OPT PRT
* fig-FORTH FOR 6809, converted by unintelligent conversion from 6800 source.
+
+* To do:
+* 4 IO routines -- OK?
+* adjust ram locations -- OK?
+* then add trace routines -- OK?
+* then try in emulator
+
* ASSEMBLY SOURCE LISTING
* RELEASE 1
* PEMIT ( word # 182 )
* PKEY ( 183 )
* PQTERM ( 184 )
+* Note: PCR, also. (PRTCR)
*
* The FORTH words for disc related I/O follow the model
* of the FORTH Interest Group, but have not been
*
NBLK EQU 4 # of disc buffer blocks for virtual memory
-MEMEND EQU 132*NBLK+$3000 end of ram
+* MEMEND EQU 132*NBLK+$3000 end of ram
+MEMEND EQU 132*NBLK+$5000+132 end of ram with some breathing room (32K Coco)
* each block is 132 bytes in size,
* holding 128 characters
*
-MEMTOP EQU $3FFF absolute end of all ram
-ACIAC EQU $FBCE the ACIA control address and
-ACIAD EQU ACIAC+1 data address for PROTO
+* MEMTOP EQU $3FFF absolute end of all ram
+MEMTOP EQU $7FFF putative absolute end of all ram (32K Coco)
+* No ACIA in Coco (how sad).
+* ACIAC EQU $FBCE the ACIA control address and
+* ACIAD EQU ACIAC+1 data address for PROTO
PAGE
-* MEMORY MAP for this 16K system:
+* MEMORY MAP for this 16K system (32K Coco):
* ( positioned so that systems with 4k byte write-
* protected segments can write protect FORTH )
*
+* Read below and calculate it yourself:
* addr. contents pointer init by
* **** ******************************* ******* ******
* 3FFF HI
* <== W
* the VIRTUAL FORTH MACHINE
*
-* 1004 <<< WARM START ENTRY >>>
-* 1000 <<< COLD START ENTRY >>>
+* 1004 (3004) <<< WARM START ENTRY >>>
+* 1000 (3000) <<< COLD START ENTRY >>>
*
* >>>>>> memory from here down must be RAM <<<<<<
* FFE RETURN STACK base <== RP RINIT
* RP points to second free byte (first free word) in return stack
* SP (hardware SP) points to first free byte in data stack
*
-* when A ANDB hold one 16 bit FORTH data word,
+* when A AND B hold one 16 bit FORTH data word,
* A contains the high byte, B, the low byte.
***
- ORG $E0 variables
+* ORG $E0 variables
+ ORG $1300 variables
+PGBASE EQU *
+PGBDP EQU PGBASE/$100
+ SETDP PGBDP
N RMB 10 used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY,
UP RMB 2 the pointer to base of current user's 'USER' table
* ( altered during multi-tasking )
*
+* For the tracer:
+ RMB 4
+TRASP RMB 2
+TRAVEC RMB 2
+TRAA RMB 1
+TRAB RMB 1
+FLAGON RMB 1
+*
PAGE
* This system is shown with one user, but additional users
* may be added by allocating additional user tables:
* COLD start and WARM start:
* [ names correspond to FORTH words of similar (no X) name ]
*
- ORG $100
+* ORG $100
+ ORG $1400
UORIG RMB 6 3 reserved variables
XSPZER RMB 2 initial top of data stack for this user
XRZERO RMB 2 initial top of return stack
REND EQU * ( first empty location in dictionary )
PAGE
+* Check the addresses yourself:
* The FORTH program ( address $1000 to $27FF ) is written
* so that it can be in a ROM, or write-protected if desired
- ORG $1000
+ ORG $3000
* ######>> screen 3 <<
*
*
******* startup parmeters **************************
*
- FDB $6800,0000 cpu & revision
+RPTIB EQU $200 Give us more room to breath.
+SBUMPR EQU $10 Bumper area for stacks.
+*
+ FDB $6800,6809 cpu & revision
FDB 0 topmost word in FORTH vocabulary
BACKSP FDB $7F backspace character for editing
UPINIT FDB UORIG initial user area
-SINIT FDB ORIG-$D0 initial top of data stack
-RINIT FDB ORIG-2 initial top of return stack
- FDB ORIG-$D0 terminal input buffer
+* SINIT FDB ORIG-$D0 initial top of data stack
+SINIT FDB ORIG-RPTIB-SBUMPR*2
+* RINIT FDB ORIG-2 initial top of return stack
+RINIT FDB ORIG-SBUMPR
+* FDB ORIG-$D0 terminal input buffer
+ FDB ORIG-RPTIB-SBUMPR
FDB 31 initial name field width
FDB 0 initial warning mode (0 = no disc)
FENCIN FDB REND initial fence
PAGE
*
* ######>> screen 13 <<
+* Calculate the cycles yourself:
PULABX PULS A 24 cycles until 'NEXT'
PULS B
STABX STA 0,X 16 cycles until 'NEXT'
*
* "NEXT" takes 38 cycles if TRACE is removed,
*
-* and 95 cycles if NOT tracing.
+* and 95 cycles if NOT tracing. (Way bogus numbers by now.)
*
* = = = = = = = t h e v i r t u a l m a c h i n e = = = = =
* =
* The next instruction could be patched to JMP TRACE =
* if a TRACE routine is available: =
* =
- JMP 0,X
+* Or add the TRACE routine in-line, since we are assembling it.
+ TST TRACEM
+ BEQ NEXTGO
+ STX TRAVEC
+ TFR S,X ; Mechanical! Mechanical! (So the funn 6800 stack didn't beach us.)
+ STX TRASP
+ LDA #':'
+ JSR PEMIT
+* LDA #' '
+* JSR PEMIT
+ LDX W
+ LEAX -1,X
+ LEAX -1,X ; allocation link
+ LEAX -1,X ; last char
+ LDA #31
+NAMTST LEAX -1,X ; length byte?
+ LDB 0,X
+ BMI NAMTDN
+ DECA
+ BNE NAMTST
+NAMTDN ANDB #31 ; It's the length byte whether it wants to be or not.
+NAMSHW LEAX 1,X
+ LDA 0,X
+ JSR PEMIT
+ DECB
+ BNE NAMSHW
+* show the virtual registers
+* TOO MUCH OUTPUT! Have to trim this.
+ LDA #' '
+ JSR PEMIT
+ LDA #'@'
+ LDX #TRAVEC
+ JSR PHEX4F
+ TFR DP,A
+ LDB #(W-PGBASE)
+ TFR D,X
+ LDA #'W'
+ JSR PHEX4F
+ LDA #'I'
+ JSR PHEX4F
+ LDA #'R'
+ JSR PHEX4F
+ LDA #'U'
+ JSR PHEX4F
+ TFR DP,A
+ LDB #(W-TRASP)
+ TFR D,X
+ LDA #'S'
+ BSR PHEX4F
+ LDA #'>'
+ TFR S,X
+ BSR PHEX4F
+ LDA #' '
+ BSR PHEX4F
+*
+ JSR PRTCR
+ LDX TRAVEC
+*
+NEXTGO JMP 0,X
NOP
* JMP TRACE ( an alternate for the above )
* =
+* =
+*DBG
+PHEX4F JSR PEMIT
+ BSR PHEXX2
+ BSR PHEXX2
+ LDA #' '
+ JMP PEMIT ; rob return
+*
+PHEXX2 LDA 0,X
+ LSRA
+ LSRA
+ LSRA
+ LSRA
+ BSR PHEXD
+ LDA 0,X
+ BSR PHEXD
+ LEAX 1,X
+ RTS
+*
+PHEXD ANDA #$0F
+ CMPA #10
+ BLO PHEXDH
+ ADDA #7 ; 'A'-'9'+1
+PHEXDH ADDA #'0'
+ JMP PEMIT ; rob return
+*
+DEBUGP FDB *+2
+ INC FLAGON my version of trace
+ LDA FLAGON
+ JSR PEMIT
+ JMP NEXT
+*
+DEBUGM FDB *+2
+ DEC FLAGON my version of trace
+ LDA FLAGON
+ JSR PEMIT
+ JMP NEXT
+*DBG
* = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
PSHS B
PSHS A
INCB
- BRA ENCL7+2
+ BRA ENCL7A ; ENCL7+2 ******* was a *potential* bug ****** (But DP)
* found NUL following the word instead of SPACE
ENCL7 LDB N
- PSHS B save EW
+ENCL7A PSHS B save EW
PSHS A
ENCL8 LDB N save NC
JMP PUSHBA
JSR PEMIT
LDX UP
INC XOUT+1-UORIG,X
- BNE *+4
+ BNE EMITDN
INC XOUT-UORIG,X
- JMP NEXT
+EMITDN JMP NEXT
*
* ======>> 14 <<
FCB $83
FCB $D3
FDB RPSTOR-6
SEMIS FDB *+2
+* DBG
+ LDA #-$10
+ ADDA FLAGON
+ STA FLAGON my version of trace
+ JSR PEMIT
+*
LDX RP
LEAX 1,X
LEAX 1,X
LEAX -1,X
LEAX -1,X
STX RP
+* DBG
+ LDA #$10
+ ADDA FLAGON
+ STA FLAGON my version of trace
+ JSR PEMIT
+*
LDA IP
LDB IP+1
STA 2,X Store address of the high level word
FCC 'DECIMA' ; 'DECIMAL'
FCB $CC
FDB HEX-6
-DEC FDB DOCOL
+DECIM FDB DOCOL
FDB CLITER
FCB 10 note: hex "A"
FDB BASE,STORE
FCB $87
FCC '(;CODE' ; '(;CODE)'
FCB $A9
- FDB DEC-10
+ FDB DECIM-10
PSCODE FDB DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
FDB SEMIS
*
FCC 'ABOR' ; 'ABORT'
FCB $D4
FDB QUIT-7
-ABORT FDB DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ
- FCB 8
- FCC "Forth-68"
+ABORT FDB DOCOL,SPSTOR,DECIM,QSTACK,DRZERO,CR,PDOTQ
+ FCB 15
+ FCC "Forth-68oo-68o9"
FDB FORTH,DEFIN
FDB QUIT
* FDB SEMIS never executed
FDB ABORT-8
COLD FDB *+2
* CENT LDS #REND-1 top of destination on 6800
-CENT LDS #REND top of destination on 6809
+CENT LDA #PGBDP
+ TFR A,DP
+ LDS #REND top of destination on 6809
LDX #ERAM top of stuff to move
COLD2 LEAX -1,X
LDA 0,X
STX TRLIM clear trace mode
LDX #0
STX BRKPT clear breakpoint address
+* DBG
+ LDA #$21
+ STA FLAGON my version of trace
+ JSR PEMIT
+*
JMP RPSTOR+2 start the virtual machine running !
*
* Here is the stuff that gets copied to ram :
* at address $140:
*
-RAM FDB $3000,$3000,0,0
+RAM FDB $5000,$5000,0,0
* ======>> (152) <<
FCB $C5 immediate
* called by words 13 through 16 in the dictionary.
*
* ======>> 182 << code for EMIT
-PEMIT STB N save B
- STX N+1 save X
- LDB ACIAC
- BITB #2 check ready bit
- BEQ PEMIT+4 if not ready for more data
- STA ACIAD
- LDX UP
- STB IOSTAT-UORIG,X
- LDB N recover B & X
- LDX N+1
- RTS only A register may change
+* character to output in A
+* Coco:
+PEMIT PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ JSR [$A002]
+ PULS Y,U,DP,PC
+*
+* PEMIT STB N save B
+* STX N+1 save X
+* LDB ACIAC
+* BITB #2 check ready bit
+* BEQ PEMIT+4 if not ready for more data
+* STA ACIAD
+* LDX UP
+* STB IOSTAT-UORIG,X
+* LDB N recover B & X
+* LDX N+1
+* RTS only A register may change
* PEMIT JMP $E1D1 for MIKBUG
* PEMIT FCB $3F,$11,$39 for PROTO
* PEMIT JMP $D286 for Smoke Signal DOS
*
* ======>> 183 << code for KEY
-PKEY STB N
- STX N+1
- LDB ACIAC
- ASRB
- BCC PKEY+4 no incoming data yet
- LDA ACIAD
- ANDA #$7F strip parity bit
- LDX UP
- STB IOSTAT+1-UORIG,X
- LDB N
- LDX N+1
- RTS
+* Returns input character in A
+* Coco:
+PKEY PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ LDA #$CF a cursor
+ LDB [$0088] (locate) save
+ STA [$0088]
+PKEYBZ JSR [$A000]
+ BEQ PKEYBZ
+ STB [$0088] restore
+ PULS Y,U,DP,PC
+*
+* PKEY STB N
+* STX N+1
+* LDB ACIAC
+* ASRB
+* BCC PKEY+4 no incoming data yet
+* LDA ACIAD
+* ANDA #$7F strip parity bit
+* LDX UP
+* STB IOSTAT+1-UORIG,X
+* LDB N
+* LDX N+1
+* RTS
* PKEY JMP $E1AC for MIKBUG
* PKEY FCB $3F,$14,$39 for PROTO
* PKEY JMP $D289 for Smoke Signal DOS
*
* ######>> screen 64 <<
* ======>> 184 << code for ?TERMINAL
-PQTER LDA ACIAC Test for 'break' condition
- ANDA #$11 mask framing error bit and
-* input buffer full
- BEQ PQTER2
- LDA ACIAD clear input buffer
- LDA #01
-PQTER2 RTS
+* Returns flag in A (non-zero if BREAK).
+* Coco:
+PQTER PSHS Y,U,DP
+ CLRB
+ TFR B,DP
+ JSR [$A000]
+ CLRB
+ CMPA #3 break key
+ BNE PQTERN
+ INCB
+ EXG A,B
+PQTERN PULS Y,U,DP,PC
+*
+* PQTER LDA ACIAC Test for 'break' condition
+* ANDA #$11 mask framing error bit and
+** input buffer full
+* BEQ PQTER2
+* LDA ACIAD clear input buffer
+* LDA #01
+*PQTER2 RTS
PAGE
*
* ======>> 185 << code for CR
+* Coco:
PRTCR LDA #$D carriage return ; PCR in 6800 source
- BSR PEMIT
- LDA #$A line feed
- BSR PEMIT
- LDA #$7F rubout
- LDX UP
- LDB XDELAY+1-UORIG,X
-PCR2 DECB
- BMI PQTER2 return if minus
- PSHS B save counter
- BSR PEMIT print RUBOUTs to delay.....
- PULS B
- BRA PCR2 repeat
+ BRA PEMIT Let PEMIT return
+*
+* BSR PEMIT
+* LDA #$A line feed
+* BSR PEMIT
+* LDA #$7F rubout
+* LDX UP
+* LDB XDELAY+1-UORIG,X
+* PCR2 DECB
+* BMI PQTER2 return if minus
+* PSHS B save counter
+* BSR PEMIT print RUBOUTs to delay.....
+* PULS B
+* BRA PCR2 repeat
PAGE
FCC 'LIS' ; 'LIST'
FCB $D4
FDB QUEST-4
-LIST FDB DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ
+LIST FDB DOCOL,DECIM,CR,DUP,SCR,STORE,PDOTQ
FCB 6
FCC "SCR # "
FDB DOT,CLITER
OSDN Git Service
