dick 36 éve
szülő
commit
a717832bfb
68 módosított fájl, 15062 hozzáadás és 0 törlés
  1. 716 0
      util/int/ChangeLog
  2. 21 0
      util/int/M.trap_msg
  3. 23 0
      util/int/M.warn_h
  4. 24 0
      util/int/M.warn_msg
  5. 143 0
      util/int/Makefile
  6. 37 0
      util/int/READ_ME
  7. 48 0
      util/int/alloc.c
  8. 14 0
      util/int/alloc.h
  9. 75 0
      util/int/core.c
  10. 371 0
      util/int/data.c
  11. 8 0
      util/int/debug.h
  12. 1776 0
      util/int/disassemble.c
  13. 142 0
      util/int/do_array.c
  14. 515 0
      util/int/do_branch.c
  15. 271 0
      util/int/do_comp.c
  16. 383 0
      util/int/do_conv.c
  17. 639 0
      util/int/do_fpar.c
  18. 455 0
      util/int/do_incdec.c
  19. 434 0
      util/int/do_intar.c
  20. 727 0
      util/int/do_load.c
  21. 347 0
      util/int/do_logic.c
  22. 763 0
      util/int/do_misc.c
  23. 224 0
      util/int/do_proc.c
  24. 202 0
      util/int/do_ptrar.c
  25. 137 0
      util/int/do_sets.c
  26. 412 0
      util/int/do_store.c
  27. 262 0
      util/int/do_unsar.c
  28. 645 0
      util/int/dump.c
  29. 13 0
      util/int/e.out.h
  30. 55 0
      util/int/fra.c
  31. 18 0
      util/int/fra.h
  32. 71 0
      util/int/global.c
  33. 154 0
      util/int/global.h
  34. 202 0
      util/int/init.c
  35. 205 0
      util/int/io.c
  36. 20 0
      util/int/linfil.h
  37. 319 0
      util/int/log.c
  38. 24 0
      util/int/log.h
  39. 4 0
      util/int/logging.h
  40. 301 0
      util/int/m_ioctl.c
  41. 119 0
      util/int/m_sigtrp.c
  42. 194 0
      util/int/main.c
  43. 63 0
      util/int/mem.h
  44. 60 0
      util/int/memdirect.h
  45. 1140 0
      util/int/moncalls.c
  46. 190 0
      util/int/monstruct.c
  47. 69 0
      util/int/monstruct.h
  48. 4 0
      util/int/nofloat.h
  49. 13 0
      util/int/opcode.h
  50. 74 0
      util/int/proctab.c
  51. 13 0
      util/int/proctab.h
  52. 320 0
      util/int/read.c
  53. 18 0
      util/int/read.h
  54. 108 0
      util/int/rsb.c
  55. 31 0
      util/int/rsb.h
  56. 11 0
      util/int/segcheck.h
  57. 84 0
      util/int/segment.c
  58. 101 0
      util/int/shadow.h
  59. 595 0
      util/int/stack.c
  60. 29 0
      util/int/switch.c
  61. 23 0
      util/int/sysidf.h
  62. 137 0
      util/int/tally.c
  63. 47 0
      util/int/text.c
  64. 114 0
      util/int/text.h
  65. 128 0
      util/int/trap.c
  66. 14 0
      util/int/trap.h
  67. 5 0
      util/int/v7ioctl.h
  68. 158 0
      util/int/warn.c

+ 716 - 0
util/int/ChangeLog

@@ -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 - 0
util/int/M.trap_msg

@@ -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 - 0
util/int/M.warn_h

@@ -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 - 0
util/int/M.warn_msg

@@ -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 - 0
util/int/Makefile

@@ -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 - 0
util/int/READ_ME

@@ -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 - 0
util/int/alloc.c

@@ -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 - 0
util/int/alloc.h

@@ -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 - 0
util/int/core.c

@@ -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 - 0
util/int/data.c

@@ -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 - 0
util/int/debug.h

@@ -0,0 +1,8 @@
+/*
+	Various debug flags
+*/
+
+/* $Header$ */
+
+#undef	DB_MALLOC			/* sally malloc area */
+

+ 1776 - 0
util/int/disassemble.c

@@ -0,0 +1,1776 @@
+/*
+	For disassembling the text segment.
+*/
+
+/* $Header$ */
+
+#include	"global.h"
+#include	"opcode.h"
+#include	"memdirect.h"
+#include	"proctab.h"
+#include	"alloc.h"
+
+PRIVATE ptr TC;
+PRIVATE do_pr_instr();
+
+/* This text is copied and modified from text.h */
+
+#define	text_loc(a)	(*(text + (p2i(a))))
+
+/*	Reading the opcode.
+*/
+#define	nextTCbyte()	(TC+=1, btou(text_loc(TC-1)))
+
+/*	Shortie arguments consist of the high order value, derived from
+	the opcode and passed as a parameter, and the following byte.
+*/
+#define	St_arg(h)	(TC+=1, ((h)<<8) + btol(text_loc(TC-1)))
+
+/*	Two-byte arguments consist of the following two bytes.
+*/
+
+#define	Lt_arg_2()	(TC+=2, (btol(text_loc(TC-1)) | \
+				(btos(text_loc(TC-2)) << 8)))
+
+#define	Pt_arg_2()	(TC+=2, (btol(text_loc(TC-1)) | \
+				(btos(text_loc(TC-2)) << 8)))/* should test */
+
+#define	Nt_arg_2()	(TC+=2, (btol(text_loc(TC-1)) | \
+				(btos(text_loc(TC-2)) << 8)))/* should test */
+
+#define	Ut_arg()		(TC+=2, (btol(text_loc(TC-1)) | \
+				(btol(text_loc(TC-2)) << 8)))
+
+/*	The L-, P-, and N-4-bytes #defines are all equal, because
+	we assume our longs to be 4 bytes long.
+*/
+
+#define	Lt_arg_4()	(TC+=4, (btol(text_loc(TC-1)) | \
+				(btol(text_loc(TC-2)) << 8) | \
+				(btol(text_loc(TC-3)) << 16) | \
+				(btos(text_loc(TC-4)) << 24)))
+
+#define	Pt_arg_4()	(TC+=4, (btol(text_loc(TC-1)) | \
+				(btol(text_loc(TC-2)) << 8) | \
+				(btol(text_loc(TC-3)) << 16) | \
+				(btos(text_loc(TC-4)) << 24)))/* should test */
+
+#define	Nt_arg_4()	(TC+=4, (btol(text_loc(TC-1)) | \
+				(btol(text_loc(TC-2)) << 8) | \
+				(btol(text_loc(TC-3)) << 16) | \
+				(btos(text_loc(TC-4)) << 24)))/* should test */
+
+
+/* This text was generated by mkswitch Pr and then modified */
+
+PRIVATE PrAARl2(arg) long arg; 
+{
+	printf(" AAR %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrAARm(arg) long arg; 
+{
+	printf(" AAR %ld\n", arg);
+}
+
+PRIVATE PrAARz() {
+	printf(" AAR\n");
+}
+
+PRIVATE PrADFl2(arg) long arg; 
+{
+	printf(" ADF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrADFs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ADF %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrADFz() {
+	printf(" ADF\n");
+}
+
+PRIVATE PrADIl2(arg) long arg; 
+{
+	printf(" ADI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrADIm(arg) long arg; 
+{
+	printf(" ADI %ld\n", arg);
+}
+
+PRIVATE PrADIz() {
+	printf(" ADI\n");
+}
+
+PRIVATE PrADPl2(arg) long arg; 
+{
+	printf(" ADP %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrADPl4(arg) long arg; 
+{
+	printf(" ADP %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrADPm(arg) long arg; 
+{
+	printf(" ADP %ld\n", arg);
+}
+
+PRIVATE PrADPs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ADP %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrADSl2(arg) long arg; 
+{
+	printf(" ADS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrADSm(arg) long arg; 
+{
+	printf(" ADS %ld\n", arg);
+}
+
+PRIVATE PrADSz() {
+	printf(" ADS\n");
+}
+
+PRIVATE PrADUl2(arg) long arg; 
+{
+	printf(" ADU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrADUz() {
+	printf(" ADU\n");
+}
+
+PRIVATE PrANDl2(arg) long arg; 
+{
+	printf(" AND %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrANDm(arg) long arg; 
+{
+	printf(" AND %ld\n", arg);
+}
+
+PRIVATE PrANDz() {
+	printf(" AND\n");
+}
+
+PRIVATE PrASPl2(arg) long arg; 
+{
+	printf(" ASP %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrASPl4(arg) long arg; 
+{
+	printf(" ASP %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrASPm(arg) long arg; 
+{
+	printf(" ASP %ld\n", arg);
+}
+
+PRIVATE PrASPs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ASP %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrASSl2(arg) long arg; 
+{
+	printf(" ASS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrASSz() {
+	printf(" ASS\n");
+}
+
+PRIVATE PrBEQl2(arg) long arg; 
+{
+	printf(" BEQ %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBEQl4(arg) long arg; 
+{
+	printf(" BEQ %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBEQs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BEQ %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrBGEl2(arg) long arg; 
+{
+	printf(" BGE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBGEl4(arg) long arg; 
+{
+	printf(" BGE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBGEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BGE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrBGTl2(arg) long arg; 
+{
+	printf(" BGT %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBGTl4(arg) long arg; 
+{
+	printf(" BGT %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBGTs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BGT %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrBLEl2(arg) long arg; 
+{
+	printf(" BLE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBLEl4(arg) long arg; 
+{
+	printf(" BLE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBLEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BLE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrBLMl2(arg) long arg; 
+{
+	printf(" BLM %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBLMl4(arg) long arg; 
+{
+	printf(" BLM %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBLMs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BLM %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrBLSl2(arg) long arg; 
+{
+	printf(" BLS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBLSz() {
+	printf(" BLS\n");
+}
+
+PRIVATE PrBLTl2(arg) long arg; 
+{
+	printf(" BLT %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBLTl4(arg) long arg; 
+{
+	printf(" BLT %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBLTs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BLT %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrBNEl2(arg) long arg; 
+{
+	printf(" BNE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBNEl4(arg) long arg; 
+{
+	printf(" BNE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBNEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BNE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrBRAl2(arg) long arg; 
+{
+	printf(" BRA %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrBRAl4(arg) long arg; 
+{
+	printf(" BRA %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrBRAs(hob, wfac) long hob; size wfac; 
+{
+	printf(" BRA %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrCAIz() {
+	printf(" CAI\n");
+}
+
+PRIVATE PrCALl2(arg) long arg; 
+{
+	printf(" CAL %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCALl4(arg) long arg; 
+{
+	printf(" CAL %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrCALm(arg) long arg; 
+{
+	printf(" CAL %ld\n", arg);
+}
+
+PRIVATE PrCALs(hob, wfac) long hob; size wfac; 
+{
+	printf(" CAL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrCFFz() {
+	printf(" CFF\n");
+}
+
+PRIVATE PrCFIz() {
+	printf(" CFI\n");
+}
+
+PRIVATE PrCFUz() {
+	printf(" CFU\n");
+}
+
+PRIVATE PrCIFz() {
+	printf(" CIF\n");
+}
+
+PRIVATE PrCIIz() {
+	printf(" CII\n");
+}
+
+PRIVATE PrCIUz() {
+	printf(" CIU\n");
+}
+
+PRIVATE PrCMFl2(arg) long arg; 
+{
+	printf(" CMF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCMFs(hob, wfac) long hob; size wfac; 
+{
+	printf(" CMF %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrCMFz() {
+	printf(" CMF\n");
+}
+
+PRIVATE PrCMIl2(arg) long arg; 
+{
+	printf(" CMI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCMIm(arg) long arg; 
+{
+	printf(" CMI %ld\n", arg);
+}
+
+PRIVATE PrCMIz() {
+	printf(" CMI\n");
+}
+
+PRIVATE PrCMPz() {
+	printf(" CMP\n");
+}
+
+PRIVATE PrCMSl2(arg) long arg; 
+{
+	printf(" CMS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCMSs(hob, wfac) long hob; size wfac; 
+{
+	printf(" CMS %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrCMSz() {
+	printf(" CMS\n");
+}
+
+PRIVATE PrCMUl2(arg) long arg; 
+{
+	printf(" CMU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCMUz() {
+	printf(" CMU\n");
+}
+
+PRIVATE PrCOMl2(arg) long arg; 
+{
+	printf(" COM %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCOMz() {
+	printf(" COM\n");
+}
+
+PRIVATE PrCSAl2(arg) long arg; 
+{
+	printf(" CSA %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCSAm(arg) long arg; 
+{
+	printf(" CSA %ld\n", arg);
+}
+
+PRIVATE PrCSAz() {
+	printf(" CSA\n");
+}
+
+PRIVATE PrCSBl2(arg) long arg; 
+{
+	printf(" CSB %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrCSBm(arg) long arg; 
+{
+	printf(" CSB %ld\n", arg);
+}
+
+PRIVATE PrCSBz() {
+	printf(" CSB\n");
+}
+
+PRIVATE PrCUFz() {
+	printf(" CUF\n");
+}
+
+PRIVATE PrCUIz() {
+	printf(" CUI\n");
+}
+
+PRIVATE PrCUUz() {
+	printf(" CUU\n");
+}
+
+PRIVATE PrDCHz() {
+	printf(" DCH\n");
+}
+
+PRIVATE PrDECz() {
+	printf(" DEC\n");
+}
+
+PRIVATE PrDEEl2(arg) long arg; 
+{
+	printf(" DEE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrDEEl4(arg) long arg; 
+{
+	printf(" DEE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrDEEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" DEE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrDELn2(arg) long arg; 
+{
+	printf(" DEL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrDELn4(arg) long arg; 
+{
+	printf(" DEL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrDELp2(arg) long arg; 
+{
+	printf(" DEL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrDELp4(arg) long arg; 
+{
+	printf(" DEL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrDELs(hob, wfac) long hob; size wfac; 
+{
+	printf(" DEL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrDUPl2(arg) long arg; 
+{
+	printf(" DUP %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrDUPm(arg) long arg; 
+{
+	printf(" DUP %ld\n", arg);
+}
+
+PRIVATE PrDUSl2(arg) long arg; 
+{
+	printf(" DUS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrDUSz() {
+	printf(" DUS\n");
+}
+
+PRIVATE PrDVFl2(arg) long arg; 
+{
+	printf(" DVF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrDVFs(hob, wfac) long hob; size wfac; 
+{
+	printf(" DVF %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrDVFz() {
+	printf(" DVF\n");
+}
+
+PRIVATE PrDVIl2(arg) long arg; 
+{
+	printf(" DVI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrDVIm(arg) long arg; 
+{
+	printf(" DVI %ld\n", arg);
+}
+
+PRIVATE PrDVIz() {
+	printf(" DVI\n");
+}
+
+PRIVATE PrDVUl2(arg) long arg; 
+{
+	printf(" DVU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrDVUz() {
+	printf(" DVU\n");
+}
+
+PRIVATE PrEXGl2(arg) long arg; 
+{
+	printf(" EXG %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrEXGs(hob, wfac) long hob; size wfac; 
+{
+	printf(" EXG %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrEXGz() {
+	printf(" EXG\n");
+}
+
+PRIVATE PrFEFl2(arg) long arg; 
+{
+	printf(" FEF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrFEFz() {
+	printf(" FEF\n");
+}
+
+PRIVATE PrFIFl2(arg) long arg; 
+{
+	printf(" FIF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrFIFz() {
+	printf(" FIF\n");
+}
+
+PRIVATE PrFILu(arg) long arg; 
+{
+	printf(" FIL %ld\n", Ut_arg() * arg);
+}
+
+PRIVATE PrFILl4(arg) long arg; 
+{
+	printf(" FIL %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrGTOu(arg) long arg; 
+{
+	printf(" GTO %ld\n", Ut_arg() * arg);
+}
+
+PRIVATE PrGTOl4(arg) long arg; 
+{
+	printf(" GTO %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrINCz() {
+	printf(" INC\n");
+}
+
+PRIVATE PrINEl2(arg) long arg; 
+{
+	printf(" INE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrINEl4(arg) long arg; 
+{
+	printf(" INE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrINEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" INE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrINLm(arg) long arg; 
+{
+	printf(" INL %ld\n", arg);
+}
+
+PRIVATE PrINLn2(arg) long arg; 
+{
+	printf(" INL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrINLn4(arg) long arg; 
+{
+	printf(" INL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrINLp2(arg) long arg; 
+{
+	printf(" INL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrINLp4(arg) long arg; 
+{
+	printf(" INL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrINLs(hob, wfac) long hob; size wfac; 
+{
+	printf(" INL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrINNl2(arg) long arg; 
+{
+	printf(" INN %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrINNs(hob, wfac) long hob; size wfac; 
+{
+	printf(" INN %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrINNz() {
+	printf(" INN\n");
+}
+
+PRIVATE PrIORl2(arg) long arg; 
+{
+	printf(" IOR %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrIORm(arg) long arg; 
+{
+	printf(" IOR %ld\n", arg);
+}
+
+PRIVATE PrIORs(hob, wfac) long hob; size wfac; 
+{
+	printf(" IOR %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrIORz() {
+	printf(" IOR\n");
+}
+
+PRIVATE PrLAEu(arg) long arg; 
+{
+	printf(" LAE %ld\n", Ut_arg() * arg);
+}
+
+PRIVATE PrLAEl4(arg) long arg; 
+{
+	printf(" LAE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLAEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LAE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLALm(arg) long arg; 
+{
+	printf(" LAL %ld\n", arg);
+}
+
+PRIVATE PrLALn2(arg) long arg; 
+{
+	printf(" LAL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrLALn4(arg) long arg; 
+{
+	printf(" LAL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrLALp2(arg) long arg; 
+{
+	printf(" LAL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrLALp4(arg) long arg; 
+{
+	printf(" LAL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrLALs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LAL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLARl2(arg) long arg; 
+{
+	printf(" LAR %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLARm(arg) long arg; 
+{
+	printf(" LAR %ld\n", arg);
+}
+
+PRIVATE PrLARz() {
+	printf(" LAR\n");
+}
+
+PRIVATE PrLDCl2(arg) long arg; 
+{
+	printf(" LDC %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLDCl4(arg) long arg; 
+{
+	printf(" LDC %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLDCm(arg) long arg; 
+{
+	printf(" LDC %ld\n", arg);
+}
+
+PRIVATE PrLDEl2(arg) long arg; 
+{
+	printf(" LDE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLDEl4(arg) long arg; 
+{
+	printf(" LDE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLDEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LDE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLDFl2(arg) long arg; 
+{
+	printf(" LDF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLDFl4(arg) long arg; 
+{
+	printf(" LDF %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLDLm(arg) long arg; 
+{
+	printf(" LDL %ld\n", arg);
+}
+
+PRIVATE PrLDLn2(arg) long arg; 
+{
+	printf(" LDL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrLDLn4(arg) long arg; 
+{
+	printf(" LDL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrLDLp2(arg) long arg; 
+{
+	printf(" LDL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrLDLp4(arg) long arg; 
+{
+	printf(" LDL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrLDLs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LDL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLFRl2(arg) long arg; 
+{
+	printf(" LFR %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLFRm(arg) long arg; 
+{
+	printf(" LFR %ld\n", arg);
+}
+
+PRIVATE PrLFRs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LFR %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLILm(arg) long arg; 
+{
+	printf(" LIL %ld\n", arg);
+}
+
+PRIVATE PrLILn2(arg) long arg; 
+{
+	printf(" LIL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrLILn4(arg) long arg; 
+{
+	printf(" LIL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrLILp2(arg) long arg; 
+{
+	printf(" LIL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrLILp4(arg) long arg; 
+{
+	printf(" LIL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrLILs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LIL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLIMz() {
+	printf(" LIM\n");
+}
+
+PRIVATE PrLINl2(arg) long arg; 
+{
+	printf(" LIN %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLINl4(arg) long arg; 
+{
+	printf(" LIN %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLINs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LIN %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLNIz() {
+	printf(" LNI\n");
+}
+
+PRIVATE PrLOCl2(arg) long arg; 
+{
+	printf(" LOC %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLOCl4(arg) long arg; 
+{
+	printf(" LOC %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLOCm(arg) long arg; 
+{
+	printf(" LOC %ld\n", arg);
+}
+
+PRIVATE PrLOCs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LOC %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLOEl2(arg) long arg; 
+{
+	printf(" LOE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLOEl4(arg) long arg; 
+{
+	printf(" LOE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLOEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LOE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLOFl2(arg) long arg; 
+{
+	printf(" LOF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLOFl4(arg) long arg; 
+{
+	printf(" LOF %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLOFm(arg) long arg; 
+{
+	printf(" LOF %ld\n", arg);
+}
+
+PRIVATE PrLOFs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LOF %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLOIl2(arg) long arg; 
+{
+	printf(" LOI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLOIl4(arg) long arg; 
+{
+	printf(" LOI %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLOIm(arg) long arg; 
+{
+	printf(" LOI %ld\n", arg);
+}
+
+PRIVATE PrLOIs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LOI %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLOLm(arg) long arg; 
+{
+	printf(" LOL %ld\n", arg);
+}
+
+PRIVATE PrLOLn2(arg) long arg; 
+{
+	printf(" LOL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrLOLn4(arg) long arg; 
+{
+	printf(" LOL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrLOLp2(arg) long arg; 
+{
+	printf(" LOL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrLOLp4(arg) long arg; 
+{
+	printf(" LOL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrLOLs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LOL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLORs(hob, wfac) long hob; size wfac; 
+{
+	printf(" LOR %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrLOSl2(arg) long arg; 
+{
+	printf(" LOS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLOSz() {
+	printf(" LOS\n");
+}
+
+PRIVATE PrLPBz() {
+	printf(" LPB\n");
+}
+
+PRIVATE PrLPIl2(arg) long arg; 
+{
+	printf(" LPI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLPIl4(arg) long arg; 
+{
+	printf(" LPI %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrLXAl2(arg) long arg; 
+{
+	printf(" LXA %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLXAm(arg) long arg; 
+{
+	printf(" LXA %ld\n", arg);
+}
+
+PRIVATE PrLXLl2(arg) long arg; 
+{
+	printf(" LXL %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrLXLm(arg) long arg; 
+{
+	printf(" LXL %ld\n", arg);
+}
+
+PRIVATE PrMLFl2(arg) long arg; 
+{
+	printf(" MLF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrMLFs(hob, wfac) long hob; size wfac; 
+{
+	printf(" MLF %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrMLFz() {
+	printf(" MLF\n");
+}
+
+PRIVATE PrMLIl2(arg) long arg; 
+{
+	printf(" MLI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrMLIm(arg) long arg; 
+{
+	printf(" MLI %ld\n", arg);
+}
+
+PRIVATE PrMLIz() {
+	printf(" MLI\n");
+}
+
+PRIVATE PrMLUl2(arg) long arg; 
+{
+	printf(" MLU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrMLUz() {
+	printf(" MLU\n");
+}
+
+PRIVATE PrMONz() {
+	printf(" MON\n");
+}
+
+PRIVATE PrNGFl2(arg) long arg; 
+{
+	printf(" NGF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrNGFz() {
+	printf(" NGF\n");
+}
+
+PRIVATE PrNGIl2(arg) long arg; 
+{
+	printf(" NGI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrNGIz() {
+	printf(" NGI\n");
+}
+
+PRIVATE PrNOPz() {
+	printf(" NOP\n");
+}
+
+PRIVATE PrRCKl2(arg) long arg; 
+{
+	printf(" RCK %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrRCKm(arg) long arg; 
+{
+	printf(" RCK %ld\n", arg);
+}
+
+PRIVATE PrRCKz() {
+	printf(" RCK\n");
+}
+
+PRIVATE PrRETl2(arg) long arg; 
+{
+	printf(" RET %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrRETm(arg) long arg; 
+{
+	printf(" RET %ld\n", arg);
+}
+
+PRIVATE PrRETs(hob, wfac) long hob; size wfac; 
+{
+	printf(" RET %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrRMIl2(arg) long arg; 
+{
+	printf(" RMI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrRMIm(arg) long arg; 
+{
+	printf(" RMI %ld\n", arg);
+}
+
+PRIVATE PrRMIz() {
+	printf(" RMI\n");
+}
+
+PRIVATE PrRMUl2(arg) long arg; 
+{
+	printf(" RMU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrRMUz() {
+	printf(" RMU\n");
+}
+
+PRIVATE PrROLl2(arg) long arg; 
+{
+	printf(" ROL %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrROLz() {
+	printf(" ROL\n");
+}
+
+PRIVATE PrRORl2(arg) long arg; 
+{
+	printf(" ROR %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrRORz() {
+	printf(" ROR\n");
+}
+
+PRIVATE PrRTTz() {
+	printf(" RTT\n");
+}
+
+PRIVATE PrSARl2(arg) long arg; 
+{
+	printf(" SAR %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSARm(arg) long arg; 
+{
+	printf(" SAR %ld\n", arg);
+}
+
+PRIVATE PrSARz() {
+	printf(" SAR\n");
+}
+
+PRIVATE PrSBFl2(arg) long arg; 
+{
+	printf(" SBF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSBFs(hob, wfac) long hob; size wfac; 
+{
+	printf(" SBF %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSBFz() {
+	printf(" SBF\n");
+}
+
+PRIVATE PrSBIl2(arg) long arg; 
+{
+	printf(" SBI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSBIm(arg) long arg; 
+{
+	printf(" SBI %ld\n", arg);
+}
+
+PRIVATE PrSBIz() {
+	printf(" SBI\n");
+}
+
+PRIVATE PrSBSl2(arg) long arg; 
+{
+	printf(" SBS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSBSz() {
+	printf(" SBS\n");
+}
+
+PRIVATE PrSBUl2(arg) long arg; 
+{
+	printf(" SBU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSBUz() {
+	printf(" SBU\n");
+}
+
+PRIVATE PrSDEu(arg) long arg; 
+{
+	printf(" SDE %ld\n", Ut_arg() * arg);
+}
+
+PRIVATE PrSDEl4(arg) long arg; 
+{
+	printf(" SDE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrSDFl2(arg) long arg; 
+{
+	printf(" SDF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSDFl4(arg) long arg; 
+{
+	printf(" SDF %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrSDLn2(arg) long arg; 
+{
+	printf(" SDL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrSDLn4(arg) long arg; 
+{
+	printf(" SDL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrSDLp2(arg) long arg; 
+{
+	printf(" SDL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrSDLp4(arg) long arg; 
+{
+	printf(" SDL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrSDLs(hob, wfac) long hob; size wfac; 
+{
+	printf(" SDL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSETl2(arg) long arg; 
+{
+	printf(" SET %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSETs(hob, wfac) long hob; size wfac; 
+{
+	printf(" SET %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSETz() {
+	printf(" SET\n");
+}
+
+PRIVATE PrSIGz() {
+	printf(" SIG\n");
+}
+
+PRIVATE PrSILn2(arg) long arg; 
+{
+	printf(" SIL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrSILn4(arg) long arg; 
+{
+	printf(" SIL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrSILp2(arg) long arg; 
+{
+	printf(" SIL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrSILp4(arg) long arg; 
+{
+	printf(" SIL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrSILs(hob, wfac) long hob; size wfac; 
+{
+	printf(" SIL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSIMz() {
+	printf(" SIM\n");
+}
+
+PRIVATE PrSLIl2(arg) long arg; 
+{
+	printf(" SLI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSLIm(arg) long arg; 
+{
+	printf(" SLI %ld\n", arg);
+}
+
+PRIVATE PrSLIz() {
+	printf(" SLI\n");
+}
+
+PRIVATE PrSLUl2(arg) long arg; 
+{
+	printf(" SLU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSLUz() {
+	printf(" SLU\n");
+}
+
+PRIVATE PrSRIl2(arg) long arg; 
+{
+	printf(" SRI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSRIz() {
+	printf(" SRI\n");
+}
+
+PRIVATE PrSRUl2(arg) long arg; 
+{
+	printf(" SRU %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSRUz() {
+	printf(" SRU\n");
+}
+
+PRIVATE PrSTEl2(arg) long arg; 
+{
+	printf(" STE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSTEl4(arg) long arg; 
+{
+	printf(" STE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrSTEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" STE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSTFl2(arg) long arg; 
+{
+	printf(" STF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSTFl4(arg) long arg; 
+{
+	printf(" STF %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrSTFm(arg) long arg; 
+{
+	printf(" STF %ld\n", arg);
+}
+
+PRIVATE PrSTFs(hob, wfac) long hob; size wfac; 
+{
+	printf(" STF %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSTIl2(arg) long arg; 
+{
+	printf(" STI %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSTIl4(arg) long arg; 
+{
+	printf(" STI %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrSTIm(arg) long arg; 
+{
+	printf(" STI %ld\n", arg);
+}
+
+PRIVATE PrSTIs(hob, wfac) long hob; size wfac; 
+{
+	printf(" STI %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSTLm(arg) long arg; 
+{
+	printf(" STL %ld\n", arg);
+}
+
+PRIVATE PrSTLn2(arg) long arg; 
+{
+	printf(" STL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrSTLn4(arg) long arg; 
+{
+	printf(" STL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrSTLp2(arg) long arg; 
+{
+	printf(" STL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrSTLp4(arg) long arg; 
+{
+	printf(" STL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrSTLs(hob, wfac) long hob; size wfac; 
+{
+	printf(" STL %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSTRs(hob, wfac) long hob; size wfac; 
+{
+	printf(" STR %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrSTSl2(arg) long arg; 
+{
+	printf(" STS %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrSTSz() {
+	printf(" STS\n");
+}
+
+PRIVATE PrTEQz() {
+	printf(" TEQ\n");
+}
+
+PRIVATE PrTGEz() {
+	printf(" TGE\n");
+}
+
+PRIVATE PrTGTz() {
+	printf(" TGT\n");
+}
+
+PRIVATE PrTLEz() {
+	printf(" TLE\n");
+}
+
+PRIVATE PrTLTz() {
+	printf(" TLT\n");
+}
+
+PRIVATE PrTNEz() {
+	printf(" TNE\n");
+}
+
+PRIVATE PrTRPz() {
+	printf(" TRP\n");
+}
+
+PRIVATE PrXORl2(arg) long arg; 
+{
+	printf(" XOR %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrXORz() {
+	printf(" XOR\n");
+}
+
+PRIVATE PrZEQl2(arg) long arg; 
+{
+	printf(" ZEQ %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZEQl4(arg) long arg; 
+{
+	printf(" ZEQ %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrZEQs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZEQ %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZERl2(arg) long arg; 
+{
+	printf(" ZER %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZERs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZER %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZERz() {
+	printf(" ZER\n");
+}
+
+PRIVATE PrZGEl2(arg) long arg; 
+{
+	printf(" ZGE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZGEl4(arg) long arg; 
+{
+	printf(" ZGE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrZGEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZGE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZGTl2(arg) long arg; 
+{
+	printf(" ZGT %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZGTl4(arg) long arg; 
+{
+	printf(" ZGT %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrZGTs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZGT %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZLEl2(arg) long arg; 
+{
+	printf(" ZLE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZLEl4(arg) long arg; 
+{
+	printf(" ZLE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrZLEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZLE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZLTl2(arg) long arg; 
+{
+	printf(" ZLT %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZLTl4(arg) long arg; 
+{
+	printf(" ZLT %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrZLTs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZLT %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZNEl2(arg) long arg; 
+{
+	printf(" ZNE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZNEl4(arg) long arg; 
+{
+	printf(" ZNE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrZNEs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZNE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZREl2(arg) long arg; 
+{
+	printf(" ZRE %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZREl4(arg) long arg; 
+{
+	printf(" ZRE %ld\n", Lt_arg_4() * arg);
+}
+
+PRIVATE PrZREs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZRE %ld\n", St_arg(hob) * wfac);
+}
+
+PRIVATE PrZRFl2(arg) long arg; 
+{
+	printf(" ZRF %ld\n", Lt_arg_2() * arg);
+}
+
+PRIVATE PrZRFz() {
+	printf(" ZRF\n");
+}
+
+PRIVATE PrZRLm(arg) long arg; 
+{
+	printf(" ZRL %ld\n", arg);
+}
+
+PRIVATE PrZRLn2(arg) long arg; 
+{
+	printf(" ZRL %ld\n", Nt_arg_2() * arg);
+}
+
+PRIVATE PrZRLn4(arg) long arg; 
+{
+	printf(" ZRL %ld\n", Nt_arg_4() * arg);
+}
+
+PRIVATE PrZRLp2(arg) long arg; 
+{
+	printf(" ZRL %ld\n", Pt_arg_2() * arg);
+}
+
+PRIVATE PrZRLp4(arg) long arg; 
+{
+	printf(" ZRL %ld\n", Pt_arg_4() * arg);
+}
+
+PRIVATE PrZRLs(hob, wfac) long hob; size wfac; 
+{
+	printf(" ZRL %ld\n", St_arg(hob) * wfac);
+}
+
+/* Original code! */
+
+/******** Disassembly of Text Segment ********/
+
+struct ep {				/* procedure entry points */
+	int ep_idf;
+	ptr ep_ep;
+	size ep_nloc;
+};
+
+disassemble()
+{
+	register ptr low = 0;
+	register ptr high = DB;
+	register int idf;
+	register int cnt;
+	struct ep *ep;			/* list of entry points */
+
+	/* collect the entry points */
+	ep = (struct ep *)Malloc((size)(NProc * sizeof (struct ep)),
+							"entry points");
+	for (idf = 0; idf < NProc; idf++) {
+		register struct proc *pr = &proctab[idf];
+		
+		ep[idf].ep_idf = idf;
+		ep[idf].ep_ep = pr->pr_ep;
+		ep[idf].ep_nloc = pr->pr_nloc;
+	}
+
+	/* a very naive sorting algorithm */
+	for (idf = 0; idf < NProc; idf++) {
+		register int jdf;
+
+		for (jdf = 0; jdf < NProc; jdf++) {
+			if (	(ep[idf].ep_ep < ep[jdf].ep_ep)
+				!= (idf < jdf)
+			) {
+				struct ep p;
+				p = ep[idf];
+				ep[idf] = ep[jdf];
+				ep[jdf] = p;
+			}
+		}
+	}
+
+	TC = low;
+	cnt = 0;
+	idf = 0;
+	while (TC < high) {
+		if (cnt == 0) {
+			printf("%lu\n", TC);
+		}
+		cnt = (cnt + 1) % 10;
+
+		if (idf < NProc && TC >=ep[idf].ep_ep) {
+			register struct ep *p = &ep[idf];
+
+			printf("P[%d]+%lu:	; %ld %s\n",
+				p->ep_idf, TC - p->ep_ep,
+				p->ep_nloc,
+				p->ep_nloc == 1 ? "local" : "locals");
+			idf++;
+		}
+
+		do_pr_instr(nextTCbyte());	/* advances TC */
+	}
+}
+
+/* See switch.c */
+
+PRIVATE do_pr_instr(opcode)
+	unsigned int opcode;
+{
+	switch (opcode) {
+#include	"switch/PrCases"	/* for the muscle */
+		case SECONDARY:
+			do_pr_instr(SEC_BASE + nextTCbyte());
+			break;
+		case TERTIARY:
+			do_pr_instr(TERT_BASE + nextTCbyte());
+			break;
+		default:
+			printf(">>>> bad opcode %d at PC = %lu <<<<\n",
+					opcode, TC);
+			break;
+	}
+}
+
+
+

+ 142 - 0
util/int/do_array.c

@@ -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 - 0
util/int/do_branch.c

@@ -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 - 0
util/int/do_comp.c

@@ -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 - 0
util/int/do_conv.c

@@ -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 - 0
util/int/do_fpar.c

@@ -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 - 0
util/int/do_incdec.c

@@ -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 - 0
util/int/do_intar.c

@@ -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 - 0
util/int/do_load.c

@@ -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 - 0
util/int/do_logic.c

@@ -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 - 0
util/int/do_misc.c

@@ -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 - 0
util/int/do_proc.c

@@ -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 - 0
util/int/do_ptrar.c

@@ -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 - 0
util/int/do_sets.c

@@ -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 - 0
util/int/do_store.c

@@ -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 - 0
util/int/do_unsar.c

@@ -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 - 0
util/int/dump.c

@@ -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 - 0
util/int/e.out.h

@@ -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 - 0
util/int/fra.c

@@ -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 - 0
util/int/fra.h

@@ -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 - 0
util/int/global.c

@@ -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 - 0
util/int/global.h

@@ -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 - 0
util/int/init.c

@@ -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 - 0
util/int/io.c

@@ -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 - 0
util/int/linfil.h

@@ -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 - 0
util/int/log.c

@@ -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 - 0
util/int/log.h

@@ -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 - 0
util/int/logging.h

@@ -0,0 +1,4 @@
+/* $Header$ */
+
+#define	LOGGING		1		/* Includes logging when defined */
+

+ 301 - 0
util/int/m_ioctl.c

@@ -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 *) &ltc_buf)) == -1
+		||	!ltchars2mem(addr, &ltc_buf)
+		) {
+			e = -1;		/* errno already set */
+		}
+		break;
+
+	case TIOCSLTC:
+		/* set ltc_buf; load from addr */
+		if (	!mem2ltchars(addr, &ltc_buf)
+		||	(e = ioctl(fd, req, (char *) &ltc_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 - 0
util/int/m_sigtrp.c

@@ -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 - 0
util/int/main.c

@@ -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 - 0
util/int/mem.h

@@ -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 - 0
util/int/memdirect.h

@@ -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 - 0
util/int/moncalls.c

@@ -0,0 +1,1140 @@
+/*
+	The MON instruction
+*/
+
+/* $Header$ */
+
+#include	"sysidf.h"
+#include	"log.h"
+#include	"alloc.h"
+#include	"shadow.h"
+
+#include	<sys/types.h>
+#include	<sys/stat.h>
+#include	<sys/times.h>
+
+extern int errno;			/* UNIX error number */
+
+extern int running;			/* from main.c */
+extern int fd_limit;			/* from io.c */
+
+#define	good_fd(fd)	(fd < fd_limit ? 1 : (errno = 9 /* EBADF */, 0))
+
+#ifdef	BSD_X				/* from system.h */
+#include	<sys/timeb.h>
+#endif	BSD_X
+#ifdef	SYS_V
+struct timeb {			/* non-existing; we use an ad-hoc definition */
+	long time;
+	unsigned short millitm;
+	short timezone, dstflag;
+};
+#endif	SYS_V
+
+#ifdef	BSD4_2				/* from system.h */
+#include	<sys/time.h>
+#include	<sys/wait.h>
+#endif	BSD4_2
+
+#ifdef	SYS_V
+#include	<sys/errno.h>
+#undef		ERANGE			/* collision with trap.h */
+#include	<fcntl.h>
+#include	<time.h>
+#endif	SYS_V
+
+#include	<em_abs.h>
+#include	"logging.h"
+#include	"global.h"
+#include	"trap.h"
+#include	"warn.h"
+#include	"mem.h"
+
+#define	INPUT		0
+#define	OUTPUT		1
+
+#define	DUPMASK		0x40
+
+#ifdef	BSD4_2				/* from system.h */
+extern int times();
+#else
+extern long times();
+#endif	BSD4_2
+extern long lseek();
+#ifdef	SYS_V
+extern unsigned int alarm();
+extern long time();
+extern void sync();
+#endif	SYS_V
+
+#define	INT2SIZE	max(wsize, 2L)
+#define	INT4SIZE	max(wsize, 4L)
+
+#define	pop_int()	((int) spop(wsize))
+#define	pop_int2()	((int) spop(INT2SIZE))
+#define	pop_int4()	(spop(INT4SIZE))
+#define	pop_intp()	((int) spop(psize))
+#define	pop_uns2()	((unsigned int) upop(INT2SIZE))
+#define	pop_unsp()	((unsigned int) upop(psize))
+#define	pop_ptr()	(dppop())
+
+#define	push_int(a)	(npush((long)(a), wsize))
+#define	push_i2(a)	(npush((long)(a), INT2SIZE))
+#define	push_i4(a)	(npush((long)(a), INT4SIZE))
+#define	push_unsp(a)	(npush((long)(a), psize))
+
+#define	push_err()	{ push_int(errno); push_int(errno); }
+
+/************************************************************************
+ *				Monitor calls.				*
+ *									*
+ *	The instruction "MON" expects a wsized integer on top of	*
+ *	top of the stack, which identifies the call. Often there	*
+ *	are also parameters following this number. The parameters	*
+ *	were stacked in reverse order (C convention).			*
+ *	The possible parameter types are :				*
+ *									*
+ *		1) int : integer of wordsize				*
+ *		2) int2: integer with size max(2, wordsize)		*
+ *		3) int4: integer with size max(4, wordsize)		*
+ *		4) intp: integer with size of a pointer			*
+ *		5) uns2: unsigned integer with size max(2, wordsize)	*
+ *		6) unsp: unsigned integer with size of a pointer	*
+ *		7) ptr : pointer into data space			*
+ *									*
+ *	After the call has been executed, a return code is present	*
+ *	on top of the stack. If this return code equals zero, the call	*
+ *	succeeded and the results of the call can be found right	*
+ *	after the return code. A non zero return code indicates a	*
+ *	failure.  In this case no results are available and the return	*
+ *	code has been pushed twice.					*
+ *									*
+ *	Monitor calls such as "ioctl", "stat", "ftime", etc. work	*
+ *	with a private buffer to be filled by the call. The fields	*
+ *	of the buffer are written to EM-memory separately, possibly	*
+ *	with some of the fields aligned.  To this end a number of	*
+ *	transport routines are assembled in monstruct.[ch].		*
+ *									*
+ *	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.  A number	*
+ *	of 4.1 BSD specific parameters have also been implemented.	*
+ *									*
+ ************************************************************************/
+
+PRIVATE size buf_cnt[5];		/* Current sizes of the buffers */
+PRIVATE char *buf[5];			/* Pointers to the buffers */
+
+PRIVATE check_buf();
+PRIVATE int savestr();
+PRIVATE int vec();
+
+moncall()
+{
+	int n;				/* number actually read/written */
+#ifndef	BSD4_2				/* from system.h */
+	int status;			/* status for wait-call */
+#else	BSD4_2
+	union wait status;		/* status for wait-call */
+#endif	BSD4_2
+	int flag;			/* various flag parameters */
+	int mode;			/* various mode parameters */
+	int oldmask;			/* for umask call */
+	int whence;			/* parameter for lseek */
+	int address;			/* address parameter typed int2 */
+	int owner;			/* owner parameter typed int2 */
+	int group;			/* group parameter typed int2 */
+	int pid;			/* pid parameter typed int2 */
+	int ppid;			/* parent process pid */
+	long off;			/* offset parameter */
+	int pfds[2];			/* pipe file descriptors */
+	long tm;			/* for stime call */
+	long actime, modtime;		/* for utime */
+	int incr;			/* for nice call */
+	int fd, fdnew;			/* file descriptors */
+	int groupid;			/* group id */
+	int userid;			/* user id */
+	int sig;			/* killing signal */
+	ptr dsp1, dsp2, dsp3;		/* Data Space Pointers */
+	int nbytes;			/* number to be read/written */
+	unsigned int seconds;		/* for alarm call */
+	int trap_no;			/* for sigtrp; trap number */
+	int old_trap_no;		/* for sigtrp; old trap number */
+	int sig_no;			/* for sigtrp; signal number */
+	int request;			/* ioctl and ptrace request */
+	char **envvec;			/* environment vector (exec) */
+	char **argvec;			/* argument vector (exec) */
+
+	struct stat st_buf;		/* private stat buffer */
+	struct tms tm_buf;		/* private tms buffer */
+	struct timeb tb_buf;		/* private timeb buffer */
+
+#ifdef	BSD4_2				/* from system.h */
+	struct timeval tv;		/* private timeval buffer */
+#endif	BSD4_2			
+
+#ifdef	BSD_X				/* from system.h */
+	time_t utimbuf[2];		/* private utime buffer */
+#endif	BSD_X
+#ifdef	SYS_V				/* from system.h */
+	struct {time_t x, y;} utimbuf;	/* private utime buffer */
+#endif	SYS_V
+
+	char *cp;
+	int nr;
+	ptr addr;
+	int rc;
+
+	switch (pop_int()) {
+
+	case 1:				/* Exit */
+
+#ifdef	LOGGING
+		ES_def =
+			((st_sh(SP) == UNDEFINED)
+				|| (st_sh(SP + wsize-1) == UNDEFINED)) ?
+			UNDEFINED : DEFINED;
+#else
+		ES_def = DEFINED;
+#endif	LOGGING
+		ES = pop_int();
+		running = 0;		/* stop the machine */
+		LOG(("@m9 Exit: ES = %ld", ES));
+		break;
+
+	case 2:				/* Fork */
+
+		ppid = getpid();
+		if ((pid = fork()) == 0) {
+			/* Child */
+			init_ofiles(0);	/* Reinitialize */
+			push_int(ppid);	/* Pid of parent */
+			push_int(1);	/* Flag = 1 for child */
+			push_int(0);
+			LOG(("@m9 Fork: in child, ppid = %d", ppid));
+		}
+		else if (pid > 0) {	/* Parent */
+			incr_mess_id();	/* Incr. id for next child */
+			push_int(pid);	/* Pid of child */
+			push_int(0);	/* Flag = 0 for parent */
+			push_int(0);
+			LOG(("@m9 Fork: in parent, cpid = %d", pid));
+		}
+		else {
+			/* fork call failed */
+			push_err();
+			LOG(("@m4 Fork: failed, pid = %d, errno = %d",
+				pid, errno));
+		}
+		break;
+
+	case 3:				/* Read */
+
+		fd = pop_int();
+		dsp1 = pop_ptr();
+		nbytes = pop_intp();
+
+		if (!good_fd(fd))
+			goto read_error;
+		if (nbytes < 0) {
+			errno = 22;	/* EINVAL */
+			goto read_error;
+		}
+
+		check_buf(0, (size)nbytes);
+		if ((n = read(fd, buf[0], nbytes)) == -1)
+			goto read_error;
+
+#ifdef	LOGGING
+		if (check_log("@m6")) {
+			register int i;
+			
+			for (i = 0; i < n; i++) {
+				LOG(("@m6 Read: char = '%c'", *(buf[0] + i)));
+			}
+		}
+#endif	LOGGING
+
+		if (in_gda(dsp1) && !in_gda(dsp1 + (n-1))) {
+			efault(WRGDAH);
+			goto read_error;
+		}
+
+		if (!is_in_mem(dsp1, n)) {
+			efault(WRUMEM);
+			goto read_error;
+		}
+
+		for (	nr = n, cp = buf[0], addr = dsp1;
+			nr;
+			nr--, addr++, cp++
+		) {
+			if (in_stack(addr)) {
+				ch_st_prot(addr);
+				stack_loc(addr) = *cp;
+				st_int(addr);
+			}
+			else {
+				ch_dt_prot(addr);
+				data_loc(addr) = *cp;
+				dt_int(addr);
+			}
+		}
+
+		push_unsp(n);
+		push_int(0);
+		LOG(("@m9 Read: succeeded, n = %d", n));
+		break;
+
+	read_error:
+		push_err();
+		LOG(("@m4 Read: failed, n = %d, errno = %d", n, errno));
+		break;
+
+	case 4:				/* Write */
+
+		fd = pop_int();
+		dsp1 = pop_ptr();
+		nbytes = pop_intp();
+
+		if (!good_fd(fd))
+			goto write_error;
+		if (nbytes < 0) {
+			errno = 22;	/* EINVAL */
+			goto read_error;
+		}
+
+		if (in_gda(dsp1) && !in_gda(dsp1 + (nbytes-1))) {
+			efault(WWGDAH);
+			goto write_error;
+		}
+		if (!is_in_mem(dsp1, nbytes)) {
+			efault(WWUMEM);
+			goto write_error;
+		}
+
+#ifdef	LOGGING
+		for (addr = dsp1; addr < dsp1 + nbytes; addr++) {
+			if (mem_sh(addr) == UNDEFINED) {
+				warning(in_stack(addr) ? WWLUNDEF : WWGUNDEF);
+			}
+		}
+#endif	LOGGING
+
+		check_buf(0, (size)nbytes);
+		for (	nr = nbytes, addr = dsp1, cp = buf[0];
+			nr;
+			nr--, addr++, cp++
+		) {
+			*cp = mem_loc(addr);
+		}
+
+#ifdef	LOGGING
+		if (check_log("@m6")) {
+			register int i;
+			
+			for (i = 0; i < nbytes; i++) {
+				LOG(("@m6 write: char = '%c'", *(buf[0] + i)));
+			}
+		}
+#endif	LOGGING
+
+		if ((n = write(fd, buf[0], nbytes)) == -1)
+			goto write_error;
+
+		push_unsp(n);
+		push_int(0);
+		LOG(("@m9 Write: succeeded, n = %d", n));
+		break;
+
+	write_error:
+		push_err();
+		LOG(("@m4 Write: failed, n = %d, nbytes = %d, errno = %d",
+			n, nbytes, errno));
+		break;
+
+	case 5:				/* Open */
+
+		dsp1 = pop_ptr();
+		flag = pop_int();
+		if (!savestr(0, dsp1) || (fd = open(buf[0], flag)) == -1) {
+			push_err();
+			LOG(("@m4 Open: failed, file = %lu, flag = %d, fd = %d, errno = %d",
+					dsp1, flag, fd, errno));
+		}
+		else {
+			push_int(fd);
+			push_int(0);
+			LOG(("@m9 Open: succeeded, file = %lu, flag = %d, fd = %d",
+					dsp1, flag, fd));
+		}
+		break;
+
+	case 6:				/* Close */
+
+		fd = pop_int();
+		if (!good_fd(fd) || close(fd) == -1) {
+			push_err();
+			LOG(("@m4 Close: failed, fd = %d, errno = %d",
+				fd, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Close: succeeded"));
+		}
+		break;
+
+	case 7:				/* Wait */
+
+		if ((pid = wait(&status)) == -1) {
+			push_err();
+			LOG(("@m4 Wait: failed, status = %d, errno = %d",
+				status, errno));
+		}
+		else {
+			push_i2(pid);
+#ifndef	BSD4_2				/* from system.h */
+			push_i2(status);
+#else	BSD4_2
+			push_i2(status.w_status);
+#endif	BSD4_2
+			push_int(0);
+			LOG(("@m9 Wait: succeeded, status = %d, pid = %d",
+					status, pid));
+		}
+		break;
+
+	case 8:				/* Creat */
+
+		dsp1 = pop_ptr();
+		flag = pop_int();
+		if (!savestr(0, dsp1) || (fd = creat(buf[0], flag)) == -1) {
+			push_err();
+			LOG(("@m4 Creat: failed, dsp1 = %lu, flag = %d, errno = %d",
+					dsp1, flag, errno));
+		}
+		else {
+			push_int(fd);
+			push_int(0);
+			LOG(("@m9 Creat: succeeded, fd = %d", fd));
+		}
+		break;
+
+	case 9:				/* Link */
+
+		dsp1 = pop_ptr();
+		dsp2 = pop_ptr();
+		if (	!savestr(0, dsp1)
+		||	!savestr(1, dsp2)
+		||	link(buf[0], buf[1]) == -1
+		) {
+			push_err();
+			LOG(("@m4 Link: failed, dsp1 = %lu, dsp2 = %lu, errno = %d",
+					dsp1, dsp2, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Link: succeeded, dsp1 = %lu, dsp2 = %lu",
+					dsp1, dsp2));
+		}
+		break;
+
+	case 10:			/* Unlink */
+
+		dsp1 = pop_ptr();
+		if (!savestr(0, dsp1) || unlink(buf[0]) == -1) {
+			push_err();
+			LOG(("@m4 Unlink: failed, dsp1 = %lu, errno = %d",
+					dsp1, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Unlink: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	case 12:			/* Chdir */
+
+		dsp1 = pop_ptr();
+		if (!savestr(0, dsp1) || chdir(buf[0]) == -1) {
+			push_err();
+			LOG(("@m4 Chdir: failed, dsp1 = %lu, errno = %d",
+				dsp1, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Chdir: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	case 14:			/* Mknod */
+
+		dsp1 = pop_ptr();
+		mode = pop_int();
+		address = pop_int2();
+		if (!savestr(0, dsp1) || mknod(buf[0], mode, address) == -1) {
+			push_err();
+			LOG(("@m4 Mknod: failed, dsp1 = %lu, mode = %d, address = %d, errno = %d",
+					dsp1, mode, address, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Mknod: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	case 15:			/* Chmod */
+
+		dsp1 = pop_ptr();
+		mode = pop_int2();
+		if (!savestr(0, dsp1) || chmod(buf[0], mode) == -1) {
+			push_err();
+			LOG(("@m4 Chmod: failed, dsp1 = %lu, mode = %d, errno = %d",
+				dsp1, mode, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Chmod: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	case 16:			/* Chown */
+
+		dsp1 = pop_ptr();
+		owner = pop_int2();
+		group = pop_int2();
+		if (!savestr(0, dsp1) || chown(buf[0], owner, group) == -1) {
+			push_err();
+			LOG(("@m4 Chown: failed, dsp1 = %lu, owner = %d, group = %d, errno = %d",
+				dsp1, owner, group, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Chown: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	case 18:			/* Stat */
+
+		dsp1 = pop_ptr();	/* points to file-name space */
+		dsp2 = pop_ptr();	/* points to EM-stat-buffer space */
+		if (	!savestr(0, dsp1)
+		||	stat(buf[0], &st_buf) == -1
+		||	!stat2mem(dsp2, &st_buf)
+		) {
+			push_err();
+			LOG(("@m4 Stat: failed, dsp1 = %lu, dsp2 = %lu, errno = %d",
+				dsp1, dsp2, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Stat: succeeded, dsp1 = %lu, dsp2 = %lu",
+				dsp1, dsp2));
+		}
+		break;
+
+	case 19:			/* Lseek */
+
+		fd = pop_int();
+		off = pop_int4();
+		whence = pop_int();
+		LOG(("@m4 Lseek: fd = %d, off = %ld, whence = %d",
+				fd, off, whence));
+
+		if (!good_fd(fd) || (off = lseek(fd, off, whence)) == -1) {
+			push_err();
+			LOG(("@m9 Lseek: failed, errno = %d", errno));
+		}
+		else {
+			push_i4(off);
+			push_int(0);
+			LOG(("@m9 Lseek: succeeded, pushed %ld", off));
+		}
+		break;
+
+	case 20:			/* Getpid */
+
+		pid = getpid();
+		push_i2(pid);
+		push_int(0);
+		LOG(("@m9 Getpid: succeeded, pid = %d", pid));
+		break;
+
+	case 21:			/* Mount */
+
+		dsp1 = pop_ptr();
+		dsp2 = pop_ptr();
+		flag = pop_int();
+		if (	!savestr(0, dsp1)
+		||	!savestr(1, dsp2)
+		||	mount(buf[0], buf[1], flag) == -1
+		) {
+			push_err();
+			LOG(("@m4 Mount: failed, dsp1 = %lu, dsp2 = %lu, flag = %d, errno = %d",
+				dsp1, dsp2, flag, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Mount: succeeded, dsp1 = %lu, dsp2 = %lu, flag = %d",
+				dsp1, dsp2, flag));
+		}
+		break;
+
+	case 22:			/* Umount */
+
+		dsp1 = pop_ptr();
+		if (	!savestr(0, dsp1)
+#ifndef	BSD4_2				/* from system.h */
+		||	umount(buf[0]) == -1
+#else	BSD4_2
+		||	unmount(buf[0]) == -1
+#endif	BSD4_2
+		) {
+			push_err();
+			LOG(("@m4 Umount: failed, dsp1 = %lu, errno = %d",
+				dsp1, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Mount: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	case 23:			/* Setuid */
+
+		userid = pop_int2();
+		if (setuid(userid) == -1) {
+			push_err();
+			LOG(("@m4 Setuid: failed, userid = %d, errno = %d",
+				userid, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Setuid: succeeded, userid = %d", userid));
+		}
+		break;
+
+	case 24:			/* Getuid */
+
+		userid = getuid();
+		push_i2(userid);
+		LOG(("@m9 Getuid(part 1): real uid = %d", userid));
+		userid = geteuid();
+		push_i2(userid);
+		LOG(("@m9 Getuid(part 2): eff uid = %d", userid));
+		break;
+
+	case 25:			/* Stime */
+
+		tm = pop_int4();
+#ifndef	BSD4_2				/* from system.h */
+		rc = stime(&tm);
+#else	BSD4_2
+		tv.tv_sec = tm;
+		tv.tv_usec = 0;		/* zero microseconds */
+		rc = settimeofday(&tv, (struct timezone *)0);
+#endif	BSD4_2
+		if (rc == -1) {
+			push_err();
+			LOG(("@m4 Stime: failed, tm = %ld, errno = %d",
+				tm, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Stime: succeeded, tm = %ld", tm));
+		}
+		break;
+
+	case 26:			/* Ptrace */
+
+		request = pop_int();
+		pid = pop_int2();
+		dsp3 = pop_ptr();
+		n = pop_int();		/* Data */
+		einval(WPTRACEIMP);
+		push_err();
+		LOG(("@m4 Ptrace: failed, request = %d, pid = %d, addr = %lu, data = %d, errno = %d",
+			request, pid, dsp3, n, errno));
+		break;
+
+	case 27:			/* Alarm */
+
+		seconds = pop_uns2();
+		LOG(("@m9 Alarm(part 1) seconds = %u", seconds));
+		seconds = alarm(seconds);
+		push_i2(seconds);
+		LOG(("@m9 Alarm(part 2) seconds = %u", seconds));
+		break;
+
+	case 28:			/* Fstat */
+
+		fd = pop_int();
+		dsp2 = pop_ptr();
+		if (	!good_fd(fd)
+		||	fstat(fd, &st_buf) == -1
+		||	!stat2mem(dsp2, &st_buf)
+		) {
+			push_err();
+			LOG(("@m4 Fstat: failed, fd = %d, dsp2 = %lu, errno = %d",
+				fd, dsp2, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Fstat: succeeded, fd = %d, dsp2 = %lu",
+				fd, dsp2));
+		}
+		break;
+
+	case 29:			/* Pause */
+
+		pause();
+		LOG(("@m9 Pause: succeeded"));
+		break;
+
+	case 30:			/* Utime */
+
+		dsp1 = pop_ptr();
+		dsp2 = pop_ptr();
+		if (memfault(dsp2, 2*INT4SIZE)) {
+			push_err();
+			LOG(("@m4 Utime: failed, dsp1 = %lu, dsp2 = %lu, errno = %d",
+					dsp1, dsp2, errno));
+			break;
+		}
+		actime = mem_ldu(dsp2, INT4SIZE);
+		modtime = mem_ldu(dsp2 + INT4SIZE, INT4SIZE);
+#ifdef	BSD_X				/* from system.h */
+		utimbuf[0] = actime;
+		utimbuf[1] = modtime;
+#endif	BSD_X
+#ifdef	SYS_V				/* from system.h */
+		utimbuf.x = actime;
+		utimbuf.y = modtime;
+#endif	SYS_V
+		if (!savestr(0, dsp1) || utime(buf[0], utimbuf) == -1) {
+			push_err();
+			LOG(("@m4 Utime: failed, dsp1 = %lu, dsp2 = %lu, errno = %d",
+					dsp1, dsp2, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Utime: succeeded, dsp1 = %lu, dsp2 = %lu",
+					dsp1, dsp2));
+		}
+		break;
+
+	case 33:			/* Access */
+
+		dsp1 = pop_ptr();
+		mode = pop_int();
+		if (!savestr(0, dsp1) || access(buf[0], mode) == -1) {
+			push_err();
+			LOG(("@m4 Access: failed, dsp1 = %lu, mode = %d, errno = %d",
+					dsp1, mode, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Access: succeeded, dsp1 = %lu, mode = %d",
+				dsp1, mode));
+		}
+		break;
+
+	case 34:			/* Nice */
+
+		incr = pop_int();
+		nice(incr);
+		LOG(("@m9 Nice: succeeded, incr = %d", incr));
+		break;
+
+	case 35:			/* Ftime */
+
+		dsp2 = pop_ptr();
+#ifdef	BSD_X				/* from system.h */
+		ftime(&tb_buf);
+#endif	BSD_X
+#ifdef	SYS_V				/* from system.h */
+		tb_buf.time = time((time_t*)0);
+		tb_buf.millitm = 0;
+		tb_buf.timezone = timezone / 60;
+		tb_buf.dstflag = daylight;
+#endif	SYS_V
+		if (!timeb2mem(dsp2, &tb_buf)) {
+			push_err();
+			LOG(("@m4 Ftime: failed, dsp2 = %lu, errno = %d",
+				dsp2, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Ftime: succeeded, dsp2 = %lu", dsp2));
+		}
+		break;
+
+	case 36:			/* Sync */
+
+		sync();
+		LOG(("@m9 Sync: succeeded"));
+		break;
+
+	case 37:			/* Kill */
+
+		pid = pop_int2();
+		sig = pop_int();
+		if (kill(pid, sig) == -1) {
+			push_err();
+			LOG(("@m4 Kill: failed, pid = %d, sig = %d, errno = %d",
+					pid, sig, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Kill: succeeded, pid = %d, sig = %d",
+				pid, sig));
+		}
+		break;
+
+	case 41:			/* Dup & Dup2 */
+
+		fd = pop_int();
+		fdnew = pop_int();
+		if (fd & DUPMASK) {
+			int fd1 = fd & ~DUPMASK;/* stripped */
+
+			LOG(("@m4 Dup2: fd1 = %d, fdnew = %d", fd1, fdnew));
+			if (!good_fd(fd1)) {
+				fdnew = -1;
+				goto dup2_error;
+			}
+#ifdef	BSD_X				/* from system.h */
+			fdnew = dup2(fd1, fdnew);
+#endif	BSD_X
+
+#ifdef	SYS_V				/* from system.h */
+			{
+				/* simulating the semantics of dup2 on SYS_V */
+				int dupped = dup(fd1);
+
+				if (dupped < 0 && errno != EMFILE) {
+					/*	the dup failed, but not
+						because of too many open
+						file descriptors
+					*/
+					fdnew = dupped;
+				}
+				else {
+					close(dupped);
+					close(fdnew);
+					fdnew = fcntl(fd1, F_DUPFD, fdnew);
+				}
+			}
+#endif	SYS_V
+		dup2_error:;
+		}
+		else {
+			LOG(("@m4 Dup: fd = %d, fdnew = %d", fd, fdnew));
+			fdnew = (!good_fd(fd) ? -1 : dup(fd));
+		}
+
+		if (fdnew == -1) {
+			push_err();
+			LOG(("@m4 Dup/Dup2: failed, fdnew = %d, errno = %d",
+				fdnew, errno));
+		}
+		else {
+			push_int(fdnew);
+			push_int(0);
+			LOG(("@m9 Dup/Dup2: succeeded, fdnew = %d", fdnew));
+		}
+		break;
+
+	case 42:			/* Pipe */
+
+		if (pipe(pfds) == -1) {
+			push_err();
+			LOG(("@m4 Pipe: failed, errno = %d", errno));
+		}
+		else {
+			push_int(pfds[0]);
+			push_int(pfds[1]);
+			push_int(0);
+			LOG(("@m9 Pipe: succeeded, pfds[0] = %d, pfds[1] = %d",
+				pfds[0], pfds[1]));
+		}
+		break;
+
+	case 43:			/* Times */
+
+		dsp2 = pop_ptr();
+		times(&tm_buf);
+		if (!tms2mem(dsp2, &tm_buf)) {
+			push_err();
+			LOG(("@m4 Times: failed, dsp2 = %lu, errno = %d",
+				dsp2, errno));
+		}
+		else {
+			LOG(("@m9 Times: succeeded, dsp2 = %lu", dsp2));
+		}
+		break;
+
+	case 44:			/* Profil */
+
+		dsp1 = pop_ptr();	/* Buffer */
+		nbytes = pop_intp();	/* Buffer size */
+		off = pop_intp();	/* Offset */
+		n = pop_intp();		/* Scale */
+		einval(WPROFILIMP);
+		push_err();
+		LOG(("@m4 Profil: failed, dsp1 = %lu, nbytes = %d, offset = %d, scale = %d, errno = %d",
+			dsp1, nbytes, off, n, errno));
+		break;
+
+	case 46:			/* Setgid */
+
+		groupid = pop_int2();
+		if (setgid(groupid) == -1) {
+			push_err();
+			LOG(("@m4 Setgid: failed, groupid = %d, errno = %d",
+				groupid, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Setgid: succeeded, groupid = %d", groupid));
+		}
+		break;
+
+	case 47:			/* Getgid */
+
+		groupid = getgid();
+		push_i2(groupid);
+		LOG(("@m9 Getgid(part 1): succeeded, real groupid = %d",
+				groupid));
+		groupid = getegid();
+		push_i2(groupid);
+		LOG(("@m9 Getgid(part 2): succeeded, eff groupid = %d",
+				groupid));
+		break;
+
+	case 48:			/* Sigtrp */
+
+		trap_no = pop_int();
+		sig_no = pop_int();
+		
+		if ((old_trap_no = do_sigtrp(trap_no, sig_no)) == -1) {
+			push_err();
+			LOG(("@m4 Sigtrp: failed, trap_no = %d, sig_no = %d, errno = %d",
+					trap_no, sig_no, errno));
+		}
+		else {
+			push_int(old_trap_no);
+			push_int(0);
+			LOG(("@m9 Sigtrp: succeeded, trap_no = %d, sig_no = %d, old_trap_no = %d",
+					trap_no, sig_no, old_trap_no));
+		}
+		break;
+
+	case 51:			/* Acct */
+
+		dsp1 = pop_ptr();
+		if (!savestr(0, dsp1) || acct(buf[0]) == -1) {
+			push_err();
+			LOG(("@m4 Acct: failed, dsp1 = %lu, errno = %d",
+				dsp1, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Acct: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	case 54:			/* Ioctl */
+
+		fd = pop_int();
+		request = pop_int();
+		dsp2 = pop_ptr();
+		if (!good_fd(fd) || do_ioctl(fd, request, dsp2) != 0) {
+			push_err();
+			LOG(("@m4 Ioctl: failed, fd = %d, request = %d, dsp2 = %lu, errno = %d",
+				fd, request, dsp2, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Ioctl: succeeded, fd = %d, request = %d, dsp2 = %lu",
+				fd, request, dsp2));
+		}
+		break;
+
+	case 56:			/* Mpxcall */
+
+		request = pop_int();	/* Command */
+		dsp1 = pop_ptr();	/* Vec */
+		einval(WMPXIMP);
+		push_err();
+		LOG(("@m4 Mpxcall: failed, request = %d, dsp1 = %lu, errno = %d",
+			request, dsp1, errno));
+		break;
+
+	case 59:			/* Exec */
+
+		dsp1 = pop_ptr();
+		dsp2 = pop_ptr();
+		dsp3 = pop_ptr();
+		if (	!savestr(0, dsp1)
+		||	!vec(1, 2, dsp2, &argvec)
+		||	!vec(3, 4, dsp3, &envvec)
+		||	/* execute results, ignore return code */
+			(execve(buf[0], argvec, envvec), 1)
+		) {
+			push_err();
+			LOG(("@m4 Exece: failed, dsp1 = %lu, dsp2 = %lu, dsp2 = %lu, errno = %d",
+				dsp1, dsp2, dsp3, errno));
+		}
+		break;
+
+	case 60:			/* Umask */
+
+		mode = pop_int2();
+		oldmask = umask(mode);
+		push_int(oldmask);
+		LOG(("@m9 Umask: succeeded, mode = %d, oldmask = %d",
+			mode, oldmask));
+		break;
+
+	case 61:			/* Chroot */
+
+		dsp1 = pop_ptr();
+		if (!savestr(0, dsp1) || chroot(buf[0]) == -1) {
+			push_err();
+			LOG(("@m4 Chroot: failed, dsp1 = %lu, errno = %d",
+				dsp1, errno));
+		}
+		else {
+			push_int(0);
+			LOG(("@m9 Chroot: succeeded, dsp1 = %lu", dsp1));
+		}
+		break;
+
+	default:
+		trap(EBADMON);
+		break;
+	}
+}
+
+/* Buffer administration */
+
+PRIVATE check_buf(n, sz)
+	int n;
+	size sz;
+{
+	if (buf_cnt[n] == 0) {
+		buf_cnt[n] = max(128, sz);
+		buf[n] = Malloc(buf_cnt[n], "moncall buffer");
+	}
+	else if (buf_cnt[n] < sz) {
+		buf_cnt[n] = allocfrac(sz);
+		buf[n] = Realloc(buf[n], buf_cnt[n], "moncall buffer");
+	}
+}
+
+PRIVATE int savestr(n, addr)
+	int n;
+	ptr addr;
+{
+	register size len;
+	register char *cp, ch;
+
+	/* determine the length, carefully */
+	len = 0;
+	do {
+		if (memfault(addr + len, 1L)) {
+			return 0;
+		}
+		ch = mem_loc(addr + len);
+		len++;
+	} while (ch);
+
+	/* allocate enough buffer space */
+	check_buf(n, len);
+
+	/* copy the string */
+	cp = buf[n];
+	do {
+		*cp++ = ch = mem_loc(addr);
+		addr++;
+	} while (ch);
+
+	return 1;
+}
+
+PRIVATE int vec(n1, n2, addr, vecvec)
+	int n1, n2;
+	ptr addr;
+	char ***vecvec;
+{
+	register char *cp1, *cp2;
+	ptr p, ldp;
+	register int n_ent = 0;		/* number of entries */
+	register size str = 0;		/* total string length */
+
+	/* determine number of elements n_ent */
+	p = addr;
+	do {
+		if (memfault(addr, psize)) {
+			return 0;
+		}
+		ldp = mem_lddp(p);
+		if (!savestr(n2, ldp)) {
+			return 0;
+		}
+		str += strlen(buf[n2]) + 1;
+		n_ent++;
+		p += psize;
+	} while (ldp);
+	n_ent++;
+
+	*vecvec = (char **) Malloc((size)(n_ent * sizeof (char *)),
+					"argvec or envvec in exec()");
+	check_buf(n1, str);
+
+	/* copy the elements */
+	for (	cp1 = buf[n1], n_ent = 0, p = addr;
+		ldp = mem_lddp(p);
+		p += psize, n_ent++
+	) {
+		if (!savestr(n2, ldp)) {
+			return 0;
+		}
+		(*vecvec)[n_ent] = cp1;
+		cp2 = buf[n2];
+		while (*cp1++ = *cp2++) {
+			/* nothing */
+		}
+	}
+	(*vecvec)[n_ent] = 0;
+	return 1;
+}
+
+int memfault(addr, length)
+	ptr addr;
+	size length;
+{
+	/* centralizes (almost) all memory access tests in MON */
+	if (!is_in_mem(addr, length)) {
+		efault(WMONFLT);
+		return 1;
+	}
+	return 0;
+}
+
+efault(wrn)
+	int wrn;			/* warning number */
+{
+	warning(wrn);
+	errno = 14;			/* EFAULT */
+}
+
+einval(wrn)
+	int wrn;			/* warning number */
+{
+	warning(wrn);
+	errno = 22;			/* EINVAL */
+}
+

+ 190 - 0
util/int/monstruct.c

@@ -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 - 0
util/int/monstruct.h

@@ -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 - 0
util/int/nofloat.h

@@ -0,0 +1,4 @@
+/* $Header$ */
+
+#undef	NOFLOAT				/* No floating point when defined */
+

+ 13 - 0
util/int/opcode.h

@@ -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 - 0
util/int/proctab.c

@@ -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 - 0
util/int/proctab.h

@@ -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 - 0
util/int/read.c

@@ -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 - 0
util/int/read.h

@@ -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 - 0
util/int/rsb.c

@@ -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 - 0
util/int/rsb.h

@@ -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 - 0
util/int/segcheck.h

@@ -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 - 0
util/int/segment.c

@@ -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 - 0
util/int/shadow.h

@@ -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 - 0
util/int/stack.c

@@ -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 - 0
util/int/switch.c

@@ -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 - 0
util/int/sysidf.h

@@ -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 - 0
util/int/tally.c

@@ -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 - 0
util/int/text.c

@@ -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 - 0
util/int/text.h

@@ -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 - 0
util/int/trap.c

@@ -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 - 0
util/int/trap.h

@@ -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 - 0
util/int/v7ioctl.h

@@ -0,0 +1,5 @@
+/* $Header$ */
+
+#define	V7IOCTL				/* ioctl() requests are from V7 UNIX */
+					/* otherwise from local system */
+

+ 158 - 0
util/int/warn.c

@@ -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;
+	}
+}
+