d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

Model 3 (Intelligent Calls) implemented (Remco Feenstra & Peter Boersma);

Browse source 
a few bugs fixed
This commit is contained in:
ceriel 1990-06-21 12:16:31 +00:00
parent c7c79e9b42
commit 4355b05597
17 changed files with 411 additions and 3147 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
util/int/ChangeLog
View file

@ -1,3 +1,10 @@
21-Jun-90 Ceriel Jacobs (ceriel) at ceriel
fixed bug in FEF: did not work on 0.0
20-Jun-90 Remco Feenstra & Peter Boersma
Implemented model 3 (intelligent calls)
Fixed bug in INN and SET
31-Jan-90 Ceriel Jacobs (ceriel) at ceriel 31-Jan-90 Ceriel Jacobs (ceriel) at ceriel
Fixed getpid() version of MON. Fixed getpid() version of MON.

8
util/int/TODO
View file

@ -1,11 +1,3 @@
- Reduction of repetetivity in the code
Before making any major changes to the interpreter, it would be good to
implement Model 3 (Intelligent Calls), as described in the interpreter
documentation. This will reduce the bulk of the code considerably, since then
there will be only one routine for each instruction. Now identical changes
have to be made in n places.
- Shadow bytes with internal values - Shadow bytes with internal values
The biggest problem with the interpreter is that undefinedness is not The biggest problem with the interpreter is that undefinedness is not
transitive. A warning is given if an undefined value is used, but then the transitive. A warning is given if an undefined value is used, but then the

68
util/int/do_array.c
View file

@ -18,86 +18,30 @@
PRIVATE arr(); PRIVATE arr();
DoLARl2(arg) DoLAR(arg)
size arg; size arg;
{ {
/* LAR w: Load array element, descriptor contains integers of size w */ /* LAR w: Load array element, descriptor contains integers of size w */
register size l = (L_arg_2() * arg); LOG(("@A6 DoLAR(%ld)", arg));
LOG(("@A6 DoLARl2(%ld)", l));
arr(LAR, arg_wi(l));
}
DoLARm(arg)
size arg;
{
/* LAR w: Load array element, descriptor contains integers of size w */
LOG(("@A6 DoLARm(%ld)", arg));
arr(LAR, arg_wi(arg)); arr(LAR, arg_wi(arg));
} }
DoLARz() DoSAR(arg)
{
/* LAR w: Load array element, descriptor contains integers of size w */
register size l = uwpop();
LOG(("@A6 DoLARz(%ld)", l));
arr(LAR, arg_wi(l));
}
DoSARl2(arg)
size arg; size arg;
{ {
/* SAR w: Store array element */ /* SAR w: Store array element */
register size l = (L_arg_2() * arg); LOG(("@A6 DoSAR(%ld)", arg));
LOG(("@A6 DoSARl2(%ld)", l));
arr(SAR, arg_wi(l));
}
DoSARm(arg)
size arg;
{
/* SAR w: Store array element */
LOG(("@A6 DoSARm(%ld)", arg));
arr(SAR, arg_wi(arg)); arr(SAR, arg_wi(arg));
} }
DoSARz() DoAAR(arg)
{
/* SAR w: Store array element */
register size l = uwpop();
LOG(("@A6 DoSARz(%ld)", l));
arr(SAR, arg_wi(l));
}
DoAARl2(arg)
size arg; size arg;
{ {
/* AAR w: Load address of array element */ /* AAR w: Load address of array element */
register size l = (L_arg_2() * arg); LOG(("@A6 DoAAR(%ld)", arg));
LOG(("@A6 DoAARl2(%ld)", l));
arr(AAR, arg_wi(l));
}
DoAARm(arg)
size arg;
{
/* AAR w: Load address of array element */
LOG(("@A6 DoAARm(%ld)", arg));
arr(AAR, arg_wi(arg)); arr(AAR, arg_wi(arg));
} }
DoAARz()
{
/* AAR w: Load address of array element */
register size l = uwpop();
LOG(("@A6 DoAARz(%ld)", l));
arr(AAR, arg_wi(l));
}
/******************************************************** /********************************************************
* Array arithmetic * * Array arithmetic *

424
util/int/do_branch.c
View file

@ -21,494 +21,148 @@
#define do_jump(j) { newPC(PC + (j)); } #define do_jump(j) { newPC(PC + (j)); }
DoBRAl2(arg) DoBRA(jump)
long arg; register long jump;
{ {
/* BRA b: Branch unconditionally to label b */ /* BRA b: Branch unconditionally to label b */
register long jump = (L_arg_2() * arg);
LOG(("@B6 DoBRAl2(%ld)", jump)); LOG(("@B6 DoBRA(%ld)", jump));
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoBRAl4(arg) DoBLT(jump)
long arg; register long jump;
{
/* BRA b: Branch unconditionally to label b */
register long jump = (L_arg_4() * arg);
LOG(("@B6 DoBRAl4(%ld)", jump));
do_jump(arg_c(jump));
}
DoBRAs(hob, wfac)
long hob;
size wfac;
{
/* BRA b: Branch unconditionally to label b */
register long jump = (S_arg(hob) * wfac);
LOG(("@B6 DoBRAs(%ld)", jump));
do_jump(arg_c(jump));
}
DoBLTl2(arg)
long arg;
{ {
/* BLT b: Branch less (pop 2 words, branch if top > second) */ /* BLT b: Branch less (pop 2 words, branch if top > second) */
register long jump = (L_arg_2() * arg);
register long t = wpop(); register long t = wpop();
LOG(("@B6 DoBLTl2(%ld)", jump)); LOG(("@B6 DoBLT(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() < t) if (wpop() < t)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoBLTl4(arg) DoBLE(jump)
long arg; register long jump;
{
/* BLT b: Branch less (pop 2 words, branch if top > second) */
register long jump = (L_arg_4() * arg);
register long t = wpop();
LOG(("@B6 DoBLTl4(%ld)", jump));
spoilFRA();
if (wpop() < t)
do_jump(arg_c(jump));
}
DoBLTs(hob, wfac)
long hob;
size wfac;
{
/* BLT b: Branch less (pop 2 words, branch if top > second) */
register long jump = (S_arg(hob) * wfac);
register long t = wpop();
LOG(("@B6 DoBLTs(%ld)", jump));
spoilFRA();
if (wpop() < t)
do_jump(arg_c(jump));
}
DoBLEl2(arg)
long arg;
{ {
/* BLE b: Branch less or equal */ /* BLE b: Branch less or equal */
register long jump = (L_arg_2() * arg);
register long t = wpop(); register long t = wpop();
LOG(("@B6 DoBLEl2(%ld)", jump)); LOG(("@B6 DoBLE(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() <= t) if (wpop() <= t)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoBLEl4(arg) DoBEQ(jump)
long arg; register long jump;
{
/* BLE b: Branch less or equal */
register long jump = (L_arg_4() * arg);
register long t = wpop();
LOG(("@B6 DoBLEl4(%ld)", jump));
spoilFRA();
if (wpop() <= t)
do_jump(arg_c(jump));
}
DoBLEs(hob, wfac)
long hob;
size wfac;
{
/* BLE b: Branch less or equal */
register long jump = (S_arg(hob) * wfac);
register long t = wpop();
LOG(("@B6 DoBLEs(%ld)", jump));
spoilFRA();
if (wpop() <= t)
do_jump(arg_c(jump));
}
DoBEQl2(arg)
long arg;
{ {
/* BEQ b: Branch equal */ /* BEQ b: Branch equal */
register long jump = (L_arg_2() * arg);
register long t = wpop(); register long t = wpop();
LOG(("@B6 DoBEQl2(%ld)", jump)); LOG(("@B6 DoBEQ(%ld)", jump));
spoilFRA(); spoilFRA();
if (t == wpop()) if (t == wpop())
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoBEQl4(arg) DoBNE(jump)
long arg; register long jump;
{
/* BEQ b: Branch equal */
register long jump = (L_arg_4() * arg);
register long t = wpop();
LOG(("@B6 DoBEQl4(%ld)", jump));
spoilFRA();
if (t == wpop())
do_jump(arg_c(jump));
}
DoBEQs(hob, wfac)
long hob;
size wfac;
{
/* BEQ b: Branch equal */
register long jump = (S_arg(hob) * wfac);
register long t = wpop();
LOG(("@B6 DoBEQs(%ld)", jump));
spoilFRA();
if (t == wpop())
do_jump(arg_c(jump));
}
DoBNEl2(arg)
long arg;
{ {
/* BNE b: Branch not equal */ /* BNE b: Branch not equal */
register long jump = (L_arg_2() * arg);
register long t = wpop(); register long t = wpop();
LOG(("@B6 DoBNEl2(%ld)", jump)); LOG(("@B6 DoBNE(%ld)", jump));
spoilFRA(); spoilFRA();
if (t != wpop()) if (t != wpop())
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoBNEl4(arg) DoBGE(jump)
long arg; register long jump;
{
/* BNE b: Branch not equal */
register long jump = (L_arg_4() * arg);
register long t = wpop();
LOG(("@B6 DoBNEl4(%ld)", jump));
spoilFRA();
if (t != wpop())
do_jump(arg_c(jump));
}
DoBNEs(hob, wfac)
long hob;
size wfac;
{
/* BNE b: Branch not equal */
register long jump = (S_arg(hob) * wfac);
register long t = wpop();
LOG(("@B6 DoBNEs(%ld)", jump));
spoilFRA();
if (t != wpop())
do_jump(arg_c(jump));
}
DoBGEl2(arg)
long arg;
{ {
/* BGE b: Branch greater or equal */ /* BGE b: Branch greater or equal */
register long jump = (L_arg_2() * arg);
register long t = wpop(); register long t = wpop();
LOG(("@B6 DoBGEl2(%ld)", jump)); LOG(("@B6 DoBGE(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() >= t) if (wpop() >= t)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoBGEl4(arg) DoBGT(jump)
long arg; register long jump;
{
/* BGE b: Branch greater or equal */
register long jump = (L_arg_4() * arg);
register long t = wpop();
LOG(("@B6 DoBGEl4(%ld)", jump));
spoilFRA();
if (wpop() >= t)
do_jump(arg_c(jump));
}
DoBGEs(hob, wfac)
long hob;
size wfac;
{
/* BGE b: Branch greater or equal */
register long jump = (S_arg(hob) * wfac);
register long t = wpop();
LOG(("@B6 DoBGEs(%ld)", jump));
spoilFRA();
if (wpop() >= t)
do_jump(arg_c(jump));
}
DoBGTl2(arg)
long arg;
{ {
/* BGT b: Branch greater */ /* BGT b: Branch greater */
register long jump = (L_arg_2() * arg);
register long t = wpop(); register long t = wpop();
LOG(("@B6 DoBGTl2(%ld)", jump)); LOG(("@B6 DoBGT(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() > t) if (wpop() > t)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoBGTl4(arg) DoZLT(jump)
long arg; register long jump;
{
/* BGT b: Branch greater */
register long jump = (L_arg_4() * arg);
register long t = wpop();
LOG(("@B6 DoBGTl4(%ld)", jump));
spoilFRA();
if (wpop() > t)
do_jump(arg_c(jump));
}
DoBGTs(hob, wfac)
long hob;
size wfac;
{
/* BGT b: Branch greater */
register long jump = (S_arg(hob) * wfac);
register long t = wpop();
LOG(("@B6 DoBGTs(%ld)", jump));
spoilFRA();
if (wpop() > t)
do_jump(arg_c(jump));
}
DoZLTl2(arg)
long arg;
{ {
/* ZLT b: Branch less than zero (pop 1 word, branch negative) */ /* ZLT b: Branch less than zero (pop 1 word, branch negative) */
register long jump = (L_arg_2() * arg);
LOG(("@B6 DoZLTl2(%ld)", jump)); LOG(("@B6 DoZLT(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() < 0) if (wpop() < 0)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoZLTl4(arg) DoZLE(jump)
long arg; register long jump;
{
/* ZLT b: Branch less than zero (pop 1 word, branch negative) */
register long jump = (L_arg_4() * arg);
LOG(("@B6 DoZLTl4(%ld)", jump));
spoilFRA();
if (wpop() < 0)
do_jump(arg_c(jump));
}
DoZLTs(hob, wfac)
long hob;
size wfac;
{
/* ZLT b: Branch less than zero (pop 1 word, branch negative) */
register long jump = (S_arg(hob) * wfac);
LOG(("@B6 DoZLTs(%ld)", jump));
spoilFRA();
if (wpop() < 0)
do_jump(arg_c(jump));
}
DoZLEl2(arg)
long arg;
{ {
/* ZLE b: Branch less or equal to zero */ /* ZLE b: Branch less or equal to zero */
register long jump = (L_arg_2() * arg);
LOG(("@B6 DoZLEl2(%ld)", jump)); LOG(("@B6 DoZLE(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() <= 0) if (wpop() <= 0)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoZLEl4(arg) DoZEQ(jump)
long arg; register long jump;
{
/* ZLE b: Branch less or equal to zero */
register long jump = (L_arg_4() * arg);
LOG(("@B6 DoZLEl4(%ld)", jump));
spoilFRA();
if (wpop() <= 0)
do_jump(arg_c(jump));
}
DoZLEs(hob, wfac)
long hob;
size wfac;
{
/* ZLE b: Branch less or equal to zero */
register long jump = (S_arg(hob) * wfac);
LOG(("@B6 DoZLEs(%ld)", jump));
spoilFRA();
if (wpop() <= 0)
do_jump(arg_c(jump));
}
DoZEQl2(arg)
long arg;
{ {
/* ZEQ b: Branch equal zero */ /* ZEQ b: Branch equal zero */
register long jump = (L_arg_2() * arg);
LOG(("@B6 DoZEQl2(%ld)", jump)); LOG(("@B6 DoZEQ(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() == 0) if (wpop() == 0)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoZEQl4(arg) DoZNE(jump)
long arg; register long jump;
{
/* ZEQ b: Branch equal zero */
register long jump = (L_arg_4() * arg);
LOG(("@B6 DoZEQl4(%ld)", jump));
spoilFRA();
if (wpop() == 0)
do_jump(arg_c(jump));
}
DoZEQs(hob, wfac)
long hob;
size wfac;
{
/* ZEQ b: Branch equal zero */
register long jump = (S_arg(hob) * wfac);
LOG(("@B6 DoZEQs(%ld)", jump));
spoilFRA();
if (wpop() == 0)
do_jump(arg_c(jump));
}
DoZNEl2(arg)
long arg;
{ {
/* ZNE b: Branch not zero */ /* ZNE b: Branch not zero */
register long jump = (L_arg_2() * arg);
LOG(("@B6 DoZNEl2(%ld)", jump)); LOG(("@B6 DoZNE(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() != 0) if (wpop() != 0)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoZNEl4(arg) DoZGE(jump)
long arg; register long jump;
{
/* ZNE b: Branch not zero */
register long jump = (L_arg_4() * arg);
LOG(("@B6 DoZNEl4(%ld)", jump));
spoilFRA();
if (wpop() != 0)
do_jump(arg_c(jump));
}
DoZNEs(hob, wfac)
long hob;
size wfac;
{
/* ZNE b: Branch not zero */
register long jump = (S_arg(hob) * wfac);
LOG(("@B6 DoZNEs(%ld)", jump));
spoilFRA();
if (wpop() != 0)
do_jump(arg_c(jump));
}
DoZGEl2(arg)
long arg;
{ {
/* ZGE b: Branch greater or equal zero */ /* ZGE b: Branch greater or equal zero */
register long jump = (L_arg_2() * arg);
LOG(("@B6 DoZGEl2(%ld)", jump)); LOG(("@B6 DoZGE(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() >= 0) if (wpop() >= 0)
do_jump(arg_c(jump)); do_jump(arg_c(jump));
} }
DoZGEl4(arg) DoZGT(jump)
long arg; register long jump;
{
/* ZGE b: Branch greater or equal zero */
register long jump = (L_arg_4() * arg);
LOG(("@B6 DoZGEl4(%ld)", jump));
spoilFRA();
if (wpop() >= 0)
do_jump(arg_c(jump));
}
DoZGEs(hob, wfac)
long hob;
size wfac;
{
/* ZGE b: Branch greater or equal zero */
register long jump = (S_arg(hob) * wfac);
LOG(("@B6 DoZGEs(%ld)", jump));
spoilFRA();
if (wpop() >= 0)
do_jump(arg_c(jump));
}
DoZGTl2(arg)
long arg;
{ {
/* ZGT b: Branch greater than zero */ /* ZGT b: Branch greater than zero */
register long jump = (L_arg_2() * arg);
LOG(("@B6 DoZGTl2(%ld)", jump)); LOG(("@B6 DoZGT(%ld)", jump));
spoilFRA();
if (wpop() > 0)
do_jump(arg_c(jump));
}
DoZGTl4(arg)
long arg;
{
/* ZGT b: Branch greater than zero */
register long jump = (L_arg_4() * arg);
LOG(("@B6 DoZGTl4(%ld)", jump));
spoilFRA();
if (wpop() > 0)
do_jump(arg_c(jump));
}
DoZGTs(hob, wfac)
long hob;
size wfac;
{
/* ZGT b: Branch greater than zero */
register long jump = (S_arg(hob) * wfac);
LOG(("@B6 DoZGTs(%ld)", jump));
spoilFRA(); spoilFRA();
if (wpop() > 0) if (wpop() > 0)
do_jump(arg_c(jump)); do_jump(arg_c(jump));

152
util/int/do_comp.c
View file

@ -22,91 +22,27 @@ extern double fpop();
PRIVATE compare_obj(); PRIVATE compare_obj();
DoCMIl2(arg) DoCMI(l)
size arg; register size l;
{ {
/* CMI w: Compare w byte integers, Push negative, zero, positive for <, = or > */ /* CMI w: Compare w byte integers, Push negative, zero, positive for <, = or > */
register size l = (L_arg_2() * arg);
register long t = spop(arg_wi(l)); register long t = spop(arg_wi(l));
register long s = spop(l); register long s = spop(l);
LOG(("@T6 DoCMIl2(%ld)", l)); LOG(("@T6 DoCMI(%ld)", l));
spoilFRA(); spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0)); wpush((long)(t < s ? 1 : t > s ? -1 : 0));
} }
DoCMIm(arg) DoCMF(l)
size arg; register size l;
{
/* CMI w: Compare w byte integers, Push negative, zero, positive for <, = or > */
register size l = arg_wi(arg);
register long t = spop(l);
register long s = spop(l);
LOG(("@T6 DoCMIm(%ld)", l));
spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0));
}
DoCMIz()
{
/* CMI w: Compare w byte integers, Push negative, zero, positive for <, = or > */
register size l = uwpop();
register long t = spop(arg_wi(l));
register long s = spop(l);
LOG(("@T6 DoCMIz(%ld)", l));
spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0));
}
DoCMFl2(arg)
size arg;
{ {
/* CMF w: Compare w byte reals */ /* CMF w: Compare w byte reals */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg);
double t = fpop(arg_wf(l)); double t = fpop(arg_wf(l));
double s = fpop(l); double s = fpop(l);
LOG(("@T6 DoCMFl2(%ld)", l)); LOG(("@T6 DoCMF(%ld)", l));
spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0));
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoCMFs(hob, wfac)
long hob;
size wfac;
{
/* CMF w: Compare w byte reals */
#ifndef NOFLOAT
register size l = (S_arg(hob) * wfac);
double t = fpop(arg_wf(l));
double s = fpop(l);
LOG(("@T6 DoCMFs(%ld)", l));
spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0));
#else NOFLOAT
hob = hob;
wfac = wfac;
nofloat();
#endif NOFLOAT
}
DoCMFz()
{
/* CMF w: Compare w byte reals */
#ifndef NOFLOAT
register size l = uwpop();
double t = fpop(arg_wf(l));
double s = fpop(l);
LOG(("@T6 DoCMFz(%ld)", l));
spoilFRA(); spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0)); wpush((long)(t < s ? 1 : t > s ? -1 : 0));
#else NOFLOAT #else NOFLOAT
@ -114,120 +50,84 @@ DoCMFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoCMUl2(arg) DoCMU(l)
size arg; register size l;
{ {
/* CMU w: Compare w byte unsigneds */ /* CMU w: Compare w byte unsigneds */
register size l = (L_arg_2() * arg);
register unsigned long t = upop(arg_wi(l)); register unsigned long t = upop(arg_wi(l));
register unsigned long s = upop(l); register unsigned long s = upop(l);
LOG(("@T6 DoCMUl2(%ld)", l)); LOG(("@T6 DoCMU(%ld)", l));
spoilFRA(); spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0)); wpush((long)(t < s ? 1 : t > s ? -1 : 0));
} }
DoCMUz() DoCMS(l)
{ register size l;
/* CMU w: Compare w byte unsigneds */
register size l = uwpop();
register unsigned long t = upop(arg_wi(l));
register unsigned long s = upop(l);
LOG(("@T6 DoCMUz(%ld)", l));
spoilFRA();
wpush((long)(t < s ? 1 : t > s ? -1 : 0));
}
DoCMSl2(arg)
size arg;
{ {
/* CMS w: Compare w byte values, can only be used for bit for bit equality test */ /* CMS w: Compare w byte values, can only be used for bit for bit equality test */
register size l = (L_arg_2() * arg);
LOG(("@T6 DoCMSl2(%ld)", l)); LOG(("@T6 DoCMS(%ld)", l));
spoilFRA(); spoilFRA();
compare_obj(arg_w(l)); compare_obj(arg_w(l));
} }
DoCMSs(hob, wfac) DoCMP()
long hob;
size wfac;
{
/* CMS w: Compare w byte values, can only be used for bit for bit equality test */
register size l = (S_arg(hob) * wfac);
LOG(("@T6 DoCMSs(%ld)", l));
spoilFRA();
compare_obj(arg_w(l));
}
DoCMSz()
{
/* CMS w: Compare w byte values, can only be used for bit for bit equality test */
register size l = uwpop();
LOG(("@T6 DoCMSz(%ld)", l));
spoilFRA();
compare_obj(arg_w(l));
}
DoCMPz()
{ {
/* CMP -: Compare pointers */ /* CMP -: Compare pointers */
register ptr t, s; register ptr t, s;
LOG(("@T6 DoCMPz()")); LOG(("@T6 DoCMP()"));
spoilFRA(); spoilFRA();
t = dppop(); t = dppop();
s = dppop(); s = dppop();
wpush((long)(t < s ? 1 : t > s ? -1 : 0)); wpush((long)(t < s ? 1 : t > s ? -1 : 0));
} }
DoTLTz() DoTLT()
{ {
/* TLT -: True if less, i.e. iff top of stack < 0 */ /* TLT -: True if less, i.e. iff top of stack < 0 */
LOG(("@T6 DoTLTz()")); LOG(("@T6 DoTLT()"));
spoilFRA(); spoilFRA();
wpush((long)(wpop() < 0 ? 1 : 0)); wpush((long)(wpop() < 0 ? 1 : 0));
} }
DoTLEz() DoTLE()
{ {
/* TLE -: True if less or equal, i.e. iff top of stack <= 0 */ /* TLE -: True if less or equal, i.e. iff top of stack <= 0 */
LOG(("@T6 DoTLEz()")); LOG(("@T6 DoTLE()"));
spoilFRA(); spoilFRA();
wpush((long)(wpop() <= 0 ? 1 : 0)); wpush((long)(wpop() <= 0 ? 1 : 0));
} }
DoTEQz() DoTEQ()
{ {
/* TEQ -: True if equal, i.e. iff top of stack = 0 */ /* TEQ -: True if equal, i.e. iff top of stack = 0 */
LOG(("@T6 DoTEQz()")); LOG(("@T6 DoTEQ()"));
spoilFRA(); spoilFRA();
wpush((long)(wpop() == 0 ? 1 : 0)); wpush((long)(wpop() == 0 ? 1 : 0));
} }
DoTNEz() DoTNE()
{ {
/* TNE -: True if not equal, i.e. iff top of stack non zero */ /* TNE -: True if not equal, i.e. iff top of stack non zero */
LOG(("@T6 DoTNEz()")); LOG(("@T6 DoTNE()"));
spoilFRA(); spoilFRA();
wpush((long)(wpop() != 0 ? 1 : 0)); wpush((long)(wpop() != 0 ? 1 : 0));
} }
DoTGEz() DoTGE()
{ {
/* TGE -: True if greater or equal, i.e. iff top of stack >= 0 */ /* TGE -: True if greater or equal, i.e. iff top of stack >= 0 */
LOG(("@T6 DoTGEz()")); LOG(("@T6 DoTGE()"));
spoilFRA(); spoilFRA();
wpush((long)(wpop() >= 0 ? 1 : 0)); wpush((long)(wpop() >= 0 ? 1 : 0));
} }
DoTGTz() DoTGT()
{ {
/* TGT -: True if greater, i.e. iff top of stack > 0 */ /* TGT -: True if greater, i.e. iff top of stack > 0 */
LOG(("@T6 DoTGTz()")); LOG(("@T6 DoTGT()"));
spoilFRA(); spoilFRA();
wpush((long)(wpop() > 0 ? 1 : 0)); wpush((long)(wpop() > 0 ? 1 : 0));
} }

36
util/int/do_conv.c
View file

@ -18,13 +18,13 @@
extern double fpop(); extern double fpop();
#endif NOFLOAT #endif NOFLOAT
DoCIIz() DoCII()
{ {
/* CII -: Convert integer to integer (*) */ /* CII -: Convert integer to integer (*) */
register int newsize = swpop(); register int newsize = swpop();
register long s; register long s;
LOG(("@C6 DoCIIz()")); LOG(("@C6 DoCII()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 12: case 12:
@ -62,13 +62,13 @@ DoCIIz()
} }
} }
DoCUIz() DoCUI()
{ {
/* CUI -: Convert unsigned to integer (*) */ /* CUI -: Convert unsigned to integer (*) */
register int newsize = swpop(); register int newsize = swpop();
register unsigned long u; register unsigned long u;
LOG(("@C6 DoCUIz()")); LOG(("@C6 DoCUI()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 22: case 22:
@ -112,14 +112,14 @@ DoCUIz()
} }
} }
DoCFIz() DoCFI()
{ {
/* CFI -: Convert floating to integer (*) */ /* CFI -: Convert floating to integer (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register int newsize = swpop(); register int newsize = swpop();
double f; double f;
LOG(("@C6 DoCFIz()")); LOG(("@C6 DoCFI()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 42: case 42:
@ -168,13 +168,13 @@ DoCFIz()
#endif NOFLOAT #endif NOFLOAT
} }
DoCIFz() DoCIF()
{ {
/* CIF -: Convert integer to floating (*) */ /* CIF -: Convert integer to floating (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register int newsize = swpop(); register int newsize = swpop();
LOG(("@C6 DoCIFz()")); LOG(("@C6 DoCIF()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 24: case 24:
@ -203,14 +203,14 @@ DoCIFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoCUFz() DoCUF()
{ {
/* CUF -: Convert unsigned to floating (*) */ /* CUF -: Convert unsigned to floating (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register int newsize = swpop(); register int newsize = swpop();
register unsigned long u; register unsigned long u;
LOG(("@C6 DoCUFz()")); LOG(("@C6 DoCUF()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 24: case 24:
@ -249,13 +249,13 @@ DoCUFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoCFFz() DoCFF()
{ {
/* CFF -: Convert floating to floating (*) */ /* CFF -: Convert floating to floating (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register int newsize = swpop(); register int newsize = swpop();
LOG(("@C6 DoCFFz()")); LOG(("@C6 DoCFF()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 44: case 44:
@ -276,13 +276,13 @@ DoCFFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoCIUz() DoCIU()
{ {
/* CIU -: Convert integer to unsigned */ /* CIU -: Convert integer to unsigned */
register int newsize = swpop(); register int newsize = swpop();
register long u; register long u;
LOG(("@C6 DoCIUz()")); LOG(("@C6 DoCIU()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 22: case 22:
@ -310,12 +310,12 @@ DoCIUz()
} }
} }
DoCUUz() DoCUU()
{ {
/* CUU -: Convert unsigned to unsigned */ /* CUU -: Convert unsigned to unsigned */
register int newsize = swpop(); register int newsize = swpop();
LOG(("@C6 DoCUUz()")); LOG(("@C6 DoCUU()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 22: case 22:
@ -342,14 +342,14 @@ DoCUUz()
} }
} }
DoCFUz() DoCFU()
{ {
/* CFU -: Convert floating to unsigned */ /* CFU -: Convert floating to unsigned */
#ifndef NOFLOAT #ifndef NOFLOAT
register int newsize = swpop(); register int newsize = swpop();
double f; double f;
LOG(("@C6 DoCFUz()")); LOG(("@C6 DoCFU()"));
spoilFRA(); spoilFRA();
switch ((int)(10 * swpop() + newsize)) { switch ((int)(10 * swpop() + newsize)) {
case 42: case 42:

243
util/int/do_fpar.c
View file

@ -28,50 +28,14 @@ PRIVATE fef(), fif();
#endif NOFLOAT #endif NOFLOAT
DoADFl2(arg) DoADF(l)
size arg; register size l;
{ {
/* ADF w: Floating add (*) */ /* ADF w: Floating add (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg);
double t = fpop(arg_wf(l)); double t = fpop(arg_wf(l));
LOG(("@F6 DoADFl2(%ld)", l)); LOG(("@F6 DoADF(%ld)", l));
spoilFRA();
fpush(adf(fpop(l), t), l);
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoADFs(hob, wfac)
long hob;
size wfac;
{
/* ADF w: Floating add (*) */
#ifndef NOFLOAT
register size l = (S_arg(hob) * wfac);
double t = fpop(arg_wf(l));
LOG(("@F6 DoADFs(%ld)", l));
spoilFRA();
fpush(adf(fpop(l), t), l);
#else NOFLOAT
hob = hob;
wfac = wfac;
nofloat();
#endif NOFLOAT
}
DoADFz()
{
/* ADF w: Floating add (*) */
#ifndef NOFLOAT
register size l = uwpop();
double t = fpop(arg_wf(l));
LOG(("@F6 DoADFz(%ld)", l));
spoilFRA(); spoilFRA();
fpush(adf(fpop(l), t), l); fpush(adf(fpop(l), t), l);
#else NOFLOAT #else NOFLOAT
@ -79,50 +43,14 @@ DoADFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoSBFl2(arg) DoSBF(l)
size arg; register size l;
{ {
/* SBF w: Floating subtract (*) */ /* SBF w: Floating subtract (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg);
double t = fpop(arg_wf(l)); double t = fpop(arg_wf(l));
LOG(("@F6 DoSBFl2(%ld)", l)); LOG(("@F6 DoSBF(%ld)", l));
spoilFRA();
fpush(sbf(fpop(l), t), l);
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoSBFs(hob, wfac)
long hob;
size wfac;
{
/* SBF w: Floating subtract (*) */
#ifndef NOFLOAT
register size l = (S_arg(hob) * wfac);
double t = fpop(arg_wf(l));
LOG(("@F6 DoSBFs(%ld)", l));
spoilFRA();
fpush(sbf(fpop(l), t), l);
#else NOFLOAT
hob = hob;
wfac = wfac;
nofloat();
#endif NOFLOAT
}
DoSBFz()
{
/* SBF w: Floating subtract (*) */
#ifndef NOFLOAT
register size l = uwpop();
double t = fpop(arg_wf(l));
LOG(("@F6 DoSBFz(%ld)", l));
spoilFRA(); spoilFRA();
fpush(sbf(fpop(l), t), l); fpush(sbf(fpop(l), t), l);
#else NOFLOAT #else NOFLOAT
@ -130,50 +58,14 @@ DoSBFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoMLFl2(arg) DoMLF(l)
size arg; register size l;
{ {
/* MLF w: Floating multiply (*) */ /* MLF w: Floating multiply (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg);
double t = fpop(arg_wf(l)); double t = fpop(arg_wf(l));
LOG(("@F6 DoMLFl2(%ld)", l)); LOG(("@F6 DoMLF(%ld)", l));
spoilFRA();
fpush(mlf(fpop(l), t), l);
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoMLFs(hob, wfac)
long hob;
size wfac;
{
/* MLF w: Floating multiply (*) */
#ifndef NOFLOAT
register size l = (S_arg(hob) * wfac);
double t = fpop(arg_wf(l));
LOG(("@F6 DoMLFs(%ld)", l));
spoilFRA();
fpush(mlf(fpop(l), t), l);
#else NOFLOAT
hob = hob;
wfac = wfac;
nofloat();
#endif NOFLOAT
}
DoMLFz()
{
/* MLF w: Floating multiply (*) */
#ifndef NOFLOAT
register size l = uwpop();
double t = fpop(arg_wf(l));
LOG(("@F6 DoMLFz(%ld)", l));
spoilFRA(); spoilFRA();
fpush(mlf(fpop(l), t), l); fpush(mlf(fpop(l), t), l);
#else NOFLOAT #else NOFLOAT
@ -181,50 +73,14 @@ DoMLFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoDVFl2(arg) DoDVF(l)
size arg; register size l;
{ {
/* DVF w: Floating divide (*) */ /* DVF w: Floating divide (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg);
double t = fpop(arg_wf(l)); double t = fpop(arg_wf(l));
LOG(("@F6 DoDVFl2(%ld)", l)); LOG(("@F6 DoDVF(%ld)", l));
spoilFRA();
fpush(dvf(fpop(l), t), l);
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoDVFs(hob, wfac)
long hob;
size wfac;
{
/* DVF w: Floating divide (*) */
#ifndef NOFLOAT
register size l = (S_arg(hob) * wfac);
double t = fpop(arg_wf(l));
LOG(("@F6 DoDVFs(%ld)", l));
spoilFRA();
fpush(dvf(fpop(l), t), l);
#else NOFLOAT
hob = hob;
wfac = wfac;
nofloat();
#endif NOFLOAT
}
DoDVFz()
{
/* DVF w: Floating divide (*) */
#ifndef NOFLOAT
register size l = uwpop();
double t = fpop(arg_wf(l));
LOG(("@F6 DoDVFz(%ld)", l));
spoilFRA(); spoilFRA();
fpush(dvf(fpop(l), t), l); fpush(dvf(fpop(l), t), l);
#else NOFLOAT #else NOFLOAT
@ -232,31 +88,14 @@ DoDVFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoNGFl2(arg) DoNGF(l)
size arg; register size l;
{ {
/* NGF w: Floating negate (*) */ /* NGF w: Floating negate (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg);
double t = fpop(arg_wf(l)); double t = fpop(arg_wf(l));
LOG(("@F6 DoNGFl2(%ld)", l)); LOG(("@F6 DoNGF(%ld)", l));
spoilFRA();
fpush(-t, l);
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoNGFz()
{
/* NGF w: Floating negate (*) */
#ifndef NOFLOAT
register size l = uwpop();
double t = fpop(arg_wf(l));
LOG(("@F6 DoNGFz(%ld)", l));
spoilFRA(); spoilFRA();
fpush(-t, l); fpush(-t, l);
#else NOFLOAT #else NOFLOAT
@ -264,31 +103,14 @@ DoNGFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoFIFl2(arg) DoFIF(l)
size arg; register size l;
{ {
/* FIF w: Floating multiply and split integer and fraction part (*) */ /* FIF w: Floating multiply and split integer and fraction part (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg);
double t = fpop(arg_wf(l)); double t = fpop(arg_wf(l));
LOG(("@F6 DoFIFl2(%ld)", l)); LOG(("@F6 DoFIF(%ld)", l));
spoilFRA();
fif(fpop(l), t, l);
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoFIFz()
{
/* FIF w: Floating multiply and split integer and fraction part (*) */
#ifndef NOFLOAT
register size l = uwpop();
double t = fpop(arg_wf(l));
LOG(("@F6 DoFIFz(%ld)", l));
spoilFRA(); spoilFRA();
fif(fpop(l), t, l); fif(fpop(l), t, l);
#else NOFLOAT #else NOFLOAT
@ -296,29 +118,12 @@ DoFIFz()
#endif NOFLOAT #endif NOFLOAT
} }
DoFEFl2(arg) DoFEF(l)
size arg; register size l;
{ {
/* FEF w: Split floating number in exponent and fraction part (*) */ /* FEF w: Split floating number in exponent and fraction part (*) */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg); LOG(("@F6 DoFEF(%ld)", l));
LOG(("@F6 DoFEFl2(%ld)", l));
spoilFRA();
fef(fpop(arg_wf(l)), l);
#else NOFLOAT
arg = arg;
nofloat();
#endif NOFLOAT
}
DoFEFz()
{
/* FEF w: Split floating number in exponent and fraction part (*) */
#ifndef NOFLOAT
register size l = uwpop();
LOG(("@F6 DoFEFz(%ld)", l));
spoilFRA(); spoilFRA();
fef(fpop(arg_wf(l)), l); fef(fpop(arg_wf(l)), l);
#else NOFLOAT #else NOFLOAT
@ -454,6 +259,12 @@ PRIVATE fef(f, n)
{ {
register long exponent, sign = (long) (f < 0.0); register long exponent, sign = (long) (f < 0.0);
if (f == 0.0) {
fpush(f, n);
wpush(0L);
return;
}
for (f = fabs(f), exponent = 0; f >= 1.0; exponent++) for (f = fabs(f), exponent = 0; f >= 1.0; exponent++)
f /= 2.0; f /= 2.0;

374
util/int/do_incdec.c
View file

@ -16,365 +16,99 @@
PRIVATE long inc(), dec(); PRIVATE long inc(), dec();
DoINCz() DoINC()
{ {
/* INC -: Increment word on top of stack by 1 (*) */ /* INC -: Increment word on top of stack by 1 (*) */
LOG(("@Z6 DoINCz()")); LOG(("@Z6 DoINC()"));
spoilFRA(); spoilFRA();
wpush(inc(swpop())); wpush(inc(swpop()));
} }
DoINLm(arg) DoINL(l)
long arg; register long l;
{ {
/* INL l: Increment local or parameter (*) */ /* INL l: Increment local or parameter (*) */
register long l = arg_l(arg);
register ptr p; register ptr p;
LOG(("@Z6 DoINLm(%ld)", l)); LOG(("@Z6 DoINL(%ld)", l));
spoilFRA(); spoilFRA();
p = loc_addr(l); p = loc_addr(arg_l(l));
st_stw(p, inc(st_ldsw(p))); st_stw(p, inc(st_ldsw(p)));
} }
DoINLn2(arg) DoINE(arg)
long arg; register long arg;
{
/* INL l: Increment local or parameter (*) */
register long l = (N_arg_2() * arg);
register ptr p;
LOG(("@Z6 DoINLn2(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, inc(st_ldsw(p)));
}
DoINLn4(arg)
long arg;
{
/* INL l: Increment local or parameter (*) */
register long l = (N_arg_4() * arg);
register ptr p;
LOG(("@Z6 DoINLn4(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, inc(st_ldsw(p)));
}
DoINLp2(arg)
long arg;
{
/* INL l: Increment local or parameter (*) */
register long l = (P_arg_2() * arg);
register ptr p;
LOG(("@Z6 DoINLp2(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, inc(st_ldsw(p)));
}
DoINLp4(arg)
long arg;
{
/* INL l: Increment local or parameter (*) */
register long l = (P_arg_4() * arg);
register ptr p;
LOG(("@Z6 DoINLp4(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, inc(st_ldsw(p)));
}
DoINLs(hob, wfac)
long hob;
size wfac;
{
/* INL l: Increment local or parameter (*) */
register long l = (S_arg(hob) * wfac);
register ptr p;
LOG(("@Z6 DoINLs(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, inc(st_ldsw(p)));
}
DoINEl2(arg)
long arg;
{ {
/* INE g: Increment external (*) */ /* INE g: Increment external (*) */
register ptr p = i2p(L_arg_2() * arg); register ptr p = i2p(arg);
LOG(("@Z6 DoINEl2(%lu)", p)); LOG(("@Z6 DoINE(%lu)", p));
spoilFRA(); spoilFRA();
p = arg_g(p); p = arg_g(p);
dt_stw(p, inc(dt_ldsw(p))); dt_stw(p, inc(dt_ldsw(p)));
} }
DoINEl4(arg) DoDEC()
long arg;
{
/* INE g: Increment external (*) */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@Z6 DoINEl4(%lu)", p));
spoilFRA();
p = arg_g(p);
dt_stw(p, inc(dt_ldsw(p)));
}
DoINEs(hob, wfac)
long hob;
size wfac;
{
/* INE g: Increment external (*) */
register ptr p = i2p(S_arg(hob) * wfac);
LOG(("@Z6 DoINEs(%lu)", p));
spoilFRA();
p = arg_g(p);
dt_stw(p, inc(dt_ldsw(p)));
}
DoDECz()
{ {
/* DEC -: Decrement word on top of stack by 1 (*) */ /* DEC -: Decrement word on top of stack by 1 (*) */
LOG(("@Z6 DoDECz()")); LOG(("@Z6 DoDEC()"));
spoilFRA(); spoilFRA();
wpush(dec(swpop())); wpush(dec(swpop()));
} }
DoDELn2(arg) DoDEL(l)
long arg; register long l;
{ {
/* DEL l: Decrement local or parameter (*) */ /* DEL l: Decrement local or parameter (*) */
register long l = (N_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@Z6 DoDELn2(%ld)", l)); LOG(("@Z6 DoDEL(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
p = loc_addr(l); p = loc_addr(l);
st_stw(p, dec(st_ldsw(p))); st_stw(p, dec(st_ldsw(p)));
} }
DoDELn4(arg) DoDEE(arg)
long arg; register long arg;
{
/* DEL l: Decrement local or parameter (*) */
register long l = (N_arg_4() * arg);
register ptr p;
LOG(("@Z6 DoDELn4(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, dec(st_ldsw(p)));
}
DoDELp2(arg)
long arg;
{
/* DEL l: Decrement local or parameter (*) */
register long l = (P_arg_2() * arg);
register ptr p;
LOG(("@Z6 DoDELp2(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, dec(st_ldsw(p)));
}
DoDELp4(arg)
long arg;
{
/* DEL l: Decrement local or parameter (*) */
register long l = (P_arg_4() * arg);
register ptr p;
LOG(("@Z6 DoDELp4(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, dec(st_ldsw(p)));
}
DoDELs(hob, wfac)
long hob;
size wfac;
{
/* DEL l: Decrement local or parameter (*) */
register long l = (S_arg(hob) * wfac);
register ptr p;
LOG(("@Z6 DoDELs(%ld)", l));
spoilFRA();
l = arg_l(l);
p = loc_addr(l);
st_stw(p, dec(st_ldsw(p)));
}
DoDEEl2(arg)
long arg;
{ {
/* DEE g: Decrement external (*) */ /* DEE g: Decrement external (*) */
register ptr p = i2p(L_arg_2() * arg); register ptr p = i2p(arg);
LOG(("@Z6 DoDEEl2(%lu)", p)); LOG(("@Z6 DoDEE(%lu)", p));
spoilFRA(); spoilFRA();
p = arg_g(p); p = arg_g(p);
dt_stw(p, dec(dt_ldsw(p))); dt_stw(p, dec(dt_ldsw(p)));
} }
DoDEEl4(arg) DoZRL(l)
long arg; register long l;
{
/* DEE g: Decrement external (*) */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@Z6 DoDEEl4(%lu)", p));
spoilFRA();
p = arg_g(p);
dt_stw(p, dec(dt_ldsw(p)));
}
DoDEEs(hob, wfac)
long hob;
size wfac;
{
/* DEE g: Decrement external (*) */
register ptr p = i2p(S_arg(hob) * wfac);
LOG(("@Z6 DoDEEs(%lu)", p));
spoilFRA();
p = arg_g(p);
dt_stw(p, dec(dt_ldsw(p)));
}
DoZRLm(arg)
long arg;
{ {
/* ZRL l: Zero local or parameter */ /* ZRL l: Zero local or parameter */
register long l = arg_l(arg);
LOG(("@Z6 DoZRLm(%ld)", l)); LOG(("@Z6 DoZRL(%ld)", l));
spoilFRA();
st_stw(loc_addr(l), 0L);
}
DoZRLn2(arg)
long arg;
{
/* ZRL l: Zero local or parameter */
register long l = (N_arg_2() * arg);
LOG(("@Z6 DoZRLn2(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
st_stw(loc_addr(l), 0L); st_stw(loc_addr(l), 0L);
} }
DoZRLn4(arg) DoZRE(arg)
long arg; register long arg;
{
/* ZRL l: Zero local or parameter */
register long l = (N_arg_4() * arg);
LOG(("@Z6 DoZRLn4(%ld)", l));
spoilFRA();
l = arg_l(l);
st_stw(loc_addr(l), 0L);
}
DoZRLp2(arg)
long arg;
{
/* ZRL l: Zero local or parameter */
register long l = (P_arg_2() * arg);
LOG(("@Z6 DoZRLp2(%ld)", l));
spoilFRA();
l = arg_l(l);
st_stw(loc_addr(l), 0L);
}
DoZRLp4(arg)
long arg;
{
/* ZRL l: Zero local or parameter */
register long l = (P_arg_4() * arg);
LOG(("@Z6 DoZRLp4(%ld)", l));
spoilFRA();
l = arg_l(l);
st_stw(loc_addr(l), 0L);
}
DoZRLs(hob, wfac)
long hob;
size wfac;
{
/* ZRL l: Zero local or parameter */
register long l = (S_arg(hob) * wfac);
LOG(("@Z6 DoZRLs(%ld)", l));
spoilFRA();
l = arg_l(l);
st_stw(loc_addr(l), 0L);
}
DoZREl2(arg)
long arg;
{ {
/* ZRE g: Zero external */ /* ZRE g: Zero external */
register ptr p = i2p(L_arg_2() * arg); register ptr p = i2p(arg);
LOG(("@Z6 DoZREl2(%lu)", p)); LOG(("@Z6 DoZRE(%lu)", p));
spoilFRA(); spoilFRA();
dt_stw(arg_g(p), 0L); dt_stw(arg_g(p), 0L);
} }
DoZREl4(arg) DoZRF(l)
long arg; register size l;
{
/* ZRE g: Zero external */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@Z6 DoZREl4(%lu)", p));
spoilFRA();
dt_stw(arg_g(p), 0L);
}
DoZREs(hob, wfac)
long hob;
size wfac;
{
/* ZRE g: Zero external */
register ptr p = i2p(S_arg(hob) * wfac);
LOG(("@Z6 DoZREs(%lu)", p));
spoilFRA();
dt_stw(arg_g(p), 0L);
}
DoZRFl2(arg)
size arg;
{ {
/* ZRF w: Load a floating zero of size w */ /* ZRF w: Load a floating zero of size w */
#ifndef NOFLOAT #ifndef NOFLOAT
register size l = (L_arg_2() * arg); LOG(("@Z6 DoZRF(%ld)", l));
LOG(("@Z6 DoZRFl2(%ld)", l));
spoilFRA(); spoilFRA();
fpush(0.0, arg_wf(l)); fpush(0.0, arg_wf(l));
#else NOFLOAT #else NOFLOAT
@ -383,54 +117,20 @@ DoZRFl2(arg)
#endif NOFLOAT #endif NOFLOAT
} }
DoZRFz() DoZER(l)
{ register size l;
/* ZRF w: Load a floating zero of size w */
#ifndef NOFLOAT
register size l = uwpop();
LOG(("@Z6 DoZRFz(%ld)", l));
spoilFRA();
fpush(0.0, arg_wf(l));
#else NOFLOAT
nofloat();
#endif NOFLOAT
}
DoZERl2(arg)
size arg;
{ {
/* ZER w: Load w zero bytes */ /* ZER w: Load w zero bytes */
register size i, l = (L_arg_2() * arg); register size i;
LOG(("@Z6 DoZERl2(%ld)", l)); LOG(("@Z6 DoZER(%ld)", l));
spoilFRA();
for (i = arg_w(l); i; i -= wsize)
wpush(0L);
}
DoZERs(hob, wfac)
long hob;
size wfac;
{
/* ZER w: Load w zero bytes */
register size i, l = (S_arg(hob) * wfac);
LOG(("@Z6 DoZERs(%ld)", l));
spoilFRA();
for (i = arg_w(l); i; i -= wsize)
wpush(0L);
}
DoZERz()
{
/* ZER w: Load w zero bytes */
register size i, l = swpop();
LOG(("@Z6 DoZERz(%ld)", l));
spoilFRA(); spoilFRA();
npush(0L, arg_w(l));
/*
for (i = arg_w(l); i; i -= wsize) for (i = arg_w(l); i; i -= wsize)
wpush(0L); wpush(0L);
*/
} }
PRIVATE long inc(l) PRIVATE long inc(l)

218
util/int/do_intar.c
View file

@ -16,261 +16,91 @@
PRIVATE long adi(), sbi(), dvi(), mli(), rmi(), ngi(), sli(), sri(); PRIVATE long adi(), sbi(), dvi(), mli(), rmi(), ngi(), sli(), sri();
DoADIl2(arg) DoADI(l)
size arg; register size l;
{ {
/* ADI w: Addition (*) */ /* ADI w: Addition (*) */
register size l = (L_arg_2() * arg);
register long t = spop(arg_wi(l)); register long t = spop(arg_wi(l));
LOG(("@I6 DoADIl2(%ld)", l)); LOG(("@I6 DoADI(%ld)", l));
spoilFRA(); spoilFRA();
npush(adi(spop(l), t, l), l); npush(adi(spop(l), t, l), l);
} }
DoADIm(arg) DoSBI(l)
size arg; register size l;
{
/* ADI w: Addition (*) */
register size l = arg_wi(arg);
register long t = spop(l);
LOG(("@I6 DoADIm(%ld)", l));
spoilFRA();
npush(adi(spop(l), t, l), l);
}
DoADIz() /* argument on top of stack */
{
/* ADI w: Addition (*) */
register size l = uwpop();
register long t = spop(arg_wi(l));
LOG(("@I6 DoADIz(%ld)", l));
spoilFRA();
npush(adi(spop(l), t, l), l);
}
DoSBIl2(arg)
size arg;
{ {
/* SBI w: Subtraction (*) */ /* SBI w: Subtraction (*) */
register size l = (L_arg_2() * arg);
register long t = spop(arg_wi(l)); register long t = spop(arg_wi(l));
LOG(("@I6 DoSBIl2(%ld)", l)); LOG(("@I6 DoSBI(%ld)", l));
spoilFRA(); spoilFRA();
npush(sbi(spop(l), t, l), l); npush(sbi(spop(l), t, l), l);
} }
DoSBIm(arg) DoMLI(l)
size arg; register size l;
{
/* SBI w: Subtraction (*) */
register size l = arg_wi(arg);
register long t = spop(l);
LOG(("@I6 DoSBIm(%ld)", l));
spoilFRA();
npush(sbi(spop(l), t, l), l);
}
DoSBIz() /* arg on top of stack */
{
/* SBI w: Subtraction (*) */
register size l = uwpop();
register long t = spop(arg_wi(l));
LOG(("@I6 DoSBIz(%ld)", l));
spoilFRA();
npush(sbi(spop(l), t, l), l);
}
DoMLIl2(arg)
size arg;
{ {
/* MLI w: Multiplication (*) */ /* MLI w: Multiplication (*) */
register size l = (L_arg_2() * arg);
register long t = spop(arg_wi(l)); register long t = spop(arg_wi(l));
LOG(("@I6 DoMLIl2(%ld)", l)); LOG(("@I6 DoMLI(%ld)", l));
spoilFRA(); spoilFRA();
npush(mli(spop(l), t, l), l); npush(mli(spop(l), t, l), l);
} }
DoMLIm(arg) DoDVI(l)
size arg; register size l;
{
/* MLI w: Multiplication (*) */
register size l = arg_wi(arg);
register long t = spop(l);
LOG(("@I6 DoMLIm(%ld)", l));
spoilFRA();
npush(mli(spop(l), t, l), l);
}
DoMLIz() /* arg on top of stack */
{
/* MLI w: Multiplication (*) */
register size l = uwpop();
register long t = spop(arg_wi(l));
LOG(("@I6 DoMLIz(%ld)", l));
spoilFRA();
npush(mli(spop(l), t, l), l);
}
DoDVIl2(arg)
size arg;
{ {
/* DVI w: Division (*) */ /* DVI w: Division (*) */
register size l = (L_arg_2() * arg);
register long t = spop(arg_wi(l)); register long t = spop(arg_wi(l));
LOG(("@I6 DoDVIl2(%ld)", l)); LOG(("@I6 DoDVI(%ld)", l));
spoilFRA(); spoilFRA();
npush(dvi(spop(l), t), l); npush(dvi(spop(l), t), l);
} }
DoDVIm(arg) DoRMI(l)
size arg; register size l;
{
/* DVI w: Division (*) */
register size l = arg_wi(arg);
register long t = spop(l);
LOG(("@I6 DoDVIm(%ld)", l));
spoilFRA();
npush(dvi(spop(l), t), l);
}
DoDVIz() /* arg on top of stack */
{
/* DVI w: Division (*) */
register size l = uwpop();
register long t = spop(arg_wi(l));
LOG(("@I6 DoDVIz(%ld)", l));
spoilFRA();
npush(dvi(spop(l), t), l);
}
DoRMIl2(arg)
size arg;
{ {
/* RMI w: Remainder (*) */ /* RMI w: Remainder (*) */
register size l = (L_arg_2() * arg);
register long t = spop(arg_wi(l)); register long t = spop(arg_wi(l));
LOG(("@I6 DoRMIl2(%ld)", l)); LOG(("@I6 DoRMI(%ld)", l));
spoilFRA(); spoilFRA();
npush(rmi(spop(l), t), l); npush(rmi(spop(l), t), l);
} }
DoRMIm(arg) DoNGI(l)
size arg; register size l;
{
/* RMI w: Remainder (*) */
register size l = arg_wi(arg);
register long t = spop(l);
LOG(("@I6 DoRMIm(%ld)", l));
spoilFRA();
npush(rmi(spop(l), t), l);
}
DoRMIz() /* arg on top of stack */
{
/* RMI w: Remainder (*) */
register size l = uwpop();
register long t = spop(arg_wi(l));
LOG(("@I6 DoRMIz(%ld)", l));
spoilFRA();
npush(rmi(spop(l), t), l);
}
DoNGIl2(arg)
size arg;
{ {
/* NGI w: Negate (two's complement) (*) */ /* NGI w: Negate (two's complement) (*) */
register size l = (L_arg_2() * arg);
LOG(("@I6 DoNGIl2(%ld)", l)); LOG(("@I6 DoNGI(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_wi(l); l = arg_wi(l);
npush(ngi(spop(l), l), l); npush(ngi(spop(l), l), l);
} }
DoNGIz() DoSLI(l)
{ register size l;
/* NGI w: Negate (two's complement) (*) */
register size l = uwpop();
LOG(("@I6 DoNGIz(%ld)", l));
spoilFRA();
l = arg_wi(l);
npush(ngi(spop(l), l), l);
}
DoSLIl2(arg)
size arg;
{ {
/* SLI w: Shift left (*) */ /* SLI w: Shift left (*) */
register size l = (L_arg_2() * arg);
register long t = swpop(); register long t = swpop();
LOG(("@I6 DoSLIl2(%ld)", l)); LOG(("@I6 DoSLI(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_wi(l); l = arg_wi(l);
npush(sli(spop(l), t, l), l); npush(sli(spop(l), t, l), l);
} }
DoSLIm(arg) DoSRI(l)
size arg; register size l;
{
/* SLI w: Shift left (*) */
register size l = arg_wi(arg);
register long t = swpop();
LOG(("@I6 DoSLIm(%ld)", l));
spoilFRA();
npush(sli(spop(l), t, l), l);
}
DoSLIz()
{
/* SLI w: Shift left (*) */
register size l = uwpop();
register long t = swpop();
LOG(("@I6 DoSLIz(%ld)", l));
spoilFRA();
l = arg_wi(l);
npush(sli(spop(l), t, l), l);
}
DoSRIl2(arg)
size arg;
{ {
/* SRI w: Shift right (*) */ /* SRI w: Shift right (*) */
register size l = (L_arg_2() * arg);
register long t = swpop(); register long t = swpop();
LOG(("@I6 DoSRIl2(%ld)", l)); LOG(("@I6 DoSRI(%ld)", l));
spoilFRA();
l = arg_wi(l);
npush(sri(spop(l), t, l), l);
}
DoSRIz()
{
/* SRI w: Shift right (*) */
register size l = uwpop();
register long t = swpop();
LOG(("@I6 DoSRIz(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_wi(l); l = arg_wi(l);
npush(sri(spop(l), t, l), l); npush(sri(spop(l), t, l), l);

620
util/int/do_load.c
View file

@ -16,528 +16,138 @@
PRIVATE ptr lexback_LB(); PRIVATE ptr lexback_LB();
DoLOCl2(arg) DoLOC(l)
long arg; register long l;
{ {
/* LOC c: Load constant (i.e. push one word onto the stack) */ /* LOC c: Load constant (i.e. push one word onto the stack) */
register long l = (L_arg_2() * arg);
LOG(("@L6 DoLOCl2(%ld)", l)); LOG(("@L6 DoLOC(%ld)", l));
spoilFRA(); spoilFRA();
wpush(arg_c(l)); wpush(arg_c(l));
} }
DoLOCl4(arg) DoLDC(l)
long arg; register long l;
{
/* LOC c: Load constant (i.e. push one word onto the stack) */
register long l = (L_arg_4() * arg);
LOG(("@L6 DoLOCl4(%ld)", l));
spoilFRA();
wpush(arg_c(l));
}
DoLOCm(arg)
long arg;
{
/* LOC c: Load constant (i.e. push one word onto the stack) */
long l = arg_c(arg);
LOG(("@L6 DoLOCm(%ld)", l));
spoilFRA();
wpush(l);
}
DoLOCs(hob, wfac)
long hob;
size wfac;
{
/* LOC c: Load constant (i.e. push one word onto the stack) */
register long l = (S_arg(hob) * wfac);
LOG(("@L6 DoLOCs(%ld)", l));
spoilFRA();
wpush(arg_c(l));
}
DoLDCl2(arg)
long arg;
{ {
/* LDC d: Load double constant ( push two words ) */ /* LDC d: Load double constant ( push two words ) */
register long l = (L_arg_2() * arg);
LOG(("@L6 DoLDCl2(%ld)", l)); LOG(("@L6 DoLDC(%ld)", l));
spoilFRA();
npush(arg_d(l), dwsize);
}
DoLDCl4(arg)
long arg;
{
/* LDC d: Load double constant ( push two words ) */
register long l = (L_arg_4() * arg);
LOG(("@L6 DoLDCl4(%ld)", l));
spoilFRA();
npush(arg_d(l), dwsize);
}
DoLDCm(arg)
long arg;
{
/* LDC d: Load double constant ( push two words ) */
register long l = arg_d(arg);
LOG(("@L6 DoLDCm(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_d(l);
npush(l, dwsize); npush(l, dwsize);
} }
DoLOLm(arg) DoLOL(l)
long arg; register long l;
{ {
/* LOL l: Load word at l-th local (l<0) or parameter (l>=0) */ /* LOL l: Load word at l-th local (l<0) or parameter (l>=0) */
register long l = arg_l(arg);
LOG(("@L6 DoLOLm(%ld)", l)); LOG(("@L6 DoLOL(%ld)", l));
spoilFRA();
pushw_st(loc_addr(l));
}
DoLOLn2(arg)
long arg;
{
/* LOL l: Load word at l-th local (l<0) or parameter (l>=0) */
register long l = (N_arg_2() * arg);
LOG(("@L6 DoLOLn2(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
pushw_st(loc_addr(l)); pushw_st(loc_addr(l));
} }
DoLOLn4(arg) DoLOE(arg)
long arg; register long arg;
{
/* LOL l: Load word at l-th local (l<0) or parameter (l>=0) */
register long l = (N_arg_4() * arg);
LOG(("@L6 DoLOLn4(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_st(loc_addr(l));
}
DoLOLp2(arg)
long arg;
{
/* LOL l: Load word at l-th local (l<0) or parameter (l>=0) */
register long l = (P_arg_2() * arg);
LOG(("@L6 DoLOLp2(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_st(loc_addr(l));
}
DoLOLp4(arg)
long arg;
{
/* LOL l: Load word at l-th local (l<0) or parameter (l>=0) */
register long l = (P_arg_4() * arg);
LOG(("@L6 DoLOLp4(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_st(loc_addr(l));
}
DoLOLs(hob, wfac)
long hob;
size wfac;
{
/* LOL l: Load word at l-th local (l<0) or parameter (l>=0) */
register long l = (S_arg(hob) * wfac);
LOG(("@L6 DoLOLs(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_st(loc_addr(l));
}
DoLOEl2(arg)
long arg;
{ {
/* LOE g: Load external word g */ /* LOE g: Load external word g */
register ptr p = i2p(L_arg_2() * arg); register ptr p = i2p(arg);
LOG(("@L6 DoLOEl2(%lu)", p)); LOG(("@L6 DoLOE(%lu)", p));
spoilFRA(); spoilFRA();
pushw_m(arg_g(p)); pushw_m(arg_g(p));
} }
DoLOEl4(arg) DoLIL(l)
long arg; register long l;
{
/* LOE g: Load external word g */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@L6 DoLOEl4(%lu)", p));
spoilFRA();
pushw_m(arg_g(p));
}
DoLOEs(hob, wfac)
long hob;
size wfac;
{
/* LOE g: Load external word g */
register ptr p = i2p(S_arg(hob) * wfac);
LOG(("@L6 DoLOEs(%lu)", p));
spoilFRA();
pushw_m(arg_g(p));
}
DoLILm(arg)
long arg;
{ {
/* LIL l: Load word pointed to by l-th local or parameter */ /* LIL l: Load word pointed to by l-th local or parameter */
register long l = arg_l(arg);
LOG(("@L6 DoLILm(%ld)", l)); LOG(("@L6 DoLIL(%ld)", l));
spoilFRA();
pushw_m(st_lddp(loc_addr(l)));
}
DoLILn2(arg)
long arg;
{
/* LIL l: Load word pointed to by l-th local or parameter */
register long l = (N_arg_2() * arg);
LOG(("@L6 DoLILn2(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
pushw_m(st_lddp(loc_addr(l))); pushw_m(st_lddp(loc_addr(l)));
} }
DoLILn4(arg) DoLOF(l)
long arg; register long l;
{
/* LIL l: Load word pointed to by l-th local or parameter */
register long l = (N_arg_4() * arg);
LOG(("@L6 DoLILn4(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_m(st_lddp(loc_addr(l)));
}
DoLILp2(arg)
long arg;
{
/* LIL l: Load word pointed to by l-th local or parameter */
register long l = (P_arg_2() * arg);
LOG(("@L6 DoLILp2(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_m(st_lddp(loc_addr(l)));
}
DoLILp4(arg)
long arg;
{
/* LIL l: Load word pointed to by l-th local or parameter */
register long l = (P_arg_4() * arg);
LOG(("@L6 DoLILp4(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_m(st_lddp(loc_addr(l)));
}
DoLILs(hob, wfac)
long hob;
size wfac;
{
/* LIL l: Load word pointed to by l-th local or parameter */
register long l = (S_arg(hob) * wfac);
LOG(("@L6 DoLILs(%ld)", l));
spoilFRA();
l = arg_l(l);
pushw_m(st_lddp(loc_addr(l)));
}
DoLOFl2(arg)
long arg;
{ {
/* LOF f: Load offsetted (top of stack + f yield address) */ /* LOF f: Load offsetted (top of stack + f yield address) */
register long l = (L_arg_2() * arg);
register ptr p = dppop(); register ptr p = dppop();
LOG(("@L6 DoLOFl2(%ld)", l)); LOG(("@L6 DoLOF(%ld)", l));
spoilFRA(); spoilFRA();
pushw_m(p + arg_f(l)); pushw_m(p + arg_f(l));
} }
DoLOFl4(arg) DoLAL(l)
long arg; register long l;
{
/* LOF f: Load offsetted (top of stack + f yield address) */
register long l = (L_arg_4() * arg);
register ptr p = dppop();
LOG(("@L6 DoLOFl4(%ld)", l));
spoilFRA();
pushw_m(p + arg_f(l));
}
DoLOFm(arg)
long arg;
{
/* LOF f: Load offsetted (top of stack + f yield address) */
register long l = arg;
register ptr p = dppop();
LOG(("@L6 DoLOFm(%ld)", l));
spoilFRA();
pushw_m(p + arg_f(l));
}
DoLOFs(hob, wfac)
long hob;
size wfac;
{
/* LOF f: Load offsetted (top of stack + f yield address) */
register long l = (S_arg(hob) * wfac);
register ptr p = dppop();
LOG(("@L6 DoLOFs(%ld)", l));
spoilFRA();
pushw_m(p + arg_f(l));
}
DoLALm(arg)
long arg;
{ {
/* LAL l: Load address of local or parameter */ /* LAL l: Load address of local or parameter */
register long l = arg_l(arg);
LOG(("@L6 DoLALm(%ld)", l)); LOG(("@L6 DoLAL(%ld)", l));
spoilFRA();
dppush(loc_addr(l));
}
DoLALn2(arg)
long arg;
{
/* LAL l: Load address of local or parameter */
register long l = (N_arg_2() * arg);
LOG(("@L6 DoLALn2(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
dppush(loc_addr(l)); dppush(loc_addr(l));
} }
DoLALn4(arg) DoLAE(arg)
long arg; register unsigned long arg;
{
/* LAL l: Load address of local or parameter */
register long l = (N_arg_4() * arg);
LOG(("@L6 DoLALn4(%ld)", l));
spoilFRA();
l = arg_l(l);
dppush(loc_addr(l));
}
DoLALp2(arg)
long arg;
{
/* LAL l: Load address of local or parameter */
register long l = (P_arg_2() * arg);
LOG(("@L6 DoLALp2(%ld)", l));
spoilFRA();
l = arg_l(l);
dppush(loc_addr(l));
}
DoLALp4(arg)
long arg;
{
/* LAL l: Load address of local or parameter */
register long l = (P_arg_4() * arg);
LOG(("@L6 DoLALp4(%ld)", l));
spoilFRA();
l = arg_l(l);
dppush(loc_addr(l));
}
DoLALs(hob, wfac)
long hob;
size wfac;
{
/* LAL l: Load address of local or parameter */
register long l = (S_arg(hob) * wfac);
LOG(("@L6 DoLALs(%ld)", l));
spoilFRA();
l = arg_l(l);
dppush(loc_addr(l));
}
DoLAEu(arg)
long arg;
{ {
/* LAE g: Load address of external */ /* LAE g: Load address of external */
register ptr p = i2p(U_arg() * arg); register ptr p = i2p(arg);
LOG(("@L6 DoLAEu(%lu)", p)); LOG(("@L6 DoLAE(%lu)", p));
spoilFRA(); spoilFRA();
dppush(arg_lae(p)); dppush(arg_lae(p));
} }
DoLAEl4(arg) DoLXL(l)
long arg; register unsigned long l;
{
/* LAE g: Load address of external */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@L6 DoLAEl4(%lu)", p));
spoilFRA();
dppush(arg_lae(p));
}
DoLAEs(hob, wfac)
long hob;
size wfac;
{
/* LAE g: Load address of external */
register ptr p = i2p(S_arg(hob) * wfac);
LOG(("@L6 DoLAEs(%lu)", p));
spoilFRA();
dppush(arg_lae(p));
}
DoLXLl2(arg)
unsigned long arg;
{ {
/* LXL n: Load lexical (address of LB n static levels back) */ /* LXL n: Load lexical (address of LB n static levels back) */
register unsigned long l = (L_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@L6 DoLXLl2(%lu)", l)); LOG(("@L6 DoLXL(%lu)", l));
spoilFRA(); spoilFRA();
l = arg_n(l); l = arg_n(l);
p = lexback_LB(l); p = lexback_LB(l);
dppush(p); dppush(p);
} }
DoLXLm(arg) DoLXA(l)
unsigned long arg; register unsigned long l;
{
/* LXL n: Load lexical (address of LB n static levels back) */
register unsigned long l = arg_n(arg);
register ptr p;
LOG(("@L6 DoLXLm(%lu)", l));
spoilFRA();
p = lexback_LB(l);
dppush(p);
}
DoLXAl2(arg)
unsigned long arg;
{ {
/* LXA n: Load lexical (address of AB n static levels back) */ /* LXA n: Load lexical (address of AB n static levels back) */
register unsigned long l = (P_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@L6 DoLXAl2(%lu)", l)); LOG(("@L6 DoLXA(%lu)", l));
spoilFRA(); spoilFRA();
l = arg_n(l); l = arg_n(l);
p = lexback_LB(l); p = lexback_LB(l);
dppush(p + rsbsize); dppush(p + rsbsize);
} }
DoLXAm(arg) DoLOI(l)
unsigned long arg; register size l;
{
/* LXA n: Load lexical (address of AB n static levels back) */
register unsigned long l = arg_n(arg);
register ptr p;
LOG(("@L6 DoLXAm(%lu)", l));
spoilFRA();
p = lexback_LB(l);
dppush(p + rsbsize);
}
DoLOIl2(arg)
size arg;
{ {
/* LOI o: Load indirect o bytes (address is popped from the stack) */ /* LOI o: Load indirect o bytes (address is popped from the stack) */
register size l = (L_arg_2() * arg);
register ptr p = dppop(); register ptr p = dppop();
LOG(("@L6 DoLOIl2(%ld)", l)); LOG(("@L6 DoLOI(%ld)", l));
spoilFRA();
push_m(p, arg_o(l));
}
DoLOIl4(arg)
size arg;
{
/* LOI o: Load indirect o bytes (address is popped from the stack) */
register size l = (L_arg_4() * arg);
register ptr p = dppop();
LOG(("@L6 DoLOIl4(%ld)", l));
spoilFRA();
push_m(p, arg_o(l));
}
DoLOIm(arg)
size arg;
{
/* LOI o: Load indirect o bytes (address is popped from the stack) */
register size l = arg_o(arg);
register ptr p = dppop();
LOG(("@L6 DoLOIm(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_o(l);
push_m(p, l); push_m(p, l);
} }
DoLOIs(hob, wfac) DoLOS(l)
long hob; register size l;
size wfac;
{
/* LOI o: Load indirect o bytes (address is popped from the stack) */
register size l = (S_arg(hob) * wfac);
register ptr p = dppop();
LOG(("@L6 DoLOIs(%ld)", l));
spoilFRA();
push_m(p, arg_o(l));
}
DoLOSl2(arg)
size arg;
{ {
/* LOS w: Load indirect, w-byte integer on top of stack gives object size */ /* LOS w: Load indirect, w-byte integer on top of stack gives object size */
register size l = (P_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@L6 DoLOSl2(%ld)", l)); LOG(("@L6 DoLOS(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_wi(l); l = arg_wi(l);
l = upop(l); l = upop(l);
@ -545,169 +155,45 @@ DoLOSl2(arg)
push_m(p, arg_o(l)); push_m(p, arg_o(l));
} }
DoLOSz() DoLDL(l)
{ register long l;
/* LOS w: Load indirect, w-byte integer on top of stack gives object size */
register size l = uwpop();
register ptr p;
LOG(("@L6 DoLOSz(%ld)", l));
spoilFRA();
l = arg_wi(l);
l = upop(l);
p = dppop();
push_m(p, arg_o(l));
}
DoLDLm(arg)
long arg;
{ {
/* LDL l: Load double local or parameter (two consecutive words are stacked) */ /* LDL l: Load double local or parameter (two consecutive words are stacked) */
register long l = arg_l(arg);
LOG(("@L6 DoLDLm(%ld)", l)); LOG(("@L6 DoLDL(%ld)", l));
spoilFRA();
push_st(loc_addr(l), dwsize);
}
DoLDLn2(arg)
long arg;
{
/* LDL l: Load double local or parameter (two consecutive words are stacked) */
register long l = (N_arg_2() * arg);
LOG(("@L6 DoLDLn2(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
push_st(loc_addr(l), dwsize); push_st(loc_addr(l), dwsize);
} }
DoLDLn4(arg) DoLDE(arg)
long arg; register long arg;
{
/* LDL l: Load double local or parameter (two consecutive words are stacked) */
register long l = (N_arg_4() * arg);
LOG(("@L6 DoLDLn4(%ld)", l));
spoilFRA();
l = arg_l(l);
push_st(loc_addr(l), dwsize);
}
DoLDLp2(arg)
long arg;
{
/* LDL l: Load double local or parameter (two consecutive words are stacked) */
register long l = (P_arg_2() * arg);
LOG(("@L6 DoLDLp2(%ld)", l));
spoilFRA();
l = arg_l(l);
push_st(loc_addr(l), dwsize);
}
DoLDLp4(arg)
long arg;
{
/* LDL l: Load double local or parameter (two consecutive words are stacked) */
register long l = (P_arg_4() * arg);
LOG(("@L6 DoLDLp4(%ld)", l));
spoilFRA();
l = arg_l(l);
push_st(loc_addr(l), dwsize);
}
DoLDLs(hob, wfac)
long hob;
size wfac;
{
/* LDL l: Load double local or parameter (two consecutive words are stacked) */
register long l = (S_arg(hob) * wfac);
LOG(("@L6 DoLDLs(%ld)", l));
spoilFRA();
l = arg_l(l);
push_st(loc_addr(l), dwsize);
}
DoLDEl2(arg)
long arg;
{ {
/* LDE g: Load double external (two consecutive externals are stacked) */ /* LDE g: Load double external (two consecutive externals are stacked) */
register ptr p = i2p(L_arg_2() * arg); register ptr p = i2p(arg);
LOG(("@L6 DoLDEl2(%lu)", p)); LOG(("@L6 DoLDE(%lu)", p));
spoilFRA(); spoilFRA();
push_m(arg_g(p), dwsize); push_m(arg_g(p), dwsize);
} }
DoLDEl4(arg) DoLDF(l)
long arg; register long l;
{
/* LDE g: Load double external (two consecutive externals are stacked) */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@L6 DoLDEl4(%lu)", p));
spoilFRA();
push_m(arg_g(p), dwsize);
}
DoLDEs(hob, wfac)
long hob;
size wfac;
{
/* LDE g: Load double external (two consecutive externals are stacked) */
register ptr p = i2p(S_arg(hob) * wfac);
LOG(("@L6 DoLDEs(%lu)", p));
spoilFRA();
push_m(arg_g(p), dwsize);
}
DoLDFl2(arg)
long arg;
{ {
/* LDF f: Load double offsetted (top of stack + f yield address) */ /* LDF f: Load double offsetted (top of stack + f yield address) */
register long l = (L_arg_2() * arg);
register ptr p = dppop(); register ptr p = dppop();
LOG(("@L6 DoLDFl2(%ld)", l)); LOG(("@L6 DoLDF(%ld)", l));
spoilFRA(); spoilFRA();
push_m(p + arg_f(l), dwsize); push_m(p + arg_f(l), dwsize);
} }
DoLDFl4(arg) DoLPI(pi)
long arg; register long pi;
{
/* LDF f: Load double offsetted (top of stack + f yield address) */
register long l = (L_arg_4() * arg);
register ptr p = dppop();
LOG(("@L6 DoLDFl4(%ld)", l));
spoilFRA();
push_m(p + arg_f(l), dwsize);
}
DoLPIl2(arg)
long arg;
{ {
/* LPI p: Load procedure identifier */ /* LPI p: Load procedure identifier */
register long pi = (L_arg_2() * arg);
LOG(("@L6 DoLPIl2(%ld)", pi)); LOG(("@L6 DoLPI(%ld)", pi));
spoilFRA();
npush(arg_p(pi), psize);
}
DoLPIl4(arg)
long arg;
{
/* LPI p: Load procedure identifier */
register long pi = (L_arg_4() * arg);
LOG(("@L6 DoLPIl4(%ld)", pi));
spoilFRA(); spoilFRA();
npush(arg_p(pi), psize); npush(arg_p(pi), psize);
} }

224
util/int/do_logic.c
View file

@ -25,47 +25,14 @@ extern int must_test;
#define check_def(p,l) #define check_def(p,l)
#endif LOGGING #endif LOGGING
DoANDl2(arg) DoAND(l)
size arg; register size l;
{
/* AND w: Boolean and on two groups of w bytes */
register size l = (L_arg_2() * arg);
register ptr p;
LOG(("@X6 DoANDl2(%ld)", l));
spoilFRA();
l = arg_w(l);
for (p = SP; p < (SP + l); p++) {
check_def(p, l);
stack_loc(p + l) &= stack_loc(p);
}
st_dec(l);
}
DoANDm(arg)
size arg;
{
/* AND w: Boolean and on two groups of w bytes */
register size l = arg_w(arg);
register ptr p;
LOG(("@X6 DoANDm(%ld)", l));
spoilFRA();
for (p = SP; p < (SP + l); p ++) {
check_def(p, l);
stack_loc(p + l) &= stack_loc(p);
}
st_dec(l);
}
DoANDz()
{ {
/* AND w: Boolean and on two groups of w bytes */ /* AND w: Boolean and on two groups of w bytes */
/* size of objects to be compared (in bytes) on top of stack */ /* size of objects to be compared (in bytes) on top of stack */
register size l = uwpop();
register ptr p; register ptr p;
LOG(("@X6 DoANDz(%ld)", l)); LOG(("@X6 DoAND(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_w(l); l = arg_w(l);
for (p = SP; p < (SP + l); p++) { for (p = SP; p < (SP + l); p++) {
@ -75,14 +42,13 @@ DoANDz()
st_dec(l); st_dec(l);
} }
DoIORl2(arg) DoIOR(l)
size arg; register size l;
{ {
/* IOR w: Boolean inclusive or on two groups of w bytes */ /* IOR w: Boolean inclusive or on two groups of w bytes */
register size l = (L_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@X6 DoIORl2(%ld)", l)); LOG(("@X6 DoIOR(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_w(l); l = arg_w(l);
for (p = SP; p < (SP + l); p++) { for (p = SP; p < (SP + l); p++) {
@ -92,64 +58,13 @@ DoIORl2(arg)
st_dec(l); st_dec(l);
} }
DoIORm(arg) DoXOR(l)
size arg; register size l;
{
/* IOR w: Boolean inclusive or on two groups of w bytes */
register size l = arg_w(arg);
register ptr p;
LOG(("@X6 DoIORm(%ld)", l));
spoilFRA();
for (p = SP; p < (SP + l); p++) {
check_def(p, l);
stack_loc(p + l) |= stack_loc(p);
}
st_dec(l);
}
DoIORs(hob, wfac)
long hob;
size wfac;
{
/* IOR w: Boolean inclusive or on two groups of w bytes */
register size l = (S_arg(hob) * wfac);
register ptr p;
LOG(("@X6 DoIORs(%ld)", l));
spoilFRA();
l = arg_w(l);
for (p = SP; p < (SP + l); p++) {
check_def(p, l);
stack_loc(p + l) |= stack_loc(p);
}
st_dec(l);
}
DoIORz()
{
/* IOR w: Boolean inclusive or on two groups of w bytes */
register size l = uwpop();
register ptr p;
LOG(("@X6 DoIORz(%ld)", l));
spoilFRA();
l = arg_w(l);
for (p = SP; p < (SP + l); p++) {
check_def(p, l);
stack_loc(p + l) |= stack_loc(p);
}
st_dec(l);
}
DoXORl2(arg)
size arg;
{ {
/* XOR w: Boolean exclusive or on two groups of w bytes */ /* XOR w: Boolean exclusive or on two groups of w bytes */
register size l = (L_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@X6 DoXORl2(%ld)", l)); LOG(("@X6 DoXOR(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_w(l); l = arg_w(l);
for (p = SP; p < (SP + l); p++) { for (p = SP; p < (SP + l); p++) {
@ -159,30 +74,13 @@ DoXORl2(arg)
st_dec(l); st_dec(l);
} }
DoXORz() DoCOM(l)
{ register size l;
/* XOR w: Boolean exclusive or on two groups of w bytes */
register size l = uwpop();
register ptr p;
LOG(("@X6 DoXORz(%ld)", l));
spoilFRA();
l = arg_w(l);
for (p = SP; p < (SP + l); p++) {
check_def(p, l);
stack_loc(p + l) ^= stack_loc(p);
}
st_dec(l);
}
DoCOMl2(arg)
size arg;
{ {
/* COM w: Complement (one's complement of top w bytes) */ /* COM w: Complement (one's complement of top w bytes) */
register size l = (L_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@X6 DoCOMl2(%ld)", l)); LOG(("@X6 DoCOM(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_w(l); l = arg_w(l);
for (p = SP; p < (SP + l); p++) { for (p = SP; p < (SP + l); p++) {
@ -191,30 +89,14 @@ DoCOMl2(arg)
} }
} }
DoCOMz() DoROL(l)
{ register size l;
/* COM w: Complement (one's complement of top w bytes) */
register size l = uwpop();
register ptr p;
LOG(("@X6 DoCOMz(%ld)", l));
spoilFRA();
l = arg_w(l);
for (p = SP; p < (SP + l); p++) {
check_def(p, 0);
stack_loc(p) = ~stack_loc(p);
}
}
DoROLl2(arg)
size arg;
{ {
/* ROL w: Rotate left a group of w bytes */ /* ROL w: Rotate left a group of w bytes */
register size l = (L_arg_2() * arg);
register long s, t = uwpop(); register long s, t = uwpop();
register long signbit; register long signbit;
LOG(("@X6 DoROLl2(%ld)", l)); LOG(("@X6 DoROL(%ld)", l));
spoilFRA(); spoilFRA();
signbit = (arg_wi(l) == 2) ? SIGNBIT2 : SIGNBIT4; signbit = (arg_wi(l) == 2) ? SIGNBIT2 : SIGNBIT4;
s = upop(l); s = upop(l);
@ -240,84 +122,14 @@ DoROLl2(arg)
npush(s, l); npush(s, l);
} }
DoROLz() DoROR(l)
{ register size l;
/* ROL w: Rotate left a group of w bytes */
register size l = uwpop();
register long s, t = uwpop();
register long signbit;
LOG(("@X6 DoROLz(%ld)", l));
spoilFRA();
signbit = (arg_wi(l) == 2) ? SIGNBIT2 : SIGNBIT4;
s = upop(l);
#ifdef LOGGING
if (must_test) {
/* check shift distance */
if (t < 0) {
warning(WSHNEG);
t = 0;
}
if (t >= l*8) {
warning(WSHLARGE);
t = l*8 - 1;
}
}
#endif LOGGING
/* calculate result */
while (t--) {
s = (s & signbit) ? ((s<<1) | BIT(0)) : (s<<1);
}
npush(s, l);
}
DoRORl2(arg)
size arg;
{ {
/* ROR w: Rotate right a group of w bytes */ /* ROR w: Rotate right a group of w bytes */
register size l = (L_arg_2() * arg);
register long s, t = uwpop(); register long s, t = uwpop();
register long signbit; register long signbit;
LOG(("@X6 DoRORl2(%ld)", l)); LOG(("@X6 DoROR(%ld)", l));
spoilFRA();
signbit = (l == 2) ? SIGNBIT2 : SIGNBIT4;
s = upop(arg_wi(l));
#ifdef LOGGING
if (must_test) {
/* check shift distance */
if (t < 0) {
warning(WSHNEG);
t = 0;
}
if (t >= l*8) {
warning(WSHLARGE);
t = l*8 - 1;
}
}
#endif LOGGING
/* calculate result */
while (t--) {
/* the >> in C does sign extension, the ROR does not */
if (s & BIT(0))
s = (s >> 1) | signbit;
else s = (s >> 1) & ~signbit;
}
npush(s, l);
}
DoRORz()
{
/* ROR w: Rotate right a group of w bytes */
register size l = uwpop();
register long s, t = uwpop();
register long signbit;
LOG(("@X6 DoRORz(%ld)", l));
spoilFRA(); spoilFRA();
signbit = (arg_wi(l) == 2) ? SIGNBIT2 : SIGNBIT4; signbit = (arg_wi(l) == 2) ? SIGNBIT2 : SIGNBIT4;
s = upop(l); s = upop(l);

394
util/int/do_misc.c
View file

@ -30,65 +30,21 @@ PRIVATE gto();
#define asp(l) newSP(SP + arg_f(l)) #define asp(l) newSP(SP + arg_f(l))
DoASPl2(arg) DoASP(l)
long arg; register long l;
{ {
/* ASP f: Adjust the stack pointer by f */ /* ASP f: Adjust the stack pointer by f */
register long l = (L_arg_2() * arg);
LOG(("@M6 DoASPl2(%ld)", l)); LOG(("@M6 DoASP(%ld)", l));
asp(l); asp(l);
} }
DoASPl4(arg) DoASS(l)
long arg; register size l;
{
/* ASP f: Adjust the stack pointer by f */
register long l = (L_arg_4() * arg);
LOG(("@M6 DoASPl4(%ld)", l));
asp(l);
}
DoASPm(arg)
long arg;
{
/* ASP f: Adjust the stack pointer by f */
register long l = arg;
LOG(("@M6 DoASPm(%ld)", l));
asp(l);
}
DoASPs(hob, wfac)
long hob;
size wfac;
{
/* ASP f: Adjust the stack pointer by f */
register long l = (S_arg(hob) * wfac);
LOG(("@M6 DoASPs(%ld)", l));
asp(l);
}
DoASSl2(arg)
size arg;
{ {
/* ASS w: Adjust the stack pointer by w-byte integer */ /* ASS w: Adjust the stack pointer by w-byte integer */
register size l = (L_arg_2() * arg);
LOG(("@M6 DoASSl2(%ld)", l)); LOG(("@M6 DoASS(%ld)", l));
spoilFRA();
l = spop(arg_wi(l));
asp(l);
}
DoASSz()
{
/* ASS w: Adjust the stack pointer by w-byte integer */
register size l = uwpop();
LOG(("@M6 DoASSz(%ld)", l));
spoilFRA(); spoilFRA();
l = spop(arg_wi(l)); l = spop(arg_wi(l));
asp(l); asp(l);
@ -101,57 +57,26 @@ DoASSz()
else { if (in_stack(a2)) dt_mvs(a1, a2, n); \ else { if (in_stack(a2)) dt_mvs(a1, a2, n); \
else dt_mvd(a1, a2, n); } else dt_mvd(a1, a2, n); }
DoBLMl2(arg) DoBLM(l)
size arg; register size l;
{ {
/* BLM z: Block move z bytes; first pop destination addr, then source addr */ /* BLM z: Block move z bytes; first pop destination addr, then source addr */
register size l = (L_arg_2() * arg);
register ptr dp1, dp2; /* Destination Pointers */ register ptr dp1, dp2; /* Destination Pointers */
LOG(("@M6 DoBLMl2(%ld)", l)); LOG(("@M6 DoBLM(%ld)", l));
spoilFRA(); spoilFRA();
dp1 = dppop(); dp1 = dppop();
dp2 = dppop(); dp2 = dppop();
block_move(dp1, dp2, arg_z(l)); block_move(dp1, dp2, arg_z(l));
} }
DoBLMl4(arg) DoBLS(l)
size arg; register size l;
{
/* BLM z: Block move z bytes; first pop destination addr, then source addr */
register size l = (L_arg_4() * arg);
register ptr dp1, dp2; /* Destination Pointer */
LOG(("@M6 DoBLMl4(%ld)", l));
spoilFRA();
dp1 = dppop();
dp2 = dppop();
block_move(dp1, dp2, arg_z(l));
}
DoBLMs(hob, wfac)
long hob;
size wfac;
{
/* BLM z: Block move z bytes; first pop destination addr, then source addr */
register size l = (S_arg(hob) * wfac);
register ptr dp1, dp2; /* Destination Pointer */
LOG(("@M6 DoBLMs(%ld)", l));
spoilFRA();
dp1 = dppop();
dp2 = dppop();
block_move(dp1, dp2, arg_z(l));
}
DoBLSl2(arg)
size arg;
{ {
/* BLS w: Block move, size is in w-byte integer on top of stack */ /* BLS w: Block move, size is in w-byte integer on top of stack */
register size l = (L_arg_2() * arg);
register ptr dp1, dp2; register ptr dp1, dp2;
LOG(("@M6 DoBLSl2(%ld)", l)); LOG(("@M6 DoBLS(%ld)", l));
spoilFRA(); spoilFRA();
l = upop(arg_wi(l)); l = upop(arg_wi(l));
dp1 = dppop(); dp1 = dppop();
@ -159,86 +84,32 @@ DoBLSl2(arg)
block_move(dp1, dp2, arg_z(l)); block_move(dp1, dp2, arg_z(l));
} }
DoBLSz() DoCSA(l)
{ register size l;
/* BLS w: Block move, size is in w-byte integer on top of stack */
register size l = uwpop();
register ptr dp1, dp2;
LOG(("@M6 DoBLSz(%ld)", l));
spoilFRA();
l = upop(arg_wi(l));
dp1 = dppop();
dp2 = dppop();
block_move(dp1, dp2, arg_z(l));
}
DoCSAl2(arg)
size arg;
{ {
/* CSA w: Case jump; address of jump table at top of stack */ /* CSA w: Case jump; address of jump table at top of stack */
register size l = (L_arg_2() * arg);
LOG(("@M6 DoCSAl2(%ld)", l)); LOG(("@M6 DoCSA(%ld)", l));
spoilFRA(); spoilFRA();
index_jump(arg_wi(l)); index_jump(arg_wi(l));
} }
DoCSAm(arg) DoCSB(l)
size arg; register size l;
{
/* CSA w: Case jump; address of jump table at top of stack */
LOG(("@M6 DoCSAm(%ld)", arg));
spoilFRA();
index_jump(arg_wi(arg));
}
DoCSAz()
{
/* CSA w: Case jump; address of jump table at top of stack */
register size l = uwpop();
LOG(("@M6 DoCSAz(%ld)", l));
spoilFRA();
index_jump(arg_wi(l));
}
DoCSBl2(arg)
size arg;
{ {
/* CSB w: Table lookup jump; address of jump table at top of stack */ /* CSB w: Table lookup jump; address of jump table at top of stack */
register size l = (L_arg_2() * arg);
LOG(("@M6 DoCSBl2(%ld)", l)); LOG(("@M6 DoCSB(%ld)", l));
spoilFRA(); spoilFRA();
search_jump(arg_wi(l)); search_jump(arg_wi(l));
} }
DoCSBm(arg) DoDCH()
size arg;
{
/* CSB w: Table lookup jump; address of jump table at top of stack */
LOG(("@M6 DoCSBm(%ld)", arg));
spoilFRA();
search_jump(arg_wi(arg));
}
DoCSBz()
{
/* CSB w: Table lookup jump; address of jump table at top of stack */
register size l = uwpop();
LOG(("@M6 DoCSBz(%ld)", l));
spoilFRA();
search_jump(arg_wi(l));
}
DoDCHz()
{ {
/* DCH -: Follow dynamic chain, convert LB to LB of caller */ /* DCH -: Follow dynamic chain, convert LB to LB of caller */
register ptr lb; register ptr lb;
LOG(("@M6 DoDCHz()")); LOG(("@M6 DoDCH()"));
spoilFRA(); spoilFRA();
lb = dppop(); lb = dppop();
if (!is_LB(lb)) { if (!is_LB(lb)) {
@ -247,39 +118,25 @@ DoDCHz()
dppush(st_lddp(lb + rsb_LB)); dppush(st_lddp(lb + rsb_LB));
} }
DoDUPl2(arg) DoDUP(arg)
size arg;
{
/* DUP s: Duplicate top s bytes */
register size l = (L_arg_2() * arg);
register ptr oldSP = SP;
LOG(("@M6 DoDUPl2(%ld)", l));
spoilFRA();
st_inc(arg_s(l));
st_mvs(SP, oldSP, l);
}
DoDUPm(arg)
size arg; size arg;
{ {
/* DUP s: Duplicate top s bytes */ /* DUP s: Duplicate top s bytes */
register ptr oldSP = SP; register ptr oldSP = SP;
LOG(("@M6 DoDUPm(%ld)", arg)); LOG(("@M6 DoDUP(%ld)", arg));
spoilFRA(); spoilFRA();
st_inc(arg_s(arg)); st_inc(arg_s(arg));
st_mvs(SP, oldSP, arg); st_mvs(SP, oldSP, arg);
} }
DoDUSl2(arg) DoDUS(l)
size arg; register size l;
{ {
/* DUS w: Duplicate top w bytes */ /* DUS w: Duplicate top w bytes */
register size l = (L_arg_2() * arg);
register ptr oldSP; register ptr oldSP;
LOG(("@M6 DoDUSl2(%ld)", l)); LOG(("@M6 DoDUS(%ld)", l));
spoilFRA(); spoilFRA();
l = upop(arg_wi(l)); l = upop(arg_wi(l));
oldSP = SP; oldSP = SP;
@ -287,28 +144,13 @@ DoDUSl2(arg)
st_mvs(SP, oldSP, l); st_mvs(SP, oldSP, l);
} }
DoDUSz() DoEXG(l)
{ register size l;
/* DUS w: Duplicate top w bytes */
register size l = uwpop();
register ptr oldSP;
LOG(("@M6 DoDUSz(%ld)", l));
spoilFRA();
l = upop(arg_wi(l));
oldSP = SP;
st_inc(arg_s(l));
st_mvs(SP, oldSP, l);
}
DoEXGl2(arg)
size arg;
{ {
/* EXG w: Exchange top w bytes */ /* EXG w: Exchange top w bytes */
register size l = (L_arg_2() * arg);
register ptr oldSP = SP; register ptr oldSP = SP;
LOG(("@M6 DoEXGl2(%ld)", l)); LOG(("@M6 DoEXG(%ld)", l));
spoilFRA(); spoilFRA();
st_inc(arg_w(l)); st_inc(arg_w(l));
st_mvs(SP, oldSP, l); st_mvs(SP, oldSP, l);
@ -317,45 +159,13 @@ DoEXGl2(arg)
st_dec(l); st_dec(l);
} }
DoEXGs(hob, wfac) DoFIL(arg)
long hob; register unsigned long arg;
size wfac;
{
/* EXG w: Exchange top w bytes */
register size l = (S_arg(hob) * wfac);
register ptr oldSP = SP;
LOG(("@M6 DoEXGs(%ld)", l));
spoilFRA();
st_inc(arg_w(l));
st_mvs(SP, oldSP, l);
st_mvs(oldSP, oldSP + l, l);
st_mvs(oldSP + l, SP, l);
st_dec(l);
}
DoEXGz()
{
/* EXG w: Exchange top w bytes */
register size l = uwpop();
register ptr oldSP = SP;
LOG(("@M6 DoEXGz(%ld)", l));
spoilFRA();
st_inc(arg_w(l));
st_mvs(SP, oldSP, l);
st_mvs(oldSP, oldSP + l, l);
st_mvs(oldSP + l, SP, l);
st_dec(l);
}
DoFILu(arg)
long arg;
{ {
/* FIL g: File name (external 4 := g) */ /* FIL g: File name (external 4 := g) */
register ptr p = i2p(U_arg() * arg); register ptr p = i2p(arg);
LOG(("@M6 DoFILu(%lu)", p)); LOG(("@M6 DoFIL(%lu)", p));
spoilFRA(); spoilFRA();
if (p > HB) { if (p > HB) {
wtrap(WILLFIL, EILLINS); wtrap(WILLFIL, EILLINS);
@ -363,98 +173,48 @@ DoFILu(arg)
putFIL(arg_g(p)); putFIL(arg_g(p));
} }
DoFILl4(arg) DoGTO(arg)
long arg; register unsigned long arg;
{
/* FIL g: File name (external 4 := g) */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@M6 DoFILl4(%lu)", p));
spoilFRA();
if (p > HB) {
wtrap(WILLFIL, EILLINS);
}
putFIL(arg_g(p));
}
DoGTOu(arg)
long arg;
{ {
/* GTO g: Non-local goto, descriptor at g */ /* GTO g: Non-local goto, descriptor at g */
register ptr p = i2p(U_arg() * arg); register ptr p = i2p(arg);
LOG(("@M6 DoGTOu(%lu)", p)); LOG(("@M6 DoGTO(%lu)", p));
gto(arg_gto(p)); gto(arg_gto(p));
} }
DoGTOl4(arg) DoLIM()
long arg;
{
/* GTO g: Non-local goto, descriptor at g */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@M6 DoGTOl4(%lu)", p));
gto(arg_gto(p));
}
DoLIMz()
{ {
/* LIM -: Load 16 bit ignore mask */ /* LIM -: Load 16 bit ignore mask */
LOG(("@M6 DoLIMz()")); LOG(("@M6 DoLIM()"));
spoilFRA(); spoilFRA();
wpush(IgnMask); wpush(IgnMask);
} }
DoLINl2(arg) DoLIN(l)
long arg; register unsigned long l;
{ {
/* LIN n: Line number (external 0 := n) */ /* LIN n: Line number (external 0 := n) */
register unsigned long l = (L_arg_2() * arg);
LOG(("@M6 DoLINl2(%lu)", l)); LOG(("@M6 DoLIN(%lu)", l));
spoilFRA(); spoilFRA();
putLIN((long) arg_lin(l)); putLIN((long) arg_lin(l));
} }
DoLINl4(arg) DoLNI()
long arg;
{
/* LIN n: Line number (external 0 := n) */
register unsigned long l = (L_arg_4() * arg);
LOG(("@M6 DoLINl4(%lu)", l));
spoilFRA();
putLIN((long) arg_lin(l));
}
DoLINs(hob, wfac)
long hob;
size wfac;
{
/* LIN n: Line number (external 0 := n) */
register unsigned long l = (S_arg(hob) * wfac);
LOG(("@M6 DoLINs(%lu)", l));
spoilFRA();
putLIN((long) arg_lin(l));
}
DoLNIz()
{ {
/* LNI -: Line number increment */ /* LNI -: Line number increment */
LOG(("@M6 DoLNIz()")); LOG(("@M6 DoLNI()"));
spoilFRA(); spoilFRA();
putLIN((long)getLIN() + 1); putLIN((long)getLIN() + 1);
} }
DoLORs(hob, wfac) DoLOR(l)
long hob; register long l;
size wfac;
{ {
/* LOR r: Load register (0=LB, 1=SP, 2=HP) */ /* LOR r: Load register (0=LB, 1=SP, 2=HP) */
register long l = (S_arg(hob) * wfac);
LOG(("@M6 DoLORs(%ld)", l)); LOG(("@M6 DoLOR(%ld)", l));
spoilFRA(); spoilFRA();
switch ((int) arg_r(l)) { switch ((int) arg_r(l)) {
case 0: case 0:
@ -469,12 +229,12 @@ DoLORs(hob, wfac)
} }
} }
DoLPBz() DoLPB()
{ {
/* LPB -: Convert local base to argument base */ /* LPB -: Convert local base to argument base */
register ptr lb; register ptr lb;
LOG(("@M6 DoLPBz()")); LOG(("@M6 DoLPB()"));
spoilFRA(); spoilFRA();
lb = dppop(); lb = dppop();
if (!is_LB(lb)) { if (!is_LB(lb)) {
@ -483,56 +243,36 @@ DoLPBz()
dppush(lb + rsbsize); dppush(lb + rsbsize);
} }
DoMONz() DoMON()
{ {
/* MON -: Monitor call */ /* MON -: Monitor call */
LOG(("@M6 DoMONz()")); LOG(("@M6 DoMON()"));
spoilFRA(); spoilFRA();
moncall(); moncall();
} }
DoNOPz() DoNOP()
{ {
/* NOP -: No operation */ /* NOP -: No operation */
LOG(("@M6 DoNOPz()")); LOG(("@M6 DoNOP()"));
spoilFRA(); spoilFRA();
message("NOP instruction"); message("NOP instruction");
} }
DoRCKl2(arg) DoRCK(l)
size arg; register size l;
{ {
/* RCK w: Range check; trap on error */ /* RCK w: Range check; trap on error */
register size l = (L_arg_2() * arg);
LOG(("@M6 DoRCKl2(%ld)", l)); LOG(("@M6 DoRCK(%ld)", l));
spoilFRA(); spoilFRA();
range_check(arg_wi(l)); range_check(arg_wi(l));
} }
DoRCKm(arg) DoRTT()
size arg;
{
/* RCK w: Range check; trap on error */
LOG(("@M6 DoRCKm(%ld)", arg));
spoilFRA();
range_check(arg_wi(arg));
}
DoRCKz()
{
/* RCK w: Range check; trap on error */
register size l = uwpop();
LOG(("@M6 DoRCKz(%ld)", l));
spoilFRA();
range_check(arg_wi(l));
}
DoRTTz()
{ {
/* RTT -: Return from trap */ /* RTT -: Return from trap */
LOG(("@M6 DoRTTz()")); LOG(("@M6 DoRTT()"));
switch (poprsb(1)) { switch (poprsb(1)) {
case RSB_STP: case RSB_STP:
@ -563,12 +303,12 @@ DoRTTz()
popFRA(FRASize); popFRA(FRASize);
} }
DoSIGz() DoSIG()
{ {
/* SIG -: Trap errors to proc identifier on top of stack, \-2 resets default */ /* SIG -: Trap errors to proc identifier on top of stack, \-2 resets default */
register long tpi = spop(psize); register long tpi = spop(psize);
LOG(("@M6 DoSIGz()")); LOG(("@M6 DoSIG()"));
spoilFRA(); spoilFRA();
if (OnTrap == TR_HALT) { if (OnTrap == TR_HALT) {
npush(-2L, psize); npush(-2L, psize);
@ -585,22 +325,20 @@ DoSIGz()
} }
} }
DoSIMz() DoSIM()
{ {
/* SIM -: Store 16 bit ignore mask */ /* SIM -: Store 16 bit ignore mask */
LOG(("@M6 DoSIMz()")); LOG(("@M6 DoSIM()"));
spoilFRA(); spoilFRA();
IgnMask = (uwpop() | PreIgnMask) & MASK2; IgnMask = (uwpop() | PreIgnMask) & MASK2;
} }
DoSTRs(hob, wfac) DoSTR(l)
long hob; register long l;
size wfac;
{ {
/* STR r: Store register (0=LB, 1=SP, 2=HP) */ /* STR r: Store register (0=LB, 1=SP, 2=HP) */
register long l = (S_arg(hob) * wfac);
LOG(("@M6 DoSTRs(%ld)", l)); LOG(("@M6 DoSTR(%ld)", l));
spoilFRA(); spoilFRA();
switch ((int) arg_r(l)) { switch ((int) arg_r(l)) {
case 0: case 0:
@ -616,12 +354,12 @@ DoSTRs(hob, wfac)
} }
} }
DoTRPz() DoTRP()
{ {
/* TRP -: Cause trap to occur (Error number on stack) */ /* TRP -: Cause trap to occur (Error number on stack) */
register unsigned int tr = (unsigned int)uwpop(); register unsigned int tr = (unsigned int)uwpop();
LOG(("@M6 DoTRPz()")); LOG(("@M6 DoTRP()"));
spoilFRA(); spoilFRA();
if (tr > 15 || !(IgnMask&BIT(tr))) { if (tr > 15 || !(IgnMask&BIT(tr))) {
wtrap(WTRP, (int)tr); wtrap(WTRP, (int)tr);

94
util/int/do_proc.c
View file

@ -23,111 +23,39 @@ extern int running; /* from main.c */
PRIVATE lfr(), ret(); PRIVATE lfr(), ret();
DoCAIz() /* proc identifier on top of stack */ DoCAI() /* proc identifier on top of stack */
{ {
/* CAI -: Call procedure (procedure identifier on stack) */ /* CAI -: Call procedure (procedure identifier on stack) */
register long pi = spop(psize); register long pi = spop(psize);
LOG(("@P6 DoCAIz(%lu)", pi)); LOG(("@P6 DoCAI(%lu)", pi));
call(arg_p(pi), RSB_CAL); call(arg_p(pi), RSB_CAL);
} }
DoCALl2(arg) DoCAL(pi)
long arg; register long pi;
{ {
/* CAL p: Call procedure (with identifier p) */ /* CAL p: Call procedure (with identifier p) */
register long pi = (L_arg_2() * arg);
LOG(("@P6 DoCALl2(%lu)", pi)); LOG(("@P6 DoCAL(%lu)", pi));
call(arg_p(pi), RSB_CAL); call(arg_p(pi), RSB_CAL);
} }
DoCALl4(arg) DoLFR(l)
long arg; register size l;
{
/* CAL p: Call procedure (with identifier p) */
register long pi = (L_arg_4() * arg);
LOG(("@P6 DoCALl4(%lu)", pi));
call(arg_p(pi), RSB_CAL);
}
DoCALm(arg)
long arg;
{
/* CAL p: Call procedure (with identifier p) */
register long pi = arg_p(arg);
LOG(("@P6 DoCALm(%lu)", pi));
call(pi, RSB_CAL);
}
DoCALs(hob, wfac)
long hob;
size wfac;
{
/* CAL p: Call procedure (with identifier p) */
register long pi = (S_arg(hob) * wfac);
LOG(("@P6 DoCALs(%lu)", pi));
call(arg_p(pi), RSB_CAL);
}
DoLFRl2(arg)
size arg;
{ {
/* LFR s: Load function result */ /* LFR s: Load function result */
register size l = (L_arg_2() * arg);
LOG(("@P6 DoLFRl2(%ld)", l)); LOG(("@P6 DoLFR(%ld)", l));
lfr(arg_s(l)); lfr(arg_s(l));
} }
DoLFRm(arg) DoRET(l)
size arg; register size l;
{
/* LFR s: Load function result */
LOG(("@P6 DoLFRm(%ld)", arg));
lfr(arg_s(arg));
}
DoLFRs(hob, wfac)
long hob;
size wfac;
{
/* LFR s: Load function result */
register size l = (S_arg(hob) * wfac);
LOG(("@P6 DoLFRs(%ld)", l));
lfr(arg_s(l));
}
DoRETl2(arg)
size arg;
{ {
/* RET z: Return (function result consists of top z bytes) */ /* RET z: Return (function result consists of top z bytes) */
register size l = (L_arg_2() * arg);
LOG(("@P6 DoRETl2(%ld)", l)); LOG(("@P6 DoRET(%ld)", l));
ret(arg_z(l));
}
DoRETm(arg)
size arg;
{
/* RET z: Return (function result consists of top z bytes) */
LOG(("@P6 DoRETm(%ld)", arg));
ret(arg_z(arg));
}
DoRETs(hob, wfac)
long hob;
size wfac;
{
/* RET z: Return (function result consists of top z bytes) */
register size l = (S_arg(hob) * wfac);
LOG(("@P6 DoRETs(%ld)", l));
ret(arg_z(l)); ret(arg_z(l));
} }

135
util/int/do_ptrar.c
View file

@ -27,14 +27,13 @@
#endif SEGCHECK #endif SEGCHECK
DoADPl2(arg) DoADP(l)
long arg; register long l;
{ {
/* ADP f: Add f to pointer on top of stack */ /* ADP f: Add f to pointer on top of stack */
register long l = (L_arg_2() * arg);
register ptr p, t = st_lddp(SP); register ptr p, t = st_lddp(SP);
LOG(("@R6 DoADPl2(%ld)", l)); LOG(("@R6 DoADP(%ld)", l));
spoilFRA(); spoilFRA();
if (t == 0) { if (t == 0) {
warning(WNULLPA); warning(WNULLPA);
@ -45,70 +44,14 @@ DoADPl2(arg)
st_stdp(SP, p); st_stdp(SP, p);
} }
DoADPl4(arg) DoADS(l)
long arg; register size l;
{
/* ADP f: Add f to pointer on top of stack */
register long l = (L_arg_4() * arg);
register ptr p, t = st_lddp(SP);
LOG(("@R6 DoADPl4(%ld)", l));
spoilFRA();
if (t == 0) {
warning(WNULLPA);
}
l = arg_f(l);
p = adp(t, l);
check_seg(ptr2seg(t), ptr2seg(p), WSEGADP);
st_stdp(SP, p);
}
DoADPm(arg)
long arg;
{
/* ADP f: Add f to pointer on top of stack */
register long l = arg_f(arg);
register ptr p, t = st_lddp(SP);
LOG(("@R6 DoADPm(%ld)", l));
spoilFRA();
if (t == 0) {
warning(WNULLPA);
}
l = arg_f(l);
p = adp(t, l);
check_seg(ptr2seg(t), ptr2seg(p), WSEGADP);
st_stdp(SP, p);
}
DoADPs(hob, wfac)
long hob;
size wfac;
{
/* ADP f: Add f to pointer on top of stack */
register long l = (S_arg(hob) * wfac);
register ptr p, t = st_lddp(SP);
LOG(("@R6 DoADPs(%ld)", l));
spoilFRA();
if (t == 0) {
warning(WNULLPA);
}
l = arg_f(l);
p = adp(t, l);
check_seg(ptr2seg(t), ptr2seg(p), WSEGADP);
st_stdp(SP, p);
}
DoADSl2(arg)
size arg;
{ {
/* ADS w: Add w-byte value and pointer */ /* ADS w: Add w-byte value and pointer */
register size l = (L_arg_2() * arg);
register long t = spop(arg_wi(l)); register long t = spop(arg_wi(l));
register ptr p, s = st_lddp(SP); register ptr p, s = st_lddp(SP);
LOG(("@R6 DoADSl2(%ld)", l)); LOG(("@R6 DoADS(%ld)", l));
spoilFRA(); spoilFRA();
t = arg_f(t); t = arg_f(t);
if (s == 0) { if (s == 0) {
@ -119,75 +62,15 @@ DoADSl2(arg)
st_stdp(SP, p); st_stdp(SP, p);
} }
DoADSm(arg) DoSBS(l)
size arg; register size l;
{
/* ADS w: Add w-byte value and pointer */
register long t = spop(arg_wi(arg));
register ptr p, s = st_lddp(SP);
LOG(("@R6 DoADSm(%ld)", arg));
spoilFRA();
t = arg_f(t);
if (s == 0) {
warning(WNULLPA);
}
p = adp(s, t);
check_seg(ptr2seg(s), ptr2seg(p), WSEGADP);
st_stdp(SP, p);
}
DoADSz()
{
/* ADS w: Add w-byte value and pointer */
register size l = uwpop();
register long t = spop(arg_wi(l));
register ptr p, s = st_lddp(SP);
LOG(("@R6 DoADSz(%ld)", l));
spoilFRA();
t = arg_f(t);
if (s == 0) {
warning(WNULLPA);
}
p = adp(s, t);
check_seg(ptr2seg(s), ptr2seg(p), WSEGADP);
st_stdp(SP, p);
}
DoSBSl2(arg)
size arg;
{ {
/* SBS w: Subtract pointers in same fragment and push diff as size w integer */ /* SBS w: Subtract pointers in same fragment and push diff as size w integer */
register size l = (L_arg_2() * arg);
register ptr t = st_lddp(SP); register ptr t = st_lddp(SP);
register ptr s = st_lddp(SP + psize); register ptr s = st_lddp(SP + psize);
register long w; register long w;
LOG(("@R6 DoSBSl2(%ld)", l)); LOG(("@R6 DoSBS(%ld)", l));
spoilFRA();
l = arg_wi(l);
check_seg(ptr2seg(t), ptr2seg(s), WSEGSBS);
w = sbs(t, s);
if (must_test && !(IgnMask&BIT(EIOVFL))) {
if (l == 2 && (w < I_MINS2 || w > I_MAXS2))
trap(EIOVFL);
}
dppop();
dppop();
npush(w, l);
}
DoSBSz()
{
/* SBS w: Subtract pointers in same fragment and push diff as size w integer */
register size l = uwpop();
register ptr t = st_lddp(SP);
register ptr s = st_lddp(SP + psize);
register long w;
LOG(("@R6 DoSBSz(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_wi(l); l = arg_wi(l);
check_seg(ptr2seg(t), ptr2seg(s), WSEGSBS); check_seg(ptr2seg(t), ptr2seg(s), WSEGSBS);

78
util/int/do_sets.c
View file

@ -14,68 +14,22 @@
PRIVATE bit_test(), create_set(); PRIVATE bit_test(), create_set();
DoINNl2(arg) DoINN(l)
size arg; register size l;
{ {
/* INN w: Bit test on w byte set (bit number on top of stack) */ /* INN w: Bit test on w byte set (bit number on top of stack) */
register size l = (L_arg_2() * arg);
LOG(("@Y6 DoINNl2(%ld)", l)); LOG(("@Y6 DoINN(%ld)", l));
spoilFRA(); spoilFRA();
bit_test(arg_w(l)); bit_test(arg_w(l));
} }
DoINNs(hob, wfac) DoSET(l)
long hob; register size l;
size wfac;
{
/* INN w: Bit test on w byte set (bit number on top of stack) */
register size l = (S_arg(hob) * wfac);
LOG(("@Y6 DoINNs(%ld)", l));
spoilFRA();
bit_test(arg_w(l));
}
DoINNz()
{
/* INN w: Bit test on w byte set (bit number on top of stack) */
register size l = uwpop();
LOG(("@Y6 DoINNz(%ld)", l));
spoilFRA();
bit_test(arg_w(l));
}
DoSETl2(arg)
size arg;
{ {
/* SET w: Create singleton w byte set with bit n on (n is top of stack) */ /* SET w: Create singleton w byte set with bit n on (n is top of stack) */
register size l = (L_arg_2() * arg);
LOG(("@Y6 DoSETl2(%ld)", l)); LOG(("@Y6 DoSET(%ld)", l));
spoilFRA();
create_set(arg_w(l));
}
DoSETs(hob, wfac)
long hob;
size wfac;
{
/* SET w: Create singleton w byte set with bit n on (n is top of stack) */
register size l = (S_arg(hob) * wfac);
LOG(("@Y6 DoSETs(%ld)", l));
spoilFRA();
create_set(arg_w(l));
}
DoSETz()
{
/* SET w: Create singleton w byte set with bit n on (n is top of stack) */
register size l = uwpop();
LOG(("@Y6 DoSETz(%ld)", l));
spoilFRA(); spoilFRA();
create_set(arg_w(l)); create_set(arg_w(l));
} }
@ -95,16 +49,20 @@ PRIVATE bit_test(w)
register int bitno = register int bitno =
(int) swpop(); /* bitno on TOS */ (int) swpop(); /* bitno on TOS */
register char test_byte = (char) 0;/* default value to be tested */ register char test_byte = (char) 0;/* default value to be tested */
register int wordoff = bitno / 8;
register int bitoff = bitno % 8;
if (bitoff < 0) bitoff += 8;
if (must_test && !(IgnMask&BIT(ESET))) { if (must_test && !(IgnMask&BIT(ESET))) {
/* Only w<<3 bytes CAN be tested */ /* Only w*8 bits CAN be tested */
if (bitno > (int) ((w << 3) - 1)) { if (wordoff >= w) {
trap(ESET); trap(ESET);
} }
} }
test_byte = stack_loc(SP + (bitno >> 3)); test_byte = stack_loc(SP + wordoff);
st_dec(w); st_dec(w);
wpush((long)((test_byte & BIT(bitno & 7)) ? 1 : 0)); wpush((long)((test_byte & BIT(bitoff)) ? 1 : 0));
} }
/******************************************************** /********************************************************
@ -121,6 +79,10 @@ PRIVATE create_set(w)
{ {
register int bitno = (int) swpop(); register int bitno = (int) swpop();
register size nbytes = w; register size nbytes = w;
register int wordoff = bitno / 8;
register int bitoff = bitno % 8;
if (bitoff < 0) bitoff += 8;
st_inc(nbytes); st_inc(nbytes);
while (--nbytes >= 0) { while (--nbytes >= 0) {
@ -128,10 +90,10 @@ PRIVATE create_set(w)
} }
if (must_test && !(IgnMask&BIT(ESET))) { if (must_test && !(IgnMask&BIT(ESET))) {
if (bitno > (int) ((w << 3) - 1)) { if (wordoff >= w) {
trap(ESET); trap(ESET);
} }
} }
st_stn(SP + (bitno >> 3), (long)BIT(bitno & 7), 1L); st_stn(SP + wordoff, (long)BIT(bitoff), 1L);
} }

355
util/int/do_store.c
View file

@ -13,400 +13,103 @@
#include "fra.h" #include "fra.h"
#include "warn.h" #include "warn.h"
DoSTLm(arg) DoSTL(l)
long arg; register long l;
{ {
/* STL l: Store local or parameter */ /* STL l: Store local or parameter */
register long l = arg_l(arg);
LOG(("@S6 DoSTLm(%ld)", l)); LOG(("@S6 DoSTL(%ld)", l));
spoilFRA();
popw_st(loc_addr(l));
}
DoSTLn2(arg)
long arg;
{
/* STL l: Store local or parameter */
register long l = (N_arg_2() * arg);
LOG(("@S6 DoSTLn2(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
popw_st(loc_addr(l)); popw_st(loc_addr(l));
} }
DoSTLn4(arg) DoSTE(arg)
long arg; register unsigned long arg;
{
/* STL l: Store local or parameter */
register long l = (N_arg_4() * arg);
LOG(("@S6 DoSTLn4(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_st(loc_addr(l));
}
DoSTLp2(arg)
long arg;
{
/* STL l: Store local or parameter */
register long l = (P_arg_2() * arg);
LOG(("@S6 DoSTLp2(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_st(loc_addr(l));
}
DoSTLp4(arg)
long arg;
{
/* STL l: Store local or parameter */
register long l = (P_arg_4() * arg);
LOG(("@S6 DoSTLp4(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_st(loc_addr(l));
}
DoSTLs(hob, wfac)
long hob;
size wfac;
{
/* STL l: Store local or parameter */
register long l = (S_arg(hob) * wfac);
LOG(("@S6 DoSTLs(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_st(loc_addr(l));
}
DoSTEl2(arg)
long arg;
{ {
/* STE g: Store external */ /* STE g: Store external */
register ptr p = i2p(L_arg_2() * arg); register ptr p = i2p(arg);
LOG(("@S6 DoSTEl2(%lu)", p)); LOG(("@S6 DoSTE(%lu)", p));
spoilFRA(); spoilFRA();
popw_m(arg_g(p)); popw_m(arg_g(p));
} }
DoSTEl4(arg) DoSIL(l)
long arg; register long l;
{
/* STE g: Store external */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@S6 DoSTEl4(%lu)", p));
spoilFRA();
popw_m(arg_g(p));
}
DoSTEs(hob, wfac)
long hob;
size wfac;
{
/* STE g: Store external */
register ptr p = i2p(S_arg(hob) * wfac);
LOG(("@S6 DoSTEs(%lu)", p));
spoilFRA();
popw_m(arg_g(p));
}
DoSILn2(arg)
long arg;
{ {
/* SIL l: Store into word pointed to by l-th local or parameter */ /* SIL l: Store into word pointed to by l-th local or parameter */
register long l = (N_arg_2() * arg);
LOG(("@S6 DoSILn2(%ld)", l)); LOG(("@S6 DoSIL(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
popw_m(st_lddp(loc_addr(l))); popw_m(st_lddp(loc_addr(l)));
} }
DoSILn4(arg) DoSTF(l)
long arg; register long l;
{
/* SIL l: Store into word pointed to by l-th local or parameter */
register long l = (N_arg_4() * arg);
LOG(("@S6 DoSILn4(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_m(st_lddp(loc_addr(l)));
}
DoSILp2(arg)
long arg;
{
/* SIL l: Store into word pointed to by l-th local or parameter */
register long l = (P_arg_2() * arg);
LOG(("@S6 DoSILp2(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_m(st_lddp(loc_addr(l)));
}
DoSILp4(arg)
long arg;
{
/* SIL l: Store into word pointed to by l-th local or parameter */
register long l = (P_arg_4() * arg);
LOG(("@S6 DoSILp4(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_m(st_lddp(loc_addr(l)));
}
DoSILs(hob, wfac)
long hob;
size wfac;
{
/* SIL l: Store into word pointed to by l-th local or parameter */
register long l = (S_arg(hob) * wfac);
LOG(("@S6 DoSILs(%ld)", l));
spoilFRA();
l = arg_l(l);
popw_m(st_lddp(loc_addr(l)));
}
DoSTFl2(arg)
long arg;
{ {
/* STF f: Store offsetted */ /* STF f: Store offsetted */
register long l = (L_arg_2() * arg);
register ptr p = dppop(); register ptr p = dppop();
LOG(("@S6 DoSTFl2(%ld)", l)); LOG(("@S6 DoSTF(%ld)", l));
spoilFRA(); spoilFRA();
popw_m(p + arg_f(l)); popw_m(p + arg_f(l));
} }
DoSTFl4(arg) DoSTI(l)
long arg; register size l;
{
/* STF f: Store offsetted */
register long l = (L_arg_4() * arg);
register ptr p = dppop();
LOG(("@S6 DoSTFl4(%ld)", l));
spoilFRA();
popw_m(p + arg_f(l));
}
DoSTFm(arg)
long arg;
{
/* STF f: Store offsetted */
register long l = arg;
register ptr p = dppop();
LOG(("@S6 DoSTFm(%ld)", l));
spoilFRA();
popw_m(p + arg_f(l));
}
DoSTFs(hob, wfac)
long hob;
size wfac;
{
/* STF f: Store offsetted */
register long l = (S_arg(hob) * wfac);
register ptr p = dppop();
LOG(("@S6 DoSTFs(%ld)", l));
spoilFRA();
popw_m(p + arg_f(l));
}
DoSTIl2(arg)
size arg;
{ {
/* STI o: Store indirect o bytes (pop address, then data) */ /* STI o: Store indirect o bytes (pop address, then data) */
register size l = (L_arg_2() * arg);
register ptr p = dppop(); register ptr p = dppop();
LOG(("@S6 DoSTIl2(%ld)", l)); LOG(("@S6 DoSTI(%ld)", l));
spoilFRA(); spoilFRA();
pop_m(p, arg_o(l)); pop_m(p, arg_o(l));
} }
DoSTIl4(arg) DoSTS(l)
size arg; register size l;
{
/* STI o: Store indirect o bytes (pop address, then data) */
register size l = (L_arg_4() * arg);
register ptr p = dppop();
LOG(("@S6 DoSTIl4(%ld)", l));
spoilFRA();
pop_m(p, arg_o(l));
}
DoSTIm(arg)
size arg;
{
/* STI o: Store indirect o bytes (pop address, then data) */
register ptr p = dppop();
LOG(("@S6 DoSTIm(%ld)", arg));
spoilFRA();
pop_m(p, arg_o(arg));
}
DoSTIs(hob, wfac)
long hob;
size wfac;
{
/* STI o: Store indirect o bytes (pop address, then data) */
register size l = (S_arg(hob) * wfac);
register ptr p = dppop();
LOG(("@S6 DoSTIs(%ld)", l));
spoilFRA();
pop_m(p, arg_o(l));
}
DoSTSl2(arg)
size arg;
{ {
/* STS w: Store indirect, w-byte integer on top of stack gives object size */ /* STS w: Store indirect, w-byte integer on top of stack gives object size */
register size l = (P_arg_2() * arg);
register ptr p; register ptr p;
LOG(("@S6 DoSTSl2(%ld)", l)); LOG(("@S6 DoSTS(%ld)", l));
spoilFRA(); spoilFRA();
l = upop(arg_wi(l)); l = upop(arg_wi(l));
p = dppop(); p = dppop();
pop_m(p, arg_o(l)); pop_m(p, arg_o(l));
} }
DoSTSz() /* the arg 'w' is on top of stack */ DoSDL(l)
{ register long l;
/* STS w: Store indirect, w-byte integer on top of stack gives object size */
register size l = uwpop();
register ptr p;
LOG(("@S6 DoSTSz(%ld)", l));
spoilFRA();
l = upop(arg_wi(l));
p = dppop();
pop_m(p, arg_o(l));
}
DoSDLn2(arg)
long arg;
{ {
/* SDL l: Store double local or parameter */ /* SDL l: Store double local or parameter */
register long l = (N_arg_2() * arg);
LOG(("@S6 DoSDLn2(%ld)", l)); LOG(("@S6 DoSDL(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_l(l); l = arg_l(l);
pop_st(loc_addr(l), dwsize); pop_st(loc_addr(l), dwsize);
} }
DoSDLn4(arg) DoSDE(arg)
long arg; register unsigned long arg;
{
/* SDL l: Store double local or parameter */
register long l = (N_arg_4() * arg);
LOG(("@S6 DoSDLn4(%ld)", l));
spoilFRA();
l = arg_l(l);
pop_st(loc_addr(l), dwsize);
}
DoSDLp2(arg)
long arg;
{
/* SDL l: Store double local or parameter */
register long l = (P_arg_2() * arg);
LOG(("@S6 DoSDLp2(%ld)", l));
spoilFRA();
l = arg_l(l);
pop_st(loc_addr(l), dwsize);
}
DoSDLp4(arg)
long arg;
{
/* SDL l: Store double local or parameter */
register long l = (P_arg_4() * arg);
LOG(("@S6 DoSDLp4(%ld)", l));
spoilFRA();
l = arg_l(l);
pop_st(loc_addr(l), dwsize);
}
DoSDLs(hob, wfac)
long hob;
size wfac;
{
/* SDL l: Store double local or parameter */
register long l = (S_arg(hob) * wfac);
LOG(("@S6 DoSDLs(%ld)", l));
spoilFRA();
l = arg_l(l);
pop_st(loc_addr(l), dwsize);
}
DoSDEu(arg)
long arg;
{ {
/* SDE g: Store double external */ /* SDE g: Store double external */
register ptr p = i2p(U_arg() * arg); register ptr p = i2p(arg);
LOG(("@S6 DoSDEu(%lu)", p)); LOG(("@S6 DoSDE(%lu)", p));
spoilFRA(); spoilFRA();
pop_m(arg_g(p), dwsize); pop_m(arg_g(p), dwsize);
} }
DoSDEl4(arg) DoSDF(l)
long arg; register long l;
{
/* SDE g: Store double external */
register ptr p = i2p(L_arg_4() * arg);
LOG(("@S6 DoSDEl4(%lu)", p));
spoilFRA();
pop_m(arg_g(p), dwsize);
}
DoSDFl2(arg)
long arg;
{ {
/* SDF f: Store double offsetted */ /* SDF f: Store double offsetted */
register long l = (L_arg_2() * arg);
register ptr p = dppop(); register ptr p = dppop();
LOG(("@S6 DoSDFl2(%ld)", l)); LOG(("@S6 DoSDF(%ld)", l));
spoilFRA();
pop_m(p + arg_f(l), dwsize);
}
DoSDFl4(arg)
long arg;
{
/* SDF f: Store double offsetted */
register long l = (L_arg_4() * arg);
register ptr p = dppop();
LOG(("@S6 DoSDFl4(%ld)", l));
spoilFRA(); spoilFRA();
pop_m(p + arg_f(l), dwsize); pop_m(p + arg_f(l), dwsize);
} }

128
util/int/do_unsar.c
View file

@ -33,166 +33,80 @@ extern int must_test;
PRIVATE unsigned long dvu(), rmu(), slu(), sru(); PRIVATE unsigned long dvu(), rmu(), slu(), sru();
DoADUl2(arg) DoADU(l)
size arg; register size l;
{ {
/* ADU w: Addition */ /* ADU w: Addition */
register size l = (L_arg_2() * arg);
register unsigned long t = upop(arg_wi(l)); register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoADUl2(%ld)", l)); LOG(("@U6 DoADU(%ld)", l));
spoilFRA(); spoilFRA();
npush((long) adu(upop(l), t), l); npush((long) adu(upop(l), t), l);
} }
DoADUz() DoSBU(l)
{ register size l;
/* ADU w: Addition */
register size l = uwpop();
register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoADUz(%ld)", l));
spoilFRA();
npush((long) adu(upop(l), t), l);
}
DoSBUl2(arg)
size arg;
{ {
/* SBU w: Subtraction */ /* SBU w: Subtraction */
register size l = (L_arg_2() * arg);
register unsigned long t = upop(arg_wi(l)); register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoSBUl2(%ld)", l)); LOG(("@U6 DoSBU(%ld)", l));
spoilFRA(); spoilFRA();
npush((long) sbu(upop(l), t), l); npush((long) sbu(upop(l), t), l);
} }
DoSBUz() DoMLU(l)
{ register size l;
/* SBU w: Subtraction */
register size l = uwpop();
register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoSBUz(%ld)", l));
spoilFRA();
npush((long) sbu(upop(l), t), l);
}
DoMLUl2(arg)
size arg;
{ {
/* MLU w: Multiplication */ /* MLU w: Multiplication */
register size l = (L_arg_2() * arg);
register unsigned long t = upop(arg_wi(l)); register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoMLUl2(%ld)", l)); LOG(("@U6 DoMLU(%ld)", l));
spoilFRA(); spoilFRA();
npush((long) mlu(upop(l), t), l); npush((long) mlu(upop(l), t), l);
} }
DoMLUz() DoDVU(l)
{ register size l;
/* MLU w: Multiplication */
register size l = uwpop();
register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoMLUz(%ld)", l));
spoilFRA();
npush((long) mlu(upop(l), t), l);
}
DoDVUl2(arg)
size arg;
{ {
/* DVU w: Division */ /* DVU w: Division */
register size l = (L_arg_2() * arg);
register unsigned long t = upop(arg_wi(l)); register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoDVUl2(%ld)", l)); LOG(("@U6 DoDVU(%ld)", l));
spoilFRA(); spoilFRA();
npush((long) dvu(upop(l), t), l); npush((long) dvu(upop(l), t), l);
} }
DoDVUz() DoRMU(l)
{ register size l;
/* DVU w: Division */
register size l = uwpop();
register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoDVUz(%ld)", l));
spoilFRA();
npush((long) dvu(upop(l), t), l);
}
DoRMUl2(arg)
size arg;
{ {
/* RMU w: Remainder */ /* RMU w: Remainder */
register size l = (L_arg_2() * arg);
register unsigned long t = upop(arg_wi(l)); register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoRMUl2(%ld)", l)); LOG(("@U6 DoRMU(%ld)", l));
spoilFRA(); spoilFRA();
npush((long) rmu(upop(l), t), l); npush((long) rmu(upop(l), t), l);
} }
DoRMUz() DoSLU(l)
{ register size l;
/* RMU w: Remainder */
register size l = uwpop();
register unsigned long t = upop(arg_wi(l));
LOG(("@U6 DoRMUz(%ld)", l));
spoilFRA();
npush((long) rmu(upop(l), t), l);
}
DoSLUl2(arg)
size arg;
{ {
/* SLU w: Shift left */ /* SLU w: Shift left */
register size l = (L_arg_2() * arg);
register unsigned long t = uwpop(); register unsigned long t = uwpop();
LOG(("@U6 DoSLUl2(%ld)", l)); LOG(("@U6 DoSLU(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_wi(l); l = arg_wi(l);
npush((long) slu(upop(l), t, l), l); npush((long) slu(upop(l), t, l), l);
} }
DoSLUz() DoSRU(l)
{ register size l;
/* SLU w: Shift left */
register size l = uwpop();
register unsigned long t = uwpop();
LOG(("@U6 DoSLUz(%ld)", l));
spoilFRA();
l = arg_wi(l);
npush((long) slu(upop(l), t, l), l);
}
DoSRUl2(arg)
size arg;
{ {
/* SRU w: Shift right */ /* SRU w: Shift right */
register size l = (L_arg_2() * arg);
register unsigned long t = uwpop(); register unsigned long t = uwpop();
LOG(("@U6 DoSRUl2(%ld)", l)); LOG(("@U6 DoSRU(%ld)", l));
spoilFRA();
l = arg_wi(l);
npush((long) sru(upop(l), t, l), l);
}
DoSRUz()
{
/* SRU w: Shift right */
register size l = uwpop();
register unsigned long t = uwpop();
LOG(("@U6 DoSRUz(%ld)", l));
spoilFRA(); spoilFRA();
l = arg_wi(l); l = arg_wi(l);
npush((long) sru(upop(l), t, l), l); npush((long) sru(upop(l), t, l), l);