\ MAR. 27, 2004. 06:30 comment: ================================== DATA MEMORY ============================== ========================== B =========================== 7 6 5 4 3 2 1 0 ........ R 00 0 : . . . : . . . : ........ R 01 1 : . . . : . . . : ........ R 02 2 : . . . : . . . : ........ R 03 3 : . . . : . . . : ........ R 04 4 : . . . : . . . : ........ R 05 5 : . . . : . . . : ........ R 06 6 : . . . : . . . : ........ R 07 7 : . . . : . . . : ........ R 08 8 : . . . : . . . : ........ R 09 9 : . . . : . . . : ........ R 0A A : . . . : . . . : ........ R 0B B : . . . : . . . : ........ R 0C C : . . . : . . . : ........ R 0D D : . . . : . . . : ........ R 0E E : . . . : . . . : ........ R 0F F : . . . : . . . : DEVICE R 10 10 : . . . : . . . : TEMP1 R 11 11 : . . . : . . . : TEMP2 R 12 12 : . . . : . . . : S.DATA R 13 13 : . . . : . . . : U.DATA R 14 14 : . . . : . . . : ADDRL R 15 15 : . . . : . . . : ADDRH R 16 16 : . . . : . . . : BIT.CT R 17 17 : . . . : . . . : RX/TX R 18 18 : . . . : . . . : CMD R 19 19 : . . . : . . . : COUNT X R 1A 1A : . . . : . . . : X low byte ... DEBUG1 R 1B 1B : . . . : . . . : X high byte ... Y R 1C 1C : . . . : . . . : Y low byte ... R 1D 1D : . . . : . . . : Y high byte ... Z R 1E 1E : . . . : . . . : Z low byte ... R 1F 1F : . . . : . . . : Z high byte ... ========================== B =========================== 7 6 5 4 3 2 1 0 ........ P 00 20 : . . . : . . . : ........ P 01 21 : . . . : . . . : ........ P 02 22 : . . . : . . . : ........ P 03 23 : . . . : . . . : ........ P 04 24 : . . . : . . . : ........ P 05 25 : . . . : . . . : ........ P 06 26 : . . . : . . . : ........ P 07 27 : . . . : . . . : ACSR P 08 28 : ACD . . ACO . ACI : ACIE . ACIC . ACIS1. ACIS0: UBRR P 09 29 : BAUD RATE GENERATOR : UCR P 0A 2A : RXCIE. TXCIE. UDRIE. RXEN : TXEN . CHR9 . RXB8 . TXB8 : USR P 0B 2B : RXC . TXC . UDRE . FR : OR . . . : UDR P 0C 2C : UART I/O register : SPCR P 0D 2D : SPIE . SPE . DORD . MSTR : CPOL . CPHA . SPRI . SPR0 : SPSR P 0E 2E : SPIF . WCOL . . : . . . : SPDR P 0F 2F : SPI Data Register : PIND P 10 30 : . . . : . . . : DDRD P 11 31 : . . . : . . . : PORTD P 12 32 : . . . : . . . : PINC P 13 33 : . . . : . . . : DDRC P 14 34 : . . . : . . . : PORTC P 15 35 : . . . : . . . : PINB P 16 36 : . . . : . . . : DDRB P 17 37 : . . . : . . . : PORTB P 18 38 : . . . : . . . : PINA P 19 39 : . . . : . . . : DDRA P 1A 3A : . . . : . . . : PORTA P 1B 3B : . . . : . . . : EECR P 1C 3C : . . . : . EEMWE. EEWE . EERE : EEDR P 1D 3D : EEPROM Data Register : EEARL P 1E 3E : EEPROM Address Register : EEARH P 1F 3F : . . . : . . . : ........ P 20 40 : . . . : . . . : WDTCR P 21 41 : . . . WDTOE: WDE . WDP2 . WDP1 . WDP0 : ........ P 22 42 : . . . : . . . : ........ P 23 43 : . . . : . . . : ICR1L P 24 44 : Timer/Counter 1 - Input Capture Register Low byte : ICR1H P 25 45 : Timer/Counter 1 - Input Capture Register How byte : ........ P 26 46 : . . . : . . . : ........ P 27 47 : . . . : . . . : OCR1BL P 28 48 : Timer/Counter 1 Output Compare Register B Low Byte : OCR1BH P 29 49 : Timer/Counter 1 Output Compare Register B High Byte : OCR1AL P 2A 4A : Timer/Counter 1 Output Compare Register A Low Byte : OCR1AH P 2B 4B : Timer/Counter 1 Output Compare Register A High Byte : TCNT1L P 2C 4C : Timer/Counter 1 Counter Register High Byte : TCNT1H P 2D 4D : Timer/Counter 1 Counter Register Low Byte : TCCR1B P 2E 4E : ICNC1. ICES1. . : CTC1 . CS12 . CS11 . CS10 : TCCR1A P 2F 4F :COM1A1.COM1A0.COM1B1.COM1B0: . . PWM11. PWM10: ........ P 30 50 : . . . : . . . : ........ P 31 51 : . . . : . . . : TCNT0 P 32 52 : Timer/Counter 0 ( 8 Bit ) : TCCR0 P 33 53 : . . . : . CS02 . CS01 . CS00 : ........ P 34 54 : . . . : . . . : MCUCR P 35 55 : SRE . SRW . SE . SM : ISC11. ISC10. ISC01. ISC00: ........ P 36 56 : . . . : . . . : ........ P 37 57 : . . . : . . . : TIFR P 38 58 : TOV1 . OCF1A. OCF1B. : ICF1 . . TOV0 . : TIMSK P 39 59 : TOIE1.OCIE1A.OCIE1B: .TICIE1. . TOIE0. : GIFR P 3A 5A : INTF1. INTF0. . : . . . : GIMSK P 3B 5B : INT1 . INT0 . . : . . . : ........ P 3C 5C : . . . : . . . : SPL P 3D 5D : . . . : . . . : SPH P 3E 5E : . . . : . . . : SREG P 3F 5F : I . T . H . S : V . N . Z . C : . INTERNAL SRAM ........ 60 : . . . : . . . : ........ 61 : . . . : . . . : ........ 62 : . . . : . . . : ........ 63 : . . . : . . . : ........ 64 : . . . : . . . : ........ 65 : . . . : . . . : ........ 66 : . . . : . . . : ........ 67 : . . . : . . . : ........ . : . . . : . . . : ........ . : . . . : . . . : ........ . : . . . : . . . : ........ . : . . . : . . . : ........ 258 : . . . : . . . : ........ 259 : . . . : . . . : ........ 25A : . . . : . . . : ........ 25B : . . . : . . . : ........ 25C : . . . : . . . : ........ 25D : . . . : . . . : ........ 25E : . . . : . . . : ........ 25F : . . . : . . . : EXTERNAL SRAM ........ 260 : . . . : . . . : ........ 261 : . . . : . . . : ........ 262 : . . . : . . . : ........ . : . . . : . . . : ........ . : . . . : . . . : ........ . : . . . : . . . : ........ . : . . . : . . . : ........ FFFF : . . . : . . . : =============================== PROGRAM MEMORY ==================================================== F E D C B A 9 8 7 6 5 4 3 2 1 0 0000 : 1 . 1 . 0 . 0 : 0 . 0 . 0 . 0 : 1 . 0 . 1 . 0 : 1 . 0 . 1 . 1 : C0AB AC RJMP 0001 : 1 . 0 . 0 . 1 : 0 . 1 . 0 . 1 : 0 . 0 . 0 . 1 : 1 . 0 . 0 . 0 : 9518 RETI 0002 : 1 . 1 . 0 . 0 : 0 . 0 . 0 . 0 : 0 . 0 . 0 . 0 : 0 . 0 . 0 . 0 : C001 4 RJMP 0003 : 1 . 0 . 0 . 1 : 0 . 1 . 0 . 1 : 0 . 0 . 0 . 1 : 1 . 0 . 0 . 0 : 9518 RETI 0004 : 1 . 0 . 1 . 1 : 0 . 1 . 1 . 0 : 0 . 0 . 0 . 0 : 1 . 1 . 1 . 1 : B60F 3F 0 P>R 0005 : 1 . 1 . 1 . 0 : 1 . 1 . 1 . 0 : 0 . 0 . 0 . 1 : 0 . 1 . 1 . 1 : EE17 E7 11 #>R 0006 : 1 . 0 . 1 . 1 : 1 . 1 . 1 . 1 : 0 . 0 . 0 . 1 : 0 . 0 . 1 . 0 : BF12 11 32 R>P . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... 00AC : 0 . 0 . 1 . 0 : 0 . 1 . 1 . 1 : 0 . 0 . 0 . 1 : 0 . 0 . 0 . 1 : 2711 11 R=00 00AD : 1 . 0 . 1 . 1 : 1 . 1 . 1 . 1 : 0 . 0 . 0 . 1 : 1 . 0 . 1 . 1 : BF1B 11 3B R>P 00AE : 1 . 1 . 1 . 0 : 1 . 1 . 1 . 1 : 0 . 0 . 0 . 1 : 1 . 1 . 1 . 1 : EF1F FF 11 #>R 00AF : 1 . 0 . 1 . 1 : 1 . 0 . 1 . 1 : 0 . 0 . 0 . 0 : 0 . 0 . 1 . 0 : BB12 11 12 R>P 00B0 : 1 . 0 . 0 . 1 : 1 . 0 . 1 . 0 : 1 . 1 . 0 . 0 : 0 . 1 . 0 . 0 : 9AC4 18 4 PB=1 00B1 : 1 . 0 . 1 . 1 : 1 . 0 . 1 . 1 : 0 . 0 . 0 . 1 : 0 . 1 . 1 . 1 : BB17 11 17 R>P 00B2 : 1 . 0 . 1 . 1 : 1 . 0 . 1 . 1 : 0 . 0 . 0 . 1 : 1 . 0 . 0 . 0 : BB18 11 18 R>P 00B3 : 1 . 1 . 0 . 1 : 1 . 1 . 1 . 1 : 0 . 1 . 1 . 1 : 0 . 0 . 1 . 0 : DF72 26 RCALL 00B4 : 1 . 0 . 0 . 1 : 0 . 1 . 0 . 0 : 0 . 1 . 1 . 1 : 1 . 0 . 0 . 0 : 9478 I=1 . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... . : . . . : . . . : . . . : . . . : ......................... 0FFC : . . . : . . . : . . . : . . . : ......................... 0FFD : . . . : . . . : . . . : . . . : ......................... 0FFE : . . . : . . . : . . . : . . . : ......................... 0FFF : . . . : . . . : . . . : . . . : ......................... \ 32 919B 3 + C! ( RETI ) : 3 ; 0E ALLOT ' 2 ' 3 0B CMOVE ' 3 >NAME 2 - 8130 0C + 0F CMOVE 0 8130 0C + ! 8132 0C + ' .XX >NAME 2 - ! \ ' find >NAME ' NAME? >NAME 2 - ! FORGET 3 C61C >NAME ' dNAME 2 - ! \ REMOVE 3 1 2 + ' 3 7 + C! ' 3 FLIP DUP CD87 ! DUP E0EE ! DUP E0FD ! E1B0 ! comment; \ AVR90S8515 AVRFPC3.SEQ FEB. 11, 2000. UNDER PC \ AVR90S8515 AVREF38.SEQ APR. 8, 2000. UNDER eFORTH51 \ ' OVERLAY 1 + ORG \ FORGET OVERLAY RAM0 2000 ORG HEX : .XX 0 <# # # #> TYPE ; \ : .XX 0FF AND DUP 0A 0F BETWEEN \ IF 0 0 <# # #> TYPE 0 <# # #> TYPE \ ELSE 0 <# # # #> TYPE \ .XX \ THEN ; \ CODE >2^N ( B ... 2^N ) \ B = 0 ~ 0F \ 2 R+ 2 4 R>D A=0 3 A>R A+ 2 A>R \ BEGIN' 4 R- 4 R>A \ WHILE'A<>0 C=0 2 R>A RLC 2 A>R 3 R>A RLC 3 A>R \ REPEAT' RET \ THIS TAKES 15 ( 21 ) BYTES OF MEMEORY. \ CODE 2^N? ( N1 .... N -1 , 0 0 ) 11 5 #>R 0 4 #>R \ BEGIN' 5 R- 5 R>A \ WHILE'A<>0 3 R>A RRC 3 A>R 2 R>A RRC 2 A>R \ IF'C=1 4 R+ 5 6 R>D \ THEN' \ REPEAT' 4 R>A 1 Ax# \ IF'A=0 C=0 10 #>A 6 A-R-C 2 A>R 0 3 #>R \ ' DUP LCALL 0FF #>A 2 A>R 3 A>R \ ELSE' A=0 2 A>R 3 A>R ' DUP LCALL \ THEN' \ RET \ THIS TAKES 30 ( 48 ) BYTES OF MEMORY. \ : #>2^N ( # ... N ) \ # MUST BE 2^N \ 2^N? DROP ; : #>2^N ( # ... N ) \ # MUST BE 2^N CASE 1 OF 0 ENDOF 2 OF 1 ENDOF 4 OF 2 ENDOF 8 OF 3 ENDOF 10 OF 4 ENDOF 20 OF 5 ENDOF 40 OF 6 ENDOF 80 OF 7 ENDOF ABORT" # isn't 2^n " ENDCASE ; CREATE N>2^N.TABLE 1 C, 2 C, 4 C, 8 C, 10 C, 20 C, 40 C, 80 C, : >2^N ( N ... 2^N ) N>2^N.TABLE + C@ ; VARIABLE MATCH? : 2^N? ( N ... N -1 / 0 0 ) 0 MATCH? ! 8 0 DO DUP I N>2^N.TABLE + C@ = IF -1 MATCH? ! LEAVE THEN LOOP MATCH? @ IF -1 ELSE DROP 0 0 THEN ; : FLIPP ; : 2+ 2 + ; : 2- 2 - ; : 2* 2 * ; : 2/ 2 / ; : 3+ 3 + ; : 2OVER 3 PICK 3 PICK ; : 2SWAP ROT >R ROT R> ; : -ROT ROT ROT ; \ : ASCII ( ... BYTE ) BL WORD 1+ C@ \ 'EVAL @ [ ' $COMPILE ] LITERAL = \ IF [ 12 C, ' LITERAL FLIP , ] \ THEN ; IMMEDIATE \ CODE doLIT$| \ SOMETHING LIKE doLIT AND ."| \ 83 POP 82 POP ' DUP LCALL \ 83 3 D>R 82 2 D>R (DP)>A DP+ JMP>A+DP \ : $" [ ' doLIT$| ] LITERAL CALL $." ; IMMEDIATE DEFER $" ' S" IS $" : TEXT ( ... PAD ) WORD PAD OVER C@ 1+ CMOVE PAD ; : $( ( ... PAD ) 29 TEXT ; \ ASCII ) = 29 : $, ( $ADDR ... ) COUNT 0 DO DUP I + C@ C, LOOP DROP ; \ : $= ( $1 $2 ... F ) \ COUNT ROT COUNT ROT DUP >R = \ IF -1 R@ 1 - \ FOR -ROT OVER R@ + C@ OVER R@ + C@ = >R ROT R> AND \ NEXT -ROT 2DROP \ ELSE 2DROP 0 \ THEN R> DROP ; \ ' OVERLAY >NAME ' >2^N >NAME 2 - ! \ .................................. \ : OVERLAY ; FORGET OVERLAY RAM0 2000 ORG \ .................................. CREATE $.I/O.SPACE.TABLE $( ) $, \ 0 $( ) $, \ 1 $( ) $, \ 2 $( ) $, \ 3 $( ) $, \ 4 $( ) $, \ 5 $( ) $, \ 6 $( ) $, \ 7 $( ACSR) $, \ 8 $( UBRR) $, \ 9 $( UCR) $, \ 0A $( USR) $, \ 0B $( UDR) $, \ 0C $( SPCR) $, \ 0D $( CPSR) $, \ 0E $( SPDR) $, \ 0F $( PIND) $, \ 10 $( DDRD) $, \ 11 $( PORTD) $, \ 12 $( PINC) $, \ 13 $( DDRC) $, \ 14 $( PORTC) $, \ 15 $( PINB) $, \ 16 $( DDRB) $, \ 17 $( PORTB) $, \ 18 $( PINA) $, \ 19 $( DDRA) $, \ 1A $( PORTA) $, \ 1B $( EECR) $, \ 1C $( EEDR) $, \ 1D $( EEARL) $, \ 1E $( EEARH) $, \ 1F $( ) $, \ 20 $( WDTCR) $, \ 21 $( ) $, \ 22 $( ) $, \ 23 $( ICR1L) $, \ 24 $( ICR1H) $, \ 25 $( ) $, \ 26 $( ) $, \ 27 $( OCR1BL) $, \ 28 $( OCR1BH) $, \ 29 $( OCR1AL) $, \ 2A $( OCR1AH) $, \ 2B $( TCNT1L) $, \ 2C $( TCNT1H) $, \ 2D $( TCCR1B) $, \ 2E $( TCCR1A) $, \ 2F $( ) $, \ 30 $( ) $, \ 31 $( TCNT0) $, \ 32 $( TCCR0) $, \ 33 $( ) $, \ 34 $( MCUCR) $, \ 35 $( ) $, \ 36 $( ) $, \ 37 $( TIFR) $, \ 38 $( TIMSK) $, \ 39 $( GIFR) $, \ 3A $( GIMSK) $, \ 3B $( ) $, \ 3C $( SPL) $, \ 3D $( SPH) $, \ 3E $( SREG) $, \ 3F : ############ ; : ######### ; \ AVR DISASSEMBLER \ HEX NOBASE \ ASSEMBLER DEFINITIONS \ VOCABULARY AVR AVR DEFINITIONS \ CREATE AVR.PROGRAM.AREA 2000 ALLOT VARIABLE CP' 0 CP' ! CREATE PROGRAM.AREA 2000 ALLOT : AVR.PROGRAM.AREA 0 ; : CP0 PROGRAM.AREA ; \ : AVR.PROGRAM.AREA CP0 ; : CELL+ ( N ... N*2 ) 2+ ; : CELL- ( N ... N*2 ) 2- ; : CELL* ( N ... N*2 ) 2* ; : CELL/ ( N ... N*2 ) 2/ ; : 16! >R 100 /MOD R@ 1+ C! R> C! ; : 16@ @ FFFF AND ; : C@' CP0 + C@ ; : @' CELL* CP0 + 16@ ; : !' CELL* CP0 + 16! ; : +!' >R R@ @' + R> !' ; : ALLOT' ( N ... ) CP' +! ; \ : !' ( N ADDR' ... ) CELL* CP0 + 16! ; \ : @' ( ADDR' ... N ) CELL* CP0 + 16@ ; : ORG' ( ADDR' ... ) CP' ! ; : HERE' ( ... ADDR' ) CP' @ ; \ : ,' ( N ... ) HERE' CELL* CP0 + ! 1 ALLOT' ; : ,' ( N ... ) HERE' !' 1 ALLOT' ; VARIABLE MAX.DEFER.QUEUE.COUNT 10 MAX.DEFER.QUEUE.COUNT ! VARIABLE DEFER.QUEUE.COUNTER : >DEFER.QUEUE ( ADDR' CFA ... ) >R R@ @ C@' 2 = \ DEFER INSTRUCTION? 0 DEFER.QUEUE.COUNTER ! IF BEGIN R@ 4 + DEFER.QUEUE.COUNTER @ 4 * + @ -1 = IF R@ 4 + DEFER.QUEUE.COUNTER @ 4 * + ! -1 ELSE 1 DEFER.QUEUE.COUNTER +! DEFER.QUEUE.COUNTER @ MAX.DEFER.QUEUE.COUNT @ > IF ABORT" TOO MANY DEFERS CALLED " THEN 0 THEN UNTIL ELSE DROP THEN R> DROP ; : >DEFER.QUEUE ( ADDR' CFA ... ) >R R@ @ @' F000 AND C000 = \ DEFER INSTRUCTION? 0 DEFER.QUEUE.COUNTER ! IF BEGIN R@ 4 + DEFER.QUEUE.COUNTER @ 4 * + @ -1 = IF R@ 4 + DEFER.QUEUE.COUNTER @ 4 * + ! -1 ELSE 1 DEFER.QUEUE.COUNTER +! DEFER.QUEUE.COUNTER @ MAX.DEFER.QUEUE.COUNT @ > IF ABORT" TOO MANY DEFERS CALLED " THEN 0 THEN UNTIL ELSE DROP THEN R> DROP ; \ : L: CREATE HERE' , DOES> @ ; \ : T: CREATE HERE' , DOES> @ FLIP 12 C,' ,' ; \ 8051 ONLY \ : T: CREATE HERE' , DOES> DUP >R @ FLIP 12 C,' DUP ,' R> >DEFER.QUEUE ; \ : T: CREATE HERE' , DOES> >R HERE' R@ @ FLIP 12 C,' ,' R> >DEFER.QUEUE ; \ : :T T: ; : ;T RET ; \ : :' T: ; : ;' RET ; \ :T T.START VARIABLE TABLE.OFFSET 0 TABLE.OFFSET ! : MEM.TOP 7FF ; \ : T: CREATE HERE' , DOES> @ 2000 + ,' ; \ TARGET ASSEMBLING : T:QUEUE.MAX 200 ; VARIABLE T:QUEUE.COUNTER CREATE T:QUEUE T:QUEUE.MAX 6 * ALLOT : ERASE.T:QUEUE T:QUEUE T:QUEUE.MAX 6 * ERASE ; \ : ET 0 2000 ERASE' ERASE.T:QUEUE ; : T: CREATE HERE' , HERE' T:QUEUE T:QUEUE.COUNTER @ + 16! LAST @ T:QUEUE T:QUEUE.COUNTER @ + 2+ ! 6 T:QUEUE.COUNTER +! DOES> @ D000 + ,' ; \ TARGET ASSEMBLING : T: CREATE HERE' , HERE' T:QUEUE T:QUEUE.COUNTER @ + 16! LAST @ T:QUEUE T:QUEUE.COUNTER @ + 2+ ! 6 T:QUEUE.COUNTER +! DOES> @ HERE' 1+ - 0FFF ( 2^12 ) AND D000 + ,' ; \ TARGET ASSEMBLING \ : T: CREATE HERE' , DOES> >R HERE' R@ @ FLIP 12 C,' ,' R> >DEFER.QUEUE ; \ 8051 : T: CREATE HERE' , HERE' T:QUEUE T:QUEUE.COUNTER @ + 16! LAST @ T:QUEUE T:QUEUE.COUNTER @ + 2+ ! 6 T:QUEUE.COUNTER +! DOES> >R HERE' R@ @ HERE' 1+ - 0FFF ( 2^12 ) AND D000 + ,' R> >DEFER.QUEUE ; \ TARGET ASSEMBLING \ : INST HERE' 1- @' 7FF AND -1 ALLOT' (U) ; : $ HERE' ; VARIABLE NFA.OF._T:? : T:? ( NFA ... F ) 0 NFA.OF._T:? ! T:QUEUE.MAX 6 * 0 DO DUP T:QUEUE I + 2 + @ = IF DUP NFA.OF._T:? ! THEN 6 +LOOP DROP NFA.OF._T:? @ 0<> ; \ ' T:? IS _T:? \ CODE doLIT' ' doLIT LJMP \ : CODE' CREATE -3 ALLOT 12 C, [ ' doLIT' FLIP ] LITERAL , \ [ ' HERE' ] LITERAL EXECUTE , 22 C, ; \ : LABEL' CODE' ; : JMP.LABEL.END 2002 ; \ : FIND.JMP.LABEL ( N .... NFA / 0 ) LAST @ >R \ BEGIN R@ NAME> \ CFA \ DUP C@ 12 = >R DUP 1+ @ FLIP [ ' doLIT' ] LITERAL = R> AND >R \ 3 + @ OVER = R> AND \ IF DROP R@ -1 \ ELSE R> 2 - @ DUP >R JMP.LABEL.END = IF DROP 0 -1 ELSE 0 THEN \ THEN \ UNTIL R> DROP ; VARIABLE FIND.JMP.LABEL? : FIND.JMP.LABEL ( N .... NFA / 0 ) T:QUEUE.MAX 0 0 FIND.JMP.LABEL? ! DO DUP T:QUEUE I 6 * + 16@ = IF T:QUEUE I 6 * + 2 + @ FIND.JMP.LABEL? ! LEAVE THEN LOOP DROP FIND.JMP.LABEL? @ ; : FLIP ( 1234 ... 3412 ) FFFF AND 100 /MOD SWAP 100 * + ; \ : FIND.JMP.LABEL ( N .... NFA -1 / 0 ) DROP 0 ; \ : T: ( ... ) CODE' LAST @ DUP 2 - @ >R \ BEGIN R@ OVER $= \ IF DROP R@ -1 \ ELSE R> 2 - @ DUP >R JMP.LABEL.END = \ IF 0 -1 \ ELSE 0 \ THEN \ THEN \ UNTIL R> DROP ?DUP \ IF NAME> 3 + HERE' SWAP ! \ LAST @ NAME> [ ' FORGET 3 + ] LITERAL EXECUTE \ THEN ; \ BASIC DEFER RXXXX....XXXXB ( N1 N2 ... ) DEFER PXXXX....XXXXB ( N1 N2 ... ) DEFER PXXXX....XXXXR ( N1 N2 ... ) DEFER RXXXX....XXXXP ( N1 N2 ... ) DEFER RXXXX....XXXXR ( N1 N2 ... ) DEFER RXXXX....XXXX ( N1 N2 ... ) DEFER XXXX....XXXXR ( N1 N2 ... ) DEFER ........XXXXR ( N1 N2 ... ) DEFER ....XXXXR VARIABLE SHOW.T:? : NO.T: ( ... ) 0 SHOW.T:? ! ; : SHOW.T: ( ... ) -1 SHOW.T:? ! ; SHOW.T: : TOGGLE.T: -1 SHOW.T:? @ XOR SHOW.T:? ! ; VARIABLE SHOW.I/O? : NO.I/O ( ... ) 0 SHOW.I/O? ! ; : SHOW.I/O ( ... ) -1 SHOW.I/O? ! ; SHOW.I/O VARIABLE SHOW.REGISTER? : NO.REGISTER ( ... ) 0 SHOW.REGISTER? ! ; : SHOW.REGISTER ( ... ) -1 SHOW.REGISTER? ! ; SHOW.REGISTER : N SHOW.I/O? @ \ NOT NOW IF SHOW.REGISTER? @ IF -1 SHOW.I/O? @ XOR SHOW.I/O? ! \ 1 1 -> 0 1 ELSE -1 SHOW.REGISTER? @ XOR SHOW.REGISTER? ! \ 1 0 -> 1 1 THEN ELSE SHOW.REGISTER? @ IF -1 SHOW.REGISTER? @ XOR SHOW.REGISTER? ! \ 0 1 -> 0 0 ELSE -1 SHOW.I/O? @ XOR SHOW.I/O? ! \ 0 0 -> 1 0 THEN THEN ; : ........XXXX ( D ... ) 0F SPACES 5 U.R 2 SPACES ; : ....XXXX ( N ... ) 7 SPACES 7 U.R ; : XXXX....XXXX ( N1 N2 ... ) 6 SPACES SWAP 7 U.R 7 U.R 2 SPACES ; : ........XXXX' ( ADDR' ... ) >R R@ FIND.JMP.LABEL DUP SHOW.T:? @ AND IF NFA-COUNT 14 OVER - SPACES TYPE 2 SPACES ELSE DROP R@ ........XXXX THEN R> DROP ; CREATE $.REGISTERS.TABLE $( ) $, \ R0 0 $( ) $, \ R1 1 $( ) $, \ R2 2 $( ) $, \ R3 3 $( ) $, \ R4 4 $( ) $, \ R5 5 $( ) $, \ R6 6 $( ) $, \ R7 7 $( ) $, \ R8 8 $( ) $, \ R9 9 $( ) $, \ R10 A $( ) $, \ R11 B $( ) $, \ R12 C $( ) $, \ R13 D $( ) $, \ R14 E $( ) $, \ R15 F $( DEVICE) $, \ R16 10 $( TEMP1) $, \ R17 11 $( TEMP2) $, \ R18 12 $( S.DATA) $, \ R19 13 $( U.DATA) $, \ R20 14 $( ADDRL) $, \ R21 15 $( ADDRH) $, \ R22 16 $( BIT.CT) $, \ R23 17 $( RX/TX ) $, \ R24 18 U.STAT $( CMD) $, \ R25 19 \ $( #COUNT) $, \ R26 1A \ $( DEBUG1) $, \ R27 1B $( XL ) $, \ R26 1A $( XH ) $, \ R27 1B $( YL ) $, \ R28 1C $( YH ) $, \ R29 1D $( ZL ) $, \ R30 1E $( ZH ) $, \ R31 1F \ : OVERLAY ; FORGET OVERLAY RAM0 2000 ORG VARIABLE TRAILING.SPACE.COUNT VARIABLE 1ST.TRAILING.SPACE? \ : TYPE.R ( ADDR LENGTH ... ) DUP 1- \ 0 1ST.TRAILING.SPACE? ! 0 TRAILING.SPACE.COUNT ! \ FOR OVER R@ + C@ 20 = \ IF 1ST.TRAILING.SPACE? @ \ IF \ ELSE 1 TRAILING.SPACE.COUNT +! \ THEN \ ELSE -1 1ST.TRAILING.SPACE? ! \ THEN \ NEXT TRAILING.SPACE.COUNT @ DUP SPACES - _TYPE ; : TYPE.R ( ADDR LENGTH ... ) DUP 1- 0 1ST.TRAILING.SPACE? ! 0 TRAILING.SPACE.COUNT ! BEGIN >R OVER R@ + C@ 20 = IF 1ST.TRAILING.SPACE? @ IF ELSE 1 TRAILING.SPACE.COUNT +! THEN ELSE -1 1ST.TRAILING.SPACE? ! THEN R> 1 - ?DUP 0= UNTIL TRAILING.SPACE.COUNT @ DUP SPACES - _TYPE ; : PRINT.REGISTER.NAME ( REG ... ) SHOW.REGISTER? @ >R DUP 6 * $.REGISTERS.TABLE + 0 5 0 DO OVER I + C@ 20 <> + LOOP R> AND IF SPACE 6 TYPE.R DROP ELSE DROP 7 U.R THEN ; : PRINT.I/O.NAME ( P ... ) SHOW.I/O? @ >R DUP 6 * $.I/O.SPACE.TABLE + DUP 5 + C@ 20 <> R> AND IF SPACE 6 TYPE.R DROP ELSE DROP 7 U.R THEN ; VARIABLE MACRO? -1 MACRO? ! \ : H H CR ." M N " ; \ : PC..(PC)' ( ADDR' ... ) ." ( " \ DUP AVR.PROGRAM.AREA - CELL/ 5 U.R @' 7 U.R ." ) " ; : PC..(PC)' ( ADDR' ... ) ." ( " DUP 5 U.R @' 7 U.R ." ) " ; \ ..................................................... : ACSR 08 ; : UBRR 09 ; : UCR 0A ; : USR 0B ; : UDR 0C ; : SPCR 0D ; : SPSR 0E ; : SPDR 0F ; : PIND 10 ; : DDRD 11 ; : PORTD 12 ; : PINC 13 ; : DDRC 14 ; : PORTC 15 ; : PINB 16 ; : DDRB 17 ; : PORTB 18 ; : PINA 19 ; : DDRA 1A ; : PORTA 1B ; : EECR 1C ; : EEDR 1D ; : EEARL 1E ; : WDTCR 21 ; : ICR1L 24 ; : ICR1H 25 ; : OCR1BL 28 ; : OCR1BH 29 ; : OCR1AL 2A ; : OCR1AH 2B ; : TCNT1L 2C ; : TCNT1H 2D ; : TCCR1B 2E ; : TCCR1A 2F ; : TCNT0 32 ; : TCCR0 33 ; : MCUCR 35 ; : TIFR 38 ; : TIMSK 39 ; : GIFR 3A ; : GIMSK 3B ; : SPL 3D ; : SPH 3E ; : SREG 3F ; \ : OVERLAY ; FORGET OVERLAY RAM0 2000 ORG \ HEX NOBASE VOCABULARY AVR AVR DEFINITIONS \ CREATE AVR.PROGRAM.AREA 1000 ALLOT \ : +!' ( N ADDR' ... ) CELL* AVR.PROGRAM.AREA + +! ; \ : ALLOT' CP' +! ; \ : ,' HERE' !' 1 ALLOT' ; \ : T AVR.PROGRAM.AREA 2000 ERASE ; \ : TT AVR.PROGRAM.AREA 100 DUMP ; \ RDDDDDRRRR ( D R ... N ) \ (1) \ ##DD#### ( D' #' ... N ) \ (2) \ ####DDDD#### ( D # ... N ) \ (3) \ CODE MACRO ' : LJMP \ CODE ENDM ' ; LJMP ' ENDM >NAME DUP C@ C0 OR SWAP C! : .ERR ( N1 N2 ... ) ." IS OUT OF RANGE " SWAP . ." TO " . ; \ ABORT ; : CHECK.X.RANGE ( X LOWER.LIMIT UPPER.LIMIT CHAR ... ) >R 2DUP >R >R BETWEEN IF R> R> R> DROP 2DROP ELSE R> R> R> 2 SPACES EMIT .ERR THEN ; : CHECK.B.RANGE ( B LOWER.LIMIT UPPER.LIMIT ... ) ASCII B CHECK.X.RANGE ; : CHECK.D.RANGE ( D LOWER.LIMIT UPPER.LIMIT ... ) ASCII D CHECK.X.RANGE ; : CHECK.P.RANGE ( P LOWER.LIMIT UPPER.LIMIT ... ) ASCII P CHECK.X.RANGE ; : CHECK.Q.RANGE ( Q LOWER.LIMIT UPPER.LIMIT ... ) ASCII Q CHECK.X.RANGE ; : CHECK.R.RANGE ( R LOWER.LIMIT UPPER.LIMIT ... ) ASCII R CHECK.X.RANGE ; : CHECK.S.RANGE ( S LOWER.LIMIT UPPER.LIMIT ... ) ASCII S CHECK.X.RANGE ; : CHECK.#.RANGE ( # LOWER.LIMIT UPPER.LIMIT ... ) ASCII # CHECK.X.RANGE ; : CHECK.D,R.RANGE ( D R ... ) 0 1F CHECK.R.RANGE 0 1F CHECK.D.RANGE ; : CHECK.D,#.RANGE ( D # ... ) 0 1F CHECK.#.RANGE 0 1F CHECK.D.RANGE ; \ .......................................... \ 1. 1R5D4R : R+R+C R+R RnR R:R R:RC R=R? RxR R>R R*R RoR \ R-R-C R-R R=0 LSR ROL TST : RDDDDDRRRR ( D R ? ... N ) >R 2DUP 0 1F CHECK.R.RANGE 0 1F CHECK.D.RANGE 10 /MOD 200 * OR SWAP 10 * OR R> OR FLIPP ,' ; : R+R ( D R ... ) 0C00 RDDDDDRRRR ; ######### : ADD R+R ; : R-R ( D R ... ) 1800 RDDDDDRRRR ; ######### : SUB R-R ; : R+R+C ( D R ... ) 1C00 RDDDDDRRRR ; ######### : ADC R+R+C ; : R-R-C ( D R ... ) 0800 RDDDDDRRRR ; ######### : SBC R-R-C ; : RnR ( D R ... ) 2000 RDDDDDRRRR ; ######### \ AND RnR ; : RoR ( D R ... ) 2800 RDDDDDRRRR ; ######### \ OR RoR ; : RxR ( D R ... ) 2400 RDDDDDRRRR ; ######### : EOR RxR ; : R:R ( D R ... ) 1400 RDDDDDRRRR ; ######### : CP R:R ; : R:RC ( D R ... ) 0400 RDDDDDRRRR ; ######### : CPC R:RC ; : R=R? ( D R ... ) 1000 RDDDDDRRRR ; ######### : CPSE R=R? ; : R>R ( R D ... ) SWAP 2C00 RDDDDDRRRR ; ######### : MOV R>R ; : R*R ( D R ... ) 9C00 RDDDDDRRRR ; ######### : MUL R*R ; : TEMP1 11 ; : TEMP2 12 ; : A+R TEMP1 SWAP R+R ; : A-R TEMP1 SWAP R-R ; : A+R+C TEMP1 SWAP R+R+C ; : A-R-C TEMP1 SWAP R-R-C ; : AnR TEMP1 SWAP RnR ; : AoR TEMP1 SWAP RoR ; : AxR TEMP1 SWAP RxR ; : A:R TEMP1 SWAP R:R ; : A:RC TEMP1 SWAP R:RC ; : A=R? TEMP1 SWAP R=R? ; : A>R TEMP1 SWAP R>R ; : R=A A>R ; : A*R TEMP1 SWAP R*R ; : R+A TEMP1 R+R ; : R-A TEMP1 R-R ; : R+A+C TEMP1 R+R+C ; : R-A-C TEMP1 R-R-C ; : RnA TEMP1 RnR ; : RoA TEMP1 RoR ; : RxA TEMP1 RxR ; : R:A TEMP1 R:R ; : R:AC TEMP1 R:RC ; : R=A? TEMP1 R=R? ; : R>A TEMP1 R>R ; : A=R R>A ; : R*A TEMP1 R*R ; \ .......................................... \ 10D : R=0 R=00 SL RLC R:0 : dDDDDDdddd ( D ? ... N ) >R DUP 0 1F CHECK.R.RANGE DUP 10 /MOD 200 * OR SWAP 10 * OR R> OR FLIPP ,' ; : R=0 ( D R ... ) 2400 dDDDDDdddd ; ######### : CLR R=0 ; : R=00 ( D R ... ) 2400 dDDDDDdddd ; ######### : CLR R=00 ; : SL ( D R ... ) 0C00 dDDDDDdddd ; ######### : LSL SL ; : RLCR ( D R ... ) 1C00 dDDDDDdddd ; ######### : ROL RLCR ; : R:0 ( D R ... ) 2000 dDDDDDdddd ; ######### : TST R:0 ; : A=0 TEMP1 R=0 ; : A:0 TEMP1 R=0 ; \ 2. 2K2D4K : RX+# RX-# \ KKDDKKKK : REGISTER.PAIR>RX ( N1 ... N2 ) CASE 18 ( 24 ) OF 00 -1 ENDOF 1A ( 26 ) OF 10 -1 ENDOF 1C ( 28 ) OF 20 -1 ENDOF 1E ( 34 ) OF 30 -1 ENDOF DROP 0 ENDCASE 0 = IF ABORT" REGISTER PAIR ERROR " THEN ; : ##DD#### ( D # ? ... N ) >R DUP 0 3F CHECK.#.RANGE 10 /MOD 40 * OR SWAP REGISTER.PAIR>RX OR R> OR FLIPP ,' ; : RX+# ( D # ... ) 9600 ##DD#### ; ######### : ADIW RX+# ; : RX-# ( D # ... ) 9700 ##DD#### ; ######### : SBIW RX-# ; \ .......................................... \ 3. 4K4D4K : R:# Rn# #>R ( R<# ) Ro# Rn/# R-#-C R-# : ####DDDD#### ( D # ? ... N ) >R 2DUP 00 0FF CHECK.#.RANGE 10 1F CHECK.D.RANGE 10 /MOD 100 * OR SWAP 10 - 10 * OR R> OR FLIPP ,' ; : R:# ( D # ... ) 3000 ####DDDD#### ; ######### : CPI R:# ; : Rn# ( D # ... ) 7000 ####DDDD#### ; ######### : ANDI Rn# ; : Rn/# ( D # ... ) 0FF XOR 7000 ####DDDD#### ; ######### : CBR Rn/# ; : Ro# ( D # ... ) 6000 ####DDDD#### ; ######### : ORI Ro# ; : SBR Ro# ; : R-#-C ( D # ... ) 4000 ####DDDD#### ; ######### : SBIC R-#-C ; : R-# ( D # ... ) 5000 ####DDDD#### ; ######### : SUBI R-# ; \ : R<# ( D # ... ) E000 ####DDDD#### ; ######### \ LDI #>R ; : R=# ( # D ... ) E000 ####DDDD#### ; ######### : LDI R=# ; : #>R SWAP R=# ; : RB=X ( R B ... ) 2DUP 0 7 CHECK.B.RANGE 10 1F CHECK.D.RANGE >2^N ; : RB=0 ( R B ... ) RB=X Rn/# ; \ : RB=1 ( R B ... ) RB=X Ro# ; \ : A:# TEMP1 SWAP R:# ; : An# TEMP1 SWAP Rn# ; : An/# TEMP1 SWAP Rn/# ; : Ao# TEMP1 SWAP Ro# ; : A-#-C TEMP1 SWAP R-#-C ; : A-# TEMP1 SWAP R-# ; : #>A TEMP1 #>R ; : A=# #>A ; \ ......................................... \ 4. 5D : ASR D=0 /D D-1 D+1 (X)>D (X+)>D (-X)>D SL SR 0-D \ POP PUSH RLC RRC SWAPR : DDDDD... ( D ? ... N ) >R DUP 0 1F CHECK.D.RANGE 10 * R> OR FLIPP ,' ; : ASR ( D ... ) 9405 DDDDD... ; ######### : /R ( D ... ) 9400 DDDDD... ; ######### : COM /R ; : R- ( D ... ) 940A DDDDD... ; ######### : DEC R- ; : (X)>R ( D ... ) 900C DDDDD... ; ######### : LD_R,X (X)>R ; : (Y)>R ( D ... ) 8008 DDDDD... ; ######### : LD_R,Y (Y)>R ; : (Z)>R ( D ... ) 8000 DDDDD... ; ######### : LD_R,Z (Z)>R ; : (-X)>R ( D ... ) 900E DDDDD... ; ######### : LD_R,-X (-X)>R ; : (-Y)>R ( D ... ) 900A DDDDD... ; ######### : LD_R,-Y (-Y)>R ; : (-Z)>R ( D ... ) 9002 DDDDD... ; ######### : LD_R,-Z (-Z)>R ; : (X+)>R ( D ... ) 900D DDDDD... ; ######### : LD_R,X+ (X+)>R ; : (Y+)>R ( D ... ) 9009 DDDDD... ; ######### : LD_R,Y+ (Y+)>R ; : (Z+)>R ( D ... ) 9001 DDDDD... ; ######### : LD_R,Z+ (Z+)>R ; : 0-R ( D ... ) 9401 DDDDD... ; ######### : NEG 0-R ; : R+ ( D ... ) 9403 DDDDD... ; ######### : INC R+ ; : POP ( D ... ) 900F DDDDD... ; ######### \ : PUSH ( D ... ) 920F DDDDD... ; ######### \ : RRCR ( D ... ) 9407 DDDDD... ; ######### \ : ROR RRC ; -->CONFLICT RoR : SR ( D ... ) 9406 DDDDD... ; ######### : LSR SR ; : SWAPR ( D ... ) 9402 DDDDD... ; ######### : /A TEMP1 /R ; : A- TEMP1 R- ; : (X)>A TEMP1 (X)>R ; : (Y)>A TEMP1 (Y)>R ; : (Z)>A TEMP1 (Z)>R ; : (-X)>A TEMP1 (-X)>R ; : (-Y)>A TEMP1 (-X)>R ; : (-Z)>A TEMP1 (-X)>R ; : (X+)>A TEMP1 (X+)>R ; : (Y+)>A TEMP1 (Y+)>R ; : (Z+)>A TEMP1 (Z+)>R ; : -A TEMP1 0-R ; : A+ TEMP1 R+ ; : SSS.... ( S ? ... N ) >R DUP 0 7 CHECK.S.RANGE 10 * R> OR FLIPP ,' ; : SREG=0 ( S ... ) 9488 SSS.... ; ######### : BCLR SREG=0 ; : SREG=1 ( S ... ) 9408 SSS.... ; ######### : BSET SREG=1 ; \ ......................................... \ ......................................... \ D DDDD .BBB DB>T FA00 \ 5. 3S : SREG=0 9488 \ 6. 5D3B : T>RB F800 : DDDDD.BBB ( R B ? ... ) >R 2DUP 0 7 CHECK.B.RANGE 0 1F CHECK.D.RANGE SWAP 10 * + R> OR FLIPP ,' ; : T>RB ( D B ... ) F800 DDDDD.BBB ; ######### : BLD T>RB ; : RB>T ( D B ... ) FA00 DDDDD.BBB ; ######### : BBST RB>T ; \ ......................................... \ 7. 7K3S : SREG=0? F400 \ KK KKKK KSSS SREG=1? F000 : KKKKKKKSSS ( ADDR'S ? ... ) >R DUP 0 7 CHECK.B.RANGE SWAP HERE' - 8 * OR R> OR FLIPP ,' ; : KKKKKKKSSS ( K S ? ... ) >R 2DUP 0 7 CHECK.S.RANGE 0 7F CHECK.#.RANGE SWAP 8 * OR R> OR FLIPP ,' ; : SREG=0? ( S ... ) F400 KKKKKKKSSS ; ######### : BRBC SREG=0? ; : SREG=1? ( S ... ) F000 KKKKKKKSSS ; ######### : BRBS SREG=1? ; \ ......................................... \ 8. 7K C=0? Z=0? N=0? S=0? H=0? T=0? V=0? I=0? \ KK KKKK K... C=1? Z=1? N=1? S=1? H=1? T=1? V=1? I=1? : KKKKKKK ( OFFSET.ADDR' ? ... ) \ >R HERE' - DUP 0 7F CHECK.B.RANGE 8 * R> OR FLIPP ,' ; \ >R DUP 0 7F CHECK.#.RANGE 8 * R> OR FLIPP ,' ; >R HERE' 1+ - DUP -40 3F CHECK.#.RANGE DUP 0< IF 7F AND THEN 8 * R> OR ,' ; : C=0? ( OFFSET.ADDR'... ) F400 KKKKKKK ; ######### : BRCC C=0? ; : C=1? ( OFFSET.ADDR'... ) F000 KKKKKKK ; ######### : BRCS C=1? ; : Z=0? ( OFFSET.ADDR'... ) F401 KKKKKKK ; ######### : BRNE Z=0? ; : Z=1? ( OFFSET.ADDR'... ) F001 KKKKKKK ; ######### : BREQ Z=1? ; : N=0? ( OFFSET.ADDR'... ) F402 KKKKKKK ; ######### : BRPL N=0? ; : N=1? ( OFFSET.ADDR'... ) F002 KKKKKKK ; ######### : BRMI N=1? ; : V=0? ( OFFSET.ADDR'... ) F403 KKKKKKK ; ######### : BRVC V=0? ; : V=1? ( OFFSET.ADDR'... ) F003 KKKKKKK ; ######### : BRVS V=1? ; : S=0? ( OFFSET.ADDR'... ) F404 KKKKKKK ; ######### : BRGE S=0? ; : S=1? ( OFFSET.ADDR'... ) F004 KKKKKKK ; ######### : BRLT S=1? ; : H=0? ( OFFSET.ADDR'... ) F405 KKKKKKK ; ######### : BRHC H=0? ; : H=1? ( OFFSET.ADDR'... ) F005 KKKKKKK ; ######### : BRHS H=1? ; : T=0? ( OFFSET.ADDR'... ) F406 KKKKKKK ; ######### : BRTC T=0? ; : T=1? ( OFFSET.ADDR'... ) F006 KKKKKKK ; ######### : BRTS T=1? ; : I=0? ( OFFSET.ADDR'... ) F407 KKKKKKK ; ######### : BRID I=0? ; : I=1? ( OFFSET.ADDR'... ) F007 KKKKKKK ; ######### : BRIE I=1? ; \ ......................................... \ 9. 5K1K : CALL 940E \ K KKKK ...K XCALL 940E : CALL ( ADDR'... ) 940E FLIPP ,' FLIPP ,' ; ######### ( 64K ) : JMP ( ADDR'... ) 940C FLIPP ,' FLIPP ,' ; ######### ( 64K ) : XCALL ( ADDRL ADDRH ... ) \ 4M EXTENDED CALL DUP 0 3F CHECK.#.RANGE 2 /MOD 10 * OR 940E OR FLIPP ,' FLIPP ,' ; ######### : XJMP ( ADDRL ADDRH ... ) \ 4M EXTENDED CALL DUP 0 3F CHECK.#.RANGE 2 /MOD 10 * OR 940C OR FLIPP ,' FLIPP ,' ; ######### \ ......................................... \ 10. 5P3B : PB=0 9800 \ PPPP PBBB PB=1 9A00 : PPPPPBBB ( P B ? ... ) >R 2DUP 0 7 CHECK.B.RANGE 0 1F CHECK.P.RANGE SWAP 8 * OR R> OR FLIPP ,' ; : PB=0? ( D B ... ) 9900 PPPPPBBB ; ######### : SBIC PB=0? ; : PB=1? ( D B ... ) 9B00 PPPPPBBB ; ######### : SBIS PB=1? ; : PB=0 ( P B ... ) 9800 PPPPPBBB ; ######### : CBI PB=0 ; : PB=1 ( P B ... ) 9A00 PPPPPBBB ; ######### : SBI PB=1 ; \ ......................................... \ 11. 2P5D4P : IN B000 \ IN \ PPD DDDD PPPP P>D B000 \ IN : PPDDDDDPPPP ( P D ? ... ) >R 2DUP 0 1F CHECK.D.RANGE 0 3F CHECK.P.RANGE 10 * SWAP 10 /MOD 200 * OR OR R> OR FLIPP ,' ; : P>R ( P R ... ) B000 PPDDDDDPPPP ; ######### : IN P>R ; \ ......................................... \ 13. 2P5R4P : R>P B800 \ OUT \ PPR RRRR PPPP : PPRRRRRPPPP ( R P ? ... ) >R \ THE SAME AS IN 2DUP 0 3F CHECK.P.RANGE 0 1F CHECK.R.RANGE \ SWAP 10 * SWAP 10 /MOD 200 * OR OR R> OR FLIPP ,' SWAP ; 10 /MOD 200 * OR SWAP 10 * OR R> OR FLIPP ,' ; : R>P ( R P ... ) B800 PPRRRRRPPPP ; ######### : OUT R>P ; \ ......................................... \ 14. 12K : RCALL D000 \ KKKK KKKK KKKK RJMP C000 : KKKKKKKKKKKK ( ADDR' ? ... ) >R HERE' 1+ - DUP ABS 0 7FF CHECK.#.RANGE 0FFF AND R> OR ,' ; \ >R HERE' 1+ - DUP ABS 0 7FF CHECK.#.RANGE DUP 7FFF U> \ IF ELSE 0FFF AND R> OR ,' ; : RCALL ( ADDR' ... ) D000 KKKKKKKKKKKK ; ######### : RJMP ( ADDR' ... ) C000 KKKKKKKKKKKK ; ######### \ ......................................... \ 15. 5R3B RB=0? FC00 ( RB=0 ) \ R RRRR .BBB RB=1? FE00 ( RB=1 ) : RRRRR.BBB ( ADDR'R B ? ... ) >R 2DUP 0 7 CHECK.B.RANGE 0 1F CHECK.R.RANGE SWAP 10 * OR R> OR FLIPP ,' ; : RB=0? ( R B ... ) FC00 RRRRR.BBB ; ######### : SBRC RB=0? ; : RB=1? ( R B ... ) FE00 RRRRR.BBB ; ######### : SBRS RB=1? ; \ ......................................... \ 16 : 4D : DDDD.... ( D ... ) DUP 10 1F CHECK.D.RANGE 10 * R> OR FLIPP ; : R=FF ( D ... ) DDDD.... EF0F ; ######### : SER R=FF ; \ ......................................... \ 16. 5R : R>(X) R>(Y) R>(Z) \ R RRRR .... R>(X+) R>(Y+) R>(Z+) \ R>(-X) R>(-Y) R>(-Z) : RRRRR ( R ... ) >R DUP 0 1F CHECK.R.RANGE 10 * R> OR FLIPP ,' ; : R>(X) 920C RRRRR ; ######### : ST_X,R R>(X) ; : R>(X+) 920D RRRRR ; ######### : ST_X+,R R>(X+) ; : R>(-X) 920E RRRRR ; ######### : ST_-X,R R>(-X) ; : R>(Y) 8208 RRRRR ; ######### : ST_Y,R R>(Y) ; : R>(Y+) 9209 RRRRR ; ######### : ST_Y+,R R>(Y+) ; : R>(-Y) 920A RRRRR ; ######### : ST_-Y,R R>(-Y) ; : R>(Z) 8200 RRRRR ; ######### : ST_Z,R R>(Z) ; : R>(Z+) 9201 RRRRR ; ######### : ST_Z+,R R>(Z+) ; : R>(-Z) 9202 RRRRR ; ######### : ST_-Z,R R>(-Z) ; \ ......................................... \ 18 1Q2Q5D3Q : (Y+Q)>R 8008 \ Q. QQ.D DDDD .QQQ (Z+Q)>R 8000 : Q.QQ.DDDDD.QQQ ( Q D ? ... ) >R SWAP 2DUP 0 3F CHECK.Q.RANGE 0 1F CHECK.R.RANGE DUP 20 AND 100 * SWAP 1F AND 8 /MOD 400 * OR OR SWAP 10 * OR R> OR FLIPP ,' ; : (Y+Q)>R 8008 Q.QQ.DDDDD.QQQ ; ######### : LDD_R,Y+Q (Y+Q)>R ; : (Z+Q)>R 8000 Q.QQ.DDDDD.QQQ ; ######### : LDD_R,Z+Q (Z+Q)>R ; \ ......................................... \ 19. 1Q2Q5R3Q : R>(Y+Q) 8208 \ Q. QQ.R RRRR .QQQ R>(Z+Q) 8200 : Q.QQ.RRRRR.QQQ ( R Q ? ... ) >R 2DUP 0 3F CHECK.Q.RANGE 0 1F CHECK.R.RANGE DUP 20 AND 100 * SWAP 1F AND 8 /MOD 400 * OR OR SWAP 10 * OR R> OR FLIPP ,' ; : R>(Y+Q) 8208 Q.QQ.RRRRR.QQQ ; ######### : STD_Y+Q,R R>(Y+Q) ; : R>(Z+Q) 8200 Q.QQ.RRRRR.QQQ ; ######### : STD_Z+Q,R R>(Z+Q) ; \ ......................................... : C=0 ( ... ) 9488 FLIPP ,' ; ######### : CLC C=0 ; : Z=0 ( ... ) 9498 FLIPP ,' ; ######### : CLZ Z=0 ; : N=0 ( ... ) 94A8 FLIPP ,' ; ######### : CLN N=0 ; : V=0 ( ... ) 94B8 FLIPP ,' ; ######### : CLV V=0 ; : S=0 ( ... ) 94C8 FLIPP ,' ; ######### \ : CLS S=0 ; : H=0 ( ... ) 94D8 FLIPP ,' ; ######### : CLH H=0 ; : T=0 ( ... ) 94E8 FLIPP ,' ; ######### : CLT T=0 ; : I=0 ( ... ) 94F8 FLIPP ,' ; ######### : CLI I=0 ; \ ......................................... \ : CP?? ( D R ? ... ) >R \ 0 1F CHECK.R.RANGE 0 1F CHECK.D.RANGE \ RDDDDDRRRR R> OR FLIPP ,' ; \ ......................................... : CALL>Z ( ADDR'... ) 9505 FLIPP ,' ; ######### : ICALL CALL>Z ; : JMP>Z ( ADDR'... ) 9405 FLIPP ,' ; ######### : IJMP JMP>Z ; \ ......................................... : (#)>R ( # R ... ) \ LDS DUP 0 1F CHECK.D.RANGE \ OVER 0 FFFF CHECK.#.RANGE 10 * 9000 OR ,' ,' ; ######### \ ......................................... : (Z)>R0 ( ... ) 95C8 ,' ; ######### : LPM (Z)>R0 ; : NOP ( ... ) 0 ,' ; ######### \ : WDR ( ... ) 95A8 ,' ; ######### : WDT=0 WDR ; : RET ( ... ) 9508 ,' ; ######### \ : RETI ( ... ) 9518 ,' ; ######### \ : C=1 ( ... ) 9408 ,' ; ######### : SEC C=1 ; : H=1 ( ... ) 9458 ,' ; ######### : SEI H=1 ; : I=1 ( ... ) 9478 ,' ; ######### : SEH I=1 ; : N=1 ( ... ) 9428 ,' ; ######### : SEN N=1 ; : S=1 ( ... ) 9448 ,' ; ######### : SES S=1 ; : T=1 ( ... ) 9468 ,' ; ######### : SET T=1 ; : V=1 ( ... ) 9438 ,' ; ######### : SEV V=1 ; : Z=1 ( ... ) 9418 ,' ; ######### : SEZ Z=1 ; : SLEEP ( ... ) 9588 ,' ; ######### \ : R>(#) ( R # ... ) SWAP 10 * 9200 OR ,' SWAP ,' ; : STS R>(#) ; \ : SWAPR ( R ... ) DUP 0 1F CHECK.D.RANGE 10 * 9402 OR ,' ; ######### \ .......................................... CREATE IF'FLAG=X.NEST.LEVEL 40 ALLOT : IF'X??? ( X... ) HERE' SWAP ,' ; : IF'C=1 ( ... ) F400 IF'X??? ; ############ : IF'C=0 ( ... ) F000 IF'X??? ; ############ : IF'Z=1 ( ... ) F401 IF'X??? ; ############ : IF'Z=0 ( ... ) F001 IF'X??? ; ############ : IF'N=1 ( ... ) F402 IF'X??? ; ############ : IF'N=0 ( ... ) F002 IF'X??? ; ############ : IF'V=1 ( ... ) F403 IF'X??? ; ############ : IF'V=0 ( ... ) F003 IF'X??? ; ############ : IF'S=1 ( ... ) F404 IF'X??? ; ############ : IF'S=0 ( ... ) F004 IF'X??? ; ############ : IF'H=1 ( ... ) F405 IF'X??? ; ############ : IF'H=0 ( ... ) F005 IF'X??? ; ############ : IF'T=1 ( ... ) F406 IF'X??? ; ############ : IF'T=0 ( ... ) F006 IF'X??? ; ############ : IF'I=1 ( ... ) F407 IF'X??? ; ############ : IF'I=0 ( ... ) F007 IF'X??? ; ############ : IF'RB=0 RB=0? HERE' 1234 ,' ; : IF'RB=1 RB=1? HERE' 1234 ,' ; : IF'PB=0 PB=0? HERE' 1234 ,' ; : IF'PB=1 PB=1? HERE' 1234 ,' ; : IF'R=R R:R IF'Z=1 ; : IF'R>=R R:R IF'C=0 ; : IF'R=>R IF'R>=R ; : IF'RR R:R IF'Z=0 ; \ : IF'R>R C=1 R:RC IF'C=0 ; \ : IF'R<=R C=1 R:RC IF'C=1 ; : IF'R==# R:# IF'C=0 ; : IF'R=># IF'R>=# ; : IF'R<# R:# IF'C=1 ; : IF'R<># R:# IF'Z=0 ; \ : IF'R># C=1 R:RC IF'C=0 ; \ : IF'R<=# C=1 R:RC IF'C=1 ; : IF'R=<# IF'R<=# ; : IF'R=0 0 R:# IF'Z=1 ; : IF'R=A TEMP1 R:R IF'Z=1 ; : IF'R>=A TEMP1 R:R IF'C=0 ; : IF'R=>A IF'R>=A ; : IF'RA TEMP1 R:R IF'Z=0 ; \ : IF'R>A TEMP1 C=1 R:RC IF'C=0 ; \ : IF'R<=A TEMP1 C=1 R:RC IF'C=1 ; : IF'R==R TEMP1 SWAP R:R IF'C=0 ; : IF'A=>R IF'A>=R ; : IF'AR TEMP1 SWAP R:R IF'Z=0 ; \ : IF'A>R TEMP1 SWAP C=1 R:RC IF'C=0 ; \ : IF'A<=R TEMP1 SWAP C=1 R:RC IF'C=1 ; : IF'R==# TEMP1 SWAP R:# IF'C=0 ; : IF'A=># IF'A>=# ; : IF'A<# TEMP1 SWAP R:# IF'C=1 ; : IF'A<># TEMP1 SWAP R:# IF'Z=0 ; \ : IF'A># TEMP1 SWAP C=1 R:RC IF'C=0 ; \ : IF'A<=# TEMP1 SWAP C=1 R:RC IF'C=1 ; : IF'R=R HERE' R@ 1+ - DUP -40 3F CHECK.#.RANGE IF.IS.AHEAD? @ IF 8 * THEN R@ @' OR R> !' -1 IF.IS.AHEAD? ! ; ############ : THEN' >R HERE' R@ 1+ - DUP -40 3F CHECK.#.RANGE R@ @' 1234 = IF 0FFF AND C000 OR ELSE IF.IS.AHEAD? @ IF 8 * THEN R@ @' OR THEN R> !' -1 IF.IS.AHEAD? ! ; ############ : ENDIF' THEN' ; : ELSE' HERE' >R C000 ,' >R HERE' 1- R@ - 8 * R@ @' OR R> !' 0 IF.IS.AHEAD? ! R> ; ############ : ELSE' HERE' >R C000 ,' >R HERE' 1- R@ - DUP -40 3F CHECK.#.RANGE 8 * R@ @' OR R> !' 0 IF.IS.AHEAD? ! R> ; ############ : ELSE' HERE' 1234 ,' SWAP THEN' ; : BEGIN' HERE' ; ############ : AGAIN' RJMP ; \ HERE' 1+ - 0FFF AND C000 OR ,' ; ############ : REPEAT' SWAP HERE' - 1- 0FFF AND C000 OR ,' >R HERE' R@ - 1- DUP -40 3F CHECK.#.RANGE 8 * R@ @' OR R> !' ; ############ : REPEAT' SWAP AGAIN' THEN' ; : WHILE'X??? ( ?... ) HERE' SWAP ,' ; : WHILE'C=1 ( ... ) F400 WHILE'X??? ; ############ : WHILE'C=0 ( ... ) F000 WHILE'X??? ; ############ : WHILE'Z=1 ( ... ) F401 WHILE'X??? ; ############ : WHILE'Z=0 ( ... ) F001 WHILE'X??? ; ############ : WHILE'N=1 ( ... ) F402 WHILE'X??? ; ############ : WHILE'N=0 ( ... ) F002 WHILE'X??? ; ############ : WHILE'V=1 ( ... ) F403 WHILE'X??? ; ############ : WHILE'V=0 ( ... ) F003 WHILE'X??? ; ############ : WHILE'S=1 ( ... ) F404 WHILE'X??? ; ############ : WHILE'S=0 ( ... ) F004 WHILE'X??? ; ############ : WHILE'H=1 ( ... ) F405 WHILE'X??? ; ############ : WHILE'H=0 ( ... ) F005 WHILE'X??? ; ############ : WHILE'T=1 ( ... ) F406 WHILE'X??? ; ############ : WHILE'T=0 ( ... ) F006 WHILE'X??? ; ############ : WHILE'I=1 ( ... ) F407 WHILE'X??? ; ############ : WHILE'I=0 ( ... ) F007 WHILE'X??? ; ############ : WHILE'RB=0 RB=0? HERE' 1234 ,' ; : WHILE'RB=1 RB=1? HERE' 1234 ,' ; : WHILE'PB=0 PB=0? HERE' 1234 ,' ; : WHILE'PB=1 PB=1? HERE' 1234 ,' ; : WHILE'R=R R:R WHILE'Z=1 ; : WHILE'R>=R R:R WHILE'C=0 ; : WHILE'R=>R WHILE'R>=R ; : WHILE'RR R:R WHILE'Z=0 ; \ : WHILE'R>R C=1 R:RC WHILE'C=0 ; \ : WHILE'R<=R C=1 R:RC WHILE'C=1 ; : WHILE'R==# R:# WHILE'C=0 ; : WHILE'R=># WHILE'R>=# ; : WHILE'R<# R:# WHILE'C=1 ; : WHILE'R<># R:# WHILE'Z=0 ; \ : WHILE'R># C=1 R:RC WHILE'C=0 ; \ : WHILE'R<=# C=1 R:RC WHILE'C=1 ; : WHILE'R=<# WHILE'R<=# ; : WHILE'R=0 0 R:# WHILE'Z=1 ; : WHILE'R=A TEMP1 R:R WHILE'Z=1 ; : WHILE'R>=A TEMP1 R:R WHILE'C=0 ; : WHILE'R=>A WHILE'R>=A ; : WHILE'RA TEMP1 R:R WHILE'Z=0 ; \ : WHILE'R>A TEMP1 C=1 R:RC WHILE'C=0 ; \ : WHILE'R<=A TEMP1 C=1 R:RC WHILE'C=1 ; : WHILE'R==R TEMP1 SWAP R:R WHILE'C=0 ; : WHILE'A=>R WHILE'A>=R ; : WHILE'AR TEMP1 SWAP R:R WHILE'Z=0 ; \ : WHILE'A>R TEMP1 SWAP C=1 R:RC WHILE'C=0 ; \ : WHILE'A<=R TEMP1 SWAP C=1 R:RC WHILE'C=1 ; : WHILE'R==# TEMP1 SWAP R:# WHILE'C=0 ; : WHILE'A=># WHILE'A>=# ; : WHILE'A<# TEMP1 SWAP R:# WHILE'C=1 ; : WHILE'A<># TEMP1 SWAP R:# WHILE'Z=0 ; \ : WHILE'A># TEMP1 SWAP C=1 R:RC WHILE'C=0 ; \ : WHILE'A<=# TEMP1 SWAP C=1 R:RC WHILE'C=1 ; : WHILE'R=R HERE' 1+ - DUP -40 3F CHECK.#.RANGE DUP 0< IF 7F AND THEN 8 * R> OR ,' ; : UNTIL'C=1 ( ... ) F400 UNTIL'X??? ; ############ : UNTIL'C=0 ( ... ) F000 UNTIL'X??? ; ############ : UNTIL'Z=1 ( ... ) F401 UNTIL'X??? ; ############ : UNTIL'Z=0 ( ... ) F001 UNTIL'X??? ; ############ : UNTIL'N=1 ( ... ) F402 UNTIL'X??? ; ############ : UNTIL'N=0 ( ... ) F002 UNTIL'X??? ; ############ : UNTIL'V=1 ( ... ) F403 UNTIL'X??? ; ############ : UNTIL'V=0 ( ... ) F003 UNTIL'X??? ; ############ : UNTIL'S=1 ( ... ) F404 UNTIL'X??? ; ############ : UNTIL'S=0 ( ... ) F004 UNTIL'X??? ; ############ : UNTIL'H=1 ( ... ) F405 UNTIL'X??? ; ############ : UNTIL'H=0 ( ... ) F005 UNTIL'X??? ; ############ : UNTIL'T=1 ( ... ) F406 UNTIL'X??? ; ############ : UNTIL'T=0 ( ... ) F006 UNTIL'X??? ; ############ : UNTIL'I=1 ( ... ) F407 UNTIL'X??? ; ############ : UNTIL'I=0 ( ... ) F007 UNTIL'X??? ; ############ : UNTIL'RB=0 RB=0? RJMP ; : UNTIL'RB=1 RB=1? RJMP ; : UNTIL'PB=0 PB=0? RJMP ; : UNTIL'PB=1 PB=1? RJMP ; : UNTIL'R=R R:R UNTIL'Z=1 ; : UNTIL'R>=R R:R UNTIL'C=0 ; : UNTIL'R=>R UNTIL'R>=R ; : UNTIL'RR R:R UNTIL'Z=0 ; \ : UNTIL'R>R C=1 R:RC UNTIL'C=0 ; \ : UNTIL'R<=R C=1 R:RC UNTIL'C=1 ; : UNTIL'R==# R:# UNTIL'C=0 ; : UNTIL'R=># UNTIL'R>=# ; : UNTIL'R<# R:# UNTIL'C=1 ; : UNTIL'R<># R:# UNTIL'Z=0 ; \ : UNTIL'R># C=1 R:RC UNTIL'C=0 ; \ : UNTIL'R<=# C=1 R:RC UNTIL'C=1 ; : UNTIL'R=<# UNTIL'R<=# ; : UNTIL'R=0 0 R:# UNTIL'Z=1 ; : UNTIL'R=A TEMP1 R:R UNTIL'Z=1 ; : UNTIL'R>=A TEMP1 R:R UNTIL'C=0 ; : UNTIL'R=>A UNTIL'R>=A ; : UNTIL'RA TEMP1 R:R UNTIL'Z=0 ; \ : UNTIL'R>A TEMP1 C=1 R:RC UNTIL'C=0 ; \ : UNTIL'R<=A TEMP1 C=1 R:RC UNTIL'C=1 ; : UNTIL'R==R TEMP1 SWAP R:R UNTIL'C=0 ; : UNTIL'A=>R UNTIL'A>=R ; : UNTIL'AR TEMP1 SWAP R:R UNTIL'Z=0 ; \ : UNTIL'A>R TEMP1 SWAP C=1 R:RC UNTIL'C=0 ; \ : UNTIL'A<=R TEMP1 SWAP C=1 R:RC UNTIL'C=1 ; : UNTIL'R==# TEMP1 SWAP R:# UNTIL'C=0 ; : UNTIL'A=># UNTIL'A>=# ; : UNTIL'A<# TEMP1 SWAP R:# UNTIL'C=1 ; : UNTIL'A<># TEMP1 SWAP R:# UNTIL'Z=0 ; \ : UNTIL'A># TEMP1 SWAP C=1 R:RC UNTIL'C=0 ; \ : UNTIL'A<=# TEMP1 SWAP C=1 R:RC UNTIL'C=1 ; : UNTIL'R=R IF'C=1 R> R+ THEN' R+# ; \ C=1 if no carry : A+# 100 SWAP - 0FF AND A-# ; \ C=1 if no carry : A+#+C IF'C=1 A+ THEN' A+# ; \ C=1 if no carry \ VARIABLE MAX.DEFER.QUEUE.COUNT 10 MAX.DEFER.QUEUE.COUNT ! \ VARIABLE DEFER.QUEUE.COUNTER \ : >DEFER.QUEUE ( ADDR' CFA ... ) >R R@ @ C@' 2 = \ DEFER INSTRUCTION? \ 0 DEFER.QUEUE.COUNTER ! \ IF BEGIN R@ 4 + DEFER.QUEUE.COUNTER @ 4 * + @ -1 = \ IF R@ 4 + DEFER.QUEUE.COUNTER @ 4 * + ! -1 \ ELSE 1 DEFER.QUEUE.COUNTER +! \ DEFER.QUEUE.COUNTER @ MAX.DEFER.QUEUE.COUNT @ > \ IF ABORT" TOO MANY DEFERS CALLED " \ THEN 0 \ THEN \ UNTIL \ ELSE DROP \ THEN R> DROP ; \ : L: CREATE HERE' , DOES> @ ; \ : T: CREATE HERE' , DOES> @ FLIP 12 C,' ,' ; \ 8051 ONLY \ : T: CREATE HERE' , DOES> DUP >R @ FLIP 12 C,' DUP ,' R> >DEFER.QUEUE ; \ : T: CREATE HERE' , DOES> >R HERE' R@ @ FLIP 12 C,' ,' R> >DEFER.QUEUE ; \ : :T T: ; : ;T RET ; \ : :' T: ; : ;' RET ; \ :T T.START \ : DEFER' T: FFFF JMP ; : DEFER' T: HERE' RJMP MAX.DEFER.QUEUE.COUNT @ 0 DO -1 , LOOP ; VARIABLE END.PROGRAM.MEMORY F000 END.PROGRAM.MEMORY ! VARIABLE HERE'.DEFER' END.PROGRAM.MEMORY @ HERE'.DEFER' ! : DEFER" HERE' HERE'.DEFER' @ ORG' DEFER' -3 HERE'.DEFER' +! ORG' ; \ : IS' >R R@ 4 + @ FLIP ' DUP >R 4 + @ 1+ !' \ R> 8 + R> 4 + @ FLIP SWAP \ 0 DEFER.QUEUE.COUNTER ! \ BEGIN DUP DEFER.QUEUE.COUNTER @ 4 * + @ -1 = \ IF -1 \ ELSE 2DUP DEFER.QUEUE.COUNTER @ 4 * + @ 1+ !' \ 1 DEFER.QUEUE.COUNTER +! \ DEFER.QUEUE.COUNTER @ MAX.DEFER.QUEUE.COUNT @ > \ THEN \ UNTIL 2DROP ; : IS' >R R@ 4 + @ ( FLIP ) ' DUP >R 4 + @ ( 1+ ) DUP >R - 1- DUP -800 7FF CHECK.#.RANGE 0FFF AND C000 OR R> !' R> 8 + R> 4 + @ ( FLIP ) SWAP \ CFA1 )CFA2( 0 DEFER.QUEUE.COUNTER ! BEGIN DUP DEFER.QUEUE.COUNTER @ 4 * + @ -1 = IF -1 ELSE 2DUP DEFER.QUEUE.COUNTER @ 4 * + @ ( 1+ ) 2DUP - DUP -800 7FF CHECK.#.RANGE 0FFF AND D000 OR >R NIP R> 1- SWAP !' 1 DEFER.QUEUE.COUNTER +! DEFER.QUEUE.COUNTER @ MAX.DEFER.QUEUE.COUNT @ > THEN UNTIL 2DROP ; \ *************************************************************************** \ MICRO PARSER USED IN THE CASE OF ASSEMBLING CODE LIKE SUCH \ IF'PORT.A=R0 , P1=R2 , P1=P2 , P1.2=1 .... \ BASED ON THE "=" TO INDENTIFY OPERANDS ON BOTH SIDES OF "=" VARIABLE LEFT.n VARIABLE RIGHT.n : :P ; \ :P PORT.A ;P : ;P ; : :R ; \ :R R1 ;R : ;R ; : :B ; \ :B TX.PIN ;B : ;B ; : :RB ; \ :RB R1 1 ;RB : ;RB ; : :PB ; \ :PB P1 1 ;PB : ;PB ; : R.TYPE 11 ; : P.TYPE 22 ; : M.TYPE 33 ; : B.TYPE 44 ; : A.TYPE 55 ; : PB.TYPE 66 ; : RB.TYPE 77 ; : R.LEFT 11 ; : P.LEFT 22 ; : M.LEFT 33 ; : B.LEFT 44 ; : A.LEFT 55 ; : PB.LEFT 66 ; : RB.LEFT 77 ; : R.RIGHT 11 ; : P.RIGHT 22 ; : M.RIGHT 33 ; : B.RIGHT 44 ; : A.RIGHT 55 ; : PB.RIGHT 66 ; : RB.RIGHT 77 ; VARIABLE R/P/M... : :R CREATE DOES> @ R.TYPE R/P/M... ! ; : :P CREATE DOES> @ P.TYPE R/P/M... ! ; : :M CREATE DOES> @ R.TYPE R/P/M... ! ; : :B CREATE DOES> @ B.TYPE R/P/M... ! ; : :A CREATE DOES> @ R.TYPE R/P/M... ! ; : :PB CREATE DOES> @ PB.TYPE R/P/M... ! ; : :RB CREATE DOES> @ RB.TYPE R/P/M... ! ; : ;R , ; : ;P , ; : ;M , ; : ;B , ; : ;A , ; : ;PB , ; : ;RB , ; \ : ` CREATE LAST @ NAME> (FORGET) ; IMMEDIATE COMMENT: \ CODE >NUMBER ( ud addr len -- ud addr len ) : NUMBER? ( addr len -- d1 f1 ) FALSE TO DOUBLE? \ initially not a double # -1 TO DP-LOCATION OVER C@ [CHAR] - = \ MINUS PRECEEDED OVER 0> AND DUP>R \ POSITIVE NUMBER OF ADDR IF 1 /STRING \ TRUELY NEGATIVE NUMBER THEN DUP 0= \ LENGTH = 0 ? IF R>DROP 2DROP 0 0 FALSE _EXIT \ always return zero on failure THEN \ LENGTH IS NOT ZERO 0 0 2SWAP >NUMBER \ 0 0 ADDR LENGTH OVER C@ [CHAR] . = \ next char is a '.' OVER 0> AND \ more chars to look at IF DUP 1- TO DP-LOCATION 1 /STRING >NUMBER DUP 0= IF TRUE TO DOUBLE? \ mark as a double number THEN THEN NIP 0= R> IF >R DNEGATE R> THEN ; : ?MISSING ( f -- ) ABORT" is undefined" ; : (NUMBER) ( str -- d ) COUNT FIND-BUFFER PLACE FIND-BUFFER ?UPPERCASE COUNT NUMBER? 0= ?MISSING ; : PARSE ( char -- addr len ) >R SOURCE >IN @ /STRING 2DUP R> SCAN NIP - DUP 1+ >IN +! ; : .( ( -- ) [CHAR] ) PARSE TYPE ; IMMEDIATE : \ ( -- ) SOURCE >IN ! DROP ; IMMEDIATE : (FIND) ( str -- str FALSE | cfa flag ) DUP C@ 0= IF 0 _EXIT THEN CONTEXT BEGIN DUP @ \ while not at end of list WHILE DUP 2@ <> \ and not the same vocabulary \ as NEXT time IF OVER COUNT NAME-MAX-CHARS MIN 2 PICK @ _SEARCH-WORDLIST ?DUP IF 2SWAP 2DROP \ found it, so _EXIT \ we're done searching THEN THEN CELL+ \ step to next vocabulary REPEAT DROP FALSE ; : CAPS-FIND ( str -- str FALSE | cfa flag ) DUP COUNT FIND-BUFFER PLACE FIND-BUFFER ?UPPERCASE (FIND) DUP>R IF NIP ELSE DROP THEN R> ; DEFER FIND ( str -- str 0 | cfa flag ) : DEFINED ( -- str 0 | cfa flag ) BL WORD PARMFIND ; COMMENT; : STRING ( N ... ) CREATE DUP C, DUP ALLOT HERE SWAP BL FILL DOES> 1+ ; \ CREATE TEMP$ 20 ALLOT \ CREATE LEFT$ 20 ALLOT \ CREATE RIGHT$ 20 ALLOT 20 STRING TEMP$ 20 STRING LEFT$ 20 STRING RIGHT$ 20 STRING TEMP$' 20 STRING LEFT$' 20 STRING RIGHT$' VARIABLE RIGHT.n VARIABLE LEFT.n VARIABLE RIGHT.R/P/M... VARIABLE LEFT.R/P/M... VARIABLE "="? VARIABLE "?"? VARIABLE "?" VARIABLE ">"? VARIABLE "<"? VARIABLE ">="? VARIABLE "<="? VARIABLE "<>"? 1234 VALUE (LENGTH) 5678 VALUE (ADDR) : PARSE."=" ( NFA ... F ) 0 "="? ! \ ex. ' R12=3 PARSE."=" NFA-COUNT TO (LENGTH) TO (ADDR) (LENGTH) 0 DO (ADDR) I + C@ ASCII = = IF I LEFT$ C! (ADDR) LEFT$ 1+ I CMOVE (LENGTH) I - 1- RIGHT$ C! (ADDR) I + 1+ RIGHT$ 1+ (LENGTH) I - 1 - CMOVE -1 "="? ! LEAVE THEN LOOP "="? @ ( MISSING? ) ; \ VARIABLE (LENGTH) \ VARIABLE (ADDR) \ : PARSE."=" ( NFA ... F ) 0 "="? ! \ NFA-COUNT (LENGTH) ! (ADDR) ! \ (LENGTH) 0 \ DO (ADDR) @ I + C@ ASCII = = \ IF I LEFT$ C! \ (ADDR) @ LEFT$ 1+ I CMOVE \ (LENGTH) @ I - 1- RIGHT$ C! \ (ADDR) @ I + 1+ RIGHT$ 1+ (LENGTH) @ I - 1 - CMOVE -1 "="? ! LEAVE \ THEN \ LOOP "="? @ ( MISSING? ) ; \ : PARSE."?" ( NFA CHAR ... F ) "?" ! 0 "?"? ! LEFT$ 20 ERASE RIGHT$ 20 ERASE \ NFA-COUNT TO (LENGTH) TO (ADDR) \ (LENGTH) 0 \ DO (ADDR) I + C@ "?" @ = \ IF I LEFT$ C! \ (ADDR) LEFT$ 1+ I CMOVE \ (LENGTH) I - 1- RIGHT$ C! \ (ADDR) I + 1+ RIGHT$ 1+ (LENGTH) I - 1 - CMOVE -1 "?"? ! LEAVE \ THEN \ LOOP "?"? @ ; \ : PARSE."=" ( NFA ... F ) ASCII = PARSE."?" ; \ "?" @ "="? ! ; \ : PARSE."+" ( NFA ... F ) ASCII + PARSE."?" ; \ "?" @ ">"? ! ; \ : PARSE."-" ( NFA ... F ) ASCII - PARSE."?" ; \ "?" @ "<"? ! ; \ : PARSE."n" ( NFA ... F ) ASCII n PARSE."?" ; \ "?" @ "="? ! ; \ : PARSE."o" ( NFA ... F ) ASCII o PARSE."?" ; \ "?" @ "="? ! ; \ : PARSE."x" ( NFA ... F ) ASCII x PARSE."?" ; \ "?" @ ">"? ! ; \ : PARSE.":" ( NFA ... F ) ASCII : PARSE."?" ; \ "?" @ "<"? ! ; \ : PARSE.">" ( NFA ... F ) ASCII > PARSE."?" ; \ "?" @ ">"? ! ; \ : PARSE."<" ( NFA ... F ) ASCII < PARSE."?" ; \ "?" @ "<"? ! ; \ : PARSE."<>" ( NFA ... F ) ASCII <> PARSE."?" ; \ "?" @ "<>"? ! ; \ : PARSE.">=" ( NFA ... F ) ASCII >= PARSE."?" ; \ "?" @ ">="? ! ; \ : PARSE."<=" ( NFA ... F ) ASCII <= PARSE."?" ; \ "?" @ "<="? ! ; \ : PARSE."=>" ( NFA ... F ) ASCII => PARSE."?" ; \ "?" @ ">="? ! ; \ : PARSE."=<" ( NFA ... F ) ASCII =< PARSE."?" ; \ "?" @ "<="? ! ; : PARSE."?/??" ( ADDR$ CHAR ... F ) "?" ! 0 "?"? ! LEFT$ 1- 20 1 + ERASE RIGHT$ 1- 20 1+ ERASE ( NFA-COUNT ) DUP 1- C@ TO (LENGTH) TO (ADDR) "?" @ 100 > IF \ <> <= =< => >= (LENGTH) 0 ?DO (ADDR) I + 16@ "?" @ = IF I LEFT$ C! \ LENGTH (ADDR) LEFT$ 1+ I CMOVE (LENGTH) I - 2- RIGHT$ C! \ LENGTH (ADDR) I + 2+ RIGHT$ 1+ (LENGTH) I - 2- CMOVE -1 "?"? ! LEAVE THEN LOOP ELSE (LENGTH) 0 \ = > < : ?DO (ADDR) I + C@ "?" @ = IF I LEFT$ C! \ LENGTH (ADDR) LEFT$ 1+ I CMOVE (LENGTH) I - 1- RIGHT$ C! \ LENGTH (ADDR) I + 1+ RIGHT$ 1+ (LENGTH) I - 1- CMOVE -1 "?"? ! LEAVE THEN LOOP THEN "?"? @ ; : PARSE."?/??" ( ADDR$ CHAR ... F ) "?" ! 0 "?"? ! LEFT$ 1- 20 1+ BL FILL \ SET BLANK INITIALLY RIGHT$ 1- 20 1+ BL FILL ( NFA-COUNT ) DUP 1- C@ TO (LENGTH) TO (ADDR) "?" @ 100 > IF \ <> <= =< => >= (LENGTH) 0 ?DO (ADDR) I + 16@ "?" @ = IF I LEFT$ 1- C! \ LENGTH (ADDR) LEFT$ I CMOVE (LENGTH) I - 2- RIGHT$ 1- C! \ LENGTH (ADDR) I + 2+ RIGHT$ (LENGTH) I - 2- CMOVE -1 "?"? ! LEAVE THEN LOOP ELSE (LENGTH) 0 \ = > < : ?DO (ADDR) I + C@ "?" @ = IF I LEFT$ 1- C! \ LENGTH (ADDR) LEFT$ I CMOVE (LENGTH) I - 1- RIGHT$ 1- C! \ LENGTH (ADDR) I + 1+ RIGHT$ (LENGTH) I - 1- CMOVE -1 "?"? ! LEAVE THEN LOOP THEN "?"? @ ; VARIABLE OPERATOR.POSITION VARIABLE OPERATOR.BYTE.COUNT : PARSE."?/??" ( ADDR$ CHAR ... F ) "?" ! 0 "?"? ! LEFT$ 1- 20 1+ BL FILL \ SET BLANK INITIALLY RIGHT$ 1- 20 1+ BL FILL ( NFA-COUNT ) DUP 1- C@ TO (LENGTH) TO (ADDR) "?" @ 100 > IF \ <> <= =< => >= (LENGTH) 0 ?DO (ADDR) I + 16@ "?" @ = IF I LEFT$ 1- C! \ LENGTH (ADDR) LEFT$ I CMOVE (LENGTH) I - 2- RIGHT$ 1- C! \ LENGTH (ADDR) I + 2+ RIGHT$ (LENGTH) I - 2- CMOVE -1 "?"? ! I OPERATOR.POSITION ! 2 OPERATOR.BYTE.COUNT ! LEAVE THEN LOOP ELSE (LENGTH) 0 \ = > < : ?DO (ADDR) I + C@ "?" @ = IF I LEFT$ 1- C! \ LENGTH (ADDR) LEFT$ I CMOVE (LENGTH) I - 1- RIGHT$ 1- C! \ LENGTH (ADDR) I + 1+ RIGHT$ (LENGTH) I - 1- CMOVE -1 "?"? ! I OPERATOR.POSITION ! 1 OPERATOR.BYTE.COUNT ! LEAVE THEN LOOP THEN "?"? @ ; 20 STRING RIGHT$' 20 STRING LEFT$' : PARSE."?/??"' ( ADDR$ CHAR ... F ) "?" ! 0 "?"? ! LEFT$' 1- 20 1+ BL FILL \ SET BLANK INITIALLY RIGHT$' 1- 20 1+ BL FILL ( NFA-COUNT ) DUP 1- C@ TO (LENGTH) TO (ADDR) "?" @ 100 > IF \ <> <= =< => >= (LENGTH) 0 ?DO (ADDR) I + 16@ "?" @ = IF I LEFT$' 1- C! \ LENGTH (ADDR) LEFT$' I CMOVE (LENGTH) I - 2- RIGHT$' 1- C! \ LENGTH (ADDR) I + 2+ RIGHT$' (LENGTH) I - 2- CMOVE -1 "?"? ! ( I OPERATOR.POSITION ! 2 OPERATOR.BYTE.COUNT ! ) LEAVE THEN LOOP ELSE (LENGTH) 0 \ = > < : ?DO (ADDR) I + C@ "?" @ = IF I LEFT$' 1- C! \ LENGTH (ADDR) LEFT$' I CMOVE (LENGTH) I - 1- RIGHT$' 1- C! \ LENGTH (ADDR) I + 1+ RIGHT$' (LENGTH) I - 1- CMOVE -1 "?"? ! ( I OPERATOR.POSITION ! 1 OPERATOR.BYTE.COUNT ! ) LEAVE THEN LOOP THEN "?"? @ ; : PARSE."=" ( ADDR$ ... F ) ASCII = PARSE."?/??" ; \ "?" @ "="? ! ; : PARSE."+" ( ADDR$ ... F ) ASCII + PARSE."?/??" ; : PARSE."-" ( ADDR$ ... F ) ASCII - PARSE."?/??" ; : PARSE."n" ( ADDR$ ... F ) ASCII n UPC PARSE."?/??" ; : PARSE."o" ( ADDR$ ... F ) ASCII o UPC PARSE."?/??" ; : PARSE."x" ( ADDR$ ... F ) ASCII x UPC PARSE."?/??" ; : PARSE.":" ( ADDR$ ... F ) ASCII : PARSE."?/??" ; : PARSE.">" ( ADDR$ ... F ) ASCII > PARSE."?/??" ; : PARSE."<" ( ADDR$ ... F ) ASCII < PARSE."?/??" ; : PARSE."<>" ( ADDR$ ... F ) ASCII < ASCII > FLIP + PARSE."?/??" ; : PARSE.">=" ( ADDR$ ... F ) ASCII > ASCII = FLIP + PARSE."?/??" ; : PARSE."<=" ( ADDR$ ... F ) ASCII < ASCII = FLIP + PARSE."?/??" ; : PARSE."=>" ( ADDR$ ... F ) ASCII = ASCII > FLIP + PARSE."?/??" ; : PARSE."=<" ( ADDR$ ... F ) ASCII = ASCII < FLIP + PARSE."?/??" ; : PARSE.RELATIONAL.OPERATOR ( ADDR$ ... F ) DUP PARSE."<>" IF DROP -1 EXIT THEN DUP PARSE."=>" IF DROP -1 EXIT THEN DUP PARSE."=<" IF DROP -1 EXIT THEN DUP PARSE.">=" IF DROP -1 EXIT THEN DUP PARSE."<=" IF DROP -1 EXIT THEN DUP PARSE."=" IF DROP -1 EXIT THEN DUP PARSE."+" IF DROP -1 EXIT THEN DUP PARSE."-" IF DROP -1 EXIT THEN DUP PARSE."n" IF DROP -1 EXIT THEN DUP PARSE."o" IF DROP -1 EXIT THEN DUP PARSE."x" IF DROP -1 EXIT THEN DUP PARSE.":" IF DROP -1 EXIT THEN DUP PARSE.">" IF DROP -1 EXIT THEN DUP PARSE."<" IF DROP -1 EXIT THEN DROP 0 ; \ : A=R R>A ; : A?R ( ... ) "?" @ \ DUP ASCII < ASCII > + = IF DROP A<>R EXIT THEN \ DUP ASCII = ASCII > + = IF DROP A=>R EXIT THEN \ DUP ASCII = ASCII < + = IF DROP A= ASCII = + = IF DROP A>=R EXIT THEN \ DUP ASCII < ASCII = + = IF DROP A<=R EXIT THEN DUP ASCII = = IF DROP A=R EXIT THEN DUP ASCII + = IF DROP A+R EXIT THEN DUP ASCII - = IF DROP A-R EXIT THEN DUP ASCII n UPC = IF DROP AnR EXIT THEN DUP ASCII o UPC = IF DROP AoR EXIT THEN DUP ASCII x UPC = IF DROP AxR EXIT THEN DUP ASCII : = IF DROP A:R EXIT THEN \ DUP ASCII > = IF DROP A>R EXIT THEN \ DUP ASCII < = IF DROP A + = IF DROP A<># EXIT THEN \ DUP ASCII = ASCII > + = IF DROP A=># EXIT THEN \ DUP ASCII = ASCII < + = IF DROP A=<# EXIT THEN \ DUP ASCII > ASCII = + = IF DROP A>=# EXIT THEN \ DUP ASCII < ASCII = + = IF DROP A<=# EXIT THEN DUP ASCII = = IF DROP A=# EXIT THEN DUP ASCII + = IF DROP A+# EXIT THEN DUP ASCII - = IF DROP A-# EXIT THEN DUP ASCII n UPC = IF DROP An# EXIT THEN DUP ASCII o UPC = IF DROP Ao# EXIT THEN \ DUP ASCII x UPC = IF DROP Ax# EXIT THEN DUP ASCII : = IF DROP A:# EXIT THEN \ DUP ASCII > = IF DROP A># EXIT THEN \ DUP ASCII < = IF DROP A<# EXIT THEN DROP ; \ : R=A A>R ; \ : R+A DUP A+R A>R ; \ DUP A<->R DUP A+R A<->R \ : RoA DUP AoR A>R ; \ DUP A<->R DUP AoR A<->R \ : RnA DUP AnR A>R ; \ DUP A<->R DUP AnR A<->R \ : RxA DUP AxR A>R ; \ DUP A<->R DUP AxR A<->R \ : R=R A=R R=A ; \ : R+R A=R R+A ; \ : RoR A=R RoA ; \ : RnR A=R RnA ; \ : RxR A=R RxA ; : R=R SWAP R>R ; : R?R ( ... ) "?" @ \ DUP ASCII < ASCII > + = IF DROP R<>R EXIT THEN \ DUP ASCII = ASCII > + = IF DROP R=>R EXIT THEN \ DUP ASCII = ASCII < + = IF DROP R= ASCII = + = IF DROP R>=R EXIT THEN \ DUP ASCII < ASCII = + = IF DROP R<=R EXIT THEN DUP ASCII = = IF DROP R=R EXIT THEN DUP ASCII + = IF DROP R+R EXIT THEN \ DUP ASCII - = IF DROP R-R EXIT THEN DUP ASCII n UPC = IF DROP RnR EXIT THEN DUP ASCII o UPC = IF DROP RoR EXIT THEN DUP ASCII x UPC = IF DROP RxR EXIT THEN \ DUP ASCII : = IF DROP R:R EXIT THEN \ DUP ASCII > = IF DROP R>R EXIT THEN \ DUP ASCII < = IF DROP R + = IF DROP R<>A EXIT THEN \ DUP ASCII = ASCII > + = IF DROP R=>A EXIT THEN \ DUP ASCII = ASCII < + = IF DROP R= ASCII = + = IF DROP R>=A EXIT THEN \ DUP ASCII < ASCII = + = IF DROP R<=A EXIT THEN DUP ASCII = = IF DROP R=A EXIT THEN DUP ASCII + = IF DROP R+A EXIT THEN \ DUP ASCII - = IF DROP R-A EXIT THEN DUP ASCII n UPC = IF DROP RnA EXIT THEN DUP ASCII o UPC = IF DROP RoA EXIT THEN DUP ASCII x UPC = IF DROP RxA EXIT THEN DUP ASCII : = IF DROP R:A EXIT THEN \ DUP ASCII > = IF DROP R>A EXIT THEN \ DUP ASCII < = IF DROP R + = IF DROP R<># EXIT THEN \ DUP ASCII = ASCII > + = IF DROP R=># EXIT THEN \ DUP ASCII = ASCII < + = IF DROP R=<# EXIT THEN \ DUP ASCII > ASCII = + = IF DROP R>=# EXIT THEN \ DUP ASCII < ASCII = + = IF DROP R<=# EXIT THEN DUP ASCII = = IF DROP R=# EXIT THEN \ DUP ASCII + = IF DROP R+# EXIT THEN \ DUP ASCII - = IF DROP R-# EXIT THEN DUP ASCII n UPC = IF DROP Rn# EXIT THEN DUP ASCII o UPC = IF DROP Ro# EXIT THEN \ DUP ASCII x UPC = IF DROP Rx# EXIT THEN \ DUP ASCII : = IF DROP R:# EXIT THEN \ DUP ASCII > = IF DROP R># EXIT THEN \ DUP ASCII < = IF DROP R<# EXIT THEN DROP ; : PARSE.LEFT.R/P/M... ( CHAR ... F ) UPC >R R@ LEFT$ C@ = IF R> LEFT.R/P/M... ! -1 ELSE R> DROP 0 THEN ; : PARSE.LEFT.R ASCII R PARSE.LEFT.R/P/M... ; : PARSE.LEFT.P ASCII P PARSE.LEFT.R/P/M... ; : PARSE.LEFT.M ASCII M PARSE.LEFT.R/P/M... ; : PARSE.LEFT.B ASCII B PARSE.LEFT.R/P/M... ; : PARSE.LEFT.A ASCII A PARSE.LEFT.R/P/M... ; : PARSE.RIGHT.R/P/M... ( CHAR ... F ) UPC >R R@ RIGHT$ C@ = IF R> RIGHT.R/P/M... ! -1 ELSE R> DROP 0 THEN ; : PARSE.RIGHT.R ASCII R PARSE.RIGHT.R/P/M... ; : PARSE.RIGHT.P ASCII P PARSE.RIGHT.R/P/M... ; : PARSE.RIGHT.M ASCII M PARSE.RIGHT.R/P/M... ; : PARSE.RIGHT.B ASCII B PARSE.RIGHT.R/P/M... ; : PARSE.RIGHT.A ASCII A PARSE.RIGHT.R/P/M... ; \ CREATE NEWEST.NUMBER 4 ALLOT \ : PARSE.#/##.. ( ADDR ... N -1 / 0 ) >R R@ 1 NUMBER? \ IF NEWEST.NUMBER 2! R@ 2 NUMBER? \ IF NEWEST.NUMBER 2! R@ 3 NUMBER? \ IF NEWEST.NUMBER 2! R@ 4 NUMBER? \ IF NEWEST.NUMBER 2! R@ 5 NUMBER? \ IF ABORT" *** NO MORE THAN 4 DIGITS CAN BE ACCEPTED *** " \ ELSE 2DROP \ THEN \ ELSE 2DROP \ THEN \ ELSE 2DROP \ THEN \ ELSE 2DROP \ THEN R> DROP NEWEST.NUMBER @ -1 EXIT \ ELSE R> DROP 2DROP 0 \ THEN ; : PARSE.#/##.. ( ADDR ... N -1 / 0 ) \ STANDARD STRING, i.e. S= TYPE OF STRING ADDRESS DUP 6 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN DUP 5 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN DUP 4 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN DUP 3 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN DUP 2 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN 1 NUMBER? IF DROP -1 EXIT ELSE 2DROP THEN 0 ; : PARSE.#/##.. ( ADDR ... N -1 / 0 ) \ STANDARD STRING, i.e. S= TYPE OF STRING ADDRESS DUP 6 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN DUP 5 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN \ NUMBER USES NON-STANDARD DUP 4 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN \ WITH NO LENGTH DUP 3 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN \ DUP 2 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN \ DUP 1 NUMBER? IF ROT 2DROP -1 EXIT ELSE 2DROP THEN \ 1- FIND IF 8 + @ -1 ELSE DROP 0 THEN ; \ FIND USES 'COUNT' TYPE \ OF ADDRESS VARIABLE MATCH? : S=$? ( S1 S2 ... F ) \ S1 IS STANDARD STRING FORMAT. $2 CAN BE NO LENGTH \ 5 WORDS WORDS ONLY, NO 5 PRECEED IT SWAP DUP 1 - C@ BOUNDS -1 MATCH? ! DO I C@ OVER C@ <> IF 0 MATCH? ! LEAVE THEN LOOP 2DROP MATCH? @ ; : FIND.NEXT.NFA ( NFA1 ... NFA2 ) >R R@ R> C@ 1+ 4 / ( 1 + ) 4 * 10 + - ; : FNN FIND.NEXT.NFA ; : MATCH.NAME ( ADDR$ ... F ) LAST @ 500 0 ( REGISTER ) \ VOCABULARY REGISTER DO >R DUP R@ NFA-COUNT S=$? IF LEAVE THEN R> FIND.NEXT.NFA SWAP LOOP ; \ FORTH \ : PARSE."R12?R34/5/A.." ( ... ) \ PARSE.LEFT.A IF PARSE.RIGHT.R \ IF RIGHT$ 1+ PARSE.#/##.. \ IF A?R EXIT \ THEN \ ELSE RIGHT$ PARSE.#/##.. \ IF A?# EXIT \ THEN \ THEN \ THEN \ PARSE.LEFT.R IF LEFT$ 1+ PARSE.#/##.. \ IF PARSE.RIGHT.R \ IF RIGHT$ 1+ PARSE.#/##.. \ IF R?R EXIT \ R12=R34 \ THEN \ ELSE \ PARSE.RIGHT.A \ IF R?A EXIT \ R12=A \ ELSE RIGHT$ PARSE.#/##.. \ IF R?# EXIT \ R12=5 , 0A \ THEN \ THEN \ THEN \ THEN \ THEN ; : PARSE.#/##..' ( ADDR$ N ... # -1 /0 ) \ S= TYPE OF ADDRESS >R DUP R@ + TEMP$' 20 R@ - CMOVE 1- C@ R> - TEMP$' 1- C! TEMP$' PARSE.#/##.. ; : PARSE."R12?R34/5/A.." ( ... ) PARSE.LEFT.A IF PARSE.RIGHT.R IF RIGHT$ 1 PARSE.#/##..' IF A?R EXIT THEN ELSE RIGHT$ PARSE.#/##.. IF A?# EXIT THEN THEN THEN PARSE.LEFT.R IF LEFT$ 1 PARSE.#/##..' IF PARSE.RIGHT.R IF RIGHT$ 1 PARSE.#/##..' IF R?R EXIT \ R12?R34 THEN ELSE PARSE.RIGHT.A IF R?A EXIT \ R12?A ELSE RIGHT$ PARSE.#/##.. IF R?# EXIT \ R12?5 , 0A THEN THEN THEN THEN THEN ABORT" *** no instruction is generated for this: " TEMP$ 1- COUNT TYPE ." *** " cr ; : CFA>NUMBER 123456 ; : EXECUTE.SPECIAL ( CFA ... ) EXECUTE ; : NUMBER?' ( STR ... F ) COUNT FIND-BUFFER PLACE FIND-BUFFER ?UPPERCASE COUNT NUMBER? 0= ; : ?.IN.THE.1ST.CHAR? ( $ CHAR ... F ) -ROT DROP 1 + C@ UPC = ; : R.IN.THE.1ST.CHAR? ASCII R UPC ?.IN.THE.1ST.CHAR? ; : P.IN.THE.1ST.CHAR? ASCII P UPC ?.IN.THE.1ST.CHAR? ; : M.IN.THE.1ST.CHAR? ASCII M UPC ?.IN.THE.1ST.CHAR? ; : B.IN.THE.1ST.CHAR? ASCII B UPC ?.IN.THE.1ST.CHAR? ; : A.IN.THE.1ST.CHAR? ASCII A UPC ?.IN.THE.1ST.CHAR? ; : ` CREATE LAST @ PARSE."=" \ ` PORT12=34 IF LEFT$ CAPS-FIND ( CFA -1/ STR 0 ) \ ?MISSING IF EXECUTE.SPECIAL ( CFA>NUMBER ) RIGHT$ CAPS-FIND ( SEE IF IT IS INSTRUCTION OR NUMBER ) IF EXECUTE.SPECIAL ( INSTRUCTION ) \ CFA>NUMBER ELSE DROP RIGHT$ (NUMBER) DROP THEN THEN ELSE THEN ; IMMEDIATE \ (FORGET) ; IMMEDIATE VARIABLE (BIT) : COMBINE.LEFT.RIGHT.OPERAND ( ... ) LEFT.n @ FLIP RIGHT.n @ + CASE \ P.TYPE FLIP P.TYPE + OF P=P ENDOF \ P.TYPE FLIP R.TYPE + OF P=R ENDOF R.TYPE FLIP R.TYPE + OF R=R ENDOF \ R=R \ R.TYPE FLIP P.TYPE + OF R=P ENDOF \ PB.TYPE FLIP PB.TYPE + OF PB=PB ENDOF \ PB.TYPE FLIP RB.TYPE + OF PB=RB ENDOF \ RB.TYPE FLIP PB.TYPE + OF RB=PB ENDOF \ RB.TYPE FLIP RB.TYPE + OF RB=RB ENDOF R.TYPE FLIP OF R=# ENDOF \ RB.TYPE FLIP OF (BIT) @ IF RB=1 ELSE RB=0 THEN ENDOF ENDCASE ; : R?R ( "?" ... ) CASE "="? @ OF R=R ENDOF ">"? @ OF R=R ENDOF "<"? @ OF R=R ENDOF ENDCASE ; : COMBINE.LEFT.RIGHT.OPERAND' ( ... ) LEFT.n @ FLIP RIGHT.n @ + CASE \ P.LEFT FLIP P.RIGHT + OF P=P ENDOF \ P.LEFT FLIP R.RIGHT + OF P=R ENDOF R.LEFT FLIP R.RIGHT + OF R=R ENDOF \ R=R \ R.LEFT FLIP P.RIGHT + OF R=P ENDOF \ PB.LEFT FLIP PB.RIGHT + OF PB=PB ENDOF \ PB.LEFT FLIP RB.RIGHT + OF PB=RB ENDOF \ RB.LEFT FLIP PB.RIGHT + OF RB=PB ENDOF \ RB.LEFT FLIP RB.RIGHT + OF RB=RB ENDOF R.LEFT FLIP OF R=# ENDOF \ RB.LEFT FLIP OF (BIT) @ IF RB=1 ELSE RB=0 THEN ENDOF ENDCASE ; : ` CREATE LAST @ PARSE."=" 0 LEFT.n ! 0 RIGHT.n ! \ ` PORT12=34 IF LEFT$ CAPS-FIND ( CFA -1/ STR 0 ) \ ?MISSING IF EXECUTE.SPECIAL R/P/M... @ LEFT.n ! ( CFA>NUMBER ) RIGHT$ CAPS-FIND ( SEE IF IT IS INSTRUCTION OR NUMBER ) IF EXECUTE.SPECIAL R/P/M... @ RIGHT.n ! ( INSTRUCTION ) \ CFA>NUMBER ELSE DROP RIGHT$ (NUMBER) 0 RIGHT.n ! DROP DUP IF 1 ELSE 0 THEN (BIT) ! THEN THEN ELSE 1234 ?MISSING THEN COMBINE.LEFT.RIGHT.OPERAND ; IMMEDIATE \ (FORGET) ; IMMEDIATE : TEMPn$>TEMP$ ( ADDR$ ... ) >R R@ C@ 1- TEMP$ C! R@ 1+ TEMP$ 1+ R> C@ 1 - CMOVE ; : `` -1 LEFT.n ! -1 RIGHT.n ! -1 LEFT.R/P/M... ! -1 RIGHT.R/P/M... ! \ ` PORT12=34 CREATE LAST @ >R R@ PARSE."=" R@ PARSE.">" OR R> PARSE."<" OR ( R@ PARSE."<>" OR R@ PARSE.">=" OR R> PARSE."<=" OR ) IF LEFT$ CAPS-FIND ( CFA -1/ STR 0 ) \ ?MISSING IF EXECUTE.SPECIAL R/P/M... @ LEFT.R/P/M... ! LEFT.n ! RIGHT$ CAPS-FIND ( SEE IF IT IS INSTRUCTION OR NUMBER ) IF EXECUTE.SPECIAL R/P/M... @ RIGHT.R/P/M... ! RIGHT.n ! ELSE PARSE.RIGHT.R PARSE.RIGHT.P PARSE.RIGHT.M PARSE.RIGHT.B PARSE.LEFT.A OR OR OR OR IF R/P/M... @ RIGHT.R/P/M... ! RIGHT$ TEMPn$>TEMP$ TEMP$ (NUMBER) DROP RIGHT.n ! \ R ELSE 0 RIGHT.R/P/M... ! RIGHT$ (NUMBER) DROP RIGHT.n ! \ # THEN DROP DUP IF 1 ELSE 0 THEN (BIT) ! THEN ELSE PARSE.LEFT.R PARSE.LEFT.P PARSE.LEFT.M PARSE.LEFT.B PARSE.LEFT.A OR OR OR OR IF R/P/M... @ LEFT.R/P/M... ! LEFT$ TEMPn$>TEMP$ TEMP$ (NUMBER) DROP LEFT.n ! \ STRING WITHOUT R/P/.. RIGHT$ CAPS-FIND ( SEE IF IT IS INSTRUCTION OR NUMBER ) IF EXECUTE.SPECIAL R/P/M... @ RIGHT.R/P/M... ! ( INSTRUCTION ) \ CFA>NUMBER ELSE PARSE.RIGHT.R PARSE.RIGHT.P PARSE.RIGHT.M PARSE.RIGHT.B PARSE.RIGHT.A OR OR OR OR IF R/P/M... @ RIGHT.R/P/M... ! RIGHT$ TEMPn$>TEMP$ TEMP$ (NUMBER) DROP RIGHT.n ! \ R ELSE 0 RIGHT.R/P/M... ! RIGHT$ (NUMBER) DROP RIGHT.n ! \ # THEN DROP DUP IF 1 ELSE 0 THEN (BIT) ! THEN ELSE 1234 ?MISSING THEN THEN ELSE 1234 ?MISSING THEN COMBINE.LEFT.RIGHT.OPERAND' ; IMMEDIATE \ (FORGET) ; IMMEDIATE :R PORT12 12 ;R \ : PORT12=34 ; \ ****************************************************************************** \ infix \ ****************************************************************************** \ : IF' A = 12 \ : UNTIL' Rn > Rn \ : WHILE' RB < 0 \ PB <> >< 1 \ => >= FF \ =< <= A VARIABLE MATCH? : PARSE."IF'" ( ... F ) -1 MATCH? ! S" IF'" 0 DO DUP I + C@ LEFT$ 1 + I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP DROP MATCH? @ ; : PARSE.LEFT.SIDE."IF'A=" ( ... F ) -1 MATCH? ! S" IF'A=" 0 DO DUP I + C@ LEFT$ 1 + I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP DROP MATCH? @ ; : PARSE.RIGHT.SIDE."R" ( ... F ) -1 MATCH? ! S" R" 0 DO DUP I + C@ RIGHT$ 1 + I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP DROP MATCH? @ ; : PARSE.RIGHT.SIDE."A_" ( ... F ) -1 MATCH? ! S" A " 0 DO DUP I + C@ RIGHT$ 1 + I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP DROP MATCH? @ ; : PARSE.LEFT.SIDE."IF'R" ( ... F ) -1 MATCH? ! S" IF'R" 0 DO DUP I + C@ RIGHT$ 1 + I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP DROP MATCH? @ ; : EXTRACT.RIGHT.SIDE.# ( ... # -1 / 0 ) RIGHT$ NUMBER? ; : EXTRACT.RIGHT.SIDE.0/1 ( ... # -1 / 0 ) RIGHT$ NUMBER? IF CASE 0 OF 0 -1 ENDOF 1 OF 1 -1 ENDOF DROP 0 ENDCASE ELSE 0 THEN ; : EXTRACT.RIGHT.SIDE.n.OF.R ( ... n -1 / 0 ) RIGHT$ 1 - >R 1 + R> NUMBER? ; : EXTRACT.LEFT.SIDE.n.IN.IF'Rn= ( ... n -1 / 0 ) LEFT$ 5 - >R 5 + R> NUMBER? ; : EXTRACT.LEFT.SIDE.n.b.IN.IF'Rn.b= ( ... n b -1 / 0 ) \ IF'R1234.5 LEFT$ 6 + 4 0 0 MATCH? ! DO DUP I + C@ ASCII . = IF I -1 MATCH? ! LEAVE THEN \ R1234.5 LOOP MATCH? @ IF LEFT$ 5 + OVER 1+ NUMBER? ( n ) IF LEFT$ 7 + + 1 NUMBER? ( b ) IF ( n b ) -1 ELSE DROP 0 THEN ELSE 0 THEN ELSE 0 THEN ; \ : ` CREATE LAST @ PARSE."=" \ ` PORT12=34 \ IF LEFT$ CAPS-FIND ( CFA -1/ STR 0 ) \ ?MISSING \ IF EXECUTE.SPECIAL ( CFA>NUMBER ) \ RIGHT$ CAPS-FIND ( SEE IF IT IS INSTRUCTION OR NUMBER ) \ IF EXECUTE.SPECIAL ( INSTRUCTION ) \ CFA>NUMBER \ ELSE DROP RIGHT$ (NUMBER) DROP \ THEN \ THEN \ ELSE \ THEN ; IMMEDIATE \ (FORGET) ; IMMEDIATE \ \ : INFIX.PARSE ( ... ) \ PARSE."=" \ IF PARSE."IF'" \ IF PARSE.LEFT.SIDE."IF'A=" \ IF'A= \ IF EXTRACT.RIGHT.SIDE.# \ IF IF'A=# \ 1 IF'A=# \ ELSE PARSE.RIGHT.SIDE."R" \ IF EXTRACT.RIGHT.SIDE.n.OF.R \ 1 IF'A=R \ IF \ IF'A=R \ THEN \ THEN \ THEN \ ELSE PARSE.LEFT.SIDE."IF'R" \ IF'R= \ IF EXTRACT.LEFT.SIDE.n.IN.IF'Rn= \ IF EXTRACT.RIGHT.SIDE.# \ IF \ IF'R=# \ 1 2 IF'R=# \ ELSE PARSE.RIGHT.SIDE."A_" \ IF \ IF'R=A \ 1 IF'R=A \ ELSE PARSE.RIGHT.SIDE."R" \ IF EXTRACT.RIGHT.SIDE.n.OF.R \ IF \ IF'R=R \ 1 2 IF'R=R \ THEN \ THEN \ THEN \ THEN \ ELSE EXTRACT.LEFT.SIDE.n.b.IN.IF'Rn.b= \ 1 2 IF'RB= \ IF EXTRACT.RIGHT.SIDE.0/1 \ IF IF IF'RB=1 \ 1 2 IF'RB=1 \ ELSE IF'RB=0 \ 1 2 IF'RB=0 \ THEN \ ELSE 2DROP \ THEN \ THEN \ THEN \ THEN \ THEN \ THEN \ THEN ; 20 STRING TEMP$.EXCLUDING.OPERAND \ IF'R12=R34 --> IF'R=R : COMPARE.STRING ( ADDR$ ADDR LENGTH ... F ) >R -1 MATCH? ! SWAP R> 0 DO OVER I + C@ OVER I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP 2DROP MATCH? @ ; : COMPARE.WITH.TEMP$ ( ADDR LENGTH ... F ) \ ==> COMPARE.WITH.TEMP$ >R -1 MATCH? ! TEMP$ R> 0 DO OVER I + C@ OVER I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP 2DROP MATCH? @ ; : COMPARE.WITH.TEMP$' ( PARSE.WITH.TEMP$ ) ( ADDR LENGTH ... F ) >R -1 MATCH? ! TEMP$.EXCLUDING.OPERAND R> 0 DO OVER I + C@ OVER I + C@ <> IF 0 MATCH? ! LEAVE THEN LOOP 2DROP MATCH? @ ; : COMPARE.WITH.TEMP$.OPERAND ( ADDR LENGTH n ... F ) >R \ IF'R12=R34 --> IF'R=R --> LENGTH=6 TEMP$.EXCLUDING.OPERAND 20 BL FILL \ 1234 n=4 LEFT$ TEMP$.EXCLUDING.OPERAND R@ CMOVE "?" @ TEMP$.EXCLUDING.OPERAND R@ + OPERATOR.BYTE.COUNT @ 1 = IF C! ELSE 16! THEN RIGHT$ TEMP$.EXCLUDING.OPERAND R> + OPERATOR.BYTE.COUNT @ + 2 CMOVE COMPARE.WITH.TEMP$' ; : SHOW.ALL.STRINGS ( ... ) CR ." OPERATOR.POSITION :" OPERATOR.POSITION ? CR ." OPERATOR.BYTE.COUNT :" OPERATOR.BYTE.COUNT ? CR ." TEMP$ " TEMP$ 20 DUMP CR ." LEFT$ " LEFT$ 20 DUMP CR ." RIGHT$ " RIGHT$ 20 DUMP CR ." TEMP$.EXCLUDING.OPERAND " TEMP$.EXCLUDING.OPERAND 20 DUMP ; : SAS SHOW.ALL.STRINGS ; \ --------------------------------------------------------------------- : PARSE."IF'A<>R" ( ... F ) S" IF'A<>R" COMPARE.WITH.TEMP$ ; : PARSE."IF'A<=R" ( ... F ) S" IF'A<=R" COMPARE.WITH.TEMP$ ; : PARSE."IF'A=R" ( ... F ) S" IF'A=>R" COMPARE.WITH.TEMP$ ; : PARSE."IF'A>=R" ( ... F ) S" IF'A>=R" COMPARE.WITH.TEMP$ ; : PARSE."IF'A=R" ( ... F ) S" IF'A=R" COMPARE.WITH.TEMP$ ; : PARSE."IF'AR" ( ... F ) S" IF'A>R" COMPARE.WITH.TEMP$ ; : PARSE."IF'A<>" ( ... F ) S" IF'A<>" COMPARE.WITH.TEMP$ ; : PARSE."IF'A<=" ( ... F ) S" IF'A<=" COMPARE.WITH.TEMP$ ; : PARSE."IF'A=<" ( ... F ) S" IF'A=<" COMPARE.WITH.TEMP$ ; : PARSE."IF'A=>" ( ... F ) S" IF'A=>" COMPARE.WITH.TEMP$ ; : PARSE."IF'A>=" ( ... F ) S" IF'A>=" COMPARE.WITH.TEMP$ ; : PARSE."IF'A=" ( ... F ) S" IF'A=" COMPARE.WITH.TEMP$ ; : PARSE."IF'A<" ( ... F ) S" IF'A<" COMPARE.WITH.TEMP$ ; : PARSE."IF'A>" ( ... F ) S" IF'A>" COMPARE.WITH.TEMP$ ; \ --------------------------------------------------------------------- : PARSE."WHILE'A<>R" ( ... F ) S" WHILE'A<>R" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A<=R" ( ... F ) S" WHILE'A<=R" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A=R" ( ... F ) S" WHILE'A=>R" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A>=R" ( ... F ) S" WHILE'A>=R" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A=R" ( ... F ) S" WHILE'A=R" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'AR" ( ... F ) S" WHILE'A>R" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A<>" ( ... F ) S" WHILE'A<>" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A<=" ( ... F ) S" WHILE'A<=" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A=<" ( ... F ) S" WHILE'A=<" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A=>" ( ... F ) S" WHILE'A=>" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A>=" ( ... F ) S" WHILE'A>=" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A=" ( ... F ) S" WHILE'A=" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A<" ( ... F ) S" WHILE'A<" COMPARE.WITH.TEMP$ ; : PARSE."WHILE'A>" ( ... F ) S" WHILE'A>" COMPARE.WITH.TEMP$ ; \ --------------------------------------------------------------------- : PARSE."UNTIL'A<>R" ( ... F ) S" UNTIL'A<>R" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A<=R" ( ... F ) S" UNTIL'A<=R" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A=R" ( ... F ) S" UNTIL'A=>R" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A>=R" ( ... F ) S" UNTIL'A>=R" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A=R" ( ... F ) S" UNTIL'A=R" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'AR" ( ... F ) S" UNTIL'A>R" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A<>" ( ... F ) S" UNTIL'A<>" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A<=" ( ... F ) S" UNTIL'A<=" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A=<" ( ... F ) S" UNTIL'A=<" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A=>" ( ... F ) S" UNTIL'A=>" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A>=" ( ... F ) S" UNTIL'A>=" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A=" ( ... F ) S" UNTIL'A=" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A<" ( ... F ) S" UNTIL'A<" COMPARE.WITH.TEMP$ ; : PARSE."UNTIL'A>" ( ... F ) S" UNTIL'A>" COMPARE.WITH.TEMP$ ; \ ******************************************************************************** : PARSE."IF'R<>R" ( ... F ) S" IF'R<>R" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R<=R" ( ... F ) S" IF'R<=R" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R=R" ( ... F ) S" IF'R=>R" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R>=R" ( ... F ) S" IF'R>=R" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R=R" ( ... F ) S" IF'R=R" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'RR" ( ... F ) S" IF'R>R" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R<>" ( ... F ) S" IF'R<>" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R<=" ( ... F ) S" IF'R<=" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R=<" ( ... F ) S" IF'R=<" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R=>" ( ... F ) S" IF'R=>" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R>=" ( ... F ) S" IF'R>=" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R=" ( ... F ) S" IF'R=" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R<" ( ... F ) S" IF'R<" 4 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."IF'R>" ( ... F ) S" IF'R>" 4 COMPARE.WITH.TEMP$.OPERAND ; \ --------------------------------------------------------------------- : PARSE."WHILE'R<>R" ( ... F ) S" WHILE'R<>R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R<=R" ( ... F ) S" WHILE'R<=R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R=R" ( ... F ) S" WHILE'R=>R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R>=R" ( ... F ) S" WHILE'R>=R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R=R" ( ... F ) S" WHILE'R=R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'RR" ( ... F ) S" WHILE'R>R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R<>" ( ... F ) S" WHILE'R<>" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R<=" ( ... F ) S" WHILE'R<=" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R=<" ( ... F ) S" WHILE'R=<" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R=>" ( ... F ) S" WHILE'R=>" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R>=" ( ... F ) S" WHILE'R>=" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R=" ( ... F ) S" WHILE'R=" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R<" ( ... F ) S" WHILE'R<" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."WHILE'R>" ( ... F ) S" WHILE'R>" 7 COMPARE.WITH.TEMP$.OPERAND ; \ --------------------------------------------------------------------- : PARSE."UNTIL'R<>R" ( ... F ) S" UNTIL'R<>R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R<=R" ( ... F ) S" UNTIL'R<=R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R=R" ( ... F ) S" UNTIL'R=>R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R>=R" ( ... F ) S" UNTIL'R>=R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R=R" ( ... F ) S" UNTIL'R=R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'RR" ( ... F ) S" UNTIL'R>R" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R<>" ( ... F ) S" UNTIL'R<>" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R<=" ( ... F ) S" UNTIL'R<=" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R=<" ( ... F ) S" UNTIL'R=<" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R=>" ( ... F ) S" UNTIL'R=>" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R>=" ( ... F ) S" UNTIL'R>=" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R=" ( ... F ) S" UNTIL'R=" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R<" ( ... F ) S" UNTIL'R<" 7 COMPARE.WITH.TEMP$.OPERAND ; : PARSE."UNTIL'R>" ( ... F ) S" UNTIL'R>" 7 COMPARE.WITH.TEMP$.OPERAND ; \ --------------------------------------------------------------------- : PARSE.TEMP$."#" ( n'th len ... # -1 / 0 ) \ LEN IS TOTAL CHARACTER(S) TO BE PARSED. >R TEMP$ + R> -TRAILING NUMBER? NIP ; : PARSE.RIGHT$."#" ( n'th len ... # -1 / 0 ) \ LEN IS TOTAL CHARACTER(S) TO BE PARSED. >R RIGHT$ + R> -TRAILING NUMBER? NIP ; : PARSE.LEFT$."#" ( n'th len ... # -1 / 0 ) \ len IS TOTAL CHARACTER(S) TO BE PARSED. >R LEFT$ + R> -TRAILING NUMBER? NIP ; : PARSE.BOTH$."#" ( LEFT.n'th LEFT.len RIGHT.nth' RIGHT.len .... left.# right.# -1 / 0 ) PARSE.RIGHT$."#" IF -ROT PARSE.LEFT$."#" IF SWAP -1 ELSE DROP 0 THEN ELSE 0 THEN ; VARIABLE SEPERATOR \ RELATIONAL OPERATOR \ COMMENT: \ : ` ( PARSE.ALL ) ( ... ) TEMP$ 20 20 FILL \ CREATE LAST @ NFA-COUNT 1+ >R TEMP$ 1- R> CMOVE \ PARSE."IF'A<>R" IF 7 20 PARSE.TEMP$."#" IF IF'A<>R EXIT THEN THEN \ PARSE."IF'A<=R" IF 7 20 PARSE.TEMP$."#" IF IF'A<=R EXIT THEN THEN \ PARSE."IF'A=R" IF 7 20 PARSE.TEMP$."#" IF IF'A=>R EXIT THEN THEN \ PARSE."IF'A>=R" IF 7 20 PARSE.TEMP$."#" IF IF'A>=R EXIT THEN THEN \ PARSE."IF'A=R" IF 6 20 PARSE.TEMP$."#" IF IF'A=R EXIT THEN THEN \ PARSE."IF'AR" IF 6 20 PARSE.TEMP$."#" IF IF'A>R EXIT THEN THEN \ PARSE."IF'A<>" IF 6 20 PARSE.TEMP$."#" IF IF'A<># EXIT THEN THEN \ PARSE."IF'A<=" IF 6 20 PARSE.TEMP$."#" IF IF'A<=# EXIT THEN THEN \ PARSE."IF'A=<" IF 6 20 PARSE.TEMP$."#" IF IF'A=<# EXIT THEN THEN \ PARSE."IF'A=>" IF 6 20 PARSE.TEMP$."#" IF IF'A=># EXIT THEN THEN \ PARSE."IF'A>=" IF 6 20 PARSE.TEMP$."#" IF IF'A>=# EXIT THEN THEN \ PARSE."IF'A=" IF 5 20 PARSE.TEMP$."#" IF IF'A=# EXIT THEN THEN \ PARSE."IF'A<" IF 5 20 PARSE.TEMP$."#" IF IF'A<# EXIT THEN THEN \ PARSE."IF'A>" IF 5 20 PARSE.TEMP$."#" IF IF'A># EXIT THEN THEN \ ; \ COMMENT; \ : XXX \ TEMP$ PARSE.RELATIONAL.OPERATOR DROP \ PARSE."IF'R<>R" IF 4 2 1 10 PARSE.BOTH$."#" IF IF'R<>R EXIT THEN THEN ; : ` ( PARSE.ALL ) ( ... ) TEMP$ 20 20 FILL CREATE LAST @ NFA-COUNT >R TEMP$ R@ CMOVE R> TEMP$ 1- C! TEMP$ PARSE.RELATIONAL.OPERATOR DROP PARSE."IF'A<>R" IF 7 10 PARSE.TEMP$."#" IF IF'A<>R EXIT THEN THEN \ PARSE."IF'A<=R" IF 7 10 PARSE.TEMP$."#" IF IF'A<=R EXIT THEN THEN \ PARSE."IF'A=R" IF 7 10 PARSE.TEMP$."#" IF IF'A=>R EXIT THEN THEN PARSE."IF'A>=R" IF 7 10 PARSE.TEMP$."#" IF IF'A>=R EXIT THEN THEN PARSE."IF'A=R" IF 6 10 PARSE.TEMP$."#" IF IF'A=R EXIT THEN THEN PARSE."IF'AR" IF 6 10 PARSE.TEMP$."#" IF IF'A>R EXIT THEN THEN PARSE."IF'A<>" IF 6 10 PARSE.TEMP$."#" IF IF'A<># EXIT THEN THEN \ PARSE."IF'A<=" IF 6 10 PARSE.TEMP$."#" IF IF'A<=# EXIT THEN THEN \ PARSE."IF'A=<" IF 6 10 PARSE.TEMP$."#" IF IF'A=<# EXIT THEN THEN PARSE."IF'A=>" IF 6 10 PARSE.TEMP$."#" IF IF'A=># EXIT THEN THEN PARSE."IF'A>=" IF 6 10 PARSE.TEMP$."#" IF IF'A>=# EXIT THEN THEN PARSE."IF'A=" IF 5 10 PARSE.TEMP$."#" IF IF'A=# EXIT THEN THEN PARSE."IF'A<" IF 5 10 PARSE.TEMP$."#" IF IF'A<# EXIT THEN THEN \ PARSE."IF'A>" IF 5 10 PARSE.TEMP$."#" IF IF'A># EXIT THEN THEN \ PARSE."WHILE'A<>R" IF 7 10 PARSE.TEMP$."#" IF WHILE'A<>R EXIT THEN THEN \ PARSE."WHILE'A<=R" IF 7 10 PARSE.TEMP$."#" IF WHILE'A<=R EXIT THEN THEN \ PARSE."WHILE'A=R" IF 7 10 PARSE.TEMP$."#" IF WHILE'A=>R EXIT THEN THEN \ PARSE."WHILE'A>=R" IF 7 10 PARSE.TEMP$."#" IF WHILE'A>=R EXIT THEN THEN \ PARSE."WHILE'A=R" IF 6 10 PARSE.TEMP$."#" IF WHILE'A=R EXIT THEN THEN \ PARSE."WHILE'AR" IF 6 10 PARSE.TEMP$."#" IF WHILE'A>R EXIT THEN THEN \ PARSE."WHILE'A<>" IF 6 10 PARSE.TEMP$."#" IF WHILE'A<># EXIT THEN THEN \ PARSE."WHILE'A<=" IF 6 10 PARSE.TEMP$."#" IF WHILE'A<=# EXIT THEN THEN \ PARSE."WHILE'A=<" IF 6 10 PARSE.TEMP$."#" IF WHILE'A=<# EXIT THEN THEN \ PARSE."WHILE'A=>" IF 6 10 PARSE.TEMP$."#" IF WHILE'A=># EXIT THEN THEN \ PARSE."WHILE'A>=" IF 6 10 PARSE.TEMP$."#" IF WHILE'A>=# EXIT THEN THEN \ PARSE."WHILE'A=" IF 5 10 PARSE.TEMP$."#" IF WHILE'A=# EXIT THEN THEN \ PARSE."WHILE'A<" IF 5 10 PARSE.TEMP$."#" IF WHILE'A<# EXIT THEN THEN \ PARSE."WHILE'A>" IF 5 10 PARSE.TEMP$."#" IF WHILE'A># EXIT THEN THEN \ PARSE."UNTIL'A<>R" IF 7 10 PARSE.TEMP$."#" IF UNTIL'A<>R EXIT THEN THEN \ PARSE."UNTIL'A<=R" IF 7 10 PARSE.TEMP$."#" IF UNTIL'A<=R EXIT THEN THEN \ PARSE."UNTIL'A=R" IF 7 10 PARSE.TEMP$."#" IF UNTIL'A=>R EXIT THEN THEN \ PARSE."UNTIL'A>=R" IF 7 10 PARSE.TEMP$."#" IF UNTIL'A>=R EXIT THEN THEN \ PARSE."UNTIL'A=R" IF 6 10 PARSE.TEMP$."#" IF UNTIL'A=R EXIT THEN THEN \ PARSE."UNTIL'AR" IF 6 10 PARSE.TEMP$."#" IF UNTIL'A>R EXIT THEN THEN \ PARSE."UNTIL'A<>" IF 6 10 PARSE.TEMP$."#" IF UNTIL'A<># EXIT THEN THEN \ PARSE."UNTIL'A<=" IF 6 10 PARSE.TEMP$."#" IF UNTIL'A<=# EXIT THEN THEN \ PARSE."UNTIL'A=<" IF 6 10 PARSE.TEMP$."#" IF UNTIL'A=<# EXIT THEN THEN \ PARSE."UNTIL'A=>" IF 6 10 PARSE.TEMP$."#" IF UNTIL'A=># EXIT THEN THEN \ PARSE."UNTIL'A>=" IF 6 10 PARSE.TEMP$."#" IF UNTIL'A>=# EXIT THEN THEN \ PARSE."UNTIL'A=" IF 5 10 PARSE.TEMP$."#" IF UNTIL'A=# EXIT THEN THEN \ PARSE."UNTIL'A<" IF 5 10 PARSE.TEMP$."#" IF UNTIL'A<# EXIT THEN THEN \ PARSE."UNTIL'A>" IF 5 10 PARSE.TEMP$."#" IF UNTIL'A># EXIT THEN THEN PARSE."IF'R<>R" IF 4 2 1 10 PARSE.BOTH$."#" IF IF'R<>R EXIT THEN THEN \ PARSE."IF'R<=R" IF 4 2 1 10 PARSE.BOTH$."#" IF IF'R<=R EXIT THEN THEN \ PARSE."IF'R=R" IF 4 2 1 10 PARSE.BOTH$."#" IF IF'R=>R EXIT THEN THEN PARSE."IF'R>=R" IF 4 2 1 10 PARSE.BOTH$."#" IF IF'R>=R EXIT THEN THEN PARSE."IF'R=R" IF 4 2 1 10 PARSE.BOTH$."#" IF IF'R=R EXIT THEN THEN PARSE."IF'RR" IF 4 2 1 10 PARSE.BOTH$."#" IF IF'R>R EXIT THEN THEN PARSE."IF'R<>" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R<># EXIT THEN THEN \ PARSE."IF'R<=" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R<=# EXIT THEN THEN \ PARSE."IF'R=<" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R=<# EXIT THEN THEN PARSE."IF'R=>" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R=># EXIT THEN THEN PARSE."IF'R>=" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R>=# EXIT THEN THEN PARSE."IF'R=" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R=# EXIT THEN THEN PARSE."IF'R<" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R<# EXIT THEN THEN \ PARSE."IF'R>" IF 4 2 0 10 PARSE.BOTH$."#" IF IF'R># EXIT THEN THEN \ PARSE."WHILE'R<>R" IF 4 2 1 10 PARSE.BOTH$."#" IF WHILE'R<>R EXIT THEN THEN \ PARSE."WHILE'R<=R" IF 4 2 1 10 PARSE.BOTH$."#" IF WHILE'R<=R EXIT THEN THEN \ PARSE."WHILE'R=R" IF 4 2 1 10 PARSE.BOTH$."#" IF WHILE'R=>R EXIT THEN THEN \ PARSE."WHILE'R>=R" IF 4 2 1 10 PARSE.BOTH$."#" IF WHILE'R>=R EXIT THEN THEN \ PARSE."WHILE'R=R" IF 4 2 1 10 PARSE.BOTH$."#" IF WHILE'R=R EXIT THEN THEN \ PARSE."WHILE'RR" IF 4 2 1 10 PARSE.BOTH$."#" IF WHILE'R>R EXIT THEN THEN \ PARSE."WHILE'R<>" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R<># EXIT THEN THEN \ PARSE."WHILE'R<=" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R<=# EXIT THEN THEN \ PARSE."WHILE'R=<" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R=<# EXIT THEN THEN \ PARSE."WHILE'R=>" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R=># EXIT THEN THEN \ PARSE."WHILE'R>=" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R>=# EXIT THEN THEN \ PARSE."WHILE'R=" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R=# EXIT THEN THEN \ PARSE."WHILE'R<" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R<# EXIT THEN THEN \ PARSE."WHILE'R>" IF 4 2 0 10 PARSE.BOTH$."#" IF WHILE'R># EXIT THEN THEN \ PARSE."UNTIL'R<>R" IF 4 2 1 10 PARSE.BOTH$."#" IF UNTIL'R<>R EXIT THEN THEN \ PARSE."UNTIL'R<=R" IF 4 2 1 10 PARSE.BOTH$."#" IF UNTIL'R<=R EXIT THEN THEN \ PARSE."UNTIL'R=R" IF 4 2 1 10 PARSE.BOTH$."#" IF UNTIL'R=>R EXIT THEN THEN \ PARSE."UNTIL'R>=R" IF 4 2 1 10 PARSE.BOTH$."#" IF UNTIL'R>=R EXIT THEN THEN \ PARSE."UNTIL'R=R" IF 4 2 1 10 PARSE.BOTH$."#" IF UNTIL'R=R EXIT THEN THEN \ PARSE."UNTIL'RR" IF 4 2 1 10 PARSE.BOTH$."#" IF UNTIL'R>R EXIT THEN THEN \ PARSE."UNTIL'R<>" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R<># EXIT THEN THEN \ PARSE."UNTIL'R<=" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R<=# EXIT THEN THEN \ PARSE."UNTIL'R=<" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R=<# EXIT THEN THEN \ PARSE."UNTIL'R=>" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R=># EXIT THEN THEN \ PARSE."UNTIL'R>=" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R>=# EXIT THEN THEN \ PARSE."UNTIL'R=" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R=# EXIT THEN THEN \ PARSE."UNTIL'R<" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R<# EXIT THEN THEN \ PARSE."UNTIL'R>" IF 4 2 0 10 PARSE.BOTH$."#" IF UNTIL'R># EXIT THEN THEN PARSE."R12?R34/5/A.." ; \ ***************************************************** VARIABLE OFFSET.ADDR FF60 OFFSET.ADDR ! : PORT.A 0 OFFSET.ADDR @ + ; : PORT.B 1 OFFSET.ADDR @ + ; : PORT.C 2 OFFSET.ADDR @ + ; : PORT.D 3 OFFSET.ADDR @ + ; \ AVR90S8515 PROGRAMMER 8515.SEQ \ SERIAL PROGRAMMING 8515.PB6(MISO) PIN 7 ---> PORT.C.3 \ 8515.PB7(SCK) PIN 8 <--- PORT.C.4 \ RESET PIN 9 <--- PORT.C.5 \ 8515.PB5(MOSI) PIN 6 <--- PORT.C.6 : III/O ( ... ) 93 PORT.D C! ; : PB5(MOSI) ( 1/0 ... ) \ PORT.C.6 = PORT.C.BIT 6 IF 0D ELSE 0C THEN PORT.D C! ; : SCK=0 ( ... ) 8 PORT.D C! ; : SCK=1 ( ... ) 9 PORT.D C! ; : SERIAL.DATA.INPUT->8515 ( BYTE ... ) 8 0 DO 2 /MOD LOOP DROP 8 0 DO PB5(MOSI) SCK=1 SCK=0 LOOP ; : PROGRAMMING.ENABLE ( ... ) AC SERIAL.DATA.INPUT->8515 53 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 ; : CHIP.ERASE ( ... ) AC SERIAL.DATA.INPUT->8515 80 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 ; : WRITE.PROGRAM.MEMORY.LOW.BYTE ( BYTE ADDR ... ) 40 SERIAL.DATA.INPUT->8515 100 /MOD 0F AND SERIAL.DATA.INPUT->8515 ( A8~A11 ) SERIAL.DATA.INPUT->8515 ( A0~A7 ) SERIAL.DATA.INPUT->8515 ; : WRITE.PROGRAM.MEMORY.HIGH.BYTE ( BYTE ADDR ... ) 48 SERIAL.DATA.INPUT->8515 100 /MOD 0F AND SERIAL.DATA.INPUT->8515 ( A8~A11 ) SERIAL.DATA.INPUT->8515 ( A0~A7 ) SERIAL.DATA.INPUT->8515 ; : WRITE.EEPROM.MEMORY ( BYTE ADDR ... ) C0 SERIAL.DATA.INPUT->8515 100 /MOD SERIAL.DATA.INPUT->8515 ( A8~A11 ) SERIAL.DATA.INPUT->8515 ( A0~A7 ) SERIAL.DATA.INPUT->8515 4 MS ; : WRITE.LOCK.BIT.1 ( ... ) AC SERIAL.DATA.INPUT->8515 E4 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 ; : WRITE.LOCK.BIT.2 ( ... ) AC SERIAL.DATA.INPUT->8515 E2 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 ; \ --------------------------------- : SERIAL.DATA.INPUT<-8515 ( ... BYTE ) 0 SCK=1 \ SERIAL.CLOCK.INPUT.HIGH SCK=0 \ SERIAL.CLOCK.INPUT.LOW 8 0 DO SCK=1 \ SERIAL.CLOCK.INPUT.HIGH 2 * PORT.C C@ 1 AND + SCK=0 \ SERIAL.CLOCK.INPUT.LOW LOOP ; : READ.PROGRAM.MEMORY.LOW.BYTE ( ADDR ... BYTE ) 20 SERIAL.DATA.INPUT->8515 100 /MOD SERIAL.DATA.INPUT->8515 SERIAL.DATA.INPUT->8515 SERIAL.DATA.INPUT<-8515 ; : READ.PROGRAM.MEMORY.HIGH.BYTE ( ADDR ... BYTE ) 28 SERIAL.DATA.INPUT->8515 100 /MOD SERIAL.DATA.INPUT->8515 ( A8~A11 ) SERIAL.DATA.INPUT->8515 ( A0~A7 ) SERIAL.DATA.INPUT<-8515 ; : READ.EEPROM.MEMORY ( ADDR ... BYTE ) A0 SERIAL.DATA.INPUT->8515 100 /MOD SERIAL.DATA.INPUT->8515 ( A8~A11 ) SERIAL.DATA.INPUT->8515 ( A0~A7 ) SERIAL.DATA.INPUT<-8515 ; : READ.DEVICE.CODE ( ADDR ... BYTE ) 30 SERIAL.DATA.INPUT->8515 00 SERIAL.DATA.INPUT->8515 SERIAL.DATA.INPUT->8515 SERIAL.DATA.INPUT<-8515 ; : RESET=0 0A PORT.D C! ; : RESET=1 0B PORT.D C! ; : POWER.UP ( ... ) CR ." APPLY POWER BETWEEN VCC AND GND " RESET=0 SCK=0 ; : XTAL=0 ; : WRITE.PROGRAM.MEMORY ( FROM TO LENGTH ... ) 2* 0 POWER.UP 20 MS PROGRAMMING.ENABLE CHIP.ERASE 10 MS RESET=1 RESET=0 DO OVER I + C@ OVER I + WRITE.PROGRAM.MEMORY.LOW.BYTE OVER I + 1+ C@ OVER I + WRITE.PROGRAM.MEMORY.HIGH.BYTE LOOP 2DROP RESET=1 XTAL=0 ; : WRITE.EEPROM ( FROM TO LENGTH ... ) 0 DO OVER I + C@ OVER I + WRITE.EEPROM.MEMORY LOOP 2DROP ; \ : WPM WRITE.PROGRAM.MEMORY ( FROM TO LENGTH ... ) ; \ : WE WRITE.EEPROM ( FROM TO LENGTH ... ) ; \ ................................................................. : MASK=? ( ADDR MASK VALE ... ADDR F ) >R >R DUP @ R> AND R> = ; : MASK=? ( ADDR MASK VALE ... ADDR F ) >R >R DUP @' R> AND R> = ; : 1R5D4R' ( OPCODE ... R R ) \ (1) DUP 1F0 AND 10 / ( D ) SWAP 20F AND 200 /MOD 10 * OR ; : .MN ( ADDR ... ) COUNT ( NFA-COUNT ) TYPE ; : "\" ." \" ; : 1R5D4R'.TYPE ( ADDR OP.CODE -1/0 $1 $2 ... F ) DROP NIP 1- SWAP 1- SWAP >R >R >R >R FC00 R> MASK=? IF CR DUP PC..(PC)' @' 1R5D4R' R> IF SWAP THEN 2DUP RXXXX....XXXXR R> .MN 3 SPACES "\" XXXX....XXXX R> .MN -1 ELSE R> 2DROP R> R> 2DROP 0 THEN ; \ : $" ( -- ) \ STATE @ \ IF COMPILE (S") ," DROP 1 - \ ELSE [CHAR] " WORD \ NEW$ DUP>R OVER C@ 1+ MOVE \ r> COUNT \ THEN ; IMMEDIATE : MOV' ( ADDR ... F ) 2C00 -1 S" R>R " S" MOV " 1R5D4R'.TYPE ; : ADC' ( ADDR ... F ) 1C00 0 S" R+R+C" S" ADC " 1R5D4R'.TYPE ; : ADD' ( ADDR ... F ) 0C00 0 S" R+R " S" ADD " 1R5D4R'.TYPE ; : SUB' ( ADDR ... F ) 1800 0 S" R-R " S" SUB " 1R5D4R'.TYPE ; : SBC' ( ADDR ... F ) C800 0 S" R-R-C" S" SBC " 1R5D4R'.TYPE ; : AND' ( ADDR ... F ) 2000 0 S" RnR " S" AND " 1R5D4R'.TYPE ; : OR' ( ADDR ... F ) 2800 0 S" RoR " S" OR " 1R5D4R'.TYPE ; : EOR' ( ADDR ... F ) 2400 0 S" RxR " S" EOR " 1R5D4R'.TYPE ; : CPSE' ( ADDR ... F ) 1000 0 S" R=R? " S" CPSE" 1R5D4R'.TYPE ; : CP' ( ADDR ... F ) 1400 0 S" R:R " S" CP " 1R5D4R'.TYPE ; : CPC' ( ADDR ... F ) 0400 0 S" R:RC " S" CPC " 1R5D4R'.TYPE ; : ADC' ( ADDR ... F ) 1C00 0 S" R+R+C" S" ADC " 1R5D4R'.TYPE ; \ ................................................................. : 1d5D4d'? ( ADDR ... F ) @' 1R5D4R' = ; : 1d5D4d'.TYPE ( ADDR' OP.CODE $1 $2 ... F ) DROP NIP 1- SWAP 1- SWAP >R >R >R FC00 R> MASK=? IF DUP 1d5D4d'? ELSE 0 THEN IF CR DUP PC..(PC)' @' 1R5D4R' ........XXXXR R> .MN 4 SPACES "\" ........XXXX R> .MN -1 ELSE DROP R> R> 2DROP 0 THEN ; : LSL' ( ADDR ... F ) 0C00 S" SL " S" LSL " 1d5D4d'.TYPE ; : ROL' ( ADDR ... F ) 1C00 S" RLCR" S" ROL " 1d5D4d'.TYPE ; : TST' ( ADDR ... F ) 2000 S" R:0 " S" TST " 1d5D4d'.TYPE ; : CLR' ( ADDR ... F ) 2400 S" R=00" S" CLR " 1d5D4d'.TYPE ; \ ..................................................... : RX>REGISTER ( RX ... REGISTER ) CASE 0 OF 18 ENDOF 1 OF 1A ENDOF 2 OF 1C ENDOF 3 OF 1E ENDOF ABORT" RX IS NOT 0 ~ 3 " ENDCASE ; : 2K2D4K' ( OPCODE ... RX # ) \ (2) 0FF AND DUP 30 AND 10 / ( D ) RX>REGISTER SWAP 0CF AND 40 /MOD 10 * OR ; : 2K2D4K'.TYPE ( OPCODE $1 $2 ... ) DROP NIP 1- SWAP 1- SWAP >R >R >R FF00 R> MASK=? IF CR DUP PC..(PC)' @' 2K2D4K' 2DUP XXXX....XXXX R> .MN 3 SPACES "\" XXXX....XXXX R> .MN -1 ELSE DROP R> R> 2DROP 0 THEN ; : ADIW' ( ADDR ... F ) 9600 S" RX+# " S" ADIW " 2K2D4K'.TYPE ; : SBIW' ( ADDR ... F ) 9700 S" RX-# " S" SBIW " 2K2D4K'.TYPE ; \ ..................................................... : 4K4D4K' ( OPCODE ... D # ) \ (3) DUP F0 AND 10 / ( D ) 10 + SWAP 0F0F AND 100 /MOD 10 * OR ; : 4K4D4K'.TYPE ( ADDR' OP.CODE -1/0 $1 $2 ... ) DROP NIP 1- SWAP 1- SWAP >R >R >R >R F000 R> MASK=? IF CR DUP PC..(PC)' @' 4K4D4K' R> IF SWAP 2DUP XXXX....XXXXR ELSE 2DUP RXXXX....XXXX THEN R> .MN 2 SPACES "\" XXXX....XXXX R> .MN -1 ELSE R> 2DROP R> R> 2DROP 0 THEN ; : SUBI' ( ADDR ... F ) 5000 0 S" R-# " S" SUBI " 4K4D4K'.TYPE ; : SBCI' ( ADDR ... F ) 4000 0 S" R-#-C " S" SBCI " 4K4D4K'.TYPE ; : ANDI' ( ADDR ... F ) 7000 0 S" Rn# " S" ANDI " 4K4D4K'.TYPE ; \ : CBR' ( ADDR ... F ) 7000 0 S" Rn# " S" ANDI " 4K4D4K'.TYPE ; : ORI' ( ADDR ... F ) 6000 0 S" Ro# " S" ORI or SBR" 4K4D4K'.TYPE ; : CPI' ( ADDR ... F ) 3000 0 S" R:# " S" CPI " 4K4D4K'.TYPE ; : LDI' ( ADDR ... F ) E000 -1 S" #>R " S" LDI " 4K4D4K'.TYPE ; : 4K4D4K'.TYPE.RB=X ( ADDR' -1/0 OP.CODE $1 $2 ... ) DROP NIP 1- SWAP 1- SWAP >R >R >R >R F000 R> MASK=? OVER @' 4K4D4K' SWAP DROP R@ IF 0FF XOR THEN 2^N? SWAP DROP AND \ IF CR DUP PC..(PC)' @' 4K4D4K' R> IF 0FF XOR THEN #>2^N \ 2DUP RXXXX....XXXXB R> .MN 2 SPACES XXXX....XXXX R> .MN -1 IF CR DUP PC..(PC)' @' 4K4D4K' R> IF 0FF XOR THEN 2DUP #>2^N RXXXX....XXXXB R> .MN 2 SPACES "\" XXXX....XXXX R> .MN -1 ELSE R> 2DROP R> R> 2DROP 0 THEN ; : RB=0' ( ADDR ... F ) 7000 -1 S" RB=0 " S" CBR " 4K4D4K'.TYPE.RB=X ; : RB=1' ( ADDR ... F ) 6000 0 S" RB=1 " S" ORI or SBR" 4K4D4K'.TYPE.RB=X ; \ ..................................................... : 5D' ( OPCODE ... D ) \ (4) 1F0 AND 10 / ; : 5D'.TYPE ( ADDR' $1 $2 ... F ) DROP NIP 1- SWAP 1- SWAP >R >R >R FE0F R> MASK=? IF CR DUP PC..(PC)' @' 5D' DUP ........XXXXR R> .MN SPACE "\" ........XXXX R> .MN -1 ELSE DROP R> R> 2DROP 0 THEN ; : COM' ( ADDR ... F ) 9400 S" /R " S" COM " 5D'.TYPE ; : NEG' ( ADDR ... F ) 9401 S" 0-R " S" NEG " 5D'.TYPE ; : INC' ( ADDR ... F ) 9403 S" R+ " S" INC " 5D'.TYPE ; : DEC' ( ADDR ... F ) 940A S" R- " S" DEC " 5D'.TYPE ; : (X)>R' ( ADDR ... F ) 900C S" (X)>R " S" LD_Rd,X " 5D'.TYPE ; : (X+)>R' ( ADDR ... F ) 900D S" (X+)>R " S" LD_Rd,X+" 5D'.TYPE ; : (-X)>R' ( ADDR ... F ) 900E S" (-X)>R " S" LD_Rd,-X" 5D'.TYPE ; : (Y)>R' ( ADDR ... F ) 8008 S" (Y)>R " S" LD_Rd,Y " 5D'.TYPE ; : (Y+)>R' ( ADDR ... F ) 9009 S" (Y+)>R " S" LD_Rd,Y+" 5D'.TYPE ; : (-Y)>R' ( ADDR ... F ) 900A S" (-Y)>R " S" LD_Rd,-Y" 5D'.TYPE ; : (Z)>R' ( ADDR ... F ) 8000 S" (Z)>R " S" LD_Rd,Z " 5D'.TYPE ; : (Z+)>R' ( ADDR ... F ) 9001 S" (Z+)>R " S" LD_Rd,Z+" 5D'.TYPE ; : (-Z)>R' ( ADDR ... F ) 9002 S" (-Z)>R " S" LD_Rd,-Z" 5D'.TYPE ; : PUSH' ( ADDR ... F ) 920F S" PUSH " S" PUSH " 5D'.TYPE ; : POP' ( ADDR ... F ) 900F S" POP " S" POP " 5D'.TYPE ; : LSR' ( ADDR ... F ) 9406 S" SR " S" LSR " 5D'.TYPE ; : ROR' ( ADDR ... F ) 9407 S" RRCR " S" ROR " 5D'.TYPE ; : ASR' ( ADDR ... F ) 9405 S" ASR " S" ASR " 5D'.TYPE ; : SWAPR' ( ADDR ... F ) 9402 S" SWAPR " S" SWAPR " 5D'.TYPE ; \ ..................................................... : 3S' ( OPCODE ... S ) \ (5) 70 AND 10 / ; : ."_SREG=?__" ( S ... ) CASE 0 OF ." C" ENDOF 1 OF ." Z" ENDOF 2 OF ." N" ENDOF 3 OF ." V" ENDOF 4 OF ." S" ENDOF 5 OF ." H" ENDOF 6 OF ." T" ENDOF 7 OF ." I" ENDOF ENDCASE ; : ."_SREG=0__" ( S ... ) ."_SREG=?__" ." =0 " ; : ."_SREG=1__" ( S ... ) ."_SREG=?__" ." =1 " ; : ."_SREG=CL_" ( S ... ) ." CL" ."_SREG=?__" ; : ."_SREG=SE_" ( S ... ) ." SE" ."_SREG=?__" ; : BSET' ( ADDR ... F ) FF8F 9408 MASK=? IF CR DUP PC..(PC)' @' 3S' DUP 16 SPACES ."_SREG=1__" "\" 16 SPACES ."_SREG=SE_" -1 ELSE DROP 0 THEN ; : BCLR' ( ADDR .