FORTH
* (c) Copyright PPC Paris 1986
        TITLE  **** DEBOGUEUR EN FORTH ****
MLFFLG  EQU    #2F870
TRFMBF  EQU    #2F8C5
CSRC5   EQU    #1B41B
CSLC5   EQU    #1B435
oONERR  EQU    #2FBB6
oERR?   EQU    #2FBBB
DSTKAD  EQU    #2FAFD
ACTIVE  EQU    #2FB0C
oFLD    EQU    #2FB7F
oR0     EQU    #2FB16
oBASIC  EQU    #2FBA2
SVSTAT  EQU    #E47C7
GTSTAT  EQU    #E1BA5
NEXT00  EQU    #E71DD
DSPCHC  EQU    #01C3C

        WORD   'DEBOG'
        AD0EX
        D0=(5) #2F9DF
        LC(2)  #D8
        DAT0=C B
        D0=D0+ 2
        LC(5)  CNTRL
        DAT0=C A
        D0=A
        RTNCC

**********
STOD1   C=DAT1 W
        D1=D1+ 16
STO     DAT0=C W
        D0=D0+ 16
        RTN
STO5D1  C=DAT1 A
        D1=D1+ 5
        DAT0=C A
        D0=D0+ 5
        RTN
        STITLE **** ASSEMBLEUR > FORTH ****
CNTRL   R4=C
        CSLC
        CSLC
        CSLC
        CSLC
        CSLC
        CD0EX
        D0=(5) REG
        DAT0=C A        D0
        C=0    B
        GONC   CNT10
        C=C+1  B
CNT10   D0=D0+ 5
        CD1EX
        DAT0=C A        D1
        D0=D0+ 5
        CD1EX
        DAT0=C 1        Cy
        D0=D0+ 1
        C=P    15
        DAT0=C S        P
        D0=D0+ 1
        C=0    S
        C=C-1  S
        DAT0=C S        F si Hex, 9 si DÅc
        D0=D0+ 1
        C=ST
        DAT0=C 3        ST
        D0=D0+ 3
        C=0    A
        P=     7
        ?ST=0  15
        GOYES  CNT41
        C+P+1
CNT41   P=     3
        ?ST=0  14
        GOYES  CNT42
        C+P+1
CNT42   P=     1
        ?ST=0  13
        GOYES  CNT43
        C+P+1
CNT43   P=     0
        ?ST=0  12
        GOYES  CNT44
        C+P+1
CNT44   DAT0=C 1        PST (Prog. STatus: S15 È S12)
        D0=D0+ 1
        C=0    A
        ?XM=0
        GOYES  CNT20
        C+P+1
CNT20   P=     1
        ?SB=0
        GOYES  CNT21
        C+P+1
CNT21   P=     3
        ?SR=0
        GOYES  CNT22
        C+P+1
CNT22   P=     7
        ?MP=0
        GOYES  CNT30
        C+P+1
CNT30   DAT0=C 1        HST (MP,SR,SB,XM)    (Poids fort - Poids faible)
        D0=D0+ 1
CNT40   C=RSTK
        DAT0=C A        RSTK
        D0=D0+ 5
        P=P-1
        GONC   CNT40
        GOSBVL CSRC5
        RSTK=C
        C=A    W
        GOSUB  STO      A
        C=B    W
        GOSUB  STO      B
        C=R4
        C=RSTK
        GOSUB  STO      C
        C=D    W
        GOSUB  STO      D
        C=R0
        GOSUB  STO      R0
        C=R1
        GOSUB  STO      R1
        C=R2
        GOSUB  STO      R2
        C=R3
        GOSUB  STO      R3
        D1=(5) 1+(MLFFLG)   Une autre facon de dire STMTR0...
        GOSUB  STOD1
        GOSUB  STOD1
        GOSUB  STO5D1
        GOSUB  STO5D1
        GOSUB  STOD1
        GOSUB  STOD1
        GOSUB  STO5D1
        GOSUB  STO5D1
*
* Maintenant, nous rendons le contrÂle È l'interprÅteur FORTH
*
        SETHEX
        P=     0
        D0=(5) oONERR
        C=0    A
        DAT0=C A
        D0=(5) oERR?
        DAT0=C A
        D0=(5) DSTKAD
        C=DAT0 A
        D1=C
        D0=(5) oR0
        C=DAT0 A
        R3=C
        D0=(5) ACTIVE
        A=DAT0 A
        C=0    A
        C=C+1  A
        DAT0=C A
        D0=(5) oFLD
        DAT0=A A
        ?A#0   A
        GOYES  DEJA
        GOSBVL SVSTAT
DEJA    D0=(5) oBASIC
        C=0    A
        DAT0=C A
        C=R3
        B=C    A
        GOSUB  SETI
PINIT   BSS    5        CFA du mot "COEUR" (Coeur du debogueur)
SETI    C=RSTK
        CD0EX
        GOVLNG NEXT00

        STITLE **** FORTH > ASSEMBLEUR ****
        WORD   'RETOUR'
        CD1EX
        D1=(5) DSTKAD
        DAT1=C A
        D0=(5) oFLD
        C=DAT0 A
        D0=(5) ACTIVE
        DAT0=C A
        ?C#0   A
        GOYES  DEJA2
        GOSBVL GTSTAT
DEJA2   D0=(5) HST
        C=DAT0 1
        GOSUB  XM=1
        SB=0
        CSRB
        ?SB=0  
        GOYES  RET05
        XM=0
RET05   D0=(5) REGFIN
        D1=(5) TRFMBF
        GOSUB  RCL5D1
        GOSUB  RCL5D1
        GOSUB  RCLD1
        GOSUB  RCLD1
        GOSUB  RCL5D1
        GOSUB  RCL5D1
        GOSUB  RCLD1
        GOSUB  RCLD1
        GOSUB  RCL
        R3=C            R3
        GOSUB  RCL
        R2=C            R2
        GOSUB  RCL
        R1=C            R1
        GOSUB  RCL
        R0=C            R0
        GOSUB  RCL
        D=C    W        D
        D0=D0- 16
        GOSUB  RCL
        B=C    W        B
        GOSUB  RCL
        A=C    W        A
        P=     7
RET10   D0=D0- 5
        C=DAT0 A        RSTK
        RSTK=C
        P=P-1
        GONC   RET10
        D0=D0- 1        HST (MP,SR,SB,XM)
        C=DAT0 1
        CSRB
        SB=0
        CSRB            Maintenant, SB est restaurÅ
        SETHEX
        D0=D0- 1        PST (Program STatus: S15 È S12)
        C=DAT0 S
        C=C+C  S
        ST=0   15
        GONC   RET15
        ST=1   15
RET15   C=C+C  S
        ST=0   14
        GONC   RET14
        ST=1   14
RET14   C=C+C  S
        ST=0   13
        GONC   RET13
        ST=1   13
RET13   C=C+C  S
        ST=0   12
        GONC   RET12
        ST=1   12
RET12   D0=D0- 3
        C=DAT0 3        ST
        ST=C
        D0=D0- 1        Mode Hex ou DÅc
        C=DAT0 S
        C=C+1  S
        GOC    HEX      C valait #F
        SETDEC
HEX     D0=D0- 1        P
        C=DAT0 S
        P=C    15
        D0=D0- 1        Cy
        C=DAT0 S
        ?C#0   S
        GOYES  RET20
RET20   D0=(5) D1       D1
        C=DAT0 A
        D1=C
        D0=(5) D0       D0
        C=DAT0 A
        D0=(5) RET99
        DAT0=C A
        D0=(5) C
        C=DAT0 W
        NIBHEX 1B       D0=(5) #00000
RET99   BSS    5
        RTN
RCL     D0=D0- 16
        C=DAT0 W
XM=1    RTNSXM
RCLD1   GOSUB  RCL
        D1=D1- 16
        DAT1=C W
        RTN
RCL5D1  D0=D0- 5
        C=DAT0 A
        D1=D1- 5
        DAT1=C A
        RTN
        STITLE **** REGISTRES DU 1LF2  ****
REG
D0      BSS    5
D1      BSS    5
Cy      BSS    1
P       BSS    1
MODE    BSS    1
ST      BSS    3
PST     BSS    1
HST     BSS    1
PC      BSS    5
RSTK    BSS    5
        BSS    5
        BSS    5
        BSS    5
        BSS    5
        BSS    5
        BSS    5
A       BSS    16
B       BSS    16
C       BSS    16
D       BSS    16
R0      BSS    16
R1      BSS    16
R2      BSS    16
R3      BSS    16
SR0     BSS    16
SR1     BSS    16
SD0     BSS    5
SD1     BSS    5
FR0     BSS    16
FR1     BSS    16
FD0     BSS    5
FD1     BSS    5
REGFIN
        STITLE ****    UTILITAIRES     ****
        WORD   'PMUD'
        CD0EX
        RSTK=C
        C=B    A
        RSTK=C
        C=DAT1 A
        D1=D1+ 5
        A=DAT1 A
        D1=D1+ 5
        A=A+C  A
        A=A-1  A
        D0=A
        CD1EX
        RSTK=C
        CD1EX
        GONC   PMUD40   B.E.T.
PMUD10  RSTK=C
        A=0    B
        A=DAT0 1
        D0=D0- 1
        CD0EX
        RSTK=C
        LC(2)  9
        ?A>C   B
        GOYES  PMUD20
        LCASC  '0'
        GONC   PMUD30     B.E.T.
PMUD20  LC(2)  'A'-10
PMUD30  C=C+A  B
        GOSBVL DSPCHC
        C=RSTK
        D0=C
        C=RSTK
PMUD40  C=C-1  A
        GONC   PMUD10
        C=RSTK
        D1=C
        C=RSTK
        B=C    A
        C=RSTK
        D0=C
        RTNCC

        WORD   'DCST'   Debogger ConSTants
        RTNCC
        CON(5) PINIT
        CON(5) REG

        END