\ 16F87XK.SIM COPYRIGHT OF CJJ MAR. 126, 2004 19:46 \ add HEX \ FORGET OVERLAY : OVERLAY ; : .XX 0 <# # # #> TYPE ; : .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 ) 18 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 : (TO) 3 4 ; \ STATUS 4 : (RP0) 3 5 ; \ STATUS 5 : (RP1) 3 6 ; \ STATUS 6 : (IRP) 3 7 ; \ STATUS 7 : 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.R 7F AND DUP 0= IF DROP 4 REG C@ THEN ; : EXTRACT.B 380 AND 80 / ; : EXTRACT.8# 0FF AND ; : EXTRACT.11# 7FF 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 ; \ : FLIP 100 /MOD SWAP 100 * + ; CODE FLIP XCHG BH, BL NEXT END-CODE : SET.PCL,PCH CPU.MEM C@ DUP CPU.MEM 80 + C! \ INDF DUP CPU.MEM 100 + C! CPU.MEM 180 + C! CPU.MEM 1 + C@ CPU.MEM 101 + C! \ TMR0 CPU.MEM 81 + C@ CPU.MEM 181 + C! \ OPTION PC @ DUP CPU.MEM 2 + C! \ PCL DUP CPU.MEM 82 + C! DUP CPU.MEM 102 + C! DUP CPU.MEM 182 + C! 3F00 AND FLIP DUP CPU.MEM 0A + C! \ PCH PIC16F87X 14 BITS DUP CPU.MEM 8A + C! DUP CPU.MEM 10A + C! CPU.MEM 18A + C! CPU.MEM 3 + C@ DUP CPU.MEM 83 + C! \ STATUS DUP CPU.MEM 103 + C! CPU.MEM 183 + C! CPU.MEM 4 + C@ DUP CPU.MEM 84 + C! \ FSR DUP CPU.MEM 104 + C! CPU.MEM 184 + C! CPU.MEM 6 + C@ CPU.MEM 106 + C! \ PORTB CPU.MEM 86 + C@ CPU.MEM 186 + C! \ TRISB CPU.MEM 0B + C@ DUP CPU.MEM 8B + C! \ INTCON DUP CPU.MEM 10B + C! CPU.MEM 18B + C! ; \ ========================================================================= VARIABLE STEP.COUNTER : 0S 0 STEP.COUNTER ! ; : 1S 1 STEP.COUNTER +! ; VARIABLE STEP.COUNTER.SETTING : SCS ( N ... ) STEP.COUNTER.SETTING ! ; : SC ( N ... ) STEP.COUNTER ! ; : CSC ( ..... ) 0 STEP.COUNTER ! ; CSC VARIABLE INSTRUCTION.TIME : 1T 1 INSTRUCTION.TIME +! 1S ; : 2T 2 INSTRUCTION.TIME +! 1S ; : 0T 0 INSTRUCTION.TIME ! ; : EXECUTE.A+R ( C ... ) EXTRACT.R 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 +! SET.PCL,PCH 1T ; : EXECUTE.JMP>A+PC DROP A.REG C@ PC @ 1+ + PC ! SET.PCL,PCH 2T ; \ 0782 : EXECUTE.R+A ( C ... ) EXTRACT.R 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 +! SET.PCL,PCH 1T ; : EXECUTE.R-A ( C ... ) EXTRACT.R 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 +! SET.PCL,PCH 1T ; : EXECUTE.R-A>A ( C ... ) EXTRACT.R REG C@ A.REG C@ - >R R@ A.REG ! R@ 0= (Z) RB! R@ 0FF > (C) RB! R> CALCULATE.DC (DC) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.AnR ( C ... ) EXTRACT.R REG C@ A.REG C@ AND >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RnA ( C ... ) EXTRACT.R DUP REG C@ A.REG C@ AND >R R@ SWAP REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.AoR ( C ... ) EXTRACT.R REG C@ A.REG C@ OR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RoA ( C ... ) EXTRACT.R DUP REG C@ A.REG C@ OR >R R@ SWAP REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.AxR ( C ... ) EXTRACT.R REG C@ A.REG C@ XOR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RxA ( C ... ) EXTRACT.R DUP REG C@ A.REG C@ XOR >R R@ SWAP REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.R=0 ( C ... ) EXTRACT.R REG 0 SWAP C! -1 (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.A=0 ( C ... ) 0 A.REG C! DROP -1 (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE./R ( C ... ) EXTRACT.R DUP >R REG C@ FF XOR DUP R> REG C! 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE./R>A ( C ... ) EXTRACT.R REG C@ FF XOR DUP A.REG C! 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.R- ( C ... ) EXTRACT.R DUP >R REG C@ 1- DUP R> REG C! 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.R-1>A ( C ... ) EXTRACT.R REG C@ 1- DUP A.REG C! 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.R-1=0? ( C ... ) EXTRACT.R DUP >R REG C@ 1- DUP R> REG C! 0= IF 2 2T ELSE 1 1T THEN PC +! SET.PCL,PCH ; : EXECUTE.R-1=0?>A EXTRACT.R REG C@ 1- DUP A.REG C! 0= IF 2 2T ELSE 1 1T THEN PC +! SET.PCL,PCH ; : EXECUTE.R+ ( C ... ) EXTRACT.R DUP >R REG C@ 1+ DUP R> REG C! 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.R+1>A ( C ... ) EXTRACT.R REG C@ 1+ DUP A.REG C! 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.R+1=0? ( C ... ) EXTRACT.R DUP >R REG C@ 1+ DUP R> REG C! 0= IF 2 2T ELSE 1 1T THEN PC +! SET.PCL,PCH 1T ; : EXECUTE.R+1=0?>A EXTRACT.R REG C@ 1+ DUP A.REG C! 0= IF 2 2T ELSE 1 1T THEN PC +! SET.PCL,PCH 1T ; : EXECUTE.R>A ( C ... ) EXTRACT.R REG C@ DUP A.REG C! 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.R:0 ( C ... ) EXTRACT.R REG C@ 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.A>R ( C ... ) EXTRACT.R REG A.REG C@ SWAP C! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.NOP 1 PC +! DROP SET.PCL,PCH 1T ; : EXECUTE.RLCR ( C ... ) EXTRACT.R DUP >R REG C@ 2* SPLIT 0<> (C) RB! R> REG C! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RLCR>A ( C ... ) EXTRACT.R REG C@ 2* SPLIT 0<> (C) RB! A.REG C! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RRCR ( C ... ) EXTRACT.R DUP >R REG C@ DUP 1 AND 0<> (C) RB! 2/ R> REG C! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RRCR>A ( C ... ) EXTRACT.R REG C@ DUP 1 AND 0<> (C) RB! 2/ A.REG C! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.SWAPR ( C ... ) EXTRACT.R DUP >R REG C@ 10 /MOD SWAP 10 * + R> REG C! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.SWAPR>A EXTRACT.R REG C@ 10 /MOD SWAP 10 * + A.REG C! 1 PC +! SET.PCL,PCH 1T ; \ ========================================================================= : EXECUTE.RB=0 DUP EXTRACT.R SWAP EXTRACT.B 0 -ROT RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RB=1 DUP EXTRACT.R SWAP EXTRACT.B 1 -ROT RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RB=0? DUP EXTRACT.R SWAP EXTRACT.B RB@ IF 1 1T ELSE 2 2T THEN PC +! SET.PCL,PCH ; : EXECUTE.RB=1? DUP EXTRACT.R SWAP EXTRACT.B RB@ IF 2 2T ELSE 1 1T THEN PC +! SET.PCL,PCH ; \ ========================================================================= : 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 +! SET.PCL,PCH 1T ; : EXECUTE.An# ( C ... ) EXTRACT.8# A.REG C@ AND >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.Ao# ( C ... ) EXTRACT.8# A.REG C@ OR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.Ax# ( C ... ) EXTRACT.8# A.REG C@ XOR >R R@ A.REG C! R> 0= (Z) RB! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.CALL ( C ... ) PUSH.PC EXTRACT.11# PC ! SET.PCL,PCH 2T ; : EXECUTE.JMP ( C ... ) EXTRACT.11# PC ! SET.PCL,PCH 2T ; : EXECUTE.WDT=0 ( C ... ) 0 WDT ! DROP 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.#>A ( C ... ) EXTRACT.8# A.REG ! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.A=# ( C ... ) EXTRACT.8# A.REG ! 1 PC +! SET.PCL,PCH 1T ; : EXECUTE.RETI ( C ... ) POP.PC DROP SET.PCL,PCH 2T ; : EXECUTE.RET ( C ... ) POP.PC DROP SET.PCL,PCH 2T ; : EXECUTE.#>ARET ( C ... ) POP.PC EXTRACT.8# A.REG ! SET.PCL,PCH 2T ; : EXECUTE.SLEEP ( C ... ) DROP 1 (TO) RB! 1 PC +! -1 (PD) RB! SET.PCL,PCH 1T ; : 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 +! SET.PCL,PCH 1T ; \ ========================================================================= \ 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 ; : !.6C1D7R: !.A.RANGE.OF.JMP.CODE.ADDR ; : !.16C: !.A.RANGE.OF.JMP.CODE.ADDR ; : !.4C3B7R: !.A.RANGE.OF.JMP.CODE.ADDR ; : !.5C1X8#: !.A.RANGE.OF.JMP.CODE.ADDR ; : !.6C8#: !.A.RANGE.OF.JMP.CODE.ADDR ; : !.3C11#: !.A.RANGE.OF.JMP.CODE.ADDR ; : !.4C2X8#: !.A.RANGE.OF.JMP.CODE.ADDR ; \ ========================================================================= : !.A+R [ ' EXECUTE.A+R ] LITERAL 700 80 !.6C1D7R: ; !.A+R : !.R+A [ ' EXECUTE.A+R ] LITERAL 780 80 !.6C1D7R: ; !.R+A : !.AnR [ ' EXECUTE.AnR ] LITERAL 500 80 !.6C1D7R: ; !.AnR : !.RnA [ ' EXECUTE.AnR ] LITERAL 580 80 !.6C1D7R: ; !.RnA : !.AoR [ ' EXECUTE.AoR ] LITERAL 400 80 !.6C1D7R: ; !.AoR : !.RoA [ ' EXECUTE.AoR ] LITERAL 480 80 !.6C1D7R: ; !.RoA : !.AxR [ ' EXECUTE.AxR ] LITERAL 600 80 !.6C1D7R: ; !.AxR : !.RxA [ ' EXECUTE.AxR ] LITERAL 680 80 !.6C1D7R: ; !.RxA : !.R=0 [ ' EXECUTE.R=0 ] LITERAL 180 80 !.6C1D7R: ; !.R=0 : !.A=0 [ ' EXECUTE.A=0 ] LITERAL 100 80 !.6C1D7R: ; !.A=0 : !./R [ ' EXECUTE./R ] LITERAL 900 80 !.6C1D7R: ; !./R : !.R-1>A [ ' EXECUTE.R-1>A ] LITERAL 300 80 !.6C1D7R: ; !.R-1>A : !.R- [ ' EXECUTE.R- ] LITERAL 380 80 !.6C1D7R: ; !.R- : !.R-1=0?>A [ ' EXECUTE.R-1=0?>A ] LITERAL B00 80 !.6C1D7R: ; !.R-1=0?>A : !.R-1=0? [ ' EXECUTE.R-1=0? ] LITERAL B80 80 !.6C1D7R: ; !.R-1=0? : !.R+1>A [ ' EXECUTE.R+1>A ] LITERAL A00 80 !.6C1D7R: ; !.R+1>A : !.R+ [ ' EXECUTE.R+ ] LITERAL A80 80 !.6C1D7R: ; !.R+ : !.R+1=0?>A [ ' EXECUTE.R+1=0?>A ] LITERAL F00 80 !.6C1D7R: ; !.R+1=0?>A : !.R+1=0? [ ' EXECUTE.R+1=0? ] LITERAL F80 80 !.6C1D7R: ; !.R+1=0? : !.R>A [ ' EXECUTE.R>A ] LITERAL 800 80 !.6C1D7R: ; !.R>A : !.R:0 [ ' EXECUTE.R:0 ] LITERAL 880 80 !.6C1D7R: ; !.R:0 : !.A>R [ ' EXECUTE.A>R ] LITERAL 080 80 !.6C1D7R: ; !.A>R : !.RLCR>A [ ' EXECUTE.RLCR ] LITERAL D00 80 !.6C1D7R: ; !.RLCR>A : !.RLCR [ ' EXECUTE.RLCR ] LITERAL D80 80 !.6C1D7R: ; !.RLCR : !.RRCR>A [ ' EXECUTE.RRCR ] LITERAL C00 80 !.6C1D7R: ; !.RRCR>A : !.RRCR [ ' EXECUTE.RRCR ] LITERAL C80 80 !.6C1D7R: ; !.RRCR : !.R-A [ ' EXECUTE.R-A ] LITERAL 200 80 !.6C1D7R: ; !.R-A : !.R-A>A [ ' EXECUTE.R-A>A ] LITERAL 280 80 !.6C1D7R: ; !.R-A>A : !.SWAPR>A [ ' EXECUTE.SWAPR>A ] LITERAL E00 80 !.6C1D7R: ; !.SWAPR>A : !.SWAPR [ ' EXECUTE.SWAPR ] LITERAL E80 80 !.6C1D7R: ; !.SWAPR : !.NOP [ ' EXECUTE.NOP ] LITERAL DUP 0 1 !.16C: DUP 20 1 !.16C: DUP 40 1 !.16C: 60 1 !.16C: ; !.NOP \ ========================================================================= : !.RB=0 [ ' EXECUTE.RB=0 ] LITERAL 1000 400 !.4C3B7R: ; !.RB=0 : !.RB=1 [ ' EXECUTE.RB=1 ] LITERAL 1400 400 !.4C3B7R: ; !.RB=1 : !.RB=0? [ ' EXECUTE.RB=0? ] LITERAL 1800 400 !.4C3B7R: ; !.RB=0? : !.RB=1? [ ' EXECUTE.RB=1? ] LITERAL 1C00 400 !.4C3B7R: ; !.RB=1? \ ========================================================================= : !.A+# [ ' EXECUTE.A+# ] LITERAL 3E00 200 !.5C1X8#: ; !.A+# : !.#-A [ ' EXECUTE.#-A ] LITERAL 3C00 200 !.5C1X8#: ; !.#-A : !.An# [ ' EXECUTE.An# ] LITERAL 3900 100 !.6C8#: ; !.An# : !.Ao# [ ' EXECUTE.Ao# ] LITERAL 3800 100 !.6C8#: ; !.Ao# : !.Ax# [ ' EXECUTE.Ax# ] LITERAL 3A00 100 !.6C8#: ; !.Ax# : !.CALL [ ' EXECUTE.CALL ] LITERAL 2000 800 !.3C11#: ; !.CALL : !.JMP [ ' EXECUTE.JMP ] LITERAL 2800 800 !.3C11#: ; !.JMP : !.WDT=0 [ ' EXECUTE.WDT=0 ] LITERAL 64 1 !.16C: ; !.WDT=0 : !.RETI [ ' EXECUTE.RETI ] LITERAL 9 1 !.16C: ; !.RETI : !.RET [ ' EXECUTE.RET ] LITERAL 8 1 !.16C: ; !.RET : !.SLEEP [ ' EXECUTE.SLEEP ] LITERAL 63 1 !.16C: ; !.SLEEP : !.JMP>A+PC [ ' EXECUTE.JMP>A+PC ] LITERAL 782 1 !.16C: ; !.JMP>A+PC : !.#>A [ ' EXECUTE.#>A ] LITERAL 3000 400 !.4C2X8#: ; !.#>A : !.#>ARET [ ' EXECUTE.#>ARET ] LITERAL 3400 400 !.4C2X8#: ; !.#>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 ; : .BINARY ( N ... ) SPACE BASE @ >R 2 BASE ! 0 <# # # # # # # # # #> TYPE R> BASE ! ; 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 ; : DISPLAY.CPU.REGISTERS ( ... ) CPU.MEM CR 3 SPACES 10 0 DO I 3 .R LOOP 200 0 DO I 10 MOD 0 = IF CR I 3 U.R ." : " THEN DUP I + C@ .XX SPACE LOOP DROP ; : S877 DISPLAY.CPU.REGISTERS ; : R. SPACE CPU.MEM + C@ .XX ." , " ; : ----- ." ----- " ; : DISPLAY.SPECIAL.REGISTERS ( ... ) CR ." W = A ( ) " A.REG @ .XX ." ," CR ." INDF ( 0)" 0 R. ." INDF (80)" 80 R. ." INDF (100)" 100 R. ." INDF (180)" 180 R. CR ." TMR0 ( 1)" 1 R. ." OPTION (81)" 81 R. ." TMR0 (101)" 101 R. ." TMR0 (181)" 181 R. CR ." PCL ( 2)" 2 R. ." PCL (82)" 82 R. ." PCL (102)" 102 R. ." PCL (182)" 182 R. CR ." STATUS ( 3)" 3 R. ." STATUS (83)" 83 R. ." STATUS (103)" 103 R. ." STATUS (183)" 183 R. CR ." FSR ( 4)" 4 R. ." FSR (84)" 84 R. ." FSR (104)" 104 R. ." FSR (184)" 184 R. CR ." PORTA ( 5)" 5 R. ." TRISA (85)" 85 R. ----- SPACE ----- CR ." PORTB ( 6)" 6 R. ." TRISB (86)" 86 R. ." PORTB (106)" 106 R. ." TRISB (186)" 186 R. CR ." PORTC ( 7)" 7 R. ." TRISC (87)" 87 R. ----- SPACE ----- CR ." PORTD ( 8)" 8 R. ." TRISD (88)" 88 R. ----- SPACE ----- CR ." PORTE ( 9)" 9 R. ." TRISE (89)" 89 R. ----- SPACE ----- CR ." PCLATH (0A)" 0A R. ." PCLATH (8A)" 8A R. ." PCLATH (10A)" 10A R. ." PCLATH (18A)" 18A R. CR ." INTCON (0B)" 0B R. ." INTCON (8B)" 8B R. ." INTCON (10B)" 10B R. ." INTCON (18B)" 18B R. CR ." PIR1 (0C)" 0C R. ." PE1 (8C)" 8C R. ." EEDATA (10C)" 10C R. ." EECON1 (18C)" 18C R. CR ." PIR2 (0D)" 0D R. ." PE2 (8D)" 8D R. ." EEADR (10D)" 10D R. ." EECON2 (18D)" 18D R. CR ." TMR1L (0E)" 0E R. ." PCON (8E)" 8E R. ." EEDATAH(10E)" 10E R. ----- CR ." TMR1H (0F)" 0F R. ----- ." EEADRH (10F)" 10F R. ----- CR ." T1CON (10)" 10 R. ----- CR ." TMR2 (11)" 11 R. ." SSPCON2(91)" 91 R. CR ." T2CON (12)" 12 R. ." PR2 (92)" 92 R. CR ." SSPBUF (13)" 13 R. ." SSPADD (93)" 93 R. CR ." SSPCON (14)" 14 R. ." SSPSTAT(94)" 94 R. CR ." CCPR1L (15)" 15 R. ----- CR ." CCPR1H (16)" 16 R. ----- CR ." CCP1CON(17)" 17 R. ----- CR ." RCSTA (18)" 18 R. ." TXSTA (98)" 98 R. CR ." TXREG (19)" 19 R. ." SPBRG (99)" 99 R. CR ." RCREG (1A)" 1A R. ----- CR ." CCPR2L (1B)" 1B R. ----- CR ." CCPR2H (1C)" 1C R. ----- CR ." CCP2CON(1D)" 1D R. ----- CR ." ADRES (1E)" 1E R. ." ADRESL (9E)" 9E R. CR ." ADCON0 (1F)" 1F R. ." ADCON1 (9F)" 9F R. ; : SHOW.BIT 7 AND N>2^N SWAP CPU.MEM + C@ AND 0 <> IF 1 ELSE 0 THEN . ; : --- ." ----- " ; : DISPLAY.SPECIAL.BIT ( ... ) CR ." STATUS ( 3):" ." IRP (7) " STATUS 7 SHOW.BIT ." RP1 (6) " STATUS 6 SHOW.BIT ." RP0 (5) " STATUS 5 SHOW.BIT ." TO (4) " STATUS 4 SHOW.BIT ." PD (3) " STATUS 3 SHOW.BIT --- --- --- CR ." PORTE ( 9):" --- --- --- --- --- ." RE2 (2) " PORTE 2 SHOW.BIT ." RE1 (1) " PORTE 1 SHOW.BIT ." RE0 (0) " PORTE 0 SHOW.BIT CR ." INTCON (0B):" ." GIE (7) " INTCON 7 SHOW.BIT ." PEIE (6) " INTCON 6 SHOW.BIT ." T0IE (5) " INTCON 5 SHOW.BIT ." INTE (4) " INTCON 4 SHOW.BIT ." RB1E (3) " INTCON 3 SHOW.BIT ." T0IF (2) " INTCON 2 SHOW.BIT ." INTF (1) " INTCON 1 SHOW.BIT ." RBIF (0) " INTCON 0 SHOW.BIT CR ." PIR1 (0C):" ." PSPIF (7) " PIR1 7 SHOW.BIT ." ADIF (6) " PIR1 6 SHOW.BIT ." RCIF (5) " PIR1 5 SHOW.BIT ." TXIF (4) " PIR1 4 SHOW.BIT ." SSP1F (3) " PIR1 3 SHOW.BIT ." CCP1IF (2) " PIR1 2 SHOW.BIT ." TMR2IF (1) " PIR1 1 SHOW.BIT ." TMR1IF (0) " PIR1 0 SHOW.BIT CR ." PIR2 (0D):" --- --- --- ." EEIF (4) " PIR2 4 SHOW.BIT ." BCLIF (3) " PIR2 3 SHOW.BIT --- --- ." CCP2IF (0) " PIR2 0 SHOW.BIT CR ." T1CON (10):" --- --- ." T1CKPS1(5) " T1CON 5 SHOW.BIT ." T1CKPS0(4) " T1CON 4 SHOW.BIT ." T1OSCEN(3) " T1CON 3 SHOW.BIT ." T1SYNC (2) " T1CON 2 SHOW.BIT ." TMR1CS (1) " T1CON 1 SHOW.BIT ." TMR1ON (0) " T1CON 0 SHOW.BIT CR ." T2CON (12):" --- ." TOUTPS0(6) " T2CON 6 SHOW.BIT ." TOUTPS2(5) " T2CON 5 SHOW.BIT ." TOUTPS1(4) " T2CON 4 SHOW.BIT ." TOUTPS0(3) " T2CON 3 SHOW.BIT ." TMR2ON (2) " T2CON 2 SHOW.BIT ." T2CKPS1(1) " T2CON 1 SHOW.BIT ." T2CKPS0(0) " T2CON 0 SHOW.BIT CR ." SSPCON (14):" ." WCOL (7) " SSPCON 7 SHOW.BIT ." SSPOV (6) " SSPCON 6 SHOW.BIT ." SSPEN (5) " SSPCON 5 SHOW.BIT ." CKP (4) " SSPCON 4 SHOW.BIT ." SSPM3 (3) " SSPCON 3 SHOW.BIT ." SSPM2 (2) " SSPCON 2 SHOW.BIT ." SSPM1 (1) " SSPCON 1 SHOW.BIT ." SSPM0 (0) " SSPCON 0 SHOW.BIT CR ." CCP1CON(17):" --- --- ." CCP1X (5) " CCP1CON 4 SHOW.BIT ." CCP1Y (4) " CCP1CON 4 SHOW.BIT ." CCP1M3 (3) " CCP1CON 3 SHOW.BIT ." CCP1M2 (2) " CCP1CON 2 SHOW.BIT ." CCP1M1 (1) " CCP1CON 1 SHOW.BIT ." CCP1M0 (0) " CCP1CON 0 SHOW.BIT CR ." RCSTA (18):" ." SPEN (7) " RCSTA 7 SHOW.BIT ." RX9 (6) " RCSTA 6 SHOW.BIT ." SREN (5) " RCSTA 5 SHOW.BIT ." CREN (4) " RCSTA 4 SHOW.BIT --- ." FERR (2) " RCSTA 2 SHOW.BIT ." OERR (1) " RCSTA 1 SHOW.BIT ." RX9D (0) " RCSTA 0 SHOW.BIT CR ." CCP2CON(1D):" --- --- ." CCP2X (5) " CCP2CON 5 SHOW.BIT ." CCP2Y (4) " CCP2CON 4 SHOW.BIT ." CCP2M3 (3) " CCP2CON 3 SHOW.BIT ." CCP2M2 (2) " CCP2CON 2 SHOW.BIT ." CCP2M1 (1) " CCP2CON 1 SHOW.BIT ." CCP2M0 (0) " CCP2CON 0 SHOW.BIT CR ." ADCON0 (1F):" ." ADCS1 (7) " ADCON0 7 SHOW.BIT ." ADCS0 (6) " ADCON0 6 SHOW.BIT ." CHS2 (5) " ADCON0 5 SHOW.BIT ." CHS1 (4) " ADCON0 4 SHOW.BIT ." CHS0 (3) " ADCON0 3 SHOW.BIT ." GO/DONE(2) " ADCON0 2 SHOW.BIT --- --- ; \ ' DISPLAY.CPU.REGISTERS IS _SHOW.REGISTER.CONTENT : FILL.CPU.REGISTERS.WITH.N ( N ... ) 200 0 DO DUP CPU.MEM I + C! LOOP DROP ; : C 0 FILL.CPU.REGISTERS.WITH.N DISPLAY.CPU.REGISTERS ; : F 0FF FILL.CPU.REGISTERS.WITH.N DISPLAY.CPU.REGISTERS ; DEFER _(ZZ) VARIABLE MODE VARIABLE LIMIT.LENGTH$ 20 LIMIT.LENGTH$ ! VARIABLE PIC.INSTRUCTION? DEFER _RESET : (GO) ( ADDR ... ) CR ." PRESS WSXZ TO SEE THE DIFFERENCE" 0 UNASSEMBLE(pic.")? ! 0 MODE ! _(ZZ) \ 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 ." SWXZ " BASE @ >R DECIMAL STEP.COUNTER @ . INSTRUCTION.TIME @ . R> BASE ! KEY UPC \ UPPER CASE CASE 1B OF -1 ENDOF \ ESC 53 OF DISPLAY.CPU.REGISTERS 0 ENDOF \ S 57 OF CLS DISPLAY.SPECIAL.REGISTERS DISPLAY.SPECIAL.BIT 0 ENDOF \ W 58 OF -1 PIC.INSTRUCTION? @ XOR PIC.INSTRUCTION? ! PIC.INSTRUCTION? @ IF 0A ELSE 20 THEN LIMIT.LENGTH$ ! 0 ENDOF \ X 5A OF CLS DISPLAY.CPU.REGISTERS 20 MS 0 ENDOF \ Z 0 ENDCASE >R R@ 0 = R@ -1 = OR IF R> ELSE R> DROP 0 THEN UNTIL ; \ : G (GO) ; : DISPLAY.A.LINE.OF.INSTRUCTION ( ... ) CR PC @ ." ( " DUP .XXXX PC @ @.PROGRAM 2 SPACES .XXXX ." ) " DISASSEM"" DROP ; VARIABLE MAXIMUM.BREAK.POINTS 400 MAXIMUM.BREAK.POINTS ! CREATE BREAK.POINT.QUEUE MAXIMUM.BREAK.POINTS @ 4 * ALLOT : CLEAR.BREAK.POINT BREAK.POINT.QUEUE MAXIMUM.BREAK.POINTS @ 4 * -1 FILL ; \ : SHOW.BREAK.POINT(S) ." BREAK POINT(S): " \ 0 MAXIMUM.BREAK.POINTS @ 1 - 4 * \ DO I BREAK.POINT.QUEUE + @ DUP -1 <> \ IF . \ ELSE DROP \ THEN -4 \ +LOOP ; VARIABLE SET.BREAK.POINT? : SHOW.BREAK.POINT(S) ." BREAK POINT(S): " 0 MAXIMUM.BREAK.POINTS @ 1 - 4 * DO I BREAK.POINT.QUEUE + @ DUP -1 <> IF . ELSE DROP THEN -4 +LOOP ; : SET.BREAK.POINT(S) ( N+M..N-1 N ... ) -1 SET.BREAK.POINT? ! CLEAR.BREAK.POINT ( ?STACK ) DEPTH 0 ?DO I 4 * BREAK.POINT.QUEUE + ! LOOP SHOW.BREAK.POINT(S) ; : SBP SET.BREAK.POINT(S) ; : CBP CLEAR.BREAK.POINT ; CBP : SHOW.BREAK.POINT.RANGE ( FROM TO ... ) ." BREAK POINT RANGE: " ." from " SWAP . ." to " . ; VARIABLE BREAK.POINT.RANGE.UPPER VARIABLE BREAK.POINT.RANGE.LOWER : SET.BREAK.POINT.RANGE ( ADDR1 ADDR2 ... ) 0 SET.BREAK.POINT? ! 2DUP MIN -ROT MAX 2DUP - ABS MAXIMUM.BREAK.POINTS @ > IF ABORT" *** RANGE IS TOO LARGE *** " ELSE CLEAR.BREAK.POINT \ ." BREAK POINT RANGE: " ." from " OVER . ." to " DUP . 2DUP BREAK.POINT.RANGE.UPPER ! BREAK.POINT.RANGE.LOWER ! 2DUP SHOW.BREAK.POINT.RANGE 1+ OVER - 0 DO DUP I + BREAK.POINT.QUEUE I 4 * + ! LOOP DROP THEN ; : SBPR SET.BREAK.POINT.RANGE ; : CBPR 0 BREAK.POINT.RANGE.UPPER ! 0 BREAK.POINT.RANGE.LOWER ! ; VARIABLE FOLLOWINGS 1 FOLLOWINGS ! : FOL FOLLOWINGS ! ; : SHOW.BREAK.POINT(S)/RANGE ( ... ) SET.BREAK.POINT? @ IF SHOW.BREAK.POINT(S) ELSE BREAK.POINT.RANGE.UPPER @ BREAK.POINT.RANGE.LOWER @ SHOW.BREAK.POINT.RANGE THEN ; : SHOW.REGISTER.CONTENT DISPLAY.CPU.REGISTERS ; : GODO @.PROGRAM DUP 4 * CODE>EXEC.ADDR + @ EXECUTE ; \ COMMENT: : (GO') ( ADDR ... ) PC ! \ -1 SHOW.REGISTERS.NAME? ! BEGIN \ GET.QUESTION.DATA 0 40 4 * 0 DO PC @ I BREAK.POINT.QUEUE + @ = OR 4 +LOOP PC @ STEP.COUNTER.SETTING @ = OR IF FOLLOWINGS @ 0 DO \ SHOW.REGISTER.CONTENT \ PC @ GODO \ LOOP ." ( S W X Z )" \ KEY 0DF AND >R R@ 53 ( S ) = \ IF CR S51 \ ELSE R@ 5A ( Z) = \ IF CLS S51 \ THEN \ THEN R> DROP CR 1 MS 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 ." SWXZ " BASE @ >R DECIMAL STEP.COUNTER @ . INSTRUCTION.TIME @ . R> BASE ! LOOP KEY UPC \ UPPER CASE CASE 1B OF -1 ENDOF \ ESC 53 OF DISPLAY.CPU.REGISTERS 0 ENDOF \ S 57 OF CLS DISPLAY.SPECIAL.REGISTERS DISPLAY.SPECIAL.BIT 0 ENDOF \ W 58 OF -1 PIC.INSTRUCTION? @ XOR PIC.INSTRUCTION? ! PIC.INSTRUCTION? @ IF 0A ELSE 20 THEN LIMIT.LENGTH$ ! 0 ENDOF \ X 5A OF CLS DISPLAY.CPU.REGISTERS 20 MS 0 ENDOF \ Z 0 ENDCASE >R R@ 0 = R@ -1 = OR IF R> ELSE R> DROP 0 THEN ELSE PC @ GODO 0 THEN \ JUDGE.QUESTION \ KEY? IF KEY 1B = ( Esc ) ELSE 0 THEN UNTIL ; : GO' SHOW.BREAK.POINT(S)/RANGE ." PRESS WSXZ TO SEE THE DIFFERENCE" (GO') ; : G' GO' ; : CONTINUE ( ... ) PC @ (GO) ; : CONTINUE' ( ... ) PC @ GO' ; : CON' CONTINUE' ; : CON CONTINUE ; \ COMMENT; VARIABLE PREVIOUS.INSTRUCTION : CONTINUE PC @ (GO) ; : CON CONTINUE ; : RUN PC ! 0 RP ! _RESET CR 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@ DUP 0D = IF SPACE CR THEN EMIT POP.PC THEN KEY? IF CR 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' \ ============================================================================= \ COPYWRIGHT OF CJJ \ 16F87X7.F ASSERBLER AND DISASSEMBLER FOR PIC 16F87X MICROCONTROLLER. \ ======================================== \ PIC 16F87X ASSEMBLER \ ======================================== HEX \ 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 [ HERE 20000 + FFFF0000 AND ] LITERAL ; \ HERE 20000 + FFFF0000 AND HERE - ALLOT : CP0 [ HERE 10000 + FFFF0000 AND ] LITERAL ; : CP0 PROGRAM.MEMORY ; \ HERE 10000 + FFFF0000 AND HERE - ALLOT \ : CP0 [ HERE 100 + ] LITERAL ; \ 2000 ALLOT : CELL 2 ; : CELL+ 2+ ; : CELL* 2* ; : CELL/ 2/ ; : CELL! ! ; : CELL@ @ ; : 16! >R 100 /MOD R@ 1+ C! R> C! ; : 16@ @ FFFF AND ; : C@' CP0 + C@ ; : @' CELL* CP0 + 16@ ; : C!' CP0 + C! ; : !' CELL* CP0 + 16! ; : +!' >R R@ @' + R> !' ; : HERE' ( ... ADDR ) CP @ ; : ALLOT' ( N ... ) CP +! ; : ,' ( N ... ) HERE' CELL* CP0 + ! 1 ALLOT' ; : ORG' ( ADDR ... ) CP ! ; \ : LABEL' HERE' 2/ ' 3 + @ ! ; \ : FLIP 100 /MOD SWAP 100 * + ; : BETWEEN 1+ WITHIN ; : 3B.CHECK ( B ... ) DUP 0 7 BETWEEN IF DROP ELSE ." B=" . ABORT" <-- B IS NOT IN THE RANGE 0 ~ 7 " THEN ; : 7R.CHECK ( R ... ) DUP 0 7F BETWEEN IF DROP ELSE ." R=" . ABORT" <-- R IS NOT IN THE RANGE 0 ~ 7F " THEN ; : 8#.CHECK ( # ... ) DUP 0 0FF BETWEEN IF DROP ELSE ." #=" . ABORT" <-- # IS NOT IN THE RANGE 0 ~ FF " THEN ; : 11#.CHECK ( # ... ) DUP 0 7FF BETWEEN IF DROP ELSE ." #=" . ABORT" <-- # IS NOT IN THE RANGE 0 ~ 7FF " THEN ; : 6C8#: CREATE , DOES> >R DUP 8#.CHECK R> @ + ,' ; : 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> @ ,' ; 0 14C: NOP 8 14C: RET : RETURN RET ; 9 14C: RETI : RETFIE RETI ; 63 14C: SLEEP 64 14C: WDT=0 : CLRWDT WDT=0 ; 100 14C: A=0 : CLRW A=0 ; 700 6C1D7R: A+R : ADDWF_W,0 A+R ; 780 6C1D7R: R+A : ADDWF_W,1 R+A ; 500 6C1D7R: AnR : ANDWF_W,0 AnR ; 508 6C1D7R: RnA : ANDWF_W,1 RnA ; 180 6C1D7R: R=0 : CLRF R=0 ; 900 6C1D7R: /R>A : COMF_F,0 /R>A ; : A=/R /R>A ; 980 6C1D7R: /R : COMF_F,1 /R ; 0300 6C1D7R: R-1>A : DECF_F,0 R-1>A ; : A=R-1 R-1>A ; 0300 6C1D7R: R->A 0380 6C1D7R: R- : DECF_F,1 R- ; 0B00 6C1D7R: R-1=0?>A : DECFSZ_F,0 R-1=0?>A ; : A=R-1=0? R-1=0?>A ; 0B80 6C1D7R: R-1=0? : DECFSZ_F,1 R-1=0? ; 0A00 6C1D7R: R+1>A : INCF_F,0 R+1>A ; : A=R+1 R+1>A ; 0A00 6C1D7R: R+>A 0A80 6C1D7R: R+ : INCF_F,1 R+ ; 0F00 6C1D7R: R+1=0?>A : INCFSZ_F,0 R+1=0?>A ; : A=R+1=0? R+1=0?>A ; 0F80 6C1D7R: R+1=0? : INCFSZ_F,1 R+1=0? ; 0400 6C1D7R: AoR : IORWF_F,0 AoR ; 0480 6C1D7R: RoA : IORWF_F,1 RoA ; 0800 6C1D7R: R>A : MOVF_F,0 R>A ; : A=R R>A ; 0880 6C1D7R: R:0 : MOVF_F,1 R:0 ; 0080 6C1D7R: A>R : MOVWF_F,0 A>R ; : R=A A>R ; 0D00 6C1D7R: RLCR>A : RLF_F,0 RLCR>A ; : A=RLCR RLCR>A ; 0D80 6C1D7R: RLCR : RLF_F,1 RLCR ; 0C00 6C1D7R: RRCR>A : RRF_F,0 RRCR>A ; : A=RRCR RRCR>A ; 0C80 6C1D7R: RRCR : RRF_F,1 RRCR ; 0200 6C1D7R: R-A>A : SUBWF_F,0 R-A>A ; : A=R-A R-A>A ; 0280 6C1D7R: R-A : SUBWF_F,1 R-A ; : -A+R R-A>A ; 0E00 6C1D7R: SWAPR>A : SWAPF_F,0 SWAPR>A ; : A=SWAPR SWAPR>A ; 0E80 6C1D7R: SWAPR : SWAPF_F,1 SWAPR ; 0600 6C1D7R: AxR : XORWF_F,0 AxR ; 0680 6C1D7R: RxA : XORWF_F,1 RxA ; 1000 4C3B7R: RB=0 : BCF RB=0 ; 1400 4C3B7R: RB=1 : BSF RB=1 ; 1800 4C3B7R: RB=0? : BTFSC RB=0? ; 1C00 4C3B7R: RB=1? : BTFSS RB=1? ; 3900 6C8#: An# : ANDLW An# ; 3800 6C8#: Ao# : IORLW Ao# ; 3A00 6C8#: Ax# : XORLW Ax# ; 3E00 5C1X8#: A+# : ADDLW A+# ; 3C00 5C1X8#: #-A : SUBLW #-A ; 3C00 5C1X8#: -A+# : #-A>A #-A ; : A=#-A #-A ; 3000 4C2X8#: #>A : MOVLW #>A ; : A=# #>A ; 3400 4C2X8#: #>ARET : RETLW #>ARET ; : RET,A=# #>ARET ; : A=#,RET #>ARET ; 2000 3C11#: CALL 2800 3C11#: JMP : GOTO JMP ; \ ------------------------------------------------------------- 12 VALUE (R) 34 VALUE (B) : A+ 1 A+# ; : A- FF A+# ; \ C=0 is Borrow ????? : C=0 3 0 RB=0 ; : C=1 3 0 RB=1 ; : Z=0 3 2 RB=0 ; : Z=1 3 2 RB=1 ; : Z=0? 3 2 RB=0? ; \ skip : Z=1? 3 2 RB=1? ; \ " : C=0? 3 0 RB=0? ; \ " : C=1? 3 0 RB=1? ; \ " : A.5=0 0BF An# ; : R-C C=0? R- ; \ R-CARRY : -A 0 #-A ; : A-R A=R-A -A ; : /A 0FF Ax# ; : R+# #>A R+A ; : R-# #>A R-A ; : R+R R>A R+A ; : R-R R>A R-A ; : Rn# #>A RnA ; : RnR #>A RnA ; : Ro# #>A RoA ; : RoR #>A RoA ; : Rx# #>A RxA ; : RxR #>A RxA ; : R=# #>A A>R ; : R>R SWAP R>A A>R ; : R=R R>A A>R ; : #>R SWAP #>A A>R ; : B>B TO (B) TO (R) (R) (B) RB=1? 2DUP RB=0 (R) (B) RB=0? RB=1 ; : B=B 2SWAP B>B ; : /B>B TO (B) TO (R) (R) (B) RB=0? 2DUP RB=0 (R) (B) RB=1? RB=1 ; : B=/B 2SWAP /B>B ; : B>C 3 0 B>B ; : C=B B>C ; : C>B 3 0 2SWAP B>B ; : B=C C>B ; : #>OPTION ; : A>OPTION ; : R>OPTION ; : #>TRIS ; : A>TRIS ; : R>TRIS ; : R>#? #>A FF Ax# A+R C=0? ( JMP ) ; \ > SKIP : R>R? SWAP R>A -A+R C=1? ( JMP ) ; \ > : R>=#? #>A -A+R C=0? ( JMP ) ; : R=>#? R>=#? ; \ >= : R>=R? R>A -A+R C=0? ( JMP ) ; : R=>R? R>=R? ; \ >= : R<#? #>A -A+R C=0? ( JMP ) ; \ < : RA -A+R C=0? ( JMP ) ; \ < : R<=#? #>A /A A+R C=0? ( JMP ) ; : R=<#? R<=#? ; \ <= : R<=R? R>A /A A+R C=0? ( JMP ) ; : R=A -A+R Z=1? ( JMP ) ; \ = : R=R? R>A -A+R Z=1? ( JMP ) ; \ = : R<>#? #>A -A+R Z=0? ( JMP ) ; \ <> : R<>R? R>A -A+R Z=0? ( JMP ) ; \ <> : R=0? 0 R=#? ; : R<>0? 0 R=#? ; : R-1<>0? R-1=0? ; \ ------------------------------------------------------------- \ CONDITIONAL STRUCTURE \ IF' A <> 12 R34 A \ UNTIL' R12 <= 0 1 \ WHILE' =< \ => \ >= \ > \ < \ = : IF'RB=0 ( R B ... ) RB=0? HERE' 0 JMP ; : IF'RB=1 ( R B ... ) RB=1? 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=1 ; : IF'Z=0 3 2 IF'RB=0 ; : IF'Z=1 3 2 IF'RB=1 ; : IF'A=0 0 Ao# IF'Z=1 ; : IF'A<>0 0 Ao# IF'Z=0 ; : IF'A=# Ax# IF'Z=1 ; \ add Ax# to recover A : IF'A<># Ax# IF'Z=0 ; \ " " : THEN'' ( ADDR ... ) HERE' @' >R HERE' OVER - 2 = IF HERE' 1- @' HERE' 2 - !' -1 ALLOT' DROP ELSE >R HERE' R@ @' 3800 AND OR R> !' THEN R> HERE' !' ; : THEN' ( ADDR ... ) >R HERE' R@ @' 3800 AND OR R> !' ; : ENDIF' THEN' ; : 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=1 ; : UNTIL'Z=0 3 2 UNTIL'RB=0 ; : UNTIL'Z=1 3 2 UNTIL'RB=1 ; : UNTIL'A=0 UNTIL'Z=1 ; : UNTIL'A<>0 UNTIL'Z=1 ; : UNTIL'A=# Ax# UNTIL'Z=1 ; : UNTIL'A<># Ax# UNTIL'Z=0 ; : WHILE'RB=0 ( R B ... ) IF'RB=0 ; : WHILE'RB=1 ( R B ... ) IF'RB=1 ; : WHILE'R+1=0 ( R ... ) IF'R+1=0 ; : WHILE'R-1=0 ( R ... ) IF'R-1=0 ; : WHILE'R+1=0>A ( R ... ) IF'R+1=0>A ; : WHILE'R-1=0>A ( R ... ) IF'R-1=0>A ; : WHILE'C=0 3 0 WHILE'RB=0 ; : WHILE'C=1 3 0 WHILE'RB=1 ; : WHILE'Z=0 3 2 WHILE'RB=0 ; : WHILE'Z=1 3 2 WHILE'RB=1 ; : WHILE'A=0 WHILE'Z=1 ; : WHILE'A<>0 WHILE'Z=1 ; : WHILE'A=# Ax# WHILE'Z=1 ; : WHILE'A<># Ax# WHILE'Z=0 ; : REPEAT' SWAP AGAIN' THEN' ; \ ======================================================== \ COMMENT: : IF'A<>R -A+R IF'Z=0 ; \ A, C, Z ARE CHANGED. : IF'A=R -A+R IF'Z=1 ; : IF'A<=R -A+R IF'C=0 ; : IF'A=R -A+R IF'C=1 ; \ IF'A>=R ; : IF'A=>R IF'A>=R ; \ IF'A# -A+# IF'Z=0 ; \ A, C, Z ARE CHANGED. : IF'A=# -A+# IF'Z=1 ; : IF'A<=# -A+# IF'C=0 ; : IF'A=<# IF'A<=# ; : IF'A># -A+# IF'C=1 ; \ IF'A>=# ; : IF'A=># IF'A>=# ; \ IF'A<# ; : UNTIL'A<>R -A+R UNTIL'Z=0 ; \ A, C, Z ARE CHANGED. : UNTIL'A=R -A+R UNTIL'Z=1 ; : UNTIL'A<=R -A+R UNTIL'C=0 ; : UNTIL'A=R -A+R UNTIL'C=1 ; \ UNTIL'A>=R ; : UNTIL'A=>R UNTIL'A>=R ; \ UNTIL'A# -A+# UNTIL'Z=0 ; \ A, C, Z ARE CHANGED. : UNTIL'A=# -A+# UNTIL'Z=1 ; : UNTIL'A<=# -A+# UNTIL'C=0 ; : UNTIL'A=<# UNTIL'A<=# ; : UNTIL'A># -A+# UNTIL'C=1 ; \ UNTIL'A>=# ; : UNTIL'A=># UNTIL'A>=# ; \ UNTIL'A<# ; : WHILE'A<>R -A+R WHILE'Z=0 ; \ A, C, Z ARE CHANGED. : WHILE'A=R -A+R WHILE'Z=1 ; : WHILE'A<=R -A+R WHILE'C=0 ; : WHILE'A=R -A+R WHILE'C=1 ; \ WHILE'A>=R ; : WHILE'A=>R WHILE'A>=R ; \ WHILE'A# -A+# WHILE'Z=0 ; \ A, C, Z ARE CHANGED. : WHILE'A=# -A+# WHILE'Z=1 ; : WHILE'A<=# -A+# WHILE'C=0 ; : WHILE'A=<# WHILE'A<=# ; : WHILE'A># -A+# WHILE'C=1 ; \ WHILE'A>=# ; : WHILE'A=># WHILE'A>=# ; \ WHILE'A<# ; \ COMMENT: : IF'R<>R R>A -A+R IF'Z=0 ; \ A, C, Z ARE CHANGED. : IF'R=R R>A -A+R IF'Z=1 ; : IF'R<=R R>A -A+R IF'C=0 ; : IF'R=R R>A -A+R IF'C=1 ; \ IF'R>=R ; : IF'R=>R IF'R>=R ; \ IF'R# SWAP R>A -A+# IF'Z=0 ; \ A, C, Z ARE CHANGED. : IF'R=# SWAP R>A -A+# IF'Z=1 ; : IF'R<=# SWAP R>A -A+# IF'C=0 ; : IF'R=<# IF'R<=# ; : IF'R># SWAP R>A -A+# IF'C=1 ; \ IF'R>=# SWAP ; : IF'R=># IF'R>=# ; \ IF'R<# SWAP ; : UNTIL'R<>R R>A -A+R UNTIL'Z=0 ; \ A, C, Z ARE CHANGED. : UNTIL'R=R R>A -A+R UNTIL'Z=1 ; : UNTIL'R<=R R>A -A+R UNTIL'C=0 ; : UNTIL'R=R R>A -A+R UNTIL'C=1 ; \ UNTIL'R>=R ; : UNTIL'R=>R UNTIL'R>=R ; \ UNTIL'R# SWAP R>A -A+# UNTIL'Z=0 ; \ A, C, Z ARE CHANGED. : UNTIL'R=# SWAP R>A -A+# UNTIL'Z=1 ; : UNTIL'R<=# SWAP R>A -A+# UNTIL'C=0 ; : UNTIL'R=<# UNTIL'R<=# ; : UNTIL'R># SWAP R>A -A+# UNTIL'C=1 ; \ UNTIL'R>=# SWAP ; : UNTIL'R=># UNTIL'R>=# ; \ UNTIL'R<# SWAP ; : WHILE'R<>R R>A -A+R WHILE'Z=0 ; \ A, C, Z ARE CHANGED. : WHILE'R=R R>A -A+R WHILE'Z=1 ; : WHILE'R<=R R>A -A+R WHILE'C=0 ; : WHILE'R=R R>A -A+R WHILE'C=1 ; \ WHILE'R>=R ; : WHILE'R=>R WHILE'R>=R ; \ WHILE'R# SWAP R>A -A+# WHILE'Z=0 ; \ A, C, Z ARE CHANGED. : WHILE'R=# SWAP R>A -A+# WHILE'Z=1 ; : WHILE'R<=# SWAP R>A -A+# WHILE'C=0 ; : WHILE'R=<# WHILE'R<=# ; : WHILE'R># SWAP R>A -A+# WHILE'C=1 ; \ WHILE'R>=# SWAP ; : WHILE'R=># WHILE'R>=# ; \ WHILE'R<# SWAP ; \ COMMENT; \ ======================================================= \ DISASSEMBLER FOR 16F87X \ ======================================================= \ VARIABLE LIMIT.LENGTH$ 20 LIMIT.LENGTH$ ! : (."L) ((")) COUNT LIMIT.LENGTH$ @ MIN TYPE ; : ."L COMPILE (."L) ," ; IMMEDIATE : .R" ( N R ... ) SWAP DUP 0A 0F BETWEEN IF 30 EMIT 1 .R DROP ELSE SWAP .R THEN ; : 14C.GROUP ( N ... ) CASE 0 OF 8 SPACES ."L NOP \ NOP " ENDOF 8 OF 8 SPACES ."L RET \ RETURN " ENDOF 9 OF 8 SPACES ."L RETI \ RETFIE " ENDOF 63 OF 8 SPACES ."L SLEEP \ SLEEP " ENDOF 64 OF 8 SPACES ."L WDT=0 \ CLRWDT " ENDOF 100 OF 8 SPACES ."L A=0 \ CLRW " ENDOF ENDCASE ; : 14C.GROUP ( N ... ) CASE 0 OF 8 SPACES ."L NOP \ NOP " ENDOF 8 OF 8 SPACES ."L RET \ RETURN " ENDOF 9 OF 8 SPACES ."L RETI \ RETFIE " ENDOF 63 OF 8 SPACES ."L SLEEP \ SLEEP " ENDOF 64 OF 8 SPACES ."L WDT=0 \ CLRWDT " ENDOF 100 OF 8 SPACES ."L A=0 \ CLRW " ENDOF ENDCASE ; : R,D ( N ... ) 4 SPACES 7F AND 2 .R" 2 SPACES ; : F,D ( N ... ) 2 SPACES 7F AND . ; : 6C1D7R.GROUP.1 ( N ... ) DUP 782 = IF 8 SPACES DROP ."L JMP>A+PC \ 2 ADDWF_W,1 " EXIT THEN DUP 3F80 AND CASE 700 OF R,D ."L A+R \ ADDWF_W,0 " ENDOF 780 OF R,D ."L R+A \ ADDWF_W,1 " ENDOF 500 OF R,D ."L AnR \ ANDWF_W,0 " ENDOF 508 OF R,D ."L RnA \ ANDWF_W,1 " ENDOF 180 OF R,D ."L R=0 \ CLRF " ENDOF DROP ENDCASE ; : 6C1D7R.GROUP.2 ( N ... ) DUP 3F80 AND CASE 900 OF R,D ."L /R>A \ COMF_F,0 " ENDOF 980 OF R,D ."L /R \ COMF_F,1 " ENDOF 0300 OF R,D ."L R-1>A \ DECF_F,0 " ENDOF 0380 OF R,D ."L R- \ DECF_F,1 " ENDOF 0B00 OF R,D ."L R-1=0?>A \ DECFSZ_F,0 " ENDOF DROP ENDCASE ; : 6C1D7R.GROUP.3 ( N ... ) DUP 3F80 AND CASE 0B80 OF R,D ."L R-1=0? \ DECFSZ_F,1 " ENDOF 0A00 OF R,D ."L R+1>A \ INCF_F,0 " ENDOF 0A80 OF R,D ."L R+ \ INCF_F,1 " ENDOF 0F00 OF R,D ."L R+1=0?>A \ INCFSZ_F,0 " ENDOF 0F80 OF R,D ."L R+1=0? \ INCFSZ_F,1 " ENDOF DROP ENDCASE ; : 6C1D7R.GROUP.4 ( N ... ) DUP 3F80 AND CASE 0400 OF R,D ."L AoR \ IORWF_F,0 " ENDOF 0480 OF R,D ."L RoA \ IORWF_F,1 " ENDOF 0800 OF R,D ."L R>A \ MOVF_F,0 " ENDOF 0880 OF R,D ."L R:0 \ MOVF_F,1 " ENDOF 0080 OF R,D ."L A>R \ MOVWF_F,0 " ENDOF DROP ENDCASE ; : 6C1D7R.GROUP.5 ( N ... ) DUP 3F80 AND CASE 0D00 OF R,D ."L RLCR>A \ RLF_F,0 " ENDOF 0D80 OF R,D ."L RLCR \ RLF_F,1 " ENDOF 0C00 OF R,D ."L RRCR>A \ RRF_F,0 " ENDOF 0C80 OF R,D ."L RRCR \ RRF_F,1 " ENDOF 0200 OF R,D ."L R-A>A \ SUBWF_F,0 " ENDOF DROP ENDCASE ; : 6C1D7R.GROUP.6 ( N ... ) DUP 3F80 AND CASE 0280 OF R,D ."L R-A \ SUBWF_F,1 " ENDOF 0E00 OF R,D ."L SWAPR>A \ SWAPF_F,0 " ENDOF 0E80 OF R,D ."L SWAPR \ SWAPF_F,1 " ENDOF 0600 OF R,D ."L AxR \ XORWF_F,0 " ENDOF 0680 OF R,D ."L RxA \ XORWF_F,1 " ENDOF DROP ENDCASE ; : R,B ( N ... ) 3FF AND 80 /MOD SWAP 2 .R" 3 SPACES . SPACE ; : 4C3B7R.GROUP ( N ... ) DUP 3C00 AND CASE 1000 OF R,B ."L RB=0 \ BCF_F,B " ENDOF 1400 OF R,B ."L RB=1 \ BCF_F,B " ENDOF 1800 OF R,B ."L RB=0? \ BTFSC_F,B " ENDOF 1C00 OF R,B ."L RB=1? \ BTFSS_F,B " ENDOF DROP ENDCASE ; : 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 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 \ R@ 10 + @ [ ' RB=0 ] LITERAL = AND IF R@ 0C + @ CFA>n \ IF R@ 8 + @ = IF R> >NAME -1 \ ELSE R> DROP 0 \ THEN ELSE R> DROP 0 THEN ELSE R> DROP 0 THEN ; : 3_0_RB=0...C=0 ( R B CFA ... NFA -1 / 0 ) >R R@ @ 60 = R@ 4 + @ [ ' lit ] LITERAL = AND \ R@ 10 + @ [ ' RB=0 ] LITERAL = AND IF R@ 0C + @ CFA>n IF ROT R@ 8 + @ = >R = R> AND IF R> >NAME -1 ELSE R> DROP 0 THEN ELSE 2DROP R> DROP 0 THEN ELSE 2DROP R> DROP 0 THEN ; VARIABLE LIT? : 3_0_RB=0...C=0 ( R B CFA ... NFA -1 / 0 ) >R \ R@ @ 60 = R@ 4 + @ [ ' lit ] LITERAL = IF 0 LIT? ! -1 ELSE R@ 4 + @ CFA>n IF 4 LIT? ! -1 ELSE 0 LIT? ! 0 THEN THEN \ R@ 10 + @ [ ' RB=0 ] LITERAL = AND IF R@ 0C + LIT? @ - @ CFA>n IF ROT R@ 8 + LIT? @ - @ = >R = R> AND IF R> >NAME -1 ELSE R> DROP 0 THEN ELSE 2DROP R> DROP 0 THEN ELSE 2DROP R> DROP 0 THEN ; : 3_0_RB=0...C=0 ( R B CFA ... NFA -1 / 0 ) >R \ R@ @ 60 = R@ 4 + @ [ ' lit ] LITERAL = IF 0 LIT? ! -1 ELSE R@ 4 + @ CFA>n IF 4 LIT? ! -1 ELSE 0 LIT? ! 0 THEN THEN \ R@ 10 + @ [ ' RB=0 ] LITERAL = AND IF R@ 0C + LIT? @ - @ CFA>n \ IF ROT R@ 8 + LIT? @ - @ = >R = R> AND IF ROT LIT? @ 0= IF R@ 8 + @ = >R = R> AND ELSE R@ CFA>n IF = >R = R> AND ELSE 2DROP 0 THEN THEN IF R> >NAME -1 ELSE R> DROP 0 THEN ELSE 2DROP R> DROP 0 THEN ELSE 2DROP R> DROP 0 THEN ; : XX 3_0_RB=0...C=0 ( R B CFA ... NFA -1 / 0 ) ; VARIABLE COUNTER VARIABLE DISASSEM.ADDR VARIABLE SPECIAL.RB=X? -1 SPECIAL.RB=X? ! : CHECK.IF.SPECIAL.RB=X ( R B CFA ... NFA -1 / 0 ) 0 COUNTER ! LAST @ NAME> >R BEGIN 2DUP R@ 3_0_RB=0...C=0 IF R> DROP -1 -1 ELSE R> n>LINK @ NAME> >R COUNTER @ 200 > IF 0 -1 ELSE 0 THEN THEN 1 COUNTER +! UNTIL R> DROP 0 COUNTER ! ; : 4C3B7R.GROUP ( N ... ) DUP 3C00 AND CASE 1000 OF SPECIAL.RB=X? @ IF DUP >R CASE 1003 OF ." C=0 " ENDOF 1103 OF ." Z=0 " ENDOF R@ R,B ."L RB=0 \ BCF_F,B " ENDCASE R> DROP \ ELSE R,B ."L RB=0 \ BCF_F,B " ELSE R,B 2DUP CHECK.IF.SPECIAL.RB=X IF .ID ELSE ."L RB=0 \ BCF_F,B " THEN THEN ENDOF 1400 OF SPECIAL.RB=X? @ IF DUP >R CASE 1403 OF ." C=1 " ENDOF 1503 OF ." Z=1 " ENDOF R@ R,B ."L RB=1 \ BSF_F,B " ENDCASE R> DROP ELSE R,B ."L RB=1 \ BSF_F,B " THEN ENDOF 1800 OF R,B ."L RB=0? \ BTFSC_F,B " ENDOF 1C00 OF R,B ."L RB=1? \ BTFSS_F,B " ENDOF DROP ENDCASE ; : 4C3B7R.GROUP ( N ... ) DUP 3C00 AND CASE 1000 OF SPECIAL.RB=X? @ IF DUP >R CASE 1003 OF ." C=0 " ENDOF 1103 OF ." Z=0 " ENDOF R@ R,B ."L RB=0 \ BCF_F,B " ENDCASE R> DROP ELSE R,B ."L RB=0 \ BCF_F,B " THEN ENDOF 1400 OF SPECIAL.RB=X? @ IF DUP >R CASE 1403 OF ." C=1 " ENDOF 1503 OF ." Z=1 " ENDOF R@ R,B ."L RB=1 \ BSF_F,B " ENDCASE R> DROP ELSE R,B ."L RB=1 \ BSF_F,B " THEN ENDOF 1800 OF R,B ."L RB=0? \ BTFSC_F,B " ENDOF 1C00 OF R,B ."L RB=1? \ BTFSS_F,B " ENDOF DROP ENDCASE ; : 8# ( N ... ) 4 SPACES 0FF AND 2 .R" 2 SPACES ; : 8#' ( N ... ) 0FF AND . ; : 11# ( N ... ) 2 SPACES 7FF AND 4 .R 2 SPACES ; : 11#' ( N ... ) 7FF AND . ; : 6C8#.GROUP ( N ... ) DUP 3F00 AND CASE 3900 OF 8# ."L An# \ ANDLW " ENDOF 3800 OF 8# ."L Ao# \ IORLW " ENDOF 3A00 OF 8# ."L Ax# \ XORLW " ENDOF DROP ENDCASE ; : 5C1X8#.GROUP ( N ... ) DUP 3E00 AND CASE 3E00 OF 8# ."L A+# \ ADDLW " ENDOF 3C00 OF 8# ."L #-A \ SUBLW " ENDOF DROP ENDCASE ; : 4C2X8#.GROUP ( N ... ) DUP 3C00 AND CASE 3000 OF 8# ."L #>A \ MOVLW " ENDOF 3400 OF 8# ."L #>ARET \ RETLW " ENDOF DROP ENDCASE ; DEFER _NFA? \ : NAME.CALL DUP 7FF AND _NFA? IF .ID SPACE DROP ELSE 11# THEN ; : NAME.CALL DUP 7FF AND _NFA? IF .ID SPACE DROP ELSE 7FF AND DISASSEM.ADDR @ - ( 8 EMIT ) ." $ " DUP ABS 4 U.R 0> IF ." + " ELSE ." - " THEN ."L CALL " THEN ; : NAME.JMP DUP 7FF AND _NFA? IF .ID SPACE DROP ELSE 7FF AND DISASSEM.ADDR @ - ( 8 EMIT ) ." $ " DUP ABS 4 U.R 0> IF ." + " ELSE ." - " THEN ."L JMP \ GOTO " THEN ; : NAME.JMP DUP 7FF AND _NFA? IF .ID SPACE DROP ELSE 7FF AND >R R@ DISASSEM.ADDR @ - ( 8 EMIT ) DUP ABS 0FF < IF ." $ " DUP ABS 2 U.R 0> IF ." + " ELSE ." - " THEN R> DROP ELSE DROP R> 4 U.R SPACE THEN ."L JMP \ GOTO " THEN ; : 3C11#.GROUP ( N ... ) DUP 3800 AND CASE 2000 OF SHOW.NAME? @ IF 8 SPACES NAME.CALL ELSE 11# ."L CALL \ CALL " THEN ENDOF 2800 OF SHOW.NAME? @ IF ( 8 SPACES ) NAME.JMP ELSE 11# ."L JMP \ GOTO " THEN ENDOF DROP ENDCASE ; VARIABLE (ADDR..DATA)? -1 (ADDR..DATA)? ! DEFER SCAN.QUEUE VARIABLE SCAN.QUEUE? -1 SCAN.QUEUE? ! \ : DISASSEM....... ( ADDR' ... ADDR'+1 ) DUP DISASSEM.ADDR ! \ SCAN.QUEUE? @ \ IF SCAN.QUEUE \ ELSE 0 \ THEN 0= \ IF ( DUP DISASSEM.ADDR ! ) BASE @ >R HEX >R \ (ADDR..DATA)? @ \ IF 28 EMIT SPACE R@ .XXXX 2 SPACES \ R@ @' .XXXX SPACE 29 EMIT 7 SPACES \ ELSE 15 SPACES \ THEN R@ @' \ DUP 14C.GROUP \ DUP 4C3B7R.GROUP \ DUP 6C1D7R.GROUP.1 \ DUP 6C1D7R.GROUP.2 \ DUP 6C1D7R.GROUP.3 \ DUP 6C1D7R.GROUP.4 \ DUP 6C1D7R.GROUP.5 \ DUP 6C1D7R.GROUP.6 \ DUP 6C8#.GROUP \ DUP 5C1X8#.GROUP \ DUP 4C2X8#.GROUP \ 3C11#.GROUP \ R> 1+ R> BASE ! \ THEN ; DEFER UNASSEMBLE(pic.") -1 UNASSEMBLE(pic.")? ! \ : DISASSEM" ( ADDR' ... ADDR'+1 ) >R R@ @' \ DUP 14C.GROUP \ DUP 4C3B7R.GROUP \ DUP 6C1D7R.GROUP.1 \ DUP 6C1D7R.GROUP.2 \ DUP 6C1D7R.GROUP.3 \ DUP 6C1D7R.GROUP.4 \ DUP 6C1D7R.GROUP.5 \ DUP 6C1D7R.GROUP.6 \ DUP 6C8#.GROUP \ DUP 5C1X8#.GROUP \ DUP 4C2X8#.GROUP \ 3C11#.GROUP R> 1+ ; VARIABLE SEPERATION 16 SEPERATION ! : SEP SEPERATION ! ; : DISASSEM" ( ADDR' ... ADDR'+1 ) DUP DISASSEM.ADDR ! >R UNASSEMBLE(pic.")? @ IF R@ UNASSEMBLE(pic.") ELSE 0 THEN IF R> DROP ELSE SEPERATION @ SPACES R@ @' DUP 14C.GROUP DUP 4C3B7R.GROUP DUP 6C1D7R.GROUP.1 DUP 6C1D7R.GROUP.2 DUP 6C1D7R.GROUP.3 DUP 6C1D7R.GROUP.4 DUP 6C1D7R.GROUP.5 DUP 6C1D7R.GROUP.6 DUP 6C8#.GROUP DUP 5C1X8#.GROUP DUP 4C2X8#.GROUP 3C11#.GROUP R> 1+ THEN ; ' DISASSEM" IS DISASSEM"" \ : DISASSEM ( ADDR' ... ADDR'+1 ) SCAN.QUEUE? @ \ IF SCAN.QUEUE \ ELSE 0 \ THEN \ IF \ ELSE \ DUP DISASSEM.ADDR ! BASE @ >R HEX >R \ (ADDR..DATA)? @ \ IF 28 EMIT SPACE R@ .XXXX 2 SPACES \ R@ @' .XXXX SPACE 29 EMIT 7 SPACES \ ELSE 15 SPACES \ THEN R> DISASSEM" R> BASE ! \ THEN ; : DISASSEM ( ADDR' ... ADDR'+1 ) DUP DISASSEM.ADDR ! SCAN.QUEUE? @ IF SCAN.QUEUE ELSE 0 THEN 0= IF ( DUP DISASSEM.ADDR ! ) BASE @ >R HEX >R (ADDR..DATA)? @ IF 28 EMIT SPACE R@ .XXXX 2 SPACES R@ @' .XXXX SPACE 29 EMIT 7 SPACES ELSE 15 SPACES THEN R> DISASSEM" R> BASE ! THEN ; VARIABLE LAST.U VARIABLE LIST.N.LINE 16 LIST.N.LINE ! : LNL LIST.N.LINE ! ; COMMENT: VARIABLE DISPLAY.OLD.MNEMONIC? -1 DISPLAY.OLD.MNEMONIC? ! : GO' SHOW.BREAK.POINT(S)/RANGE DISPLAY.OLD.MNEMONIC? @ >R 0 DISPLAY.OLD.MNEMONIC? ! (GO') R> DISPLAY.OLD.MNEMONIC? ! ; : CONTINUE ( ... ) (PC') (GO) ; : CONTINUE' ( ... ) (PC') (GO') ; : CON' CONTINUE' ; \ CON CONTINUE ; : CON DISPLAY.OLD.MNEMONIC? @ >R 0 DISPLAY.OLD.MNEMONIC? ! CONTINUE R> DISPLAY.OLD.MNEMONIC? ! ; \ : DOM DISPLAY.OLD.MNEMONIC? @ -1 XOR \ DISPLAY.OLD.MNEMONIC? ! LAST.U @ U DROP ; COMMENT; DEFER _T:? : (U) ( ADDR1' ... ADDR2' ) 8 EMIT ( BS ) DUP LAST.U ! LIST.N.LINE @ 0 DO DUP _NFA? KEY? IF KEY DUP 1B = SWAP 0D = OR IF DROP DEPTH 1 U> IF 2DUP - ABS 10 U> IF DROP THEN THEN LEAVE THEN THEN IF DUP 12345 NAME> >NAME <> \ MAKE SURE IT IS NAME. IF DUP _T:? IF CR 0F SPACES ." T: " .ID ELSE DROP THEN ELSE DROP THEN THEN CR DISASSEM LOOP ; : 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 \ : length OVER 100 /MOD .XX+SUM .XX+SUM \ addrH addrL 0 .XX \ record BOUNDS DO I C@' .XX+SUM \ data data ... LOOP ELSE DROP THEN 100 SUM C@ - 0FF AND .XX ; \ sum : >HEX' ( FROM LENGTH ... ) 2* CLS 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 QUIT ; : HEX> ( ... ) 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 QUIT ; \ ===================================================== \ 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' 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 ; : SWAPR>A' R.OFFSET + SWAPR>A ; : 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:? \ *************************************************************************** \ 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 THE TWO OPERANDS ON THE 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 ( ... ) "?" @ \ 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 0 ; 2DROP ; : 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 0 ; 2DROP ; : 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 CR ." *** 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'