1
0
mirror of https://github.com/dschmenk/PLASMA.git synced 2026-04-20 01:16:36 +00:00

Add binary format to numbers in PLFORTH and cleant up some plvm code

This commit is contained in:
David Schmenk
2025-01-19 16:14:42 -08:00
parent 4c4924a34b
commit b4d8f463a1
4 changed files with 69 additions and 25 deletions
+46 -3
View File
@@ -99,7 +99,8 @@ predef _cmove_(a,b,c)#0, _move_(a,b,c)#0, _fill_(a,b,c)#0, _plasma_(a)#0
predef _compare_(a,b,c,d)#1, _var_(a)#0, _const_(a)#0, _lit_#1, _slit_#1, _find_(a)#2
predef _tick_#0, _forget_#0, _keypressed_#1, _key_#1, _prat_(a)#0
predef _blank_#0, _char_#0, _str_#0, _prstr_#0, _prpstr_#0
predef _prval_(a)#0, _prbyte_(a)#0, _prhex_(a)#0, _accept_(a,b)#1, _type_(a,b)#0
predef _prval_(a)#0, _prbyte_(a)#0, _prhex_(a)#0, _prbin_(a)#0, _prbinw_(a)#0
predef _accept_(a,b)#1, _type_(a,b)#0
predef _words_#0, _tron_#0, _troff_#0, _stepon_#0, _stepoff_#0
predef _itc_#0, _pbc_#0, _comment_#0, _src_(a)#0, _srcstr_#0, _endsrc_#0, _ifendsrc_(a)#0
predef _brk_#0, _brkon_#0, _brkoff_#0, _word_(a)#1, _count_(a)#2
@@ -591,10 +592,18 @@ word = @d_prtos, 0, @_prhex_
char d_prtosbyte = "C$."
byte = 0
word = @d_prtoshex, 0, @_prbyte_
// PRINT TOS BINARY
char d_prtosbinw = "%."
byte = 0
word = @d_prtosbyte, 0, @_prbinw_
// PRINT TOS BINARY BYTE
char d_prtosbin = "C%."
byte = 0
word = @d_prtosbinw, 0, @_prbin_
// EMIT
char d_emit = "EMIT"
byte = 0
word = @d_prtosbyte, 0, @putc
word = @d_prtosbin, 0, @putc
// CR
char d_cr = "CR"
byte = showcr_flag
@@ -952,7 +961,7 @@ def _isnum_(numchars, numlen)#2
fin
fin
num = 0
if ^numchars == '$'
if ^numchars == '$' // Hexadecimal
numchars++
numlen--
if numlen == 0
@@ -970,6 +979,22 @@ def _isnum_(numchars, numlen)#2
numchars++
numlen--
loop
elsif ^numchars == '%' // Binary
numchars++
numlen--
if numlen == 0
return 0, 0
fin
while numlen
numchar = ^numchars
if numchar == '0' or numchar == '1'
num = num * 2 + numchar - '0'
else
break
fin
numchars++
numlen--
loop
else
while numlen
numchar = ^numchars
@@ -1736,6 +1761,24 @@ end
def _prhex_(a)#0
putc('$'); puth(a); putc(' ')
end
def _prbin_(a)#0
byte i
putc('%')
for i = 0 to 7
putc(a & $80 ?? '1' :: '0')
a = a << 1
next
putc(' ')
end
def _prbinw_(a)#0
byte i
putc('%')
for i = 0 to 15
putc(a & $8000 ?? '1' :: '0')
a = a << 1
next
putc(' ')
end
def _prat_(a)#0
puti(*a); putc(' ')
end
+2 -2
View File
@@ -297,7 +297,7 @@ uword lookup_def(defxlat_t *defxtbl, uword ofst)
defxtbl++;
return defxtbl->defaddr;
}
uword add_natv( VM_Callout natvfn)
uword add_natv(VM_Callout natvfn)
{
uword handle, defaddr;
handle = vm_addnatv(natvfn);
@@ -959,7 +959,7 @@ int main(int argc, char **argv)
mem_6502[0x01FE] = 0xFF; // Address of $FF (RTN) instruction
mem_6502[0x01FD] = 0xFE;
mpu->registers->s = 0xFC;
mpu->registers->x = ESTK_SIZE;
mpu->registers->x = ESTK_DEPTH;
//
// Load module from command line - PLVM version
//
+18 -17
View File
@@ -70,9 +70,9 @@ int vm_indef(M6502 *mpu, uword address, byte data)
uword addr;
addr = mem_6502[++mpu->registers->s + 0x0100];
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call inline def: SP LSB underflow");
addr |= mem_6502[++mpu->registers->s + 0x0100] << 8;
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call inline def: SP MSB underflow");
vm_interp(mpu, &mem_6502[addr + 1]);
RTS;
}
@@ -81,9 +81,9 @@ int vm_iidef(M6502 *mpu, uword address, byte data)
uword addr;
addr = mem_6502[++mpu->registers->s + 0x0100];
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call indirect def: SP LSB underflow");
addr |= mem_6502[++mpu->registers->s + 0x0100] << 8;
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call indirect def: SP MSB underflow");
vm_interp(mpu, mem_6502 + UWORD_PTR(&mem_6502[addr + 1]));
RTS;
}
@@ -95,9 +95,9 @@ int vm_exdef(M6502 *mpu, uword address, byte data)
uword addr;
addr = mem_6502[++mpu->registers->s + 0x0100];
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call ext def: SP LSB underflow");
addr |= mem_6502[++mpu->registers->s + 0x0100] << 8;
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call ext def: SP MSB underflow");
vm_interp(mpu, vm_def[UWORD_PTR(&mem_6502[addr + 1])]);
RTS;
}
@@ -109,9 +109,9 @@ int vm_natvdef(M6502 *mpu, uword address, byte data)
uword addr;
addr = mem_6502[++mpu->registers->s + 0x0100];
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call native def: SP LSB underflow");
addr |= mem_6502[++mpu->registers->s + 0x0100] << 8;
if (!mpu->registers->s) pfail("SP underflow");
if (!mpu->registers->s) pfail("Call native def: SP MSB underflow");
vm_natv[mem_6502[addr + 1]](mpu);
RTS;
}
@@ -145,17 +145,17 @@ OPTBL DW CN,CN,CN,CN,CN,CN,CN,CN ; 00 02 04 06
#define internalize() \
vm_fp = UWORD_PTR(&mem_6502[FP]); \
vm_pp = UWORD_PTR(&mem_6502[PP]); \
esp = &eval_stack[ESTK_SIZE]; \
for (val = ESTK_SIZE - 1; val >= mpu->registers->x; val--) \
esp = &eval_stack[ESTK_DEPTH]; \
for (val = ESTK_DEPTH - 1; val >= mpu->registers->x; val--) \
PUSH(mem_6502[ESTKL + val] | (mem_6502[ESTKH + val] << 8))
#define externalize() \
mem_6502[FPL] = (byte)vm_fp; \
mem_6502[FPH] = (byte)(vm_fp >> 8); \
mem_6502[PPL] = (byte)vm_pp; \
mem_6502[PPH] = (byte)(vm_pp >> 8); \
ea = ESTK_SIZE-1; \
ea = ESTK_DEPTH-1; \
{ word *vm_sp; \
for (vm_sp = &eval_stack[ESTK_SIZE-1]; vm_sp >= esp; vm_sp--) { \
for (vm_sp = &eval_stack[ESTK_DEPTH-1]; vm_sp >= esp; vm_sp--) { \
mem_6502[ESTKL + ea] = (byte)*vm_sp; \
mem_6502[ESTKH + ea] = (byte)(*vm_sp >> 8); \
ea--; \
@@ -166,20 +166,21 @@ void vm_interp(M6502 *mpu, code *vm_ip)
{
int val, ea, frmsz, parmcnt;
uword vm_fp, vm_pp;
word eval_stack[ESTK_SIZE], *esp;
word eval_stack[ESTK_DEPTH], *esp;
internalize();
while (1)
{
if ((esp - eval_stack) < 0 || (esp - eval_stack) > ESTK_SIZE)
if ((esp - eval_stack) < 0 || (esp - eval_stack) > ESTK_DEPTH)
{
printf("Eval stack over/underflow! - $%04X: $%02X [%d]\r\n", (unsigned int)(vm_ip - mem_6502), (unsigned int)*vm_ip, (int)(ESTK_SIZE - (esp - eval_stack)));
exit(-1);
printf("Eval stack over/underflow! - $%04X: $%02X [%d]\r\n", (unsigned int)(vm_ip - mem_6502), (unsigned int)*vm_ip, (int)(ESTK_DEPTH - (esp - eval_stack)));
esp = &eval_stack[ESTK_DEPTH];
//exit(-1);
}
if (trace)
{
char cmdline[16];
word *dsp = &eval_stack[ESTK_SIZE - 1];
word *dsp = &eval_stack[ESTK_DEPTH - 1];
if (vm_ip >= mem_6502 && vm_ip < (mem_6502 + MEM6502_SIZE))
printf("$%04X: $%02X [ ", (unsigned int)(vm_ip - mem_6502), (unsigned int)*vm_ip);
else
+3 -3
View File
@@ -38,9 +38,9 @@ typedef uint16_t address;
{ \
uword pc; \
pc = mem_6502[++mpu->registers->s + 0x100]; \
if (!mpu->registers->s) pfail("SP underflow"); \
if (!mpu->registers->s) pfail("RTS: SP LSB underflow"); \
pc |= mem_6502[++mpu->registers->s + 0x100]<<8; \
if (!mpu->registers->s) pfail("SP underflow"); \
if (!mpu->registers->s) pfail("RTS: SP MSB underflow"); \
return pc + 1; \
}
/*
@@ -62,7 +62,7 @@ typedef uint16_t address;
* 6502 memory map
*/
#define MEM6502_SIZE 0x00010000
#define ESTK_SIZE 32
#define ESTK_DEPTH 32
#define CMDLINE_STR 0x01FF
#define CMDLINE_BUF 0x0200
#define SYSPATH_STR 0x0280