mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-02 18:10:55 +11:00
Compare commits
No commits in common. "94166186ebeeb2692e83343617e7d6a5e969e34e" and "d0d92a45599aeb6cef7ceec1cbf73c3772260009" have entirely different histories.
94166186eb
...
d0d92a4559
@ -1,26 +1,16 @@
|
|||||||
: H HERE @ ;
|
: H HERE @ ;
|
||||||
: -^ SWAP - ;
|
: -^ SWAP - ;
|
||||||
|
: ? @ . ;
|
||||||
: +! SWAP OVER @ + SWAP ! ;
|
: +! SWAP OVER @ + SWAP ! ;
|
||||||
: ALLOT HERE +! ;
|
: ALLOT HERE +! ;
|
||||||
: , H ! 2 ALLOT ;
|
|
||||||
: C, H C! 1 ALLOT ;
|
|
||||||
: IF ['] (fbr?) , H 1 ALLOT ; IMMEDIATE
|
|
||||||
: THEN DUP H -^ SWAP C! ; 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 ;
|
|
||||||
: ? @ . ;
|
|
||||||
: VARIABLE CREATE 2 ALLOT ;
|
: VARIABLE CREATE 2 ALLOT ;
|
||||||
: CONSTANT CREATE H ! DOES> @ ;
|
: CONSTANT CREATE H ! DOES> @ ;
|
||||||
|
: , H ! 2 ALLOT ;
|
||||||
|
: C, H C! 1 ALLOT ;
|
||||||
|
: IF ['] (fbr?) , H 0 C, ; IMMEDIATE
|
||||||
|
: THEN DUP H -^ SWAP C! ; IMMEDIATE
|
||||||
|
: ELSE ['] (fbr) , 0 C, DUP H -^ SWAP C! H 1 - ; IMMEDIATE
|
||||||
|
: NOT IF 0 ELSE 1 THEN ;
|
||||||
: = CMP NOT ;
|
: = CMP NOT ;
|
||||||
: < CMP 0 1 - = ;
|
: < CMP 0 1 - = ;
|
||||||
: > CMP 1 = ;
|
: > CMP 1 = ;
|
||||||
|
@ -7,64 +7,43 @@
|
|||||||
;
|
;
|
||||||
; 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 (IP). They will usually do so with "jp next".
|
; to the address at the top of the Return Stack. They will usually do so with
|
||||||
|
; "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 always end with EXIT.
|
; Execute a list of atoms, which usually ends with EXIT.
|
||||||
; IY points to that list. What do we do:
|
; IY points to that list.
|
||||||
; 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
|
||||||
ld (IP), hl
|
; HL points to next Interpreter pointer.
|
||||||
; IY still is our atom reference...
|
call pushRS
|
||||||
ld l, (iy)
|
ld l, (iy)
|
||||||
ld h, (iy+1)
|
ld h, (iy+1)
|
||||||
push hl ; argument for EXECUTE
|
push hl \ pop iy
|
||||||
jp EXECUTE+2
|
; IY points to code link
|
||||||
|
jp executeCodeLink
|
||||||
|
|
||||||
; Pushes the PFA directly
|
; Pushes the PFA directly
|
||||||
cellWord:
|
cellWord:
|
||||||
push iy
|
push iy
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; 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 next
|
jp exit
|
||||||
|
|
||||||
; 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>.
|
||||||
@ -80,16 +59,20 @@ 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 IP.
|
; that number is to play with the Return stack: We pop it, read the number, push
|
||||||
|
; it to the Parameter stack and then push an increase Interpreter Pointer back
|
||||||
|
; to RS.
|
||||||
numberWord:
|
numberWord:
|
||||||
ld hl, (IP) ; (HL) is out number
|
ld l, (ix)
|
||||||
|
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 (IP), hl ; advance IP by 2
|
ld (ix), l
|
||||||
|
ld (ix+1), h
|
||||||
push de
|
push de
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
.db 0b10 ; Flags
|
.db 0b10 ; Flags
|
||||||
NUMBER:
|
NUMBER:
|
||||||
@ -101,7 +84,8 @@ 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:
|
||||||
ld hl, (IP)
|
call popRS
|
||||||
|
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
|
||||||
@ -113,17 +97,24 @@ litWord:
|
|||||||
LIT:
|
LIT:
|
||||||
.dw litWord
|
.dw litWord
|
||||||
|
|
||||||
; Pop previous IP from Return stack and execute it.
|
|
||||||
; ( R:I -- )
|
; ( R:I -- )
|
||||||
.db "EXIT"
|
.db ";"
|
||||||
.fill 3
|
.fill 7
|
||||||
.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
|
||||||
ld (IP), hl
|
exit:
|
||||||
jp next
|
; Before we continue: is SP within bounds?
|
||||||
|
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"
|
||||||
@ -142,9 +133,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 forthRdLineNoOk
|
jp forthRdLine
|
||||||
ABORTREF:
|
ABORTREF:
|
||||||
.dw ABORT
|
.dw ABORT
|
||||||
|
|
||||||
@ -172,7 +163,7 @@ EMIT:
|
|||||||
pop hl
|
pop hl
|
||||||
ld a, l
|
ld a, l
|
||||||
call stdioPutC
|
call stdioPutC
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( c port -- )
|
; ( c port -- )
|
||||||
.db "PC!"
|
.db "PC!"
|
||||||
@ -184,7 +175,7 @@ PSTORE:
|
|||||||
pop bc
|
pop bc
|
||||||
pop hl
|
pop hl
|
||||||
out (c), l
|
out (c), l
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( port -- c )
|
; ( port -- c )
|
||||||
.db "PC@"
|
.db "PC@"
|
||||||
@ -197,7 +188,7 @@ PFETCH:
|
|||||||
ld h, 0
|
ld h, 0
|
||||||
in l, (c)
|
in l, (c)
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( addr -- )
|
; ( addr -- )
|
||||||
.db "EXECUTE"
|
.db "EXECUTE"
|
||||||
@ -215,24 +206,18 @@ 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 ENDDEF
|
.dw EXECUTE
|
||||||
.db 0
|
.db 0
|
||||||
DEFINE:
|
DEFINE:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call entryhead
|
call entryhead
|
||||||
ld de, compiledWord
|
ld de, compiledWord
|
||||||
call DEinHL
|
ld (hl), e
|
||||||
|
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.
|
||||||
@ -240,12 +225,10 @@ 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 hl, (IP)
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
.loop:
|
.loop:
|
||||||
push de ; --> lvl 1
|
call HLPointsEXIT
|
||||||
ld de, ENDDEF
|
|
||||||
call HLPointsDE
|
|
||||||
pop de ; <-- lvl 1
|
|
||||||
jr z, .loopend
|
jr z, .loopend
|
||||||
call compSkip
|
call compSkip
|
||||||
jr .loop
|
jr .loop
|
||||||
@ -253,19 +236,22 @@ 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 de, (IP)
|
ld e, (ix)
|
||||||
|
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 hl, (IP)
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
ld de, (HERE) ; recall dest
|
ld de, (HERE) ; recall dest
|
||||||
; copy!
|
; copy!
|
||||||
ldir
|
ldir
|
||||||
ld (IP), hl
|
ld (ix), l
|
||||||
|
ld (ix+1), h
|
||||||
ld (HERE), de
|
ld (HERE), de
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
|
|
||||||
.db "DOES>"
|
.db "DOES>"
|
||||||
@ -278,16 +264,18 @@ 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. Write down IP+2 to entry.
|
; 3. Get the Interpreter pointer from the stack and write this down to
|
||||||
; 3. exit. we're done here.
|
; entry PFA+2.
|
||||||
|
; 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
|
||||||
ld hl, (IP)
|
call popRS
|
||||||
call wrCompHL
|
call wrCompHL
|
||||||
ld (HERE), iy
|
ld (HERE), iy
|
||||||
jp EXIT+2
|
jp exit
|
||||||
|
|
||||||
|
|
||||||
.db "IMMEDIA"
|
.db "IMMEDIA"
|
||||||
@ -298,7 +286,7 @@ IMMEDIATE:
|
|||||||
ld hl, (CURRENT)
|
ld hl, (CURRENT)
|
||||||
dec hl
|
dec hl
|
||||||
set FLAG_IMMED, (hl)
|
set FLAG_IMMED, (hl)
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( n -- )
|
; ( n -- )
|
||||||
.db "LITERAL"
|
.db "LITERAL"
|
||||||
@ -312,7 +300,7 @@ LITERAL:
|
|||||||
pop de ; number from stack
|
pop de ; number from stack
|
||||||
call DEinHL
|
call DEinHL
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
|
|
||||||
.db "'"
|
.db "'"
|
||||||
@ -325,7 +313,7 @@ APOS:
|
|||||||
call find
|
call find
|
||||||
jr nz, .notfound
|
jr nz, .notfound
|
||||||
push de
|
push de
|
||||||
jp next
|
jp exit
|
||||||
.notfound:
|
.notfound:
|
||||||
ld hl, .msg
|
ld hl, .msg
|
||||||
call printstr
|
call printstr
|
||||||
@ -349,7 +337,7 @@ APOSI:
|
|||||||
pop de ; <-- lvl 1
|
pop de ; <-- lvl 1
|
||||||
call DEinHL
|
call DEinHL
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
jp next
|
jp exit
|
||||||
.notfound:
|
.notfound:
|
||||||
ld hl, .msg
|
ld hl, .msg
|
||||||
call printstr
|
call printstr
|
||||||
@ -368,33 +356,23 @@ KEY:
|
|||||||
ld h, 0
|
ld h, 0
|
||||||
ld l, a
|
ld l, a
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
.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 WORD
|
.dw KEY
|
||||||
.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 next
|
jp exit
|
||||||
|
|
||||||
.db "HERE"
|
.db "HERE"
|
||||||
.fill 3
|
.fill 3
|
||||||
@ -421,11 +399,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 chkPSRS
|
call chkPS
|
||||||
call pad
|
call pad
|
||||||
call fmtDecimalS
|
call fmtDecimalS
|
||||||
call printstr
|
call printstr
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( n a -- )
|
; ( n a -- )
|
||||||
.db "!"
|
.db "!"
|
||||||
@ -438,7 +416,7 @@ STORE:
|
|||||||
pop hl
|
pop hl
|
||||||
ld (iy), l
|
ld (iy), l
|
||||||
ld (iy+1), h
|
ld (iy+1), h
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( n a -- )
|
; ( n a -- )
|
||||||
.db "C!"
|
.db "C!"
|
||||||
@ -450,7 +428,7 @@ CSTORE:
|
|||||||
pop hl
|
pop hl
|
||||||
pop de
|
pop de
|
||||||
ld (hl), e
|
ld (hl), e
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a -- n )
|
; ( a -- n )
|
||||||
.db "@"
|
.db "@"
|
||||||
@ -462,7 +440,7 @@ FETCH:
|
|||||||
pop hl
|
pop hl
|
||||||
call intoHL
|
call intoHL
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a -- c )
|
; ( a -- c )
|
||||||
.db "C@"
|
.db "C@"
|
||||||
@ -475,8 +453,9 @@ CFETCH:
|
|||||||
ld l, (hl)
|
ld l, (hl)
|
||||||
ld h, 0
|
ld h, 0
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
|
; ( -- a )
|
||||||
.db "LIT@"
|
.db "LIT@"
|
||||||
.fill 3
|
.fill 3
|
||||||
.dw CFETCH
|
.dw CFETCH
|
||||||
@ -485,7 +464,7 @@ LITFETCH:
|
|||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
call readLITTOS
|
call readLITTOS
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b -- b a )
|
; ( a b -- b a )
|
||||||
.db "SWAP"
|
.db "SWAP"
|
||||||
@ -497,7 +476,7 @@ SWAP:
|
|||||||
pop hl
|
pop hl
|
||||||
ex (sp), hl
|
ex (sp), hl
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b c d -- c d a b )
|
; ( a b c d -- c d a b )
|
||||||
.db "2SWAP"
|
.db "2SWAP"
|
||||||
@ -514,7 +493,7 @@ SWAP2:
|
|||||||
push de ; D
|
push de ; D
|
||||||
push hl ; A
|
push hl ; A
|
||||||
push bc ; B
|
push bc ; B
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a -- a a )
|
; ( a -- a a )
|
||||||
.db "DUP"
|
.db "DUP"
|
||||||
@ -526,7 +505,7 @@ DUP:
|
|||||||
pop hl
|
pop hl
|
||||||
push hl
|
push hl
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b -- a b a b )
|
; ( a b -- a b a b )
|
||||||
.db "2DUP"
|
.db "2DUP"
|
||||||
@ -541,7 +520,7 @@ DUP2:
|
|||||||
push hl
|
push hl
|
||||||
push de
|
push de
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b -- a b a )
|
; ( a b -- a b a )
|
||||||
.db "OVER"
|
.db "OVER"
|
||||||
@ -555,7 +534,7 @@ OVER:
|
|||||||
push de
|
push de
|
||||||
push hl
|
push hl
|
||||||
push de
|
push de
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b c d -- a b c d a b )
|
; ( a b c d -- a b c d a b )
|
||||||
.db "2OVER"
|
.db "2OVER"
|
||||||
@ -574,65 +553,12 @@ OVER2:
|
|||||||
push hl ; D
|
push hl ; D
|
||||||
push iy ; A
|
push iy ; A
|
||||||
push bc ; B
|
push bc ; B
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
.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 J
|
.dw OVER2
|
||||||
.db 0
|
.db 0
|
||||||
PLUS:
|
PLUS:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
@ -640,7 +566,7 @@ PLUS:
|
|||||||
pop de
|
pop de
|
||||||
add hl, de
|
add hl, de
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A - B
|
; ( a b -- c ) A - B
|
||||||
.db "-"
|
.db "-"
|
||||||
@ -654,7 +580,7 @@ MINUS:
|
|||||||
or a ; reset carry
|
or a ; reset carry
|
||||||
sbc hl, de
|
sbc hl, de
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A * B
|
; ( a b -- c ) A * B
|
||||||
.db "*"
|
.db "*"
|
||||||
@ -667,7 +593,7 @@ MULT:
|
|||||||
pop bc
|
pop bc
|
||||||
call multDEBC
|
call multDEBC
|
||||||
push hl
|
push hl
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a b -- c ) A / B
|
; ( a b -- c ) A / B
|
||||||
.db "/"
|
.db "/"
|
||||||
@ -680,7 +606,7 @@ DIV:
|
|||||||
pop hl
|
pop hl
|
||||||
call divide
|
call divide
|
||||||
push bc
|
push bc
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( a1 a2 -- b )
|
; ( a1 a2 -- b )
|
||||||
.db "SCMP"
|
.db "SCMP"
|
||||||
@ -694,7 +620,7 @@ SCMP:
|
|||||||
call strcmp
|
call strcmp
|
||||||
call flagsToBC
|
call flagsToBC
|
||||||
push bc
|
push bc
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; ( n1 n2 -- f )
|
; ( n1 n2 -- f )
|
||||||
.db "CMP"
|
.db "CMP"
|
||||||
@ -709,7 +635,7 @@ CMP:
|
|||||||
sbc hl, de
|
sbc hl, de
|
||||||
call flagsToBC
|
call flagsToBC
|
||||||
push bc
|
push bc
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; 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
|
||||||
@ -721,12 +647,14 @@ CMP:
|
|||||||
FBR:
|
FBR:
|
||||||
.dw nativeWord
|
.dw nativeWord
|
||||||
push de
|
push de
|
||||||
ld hl, (IP)
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
ld a, (hl)
|
ld a, (hl)
|
||||||
call addHL
|
call addHL
|
||||||
ld (IP), hl
|
ld (ix), l
|
||||||
|
ld (ix+1), h
|
||||||
pop de
|
pop de
|
||||||
jp next
|
jp exit
|
||||||
|
|
||||||
; Conditional branch, only branch if TOS is zero
|
; Conditional branch, only branch if TOS is zero
|
||||||
.db "(fbr?)"
|
.db "(fbr?)"
|
||||||
@ -740,11 +668,25 @@ FBRC:
|
|||||||
or l
|
or l
|
||||||
jr z, FBR+2
|
jr z, FBR+2
|
||||||
; skip next byte in RS
|
; skip next byte in RS
|
||||||
ld hl, (IP)
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
inc hl
|
inc hl
|
||||||
ld (IP), hl
|
ld (ix), l
|
||||||
jp next
|
ld (ix+1), h
|
||||||
|
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 FBRC
|
.dw RECURSE
|
||||||
|
|
||||||
|
@ -36,9 +36,7 @@ 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
|
['] x -- *I* Like "'", but spits the addr as a number literal.
|
||||||
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.
|
||||||
@ -62,7 +60,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.
|
||||||
|
|
||||||
*** Parameter Stack ***
|
*** 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
|
||||||
@ -70,13 +68,6 @@ 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
|
||||||
@ -84,7 +75,7 @@ J -- n Copy RS third item to PS
|
|||||||
+! 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 -- a Set a to wordref of last added entry.
|
CURRENT -- n Set n to wordref of last added entry.
|
||||||
HERE -- a Push HERE's address
|
HERE -- a Push HERE's address
|
||||||
H -- a HERE @
|
H -- a HERE @
|
||||||
|
|
||||||
@ -105,8 +96,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 following LIT and push its addr to a
|
LIT@ x -- a Read folloing LIT and push its addr to a
|
||||||
SCMP a1 a2 -- n Compare strings a1 and a2. See CMP
|
S= 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
|
||||||
@ -114,5 +105,4 @@ 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,15 +17,9 @@
|
|||||||
|
|
||||||
; *** 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.
|
||||||
@ -65,23 +59,6 @@
|
|||||||
;
|
;
|
||||||
; 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:
|
||||||
@ -105,14 +82,10 @@ 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)
|
||||||
@ -155,17 +128,11 @@ forthInterpret:
|
|||||||
ld (HERE), de
|
ld (HERE), de
|
||||||
jr forthInterpret
|
jr forthInterpret
|
||||||
.immed:
|
.immed:
|
||||||
; For this IMMEDIATE word to be compatible with regular execution model,
|
push hl ; --> lvl 1
|
||||||
; it needs to be compiled as an atom list. We need a temporary space for
|
ld hl, .retRef
|
||||||
; this, let's use (OLDHERE) while it isn't used.
|
call pushRS
|
||||||
ex de, hl ; atom to write in DE
|
pop iy ; <-- lvl 1
|
||||||
ld hl, (OLDHERE)
|
jp executeCodeLink
|
||||||
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
|
||||||
@ -173,25 +140,23 @@ 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)
|
||||||
call DEinHL
|
ld (hl), e
|
||||||
|
inc hl
|
||||||
|
ld (hl), d
|
||||||
|
inc hl
|
||||||
ld (HERE), hl
|
ld (HERE), hl
|
||||||
pop hl
|
pop hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
.retRef:
|
.retRef:
|
||||||
.dw forthInterpret
|
.dw $+2
|
||||||
|
.dw $+2
|
||||||
|
call popRS
|
||||||
|
jr forthInterpret
|
||||||
|
|
||||||
msgOk:
|
msgOk:
|
||||||
.db " ok", 0
|
.db " ok", 0
|
||||||
|
@ -36,15 +36,8 @@ skipRS:
|
|||||||
pop hl
|
pop hl
|
||||||
ret
|
ret
|
||||||
|
|
||||||
; Verifies that SP and RS are within bounds. If it's not, call ABORT
|
; Verifies that SP is within bounds. If it's not, call ABORT
|
||||||
chkPSRS:
|
chkPS:
|
||||||
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
|
||||||
@ -52,7 +45,6 @@ chkPSRS:
|
|||||||
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,6 +80,13 @@ 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.
|
||||||
@ -195,31 +202,20 @@ 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
|
||||||
push ix \ pop hl
|
ld hl, (RS_ADDR)
|
||||||
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+2), de
|
ld (RS_ADDR), de
|
||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
readLITTOS:
|
readLITTOS:
|
||||||
push de
|
push de
|
||||||
ld hl, (IP)
|
ld l, (ix)
|
||||||
|
ld h, (ix+1)
|
||||||
call readLIT
|
call readLIT
|
||||||
ld (IP), de
|
ld (ix), e
|
||||||
|
ld (ix+1), d
|
||||||
pop de
|
pop de
|
||||||
ret
|
ret
|
||||||
|
|
||||||
@ -288,6 +284,7 @@ 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,6 +1,5 @@
|
|||||||
/shell/shell
|
/shell/shell
|
||||||
/forth/stage1
|
/forth/stage1
|
||||||
/forth/stage1dbg
|
|
||||||
/forth/forth
|
/forth/forth
|
||||||
/zasm/zasm
|
/zasm/zasm
|
||||||
/zasm/avra
|
/zasm/avra
|
||||||
|
@ -33,9 +33,6 @@ 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,11 +20,6 @@ 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
|
||||||
@ -49,17 +44,11 @@ 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[])
|
||||||
{
|
{
|
||||||
#ifdef DEBUG
|
bool tty = false;
|
||||||
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) {
|
||||||
@ -70,7 +59,6 @@ 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;
|
||||||
@ -86,7 +74,6 @@ 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]);
|
||||||
@ -95,7 +82,6 @@ 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