mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 16:30:57 +11:00
Compare commits
4 Commits
d0d92a4559
...
94166186eb
Author | SHA1 | Date | |
---|---|---|---|
|
94166186eb | ||
|
5b1ca474d4 | ||
|
d60ea4cb30 | ||
|
c3838714d5 |
@ -1,16 +1,26 @@
|
|||||||
: H HERE @ ;
|
: H HERE @ ;
|
||||||
: -^ SWAP - ;
|
: -^ SWAP - ;
|
||||||
: ? @ . ;
|
|
||||||
: +! SWAP OVER @ + SWAP ! ;
|
: +! SWAP OVER @ + SWAP ! ;
|
||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
|
||||||
: CONSTANT CREATE H ! DOES> @ ;
|
|
||||||
: , H ! 2 ALLOT ;
|
: , H ! 2 ALLOT ;
|
||||||
: C, H C! 1 ALLOT ;
|
: C, H C! 1 ALLOT ;
|
||||||
: IF ['] (fbr?) , H 0 C, ; IMMEDIATE
|
: IF ['] (fbr?) , H 1 ALLOT ; IMMEDIATE
|
||||||
: THEN DUP H -^ SWAP C! ; IMMEDIATE
|
: THEN DUP H -^ SWAP C! ; IMMEDIATE
|
||||||
: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE
|
: ELSE ['] (fbr) , 1 ALLOT DUP H -^ SWAP C! H 1 - ; IMMEDIATE
|
||||||
|
: RECURSE R> R> 2 - >R >R EXIT ;
|
||||||
|
: ( LIT@ ) WORD SCMP IF RECURSE THEN ; IMMEDIATE
|
||||||
|
( Hello, hello, krkrkrkr... do you hear me? )
|
||||||
|
( Ah, voice at last! Some lines above need comments )
|
||||||
|
( IF: write (fbr?) addr, push HERE, create cell )
|
||||||
|
( THEN: Subtract TOS from H to get offset to write to cell )
|
||||||
|
( in that same TOS's addr )
|
||||||
|
( ELSE: write (fbr) addr, allot, then same as THEN )
|
||||||
|
( RECURSE: RS TOS is for RECURSE itself, then we have to dig )
|
||||||
|
( one more level to get to RECURSE's parent's caller. )
|
||||||
: NOT IF 0 ELSE 1 THEN ;
|
: NOT IF 0 ELSE 1 THEN ;
|
||||||
|
: ? @ . ;
|
||||||
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
|
: CONSTANT CREATE H ! DOES> @ ;
|
||||||
: = CMP NOT ;
|
: = CMP NOT ;
|
||||||
: < CMP 0 1 - = ;
|
: < CMP 0 1 - = ;
|
||||||
: > CMP 1 = ;
|
: > CMP 1 = ;
|
||||||
|
@ -7,43 +7,64 @@
|
|||||||
;
|
;
|
||||||
; The code pointer point to "word routines". These routines expect to be called
|
; The code pointer point to "word routines". These routines expect to be called
|
||||||
; with IY pointing to the PF. They themselves are expected to end by jumping
|
; with IY pointing to the PF. They themselves are expected to end by jumping
|
||||||
; to the address at the top of the Return Stack. They will usually do so with
|
; to the address at (IP). They will usually do so with "jp next".
|
||||||
; "jp exit".
|
|
||||||
;
|
;
|
||||||
; That's for "regular" words (words that are part of the dict chain). There are
|
; That's for "regular" words (words that are part of the dict chain). There are
|
||||||
; also "special words", for example NUMBER, LIT, FBR, that have a slightly
|
; also "special words", for example NUMBER, LIT, FBR, that have a slightly
|
||||||
; different structure. They're also a pointer to an executable, but as for the
|
; different structure. They're also a pointer to an executable, but as for the
|
||||||
; other fields, the only one they have is the "flags" field.
|
; other fields, the only one they have is the "flags" field.
|
||||||
|
|
||||||
|
; This routine is jumped to at the end of every word. In it, we jump to current
|
||||||
|
; IP, but we also take care of increasing it my 2 before jumping
|
||||||
|
next:
|
||||||
|
; Before we continue: are stacks within bounds?
|
||||||
|
call chkPSRS
|
||||||
|
ld de, (IP)
|
||||||
|
ld h, d
|
||||||
|
ld l, e
|
||||||
|
inc de \ inc de
|
||||||
|
ld (IP), de
|
||||||
|
; HL is an atom list pointer. We need to go into it to have a wordref
|
||||||
|
ld e, (hl)
|
||||||
|
inc hl
|
||||||
|
ld d, (hl)
|
||||||
|
push de
|
||||||
|
jp EXECUTE+2
|
||||||
|
|
||||||
|
|
||||||
; Execute a word containing native code at its PF address (PFA)
|
; Execute a word containing native code at its PF address (PFA)
|
||||||
nativeWord:
|
nativeWord:
|
||||||
jp (iy)
|
jp (iy)
|
||||||
|
|
||||||
; Execute a list of atoms, which usually ends with EXIT.
|
; Execute a list of atoms, which always end with EXIT.
|
||||||
; IY points to that list.
|
; IY points to that list. What do we do:
|
||||||
|
; 1. Push current IP to RS
|
||||||
|
; 2. Set new IP to the second atom of the list
|
||||||
|
; 3. Execute the first atom of the list.
|
||||||
compiledWord:
|
compiledWord:
|
||||||
|
ld hl, (IP)
|
||||||
|
call pushRS
|
||||||
push iy \ pop hl
|
push iy \ pop hl
|
||||||
inc hl
|
inc hl
|
||||||
inc hl
|
inc hl
|
||||||
; HL points to next Interpreter pointer.
|
ld (IP), hl
|
||||||
call pushRS
|
; IY still is our atom reference...
|
||||||
ld l, (iy)
|
ld l, (iy)
|
||||||
ld h, (iy+1)
|
ld h, (iy+1)
|
||||||
push hl \ pop iy
|
push hl ; argument for EXECUTE
|
||||||
; IY points to code link
|
jp EXECUTE+2
|
||||||
jp executeCodeLink
|
|
||||||
|
|
||||||
; Pushes the PFA directly
|
; Pushes the PFA directly
|
||||||
cellWord:
|
cellWord:
|
||||||
push iy
|
push iy
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; Pushes the address in the first word of the PF
|
; Pushes the address in the first word of the PF
|
||||||
sysvarWord:
|
sysvarWord:
|
||||||
ld l, (iy)
|
ld l, (iy)
|
||||||
ld h, (iy+1)
|
ld h, (iy+1)
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; The word was spawned from a definition word that has a DOES>. PFA+2 (right
|
; The word was spawned from a definition word that has a DOES>. PFA+2 (right
|
||||||
; after the actual cell) is a link to the slot right after that DOES>.
|
; after the actual cell) is a link to the slot right after that DOES>.
|
||||||
@ -59,20 +80,16 @@ doesWord:
|
|||||||
; This is not a word, but a number literal. This works a bit differently than
|
; This is not a word, but a number literal. This works a bit differently than
|
||||||
; others: PF means nothing and the actual number is placed next to the
|
; others: PF means nothing and the actual number is placed next to the
|
||||||
; numberWord reference in the compiled word list. What we need to do to fetch
|
; numberWord reference in the compiled word list. What we need to do to fetch
|
||||||
; that number is to play with the Return stack: We pop it, read the number, push
|
; that number is to play with the IP.
|
||||||
; it to the Parameter stack and then push an increase Interpreter Pointer back
|
|
||||||
; to RS.
|
|
||||||
numberWord:
|
numberWord:
|
||||||
ld l, (ix)
|
ld hl, (IP) ; (HL) is out number
|
||||||
ld h, (ix+1)
|
|
||||||
ld e, (hl)
|
ld e, (hl)
|
||||||
inc hl
|
inc hl
|
||||||
ld d, (hl)
|
ld d, (hl)
|
||||||
inc hl
|
inc hl
|
||||||
ld (ix), l
|
ld (IP), hl ; advance IP by 2
|
||||||
ld (ix+1), h
|
|
||||||
push de
|
push de
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
.db 0b10 ; Flags
|
.db 0b10 ; Flags
|
||||||
NUMBER:
|
NUMBER:
|
||||||
@ -84,8 +101,7 @@ NUMBER:
|
|||||||
; context. Only words expecting those literals will look for them. This is why
|
; context. Only words expecting those literals will look for them. This is why
|
||||||
; the litWord triggers abort.
|
; the litWord triggers abort.
|
||||||
litWord:
|
litWord:
|
||||||
call popRS
|
ld hl, (IP)
|
||||||
call intoHL
|
|
||||||
call printstr ; let's print the word before abort.
|
call printstr ; let's print the word before abort.
|
||||||
ld hl, .msg
|
ld hl, .msg
|
||||||
call printstr
|
call printstr
|
||||||
@ -97,24 +113,17 @@ litWord:
|
|||||||
LIT:
|
LIT:
|
||||||
.dw litWord
|
.dw litWord
|
||||||
|
|
||||||
|
; Pop previous IP from Return stack and execute it.
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
.db ";"
|
.db "EXIT"
|
||||||
.fill 7
|
.fill 3
|
||||||
.dw 0
|
.dw 0
|
||||||
|
.db 0
|
||||||
EXIT:
|
EXIT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
; When we call the EXIT word, we have to do a "double exit" because our current
|
|
||||||
; Interpreter pointer is pointing to the word *next* to our EXIT reference when,
|
|
||||||
; in fact, we want to continue processing the one above it.
|
|
||||||
call popRS
|
call popRS
|
||||||
exit:
|
ld (IP), hl
|
||||||
; Before we continue: is SP within bounds?
|
jp next
|
||||||
call chkPS
|
|
||||||
; we're good
|
|
||||||
call popRS
|
|
||||||
; We have a pointer to a word
|
|
||||||
push hl \ pop iy
|
|
||||||
jp compiledWord
|
|
||||||
|
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
.db "QUIT"
|
.db "QUIT"
|
||||||
@ -133,9 +142,9 @@ quit:
|
|||||||
ABORT:
|
ABORT:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
abort:
|
abort:
|
||||||
; Reinitialize PS (RS is reinitialized in forthInterpret
|
; Reinitialize PS (RS is reinitialized in forthInterpret)
|
||||||
ld sp, (INITIAL_SP)
|
ld sp, (INITIAL_SP)
|
||||||
jp forthRdLine
|
jp forthRdLineNoOk
|
||||||
ABORTREF:
|
ABORTREF:
|
||||||
.dw ABORT
|
.dw ABORT
|
||||||
|
|
||||||
@ -163,7 +172,7 @@ EMIT:
|
|||||||
pop hl
|
pop hl
|
||||||
ld a, l
|
ld a, l
|
||||||
call stdioPutC
|
call stdioPutC
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( c port -- )
|
; ( c port -- )
|
||||||
.db "PC!"
|
.db "PC!"
|
||||||
@ -175,7 +184,7 @@ PSTORE:
|
|||||||
pop bc
|
pop bc
|
||||||
pop hl
|
pop hl
|
||||||
out (c), l
|
out (c), l
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( port -- c )
|
; ( port -- c )
|
||||||
.db "PC@"
|
.db "PC@"
|
||||||
@ -188,7 +197,7 @@ PFETCH:
|
|||||||
ld h, 0
|
ld h, 0
|
||||||
in l, (c)
|
in l, (c)
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( addr -- )
|
; ( addr -- )
|
||||||
.db "EXECUTE"
|
.db "EXECUTE"
|
||||||
@ -206,18 +215,24 @@ executeCodeLink:
|
|||||||
; IY points to PFA
|
; IY points to PFA
|
||||||
jp (hl) ; go!
|
jp (hl) ; go!
|
||||||
|
|
||||||
|
|
||||||
|
.db ";"
|
||||||
|
.fill 6
|
||||||
|
.dw EXECUTE
|
||||||
|
.db 0
|
||||||
|
ENDDEF:
|
||||||
|
.dw nativeWord
|
||||||
|
jp EXIT+2
|
||||||
|
|
||||||
.db ":"
|
.db ":"
|
||||||
.fill 6
|
.fill 6
|
||||||
.dw EXECUTE
|
.dw ENDDEF
|
||||||
.db 0
|
.db 0
|
||||||
DEFINE:
|
DEFINE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call entryhead
|
call entryhead
|
||||||
ld de, compiledWord
|
ld de, compiledWord
|
||||||
ld (hl), e
|
call DEinHL
|
||||||
inc hl
|
|
||||||
ld (hl), d
|
|
||||||
inc hl
|
|
||||||
; At this point, we've processed the name literal following the ':'.
|
; At this point, we've processed the name literal following the ':'.
|
||||||
; What's next? We have, in IP, a pointer to words that *have already
|
; What's next? We have, in IP, a pointer to words that *have already
|
||||||
; been compiled by INTERPRET*. All those bytes will be copied as-is.
|
; been compiled by INTERPRET*. All those bytes will be copied as-is.
|
||||||
@ -225,10 +240,12 @@ DEFINE:
|
|||||||
; skip compwords until EXIT is reached.
|
; skip compwords until EXIT is reached.
|
||||||
ex de, hl ; DE is our dest
|
ex de, hl ; DE is our dest
|
||||||
ld (HERE), de ; update HERE
|
ld (HERE), de ; update HERE
|
||||||
ld l, (ix)
|
ld hl, (IP)
|
||||||
ld h, (ix+1)
|
|
||||||
.loop:
|
.loop:
|
||||||
call HLPointsEXIT
|
push de ; --> lvl 1
|
||||||
|
ld de, ENDDEF
|
||||||
|
call HLPointsDE
|
||||||
|
pop de ; <-- lvl 1
|
||||||
jr z, .loopend
|
jr z, .loopend
|
||||||
call compSkip
|
call compSkip
|
||||||
jr .loop
|
jr .loop
|
||||||
@ -236,22 +253,19 @@ DEFINE:
|
|||||||
; skip EXIT
|
; skip EXIT
|
||||||
inc hl \ inc hl
|
inc hl \ inc hl
|
||||||
; We have out end offset. Let's get our offset
|
; We have out end offset. Let's get our offset
|
||||||
ld e, (ix)
|
ld de, (IP)
|
||||||
ld d, (ix+1)
|
|
||||||
or a ; clear carry
|
or a ; clear carry
|
||||||
sbc hl, de
|
sbc hl, de
|
||||||
; HL is our copy count.
|
; HL is our copy count.
|
||||||
ld b, h
|
ld b, h
|
||||||
ld c, l
|
ld c, l
|
||||||
ld l, (ix)
|
ld hl, (IP)
|
||||||
ld h, (ix+1)
|
|
||||||
ld de, (HERE) ; recall dest
|
ld de, (HERE) ; recall dest
|
||||||
; copy!
|
; copy!
|
||||||
ldir
|
ldir
|
||||||
ld (ix), l
|
ld (IP), hl
|
||||||
ld (ix+1), h
|
|
||||||
ld (HERE), de
|
ld (HERE), de
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.db "DOES>"
|
.db "DOES>"
|
||||||
@ -264,18 +278,16 @@ DOES:
|
|||||||
; need to do.
|
; need to do.
|
||||||
; 1. Change the code link to doesWord
|
; 1. Change the code link to doesWord
|
||||||
; 2. Leave 2 bytes for regular cell variable.
|
; 2. Leave 2 bytes for regular cell variable.
|
||||||
; 3. Get the Interpreter pointer from the stack and write this down to
|
; 3. Write down IP+2 to entry.
|
||||||
; entry PFA+2.
|
; 3. exit. we're done here.
|
||||||
; 3. exit. Because we've already popped RS, a regular exit will abort
|
|
||||||
; colon definition, so we're good.
|
|
||||||
ld iy, (CURRENT)
|
ld iy, (CURRENT)
|
||||||
ld hl, doesWord
|
ld hl, doesWord
|
||||||
call wrCompHL
|
call wrCompHL
|
||||||
inc iy \ inc iy ; cell variable space
|
inc iy \ inc iy ; cell variable space
|
||||||
call popRS
|
ld hl, (IP)
|
||||||
call wrCompHL
|
call wrCompHL
|
||||||
ld (HERE), iy
|
ld (HERE), iy
|
||||||
jp exit
|
jp EXIT+2
|
||||||
|
|
||||||
|
|
||||||
.db "IMMEDIA"
|
.db "IMMEDIA"
|
||||||
@ -286,7 +298,7 @@ IMMEDIATE:
|
|||||||
ld hl, (CURRENT)
|
ld hl, (CURRENT)
|
||||||
dec hl
|
dec hl
|
||||||
set FLAG_IMMED, (hl)
|
set FLAG_IMMED, (hl)
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( n -- )
|
; ( n -- )
|
||||||
.db "LITERAL"
|
.db "LITERAL"
|
||||||
@ -300,7 +312,7 @@ LITERAL:
|
|||||||
pop de ; number from stack
|
pop de ; number from stack
|
||||||
call DEinHL
|
call DEinHL
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
|
|
||||||
.db "'"
|
.db "'"
|
||||||
@ -313,7 +325,7 @@ APOS:
|
|||||||
call find
|
call find
|
||||||
jr nz, .notfound
|
jr nz, .notfound
|
||||||
push de
|
push de
|
||||||
jp exit
|
jp next
|
||||||
.notfound:
|
.notfound:
|
||||||
ld hl, .msg
|
ld hl, .msg
|
||||||
call printstr
|
call printstr
|
||||||
@ -337,7 +349,7 @@ APOSI:
|
|||||||
pop de ; <-- lvl 1
|
pop de ; <-- lvl 1
|
||||||
call DEinHL
|
call DEinHL
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
jp exit
|
jp next
|
||||||
.notfound:
|
.notfound:
|
||||||
ld hl, .msg
|
ld hl, .msg
|
||||||
call printstr
|
call printstr
|
||||||
@ -356,23 +368,33 @@ KEY:
|
|||||||
ld h, 0
|
ld h, 0
|
||||||
ld l, a
|
ld l, a
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
|
.db "WORD"
|
||||||
|
.fill 3
|
||||||
|
.dw KEY
|
||||||
|
.db 0
|
||||||
|
WORD:
|
||||||
|
.dw nativeWord
|
||||||
|
call readword
|
||||||
|
jp nz, abort
|
||||||
|
push hl
|
||||||
|
jp next
|
||||||
|
|
||||||
.db "CREATE"
|
.db "CREATE"
|
||||||
.fill 1
|
.fill 1
|
||||||
.dw KEY
|
.dw WORD
|
||||||
.db 0
|
.db 0
|
||||||
CREATE:
|
CREATE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call entryhead
|
call entryhead
|
||||||
jp nz, quit
|
|
||||||
ld de, cellWord
|
ld de, cellWord
|
||||||
ld (hl), e
|
ld (hl), e
|
||||||
inc hl
|
inc hl
|
||||||
ld (hl), d
|
ld (hl), d
|
||||||
inc hl
|
inc hl
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
.db "HERE"
|
.db "HERE"
|
||||||
.fill 3
|
.fill 3
|
||||||
@ -399,11 +421,11 @@ DOT:
|
|||||||
pop de
|
pop de
|
||||||
; We check PS explicitly because it doesn't look nice to spew gibberish
|
; We check PS explicitly because it doesn't look nice to spew gibberish
|
||||||
; before aborting the stack underflow.
|
; before aborting the stack underflow.
|
||||||
call chkPS
|
call chkPSRS
|
||||||
call pad
|
call pad
|
||||||
call fmtDecimalS
|
call fmtDecimalS
|
||||||
call printstr
|
call printstr
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( n a -- )
|
; ( n a -- )
|
||||||
.db "!"
|
.db "!"
|
||||||
@ -416,7 +438,7 @@ STORE:
|
|||||||
pop hl
|
pop hl
|
||||||
ld (iy), l
|
ld (iy), l
|
||||||
ld (iy+1), h
|
ld (iy+1), h
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( n a -- )
|
; ( n a -- )
|
||||||
.db "C!"
|
.db "C!"
|
||||||
@ -428,7 +450,7 @@ CSTORE:
|
|||||||
pop hl
|
pop hl
|
||||||
pop de
|
pop de
|
||||||
ld (hl), e
|
ld (hl), e
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a -- n )
|
; ( a -- n )
|
||||||
.db "@"
|
.db "@"
|
||||||
@ -440,7 +462,7 @@ FETCH:
|
|||||||
pop hl
|
pop hl
|
||||||
call intoHL
|
call intoHL
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a -- c )
|
; ( a -- c )
|
||||||
.db "C@"
|
.db "C@"
|
||||||
@ -453,9 +475,8 @@ CFETCH:
|
|||||||
ld l, (hl)
|
ld l, (hl)
|
||||||
ld h, 0
|
ld h, 0
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( -- a )
|
|
||||||
.db "LIT@"
|
.db "LIT@"
|
||||||
.fill 3
|
.fill 3
|
||||||
.dw CFETCH
|
.dw CFETCH
|
||||||
@ -464,7 +485,7 @@ LITFETCH:
|
|||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call readLITTOS
|
call readLITTOS
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b -- b a )
|
; ( a b -- b a )
|
||||||
.db "SWAP"
|
.db "SWAP"
|
||||||
@ -476,7 +497,7 @@ SWAP:
|
|||||||
pop hl
|
pop hl
|
||||||
ex (sp), hl
|
ex (sp), hl
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b c d -- c d a b )
|
; ( a b c d -- c d a b )
|
||||||
.db "2SWAP"
|
.db "2SWAP"
|
||||||
@ -493,7 +514,7 @@ SWAP2:
|
|||||||
push de ; D
|
push de ; D
|
||||||
push hl ; A
|
push hl ; A
|
||||||
push bc ; B
|
push bc ; B
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a -- a a )
|
; ( a -- a a )
|
||||||
.db "DUP"
|
.db "DUP"
|
||||||
@ -505,7 +526,7 @@ DUP:
|
|||||||
pop hl
|
pop hl
|
||||||
push hl
|
push hl
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b -- a b a b )
|
; ( a b -- a b a b )
|
||||||
.db "2DUP"
|
.db "2DUP"
|
||||||
@ -520,7 +541,7 @@ DUP2:
|
|||||||
push hl
|
push hl
|
||||||
push de
|
push de
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b -- a b a )
|
; ( a b -- a b a )
|
||||||
.db "OVER"
|
.db "OVER"
|
||||||
@ -534,7 +555,7 @@ OVER:
|
|||||||
push de
|
push de
|
||||||
push hl
|
push hl
|
||||||
push de
|
push de
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b c d -- a b c d a b )
|
; ( a b c d -- a b c d a b )
|
||||||
.db "2OVER"
|
.db "2OVER"
|
||||||
@ -553,12 +574,65 @@ OVER2:
|
|||||||
push hl ; D
|
push hl ; D
|
||||||
push iy ; A
|
push iy ; A
|
||||||
push bc ; B
|
push bc ; B
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
|
.db ">R"
|
||||||
|
.fill 5
|
||||||
|
.dw OVER2
|
||||||
|
.db 0
|
||||||
|
P2R:
|
||||||
|
.dw nativeWord
|
||||||
|
pop hl
|
||||||
|
call pushRS
|
||||||
|
jp next
|
||||||
|
|
||||||
|
.db "R>"
|
||||||
|
.fill 5
|
||||||
|
.dw P2R
|
||||||
|
.db 0
|
||||||
|
R2P:
|
||||||
|
.dw nativeWord
|
||||||
|
call popRS
|
||||||
|
push hl
|
||||||
|
jp next
|
||||||
|
|
||||||
|
.db "I"
|
||||||
|
.fill 6
|
||||||
|
.dw R2P
|
||||||
|
.db 0
|
||||||
|
I:
|
||||||
|
.dw nativeWord
|
||||||
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
|
push hl
|
||||||
|
jp next
|
||||||
|
|
||||||
|
.db "I'"
|
||||||
|
.fill 5
|
||||||
|
.dw I
|
||||||
|
.db 0
|
||||||
|
IPRIME:
|
||||||
|
.dw nativeWord
|
||||||
|
ld l, (ix-2)
|
||||||
|
ld h, (ix-1)
|
||||||
|
push hl
|
||||||
|
jp next
|
||||||
|
|
||||||
|
.db "J"
|
||||||
|
.fill 6
|
||||||
|
.dw IPRIME
|
||||||
|
.db 0
|
||||||
|
J:
|
||||||
|
.dw nativeWord
|
||||||
|
ld l, (ix-4)
|
||||||
|
ld h, (ix-3)
|
||||||
|
push hl
|
||||||
|
jp next
|
||||||
|
|
||||||
; ( a b -- c ) A + B
|
; ( a b -- c ) A + B
|
||||||
.db "+"
|
.db "+"
|
||||||
.fill 6
|
.fill 6
|
||||||
.dw OVER2
|
.dw J
|
||||||
.db 0
|
.db 0
|
||||||
PLUS:
|
PLUS:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -566,7 +640,7 @@ PLUS:
|
|||||||
pop de
|
pop de
|
||||||
add hl, de
|
add hl, de
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b -- c ) A - B
|
; ( a b -- c ) A - B
|
||||||
.db "-"
|
.db "-"
|
||||||
@ -580,7 +654,7 @@ MINUS:
|
|||||||
or a ; reset carry
|
or a ; reset carry
|
||||||
sbc hl, de
|
sbc hl, de
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b -- c ) A * B
|
; ( a b -- c ) A * B
|
||||||
.db "*"
|
.db "*"
|
||||||
@ -593,7 +667,7 @@ MULT:
|
|||||||
pop bc
|
pop bc
|
||||||
call multDEBC
|
call multDEBC
|
||||||
push hl
|
push hl
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a b -- c ) A / B
|
; ( a b -- c ) A / B
|
||||||
.db "/"
|
.db "/"
|
||||||
@ -606,7 +680,7 @@ DIV:
|
|||||||
pop hl
|
pop hl
|
||||||
call divide
|
call divide
|
||||||
push bc
|
push bc
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( a1 a2 -- b )
|
; ( a1 a2 -- b )
|
||||||
.db "SCMP"
|
.db "SCMP"
|
||||||
@ -620,7 +694,7 @@ SCMP:
|
|||||||
call strcmp
|
call strcmp
|
||||||
call flagsToBC
|
call flagsToBC
|
||||||
push bc
|
push bc
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; ( n1 n2 -- f )
|
; ( n1 n2 -- f )
|
||||||
.db "CMP"
|
.db "CMP"
|
||||||
@ -635,7 +709,7 @@ CMP:
|
|||||||
sbc hl, de
|
sbc hl, de
|
||||||
call flagsToBC
|
call flagsToBC
|
||||||
push bc
|
push bc
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
|
; This word's atom is followed by 1b *relative* offset (to the cell's addr) to
|
||||||
; where to branch to. For example, The branching cell of "IF THEN" would
|
; where to branch to. For example, The branching cell of "IF THEN" would
|
||||||
@ -647,14 +721,12 @@ CMP:
|
|||||||
FBR:
|
FBR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
push de
|
push de
|
||||||
ld l, (ix)
|
ld hl, (IP)
|
||||||
ld h, (ix+1)
|
|
||||||
ld a, (hl)
|
ld a, (hl)
|
||||||
call addHL
|
call addHL
|
||||||
ld (ix), l
|
ld (IP), hl
|
||||||
ld (ix+1), h
|
|
||||||
pop de
|
pop de
|
||||||
jp exit
|
jp next
|
||||||
|
|
||||||
; Conditional branch, only branch if TOS is zero
|
; Conditional branch, only branch if TOS is zero
|
||||||
.db "(fbr?)"
|
.db "(fbr?)"
|
||||||
@ -668,25 +740,11 @@ FBRC:
|
|||||||
or l
|
or l
|
||||||
jr z, FBR+2
|
jr z, FBR+2
|
||||||
; skip next byte in RS
|
; skip next byte in RS
|
||||||
ld l, (ix)
|
ld hl, (IP)
|
||||||
ld h, (ix+1)
|
|
||||||
inc hl
|
inc hl
|
||||||
ld (ix), l
|
ld (IP), hl
|
||||||
ld (ix+1), h
|
jp next
|
||||||
jp exit
|
|
||||||
|
|
||||||
|
|
||||||
.db "RECURSE"
|
|
||||||
.dw FBRC
|
|
||||||
.db 0
|
|
||||||
RECURSE:
|
|
||||||
.dw nativeWord
|
|
||||||
call popRS
|
|
||||||
ld l, (ix)
|
|
||||||
ld h, (ix+1)
|
|
||||||
dec hl \ dec hl
|
|
||||||
push hl \ pop iy
|
|
||||||
jp compiledWord
|
|
||||||
|
|
||||||
LATEST:
|
LATEST:
|
||||||
.dw RECURSE
|
.dw FBRC
|
||||||
|
|
||||||
|
@ -36,7 +36,9 @@ directly, but as part of another word.
|
|||||||
; R:I -- Exit a colon definition
|
; R:I -- Exit a colon definition
|
||||||
, n -- Write n in HERE and advance it.
|
, n -- Write n in HERE and advance it.
|
||||||
' x -- a Push addr of word x to a.
|
' x -- a Push addr of word x to a.
|
||||||
['] x -- *I* Like "'", but spits the addr as a number literal.
|
['] x -- *I* Like "'", but spits the addr as a number
|
||||||
|
literal.
|
||||||
|
( -- *I* Comment. Ignore rest of line until ")" is read.
|
||||||
ALLOT n -- Move HERE by n bytes
|
ALLOT n -- Move HERE by n bytes
|
||||||
C, b -- Write byte b in HERE and advance it.
|
C, b -- Write byte b in HERE and advance it.
|
||||||
CREATE x -- Create cell named x. Doesn't allocate a PF.
|
CREATE x -- Create cell named x. Doesn't allocate a PF.
|
||||||
@ -60,7 +62,7 @@ QUIT R:drop -- Return to interpreter promp immediately
|
|||||||
RECURSE R:I -- R:I-2 Run the current word again.
|
RECURSE R:I -- R:I-2 Run the current word again.
|
||||||
THEN I:a -- *I* Set branching cell at a.
|
THEN I:a -- *I* Set branching cell at a.
|
||||||
|
|
||||||
*** Stack ***
|
*** Parameter Stack ***
|
||||||
DUP a -- a a
|
DUP a -- a a
|
||||||
OVER a b -- a b a
|
OVER a b -- a b a
|
||||||
SWAP a b -- b a
|
SWAP a b -- b a
|
||||||
@ -68,6 +70,13 @@ SWAP a b -- b a
|
|||||||
2OVER a b c d -- a b c d a b
|
2OVER a b c d -- a b c d a b
|
||||||
2SWAP a b c d -- c d a b
|
2SWAP a b c d -- c d a b
|
||||||
|
|
||||||
|
*** Return Stack ***
|
||||||
|
>R n -- R:n Pops PS and push to RS
|
||||||
|
R> R:n -- n Pops RS and push to PS
|
||||||
|
I -- n Copy RS TOS to PS
|
||||||
|
I' -- n Copy RS second item to PS
|
||||||
|
J -- n Copy RS third item to PS
|
||||||
|
|
||||||
*** Memory ***
|
*** Memory ***
|
||||||
@ a -- n Set n to value at address a
|
@ a -- n Set n to value at address a
|
||||||
! n a -- Store n in address a
|
! n a -- Store n in address a
|
||||||
@ -75,7 +84,7 @@ SWAP a b -- b a
|
|||||||
+! n a -- Increase value of addr a by n
|
+! n a -- Increase value of addr a by n
|
||||||
C@ a -- c Set c to byte at address a
|
C@ a -- c Set c to byte at address a
|
||||||
C! c a -- Store byte c in address a
|
C! c a -- Store byte c in address a
|
||||||
CURRENT -- n Set n to wordref of last added entry.
|
CURRENT -- a Set a to wordref of last added entry.
|
||||||
HERE -- a Push HERE's address
|
HERE -- a Push HERE's address
|
||||||
H -- a HERE @
|
H -- a HERE @
|
||||||
|
|
||||||
@ -96,8 +105,8 @@ CMP n1 n2 -- n Compare n1 and n2 and set n to -1, 0, or 1.
|
|||||||
NOT f -- f Push the logical opposite of f
|
NOT f -- f Push the logical opposite of f
|
||||||
|
|
||||||
*** Strings ***
|
*** Strings ***
|
||||||
LIT@ x -- a Read folloing LIT and push its addr to a
|
LIT@ x -- a Read following LIT and push its addr to a
|
||||||
S= a1 a2 -- n Compare strings a1 and a2. See CMP
|
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
|
||||||
|
|
||||||
*** I/O ***
|
*** I/O ***
|
||||||
. n -- Print n in its decimal form
|
. n -- Print n in its decimal form
|
||||||
@ -105,4 +114,5 @@ EMIT c -- Spit char c to stdout
|
|||||||
KEY -- c Get char c from stdin
|
KEY -- c Get char c from stdin
|
||||||
PC! c a -- Spit c to port a
|
PC! c a -- Spit c to port a
|
||||||
PC@ a -- c Fetch c from port a
|
PC@ a -- c Fetch c from port a
|
||||||
|
WORD -- a Read one word from stdin and push its addr
|
||||||
|
|
||||||
|
@ -17,9 +17,15 @@
|
|||||||
|
|
||||||
; *** Variables ***
|
; *** Variables ***
|
||||||
.equ INITIAL_SP FORTH_RAMSTART
|
.equ INITIAL_SP FORTH_RAMSTART
|
||||||
|
; wordref of the last entry of the dict.
|
||||||
.equ CURRENT @+2
|
.equ CURRENT @+2
|
||||||
|
; Pointer to the next free byte in dict. During compilation of input text, this
|
||||||
|
; temporarily points to the next free byte in COMPBUF.
|
||||||
.equ HERE @+2
|
.equ HERE @+2
|
||||||
|
; Used to hold HERE while we temporarily point it to COMPBUF
|
||||||
.equ OLDHERE @+2
|
.equ OLDHERE @+2
|
||||||
|
; Interpreter pointer. See Execution model comment below.
|
||||||
|
.equ IP @+2
|
||||||
; Pointer to where we currently are in the interpretation of the current line.
|
; Pointer to where we currently are in the interpretation of the current line.
|
||||||
.equ INPUTPOS @+2
|
.equ INPUTPOS @+2
|
||||||
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
|
; Buffer where we compile the current input line. Same size as STDIO_BUFSIZE.
|
||||||
@ -59,6 +65,23 @@
|
|||||||
;
|
;
|
||||||
; During IMMEDIATE mode, (HERE) is temporarily set to COMPBUF, and when we're
|
; During IMMEDIATE mode, (HERE) is temporarily set to COMPBUF, and when we're
|
||||||
; done, we restore (HERE) for runtime. This way, everyone is happy.
|
; done, we restore (HERE) for runtime. This way, everyone is happy.
|
||||||
|
;
|
||||||
|
; EXECUTING A WORD
|
||||||
|
;
|
||||||
|
; At it's core, executing a word is having the wordref in IY and call
|
||||||
|
; executeCodeLink. Then, we let the word do its things. Some words are special,
|
||||||
|
; but most of them are of the compiledWord type, and that's their execution that
|
||||||
|
; we describe here.
|
||||||
|
;
|
||||||
|
; First of all, at all time during execution, the Interpreter Pointer (IP)
|
||||||
|
; points to the wordref we're executing next.
|
||||||
|
;
|
||||||
|
; When we execute a compiledWord, the first thing we do is push IP to the Return
|
||||||
|
; Stack (RS). Therefore, RS' top of stack will contain a wordref to execute
|
||||||
|
; next, after we EXIT.
|
||||||
|
;
|
||||||
|
; At the end of every compiledWord is an EXIT. This pops RS, sets IP to it, and
|
||||||
|
; continues.
|
||||||
|
|
||||||
; *** Code ***
|
; *** Code ***
|
||||||
forthMain:
|
forthMain:
|
||||||
@ -82,10 +105,14 @@ forthMain:
|
|||||||
forthRdLine:
|
forthRdLine:
|
||||||
ld hl, msgOk
|
ld hl, msgOk
|
||||||
call printstr
|
call printstr
|
||||||
|
forthRdLineNoOk:
|
||||||
call printcrlf
|
call printcrlf
|
||||||
call stdioReadLine
|
call stdioReadLine
|
||||||
ld ix, RS_ADDR-2 ; -2 because we inc-before-push
|
|
||||||
ld (INPUTPOS), hl
|
ld (INPUTPOS), hl
|
||||||
|
; Setup return stack. As a safety net, we set its bottom to ABORTREF.
|
||||||
|
ld hl, ABORTREF
|
||||||
|
ld (RS_ADDR), hl
|
||||||
|
ld ix, RS_ADDR
|
||||||
; We're about to compile the line and possibly execute IMMEDIATE words.
|
; We're about to compile the line and possibly execute IMMEDIATE words.
|
||||||
; Let's save current (HERE) and temporarily set it to COMPBUF.
|
; Let's save current (HERE) and temporarily set it to COMPBUF.
|
||||||
ld hl, (HERE)
|
ld hl, (HERE)
|
||||||
@ -128,11 +155,17 @@ forthInterpret:
|
|||||||
ld (HERE), de
|
ld (HERE), de
|
||||||
jr forthInterpret
|
jr forthInterpret
|
||||||
.immed:
|
.immed:
|
||||||
push hl ; --> lvl 1
|
; For this IMMEDIATE word to be compatible with regular execution model,
|
||||||
ld hl, .retRef
|
; it needs to be compiled as an atom list. We need a temporary space for
|
||||||
call pushRS
|
; this, let's use (OLDHERE) while it isn't used.
|
||||||
pop iy ; <-- lvl 1
|
ex de, hl ; atom to write in DE
|
||||||
jp executeCodeLink
|
ld hl, (OLDHERE)
|
||||||
|
call DEinHL
|
||||||
|
; Now, let's write the .retRef
|
||||||
|
ld de, .retRef
|
||||||
|
call DEinHL
|
||||||
|
ld iy, (OLDHERE)
|
||||||
|
jr .execIY
|
||||||
.execute:
|
.execute:
|
||||||
ld de, QUIT
|
ld de, QUIT
|
||||||
call .writeDE
|
call .writeDE
|
||||||
@ -140,23 +173,25 @@ forthInterpret:
|
|||||||
ld hl, (OLDHERE)
|
ld hl, (OLDHERE)
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
ld iy, COMPBUF
|
ld iy, COMPBUF
|
||||||
|
.execIY:
|
||||||
|
; before we execute, let's play with our RS a bit: compiledWord is
|
||||||
|
; going to push (IP) on the RS, but we don't expect our compiled words
|
||||||
|
; to ever return: it ends with QUIT. Let's set (IP) to ABORTREF and
|
||||||
|
; IX to RS_ADDR-2 so that compiledWord re-pushes our safety net.
|
||||||
|
ld hl, ABORTREF
|
||||||
|
ld (IP), hl
|
||||||
|
ld ix, RS_ADDR-2
|
||||||
jp compiledWord
|
jp compiledWord
|
||||||
.writeDE:
|
.writeDE:
|
||||||
push hl
|
push hl
|
||||||
ld hl, (HERE)
|
ld hl, (HERE)
|
||||||
ld (hl), e
|
call DEinHL
|
||||||
inc hl
|
|
||||||
ld (hl), d
|
|
||||||
inc hl
|
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
pop hl
|
pop hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
.retRef:
|
.retRef:
|
||||||
.dw $+2
|
.dw forthInterpret
|
||||||
.dw $+2
|
|
||||||
call popRS
|
|
||||||
jr forthInterpret
|
|
||||||
|
|
||||||
msgOk:
|
msgOk:
|
||||||
.db " ok", 0
|
.db " ok", 0
|
||||||
|
@ -36,8 +36,15 @@ skipRS:
|
|||||||
pop hl
|
pop hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Verifies that SP is within bounds. If it's not, call ABORT
|
; Verifies that SP and RS are within bounds. If it's not, call ABORT
|
||||||
chkPS:
|
chkPSRS:
|
||||||
|
push ix \ pop hl
|
||||||
|
push de ; --> lvl 1
|
||||||
|
ld de, RS_ADDR
|
||||||
|
or a ; clear carry
|
||||||
|
sbc hl, de
|
||||||
|
pop de ; <-- lvl 1
|
||||||
|
jr c, .underflow
|
||||||
ld hl, (INITIAL_SP)
|
ld hl, (INITIAL_SP)
|
||||||
; We have the return address for this very call on the stack. Let's
|
; We have the return address for this very call on the stack. Let's
|
||||||
; compensate
|
; compensate
|
||||||
@ -45,6 +52,7 @@ chkPS:
|
|||||||
or a ; clear carry
|
or a ; clear carry
|
||||||
sbc hl, sp
|
sbc hl, sp
|
||||||
ret nc ; (INITIAL_SP) >= SP? good
|
ret nc ; (INITIAL_SP) >= SP? good
|
||||||
|
.underflow:
|
||||||
; underflow
|
; underflow
|
||||||
ld hl, .msg
|
ld hl, .msg
|
||||||
call printstr
|
call printstr
|
||||||
|
@ -80,13 +80,6 @@ HLPointsBR:
|
|||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
HLPointsEXIT:
|
|
||||||
push de
|
|
||||||
ld de, EXIT
|
|
||||||
call HLPointsDE
|
|
||||||
pop de
|
|
||||||
ret
|
|
||||||
|
|
||||||
; Skip the compword where HL is currently pointing. If it's a regular word,
|
; Skip the compword where HL is currently pointing. If it's a regular word,
|
||||||
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
|
; it's easy: we inc by 2. If it's a NUMBER, we inc by 4. If it's a LIT, we skip
|
||||||
; to after null-termination.
|
; to after null-termination.
|
||||||
@ -202,20 +195,31 @@ readLIT:
|
|||||||
.db "word expected", 0
|
.db "word expected", 0
|
||||||
|
|
||||||
readLITBOS:
|
readLITBOS:
|
||||||
|
; Before we start: is our RS empty? If IX == RS_ADDR, it is (it only has
|
||||||
|
; its safety net). When that happens, we actually want to run readLITTOS
|
||||||
|
push hl
|
||||||
push de
|
push de
|
||||||
ld hl, (RS_ADDR)
|
push ix \ pop hl
|
||||||
|
ld de, RS_ADDR
|
||||||
|
or a ; clear carry
|
||||||
|
sbc hl, de
|
||||||
|
pop de
|
||||||
|
pop hl
|
||||||
|
jr z, readLITTOS
|
||||||
|
push de
|
||||||
|
; Our bottom-of-stack is RS_ADDR+2 because RS_ADDR is occupied by our
|
||||||
|
; ABORTREF safety net.
|
||||||
|
ld hl, (RS_ADDR+2)
|
||||||
call readLIT
|
call readLIT
|
||||||
ld (RS_ADDR), de
|
ld (RS_ADDR+2), de
|
||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
readLITTOS:
|
readLITTOS:
|
||||||
push de
|
push de
|
||||||
ld l, (ix)
|
ld hl, (IP)
|
||||||
ld h, (ix+1)
|
|
||||||
call readLIT
|
call readLIT
|
||||||
ld (ix), e
|
ld (IP), de
|
||||||
ld (ix+1), d
|
|
||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
@ -284,7 +288,6 @@ entryhead:
|
|||||||
inc hl
|
inc hl
|
||||||
ld (CURRENT), hl
|
ld (CURRENT), hl
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
xor a ; set Z
|
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Sets Z if wordref at HL is of the IMMEDIATE type
|
; Sets Z if wordref at HL is of the IMMEDIATE type
|
||||||
|
1
emul/.gitignore
vendored
1
emul/.gitignore
vendored
@ -1,5 +1,6 @@
|
|||||||
/shell/shell
|
/shell/shell
|
||||||
/forth/stage1
|
/forth/stage1
|
||||||
|
/forth/stage1dbg
|
||||||
/forth/forth
|
/forth/forth
|
||||||
/zasm/zasm
|
/zasm/zasm
|
||||||
/zasm/avra
|
/zasm/avra
|
||||||
|
@ -33,6 +33,9 @@ forth/forth0-bin.h: forth/forth0.bin
|
|||||||
forth/stage1: forth/stage1.c $(OBJS) forth/forth0-bin.h
|
forth/stage1: forth/stage1.c $(OBJS) forth/forth0-bin.h
|
||||||
$(CC) forth/stage1.c $(OBJS) -o $@
|
$(CC) forth/stage1.c $(OBJS) -o $@
|
||||||
|
|
||||||
|
forth/stage1dbg: forth/stage1.c $(OBJS) forth/forth0-bin.h
|
||||||
|
$(CC) -DDEBUG forth/stage1.c $(OBJS) -o $@
|
||||||
|
|
||||||
forth/core.bin: $(APPS)/forth/core.fth forth/stage1
|
forth/core.bin: $(APPS)/forth/core.fth forth/stage1
|
||||||
./forth/stage1 $(APPS)/forth/core.fth | tee $@ > /dev/null
|
./forth/stage1 $(APPS)/forth/core.fth | tee $@ > /dev/null
|
||||||
|
|
||||||
|
@ -20,6 +20,11 @@ directly follow executable's last byte so that we don't waste spce and also
|
|||||||
that wordref offsets correspond.
|
that wordref offsets correspond.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
// When DEBUG is set, stage1 is a core-less forth that works interactively.
|
||||||
|
// Useful for... debugging!
|
||||||
|
// By the way: there's a double-echo in stagedbg. It's normal. Don't panic.
|
||||||
|
|
||||||
|
//#define DEBUG
|
||||||
// in sync with glue.asm
|
// in sync with glue.asm
|
||||||
#define RAMSTART 0x900
|
#define RAMSTART 0x900
|
||||||
#define STDIO_PORT 0x00
|
#define STDIO_PORT 0x00
|
||||||
@ -44,11 +49,17 @@ static uint8_t iord_stdio()
|
|||||||
static void iowr_stdio(uint8_t val)
|
static void iowr_stdio(uint8_t val)
|
||||||
{
|
{
|
||||||
// we don't output stdout in stage0
|
// we don't output stdout in stage0
|
||||||
|
#ifdef DEBUG
|
||||||
|
// ... unless we're in DEBUG mode!
|
||||||
|
putchar(val);
|
||||||
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
int main(int argc, char *argv[])
|
int main(int argc, char *argv[])
|
||||||
{
|
{
|
||||||
bool tty = false;
|
#ifdef DEBUG
|
||||||
|
fp = stdin;
|
||||||
|
#else
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
fp = fopen(argv[1], "r");
|
fp = fopen(argv[1], "r");
|
||||||
if (fp == NULL) {
|
if (fp == NULL) {
|
||||||
@ -59,6 +70,7 @@ int main(int argc, char *argv[])
|
|||||||
fprintf(stderr, "Usage: ./stage0 filename\n");
|
fprintf(stderr, "Usage: ./stage0 filename\n");
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
Machine *m = emul_init();
|
Machine *m = emul_init();
|
||||||
m->ramstart = RAMSTART;
|
m->ramstart = RAMSTART;
|
||||||
m->iord[STDIO_PORT] = iord_stdio;
|
m->iord[STDIO_PORT] = iord_stdio;
|
||||||
@ -74,6 +86,7 @@ int main(int argc, char *argv[])
|
|||||||
|
|
||||||
fclose(fp);
|
fclose(fp);
|
||||||
|
|
||||||
|
#ifndef DEBUG
|
||||||
// We're done, now let's spit dict data
|
// We're done, now let's spit dict data
|
||||||
// let's start with LATEST spitting.
|
// let's start with LATEST spitting.
|
||||||
putchar(m->mem[CURRENT]);
|
putchar(m->mem[CURRENT]);
|
||||||
@ -82,6 +95,7 @@ int main(int argc, char *argv[])
|
|||||||
for (int i=sizeof(KERNEL); i<here; i++) {
|
for (int i=sizeof(KERNEL); i<here; i++) {
|
||||||
putchar(m->mem[i]);
|
putchar(m->mem[i]);
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user