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:
+46
-3
@@ -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
@@ -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
@@ -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
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user