Adding a delay such as the 20ms one we have in AVR programmer's initialization routine is tricky without a word like TICKS. This implementation is highly inaccurate, but more accurate and reliable than a "ballpark" DO..LOOP...master
@@ -10,7 +10,7 @@ VARIABLE aspprevx | |||||
: asprdy ( -- ) BEGIN 0 0 0 0xf0 _cmd 1 AND NOT UNTIL ; | : asprdy ( -- ) BEGIN 0 0 0 0xf0 _cmd 1 AND NOT UNTIL ; | ||||
: asp$ ( spidevid -- ) | : asp$ ( spidevid -- ) | ||||
( RESET pulse ) DUP (spie) 0 (spie) (spie) | ( RESET pulse ) DUP (spie) 0 (spie) (spie) | ||||
( wait >20ms ) 5000 0 DO LOOP | |||||
( wait >20ms ) 220 TICKS | |||||
( enable prog ) 0xac (spix) DROP | ( enable prog ) 0xac (spix) DROP | ||||
0x53 _x DROP 0 _xc DROP 0 _x DROP ; | 0x53 _x DROP 0 _xc DROP 0 _x DROP ; | ||||
: asperase 0 0 0x80 0xac _cmd asprdy ; | : asperase 0 0 0x80 0xac _cmd asprdy ; |
@@ -1 +1,5 @@ | |||||
VARIABLE lbluflw VARIABLE lblexec | VARIABLE lbluflw VARIABLE lblexec | ||||
( see comment at TICKS' definition ) | |||||
( 7.373MHz target: 737t. outer: 37t inner: 16t ) | |||||
( tickfactor = (737 - 37) / 16 ) | |||||
CREATE tickfactor 44 , |
@@ -0,0 +1,13 @@ | |||||
( The word below is designed to wait the proper 100us per tick | |||||
at 500kHz when tickfactor is 1. If the CPU runs faster, | |||||
tickfactor has to be adjusted accordingly. "t" in comments | |||||
below means "T-cycle", which at 500kHz is worth 2us. ) | |||||
CODE TICKS | |||||
HL POP, chkPS, | |||||
( we pre-dec to compensate for initialization ) | |||||
BEGIN, | |||||
HL DECd, ( 6t ) | |||||
IFZ, ( 12t ) JPNEXT, THEN, | |||||
A tickfactor @ LDri, ( 7t ) | |||||
BEGIN, A DECr, ( 4t ) JRNZ, ( 12t ) AGAIN, | |||||
JR, ( 12t ) AGAIN, ( outer: 37t inner: 16t ) |
@@ -10,4 +10,4 @@ size of stack. This allows for some interesting optimization. | |||||
For example, in SWAP, no need to pop, chkPS, then push, we can | For example, in SWAP, no need to pop, chkPS, then push, we can | ||||
chkPS and then proceed to optimized swapping in PS. | chkPS and then proceed to optimized swapping in PS. | ||||
To assemble, load blocks 445 through 460 | |||||
To assemble, load blocks 445 through 461 |
@@ -0,0 +1,9 @@ | |||||
( See comment in B321. TODO: test on real hardware. in qemu, | |||||
the resulting delay is more than 10x too long. ) | |||||
CODE TICKS 1 chkPS, ( n=100us ) | |||||
SI DX MOVxx, ( protect IP ) | |||||
AX POPx, BX 100 MOVxI, BX MULx, | |||||
CX DX MOVxx, ( high ) DX AX MOVxx, ( low ) | |||||
AX 0x8600 MOVxI, ( 86h, WAIT ) 0x15 INT, | |||||
DX SI MOVxx, ( restore IP ) | |||||
;CODE |
@@ -1,6 +1,7 @@ | |||||
#include <stdlib.h> | #include <stdlib.h> | ||||
#include <stdio.h> | #include <stdio.h> | ||||
#include <string.h> | #include <string.h> | ||||
#include <unistd.h> | |||||
#include "vm.h" | #include "vm.h" | ||||
// Port for block reads. Each read or write has to be done in 5 IO writes: | // Port for block reads. Each read or write has to be done in 5 IO writes: | ||||
@@ -263,6 +264,7 @@ static void MINUS2() { push(pop()-2); } | |||||
static void PLUS2() { push(pop()+2); } | static void PLUS2() { push(pop()+2); } | ||||
static void RSHIFT() { word u = pop(); push(pop()>>u); } | static void RSHIFT() { word u = pop(); push(pop()>>u); } | ||||
static void LSHIFT() { word u = pop(); push(pop()<<u); } | static void LSHIFT() { word u = pop(); push(pop()<<u); } | ||||
static void TICKS() { usleep(pop()); } | |||||
static void native(NativeWord func) { | static void native(NativeWord func) { | ||||
vm.nativew[vm.nativew_count++] = func; | vm.nativew[vm.nativew_count++] = func; | ||||
@@ -316,11 +318,11 @@ VM* VM_init(char *blkfs_path) { | |||||
native(_br_); | native(_br_); | ||||
native(_cbr_); | native(_cbr_); | ||||
native(_loop_); | native(_loop_); | ||||
native(SP_to_R_2); | |||||
native(nlit); | native(nlit); | ||||
native(slit); | native(slit); | ||||
native(SP_to_R); | native(SP_to_R); | ||||
native(R_to_SP); | native(R_to_SP); | ||||
native(SP_to_R_2); | |||||
native(R_to_SP_2); | native(R_to_SP_2); | ||||
native(EXECUTE); | native(EXECUTE); | ||||
native(ROT); | native(ROT); | ||||
@@ -367,6 +369,7 @@ VM* VM_init(char *blkfs_path) { | |||||
native(MINUS2); | native(MINUS2); | ||||
native(RSHIFT); | native(RSHIFT); | ||||
native(LSHIFT); | native(LSHIFT); | ||||
native(TICKS); | |||||
vm.IP = gw(0x04) + 1; // BOOT | vm.IP = gw(0x04) + 1; // BOOT | ||||
sw(SYSVARS+0x02, gw(0x08)); // CURRENT | sw(SYSVARS+0x02, gw(0x08)); // CURRENT | ||||
sw(SYSVARS+0x04, gw(0x08)); // HERE | sw(SYSVARS+0x04, gw(0x08)); // HERE | ||||
@@ -17,11 +17,11 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) | |||||
0x01 CODE (br) | 0x01 CODE (br) | ||||
0x02 CODE (?br) | 0x02 CODE (?br) | ||||
0x03 CODE (loop) | 0x03 CODE (loop) | ||||
0x05 CODE (n) | |||||
0x06 CODE (s) | |||||
0x04 CODE 2>R | |||||
0x07 CODE >R | |||||
0x08 CODE R> | |||||
0x04 CODE (n) | |||||
0x05 CODE (s) | |||||
0x06 CODE >R | |||||
0x07 CODE R> | |||||
0x08 CODE 2>R | |||||
0x09 CODE 2R> | 0x09 CODE 2R> | ||||
0x0a CODE EXECUTE | 0x0a CODE EXECUTE | ||||
0x0b CODE ROT | 0x0b CODE ROT | ||||
@@ -68,6 +68,7 @@ H@ 4 + XCURRENT ! ( make next CODE have 0 prev field ) | |||||
0x34 CODE 2- | 0x34 CODE 2- | ||||
0x35 CODE RSHIFT | 0x35 CODE RSHIFT | ||||
0x36 CODE LSHIFT | 0x36 CODE LSHIFT | ||||
0x37 CODE TICKS | |||||
353 LOAD ( xcomp core low ) | 353 LOAD ( xcomp core low ) | ||||
: (emit) 0 PC! ; | : (emit) 0 PC! ; | ||||
: (key) 0 PC@ ; | : (key) 0 PC@ ; | ||||
@@ -242,9 +242,6 @@ S= a1 a2 -- f Returns whether string a1 == a2. | |||||
call to (print). | call to (print). | ||||
C<? -- f Returns whether there's a char waiting in buf. | C<? -- f Returns whether there's a char waiting in buf. | ||||
C< -- c Read one char from buffered input. | C< -- c Read one char from buffered input. | ||||
DUMP n a -- Prints n bytes at addr a in a hexdump format. | |||||
Prints in chunks of 8 bytes. Doesn't do partial | |||||
lines. Output is designed to fit in 32 columns. | |||||
EMIT c -- Spit char c to output stream | EMIT c -- Spit char c to output stream | ||||
IN> -- a Address of variable containing current pos in | IN> -- a Address of variable containing current pos in | ||||
input buffer. | input buffer. | ||||
@@ -270,7 +267,6 @@ BLK( -- a Beginning addr of blk buf. | |||||
BLK) -- a Ending addr of blk buf. | BLK) -- a Ending addr of blk buf. | ||||
COPY s d -- Copy contents of s block to d block. | COPY s d -- Copy contents of s block to d block. | ||||
FLUSH -- Write current block to disk if dirty. | FLUSH -- Write current block to disk if dirty. | ||||
FREEBLKS? a b -- List free blocks between blocks a and b. | |||||
LIST n -- Prints the contents of the block n on screen | LIST n -- Prints the contents of the block n on screen | ||||
in the form of 16 lines of 64 columns. | in the form of 16 lines of 64 columns. | ||||
LOAD n -- Interprets Forth code from block n | LOAD n -- Interprets Forth code from block n | ||||
@@ -279,3 +275,11 @@ LOADR n1 n2 -- Load block range between n1 and n2, inclusive. | |||||
LOADR+ n1 n2 -- Relative ranged load. | LOADR+ n1 n2 -- Relative ranged load. | ||||
WIPE -- Empties current block | WIPE -- Empties current block | ||||
WIPED? -- f Whether current block is empty | WIPED? -- f Whether current block is empty | ||||
# Other | |||||
DUMP n a -- Prints n bytes at addr a in a hexdump format. | |||||
Prints in chunks of 8 bytes. Doesn't do partial | |||||
lines. Output is designed to fit in 32 columns. | |||||
TICKS n -- Wait for approximately 0.1 millisecond. Don't | |||||
use with n=0. |
@@ -3,7 +3,7 @@ | |||||
RS_ADDR 0x80 - CONSTANT SYSVARS | RS_ADDR 0x80 - CONSTANT SYSVARS | ||||
30 LOAD ( 8086 asm ) | 30 LOAD ( 8086 asm ) | ||||
262 LOAD ( xcomp ) 270 LOAD ( xcomp overrides ) | 262 LOAD ( xcomp ) 270 LOAD ( xcomp overrides ) | ||||
445 460 LOADR ( 8086 boot code ) | |||||
445 461 LOADR ( 8086 boot code ) | |||||
353 LOAD ( xcomp core low ) | 353 LOAD ( xcomp core low ) | ||||
604 LOAD ( KEY/EMIT drivers ) | 604 LOAD ( KEY/EMIT drivers ) | ||||
606 608 LOADR ( BLK drivers ) | 606 608 LOADR ( BLK drivers ) | ||||