\ ****************************************************************************** \ PART.1 THIS PART IS COMMON TO ALL \ ****************************************************************************** HEX : .XXXX 0 <# # # # # #> TYPE ; : 16, 100 /MOD SWAP C, C, ; CREATE PROGRAM.MEMORY ( 07FF 16, 077F 16, 77F 16, ) 2000 ( 4000 ) ALLOT ( 8K*14 ) CREATE CODE>EXEC.ADDR 10000 ALLOT CODE>EXEC.ADDR 10000 ERASE CREATE RETURN.STACK 1000 ( 8 ) 4 * ALLOT CREATE CPU.MEM 400 ALLOT CPU.MEM 400 0 FILL \ CODE PC! 0 [EBP] EAX MOV EBX EDX MOV AL EDX OUT 4 [EBP] EBX MOV 8 # EBP ADD RET \ CODE PC@ EAX EAX XOR EBX EDX MOV EDX AL IN EAX EBX MOV RET \ VOCABULARY 16F87X 16F87X DEFINITIONS : 2+ 2 + ; : 2- 2 - ; \ : 2* 2 * ; \ : 2/ 2 / ; \ : .XXXX 0 <# # # # # #> TYPE ; : 16F87X.PROGRAM.AREA 0 ; VARIABLE CP' \ 16F87X.PROGRAM.AREA CP' ! : CP0 PROGRAM.MEMORY ; \ : CELL 2 ; \ : CELL+ 2+ ; : CELL* 2* ; \ : CELL/ 2/ ; \ : CELL! ! ; \ : CELL@ @ ; : 16! >R 100 /MOD R@ 1+ C! R> C! ; \ win32for : 16@ @ FFFF AND ; \ """ : C@' CP0 + C@ ; \ target : @' CELL* CP0 + 16@ ; \ """ : C!' CP0 + C! ; \ """ : !' CELL* CP0 + 16! ; \ """ : +!' >R R@ @' + R> !' ; \ """ : HERE' ( ... ADDR ) CP' @ ; : $ HERE' ; \ """ : ALLOT' ( N ... ) CP' +! ; \ """ : ,' ( N ... ) HERE' CELL* CP0 + 16! 1 ALLOT' ; \ """ : ORG' ( ADDR ... ) CP' ! ; \ """ : T:QUEUE.MAX 400 ; \ 1024 instructions maximum in the target system. VARIABLE T:QUEUE.COUNTER CREATE T:QUEUE T:QUEUE.MAX 6 * ALLOT : ERASE.T:QUEUE T:QUEUE T:QUEUE.MAX 6 * ERASE ; : T: CREATE HERE' , HERE' T:QUEUE T:QUEUE.COUNTER @ + 16! LAST @ T:QUEUE T:QUEUE.COUNTER @ + 2 + ! 6 T:QUEUE.COUNTER +! DOES> @ 2000 + ,' ; \ TARGET ASSEMBLING 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<> ; : FLIP ( 16bit ... 16bit ) 100 /MOD SWAP 100 * + ; \ 1234 --> 3412 \ ****************************************************************************** \ PART.2 EM78156/447 ASSEMBLER \ ****************************************************************************** \ hex \ : EM78447.PROGRAM.AREA 0 ; \ VARIABLE CP' EM78447.PROGRAM.AREA CP' ! \ : @' 2/ @ ; \ : CELL/ 2 / ; \ : CELL* 2 * ; \ : HERE' CP' @ CELL/ ; \ : ALLOT' ( N ... ) CELL* CP' +! ; \ : ,' ( N ... ) CP' @ ! 1 ALLOT' ; \ : ORG' CELL* CP' ! ; : 3B.CHECK ( B ... ) 0 7 BETWEEN NOT IF ABORT" B IS NOT IN THE RANGE 0 ~ 7 " THEN ; : 4R.CHECK ( R ... ) 0 0F BETWEEN NOT IF ABORT" R IS NOT IN THE RANGE 0 ~ 0F " THEN ; : 6R.CHECK ( R ... ) 0 3F BETWEEN NOT IF ABORT" R IS NOT IN THE RANGE 0 ~ 3F " THEN ; : 8#.CHECK ( # ... ) 0 0FF BETWEEN NOT IF ABORT" # IS NOT IN THE RANGE 0 ~ FF " THEN ; : 10#.CHECK ( # ... ) 0 3FF BETWEEN NOT IF ABORT" # IS NOT IN THE RANGE 0 ~ 3FF " THEN ; DEFER _,' ' ,' IS _,' \ 13C: CREATE , DOES>' R> @ _,' ; \ 9C4R: CREATE , DOES>' DUP 4R.CHECK R> @ + _,' ; \ 7C6R: CREATE , DOES>' DUP 6R.CHECK R> @ + _,' ; \ 4C3B6R: CREATE , DOES>' DUP 3B.CHECK 40 * OVER 6R.CHECK \ + R> @ + _,' ; \ 3C10#: CREATE , DOES>' DUP 10#.CHECK R> @ + _,' ; \ 5C8#: CREATE , DOES>' DUP 8#.CHECK R> @ + _,' ; \ 6C8#: CREATE , DOES> >R DUP 8#.CHECK R> @ + ,' ; \ PIC16F877 \ 5C1X8#: CREATE , DOES> >R DUP 8#.CHECK R> @ + ,' ; \ 4C2X8#: CREATE , DOES> >R DUP 8#.CHECK R> @ + ,' ; \ 3C11#: CREATE , DOES> >R DUP 11#.CHECK R> @ + ,' ; \ 6C1D7R: CREATE , DOES> >R DUP 7R.CHECK R> @ + ,' ; \ 4C3B7R: CREATE , DOES> >R DUP 3B.CHECK OVER 7R.CHECK 80 * + R> @ + ,' ; \ 7C7R: CREATE , DOES> >R DUP 7R.CHECK R> @ + ,' ; \ 14C: CREATE , DOES> @ ,' ; : 5C8#: CREATE , DOES> >R DUP 8#.CHECK R> @ + ,' ; \ EM78447 : 3C10#: CREATE , DOES> >R DUP 10#.CHECK R> @ + ,' ; : 9C4R: CREATE , DOES> >R DUP 4R.CHECK R> @ + ,' ; : 4C3B6R: CREATE , DOES> >R DUP 3B.CHECK OVER 6R.CHECK 40 * + R> @ + ,' ; : 7C6R: CREATE , DOES> >R DUP 6R.CHECK R> @ + ,' ; : 13C: CREATE , DOES> @ ,' ; 0 13C: NOP 1 13C: DAA 2 13C: CONTW : A>CONT CONTW ; 3 13C: SLEP : SLEEP SLEP ; 4 13C: WDTC : WDT=0 WDTC ; 10 13C: ENI : EI ENI ; 11 13C: DISI : DI DISI ; 12 13C: RET 13 13C: RETI 14 13C: CONT_R : CONT>R CONT_R ; 20 13C: TBL 80 13C: CLR_A : A=0 CLR_A ; 1E02 13C: INT 0 9C4R: IOW_R : A>IOCR IOW_R ; 10 9C4R: IOR_R : IOCR>A IOR_R ; 40 7C6R: MOV_R,A : A>R MOV_R,A ; C0 7C6R: CLR_R : R=0 CLR_R ; 100 7C6R: SUB_A,R : R-A>A SUB_A,R ; : -A+R SUB_A,R ; 140 7C6R: SUB_R,A : R-A SUB_R,A ; 180 7C6R: DEC_A,R : R-1>A DEC_A,R ; 1C0 7C6R: DEC_R : R- DEC_R ; 200 7C6R: OR_A,R : AoR OR_A,R ; 240 7C6R: OR_R,A : RoA OR_R,A ; 280 7C6R: AND_A,R : AnR AND_A,R ; 2C0 7C6R: AND_R,A : RnA AND_R,A ; 300 7C6R: XOR_A,R : AxR XOR_A,R ; 340 7C6R: XOR_R,A : RxA XOR_R,A ; 380 7C6R: ADD_A,R : A+R ADD_A,R ; 3C0 7C6R: ADD_R,A : R+A ADD_R,A ; 400 7C6R: MOV_A,R : R>A MOV_A,R ; 440 7C6R: MOV_R,R : R:0 MOV_R,R ; 480 7C6R: COM_A,R : /R>A COM_A,R ; 4C0 7C6R: COM_R : /R COM_R ; 500 7C6R: INC_A,R : R+1>A INC_A,R ; 540 7C6R: INC_R : R+ INC_R ; 580 7C6R: DJZ_A,R : R-1=0?>A DJZ_A,R ; 5C0 7C6R: DJZ_R : R-1=0? INC_A,R ; 600 7C6R: RRC_A,R : RRCR>A RRC_A,R ; 640 7C6R: RRC_R : RRCR RRC_R ; 680 7C6R: RLC_A,R : RLCR>A RLC_A,R ; 6C0 7C6R: RLC_R : RLCR RLC_R ; 700 7C6R: SWAP_A,R : SWAPAR SWAP_A,R ; : SWAPRA SWAP_A,R ; 740 7C6R: SWAP_R : SWAPR SWAP_R ; 780 7C6R: JZ_A,R : R+1=0?>A JZ_A,R ; 7C0 7C6R: JZ_R : R+1=0? JZ_R ; 800 4C3B6R: BC_R,b : RB=0 BC_R,b ; A00 4C3B6R: BS_R,b : RB=1 BS_R,b ; C00 4C3B6R: JBC_R,b : RB=0? JBC_R,b ; E00 4C3B6R: JBS_R,b : RB=1? JBS_R,b ; 1000 3C10#: CALL 1400 3C10#: JMP 1800 5C8#: MOV_A,K : #>A MOV_A,K ; 1900 5C8#: OR_A,K : Ao# OR_A,K ; 1A00 5C8#: AND_A,K : An# AND_A,K ; 1B00 5C8#: XOR_A,K : Ax# XOR_A,K ; 1C00 5C8#: RETL_# : #>A,RET RETL_# ; : #>ARET RETL_# ; 1D00 5C8#: SUB_A,K : #-A SUB_A,K ; : -A+# #-A ; 1F00 5C8#: ADD_A,K : A+# ADD_A,K ; : A+ 1 A+# ; : A- 0FF A+# ; : R+# OVER R>A A+# A>R ; : C=0 3 0 RB=0 ; : C=1 3 0 RB=1 ; : Z=0 3 2 RB=0 ; : Z=1 3 2 RB=1 ; \ ============================================================== \ CONDITIONAL STRUCTURE \ : +!' ( N ADDR ... ) 2 * +! ; \ : !' ( N ADDR ... ) 2 * ! ; \ : HERE' HERE 2 / ; : IF'RB=0 ( R B ... ) RB=1? HERE' 0 JMP ; \ 0 IS DUMMY ADDRESS : IF'RB=1 ( R B ... ) RB=0? HERE' 0 JMP ; : IF'R+1=0 ( R ... ) R-1=0? HERE' 0 JMP ; : IF'R-1=0 ( R ... ) R+1=0? HERE' 0 JMP ; : IF'R+1=0>A ( R ... ) R-1=0?>A HERE' 0 JMP ; : IF'R-1=0>A ( R ... ) R+1=0?>A HERE' 0 JMP ; : IF'C=0 3 0 IF'RB=0 ; : IF'C=1 3 0 IF'RB=0 ; : IF'Z=0 3 2 IF'RB=0 ; : IF'Z=1 3 2 IF'RB=0 ; : IF'A=0 0 Ao# IF'Z=1 ; : IF'A<>0 0 Ao# IF'Z=0 ; : THEN' ( ADDR ... ) HERE' SWAP +!' ; : ENDIF' THEN' ; : ELSE' ( ADDR ... ADDR' ) HERE' 0 JMP SWAP THEN' ; : BEGIN' HERE' ; : AGAIN' JMP ; : UNTIL'RB=0 ( R B ... ) RB=0? JMP ; : UNTIL'RB=1 ( R B ... ) RB=1? JMP ; : UNTIL'R+1=0 ( R ... ) R+1=0? JMP ; : UNTIL'R-1=0 ( R ... ) R-1=0? JMP ; : UNTIL'R+1=0>A ( R ... ) R+1=0?>A JMP ; : UNTIL'R-1=0>A ( R ... ) R-1=0?>A JMP ; : UNTIL'C=0 3 0 UNTIL'RB=0 ; : UNTIL'C=1 3 0 UNTIL'RB=0 ; : UNTIL'Z=0 3 2 UNTIL'RB=0 ; : UNTIL'Z=1 3 2 UNTIL'RB=0 ; : UNTIL'A=0 0 Ao# UNTIL'Z=1 ; : UNTIL'A<>0 0 Ao# UNTIL'Z=0 ; : WHILE'RB=0 ( R B ... ) IF'RB=1 ; : WHILE'RB=1 ( R B ... ) IF'RB=0 ; : WHILE'R+1=0 ( R ... ) R+1=0? ; : WHILE'R-1=0 ( R ... ) R-1=0? ; : WHILE'R+1=0>A ( R ... ) R+1=0?>A ; : WHILE'R-1=0>A ( R ... ) R-1=0?>A ; : WHILE'C=0 3 0 WHILE'RB=0 ; : WHILE'C=1 3 0 WHILE'RB=0 ; : WHILE'Z=0 3 2 WHILE'RB=0 ; : WHILE'Z=1 3 2 WHILE'RB=0 ; : WHILE'A=0 0 Ao# WHILE'Z=1 ; : WHILE'A<>0 0 Ao# WHILE'Z=0 ; : REPEAT' SWAP AGAIN' THEN' ; : IF'C=0 3 0 IF'RB=0 ; : IF'C=1 3 0 IF'RB=0 ; : IF'Z=0 3 2 IF'RB=0 ; : IF'Z=1 3 2 IF'RB=0 ; \ ======================================================= \ PART.3 DISASSEMBLER FOR EM78447 \ ======================================================= : 13C.GROUP ( N ... ) CASE 0 OF 8 SPACES ." NOP \ NOP " ENDOF 1 OF 8 SPACES ." DAA \ DAA " ENDOF 2 OF 8 SPACES ." A>CONT \ CONTW " ENDOF 3 OF 8 SPACES ." SLEEP \ SLEP " ENDOF 4 OF 8 SPACES ." WDT=0 \ WDTC " ENDOF 10 OF 8 SPACES ." EI \ ENI " ENDOF 11 OF 8 SPACES ." DI \ DISI " ENDOF 12 OF 8 SPACES ." RET \ RET " ENDOF 13 OF 8 SPACES ." RETI \ RETI " ENDOF 14 OF 8 SPACES ." CONT>A \ CONTR " ENDOF 20 OF 8 SPACES ." TBL \ TBL " ENDOF 80 OF 8 SPACES ." A=0 \ CLRA " ENDOF 1E02 OF 8 SPACES ." INT \ INT " ENDOF \ DROP ENDCASE ; : R, ( N ... ) 4 SPACES 3F AND 2 .R 2 SPACES ; \ : F,D ( N ... ) 2 SPACES 7F AND . ; : 7C6R.GROUP ( N ... ) DUP 1FC0 AND CASE 40 OF R, ." A>R \ MOV_R,A " ENDOF C0 OF R, ." R=0 \ CLR_R " ENDOF 100 OF R, ." R-A>A \ SUB_A,R " ENDOF 140 OF R, ." R-A \ SUB_R,A " ENDOF 180 OF R, ." R-1>A \ DEC_A,R " ENDOF 1C0 OF R, ." R- \ DEC_R " ENDOF 200 OF R, ." AoR \ OR_A,R " ENDOF 240 OF R, ." RoA \ OR_R,A " ENDOF 280 OF R, ." AnR \ AND_A,R " ENDOF 2C0 OF R, ." RnA \ AND_R,A " ENDOF 300 OF R, ." AxR \ XOR_A,R " ENDOF 340 OF R, ." RxA \ XOR_R,A " ENDOF 380 OF R, ." A+R \ ADD_A,R " ENDOF 3C0 OF R, ." R+A \ ADD_R,A " ENDOF 400 OF R, ." R>A \ MOV_A,R " ENDOF 440 OF R, ." R:0 \ MOV_R,A " ENDOF 480 OF R, ." /R>A \ COM_A,R " ENDOF 4C0 OF R, ." /R \ COM_R " ENDOF 500 OF R, ." R+1>A \ INC_A,R " ENDOF 540 OF R, ." R+ \ INC_R " ENDOF 580 OF R, ." R-1=0?>A \ DJZ_A,R " ENDOF 5C0 OF R, ." R-1=0? \ DJZ_R " ENDOF 600 OF R, ." RRCR>A \ RRC_A,R " ENDOF 640 OF R, ." RRCR \ RRC_R " ENDOF 680 OF R, ." RLCR>A \ DEC_A,R " ENDOF 6C0 OF R, ." RLCR \ RLC_R " ENDOF 700 OF R, ." SWAPAR \ SWAPAR " ENDOF 740 OF R, ." SWAPR \ SWAPR " ENDOF 780 OF R, ." R+1=0?>A \ JZ_A,R " ENDOF 7C0 OF R, ." R+1=0? \ JZ_R " ENDOF DROP \ 2DROP ENDCASE ; : R,B ( N ... ) 1FF AND 40 /MOD SWAP 2 .R 2 SPACES . 2 SPACES ; : 4C3B6R.GROUP ( N ... ) DUP 1E00 AND CASE 0800 OF R,B ." RB=0 \ BC_R,b " ENDOF 0A00 OF R,B ." RB=1 \ BS_R,b " ENDOF 0C00 OF R,B ." RB=0? \ JBC_R,b " ENDOF 0E00 OF R,B ." RB=1? \ JBS_R,b " ENDOF DROP \ 2DROP ENDCASE ; : 8# ( N ... ) 4 SPACES 0FF AND 2 .R 2 SPACES ; : 8#' ( N ... ) 0FF AND . ; : 10# ( N ... ) 2 SPACES 3FF AND 4 .R 2 SPACES ; : 10#' ( N ... ) 3FF AND . ; : 5C8#.GROUP ( N ... ) DUP 1F00 AND CASE 1800 OF 8# ." #>A \ MOV_A,K " ENDOF 1900 OF 8# ." Ao# \ OR_A,K " ENDOF 1A00 OF 8# ." An# \ AND_A,K " ENDOF 1B00 OF 8# ." Ax# \ XOR_A,K " ENDOF 1C00 OF 8# ." #>A,RET \ RETL_K " ENDOF 1D00 OF 8# ." #-A \ SUB_A,K " ENDOF 1F00 OF 8# ." A+# \ ADD_A,K " ENDOF DROP \ 2DROP ENDCASE ; : 3C10#.GROUP ( N ... ) DUP 1C00 AND CASE 1000 OF 10# ." CALL \ CALL " ENDOF 1400 OF 10# ." JMP \ JMP " ENDOF DROP \ 2DROP ENDCASE ; : 4R ( R ... ) 0F AND 6 .R 2 SPACES ; \ : 9C4R.GROUP ( N ... ) DUP 1FF0 AND \ CASE \ 0 OF DUP 5 6 BETWEEN OVER 0B 0F BETWEEN OR \ IF 4R ." A>IOCR \ IOWR " ELSE DROP THEN ENDOF \ \ 0 OF 4R ." A>IOCR \ IOWR " ENDOF \ 10 OF 4R ." IOCR>A \ IORR " ENDOF \ 2DROP \ ENDCASE ; : 9C4R.GROUP ( N ... ) >R R@ 1FF0 AND DUP R@ 1FE0 AND 0 = IF R@ 0F AND DUP 5 6 BETWEEN SWAP 0B 0F BETWEEN OR IF CASE 0 OF 4R ." A>IOCR \ IOWR " ENDOF 10 OF 4R ." IOCR>A \ IORR " ENDOF 2DROP ENDCASE ELSE 2DROP THEN ELSE 2DROP THEN R> DROP ; : DISASSEM ( ADDR ... ADDR' ) BASE @ >R HEX >R ." ( " R@ .XXXX 2 SPACES R@ @' .XXXX ." )" 10 SPACES R@ @' DUP 13C.GROUP DUP 4C3B6R.GROUP DUP 7C6R.GROUP DUP 5C8#.GROUP DUP 9C4R.GROUP 3C10#.GROUP R> 1 + R> BASE ! ; : FILL' ( FROM LENGTH CHAR ... ) -ROT BOUNDS DO DUP I C!' LOOP DROP ; : ERASE' ( ADDR LENGTH ... ) 0 FILL' ; : U ( ADDR ... ADDR' ) 10 0 DO CR DISASSEM LOOP ; VARIABLE SUM : .XX 0 <# # # #> TYPE ; : .XX+SUM DUP SUM +! .XX ; : >A.LINE.OF.HEX.FORMAT ( ADDR LENGTH ... ) ?DUP IF CR 0 SUM ! 3A EMIT DUP .XX+SUM OVER 100 /MOD .XX+SUM .XX+SUM 0 .XX BOUNDS DO I C@' .XX+SUM LOOP ELSE DROP THEN SUM C@ .XX ; : >HEX' ( FROM LENGTH ... ) BEGIN DUP 10 U> WHILE OVER 10 >A.LINE.OF.HEX.FORMAT 10 - SWAP 10 + SWAP REPEAT >A.LINE.OF.HEX.FORMAT ; : >HEX >HEX' CR ." :00000001FF" CR ; \ ****************************************************************************** \ PART.4 SIMULATOR FOR EM78156/78447 \ ****************************************************************************** \ 16F87XF.SIM COPYRIGHT OF CJJ JAN. 18, 2003 HEX \ FORGET OVERLAY : OVERLAY ; \ : .XXXX 0 <# # # # # #> TYPE ; \ : 16, 100 /MOD SWAP C, C, ; \ CREATE PROGRAM.MEMORY 07FF 16, 077F 16, 77F 16, 2000 ( 4000 ) ALLOT ( 8K*14 ) \ CREATE CODE>EXEC.ADDR 10000 ALLOT CODE>EXEC.ADDR 10000 ERASE \ CREATE RETURN.STACK 10000 ( 8 ) 4 * ALLOT \ CREATE CPU.MEM 400 ALLOT CPU.MEM 400 0 FILL CODE 0 PUSH EBX MOV EBX, # 0 NEXT C; CODE 1 PUSH EBX MOV EBX, # 1 NEXT C; CODE 2 PUSH EBX MOV EBX, # 2 NEXT C; CODE 3 PUSH EBX MOV EBX, # 3 NEXT C; CODE 4 PUSH EBX MOV EBX, # 4 NEXT C; CODE 5 PUSH EBX MOV EBX, # 5 NEXT C; CODE 6 PUSH EBX MOV EBX, # 6 NEXT C; CODE 7 PUSH EBX MOV EBX, # 7 NEXT C; : INDF 0 ; : TMR0 1 ; : PCL 2 ; : STATUS 3 ; : FSR 4 ; : PORTA 5 ; : PORTB 6 ; : PORTC 7 ; : PORTD 8 ; : PORTE 9 ; : PCLATH 0A ; : INTCON 0B ; : PIR1 0C ; : PIR2 0D ; : TMR1L 0E ; : TMR1H 0F ; : T1CON 10 ; : TMR2 11 ; : T2CON 12 ; : SSPBUF 13 ; : SSPCON 14 ; : CCPR1L 15 ; : CCPR1H 16 ; : CCP1CON 17 ; : RCSTA 18 ; : TXREG 19 ; : RCREG 1A ; : CCPR2L 1B ; : CCPR2H 1C ; : CCP2CON 1D ; : ADRES 1E ; : ADCON0 1F ; : PD STATUS 3 ; : TO STATUS 4 ; : RP0 STATUS 5 ; : RP1 STATUS 6 ; : IRP STATUS 7 ; : RE0 PORTE 0 ; : RE1 PORTE 1 ; : RE2 PORTE 2 ; : RBIF INTCON 0 ; : INTF INTCON 1 ; : T0IF INTCON 2 ; : RB1E INTCON 3 ; : INTE INTCON 4 ; : T0IE INTCON 5 ; : PEIE INTCON 6 ; : GIE INTCON 7 ; : TMR1IF PIR1 0 ; : TMR2IF PIR1 1 ; : CCP1IF PIR1 2 ; : SSP1F PIR1 3 ; : TXIF PIR1 4 ; : RCIF PIR1 5 ; : ADIF PIR1 6 ; : PSPIF PIR1 7 ; : CCP2IF PIR2 0 ; : BCLIF PIR2 3 ; : EEIF PIR2 4 ; : TMR1ON T1CON 0 ; : TMR1CS T1CON 1 ; : T1SYNC T1CON 2 ; : T1OSCEN T1CON 3 ; : T1CKPS0 T1CON 4 ; : T1CKPS1 T1CON 5 ; : T2CKPS0 T2CON 0 ; : T2CKPS1 T2CON 1 ; : TMR2ON T2CON 2 ; : TOUTPS0 T2CON 3 ; : TOUTPS1 T2CON 4 ; : TOUTPS2 T2CON 5 ; : TOUTPS0 T2CON 6 ; : SSPM0 SSPCON 0 ; : SSPM1 SSPCON 1 ; : SSPM2 SSPCON 2 ; : SSPM3 SSPCON 3 ; : CKP SSPCON 4 ; : SSPEN SSPCON 5 ; : SSPOV SSPCON 6 ; : WCOL SSPCON 7 ; : CCP1M0 CCP1CON 0 ; : CCP1M1 CCP1CON 1 ; : CCP1M2 CCP1CON 2 ; : CCP1M3 CCP1CON 3 ; : CCP1Y CCP1CON 4 ; : CCP1X CCP1CON 5 ; : RX9D RCSTA 0 ; : OERR RCSTA 1 ; : FERR RCSTA 2 ; : CREN RCSTA 4 ; : SREN RCSTA 5 ; : RX9 RCSTA 6 ; : SPEN RCSTA 7 ; : CCP2M0 CCP2CON 0 ; : CCP2M1 CCP2CON 1 ; : CCP2M2 CCP2CON 2 ; : CCP2M3 CCP2CON 3 ; : CCP2Y CCP2CON 4 ; : CCP2X CCP2CON 5 ; : ADON ADCON0 0 ; : GO/DONE ADCON0 2 ; : CHS0 ADCON0 3 ; : CHS1 ADCON0 4 ; : CHS2 ADCON0 5 ; : ADCS0 ADCON0 6 ; : ADCS1 ADCON0 7 ; : (C) 3 0 ; \ STATUS 0 : (DC) 3 1 ; \ STATUS 1 : (Z) 3 2 ; \ STATUS 2 : (PD) 3 3 ; \ STATUS 3 D : (TO) 3 4 ; \ STATUS 4 T : (RP0) 3 5 ; \ STATUS 5 GP0 : (RP1) 3 6 ; \ STATUS 6 GP1 : (IRP) 3 7 ; \ STATUS 7 GP2 : INVERT 0FFFF XOR ; : SPLIT ( N .... L H ) 0FFFF AND 100 /MOD ; \ 16 BITS : CSET ( N ADDR ... ) >R R@ C@ OR R> C! ; : CRESET ( N ADDR ... ) >R INVERT R@ C@ AND R> C! ; CREATE N>2^N.TABLE 1 C, 2 C, 4 C, 8 C, 10 C, 20 C, 40 C, 80 C, : N>2^N N>2^N.TABLE + C@ ; : 3b.CHECK ; \ DUP 0 7 WITHIN NOT IF . ABORT" b IS NOT IN THE RANGE 0~7" THEN ; : 7r.CHECK ; \ DUP 0 7F WITHIN NOT IF . ABORT" r IS NOT IN THE RANGE 0~7F" THEN ; : MB! 3b.CHECK N>2^N ROT >R SWAP R> IF CSET ELSE CRESET THEN ; : MB@ 3b.CHECK N>2^N SWAP C@ AND IF 1 ELSE 0 THEN ; : REG CPU.MEM + ; \ REG DUP 0= IF DROP 4 CPU.MEM + THEN ; : RB! SWAP 7r.CHECK REG SWAP MB! ; : RB@ SWAP 7r.CHECK REG SWAP MB@ ; VARIABLE A.REG VARIABLE PC \ PROGRAM COUNTER VARIABLE RP \ RETURN STACK POINTER VARIABLE WDT : RETURN.STACK.DEPTH 10 ; \ EXTRACT.R 7F AND ; \ EXTRACT.R 7F AND DUP 0= \ IF 4 REG C@ REG C@ 0 REG C! THEN ; \ EXTRACT.R 7F AND DUP 0= \ IF DROP 4 REG C@ REG C@ DUP 0 REG C! THEN ; : EXTRACT.4R 0F AND DUP 0= IF DROP 4 REG C@ THEN ; : EXTRACT.6R 3F AND DUP 0= IF DROP 4 REG C@ THEN ; : EXTRACT.3B 1C0 AND 40 / ; : EXTRACT.8# 0FF AND ; : EXTRACT.10# 3FF AND ; : CALCULATE.DC DROP 0 ; \ IGNORE NOW \ PUSH.PC 1 RP +! PC @ 1+ RP @ 4 * RETURN.STACK + ! ; \ POP.PC RETURN.STACK RP @ 4 * + @ PC ! -1 RP +! ; \ PUSH.PC 1 RP +! PC @ 1+ RP @ 4 * RETURN.STACK + ! \ RP @ RETURN.STACK.DEPTH > \ IF CR ." RETURN STACK OVERFLOW " THEN ; \ POP.PC RETURN.STACK RP @ 4 * + @ PC ! -1 RP +! \ RP @ 0< IF ." RETURN STACK UNDEFLOW" THEN ; : PUSH.PC 1 RP +! PC @ 1+ RP @ 4 * RETURN.STACK + ! RP @ RETURN.STACK.DEPTH > IF CR ." RETURN STACK OVERFLOW " THEN ; : POP.PC RETURN.STACK RP @ 4 * + @ PC ! -1 RP +! RP @ 0< IF ." RETURN STACK UNDEFLOW" THEN ; \ ========================================================================= : EXECUTE.A+R ( C ... ) EXTRACT.6R REG C@ A.REG C@ + >R R@ A.REG C! R@ 0= (Z) RB! R@ 0FF > (C) RB! R> CALCULATE.DC (DC) RB! 1 PC +! ; : EXECUTE.JMP>A+PC DROP A.REG C@ PC @ 1+ + PC ! ; \ 0782 : EXECUTE.R+A ( C ... ) EXTRACT.6R DUP REG C@ A.REG C@ + >R R@ SWAP REG ! R@ 0= (Z) RB! R@ 0FF > (C) RB! R> CALCULATE.DC (DC) RB! 1 PC +! ; : EXECUTE.R-A ( C ... ) EXTRACT.6R DUP REG C@ A.REG C@ - >R R@ SWAP REG ! R@ 0= (Z) RB! R@ 0FF > (C) RB! R> CALCULATE.DC (DC) RB! 1 PC +! ; : EXECUTE.R-A>A ( C ... ) EXTRACT.6R REG C@ A.REG C@ - >R R@ A.REG ! R@ 0= (Z) RB! R@ 0FF > (C) RB! R> CALCULATE.DC (DC) RB! 1 PC +! ; : EXECUTE.AnR ( C ... ) EXTRACT.6R REG C@ A.REG C@ AND >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.RnA ( C ... ) EXTRACT.6R DUP REG C@ A.REG C@ AND >R R@ SWAP REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.AoR ( C ... ) EXTRACT.6R REG C@ A.REG C@ OR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.RoA ( C ... ) EXTRACT.6R DUP REG C@ A.REG C@ OR >R R@ SWAP REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.AxR ( C ... ) EXTRACT.6R REG C@ A.REG C@ XOR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.RxA ( C ... ) EXTRACT.6R DUP REG C@ A.REG C@ XOR >R R@ SWAP REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.R=0 ( C ... ) EXTRACT.6R REG 0 SWAP C! -1 (Z) RB! 1 PC +! ; : EXECUTE.A=0 ( C ... ) 0 A.REG C! DROP -1 (Z) RB! 1 PC +! ; : EXECUTE./R ( C ... ) EXTRACT.6R DUP >R REG C@ FF XOR DUP R> REG C! 0= (Z) RB! 1 PC +! ; : EXECUTE./R>A ( C ... ) EXTRACT.6R REG C@ FF XOR DUP A.REG C! 0= (Z) RB! 1 PC +! ; : EXECUTE.R- ( C ... ) EXTRACT.6R DUP >R REG C@ 1- DUP R> REG C! 0= (Z) RB! 1 PC +! ; : EXECUTE.R-1>A ( C ... ) EXTRACT.6R REG C@ 1- DUP A.REG C! 0= (Z) RB! 1 PC +! ; : EXECUTE.R-1=0? ( C ... ) EXTRACT.6R DUP >R REG C@ 1- DUP R> REG C! 0= IF 2 ELSE 1 THEN PC +! ; : EXECUTE.R-1=0?>A EXTRACT.6R REG C@ 1- DUP A.REG C! 0= IF 2 ELSE 1 THEN PC +! ; : EXECUTE.R+ ( C ... ) EXTRACT.6R DUP >R REG C@ 1+ DUP R> REG C! 0= (Z) RB! 1 PC +! ; : EXECUTE.R+1>A ( C ... ) EXTRACT.6R REG C@ 1+ DUP A.REG C! 0= (Z) RB! 1 PC +! ; : EXECUTE.R+1=0? ( C ... ) EXTRACT.6R DUP >R REG C@ 1+ DUP R> REG C! 0= IF 2 ELSE 1 THEN PC +! ; : EXECUTE.R+1=0?>A EXTRACT.6R REG C@ 1+ DUP A.REG C! 0= IF 2 ELSE 1 THEN PC +! ; : EXECUTE.R>A ( C ... ) EXTRACT.6R REG C@ DUP A.REG C! 0= (Z) RB! 1 PC +! ; : EXECUTE.R:0 ( C ... ) EXTRACT.6R REG C@ 0= (Z) RB! 1 PC +! ; : EXECUTE.A>R ( C ... ) EXTRACT.6R REG A.REG C@ SWAP C! 1 PC +! ; : EXECUTE.NOP 1 PC +! DROP ; : EXECUTE.RLCR ( C ... ) EXTRACT.6R DUP >R REG C@ 2* SPLIT 0<> (C) RB! R> REG C! 1 PC +! ; : EXECUTE.RLCR>A ( C ... ) EXTRACT.6R REG C@ 2* SPLIT 0<> (C) RB! A.REG C! 1 PC +! ; : EXECUTE.RRCR ( C ... ) EXTRACT.6R DUP >R REG C@ DUP 1 AND 0<> (C) RB! 2/ R> REG C! 1 PC +! ; : EXECUTE.RRCR>A ( C ... ) EXTRACT.6R REG C@ DUP 1 AND 0<> (C) RB! 2/ A.REG C! 1 PC +! ; : EXECUTE.SWAPR ( C ... ) EXTRACT.6R DUP >R REG C@ 10 /MOD SWAP 10 * + R> REG C! 1 PC +! ; : EXECUTE.SWAPR>A EXTRACT.6R REG C@ 10 /MOD SWAP 10 * + A.REG C! 1 PC +! ; \ ========================================================================= : EXECUTE.RB=0 DUP EXTRACT.6R SWAP EXTRACT.3B 0 -ROT RB! 1 PC +! ; : EXECUTE.RB=1 DUP EXTRACT.6R SWAP EXTRACT.3B 1 -ROT RB! 1 PC +! ; : EXECUTE.RB=0? DUP EXTRACT.6R SWAP EXTRACT.3B RB@ IF 1 ELSE 2 THEN PC +! ; : EXECUTE.RB=1? DUP EXTRACT.6R SWAP EXTRACT.3B RB@ IF 2 ELSE 1 THEN PC +! ; \ ========================================================================= : EXECUTE.A+# ( C ... ) EXTRACT.8# A.REG C@ + >R R@ A.REG C! R@ 0= (Z) RB! R@ 0FF > (C) RB! R> CALCULATE.DC (DC) RB! 1 PC +! ; : EXECUTE.An# ( C ... ) EXTRACT.8# A.REG C@ AND >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.Ao# ( C ... ) EXTRACT.8# A.REG C@ OR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.Ax# ( C ... ) EXTRACT.8# A.REG C@ XOR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! ; : EXECUTE.CALL ( C ... ) PUSH.PC EXTRACT.10# PC ! ; : EXECUTE.JMP ( C ... ) EXTRACT.10# PC ! ; : EXECUTE.WDT=0 ( C ... ) 0 WDT ! DROP 1 PC +! ; : EXECUTE.#>A ( C ... ) EXTRACT.8# A.REG ! 1 PC +! ; : EXECUTE.A=0 ( ... ) 0 A.REG ! 1 PC +! ; : EXECUTE.RETI ( C ... ) POP.PC DROP ; : EXECUTE.RET ( C ... ) POP.PC DROP ; : EXECUTE.#>ARET ( C ... ) POP.PC EXTRACT.8# A.REG ! ; : EXECUTE.SLEEP ( C ... ) DROP 1 (TO) RB! 1 PC +! -1 (PD) RB! ; : EXECUTE.#-A ( C ... ) EXTRACT.8# A.REG C@ - >R R@ A.REG C! R@ 0= (Z) RB! R@ 0FF > (C) RB! R> CALCULATE.DC (DC) RB! 1 PC +! ; \ ========================================================================= \ 6C1D7R: D=0 0700 ~ 077F \ 6C1D7R: D=1 0780 ~ 07FF : !.A.RANGE.OF.JMP.CODE.ADDR ( EXEC.ADDR FROM LENGTH ... ) BOUNDS DO DUP I 4 * CODE>EXEC.ADDR + ! LOOP DROP ; : !.7C6R: !.A.RANGE.OF.JMP.CODE.ADDR ; \ 1 : !.9C4R: !.A.RANGE.OF.JMP.CODE.ADDR ; \ 2 : !.13C: !.A.RANGE.OF.JMP.CODE.ADDR ; \ 3 : !.4C3B6R: !.A.RANGE.OF.JMP.CODE.ADDR ; \ 4 : !.5C8#: !.A.RANGE.OF.JMP.CODE.ADDR ; \ 5 : !.3C10#: !.A.RANGE.OF.JMP.CODE.ADDR ; \ 6 : !.16C: !.A.RANGE.OF.JMP.CODE.ADDR ; \ 7 \ ========================================================================= : !.A+R [ ' EXECUTE.A+R ] LITERAL 700 2/ 40 !.7C6R: ; !.A+R : !.R+A [ ' EXECUTE.A+R ] LITERAL 780 2/ 40 !.7C6R: ; !.R+A : !.AnR [ ' EXECUTE.AnR ] LITERAL 500 2/ 40 !.7C6R: ; !.AnR : !.RnA [ ' EXECUTE.AnR ] LITERAL 580 2/ 40 !.7C6R: ; !.RnA : !.AoR [ ' EXECUTE.AoR ] LITERAL 400 2/ 40 !.7C6R: ; !.AoR : !.RoA [ ' EXECUTE.AoR ] LITERAL 480 2/ 40 !.7C6R: ; !.RoA : !.AxR [ ' EXECUTE.AxR ] LITERAL 600 2/ 40 !.7C6R: ; !.AxR : !.RxA [ ' EXECUTE.AxR ] LITERAL 680 2/ 40 !.7C6R: ; !.RxA : !.R=0 [ ' EXECUTE.R=0 ] LITERAL 180 2/ 40 !.7C6R: ; !.R=0 : !.A=0 [ ' EXECUTE.A=0 ] LITERAL 100 2/ 40 !.7C6R: ; !.A=0 : !./R [ ' EXECUTE./R ] LITERAL 900 2/ 40 !.7C6R: ; !./R : !.R-1>A [ ' EXECUTE.R-1>A ] LITERAL 300 2/ 40 !.7C6R: ; !.R-1>A : !.R- [ ' EXECUTE.R- ] LITERAL 380 2/ 40 !.7C6R: ; !.R- : !.R-1=0?>A [ ' EXECUTE.R-1=0?>A ] LITERAL B00 2/ 40 !.7C6R: ; !.R-1=0?>A : !.R-1=0? [ ' EXECUTE.R-1=0? ] LITERAL B80 2/ 40 !.7C6R: ; !.R-1=0? : !.R+1>A [ ' EXECUTE.R+1>A ] LITERAL A00 2/ 40 !.7C6R: ; !.R+1>A : !.R+ [ ' EXECUTE.R+ ] LITERAL A80 2/ 40 !.7C6R: ; !.R+ : !.R+1=0?>A [ ' EXECUTE.R+1=0?>A ] LITERAL F00 2/ 40 !.7C6R: ; !.R+1=0?>A : !.R+1=0? [ ' EXECUTE.R+1=0? ] LITERAL F80 2/ 40 !.7C6R: ; !.R+1=0? : !.R>A [ ' EXECUTE.R>A ] LITERAL 800 2/ 40 !.7C6R: ; !.R>A : !.R:0 [ ' EXECUTE.R:0 ] LITERAL 880 2/ 40 !.7C6R: ; !.R:0 : !.A>R [ ' EXECUTE.A>R ] LITERAL 080 2/ 40 !.7C6R: ; !.A>R : !.RLCR>A [ ' EXECUTE.RLCR ] LITERAL D00 2/ 40 !.7C6R: ; !.RLCR>A : !.RLCR [ ' EXECUTE.RLCR ] LITERAL D80 2/ 40 !.7C6R: ; !.RLCR : !.RRCR>A [ ' EXECUTE.RRCR ] LITERAL C00 2/ 40 !.7C6R: ; !.RRCR>A : !.RRCR [ ' EXECUTE.RRCR ] LITERAL C80 2/ 40 !.7C6R: ; !.RRCR : !.R-A [ ' EXECUTE.R-A ] LITERAL 200 2/ 40 !.7C6R: ; !.R-A : !.R-A>A [ ' EXECUTE.R-A>A ] LITERAL 280 2/ 40 !.7C6R: ; !.R-A>A : !.SWAPR>A [ ' EXECUTE.SWAPR>A ] LITERAL E00 2/ 40 !.7C6R: ; !.SWAPR>A : !.SWAPR [ ' EXECUTE.SWAPR ] LITERAL E80 2/ 40 !.7C6R: ; !.SWAPR : !.A=0 [ ' EXECUTE.A=0 ] LITERAL 80 1 !.16C: ; : !.NOP [ ' EXECUTE.NOP ] LITERAL 0 1 !.16C: ; !.NOP : !.WDT=0 [ ' EXECUTE.WDT=0 ] LITERAL 4 1 !.16C: ; !.WDT=0 : !.RETI [ ' EXECUTE.RETI ] LITERAL 13 1 !.16C: ; !.RETI : !.RET [ ' EXECUTE.RET ] LITERAL 12 1 !.16C: ; !.RET : !.SLEEP [ ' EXECUTE.SLEEP ] LITERAL 3 1 !.16C: ; !.SLEEP \ ========================================================================= : !.RB=0 [ ' EXECUTE.RB=0 ] LITERAL 1000 2/ 400 2/ !.4C3B6R: ; !.RB=0 : !.RB=1 [ ' EXECUTE.RB=1 ] LITERAL 1400 2/ 400 2/ !.4C3B6R: ; !.RB=1 : !.RB=0? [ ' EXECUTE.RB=0? ] LITERAL 1800 2/ 400 2/ !.4C3B6R: ; !.RB=0? : !.RB=1? [ ' EXECUTE.RB=1? ] LITERAL 1C00 2/ 400 2/ !.4C3B6R: ; !.RB=1? \ ========================================================================= : !.A+# [ ' EXECUTE.A+# ] LITERAL 3E00 2/ 200 2/ !.5C8#: ; !.A+# : !.#-A [ ' EXECUTE.#-A ] LITERAL 3C00 2/ 200 2/ !.5C8#: ; !.#-A : !.An# [ ' EXECUTE.An# ] LITERAL 3900 2/ 100 2/ !.5C8#: ; !.An# : !.Ao# [ ' EXECUTE.Ao# ] LITERAL 3800 2/ 100 2/ !.5C8#: ; !.Ao# : !.Ax# [ ' EXECUTE.Ax# ] LITERAL 3A00 2/ 100 2/ !.5C8#: ; !.Ax# : !.CALL [ ' EXECUTE.CALL ] LITERAL 2000 2/ 800 2/ !.3C10#: ; !.CALL : !.JMP [ ' EXECUTE.JMP ] LITERAL 2800 2/ 800 2/ !.3C10#: ; !.JMP : !.#>A [ ' EXECUTE.#>A ] LITERAL 3000 2/ 400 2/ !.5C8#: ; !.#>A : !.#>ARET [ ' EXECUTE.#>ARET ] LITERAL 3400 2/ 400 2/ !.5C8#: ; !.#>ARET \ ============================================================================ : @.PROGRAM 2* PROGRAM.MEMORY + @ 0FFFF AND ; \ 14 BITS ONLY \ : @.PROGRAM @' ; VARIABLE SINGLE.STEP? 0 SINGLE.STEP? ! : SINGLE.STEP SINGLE.STEP? @ -1 XOR SINGLE.STEP? ! ; DEFER TP' DEFER DISASSEM' : .RETURN.STACK ." rp>" RP @ 0 ?DO RETURN.STACK I 1+ 4 * + ? LOOP ; : .RP .RETURN.STACK ; : .BINARY 8 0 DO 2 /MOD LOOP DROP SPACE 8 0 DO . 8 EMIT ( BS ) LOOP ; VARIABLE BREAK.POINT? 0 BREAK.POINT? ! : .CPU.MEM 20 0 DO CR CPU.MEM I + C@ 3 .R 5 SPACES CPU.MEM I + 80 + C@ 3 .R 5 SPACES CPU.MEM I + 100 + C@ 3 .R 5 SPACES CPU.MEM I + 180 + C@ 3 .R LOOP ; \ : TP 3 REG C@ .BINARY .RETURN.STACK ; VARIABLE FAST? 0 FAST? ! : TP BREAK.POINT? @ IF .CPU.MEM ELSE FAST? @ \ SINGLE.STEP? @ IF ELSE PC @ 6 .R ." : " 27 REG C@ 3 .R 3 REG C@ .BINARY .RETURN.STACK THEN THEN ; : QUEUE.TP.MAX 20 ; CREATE QUEUE.TP QUEUE.TP.MAX 1+ 4 * ALLOT VARIABLE QUEUE.TP.COUNTER : >QUEUE.TP QUEUE.TP.COUNTER @ 1+ QUEUE.TP.MAX > IF CR ." QUEUE.TP.MAX IS " QUEUE.TP.MAX . BASE @ >R DECIMAL ." , NO MORE QUEUE AVAILABLE NOW!" R> BASE ! ELSE QUEUE.TP QUEUE.TP.COUNTER @ 4 * + ! 1 QUEUE.TP.COUNTER +! THEN ; : TP 0 QUEUE.TP.MAX 4 * 0 DO QUEUE.TP I + @ PC @ = OR 4 +LOOP IF CR PC @ DISASSEM' DROP A.REG C@ 3 .R 3 REG C@ .BINARY .RETURN.STACK THEN ; : RESET.QUEUE.TP.COUNTER 0 QUEUE.TP.COUNTER ! QUEUE.TP QUEUE.TP.MAX 4 * FF FILL CR ." QUEUE.TP .... " CR QUEUE.TP QUEUE.TP.MAX 4 * DUMP ; : RESET 0 RP ! RESET.QUEUE.TP.COUNTER ; DEFER DISASSEM"" VARIABLE SHOW.NAME? -1 SHOW.NAME? ! VARIABLE UNASSEMBLE(pic.")? DEFER _MM : G ( ADDR ... ) 0 UNASSEMBLE(pic.")? ! \ 8 _MM DUP 0= IF RESET THEN PC ! \ 0 SHOW.NAME? ! BEGIN CR PC @ ." ( " DUP .XXXX PC @ @.PROGRAM 2 SPACES .XXXX ." ) " DISASSEM"" DROP PC @ @.PROGRAM DUP 4 * CODE>EXEC.ADDR + @ EXECUTE A.REG @ 3 .R 3 REG C@ .BINARY TP' .RETURN.STACK KEY 1B = ( ESC ) UNTIL ; : CONTINUE PC @ G ; : CON CONTINUE ; : RUN PC ! 0 RP ! RESET BEGIN TP' PC @ DUP >R @.PROGRAM DUP 4 * CODE>EXEC.ADDR + @ EXECUTE R@ 21C ( RX ) = IF KEY A.REG ! POP.PC THEN R> 20A ( TX ) = IF A.REG C@ EMIT POP.PC THEN KEY? IF KEY CASE 1B ( ESC ) OF -1 ENDOF 58 ( X ) OF 0 ENDOF 59 ( Y ) OF 0 ENDOF 53 ( S ) OF SINGLE.STEP CR TP' 0 ENDOF 0 ENDCASE ELSE 0 THEN UNTIL ; ' TP IS TP' : UU U U ; : UUU U U U ; : UUUU U U U U ; : DUMP16 ( ADDR LENGTH ... ) 2 / 0 \ 16 BITS MODE ?DO I 10 MOD 0 = IF CR DUP I + 4 U.R ." :" THEN I 4 MOD 0 = IF 2 SPACES THEN DUP I + 2 * CP0 + @ 0FFFF AND .XXXX SPACE LOOP DROP ; : DUMP8 ( ADDR' LENGTH.8BIT ... ) SWAP 2 * CP0 + SWAP DUMP ; \ 8 BITS MODE : DUMP' 2DUP DUMP8 DUMP16 ; : FILL' >R >R 2* CP0 + R> R> FILL ; : ERASE' 0 FILL' ; \ : _T:? DROP -1 ; ' _T:? IS T:? \ ============================================================ \ [SWAP] A<->(0) ; \ : [DUP] ; \ : [FLIP] ; \ : 0~F>ASC [ 0F An# F6 A+# IF'C=1 7 A+# THEN' 3A A+# ] ; \ : 0~FF>ASC [ [DUP] ] 0~F>ASC [ [SWAP] [FLIP] ] 0~F>ASC ; \ : ASC>0~F D0 A+# \ IF'C=1 F6 A+# \ 30~39 ==> F6~FF \ IF'C=0 0A A+# RET \ 0~9 \ THEN' A.5=0 F9 A+# \ a~f --> A~F \ IF'C=1 FA A+# \ 41~46 ==> F6~FF \ IF'C=0 0F An# RET \ A~F \ THEN' \ THEN' \ THEN' ; \ : AND \ COMPILING? @ \ IF NUMBER.PRECEED? @ \ IF An# EXIT \ THEN \ THEN AND ; \ : ZZZ ( CP0 100 ERASE ) 0 CP ! ; VARIABLE SUM : .XX 0 <# # # #> TYPE ; : .XX+SUM DUP SUM +! .XX ; : >A.LINE.OF.HEX.FORMAT ( ADDR LENGTH ... ) ?DUP IF CR 0 SUM ! 3A EMIT DUP .XX+SUM OVER 100 /MOD .XX+SUM .XX+SUM 0 .XX BOUNDS DO I C@' .XX+SUM LOOP ELSE DROP THEN SUM C@ .XX ; : >HEX' ( FROM LENGTH ... ) BEGIN DUP 10 U> WHILE OVER 10 >A.LINE.OF.HEX.FORMAT 10 - SWAP 10 + SWAP REPEAT >A.LINE.OF.HEX.FORMAT ; : >HEX >HEX' CR ." :00000001FF" CR ; \ \s \ ===================================================== \ PIC16F87X monitor program \ ===================================================== : T>N 0 A>R ; \ SP = R4 T = A : N>T 0 R>A ; \ |--------| |--------| : SP+ 4 R+ ; \ | N | | 4 4 | : SP- 4 R- ; \ |--------| |--------| : DUP' SP+ T>N ; : DROP' N>T SP- ; \ : SWAP' 1 T>R' N>T 1 R'>T ; \ N' N \ N" N' N : (SP)>A 0 R>A ; \ 70 71 72 73 : (SP)>T 0 R>A ; \ --|--------|--------|--------|--------|-- : T>(SP) 0 A>R ; \ 1 1 2 2 3 3 | | : A>(SP) 0 A>R ; \ --|--------|--------|--------|--------|-- : A>R0 0 A>R ; \ A>(R4) : R0>A 0 R>A ; \ (R4)>A : A>(0) 0 A>R ; \ A>(R4) : (0)>A 0 R>A ; \ (R4)>A \ : R.OFFSET 0 ; \ T ==> Top of stack : ORG CP' ! ; \ N ==> Next of stack : DI 0B 7 RB=0 ; \ SP ==> Stack Pointer : EI 0B 7 RB=1 ; \ : DROP' N>T SP- ; : R>A' R.OFFSET + R>A ; \ : DUP' SP+ T>N ; : A>R' R.OFFSET + A>R ; \ : SWAP' T>T1 N>T T1>N ; : PUSH.A 0 R+ A>(0) ; \ No PUSH, POP instruction in PIC microcomputer, : POP.A (0)>A 0 R- ; \ We can make it with the software stack. Common : PUSH R>A' PUSH.A ; \ : POP POP.A A>R' ; : BANK0 3 5 RB=0 ; : BANK1 3 5 RB=1 ; : (RX) 20 0 ; : (TX) 20 0 ; : RX=0? (RX) RB=0? ; : R.OFFSET 20 ; \ FOR PIC 16F877X === 20 , FOR 8051 === 0 . : TX=0 (TX) RB=0 ; : TX=1 (TX) RB=1 ; : UNTIL'RX=0 (RX) UNTIL'RB=0 ; : UNTIL'RX=1 (RX) UNTIL'RB=1 ; : UNTIL'R'-1=0 R.OFFSET + UNTIL'R-1=0 ; : UNTIL'R-1=0' R.OFFSET + UNTIL'R-1=0 ; : IF'RX=1 0 0 IF'RB=1 ; : #>R SWAP #>A A>R ; : #>R' R.OFFSET + #>R ; : A>R' R.OFFSET + A>R ; : R>A' R.OFFSET + R>A ; : R+' R.OFFSET + R+ ; : R-' R.OFFSET + R- ; : SWAPR' R.OFFSET + SWAPR ; : SWAPRA' R.OFFSET + SWAPRA ; : SWAPAR' SWAPRA' ; : RRCR' R.OFFSET + RRCR ; : AoR' R.OFFSET + AoR ; : JMP>A+PC 2 R+A ; ( ADDWF PCL,W ) : JMP>PC+A JMP>A+PC ; 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> @ 2000 + ,' ; \ TARGET ASSEMBLING \ : :T T: ; : T; RET ; : ;T RET ; : 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:? \ ------------------------------------------------------------------------- : C>RB ( R B ... ) 2DUP IF'C=1 >R RB=1 R> ELSE' >R RB=0 R> THEN' ; : /C>RB ( R B ... ) 2DUP IF'C=0 >R RB=1 R> ELSE' >R RB=0 R> THEN' ; \ : RB>C ( R B ... ) C=0 IF'RB=1 C=1 THEN' ; \ : /RB>C ( R B ... ) C=0 IF'RB=0 C=1 THEN' ; : RB>C ( R B ... ) C=0 RB=0? C=1 ; : /RB>C ( R B ... ) C=0 RB=1? C=1 ; : C>TX ( ....... ) (TX) C>RB ; : /C>TX ( ....... ) (TX) /C>RB ; : RX>C ( ....... ) (RX) RB>C ; : /RX>C ( ....... ) (RX) /RB>C ; : GET.SUBROUTINE.ADDR HERE' 1- @' 7FF ( 14 bit opcode ) AND -1 ALLOT' ; : ,JMP DUP IF GET.SUBROUTINE.ADDR THEN JMP ; : RET' HERE' 1- @' 3800 AND 2000 = IF GET.SUBROUTINE.ADDR JMP ELSE RET THEN ; VARIABLE RET? : RT RET? @ -1 XOR RET? ! ; : RET RET? @ IF RET' ELSE RET THEN ; : ,JMP HERE' 1- @' 3800 AND 2000 = IF GET.SUBROUTINE.ADDR JMP ELSE ABORT" can only be used right after subroutine call! " THEN ; \ ===================================================== \ **** PIC16F87X monitor program **** \ ===================================================== \ Common easy natural language \ START 0 1 2 3 4 5 6 7 START 0 1 \ TX ------_____-----_____-----_____-----_____-----_____-----_____-----_____-- \ RX ^^^^^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^^^^ ^ ^ ^ \ |20| 40 | 40 | 40 | 40 | 40 | 40 | 40 | 40 | |20| 40 | 40 | \ 7F ORG T: GO.TBL 200 ORG \ T: RX [ BEGIN' 98 UNTIL'B=1 98 B=0 99 D>A ] ; ( ... A ) \ 8051 T: DELAY.52uS $ 1 + CALL \ Common T: DELAY.26uS 26 #>A \ Common T: DELAY 1 A>R' BEGIN' 1 UNTIL'R-1=0' RET \ Common \ T: TX [ 99 B=0 99 A>D BEGIN' 99 UNTIL'B=1 99 B=0 ] RET \ 8051 \ T: TX IF'A=0 RET ( A ... ) \ Common R1 \ ENDIF' 1 A>R' 9 2 #>R' C=0 ( START BIT=0 ) \ BEGIN' IF'C=0 TX=1 \ ELSE' TX=0 \ ENDIF' DELAY.52uS 1 RRCR \ 2 UNTIL'R-1=0' TX=1 DELAY.52uS RET ( STOP BIT=1 ) T: TX 0 Ao# IF'Z=1 RET THEN' ( A ... ) \ Common R1 1 A>R' 9 2 #>R' C=0 ( START BIT=0 ) BEGIN' NOP /C>TX DELAY.52uS 1 RRCR' 2 UNTIL'R-1=0' TX=1 DELAY.52uS RET ( STOP BIT=1 ) \ T: RX 9 2 #>R' BEGIN' UNTIL'RX=0 DELAY.T/2 ( START BIT=0 ) \ BEGIN' C=0 IF'RX=1 C=1 ENDIF' 1 RRCR' DELAY.52uS \ 2 UNTIL'R-1=0' 1 R>A' RET \ Common R1,2 T: RX 9 2 #>R' BEGIN' UNTIL'RX=0 DELAY.26uS ( START BIT=0 ) BEGIN' NOP RX>C 1 RRCR' DELAY.52uS 2 UNTIL'R-1=0' 1 R>A' RET \ Common R1,2 \ \S T: SPACE' 20 #>A TX RET \ Common R1,2 T: CRLF 0A #>A TX 0D #>A TX RET \ Common R1,2 T: 0~F>ASC 0F An# F6 A+# IF'C=1 7 A+# ENDIF' 3A A+# RET ( A ... A ) \ Common T: .n 0~F>ASC TX RET \ Common R1,2 \ T: .' [ PUSH.A SWAPA ] .n [ POP.A PUSH.A ] .n [ POP.A ] RET \ 8051 T: .' 3 A>R' 3 SWAPRA' .n 3 R>A' .n RET \ Common R1,2,3 \ T: .STR$ [ 82 POP~ ( ... ) \ 8051 \ BEGIN' 0 #>A (A+DP)>A \ IF'A=0 1 #>A JMP>A+DP ENDIF' ] TX [ DP+ \ AGAIN' ] RET \ T: ."51 82 POP~ (DP)>A 4 A>R' ( length data1 data2 ... ) \ 8051 \ BEGIN' DP+ (DP)>A TX 4 UNTIL'R-1=0' DP+ 82 PUSH~ RET HERE' 0F5 ORG' ( | ) ( | ) T: (pic.") 6 A>R' HERE' 9 + CALL 7 A>R' ( length ) ( | ) BEGIN' 6 R+' 6 R>A' HERE' 5 + CALL TX 7 UNTIL'R-1=0' RET ( | ) JMP>PC+A ORG' : pic." TABLE.OFFSET @ #>A (pic.") HERE' TABLE.OFFSET @ 100 + ORG' ( | ) 22 ( " ) WORD COUNT DUP #>ARET 1 TABLE.OFFSET +! BOUNDS DO 1 TABLE.OFFSET +! I C@ #>ARET LOOP ORG' TABLE.OFFSET @ 0FF > IF ." table.offset overflow >255" THEN ; \ (pic.") JMP>A+PC length data1 data2 ... \ Common R1,2,5 \ T: not0~F.TBL RL A+ JMP>A+PC ( placed below xxE0 ) \ 8051 \ 46 ( F ) #>A RET 7E ( ~ ) #>A RET 30 ( 0 ) #>A RET 20 ( ) #>A RET \ 2D ( - ) #>A RET 3C ( < ) #>A RET 20 ( ) #>A RET 3F ( ? ) #>A RET \ T: not0~F.TBL JMP>A+PC ( ADDWF PCL,W ) \ PIC \ 46 ( F ) #>ARET 7E ( ~ ) #>ARET 30 ( 0 ) #>ARET 20 ( ) #>ARET \ 2D ( - ) #>ARET 3C ( < ) #>ARET 20 ( ) #>ARET 3F ( ? ) #>ARET \ T: not0~F A=0 not0~F.TABLE 5 A>R' ( length ) 1 6 #>R' \ BEGIN' 6 R>A' not0~F.TBL TX 5 UNTIL'R-1=0' RET \ Common R1,2,5 \ T: TP PUSH.A STATUS PUSH 1 PUSH 2 PUSH ( save registers ) \ 35 #>A TX 35 #>A TX 35 #>A TX \ Common \ 2 POP 1 POP STATUS POP POP.A RET ( restore registers ) T: not0~F pic." ? <- 0~F" RET ( ... ) \ Common \ T: notA~Z ."_ 8 C,' ," ? <- A~Z" 0000 JMP ( ... ) \ Common T: notA~Z pic." ? <- A~Z" RET ( ... ) \ Common \ T: ."_ #>SP BEGIN' N>T RX SP+ 5 UNTIL'R-1=0' RET T: ASC>0~F D0 A+# ( 30 ... 0 ) \ Common IF'C=1 F6 A+# \ 30~39 => F6~FF IF'C=0 0A A+# RET \ 0~9 ENDIF' DF An# \ lower case -> UPPER CASE F9 A+# \ IF'C=1 FA A+# \ 41~46 => FA~FF IF'C=0 0F An# RET \ A~F ENDIF' ENDIF' ENDIF' not0~F RET \ 0000 JMP T: GET.n RX ASC>0~F RET ( ... 0~F ) \ Common \ T: GET2n GET.n SWAPA 5 A>R GET.n 5 AoR RET ( ... 12 ) \ 8051 T: GET2n GET.n 5 A>R' 5 SWAPR' GET.n 5 AoR' RET \ Common R5 \ T: INIT.51 [ 20 89 #>D 41 88 #>D FD 8D #>D 50 98 #>D 50 0 #>R 68 1 #>R ] RET T: INIT.PIC 0B R=0 BANK1 A=0 7 A>R BANK0 FE 7 #>R 50 0 #>R 68 1 #>R' RET \ T: GET.A~Z RX [ E5 B=0 PUSH.A ] TX [ POP.A BF A+# ] \ A~Z and above \ [ IF'C=0 ] notA~Z RET [ ENDIF' PUSH.A E6 A+# ] \ below Z \ [ IF'C=1 ] notA~Z RET [ ENDIF' POP.A ] RET ( ... A ) T: GET.A~Z RX 0DF An# 6 A>R' TX 6 R>A' BF A+# \ A~Z and above IF'C=0 notA~Z ENDIF' 6 A>R' E6 A+# \ below Z \ R6 IF'C=1 notA~Z ENDIF' 6 R>A' RET ( A ~ Z ) \ Common \ T: GET.A~Z RX 0DF An# 6 A>R' TX 6 R>A' BF A+# \ A~Z and above \ IF'C=0 notA~Z ENDIF' 6 A>R' E6 A+# \ below Z \ R6 \ IF'C=1 notA~Z ENDIF' 6 R>A' \ 41 A+# TX BF A+# RET ( A ~ Z ) \ Common \ T: GO.A~Z [ ' GO.TBL #>DP ( 0 ~ 25 ) \ 8051 \ RL 7 A>R (A+DP)>A PUSH.A \ 7 R>A A+ (A+DP)>A PUSH.A ] RET T: GO.A~Z GO.TBL CRLF RET \ T: START [ DI ] INIT \ 8051 \ .STR$ [ ," 8-bits Forth 035201382 Taiwan" 0 C, \ BEGIN' 2F #>RP DI 0 B=0 ] \ .STR$ [ 0D C, ," *" 0 C, \ 9B B=0 ] GET.A~Z [ PUSH.A ] SPACE' [ POP.A ] GO.A~Z \ [ AGAIN' ] RET T: START 70 4 #>R' ( SP ) DI INIT.PIC ( INIT.51 ) ( INIT.AVR ) ( INIT.EMC ) \ Common CRLF pic." 8-bits Forth 035201382 Taiwan" BEGIN' ( 60 #>RP ) DI CRLF pic." * " GET.A~Z ( 7 #>A ) GO.A~Z C=0 UNTIL'C=1 \ AGAIN' T: GO RET \ GO 1234 \ 2 2 #>R' \ Common \ BEGIN' GET.n 6 A>R' 6 SWAPR' .n GET.n 5 A>R' .n \ 5 R>A' 6 AoR' PUSH.A \ 2 UNTIL'R-1=0' RET \ POP.A F0 POP PUSH.A F0 PUSH RET \ :1000000000741222F010044C034F5202F010044C02 \ :09001000034F5202F010044C03EE \ 1 2 3 4 5 6 6 6 6 6 6 6 6 6 7 \ :00000001FF \ 8 9 A B \ T: DOWNLOAD [ 3E #>A ] TX \ 3E is > 51 \ [ BEGIN' BEGIN' ] RX ( 1 ) \ 3A is : \ [ 3A UNTIL'A=# ] GET2n [ 3 A>R ( 2 ) \ LENGTH \ WHILE'A<>0 ] GET2n [ 83 A>D ( 3 ) \ ADDR.H \ ] GET2n [ 82 A>D ( 4 ) \ ADDR.L \ ] GET2n ( 5 ) \ RECORD \ [ BEGIN' ] GET2n [ A>(DP) ( 6 ) DP+ \ DATA \ 3 UNTIL'R-1=0 ] GET2n ( 7 ) [ 2E #>A ] TX \ [ REPEAT' ] \ 2E is . \ GET2n GET2n GET2n GET2n [ 3B #>A ( 3b is ; ) ] TX \ [ 0000 JMP ] RET T: DOWNLOAD RET T: ESCAPE RET \ Common T: HELP pic." Dump Go Help Test" 0 C, ( 0000 JMP ) RET \ Common \ : GET.SUBROUTINE.ADDR HERE' 1- @' 7FF ( 14 bit opcode ) AND -1 ALLOT' ; \ : ,JMP DUP IF GET.SUBROUTINE.ADDR THEN JMP ; T: UPLOAD 5 4 #>R' BEGIN' 4 R>A' 03 An# IF'Z=1 CRLF THEN' 4 R>A' TX ( SPACE' ) (SP)>A TX \ Common 4 UNTIL'R-1=0' CRLF RET \ PIC-->PC \ T: UPLOAD Z=1 IF'Z=0 CRLF CRLF CRLF CRLF CRLF THEN' RET \ T: UPLOAD CRLF CRLF CRLF CRLF CRLF RET HERE' 0 ORG START ,JMP \ START GET.SUBROUTINE.ADDR JMP \ 0 ORG ' START JMP 3 ORG 0000 JMP 0B ORG 0000 JMP \ 8051 \ 13 ORG 0000 JMP 1B ORG 0000 JMP \ 23 ORG 0000 JMP 2B ORG 0000 JMP \ 12345678 ( DUMMY NUMMBER ) ( ' GO.TBL ) 7F ORG JMP>A+PC \ i.e. GODO' \ Common ( 0: A ) RET ( 1: B ) RET ( 2: C ) RET DOWNLOAD ( 3: D ) ,JMP ESCAPE ( 4: E ) ,JMP ( 5: F ) RET GO ( 6: G ) ,JMP HELP ( 7: H ) ,JMP ( 8: I ) RET ( 9: J ) RET ( 0A: K ) RET ( 0B: L ) RET ( 0C: M ) RET ( 0D: N ) RET ( 0E: O ) RET UPLOAD ( 0F: P ) ,JMP ( 10: Q ) RET ( 11: R ) RET ( 12: S ) RET ( 13: T ) RET ( 14: U ) RET ( 15: V ) RET ( 16: W ) RET ( 17: X ) RET ( 18: Y ) RET ( 19: Z ) RET ORG' \ : (pic.") ( A=0 ) 6 A>R' HERE' 7 + CALL 7 A>R' ( length ) \ BEGIN' 6 R+' 6 R>A' HERE' 4 + CALL TX 7 UNTIL'R-1=0' ; \ : pic." HERE' TABLE.OFFSET @ #>A (pic.") RET TABLE.OFFSET @ \ BL WORD COUNT DUP #>ARET BOUNDS \ DO I C@ #>ARET 1 TABLE.OFFSET +! LOOP ; \ \ ( input A = offset ) \ (pic.") 6 A>R' \ XX00 CALL \ 7 A>R' ( length ) \ BEGIN' 6 R+' \ 6 R>A' \ XX00 CALL ( data ) \ TX \ 7 UNTIL'R-1=0' \ RET \ XX00 JMP>A+PC \ length #>A.RET \ data.1 #>A.RET \ ...... #>A.RET \ ...... #>A.RET \ data.m #>A.RET \ length #>A.RET \ data.1 #>A.RET \ ...... #>A.RET \ ...... #>A.RET \ data.m #>A.RET \ ====================================================================== \ CASE 11 OF ... ENDOF ... ENDCASE for PIC16F87X \ ====================================================================== VARIABLE RESOLVE : CASE' 5 A>R' 0 RESOLVE ! HERE' ; : OF' 5 R>A' Ax# IF'A=0 1 RESOLVE +! ; : ENDOF' ( 7FF JMP ) HERE' JMP THEN' ; : ENDCASE' NOP HERE' SWAP DO I @' 2FFF = IF HERE' 2800 + I !' -1 RESOLVE +! THEN LOOP RESOLVE @ IF ." NOT PAIRED ?" THEN ; T: EXAMPLE CASE' 11 OF' 11 #>A ENDOF' 22 OF' 22 #>A ENDOF' 33 OF' 33 #>A ENDOF' 44 #>A 55 #>A ENDCASE' 66 #>A 77 #>A RET \ T: EXAMPLE \ SELECT.CASE \ CASE 11 11 #>A \ CASE 22 22 #>A \ CASE 33 33 #>A \ CASE.ELSE 44 #>A \ 55 #>A \ END.SELECT 66 #>A \ 77 #>A \ RET \ ========================================================================== \ **** BASIC compatible structural instruction **** for PIC 16F87X \ ========================================================================== \ FORGET OVERLAY RAM0 100 ORG : DO.WHILE'A=0 BEGIN' WHILE'A=0 ; : LOOP' REPEAT' ; : DO' BEGIN' ; : LOOP.WHILE'A=0 UNTIL'A<>0 ; : DO.UNTIL'A=0 BEGIN' WHILE'A<>0 ; : LOOP.UNTIL'A=0 UNTIL'A=0 ; : IF'A=0.THEN IF'A=0 ; : FOR' 5 #>R' BEGIN' ; : NEXT' 5 UNTIL'R-1=0' ; : I' 5 R>A' ; \ usage: 12 FOR' I' .' NEXT' 12 FOR' I' .' NEXT' RET DO.WHILE'A=0 A+ A+ LOOP' RET DO' A- A- LOOP.WHILE'A=0 RET COMMENT: \ =========================================================================== \ CASE 11 OF ... ENDOF ... ENDCASE \ 8051 not Forth version \ =========================================================================== \ This CASE ... OF ... ENDOF ... ENDCASE ... clause \ can be used in assembling 8-bit machine code only. \ We can moderately utilize it in 16-bit system or high level program. \ It depends on how much we realize it. FORGET OVERLAY RAM0 100 ORG : JMP LJMP ; 10 D671 ! \ 8051 VARIABLE RESOLVE : CASE' 5 A>R 0 RESOLVE ! HERE' ; : OF' 5 R>A Ax# IF'A=0 1 RESOLVE +! ; : ENDOF' FFFF JMP THEN' ; : ENDCASE' HERE SWAP DO I C@ 2 = I 1+ @ FFFF = AND \ FFFF JMP \ 8051 IF HERE FLIP I 1+ ! -1 RESOLVE +! \ 8051 THEN LOOP RESOLVE @ IF ." NOT PAIRED ?" THEN ; T: EXAMPLE' \ dup' if Forth version is anticepated CASE' 11 OF' 11 #>A ENDOF' 22 OF' 22 #>A ENDOF' 33 OF' 33 #>A ENDOF' 44 #>A 55 #>A ENDCASE' 66 #>A 77 #>A RET \ ====================================================================== \ **** BASIC compatible structural instruction **** for 8051 \ ====================================================================== FORGET OVERLAY RAM0 100 ORG : DO.WHILE'A=0 BEGIN' WHILE'A=0 ; : LOOP' REPEAT' ; : DO' BEGIN' ; : LOOP.WHILE'A=0 UNTIL'A<>0 ; : DO.UNTIL'A=0 BEGIN' WHILE'A<>0 ; : LOOP.UNTIL'A=0 UNTIL'A=0 ; : IF'A=0.THEN IF'A=0 ; : FOR' 5 #>R' BEGIN' ; : NEXT' 5 UNTIL'R-1=0' ; : I' 5 R>A' ; \ usage: 12 FOR' I .' NEXT' 12 FOR' I .' NEXT' HERE' DOWHILE'A=0 LOOP' DO' LOOP.WHILE'A=0 DO'WHILE'A=0 LOOP' COMMENT; ' DISASSEM IS DISASSEM' \ : HELP CR ." RX INST " \ CR ." RUN " ; : P ( FROM LENGTH ... ) QUEUE.TP.COUNTER @ 1+ QUEUE.TP.MAX > IF ." QUEUE.TP.MAX IS LIMIT TO " QUEUE.TP.MAX . ." ONLY NOW!" ELSE QUEUE.TP.MAX MIN BOUNDS DO I >QUEUE.TP LOOP QUEUE.TP QUEUE.TP.MAX 4 * DUMP THEN ; RESET CR 27C 10 P : >> HEX CP0 PROGRAM.MEMORY 1000 CMOVE ; >> : << HEX PROGRAM.MEMORY CP0 1000 CMOVE ; : EXECUTE' HERE' 1- @' 7FF AND -1 ALLOT' G ; \ 0~F>ASC EXECUTE' : EXECUTE" DUP @ [ ' GO.TBL @ ] LITERAL = \ ' 0~F>ASC EXECUTE" IF 4 + @ G ELSE ." not a valid CALL address, use 123 G to do it !" THEN ; : G >> G ; : NFA? ( CFA' ... NFA' -1/0 ) 0 SWAP [ ' GO.TBL ] LITERAL 1000 BOUNDS DO I 4 + @ 2DUP = IF DROP 2DROP I >NAME -1 -1 LEAVE ELSE DROP THEN 8 +LOOP DROP ; : NFA? ( CFA' ... NFA' -1/0 ) 0 SWAP HERE [ ' GO.TBL ] LITERAL \ 10000 ) \ BOUNDS DO I 4 + @ 2DUP = IF DROP 2DROP I >NAME -1 -1 LEAVE ELSE DROP THEN 8 +LOOP DROP ; \ ' NFA? IS _NFA? : (SEE') 4 + @ 0FFFF AND U ; : SEE' ' (SEE') ; : SEE ' DUP @ ['] RX @ = IF (SEE') ELSE (SEE) THEN ; CREATE BEGIN.QUEUE 800 ALLOT BEGIN.QUEUE 800 0FF FILL CREATE UNTIL.QUEUE 800 ALLOT UNTIL.QUEUE 800 0FF FILL CREATE IF.QUEUE 800 ALLOT IF.QUEUE 800 0FF FILL CREATE ELSE.QUEUE 800 ALLOT ELSE.QUEUE 800 0FF FILL CREATE THEN.QUEUE 800 ALLOT THEN.QUEUE 800 0FF FILL CREATE WHILE.QUEUE 800 ALLOT WHILE.QUEUE 800 0FF FILL CREATE REPEAT.QUEUE 800 ALLOT REPEAT.QUEUE 800 0FF FILL CREATE AGAIN.QUEUE 800 ALLOT AGAIN.QUEUE 800 0FF FILL VARIABLE MAX.IF.QUEUE 800 MAX.IF.QUEUE ! : MAX.IF.QUEUE.COUNT MAX.IF.QUEUE @ 4 / ; VARIABLE IF.QUEUE.COUNT : >IF.QUEUE ( N IF.QUEUE ... ) >R 0 IF.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 IF.QUEUE.COUNT +! IF.QUEUE.COUNT @ MAX.IF.QUEUE.COUNT > IF CR ." IF.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; VARIABLE MAX.ELSE.QUEUE 800 MAX.ELSE.QUEUE ! : MAX.ELSE.QUEUE.COUNT MAX.ELSE.QUEUE @ 4 / ; VARIABLE ELSE.QUEUE.COUNT : >ELSE.QUEUE ( N ELSE.QUEUE ... ) >R 0 ELSE.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 ELSE.QUEUE.COUNT +! ELSE.QUEUE.COUNT @ MAX.ELSE.QUEUE.COUNT > IF CR ." ELSE.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; VARIABLE MAX.THEN.QUEUE 800 MAX.THEN.QUEUE ! : MAX.THEN.QUEUE.COUNT MAX.THEN.QUEUE @ 4 / ; VARIABLE THEN.QUEUE.COUNT : >THEN.QUEUE ( N THEN.QUEUE ... ) >R 0 THEN.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 THEN.QUEUE.COUNT +! THEN.QUEUE.COUNT @ MAX.THEN.QUEUE.COUNT > IF CR ." THEN.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; VARIABLE MAX.BEGIN.QUEUE 800 MAX.BEGIN.QUEUE ! : MAX.BEGIN.QUEUE.COUNT MAX.BEGIN.QUEUE @ 4 / ; VARIABLE BEGIN.QUEUE.COUNT : >BEGIN.QUEUE ( N BEGIN.QUEUE ... ) >R 0 BEGIN.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 BEGIN.QUEUE.COUNT +! BEGIN.QUEUE.COUNT @ MAX.BEGIN.QUEUE.COUNT > IF CR ." BEGIN.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; VARIABLE MAX.WHILE.QUEUE 800 MAX.WHILE.QUEUE ! : MAX.WHILE.QUEUE.COUNT MAX.WHILE.QUEUE @ 4 / ; VARIABLE WHILE.QUEUE.COUNT : >WHILE.QUEUE ( N WHILE.QUEUE ... ) >R 0 WHILE.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 WHILE.QUEUE.COUNT +! WHILE.QUEUE.COUNT @ MAX.WHILE.QUEUE.COUNT > IF CR ." WHILE.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; VARIABLE MAX.REPEAT.QUEUE 800 MAX.REPEAT.QUEUE ! : MAX.REPEAT.QUEUE.COUNT MAX.REPEAT.QUEUE @ 4 / ; VARIABLE REPEAT.QUEUE.COUNT : >REPEAT.QUEUE ( N REPEAT.QUEUE ... ) >R 0 REPEAT.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 REPEAT.QUEUE.COUNT +! REPEAT.QUEUE.COUNT @ MAX.REPEAT.QUEUE.COUNT > IF CR ." REPEAT.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; VARIABLE MAX.UNTIL.QUEUE 800 MAX.UNTIL.QUEUE ! : MAX.UNTIL.QUEUE.COUNT MAX.UNTIL.QUEUE @ 4 / ; VARIABLE UNTIL.QUEUE.COUNT : >UNTIL.QUEUE ( N UNTIL.QUEUE ... ) >R 0 UNTIL.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 UNTIL.QUEUE.COUNT +! UNTIL.QUEUE.COUNT @ MAX.UNTIL.QUEUE.COUNT > IF CR ." UNTIL.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; VARIABLE MAX.AGAIN.QUEUE 800 MAX.AGAIN.QUEUE ! : MAX.AGAIN.QUEUE.COUNT MAX.AGAIN.QUEUE @ 4 / ; VARIABLE AGAIN.QUEUE.COUNT : >AGAIN.QUEUE ( N AGAIN.QUEUE ... ) >R 0 AGAIN.QUEUE.COUNT ! BEGIN R@ @ -1 <> IF 1 AGAIN.QUEUE.COUNT +! AGAIN.QUEUE.COUNT @ MAX.AGAIN.QUEUE.COUNT > IF CR ." AGAIN.QUEUE IS FULL " CR -1 ELSE R> 4 + >R 0 THEN ELSE -1 THEN UNTIL R> ! ; : CHECK.R-1=0? ( ADDR1' ... ADDR2' -1 / ADDR1' 0 ) DUP @' 3F00 AND 0B00 = IF 1+ -1 ELSE DROP 0 THEN ; : CHECK.R+/-1=0? ( ADDR1' ... ADDR2' -1 / ADDR1' 0 ) @' 3B00 AND 0B00 = ; : CHECK.RB=X? ( ADDR1' ... ADDR2' -1 / ADDR1' 0 ) @' 3800 AND 1800 = ; : ERASE.ALL.QUEUE ( ... ) IF.QUEUE MAX.IF.QUEUE @ 0FF FILL ELSE.QUEUE MAX.ELSE.QUEUE @ 0FF FILL THEN.QUEUE MAX.THEN.QUEUE @ 0FF FILL BEGIN.QUEUE MAX.BEGIN.QUEUE @ 0FF FILL UNTIL.QUEUE MAX.UNTIL.QUEUE @ 0FF FILL WHILE.QUEUE MAX.WHILE.QUEUE @ 0FF FILL REPEAT.QUEUE MAX.REPEAT.QUEUE @ 0FF FILL AGAIN.QUEUE MAX.AGAIN.QUEUE @ 0FF FILL ; : CONDITION>QUEUE ( ... ) ERASE.ALL.QUEUE 1 ( START FROM 1 ) BEGIN >R R@ CHECK.RB=X? R@ CHECK.R+/-1=0? OR IF R@ 1+ @' 3800 AND 2800 = \ IS NEXT ONE JMP? IF R@ 1+ @' 7FF AND R@ > IF R@ IF.QUEUE >IF.QUEUE \ IF R@ 1+ @' 7FF AND THEN.QUEUE >THEN.QUEUE \ THEN ELSE R@ 1+ @' 7FF AND BEGIN.QUEUE >BEGIN.QUEUE \ BEGIN R@ UNTIL.QUEUE >UNTIL.QUEUE \ UNTIL THEN -1 2 ELSE 0 0 THEN ELSE 0 0 THEN R> + SWAP IF 0 ELSE 1+ DUP HERE' > THEN UNTIL DROP ; VARIABLE CURRENT.addr VARIABLE IF.ADDR VARIABLE ELSE.addr VARIABLE THEN.addr VARIABLE REPEAT.addr VARIABLE BEGIN.addr VARIABLE UNTIL.ADDR VARIABLE WHILE.ADDR VARIABLE AGAIN.ADDR : CHECK.ELSE.REPEAT.ADDR ( ADDR' ... ) DUP CURRENT.addr ! 1+ @' 7FF AND >R \ JMP.addr XX=X? JMP addr <--- R@ 1- @' 3800 AND 2800 = ( JMP? ) IF R@ 1- @' 7FF AND R@ U> IF CURRENT.ADDR @ IF.ADDR ! R@ 1- ELSE.addr ! R@ 1- @' 7FF AND THEN.addr ! ( JMP FORWARD ) IF.ADDR @ IF.QUEUE >IF.QUEUE ELSE.ADDR @ ELSE.QUEUE >ELSE.QUEUE THEN.ADDR @ THEN.QUEUE >THEN.QUEUE \ CR CR .S CR CR CR ELSE R@ 1- REPEAT.addr ! R@ 1- @' 7FF AND BEGIN.addr ! ( JMP BACKWARD ) CURRENT.ADDR @ WHILE.ADDR ! BEGIN.ADDR @ BEGIN.QUEUE >BEGIN.QUEUE WHILE.ADDR @ WHILE.QUEUE >WHILE.QUEUE REPEAT.ADDR @ REPEAT.QUEUE >REPEAT.QUEUE THEN ELSE R@ CURRENT.ADDR @ U> IF R@ THEN.addr ! CURRENT.ADDR @ IF.ADDR ! IF.ADDR @ IF.QUEUE >IF.QUEUE THEN.ADDR @ THEN.QUEUE >THEN.QUEUE ELSE R@ BEGIN.addr ! CURRENT.ADDR @ UNTIL.ADDR ! BEGIN.ADDR @ BEGIN.QUEUE >BEGIN.QUEUE UNTIL.ADDR @ UNTIL.QUEUE >UNTIL.QUEUE THEN THEN R> DROP ; : CONDITION>QUEUE''' ( ... ) ERASE.ALL.QUEUE 1 ( START FROM 0 ) BEGIN >R R@ CHECK.RB=X? R@ CHECK.R+/-1=0? OR IF R@ 1+ @' 3800 AND 2800 = \ IS NEXT ONE JMP? IF R@ CHECK.ELSE.REPEAT.ADDR -1 2 ELSE 0 0 THEN \ CR CR .S CR CR ELSE 0 0 THEN R> + SWAP IF 0 ELSE 1+ DUP HERE' > THEN \ CR .S KEY 0D = UNTIL DROP ; \ ' CONDITION>QUEUE''' IS _CONDITION>QUEUE''' \ VARIABLE INCREMENT.BY.2? \ : SET.INCREMENT.BY.2 ( ADDR' F ... ) INCREMENT.BY.2? ! DROP ; VARIABLE TEMP : DIS.IF.QUEUE ( ADDR' ... ADDR2' -1 / ADDR1' 0 ) TEMP ! 0 IF.QUEUE MAX.IF.QUEUE @ BOUNDS DO I @ TEMP @ = IF TEMP @ @' 15 SPACES CASE 1803 OF 7 SPACES ." IF'C=0 " ENDOF 1C03 OF 7 SPACES ." IF'C=1 " ENDOF 1903 OF 7 SPACES ." IF'Z=0 " ENDOF 1D03 OF 7 SPACES ." IF'Z=1 " ENDOF TEMP @ @' 3800 AND 1800 = IF TEMP @ @' DUP EXTRACT.6R 2 .R DUP EXTRACT.3B 4 .R 400 AND IF 31 ELSE 30 THEN SPACE ." IF'RB=" EMIT ELSE 2 SPACES TEMP @ @' DUP EXTRACT.6R 4 .R 3F00 AND 0B00 = IF SPACE ." IF'R-1=0 " ELSE SPACE ." IF'R+1=0 " THEN THEN ENDCASE -1 ELSE 0 THEN OR 4 \ DUP IF DROP -1 LEAVE THEN 4 +LOOP IF TEMP @ 2+ -1 ELSE TEMP @ 0 THEN ; : DIS.UNTIL.QUEUE ( ADDR' ... ADDR2' -1 / ADDR1' 0 ) TEMP ! 0 UNTIL.QUEUE MAX.UNTIL.QUEUE @ BOUNDS DO I @ TEMP @ = IF TEMP @ @' 15 SPACES CASE 1803 OF 7 SPACES ." UNTIL'C=0 " ENDOF 1C03 OF 7 SPACES ." UNTIL'C=1 " ENDOF 1903 OF 7 SPACES ." UNTIL'Z=0 " ENDOF 1D03 OF 7 SPACES ." UNTIL'Z=1 " ENDOF TEMP @ @' 3800 AND 1800 = IF TEMP @ @' DUP EXTRACT.6R 2 .R DUP EXTRACT.3B 4 .R 400 AND IF 31 ELSE 30 THEN SPACE ." UNTIL'RB=" EMIT ELSE 2 SPACES TEMP @ @' DUP EXTRACT.6R 4 .R 3F00 AND 0B00 = IF SPACE ." UNTIL'R-1=0 " ELSE SPACE ." UNTIL'R+1=0 " THEN THEN ENDCASE -1 ELSE 0 THEN OR 4 \ DUP IF DROP -1 LEAVE THEN 4 +LOOP IF TEMP @ 2+ -1 ELSE TEMP @ 0 THEN ; : DIS.WHILE.QUEUE ( ADDR' ... ADDR2' -1 / ADDR1' 0 ) TEMP ! 0 WHILE.QUEUE MAX.WHILE.QUEUE @ BOUNDS DO I @ TEMP @ = IF TEMP @ @' 15 SPACES CASE 1803 OF 7 SPACES ." WHILE'C=0 " ENDOF 1C03 OF 7 SPACES ." WHILE'C=1 " ENDOF 1903 OF 7 SPACES ." WHILE'Z=0 " ENDOF 1D03 OF 7 SPACES ." WHILE'Z=1 " ENDOF TEMP @ @' 3800 AND 1800 = IF TEMP @ @' DUP EXTRACT.6R 2 .R DUP EXTRACT.3B 4 .R 400 AND IF 31 ELSE 30 THEN SPACE ." WHILE'RB=" EMIT ELSE 2 SPACES TEMP @ @' DUP EXTRACT.6R 4 .R 3F00 AND 0B00 = IF SPACE ." WHILE'R-1=0 " ELSE SPACE ." WHILE'R+1=0 " THEN THEN ENDCASE -1 ELSE 0 THEN OR 4 \ DUP IF DROP -1 LEAVE THEN 4 +LOOP IF TEMP @ 2+ -1 ELSE TEMP @ 0 THEN ; : DIS.BEGIN.QUEUE ( ADDR' ... ADDR'+1 ) BEGIN.QUEUE MAX.BEGIN.QUEUE @ BOUNDS DO I @ OVER = IF 1C SPACES ." BEGIN' " CR THEN 4 +LOOP 1+ ; : DIS.THEN.QUEUE ( ADDR' ... ADDR'+1 ) THEN.QUEUE MAX.THEN.QUEUE @ BOUNDS DO I @ OVER = IF 1C SPACES ." ENDIF' " CR THEN 4 +LOOP 1+ ; : DIS.ELSE.QUEUE ( ADDR' ... ADDR'+1 -1 / ADDR' 0 ) 0 SWAP ELSE.QUEUE MAX.ELSE.QUEUE @ BOUNDS DO I @ OVER = IF 1C SPACES ." ELSE' " -1 SWAP OR SWAP THEN 4 +LOOP SWAP IF 1+ -1 ELSE 0 THEN ; : DIS.REPEAT.QUEUE ( ADDR' ... ADDR'+1 -1 / ADDR' 0 ) 0 SWAP REPEAT.QUEUE MAX.REPEAT.QUEUE @ BOUNDS DO I @ OVER = IF 1C SPACES ." REPEAT' " -1 SWAP OR SWAP THEN 4 +LOOP SWAP IF 1+ -1 ELSE 0 THEN ; : DIS.AGAIN.QUEUE ( ADDR' ... ADDR'+1 -1 / ADDR' 0 ) 0 SWAP AGAIN.QUEUE MAX.AGAIN.QUEUE @ BOUNDS DO I @ OVER = IF 1C SPACES ." AGAIN' " -1 SWAP OR SWAP THEN 4 +LOOP SWAP IF 1+ -1 ELSE 0 THEN ; : 14_ 14 SPACES ; \ : SCAN.SPECIAL.INSTRUCTION ( ADDR' ... F ) @' \ CASE 1003 OF 14_ ." C=0 " -1 ENDOF \ 1403 OF 14_ ." C=1 " -1 ENDOF \ 1103 OF 14_ ." Z=0 " -1 ENDOF \ 1503 OF 14_ ." Z=1 " -1 ENDOF \ 0 \ ENDCASE ; \ : SCAN.SPECIAL.INSTRUCTION ( ADDR' ... F ) DROP 0 ; \ : SCAN.SPECIAL.INSTRUCTION ( ADDR' ... F ) @' \ CASE 1003 OF 14_ ." C=0 " -1 ENDOF \ 1403 OF 14_ ." C=1 " -1 ENDOF \ 1103 OF 14_ ." Z=0 " -1 ENDOF \ 1503 OF 14_ ." Z=1 " -1 ENDOF \ 0 \ ENDCASE ; \ : SCAN.SPECIAL.INSTRUCTION ( ADDR' ... F ) DROP 0 ; VARIABLE (ADDR..DATA)? : (_ADDR__DATA_) (ADDR..DATA)? @ IF >R ." ( " R@ .XXXX 2 SPACES R> @' .XXXX ." ) " 1B SPACES ELSE DROP 2A SPACES THEN ; : DISASSEM./RB>C.1 ( ADDR... -1/0 ) >R R@ @' 1003 = \ C=0 R@ 1+ @' 3C00 AND 1C00 = AND \ RB=1? R@ 2+ @' 1403 = AND \ C=1 IF R@ (_ADDR__DATA_) R@ 1+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." /RB>C " -1 ELSE 0 THEN R> DROP ; : DISASSEM./RB>C.2 ( ADDR... -1/0 ) >R R@ @' 1403 = \ C=1 R@ 1+ @' 3C00 AND 1800 = AND \ RB=0? R@ 2+ @' 1003 = AND \ C=0 IF R@ (_ADDR__DATA_) R@ 1+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." /RB>C " -1 ELSE 0 THEN R> DROP ; : DISASSEM./RB>C ( ADDR ... -1/0 ) >R R@ DISASSEM./RB>C.1 IF -1 ELSE R@ DISASSEM./RB>C.2 THEN R> DROP ; : /RB>C' DISASSEM./RB>C ; : DISASSEM.RB>C.1 ( ADDR... -1/0 ) >R R@ @' 1003 = \ C=0 R@ 1+ @' 3C00 AND 1800 = AND \ RB=0? R@ 2+ @' 1403 = AND \ C=1 IF R@ (_ADDR__DATA_) R@ 1+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." RB>C " -1 ELSE 0 THEN R> DROP ; : DISASSEM.RB>C.2 ( ADDR... -1/0 ) >R R@ @' 1403 = \ C=1 R@ 1+ @' 3C00 AND 1C00 = AND \ RB=1? R@ 2+ @' 1003 = AND \ C=0 IF R@ (_ADDR__DATA_) R@ 1+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." RB>C " -1 ELSE 0 THEN R> DROP ; : DISASSEM.RB>C ( ADDR ... -1/0 ) >R R@ DISASSEM.RB>C.1 IF -1 ELSE R@ DISASSEM.RB>C.2 THEN R> DROP ; : RB>C' DISASSEM.RB>C ; : DISASSEM./C>RB.1 ( ADDR... -1/0 ) >R R@ @' 1803 = \ C=0? R@ 1+ @' 3800 AND 2800 = AND \ RJMP R@ 2+ @' 3C00 AND 1400 = AND \ RB=1 R@ 3 + @' 3800 AND 2800 = AND \ RJMP R@ 4 + @' 3C00 AND 1000 = AND \ RB=0 IF R@ (_ADDR__DATA_) R@ 2+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." /C>RB " -1 ELSE 0 THEN R> DROP ; : DISASSEM./C>RB.2 ( ADDR... -1/0 ) >R R@ @' 1C03 = \ C=1? R@ 1+ @' 3800 AND 2800 = AND \ RJMP R@ 2+ @' 3C00 AND 1000 = AND \ RB=0 R@ 3 + @' 3800 AND 2800 = AND \ RJMP R@ 4 + @' 3C00 AND 1400 = AND \ RB=1 IF R@ (_ADDR__DATA_) R@ 2+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." /C>RB " -1 ELSE 0 THEN R> DROP ; : DISASSEM./C>RB ( ADDR ... -1/0 ) >R R@ DISASSEM./C>RB.1 IF -1 ELSE R@ DISASSEM./C>RB.2 THEN R> DROP ; : /C>RB' DISASSEM./C>RB ; : DISASSEM.C>RB.1 ( ADDR... -1/0 ) >R R@ @' 1803 = \ C=0? R@ 1+ @' 3800 AND 2800 = AND \ RJMP R@ 2+ @' 3C00 AND 1000 = AND \ RB=0 R@ 3 + @' 3800 AND 2800 = AND \ RJMP R@ 4 + @' 3C00 AND 1400 = AND \ RB=1 IF R@ (_ADDR__DATA_) R@ 2+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." C>RB " -1 ELSE 0 THEN R> DROP ; : DISASSEM.C>RB.2 ( ADDR... -1/0 ) >R R@ @' 1C03 = \ C=1? R@ 1+ @' 3800 AND 2800 = AND \ RJMP R@ 2+ @' 3C00 AND 1400 = AND \ RB=1 R@ 3 + @' 3800 AND 2800 = AND \ RJMP R@ 4 + @' 3C00 AND 1000 = AND \ RB=0 IF R@ (_ADDR__DATA_) R@ 2+ @' DUP 7F AND 3 .R 380 AND 80 / 4 .R ." C>RB " -1 ELSE 0 THEN R> DROP ; : DISASSEM.C>RB ( ADDR ... -1/0 ) >R R@ DISASSEM.C>RB.1 IF -1 ELSE R@ DISASSEM.C>RB.2 THEN R> DROP ; : C>RB' DISASSEM.C>RB ; : DISASSEM.SPECIAL.INSTRUCTION ( ADDR ... ADDR+N -1 / 0 ) >R R@ DISASSEM./C>RB IF R@ 5 + -1 ELSE R@ DISASSEM.C>RB IF R@ 5 + -1 ELSE R@ DISASSEM.RB>C IF R@ 3 + -1 ELSE R@ DISASSEM./RB>C IF R@ 3 + -1 ELSE 0 THEN THEN THEN THEN R> DROP ; : DSI DISASSEM.SPECIAL.INSTRUCTION ; VARIABLE SCAN.QUEUE? VARIABLE DSI? -1 DSI? ! : SCAN.QUEUE' ( ADDR' ... ADDR'+2 -1 / ADDR' 0 ) >R SCAN.QUEUE? @ IF DSI? @ IF R@ DSI ELSE 0 THEN ELSE 0 THEN IF R> DROP -1 ELSE R@ DIS.THEN.QUEUE DROP R@ DIS.BEGIN.QUEUE DROP R@ DIS.AGAIN.QUEUE SWAP DROP R@ DIS.REPEAT.QUEUE SWAP DROP OR R@ DIS.ELSE.QUEUE SWAP DROP OR IF R> 1+ -1 ELSE R@ DIS.IF.QUEUE SWAP DROP R@ DIS.UNTIL.QUEUE SWAP DROP OR R@ DIS.WHILE.QUEUE SWAP DROP OR IF R> 2+ -1 ELSE R@ DSI \ SCAN.SPECIAL.INSTRUCTION IF R> DROP -1 ELSE R> 0 THEN THEN THEN THEN ; : SCAN.QUEUE'--- ( ADDR' ... ADDR'+2 -1 / ADDR' 0 ) >R R@ DIS.THEN.QUEUE DROP R@ DIS.BEGIN.QUEUE DROP R@ DIS.AGAIN.QUEUE SWAP DROP R@ DIS.REPEAT.QUEUE SWAP DROP OR R@ DIS.ELSE.QUEUE SWAP DROP OR IF R> 1+ -1 ELSE R@ DIS.IF.QUEUE SWAP DROP R@ DIS.UNTIL.QUEUE SWAP DROP OR R@ DIS.WHILE.QUEUE SWAP DROP OR IF R> 2+ -1 ELSE R@ DSI \ SCAN.SPECIAL.INSTRUCTION IF R> DROP -1 ELSE R> 0 THEN THEN THEN ; \ ' SCAN.QUEUE' IS SCAN.QUEUE VARIABLE MODE : ZZ MODE @ 0 = IF 8 ELSE 0 THEN DUP MODE ! CASE 1 OF 0 0 0 0 ENDOF 0B OF 0 0 0 -1 ENDOF 2 OF 0 0 -1 0 ENDOF 3 OF 0 0 -1 -1 ENDOF 4 OF 0 -1 0 0 ENDOF 5 OF 0 -1 0 -1 ENDOF 6 OF 0 -1 -1 0 ENDOF 7 OF 0 -1 -1 -1 ENDOF 8 OF -1 0 0 0 ENDOF 9 OF -1 0 0 -1 ENDOF 0A OF -1 0 -1 0 ENDOF 0 OF -1 0 -1 -1 ENDOF 0C OF -1 -1 0 0 ENDOF 0D OF -1 -1 0 -1 ENDOF 0E OF -1 -1 -1 0 ENDOF 0F OF -1 -1 -1 -1 ENDOF ENDCASE SCAN.QUEUE? ! SHOW.NAME? ! DROP \ SPECIAL.RB=X? ! \ (ADDR..DATA)? ! LAST.U @ U ; : M MODE @ >R R@ 1+ 0F AND MODE ! ." ==> " R@ . ." MM " R> CASE 1 OF 0 0 0 0 ENDOF 0B OF 0 0 0 -1 ENDOF 2 OF 0 0 -1 0 ENDOF 3 OF 0 0 -1 -1 ENDOF 4 OF 0 -1 0 0 ENDOF 5 OF 0 -1 0 -1 ENDOF 6 OF 0 -1 -1 0 ENDOF 7 OF 0 -1 -1 -1 ENDOF 8 OF -1 0 0 0 ENDOF 9 OF -1 0 0 -1 ENDOF 0A OF -1 0 -1 0 ENDOF 0 OF -1 0 -1 -1 ENDOF 0C OF -1 -1 0 0 ENDOF 0D OF -1 -1 0 -1 ENDOF 0E OF -1 -1 -1 0 ENDOF 0F OF -1 -1 -1 -1 ENDOF ENDCASE SCAN.QUEUE? ! SHOW.NAME? ! SPECIAL.RB=X? ! (ADDR..DATA)? ! LAST.U @ U ; : MM ( N ... ) 0F AND DUP MODE ! M ; \ MULTI.MODE : CCCC CHECK.ELSE.REPEAT.ADDR CR IF.ADDR @ 6 .R CR ELSE.ADDR @ 6 .R CR THEN.ADDR @ 6 .R CR CR BEGIN.ADDR @ 6 .R CR WHILE.ADDR @ 6 .R CR REPEAT.ADDR @ 6 .R CR CR AGAIN.ADDR @ 6 .R ; ' MM IS _MM \ HERE' IF'C=0 A+ A+ ELSE' A- A- THEN' A=0 A=0 RET \ BEGIN' A- A- WHILE'C=0 A+ A+ REPEAT' A=0 A=0 RET : UNASSEMBLE(pic.")' ( ADDR' ... ADDR'+2 -1 / ADDR' 0 ) >R R@ @' 3F00 AND 3000 = ( 3012 12 #>A ) R@ 1+ @' 2000 [ ' (pic.") 4 + @ ] LITERAL + = AND ( 20F5 0F5 CALL ) IF R@ 1+ @' 7FF AND ( get runtime address of pic." ----- 0F5 ) ( DUP ) 1+ @' 7FF AND 1+ ( TABLE START ADDRESS ) ( 100 ) R@ @' 0FF AND ( TBL.OFFSET ) + >R ( STRING.n ADDRESS ) R@ 1+ R> @' 0FF AND ( STRING.n LENGTH ) BOUNDS 10 ( 8 ) SPACES ." pic" 2E EMIT 22 EMIT ( ." ) SPACE \ pic." DO I @' 0FF AND EMIT LOOP R> 2+ -1 22 EMIT ELSE R> DROP 0 THEN ; ' UNASSEMBLE(pic.")' IS UNASSEMBLE(pic.") : SHOW.SETTINGS" CR UNASSEMBLE(pic.")? @ ." UNASSEMBLE(." 22 EMIT ." pic)?" 3 .R ." ( UN )" MODE @ 1- 0F AND ." MODE" DUP 3 .R ." ( " 2 .R ." MM )" CR SCAN.QUEUE? @ ." SCAN.QUEUE?" 3 .R ." ( SQ )" LIMIT.LENGTH$ @ ." LIMIT.LENGTH$" DUP 3 .R ." ( " 2 .R ." LL )" CR SPECIAL.RB=X? @ ." SPECIAL.RB=X?" 3 .R ." ( RB )" CR (ADDR..DATA)? @ ." (ADDR..DATA)?" 3 .R ." ( PC )" CR SHOW.NAME? @ ." SHOW.NAME?" 3 .R ." ( SN )" ; VARIABLE SHOW.SETTINGS? -1 SHOW.SETTINGS? ! : SHOW.SETTINGS SHOW.SETTINGS? @ IF CR UNASSEMBLE(pic.")? @ ." pic." 22 EMIT ." GOOD LUCK !" 22 EMIT 3 .R ." ( S1 )" MODE @ 1- 0F AND ." MODE " DUP 3 .R ." ( " 2 .R ." MM )" CR SCAN.QUEUE? @ ." IF..ELSE..THEN " 3 .R ." ( S2 )" LIMIT.LENGTH$ @ ." 0123456789 " DUP 3 .R ." ( " 2 .R ." S5 )" CR (ADDR..DATA)? @ ." ( 1234 5678 ) " 3 .R ." ( S3 )" SPECIAL.RB=X? @ ." 3 2 RB=0 " 3 .R ." ( S6 )" CR SHOW.NAME? @ ." T: START " 3 .R ." ( S4 )" SHOW.SETTINGS? @ ." this settings " 3 .R ." ( S7 )" CR DSI? @ ." C>RB " 3 .R ." ( S8 )" THEN ; : H' CR ." ( WORDS WORDS' 200 U 600 U UU M ZZ 0 G CON 0 RUN ) " CR ." ( 123 45 >HEX >PIC SEE TX FORGET' RX )" \ 10 SEP S7 )" SHOW.SETTINGS CR CR LAST.U @ U ; : H HEX H' ; : UN UNASSEMBLE(pic.")? @ -1 XOR UNASSEMBLE(pic.")? ! H ; : CN SCAN.QUEUE? @ -1 XOR SCAN.QUEUE? ! H ; : RB SPECIAL.RB=X? @ -1 XOR SPECIAL.RB=X? ! H ; : PC (ADDR..DATA)? @ -1 XOR (ADDR..DATA)? ! H ; : SN SHOW.NAME? @ -1 XOR SHOW.NAME? ! H ; : SS SHOW.SETTINGS? @ -1 XOR SHOW.SETTINGS? ! H ; : LL LIMIT.LENGTH$ ! H ; : S1 UNASSEMBLE(pic.")? @ -1 XOR UNASSEMBLE(pic.")? ! H ; : S2 SCAN.QUEUE? @ -1 XOR SCAN.QUEUE? ! H ; : S3 (ADDR..DATA)? @ -1 XOR (ADDR..DATA)? ! H ; : S4 SHOW.NAME? @ -1 XOR SHOW.NAME? ! H ; : S5 LIMIT.LENGTH$ ! H ; : S6 SPECIAL.RB=X? @ -1 XOR SPECIAL.RB=X? ! H ; : S7 SHOW.SETTINGS? @ -1 XOR SHOW.SETTINGS? ! H ; : S8 DSI? @ -1 XOR DSI? ! H ; CONDITION>QUEUE''' VARIABLE MATCH? : $= ( $1 $2 ... F ) SWAP DUP C@ 1+ BOUNDS 0 MATCH? ! DO I C@ OVER C@ <> IF 0 MATCH? ! LEAVE THEN LOOP 2DROP MATCH? @ ; CREATE BUFFER 30 ALLOT : -LEADING.SPACE ( ADDR ... ADDR' ) BEGIN DUP 1+ SWAP C@ 20 = UNTIL ; : GET.STRING ( ADDR ... ADDR$ LENGTH ) -LEADING.SPACE DUP >R BEGIN DUP 1+ SWAP C@ 0= UNTIL R> - ; : >NEXT.NFA ( NFA1 ... NFA2 ) ; : MATCH.WORD ( $ADDR ... NFA ) LAST @ >R BEGIN DUP R@ $= IF -1 ELSE R> >NEXT.NFA >R 0 THEN UNTIL DROP R> ; : || BUFFER 30 ERASE 3D ( = ) PARSE 2+ BUFFER SWAP CMOVE ; \ || C=1 BUFFER 10 DUMP 20 20 20 20 43 3D 31 00 00 00 .... C=1 : | || BUFFER GET.STRING OVER + DUP C@ >R 1+ C@ >R ( 0/1 ?/0 ) MATCH.WORD NAME> DUP 8 + @ SWAP @ R> IF R> 1+ C@ IF 1800 ELSE 1400 THEN + ELSE R> 1+ C@ IF 1C00 ELSE 1000 THEN + THEN ,' ; \ : DISASSEM.C>RB/RB>C.... ( ADDR' ... ADDR'+5 -1 / 0 ) >R \ R@ @' 3800 AND 1000 = \ IF'C=1 IF'Z=1 IF'XX=1 \ R@ 1+ @' 3800 AND 2800 = AND \ $ 5 + JMP \ R@ 2+ @' 3800 AND 1000 = AND \ TX=1 \ R@ 3 + @' 3800 AND 2800 = AND \ $ 3 + JMP \ R@ 4 + @' 3800 AND 1000 = AND \ TX=0 \ \ IF \ R> 5 + -1 \ ELSE R> DROP 0 \ THEN ; \ : DISASSEM./C>RB \ : DISASSEM.RB>C \ : DISASSEM./RB>C : PD=0 STATUS 3 RB=0 ; : TO=0 STATUS 4 RB=0 ; : RP0=0 STATUS 5 RB=0 ; : RP1=0 STATUS 6 RB=0 ; : IRP=0 STATUS 7 RB=0 ; : RE0=0 PORTE 0 RB=0 ; : RE1=0 PORTE 1 RB=0 ; : RE2=0 PORTE 2 RB=0 ; : RBIF=0 INTCON 0 RB=0 ; : INTF=0 INTCON 1 RB=0 ; : T0IF=0 INTCON 2 RB=0 ; : RB1E=0 INTCON 3 RB=0 ; : INTE=0 INTCON 4 RB=0 ; : T0IE=0 INTCON 5 RB=0 ; : PEIE=0 INTCON 6 RB=0 ; : GIE=0 INTCON 7 RB=0 ; : TMR1IF=0 PIR1 0 RB=0 ; : TMR2IF=0 PIR1 1 RB=0 ; : CCP1IF=0 PIR1 2 RB=0 ; : SSP1F=0 PIR1 3 RB=0 ; : TXIF=0 PIR1 4 RB=0 ; : RCIF=0 PIR1 5 RB=0 ; : ADIF=0 PIR1 6 RB=0 ; : PSPIF=0 PIR1 7 RB=0 ; : CCP2IF=0 PIR2 0 RB=0 ; : BCLIF=0 PIR2 3 RB=0 ; : EEIF=0 PIR2 4 RB=0 ; : TMR1ON=0 T1CON 0 RB=0 ; : TMR1CS=0 T1CON 1 RB=0 ; : T1SYNC=0 T1CON 2 RB=0 ; : T1OSCEN=0 T1CON 3 RB=0 ; : T1CKPS0=0 T1CON 4 RB=0 ; : T1CKPS1=0 T1CON 5 RB=0 ; : T2CKPS0=0 T2CON 0 RB=0 ; : T2CKPS1=0 T2CON 1 RB=0 ; : TMR2ON=0 T2CON 2 RB=0 ; : TOUTPS0=0 T2CON 3 RB=0 ; : TOUTPS1=0 T2CON 4 RB=0 ; : TOUTPS2=0 T2CON 5 RB=0 ; : TOUTPS0=0 T2CON 6 RB=0 ; : SSPM0=0 SSPCON 0 RB=0 ; : SSPM1=0 SSPCON 1 RB=0 ; : SSPM2=0 SSPCON 2 RB=0 ; : SSPM3=0 SSPCON 3 RB=0 ; : CKP=0 SSPCON 4 RB=0 ; : SSPEN=0 SSPCON 5 RB=0 ; : SSPOV=0 SSPCON 6 RB=0 ; : WCOL=0 SSPCON 7 RB=0 ; : CCP1M0=0 CCP1CON 0 RB=0 ; : CCP1M1=0 CCP1CON 1 RB=0 ; : CCP1M2=0 CCP1CON 2 RB=0 ; : CCP1M3=0 CCP1CON 3 RB=0 ; : CCP1Y=0 CCP1CON 4 RB=0 ; : CCP1X=0 CCP1CON 5 RB=0 ; : RX9D=0 RCSTA 0 RB=0 ; : OERR=0 RCSTA 1 RB=0 ; : FERR=0 RCSTA 2 RB=0 ; : CREN=0 RCSTA 4 RB=0 ; : SREN=0 RCSTA 5 RB=0 ; : RX9=0 RCSTA 6 RB=0 ; : SPEN=0 RCSTA 7 RB=0 ; : CCP2M0=0 CCP2CON 0 RB=0 ; : CCP2M1=0 CCP2CON 1 RB=0 ; : CCP2M2=0 CCP2CON 2 RB=0 ; : CCP2M3=0 CCP2CON 3 RB=0 ; : CCP2Y=0 CCP2CON 4 RB=0 ; : CCP2X=0 CCP2CON 5 RB=0 ; : ADON=0 ADCON0 0 RB=0 ; : GO/DONE=0 ADCON0 2 RB=0 ; : CHS0=0 ADCON0 3 RB=0 ; : CHS1=0 ADCON0 4 RB=0 ; : CHS2=0 ADCON0 5 RB=0 ; : ADCS0=0 ADCON0 6 RB=0 ; : ADCS1=0 ADCON0 7 RB=0 ; : PD=1 STATUS 3 RB=1 ; : TO=1 STATUS 4 RB=1 ; : RP0=1 STATUS 5 RB=1 ; : RP1=1 STATUS 6 RB=1 ; : IRP=1 STATUS 7 RB=1 ; : RE0=1 PORTE 0 RB=1 ; : RE1=1 PORTE 1 RB=1 ; : RE2=1 PORTE 2 RB=1 ; : RBIF=1 INTCON 0 RB=1 ; : INTF=1 INTCON 1 RB=1 ; : T0IF=1 INTCON 2 RB=1 ; : RB1E=1 INTCON 3 RB=1 ; : INTE=1 INTCON 4 RB=1 ; : T0IE=1 INTCON 5 RB=1 ; : PEIE=1 INTCON 6 RB=1 ; : GIE=1 INTCON 7 RB=1 ; : TMR1IF=1 PIR1 0 RB=1 ; : TMR2IF=1 PIR1 1 RB=1 ; : CCP1IF=1 PIR1 2 RB=1 ; : SSP1F=1 PIR1 3 RB=1 ; : TXIF=1 PIR1 4 RB=1 ; : RCIF=1 PIR1 5 RB=1 ; : ADIF=1 PIR1 6 RB=1 ; : PSPIF=1 PIR1 7 RB=1 ; : CCP2IF=1 PIR2 0 RB=1 ; : BCLIF=1 PIR2 3 RB=1 ; : EEIF=1 PIR2 4 RB=1 ; : TMR1ON=1 T1CON 0 RB=1 ; : TMR1CS=1 T1CON 1 RB=1 ; : T1SYNC=1 T1CON 2 RB=1 ; : T1OSCEN=1 T1CON 3 RB=1 ; : T1CKPS0=1 T1CON 4 RB=1 ; : T1CKPS1=1 T1CON 5 RB=1 ; : T2CKPS0=1 T2CON 0 RB=1 ; : T2CKPS1=1 T2CON 1 RB=1 ; : TMR2ON=1 T2CON 2 RB=1 ; : TOUTPS0=1 T2CON 3 RB=1 ; : TOUTPS1=1 T2CON 4 RB=1 ; : TOUTPS2=1 T2CON 5 RB=1 ; : TOUTPS0=1 T2CON 6 RB=1 ; : SSPM0=1 SSPCON 0 RB=1 ; : SSPM1=1 SSPCON 1 RB=1 ; : SSPM2=1 SSPCON 2 RB=1 ; : SSPM3=1 SSPCON 3 RB=1 ; : CKP=1 SSPCON 4 RB=1 ; : SSPEN=1 SSPCON 5 RB=1 ; : SSPOV=1 SSPCON 6 RB=1 ; : WCOL=1 SSPCON 7 RB=1 ; : CCP1M0=1 CCP1CON 0 RB=1 ; : CCP1M1=1 CCP1CON 1 RB=1 ; : CCP1M2=1 CCP1CON 2 RB=1 ; : CCP1M3=1 CCP1CON 3 RB=1 ; : CCP1Y=1 CCP1CON 4 RB=1 ; : CCP1X=1 CCP1CON 5 RB=1 ; : RX9D=1 RCSTA 0 RB=1 ; : OERR=1 RCSTA 1 RB=1 ; : FERR=1 RCSTA 2 RB=1 ; : CREN=1 RCSTA 4 RB=1 ; : SREN=1 RCSTA 5 RB=1 ; : RX9=1 RCSTA 6 RB=1 ; : SPEN=1 RCSTA 7 RB=1 ; : CCP2M0=1 CCP2CON 0 RB=1 ; : CCP2M1=1 CCP2CON 1 RB=1 ; : CCP2M2=1 CCP2CON 2 RB=1 ; : CCP2M3=1 CCP2CON 3 RB=1 ; : CCP2Y=1 CCP2CON 4 RB=1 ; : CCP2X=1 CCP2CON 5 RB=1 ; : ADON=1 ADCON0 0 RB=1 ; : GO/DONE=1 ADCON0 2 RB=1 ; : CHS0=1 ADCON0 3 RB=1 ; : CHS1=1 ADCON0 4 RB=1 ; : CHS2=1 ADCON0 5 RB=1 ; : ADCS0=1 ADCON0 6 RB=1 ; : ADCS1=1 ADCON0 7 RB=1 ; COMMENT: 7F ORG T: GO.TBL 200 ORG T: DELAY.T $ 1 + CALL \ Common T: DELAY.T/2 20 #>A \ Common T: DELAY 1 A>R' BEGIN' 1 UNTIL'R-1=0' RET \ Common T: TX IF'A=0 RET THEN' ( A ... ) \ Common R1,2 1 A>R' 9 2 #>R' C=0 ( START BIT=0 ) BEGIN' NOP /C>TX NOP DELAY.T 1 RRCR' 2 UNTIL'R-1=0' TX=1 DELAY.T RET ( STOP BIT=1 ) T: RX 9 2 #>R' BEGIN' UNTIL'RX=0 DELAY.T/2 ( START BIT=0 ) BEGIN' NOP RX>C 1 RRCR' DELAY.T 2 UNTIL'R-1=0' 1 R>A' RET \ Common R1,2 T: SPACE' 20 #>A TX RET \ Common R1,2 T: CRLF 0A #>A TX 0D #>A TX RET \ Common R1,2 T: 0~F>ASC 0F An# F6 A+# IF'C=1 7 A+# ENDIF' 3A A+# RET \ Common T: .n 0~F>ASC TX RET \ Common R1,2 T: .' 3 A>R' 3 SWAPR>A' .n 3 R>A' .n 3 R>A' RET HERE' 0F5 ORG' T: (pic.") 6 A>R' $ 9 + CALL 7 A>R' ( length ) BEGIN' 6 R+' 6 R>A' $ 5 + CALL TX 7 UNTIL'R-1=0' RET JMP>PC+A ORG' : pic." TABLE.OFFSET @ #>A (pic.") HERE' TABLE.OFFSET @ 100 + ORG' ( | ) 22 ( " ) WORD COUNT DUP #>ARET 1 TABLE.OFFSET +! BOUNDS DO 1 TABLE.OFFSET +! I C@ #>ARET LOOP ORG' TABLE.OFFSET @ 0FF > IF ." table.offset overflow >255" THEN ; T: not0~F pic." ? <- 0~F" RET ( ... ) \ Common T: notA~Z pic." ? <- A~Z" RET ( ... ) \ Common T: ASC>0~F D0 A+# ( 30 ... 0 ) \ Common IF'C=1 F6 A+# \ 30~39 => F6~FF IF'C=0 0A A+# RET \ 0~9 ENDIF' DF An# \ lower case -> UPPER CASE F9 A+# \ IF'C=1 FA A+# \ 41~46 => FA~FF IF'C=0 0F An# RET \ A~F ENDIF' ENDIF' ENDIF' not0~F RET \ 0000 JMP T: GET.n RX ASC>0~F RET ( ... 0~F ) \ Common T: GET2n GET.n 5 A>R' 5 SWAPR' GET.n 5 AoR' RET \ Common R5 T: INIT.PIC 0B R=0 BANK1 A=0 7 A>R BANK0 FE 7 #>R 50 0 #>R 68 1 #>R' RET T: GET.A~Z RX 0DF An# 6 A>R' TX 6 R>A' BF A+# \ A~Z and above IF'C=0 notA~Z ENDIF' 6 A>R' E6 A+# \ below Z \ R6 IF'C=1 notA~Z ENDIF' 6 R>A' RET ( A ~ Z ) \ Common T: GO.A~Z GO.TBL CRLF RET T: START DI INIT.PIC ( INIT.51 ) ( INIT.AVR ) ( INIT.EMC ) \ Common pic." 8-bits Forth 035201382 Taiwan" T: LOOP.START BEGIN' DI CRLF pic." *" GET.A~Z ( 7 #>A ) GO.A~Z AGAIN' T: DOWNLOAD RET \ Common T: HELP pic." Dump Go Help Test" RET \ Common T: UPLOAD 7F 4 #>R' BEGIN' 4 R>A' 07 An# IF'Z=1 CRLF THEN' 4 R>A' TX ( SPACE' ) (SP)>A TX \ Common 4 UNTIL'R-1=0' CRLF RET \ PIC-->PC HERE' 0 ORG START RET ( ' GO.TBL ) 7F ORG JMP>A+PC \ Common ( A ) RET ( B ) RET ( C ) RET DOWNLOAD ( D ) RET ( E ) RET ( F ) RET ( G ) RET HELP ( H ) RET ( I ) RET ( J ) RET ( K ) RET ( L ) RET ( M ) RET ( N ) RET ( O ) RET UPLOAD ( P ) RET ( Q ) RET ( R ) RET ( S ) RET ( T ) RET ( U ) RET ( V ) RET ( W ) RET ( X ) RET ( Y ) RET ( Z ) RET ORG' COMMENT; \ : U CONDITION>QUEUE''' U ; : A+R' R.OFFSET + A+R ; : RLCR' R.OFFSET + RLCR ; : RLCR>A' R.OFFSET + RLCR>A ; : RL 6 DUP A>R' C=0 RLCR>A' ; : A*R' 8 FOR' SWAP RLCR' IF'C=1 9 A>R' RL 9 A+R' THEN' NEXT' ; : A=R*R R>A' A*R' ; T: 9*9 9 7 #>R' BEGIN' 9 8 #>R' BEGIN' 7 8 A=R*R IF'A=0 CRLF ELSE' .' THEN' 8 UNTIL'R-1=0' 7 UNTIL'R-1=0' RET COMMENT: : CFA>n ( CFA ... n -1 / 0 ) >R \ CODE 0 PUSH EBX MOV EBX, # 0 NEXT C; R@ C@ 53 ( PUSH EBX ) = R@ 1+ @ 0FFFF AND C7C3 ( MOV EBX, # ) = AND IF R> 3 + @ DUP 0 7 BETWEEN IF -1 ( n -1 ) ELSE DROP 0 ( 0 ) THEN ELSE R> DROP 0 ( 0 ) THEN ; : CFA>n ( CFA ... n -1 / 0 ) CASE ['] 0 OF 0 -1 ENDOF ['] 1 OF 1 -1 ENDOF ['] 2 OF 2 -1 ENDOF ['] 3 OF 3 -1 ENDOF ['] 4 OF 4 -1 ENDOF ['] 5 OF 5 -1 ENDOF ['] 6 OF 6 -1 ENDOF ['] 7 OF 7 -1 ENDOF DROP 0 ENDCASE ; : TP1 CR ." TP1: " .S CR ; : TP2 CR ." TP2: " .S CR ; : 3_0_RB=0...C=0 ( R B CFA ... NFA -1 / 0 ) >R R@ @ 60 = R@ 4 + @ ['] lit LITERAL = AND TP1 \ R@ 10 + @ ['] RB=0 LITERAL = AND IF \ R@ 0C + @ CFA>n \ IF R@ 8 + @ SWAP D= IF R> >NAME -1 TP2 \ ELSE R> DROP 0 \ THEN ELSE R> DROP 0 THEN ELSE R> DROP 0 THEN ; : XX 3_0_RB=0...C=0 ( R B CFA ... NFA -1 / 0 ) ; COMMENT; : TX=0 20 0 RB=0 ; \ 20 0 ' TX=0 XX : PD=0 STATUS 3 RB=0 ; : TO=0 STATUS 4 RB=0 ; : RP0=0 STATUS 5 RB=0 ; : RP1=0 STATUS 6 RB=0 ; : IRP=0 STATUS 7 RB=0 ; : RE0=0 PORTE 0 RB=0 ; : RE1=0 PORTE 1 RB=0 ; : RE2=0 PORTE 2 RB=0 ; : RBIF=0 INTCON 0 RB=0 ; : INTF=0 INTCON 1 RB=0 ; : T0IF=0 INTCON 2 RB=0 ; : RB1E=0 INTCON 3 RB=0 ; : INTE=0 INTCON 4 RB=0 ; : T0IE=0 INTCON 5 RB=0 ; : PEIE=0 INTCON 6 RB=0 ; : GIE=0 INTCON 7 RB=0 ; : TMR1IF=0 PIR1 0 RB=0 ; : TMR2IF=0 PIR1 1 RB=0 ; : CCP1IF=0 PIR1 2 RB=0 ; : SSP1F=0 PIR1 3 RB=0 ; : TXIF=0 PIR1 4 RB=0 ; : RCIF=0 PIR1 5 RB=0 ; : ADIF=0 PIR1 6 RB=0 ; : PSPIF=0 PIR1 7 RB=0 ; : CCP2IF=0 PIR2 0 RB=0 ; : BCLIF=0 PIR2 3 RB=0 ; : EEIF=0 PIR2 4 RB=0 ; : TMR1ON=0 T1CON 0 RB=0 ; : TMR1CS=0 T1CON 1 RB=0 ; : T1SYNC=0 T1CON 2 RB=0 ; : T1OSCEN=0 T1CON 3 RB=0 ; : T1CKPS0=0 T1CON 4 RB=0 ; : T1CKPS1=0 T1CON 5 RB=0 ; : T2CKPS0=0 T2CON 0 RB=0 ; : T2CKPS1=0 T2CON 1 RB=0 ; : TMR2ON=0 T2CON 2 RB=0 ; : TOUTPS0=0 T2CON 3 RB=0 ; : TOUTPS1=0 T2CON 4 RB=0 ; : TOUTPS2=0 T2CON 5 RB=0 ; : TOUTPS0=0 T2CON 6 RB=0 ; : SSPM0=0 SSPCON 0 RB=0 ; : SSPM1=0 SSPCON 1 RB=0 ; : SSPM2=0 SSPCON 2 RB=0 ; : SSPM3=0 SSPCON 3 RB=0 ; : CKP=0 SSPCON 4 RB=0 ; : SSPEN=0 SSPCON 5 RB=0 ; : SSPOV=0 SSPCON 6 RB=0 ; : WCOL=0 SSPCON 7 RB=0 ; : CCP1M0=0 CCP1CON 0 RB=0 ; : CCP1M1=0 CCP1CON 1 RB=0 ; : CCP1M2=0 CCP1CON 2 RB=0 ; : CCP1M3=0 CCP1CON 3 RB=0 ; : CCP1Y=0 CCP1CON 4 RB=0 ; : CCP1X=0 CCP1CON 5 RB=0 ; : RX9D=0 RCSTA 0 RB=0 ; : OERR=0 RCSTA 1 RB=0 ; : FERR=0 RCSTA 2 RB=0 ; : CREN=0 RCSTA 4 RB=0 ; : SREN=0 RCSTA 5 RB=0 ; : RX9=0 RCSTA 6 RB=0 ; : SPEN=0 RCSTA 7 RB=0 ; : CCP2M0=0 CCP2CON 0 RB=0 ; : CCP2M1=0 CCP2CON 1 RB=0 ; : CCP2M2=0 CCP2CON 2 RB=0 ; : CCP2M3=0 CCP2CON 3 RB=0 ; : CCP2Y=0 CCP2CON 4 RB=0 ; : CCP2X=0 CCP2CON 5 RB=0 ; : ADON=0 ADCON0 0 RB=0 ; : GO/DONE=0 ADCON0 2 RB=0 ; : CHS0=0 ADCON0 3 RB=0 ; : CHS1=0 ADCON0 4 RB=0 ; : CHS2=0 ADCON0 5 RB=0 ; : ADCS0=0 ADCON0 6 RB=0 ; : ADCS1=0 ADCON0 7 RB=0 ; : PD=1 STATUS 3 RB=1 ; : TO=1 STATUS 4 RB=1 ; : RP0=1 STATUS 5 RB=1 ; : RP1=1 STATUS 6 RB=1 ; : IRP=1 STATUS 7 RB=1 ; : RE0=1 PORTE 0 RB=1 ; : RE1=1 PORTE 1 RB=1 ; : RE2=1 PORTE 2 RB=1 ; : RBIF=1 INTCON 0 RB=1 ; : INTF=1 INTCON 1 RB=1 ; : T0IF=1 INTCON 2 RB=1 ; : RB1E=1 INTCON 3 RB=1 ; : INTE=1 INTCON 4 RB=1 ; : T0IE=1 INTCON 5 RB=1 ; : PEIE=1 INTCON 6 RB=1 ; : GIE=1 INTCON 7 RB=1 ; : TMR1IF=1 PIR1 0 RB=1 ; : TMR2IF=1 PIR1 1 RB=1 ; : CCP1IF=1 PIR1 2 RB=1 ; : SSP1F=1 PIR1 3 RB=1 ; : TXIF=1 PIR1 4 RB=1 ; : RCIF=1 PIR1 5 RB=1 ; : ADIF=1 PIR1 6 RB=1 ; : PSPIF=1 PIR1 7 RB=1 ; : CCP2IF=1 PIR2 0 RB=1 ; : BCLIF=1 PIR2 3 RB=1 ; : EEIF=1 PIR2 4 RB=1 ; : TMR1ON=1 T1CON 0 RB=1 ; : TMR1CS=1 T1CON 1 RB=1 ; : T1SYNC=1 T1CON 2 RB=1 ; : T1OSCEN=1 T1CON 3 RB=1 ; : T1CKPS0=1 T1CON 4 RB=1 ; : T1CKPS1=1 T1CON 5 RB=1 ; : T2CKPS0=1 T2CON 0 RB=1 ; : T2CKPS1=1 T2CON 1 RB=1 ; : TMR2ON=1 T2CON 2 RB=1 ; : TOUTPS0=1 T2CON 3 RB=1 ; : TOUTPS1=1 T2CON 4 RB=1 ; : TOUTPS2=1 T2CON 5 RB=1 ; : TOUTPS0=1 T2CON 6 RB=1 ; : SSPM0=1 SSPCON 0 RB=1 ; : SSPM1=1 SSPCON 1 RB=1 ; : SSPM2=1 SSPCON 2 RB=1 ; : SSPM3=1 SSPCON 3 RB=1 ; : CKP=1 SSPCON 4 RB=1 ; : SSPEN=1 SSPCON 5 RB=1 ; : SSPOV=1 SSPCON 6 RB=1 ; : WCOL=1 SSPCON 7 RB=1 ; : CCP1M0=1 CCP1CON 0 RB=1 ; : CCP1M1=1 CCP1CON 1 RB=1 ; : CCP1M2=1 CCP1CON 2 RB=1 ; : CCP1M3=1 CCP1CON 3 RB=1 ; : CCP1Y=1 CCP1CON 4 RB=1 ; : CCP1X=1 CCP1CON 5 RB=1 ; : RX9D=1 RCSTA 0 RB=1 ; : OERR=1 RCSTA 1 RB=1 ; : FERR=1 RCSTA 2 RB=1 ; : CREN=1 RCSTA 4 RB=1 ; : SREN=1 RCSTA 5 RB=1 ; : RX9=1 RCSTA 6 RB=1 ; : SPEN=1 RCSTA 7 RB=1 ; : CCP2M0=1 CCP2CON 0 RB=1 ; : CCP2M1=1 CCP2CON 1 RB=1 ; : CCP2M2=1 CCP2CON 2 RB=1 ; : CCP2M3=1 CCP2CON 3 RB=1 ; : CCP2Y=1 CCP2CON 4 RB=1 ; : CCP2X=1 CCP2CON 5 RB=1 ; : ADON=1 ADCON0 0 RB=1 ; : GO/DONE=1 ADCON0 2 RB=1 ; : CHS0=1 ADCON0 3 RB=1 ; : CHS1=1 ADCON0 4 RB=1 ; : CHS2=1 ADCON0 5 RB=1 ; : ADCS0=1 ADCON0 6 RB=1 ; : ADCS1=1 ADCON0 7 RB=1 ; : 如果Z=0 IF'Z=0 ; : 如果Z=1 IF'Z=1 ; : 如果C=0 IF'C=0 ; : 如果C=1 IF'C=1 ; : 否則 ELSE' ; : 結束如果 ENDIF' ; : 開始 BEGIN' ; : 直到R-1=0' UNTIL'R-1=0' ; : 直到RX=0 UNTIL'RX=0 ; : 直到C=0 UNTIL'C=0 ; : 直到C=1 UNTIL'C=1 ; : 再來 AGAIN' ; : 當C=0 WHILE'C=0 ; : 麥岔 DI ; : 岔 EI ; : 現在位址 HERE' ; : 如果A=0 IF'A=0 ; : 從這 ORG ; \ Common 47F 從這 T: 執行.TBL \ Common 600 從這 T: 延遲52uS 現在位址 1 + CALL \ Common T: 延遲26uS 26 #>A \ Common T: 延遲 1 A>R' 開始 1 直到R-1=0' ( NOP ) RET \ Common T: 傳送 0 Ao# ( NOP ) 如果A=0 RET 結束如果 1 A>R' \ Common R1,2 9 2 #>R' C=0 ( START BIT=0 ) 開始 NOP C>TX 延遲52uS 1 RRCR' 2 直到R-1=0' TX=1 延遲52uS RET ( STOP BIT=1 ) T: 接收 9 2 #>R' 開始 直到RX=0 延遲26uS ( START BIT=0 ) 開始 NOP RX>C 1 RRCR' 延遲52uS 2 直到R-1=0' 1 R>A' RET \ Common R1,2 T: 空格 20 #>A 傳送 RET \ Common R1,2 T: 換行 0A #>A 傳送 0D #>A 傳送 RET \ Common R1,2 T: 0~F>ASC 0F An# F6 A+# 如果C=1 7 A+# 結束如果 3A A+# RET \ Common T: 傳送一數字 0~F>ASC 傳送 RET \ Common R1,2 T: 傳送二數字 3 A>R' 3 SWAPR>A' 傳送一數字 \ Common 3 A>R' 傳送一數字 RET \ Common 現在位址 4F5 從這 T: (pic.") 6 A>R' 現在位址 9 + CALL 7 A>R' ( length ) 開始 6 R+' 6 R>A' 現在位址 5 + CALL 傳送 7 直到R-1=0' RET JMP>PC+A 從這 : 傳送" TABLE.OFFSET @ #>A (pic.") 現在位址 TABLE.OFFSET @ 500 + 從這 ( | ) 22 ( " ) WORD COUNT DUP #>ARET 1 TABLE.OFFSET +! BOUNDS DO 1 TABLE.OFFSET +! I C@ #>ARET LOOP 從這 TABLE.OFFSET @ 0FF > IF ." table.offset overflow >255" THEN ; T: 非0~F 傳送" ? <- 0~F" RET ( ... ) \ Common T: 非A~Z 傳送" ? <- A~Z" RET ( ... ) \ Common T: ASC>0~F D0 A+# ( 30 ... 0 ) \ Common 如果C=1 F6 A+# \ 30~39 => F6~FF 如果C=0 0A A+# RET \ 0~9 結束如果 DF An# \ lower case -> UPPER CASE F9 A+# \ 如果C=1 FA A+# \ 41~46 => FA~FF 如果C=0 0F An# RET \ A~F 結束如果 結束如果 結束如果 非0~F RET T: 接收一數字 接收 ASC>0~F RET ( ... 0~F ) \ Common T: 接收二數字 接收一數字 5 A>R' 5 SWAPR' 接收一數字 5 AoR' RET \ Common R5 T: 起始設定 0B R=0 BANK1 A=0 7 A>R BANK0 FE 7 #>R 50 0 #>R 68 1 #>R' RET T: 接收.A~Z 接收 0DF An# 6 A>R' 傳送 6 R>A' BF A+# \ A~Z and above 如果C=0 非A~Z 結束如果 6 A>R' E6 A+# \ below Z \R6 如果C=1 非A~Z 結束如果 6 R>A' RET ( A ~ Z ) \ Common T: 執行.A~Z 執行.TBL 換行 RET T: 開動 70 4 #>R' 麥岔 起始設定 ( INIT.51 ) ( INIT.AVR ) ( INIT.EMC ) \ Common 換行 傳送" 8-bits Forth 035201382 Taiwan" 開始 麥岔 換行 傳送" *" 接收.A~Z ( 7 #>A ) 執行.A~Z C=0 直到C=1 \ 再來 T: 走 RET T: 下載 RET \ Common T: 逃離 RET T: 救命啊 傳送" 上載 ?下載 救命啊 " RET \ Common o T: 上載 7F 4 #>R' 開始 4 R>A' 07 An# 如果Z=1 換行 THEN' 4 R>A' 傳送 ( 空格 ) (SP)>A 傳送 \ Common 4 直到R-1=0' 換行 RET \ PIC-->PC 現在位址 0 從這 \ 開動 ,JMP \ Common ( ' 執行.TBL ) 47F 從這 JMP>A+PC \ Common ( A ) RET ( B ) RET ( C ) RET 下載 ( D ) RET 逃離 ( E ) RET ( F ) RET 走 ( G ) RET 救命啊 ( H ) RET ( I ) RET ( J ) RET ( K ) RET ( L ) RET ( M ) RET ( N ) RET ( O ) RET 上載 ( P ) RET ( Q ) RET ( R ) RET ( S ) RET ( T ) RET ( U ) RET ( V ) RET ( W ) RET ( X ) RET ( Y ) RET ( Z ) RET 從這 COMMENT: 7F ORG T: GO.TBL 200 ORG T: DELAY.T $ 1 + CALL \ Common T: DELAY.T/2 20 #>A \ Common T: DELAY 1 A>R' BEGIN' 1 UNTIL'R-1=0' RET \ Common T: TX IF'A=0 RET THEN' ( A ... ) \ Common R1,2 1 A>R' 9 2 #>R' C=0 ( START BIT=0 ) BEGIN' /C>TX DELAY.T 1 RRCR' 2 UNTIL'R-1=0' TX=1 DELAY.T RET ( STOP BIT=1 ) T: RX 9 2 #>R' BEGIN' UNTIL'RX=0 DELAY.T/2 ( START BIT=0 ) BEGIN' RX>C 1 RRCR' DELAY.T 2 UNTIL'R-1=0' 1 R>A' RET \ Common R1,2 T: SPACE' 20 #>A TX RET \ Common R1,2 T: CRLF 0A #>A TX 0D #>A TX RET \ Common R1,2 T: 0~F>ASC 0F An# F6 A+# IF'C=1 7 A+# ENDIF' 3A A+# RET \ Common T: .n 0~F>ASC TX RET \ Common R1,2 T: .' 3 A>R' 3 SWAPR>A' .n 3 R>A' .n 3 R>A' RET HERE' 0F5 ORG' T: (pic.") 6 A>R' $ 9 + CALL 7 A>R' ( length ) BEGIN' 6 R+' 6 R>A' $ 5 + CALL TX 7 UNTIL'R-1=0' RET JMP>PC+A ORG' : pic." TABLE.OFFSET @ #>A (pic.") HERE' TABLE.OFFSET @ 100 + ORG' ( | ) 22 ( " ) WORD COUNT DUP #>ARET 1 TABLE.OFFSET +! BOUNDS DO 1 TABLE.OFFSET +! I C@ #>ARET LOOP ORG' TABLE.OFFSET @ 0FF > IF ." table.offset overflow >255" THEN ; T: not0~F pic." ? <- 0~F" RET ( ... ) \ Common T: notA~Z pic." ? <- A~Z" RET ( ... ) \ Common T: ASC>0~F D0 A+# ( 30 ... 0 ) \ Common IF'C=1 F6 A+# \ 30~39 => F6~FF IF'C=0 0A A+# RET \ 0~9 ENDIF' DF An# \ lower case -> UPPER CASE F9 A+# \ IF'C=1 FA A+# \ 41~46 => FA~FF IF'C=0 0F An# RET \ A~F ENDIF' ENDIF' ENDIF' not0~F RET \ 0000 JMP T: GET.n RX ASC>0~F RET ( ... 0~F ) \ Common T: GET2n GET.n 5 A>R' 5 SWAPR' GET.n 5 AoR' RET \ Common R5 T: INIT.PIC 0B R=0 BANK1 A=0 7 A>R BANK0 FE 7 #>R 50 0 #>R 68 1 #>R' RET T: GET.A~Z RX 0DF An# 6 A>R' TX 6 R>A' BF A+# \ A~Z and above IF'C=0 notA~Z ENDIF' 6 A>R' E6 A+# \ below Z \ R6 IF'C=1 notA~Z ENDIF' 6 R>A' RET ( A ~ Z ) \ Common T: GO.A~Z GO.TBL CRLF RET T: START 70 4 #>R DI INIT.PIC ( INIT.51 ) ( INIT.AVR ) ( INIT.EMC ) \ Common pic." 8-bits Forth 035201382 Taiwan" BEGIN' DI CRLF pic." *" GET.A~Z ( 7 #>A ) GO.A~Z AGAIN' T: DOWNLOAD RET \ Common T: HELP pic." Dump Go Help Test" RET \ Common T: UPLOAD 7F 4 #>R' BEGIN' 4 R>A' 07 An# IF'Z=1 CRLF THEN' 4 R>A' TX ( SPACE' ) (SP)>A TX \ Common 4 UNTIL'R-1=0' CRLF RET \ PIC-->PC HERE' 0 ORG START RET ( ' GO.TBL ) 7F ORG JMP>A+PC \ Common ( A ) RET ( B ) RET ( C ) RET DOWNLOAD ( D ) RET ( E ) RET ( F ) RET ( G ) RET HELP ( H ) RET ( I ) RET ( J ) RET ( K ) RET ( L ) RET ( M ) RET ( N ) RET ( O ) RET UPLOAD ( P ) RET ( Q ) RET ( R ) RET ( S ) RET ( T ) RET ( U ) RET ( V ) RET ( W ) RET ( X ) RET ( Y ) RET ( Z ) RET ORG' \ : U CONDITION>QUEUE''' U ; COMMENT; \ << : KEY' key dup emit ; : >PIC ( ... ) CR ." *** please enter .HEX file *** " BEGIN BEGIN KEY' 3A ( : ) = UNTIL cr KEY' 10 DIGIT DROP 10 * KEY' 10 DIGIT DROP + >R ( LENGTH ) KEY' 10 DIGIT DROP 10 * KEY' 10 DIGIT DROP + 10 * ( ADDR H ) KEY' 10 DIGIT DROP + 10 * KEY' 10 DIGIT DROP + ( ADDR L ) KEY' 10 DIGIT DROP 10 * KEY' 10 DIGIT DROP + DROP ( RECORD ) R@ IF R> 0 DO DUP I + KEY' 10 DIGIT DROP 10 * KEY' 10 DIGIT DROP + SWAP CP0 + C! LOOP DROP 0 ELSE R> 2DROP -1 THEN UNTIL ; VARIABLE TO.BE.FORGOTTEN \ in T:QUEUE == 7F 00 F3 2D 0F 00 007F nfa.of.T: GO.TBL \ 00 02 0F 2E 0F 00 0200 nfa.of.T: DELAY.52uS \ 01 02 2B 2E 0F 00 0201 nfa.of.T: DELAY.26uS \ 02 02 43 2E 0F 00 0202 nfa.of.T: DELAY \ 06 02 57 2E 0F 00 0206 nfa.of.T: TX \ 1C 02 6B 2E 0F 00 021C nfa.of.T: RX \ CFA' of T: NFA' name length : (FORGET') ( CFA ... ) \ FORGET name FORGET' T:_type_name >NAME DUP T:? IF T:QUEUE.MAX 0 -1 TO.BE.FORGOTTEN ! DO DUP T:QUEUE I 6 * + 2 + @ = IF I TO.BE.FORGOTTEN ! LEAVE THEN LOOP DROP TO.BE.FORGOTTEN @ -1 <> IF T:QUEUE TO.BE.FORGOTTEN @ 6 * + @ 0FFFF AND CP ! T:QUEUE.MAX 0 DO T:QUEUE I 6 * + @ 0= T:QUEUE I 6 * + 2 + @ 0= OR IF I LEAVE THEN LOOP 0 DO I TO.BE.FORGOTTEN @ >= IF T:QUEUE I 6 * 2 + + @ >R R@ R@ C@ 3F AND - 1 - ( FROM === NFA-LENGTH-1 ) R> C@ 3F AND 1 + ( LENGTH+1 ) ERASE T:QUEUE I 6 * + 6 ERASE THEN LOOP THEN TO.BE.FORGOTTEN @ 6 * DUP T:QUEUE.COUNTER ! ELSE DROP THEN ; : FORGET' ' (FORGET') ; : WORDS' T:QUEUE.MAX 0 DO T:QUEUE I 6 * + @ 0= T:QUEUE I 6 * + 2 + @ 0= OR IF I LEAVE THEN LOOP BASE @ >R DECIMAL CR ." *** " DUP . ." instruction(s) in the target system ***" CR 0 R> BASE ! ?DO T:QUEUE I 6 * + 2 + @ .ID SPACE LOOP ; \S COMMENT: \ ===================================================================== \ FORTH TO PIC COMPILER PIC 16C84 SEP. 7, 2001 16C84C.SEQ F2P4.SEQ \ ===================================================================== : CODE. CREATE -2 ALLOT [ ' doLIT FLIP ] LITERAL , HERE' , 22 C, ; : L: CODE. ; : :. CODE. ; : ;' RET ; : ;. RET ; : END-CODE. RET ; : END-CODE. RET ; : SEE' ' DUP >R INST R> 3 + @ U ; : SEE. SEE' ; \ =========================================================================== : SP+ 0 R+ ; : SP- 0 R- ; : N>T (0)>A ; : T>N A>(0) ; : TnN An(0) ; : ToN Ao(0) ; : TxN Ax(0) ; : T>T1 5 A>R ; : T1>T 5 R>A ; : T>T2 6 A>R ; : T2>T 6 R>A ; : T>T3 7顛>R ; : T3>T 7 R>A ; \ \ =========================================================================== 10 ORG' \ ADD, SUB, RL, RR AFFECTS CY CODE. '2DROP SP+ : 2DROP. '2DROP CALL ; \ CY CODE. 'DROP N>T L: 'NIP SP+ RET : DROP. 'DROP CALL ; \ IS CODE. '?DUP 0 To# Z=0? RET : NIP. 'NIP CALL ; \ UNAFFEC CODE. 'DUP SP- T>N RET : DUP. 'DUP CALL ; \ TED. CODE. 'AND TnN 'NIP JMP CODE. 'OR ToN 'NIP JMP CODE. 'XOR TxN 'NIP JMP CODE. 'OVER DUP. SP+ N>T SP- RET CODE. 'SWAP T>T1 N>T2 T1>N T2>T RET \ T<->N CODE. 'ROT T>T1 N>T2 T1>N SP+ N>T1 T2>N SP- T1>T RET CODE. '0= 0 To# Z=1? T=FF RET CODE. '= N-T T=FF Z=1? T=0 'NIP JMP CODE. '> N- N-T T=FF CY=0? T+ 'NIP JMP CODE. '< N-T 0 #>T CY=0? 'NIP JMP Z=1? T=FF 'NIP JMP CODE. '- N-T>T 'NIP JMP : [-] N-T>T 'NIP JMP ; CODE. '+ T+N 'NIP JMP : [+] T+N 'NIP JMP ; CODE. '1+ 1 T+# RET : [1+] 1 T+# ; CODE. '2+ 2 T+# RET : [2+] 2 T+# ; CODE. '1- FF T+# RET : [1-] FF T+# ; CODE. '2- FE T+# RET : [2-] FE T+# ; CODE. '2* CY=0 T>T1 T1 RLCR>T RET CODE. '2/ CY=0 T>T1 T1 RRCR>T RET CODE. 'D+ T>T1 N>T2 2DROP. T1+T N+T2 CY=0? T1 R+ T1>T RET CODE. 'D- T>T1 N>T2 2DROP. T-T1 T2-N CY=0? T1 R- T1>T RET CODE. 'S>D DUP. T=0 RET ( N ... N 0 ) CODE. 'INVERT FF Tx# RET CODE. 'ABS T>T1 T1 7 RB=1? RET CODE. 'NEGATE 0 #-T RET : [NEGATE] 0 #-T ; \ -T CODE. '* \ ( N1 N2 ... N1*N2.LOW N1*N2.HIGH ) T>T2 8 #>T1 N>T N=0 \ LOW BYTE BEGIN' CY=0 T2 0 RB=0? N+T RRCN T2 RRCR T1 UNTIL'R-1=0 SP+ T2>T RET CODE. '@ T>T1 SP>T3 T1>SP N>T1 T3>SP T1>T RET CODE. 'TT1 T>T1 N>T2 SP>T3 T1>SP RET CODE. '! 'TT1 CALL T2>N L: L1 T3>SP '2DROP JMP CODE. '+! 'TT1 CALL N+T2 L1 JMP CODE. 'DO T>T1 N>T2 SP>T3 RSP->SP