--- /dev/null
+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$
--- /dev/null
+#!/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
+
--- /dev/null
+#!/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
+
--- /dev/null
+#!/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
+
--- /dev/null
+# $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
--- /dev/null
+# $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.
+
--- /dev/null
+/* $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;
+}
+
--- /dev/null
+/*
+ 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)
+
--- /dev/null
+/*
+ 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;
+}
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ Various debug flags
+*/
+
+/* $Header$ */
+
+#undef DB_MALLOC /* sally malloc area */
+
--- /dev/null
+/*
+ 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;
+ }
+}
+
+
+
--- /dev/null
+/*
+ * 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;
+ }
+}
--- /dev/null
+/*
+ * 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));
+}
--- /dev/null
+/*
+ * 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);
+}
--- /dev/null
+/*
+ * 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
+}
--- /dev/null
+/*
+ * 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
+
--- /dev/null
+/*
+ * 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);
+}
+
--- /dev/null
+/*
+ * 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);
+}
+
--- /dev/null
+/*
+ * 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;
+}
+
--- /dev/null
+/*
+ * 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);
+}
--- /dev/null
+/*
+ * 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);
+ }
+ }
+}
--- /dev/null
+/*
+ * 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;
+ }
+}
+
--- /dev/null
+/*
+ * 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);
+}
--- /dev/null
+/*
+ * 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);
+}
+
--- /dev/null
+/*
+ * 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);
+}
--- /dev/null
+/*
+ * 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);
+}
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/* $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
+
--- /dev/null
+/* $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));
+}
+
--- /dev/null
+/*
+ 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
--- /dev/null
+/*
+ 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;
+
+
+
+
+
+
--- /dev/null
+/*
+ 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))
+
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ 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>");
+}
+
--- /dev/null
+/*
+ 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();
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/* $Header$ */
+
+#define LOGGING 1 /* Includes logging when defined */
+
--- /dev/null
+/*
+ Dedicated to the ioctl system call, MON 54.
+*/
+
+/* $Header$ */
+
+#include "sysidf.h"
+#include "v7ioctl.h"
+#include "global.h"
+#include "mem.h"
+#include "warn.h"
+
+#include <sgtty.h>
+
+#ifdef V7IOCTL /* define the proper V7 requests */
+
+#define V7IOGETP (('t'<<8)|8)
+#define V7IOSETP (('t'<<8)|9)
+#define V7IOSETN (('t'<<8)|10)
+#define V7IOEXCL (('t'<<8)|13)
+#define V7IONXCL (('t'<<8)|14)
+#define V7IOHPCL (('t'<<8)|2)
+#define V7IOFLUSH (('t'<<8)|16)
+
+#define V7IOSETC (('t'<<8)|17)
+#define V7IOGETC (('t'<<8)|18)
+
+#endif V7IOCTL
+
+
+/************************************************************************
+ * do_ioctl handles all ioctl system calls. It is called by the *
+ * moncall() routine, case 54. It was too big to leave it there. *
+ * The ioctl system call is divided into 5 parts. *
+ * Ioctl's dealing with respectively: *
+ * sgttyb, tchars, local mode word, ltchars, and miscellaneous ioctl's. *
+ * Some of the sgttyb-calls are only possible under the new tty-driver. *
+ * All of these are to be found in the miscellaneous section. *
+ * do_ioctl() simply returns the value ioctl() would return itself. *
+ * (0 for success, -1 for failure) *
+ ***********************************************************************/
+
+int do_ioctl(fd, req, addr)
+ int fd, req;
+ ptr addr;
+{
+ register long e;
+ struct sgttyb sg_buf;
+
+#ifdef BSD_X /* from system.h */
+#ifndef V7IOCTL
+ char c;
+ int mask; /* will get ALIGNMENT problems with this one */
+ long count; /* might get ALIGNMENT problems with this one */
+ int ldisc; /* might get ALIGNMENT problems with this one */
+ int pgrp; /* might get ALIGNMENT problems with this one */
+#endif V7IOCTL
+
+ struct tchars tc_buf;
+#ifndef V7IOCTL
+ struct ltchars ltc_buf;
+#endif V7IOCTL
+#endif BSD_X
+
+
+#ifdef V7IOCTL
+ switch (req) { /* translate the V7 requests */
+ /* and reject the non-V7 ones */
+ case V7IOGETP:
+ req = TIOCGETP;
+ break;
+ case V7IOSETP:
+ req = TIOCSETP;
+ break;
+ case V7IOEXCL:
+ req = TIOCEXCL;
+ break;
+ case V7IONXCL:
+ req = TIOCNXCL;
+ break;
+ case V7IOHPCL:
+ req = TIOCHPCL;
+ break;
+#ifdef BSD_X /* from system.h */
+ case V7IOSETN:
+ req = TIOCSETN;
+ break;
+
+ case V7IOSETC:
+ req = TIOCSETC;
+ break;
+ case V7IOGETC:
+ req = TIOCGETC;
+ break;
+#endif BSD_X
+
+ default:
+ einval(WBADIOCTL);
+ return (-1); /* Fake return value */
+ }
+
+#endif V7IOCTL
+
+
+ switch (req) {
+
+ /*************************************/
+ /****** Struct sgttyb ioctl's ********/
+ /*************************************/
+
+ case TIOCGETP:
+ /* Get fd's current param's and store at dsp2 */
+ if ( (e = ioctl(fd, req, (char *) &sg_buf)) == -1
+ || !sgttyb2mem(addr, &sg_buf)
+ ) {
+ e = -1; /* errno already set */
+ }
+ break;
+
+ case TIOCSETP:
+#ifdef BSD4_1 /* from system.h */
+ case TIOCSETN:
+#endif BSD4_1
+ /* set fd's parameters according to sgtty buffer */
+ /* pointed to (addr), so first fill sg_buf properly. */
+ if ( !mem2sgtty(addr, &sg_buf)
+ || (e = ioctl(fd, req, (char *) &sg_buf)) == -1
+ ) {
+ e = -1; /* errno already set */
+ }
+ break;
+
+ case TIOCEXCL:
+ case TIOCNXCL:
+ case TIOCHPCL:
+ /* These have no third argument. */
+ e = ioctl(fd, req, (char *) 0);
+ break;
+
+#ifdef BSD_X /* from system.h */
+ /*************************************/
+ /****** Struct tchars ioctl's ********/
+ /*************************************/
+
+ case TIOCGETC:
+ /* get special char's; store at addr */
+ if ( (e = ioctl(fd, req, (char *) &tc_buf)) == -1
+ || !tchars2mem(addr, &tc_buf)
+ ) {
+ e = -1; /* errno already set */
+ }
+ break;
+
+ case TIOCSETC:
+ /* set special char's; load from addr */
+ if ( !mem2tchars(addr, &tc_buf)
+ || (e = ioctl(fd, req, (char *) &tc_buf)) == -1
+ ) {
+ e = -1;
+ }
+ break;
+
+#ifndef V7IOCTL
+ /***************************************/
+ /****** Local mode word ioctl's ********/
+ /***************************************/
+
+ case TIOCLBIS: /* addr points to mask which is or-ed with lmw */
+ case TIOCLBIC: /* addr points to mask, ~mask & lmw is done */
+ case TIOCLSET: /* addr points to mask, lmw is replaced by it */
+ if (memfault(addr, wsize)) {
+ e = -1;
+ }
+ else {
+ mask = mem_ldu(addr, wsize);
+ e = ioctl(fd, req, (char *) &mask);
+ }
+ break;
+
+ case TIOCLGET: /* addr points to space, store lmw there */
+ if ( memfault(addr, wsize)
+ || (e = ioctl(fd, req, (char *) &mask)) == -1
+ ) {
+ e = -1;
+ }
+ else {
+ mem_stn(addr, (long) mask, wsize);
+ }
+ break;
+
+ /**************************************/
+ /****** Struct ltchars ioctl's ********/
+ /**************************************/
+
+ case TIOCGLTC:
+ /* get current ltc's; store at addr */
+ if ( (e = ioctl(fd, req, (char *) <c_buf)) == -1
+ || !ltchars2mem(addr, <c_buf)
+ ) {
+ e = -1; /* errno already set */
+ }
+ break;
+
+ case TIOCSLTC:
+ /* set ltc_buf; load from addr */
+ if ( !mem2ltchars(addr, <c_buf)
+ || (e = ioctl(fd, req, (char *) <c_buf)) == -1
+ ) {
+ e = -1;
+ }
+ break;
+
+ /*************************************/
+ /****** Miscellaneous ioctl's ********/
+ /*************************************/
+
+ case TIOCGETD:
+ /* Get line discipline, store at addr */
+ if ( memfault(addr, wsize)
+ || (e = ioctl(fd, req, (char *) &ldisc)) == -1
+ ) {
+ e = -1;
+ }
+ else {
+ mem_stn(addr, (long) ldisc, wsize);
+ }
+ break;
+
+ case TIOCSETD:
+ /* Set line discipline, load from addr */
+ if (memfault(addr, wsize)) {
+ e = -1;
+ }
+ else {
+ ldisc = (int) mem_ldu(addr, wsize);
+ e = ioctl(fd, req, (char *) &ldisc);
+ }
+ break;
+
+ /* The following are not standard vanilla 7 UNIX */
+ case TIOCSBRK: /* These have no argument */
+ case TIOCCBRK: /* They work on parts of struct sgttyb */
+ case TIOCSDTR:
+ case TIOCCDTR:
+ e = ioctl(fd, req, (char *) 0);
+ break;
+
+ /* The following are used to set the line discipline */
+ case OTTYDISC:
+ case NETLDISC:
+ case NTTYDISC:
+ e = ioctl(fd, req, (char *) 0);
+ break;
+
+ case TIOCSTI: /* addr = address of character */
+ if (memfault(addr, 1L)) {
+ e = -1;
+ }
+ else {
+ c = (char) mem_ldu(addr, 1L);
+ e = ioctl(fd, req, (char *) &c);
+ }
+ break;
+
+ case TIOCGPGRP:
+ /* store proc grp number of control term in addr */
+ if ( memfault(addr, wsize)
+ || (e = ioctl(fd, req, (char *) &pgrp)) == -1
+ ) {
+ e = -1;
+ }
+ else {
+ mem_stn(addr, (long) pgrp, wsize);
+ }
+ break;
+
+ case TIOCSPGRP: /* addr is NO POINTER !! */
+ e = ioctl(fd, req, (char *) addr);
+ break;
+
+ case FIONREAD: /* do the ioctl, addr is long-int ptr now */
+ if ( memfault(addr, wsize)
+ || (e = ioctl(fd, req, (char *) &count)) == -1
+ ) {
+ e = -1;
+ }
+ else {
+ mem_stn(addr, count, wsize);
+ }
+ break;
+
+#endif V7IOCTL
+#endif BSD_X
+
+ default:
+ einval(WBADIOCTL);
+ e = -1; /* Fake return value */
+ break;
+ }
+ return (e);
+}
--- /dev/null
+/*
+ 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;
+}
+
--- /dev/null
+/*
+ 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*/
+}
+
--- /dev/null
+/*
+ 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();
+
--- /dev/null
+/*
+ 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)))
+
--- /dev/null
+/*
+ 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 */
+}
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/* $Header$ */
+
+#undef NOFLOAT /* No floating point when defined */
+
--- /dev/null
+/*
+ Secondary and tertiary opcode defines
+*/
+
+/* $Header$ */
+
+#define PRIM_BASE 0
+#define SEC_BASE 256
+#define TERT_BASE 512
+
+#define SECONDARY 254
+#define TERTIARY 255
+
--- /dev/null
+/*
+ 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
+}
+
--- /dev/null
+/*
+ Handling the proctable
+*/
+
+/* $Header$ */
+
+struct proc {
+ size pr_nloc;
+ ptr pr_ep;
+ ptr pr_ff; /* first address not in proc */
+};
+
+extern struct proc *proctab;
--- /dev/null
+/*
+ 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);
+}
+
--- /dev/null
+/*
+ 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 */
--- /dev/null
+/* $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;
+}
+
--- /dev/null
+/* $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)
+
--- /dev/null
+/* $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.
+*/
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ 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;
+ }
+}
--- /dev/null
+/*
+ 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
+
--- /dev/null
+/*
+ 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;
+}
+
--- /dev/null
+/*
+ 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;
+}
+
--- /dev/null
+/*
+ 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)
+
--- /dev/null
+/*
+ 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*/
+}
+
--- /dev/null
+/*
+ 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 */
+
--- /dev/null
+/* $Header$ */
+
+#define V7IOCTL /* ioctl() requests are from V7 UNIX */
+ /* otherwise from local system */
+
--- /dev/null
+/*
+ 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;
+ }
+}
+
public / ack.git / commitdiff