Initial entry
This commit is contained in:
dick
parent
4934f830fc
commit
a717832bfb
716
util/int/ChangeLog
Normal file
716
util/int/ChangeLog
Normal file
|
|
@ -0,0 +1,716 @@
|
|||
27-May-88 Dick Grune (dick) at dick
|
||||
Testing with the UNIX system call tester by Leonie van der Voort
|
||||
revealed a few errors: when length was negative in a call of read
|
||||
or write, funny values were passed to Malloc; the size of the
|
||||
elements in the mtime/atime array passed to a call of utime was
|
||||
wsize rather than INT4SIZE, as it probably should have been.
|
||||
|
||||
25-May-88 Dick Grune (dick) at dick
|
||||
It is just too much of a drag to be able to unstack even the last
|
||||
RSB, the one that contains the initial setting of the machine.
|
||||
newLB has to be patched, and now it seems that also newPC has to
|
||||
make an exeception for this case. We now don't unstack the
|
||||
original RSB.
|
||||
|
||||
19-May-88 Dick Grune (dick) at dick
|
||||
We now also dump the Function Return Area, when giving a stack
|
||||
dump.
|
||||
|
||||
17-May-88 Dick Grune (dick) at dick
|
||||
Segment checking for pointers should also be done for subtraction,
|
||||
and give a different warning.
|
||||
|
||||
16-May-88 Dick Grune (dick) at dick
|
||||
The implementation of the MON call 'exec' was sloppy about the
|
||||
buffers used: all strings were assumed to have a maximum length of
|
||||
128, and the maximum number of args or environ entries was built
|
||||
in. We now scan the whole works to determine the size.
|
||||
|
||||
16-May-88 Dick Grune (dick) at dick
|
||||
A stack dump with given size would look funny if the size was large
|
||||
than the original stack, or when the dump happened to start in the
|
||||
middle of a RSB.
|
||||
|
||||
14-May-88 Dick Grune (dick) at dick
|
||||
Rethinking the start-up procedure has resulted in the removal of the
|
||||
flag LB_def and the RSB is now stacked and unstacked in one blow.
|
||||
LB = ML + 1 is now a special case.
|
||||
|
||||
11-May-88 Dick Grune (dick) at dick
|
||||
Code handling the Function Return Area was spread over a number of
|
||||
files; since there was already an include file fra.h, I made a file
|
||||
fra.c. Likewise for alloc.[ch]
|
||||
|
||||
10-May-88 Dick Grune (dick) at dick
|
||||
The whole segment-checking stuff is now concentrated in segment.c
|
||||
(and made correct!)
|
||||
|
||||
9-May-88 Dick Grune (dick) at dick
|
||||
Things would be a lot simpler if LB and AB and SP could start from
|
||||
ML+1, but they cannot because ML+1 gives overflow. So we now set ML
|
||||
to the highest word boundary minus 1.
|
||||
|
||||
8-May-88 Dick Grune (dick) at dick
|
||||
The whole business of deriving AB from LB every time you need it is
|
||||
unnatural: it is a separate register in its own right and
|
||||
recalculation is only possible since we happen to have a linear
|
||||
stack implementation. -> a normal register in the EM machine, set
|
||||
in newLB().
|
||||
|
||||
7-May-88 Dick Grune (dick) at dick
|
||||
In the non-checking version it did not even check for bad proc
|
||||
idfs, actions on double words with wsize == 4, etc., in text.h. It
|
||||
now checks.
|
||||
|
||||
7-May-88 Dick Grune (dick) at dick
|
||||
When a trap occurs it is often not at all clear why it happened;
|
||||
e.g., the trap ESTACK may have several causes except stack
|
||||
overflow: setting SP to an odd value, setting LB to a place where
|
||||
there is no RSB, and so on. Now all such traps are preceded by a
|
||||
warning; the combined action is written as wtrap(W..., E...)
|
||||
with W... the warning number and E... the trap number.
|
||||
|
||||
6-May-88 Dick Grune (dick) at dick
|
||||
The offsets in the RSB and its size were recalculated every time;
|
||||
this was especially ridiculous in accessing a formal parameter
|
||||
based on AB; they are now precalculated as soon as psize and wsize
|
||||
are known.
|
||||
|
||||
6-May-88 Dick Grune (dick) at dick
|
||||
The one-bit register HaltOnTrap is not powerful enough; it has to
|
||||
have a special value during loading the EM file (for floating
|
||||
overflow in calculations). We now have OnTrap with three values.
|
||||
|
||||
3-May-88 Dick Grune (dick) at dick
|
||||
If we want to check that PC does not jump from procedure to
|
||||
procedure, we have to know which procedure is running. Introduced
|
||||
an EM register PI for Procedure Identifier. We also need the limits
|
||||
for each procedure; for this purpose, the procedure descriptor
|
||||
table is now preprocessed on start-up. New files: proctab.[ch].
|
||||
|
||||
3-May-88 Dick Grune (dick) at dick
|
||||
There was still a considerable confusion between ignorable and
|
||||
non-ignorable traps. All ignorable traps are now handled on the
|
||||
spot and the procedure trap() is not called if the trap is ignored.
|
||||
This means that arm_trap() has disappeared.
|
||||
|
||||
2-May-88 Dick Grune (dick) at dick
|
||||
The GTO was done by a rude store in LB, SP and PC; now it properly
|
||||
unwinds the stack.
|
||||
|
||||
25-Apr-88 Dick Grune (dick) at dick
|
||||
With the advent of the Sun 4 RISC machine, the use of variable length
|
||||
argument lists has become a liability. The answer is the include file
|
||||
<varargs.h>. It appears that _doprnt() is sufficiently universal,
|
||||
fortunately.
|
||||
|
||||
24-Apr-88 Dick Grune (dick) at dick
|
||||
There are two levels to stack dumping, the RSB list and the whole
|
||||
contents; we now control the first by d1 and the rest by d2.
|
||||
|
||||
24-Apr-88 Dick Grune (dick) at dick
|
||||
Dumping the GDA and heap is under control of the GDA= and HEAP=
|
||||
parameters rather than under d3 or d4. Changed their id-s to +1
|
||||
and *1, so they can be set in the program but not from the
|
||||
LOGMASK=.
|
||||
|
||||
24-Apr-88 Dick Grune (dick) at dick
|
||||
Now that the Logging Machine has been baptized, time has come to
|
||||
call the controlling define LOGGING again. Sorry for the confusion.
|
||||
|
||||
24-Apr-88 Dick Grune (dick) at dick
|
||||
Trying to have the interpreter interpret itself has given rise to
|
||||
many small improvements, and a considerable correction to npush() and
|
||||
st_lds(). We are again trying.
|
||||
|
||||
15-Apr-88 Dick Grune (dick) at dick
|
||||
The tallying does in no way belong to the logging machine, so I
|
||||
removed the dependency on the flag CHECKING (see 15-Feb-88).
|
||||
|
||||
15-Apr-88 Dick Grune (dick) at dick
|
||||
The instruction counter inr is properly speaking no part of the
|
||||
EM machine, but belongs to the logging machine.
|
||||
|
||||
15-Apr-88 Dick Grune (dick) at dick
|
||||
It is unnatural for the logging machine to derive the values of its
|
||||
variables from shell variables. Shell variables are very global
|
||||
and represent a setting in which the user wishes to work. The
|
||||
values of the logging variables change from moment to moment. They
|
||||
are now derived from make-like assignments in the command line.
|
||||
|
||||
14-Apr-88 Dick Grune (dick) at dick
|
||||
To allow testing routines that handle heap and stack overflow, two
|
||||
command line parameters have been added, -hN and -sN, that limit
|
||||
the heap and stack size.
|
||||
|
||||
14-Apr-88 Dick Grune (dick) at dick
|
||||
The EM Manual provides two traps for undefined integers and floats.
|
||||
Since the interpreter does not have special values for undefined;
|
||||
since it relies on the shadow bytes to give a warning; and in view
|
||||
of the frequent occurrence of such undefined values, the
|
||||
interpreter just gives a warning.
|
||||
It would be nice if the interpreter could also, on request, exhibit
|
||||
the formally correct behaviour of giving a trap. This is, however,
|
||||
impossible, since such a trap would have to rely on the shadow bits
|
||||
and the shadow bits are only present in the checking version.
|
||||
The conclusion is that we do not give a trap on use of undefined,
|
||||
ever.
|
||||
|
||||
2-Apr-88 Dick Grune (dick) at dick
|
||||
The warnings about type T expected left one in the dark as to what
|
||||
*was* there. Now it prints a continued warning telling about the
|
||||
type found. To this end, warningcont() prints a chained warning.
|
||||
|
||||
1-Apr-88 Dick Grune (dick) at dick
|
||||
When a pointer is needed and it turns out to be an integer, a test
|
||||
is done to see if it happens to be zero, in which case all is well.
|
||||
This was, however, a rather weird test; it is much simpler, when
|
||||
storing a zero value, to switch on both the SH_INT bit and the
|
||||
SH_DATAP bit.
|
||||
|
||||
31-Mar-88 Dick Grune (dick) at dick
|
||||
The logging machine has now been separated from the EM machine as
|
||||
much as is reasonably possible. Weak points are still forking and
|
||||
the handling of the abbreviations AT= and L= .
|
||||
|
||||
29-Mar-88 Dick Grune (dick) at dick
|
||||
On many systems it is inappropriate to grab file descriptors 19 and
|
||||
18 for messages and logging. It now finds the highest ones (with a
|
||||
limit of 99, for systems that have an unlimited supply of them).
|
||||
|
||||
29-Mar-88 Dick Grune (dick) at dick
|
||||
There were some terminological inaccuracies about the difference
|
||||
between a procedure identifier and a procedure descriptor.
|
||||
|
||||
29-Mar-88 Dick Grune (dick) at dick
|
||||
Since the disassembler is in no way involved in the logging machine,
|
||||
it seems inappropriate to use LOG(()) to produce the text. Just
|
||||
using printf() is much cleaner.
|
||||
|
||||
28-Mar-88 Dick Grune (dick) at dick
|
||||
Although trap handling had a file for itself, trap.c, warning
|
||||
handling was still done inside io.c. Introduced a new file,
|
||||
warn.c, to handle the warnings.
|
||||
|
||||
26-Mar-88 Dick Grune (dick) at dick
|
||||
Providing a good dump of a 2/4 machine is not easy; it is not clear
|
||||
where a pointer may be found. This was solved by just printing
|
||||
words everywhere, which was unsatisfactory. Now pointers are
|
||||
printed wherever the shadow bits indicate that there might be a
|
||||
pointer there, i.e. when the address is a word multiple and the 4
|
||||
bytes all have the pointer bit on. This is less unsatisfactory,
|
||||
though not good.
|
||||
|
||||
23-Mar-88 Dick Grune (dick) at dick
|
||||
Adapted to the new u flag in ip_spec.t; this cleared up the text
|
||||
segment access in text.h.
|
||||
|
||||
21-Mar-88 Dick Grune (dick) at dick
|
||||
Implemented the requirement that, when doing an RET or RTT, the stack
|
||||
pointer must be back where it started. This required the proc.
|
||||
idf to be recorded in the Return Status Block.
|
||||
|
||||
20-Mar-88 Dick Grune (dick) at dick
|
||||
Likewise (see below) for the text of the trap messages.
|
||||
|
||||
20-Mar-88 Dick Grune (dick) at dick
|
||||
Having the text, defines and numerical values in three different
|
||||
files is kind of inconvenient. They are now centralized in
|
||||
../doc/appA (Appendix A of the manual) where they appear with
|
||||
explanations. The files warn_msg (with texts) and warn.h (with
|
||||
defines) are generated from it through M.warn_msg and M.warn_h,
|
||||
resp.
|
||||
|
||||
20-Mar-88 Dick Grune (dick) at dick
|
||||
Introduced the use of $(EM)/h/em_abs.h to include the trap numbers
|
||||
and the positions of LIN and FIL (although this seems a funny place
|
||||
to find them).
|
||||
|
||||
20-Mar-88 Dick Grune (dick) at dick
|
||||
Concentrated all e.out.h defines in e.out.h; this should probably
|
||||
go into $(EM)/h one of these days.
|
||||
|
||||
20-Mar-88 Dick Grune (dick) at dick
|
||||
The interpreter in the EM Manual does not use EBADLIN; we now decide
|
||||
that it is raised if the line number is larger than that mentioned
|
||||
in the EM header, part 2.
|
||||
|
||||
19-Mar-88 Dick Grune (dick) at dick
|
||||
The EM Manual states that a number of overflow tests need not be done
|
||||
if the FB_TEST bit in the second header word is not on.
|
||||
Experimental implementation of this shows a speed-up of 16%, so it
|
||||
is probably worth while.
|
||||
|
||||
18-Mar-88 Dick Grune (dick) at dick
|
||||
Reading the opcode and the argument bytes from the text segment was
|
||||
done by a procedure call, but the procedure call (newPC()) did not
|
||||
test for running out of the text segment. Replaced by a macro + a
|
||||
number of other similar speed-ups.
|
||||
|
||||
18-Mar-88 Dick Grune (dick) at dick
|
||||
Reraising the signal is not really useful; it is more useful never
|
||||
to catch a synchronous trap. UNIX then automatically does what it
|
||||
has to do.
|
||||
|
||||
17-Mar-88 Dick Grune (dick) at dick
|
||||
Redoing the trap mechanism lead to looking at the RTT vs RET
|
||||
instruction; it is nice to know where a Return Status Block
|
||||
originated: start-up, call, trap, non-restartable trap. We now
|
||||
push this info as topmost item on the stack. Values etc. in rsb.h
|
||||
|
||||
15-Mar-88 Dick Grune (dick) at dick
|
||||
I finally found out why the interpreter was spending 30% of
|
||||
its time in the system: it did a setjmp for each and every EM
|
||||
instruction, and IT does a call of signal(). Redoing this lead to
|
||||
considerable hacking in the trap handling mechanism. See the
|
||||
chapter in the documentation.
|
||||
|
||||
11-Mar-88 Dick Grune (dick) at dick
|
||||
Not all C compilers provide floating point operations. Installed a
|
||||
file nofloat.h with a flag NOFLOAT, which, if defined, suppresses
|
||||
the use of fp operations. The resulting interpreter will load EM
|
||||
files with floats in the GDA (but ignore them) but will give a
|
||||
fatal error upon attempt to execute a fp instruction.
|
||||
|
||||
10-Mar-88 Dick Grune (dick) at dick
|
||||
Added procedure identifier indications in the disassembly output,
|
||||
which helps in reading it.
|
||||
|
||||
8-Mar-88 Dick Grune (dick) at dick
|
||||
Implemented the other half of the type checking on ptr; this involved
|
||||
a macro i2p() to convert from index to pointer.
|
||||
|
||||
6-Mar-88 Dick Grune (dick) at dick
|
||||
Officially C does not have a type 'unsigned long', but the
|
||||
interpreter uses it heavily. Now it would be nice if we could make
|
||||
a version that does not use unsigned long. The main difficulty is
|
||||
the file do_unsar.c for doing unsigned arithmetic; for the rest it
|
||||
is possible and partway done. Most sizes are now of the type size.
|
||||
|
||||
4-Mar-88 Dick Grune (dick) at dick
|
||||
The list of warnings was fixed and contiguous, which was a nuisance
|
||||
when adding warnings. Now there is a mapping from warning numbers
|
||||
to the corresponding strings through a routine which does the
|
||||
lookup.
|
||||
|
||||
3-Mar-88 Dick Grune (dick) at dick
|
||||
The whole address testing for system calls in MON was shaky; most
|
||||
of them just produced traps. Corrected; they now return -1 and set
|
||||
errno to 14 (EFAULT).
|
||||
|
||||
1-Mar-88 Dick Grune (dick) at dick
|
||||
Some compilers use V7 ioctl request codes, some use the local
|
||||
codes. To accommodate both, we have a compile-time flag, V7IOCTL,
|
||||
which, if defined, causes the ioctl requests to be interpreted as
|
||||
V7 requests (of the form 't'<<8 | x)
|
||||
|
||||
1-Mar-88 Dick Grune (dick) at dick
|
||||
String arguments to system calls were, for the most part, just
|
||||
picked up, without any serious testing. Corrected in moncalls.c;
|
||||
violation results in errno == 14 (EFAULT) as it should.
|
||||
|
||||
29-Feb-88 Dick Grune (dick) at dick
|
||||
Concentrates all exits in a function close_down() which does
|
||||
calls to fclose() on the opened files, may reraise a caught signal
|
||||
and exits with the given return code.
|
||||
|
||||
26-Feb-88 Dick Grune (dick) at dick
|
||||
The type ptr was used very loosely; tightened up the code in many,
|
||||
many places. Introduced a macro p2i(p) which converts a "pointer"
|
||||
(EM address) to an index in the machine array. This modification
|
||||
necessitated a great many small changes and allowed some
|
||||
considerable simplifications.
|
||||
|
||||
22-Feb-88 Dick Grune (dick) at dick
|
||||
The format of a procedure identifier was a pointer in places and a
|
||||
long in others. It is now a psize unsigned integer.
|
||||
|
||||
16-Feb-88 Dick Grune (dick) at dick
|
||||
The code for calculating the sizes of the environ strings and the
|
||||
argument strings was unreadable. Rewritten in init.c.
|
||||
|
||||
15-Feb-88 Dick Grune (dick) at dick
|
||||
The tallying is not likely to be used by a user of the non-logging
|
||||
version, so it may as well be absent then, to save space. Made all
|
||||
tallying dependent on CHECKING.
|
||||
|
||||
15-Feb-88 Dick Grune (dick) at dick
|
||||
When allocating space for the stack and the global data area, the
|
||||
shadow bytes were not set to SH_UNDEF. Since the undef-ing of the
|
||||
shadow bytes occurs in several places, I introduced two routines,
|
||||
st_clear_area() and dt_clear_area() for the purpose.
|
||||
|
||||
12-Feb-88 Dick Grune (dick) at dick
|
||||
The dumping format of the text segment (just bytes in decimal) was
|
||||
unsatisfactory. It turned out quite easy to use the mkswitch from
|
||||
the switch directory to hack together a simple disassembler, which
|
||||
produced readable EM instructions.
|
||||
Moreover, text does not change while the program runs, so dumping
|
||||
it at a given instruction is quite meaningless. We now dump it
|
||||
right at the beginning, when the -T option is given.
|
||||
|
||||
4-Feb-88 Dick Grune (dick) at dick
|
||||
The whole idea of a driver (int.c) is superfluous now. Moreover
|
||||
there were naming problems all the time. Removed references to the
|
||||
driver.
|
||||
|
||||
1-Feb-88 Dick Grune (dick) at dick
|
||||
Measurements have shown that a checking but not logging interpreter
|
||||
is only a few percents faster that one that does both, at the
|
||||
expense of considerably lower functionality. So I merged logging and
|
||||
checking in the file checking.h. Made testing for logging more
|
||||
efficient by having a single variable logging which is set as
|
||||
soon as must_log && inr >= log_start is true. This is faster
|
||||
and much leaner code. Exit the function interesting().
|
||||
|
||||
1-Feb-88 Dick Grune (dick) at dick
|
||||
Removed the warning about switched-off warnings and traps; they
|
||||
were a nuisance.
|
||||
|
||||
29-Jan-88 Dick Grune (dick) at dick
|
||||
The zero pointer arithmetic check was implemented incorrectly.
|
||||
While correcting this, I cleaned up all the checking and warning
|
||||
mechanisms, up to a point. There is much more one can do.
|
||||
Unfortunately this involved renumbering the warnings, so we hack
|
||||
the manual to match.
|
||||
|
||||
27-Jan-88 Dick Grune (dick) at dick
|
||||
Line number and file name also in last line of stack dump, for
|
||||
uniformity with RSB descriptions.
|
||||
|
||||
25-Jan-88 Dick Grune (dick) at dick
|
||||
The default log mask is better at A-Z9d4twx9 than at A-Z9d1twx9.
|
||||
|
||||
23-Jan-88 Dick Grune (dick) at dick
|
||||
Warnings are now tallied not only by warning number, but also by
|
||||
file name and line number. Used simple linked lists in io.c.
|
||||
|
||||
23-Jan-88 Dick Grune (dick) at dick
|
||||
Having an address space of 2**32 is absurd; it will have to be 2**31
|
||||
to implement uninitialized pointers. Just to be able to give a
|
||||
good example in "How To Use the Interpreter", I changed MAX_ADR4 to
|
||||
I_MAXS4 (was I_MAXU4).
|
||||
|
||||
22-Jan-88 Dick Grune (dick) at dick
|
||||
The grammar of a float in the manual, the grammar of an UnsignedReal
|
||||
in the Pascal manual and the implementation in read.c were all
|
||||
slightly different. I made a clear distinction between the Pascal
|
||||
version (OK), the more loose implementation of "acceptable float"
|
||||
(with warning) and just garbage (with fatal error). ".e3" is an
|
||||
acceptable float.
|
||||
|
||||
21-Jan-88 Dick Grune (dick) at dick
|
||||
The interpreter did not catch stores at location 0. Changed this
|
||||
by making the LIN and FIL locations ROM. Introduced macros for
|
||||
protecting the data space (analogous to protecting the RSB in the
|
||||
stack). Moved all shadow byte handling to shadow.h. LIN, LNI and FIL
|
||||
are implemented by first lifting the write ban by dt_unprot, writing
|
||||
and then restoring it by dt_prot.
|
||||
|
||||
8-Jan-88 Dick Grune (dick) at dick
|
||||
The AT shell variable stopped one instruction too late. Corrected
|
||||
in main.c.
|
||||
|
||||
8-Dec-87 Dick Grune (dick) at dick
|
||||
I was explained that there is a subtle difference between the trap
|
||||
routine address being 0 and the default action upon trap. It says
|
||||
in the beginning of chapter 9 (Traps and Interrupts) of IR-81:
|
||||
Initially the pointer used is zero and all traps halt the program
|
||||
with ... The meaning of the SIG instruction is stated as: Trap
|
||||
errors to proc identifier on top of stack, -2 resets default. This
|
||||
means, I am told, that SIG with -2 restores the "pointer used" to
|
||||
zero and "directs all traps to halt the program ...", and that SIG
|
||||
with 0 just registers proc 0 as the trap routine.
|
||||
|
||||
Although I think this raises more questions than it answers (how
|
||||
can I see if the previous trap routine was 0 or default?) I
|
||||
implemented it by adding an EM machine register HaltOnTrap, which
|
||||
is set in the non-default case.
|
||||
|
||||
1-Dec-87 Dick Grune (dick) at dick
|
||||
When debugging with the interpreter one often uses a call like
|
||||
LOG=123455 STOP=123457 int .....
|
||||
Added a shell variable AT which effects the above:
|
||||
AT=123456 int ...
|
||||
|
||||
27-Nov-87 Dick Grune (dick) at dick
|
||||
The shift distance in shifts and rotates must be in the range 0
|
||||
to object size in bits - 1, as it says in IR-81. This introduced a
|
||||
lot of inline code in DoSLI .. DoROR that should maybe go into
|
||||
subroutines.
|
||||
|
||||
23-Nov-87 Dick Grune (dick) at dick
|
||||
It turned out that LOG(("@S was a prefix both in do_store.c and in
|
||||
do_sets.c. Changed to @Y in the latter.
|
||||
|
||||
23-Nov-87 Dick Grune (dick) at dick
|
||||
SLI (shift left int) did an incorrect overflow test (failed on
|
||||
negative shift argument).
|
||||
|
||||
22-Nov-87 Dick Grune (dick) at dick
|
||||
Reformatted the output of the dump of the text and of the
|
||||
procedure descriptors. The latter is now more or less
|
||||
readable.
|
||||
|
||||
22-Nov-87 Dick Grune (dick) at dick
|
||||
Took all the direct memory access actions together in memdirect.h.
|
||||
This allows more readable code in dump.c and in a few other places.
|
||||
|
||||
10-Nov-87 Dick Grune (dick) at dick
|
||||
The stack dump is too unstructured and does not give enough
|
||||
information. Moreover, the position reporting in the various dump
|
||||
lines is erratic. Changed the routine do_log() to have two
|
||||
variants, one in which the format starts with @, which causes the
|
||||
position to be reported, and one in which the format starts with a
|
||||
blank, which is printed as is.
|
||||
Added two routines st_raw() and st_rsb() to print the raw and
|
||||
Return Status Block portions of the stack, resp., and displ_fil(),
|
||||
to print the name of the file, if at all possible. The stack
|
||||
parsing can be switched off with the -r option.
|
||||
|
||||
9-Nov-87 Dick Grune (dick) at dick
|
||||
Redressed the treatment of the Return Status Block, to give a
|
||||
better dump.
|
||||
|
||||
1-Nov-87 Dick Grune (dick) at dick
|
||||
The present segment checking is not very informative and produces
|
||||
complaints about intermediate results, which is annoying.
|
||||
This is not easily corrected. For each pointer, one should keep
|
||||
track where it originated, and when it is dereferenced a check
|
||||
should be made to see if it is applied to the original segment.
|
||||
This is kind of stiff to implement.
|
||||
For the time being, I have made the whole segment checking subject
|
||||
to a compile-time flag, SEGCHECK, to be kept in segcheck.h. The
|
||||
flag will normally be off, which saves time, space and
|
||||
inappropriate warnings.
|
||||
|
||||
28-Oct-87 Dick Grune (dick) at dick
|
||||
Small changes:
|
||||
- put Malloc etc in a header file: alloc.h
|
||||
- removed dt_ldf() (unused)
|
||||
- make static routines and data PRIVATE, to allow both
|
||||
static and extern
|
||||
|
||||
25-Oct-87 Dick Grune (dick) at dick
|
||||
arg_lae() should not check against HB but against max_addr, for
|
||||
funny address calculations as performed by e.g. lex.
|
||||
|
||||
14-Oct-87 Dick Grune (dick) at dick
|
||||
Exece in moncalls.c cannot succeed (if it succeeds, it's gone!)
|
||||
Corresponding code removed and rest straightened out.
|
||||
|
||||
13-Oct-87 Dick Grune (dick) at dick
|
||||
Brought the interpreter under RCS and CVS.
|
||||
|
||||
12-Oct-87 Dick Grune (dick) at dick
|
||||
Added a -t option in main.c to switch the tallying on.
|
||||
|
||||
11-Oct-87 Dick Grune (dick) at dick
|
||||
Added two routines, tally() and out_tally() for (you guessed it)
|
||||
tallying. out_tally() produces a readable file with for each
|
||||
source file the name followed by a number of lines, each
|
||||
containing a line number, the number of times that line was
|
||||
entered and the number of instructions executed on that line.
|
||||
Somebody should write a program to merge this with the original
|
||||
files.
|
||||
|
||||
3-Oct-87 Dick Grune (dick) at dick
|
||||
Added routines for fabs(), pow() and floor() to avoid having to
|
||||
invoke -lm.
|
||||
|
||||
2-Oct-87 Dick Grune (dick) at dick
|
||||
Floating point constants that started with a . were read
|
||||
incorrectly, as the mantissa was not initialized in that case.
|
||||
|
||||
25-Sep-87 Dick Grune (dick) at tjalk
|
||||
All access to the LIN and FIL information has been brought
|
||||
together in a header file linfil.h, which contains #defines for
|
||||
putLIN(), getLIN(), putFIL() and getFIL().
|
||||
|
||||
20-Sep-87 Dick Grune (dick) at tjalk
|
||||
Added a routine core_dump() which dumps core after a fatal error.
|
||||
The core image consists of the values of the EM parameters and
|
||||
registers, by name; ie.
|
||||
wsize=4
|
||||
psize=4
|
||||
ML=4294967295
|
||||
HB=816
|
||||
etc., one to a line, followed by
|
||||
fwrite(text, 1, DB, core_file);
|
||||
fwrite(FRA, 1, FRALimit, core_file);
|
||||
fwrite(data, 1, HL, core_file);
|
||||
fwrite(stack, 1, ML+1-SL, core_file);
|
||||
possibly followed by
|
||||
fwrite(FRA_sh, 1, FRALimit, core_file);
|
||||
fwrite(data_sh, 1, HL, core_file);
|
||||
fwrite(stack_sh, 1, ML+1-SL, core_file);
|
||||
so somebody could write a formatter for it.
|
||||
|
||||
|
||||
18-Sep-87 Dick Grune (dick) at tjalk
|
||||
The function return area was a fixed-size array. Now it is
|
||||
allocated through Malloc(), like the other memory constituents of
|
||||
the EM machine. This introduced the -R-option, to set the size of
|
||||
the return area (default is 8).
|
||||
|
||||
13-Sep-87 Dick Grune (dick) at tjalk
|
||||
Restructured global.h to better reflect what are EM registers and
|
||||
what are implementation variables. This introduced read.h to
|
||||
concentrate the EM header quantities.
|
||||
|
||||
10-Sep-87 Dick Grune (dick) at tjalk
|
||||
Implemented a shell-variable STOP= more or less analogous to LOG=
|
||||
such that a call of the interpreter
|
||||
STOP=321456 int ...
|
||||
will stop the interpreter after an instruction count of 321456, to
|
||||
avoid run-away interpreters.
|
||||
|
||||
27-Aug-87 Dick Grune (dick) at tjalk
|
||||
The idea has been raised to let int read the default values of
|
||||
LOG, LOGMASK, etc., for a file in the working directory, e.g.
|
||||
.em_intrc or so. I have not done so since only for the LOGMASK
|
||||
a reasonable default can be given; the others are case-specific.
|
||||
So I gave LOGMASK the default value "A-Z9d1twx9" instead.
|
||||
|
||||
25-Aug-87 Dick Grune (dick) at tjalk
|
||||
Changed the name of the instruction counter from ino to inr, to
|
||||
avoid confusion with "inode numbers".
|
||||
|
||||
20-Aug-87 Dick Grune (dick) at tjalk
|
||||
The EM report specifies a list of UNIX Version 7 -like system
|
||||
calls, not full access to the system calls on the underlying
|
||||
machine. Therefore an attempt has been made to use or emulate
|
||||
the Version 7 system calls on the various machines.
|
||||
|
||||
18-Aug-87 Dick Grune (dick) at tjalk
|
||||
Introduced a file sysidf.h which holds the #define for the
|
||||
present system: BSD4_1, BSD4_2 or SYS_V0. Based on these, it
|
||||
defines generic #defines: BSD_X and SYS_V . Added various
|
||||
#ifdefs for the various systems, guided by cc, acc and lint.
|
||||
|
||||
16-Aug-87 Dick Grune (dick) at tjalk
|
||||
There were some portability problems with dup2 .
|
||||
Since dup2 is not available on all UNIX systems, and since
|
||||
it was a kludge in the first place, I implemented a routine
|
||||
move_file_descriptor, again with slightly different semantics:
|
||||
it closes the original file descriptor. (io.c)
|
||||
|
||||
13-Aug-87 Dick Grune (dick) at tjalk
|
||||
Renamed set_log to set_lmask and set_log_file to set_lfile, all in
|
||||
the name of System V compatibility. Perhaps we should rename
|
||||
everything, to SetLogMask, SetLogFile, etc., Modula-2 style.
|
||||
|
||||
13-Aug-87 Dick Grune (dick) at tjalk
|
||||
And changed names like do_LAEl4 to DoLAEl4, to get them through
|
||||
the assembler in System V.
|
||||
|
||||
11-Aug-87 Dick Grune (dick) at tjalk
|
||||
Changed names like do_LAEl4 to do_lae_l4, to keep within 8
|
||||
characters.
|
||||
|
||||
10-Jul-87 Dick Grune (dick) at tjalk
|
||||
Introduced monstruct.h and monstruct.c, to contain the code for
|
||||
copying UNIX system call structures to and from EM MON call
|
||||
structures.
|
||||
|
||||
9-Jul-87 Dick Grune (dick) at tjalk
|
||||
Made -W option always available.
|
||||
|
||||
8-Jul-87 Dick Grune (dick) at tjalk
|
||||
Why is the -W option available only when CHECKING is on? What am I
|
||||
missing?
|
||||
|
||||
6-Jul-87 Dick Grune (dick) at tjalk
|
||||
It turned out that emsig.h is included in m_sigtrp.c only and
|
||||
contains only definitions of functions from same m_sigtrp.c.
|
||||
Eliminated emsig.h.
|
||||
|
||||
Better identification of the position from where a message is
|
||||
given, through the new routine position().
|
||||
|
||||
3-Jul-87 Dick Grune (dick) at tjalk
|
||||
Did the rest of dump.c (and found an error in the administration
|
||||
of the undefineds in hp_dump).
|
||||
Changed LOG to LOGGING, and log(( to LOG((, just for
|
||||
readability and uniformity.
|
||||
|
||||
2-Jul-87 Dick Grune (dick) at tjalk
|
||||
Changed switch.c to be a normal file in this directory; it now
|
||||
includes the cases in the switch from ../switch/cases , which
|
||||
allows greater freedom in programming the rest of switch.c.
|
||||
|
||||
1-Jul-87 Dick Grune (dick) at tjalk
|
||||
Read.c nested to excessive length. Isolated a function rd_descr()
|
||||
which reads one descriptor.
|
||||
There were many almost similar #defines for setting bits in
|
||||
'trapped'. Concentrated them in arm_trap(ENUMBER).
|
||||
|
||||
30-Jun-87 Dick Grune (dick) at tjalk
|
||||
Handling of failure of ftime (moncalls.c) was wrong. Corrected.
|
||||
Corrected many lint gripes.
|
||||
|
||||
28-Jun-87 Dick Grune (dick) at tjalk
|
||||
The routine st_dump in dump.c does nothing but testing whether
|
||||
or not to log at level d1. Why not test so right at the
|
||||
beginning? So I did: the same test now runs in 7 sec. See macro
|
||||
interesting() in dump.c.
|
||||
|
||||
25-Jun-87 Dick Grune (dick) at tjalk
|
||||
Restructured the file dump.c, because of excessive nesting depth.
|
||||
The result, however, was an efficiency loss of 50 % (from 65 sec.
|
||||
to 96 sec.!). The restructuring will have to be rethought!
|
||||
|
||||
24-Jun-87 Dick Grune (dick) at tjalk
|
||||
The shadow-byte checking macro's are used only in data.c, dump.c
|
||||
and stack.c. They are brought into a new header file, shadow.h,
|
||||
which reduces the weight of mem.h.
|
||||
|
||||
22-Jun-87 Dick Grune (dick) at tjalk
|
||||
Removed or changed macros that assign to their parameters; these
|
||||
introduce a parameter mechanism that is alien to C and is misleading.
|
||||
|
||||
Made testing calls of malloc and realloc into functions Malloc and
|
||||
Realloc in init.c.
|
||||
|
||||
21-Jun-87 Dick Grune (dick) at tjalk
|
||||
Created global.c to contain the actual definitions from
|
||||
global.h. The declarations stay behind in global.h , thus
|
||||
avoiding multiple definitions.
|
||||
|
||||
Removed io.h altogether. All handling of the EM object file is
|
||||
now concentrated in read.c (fopen was in io.c, fclose in init.c).
|
||||
|
||||
21-Jun-87 Dick Grune (dick) at tjalk
|
||||
Renamed def.h global.h (in anticipation of global.c ).
|
||||
Removed test if (warnmark) from init.c. Here warnmark is an
|
||||
array, an error not caught by the VAX C compiler.
|
||||
|
||||
20-Jun-87 Dick Grune (dick) at tjalk
|
||||
Removed initializations from .h files. This resulted in the
|
||||
complete removal of trapmess.h and warnmess.h. Concentrated data
|
||||
about the return area in return.h. Slimmed down io.h considerably.
|
||||
|
||||
19-Jun-87 Dick Grune (dick) at tjalk
|
||||
Moved contents of ../include to here (src) since a separate
|
||||
include directory is only meaningful if it is referenced in other
|
||||
places as well. Updated Makefile and all #include's.
|
||||
Replaced SECUNDAIR by SECONDARY and TERTIAIR by TERTIARY.
|
||||
|
||||
All files included log.h and nocheck.h , which contain compile
|
||||
time flags. This is not logical; only the files that use LOG and
|
||||
NOCHECK should have any business of knowing about them.
|
||||
Reorganized the files in this sense. Dependencies recalculated by
|
||||
$(EM)/bin/mkdep.
|
||||
|
||||
18-Jun-87 Dick Grune (dick) at tjalk
|
||||
More reformatting, especially the complicated #define's.
|
||||
Established a small test environment.
|
||||
|
||||
17-Jun-87 Dick Grune (dick) at tjalk
|
||||
Made all indentation conform to tabulation scheme.
|
||||
Replaced register by register int where appropriate.
|
||||
|
||||
16-Jun-87 Dick Grune (dick) at tjalk
|
||||
Received the directory from Eddo de Groot and Leo van den Berge.
|
||||
|
||||
$Header$
|
||||
21
util/int/M.trap_msg
Executable file
21
util/int/M.trap_msg
Executable file
|
|
@ -0,0 +1,21 @@
|
|||
#!/bin/sh
|
||||
# $Header$
|
||||
|
||||
(
|
||||
echo '/* This file is generated from '$1'; do not edit */'
|
||||
|
||||
cat $1 |
|
||||
sed '
|
||||
s/..//
|
||||
s/.*/ "&",/
|
||||
'
|
||||
) >\#trap_msg
|
||||
|
||||
if # the new one unchanged
|
||||
cmp -s \#trap_msg trap_msg
|
||||
then # throw it away
|
||||
rm \#trap_msg
|
||||
else # overwrite old version
|
||||
mv \#trap_msg trap_msg
|
||||
fi
|
||||
|
||||
23
util/int/M.warn_h
Executable file
23
util/int/M.warn_h
Executable file
|
|
@ -0,0 +1,23 @@
|
|||
#!/bin/sh
|
||||
# $Header$
|
||||
|
||||
(
|
||||
echo '/* This file is generated from '$1'; do not edit */'
|
||||
|
||||
cat $1 |
|
||||
grep '^\.Wn' |
|
||||
sed '
|
||||
s/.*"/#define /
|
||||
'
|
||||
|
||||
echo '#define warning(n) do_warn((n), __LINE__, __FILE__)'
|
||||
) >\#warn.h
|
||||
|
||||
if # the new one unchanged
|
||||
cmp -s \#warn.h warn.h
|
||||
then # throw it away
|
||||
rm \#warn.h
|
||||
else # overwrite old version
|
||||
mv \#warn.h warn.h
|
||||
fi
|
||||
|
||||
24
util/int/M.warn_msg
Executable file
24
util/int/M.warn_msg
Executable file
|
|
@ -0,0 +1,24 @@
|
|||
#!/bin/sh
|
||||
# $Header$
|
||||
|
||||
(
|
||||
echo '/* This file is generated from '$1'; do not edit */'
|
||||
|
||||
cat $1 |
|
||||
grep '^\.Wn' |
|
||||
sed '
|
||||
s/^\.Wn[ ]*/ {/
|
||||
s/[ ]*[0-9][0-9]*$/},/
|
||||
s/"[ ][ ]*W/", W/
|
||||
s/\\-/-/g
|
||||
'
|
||||
) >\#warn_msg
|
||||
|
||||
if # the new one unchanged
|
||||
cmp -s \#warn_msg warn_msg
|
||||
then # throw it away
|
||||
rm \#warn_msg
|
||||
else # overwrite old version
|
||||
mv \#warn_msg warn_msg
|
||||
fi
|
||||
|
||||
143
util/int/Makefile
Normal file
143
util/int/Makefile
Normal file
|
|
@ -0,0 +1,143 @@
|
|||
# $Header$
|
||||
|
||||
EM = /usr/em# # EM tree
|
||||
|
||||
CC = cc# # C comp used for compiling the interpreter
|
||||
CFLAGS = -O# # passed to C compiler
|
||||
LFLAGS = # # passed to loader
|
||||
|
||||
IDIRS = -I$(EM)/h# # passed to C compiler and lint
|
||||
|
||||
INT = ./int# # name of resulting interpreter
|
||||
|
||||
IP_SPEC = $(EM)/etc/ip_spec.t
|
||||
TRAPS = $(EM)/etc/traps
|
||||
APP_A = ../doc/appA # to be moved later
|
||||
|
||||
SRC = alloc.c core.c data.c do_array.c do_branch.c do_comp.c do_conv.c \
|
||||
do_fpar.c do_incdec.c do_intar.c do_load.c do_logic.c do_misc.c \
|
||||
do_proc.c do_ptrar.c do_sets.c do_store.c do_unsar.c dump.c \
|
||||
disassemble.c fra.c global.c init.c io.c log.c m_ioctl.c m_sigtrp.c \
|
||||
main.c moncalls.c monstruct.c proctab.c read.c rsb.c segment.c \
|
||||
stack.c switch.c tally.c text.c trap.c warn.c
|
||||
|
||||
OBJ = alloc.o core.o data.o do_array.o do_branch.o do_comp.o do_conv.o \
|
||||
do_fpar.o do_incdec.o do_intar.o do_load.o do_logic.o do_misc.o \
|
||||
do_proc.o do_ptrar.o do_sets.o do_store.o do_unsar.o dump.o \
|
||||
disassemble.o fra.o global.o init.o io.o log.o m_ioctl.o m_sigtrp.o \
|
||||
main.o moncalls.o monstruct.o proctab.o read.o rsb.o segment.o \
|
||||
stack.o switch.o tally.o text.o trap.o warn.o
|
||||
|
||||
HDR = alloc.h fra.h global.h linfil.h log.h mem.h memdirect.h monstruct.h \
|
||||
opcode.h proctab.h read.h rsb.h shadow.h text.h trap.h \
|
||||
logging.h debug.h nofloat.h segcheck.h sysidf.h v7ioctl.h \
|
||||
e.out.h# should be in $(EM)/h or so, or in $(EM/h/em_abs.h
|
||||
|
||||
.SUFFIXES: .o
|
||||
.c.o:
|
||||
$(CC) $(CFLAGS) $(IDIRS) -c $<
|
||||
|
||||
|
||||
# Main entries
|
||||
test: $(INT)
|
||||
@rm -f int.mess
|
||||
- time $(INT) test22/awa.em <test22/awa.inp
|
||||
cat int.mess
|
||||
@rm -f int.mess
|
||||
-echo 3 5 7 2 -1 | time $(INT) test24/awa.em
|
||||
cat int.mess
|
||||
@rm -f int.mess
|
||||
-echo 3 5 7 2 -1 | time $(INT) test44/awa.em
|
||||
cat int.mess
|
||||
|
||||
$(INT): $(OBJ) Makefile
|
||||
$(CC) $(LFLAGS) -o $(INT) $(OBJ)
|
||||
@size $(INT)
|
||||
|
||||
|
||||
# Generated files
|
||||
trap_msg: M.trap_msg $(TRAPS)
|
||||
M.trap_msg $(TRAPS)
|
||||
|
||||
warn_msg: M.warn_msg $(APP_A)
|
||||
M.warn_msg $(APP_A)
|
||||
|
||||
warn.h: M.warn_h $(APP_A)
|
||||
M.warn_h $(APP_A)
|
||||
|
||||
switch/DoCases: $(IP_SPEC)
|
||||
(cd switch; make IP_SPEC=$(IP_SPEC) DoCases)
|
||||
|
||||
switch/PrCases: $(IP_SPEC)
|
||||
(cd switch; make IP_SPEC=$(IP_SPEC) PrCases)
|
||||
|
||||
|
||||
# Auxiliary entries
|
||||
lint:
|
||||
lint $(IDIRS) $(SRC) -lc
|
||||
|
||||
tags: $(HDR) $(SRC)
|
||||
ctags $(HDR) $(SRC)
|
||||
|
||||
MFILES = M.trap_msg M.warn_h M.warn_msg
|
||||
|
||||
ALL = READ_ME Makefile $(MFILES) $(HDR) $(SRC)
|
||||
|
||||
print:
|
||||
@pr $(ALL)
|
||||
|
||||
.distr: Makefile
|
||||
echo $(ALL) | tr ' ' '\012' >.distr
|
||||
|
||||
clean:
|
||||
rm -f core mon.out int.mess int.log int.core int.tally \
|
||||
trap_msg warn_msg warn.h tags print \
|
||||
$(OBJ)
|
||||
(cd switch; make clean)
|
||||
|
||||
bare: clean
|
||||
/bin/rm -f $(INT)
|
||||
(cd switch; make bare)
|
||||
|
||||
|
||||
#----------------------------------------------------------------
|
||||
alloc.o: alloc.h debug.h global.h
|
||||
core.o: fra.h global.h logging.h shadow.h
|
||||
data.o: alloc.h global.h log.h logging.h mem.h memdirect.h nofloat.h shadow.h trap.h warn.h
|
||||
disassemble.o: alloc.h global.h memdirect.h opcode.h proctab.h switch/PrCases
|
||||
do_array.o: fra.h global.h log.h logging.h mem.h text.h trap.h
|
||||
do_branch.o: fra.h global.h log.h logging.h mem.h text.h trap.h warn.h
|
||||
do_comp.o: fra.h global.h log.h logging.h mem.h nofloat.h shadow.h text.h trap.h warn.h
|
||||
do_conv.o: fra.h global.h log.h logging.h mem.h nofloat.h text.h trap.h warn.h
|
||||
do_fpar.o: fra.h global.h log.h logging.h mem.h nofloat.h text.h trap.h warn.h
|
||||
do_incdec.o: fra.h global.h log.h logging.h mem.h nofloat.h text.h trap.h warn.h
|
||||
do_intar.o: fra.h global.h log.h logging.h mem.h text.h trap.h warn.h
|
||||
do_load.o: fra.h global.h log.h logging.h mem.h rsb.h text.h trap.h warn.h
|
||||
do_logic.o: fra.h global.h log.h logging.h mem.h shadow.h text.h trap.h warn.h
|
||||
do_misc.o: fra.h global.h linfil.h log.h logging.h mem.h memdirect.h read.h rsb.h shadow.h text.h trap.h warn.h
|
||||
do_proc.o: fra.h global.h linfil.h log.h logging.h mem.h memdirect.h proctab.h rsb.h shadow.h text.h trap.h warn.h
|
||||
do_ptrar.o: fra.h global.h log.h logging.h mem.h segcheck.h text.h trap.h warn.h
|
||||
do_sets.o: fra.h global.h log.h logging.h mem.h text.h trap.h
|
||||
do_store.o: fra.h global.h log.h logging.h mem.h text.h trap.h warn.h
|
||||
do_unsar.o: fra.h global.h log.h logging.h mem.h text.h trap.h warn.h
|
||||
dump.o: global.h linfil.h log.h logging.h mem.h memdirect.h proctab.h rsb.h shadow.h text.h
|
||||
fra.o: alloc.h fra.h global.h logging.h mem.h shadow.h
|
||||
global.o: global.h
|
||||
init.o: alloc.h global.h log.h logging.h mem.h read.h shadow.h trap.h warn.h
|
||||
io.o: global.h linfil.h logging.h mem.h
|
||||
log.o: global.h linfil.h logging.h
|
||||
m_ioctl.o: global.h mem.h sysidf.h v7ioctl.h warn.h
|
||||
m_sigtrp.o: global.h log.h logging.h trap.h warn.h
|
||||
main.o: e.out.h global.h log.h logging.h nofloat.h opcode.h read.h rsb.h text.h trap.h warn.h
|
||||
moncalls.o: alloc.h global.h log.h logging.h mem.h shadow.h sysidf.h trap.h warn.h
|
||||
monstruct.o: global.h mem.h monstruct.h sysidf.h v7ioctl.h
|
||||
proctab.o: alloc.h global.h log.h logging.h proctab.h
|
||||
read.o: e.out.h global.h log.h logging.h mem.h nofloat.h read.h shadow.h text.h warn.h
|
||||
rsb.o: global.h linfil.h logging.h mem.h proctab.h rsb.h shadow.h warn.h
|
||||
segment.o: alloc.h global.h mem.h segcheck.h
|
||||
stack.o: alloc.h global.h log.h logging.h mem.h memdirect.h nofloat.h rsb.h shadow.h trap.h warn.h
|
||||
switch.o: global.h opcode.h switch/DoCases text.h trap.h warn.h
|
||||
tally.o: alloc.h global.h linfil.h
|
||||
text.o: alloc.h global.h proctab.h read.h text.h trap.h warn.h
|
||||
trap.o: fra.h global.h linfil.h log.h logging.h mem.h rsb.h shadow.h trap.h trap_msg warn.h
|
||||
warn.o: alloc.h global.h linfil.h log.h logging.h warn.h warn_msg
|
||||
37
util/int/READ_ME
Normal file
37
util/int/READ_ME
Normal file
|
|
@ -0,0 +1,37 @@
|
|||
# $Header$
|
||||
|
||||
This directory contains the sources of the EM interpreter. A parallel
|
||||
directory contains the manual page and the documentation. Two types of
|
||||
interpreters can be generated.
|
||||
|
||||
- Normal Version
|
||||
A call to make will result in the generation of an interpreter, int. This
|
||||
interpreter will do full checking and can do logging on request. It is the
|
||||
normal interpreter to be used for software checking and grooming.
|
||||
|
||||
- Fast Version
|
||||
If the interpreter is used for the purpose of running programs rather than for
|
||||
testing them, a considerably faster version can be generated by undefining the
|
||||
macro LOGGING in the include file logging.h . This interpreter will
|
||||
still give some warnings: about bad trap numbers, unimplemented system calls
|
||||
and the occurrence of traps.
|
||||
|
||||
There are a small number of compile-time flags, each in a separate file:
|
||||
loggin.h - distinguishes between normal and fast version
|
||||
debug.h - ignore
|
||||
segcheck.h - ignore
|
||||
sysidf.h - define the approrpiate system name
|
||||
v7ioctl.h - define if ioctl requests should conform to UNIX V7
|
||||
nofloat.h - define if the C compiler used has no floating point
|
||||
|
||||
|
||||
Installation note:
|
||||
The file do_fpar.c (do floating point arithmetic) contains a macro MAXDOUBLE
|
||||
which defines the largest possible double on the present machine. It is set to
|
||||
99.e999, which may not be acceptable to your compiler. Adjust as necessary.
|
||||
|
||||
Note:
|
||||
This interpreter assumes that the char in the C compiler used to translate
|
||||
the interpreter, is a signed char. It is not impossible to adapt the
|
||||
interpreter to unsigned chars, but it is not trivial.
|
||||
|
||||
48
util/int/alloc.c
Normal file
48
util/int/alloc.c
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
/* $Header$ */
|
||||
|
||||
#include "debug.h"
|
||||
#include "global.h"
|
||||
#include "alloc.h"
|
||||
|
||||
extern char *malloc();
|
||||
extern char *realloc();
|
||||
|
||||
char *Malloc(sz, descr)
|
||||
size sz;
|
||||
char *descr;
|
||||
{
|
||||
register char *new = malloc((unsigned int) (sz));
|
||||
|
||||
if (new == (char *) 0 && descr != (char *) 0)
|
||||
fatal("Cannot allocate %s", descr);
|
||||
|
||||
#ifdef DB_MALLOC /* from debug.h */
|
||||
/* fill area with recognizable garbage */
|
||||
{ register char *p = new;
|
||||
register size i = sz;
|
||||
register char ch = 0252;
|
||||
|
||||
if (p) {
|
||||
while (i--) {
|
||||
*p++ = ch;
|
||||
ch = ~ch;
|
||||
}
|
||||
}
|
||||
}
|
||||
#endif DB_MALLOC
|
||||
|
||||
return new;
|
||||
}
|
||||
|
||||
char *Realloc(old, sz, descr)
|
||||
char *old;
|
||||
size sz;
|
||||
char *descr;
|
||||
{
|
||||
register char *new = realloc(old, (unsigned int) (sz));
|
||||
|
||||
if (new == (char *) 0)
|
||||
fatal("Cannot reallocate %s", descr);
|
||||
return new;
|
||||
}
|
||||
|
||||
14
util/int/alloc.h
Normal file
14
util/int/alloc.h
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
/*
|
||||
Rather than using malloc and realloc, which require testing
|
||||
afterwards, we use a version that will either succeed or call
|
||||
fatal().
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
extern char *Realloc(), *Malloc();
|
||||
|
||||
/* reallocation factor */
|
||||
|
||||
#define allocfrac(s) ((s) * 3 / 2)
|
||||
|
||||
75
util/int/core.c
Normal file
75
util/int/core.c
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
/*
|
||||
Core dumping routines
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "shadow.h"
|
||||
#include "fra.h"
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
core_dump()
|
||||
{
|
||||
FILE *core_file;
|
||||
|
||||
core_file = fopen("int.core", "w");
|
||||
if (!core_file) {
|
||||
/* no point in giving a fatal error again! */
|
||||
return;
|
||||
}
|
||||
|
||||
/******** EM Machine capacity parameters ********/
|
||||
|
||||
fprintf(core_file, "wsize=%ld\n", wsize);
|
||||
fprintf(core_file, "psize=%ld\n", psize);
|
||||
|
||||
/******** EM program parameters ********/
|
||||
|
||||
fprintf(core_file, "ML=%lu\n", ML);
|
||||
fprintf(core_file, "HB=%lu\n", HB);
|
||||
fprintf(core_file, "DB=%lu\n", DB);
|
||||
fprintf(core_file, "NProc=%ld\n", NProc);
|
||||
|
||||
/******** EM machine registers ********/
|
||||
|
||||
fprintf(core_file, "PI=%ld\n", PI);
|
||||
fprintf(core_file, "PC=%lu\n", PC);
|
||||
|
||||
fprintf(core_file, "HP=%lu\n", HP);
|
||||
fprintf(core_file, "SP=%lu\n", SP);
|
||||
fprintf(core_file, "LB=%lu\n", LB);
|
||||
fprintf(core_file, "AB=%lu\n", AB);
|
||||
|
||||
fprintf(core_file, "ES=%ld\n", ES);
|
||||
fprintf(core_file, "ES_def=%d\n", ES_def);
|
||||
|
||||
fprintf(core_file, "OnTrap=%d\n", OnTrap);
|
||||
fprintf(core_file, "IgnMask=%ld\n", IgnMask);
|
||||
fprintf(core_file, "TrapPI=%d\n", TrapPI);
|
||||
|
||||
fprintf(core_file, "FRASize=%ld\n", FRASize);
|
||||
fprintf(core_file, "FRA_def=%d\n", FRA_def);
|
||||
|
||||
fprintf(core_file, "HL=%lu\n", HL);
|
||||
fprintf(core_file, "SL=%lu\n", SL);
|
||||
|
||||
/******** The EM machine memory ********/
|
||||
|
||||
fwrite(text, 1, (int)(DB), core_file);
|
||||
fwrite(data, 1, (int)(HL), core_file);
|
||||
fwrite(stack, 1, (int)(ML+1-SL), core_file);
|
||||
fwrite(FRA, 1, (int)(FRALimit), core_file);
|
||||
|
||||
#ifdef LOGGING
|
||||
fwrite(FRA_sh, 1, (int)(FRALimit), core_file);
|
||||
fwrite(data_sh, 1, (int)(HL), core_file);
|
||||
fwrite(stack_sh, 1, (int)(ML+1-SL), core_file);
|
||||
#endif LOGGING
|
||||
|
||||
fclose(core_file);
|
||||
core_file = 0;
|
||||
}
|
||||
|
||||
371
util/int/data.c
Normal file
371
util/int/data.c
Normal file
|
|
@ -0,0 +1,371 @@
|
|||
/*
|
||||
Data access
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "nofloat.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "alloc.h"
|
||||
#include "memdirect.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
|
||||
#define HEAPSIZE 1000L /* initial heap size */
|
||||
|
||||
extern size maxheap; /* from main.c */
|
||||
|
||||
#ifdef LOGGING
|
||||
char *data_sh; /* shadowbytes */
|
||||
#endif LOGGING
|
||||
|
||||
PRIVATE warn_dtbits();
|
||||
|
||||
init_data(hb)
|
||||
ptr hb;
|
||||
{
|
||||
HB = hb; /* set Heap Base */
|
||||
HP = HB; /* initialize Heap Pointer */
|
||||
HL = HB + HEAPSIZE; /* initialize Heap Limit */
|
||||
|
||||
data = Malloc((size)p2i(HL), "data space");
|
||||
#ifdef LOGGING
|
||||
data_sh = Malloc((size)p2i(HL), "shadowspace for data");
|
||||
dt_clear_area(i2p(0), HL);
|
||||
#endif LOGGING
|
||||
}
|
||||
|
||||
|
||||
/********************************************************
|
||||
* EM-register division. *
|
||||
********************************************************
|
||||
* *
|
||||
* newHP(p) - check and adjust HeapPointer. *
|
||||
* *
|
||||
********************************************************/
|
||||
|
||||
newHP(ap)
|
||||
ptr ap;
|
||||
{
|
||||
register ptr p = ap;
|
||||
|
||||
if (in_gda(p)) {
|
||||
wtrap(WHPGDA, EHEAP);
|
||||
}
|
||||
if (in_stack(p)) {
|
||||
wtrap(WHPSTACK, EHEAP);
|
||||
}
|
||||
if (!is_aligned(p, wsize)) {
|
||||
wtrap(WHPODD, EHEAP);
|
||||
}
|
||||
if (maxheap) {
|
||||
/* more than allowed on command line */
|
||||
if (p - HB > maxheap) {
|
||||
warning(WEHEAP);
|
||||
trap(EHEAP);
|
||||
}
|
||||
}
|
||||
if (p > HL) {
|
||||
/* extend heap space */
|
||||
HL = i2p(allocfrac(p2i(p)) - 1);
|
||||
data = Realloc(data, (size)(p2i(HL) + 1), "heap space");
|
||||
#ifdef LOGGING
|
||||
data_sh = Realloc(data_sh, (size)(p2i(HL) + 1),
|
||||
"shadowspace for heap");
|
||||
#endif LOGGING
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
if (p > HP) {
|
||||
dt_clear_area(HP, p);
|
||||
}
|
||||
#endif LOGGING
|
||||
HP = p;
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Data store division. *
|
||||
************************************************************************
|
||||
* *
|
||||
* dt_stdp(addr, p) - STore Data Pointer. *
|
||||
* dt_stn(addr, l, n) - STore N byte integer. *
|
||||
* dt_stf(addr, f, n) - STore n byte Floating point number. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
dt_stdp(addr, ap)
|
||||
ptr addr, ap;
|
||||
{
|
||||
register int i;
|
||||
register long p = (long) ap;
|
||||
|
||||
LOG(("@g6 dt_stdp(%lu, %lu)", addr, p));
|
||||
ch_in_data(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
for (i = 0; i < (int) psize; i++) {
|
||||
ch_dt_prot(addr + i);
|
||||
data_loc(addr + i) = (char) (p);
|
||||
dt_dp(addr + i);
|
||||
p = p>>8;
|
||||
}
|
||||
}
|
||||
|
||||
dt_stip(addr, ap)
|
||||
ptr addr, ap;
|
||||
{
|
||||
register int i;
|
||||
register long p = (long) ap;
|
||||
|
||||
LOG(("@g6 dt_stip(%lu, %lu)", addr, p));
|
||||
ch_in_data(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
for (i = 0; i < (int) psize; i++) {
|
||||
ch_dt_prot(addr + i);
|
||||
data_loc(addr + i) = (char) (p);
|
||||
dt_ip(addr + i);
|
||||
p = p>>8;
|
||||
}
|
||||
}
|
||||
|
||||
dt_stn(addr, al, n)
|
||||
ptr addr;
|
||||
long al;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
register long l = al;
|
||||
|
||||
LOG(("@g6 dt_stn(%lu, %lu, %lu)", addr, l, n));
|
||||
ch_in_data(addr, n);
|
||||
ch_aligned(addr, n);
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_dt_prot(addr + i);
|
||||
data_loc(addr + i) = (char) l;
|
||||
#ifdef LOGGING
|
||||
if (al == 0 && n == psize) {
|
||||
/* a psize zero, ambiguous */
|
||||
dt_sh(addr + i) = (SH_INT|SH_DATAP);
|
||||
}
|
||||
else {
|
||||
dt_sh(addr + i) = SH_INT;
|
||||
}
|
||||
#endif LOGGING
|
||||
l = l>>8;
|
||||
}
|
||||
}
|
||||
|
||||
#ifndef NOFLOAT
|
||||
dt_stf(addr, f, n)
|
||||
ptr addr;
|
||||
double f;
|
||||
size n;
|
||||
{
|
||||
register char *cp = (char *) &f;
|
||||
register int i;
|
||||
|
||||
LOG(("@g6 dt_stf(%lu, %g, %lu)", addr, f, n));
|
||||
ch_in_data(addr, n);
|
||||
ch_aligned(addr, wsize);
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_dt_prot(addr + i);
|
||||
data_loc(addr + i) = *cp++;
|
||||
dt_fl(addr + i);
|
||||
}
|
||||
}
|
||||
#endif NOFLOAT
|
||||
|
||||
/************************************************************************
|
||||
* Data load division. *
|
||||
************************************************************************
|
||||
* *
|
||||
* dt_lddp(addr) - LoaD Data Pointer from data. *
|
||||
* dt_ldip(addr) - LoaD Instruction Pointer from data. *
|
||||
* dt_ldu(addr, n) - LoaD n Unsigned bytes from data. *
|
||||
* dt_lds(addr, n) - LoaD n Signed bytes from data. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
ptr dt_lddp(addr)
|
||||
ptr addr;
|
||||
{
|
||||
register ptr p;
|
||||
|
||||
LOG(("@g6 dt_lddp(%lu)", addr));
|
||||
|
||||
ch_in_data(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
#ifdef LOGGING
|
||||
if (!is_dt_set(addr, psize, SH_DATAP)) {
|
||||
warning(WGDPEXP);
|
||||
warn_dtbits(addr, psize);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
p = p_in_data(addr);
|
||||
LOG(("@g6 dt_lddp() returns %lu", p));
|
||||
return (p);
|
||||
}
|
||||
|
||||
ptr dt_ldip(addr)
|
||||
ptr addr;
|
||||
{
|
||||
register ptr p;
|
||||
|
||||
LOG(("@g6 dt_ldip(%lu)", addr));
|
||||
|
||||
ch_in_data(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
#ifdef LOGGING
|
||||
if (!is_dt_set(addr, psize, SH_INSP)) {
|
||||
warning(WGIPEXP);
|
||||
warn_dtbits(addr, psize);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
p = p_in_data(addr);
|
||||
LOG(("@g6 dt_ldip() returns %lu", p));
|
||||
return (p);
|
||||
}
|
||||
|
||||
unsigned long dt_ldu(addr, n)
|
||||
ptr addr;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
register unsigned long u = 0;
|
||||
|
||||
LOG(("@g6 dt_ldu(%lu, %lu)", addr, n));
|
||||
|
||||
ch_in_data(addr, n);
|
||||
ch_aligned(addr, n);
|
||||
#ifdef LOGGING
|
||||
if (!is_dt_set(addr, n, SH_INT)) {
|
||||
warning(n == 1 ? WGCEXP : WGIEXP);
|
||||
warn_dtbits(addr, n);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
for (i = (int) n-1; i >= 0; i--) {
|
||||
u = (u<<8) | btou(data_loc(addr + i));
|
||||
}
|
||||
LOG(("@g6 dt_ldu() returns %lu", u));
|
||||
return (u);
|
||||
}
|
||||
|
||||
long dt_lds(addr, n)
|
||||
ptr addr;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
register long l;
|
||||
|
||||
LOG(("@g6 dt_lds(%lu, %lu)", addr, n));
|
||||
|
||||
ch_in_data(addr, n);
|
||||
ch_aligned(addr, n);
|
||||
#ifdef LOGGING
|
||||
if (!is_dt_set(addr, n, SH_INT)) {
|
||||
warning(n == 1 ? WGCEXP : WGIEXP);
|
||||
warn_dtbits(addr, n);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
l = btos(data_loc(addr + n - 1));
|
||||
for (i = n - 2; i >= 0; i--) {
|
||||
l = (l<<8) | btol(data_loc(addr + i));
|
||||
}
|
||||
LOG(("@g6 dt_lds() returns %lu", l));
|
||||
return (l);
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Data move division *
|
||||
************************************************************************
|
||||
* *
|
||||
* dt_mvd(d2, d1, n) - Move n bytes in data from d1 to d2. *
|
||||
* dt_mvs(d, s, n) - Move n bytes from s in stack to d in data. *
|
||||
* *
|
||||
* See st_mvs() in stack.c for a description. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
dt_mvd(d2, d1, n) /* d1 -> d2 */
|
||||
ptr d2, d1;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
|
||||
ch_in_data(d1, n);
|
||||
ch_aligned(d1, wsize);
|
||||
ch_in_data(d2, n);
|
||||
ch_aligned(d2, wsize);
|
||||
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_dt_prot(d2 + i);
|
||||
data_loc(d2 + i) = data_loc(d1 + i);
|
||||
#ifdef LOGGING
|
||||
dt_sh(d2 + i) = dt_sh(d1 + i) & ~SH_PROT;
|
||||
#endif LOGGING
|
||||
}
|
||||
}
|
||||
|
||||
dt_mvs(d, s, n) /* s -> d */
|
||||
ptr d, s;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
|
||||
ch_in_stack(s, n);
|
||||
ch_aligned(s, wsize);
|
||||
ch_in_data(d, n);
|
||||
ch_aligned(d, wsize);
|
||||
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_dt_prot(d + i);
|
||||
ch_st_prot(s + i);
|
||||
data_loc(d + i) = stack_loc(s + i);
|
||||
#ifdef LOGGING
|
||||
dt_sh(d + i) = st_sh(s + i) & ~SH_PROT;
|
||||
#endif LOGGING
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
PRIVATE warn_dtbits(addr, n)
|
||||
ptr addr;
|
||||
size n;
|
||||
{
|
||||
register int or_bits = 0;
|
||||
register int and_bits = 0xff;
|
||||
|
||||
while (n--) {
|
||||
or_bits |= dt_sh(addr);
|
||||
and_bits &= dt_sh(addr);
|
||||
addr++;
|
||||
}
|
||||
|
||||
if (or_bits != and_bits) {
|
||||
/* no use trying to diagnose */
|
||||
warningcont(WWASMISC);
|
||||
return;
|
||||
}
|
||||
if (or_bits == 0)
|
||||
warningcont(WWASUND);
|
||||
if (or_bits & SH_INT)
|
||||
warningcont(WWASINT);
|
||||
if (or_bits & SH_FLOAT)
|
||||
warningcont(WWASFLOAT);
|
||||
if (or_bits & SH_DATAP)
|
||||
warningcont(WWASDATAP);
|
||||
if (or_bits & SH_INSP)
|
||||
warningcont(WWASINSP);
|
||||
}
|
||||
|
||||
#endif LOGGING
|
||||
|
||||
8
util/int/debug.h
Normal file
8
util/int/debug.h
Normal file
|
|
@ -0,0 +1,8 @@
|
|||
/*
|
||||
Various debug flags
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#undef DB_MALLOC /* sally malloc area */
|
||||
|
||||
1776
util/int/disassemble.c
Normal file
1776
util/int/disassemble.c
Normal file
File diff suppressed because it is too large
Load diff
142
util/int/do_array.c
Normal file
142
util/int/do_array.c
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
/*
|
||||
* Sources of the "ARRAY" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "trap.h"
|
||||
#include "mem.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
|
||||
#define LAR 1
|
||||
#define SAR 2
|
||||
#define AAR 3
|
||||
|
||||
PRIVATE arr();
|
||||
|
||||
DoLARl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* LAR w: Load array element, descriptor contains integers of size w */
|
||||
register size l = (L_arg_2() * 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));
|
||||
}
|
||||
|
||||
DoLARz()
|
||||
{
|
||||
/* LAR w: Load array element, descriptor contains integers of size w */
|
||||
register size l = upop(wsize);
|
||||
|
||||
LOG(("@A6 DoLARz(%ld)", l));
|
||||
arr(LAR, arg_wi(l));
|
||||
}
|
||||
|
||||
DoSARl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* SAR w: Store array element */
|
||||
register size l = (L_arg_2() * 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));
|
||||
}
|
||||
|
||||
DoSARz()
|
||||
{
|
||||
/* SAR w: Store array element */
|
||||
register size l = upop(wsize);
|
||||
|
||||
LOG(("@A6 DoSARz(%ld)", l));
|
||||
arr(SAR, arg_wi(l));
|
||||
}
|
||||
|
||||
DoAARl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* AAR w: Load address of array element */
|
||||
register size l = (L_arg_2() * 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));
|
||||
}
|
||||
|
||||
DoAARz()
|
||||
{
|
||||
/* AAR w: Load address of array element */
|
||||
register size l = upop(wsize);
|
||||
|
||||
LOG(("@A6 DoAARz(%ld)", l));
|
||||
arr(AAR, arg_wi(l));
|
||||
}
|
||||
|
||||
/********************************************************
|
||||
* Array arithmetic *
|
||||
* *
|
||||
* 1. The address of the descriptor is popped. *
|
||||
* 2. The index is popped. *
|
||||
* 3. Calculate index - lower bound. *
|
||||
* 4. Check if in range. *
|
||||
* 5. Calculate object size. *
|
||||
* 6. Perform the correct function. *
|
||||
*********************************************************/
|
||||
|
||||
PRIVATE arr(type, elm_size)
|
||||
int type; /* operation TYPE */
|
||||
size elm_size; /* ELeMent SIZE */
|
||||
{
|
||||
register ptr desc = dppop(); /* array DESCriptor */
|
||||
register size obj_size; /* OBJect SIZE */
|
||||
register long diff = /* between index and lower bound */
|
||||
spop(elm_size) - mem_lds(desc, elm_size);
|
||||
register ptr arr_addr = dppop();/* ARRay ADDRess */
|
||||
|
||||
if (must_test && !(IgnMask&BIT(EARRAY))) {
|
||||
if (diff < 0 || diff > mem_lds(desc + elm_size, elm_size)) {
|
||||
trap(EARRAY);
|
||||
}
|
||||
}
|
||||
obj_size = mem_lds(desc + (2*elm_size), elm_size);
|
||||
obj_size = arg_o(((long) obj_size));
|
||||
spoilFRA(); /* array functions don't retain FRA */
|
||||
switch (type) {
|
||||
case LAR:
|
||||
push_m(arr_addr + diff * obj_size, obj_size);
|
||||
break;
|
||||
case SAR:
|
||||
pop_m(arr_addr + diff * obj_size, obj_size);
|
||||
break;
|
||||
case AAR:
|
||||
dppush(arr_addr + diff * obj_size);
|
||||
break;
|
||||
}
|
||||
}
|
||||
515
util/int/do_branch.c
Normal file
515
util/int/do_branch.c
Normal file
|
|
@ -0,0 +1,515 @@
|
|||
/*
|
||||
* Sources of the "BRANCH" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
#include "warn.h"
|
||||
|
||||
/* Note that in the EM assembly language brach instructions have
|
||||
lables as their arguments, where in the EM machine language they
|
||||
have (relative) offsets as parameters. This is not described in the
|
||||
EM manual but follows from the Pascal interpreter.
|
||||
*/
|
||||
|
||||
#define do_jump(j) { newPC(PC + (j)); }
|
||||
|
||||
DoBRAl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* BRA b: Branch unconditionally to label b */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@B6 DoBRAl2(%ld)", jump));
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoBRAl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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) */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
register long t = wpop();
|
||||
|
||||
LOG(("@B6 DoBLTl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() < t)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoBLTl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
register long t = wpop();
|
||||
|
||||
LOG(("@B6 DoBLEl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() <= t)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoBLEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
register long t = wpop();
|
||||
|
||||
LOG(("@B6 DoBEQl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (t == wpop())
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoBEQl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
register long t = wpop();
|
||||
|
||||
LOG(("@B6 DoBNEl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (t != wpop())
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoBNEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
register long t = wpop();
|
||||
|
||||
LOG(("@B6 DoBGEl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() >= t)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoBGEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
register long t = wpop();
|
||||
|
||||
LOG(("@B6 DoBGTl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() > t)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoBGTl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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) */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@B6 DoZLTl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() < 0)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoZLTl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@B6 DoZLEl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() <= 0)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoZLEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@B6 DoZEQl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() == 0)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoZEQl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@B6 DoZNEl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() != 0)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoZNEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@B6 DoZGEl2(%ld)", jump));
|
||||
spoilFRA();
|
||||
if (wpop() >= 0)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
|
||||
DoZGEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long jump = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@B6 DoZGTl2(%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();
|
||||
if (wpop() > 0)
|
||||
do_jump(arg_c(jump));
|
||||
}
|
||||
271
util/int/do_comp.c
Normal file
271
util/int/do_comp.c
Normal file
|
|
@ -0,0 +1,271 @@
|
|||
/*
|
||||
* Sources of the "COMPARE" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "nofloat.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "warn.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
|
||||
#ifndef NOFLOAT
|
||||
extern double fpop();
|
||||
#endif NOFLOAT
|
||||
|
||||
PRIVATE compare_obj();
|
||||
|
||||
DoCMIl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 s = spop(l);
|
||||
|
||||
LOG(("@T6 DoCMIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoCMIm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoCMIz()
|
||||
{
|
||||
/* CMI w: Compare w byte integers, Push negative, zero, positive for <, = or > */
|
||||
register size l = upop(wsize);
|
||||
register long t = spop(arg_wi(l));
|
||||
register long s = spop(l);
|
||||
|
||||
LOG(("@T6 DoCMIz(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoCMFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* CMF w: Compare w byte reals */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
double t = fpop(arg_wf(l));
|
||||
double s = fpop(l);
|
||||
|
||||
LOG(("@T6 DoCMFl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
#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();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
#else NOFLOAT
|
||||
hob = hob;
|
||||
wfac = wfac;
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoCMFz()
|
||||
{
|
||||
/* CMF w: Compare w byte reals */
|
||||
#ifndef NOFLOAT
|
||||
register size l = upop(wsize);
|
||||
double t = fpop(arg_wf(l));
|
||||
double s = fpop(l);
|
||||
|
||||
LOG(("@T6 DoCMFz(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoCMUl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* CMU w: Compare w byte unsigneds */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(arg_wi(l));
|
||||
register unsigned long s = upop(l);
|
||||
|
||||
LOG(("@T6 DoCMUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoCMUz()
|
||||
{
|
||||
/* CMU w: Compare w byte unsigneds */
|
||||
register size l = upop(wsize);
|
||||
register unsigned long t = upop(arg_wi(l));
|
||||
register unsigned long s = upop(l);
|
||||
|
||||
LOG(("@T6 DoCMUz(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoCMSl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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));
|
||||
spoilFRA();
|
||||
compare_obj(arg_w(l));
|
||||
}
|
||||
|
||||
DoCMSs(hob, wfac)
|
||||
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 = upop(wsize);
|
||||
|
||||
LOG(("@T6 DoCMSz(%ld)", l));
|
||||
spoilFRA();
|
||||
compare_obj(arg_w(l));
|
||||
}
|
||||
|
||||
DoCMPz()
|
||||
{
|
||||
/* CMP -: Compare pointers */
|
||||
register ptr t, s;
|
||||
|
||||
LOG(("@T6 DoCMPz()"));
|
||||
spoilFRA();
|
||||
t = dppop();
|
||||
s = dppop();
|
||||
npush((long)(t < s ? 1 : t > s ? -1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoTLTz()
|
||||
{
|
||||
/* TLT -: True if less, i.e. iff top of stack < 0 */
|
||||
LOG(("@T6 DoTLTz()"));
|
||||
spoilFRA();
|
||||
npush((long)(wpop() < 0 ? 1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoTLEz()
|
||||
{
|
||||
/* TLE -: True if less or equal, i.e. iff top of stack <= 0 */
|
||||
LOG(("@T6 DoTLEz()"));
|
||||
spoilFRA();
|
||||
npush((long)(wpop() <= 0 ? 1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoTEQz()
|
||||
{
|
||||
/* TEQ -: True if equal, i.e. iff top of stack = 0 */
|
||||
LOG(("@T6 DoTEQz()"));
|
||||
spoilFRA();
|
||||
npush((long)(wpop() == 0 ? 1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoTNEz()
|
||||
{
|
||||
/* TNE -: True if not equal, i.e. iff top of stack non zero */
|
||||
LOG(("@T6 DoTNEz()"));
|
||||
spoilFRA();
|
||||
npush((long)(wpop() != 0 ? 1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoTGEz()
|
||||
{
|
||||
/* TGE -: True if greater or equal, i.e. iff top of stack >= 0 */
|
||||
LOG(("@T6 DoTGEz()"));
|
||||
spoilFRA();
|
||||
npush((long)(wpop() >= 0 ? 1 : 0), wsize);
|
||||
}
|
||||
|
||||
DoTGTz()
|
||||
{
|
||||
/* TGT -: True if greater, i.e. iff top of stack > 0 */
|
||||
LOG(("@T6 DoTGTz()"));
|
||||
spoilFRA();
|
||||
npush((long)(wpop() > 0 ? 1 : 0), wsize);
|
||||
}
|
||||
|
||||
/********************************************************
|
||||
* Compare objects *
|
||||
* *
|
||||
* Two 'obj_size' sized objects are bytewise *
|
||||
* compared; as soon as one byte is different *
|
||||
* 1 is returned, otherwise 0. No type checking *
|
||||
* is performed. Checking for undefined bytes *
|
||||
* is done when LOGGING is defined. *
|
||||
********************************************************/
|
||||
|
||||
PRIVATE compare_obj(obj_size)
|
||||
size obj_size;
|
||||
{
|
||||
register ptr addr1; /* ADDRess in object highest on st. */
|
||||
register ptr addr2; /* ADDRess in object deeper in st. */
|
||||
register int comp_res = 0; /* COMPare RESult */
|
||||
|
||||
for ( addr1 = SP, addr2 = SP + obj_size;
|
||||
addr1 < SP + obj_size;
|
||||
addr1++, addr2++
|
||||
) {
|
||||
#ifdef LOGGING
|
||||
if (!st_sh(addr1) || !st_sh(addr2)) {
|
||||
warning(WUNCMP);
|
||||
/* Let's say undefined's are not equal: */
|
||||
comp_res = 1;
|
||||
break;
|
||||
}
|
||||
#endif LOGGING
|
||||
if (stack_loc(addr1) != stack_loc(addr2)) {
|
||||
comp_res = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
st_dec(2 * obj_size);
|
||||
npush((long) comp_res, wsize);
|
||||
}
|
||||
383
util/int/do_conv.c
Normal file
383
util/int/do_conv.c
Normal file
|
|
@ -0,0 +1,383 @@
|
|||
/*
|
||||
* Sources of the "CONVERT" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "nofloat.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
#include "warn.h"
|
||||
|
||||
#ifndef NOFLOAT
|
||||
extern double fpop();
|
||||
#endif NOFLOAT
|
||||
|
||||
DoCIIz()
|
||||
{
|
||||
/* CII -: Convert integer to integer (*) */
|
||||
register int newsize = spop(wsize);
|
||||
register long s;
|
||||
|
||||
LOG(("@C6 DoCIIz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 12:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
npush(spop(1L), 2L);
|
||||
return;
|
||||
case 14:
|
||||
npush(spop(1L), 4L);
|
||||
return;
|
||||
case 22:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
return;
|
||||
case 24:
|
||||
npush(spop(2L), 4L);
|
||||
return;
|
||||
case 42:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
s = spop(4L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (s < I_MINS2 || s > I_MAXS2)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush(s, 2L);
|
||||
return;
|
||||
case 44:
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
}
|
||||
|
||||
DoCUIz()
|
||||
{
|
||||
/* CUI -: Convert unsigned to integer (*) */
|
||||
register int newsize = spop(wsize);
|
||||
register unsigned long u;
|
||||
|
||||
LOG(("@C6 DoCUIz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 22:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
u = upop(2L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (u > I_MAXS2)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush((long) u, 2L);
|
||||
return;
|
||||
case 24:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
npush((long) upop(2L), 4L);
|
||||
return;
|
||||
case 42:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
u = upop(4L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (u > I_MAXS2)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush((long) u, 2L);
|
||||
return;
|
||||
case 44:
|
||||
u = upop(4L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (u > I_MAXS4)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush((long) u, 4L);
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
}
|
||||
|
||||
DoCFIz()
|
||||
{
|
||||
/* CFI -: Convert floating to integer (*) */
|
||||
#ifndef NOFLOAT
|
||||
register int newsize = spop(wsize);
|
||||
double f;
|
||||
|
||||
LOG(("@C6 DoCFIz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 42:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
f = fpop(4L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (f <= (FL_MINS2 - 1.0) || f > FL_MAXS2)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush((long) f, 2L);
|
||||
return;
|
||||
case 44:
|
||||
f = fpop(4L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (f <= (FL_MINS4 - 1.0) || f > FL_MAXS4)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush((long) f, 4L);
|
||||
return;
|
||||
case 82:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
f = fpop(8L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (f <= (FL_MINS2 - 1.0) || f > FL_MAXS2)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush((long) f, 2L);
|
||||
return;
|
||||
case 84:
|
||||
f = fpop(8L);
|
||||
if (must_test && !(IgnMask&BIT(ECONV))) {
|
||||
if (f <= (FL_MINS4 - 1.0) || f > FL_MAXS4)
|
||||
trap(ECONV);
|
||||
}
|
||||
npush((long) f, 4L);
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoCIFz()
|
||||
{
|
||||
/* CIF -: Convert integer to floating (*) */
|
||||
#ifndef NOFLOAT
|
||||
register int newsize = spop(wsize);
|
||||
|
||||
LOG(("@C6 DoCIFz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 24:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
fpush((double) spop(2L), 4L);
|
||||
return;
|
||||
case 28:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
fpush((double) spop(2L), 8L);
|
||||
return;
|
||||
case 44:
|
||||
fpush((double) spop(4L), 4L);
|
||||
return;
|
||||
case 48:
|
||||
fpush((double) spop(4L), 8L);
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoCUFz()
|
||||
{
|
||||
/* CUF -: Convert unsigned to floating (*) */
|
||||
#ifndef NOFLOAT
|
||||
register int newsize = spop(wsize);
|
||||
register unsigned long u;
|
||||
|
||||
LOG(("@C6 DoCUFz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 24:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
fpush((double) upop(2L), 4L);
|
||||
return;
|
||||
case 28:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
fpush((double) upop(2L), 8L);
|
||||
return;
|
||||
case 44:
|
||||
if ((u = upop(4L)) > I_MAXS4) {
|
||||
u -= I_MAXS4;
|
||||
u -= 1;
|
||||
fpush(((double) u) - (double)(-I_MAXS4-1), 4L);
|
||||
}
|
||||
else fpush((double) u, 4L);
|
||||
return;
|
||||
case 48:
|
||||
if ((u = upop(4L)) > I_MAXS4) {
|
||||
u -= I_MAXS4;
|
||||
u -= 1;
|
||||
fpush(((double) u) - (double)(-I_MAXS4-1), 8L);
|
||||
}
|
||||
else fpush((double) u, 8L);
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoCFFz()
|
||||
{
|
||||
/* CFF -: Convert floating to floating (*) */
|
||||
#ifndef NOFLOAT
|
||||
register int newsize = spop(wsize);
|
||||
|
||||
LOG(("@C6 DoCFFz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 44:
|
||||
return;
|
||||
case 48:
|
||||
fpush(fpop(4L), 8L);
|
||||
return;
|
||||
case 88:
|
||||
return;
|
||||
case 84:
|
||||
fpush(fpop(8L), 4L);
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoCIUz()
|
||||
{
|
||||
/* CIU -: Convert integer to unsigned */
|
||||
register int newsize = spop(wsize);
|
||||
register long u;
|
||||
|
||||
LOG(("@C6 DoCIUz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 22:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
return;
|
||||
case 24:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
npush((long) upop(2L), 4L);
|
||||
return;
|
||||
case 42:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
u = upop(4L);
|
||||
npush(u, 2L);
|
||||
return;
|
||||
case 44:
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
}
|
||||
|
||||
DoCUUz()
|
||||
{
|
||||
/* CUU -: Convert unsigned to unsigned */
|
||||
register int newsize = spop(wsize);
|
||||
|
||||
LOG(("@C6 DoCUUz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 22:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
return;
|
||||
case 24:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
npush((long) upop(2L), 4L);
|
||||
return;
|
||||
case 42:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
npush((long) upop(4L), 2L);
|
||||
return;
|
||||
case 44:
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
}
|
||||
|
||||
DoCFUz()
|
||||
{
|
||||
/* CFU -: Convert floating to unsigned */
|
||||
#ifndef NOFLOAT
|
||||
register int newsize = spop(wsize);
|
||||
double f;
|
||||
|
||||
LOG(("@C6 DoCFUz()"));
|
||||
spoilFRA();
|
||||
switch ((int)(10 * spop(wsize) + newsize)) {
|
||||
case 42:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
f = fpop(4L);
|
||||
npush((long) f, 2L);
|
||||
return;
|
||||
case 44:
|
||||
f = fpop(4L);
|
||||
npush((long) f, 4L);
|
||||
return;
|
||||
case 82:
|
||||
if (wsize == 4) {
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
f = fpop(8L);
|
||||
npush((long) f, 2L);
|
||||
return;
|
||||
case 84:
|
||||
f = fpop(8L);
|
||||
npush((long) f, 4L);
|
||||
return;
|
||||
default:
|
||||
wtrap(WILLCONV, EILLINS);
|
||||
}
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
639
util/int/do_fpar.c
Normal file
639
util/int/do_fpar.c
Normal file
|
|
@ -0,0 +1,639 @@
|
|||
/*
|
||||
* Sources of the "FLOATING POINT ARITHMETIC" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "nofloat.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
#include "warn.h"
|
||||
|
||||
#ifndef NOFLOAT
|
||||
|
||||
extern double fpop();
|
||||
|
||||
#define MAXDOUBLE 99.e999 /* IEEE infinity */ /*???*/
|
||||
#define SMALL (1.0/MAXDOUBLE)
|
||||
|
||||
PRIVATE double adf(), sbf(), mlf(), dvf();
|
||||
PRIVATE double ttttp();
|
||||
PRIVATE double floor(), fabs();
|
||||
PRIVATE fef(), fif();
|
||||
|
||||
#endif NOFLOAT
|
||||
|
||||
DoADFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* ADF w: Floating add (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoADFl2(%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 = upop(wsize);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoADFz(%ld)", l));
|
||||
spoilFRA();
|
||||
fpush(adf(fpop(l), t), l);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoSBFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* SBF w: Floating subtract (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoSBFl2(%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 = upop(wsize);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoSBFz(%ld)", l));
|
||||
spoilFRA();
|
||||
fpush(sbf(fpop(l), t), l);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoMLFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* MLF w: Floating multiply (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoMLFl2(%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 = upop(wsize);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoMLFz(%ld)", l));
|
||||
spoilFRA();
|
||||
fpush(mlf(fpop(l), t), l);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoDVFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* DVF w: Floating divide (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoDVFl2(%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 = upop(wsize);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoDVFz(%ld)", l));
|
||||
spoilFRA();
|
||||
fpush(dvf(fpop(l), t), l);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoNGFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* NGF w: Floating negate (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoNGFl2(%ld)", l));
|
||||
spoilFRA();
|
||||
fpush(-t, l);
|
||||
#else NOFLOAT
|
||||
arg = arg;
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoNGFz()
|
||||
{
|
||||
/* NGF w: Floating negate (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = upop(wsize);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoNGFz(%ld)", l));
|
||||
spoilFRA();
|
||||
fpush(-t, l);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoFIFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* FIF w: Floating multiply and split integer and fraction part (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoFIFl2(%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 = upop(wsize);
|
||||
double t = fpop(arg_wf(l));
|
||||
|
||||
LOG(("@F6 DoFIFz(%ld)", l));
|
||||
spoilFRA();
|
||||
fif(fpop(l), t, l);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoFEFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* FEF w: Split floating number in exponent and fraction part (*) */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
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 = upop(wsize);
|
||||
|
||||
LOG(("@F6 DoFEFz(%ld)", l));
|
||||
spoilFRA();
|
||||
fef(fpop(arg_wf(l)), l);
|
||||
#else NOFLOAT
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
#ifndef NOFLOAT
|
||||
|
||||
/* Service routines */
|
||||
|
||||
PRIVATE double adf(f1, f2) /* returns f1 + f2 */
|
||||
double f1, f2;
|
||||
{
|
||||
if (must_test && !(IgnMask&BIT(EFOVFL))) {
|
||||
if (f1 > 0.0 && f2 > 0.0) {
|
||||
if (MAXDOUBLE - f1 < f2) {
|
||||
trap(EFOVFL);
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
else if (f1 < 0.0 && f2 < 0.0) {
|
||||
if (-(MAXDOUBLE + f1) > f2) {
|
||||
trap(EFOVFL);
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
}
|
||||
return (f1 + f2);
|
||||
}
|
||||
|
||||
PRIVATE double sbf(f1, f2) /* returns f1 - f2 */
|
||||
double f1, f2;
|
||||
{
|
||||
if (must_test && !(IgnMask&BIT(EFOVFL))) {
|
||||
if (f2 < 0.0 && f1 > 0.0) {
|
||||
if (MAXDOUBLE - f1 < -f2) {
|
||||
trap(EFOVFL);
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
else if (f2 > 0.0 && f1 < 0.0) {
|
||||
if (f2 - MAXDOUBLE > f1) {
|
||||
trap(EFOVFL);
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
}
|
||||
return (f1 - f2);
|
||||
}
|
||||
|
||||
PRIVATE double mlf(f1, f2) /* returns f1 * f2 */
|
||||
double f1, f2;
|
||||
{
|
||||
double ff1 = fabs(f1), ff2 = fabs(f2);
|
||||
|
||||
if (f1 == 0.0 || f2 == 0.0)
|
||||
return (0.0);
|
||||
|
||||
if ((ff1 >= 1.0 && ff2 <= 1.0) || (ff2 >= 1.0 && ff1 <= 1.0))
|
||||
return (f1 * f2);
|
||||
|
||||
if (must_test && !(IgnMask&BIT(EFUNFL))) {
|
||||
if (ff1 < 1.0 && ff2 < 1.0) {
|
||||
if (SMALL / ff1 > ff2) {
|
||||
trap(EFUNFL);
|
||||
return (0.0);
|
||||
}
|
||||
return (f1 * f2);
|
||||
}
|
||||
}
|
||||
|
||||
if (must_test && !(IgnMask&BIT(EFOVFL))) {
|
||||
if (MAXDOUBLE / ff1 < ff2) {
|
||||
trap(EFOVFL);
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
return (f1 * f2);
|
||||
}
|
||||
|
||||
PRIVATE double dvf(f1, f2) /* returns f1 / f2 */
|
||||
double f1, f2;
|
||||
{
|
||||
double ff1 = fabs(f1), ff2 = fabs(f2);
|
||||
|
||||
if (f2 == 0.0) {
|
||||
if (!(IgnMask&BIT(EFDIVZ))) {
|
||||
trap(EFDIVZ);
|
||||
}
|
||||
else return (0.0);
|
||||
}
|
||||
|
||||
if (f1 == 0.0)
|
||||
return (0.0);
|
||||
|
||||
if ((ff2 >= 1.0 && ff1 >= 1.0) || (ff1 <= 1.0 && ff2 <= 1.0))
|
||||
return (f1 / f2);
|
||||
|
||||
if (must_test && !(IgnMask&BIT(EFUNFL))) {
|
||||
if (ff2 > 1.0 && ff1 < 1.0) {
|
||||
if (SMALL / ff2 > ff1) {
|
||||
trap(EFUNFL);
|
||||
return (0.0);
|
||||
}
|
||||
return (f1 / f2);
|
||||
}
|
||||
}
|
||||
|
||||
if (must_test && !(IgnMask&BIT(EFOVFL))) {
|
||||
if (MAXDOUBLE * ff2 < ff1) {
|
||||
trap(EFOVFL);
|
||||
return (0.0);
|
||||
}
|
||||
}
|
||||
return (f1 / f2);
|
||||
}
|
||||
|
||||
PRIVATE fif(f1, f2, n)
|
||||
double f1, f2;
|
||||
size n;
|
||||
{
|
||||
double f = mlf(f1, f2);
|
||||
double fl = floor(fabs(f));
|
||||
|
||||
fpush(fabs(f) - fl, n); /* push fraction */
|
||||
fpush((f < 0.0) ? -fl : fl, n); /* push integer-part */
|
||||
}
|
||||
|
||||
PRIVATE fef(f, n)
|
||||
double f;
|
||||
size n;
|
||||
{
|
||||
register long exponent, sign = (long) (f < 0.0);
|
||||
|
||||
for (f = fabs(f), exponent = 0; f >= 1.0; exponent++)
|
||||
f /= 2.0;
|
||||
|
||||
for (; f < 0.5; exponent--)
|
||||
f *= 2.0;
|
||||
|
||||
fpush((sign) ? -f : f, n); /* push mantissa */
|
||||
npush(exponent, wsize); /* push exponent */
|
||||
}
|
||||
|
||||
/* floating point service routines, to avoid having to use -lm */
|
||||
|
||||
PRIVATE double fabs(f)
|
||||
double f;
|
||||
{
|
||||
return (f < 0.0 ? -f : f);
|
||||
}
|
||||
|
||||
PRIVATE double floor(f)
|
||||
double f;
|
||||
{
|
||||
double res, d;
|
||||
register int sign = 1;
|
||||
|
||||
/* eliminate the sign */
|
||||
if (f < 0) {
|
||||
sign = -1, f = -f;
|
||||
}
|
||||
|
||||
/* get the largest power of 2 <= f */
|
||||
d = 1.0;
|
||||
while (f - d >= d) {
|
||||
d *= 2.0;
|
||||
}
|
||||
|
||||
/* reconstruct f by deminishing powers of 2 */
|
||||
res = 0.0;
|
||||
while (d >= 1.0) {
|
||||
if (res + d <= f)
|
||||
res += d;
|
||||
d /= 2.0;
|
||||
}
|
||||
|
||||
/* undo the sign elimination */
|
||||
if (sign == -1) {
|
||||
res = -res, f = -f;
|
||||
if (res > f)
|
||||
res -= 1.0;
|
||||
}
|
||||
|
||||
return res;
|
||||
}
|
||||
|
||||
PRIVATE double ttttp(f, n) /* times ten to the power */
|
||||
double f;
|
||||
{
|
||||
while (n > 0) {
|
||||
f = mlf(f, 10.0);
|
||||
n--;
|
||||
}
|
||||
while (n < 0) {
|
||||
f = dvf(f, 10.0);
|
||||
n++;
|
||||
}
|
||||
return f;
|
||||
}
|
||||
|
||||
/* Str2double is used to initialize the global data area with floats;
|
||||
we do not use, e.g., sscanf(), to be able to check the grammar of
|
||||
the string and to give warnings.
|
||||
*/
|
||||
|
||||
double str2double(str)
|
||||
char *str;
|
||||
{
|
||||
register char b;
|
||||
register int sign = 1; /* either +1 or -1 */
|
||||
register int frac = 0; /* how far in fraction part ? */
|
||||
register int ex; /* to store exponent */
|
||||
double mantissa = 0.0; /* to store mantissa */
|
||||
double d; /* double to be returned */
|
||||
|
||||
b = *str++;
|
||||
if (b == '-') {
|
||||
sign = -1;
|
||||
b = *str++;
|
||||
}
|
||||
else if (b == '+') {
|
||||
sign = 1;
|
||||
b = *str++;
|
||||
}
|
||||
|
||||
if ('0' <= b && b <= '9') {
|
||||
mantissa = (double) (b-'0');
|
||||
}
|
||||
else if (b == '.') {
|
||||
/* part before dot cannot be empty */
|
||||
warning(WBADFLOAT);
|
||||
frac = 1;
|
||||
}
|
||||
else {
|
||||
goto BadFloat;
|
||||
}
|
||||
|
||||
LOG((" q9 str2double : (before while) mantissa = %20.20g", mantissa));
|
||||
|
||||
while ((b = *str++) != 'e' && b != 'E' && b != '\0') {
|
||||
if (b == '.') {
|
||||
if (frac == 0) {
|
||||
frac++;
|
||||
}
|
||||
else { /* there already was a '.' in input */
|
||||
goto BadFloat;
|
||||
}
|
||||
}
|
||||
else if ('0' <= b && b <= '9') {
|
||||
double bval = b - '0';
|
||||
|
||||
if (frac) {
|
||||
mantissa =
|
||||
adf(mantissa, ttttp(bval, -frac));
|
||||
frac++;
|
||||
}
|
||||
else {
|
||||
mantissa =
|
||||
adf(mlf(mantissa, 10.0), bval);
|
||||
}
|
||||
}
|
||||
else {
|
||||
goto BadFloat;
|
||||
}
|
||||
LOG((" q9 str2double : (inside while) mantissa = %20.20g",
|
||||
mantissa));
|
||||
}
|
||||
LOG((" q9 str2double : mantissa = %10.10g", mantissa));
|
||||
mantissa = sign * mantissa;
|
||||
if (b == '\0')
|
||||
return (mantissa);
|
||||
/* else we have b == 'e' or b== 'E' */
|
||||
|
||||
/* Optional sign for exponent */
|
||||
b = *str++;
|
||||
if (b == '-') {
|
||||
sign = -1;
|
||||
b = *str++;
|
||||
}
|
||||
else if (b == '+') {
|
||||
sign = 1;
|
||||
b = *str++;
|
||||
}
|
||||
else {
|
||||
sign = 1;
|
||||
}
|
||||
|
||||
ex = 0;
|
||||
do {
|
||||
if ('0' <= b && b <= '9') {
|
||||
ex = 10*ex + (b-'0');
|
||||
}
|
||||
else {
|
||||
goto BadFloat;
|
||||
}
|
||||
} while ((b = *str++) != '\0');
|
||||
LOG((" q9 str2double : exponent = %d", ex));
|
||||
|
||||
/* Construct total value of float */
|
||||
ex = sign * ex;
|
||||
d = ttttp(mantissa, ex);
|
||||
return (d);
|
||||
|
||||
BadFloat:
|
||||
fatal("Float garbled in loadfile");
|
||||
return (0.0);
|
||||
}
|
||||
|
||||
#else NOFLOAT
|
||||
|
||||
nofloat() {
|
||||
fatal("attempt to execute a floating point instruction on an EM machine without FP");
|
||||
}
|
||||
|
||||
#endif NOFLOAT
|
||||
|
||||
455
util/int/do_incdec.c
Normal file
455
util/int/do_incdec.c
Normal file
|
|
@ -0,0 +1,455 @@
|
|||
/*
|
||||
* Sources of the "INCREMENT/DECREMENT/ZERO" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "nofloat.h"
|
||||
#include "trap.h"
|
||||
#include "mem.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
#include "warn.h"
|
||||
|
||||
PRIVATE long inc(), dec();
|
||||
|
||||
DoINCz()
|
||||
{
|
||||
/* INC -: Increment word on top of stack by 1 (*) */
|
||||
LOG(("@Z6 DoINCz()"));
|
||||
spoilFRA();
|
||||
npush(inc(spop(wsize)), wsize);
|
||||
}
|
||||
|
||||
DoINLm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* INL l: Increment local or parameter (*) */
|
||||
register long l = arg_l(arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@Z6 DoINLm(%ld)", l));
|
||||
spoilFRA();
|
||||
p = loc_addr(l);
|
||||
st_stn(p, inc(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoINLn2(arg)
|
||||
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_stn(p, inc(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, inc(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, inc(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, inc(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, inc(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoINEl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* INE g: Increment external (*) */
|
||||
register ptr p = i2p(L_arg_2() * arg);
|
||||
|
||||
LOG(("@Z6 DoINEl2(%lu)", p));
|
||||
spoilFRA();
|
||||
p = arg_g(p);
|
||||
dt_stn(p, inc(dt_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoINEl4(arg)
|
||||
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_stn(p, inc(dt_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, inc(dt_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoDECz()
|
||||
{
|
||||
/* DEC -: Decrement word on top of stack by 1 (*) */
|
||||
LOG(("@Z6 DoDECz()"));
|
||||
spoilFRA();
|
||||
npush(dec(spop(wsize)), wsize);
|
||||
}
|
||||
|
||||
DoDELn2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* DEL l: Decrement local or parameter (*) */
|
||||
register long l = (N_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@Z6 DoDELn2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_l(l);
|
||||
p = loc_addr(l);
|
||||
st_stn(p, dec(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoDELn4(arg)
|
||||
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_stn(p, dec(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, dec(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, dec(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, dec(st_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoDEEl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* DEE g: Decrement external (*) */
|
||||
register ptr p = i2p(L_arg_2() * arg);
|
||||
|
||||
LOG(("@Z6 DoDEEl2(%lu)", p));
|
||||
spoilFRA();
|
||||
p = arg_g(p);
|
||||
dt_stn(p, dec(dt_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoDEEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* DEE g: Decrement external (*) */
|
||||
register ptr p = i2p(L_arg_4() * arg);
|
||||
|
||||
LOG(("@Z6 DoDEEl4(%lu)", p));
|
||||
spoilFRA();
|
||||
p = arg_g(p);
|
||||
dt_stn(p, dec(dt_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
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_stn(p, dec(dt_lds(p, wsize)), wsize);
|
||||
}
|
||||
|
||||
DoZRLm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* ZRL l: Zero local or parameter */
|
||||
register long l = arg_l(arg);
|
||||
|
||||
LOG(("@Z6 DoZRLm(%ld)", l));
|
||||
spoilFRA();
|
||||
st_stn(loc_addr(l), 0L, wsize);
|
||||
}
|
||||
|
||||
DoZRLn2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* ZRL l: Zero local or parameter */
|
||||
register long l = (N_arg_2() * arg);
|
||||
|
||||
LOG(("@Z6 DoZRLn2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_l(arg);
|
||||
st_stn(loc_addr(l), 0L, wsize);
|
||||
}
|
||||
|
||||
DoZRLn4(arg)
|
||||
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_stn(loc_addr(l), 0L, wsize);
|
||||
}
|
||||
|
||||
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_stn(loc_addr(l), 0L, wsize);
|
||||
}
|
||||
|
||||
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_stn(loc_addr(l), 0L, wsize);
|
||||
}
|
||||
|
||||
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_stn(loc_addr(l), 0L, wsize);
|
||||
}
|
||||
|
||||
DoZREl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* ZRE g: Zero external */
|
||||
register ptr p = i2p(L_arg_2() * arg);
|
||||
|
||||
LOG(("@Z6 DoZREl2(%lu)", p));
|
||||
spoilFRA();
|
||||
dt_stn(arg_g(p), 0L, wsize);
|
||||
}
|
||||
|
||||
DoZREl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* ZRE g: Zero external */
|
||||
register ptr p = i2p(L_arg_4() * arg);
|
||||
|
||||
LOG(("@Z6 DoZREl4(%lu)", p));
|
||||
spoilFRA();
|
||||
dt_stn(arg_g(p), 0L, wsize);
|
||||
}
|
||||
|
||||
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_stn(arg_g(p), 0L, wsize);
|
||||
}
|
||||
|
||||
DoZRFl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* ZRF w: Load a floating zero of size w */
|
||||
#ifndef NOFLOAT
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@Z6 DoZRFl2(%ld)", l));
|
||||
spoilFRA();
|
||||
fpush(0.0, arg_wf(l));
|
||||
#else NOFLOAT
|
||||
arg = arg;
|
||||
nofloat();
|
||||
#endif NOFLOAT
|
||||
}
|
||||
|
||||
DoZRFz()
|
||||
{
|
||||
/* ZRF w: Load a floating zero of size w */
|
||||
#ifndef NOFLOAT
|
||||
register size l = upop(wsize);
|
||||
|
||||
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 */
|
||||
register size i, l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@Z6 DoZERl2(%ld)", l));
|
||||
spoilFRA();
|
||||
for (i = arg_w(l); i; i -= wsize)
|
||||
npush(0L, wsize);
|
||||
}
|
||||
|
||||
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)
|
||||
npush(0L, wsize);
|
||||
}
|
||||
|
||||
DoZERz()
|
||||
{
|
||||
/* ZER w: Load w zero bytes */
|
||||
register size i, l = spop(wsize);
|
||||
|
||||
LOG(("@Z6 DoZERz(%ld)", l));
|
||||
spoilFRA();
|
||||
for (i = arg_w(l); i; i -= wsize)
|
||||
npush(0L, wsize);
|
||||
}
|
||||
|
||||
PRIVATE long inc(l)
|
||||
long l;
|
||||
{
|
||||
if (must_test && !(IgnMask&BIT(EIOVFL))) {
|
||||
if (l == i_maxsw)
|
||||
trap(EIOVFL);
|
||||
}
|
||||
return (l + 1);
|
||||
}
|
||||
|
||||
PRIVATE long dec(l)
|
||||
long l;
|
||||
{
|
||||
if (must_test && !(IgnMask&BIT(EIOVFL))) {
|
||||
if (l == i_minsw)
|
||||
trap(EIOVFL);
|
||||
}
|
||||
return (l - 1);
|
||||
}
|
||||
|
||||
434
util/int/do_intar.c
Normal file
434
util/int/do_intar.c
Normal file
|
|
@ -0,0 +1,434 @@
|
|||
/*
|
||||
* Sources of the "INTEGER ARITHMETIC" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
|
||||
PRIVATE long adi(), sbi(), dvi(), mli(), rmi(), ngi(), sli(), sri();
|
||||
|
||||
DoADIl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* ADI w: Addition (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(arg_wi(l));
|
||||
|
||||
LOG(("@I6 DoADIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(adi(spop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoADIm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
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 (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(arg_wi(l));
|
||||
|
||||
LOG(("@I6 DoSBIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(sbi(spop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoSBIm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
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 (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(arg_wi(l));
|
||||
|
||||
LOG(("@I6 DoMLIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(mli(spop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoMLIm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
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 (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(arg_wi(l));
|
||||
|
||||
LOG(("@I6 DoDVIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(dvi(spop(l), t), l);
|
||||
}
|
||||
|
||||
DoDVIm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
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 (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(arg_wi(l));
|
||||
|
||||
LOG(("@I6 DoRMIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(rmi(spop(l), t), l);
|
||||
}
|
||||
|
||||
DoRMIm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
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) (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@I6 DoNGIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush(ngi(spop(l), l), l);
|
||||
}
|
||||
|
||||
DoNGIz()
|
||||
{
|
||||
/* NGI w: Negate (two's complement) (*) */
|
||||
register size l = upop(wsize);
|
||||
|
||||
LOG(("@I6 DoNGIz(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush(ngi(spop(l), l), l);
|
||||
}
|
||||
|
||||
DoSLIl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* SLI w: Shift left (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(wsize);
|
||||
|
||||
LOG(("@I6 DoSLIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush(sli(spop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoSLIm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* SLI w: Shift left (*) */
|
||||
register size l = arg_wi(arg);
|
||||
register long t = spop(wsize);
|
||||
|
||||
LOG(("@I6 DoSLIm(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(sli(spop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoSLIz()
|
||||
{
|
||||
/* SLI w: Shift left (*) */
|
||||
register size l = upop(wsize);
|
||||
register long t = spop(wsize);
|
||||
|
||||
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 (*) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(wsize);
|
||||
|
||||
LOG(("@I6 DoSRIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush(sri(spop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoSRIz()
|
||||
{
|
||||
/* SRI w: Shift right (*) */
|
||||
register size l = upop(wsize);
|
||||
register long t = spop(wsize);
|
||||
|
||||
LOG(("@I6 DoSRIz(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush(sri(spop(l), t, l), l);
|
||||
}
|
||||
|
||||
#define i_maxs(n) ((n == 2) ? I_MAXS2 : I_MAXS4)
|
||||
#define i_mins(n) ((n == 2) ? I_MINS2 : I_MINS4)
|
||||
|
||||
PRIVATE long adi(w1, w2, nbytes) /* returns w1 + w2 */
|
||||
long w1, w2;
|
||||
size nbytes;
|
||||
{
|
||||
if (must_test && !(IgnMask&BIT(EIOVFL))) {
|
||||
if (w1 > 0 && w2 > 0) {
|
||||
if (i_maxs(nbytes) - w1 < w2)
|
||||
trap(EIOVFL);
|
||||
}
|
||||
else if (w1 < 0 && w2 < 0) {
|
||||
if (i_mins(nbytes) - w1 > w2)
|
||||
trap(EIOVFL);
|
||||
}
|
||||
}
|
||||
return (w1 + w2);
|
||||
}
|
||||
|
||||
PRIVATE long sbi(w1, w2, nbytes) /* returns w1 - w2 */
|
||||
long w1, w2;
|
||||
size nbytes;
|
||||
{
|
||||
if (must_test && !(IgnMask&BIT(EIOVFL))) {
|
||||
if (w2 < 0 && w1 > 0) {
|
||||
if (i_maxs(nbytes) + w2 < w1)
|
||||
trap(EIOVFL);
|
||||
}
|
||||
else if (w2 > 0 && w1 < 0) {
|
||||
if (i_mins(nbytes) + w2 > w1) {
|
||||
trap(EIOVFL);
|
||||
}
|
||||
}
|
||||
}
|
||||
return (w1 - w2);
|
||||
}
|
||||
|
||||
#define labs(w) ((w < 0) ? (-w) : w)
|
||||
|
||||
PRIVATE long mli(w1, w2, nbytes) /* returns w1 * w2 */
|
||||
long w1, w2;
|
||||
size nbytes;
|
||||
{
|
||||
if (w1 == 0 || w2 == 0)
|
||||
return (0L);
|
||||
|
||||
if (must_test && !(IgnMask&BIT(EIOVFL))) {
|
||||
if ((w1 > 0 && w2 > 0) || (w2 < 0 && w1 < 0)) {
|
||||
if ( w1 == i_mins(nbytes) || w2 == i_mins(nbytes)
|
||||
|| (i_maxs(nbytes) / labs(w1)) < labs(w2)
|
||||
) {
|
||||
trap(EIOVFL);
|
||||
}
|
||||
}
|
||||
else if (w1 > 0) {
|
||||
if (i_mins(nbytes) / w1 > w2)
|
||||
trap(EIOVFL);
|
||||
}
|
||||
else if (i_mins(nbytes) / w2 > w1) {
|
||||
trap(EIOVFL);
|
||||
}
|
||||
}
|
||||
return (w1 * w2);
|
||||
}
|
||||
|
||||
PRIVATE long dvi(w1, w2)
|
||||
long w1, w2;
|
||||
{
|
||||
if (w2 == 0) {
|
||||
if (!(IgnMask&BIT(EIDIVZ))) {
|
||||
trap(EIDIVZ);
|
||||
}
|
||||
else return (0L);
|
||||
}
|
||||
return (w1 / w2);
|
||||
}
|
||||
|
||||
PRIVATE long rmi(w1, w2)
|
||||
long w1, w2;
|
||||
{
|
||||
if (w2 == 0) {
|
||||
if (!(IgnMask&BIT(EIDIVZ))) {
|
||||
trap(EIDIVZ);
|
||||
}
|
||||
else return (0L);
|
||||
}
|
||||
return (w1 % w2);
|
||||
}
|
||||
|
||||
PRIVATE long ngi(w1, nbytes)
|
||||
long w1;
|
||||
size nbytes;
|
||||
{
|
||||
if (must_test && !(IgnMask&BIT(EIOVFL))) {
|
||||
if (w1 == i_mins(nbytes)) {
|
||||
trap(EIOVFL);
|
||||
}
|
||||
}
|
||||
return (-w1);
|
||||
}
|
||||
|
||||
PRIVATE long sli(w1, w2, nbytes) /* w1 << w2 */
|
||||
long w1, w2;
|
||||
size nbytes;
|
||||
{
|
||||
if (must_test) {
|
||||
#ifdef LOGGING
|
||||
/* check shift distance */
|
||||
if (w2 < 0) {
|
||||
warning(WSHNEG);
|
||||
w2 = 0;
|
||||
}
|
||||
if (w2 >= nbytes*8) {
|
||||
warning(WSHLARGE);
|
||||
w2 = nbytes*8 - 1;
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
if (!(IgnMask&BIT(EIOVFL))) {
|
||||
/* check overflow */
|
||||
if ( (w1 >= 0 && (w1 >> (nbytes*8 - w2)) != 0)
|
||||
|| (w1 < 0 && (w1 >> (nbytes*8 - w2)) != -1)
|
||||
) {
|
||||
trap(EIOVFL);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* calculate result */
|
||||
return (w1 << w2);
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
PRIVATE long sri(w1, w2, nbytes) /* w1 >> w2 */
|
||||
long w1, w2;
|
||||
size nbytes;
|
||||
{
|
||||
#ifdef LOGGING
|
||||
if (must_test) {
|
||||
/* check shift distance */
|
||||
if (w2 < 0) {
|
||||
warning(WSHNEG);
|
||||
w2 = 0;
|
||||
}
|
||||
if (w2 >= nbytes*8) {
|
||||
warning(WSHLARGE);
|
||||
w2 = nbytes*8 - 1;
|
||||
}
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
/* calculate result */
|
||||
return (w1 >> w2);
|
||||
}
|
||||
|
||||
727
util/int/do_load.c
Normal file
727
util/int/do_load.c
Normal file
|
|
@ -0,0 +1,727 @@
|
|||
/*
|
||||
* Sources of the "LOAD" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
#include "rsb.h"
|
||||
#include "warn.h"
|
||||
|
||||
PRIVATE ptr lexback_LB();
|
||||
|
||||
DoLOCl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LOC c: Load constant (i.e. push one word onto the stack) */
|
||||
register long l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@L6 DoLOCl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(arg_c(l), wsize);
|
||||
}
|
||||
|
||||
DoLOCl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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();
|
||||
npush(arg_c(l), wsize);
|
||||
}
|
||||
|
||||
DoLOCm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LOC c: Load constant (i.e. push one word onto the stack) */
|
||||
register long l = arg_c(arg);
|
||||
|
||||
LOG(("@L6 DoLOCm(%ld)", l));
|
||||
spoilFRA();
|
||||
npush(l, wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
npush(arg_c(l), wsize);
|
||||
}
|
||||
|
||||
DoLDCl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LDC d: Load double constant ( push two words ) */
|
||||
register long l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@L6 DoLDCl2(%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();
|
||||
npush(l, dwsize);
|
||||
}
|
||||
|
||||
DoLOLm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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));
|
||||
spoilFRA();
|
||||
push_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
l = arg_l(l);
|
||||
push_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
DoLOLn4(arg)
|
||||
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);
|
||||
push_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
push_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
push_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
push_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
DoLOEl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LOE g: Load external word g */
|
||||
register ptr p = i2p(L_arg_2() * arg);
|
||||
|
||||
LOG(("@L6 DoLOEl2(%lu)", p));
|
||||
spoilFRA();
|
||||
push_m(arg_g(p), wsize);
|
||||
}
|
||||
|
||||
DoLOEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LOE g: Load external word g */
|
||||
register ptr p = i2p(L_arg_4() * arg);
|
||||
|
||||
LOG(("@L6 DoLOEl4(%lu)", p));
|
||||
spoilFRA();
|
||||
push_m(arg_g(p), wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
push_m(arg_g(p), wsize);
|
||||
}
|
||||
|
||||
DoLILm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LIL l: Load word pointed to by l-th local or parameter */
|
||||
register long l = arg_l(arg);
|
||||
|
||||
LOG(("@L6 DoLILm(%ld)", l));
|
||||
spoilFRA();
|
||||
push_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
l = arg_l(l);
|
||||
push_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
DoLILn4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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);
|
||||
push_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
push_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
push_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
push_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
DoLOFl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LOF f: Load offsetted (top of stack + f yield address) */
|
||||
register long l = (L_arg_2() * arg);
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@L6 DoLOFl2(%ld)", l));
|
||||
spoilFRA();
|
||||
push_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
DoLOFl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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();
|
||||
push_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
push_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
push_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
DoLALm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LAL l: Load address of local or parameter */
|
||||
register long l = arg_l(arg);
|
||||
|
||||
LOG(("@L6 DoLALm(%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();
|
||||
l = arg_l(l);
|
||||
dppush(loc_addr(l));
|
||||
}
|
||||
|
||||
DoLALn4(arg)
|
||||
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 */
|
||||
register ptr p = i2p(U_arg() * arg);
|
||||
|
||||
LOG(("@L6 DoLAEu(%lu)", p));
|
||||
spoilFRA();
|
||||
dppush(arg_lae(p));
|
||||
}
|
||||
|
||||
DoLAEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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) */
|
||||
register unsigned long l = (L_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@L6 DoLXLl2(%lu)", l));
|
||||
spoilFRA();
|
||||
l = arg_n(l);
|
||||
p = lexback_LB(l);
|
||||
dppush(p);
|
||||
}
|
||||
|
||||
DoLXLm(arg)
|
||||
unsigned long arg;
|
||||
{
|
||||
/* 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) */
|
||||
register unsigned long l = (P_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@L6 DoLXAl2(%lu)", l));
|
||||
spoilFRA();
|
||||
l = arg_n(l);
|
||||
p = lexback_LB(l);
|
||||
dppush(p + rsbsize);
|
||||
}
|
||||
|
||||
DoLXAm(arg)
|
||||
unsigned long arg;
|
||||
{
|
||||
/* 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) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@L6 DoLOIl2(%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();
|
||||
push_m(p, l);
|
||||
}
|
||||
|
||||
DoLOIs(hob, wfac)
|
||||
long hob;
|
||||
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 */
|
||||
register size l = (P_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@L6 DoLOSl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
l = upop(l);
|
||||
p = dppop();
|
||||
push_m(p, arg_o(l));
|
||||
}
|
||||
|
||||
DoLOSz()
|
||||
{
|
||||
/* LOS w: Load indirect, w-byte integer on top of stack gives object size */
|
||||
register size l = upop(wsize);
|
||||
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) */
|
||||
register long l = arg_l(arg);
|
||||
|
||||
LOG(("@L6 DoLDLm(%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();
|
||||
l = arg_l(l);
|
||||
push_st(loc_addr(l), dwsize);
|
||||
}
|
||||
|
||||
DoLDLn4(arg)
|
||||
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) */
|
||||
register ptr p = i2p(L_arg_2() * arg);
|
||||
|
||||
LOG(("@L6 DoLDEl2(%lu)", p));
|
||||
spoilFRA();
|
||||
push_m(arg_g(p), dwsize);
|
||||
}
|
||||
|
||||
DoLDEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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) */
|
||||
register long l = (L_arg_2() * arg);
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@L6 DoLDFl2(%ld)", l));
|
||||
spoilFRA();
|
||||
push_m(p + arg_f(l), dwsize);
|
||||
}
|
||||
|
||||
DoLDFl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long pi = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@L6 DoLPIl2(%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();
|
||||
npush(arg_p(pi), psize);
|
||||
}
|
||||
|
||||
PRIVATE ptr lexback_LB(n)
|
||||
unsigned long n;
|
||||
{
|
||||
/* LB n static levels back */
|
||||
register ptr lb = LB;
|
||||
|
||||
while (n != 0) {
|
||||
lb = st_lddp(lb + rsbsize);
|
||||
n--;
|
||||
}
|
||||
return lb;
|
||||
}
|
||||
|
||||
347
util/int/do_logic.c
Normal file
347
util/int/do_logic.c
Normal file
|
|
@ -0,0 +1,347 @@
|
|||
/*
|
||||
* Sources of the "LOGICAL" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "warn.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
|
||||
#ifdef LOGGING
|
||||
extern int must_test;
|
||||
#endif LOGGING
|
||||
|
||||
#ifdef LOGGING
|
||||
#define check_def(p,l) if (!st_sh(p) || !st_sh(p+l)) {warning(WUNLOG);}
|
||||
#else
|
||||
#define check_def(p,l)
|
||||
#endif LOGGING
|
||||
|
||||
DoANDl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 */
|
||||
/* size of objects to be compared (in bytes) on top of stack */
|
||||
register size l = upop(wsize);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@X6 DoANDz(%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);
|
||||
}
|
||||
|
||||
DoIORl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* IOR w: Boolean inclusive or on two groups of w bytes */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@X6 DoIORl2(%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);
|
||||
}
|
||||
|
||||
DoIORm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@X6 DoXORl2(%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);
|
||||
}
|
||||
|
||||
DoXORz()
|
||||
{
|
||||
/* XOR w: Boolean exclusive or on two groups of w bytes */
|
||||
register size l = upop(wsize);
|
||||
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) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@X6 DoCOMl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_w(l);
|
||||
for (p = SP; p < (SP + l); p++) {
|
||||
check_def(p, 0);
|
||||
stack_loc(p) = ~stack_loc(p);
|
||||
}
|
||||
}
|
||||
|
||||
DoCOMz()
|
||||
{
|
||||
/* COM w: Complement (one's complement of top w bytes) */
|
||||
register size l = upop(wsize);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@X6 DoCOMz(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_w(l);
|
||||
for (p = SP; p < (SP + l); p++) {
|
||||
check_def(p, l);
|
||||
stack_loc(p) = ~stack_loc(p);
|
||||
}
|
||||
}
|
||||
|
||||
DoROLl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* ROL w: Rotate left a group of w bytes */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long s, t = upop(wsize);
|
||||
register long signbit;
|
||||
|
||||
LOG(("@X6 DoROLl2(%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);
|
||||
}
|
||||
|
||||
DoROLz()
|
||||
{
|
||||
/* ROL w: Rotate left a group of w bytes */
|
||||
register size l = upop(wsize);
|
||||
register long s, t = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long s, t = upop(wsize);
|
||||
register long signbit;
|
||||
|
||||
LOG(("@X6 DoRORl2(%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 = upop(wsize);
|
||||
register long s, t = upop(wsize);
|
||||
register long signbit;
|
||||
|
||||
LOG(("@X6 DoRORz(%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--) {
|
||||
/* 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);
|
||||
}
|
||||
763
util/int/do_misc.c
Normal file
763
util/int/do_misc.c
Normal file
|
|
@ -0,0 +1,763 @@
|
|||
/*
|
||||
* Sources of the "MISCELLANEOUS" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "mem.h"
|
||||
#include "memdirect.h"
|
||||
#include "shadow.h"
|
||||
#include "text.h"
|
||||
#include "read.h"
|
||||
#include "fra.h"
|
||||
#include "rsb.h"
|
||||
#include "linfil.h"
|
||||
|
||||
extern int running; /* from main.c */
|
||||
|
||||
/* Two useful but unofficial registers */
|
||||
long LIN;
|
||||
ptr FIL;
|
||||
|
||||
PRIVATE index_jump(), range_check(), search_jump();
|
||||
PRIVATE gto();
|
||||
|
||||
#define asp(l) newSP(SP + arg_f(l))
|
||||
|
||||
DoASPl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* ASP f: Adjust the stack pointer by f */
|
||||
register long l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@M6 DoASPl2(%ld)", l));
|
||||
asp(l);
|
||||
}
|
||||
|
||||
DoASPl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@M6 DoASSl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = spop(arg_wi(l));
|
||||
asp(l);
|
||||
}
|
||||
|
||||
DoASSz()
|
||||
{
|
||||
/* ASS w: Adjust the stack pointer by w-byte integer */
|
||||
register size l = upop(wsize);
|
||||
|
||||
LOG(("@M6 DoASSz(%ld)", l));
|
||||
spoilFRA();
|
||||
l = spop(arg_wi(l));
|
||||
asp(l);
|
||||
}
|
||||
|
||||
#define block_move(a1,a2,n) \
|
||||
if (in_stack(a1)) { \
|
||||
if (in_stack(a2)) st_mvs(a1, a2, n); \
|
||||
else st_mvd(a1, a2, n); } \
|
||||
else { if (in_stack(a2)) dt_mvs(a1, a2, n); \
|
||||
else dt_mvd(a1, a2, n); }
|
||||
|
||||
DoBLMl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 */
|
||||
|
||||
LOG(("@M6 DoBLMl2(%ld)", l));
|
||||
spoilFRA();
|
||||
dp1 = dppop();
|
||||
dp2 = dppop();
|
||||
block_move(dp1, dp2, arg_z(l));
|
||||
}
|
||||
|
||||
DoBLMl4(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr dp1, dp2;
|
||||
|
||||
LOG(("@M6 DoBLSl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = upop(arg_wi(l));
|
||||
dp1 = dppop();
|
||||
dp2 = dppop();
|
||||
block_move(dp1, dp2, arg_z(l));
|
||||
}
|
||||
|
||||
DoBLSz()
|
||||
{
|
||||
/* BLS w: Block move, size is in w-byte integer on top of stack */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@M6 DoCSAl2(%ld)", l));
|
||||
spoilFRA();
|
||||
index_jump(arg_wi(l));
|
||||
}
|
||||
|
||||
DoCSAm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@M6 DoCSBl2(%ld)", l));
|
||||
spoilFRA();
|
||||
search_jump(arg_wi(l));
|
||||
}
|
||||
|
||||
DoCSBm(arg)
|
||||
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 = upop(wsize);
|
||||
|
||||
LOG(("@M6 DoCSBz(%ld)", l));
|
||||
spoilFRA();
|
||||
search_jump(arg_wi(l));
|
||||
}
|
||||
|
||||
DoDCHz()
|
||||
{
|
||||
/* DCH -: Follow dynamic chain, convert LB to LB of caller */
|
||||
register ptr lb;
|
||||
|
||||
LOG(("@M6 DoDCHz()"));
|
||||
spoilFRA();
|
||||
lb = dppop();
|
||||
if (!is_LB(lb)) {
|
||||
wtrap(WDCHBADLB, ESTACK);
|
||||
}
|
||||
dppush(st_lddp(lb + rsb_LB));
|
||||
}
|
||||
|
||||
DoDUPl2(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;
|
||||
{
|
||||
/* DUP s: Duplicate top s bytes */
|
||||
register ptr oldSP = SP;
|
||||
|
||||
LOG(("@M6 DoDUPm(%ld)", arg));
|
||||
spoilFRA();
|
||||
st_inc(arg_s(arg));
|
||||
st_mvs(SP, oldSP, arg);
|
||||
}
|
||||
|
||||
DoDUSl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* DUS w: Duplicate top w bytes */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr oldSP;
|
||||
|
||||
LOG(("@M6 DoDUSl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = upop(arg_wi(l));
|
||||
oldSP = SP;
|
||||
st_inc(arg_s(l));
|
||||
st_mvs(SP, oldSP, l);
|
||||
}
|
||||
|
||||
DoDUSz()
|
||||
{
|
||||
/* DUS w: Duplicate top w bytes */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr oldSP = SP;
|
||||
|
||||
LOG(("@M6 DoEXGl2(%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);
|
||||
}
|
||||
|
||||
DoEXGs(hob, wfac)
|
||||
long hob;
|
||||
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 = upop(wsize);
|
||||
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) */
|
||||
register ptr p = i2p(U_arg() * arg);
|
||||
|
||||
LOG(("@M6 DoFILu(%lu)", p));
|
||||
spoilFRA();
|
||||
if (p > HB) {
|
||||
wtrap(WILLFIL, EILLINS);
|
||||
}
|
||||
putFIL(arg_g(p));
|
||||
}
|
||||
|
||||
DoFILl4(arg)
|
||||
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 */
|
||||
register ptr p = i2p(U_arg() * arg);
|
||||
|
||||
LOG(("@M6 DoGTOu(%lu)", p));
|
||||
gto(arg_gto(p));
|
||||
}
|
||||
|
||||
DoGTOl4(arg)
|
||||
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 */
|
||||
LOG(("@M6 DoLIMz()"));
|
||||
spoilFRA();
|
||||
npush(IgnMask, wsize);
|
||||
}
|
||||
|
||||
DoLINl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* LIN n: Line number (external 0 := n) */
|
||||
register unsigned long l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@M6 DoLINl2(%lu)", l));
|
||||
spoilFRA();
|
||||
putLIN((long) arg_lin(l));
|
||||
}
|
||||
|
||||
DoLINl4(arg)
|
||||
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 */
|
||||
LOG(("@M6 DoLNIz()"));
|
||||
spoilFRA();
|
||||
putLIN((long)getLIN() + 1);
|
||||
}
|
||||
|
||||
DoLORs(hob, wfac)
|
||||
long hob;
|
||||
size wfac;
|
||||
{
|
||||
/* LOR r: Load register (0=LB, 1=SP, 2=HP) */
|
||||
register long l = (S_arg(hob) * wfac);
|
||||
|
||||
LOG(("@M6 DoLORs(%ld)", l));
|
||||
spoilFRA();
|
||||
switch ((int) arg_r(l)) {
|
||||
case 0:
|
||||
dppush(LB);
|
||||
break;
|
||||
case 1:
|
||||
dppush(SP);
|
||||
break;
|
||||
case 2:
|
||||
dppush(HP);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
DoLPBz()
|
||||
{
|
||||
/* LPB -: Convert local base to argument base */
|
||||
register ptr lb;
|
||||
|
||||
LOG(("@M6 DoLPBz()"));
|
||||
spoilFRA();
|
||||
lb = dppop();
|
||||
if (!is_LB(lb)) {
|
||||
wtrap(WLPBBADLB, ESTACK);
|
||||
}
|
||||
dppush(lb + rsbsize);
|
||||
}
|
||||
|
||||
DoMONz()
|
||||
{
|
||||
/* MON -: Monitor call */
|
||||
LOG(("@M6 DoMONz()"));
|
||||
spoilFRA();
|
||||
moncall();
|
||||
}
|
||||
|
||||
DoNOPz()
|
||||
{
|
||||
/* NOP -: No operation */
|
||||
LOG(("@M6 DoNOPz()"));
|
||||
spoilFRA();
|
||||
message("NOP instruction");
|
||||
}
|
||||
|
||||
DoRCKl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* RCK w: Range check; trap on error */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@M6 DoRCKl2(%ld)", l));
|
||||
spoilFRA();
|
||||
range_check(arg_wi(l));
|
||||
}
|
||||
|
||||
DoRCKm(arg)
|
||||
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 = upop(wsize);
|
||||
|
||||
LOG(("@M6 DoRCKz(%ld)", l));
|
||||
spoilFRA();
|
||||
range_check(arg_wi(l));
|
||||
}
|
||||
|
||||
DoRTTz()
|
||||
{
|
||||
/* RTT -: Return from trap */
|
||||
LOG(("@M6 DoRTTz()"));
|
||||
|
||||
switch (poprsb(1)) {
|
||||
case RSB_STP:
|
||||
warning(WRTTEMPTY);
|
||||
running = 0; /* stop the machine */
|
||||
return;
|
||||
case RSB_CAL:
|
||||
warning(WRTTCALL);
|
||||
return;
|
||||
case RSB_RTT:
|
||||
/* OK */
|
||||
break;
|
||||
case RSB_NRT:
|
||||
warning(WRTTNRTT);
|
||||
running = 0; /* stop the machine */
|
||||
return;
|
||||
default:
|
||||
warning(WRTTBAD);
|
||||
return;
|
||||
}
|
||||
|
||||
/* pop the trap number */
|
||||
upop(wsize);
|
||||
|
||||
/* restore the Function Return Area */
|
||||
FRA_def = upop(wsize);
|
||||
FRASize = upop(wsize);
|
||||
popFRA(FRASize);
|
||||
}
|
||||
|
||||
DoSIGz()
|
||||
{
|
||||
/* SIG -: Trap errors to proc identifier on top of stack, \-2 resets default */
|
||||
register long tpi = spop(psize);
|
||||
|
||||
LOG(("@M6 DoSIGz()"));
|
||||
spoilFRA();
|
||||
npush(TrapPI, psize);
|
||||
if (tpi == -2) {
|
||||
OnTrap = TR_HALT;
|
||||
TrapPI = 0;
|
||||
}
|
||||
else {
|
||||
tpi = arg_p(tpi); /* do not test earlier! */
|
||||
OnTrap = TR_TRAP;
|
||||
TrapPI = tpi;
|
||||
}
|
||||
}
|
||||
|
||||
DoSIMz()
|
||||
{
|
||||
/* SIM -: Store 16 bit ignore mask */
|
||||
LOG(("@M6 DoSIMz()"));
|
||||
spoilFRA();
|
||||
IgnMask = (upop(wsize) | PreIgnMask) & MASK2;
|
||||
}
|
||||
|
||||
DoSTRs(hob, wfac)
|
||||
long hob;
|
||||
size wfac;
|
||||
{
|
||||
/* STR r: Store register (0=LB, 1=SP, 2=HP) */
|
||||
register long l = (S_arg(hob) * wfac);
|
||||
|
||||
LOG(("@M6 DoSTRs(%ld)", l));
|
||||
spoilFRA();
|
||||
switch ((int) arg_r(l)) {
|
||||
case 0:
|
||||
newLB(dppop());
|
||||
pop_frames();
|
||||
break;
|
||||
case 1:
|
||||
newSP(dppop());
|
||||
break;
|
||||
case 2:
|
||||
newHP(dppop());
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
DoTRPz()
|
||||
{
|
||||
/* TRP -: Cause trap to occur (Error number on stack) */
|
||||
register unsigned int tr = (unsigned int)upop(wsize);
|
||||
|
||||
LOG(("@M6 DoTRPz()"));
|
||||
spoilFRA();
|
||||
if (tr > 15 || !(IgnMask&BIT(tr))) {
|
||||
wtrap(WTRP, (int)tr);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Service routines */
|
||||
|
||||
PRIVATE gto(p)
|
||||
ptr p;
|
||||
{
|
||||
register ptr old_LB = LB;
|
||||
register ptr new_PC = dt_ldip(p);
|
||||
register ptr new_SP = dt_lddp(p + psize);
|
||||
register ptr new_LB = dt_lddp(p + (2 * psize));
|
||||
|
||||
while (old_LB < new_LB) {
|
||||
PI = st_lds(old_LB + rsb_PI, psize);
|
||||
old_LB = st_lddp(old_LB + rsb_LB);
|
||||
}
|
||||
if (old_LB != new_LB) {
|
||||
wtrap(WGTORSB, EBADGTO);
|
||||
}
|
||||
|
||||
newLB(new_LB);
|
||||
pop_frames();
|
||||
newSP(new_SP);
|
||||
newPC(new_PC);
|
||||
}
|
||||
|
||||
/*
|
||||
The LIN and FIL routines.
|
||||
The values of LIN and FIL are kept in EM machine registers
|
||||
(variables LIN and FIL) and in the data space.
|
||||
*/
|
||||
|
||||
putLIN(lin)
|
||||
long lin;
|
||||
{
|
||||
dt_unprot(i2p(LINO_AD), (long)LINSIZE);
|
||||
dt_stn(i2p(LINO_AD), lin, (long)LINSIZE);
|
||||
LIN = lin;
|
||||
dt_prot(i2p(LINO_AD), (long)LINSIZE);
|
||||
}
|
||||
|
||||
putFIL(fil)
|
||||
ptr fil;
|
||||
{
|
||||
dt_unprot(i2p(FILN_AD), psize);
|
||||
dt_stdp(i2p(FILN_AD), fil);
|
||||
FIL = fil;
|
||||
dt_prot(i2p(FILN_AD), psize);
|
||||
}
|
||||
|
||||
/********************************************************
|
||||
* Case jump by indexing *
|
||||
* *
|
||||
* 1. pop case descriptor pointer. *
|
||||
* 2. pop table index. *
|
||||
* 3. Calculate (table index) - (lower bound). *
|
||||
* 4. Check if in range. *
|
||||
* 5. If in range: load Program Counter value. *
|
||||
* 6. Else: load default value. *
|
||||
********************************************************/
|
||||
|
||||
PRIVATE index_jump(nbytes)
|
||||
size nbytes;
|
||||
{
|
||||
register ptr cdp = dppop(); /* Case Descriptor Pointer */
|
||||
register long t_index = /* Table INDEX */
|
||||
spop(nbytes) - mem_lds(cdp + psize, wsize);
|
||||
register ptr nPC; /* New Program Counter */
|
||||
|
||||
if (t_index >= 0 && t_index <= mem_lds(cdp + wsize + psize, wsize)) {
|
||||
nPC = mem_ldip(cdp + (2 * wsize) + ((t_index + 1) * psize));
|
||||
}
|
||||
else if ((nPC = mem_ldip(cdp)) == 0) {
|
||||
trap(ECASE);
|
||||
}
|
||||
newPC(nPC);
|
||||
}
|
||||
|
||||
/********************************************************
|
||||
* Case jump by table search *
|
||||
* *
|
||||
* 1. pop case descriptor pointer. *
|
||||
* 2. pop search value. *
|
||||
* 3. Load number of table entries. *
|
||||
* 4. Check if search value in table. *
|
||||
* 5. If found: load Program Counter value. *
|
||||
* 6. Else: load default value. *
|
||||
********************************************************/
|
||||
|
||||
PRIVATE search_jump(nbytes)
|
||||
size nbytes;
|
||||
{
|
||||
register ptr cdp = dppop(); /* Case Descriptor Pointer */
|
||||
register long sv = spop(nbytes);/* Search Value */
|
||||
register long nt = /* Number of Table-entries */
|
||||
mem_lds(cdp + psize, wsize);
|
||||
register ptr nPC; /* New Program Counter */
|
||||
|
||||
while (--nt >= 0) {
|
||||
if (sv == mem_lds(cdp + (nt+1) * (wsize+psize), wsize)) {
|
||||
nPC = mem_ldip(cdp + wsize + (nt+1)*(wsize+psize));
|
||||
if (nPC == 0)
|
||||
trap(ECASE);
|
||||
newPC(nPC);
|
||||
return;
|
||||
}
|
||||
}
|
||||
nPC = mem_ldip(cdp);
|
||||
if (nPC == 0)
|
||||
trap(ECASE);
|
||||
newPC(nPC);
|
||||
}
|
||||
|
||||
/********************************************************
|
||||
* Range check *
|
||||
* *
|
||||
* 1. Load range descriptor. *
|
||||
* 2. Check against lower and upper bound. *
|
||||
* 3. Generate trap if necessary. *
|
||||
* 4. DON'T remove integer. *
|
||||
********************************************************/
|
||||
|
||||
PRIVATE range_check(nbytes)
|
||||
size nbytes;
|
||||
{
|
||||
register ptr rdp = dppop(); /* Range check Descriptor Pointer */
|
||||
register long cv = /* Check Value */
|
||||
st_lds(SP, nbytes);
|
||||
|
||||
if (must_test && !(IgnMask&BIT(ERANGE))) {
|
||||
if ( cv < mem_lds(rdp, wsize)
|
||||
|| cv > mem_lds(rdp + wsize, wsize)
|
||||
) {
|
||||
trap(ERANGE);
|
||||
}
|
||||
}
|
||||
}
|
||||
224
util/int/do_proc.c
Normal file
224
util/int/do_proc.c
Normal file
|
|
@ -0,0 +1,224 @@
|
|||
/*
|
||||
* Sources of the "PROCEDURE CALL" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "memdirect.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "text.h"
|
||||
#include "proctab.h"
|
||||
#include "fra.h"
|
||||
#include "rsb.h"
|
||||
#include "linfil.h"
|
||||
|
||||
extern int running; /* from main.c */
|
||||
|
||||
PRIVATE lfr(), ret();
|
||||
|
||||
DoCAIz() /* proc identifier on top of stack */
|
||||
{
|
||||
/* CAI -: Call procedure (procedure identifier on stack) */
|
||||
register long pi = spop(psize);
|
||||
|
||||
LOG(("@P6 DoCAIz(%lu)", pi));
|
||||
call(arg_p(pi), RSB_CAL);
|
||||
}
|
||||
|
||||
DoCALl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* CAL p: Call procedure (with identifier p) */
|
||||
register long pi = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@P6 DoCALl2(%lu)", pi));
|
||||
call(arg_p(pi), RSB_CAL);
|
||||
}
|
||||
|
||||
DoCALl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@P6 DoLFRl2(%ld)", l));
|
||||
lfr(arg_s(l));
|
||||
}
|
||||
|
||||
DoLFRm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@P6 DoRETl2(%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));
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Calling a new procedure. *
|
||||
************************************************************************/
|
||||
|
||||
call(new_PI, rsbcode)
|
||||
long new_PI;
|
||||
int rsbcode;
|
||||
{
|
||||
/* legality of new_PI has already been checked */
|
||||
register size nloc = proctab[new_PI].pr_nloc;
|
||||
register ptr ep = proctab[new_PI].pr_ep;
|
||||
|
||||
push_frame(SP); /* remember AB */
|
||||
pushrsb(rsbcode);
|
||||
|
||||
/* do the call */
|
||||
PI = new_PI;
|
||||
st_inc(nloc);
|
||||
newPC(ep);
|
||||
spoilFRA();
|
||||
LOG(("@p5 call: new_PI = %lu, nloc = %lu, ep = %lu",
|
||||
new_PI, nloc, ep));
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Loading a function result. *
|
||||
************************************************************************/
|
||||
|
||||
PRIVATE lfr(sz)
|
||||
size sz;
|
||||
{
|
||||
if (sz > FRALimit) {
|
||||
wtrap(WILLLFR, EILLINS);
|
||||
}
|
||||
|
||||
LOG(("@p5 lfr: size = %ld", sz));
|
||||
|
||||
#ifdef LOGGING
|
||||
if (!FRA_def) {
|
||||
warning(WRFUNGAR);
|
||||
}
|
||||
if (sz != FRASize) {
|
||||
warning(FRASize < sz ? WRFUNSML : WRFUNLAR);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
pushFRA(sz);
|
||||
spoilFRA();
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Returning from a procedure. *
|
||||
************************************************************************/
|
||||
|
||||
PRIVATE ret(sz)
|
||||
size sz;
|
||||
{
|
||||
if (sz > FRALimit) {
|
||||
wtrap(WILLRET, EILLINS);
|
||||
}
|
||||
|
||||
LOG(("@p5 ret: size = %ld", sz));
|
||||
|
||||
/* retrieve return value from stack */
|
||||
FRA_def = DEFINED;
|
||||
FRASize = sz;
|
||||
popFRA(FRASize);
|
||||
|
||||
switch (poprsb(0)) {
|
||||
case RSB_STP:
|
||||
if (sz == wsize) {
|
||||
ES_def = DEFINED;
|
||||
ES = btol(FRA[sz-1]);
|
||||
/* one byte only */
|
||||
}
|
||||
running = 0; /* stop the machine */
|
||||
return;
|
||||
case RSB_CAL:
|
||||
/* OK */
|
||||
break;
|
||||
case RSB_RTT:
|
||||
case RSB_NRT:
|
||||
warning(WRETTRAP);
|
||||
running = 0; /* stop the machine */
|
||||
return;
|
||||
default:
|
||||
warning(WRETBAD);
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
202
util/int/do_ptrar.c
Normal file
202
util/int/do_ptrar.c
Normal file
|
|
@ -0,0 +1,202 @@
|
|||
/*
|
||||
* Sources of the "POINTER ARITHMETIC" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "segcheck.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
|
||||
#define adp(p,w) ((p) + (w))
|
||||
#define sbs(t,s) ((s) - (t))
|
||||
|
||||
#ifdef SEGCHECK
|
||||
|
||||
#define check_seg(s1,s2,w) if (s1 != s2) { warning(w); }
|
||||
|
||||
#else
|
||||
|
||||
#define check_seg(s1,s2,w)
|
||||
|
||||
#endif SEGCHECK
|
||||
|
||||
DoADPl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* ADP f: Add f to pointer on top of stack */
|
||||
register long l = (L_arg_2() * arg);
|
||||
register ptr p, t = st_lddp(SP);
|
||||
|
||||
LOG(("@R6 DoADPl2(%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);
|
||||
}
|
||||
|
||||
DoADPl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register long t = spop(arg_wi(l));
|
||||
register ptr p, s = st_lddp(SP);
|
||||
|
||||
LOG(("@R6 DoADSl2(%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);
|
||||
}
|
||||
|
||||
DoADSm(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr t = st_lddp(SP);
|
||||
register ptr s = st_lddp(SP + psize);
|
||||
register long w;
|
||||
|
||||
LOG(("@R6 DoSBSl2(%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 = upop(wsize);
|
||||
register ptr t = st_lddp(SP);
|
||||
register ptr s = st_lddp(SP + psize);
|
||||
register long w;
|
||||
|
||||
LOG(("@R6 DoSBSz(%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);
|
||||
}
|
||||
137
util/int/do_sets.c
Normal file
137
util/int/do_sets.c
Normal file
|
|
@ -0,0 +1,137 @@
|
|||
/*
|
||||
* Sources of the "SETS" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "trap.h"
|
||||
#include "mem.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
|
||||
PRIVATE bit_test(), create_set();
|
||||
|
||||
DoINNl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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));
|
||||
spoilFRA();
|
||||
bit_test(arg_w(l));
|
||||
}
|
||||
|
||||
DoINNs(hob, wfac)
|
||||
long hob;
|
||||
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 = upop(wsize);
|
||||
|
||||
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) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
|
||||
LOG(("@Y6 DoSETl2(%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 = upop(wsize);
|
||||
|
||||
LOG(("@Y6 DoSETz(%ld)", l));
|
||||
spoilFRA();
|
||||
create_set(arg_w(l));
|
||||
}
|
||||
|
||||
/********************************************************
|
||||
* bit testing *
|
||||
* *
|
||||
* Tests whether the bit with number to be found *
|
||||
* on TOS is on in 'w'-byte set. *
|
||||
* ON --> push 1 on stack. *
|
||||
* OFF -> push 0 on stack. *
|
||||
********************************************************/
|
||||
|
||||
PRIVATE bit_test(w)
|
||||
size w;
|
||||
{
|
||||
register int bitno =
|
||||
(int) spop(wsize); /* bitno on TOS */
|
||||
register char test_byte = (char) 0;/* default value to be tested */
|
||||
|
||||
if (must_test && !(IgnMask&BIT(ESET))) {
|
||||
/* Only w<<3 bytes CAN be tested */
|
||||
if (bitno > (int) ((w << 3) - 1)) {
|
||||
trap(ESET);
|
||||
}
|
||||
}
|
||||
test_byte = stack_loc(SP + (bitno / 8));
|
||||
st_dec(w);
|
||||
npush((long)((test_byte & BIT(bitno % 8)) ? 1 : 0), wsize);
|
||||
}
|
||||
|
||||
/********************************************************
|
||||
* set creation *
|
||||
* *
|
||||
* Creates a singleton 'w'-byte set with as *
|
||||
* singleton member, the bit with number on *
|
||||
* TOS. The w bytes constituting the set are *
|
||||
* pushed on the stack. *
|
||||
********************************************************/
|
||||
|
||||
PRIVATE create_set(w)
|
||||
size w;
|
||||
{
|
||||
register int bitno = (int) spop(wsize);
|
||||
register size nbytes = w;
|
||||
|
||||
st_inc(nbytes);
|
||||
while (--nbytes >= 0) {
|
||||
st_stn(SP + nbytes, 0L, 1L);
|
||||
}
|
||||
|
||||
if (must_test && !(IgnMask&BIT(ESET))) {
|
||||
if (bitno > (int) ((w << 3) - 1)) {
|
||||
trap(ESET);
|
||||
}
|
||||
}
|
||||
st_stn(SP + (bitno / 8), (long)BIT(bitno % 8), 1L);
|
||||
}
|
||||
|
||||
412
util/int/do_store.c
Normal file
412
util/int/do_store.c
Normal file
|
|
@ -0,0 +1,412 @@
|
|||
/*
|
||||
* Sources of the "STORE" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
#include "warn.h"
|
||||
|
||||
DoSTLm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* STL l: Store local or parameter */
|
||||
register long l = arg_l(arg);
|
||||
|
||||
LOG(("@S6 DoSTLm(%ld)", l));
|
||||
spoilFRA();
|
||||
pop_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
DoSTLn2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* STL l: Store local or parameter */
|
||||
register long l = (N_arg_2() * arg);
|
||||
|
||||
LOG(("@S6 DoSTLn2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_l(l);
|
||||
pop_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
DoSTLn4(arg)
|
||||
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);
|
||||
pop_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
pop_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
pop_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
pop_st(loc_addr(l), wsize);
|
||||
}
|
||||
|
||||
DoSTEl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* STE g: Store external */
|
||||
register ptr p = i2p(L_arg_2() * arg);
|
||||
|
||||
LOG(("@S6 DoSTEl2(%lu)", p));
|
||||
spoilFRA();
|
||||
pop_m(arg_g(p), wsize);
|
||||
}
|
||||
|
||||
DoSTEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* STE g: Store external */
|
||||
register ptr p = i2p(L_arg_4() * arg);
|
||||
|
||||
LOG(("@S6 DoSTEl4(%lu)", p));
|
||||
spoilFRA();
|
||||
pop_m(arg_g(p), wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
pop_m(arg_g(p), wsize);
|
||||
}
|
||||
|
||||
DoSILn2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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));
|
||||
spoilFRA();
|
||||
l = arg_l(l);
|
||||
pop_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
DoSILn4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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);
|
||||
pop_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
pop_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
pop_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
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);
|
||||
pop_m(st_lddp(loc_addr(l)), wsize);
|
||||
}
|
||||
|
||||
DoSTFl2(arg)
|
||||
long arg;
|
||||
{
|
||||
/* STF f: Store offsetted */
|
||||
register long l = (L_arg_2() * arg);
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@S6 DoSTFl2(%ld)", l));
|
||||
spoilFRA();
|
||||
pop_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
DoSTFl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* STF f: Store offsetted */
|
||||
register long l = (L_arg_4() * arg);
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@S6 DoSTFl4(%ld)", l));
|
||||
spoilFRA();
|
||||
pop_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
DoSTFm(arg)
|
||||
long arg;
|
||||
{
|
||||
/* STF f: Store offsetted */
|
||||
register long l = arg;
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@S6 DoSTFm(%ld)", l));
|
||||
spoilFRA();
|
||||
pop_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
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();
|
||||
pop_m(p + arg_f(l), wsize);
|
||||
}
|
||||
|
||||
DoSTIl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* STI o: Store indirect o bytes (pop address, then data) */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@S6 DoSTIl2(%ld)", l));
|
||||
spoilFRA();
|
||||
pop_m(p, arg_o(l));
|
||||
}
|
||||
|
||||
DoSTIl4(arg)
|
||||
size arg;
|
||||
{
|
||||
/* 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 */
|
||||
register size l = (P_arg_2() * arg);
|
||||
register ptr p;
|
||||
|
||||
LOG(("@S6 DoSTSl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = upop(arg_wi(l));
|
||||
p = dppop();
|
||||
pop_m(p, arg_o(l));
|
||||
}
|
||||
|
||||
DoSTSz() /* the arg 'w' is on top of stack */
|
||||
{
|
||||
/* STS w: Store indirect, w-byte integer on top of stack gives object size */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register long l = (N_arg_2() * arg);
|
||||
|
||||
LOG(("@S6 DoSDLn2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_l(l);
|
||||
pop_st(loc_addr(l), dwsize);
|
||||
}
|
||||
|
||||
DoSDLn4(arg)
|
||||
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 */
|
||||
register ptr p = i2p(U_arg() * arg);
|
||||
|
||||
LOG(("@S6 DoSDEu(%lu)", p));
|
||||
spoilFRA();
|
||||
pop_m(arg_g(p), dwsize);
|
||||
}
|
||||
|
||||
DoSDEl4(arg)
|
||||
long arg;
|
||||
{
|
||||
/* 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 */
|
||||
register long l = (L_arg_2() * arg);
|
||||
register ptr p = dppop();
|
||||
|
||||
LOG(("@S6 DoSDFl2(%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();
|
||||
pop_m(p + arg_f(l), dwsize);
|
||||
}
|
||||
262
util/int/do_unsar.c
Normal file
262
util/int/do_unsar.c
Normal file
|
|
@ -0,0 +1,262 @@
|
|||
/*
|
||||
* Sources of the "UNSIGNED ARITHMETIC" group instructions
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "mem.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "text.h"
|
||||
#include "fra.h"
|
||||
|
||||
/************************************************************************
|
||||
* No checking is performed, except for division by zero. *
|
||||
* The operands popped from the stack are put in unsigned *
|
||||
* longs. Now the required operation can be performed *
|
||||
* immediately. Whether the wordsize is two or four bytes *
|
||||
* doesn't matter. Alas, arithmetic is performed modulo *
|
||||
* the highest unsigned number for the given size plus 1. *
|
||||
************************************************************************/
|
||||
|
||||
#ifdef LOGGING
|
||||
extern int must_test;
|
||||
#endif LOGGING
|
||||
|
||||
#define adu(w1,w2) (unsigned long)(w1 + w2)
|
||||
#define sbu(w1,w2) (unsigned long)(w1 - w2)
|
||||
#define mlu(w1,w2) (unsigned long)(w1 * w2)
|
||||
|
||||
PRIVATE unsigned long dvu(), rmu(), slu(), sru();
|
||||
|
||||
DoADUl2(arg)
|
||||
size arg;
|
||||
{
|
||||
/* ADU w: Addition */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(arg_wi(l));
|
||||
|
||||
LOG(("@U6 DoADUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long) adu(upop(l), t), l);
|
||||
}
|
||||
|
||||
DoADUz()
|
||||
{
|
||||
/* ADU w: Addition */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(arg_wi(l));
|
||||
|
||||
LOG(("@U6 DoSBUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long) sbu(upop(l), t), l);
|
||||
}
|
||||
|
||||
DoSBUz()
|
||||
{
|
||||
/* SBU w: Subtraction */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(arg_wi(l));
|
||||
|
||||
LOG(("@U6 DoMLUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long) mlu(upop(l), t), l);
|
||||
}
|
||||
|
||||
DoMLUz()
|
||||
{
|
||||
/* MLU w: Multiplication */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(arg_wi(l));
|
||||
|
||||
LOG(("@U6 DoDVUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long) dvu(upop(l), t), l);
|
||||
}
|
||||
|
||||
DoDVUz()
|
||||
{
|
||||
/* DVU w: Division */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(arg_wi(l));
|
||||
|
||||
LOG(("@U6 DoRMUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
npush((long) rmu(upop(l), t), l);
|
||||
}
|
||||
|
||||
DoRMUz()
|
||||
{
|
||||
/* RMU w: Remainder */
|
||||
register size l = upop(wsize);
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(wsize);
|
||||
|
||||
LOG(("@U6 DoSLUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush((long) slu(upop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoSLUz()
|
||||
{
|
||||
/* SLU w: Shift left */
|
||||
register size l = upop(wsize);
|
||||
register unsigned long t = upop(wsize);
|
||||
|
||||
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 */
|
||||
register size l = (L_arg_2() * arg);
|
||||
register unsigned long t = upop(wsize);
|
||||
|
||||
LOG(("@U6 DoSRUl2(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush((long) sru(upop(l), t, l), l);
|
||||
}
|
||||
|
||||
DoSRUz()
|
||||
{
|
||||
/* SRU w: Shift right */
|
||||
register size l = upop(wsize);
|
||||
register unsigned long t = upop(wsize);
|
||||
|
||||
LOG(("@U6 DoSRUz(%ld)", l));
|
||||
spoilFRA();
|
||||
l = arg_wi(l);
|
||||
npush((long) sru(upop(l), t, l), l);
|
||||
}
|
||||
|
||||
PRIVATE unsigned long dvu(w1, w2)
|
||||
unsigned long w1, w2;
|
||||
{
|
||||
if (w2 == 0) {
|
||||
if (!(IgnMask&BIT(EIDIVZ))) {
|
||||
trap(EIDIVZ);
|
||||
}
|
||||
else return (0L);
|
||||
}
|
||||
return (w1 / w2);
|
||||
}
|
||||
|
||||
PRIVATE unsigned long rmu(w1, w2)
|
||||
unsigned long w1, w2;
|
||||
{
|
||||
if (w2 == 0) {
|
||||
if (!(IgnMask&BIT(EIDIVZ))) {
|
||||
trap(EIDIVZ);
|
||||
}
|
||||
else return (0L);
|
||||
}
|
||||
return (w1 % w2);
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
PRIVATE unsigned long slu(w1, w2, nbytes) /* w1 << w2 */
|
||||
unsigned long w1, w2;
|
||||
size nbytes;
|
||||
{
|
||||
#ifdef LOGGING
|
||||
if (must_test) {
|
||||
/* check shift distance */
|
||||
if (w2 >= nbytes*8) {
|
||||
warning(WSHLARGE);
|
||||
w2 = nbytes*8 - 1;
|
||||
}
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
/* calculate result */
|
||||
return (w1 << w2);
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
PRIVATE unsigned long sru(w1, w2, nbytes) /* w1 >> w2 */
|
||||
unsigned long w1, w2;
|
||||
size nbytes;
|
||||
{
|
||||
#ifdef LOGGING
|
||||
if (must_test) {
|
||||
/* check shift distance */
|
||||
if (w2 >= nbytes*8) {
|
||||
warning(WSHLARGE);
|
||||
w2 = nbytes*8 - 1;
|
||||
}
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
/* calculate result */
|
||||
return (w1 >> w2);
|
||||
}
|
||||
|
||||
645
util/int/dump.c
Normal file
645
util/int/dump.c
Normal file
|
|
@ -0,0 +1,645 @@
|
|||
/*
|
||||
For dumping the stack, GDA, heap and text segment.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <ctype.h>
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "memdirect.h"
|
||||
#include "mem.h"
|
||||
#include "fra.h"
|
||||
#include "text.h"
|
||||
#include "proctab.h"
|
||||
#include "shadow.h"
|
||||
#include "linfil.h"
|
||||
#include "rsb.h"
|
||||
|
||||
extern long inr; /* from log.c */
|
||||
|
||||
/****************************************************************
|
||||
* Dumping routines for debugging, in human-readable form. *
|
||||
****************************************************************/
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
/* The file is repetitive and should probably be partly generated,
|
||||
although it is not directly evident how.
|
||||
*/
|
||||
|
||||
extern char *sprintf();
|
||||
|
||||
PRIVATE char *displ_undefs(), *displ_fil(), *displ_sh(), *displ_code();
|
||||
PRIVATE ptr std_raw(), std_rsb();
|
||||
PRIVATE int std_bytes(), dtd_bytes(), FRAd_bytes();
|
||||
PRIVATE std_item(), std_left_undefs();
|
||||
PRIVATE gdad_item(), gdad_left_undefs();
|
||||
PRIVATE hpd_item(), hpd_left_undefs();
|
||||
PRIVATE FRA_dump(), FRA_item();
|
||||
|
||||
/******** Stack Dump ********/
|
||||
|
||||
std_all(sz, rawfl)
|
||||
long sz;
|
||||
int rawfl;
|
||||
{
|
||||
register ptr addr;
|
||||
|
||||
if (!check_log(" d1 "))
|
||||
return;
|
||||
|
||||
LOG((" d2 "));
|
||||
LOG((" d2 . . STACK_DUMP[%ld/%ld%s] . . INR = %lu . . STACK_DUMP . .",
|
||||
wsize, psize, rawfl ? ", raw" : "", inr));
|
||||
LOG((" d2 ----------------------------------------------------------------"));
|
||||
|
||||
/* find a good start address */
|
||||
addr = (sz && sz < ML - SP ? SP + sz : ML);
|
||||
/* find RSB backwards */
|
||||
while (in_stack(addr) && !is_st_prot(addr)) {
|
||||
addr++;
|
||||
}
|
||||
/* find end of RSB backwards */
|
||||
while (in_stack(addr) && is_st_prot(addr)) {
|
||||
addr++;
|
||||
}
|
||||
addr--;
|
||||
|
||||
/* dump the stack */
|
||||
while (in_stack(addr)) {
|
||||
addr = std_raw(addr, rawfl);
|
||||
addr = std_rsb(addr);
|
||||
}
|
||||
FRA_dump();
|
||||
LOG((" d1 >> AB = %lu, LB = %lu, SP = %lu, HP = %lu, LIN = %lu, FIL = %s",
|
||||
AB, LB, SP, HP, getLIN(), displ_fil(getFIL())));
|
||||
LOG((" d2 ----------------------------------------------------------------"));
|
||||
LOG((" d2 "));
|
||||
}
|
||||
|
||||
PRIVATE ptr
|
||||
std_raw(addr, rawfl)
|
||||
ptr addr;
|
||||
int rawfl;
|
||||
{ /* Produces a formatted dump of the stack segment starting
|
||||
at addr, up to the Return Status Block (identified
|
||||
by protection bits)
|
||||
*/
|
||||
register int nundef = 0;
|
||||
|
||||
LOG((" d2 ADDRESS BYTE ITEM VALUE SHADOW"));
|
||||
|
||||
while ( in_stack(addr)
|
||||
&& (!is_st_prot(addr) || rawfl)
|
||||
) {
|
||||
if (st_sh(addr) == UNDEFINED) {
|
||||
if (nundef++ == 0)
|
||||
LOG((" d2 %10lu undef", addr));
|
||||
}
|
||||
else {
|
||||
if (nundef) {
|
||||
std_left_undefs(nundef, addr + 1);
|
||||
nundef = 0;
|
||||
}
|
||||
std_item(addr);
|
||||
}
|
||||
addr--;
|
||||
}
|
||||
if (nundef)
|
||||
std_left_undefs(nundef, addr + 1);
|
||||
return addr;
|
||||
}
|
||||
|
||||
PRIVATE std_item(addr)
|
||||
ptr addr;
|
||||
{
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_stack(addr, psize)
|
||||
&& std_bytes(addr, addr + psize, SH_DATAP|SH_INSP)
|
||||
) {
|
||||
/* print a pointer value */
|
||||
LOG((" d2 %10lu %3lu [%10lu] (%-s)",
|
||||
addr,
|
||||
btol(stack_loc(addr)),
|
||||
p_in_stack(addr),
|
||||
displ_sh(st_sh(addr), stack_loc(addr))));
|
||||
}
|
||||
else
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_stack(addr, wsize)
|
||||
&& std_bytes(addr, addr + wsize, SH_INT)
|
||||
) {
|
||||
/* print a word value */
|
||||
LOG((" d2 %10lu %3lu [%10ld] (%-s)",
|
||||
addr,
|
||||
btol(stack_loc(addr)),
|
||||
w_in_stack(addr),
|
||||
displ_sh(st_sh(addr), stack_loc(addr))));
|
||||
}
|
||||
else {
|
||||
/* just print the byte */
|
||||
LOG((" d2 %10lu %3lu (%-s)",
|
||||
addr,
|
||||
btol(stack_loc(addr)),
|
||||
displ_sh(st_sh(addr), stack_loc(addr))));
|
||||
}
|
||||
}
|
||||
|
||||
PRIVATE ptr
|
||||
std_rsb(addr)
|
||||
ptr addr;
|
||||
{ /* Dumps the Return Status Block */
|
||||
ptr dmp_lb;
|
||||
int code;
|
||||
long pi;
|
||||
ptr pc;
|
||||
ptr lb;
|
||||
long lin;
|
||||
ptr fil;
|
||||
char pr_descr[300];
|
||||
|
||||
if (!in_stack(addr))
|
||||
return addr;
|
||||
|
||||
dmp_lb = addr - (rsbsize-1); /* pseudo local base */
|
||||
if (!in_stack(dmp_lb)) {
|
||||
LOG((" d1 >>RSB: >>>> INCOMPLETE <<<<"));
|
||||
return dmp_lb;
|
||||
}
|
||||
|
||||
code = (int)w_in_stack(dmp_lb + rsb_rsbcode);
|
||||
pi = (long)p_in_stack(dmp_lb + rsb_PI);
|
||||
pc = p_in_stack(dmp_lb + rsb_PC);
|
||||
lb = p_in_stack(dmp_lb + rsb_LB);
|
||||
lin = LIN_in_stack(dmp_lb + rsb_LIN);
|
||||
fil = p_in_stack(dmp_lb + rsb_FIL);
|
||||
|
||||
if (pi == -1) {
|
||||
sprintf(pr_descr, "uninit");
|
||||
}
|
||||
else
|
||||
if (pi < NProc) {
|
||||
sprintf(pr_descr, "(%lu,%lu)",
|
||||
pi, (long)proctab[pi].pr_nloc);
|
||||
}
|
||||
else {
|
||||
sprintf(pr_descr, "%lu >>>> ILLEGAL <<<<", pi);
|
||||
}
|
||||
LOG((" d1 >> RSB: code = %s, PI = %s, PC = %lu, LB = %lu, LIN = %lu, FIL = %s",
|
||||
displ_code(code), pr_descr, pc, lb, lin, displ_fil(fil)));
|
||||
|
||||
LOG((" d2 "));
|
||||
return addr - rsbsize;
|
||||
}
|
||||
|
||||
PRIVATE char *displ_code(rsbcode)
|
||||
int rsbcode;
|
||||
{
|
||||
switch (rsbcode) {
|
||||
case RSB_STP: return "STP";
|
||||
case RSB_CAL: return "CAL";
|
||||
case RSB_RTT: return "RTT";
|
||||
case RSB_NRT: return "NRT";
|
||||
default: return ">>Bad RSB code<<";
|
||||
}
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
PRIVATE std_left_undefs(nundef, addr)
|
||||
int nundef;
|
||||
ptr addr;
|
||||
{
|
||||
/* handle pending undefineds */
|
||||
switch (nundef) {
|
||||
case 1:
|
||||
break;
|
||||
case 2:
|
||||
LOG((" d2 %10lu undef", addr));
|
||||
break;
|
||||
default:
|
||||
LOG((" d2 | | | | | |"));
|
||||
LOG((" d2 %10lu undef (%s)",
|
||||
addr, displ_undefs(nundef, addr)));
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
PRIVATE FRA_dump()
|
||||
{
|
||||
register int addr;
|
||||
|
||||
LOG((" d2 FRA: size = %d, %s",
|
||||
FRASize, FRA_def ? "defined" : "undefined"));
|
||||
|
||||
for (addr = 0; addr < FRASize; addr++) {
|
||||
FRA_item(addr);
|
||||
}
|
||||
}
|
||||
|
||||
PRIVATE FRA_item(addr)
|
||||
int addr;
|
||||
{
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_FRA(addr, psize)
|
||||
&& FRAd_bytes(addr, (int)(addr + psize), SH_DATAP|SH_INSP)
|
||||
) {
|
||||
/* print a pointer value */
|
||||
LOG((" d2 FRA[%1d] %3lu [%10lu] (%-s)",
|
||||
addr,
|
||||
btol(FRA[addr]),
|
||||
p_in_FRA(addr),
|
||||
displ_sh(FRA_sh[addr], FRA[addr])));
|
||||
}
|
||||
else
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_FRA(addr, wsize)
|
||||
&& FRAd_bytes(addr, (int)(addr + wsize), SH_INT)
|
||||
) {
|
||||
/* print a word value */
|
||||
LOG((" d2 FRA[%1d] %3lu [%10ld] (%-s)",
|
||||
addr,
|
||||
btol(FRA[addr]),
|
||||
w_in_FRA(addr),
|
||||
displ_sh(FRA_sh[addr], FRA[addr])));
|
||||
}
|
||||
else {
|
||||
/* just print the byte */
|
||||
LOG((" d2 FRA[%1d] %3lu (%-s)",
|
||||
addr,
|
||||
btol(FRA[addr]),
|
||||
displ_sh(FRA_sh[addr], FRA[addr])));
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/******** Global Data Area Dump ********/
|
||||
|
||||
gdad_all(low, high)
|
||||
ptr low, high;
|
||||
{
|
||||
register ptr addr;
|
||||
register int nundef = 0;
|
||||
|
||||
if (!check_log(" +1 "))
|
||||
return;
|
||||
|
||||
if (low == 0 && high == 0)
|
||||
high = HB;
|
||||
|
||||
LOG((" +1 "));
|
||||
LOG((" +1 . . GDA_DUMP[%ld/%ld] . . INR = %lu . . GDA_DUMP . .",
|
||||
wsize, psize, inr));
|
||||
LOG((" +1 ----------------------------------------------------------------"));
|
||||
LOG((" +1 ADDRESS BYTE WORD VALUE SHADOW"));
|
||||
|
||||
/* dump global data area contents */
|
||||
addr = low;
|
||||
while (addr < min(HB, high)) {
|
||||
if (dt_sh(addr) == UNDEFINED) {
|
||||
if (nundef++ == 0)
|
||||
LOG((" +1 %10lu undef", addr));
|
||||
}
|
||||
else {
|
||||
if (nundef) {
|
||||
gdad_left_undefs(nundef, addr-1);
|
||||
nundef = 0;
|
||||
}
|
||||
gdad_item(addr);
|
||||
}
|
||||
addr++;
|
||||
}
|
||||
if (nundef)
|
||||
gdad_left_undefs(nundef, addr-1);
|
||||
LOG((" +1 ----------------------------------------------------------------"));
|
||||
LOG((" +1 "));
|
||||
}
|
||||
|
||||
PRIVATE gdad_item(addr)
|
||||
ptr addr;
|
||||
{
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_data(addr, psize)
|
||||
&& dtd_bytes(addr, addr + psize, SH_DATAP|SH_INSP)
|
||||
) {
|
||||
/* print a pointer value */
|
||||
LOG((" +1 %10lu %3lu [%10lu] (%-s)",
|
||||
addr,
|
||||
btol(data_loc(addr)),
|
||||
p_in_data(addr),
|
||||
displ_sh(dt_sh(addr), data_loc(addr))));
|
||||
}
|
||||
else
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_data(addr, wsize)
|
||||
&& dtd_bytes(addr, addr + wsize, SH_INT)
|
||||
) {
|
||||
/* print a word value */
|
||||
LOG((" +1 %10lu %3lu [%10ld] (%-s)",
|
||||
addr,
|
||||
btol(data_loc(addr)),
|
||||
w_in_data(addr),
|
||||
displ_sh(dt_sh(addr), data_loc(addr))));
|
||||
}
|
||||
else {
|
||||
/* just print the byte */
|
||||
LOG((" +1 %10lu %3lu (%-s)",
|
||||
addr,
|
||||
btol(data_loc(addr)),
|
||||
displ_sh(dt_sh(addr), data_loc(addr))));
|
||||
}
|
||||
}
|
||||
|
||||
PRIVATE gdad_left_undefs(nundef, addr)
|
||||
int nundef;
|
||||
ptr addr;
|
||||
{
|
||||
/* handle pending undefineds */
|
||||
switch (nundef) {
|
||||
case 1:
|
||||
break;
|
||||
case 2:
|
||||
LOG((" +1 %10lu undef", addr));
|
||||
break;
|
||||
default:
|
||||
LOG((" +1 | | | | | |"));
|
||||
LOG((" +1 %10lu undef (%s)",
|
||||
addr, displ_undefs(nundef, addr)));
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/******** Heap Area Dump ********/
|
||||
|
||||
hpd_all()
|
||||
{
|
||||
register ptr addr;
|
||||
register int nundef = 0;
|
||||
|
||||
if (!check_log(" *1 "))
|
||||
return;
|
||||
|
||||
LOG((" *1 "));
|
||||
LOG((" *1 . . HEAP_DUMP[%ld/%ld] . . INR = %lu . . HEAP_DUMP . .",
|
||||
wsize, psize, inr));
|
||||
LOG((" *1 ----------------------------------------------------------------"));
|
||||
LOG((" *1 ADDRESS BYTE WORD VALUE SHADOW"));
|
||||
|
||||
/* dump heap contents */
|
||||
for (addr = HB; addr < HP; addr++) {
|
||||
if (dt_sh(addr) == UNDEFINED) {
|
||||
if (nundef++ == 0)
|
||||
LOG((" *1 %10lu undef", addr));
|
||||
}
|
||||
else {
|
||||
if (nundef) {
|
||||
hpd_left_undefs(nundef, addr-1);
|
||||
nundef = 0;
|
||||
}
|
||||
hpd_item(addr);
|
||||
}
|
||||
}
|
||||
if (nundef)
|
||||
hpd_left_undefs(nundef, addr-1);
|
||||
LOG((" *1 ----------------------------------------------------------------"));
|
||||
LOG((" *1 "));
|
||||
}
|
||||
|
||||
PRIVATE hpd_item(addr)
|
||||
ptr addr;
|
||||
{
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_data(addr, psize)
|
||||
&& dtd_bytes(addr, addr + psize, SH_DATAP|SH_INSP)
|
||||
) {
|
||||
/* print a pointer value */
|
||||
LOG((" *1 %10lu %3lu [%10lu] (%-s)",
|
||||
addr,
|
||||
btol(data_loc(addr)),
|
||||
p_in_data(addr),
|
||||
displ_sh(dt_sh(addr), data_loc(addr))));
|
||||
}
|
||||
else
|
||||
if ( is_aligned(addr, wsize)
|
||||
&& is_in_data(addr, wsize)
|
||||
&& dtd_bytes(addr, addr + wsize, SH_INT)
|
||||
) {
|
||||
/* print a word value */
|
||||
LOG((" *1 %10lu %3lu [%10ld] (%-s)",
|
||||
addr,
|
||||
btol(data_loc(addr)),
|
||||
w_in_data(addr),
|
||||
displ_sh(dt_sh(addr), data_loc(addr))));
|
||||
}
|
||||
else {
|
||||
/* just print the byte */
|
||||
LOG((" *1 %10lu %3lu (%-s)",
|
||||
addr,
|
||||
btol(data_loc(addr)),
|
||||
displ_sh(dt_sh(addr), data_loc(addr))));
|
||||
}
|
||||
}
|
||||
|
||||
PRIVATE hpd_left_undefs(nundef, addr)
|
||||
int nundef;
|
||||
ptr addr;
|
||||
{
|
||||
/* handle pending undefineds */
|
||||
switch (nundef) {
|
||||
case 1:
|
||||
break;
|
||||
case 2:
|
||||
LOG((" *1 %10lu undef", addr));
|
||||
break;
|
||||
default:
|
||||
LOG((" *1 | | | | | |"));
|
||||
LOG((" *1 %10lu undef (%s)",
|
||||
addr, displ_undefs(nundef, addr)));
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Service routines */
|
||||
|
||||
PRIVATE int std_bytes(low, high, bits)
|
||||
ptr low, high;
|
||||
int bits;
|
||||
{
|
||||
/* True if all stack bytes from low to high-1 have one of the
|
||||
bits in bits on.
|
||||
*/
|
||||
int byte = bits;
|
||||
|
||||
while (low < high) {
|
||||
byte &= st_sh(low);
|
||||
low++;
|
||||
}
|
||||
|
||||
return byte & bits;
|
||||
}
|
||||
|
||||
PRIVATE int dtd_bytes(low, high, bits)
|
||||
ptr low, high;
|
||||
int bits;
|
||||
{
|
||||
/* True if all data bytes from low to high-1 have one of the
|
||||
bits in bits on.
|
||||
*/
|
||||
int byte = bits;
|
||||
|
||||
while (low < high) {
|
||||
byte &= dt_sh(low);
|
||||
low++;
|
||||
}
|
||||
|
||||
return byte & bits;
|
||||
}
|
||||
|
||||
PRIVATE int FRAd_bytes(low, high, bits)
|
||||
int low, high;
|
||||
int bits;
|
||||
{
|
||||
/* True if all data bytes from low to high-1 have one of the
|
||||
bits in bits on.
|
||||
*/
|
||||
int byte = bits;
|
||||
|
||||
while (low < high) {
|
||||
byte &= FRA_sh[low];
|
||||
low++;
|
||||
}
|
||||
|
||||
return byte & bits;
|
||||
}
|
||||
|
||||
PRIVATE char * /* transient */
|
||||
displ_undefs(nundef, addr)
|
||||
int nundef;
|
||||
ptr addr;
|
||||
{
|
||||
/* Given the number of undefineds, we want to report the number
|
||||
of words with the left-over numbers of bytes on both sides:
|
||||
| nundef |
|
||||
|left| wrds |right
|
||||
.....|........|........|........|...
|
||||
a
|
||||
d
|
||||
d
|
||||
r
|
||||
This takes some arithmetic.
|
||||
*/
|
||||
static char buf[30];
|
||||
register int left = wsize - 1 - p2i(addr-1) % wsize;
|
||||
register int wrds = (nundef-left) / wsize;
|
||||
register int right = nundef - left - wrds*wsize;
|
||||
|
||||
if (wrds == 0) {
|
||||
sprintf(buf, "%d byte%s",
|
||||
nundef, nundef == 1 ? "" : "s");
|
||||
}
|
||||
else if (left == 0 && right == 0) {
|
||||
sprintf(buf, "%d word%s",
|
||||
wrds, wrds == 1 ? "" : "s");
|
||||
}
|
||||
else if (left == 0) {
|
||||
sprintf(buf, "%d word%s + %d byte%s",
|
||||
wrds, wrds == 1 ? "" : "s",
|
||||
right, right == 1 ? "" : "s");
|
||||
}
|
||||
else if (right == 0) {
|
||||
sprintf(buf, "%d byte%s + %d word%s",
|
||||
left, left == 1 ? "" : "s",
|
||||
wrds, wrds == 1 ? "" : "s");
|
||||
}
|
||||
else {
|
||||
sprintf(buf, "%d byte%s + %d word%s + %d byte%s",
|
||||
left, left == 1 ? "" : "s",
|
||||
wrds, wrds == 1 ? "" : "s",
|
||||
right, right == 1 ? "" : "s");
|
||||
}
|
||||
return buf;
|
||||
}
|
||||
|
||||
PRIVATE char *
|
||||
displ_fil(fil) /* transient */
|
||||
ptr fil;
|
||||
{ /* Returns a buffer containing a representation of the
|
||||
filename derived from FIL-value fil.
|
||||
*/
|
||||
static char buf[40];
|
||||
char *bp = &buf[0];
|
||||
int ch;
|
||||
|
||||
if (!fil)
|
||||
return "NULL";
|
||||
if (fil >= HB)
|
||||
return "***NOT IN GDA***";
|
||||
|
||||
*bp++ = '"';
|
||||
while (in_gda(fil) && (ch = data_loc(fil))) {
|
||||
if (bp < &buf[sizeof buf-1]) {
|
||||
*bp++ = (ch < 040 || ch > 126 ? '?' : ch);
|
||||
}
|
||||
fil++;
|
||||
}
|
||||
if (bp < &buf[sizeof buf-1])
|
||||
*bp++ = '"';
|
||||
*bp++ = '\0';
|
||||
return &buf[0];
|
||||
}
|
||||
|
||||
PRIVATE char *
|
||||
displ_sh(shadow, byte) /* transient */
|
||||
char shadow;
|
||||
int byte;
|
||||
{ /* Returns a buffer containing a description of the
|
||||
shadow byte.
|
||||
*/
|
||||
static char buf[32];
|
||||
register char *bufp;
|
||||
int check = 0;
|
||||
|
||||
bufp = buf;
|
||||
if (shadow & SH_INT) {
|
||||
*bufp++ = 'I';
|
||||
*bufp++ = 'n';
|
||||
check++;
|
||||
}
|
||||
if (shadow & SH_FLOAT) {
|
||||
*bufp++ = 'F';
|
||||
*bufp++ = 'l';
|
||||
}
|
||||
if (shadow & SH_DATAP) {
|
||||
*bufp++ = 'D';
|
||||
*bufp++ = 'p';
|
||||
}
|
||||
if (shadow & SH_INSP) {
|
||||
*bufp++ = 'I';
|
||||
*bufp++ = 'p';
|
||||
}
|
||||
|
||||
if (shadow & SH_PROT) {
|
||||
*bufp++ = ',';
|
||||
*bufp++ = ' ';
|
||||
*bufp++ = 'P';
|
||||
*bufp++ = 'r';
|
||||
*bufp++ = 'o';
|
||||
*bufp++ = 't';
|
||||
}
|
||||
|
||||
if (check && isascii(byte) && isprint(byte)) {
|
||||
*bufp++ = ',';
|
||||
*bufp++ = ' ';
|
||||
*bufp++ = byte;
|
||||
*bufp++ = ' ';
|
||||
}
|
||||
*bufp = 0;
|
||||
return (buf);
|
||||
}
|
||||
|
||||
#endif LOGGING
|
||||
|
||||
13
util/int/e.out.h
Normal file
13
util/int/e.out.h
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
/* $Header$ */
|
||||
|
||||
#define MAGIC 07255
|
||||
|
||||
#define VERSION 3
|
||||
|
||||
#define FB_TEST 001
|
||||
#define FB_PROFILE 002
|
||||
#define FB_FLOW 004
|
||||
#define FB_COUNT 010
|
||||
#define FB_REALS 020
|
||||
#define FB_EXTRA 040
|
||||
|
||||
55
util/int/fra.c
Normal file
55
util/int/fra.c
Normal file
|
|
@ -0,0 +1,55 @@
|
|||
/* $Header$ */
|
||||
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "fra.h"
|
||||
#include "alloc.h"
|
||||
|
||||
#ifdef LOGGING
|
||||
char *FRA_sh; /* shadowbytes */
|
||||
#endif LOGGING
|
||||
|
||||
init_FRA() {
|
||||
FRA = Malloc(FRALimit, "Function Return Area");
|
||||
#ifdef LOGGING
|
||||
FRA_sh = Malloc(FRALimit, "shadowspace for Function Return Area");
|
||||
#endif LOGGING
|
||||
FRA_def = UNDEFINED; /* set FRA illegal */
|
||||
}
|
||||
|
||||
pushFRA(sz)
|
||||
size sz;
|
||||
{
|
||||
register int i;
|
||||
|
||||
if (sz == 0)
|
||||
return;
|
||||
|
||||
st_inc(max(sz, wsize));
|
||||
for (i = 0; i < sz; i++) {
|
||||
stack_loc(SP + i) = FRA[i];
|
||||
#ifdef LOGGING
|
||||
st_sh(SP + i) = (i < FRASize ? FRA_sh[i] : UNDEFINED);
|
||||
#endif LOGGING
|
||||
}
|
||||
}
|
||||
|
||||
popFRA(sz)
|
||||
size sz;
|
||||
{
|
||||
register int i;
|
||||
|
||||
if (sz == 0)
|
||||
return;
|
||||
|
||||
for (i = 0; i < sz; i++) {
|
||||
FRA[i] = stack_loc(SP + i);
|
||||
#ifdef LOGGING
|
||||
FRA_sh[i] = st_sh(SP + i);
|
||||
#endif LOGGING
|
||||
}
|
||||
st_dec(max(sz, wsize));
|
||||
}
|
||||
|
||||
18
util/int/fra.h
Normal file
18
util/int/fra.h
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
/*
|
||||
Concerning the Function Return Area
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "logging.h"
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
extern char *FRA_sh; /* shadowbytes of Function Return Area */
|
||||
#define spoilFRA() { FRA_def = UNDEFINED; }
|
||||
|
||||
#else
|
||||
|
||||
#define spoilFRA()
|
||||
|
||||
#endif LOGGING
|
||||
71
util/int/global.c
Normal file
71
util/int/global.c
Normal file
|
|
@ -0,0 +1,71 @@
|
|||
/*
|
||||
Definitions of the externs in global.h.
|
||||
Could be generated.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "global.h"
|
||||
|
||||
|
||||
/******** EM Machine capacity parameters ********/
|
||||
|
||||
size wsize;
|
||||
size dwsize;
|
||||
size psize;
|
||||
long i_minsw;
|
||||
long i_maxsw;
|
||||
unsigned long i_maxuw;
|
||||
long min_off;
|
||||
long max_off;
|
||||
ptr max_addr;
|
||||
|
||||
|
||||
/******** EM program parameters ********/
|
||||
|
||||
ptr ML;
|
||||
ptr HB;
|
||||
ptr DB;
|
||||
long NProc;
|
||||
long PreIgnMask;
|
||||
|
||||
|
||||
/******** EM machine registers ********/
|
||||
|
||||
|
||||
long PI;
|
||||
ptr PC;
|
||||
|
||||
ptr HP;
|
||||
ptr SP;
|
||||
ptr LB;
|
||||
ptr AB;
|
||||
|
||||
long ES;
|
||||
int ES_def;
|
||||
|
||||
int OnTrap;
|
||||
long IgnMask;
|
||||
long TrapPI;
|
||||
|
||||
char *FRA;
|
||||
size FRALimit;
|
||||
size FRASize;
|
||||
int FRA_def;
|
||||
|
||||
|
||||
/******** The EM Machine Memory ********/
|
||||
|
||||
char *text;
|
||||
|
||||
char *data;
|
||||
ptr HL;
|
||||
|
||||
char *stack;
|
||||
ptr SL;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
154
util/int/global.h
Normal file
154
util/int/global.h
Normal file
|
|
@ -0,0 +1,154 @@
|
|||
/*
|
||||
Defines and externs of general interest
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
|
||||
/********* PRIVATE/static *********/
|
||||
|
||||
#define PRIVATE static /* or not */
|
||||
|
||||
|
||||
/********* The internal data types ********/
|
||||
|
||||
#define UNSIGNED /* the normal case */
|
||||
#ifdef UNSIGNED
|
||||
|
||||
/* The EM pointer is an abstract type and requires explicit conversion*/
|
||||
typedef unsigned long ptr; /* pointer to EM address */
|
||||
#define p2i(p) (p) /* convert pointer to index */
|
||||
#define i2p(p) (ptr)(p) /* convert index to pointer */
|
||||
|
||||
#else UNSIGNED
|
||||
|
||||
typedef char *ptr; /* pointer to EM address */
|
||||
#define p2i(p) (long)(p) /* convert pointer to index */
|
||||
#define i2p(p) (ptr)(p) /* convert index to pointer */
|
||||
|
||||
#endif UNSIGNED
|
||||
|
||||
/* The EM size is an integer type; a cast suffices */
|
||||
typedef long size;
|
||||
|
||||
|
||||
/********* Mathematical constants ********/
|
||||
|
||||
#define I_MAXU1 255L
|
||||
#define I_MAXS1 127L
|
||||
#define I_MINS1 (-127L-1L)
|
||||
|
||||
#define I_MAXU2 65535L
|
||||
#define I_MAXS2 32767L
|
||||
#define I_MINS2 (-32767L-1L)
|
||||
|
||||
#define I_MAXU4 4294967295L
|
||||
#define I_MAXS4 2147483647L
|
||||
#define I_MINS4 (-2147483647L-1L)
|
||||
|
||||
#define FL_MAXU1 255.0
|
||||
#define FL_MAXS1 127.0
|
||||
#define FL_MINS1 -128.0
|
||||
|
||||
#define FL_MAXU2 65535.0
|
||||
#define FL_MAXS2 32767.0
|
||||
#define FL_MINS2 -32768.0
|
||||
|
||||
#define FL_MAXU4 4294967295.0
|
||||
#define FL_MAXS4 2147483647.0
|
||||
#define FL_MINS4 -2147483648.0
|
||||
|
||||
#define BIT(n) (1L<<(n))
|
||||
|
||||
#define SIGNBIT1 BIT(7) /* Signbit of one byte signed int */
|
||||
#define SIGNBIT2 BIT(15) /* Signbit of two byte signed int */
|
||||
#define SIGNBIT4 BIT(31) /* Signbit of four byte signed int */
|
||||
|
||||
#define MASK1 0xFF /* To mask one byte */
|
||||
#define MASK2 0xFFFF /* To mask two bytes */
|
||||
|
||||
|
||||
/******** Machine constants ********/
|
||||
|
||||
#define MAX_OFF2 I_MAXS2
|
||||
#define MAX_OFF4 I_MAXS4
|
||||
|
||||
|
||||
/******** EM machine data sizes ********/
|
||||
|
||||
#define FRALIMIT 8L /* Default limit */
|
||||
#define LINSIZE 4L /* Fixed size of LIN number */
|
||||
|
||||
|
||||
/******** EM Machine capacity parameters ********/
|
||||
|
||||
extern size wsize; /* wordsize */
|
||||
extern size dwsize; /* double wordsize */
|
||||
extern size psize; /* pointersize */
|
||||
extern long i_minsw; /* Min. value for signed integer of wsize */
|
||||
extern long i_maxsw; /* Max. value for signed integer of wsize */
|
||||
extern unsigned long i_maxuw; /* Max. value for unsigned integer of wsize */
|
||||
extern long min_off; /* Minimum offset */
|
||||
extern long max_off; /* Maximum offset */
|
||||
extern ptr max_addr; /* Maximum address */
|
||||
|
||||
|
||||
/******** EM program parameters ********/
|
||||
|
||||
extern ptr ML; /* Memory Limit */
|
||||
extern ptr HB; /* Heap Base */
|
||||
extern ptr DB; /* Procedure Descriptor Base, end of text */
|
||||
extern long NProc; /* Number of Procedure Descriptors */
|
||||
extern long PreIgnMask; /* Preset Ignore Mask, from command line */
|
||||
|
||||
|
||||
/******** EM machine registers ********/
|
||||
|
||||
#define UNDEFINED (0)
|
||||
#define DEFINED (1)
|
||||
|
||||
extern long PI; /* Procedure Identifier of running proc */
|
||||
extern ptr PC; /* Program Counter */
|
||||
|
||||
extern ptr HP; /* Heap Pointer */
|
||||
extern ptr SP; /* Stack Pointer */
|
||||
extern ptr LB; /* Local Base */
|
||||
extern ptr AB; /* Actual Base */
|
||||
|
||||
extern long ES; /* program Exit Status */
|
||||
extern int ES_def; /* set iff Exit Status legal */
|
||||
|
||||
#define TR_ABORT (1)
|
||||
#define TR_HALT (2)
|
||||
#define TR_TRAP (3)
|
||||
extern int OnTrap; /* what to do upon trap */
|
||||
extern long IgnMask; /* Ignore Mask for traps */
|
||||
extern long TrapPI; /* Procedure Identifier of trap routine */
|
||||
|
||||
extern char *FRA; /* Function Return Area */
|
||||
extern size FRALimit; /* Function Return Area maximum Size */
|
||||
extern size FRASize; /* Function Return Area actual Size */
|
||||
extern int FRA_def; /* set iff Function Return Area legal */
|
||||
|
||||
|
||||
/******** The EM Machine Memory ********/
|
||||
|
||||
extern char *text; /* program text & procedure descriptors */
|
||||
|
||||
extern char *data; /* global data & heap space */
|
||||
extern ptr HL; /* Heap Limit */
|
||||
|
||||
extern char *stack; /* stack space and local data */
|
||||
extern ptr SL; /* Stack Limit */
|
||||
|
||||
|
||||
/********* Global inline functions ********/
|
||||
|
||||
#define btol(c) (long)((c) & MASK1)
|
||||
#define btou(c) (unsigned int)((c) & MASK1)
|
||||
#define btos(c) (c)
|
||||
|
||||
#define max(i,j) (((i) > (j)) ? (i) : (j))
|
||||
#define min(i,j) (((i) < (j)) ? (i) : (j))
|
||||
|
||||
|
||||
202
util/int/init.c
Normal file
202
util/int/init.c
Normal file
|
|
@ -0,0 +1,202 @@
|
|||
/*
|
||||
Startup routines
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "alloc.h"
|
||||
#include "warn.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "trap.h"
|
||||
#include "read.h"
|
||||
|
||||
|
||||
/****************************************************************
|
||||
* The EM-machine is not implemented as a contiguous *
|
||||
* piece of memory. Instead there are a number of *
|
||||
* "floating" pieces of memory, each representing a *
|
||||
* specific part of the machine. There are separate *
|
||||
* allocations for: *
|
||||
* - stack and local area (stack), *
|
||||
* - heap area & global data area (data), *
|
||||
* - program text & procedure descriptors (text). *
|
||||
* The names in parenthesis are the names of the global *
|
||||
* variables used within our program, pointing to *
|
||||
* the beginning of such an area. The sizes of the global *
|
||||
* data area and the program text can be determined *
|
||||
* once and for all in the "rd_header" routine. *
|
||||
****************************************************************/
|
||||
|
||||
extern char **environ;
|
||||
|
||||
PRIVATE ptr storestring();
|
||||
PRIVATE size alignedstrlen();
|
||||
|
||||
char *load_name;
|
||||
|
||||
init(ac, av)
|
||||
int ac;
|
||||
char **av;
|
||||
{
|
||||
register char **p;
|
||||
register size env_vec_size; /* size of environ vector */
|
||||
register size arg_vec_size; /* size of argument vector */
|
||||
register size string_size = 0; /* total size arg, env, strings */
|
||||
register ptr ARGB, vecp, strp;
|
||||
|
||||
init_ofiles(1); /* Initialize all output files */
|
||||
init_signals();
|
||||
|
||||
/* Read the load file header, to obtain wsize and psize */
|
||||
load_name = av[0];
|
||||
rd_open(load_name); /* Open object file */
|
||||
|
||||
rd_header(); /* Read in load file header */
|
||||
|
||||
/* Initialize wsize- and psize-dependent variables */
|
||||
|
||||
init_rsb();
|
||||
i_minsw = (wsize == 2) ? I_MINS2 : I_MINS4;
|
||||
i_maxsw = (wsize == 2) ? I_MAXS2 : I_MAXS4;
|
||||
i_maxuw = (wsize == 2) ? I_MAXU2 : I_MAXU4;
|
||||
max_addr = i2p(((psize == 2) ? I_MAXU2 : I_MAXS4) / wsize * wsize) - 1;
|
||||
min_off = (psize == 2) ? (-MAX_OFF2-1) : (-MAX_OFF4-1);
|
||||
max_off = (psize == 2) ? MAX_OFF2 : MAX_OFF4;
|
||||
|
||||
/* Determine nr of bytes, needed to store arguments/environment */
|
||||
|
||||
env_vec_size = 0; /* length of environ vector copy */
|
||||
for (p = environ; *p != (char *) 0; p++) {
|
||||
string_size += alignedstrlen(*p);
|
||||
env_vec_size += psize;
|
||||
}
|
||||
env_vec_size += psize; /* terminating zero */
|
||||
|
||||
arg_vec_size = 0; /* length of argument vector copy */
|
||||
for (p = av; *p != (char *) 0; p++) {
|
||||
string_size += alignedstrlen(*p);
|
||||
arg_vec_size += psize;
|
||||
}
|
||||
arg_vec_size += psize; /* terminating zero */
|
||||
|
||||
/* One pseudo-register */
|
||||
ARGB = i2p(SZDATA); /* command arguments base */
|
||||
|
||||
/* Initialize segments */
|
||||
init_text();
|
||||
init_data(ARGB + arg_vec_size + env_vec_size + string_size);
|
||||
init_stack();
|
||||
init_FRA();
|
||||
init_AB_list();
|
||||
|
||||
/* Initialize trap registers */
|
||||
TrapPI = 0; /* set Trap Procedure Identifier */
|
||||
OnTrap = TR_ABORT; /* there cannot be a trap handler yet*/
|
||||
IgnMask = PreIgnMask; /* copy Ignore Mask from preset */
|
||||
|
||||
/* Initialize Exit Status */
|
||||
ES_def = UNDEFINED; /* set Exit Status illegal */
|
||||
|
||||
/* Read partitions */
|
||||
|
||||
rd_text();
|
||||
rd_gda();
|
||||
rd_proctab();
|
||||
|
||||
rd_close();
|
||||
|
||||
/* Set up the arguments and environment */
|
||||
|
||||
vecp = ARGB; /* start of environ vector copy */
|
||||
dppush(vecp); /* push address of env pointer */
|
||||
strp = vecp + env_vec_size; /* start of environ strings */
|
||||
for (p = environ; *p != (char *) 0; p++) {
|
||||
dt_stdp(vecp, strp);
|
||||
strp = storestring(strp, *p);
|
||||
vecp += psize;
|
||||
}
|
||||
dt_stdp(vecp, i2p(0)); /* terminating zero */
|
||||
|
||||
vecp = strp; /* start of argument vector copy */
|
||||
dppush(vecp); /* push address of argv pointer */
|
||||
strp = vecp + arg_vec_size; /* start of argument strings */
|
||||
for (p = av; *p != (char *) 0; p++) {
|
||||
dt_stdp(vecp, strp);
|
||||
strp = storestring(strp, *p);
|
||||
vecp += psize;
|
||||
}
|
||||
dt_stdp(vecp, i2p(0)); /* terminating zero */
|
||||
|
||||
npush((long) ac, wsize); /* push argc */
|
||||
}
|
||||
|
||||
PRIVATE size alignedstrlen(s)
|
||||
char *s;
|
||||
{
|
||||
register size len = strlen(s) + 1;
|
||||
|
||||
return (len + wsize - 1) / wsize * wsize;
|
||||
}
|
||||
|
||||
PRIVATE ptr storestring(addr, s)
|
||||
ptr addr;
|
||||
char *s;
|
||||
{
|
||||
/* Store string, aligned to a fit multiple of wsize bytes.
|
||||
Return first address on a wordsize boundary after string.
|
||||
*/
|
||||
register size oldlen = strlen(s) + 1;
|
||||
register size newlen = ((oldlen + wsize - 1) / wsize) * wsize;
|
||||
register long i;
|
||||
|
||||
LOG(("@g6 storestring(%lu, %s), oldlen = %ld, newlen = %ld",
|
||||
addr, s, oldlen, newlen));
|
||||
ch_in_data(addr, newlen);
|
||||
ch_aligned(addr, newlen);
|
||||
|
||||
/* copy data of source string */
|
||||
for (i = 0; i < oldlen; i++) {
|
||||
data_loc(addr + i) = *s++;
|
||||
dt_int(addr + i);
|
||||
}
|
||||
/* pad until newlen */
|
||||
for (; i < newlen; i++) {
|
||||
data_loc(addr + i) = (char) 0;
|
||||
dt_int(addr + i);
|
||||
}
|
||||
return (addr + i);
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
dt_clear_area(from, to)
|
||||
ptr from;
|
||||
ptr to;
|
||||
{
|
||||
/* includes *from but excludes *to */
|
||||
register ptr a;
|
||||
|
||||
for (a = from; a < to; a++) {
|
||||
dt_undef(a);
|
||||
}
|
||||
}
|
||||
|
||||
st_clear_area(from, to)
|
||||
ptr from;
|
||||
ptr to;
|
||||
{
|
||||
/* includes both *from and *to (since ML+1 is unexpressible) */
|
||||
register ptr a;
|
||||
|
||||
for (a = from; a >= to; a--) {
|
||||
st_undef(a);
|
||||
}
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
205
util/int/io.c
Normal file
205
util/int/io.c
Normal file
|
|
@ -0,0 +1,205 @@
|
|||
/*
|
||||
In and output, error messages, etc.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
#include <varargs.h>
|
||||
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "mem.h"
|
||||
#include "linfil.h"
|
||||
|
||||
extern char *sprintf();
|
||||
extern _doprnt();
|
||||
|
||||
extern int running; /* from main.c */
|
||||
extern char *prog_name; /* from main.c */
|
||||
extern char *load_name; /* from init.c */
|
||||
|
||||
/******** The message file ********/
|
||||
|
||||
extern char mess_file[64]; /* from main.c */
|
||||
long mess_id; /* Id, to determine unique mess file */
|
||||
FILE *mess_fp; /* Filepointer of message file */
|
||||
|
||||
PRIVATE do_fatal();
|
||||
|
||||
incr_mess_id()
|
||||
{ /* for a new child */
|
||||
mess_id++;
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
extern long inr; /* from log.c */
|
||||
#endif LOGGING
|
||||
|
||||
/******** General file handling ********/
|
||||
|
||||
PRIVATE int highestfd();
|
||||
|
||||
int fd_limit = 100; /* first non-available file descriptor */
|
||||
|
||||
FILE *fcreat_high(fn)
|
||||
char *fn;
|
||||
{
|
||||
/* Creates an unbuffered FILE with name fn on the highest
|
||||
possible file descriptor.
|
||||
*/
|
||||
register int fd;
|
||||
register FILE *fp;
|
||||
|
||||
if ((fd = creat(fn, 0644)) == -1)
|
||||
return NULL;
|
||||
fd = highestfd(fd);
|
||||
if ((fp = fdopen(fd, "w")) == NULL)
|
||||
return NULL;
|
||||
setbuf(fp, (char *) 0); /* unbuffered! */
|
||||
fd_limit = fd;
|
||||
return fp;
|
||||
}
|
||||
|
||||
PRIVATE int highestfd(fd)
|
||||
int fd;
|
||||
{
|
||||
/* Moves the (open) file descriptor fd to the highest available
|
||||
position and returns the new fd. Does this without knowing
|
||||
how many fd-s are available.
|
||||
*/
|
||||
register int newfd, higherfd;
|
||||
|
||||
/* try to get a better fd */
|
||||
newfd = dup(fd);
|
||||
if (newfd < 0) {
|
||||
return fd;
|
||||
}
|
||||
if (newfd > 99) {
|
||||
/* for systems with an unlimited supply of file descriptors */
|
||||
close(newfd);
|
||||
return fd;
|
||||
}
|
||||
|
||||
/* occupying the new fd, try to do even better */
|
||||
higherfd = highestfd(newfd);
|
||||
close(fd);
|
||||
return higherfd; /* this is a deep one */
|
||||
}
|
||||
|
||||
init_ofiles(firsttime)
|
||||
int firsttime;
|
||||
{
|
||||
if (!firsttime) {
|
||||
fclose(mess_fp); /* old message file */
|
||||
mess_fp = 0;
|
||||
sprintf(mess_file, "%s_%ld", mess_file, mess_id);
|
||||
}
|
||||
|
||||
/* Create messagefile */
|
||||
if ((mess_fp = fcreat_high(mess_file)) == NULL)
|
||||
fatal("Cannot create messagefile '%s'", mess_file);
|
||||
init_wmsg();
|
||||
|
||||
mess_id = 1; /* ID of next child */
|
||||
|
||||
#ifdef LOGGING
|
||||
open_log(firsttime);
|
||||
#endif LOGGING
|
||||
}
|
||||
|
||||
/*VARARGS0*/
|
||||
fatal(va_alist)
|
||||
va_dcl
|
||||
{
|
||||
va_list ap;
|
||||
|
||||
fprintf(stderr, "%s: ", prog_name);
|
||||
|
||||
va_start(ap);
|
||||
{
|
||||
register char *fmt = va_arg(ap, char *);
|
||||
do_fatal(stderr, fmt, ap);
|
||||
}
|
||||
va_end(ap);
|
||||
|
||||
if (mess_fp) {
|
||||
va_start(ap);
|
||||
{
|
||||
register char *fmt = va_arg(ap, char *);
|
||||
do_fatal(mess_fp, fmt, ap);
|
||||
}
|
||||
va_end(ap);
|
||||
}
|
||||
|
||||
if (running)
|
||||
core_dump();
|
||||
|
||||
close_down(1);
|
||||
}
|
||||
|
||||
close_down(rc)
|
||||
int rc;
|
||||
{
|
||||
/* all exits should go through here */
|
||||
if (mess_fp) {
|
||||
fclose(mess_fp);
|
||||
mess_fp = 0;
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
close_log();
|
||||
#endif LOGGING
|
||||
|
||||
exit(rc);
|
||||
}
|
||||
|
||||
PRIVATE do_fatal(fp, fmt, ap)
|
||||
FILE *fp;
|
||||
char *fmt;
|
||||
va_list ap;
|
||||
{
|
||||
fprintf(fp, "(Fatal error) ");
|
||||
if (load_name)
|
||||
fprintf(fp, "%s: ", load_name);
|
||||
_doprnt(fmt, ap, fp);
|
||||
fputc('\n', fp);
|
||||
}
|
||||
|
||||
/*VARARGS0*/
|
||||
message(va_alist)
|
||||
va_dcl
|
||||
{
|
||||
va_list ap;
|
||||
|
||||
fprintf(mess_fp, "(Message): ");
|
||||
|
||||
va_start(ap);
|
||||
{
|
||||
register char *fmt = va_arg(ap, char *);
|
||||
_doprnt(fmt, ap, mess_fp);
|
||||
}
|
||||
va_end(ap);
|
||||
|
||||
fprintf(mess_fp, " at %s\n", position());
|
||||
}
|
||||
|
||||
char *position() /* transient */
|
||||
{
|
||||
static char buff[300];
|
||||
register char *fn = dt_fname(getFIL());
|
||||
|
||||
#ifdef LOGGING
|
||||
sprintf(buff, "\"%s\", line %ld, INR = %ld", fn, getLIN(), inr);
|
||||
#else LOGGING
|
||||
sprintf(buff, "\"%s\", line %ld", fn, getLIN());
|
||||
#endif LOGGING
|
||||
return buff;
|
||||
}
|
||||
|
||||
char *dt_fname(p)
|
||||
ptr p;
|
||||
{
|
||||
return (p ? &data_loc(p) : "<unknown>");
|
||||
}
|
||||
|
||||
20
util/int/linfil.h
Normal file
20
util/int/linfil.h
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
/*
|
||||
This file includes all (the arbitrary) details of the implementation
|
||||
of the present line number and file name in the EM machine.
|
||||
|
||||
For efficiency reasons the EM machine keeps its own copies of the
|
||||
file name and the line number.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
/* these should be EM machine registers */
|
||||
extern long LIN;
|
||||
extern ptr FIL; /* address in data[] */
|
||||
|
||||
#define getLIN() (LIN)
|
||||
#define getFIL() (FIL)
|
||||
|
||||
extern char *dt_fname();
|
||||
extern char *position();
|
||||
|
||||
319
util/int/log.c
Normal file
319
util/int/log.c
Normal file
|
|
@ -0,0 +1,319 @@
|
|||
/*
|
||||
The logging machine
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
#include <varargs.h>
|
||||
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "linfil.h"
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
extern char *sprintf();
|
||||
extern int strlen();
|
||||
extern char *strcpy();
|
||||
|
||||
extern long mess_id; /* from io.c */
|
||||
extern FILE *fcreat_high(); /* from io.c */
|
||||
|
||||
/******** The Logging Machine Variables ********/
|
||||
|
||||
extern long atol();
|
||||
|
||||
long inr; /* current instruction number */
|
||||
|
||||
int must_log; /* set if logging may be required */
|
||||
long log_start; /* first instruction to be logged */
|
||||
int logging; /* set as soon as logging starts */
|
||||
|
||||
PRIVATE long stop; /* inr after which to stop */
|
||||
PRIVATE long gdump; /* inr at which to dump GDA */
|
||||
PRIVATE ptr gmin, gmax; /* GDA dump limits */
|
||||
PRIVATE long hdump; /* inr at which to dump the heap */
|
||||
PRIVATE long stdsize; /* optional size of stack dump */
|
||||
PRIVATE int stdrawflag; /* set if unformatted stack dump */
|
||||
|
||||
PRIVATE char log_file[64] = "int.log"; /* Name of log file */
|
||||
PRIVATE long at; /* patch to set log_start */
|
||||
PRIVATE char *lmask; /* patch to set logmask */
|
||||
PRIVATE char *logvar; /* Name of LOG variable */
|
||||
PRIVATE int log_level[128]; /* Holds the log levels */
|
||||
PRIVATE FILE *log_fp; /* Filepointer of log file */
|
||||
|
||||
/* arguments for the logging machine */
|
||||
PRIVATE int argcount;
|
||||
PRIVATE char *arglist[20]; /* arbitrary size */
|
||||
|
||||
PRIVATE char *getpar();
|
||||
PRIVATE long longpar();
|
||||
PRIVATE set_lmask();
|
||||
|
||||
int logarg(str)
|
||||
char *str;
|
||||
{
|
||||
/* If the string might be an interesting argument for the
|
||||
logging machine, it is stored in the arglist, and logarg
|
||||
succeeds. Otherwise it fails.
|
||||
|
||||
The string is interesting if it contains a '='.
|
||||
*/
|
||||
register char *arg = str;
|
||||
register char ch;
|
||||
|
||||
while ((ch = *arg) && (ch != '=')) {
|
||||
arg++;
|
||||
}
|
||||
if (ch == '=') {
|
||||
if (argcount == (sizeof arglist /sizeof arglist[0]))
|
||||
fatal("too many logging arguments on command line");
|
||||
arglist[argcount++] = str;
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
init_log()
|
||||
{
|
||||
/* setting the logging machine */
|
||||
|
||||
stop = longpar("STOP", 0L);
|
||||
gdump = longpar("GDA", 0L);
|
||||
if (gdump) {
|
||||
gmin = i2p(longpar("GMIN", 0L));
|
||||
gmax = i2p(longpar("GMAX", 0L));
|
||||
set_lmask("+1");
|
||||
}
|
||||
hdump = longpar("HEAP", 0L);
|
||||
if (hdump) {
|
||||
set_lmask("*1");
|
||||
}
|
||||
stdsize = longpar("STDSIZE", 0L);
|
||||
stdrawflag = longpar("RAWSTACK", 0L);
|
||||
|
||||
if (getpar("LOGFILE")) {
|
||||
strcpy(log_file, getpar("LOGFILE"));
|
||||
}
|
||||
|
||||
if ((at = longpar("AT", 0L))) {
|
||||
/* abbreviation for: */
|
||||
stop = at + 1; /* stop AFTER at + 1 */
|
||||
/* Note: the setting of log_start is deferred to
|
||||
init_ofiles(1), for implementation reasons. The
|
||||
AT-variable presently only works for the top
|
||||
level.
|
||||
*/
|
||||
}
|
||||
|
||||
if ((lmask = getpar("L"))) {
|
||||
/* abbreviation for: */
|
||||
log_start = 0;
|
||||
must_log = 1;
|
||||
}
|
||||
|
||||
inr = 0;
|
||||
}
|
||||
|
||||
|
||||
/******** The log file ********/
|
||||
|
||||
open_log(firsttime)
|
||||
int firsttime;
|
||||
{
|
||||
if (!firsttime) {
|
||||
sprintf(logvar, "%s%ld", logvar, mess_id);
|
||||
if (log_fp) {
|
||||
fclose(log_fp);
|
||||
log_fp = 0;
|
||||
}
|
||||
logging = 0;
|
||||
if ((must_log = getpar(logvar) != 0)) {
|
||||
sprintf(log_file, "%s%ld", log_file, mess_id);
|
||||
log_start = atol(getpar(logvar));
|
||||
}
|
||||
}
|
||||
else {
|
||||
/* first time, top level */
|
||||
logvar = "LOG\0 ";
|
||||
|
||||
if (at) { /* patch */
|
||||
must_log = 1;
|
||||
log_start = at - 1;
|
||||
}
|
||||
else
|
||||
if (!must_log && (must_log = getpar(logvar) != 0)) {
|
||||
log_start = atoi(getpar(logvar));
|
||||
}
|
||||
|
||||
set_lmask(lmask ? lmask :
|
||||
getpar("LOGMASK") ? getpar("LOGMASK") :
|
||||
"A-Z9d2twx9");
|
||||
}
|
||||
|
||||
/* Create logfile if needed */
|
||||
if (must_log) {
|
||||
if ((log_fp = fcreat_high(log_file)) == NULL)
|
||||
fatal("Cannot create logfile '%s'", log_file);
|
||||
}
|
||||
|
||||
if (must_log && inr >= log_start) {
|
||||
logging = 1;
|
||||
}
|
||||
}
|
||||
|
||||
close_log() {
|
||||
if (log_fp) {
|
||||
fclose(log_fp);
|
||||
log_fp = 0;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
/******** The logmask ********/
|
||||
|
||||
#define inrange(c,l,h) (l <= c && c <= h)
|
||||
#define layout(c) (c == ' ' || c == '\t' || c == ',')
|
||||
|
||||
PRIVATE set_lmask(mask)
|
||||
char *mask;
|
||||
{
|
||||
register char *mp = mask;
|
||||
|
||||
while (*mp != 0) {
|
||||
register char *lvp;
|
||||
register int lev;
|
||||
|
||||
while (layout(*mp)) {
|
||||
mp++;
|
||||
}
|
||||
/* find level */
|
||||
lvp = mp;
|
||||
while (*lvp != 0 && !inrange(*lvp, '0', '9')) {
|
||||
lvp++;
|
||||
}
|
||||
lev = *lvp - '0';
|
||||
/* find classes */
|
||||
while (mp != lvp) {
|
||||
register mc = *mp;
|
||||
|
||||
if ( inrange(mc, 'a', 'z')
|
||||
|| inrange(mc, 'A', 'Z')
|
||||
|| mc == '+'
|
||||
|| mc == '*'
|
||||
) {
|
||||
log_level[mc] = lev;
|
||||
mp++;
|
||||
}
|
||||
else if (mc == '-') {
|
||||
register char c;
|
||||
|
||||
for (c = *(mp-1) + 1; c <= *(mp + 1); c++) {
|
||||
log_level[c] = lev;
|
||||
}
|
||||
mp += 2;
|
||||
}
|
||||
else if (layout(mc)) {
|
||||
mp++;
|
||||
}
|
||||
else fatal("Bad logmask initialization string");
|
||||
}
|
||||
mp = lvp + 1;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/******** The logging ********/
|
||||
|
||||
int check_log(mark)
|
||||
char mark[];
|
||||
{
|
||||
/* mark must be of the form ".CL...", C is class letter,
|
||||
L is level digit.
|
||||
*/
|
||||
if (!logging)
|
||||
return 0;
|
||||
|
||||
return ((mark[2] - '0') <= log_level[mark[1]]);
|
||||
}
|
||||
|
||||
/*VARARGS*/
|
||||
do_log(va_alist)
|
||||
va_dcl
|
||||
{
|
||||
va_list ap;
|
||||
|
||||
va_start(ap);
|
||||
{
|
||||
char *fmt = va_arg(ap, char *);
|
||||
|
||||
if (!check_log(fmt))
|
||||
return;
|
||||
|
||||
if (fmt[0] == '@') {
|
||||
/* include position */
|
||||
fprintf(log_fp, "%.4s%s, ", fmt, position());
|
||||
_doprnt(&fmt[4], ap, log_fp);
|
||||
}
|
||||
else {
|
||||
_doprnt(&fmt[0], ap, log_fp);
|
||||
}
|
||||
}
|
||||
va_end(ap);
|
||||
|
||||
putc('\n', log_fp);
|
||||
}
|
||||
|
||||
log_eoi()
|
||||
{
|
||||
/* Logging to be done at end of instruction */
|
||||
if (logging) {
|
||||
if (inr == gdump)
|
||||
gdad_all(gmin, gmax);
|
||||
if (inr == hdump)
|
||||
hpd_all();
|
||||
std_all(stdsize, stdrawflag);
|
||||
}
|
||||
|
||||
if (inr == stop) {
|
||||
message("program stopped on request");
|
||||
close_down(0);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/******** Service routines ********/
|
||||
|
||||
PRIVATE char *getpar(var)
|
||||
char *var;
|
||||
{
|
||||
/* Looks up the name in the argument list.
|
||||
*/
|
||||
register int count;
|
||||
register int ln = strlen(var);
|
||||
|
||||
for (count = 0; count < argcount; count++) {
|
||||
register char *arg = arglist[count];
|
||||
|
||||
if (strncmp(var, arg, ln) == 0 && arg[ln] == '=') {
|
||||
return &arg[ln+1];
|
||||
}
|
||||
}
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
PRIVATE long longpar(var, def)
|
||||
char *var; /* name of the variable */
|
||||
long def; /* default value */
|
||||
{
|
||||
register char *res = getpar(var);
|
||||
|
||||
return (res ? atol(res) : def);
|
||||
}
|
||||
|
||||
#endif LOGGING
|
||||
|
||||
24
util/int/log.h
Normal file
24
util/int/log.h
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
/*
|
||||
Defines and externs for the logging machine
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "logging.h"
|
||||
|
||||
/********* Logging control ********/
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
extern int must_log; /* set if logging must occur */
|
||||
extern long log_start; /* inr at start of logging */
|
||||
extern int logging; /* set if logging in progress */
|
||||
|
||||
#define LOG(a) { if (logging) do_log a; }
|
||||
|
||||
#else
|
||||
|
||||
#define LOG(a)
|
||||
|
||||
#endif LOGGING
|
||||
|
||||
4
util/int/logging.h
Normal file
4
util/int/logging.h
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
/* $Header$ */
|
||||
|
||||
#define LOGGING 1 /* Includes logging when defined */
|
||||
|
||||
301
util/int/m_ioctl.c
Normal file
301
util/int/m_ioctl.c
Normal file
|
|
@ -0,0 +1,301 @@
|
|||
/*
|
||||
Dedicated to the ioctl system call, MON 54.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "sysidf.h"
|
||||
#include "v7ioctl.h"
|
||||
#include "global.h"
|
||||
#include "mem.h"
|
||||
#include "warn.h"
|
||||
|
||||
#include <sgtty.h>
|
||||
|
||||
#ifdef V7IOCTL /* define the proper V7 requests */
|
||||
|
||||
#define V7IOGETP (('t'<<8)|8)
|
||||
#define V7IOSETP (('t'<<8)|9)
|
||||
#define V7IOSETN (('t'<<8)|10)
|
||||
#define V7IOEXCL (('t'<<8)|13)
|
||||
#define V7IONXCL (('t'<<8)|14)
|
||||
#define V7IOHPCL (('t'<<8)|2)
|
||||
#define V7IOFLUSH (('t'<<8)|16)
|
||||
|
||||
#define V7IOSETC (('t'<<8)|17)
|
||||
#define V7IOGETC (('t'<<8)|18)
|
||||
|
||||
#endif V7IOCTL
|
||||
|
||||
|
||||
/************************************************************************
|
||||
* do_ioctl handles all ioctl system calls. It is called by the *
|
||||
* moncall() routine, case 54. It was too big to leave it there. *
|
||||
* The ioctl system call is divided into 5 parts. *
|
||||
* Ioctl's dealing with respectively: *
|
||||
* sgttyb, tchars, local mode word, ltchars, and miscellaneous ioctl's. *
|
||||
* Some of the sgttyb-calls are only possible under the new tty-driver. *
|
||||
* All of these are to be found in the miscellaneous section. *
|
||||
* do_ioctl() simply returns the value ioctl() would return itself. *
|
||||
* (0 for success, -1 for failure) *
|
||||
***********************************************************************/
|
||||
|
||||
int do_ioctl(fd, req, addr)
|
||||
int fd, req;
|
||||
ptr addr;
|
||||
{
|
||||
register long e;
|
||||
struct sgttyb sg_buf;
|
||||
|
||||
#ifdef BSD_X /* from system.h */
|
||||
#ifndef V7IOCTL
|
||||
char c;
|
||||
int mask; /* will get ALIGNMENT problems with this one */
|
||||
long count; /* might get ALIGNMENT problems with this one */
|
||||
int ldisc; /* might get ALIGNMENT problems with this one */
|
||||
int pgrp; /* might get ALIGNMENT problems with this one */
|
||||
#endif V7IOCTL
|
||||
|
||||
struct tchars tc_buf;
|
||||
#ifndef V7IOCTL
|
||||
struct ltchars ltc_buf;
|
||||
#endif V7IOCTL
|
||||
#endif BSD_X
|
||||
|
||||
|
||||
#ifdef V7IOCTL
|
||||
switch (req) { /* translate the V7 requests */
|
||||
/* and reject the non-V7 ones */
|
||||
case V7IOGETP:
|
||||
req = TIOCGETP;
|
||||
break;
|
||||
case V7IOSETP:
|
||||
req = TIOCSETP;
|
||||
break;
|
||||
case V7IOEXCL:
|
||||
req = TIOCEXCL;
|
||||
break;
|
||||
case V7IONXCL:
|
||||
req = TIOCNXCL;
|
||||
break;
|
||||
case V7IOHPCL:
|
||||
req = TIOCHPCL;
|
||||
break;
|
||||
#ifdef BSD_X /* from system.h */
|
||||
case V7IOSETN:
|
||||
req = TIOCSETN;
|
||||
break;
|
||||
|
||||
case V7IOSETC:
|
||||
req = TIOCSETC;
|
||||
break;
|
||||
case V7IOGETC:
|
||||
req = TIOCGETC;
|
||||
break;
|
||||
#endif BSD_X
|
||||
|
||||
default:
|
||||
einval(WBADIOCTL);
|
||||
return (-1); /* Fake return value */
|
||||
}
|
||||
|
||||
#endif V7IOCTL
|
||||
|
||||
|
||||
switch (req) {
|
||||
|
||||
/*************************************/
|
||||
/****** Struct sgttyb ioctl's ********/
|
||||
/*************************************/
|
||||
|
||||
case TIOCGETP:
|
||||
/* Get fd's current param's and store at dsp2 */
|
||||
if ( (e = ioctl(fd, req, (char *) &sg_buf)) == -1
|
||||
|| !sgttyb2mem(addr, &sg_buf)
|
||||
) {
|
||||
e = -1; /* errno already set */
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCSETP:
|
||||
#ifdef BSD4_1 /* from system.h */
|
||||
case TIOCSETN:
|
||||
#endif BSD4_1
|
||||
/* set fd's parameters according to sgtty buffer */
|
||||
/* pointed to (addr), so first fill sg_buf properly. */
|
||||
if ( !mem2sgtty(addr, &sg_buf)
|
||||
|| (e = ioctl(fd, req, (char *) &sg_buf)) == -1
|
||||
) {
|
||||
e = -1; /* errno already set */
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCEXCL:
|
||||
case TIOCNXCL:
|
||||
case TIOCHPCL:
|
||||
/* These have no third argument. */
|
||||
e = ioctl(fd, req, (char *) 0);
|
||||
break;
|
||||
|
||||
#ifdef BSD_X /* from system.h */
|
||||
/*************************************/
|
||||
/****** Struct tchars ioctl's ********/
|
||||
/*************************************/
|
||||
|
||||
case TIOCGETC:
|
||||
/* get special char's; store at addr */
|
||||
if ( (e = ioctl(fd, req, (char *) &tc_buf)) == -1
|
||||
|| !tchars2mem(addr, &tc_buf)
|
||||
) {
|
||||
e = -1; /* errno already set */
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCSETC:
|
||||
/* set special char's; load from addr */
|
||||
if ( !mem2tchars(addr, &tc_buf)
|
||||
|| (e = ioctl(fd, req, (char *) &tc_buf)) == -1
|
||||
) {
|
||||
e = -1;
|
||||
}
|
||||
break;
|
||||
|
||||
#ifndef V7IOCTL
|
||||
/***************************************/
|
||||
/****** Local mode word ioctl's ********/
|
||||
/***************************************/
|
||||
|
||||
case TIOCLBIS: /* addr points to mask which is or-ed with lmw */
|
||||
case TIOCLBIC: /* addr points to mask, ~mask & lmw is done */
|
||||
case TIOCLSET: /* addr points to mask, lmw is replaced by it */
|
||||
if (memfault(addr, wsize)) {
|
||||
e = -1;
|
||||
}
|
||||
else {
|
||||
mask = mem_ldu(addr, wsize);
|
||||
e = ioctl(fd, req, (char *) &mask);
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCLGET: /* addr points to space, store lmw there */
|
||||
if ( memfault(addr, wsize)
|
||||
|| (e = ioctl(fd, req, (char *) &mask)) == -1
|
||||
) {
|
||||
e = -1;
|
||||
}
|
||||
else {
|
||||
mem_stn(addr, (long) mask, wsize);
|
||||
}
|
||||
break;
|
||||
|
||||
/**************************************/
|
||||
/****** Struct ltchars ioctl's ********/
|
||||
/**************************************/
|
||||
|
||||
case TIOCGLTC:
|
||||
/* get current ltc's; store at addr */
|
||||
if ( (e = ioctl(fd, req, (char *) <c_buf)) == -1
|
||||
|| !ltchars2mem(addr, <c_buf)
|
||||
) {
|
||||
e = -1; /* errno already set */
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCSLTC:
|
||||
/* set ltc_buf; load from addr */
|
||||
if ( !mem2ltchars(addr, <c_buf)
|
||||
|| (e = ioctl(fd, req, (char *) <c_buf)) == -1
|
||||
) {
|
||||
e = -1;
|
||||
}
|
||||
break;
|
||||
|
||||
/*************************************/
|
||||
/****** Miscellaneous ioctl's ********/
|
||||
/*************************************/
|
||||
|
||||
case TIOCGETD:
|
||||
/* Get line discipline, store at addr */
|
||||
if ( memfault(addr, wsize)
|
||||
|| (e = ioctl(fd, req, (char *) &ldisc)) == -1
|
||||
) {
|
||||
e = -1;
|
||||
}
|
||||
else {
|
||||
mem_stn(addr, (long) ldisc, wsize);
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCSETD:
|
||||
/* Set line discipline, load from addr */
|
||||
if (memfault(addr, wsize)) {
|
||||
e = -1;
|
||||
}
|
||||
else {
|
||||
ldisc = (int) mem_ldu(addr, wsize);
|
||||
e = ioctl(fd, req, (char *) &ldisc);
|
||||
}
|
||||
break;
|
||||
|
||||
/* The following are not standard vanilla 7 UNIX */
|
||||
case TIOCSBRK: /* These have no argument */
|
||||
case TIOCCBRK: /* They work on parts of struct sgttyb */
|
||||
case TIOCSDTR:
|
||||
case TIOCCDTR:
|
||||
e = ioctl(fd, req, (char *) 0);
|
||||
break;
|
||||
|
||||
/* The following are used to set the line discipline */
|
||||
case OTTYDISC:
|
||||
case NETLDISC:
|
||||
case NTTYDISC:
|
||||
e = ioctl(fd, req, (char *) 0);
|
||||
break;
|
||||
|
||||
case TIOCSTI: /* addr = address of character */
|
||||
if (memfault(addr, 1L)) {
|
||||
e = -1;
|
||||
}
|
||||
else {
|
||||
c = (char) mem_ldu(addr, 1L);
|
||||
e = ioctl(fd, req, (char *) &c);
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCGPGRP:
|
||||
/* store proc grp number of control term in addr */
|
||||
if ( memfault(addr, wsize)
|
||||
|| (e = ioctl(fd, req, (char *) &pgrp)) == -1
|
||||
) {
|
||||
e = -1;
|
||||
}
|
||||
else {
|
||||
mem_stn(addr, (long) pgrp, wsize);
|
||||
}
|
||||
break;
|
||||
|
||||
case TIOCSPGRP: /* addr is NO POINTER !! */
|
||||
e = ioctl(fd, req, (char *) addr);
|
||||
break;
|
||||
|
||||
case FIONREAD: /* do the ioctl, addr is long-int ptr now */
|
||||
if ( memfault(addr, wsize)
|
||||
|| (e = ioctl(fd, req, (char *) &count)) == -1
|
||||
) {
|
||||
e = -1;
|
||||
}
|
||||
else {
|
||||
mem_stn(addr, count, wsize);
|
||||
}
|
||||
break;
|
||||
|
||||
#endif V7IOCTL
|
||||
#endif BSD_X
|
||||
|
||||
default:
|
||||
einval(WBADIOCTL);
|
||||
e = -1; /* Fake return value */
|
||||
break;
|
||||
}
|
||||
return (e);
|
||||
}
|
||||
119
util/int/m_sigtrp.c
Normal file
119
util/int/m_sigtrp.c
Normal file
|
|
@ -0,0 +1,119 @@
|
|||
/*
|
||||
Dedicated treatment of the sigtrp system call, MON 48.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <signal.h>
|
||||
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "warn.h"
|
||||
#include "trap.h"
|
||||
|
||||
/*************************** SIGTRP *************************************
|
||||
* The monitor call "sigtrp()" is handled by "do_sigtrp()". The first *
|
||||
* argument is a EM-trap number (0<=tn<=252), the second a UNIX signal *
|
||||
* number. The user wants trap "tn" to be generated, in case signal *
|
||||
* "sn" occurs. The report about this interpreter has a section, *
|
||||
* giving all details about signal handling. Do_sigtrp() returns the *
|
||||
* previous trap-number "sn" was mapped onto. A return value of -1 *
|
||||
* indicates an error. *
|
||||
************************************************************************/
|
||||
|
||||
#define UNIX_trap(sn) (SIGILL <= sn && sn <= SIGSYS)
|
||||
|
||||
PRIVATE int sig_map[NSIG+1]; /* maps signals onto trap numbers */
|
||||
|
||||
PRIVATE int HndlIntSig(); /* handle signal to interpreter */
|
||||
PRIVATE int HndlEmSig(); /* handle signal to user program */
|
||||
|
||||
init_signals() {
|
||||
int sn;
|
||||
|
||||
for (sn = 0; sn < NSIG+1; sn++) {
|
||||
sig_map[sn] = -2; /* Default EM trap number */
|
||||
}
|
||||
|
||||
for (sn = 0; sn < NSIG+1; sn++) {
|
||||
/* for all signals that would cause termination */
|
||||
if (!UNIX_trap(sn)) {
|
||||
if (signal(sn, SIG_IGN) != SIG_IGN) {
|
||||
/* we take our fate in our own hand */
|
||||
signal(sn, HndlIntSig);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
int do_sigtrp(tn, sn)
|
||||
int tn; /* EM trap number */
|
||||
int sn; /* UNIX signal number */
|
||||
{
|
||||
register int old_tn;
|
||||
|
||||
if (sn <= 0 || sn > NSIG) {
|
||||
einval(WILLSN);
|
||||
return (-1);
|
||||
}
|
||||
|
||||
if (UNIX_trap(sn)) {
|
||||
einval(WUNIXTR);
|
||||
return (-1);
|
||||
}
|
||||
|
||||
old_tn = sig_map[sn];
|
||||
sig_map[sn] = tn;
|
||||
if (tn == -2) { /* reset default for signal sn */
|
||||
signal(sn, SIG_DFL);
|
||||
}
|
||||
else if (tn == -3) { /* ignore signal sn */
|
||||
signal(sn, SIG_IGN);
|
||||
}
|
||||
else if (tn >= 0 && tn <= 252) {/* legal tn */
|
||||
if ((int)signal(sn, HndlEmSig) == -1) {
|
||||
sig_map[sn] = old_tn;
|
||||
return (-1);
|
||||
}
|
||||
}
|
||||
else {
|
||||
/* illegal trap number */
|
||||
einval(WILLTN);
|
||||
sig_map[sn] = old_tn; /* restore sig_map */
|
||||
return (-1);
|
||||
}
|
||||
return (old_tn);
|
||||
}
|
||||
|
||||
trap_signal()
|
||||
{
|
||||
/* execute the trap belonging to the signal that came in during
|
||||
the last instruction
|
||||
*/
|
||||
register int old_sig = signalled;
|
||||
|
||||
signalled = 0;
|
||||
trap(sig_map[old_sig]);
|
||||
}
|
||||
|
||||
/* The handling functions for the UNIX signals */
|
||||
|
||||
PRIVATE HndlIntSig(sn)
|
||||
int sn;
|
||||
{
|
||||
/* The interpreter got the signal */
|
||||
signal(sn, SIG_IGN); /* peace and quiet for close_down() */
|
||||
LOG(("@t1 signal %d caught by interpreter", sn));
|
||||
message("interpreter received signal %d, which was not caught by the interpreted program",
|
||||
sn);
|
||||
close_down(1);
|
||||
}
|
||||
|
||||
PRIVATE HndlEmSig(sn)
|
||||
int sn;
|
||||
{
|
||||
/* The EM machine got the signal */
|
||||
signal(sn, HndlIntSig); /* Revert to old situation */
|
||||
signalled = sn;
|
||||
}
|
||||
|
||||
194
util/int/main.c
Normal file
194
util/int/main.c
Normal file
|
|
@ -0,0 +1,194 @@
|
|||
/*
|
||||
Main loop
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
#include <setjmp.h>
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "e.out.h"
|
||||
#include "logging.h"
|
||||
#include "nofloat.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "text.h"
|
||||
#include "read.h"
|
||||
#include "opcode.h"
|
||||
#include "rsb.h"
|
||||
|
||||
extern int atoi();
|
||||
extern long atol();
|
||||
extern char *strcpy();
|
||||
|
||||
char mess_file[64] = "int.mess"; /* name of message file */
|
||||
|
||||
jmp_buf trapbuf;
|
||||
char *prog_name;
|
||||
int running; /* set if EM machine is running */
|
||||
|
||||
size maxstack; /* if set, max stack size */
|
||||
size maxheap; /* if set, max heap size */
|
||||
|
||||
#ifdef LOGGING
|
||||
extern long inr; /* from log.c */
|
||||
#endif LOGGING
|
||||
|
||||
PRIVATE char *dflt_av[] = {"e.out", 0}; /* default arguments */
|
||||
|
||||
main(argc, argv)
|
||||
int argc;
|
||||
char *argv[];
|
||||
{
|
||||
register int i;
|
||||
register int nosetjmp = 1;
|
||||
int must_disassemble = 0;
|
||||
int must_tally = 0;
|
||||
|
||||
prog_name = argv[0];
|
||||
|
||||
/* Initialize the EM machine */
|
||||
PreIgnMask = 0;
|
||||
FRALimit = FRALIMIT;
|
||||
|
||||
for (i = 1; i < argc; i++) {
|
||||
if (*(argv[i]) == '-') {
|
||||
switch (*(argv[i] + 1)) {
|
||||
case 'd': /* disassembly */
|
||||
must_disassemble = 1;
|
||||
break;
|
||||
case 'h': /* limit heap size */
|
||||
maxheap = atol(argv[i] + 2);
|
||||
break;
|
||||
case 'I': /* IgnMask pre-setting */
|
||||
if (atoi(argv[i] + 2) < 16)
|
||||
PreIgnMask = BIT(atoi(argv[i] + 2));
|
||||
break;
|
||||
case 'm': /* messagefile name override */
|
||||
strcpy(mess_file, argv[i] + 2);
|
||||
break;
|
||||
case 'r': /* FRALimit override */
|
||||
FRALimit = atoi(argv[i] + 2);
|
||||
break;
|
||||
case 's': /* limit stack size */
|
||||
maxstack = atol(argv[i] + 2);
|
||||
break;
|
||||
case 't': /* switch on tallying */
|
||||
must_tally= 1;
|
||||
break;
|
||||
case 'W': /* disable warning */
|
||||
set_wmask(atoi(argv[i] + 2));
|
||||
break;
|
||||
default:
|
||||
fprintf(stderr,
|
||||
"%s: bad option: %s\n",
|
||||
prog_name,
|
||||
argv[i]
|
||||
);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
#ifdef LOGGING
|
||||
else if (logarg(argv[i])) {
|
||||
/* interesting for the logging machine */
|
||||
}
|
||||
#endif LOGGING
|
||||
else break;
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
/* Initialize the logging machine */
|
||||
init_log();
|
||||
#endif LOGGING
|
||||
|
||||
if (argc > i)
|
||||
init(argc - i, argv + i);
|
||||
else
|
||||
init(1, dflt_av);
|
||||
|
||||
/* Text dump only? */
|
||||
if (must_disassemble) {
|
||||
message(
|
||||
"text segment disassembly produced; program was not run");
|
||||
disassemble();
|
||||
close_down(0);
|
||||
}
|
||||
|
||||
/* Analyse FLAGS word */
|
||||
if (FLAGS&FB_TEST)
|
||||
must_test = 1;
|
||||
|
||||
if ((FLAGS&FB_PROFILE) || (FLAGS&FB_FLOW) || (FLAGS&FB_COUNT))
|
||||
must_tally = 1;
|
||||
|
||||
#ifdef NOFLOAT
|
||||
if (FLAGS&FB_REALS)
|
||||
warning(WFLUSED);
|
||||
#endif NOFLOAT
|
||||
|
||||
if (FLAGS&FB_EXTRA)
|
||||
warning(WEXTRIGN);
|
||||
|
||||
/* Call first procedure */
|
||||
running = 1; /* start the machine */
|
||||
OnTrap = TR_HALT; /* default trap handling */
|
||||
call(ENTRY, RSB_STP);
|
||||
|
||||
/* Run the machine */
|
||||
while (running) {
|
||||
#ifdef LOGGING
|
||||
inr++;
|
||||
if (must_log && inr >= log_start) {
|
||||
/* log this instruction */
|
||||
logging = 1;
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
LOG(("@x9 PC = %lu OPCODE = %lu", PC,
|
||||
btol(text_loc(PC)) < SECONDARY ?
|
||||
btol(text_loc(PC)) :
|
||||
btol(text_loc(PC)) + btol(text_loc(PC+1))
|
||||
));
|
||||
|
||||
newPC(PC); /* just check for validity */
|
||||
do_instr(nextPCbyte()); /* here it happens */
|
||||
|
||||
if (must_tally) {
|
||||
tally();
|
||||
}
|
||||
|
||||
if (signalled) {
|
||||
/* a signal has come in during this instruction */
|
||||
LOG(("@t1 signal %d caught by EM machine", signalled));
|
||||
trap_signal();
|
||||
}
|
||||
|
||||
if (nosetjmp) {
|
||||
/* entry point after a trap occurred */
|
||||
setjmp(trapbuf);
|
||||
nosetjmp = 0;
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
log_eoi();
|
||||
#endif LOGGING
|
||||
}
|
||||
|
||||
if (must_tally) {
|
||||
out_tally();
|
||||
}
|
||||
|
||||
if (ES_def == DEFINED) {
|
||||
message("program exits with status %ld", ES);
|
||||
close_down((int) ES);
|
||||
}
|
||||
else {
|
||||
message("program exits with undefined status");
|
||||
close_down(0);
|
||||
}
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
63
util/int/mem.h
Normal file
63
util/int/mem.h
Normal file
|
|
@ -0,0 +1,63 @@
|
|||
/*
|
||||
Memory access facilities
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
|
||||
/******** Memory address & location defines ********/
|
||||
|
||||
#define data_loc(a) (*(data + (p2i(a))))
|
||||
#define stack_loc(a) (*(stack + (ML - (a))))
|
||||
#define mem_loc(a) (in_stack(a) ? stack_loc(a) : data_loc(a))
|
||||
|
||||
#define loc_addr(o) (((o) < 0) ? (LB + (o)) : (AB + (o)))
|
||||
|
||||
|
||||
/******** Checks on adresses and ranges ********/
|
||||
|
||||
#define is_aligned(a,n) ((p2i(a)) % (n) == 0)
|
||||
|
||||
#define ch_aligned(a,n) { if (!is_aligned(a, min(n, wsize))) \
|
||||
{ trap(EBADPTR); } }
|
||||
|
||||
#define in_gda(p) ((p) < HB)
|
||||
#define in_stack(p) (SP <= (p) && (p) <= ML)
|
||||
|
||||
#define is_in_data(a,n) ((a) + (n) <= HP)
|
||||
#define ch_in_data(a,n) { if (!is_in_data(a, n)) { trap(EMEMFLT); } }
|
||||
|
||||
#define is_in_stack(a,n) (SP <= (a) && (a) + (n) - 1 <= ML)
|
||||
#define ch_in_stack(a,n) { if (!is_in_stack(a, n)) { trap(EMEMFLT); } }
|
||||
|
||||
#define is_in_FRA(a,n) ((a) + (n) <= FRASize)
|
||||
|
||||
|
||||
/******* Address-depending memory defines *******/
|
||||
|
||||
#define is_in_mem(a,n) (is_in_data(a, n) || is_in_stack(a, n))
|
||||
|
||||
#define mem_stn(a,l,n) { if (in_stack(a)) st_stn(a, l, n); else dt_stn(a, l, n); }
|
||||
|
||||
#define mem_lddp(a) (in_stack(a) ? st_lddp(a) : dt_lddp(a))
|
||||
#define mem_ldip(a) (in_stack(a) ? st_ldip(a) : dt_ldip(a))
|
||||
#define mem_ldu(a,n) (in_stack(a) ? st_ldu(a, n) : dt_ldu(a, n))
|
||||
#define mem_lds(a,n) (in_stack(a) ? st_lds(a, n) : dt_lds(a, n))
|
||||
|
||||
#define push_m(a,n) { if (in_stack(a)) push_st(a, n); else push_dt(a, n); }
|
||||
#define pop_m(a,n) { if (in_stack(a)) pop_st(a, n); else pop_dt(a, n); }
|
||||
|
||||
|
||||
/******** Simple stack manipulation ********/
|
||||
|
||||
#define st_inc(n) newSP(SP - (n)) /* stack grows */
|
||||
#define st_dec(n) newSP(SP + (n)) /* stack shrinks */
|
||||
|
||||
|
||||
/******** Function return types ********/
|
||||
|
||||
extern ptr st_ldip(), dt_ldip();
|
||||
extern ptr st_lddp(), dt_lddp(), dppop();
|
||||
extern long st_lds(), dt_lds(), spop(), wpop();
|
||||
extern unsigned long st_ldu(), dt_ldu(), upop();
|
||||
|
||||
60
util/int/memdirect.h
Normal file
60
util/int/memdirect.h
Normal file
|
|
@ -0,0 +1,60 @@
|
|||
/*
|
||||
Direct unchecked memory access
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
/* The set of macros is neither systematic nor exhaustive; its contents
|
||||
were suggested by expediency rather than by completeness.
|
||||
*/
|
||||
|
||||
/* Loading from memory */
|
||||
|
||||
#define p_in_stack(a) i2p((psize == 2) \
|
||||
? (btol(stack_loc(a)) | (btol(stack_loc(a+1))<<8)) \
|
||||
: (btol(stack_loc(a)) | (btol(stack_loc(a+1))<<8) | \
|
||||
(btol(stack_loc(a+2))<<16) | \
|
||||
(btol(stack_loc(a+3))<<24)))
|
||||
|
||||
#define p_in_data(a) i2p((psize == 2) \
|
||||
? (btol(data_loc(a)) | (btol(data_loc(a+1))<<8)) \
|
||||
: (btol(data_loc(a)) | (btol(data_loc(a+1))<<8) | \
|
||||
(btol(data_loc(a+2))<<16) | \
|
||||
(btol(data_loc(a+3))<<24)))
|
||||
|
||||
#define p_in_text(a) i2p((psize == 2) \
|
||||
? (btol(text_loc(a)) | (btol(text_loc(a+1))<<8)) \
|
||||
: (btol(text_loc(a)) | (btol(text_loc(a+1))<<8) | \
|
||||
(btol(text_loc(a+2))<<16) | \
|
||||
(btol(text_loc(a+3))<<24)))
|
||||
|
||||
#define p_in_FRA(a) i2p((psize == 2) \
|
||||
? (btol(FRA[a]) | (btol(FRA[a+1])<<8)) \
|
||||
: (btol(FRA[a]) | (btol(FRA[a+1])<<8) | \
|
||||
(btol(FRA[a+2])<<16) | \
|
||||
(btol(FRA[a+3])<<24)))
|
||||
|
||||
#define w_in_stack(a) ((wsize == 2) \
|
||||
? (btol(stack_loc(a)) | (btos(stack_loc(a+1))<<8)) \
|
||||
: (btol(stack_loc(a)) | (btol(stack_loc(a+1))<<8) | \
|
||||
(btol(stack_loc(a+2))<<16) | \
|
||||
(btos(stack_loc(a+3))<<24)))
|
||||
|
||||
#define w_in_data(a) ((wsize == 2) \
|
||||
? (btol(data_loc(a)) | (btos(data_loc(a+1))<<8)) \
|
||||
: (btol(data_loc(a)) | (btol(data_loc(a+1))<<8) | \
|
||||
(btol(data_loc(a+2))<<16) | \
|
||||
(btos(data_loc(a+3))<<24)))
|
||||
|
||||
#define w_in_FRA(a) ((wsize == 2) \
|
||||
? (btol(FRA[a]) | (btos(FRA[a+1])<<8)) \
|
||||
: (btol(FRA[a]) | (btol(FRA[a+1])<<8) | \
|
||||
(btol(FRA[a+2])<<16) | \
|
||||
(btos(FRA[a+3])<<24)))
|
||||
|
||||
#define LIN_in_stack(a) ((LINSIZE == 2) \
|
||||
? (btol(stack_loc(a)) | (btol(stack_loc(a+1))<<8)) \
|
||||
: (btol(stack_loc(a)) | (btol(stack_loc(a+1))<<8) | \
|
||||
(btol(stack_loc(a+2))<<16) | \
|
||||
(btol(stack_loc(a+3))<<24)))
|
||||
|
||||
1140
util/int/moncalls.c
Normal file
1140
util/int/moncalls.c
Normal file
File diff suppressed because it is too large
Load diff
190
util/int/monstruct.c
Normal file
190
util/int/monstruct.c
Normal file
|
|
@ -0,0 +1,190 @@
|
|||
/*
|
||||
Moving system structs between UNIX and EM
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "sysidf.h"
|
||||
#include "v7ioctl.h"
|
||||
#include "global.h"
|
||||
#include "mem.h"
|
||||
#include "monstruct.h"
|
||||
|
||||
#include <sys/types.h>
|
||||
#include <sys/stat.h>
|
||||
#include <sys/times.h>
|
||||
#include <sgtty.h>
|
||||
|
||||
#ifdef BSD_X /* from system.h */
|
||||
#include <sys/timeb.h>
|
||||
#endif BSD_X
|
||||
#ifdef SYS_V /* from system.h */
|
||||
struct timeb { /* non-existing; we use an ad-hoc definition */
|
||||
long time;
|
||||
unsigned short millitm;
|
||||
short timezone, dstflag;
|
||||
}
|
||||
#endif SYS_V
|
||||
|
||||
/******** System to EM memory ********/
|
||||
|
||||
PRIVATE mem_stfld(addr, offset, length, val)
|
||||
ptr addr;
|
||||
size offset, length;
|
||||
long val;
|
||||
{
|
||||
mem_stn(addr + offset, val, length);
|
||||
}
|
||||
|
||||
int stat2mem(addr, statb)
|
||||
ptr addr;
|
||||
struct stat *statb;
|
||||
{
|
||||
if (memfault(addr, V7st_sz))
|
||||
return 0;
|
||||
mem_stfld(addr, V7st_dev, (long) statb->st_dev);
|
||||
mem_stfld(addr, V7st_ino, (long) statb->st_ino);
|
||||
mem_stfld(addr, V7st_mode, (long) statb->st_mode);
|
||||
mem_stfld(addr, V7st_nlink, (long) statb->st_nlink);
|
||||
mem_stfld(addr, V7st_uid, (long) statb->st_uid);
|
||||
mem_stfld(addr, V7st_gid, (long) statb->st_gid);
|
||||
mem_stfld(addr, V7st_rdev, (long) statb->st_rdev);
|
||||
mem_stfld(addr, V7st_size, (long) statb->st_size);
|
||||
mem_stfld(addr, V7st_atime, (long) statb->st_atime);
|
||||
mem_stfld(addr, V7st_mtime, (long) statb->st_mtime);
|
||||
mem_stfld(addr, V7st_ctime, (long) statb->st_ctime);
|
||||
return 1;
|
||||
}
|
||||
|
||||
int timeb2mem(addr, timebb)
|
||||
ptr addr;
|
||||
struct timeb *timebb;
|
||||
{
|
||||
if (memfault(addr, V7tb_sz))
|
||||
return 0;
|
||||
mem_stfld(addr, V7tb_time, (long) timebb->time);
|
||||
mem_stfld(addr, V7tb_millitm, (long) timebb->millitm);
|
||||
mem_stfld(addr, V7tb_timezone, (long) timebb->timezone);
|
||||
mem_stfld(addr, V7tb_dstflag, (long) timebb->dstflag);
|
||||
return 1;
|
||||
}
|
||||
|
||||
int tms2mem(addr, tmsb)
|
||||
ptr addr;
|
||||
struct tms *tmsb;
|
||||
{
|
||||
if (memfault(addr, V7tms_sz))
|
||||
return 0;
|
||||
mem_stfld(addr, V7tms_utime, (long) tmsb->tms_utime);
|
||||
mem_stfld(addr, V7tms_stime, (long) tmsb->tms_stime);
|
||||
mem_stfld(addr, V7tms_cutime, (long) tmsb->tms_cutime);
|
||||
mem_stfld(addr, V7tms_cstime, (long) tmsb->tms_cstime);
|
||||
return 1;
|
||||
}
|
||||
|
||||
int sgttyb2mem(addr, sgttybb)
|
||||
ptr addr;
|
||||
struct sgttyb *sgttybb;
|
||||
{
|
||||
if (memfault(addr, V7sg_sz))
|
||||
return 0;
|
||||
mem_stfld(addr, V7sg_ispeed, (long) sgttybb->sg_ispeed);
|
||||
mem_stfld(addr, V7sg_ospeed, (long) sgttybb->sg_ospeed);
|
||||
mem_stfld(addr, V7sg_erase, (long) sgttybb->sg_erase);
|
||||
mem_stfld(addr, V7sg_kill, (long) sgttybb->sg_kill);
|
||||
mem_stfld(addr, V7sg_flags, (long) sgttybb->sg_flags);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifdef BSD_X /* from system.h */
|
||||
int tchars2mem(addr, tcharsb)
|
||||
ptr addr;
|
||||
struct tchars *tcharsb;
|
||||
{
|
||||
if (memfault(addr, V7t_sz_tch))
|
||||
return 0;
|
||||
mem_stfld(addr, V7t_intrc, (long) tcharsb->t_intrc);
|
||||
mem_stfld(addr, V7t_quitc, (long) tcharsb->t_quitc);
|
||||
mem_stfld(addr, V7t_startc, (long) tcharsb->t_startc);
|
||||
mem_stfld(addr, V7t_stopc, (long) tcharsb->t_stopc);
|
||||
mem_stfld(addr, V7t_eofc, (long) tcharsb->t_eofc);
|
||||
mem_stfld(addr, V7t_brkc, (long) tcharsb->t_brkc);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifndef V7IOCTL
|
||||
int ltchars2mem(addr, ltcharsb)
|
||||
ptr addr;
|
||||
struct ltchars *ltcharsb;
|
||||
{
|
||||
if (memfault(addr, V7t_sz_ltch))
|
||||
return 0;
|
||||
mem_stfld(addr, V7t_suspc, (long) ltcharsb->t_suspc);
|
||||
mem_stfld(addr, V7t_dsuspc, (long) ltcharsb->t_dsuspc);
|
||||
mem_stfld(addr, V7t_rprntc, (long) ltcharsb->t_rprntc);
|
||||
mem_stfld(addr, V7t_flushc, (long) ltcharsb->t_flushc);
|
||||
mem_stfld(addr, V7t_werasc, (long) ltcharsb->t_werasc);
|
||||
mem_stfld(addr, V7t_lnextc, (long) ltcharsb->t_lnextc);
|
||||
return 1;
|
||||
}
|
||||
#endif V7IOCTL
|
||||
#endif BSD_X
|
||||
|
||||
|
||||
/******** EM memory to system ********/
|
||||
|
||||
PRIVATE unsigned long mem_ldfld(addr, offset, length)
|
||||
ptr addr;
|
||||
size offset, length;
|
||||
{
|
||||
return mem_ldu(addr + offset, length);
|
||||
}
|
||||
|
||||
int mem2sgtty(addr, sgttybb)
|
||||
ptr addr;
|
||||
struct sgttyb *sgttybb;
|
||||
{
|
||||
if (memfault(addr, V7sg_sz))
|
||||
return 0;
|
||||
sgttybb->sg_ispeed = (char) mem_ldfld(addr, V7sg_ispeed);
|
||||
sgttybb->sg_ospeed = (char) mem_ldfld(addr, V7sg_ospeed);
|
||||
sgttybb->sg_erase = (char) mem_ldfld(addr, V7sg_erase);
|
||||
sgttybb->sg_kill = (char) mem_ldfld(addr, V7sg_kill);
|
||||
sgttybb->sg_flags = (short) mem_ldfld(addr, V7sg_flags);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifdef BSD_X /* from system.h */
|
||||
int mem2tchars(addr, tcharsb)
|
||||
ptr addr;
|
||||
struct tchars *tcharsb;
|
||||
{
|
||||
if (memfault(addr, V7t_sz_tch))
|
||||
return 0;
|
||||
tcharsb->t_intrc = (char) mem_ldfld(addr, V7t_intrc);
|
||||
tcharsb->t_quitc = (char) mem_ldfld(addr, V7t_quitc);
|
||||
tcharsb->t_startc = (char) mem_ldfld(addr, V7t_startc);
|
||||
tcharsb->t_stopc = (char) mem_ldfld(addr, V7t_stopc);
|
||||
tcharsb->t_eofc = (char) mem_ldfld(addr, V7t_eofc);
|
||||
tcharsb->t_brkc = (char) mem_ldfld(addr, V7t_brkc);
|
||||
return 1;
|
||||
}
|
||||
|
||||
#ifndef V7IOCTL
|
||||
int mem2ltchars(addr, ltcharsb)
|
||||
ptr addr;
|
||||
struct ltchars *ltcharsb;
|
||||
{
|
||||
if (memfault(addr, V7t_sz_ltch))
|
||||
return 0;
|
||||
ltcharsb->t_suspc = (char) mem_ldfld(addr, V7t_suspc);
|
||||
ltcharsb->t_dsuspc = (char) mem_ldfld(addr, V7t_dsuspc);
|
||||
ltcharsb->t_rprntc = (char) mem_ldfld(addr, V7t_rprntc);
|
||||
ltcharsb->t_flushc = (char) mem_ldfld(addr, V7t_flushc);
|
||||
ltcharsb->t_werasc = (char) mem_ldfld(addr, V7t_werasc);
|
||||
ltcharsb->t_lnextc = (char) mem_ldfld(addr, V7t_lnextc);
|
||||
return 1;
|
||||
}
|
||||
#endif V7IOCTL
|
||||
#endif BSD_X
|
||||
|
||||
69
util/int/monstruct.h
Normal file
69
util/int/monstruct.h
Normal file
|
|
@ -0,0 +1,69 @@
|
|||
/*
|
||||
These are descriptions of the fields of the structs as returned
|
||||
by the MON instruction. Each field is described by its offset and
|
||||
its length. The offset may be dependent on the word size, which
|
||||
is supposed to be given by wsize . (This wsize should actually
|
||||
be a parameter to all #defines, but this is not done to avoid
|
||||
excessive clutter.)
|
||||
|
||||
The description is intended as one parameter for a routine that
|
||||
expects two parameters, the offset and the length, both ints.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
/* struct stat */
|
||||
#define V7st_dev 0L, 2L /* short */
|
||||
#define V7st_ino 2L, 2L /* unsigned short */
|
||||
#define V7st_mode 4L, 2L /* unsigned short */
|
||||
#define V7st_nlink 6L, 2L /* short */
|
||||
#define V7st_uid 8L, 2L /* short */
|
||||
#define V7st_gid 10L, 2L /* short */
|
||||
#define V7st_rdev 12L, 2L /* short */
|
||||
#define V7st_align1 ((14 + wsize - 1) / wsize * wsize)
|
||||
#define V7st_size V7st_align1 + 0L, 4L /* long */
|
||||
#define V7st_atime V7st_align1 + 4L, 4L /* long */
|
||||
#define V7st_mtime V7st_align1 + 8L, 4L /* long */
|
||||
#define V7st_ctime V7st_align1 + 12L, 4L /* long */
|
||||
#define V7st_sz V7st_align1 + 16L
|
||||
|
||||
/* struct timeb */
|
||||
#define V7tb_time 0L, 4L /* long */
|
||||
#define V7tb_millitm 4L, 2L /* unsigned short */
|
||||
#define V7tb_timezone 6L, 2L /* short */
|
||||
#define V7tb_dstflag 8L, 2L /* short */
|
||||
#define V7tb_sz 10L
|
||||
|
||||
/* struct tms */
|
||||
#define V7tms_utime 0L, 4L /* long */
|
||||
#define V7tms_stime 4L, 4L /* long */
|
||||
#define V7tms_cutime 8L, 4L /* long */
|
||||
#define V7tms_cstime 12L, 4L /* long */
|
||||
#define V7tms_sz 16L
|
||||
|
||||
/* struct sgttyb */
|
||||
#define V7sg_ispeed 0L, 1L /* char */
|
||||
#define V7sg_ospeed 1L, 1L /* char */
|
||||
#define V7sg_erase 2L, 1L /* char */
|
||||
#define V7sg_kill 3L, 1L /* char */
|
||||
#define V7sg_flags 4L, 2L /* short */
|
||||
#define V7sg_sz 6L
|
||||
|
||||
/* struct tchars */
|
||||
#define V7t_intrc 0L, 1L /* char */
|
||||
#define V7t_quitc 1L, 1L /* char */
|
||||
#define V7t_startc 2L, 1L /* char */
|
||||
#define V7t_stopc 3L, 1L /* char */
|
||||
#define V7t_eofc 4L, 1L /* char */
|
||||
#define V7t_brkc 5L, 1L /* char */
|
||||
#define V7t_sz_tch 6L
|
||||
|
||||
/* struct ltchars */
|
||||
#define V7t_suspc 0L, 1L /* char */
|
||||
#define V7t_dsuspc 1L, 1L /* char */
|
||||
#define V7t_rprntc 2L, 1L /* char */
|
||||
#define V7t_flushc 3L, 1L /* char */
|
||||
#define V7t_werasc 4L, 1L /* char */
|
||||
#define V7t_lnextc 5L, 1L /* char */
|
||||
#define V7t_sz_ltch 6L
|
||||
|
||||
4
util/int/nofloat.h
Normal file
4
util/int/nofloat.h
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
/* $Header$ */
|
||||
|
||||
#undef NOFLOAT /* No floating point when defined */
|
||||
|
||||
13
util/int/opcode.h
Normal file
13
util/int/opcode.h
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
/*
|
||||
Secondary and tertiary opcode defines
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#define PRIM_BASE 0
|
||||
#define SEC_BASE 256
|
||||
#define TERT_BASE 512
|
||||
|
||||
#define SECONDARY 254
|
||||
#define TERTIARY 255
|
||||
|
||||
74
util/int/proctab.c
Normal file
74
util/int/proctab.c
Normal file
|
|
@ -0,0 +1,74 @@
|
|||
/*
|
||||
Handling the proctable
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "alloc.h"
|
||||
#include "proctab.h"
|
||||
|
||||
struct proc *proctab;
|
||||
PRIVATE long pr_cnt;
|
||||
|
||||
init_proctab()
|
||||
{
|
||||
proctab = (struct proc *)
|
||||
Malloc(NProc * sizeof (struct proc), "proctable");
|
||||
pr_cnt = 0;
|
||||
}
|
||||
|
||||
add_proc(nloc, ep)
|
||||
size nloc;
|
||||
ptr ep;
|
||||
{
|
||||
register struct proc *pr = &proctab[pr_cnt++];
|
||||
register struct proc *p;
|
||||
register ptr ff = DB;
|
||||
|
||||
LOG((" r6 add_proc: pr_cnt = %ld, nloc = %lu, ep = %lu",
|
||||
pr_cnt-1, nloc, ep));
|
||||
if (ep > DB)
|
||||
fatal("procedure entry point outside text segment");
|
||||
|
||||
pr->pr_nloc = nloc;
|
||||
pr->pr_ep = ep;
|
||||
/* examine all old proc descriptors */
|
||||
for (p = &proctab[0]; p < pr; p++) {
|
||||
if ( /* the old one starts earlier */
|
||||
p->pr_ep < pr->pr_ep
|
||||
&& /* it seems to end later */
|
||||
p->pr_ff > pr->pr_ep
|
||||
) { /* update its limit */
|
||||
p->pr_ff = pr->pr_ep;
|
||||
}
|
||||
if ( /* the old one starts later */
|
||||
p->pr_ep > pr->pr_ep
|
||||
&& /* our limit is beyond the old procedure entry point*/
|
||||
ff > p->pr_ep
|
||||
) { /* update our limit */
|
||||
ff = p->pr_ep;
|
||||
}
|
||||
}
|
||||
pr->pr_ff = ff;
|
||||
}
|
||||
|
||||
end_init_proctab()
|
||||
{
|
||||
#ifdef LOGGING
|
||||
register long p;
|
||||
|
||||
if (!check_log(" r6"))
|
||||
return;
|
||||
|
||||
for (p = 0; p < NProc; p++) {
|
||||
register struct proc *pr = &proctab[p];
|
||||
|
||||
LOG((" r5: proctab[%ld]: nloc = %d, ep = %lu, ff = %lu",
|
||||
p, pr->pr_nloc, pr->pr_ep, pr->pr_ff));
|
||||
}
|
||||
#endif LOGGING
|
||||
}
|
||||
|
||||
13
util/int/proctab.h
Normal file
13
util/int/proctab.h
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
/*
|
||||
Handling the proctable
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
struct proc {
|
||||
size pr_nloc;
|
||||
ptr pr_ep;
|
||||
ptr pr_ff; /* first address not in proc */
|
||||
};
|
||||
|
||||
extern struct proc *proctab;
|
||||
320
util/int/read.c
Normal file
320
util/int/read.c
Normal file
|
|
@ -0,0 +1,320 @@
|
|||
/*
|
||||
Reading the EM object file
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "e.out.h"
|
||||
#include "logging.h"
|
||||
#include "nofloat.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "warn.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "read.h"
|
||||
#include "text.h"
|
||||
|
||||
#ifndef NOFLOAT
|
||||
extern double str2double();
|
||||
#endif NOFLOAT
|
||||
|
||||
/************************************************************************
|
||||
* Read object file contents. *
|
||||
************************************************************************
|
||||
* *
|
||||
* rd_open() - open object file. *
|
||||
* rd_header() - read object file header. *
|
||||
* rd_text() - read program text. *
|
||||
* rd_gda() - read global data area. *
|
||||
* rd_proctab() - read procedure descriptors, *
|
||||
* rd_close() - close object file. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
/* EM header Part 1 variables */
|
||||
|
||||
int FLAGS;
|
||||
|
||||
/* EM header Part 2 variables */
|
||||
|
||||
size NTEXT;
|
||||
size NDATA;
|
||||
long NPROC;
|
||||
long ENTRY;
|
||||
long NLINE;
|
||||
size SZDATA;
|
||||
|
||||
PRIVATE FILE *load_fp; /* Filepointer of load file */
|
||||
|
||||
PRIVATE ptr rd_repeat();
|
||||
PRIVATE ptr rd_descr();
|
||||
PRIVATE int rd_byte();
|
||||
PRIVATE long rd_int();
|
||||
|
||||
rd_open(fname)
|
||||
char *fname;
|
||||
{ /* Open loadfile */
|
||||
if ((load_fp = fopen(fname, "r")) == NULL) {
|
||||
fatal("Cannot open loadfile '%s'", fname);
|
||||
}
|
||||
}
|
||||
|
||||
rd_header()
|
||||
{
|
||||
/* Part 1 */
|
||||
if (rd_int(2L) != MAGIC)
|
||||
fatal("Bad magic number in loadfile");
|
||||
|
||||
FLAGS = rd_int(2L);
|
||||
|
||||
if (rd_int(2L) != 0)
|
||||
fatal("Unresolved references in loadfile");
|
||||
|
||||
if (rd_int(2L) != VERSION)
|
||||
fatal("Incorrect version number in loadfile");
|
||||
|
||||
/* We only allow the following wordsize/pointersize combinations: */
|
||||
/* 2/2, 2/4, 4/4 */
|
||||
/* A fatal error will be generated if other combinations occur. */
|
||||
|
||||
wsize = rd_int(2L);
|
||||
if (!(wsize == 2 || wsize == 4))
|
||||
fatal("Bad wordsize in loadfile");
|
||||
|
||||
dwsize = 2 * wsize; /* set double wordsize */
|
||||
|
||||
psize = rd_int(2L);
|
||||
if (!(psize == 2 || psize == 4) || psize < wsize)
|
||||
fatal("Bad pointersize in loadfile");
|
||||
if (2 * psize > FRALimit)
|
||||
fatal("FRA maximum size too small");
|
||||
|
||||
rd_int(2L); /* Entry 7 is unused */
|
||||
rd_int(2L); /* Entry 8 is unused */
|
||||
|
||||
/* Part 2 */
|
||||
NTEXT = rd_int(psize);
|
||||
NDATA = rd_int(psize);
|
||||
NPROC = rd_int(psize);
|
||||
ENTRY = rd_int(psize);
|
||||
if (ENTRY < 0 || ENTRY >= NPROC)
|
||||
fatal("Bad entry point");
|
||||
NLINE = rd_int(psize);
|
||||
if (NLINE == 0) {
|
||||
warning(WNLINEZR);
|
||||
NLINE = I_MAXS4;
|
||||
}
|
||||
SZDATA = rd_int(psize);
|
||||
|
||||
rd_int(psize); /* entry 7 is unused */
|
||||
rd_int(psize); /* entry 8 is unused */
|
||||
}
|
||||
|
||||
rd_text()
|
||||
{
|
||||
fread(text, 1, (int) DB, load_fp);
|
||||
}
|
||||
|
||||
rd_gda()
|
||||
{
|
||||
register int type, prev_type;
|
||||
register ptr pos, prev_pos; /* prev_pos invalid if prev_type==0 */
|
||||
register long i;
|
||||
|
||||
type = prev_type = 0;
|
||||
pos = prev_pos = i2p(0);
|
||||
for (i = 1; i <= NDATA; i++) {
|
||||
type = btol(rd_byte());
|
||||
LOG((" r6 rd_gda(), i = %ld, pos = %u", i, pos));
|
||||
if (type == 0) {
|
||||
/* repetition descriptor */
|
||||
register size count = rd_int(psize);
|
||||
|
||||
LOG((" r6 rd_gda(), case 0: count = %lu", count));
|
||||
if (prev_type == 0) {
|
||||
fatal("Type 0 initialisation on type 0");
|
||||
}
|
||||
pos = rd_repeat(pos, count, prev_pos);
|
||||
prev_type = 0;
|
||||
}
|
||||
else {
|
||||
/* filling descriptor */
|
||||
register size count = btol(rd_byte());
|
||||
|
||||
LOG((" r6 rd_gda(), case %d: count = %lu",
|
||||
type, count));
|
||||
prev_pos = pos;
|
||||
pos = rd_descr(type, count, prev_pos);
|
||||
prev_type = type;
|
||||
}
|
||||
}
|
||||
|
||||
/* now protect the LIN and FIL area */
|
||||
dt_prot(i2p(0), (long)LINSIZE);
|
||||
dt_prot(i2p(4), psize);
|
||||
}
|
||||
|
||||
rd_proctab()
|
||||
{
|
||||
register long p;
|
||||
|
||||
init_proctab();
|
||||
for (p = 0; p < NPROC; p++) {
|
||||
register long nloc = rd_int(psize);
|
||||
register ptr ep = i2p(rd_int(psize));
|
||||
|
||||
add_proc(nloc, ep);
|
||||
}
|
||||
end_init_proctab();
|
||||
}
|
||||
|
||||
rd_close()
|
||||
{
|
||||
fclose(load_fp);
|
||||
load_fp = 0;
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Read functions for several types. *
|
||||
************************************************************************
|
||||
* *
|
||||
* rd_repeat() - repeat the previous initialisation *
|
||||
* rd_descr() - read a descriptor *
|
||||
* rd_byte() - read one byte, return a int. *
|
||||
* rd_int(n) - read n byte integer, return a long. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
/************************************************************************
|
||||
* Reading a floating point number *
|
||||
* *
|
||||
* A double is 8 bytes, so it can contain 4- and 8-byte (EM) *
|
||||
* floating point numbers. That's why a 4-byte floating point *
|
||||
* number is also stored in a double. In this case only the *
|
||||
* the 4 LSB's are used. These bytes contain the most important *
|
||||
* information, the MSB's are just for precision. *
|
||||
************************************************************************/
|
||||
|
||||
PRIVATE ptr rd_repeat(pos, count, prev_pos)
|
||||
ptr pos, prev_pos;
|
||||
size count;
|
||||
{
|
||||
register size diff = pos - prev_pos;
|
||||
register size j;
|
||||
|
||||
for (j = 0; j < count; j++) {
|
||||
register long i;
|
||||
|
||||
for (i = 0; i < diff; i++) {
|
||||
data_loc(pos) = data_loc(pos - diff);
|
||||
#ifdef LOGGING
|
||||
/* copy shadow byte, including protection bit */
|
||||
dt_sh(pos) = dt_sh(pos - diff);
|
||||
#endif LOGGING
|
||||
pos++;
|
||||
}
|
||||
}
|
||||
return pos;
|
||||
}
|
||||
|
||||
PRIVATE ptr rd_descr(type, count, pos)
|
||||
int type;
|
||||
size count;
|
||||
ptr pos;
|
||||
{
|
||||
register size j;
|
||||
char fl_rep[128]; /* fp number representation */
|
||||
register int fl_cnt;
|
||||
|
||||
switch (type) {
|
||||
case 1: /* m uninitialized words */
|
||||
j = count;
|
||||
while (j--) {
|
||||
dt_stn(pos, 0L, wsize);
|
||||
pos += wsize;
|
||||
}
|
||||
break;
|
||||
case 2: /* m initialized bytes */
|
||||
j = count;
|
||||
while (j--) {
|
||||
dt_stn(pos++, btol(rd_byte()), 1L);
|
||||
}
|
||||
break;
|
||||
case 3: /* m initialized wordsize integers */
|
||||
for (j = 0; j < count; j++) {
|
||||
dt_stn(pos, rd_int(wsize), wsize);
|
||||
pos += wsize;
|
||||
}
|
||||
break;
|
||||
case 4: /* m initialized data pointers */
|
||||
for (j = 0; j < count; j++) {
|
||||
dt_stdp(pos, i2p(rd_int(psize)));
|
||||
pos += psize;
|
||||
}
|
||||
break;
|
||||
case 5: /* m initialized instruction pointers */
|
||||
for (j = 0; j < count; j++) {
|
||||
dt_stip(pos, i2p(rd_int(psize)));
|
||||
pos += psize;
|
||||
}
|
||||
break;
|
||||
case 6: /* initialized integer of size m */
|
||||
case 7: /* initialized unsigned int of size m */
|
||||
if ((j = count) != 1 && j != 2 && j != 4)
|
||||
fatal("Bad integersize during initialisation");
|
||||
dt_stn(pos, rd_int(j), j);
|
||||
pos += j;
|
||||
break;
|
||||
case 8: /* initialized float of size m */
|
||||
if ((j = count) != 4 && j != 8)
|
||||
fatal("Bad floatsize during initialisation");
|
||||
/* get fp representation */
|
||||
fl_cnt = 0;
|
||||
while (fl_rep[fl_cnt] = rd_byte()) {
|
||||
fl_cnt++;
|
||||
if (fl_cnt >= sizeof (fl_rep)) {
|
||||
fatal("Initialized float longer than %d chars",
|
||||
sizeof (fl_rep));
|
||||
}
|
||||
}
|
||||
#ifndef NOFLOAT
|
||||
/* store the float */
|
||||
dt_stf(pos, str2double(fl_rep), j);
|
||||
#else NOFLOAT
|
||||
/* we cannot store the float */
|
||||
warning(WFLINIT);
|
||||
#endif NOFLOAT
|
||||
pos += j;
|
||||
break;
|
||||
default:
|
||||
fatal("Unknown initializer type in global data.");
|
||||
break;
|
||||
}
|
||||
return pos;
|
||||
}
|
||||
|
||||
PRIVATE int rd_byte()
|
||||
{
|
||||
register int i;
|
||||
|
||||
if ((i = fgetc(load_fp)) == EOF)
|
||||
fatal("EOF reached during initialization");
|
||||
return (i);
|
||||
}
|
||||
|
||||
PRIVATE long rd_int(n)
|
||||
size n;
|
||||
{
|
||||
register long l;
|
||||
register int i;
|
||||
|
||||
l = btol(rd_byte());
|
||||
for (i = 1; i < n; i++) {
|
||||
l |= (btol(rd_byte()) << (i*8));
|
||||
}
|
||||
return (l);
|
||||
}
|
||||
|
||||
18
util/int/read.h
Normal file
18
util/int/read.h
Normal file
|
|
@ -0,0 +1,18 @@
|
|||
/*
|
||||
Load-time variables, for reading the EM object file
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
/* EM header Part 1 varaibles */
|
||||
|
||||
extern int FLAGS;
|
||||
|
||||
/* EM header Part 2 variables */
|
||||
|
||||
extern size NTEXT; /* number of programtext bytes */
|
||||
extern size NDATA; /* number of load-file descriptor bytes */
|
||||
extern long NPROC; /* number of procedure descriptors */
|
||||
extern long ENTRY; /* procedure identifier of start procedure */
|
||||
extern long NLINE; /* the maximum source line number */
|
||||
extern size SZDATA; /* number of gda bytes after initialization */
|
||||
108
util/int/rsb.c
Normal file
108
util/int/rsb.c
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
/* $Header$ */
|
||||
|
||||
/* The Return Status Block contains, in push order:
|
||||
FIL, LIN, LB, PC, PI, rsbcode
|
||||
*/
|
||||
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "mem.h"
|
||||
#include "rsb.h"
|
||||
#include "proctab.h"
|
||||
#include "linfil.h"
|
||||
#include "shadow.h"
|
||||
#include "warn.h"
|
||||
|
||||
/* offsets to be added to a local base */
|
||||
int rsb_rsbcode;
|
||||
int rsb_PI;
|
||||
int rsb_PC;
|
||||
int rsb_LB;
|
||||
int rsb_LIN;
|
||||
int rsb_FIL;
|
||||
int rsbsize;
|
||||
|
||||
init_rsb()
|
||||
{
|
||||
rsb_rsbcode = 0;
|
||||
rsb_PI = wsize;
|
||||
rsb_PC = rsb_PI + psize;
|
||||
rsb_LB = rsb_PC + psize;
|
||||
rsb_LIN = rsb_LB + psize;
|
||||
rsb_FIL = rsb_LIN + LINSIZE;
|
||||
rsbsize = rsb_FIL + psize;
|
||||
}
|
||||
|
||||
pushrsb(rsbcode)
|
||||
int rsbcode;
|
||||
{
|
||||
/* fill Return Status Block */
|
||||
st_inc(rsbsize);
|
||||
|
||||
st_stdp(SP + rsb_FIL, getFIL());
|
||||
st_prot(SP + rsb_FIL, psize);
|
||||
|
||||
st_stn(SP + rsb_LIN, (long)getLIN(), LINSIZE);
|
||||
st_prot(SP + rsb_LIN, LINSIZE);
|
||||
|
||||
st_stdp(SP + rsb_LB, LB);
|
||||
st_prot(SP + rsb_LB, psize);
|
||||
|
||||
st_stip(SP + rsb_PC, PC);
|
||||
st_prot(SP + rsb_PC, psize);
|
||||
|
||||
st_stn(SP + rsb_PI, PI, psize);
|
||||
st_prot(SP + rsb_PI, psize);
|
||||
|
||||
st_stn(SP + rsb_rsbcode, (long)rsbcode, wsize);
|
||||
st_prot(SP + rsb_rsbcode, wsize);
|
||||
|
||||
newLB(SP);
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
int poprsb(rtt)
|
||||
int rtt; /* set to 1 if working for RTT */
|
||||
{
|
||||
/* pops the RSB and returns the rsbcode, for further testing */
|
||||
register int rsbcode;
|
||||
|
||||
#ifdef LOGGING
|
||||
{
|
||||
/* check SP */
|
||||
register ptr properSP = LB - proctab[PI].pr_nloc;
|
||||
|
||||
if (SP < properSP)
|
||||
warning(rtt ? WRTTSTL : WRETSTL);
|
||||
if (SP > properSP)
|
||||
warning(rtt ? WRTTSTS : WRETSTS);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
/* discard stack up to RSB */
|
||||
newSP(LB);
|
||||
|
||||
/* get RSB code and test it for applicability */
|
||||
rsbcode = st_ldu(SP + rsb_rsbcode, wsize);
|
||||
if ((rsbcode & RSBMASK) != RSBCODE) /* no RSB at all */
|
||||
return rsbcode;
|
||||
|
||||
if (rsbcode != RSB_STP) {
|
||||
/* Restore registers PI, PC, LB, LIN and FIL
|
||||
from Return Status Block
|
||||
*/
|
||||
PI = st_lds(SP + rsb_PI, psize);
|
||||
newPC(st_ldip(SP + rsb_PC));
|
||||
newLB(st_lddp(SP + rsb_LB));
|
||||
putLIN((long) st_ldu(SP + rsb_LIN, LINSIZE));
|
||||
putFIL(st_lddp(SP + rsb_FIL));
|
||||
|
||||
/* remove RSB */
|
||||
st_dec(rsbsize);
|
||||
|
||||
pop_frames();
|
||||
}
|
||||
|
||||
return rsbcode;
|
||||
}
|
||||
|
||||
31
util/int/rsb.h
Normal file
31
util/int/rsb.h
Normal file
|
|
@ -0,0 +1,31 @@
|
|||
/* $Header$ */
|
||||
|
||||
/* The Return Status Block contains, in push order:
|
||||
FIL, LIN, LB, PC, PI, rsbcode
|
||||
|
||||
In a trap this is preceeded by:
|
||||
FRA, FRASize, FRA_def, trap_nr
|
||||
*/
|
||||
|
||||
/* offsets to be added to a local base */
|
||||
extern int rsb_rsbcode;
|
||||
extern int rsb_PI;
|
||||
extern int rsb_PC;
|
||||
extern int rsb_LB;
|
||||
extern int rsb_LIN;
|
||||
extern int rsb_FIL;
|
||||
extern int rsbsize;
|
||||
|
||||
/* The last item stored in the Return Status Block is a word containing
|
||||
a code describing the type of the RSB.
|
||||
*/
|
||||
|
||||
#define RSBMASK 0xfff0
|
||||
#define RSBCODE 0x2b90 /* 0rrr rrrr rrrr 0000, r = random */
|
||||
#define RSB_STP (RSBCODE + 1) /* in first RSB */
|
||||
#define RSB_CAL (RSBCODE + 2) /* in RSB from call */
|
||||
#define RSB_RTT (RSBCODE + 3) /* in RSB from returnable trap */
|
||||
#define RSB_NRT (RSBCODE + 4) /* in RSB from non-returnable trap */
|
||||
|
||||
#define is_LB(p) ((st_lds(p+rsb_rsbcode, wsize) & RSBMASK) == RSBCODE)
|
||||
|
||||
11
util/int/segcheck.h
Normal file
11
util/int/segcheck.h
Normal file
|
|
@ -0,0 +1,11 @@
|
|||
/* $Header$ */
|
||||
|
||||
/* Includes special segment checking when defined */
|
||||
#define SEGCHECK
|
||||
|
||||
/*
|
||||
The present segment checking is not very informative and produces
|
||||
complaints about intermediate results, which is annoying.
|
||||
Not easily corrected.
|
||||
*/
|
||||
|
||||
84
util/int/segment.c
Normal file
84
util/int/segment.c
Normal file
|
|
@ -0,0 +1,84 @@
|
|||
/*
|
||||
AB_list[s] holds the actual base of stack frame s; this
|
||||
is the highest stack pointer of frame s-1.
|
||||
Segments have the following numbers:
|
||||
-2 DATA_SEGMENT
|
||||
-1 HEAP_SEGMENT
|
||||
0, 1, .., curr_frame stackframes
|
||||
Note that AB_list[s] increases for decreasing s.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "segcheck.h"
|
||||
#include "global.h"
|
||||
#include "mem.h"
|
||||
#include "alloc.h"
|
||||
|
||||
#ifdef SEGCHECK
|
||||
|
||||
#define ABLISTSIZE 100L /* initial AB_list size */
|
||||
|
||||
#define DATA_SEGMENT -2
|
||||
#define HEAP_SEGMENT -1
|
||||
|
||||
PRIVATE ptr *AB_list;
|
||||
PRIVATE size frame_limit;
|
||||
PRIVATE size curr_frame;
|
||||
|
||||
init_AB_list() {
|
||||
/* Allocate space for AB_list & initialize frame variables */
|
||||
|
||||
frame_limit = ABLISTSIZE;
|
||||
curr_frame = 0L;
|
||||
AB_list = (ptr *) Malloc(frame_limit * sizeof (ptr), "AB_list");
|
||||
AB_list[curr_frame] = AB;
|
||||
}
|
||||
|
||||
push_frame(p)
|
||||
ptr p;
|
||||
{
|
||||
if (++curr_frame == frame_limit) {
|
||||
frame_limit = allocfrac(frame_limit);
|
||||
AB_list = (ptr *) Realloc((char *) AB_list,
|
||||
frame_limit * sizeof (ptr), "AB_list");
|
||||
}
|
||||
AB_list[curr_frame] = p;
|
||||
}
|
||||
|
||||
pop_frames() {
|
||||
while (AB_list[curr_frame] < AB) {
|
||||
curr_frame--;
|
||||
}
|
||||
}
|
||||
|
||||
int ptr2seg(p)
|
||||
ptr p;
|
||||
{
|
||||
register int s;
|
||||
|
||||
if (in_gda(p)) {
|
||||
s = DATA_SEGMENT;
|
||||
}
|
||||
else if (!in_stack(p)) {
|
||||
s = HEAP_SEGMENT;
|
||||
}
|
||||
else {
|
||||
for (s = curr_frame; s > 0; s--) {
|
||||
if (AB_list[s] > p)
|
||||
break;
|
||||
}
|
||||
}
|
||||
return s;
|
||||
}
|
||||
|
||||
#else SEGCHECK
|
||||
|
||||
init_AB_list() {}
|
||||
|
||||
push_frame() {}
|
||||
|
||||
pop_frames() {}
|
||||
|
||||
#endif SEGCHECK
|
||||
|
||||
101
util/int/shadow.h
Normal file
101
util/int/shadow.h
Normal file
|
|
@ -0,0 +1,101 @@
|
|||
/*
|
||||
Shadowbyte macros
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include "logging.h"
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
extern char *data_sh; /* shadowbytes of data space */
|
||||
extern char *stack_sh; /* shadowbytes of stack space */
|
||||
|
||||
/* Bit 0, 1, 2 and 3: datatype/pointertype. */
|
||||
|
||||
#define SH_INT (0x01)
|
||||
#define SH_FLOAT (0x02)
|
||||
#define SH_DATAP (0x04)
|
||||
#define SH_INSP (0x08)
|
||||
|
||||
/* Bit 7: protection bit */
|
||||
|
||||
#define SH_PROT (0x80)
|
||||
|
||||
/******** Shadowbytes, general ********/
|
||||
|
||||
#define dt_sh(a) (*(data_sh + (p2i(a))))
|
||||
#define st_sh(a) (*(stack_sh + (ML - (a))))
|
||||
#define mem_sh(a) (in_stack(a) ? st_sh(a) : dt_sh(a))
|
||||
|
||||
/******** Shadowbytes settings for data ********/
|
||||
|
||||
#define dt_undef(a) (dt_sh(a) = UNDEFINED)
|
||||
|
||||
#define dt_int(a) (dt_sh(a) = SH_INT)
|
||||
#define dt_fl(a) (dt_sh(a) = SH_FLOAT)
|
||||
#define dt_ip(a) (dt_sh(a) = SH_INSP)
|
||||
#define dt_dp(a) (dt_sh(a) = SH_DATAP)
|
||||
|
||||
#define dt_prot2b(a) { dt_sh(a) |= SH_PROT; dt_sh(a+1) |= SH_PROT; }
|
||||
#define dt_unpr2b(a) { dt_sh(a) &= ~SH_PROT; dt_sh(a+1) &= ~SH_PROT; }
|
||||
#define dt_prot(a,n) { dt_prot2b(a); \
|
||||
if ((n) == 4) { dt_prot2b(a+2); } }
|
||||
#define dt_unprot(a,n) { dt_unpr2b(a); \
|
||||
if ((n) == 4) { dt_unpr2b(a+2); } }
|
||||
|
||||
/******** Shadowbytes settings for stack ********/
|
||||
|
||||
#define st_undef(a) (st_sh(a) = UNDEFINED)
|
||||
|
||||
#define st_int(a) (st_sh(a) = SH_INT)
|
||||
#define st_fl(a) (st_sh(a) = SH_FLOAT)
|
||||
#define st_ip(a) (st_sh(a) = SH_INSP)
|
||||
#define st_dp(a) (st_sh(a) = SH_DATAP)
|
||||
|
||||
#define st_prot2b(a) { st_sh(a) |= SH_PROT; st_sh(a+1) |= SH_PROT; }
|
||||
#define st_unpr2b(a) { st_sh(a) &= ~SH_PROT; st_sh(a+1) &= ~SH_PROT; }
|
||||
#define st_prot(a,n) { st_prot2b(a); \
|
||||
if ((n) == 4) { st_prot2b(a+2); } }
|
||||
#define st_unprot(a,n) { st_unpr2b(a); \
|
||||
if ((n) == 4) { st_unpr2b(a+2); } }
|
||||
|
||||
/******** Shadowbytes checking for data ********/
|
||||
|
||||
#define is_dt_set(a,n,s) ((dt_sh(a) & s) && (dt_sh(a+(n-1)) & s))
|
||||
#define is_dt_prot(a) (dt_sh(a) & SH_PROT)
|
||||
#define ch_dt_prot(a) { if (is_dt_prot(a)) warning(WDESROM); }
|
||||
|
||||
/******** Shadowbytes checking for stack ********/
|
||||
|
||||
#define is_st_set(a,n,s) ((st_sh(a) & s) && (st_sh(a+(n-1)) & s))
|
||||
#define is_st_prot(a) (st_sh(a) & SH_PROT)
|
||||
#define ch_st_prot(a) { if (is_st_prot(a)) warning(WDESRSB); }
|
||||
|
||||
#else
|
||||
|
||||
#define dt_undef(a)
|
||||
|
||||
#define dt_int(a)
|
||||
#define dt_fl(a)
|
||||
#define dt_ip(a)
|
||||
#define dt_dp(a)
|
||||
|
||||
#define dt_prot(a,n)
|
||||
#define dt_unprot(a,b)
|
||||
|
||||
#define st_undef(a)
|
||||
|
||||
#define st_int(a)
|
||||
#define st_fl(a)
|
||||
#define st_ip(a)
|
||||
#define st_dp(a)
|
||||
|
||||
#define st_prot(a,n)
|
||||
#define st_unprot(a,b)
|
||||
|
||||
#define ch_dt_prot(a)
|
||||
#define ch_st_prot(a)
|
||||
|
||||
#endif LOGGING
|
||||
|
||||
595
util/int/stack.c
Normal file
595
util/int/stack.c
Normal file
|
|
@ -0,0 +1,595 @@
|
|||
/*
|
||||
Stack manipulation
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "nofloat.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "warn.h"
|
||||
#include "trap.h"
|
||||
#include "alloc.h"
|
||||
#include "memdirect.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "rsb.h"
|
||||
|
||||
#define STACKSIZE 1000L /* initial stack size */
|
||||
|
||||
extern size maxstack; /* from main.c */
|
||||
|
||||
#ifdef LOGGING
|
||||
char *stack_sh; /* stadowbytes */
|
||||
#endif LOGGING
|
||||
|
||||
PRIVATE warn_stbits();
|
||||
|
||||
init_stack() {
|
||||
ML = max_addr; /* set Memory Limit */
|
||||
SP = ML + 1; /* initialize Stack Pointer */
|
||||
SL = ML + 1; /* initialize Stack Limit */
|
||||
LB = ML + 1; /* initialize Local Base */
|
||||
AB = ML + 1; /* initialize Actual Base */
|
||||
|
||||
SL = ML + 1 - STACKSIZE; /* initialize Stack Limit */
|
||||
stack = Malloc(STACKSIZE, "stack space");
|
||||
#ifdef LOGGING
|
||||
stack_sh = Malloc(STACKSIZE, "shadowspace for stack");
|
||||
st_clear_area(ML, SL);
|
||||
#endif LOGGING
|
||||
}
|
||||
|
||||
|
||||
/************************************************************************
|
||||
* EM-register division. *
|
||||
************************************************************************
|
||||
* *
|
||||
* newSP(p) - check and adjust StackPointer. *
|
||||
* newLB(p) - check and adjust Local Base and Actual Base *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
newSP(ap)
|
||||
ptr ap;
|
||||
{
|
||||
register ptr p = ap;
|
||||
|
||||
LOG(("@s6 newSP(%lu), ML = %lu, SP = %lu", p, ML, SP));
|
||||
if (LB < p) {
|
||||
wtrap(WSPGTLB, ESTACK);
|
||||
}
|
||||
if (p < HP) {
|
||||
wtrap(WSPINHEAP, ESTACK);
|
||||
}
|
||||
if (!is_aligned(p, wsize)) {
|
||||
wtrap(WSPODD, ESTACK);
|
||||
}
|
||||
if (maxstack) {
|
||||
/* more than allowed on command line */
|
||||
if (ML - p > maxstack) {
|
||||
warning(WESTACK);
|
||||
trap(ESTACK);
|
||||
}
|
||||
}
|
||||
if (p < SL) {
|
||||
/* extend stack space */
|
||||
register size stacksize = ML + 1 - p;
|
||||
|
||||
stacksize = allocfrac(stacksize);
|
||||
SL = ML + 1 - stacksize;
|
||||
stack = Realloc(stack, (size)(stacksize), "stack space");
|
||||
#ifdef LOGGING
|
||||
stack_sh = Realloc(stack_sh, (size)(stacksize),
|
||||
"shadowspace for stack");
|
||||
#endif LOGGING
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
if (!in_stack(p)) {
|
||||
st_clear_area(SP - 1, p);
|
||||
}
|
||||
#endif LOGGING
|
||||
SP = p;
|
||||
}
|
||||
|
||||
newLB(p)
|
||||
ptr p;
|
||||
{
|
||||
if (!in_stack(p)) {
|
||||
wtrap(WLBOUT, ESTACK);
|
||||
}
|
||||
if (!is_aligned(p, wsize)) {
|
||||
wtrap(WLBODD, ESTACK);
|
||||
}
|
||||
if (!is_LB(p)) {
|
||||
wtrap(WLBRSB, ESTACK);
|
||||
}
|
||||
LB = p;
|
||||
AB = LB + rsbsize;
|
||||
}
|
||||
|
||||
|
||||
/************************************************************************
|
||||
* Stack store division. *
|
||||
************************************************************************
|
||||
* *
|
||||
* st_stdp(addr, p) - STore Data Pointer. *
|
||||
* st_stip(addr, p) - STore Instruction Pointer. *
|
||||
* st_stn(addr, l, n) - STore N byte integer. *
|
||||
* st_stf(addr, f, n) - STore Floating point number. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
st_stdp(addr, ap)
|
||||
ptr addr, ap;
|
||||
{
|
||||
register int i;
|
||||
register long p = (long) ap;
|
||||
|
||||
LOG(("@s6 st_stdp(%lu, %lu)", addr, p));
|
||||
ch_in_stack(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
for (i = 0; i < (int) psize; i++) {
|
||||
ch_st_prot(addr + i);
|
||||
stack_loc(addr + i) = (char) (p);
|
||||
st_dp(addr + i);
|
||||
p = p>>8;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
st_stip(addr, ap)
|
||||
ptr addr, ap;
|
||||
{
|
||||
register int i;
|
||||
register long p = (long) ap;
|
||||
|
||||
LOG(("@s6 st_stip(%lu, %lu)", addr, p));
|
||||
ch_in_stack(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
for (i = 0; i < (int) psize; i++) {
|
||||
ch_st_prot(addr + i);
|
||||
stack_loc(addr + i) = (char) (p);
|
||||
st_ip(addr + i);
|
||||
p = p>>8;
|
||||
}
|
||||
}
|
||||
|
||||
st_stn(addr, al, n)
|
||||
ptr addr;
|
||||
long al;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
register long l = al;
|
||||
|
||||
LOG(("@s6 st_stn(%lu, %ld, %lu)", addr, l, n));
|
||||
ch_in_stack(addr, n);
|
||||
ch_aligned(addr, n);
|
||||
|
||||
/* store the bytes */
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_st_prot(addr + i);
|
||||
stack_loc(addr + i) = (char) l;
|
||||
#ifdef LOGGING
|
||||
if (al == 0 && n == psize) {
|
||||
/* a psize zero, ambiguous */
|
||||
st_sh(addr + i) = (SH_INT|SH_DATAP);
|
||||
}
|
||||
else {
|
||||
st_sh(addr + i) = SH_INT;
|
||||
}
|
||||
#endif LOGGING
|
||||
l = l>>8;
|
||||
}
|
||||
}
|
||||
|
||||
#ifndef NOFLOAT
|
||||
st_stf(addr, f, n)
|
||||
ptr addr;
|
||||
double f;
|
||||
size n;
|
||||
{
|
||||
register char *cp = (char *) &f;
|
||||
register int i;
|
||||
|
||||
LOG(("@s6 st_stf(%lu, %g, %lu)", addr, f, n));
|
||||
ch_in_stack(addr, n);
|
||||
ch_aligned(addr, wsize);
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_st_prot(addr + i);
|
||||
stack_loc(addr + i) = *(cp++);
|
||||
st_fl(addr + i);
|
||||
}
|
||||
}
|
||||
#endif NOFLOAT
|
||||
|
||||
/************************************************************************
|
||||
* Stack load division. *
|
||||
************************************************************************
|
||||
* *
|
||||
* st_lddp(addr) - LoaD Data Pointer from stack. *
|
||||
* st_ldip(addr) - LoaD Instruction Pointer from stack. *
|
||||
* st_ldu(addr, n) - LoaD n Unsigned bytes from stack. *
|
||||
* st_lds(addr, n) - LoaD n Signed bytes from stack. *
|
||||
* st_ldf(addr, n) - LoaD Floating point number from stack. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
ptr st_lddp(addr)
|
||||
ptr addr;
|
||||
{
|
||||
register ptr p;
|
||||
|
||||
LOG(("@s6 st_lddp(%lu)", addr));
|
||||
|
||||
ch_in_stack(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
#ifdef LOGGING
|
||||
if (!is_st_set(addr, psize, SH_DATAP)) {
|
||||
warning(WLDPEXP);
|
||||
warn_stbits(addr, psize);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
p = p_in_stack(addr);
|
||||
LOG(("@s6 st_lddp() returns %lu", p));
|
||||
return (p);
|
||||
}
|
||||
|
||||
ptr st_ldip(addr)
|
||||
ptr addr;
|
||||
{
|
||||
register ptr p;
|
||||
|
||||
LOG(("@s6 st_ldip(%lu)", addr));
|
||||
|
||||
ch_in_stack(addr, psize);
|
||||
ch_aligned(addr, wsize);
|
||||
#ifdef LOGGING
|
||||
if (!is_st_set(addr, psize, SH_INSP)) {
|
||||
warning(WLIPEXP);
|
||||
warn_stbits(addr, psize);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
p = p_in_stack(addr);
|
||||
LOG(("@s6 st_ldip() returns %lu", p));
|
||||
return (p);
|
||||
}
|
||||
|
||||
unsigned long st_ldu(addr, n)
|
||||
ptr addr;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
register unsigned long u = 0;
|
||||
|
||||
LOG(("@s6 st_ldu(%lu, %lu)", addr, n));
|
||||
|
||||
ch_in_stack(addr, n);
|
||||
ch_aligned(addr, n);
|
||||
#ifdef LOGGING
|
||||
if (!is_st_set(addr, n, SH_INT)) {
|
||||
warning(n == 1 ? WLCEXP : WLIEXP);
|
||||
warn_stbits(addr, n);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
for (i = (int) n-1; i >= 0; i--) {
|
||||
u = (u<<8) | (btou(stack_loc(addr + i)));
|
||||
}
|
||||
LOG(("@s6 st_ldu() returns %ld", u));
|
||||
return (u);
|
||||
}
|
||||
|
||||
long st_lds(addr, n)
|
||||
ptr addr;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
register long l;
|
||||
|
||||
LOG(("@s6 st_lds(%lu, %lu)", addr, n));
|
||||
|
||||
ch_in_stack(addr, n);
|
||||
ch_aligned(addr, n);
|
||||
#ifdef LOGGING
|
||||
if (!is_st_set(addr, n, SH_INT)) {
|
||||
warning(n == 1 ? WLCEXP : WLIEXP);
|
||||
warn_stbits(addr, n);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
l = btos(stack_loc(addr + n - 1));
|
||||
for (i = n - 2; i >= 0; i--) {
|
||||
l = (l<<8) | btol(stack_loc(addr + i));
|
||||
}
|
||||
LOG(("@s6 st_lds() returns %ld", l));
|
||||
return (l);
|
||||
}
|
||||
|
||||
#ifndef NOFLOAT
|
||||
double st_ldf(addr, n)
|
||||
ptr addr;
|
||||
size n;
|
||||
{
|
||||
double f = 0.0;
|
||||
register char *cp = (char *) &f;
|
||||
register int i;
|
||||
|
||||
LOG(("@s6 st_ldf(%lu, %lu)", addr, n));
|
||||
|
||||
ch_in_stack(addr, n);
|
||||
ch_aligned(addr, wsize);
|
||||
#ifdef LOGGING
|
||||
if (!is_st_set(addr, n, SH_FLOAT)) {
|
||||
warning(WLFEXP);
|
||||
warn_stbits(addr, n);
|
||||
}
|
||||
#endif LOGGING
|
||||
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
*(cp++) = stack_loc(addr + i);
|
||||
}
|
||||
return (f);
|
||||
}
|
||||
#endif NOFLOAT
|
||||
|
||||
/************************************************************************
|
||||
* Stack move division *
|
||||
************************************************************************
|
||||
* *
|
||||
* st_mvs(s2, s1, n) - Move n bytes in stack from s1 to s2. *
|
||||
* st_mvd(s, d, n) - Move n bytes from d in data to s in stack. *
|
||||
* *
|
||||
* st_mvs(): The intention is to copy the contents of addresses *
|
||||
* s1, s1+1....s1-(n-1) to addresses s2, s2+1....s2+(n-1). *
|
||||
* All addresses are expected to be in the stack. This condition *
|
||||
* is checked for. The shadow bytes of the bytes to be filled in, *
|
||||
* are marked identical to the source-shadow bytes. *
|
||||
* *
|
||||
* st_mvd(), dt_mvd() and dt_mvs() act identically (see data.c). *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
st_mvs(s2, s1, n) /* s1 -> s2 */
|
||||
ptr s2, s1;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
|
||||
ch_in_stack(s1, n);
|
||||
ch_aligned(s1, wsize);
|
||||
ch_in_stack(s2, n);
|
||||
ch_aligned(s2, wsize);
|
||||
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_st_prot(s2 + i);
|
||||
ch_st_prot(s1 + i);
|
||||
stack_loc(s2 + i) = stack_loc(s1 + i);
|
||||
#ifdef LOGGING
|
||||
st_sh(s2 + i) = st_sh(s1 + i) & ~SH_PROT;
|
||||
#endif LOGGING
|
||||
}
|
||||
}
|
||||
|
||||
st_mvd(s, d, n) /* d -> s */
|
||||
ptr s, d;
|
||||
size n;
|
||||
{
|
||||
register int i;
|
||||
|
||||
ch_in_data(d, n);
|
||||
ch_aligned(d, wsize);
|
||||
ch_in_stack(s, n);
|
||||
ch_aligned(s, wsize);
|
||||
|
||||
for (i = 0; i < (int) n; i++) {
|
||||
ch_st_prot(s + i);
|
||||
stack_loc(s + i) = data_loc(d + i);
|
||||
#ifdef LOGGING
|
||||
st_sh(s + i) = dt_sh(d + i) & ~SH_PROT;
|
||||
#endif LOGGING
|
||||
}
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Stack pop division. *
|
||||
************************************************************************
|
||||
* *
|
||||
* dppop() - pop a data ptr, return a ptr. *
|
||||
* upop(n) - pop n unsigned bytes, return a long. *
|
||||
* spop(n) - pop n signed bytes, return a long. *
|
||||
* pop_dt(d, n) - pop n bytes, store at address d in data. *
|
||||
* pop_st(s, n) - pop n bytes, store at address s in stack. *
|
||||
* fpop() - pop a floating point number. *
|
||||
* wpop() - pop a signed word, don't care about any type. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
ptr dppop()
|
||||
{
|
||||
register ptr p;
|
||||
|
||||
p = st_lddp(SP);
|
||||
st_dec(psize);
|
||||
LOG(("@s7 dppop(), return: %lu", p));
|
||||
return (p);
|
||||
}
|
||||
|
||||
unsigned long upop(n)
|
||||
size n;
|
||||
{
|
||||
register unsigned long l;
|
||||
|
||||
l = st_ldu(SP, n);
|
||||
st_dec(max(n, wsize));
|
||||
LOG(("@s7 upop(), return: %lu", l));
|
||||
return (l);
|
||||
}
|
||||
|
||||
long spop(n)
|
||||
size n;
|
||||
{
|
||||
register long l;
|
||||
|
||||
l = st_lds(SP, n);
|
||||
st_dec(max(n, wsize));
|
||||
LOG(("@s7 spop(), return: %ld", l));
|
||||
return (l);
|
||||
}
|
||||
|
||||
pop_dt(d, n)
|
||||
ptr d;
|
||||
size n;
|
||||
{
|
||||
if (n < wsize)
|
||||
dt_stn(d, (long) upop(n), n);
|
||||
else {
|
||||
dt_mvs(d, SP, n);
|
||||
st_dec(n);
|
||||
}
|
||||
}
|
||||
|
||||
pop_st(s, n)
|
||||
ptr s;
|
||||
size n;
|
||||
{
|
||||
if (n < wsize)
|
||||
st_stn(s, (long) upop(n), n);
|
||||
else {
|
||||
st_mvs(s, SP, n);
|
||||
st_dec(n);
|
||||
}
|
||||
}
|
||||
|
||||
#ifndef NOFLOAT
|
||||
double fpop(n)
|
||||
size n;
|
||||
{
|
||||
double d;
|
||||
|
||||
d = st_ldf(SP, n);
|
||||
st_dec(n);
|
||||
return (d);
|
||||
}
|
||||
#endif NOFLOAT
|
||||
|
||||
long wpop()
|
||||
{
|
||||
register long l;
|
||||
|
||||
l = w_in_stack(SP);
|
||||
st_dec(wsize);
|
||||
return (l);
|
||||
}
|
||||
|
||||
/************************************************************************
|
||||
* Stack push division. *
|
||||
************************************************************************
|
||||
* *
|
||||
* dppush(p) - push a data ptr, load from p. *
|
||||
* npush(l, n) - push n bytes, load from l. *
|
||||
* push_dt(d, n) - push n bytes, load from address d in data. *
|
||||
* push_st(s, n) - push n bytes, load from address s in stack. *
|
||||
* fpush(f, n) - push a floating point number, of size n. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
dppush(p)
|
||||
ptr p;
|
||||
{
|
||||
st_inc(psize);
|
||||
st_stdp(SP, p);
|
||||
}
|
||||
|
||||
npush(l, n)
|
||||
long l;
|
||||
size n;
|
||||
{
|
||||
st_inc(max(n, wsize));
|
||||
if (n == 1)
|
||||
l &= MASK1;
|
||||
else
|
||||
if (n == 2)
|
||||
l &= MASK2;
|
||||
st_stn(SP, l, max(n, wsize));
|
||||
|
||||
}
|
||||
|
||||
push_dt(d, n)
|
||||
ptr d;
|
||||
size n;
|
||||
{
|
||||
if (n < wsize) {
|
||||
npush((long) dt_ldu(d, n), n);
|
||||
}
|
||||
else {
|
||||
st_inc(n);
|
||||
st_mvd(SP, d, n);
|
||||
}
|
||||
}
|
||||
|
||||
push_st(s, n)
|
||||
ptr s;
|
||||
size n;
|
||||
{
|
||||
if (n < wsize) {
|
||||
npush((long) st_ldu(s, n), n);
|
||||
}
|
||||
else {
|
||||
st_inc(n);
|
||||
st_mvs(SP, s, n);
|
||||
}
|
||||
}
|
||||
|
||||
#ifndef NOFLOAT
|
||||
fpush(f, n)
|
||||
double f;
|
||||
size n;
|
||||
{
|
||||
st_inc(n);
|
||||
st_stf(SP, f, n);
|
||||
}
|
||||
#endif NOFLOAT
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
PRIVATE warn_stbits(addr, n)
|
||||
ptr addr;
|
||||
size n;
|
||||
{
|
||||
register int or_bits = 0;
|
||||
register int and_bits = 0xff;
|
||||
|
||||
while (n--) {
|
||||
or_bits |= st_sh(addr);
|
||||
and_bits &= st_sh(addr);
|
||||
addr++;
|
||||
}
|
||||
|
||||
if (or_bits != and_bits) {
|
||||
/* no use trying to diagnose */
|
||||
warningcont(WWASMISC);
|
||||
return;
|
||||
}
|
||||
if (or_bits == 0)
|
||||
warningcont(WWASUND);
|
||||
if (or_bits & SH_INT)
|
||||
warningcont(WWASINT);
|
||||
if (or_bits & SH_FLOAT)
|
||||
warningcont(WWASFLOAT);
|
||||
if (or_bits & SH_DATAP)
|
||||
warningcont(WWASDATAP);
|
||||
if (or_bits & SH_INSP)
|
||||
warningcont(WWASINSP);
|
||||
}
|
||||
|
||||
#endif LOGGING
|
||||
|
||||
29
util/int/switch.c
Normal file
29
util/int/switch.c
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
/*
|
||||
The big switch on all the opcodes
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "opcode.h"
|
||||
#include "text.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
|
||||
do_instr(opcode)
|
||||
unsigned int opcode;
|
||||
{
|
||||
switch (opcode) {
|
||||
#include "switch/DoCases" /* for the muscle */
|
||||
case SECONDARY:
|
||||
do_instr(SEC_BASE + nextPCbyte());
|
||||
break;
|
||||
case TERTIARY:
|
||||
do_instr(TERT_BASE + nextPCbyte());
|
||||
break;
|
||||
default:
|
||||
wtrap(WBADOPC, EILLINS);
|
||||
break;
|
||||
}
|
||||
}
|
||||
23
util/int/sysidf.h
Normal file
23
util/int/sysidf.h
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
/*
|
||||
Provisional arrangement for determining the system on which
|
||||
the program is being translated.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#undef BSD4_1 /* Berkeley Software Distr. 4.1 */
|
||||
#define BSD4_2 /* Berkeley Software Distr. 4.2 */
|
||||
#undef SYS_V0 /* System V0 */
|
||||
|
||||
#ifdef BSD4_1
|
||||
#define BSD_X
|
||||
#endif BSD4_1
|
||||
|
||||
#ifdef BSD4_2
|
||||
#define BSD_X
|
||||
#endif BSD4_2
|
||||
|
||||
#ifdef SYS_V0
|
||||
#define SYS_V
|
||||
#endif SYS_V0
|
||||
|
||||
137
util/int/tally.c
Normal file
137
util/int/tally.c
Normal file
|
|
@ -0,0 +1,137 @@
|
|||
/*
|
||||
Gathering run-time statistics
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "global.h"
|
||||
#include "linfil.h"
|
||||
#include "alloc.h"
|
||||
|
||||
struct line_tally { /* one for each line */
|
||||
long lt_cnt; /* counts entrances */
|
||||
long lt_instr; /* counts instructions */
|
||||
};
|
||||
|
||||
struct file_tally { /* one for each file */
|
||||
struct file_tally *next;
|
||||
ptr ft_fil; /* file name */
|
||||
long ft_limit; /* size of line array */
|
||||
struct line_tally *ft_line; /* pointer to line array */
|
||||
};
|
||||
|
||||
PRIVATE struct file_tally *first_tally; /* start of chain */
|
||||
PRIVATE struct file_tally *file; /* present file */
|
||||
|
||||
PRIVATE long lastLIN;
|
||||
|
||||
PRIVATE tally_newFIL();
|
||||
PRIVATE enlarge();
|
||||
|
||||
tally()
|
||||
{
|
||||
if (!FIL)
|
||||
return;
|
||||
|
||||
if (!file || FIL != file->ft_fil) {
|
||||
tally_newFIL(FIL);
|
||||
file->ft_fil = FIL;
|
||||
lastLIN = -1;
|
||||
}
|
||||
if (LIN != lastLIN) {
|
||||
if (LIN >= file->ft_limit) {
|
||||
enlarge(file, LIN);
|
||||
}
|
||||
file->ft_line[LIN].lt_cnt++;
|
||||
lastLIN = LIN;
|
||||
}
|
||||
file->ft_line[LIN].lt_instr++;
|
||||
}
|
||||
|
||||
PRIVATE tally_newFIL(f)
|
||||
ptr f;
|
||||
{
|
||||
struct file_tally **hook = &first_tally;
|
||||
|
||||
while (*hook) {
|
||||
if ((*hook)->ft_fil == f)
|
||||
break;
|
||||
hook = &(*hook)->next;
|
||||
}
|
||||
if (!*hook) {
|
||||
/* first time we see this file */
|
||||
/* construct a new entry */
|
||||
struct file_tally *nt = (struct file_tally *)
|
||||
Malloc((size) sizeof (struct file_tally), "file_tally");
|
||||
|
||||
nt->next = (struct file_tally *)0;
|
||||
nt->ft_fil = f;
|
||||
nt->ft_limit = 1; /* provisional length */
|
||||
nt->ft_line = (struct line_tally *)
|
||||
Malloc((size) sizeof (struct line_tally),
|
||||
"struct line_tally");
|
||||
nt->ft_line[0].lt_cnt = 0;
|
||||
nt->ft_line[0].lt_instr = 0;
|
||||
|
||||
/* and hook it in */
|
||||
*hook = nt;
|
||||
}
|
||||
file = *hook;
|
||||
}
|
||||
|
||||
PRIVATE enlarge(ft, l)
|
||||
struct file_tally *ft;
|
||||
long l;
|
||||
{
|
||||
long limit = allocfrac(l < 100 ? 100 : l);
|
||||
|
||||
if (limit <= ft->ft_limit)
|
||||
return;
|
||||
ft->ft_line = (struct line_tally *)
|
||||
Realloc((char *)ft->ft_line,
|
||||
(size)(limit*sizeof (struct line_tally)),
|
||||
"array line_tally");
|
||||
while (ft->ft_limit < limit) {
|
||||
ft->ft_line[ft->ft_limit].lt_cnt = 0;
|
||||
ft->ft_line[ft->ft_limit].lt_instr = 0;
|
||||
ft->ft_limit++;
|
||||
}
|
||||
}
|
||||
|
||||
PRIVATE FILE *tally_fp;
|
||||
|
||||
out_tally()
|
||||
{
|
||||
struct file_tally **hook = &first_tally;
|
||||
|
||||
if (!*hook)
|
||||
return;
|
||||
|
||||
tally_fp = fopen("int.tally", "w");
|
||||
if (!tally_fp)
|
||||
return;
|
||||
|
||||
while (*hook) {
|
||||
struct file_tally *ft = *hook;
|
||||
register long i;
|
||||
|
||||
fprintf(tally_fp, "%s:\n", dt_fname(ft->ft_fil));
|
||||
for (i = 0; i < ft->ft_limit; i++) {
|
||||
struct line_tally *lt = &ft->ft_line[i];
|
||||
|
||||
if (lt->lt_cnt) {
|
||||
/* we visited this line */
|
||||
fprintf(tally_fp, "\t%ld\t%ld\t%ld\n",
|
||||
i, lt->lt_cnt, lt->lt_instr);
|
||||
}
|
||||
}
|
||||
fprintf(tally_fp, "\n");
|
||||
hook = &(*hook)->next;
|
||||
}
|
||||
|
||||
fclose(tally_fp);
|
||||
tally_fp = 0;
|
||||
}
|
||||
|
||||
47
util/int/text.c
Normal file
47
util/int/text.c
Normal file
|
|
@ -0,0 +1,47 @@
|
|||
/*
|
||||
Manipulating the Program Counter
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "global.h"
|
||||
#include "alloc.h"
|
||||
#include "trap.h"
|
||||
#include "text.h"
|
||||
#include "read.h"
|
||||
#include "proctab.h"
|
||||
#include "warn.h"
|
||||
|
||||
init_text() {
|
||||
DB = i2p(NTEXT); /* set Descriptor Base */
|
||||
NProc = NPROC; /* set Number of Proc. Descriptors */
|
||||
PI = -1; /* initialize Procedure Identifier */
|
||||
PC = 0; /* initialize Program Counter */
|
||||
|
||||
text = Malloc((size)p2i(DB), "text space");
|
||||
}
|
||||
|
||||
|
||||
/************************************************************************
|
||||
* Program Counter division *
|
||||
************************************************************************
|
||||
* *
|
||||
* newPC(p) - check and adjust PC. *
|
||||
* *
|
||||
************************************************************************/
|
||||
|
||||
newPC(p)
|
||||
ptr p;
|
||||
{
|
||||
register struct proc *pr = &proctab[PI];
|
||||
|
||||
if (p >= DB) {
|
||||
wtrap(WPCOVFL, EBADPC);
|
||||
}
|
||||
if (p < pr->pr_ep || p >= pr->pr_ff) {
|
||||
wtrap(WPCPROC, EBADPC);
|
||||
}
|
||||
PC = p;
|
||||
}
|
||||
|
||||
114
util/int/text.h
Normal file
114
util/int/text.h
Normal file
|
|
@ -0,0 +1,114 @@
|
|||
/*
|
||||
Accessing the program text
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#define text_loc(a) (*(text + (p2i(a))))
|
||||
|
||||
/* The bytes in the text segment are unsigned, and this is what is
|
||||
implemented by the macros btol() and btou(). Some operands,
|
||||
however, are signed; this is indicated in the table by P or N.
|
||||
When an operand is positive, it is guaranteed that the leftmost
|
||||
bit is 0, so we can get the value by doing sign extension. Likewise,
|
||||
when the operand is negative the leftmost bit will be 1 and again sign
|
||||
extension yields the right value.
|
||||
Actually we should test if this guarantee is indeed upheld, but that
|
||||
is just too expensive.
|
||||
*/
|
||||
|
||||
/* Reading the opcode.
|
||||
*/
|
||||
#define nextPCbyte() (PC+=1, btou(text_loc(PC-1)))
|
||||
|
||||
/* Shortie arguments consist of the high order value, derived from
|
||||
the opcode and passed as a parameter, and the following byte.
|
||||
*/
|
||||
#define S_arg(h) (PC+=1, ((h)<<8) + btol(text_loc(PC-1)))
|
||||
|
||||
/* Two-byte arguments consist of the following two bytes.
|
||||
*/
|
||||
|
||||
#define L_arg_2() (PC+=2, (btol(text_loc(PC-1)) | \
|
||||
(btos(text_loc(PC-2)) << 8)))
|
||||
|
||||
#define P_arg_2() (PC+=2, (btol(text_loc(PC-1)) | \
|
||||
(btos(text_loc(PC-2)) << 8)))/* should test */
|
||||
|
||||
#define N_arg_2() (PC+=2, (btol(text_loc(PC-1)) | \
|
||||
(btos(text_loc(PC-2)) << 8)))/* should test */
|
||||
|
||||
#define U_arg() (PC+=2, (btol(text_loc(PC-1)) | \
|
||||
(btol(text_loc(PC-2)) << 8)))
|
||||
|
||||
/* The L-, P-, and N-4-bytes #defines are all equal, because
|
||||
we assume our longs to be 4 bytes long.
|
||||
*/
|
||||
|
||||
#define L_arg_4() (PC+=4, (btol(text_loc(PC-1)) | \
|
||||
(btol(text_loc(PC-2)) << 8) | \
|
||||
(btol(text_loc(PC-3)) << 16) | \
|
||||
(btos(text_loc(PC-4)) << 24)))
|
||||
|
||||
#define P_arg_4() (PC+=4, (btol(text_loc(PC-1)) | \
|
||||
(btol(text_loc(PC-2)) << 8) | \
|
||||
(btol(text_loc(PC-3)) << 16) | \
|
||||
(btos(text_loc(PC-4)) << 24)))/* should test */
|
||||
|
||||
#define N_arg_4() (PC+=4, (btol(text_loc(PC-1)) | \
|
||||
(btol(text_loc(PC-2)) << 8) | \
|
||||
(btol(text_loc(PC-3)) << 16) | \
|
||||
(btos(text_loc(PC-4)) << 24)))/* should test */
|
||||
|
||||
|
||||
/*
|
||||
* #defines for argument checks.
|
||||
*/
|
||||
|
||||
#define arg_c(n) ((n < i_minsw || n > i_maxsw) ? \
|
||||
(wtrap(WARGC, EILLINS), 0) : n)
|
||||
|
||||
#define arg_d(n) ((wsize > 2) ? (wtrap(WARGD, EILLINS), 0) : n)
|
||||
|
||||
#define arg_l(n) ((n < min_off || n > max_off) ? \
|
||||
(wtrap(WARGL, EILLINS), 0) : n)
|
||||
|
||||
#define arg_g(p) ((p >= HB) ? (wtrap(WARGG, EILLINS), i2p(0)) : p)
|
||||
|
||||
#define arg_f(n) ((n < min_off || n > max_off) ? \
|
||||
(wtrap(WARGF, EILLINS), 0) : n)
|
||||
|
||||
#define arg_n(u) ((u > i_maxuw) ? (wtrap(WARGL, EILLINS), 0) : u)
|
||||
|
||||
#define arg_s(s) ((s <= 0 || s > max_off || s % wsize) ? \
|
||||
(trap(EODDZ), s) : s)
|
||||
|
||||
#define arg_z(s) ((s < 0 || s > max_off || s % wsize) ? \
|
||||
(trap(EODDZ), s) : s)
|
||||
|
||||
#define arg_o(s) ((s < 0 || s > max_off || (s%wsize && wsize%s)) ? \
|
||||
(trap(EODDZ), s) : s)
|
||||
|
||||
#define arg_w(s) ((s <= 0 || s > max_off || s % wsize) ? \
|
||||
(trap(EODDZ), s) : s)
|
||||
|
||||
#define arg_p(l) ((l >= NProc) ? (wtrap(WARGP, EILLINS), 0) : l)
|
||||
|
||||
#define arg_r(n) ((n < 0 || n > 2) ? (wtrap(WARGR, EILLINS), 0) : n)
|
||||
|
||||
/* tests on widths */
|
||||
#define arg_wn(s) ((s != 1 && s != 2 && s != 4) ? \
|
||||
(trap(EODDZ), s) : s)
|
||||
|
||||
#define arg_wf(s) ((s != 4 && s != 8) ? (trap(EODDZ), s) : s)
|
||||
|
||||
#define arg_wi(s) (((s != 2 && s != 4) || (s % wsize)) ? \
|
||||
(trap(EODDZ), s) : s)
|
||||
|
||||
/* special tests */
|
||||
#define arg_lae(p) ((p > ML) ? (trap(EBADLAE), p) : p)
|
||||
|
||||
#define arg_gto(p) ((p>=HB) ? (wtrap(WGTOSTACK, EBADGTO), p) : p)
|
||||
|
||||
#define arg_lin(u) ((u > NLINE) ? (trap(EBADLIN), u) : u)
|
||||
|
||||
128
util/int/trap.c
Normal file
128
util/int/trap.c
Normal file
|
|
@ -0,0 +1,128 @@
|
|||
/*
|
||||
Trap handling
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <setjmp.h>
|
||||
|
||||
#include <em_abs.h>
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "trap.h"
|
||||
#include "warn.h"
|
||||
#include "mem.h"
|
||||
#include "shadow.h"
|
||||
#include "linfil.h"
|
||||
#include "rsb.h"
|
||||
#include "fra.h"
|
||||
|
||||
extern char *sprintf();
|
||||
|
||||
extern jmp_buf trapbuf; /* from main.c */
|
||||
|
||||
int must_test; /* TEST-bit on in EM header word 2 */
|
||||
int signalled;
|
||||
|
||||
PRIVATE int nonreturnable();
|
||||
|
||||
PRIVATE char *trap_msg[] = {
|
||||
#include "trap_msg" /* generated from $(EM)/etc/traps */
|
||||
""
|
||||
};
|
||||
|
||||
char *trap2text(nr) /* transient */
|
||||
int nr;
|
||||
{
|
||||
if ( /* trap number in predefined range */
|
||||
nr < sizeof (trap_msg) / sizeof (trap_msg[0])
|
||||
&& /* trap message not the empty string */
|
||||
trap_msg[nr][0]
|
||||
) {
|
||||
return trap_msg[nr];
|
||||
}
|
||||
else {
|
||||
static char buf[50];
|
||||
|
||||
sprintf(buf, "TRAP %d", nr);
|
||||
return buf;
|
||||
}
|
||||
}
|
||||
|
||||
/*ARGSUSED*/
|
||||
do_trap(nr, L, F)
|
||||
int nr;
|
||||
int L;
|
||||
char *F;
|
||||
{
|
||||
/*
|
||||
1. The trap has not been masked.
|
||||
2. This routine does not return; it either ends in a call of
|
||||
fatal() or in a longjmp().
|
||||
*/
|
||||
static int rec_nr; /* Recursive trap number */
|
||||
static int rec_trap = 0; /* To detect traps inside do_trap() */
|
||||
|
||||
register long tpi; /* Trap Procedure Identifier */
|
||||
|
||||
LOG(("@t1 trap(%d) [%s: %d]", nr, F, L));
|
||||
warning(WMSG + nr);
|
||||
|
||||
switch (OnTrap) {
|
||||
case TR_ABORT:
|
||||
fatal("trap \"%s\" before program started", trap2text(nr));
|
||||
/*NOTREACHED*/
|
||||
|
||||
case TR_HALT:
|
||||
fatal("trap \"%s\" not caught at %s",
|
||||
trap2text(nr), position());
|
||||
/*NOTREACHED*/
|
||||
|
||||
case TR_TRAP:
|
||||
/* execute the trap */
|
||||
if (rec_trap) {
|
||||
fatal("recursive trap; first trap number was \"%s\"",
|
||||
trap2text(rec_nr));
|
||||
}
|
||||
rec_trap = 1;
|
||||
rec_nr = nr;
|
||||
|
||||
/* save the Function Return Area */
|
||||
pushFRA(FRASize);
|
||||
npush((long)FRASize, wsize);
|
||||
npush((long)FRA_def, wsize);
|
||||
|
||||
/* set up the trap number as the only parameter */
|
||||
npush((long) nr, wsize);
|
||||
|
||||
tpi = TrapPI; /* allowed since OnTrap == TR_TRAP */
|
||||
TrapPI = 0;
|
||||
OnTrap = TR_HALT;
|
||||
call(tpi, (nonreturnable(nr) ? RSB_NRT : RSB_RTT));
|
||||
rec_trap = 0;
|
||||
longjmp(trapbuf, 1);
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
}
|
||||
|
||||
PRIVATE int nonreturnable(nr)
|
||||
int nr;
|
||||
{
|
||||
switch (nr) {
|
||||
case ESTACK:
|
||||
case EILLINS:
|
||||
case EODDZ:
|
||||
case ECASE:
|
||||
case EMEMFLT:
|
||||
case EBADPTR:
|
||||
case EBADPC:
|
||||
case EBADLAE:
|
||||
case EBADGTO:
|
||||
return 1;
|
||||
default:
|
||||
return 0;
|
||||
}
|
||||
/*NOTREACHED*/
|
||||
}
|
||||
|
||||
14
util/int/trap.h
Normal file
14
util/int/trap.h
Normal file
|
|
@ -0,0 +1,14 @@
|
|||
/*
|
||||
Trap handling
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#define wtrap(wn,tr) (warning(wn), trap(tr))
|
||||
#define trap(tr) do_trap(tr, __LINE__, __FILE__)
|
||||
|
||||
extern int signalled; /* signal nr if trap was due to sig */
|
||||
|
||||
extern int must_test; /* must trap on overfl./out of range*/
|
||||
/* TEST-bit on in EM header word 2 */
|
||||
|
||||
5
util/int/v7ioctl.h
Normal file
5
util/int/v7ioctl.h
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
/* $Header$ */
|
||||
|
||||
#define V7IOCTL /* ioctl() requests are from V7 UNIX */
|
||||
/* otherwise from local system */
|
||||
|
||||
158
util/int/warn.c
Normal file
158
util/int/warn.c
Normal file
|
|
@ -0,0 +1,158 @@
|
|||
/*
|
||||
Warnings.
|
||||
*/
|
||||
|
||||
/* $Header$ */
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
#include "logging.h"
|
||||
#include "global.h"
|
||||
#include "log.h"
|
||||
#include "alloc.h"
|
||||
#include "warn.h"
|
||||
#include "linfil.h"
|
||||
|
||||
extern FILE *mess_fp; /* from io.c */
|
||||
extern char *trap2text(); /* from trap.c */
|
||||
|
||||
/******** The warnings ********/
|
||||
|
||||
struct warn_msg {
|
||||
char *wm_text;
|
||||
int wm_nr;
|
||||
};
|
||||
|
||||
#define WMASK 0x5555 /* powers of 4 */
|
||||
|
||||
PRIVATE struct warn_msg warn_msg[] = {
|
||||
#include "warn_msg" /* generated from $(EM)/doc/int */
|
||||
{0, 0} /* sentinel */
|
||||
};
|
||||
|
||||
PRIVATE char *warn_text[WMSG+1];
|
||||
|
||||
init_wmsg()
|
||||
{
|
||||
register int i;
|
||||
register struct warn_msg *wmsg;
|
||||
|
||||
for (i = 0; i <= WMSG; i++) {
|
||||
warn_text[i] = "*** Unknown warning (internal error) ***";
|
||||
}
|
||||
|
||||
for (wmsg = &warn_msg[0]; wmsg->wm_nr; wmsg++) {
|
||||
warn_text[wmsg->wm_nr] = wmsg->wm_text;
|
||||
}
|
||||
}
|
||||
|
||||
/******** The warning counters ********/
|
||||
|
||||
struct warn_cnt {
|
||||
struct warn_cnt *next;
|
||||
ptr wc_fil; /* file name pointer */
|
||||
long wc_lin; /* line number */
|
||||
long wc_cnt; /* the counter */
|
||||
};
|
||||
|
||||
PRIVATE struct warn_cnt *warn_cnt[WMSG];
|
||||
PRIVATE char warnmask[WMSG];
|
||||
|
||||
PRIVATE long count_wrn(nr)
|
||||
int nr;
|
||||
{ /* returns the occurrence counter for the warning with number
|
||||
nr; keeps track of the warnings, sorted by warning number,
|
||||
file name and line number.
|
||||
*/
|
||||
register struct warn_cnt **warn_hook = &warn_cnt[nr];
|
||||
register struct warn_cnt *wrn;
|
||||
|
||||
while (wrn = *warn_hook) {
|
||||
if (wrn->wc_fil == FIL && wrn->wc_lin == LIN) {
|
||||
return ++wrn->wc_cnt;
|
||||
}
|
||||
warn_hook = &wrn->next;
|
||||
}
|
||||
|
||||
wrn = (struct warn_cnt *)
|
||||
Malloc((size) sizeof (struct warn_cnt), (char *)0);
|
||||
if (!wrn) {
|
||||
/* no problem */
|
||||
return 1;
|
||||
}
|
||||
*warn_hook = wrn;
|
||||
wrn->next = 0;
|
||||
wrn->wc_fil = FIL;
|
||||
wrn->wc_lin = LIN;
|
||||
wrn->wc_cnt = 1;
|
||||
return 1;
|
||||
}
|
||||
|
||||
/******** The handling ********/
|
||||
|
||||
#define wmask_on(i) (warnmask[i])
|
||||
|
||||
PRIVATE int latest_warning_printed; /* set if ... */
|
||||
|
||||
/*ARGSUSED*/
|
||||
do_warn(nr, L, F)
|
||||
int nr;
|
||||
int L;
|
||||
char *F;
|
||||
{
|
||||
latest_warning_printed = 0;
|
||||
if (nr < WMSG) {
|
||||
if (!wmask_on(nr)) {
|
||||
register long wrn_cnt = count_wrn(nr);
|
||||
register char *wmsgtxt = warn_text[nr];
|
||||
|
||||
LOG(("@w1 warning: %s [%s: %d]", wmsgtxt, F, L));
|
||||
if ( /* wrn_cnt is a power of two */
|
||||
!((wrn_cnt-1) & wrn_cnt)
|
||||
&& /* and it is the right power of two */
|
||||
(WMASK & wrn_cnt)
|
||||
) {
|
||||
fprintf(mess_fp,
|
||||
"(Warning %d, #%ld): %s at %s\n",
|
||||
nr, wrn_cnt, wmsgtxt, position());
|
||||
latest_warning_printed = 1;
|
||||
}
|
||||
}
|
||||
}
|
||||
else {
|
||||
/* actually a trap number */
|
||||
nr -= WMSG;
|
||||
|
||||
fprintf(mess_fp, "(Warning): Trap occurred - %s at %s\n",
|
||||
trap2text(nr), position());
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef LOGGING
|
||||
|
||||
warningcont(nr)
|
||||
int nr;
|
||||
{
|
||||
/* continued warning */
|
||||
if (latest_warning_printed) {
|
||||
if (!wmask_on(nr)) {
|
||||
register char *wmsgtxt = warn_text[nr];
|
||||
|
||||
LOG(("@w1 warning cont.: %s", wmsgtxt));
|
||||
fprintf(mess_fp,
|
||||
"(Warning %d, cont.): %s at %s\n",
|
||||
nr, wmsgtxt, position());
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#endif LOGGING
|
||||
|
||||
set_wmask(i)
|
||||
int i;
|
||||
{
|
||||
if (i < WMSG) {
|
||||
warnmask[i] = 1;
|
||||
}
|
||||
}
|
||||
|
||||
Loading…
Reference in a new issue