453 lines
13 KiB
C
453 lines
13 KiB
C
/*
|
|
* rpl.c
|
|
*
|
|
* This file is part of Emu48
|
|
*
|
|
* Copyright (C) 1995 Sebastien Carlier
|
|
*
|
|
*/
|
|
#include "pch.h"
|
|
#include "Emu48.h"
|
|
#include "ops.h"
|
|
#include "io.h"
|
|
|
|
//| 38G | 39G | 40G | 48SX | 48GX | 49G | Name
|
|
//#F0688 #806E9 #806E9 #7056A #806E9 #806E9 =TEMPOB
|
|
//#F068D #806EE #806EE #7056F #806EE #806EE =TEMPTOP
|
|
//#F0692 #806F3 #806F3 #70574 #806F3 #806F3 =RSKTOP (B)
|
|
//#F0697 #806F8 #806F8 #70579 #806F8 #806F8 =DSKTOP (D1)
|
|
//#F069C #806FD #806FD #7057E #806FD #806FD =EDITLINE
|
|
//#F0DEA #80E9B #80E9B #7066E #807ED #80E9B =AVMEM (D)
|
|
//#F0705 #8076B #8076B #705B0 #8072F #8076B =INTRPPTR (D0)
|
|
//#F0E42 #80F02 #80F02 #706C5 #80843 #80F02 =SystemFlags
|
|
|
|
#define TEMPOB ((cCurrentRomType=='S')?0x7056A:0x806E9)
|
|
#define TEMPTOP ((cCurrentRomType=='S')?0x7056F:0x806EE)
|
|
#define RSKTOP ((cCurrentRomType=='S')?0x70574:0x806F3)
|
|
#define DSKTOP ((cCurrentRomType=='S')?0x70579:0x806F8)
|
|
#define EDITLINE ((cCurrentRomType=='S')?0x7057E:0x806FD)
|
|
#define AVMEM ((cCurrentRomType!='X')?((cCurrentRomType=='S')?0x7066E:0x807ED):0x80E9B)
|
|
#define INTRPPTR ((cCurrentRomType!='X')?((cCurrentRomType=='S')?0x705B0:0x8072F):0x8076B)
|
|
#define SYSTEMFLAGS ((cCurrentRomType!='X')?((cCurrentRomType=='S')?0x706C5:0x80843):0x80F02)
|
|
|
|
#define DOINT 0x02614 // Precision Integer (HP49G)
|
|
#define DOLNGREAL 0x0263A // Precision Real (HP49G)
|
|
#define DOLNGCMP 0x02660 // Precision Complex (HP49G)
|
|
#define DOMATRIX 0x02686 // Symbolic matrix (HP49G)
|
|
#define DOFLASHP 0x026AC // Flash PTR (HP49G)
|
|
#define DOAPLET 0x026D5 // Aplet (HP49G)
|
|
#define DOMINIFONT 0x026FE // Mini Font (HP49G)
|
|
#define DOBINT 0x02911 // System Binary
|
|
#define DOREAL 0x02933 // Real
|
|
#define DOEREL 0x02955 // Long Real
|
|
#define DOCMP 0x02977 // Complex
|
|
#define DOECMP 0x0299D // Long Complex
|
|
#define DOCHAR 0x029BF // Character
|
|
#define DOARRY 0x029E8 // Array
|
|
#define DOLNKARRY 0x02A0A // Linked Array
|
|
#define DOCSTR 0x02A2C // String
|
|
#define DOHSTR 0x02A4E // Binary Integer
|
|
#define DOLIST 0x02A74 // List
|
|
#define DORRP 0x02A96 // Directory
|
|
#define DOSYMB 0x02AB8 // Algebraic
|
|
#define DOEXT 0x02ADA // Unit
|
|
#define DOTAG 0x02AFC // Tagged
|
|
#define DOGROB 0x02B1E // Graphic
|
|
#define DOLIB 0x02B40 // Library
|
|
#define DOBAK 0x02B62 // Backup
|
|
#define DOEXT0 0x02B88 // Library Data
|
|
#define DOEXT1 0x02BAA // Reserved 1, ACcess PoinTeR (HP48GX and later)
|
|
#define DOEXT2 0x02BCC // Reserved 2, Font (HP49G)
|
|
#define DOEXT3 0x02BEE // Reserved 3
|
|
#define DOEXT4 0x02C10 // Reserved 4
|
|
#define DOCOL 0x02D9D // Program
|
|
#define DOCODE 0x02DCC // Code
|
|
#define DOIDNT 0x02E48 // Global Name
|
|
#define DOLAM 0x02E6D // Local Name
|
|
#define DOROMP 0x02E92 // XLIB Name
|
|
#define SEMI 0x0312B // ;
|
|
|
|
#define GARBAGECOL 0x0613E // =GARBAGECOL entry for HP48S/G and HP49G
|
|
|
|
// check for Metakernel version
|
|
#define METAKERNEL Metakernel()
|
|
|
|
// search for "MDGKER:MK2.30" or "MDGKER:PREVIE" in port1 of a HP48GX
|
|
static BOOL Metakernel(VOID)
|
|
{
|
|
BOOL bMkDetect = FALSE;
|
|
|
|
// card in slot1 of a HP48GX enabled
|
|
if (cCurrentRomType=='G' && Chipset.Port1 && Chipset.cards_status & PORT1_PRESENT)
|
|
{
|
|
// check for Metakernel string "MDGKER:"
|
|
if (!strncmp(&Chipset.Port1[12],"\xD\x4\x4\x4\x7\x4\xB\x4\x5\x4\x2\x5\xA\x3",14))
|
|
{
|
|
bMkDetect = TRUE; // Metakernel detected
|
|
// check for "MK"
|
|
if (!strncmp(&Chipset.Port1[26],"\xD\x4\xB\x4",4))
|
|
{
|
|
// get version number
|
|
WORD wVersion = ((Chipset.Port1[30] * 10) + Chipset.Port1[34]) * 10
|
|
+ Chipset.Port1[36];
|
|
|
|
// version newer then V2.30, then compatible with HP OS
|
|
bMkDetect = (wVersion <= 230);
|
|
}
|
|
}
|
|
}
|
|
return bMkDetect;
|
|
}
|
|
|
|
static DWORD RPL_GarbageCol(VOID) // RPL variables must be in system RAM
|
|
{
|
|
CHIPSET OrgChipset;
|
|
DWORD dwAVMEM;
|
|
|
|
// only for HP48SX, HP48GX and HP49G
|
|
_ASSERT(cCurrentRomType == 'S' || cCurrentRomType == 'G' || cCurrentRomType == 'X');
|
|
|
|
OrgChipset = Chipset; // save original chipset
|
|
|
|
// entry for =GARBAGECOL
|
|
Chipset.P = 0; // P=0
|
|
Chipset.mode_dec = FALSE; // hex mode
|
|
Chipset.pc = GARBAGECOL; // =GARBAGECOL entry
|
|
rstkpush(0xFFFFF); // return address for stopping
|
|
|
|
while (Chipset.pc != 0xFFFFF) // wait for stop address
|
|
{
|
|
EvalOpcode(FASTPTR(Chipset.pc)); // execute opcode
|
|
}
|
|
|
|
dwAVMEM = Npack(Chipset.C,5); // available AVMEM
|
|
Chipset = OrgChipset; // restore original chipset
|
|
return dwAVMEM;
|
|
}
|
|
|
|
BOOL RPL_GetSystemFlag(INT nFlag)
|
|
{
|
|
DWORD dwAddr;
|
|
BYTE byMask,byFlag;
|
|
|
|
_ASSERT(nFlag > 0); // first flag is 1
|
|
|
|
// calculate memory address and bit mask
|
|
dwAddr = SYSTEMFLAGS + (nFlag - 1) / 4;
|
|
byMask = 1 << ((nFlag - 1) & 0x3);
|
|
|
|
Npeek(&byFlag,dwAddr,sizeof(byFlag));
|
|
return (byFlag & byMask) != 0;
|
|
}
|
|
|
|
DWORD RPL_SkipOb(DWORD d)
|
|
{
|
|
BYTE X[8];
|
|
DWORD n, l;
|
|
|
|
Npeek(X,d,5);
|
|
n = Npack(X, 5); // read prolog
|
|
switch (n)
|
|
{
|
|
case DOFLASHP: l = (cCurrentRomType!='X') ? 5 : 12; break; // Flash PTR (HP49G)
|
|
case DOBINT: l = 10; break; // System Binary
|
|
case DOREAL: l = 21; break; // Real
|
|
case DOEREL: l = 26; break; // Long Real
|
|
case DOCMP: l = 37; break; // Complex
|
|
case DOECMP: l = 47; break; // Long Complex
|
|
case DOCHAR: l = 7; break; // Character
|
|
case DOROMP: l = 11; break; // XLIB Name
|
|
case DOMATRIX: // Symbolic matrix (HP49G)
|
|
if (cCurrentRomType!='X')
|
|
{
|
|
l = 5;
|
|
break;
|
|
}
|
|
case DOLIST: // List
|
|
case DOSYMB: // Algebraic
|
|
case DOEXT: // Unit
|
|
case DOCOL: // Program
|
|
n=d+5;
|
|
do
|
|
{
|
|
d=n; n=RPL_SkipOb(d);
|
|
} while (d!=n);
|
|
return n+5;
|
|
case SEMI: return d; // SEMI
|
|
case DOIDNT: // Global Name
|
|
case DOLAM: // Local Name
|
|
case DOTAG: // Tagged
|
|
Npeek(X,d+5,2); n = 7 + Npack(X,2)*2;
|
|
return RPL_SkipOb(d+n);
|
|
case DORRP: // Directory
|
|
d+=8;
|
|
n = Read5(d);
|
|
if (n==0)
|
|
{
|
|
return d+5;
|
|
}
|
|
else
|
|
{
|
|
d+=n;
|
|
Npeek(X,d,2);
|
|
n = Npack(X,2)*2 + 4;
|
|
return RPL_SkipOb(d+n);
|
|
}
|
|
case DOINT: // Precision Integer (HP49G)
|
|
case DOAPLET: // Aplet (HP49G)
|
|
case DOMINIFONT: // Mini Font (HP49G)
|
|
if (cCurrentRomType!='X')
|
|
{
|
|
l = 5;
|
|
break;
|
|
}
|
|
case DOARRY: // Array
|
|
case DOLNKARRY: // Linked Array
|
|
case DOCSTR: // String
|
|
case DOHSTR: // Binary Integer
|
|
case DOGROB: // Graphic
|
|
case DOLIB: // Library
|
|
case DOBAK: // Backup
|
|
case DOEXT0: // Library Data
|
|
case DOEXT1: // Reserved 1
|
|
if (n == DOEXT1 && cCurrentRomType != 'S')
|
|
{
|
|
// on HP48G series and later interpreted as DOACPTR
|
|
l = 15; break; // ACcess PoinTeR
|
|
break;
|
|
}
|
|
case DOEXT2: // Reserved 2, Font (HP49G)
|
|
case DOEXT3: // Reserved 3
|
|
case DOEXT4: // Reserved 4
|
|
case DOCODE: // Code
|
|
l = 5+Read5(d+5);
|
|
break;
|
|
case DOLNGREAL: // Precision Real (HP49G)
|
|
l = 5;
|
|
if (cCurrentRomType=='X')
|
|
{
|
|
l += Read5(d+l);
|
|
l += Read5(d+l);
|
|
}
|
|
break;
|
|
case DOLNGCMP: // Precision Complex (HP49G)
|
|
l = 5;
|
|
if (cCurrentRomType=='X')
|
|
{
|
|
l += Read5(d+l);
|
|
l += Read5(d+l);
|
|
l += Read5(d+l);
|
|
l += Read5(d+l);
|
|
}
|
|
break;
|
|
default: return d+5;
|
|
}
|
|
return d+l;
|
|
}
|
|
|
|
DWORD RPL_ObjectSize(BYTE *o,DWORD s)
|
|
{
|
|
DWORD n, l = 0;
|
|
|
|
if (s < 5) return BAD_OB; // size too small for prolog
|
|
n = Npack(o,5); // read prolog
|
|
switch (n)
|
|
{
|
|
case DOFLASHP: l = (cCurrentRomType!='X') ? 5 : 12; break; // Flash PTR (HP49G)
|
|
case DOBINT: l = 10; break; // System Binary
|
|
case DOREAL: l = 21; break; // Real
|
|
case DOEREL: l = 26; break; // Long Real
|
|
case DOCMP: l = 37; break; // Complex
|
|
case DOECMP: l = 47; break; // Long Complex
|
|
case DOCHAR: l = 7; break; // Character
|
|
case DOROMP: l = 11; break; // XLIB Name
|
|
case DOMATRIX: // Symbolic matrix (HP49G)
|
|
if (cCurrentRomType!='X')
|
|
{
|
|
l = 5;
|
|
break;
|
|
}
|
|
case DOLIST: // List
|
|
case DOSYMB: // Algebraic
|
|
case DOEXT: // Unit
|
|
case DOCOL: // Program
|
|
n = 5; // prolog length
|
|
do
|
|
{
|
|
l += n;
|
|
if (l > s) return BAD_OB; // prevent negative size argument
|
|
n = RPL_ObjectSize(o+l,s-l); // get new object
|
|
if (n == BAD_OB) return BAD_OB; // buffer overflow
|
|
}
|
|
while (n);
|
|
l += 5;
|
|
break;
|
|
case SEMI: l = 0; break; // SEMI
|
|
case DOIDNT: // Global Name
|
|
case DOLAM: // Local Name
|
|
case DOTAG: // Tagged
|
|
if (s < 5 + 2) return BAD_OB;
|
|
l = 7 + Npack(o+5,2) * 2; // prolog + name length
|
|
if (l > s) return BAD_OB; // prevent negative size argument
|
|
n = RPL_ObjectSize(o+l,s-l); // get new object
|
|
if (n == BAD_OB) return BAD_OB; // buffer overflow
|
|
l += n;
|
|
break;
|
|
case DORRP: // Directory
|
|
if (s < 8 + 5) return BAD_OB;
|
|
n = Npack(o+8,5);
|
|
if (n == 0) // empty dir
|
|
{
|
|
l = 13;
|
|
}
|
|
else
|
|
{
|
|
l = 8 + n;
|
|
if (s < l + 2) return BAD_OB;
|
|
n = Npack(o+l,2) * 2 + 4;
|
|
l += n;
|
|
if (l > s) return BAD_OB; // prevent negative size argument
|
|
n = RPL_ObjectSize(o+l,s-l); // next rrp
|
|
if (n == BAD_OB) return BAD_OB; // buffer overflow
|
|
l += n;
|
|
}
|
|
break;
|
|
case DOINT: // Precision Integer (HP49G)
|
|
case DOAPLET: // Aplet (HP49G)
|
|
case DOMINIFONT: // Mini Font (HP49G)
|
|
if (cCurrentRomType!='X')
|
|
{
|
|
l = 5;
|
|
break;
|
|
}
|
|
case DOARRY: // Array
|
|
case DOLNKARRY: // Linked Array
|
|
case DOCSTR: // String
|
|
case DOHSTR: // Binary Integer
|
|
case DOGROB: // Graphic
|
|
case DOLIB: // Library
|
|
case DOBAK: // Backup
|
|
case DOEXT0: // Library Data
|
|
case DOEXT1: // Reserved 1
|
|
if (n == DOEXT1 && cCurrentRomType != 'S')
|
|
{
|
|
// on HP48G series and later interpreted as DOACPTR
|
|
l = 15; break; // ACcess PoinTeR
|
|
break;
|
|
}
|
|
case DOEXT2: // Reserved 2, Font (HP49G)
|
|
case DOEXT3: // Reserved 3
|
|
case DOEXT4: // Reserved 4
|
|
case DOCODE: // Code
|
|
if (s < 5 + 5) return BAD_OB;
|
|
l = 5 + Npack(o+5,5);
|
|
break;
|
|
case DOLNGREAL: // Precision Real (HP49G)
|
|
l = 5;
|
|
if (cCurrentRomType=='X')
|
|
{
|
|
if (s < l + 5) return BAD_OB;
|
|
l += Npack(o+l,5);
|
|
if (s < l + 5) return BAD_OB;
|
|
l += Npack(o+l,5);
|
|
}
|
|
break;
|
|
case DOLNGCMP: // Precision Complex (HP49G)
|
|
l = 5;
|
|
if (cCurrentRomType=='X')
|
|
{
|
|
if (s < l + 5) return BAD_OB;
|
|
l += Npack(o+l,5);
|
|
if (s < l + 5) return BAD_OB;
|
|
l += Npack(o+l,5);
|
|
if (s < l + 5) return BAD_OB;
|
|
l += Npack(o+l,5);
|
|
if (s < l + 5) return BAD_OB;
|
|
l += Npack(o+l,5);
|
|
}
|
|
break;
|
|
default: l = 5;
|
|
}
|
|
return (s >= l) ? l : BAD_OB;
|
|
}
|
|
|
|
DWORD RPL_CreateTemp(DWORD l)
|
|
{
|
|
DWORD a, b, c;
|
|
BYTE *p;
|
|
|
|
l += 6; // memory for link field (5) + marker (1) and end
|
|
b = Read5(RSKTOP); // tail address of rtn stack
|
|
c = Read5(DSKTOP); // top of data stack
|
|
if ((b+l)>c) // there's not enough memory to move DSKTOP
|
|
{
|
|
RPL_GarbageCol(); // do a garbage collection
|
|
b = Read5(RSKTOP); // reload tail address of rtn stack
|
|
c = Read5(DSKTOP); // reload top of data stack
|
|
}
|
|
if ((b+l)>c) return 0; // check if now there's enough memory to move DSKTOP
|
|
a = Read5(TEMPTOP); // tail address of top object
|
|
Write5(TEMPTOP, a+l); // adjust new end of top object
|
|
Write5(RSKTOP, b+l); // adjust new end of rtn stack
|
|
Write5(AVMEM, (c-b-l)/5); // calculate free memory (*5 nibbles)
|
|
p = HeapAlloc(hHeap,0,b-a); // move down rtn stack
|
|
Npeek(p,a,b-a);
|
|
Nwrite(p,a+l,b-a);
|
|
HeapFree(hHeap,0,p);
|
|
Write5(a+l-5,l); // set object length field
|
|
return (a+1); // return base address of new object
|
|
}
|
|
|
|
UINT RPL_Depth(VOID)
|
|
{
|
|
return (Read5(EDITLINE) - Read5(DSKTOP)) / 5 - 1;
|
|
}
|
|
|
|
DWORD RPL_Pick(UINT l)
|
|
{
|
|
DWORD stkp;
|
|
|
|
_ASSERT(l > 0); // first stack element is one
|
|
if (l == 0) return 0;
|
|
if (METAKERNEL) ++l; // Metakernel support
|
|
if (RPL_Depth() < l) return 0; // not enough elements on stack
|
|
stkp = Read5(DSKTOP) + (l-1)*5;
|
|
return Read5(stkp); // return object address
|
|
}
|
|
|
|
VOID RPL_Replace(DWORD n)
|
|
{
|
|
DWORD stkp;
|
|
|
|
stkp = Read5(DSKTOP);
|
|
if (METAKERNEL) stkp+=5; // Metakernel support
|
|
Write5(stkp,n);
|
|
return;
|
|
}
|
|
|
|
VOID RPL_Push(UINT l,DWORD n)
|
|
{
|
|
UINT i;
|
|
DWORD stkp, avmem;
|
|
|
|
if (l > RPL_Depth() + 1) return; // invalid stack level
|
|
|
|
avmem = Read5(AVMEM); // amount of free memory
|
|
if (avmem == 0) return; // no memory free
|
|
avmem--; // fetch memory
|
|
Write5(AVMEM,avmem); // save new amount of free memory
|
|
|
|
if (METAKERNEL) ++l; // Metakernel, save MK object on stack level 1
|
|
|
|
stkp = Read5(DSKTOP) - 5; // get pointer of new stack level 1
|
|
Write5(DSKTOP,stkp); // save it
|
|
|
|
for (i = 1; i < l; ++i) // move down stack level entries before insert pos
|
|
{
|
|
Write5(stkp,Read5(stkp+5)); // move down stack level entry
|
|
stkp += 5; // next stack entry
|
|
}
|
|
|
|
Write5(stkp,n); // save pointer of new object on given stack level
|
|
return;
|
|
}
|