emu48-mirror/sources/Emu48/RPL.C
2024-03-19 22:25:45 +01:00

277 lines
6.6 KiB
C

/*
* rpl.c
*
* This file is part of Emu48
*
* Copyright (C) 1995 Sebastien Carlier
*
*/
#include "pch.h"
#include "Emu48.h"
//| 38G | 48SX | 48GX | 49G | Name
// #7056A #806E9 #806E9 =TEMPOB
// #7056F #806EE #806EE =TEMPTOP
//#F0692 #70574 #806F3 #806F3 =RSKTOP (B)
//#F0697 #70579 #806F8 #806F8 =DSKTOP (D1)
//#F0DEA #7066E #807ED #80E9B =AVMEM (D)
//#F0705 #705B0 #8072F #8076B =INTRPPTR (D0)
#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 AVMEM ((cCurrentRomType!='X')?((cCurrentRomType=='S')?0x7066E:0x807ED):0x80E9B)
#define INTRPPTR ((cCurrentRomType!='X')?((cCurrentRomType=='S')?0x705B0:0x8072F):0x8076B)
DWORD RPL_SkipOb(DWORD d)
{
BYTE X[8];
DWORD n, l;
Npeek(X,d,5);
n = Npack(X, 5); // read prolog
switch (n)
{
case 0x026AC: l = (cCurrentRomType!='X') ? 5 : 12; break; // Flash PTR (HP49G)
case 0x02911: l = 10; break; // System Binary
case 0x02933: l = 21; break; // Real
case 0x02955: l = 26; break; // Long Real
case 0x02977: l = 37; break; // Complex
case 0x0299D: l = 47; break; // Long Complex
case 0x029BF: l = 7; break; // Character
case 0x02BAA: l = 15; break; // Extended Pointer
case 0x02E92: l = 11; break; // XLIB Name
case 0x02686: // Symbolic matrix (HP49G)
if (cCurrentRomType!='X')
{
l = 5;
break;
}
case 0x02A74: // List
case 0x02AB8: // Algebraic
case 0x02ADA: // Unit
case 0x02D9D: // Program
n=d+5;
do
{
d=n; n=RPL_SkipOb(d);
} while (d!=n);
return n+5;
case 0x0312B: return d; // SEMI
case 0x02E48: // Global Name
case 0x02E6D: // Local Name
case 0x02AFC: // Tagged
Npeek(X,d+5,2); n = 7 + Npack(X,2)*2;
return RPL_SkipOb(d+n);
case 0x02A96: // 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 0x02614: // Precision Integer (HP49G)
case 0x026D5: // Aplet (HP49G)
case 0x026FE: // Mini Font (HP49G)
if (cCurrentRomType!='X')
{
l = 5;
break;
}
case 0x029E8: // Array
case 0x02A0A: // Linked Array
case 0x02A2C: // String
case 0x02A4E: // Binary Integer
case 0x02B1E: // Graphic
case 0x02B40: // Library
case 0x02B62: // Backup
case 0x02B88: // Library Data
case 0x02BCC: // Reserved 1, Font (HP49G)
case 0x02BEE: // Reserved 2
case 0x02C10: // Reserved 3
case 0x02DCC: // Code
l = 5+Read5(d+5);
break;
case 0x0263A: // Precision Real (HP49G)
l = 5;
if (cCurrentRomType=='X')
{
l += Read5(d+l);
l += Read5(d+l);
}
break;
case 0x02660: // 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 n, l = 0;
n = Npack(o, 5); // read prolog
switch (n)
{
case 0x026AC: l = (cCurrentRomType!='X') ? 5 : 12; break; // Flash PTR (HP49G)
case 0x02911: l = 10; break; // System Binary
case 0x02933: l = 21; break; // Real
case 0x02955: l = 26; break; // Long Real
case 0x02977: l = 37; break; // Complex
case 0x0299D: l = 47; break; // Long Complex
case 0x029BF: l = 7; break; // Character
case 0x02BAA: l = 15; break; // Extended Pointer
case 0x02E92: l = 11; break; // XLIB Name
case 0x02686: // Symbolic matrix (HP49G)
if (cCurrentRomType!='X')
{
l = 5;
break;
}
case 0x02A74: // List
case 0x02AB8: // Algebraic
case 0x02ADA: // Unit
case 0x02D9D: // Program
n=5;
do { l+=n; o+=n; n=RPL_ObjectSize(o); } while (n);
l += 5;
break;
case 0x0312B: l = 0; break; // SEMI
case 0x02E48: // Global Name
case 0x02E6D: // Local Name
case 0x02AFC: // Tagged
n = 7 + Npack(o+5,2)*2;
l = n + RPL_ObjectSize(o+n);
break;
case 0x02A96: // Directory
n = Npack(o+8,5);
if (n==0) // empty dir
{
l=13;
}
else
{
l = 8+n;
n = Npack(o+l,2)*2 + 4;
l += n;
l += RPL_ObjectSize(o+l);
}
break;
case 0x02614: // Precision Integer (HP49G)
case 0x026D5: // Aplet (HP49G)
case 0x026FE: // Mini Font (HP49G)
if (cCurrentRomType!='X')
{
l = 5;
break;
}
case 0x029E8: // Array
case 0x02A0A: // Linked Array
case 0x02A2C: // String
case 0x02A4E: // Binary Integer
case 0x02B1E: // Graphic
case 0x02B40: // Library
case 0x02B62: // Backup
case 0x02B88: // Library Data
case 0x02BCC: // Reserved 1, Font (HP49G)
case 0x02BEE: // Reserved 2
case 0x02C10: // Reserved 3
case 0x02DCC: // Code
l = 5 + Npack(o+5,5);
break;
case 0x0263A: // Precision Real (HP49G)
l = 5;
if (cCurrentRomType=='X')
{
l += Npack(o+l,5);
l += Npack(o+l,5);
}
break;
case 0x02660: // Precision Complex (HP49G)
l = 5;
if (cCurrentRomType=='X')
{
l += Npack(o+l,5);
l += Npack(o+l,5);
l += Npack(o+l,5);
l += Npack(o+l,5);
}
break;
default: l=5;
}
return l;
}
DWORD RPL_CreateTemp(DWORD l)
{
DWORD a, b, c;
BYTE *p;
l += 6;
a = Read5(TEMPTOP);
b = Read5(RSKTOP); // start of available mem
c = Read5(DSKTOP); // end of available mem
if ((b+l)>c) return 0; // check if there is enough memory
Write5(TEMPTOP, a+l); // adjust end of temporary objects
Write5(RSKTOP, b+l); // adjust start of available mem
Write5(AVMEM, (c-(b+l))/5); // free memory (*5 nibbles)
p = (BYTE*)LocalAlloc(0,b-a);
Npeek(p,a,b-a);
Nwrite(p,a+l,b-a);
LocalFree(p);
Write5(a+l-5,l); // set temporary object length field
return (a+1); // return temporary object address
}
DWORD RPL_Pick(UINT l)
{
DWORD stkp;
_ASSERT(l > 0); // first stack elememt is one
if (l==0) return 0;
stkp = Read5(DSKTOP) + (l-1)*5;
return Read5(stkp);
}
#if 0 // function not needed yet
VOID RPL_Replace(DWORD n)
{
DWORD stkp;
stkp = Read5(DSKTOP);
Write5(stkp,n);
return;
}
#endif
VOID RPL_Push(DWORD n)
{
DWORD stkp, avmem;
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
stkp = Read5(DSKTOP); // get pointer to stack level 1
stkp-=5; // fetch new stack entry
Write5(stkp,n); // save pointer to new object on stack level 1
Write5(DSKTOP,stkp); // save new pointer to stack level 1
return;
}