From: Joel Matthew Rees Date: Tue, 29 Jan 2019 14:25:03 +0000 (+0900) Subject: disc emulation is almost working, so we are close to being able to release X-Git-Url: http://git.osdn.net/view?p=fig-forth-6809%2Ffig-forth-6809.git;a=commitdiff_plain;h=723a09ffcbd758c0efaa1394dfd1674171913fd0 disc emulation is almost working, so we are close to being able to release --- diff --git a/fig-forth-auto6809opt.asm b/fig-forth-auto6809opt.asm index bd0e659..bb43beb 100644 --- a/fig-forth-auto6809opt.asm +++ b/fig-forth-auto6809opt.asm @@ -99,91 +99,113 @@ NATWID EQU 2 ; bytes per natural integer/pointer * 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" * @@ -293,9 +315,9 @@ VECT RMB 2 vector to machine code 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 @@ -384,8 +406,9 @@ RINIT FDB IRP ; initial top of return stack 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 **************************************************** * @@ -2519,11 +2542,20 @@ LIMIT FDB DOCON * * ======>> 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: @@ -3765,6 +3797,10 @@ NULL3 FDB SEMIS * ======>> 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 @@ -4227,14 +4263,26 @@ CENT LDS SINIT,PCR ; Get a useable return stack, at least. * 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 > (152) << * ( --- ) P * Makes FORTH the current interpretation vocabulary. @@ -4334,13 +4393,17 @@ RAM FDB $3000,$3000,0,0 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 << @@ -4375,6 +4438,7 @@ STAR FDB *+NATWID * ( 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 @@ -4385,6 +4449,7 @@ SLMOD FDB DOCOL,TOR,STOD,FROMR,USLASH * ======>> 161 << * ( dividend divisor --- quotient ) * Signed word divide without remainder. +* Except *BUG* it isn't signed. FCB $81 ; / FCB $AF FDB SLMOD-7 @@ -4497,8 +4562,9 @@ PREV FDB DOCON 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 @@ -5447,7 +5513,7 @@ BLINEX FDB I,CAT,THREE,XDOTR,XLOOP 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 @@ -5478,7 +5544,10 @@ BDUMPL FDB I,LIT8 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 @@ -5489,6 +5558,7 @@ ZZZZ FDB 0,0,0,0,0,0,0,0 end of rom program * 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 @@ -5496,8 +5566,11 @@ ZZZZ FDB 0,0,0,0,0,0,0,0 end of rom program 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 @@ -5505,11 +5578,47 @@ FORTH FDB DODOES,DOVOC,$81A0,TASK-7 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