* implementation for the 6809 -- Color Computer.
*
-*
-MEMT32 EQU $7FFF absolute end of all ram
-MEMT16 EQU $3FFF
-MEMTOP EQU MEMT32 ; tentative guess
-ACIAC EQU $FBCE the ACIA control address and
-ACIAD EQU ACIAC+1 data address for PROTO
- PAGE
* MEMORY MAP for this 16K|32K system:
* ( delineated so that systems with 4k byte write-
* protected segments can write protect FORTH )
*
* addr. contents pointer init by
* **** ******************************* ******* ******
-* 2nd through 4th per-user tables
-* 4000|7D00
-USERSZ EQU 256 ; (Addressable by DP)
+*
+* Coco has no ACIA!
+* ACIAC EQU $FBCE the ACIA control address and
+* ACIAD EQU ACIAC+1 data address for PROTO
+*
+MEMT32 EQU $7FFF ; Theoretical absolute end of all ram
+MEMT16 EQU $3FFF ; 16K is too tight until we no longer need disc emulation.
+MEMTOP EQU MEMT32
+*
+MASSHI EQU MEMTOP
+*
+* 3FFF|7FFF HI
+*
+* substitute for disc mass memory
+RAMSCR EQU 8 ; addresses calculate as 2 (Too much for 16K in RAM only.)
+SCRSZ EQU 1024
+* 3800|7800 LO
+MASSLO EQU MASSHI-RAMSCR*SCRSZ+1
+RAMDSK EQU MASSLO
+MEMEND EQU MASSLO
+*
+* 3800|7800 MEMEND
+* "end" of "usable ram" (If disc mass memory emulation is removed, actual end.)
+*
+* 37FF|77FF
+*
+* per-user tables
+USERSZ EQU 256 ; (Addressable by DP, must be 256 on even boundary)
USER16 EQU 1 ; We can change these for ROMPACK or 64K.
-USER32 EQU 4
+USER32 EQU 2 ; maybe?
USERCT EQU USER32
-IUP16 EQU MEMT16+1-USER16*USERSZ
-IUP32 EQU MEMT32+1-USER32*USERSZ
-IUP EQU IUP32
+USERLO EQU MEMEND-USERSZ*USERCT
+IUP EQU USERLO
IUPDP EQU IUP/256
* user tables of variables
* registers & pointers for the virtual machine
-* scratch area used by various words
-* 3F00|7C00 <== UP (DICTPT)
-* 3EFF|7BFF HI
-* substitute for disc mass memory
-RAMSCR EQU 3
-SCRSZ EQU 1024
-* 3300|7000 LO,MEMEND
-RAMD16 EQU IUP16-RAMSCR*SCRSZ
-RAMD32 EQU IUP32-RAMSCR*SCRSZ
-RAMDSK EQU RAMD32
-MEME16 EQU RAMD16
-MEME32 EQU RAMD32
-MEMEND EQU MEME32
-* 32FF|6FFF
+* scratch area for potential use in something, maybe?
+*
+* 3700|7600 <== UP
+*
+* This is a really awkward place to define the disk buffer records.
+*
* 4 buffer sectors of VIRTUAL MEMORY
NBLK EQU 4 ; # of disc buffer blocks for virtual memory
* Should NBLK be SCRSZ/SECTSZ?
* each block is SECTSZ+SECTRL bytes in size,
* holding SECTSZ characters
SECTSZ EQU 256
-SECTRL EQU 8
+SECTRL EQU 2*NATWID ; Currently held sector number, etc.
BUFSZ EQU (SECTSZ+SECTRL)*NBLK
-* 2EE0|6BE0 FIRST
-BUFB16 EQU MEME16-BUFSZ
-BUFB32 EQU MEME32-BUFSZ
-BUFBAS EQU BUFB32
-* "end" of "usable ram" -- in 16K
-* 2EE0|6BE0 <== RP RINIT
-IRP16 EQU BUFB16
-IRP32 EQU BUFB32
-IRP EQU IRP32
+BUFBAS EQU USERLO-BUFSZ
+* *BUG* SECTRL is hard-wired into several definitions.
+* It will take a bit of work to ferret them out.
+* It is too small, and it should not be hard-wired.
+* SECTSZ was also hard-wired into several definitions,
+* will I find them all?
+*
+* 32E0|71E0 FIRST
+*
+ PAGE
+*
+* Don't want one return too many to destroy the disc buffers.
+RPBUMP EQU 4*NATWID
+*
+* 32D8|71D8 <== RP RINIT
+*
+IRP EQU BUFBAS-RPBUMP
* RETURN STACK
-* (64|112 levels nesting)
-RSTK16 EQU 128
-RSTK32 EQU 224
-* (2E60|6B00)
-SFTB16 EQU IRP16-RSTK16
-SFTB32 EQU IRP32-RSTK32
-SFTBND EQU SFTB32
+RSTK16 EQU $50*NATWID ; 80 max levels nesting calls
+RSTK32 EQU $90*NATWID ; 144 max
+RSTKSZ EQU RSTK32
+*
+* 3248|70B8
+*
+SFTBND EQU IRP-RSTKSZ ; (false boundary between TIB and return stack)
* INPUT LINE BUFFER
-* holds up to 256 characters
+* holds up to TIBSZ characters
* and is scanned upward by IN
* starting at TIB
TIBSZ EQU 256
-* 2D60|6A00
-ITIB16 EQU SFTB16-TIBSZ
-ITIB32 EQU SFTB32-TIBSZ
-ITIB EQU ITIB32
-* 2D60|6A00 <== IN TIB
-ISP16 EQU ITIB16
-ISP32 EQU ITIB32
-ISP EQU ISP32
-* 2D60|6A00 <== SP SP0,SINIT
+ITIB EQU SFTBND-TIBSZ
+*
+* 3148|6FB8 <== IN TIB
+*
+* Don't want terminal input and parameter underflow collisions
+SPBUMP EQU 4*NATWID
+*
+ISP EQU ITIB-SPBUMP
+*
+* 3140|6FB0 <== SP SP0,SINIT
* DATA STACK
-* | grows downward from 2A60|6A00
+* | grows downward from 3140|6FB0
* v
* - -
+* ^
* |
* I DICTIONARY grows upward
*
+* >>>>>>--------Two words to start RAMmable dictionary--------<<<<<<
+*
+* (2B00)
* ???? end of ram-dictionary. <== DICTPT DPINIT
* "TASK"
*
W RMB 2 the instruction register points to 6800 code
* This is not exactly accurate. Points to the definiton body,
* which is native CPU machine code when it is native CPU machine code.
-IP RMB 2 the instruction pointer points to pointer to 6800 code
-RP RMB 2 the return stack pointer
-UP RMB 2 the pointer to base of current user's 'USER' table
+* IP RMB 2 the instruction pointer points to pointer to 6800 code
+* RP RMB 2 the return stack pointer
+* UP RMB 2 the pointer to base of current user's 'USER' table
* ( altered during multi-tasking )
*
*UORIG RMB 6 3 reserved variables
FDB 0 initial warning mode (0 = no disc)
FENCIN FDB REND initial fence
DPINIT FDB REND cold start value for DICTPT
+BUFINT FDB BUFBAS Start of the disk buffers area
VOCINT FDB FORTH+4*NATWID
-COLINT FDB 132 initial terminal carriage width
+COLINT FDB TIBSZ initial terminal carriage width
DELINT FDB 4 initial carriage return delay
****************************************************
*
*
* ======>> 59 <<
* ( --- sectorsize )
+* The size, in bytes, of a buffer control region.
+ FCB $85
+ FCC 'B/CTL' ; 'B/CTL' : (bytes/control region)
+ FCB $CC
+ FDB LIMIT-8
+BCTL FDB DOCON
+ FDB SECTRL
+*
+* ( --- sectorsize )
* The size, in bytes, of a buffer.
FCB $85
FCC 'B/BU' ; 'B/BUF' : (bytes/buffer)
FCB $C6
- FDB LIMIT-8
+ FDB BCTL-8
BBUF FDB DOCON
FDB SECTSZ
* Hardcoded in 6800 model:
* ======>> 133 <<
* ( adr n b --- )
* Fill n bytes at adr with b.
+* This relies on CMOVE having a certain lack of parameter checking,
+* where overlapping regions are not properly inverted in copy.
+* And this really should be done in low-level.
+* None of the advantages of doing things in high-level apply to fill.
FCB $84
FCC 'FIL' ; 'FILL'
FCB $CC
* We'll keep this here for the time being.
* There are better ways to do this, of course.
* Re-architect, re-architect.
- LEAX RAM,PCR
+ LEAX ERAM,PCR ; end of stuff to move
STX <XFENCE ; Borrow this variable for a loop terminator.
- LEAY REND,PCR ; top of destination
- LEAX ERAM,PCR ; top of stuff to move
-COLD2 LDA ,-X
- STA ,-Y ; move TASK & FORTH to ram
+ LDY #RBEG ; bottom of open-ended destination
+ LEAX RAM,PCR ; bottom of stuff to move
+COLD2 LDA ,X+
+ STA ,Y+ ; move TASK & FORTH to ram
CMPX <XFENCE
BNE COLD2
+* Leaves USE and PREV uninitialized.
+ LDX BUFINT,PCR
+ STX <XUSE
+ STX <XPREV
+* LEAX RAM,PCR
+* STX <XFENCE ; Borrow this variable for a loop terminator.
+* LEAY REND,PCR ; top of destination (included XUSE and XPREV)
+* LEAX ERAM,PCR ; top of stuff to move (included initializers for XUSE and XPREV)
+* COLD2 LDA ,-X
+* STA ,-Y ; move TASK & FORTH to ram
+* CMPX <XFENCE
+* BNE COLD2
*
* CENT LDS #REND-1 top of destination
* LDX #ERAM top of stuff to move
CMPX ,S
BNE WARM2
LEAS 2,S ; But we'll reset the return stack shortly, anyway.
+ LDU <XSPZER ; So we can clear the hole above the TOS
* WENT LDS #XFENCE-1 top of destination
* LDX #FENCIN top of stuff to move
* WARM2 LEAX -1,X ;
*
* For systems with TRACE:
LDX #00
+ STX ,U The hole above the parameter stack
* STX TRLIM clear trace mode
STX <TRLIM clear trace mode (both bytes)
LDX #0
STX <BRKPT clear breakpoint address
* JMP RPSTOR+2 start the virtual machine running !
LBSR RPSTOR+NATWID start the virtual machine running !
- LBRA NEXT ; But we must also give RP! someplace to return.
+ LEAX WENT,PCR ; But we must also give RP! someplace to return.
+ STX ,S ; This rail might get walked on by (DO).
+ LBRA NEXT
* RP! sets up the return stack pointer, then Y references abort.
*
* Here is the stuff that gets copied to ram :
* (not * at address $140:)
* at an appropriate address:
*
-RAM FDB $3000,$3000,0,0
-
+* RAM FDB $3000,$3000,0,0
+* RAM FDB BUFBAS,BUFBAS,0,0 ; ... except the direct page has moved.
+* These initialization values for USE and PREV were here to help pack the code.
+* They don't belong here unless we move the USER table
+* back below the writable dictionary,
+* *and* move these USER variables to the end of the direct page --
+* *or* let these definitions exist in the USER table.
+RAM EQU *
+
* ======>> (152) <<
* ( --- ) P
* Makes FORTH the current interpretation vocabulary.
FDB NOOP-7 ; Note that this does not link to COLD!
RFORTH FDB DODOES,DOVOC,$81A0,TASK-7
FDB 0
- FCC "(C) Forth Interest Group, 1979"
+ FCC "Copyright 1979 Forth Interest Group, David Lion,"
+ FCB $0D
+ FCC "Parts Copyright 2019 Joel Matthew Rees"
+ FCB $0D
FCB $84
FCC 'TAS' ; 'TASK'
FCB $CB
FDB FORTH-8
RTASK FDB DOCOL,SEMIS
-ERAM FCC "David Lion"
+ERAM EQU *
+ERAMSZ EQU *-RAM ; So we can get a look at it.
PAGE
*
* ######>> screen 57 <<
* ( dividend divisor --- remainder quotient )
* M/ in word-only form, i. e., signed division of 2nd word by top word,
* yielding signed word quotient and remainder.
+* Except *BUG* it isn't signed.
FCB $84
FCC '/MO' ; '/MOD'
FCB $C4
* ======>> 161 <<
* ( dividend divisor --- quotient )
* Signed word divide without remainder.
+* Except *BUG* it isn't signed.
FCB $81 ; /
FCB $AF
FDB SLMOD-7
FCC '+BU' ; '+BUF'
FCB $C6
FDB PREV-7
-PBUF FDB DOCOL,LIT8
- FCB $84
+* PBUF FDB DOCOL,LIT8
+* FCB $84 ; This was a hard-wiring bug.
+PBUF FDB DOCOL,BBUF,BCTL,PLUS ; Size of the buffer record.
FDB PLUS,DUP,LIMIT,EQUAL,ZBRAN
FDB PBUF2-*-NATWID
FDB DROP,FIRST
FDB SPACE,SPACE
FDB DUP,LIT8
FCB 4
- FDB SWAP,XDO
+ FDB PLUS,SWAP,XDO
BLINEC FDB I,CAT,BEMIT,XLOOP
FDB BLINEC-*-NATWID
FDB SEMIS
FCC 'NOO' ; 'NOOP'
FCB $D0
FDB BDUMP-8
-NOOP FDB NEXT a useful no-op
+NOOP FDB *+NATWID
+ RTS
+* Without the RTS, would misalign the stack.
+* NOOP NEXT a useful no-op
ZZZZ FDB 0,0,0,0,0,0,0,0 end of rom program
PAGE
* This can be moved whereever the bottom of the
* user's dictionary is going to be put.
*
+RBEG EQU *
FCB $C5 immediate
FCC 'FORT' ; 'FORTH'
FCB $C8
FORTH FDB DODOES,DOVOC,$81A0,TASK-7
FDB 0
*
- FCC "(C) Forth Interest Group, 1979"
-
+ FCC "Copyright 1979 Forth Interest Group, David Lion,"
+ FCB $0D
+ FCC "Parts Copyright 2019 Joel Matthew Rees"
+ FCB $0D
+*
FCB $84
FCC 'TAS' ; 'TASK'
FCB $CB
TASK FDB DOCOL,SEMIS
*
REND EQU * ( first empty location in dictionary )
+RSIZE EQU *-RBEG ; So we can look at it.
+ PAGE
-
-
-
-
+ ORG RAMDSK
+* "0 1 2 3 4 5 6 " ;
+* "0123456789012345678901234567890123456789012345678901234567890123" ;
+ FCC "HEX ( THIS IS SOME TEST STUFF. ) " ; 0
+ FCC ": STAR 42 EMIT ; ( With some randome comments. ) " ; 1
+ FCC ": STARS 0 DO I EMIT LOOP ; ;S " ; 2
+ FCC " " ; 3
+ FCC " " ; 4
+ FCC " " ; 5
+ FCC " " ; 6
+ FCC " " ; 7
+ FCC " " ; 8
+ FCC " " ; 9
+ FCC " " ; 10
+ FCC " " ; 11
+ FCC " " ; 12
+ FCC " " ; 13
+ FCC " " ; 14
+ FCC " " ; 15
+* "0 1 2 3 4 5 6 " ;
+* "0123456789012345678901234567890123456789012345678901234567890123" ;
+ FCC " more test data 2 3 4 5 6 " ; 0
+ FCC "0123456789012345678901234567890123456789012345678901234567890123" ; 1
+ FCC "Test data for the RAM disc emulator buffers. " ; 2
+ FCC " " ; 3
+ FCC " " ; 4
+ FCC " " ; 5
+ FCC " " ; 6
+ FCC " " ; 7
+ FCC " " ; 8
+ FCC " " ; 9
+ FCC " " ; 10
+ FCC " " ; 11
+ FCC " " ; 12
+ FCC " " ; 13
+ FCC " " ; 14
+ FCC " end" ; 15
+RAMDND EQU *
PAGE
OSDN Git Service
