diff --git a/.VLM b/.VLM new file mode 100644 index 0000000..14649bd --- /dev/null +++ b/.VLM @@ -0,0 +1,17 @@ +genera.network: tap1:CHAOS|402;host=777,tap0:INTERNET|192.168.2.2;gateway=192.168.2.1;host=192.168.2.1 + +genera.virtualMemory: 512 +genera.trace: no +genera.worldSearchPath: /home/lispm/snap5/jj-vlm:/home/lispm/snap5/vlods:/var/lib/symbolics +*main.geometry: 1280x1024+0+1024 +*coldLoad.geometry: 800x600+1280+0 +*coldLoad.iconic: yes +*coldLoad.background: gray85 +*coldLoad.foreground: gray15 + +genera.world: ../vlods/Genera-8-5.vlod +genera.spy: no + +genera.debugger: VLM_debugger + + diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e237b42 --- /dev/null +++ b/.gitignore @@ -0,0 +1,21 @@ +/Makefile +/Makefile.in +/aclocal.m4 +/autom4te.cache/ +/config.* +/VLM_debugger +/m4/ +/stamp-h? +.deps/ +.dirstamp +*.o +*~ +/autoscan.* +/configure.scan +/keyboard.c +/keyboard +/machine +/2machines +/tozeb +/vlm-*.xz + diff --git a/AUTHORS b/AUTHORS new file mode 100644 index 0000000..05b5f26 --- /dev/null +++ b/AUTHORS @@ -0,0 +1,8 @@ +authors: +vlm on alpha:P.T.Withington, Scott McKay, and Gary Palter at Symbolics Inc. + Paul Robertson at Dynamic Object Language Group +see: http://pt.withy.org/publications/VLM.html + +x86_64 port: by bard parker (brad@unlambda.com) + +last modified: Joachim Jachemich (joachim@jachemich.de) diff --git a/COPYING b/COPYING new file mode 120000 index 0000000..2fcb217 --- /dev/null +++ b/COPYING @@ -0,0 +1 @@ +/usr/share/automake-1.13/COPYING \ No newline at end of file diff --git a/ChangeLog b/ChangeLog new file mode 100644 index 0000000..c3a0604 --- /dev/null +++ b/ChangeLog @@ -0,0 +1,70 @@ +in 2013 disassembled Brad's genera to locate and fix the integer division + code. Located and binary patched it - integer division works ok. +Oct 2014 eventually located the vlm source code and began to work on it. +in 2014 changed stub/process.lisp to work with clisp + implemented rational division as "asm" operation in + alpha-emulator/imacmath.lisp and stub/process.lisp + implemented double-float trap as "c" code in + alpha-emulator/imactrap.lisp and stub/process.lisp + implemented networking using a tap interface for internet + as well as chaos in life-support/network-tap-linux.c. + floor/ceiling/round produce erroneous results - fixed them by + introducing new "pseudo" alpha-ops and generating code in + stub/process.lisp to make use of the libm-functions + floor, ceil, trunc, and rint functions. +in 2015 implemented check for and workaround for X11 with xcb in + life-support/cold-load.c and life-support/console.c + changed keyboard detection code and key translation for + the cold-load/debugger window in life-support/cold-load.c + changed timing in life-support/signals.c and utilitites.c + implemented nfs version 3 client in LISP. + implemented a server for the "MINI" protocol in LISP, + patched qld and friends to be able to do a cold load + using two OG2 instances. Finally able to do a cold-load. + Still looking for the cold-load generator sources... + Implemented a few additions to the embedded communication + area (cwd, home dir), added block-size setting for FEP-disks, + added unix crypt as a callable routine. Did some changes to + gc routines to be able to gc even more areas. Succeeded in + saving worlds smaller then the original 8-5 world. +Aug 2016 made a version of genera work on the alpha using the + original alpha-assembly generation, fixed some glitches + when shutting down genera (move termination of network in front + of all other termination routines). moved to the x64 version as well +Oct 2016 added alpha assembly instruction in alpha-emulator/imactrap.lisp + to correctly identify double-float traps. Tested on alpha, then + also moved to the x64 version. +Nov 2016 worked on the chaosnet network module for Linux 'til + Nov 2017 +Nov 2017 moved the source tree into an autoconf/automake project + fixed a lot of compilation warnings +Feb 2018 cleaned up the sources + reverted useless code changes in emulator/interface.c +04/21/18 added :MAC|aa:bb:cc:dd:ee:ff to network options on + request from Jean Marangos. This is an additional option for the + interface and is used for CHAOS as well as INTERNET interfaces. By + default the tap interface code will generate a new MAC address for + the OG2 end of the tap tunnel each time genera is started. +04/24/18 developed a LISP patch to use the hosts time at startup instead + of asking around on the network +04/26/18 added "host=address" option to network specifications, so a + network specification could now look like + "tap0:INTERNET|192.168.2.2;gateway=192.168.2.1;host=192.168.2.1", + for example or + "tap0:CHAOS|401;host=777". By default the tap interface code + assumes its host is ".1" on the guests subnet for ip, or "377" on the + guest subnet for chaos. Giving the "host=" option will override + this default, should you ever need it. I you give the host option + the address used should be the same address you've used when you + configured the tap interface. + added some of the LISP patches I use to the OG2-patches directory +04/27/18 removed "while (1);" from vpunt() to allow termination after an + error +04/28/18 use ucontext_t instead of struct ucontext in emulator/interfac.c + and emulator/memory.c as reported by Seth Morabito + added extern definitions for fixtfloat, _ADDS, _SUBS, _MULS, _DIVS + as those caused gcc hickups on Ubuntu reported by Seth Morabito + bumped version to vlm-0.99-1 +04/29/18 fixed a bug in life-support/disks.c where passing a negative + blocksize lead to non-logical blocksize settings + diff --git a/GNUmakefile.orig b/GNUmakefile.orig new file mode 100644 index 0000000..453add8 --- /dev/null +++ b/GNUmakefile.orig @@ -0,0 +1,240 @@ +# +# Builds the Ivory Emulator (VLM) +# +# The command line to build an emulator is +# +# make {OPTIONS="option1 option2 ..."} {NONSHARED=YES} TARGET +# +# where TARGET is either "genera", "minima", or "iverify". The makefile will +# automatically include the -DGENERA, -DMINIMA, or -DIVERIFY preprocessor option +# when invoking the compiler and assembler. +# +# On the make command line, use OPTIONS="option1 option2 ..." to specify compiler +# and assembler options, notably preprocessor options. +# +# The main preprocessor options used throughout the sources are +# GENERA to build an emulator that is intended to run Genera +# MINIMA to build an emulator that is intended to run Minima +# IVERIFY to build an emulator that is intended to run the instruction test suite +# TRACING to enable instruction tracing and counting +# CACHEMETERING to enable instruction cache metering facilities +# TRAPMETERING to enable trap metering facilities +# STATISTICS to enable other statistics-gathering facilities +# if enabled: +# EXECTIMES : enable execution times statistics +# ends up in "usagedata.lisp" / "usagedata.text" after a vlm run +# DEBUGGING to enable debugging facilities +# DEBUG* to enable other, more specific debugging facilities +# AUTOSTART to immediately start execution of the loaded image without waiting for +# a :Start Interactor command from the Minima Debugger. (This option is defined +# automatically when the TARGET is "genera".) +# USE_CPU_FOR_MICROSECOND_CLOCK to use the process CPU time rather than elapsed time +# as the value of Ivory's microsecond clock +# DISK_SIZE_1536 to enable disks.c to read 1536 bytes sectors +# instead of the default 8192 byte sectors +# DEBUG_DISK +# enable disk read/write verbosity +# DEBUG_NETWORk +# Networking debug verbosity +# if enabled: +# DEBUG_CHAOS +# DEBUG_IP +# DEBUG_ARP +# DEBUG_ICMP +# verbosity of indiv. netwoeking parts +# +# For example, to create an emulator that runs Genera but waits for a :Start Interactor +# command from the Minima Debugger before booting and also has debugging features enabled, +# +# make genera OPTIONS="-DDEBUGGING -UAUTOSTART" +# +# If you specify a target different from your last build, you must remove all object +# files first to ensure that everything is properly compiled. Use the "clean" target. +# +# In fact, if you change any settings between builds, it's a good idea to build from scratch +# +# On the make command line, use PROFILE=YES to build the VLM using the profiling option +# to gather statistics on execution frequencies. +# +# On the make command line, use NONSHARED=YES to build the VLM using the non-shared +# libraries. (The default is to use the shared libraries.) +# + + +LIFE = ./life-support +EMULATOR = ./emulator +G5EMULATOR = ./g5-emulator +X86EMULATOR = ./x86_64-emulator +OTHER = ./other + +CPU = $(X86EMULATOR) +CLISP = /usr/bin/clisp +CCL=/home/lispm/ccl/scripts/ccl64 +OPTIMOPT = -Ofast -march=native -fno-strict-aliasing +NOCONAOPTIMOPT = -Ofast -march=nocona -fno-strict-aliasing + +genera: MAINOPTIONS = -DGENERA -DAUTOSTART -DUSE_TAP #-DUSE_CPU_FOR_MICROSECOND_CLOCK +minima: MAINOPTIONS = -DMINIMA -DUSE_TAP +iverify: MAINOPTIONS = -DIVERIFY -DUSE_TAP + +genera.nocona: MAINOPTIONS = -DGENERA -DAUTOSTART -DUSE_TAP #-DUSE_CPU_FOR_MICROSECOND_ + +SYMBOLSOPT = +#SYMBOLSOPT = -g + +# -foptimize-sibling-calls -fstrength-reduce \ +# -fexpensive-optimizations \ +# -fsched-interblock -fsched-spec -fpeephole2 \ +# -freorder-blocks -freorder-functions \ +# -funit-at-a-time \ +# -falign-functions -falign-jumps -falign-loops -falign-labels \ +# -fcrossjumping \ +# -finline-functions -frename-registers -funswitch-loops \ +# -fregmove \ +# -fcse-follow-jumps \ +# -fcse-skip-blocks -frerun-cse-after-loop -frerun-loop-opt -fgcse \ +# -fgcse-lm -fgcse-sm -fgcse-las -fdelete-null-pointer-checks \ +# -foptimize-sibling-calls -fcaller-saves -Winline \ +# -fno-strict-aliasing \ +# -fschedule-insns -fschedule-insns2 + +# broken +#-fstrict-aliasing +#-fschedule-insns -fschedule-insns2 + +#-fforce-mem -foptimize-sibling-calls -fstrength-reduce -fcse-follow-jumps +#-fcse-skip-blocks -frerun-cse-after-loop -frerun-loop-opt -fgcse +#-fgcse-lm -fgcse-sm -fgcse-las -fdelete-null-pointer-checks +#-fexpensive-optimizations -fregmove -fschedule-insns -fsched-ule-insns2 +#-fsched-interblock -fsched-spec -fcaller-saves -fpeep-hole2 +#-freorder-blocks -freorder-functions -fstrict-aliasing +#-funit-at-a-time -falign-functions -falign-jumps -falign-loops +#-falign-labels -fcrossjumping + +#-finline-functions, -fweb, -frename-registers and -funswitch-loops + +CFLAGS = $(OPTIMOPT) $(SYMBOLSOPT) -std=gnu99 -I/usr/X11R6/include -I. -I$(LIFE) -I$(EMULATOR) -I$(X86EMULATOR) $(MAINOPTIONS) $(OPTIONS) +AFLAGS = $(SYMBOLSOPT) -I. -I$(LIFE) -I$(EMULATOR) -I$(X86EMULATOR) $(MAINOPTIONS) $(OPTIONS) + +.SUFFIXES: +.SUFFIXES: .o .c .S + +.c.o: + $(CC) $(CFLAGS) -o $@ -c $< + +.S.o: + $(CC) $(AFLAGS) -o $@ -c $< + +SRCS = main.c spy.c world_tools.c utilities.c \ + $(LIFE)/cold_load.c $(LIFE)/console.c $(LIFE)/disks.c $(LIFE)/initialization.c \ + $(LIFE)/network.c $(LIFE)/message_channels.c $(LIFE)/polling.c $(LIFE)/queues.c \ + $(LIFE)/signals.c $(LIFE)/unixcrypt.c \ + $(EMULATOR)/interfac.c $(EMULATOR)/interpds.c $(EMULATOR)/externals.c \ + $(EMULATOR)/memory.c + +NETWORKSOURCES = $(LIFE)/network-osf.c \ + $(LIFE)/network-linux.c $(LIFE)/network-tun-linux.c \ + $(LIFE)/network-darwin.c $(LIFE)/network-libpcap.c + +FAKEEMULATOR=y +ifndef FAKEEMULATOR + ASMS = $(EMULATOR)/emulator.S + EMULATOROBJ = $(EMULATOR)/emulator.o + COMPONENTS = $(CPU)/idispat.s $(CPU)/ifuncom1.s $(CPU)/ifuncom2.s \ + $(CPU)/ifungene.s $(CPU)/ifunfcal.s $(CPU)/ifunloop.s \ + $(CPU)/ifunlist.s $(CPU)/ifuninst.s $(CPU)/ifunmath.s \ + $(CPU)/ifunarra.s $(CPU)/ifunmove.s $(CPU)/ifunpred.s \ + $(CPU)/ifunsubp.s $(CPU)/ifunfext.s $(CPU)/ifunlexi.s \ + $(CPU)/ifunbits.s $(CPU)/ifunblok.s $(CPU)/ifunbind.s \ + $(CPU)/ifunfull.s $(CPU)/ifunbnum.s $(CPU)/ifuntrap.s \ + $(CPU)/ihalt.s $(CPU)/idouble.s $(CPU)/ifunjosh.s \ + $(CPU)/ifuntran.s +else +# ASMS = $(EMULATOR)/fake_emulator.c +# EMULATOROBJ = $(EMULATOR)/fake_emulator.o + ASMS = stub/stub.c + EMULATOROBJ = stub/stub.o + COMPONENTS = +endif + +OBJS = $(LIFE)/cold_load.o $(LIFE)/console.o $(LIFE)/disks.o $(LIFE)/initialization.o \ + $(LIFE)/network.o $(LIFE)/message_channels.o $(LIFE)/polling.o $(LIFE)/queues.o \ + $(LIFE)/signals.o $(LIFE)/unixcrypt.o \ + world_tools.o utilities.o spy.o \ + $(EMULATOR)/interfac.o $(EMULATOR)/interpds.o $(EMULATOR)/externals.o \ + $(EMULATOR)/memory.o $(EMULATOROBJ) + +EMULATORINCLUDES = $(EMULATOR)/aihead.h $(CPU)/aistat.h $(EMULATOR)/ivoryrep.h + +OTHEROBJS = + +ifdef NONSHARED + OTHEROBJS += +# LIBRARIES = -lpthread -lc -lX11 -lm -lpcap + LIBRARIES = -lpthread -lc -lX11 -lm + EARLYLIBS = -L/opt/ppc64/X11R6/lib +else + OTHEROBJS += +# LIBRARIES = -lpthread -lc -lX11 -lm +# EARLYLIBS = -L/opt/ppc64/X11R6/lib +# LIBRARIES = -rdynamic -lpthread -lc -lX11 -lm -ldl -lX11-xcb -lpcap +# LIBRARIES = -rdynamic -lpthread -lc -lX11 -lm -ldl -lX11-xcb + LIBRARIES = -rdynamic -lpthread -lc -lX11 -lm -ldl -lcrypt + EARLYLIBS = -L/usr/X11R6/lib64 -L/usr/X11R6/lib +endif + +ifdef PROFILE + override PROFILE = -p +endif + +all: clean genera +nocona: clean genera.nocona + +$(SRCS): $(EMULATORINCLUDES) + +$(LIFE)/network.o: $(NETWORKSOURCES) $(EMULATORINCLUDES) + +alpha-emulator/aistat.h: alpha-emulator/aistat.sid + $(CCL) -b -Q -l compile-alpha-emulator.lisp ' header file. The option `-nodtk' can be used as +a workaround. If GNU CC is not installed, it is therefore recommended +to try + + ./configure CC="cc" + +and if that doesn't work, try + + ./configure CC="cc -nodtk" + + On Solaris, don't put `/usr/ucb' early in your `PATH'. This +directory contains several dysfunctional programs; working variants of +these programs are available in `/usr/bin'. So, if you need `/usr/ucb' +in your `PATH', put it _after_ `/usr/bin'. + + On Haiku, software installed for all users goes in `/boot/common', +not `/usr/local'. It is recommended to use the following options: + + ./configure --prefix=/boot/common + +Specifying the System Type +========================== + + There may be some features `configure' cannot figure out +automatically, but needs to determine by the type of machine the package +will run on. Usually, assuming the package is built to be run on the +_same_ architectures, `configure' can figure that out, but if it prints +a message saying it cannot guess the machine type, give it the +`--build=TYPE' option. TYPE can either be a short name for the system +type, such as `sun4', or a canonical name which has the form: + + CPU-COMPANY-SYSTEM + +where SYSTEM can have one of these forms: + + OS + KERNEL-OS + + See the file `config.sub' for the possible values of each field. If +`config.sub' isn't included in this package, then this package doesn't +need to know the machine type. + + If you are _building_ compiler tools for cross-compiling, you should +use the option `--target=TYPE' to select the type of system they will +produce code for. + + If you want to _use_ a cross compiler, that generates code for a +platform different from the build platform, you should specify the +"host" platform (i.e., that on which the generated programs will +eventually be run) with `--host=TYPE'. + +Sharing Defaults +================ + + If you want to set default values for `configure' scripts to share, +you can create a site shell script called `config.site' that gives +default values for variables like `CC', `cache_file', and `prefix'. +`configure' looks for `PREFIX/share/config.site' if it exists, then +`PREFIX/etc/config.site' if it exists. Or, you can set the +`CONFIG_SITE' environment variable to the location of the site script. +A warning: not all `configure' scripts look for a site script. + +Defining Variables +================== + + Variables not defined in a site shell script can be set in the +environment passed to `configure'. However, some packages may run +configure again during the build, and the customized values of these +variables may be lost. In order to avoid this problem, you should set +them in the `configure' command line, using `VAR=value'. For example: + + ./configure CC=/usr/local2/bin/gcc + +causes the specified `gcc' to be used as the C compiler (unless it is +overridden in the site shell script). + +Unfortunately, this technique does not work for `CONFIG_SHELL' due to +an Autoconf limitation. Until the limitation is lifted, you can use +this workaround: + + CONFIG_SHELL=/bin/bash ./configure CONFIG_SHELL=/bin/bash + +`configure' Invocation +====================== + + `configure' recognizes the following options to control how it +operates. + +`--help' +`-h' + Print a summary of all of the options to `configure', and exit. + +`--help=short' +`--help=recursive' + Print a summary of the options unique to this package's + `configure', and exit. The `short' variant lists options used + only in the top level, while the `recursive' variant lists options + also present in any nested packages. + +`--version' +`-V' + Print the version of Autoconf used to generate the `configure' + script, and exit. + +`--cache-file=FILE' + Enable the cache: use and save the results of the tests in FILE, + traditionally `config.cache'. FILE defaults to `/dev/null' to + disable caching. + +`--config-cache' +`-C' + Alias for `--cache-file=config.cache'. + +`--quiet' +`--silent' +`-q' + Do not print messages saying which checks are being made. To + suppress all normal output, redirect it to `/dev/null' (any error + messages will still be shown). + +`--srcdir=DIR' + Look for the package's source code in directory DIR. Usually + `configure' can determine that directory automatically. + +`--prefix=DIR' + Use DIR as the installation prefix. *note Installation Names:: + for more details, including other options available for fine-tuning + the installation locations. + +`--no-create' +`-n' + Run the configure checks, but stop before creating any output + files. + +`configure' also accepts some other, not widely useful, options. Run +`configure --help' for more details. diff --git a/Makefile.am b/Makefile.am new file mode 100644 index 0000000..70c082e --- /dev/null +++ b/Makefile.am @@ -0,0 +1,8 @@ +SUBDIRS= emulator life-support stub src + +EXTRA_DIST=include admin alpha-emulator assembler c-emulator documentation g5-emulator other support translator x86_64-emulator emulator life-support stub src OG2-patches + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..e69de29 diff --git a/OG2-patches/allow-multiple-ll-addresses.lisp b/OG2-patches/allow-multiple-ll-addresses.lisp new file mode 100644 index 0000000..fd5658e --- /dev/null +++ b/OG2-patches/allow-multiple-ll-addresses.lisp @@ -0,0 +1,131 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp Machine, 3/12/14 20:31:49 +;;; while running on GENERA from GENERA-HOST:jjsc1i0.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Ivory Revision 5, VLM Debugger 329, Genera program 9.0, DEC OSF/1 V127, +;;; 1280x956 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11403901), +;;; Machine serial number 1833832527, Linux, +;;; not Alpha (from GENERA-HOST:/home/lispm/patches.sct/alpha.lisp.~3~), +;;; doc ex drawings (from GENERA-HOST:/home/lispm/patches.sct/docs-ellipse.lisp.~3~), +;;; OpenSuse FSS (from GENERA-HOST:/home/lispm/patches.sct/opensuse-fss-patch.lisp.~1~), +;;; parse :internet before :chaos (from GENERA-HOST:/home/lispm/lsource/primary-network-address.lisp), +;;; Rational quotient (from GENERA-HOST:/home/lispm/lsource/rational-quotient.lisp). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:NETWORK;EMB-ETHERNET-DRIVER.LISP.40" + "SYS:NETWORK;I-BASIC-INTERFACES.LISP.3") + + +(SCT:NOTE-PRIVATE-PATCH "Allow multiple ll addresses") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:NETWORK;EMB-ETHERNET-DRIVER.LISP.40") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Base: 10; Package: NETWORK-INTERNALS; Syntax: Zetalisp; Lowercase: Yes -*-") + +#+IMACH +;;; +;;; allow multiple ll adresses for multiple network interfaces +;; +(defwiredvar *emb-ethernet-net-address-1* (make-array 32)) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:NETWORK;EMB-ETHERNET-DRIVER.LISP.40") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Base: 10; Package: NETWORK-INTERNALS; Syntax: Zetalisp; Lowercase: Yes -*-") + +#+IMACH +(defwiredvar *emb-ethernet-net-address-2* (make-array 32)) + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:NETWORK;EMB-ETHERNET-DRIVER.LISP.40") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Base: 10; Package: NETWORK-INTERNALS; Syntax: Zetalisp; Lowercase: Yes -*-") + +#+IMACH + +(defwiredfun initialize-embedded-network () + (unless storage::*disk-exists-p* + (setf *emb-ethernet-interfaces* (storage::allocate-unmapped-array 32))) + (setf *n-emb-ethernet-interfaces* 0) + (loop ;;;with net-address-set-p = nil + for ptr first (emb-channel-table) then (emb-net-channel-next channel) + until (= ptr -1) + for channel = (emb-pointer-to-pma ptr) + when (= (emb-net-channel-type channel) %emb-channel-type-network) + do ;;;(unless net-address-set-p + (progn + (setq sys:net-address-1 (emb-net-channel-hardware-address-high channel) + sys:net-address-2 (emb-net-channel-hardware-address-low channel)) + ;;; net-address-set-p t) + (setf (aref *emb-ethernet-net-address-1* *n-emb-ethernet-interfaces*) + (emb-net-channel-hardware-address-high channel)) + (setf (aref *emb-ethernet-net-address-2* *n-emb-ethernet-interfaces*) + (emb-net-channel-hardware-address-low channel))) + (let ((interface + (or (aref *emb-ethernet-interfaces* *n-emb-ethernet-interfaces*) + (setf (aref *emb-ethernet-interfaces* *n-emb-ethernet-interfaces*) + (storage::allocate-unmapped-array (emb-ethernet-driver-size)))))) + (fill-emb-ethernet-driver channel interface)) + (incf *n-emb-ethernet-interfaces*))) + +(defwiredfun emb-ethernet-transmit-epacket (driver epacket free-flag data-length) + (unless (= (epacket-ref-count epacket) 1) + (wired-ferror :proceedable-halt + "Attempt to transmit packet ~S, whose ref-count is not 1" + epacket)) + (let ((length (max data-length 16.))) + (when (> length 1500.) + (wired-ferror :proceedable-halt "~S Packet too long" length)) + (setf (epacket-data-length epacket) length)) + (setf (epacket-link epacket) nil) + (sys:%set-trap-mode sys:trap-mode-io) + (unless free-flag + (incf (epacket-ref-count epacket))) + (let ((last-epacket (eei-transmit-list-tail driver))) + (setf (eei-transmit-list-tail driver) epacket) + (cond (last-epacket + (setf (epacket-link last-epacket) epacket)) + (t + (setf (eei-transmit-list-head driver) epacket) + (when t + (cli::enqueue-interrupt-task #'emb-ethernet-do-transmit-work driver 2) + (cli::execute-interrupt-tasks)))) + nil)) + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:NETWORK;I-BASIC-INTERFACES.LISP.3") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: NETWORK-INTERNALS; Base: 8; -*-") + +#+IMACH + +(DEFMETHOD (:RESET IVORY-ETHERNET-INTERFACE :BEFORE) () + ;; If we ever try to be a bridge, this whole scheme of NET-ADDRESS-n and + ;; LOCAL-HARDWARE-ADDRESS needs to be reimplemented. + (SETQ LOCAL-HARDWARE-ADDRESS + (LET* ((channel (pni-number low-level-interface)) + (ADDR (MAKE-ARRAY 6 ':TYPE 'ART-8B ':AREA NETWORK-CONS-AREA)) + (INDEX 0)) + (FILL-IN-BYTES :LITTLE ADDR INDEX + (DPB (aref *emb-ethernet-net-address-2* channel) + (BYTE 20 40) + (aref *emb-ethernet-net-address-1* channel)) 6) + ADDR))) + +(eval-when (load eval) + (neti:initialize-embedded-network) + (neti:general-network-reset) + (neti:enable)) \ No newline at end of file diff --git a/OG2-patches/detect-keyboard-patch.lisp b/OG2-patches/detect-keyboard-patch.lisp new file mode 100644 index 0000000..cee68f5 --- /dev/null +++ b/OG2-patches/detect-keyboard-patch.lisp @@ -0,0 +1,1337 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp Machine, 3/19/14 16:24:59 +;;; while running on CHAOS from CHAOS-HOST:who-calls-chaos.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Ivory Revision 5, VLM Debugger 329, Genera program 9.0, DEC OSF/1 V127, +;;; 1280x956 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11403901), +;;; Machine serial number 672934633, +;;; Allow multiple ll addresses (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/allow-multiple-ll-addresses.), +;;; Linux, not Alpha (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/alpha.), +;;; doc ex drawings (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/docs-ellipse.), +;;; more emb eth packets and disk buffers (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/emb-bufs.), +;;; disable lossage in get-emb-host (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/get-emb-host.), +;;; OpenSuse FSS (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/opensuse-fss-patch.), +;;; primary network: parse :internet before :chaos (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/primary-network-address.), +;;; Rational quotient (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/rational-quotient.), +;;; disable GC during user disk io (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/user-disk-without-gc.). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:X11;CLX;KEYSYMS.LISP.5001" + "SYS:X11;SCREEN;X-CONSOLE.LISP.47" + "SYS:X11;SCREEN;X-KEYSYM-NAMES.LISP.8") + + +(SCT:NOTE-PRIVATE-PATCH "detect keyboard") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:X11;CLX;KEYSYMS.LISP.5001") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:YES -*-") + + +;#+vlm + (defconstant iso-level3-shift-keysym (keysym 254 003)) + (define-keysym :iso-level3-shift iso-level3-shift-keysym) + + (defconstant keypad-home-keysym (keysym 255 149)) + (define-keysym :keypad-home keypad-home-keysym) + + (defconstant keypad-left-keysym (keysym 255 150)) + (define-keysym :keypad-left keypad-left-keysym) + + (defconstant keypad-up-keysym (keysym 255 151)) + (define-keysym :keypad-up keypad-up-keysym) + + (defconstant keypad-right-keysym (keysym 255 152)) + (define-keysym :keypad-right keypad-right-keysym) + + (defconstant keypad-down-keysym (keysym 255 153)) + (define-keysym :keypad-down keypad-down-keysym) + + (defconstant keypad-prior-keysym (keysym 255 154)) + (define-keysym :keypad-prior keypad-prior-keysym) + + (defconstant keypad-next-keysym (keysym 255 155)) + (define-keysym :keypad-next keypad-next-keysym) + + (defconstant keypad-end-keysym (keysym 255 156)) + (define-keysym :keypad-end keypad-end-keysym) + + (defconstant keypad-begin-keysym (keysym 255 157)) + (define-keysym :keypad-begin keypad-begin-keysym) + + (defconstant keypad-insert-keysym (keysym 255 158)) + (define-keysym :keypad-insert keypad-insert-keysym) + + (defconstant keypad-delete-keysym (keysym 255 159)) + (define-keysym :keypad-delete keypad-delete-keysym) + + (defconstant dead-circumflex-keysym (keysym 254 82)) + (define-keysym :dead-circumflex dead-circumflex-keysym) + + (defconstant dead-acute-keysym (keysym 254 81)) + (define-keysym :dead-acute dead-acute-keysym) + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:X11;SCREEN;X-CONSOLE.LISP.47") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Base: 10; Package: X-SCREEN; Mode: LISP; Syntax: Common-lisp; Lowercase: T -*-") + +;(defparameter +; *modifier-mapping-alist* +; '((:shift :left-shift :right-shift) +; (:lock :caps-lock :num-lock) +; (:control :left-control :right-control) +; (:meta :left-meta :right-meta) +; (:super :left-super :right-super) +; (:hyper :left-hyper :right-hyper) +; (:symbol :left-symbol :right-symbol) +; (:function :mode-lock #\Abort #\Select #\Function #\Network #\Suspend #\Resume #\Help))) + +(defun-in-flavor (fill-keyboard-table-specific x-console) (table layout-type) + (loop with nxshifts = (array-dimension (xlib::display-keyboard-mapping display) 1) + with nlshifts = (array-dimension table 0) + with null-mapping = (sys:standardize-keyboard-mapping nil t) + with keyboard-mapping = + (keyboard-mapping-keys + (or (layout-type-keyboard-mapping layout-type) + (layout-type-keyboard-mapping :default))) + for code from (xlib:display-min-keycode display) + to (xlib:display-max-keycode display) + for code-keys = (cdr (assoc (keycode->keynum code) keyboard-mapping)) + do (when code-keys + ;; key code specific key mappings have the highest priority + (loop for lshift below nlshifts + for key = (or (nth lshift code-keys) (first code-keys)) + when (and key t) +;; (= (aref table lshift (keycode->keynum code)) +;; null-mapping)) + do (setf (aref table lshift (keycode->keynum code)) + (sys:standardize-keyboard-mapping key t)))) + ;; Next comes shift specific key mappings + (loop with unshifted-keysym = (xlib:keycode->keysym display code 0) + for xshift below nxshifts + for lshift below nlshifts + when (= (aref table lshift (keycode->keynum code)) null-mapping) + do (loop with shifted-keysym = (xlib:keycode->keysym display code xshift) + with shifted-keysym-names = + (gethash shifted-keysym *keysym-name-table*) + for shifted-keysym-name in shifted-keysym-names + for shifted-key = + (cadr (assoc shifted-keysym-name keyboard-mapping)) + when (and shifted-key + (not (= unshifted-keysym shifted-keysym)) +;; (= (aref table lshift (keycode->keynum code)) +;; null-mapping)) + ) + do (setf (aref table lshift (keycode->keynum code)) + (sys:standardize-keyboard-mapping shifted-key t)) + and return)) + ;; finally mappings based on the unshifted keysym + (loop with unshifted-keysym = (xlib:keycode->keysym display code 0) + with unshifted-keysym-names = (gethash unshifted-keysym *keysym-name-table*) + for lshift below nlshifts + do (loop for unshifted-keysym-name in unshifted-keysym-names + for unshifted-keys = + (cdr (assoc unshifted-keysym-name keyboard-mapping)) + for key = (or (nth lshift unshifted-keys) (first unshifted-keys)) + when (and key t) +;; (= (aref table lshift (keycode->keynum code)) +;; null-mapping)) + do (setf (aref table lshift (keycode->keynum code)) + (sys:standardize-keyboard-mapping key t)))))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:X11;SCREEN;X-KEYSYM-NAMES.LISP.8") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: Lisp; Package: X-SCREEN; Syntax: Common-Lisp; Lowercase: Yes -*-") + +;; +;; added the following keysyms: +;; +; (254 3 "iso level3 shift" :ISO-LEVEL3-SHIFT) +; (255 149 "Keypad Home" :KEYPAD-HOME) +; (255 150 "Keypad Left" :KEYPAD-LEFT) +; (255 151 "Keypad Up" :KEYPAD-UP) +; (255 152 "Keypad Right" :KEYPAD-RIGHT) +; (255 153 "Keypad Down" :KEYPAD-DOWN) +; (255 154 "Keypad Prior" :KEYPAD-PRIOR) +; (255 155 "Keypad Next" :KEYPAD-NEXT) +; (255 156 "Keypad End" :KEYPAD-END) +; (255 157 "Keypad Begin" :KEYPAD-BEGIN) +; (255 158 "Keypad Insert" :KEYPAD-INSERT) +; (255 159 "Keypad Delete" :KEYPAD-DELETE) +;; +;; + +(defparameter + *keysym-name-list* + '((000 032 " " :space) + (000 033 "!" :exclamation-point) + (000 034 "\"" :quotation-mark) + (000 035 "#" :number-sign) + (000 036 "$" :dollar-sign) + (000 037 "%" :percent-sign) + (000 038 "&" :ampersand) + (000 039 "'" :apostrophe) + (000 040 "(" :left-parenthesis) + (000 041 ")" :right-parenthesis) + (000 042 "*" :asterisk) + (000 043 "+" :plus-sign) + (000 044 "," :comma) + (000 045 "-" :hyphen :minus-sign) + (000 046 "." :full-stop) + (000 047 "/" :solidus) + (000 048 "0" :digit-zero) + (000 049 "1" :digit-one) + (000 050 "2" :digit-two) + (000 051 "3" :digit-three) + (000 052 "4" :digit-four) + (000 053 "5" :digit-five) + (000 054 "6" :digit-six) + (000 055 "7" :digit-seven) + (000 056 "8" :digit-eight) + (000 057 "9" :digit-nine) + (000 058 ":" :colon) + (000 059 ";" :semicolon) + (000 060 "<" :less-than-sign) + (000 061 "=" :equals-sign) + (000 062 ">" :greater-than-sign) + (000 063 "?" :question-mark) + (000 064 "@" :commercial-at) + (000 065 "A" :latin-capital-letter-a) + (000 066 "B" :latin-capital-letter-b) + (000 067 "C" :latin-capital-letter-c) + (000 068 "D" :latin-capital-letter-d) + (000 069 "E" :latin-capital-letter-e) + (000 070 "F" :latin-capital-letter-f) + (000 071 "G" :latin-capital-letter-g) + (000 072 "H" :latin-capital-letter-h) + (000 073 "I" :latin-capital-letter-i) + (000 074 "J" :latin-capital-letter-j) + (000 075 "K" :latin-capital-letter-k) + (000 076 "L" :latin-capital-letter-l) + (000 077 "M" :latin-capital-letter-m) + (000 078 "N" :latin-capital-letter-n) + (000 079 "O" :latin-capital-letter-o) + (000 080 "P" :latin-capital-letter-p) + (000 081 "Q" :latin-capital-letter-q) + (000 082 "R" :latin-capital-letter-r) + (000 083 "S" :latin-capital-letter-s) + (000 084 "T" :latin-capital-letter-t) + (000 085 "U" :latin-capital-letter-u) + (000 086 "V" :latin-capital-letter-v) + (000 087 "W" :latin-capital-letter-w) + (000 088 "X" :latin-capital-letter-x) + (000 089 "Y" :latin-capital-letter-y) + (000 090 "Z" :latin-capital-letter-z) + (000 091 "[" :left-square-bracket) + (000 092 "\\" :reverse-solidus) + (000 093 "]" :right-square-bracket) + (000 094 "^" :circumflex-accent) + (000 095 "_" :low-line) + (000 096 "`" :GRAVE-ACCENT) + (000 097 "a" :latin-small-letter-a) + (000 098 "b" :latin-small-letter-b) + (000 099 "c" :latin-small-letter-c) + (000 100 "d" :latin-small-letter-d) + (000 101 "e" :latin-small-letter-e) + (000 102 "f" :latin-small-letter-f) + (000 103 "g" :latin-small-letter-g) + (000 104 "h" :latin-small-letter-h) + (000 105 "i" :latin-small-letter-i) + (000 106 "j" :latin-small-letter-j) + (000 107 "k" :latin-small-letter-k) + (000 108 "l" :latin-small-letter-l) + (000 109 "m" :latin-small-letter-m) + (000 110 "n" :latin-small-letter-n) + (000 111 "o" :latin-small-letter-o) + (000 112 "p" :latin-small-letter-p) + (000 113 "q" :latin-small-letter-q) + (000 114 "r" :latin-small-letter-r) + (000 115 "s" :latin-small-letter-s) + (000 116 "t" :latin-small-letter-t) + (000 117 "u" :latin-small-letter-u) + (000 118 "v" :latin-small-letter-v) + (000 119 "w" :latin-small-letter-w) + (000 120 "x" :latin-small-letter-x) + (000 121 "y" :latin-small-letter-y) + (000 122 "z" :latin-small-letter-z) + (000 123 "{" :left-curly-bracket) + (000 124 "|" :vertical-line) + (000 125 "}" :right-curly-bracket) + (000 126 "~" :tilde) + (000 160 "no break space" :no-break-space) + (000 161 "inverted exclamation mark" :inverted-exclamation-mark) + (000 162 "cent sign" :cent-sign) + (000 163 "pound sign" :pound-sign) + (000 164 "currency sign" :currency-sign) + (000 165 "yen sign" :yen-sign) + (000 166 "broken vertical bar" :broken-vertical-bar) + (000 167 "paragraph sign" :paragraph-sign :section-sign) + (000 168 "diaeresis" :diaeresis) + (000 169 "copyright sign" :copyright-sign) + (000 170 "feminine ordinal indicator" :feminine-ordinal-indicator) + (000 171 "left angle quotation mark" :left-angle-quotation-mark) + (000 172 "not sign" :not-sign) + (000 174 "registered trade mark sign" :registered-trade-mark-sign) + (000 175 "macron" :macron) + (000 176 "degree sign" :degree-sign :ring-above) + (000 177 "plus minus sign" :plus-minus-sign) + (000 178 "superscript two" :superscript-two) + (000 179 "superscript three" :superscript-three) + (000 180 "acute accent" :acute-accent) + (000 181 "micro sign" :micro-sign) + (000 182 "pilcrow sign" :pilcrow-sign) + (000 183 "middle dot" :middle-dot) + (000 184 "cedilla" :cedilla) + (000 185 "superscript one" :superscript-one) + (000 186 "masculine ordinal indicator" :masculine-ordinal-indicator) + (000 187 "right angle quotation mark" :right-angle-quotation-mark) + (000 188 "vulgar fraction one quarter" :vulgar-fraction-one-quarter) + (000 189 "vulgar fraction one half" :vulgar-fraction-one-half) + (000 190 "vulgar fraction three quarters" :vulgar-fraction-three-quarters) + (000 191 "inverted question mark" :inverted-question-mark) + (000 192 "A with grave accent" :latin-capital-letter-a-with-grave-accent) + (000 193 "A with acute accent" :latin-capital-letter-a-with-acute-accent) + (000 194 "A with circumflex accent" :latin-capital-letter-a-with-circumflex-accent) + (000 195 "A with tilde" :latin-capital-letter-a-with-tilde) + (000 196 "A with diaeresis" :latin-capital-letter-a-with-diaeresis) + (000 197 "A with ring above" :latin-capital-letter-a-with-ring-above) + (000 198 "AE" :latin-capital-diphthong-ae) + (000 199 "C with cedilla" :latin-capital-letter-c-with-cedilla) + (000 200 "E with grave accent" :latin-capital-letter-e-with-grave-accent) + (000 201 "E with acute accent" :latin-capital-letter-e-with-acute-accent) + (000 202 "E with circumflex accent" :latin-capital-letter-e-with-circumflex-accent) + (000 203 "E with diaeresis" :latin-capital-letter-e-with-diaeresis) + (000 204 "I with grave accent" :latin-capital-letter-i-with-grave-accent) + (000 205 "I with acute accent" :latin-capital-letter-i-with-acute-accent) + (000 206 "I with circumflex accent" :latin-capital-letter-i-with-circumflex-accent) + (000 207 "I with diaeresis" :latin-capital-letter-i-with-diaeresis) + (000 208 "ETH" :icelandic-capital-letter-eth) + (000 209 "N with tilde" :latin-capital-letter-n-with-tilde) + (000 210 "O with grave accent" :latin-capital-letter-o-with-grave-accent) + (000 211 "O with acute accent" :latin-capital-letter-o-with-acute-accent) + (000 212 "O with circumflex accent" :latin-capital-letter-o-with-circumflex-accent) + (000 213 "O with tilde" :latin-capital-letter-o-with-tilde) + (000 214 "O with diaeresis" :latin-capital-letter-o-with-diaeresis) + (000 215 "multiplication sign" :multiplication-sign) + (000 216 "O with oblique stroke" :latin-capital-letter-o-with-oblique-stroke) + (000 217 "U with grave accent" :latin-capital-letter-u-with-grave-accent) + (000 218 "U with acute accent" :latin-capital-letter-u-with-acute-accent) + (000 219 "U with circumflex accent" :latin-capital-letter-u-with-circumflex-accent) + (000 220 "U with diaeresis" :latin-capital-letter-u-with-diaeresis) + (000 221 "Y with acute accent" :latin-capital-letter-y-with-acute-accent) + (000 222 "THORN" :icelandic-capital-letter-thorn) + (000 223 "sharp s" :german-small-letter-sharp-s) + (000 224 "a with grave accent" :latin-small-letter-a-with-grave-accent) + (000 225 "a with acute accent" :latin-small-letter-a-with-acute-accent) + (000 226 "a with circumflex accent" :latin-small-letter-a-with-circumflex-accent) + (000 227 "a with tilde" :latin-small-letter-a-with-tilde) + (000 228 "a with diaeresis" :latin-small-letter-a-with-diaeresis) + (000 229 "a with ring above" :latin-small-letter-a-with-ring-above) + (000 230 "ae" :latin-small-diphthong-ae) + (000 231 "c with cedilla" :latin-small-letter-c-with-cedilla) + (000 232 "e with grave accent" :latin-small-letter-e-with-grave-accent) + (000 233 "e with acute accent" :latin-small-letter-e-with-acute-accent) + (000 234 "e with circumflex accent" :latin-small-letter-e-with-circumflex-accent) + (000 235 "e with diaeresis" :latin-small-letter-e-with-diaeresis) + (000 236 "i with grave accent" :latin-small-letter-i-with-grave-accent) + (000 237 "i with acute accent" :latin-small-letter-i-with-acute-accent) + (000 238 "i with circumflex accent" :latin-small-letter-i-with-circumflex-accent) + (000 239 "i with diaeresis" :latin-small-letter-i-with-diaeresis) + (000 240 "eth" :icelandic-small-letter-eth) + (000 241 "n with tilde" :latin-small-letter-n-with-tilde) + (000 242 "o with grave accent" :latin-small-letter-o-with-grave-accent) + (000 243 "o with acute accent" :latin-small-letter-o-with-acute-accent) + (000 244 "o with circumflex accent" :latin-small-letter-o-with-circumflex-accent) + (000 245 "o with tilde" :latin-small-letter-o-with-tilde) + (000 246 "o with diaeresis" :latin-small-letter-o-with-diaeresis) + (000 247 "division sign" :division-sign) + (000 248 "o with oblique stroke" :latin-small-letter-o-with-oblique-stroke) + (000 249 "u with grave accent" :latin-small-letter-u-with-grave-accent) + (000 250 "u with acute accent" :latin-small-letter-u-with-acute-accent) + (000 251 "u with circumflex accent" :latin-small-letter-u-with-circumflex-accent) + (000 252 "u with diaeresis" :latin-small-letter-u-with-diaeresis) + (000 253 "y with acute accent" :latin-small-letter-y-with-acute-accent) + (000 254 "thorn" :icelandic-small-letter-thorn) + (000 255 "y with diaeresis" :latin-small-letter-y-with-diaeresis) + (001 161 "A with ogonek" :latin-capital-letter-a-with-ogonek) + (001 162 "breve" :breve) + (001 163 "L with stroke" :latin-capital-letter-l-with-stroke) + (001 165 "L with caron" :latin-capital-letter-l-with-caron) + (001 166 "S with acute accent" :latin-capital-letter-s-with-acute-accent) + (001 169 "S with caron" :latin-capital-letter-s-with-caron) + (001 170 "S with cedilla" :latin-capital-letter-s-with-cedilla) + (001 171 "T with caron" :latin-capital-letter-t-with-caron) + (001 172 "Z with acute accent" :latin-capital-letter-z-with-acute-accent) + (001 174 "Z with caron" :latin-capital-letter-z-with-caron) + (001 175 "Z with dot above" :latin-capital-letter-z-with-dot-above) + (001 177 "a with ogonek" :latin-small-letter-a-with-ogonek) + (001 178 "ogonek" :ogonek) + (001 179 "l with stroke" :latin-small-letter-l-with-stroke) + (001 181 "l with caron" :latin-small-letter-l-with-caron) + (001 182 "s with acute accent" :latin-small-letter-s-with-acute-accent) + (001 183 "caron" :caron) + (001 185 "s with caron" :latin-small-letter-s-with-caron) + (001 186 "s with cedilla" :latin-small-letter-s-with-cedilla) + (001 187 "t with caron" :latin-small-letter-t-with-caron) + (001 188 "z with acute accent" :latin-small-letter-z-with-acute-accent) + (001 189 "double acute accent" :double-acute-accent) + (001 190 "z with caron" :latin-small-letter-z-with-caron) + (001 191 "z with dot above" :latin-small-letter-z-with-dot-above) + (001 192 "R with acute accent" :latin-capital-letter-r-with-acute-accent) + (001 195 "A with breve" :latin-capital-letter-a-with-breve) + (001 197 "L with acute accent" :latin-capital-letter-l-with-acute-accent) + (001 198 "C with acute accent" :latin-capital-letter-c-with-acute-accent) + (001 200 "C with caron" :latin-capital-letter-c-with-caron) + (001 202 "E with ogonek" :latin-capital-letter-e-with-ogonek) + (001 204 "E with caron" :latin-capital-letter-e-with-caron) + (001 207 "D with caron" :latin-capital-letter-d-with-caron) + (001 208 "D with stroke" :latin-capital-letter-d-with-stroke) + (001 209 "N with acute accent" :latin-capital-letter-n-with-acute-accent) + (001 210 "N with caron" :latin-capital-letter-n-with-caron) + (001 213 "O with double acute accent" :latin-capital-letter-o-with-double-acute-accent) + (001 216 "R with caron" :latin-capital-letter-r-with-caron) + (001 217 "U with ring above" :latin-capital-letter-u-with-ring-above) + (001 219 "U with double acute accent" :latin-capital-letter-u-with-double-acute-accent) + (001 222 "T with cedilla" :latin-capital-letter-t-with-cedilla) + (001 224 "r with acute accent" :latin-small-letter-r-with-acute-accent) + (001 227 "a with breve" :latin-small-letter-a-with-breve) + (001 229 "l with acute accent" :latin-small-letter-l-with-acute-accent) + (001 230 "c with acute accent" :latin-small-letter-c-with-acute-accent) + (001 232 "c with caron" :latin-small-letter-c-with-caron) + (001 234 "e with ogonek" :latin-small-letter-e-with-ogonek) + (001 236 "e with caron" :latin-small-letter-e-with-caron) + (001 239 "d with caron" :latin-small-letter-d-with-caron) + (001 240 "d with stroke" :latin-small-letter-d-with-stroke) + (001 241 "n with acute accent" :latin-small-letter-n-with-acute-accent) + (001 242 "n with caron" :latin-small-letter-n-with-caron) + (001 245 "o with double acute accent" :latin-small-letter-o-with-double-acute-accent) + (001 248 "r with caron" :latin-small-letter-r-with-caron) + (001 249 "u with ring above" :latin-small-letter-u-with-ring-above) + (001 251 "u with double acute accent" :latin-small-letter-u-with-double-acute-accent) + (001 254 "t with cedilla" :latin-small-letter-t-with-cedilla) + (001 255 "dot above" :dot-above) + (002 161 "H with stroke" :latin-capital-letter-h-with-stroke) + (002 166 "H with circumflex accent" :latin-capital-letter-h-with-circumflex-accent) + (002 169 "I with dot above" :latin-capital-letter-i-with-dot-above) + (002 171 "G with breve" :latin-capital-letter-g-with-breve) + (002 172 "J with circumflex accent" :latin-capital-letter-j-with-circumflex-accent) + (002 177 "h with stroke" :latin-small-letter-h-with-stroke) + (002 182 "h with circumflex accent" :latin-small-letter-h-with-circumflex-accent) + (002 185 "i" :small-dotless-letter-i) + (002 187 "g with breve" :latin-small-letter-g-with-breve) + (002 188 "j with circumflex accent" :latin-small-letter-j-with-circumflex-accent) + (002 197 "C with dot above" :latin-capital-letter-c-with-dot-above) + (002 198 "C with circumflex accent" :latin-capital-letter-c-with-circumflex-accent) + (002 213 "G with dot above" :latin-capital-letter-g-with-dot-above) + (002 216 "G with circumflex accent" :latin-capital-letter-g-with-circumflex-accent) + (002 221 "U with breve" :latin-capital-letter-u-with-breve) + (002 222 "S with circumflex accent" :latin-capital-letter-s-with-circumflex-accent) + (002 229 "c with dot above" :latin-small-letter-c-with-dot-above) + (002 230 "c with circumflex accent" :latin-small-letter-c-with-circumflex-accent) + (002 245 "g with dot above" :latin-small-letter-g-with-dot-above) + (002 248 "g with circumflex accent" :latin-small-letter-g-with-circumflex-accent) + (002 253 "u with breve" :latin-small-letter-u-with-breve) + (002 254 "s with circumflex accent" :latin-small-letter-s-with-circumflex-accent) + (003 162 "kappa" :latin-small-letter-kappa) + (003 163 "R with cedilla" :latin-capital-letter-r-with-cedilla) + (003 165 "I with tilde" :latin-capital-letter-i-with-tilde) + (003 166 "L with cedilla" :latin-capital-letter-l-with-cedilla) + (003 170 "E with macron" :latin-capital-letter-e-with-macron) + (003 171 "G with cedilla" :latin-capital-letter-g-with-cedilla) + (003 172 "T with oblique stroke" :latin-capital-letter-t-with-oblique-stroke) + (003 179 "r with cedilla" :latin-small-letter-r-with-cedilla) + (003 181 "i with tilde" :latin-small-letter-i-with-tilde) + (003 182 "l with cedilla" :latin-small-letter-l-with-cedilla) + (003 186 "e with macron" :latin-small-letter-e-with-macron) + (003 187 "g with acute accent" :latin-small-letter-g-with-acute-accent) + (003 188 "t with oblique stroke" :latin-small-letter-t-with-oblique-stroke) + (003 189 "ENG" :lappish-capital-letter-eng) + (003 191 "eng" :lappish-small-letter-eng) + (003 192 "A with macron" :latin-capital-letter-a-with-macron) + (003 199 "I with ogonek" :latin-capital-letter-i-with-ogonek) + (003 204 "E with dot above" :latin-capital-letter-e-with-dot-above) + (003 207 "I with macron" :latin-capital-letter-i-with-macron) + (003 209 "N with cedilla" :latin-capital-letter-n-with-cedilla) + (003 210 "O with macron" :latin-capital-letter-o-with-macron) + (003 211 "K with cedilla" :latin-capital-letter-k-with-cedilla) + (003 217 "U with ogonek" :latin-capital-letter-u-with-ogonek) + (003 221 "U with tilde" :latin-capital-letter-u-with-tilde) + (003 222 "U with macron" :latin-capital-letter-u-with-macron) + (003 224 "a with macron" :latin-small-letter-a-with-macron) + (003 231 "i with ogonek" :latin-small-letter-i-with-ogonek) + (003 236 "e with dot above" :latin-small-letter-e-with-dot-above) + (003 239 "i with macron" :latin-small-letter-i-with-macron) + (003 241 "n with cedilla" :latin-small-letter-n-with-cedilla) + (003 242 "o with macron" :latin-small-letter-o-with-macron) + (003 243 "k with cedilla" :latin-small-letter-k-with-cedilla) + (003 249 "u with ogonek" :latin-small-letter-u-with-ogonek) + (003 253 "u with tilde" :latin-small-letter-u-with-tilde) + (003 254 "u with macron" :latin-small-letter-u-with-macron) + (004 126 "overline" :overline) + (004 161 "kana full stop" :kana-full-stop) + (004 162 "kana opening bracket" :kana-opening-bracket) + (004 163 "kana closing bracket" :kana-closing-bracket) + (004 164 "kana comma" :kana-comma) + (004 165 "kana middle dot" :kana-middle-dot) + (004 166 "wo" :kana-letter-wo) + (004 167 "small a" :kana-letter-small-a) + (004 168 "small i" :kana-letter-small-i) + (004 169 "small u" :kana-letter-small-u) + (004 170 "small e" :kana-letter-small-e) + (004 171 "small o" :kana-letter-small-o) + (004 172 "small ya" :kana-letter-small-ya) + (004 173 "small yu" :kana-letter-small-yu) + (004 174 "small yo" :kana-letter-small-yo) + (004 175 "small tu" :kana-letter-small-tu) + (004 176 "prolonged sound symbol" :prolonged-sound-symbol) + (004 177 "a" :kana-letter-a) + (004 178 "i" :kana-letter-i) + (004 179 "u" :kana-letter-u) + (004 180 "e" :kana-letter-e) + (004 181 "o" :kana-letter-o) + (004 182 "ka" :kana-letter-ka) + (004 183 "ki" :kana-letter-ki) + (004 184 "ku" :kana-letter-ku) + (004 185 "ke" :kana-letter-ke) + (004 186 "ko" :kana-letter-ko) + (004 187 "sa" :kana-letter-sa) + (004 188 "shi" :kana-letter-shi) + (004 189 "su" :kana-letter-su) + (004 190 "se" :kana-letter-se) + (004 191 "so" :kana-letter-so) + (004 192 "ta" :kana-letter-ta) + (004 193 "ti" :kana-letter-ti) + (004 194 "tu" :kana-letter-tu) + (004 195 "te" :kana-letter-te) + (004 196 "to" :kana-letter-to) + (004 197 "na" :kana-letter-na) + (004 198 "ni" :kana-letter-ni) + (004 199 "nu" :kana-letter-nu) + (004 200 "ne" :kana-letter-ne) + (004 201 "no" :kana-letter-no) + (004 202 "ha" :kana-letter-ha) + (004 203 "hi" :kana-letter-hi) + (004 204 "hu" :kana-letter-hu) + (004 205 "he" :kana-letter-he) + (004 206 "ho" :kana-letter-ho) + (004 207 "ma" :kana-letter-ma) + (004 208 "mi" :kana-letter-mi) + (004 209 "mu" :kana-letter-mu) + (004 210 "me" :kana-letter-me) + (004 211 "mo" :kana-letter-mo) + (004 212 "ya" :kana-letter-ya) + (004 213 "yu" :kana-letter-yu) + (004 214 "yo" :kana-letter-yo) + (004 215 "ra" :kana-letter-ra) + (004 216 "ri" :kana-letter-ri) + (004 217 "ru" :kana-letter-ru) + (004 218 "re" :kana-letter-re) + (004 219 "ro" :kana-letter-ro) + (004 220 "wa" :kana-letter-wa) + (004 221 "n" :kana-letter-n) + (004 222 "voiced sound symbol" :voiced-sound-symbol) + (004 223 "semi voiced sound symbol" :semi-voiced-sound-symbol) + (005 172 "arabic comma" :arabic-comma) + (005 187 "arabic semi colon" :arabic-semi-colon) + (005 191 "arabic question mark" :arabic-question-mark) + (005 193 "hamza" :arabic-letter-hamza) + (005 194 "madda on alef" :arabic-letter-madda-on-alef) + (005 195 "hamza on alef" :arabic-letter-hamza-on-alef) + (005 196 "hamza on waw" :arabic-letter-hamza-on-waw) + (005 197 "hamza under alef" :arabic-letter-hamza-under-alef) + (005 198 "hamza on yeh" :arabic-letter-hamza-on-yeh) + (005 199 "alef" :arabic-letter-alef) + (005 200 "beh" :arabic-letter-beh) + (005 201 "teh marbuta" :arabic-letter-teh-marbuta) + (005 202 "teh" :arabic-letter-teh) + (005 203 "theh" :arabic-letter-theh) + (005 204 "jeem" :arabic-letter-jeem) + (005 205 "hah" :arabic-letter-hah) + (005 206 "khah" :arabic-letter-khah) + (005 207 "dal" :arabic-letter-dal) + (005 208 "thal" :arabic-letter-thal) + (005 209 "ra" :arabic-letter-ra) + (005 210 "zain" :arabic-letter-zain) + (005 211 "seen" :arabic-letter-seen) + (005 212 "sheen" :arabic-letter-sheen) + (005 213 "sad" :arabic-letter-sad) + (005 214 "dad" :arabic-letter-dad) + (005 215 "tah" :arabic-letter-tah) + (005 216 "zah" :arabic-letter-zah) + (005 217 "ain" :arabic-letter-ain) + (005 218 "ghain" :arabic-letter-ghain) + (005 224 "tatweel" :arabic-letter-tatweel) + (005 225 "feh" :arabic-letter-feh) + (005 226 "qaf" :arabic-letter-qaf) + (005 227 "kaf" :arabic-letter-kaf) + (005 228 "lam" :arabic-letter-lam) + (005 229 "meem" :arabic-letter-meem) + (005 230 "noon" :arabic-letter-noon) + (005 231 "heh" :arabic-letter-heh) + (005 232 "waw" :arabic-letter-waw) + (005 233 "alef maksura" :arabic-letter-alef-maksura) + (005 234 "yeh" :arabic-letter-yeh) + (005 235 "fathatan" :arabic-letter-fathatan) + (005 236 "dammatan" :arabic-letter-dammatan) + (005 237 "kasratan" :arabic-letter-kasratan) + (005 238 "fatha" :arabic-letter-fatha) + (005 239 "damma" :arabic-letter-damma) + (005 240 "kasra" :arabic-letter-kasra) + (005 241 "shadda" :arabic-letter-shadda) + (005 242 "sukun" :arabic-letter-sukun) + (006 161 "dje" :serbian-small-letter-dje) + (006 162 "gje" :macedonia-small-letter-gje) + (006 163 "io" :cyrillic-small-letter-io) + (006 164 "je" :ukranian-small-letter-je) + (006 165 "dse" :macedonia-small-letter-dse) + (006 166 "i" :ukranian-small-letter-i) + (006 167 "yi" :ukranian-small-letter-yi) + (006 168 "je" :serbian-small-letter-je) + (006 169 "lje" :serbian-small-letter-lje) + (006 170 "nje" :serbian-small-letter-nje) + (006 171 "tshe" :serbian-small-letter-tshe) + (006 172 "kje" :macedonia-small-letter-kje) + (006 174 "short u" :byelorussian-small-letter-short-u) + (006 175 "dze" :serbian-small-letter-dze) + (006 176 "numero sign" :numero-sign) + (006 177 "DJE" :serbian-capital-letter-dje) + (006 178 "GJE" :macedonia-capital-letter-gje) + (006 179 "IO" :cyrillic-capital-letter-io) + (006 180 "JE" :ukranian-capital-letter-je) + (006 181 "DSE" :macedonia-capital-letter-dse) + (006 182 "I" :ukranian-capital-letter-i) + (006 183 "YI" :ukranian-capital-letter-yi) + (006 184 "JE" :serbian-capital-letter-je) + (006 185 "LJE" :serbian-capital-letter-lje) + (006 186 "NJE" :serbian-capital-letter-nje) + (006 187 "TSHE" :serbian-capital-letter-tshe) + (006 188 "KJE" :macedonia-capital-letter-kje) + (006 190 "SHORT u" :byelorussian-capital-letter-short-u) + (006 191 "DZE" :serbian-capital-letter-dze) + (006 192 "yu" :cyrillic-small-letter-yu) + (006 193 "a" :cyrillic-small-letter-a) + (006 194 "be" :cyrillic-small-letter-be) + (006 195 "tse" :cyrillic-small-letter-tse) + (006 196 "de" :cyrillic-small-letter-de) + (006 197 "ie" :cyrillic-small-letter-ie) + (006 198 "ef" :cyrillic-small-letter-ef) + (006 199 "ghe" :cyrillic-small-letter-ghe) + (006 200 "ha" :cyrillic-small-letter-ha) + (006 201 "i" :cyrillic-small-letter-i) + (006 202 "short i" :cyrillic-small-letter-short-i) + (006 203 "ka" :cyrillic-small-letter-ka) + (006 204 "el" :cyrillic-small-letter-el) + (006 205 "em" :cyrillic-small-letter-em) + (006 206 "en" :cyrillic-small-letter-en) + (006 207 "o" :cyrillic-small-letter-o) + (006 208 "pe" :cyrillic-small-letter-pe) + (006 209 "ya" :cyrillic-small-letter-ya) + (006 210 "er" :cyrillic-small-letter-er) + (006 211 "es" :cyrillic-small-letter-es) + (006 212 "te" :cyrillic-small-letter-te) + (006 213 "u" :cyrillic-small-letter-u) + (006 214 "zhe" :cyrillic-small-letter-zhe) + (006 215 "ve" :cyrillic-small-letter-ve) + (006 216 "cyrillic small soft sign" :cyrillic-small-soft-sign) + (006 217 "yeru" :cyrillic-small-letter-yeru) + (006 218 "ze" :cyrillic-small-letter-ze) + (006 219 "sha" :cyrillic-small-letter-sha) + (006 220 "e" :cyrillic-small-letter-e) + (006 221 "shcha" :cyrillic-small-letter-shcha) + (006 222 "che" :cyrillic-small-letter-che) + (006 223 "cyrillic small hard sign" :cyrillic-small-hard-sign) + (006 224 "YU" :cyrillic-capital-letter-yu) + (006 225 "A" :cyrillic-capital-letter-a) + (006 226 "BE" :cyrillic-capital-letter-be) + (006 227 "TSE" :cyrillic-capital-letter-tse) + (006 228 "DE" :cyrillic-capital-letter-de) + (006 229 "IE" :cyrillic-capital-letter-ie) + (006 230 "EF" :cyrillic-capital-letter-ef) + (006 231 "GHE" :cyrillic-capital-letter-ghe) + (006 232 "HA" :cyrillic-capital-letter-ha) + (006 233 "I" :cyrillic-capital-letter-i) + (006 234 "SHORT i" :cyrillic-capital-letter-short-i) + (006 235 "KA" :cyrillic-capital-letter-ka) + (006 236 "EL" :cyrillic-capital-letter-el) + (006 237 "EM" :cyrillic-capital-letter-em) + (006 238 "EN" :cyrillic-capital-letter-en) + (006 239 "O" :cyrillic-capital-letter-o) + (006 240 "PE" :cyrillic-capital-letter-pe) + (006 241 "YA" :cyrillic-capital-letter-ya) + (006 242 "ER" :cyrillic-capital-letter-er) + (006 243 "ES" :cyrillic-capital-letter-es) + (006 244 "TE" :cyrillic-capital-letter-te) + (006 245 "U" :cyrillic-capital-letter-u) + (006 246 "ZHE" :cyrillic-capital-letter-zhe) + (006 247 "VE" :cyrillic-capital-letter-ve) + (006 248 "SOFT SIGN" :cyrillic-capital-soft-sign) + (006 249 "YERU" :cyrillic-capital-letter-yeru) + (006 250 "ZE" :cyrillic-capital-letter-ze) + (006 251 "SHA" :cyrillic-capital-letter-sha) + (006 252 "E" :cyrillic-capital-letter-e) + (006 253 "SHCHA" :cyrillic-capital-letter-shcha) + (006 254 "CHE" :cyrillic-capital-letter-che) + (006 255 "CYRILLIC capital hard sign" :cyrillic-capital-hard-sign) + (007 161 "ALPHA with accent" :greek-capital-letter-alpha-with-accent) + (007 162 "EPSILON with accent" :greek-capital-letter-epsilon-with-accent) + (007 163 "ETA with accent" :greek-capital-letter-eta-with-accent) + (007 164 "IOTA with accent" :greek-capital-letter-iota-with-accent) + (007 165 "IOTA with diaeresis" :greek-capital-letter-iota-with-diaeresis) + (007 166 "IOTA with accent+dieresis" :greek-capital-letter-iota-with-accent+dieresis) + (007 167 "OMICRON with accent" :greek-capital-letter-omicron-with-accent) + (007 168 "UPSILON with accent" :greek-capital-letter-upsilon-with-accent) + (007 169 "UPSILON with dieresis" :greek-capital-letter-upsilon-with-dieresis) + (007 170 "UPSILON with accent+dieresis" :greek-capital-letter-upsilon-with-accent+dieresis) + (007 171 "OMEGA with accent" :greek-capital-letter-omega-with-accent) + (007 177 "alpha with accent" :greek-small-letter-alpha-with-accent) + (007 178 "epsilon with accent" :greek-small-letter-epsilon-with-accent) + (007 179 "eta with accent" :greek-small-letter-eta-with-accent) + (007 180 "iota with accent" :greek-small-letter-iota-with-accent) + (007 181 "iota with dieresis" :greek-small-letter-iota-with-dieresis) + (007 182 "iota with accent+dieresis" :greek-small-letter-iota-with-accent+dieresis) + (007 183 "omicron with accent" :greek-small-letter-omicron-with-accent) + (007 184 "upsilon with accent" :greek-small-letter-upsilon-with-accent) + (007 185 "upsilon with dieresis" :greek-small-letter-upsilon-with-dieresis) + (007 186 "upsilon with accent+dieresis" :greek-small-letter-upsilon-with-accent+dieresis) + (007 187 "omega with accent" :greek-small-letter-omega-with-accent) + (007 193 "ALPHA" :greek-capital-letter-alpha) + (007 194 "BETA" :greek-capital-letter-beta) + (007 195 "GAMMA" :greek-capital-letter-gamma) + (007 196 "DELTA" :greek-capital-letter-delta) + (007 197 "EPSILON" :greek-capital-letter-epsilon) + (007 198 "ZETA" :greek-capital-letter-zeta) + (007 199 "ETA" :greek-capital-letter-eta) + (007 200 "THETA" :greek-capital-letter-theta) + (007 201 "IOTA" :greek-capital-letter-iota) + (007 202 "KAPPA" :greek-capital-letter-kappa) + (007 203 "LAMBDA" :greek-capital-letter-lambda) + (007 204 "MU" :greek-capital-letter-mu) + (007 205 "NU" :greek-capital-letter-nu) + (007 206 "XI" :greek-capital-letter-xi) + (007 207 "OMICRON" :greek-capital-letter-omicron) + (007 208 "PI" :greek-capital-letter-pi) + (007 209 "RHO" :greek-capital-letter-rho) + (007 210 "SIGMA" :greek-capital-letter-sigma) + (007 212 "TAU" :greek-capital-letter-tau) + (007 213 "UPSILON" :greek-capital-letter-upsilon) + (007 214 "PHI" :greek-capital-letter-phi) + (007 215 "CHI" :greek-capital-letter-chi) + (007 216 "PSI" :greek-capital-letter-psi) + (007 217 "OMEGA" :greek-capital-letter-omega) + (007 225 "alpha" :greek-small-letter-alpha) + (007 226 "beta" :greek-small-letter-beta) + (007 227 "gamma" :greek-small-letter-gamma) + (007 228 "delta" :greek-small-letter-delta) + (007 229 "epsilon" :greek-small-letter-epsilon) + (007 230 "zeta" :greek-small-letter-zeta) + (007 231 "eta" :greek-small-letter-eta) + (007 232 "theta" :greek-small-letter-theta) + (007 233 "iota" :greek-small-letter-iota) + (007 234 "kappa" :greek-small-letter-kappa) + (007 235 "lambda" :greek-small-letter-lambda) + (007 236 "mu" :greek-small-letter-mu) + (007 237 "nu" :greek-small-letter-nu) + (007 238 "xi" :greek-small-letter-xi) + (007 239 "omicron" :greek-small-letter-omicron) + (007 240 "pi" :greek-small-letter-pi) + (007 241 "rho" :greek-small-letter-rho) + (007 242 "sigma" :greek-small-letter-sigma) + (007 243 "final small sigma" :greek-small-letter-final-small-sigma) + (007 244 "tau" :greek-small-letter-tau) + (007 245 "upsilon" :greek-small-letter-upsilon) + (007 246 "phi" :greek-small-letter-phi) + (007 247 "chi" :greek-small-letter-chi) + (007 248 "psi" :greek-small-letter-psi) + (007 249 "omega" :greek-small-letter-omega) + (008 161 "left radical" :left-radical) + (008 162 "top left radical" :top-left-radical) + (008 163 "horizontal connector" :horizontal-connector) + (008 164 "top integral" :top-integral) + (008 165 "bottom integral" :bottom-integral) + (008 166 "vertical connector" :vertical-connector) + (008 167 "top left square bracket" :top-left-square-bracket) + (008 168 "bottom left square bracket" :bottom-left-square-bracket) + (008 169 "top right square bracket" :top-right-square-bracket) + (008 170 "bottom right square bracket" :bottom-right-square-bracket) + (008 171 "top left parenthesis" :top-left-parenthesis) + (008 172 "bottom left parenthesis" :bottom-left-parenthesis) + (008 173 "top right parenthesis" :top-right-parenthesis) + (008 174 "bottom right parenthesis" :bottom-right-parenthesis) + (008 175 "left middle curly brace" :left-middle-curly-brace) + (008 176 "right middle curly brace" :right-middle-curly-brace) + (008 177 "top left summation" :top-left-summation) + (008 178 "bottom left summation" :bottom-left-summation) + (008 179 "top vertical summation connector" :top-vertical-summation-connector) + (008 180 "bottom vertical summation connector" :bottom-vertical-summation-connector) + (008 181 "top right summation" :top-right-summation) + (008 182 "bottom right summation" :bottom-right-summation) + (008 183 "right middle summation" :right-middle-summation) + (008 188 "less than or equal sign" :less-than-or-equal-sign) + (008 189 "not equal sign" :not-equal-sign) + (008 190 "greater than or equal sign" :greater-than-or-equal-sign) + (008 191 "integral" :integral) + (008 192 "therefore" :therefore) + (008 193 "variation" :variation :proportional-to) + (008 194 "infinity" :infinity) + (008 197 "nabla" :nabla :del) + (008 200 "is approximate to" :is-approximate-to) + (008 201 "similar or equal to" :similar-or-equal-to) + (008 205 "if and only if" :if-and-only-if) + (008 206 "implies" :implies) + (008 207 "identical to" :identical-to) + (008 214 "radical" :radical) + (008 218 "is included in" :is-included-in) + (008 219 "includes" :includes) + (008 220 "intersection" :intersection) + (008 221 "union" :union) + (008 222 "logical and" :logical-and) + (008 223 "logical or" :logical-or) + (008 239 "partial derivative" :partial-derivative) + (008 246 "function" :function) + (008 251 "left arrow" :left-arrow) + (008 252 "upward arrow" :upward-arrow) + (008 253 "right arrow" :right-arrow) + (008 254 "downward arrow" :downward-arrow) + (009 223 "blank" :blank) + (009 224 "solid diamond" :solid-diamond) + (009 225 "checkerboard" :checkerboard) + (009 226 "ht" :ht) + (009 227 "ff" :ff) + (009 228 "cr" :cr) + (009 229 "lf" :lf) + (009 232 "nl" :nl) + (009 233 "vt" :vt) + (009 234 "lower right corner" :lower-right-corner) + (009 235 "upper right corner" :upper-right-corner) + (009 236 "upper left corner" :upper-left-corner) + (009 237 "lower left corner" :lower-left-corner) + (009 238 "crossing lines" :crossing-lines) + (009 239 "horizontal line scan 1" :horizontal-line-scan-1) + (009 240 "horizontal line scan 3" :horizontal-line-scan-3) + (009 241 "horizontal line scan 5" :horizontal-line-scan-5) + (009 242 "horizontal line scan 7" :horizontal-line-scan-7) + (009 243 "horizontal line scan 9" :horizontal-line-scan-9) + (009 244 "left t" :left-t) + (009 245 "right t" :right-t) + (009 246 "bottom t" :bottom-t) + (009 247 "top t" :top-t) + (009 248 "vertical bar" :vertical-bar) + (010 161 "em space" :em-space) + (010 162 "en space" :en-space) + (010 163 "3/em space" :3/em-space) + (010 164 "4/em space" :4/em-space) + (010 165 "digit space" :digit-space) + (010 166 "punctuation space" :punctuation-space) + (010 167 "thin space" :thin-space) + (010 168 "hair space" :hair-space) + (010 169 "em dash" :em-dash) + (010 170 "en dash" :en-dash) + (010 172 "significant blank symbol" :significant-blank-symbol) + (010 174 "ellipsis" :ellipsis) + (010 175 "double baseline dot" :double-baseline-dot) + (010 176 "vulgar fraction one third" :vulgar-fraction-one-third) + (010 177 "vulgar fraction two thirds" :vulgar-fraction-two-thirds) + (010 178 "vulgar fraction one fifth" :vulgar-fraction-one-fifth) + (010 179 "vulgar fraction two fifths" :vulgar-fraction-two-fifths) + (010 180 "vulgar fraction three fifths" :vulgar-fraction-three-fifths) + (010 181 "vulgar fraction four fifths" :vulgar-fraction-four-fifths) + (010 182 "vulgar fraction one sixth" :vulgar-fraction-one-sixth) + (010 183 "vulgar fraction five sixths" :vulgar-fraction-five-sixths) + (010 184 "care of" :care-of) + (010 187 "figure dash" :figure-dash) + (010 188 "left angle bracket" :left-angle-bracket) + (010 189 "decimal point" :decimal-point) + (010 190 "right angle bracket" :right-angle-bracket) + (010 191 "marker" :marker) + (010 195 "vulgar fraction one eighth" :vulgar-fraction-one-eighth) + (010 196 "vulgar fraction three eighths" :vulgar-fraction-three-eighths) + (010 197 "vulgar fraction five eighths" :vulgar-fraction-five-eighths) + (010 198 "vulgar fraction seven eighths" :vulgar-fraction-seven-eighths) + (010 201 "trademark sign" :trademark-sign) + (010 202 "signature mark" :signature-mark) + (010 203 "trademark sign in circle" :trademark-sign-in-circle) + (010 204 "left open triangle" :left-open-triangle) + (010 205 "right open triangle" :right-open-triangle) + (010 206 "em open circle" :em-open-circle) + (010 207 "em open rectangle" :em-open-rectangle) + (010 208 "left single quotation mark" :left-single-quotation-mark) + (010 209 "right single quotation mark" :right-single-quotation-mark) + (010 210 "left double quotation mark" :left-double-quotation-mark) + (010 211 "right double quotation mark" :right-double-quotation-mark) + (010 212 "prescription" :prescription :take :recipe) + (010 214 "minutes" :minutes) + (010 215 "seconds" :seconds) + (010 217 "latin cross" :latin-cross) + (010 218 "hexagram" :hexagram) + (010 219 "filled rectangle bullet" :filled-rectangle-bullet) + (010 220 "filled left triangle bullet" :filled-left-triangle-bullet) + (010 221 "filled right triangle bullet" :filled-right-triangle-bullet) + (010 222 "em filled circle" :em-filled-circle) + (010 223 "em filled rectangle" :em-filled-rectangle) + (010 224 "en open circle bullet" :en-open-circle-bullet) + (010 225 "en open square bullet" :en-open-square-bullet) + (010 226 "open rectangular bullet" :open-rectangular-bullet) + (010 227 "open triangular bullet up" :open-triangular-bullet-up) + (010 228 "open triangular bullet down" :open-triangular-bullet-down) + (010 229 "open star" :open-star) + (010 230 "en filled circle bullet" :en-filled-circle-bullet) + (010 231 "en filled square bullet" :en-filled-square-bullet) + (010 232 "filled triangular bullet up" :filled-triangular-bullet-up) + (010 233 "filled triangular bullet down" :filled-triangular-bullet-down) + (010 234 "left pointer" :left-pointer) + (010 235 "right pointer" :right-pointer) + (010 236 "club" :club) + (010 237 "diamond" :diamond) + (010 238 "heart" :heart) + (010 240 "maltese cross" :maltese-cross) + (010 241 "dagger" :dagger) + (010 242 "double dagger" :double-dagger) + (010 243 "check mark" :check-mark :tick) + (010 244 "ballot cross" :ballot-cross) + (010 245 "musical sharp" :musical-sharp) + (010 246 "musical flat" :musical-flat) + (010 247 "male symbol" :male-symbol) + (010 248 "female symbol" :female-symbol) + (010 249 "telephone symbol" :telephone-symbol) + (010 250 "telephone recorder symbol" :telephone-recorder-symbol) + (010 251 "phonograph copyright sign" :phonograph-copyright-sign) + (010 252 "caret" :caret) + (010 253 "single low quotation mark" :single-low-quotation-mark) + (010 254 "double low quotation mark" :double-low-quotation-mark) + (010 255 "cursor" :cursor) + (011 163 "left caret" :left-caret) + (011 166 "right caret" :right-caret) + (011 168 "down caret" :down-caret) + (011 169 "up caret" :up-caret) + (011 192 "overbar" :overbar) + (011 194 "down tack" :down-tack) + (011 195 "up shoe cap" :up-shoe-cap) + (011 196 "down stile" :down-stile) + (011 198 "underbar" :underbar) + (011 202 "jot" :jot) + (011 204 "quad" :quad) + (011 206 "up tack" :up-tack) + (011 207 "circle" :circle) + (011 211 "up stile" :up-stile) + (011 214 "down shoe cup" :down-shoe-cup) + (011 216 "right shoe" :right-shoe) + (011 218 "left shoe" :left-shoe) + (011 220 "left tack" :left-tack) + (011 252 "right tack" :right-tack) + (012 224 "aleph" :hebrew-letter-aleph) + (012 225 "beth" :hebrew-letter-beth) + (012 226 "gimmel" :hebrew-letter-gimmel) + (012 227 "daleth" :hebrew-letter-daleth) + (012 228 "he" :hebrew-letter-he) + (012 229 "waw" :hebrew-letter-waw) + (012 230 "zayin" :hebrew-letter-zayin) + (012 231 "het" :hebrew-letter-het) + (012 232 "teth" :hebrew-letter-teth) + (012 233 "yod" :hebrew-letter-yod) + (012 234 "final kaph" :hebrew-letter-final-kaph) + (012 235 "kaph" :hebrew-letter-kaph) + (012 236 "lamed" :hebrew-letter-lamed) + (012 237 "final mem" :hebrew-letter-final-mem) + (012 238 "mem" :hebrew-letter-mem) + (012 239 "final nun" :hebrew-letter-final-nun) + (012 240 "nun" :hebrew-letter-nun) + (012 241 "samekh" :hebrew-letter-samekh) + (012 242 "a yin" :hebrew-letter-a-yin) + (012 243 "final pe" :hebrew-letter-final-pe) + (012 244 "pe" :hebrew-letter-pe) + (012 245 "final zadi" :hebrew-letter-final-zadi) + (012 246 "zadi" :hebrew-letter-zadi) + (012 247 "hebrew kuf" :hebrew-kuf) + (012 248 "hebrew resh" :hebrew-resh) + (012 249 "hebrew shin" :hebrew-shin) + (012 250 "hebrew taf" :hebrew-taf) + (254 003 "iso level3 shift" :iso-level3-shift) + (254 081 "dead acute" :dead-acute) + (254 082 "dead circumflex" :dead-circumflex) + (255 008 "backspace" :backspace :back-space :back-char) + (255 009 "tab" :tab) + (255 010 "linefeed" :linefeed) + (255 011 "clear" :clear) + (255 013 "return" :return :enter) + (255 019 "pause" :pause :hold :scroll-lock) + (255 027 "escape" :escape) + (255 032 "multi key character preface" :multi-key-character-preface) + (255 033 "kanji" :kanji :kanji-convert) + (255 080 "home" :home) + (255 081 "left" :left :move-left) + (255 082 "up" :up :move-up :up-arrow) + (255 083 "right" :right :move-right) + (255 084 "down" :down :move-down :down-arrow) + (255 085 "prior" :prior :previous) + (255 086 "next" :next) + (255 087 "end" :end :eol) + (255 088 "begin" :begin :bol) + (255 096 "select" :select :mark) + (255 097 "print" :print) + (255 098 "execute" :execute :run :do) + (255 099 "insert" :insert :insert-here) + (255 101 "undo" :undo :oops) + (255 102 "redo" :redo :again) + (255 103 "menu" :menu) + (255 104 "find" :find :search) + (255 105 "cancel" :cancel :stop :abort :exit) + (255 106 "help" :help) + (255 107 "break" :break) + (255 126 "mode switch" :mode-switch :script-switch :character-set-switch) + (255 127 "num lock" :num-lock) + (255 128 " " :keypad-space) + (255 137 "tab" :keypad-tab) + (255 141 "enter" :keypad-enter) + (255 145 "f1" :keypad-f1 :pf1 :a) + (255 146 "f2" :keypad-f2 :pf2 :b) + (255 147 "f3" :keypad-f3 :pf3 :c) + (255 148 "f4" :keypad-f4 :pf4 :d) + (255 149 "Keypad Home" :keypad-home) + (255 150 "Keypad Left" :keypad-left) + (255 151 "Keypad Up" :keypad-up) + (255 152 "Keypad Right" :keypad-right) + (255 153 "Keypad Down" :keypad-down) + (255 154 "Keypad Prior" :keypad-prior) + (255 155 "Keypad Next" :keypad-next) + (255 156 "Keypad End" :keypad-end) + (255 157 "Keypad Begin" :keypad-begin) + (255 158 "Keypad Insert" :keypad-insert) + (255 159 "Keypad Delete" :keypad-delete) + (255 170 "*" :keypad-multiplication-sign) + (255 171 "+" :keypad-plus-sign) + (255 172 "keypad separator" :keypad-separator) + (255 173 "-" :keypad-minus-sign) + (255 174 "." :keypad-decimal-point) + (255 175 "/" :keypad-division-sign) + (255 176 "0" :keypad-digit-zero) + (255 177 "1" :keypad-digit-one) + (255 178 "2" :keypad-digit-two) + (255 179 "3" :keypad-digit-three) + (255 180 "4" :keypad-digit-four) + (255 181 "5" :keypad-digit-five) + (255 182 "6" :keypad-digit-six) + (255 183 "7" :keypad-digit-seven) + (255 184 "8" :keypad-digit-eight) + (255 185 "9" :keypad-digit-nine) + (255 189 "=" :keypad-equals-sign) + (255 190 "f1" :f1) + (255 191 "f2" :f2) + (255 192 "f3" :f3) + (255 193 "f4" :f4) + (255 194 "f5" :f5) + (255 195 "f6" :f6) + (255 196 "f7" :f7) + (255 197 "f8" :f8) + (255 198 "f9" :f9) + (255 199 "f10" :f10) + (255 200 "f11" :f11 :l1) + (255 201 "f12" :f12 :l2) + (255 202 "f13" :f13 :l3) + (255 203 "f14" :f14 :l4) + (255 204 "f15" :f15 :l5) + (255 205 "f16" :f16 :l6) + (255 206 "f17" :f17 :l7) + (255 207 "f18" :f18 :l8) + (255 208 "f19" :f19 :l9) + (255 209 "f20" :f20 :l10) + (255 210 "f21" :f21 :r1) + (255 211 "f22" :f22 :r2) + (255 212 "f23" :f23 :r3) + (255 213 "f24" :f24 :r4) + (255 214 "f25" :f25 :r5) + (255 215 "f26" :f26 :r6) + (255 216 "f27" :f27 :r7) + (255 217 "f28" :f28 :r8) + (255 218 "f29" :f29 :r9) + (255 219 "f30" :f30 :r10) + (255 220 "f31" :f31 :r11) + (255 221 "f32" :f32 :r12) + (255 222 "f33" :f33 :r13) + (255 223 "f34" :f34 :r14) + (255 224 "f35" :f35 :r15) + (255 225 "left shift" :left-shift) + (255 226 "right shift" :right-shift) + (255 227 "left control" :left-control) + (255 228 "right control" :right-control) + (255 229 "caps lock" :caps-lock) + (255 230 "shift lock" :shift-lock) + (255 231 "left meta" :left-meta) + (255 232 "right meta" :right-meta) + (255 233 "left alt" :left-alt) + (255 234 "right alt" :right-alt) + (255 235 "left super" :left-super) + (255 236 "right super" :right-super) + (255 237 "left hyper" :left-hyper) + (255 238 "right hyper" :right-hyper) + (255 255 "delete" :delete :rubout))) + +(defparameter *keysym-name-table* (make-keysym-name-table *keysym-name-list*)) +(defparameter *keysym-legend-table* (make-keysym-legend-table *keysym-name-list*)) +(defparameter *name-keysym-table* (make-name-keysym-table *keysym-name-list*)) + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: Lisp; Package: X-SCREEN; Syntax: Common-Lisp; Lowercase: Yes -*-") + +(defun maybe-define-signature (&optional display) + (unless display (setq display (x-screen::x-console-display sys:*console*))) + (let ( +; (display (unless display +; (x-screen::x-console-display sys:*console*))) + vendor-name + codes + (german nil)) + (setq vendor-name (xlib:display-vendor-name display)) + (setq codes (x-screen::display-keyboard-signature-keys display)) + (loop for l in codes + do + (when (member ':LATIN-SMALL-LETTER-U-WITH-DIAERESIS l) (setq german t))) + (append + (list 'x-screen:define-keyboard-signature + (if german ':Xorg-pc-german ':Xorg-pc) + (list ':vendor-name vendor-name ':keycode-offset 0)) + codes))) +;; (list ':german german)))) + +;;; +;;; eval this into buffer to get your keyboard def +;;; +;;; (maybe-define-signature) +;;; +(eval (maybe-define-signature)) +;;; +(defun display-keyboard-layout-type (display) + (declare (values layout-type keycode-offset)) + (eval (maybe-define-signature display)) + (multiple-value-bind (vendor-name vendor-version) + (xlib:display-vendor display) + (let ((keys (display-keyboard-signature-keys display))) + (loop with highest-score = -1 + with highest-scoring-keyboard-signature = nil + for keyboard-signature in *keyboard-signatures* + for score = + (compare-keyboard-signature-keys + (keyboard-signature-vendor-name keyboard-signature) + (keyboard-signature-vendor-version keyboard-signature) + (keyboard-signature-keys keyboard-signature) + vendor-name vendor-version keys) + when (> score highest-score) + do (setq highest-score score) + (setq highest-scoring-keyboard-signature keyboard-signature) + finally + (when (> highest-score .75s0) + (return + (values + (keyboard-signature-name highest-scoring-keyboard-signature) + (keyboard-signature-keycode-offset highest-scoring-keyboard-signature)))) + )))) + + + +;#+vlm +(x-screen:define-keyboard-mapping :Xorg-pc-german + (:leds ((3 :caps-lock) + (4 :scroll-lock) + (5 :num-lock))) + +;;; +;;; standard vlm codes +;;; + (:f1 #\Select #\Square) + (:f2 #\Network #\Circle) + (:f3 #\Function #\Triangle) + (:f4 #\Suspend (:mode-lock :locking t)) + (:f5 #\Resume) + (:f6 #\Abort) + (:f7 :left-super) + (:f8 :left-hyper) + (:f9 #\Scroll #\Page) + (:f10 #\Clear-Input #\Refresh) + (:f11 #\Complete #\End) + (:f12 #\Help) +;;; +;;; do something reasonable with the keypad +;;; ??? num-lock ??? +;;; for now, keypad numbers are on shift +;;; + (:keypad-home #\Keyboard:Home #\7) + (:keypad-up #\Keyboard:Up #\8) + (:keypad-prior #\Keyboard:Back-Scroll #\9) + (:keypad-minus-sign #\Keyboard:Copy #\-) + (:keypad-left #\Keyboard:Left #\4) + (:keypad-begin #\Space #\5 #\Space #\5) + (:keypad-right #\Keyboard:Right #\6) + (:keypad-plus-sign #\+ #\+) + (:keypad-end #\End #\1) + (:keypad-down #\Keyboard:Down #\2) + (:keypad-next #\Scroll #\3 #\Page) + (:keypad-insert #\0 #\0) + (:keypad-delete #\Rubout #\,) + (:keypad-division-sign #\Keyboard:Paste #\/) + (:keypad-multiplication-sign #\Keyboard:Cut #\*) + (:keypad-decimal-point #\Rubout #\.) + (:keypad-enter #\Linefeed #\Return) +;;; +;;; special keys directly mappable +;;; :prior should map to m-scroll (how ??) +;;; + (:home #\Keyboard:Home) + (:up #\Keyboard:Up) + (:left #\Keyboard:Left) + (:right #\Keyboard:Right) + (:down #\Keyboard:Down) + (:print #\Keyboard:Print) + (:undo #\Keyboard:Undo) + (:redo #\Keyboard:Redo) + (:find #\Keyboard:Find) + (:next #\Scroll #\Page) + (:prior #\Keyboard:Back-Scroll #\Scroll) + (:break #\Suspend) +;;; +;;; right menu key to right-hyper +;;; + (:menu :right-hyper) +;;; +;;; num-lock is a mystery still +;; + (:num-lock (:num-lock :locking t)) + (:caps-lock (:caps-lock :locking t)) +;;; +;;; map Umlaute to their us keyboard equivalents +;;; won't display anyway because of no font glyphs +;;; + (:latin-small-letter-u-with-diaeresis #\\ #\|) + (:latin-small-letter-o-with-diaeresis #\[ #\{) + (:latin-small-letter-a-with-diaeresis #\] #\}) +;;; +;;; AltGr maps to right-symbol (to get "\{[]}@|~" going) +;;; + (:iso-level3-shift :right-symbol) +;;; +;;; remap AltGr based keys to :right-symbol combinations +;;; conflicting symbols moved to shift-symbol +;;; + (:german-small-letter-sharp-s #\space #\? #\\) + (:digit-seven #\7 #\/ #\{) + (:digit-eight #\8 #\( #\[) + (:digit-nine #\9 #\) #\]) + (:digit-zero #\0 #\= #\} #\) + (:latin-small-letter-q #\q #\Q #\@ #\) + (:plus-sign #\+ #\* #\~) + (:less-than-sign #\< #\> #\|) + ;; + ;; dead circumflex / degree + ;; dead acute / grave + ;; + (:dead-circumflex #\^ #\) + (:dead-acute #\` #\') + ) + +(x-screen:define-keyboard-mapping :Xorg-pc + (:leds ((3 :caps-lock) + (4 :scroll-lock) + (5 :num-lock))) + +;;; +;;; standard vlm codes +;;; + (:f1 #\Select #\Square) + (:f2 #\Network #\Circle) + (:f3 #\Function #\Triangle) + (:f4 #\Suspend (:mode-lock :locking t)) + (:f5 #\Resume) + (:f6 #\Abort) + (:f7 :left-super) + (:f8 :left-hyper) + (:f9 #\Scroll #\Page) + (:f10 #\Clear-Input #\Refresh) + (:f11 #\Complete #\End) + (:f12 #\Help) +;;; +;;; do something reasonable with the keypad +;;; ??? num-lock ??? +;;; for now, keypad numbers are on shift +;;; + (:keypad-home #\Keyboard:Home #\7) + (:keypad-up #\Keyboard:Up #\8) + (:keypad-prior #\Keyboard:Back-Scroll #\9) + (:keypad-minus-sign #\Keyboard:Copy #\-) + (:keypad-left #\Keyboard:Left #\4) + (:keypad-begin #\Space #\5 #\Space #\5) + (:keypad-right #\Keyboard:Right #\6) + (:keypad-plus-sign #\+ #\+) + (:keypad-end #\End #\1) + (:keypad-down #\Keyboard:Down #\2) + (:keypad-next #\Scroll #\3 #\Page) + (:keypad-insert #\0 #\0) + (:keypad-delete #\Rubout #\,) + (:keypad-division-sign #\Keyboard:Paste #\/) + (:keypad-multiplication-sign #\Keyboard:Cut #\*) + (:keypad-decimal-point #\Rubout #\.) + (:keypad-enter #\Linefeed #\Return) +;;; +;;; special keys directly mappable +;;; :prior should map to m-scroll (how ??) +;;; + (:home #\Keyboard:Home) + (:up #\Keyboard:Up) + (:left #\Keyboard:Left) + (:right #\Keyboard:Right) + (:down #\Keyboard:Down) + (:print #\Keyboard:Print) + (:undo #\Keyboard:Undo) + (:redo #\Keyboard:Redo) + (:find #\Keyboard:Find) + (:next #\Scroll #\Page) + (:prior #\Keyboard:Back-Scroll #\Scroll) + (:break #\Suspend) +;;; +;;; right menu key to right-hyper +;;; + (:menu :right-hyper) +;;; +;;; num-lock is a mystery still +;; + (:num-lock (:num-lock :locking t)) + (:caps-lock (:caps-lock :locking t)) +;;; +;;; map Umlaute to their us keyboard equivalents +;;; won't display anyway because of no font glyphs +;;; +;; (:latin-small-letter-u-with-diaeresis #\\ #\|) +;; (:latin-small-letter-o-with-diaeresis #\[ #\{) +;; (:latin-small-letter-a-with-diaeresis #\] #\}) +;;; +;;; AltGr maps to right-symbol (to get "\{[]}@|~" going) +;;; +;; (:iso-level3-shift :right-symbol) +;;; +;;; remap AltGr based keys to :right-symbol combinations +;;; conflicting symbols moved to shift-symbol +;;; +; (:german-small-letter-sharp-s #\space #\? #\\) +; (:digit-seven #\7 #\/ #\{) +; (:digit-eight #\8 #\( #\[) +; (:digit-nine #\9 #\) #\]) +; (:digit-zero #\0 #\= #\} #\) +; (:latin-small-letter-q #\q #\Q #\@ #\) +; (:plus-sign #\+ #\* #\~) +; (:less-than-sign #\< #\> #\|) + ;; + ;; dead circumflex / degree + ;; dead acute / grave + ;; + (:dead-circumflex #\^ #\) + (:dead-acute #\` #\') + ) diff --git a/OG2-patches/emb-bufs.lisp b/OG2-patches/emb-bufs.lisp new file mode 100644 index 0000000..da5e679 --- /dev/null +++ b/OG2-patches/emb-bufs.lisp @@ -0,0 +1,52 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp Machine, 3/14/14 18:08:13 +;;; while running on CHAOS from CHAOS-HOST:who-calls-chaos.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Ivory Revision 5, VLM Debugger 329, Genera program 9.0, DEC OSF/1 V127, +;;; 1280x956 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11403901), +;;; Machine serial number 771101265, Linux, +;;; not Alpha (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/patches.sct/alpha.), +;;; doc ex drawings (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/patches.sct/docs-ellipse.), +;;; OpenSuse FSS (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/patches.sct/opensuse-fss-patch.), +;;; Allow multiple ll addresses (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/allow-multiple-ll-addresses.), +;;; primary network: parse :internet before :chaos (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/primary-network-address.), +;;; Rational quotient (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/rational-quotient.), +;;; disable lossage in get-emb-host (from CHAOS-HOST:/home/lispm/lsource/get-emb-host.lisp). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:EMBEDDING;EMB-BUFFER.LISP.55") + + +(SCT:NOTE-PRIVATE-PATCH "more emb eth packets and disk buffers") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:EMBEDDING;EMB-BUFFER.LISP.55") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: COMMON-LISP-INTERNALS; Lowercase: Yes -*-") + +#+IMACH + +;;; +;;; list of bufsize and how many to alloc at once +;;; I don't know how to make a defconstant list get wired, so use a function +;;; must do smallest first +;;; +(defwiredfun map-over-emb-buf-sizes-and-counts (function) + (declare (sys:downward-funarg function)) + (funcall function 8 4) ; random small buffer + (funcall function 32 8) ; other random buffer + (funcall function 40 1) ; embedded DQE + (funcall function 128 1) ; mac page + #-VLM (funcall function 320 2) ; IMach page + (funcall function 380 16) ; ethernet packet + #+VLM (funcall function 2048 2)) ; VLM disk block + +;;; +;;; faking an array of buf pools +;;; + diff --git a/OG2-patches/full-gc-patch.lisp b/OG2-patches/full-gc-patch.lisp new file mode 100644 index 0000000..ad560af --- /dev/null +++ b/OG2-patches/full-gc-patch.lisp @@ -0,0 +1,305 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp-Machine, 4/11/14 14:23:47 +;;; while running on DIS-SYS-HOST from DIS-EMB-HOST:mini-newlmfs.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Ivory Revision 5, VLM Debugger 329, Genera program 9.0, DEC OSF/1 V127, +;;; 1280x956 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11403901), +;;; Machine serial number 1622679303, +;;; Allow multiple ll addresses (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/allow-multiple-ll-addresses.), +;;; Linux, not Alpha (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/alpha.), +;;; doc ex drawings (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/docs-ellipse.), +;;; more emb eth packets and disk buffers (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/emb-bufs.), +;;; german keyboard (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/german-keyboard-patch.), +;;; disable lossage in get-emb-host (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/get-emb-host.), +;;; OpenSuse FSS (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/opensuse-fss-patch.), +;;; primary network: parse :internet before :chaos (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/primary-network-address.), +;;; Rational quotient (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/rational-quotient.), +;;; disable GC during user disk io (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/user-disk-without-gc.). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:GC;FULL-GC.LISP.99") + + +(SCT:NOTE-PRIVATE-PATCH "Full gc patches") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:GC;FULL-GC.LISP.99") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: Lisp; Base: 8; Package: System-Internals -*-") + + +;(DEFINE-GC-OPTIMIZATION GC-SYMBOLS :LAYERED-SYSTEM-RELEASE +;D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") ;; +0;1 ;; jj : disabled, weakspace crashes +0;1 ;; +0;) + +(defun region-check (&key + (areas `(FLAVOR::*FLAVOR-AREA*)) + all-areas fix-regions verbose show-errors) + (let (bits + (regs 0) + (errs 0) + (fixes 0) + (non-space (list + si:%REGION-SPACE-FREE ;free region slot (must be zero) + si:%REGION-SPACE-OLD ;oldspace region of dynamic area + ;; %REGION-SPACE-NEW ;newspace region of dynamic area + ;; %REGION-SPACE-COPY ;stuff copied from oldspace goes + si:%REGION-SPACE-WEAK ;contains weak pointers, scavenged specially + si:%REGION-SPACE-5 ;unused + si:%REGION-SPACE-6 ;unused + si:%REGION-SPACE-7)) + (non-level (list + si:%LEVEL-TYPE-UNALLOCATED + si:%LEVEL-TYPE-WIRED + si:%LEVEL-TYPE-SAFEGUARDED))) + (when all-areas (setq areas sys:area-list)) + (when verbose (format t "~&Checking regions...")) + (loop for area in areas + as area-name = (si:area-name (eval area)) + do + (si:do-area-regions (region (eval area)) + (setq bits (si:region-bits region)) + (unless (or + (ldb-test si:%%REGION-TEMPORARY bits) + (ldb-test si:%%REGION-STACK bits) + (member (si:level-type (ldb si:%%REGION-LEVEL bits)) non-level) + (member (ldb si:%%REGION-SPACE-TYPE bits) non-space) + (= (ldb si:%%REGION-REPRESENTATION-TYPE bits) + si:%REGION-REPRESENTATION-TYPE-LIST)) + (multiple-value-bind (ignore err) + (catch-error (si:%find-structure-header (si:region-origin region)) + show-errors) + (incf regs) + (when err + (incf errs) + (when verbose + (format t "~&~a:region #~o should be list, is structure." area-name region)) + (if fix-regions + (progn + (incf fixes) + (when verbose + (format t "Fixing ~a:region #~O from structure to list." + area-name region)) + (setf (aref sys:*region-bits* region) + (dpb + si:%REGION-REPRESENTATION-TYPE-LIST + si:%%REGION-REPRESENTATION-TYPE + bits)) + (when verbose (si:describe-region region))) + (when verbose (format t " Not fixing.")))))))) + (format t "~&~[~0;No~1;One~:;~0@*~d~] region~:P checked, " regs) + (format t "~[~0;no~1;one~:;~0@*~d~] error~:P found, " errs) + (format t "~[~0;no fixes~1;one fix~:;~0@*~d fixes~] applied.~&" fixes))) + +(defun make-static-regions-dynamic (&key + (areas `(FLAVOR::*FLAVOR-AREA* + FS:PATHNAME-AREA + SYS:COMPILED-FUNCTION-AREA + SYS:SYMBOL-AREA + SI:DEBUG-INFO-AREA + SAGE:*SAGE-COMPLETION-AREA*)) + all-areas verbose) + (let ((areas-not-to-touch '(CLOS-INTERNALS::*CLOS-STATIC-AREA* + CLOS-INTERNALS::*CLOS-WEAK-LINK-AREA* + DW::*PRESENTATION-AREA* + DW::*PRESENTATION-TYPE-AREA*)) + bits + (regs 0) + (non-space (list + si:%REGION-SPACE-FREE ;free region slot (must be zero) + si:%REGION-SPACE-OLD ;oldspace region of dynamic area + ;; %REGION-SPACE-NEW ;newspace region of dynamic area + ;; %REGION-SPACE-COPY ;stuff copied from oldspace goes + si:%REGION-SPACE-WEAK ;contains weak pointers, scavenged specially + si:%REGION-SPACE-5 ;unused + si:%REGION-SPACE-6 ;unused + si:%REGION-SPACE-7)) + (non-level (list + si:%LEVEL-TYPE-UNALLOCATED + si:%LEVEL-TYPE-WIRED + si:%LEVEL-TYPE-SAFEGUARDED))) + (when all-areas (setq areas (lisp:set-difference sys:area-list areas-not-to-touch))) +;; (format t "~& ~s ~%" areas) + (when verbose (format t "~&Making static regions dynamic...")) + (loop for area in areas + do + (si:do-area-regions (region (eval area)) + (setq bits (si:region-bits region)) + (unless (or + (ldb-test si:%%REGION-TEMPORARY bits) + (ldb-test si:%%REGION-STACK bits) + (member (si:level-type (ldb si:%%REGION-LEVEL bits)) non-level) + (member (ldb si:%%REGION-SPACE-TYPE bits) non-space) + (not (ldb-test %%REGION-SCAVENGE-ENABLE bits)) + (ldb-test %%REGION-READ-ONLY bits) + ) + (when (= (si:level-type (ldb si:%%REGION-LEVEL bits)) si:%LEVEL-TYPE-STATIC) + (setf (aref sys:*region-bits* region) + (dpb si:%DYNAMIC-LEVEL si:%%REGION-LEVEL bits)) + (incf regs))))) + (format t "~&~[~0;No~1;One~:;~0@*~d~] region~:P made dynamic" regs) +; (si:region-check :all-areas all-areas :verbose verbose :fix-regions nil) + )) + +;; The workhorse +(DEFUN IMMEDIATE-GC (&REST OPTIONS + &KEY (MODE :NORMAL) + (GC-COMPILED-FUNCTIONS NIL GC-COMPILED-FUNCTIONS-P) + (GC-STATIC-AREAS NIL GC-STATIC-AREAS-P) + (OPTIMIZE NIL OPTIMIZE-P) + (INCREMENTAL-OPTIMIZE NIL INCREMENTAL-OPTIMIZE-P) + (INSUFFICIENT-ADDRESS-SPACE-ACTION :QUERY) + (AREA-MASK NIL AREA-MASK-P) + (REGION-MASK NIL REGION-MASK-P) + (LEVEL-MASK NIL LEVEL-MASK-P) + (VERBOSE NIL VERBOSE-P) + &ALLOW-OTHER-KEYS) + (DECLARE (IGNORE GC-COMPILED-FUNCTIONS-P GC-COMPILED-FUNCTIONS + GC-STATIC-AREAS-P GC-STATIC-AREAS)) + ;; Set up defaults + (CHECK-ARG MODE (MEMQ MODE *IMMEDIATE-GC-MODES*) "a valid mode for IMMEDIATE-GC") + (WHEN (EQ MODE 'SYMBOLICS-SYSTEM-RELEASE) + (FORMAT ERROR-OUTPUT + "~&Use of the ~S mode in ~S is reserved to Symbolics.~@ + Use by customers is not recommended or supported." + 'SYMBOLICS-SYSTEM-RELEASE 'IMMEDIATE-GC)) +; (UNLESS GC-COMPILED-FUNCTIONS-P +; (SETQ GC-COMPILED-FUNCTIONS (MEMQ MODE '(:LAYERED-IDS-RELEASE +; :LAYERED-SYSTEM-RELEASE +; SYMBOLICS-SYSTEM-RELEASE)))) +; (UNLESS GC-STATIC-AREAS-P +; (SETQ GC-STATIC-AREAS (MEMQ MODE '(:LAYERED-SYSTEM-RELEASE SYMBOLICS-SYSTEM-RELEASE)))) + (UNLESS OPTIMIZE-P + (SETQ OPTIMIZE (IMMEDIATE-GC-DEFAULT-OPTIMIZATIONS MODE))) + (WHEN OPTIMIZE + (UNLESS INCREMENTAL-OPTIMIZE-P + (SETQ INCREMENTAL-OPTIMIZE + (NOT (MEMQ MODE '(:LAYERED-SYSTEM-RELEASE SYMBOLICS-SYSTEM-RELEASE))))) + (SETQ OPTIMIZE (ORDER-GC-OPTIMIZATIONS OPTIMIZE))) + (UNLESS VERBOSE-P + (SETQ VERBOSE (MEMQ MODE '(:LAYERED-IDS-RELEASE + :LAYERED-SYSTEM-RELEASE + SYMBOLICS-SYSTEM-RELEASE)))) + ;; Some GC optimizations assume we're logged in. + (FS:WITH-AUTOMATIC-LOGIN-TO-SYS-HOST + ;; Do it. + (LET* (;; This is for communications with individual optimizations. + (*IMMEDIATE-GC-OPTIONS* OPTIONS) + ;; This is mainly for compatibility. + (*FULL-GC-FOR-SYSTEM-RELEASE* (EQ MODE 'SYMBOLICS-SYSTEM-RELEASE)) + ;; This is for communication between the optimizations and the flipper. + (*IMMEDIATE-GC-FLIP-OPTIONS* NIL) + ;; This is so that an optimization can alter its behavior depending on whether + ;; another optimization is running. + (*IMMEDIATE-GC-OPTIMIZATIONS* OPTIMIZE) + ;; This is the list of reorderings built by optimizations + (*REORDERINGS* NIL) + ;; This is another way to pass INCREMENTAL-OPTIMIZE to individual optimizations. + ;; I don't feel like fixing the modularity here at the moment. + (*INCREMENTAL-IMMEDIATE-GC* INCREMENTAL-OPTIMIZE) + ;; Whether to clam up. + (*ENABLE-GC-OPTIMIZATION-REPORTS* VERBOSE) + ;; Optimizations control flipping and migration through these. + (*IMMEDIATE-GC-LEVEL-MASK* NIL) + (*IMMEDIATE-GC-AREA-MASK* NIL) + (*IMMEDIATE-GC-REGION-MASK* NIL) + (*IMMEDIATE-GC-LEVEL-MIGRATION-ARRAY* NIL) + (*IMMEDIATE-GC-AREA-MIGRATION-ARRAY* NIL) + (*IMMEDIATE-GC-REGION-MIGRATION-ARRAY* NIL)) + 1(make-static-regions-dynamic :all-areas 0t1 :verbose verbose) +0 1(region-check :all-areas 0t1 :fix-regions t :show-errors nil :verbose verbose) +0 (WITH-DATA-STACK + ;; The default is to flip all dynamic and ephemeral levels. + ;; Individual optimizations can add levels or exclude regions and areas as appropriate. + ;; Migration is specified by setting the appropriate migration array element to + ;; the appropriate level. + (IF LEVEL-MASK-P + (SETQ *IMMEDIATE-GC-LEVEL-MASK* LEVEL-MASK) + (SETQ *IMMEDIATE-GC-LEVEL-MASK* (MAKE-STACK-ARRAY %NUMBER-OF-LEVELS :TYPE ART-BOOLEAN)) + (LOOP FOR LEVEL BELOW %NUMBER-OF-LEVELS DO + (SETF (AREF *IMMEDIATE-GC-LEVEL-MASK* LEVEL) + ( (LEVEL-TYPE LEVEL) %LEVEL-TYPE-DYNAMIC)))) + (SETQ *IMMEDIATE-GC-AREA-MASK* + (IF AREA-MASK-P AREA-MASK + (MAKE-STACK-ARRAY NUMBER-OF-AREAS :TYPE ART-BOOLEAN :INITIAL-ELEMENT T))) + (SETQ *IMMEDIATE-GC-REGION-MASK* + (IF REGION-MASK-P REGION-MASK + (MAKE-STACK-ARRAY NUMBER-OF-REGIONS :TYPE ART-BOOLEAN :INITIAL-ELEMENT T))) + (SETQ *IMMEDIATE-GC-LEVEL-MIGRATION-ARRAY* (MAKE-STACK-ARRAY %NUMBER-OF-LEVELS)) + ;; By default all ephemeral levels should migrate to dynamic space + (LOOP FOR LEVEL BELOW %NUMBER-OF-EPHEMERAL-LEVELS DO + (SETF (AREF *IMMEDIATE-GC-LEVEL-MIGRATION-ARRAY* LEVEL) %DYNAMIC-LEVEL)) + (SETQ *IMMEDIATE-GC-AREA-MIGRATION-ARRAY* (MAKE-STACK-ARRAY NUMBER-OF-AREAS)) + (SETQ *IMMEDIATE-GC-REGION-MIGRATION-ARRAY* (MAKE-STACK-ARRAY NUMBER-OF-REGIONS)) + (WITHOUT-ABORTS (IMMEDIATE-GC "An immediate garbage collection is in progress.~@ + Aborting at this time could cause the selected GC~@ + optimizations to leave the world in an inconsistent~@ + state. This can result in serious damage to the running~@ + world, including irrecoverable crashes.") + ;;--- This should really use an extra ephemeral level. Fix MAKE-AREA. + (WITH-EPHEMERAL-MIGRATION-MODE :COLLECT + (MULTIPLE-VALUE-BIND (BIND-VARS BIND-VALS) + (IMMEDIATE-GC-VARIABLE-BINDINGS MODE OPTIMIZE INCREMENTAL-OPTIMIZE) + (PROGV BIND-VARS BIND-VALS + (LET-GLOBALLY ((GC-IMMEDIATELY-IN-PROGRESS T)) + (RESET-TEMPORARY-AREA REORDERING-LIST-AREA) + (LOOP FOR OPTIMIZATION IN OPTIMIZE DO + (RUN-GC-OPTIMIZATION OPTIMIZATION :BEFORE-FLIP INCREMENTAL-OPTIMIZE)) + ;; Possibly temporary metering for system-release. + (WHEN (EQ MODE 'SYMBOLICS-SYSTEM-RELEASE) + (GC-OPTIMIZATION-REPORT "~%~\DATIME\ Resetting GC meters ...") + (DOLIST (GC-METER *GC-METERS*) + (SET GC-METER 0))) + ;;--- Then flip, appropriately hacking areas + (GC-OPTIMIZATION-REPORT "~%~\DATIME\ Flipping ...") + (CL:APPLY #'DYNAMIC-GC-FLIP + :INSUFFICIENT-ADDRESS-SPACE-ACTION INSUFFICIENT-ADDRESS-SPACE-ACTION + :RECLAIM :IMMEDIATE + :REORDERINGS *REORDERINGS* + :INCREMENTAL-REORDERINGS INCREMENTAL-OPTIMIZE + :LEVEL-MASK *IMMEDIATE-GC-LEVEL-MASK* + :AREA-MASK *IMMEDIATE-GC-AREA-MASK* + :REGION-MASK *IMMEDIATE-GC-REGION-MASK* + :LEVEL-MIGRATION-ARRAY *IMMEDIATE-GC-LEVEL-MIGRATION-ARRAY* + :AREA-MIGRATION-ARRAY *IMMEDIATE-GC-AREA-MIGRATION-ARRAY* + :REGION-MIGRATION-ARRAY *IMMEDIATE-GC-REGION-MIGRATION-ARRAY* + *IMMEDIATE-GC-FLIP-OPTIONS*) + (LOOP FOR OPTIMIZATION IN OPTIMIZE DO + (RUN-GC-OPTIMIZATION OPTIMIZATION :AFTER-FLIP INCREMENTAL-OPTIMIZE)) + (FLET ((FINISH () + (GC-OPTIMIZATION-REPORT "~%~\DATIME\ Scavenging ...") + (%GC-SCAVENGE) + (GC-OPTIMIZATION-REPORT "~%~\DATIME\ Reclaiming Oldspace ...") + (GC-RECLAIM-OLDSPACE) + (WHEN (EQ MODE 'SYMBOLICS-SYSTEM-RELEASE) (PRINT-GC-METERS)) + (LOOP FOR OPTIMIZATION IN OPTIMIZE DO + (RUN-GC-OPTIMIZATION OPTIMIZATION :AFTER-RECLAIM-OLDSPACE + INCREMENTAL-OPTIMIZE)) + (GC-OPTIMIZATION-REPORT "~%~\DATIME\ Resetting temporary areas ...") + (RESET-TEMPORARY-AREA REORDERING-LIST-AREA T) + (RESET-TEMPORARY-AREA SYSTEM-WEAKSPACE-AREA T) + 1(region-check :fix-regions nil + :all-areas t + :verbose nil + :show-errors nil) +0 T)) + (IF (LOOP FOR OPTIMIZATION IN OPTIMIZE + NEVER (RUN-GC-OPTIMIZATION-P + OPTIMIZATION :AFTER-RECLAIM-OLDSPACE)) + ;; Allow aborting out if it won't hurt. + (WITH-ABORTS-ENABLED (IMMEDIATE-GC) + (FINISH)) + (FINISH)))))))))))) + + +(DEFUN REORDER-MEMORY (&KEY (INCREMENTAL T) (RUN-WITHOUT-INTERRUPTS 1nil0)) + (LET-IF RUN-WITHOUT-INTERRUPTS ((INHIBIT-SCHEDULING-FLAG T)) + (IMMEDIATE-GC :MODE (IF INCREMENTAL :LAYERED-IDS-RELEASE :LAYERED-SYSTEM-RELEASE) + :OPTIMIZE *REORDER-MEMORY-OPTIMIZATIONS* + :INCREMENTAL-OPTIMIZE INCREMENTAL))) diff --git a/OG2-patches/get-emb-host.lisp b/OG2-patches/get-emb-host.lisp new file mode 100644 index 0000000..3dc2a6a --- /dev/null +++ b/OG2-patches/get-emb-host.lisp @@ -0,0 +1,121 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp Machine, 3/13/14 15:42:45 +;;; while running on CHAOS from CHAOS-HOST:who-calls-chaos.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Ivory Revision 5, VLM Debugger 329, Genera program 9.0, DEC OSF/1 V127, +;;; 1280x956 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11403901), +;;; Machine serial number 771101265, Linux, +;;; not Alpha (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/patches.sct/alpha.), +;;; doc ex drawings (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/patches.sct/docs-ellipse.), +;;; OpenSuse FSS (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/patches.sct/opensuse-fss-patch.), +;;; Allow multiple ll addresses (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/allow-multiple-ll-addresses.), +;;; primary network: parse :internet before :chaos (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/primary-network-address.), +;;; Rational quotient (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/rational-quotient.). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:NETWORK;NAMESPACES.LISP.859") + + +(SCT:NOTE-PRIVATE-PATCH "disable lossage in get-emb-host") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:NETWORK;NAMESPACES.LISP.859") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: NETI; Base: 10; Lowercase: Yes -*-") + +(PROGN + +#+IMach +(defun get-emb-host (&optional name) + (flet ((get-host (address-pair) + (when (car address-pair) + (let* ((network (car address-pair)) + (address (send network :unparse-address (cadr address-pair))) + (candidates (find-objects-from-property-list + :host + :address `((,network ,address)))) + (host (first candidates))) + (cons host address-pair)))) + (unparse-address (address-pair) + (setf (cadr address-pair) + (send (car address-pair) :unparse-address (cadr address-pair))))) + (sys:system-case + (Embedded + (let* ((address-pairs (get-emb-host-addresses)) + (candidates (mapcar #'get-host address-pairs)) + (best-host (loop for (host) in candidates + when host + return host))) + ;; If the addressing situation is confused (the host has specified addresses + ;; that we believe belong to more than one host, based on the namespace), + ;; then give the poor user as much help as possible in straightening things out. + (when (and (cdr candidates) + (cl:some (lambda (list) (neq (car list) (caar candidates))) + (cdr candidates))) + (tv:notify + nil + (with-output-to-string (string) + (let ((all-hosts + (mapcar (lambda (a) + (list (first a) + (second a) + (send (second a) :unparse-address (third a)))) + candidates))) + (format + string + "The host (Unix) system claims addresses~{~#[~1; and~] ~{~*~A|~A~},~} ~%~ +which belong to hosts~{~#[~1; and~] ~{~:[~;~:*~A~]~2*~},~} respectively.~%" + all-hosts all-hosts) + (loop for (host) in all-hosts + for addresses = (if host (send host :address) + `((:unknown :unknown))) + do + (format string "~& ~A's ~:[address~;addresses~]~:* in the namespace ~:[is~;are~] " host (cdr addresses)) + (format-textual-list + addresses + (lambda (pair stream) + (format stream "~A|~A" (first pair) (second pair))) + :stream string + :conjunction "and")) + (format string "~&Either the namespace or the host system is confused.~%~ +Guessing that the host is named ~A; you should :Reset Network after fixing the namespace~%~ +or restart host life support and warm-boot after fixing the host." + best-host))))) + ;; If there was no host, but there were some addresses, create a host object + (when (and (null best-host) address-pairs) + (mapc #'unparse-address address-pairs) + (let* ((required-services (system-case + (Solstice *solstice-required-emb-services*) + (VLM *VLM-required-emb-services*) + (otherwise nil))) + (services + (loop with services = (commonly-supported-services :unix42 :internet) + for service in required-services + unless (cl:member service services :test 'cl:equalp) + do (push service services) + finally (return services))) + (plist `(:address ,address-pairs + :machine-type ,(emb-machine-type) + :service ,services + :site ,*local-site* + :system-type :unix42)) + (network (caar address-pairs))) + (setf best-host + (if (not (null name)) + ;; Create an interned host object + (update-object-permanently :host *namespace* + (parse-name name nil) plist t) + ;; No name specified, create an uninterned host object + (make-object-from-property-list + :host + (format nil "~a|~a|~a" *namespace* network (cadar address-pairs)) + plist))))) + best-host)) + (Otherwise + nil)))) + +) diff --git a/OG2-patches/host-ll-address.lisp b/OG2-patches/host-ll-address.lisp new file mode 100644 index 0000000..4c723c7 --- /dev/null +++ b/OG2-patches/host-ll-address.lisp @@ -0,0 +1,52 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp Machine, 11/03/14 17:03:40 +;;; while running on CHAOS from CHAOS-HOST:chaos.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Ivory Revision 5, VLM Debugger 329, Genera program 9.0, DEC OSF/1 V127, +;;; 1280x976 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11403901), +;;; Machine serial number 1860185938, +;;; more emb eth packets and disk buffers (from CHAOS-HOST:/home/lispm/lsource/emb-bufs.lisp), +;;; Allow multiple ll addresses (from CHAOS-HOST:/home/lispm/lsource/allow-multiple-ll-addresses.lisp), +;;; primary network: parse :internet before :chaos (from CHAOS-HOST:/home/lispm/lsource/primary-network-address.lisp), +;;; Reset arp (from CHAOS-HOST:/home/lispm/lsource/reset-arp.lisp), +;;; disable lossage in get-emb-host (from CHAOS-HOST:/home/lispm/lsource/get-emb-host.lisp), +;;; Full gc patches (from CHAOS-HOST:/home/lispm/lsource/full-gc-patch.lisp), +;;; disable GC during user disk io (from CHAOS-HOST:/home/lispm/lsource/user-disk-without-gc.lisp), +;;; doc ex drawings (from CHAOS-HOST:/home/lispm/lsource/docs-ellipse.lisp), +;;; OpenSuse FSS (from CHAOS-HOST:/home/lispm/lsource/opensuse-fss-patch.lisp), +;;; Linux, not Alpha (from CHAOS-HOST:/home/lispm/lsource/alpha.lisp), +;;; german keyboard (from CHAOS-HOST:/home/lispm/lsource/german-keyboard-patch.). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:NETWORK;VLM-INTERFACES.LISP.4") + + +(SCT:NOTE-PRIVATE-PATCH "Host ll address") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:NETWORK;VLM-INTERFACES.LISP.4") +#+VLM +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: NETWORK-INTERNALS; Base: 8; -*-") + +#+VLM + +(DEFMETHOD (:ADD-NETWORK VLM-ETHERNET-INTERFACE :AFTER) (NETWORK LOCAL-ADDRESS) + (ignore network local-address) + ;; dont assume the host to be on the same network interface + nil +; (LET* ((PROTOCOL (CL:FIND NETWORK PROTOCOL-TABLE +; :KEY #'PROTOCOL-TABLE-ENTRY-NETWORK)) +; (CHANNEL (EEI-CHANNEL LOW-LEVEL-INTERFACE))) +; ;; If this is the network protocol the host wants to use to talk to us, pick up its address +; (WHEN (= (PROTOCOL-TABLE-ENTRY-PROTOCOL-NUMBER PROTOCOL) +; (EMB-NET-CHANNEL-HOST-PRIMARY-PROTOCOL CHANNEL)) +; (SETF (GETHASH (EMB-NET-CHANNEL-HOST-PRIMARY-ADDRESS CHANNEL) +; (PROTOCOL-TABLE-ENTRY-HASH-TABLE PROTOCOL)) +; LOCAL-HARDWARE-ADDRESS)))) +) + diff --git a/OG2-patches/modifier-loop-patch.lisp b/OG2-patches/modifier-loop-patch.lisp new file mode 100644 index 0000000..7d813ca --- /dev/null +++ b/OG2-patches/modifier-loop-patch.lisp @@ -0,0 +1,69 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp Machine, 5/04/16 16:30:27 +;;; while running on CHAOS from CHAOS-HOST:chaos.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; NFSv3 Client 10.0, Ivory Revision 5, VLM Debugger 329, Genera program 9.0, +;;; DEC OSF/1 V127, +;;; 1280x976 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11702000), +;;; Machine serial number 356942099, +;;; more emb eth packets and disk buffers (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/emb-bufs.), +;;; Host ll address (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/host-ll-address.), +;;; Allow multiple ll addresses (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/allow-multiple-ll-addresses.), +;;; primary network: parse :internet before :chaos (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/primary-network-address.), +;;; disable lossage in get-emb-host (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/get-emb-host.), +;;; Full gc patches (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/full-gc-patch.), +;;; disable GC during user disk io (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/user-disk-without-gc.), +;;; OpenSuse FSS (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/opensuse-fss-patch.), +;;; Linux, not Alpha (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/alpha.), +;;; german keyboard (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/german-keyboard-patch.). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:X11;SCREEN;X-CONSOLE.LISP.47") + + +(SCT:NOTE-PRIVATE-PATCH "Modifier loop patch") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:X11;SCREEN;X-CONSOLE.LISP.47") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Base: 10; Package: X-SCREEN; Mode: LISP; Syntax: Common-lisp; Lowercase: T -*-") + + +(defun-in-flavor (update-server-modifier-mapping x-console) () + ) +; (loop +; for i below 10 +; while +; (eq (xlib:with-server-grabbed (display) +; (loop +; with table = (sys:keyboard-keyboard-table cli::keyboard) +; with nshifts = (array-dimension table 0) +; with display-modifier-mapping = (display-modifier-mapping) +; with modifier-mapping = (copy-tree display-modifier-mapping) +; with bound-modifier-mapping = +; (bound-modifier-mapping table display-modifier-mapping) +; for code from (xlib:display-min-keycode display) +; to (xlib:display-max-keycode display) +; do (loop +; for shift below nshifts +; for key = (keyboard-table-lookup table code shift) +; when key +; thereis +; (loop +; for (name keys) on bound-modifier-mapping by #'cddr +; when (member key keys) +; do (pushnew code (getf modifier-mapping name)) +; and return t)) +; finally +; (return +; (unless (equal modifier-mapping display-modifier-mapping) +; (catch-network-errors () +; (apply #'xlib:set-modifier-mapping display modifier-mapping)))))) +; :busy) +; do (cli::console-beep self) +; (sleep 1))) + diff --git a/OG2-patches/primary-network-address.lisp b/OG2-patches/primary-network-address.lisp new file mode 100644 index 0000000..4b48d78 --- /dev/null +++ b/OG2-patches/primary-network-address.lisp @@ -0,0 +1,50 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Written by Lisp Machine, 3/07/14 15:10:58 +;;; while running on GENERA from JJS|INTERNET|192.168.5.1:jjs.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Ivory Revision 5, VLM Debugger 329, Genera program 9.0, DEC OSF/1 V127, +;;; 1280x956 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11403901), +;;; Machine serial number 1833831759, +;;; Rational quotient (from GENERA-HOST:/home/lispm/lsource/rational-quotient.lisp), +;;; Linux, not Alpha (from GENERA-HOST:/home/lispm/patches.sct/alpha.lisp.~3~), +;;; doc ex drawings (from GENERA-HOST:/home/lispm/patches.sct/docs-ellipse.lisp.~3~), +;;; OpenSuse FSS (from GENERA-HOST:/home/lispm/patches.sct/opensuse-fss-patch.lisp.~1~). + + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "SYS:NETWORK;NAMESPACES.LISP.859") + + +(SCT:NOTE-PRIVATE-PATCH "primary network: parse :internet before :chaos") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:NETWORK;NAMESPACES.LISP.859") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: NETI; Base: 10; Lowercase: Yes -*-") + + +;;; Find the primary network address of the machine. +;;; This may have been specified with the Set Network-Address or Set Chaos-address command. +;;; We don't really handle the case of no network address yet. +(defun get-primary-network-address () + ;; first parse the strings from the FEP + (parse-primary-network-address) + ;; D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")Try chaos first and then Internet. +0 (loop for network-type in '(:internet :chaos) + as entry = (get-primary-address-entry-of-type network-type) + as network = (and entry + (find-object-from-property-list :network :type network-type)) + when network + return + (progn (setq *primary-network* network) + (setq *primary-network-address* (primary-address-address-string entry))) + finally + (setq *primary-network* nil) + (setq *primary-network-address* nil) + (fsignal + "No valid primary network address has been defined or the network specified in the ~ + FEP could not be found."))) + diff --git a/OG2-patches/use-host-time.lisp b/OG2-patches/use-host-time.lisp new file mode 100644 index 0000000..22fe1a6 --- /dev/null +++ b/OG2-patches/use-host-time.lisp @@ -0,0 +1,166 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Reason: Function TIME:READ-CALENDAR-CLOCK: don't check for 1985 <= year <= 1999 +;;; Function CLI::VLM-READ-CALENDAR-CLOCK-INTERNAL: don't restrict the year to be in the 20th century +;;; Variable TIME:*INITIALIZE-TIMEBASE-FROM-CALENDAR-CLOCK*: enable initialize time from calendar clock +;;; Written by Lisp Machine, 4/24/18 13:39:59 +;;; while running on CHAOS from CHAOS-HOST:../vlods/chaos.vlod +;;; with Open Genera 2.0, Genera 8.5, Logical Pathnames Translation Files NEWEST, +;;; Experimental NFSv3 Client 11.0, Ivory Revision 5, VLM Debugger 329, +;;; Genera program 9.1, DEC OSF/1 V4.17 (Rev. 0.0), +;;; 1280x976 24-bit TRUE-COLOR X Screen INTERNET|127.0.0.1:0.0 with 224 Genera fonts (The X.Org Foundation R11906000), +;;; Machine serial number 881198162, new elements unix-cwd, unix-home-dir, +;;; new coprocessor-register unixCrypt (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/emb-comm-area.), +;;; new unix crypt (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/nfs-rpc.), +;;; pass blocksize to embedded (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/attach-disk-blocksize.), +;;; more emb eth packets and disk buffers (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/emb-bufs.), +;;; Host ll address (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/host-ll-address.), +;;; Allow multiple ll addresses (from CHAOS-HOST:/home/lispm/lsource/allow-multiple-ll-addresses.lisp), +;;; primary network: parse :internet before :chaos (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/primary-network-address.), +;;; disable lossage in get-emb-host (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/get-emb-host.), +;;; Full gc patches (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/full-gc-patch.), +;;; disable GC during user disk io (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/user-disk-without-gc.), +;;; OpenSuse FSS (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/opensuse-fss-patch.), +;;; Linux, not Alpha (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/alpha.), +;;; Modifier loop patch (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/modifier-loop-patch.), +;;; detect keyboard (from DISTRIBUTION|DIS-EMB-HOST:/home/lispm/lsource/detect-keyboard-patch.). + + +(SCT:NOTE-PRIVATE-PATCH "Use embedding hosts time instead of asking the network") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:IO1;TIME.LISP.199") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode:LISP; Package:TIME; Base:8 -*-") + + +(DEFUN READ-CALENDAR-CLOCK (&OPTIONAL EVEN-IF-BAD) + (DECLARE (VALUES UT-OR-NIL)) + (MULTIPLE-VALUE-BIND (SECONDS MINUTES HOURS DAY MONTH YEAR DAY-OF-WEEK) + (PROGN + #+3600 + (FUNCALL (SELECTQ SYS:*IO-BOARD-TYPE* + (:OBS #'SI:READ-CALENDAR-CLOCK-INTERNAL) + (:NBS #'CLI::NBS-READ-CALENDAR-CLOCK-INTERNAL)) + EVEN-IF-BAD) + #+IMACH + (SYS:SYSTEM-CASE + (Solstice + (MULTIPLE-VALUE-BIND (SECONDS MINUTES HOURS DAY MONTH YEAR DAY-OF-WEEK) + (CLI::SOLSTICE-READ-CALENDAR-CLOCK-INTERNAL) + (IF SECONDS + (VALUES SECONDS MINUTES HOURS DAY MONTH YEAR DAY-OF-WEEK) + (CLI::MERLIN-READ-CALENDAR-CLOCK-INTERNAL EVEN-IF-BAD)))) + ((Merlin Zora) + (CLI::MERLIN-READ-CALENDAR-CLOCK-INTERNAL EVEN-IF-BAD)) + (MACIVORY + (MACINTOSH-INTERNALS::MACIVORY-READ-CALENDAR-CLOCK-INTERNAL)) + (Domino + (CLI::DOMINO-READ-CALENDAR-CLOCK-INTERNAL EVEN-IF-BAD)) + (VLM + (CLI::VLM-READ-CALENDAR-CLOCK-INTERNAL EVEN-IF-BAD)) + (OTHERWISE NIL))) + DAY-OF-WEEK ;not needed + (AND SECONDS ;values returned + (AND (<= 0 SECONDS 59.) + (<= 0 MINUTES 59.) + (<= 0 HOURS 23.) + (<= 1 MONTH 12.)) +;; (<= 85. YEAR 99.)) + (TIME:ENCODE-UNIVERSAL-TIME SECONDS MINUTES HOURS DAY MONTH YEAR 0)))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:I-SYS;V-CLOCK.LISP.2") +#+VLM +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode:LISP; Syntax:Common-lisp; Package:CLI; Base:10; Lowercase:Yes; -*-") + +#+VLM +;;; -*- Mode:LISP; Syntax:Common-lisp; Package:CLI; Base:10; Lowercase:Yes; -*- + +;;; VLM Calendar Clock + +;;;> +;;;> ***************************************************************************************** +;;;> ** (c) Copyright 1998-1982 Symbolics, Inc. All rights reserved. +;;;> ** Portions of font library Copyright (c) 1984 Bitstream, Inc. All Rights Reserved. +;;;> +;;;> The software, data, and information contained herein are proprietary to, +;;;> and comprise valuable trade secrets of, Symbolics, Inc., which intends +;;;> to keep such software, data, and information confidential and to preserve them +;;;> as trade secrets. They are given in confidence by Symbolics pursuant +;;;> to a written license agreement, and may be used, copied, transmitted, and stored +;;;> only in accordance with the terms of such license. +;;;> +;;;> Symbolics, Symbolics 3600, Symbolics 3675, Symbolics 3630, Symbolics 3640, +;;;> Symbolics 3645, Symbolics 3650, Symbolics 3653, Symbolics 3620, Symbolics 3610, +;;;> Zetalisp, Open Genera, Virtual Lisp Machine, VLM, Wheels, Dynamic Windows, +;;;> SmartStore, Semanticue, Frame-Up, Firewall, Document Examiner, +;;;> Delivery Document Examiner, "Your Next Step in Computing", Ivory, MacIvory, +;;;> MacIvory model 1, MacIvory model 2, MacIvory model 3, XL400, XL1200, XL1201, +;;;> Symbolics UX400S, Symbolics UX1200S, NXP1000, Symbolics C, Symbolics Pascal, +;;;> Symbolics Prolog, Symbolics Fortran, CLOE, CLOE Application Generator, +;;;> CLOE Developer, CLOE Runtime, Common Lisp Developer, Symbolics Concordia, +;;;> Joshua, Statice, and Minima are trademarks of Symbolics, Inc. +;;;> +;;;> Symbolics 3670, Symbolics Common Lisp, Symbolics-Lisp, and Genera are registered +;;;> trademarks of Symbolics, Inc. +;;;> +;;;> GOVERNMENT PURPOSE RIGHTS LEGEND +;;;> +;;;> Contract No.: various +;;;> Contractor Name: Symbolics, Inc. +;;;> Contractor Address: c/o Ropes & Gray +;;;> One International Place +;;;> Boston, Massachusetts 02110-2624 +;;;> Expiration Date: 2/27/2018 +;;;> +;;;> The Government's rights to use, modify, reproduce, release, perform, display or +;;;> disclose this software are restricted by paragraph (b)(2) of the "Rights in +;;;> Noncommercial Computer Software and Noncommercial Computer Software Documentation" +;;;> contained in the above identified contracts. No restrictions apply after the +;;;> expiration date shown above. Any reproduction of the software or portions thereof +;;;> marked with this legend must also reproduce the markings. Questions regarding +;;;> the Government's rights may be referred to the AS&T Contracts Office of the +;;;> National Reconnaissance Office, Chantilly, Virginia 20151-1715. +;;;> +;;;> Symbolics, Inc. +;;;> c/o Ropes & Gray +;;;> One International Place +;;;> Boston, Massachusetts 02110-2624 +;;;> 781-937-7655 +;;;> +;;;> ***************************************************************************************** +;;;> +(defun vlm-read-calendar-clock-internal (&optional even-if-bad) + (declare (values seconds minutes hours day month year day-of-week) + (ignore even-if-bad)) + (let ((ut (%coprocessor-read %coprocessor-register-calendar-clock))) + (values (%logldb coprocessor-calendar-clock-second ut) + (%logldb coprocessor-calendar-clock-minute ut) + (%logldb coprocessor-calendar-clock-hour ut) + (%logldb coprocessor-calendar-clock-date ut) + (%logldb coprocessor-calendar-clock-month ut) +;; (mod (+ (%logldb coprocessor-calendar-clock-year ut) +;; %coprocessor-calendar-clock-base-year) +;; 100) + (+ (%logldb coprocessor-calendar-clock-year ut) + %coprocessor-calendar-clock-base-year) + 0 ;Caller ignores it. + ))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "SYS:IO1;TIME.LISP.199") +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode:LISP; Package:TIME; Base:8 -*-") + + +(DEFVAR *INITIALIZE-TIMEBASE-FROM-CALENDAR-CLOCK* t + "Skip trying to read from network or prompting user") + diff --git a/README b/README new file mode 100644 index 0000000..c421fc6 --- /dev/null +++ b/README @@ -0,0 +1,63 @@ +vlm for linux on x86_64 + +if you don't know what it is, you probably don't want it... + +based on the admirable work of Brad Parker who changed the alpha assembler +code generator to produce c-code runnable on an x86_64 platform + +this version uses a TUNTAP tap device for networking, that way +it doesn't need root privileges to run if you define a tap +interface beforehand. I decided to use a tap (as opposed to a tun) +interface because access to the complete ethernet frame is possible +with a tap interface - making my life easier since I'm currently +writing a chaosnet network module for Linux and would need access to +the complete ethernet frame therefore. Also it is possible to put tap +devices on a bridge with different mac addresses to be able to run +multiple vlm instances communicating to each other via chaosnet. + +this version has fixes for: + - X11 with xcb lib (runs with or without xcb) + since clx directly accesses the bar-bones X11-protocol, xcb + gets confused when you try to XCloseDisplay/XSynch because clx tries + to keep track of the X11 calls internally which it is unable to + do with a mixture of XLIB calls and direct access to the X11-protocol. + This in turn keeps the vlm from cleanly closing a display, which it + uses when terminating and/or saving a LISP world. + So, if we detect xcb being used, we use a workaround for closing + X displays... + + - keyboard mapping for the cold-load/debugger window + I deemed it unsatisfactory to not being able to use the CTRL-, META-, + SUPER-, and HYPER- keys in the cold-load/debugger window, so I did setup + a mapping for those keys like it is done in the GENERA system itself. You + may use the same keys now in the cold-load/debugger window. + + - rational division (/ 3) yields 1/3 instead of 0 + doesn't work in Brads version, because rational division ought to + produce a trap if there is a non-zero remainder from a division. I've + decide to produce asm code for rational division by generating a new + pseudo alpha instruction (x64ratquo) and generating asm code from that. + see alpha-assembler/imacmath.lisp and stub/process.lisp + + - double float exceptions (/ 0.0d0) results in a valid trap now + has not been implemented in the alpha assembly version (forgotten + perhaps). + Changed that in the generation of alpha assembly code (tested on an alpha + as well). see alpha-assembler/imactrap.lisp. + +there are extensions for: + - blocksize settable for attach-disk-channel (to be able to use fep-file + images with non-2048 word blocks, like images derived from ancient + ESDI disks. + + - a unix crypt routine + links to unix crypt to enable use of modern crypt algorithms. + + - unix cwd and unix home dir to be found in embedded communication area + + You won't be able to use these extensions if you do not patch and + recompile respective the LISP definitions as well. + +to install follow the instructions given in the file INSTALL. + +./configure --help will give you some configuration options diff --git a/TAGS b/TAGS new file mode 100644 index 0000000..061c279 --- /dev/null +++ b/TAGS @@ -0,0 +1,25936 @@ + +keyboard.c,41 +static void test(6,90 +void main 40,756 + +config.h,2378 +#define HAVE_ALARM 5,176 +#define HAVE_ARPA_INET_H 8,259 +#define HAVE_ATEXIT 11,340 +#define HAVE_CLOCK_GETTIME 14,423 +#define HAVE_DLFCN_H 17,510 +#define HAVE_FCNTL_H 20,591 +#define HAVE_FENV_H 23,671 +#define HAVE_FLOOR 26,746 +#define HAVE_FTRUNCATE 29,824 +#define HAVE_GETCWD 32,903 +#define HAVE_GETHOSTBYADDR 35,986 +#define HAVE_GETHOSTBYNAME 38,1076 +#define HAVE_GETHOSTNAME 41,1164 +#define HAVE_GETPAGESIZE 44,1250 +#define HAVE_GETTIMEOFDAY 47,1337 +#define HAVE_INET_NTOA 50,1422 +#define HAVE_INTTYPES_H 53,1508 +#define HAVE_LIBC 56,1588 +#define HAVE_LIBCRYPT 59,1670 +#define HAVE_LIBDL 62,1750 +#define HAVE_LIBM 65,1825 +#define HAVE_LIBPTHREAD 68,1911 +#define HAVE_LIBX11 71,1995 +#define HAVE_LIMITS_H 74,2076 +#define HAVE_MALLOC 78,2202 +#define HAVE_MALLOC_H 81,2283 +#define HAVE_MEMCHR 84,2361 +#define HAVE_MEMMOVE 87,2438 +#define HAVE_MEMORY_H 90,2520 +#define HAVE_MEMSET 93,2598 +#define HAVE_MMAP 96,2681 +#define HAVE_MUNMAP 99,2755 +#define HAVE_NETDB_H 102,2835 +#define HAVE_NETINET_IN_H 105,2921 +#define HAVE_NLIST_H 108,3007 +#define HAVE_PATHS_H 111,3088 +#define HAVE_PTHREAD 114,3179 +#define HAVE_PTRDIFF_T 117,3261 +#define HAVE_REALLOC 121,3389 +#define HAVE_RINT 124,3464 +#define HAVE_SOCKET 127,3538 +#define HAVE_STDDEF_H 130,3619 +#define HAVE_STDINT_H 133,3702 +#define HAVE_STDLIB_H 136,3785 +#define HAVE_STPCPY 139,3863 +#define HAVE_STRCHR 142,3939 +#define HAVE_STRDUP 145,4015 +#define HAVE_STRERROR 148,4093 +#define HAVE_STRINGS_H 151,4177 +#define HAVE_STRING_H 154,4261 +#define HAVE_STRNDUP 157,4340 +#define HAVE_STRRCHR 160,4418 +#define HAVE_STRTOUL 163,4496 +#define HAVE_SYS_FILE_H 166,4580 +#define HAVE_SYS_IOCTL_H 169,4668 +#define HAVE_SYS_PARAM_H 172,4757 +#define HAVE_SYS_SOCKET_H 175,4847 +#define HAVE_SYS_STAT_H 178,4936 +#define HAVE_SYS_TIME_H 181,5023 +#define HAVE_SYS_TYPES_H 184,5111 +#define HAVE_UCONTEXT_T 187,5198 +#define HAVE_UNAME 190,5277 +#define HAVE_UNISTD_H 193,5357 +#define HAVE_UTMP_H 196,5438 +#define HAVE_X11_XLIB_XCB_H 199,5525 +#define HAVE__BOOL 202,5610 +#define PACKAGE 208,5759 +#define PACKAGE_BUGREPORT 211,5861 +#define PACKAGE_NAME 214,5958 +#define PACKAGE_STRING 217,6045 +#define PACKAGE_TARNAME 220,6139 +#define PACKAGE_URL 223,6218 +#define PACKAGE_VERSION 226,6287 +#define SIZEOF_INT_P 233,6501 +#define STDC_HEADERS 236,6580 +#define VERSION 239,6636 + +admin/mprotect-bug.c,192 +#define PAGESIZE 9,153 +#define MAPSIZE 10,179 +#define NMAP 11,208 +#define MAPBASE 12,225 +long addrarr[addrarr14,257 +long maddrarr[maddrarr15,277 +void segv_handler 17,299 +main(32,822 + +admin/swapstat.c,136 +struct nlist nl[nl20,523 +#define N_VM_SWAP_SPACE 22,571 +#define N_VM_TOTAL_SWAP_SPACE 24,637 +#define N_PHYSMEM 26,691 +main(30,743 + +c-emulator/dispatch.c,1205 +typedef struct _DecoderPair13,180 + int dispatch;15,210 + void (*decode)decode16,226 +} DecoderPair;17,247 +static const int ReturnInstructionDecoder[ReturnInstructionDecoder19,263 +static const int WordInstructionDecoder[WordInstructionDecoder26,394 +static const int PopInstructionDecoder[PopInstructionDecoder94,2295 +static const int IllegalInstructionDecoder 354,9420 +static void DecodeNoneFunction 356,9494 +static InstructionCacheLine InstructionCacheLookupCPRepresentation 361,9583 +static void Decode8BitUnsignedOperandFunction 364,9733 +static void Decode8BitSignedOperandFunction 369,9844 +static void Decode10BitUnsignedOperandFunction 374,9960 +static void Decode12BitUnsignedOperandFunction 379,10073 +static void DecodeFPOperandFunction 384,10186 +static void DecodeLPOperandFunction 389,10289 +static void DecodeSPOperandFunction 394,10392 +static void DecodeBranchOperandFunction 407,10643 +static void DecodeReturnOperandFunction 412,10756 +static void DecodeEntryOperandFunction 431,11159 +static const DecoderPair PackedInstructionDecoder[PackedInstructionDecoder436,11289 +const char *ivory_dispatch_names[ivory_dispatch_names1464,71706 +int InstructionCacheMiss 2191,86303 + +c-emulator/emulator.c,2797 +#define MARK(14,223 +volatile int suspend 22,333 +typedef enum _SuspendType24,360 + SuspendNone,26,388 + SuspendSpy,27,403 + SuspendLowPriority,28,417 + SuspendHighPriority,29,439 + SuspendReset30,462 +} SuspendType;31,477 +static jmp_buf trap_environment;33,493 +static LispObj trap_vma 34,526 +static LispObj trap_microstate 35,573 +Integer memory_vma;36,625 +void TakeMemoryTrap(39,683 +void TakeIllegalOperandTrap(45,795 +void TakeInstructionExceptionTrap(52,1030 +static void segv_handler 58,1171 +static void io_handler 65,1370 +void SendInterruptToEmulator 70,1435 +static void ProcessSuspend(75,1505 +int ReadVirtualMemory 95,1976 +int WriteVirtualMemory 108,2278 +int ReadVirtualMemoryBlock 118,2559 +int WriteVirtualMemoryBlock 132,2909 +void StackCacheScrollUp 145,3249 +void StackCacheScrollDown 167,3845 +Boolean EphemeralP 187,4416 +Boolean OldspaceAddressP 192,4533 +Boolean OldspaceP 204,4862 +Byte MemoryActionTable[MemoryActionTable209,4976 +Integer MemoryReadInternal 273,7980 +int StoreContentsInternal 312,8965 +static int CarInternal 328,9283 +static int CdrInternal 351,9738 +static int CarCdrInternal 390,10563 +static void Aref1Internal 410,10965 +static void Aset1Internal 453,11957 +static void RecomputeArrayRegister(498,13078 +static Integer LocateInstanceVariableMapped 528,13887 +static Integer LocateArbitraryInstanceVariable 551,14671 +int PullApplyArgsQuickly 571,15294 +static int Unbind(645,17126 +Integer ALUFunctionBoolean(667,17748 +Integer ALUFunctionByte(690,18438 +Integer ALUFunctionAdder(724,19466 +Integer ALUFunctionMultiplyDivide(743,19961 +Boolean ALUComputeCondition 756,20203 +#define AddressImmediateOperand(821,22199 +#define AddressSPOperand(822,22279 +#define AddressFPOperand(823,22331 +#define AddressLPOperand(824,22383 +#define AddressPopOperand(825,22435 +#define AddressBAR(826,22476 +#define PushObject(829,22608 +#define PushFixnum(830,22676 +#define PushNIL(831,22764 +#define PushT(832,22811 +#define PushConstant(833,22854 +#define PushPredicate(834,22986 +#define PopObject(835,23057 +#define MoveObject(836,23106 +#define SetObject(839,23196 +#define SetFixnum(840,23250 +#define SetNIL(841,23327 +#define SetT(842,23362 +#define SetPredicate(843,23393 +#define SetConstant(844,23461 +#define BranchConditionTrue 846,23584 +#define BranchConditionFalse 847,23649 +#define TakeBranch(848,23715 +#define DontTakeBranch(849,23776 +#define NextInstruction 851,23845 +#define UnimplementedInstruction 852,23893 +#define InstructionException 853,23959 +#define IllegalOperand 854,24017 +#define AllowSequenceBreaks 855,24063 +#define PushContinuation(857,24127 +#define PushControl(858,24189 +#define DecacheRegisters(860,24245 +#define EncacheRegisters(861,24345 +void IncrementPC(863,24446 +void InstructionSequencer 881,24758 + +c-emulator/initialization.c,526 +static Boolean allocatedCaches 11,144 +volatile int run 12,184 +static void quit_handler 15,227 +static ProcessorState ps;21,296 +ProcessorState *processor processor23,323 +Boolean Runningp 25,357 +void HaltMachine 30,401 +void ResetMachine 37,471 +void StartMachine 40,501 +Boolean IvoryProcessorSystemStartup 46,557 +void PushOneFakeFrame 70,1284 +void PopOneFakeFrame 86,1720 +void InitializeIvoryProcessor 98,2078 +void OutOfMemory(157,4377 +Boolean ReadInternalRegister 163,4518 +Boolean WriteInternalRegister 203,5576 + +c-emulator/memory.c,1088 +const LispObj ObjectT 15,202 +const LispObj ObjectNIL 16,252 +const LispObj ObjectCdrMask 17,303 +Tag *TagSpace TagSpace22,425 +Integer *DataSpace DataSpace23,491 +#define MemoryPageSize 31,750 +#define MemoryAddressPageShift 32,780 +#define MemoryPageNumber(34,815 +#define MemoryPageOffset(35,879 +#define PageNumberMemory(36,940 +VMAttribute VMAttributeTable[VMAttributeTable39,1077 +#define Created(41,1140 +#define SetCreated(42,1211 +#define ClearCreated(43,1296 +Integer EnsureVirtualAddress 47,1404 +Integer EnsureVirtualAddressRange 68,2063 +Integer DestroyVirtualAddress 104,3129 +Integer DestroyVirtualAddressRange 123,3648 +Integer* MapVirtualAddressData(134,3850 +Tag* MapVirtualAddressTag(139,3926 +int VirtualMemoryRead 144,3996 +int VirtualMemoryWrite 154,4197 +int VirtualMemoryReadBlock 164,4399 +int VirtualMemoryWriteBlock 181,4771 +int VirtualMemoryWriteBlockConstant 198,5144 +Boolean VirtualMemorySearch 229,6016 +int VirtualMemoryCopy 254,6579 +Boolean VirtualMemoryScan 304,7821 +void VirtualMemoryEnable 329,8477 +VMState VM;342,8851 +int VMCommand(344,8864 + +c-emulator/traps.c,341 +typedef struct _ExceptionInfo7,109 + int arity;9,144 + int stackp;10,159 + int arithp;11,175 +ExceptionInfo;13,196 +const ExceptionInfo InstructionExceptionInfo[InstructionExceptionInfo15,212 +static int FetchTrapVectorEntry 274,15384 +int TakePreTrap 289,15923 +int TakePostTrap(363,17908 +int TakeInstructionException(425,19749 + +emulator/externals.c,426 +int CoprocessorWrite 31,854 +LispObj CoprocessorRead 168,5897 +void FlushCaches 312,10854 +static TRACEDATA traceData;320,10924 +static FILE *traceS traceS321,10952 +static uint64_t lastCR 322,10980 +void InitializeTracing 324,11009 +void EnterTrace 350,11951 +#define DecodeObject(387,13281 +static void PrintTraceRecord 389,13422 +void PrintTrace 465,15808 +void MaybePrintTrace 482,16257 +void TerminateTracing 488,16324 + +emulator/fake_emulator.c,27847 +static int first_call 7,80 +int iInterpret 9,108 +void SpinWheels 20,318 +void ARITHMETICEXCEPTION 25,387 +void DECODEFAULT 26,419 +void CarCdrSubroutine 28,444 +void CarSubroutine 29,473 +void CdrSubroutine 30,499 +void Do32BitDifferenceFP 31,525 +void Do32BitDifferenceIM 32,557 +void Do32BitDifferenceLP 33,589 +void Do32BitDifferenceSP 34,621 +void Do32BitPlusFP 35,653 +void Do32BitPlusIM 36,679 +void Do32BitPlusLP 37,705 +void Do32BitPlusSP 38,731 +void DoAddBignumStepFP 39,757 +void DoAddBignumStepIM 40,787 +void DoAddBignumStepLP 41,817 +void DoAddBignumStepSP 42,847 +void DoAddFP 43,877 +void DoAddIM 44,897 +void DoAddLP 45,917 +void DoAddSP 46,937 +void DoAllocateListBlockFP 47,957 +void DoAllocateListBlockIM 48,991 +void DoAllocateListBlockLP 49,1025 +void DoAllocateListBlockSP 50,1059 +void DoAllocateStructureBlockFP 51,1093 +void DoAllocateStructureBlockIM 52,1132 +void DoAllocateStructureBlockLP 53,1171 +void DoAllocateStructureBlockSP 54,1210 +void DoAloc1FP 55,1249 +void DoAloc1IM 56,1271 +void DoAloc1LP 57,1293 +void DoAloc1SP 58,1315 +void DoAlocLeaderFP 59,1337 +void DoAlocLeaderIM 60,1364 +void DoAlocLeaderLP 61,1391 +void DoAlocLeaderSP 62,1418 +void DoAluFP 63,1445 +void DoAluIM 64,1465 +void DoAluLP 65,1485 +void DoAluSP 66,1505 +void DoAref1FP 67,1525 +void DoAref1IM 68,1547 +void DoAref1LP 69,1569 +void DoAref1SP 70,1591 +void DoArrayLeaderFP 71,1613 +void DoArrayLeaderIM 72,1641 +void DoArrayLeaderLP 73,1669 +void DoArrayLeaderSP 74,1697 +void DoAset1FP 75,1725 +void DoAset1IM 76,1747 +void DoAset1LP 77,1769 +void DoAset1SP 78,1791 +void DoAshFP 79,1813 +void DoAshIM 80,1833 +void DoAshLP 81,1853 +void DoAshSP 82,1873 +void DoAssocFP 83,1893 +void DoAssocIM 84,1915 +void DoAssocLP 85,1937 +void DoAssocSP 86,1959 +void DoBindLocativeFP 87,1981 +void DoBindLocativeIM 88,2010 +void DoBindLocativeLP 89,2039 +void DoBindLocativeSP 90,2068 +void DoBindLocativeToValueFP 91,2097 +void DoBindLocativeToValueIM 92,2133 +void DoBindLocativeToValueLP 93,2169 +void DoBindLocativeToValueSP 94,2205 +void DoBlock0ReadAluFP 95,2241 +void DoBlock0ReadAluIM 96,2271 +void DoBlock0ReadAluLP 97,2301 +void DoBlock0ReadAluSP 98,2331 +void DoBlock0ReadFP 99,2361 +void DoBlock0ReadIM 100,2388 +void DoBlock0ReadLP 101,2415 +void DoBlock0ReadSP 102,2442 +void DoBlock0ReadShiftFP 103,2469 +void DoBlock0ReadShiftIM 104,2501 +void DoBlock0ReadShiftLP 105,2533 +void DoBlock0ReadShiftSP 106,2565 +void DoBlock0ReadTestFP 107,2597 +void DoBlock0ReadTestIM 108,2628 +void DoBlock0ReadTestLP 109,2659 +void DoBlock0ReadTestSP 110,2690 +void DoBlock0WriteFP 111,2721 +void DoBlock0WriteIM 112,2749 +void DoBlock0WriteLP 113,2777 +void DoBlock0WriteSP 114,2805 +void DoBlock1ReadAluFP 115,2833 +void DoBlock1ReadAluIM 116,2863 +void DoBlock1ReadAluLP 117,2893 +void DoBlock1ReadAluSP 118,2923 +void DoBlock1ReadFP 119,2953 +void DoBlock1ReadIM 120,2980 +void DoBlock1ReadLP 121,3007 +void DoBlock1ReadSP 122,3034 +void DoBlock1ReadShiftFP 123,3061 +void DoBlock1ReadShiftIM 124,3093 +void DoBlock1ReadShiftLP 125,3125 +void DoBlock1ReadShiftSP 126,3157 +void DoBlock1ReadTestFP 127,3189 +void DoBlock1ReadTestIM 128,3220 +void DoBlock1ReadTestLP 129,3251 +void DoBlock1ReadTestSP 130,3282 +void DoBlock1WriteFP 131,3313 +void DoBlock1WriteIM 132,3341 +void DoBlock1WriteLP 133,3369 +void DoBlock1WriteSP 134,3397 +void DoBlock2ReadAluFP 135,3425 +void DoBlock2ReadAluIM 136,3455 +void DoBlock2ReadAluLP 137,3485 +void DoBlock2ReadAluSP 138,3515 +void DoBlock2ReadFP 139,3545 +void DoBlock2ReadIM 140,3572 +void DoBlock2ReadLP 141,3599 +void DoBlock2ReadSP 142,3626 +void DoBlock2ReadShiftFP 143,3653 +void DoBlock2ReadShiftIM 144,3685 +void DoBlock2ReadShiftLP 145,3717 +void DoBlock2ReadShiftSP 146,3749 +void DoBlock2ReadTestFP 147,3781 +void DoBlock2ReadTestIM 148,3812 +void DoBlock2ReadTestLP 149,3843 +void DoBlock2ReadTestSP 150,3874 +void DoBlock2WriteFP 151,3905 +void DoBlock2WriteIM 152,3933 +void DoBlock2WriteLP 153,3961 +void DoBlock2WriteSP 154,3989 +void DoBlock3ReadAluFP 155,4017 +void DoBlock3ReadAluIM 156,4047 +void DoBlock3ReadAluLP 157,4077 +void DoBlock3ReadAluSP 158,4107 +void DoBlock3ReadFP 159,4137 +void DoBlock3ReadIM 160,4164 +void DoBlock3ReadLP 161,4191 +void DoBlock3ReadSP 162,4218 +void DoBlock3ReadShiftFP 163,4245 +void DoBlock3ReadShiftIM 164,4277 +void DoBlock3ReadShiftLP 165,4309 +void DoBlock3ReadShiftSP 166,4341 +void DoBlock3ReadTestFP 167,4373 +void DoBlock3ReadTestIM 168,4404 +void DoBlock3ReadTestLP 169,4435 +void DoBlock3ReadTestSP 170,4466 +void DoBlock3WriteFP 171,4497 +void DoBlock3WriteIM 172,4525 +void DoBlock3WriteLP 173,4553 +void DoBlock3WriteSP 174,4581 +void DoBranchFP 175,4609 +void DoBranchFalseAndExtraPopFP 176,4632 +void DoBranchFalseAndExtraPopIM 177,4671 +void DoBranchFalseAndExtraPopLP 178,4710 +void DoBranchFalseAndExtraPopSP 179,4749 +void DoBranchFalseAndNoPopElseNoPopExtraPopFP 180,4788 +void DoBranchFalseAndNoPopElseNoPopExtraPopIM 181,4841 +void DoBranchFalseAndNoPopElseNoPopExtraPopLP 182,4894 +void DoBranchFalseAndNoPopElseNoPopExtraPopSP 183,4947 +void DoBranchFalseAndNoPopFP 184,5000 +void DoBranchFalseAndNoPopIM 185,5036 +void DoBranchFalseAndNoPopLP 186,5072 +void DoBranchFalseAndNoPopSP 187,5108 +void DoBranchFalseElseExtraPopFP 188,5144 +void DoBranchFalseElseExtraPopIM 189,5184 +void DoBranchFalseElseExtraPopLP 190,5224 +void DoBranchFalseElseExtraPopSP 191,5264 +void DoBranchFalseElseNoPopFP 192,5304 +void DoBranchFalseElseNoPopIM 193,5341 +void DoBranchFalseElseNoPopLP 194,5378 +void DoBranchFalseElseNoPopSP 195,5415 +void DoBranchFalseExtraPopFP 196,5452 +void DoBranchFalseExtraPopIM 197,5488 +void DoBranchFalseExtraPopLP 198,5524 +void DoBranchFalseExtraPopSP 199,5560 +void DoBranchFalseFP 200,5596 +void DoBranchFalseIM 201,5624 +void DoBranchFalseLP 202,5652 +void DoBranchFalseNoPopFP 203,5680 +void DoBranchFalseNoPopIM 204,5713 +void DoBranchFalseNoPopLP 205,5746 +void DoBranchFalseNoPopSP 206,5779 +void DoBranchFalseSP 207,5812 +void DoBranchIM 208,5840 +void DoBranchLP 209,5863 +void DoBranchSP 210,5886 +void DoBranchTrueAndExtraPopFP 211,5909 +void DoBranchTrueAndExtraPopIM 212,5947 +void DoBranchTrueAndExtraPopLP 213,5985 +void DoBranchTrueAndExtraPopSP 214,6023 +void DoBranchTrueAndNoPopElseNoPopExtraPopFP 215,6061 +void DoBranchTrueAndNoPopElseNoPopExtraPopIM 216,6113 +void DoBranchTrueAndNoPopElseNoPopExtraPopLP 217,6165 +void DoBranchTrueAndNoPopElseNoPopExtraPopSP 218,6217 +void DoBranchTrueAndNoPopFP 219,6269 +void DoBranchTrueAndNoPopIM 220,6304 +void DoBranchTrueAndNoPopLP 221,6339 +void DoBranchTrueAndNoPopSP 222,6374 +void DoBranchTrueElseExtraPopFP 223,6409 +void DoBranchTrueElseExtraPopIM 224,6448 +void DoBranchTrueElseExtraPopLP 225,6487 +void DoBranchTrueElseExtraPopSP 226,6526 +void DoBranchTrueElseNoPopFP 227,6565 +void DoBranchTrueElseNoPopIM 228,6601 +void DoBranchTrueElseNoPopLP 229,6637 +void DoBranchTrueElseNoPopSP 230,6673 +void DoBranchTrueExtraPopFP 231,6709 +void DoBranchTrueExtraPopIM 232,6744 +void DoBranchTrueExtraPopLP 233,6779 +void DoBranchTrueExtraPopSP 234,6814 +void DoBranchTrueFP 235,6849 +void DoBranchTrueIM 236,6876 +void DoBranchTrueLP 237,6903 +void DoBranchTrueNoPopFP 238,6930 +void DoBranchTrueNoPopIM 239,6962 +void DoBranchTrueNoPopLP 240,6994 +void DoBranchTrueNoPopSP 241,7026 +void DoBranchTrueSP 242,7058 +void DoCarFP 243,7085 +void DoCarIM 244,7105 +void DoCarLP 245,7125 +void DoCarSP 246,7145 +void DoCatchCloseFP 247,7165 +void DoCatchCloseIM 248,7192 +void DoCatchCloseLP 249,7219 +void DoCatchCloseSP 250,7246 +void DoCatchOpenFP 251,7273 +void DoCatchOpenIM 252,7299 +void DoCatchOpenLP 253,7325 +void DoCatchOpenSP 254,7351 +void DoCdrFP 255,7377 +void DoCdrIM 256,7397 +void DoCdrLP 257,7417 +void DoCdrSP 258,7437 +void DoCeilingFP 259,7457 +void DoCeilingIM 260,7481 +void DoCeilingLP 261,7505 +void DoCeilingSP 262,7529 +void DoCharDpbFP 263,7553 +void DoCharDpbIM 264,7577 +void DoCharDpbLP 265,7601 +void DoCharDpbSP 266,7625 +void DoCharLdbFP 267,7649 +void DoCharLdbIM 268,7673 +void DoCharLdbLP 269,7697 +void DoCharLdbSP 270,7721 +void DoCheckPreemptRequestFP 271,7745 +void DoCheckPreemptRequestIM 272,7781 +void DoCheckPreemptRequestLP 273,7817 +void DoCheckPreemptRequestSP 274,7853 +void DoCoprocessorReadFP 275,7889 +void DoCoprocessorReadIM 276,7921 +void DoCoprocessorReadLP 277,7953 +void DoCoprocessorReadSP 278,7985 +void DoCoprocessorWriteFP 279,8017 +void DoCoprocessorWriteIM 280,8050 +void DoCoprocessorWriteLP 281,8083 +void DoCoprocessorWriteSP 282,8116 +void DoDecrementFP 283,8149 +void DoDecrementIM 284,8175 +void DoDecrementLP 285,8201 +void DoDecrementSP 286,8227 +void DoDereferenceFP 287,8253 +void DoDereferenceIM 288,8281 +void DoDereferenceLP 289,8309 +void DoDereferenceSP 290,8337 +void DoDivideBignumStepFP 291,8365 +void DoDivideBignumStepIM 292,8398 +void DoDivideBignumStepLP 293,8431 +void DoDivideBignumStepSP 294,8464 +void DoDoubleFloatOpFP 295,8497 +void DoDoubleFloatOpIM 296,8527 +void DoDoubleFloatOpLP 297,8557 +void DoDoubleFloatOpSP 298,8587 +void DoDpbFP 299,8617 +void DoDpbIM 300,8637 +void DoDpbLP 301,8657 +void DoDpbSP 302,8677 +void DoEndpFP 303,8697 +void DoEndpIM 304,8718 +void DoEndpLP 305,8739 +void DoEndpSP 306,8760 +void DoEntryRestAcceptedFP 307,8781 +void DoEntryRestAcceptedIM 308,8815 +void DoEntryRestAcceptedLP 309,8849 +void DoEntryRestAcceptedSP 310,8883 +void DoEntryRestNotAcceptedFP 311,8917 +void DoEntryRestNotAcceptedIM 312,8954 +void DoEntryRestNotAcceptedLP 313,8991 +void DoEntryRestNotAcceptedSP 314,9028 +void DoEphemeralpFP 315,9065 +void DoEphemeralpIM 316,9092 +void DoEphemeralpLP 317,9119 +void DoEphemeralpSP 318,9146 +void DoEqFP 319,9173 +void DoEqIM 320,9192 +void DoEqLP 321,9211 +void DoEqSP 322,9230 +void DoEqlFP 323,9249 +void DoEqlIM 324,9269 +void DoEqlLP 325,9289 +void DoEqlSP 326,9309 +void DoEqualNumberFP 327,9329 +void DoEqualNumberIM 328,9357 +void DoEqualNumberLP 329,9385 +void DoEqualNumberSP 330,9413 +void DoFastAref1FP 331,9441 +void DoFastAref1IM 332,9467 +void DoFastAref1LP 333,9493 +void DoFastAref1SP 334,9519 +void DoFastAset1FP 335,9545 +void DoFastAset1IM 336,9571 +void DoFastAset1LP 337,9597 +void DoFastAset1SP 338,9623 +void DoFinishCallNFP 339,9649 +void DoFinishCallNIM 340,9677 +void DoFinishCallNLP 341,9705 +void DoFinishCallNSP 342,9733 +void DoFinishCallTosFP 343,9761 +void DoFinishCallTosIM 344,9791 +void DoFinishCallTosLP 345,9821 +void DoFinishCallTosSP 346,9851 +void DoFloorFP 347,9881 +void DoFloorIM 348,9903 +void DoFloorLP 349,9925 +void DoFloorSP 350,9947 +void DoGenericDispatchFP 351,9969 +void DoGenericDispatchIM 352,10001 +void DoGenericDispatchLP 353,10033 +void DoGenericDispatchSP 354,10065 +void DoGreaterpFP 355,10097 +void DoGreaterpIM 356,10122 +void DoGreaterpLP 357,10147 +void DoGreaterpSP 358,10172 +void DoHaltFP 359,10197 +void DoHaltIM 360,10218 +void DoHaltLP 361,10239 +void DoHaltSP 362,10260 +void DoIStageError 363,10281 +void DoIncrementFP 364,10307 +void DoIncrementIM 365,10333 +void DoIncrementLP 366,10359 +void DoIncrementSP 367,10385 +void DoInstanceLocFP 368,10411 +void DoInstanceLocIM 369,10439 +void DoInstanceLocLP 370,10467 +void DoInstanceLocSP 371,10495 +void DoInstanceRefFP 372,10523 +void DoInstanceRefIM 373,10551 +void DoInstanceRefLP 374,10579 +void DoInstanceRefSP 375,10607 +void DoInstanceSetFP 376,10635 +void DoInstanceSetIM 377,10663 +void DoInstanceSetLP 378,10691 +void DoInstanceSetSP 379,10719 +void DoJumpFP 380,10747 +void DoJumpIM 381,10768 +void DoJumpLP 382,10789 +void DoJumpSP 383,10810 +void DoLdbFP 384,10831 +void DoLdbIM 385,10851 +void DoLdbLP 386,10871 +void DoLdbSP 387,10891 +void DoLesspFP 388,10911 +void DoLesspIM 389,10933 +void DoLesspLP 390,10955 +void DoLesspSP 391,10977 +void DoLocateLocalsFP 392,10999 +void DoLocateLocalsIM 393,11028 +void DoLocateLocalsLP 394,11057 +void DoLocateLocalsSP 395,11086 +void DoLogandFP 396,11115 +void DoLogandIM 397,11138 +void DoLogandLP 398,11161 +void DoLogandSP 399,11184 +void DoLogicTailTestFP 400,11207 +void DoLogicTailTestIM 401,11237 +void DoLogicTailTestLP 402,11267 +void DoLogicTailTestSP 403,11297 +void DoLogiorFP 404,11327 +void DoLogiorIM 405,11350 +void DoLogiorLP 406,11373 +void DoLogiorSP 407,11396 +void DoLogtestFP 408,11419 +void DoLogtestIM 409,11443 +void DoLogtestLP 410,11467 +void DoLogtestSP 411,11491 +void DoLogxorFP 412,11515 +void DoLogxorIM 413,11538 +void DoLogxorLP 414,11561 +void DoLogxorSP 415,11584 +void DoLoopDecrementTosFP 416,11607 +void DoLoopDecrementTosIM 417,11640 +void DoLoopDecrementTosLP 418,11673 +void DoLoopDecrementTosSP 419,11706 +void DoLoopIncrementTosLessThanFP 420,11739 +void DoLoopIncrementTosLessThanIM 421,11780 +void DoLoopIncrementTosLessThanLP 422,11821 +void DoLoopIncrementTosLessThanSP 423,11862 +void DoLshFP 424,11903 +void DoLshIM 425,11923 +void DoLshLP 426,11943 +void DoLshSP 427,11963 +void DoLshcBignumStepFP 428,11983 +void DoLshcBignumStepIM 429,12014 +void DoLshcBignumStepLP 430,12045 +void DoLshcBignumStepSP 431,12076 +void DoMaxFP 432,12107 +void DoMaxIM 433,12127 +void DoMaxLP 434,12147 +void DoMaxSP 435,12167 +void DoMemberFP 436,12187 +void DoMemberIM 437,12210 +void DoMemberLP 438,12233 +void DoMemberSP 439,12256 +void DoMemoryReadFP 440,12279 +void DoMemoryReadIM 441,12306 +void DoMemoryReadLP 442,12333 +void DoMemoryReadSP 443,12360 +void DoMemoryWriteFP 444,12387 +void DoMemoryWriteIM 445,12415 +void DoMemoryWriteLP 446,12443 +void DoMemoryWriteSP 447,12471 +void DoMergeCdrNoPopFP 448,12499 +void DoMergeCdrNoPopIM 449,12529 +void DoMergeCdrNoPopLP 450,12559 +void DoMergeCdrNoPopSP 451,12589 +void DoMessageDispatchFP 452,12619 +void DoMessageDispatchIM 453,12651 +void DoMessageDispatchLP 454,12683 +void DoMessageDispatchSP 455,12715 +void DoMinFP 456,12747 +void DoMinIM 457,12767 +void DoMinLP 458,12787 +void DoMinSP 459,12807 +void DoMinuspFP 460,12827 +void DoMinuspIM 461,12850 +void DoMinuspLP 462,12873 +void DoMinuspSP 463,12896 +void DoMovemFP 464,12919 +void DoMovemIM 465,12941 +void DoMovemInstanceVariableFP 466,12963 +void DoMovemInstanceVariableIM 467,13001 +void DoMovemInstanceVariableLP 468,13039 +void DoMovemInstanceVariableOrderedFP 469,13077 +void DoMovemInstanceVariableOrderedIM 470,13122 +void DoMovemInstanceVariableOrderedLP 471,13167 +void DoMovemInstanceVariableOrderedSP 472,13212 +void DoMovemInstanceVariableSP 473,13257 +void DoMovemLP 474,13295 +void DoMovemLexicalVarNFP 475,13317 +void DoMovemLexicalVarNIM 476,13350 +void DoMovemLexicalVarNLP 477,13383 +void DoMovemLexicalVarNSP 478,13416 +void DoMovemSP 479,13449 +void DoMultiplyBignumStepFP 480,13471 +void DoMultiplyBignumStepIM 481,13506 +void DoMultiplyBignumStepLP 482,13541 +void DoMultiplyBignumStepSP 483,13576 +void DoMultiplyDoubleFP 484,13611 +void DoMultiplyDoubleIM 485,13642 +void DoMultiplyDoubleLP 486,13673 +void DoMultiplyDoubleSP 487,13704 +void DoMultiplyFP 488,13735 +void DoMultiplyIM 489,13760 +void DoMultiplyLP 490,13785 +void DoMultiplySP 491,13810 +void DoNoOpFP 492,13835 +void DoNoOpIM 493,13856 +void DoNoOpLP 494,13877 +void DoNoOpSP 495,13898 +void DoPDpbFP 496,13919 +void DoPDpbIM 497,13940 +void DoPDpbLP 498,13961 +void DoPDpbSP 499,13982 +void DoPLdbFP 500,14003 +void DoPLdbIM 501,14024 +void DoPLdbLP 502,14045 +void DoPLdbSP 503,14066 +void DoPStoreContentsFP 504,14087 +void DoPStoreContentsIM 505,14118 +void DoPStoreContentsLP 506,14149 +void DoPStoreContentsSP 507,14180 +void DoPTagDpbFP 508,14211 +void DoPTagDpbIM 509,14235 +void DoPTagDpbLP 510,14259 +void DoPTagDpbSP 511,14283 +void DoPTagLdbFP 512,14307 +void DoPTagLdbIM 513,14331 +void DoPTagLdbLP 514,14355 +void DoPTagLdbSP 515,14379 +void DoPluspFP 516,14403 +void DoPluspIM 517,14425 +void DoPluspLP 518,14447 +void DoPluspSP 519,14469 +void DoPointerDifferenceFP 520,14491 +void DoPointerDifferenceIM 521,14525 +void DoPointerDifferenceLP 522,14559 +void DoPointerDifferenceSP 523,14593 +void DoPointerIncrementFP 524,14627 +void DoPointerIncrementIM 525,14660 +void DoPointerIncrementLP 526,14693 +void DoPointerIncrementSP 527,14726 +void DoPointerPlusFP 528,14759 +void DoPointerPlusIM 529,14787 +void DoPointerPlusLP 530,14815 +void DoPointerPlusSP 531,14843 +void DoPopFP 532,14871 +void DoPopIM 533,14891 +void DoPopInstanceVariableFP 534,14911 +void DoPopInstanceVariableIM 535,14947 +void DoPopInstanceVariableLP 536,14983 +void DoPopInstanceVariableOrderedFP 537,15019 +void DoPopInstanceVariableOrderedIM 538,15062 +void DoPopInstanceVariableOrderedLP 539,15105 +void DoPopInstanceVariableOrderedSP 540,15148 +void DoPopInstanceVariableSP 541,15191 +void DoPopLP 542,15227 +void DoPopLexicalVarNFP 543,15247 +void DoPopLexicalVarNIM 544,15278 +void DoPopLexicalVarNLP 545,15309 +void DoPopLexicalVarNSP 546,15340 +void DoPopSP 547,15371 +void DoPushAddressFP 548,15391 +void DoPushAddressIM 549,15419 +void DoPushAddressInstanceVariableFP 550,15447 +void DoPushAddressInstanceVariableIM 551,15491 +void DoPushAddressInstanceVariableLP 552,15535 +void DoPushAddressInstanceVariableOrderedFP 553,15579 +void DoPushAddressInstanceVariableOrderedIM 554,15630 +void DoPushAddressInstanceVariableOrderedLP 555,15681 +void DoPushAddressInstanceVariableOrderedSP 556,15732 +void DoPushAddressInstanceVariableSP 557,15783 +void DoPushAddressLP 558,15827 +void DoPushAddressSP 559,15855 +void DoPushAddressSpRelativeFP 560,15883 +void DoPushAddressSpRelativeIM 561,15921 +void DoPushAddressSpRelativeLP 562,15959 +void DoPushAddressSpRelativeSP 563,15997 +void DoPushFP 564,16035 +void DoPushGlobalLogicVariableFP 565,16056 +void DoPushGlobalLogicVariableIM 566,16096 +void DoPushGlobalLogicVariableLP 567,16136 +void DoPushGlobalLogicVariableSP 568,16176 +void DoPushIM 569,16216 +void DoPushInstanceVariableFP 570,16237 +void DoPushInstanceVariableIM 571,16274 +void DoPushInstanceVariableLP 572,16311 +void DoPushInstanceVariableOrderedFP 573,16348 +void DoPushInstanceVariableOrderedIM 574,16392 +void DoPushInstanceVariableOrderedLP 575,16436 +void DoPushInstanceVariableOrderedSP 576,16480 +void DoPushInstanceVariableSP 577,16524 +void DoPushLP 578,16561 +void DoPushLexicalVarNFP 579,16582 +void DoPushLexicalVarNIM 580,16614 +void DoPushLexicalVarNLP 581,16646 +void DoPushLexicalVarNSP 582,16678 +void DoPushLocalLogicVariablesFP 583,16710 +void DoPushLocalLogicVariablesIM 584,16750 +void DoPushLocalLogicVariablesLP 585,16790 +void DoPushLocalLogicVariablesSP 586,16830 +void DoPushNNilsFP 587,16870 +void DoPushNNilsIM 588,16896 +void DoPushNNilsLP 589,16922 +void DoPushNNilsSP 590,16948 +void DoPushSP 591,16974 +void DoQuotientFP 592,16995 +void DoQuotientIM 593,17020 +void DoQuotientLP 594,17045 +void DoQuotientSP 595,17070 +void DoRationalQuotientFP 596,17095 +void DoRationalQuotientIM 597,17128 +void DoRationalQuotientLP 598,17161 +void DoRationalQuotientSP 599,17194 +void DoReadInternalRegisterFP 600,17227 +void DoReadInternalRegisterIM 601,17264 +void DoReadInternalRegisterLP 602,17301 +void DoReadInternalRegisterSP 603,17338 +void DoRestoreBindingStackFP 604,17375 +void DoRestoreBindingStackIM 605,17411 +void DoRestoreBindingStackLP 606,17447 +void DoRestoreBindingStackSP 607,17483 +void DoReturnKludgeFP 608,17519 +void DoReturnKludgeIM 609,17548 +void DoReturnKludgeLP 610,17577 +void DoReturnKludgeSP 611,17606 +void DoReturnMultipleFP 612,17635 +void DoReturnMultipleIM 613,17666 +void DoReturnMultipleLP 614,17697 +void DoReturnMultipleSP 615,17728 +void DoReturnSingleFP 616,17759 +void DoReturnSingleIM 617,17788 +void DoReturnSingleLP 618,17817 +void DoReturnSingleSP 619,17846 +void DoRgetfFP 620,17875 +void DoRgetfIM 621,17897 +void DoRgetfLP 622,17919 +void DoRgetfSP 623,17941 +void DoRotFP 624,17963 +void DoRotIM 625,17983 +void DoRotLP 626,18003 +void DoRotSP 627,18023 +void DoRoundFP 628,18043 +void DoRoundIM 629,18065 +void DoRoundLP 630,18087 +void DoRoundSP 631,18109 +void DoRplacaFP 632,18131 +void DoRplacaIM 633,18154 +void DoRplacaLP 634,18177 +void DoRplacaSP 635,18200 +void DoRplacdFP 636,18223 +void DoRplacdIM 637,18246 +void DoRplacdLP 638,18269 +void DoRplacdSP 639,18292 +void DoSetCdrCode1FP 640,18315 +void DoSetCdrCode1IM 641,18343 +void DoSetCdrCode1LP 642,18371 +void DoSetCdrCode1SP 643,18399 +void DoSetCdrCode2FP 644,18427 +void DoSetCdrCode2IM 645,18455 +void DoSetCdrCode2LP 646,18483 +void DoSetCdrCode2SP 647,18511 +void DoSetSpToAddressFP 648,18539 +void DoSetSpToAddressIM 649,18570 +void DoSetSpToAddressLP 650,18601 +void DoSetSpToAddressSP 651,18632 +void DoSetSpToAddressSaveTosFP 652,18663 +void DoSetSpToAddressSaveTosIM 653,18701 +void DoSetSpToAddressSaveTosLP 654,18739 +void DoSetSpToAddressSaveTosSP 655,18777 +void DoSetTagFP 656,18815 +void DoSetTagIM 657,18838 +void DoSetTagLP 658,18861 +void DoSetTagSP 659,18884 +void DoSetToCarFP 660,18907 +void DoSetToCarIM 661,18932 +void DoSetToCarLP 662,18957 +void DoSetToCarSP 663,18982 +void DoSetToCdrFP 664,19007 +void DoSetToCdrIM 665,19032 +void DoSetToCdrLP 666,19057 +void DoSetToCdrPushCarFP 667,19082 +void DoSetToCdrPushCarIM 668,19114 +void DoSetToCdrPushCarLP 669,19146 +void DoSetToCdrPushCarSP 670,19178 +void DoSetToCdrSP 671,19210 +void DoSetup1DArrayFP 672,19235 +void DoSetup1DArrayIM 673,19264 +void DoSetup1DArrayLP 674,19293 +void DoSetup1DArraySP 675,19322 +void DoSetupForce1DArrayFP 676,19351 +void DoSetupForce1DArrayIM 677,19385 +void DoSetupForce1DArrayLP 678,19419 +void DoSetupForce1DArraySP 679,19453 +void DoSpareOpFP 680,19487 +void DoSpareOpIM 681,19511 +void DoSpareOpLP 682,19535 +void DoSpareOpSP 683,19559 +void DoStackBltAddressFP 684,19583 +void DoStackBltAddressIM 685,19615 +void DoStackBltAddressLP 686,19647 +void DoStackBltAddressSP 687,19679 +void DoStackBltFP 688,19711 +void DoStackBltIM 689,19736 +void DoStackBltLP 690,19761 +void DoStackBltSP 691,19786 +void DoStartCallFP 692,19811 +void DoStartCallIM 693,19837 +void DoStartCallLP 694,19863 +void DoStartCallSP 695,19889 +void DoStoreArrayLeaderFP 696,19915 +void DoStoreArrayLeaderIM 697,19948 +void DoStoreArrayLeaderLP 698,19981 +void DoStoreArrayLeaderSP 699,20014 +void DoStoreConditionalFP 700,20047 +void DoStoreConditionalIM 701,20080 +void DoStoreConditionalLP 702,20113 +void DoStoreConditionalSP 703,20146 +void DoSubBignumStepFP 704,20179 +void DoSubBignumStepIM 705,20209 +void DoSubBignumStepLP 706,20239 +void DoSubBignumStepSP 707,20269 +void DoSubFP 708,20299 +void DoSubIM 709,20319 +void DoSubLP 710,20339 +void DoSubSP 711,20359 +void DoTagFP 712,20379 +void DoTagIM 713,20399 +void DoTagLP 714,20419 +void DoTagSP 715,20439 +void DoTakeValuesFP 716,20459 +void DoTakeValuesIM 717,20486 +void DoTakeValuesLP 718,20513 +void DoTakeValuesSP 719,20540 +void DoTruncateFP 720,20567 +void DoTruncateIM 721,20592 +void DoTruncateLP 722,20617 +void DoTruncateSP 723,20642 +void DoTypeMemberFP 724,20667 +void DoTypeMemberIM 725,20694 +void DoTypeMemberLP 726,20721 +void DoTypeMemberSP 727,20748 +void DoUnaryMinusFP 728,20775 +void DoUnaryMinusIM 729,20802 +void DoUnaryMinusLP 730,20829 +void DoUnaryMinusSP 731,20856 +void DoUnbindNFP 732,20883 +void DoUnbindNIM 733,20907 +void DoUnbindNLP 734,20931 +void DoUnbindNSP 735,20955 +void DoUnifyFP 736,20979 +void DoUnifyIM 737,21001 +void DoUnifyLP 738,21023 +void DoUnifySP 739,21045 +void DoUnsignedLesspFP 740,21067 +void DoUnsignedLesspIM 741,21097 +void DoUnsignedLesspLP 742,21127 +void DoUnsignedLesspSP 743,21157 +void DoWriteInternalRegisterFP 744,21187 +void DoWriteInternalRegisterIM 745,21225 +void DoWriteInternalRegisterLP 746,21263 +void DoWriteInternalRegisterSP 747,21301 +void DoZeropFP 748,21339 +void DoZeropIM 749,21361 +void DoZeropLP 750,21383 +void DoZeropSP 751,21405 +void ICACHEMISS 752,21427 +void ReadRegisterAluAndRotateControl 753,21450 +void ReadRegisterBARx 754,21494 +void ReadRegisterBindingStackLimit 755,21523 +void ReadRegisterBindingStackPointer 756,21565 +void ReadRegisterCRArgumentSize 757,21609 +void ReadRegisterCatchBlockList 758,21648 +void ReadRegisterChipRevision 759,21687 +void ReadRegisterChoicePointer 760,21724 +void ReadRegisterConstantNIL 761,21762 +void ReadRegisterConstantT 762,21798 +void ReadRegisterContinuation 763,21832 +void ReadRegisterControlRegister 764,21869 +void ReadRegisterControlStackExtraLimit 765,21909 +void ReadRegisterControlStackLimit 766,21956 +void ReadRegisterCountMapReloads 767,21998 +void ReadRegisterDynamicBindingCacheBase 768,22038 +void ReadRegisterDynamicBindingCacheMask 769,22086 +void ReadRegisterEphemeralOldspaceRegister 770,22134 +void ReadRegisterError 771,22184 +void ReadRegisterEventCount 772,22214 +void ReadRegisterFEPModeTrapVectorAddress 773,22249 +void ReadRegisterFP 774,22298 +void ReadRegisterFPCoprocessorPresent 775,22325 +void ReadRegisterIcacheControl 776,22370 +void ReadRegisterLP 777,22408 +void ReadRegisterListCacheAddress 778,22435 +void ReadRegisterListCacheArea 779,22476 +void ReadRegisterListCacheLength 780,22514 +void ReadRegisterMapCacheControl 781,22554 +void ReadRegisterMemoryControl 782,22594 +void ReadRegisterMicrosecondClock 783,22632 +void ReadRegisterPHTBase 784,22673 +void ReadRegisterPHTMask 785,22705 +void ReadRegisterPreemptRegister 786,22737 +void ReadRegisterPrefetcherControl 787,22777 +void ReadRegisterSP 788,22819 +void ReadRegisterStackCacheDumpQuantum 789,22846 +void ReadRegisterStackCacheLowerBound 790,22892 +void ReadRegisterStackCacheOverflowLimit 791,22937 +void ReadRegisterStackFrameMaximumSize 792,22985 +void ReadRegisterStructureCacheAddress 793,23031 +void ReadRegisterStructureCacheArea 794,23077 +void ReadRegisterStructureCacheLength 795,23120 +void ReadRegisterStructureStackChoicePointer 796,23165 +void ReadRegisterTOS 797,23217 +void ReadRegisterZoneOldspaceRegister 798,23245 +void WriteRegisterAluAndRotateControl 799,23290 +void WriteRegisterBARx 800,23335 +void WriteRegisterBindingStackLimit 801,23365 +void WriteRegisterBindingStackPointer 802,23408 +void WriteRegisterCatchBlockList 803,23453 +void WriteRegisterChoicePointer 804,23493 +void WriteRegisterContinuation 805,23532 +void WriteRegisterControlRegister 806,23570 +void WriteRegisterControlStackExtraLimit 807,23611 +void WriteRegisterControlStackLimit 808,23659 +void WriteRegisterDynamicBindingCacheBase 809,23702 +void WriteRegisterDynamicBindingCacheMask 810,23751 +void WriteRegisterEphemeralOldspaceRegister 811,23800 +void WriteRegisterError 812,23851 +void WriteRegisterEventCount 813,23882 +void WriteRegisterFEPModeTrapVectorAddress 814,23918 +void WriteRegisterFP 815,23968 +void WriteRegisterFPCoprocessorPresent 816,23996 +void WriteRegisterLP 817,24042 +void WriteRegisterListCacheAddress 818,24070 +void WriteRegisterListCacheArea 819,24112 +void WriteRegisterListCacheLength 820,24151 +void WriteRegisterMappingTableCache 821,24192 +void WriteRegisterPreemptRegister 822,24235 +void WriteRegisterSP 823,24276 +void WriteRegisterStackCacheLowerBound 824,24304 +void WriteRegisterStackCacheOverflowLimit 825,24350 +void WriteRegisterStructureCacheAddress 826,24399 +void WriteRegisterStructureCacheArea 827,24446 +void WriteRegisterStructureCacheLength 828,24490 +void WriteRegisterStructureStackChoicePointer 829,24536 +void WriteRegisterTOS 830,24589 +void WriteRegisterZoneOldspaceRegister 831,24618 +void boundlocationfw 832,24664 +void callcompiledeven 833,24692 +void callcompiledevenprefetch 834,24721 +void callcompiledodd 835,24758 +void callcompiledoddprefetch 836,24786 +void callgeneric 837,24822 +void callgenericprefetch 838,24846 +void callindirect 839,24878 +void callindirectprefetch 840,24903 +void elementforwardfw 841,24936 +void gcforwardfw 842,24965 +void headerforwardfw 843,24989 +void headerifw 844,25017 +void headerpfw 845,25039 +void logicvariablefw 846,25061 +void monitorforwardfw 847,25089 +void nativeinstruction 848,25118 +void nullfw 849,25148 +void oneqforwardfw 850,25167 +void pushconstantvalue 851,25193 +void resumeemulated 852,25223 +void valuecell 853,25250 + +emulator/interfac.c,1629 +#define MAP_ANONYMOUS 11,175 +#define SetIvoryWord(31,655 +PROCESSORSTATEP processor=44,1377 +char *haltreason haltreason46,1410 +void ill_handler 75,2476 +void ill_handler 80,2642 +void ill_handler 85,2826 +void ill_handler 90,3011 +void ill_handler 95,3175 +void ill_handler 100,3338 +void fpe_handler 109,3618 +void fpe_handler 114,3790 +void fpe_handler 124,4038 +void fpe_handler 140,4545 +void fpe_handler 145,4714 +int InstructionSequencer 151,4864 +int FIBTestCode 213,6774 +#define WriteControlArgumentSize(234,7364 +#define WriteControlCallerFrameSize(235,7435 +void PushOneFakeFrame 237,7510 +#define ReadControlArgumentSize(259,8359 +#define ReadControlCallerFrameSize(260,8403 +void PopOneFakeFrame 262,8458 +void InitializeFIBTest 275,8954 +void InitializeTestFunction 299,9670 +void MakeArrayFromBits 321,10369 +static int first_time 334,10705 +#define ALPHAPAGESIZE 342,11094 +static int *debugcopymat;debugcopymat344,11122 +void CheckMat 346,11149 +static void ComputeSpeed 362,11556 +#define timebase(381,12164 +volatile int gotit 386,12292 +static void alarm_handler 388,12317 +static void ComputeSpeed 392,12410 +static void ComputeSpeed 408,12893 +static void RunPOST 427,13482 +void InitializeIvoryProcessor 469,14775 +int Runningp 711,24194 +void HaltMachine 716,24250 +void ResetMachine 725,24415 +void StartMachine 731,24516 +int IvoryProcessorSystemStartup 739,24683 +void SendInterruptToEmulator 762,25378 +#define SCAtoVMA(770,25586 +#define VMAtoSCA(773,25743 +#define HWPCtoPC(781,26095 +#define PCtoHWPC(783,26204 +LispObj WriteInternalRegister 786,26312 +LispObj ReadInternalRegister 929,31307 + +emulator/interpds.c,1021 +int icachesize 29,785 +int stackcachesize 30,853 +LispObjRecordp stackcache=31,914 +CACHELINEP instructioncache=32,979 +int MemoryActionTable[MemoryActionTable40,1157 +static char *halfwordnames halfwordnames607,35252 +static char *fullwordnames fullwordnames867,59141 +#define MUNGEDADDR(919,61664 +void *_copyhalfworddispatch[_copyhalfworddispatch921,61720 +void *_copyfullworddispatch[_copyfullworddispatch922,61756 +char *GetNameOfInterpreterEntryPoint GetNameOfInterpreterEntryPoint924,61790 +void DumpInstructionUsageData 940,62254 +void ResetIcacheMissHistory 979,63397 +void DumpIcacheMissHistory 989,63691 +char *trapnames trapnames1020,64639 +void DumpTrapData 1043,65129 +void ResetTrapData 1056,65483 +#define FLUSHICACHE 1066,65677 +#define FLUSHSTACKCACHE 1067,65848 +void flushicache 1069,65933 +#define ALPHAPAGESIZE 1075,65999 +void InitializeInstructionCache 1077,66027 +void InitializeStatistics 1109,67372 +void InitializeIvoryInterpreterState 1116,67500 +void InitializeStackCache 1127,67716 + +emulator/memory.c,3780 +#define MAP_ANONYMOUS 7,109 +#define ceiling(21,431 +Integer memory_vma;26,563 +int mprotect_result;27,583 +Tag *TagSpace TagSpace31,669 +Integer *DataSpace DataSpace33,805 +Tag *TagSpace TagSpace36,929 +Integer *DataSpace DataSpace38,1065 +Tag *TagSpace TagSpace41,1190 +Integer *DataSpace DataSpace43,1326 +Tag *TagSpace TagSpace46,1430 +Integer *DataSpace DataSpace48,1566 +Tag *TagSpace TagSpace51,1668 +Integer *DataSpace DataSpace53,1818 +typedef Integer PHTEntry;58,1993 +#define ResidentPages_Size 59,2019 +static PHTEntry ResidentPages[ResidentPages61,2053 +static PHTEntry *ResidentPagesPointer ResidentPagesPointer62,2129 +static Boolean ResidentPagesWrap 63,2184 +#define VMAinStackCacheP(65,2227 +#define MemoryPageNumber(73,2513 +#define MemoryPageOffset(74,2578 +#define PageNumberMemory(75,2640 +VMAttribute VMAttributeTable[VMAttributeTable78,2778 +#define Created(80,2842 +#define fault_mask 81,2913 +#define DefaultAttributes(82,3012 +void SetCreated(84,3185 +void ClearCreated(89,3311 +#define MemoryWad_AddressShift 97,3514 +#define MemoryWad_Size 98,3585 +#define MemoryWadNumber(99,3653 +#define MemoryWadOffset(100,3716 +#define WadNumberMemory(101,3776 +#define WadExistsMask 103,3840 +#define WadCreated(104,3926 +#define EphemeralAddressP(106,4021 +#define EphemeralDemiLevel(107,4067 +#define EphemeralLevelNumber(108,4111 +#define AddressZoneNumber(109,4164 +#define TagType(110,4214 +Integer EnsureVirtualAddress 114,4284 +Integer DestroyVirtualAddress 160,5752 +Integer EnsureVirtualAddressRange 194,6465 +Integer DestroyVirtualAddressRange 205,6750 +static int unmapped_world_words 220,7049 +static int mapped_world_words 221,7086 +static int file_map_entries 222,7121 +static int swap_map_entries 223,7154 +Integer MapWorldLoad(225,7188 +Integer* MapVirtualAddressData(314,10333 +Tag* MapVirtualAddressTag(320,10410 +LispObj VirtualMemoryReadUncached 325,10480 +LispObj VirtualMemoryRead 353,11270 +void VirtualMemoryWriteUncached 363,11585 +void VirtualMemoryWrite 389,12370 +void VirtualMemoryReadBlockUncached 400,12731 +void VirtualMemoryReadBlock 412,13060 +void VirtualMemoryWriteBlockUncached 433,13664 +void VirtualMemoryWriteBlock 448,14028 +void VirtualMemoryWriteBlockConstantUncached 470,14647 +void VirtualMemoryWriteBlockConstant 499,15440 +Boolean VirtualMemorySearch 523,16267 +Boolean VirtualMemoryCopy 549,16775 +void VirtualMemoryEnable 567,17584 +Boolean VirtualMemorySearchCDR(631,19588 +Boolean VirtualMemorySearchType(688,21103 +Boolean VirtualMemoryCopyandForward 745,22664 +# define PointerP(772,23534 +# define ZoneOldspaceP(773,23589 +# define EphemeralOldspaceP(775,23719 +static Integer slowdata;777,23801 +static Byte slowtag;778,23826 +static Integer previousslowvma,779,23847 +static Integer previousslowvma, lastslowvma;779,23847 +Boolean SlowScanPage(782,23913 +Boolean ScanPage(834,25236 +Boolean VirtualMemoryScan 935,28072 +Boolean VirtualMemoryPHTScan 1041,31222 +static PHTEntry *ResidentPagesScan ResidentPagesScan1079,32341 +Boolean VirtualMemoryResidentScan 1081,32394 +VMState VM;1119,33273 +int VMCommand(1121,33286 +static int ComputeProtection(1278,37873 +void AdjustProtection(1299,38640 +#define OK 1333,39584 +#define NO 1334,39597 +static jmp_buf trap_environment;1336,39612 +static void simple_segv_handler 1339,39687 +static int mvalid 1344,39807 +static caddr_t last_vma 1390,40840 +static int times 1391,40872 +void segv_handler 1399,41012 +#define OPCODE_MASK 1469,43074 +#define OPCODE_LBZ 1470,43105 +#define OPCODE_STB 1471,43136 +void segv_handler 1473,43168 +void segv_handler 1546,45334 +#define CALL_SIZE 1548,45403 +#define OPCODE_MASK 1632,48021 +#define OPCODE_LBZ 1633,48052 +#define OPCODE_STB 1634,48083 +void segv_handler 1636,48115 +void segv_handler 1711,50320 + +life-support/cold_load.c,4710 +#define _GNU_SOURCE5,74 +int manage_run_lights 34,594 +int run_lights_state;35,621 +#define RUN_LIGHT_Y_SPACE 42,728 +#define RUN_LIGHT_Y_OFFSET 43,811 +#define RUN_LIGHT_WIDTH 47,1031 +#define RUN_LIGHT_SPACING 48,1058 +#define DISK_RUN_LIGHT 50,1088 +#define PROCESS_RUN_LIGHT 51,1113 +#define NETWORK_RUN_LIGHT 52,1141 +#define NETBOOT_PROGRESS_BAR 53,1169 +static EmbColdLoadChannel *cold_channel cold_channel55,1201 +static EmbQueue *keyboard_queue keyboard_queue56,1249 +static Display *display display58,1313 +static KeySym *orig_meta,orig_meta59,1345 +static KeySym *orig_meta, *orig_hyper orig_hyper59,1345 +static int ks_p_kc_meta,60,1385 +static int ks_p_kc_meta, ks_p_kc_hyper 60,1385 +static Screen *screen;screen61,1426 +static Visual *visual;visual62,1449 +static Window window,63,1472 +static Window window, icon_window,63,1472 +static Window window, icon_window, root;63,1472 +static Colormap colormap;64,1513 +static GC gc,65,1539 +static GC gc, icon_gc,65,1539 +static GC gc, icon_gc, icon_gc_s,65,1539 +static GC gc, icon_gc, icon_gc_s, icon_gc_c,65,1539 +static GC gc, icon_gc, icon_gc_s, icon_gc_c, icon_gc_t;65,1539 +static Pixmap icon_bitmap 66,1595 +static XModifierKeymap *originalModmap originalModmap67,1646 +static int icon_width 68,1693 +static int char_width,69,1739 +static int char_width, char_height,69,1739 +static int char_width, char_height, width 69,1739 +static int loff,70,1798 +static int loff, toff,70,1798 +static int loff, toff, roff,70,1798 +static int loff, toff, roff, boff;70,1798 +static int lmarg 71,1833 +static int current_x 72,1889 +static int cursor_visible 73,1930 +static int visibility 74,2015 +static int run_light_y,75,2063 +static int run_light_y, run_light_first_x,75,2063 +static int run_light_y, run_light_first_x, run_label_y;75,2063 +static int progress_bar_first_x,76,2119 +static int progress_bar_first_x, progress_bar_width,76,2119 +static int progress_bar_first_x, progress_bar_width, run_label_width,76,2119 +static int progress_bar_first_x, progress_bar_width, run_label_width, run_label_height;76,2119 +static int progress_bar_numerator_state 77,2207 +static int progress_bar_length_state 78,2288 +static char *progress_label progress_label79,2353 +static int meta_mask 80,2389 +static int did_show 82,2512 + int length;85,2555 + char *chars;chars86,2569 +} line;87,2584 +static line *screen_array screen_array89,2593 +static enum KeyboardType keyboardType 90,2627 +static coldmapentry *skMap skMap91,2676 +static short *fkMap fkMap92,2711 +static int removeNumLockModifier 93,2739 +enum xcbvals 95,2783 +enum xcbvals { XcbUnknown,95,2783 +enum xcbvals { XcbUnknown, XcbLoaded,95,2783 +enum xcbvals { XcbUnknown, XcbLoaded, XcbNotLoaded 95,2783 +enum xcbvals { XcbUnknown, XcbLoaded, XcbNotLoaded } haveXcb 95,2783 +#define show_cursor(148,5515 +static XModifierKeymap *remove_modifier remove_modifier151,5590 +static void make_map 169,6177 +static int open_cold_load_display 229,7977 +static int manage_x_input 240,8200 +static void manage_cold_load_output 249,8384 +static int setup_x_io_error_handler 292,9392 +static void stop_cold_x 299,9491 +static char *in_addr_to_string(in_addr_to_string312,9766 +int check_display(319,9922 +int check_keyboard 355,10796 +static int open_display 400,11872 +static void close_display 652,17918 +static void handle_input 698,18910 +static void alloc_screen_array 881,23478 +static void redisplay_line 938,25341 +static void redisplay_screen_array 959,25842 +static void show_cursor_internal 976,26288 +static void hide_cursor 1006,26971 +static void show_icon 1026,27310 +static void show_lights 1073,28062 +static void reset_light_state 1259,33130 +static void replay_command_history 1274,33430 +static void handle_output_command 1302,34070 +static void get_keyboard_modifier_codes 1394,36405 +static int find_modifier 1546,41556 +static int find_unused_modifier 1559,41869 +static int do_modifier 1595,42725 +static int mask_to_modifier 1632,43609 +static int setup_modifier_mapping 1643,43718 +static void ColdLoadOutput 1745,46587 +#define POLLWAIT_IN_MS 1753,46740 +static void ColdLoadInput 1755,46767 +static char *ColdLoadWindowName ColdLoadWindowName1799,47800 +static enum GuestStatus lastGuestStatus 1804,47936 +static char *concatenate_string(concatenate_string1806,48003 +static void SetupColdLoadNameStrings 1817,48315 +static void SetColdLoadNames 1876,49912 +void UpdateColdLoadNames 1890,50279 +static pthread_t plightsThread 1900,50500 +static void* lightsThread 1902,50534 +#define LIGHT_SLEEP 1908,50797 +int InitializeColdLoadChannel 1932,51253 +void ResetColdLoadChannel 1981,53068 +void TerminateColdLoadChannel 1996,53680 +void cold_load_init(2013,54214 + +life-support/console.c,844 +#define _GNU_SOURCE4,83 +void InitializeConsoleChannel 34,581 +void DoConsoleIO 81,2767 +void ConsoleDriver 139,4227 +void ConsoleOutput 169,5026 +void ConsoleInput 175,5189 +int OpenDisplay 183,5366 +int ProcessConnectionRequest 237,6875 +void AdvanceOpeningState 357,11248 +int ConsoleWrite 464,14084 +int ConsoleRead 519,15425 +boolean ConsoleInputAvailableP 576,16907 +int ConsoleInputWait 597,17439 +extern enum xcbvals 638,18346 +extern enum xcbvals { XcbUnknown,638,18346 +extern enum xcbvals { XcbUnknown, XcbLoaded,638,18346 +extern enum xcbvals { XcbUnknown, XcbLoaded, XcbNotLoaded 638,18346 +void CloseDisplay 640,18422 +void EnableRunLights 678,19537 +#define OneOneHundrethSecond 719,20845 +void DrawRunLights 721,20885 +void DisableRunLights 777,22658 +void ResetConsoleChannel 799,23063 +void TerminateConsoleChannel 813,23471 + +life-support/disks.c,366 +#define S_DEFFILEMODE 23,381 +#define DiskPageSize 26,461 +#define SetHostState(29,489 +#define HostState(35,637 +void AttachDiskChannel 43,978 +void GrowDiskPartition 175,5102 +void DetachDiskChannel 224,6554 +void DiskLife 264,7674 +int DoDiskIO 345,9759 +void ResetDiskChannel 424,11797 +void TerminateDiskChannel 450,12624 +void TerminateDiskChannels 464,12869 + +life-support/initialization.c,749 +#define GeneraMajorVersion 55,1897 +#define GeneraMinorVersion 56,1926 +BootCommArea *BootCommAreaPtr BootCommAreaPtr60,1979 +BootDataArea *BootDataAreaPtr BootDataAreaPtr61,2017 +FEPCommArea *FEPCommAreaPtr FEPCommAreaPtr62,2055 +SystemCommArea *SystemCommAreaPtr SystemCommAreaPtr63,2091 +EmbCommArea *EmbCommAreaPtr EmbCommAreaPtr64,2133 +EmbPtr EmbCommAreaAllocPtr 66,2170 +size_t EmbCommAreaAllocSize 67,2211 +caddr_t dataAddress 69,2245 +caddr_t tagsAddress 70,2273 +size_t areasSize 71,2301 +static pthread_key_t mainThread;73,2324 +EmbPtr EmbCommAreaAlloc 78,2419 +EmbPtr MakeEmbString 99,2958 +void ParseVersionNumber 122,3543 +int InitializeLifeSupport 182,4598 +void TerminateLifeSupport 446,14488 +void SetupThreadAttrs 554,17034 + +life-support/message_channels.c,322 +#define SetSubtypeData(15,235 +#define SubtypeData(21,389 +void InitializeMessageChannels 27,568 +void PollMessageChannels 63,1945 +void ThreadActiveMessageChannel 86,2749 +void UnthreadMessageChannel 109,3465 +void ExecuteGuestCommands 133,4260 +void ResetMessageChannel 200,6442 +void TerminateMessageChannels 243,7929 + +life-support/network-darwin.c,110 +void InitializeNetworkChannels 15,275 +void ResetNetworkChannel 22,363 +void TerminateNetworkChannels 29,452 + +life-support/network-libpcap.c,492 +static EmbNetChannel* pInputChannel;21,417 +void InitializeNetworkChannels 25,490 +static void InitializeNetChannel 53,1344 +void ResetNetworkChannel 158,5170 +static char last_packet[last_packet174,5590 +new_packet(177,5633 +recv_packet(188,5796 +answer_arp(207,6552 +dump_packet(227,6833 +NetworkChannelTransmitter(295,8571 +#define OneMillisecond 360,10972 +static void NetworkChannelReceiver 362,11005 +static void TerminateNetChannel 433,13172 +void TerminateNetworkChannels 459,13783 + +life-support/network-linux.c,551 +static EmbNetChannel* pInputChannel;22,414 +void InitializeNetworkChannels 28,609 +static void InitializeNetChannel 90,2401 +#undef N_FILTERS108,3091 +#define N_FILTERS 109,3108 +void ResetNetworkChannel 440,14321 +static char last_packet[last_packet456,14736 +new_packet(459,14779 +recv_packet(470,14942 +answer_arp(489,15698 +dump_packet(509,15979 +void NetworkChannelTransmitter 576,17692 +#define OneMillisecond 646,19844 +void NetworkChannelReceiver 648,19877 +static void TerminateNetChannel 724,21963 +void TerminateNetworkChannels 753,22596 + +life-support/network-osf.c,394 +#define _NO_BITFIELDS14,277 +void InitializeNetworkChannels 28,531 +static void InitializeNetChannel 63,1738 +void ResetNetworkChannel 298,10105 +static void show_packet(312,10474 +static void NetworkChannelTransmitter 342,11198 +#define OneMillisecond 390,12523 +static void NetworkChannelReceiver 392,12556 +static void TerminateNetChannel 459,14367 +void TerminateNetworkChannels 480,14772 + +life-support/network-tap-linux.c,798 +#define ENV_VLM_TAP 33,562 +#define DEFAULT_INTERFACE 34,592 +#define FAKE_CHAOS_HOST_ADDRESS 35,625 +#define FAKE_INET_HOST_ADDRESS 36,661 +static EmbNetChannel* pInputChannel;43,832 +static void gen_random_mac 69,1491 +static char *makeAddressString makeAddressString89,1843 +static void send_ip_arp_req 149,3372 +static void send_chaos_arp_req 188,4389 +void InitializeNetworkChannels 242,5866 +void ResetNetworkChannel 521,14428 +recv_packet(552,15286 +answer_arp(571,16042 +static char *chaos_opcode chaos_opcode592,16360 +static void dump_packet 620,17130 +void NetworkChannelTransmitter 723,19757 +#define OneMillisecond 926,25936 +#define PollTimeoutInMillis 927,25967 +void NetworkChannelReceiver 929,26000 +void TerminateNetChannel 1048,28943 +void TerminateNetworkChannels 1074,29542 + +life-support/network-tun-linux.c,483 +static EmbNetChannel* pInputChannel;30,533 +void InitializeNetworkChannels 36,720 +void InitializeNetChannel 98,2699 +void ResetNetworkChannel 371,10899 +static char last_packet[last_packet383,11227 +new_packet(386,11270 +recv_packet(397,11433 +answer_arp(416,12189 +dump_packet(436,12470 +void NetworkChannelTransmitter 503,14187 +#define OneMillisecond 578,16035 +void NetworkChannelReceiver 580,16068 +void TerminateNetChannel 673,18480 +void TerminateNetworkChannels 700,19112 + +life-support/polling.c,420 +#define OneSecond 12,178 +#define OneQuarterSecond 13,215 +#define OneEighthSecond 14,252 +#define OneSixteenthSecond 16,328 +#define OneSixteethSecond 17,365 +boolean VLMIsRunning 22,511 +boolean VLMIsRunningLisp 28,674 +void UpdateVLMStatus 34,858 +static void ResetCommArea 74,1894 +void ProcessResetRequest 132,3088 +void IvoryLifePolling 173,4357 +void IntervalTimerDriver 256,7091 +void SetIntervalTimer 311,8871 + +life-support/queues.c,456 +EmbPtr CreateQueue 14,186 +int EmbQueueSpace 31,542 +int EmbQueueFilled 45,795 +void EmbQueuePut 59,1036 +void EmbQueuePutWord 88,1822 +void EmbQueuePutByte 117,2582 +bool EmbQueueTake 146,3328 +EmbWord EmbQueueTakeWord 172,3929 +byte EmbQueueTakeByte 199,4522 +int EmbQueuePutBytes 231,5273 +int EmbQueuePutWords 274,6311 +int EmbQueueTakeBytes 317,7378 +int EmbQueueTakeWords 353,8200 +void ResetIncomingQueue 390,9154 +void ResetOutgoingQueue 406,9520 + +life-support/signals.c,356 +void InitializeSignalHandlers 16,307 +SignalNumber InstallSignalHandler 39,956 +void SendInterruptToLifeSupport 104,3220 +void WaitForLifeSupport 115,3625 +void EmbSendSignal 169,5754 +void SignalLater 200,6679 +void NullSignalHandler 216,7175 +void RemoveSignalHandler 223,7271 +void TerminateSignalHandlers 257,8367 +void SignalHandlerTopLevel 275,8881 + +life-support/signals-ptw.c,408 +void InitializeSignalHandlers 17,330 +SignalNumber InstallSignalHandler 40,979 +void SendInterruptToLifeSupport 102,3225 +void WaitForLifeSupport 113,3630 +void EmbSendSignal 150,5216 +void SignalLater 174,5990 +static void NullSignalHandler 190,6486 +void RemoveSignalHandler 197,6589 +void TerminateSignalHandler 231,7685 +void TerminateSignalHandlers 237,7767 +static void SignalHandlerTopLevel 253,8195 + +life-support/unixcrypt.c,239 +#define MAX_CRYPT_RESULT_SIZE 19,427 +static EmbPtr EmbCryptResult 21,462 +static char cryptResult[cryptResult22,506 +static void allocateResult 24,555 +static char *getLispSimpleString getLispSimpleString32,801 +void UnixCrypt 76,1885 + +other/pfopen.c,131 +static char *rcsid rcsid27,1418 +#define PFPREFIX 38,1723 +#define PFMAXMINORS 39,1787 +pfopen(55,2283 +static int setif(87,3179 + +src/byteswap_world.c,122 +#define CommandName 10,132 +Boolean Trace 12,170 +Boolean EnableIDS 13,193 +Boolean TestFunction 14,220 +int main 16,251 + +src/main.c,225 +#define MBToWords(25,374 +#define WordsToMB(26,423 +Boolean Trace 28,497 +Boolean EnableIDS 29,520 +Boolean TestFunction 30,547 +static pthread_key_t mainThread;31,577 +static void MaybeTerminateVLM 33,611 +int main 92,2262 + +src/spy.c,2179 +#define MemoryPageNumber(30,502 +#define CreatedP(31,567 +#define PageSize 34,658 +#define REMOTE_MEMORY_PACKET_DATA 36,682 +#define MEGABYTES 37,721 + rm_discard,40,759 + rm_noop,41,773 + rm_ack,42,784 + rm_write,43,794 + rm_read,44,806 + rm_system_startup,45,817 + rm_trap,46,838 + rm_boot,47,849 + rm_create_pages,48,860 + rm_mbin,49,879 + rm_stop50,890 + } remote_memory_opcode;51,900 + rm_physical,54,942 + rm_virtual,55,957 + rm_register,56,971 + rm_coprocessor57,986 + } remote_memory_type;58,1003 +struct rm_pkt 60,1028 + unsigned char rm_pad[rm_pad61,1044 + unsigned char rm_id[rm_id62,1071 + unsigned char rm_operand[rm_operand63,1097 + int rm_opcode:rm_opcode64,1128 + unsigned char data[data65,1147 +#define REMOTE_MEMORY_PACKET_HEADER 68,1200 +struct rm_aligned_pkt 70,1240 + unsigned char rm_id[rm_id71,1264 + unsigned char rm_operand[rm_operand72,1290 + int rm_opcode:rm_opcode73,1321 + unsigned char data[data74,1340 +#define REMOTE_MEMORY_ALIGNED_PACKET_HEADER 77,1393 +static int spy 79,1440 +static int send_trap 80,1461 +static pthread_key_t mainThread;81,1487 +static pthread_mutex_t spyLock;83,1521 +static boolean spyLockSetup 84,1553 +static pthread_t spyThread;85,1590 +static boolean spyThreadSetup 86,1618 +EmbMBINChannel *activeMBINChannel activeMBINChannel87,1657 +static struct {unsigned int id;88,1699 +static struct {unsigned int id; boolean acked;88,1699 +static struct {unsigned int id; boolean acked;} MBINHistory[MBINHistory88,1699 +static int divine_port_number(93,1939 +static void bind_a_port(104,2226 +static int spy_transmit 119,2608 +static unsigned int read_long 136,3255 +static void write_long 141,3384 +static struct sockaddr_in trap_sin;149,3541 +static boolean trap_sinValid 150,3577 +static struct sockaddr_in mbin_sin;151,3615 +static boolean mbin_sinValid 152,3651 +static jmp_buf trap_environment;153,3689 +static void segv_handler 156,3764 +static void SpyTopLevel 161,3841 +#define SuspendVLM(176,4332 +#define ResumeVLM(177,4427 +void RemoteMemorySpyLoop 179,4522 +void InitializeSpy 474,12921 +void ReleaseSpyLock 510,13976 +void SendMBINBuffers 516,14126 +void TerminateSpy 567,15896 + +src/utilities.c,1197 +static char* CommandName 22,375 +#define CommandClass 23,412 +static char* CommandName 26,465 +#define CommandClass 27,502 +static char* CommandName 30,556 +#define CommandClass 31,594 +static int PrintMessage 58,1837 +void vpunt 81,2263 +void verror 111,2727 +void vwarn 136,3122 +void SetCommandName 150,3321 +void BuildXDisplayName 162,3575 +void BuildConfiguration 180,4015 +static void GetDefaultConfiguration 211,4809 +static void MaybeReadConfigurationFile 258,6335 +#define BaseOptions 299,7483 +#define BaseOptions 302,7529 +#define BaseOptions 305,7575 +#define TracingOptions 309,7620 +#define TracingOptions 311,7651 +#define OptionsTableSize 314,7684 +static XrmOptionDescRec OptionsTable[OptionsTable316,7737 +static void ProcessCommandArguments 363,10135 +static void InterpretOptions 404,11248 +static void InterpretNetworkOptions 595,16299 +static void InterpretXOptions 799,22102 +static char* MergeSearchPaths 916,25206 +static boolean GetOption 935,25706 +static boolean GetXOption 956,26232 +static boolean VerifyHostName 970,26650 +#define NSECS_IN_USEC 1011,27698 +#define NSECS_IN_SEC 1012,27725 +int pthread_get_expiration_np 1014,27768 +int pthread_delay_np 1043,28481 + +src/world_tools.c,1375 +#define PuntWorld(24,394 +#define PuntWorld2(30,500 +#define PuntWorld3(36,621 +void LoadVLMDebugger 45,806 +Integer LoadWorld 66,1274 +void SaveWorld 98,2044 +boolean OpenWorldFile 191,4931 +void CreateWorldFile 361,9718 +void CloseWorldFile 413,11298 +void ReadLoadMap 478,12534 +Integer LoadMapData 498,13044 +Integer VLMLoadMapData 515,13390 +Integer IvoryLoadMapData 581,15472 +static World* originalWorld 629,16840 +void MergeLoadMaps 631,16877 +static World** worlds 656,17600 +static int totalWorlds 657,17630 +static int nWorlds 658,17658 +static char* scanningDir 660,17683 +void FindParentWorlds 662,17717 +void ScanOneDirectory 733,19465 +int WorldP 762,20150 +void CloseExtraWorlds 840,22456 +void MergeParentLoadMap 866,22803 +static void DumpMap 898,23867 +void MergeAMap 912,24301 +void CanonicalizeVLMLoadMapEntries 1082,30159 +void WriteVLMWorldFileHeader 1157,32745 +void WriteVLMWorldFilePages 1244,36045 +void ReadIvoryWorldFilePage 1321,38373 +void ReadIvoryWorldFileQ 1345,39047 +void ReadIvoryWorldFileNextQ 1380,40275 +void PrepareToWriteIvoryWorldFilePage 1397,40685 +void WriteIvoryWorldFilePage 1407,40967 +void WriteIvoryWorldFileNextQ 1432,41739 +void ReadSwappedVLMWorldFilePage 1469,43019 +void ReadSwappedVLMWorldFileQ 1515,44694 +void ReadSwappedVLMWorldFileNextQ 1537,45500 +void ByteSwapWorld 1554,45897 +void ByteSwapOneWorld 1573,46398 + +stub/blanks.c,27833 +void fake_decodefault(2,1 +void *DECODEFAULT DECODEFAULT3,66 +void fake_icachemiss(4,105 +void *ICACHEMISS ICACHEMISS5,167 +void ARITHMETICEXCEPTION 8,206 +void resumeemulated 11,346 +void CarCdrSubroutine 12,401 +void CarSubroutine 13,460 +void CdrSubroutine 14,513 +void boundlocationfw 16,567 +void callcompiledeven 17,595 +void callcompiledevenprefetch 18,624 +void callcompiledodd 19,661 +void callcompiledoddprefetch 20,689 +void callgeneric 21,725 +void callgenericprefetch 22,749 +void callindirect 23,781 +void callindirectprefetch 24,806 +void elementforwardfw 25,839 +void gcforwardfw 26,868 +void headerforwardfw 27,892 +void headerifw 28,920 +void headerpfw 29,942 +void logicvariablefw 30,964 +void monitorforwardfw 31,992 +void nativeinstruction 32,1021 +void nullfw 33,1051 +void oneqforwardfw 34,1070 +void pushconstantvalue 35,1096 +void valuecell 36,1126 +void Do32BitDifferenceFP 38,1149 +void Do32BitDifferenceIM 39,1181 +void Do32BitDifferenceLP 40,1213 +void Do32BitDifferenceSP 41,1245 +void Do32BitPlusFP 42,1277 +void Do32BitPlusIM 43,1303 +void Do32BitPlusLP 44,1329 +void Do32BitPlusSP 45,1355 +void DoAddBignumStepFP 46,1381 +void DoAddBignumStepIM 47,1411 +void DoAddBignumStepLP 48,1441 +void DoAddBignumStepSP 49,1471 +void DoAddFP 50,1501 +void DoAddIM 51,1521 +void DoAddLP 52,1541 +void DoAddSP 53,1561 +void DoAllocateListBlockFP 54,1581 +void DoAllocateListBlockIM 55,1615 +void DoAllocateListBlockLP 56,1649 +void DoAllocateListBlockSP 57,1683 +void DoAllocateStructureBlockFP 58,1717 +void DoAllocateStructureBlockIM 59,1756 +void DoAllocateStructureBlockLP 60,1795 +void DoAllocateStructureBlockSP 61,1834 +void DoAloc1FP 62,1873 +void DoAloc1IM 63,1895 +void DoAloc1LP 64,1917 +void DoAloc1SP 65,1939 +void DoAlocLeaderFP 66,1961 +void DoAlocLeaderIM 67,1988 +void DoAlocLeaderLP 68,2015 +void DoAlocLeaderSP 69,2042 +void DoAluFP 70,2069 +void DoAluIM 71,2089 +void DoAluLP 72,2109 +void DoAluSP 73,2129 +void DoAref1FP 74,2149 +void DoAref1IM 75,2171 +void DoAref1LP 76,2193 +void DoAref1SP 77,2215 +void DoArrayLeaderFP 78,2237 +void DoArrayLeaderIM 79,2265 +void DoArrayLeaderLP 80,2293 +void DoArrayLeaderSP 81,2321 +void DoAset1FP 82,2349 +void DoAset1IM 83,2371 +void DoAset1LP 84,2393 +void DoAset1SP 85,2415 +void DoAshFP 86,2437 +void DoAshIM 87,2457 +void DoAshLP 88,2477 +void DoAshSP 89,2497 +void DoAssocFP 90,2517 +void DoAssocIM 91,2539 +void DoAssocLP 92,2561 +void DoAssocSP 93,2583 +void DoBindLocativeFP 94,2605 +void DoBindLocativeIM 95,2634 +void DoBindLocativeLP 96,2663 +void DoBindLocativeSP 97,2692 +void DoBindLocativeToValueFP 98,2721 +void DoBindLocativeToValueIM 99,2757 +void DoBindLocativeToValueLP 100,2793 +void DoBindLocativeToValueSP 101,2829 +void DoBlock0ReadAluFP 102,2865 +void DoBlock0ReadAluIM 103,2895 +void DoBlock0ReadAluLP 104,2925 +void DoBlock0ReadAluSP 105,2955 +void DoBlock0ReadFP 106,2985 +void DoBlock0ReadIM 107,3012 +void DoBlock0ReadLP 108,3039 +void DoBlock0ReadSP 109,3066 +void DoBlock0ReadShiftFP 110,3093 +void DoBlock0ReadShiftIM 111,3125 +void DoBlock0ReadShiftLP 112,3157 +void DoBlock0ReadShiftSP 113,3189 +void DoBlock0ReadTestFP 114,3221 +void DoBlock0ReadTestIM 115,3252 +void DoBlock0ReadTestLP 116,3283 +void DoBlock0ReadTestSP 117,3314 +void DoBlock0WriteFP 118,3345 +void DoBlock0WriteIM 119,3373 +void DoBlock0WriteLP 120,3401 +void DoBlock0WriteSP 121,3429 +void DoBlock1ReadAluFP 122,3457 +void DoBlock1ReadAluIM 123,3487 +void DoBlock1ReadAluLP 124,3517 +void DoBlock1ReadAluSP 125,3547 +void DoBlock1ReadFP 126,3577 +void DoBlock1ReadIM 127,3604 +void DoBlock1ReadLP 128,3631 +void DoBlock1ReadSP 129,3658 +void DoBlock1ReadShiftFP 130,3685 +void DoBlock1ReadShiftIM 131,3717 +void DoBlock1ReadShiftLP 132,3749 +void DoBlock1ReadShiftSP 133,3781 +void DoBlock1ReadTestFP 134,3813 +void DoBlock1ReadTestIM 135,3844 +void DoBlock1ReadTestLP 136,3875 +void DoBlock1ReadTestSP 137,3906 +void DoBlock1WriteFP 138,3937 +void DoBlock1WriteIM 139,3965 +void DoBlock1WriteLP 140,3993 +void DoBlock1WriteSP 141,4021 +void DoBlock2ReadAluFP 142,4049 +void DoBlock2ReadAluIM 143,4079 +void DoBlock2ReadAluLP 144,4109 +void DoBlock2ReadAluSP 145,4139 +void DoBlock2ReadFP 146,4169 +void DoBlock2ReadIM 147,4196 +void DoBlock2ReadLP 148,4223 +void DoBlock2ReadSP 149,4250 +void DoBlock2ReadShiftFP 150,4277 +void DoBlock2ReadShiftIM 151,4309 +void DoBlock2ReadShiftLP 152,4341 +void DoBlock2ReadShiftSP 153,4373 +void DoBlock2ReadTestFP 154,4405 +void DoBlock2ReadTestIM 155,4436 +void DoBlock2ReadTestLP 156,4467 +void DoBlock2ReadTestSP 157,4498 +void DoBlock2WriteFP 158,4529 +void DoBlock2WriteIM 159,4557 +void DoBlock2WriteLP 160,4585 +void DoBlock2WriteSP 161,4613 +void DoBlock3ReadAluFP 162,4641 +void DoBlock3ReadAluIM 163,4671 +void DoBlock3ReadAluLP 164,4701 +void DoBlock3ReadAluSP 165,4731 +void DoBlock3ReadFP 166,4761 +void DoBlock3ReadIM 167,4788 +void DoBlock3ReadLP 168,4815 +void DoBlock3ReadSP 169,4842 +void DoBlock3ReadShiftFP 170,4869 +void DoBlock3ReadShiftIM 171,4901 +void DoBlock3ReadShiftLP 172,4933 +void DoBlock3ReadShiftSP 173,4965 +void DoBlock3ReadTestFP 174,4997 +void DoBlock3ReadTestIM 175,5028 +void DoBlock3ReadTestLP 176,5059 +void DoBlock3ReadTestSP 177,5090 +void DoBlock3WriteFP 178,5121 +void DoBlock3WriteIM 179,5149 +void DoBlock3WriteLP 180,5177 +void DoBlock3WriteSP 181,5205 +void DoBranchFP 182,5233 +void DoBranchFalseAndExtraPopFP 183,5256 +void DoBranchFalseAndExtraPopIM 184,5295 +void DoBranchFalseAndExtraPopLP 185,5334 +void DoBranchFalseAndExtraPopSP 186,5373 +void DoBranchFalseAndNoPopElseNoPopExtraPopFP 187,5412 +void DoBranchFalseAndNoPopElseNoPopExtraPopIM 188,5465 +void DoBranchFalseAndNoPopElseNoPopExtraPopLP 189,5518 +void DoBranchFalseAndNoPopElseNoPopExtraPopSP 190,5571 +void DoBranchFalseAndNoPopFP 191,5624 +void DoBranchFalseAndNoPopIM 192,5660 +void DoBranchFalseAndNoPopLP 193,5696 +void DoBranchFalseAndNoPopSP 194,5732 +void DoBranchFalseElseExtraPopFP 195,5768 +void DoBranchFalseElseExtraPopIM 196,5808 +void DoBranchFalseElseExtraPopLP 197,5848 +void DoBranchFalseElseExtraPopSP 198,5888 +void DoBranchFalseElseNoPopFP 199,5928 +void DoBranchFalseElseNoPopIM 200,5965 +void DoBranchFalseElseNoPopLP 201,6002 +void DoBranchFalseElseNoPopSP 202,6039 +void DoBranchFalseExtraPopFP 203,6076 +void DoBranchFalseExtraPopIM 204,6112 +void DoBranchFalseExtraPopLP 205,6148 +void DoBranchFalseExtraPopSP 206,6184 +void DoBranchFalseFP 207,6220 +void DoBranchFalseIM 208,6248 +void DoBranchFalseLP 209,6276 +void DoBranchFalseNoPopFP 210,6304 +void DoBranchFalseNoPopIM 211,6337 +void DoBranchFalseNoPopLP 212,6370 +void DoBranchFalseNoPopSP 213,6403 +void DoBranchFalseSP 214,6436 +void DoBranchIM 215,6464 +void DoBranchLP 216,6487 +void DoBranchSP 217,6510 +void DoBranchTrueAndExtraPopFP 218,6533 +void DoBranchTrueAndExtraPopIM 219,6571 +void DoBranchTrueAndExtraPopLP 220,6609 +void DoBranchTrueAndExtraPopSP 221,6647 +void DoBranchTrueAndNoPopElseNoPopExtraPopFP 222,6685 +void DoBranchTrueAndNoPopElseNoPopExtraPopIM 223,6737 +void DoBranchTrueAndNoPopElseNoPopExtraPopLP 224,6789 +void DoBranchTrueAndNoPopElseNoPopExtraPopSP 225,6841 +void DoBranchTrueAndNoPopFP 226,6893 +void DoBranchTrueAndNoPopIM 227,6928 +void DoBranchTrueAndNoPopLP 228,6963 +void DoBranchTrueAndNoPopSP 229,6998 +void DoBranchTrueElseExtraPopFP 230,7033 +void DoBranchTrueElseExtraPopIM 231,7072 +void DoBranchTrueElseExtraPopLP 232,7111 +void DoBranchTrueElseExtraPopSP 233,7150 +void DoBranchTrueElseNoPopFP 234,7189 +void DoBranchTrueElseNoPopIM 235,7225 +void DoBranchTrueElseNoPopLP 236,7261 +void DoBranchTrueElseNoPopSP 237,7297 +void DoBranchTrueExtraPopFP 238,7333 +void DoBranchTrueExtraPopIM 239,7368 +void DoBranchTrueExtraPopLP 240,7403 +void DoBranchTrueExtraPopSP 241,7438 +void DoBranchTrueFP 242,7473 +void DoBranchTrueIM 243,7500 +void DoBranchTrueLP 244,7527 +void DoBranchTrueNoPopFP 245,7554 +void DoBranchTrueNoPopIM 246,7586 +void DoBranchTrueNoPopLP 247,7618 +void DoBranchTrueNoPopSP 248,7650 +void DoBranchTrueSP 249,7682 +void DoCarFP 250,7709 +void DoCarIM 251,7729 +void DoCarLP 252,7749 +void DoCarSP 253,7769 +void DoCatchCloseFP 254,7789 +void DoCatchCloseIM 255,7816 +void DoCatchCloseLP 256,7843 +void DoCatchCloseSP 257,7870 +void DoCatchOpenFP 258,7897 +void DoCatchOpenIM 259,7923 +void DoCatchOpenLP 260,7949 +void DoCatchOpenSP 261,7975 +void DoCdrFP 262,8001 +void DoCdrIM 263,8021 +void DoCdrLP 264,8041 +void DoCdrSP 265,8061 +void DoCeilingFP 266,8081 +void DoCeilingIM 267,8105 +void DoCeilingLP 268,8129 +void DoCeilingSP 269,8153 +void DoCharDpbFP 270,8177 +void DoCharDpbIM 271,8201 +void DoCharDpbLP 272,8225 +void DoCharDpbSP 273,8249 +void DoCharLdbFP 274,8273 +void DoCharLdbIM 275,8297 +void DoCharLdbLP 276,8321 +void DoCharLdbSP 277,8345 +void DoCheckPreemptRequestFP 278,8369 +void DoCheckPreemptRequestIM 279,8405 +void DoCheckPreemptRequestLP 280,8441 +void DoCheckPreemptRequestSP 281,8477 +void DoCoprocessorReadFP 282,8513 +void DoCoprocessorReadIM 283,8545 +void DoCoprocessorReadLP 284,8577 +void DoCoprocessorReadSP 285,8609 +void DoCoprocessorWriteFP 286,8641 +void DoCoprocessorWriteIM 287,8674 +void DoCoprocessorWriteLP 288,8707 +void DoCoprocessorWriteSP 289,8740 +void DoDecrementFP 290,8773 +void DoDecrementIM 291,8799 +void DoDecrementLP 292,8825 +void DoDecrementSP 293,8851 +void DoDereferenceFP 294,8877 +void DoDereferenceIM 295,8905 +void DoDereferenceLP 296,8933 +void DoDereferenceSP 297,8961 +void DoDivideBignumStepFP 298,8989 +void DoDivideBignumStepIM 299,9022 +void DoDivideBignumStepLP 300,9055 +void DoDivideBignumStepSP 301,9088 +void DoDoubleFloatOpFP 302,9121 +void DoDoubleFloatOpIM 303,9151 +void DoDoubleFloatOpLP 304,9181 +void DoDoubleFloatOpSP 305,9211 +void DoDpbFP 306,9241 +void DoDpbIM 307,9261 +void DoDpbLP 308,9281 +void DoDpbSP 309,9301 +void DoEndpFP 310,9321 +void DoEndpIM 311,9342 +void DoEndpLP 312,9363 +void DoEndpSP 313,9384 +void DoEntryRestAcceptedFP 314,9405 +void DoEntryRestAcceptedIM 315,9439 +void DoEntryRestAcceptedLP 316,9473 +void DoEntryRestAcceptedSP 317,9507 +void DoEntryRestNotAcceptedFP 318,9541 +void DoEntryRestNotAcceptedIM 319,9578 +void DoEntryRestNotAcceptedLP 320,9615 +void DoEntryRestNotAcceptedSP 321,9652 +void DoEphemeralpFP 322,9689 +void DoEphemeralpIM 323,9716 +void DoEphemeralpLP 324,9743 +void DoEphemeralpSP 325,9770 +void DoEqFP 326,9797 +void DoEqIM 327,9816 +void DoEqLP 328,9835 +void DoEqSP 329,9854 +void DoEqlFP 330,9873 +void DoEqlIM 331,9893 +void DoEqlLP 332,9913 +void DoEqlSP 333,9933 +void DoEqualNumberFP 334,9953 +void DoEqualNumberIM 335,9981 +void DoEqualNumberLP 336,10009 +void DoEqualNumberSP 337,10037 +void DoFastAref1FP 338,10065 +void DoFastAref1IM 339,10091 +void DoFastAref1LP 340,10117 +void DoFastAref1SP 341,10143 +void DoFastAset1FP 342,10169 +void DoFastAset1IM 343,10195 +void DoFastAset1LP 344,10221 +void DoFastAset1SP 345,10247 +void DoFinishCallNFP 346,10273 +void DoFinishCallNIM 347,10301 +void DoFinishCallNLP 348,10329 +void DoFinishCallNSP 349,10357 +void DoFinishCallTosFP 350,10385 +void DoFinishCallTosIM 351,10415 +void DoFinishCallTosLP 352,10445 +void DoFinishCallTosSP 353,10475 +void DoFloorFP 354,10505 +void DoFloorIM 355,10527 +void DoFloorLP 356,10549 +void DoFloorSP 357,10571 +void DoGenericDispatchFP 358,10593 +void DoGenericDispatchIM 359,10625 +void DoGenericDispatchLP 360,10657 +void DoGenericDispatchSP 361,10689 +void DoGreaterpFP 362,10721 +void DoGreaterpIM 363,10746 +void DoGreaterpLP 364,10771 +void DoGreaterpSP 365,10796 +void DoHaltFP 366,10821 +void DoHaltIM 367,10842 +void DoHaltLP 368,10863 +void DoHaltSP 369,10884 +void DoIStageError 370,10905 +void DoIncrementFP 371,10931 +void DoIncrementIM 372,10957 +void DoIncrementLP 373,10983 +void DoIncrementSP 374,11009 +void DoInstanceLocFP 375,11035 +void DoInstanceLocIM 376,11063 +void DoInstanceLocLP 377,11091 +void DoInstanceLocSP 378,11119 +void DoInstanceRefFP 379,11147 +void DoInstanceRefIM 380,11175 +void DoInstanceRefLP 381,11203 +void DoInstanceRefSP 382,11231 +void DoInstanceSetFP 383,11259 +void DoInstanceSetIM 384,11287 +void DoInstanceSetLP 385,11315 +void DoInstanceSetSP 386,11343 +void DoJumpFP 387,11371 +void DoJumpIM 388,11392 +void DoJumpLP 389,11413 +void DoJumpSP 390,11434 +void DoLdbFP 391,11455 +void DoLdbIM 392,11475 +void DoLdbLP 393,11495 +void DoLdbSP 394,11515 +void DoLesspFP 395,11535 +void DoLesspIM 396,11557 +void DoLesspLP 397,11579 +void DoLesspSP 398,11601 +void DoLocateLocalsFP 399,11623 +void DoLocateLocalsIM 400,11652 +void DoLocateLocalsLP 401,11681 +void DoLocateLocalsSP 402,11710 +void DoLogandFP 403,11739 +void DoLogandIM 404,11762 +void DoLogandLP 405,11785 +void DoLogandSP 406,11808 +void DoLogicTailTestFP 407,11831 +void DoLogicTailTestIM 408,11861 +void DoLogicTailTestLP 409,11891 +void DoLogicTailTestSP 410,11921 +void DoLogiorFP 411,11951 +void DoLogiorIM 412,11974 +void DoLogiorLP 413,11997 +void DoLogiorSP 414,12020 +void DoLogtestFP 415,12043 +void DoLogtestIM 416,12067 +void DoLogtestLP 417,12091 +void DoLogtestSP 418,12115 +void DoLogxorFP 419,12139 +void DoLogxorIM 420,12162 +void DoLogxorLP 421,12185 +void DoLogxorSP 422,12208 +void DoLoopDecrementTosFP 423,12231 +void DoLoopDecrementTosIM 424,12264 +void DoLoopDecrementTosLP 425,12297 +void DoLoopDecrementTosSP 426,12330 +void DoLoopIncrementTosLessThanFP 427,12363 +void DoLoopIncrementTosLessThanIM 428,12404 +void DoLoopIncrementTosLessThanLP 429,12445 +void DoLoopIncrementTosLessThanSP 430,12486 +void DoLshFP 431,12527 +void DoLshIM 432,12547 +void DoLshLP 433,12567 +void DoLshSP 434,12587 +void DoLshcBignumStepFP 435,12607 +void DoLshcBignumStepIM 436,12638 +void DoLshcBignumStepLP 437,12669 +void DoLshcBignumStepSP 438,12700 +void DoMaxFP 439,12731 +void DoMaxIM 440,12751 +void DoMaxLP 441,12771 +void DoMaxSP 442,12791 +void DoMemberFP 443,12811 +void DoMemberIM 444,12834 +void DoMemberLP 445,12857 +void DoMemberSP 446,12880 +void DoMemoryReadFP 447,12903 +void DoMemoryReadIM 448,12930 +void DoMemoryReadLP 449,12957 +void DoMemoryReadSP 450,12984 +void DoMemoryWriteFP 451,13011 +void DoMemoryWriteIM 452,13039 +void DoMemoryWriteLP 453,13067 +void DoMemoryWriteSP 454,13095 +void DoMergeCdrNoPopFP 455,13123 +void DoMergeCdrNoPopIM 456,13153 +void DoMergeCdrNoPopLP 457,13183 +void DoMergeCdrNoPopSP 458,13213 +void DoMessageDispatchFP 459,13243 +void DoMessageDispatchIM 460,13275 +void DoMessageDispatchLP 461,13307 +void DoMessageDispatchSP 462,13339 +void DoMinFP 463,13371 +void DoMinIM 464,13391 +void DoMinLP 465,13411 +void DoMinSP 466,13431 +void DoMinuspFP 467,13451 +void DoMinuspIM 468,13474 +void DoMinuspLP 469,13497 +void DoMinuspSP 470,13520 +void DoMovemFP 471,13543 +void DoMovemIM 472,13565 +void DoMovemInstanceVariableFP 473,13587 +void DoMovemInstanceVariableIM 474,13625 +void DoMovemInstanceVariableLP 475,13663 +void DoMovemInstanceVariableOrderedFP 476,13701 +void DoMovemInstanceVariableOrderedIM 477,13746 +void DoMovemInstanceVariableOrderedLP 478,13791 +void DoMovemInstanceVariableOrderedSP 479,13836 +void DoMovemInstanceVariableSP 480,13881 +void DoMovemLP 481,13919 +void DoMovemLexicalVarNFP 482,13941 +void DoMovemLexicalVarNIM 483,13974 +void DoMovemLexicalVarNLP 484,14007 +void DoMovemLexicalVarNSP 485,14040 +void DoMovemSP 486,14073 +void DoMultiplyBignumStepFP 487,14095 +void DoMultiplyBignumStepIM 488,14130 +void DoMultiplyBignumStepLP 489,14165 +void DoMultiplyBignumStepSP 490,14200 +void DoMultiplyDoubleFP 491,14235 +void DoMultiplyDoubleIM 492,14266 +void DoMultiplyDoubleLP 493,14297 +void DoMultiplyDoubleSP 494,14328 +void DoMultiplyFP 495,14359 +void DoMultiplyIM 496,14384 +void DoMultiplyLP 497,14409 +void DoMultiplySP 498,14434 +void DoNoOpFP 499,14459 +void DoNoOpIM 500,14480 +void DoNoOpLP 501,14501 +void DoNoOpSP 502,14522 +void DoPDpbFP 503,14543 +void DoPDpbIM 504,14564 +void DoPDpbLP 505,14585 +void DoPDpbSP 506,14606 +void DoPLdbFP 507,14627 +void DoPLdbIM 508,14648 +void DoPLdbLP 509,14669 +void DoPLdbSP 510,14690 +void DoPStoreContentsFP 511,14711 +void DoPStoreContentsIM 512,14742 +void DoPStoreContentsLP 513,14773 +void DoPStoreContentsSP 514,14804 +void DoPTagDpbFP 515,14835 +void DoPTagDpbIM 516,14859 +void DoPTagDpbLP 517,14883 +void DoPTagDpbSP 518,14907 +void DoPTagLdbFP 519,14931 +void DoPTagLdbIM 520,14955 +void DoPTagLdbLP 521,14979 +void DoPTagLdbSP 522,15003 +void DoPluspFP 523,15027 +void DoPluspIM 524,15049 +void DoPluspLP 525,15071 +void DoPluspSP 526,15093 +void DoPointerDifferenceFP 527,15115 +void DoPointerDifferenceIM 528,15149 +void DoPointerDifferenceLP 529,15183 +void DoPointerDifferenceSP 530,15217 +void DoPointerIncrementFP 531,15251 +void DoPointerIncrementIM 532,15284 +void DoPointerIncrementLP 533,15317 +void DoPointerIncrementSP 534,15350 +void DoPointerPlusFP 535,15383 +void DoPointerPlusIM 536,15411 +void DoPointerPlusLP 537,15439 +void DoPointerPlusSP 538,15467 +void DoPopFP 539,15495 +void DoPopIM 540,15515 +void DoPopInstanceVariableFP 541,15535 +void DoPopInstanceVariableIM 542,15571 +void DoPopInstanceVariableLP 543,15607 +void DoPopInstanceVariableOrderedFP 544,15643 +void DoPopInstanceVariableOrderedIM 545,15686 +void DoPopInstanceVariableOrderedLP 546,15729 +void DoPopInstanceVariableOrderedSP 547,15772 +void DoPopInstanceVariableSP 548,15815 +void DoPopLP 549,15851 +void DoPopLexicalVarNFP 550,15871 +void DoPopLexicalVarNIM 551,15902 +void DoPopLexicalVarNLP 552,15933 +void DoPopLexicalVarNSP 553,15964 +void DoPopSP 554,15995 +void DoPushAddressFP 555,16015 +void DoPushAddressIM 556,16043 +void DoPushAddressInstanceVariableFP 557,16071 +void DoPushAddressInstanceVariableIM 558,16115 +void DoPushAddressInstanceVariableLP 559,16159 +void DoPushAddressInstanceVariableOrderedFP 560,16203 +void DoPushAddressInstanceVariableOrderedIM 561,16254 +void DoPushAddressInstanceVariableOrderedLP 562,16305 +void DoPushAddressInstanceVariableOrderedSP 563,16356 +void DoPushAddressInstanceVariableSP 564,16407 +void DoPushAddressLP 565,16451 +void DoPushAddressSP 566,16479 +void DoPushAddressSpRelativeFP 567,16507 +void DoPushAddressSpRelativeIM 568,16545 +void DoPushAddressSpRelativeLP 569,16583 +void DoPushAddressSpRelativeSP 570,16621 +void DoPushFP 571,16659 +void DoPushGlobalLogicVariableFP 572,16680 +void DoPushGlobalLogicVariableIM 573,16720 +void DoPushGlobalLogicVariableLP 574,16760 +void DoPushGlobalLogicVariableSP 575,16800 +void DoPushIM 576,16840 +void DoPushInstanceVariableFP 577,16861 +void DoPushInstanceVariableIM 578,16898 +void DoPushInstanceVariableLP 579,16935 +void DoPushInstanceVariableOrderedFP 580,16972 +void DoPushInstanceVariableOrderedIM 581,17016 +void DoPushInstanceVariableOrderedLP 582,17060 +void DoPushInstanceVariableOrderedSP 583,17104 +void DoPushInstanceVariableSP 584,17148 +void DoPushLP 585,17185 +void DoPushLexicalVarNFP 586,17206 +void DoPushLexicalVarNIM 587,17238 +void DoPushLexicalVarNLP 588,17270 +void DoPushLexicalVarNSP 589,17302 +void DoPushLocalLogicVariablesFP 590,17334 +void DoPushLocalLogicVariablesIM 591,17374 +void DoPushLocalLogicVariablesLP 592,17414 +void DoPushLocalLogicVariablesSP 593,17454 +void DoPushNNilsFP 594,17494 +void DoPushNNilsIM 595,17520 +void DoPushNNilsLP 596,17546 +void DoPushNNilsSP 597,17572 +void DoPushSP 598,17598 +void DoQuotientFP 599,17619 +void DoQuotientIM 600,17644 +void DoQuotientLP 601,17669 +void DoQuotientSP 602,17694 +void DoRationalQuotientFP 603,17719 +void DoRationalQuotientIM 604,17752 +void DoRationalQuotientLP 605,17785 +void DoRationalQuotientSP 606,17818 +void DoReadInternalRegisterFP 607,17851 +void DoReadInternalRegisterIM 608,17888 +void DoReadInternalRegisterLP 609,17925 +void DoReadInternalRegisterSP 610,17962 +void DoRestoreBindingStackFP 611,17999 +void DoRestoreBindingStackIM 612,18035 +void DoRestoreBindingStackLP 613,18071 +void DoRestoreBindingStackSP 614,18107 +void DoReturnKludgeFP 615,18143 +void DoReturnKludgeIM 616,18172 +void DoReturnKludgeLP 617,18201 +void DoReturnKludgeSP 618,18230 +void DoReturnMultipleFP 619,18259 +void DoReturnMultipleIM 620,18290 +void DoReturnMultipleLP 621,18321 +void DoReturnMultipleSP 622,18352 +void DoReturnSingleFP 623,18383 +void DoReturnSingleIM 624,18412 +void DoReturnSingleLP 625,18441 +void DoReturnSingleSP 626,18470 +void DoRgetfFP 627,18499 +void DoRgetfIM 628,18521 +void DoRgetfLP 629,18543 +void DoRgetfSP 630,18565 +void DoRotFP 631,18587 +void DoRotIM 632,18607 +void DoRotLP 633,18627 +void DoRotSP 634,18647 +void DoRoundFP 635,18667 +void DoRoundIM 636,18689 +void DoRoundLP 637,18711 +void DoRoundSP 638,18733 +void DoRplacaFP 639,18755 +void DoRplacaIM 640,18778 +void DoRplacaLP 641,18801 +void DoRplacaSP 642,18824 +void DoRplacdFP 643,18847 +void DoRplacdIM 644,18870 +void DoRplacdLP 645,18893 +void DoRplacdSP 646,18916 +void DoSetCdrCode1FP 647,18939 +void DoSetCdrCode1IM 648,18967 +void DoSetCdrCode1LP 649,18995 +void DoSetCdrCode1SP 650,19023 +void DoSetCdrCode2FP 651,19051 +void DoSetCdrCode2IM 652,19079 +void DoSetCdrCode2LP 653,19107 +void DoSetCdrCode2SP 654,19135 +void DoSetSpToAddressFP 655,19163 +void DoSetSpToAddressIM 656,19194 +void DoSetSpToAddressLP 657,19225 +void DoSetSpToAddressSP 658,19256 +void DoSetSpToAddressSaveTosFP 659,19287 +void DoSetSpToAddressSaveTosIM 660,19325 +void DoSetSpToAddressSaveTosLP 661,19363 +void DoSetSpToAddressSaveTosSP 662,19401 +void DoSetTagFP 663,19439 +void DoSetTagIM 664,19462 +void DoSetTagLP 665,19485 +void DoSetTagSP 666,19508 +void DoSetToCarFP 667,19531 +void DoSetToCarIM 668,19556 +void DoSetToCarLP 669,19581 +void DoSetToCarSP 670,19606 +void DoSetToCdrFP 671,19631 +void DoSetToCdrIM 672,19656 +void DoSetToCdrLP 673,19681 +void DoSetToCdrPushCarFP 674,19706 +void DoSetToCdrPushCarIM 675,19738 +void DoSetToCdrPushCarLP 676,19770 +void DoSetToCdrPushCarSP 677,19802 +void DoSetToCdrSP 678,19834 +void DoSetup1DArrayFP 679,19859 +void DoSetup1DArrayIM 680,19888 +void DoSetup1DArrayLP 681,19917 +void DoSetup1DArraySP 682,19946 +void DoSetupForce1DArrayFP 683,19975 +void DoSetupForce1DArrayIM 684,20009 +void DoSetupForce1DArrayLP 685,20043 +void DoSetupForce1DArraySP 686,20077 +void DoSpareOpFP 687,20111 +void DoSpareOpIM 688,20135 +void DoSpareOpLP 689,20159 +void DoSpareOpSP 690,20183 +void DoStackBltAddressFP 691,20207 +void DoStackBltAddressIM 692,20239 +void DoStackBltAddressLP 693,20271 +void DoStackBltAddressSP 694,20303 +void DoStackBltFP 695,20335 +void DoStackBltIM 696,20360 +void DoStackBltLP 697,20385 +void DoStackBltSP 698,20410 +void DoStartCallFP 699,20435 +void DoStartCallIM 700,20461 +void DoStartCallLP 701,20487 +void DoStartCallSP 702,20513 +void DoStoreArrayLeaderFP 703,20539 +void DoStoreArrayLeaderIM 704,20572 +void DoStoreArrayLeaderLP 705,20605 +void DoStoreArrayLeaderSP 706,20638 +void DoStoreConditionalFP 707,20671 +void DoStoreConditionalIM 708,20704 +void DoStoreConditionalLP 709,20737 +void DoStoreConditionalSP 710,20770 +void DoSubBignumStepFP 711,20803 +void DoSubBignumStepIM 712,20833 +void DoSubBignumStepLP 713,20863 +void DoSubBignumStepSP 714,20893 +void DoSubFP 715,20923 +void DoSubIM 716,20943 +void DoSubLP 717,20963 +void DoSubSP 718,20983 +void DoTagFP 719,21003 +void DoTagIM 720,21023 +void DoTagLP 721,21043 +void DoTagSP 722,21063 +void DoTakeValuesFP 723,21083 +void DoTakeValuesIM 724,21110 +void DoTakeValuesLP 725,21137 +void DoTakeValuesSP 726,21164 +void DoTruncateFP 727,21191 +void DoTruncateIM 728,21216 +void DoTruncateLP 729,21241 +void DoTruncateSP 730,21266 +void DoTypeMemberFP 731,21291 +void DoTypeMemberIM 732,21318 +void DoTypeMemberLP 733,21345 +void DoTypeMemberSP 734,21372 +void DoUnaryMinusFP 735,21399 +void DoUnaryMinusIM 736,21426 +void DoUnaryMinusLP 737,21453 +void DoUnaryMinusSP 738,21480 +void DoUnbindNFP 739,21507 +void DoUnbindNIM 740,21531 +void DoUnbindNLP 741,21555 +void DoUnbindNSP 742,21579 +void DoUnifyFP 743,21603 +void DoUnifyIM 744,21625 +void DoUnifyLP 745,21647 +void DoUnifySP 746,21669 +void DoUnsignedLesspFP 747,21691 +void DoUnsignedLesspIM 748,21721 +void DoUnsignedLesspLP 749,21751 +void DoUnsignedLesspSP 750,21781 +void DoWriteInternalRegisterFP 751,21811 +void DoWriteInternalRegisterIM 752,21849 +void DoWriteInternalRegisterLP 753,21887 +void DoWriteInternalRegisterSP 754,21925 +void DoZeropFP 755,21963 +void DoZeropIM 756,21985 +void DoZeropLP 757,22007 +void DoZeropSP 758,22029 +void ReadRegisterAluAndRotateControl 759,22051 +void ReadRegisterBARx 760,22095 +void ReadRegisterBindingStackLimit 761,22124 +void ReadRegisterBindingStackPointer 762,22166 +void ReadRegisterCRArgumentSize 763,22210 +void ReadRegisterCatchBlockList 764,22249 +void ReadRegisterChipRevision 765,22288 +void ReadRegisterChoicePointer 766,22325 +void ReadRegisterConstantNIL 767,22363 +void ReadRegisterConstantT 768,22399 +void ReadRegisterContinuation 769,22433 +void ReadRegisterControlRegister 770,22470 +void ReadRegisterControlStackExtraLimit 771,22510 +void ReadRegisterControlStackLimit 772,22557 +void ReadRegisterCountMapReloads 773,22599 +void ReadRegisterDynamicBindingCacheBase 774,22639 +void ReadRegisterDynamicBindingCacheMask 775,22687 +void ReadRegisterEphemeralOldspaceRegister 776,22735 +void ReadRegisterError 777,22785 +void ReadRegisterEventCount 778,22815 +void ReadRegisterFEPModeTrapVectorAddress 779,22850 +void ReadRegisterFP 780,22899 +void ReadRegisterFPCoprocessorPresent 781,22926 +void ReadRegisterIcacheControl 782,22971 +void ReadRegisterLP 783,23009 +void ReadRegisterListCacheAddress 784,23036 +void ReadRegisterListCacheArea 785,23077 +void ReadRegisterListCacheLength 786,23115 +void ReadRegisterMapCacheControl 787,23155 +void ReadRegisterMemoryControl 788,23195 +void ReadRegisterMicrosecondClock 789,23233 +void ReadRegisterPHTBase 790,23274 +void ReadRegisterPHTMask 791,23306 +void ReadRegisterPreemptRegister 792,23338 +void ReadRegisterPrefetcherControl 793,23378 +void ReadRegisterSP 794,23420 +void ReadRegisterStackCacheDumpQuantum 795,23447 +void ReadRegisterStackCacheLowerBound 796,23493 +void ReadRegisterStackCacheOverflowLimit 797,23538 +void ReadRegisterStackFrameMaximumSize 798,23586 +void ReadRegisterStructureCacheAddress 799,23632 +void ReadRegisterStructureCacheArea 800,23678 +void ReadRegisterStructureCacheLength 801,23721 +void ReadRegisterStructureStackChoicePointer 802,23766 +void ReadRegisterTOS 803,23818 +void ReadRegisterZoneOldspaceRegister 804,23846 +void WriteRegisterAluAndRotateControl 805,23891 +void WriteRegisterBARx 806,23936 +void WriteRegisterBindingStackLimit 807,23966 +void WriteRegisterBindingStackPointer 808,24009 +void WriteRegisterCatchBlockList 809,24054 +void WriteRegisterChoicePointer 810,24094 +void WriteRegisterContinuation 811,24133 +void WriteRegisterControlRegister 812,24171 +void WriteRegisterControlStackExtraLimit 813,24212 +void WriteRegisterControlStackLimit 814,24260 +void WriteRegisterDynamicBindingCacheBase 815,24303 +void WriteRegisterDynamicBindingCacheMask 816,24352 +void WriteRegisterEphemeralOldspaceRegister 817,24401 +void WriteRegisterError 818,24452 +void WriteRegisterEventCount 819,24483 +void WriteRegisterFEPModeTrapVectorAddress 820,24519 +void WriteRegisterFP 821,24569 +void WriteRegisterFPCoprocessorPresent 822,24597 +void WriteRegisterLP 823,24643 +void WriteRegisterListCacheAddress 824,24671 +void WriteRegisterListCacheArea 825,24713 +void WriteRegisterListCacheLength 826,24752 +void WriteRegisterMappingTableCache 827,24793 +void WriteRegisterPreemptRegister 828,24836 +void WriteRegisterSP 829,24877 +void WriteRegisterStackCacheLowerBound 830,24905 +void WriteRegisterStackCacheOverflowLimit 831,24951 +void WriteRegisterStructureCacheAddress 832,25000 +void WriteRegisterStructureCacheArea 833,25047 +void WriteRegisterStructureCacheLength 834,25091 +void WriteRegisterStructureStackChoicePointer 835,25137 +void WriteRegisterTOS 836,25190 +void WriteRegisterZoneOldspaceRegister 837,25219 + +stub/idispat.c,8461 + goto continuecurrentinstruction;12,488 + t7 23,684 + arg6 24,705 + arg5 25,724 + t5 27,771 + t8 28,790 + t6 30,852 + arg6 31,889 + arg5 32,912 + t7 37,986 + t8 38,1005 + t7 39,1031 + arg6 40,1057 + goto *r0;r045,1115 + t6 54,1282 + t5 56,1351 + arg6 57,1373 + arg5 59,1424 + goto g6046;60,1451 + arg2 67,1574 + goto g6045;68,1594 + t8 73,1697 + t7 76,1782 + *(u64 *)&processor->vma vma78,1844 + t7 80,1913 + t8 82,1965 + t7 86,2026 + arg5 89,2092 + arg5 90,2114 + goto g6055;91,2161 + t7 100,2261 + t6 101,2294 + t5 104,2363 + t7 105,2381 + t5 107,2438 + t6 108,2454 + t6 109,2464 + t5 110,2501 + t5 112,2556 + t6 113,2572 + t5 115,2616 + arg6 117,2655 + t7 119,2698 + arg2 124,2820 + goto g6045;125,2840 + goto dbcachemisstrap;129,2896 + arg1 134,2965 + arg2 135,2978 + goto performmemoryaction;136,2990 + t7 147,3178 + t8 149,3236 + arg5 150,3255 + t8 151,3275 + arg6 152,3300 + t5 154,3346 + t8 155,3365 + t6 157,3435 + arg6 158,3472 + arg5 159,3495 + t8 164,3569 + arg6 165,3595 + goto *r0;r0170,3653 + t6 179,3826 + t5 181,3895 + arg6 182,3917 + arg5 184,3968 + goto g6057;185,3995 + t8 193,4130 + t8 194,4149 + t8 195,4174 + t7 198,4267 + *(u64 *)&processor->vma vma200,4329 + t7 202,4398 + t8 204,4450 + t6 208,4511 + arg2 212,4606 + goto g6056;213,4626 + t7 217,4682 + arg5 220,4748 + arg5 221,4770 + goto g6066;222,4817 + t7 231,4917 + t6 232,4950 + t5 235,5019 + t7 236,5037 + t5 238,5094 + t6 239,5110 + t6 240,5120 + t5 241,5157 + t5 243,5212 + t6 244,5228 + t5 246,5272 + arg6 248,5311 + t7 250,5354 + arg2 255,5476 + goto g6056;256,5496 + goto dbcachemisstrap;260,5552 + arg1 265,5621 + arg2 266,5634 + goto performmemoryaction;267,5649 + t7 278,5837 + arg6 279,5858 + arg5 280,5877 + t5 282,5924 + t8 283,5943 + t6 285,6003 + arg6 286,6040 + arg5 287,6063 + t7 292,6137 + t8 293,6155 + t7 294,6181 + arg6 295,6207 + goto *r0;r0300,6265 + t6 309,6436 + t5 311,6505 + arg6 312,6527 + arg5 314,6578 + goto g6068;315,6605 + arg2 322,6728 + goto g6067;323,6748 + t8 328,6851 + t7 331,6934 + *(u64 *)&processor->vma vma333,6996 + t7 335,7065 + t8 337,7117 + arg1 341,7174 + arg2 342,7187 + goto performmemoryaction;343,7199 + t7 354,7377 + arg6 355,7398 + arg5 356,7417 + t5 358,7464 + t8 359,7483 + t6 361,7540 + arg6 362,7577 + arg5 363,7600 + t7 368,7674 + t8 369,7693 + t7 370,7719 + arg6 371,7745 + goto *r0;r0376,7803 + t6 385,7968 + t5 387,8037 + arg6 388,8059 + arg5 390,8110 + goto g6077;391,8137 + arg2 398,8260 + goto g6076;399,8280 + t8 404,8383 + t7 407,8463 + *(u64 *)&processor->vma vma409,8525 + t7 411,8594 + t8 413,8646 + arg1 417,8703 + arg2 418,8716 + goto performmemoryaction;419,8728 + arg2 434,9126 + epc 436,9189 + ecp 437,9208 + arg1 438,9248 + arg1 439,9268 + ecp 440,9297 + instn 442,9379 + ecp 443,9399 + ecp 444,9418 + arg3 446,9459 + ecp 448,9499 + arg4 450,9544 + ecp 452,9592 + opc 454,9631 + iCP 456,9682 + arg1 458,9728 + ocp 459,9759 + hwdispatch 463,9873 + hwopmask 464,9928 + fwdispatch 465,9954 + count 466,10009 + t11 467,10030 + iword 468,10053 + arg4 469,10074 + iword 470,10095 + arg4 471,10120 + goto fillicacheprefetched;472,10156 + *(u64 *)&((CACHELINEP)ocp)->nextpcdata nextpcdata477,10278 + t10 479,10354 + *(u64 *)&((CACHELINEP)ocp)->nextcp nextcp480,10384 + arg1 482,10459 + *(u64 *)&((CACHELINEP)ecp)->nextcp nextcp483,10477 + arg4 486,10564 + *(u64 *)&((CACHELINEP)ecp)->nextpcdata nextpcdata487,10584 + goto maybeunpack;489,10675 + *(u64 *)&((CACHELINEP)ecp)->nextpcdata nextpcdata494,10786 + arg1 495,10834 + *(u64 *)&((CACHELINEP)ecp)->nextcp nextcp496,10852 + t10 497,10896 + *(u64 *)&((CACHELINEP)ocp)->nextpcdata nextpcdata498,10926 + arg4 501,11018 + *(u64 *)&((CACHELINEP)ocp)->nextcp nextcp502,11038 + goto maybeunpack;503,11082 + t11 508,11191 + iword 509,11214 + arg4 510,11235 + iword 511,11256 + arg4 512,11281 + t10 518,11466 + t11 519,11514 + t10 520,11562 + t11 521,11580 + t10 522,11598 + *(u32 *)&((CACHELINEP)ecp)->annotation annotation523,11615 + t11 524,11663 + *(u32 *)&((CACHELINEP)ocp)->annotation annotation525,11680 + *(u64 *)&((CACHELINEP)ecp)->pcdata pcdata528,11775 + arg1 530,11841 + arg4 533,11897 + *(u64 *)&((CACHELINEP)ocp)->pcdata pcdata535,11956 + iword 537,12030 + arg2 542,12119 + arg1 547,12226 + arg1 560,12558 + r31 561,12576 + t10 563,12626 + *(u64 *)&((CACHELINEP)ecp)->nextpcdata nextpcdata565,12692 + arg1 567,12767 + *(u64 *)&((CACHELINEP)ecp)->nextcp nextcp569,12801 + t10 572,12918 + *(u64 *)&((CACHELINEP)ocp)->nextpcdata nextpcdata573,12951 + arg4 576,13043 + *(u64 *)&((CACHELINEP)ocp)->nextcp nextcp577,13063 + goto maybeunpack;578,13107 + arg1 584,13249 + arg4 586,13330 + t10 588,13408 + arg1 590,13477 + t11 592,13527 + *(u32 *)&processor->metervalue metervalue593,13565 + arg2 596,13639 + t10 598,13721 + t11 599,13746 + t11 600,13763 + arg2 601,13783 + t12 602,13822 + *(u32 *)&processor->metermax metermax605,13880 + *(u32 *)t10 607,13947 + *(u32 *)&processor->meterpos meterpos609,14000 + *(u32 *)&processor->metervalue metervalue610,14038 + arg4 611,14079 + *(u32 *)&processor->metercount metercount615,14161 + arg4 618,14250 + t10 620,14298 + *(u64 *)&((CACHELINEP)ocp)->instruction instruction622,14351 + t11 624,14453 + t12 626,14501 + *(u64 *)&((CACHELINEP)ocp)->annotation annotation628,14549 + t10 631,14625 + t11 633,14702 + arg2 634,14726 + t10 635,14745 + t12 637,14820 + arg2 638,14839 + *(u32 *)&((CACHELINEP)ecp)->operand operand639,14860 + arg2 644,15005 + t11 646,15076 + arg1 648,15122 + t10 649,15148 + arg2 651,15188 + t11 653,15266 + *(u64 *)&((CACHELINEP)ecp)->code code654,15290 + t12 655,15332 + arg2 656,15351 + arg1 658,15427 + *(u32 *)&((CACHELINEP)ocp)->operand operand659,15448 + t12 660,15494 + arg2 661,15513 + *(u64 *)&((CACHELINEP)ocp)->code code665,15609 + goto enddecode;666,15652 + iword 671,15757 + *(u64 *)&((CACHELINEP)ecp)->instruction instruction673,15815 + t10 675,15891 + *(u64 *)&((CACHELINEP)ecp)->annotation annotation677,15932 + epc 680,16009 + t12 682,16089 + t11 684,16166 + epc 686,16235 + arg1 688,16283 + *(u32 *)&processor->metervalue metervalue689,16322 + arg2 692,16394 + t11 694,16476 + arg1 695,16502 + arg1 696,16521 + arg2 697,16543 + t10 698,16582 + *(u32 *)&processor->metermax metermax701,16638 + *(u32 *)t11 703,16705 + *(u32 *)&processor->meterpos meterpos705,16757 + *(u32 *)&processor->metervalue metervalue706,16796 + t12 707,16837 + *(u32 *)&processor->metercount metercount711,16918 + t11 717,17084 + t12 718,17117 + arg1 719,17167 + t11 721,17222 + *(u64 *)&((CACHELINEP)ocp)->code code723,17281 + *(u64 *)&((CACHELINEP)ecp)->code code727,17399 + instn 733,17631 + epc 737,17729 + count 739,17773 + opc 740,17794 + t10 742,17848 + ocp 743,17889 + ecp 744,17921 + t10 745,17953 + goto cachevalid;749,18042 + t11 753,18107 + count 755,18196 + *(u64 *)&((CACHELINEP)ecp)->code code757,18273 + *(u64 *)&((CACHELINEP)ocp)->code code758,18315 + goto enddecode;759,18357 + *(u64 *)&processor->asrr9 asrr9772,18882 + *(u64 *)&processor->asrr10 asrr10773,18916 + *(u64 *)&processor->asrr11 asrr11774,18952 + *(u64 *)&processor->asrr12 asrr12775,18988 + *(u64 *)&processor->asrr13 asrr13776,19024 + *(u64 *)&processor->asrr15 asrr15777,19060 + *(u64 *)&processor->asrr26 asrr26778,19096 + *(u64 *)&processor->asrr27 asrr27779,19132 + *(u64 *)&processor->asrr29 asrr29780,19168 + *(u64 *)&processor->asrr30 asrr30781,19204 + *(u64 *)&processor->asrr14 asrr14782,19240 + ivory 784,19318 + iCP 786,19373 + iPC 787,19407 + iSP 788,19442 + iFP 789,19476 + iLP 790,19510 + goto ICACHEMISS;794,19631 + t2 799,19779 + arg1 801,19848 + r0 803,19898 + arg4 805,19974 + arg3 807,20044 + t1 808,20097 + iCP 811,20169 + goto continuecurrentinstruction;815,20272 + t5 823,20518 + t4 824,20559 + t4 825,20577 + arg2 826,20602 + t3 827,20622 + arg2 828,20641 + arg2 829,20661 + arg2 830,20682 + t4 832,20723 + arg2 834,20762 + t5 836,20809 + arg2 841,20893 + *(u64 *)&((CACHELINEP)iCP)->annotation annotation843,20935 + iCP 845,20991 + r30 849,21077 + r0 851,21151 + arg1 853,21221 + arg3 855,21286 + arg4 857,21367 + t2 859,21425 + goto continuecurrentinstruction;863,21559 + +stub/idouble.c,2711 + sp 12,452 + t7 16,505 + arg6 17,526 + arg5 18,545 + t5 20,592 + t8 21,611 + t6 23,673 + arg6 24,710 + arg5 25,733 + t7 30,807 + t8 31,826 + t7 32,852 + t5 37,916 + t5 39,966 + arg2 43,1053 + t7 47,1109 + arg6 48,1130 + arg5 49,1149 + t5 51,1196 + t8 52,1215 + t6 54,1277 + arg6 55,1314 + arg5 56,1337 + t7 61,1411 + t8 62,1430 + t7 63,1456 + t5 68,1520 + t5 70,1570 + *(u32 *)&processor->fp0 fp073,1617 + sp 74,1651 + goto *r0;r075,1666 + arg2 82,1797 + goto g8886;83,1817 + *(u64 *)sp 90,1915 + r0 91,1934 + goto memoryreaddatadecode;92,1960 + r0 94,2001 + goto g8897;95,2020 + arg2 102,2143 + goto g8874;103,2163 + *(u64 *)sp 110,2261 + r0 111,2280 + goto memoryreaddatadecode;112,2306 + r0 114,2347 + goto g8885;115,2366 + arg6 120,2456 + arg3 122,2505 + arg1 124,2550 + arg4 126,2589 + goto numericexception;127,2601 + sp 135,2745 + arg6 136,2761 + arg5 137,2795 + t5 138,2835 + t8 139,2872 + t6 140,2913 + arg2 142,2972 + t7 143,3014 + t7 148,3141 + *(u32 *)&processor->lclength lclength155,3329 + t8 156,3366 + t8 158,3410 + *(u32 *)&processor->lcaddress lcaddress160,3455 + arg2 161,3493 + t9 162,3513 + t9 163,3533 + t5 164,3550 + t8 165,3571 + t7 166,3588 + t6 167,3606 + t7 168,3640 + t7 172,3716 + *(u32 *)t8 174,3749 + t10 175,3770 + t9 176,3788 + t9 177,3808 + t5 178,3824 + t8 179,3844 + t7 180,3861 + t6 181,3879 + t7 182,3913 + t7 186,3989 + *(u32 *)t8 188,4022 + sp 189,4043 + goto *r0;r0190,4058 + arg6 195,4156 + arg3 197,4205 + arg1 199,4250 + arg4 201,4289 + goto numericexception;202,4301 + *(u32 *)&processor->immediate_arg immediate_arg218,4678 + arg1 219,4722 + goto begindodoublefloatop;220,4768 + arg1 227,4908 + goto headdodoublefloatop;235,5057 + goto headdodoublefloatop;241,5173 + arg1 250,5376 + arg1 252,5428 + arg3 258,5600 + arg4 260,5644 + arg5 262,5689 + arg6 264,5732 + arg3 266,5783 + arg4 267,5804 + arg5 269,5853 + arg6 270,5874 + arg3 272,5916 + arg5 274,5960 + *(u64 *)&processor->fp0 fp0275,5982 + *(u64 *)&processor->fp1 fp1276,6016 + t2 278,6072 + t1 280,6114 + t3 281,6132 + t3 283,6180 + t3 289,6308 + t3 290,6341 + goto g8901;295,6470 + t3 299,6526 + t3 300,6559 + goto g8901;305,6677 + t3 309,6733 + t3 310,6771 + goto g8901;315,6894 + t3 319,6950 + t3 320,6986 + goto g8901;325,7107 + t3 335,7319 + t1 339,7419 + t2 340,7451 + iSP 342,7518 + t4 343,7536 + iSP 348,7664 + t4 349,7681 + iSP 354,7808 + iSP 355,7825 + t4 356,7842 + t4 357,7859 + *(u64 *)iSP 359,7913 + goto NEXTINSTRUCTION;360,7933 + t3 365,8059 + goto doublefloatmerge;366,8098 + arg5 370,8183 + arg2 371,8195 + goto illegaloperand;372,8208 + +stub/ifunarra.c,33030 + t12 12,411 + t1 17,490 + t3 18,538 + t2 19,559 + arg6 20,597 + arg5 21,616 + t1 23,663 + t4 24,681 + t2 26,741 + arg6 27,777 + arg5 28,800 + t3 33,874 + t4 34,892 + t3 35,918 + arg6 36,944 + t1 42,1019 + t2 43,1037 + t1 44,1083 + *(u32 *)&((ARRAYCACHEP)t7)->array array50,1210 + t2 51,1253 + t1 52,1285 + t2 53,1303 + *(u64 *)&((ARRAYCACHEP)t7)->length length57,1427 + t10 58,1470 + t8 59,1523 + t10 60,1566 + t9 61,1618 + t10 63,1677 + *(u32 *)&((ARRAYCACHEP)t7)->arword arword65,1751 + *(u64 *)&((ARRAYCACHEP)t7)->locat locat67,1841 + arg5 69,1908 + arg6 71,1989 + arg5 72,2035 + arg4 73,2074 + arg6 74,2089 + goto aref1restart;75,2128 + t2 79,2191 + t1 81,2260 + arg6 82,2282 + arg5 84,2333 + goto g7683;85,2360 + arg4 92,2483 + goto g7682;93,2503 + t4 98,2606 + t3 101,2689 + *(u64 *)&processor->vma vma103,2751 + t3 105,2820 + t4 107,2872 + arg1 111,2929 + arg2 112,2942 + goto performmemoryaction;113,2954 + t5 121,3132 + t4 122,3160 + t5 123,3188 + t6 124,3204 + t6 126,3261 + t8 133,3373 + t3 134,3421 + t2 135,3440 + t6 136,3478 + t7 137,3495 + t8 139,3540 + t1 140,3556 + t2 142,3616 + t6 143,3652 + t7 144,3671 + t3 149,3741 + t1 150,3759 + t3 151,3783 + t6 152,3807 + t8 158,3878 + t2 159,3894 + t8 160,3938 + t1 165,4025 + t4 166,4067 + t1 167,4110 + t2 168,4160 + t1 170,4217 + t3 172,4260 + t3 173,4292 + *(u32 *)arg1 174,4308 + goto fastaref1retry;176,4357 + *(u64 *)&processor->asrf5 asrf5181,4464 + *(u64 *)&processor->asrf4 asrf4183,4542 + *(u64 *)&processor->asrf3 asrf3185,4619 + *(u64 *)&processor->asrf6 asrf6187,4696 + *(u64 *)&processor->asrf7 asrf7189,4774 + *(u64 *)&processor->asrf8 asrf8191,4852 + *(u64 *)&processor->asrf9 asrf9193,4930 + t9 194,4966 + arg2 195,4994 + t9 196,5024 + arg1 197,5040 + t4 198,5053 + t3 199,5064 + t2 200,5075 + iSP 201,5085 + r0 202,5103 + goto setup1dlongarray;203,5129 + t4 205,5166 + arg1 209,5285 + t10 211,5365 + t11 213,5444 + arg1 215,5523 + arg2 217,5603 + arg3 219,5683 + arg4 221,5763 + t3 222,5801 + iSP 224,5840 + t2 225,5857 + iSP 227,5896 + t1 228,5913 + iSP 230,5952 + t4 231,5969 + iSP 233,6008 + iSP 234,6025 + *(u32 *)arg1 235,6043 + goto fastaref1retry;238,6119 + arg6 243,6218 + arg3 245,6253 + arg1 247,6298 + arg4 249,6337 + arg5 250,6349 + arg2 251,6361 + goto arrayexception;252,6374 + arg5 256,6439 + arg2 257,6451 + goto illegaloperand;258,6464 + t2 262,6529 + t8 264,6598 + t6 265,6620 + t7 267,6669 + goto g7696;268,6694 + t5 275,6817 + goto g7695;276,6833 + t1 281,6936 + t3 284,7019 + *(u64 *)&processor->vma vma286,7079 + t3 288,7146 + t1 290,7198 + arg1 294,7255 + arg2 295,7268 + goto performmemoryaction;296,7280 + *(u64 *)&processor->asrf4 asrf4305,7477 + *(u64 *)&processor->asrf5 asrf5307,7555 + t9 308,7589 + arg2 309,7601 + arg1 310,7616 + t4 311,7631 + t3 312,7644 + t2 313,7657 + iSP 314,7670 + r0 315,7688 + goto setup1dlongarray;316,7714 + arg2 319,7793 + t7 321,7871 + t1 323,7922 + t5 325,7957 + iSP 327,8002 + t1 328,8019 + t5 330,8048 + iSP 332,8087 + t3 334,8120 + iSP 336,8159 + t9 338,8203 + arg3 340,8250 + iSP 342,8297 + t9 343,8314 + iSP 344,8330 + *(u64 *)&((ARRAYCACHEP)t7)->length length345,8348 + *(u32 *)&((ARRAYCACHEP)t7)->arword arword346,8391 + *(u32 *)&((ARRAYCACHEP)t7)->locat locat347,8434 + *(u32 *)&((ARRAYCACHEP)t7)->array array349,8500 + t9 350,8542 + t2 351,8558 + t5 354,8644 + arg5 358,8744 + arg6 360,8823 + arg4 361,8867 + arg5 362,8918 + arg4 363,8957 + arg6 364,9003 + goto aref1restart;365,9042 + arg1 369,9123 + t1 371,9161 + t1 372,9180 + arg6 374,9232 + arg3 376,9269 + arg1 378,9314 + arg4 380,9353 + arg5 381,9365 + arg2 382,9377 + goto arrayexception;383,9389 + arg5 387,9468 + arg2 388,9480 + goto illegaloperand;389,9492 + *(u64 *)&((ARRAYCACHEP)t7)->array array393,9569 + arg5 394,9613 + arg2 395,9625 + goto illegaloperand;396,9638 + t12 404,9766 + t1 409,9845 + t3 410,9893 + t2 411,9914 + arg6 412,9952 + arg5 413,9971 + t1 415,10018 + t4 416,10036 + t2 418,10096 + arg6 419,10132 + arg5 420,10155 + t3 425,10229 + t4 426,10247 + t3 427,10273 + arg6 428,10299 + t1 434,10374 + t2 435,10392 + t1 436,10438 + *(u32 *)&((ARRAYCACHEP)t7)->array array442,10565 + t2 443,10608 + t1 444,10640 + t2 445,10658 + *(u64 *)&((ARRAYCACHEP)t7)->length length449,10782 + t10 450,10825 + t8 451,10878 + t10 452,10921 + t9 453,10973 + t10 455,11032 + *(u32 *)&((ARRAYCACHEP)t7)->arword arword457,11106 + *(u64 *)&((ARRAYCACHEP)t7)->locat locat459,11196 + arg5 461,11263 + arg6 463,11344 + arg5 464,11390 + arg4 465,11429 + arg6 466,11444 + goto aset1restart;467,11483 + t2 471,11546 + t1 473,11615 + arg6 474,11637 + arg5 476,11688 + goto g7706;477,11715 + arg4 484,11838 + goto g7705;485,11858 + t4 490,11961 + t3 493,12044 + *(u64 *)&processor->vma vma495,12106 + t3 497,12175 + t4 499,12227 + arg1 503,12284 + arg2 504,12297 + goto performmemoryaction;505,12309 + t5 513,12487 + t4 514,12515 + t5 515,12543 + t6 516,12559 + t6 518,12616 + t8 525,12728 + t3 526,12776 + t2 527,12795 + t6 528,12833 + t7 529,12850 + t8 531,12895 + t1 532,12911 + t2 534,12971 + t6 535,13007 + t7 536,13026 + t3 541,13096 + t1 542,13114 + t3 543,13138 + t6 544,13162 + t8 550,13233 + t2 551,13249 + t8 552,13293 + t1 557,13380 + t4 558,13422 + t1 559,13465 + t2 560,13515 + t1 562,13572 + t3 564,13615 + t3 565,13647 + *(u32 *)arg1 566,13663 + goto fastaset1retry;568,13712 + *(u64 *)&processor->asrf5 asrf5573,13819 + *(u64 *)&processor->asrf4 asrf4575,13897 + *(u64 *)&processor->asrf3 asrf3577,13974 + *(u64 *)&processor->asrf6 asrf6579,14051 + *(u64 *)&processor->asrf7 asrf7581,14129 + *(u64 *)&processor->asrf8 asrf8583,14207 + *(u64 *)&processor->asrf9 asrf9585,14285 + t9 586,14321 + arg2 587,14349 + t9 588,14379 + arg1 589,14395 + t4 590,14408 + t3 591,14419 + t2 592,14430 + iSP 593,14440 + r0 594,14458 + goto setup1dlongarray;595,14484 + t4 597,14521 + arg1 601,14640 + t10 603,14720 + t11 605,14799 + arg1 607,14878 + arg2 609,14958 + arg3 611,15038 + arg4 613,15118 + t3 614,15156 + iSP 616,15195 + t2 617,15212 + iSP 619,15251 + t1 620,15268 + iSP 622,15307 + t4 623,15324 + iSP 625,15363 + iSP 626,15380 + *(u32 *)arg1 627,15398 + goto fastaset1retry;630,15474 + arg6 635,15573 + arg3 637,15608 + arg1 639,15653 + arg4 641,15692 + arg5 642,15704 + arg2 643,15716 + goto arrayexception;644,15729 + arg5 648,15794 + arg2 649,15806 + goto illegaloperand;650,15819 + t2 654,15884 + t8 656,15953 + t6 657,15975 + t7 659,16024 + goto g7719;660,16049 + t5 667,16172 + goto g7718;668,16188 + t1 673,16291 + t3 676,16374 + *(u64 *)&processor->vma vma678,16434 + t3 680,16501 + t1 682,16553 + arg1 686,16610 + arg2 687,16623 + goto performmemoryaction;688,16635 + *(u64 *)&processor->asrf4 asrf4697,16832 + *(u64 *)&processor->asrf3 asrf3699,16910 + *(u64 *)&processor->asrf6 asrf6701,16986 + *(u64 *)&processor->asrf5 asrf5703,17062 + t9 704,17096 + arg2 705,17108 + arg1 706,17123 + t4 707,17138 + t3 708,17151 + t2 709,17164 + iSP 710,17177 + r0 711,17195 + goto setup1dlongarray;712,17221 + t1 714,17258 + arg2 718,17386 + t5 720,17464 + t6 722,17542 + t7 724,17620 + t1 726,17671 + t2 728,17706 + iSP 730,17751 + t1 731,17768 + t2 733,17797 + iSP 735,17836 + t3 737,17869 + iSP 739,17908 + t9 741,17952 + arg3 743,17999 + iSP 745,18046 + t9 746,18063 + iSP 747,18079 + *(u64 *)&((ARRAYCACHEP)t7)->length length748,18097 + *(u32 *)&((ARRAYCACHEP)t7)->arword arword749,18140 + *(u32 *)&((ARRAYCACHEP)t7)->locat locat750,18183 + *(u32 *)&((ARRAYCACHEP)t7)->array array752,18249 + t9 753,18291 + t2 754,18307 + arg5 758,18407 + arg6 760,18486 + arg4 761,18530 + arg5 762,18581 + arg4 763,18620 + arg6 764,18666 + goto aset1restart;765,18705 + arg1 769,18786 + t1 771,18824 + t1 772,18843 + arg6 774,18895 + arg3 776,18932 + arg1 778,18977 + arg4 780,19016 + arg5 781,19028 + arg2 782,19040 + goto arrayexception;783,19052 + arg5 787,19131 + arg2 788,19143 + goto illegaloperand;789,19155 + *(u64 *)&((ARRAYCACHEP)t7)->array array793,19232 + arg5 794,19276 + arg2 795,19288 + goto illegaloperand;796,19301 + arg1 812,19616 + goto headdoaloc1;820,19765 + goto headdoaloc1;826,19857 + arg1 835,20020 + arg1 837,20072 + arg4 843,20244 + arg3 845,20297 + iSP 847,20344 + arg4 848,20361 + arg2 850,20400 + arg1 852,20438 + t1 853,20459 + t1 855,20509 + t1 861,20615 + t1 863,20674 + t1 870,20795 + t3 871,20843 + t2 872,20864 + arg6 873,20902 + arg5 874,20921 + t1 876,20968 + t4 877,20986 + t2 879,21046 + arg6 880,21082 + arg5 881,21105 + t3 886,21179 + t4 887,21197 + t3 888,21223 + t1 894,21304 + t2 895,21322 + t1 896,21368 + t2 901,21471 + t1 902,21503 + t3 903,21521 + arg6 907,21632 + arg4 908,21678 + arg4 909,21697 + arg6 910,21719 + arg6 911,21758 + t1 914,21841 + iSP 918,21948 + goto NEXTINSTRUCTION;919,21965 + arg1 923,22049 + t1 925,22087 + t1 926,22106 + arg6 928,22158 + arg3 930,22195 + arg1 932,22240 + arg4 934,22279 + arg5 935,22291 + arg2 936,22303 + goto arrayexception;937,22315 + arg5 941,22394 + arg2 942,22406 + goto illegaloperand;943,22418 + arg5 947,22495 + arg2 948,22507 + goto illegaloperand;949,22520 + arg5 953,22603 + arg2 954,22615 + goto illegaloperand;955,22627 + goto DoAloc1IM;957,22665 + arg4 963,22771 + arg3 965,22824 + iSP 967,22871 + arg4 968,22888 + goto aloc1merge;969,22908 + t2 973,22969 + t1 975,23038 + arg6 976,23060 + arg5 978,23111 + goto g7729;979,23138 + arg4 986,23261 + goto g7728;987,23281 + t4 992,23384 + t3 995,23467 + *(u64 *)&processor->vma vma997,23529 + t3 999,23598 + t4 1001,23650 + arg1 1005,23707 + arg2 1006,23720 + goto performmemoryaction;1007,23732 + arg2 1026,24254 + arg2 1031,24348 + *(u32 *)&processor->immediate_arg immediate_arg1032,24374 + arg1 1033,24418 + goto begindosetup1darray;1034,24464 + arg1 1041,24601 + goto headdosetup1darray;1049,24750 + goto headdosetup1darray;1055,24863 + arg1 1064,25061 + arg1 1066,25113 + arg2 1072,25284 + arg1 1074,25326 + t2 1076,25378 + t9 1077,25388 + t3 1078,25401 + t3 1080,25460 + t5 1087,25572 + t7 1088,25620 + t6 1089,25641 + t3 1090,25679 + t4 1091,25696 + t5 1093,25741 + t8 1094,25759 + t6 1096,25819 + t3 1097,25855 + t4 1098,25874 + t7 1103,25944 + t8 1104,25962 + t7 1105,25986 + t3 1106,26010 + t5 1112,26081 + t6 1113,26097 + t5 1114,26141 + t5 1120,26249 + iSP 1124,26350 + t8 1125,26367 + t7 1126,26417 + t1 1127,26437 + t8 1128,26480 + t5 1129,26530 + t8 1131,26589 + t6 1133,26626 + iSP 1137,26725 + t8 1138,26742 + iSP 1142,26847 + t6 1143,26864 + t6 1144,26896 + t8 1146,26933 + iSP 1150,27032 + goto NEXTINSTRUCTION;1151,27049 + t6 1156,27131 + t6 1157,27150 + arg6 1159,27200 + arg3 1161,27237 + arg1 1163,27282 + arg4 1165,27321 + arg5 1166,27333 + arg2 1167,27345 + goto arrayexception;1168,27358 + arg5 1172,27423 + arg2 1173,27435 + goto illegaloperand;1174,27448 + r0 1178,27513 + goto setup1dlongarray;1179,27539 + t1 1181,27576 + t1 1184,27660 + t1 1187,27737 + goto NEXTINSTRUCTION;1190,27819 + t6 1194,27885 + t5 1196,27954 + t3 1197,27976 + t4 1199,28025 + goto g7742;1200,28050 + arg1 1207,28173 + goto g7741;1208,28191 + t8 1213,28294 + t7 1216,28377 + *(u64 *)&processor->vma vma1218,28437 + t7 1220,28506 + t8 1222,28558 + arg1 1226,28615 + arg2 1227,28628 + goto performmemoryaction;1228,28640 + arg2 1246,29171 + arg2 1251,29265 + *(u32 *)&processor->immediate_arg immediate_arg1252,29291 + arg1 1253,29335 + goto begindosetupforce1darray;1254,29381 + arg1 1261,29533 + goto headdosetupforce1darray;1269,29682 + goto headdosetupforce1darray;1275,29810 + arg1 1284,30033 + arg1 1286,30085 + arg2 1292,30266 + arg1 1294,30308 + t2 1296,30356 + t9 1297,30366 + t3 1298,30379 + t3 1300,30438 + t5 1307,30550 + t7 1308,30598 + t6 1309,30619 + t3 1310,30657 + t4 1311,30674 + t5 1313,30719 + t8 1314,30737 + t6 1316,30797 + t3 1317,30833 + t4 1318,30852 + t7 1323,30922 + t8 1324,30940 + t7 1325,30964 + t3 1326,30988 + t5 1332,31059 + t6 1333,31075 + t5 1334,31119 + t5 1340,31227 + iSP 1344,31328 + t8 1345,31345 + t7 1346,31395 + t1 1347,31415 + t8 1348,31458 + t5 1349,31508 + t8 1351,31567 + t6 1353,31604 + iSP 1357,31703 + t8 1358,31720 + iSP 1362,31825 + t6 1363,31842 + t6 1364,31874 + t8 1366,31911 + iSP 1370,32010 + goto NEXTINSTRUCTION;1371,32027 + t6 1376,32109 + t6 1377,32128 + arg6 1379,32178 + arg3 1381,32215 + arg1 1383,32260 + arg4 1385,32299 + arg5 1386,32311 + arg2 1387,32323 + goto arrayexception;1388,32336 + arg5 1392,32401 + arg2 1393,32413 + goto illegaloperand;1394,32426 + r0 1398,32491 + goto setup1dlongarray;1399,32517 + t1 1401,32554 + t1 1404,32638 + t1 1407,32715 + goto NEXTINSTRUCTION;1410,32797 + t6 1414,32863 + t5 1416,32932 + t3 1417,32954 + t4 1419,33003 + goto g7756;1420,33028 + arg1 1427,33151 + goto g7755;1428,33169 + t8 1433,33272 + t7 1436,33355 + *(u64 *)&processor->vma vma1438,33415 + t7 1440,33484 + t8 1442,33536 + arg1 1446,33593 + arg2 1447,33606 + goto performmemoryaction;1448,33618 + t1 1459,33944 + t7 1464,34026 + t10 1465,34074 + t8 1466,34094 + arg4 1467,34132 + t6 1468,34152 + t7 1470,34198 + t11 1471,34214 + t8 1473,34277 + arg4 1474,34313 + t6 1475,34336 + t10 1480,34407 + t11 1481,34427 + t10 1482,34453 + arg4 1483,34479 + t8 1488,34538 + t8 1490,34586 + t1 1494,34659 + t7 1499,34739 + t10 1500,34787 + t8 1501,34807 + arg3 1502,34845 + t6 1503,34865 + t7 1505,34911 + t11 1506,34927 + t8 1508,34990 + arg3 1509,35026 + t6 1510,35049 + t10 1515,35120 + t11 1516,35140 + t10 1517,35166 + arg3 1518,35192 + t8 1523,35251 + t8 1525,35299 + t1 1529,35374 + t7 1534,35454 + t10 1535,35502 + t8 1536,35522 + t5 1537,35560 + t6 1538,35578 + t7 1540,35624 + t11 1541,35640 + t8 1543,35703 + t5 1544,35739 + t6 1545,35758 + t10 1550,35829 + t11 1551,35849 + t10 1552,35875 + t5 1553,35901 + t10 1559,35993 + t11 1560,36010 + t10 1571,36225 + iSP 1575,36328 + t8 1576,36345 + t7 1577,36387 + t1 1578,36407 + t8 1579,36450 + t8 1581,36542 + t6 1583,36579 + iSP 1587,36678 + t8 1588,36695 + iSP 1592,36800 + t8 1594,36838 + iSP 1598,36939 + goto g7774;1599,36956 + t11 1603,37012 + goto g7769;1610,37160 + t11 1614,37216 + t1 1624,37404 + t1 1625,37419 + t1 1627,37473 + t12 1630,37520 + t12 1631,37563 + t2 1632,37600 + t7 1640,37720 + t10 1641,37768 + t8 1642,37788 + t4 1643,37826 + t6 1644,37844 + t7 1646,37890 + t11 1647,37906 + t8 1649,37967 + t4 1650,38003 + t6 1651,38022 + t10 1656,38093 + t11 1657,38112 + t10 1658,38138 + t4 1659,38164 + t10 1664,38219 + t10 1665,38262 + arg1 1666,38299 + t7 1667,38319 + t5 1671,38425 + t8 1672,38440 + t8 1673,38461 + t10 1674,38477 + t10 1675,38498 + t8 1676,38524 + t10 1679,38586 + t7 1680,38607 + arg4 1683,38658 + arg4 1687,38713 + t10 1689,38754 + iSP 1693,38857 + t7 1694,38874 + t8 1695,38894 + t1 1696,38944 + t8 1697,38987 + t11 1699,39048 + t11 1701,39096 + t11 1702,39123 + t11 1703,39142 + t8 1705,39235 + t8 1707,39282 + t6 1709,39320 + iSP 1713,39419 + t1 1718,39508 + t1 1719,39527 + t2 1720,39551 + t5 1723,39610 + t8 1727,39668 + iSP 1731,39773 + t8 1733,39811 + iSP 1737,39912 + goto g7774;1738,39929 + t1 1743,40008 + t7 1748,40088 + t10 1749,40136 + t8 1750,40156 + arg6 1751,40194 + t4 1752,40214 + t7 1754,40260 + t11 1755,40276 + t8 1757,40339 + arg6 1758,40375 + t4 1759,40398 + t10 1764,40469 + t11 1765,40489 + t10 1766,40515 + arg6 1767,40541 + t1 1772,40600 + t1 1774,40648 + t1 1778,40718 + t7 1783,40798 + t10 1784,40846 + t8 1785,40866 + arg5 1786,40904 + t4 1787,40924 + t7 1789,40970 + t11 1790,40986 + t8 1792,41049 + arg5 1793,41085 + t4 1794,41108 + t10 1799,41179 + t11 1800,41199 + t10 1801,41225 + arg5 1802,41251 + t1 1807,41310 + t1 1809,41358 + t1 1813,41426 + t7 1818,41506 + t10 1819,41554 + t8 1820,41574 + t5 1821,41612 + t4 1822,41630 + t7 1824,41676 + t11 1825,41692 + t8 1827,41755 + t5 1828,41791 + t4 1829,41810 + t10 1834,41881 + t11 1835,41901 + t10 1836,41927 + t5 1837,41953 + t8 1842,42008 + t8 1843,42028 + t10 1844,42054 + t8 1847,42119 + t7 1850,42174 + arg4 1853,42225 + t8 1855,42275 + t10 1856,42291 + goto g7767;1863,42442 + t10 1867,42498 + goto g7767;1874,42645 + t10 1878,42701 + t7 1888,42888 + t7 1889,42908 + arg3 1890,42934 + t2 1893,43001 + goto g7768;1894,43019 + t10 1898,43075 + goto g7772;1905,43222 + goto g7766;1910,43311 + t11 1917,43409 + goto g7773;1924,43557 + goto g7766;1929,43646 + t2 1936,43744 + goto *r0;r01937,43774 + t2 1941,43838 + goto *r0;r01942,43865 + t8 1946,43929 + t7 1948,43998 + t5 1949,44020 + t4 1951,44069 + goto g7850;1952,44094 + t1 1959,44218 + goto g7849;1960,44234 + t11 1965,44337 + t10 1968,44423 + *(u64 *)&processor->vma vma1970,44484 + t10 1972,44551 + t11 1974,44606 + t10 1978,44669 + t4 1981,44738 + t4 1982,44756 + goto g7860;1983,44799 + t10 1992,44899 + t8 1993,44934 + t7 1996,45004 + t10 1997,45020 + t7 1999,45078 + t8 2000,45094 + t8 2001,45104 + t7 2002,45141 + t7 2004,45197 + t8 2005,45213 + t7 2007,45257 + t5 2009,45296 + t10 2011,45337 + t1 2016,45459 + goto g7849;2017,45475 + goto dbcachemisstrap;2021,45531 + arg1 2026,45600 + arg2 2027,45614 + goto performmemoryaction;2028,45626 + t8 2032,45696 + t7 2034,45765 + arg5 2035,45787 + t4 2037,45838 + goto g7838;2038,45863 + t1 2045,45987 + goto g7837;2046,46005 + t11 2051,46108 + t10 2054,46194 + *(u64 *)&processor->vma vma2056,46255 + t10 2058,46322 + t11 2060,46377 + t10 2064,46440 + t4 2067,46509 + t4 2068,46527 + goto g7848;2069,46570 + t10 2078,46670 + t8 2079,46705 + t7 2082,46775 + t10 2083,46791 + t7 2085,46849 + t8 2086,46865 + t8 2087,46875 + t7 2088,46912 + t7 2090,46968 + t8 2091,46984 + t7 2093,47028 + arg5 2095,47067 + t10 2097,47110 + t1 2102,47232 + goto g7837;2103,47250 + goto dbcachemisstrap;2107,47306 + arg1 2112,47375 + arg2 2113,47389 + goto performmemoryaction;2114,47401 + t8 2118,47471 + t7 2120,47540 + arg6 2121,47562 + t4 2123,47613 + goto g7826;2124,47638 + t1 2131,47762 + goto g7825;2132,47780 + t11 2137,47883 + t10 2140,47969 + *(u64 *)&processor->vma vma2142,48030 + t10 2144,48097 + t11 2146,48152 + t10 2150,48215 + t4 2153,48284 + t4 2154,48302 + goto g7836;2155,48345 + t10 2164,48445 + t8 2165,48480 + t7 2168,48550 + t10 2169,48566 + t7 2171,48624 + t8 2172,48640 + t8 2173,48650 + t7 2174,48687 + t7 2176,48743 + t8 2177,48759 + t7 2179,48803 + arg6 2181,48842 + t10 2183,48885 + t1 2188,49007 + goto g7825;2189,49025 + goto dbcachemisstrap;2193,49081 + arg1 2198,49150 + arg2 2199,49164 + goto performmemoryaction;2200,49176 + t8 2204,49246 + t7 2206,49315 + t4 2207,49337 + t6 2209,49386 + goto g7816;2210,49411 + t5 2217,49535 + goto g7815;2218,49551 + t11 2223,49654 + t10 2226,49738 + *(u64 *)&processor->vma vma2228,49799 + t10 2230,49866 + t11 2232,49921 + arg1 2236,49980 + arg2 2237,49994 + goto performmemoryaction;2238,50006 + t8 2242,50076 + t7 2244,50145 + t5 2245,50167 + t6 2247,50216 + goto g7800;2248,50241 + t1 2255,50365 + goto g7799;2256,50381 + t11 2261,50484 + t10 2264,50570 + *(u64 *)&processor->vma vma2266,50631 + t10 2268,50698 + t11 2270,50753 + t10 2274,50816 + t6 2277,50885 + t6 2278,50903 + goto g7810;2279,50946 + t10 2288,51046 + t8 2289,51081 + t7 2292,51151 + t10 2293,51167 + t7 2295,51225 + t8 2296,51241 + t8 2297,51251 + t7 2298,51288 + t7 2300,51344 + t8 2301,51360 + t7 2303,51404 + t5 2305,51443 + t10 2307,51484 + t1 2312,51606 + goto g7799;2313,51622 + goto dbcachemisstrap;2317,51678 + arg1 2322,51747 + arg2 2323,51761 + goto performmemoryaction;2324,51773 + t8 2328,51843 + t7 2330,51912 + arg3 2331,51934 + t6 2333,51985 + goto g7788;2334,52010 + t1 2341,52134 + goto g7787;2342,52152 + t11 2347,52255 + t10 2350,52341 + *(u64 *)&processor->vma vma2352,52402 + t10 2354,52469 + t11 2356,52524 + t10 2360,52587 + t6 2363,52656 + t6 2364,52674 + goto g7798;2365,52717 + t10 2374,52817 + t8 2375,52852 + t7 2378,52922 + t10 2379,52938 + t7 2381,52996 + t8 2382,53012 + t8 2383,53022 + t7 2384,53059 + t7 2386,53115 + t8 2387,53131 + t7 2389,53175 + arg3 2391,53214 + t10 2393,53257 + t1 2398,53379 + goto g7787;2399,53397 + goto dbcachemisstrap;2403,53453 + arg1 2408,53522 + arg2 2409,53536 + goto performmemoryaction;2410,53548 + t8 2414,53618 + t7 2416,53687 + arg4 2417,53709 + t6 2419,53760 + goto g7776;2420,53785 + t1 2427,53909 + goto g7775;2428,53927 + t11 2433,54030 + t10 2436,54116 + *(u64 *)&processor->vma vma2438,54177 + t10 2440,54244 + t11 2442,54299 + t10 2446,54362 + t6 2449,54431 + t6 2450,54449 + goto g7786;2451,54492 + t10 2460,54592 + t8 2461,54627 + t7 2464,54697 + t10 2465,54713 + t7 2467,54771 + t8 2468,54787 + t8 2469,54797 + t7 2470,54834 + t7 2472,54890 + t8 2473,54906 + t7 2475,54950 + arg4 2477,54989 + t10 2479,55032 + t1 2484,55154 + goto g7775;2485,55172 + goto dbcachemisstrap;2489,55228 + arg1 2494,55297 + arg2 2495,55311 + goto performmemoryaction;2496,55323 + arg1 2512,55669 + goto begindofastaset1;2520,55818 + goto begindofastaset1;2526,55923 + arg1 2536,56147 + arg4 2538,56189 + arg3 2540,56225 + iSP 2542,56272 + arg4 2543,56289 + t11 2545,56323 + t10 2547,56358 + iSP 2549,56404 + t11 2550,56421 + t1 2551,56439 + t1 2553,56489 + arg6 2559,56603 + t9 2560,56626 + t3 2561,56653 + arg6 2562,56681 + t9 2563,56701 + t5 2564,56717 + t3 2565,56736 + t4 2566,56752 + t5 2567,56795 + t2 2568,56812 + t6 2571,56891 + t6 2574,56960 + t7 2575,57012 + t8 2576,57063 + t6 2577,57115 + t7 2578,57158 + t8 2579,57200 + t1 2582,57299 + t12 2583,57316 + t2 2590,57493 + arg5 2593,57552 + arg2 2594,57564 + goto illegaloperand;2595,57577 + t2 2602,57715 + t2 2604,57755 + t1 2605,57779 + t1 2606,57793 + t1 2608,57847 + t1 2609,57859 + t1 2610,57876 + arg5 2614,57954 + arg2 2615,57966 + goto illegaloperand;2616,57979 + t12 2620,58044 + t2 2627,58215 + arg5 2630,58271 + arg2 2631,58283 + goto illegaloperand;2632,58296 + t12 2636,58361 + t11 2643,58534 + t1 2644,58545 + t11 2648,58617 + goto g7879;2649,58631 + t1 2660,58802 + t1 2664,58914 + t4 2669,58997 + t12 2670,59045 + t5 2671,59065 + t3 2672,59103 + t2 2673,59121 + t4 2675,59167 + arg3 2676,59183 + t5 2678,59248 + t3 2679,59284 + t2 2680,59303 + t12 2685,59374 + arg3 2686,59394 + t12 2687,59422 + t3 2693,59511 + t2 2694,59528 + t2 2695,59545 + t5 2696,59561 + t4 2697,59609 + arg3 2698,59628 + t3 2699,59668 + t12 2700,59685 + t5 2702,59731 + arg3 2704,59765 + t5 2705,59805 + t12 2706,59839 + t12 2710,59917 + *(u32 *)t3 2712,59953 + goto NEXTINSTRUCTION;2716,60029 + goto NEXTINSTRUCTION;2717,60053 + arg4 2722,60160 + t1 2724,60221 + t1 2726,60287 + t2 2731,60368 + t4 2732,60416 + t3 2733,60435 + t9 2734,60473 + arg5 2735,60490 + t2 2737,60537 + t5 2738,60553 + t3 2740,60615 + t9 2741,60651 + arg5 2742,60670 + t4 2747,60744 + t5 2748,60763 + t4 2749,60789 + t9 2750,60815 + t2 2757,60920 + t2 2758,60938 + t12 2765,61108 + t12 2766,61123 + t2 2767,61149 + t12 2769,61197 + t2 2770,61218 + t2 2772,61267 + t12 2773,61292 + t12 2775,61333 + t3 2776,61359 + t3 2777,61373 + t4 2779,61428 + t5 2784,61580 + t12 2786,61630 + t5 2788,61697 + t9 2790,61768 + t5 2792,61822 + t9 2794,61879 + t12 2796,61946 + t5 2798,61989 + t5 2800,62030 + t9 2802,62085 + goto g7918;2803,62101 + t9 2809,62234 + t12 2811,62297 + t9 2813,62368 + t11 2817,62427 + t3 2821,62481 + t2 2822,62529 + t12 2823,62548 + t5 2824,62587 + t4 2825,62604 + t3 2827,62649 + t12 2829,62683 + t3 2830,62721 + t4 2831,62757 + t4 2835,62833 + *(u32 *)t5 2837,62866 + goto NEXTINSTRUCTION;2841,62941 + goto NEXTINSTRUCTION;2842,62965 + arg5 2846,63031 + arg2 2847,63044 + goto illegaloperand;2848,63057 + arg5 2852,63136 + arg2 2853,63148 + goto illegaloperand;2854,63161 + arg5 2858,63246 + arg2 2859,63258 + goto illegaloperand;2860,63271 + t3 2864,63336 + t2 2868,63426 + t3 2870,63498 + t2 2872,63538 + *(u32 *)t2 2874,63583 + goto NEXTINSTRUCTION;2877,63660 + t3 2881,63726 + t2 2883,63795 + t9 2884,63817 + arg5 2886,63866 + goto g7906;2887,63893 + t1 2894,64016 + goto g7905;2895,64032 + t5 2900,64135 + t4 2903,64220 + *(u64 *)&processor->vma vma2905,64282 + t4 2907,64349 + t5 2909,64401 + t4 2913,64462 + arg5 2916,64528 + arg5 2917,64550 + goto g7916;2918,64597 + t4 2927,64697 + t3 2928,64730 + t2 2931,64799 + t4 2932,64815 + t2 2934,64872 + t3 2935,64888 + t3 2936,64898 + t2 2937,64935 + t2 2939,64990 + t3 2940,65006 + t2 2942,65050 + t9 2944,65089 + t4 2946,65130 + t1 2951,65250 + goto g7905;2952,65266 + goto dbcachemisstrap;2956,65322 + arg1 2961,65391 + arg2 2962,65404 + goto performmemoryaction;2963,65416 + t5 2967,65486 + t4 2971,65576 + t5 2973,65648 + t4 2975,65688 + *(u32 *)t4 2977,65733 + goto NEXTINSTRUCTION;2980,65808 + t5 2984,65874 + t4 2986,65943 + t3 2987,65965 + t2 2989,66014 + goto g7893;2990,66039 + t1 2997,66163 + goto g7892;2998,66179 + arg3 3003,66282 + t12 3006,66370 + *(u64 *)&processor->vma vma3008,66431 + t12 3010,66498 + arg3 3012,66554 + t12 3021,66662 + t5 3022,66698 + t4 3025,66768 + t12 3026,66784 + t4 3028,66842 + t5 3029,66858 + t5 3030,66868 + t4 3031,66905 + t4 3033,66961 + t5 3034,66977 + t4 3036,67021 + t3 3038,67060 + t12 3040,67101 + t1 3045,67223 + goto g7892;3046,67239 + goto dbcachemisstrap;3050,67295 + arg1 3055,67364 + arg2 3056,67379 + goto performmemoryaction;3057,67391 + goto doistageerror;3062,67457 + arg1 3080,67896 + goto headdoarrayleader;3088,68045 + goto headdoarrayleader;3094,68155 + arg1 3103,68348 + arg1 3105,68400 + arg4 3111,68591 + arg3 3113,68651 + iSP 3115,68698 + arg4 3116,68715 + arg2 3118,68754 + arg1 3120,68792 + t1 3121,68813 + t1 3123,68863 + t1 3129,68983 + t1 3131,69042 + t11 3134,69104 + t12 3136,69193 + t3 3140,69269 + arg5 3141,69290 + arg6 3142,69309 + t1 3144,69356 + t4 3145,69375 + t2 3147,69435 + arg5 3148,69472 + arg6 3149,69495 + t3 3154,69569 + t4 3155,69587 + t3 3156,69613 + t1 3162,69694 + t1 3163,69712 + t8 3166,69778 + t8 3167,69828 + t1 3168,69869 + arg2 3171,69950 + arg2 3172,69972 + t3 3176,70028 + arg5 3177,70049 + arg6 3178,70068 + t1 3180,70115 + t4 3181,70134 + t2 3183,70196 + arg5 3184,70233 + arg6 3185,70256 + t3 3190,70330 + t4 3191,70349 + t3 3192,70375 + t1 3198,70460 + iSP 3202,70563 + goto NEXTINSTRUCTION;3203,70580 + arg1 3207,70676 + t1 3209,70714 + t1 3210,70733 + arg6 3212,70785 + arg3 3214,70822 + arg1 3216,70867 + arg4 3218,70906 + arg5 3219,70918 + arg2 3220,70930 + goto arrayexception;3221,70943 + arg5 3225,71026 + arg2 3226,71038 + goto illegaloperand;3227,71051 + arg5 3231,71140 + arg2 3232,71152 + goto illegaloperand;3233,71165 + goto DoArrayLeaderIM;3235,71203 + arg4 3241,71334 + arg3 3243,71394 + iSP 3245,71441 + arg4 3246,71458 + goto arrayleadermerge;3247,71478 + t2 3251,71545 + t1 3253,71614 + arg5 3254,71636 + arg6 3256,71687 + goto g7934;3257,71714 + arg2 3264,71837 + goto g7933;3265,71857 + t4 3270,71960 + t3 3273,72045 + *(u64 *)&processor->vma vma3275,72107 + t3 3277,72176 + t4 3279,72228 + t3 3283,72289 + arg6 3286,72355 + arg6 3287,72377 + goto g7944;3288,72424 + t3 3297,72524 + t2 3298,72557 + t1 3301,72626 + t3 3302,72644 + t1 3304,72701 + t2 3305,72717 + t2 3306,72727 + t1 3307,72764 + t1 3309,72819 + t2 3310,72835 + t1 3312,72879 + arg5 3314,72918 + t3 3316,72961 + arg2 3321,73083 + goto g7933;3322,73103 + goto dbcachemisstrap;3326,73159 + arg1 3331,73228 + arg2 3332,73241 + goto performmemoryaction;3333,73253 + t2 3337,73323 + t1 3339,73392 + arg5 3340,73414 + arg6 3342,73465 + goto g7924;3343,73492 + arg4 3350,73615 + goto g7923;3351,73635 + t4 3356,73738 + t3 3359,73821 + *(u64 *)&processor->vma vma3361,73883 + t3 3363,73952 + t4 3365,74004 + arg1 3369,74061 + arg2 3370,74074 + goto performmemoryaction;3371,74086 + arg1 3388,74542 + goto headdostorearrayleader;3396,74691 + goto headdostorearrayleader;3402,74816 + arg1 3411,75034 + arg1 3413,75086 + arg4 3419,75287 + arg3 3421,75347 + iSP 3423,75394 + arg4 3424,75411 + t7 3426,75465 + t6 3428,75519 + iSP 3430,75564 + t7 3431,75581 + arg2 3433,75616 + arg1 3435,75654 + t1 3436,75675 + t1 3438,75725 + t1 3444,75860 + t1 3446,75919 + t11 3449,75986 + t12 3451,76075 + t3 3455,76151 + arg5 3456,76172 + arg6 3457,76191 + t1 3459,76238 + t4 3460,76257 + t2 3462,76317 + arg5 3463,76354 + arg6 3464,76377 + t3 3469,76451 + t4 3470,76469 + t3 3471,76495 + t1 3477,76576 + t1 3478,76594 + t2 3481,76665 + t2 3482,76715 + t1 3483,76756 + arg2 3486,76842 + arg2 3487,76864 + t5 3491,76920 + t2 3492,76941 + t1 3493,76958 + t3 3495,77003 + t8 3496,77022 + t4 3498,77085 + t2 3499,77122 + t1 3500,77141 + t5 3505,77211 + t8 3506,77230 + t5 3507,77254 + t2 3513,77339 + t1 3514,77355 + t1 3515,77372 + t3 3516,77388 + t2 3517,77409 + t5 3518,77426 + t4 3520,77471 + t8 3522,77508 + t4 3523,77545 + t5 3524,77579 + t5 3528,77655 + *(u32 *)t2 3530,77688 + goto NEXTINSTRUCTION;3534,77761 + goto NEXTINSTRUCTION;3535,77785 + arg1 3539,77891 + t1 3541,77929 + t1 3542,77948 + arg6 3544,78000 + arg3 3546,78037 + arg1 3548,78082 + arg4 3550,78121 + arg5 3551,78133 + arg2 3552,78145 + goto arrayexception;3553,78158 + arg5 3557,78251 + arg2 3558,78263 + goto illegaloperand;3559,78276 + arg5 3563,78375 + arg2 3564,78387 + goto illegaloperand;3565,78400 + goto DoStoreArrayLeaderIM;3567,78438 + arg4 3573,78584 + arg3 3575,78644 + iSP 3577,78691 + arg4 3578,78708 + t7 3580,78762 + t6 3582,78816 + iSP 3584,78861 + t7 3585,78878 + goto storearrayleadermerge;3586,78894 + t3 3590,78966 + t4 3592,79038 + t3 3594,79081 + *(u32 *)t3 3596,79126 + goto NEXTINSTRUCTION;3599,79200 + t4 3603,79266 + t3 3605,79335 + t2 3606,79357 + t1 3608,79406 + goto g7956;3609,79431 + arg2 3616,79554 + goto g7955;3617,79572 + t8 3622,79675 + t5 3625,79761 + *(u64 *)&processor->vma vma3627,79821 + t5 3629,79890 + t8 3631,79942 + t5 3640,80047 + t4 3641,80080 + t3 3644,80149 + t5 3645,80167 + t3 3647,80224 + t4 3648,80240 + t4 3649,80250 + t3 3650,80287 + t3 3652,80342 + t4 3653,80358 + t3 3655,80402 + t2 3657,80441 + t5 3659,80482 + arg2 3664,80604 + goto g7955;3665,80622 + goto dbcachemisstrap;3669,80678 + arg1 3674,80747 + arg2 3675,80760 + goto performmemoryaction;3676,80772 + t2 3680,80842 + t1 3682,80911 + arg5 3683,80933 + arg6 3685,80984 + goto g7946;3686,81011 + arg4 3693,81134 + goto g7945;3694,81154 + t4 3699,81257 + t3 3702,81340 + *(u64 *)&processor->vma vma3704,81402 + t3 3706,81471 + t4 3708,81523 + arg1 3712,81580 + arg2 3713,81593 + goto performmemoryaction;3714,81605 + arg1 3731,82035 + goto headdoalocleader;3739,82184 + goto headdoalocleader;3745,82291 + arg1 3754,82479 + arg1 3756,82531 + arg4 3762,82720 + arg3 3764,82780 + iSP 3766,82827 + arg4 3767,82844 + arg2 3769,82883 + arg1 3771,82921 + t1 3772,82942 + t1 3774,82992 + t1 3780,83109 + t1 3782,83168 + t1 3789,83294 + t3 3790,83342 + t2 3791,83363 + arg5 3792,83401 + arg6 3793,83420 + t1 3795,83467 + t4 3796,83485 + t2 3798,83545 + arg5 3799,83581 + arg6 3800,83604 + t3 3805,83678 + t4 3806,83696 + t3 3807,83722 + t1 3813,83803 + t1 3814,83821 + t9 3817,83886 + t9 3818,83936 + t1 3819,83977 + arg2 3822,84057 + arg2 3823,84079 + t1 3824,84098 + iSP 3828,84205 + goto NEXTINSTRUCTION;3829,84222 + arg1 3833,84316 + t1 3835,84354 + t1 3836,84373 + arg6 3838,84425 + arg3 3840,84462 + arg1 3842,84507 + arg4 3844,84546 + arg5 3845,84558 + arg2 3846,84570 + goto arrayexception;3847,84583 + arg5 3851,84664 + arg2 3852,84676 + goto illegaloperand;3853,84689 + arg5 3857,84776 + arg2 3858,84788 + goto illegaloperand;3859,84801 + goto DoAlocLeaderIM;3861,84839 + arg4 3867,84967 + arg3 3869,85027 + iSP 3871,85074 + arg4 3872,85091 + goto alocleadermerge;3873,85111 + t2 3877,85177 + t1 3879,85246 + arg5 3880,85268 + arg6 3882,85319 + goto g7969;3883,85346 + arg4 3890,85469 + goto g7968;3891,85489 + t4 3896,85592 + t3 3899,85675 + *(u64 *)&processor->vma vma3901,85737 + t3 3903,85806 + t4 3905,85858 + arg1 3909,85915 + arg2 3910,85928 + goto performmemoryaction;3911,85940 + +stub/ifunbind.c,11600 + arg2 21,753 + arg2 26,847 + *(u32 *)&processor->immediate_arg immediate_arg27,873 + arg1 28,917 + goto begindobindlocativetovalue;29,963 + arg1 36,1121 + goto headdobindlocativetovalue;44,1270 + goto headdobindlocativetovalue;50,1404 + arg1 59,1637 + arg1 61,1689 + arg6 67,1873 + arg5 69,1914 + iSP 71,1961 + arg6 72,1978 + arg3 73,1998 + arg2 75,2066 + arg4 76,2087 + arg1 78,2154 + t1 79,2174 + t1 81,2226 + t2 85,2297 + arg3 87,2323 + arg4 88,2343 + t1 89,2363 + t3 93,2465 + t1 96,2537 + t1 98,2587 + t9 102,2652 + t8 103,2688 + t4 108,2766 + t6 109,2814 + t5 110,2833 + t1 111,2871 + t2 112,2888 + t4 114,2933 + t7 115,2949 + t5 117,3011 + t1 118,3047 + t2 119,3066 + t6 124,3136 + t7 125,3155 + t6 126,3179 + t10 131,3241 + t8 133,3276 + t10 135,3338 + t11 136,3356 + t5 137,3374 + t4 138,3422 + t8 139,3441 + t7 140,3479 + t6 141,3496 + t5 143,3541 + t8 145,3575 + t5 146,3611 + t6 147,3646 + t6 151,3722 + *(u32 *)t7 153,3755 + t3 159,3838 + t5 160,3855 + t4 161,3903 + t8 162,3922 + t7 163,3960 + t6 164,3977 + t5 166,4022 + t8 168,4056 + t5 169,4092 + t6 170,4126 + t6 174,4202 + *(u32 *)t7 176,4235 + t1 182,4316 + t6 187,4401 + t8 188,4449 + t7 189,4470 + t5 190,4508 + t4 191,4525 + t6 193,4570 + t10 194,4588 + t7 196,4652 + t5 197,4688 + t4 198,4707 + t8 203,4777 + t10 204,4796 + t8 205,4822 + t5 211,4908 + t4 212,4926 + t4 213,4943 + t7 214,4959 + t6 215,5007 + t10 216,5028 + t5 217,5067 + t8 218,5084 + t7 220,5129 + t10 222,5165 + t7 223,5203 + t8 224,5237 + t8 228,5313 + *(u32 *)t5 230,5346 + t9 237,5466 + *(u32 *)&processor->control control238,5482 + *(u32 *)&processor->bindingstackpointer bindingstackpointer240,5535 + goto NEXTINSTRUCTION;241,5583 + arg5 245,5667 + arg2 246,5679 + goto illegaloperand;247,5692 + arg5 251,5777 + arg2 252,5789 + goto illegaloperand;253,5802 + t1 258,5915 + t3 260,5998 + t2 261,6043 + t3 263,6132 + t3 265,6193 + t2 267,6233 + arg5 268,6249 + arg2 269,6262 + goto illegaloperand;270,6275 + t7 274,6340 + t6 278,6430 + t7 280,6502 + t6 282,6544 + *(u32 *)t6 284,6589 + goto g8642;287,6665 + t7 291,6721 + t6 293,6790 + t5 294,6812 + t4 296,6861 + goto g8633;297,6886 + arg6 304,7009 + goto g8632;305,7027 + t10 310,7130 + t8 313,7217 + *(u64 *)&processor->vma vma315,7277 + t8 317,7346 + t10 319,7399 + arg1 323,7457 + arg2 324,7471 + goto performmemoryaction;325,7483 + t5 329,7553 + t4 333,7643 + t5 335,7715 + t4 337,7755 + *(u32 *)t4 339,7800 + goto g8629;342,7874 + t5 346,7930 + t4 350,8020 + t5 352,8092 + t4 354,8132 + *(u32 *)t4 356,8177 + goto g8626;359,8254 + t5 363,8310 + t4 365,8379 + t1 366,8401 + t2 368,8450 + goto g8617;369,8475 + t8 376,8598 + goto g8616;377,8614 + t7 382,8717 + t6 385,8802 + *(u64 *)&processor->vma vma387,8862 + t6 389,8929 + t7 391,8981 + arg1 395,9038 + arg2 396,9051 + goto performmemoryaction;397,9063 + arg1 414,9511 + goto begindobindlocative;422,9660 + goto begindobindlocative;428,9774 + arg1 438,10013 + arg1 440,10065 + arg3 441,10088 + arg5 443,10152 + arg4 444,10173 + arg6 446,10236 + t1 447,10256 + t1 449,10308 + t2 453,10374 + arg3 455,10400 + arg4 456,10420 + t1 457,10440 + t3 461,10537 + t1 464,10609 + t1 466,10659 + t9 470,10719 + t8 471,10755 + t4 476,10833 + t6 477,10881 + t5 478,10900 + t1 479,10938 + t2 480,10955 + t4 482,11000 + t7 483,11016 + t5 485,11078 + t1 486,11114 + t2 487,11133 + t6 492,11203 + t7 493,11222 + t6 494,11246 + t10 499,11308 + t8 501,11343 + t10 503,11405 + t11 504,11423 + t5 505,11441 + t4 506,11489 + t8 507,11508 + t7 508,11546 + t6 509,11563 + t5 511,11608 + t8 513,11642 + t5 514,11678 + t6 515,11713 + t6 519,11789 + *(u32 *)t7 521,11822 + t3 527,11905 + t5 528,11922 + t4 529,11970 + t8 530,11989 + t7 531,12027 + t6 532,12044 + t5 534,12089 + t8 536,12123 + t5 537,12159 + t6 538,12193 + t6 542,12269 + *(u32 *)t7 544,12302 + t1 550,12383 + t9 552,12439 + *(u32 *)&processor->control control553,12455 + *(u32 *)&processor->bindingstackpointer bindingstackpointer555,12508 + goto NEXTINSTRUCTION;556,12556 + arg5 560,12630 + arg2 561,12642 + goto illegaloperand;562,12655 + arg5 566,12730 + arg2 567,12742 + goto illegaloperand;568,12755 + t1 573,12858 + t3 575,12941 + t2 576,12986 + t3 578,13075 + t3 580,13136 + t2 582,13176 + arg5 583,13192 + arg2 584,13205 + goto illegaloperand;585,13218 + t5 589,13283 + t4 593,13373 + t5 595,13445 + t4 597,13485 + *(u32 *)t4 599,13530 + goto g8662;602,13604 + t5 606,13660 + t4 610,13750 + t5 612,13822 + t4 614,13862 + *(u32 *)t4 616,13907 + goto g8659;619,13984 + t5 623,14040 + t4 625,14109 + t1 626,14131 + t2 628,14180 + goto g8650;629,14205 + t8 636,14328 + goto g8649;637,14344 + t7 642,14447 + t6 645,14532 + *(u64 *)&processor->vma vma647,14592 + t6 649,14659 + t7 651,14711 + arg1 655,14768 + arg2 656,14781 + goto performmemoryaction;657,14793 + goto doistageerror;662,14862 + *(u32 *)&processor->immediate_arg immediate_arg679,15271 + arg1 680,15315 + goto begindounbindn;681,15361 + arg1 688,15483 + goto headdounbindn;696,15632 + goto headdounbindn;702,15730 + arg1 711,15903 + arg1 713,15955 + arg3 719,16114 + arg2 721,16173 + arg1 722,16194 + t1 723,16214 + t1 725,16264 + t2 730,16371 + t1 731,16390 + t1 733,16440 + t11 737,16500 + t12 739,16589 + goto unbindnendloop;740,16628 + arg1 744,16711 + t1 745,16730 + t4 746,16780 + t1 748,16833 + t2 749,16849 + t5 750,16869 + t3 751,16884 + t4 753,16925 + t4 757,16999 + arg5 758,17039 + arg2 759,17051 + goto illegaloperand;760,17064 + arg4 767,17166 + t6 768,17187 + t7 769,17206 + t8 771,17253 + arg5 772,17270 + arg3 774,17334 + t6 775,17373 + t7 776,17392 + arg4 781,17466 + arg5 782,17487 + arg4 783,17515 + arg4 791,17620 + t2 792,17641 + t3 793,17660 + t8 795,17707 + arg5 796,17724 + arg3 798,17788 + t2 799,17827 + t3 800,17846 + arg4 805,17920 + arg5 806,17941 + arg4 807,17969 + t2 808,17997 + arg6 816,18090 + arg3 817,18111 + t8 818,18132 + arg4 820,18179 + arg5 822,18216 + arg3 823,18257 + t8 824,18280 + arg4 829,18354 + arg6 830,18401 + arg4 831,18422 + arg6 832,18450 + arg3 838,18541 + t8 839,18559 + t8 840,18576 + arg4 841,18594 + arg3 842,18615 + arg6 843,18636 + arg5 844,18658 + arg6 845,18696 + arg6 849,18778 + arg4 851,18821 + arg5 853,18888 + arg4 855,18925 + *(u32 *)arg3 856,18967 + t3 863,19093 + t3 864,19109 + t1 865,19126 + *(u32 *)&processor->bindingstackpointer bindingstackpointer867,19158 + t4 868,19206 + *(u32 *)&processor->control control869,19222 + t3 875,19364 + t4 876,19405 + t4 877,19420 + t3 878,19446 + *(u32 *)&processor->interruptreg interruptreg879,19462 + *(u64 *)&processor->stop_interpreter stop_interpreter882,19544 + goto NEXTINSTRUCTION;883,19589 + arg5 887,19665 + arg2 888,19677 + goto illegaloperand;889,19690 + t1 895,19807 + t3 897,19890 + t2 898,19935 + t3 900,20024 + t3 902,20085 + t2 904,20125 + arg5 905,20141 + arg2 906,20154 + goto illegaloperand;907,20167 + arg4 912,20239 + arg4 914,20310 + *(u32 *)arg4 916,20361 + goto g8698;919,20439 + arg5 923,20495 + arg4 925,20566 + arg3 926,20594 + t8 928,20647 + goto g8689;929,20674 + t2 936,20799 + goto g8688;937,20817 + arg4 942,20920 + arg6 945,21008 + *(u64 *)&processor->vma vma947,21070 + arg6 949,21137 + arg4 951,21195 + arg1 955,21256 + arg2 956,21271 + goto performmemoryaction;957,21283 + arg3 961,21353 + t8 963,21424 + t2 964,21448 + t3 966,21497 + goto g8679;967,21522 + t5 974,21647 + goto g8678;975,21663 + arg5 980,21766 + arg4 983,21853 + *(u64 *)&processor->vma vma985,21915 + arg4 987,21982 + arg5 989,22040 + arg1 993,22101 + arg2 994,22116 + goto performmemoryaction;995,22128 + arg3 999,22198 + t8 1001,22269 + t6 1002,22293 + t7 1004,22342 + goto g8669;1005,22367 + t1 1012,22492 + goto g8668;1013,22508 + arg5 1018,22611 + arg4 1021,22698 + *(u64 *)&processor->vma vma1023,22760 + arg4 1025,22827 + arg5 1027,22885 + arg1 1031,22946 + arg2 1032,22961 + goto performmemoryaction;1033,22973 + *(u32 *)&processor->immediate_arg immediate_arg1050,23450 + arg1 1051,23494 + goto begindorestorebindingstack;1052,23540 + arg1 1059,23698 + goto headdorestorebindingstack;1067,23847 + goto headdorestorebindingstack;1073,23981 + arg1 1082,24214 + arg1 1084,24266 + arg3 1090,24449 + arg2 1092,24508 + arg1 1093,24529 + t1 1094,24549 + t1 1096,24601 + t2 1101,24710 + t1 1102,24729 + t1 1104,24779 + t1 1108,24841 + t11 1109,24891 + t12 1111,24980 + goto restorebsendloop;1112,25019 + t1 1116,25108 + t4 1117,25158 + t1 1119,25211 + t2 1120,25227 + t5 1121,25247 + t3 1122,25262 + t4 1124,25303 + t4 1128,25377 + arg5 1129,25417 + arg2 1130,25429 + goto illegaloperand;1131,25442 + arg4 1138,25544 + t6 1139,25565 + t7 1140,25584 + t8 1142,25631 + arg5 1143,25648 + arg3 1145,25712 + t6 1146,25751 + t7 1147,25770 + arg4 1152,25844 + arg5 1153,25865 + arg4 1154,25893 + arg4 1162,25998 + t2 1163,26019 + t3 1164,26038 + t8 1166,26085 + arg5 1167,26102 + arg3 1169,26166 + t2 1170,26205 + t3 1171,26224 + arg4 1176,26298 + arg5 1177,26319 + arg4 1178,26347 + t2 1179,26375 + arg6 1187,26468 + arg3 1188,26489 + t8 1189,26510 + arg4 1191,26557 + arg5 1193,26594 + arg3 1194,26635 + t8 1195,26658 + arg4 1200,26732 + arg6 1201,26779 + arg4 1202,26800 + arg6 1203,26828 + arg3 1209,26919 + t8 1210,26937 + t8 1211,26954 + arg4 1212,26972 + arg3 1213,26993 + arg6 1214,27014 + arg5 1215,27036 + arg6 1216,27074 + arg6 1220,27156 + arg4 1222,27199 + arg5 1224,27266 + arg4 1226,27303 + *(u32 *)arg3 1227,27345 + t3 1234,27471 + t3 1235,27487 + t1 1236,27504 + *(u32 *)&processor->bindingstackpointer bindingstackpointer1238,27536 + t4 1239,27584 + *(u32 *)&processor->control control1240,27600 + arg4 1244,27700 + t3 1247,27778 + t4 1248,27819 + t4 1249,27834 + t3 1250,27860 + *(u32 *)&processor->interruptreg interruptreg1251,27876 + *(u64 *)&processor->stop_interpreter stop_interpreter1254,27958 + goto NEXTINSTRUCTION;1255,28003 + arg5 1259,28083 + arg2 1260,28095 + goto illegaloperand;1261,28108 + t1 1267,28229 + t3 1269,28312 + t2 1270,28357 + t3 1272,28446 + t3 1274,28507 + t2 1276,28547 + arg5 1277,28563 + arg2 1278,28576 + goto illegaloperand;1279,28589 + arg4 1284,28661 + arg4 1286,28732 + *(u32 *)arg4 1288,28783 + goto g8732;1291,28861 + arg5 1295,28917 + arg4 1297,28988 + arg3 1298,29016 + t8 1300,29069 + goto g8723;1301,29096 + t2 1308,29221 + goto g8722;1309,29239 + arg4 1314,29342 + arg6 1317,29430 + *(u64 *)&processor->vma vma1319,29492 + arg6 1321,29559 + arg4 1323,29617 + arg1 1327,29678 + arg2 1328,29693 + goto performmemoryaction;1329,29705 + arg3 1333,29775 + t8 1335,29846 + t2 1336,29870 + t3 1338,29919 + goto g8713;1339,29944 + t5 1346,30069 + goto g8712;1347,30085 + arg5 1352,30188 + arg4 1355,30275 + *(u64 *)&processor->vma vma1357,30337 + arg4 1359,30404 + arg5 1361,30462 + arg1 1365,30523 + arg2 1366,30538 + goto performmemoryaction;1367,30550 + arg3 1371,30620 + t8 1373,30691 + t6 1374,30715 + t7 1376,30764 + goto g8703;1377,30789 + t1 1384,30914 + goto g8702;1385,30930 + arg5 1390,31033 + arg4 1393,31120 + *(u64 *)&processor->vma vma1395,31182 + arg4 1397,31249 + arg5 1399,31307 + arg1 1403,31368 + arg2 1404,31383 + goto performmemoryaction;1405,31395 + +stub/ifunbits.c,7013 + arg1 20,592 + goto headdologand;28,741 + goto headdologand;34,836 + arg1 43,1004 + arg1 45,1056 + t3 51,1225 + t4 53,1278 + t1 55,1324 + t6 56,1356 + t6 58,1404 + t6 61,1451 + t6 63,1499 + t4 68,1620 + iPC 69,1638 + iCP 70,1688 + r31 71,1734 + t4 73,1777 + t1 74,1793 + *(u32 *)iSP 76,1833 + goto cachevalid;79,1909 + arg6 84,2004 + arg3 86,2039 + arg1 88,2084 + arg4 90,2123 + goto numericexception;91,2135 + arg6 96,2236 + arg3 98,2271 + arg1 100,2316 + arg4 102,2355 + goto numericexception;103,2367 + goto DoLogandIM;105,2407 + t3 111,2511 + arg2 112,2537 + t4 114,2585 + arg2 115,2605 + t6 116,2631 + t6 118,2679 + t4 123,2800 + iPC 124,2818 + iCP 125,2868 + r31 126,2914 + t4 128,2957 + t1 129,2973 + *(u32 *)iSP 131,3013 + goto cachevalid;134,3089 + arg1 138,3150 + arg2 139,3172 + t1 141,3208 + t1 142,3227 + arg6 144,3279 + arg3 146,3314 + arg1 148,3359 + arg4 150,3398 + goto numericexception;151,3410 + arg1 168,3793 + goto headdologior;176,3942 + goto headdologior;182,4037 + arg1 191,4205 + arg1 193,4257 + t3 199,4426 + t4 201,4479 + t1 203,4525 + t6 204,4557 + t6 206,4605 + t6 209,4652 + t6 211,4700 + t4 216,4821 + iPC 217,4839 + iCP 218,4889 + r31 219,4935 + t4 221,4978 + t1 222,4994 + *(u32 *)iSP 224,5034 + goto cachevalid;227,5110 + arg6 232,5205 + arg3 234,5240 + arg1 236,5285 + arg4 238,5324 + goto numericexception;239,5336 + arg6 244,5437 + arg3 246,5472 + arg1 248,5517 + arg4 250,5556 + goto numericexception;251,5568 + goto DoLogiorIM;253,5608 + t3 259,5712 + arg2 260,5738 + t4 262,5786 + arg2 263,5806 + t6 264,5832 + t6 266,5880 + t4 271,6001 + iPC 272,6019 + iCP 273,6069 + r31 274,6115 + t4 276,6158 + t1 277,6174 + *(u32 *)iSP 279,6214 + goto cachevalid;282,6290 + arg1 286,6351 + arg2 287,6373 + t1 289,6409 + t1 290,6428 + arg6 292,6480 + arg3 294,6515 + arg1 296,6560 + arg4 298,6599 + goto numericexception;299,6611 + arg1 316,6994 + goto headdologxor;324,7143 + goto headdologxor;330,7238 + arg1 339,7406 + arg1 341,7458 + t3 347,7627 + t4 349,7680 + t1 351,7726 + t6 352,7758 + t6 354,7806 + t6 357,7853 + t6 359,7901 + t4 364,8022 + iPC 365,8040 + iCP 366,8090 + r31 367,8136 + t4 369,8179 + t1 370,8195 + *(u32 *)iSP 372,8235 + goto cachevalid;375,8311 + arg6 380,8406 + arg3 382,8441 + arg1 384,8486 + arg4 386,8525 + goto numericexception;387,8537 + arg6 392,8638 + arg3 394,8673 + arg1 396,8718 + arg4 398,8757 + goto numericexception;399,8769 + goto DoLogxorIM;401,8809 + t3 407,8913 + arg2 408,8939 + t4 410,8987 + arg2 411,9007 + t6 412,9033 + t6 414,9081 + t4 419,9202 + iPC 420,9220 + iCP 421,9270 + r31 422,9316 + t4 424,9359 + t1 425,9375 + *(u32 *)iSP 427,9415 + goto cachevalid;430,9491 + arg1 434,9552 + arg2 435,9574 + t1 437,9610 + t1 438,9629 + arg6 440,9681 + arg3 442,9716 + arg1 444,9761 + arg4 446,9800 + goto numericexception;447,9812 + arg2 465,10244 + arg2 470,10338 + *(u32 *)&processor->immediate_arg immediate_arg471,10364 + arg1 472,10408 + goto begindoash;473,10454 + arg1 480,10564 + goto headdoash;488,10713 + goto headdoash;494,10799 + arg1 503,10952 + arg1 505,11004 + arg4 511,11155 + arg3 512,11177 + arg4 513,11205 + arg2 515,11249 + arg1 517,11313 + t1 519,11370 + t3 521,11425 + t2 522,11443 + t4 529,11588 + arg4 543,11918 + arg5 544,11938 + arg5 548,12017 + arg6 549,12047 + arg6 551,12112 + arg2 553,12150 + *(u32 *)iSP 557,12229 + goto NEXTINSTRUCTION;560,12309 + arg1 564,12377 + arg4 566,12441 + arg5 568,12481 + arg2 570,12533 + *(u32 *)iSP 571,12553 + goto NEXTINSTRUCTION;574,12633 + arg5 578,12701 + *(u32 *)iSP 579,12723 + goto NEXTINSTRUCTION;582,12803 + arg1 593,12986 + t2 595,13022 + t2 596,13041 + arg6 598,13093 + arg3 600,13130 + arg1 602,13175 + arg4 604,13214 + goto numericexception;605,13226 + goto g8328;606,13251 + arg1 610,13307 + t2 612,13343 + t2 613,13362 + arg6 615,13414 + arg3 617,13451 + arg1 619,13496 + arg4 621,13535 + goto numericexception;622,13547 + arg1 632,13704 + t1 634,13740 + t1 635,13759 + arg6 637,13811 + arg3 639,13848 + arg1 641,13893 + arg4 643,13932 + goto exception;644,13944 + arg1 661,14296 + arg6 665,14376 + arg1 667,14419 + iSP 669,14451 + goto begindorot;671,14480 + goto begindorot;677,14567 + arg1 687,14761 + t4 692,14857 + t7 693,14890 + t1 695,14965 + t5 697,15009 + t4 699,15067 + t2 701,15109 + t4 702,15130 + t8 703,15155 + t5 705,15231 + t2 708,15278 + t5 709,15294 + t2 716,15431 + t3 718,15487 + t6 720,15536 + t3 722,15618 + iPC 726,15676 + *(u32 *)iSP 728,15729 + iCP 729,15749 + goto cachevalid;730,15761 + goto DoRotIM;732,15795 + *(u32 *)&processor->immediate_arg immediate_arg737,15864 + arg1 738,15908 + goto g8340;739,15949 + arg5 743,16005 + arg2 744,16017 + goto illegaloperand;745,16030 + arg1 762,16387 + arg6 766,16467 + arg1 768,16510 + iSP 770,16542 + goto begindolsh;772,16571 + goto begindolsh;778,16658 + arg1 788,16852 + t4 793,16948 + t7 794,16981 + t1 796,17056 + t5 798,17100 + t4 800,17158 + t2 802,17200 + t4 803,17221 + t8 804,17246 + t5 806,17322 + t5 809,17369 + t3 818,17531 + t3 822,17607 + goto lshdone;823,17631 + t2 827,17691 + t3 828,17709 + t3 832,17786 + goto lshdone;833,17810 + t3 837,17878 + iPC 844,17983 + *(u32 *)iSP 846,18036 + iCP 847,18056 + goto cachevalid;848,18068 + goto DoLshIM;850,18102 + arg2 856,18210 + arg2 861,18304 + *(u32 *)&processor->immediate_arg immediate_arg862,18330 + arg1 863,18374 + goto g8344;864,18415 + arg5 868,18471 + arg2 869,18483 + goto illegaloperand;870,18496 + arg1 887,18889 + arg6 891,18975 + arg1 893,19018 + iSP 895,19050 + goto begindo32bitplus;897,19079 + goto begindo32bitplus;903,19184 + arg1 913,19408 + t4 918,19504 + t7 919,19537 + t1 921,19612 + t5 923,19656 + t4 925,19714 + t2 927,19756 + t4 928,19777 + t8 929,19802 + t5 931,19878 + t2 934,19925 + t5 935,19941 + t3 942,20071 + iPC 946,20129 + *(u32 *)iSP 948,20182 + iCP 949,20202 + goto cachevalid;950,20214 + goto Do32BitPlusIM;952,20248 + *(u32 *)&processor->immediate_arg immediate_arg957,20335 + arg1 958,20379 + goto g8349;959,20420 + arg5 963,20476 + arg2 964,20488 + goto illegaloperand;965,20501 + arg1 982,20942 + arg6 986,21034 + arg1 988,21077 + iSP 990,21109 + goto begindo32bitdifference;992,21138 + goto begindo32bitdifference;998,21261 + arg1 1008,21515 + t4 1013,21611 + t7 1014,21644 + t1 1016,21719 + t5 1018,21763 + t4 1020,21821 + t2 1022,21863 + t4 1023,21884 + t8 1024,21909 + t5 1026,21985 + t2 1029,22032 + t5 1030,22048 + t3 1037,22185 + iPC 1041,22243 + *(u32 *)iSP 1043,22296 + iCP 1044,22316 + goto cachevalid;1045,22328 + goto Do32BitDifferenceIM;1047,22362 + *(u32 *)&processor->immediate_arg immediate_arg1052,22467 + arg1 1053,22511 + goto g8353;1054,22552 + arg5 1058,22608 + arg2 1059,22620 + goto illegaloperand;1060,22633 + +stub/ifunblok.c,14054 + arg1 28,811 + arg2 30,882 + goto blockread;31,914 + arg2 49,1395 + arg2 54,1489 + *(u32 *)&processor->immediate_arg immediate_arg55,1515 + arg1 56,1559 + goto begindoblock0write;57,1605 + arg1 64,1739 + goto headdoblock0write;72,1888 + goto headdoblock0write;78,1998 + arg1 87,2191 + arg1 89,2243 + arg3 94,2392 + arg2 95,2427 + goto blockwrite;96,2459 + arg1 121,3111 + arg2 123,3182 + goto blockreadshift;124,3214 + arg1 149,3878 + arg2 151,3949 + goto blockreadshift;152,3981 + arg1 177,4645 + arg2 179,4716 + goto blockreadshift;180,4748 + arg1 205,5412 + arg2 207,5483 + arg5 211,5575 + arg6 213,5665 + t2 215,5725 + t1 217,5765 + t4 219,5806 + t5 221,5847 + t6 223,5887 + t2 224,5905 + t11 228,5958 + t12 230,6015 + t8 231,6033 + t12 232,6052 + t7 233,6079 + t9 235,6124 + t12 236,6142 + t10 238,6214 + t7 239,6253 + t8 240,6272 + t12 245,6344 + t7 246,6370 + t9 254,6505 + t9 256,6553 + t2 266,6757 + *(u32 *)arg2 271,6847 + t8 275,6947 + t1 279,7005 + t3 281,7045 + t4 283,7107 + t2 285,7169 + t2 287,7222 + t5 288,7237 + t2 295,7402 + t6 299,7455 + t6 301,7509 + t7 302,7524 + t5 303,7548 + t7 304,7579 + t7 306,7615 + *(u64 *)&processor->rotatelatch rotatelatch310,7713 + t6 314,7795 + t6 315,7813 + t6 317,7858 + t5 319,7896 + t5 320,7913 + t4 321,7928 + t6 329,8111 + t7 334,8198 + t2 336,8239 + t7 337,8256 + iPC 338,8272 + iCP 339,8322 + iSP 343,8451 + goto cachevalid;344,8468 + arg5 348,8529 + arg2 349,8542 + goto illegaloperand;350,8555 + t4 354,8620 + goto g8380;360,8737 + t5 364,8793 + t2 371,8974 + goto g8374;372,9016 + t5 376,9072 + t2 383,9239 + goto g8374;384,9252 + t10 388,9308 + t9 390,9378 + t7 391,9401 + t8 393,9450 + goto g8362;394,9475 + t12 402,9610 + t12 403,9628 + t12 404,9655 + t11 407,9750 + *(u64 *)&processor->vma vma409,9811 + t11 411,9878 + t12 413,9933 + t10 417,9996 + t2 421,10094 + goto g8361;422,10110 + t11 426,10166 + t8 429,10235 + t8 430,10253 + goto g8372;431,10296 + t11 440,10396 + t10 441,10431 + t9 444,10502 + t11 445,10518 + t9 447,10576 + t10 448,10593 + t10 449,10604 + t9 450,10643 + t9 452,10699 + t10 453,10715 + t9 455,10761 + t7 457,10801 + t11 459,10843 + t2 464,10965 + goto g8361;465,10981 + goto dbcachemisstrap;469,11037 + arg1 474,11106 + arg2 475,11120 + goto performmemoryaction;476,11133 + arg1 493,11579 + goto begindoblock0readalu;501,11728 + goto begindoblock0readalu;507,11845 + arg1 517,12089 + arg2 518,12117 + goto blockreadalu;519,12149 + goto doistageerror;524,12212 + arg1 541,12648 + goto begindoblock3readalu;549,12797 + goto begindoblock3readalu;555,12914 + arg1 565,13158 + arg2 566,13186 + goto blockreadalu;567,13218 + goto doistageerror;572,13281 + arg1 589,13717 + goto begindoblock2readalu;597,13866 + goto begindoblock2readalu;603,13983 + arg1 613,14227 + arg2 614,14255 + goto blockreadalu;615,14287 + goto doistageerror;620,14350 + arg1 637,14786 + goto begindoblock1readalu;645,14935 + goto begindoblock1readalu;651,15052 + arg1 661,15296 + arg2 662,15324 + arg5 666,15412 + arg6 668,15502 + t1 670,15562 + t5 671,15583 + t4 672,15604 + t5 673,15631 + t9 674,15647 + t9 676,15695 + t1 679,15742 + t11 683,15795 + t3 684,15815 + t2 685,15833 + t9 687,15879 + t12 688,15897 + t10 690,15960 + t3 691,15999 + t2 692,16018 + t11 697,16090 + t12 698,16110 + t11 699,16136 + t3 700,16162 + t9 705,16217 + t9 707,16265 + t1 711,16342 + *(u32 *)arg2 713,16390 + t6 714,16411 + *(u64 *)&processor->aluoverflow aluoverflow715,16447 + t7 716,16489 + t1 717,16539 + t8 724,16700 + t8 726,16758 + t1 727,16774 + t1 736,16925 + t8 743,17066 + goto g8404;744,17082 + t1 748,17138 + t8 755,17283 + goto g8404;756,17300 + t1 760,17356 + t8 767,17493 + goto g8404;768,17504 + t1 772,17560 + t8 779,17705 + goto g8404;780,17722 + t1 784,17778 + t8 791,17915 + goto g8404;792,17926 + t1 796,17982 + t8 803,18123 + goto g8404;804,18139 + t1 808,18195 + t8 815,18336 + goto g8404;816,18352 + t1 820,18408 + t8 827,18549 + t8 828,18565 + goto g8404;829,18577 + t1 833,18633 + t8 840,18778 + t8 841,18794 + goto g8404;842,18806 + t1 846,18862 + t8 853,19001 + goto g8404;854,19013 + t1 858,19069 + t8 865,19212 + goto g8404;866,19231 + t1 870,19287 + t8 877,19426 + goto g8404;878,19438 + t1 882,19494 + t8 889,19637 + goto g8404;890,19654 + t1 894,19710 + t8 901,19853 + goto g8404;902,19869 + t1 906,19925 + t8 913,20066 + *(u32 *)arg1 917,20122 + goto NEXTINSTRUCTION;918,20143 + t1 922,20209 + t9 930,20383 + t10 932,20445 + t1 934,20508 + t1 936,20561 + t11 937,20576 + t1 944,20743 + t12 948,20796 + t12 950,20851 + t8 951,20868 + t11 952,20892 + t8 953,20924 + t8 955,20960 + *(u64 *)&processor->rotatelatch rotatelatch959,21060 + t12 963,21142 + t12 964,21161 + t12 966,21209 + t11 968,21249 + t11 969,21267 + t10 970,21284 + t12 978,21470 + t8 983,21559 + t1 985,21601 + t8 986,21619 + *(u32 *)arg1 987,21635 + goto NEXTINSTRUCTION;988,21656 + t1 992,21722 + t10 999,21879 + t10 1001,21921 + t9 1002,21938 + t9 1004,21990 + t11 1005,22005 + t1 1012,22161 + t8 1016,22214 + t8 1017,22230 + t10 1019,22263 + t11 1021,22298 + t10 1023,22358 + t11 1025,22411 + *(u64 *)&processor->aluoverflow aluoverflow1026,22429 + t10 1030,22530 + t11 1031,22562 + t7 1032,22583 + t11 1033,22601 + t11 1034,22618 + t7 1036,22668 + *(u64 *)&processor->aluandrotatecontrol aluandrotatecontrol1037,22685 + t10 1041,22775 + *(u64 *)&processor->aluborrow aluborrow1042,22812 + t3 1043,22851 + t5 1044,22867 + t10 1045,22883 + *(u64 *)&processor->alulessthan alulessthan1046,22920 + *(u32 *)arg1 1047,22961 + goto NEXTINSTRUCTION;1048,22982 + t1 1052,23048 + arg5 1060,23274 + arg2 1061,23286 + goto illegaloperand;1062,23299 + *(u32 *)arg1 1063,23322 + goto NEXTINSTRUCTION;1064,23343 + t9 1072,23494 + t9 1074,23580 + t9 1076,23643 + t1 1078,23683 + arg5 1079,23701 + arg2 1080,23714 + goto illegaloperand;1081,23727 + arg5 1085,23792 + arg2 1086,23805 + goto illegaloperand;1087,23818 + t11 1091,23883 + t1 1098,24041 + goto g8453;1099,24054 + t11 1103,24110 + t1 1110,24272 + t1 1111,24288 + t1 1112,24306 + goto g8453;1113,24322 + t11 1117,24378 + t1 1124,24544 + t1 1125,24558 + goto g8453;1126,24574 + t10 1130,24630 + goto g8446;1136,24750 + t11 1140,24806 + t1 1147,24989 + goto g8440;1148,25031 + t11 1152,25087 + t1 1159,25256 + goto g8440;1160,25269 + t10 1164,25325 + t9 1166,25395 + t3 1167,25418 + t2 1169,25467 + goto g8391;1170,25492 + t1 1177,25616 + goto g8390;1178,25632 + t12 1183,25735 + t11 1186,25821 + *(u64 *)&processor->vma vma1188,25882 + t11 1190,25949 + t12 1192,26004 + t11 1196,26067 + t2 1199,26136 + t2 1200,26154 + goto g8401;1201,26197 + t11 1210,26297 + t10 1211,26332 + t9 1214,26403 + t11 1215,26419 + t9 1217,26477 + t10 1218,26494 + t10 1219,26505 + t9 1220,26544 + t9 1222,26600 + t10 1223,26616 + t9 1225,26662 + t3 1227,26702 + t11 1229,26744 + t1 1234,26866 + goto g8390;1235,26882 + goto dbcachemisstrap;1239,26938 + arg1 1244,27007 + arg2 1245,27021 + goto performmemoryaction;1246,27033 + goto doistageerror;1251,27103 + arg1 1276,27750 + arg2 1278,27821 + goto blockreadtest;1279,27853 + arg1 1304,28502 + arg2 1306,28573 + goto blockreadtest;1307,28605 + arg1 1332,29254 + arg2 1334,29325 + goto blockreadtest;1335,29357 + arg1 1360,30006 + arg2 1362,30077 + arg3 1367,30187 + t1 1369,30229 + t5 1370,30247 + t4 1371,30267 + t5 1372,30293 + arg3 1373,30309 + t9 1378,30394 + t11 1379,30442 + t10 1380,30464 + t12 1382,30540 + t2 1383,30558 + t12 1384,30577 + t3 1385,30604 + t9 1387,30649 + t12 1388,30667 + t10 1390,30739 + t3 1391,30777 + t2 1392,30796 + t12 1397,30868 + t3 1398,30894 + t1 1404,30971 + t9 1408,31069 + t9 1410,31117 + t9 1413,31164 + t9 1415,31212 + t1 1422,31325 + t2 1427,31439 + t6 1431,31497 + *(u64 *)&processor->aluoverflow aluoverflow1432,31533 + t7 1433,31575 + t1 1434,31625 + t8 1441,31786 + t8 1443,31844 + t1 1444,31860 + t1 1453,32011 + t8 1460,32152 + goto g8492;1461,32168 + t1 1465,32224 + t8 1472,32369 + goto g8492;1473,32386 + t1 1477,32442 + t8 1484,32579 + goto g8492;1485,32590 + t1 1489,32646 + t8 1496,32791 + goto g8492;1497,32808 + t1 1501,32864 + t8 1508,33001 + goto g8492;1509,33012 + t1 1513,33068 + t8 1520,33209 + goto g8492;1521,33225 + t1 1525,33281 + t8 1532,33422 + goto g8492;1533,33438 + t1 1537,33494 + t8 1544,33635 + t8 1545,33651 + goto g8492;1546,33663 + t1 1550,33719 + t8 1557,33864 + t8 1558,33880 + goto g8492;1559,33892 + t1 1563,33948 + t8 1570,34087 + goto g8492;1571,34099 + t1 1575,34155 + t8 1582,34298 + goto g8492;1583,34317 + t1 1587,34373 + t8 1594,34512 + goto g8492;1595,34524 + t1 1599,34580 + t8 1606,34723 + goto g8492;1607,34740 + t1 1611,34796 + t8 1618,34939 + goto g8492;1619,34955 + t1 1623,35011 + t8 1630,35152 + t1 1637,35250 + t1 1639,35297 + t10 1640,35313 + t11 1641,35356 + t12 1642,35397 + t9 1643,35440 + t1 1660,35778 + goto g8553;1661,35791 + t1 1665,35847 + t9 1669,35899 + t9 1671,35952 + t1 1672,35967 + t1 1676,36037 + arg3 1681,36169 + *(u32 *)arg2 1686,36263 + goto NEXTINSTRUCTION;1687,36286 + t10 1691,36352 + t9 1692,36380 + t10 1693,36407 + t10 1694,36425 + iPC 1695,36443 + iPC 1696,36459 + goto interpretinstructionforjump;1697,36478 + t9 1702,36599 + arg3 1703,36644 + t9 1705,36735 + t9 1707,36797 + arg3 1709,36837 + arg5 1710,36857 + arg2 1711,36872 + goto illegaloperand;1712,36885 + arg5 1716,36950 + arg2 1717,36965 + goto illegaloperand;1718,36978 + t9 1722,37043 + goto g8554;1731,37252 + t9 1735,37308 + goto g8554;1744,37508 + t9 1748,37564 + goto g8554;1757,37773 + t9 1761,37829 + goto g8554;1772,38087 + t9 1776,38143 + goto g8554;1785,38356 + t9 1789,38412 + goto g8554;1798,38600 + t9 1802,38656 + t1 1809,38825 + goto g8554;1812,38872 + t9 1816,38928 + t9 1825,39112 + t9 1827,39145 + goto g8554;1830,39192 + t9 1834,39248 + arg5 1842,39474 + arg2 1843,39486 + goto illegaloperand;1844,39499 + t9 1848,39564 + arg5 1856,39790 + arg2 1857,39802 + goto illegaloperand;1858,39815 + t9 1862,39880 + arg5 1870,40098 + arg2 1871,40110 + goto illegaloperand;1872,40123 + t9 1876,40188 + arg5 1884,40398 + arg2 1885,40410 + goto illegaloperand;1886,40423 + t9 1890,40488 + t9 1898,40677 + t1 1899,40693 + goto g8553;1900,40708 + t9 1904,40764 + arg5 1912,40992 + arg2 1913,41004 + goto illegaloperand;1914,41017 + t9 1918,41082 + arg5 1926,41320 + arg2 1927,41332 + goto illegaloperand;1928,41345 + t9 1932,41410 + arg5 1940,41638 + arg2 1941,41650 + goto illegaloperand;1942,41663 + t9 1946,41728 + arg5 1954,41942 + arg2 1955,41954 + goto illegaloperand;1956,41967 + t9 1960,42032 + arg5 1968,42272 + arg2 1969,42284 + goto illegaloperand;1970,42297 + t9 1974,42362 + arg5 1982,42586 + arg2 1983,42598 + goto illegaloperand;1984,42611 + t9 1988,42676 + arg5 1996,42930 + arg2 1997,42942 + goto illegaloperand;1998,42955 + t9 2002,43020 + arg5 2010,43254 + arg2 2011,43266 + goto illegaloperand;2012,43279 + t9 2016,43344 + arg5 2024,43576 + arg2 2025,43588 + goto illegaloperand;2026,43601 + t9 2030,43666 + arg5 2038,43902 + arg2 2039,43914 + goto illegaloperand;2040,43927 + t9 2044,43992 + arg5 2052,44222 + arg2 2053,44234 + goto illegaloperand;2054,44247 + arg5 2060,44396 + arg2 2061,44408 + goto illegaloperand;2062,44421 + t1 2066,44486 + t9 2074,44660 + t10 2076,44722 + t1 2078,44785 + t1 2080,44838 + t11 2081,44853 + t1 2088,45020 + t12 2092,45073 + t12 2094,45128 + t8 2095,45145 + t11 2096,45169 + t8 2097,45201 + t8 2099,45237 + *(u64 *)&processor->rotatelatch rotatelatch2103,45337 + t12 2107,45419 + t12 2108,45438 + t12 2110,45486 + t11 2112,45526 + t11 2113,45544 + t10 2114,45561 + t12 2122,45747 + t8 2127,45836 + t1 2129,45878 + t8 2130,45896 + goto g8490;2131,45912 + t1 2135,45968 + t10 2142,46125 + t10 2144,46167 + t9 2145,46184 + t9 2147,46236 + t11 2148,46251 + t1 2155,46407 + t8 2159,46460 + t8 2160,46476 + t10 2162,46509 + t11 2164,46544 + t10 2166,46604 + t11 2168,46657 + *(u64 *)&processor->aluoverflow aluoverflow2169,46675 + t10 2173,46776 + t11 2174,46808 + t7 2175,46829 + t11 2176,46847 + t11 2177,46864 + t7 2179,46914 + *(u64 *)&processor->aluandrotatecontrol aluandrotatecontrol2180,46931 + t10 2184,47021 + *(u64 *)&processor->aluborrow aluborrow2185,47058 + t3 2186,47097 + t5 2187,47113 + t10 2188,47129 + *(u64 *)&processor->alulessthan alulessthan2189,47166 + goto g8490;2190,47207 + t1 2194,47263 + arg5 2202,47489 + arg2 2203,47501 + goto illegaloperand;2204,47514 + t11 2208,47579 + t1 2215,47737 + goto g8541;2216,47750 + t11 2220,47806 + t1 2227,47968 + t1 2228,47984 + t1 2229,48002 + goto g8541;2230,48018 + t11 2234,48074 + t1 2241,48240 + t1 2242,48254 + goto g8541;2243,48270 + t10 2247,48326 + goto g8534;2253,48446 + t11 2257,48502 + t1 2264,48685 + goto g8528;2265,48727 + t11 2269,48783 + t1 2276,48952 + goto g8528;2277,48965 + t10 2281,49021 + t9 2283,49091 + t3 2284,49114 + t2 2286,49163 + goto g8479;2287,49188 + t12 2295,49323 + t12 2296,49341 + t12 2297,49368 + t11 2300,49463 + *(u64 *)&processor->vma vma2302,49524 + t11 2304,49593 + t12 2306,49648 + t10 2310,49711 + arg3 2314,49809 + goto g8478;2315,49827 + t11 2319,49883 + t2 2322,49952 + t2 2323,49970 + goto g8489;2324,50013 + t11 2333,50113 + t10 2334,50148 + t9 2337,50219 + t11 2338,50237 + t9 2340,50295 + t10 2341,50312 + t10 2342,50323 + t9 2343,50362 + t9 2345,50418 + t10 2346,50434 + t9 2348,50480 + t3 2350,50520 + t11 2352,50562 + arg3 2357,50686 + goto g8478;2358,50704 + goto dbcachemisstrap;2362,50760 + arg1 2367,50829 + arg2 2368,50843 + goto performmemoryaction;2369,50856 + +stub/ifunbnum.c,3452 + *(u32 *)&processor->immediate_arg immediate_arg20,648 + arg1 21,692 + goto begindoaddbignumstep;22,738 + arg1 29,878 + goto headdoaddbignumstep;37,1027 + goto headdoaddbignumstep;43,1143 + arg1 52,1346 + arg1 54,1398 + arg2 60,1572 + t2 62,1614 + t3 63,1640 + arg1 65,1688 + t4 66,1708 + t4 68,1756 + arg3 72,1832 + t1 74,1881 + arg2 76,1947 + t4 77,1967 + t4 79,2015 + arg3 83,2103 + t4 84,2123 + t4 86,2171 + arg4 89,2230 + arg5 90,2252 + arg6 92,2308 + iPC 93,2329 + iCP 94,2379 + *(u32 *)iSP 100,2570 + goto cachevalid;103,2648 + arg5 107,2733 + arg2 108,2745 + goto illegaloperand;109,2758 + *(u32 *)&processor->immediate_arg immediate_arg126,3206 + arg1 127,3250 + goto begindosubbignumstep;128,3296 + arg1 135,3436 + goto headdosubbignumstep;143,3585 + goto headdosubbignumstep;149,3701 + arg1 158,3904 + arg1 160,3956 + arg2 166,4130 + t2 168,4172 + t3 169,4198 + arg1 171,4246 + t4 172,4266 + t4 174,4314 + arg3 178,4390 + t1 180,4439 + arg2 182,4505 + t4 183,4525 + t4 185,4573 + arg3 189,4661 + t4 190,4681 + t4 192,4729 + arg4 196,4806 + arg6 198,4870 + arg4 200,4949 + arg5 202,4994 + t6 204,5056 + iPC 205,5096 + iCP 206,5146 + arg6 212,5329 + *(u32 *)iSP 214,5381 + goto cachevalid;217,5459 + arg5 221,5544 + arg2 222,5556 + goto illegaloperand;223,5569 + *(u32 *)&processor->immediate_arg immediate_arg240,6047 + arg1 241,6091 + goto begindomultiplybignumstep;242,6137 + arg1 249,6292 + goto headdomultiplybignumstep;257,6441 + goto headdomultiplybignumstep;263,6572 + arg1 272,6800 + arg1 274,6852 + arg2 280,7036 + t1 281,7058 + t2 282,7084 + arg1 284,7132 + t4 285,7152 + t4 287,7200 + arg2 290,7260 + t4 291,7280 + t4 293,7328 + arg3 297,7406 + arg6 299,7457 + iPC 300,7492 + iCP 301,7542 + *(u32 *)iSP 303,7624 + iSP 310,7809 + goto cachevalid;311,7826 + arg5 315,7913 + arg2 316,7925 + goto illegaloperand;317,7938 + *(u32 *)&processor->immediate_arg immediate_arg334,8414 + arg1 335,8458 + goto begindodividebignumstep;336,8504 + arg1 343,8653 + goto headdodividebignumstep;351,8802 + goto headdodividebignumstep;357,8927 + arg1 366,9145 + arg1 368,9197 + arg2 374,9377 + t1 375,9399 + t2 376,9425 + arg1 377,9444 + t4 378,9464 + t4 380,9512 + arg2 386,9649 + arg3 388,9686 + t3 389,9715 + t4 390,9742 + t4 392,9790 + arg2 396,9877 + arg3 397,9898 + t4 398,9918 + t4 400,9966 + arg4 404,10053 + t1 406,10106 + t2 407,10126 + t2 409,10176 + *(u32 *)iSP 413,10302 + goto NEXTINSTRUCTION;414,10322 + arg5 418,10414 + arg2 419,10426 + goto illegaloperand;420,10439 + arg5 424,10530 + arg2 425,10542 + goto illegaloperand;426,10554 + arg2 444,11070 + arg2 449,11164 + *(u32 *)&processor->immediate_arg immediate_arg450,11190 + arg1 451,11234 + goto begindolshcbignumstep;452,11280 + arg1 459,11423 + goto headdolshcbignumstep;467,11572 + goto headdolshcbignumstep;473,11691 + arg1 482,11899 + arg1 484,11951 + arg2 490,12123 + t2 491,12145 + iSP 493,12189 + t3 494,12206 + arg1 496,12254 + t4 497,12274 + t4 499,12322 + arg2 502,12382 + arg3 504,12419 + t1 505,12441 + t4 506,12467 + t4 508,12515 + arg2 512,12602 + arg3 513,12623 + t4 514,12643 + t4 516,12691 + arg4 520,12778 + arg5 521,12800 + arg6 523,12857 + iPC 524,12883 + iCP 525,12933 + *(u32 *)iSP 527,13016 + goto cachevalid;530,13094 + arg5 534,13181 + arg2 535,13193 + goto illegaloperand;536,13206 + +stub/ifuncom1.c,32196 + arg1 20,620 + goto begindopush;28,769 + goto begindopush;34,859 + arg1 44,1058 + iPC 45,1086 + iSP 47,1163 + iCP 48,1180 + t1 50,1251 + t2 51,1278 + *(u32 *)iSP 53,1327 + t1 59,1431 + arg3 74,1797 + arg1 76,1872 + t2 78,1925 + arg4 80,1999 + t3 86,2155 + arg5 88,2223 + *(u64 *)&processor->restartsp restartsp90,2286 + t4 92,2351 + t2 94,2406 + arg6 96,2456 + arg2 98,2520 + t4 107,2748 + t4 109,2837 + zero 114,2966 + *(u64 *)&processor->instruction_count instruction_count118,3023 + t4 120,3110 + t5 125,3251 + t6 126,3294 + t6 131,3444 + *(u32 *)&t4->tracedata_recording_p tracedata_recording_p132,3472 + t5 140,3666 + t6 141,3713 + *(u64 *)&t5->tracerecord_epc tracerecord_epc143,3785 + *(u64 *)&t5->tracerecord_counter tracerecord_counter145,3854 + t6 146,3895 + t8 148,3958 + t7 149,4003 + t8 151,4092 + t8 153,4154 + t7 155,4194 + *(u64 *)&t5->tracerecord_tos tracerecord_tos157,4244 + *(u64 *)&t5->tracerecord_sp tracerecord_sp159,4305 + t6 160,4341 + t7 161,4385 + *(u32 *)&t5->tracerecord_operand tracerecord_operand163,4471 + *(u64 *)&t5->tracerecord_instruction tracerecord_instruction165,4561 + t7 166,4606 + t8 167,4644 + *(u32 *)&t5->tracerecord_catch_block_p tracerecord_catch_block_p169,4735 + *(u64 *)&t5->tracerecord_catch_block_0 tracerecord_catch_block_0171,4814 + t6 172,4861 + *(u64 *)&t5->tracerecord_instruction_data tracerecord_instruction_data174,4938 + *(u32 *)&t5->tracerecord_trap_p tracerecord_trap_p176,5017 + t6 180,5116 + *(u64 *)&processor->tvi tvi182,5189 + t7 183,5223 + *(u64 *)&t5->tracerecord_trap_data_0 tracerecord_trap_data_0185,5281 + t8 186,5326 + *(u64 *)&t5->tracerecord_trap_data_1 tracerecord_trap_data_1188,5375 + t9 189,5420 + *(u64 *)&t5->tracerecord_trap_data_2 tracerecord_trap_data_2191,5485 + *(u64 *)&t5->tracerecord_trap_data_3 tracerecord_trap_data_3192,5530 + t5 197,5651 + t6 199,5726 + *(u64 *)&t4->tracedata_current_entry tracedata_current_entry201,5822 + t7 203,5910 + t8 205,5999 + t7 207,6101 + *(u64 *)&processor->cp cp217,6349 + *(u64 *)&processor->epc epc218,6381 + *(u64 *)&processor->sp sp219,6414 + *(u64 *)&processor->fp fp220,6446 + *(u64 *)&processor->lp lp221,6478 + *(u64 *)&processor->asrf2 asrf2222,6510 + *(u64 *)&processor->asrf3 asrf3223,6546 + *(u64 *)&processor->asrf4 asrf4224,6582 + *(u64 *)&processor->asrf5 asrf5225,6618 + *(u64 *)&processor->asrf6 asrf6226,6654 + *(u64 *)&processor->asrf7 asrf7227,6690 + *(u64 *)&processor->asrf8 asrf8228,6726 + *(u64 *)&processor->asrf9 asrf9229,6760 + *(u64 *)&processor->long_pad1 long_pad1230,6794 + r9 231,6832 + r10 232,6868 + r11 233,6906 + r12 234,6944 + r13 235,6982 + r15 236,7020 + r27 237,7058 + r29 238,7096 + pv 239,7134 + r0 240,7145 + r9 241,7204 + r10 242,7240 + r11 243,7278 + r12 244,7316 + r13 245,7354 + r15 246,7392 + r27 247,7430 + r29 248,7468 + arg1 249,7506 + arg2 250,7544 + arg3 251,7582 + arg4 252,7620 + arg5 253,7658 + arg6 254,7696 + t4 255,7734 + t5 256,7770 + t3 257,7806 + iCP 258,7846 + iPC 259,7880 + iSP 260,7915 + iFP 261,7949 + iLP 262,7983 + t7 264,8046 + *(u64 *)&t4->tracedata_current_entry tracedata_current_entry269,8134 + *(u32 *)&t4->tracedata_wrap_p tracedata_wrap_p274,8285 + t5 278,8365 + t5 280,8461 + t5 282,8523 + *(u32 *)&t4->tracedata_recording_p tracedata_recording_p284,8579 + t4 291,8714 + t5 293,8792 + t9 294,8833 + t6 295,8853 + t6 297,8897 + t7 299,8973 + t8 301,9026 + t8 303,9063 + *(u64 *)t7 305,9109 + _lastcode 312,9352 + _lastinststart 313,9371 + t5 319,9561 + t4 321,9637 + t7 323,9712 + t5 325,9776 + t8 328,9822 + t4 330,9902 + t9 331,9924 + t7 332,9963 + t7 333,9978 + t8 334,9994 + t6 335,10031 + *(u32 *)&processor->metermax metermax338,10079 + *(u32 *)t4 340,10144 + *(u32 *)&processor->meterpos meterpos342,10194 + *(u32 *)&processor->metervalue metervalue343,10231 + t5 344,10272 + *(u32 *)&processor->metercount metercount348,10352 + goto *t3;t3356,10511 + iPC 364,10848 + iCP 366,10929 + goto cachevalid;367,10975 + goto ICACHEMISS;371,11054 + goto DoPushIM;380,11227 + iPC 385,11299 + iCP 386,11349 + t4 387,11395 + iSP 392,11545 + goto cachevalid;393,11562 + t1 419,12169 + arg2 421,12224 + arg1 424,12322 + t1 427,12397 + t1 429,12436 + iPC 433,12551 + iCP 434,12601 + iSP 435,12647 + goto cachevalid;436,12664 + iSP 443,12818 + iPC 445,12870 + goto interpretinstructionforbranch;450,12976 + t1 477,13674 + arg2 479,13729 + arg1 482,13827 + t1 485,13902 + t1 487,13941 + iPC 491,14057 + iCP 492,14107 + iSP 493,14153 + goto cachevalid;494,14170 + iSP 501,14326 + iPC 503,14378 + goto interpretinstructionforbranch;508,14484 + arg5 535,15241 + arg3 537,15297 + t3 538,15318 + t1 539,15337 + arg3 541,15396 + t2 542,15417 + t3 544,15486 + t3 546,15546 + arg6 547,15563 + arg4 552,15759 + t3 559,15919 + t1 560,15939 + t5 561,15960 + t1 563,16014 + t2 564,16032 + t7 565,16058 + t3 569,16151 + t4 570,16167 + t5 571,16214 + t6 575,16335 + t6 580,16440 + t2 582,16483 + iPC 587,16579 + t1 588,16596 + t7 589,16611 + iPC 590,16656 + t1 597,16847 + *(u32 *)&processor->continuation continuation598,16865 + iSP 600,16941 + *(u64 *)&processor->continuationcp continuationcp601,16958 + t1 603,17044 + t1 605,17072 + t2 606,17093 + t2 607,17114 + t3 609,17168 + t6 611,17243 + t4 613,17293 + iFP 615,17370 + *(u32 *)&processor->control control617,17425 + t1 619,17495 + t3 620,17512 + t3 621,17527 + *(u64 *)&processor->stop_interpreter stop_interpreter622,17543 + iLP 624,17623 + arg6 629,17726 + iSP 636,17945 + iCP 650,18288 + goto INTERPRETINSTRUCTION;651,18300 + t8 656,18430 + t8 657,18450 + iSP 658,18467 + t8 659,18484 + *(u64 *)iSP 661,18519 + goto returnsingledone;662,18539 + iSP 669,18704 + goto returnsingledone;670,18721 + goto handleframecleanup;674,18816 + goto stackcacheunderflowcheck;678,18917 + arg2 694,19288 + t11 695,19308 + t12 697,19397 + arg3 699,19457 + t7 703,19509 + arg6 704,19530 + arg5 705,19549 + t5 707,19596 + t8 708,19615 + t6 710,19677 + arg6 711,19714 + arg5 712,19737 + t7 717,19811 + t8 718,19830 + t7 719,19856 + t5 724,19920 + t5 726,19980 + arg5 729,20036 + t7 730,20058 + iSP 732,20159 + t3 733,20177 + t6 734,20213 + t8 735,20238 + t5 736,20279 + t7 738,20321 + t8 744,20483 + t5 745,20499 + *(u32 *)iSP 747,20548 + t8 751,20656 + *(u32 *)&processor->control control753,20709 + iPC 755,20771 + iCP 756,20821 + *(u32 *)&processor->continuation continuation757,20867 + *(u64 *)&processor->continuationcp continuationcp759,20959 + goto cachevalid;762,21049 + t1 766,21134 + t2 767,21170 + t3 769,21210 + iSP 774,21341 + t1 776,21388 + *(u32 *)&processor->control control778,21440 + goto cachevalid;779,21476 + arg2 786,21604 + goto g6247;787,21624 + r0 794,21722 + goto memoryreaddatadecode;795,21748 + goto g6258;797,21789 + arg1 825,22488 + arg2 827,22573 + arg3 831,22663 + t6 833,22725 + t3 834,22763 + t4 836,22816 + t3 838,22897 + t4 840,22956 + t6 841,22978 + arg3 846,23128 + t1 848,23180 + iLP 851,23274 + iLP 853,23319 + t3 856,23391 + t2 857,23407 + t3 859,23463 + t2 861,23518 + t4 863,23559 + t4 865,23603 + t5 867,23654 + t5 869,23707 + t7 872,23803 + t6 874,23851 + t5 876,23933 + t7 878,23983 + t4 880,24026 + t7 882,24080 + t7 884,24128 + t5 887,24216 + t1 889,24296 + t4 891,24344 + t1 893,24436 + t3 894,24452 + t6 897,24564 + t7 899,24622 + t6 900,24638 + t4 901,24663 + iPC 903,24720 + iPC 904,24736 + iPC 905,24754 + *(u32 *)&processor->continuation continuation906,24772 + t7 910,24905 + t5 911,24926 + t7 912,24971 + t7 914,25026 + *(u64 *)&processor->continuationcp continuationcp915,25042 + t1 917,25134 + *(u32 *)&processor->control control919,25183 + iFP 921,25257 + arg2 922,25269 + t1 925,25379 + t3 927,25428 + t4 929,25511 + t3 934,25667 + t4 936,25726 + t1 937,25771 + t4 939,25860 + t4 941,25922 + t1 943,25962 + t4 945,26005 + goto interpretinstructionforbranch;952,26210 + arg2 956,26290 + goto stackcacheoverflowhandler;957,26302 + arg5 983,27049 + arg4 985,27129 + arg1 987,27203 + arg4 988,27237 + t2 991,27383 + t1 993,27428 + t3 996,27481 + t4 998,27538 + t2 1008,27697 + arg1 1013,27813 + iPC 1019,27996 + t3 1021,28079 + iCP 1022,28095 + iPC 1027,28260 + iPC 1029,28309 + goto interpretinstructionforjump;1030,28328 + arg1 1034,28420 + goto pullapplyargs;1038,28518 + arg5 1042,28604 + arg2 1043,28616 + goto illegaloperand;1044,28629 + arg5 1048,28714 + arg2 1049,28726 + goto illegaloperand;1050,28739 + t4 1054,28804 + t4 1055,28820 + t3 1060,28956 + t3 1062,29004 + iSP 1064,29059 + arg5 1066,29113 + *(u32 *)&processor->control control1068,29166 + goto g6277;1069,29204 + t11 1078,29432 + t11 1079,29451 + arg1 1084,29544 + goto pullapplyargs;1085,29566 + arg5 1089,29630 + arg2 1090,29642 + goto illegaloperand;1091,29655 + arg5 1099,29793 + arg6 1101,29883 + t2 1102,29923 + t1 1103,29943 + t2 1104,29969 + t4 1106,30022 + t5 1107,30038 + t5 1115,30206 + t6 1117,30242 + t4 1118,30280 + t4 1123,30407 + t7 1124,30429 + t5 1125,30442 + t6 1127,30495 + t5 1129,30585 + t5 1131,30639 + t6 1133,30698 + t10 1134,30722 + iSP 1139,30858 + goto g6296;1140,30875 + t9 1144,30931 + t8 1145,30950 + t9 1146,30975 + t7 1147,30991 + t4 1148,31006 + t5 1150,31047 + t5 1155,31143 + iSP 1159,31242 + t5 1160,31259 + goto g6292;1163,31319 + t6 1167,31375 + t5 1175,31524 + iSP 1179,31623 + t5 1183,31682 + t6 1185,31748 + t5 1186,31765 + t6 1187,31784 + t5 1189,31828 + t6 1190,31844 + t5 1192,31888 + *(u32 *)&processor->control control1193,31905 + iLP 1194,31941 + goto INTERPRETINSTRUCTION;1195,31965 + t6 1199,32036 + t5 1207,32187 + iSP 1211,32286 + t11 1212,32303 + t10 1213,32323 + t11 1214,32349 + t5 1216,32404 + t6 1217,32421 + t5 1225,32589 + t6 1227,32626 + t4 1228,32664 + t4 1233,32791 + goto g6296;1234,32813 + t6 1238,32869 + goto g6294;1245,33008 + t5 1254,33160 + iSP 1258,33261 + goto g6295;1259,33278 + t7 1267,33409 + t4 1268,33424 + goto g6292;1269,33439 + t5 1275,33503 + t5 1283,33684 + t5 1285,33770 + t5 1287,33831 + t9 1289,33871 + t5 1290,33889 + iSP 1294,33990 + t5 1298,34049 + t6 1300,34115 + t5 1301,34132 + t6 1302,34151 + t5 1304,34195 + *(u32 *)&processor->control control1305,34211 + iLP 1306,34247 + arg1 1307,34271 + goto pullapplyargsslowly;1310,34344 + t5 1314,34414 + t6 1322,34586 + t7 1323,34622 + iSP 1325,34671 + t6 1327,34726 + *(u32 *)&processor->control control1328,34743 + goto INTERPRETINSTRUCTION;1329,34779 + arg1 1335,34932 + goto pullapplyargstrap;1336,34947 + arg1 1340,35015 + goto pullapplyargsslowly;1341,35030 + arg2 1348,35142 + goto stackcacheoverflowhandler;1349,35157 + arg2 1361,35372 + t11 1362,35392 + t12 1364,35481 + t7 1368,35557 + arg6 1369,35578 + arg5 1370,35597 + t5 1372,35644 + t8 1373,35663 + t6 1375,35725 + arg6 1376,35762 + arg5 1377,35785 + t7 1382,35859 + t8 1383,35878 + t7 1384,35904 + iPC 1389,35968 + iCP 1390,36018 + t3 1392,36085 + iSP 1397,36212 + goto cachevalid;1398,36229 + arg2 1405,36357 + goto g6318;1406,36377 + r0 1413,36475 + goto memoryreaddatadecode;1414,36501 + goto g6329;1416,36542 + iPC 1428,36793 + iCP 1429,36843 + iSP 1431,36917 + goto cachevalid;1432,36934 + arg1 1449,37304 + goto begindozerop;1457,37453 + goto begindozerop;1463,37546 + arg1 1473,37750 + t11 1474,37778 + t6 1475,37820 + t1 1476,37869 + t12 1477,37896 + t2 1478,37936 + t4 1481,38023 + t5 1482,38039 + iPC 1489,38184 + iCP 1490,38196 + iSP 1495,38331 + goto cachevalid;1496,38348 + t5 1500,38409 + iPC 1507,38564 + iSP 1509,38603 + iCP 1510,38620 + *(u64 *)iSP 1514,38752 + goto cachevalid;1515,38773 + arg6 1521,38901 + arg3 1523,38936 + arg1 1525,38981 + arg4 1527,39020 + goto unarynumericexception;1528,39032 + goto DoZeropIM;1533,39119 + t2 1538,39194 + iSP 1539,39233 + t1 1540,39250 + iPC 1541,39291 + iCP 1542,39341 + *(u64 *)iSP 1546,39470 + goto cachevalid;1547,39490 + arg1 1564,39913 + goto begindosetsptoaddress;1572,40062 + goto begindosetsptoaddress;1578,40182 + arg1 1588,40431 + iPC 1589,40459 + iCP 1590,40509 + iSP 1592,40590 + goto cachevalid;1593,40604 + goto doistageerror;1598,40666 + arg1 1615,41038 + arg6 1619,41117 + arg1 1621,41160 + iSP 1623,41192 + goto begindoeq;1625,41221 + goto begindoeq;1631,41305 + arg1 1641,41494 + t11 1642,41522 + arg3 1643,41564 + t12 1644,41585 + arg1 1646,41642 + iPC 1647,41665 + arg3 1649,41745 + iCP 1650,41764 + t3 1652,41839 + t3 1654,41890 + iSP 1656,41952 + *(u64 *)iSP 1660,42033 + goto cachevalid;1661,42054 + arg1 1678,42417 + arg1 1682,42502 + arg6 1684,42536 + iSP 1686,42577 + goto begindoaref1;1687,42591 + goto headdoaref1;1689,42627 + goto headdoaref1;1695,42719 + arg1 1704,42882 + arg1 1706,42934 + arg3 1711,43075 + arg4 1713,43141 + arg2 1715,43219 + t8 1716,43248 + t8 1717,43280 + arg1 1719,43316 + t7 1720,43337 + t7 1722,43428 + t1 1723,43444 + t1 1725,43494 + t8 1734,43668 + t1 1735,43712 + t1 1737,43771 + t8 1741,43867 + goto aref1regset;1746,43992 + arg6 1748,44019 + t9 1750,44099 + t3 1752,44176 + t5 1753,44221 + t4 1754,44240 + t5 1755,44283 + t2 1756,44300 + t6 1757,44338 + arg5 1763,44462 + arg4 1764,44516 + t8 1765,44569 + arg4 1766,44621 + arg5 1767,44667 + arg6 1768,44714 + t1 1774,44848 + t2 1782,44973 + t5 1783,45021 + t3 1784,45040 + t9 1785,45078 + arg3 1786,45095 + t2 1788,45142 + t6 1789,45158 + t3 1791,45220 + t9 1792,45256 + arg3 1793,45275 + t5 1798,45349 + t6 1799,45368 + t5 1800,45394 + t9 1801,45420 + r31 1811,45549 + t1 1812,45568 + arg3 1816,45638 + t5 1821,45728 + r31 1827,45843 + *(u32 *)iSP 1830,45893 + goto NEXTINSTRUCTION;1831,45913 + r31 1836,46002 + t5 1837,46021 + t6 1838,46038 + *(u32 *)iSP 1841,46100 + goto NEXTINSTRUCTION;1842,46120 + r31 1847,46209 + t5 1849,46247 + t5 1851,46286 + t6 1853,46327 + t6 1855,46371 + *(u32 *)iSP 1858,46418 + goto NEXTINSTRUCTION;1859,46438 + r31 1864,46527 + t5 1866,46565 + r31 1867,46583 + t6 1869,46627 + t6 1871,46671 + *(u32 *)iSP 1874,46717 + goto NEXTINSTRUCTION;1875,46737 + t5 1880,46827 + t5 1882,46876 + t6 1883,46892 + *(u32 *)iSP 1886,46955 + goto NEXTINSTRUCTION;1887,46975 + r31 1891,47057 + t5 1892,47076 + t6 1893,47104 + t5 1896,47166 + t6 1899,47228 + r31 1908,47389 + t5 1910,47427 + t5 1912,47467 + t6 1914,47508 + t6 1916,47552 + *(u32 *)iSP 1919,47598 + goto NEXTINSTRUCTION;1920,47618 + arg2 1924,47684 + t1 1926,47747 + t1 1928,47815 + goto g6346;1929,47831 + t1 1933,47887 + t1 1935,47937 + goto g6348;1938,47984 + arg3 1942,48040 + arg3 1945,48097 + t2 1948,48152 + t3 1949,48193 + goto g6350;1950,48232 + *(u64 *)iSP 1956,48311 + goto NEXTINSTRUCTION;1957,48331 + arg5 1961,48397 + arg2 1962,48410 + goto illegaloperand;1963,48423 + goto DoAref1IM;1965,48461 + t8 1970,48536 + arg4 1972,48599 + arg3 1973,48621 + arg4 1974,48649 + t7 1975,48669 + t8 1976,48703 + t7 1978,48778 + goto aref1merge;1979,48794 + t3 1983,48855 + t2 1985,48924 + t9 1986,48946 + arg3 1988,48995 + goto g6354;1989,49022 + t1 1996,49145 + goto g6353;1997,49161 + t6 2002,49264 + t5 2005,49349 + *(u64 *)&processor->vma vma2007,49411 + t5 2009,49478 + t6 2011,49530 + t5 2015,49591 + arg3 2018,49657 + arg3 2019,49679 + goto g6364;2020,49726 + t5 2029,49826 + t3 2030,49859 + t2 2033,49928 + t5 2034,49944 + t2 2036,50001 + t3 2037,50017 + t3 2038,50027 + t2 2039,50064 + t2 2041,50119 + t3 2042,50135 + t2 2044,50179 + t9 2046,50218 + t5 2048,50259 + t1 2053,50379 + goto g6353;2054,50395 + goto dbcachemisstrap;2058,50451 + arg1 2063,50520 + arg2 2064,50533 + goto performmemoryaction;2065,50545 + t6 2092,51198 + t4 2093,51216 + arg4 2095,51277 + t1 2096,51305 + t5 2097,51315 + t7 2099,51390 + arg1 2101,51452 + arg4 2104,51515 + t1 2106,51578 + t7 2108,51620 + t2 2110,51659 + iPC 2111,51687 + iCP 2112,51737 + iSP 2113,51783 + t3 2115,51833 + *(u64 *)iSP 2121,51914 + goto cachevalid;2122,51934 + arg1 2139,52349 + arg6 2143,52437 + arg1 2145,52480 + iSP 2147,52512 + goto begindopointerplus;2149,52541 + goto begindopointerplus;2155,52652 + arg1 2165,52886 + iPC 2166,52914 + iCP 2167,52964 + t2 2169,53038 + t3 2171,53106 + *(u32 *)iSP 2173,53171 + goto cachevalid;2174,53191 + goto DoPointerPlusIM;2176,53225 + t2 2181,53318 + iPC 2182,53337 + iCP 2183,53387 + t2 2184,53433 + t3 2189,53544 + *(u32 *)iSP 2191,53609 + goto cachevalid;2192,53629 + arg1 2218,54171 + arg2 2220,54235 + arg1 2222,54298 + arg3 2224,54362 + arg4 2226,54423 + t8 2228,54460 + t9 2229,54478 + t3 2231,54548 + t7 2235,54635 + iPC 2236,54653 + t6 2238,54728 + iCP 2239,54759 + t7 2241,54820 + t3 2243,54897 + t3 2247,55001 + *(u32 *)iSP 2248,55018 + goto cachevalid;2249,55038 + arg1 2266,55499 + arg6 2270,55597 + arg1 2272,55640 + iSP 2274,55672 + goto begindosetsptoaddresssavetos;2276,55701 + goto begindosetsptoaddresssavetos;2282,55842 + arg1 2292,56126 + iPC 2293,56154 + iCP 2294,56204 + iSP 2296,56290 + *(u64 *)arg1 2298,56329 + goto cachevalid;2299,56352 + goto doistageerror;2304,56421 + arg1 2321,56813 + arg6 2325,56893 + arg1 2327,56936 + iSP 2329,56968 + goto begindopop;2331,56997 + goto begindopop;2337,57084 + arg1 2347,57278 + iPC 2348,57306 + iCP 2349,57356 + iSP 2351,57421 + *(u64 *)arg1 2353,57473 + goto cachevalid;2354,57496 + goto doistageerror;2359,57547 + arg1 2376,57915 + arg6 2380,57997 + arg1 2382,58040 + iSP 2384,58072 + goto begindomovem;2386,58101 + goto begindomovem;2392,58194 + arg1 2402,58398 + iPC 2403,58426 + iCP 2404,58476 + *(u64 *)arg1 2406,58564 + goto cachevalid;2407,58587 + goto doistageerror;2412,58640 + arg1 2429,59048 + goto begindopushaddress;2437,59197 + goto begindopushaddress;2443,59308 + arg1 2453,59542 + t2 2455,59613 + t1 2456,59658 + t2 2458,59747 + t2 2460,59810 + t1 2462,59850 + iPC 2463,59866 + iCP 2464,59916 + t3 2465,59962 + iSP 2469,60067 + goto cachevalid;2470,60084 + goto doistageerror;2475,60143 + arg1 2500,60738 + t1 2503,60874 + t2 2505,60919 + t3 2507,60965 + arg3 2509,61009 + arg1 2510,61029 + arg2 2512,61085 + t11 2513,61105 + t12 2515,61194 + t7 2519,61270 + t8 2521,61328 + arg5 2522,61347 + t8 2523,61367 + arg6 2524,61392 + t5 2526,61438 + t8 2527,61457 + t6 2529,61527 + arg6 2530,61564 + arg5 2531,61587 + t8 2536,61661 + t5 2544,61794 + t5 2546,61844 + iPC 2552,61945 + arg5 2560,62157 + iCP 2564,62227 + *(u32 *)iSP 2568,62356 + goto cachevalid;2571,62436 + arg5 2575,62509 + arg2 2576,62521 + goto illegaloperand;2577,62533 + r0 2584,62640 + goto memoryreadgeneraldecode;2585,62666 + goto g6402;2587,62710 + arg1 2612,63247 + arg2 2615,63338 + iPC 2618,63431 + goto interpretinstructionforbranch;2623,63537 + arg1 2640,63987 + goto begindogenericdispatch;2648,64136 + goto begindogenericdispatch;2654,64259 + arg1 2664,64513 + arg2 2665,64541 + arg1 2667,64612 + t1 2668,64641 + arg5 2670,64700 + arg3 2672,64755 + arg4 2673,64784 + arg5 2675,64870 + t1 2678,64939 + arg4 2679,64955 + r0 2680,64975 + goto lookuphandler;2681,65001 + t3 2683,65035 + t3 2685,65093 + t3 2689,65163 + t3 2690,65179 + iPC 2700,65399 + iPC 2701,65415 + iPC 2702,65433 + goto interpretinstructionforjump;2703,65451 + t2 2708,65572 + t3 2709,65617 + t2 2711,65706 + t2 2713,65768 + t3 2715,65808 + arg5 2716,65824 + arg2 2717,65837 + goto illegaloperand;2718,65850 + goto doistageerror;2723,65917 + sp 2732,66128 + t11 2733,66144 + t12 2735,66233 + t5 2736,66272 + t5 2738,66334 + arg2 2742,66430 + t7 2746,66482 + arg6 2747,66503 + arg5 2748,66522 + t5 2750,66569 + t8 2751,66588 + t6 2753,66648 + arg6 2754,66685 + arg5 2755,66708 + t7 2760,66782 + t8 2761,66800 + t7 2762,66826 + arg6 2763,66852 + arg2 2771,66952 + t7 2775,67004 + arg6 2776,67025 + arg5 2777,67044 + t5 2779,67091 + t8 2780,67110 + t6 2782,67172 + arg6 2783,67209 + arg5 2784,67232 + t7 2789,67306 + t8 2790,67325 + t7 2791,67351 + arg6 2792,67377 + t2 2797,67435 + t5 2798,67448 + t5 2800,67498 + arg2 2803,67545 + t7 2807,67601 + arg6 2808,67622 + arg5 2809,67641 + t5 2811,67688 + t8 2812,67707 + t6 2814,67769 + arg6 2815,67806 + arg5 2816,67829 + t7 2821,67903 + t8 2822,67922 + t7 2823,67948 + arg6 2824,67974 + t3 2829,68032 + t5 2830,68045 + t5 2832,68097 + arg2 2835,68144 + t5 2836,68162 + arg4 2838,68213 + arg1 2840,68250 + arg2 2844,68312 + arg4 2845,68332 + t7 2850,68405 + arg6 2851,68426 + arg5 2852,68445 + t5 2854,68492 + t8 2855,68511 + t6 2857,68573 + arg6 2858,68610 + arg5 2859,68633 + t7 2864,68707 + t8 2865,68726 + t7 2866,68752 + arg5 2872,68833 + t5 2873,68853 + t5 2876,68919 + t5 2879,68981 + arg2 2886,69102 + t7 2890,69158 + arg6 2891,69179 + arg5 2892,69198 + t5 2894,69245 + t8 2895,69264 + t6 2897,69326 + arg6 2898,69363 + arg5 2899,69386 + t7 2904,69460 + t8 2905,69479 + t7 2906,69505 + arg6 2907,69531 + t4 2912,69589 + arg3 2913,69602 + arg2 2915,69640 + t7 2919,69696 + arg6 2920,69717 + arg5 2921,69736 + t5 2923,69783 + t8 2924,69802 + t6 2926,69864 + arg6 2927,69901 + arg5 2928,69924 + t7 2933,69998 + t8 2934,70017 + t7 2935,70043 + arg6 2936,70069 + t6 2941,70127 + t7 2942,70140 + t9 2943,70153 + sp 2944,70166 + goto *r0;r02945,70181 + arg2 2952,70312 + goto g6469;2953,70332 + *(u64 *)sp 2960,70430 + r0 2961,70449 + goto memoryreaddatadecode;2962,70475 + r0 2964,70516 + goto g6480;2965,70535 + arg2 2972,70658 + goto g6457;2973,70678 + *(u64 *)sp 2980,70776 + r0 2981,70795 + goto memoryreaddatadecode;2982,70821 + r0 2984,70862 + goto g6468;2985,70881 + arg2 2992,71004 + goto g6445;2993,71024 + *(u64 *)sp 3000,71122 + r0 3001,71141 + goto memoryreaddatadecode;3002,71167 + r0 3004,71208 + goto g6456;3005,71227 + arg2 3012,71350 + goto g6431;3013,71370 + *(u64 *)sp 3020,71468 + r0 3021,71487 + goto memoryreaddatadecode;3022,71513 + r0 3024,71554 + goto g6442;3025,71573 + arg2 3032,71696 + goto g6419;3033,71716 + *(u64 *)sp 3040,71814 + r0 3041,71833 + goto memoryreaddatadecode;3042,71859 + r0 3044,71900 + goto g6430;3045,71919 + arg2 3052,72042 + goto g6409;3053,72062 + *(u64 *)sp 3060,72160 + r0 3061,72179 + goto memoryreadheaderdecode;3062,72205 + r0 3064,72248 + goto g6418;3065,72267 + arg2 3070,72391 + t5 3072,72452 + arg2 3073,72470 + arg2 3074,72492 + t7 3078,72549 + arg6 3079,72570 + arg5 3080,72589 + t5 3082,72636 + t8 3083,72655 + t6 3085,72717 + arg6 3086,72754 + arg5 3087,72777 + t7 3092,72851 + t8 3093,72870 + t7 3094,72896 + arg6 3095,72922 + goto g6407;3098,72972 + arg5 3102,73028 + arg2 3103,73043 + goto illegaloperand;3104,73056 + arg5 3108,73121 + arg2 3109,73136 + goto illegaloperand;3110,73149 + arg2 3117,73281 + goto g6481;3118,73301 + *(u64 *)sp 3125,73399 + r0 3126,73418 + goto memoryreaddatadecode;3127,73444 + r0 3129,73485 + goto g6407;3130,73504 + arg1 3146,73815 + goto begindosettag;3154,73964 + goto begindosettag;3160,74060 + arg1 3170,74269 + t1 3172,74325 + arg2 3173,74352 + t3 3174,74375 + t3 3176,74423 + goto DoSetTagIM;3180,74489 + iPC 3185,74567 + iCP 3186,74617 + goto cachevalid;3189,74714 + arg5 3193,74783 + arg2 3194,74795 + goto illegaloperand;3195,74808 + arg1 3212,75171 + goto begindocar;3220,75320 + goto begindocar;3226,75407 + arg1 3236,75601 + t11 3237,75629 + t12 3239,75718 + arg5 3241,75797 + arg6 3242,75826 + r0 3243,75849 + goto carinternal;3244,75875 + t5 3247,75928 + iSP 3251,76031 + goto NEXTINSTRUCTION;3252,76048 + goto doistageerror;3257,76104 + sp 3266,76285 + arg2 3267,76301 + t5 3269,76376 + t6 3270,76394 + t7 3282,76580 + arg6 3283,76601 + arg5 3284,76620 + t5 3286,76667 + t8 3287,76686 + t6 3289,76748 + arg6 3290,76785 + arg5 3291,76808 + t7 3296,76882 + t8 3297,76901 + t7 3298,76927 + arg6 3299,76953 + sp 3310,77095 + goto *r0;r03311,77110 + t6 3315,77174 + t6 3324,77322 + arg6 3335,77542 + arg3 3337,77579 + arg1 3339,77624 + arg4 3341,77663 + goto listexception;3342,77675 + arg2 3349,77806 + goto g6496;3350,77826 + *(u64 *)sp 3357,77924 + r0 3358,77943 + goto memoryreaddatadecode;3359,77969 + r0 3361,78010 + goto g6507;3362,78029 + arg1 3378,78320 + goto begindocdr;3386,78469 + goto begindocdr;3392,78556 + arg1 3402,78750 + t11 3403,78778 + t12 3405,78867 + arg5 3407,78946 + arg6 3408,78975 + r0 3409,78998 + goto cdrinternal;3410,79024 + t5 3413,79077 + iSP 3417,79180 + goto NEXTINSTRUCTION;3418,79197 + goto doistageerror;3423,79253 + sp 3432,79434 + arg2 3433,79450 + t5 3435,79507 + t6 3436,79525 + t7 3446,79703 + arg6 3447,79724 + arg5 3448,79743 + t5 3450,79790 + t8 3451,79809 + t6 3453,79866 + arg6 3454,79903 + arg5 3455,79926 + t7 3460,80000 + t8 3461,80019 + t7 3462,80045 + t5 3468,80135 + arg6 3473,80252 + arg5 3474,80271 + sp 3484,80417 + goto *r0;r03485,80432 + t6 3489,80496 + t6 3498,80644 + arg6 3509,80864 + arg3 3511,80901 + arg1 3513,80946 + arg4 3515,80985 + goto listexception;3516,80997 + t6 3520,81061 + arg2 3527,81191 + t7 3534,81289 + arg6 3535,81310 + arg5 3536,81329 + t5 3538,81376 + t8 3539,81395 + t6 3541,81457 + arg6 3542,81494 + arg5 3543,81517 + t7 3548,81591 + t8 3549,81610 + t7 3550,81636 + arg6 3551,81662 + goto g6516;3554,81712 + t6 3558,81768 + arg6 3565,81896 + arg5 3566,81937 + arg6 3567,81984 + goto g6516;3568,82004 + arg5 3573,82093 + arg2 3574,82108 + goto illegaloperand;3575,82121 + arg2 3582,82253 + goto g6532;3583,82273 + *(u64 *)sp 3590,82371 + r0 3591,82390 + goto memoryreaddatadecode;3592,82416 + r0 3594,82457 + goto g6516;3595,82476 + arg2 3602,82599 + goto g6519;3603,82619 + *(u64 *)sp 3610,82717 + r0 3611,82736 + goto memoryreadcdrdecode;3612,82762 + r0 3614,82802 + goto g6528;3615,82821 + arg1 3639,83455 + t2 3641,83526 + t3 3642,83578 + t1 3643,83607 + t3 3648,83750 + t2 3650,83808 + t3 3651,83845 + t3 3654,83910 + goto *t3;t33656,83957 + t1 3661,84064 + t3 3662,84101 + t3 3665,84166 + goto *t3;t33667,84213 + arg1 3692,84960 + arg2 3694,85031 + arg3 3696,85093 + iSP 3698,85132 + t2 3699,85149 + t3 3700,85202 + t1 3701,85231 + t3 3706,85375 + t2 3708,85433 + t3 3709,85470 + t3 3712,85536 + goto *t3;t33714,85583 + t1 3719,85690 + t3 3720,85727 + t3 3723,85793 + goto *t3;t33725,85840 + t2 3735,86104 + iPC 3736,86122 + t3 3738,86214 + iCP 3739,86233 + t1 3740,86279 + t1 3742,86342 + t3 3744,86400 + *(u64 *)t1 3745,86418 + goto cachevalid;3746,86437 + arg1 3770,86962 + arg4 3772,87033 + goto blockread;3773,87065 + arg1 3798,87654 + arg4 3800,87725 + goto blockread;3801,87757 + arg1 3826,88346 + arg4 3828,88417 + t11 3832,88499 + t12 3834,88588 + arg2 3836,88647 + arg3 3838,88689 + t2 3840,88732 + t3 3842,88773 + t4 3844,88813 + arg2 3845,88831 + t7 3850,88914 + t8 3852,88972 + arg5 3853,88991 + t8 3854,89011 + arg6 3855,89036 + t5 3857,89082 + t8 3858,89101 + t6 3860,89171 + arg6 3861,89208 + arg5 3862,89231 + t8 3867,89305 + t4 3878,89487 + *(u32 *)arg4 3886,89646 + t2 3888,89694 + iPC 3889,89712 + iCP 3893,89822 + iSP 3897,89955 + goto cachevalid;3898,89972 + arg5 3902,90033 + arg2 3903,90048 + goto illegaloperand;3904,90061 + r0 3911,90168 + goto memoryreadgeneraldecode;3912,90194 + goto g6571;3914,90238 + t5 3918,90294 + t5 3920,90344 + goto g6558;3923,90391 + arg2 3941,90868 + arg2 3946,90962 + *(u32 *)&processor->immediate_arg immediate_arg3947,90988 + arg1 3948,91032 + goto begindoblock2write;3949,91078 + arg1 3956,91212 + goto headdoblock2write;3964,91361 + goto headdoblock2write;3970,91471 + arg1 3979,91664 + arg1 3981,91716 + arg3 3986,91865 + arg2 3987,91900 + goto blockwrite;3988,91932 + arg2 4006,92416 + arg2 4011,92510 + *(u32 *)&processor->immediate_arg immediate_arg4012,92536 + arg1 4013,92580 + goto begindoblock1write;4014,92626 + arg1 4021,92760 + goto headdoblock1write;4029,92909 + goto headdoblock1write;4035,93019 + arg1 4044,93212 + arg1 4046,93264 + arg3 4051,93413 + arg2 4052,93448 + t11 4056,93532 + t12 4058,93621 + arg3 4060,93681 + t2 4062,93717 + t3 4064,93753 + t8 4065,93771 + t6 4066,93792 + t5 4067,93809 + t4 4069,93854 + t7 4071,93891 + t4 4072,93928 + t5 4073,93962 + t5 4077,94038 + *(u32 *)t6 4079,94071 + iPC 4085,94152 + iCP 4086,94202 + arg3 4088,94278 + *(u32 *)arg2 4090,94330 + goto cachevalid;4091,94353 + t8 4095,94414 + t4 4097,94486 + t8 4099,94529 + *(u32 *)t8 4101,94574 + goto g6590;4104,94648 + t1 4131,95372 + arg2 4133,95427 + arg1 4136,95525 + t1 4139,95600 + t1 4141,95639 + iPC 4148,95812 + goto interpretinstructionforbranch;4153,95918 + t1 4180,96686 + arg2 4182,96741 + arg1 4185,96839 + t1 4188,96914 + t1 4190,96953 + iPC 4197,97126 + goto interpretinstructionforbranch;4202,97232 + t3 4217,97590 + arg4 4219,97652 + arg3 4220,97667 + arg5 4221,97698 + arg6 4222,97720 + goto startcallcompiledmerge;4223,97740 + arg6 4239,98108 + arg5 4240,98123 + arg3 4242,98166 + goto startcallcompiledmerge;4243,98181 + arg1 4260,98585 + goto begindostartcall;4268,98734 + goto begindostartcall;4274,98839 + arg1 4284,99063 + t11 4285,99091 + t12 4287,99180 + arg5 4288,99219 + arg6 4289,99248 + t1 4296,99373 + t2 4298,99452 + t3 4299,99470 + arg3 4310,99703 + arg5 4314,99760 + t7 4318,99858 + iSP 4320,99959 + t3 4321,99977 + t6 4322,100013 + t8 4323,100038 + t5 4324,100079 + t7 4326,100121 + t8 4332,100283 + t5 4333,100299 + *(u32 *)iSP 4335,100348 + t8 4339,100456 + *(u32 *)&processor->control control4341,100509 + iPC 4343,100571 + iCP 4344,100621 + *(u32 *)&processor->continuation continuation4345,100667 + *(u64 *)&processor->continuationcp continuationcp4347,100759 + goto cachevalid;4350,100837 + t1 4354,100898 + t2 4355,100934 + t3 4357,100974 + iSP 4362,101105 + t1 4364,101152 + *(u32 *)&processor->control control4366,101204 + goto cachevalid;4367,101240 + t3 4371,101301 + arg3 4378,101464 + arg4 4379,101479 + arg6 4380,101499 + goto g6598;4381,101519 + t3 4385,101575 + arg3 4392,101724 + arg4 4393,101739 + arg6 4394,101759 + goto g6598;4395,101779 + t3 4399,101835 + arg6 4406,101980 + arg3 4408,102026 + arg2 4410,102074 + goto startcallindirect;4411,102093 + t3 4415,102161 + arg2 4422,102322 + t7 4426,102379 + arg6 4427,102400 + arg5 4428,102419 + t5 4430,102466 + t8 4431,102485 + t6 4433,102547 + arg6 4434,102584 + arg5 4435,102607 + t7 4440,102681 + t8 4441,102700 + t7 4442,102726 + arg3 4447,102790 + arg4 4448,102805 + arg2 4449,102820 + t7 4456,102942 + arg6 4457,102963 + arg5 4458,102982 + t5 4460,103029 + t8 4461,103048 + t6 4463,103110 + arg6 4464,103147 + arg5 4465,103170 + t7 4470,103244 + t8 4471,103263 + t7 4472,103289 + t5 4477,103353 + t5 4479,103413 + goto g6598;4482,103460 + arg3 4490,103591 + arg4 4491,103606 + t3 4492,103621 + arg5 4494,103656 + arg2 4495,103676 + t7 4499,103733 + arg6 4500,103754 + arg5 4501,103773 + t5 4503,103820 + t8 4504,103839 + t6 4506,103901 + arg6 4507,103938 + arg5 4508,103961 + t7 4513,104035 + t8 4514,104054 + t7 4515,104080 + t3 4520,104144 + t3 4522,104204 + goto g6598;4525,104251 + arg5 4532,104349 + arg2 4533,104362 + goto illegaloperand;4534,104375 + arg2 4541,104507 + goto g6632;4542,104527 + r0 4549,104625 + goto memoryreaddatadecode;4550,104651 + goto g6643;4552,104692 + arg2 4559,104815 + goto g6619;4560,104835 + r0 4567,104933 + goto memoryreaddatadecode;4568,104959 + goto g6630;4570,105000 + arg2 4577,105123 + goto g6607;4578,105143 + r0 4585,105241 + goto memoryreaddatadecode;4586,105267 + goto g6618;4588,105308 + goto doistageerror;4593,105360 + +stub/ifuncom2.c,24904 + arg1 29,992 + t11 30,1007 + t12 32,1096 + arg2 35,1187 + arg5 36,1216 + arg2 37,1245 + t2 38,1265 + t2 40,1314 + t7 46,1401 + arg6 47,1422 + arg5 48,1441 + t5 50,1488 + t8 51,1507 + t6 53,1567 + arg6 54,1604 + arg5 55,1627 + t7 60,1701 + t8 61,1719 + t7 62,1745 + arg6 67,1809 + t3 68,1843 + arg2 72,1952 + arg2 73,1974 + t7 77,2030 + arg6 78,2051 + arg5 79,2070 + t5 81,2117 + t8 82,2136 + t6 84,2198 + arg6 85,2235 + arg5 86,2258 + t7 91,2332 + t8 92,2351 + t7 93,2377 + arg6 94,2403 + t1 99,2461 + t4 100,2474 + t4 102,2524 + arg2 106,2594 + t4 107,2623 + arg2 108,2650 + t3 109,2670 + t3 111,2730 + t3 115,2808 + t3 117,2854 + arg2 124,2975 + t7 131,3074 + arg6 132,3095 + arg5 133,3114 + t5 135,3161 + t8 136,3180 + t6 138,3242 + arg6 139,3279 + arg5 140,3302 + t7 145,3376 + t8 146,3395 + t7 147,3421 + iPC 152,3485 + iCP 153,3535 + t7 155,3602 + iSP 159,3705 + goto cachevalid;160,3722 + arg2 167,3850 + goto g6675;168,3870 + r0 175,3968 + goto memoryreaddatadecode;176,3994 + goto g6686;178,4035 + arg2 185,4158 + goto g6663;186,4178 + r0 193,4276 + goto memoryreaddatadecode;194,4302 + goto g6674;196,4343 + arg2 203,4466 + goto g6653;204,4486 + r0 211,4584 + goto memoryreadheaderdecode;212,4610 + goto g6662;214,4653 + t3 218,4709 + t7 222,4759 + arg6 223,4780 + arg5 224,4799 + t5 226,4846 + t8 227,4865 + t6 229,4925 + arg6 230,4962 + arg5 231,4985 + t7 236,5059 + t8 237,5077 + t7 238,5103 + arg6 239,5129 + t3 244,5187 + t4 248,5253 + t4 250,5295 + goto g6651;255,5417 + arg2 262,5540 + goto g6687;263,5560 + r0 270,5658 + goto memoryreadheaderdecode;271,5684 + goto g6696;273,5727 + arg1 290,6109 + arg6 294,6189 + arg1 296,6232 + iSP 298,6264 + goto begindoadd;300,6293 + goto begindoadd;306,6380 + arg1 316,6574 + t1 319,6647 + t3 321,6697 + t2 323,6742 + t4 325,6778 + t9 329,6877 + t11 331,6930 + t10 332,6947 + t12 339,7094 + t6 346,7242 + t7 358,7586 + iPC 364,7831 + *(u32 *)iSP 365,7843 + iCP 366,7863 + goto cachevalid;367,7875 + t12 371,7936 + goto g6697;380,8150 + t12 384,8206 + goto g6700;393,8420 + t10 400,8518 + t12 407,8675 + iPC 420,8995 + iCP 421,9045 + t8 422,9091 + goto cachevalid;426,9200 + t12 430,9261 + goto g6697;439,9465 + t12 443,9521 + t11 453,9721 + t12 455,9810 + goto g6701;456,9849 + t10 463,9947 + t12 470,10104 + t11 477,10262 + t12 479,10351 + arg2 480,10390 + r0 481,10408 + goto fetchdoublefloat;482,10434 + arg2 488,10543 + r0 489,10561 + goto fetchdoublefloat;490,10587 + r0 498,10776 + goto consdoublefloat;499,10802 + iPC 501,10838 + iCP 502,10888 + t8 503,10934 + *(u32 *)iSP 504,10959 + goto cachevalid;507,11037 + t12 511,11098 + t11 521,11298 + t12 523,11387 + arg2 524,11426 + r0 525,11444 + goto fetchdoublefloat;526,11470 + goto g6698;529,11537 + t12 533,11593 + goto g6699;542,11797 + arg6 557,12054 + arg3 559,12089 + arg1 561,12134 + arg4 563,12173 + goto numericexception;564,12185 + goto g6705;565,12210 + t1 569,12266 + goto doaddovfl;570,12277 + goto DoAddIM;578,12394 + t1 583,12463 + t2 585,12522 + t11 587,12577 + t12 588,12594 + t3 596,12772 + t4 597,12790 + t10 599,12883 + t5 600,12900 + t10 602,12990 + iPC 608,13169 + *(u32 *)iSP 609,13181 + iCP 610,13201 + goto cachevalid;611,13213 + *(u32 *)&processor->immediate_arg immediate_arg616,13307 + arg1 617,13351 + arg2 618,13392 + goto begindoadd;619,13407 + arg2 640,13917 + arg2 645,14011 + *(u32 *)&processor->immediate_arg immediate_arg646,14037 + arg1 647,14081 + goto begindoblock3write;648,14127 + arg1 655,14261 + goto headdoblock3write;663,14410 + goto headdoblock3write;669,14520 + arg1 678,14713 + arg1 680,14765 + arg3 685,14914 + arg2 686,14949 + goto blockwrite;687,14981 + arg1 704,15362 + goto headdoaset1;712,15511 + goto headdoaset1;718,15603 + arg1 727,15766 + arg1 729,15818 + arg4 735,15990 + arg3 737,16043 + iSP 739,16090 + arg4 740,16107 + t6 742,16162 + t5 744,16217 + iSP 746,16262 + t6 747,16279 + arg2 749,16353 + t8 750,16382 + t8 751,16414 + arg1 753,16450 + t7 754,16471 + t7 756,16562 + t1 757,16578 + t1 759,16628 + t8 768,16802 + t1 769,16846 + t1 771,16905 + t8 775,17001 + goto aset1regset;780,17126 + arg6 782,17153 + t9 784,17233 + t3 786,17310 + t11 787,17355 + t4 788,17375 + t11 789,17418 + t2 790,17437 + t12 791,17475 + arg5 797,17602 + t8 798,17656 + arg4 799,17708 + arg5 800,17761 + arg4 801,17808 + arg6 802,17854 + t1 808,18011 + t8 809,18027 + t2 816,18204 + arg5 819,18263 + arg2 820,18275 + goto illegaloperand;821,18288 + t2 828,18428 + t2 830,18468 + t1 831,18494 + t1 832,18508 + t1 834,18562 + t1 835,18574 + t1 836,18590 + arg5 840,18667 + arg2 841,18679 + goto illegaloperand;842,18692 + t8 846,18757 + t2 853,18928 + arg5 856,18984 + arg2 857,18996 + goto illegaloperand;858,19009 + t8 862,19074 + t6 869,19247 + t1 870,19257 + t6 874,19329 + goto g6745;875,19342 + t1 886,19515 + t1 890,19629 + t4 895,19712 + t8 896,19760 + t7 897,19779 + t3 898,19817 + t2 899,19834 + t4 901,19879 + arg1 902,19895 + t7 904,19960 + t3 905,19996 + t2 906,20015 + t8 911,20085 + arg1 912,20104 + t8 913,20132 + t3 919,20219 + t2 920,20235 + t2 921,20252 + t7 922,20268 + t4 923,20316 + arg1 924,20335 + t3 925,20375 + t8 926,20392 + t7 928,20437 + arg1 930,20471 + t7 931,20511 + t8 932,20545 + t8 936,20621 + *(u32 *)t3 938,20654 + goto NEXTINSTRUCTION;942,20729 + goto NEXTINSTRUCTION;943,20753 + arg2 948,20860 + t1 950,20923 + t1 952,20991 + t2 957,21072 + t4 958,21120 + t3 959,21139 + t9 960,21177 + arg3 961,21194 + t2 963,21241 + t7 964,21257 + t3 966,21319 + t9 967,21355 + arg3 968,21374 + t4 973,21448 + t7 974,21467 + t4 975,21493 + t9 976,21519 + t2 983,21624 + t2 984,21642 + t8 991,21814 + t8 992,21828 + t2 993,21854 + t8 995,21904 + t2 996,21923 + t2 998,21972 + t8 999,21996 + t8 1001,22036 + t3 1002,22062 + t3 1003,22076 + t4 1005,22130 + t7 1010,22282 + t8 1012,22332 + t7 1014,22398 + t9 1016,22469 + t7 1018,22522 + t9 1020,22579 + t8 1022,22645 + t7 1024,22686 + t7 1026,22726 + t9 1028,22781 + goto g6784;1029,22797 + t9 1035,22930 + t8 1037,22993 + t9 1039,23062 + t6 1043,23120 + t3 1047,23173 + t2 1048,23221 + t8 1049,23240 + t7 1050,23278 + t4 1051,23295 + t3 1053,23340 + t8 1055,23374 + t3 1056,23410 + t4 1057,23446 + t4 1061,23522 + *(u32 *)t7 1063,23555 + goto NEXTINSTRUCTION;1067,23628 + goto NEXTINSTRUCTION;1068,23652 + arg5 1072,23718 + arg2 1073,23731 + goto illegaloperand;1074,23744 + goto DoAset1IM;1076,23782 + t8 1081,23857 + arg4 1083,23920 + arg3 1085,23973 + iSP 1087,24020 + arg4 1088,24037 + t7 1089,24057 + t8 1090,24091 + t7 1092,24166 + t6 1094,24217 + t5 1096,24272 + iSP 1098,24317 + t6 1099,24334 + goto aset1merge;1100,24350 + t3 1104,24411 + t2 1108,24501 + t3 1110,24573 + t2 1112,24613 + *(u32 *)t2 1114,24658 + goto NEXTINSTRUCTION;1117,24734 + t3 1121,24800 + t2 1123,24869 + t9 1124,24891 + arg3 1126,24940 + goto g6772;1127,24967 + t1 1134,25090 + goto g6771;1135,25106 + t7 1140,25209 + t4 1143,25294 + *(u64 *)&processor->vma vma1145,25356 + t4 1147,25423 + t7 1149,25475 + t4 1153,25536 + arg3 1156,25602 + arg3 1157,25624 + goto g6782;1158,25671 + t4 1167,25771 + t3 1168,25804 + t2 1171,25873 + t4 1172,25889 + t2 1174,25946 + t3 1175,25962 + t3 1176,25972 + t2 1177,26009 + t2 1179,26064 + t3 1180,26080 + t2 1182,26124 + t9 1184,26163 + t4 1186,26204 + t1 1191,26324 + goto g6771;1192,26340 + goto dbcachemisstrap;1196,26396 + arg1 1201,26465 + arg2 1202,26478 + goto performmemoryaction;1203,26490 + t7 1207,26560 + t4 1211,26650 + t7 1213,26722 + t4 1215,26762 + *(u32 *)t4 1217,26807 + goto NEXTINSTRUCTION;1220,26881 + t7 1224,26947 + t4 1226,27016 + t3 1227,27038 + t2 1229,27087 + goto g6759;1230,27112 + t1 1237,27235 + goto g6758;1238,27251 + arg1 1243,27354 + t8 1246,27442 + *(u64 *)&processor->vma vma1248,27502 + t8 1250,27569 + arg1 1252,27623 + t8 1261,27730 + t7 1262,27765 + t4 1265,27834 + t8 1266,27850 + t4 1268,27907 + t7 1269,27923 + t7 1270,27933 + t4 1271,27970 + t4 1273,28025 + t7 1274,28041 + t4 1276,28085 + t3 1278,28124 + t8 1280,28165 + t1 1285,28285 + goto g6758;1286,28301 + goto dbcachemisstrap;1290,28357 + arg1 1295,28426 + arg2 1296,28441 + goto performmemoryaction;1297,28453 + arg1 1314,28855 + arg6 1318,28941 + arg1 1320,28984 + iSP 1322,29016 + goto begindofastaref1;1324,29045 + goto begindofastaref1;1330,29150 + arg1 1340,29374 + arg3 1341,29402 + arg4 1342,29437 + t1 1343,29457 + t1 1345,29507 + arg6 1351,29621 + t9 1352,29644 + t3 1353,29671 + arg6 1354,29699 + t9 1355,29719 + t5 1356,29735 + t3 1357,29754 + t4 1358,29770 + t5 1359,29813 + t2 1360,29830 + t6 1363,29909 + t6 1366,29978 + t7 1367,30030 + t8 1368,30081 + t6 1369,30133 + t7 1370,30176 + t8 1371,30218 + t1 1374,30292 + t2 1382,30417 + t4 1383,30465 + t3 1384,30484 + t9 1385,30522 + arg5 1386,30539 + t2 1388,30586 + t5 1389,30602 + t3 1391,30664 + t9 1392,30700 + arg5 1393,30719 + t4 1398,30793 + t5 1399,30812 + t4 1400,30838 + t9 1401,30864 + r31 1411,30991 + t1 1412,31010 + arg5 1416,31078 + t4 1421,31168 + r31 1427,31282 + *(u32 *)iSP 1430,31332 + goto NEXTINSTRUCTION;1431,31352 + r31 1436,31441 + t4 1437,31460 + t5 1438,31477 + *(u32 *)iSP 1441,31539 + goto NEXTINSTRUCTION;1442,31559 + r31 1447,31650 + t4 1449,31688 + t4 1451,31727 + t5 1453,31768 + t5 1455,31812 + *(u32 *)iSP 1458,31859 + goto NEXTINSTRUCTION;1459,31879 + r31 1464,31970 + t4 1466,32008 + r31 1467,32026 + t5 1469,32070 + t5 1471,32114 + *(u32 *)iSP 1474,32160 + goto NEXTINSTRUCTION;1475,32180 + t4 1480,32272 + t4 1482,32321 + t5 1483,32337 + *(u32 *)iSP 1486,32400 + goto NEXTINSTRUCTION;1487,32420 + r31 1491,32504 + t4 1492,32523 + t5 1493,32549 + t4 1496,32609 + t5 1499,32670 + r31 1508,32833 + t4 1510,32871 + t4 1512,32911 + t5 1514,32952 + t5 1516,32996 + *(u32 *)iSP 1519,33042 + goto NEXTINSTRUCTION;1520,33062 + arg4 1524,33128 + t1 1526,33189 + t1 1528,33255 + goto g6790;1529,33271 + t1 1533,33327 + t1 1535,33377 + goto g6792;1538,33424 + arg5 1542,33480 + arg5 1545,33535 + t2 1548,33588 + t3 1549,33629 + goto g6794;1550,33668 + *(u64 *)iSP 1556,33747 + goto NEXTINSTRUCTION;1557,33767 + arg5 1561,33833 + arg2 1562,33846 + goto illegaloperand;1563,33859 + arg5 1567,33938 + arg2 1568,33950 + goto illegaloperand;1569,33963 + arg5 1573,34048 + arg2 1574,34060 + goto illegaloperand;1575,34073 + t3 1579,34138 + t2 1581,34207 + t9 1582,34229 + arg5 1584,34278 + goto g6798;1585,34305 + t1 1592,34428 + goto g6797;1593,34444 + t5 1598,34547 + t4 1601,34632 + *(u64 *)&processor->vma vma1603,34694 + t4 1605,34761 + t5 1607,34813 + t4 1611,34874 + arg5 1614,34940 + arg5 1615,34962 + goto g6808;1616,35009 + t4 1625,35109 + t3 1626,35142 + t2 1629,35211 + t4 1630,35227 + t2 1632,35284 + t3 1633,35300 + t3 1634,35310 + t2 1635,35347 + t2 1637,35402 + t3 1638,35418 + t2 1640,35462 + t9 1642,35501 + t4 1644,35542 + t1 1649,35662 + goto g6797;1650,35678 + goto dbcachemisstrap;1654,35734 + arg1 1659,35803 + arg2 1660,35816 + goto performmemoryaction;1661,35828 + goto doistageerror;1666,35894 + arg2 1684,36347 + arg2 1689,36441 + *(u32 *)&processor->immediate_arg immediate_arg1690,36467 + arg1 1691,36511 + goto begindorplaca;1692,36557 + arg1 1699,36676 + arg1 1703,36762 + arg6 1705,36796 + iSP 1707,36837 + goto begindorplaca;1708,36851 + goto headdorplaca;1710,36888 + goto headdorplaca;1716,36983 + arg1 1725,37151 + arg1 1727,37203 + t11 1732,37342 + t12 1734,37431 + t1 1735,37470 + arg2 1737,37531 + iSP 1739,37570 + t3 1741,37604 + t4 1742,37620 + t4 1743,37643 + t2 1750,37772 + arg1 1752,37811 + t7 1756,37868 + arg6 1757,37889 + arg5 1758,37908 + t5 1760,37955 + t8 1761,37974 + t6 1763,38037 + arg6 1764,38074 + arg5 1765,38097 + t7 1770,38171 + t8 1771,38190 + t7 1772,38216 + arg6 1778,38303 + arg5 1779,38321 + arg5 1780,38342 + t5 1781,38364 + arg6 1782,38385 + t7 1783,38404 + t6 1785,38449 + t8 1787,38486 + t6 1788,38523 + t7 1789,38559 + t7 1793,38635 + *(u32 *)arg6 1795,38668 + goto NEXTINSTRUCTION;1799,38745 + goto NEXTINSTRUCTION;1800,38769 + t5 1804,38835 + t6 1806,38907 + t5 1808,38950 + *(u32 *)t5 1810,38995 + goto NEXTINSTRUCTION;1813,39073 + t6 1817,39139 + t5 1819,39208 + arg6 1820,39230 + arg5 1822,39281 + goto g6810;1823,39308 + arg2 1830,39431 + goto g6809;1831,39451 + t8 1836,39554 + t7 1839,39640 + *(u64 *)&processor->vma vma1841,39702 + t7 1843,39771 + t8 1845,39823 + t7 1854,39928 + t6 1855,39961 + t5 1858,40030 + t7 1859,40048 + t5 1861,40105 + t6 1862,40121 + t6 1863,40131 + t5 1864,40168 + t5 1866,40223 + t6 1867,40239 + t5 1869,40283 + arg6 1871,40322 + t7 1873,40365 + arg2 1878,40487 + goto g6809;1879,40507 + goto dbcachemisstrap;1883,40563 + arg1 1888,40632 + arg2 1889,40645 + goto performmemoryaction;1890,40657 + t7 1902,40899 + arg6 1903,40920 + arg5 1904,40939 + t5 1906,40986 + t8 1907,41005 + t6 1909,41068 + arg6 1910,41105 + arg5 1911,41128 + t7 1916,41202 + t8 1917,41221 + t7 1918,41247 + arg6 1919,41273 + goto *r0;r01924,41331 + t6 1933,41500 + t5 1935,41569 + arg6 1936,41591 + arg5 1938,41642 + goto g6824;1939,41669 + arg2 1946,41792 + goto g6823;1947,41812 + t8 1952,41915 + t7 1955,42001 + *(u64 *)&processor->vma vma1957,42063 + t7 1959,42132 + t8 1961,42184 + t7 1970,42289 + t6 1971,42322 + t5 1974,42391 + t7 1975,42409 + t5 1977,42466 + t6 1978,42482 + t6 1979,42492 + t5 1980,42529 + t5 1982,42584 + t6 1983,42600 + t5 1985,42644 + arg6 1987,42683 + t7 1989,42726 + arg2 1994,42848 + goto g6823;1995,42868 + goto dbcachemisstrap;1999,42924 + arg1 2004,42993 + arg2 2005,43006 + goto performmemoryaction;2006,43018 + arg2 2023,43412 + arg2 2028,43506 + *(u32 *)&processor->immediate_arg immediate_arg2029,43532 + arg1 2030,43576 + goto begindorplacd;2031,43622 + arg1 2038,43741 + arg1 2042,43827 + arg6 2044,43861 + iSP 2046,43902 + goto begindorplacd;2047,43916 + goto headdorplacd;2049,43953 + goto headdorplacd;2055,44048 + arg1 2064,44216 + arg1 2066,44268 + t11 2071,44407 + t12 2073,44496 + t1 2074,44535 + arg2 2076,44596 + iSP 2078,44635 + t3 2080,44669 + t4 2081,44685 + t4 2084,44748 + t7 2090,44849 + arg6 2091,44870 + arg5 2092,44889 + t5 2094,44936 + t8 2095,44955 + t6 2097,45012 + arg6 2098,45049 + arg5 2099,45072 + t7 2104,45146 + t8 2105,45165 + t7 2106,45191 + arg5 2112,45271 + arg5 2113,45291 + arg2 2118,45409 + goto rplacstore;2119,45428 + arg2 2126,45556 + goto g6833;2127,45576 + r0 2134,45674 + goto memoryreadcdrdecode;2135,45700 + goto g6842;2137,45740 + t1 2164,46526 + arg2 2166,46581 + arg1 2169,46679 + t1 2172,46754 + t1 2174,46793 + iPC 2178,46909 + iCP 2179,46959 + iSP 2180,47005 + goto cachevalid;2181,47022 + iSP 2188,47178 + iPC 2190,47231 + goto interpretinstructionforbranch;2195,47337 + t1 2222,48189 + arg2 2224,48244 + arg1 2227,48342 + t1 2230,48417 + t1 2232,48456 + iPC 2236,48573 + iCP 2237,48623 + iSP 2238,48669 + goto cachevalid;2239,48686 + iSP 2246,48844 + iPC 2248,48897 + goto interpretinstructionforbranch;2253,49003 + t1 2280,49809 + arg2 2282,49864 + arg1 2285,49962 + t1 2288,50037 + t1 2290,50076 + iPC 2294,50188 + iCP 2295,50238 + iSP 2296,50284 + goto cachevalid;2297,50301 + iPC 2305,50484 + goto interpretinstructionforbranch;2310,50590 + t1 2337,51400 + arg2 2339,51455 + arg1 2342,51553 + t1 2345,51628 + t1 2347,51667 + iPC 2351,51780 + iCP 2352,51830 + iSP 2353,51876 + goto cachevalid;2354,51893 + iPC 2362,52078 + goto interpretinstructionforbranch;2367,52184 + t1 2394,53008 + arg2 2396,53063 + arg1 2399,53161 + t1 2402,53236 + t1 2404,53275 + iSP 2410,53413 + iPC 2412,53465 + goto interpretinstructionforbranch;2417,53571 + arg1 2434,54025 + arg6 2438,54113 + arg1 2440,54156 + iSP 2442,54188 + goto begindoequalnumber;2444,54217 + goto begindoequalnumber;2450,54328 + arg1 2460,54562 + t11 2461,54590 + t7 2462,54632 + t12 2463,54651 + arg3 2465,54712 + t1 2467,54773 + t7 2469,54828 + arg2 2470,54843 + arg4 2471,54866 + t5 2474,54952 + t4 2476,55007 + t6 2477,55023 + t3 2484,55168 + t2 2491,55313 + iPC 2492,55343 + iSP 2494,55412 + iCP 2495,55436 + *(u64 *)iSP 2499,55543 + goto cachevalid;2500,55564 + t6 2507,55667 + t3 2514,55822 + iPC 2527,56188 + iSP 2528,56238 + iCP 2529,56262 + *(u64 *)iSP 2530,56308 + *(u64 *)iSP 2534,56415 + goto cachevalid;2535,56436 + goto equalnumbermmexc;2546,56614 + goto DoEqualNumberIM;2551,56696 + t11 2556,56789 + arg2 2558,56868 + t12 2559,56889 + t7 2560,56929 + arg3 2561,56948 + arg4 2562,56983 + arg2 2564,57041 + t7 2565,57067 + t3 2567,57119 + t4 2568,57137 + t2 2575,57282 + iPC 2576,57312 + iSP 2577,57362 + iCP 2578,57386 + *(u64 *)iSP 2582,57493 + goto cachevalid;2583,57514 + arg6 2589,57642 + arg3 2591,57679 + arg1 2593,57724 + arg4 2595,57763 + goto numericexception;2596,57775 + arg1 2616,58264 + goto begindosettocdrpushcar;2624,58413 + goto begindosettocdrpushcar;2630,58536 + arg1 2640,58790 + t11 2641,58818 + t12 2643,58907 + t2 2645,58986 + t1 2646,59007 + t2 2647,59034 + t3 2649,59080 + t5 2650,59097 + t5 2652,59147 + r0 2655,59212 + goto carcdrinternal;2656,59238 + arg5 2659,59290 + arg5 2661,59350 + *(u32 *)arg1 2662,59370 + t5 2666,59473 + iSP 2670,59572 + goto NEXTINSTRUCTION;2671,59589 + goto doistageerror;2676,59657 + arg1 2693,60037 + arg6 2697,60117 + arg1 2699,60160 + iSP 2701,60192 + goto begindosub;2703,60221 + goto begindosub;2709,60308 + arg1 2719,60502 + t1 2722,60575 + t3 2724,60625 + t2 2726,60670 + t4 2728,60706 + t9 2732,60805 + t11 2734,60858 + t10 2735,60875 + t12 2742,61022 + t6 2749,61170 + t7 2761,61514 + iPC 2767,61759 + *(u32 *)iSP 2768,61771 + iCP 2769,61791 + goto cachevalid;2770,61803 + t12 2774,61864 + goto g6868;2783,62078 + t12 2787,62134 + goto g6871;2796,62348 + t10 2803,62446 + t12 2810,62603 + iPC 2823,62923 + iCP 2824,62973 + t8 2825,63019 + goto cachevalid;2829,63128 + t12 2833,63189 + goto g6868;2842,63393 + t12 2846,63449 + t11 2856,63649 + t12 2858,63738 + goto g6872;2859,63777 + t10 2866,63875 + t12 2873,64032 + t11 2880,64190 + t12 2882,64279 + arg2 2883,64318 + r0 2884,64336 + goto fetchdoublefloat;2885,64362 + arg2 2891,64471 + r0 2892,64489 + goto fetchdoublefloat;2893,64515 + r0 2901,64693 + goto consdoublefloat;2902,64719 + iPC 2904,64755 + iCP 2905,64805 + t8 2906,64851 + *(u32 *)iSP 2907,64876 + goto cachevalid;2910,64954 + t12 2914,65015 + t11 2924,65215 + t12 2926,65304 + arg2 2927,65343 + r0 2928,65361 + goto fetchdoublefloat;2929,65387 + goto g6869;2932,65454 + t12 2936,65510 + goto g6870;2945,65714 + arg6 2960,65971 + arg3 2962,66006 + arg1 2964,66051 + arg4 2966,66090 + goto numericexception;2967,66102 + goto g6876;2968,66127 + t1 2972,66183 + goto dosubovfl;2973,66194 + goto DoSubIM;2981,66311 + t1 2986,66380 + t2 2988,66439 + t11 2990,66494 + t12 2991,66511 + t3 2999,66689 + t4 3000,66707 + t10 3002,66800 + t5 3003,66817 + t10 3005,66907 + iPC 3011,67086 + *(u32 *)iSP 3012,67098 + iCP 3013,67118 + goto cachevalid;3014,67130 + *(u32 *)&processor->immediate_arg immediate_arg3019,67224 + arg1 3020,67268 + arg2 3021,67309 + goto begindosub;3022,67324 + *(u32 *)&processor->immediate_arg immediate_arg3043,67776 + arg1 3044,67820 + arg2 3045,67861 + goto begindotag;3046,67876 + arg1 3053,67986 + goto begindotag;3061,68135 + goto begindotag;3067,68222 + arg1 3077,68416 + iPC 3078,68444 + arg1 3080,68529 + iCP 3081,68558 + t3 3082,68604 + iSP 3086,68709 + goto cachevalid;3087,68726 + arg1 3104,69085 + goto begindoendp;3112,69234 + goto begindoendp;3118,69324 + arg1 3128,69523 + t1 3129,69551 + arg2 3131,69609 + t2 3132,69638 + arg2 3134,69694 + t6 3136,69730 + iPC 3139,69790 + iCP 3140,69840 + iSP 3142,69912 + goto cachevalid;3143,69929 + iPC 3147,69994 + iCP 3148,70044 + iSP 3150,70116 + goto cachevalid;3151,70133 + t6 3156,70231 + t6 3159,70279 + goto DoEndpIM;3163,70360 + arg5 3168,70432 + arg2 3169,70444 + goto illegaloperand;3170,70457 + arg1 3187,70834 + goto begindominusp;3195,70983 + goto begindominusp;3201,71079 + arg1 3211,71288 + t11 3212,71316 + t6 3213,71358 + t1 3214,71407 + t12 3215,71434 + t2 3216,71474 + t4 3219,71561 + t5 3220,71577 + iPC 3227,71722 + iCP 3228,71734 + iSP 3233,71873 + goto cachevalid;3234,71890 + t5 3238,71951 + iPC 3245,72106 + iSP 3247,72145 + iCP 3248,72162 + *(u64 *)iSP 3252,72293 + goto cachevalid;3253,72314 + arg6 3259,72442 + arg3 3261,72477 + arg1 3263,72522 + arg4 3265,72561 + goto unarynumericexception;3266,72573 + goto DoMinuspIM;3271,72660 + t1 3276,72738 + arg2 3278,72815 + t2 3279,72836 + iSP 3280,72875 + iPC 3281,72892 + iCP 3282,72942 + *(u64 *)iSP 3287,73099 + goto cachevalid;3288,73119 + arg1 3305,73490 + goto begindoplusp;3313,73639 + goto begindoplusp;3319,73732 + arg1 3329,73936 + t11 3330,73964 + t6 3331,74006 + t1 3332,74055 + t12 3333,74082 + t2 3334,74122 + t4 3337,74209 + t5 3338,74225 + iPC 3345,74370 + iCP 3346,74382 + iSP 3351,74521 + goto cachevalid;3352,74538 + t5 3356,74599 + iPC 3363,74754 + iSP 3365,74793 + iCP 3366,74810 + *(u64 *)iSP 3370,74941 + goto cachevalid;3371,74962 + arg6 3377,75090 + arg3 3379,75125 + arg1 3381,75170 + arg4 3383,75209 + goto unarynumericexception;3384,75221 + goto DoPluspIM;3389,75308 + t1 3394,75383 + arg2 3396,75460 + t2 3397,75481 + iSP 3398,75520 + iPC 3399,75537 + iCP 3400,75587 + *(u64 *)iSP 3405,75744 + goto cachevalid;3406,75764 + arg1 3423,76133 + arg6 3427,76215 + arg1 3429,76258 + iSP 3431,76290 + goto begindolessp;3433,76319 + goto begindolessp;3439,76412 + arg1 3449,76616 + t11 3450,76644 + t7 3451,76686 + t12 3452,76705 + arg3 3454,76766 + t1 3456,76827 + t7 3458,76882 + arg2 3459,76897 + arg4 3460,76920 + t5 3463,77006 + t4 3465,77061 + t6 3466,77077 + t3 3473,77222 + t2 3480,77367 + iPC 3481,77387 + iSP 3483,77456 + iCP 3484,77480 + *(u64 *)iSP 3488,77591 + goto cachevalid;3489,77612 + t6 3496,77715 + t3 3503,77870 + iPC 3516,78223 + iSP 3517,78273 + iCP 3518,78297 + *(u64 *)iSP 3519,78343 + *(u64 *)iSP 3523,78450 + goto cachevalid;3524,78471 + goto lesspmmexc;3535,78649 + goto DoLesspIM;3540,78725 + t11 3545,78800 + arg2 3547,78879 + t12 3548,78900 + t7 3549,78940 + arg3 3550,78959 + arg4 3551,78994 + arg2 3553,79052 + t7 3554,79078 + t3 3556,79130 + t4 3557,79148 + t2 3564,79293 + iPC 3565,79313 + iSP 3566,79363 + iCP 3567,79387 + *(u64 *)iSP 3571,79498 + goto cachevalid;3572,79519 + arg6 3578,79647 + arg3 3580,79684 + arg1 3582,79729 + arg4 3584,79768 + goto numericexception;3585,79780 + arg1 3605,80221 + goto begindodecrement;3613,80370 + goto begindodecrement;3619,80475 + arg1 3629,80699 + arg3 3631,80757 + arg2 3632,80780 + arg3 3633,80809 + t1 3635,80866 + t2 3636,80884 + t2 3643,81029 + t3 3644,81078 + t2 3645,81095 + iPC 3648,81168 + iCP 3649,81218 + *(u32 *)arg1 3650,81264 + goto cachevalid;3653,81344 + t2 3657,81405 + iPC 3672,81803 + iCP 3673,81853 + goto cachevalid;3676,81960 + goto decrementexception;3681,82054 + goto doistageerror;3689,82161 + arg1 3706,82589 + arg6 3710,82679 + arg1 3712,82722 + iSP 3714,82754 + goto begindomergecdrnopop;3716,82783 + goto begindomergecdrnopop;3722,82900 + arg1 3732,83144 + iPC 3733,83172 + iCP 3734,83222 + t1 3736,83305 + t2 3738,83369 + t2 3743,83486 + t1 3745,83531 + t3 3747,83603 + goto cachevalid;3750,83682 + goto doistageerror;3755,83743 + goto DoEqIM;3765,83986 + arg2 3770,84052 + t4 3772,84096 + t3 3773,84122 + arg3 3774,84142 + t11 3775,84163 + arg2 3777,84248 + t4 3779,84291 + t12 3780,84307 + arg3 3782,84377 + arg2 3783,84396 + t4 3784,84426 + iSP 3786,84496 + iPC 3787,84522 + t4 3788,84572 + iCP 3789,84590 + *(u64 *)iSP 3793,84720 + goto cachevalid;3794,84741 + arg1 3810,85082 + goto begindoincrement;3818,85231 + goto begindoincrement;3824,85336 + arg1 3834,85560 + arg3 3836,85618 + arg2 3837,85641 + arg3 3838,85670 + t1 3840,85727 + t2 3841,85745 + t2 3848,85890 + t3 3849,85939 + t2 3850,85956 + iPC 3853,86029 + iCP 3854,86079 + *(u32 *)arg1 3855,86125 + goto cachevalid;3858,86205 + t2 3862,86266 + iPC 3877,86664 + iCP 3878,86714 + goto cachevalid;3881,86821 + goto incrementexception;3886,86915 + goto doistageerror;3894,87022 + +stub/ifunfcal.c,24504 + arg1 32,971 + arg2 34,1036 + iSP 36,1076 + arg2 38,1143 + goto finishcallmerge;39,1168 + arg5 66,1897 + arg4 68,1977 + arg1 70,2051 + arg4 71,2085 + t2 74,2231 + t1 76,2276 + t3 79,2329 + t4 81,2386 + t2 91,2545 + arg1 96,2660 + iPC 102,2832 + t3 104,2915 + iCP 105,2931 + iPC 110,3096 + iPC 112,3145 + goto interpretinstructionforjump;113,3164 + arg1 118,3279 + t6 126,3465 + t6 127,3491 + t6 128,3507 + t2 132,3593 + t2 133,3611 + iPC 136,3712 + t3 138,3795 + iCP 139,3811 + iPC 144,3976 + iPC 146,4025 + goto interpretinstructionforjump;147,4044 + arg5 151,4140 + arg2 152,4152 + goto illegaloperand;153,4165 + t1 158,4260 + t1 159,4286 + t1 160,4302 + t2 163,4360 + t3 165,4417 + t1 174,4548 + t3 176,4616 + t2 177,4661 + t3 179,4750 + t3 181,4811 + t2 183,4851 + t1 184,4867 + iSP 188,4968 + goto g6975;189,4985 + t1 193,5041 + t3 195,5073 + t3 196,5098 + t3 197,5114 + t1 200,5172 + t3 202,5240 + t2 203,5285 + t3 205,5374 + t3 207,5435 + t2 209,5475 + t1 210,5491 + iSP 214,5592 + iLP 215,5609 + arg5 216,5626 + *(u32 *)&processor->control control217,5645 + t1 221,5725 + t1 222,5745 + iPC 225,5846 + t2 227,5929 + iCP 228,5945 + iPC 233,6110 + iPC 235,6159 + goto interpretinstructionforjump;236,6178 + t3 240,6256 + t3 241,6272 + t2 246,6401 + t2 248,6449 + iSP 250,6504 + arg5 252,6558 + *(u32 *)&processor->control control254,6611 + goto g6977;255,6649 + t4 259,6705 + t4 260,6721 + t3 265,6856 + t3 267,6904 + iSP 269,6959 + arg5 271,7013 + *(u32 *)&processor->control control273,7066 + goto g6972;274,7104 + sp 283,7314 + arg2 284,7330 + t5 286,7403 + t6 287,7419 + t7 297,7597 + arg6 298,7618 + arg5 299,7637 + t5 301,7684 + t8 302,7703 + t6 304,7765 + arg6 305,7802 + arg5 306,7825 + t7 311,7899 + t8 312,7918 + t7 313,7944 + arg6 314,7970 + t5 319,8028 + t1 323,8132 + t2 324,8145 + t5 329,8226 + arg6 334,8343 + arg5 335,8362 + sp 345,8508 + goto *r0;r0346,8523 + t6 350,8587 + arg6 357,8726 + arg5 358,8767 + arg6 359,8814 + goto g6982;360,8834 + arg6 366,8957 + arg3 368,8992 + arg1 370,9037 + arg4 372,9076 + goto listexception;373,9088 + arg2 377,9152 + t1 378,9188 + t2 379,9201 + t7 383,9251 + arg6 384,9272 + arg5 385,9291 + t5 387,9338 + t8 388,9357 + t6 390,9414 + arg6 391,9451 + arg5 392,9474 + t7 397,9548 + t8 398,9567 + t7 399,9593 + goto g6981;404,9657 + arg2 411,9780 + goto g7015;412,9800 + *(u64 *)sp 419,9898 + r0 420,9917 + goto memoryreadcdrdecode;421,9943 + r0 423,9983 + goto g7024;424,10002 + t6 428,10058 + arg2 435,10188 + t7 439,10244 + arg6 440,10265 + arg5 441,10284 + t5 443,10331 + t8 444,10350 + t6 446,10412 + arg6 447,10449 + arg5 448,10472 + t7 453,10546 + t8 454,10565 + t7 455,10591 + arg6 456,10617 + goto g6980;459,10667 + t6 463,10723 + arg6 470,10851 + arg5 471,10892 + arg6 472,10939 + goto g6980;473,10959 + arg5 478,11048 + arg2 479,11063 + goto illegaloperand;480,11076 + arg2 487,11208 + goto g6999;488,11228 + *(u64 *)sp 495,11326 + r0 496,11345 + goto memoryreaddatadecode;497,11371 + r0 499,11412 + goto g6980;500,11431 + arg2 507,11554 + goto g6984;508,11574 + *(u64 *)sp 515,11672 + r0 516,11691 + goto memoryreaddatadecode;517,11717 + r0 519,11758 + goto g6995;520,11777 + t11 528,11920 + t12 530,12009 + arg4 532,12073 + arg3 533,12095 + arg4 534,12123 + t2 535,12143 + t3 537,12216 + t4 538,12234 + t5 548,12412 + arg6 549,12431 + arg5 550,12450 + t3 552,12497 + t6 553,12514 + t4 555,12576 + arg6 556,12613 + arg5 557,12636 + t5 562,12710 + t6 563,12729 + t5 564,12755 + arg6 565,12781 + t3 570,12839 + arg3 574,12943 + arg4 575,12958 + t3 580,13041 + arg6 585,13158 + arg5 586,13175 + *(u32 *)iSP 597,13354 + t1 601,13455 + iSP 606,13588 + arg2 607,13605 + t2 609,13673 + arg2 610,13692 + t2 611,13715 + arg2 613,13758 + *(u32 *)&processor->control control614,13778 + iLP 615,13816 + goto INTERPRETINSTRUCTION;616,13833 + t4 620,13904 + arg6 627,14043 + arg5 628,14084 + arg6 629,14131 + goto g7033;630,14151 + arg1 635,14240 + goto pullapplyargstrap;636,14255 + t2 640,14323 + arg3 641,14359 + arg4 642,14374 + t5 646,14426 + arg6 647,14445 + arg5 648,14464 + t3 650,14511 + t6 651,14528 + t4 653,14585 + arg6 654,14622 + arg5 655,14645 + t5 660,14719 + t6 661,14738 + t5 662,14764 + goto g7032;667,14828 + t4 671,14884 + t3 673,14953 + arg6 674,14975 + arg5 676,15026 + goto g7067;677,15053 + t2 684,15176 + goto g7066;685,15194 + t6 690,15297 + t5 693,15377 + *(u64 *)&processor->vma vma695,15439 + t5 697,15506 + t6 699,15558 + arg1 703,15615 + arg2 704,15628 + goto performmemoryaction;705,15640 + t4 709,15710 + t2 716,15840 + t5 720,15892 + arg6 721,15911 + arg5 722,15930 + t3 724,15977 + t6 725,15994 + t4 727,16056 + arg6 728,16093 + arg5 729,16116 + t5 734,16190 + t6 735,16209 + t5 736,16235 + arg6 737,16261 + goto g7031;740,16311 + t4 744,16367 + arg6 751,16495 + arg5 752,16536 + arg6 753,16583 + goto g7031;754,16603 + arg5 759,16692 + arg2 760,16705 + goto illegaloperand;761,16718 + t4 765,16783 + t3 767,16852 + arg6 768,16874 + arg5 770,16925 + goto g7051;771,16952 + t2 778,17075 + goto g7050;779,17093 + t6 784,17196 + t5 787,17281 + *(u64 *)&processor->vma vma789,17343 + t5 791,17410 + t6 793,17462 + t5 797,17523 + arg5 800,17589 + arg5 801,17611 + goto g7031;802,17658 + t5 811,17758 + t4 812,17791 + t3 815,17860 + t5 816,17876 + t3 818,17933 + t4 819,17949 + t4 820,17959 + t3 821,17996 + t3 823,18051 + t4 824,18067 + t3 826,18111 + arg6 828,18150 + t5 830,18193 + t2 835,18313 + goto g7050;836,18331 + goto dbcachemisstrap;840,18387 + arg1 845,18456 + arg2 846,18469 + goto performmemoryaction;847,18481 + t4 851,18551 + t3 853,18620 + arg6 854,18642 + arg5 856,18693 + goto g7036;857,18720 + t2 864,18843 + goto g7035;865,18861 + t6 870,18964 + t5 873,19049 + *(u64 *)&processor->vma vma875,19111 + t5 877,19178 + t6 879,19230 + t5 883,19291 + arg5 886,19357 + arg5 887,19379 + goto g7046;888,19426 + t5 897,19526 + t4 898,19559 + t3 901,19628 + t5 902,19644 + t3 904,19701 + t4 905,19717 + t4 906,19727 + t3 907,19764 + t3 909,19819 + t4 910,19835 + t3 912,19879 + arg6 914,19918 + t5 916,19961 + t2 921,20081 + goto g7035;922,20099 + goto dbcachemisstrap;926,20155 + arg1 931,20224 + arg2 932,20237 + goto performmemoryaction;933,20249 + arg1 949,20616 + goto begindolocatelocals;957,20765 + goto begindolocatelocals;963,20879 + arg1 973,21118 + t1 975,21175 + iLP 976,21211 + t3 978,21263 + t3 980,21314 + t2 982,21352 + t2 984,21396 + t1 985,21411 + t1 987,21459 + t4 988,21475 + iSP 992,21578 + *(u32 *)&processor->control control993,21595 + goto NEXTINSTRUCTION;994,21631 + goto doistageerror;999,21696 + arg1 1017,22155 + goto begindoreturnmultiple;1025,22304 + goto begindoreturnmultiple;1031,22424 + arg1 1041,22673 + t1 1043,22738 + arg1 1045,22788 + t2 1046,22811 + t2 1048,22859 + arg1 1052,22953 + arg5 1056,23039 + t3 1057,23077 + t2 1058,23096 + t1 1060,23132 + t3 1062,23163 + t3 1064,23224 + arg3 1066,23278 + arg6 1067,23296 + arg4 1069,23395 + t3 1073,23513 + t1 1074,23533 + t5 1075,23554 + t1 1077,23608 + t2 1078,23626 + t7 1079,23652 + t3 1083,23744 + t4 1084,23760 + t5 1085,23807 + t6 1089,23928 + t6 1094,24033 + t2 1096,24076 + iPC 1101,24172 + t1 1102,24189 + t7 1103,24204 + iPC 1104,24249 + t1 1111,24440 + *(u32 *)&processor->continuation continuation1112,24458 + iSP 1114,24534 + *(u64 *)&processor->continuationcp continuationcp1115,24551 + t1 1117,24637 + t1 1119,24665 + t2 1120,24686 + t2 1121,24707 + t3 1123,24761 + t6 1125,24836 + t4 1127,24886 + iFP 1129,24963 + *(u32 *)&processor->control control1131,25018 + t1 1133,25088 + t3 1134,25105 + t3 1135,25120 + *(u64 *)&processor->stop_interpreter stop_interpreter1136,25136 + iLP 1138,25216 + arg6 1140,25277 + t4 1142,25354 + t3 1144,25385 + t1 1146,25425 + goto g7084;1147,25467 + t3 1151,25523 + t2 1153,25569 + arg3 1155,25620 + t2 1157,25666 + *(u64 *)t4 1159,25715 + t4 1161,25762 + iSP 1167,25860 + t1 1174,26062 + iSP 1179,26200 + arg2 1185,26336 + goto INTERPRETINSTRUCTION;1190,26461 + goto stackcacheunderflowcheck;1194,26568 + arg3 1198,26673 + t1 1199,26696 + arg3 1201,26755 + arg3 1203,26794 + goto returncommontail;1206,26847 + t1 1212,26990 + iSP 1216,27095 + goto returnmultipledone;1217,27112 + goto DoReturnMultipleIM;1219,27154 + arg1 1224,27256 + arg2 1225,27271 + goto returnmultipletop;1226,27290 + arg5 1230,27380 + arg2 1231,27392 + goto illegaloperand;1232,27405 + iSP 1242,27670 + arg5 1244,27740 + t1 1248,27820 + t4 1249,27841 + t4 1250,27880 + t2 1251,27896 + t2 1256,28024 + t3 1257,28072 + t2 1259,28158 + t3 1261,28198 + t6 1262,28220 + t5 1263,28246 + t6 1264,28272 + t2 1265,28288 + t1 1266,28313 + t2 1267,28339 + t12 1268,28355 + t3 1272,28460 + t2 1274,28518 + t2 1276,28566 + t3 1277,28583 + arg5 1278,28602 + *(u32 *)&processor->control control1279,28620 + t5 1281,28675 + t5 1282,28691 + t6 1283,28708 + *(u64 *)&processor->catchblock catchblock1284,28724 + goto g7088;1285,28763 + t1 1289,28819 + t2 1290,28839 + t1 1291,28857 + t4 1297,29033 + t3 1298,29050 + t3 1300,29100 + t1 1307,29208 + t4 1308,29258 + t1 1310,29311 + t2 1311,29327 + t5 1312,29347 + t3 1313,29362 + t4 1315,29403 + t4 1319,29477 + arg5 1320,29517 + arg2 1321,29529 + goto illegaloperand;1322,29542 + t8 1330,29672 + t10 1331,29720 + t9 1332,29740 + t6 1333,29778 + t7 1334,29796 + t8 1336,29842 + t11 1337,29858 + t9 1339,29921 + t6 1340,29957 + t7 1341,29976 + t10 1346,30047 + t11 1347,30067 + t10 1348,30093 + t8 1357,30223 + t10 1358,30271 + t9 1359,30291 + t2 1360,30329 + t3 1361,30347 + t8 1363,30393 + t11 1364,30409 + t9 1366,30472 + t2 1367,30508 + t3 1368,30527 + t10 1373,30598 + t11 1374,30618 + t10 1375,30644 + t2 1376,30670 + t10 1385,30790 + t12 1386,30839 + t11 1387,30859 + t9 1388,30898 + t8 1389,30916 + t10 1391,30962 + t11 1393,30998 + t9 1394,31037 + t8 1395,31056 + t10 1400,31128 + t12 1401,31174 + t10 1402,31194 + t12 1403,31220 + t9 1409,31308 + t8 1410,31324 + t8 1411,31341 + t10 1412,31357 + t9 1413,31377 + t12 1414,31395 + t11 1415,31415 + t12 1416,31451 + t12 1420,31530 + t11 1421,31549 + t10 1423,31617 + t11 1425,31683 + t10 1427,31719 + *(u32 *)t9 1428,31758 + t3 1435,31881 + t3 1436,31897 + t1 1437,31914 + *(u32 *)&processor->bindingstackpointer bindingstackpointer1439,31946 + t4 1440,31994 + *(u32 *)&processor->control control1441,32010 + arg5 1442,32046 + t1 1443,32084 + t2 1444,32104 + t2 1448,32193 + t3 1449,32234 + t3 1450,32249 + t2 1451,32275 + *(u32 *)&processor->interruptreg interruptreg1452,32291 + *(u64 *)&processor->stop_interpreter stop_interpreter1455,32363 + t3 1462,32492 + t2 1463,32512 + arg5 1466,32576 + arg2 1467,32591 + goto illegaloperand;1468,32604 + goto INTERPRETINSTRUCTION;1469,32627 + t10 1473,32698 + t10 1475,32768 + *(u32 *)t10 1477,32816 + goto g7121;1480,32892 + t11 1484,32948 + t10 1486,33018 + t9 1487,33043 + t8 1489,33093 + goto g7112;1490,33119 + t2 1497,33243 + goto g7111;1498,33259 + t10 1503,33362 + t12 1506,33449 + *(u64 *)&processor->vma vma1508,33510 + t12 1510,33577 + t10 1512,33632 + arg1 1516,33691 + arg2 1517,33705 + goto performmemoryaction;1518,33717 + t9 1522,33787 + t8 1524,33856 + t2 1525,33878 + t3 1527,33927 + goto g7102;1528,33952 + t5 1535,34076 + goto g7101;1536,34092 + t11 1541,34195 + t10 1544,34281 + *(u64 *)&processor->vma vma1546,34342 + t10 1548,34409 + t11 1550,34464 + arg1 1554,34523 + arg2 1555,34537 + goto performmemoryaction;1556,34549 + t9 1560,34619 + t8 1562,34688 + t6 1563,34710 + t7 1565,34759 + goto g7092;1566,34784 + t1 1573,34908 + goto g7091;1574,34924 + t11 1579,35027 + t10 1582,35113 + *(u64 *)&processor->vma vma1584,35174 + t10 1586,35241 + t11 1588,35296 + arg1 1592,35355 + arg2 1593,35369 + goto performmemoryaction;1594,35381 + t1 1602,35557 + t4 1604,35653 + t3 1606,35740 + t3 1610,35849 + t4 1612,35910 + r0 1616,36029 + goto stackcacheunderflow;1617,36055 + goto interpretinstructionforbranch;1619,36095 + t2 1628,36313 + t5 1630,36382 + t5 1632,36428 + t1 1635,36515 + t2 1637,36575 + goto g7125;1638,36597 + t1 1643,36683 + t5 1644,36698 + t7 1646,36744 + t2 1648,36791 + *(u64 *)t2 1650,36838 + iFP 1656,36946 + t4 1657,36970 + iSP 1658,37010 + iLP 1659,37034 + t4 1660,37058 + t1 1662,37141 + t2 1663,37189 + *(u64 *)&processor->restartsp restartsp1664,37234 + t1 1666,37320 + t4 1668,37357 + *(u64 *)&processor->stackcachebasevma stackcachebasevma1669,37404 + t4 1671,37478 + *(u64 *)&processor->stackcachetopvma stackcachetopvma1672,37494 + t7 1673,37539 + t5 1674,37558 + t4 1675,37575 + t5 1676,37593 + t4 1677,37612 + goto g7127;1678,37643 + t7 1682,37699 + t5 1683,37718 + t4 1684,37735 + t5 1685,37753 + t4 1686,37772 + t3 1687,37803 + t1 1689,37847 + *(u32 *)t2 1690,37862 + t2 1694,37965 + t4 1701,38079 + t5 1706,38220 + t1 1707,38263 + t1 1712,38413 + *(u32 *)&t4->tracedata_recording_p tracedata_recording_p1713,38441 + t5 1721,38635 + t1 1722,38682 + *(u64 *)&t5->tracerecord_epc tracerecord_epc1724,38754 + *(u64 *)&t5->tracerecord_counter tracerecord_counter1726,38823 + t1 1727,38864 + t3 1729,38927 + t2 1730,38972 + t3 1732,39061 + t3 1734,39123 + t2 1736,39163 + *(u64 *)&t5->tracerecord_tos tracerecord_tos1738,39213 + *(u64 *)&t5->tracerecord_sp tracerecord_sp1740,39274 + t1 1741,39310 + t2 1742,39354 + *(u32 *)&t5->tracerecord_operand tracerecord_operand1744,39440 + *(u64 *)&t5->tracerecord_instruction tracerecord_instruction1746,39530 + t2 1747,39575 + t3 1748,39613 + *(u32 *)&t5->tracerecord_catch_block_p tracerecord_catch_block_p1750,39704 + *(u64 *)&t5->tracerecord_catch_block_0 tracerecord_catch_block_01752,39783 + t1 1753,39830 + *(u64 *)&t5->tracerecord_instruction_data tracerecord_instruction_data1755,39907 + *(u32 *)&t5->tracerecord_trap_p tracerecord_trap_p1757,39986 + t1 1761,40085 + *(u64 *)&processor->tvi tvi1763,40158 + t2 1764,40192 + *(u64 *)&t5->tracerecord_trap_data_0 tracerecord_trap_data_01766,40250 + t3 1767,40295 + *(u64 *)&t5->tracerecord_trap_data_1 tracerecord_trap_data_11769,40344 + t6 1770,40389 + *(u64 *)&t5->tracerecord_trap_data_2 tracerecord_trap_data_21772,40454 + *(u64 *)&t5->tracerecord_trap_data_3 tracerecord_trap_data_31773,40499 + t5 1778,40620 + t1 1780,40695 + *(u64 *)&t4->tracedata_current_entry tracedata_current_entry1782,40791 + t2 1784,40879 + t3 1786,40968 + t2 1788,41070 + *(u64 *)&processor->cp cp1798,41318 + *(u64 *)&processor->epc epc1799,41350 + *(u64 *)&processor->sp sp1800,41383 + *(u64 *)&processor->fp fp1801,41415 + *(u64 *)&processor->lp lp1802,41447 + *(u64 *)&processor->asrf2 asrf21803,41479 + *(u64 *)&processor->asrf3 asrf31804,41515 + *(u64 *)&processor->asrf4 asrf41805,41551 + *(u64 *)&processor->asrf5 asrf51806,41587 + *(u64 *)&processor->asrf6 asrf61807,41623 + *(u64 *)&processor->asrf7 asrf71808,41659 + *(u64 *)&processor->asrf8 asrf81809,41695 + *(u64 *)&processor->asrf9 asrf91810,41729 + r9 1811,41763 + r10 1812,41799 + r11 1813,41837 + r12 1814,41875 + r13 1815,41913 + r15 1816,41951 + r27 1817,41989 + r29 1818,42027 + pv 1819,42065 + r0 1820,42076 + r9 1821,42135 + r10 1822,42171 + r11 1823,42209 + r12 1824,42247 + r13 1825,42285 + r15 1826,42323 + r27 1827,42361 + r29 1828,42399 + arg1 1829,42437 + arg2 1830,42475 + arg3 1831,42513 + arg4 1832,42551 + arg5 1833,42589 + arg6 1834,42627 + t4 1835,42665 + t5 1836,42701 + iCP 1837,42737 + iPC 1838,42771 + iSP 1839,42806 + iFP 1840,42840 + iLP 1841,42874 + t2 1843,42937 + *(u64 *)&t4->tracedata_current_entry tracedata_current_entry1848,43025 + *(u32 *)&t4->tracedata_wrap_p tracedata_wrap_p1853,43176 + t5 1857,43256 + t5 1859,43352 + t5 1861,43414 + *(u32 *)&t4->tracedata_recording_p tracedata_recording_p1863,43470 + goto *r0;r01868,43562 + t1 1877,43774 + t1 1879,43838 + t1 1881,43892 + iSP 1882,43915 + t4 1884,43990 + t4 1886,44055 + t4 1887,44071 + *(u32 *)&processor->scovlimit scovlimit1889,44120 + t4 1892,44281 + t3 1893,44326 + t4 1895,44415 + t4 1897,44476 + t3 1899,44516 + t5 1901,44566 + t4 1903,44653 + t5 1905,44739 + t4 1907,44807 + *(u64 *)&processor->vma vma1909,44847 + t4 1911,44917 + t5 1915,45015 + t5 1919,45122 + t4 1925,45296 + t5 1927,45377 + t5 1928,45422 + t1 1933,45607 + t2 1935,45655 + t3 1937,45737 + *(u32 *)&processor->scovdumpcount scovdumpcount1939,45821 + t5 1941,45896 + t2 1943,45948 + goto g7134;1945,45987 + t4 1950,46065 + t1 1951,46084 + t3 1953,46128 + *(u32 *)t2 1955,46166 + t2 1957,46214 + t1 1964,46320 + t2 1966,46386 + t4 1967,46397 + t3 1969,46441 + goto g7136;1970,46457 + t1 1974,46513 + t4 1976,46549 + t3 1978,46603 + t5 1980,46647 + t4 1982,46694 + t5 1984,46751 + t5 1986,46809 + t2 1990,46901 + t1 1995,46959 + t2 1997,47007 + t4 1999,47076 + t5 2001,47152 + t2 2003,47220 + t4 2005,47264 + t5 2007,47301 + *(u64 *)&processor->stackcachebasevma stackcachebasevma2009,47337 + *(u64 *)&processor->stackcachetopvma stackcachetopvma2010,47383 + *(u32 *)&processor->scovlimit scovlimit2011,47428 + t3 2014,47528 + t2 2016,47611 + goto g7138;2017,47633 + t1 2021,47689 + t5 2023,47735 + t2 2025,47784 + *(u64 *)t3 2027,47831 + t3 2029,47878 + t1 2035,47982 + t1 2037,48035 + iSP 2038,48051 + iFP 2039,48069 + iLP 2040,48087 + *(u64 *)&processor->restartsp restartsp2041,48105 + goto INTERPRETINSTRUCTION;2042,48144 + arg1 2058,48518 + goto begindoreturnkludge;2066,48667 + goto begindoreturnkludge;2072,48781 + arg1 2082,49020 + t1 2083,49048 + arg2 2084,49075 + t2 2085,49098 + t2 2087,49146 + arg2 2090,49202 + goto DoReturnKludgeIM;2092,49237 + arg6 2097,49333 + t1 2098,49380 + t2 2099,49403 + t1 2101,49470 + t5 2103,49536 + t3 2104,49556 + t7 2105,49577 + t3 2107,49631 + t4 2108,49647 + t9 2109,49673 + t5 2113,49766 + t6 2114,49782 + t7 2115,49829 + t8 2119,49950 + t8 2124,50055 + t4 2126,50098 + iPC 2129,50161 + t3 2130,50178 + t9 2131,50193 + iPC 2132,50238 + t3 2139,50429 + *(u32 *)&processor->continuation continuation2140,50445 + iSP 2142,50521 + *(u64 *)&processor->continuationcp continuationcp2143,50538 + t3 2145,50624 + t3 2147,50652 + t4 2148,50673 + t4 2149,50694 + t5 2151,50746 + t8 2153,50821 + t6 2155,50871 + iFP 2157,50948 + *(u32 *)&processor->control control2159,51003 + t3 2161,51073 + t5 2162,51090 + t5 2163,51105 + *(u64 *)&processor->stop_interpreter stop_interpreter2164,51121 + iLP 2166,51201 + arg6 2168,51262 + t4 2175,51440 + arg2 2176,51459 + t1 2179,51552 + iSP 2180,51567 + iCP 2191,51819 + goto INTERPRETINSTRUCTION;2192,51831 + arg5 2196,51920 + arg2 2197,51932 + goto illegaloperand;2198,51945 + goto handleframecleanup;2202,52038 + goto stackcacheunderflowcheck;2206,52139 + *(u32 *)&processor->immediate_arg immediate_arg2223,52577 + arg1 2224,52621 + goto begindotakevalues;2225,52667 + arg1 2232,52798 + goto headdotakevalues;2240,52947 + goto headdotakevalues;2246,53054 + arg1 2255,53242 + arg1 2257,53294 + arg6 2262,53445 + arg1 2264,53522 + arg4 2266,53576 + arg3 2268,53632 + iSP 2270,53679 + arg4 2271,53696 + arg2 2272,53716 + goto NEXTINSTRUCTION;2279,53904 + iSP 2284,54023 + goto NEXTINSTRUCTION;2285,54049 + t4 2290,54173 + t1 2291,54211 + t2 2293,54264 + t1 2295,54354 + t1 2297,54408 + t2 2299,54467 + t4 2300,54489 + iSP 2309,54735 + arg2 2310,54752 + goto NEXTINSTRUCTION;2313,54820 + arg1 2339,55430 + t10 2342,55549 + t3 2344,55579 + t10 2345,55624 + t4 2347,55656 + t2 2348,55695 + t1 2350,55788 + t9 2351,55833 + t1 2353,55922 + t1 2355,55984 + t9 2357,56024 + t1 2358,56040 + iSP 2360,56083 + t11 2361,56100 + t2 2363,56171 + t2 2364,56189 + t1 2366,56235 + t1 2367,56252 + t1 2368,56269 + t2 2370,56302 + t1 2372,56345 + iSP 2376,56444 + t2 2379,56498 + t1 2380,56539 + t2 2381,56586 + t1 2383,56619 + t3 2385,56680 + t1 2386,56699 + iSP 2390,56798 + t1 2394,56867 + *(u32 *)&processor->catchblock catchblock2398,56959 + t1 2399,56998 + t1 2401,57034 + *(u32 *)&processor->control control2402,57051 + goto NEXTINSTRUCTION;2403,57087 + arg1 2420,57499 + goto begindocatchclose;2428,57648 + goto begindocatchclose;2434,57756 + arg1 2444,57985 + t1 2446,58026 + t1 2447,58065 + t3 2449,58124 + t10 2450,58172 + t3 2452,58259 + t10 2454,58299 + arg4 2456,58344 + arg3 2457,58372 + arg4 2458,58401 + t4 2459,58421 + arg6 2461,58492 + arg5 2462,58521 + arg6 2463,58550 + t3 2464,58570 + t5 2465,58587 + t1 2468,58653 + t1 2470,58703 + t1 2476,58814 + t4 2477,58864 + t1 2479,58917 + t2 2480,58933 + t5 2481,58953 + t3 2482,58968 + t4 2484,59009 + t4 2488,59083 + arg5 2489,59123 + arg2 2490,59135 + goto illegaloperand;2491,59148 + t8 2499,59278 + arg1 2500,59326 + t9 2501,59347 + t6 2502,59385 + t7 2503,59404 + t8 2505,59451 + arg2 2506,59467 + t9 2508,59531 + t6 2509,59567 + t7 2510,59586 + arg1 2515,59658 + arg2 2516,59679 + arg1 2517,59707 + t8 2526,59840 + arg1 2527,59888 + t9 2528,59909 + t2 2529,59947 + t3 2530,59966 + t8 2532,60013 + arg2 2533,60029 + t9 2535,60093 + t2 2536,60129 + t3 2537,60148 + arg1 2542,60220 + arg2 2543,60241 + arg1 2544,60269 + t2 2545,60297 + arg1 2554,60418 + t11 2555,60468 + arg2 2556,60488 + t9 2557,60528 + t8 2558,60546 + arg1 2560,60592 + arg2 2562,60630 + t9 2563,60672 + t8 2564,60691 + arg1 2569,60764 + t11 2570,60811 + arg1 2571,60831 + t11 2572,60859 + t9 2578,60948 + t8 2579,60964 + t8 2580,60981 + arg1 2581,60997 + t9 2582,61018 + t11 2583,61037 + arg2 2584,61058 + t11 2585,61096 + t11 2589,61176 + arg2 2590,61196 + arg1 2592,61266 + arg2 2594,61333 + arg1 2596,61371 + *(u32 *)t9 2597,61413 + t3 2604,61537 + t3 2605,61553 + t1 2606,61570 + *(u32 *)&processor->bindingstackpointer bindingstackpointer2608,61602 + t4 2609,61650 + *(u32 *)&processor->control control2610,61666 + t5 2611,61702 + t3 2614,61768 + t4 2615,61809 + t4 2616,61824 + t3 2617,61850 + *(u32 *)&processor->interruptreg interruptreg2618,61866 + *(u64 *)&processor->stop_interpreter stop_interpreter2621,61938 + t1 2629,62098 + t2 2633,62200 + t6 2635,62245 + t2 2637,62337 + *(u32 *)&processor->catchblock catchblock2639,62366 + t3 2641,62433 + t3 2643,62484 + t4 2644,62501 + t5 2646,62567 + t4 2648,62628 + t4 2650,62677 + *(u32 *)&processor->control control2651,62693 + t6 2653,62745 + arg2 2658,62868 + arg1 2659,62890 + arg2 2660,62918 + t8 2662,62988 + t7 2664,63021 + t8 2666,63080 + t10 2668,63138 + t8 2669,63155 + t7 2671,63197 + t8 2672,63213 + t9 2673,63229 + t8 2674,63249 + t7 2675,63266 + iSP 2679,63366 + t4 2681,63418 + *(u32 *)&processor->control control2682,63434 + iPC 2684,63511 + iPC 2685,63529 + iPC 2686,63549 + goto interpretinstructionforjump;2687,63569 + goto dbunwindcatchtrap;2691,63663 + arg1 2695,63731 + arg1 2697,63802 + *(u32 *)arg1 2699,63853 + goto g7175;2702,63931 + arg2 2706,63987 + arg1 2708,64058 + t9 2709,64086 + t8 2711,64137 + goto g7166;2712,64164 + t2 2719,64288 + goto g7165;2720,64304 + arg1 2725,64407 + t11 2728,64495 + *(u64 *)&processor->vma vma2730,64556 + t11 2732,64623 + arg1 2734,64679 + arg1 2738,64739 + arg2 2739,64754 + goto performmemoryaction;2740,64766 + t9 2744,64836 + t8 2746,64905 + t2 2747,64927 + t3 2749,64976 + goto g7156;2750,65001 + t5 2757,65126 + goto g7155;2758,65142 + arg2 2763,65245 + arg1 2766,65332 + *(u64 *)&processor->vma vma2768,65394 + arg1 2770,65461 + arg2 2772,65519 + arg1 2776,65580 + arg2 2777,65595 + goto performmemoryaction;2778,65607 + t9 2782,65677 + t8 2784,65746 + t6 2785,65768 + t7 2787,65817 + goto g7146;2788,65842 + t1 2795,65967 + goto g7145;2796,65983 + arg2 2801,66086 + arg1 2804,66173 + *(u64 *)&processor->vma vma2806,66235 + arg1 2808,66302 + arg2 2810,66360 + arg1 2814,66421 + arg2 2815,66436 + goto performmemoryaction;2816,66448 + goto doistageerror;2821,66515 + +stub/ifunfext.c,5586 + arg1 29,819 + arg2 31,883 + arg1 33,946 + t7 36,1025 + arg3 38,1068 + arg4 39,1096 + arg1 41,1140 + t7 43,1174 + t8 45,1217 + t9 46,1235 + arg4 48,1296 + t4 53,1411 + iPC 54,1439 + t5 56,1524 + iCP 57,1541 + t3 62,1669 + t4 63,1686 + *(u32 *)iSP 64,1706 + goto cachevalid;67,1782 + arg5 71,1853 + arg2 72,1865 + goto illegaloperand;73,1878 + arg1 99,2428 + arg2 101,2492 + arg1 103,2555 + t2 106,2645 + t1 107,2665 + t2 108,2691 + t3 109,2707 + t3 110,2741 + t3 117,2857 + t5 118,2905 + t4 119,2924 + arg4 120,2962 + arg3 121,2981 + t3 123,3028 + t4 125,3062 + arg4 126,3098 + arg3 127,3121 + arg4 132,3195 + t7 136,3238 + arg1 138,3277 + t4 140,3331 + t5 142,3394 + t7 144,3426 + t3 149,3534 + iPC 150,3551 + iCP 151,3601 + t4 152,3647 + *(u32 *)iSP 153,3667 + goto cachevalid;156,3743 + t2 161,3855 + t1 162,3900 + t2 164,3989 + t2 166,4051 + t1 168,4091 + arg5 169,4107 + arg2 170,4120 + goto illegaloperand;171,4133 + t4 175,4198 + t3 177,4267 + arg4 178,4289 + arg3 180,4340 + goto g8201;181,4367 + arg1 207,4938 + arg2 209,5002 + arg1 211,5065 + t2 214,5155 + t1 215,5175 + t2 216,5201 + t3 217,5217 + t3 218,5251 + t3 225,5370 + t5 226,5418 + t4 227,5437 + arg4 228,5475 + arg3 229,5494 + t3 231,5541 + t4 233,5575 + arg4 234,5611 + arg3 235,5634 + t7 243,5731 + arg1 245,5770 + t4 247,5824 + t5 249,5887 + t7 251,5919 + t3 256,6027 + iPC 257,6044 + iCP 258,6094 + t4 259,6140 + *(u32 *)iSP 260,6160 + goto cachevalid;263,6236 + t2 268,6354 + t1 269,6399 + t2 271,6488 + t2 273,6550 + t1 275,6590 + arg5 276,6606 + arg2 277,6619 + goto illegaloperand;278,6632 + t4 282,6697 + t3 284,6766 + arg4 285,6788 + arg3 287,6839 + goto g8210;288,6866 + arg1 314,7395 + arg2 316,7459 + arg1 318,7522 + t6 321,7612 + t5 323,7658 + iSP 325,7703 + t6 326,7720 + arg4 328,7762 + arg3 329,7784 + arg4 330,7812 + t1 332,7869 + arg6 334,7922 + t2 335,7942 + arg5 342,8087 + t7 350,8253 + t7 352,8285 + t5 354,8336 + t3 356,8378 + t5 358,8428 + t4 360,8486 + t6 362,8558 + t6 364,8603 + iPC 365,8619 + iCP 366,8669 + t4 367,8715 + *(u32 *)iSP 368,8735 + goto cachevalid;371,8811 + arg6 383,9023 + arg3 385,9058 + arg1 387,9103 + arg4 389,9142 + goto numericexception;390,9154 + goto g8221;391,9179 + arg6 396,9269 + arg3 398,9306 + arg1 400,9351 + arg4 402,9390 + goto numericexception;403,9402 + arg1 435,10066 + arg2 437,10130 + arg1 439,10193 + t6 442,10283 + t5 444,10329 + iSP 446,10374 + t6 447,10391 + arg4 449,10433 + arg3 450,10455 + arg4 451,10483 + t1 453,10540 + arg6 455,10593 + t2 456,10613 + arg5 463,10764 + t7 471,10930 + t7 473,10962 + t5 475,11013 + t3 477,11055 + t5 479,11105 + t4 481,11163 + t6 483,11235 + t6 485,11280 + iPC 486,11296 + iCP 487,11346 + t4 488,11392 + *(u32 *)iSP 489,11415 + goto cachevalid;492,11491 + arg6 504,11703 + arg3 506,11738 + arg1 508,11783 + arg4 510,11822 + arg5 511,11834 + arg2 512,11846 + goto spareexception;513,11859 + goto g8234;514,11882 + arg5 518,11938 + arg2 519,11950 + goto illegaloperand;520,11963 + arg1 552,12597 + arg2 554,12661 + arg1 556,12724 + t2 559,12814 + t1 561,12860 + iSP 563,12905 + t2 564,12922 + t3 565,12938 + t3 566,12972 + arg4 570,13049 + arg3 572,13097 + iSP 574,13144 + arg4 575,13161 + t3 580,13246 + t1 581,13294 + t4 582,13313 + t6 583,13351 + t8 584,13368 + t3 586,13413 + t4 588,13447 + t6 589,13483 + t8 590,13502 + t6 595,13572 + t6 598,13596 + t1 600,13649 + t10 601,13667 + t7 609,13829 + t7 611,13861 + t5 613,13912 + t3 615,13954 + t5 617,14004 + t4 619,14062 + t6 621,14134 + t6 623,14179 + t4 624,14195 + t3 625,14243 + t10 626,14262 + t5 627,14301 + t1 628,14318 + t4 630,14363 + t10 632,14397 + t4 633,14435 + t1 634,14469 + t1 638,14545 + *(u32 *)t5 640,14578 + goto NEXTINSTRUCTION;644,14652 + goto NEXTINSTRUCTION;645,14676 + arg5 650,14775 + arg2 651,14787 + goto illegaloperand;652,14799 + t2 660,14957 + t1 661,15002 + t2 663,15091 + t2 665,15153 + t1 667,15193 + arg5 668,15209 + arg2 669,15222 + goto illegaloperand;670,15235 + t4 674,15300 + t3 678,15390 + t4 680,15462 + t3 682,15502 + *(u32 *)t3 684,15547 + goto NEXTINSTRUCTION;687,15621 + t4 691,15687 + t3 693,15756 + t6 694,15778 + t8 696,15827 + goto g8245;697,15852 + arg1 723,16423 + arg2 725,16487 + arg1 727,16550 + t2 730,16640 + t1 732,16686 + iSP 734,16731 + t2 735,16748 + t3 736,16764 + t3 737,16798 + arg4 741,16878 + arg3 743,16926 + iSP 745,16973 + arg4 746,16990 + t3 751,17075 + t1 752,17123 + t4 753,17142 + t8 754,17180 + t6 755,17197 + t3 757,17242 + t4 759,17276 + t8 760,17312 + t6 761,17331 + t1 769,17446 + t10 770,17464 + t7 778,17626 + t7 780,17658 + t5 782,17709 + t3 784,17751 + t5 786,17801 + t4 788,17859 + t6 790,17931 + t6 792,17976 + t4 793,17992 + t3 794,18040 + t10 795,18059 + t5 796,18098 + t1 797,18115 + t4 799,18160 + t10 801,18194 + t4 802,18232 + t1 803,18266 + t1 807,18342 + *(u32 *)t5 809,18375 + goto NEXTINSTRUCTION;813,18449 + goto NEXTINSTRUCTION;814,18473 + arg5 819,18572 + arg2 820,18584 + goto illegaloperand;821,18596 + t2 829,18760 + t1 830,18805 + t2 832,18894 + t2 834,18956 + t1 836,18996 + arg5 837,19012 + arg2 838,19025 + goto illegaloperand;839,19038 + t4 843,19103 + t3 847,19193 + t4 849,19265 + t3 851,19305 + *(u32 *)t3 853,19350 + goto NEXTINSTRUCTION;856,19424 + t4 860,19490 + t3 862,19559 + t8 863,19581 + t6 865,19630 + goto g8262;866,19655 + +stub/ifunfull.c,1138 + arg5 15,493 + arg2 16,505 + goto illegaloperand;17,518 + arg5 29,742 + arg2 30,754 + goto illegaloperand;31,767 + arg5 43,1017 + arg2 44,1029 + goto illegaloperand;45,1042 + arg5 57,1284 + arg2 58,1296 + goto illegaloperand;59,1309 + arg5 71,1537 + arg2 72,1549 + goto illegaloperand;73,1562 + arg5 85,1806 + arg2 86,1818 + goto illegaloperand;87,1831 + arg5 99,2091 + arg2 100,2103 + goto illegaloperand;101,2116 + arg5 113,2384 + arg2 114,2396 + goto illegaloperand;115,2409 + arg5 127,2659 + arg2 128,2671 + goto illegaloperand;129,2684 + arg5 141,2940 + arg2 142,2952 + goto illegaloperand;143,2965 + arg5 155,3229 + arg2 156,3241 + goto illegaloperand;157,3254 + arg1 170,3546 + arg5 172,3649 + arg2 173,3661 + goto illegaloperand;174,3674 + arg1 187,3970 + arg5 189,4073 + arg2 190,4085 + goto illegaloperand;191,4098 + arg6 207,4464 + arg5 208,4479 + arg3 210,4521 + goto startcallcompiledmerge;211,4536 + arg1 224,4859 + arg1 226,4911 + arg1 228,4964 + r0 230,5026 + arg2 239,5260 + iPC 240,5311 + iPC 241,5339 + iPC 242,5359 + goto interpretinstructionforbranch;245,5434 + +stub/ifungene.c,645 + arg1 20,677 + goto begindomessagedispatch;28,826 + goto begindomessagedispatch;34,949 + arg1 44,1203 + arg2 45,1231 + arg1 47,1302 + t1 48,1331 + arg5 50,1390 + arg3 52,1445 + arg4 53,1474 + arg5 55,1560 + t1 58,1629 + arg4 59,1645 + r0 60,1665 + goto lookuphandler;61,1691 + arg4 64,1762 + t3 65,1791 + t3 67,1849 + t3 71,1919 + t3 72,1935 + goto g6969;78,2072 + iPC 91,2369 + iPC 92,2385 + iPC 93,2403 + goto interpretinstructionforjump;94,2421 + t2 99,2542 + t3 100,2587 + t2 102,2676 + t2 104,2738 + t3 106,2778 + arg5 107,2794 + arg2 108,2807 + goto illegaloperand;109,2820 + goto doistageerror;114,2887 + +stub/ifuninst.c,22783 + arg1 28,929 + arg5 30,1000 + arg6 32,1090 + arg1 35,1182 + t1 36,1211 + arg1 37,1238 + t4 38,1258 + t4 40,1305 + t9 46,1392 + t2 47,1413 + t1 48,1430 + t7 50,1475 + t10 51,1495 + t8 53,1556 + t2 54,1594 + t1 55,1613 + t9 60,1683 + t10 61,1701 + t9 62,1727 + t2 67,1790 + t5 68,1820 + arg1 72,1927 + arg1 73,1949 + t9 77,2005 + t2 78,2026 + t1 79,2043 + t7 81,2088 + t10 82,2108 + t8 84,2171 + t2 85,2209 + t1 86,2228 + t9 91,2298 + t10 92,2317 + t9 93,2343 + t2 94,2367 + t3 99,2422 + t6 100,2433 + t6 102,2481 + arg1 106,2544 + t6 107,2573 + arg1 108,2600 + t5 109,2620 + t5 111,2680 + t5 115,2758 + t5 117,2804 + arg1 124,2925 + t1 128,2987 + t2 129,3007 + iSP 131,3052 + t1 132,3069 + arg5 133,3085 + arg6 135,3175 + t8 139,3252 + t5 140,3273 + t4 141,3290 + t6 143,3335 + t9 144,3355 + t7 146,3418 + t5 147,3456 + t4 148,3475 + t8 153,3545 + t9 154,3564 + t8 155,3588 + t5 161,3673 + t4 162,3689 + t4 163,3706 + t6 164,3722 + t5 165,3743 + t8 166,3760 + t7 168,3805 + t9 170,3843 + t7 171,3881 + t8 172,3915 + t8 176,3991 + *(u32 *)t5 178,4024 + goto NEXTINSTRUCTION;182,4097 + goto NEXTINSTRUCTION;183,4121 + t1 187,4193 + t1 189,4226 + t1 190,4243 + arg6 192,4295 + arg3 194,4330 + arg1 196,4375 + arg4 198,4414 + goto exception;199,4426 + t6 203,4486 + t7 205,4558 + t6 207,4602 + *(u32 *)t6 209,4647 + goto NEXTINSTRUCTION;212,4721 + t7 216,4787 + t6 218,4856 + t5 219,4878 + t4 221,4927 + goto g7253;222,4952 + arg1 229,5075 + goto g7252;230,5093 + t9 235,5196 + t8 238,5282 + *(u64 *)&processor->vma vma240,5342 + t8 242,5411 + t9 244,5463 + t8 253,5568 + t7 254,5601 + t6 257,5670 + t8 258,5688 + t6 260,5745 + t7 261,5761 + t7 262,5771 + t6 263,5808 + t6 265,5863 + t7 266,5879 + t6 268,5923 + t5 270,5962 + t8 272,6003 + arg1 277,6125 + goto g7252;278,6143 + goto dbcachemisstrap;282,6199 + arg1 287,6268 + arg2 288,6281 + goto performmemoryaction;289,6293 + t8 293,6363 + t7 295,6432 + t2 296,6454 + t1 298,6503 + goto g7241;299,6528 + arg1 306,6651 + goto g7240;307,6669 + t10 312,6772 + t9 315,6858 + *(u64 *)&processor->vma vma317,6918 + t9 319,6987 + t10 321,7040 + t9 325,7102 + t1 328,7169 + t1 329,7187 + goto g7251;330,7230 + t9 339,7330 + t8 340,7364 + t7 343,7433 + t9 344,7451 + t7 346,7508 + t8 347,7524 + t8 348,7534 + t7 349,7571 + t7 351,7626 + t8 352,7642 + t7 354,7686 + t2 356,7725 + t9 358,7766 + arg1 363,7888 + goto g7240;364,7906 + goto dbcachemisstrap;368,7962 + arg1 373,8031 + arg2 374,8045 + goto performmemoryaction;375,8057 + t8 379,8127 + t7 381,8196 + t2 382,8218 + t1 384,8267 + goto g7231;385,8292 + arg1 392,8415 + goto g7230;393,8433 + t10 398,8536 + t9 401,8620 + *(u64 *)&processor->vma vma403,8680 + t9 405,8749 + t10 407,8802 + arg1 411,8860 + arg2 412,8874 + goto performmemoryaction;413,8886 + t5 417,8956 + t9 421,9006 + t2 422,9027 + t1 423,9044 + t7 425,9089 + t10 426,9109 + t8 428,9170 + t2 429,9208 + t1 430,9227 + t9 435,9297 + t10 436,9315 + t9 437,9341 + t2 438,9365 + t5 443,9420 + t6 447,9486 + t6 449,9528 + goto g7228;454,9650 + t8 458,9706 + t7 460,9775 + t2 461,9797 + t1 463,9846 + goto g7266;464,9871 + arg1 471,9994 + goto g7265;472,10012 + t10 477,10115 + t9 480,10199 + *(u64 *)&processor->vma vma482,10259 + t9 484,10328 + t10 486,10381 + arg1 490,10439 + arg2 491,10453 + goto performmemoryaction;492,10465 + arg1 517,11214 + arg5 519,11285 + arg6 521,11375 + arg1 524,11467 + t1 525,11496 + arg1 526,11523 + t4 527,11543 + t4 529,11590 + t9 535,11677 + t2 536,11698 + t1 537,11715 + t7 539,11760 + t10 540,11780 + t8 542,11841 + t2 543,11879 + t1 544,11898 + t9 549,11968 + t10 550,11986 + t9 551,12012 + t2 556,12075 + t5 557,12105 + arg1 561,12212 + arg1 562,12234 + t9 566,12290 + t2 567,12311 + t1 568,12328 + t7 570,12373 + t10 571,12393 + t8 573,12456 + t2 574,12494 + t1 575,12513 + t9 580,12583 + t10 581,12602 + t9 582,12628 + t2 583,12652 + t3 588,12707 + t6 589,12718 + t6 591,12766 + arg1 595,12831 + t6 596,12860 + arg1 597,12887 + t5 598,12907 + t5 600,12967 + t5 604,13045 + t5 606,13091 + arg1 613,13212 + t1 617,13274 + t2 618,13294 + t1 619,13320 + arg5 620,13336 + arg6 622,13426 + t8 626,13503 + t5 627,13524 + t4 628,13541 + t6 630,13586 + t9 631,13606 + t7 633,13669 + t5 634,13707 + t4 635,13726 + t8 640,13796 + t9 641,13815 + t8 642,13839 + t5 648,13924 + t4 649,13940 + t4 650,13957 + t6 651,13973 + t5 652,13994 + t8 653,14011 + t7 655,14056 + t9 657,14094 + t7 658,14132 + t8 659,14166 + t8 663,14242 + *(u32 *)t5 665,14275 + goto NEXTINSTRUCTION;669,14348 + goto NEXTINSTRUCTION;670,14372 + t1 674,14448 + t1 676,14481 + t1 677,14498 + arg6 679,14550 + arg3 681,14585 + arg1 683,14630 + arg4 685,14669 + goto exception;686,14681 + t6 690,14741 + t7 692,14813 + t6 694,14857 + *(u32 *)t6 696,14902 + goto NEXTINSTRUCTION;699,14976 + t7 703,15042 + t6 705,15111 + t5 706,15133 + t4 708,15182 + goto g7301;709,15207 + arg1 716,15330 + goto g7300;717,15348 + t9 722,15451 + t8 725,15537 + *(u64 *)&processor->vma vma727,15597 + t8 729,15666 + t9 731,15718 + t8 740,15823 + t7 741,15856 + t6 744,15925 + t8 745,15943 + t6 747,16000 + t7 748,16016 + t7 749,16026 + t6 750,16063 + t6 752,16118 + t7 753,16134 + t6 755,16178 + t5 757,16217 + t8 759,16258 + arg1 764,16380 + goto g7300;765,16398 + goto dbcachemisstrap;769,16454 + arg1 774,16523 + arg2 775,16536 + goto performmemoryaction;776,16548 + t8 780,16618 + t7 782,16687 + t2 783,16709 + t1 785,16758 + goto g7289;786,16783 + arg1 793,16906 + goto g7288;794,16924 + t10 799,17027 + t9 802,17113 + *(u64 *)&processor->vma vma804,17173 + t9 806,17242 + t10 808,17295 + t9 812,17357 + t1 815,17424 + t1 816,17442 + goto g7299;817,17485 + t9 826,17585 + t8 827,17619 + t7 830,17688 + t9 831,17706 + t7 833,17763 + t8 834,17779 + t8 835,17789 + t7 836,17826 + t7 838,17881 + t8 839,17897 + t7 841,17941 + t2 843,17980 + t9 845,18021 + arg1 850,18143 + goto g7288;851,18161 + goto dbcachemisstrap;855,18217 + arg1 860,18286 + arg2 861,18300 + goto performmemoryaction;862,18312 + t8 866,18382 + t7 868,18451 + t2 869,18473 + t1 871,18522 + goto g7279;872,18547 + arg1 879,18670 + goto g7278;880,18688 + t10 885,18791 + t9 888,18875 + *(u64 *)&processor->vma vma890,18935 + t9 892,19004 + t10 894,19057 + arg1 898,19115 + arg2 899,19129 + goto performmemoryaction;900,19141 + t5 904,19211 + t9 908,19261 + t2 909,19282 + t1 910,19299 + t7 912,19344 + t10 913,19364 + t8 915,19425 + t2 916,19463 + t1 917,19482 + t9 922,19552 + t10 923,19570 + t9 924,19596 + t2 925,19620 + t5 930,19675 + t6 934,19741 + t6 936,19783 + goto g7276;941,19905 + t8 945,19961 + t7 947,20030 + t2 948,20052 + t1 950,20101 + goto g7314;951,20126 + arg1 958,20249 + goto g7313;959,20267 + t10 964,20370 + t9 967,20454 + *(u64 *)&processor->vma vma969,20514 + t9 971,20583 + t10 973,20636 + arg1 977,20694 + arg2 978,20708 + goto performmemoryaction;979,20720 + arg1 1004,21545 + arg5 1006,21616 + arg6 1008,21706 + arg1 1011,21798 + t1 1012,21827 + arg1 1013,21854 + t4 1014,21874 + t4 1016,21921 + t9 1022,22008 + t2 1023,22029 + t1 1024,22046 + t7 1026,22091 + t10 1027,22111 + t8 1029,22172 + t2 1030,22210 + t1 1031,22229 + t9 1036,22299 + t10 1037,22317 + t9 1038,22343 + t2 1043,22406 + t5 1044,22436 + arg1 1048,22543 + arg1 1049,22565 + t9 1053,22621 + t2 1054,22642 + t1 1055,22659 + t7 1057,22704 + t10 1058,22724 + t8 1060,22787 + t2 1061,22825 + t1 1062,22844 + t9 1067,22914 + t10 1068,22933 + t9 1069,22959 + t2 1070,22983 + t3 1075,23038 + t6 1076,23049 + t6 1078,23097 + arg1 1082,23163 + t6 1083,23192 + arg1 1084,23219 + t5 1085,23239 + t5 1087,23299 + t5 1091,23377 + t5 1093,23423 + arg1 1100,23544 + t7 1104,23606 + iSP 1108,23713 + goto NEXTINSTRUCTION;1109,23730 + t1 1113,23808 + t1 1115,23841 + t1 1116,23858 + arg6 1118,23910 + arg3 1120,23945 + arg1 1122,23990 + arg4 1124,24029 + goto exception;1125,24041 + t8 1129,24101 + t7 1131,24170 + t2 1132,24192 + t1 1134,24241 + goto g7337;1135,24266 + arg1 1142,24389 + goto g7336;1143,24407 + t10 1148,24510 + t9 1151,24596 + *(u64 *)&processor->vma vma1153,24656 + t9 1155,24725 + t10 1157,24778 + t9 1161,24840 + t1 1164,24907 + t1 1165,24925 + goto g7347;1166,24968 + t9 1175,25068 + t8 1176,25102 + t7 1179,25171 + t9 1180,25189 + t7 1182,25246 + t8 1183,25262 + t8 1184,25272 + t7 1185,25309 + t7 1187,25364 + t8 1188,25380 + t7 1190,25424 + t2 1192,25463 + t9 1194,25504 + arg1 1199,25626 + goto g7336;1200,25644 + goto dbcachemisstrap;1204,25700 + arg1 1209,25769 + arg2 1210,25783 + goto performmemoryaction;1211,25795 + t8 1215,25865 + t7 1217,25934 + t2 1218,25956 + t1 1220,26005 + goto g7327;1221,26030 + arg1 1228,26153 + goto g7326;1229,26171 + t10 1234,26274 + t9 1237,26358 + *(u64 *)&processor->vma vma1239,26418 + t9 1241,26487 + t10 1243,26540 + arg1 1247,26598 + arg2 1248,26612 + goto performmemoryaction;1249,26624 + t5 1253,26694 + t9 1257,26744 + t2 1258,26765 + t1 1259,26782 + t7 1261,26827 + t10 1262,26847 + t8 1264,26908 + t2 1265,26946 + t1 1266,26965 + t9 1271,27035 + t10 1272,27053 + t9 1273,27079 + t2 1274,27103 + t5 1279,27158 + t6 1283,27224 + t6 1285,27266 + goto g7324;1290,27388 + t8 1294,27444 + t7 1296,27513 + t2 1297,27535 + t1 1299,27584 + goto g7349;1300,27609 + arg1 1307,27732 + goto g7348;1308,27750 + t10 1313,27853 + t9 1316,27937 + *(u64 *)&processor->vma vma1318,27997 + t9 1320,28066 + t10 1322,28119 + arg1 1326,28177 + arg2 1327,28191 + goto performmemoryaction;1328,28203 + arg1 1353,29040 + arg5 1355,29111 + arg6 1357,29201 + t2 1360,29296 + t1 1361,29323 + t2 1362,29350 + t3 1363,29366 + t3 1365,29426 + arg1 1368,29477 + t6 1372,29534 + t1 1373,29555 + t2 1374,29572 + t4 1376,29617 + t7 1377,29637 + t5 1379,29699 + t1 1380,29737 + t2 1381,29756 + t6 1386,29826 + t7 1387,29845 + t6 1388,29869 + iPC 1393,29931 + iCP 1394,29981 + t7 1396,30048 + iSP 1400,30147 + goto cachevalid;1401,30164 + t5 1405,30225 + t4 1407,30294 + t1 1408,30316 + t2 1410,30365 + goto g7359;1411,30390 + arg1 1418,30513 + goto g7358;1419,30531 + t7 1424,30634 + t6 1427,30719 + *(u64 *)&processor->vma vma1429,30779 + t6 1431,30848 + t7 1433,30900 + t6 1437,30961 + t2 1440,31027 + t2 1441,31045 + goto g7369;1442,31088 + t6 1451,31188 + t5 1452,31221 + t4 1455,31290 + t6 1456,31308 + t4 1458,31365 + t5 1459,31381 + t5 1460,31391 + t4 1461,31428 + t4 1463,31483 + t5 1464,31499 + t4 1466,31543 + t1 1468,31582 + t6 1470,31623 + arg1 1475,31745 + goto g7358;1476,31763 + goto dbcachemisstrap;1480,31819 + arg1 1485,31888 + arg2 1486,31901 + goto performmemoryaction;1487,31913 + arg1 1512,32738 + arg5 1514,32809 + arg6 1516,32899 + t2 1519,32994 + t1 1520,33021 + t2 1521,33048 + t3 1522,33064 + t3 1524,33124 + arg1 1527,33175 + t1 1528,33195 + t2 1529,33215 + iSP 1531,33260 + t1 1532,33277 + t8 1536,33330 + t5 1537,33351 + t4 1538,33368 + t6 1540,33413 + t9 1541,33433 + t7 1543,33496 + t5 1544,33534 + t4 1545,33553 + t8 1550,33623 + t9 1551,33642 + t8 1552,33666 + t5 1558,33751 + t4 1559,33767 + t4 1560,33784 + t6 1561,33800 + t5 1562,33821 + t8 1563,33838 + t7 1565,33883 + t9 1567,33921 + t7 1568,33959 + t8 1569,33993 + t8 1573,34069 + *(u32 *)t5 1575,34102 + goto NEXTINSTRUCTION;1579,34175 + goto NEXTINSTRUCTION;1580,34199 + t6 1584,34265 + t7 1586,34337 + t6 1588,34381 + *(u32 *)t6 1590,34426 + goto NEXTINSTRUCTION;1593,34500 + t7 1597,34566 + t6 1599,34635 + t5 1600,34657 + t4 1602,34706 + goto g7371;1603,34731 + arg1 1610,34854 + goto g7370;1611,34872 + t9 1616,34975 + t8 1619,35061 + *(u64 *)&processor->vma vma1621,35121 + t8 1623,35190 + t9 1625,35242 + t8 1634,35347 + t7 1635,35380 + t6 1638,35449 + t8 1639,35467 + t6 1641,35524 + t7 1642,35540 + t7 1643,35550 + t6 1644,35587 + t6 1646,35642 + t7 1647,35658 + t6 1649,35702 + t5 1651,35741 + t8 1653,35782 + arg1 1658,35904 + goto g7370;1659,35922 + goto dbcachemisstrap;1663,35978 + arg1 1668,36047 + arg2 1669,36060 + goto performmemoryaction;1670,36072 + arg1 1695,36919 + arg5 1697,36990 + arg6 1699,37080 + t2 1702,37175 + t1 1703,37202 + t2 1704,37229 + t3 1705,37245 + t3 1707,37305 + arg1 1710,37356 + t1 1711,37376 + t2 1712,37396 + t1 1713,37422 + t8 1717,37475 + t5 1718,37496 + t4 1719,37513 + t6 1721,37558 + t9 1722,37578 + t7 1724,37641 + t5 1725,37679 + t4 1726,37698 + t8 1731,37768 + t9 1732,37787 + t8 1733,37811 + t5 1739,37896 + t4 1740,37912 + t4 1741,37929 + t6 1742,37945 + t5 1743,37966 + t8 1744,37983 + t7 1746,38028 + t9 1748,38066 + t7 1749,38104 + t8 1750,38138 + t8 1754,38214 + *(u32 *)t5 1756,38247 + goto NEXTINSTRUCTION;1760,38320 + goto NEXTINSTRUCTION;1761,38344 + t6 1765,38410 + t7 1767,38482 + t6 1769,38526 + *(u32 *)t6 1771,38571 + goto NEXTINSTRUCTION;1774,38645 + t7 1778,38711 + t6 1780,38780 + t5 1781,38802 + t4 1783,38851 + goto g7384;1784,38876 + arg1 1791,38999 + goto g7383;1792,39017 + t9 1797,39120 + t8 1800,39206 + *(u64 *)&processor->vma vma1802,39266 + t8 1804,39335 + t9 1806,39387 + t8 1815,39492 + t7 1816,39525 + t6 1819,39594 + t8 1820,39612 + t6 1822,39669 + t7 1823,39685 + t7 1824,39695 + t6 1825,39732 + t6 1827,39787 + t7 1828,39803 + t6 1830,39847 + t5 1832,39886 + t8 1834,39927 + arg1 1839,40049 + goto g7383;1840,40067 + goto dbcachemisstrap;1844,40123 + arg1 1849,40192 + arg2 1850,40205 + goto performmemoryaction;1851,40217 + arg1 1876,41140 + t2 1880,41266 + t1 1881,41293 + t2 1882,41320 + t3 1883,41336 + t3 1885,41396 + arg1 1888,41447 + t7 1889,41467 + iSP 1893,41574 + goto NEXTINSTRUCTION;1894,41591 + arg5 1898,41663 + arg2 1899,41675 + goto illegaloperand;1900,41688 + arg5 1904,41763 + arg2 1905,41775 + goto illegaloperand;1906,41788 + arg5 1910,41861 + arg2 1911,41873 + goto illegaloperand;1912,41886 + *(u32 *)&processor->immediate_arg immediate_arg1929,42364 + arg1 1930,42408 + goto begindoinstanceref;1931,42454 + arg1 1938,42588 + goto headdoinstanceref;1946,42737 + goto headdoinstanceref;1952,42847 + arg1 1961,43040 + arg1 1963,43092 + arg4 1968,43245 + arg3 1969,43267 + arg4 1970,43295 + arg2 1971,43315 + arg1 1972,43336 + t11 1973,43356 + t12 1975,43445 + t1 1977,43527 + t1 1979,43589 + t1 1982,43643 + t1 1984,43693 + t7 1990,43786 + t1 1991,43807 + t2 1992,43824 + t5 1994,43869 + t8 1995,43888 + t6 1997,43948 + t1 1998,43985 + t2 1999,44004 + t7 2004,44074 + t8 2005,44092 + t7 2006,44116 + t1 2007,44140 + t1 2012,44194 + t7 2016,44246 + t2 2017,44265 + t4 2018,44282 + t5 2020,44327 + t8 2021,44344 + t6 2023,44406 + t2 2024,44443 + t4 2025,44462 + t7 2030,44532 + t8 2031,44551 + t7 2032,44575 + t5 2037,44637 + t5 2039,44685 + t4 2045,44811 + arg5 2049,44909 + t4 2054,44996 + t6 2055,45044 + t5 2056,45065 + t1 2057,45103 + t2 2058,45120 + t4 2060,45165 + t7 2061,45183 + t5 2063,45245 + t1 2064,45281 + t2 2065,45300 + t6 2070,45370 + t7 2071,45389 + t6 2072,45413 + t2 2078,45496 + iPC 2079,45512 + iCP 2080,45562 + *(u32 *)iSP 2081,45608 + goto cachevalid;2084,45684 + t5 2088,45745 + t4 2090,45814 + t1 2091,45836 + t2 2093,45885 + goto g7419;2094,45910 + arg5 2101,46033 + goto g7418;2102,46051 + t7 2107,46154 + t6 2110,46239 + *(u64 *)&processor->vma vma2112,46299 + t6 2114,46368 + t7 2116,46420 + t6 2120,46481 + t2 2123,46547 + t2 2124,46565 + goto g7429;2125,46608 + t6 2134,46708 + t5 2135,46741 + t4 2138,46810 + t6 2139,46828 + t4 2141,46885 + t5 2142,46901 + t5 2143,46911 + t4 2144,46948 + t4 2146,47003 + t5 2147,47019 + t4 2149,47063 + t1 2151,47102 + t6 2153,47143 + arg5 2158,47265 + goto g7418;2159,47283 + goto dbcachemisstrap;2163,47339 + arg1 2168,47408 + arg2 2169,47421 + goto performmemoryaction;2170,47433 + t6 2174,47503 + t5 2176,47572 + t2 2177,47594 + t4 2179,47643 + goto g7407;2180,47668 + t1 2187,47791 + goto g7406;2188,47807 + t8 2193,47910 + t7 2196,47995 + *(u64 *)&processor->vma vma2198,48055 + t7 2200,48122 + t8 2202,48174 + t7 2206,48235 + t4 2209,48301 + t4 2210,48319 + goto g7417;2211,48362 + t7 2220,48462 + t6 2221,48495 + t5 2224,48564 + t7 2225,48580 + t5 2227,48637 + t6 2228,48653 + t6 2229,48663 + t5 2230,48700 + t5 2232,48755 + t6 2233,48771 + t5 2235,48815 + t2 2237,48854 + t7 2239,48895 + t1 2244,49015 + goto g7406;2245,49031 + goto dbcachemisstrap;2249,49087 + arg1 2254,49156 + arg2 2255,49169 + goto performmemoryaction;2256,49181 + t6 2260,49251 + t5 2262,49320 + t1 2263,49342 + t2 2265,49391 + goto g7397;2266,49416 + arg4 2273,49539 + goto g7396;2274,49557 + t8 2279,49660 + t7 2282,49743 + *(u64 *)&processor->vma vma2284,49803 + t7 2286,49872 + t8 2288,49924 + arg1 2292,49981 + arg2 2293,49994 + goto performmemoryaction;2294,50006 + *(u32 *)&processor->immediate_arg immediate_arg2311,50443 + arg1 2312,50487 + goto begindoinstanceset;2313,50533 + arg1 2320,50667 + goto headdoinstanceset;2328,50816 + goto headdoinstanceset;2334,50926 + arg1 2343,51119 + arg1 2345,51171 + arg4 2350,51324 + arg3 2351,51346 + iSP 2353,51393 + arg4 2354,51410 + arg2 2355,51430 + arg1 2356,51451 + t11 2357,51471 + t12 2359,51560 + t1 2361,51642 + t1 2363,51704 + t1 2366,51759 + t1 2368,51809 + t7 2374,51902 + t1 2375,51923 + t2 2376,51940 + t5 2378,51985 + t8 2379,52004 + t6 2381,52064 + t1 2382,52101 + t2 2383,52120 + t7 2388,52190 + t8 2389,52208 + t7 2390,52232 + t1 2391,52256 + t1 2396,52310 + t7 2400,52362 + t2 2401,52381 + t4 2402,52398 + t5 2404,52443 + t8 2405,52460 + t6 2407,52522 + t2 2408,52559 + t4 2409,52578 + t7 2414,52648 + t8 2415,52667 + t7 2416,52691 + t5 2421,52753 + t5 2423,52801 + t4 2429,52927 + arg5 2433,53025 + t1 2434,53047 + t2 2435,53067 + iSP 2437,53112 + t1 2438,53129 + t11 2439,53145 + t12 2441,53234 + t7 2445,53310 + t4 2446,53331 + t3 2447,53348 + t5 2449,53393 + t8 2450,53412 + t6 2452,53475 + t4 2453,53512 + t3 2454,53531 + t7 2459,53601 + t8 2460,53620 + t7 2461,53644 + t4 2467,53729 + t3 2468,53745 + t3 2469,53762 + t5 2470,53778 + t4 2471,53799 + t7 2472,53816 + t6 2474,53861 + t8 2476,53898 + t6 2477,53935 + t7 2478,53969 + t7 2482,54045 + *(u32 *)t4 2484,54078 + goto NEXTINSTRUCTION;2488,54151 + goto NEXTINSTRUCTION;2489,54175 + arg5 2493,54257 + arg2 2494,54269 + goto illegaloperand;2495,54281 + t5 2499,54346 + t6 2501,54418 + t5 2503,54461 + *(u32 *)t5 2505,54506 + goto NEXTINSTRUCTION;2508,54580 + t6 2512,54646 + t5 2514,54715 + t4 2515,54737 + t3 2517,54786 + goto g7453;2518,54811 + arg5 2525,54934 + goto g7452;2526,54952 + t8 2531,55055 + t7 2534,55141 + *(u64 *)&processor->vma vma2536,55201 + t7 2538,55270 + t8 2540,55322 + t7 2549,55427 + t6 2550,55460 + t5 2553,55529 + t7 2554,55547 + t5 2556,55604 + t6 2557,55620 + t6 2558,55630 + t5 2559,55667 + t5 2561,55722 + t6 2562,55738 + t5 2564,55782 + t4 2566,55821 + t7 2568,55862 + arg5 2573,55984 + goto g7452;2574,56002 + goto dbcachemisstrap;2578,56058 + arg1 2583,56127 + arg2 2584,56140 + goto performmemoryaction;2585,56152 + t6 2589,56222 + t5 2591,56291 + t2 2592,56313 + t4 2594,56362 + goto g7441;2595,56387 + t1 2602,56510 + goto g7440;2603,56526 + t8 2608,56629 + t7 2611,56714 + *(u64 *)&processor->vma vma2613,56774 + t7 2615,56841 + t8 2617,56893 + t7 2621,56954 + t4 2624,57020 + t4 2625,57038 + goto g7451;2626,57081 + t7 2635,57181 + t6 2636,57214 + t5 2639,57283 + t7 2640,57299 + t5 2642,57356 + t6 2643,57372 + t6 2644,57382 + t5 2645,57419 + t5 2647,57474 + t6 2648,57490 + t5 2650,57534 + t2 2652,57573 + t7 2654,57614 + t1 2659,57734 + goto g7440;2660,57750 + goto dbcachemisstrap;2664,57806 + arg1 2669,57875 + arg2 2670,57888 + goto performmemoryaction;2671,57900 + t6 2675,57970 + t5 2677,58039 + t1 2678,58061 + t2 2680,58110 + goto g7431;2681,58135 + arg4 2688,58258 + goto g7430;2689,58276 + t8 2694,58379 + t7 2697,58462 + *(u64 *)&processor->vma vma2699,58522 + t7 2701,58591 + t8 2703,58643 + arg1 2707,58700 + arg2 2708,58713 + goto performmemoryaction;2709,58725 + *(u32 *)&processor->immediate_arg immediate_arg2726,59162 + arg1 2727,59206 + goto begindoinstanceloc;2728,59252 + arg1 2735,59386 + goto headdoinstanceloc;2743,59535 + goto headdoinstanceloc;2749,59645 + arg1 2758,59838 + arg1 2760,59890 + arg4 2765,60043 + arg3 2766,60065 + arg4 2767,60093 + arg2 2768,60113 + arg1 2769,60134 + t11 2770,60154 + t12 2772,60243 + t1 2774,60325 + t1 2776,60387 + t1 2779,60441 + t1 2781,60491 + t7 2787,60584 + t1 2788,60605 + t2 2789,60622 + t5 2791,60667 + t8 2792,60686 + t6 2794,60746 + t1 2795,60783 + t2 2796,60802 + t7 2801,60872 + t8 2802,60890 + t7 2803,60914 + t1 2804,60938 + t1 2809,60992 + t7 2813,61044 + t2 2814,61063 + t4 2815,61080 + t5 2817,61125 + t8 2818,61142 + t6 2820,61204 + t2 2821,61241 + t4 2822,61260 + t7 2827,61330 + t8 2828,61349 + t7 2829,61373 + t5 2834,61435 + t5 2836,61483 + t4 2842,61609 + arg5 2846,61707 + t7 2847,61729 + *(u32 *)iSP 2848,61751 + goto NEXTINSTRUCTION;2851,61829 + arg5 2855,61909 + arg2 2856,61921 + goto illegaloperand;2857,61933 + arg5 2861,62016 + arg2 2862,62028 + goto illegaloperand;2863,62041 + t6 2867,62106 + t5 2869,62175 + t2 2870,62197 + t4 2872,62246 + goto g7476;2873,62271 + t1 2880,62394 + goto g7475;2881,62410 + t8 2886,62513 + t7 2889,62598 + *(u64 *)&processor->vma vma2891,62658 + t7 2893,62725 + t8 2895,62777 + t7 2899,62838 + t4 2902,62904 + t4 2903,62922 + goto g7486;2904,62965 + t7 2913,63065 + t6 2914,63098 + t5 2917,63167 + t7 2918,63183 + t5 2920,63240 + t6 2921,63256 + t6 2922,63266 + t5 2923,63303 + t5 2925,63358 + t6 2926,63374 + t5 2928,63418 + t2 2930,63457 + t7 2932,63498 + t1 2937,63618 + goto g7475;2938,63634 + goto dbcachemisstrap;2942,63690 + arg1 2947,63759 + arg2 2948,63772 + goto performmemoryaction;2949,63784 + t6 2953,63854 + t5 2955,63923 + t1 2956,63945 + t2 2958,63994 + goto g7466;2959,64019 + arg4 2966,64142 + goto g7465;2967,64160 + t8 2972,64263 + t7 2975,64346 + *(u64 *)&processor->vma vma2977,64406 + t7 2979,64475 + t8 2981,64527 + arg1 2985,64584 + arg2 2986,64597 + goto performmemoryaction;2987,64609 + +stub/ifunjosh.c,4615 + arg2 21,702 + arg2 26,796 + *(u32 *)&processor->immediate_arg immediate_arg27,822 + arg1 28,866 + goto begindodereference;29,912 + arg1 36,1046 + goto headdodereference;44,1195 + goto headdodereference;50,1305 + arg1 59,1498 + arg1 61,1550 + arg2 66,1699 + arg1 67,1720 + t1 69,1777 + t2 70,1795 + t2 76,1909 + t2 82,2026 + t2 88,2142 + t5 102,2485 + t7 103,2533 + t6 104,2554 + t3 105,2592 + t4 106,2609 + t5 108,2654 + t8 109,2672 + t6 111,2734 + t3 112,2770 + t4 113,2789 + t7 118,2859 + t8 119,2878 + t7 120,2902 + t5 126,2985 + iSP 130,3084 + goto NEXTINSTRUCTION;131,3101 + t2 135,3167 + t5 142,3326 + iSP 146,3449 + goto NEXTINSTRUCTION;147,3466 + t5 153,3586 + iSP 157,3689 + goto NEXTINSTRUCTION;158,3706 + t6 165,3814 + t5 167,3883 + t3 168,3905 + t4 170,3954 + goto g8910;171,3979 + arg1 178,4102 + goto g8909;179,4120 + t8 184,4223 + t7 187,4308 + *(u64 *)&processor->vma vma189,4368 + t7 191,4437 + t8 193,4489 + t7 197,4550 + t4 200,4616 + t4 201,4634 + goto g8920;202,4677 + t7 211,4777 + t6 212,4810 + t5 215,4879 + t7 216,4897 + t5 218,4954 + t6 219,4970 + t6 220,4980 + t5 221,5017 + t5 223,5072 + t6 224,5088 + t5 226,5132 + t3 228,5171 + t7 230,5212 + arg1 235,5334 + goto g8909;236,5352 + goto dbcachemisstrap;240,5408 + arg1 245,5477 + arg2 246,5490 + goto performmemoryaction;247,5502 + arg2 265,5959 + arg2 270,6053 + *(u32 *)&processor->immediate_arg immediate_arg271,6079 + arg1 272,6123 + goto begindounify;273,6169 + arg1 280,6285 + goto headdounify;288,6434 + goto headdounify;294,6526 + arg1 303,6689 + arg1 305,6741 + arg5 311,6929 + arg2 312,6941 + goto illegaloperand;313,6954 + goto NEXTINSTRUCTION;314,6977 + *(u32 *)&processor->immediate_arg immediate_arg331,7470 + arg1 332,7514 + goto begindopushlocallogicvariables;333,7560 + arg1 340,7730 + goto headdopushlocallogicvariables;348,7879 + goto headdopushlocallogicvariables;354,8025 + arg1 363,8278 + arg1 365,8330 + arg6 370,8507 + t1 371,8536 + arg2 372,8555 + t2 373,8575 + t2 375,8623 + t4 379,8716 + t1 380,8754 + t2 382,8807 + t1 384,8897 + t1 386,8951 + t2 388,9010 + t4 389,9032 + goto pllvloopend;393,9167 + iSP 400,9327 + arg2 404,9398 + goto NEXTINSTRUCTION;408,9493 + arg5 412,9567 + arg2 413,9579 + goto illegaloperand;414,9592 + arg2 432,10176 + arg2 437,10270 + *(u32 *)&processor->immediate_arg immediate_arg438,10296 + arg1 439,10340 + goto begindopushgloballogicvariable;440,10386 + arg1 447,10556 + goto headdopushgloballogicvariable;455,10705 + goto headdopushgloballogicvariable;461,10851 + arg1 470,11104 + arg1 472,11156 + t1 478,11369 + t3 479,11402 + iSP 483,11523 + t6 488,11605 + t8 489,11653 + t7 490,11672 + t5 491,11710 + t4 492,11727 + t6 494,11772 + t9 495,11788 + t7 497,11851 + t5 498,11887 + t4 499,11906 + t8 504,11976 + t9 505,11995 + t8 506,12019 + t5 512,12104 + t4 513,12120 + t4 514,12137 + t7 515,12153 + t6 516,12201 + t9 517,12220 + t5 518,12258 + t8 519,12275 + t7 521,12320 + t9 523,12354 + t7 524,12390 + t8 525,12424 + t8 529,12500 + *(u32 *)t5 531,12533 + t2 538,12660 + *(u32 *)&processor->bar2 bar2540,12715 + goto NEXTINSTRUCTION;541,12748 + t7 545,12814 + t6 549,12904 + t7 551,12976 + t6 553,13016 + *(u32 *)t6 555,13061 + goto g8944;558,13135 + t7 562,13191 + t6 564,13260 + t5 565,13282 + t4 567,13331 + goto g8934;568,13356 + t1 575,13479 + goto g8933;576,13495 + t9 581,13598 + t8 584,13684 + *(u64 *)&processor->vma vma586,13744 + t8 588,13811 + t9 590,13863 + t8 599,13968 + t7 600,14001 + t6 603,14070 + t8 604,14086 + t6 606,14143 + t7 607,14159 + t7 608,14169 + t6 609,14206 + t6 611,14261 + t7 612,14277 + t6 614,14321 + t5 616,14360 + t8 618,14401 + t1 623,14521 + goto g8933;624,14537 + goto dbcachemisstrap;628,14593 + arg1 633,14662 + arg2 634,14675 + goto performmemoryaction;635,14687 + arg2 653,15216 + arg2 658,15310 + *(u32 *)&processor->immediate_arg immediate_arg659,15336 + arg1 660,15380 + goto begindologictailtest;661,15426 + arg1 668,15566 + goto headdologictailtest;676,15715 + goto headdologictailtest;682,15831 + arg1 691,16034 + arg1 693,16086 + arg2 698,16239 + t1 700,16297 + t2 701,16315 + t3 708,16456 + iSP 711,16545 + goto NEXTINSTRUCTION;712,16562 + t2 716,16628 + t3 723,16809 + iSP 726,16896 + goto NEXTINSTRUCTION;727,16913 + t2 731,16979 + t3 738,17136 + iSP 741,17225 + goto NEXTINSTRUCTION;742,17242 + arg6 748,17375 + arg3 750,17410 + arg1 752,17455 + arg4 754,17494 + goto exception;755,17506 + +stub/ifunlexi.c,4321 + arg1 20,668 + goto begindopushlexicalvarn;28,817 + goto begindopushlexicalvarn;34,940 + arg1 44,1194 + t4 46,1250 + t1 47,1269 + t2 48,1290 + t4 50,1352 + t1 51,1367 + t3 53,1400 + t3 54,1416 + t3 55,1439 + t1 57,1509 + arg5 60,1564 + arg6 62,1654 + t6 66,1731 + t3 67,1750 + t2 68,1767 + t4 70,1812 + t7 71,1830 + t5 73,1892 + t3 74,1930 + t2 75,1949 + t6 80,2019 + t7 81,2038 + t6 82,2062 + iPC 87,2124 + iCP 88,2174 + t4 90,2241 + iSP 94,2340 + goto cachevalid;95,2357 + arg5 99,2434 + arg2 100,2446 + goto illegaloperand;101,2459 + t5 105,2524 + t4 107,2593 + t3 108,2615 + t2 110,2664 + goto g8279;111,2689 + t1 118,2812 + goto g8278;119,2828 + t7 124,2931 + t6 127,3016 + *(u64 *)&processor->vma vma129,3076 + t6 131,3143 + t7 133,3195 + t6 137,3256 + t2 140,3322 + t2 141,3340 + goto g8289;142,3383 + t6 151,3483 + t5 152,3516 + t4 155,3585 + t6 156,3601 + t4 158,3658 + t5 159,3674 + t5 160,3684 + t4 161,3721 + t4 163,3776 + t5 164,3792 + t4 166,3836 + t3 168,3875 + t6 170,3916 + t1 175,4036 + goto g8278;176,4052 + goto dbcachemisstrap;180,4108 + arg1 185,4177 + arg2 186,4190 + goto performmemoryaction;187,4202 + goto doistageerror;192,4274 + arg1 209,4720 + goto begindopoplexicalvarn;217,4869 + goto begindopoplexicalvarn;223,4989 + arg1 233,5238 + t4 235,5294 + t1 236,5313 + t2 237,5334 + t4 239,5396 + t1 240,5411 + t3 242,5444 + t3 243,5460 + t3 244,5483 + t1 246,5553 + t3 249,5607 + t2 250,5627 + iSP 252,5672 + t3 253,5689 + arg5 254,5705 + arg6 256,5795 + t8 260,5872 + t5 261,5891 + t4 262,5908 + t6 264,5953 + t9 265,5971 + t7 267,6034 + t5 268,6072 + t4 269,6091 + t8 274,6161 + t9 275,6180 + t8 276,6204 + t5 282,6289 + t4 283,6305 + t4 284,6322 + t6 285,6338 + t5 286,6357 + t8 287,6374 + t7 289,6419 + t9 291,6455 + t7 292,6493 + t8 293,6527 + t8 297,6603 + *(u32 *)t5 299,6636 + goto NEXTINSTRUCTION;303,6709 + goto NEXTINSTRUCTION;304,6733 + arg5 308,6813 + arg2 309,6825 + goto illegaloperand;310,6838 + t6 314,6903 + t7 316,6975 + t6 318,7017 + *(u32 *)t6 320,7062 + goto NEXTINSTRUCTION;323,7136 + t7 327,7202 + t6 329,7271 + t5 330,7293 + t4 332,7342 + goto g8291;333,7367 + t1 340,7490 + goto g8290;341,7506 + t9 346,7609 + t8 349,7695 + *(u64 *)&processor->vma vma351,7755 + t8 353,7822 + t9 355,7874 + t8 364,7979 + t7 365,8012 + t6 368,8081 + t8 369,8097 + t6 371,8154 + t7 372,8170 + t7 373,8180 + t6 374,8217 + t6 376,8272 + t7 377,8288 + t6 379,8332 + t5 381,8371 + t8 383,8412 + t1 388,8532 + goto g8290;389,8548 + goto dbcachemisstrap;393,8604 + arg1 398,8673 + arg2 399,8686 + goto performmemoryaction;400,8698 + goto doistageerror;405,8769 + arg1 422,9225 + goto begindomovemlexicalvarn;430,9374 + goto begindomovemlexicalvarn;436,9500 + arg1 446,9759 + t4 448,9815 + t1 449,9834 + t2 450,9855 + t4 452,9917 + t1 453,9932 + t3 455,9965 + t3 456,9981 + t3 457,10004 + t1 459,10074 + t3 462,10130 + t2 463,10150 + t3 464,10176 + arg5 465,10192 + arg6 467,10282 + t8 471,10359 + t5 472,10378 + t4 473,10395 + t6 475,10440 + t9 476,10458 + t7 478,10521 + t5 479,10559 + t4 480,10578 + t8 485,10648 + t9 486,10667 + t8 487,10691 + t5 493,10776 + t4 494,10792 + t4 495,10809 + t6 496,10825 + t5 497,10844 + t8 498,10861 + t7 500,10906 + t9 502,10942 + t7 503,10980 + t8 504,11014 + t8 508,11090 + *(u32 *)t5 510,11123 + goto NEXTINSTRUCTION;514,11196 + goto NEXTINSTRUCTION;515,11220 + arg5 519,11304 + arg2 520,11316 + goto illegaloperand;521,11329 + t6 525,11394 + t7 527,11466 + t6 529,11508 + *(u32 *)t6 531,11553 + goto NEXTINSTRUCTION;534,11627 + t7 538,11693 + t6 540,11762 + t5 541,11784 + t4 543,11833 + goto g8304;544,11858 + t1 551,11981 + goto g8303;552,11997 + t9 557,12100 + t8 560,12186 + *(u64 *)&processor->vma vma562,12246 + t8 564,12313 + t9 566,12365 + t8 575,12470 + t7 576,12503 + t6 579,12572 + t8 580,12588 + t6 582,12645 + t7 583,12661 + t7 584,12671 + t6 585,12708 + t6 587,12763 + t7 588,12779 + t6 590,12823 + t5 592,12862 + t8 594,12903 + t1 599,13023 + goto g8303;600,13039 + goto dbcachemisstrap;604,13095 + arg1 609,13164 + arg2 610,13177 + goto performmemoryaction;611,13189 + goto doistageerror;616,13262 + +stub/ifunlist.c,4396 + arg1 20,615 + goto begindosettocar;28,764 + goto begindosettocar;34,866 + arg1 44,1085 + t11 45,1113 + t12 47,1202 + arg5 49,1281 + arg6 50,1310 + t2 52,1363 + r0 53,1382 + goto carinternal;54,1408 + arg5 57,1457 + arg5 59,1517 + *(u32 *)arg1 60,1537 + goto NEXTINSTRUCTION;63,1619 + goto doistageerror;68,1680 + arg1 85,2076 + goto begindosettocdr;93,2225 + goto begindosettocdr;99,2327 + arg1 109,2546 + t11 110,2574 + t12 112,2663 + arg5 114,2742 + arg6 115,2771 + t2 117,2824 + r0 118,2843 + goto cdrinternal;119,2869 + arg5 122,2918 + arg5 124,2978 + *(u32 *)arg1 125,2998 + goto NEXTINSTRUCTION;128,3080 + goto doistageerror;133,3141 + arg2 145,3446 + t7 149,3496 + arg6 150,3517 + arg5 151,3536 + t5 153,3583 + t8 154,3602 + t6 156,3664 + arg6 157,3701 + arg5 158,3724 + t7 163,3798 + t8 164,3817 + t7 165,3843 + t1 171,3924 + iSP 175,4027 + t1 177,4084 + *(u32 *)arg1 178,4100 + goto NEXTINSTRUCTION;181,4182 + arg2 188,4315 + goto g7187;189,4335 + r0 196,4433 + goto memoryreaddatadecode;197,4459 + goto g7198;199,4500 + arg1 215,4815 + arg6 219,4897 + arg1 221,4940 + iSP 223,4972 + goto begindoassoc;225,5001 + goto begindoassoc;231,5094 + arg1 241,5298 + t11 242,5326 + t12 244,5415 + t5 245,5454 + t5 246,5475 + arg3 247,5500 + arg4 248,5535 + t1 249,5555 + t2 250,5582 + arg3 253,5653 + t5 255,5713 + t1 258,5779 + t2 260,5825 + t6 263,5874 + goto g7200;264,5887 + t6 269,5993 + t1 272,6106 + t2 273,6124 + t5 277,6179 + r0 283,6311 + goto carcdrinternal;284,6337 + t7 287,6409 + t8 288,6425 + arg2 295,6566 + t3 296,6579 + arg1 297,6592 + t7 301,6644 + arg6 302,6665 + arg5 303,6684 + t5 305,6731 + t8 306,6750 + t6 308,6812 + arg6 309,6849 + arg5 310,6872 + t7 315,6946 + t8 316,6965 + t7 317,6991 + t5 323,7072 + arg5 324,7090 + t6 326,7129 + arg6 327,7159 + t5 332,7260 + t1 338,7384 + *(u32 *)iSP 339,7400 + goto NEXTINSTRUCTION;342,7476 + t8 346,7542 + goto assoccdr;353,7681 + t1 359,7789 + t1 360,7808 + arg5 361,7826 + arg2 362,7839 + goto illegaloperand;363,7852 + t1 371,7978 + *(u64 *)iSP 373,8041 + goto NEXTINSTRUCTION;374,8061 + arg3 379,8155 + arg1 381,8200 + arg4 383,8239 + goto exception;384,8251 + arg2 391,8378 + goto g7204;392,8398 + r0 399,8496 + goto memoryreaddatadecode;400,8522 + goto g7215;402,8563 + iSP 406,8619 + goto INTERPRETINSTRUCTION;407,8660 + goto doistageerror;412,8723 + arg1 429,9101 + arg6 433,9184 + arg1 435,9227 + iSP 437,9259 + goto begindomember;439,9288 + goto begindomember;445,9384 + arg1 455,9593 + t11 456,9621 + t12 458,9710 + t5 459,9749 + t5 460,9770 + arg3 461,9795 + arg4 462,9830 + t1 463,9850 + t2 464,9877 + arg3 467,9948 + t5 469,10008 + t1 472,10074 + t2 474,10120 + t6 477,10170 + goto g7222;478,10183 + t6 483,10291 + t1 486,10404 + t2 487,10422 + t3 492,10494 + arg1 493,10510 + t5 494,10523 + r0 500,10655 + goto carcdrinternal;501,10681 + t5 504,10733 + t7 506,10775 + t6 511,10880 + *(u32 *)iSP 516,10988 + goto NEXTINSTRUCTION;519,11066 + t1 524,11151 + *(u64 *)iSP 526,11214 + goto NEXTINSTRUCTION;527,11234 + arg3 532,11330 + arg1 534,11375 + arg4 536,11414 + goto exception;537,11426 + iSP 541,11486 + goto INTERPRETINSTRUCTION;542,11527 + goto doistageerror;547,11591 + arg1 564,11965 + arg6 568,12047 + arg1 570,12090 + iSP 572,12122 + goto begindorgetf;574,12151 + goto begindorgetf;580,12244 + arg1 590,12448 + t11 591,12476 + t12 593,12565 + t5 594,12604 + t5 595,12625 + arg3 596,12650 + arg4 597,12685 + t1 598,12705 + t2 599,12732 + arg3 602,12803 + t5 604,12863 + t1 607,12929 + t2 609,12975 + t6 612,13024 + goto g7225;613,13037 + r0 617,13099 + goto cdrinternal;618,13125 + t6 621,13201 + t1 624,13314 + t2 625,13332 + t5 629,13387 + r0 635,13519 + goto carcdrinternal;636,13545 + t5 639,13597 + t7 641,13639 + t6 646,13743 + t1 653,13890 + t5 655,13936 + t2 659,14031 + r0 660,14044 + goto carinternal;661,14070 + arg5 665,14146 + *(u32 *)iSP 666,14166 + arg2 670,14267 + iSP 675,14401 + goto NEXTINSTRUCTION;676,14418 + arg2 681,14503 + *(u64 *)iSP 682,14546 + iSP 685,14618 + goto NEXTINSTRUCTION;686,14635 + arg3 691,14729 + arg1 693,14774 + arg4 695,14813 + goto exception;696,14825 + iSP 700,14885 + goto INTERPRETINSTRUCTION;701,14926 + goto doistageerror;706,14989 + +stub/ifunloop.c,2626 + t1 30,1006 + arg2 32,1061 + arg1 35,1159 + t1 38,1234 + t1 40,1273 + iSP 46,1411 + iPC 48,1463 + goto interpretinstructionforbranch;53,1569 + t1 80,2417 + arg2 82,2472 + arg1 85,2570 + t1 88,2645 + t1 90,2684 + iPC 94,2804 + iCP 95,2854 + iSP 96,2900 + goto cachevalid;97,2918 + iSP 104,3082 + iPC 106,3134 + goto interpretinstructionforbranch;111,3240 + t1 138,4106 + arg2 140,4161 + arg1 143,4259 + t1 146,4334 + t1 148,4373 + iPC 152,4494 + iCP 153,4544 + iSP 154,4590 + goto cachevalid;155,4608 + iSP 162,4774 + iPC 164,4826 + goto interpretinstructionforbranch;169,4932 + t1 196,5752 + arg2 198,5807 + arg1 201,5905 + t1 204,5980 + t1 206,6019 + iPC 210,6143 + iCP 211,6193 + iSP 212,6239 + goto cachevalid;213,6257 + iSP 220,6429 + iPC 222,6482 + goto interpretinstructionforbranch;227,6588 + arg1 252,7287 + t1 254,7356 + arg2 256,7411 + t2 258,7469 + t3 259,7487 + t3 261,7535 + t3 264,7582 + t4 265,7607 + t6 268,7674 + *(u32 *)iSP 269,7694 + iPC 276,7881 + goto interpretinstructionforbranch;281,7987 + t3 285,8067 + t3 287,8125 + arg5 294,8238 + arg3 296,8281 + arg1 298,8326 + arg4 300,8365 + goto loopexception;301,8377 + arg5 305,8441 + arg2 306,8453 + goto illegaloperand;307,8466 + arg1 332,9240 + t1 334,9309 + arg2 336,9364 + t2 338,9422 + t5 339,9440 + t5 341,9488 + t4 345,9553 + t3 346,9580 + t4 347,9607 + t5 348,9623 + t5 350,9671 + t5 353,9718 + t6 354,9743 + t6 357,9811 + *(u32 *)iSP 358,9831 + t6 361,9907 + iPC 369,10092 + goto interpretinstructionforbranch;374,10198 + t5 378,10278 + t5 380,10336 + t5 386,10425 + t5 388,10483 + arg5 395,10596 + arg3 397,10639 + arg1 399,10684 + arg4 401,10723 + goto loopexception;402,10735 + arg5 406,10799 + arg2 407,10811 + goto illegaloperand;408,10824 + t1 435,11619 + arg2 437,11674 + arg1 440,11772 + t1 443,11847 + t1 445,11886 + iPC 449,12009 + iCP 450,12059 + iSP 451,12105 + goto cachevalid;452,12123 + iSP 459,12293 + iPC 461,12346 + goto interpretinstructionforbranch;466,12452 + t1 493,13454 + arg2 495,13509 + arg1 498,13607 + t1 501,13682 + t1 503,13721 + iPC 507,13834 + iCP 508,13884 + iSP 509,13930 + goto cachevalid;510,13947 + iSP 517,14097 + iPC 519,14149 + goto interpretinstructionforbranch;524,14255 + t1 551,15303 + arg2 553,15358 + arg1 556,15456 + t1 559,15531 + t1 561,15570 + iPC 565,15684 + iCP 566,15734 + iSP 567,15780 + goto cachevalid;568,15797 + iSP 575,15949 + iPC 577,16001 + goto interpretinstructionforbranch;582,16107 + arg5 591,16382 + arg2 592,16394 + goto illegaloperand;593,16407 + +stub/ifunmath.c,10712 + arg1 20,622 + goto begindounaryminus;28,771 + goto begindounaryminus;34,879 + arg1 44,1108 + t6 45,1136 + t7 46,1185 + arg5 48,1250 + arg6 49,1279 + t2 50,1302 + t5 53,1417 + t4 54,1435 + t2 61,1580 + arg2 62,1608 + iPC 65,1679 + iCP 68,1772 + iSP 71,1834 + goto cachevalid;72,1851 + t4 76,1912 + iPC 87,2200 + iCP 90,2298 + iSP 93,2366 + goto cachevalid;94,2383 + arg6 103,2569 + arg3 105,2606 + arg1 107,2651 + arg4 109,2690 + goto unarynumericexception;110,2702 + goto DoUnaryMinusIM;115,2789 + arg2 121,2922 + iPC 122,2954 + iCP 123,3004 + t7 124,3050 + iSP 128,3155 + goto cachevalid;129,3172 + arg1 146,3569 + arg6 150,3654 + arg1 152,3697 + iSP 154,3729 + goto begindomultiply;156,3758 + goto begindomultiply;162,3860 + arg1 172,4079 + t1 175,4152 + t3 177,4202 + t2 179,4247 + t4 181,4283 + t9 185,4382 + t11 187,4435 + t10 188,4452 + t12 195,4599 + t6 202,4747 + t7 214,5092 + iPC 220,5337 + *(u32 *)iSP 221,5349 + iCP 222,5369 + goto cachevalid;223,5381 + t12 227,5442 + goto g7494;236,5656 + t12 240,5712 + goto g7497;249,5926 + t10 256,6024 + t12 263,6181 + iPC 276,6501 + iCP 277,6551 + t8 278,6597 + goto cachevalid;282,6706 + t12 286,6767 + goto g7494;295,6971 + t12 299,7027 + t11 309,7227 + t12 311,7316 + goto g7498;312,7355 + t10 319,7453 + t12 326,7610 + t11 333,7768 + t12 335,7857 + arg2 336,7896 + r0 337,7914 + goto fetchdoublefloat;338,7940 + arg2 344,8049 + r0 345,8067 + goto fetchdoublefloat;346,8093 + r0 354,8271 + goto consdoublefloat;355,8297 + iPC 357,8333 + iCP 358,8383 + t8 359,8429 + *(u32 *)iSP 360,8454 + goto cachevalid;363,8532 + t12 367,8593 + t11 377,8793 + t12 379,8882 + arg2 380,8921 + r0 381,8939 + goto fetchdoublefloat;382,8965 + goto g7495;385,9032 + t12 389,9088 + goto g7496;398,9292 + arg6 413,9549 + arg3 415,9584 + arg1 417,9629 + arg4 419,9668 + goto numericexception;420,9680 + goto g7502;421,9705 + t1 425,9761 + goto domulovfl;426,9772 + goto DoMultiplyIM;434,9889 + arg2 439,9973 + t1 440,9994 + t2 442,10053 + arg2 443,10071 + t11 445,10134 + t12 446,10151 + t3 454,10329 + t4 455,10347 + t10 457,10440 + t5 458,10457 + t10 460,10547 + iPC 466,10726 + *(u32 *)iSP 467,10738 + iCP 468,10758 + goto cachevalid;469,10770 + *(u32 *)&processor->immediate_arg immediate_arg474,10864 + arg1 475,10908 + arg2 476,10949 + goto begindomultiply;477,10964 + sp 489,11259 + t2 492,11321 + t4 494,11357 + t1 496,11395 + t3 498,11445 + t9 501,11538 + t11 503,11591 + t10 504,11608 + t12 511,11755 + sp 531,12141 + goto *r0;r0532,12156 + t10 536,12220 + t12 543,12377 + t12 552,12536 + t3 560,12702 + goto g7541;563,12769 + t12 567,12825 + t11 577,13025 + t12 579,13114 + goto g7544;580,13153 + t10 587,13251 + t12 594,13408 + t11 601,13566 + t12 603,13655 + arg2 604,13694 + *(u64 *)sp 605,13712 + r0 606,13731 + goto fetchdoublefloat;607,13757 + r0 609,13794 + arg2 614,13885 + *(u64 *)sp 615,13903 + r0 616,13922 + goto fetchdoublefloat;617,13948 + r0 619,13985 + goto g7541;621,14034 + t12 625,14090 + t3 636,14308 + t11 637,14319 + t12 639,14408 + arg2 640,14447 + *(u64 *)sp 641,14465 + r0 642,14484 + goto fetchdoublefloat;643,14510 + r0 645,14547 + goto g7541;647,14596 + t12 651,14652 + goto g7542;660,14856 + arg6 675,15105 + arg3 677,15140 + arg1 679,15185 + arg4 681,15224 + goto numericexception;682,15236 + goto g7549;683,15261 + t1 687,15317 + goto g7545;688,15328 + t12 695,15426 + goto g7541;704,15640 + t12 708,15696 + goto g7543;717,15910 + arg1 735,16364 + arg2 736,16385 + arg1 738,16431 + *(u32 *)&processor->immediate_arg immediate_arg739,16457 + arg1 740,16501 + goto begindoquotient;741,16542 + arg1 748,16667 + arg6 752,16752 + arg1 754,16795 + iSP 756,16827 + goto begindoquotient;758,16856 + goto begindoquotient;764,16958 + arg1 774,17177 + r0 775,17205 + goto binaryarithmeticdivisionprelude;776,17231 + t8 779,17320 + t9 780,17336 + t8 792,17649 + iPC 799,17795 + iCP 800,17845 + goto cachevalid;801,17891 + t9 805,17952 + t8 815,18227 + goto g7583;819,18336 + t9 823,18392 + r0 832,18616 + goto consdoublefloat;833,18642 + t8 835,18678 + *(u32 *)iSP 836,18703 + goto g7583;839,18781 + arg1 858,19330 + arg2 859,19351 + arg1 861,19397 + *(u32 *)&processor->immediate_arg immediate_arg862,19423 + arg1 863,19467 + goto begindorationalquotient;864,19508 + arg1 871,19657 + arg6 875,19750 + arg1 877,19793 + iSP 879,19825 + goto begindorationalquotient;881,19854 + goto begindorationalquotient;887,19980 + arg1 897,20239 + r0 898,20267 + goto binaryarithmeticdivisionprelude;899,20293 + t8 902,20382 + t9 903,20398 + t8 923,21178 + iPC 930,21324 + iCP 931,21374 + goto cachevalid;932,21420 + t9 936,21481 + t8 946,21756 + goto g7591;950,21865 + t9 954,21921 + r0 963,22145 + goto consdoublefloat;964,22171 + t8 966,22207 + *(u32 *)iSP 967,22232 + goto g7591;970,22310 + arg1 989,22809 + arg2 990,22830 + arg1 992,22876 + *(u32 *)&processor->immediate_arg immediate_arg993,22902 + arg1 994,22946 + goto begindofloor;995,22987 + arg1 1002,23103 + arg6 1006,23185 + arg1 1008,23228 + iSP 1010,23260 + goto begindofloor;1012,23289 + goto begindofloor;1018,23382 + arg1 1028,23586 + r0 1029,23614 + goto binaryarithmeticdivisionprelude;1030,23640 + t8 1041,23986 + t9 1042,24002 + t8 1053,24283 + t8 1057,24387 + iSP 1061,24498 + iPC 1065,24557 + iCP 1066,24607 + goto cachevalid;1067,24653 + t9 1071,24714 + t8 1081,24977 + t8 1085,25081 + iSP 1089,25197 + goto g7599;1090,25214 + t9 1094,25270 + r0 1104,25545 + goto consdoublefloat;1105,25571 + t8 1107,25607 + t8 1111,25711 + iSP 1115,25821 + goto g7599;1116,25838 + arg1 1135,26327 + arg2 1136,26348 + arg1 1138,26394 + *(u32 *)&processor->immediate_arg immediate_arg1139,26420 + arg1 1140,26464 + goto begindoceiling;1141,26505 + arg1 1148,26627 + arg6 1152,26711 + arg1 1154,26754 + iSP 1156,26786 + goto begindoceiling;1158,26815 + goto begindoceiling;1164,26914 + arg1 1174,27128 + r0 1175,27156 + goto binaryarithmeticdivisionprelude;1176,27182 + t8 1187,27523 + t9 1188,27539 + t8 1199,27820 + t8 1203,27924 + iSP 1207,28035 + iPC 1211,28094 + iCP 1212,28144 + goto cachevalid;1213,28190 + t9 1217,28251 + t8 1227,28514 + t8 1231,28618 + iSP 1235,28734 + goto g7607;1236,28751 + t9 1240,28807 + r0 1250,29082 + goto consdoublefloat;1251,29108 + t8 1253,29144 + t8 1257,29248 + iSP 1261,29358 + goto g7607;1262,29375 + arg1 1281,29874 + arg2 1282,29895 + arg1 1284,29941 + *(u32 *)&processor->immediate_arg immediate_arg1285,29967 + arg1 1286,30011 + goto begindotruncate;1287,30052 + arg1 1294,30177 + arg6 1298,30262 + arg1 1300,30305 + iSP 1302,30337 + goto begindotruncate;1304,30366 + goto begindotruncate;1310,30468 + arg1 1320,30687 + r0 1321,30715 + goto binaryarithmeticdivisionprelude;1322,30741 + t8 1333,31091 + t9 1334,31107 + t8 1345,31388 + t8 1349,31492 + iSP 1353,31603 + iPC 1357,31662 + iCP 1358,31712 + goto cachevalid;1359,31758 + t9 1363,31819 + t8 1373,32082 + t8 1377,32186 + iSP 1381,32302 + goto g7615;1382,32319 + t9 1386,32375 + r0 1396,32650 + goto consdoublefloat;1397,32676 + t8 1399,32712 + t8 1403,32816 + iSP 1407,32926 + goto g7615;1408,32943 + arg1 1427,33426 + arg2 1428,33447 + arg1 1430,33493 + *(u32 *)&processor->immediate_arg immediate_arg1431,33519 + arg1 1432,33563 + goto begindoround;1433,33604 + arg1 1440,33720 + arg6 1444,33802 + arg1 1446,33845 + iSP 1448,33877 + goto begindoround;1450,33906 + goto begindoround;1456,33999 + arg1 1466,34203 + r0 1467,34231 + goto binaryarithmeticdivisionprelude;1468,34257 + t8 1479,34601 + t9 1480,34617 + t8 1491,34898 + t8 1495,35002 + iSP 1499,35113 + iPC 1503,35172 + iCP 1504,35222 + goto cachevalid;1505,35268 + t9 1509,35329 + t8 1519,35592 + t8 1523,35696 + iSP 1527,35812 + goto g7623;1528,35829 + t9 1532,35885 + r0 1542,36160 + goto consdoublefloat;1543,36186 + t8 1545,36222 + t8 1549,36326 + iSP 1553,36436 + goto g7623;1554,36453 + arg1 1574,36944 + arg2 1575,36965 + arg1 1577,37011 + *(u32 *)&processor->immediate_arg immediate_arg1578,37037 + arg1 1579,37081 + goto begindomax;1580,37122 + arg1 1587,37232 + arg6 1591,37312 + arg1 1593,37355 + iSP 1595,37387 + goto begindomax;1597,37416 + goto begindomax;1603,37503 + arg1 1613,37697 + t1 1616,37770 + t3 1618,37820 + t2 1620,37865 + t4 1622,37901 + t9 1625,37988 + t11 1627,38041 + t10 1628,38058 + t12 1635,38205 + t5 1642,38353 + iPC 1643,38369 + iCP 1646,38451 + *(u32 *)iSP 1648,38542 + goto cachevalid;1651,38618 + t12 1655,38679 + goto g7632;1664,38893 + t10 1671,38991 + t12 1678,39148 + iPC 1690,39400 + iCP 1693,39490 + t8 1696,39616 + goto cachevalid;1700,39725 + t12 1704,39786 + goto g7632;1713,39990 + arg6 1728,40239 + arg3 1730,40274 + arg1 1732,40319 + arg4 1734,40358 + goto numericexception;1735,40370 + goto g7636;1736,40395 + t1 1740,40451 + goto g7631;1741,40462 + arg1 1766,41007 + arg2 1767,41028 + arg1 1769,41074 + *(u32 *)&processor->immediate_arg immediate_arg1770,41100 + arg1 1771,41144 + goto begindomin;1772,41185 + arg1 1779,41295 + arg6 1783,41375 + arg1 1785,41418 + iSP 1787,41450 + goto begindomin;1789,41479 + goto begindomin;1795,41566 + arg1 1805,41760 + t1 1808,41833 + t3 1810,41883 + t2 1812,41928 + t4 1814,41964 + t9 1817,42051 + t11 1819,42104 + t10 1820,42121 + t12 1827,42268 + t5 1834,42416 + iPC 1835,42432 + iCP 1838,42514 + *(u32 *)iSP 1840,42605 + goto cachevalid;1843,42681 + t12 1847,42742 + goto g7657;1856,42956 + t10 1863,43054 + t12 1870,43211 + iPC 1882,43463 + iCP 1885,43553 + t8 1888,43679 + goto cachevalid;1892,43788 + t12 1896,43849 + goto g7657;1905,44053 + arg6 1920,44302 + arg3 1922,44337 + arg1 1924,44382 + arg4 1926,44421 + goto numericexception;1927,44433 + goto g7661;1928,44458 + t1 1932,44514 + goto g7656;1933,44525 + arg2 1957,45090 + arg2 1962,45184 + *(u32 *)&processor->immediate_arg immediate_arg1963,45210 + arg1 1964,45254 + goto begindomultiplydouble;1965,45300 + arg1 1972,45443 + goto headdomultiplydouble;1980,45592 + goto headdomultiplydouble;1986,45711 + arg1 1995,45919 + arg1 1997,45971 + t2 2003,46143 + t3 2005,46195 + t4 2007,46248 + t1 2009,46292 + t1 2012,46366 + t1 2013,46382 + t2 2016,46455 + t5 2018,46508 + t2 2019,46524 + t6 2025,46648 + t5 2027,46698 + *(u32 *)iSP 2029,46770 + t1 2030,46790 + iSP 2035,46922 + goto NEXTINSTRUCTION;2036,46939 + arg5 2040,47009 + arg2 2041,47021 + goto illegaloperand;2042,47034 + +stub/ifunmove.c,2287 + arg1 20,619 + goto headdopushnnils;28,768 + goto headdopushnnils;34,872 + arg1 43,1055 + arg1 45,1107 + arg2 51,1277 + t1 53,1317 + t5 54,1336 + t5 56,1384 + goto DoPushNNilsIM;60,1452 + t4 66,1581 + t1 67,1619 + t2 69,1672 + t1 71,1762 + t1 73,1816 + t2 75,1875 + t4 76,1897 + arg6 80,2032 + goto pushnnilsl2;81,2075 + iSP 87,2194 + arg2 88,2211 + goto NEXTINSTRUCTION;93,2287 + arg5 97,2365 + arg2 98,2377 + goto illegaloperand;99,2390 + *(u32 *)&processor->immediate_arg immediate_arg116,2878 + arg1 117,2922 + goto begindopushaddresssprelative;118,2968 + arg1 125,3132 + goto headdopushaddresssprelative;133,3281 + goto headdopushaddresssprelative;139,3421 + arg1 148,3664 + arg1 150,3716 + t4 156,3919 + t1 157,3959 + arg1 158,3978 + t6 160,4030 + t7 162,4113 + t2 164,4195 + t3 165,4211 + arg1 172,4356 + t5 174,4420 + t5 176,4468 + t5 178,4514 + t5 180,4571 + iPC 181,4587 + iCP 182,4637 + t6 183,4683 + iSP 187,4788 + goto cachevalid;188,4805 + arg5 193,4899 + arg2 194,4911 + goto illegaloperand;195,4924 + *(u32 *)&processor->immediate_arg immediate_arg215,5400 + arg1 216,5444 + goto begindostackblt;217,5490 + arg1 224,5615 + goto headdostackblt;232,5764 + goto headdostackblt;238,5865 + arg1 247,6043 + arg1 249,6095 + t3 255,6271 + t2 257,6320 + iSP 259,6365 + t3 260,6382 + t1 261,6398 + t4 263,6459 + arg1 264,6507 + t4 266,6595 + arg1 268,6635 + t4 270,6693 + t5 272,6771 + t1 274,6853 + t6 276,6927 + t7 278,6971 + t6 286,7177 + goto stkbltloopend;287,7199 + arg1 292,7296 + t6 294,7343 + t1 298,7410 + t4 299,7431 + *(u64 *)t6 301,7472 + iSP 306,7622 + goto NEXTINSTRUCTION;307,7634 + arg5 311,7708 + arg2 312,7720 + goto illegaloperand;313,7733 + arg1 330,8172 + goto begindostackbltaddress;338,8321 + goto begindostackbltaddress;344,8444 + arg1 354,8698 + t3 356,8755 + t2 358,8804 + iSP 360,8849 + t3 361,8866 + t4 363,8914 + t5 365,8992 + t1 367,9074 + t6 369,9148 + t7 371,9192 + t6 379,9404 + goto stkbltaddloopend;380,9426 + arg1 385,9532 + t6 387,9579 + t1 391,9649 + t4 392,9670 + *(u64 *)t6 394,9711 + iSP 399,9864 + goto NEXTINSTRUCTION;400,9876 + arg5 404,9956 + arg2 405,9968 + goto illegaloperand;406,9981 + goto doistageerror;411,10048 + +stub/ifunpred.c,4200 + arg1 20,580 + goto headdoeql;28,729 + goto headdoeql;34,815 + arg1 43,968 + arg1 45,1020 + arg6 50,1157 + t3 52,1204 + t4 54,1260 + t11 55,1281 + t4 57,1360 + t12 59,1417 + t5 60,1457 + t5 62,1511 + arg6 64,1558 + t5 69,1706 + t12 71,1761 + t3 76,1879 + t3 78,1913 + t4 80,1960 + iSP 88,2147 + iPC 89,2173 + iCP 90,2223 + *(u64 *)iSP 91,2269 + goto cachevalid;92,2290 + goto DoEqlIM;94,2324 + arg2 99,2393 + t4 101,2437 + t3 102,2463 + arg6 103,2483 + arg2 105,2547 + t3 106,2573 + t11 107,2589 + t4 109,2648 + t12 110,2664 + arg2 111,2704 + t4 112,2734 + arg6 114,2789 + t4 115,2808 + iSP 117,2871 + iPC 118,2897 + iCP 119,2947 + *(u64 *)iSP 123,3077 + goto cachevalid;124,3098 + arg3 129,3183 + arg1 131,3228 + arg4 133,3267 + goto exception;134,3279 + arg1 151,3661 + arg6 155,3746 + arg1 157,3789 + iSP 159,3821 + goto begindogreaterp;161,3850 + goto begindogreaterp;167,3952 + arg1 177,4171 + t11 178,4199 + t7 179,4241 + t12 180,4260 + arg3 182,4321 + t1 184,4382 + t7 186,4437 + arg2 187,4452 + arg4 188,4475 + t5 191,4561 + t4 193,4616 + t6 194,4632 + t3 201,4777 + t2 208,4922 + iPC 209,4942 + iSP 211,5011 + iCP 212,5035 + *(u64 *)iSP 216,5146 + goto cachevalid;217,5167 + t6 224,5270 + t3 231,5425 + iPC 244,5785 + iSP 245,5835 + iCP 246,5859 + *(u64 *)iSP 247,5905 + *(u64 *)iSP 251,6012 + goto cachevalid;252,6033 + goto greaterpmmexc;263,6211 + goto DoGreaterpIM;268,6290 + t11 273,6374 + arg2 275,6453 + t12 276,6474 + t7 277,6514 + arg3 278,6533 + arg4 279,6568 + arg2 281,6626 + t7 282,6652 + t3 284,6704 + t4 285,6722 + t2 292,6867 + iPC 293,6887 + iSP 294,6937 + iCP 295,6961 + *(u64 *)iSP 299,7072 + goto cachevalid;300,7093 + arg6 306,7221 + arg3 308,7258 + arg1 310,7303 + arg4 312,7342 + goto numericexception;313,7354 + arg1 333,7789 + arg6 337,7873 + arg1 339,7916 + iSP 341,7948 + goto begindologtest;343,7977 + goto begindologtest;349,8076 + arg1 359,8290 + t11 360,8318 + t7 361,8360 + t12 362,8379 + arg3 364,8440 + arg2 365,8475 + t7 367,8526 + t1 369,8567 + arg4 370,8594 + arg2 371,8614 + t5 374,8700 + t4 376,8755 + t6 377,8771 + t3 384,8916 + t2 391,9061 + iPC 392,9081 + iSP 394,9150 + iCP 395,9174 + *(u64 *)iSP 399,9276 + goto cachevalid;400,9297 + arg6 412,9509 + arg3 414,9546 + arg1 416,9591 + arg4 418,9630 + goto numericexception;419,9642 + goto g8011;420,9667 + arg6 425,9757 + arg3 427,9792 + arg1 429,9837 + arg4 431,9876 + goto numericexception;432,9888 + goto DoLogtestIM;440,10012 + t11 445,10093 + arg2 447,10172 + t12 448,10193 + t7 449,10233 + arg3 450,10252 + arg4 451,10287 + arg2 453,10345 + t7 454,10371 + t3 456,10423 + t4 457,10441 + t2 464,10586 + iPC 465,10606 + iSP 466,10656 + iCP 467,10680 + *(u64 *)iSP 471,10782 + goto cachevalid;472,10803 + arg6 478,10931 + arg3 480,10968 + arg1 482,11013 + arg4 484,11052 + goto numericexception;485,11064 + t5 498,11350 + t4 500,11405 + t6 501,11421 + t3 508,11566 + goto equalnumbermmexcfltflt;517,11777 + t6 524,11892 + t3 531,12047 + goto equalnumbermmexcfltflt;540,12248 + arg6 552,12472 + arg3 554,12509 + arg1 556,12554 + arg4 558,12593 + goto numericexception;559,12605 + goto g8029;560,12630 + arg6 565,12720 + arg3 567,12755 + arg1 569,12800 + arg4 571,12839 + goto numericexception;572,12851 + t5 587,13101 + t4 589,13156 + t6 590,13172 + t3 597,13317 + goto lesspmmexcfltflt;606,13528 + t6 613,13637 + t3 620,13792 + goto lesspmmexcfltflt;629,13993 + arg6 641,14211 + arg3 643,14248 + arg1 645,14293 + arg4 647,14332 + goto numericexception;648,14344 + goto g8048;649,14369 + arg6 654,14459 + arg3 656,14494 + arg1 658,14539 + arg4 660,14578 + goto numericexception;661,14590 + t5 676,14843 + t4 678,14898 + t6 679,14914 + t3 686,15059 + goto greaterpmmexcfltflt;695,15270 + t6 702,15382 + t3 709,15537 + goto greaterpmmexcfltflt;718,15738 + arg6 730,15959 + arg3 732,15996 + arg1 734,16041 + arg4 736,16080 + goto numericexception;737,16092 + goto g8067;738,16117 + arg6 743,16207 + arg3 745,16242 + arg1 747,16287 + arg4 749,16326 + goto numericexception;750,16338 + +stub/ifunsubp.c,26572 + arg2 21,692 + arg2 26,786 + *(u32 *)&processor->immediate_arg immediate_arg27,812 + arg1 28,856 + goto begindoephemeralp;29,902 + arg1 36,1033 + goto headdoephemeralp;44,1182 + goto headdoephemeralp;50,1289 + arg1 59,1477 + arg1 61,1529 + t1 67,1699 + arg2 68,1737 + arg1 69,1758 + arg2 71,1795 + t2 72,1815 + arg1 73,1839 + t3 75,1888 + iPC 76,1907 + iCP 77,1957 + t6 84,2134 + iSP 87,2221 + goto cachevalid;88,2238 + t6 92,2305 + iSP 95,2394 + goto cachevalid;96,2411 + arg1 113,2838 + goto headdounsignedlessp;121,2987 + goto headdounsignedlessp;127,3103 + arg1 136,3306 + arg1 138,3358 + t2 144,3542 + arg3 145,3562 + t11 146,3583 + t4 148,3661 + t12 149,3679 + arg3 151,3749 + t2 153,3790 + iSP 155,3851 + t6 157,3908 + iPC 160,3958 + iCP 161,4008 + *(u64 *)iSP 162,4054 + goto cachevalid;163,4075 + goto DoUnsignedLesspIM;165,4109 + t2 171,4235 + arg3 172,4255 + t11 173,4276 + t2 175,4330 + t12 176,4346 + arg3 178,4416 + t6 180,4466 + iSP 182,4529 + iPC 185,4589 + iCP 186,4639 + *(u64 *)iSP 187,4685 + goto cachevalid;188,4706 + *(u32 *)&processor->immediate_arg immediate_arg205,5174 + arg1 206,5218 + goto begindoallocatelistblock;207,5264 + arg1 214,5416 + goto headdoallocatelistblock;222,5565 + goto headdoallocatelistblock;228,5693 + arg1 237,5916 + arg1 239,5968 + t1 244,6133 + arg3 245,6170 + arg2 246,6192 + arg1 247,6213 + t5 248,6233 + t5 250,6283 + t4 253,6330 + t2 254,6367 + t2 259,6493 + t1 264,6595 + t3 265,6635 + t3 266,6658 + *(u32 *)&processor->lclength lclength268,6705 + *(u64 *)iSP 270,6775 + *(u32 *)&processor->bar1 bar1272,6825 + t1 273,6858 + t4 275,6899 + t1 277,6961 + *(u32 *)&processor->lcaddress lcaddress279,7009 + t3 280,7047 + t3 284,7140 + t4 285,7162 + *(u32 *)&processor->control control286,7178 + goto NEXTINSTRUCTION;287,7214 + arg5 291,7280 + arg2 292,7292 + goto illegaloperand;293,7304 + t1 298,7385 + t1 299,7404 + arg3 301,7444 + arg1 303,7489 + arg4 305,7528 + goto exception;306,7540 + *(u32 *)&processor->immediate_arg immediate_arg323,8045 + arg1 324,8089 + goto begindoallocatestructureblock;325,8135 + arg1 332,8302 + goto headdoallocatestructureblock;340,8451 + goto headdoallocatestructureblock;346,8594 + arg1 355,8842 + arg1 357,8894 + t1 362,9069 + arg3 363,9106 + arg2 364,9128 + arg1 365,9149 + t5 366,9169 + t5 368,9219 + t4 371,9266 + t2 372,9303 + t2 377,9429 + t1 382,9531 + t3 383,9571 + t3 384,9594 + *(u32 *)&processor->sclength sclength386,9641 + *(u64 *)iSP 388,9711 + *(u32 *)&processor->bar1 bar1390,9761 + t1 391,9794 + t4 393,9835 + t1 395,9897 + *(u32 *)&processor->scaddress scaddress397,9945 + t3 398,9983 + t3 402,10076 + t4 403,10098 + *(u32 *)&processor->control control404,10114 + goto NEXTINSTRUCTION;405,10150 + arg5 409,10216 + arg2 410,10228 + goto illegaloperand;411,10240 + t1 416,10321 + t1 417,10340 + arg3 419,10380 + arg1 421,10425 + arg4 423,10464 + goto exception;424,10476 + arg1 441,10950 + goto headdopointerdifference;449,11099 + goto headdopointerdifference;455,11227 + arg1 464,11450 + arg1 466,11502 + t1 472,11696 + t2 474,11745 + t3 476,11816 + iPC 477,11842 + iCP 478,11892 + t4 479,11938 + *(u32 *)iSP 481,12001 + goto cachevalid;484,12077 + goto DoPointerDifferenceIM;486,12111 + t2 491,12222 + t1 493,12270 + t2 494,12290 + t3 496,12365 + iPC 497,12391 + iCP 498,12441 + t4 499,12487 + *(u32 *)iSP 501,12550 + goto cachevalid;504,12626 + arg1 521,13085 + goto begindopointerincrement;529,13234 + goto begindopointerincrement;535,13360 + arg1 545,13619 + t2 547,13676 + t3 549,13734 + iPC 550,13759 + iCP 551,13809 + *(u32 *)arg1 553,13879 + goto cachevalid;554,13900 + goto doistageerror;559,13964 + arg2 577,14491 + arg2 582,14585 + *(u32 *)&processor->immediate_arg immediate_arg583,14611 + arg1 584,14655 + goto begindostoreconditional;585,14701 + arg1 592,14850 + goto headdostoreconditional;600,14999 + goto headdostoreconditional;606,15124 + arg1 615,15342 + arg1 617,15394 + arg2 622,15553 + arg4 624,15599 + arg3 626,15646 + iSP 628,15693 + arg4 629,15710 + arg1 630,15730 + arg6 632,15779 + arg5 634,15830 + iSP 636,15877 + arg6 637,15894 + t1 639,15931 + t2 640,15949 + t2 642,15999 + t1 650,16167 + t3 651,16215 + t2 652,16236 + t5 653,16274 + t4 654,16291 + t1 656,16336 + t2 658,16372 + t5 659,16408 + t4 660,16427 + t1 665,16497 + t3 666,16541 + t1 667,16560 + t3 668,16584 + t1 674,16681 + t2 676,16736 + t2 682,16886 + t1 687,16996 + t4 689,17038 + t4 691,17095 + t2 692,17111 + t1 693,17159 + t6 694,17180 + t5 695,17218 + t3 696,17235 + t2 698,17280 + t6 700,17316 + t2 701,17352 + t3 702,17386 + t3 706,17462 + *(u32 *)t5 708,17495 + iPC 714,17578 + iCP 715,17628 + t6 716,17674 + iSP 719,17761 + goto cachevalid;720,17778 + iPC 724,17853 + iCP 725,17903 + t6 726,17949 + iSP 729,18038 + goto cachevalid;730,18055 + arg5 734,18130 + arg2 735,18142 + goto illegaloperand;736,18155 + t2 740,18220 + t1 744,18310 + t2 746,18382 + t1 748,18424 + *(u32 *)t1 750,18469 + goto g8100;753,18545 + t2 757,18601 + t1 759,18670 + t5 760,18692 + t4 762,18741 + goto g8089;763,18766 + arg6 770,18889 + goto g8088;771,18907 + t1 776,19010 + t3 779,19095 + *(u64 *)&processor->vma vma781,19155 + t3 783,19224 + t1 785,19276 + t3 789,19337 + t4 792,19403 + t4 793,19421 + goto g8099;794,19464 + t3 803,19564 + t2 804,19597 + t1 807,19666 + t3 808,19684 + t1 810,19741 + t2 811,19757 + t2 812,19767 + t1 813,19804 + t1 815,19859 + t2 816,19875 + t1 818,19919 + t5 820,19958 + t3 822,19999 + arg6 827,20121 + goto g8088;828,20139 + goto dbcachemisstrap;832,20195 + arg1 837,20264 + arg2 838,20277 + goto performmemoryaction;839,20289 + arg2 857,20792 + arg2 862,20886 + *(u32 *)&processor->immediate_arg immediate_arg863,20912 + arg1 864,20956 + goto begindomemorywrite;865,21002 + arg1 872,21136 + goto headdomemorywrite;880,21285 + goto headdomemorywrite;886,21395 + arg1 895,21588 + arg1 897,21640 + arg4 902,21789 + arg3 903,21811 + iSP 905,21858 + arg4 906,21875 + arg2 907,21895 + arg1 908,21916 + t2 909,21936 + t1 910,21984 + t5 911,22005 + t4 912,22043 + t3 913,22060 + t2 915,22105 + t5 917,22141 + t2 918,22177 + t3 919,22213 + t3 923,22289 + *(u32 *)t4 925,22322 + goto NEXTINSTRUCTION;929,22397 + goto NEXTINSTRUCTION;930,22421 + t2 934,22487 + t1 938,22577 + t2 940,22649 + t1 942,22691 + *(u32 *)t1 944,22736 + goto NEXTINSTRUCTION;947,22814 + arg2 965,23321 + arg2 970,23415 + *(u32 *)&processor->immediate_arg immediate_arg971,23441 + arg1 972,23485 + goto begindopstorecontents;973,23531 + arg1 980,23674 + goto headdopstorecontents;988,23823 + goto headdopstorecontents;994,23942 + arg1 1003,24150 + arg1 1005,24202 + arg4 1011,24386 + arg3 1013,24437 + iSP 1015,24484 + arg4 1016,24501 + arg2 1017,24521 + arg1 1018,24542 + t6 1023,24627 + t8 1024,24675 + t7 1025,24696 + t5 1026,24734 + t4 1027,24751 + t6 1029,24796 + t7 1031,24832 + t5 1032,24868 + t4 1033,24887 + t5 1041,24988 + t4 1042,25006 + t4 1043,25023 + t7 1044,25039 + t6 1045,25087 + t9 1046,25108 + t5 1047,25146 + t8 1048,25163 + t7 1050,25208 + t9 1052,25244 + t7 1053,25280 + t8 1054,25314 + t8 1058,25390 + *(u32 *)t5 1060,25423 + goto NEXTINSTRUCTION;1064,25498 + goto NEXTINSTRUCTION;1065,25522 + t7 1069,25588 + t6 1073,25678 + t7 1075,25750 + t6 1077,25792 + *(u32 *)t6 1079,25837 + goto NEXTINSTRUCTION;1082,25913 + t7 1086,25979 + t6 1088,26048 + t5 1089,26070 + t4 1091,26119 + goto g8110;1092,26144 + arg1 1109,26562 + goto begindosetcdrcode1;1117,26711 + goto begindosetcdrcode1;1123,26822 + arg1 1133,27056 + t1 1135,27120 + iPC 1136,27147 + iCP 1137,27197 + t1 1139,27288 + t1 1141,27326 + goto cachevalid;1144,27402 + goto doistageerror;1149,27461 + arg1 1166,27881 + goto begindosetcdrcode2;1174,28030 + goto begindosetcdrcode2;1180,28141 + arg1 1190,28375 + t1 1192,28439 + iPC 1193,28466 + iCP 1194,28516 + t1 1196,28607 + t1 1198,28645 + goto cachevalid;1201,28722 + goto doistageerror;1206,28781 + arg1 1223,29159 + goto begindojump;1231,29308 + goto begindojump;1237,29398 + arg1 1247,29597 + t4 1249,29667 + t3 1250,29688 + t4 1251,29715 + t5 1252,29731 + t5 1254,29789 + t4 1257,29835 + iPC 1258,29851 + iPC 1259,29867 + t5 1260,29885 + t6 1265,30040 + t5 1267,30092 + t6 1269,30175 + t7 1270,30192 + t5 1272,30225 + t5 1274,30254 + *(u64 *)&processor->control control1275,30270 + goto interpretinstructionforjump;1276,30306 + arg3 1281,30404 + arg1 1283,30449 + arg4 1285,30488 + goto exception;1286,30500 + goto doistageerror;1291,30551 + arg1 1316,31240 + t1 1318,31311 + t2 1319,31352 + t2 1320,31367 + t1 1321,31393 + *(u32 *)&processor->interruptreg interruptreg1322,31409 + *(u64 *)&processor->stop_interpreter stop_interpreter1325,31491 + goto NEXTINSTRUCTION;1326,31536 + arg1 1351,32077 + t1 1353,32148 + t1 1355,32234 + t1 1357,32297 + goto haltmachine;1360,32355 + arg3 1365,32443 + arg1 1367,32488 + arg4 1369,32527 + goto exception;1370,32539 + arg1 1395,33044 + goto NEXTINSTRUCTION;1397,33115 + arg2 1415,33542 + arg2 1420,33636 + *(u32 *)&processor->immediate_arg immediate_arg1421,33662 + arg1 1422,33706 + goto begindoalu;1423,33752 + arg1 1430,33862 + goto headdoalu;1438,34011 + goto headdoalu;1444,34097 + arg1 1453,34250 + arg1 1455,34302 + arg2 1461,34459 + arg1 1463,34505 + arg4 1465,34542 + arg3 1466,34564 + arg4 1467,34592 + t1 1468,34612 + t1 1470,34662 + t1 1473,34710 + t1 1475,34760 + arg5 1478,34808 + *(u64 *)&processor->aluoverflow aluoverflow1479,34846 + arg6 1480,34888 + t1 1481,34940 + t10 1488,35103 + t10 1490,35164 + t1 1491,35182 + t1 1500,35334 + t10 1507,35476 + goto g8124;1508,35497 + t1 1512,35553 + t10 1519,35699 + goto g8124;1520,35721 + t1 1524,35777 + t10 1531,35915 + goto g8124;1532,35929 + t1 1536,35985 + t10 1543,36131 + goto g8124;1544,36153 + t1 1548,36209 + t10 1555,36347 + goto g8124;1556,36361 + t1 1560,36417 + t10 1567,36559 + goto g8124;1568,36580 + t1 1572,36636 + t10 1579,36778 + goto g8124;1580,36799 + t1 1584,36855 + t10 1591,36997 + t10 1592,37018 + goto g8124;1593,37032 + t1 1597,37088 + t10 1604,37234 + t10 1605,37255 + goto g8124;1606,37269 + t1 1610,37325 + t10 1617,37465 + goto g8124;1618,37480 + t1 1622,37536 + t10 1629,37680 + goto g8124;1630,37704 + t1 1634,37760 + t10 1641,37900 + goto g8124;1642,37915 + t1 1646,37971 + t10 1653,38115 + goto g8124;1654,38137 + t1 1658,38193 + t10 1665,38337 + goto g8124;1666,38358 + t1 1670,38414 + t10 1677,38556 + *(u32 *)iSP 1681,38613 + goto NEXTINSTRUCTION;1682,38634 + t1 1686,38700 + t2 1694,38876 + t3 1696,38938 + t1 1698,39000 + t1 1700,39055 + t4 1701,39070 + t1 1708,39235 + t5 1712,39290 + t5 1714,39346 + t10 1715,39361 + t4 1716,39388 + t10 1717,39420 + t10 1719,39458 + *(u64 *)&processor->rotatelatch rotatelatch1723,39558 + t5 1727,39641 + t5 1728,39659 + t5 1730,39704 + t4 1732,39742 + t4 1733,39761 + t3 1734,39776 + t5 1742,39959 + t10 1747,40046 + t1 1749,40089 + t10 1750,40106 + *(u32 *)iSP 1751,40124 + goto NEXTINSTRUCTION;1752,40145 + t1 1756,40211 + t3 1763,40370 + t3 1765,40413 + t2 1766,40428 + t2 1768,40482 + t4 1769,40497 + t1 1776,40650 + t10 1780,40705 + t10 1781,40724 + t3 1783,40759 + t4 1785,40794 + t3 1787,40854 + t4 1789,40904 + *(u64 *)&processor->aluoverflow aluoverflow1790,40923 + t3 1794,41022 + t4 1795,41054 + arg6 1796,41074 + t4 1797,41095 + t4 1798,41110 + arg6 1800,41158 + *(u64 *)&processor->aluandrotatecontrol aluandrotatecontrol1801,41178 + t3 1805,41270 + *(u64 *)&processor->aluborrow aluborrow1806,41308 + arg4 1807,41346 + arg1 1808,41366 + t3 1809,41386 + *(u64 *)&processor->alulessthan alulessthan1810,41424 + *(u32 *)iSP 1811,41464 + goto NEXTINSTRUCTION;1812,41485 + t1 1816,41551 + arg5 1824,41779 + arg2 1825,41791 + goto illegaloperand;1826,41804 + *(u32 *)iSP 1827,41827 + goto NEXTINSTRUCTION;1828,41848 + arg5 1835,41958 + arg2 1836,41970 + goto illegaloperand;1837,41983 + t4 1841,42048 + t1 1848,42203 + goto g8173;1849,42216 + t4 1853,42272 + t1 1860,42431 + t1 1861,42449 + t1 1862,42467 + goto g8173;1863,42483 + t4 1867,42539 + t1 1874,42702 + t1 1875,42716 + goto g8173;1876,42732 + t3 1880,42788 + goto g8166;1886,42905 + t4 1890,42961 + t1 1897,43142 + goto g8160;1898,43184 + t4 1902,43240 + t1 1909,43407 + goto g8160;1910,43420 + arg1 1935,43955 + t1 1938,44054 + t1 1940,44132 + t1 1942,44168 + arg1 1944,44218 + arg2 1946,44264 + arg3 1948,44299 + arg4 1950,44338 + arg5 1952,44387 + arg6 1954,44431 + goto exception;1955,44443 + goto NEXTINSTRUCTION;1956,44461 + t5 1967,44751 + t4 1968,44796 + t5 1970,44885 + t5 1972,44947 + t4 1974,44987 + t5 1975,45003 + iSP 1979,45108 + goto NEXTINSTRUCTION;1980,45125 + t5 1989,45306 + t4 1990,45351 + t5 1992,45440 + t5 1994,45502 + t4 1996,45542 + t5 1997,45558 + iSP 2001,45663 + goto NEXTINSTRUCTION;2002,45680 + t5 2011,45861 + t4 2012,45906 + t5 2014,45995 + t5 2016,46057 + t4 2018,46097 + t5 2019,46113 + iSP 2023,46218 + goto NEXTINSTRUCTION;2024,46235 + t3 2032,46427 + t5 2033,46475 + iSP 2037,46580 + goto NEXTINSTRUCTION;2038,46597 + t2 2047,46786 + iPC 2048,46804 + t1 2049,46854 + iCP 2050,46884 + t1 2052,46963 + t3 2053,46985 + t4 2054,47004 + iSP 2058,47109 + goto cachevalid;2059,47126 + t3 2067,47291 + iSP 2068,47334 + t5 2069,47351 + t5 2070,47368 + *(u64 *)iSP 2071,47385 + goto NEXTINSTRUCTION;2072,47405 + t3 2080,47604 + t5 2081,47654 + iSP 2085,47757 + goto NEXTINSTRUCTION;2086,47774 + t3 2094,47968 + t5 2095,48004 + iSP 2099,48107 + goto NEXTINSTRUCTION;2100,48124 + t3 2108,48311 + t3 2110,48383 + t5 2111,48400 + iSP 2115,48503 + goto NEXTINSTRUCTION;2116,48520 + t3 2124,48739 + t5 2125,48785 + iSP 2129,48888 + goto NEXTINSTRUCTION;2130,48905 + t3 2138,49120 + t5 2139,49161 + iSP 2143,49264 + goto NEXTINSTRUCTION;2144,49281 + t3 2152,49467 + t5 2153,49477 + iSP 2157,49580 + goto NEXTINSTRUCTION;2158,49597 + t4 2166,49799 + iSP 2170,49904 + goto NEXTINSTRUCTION;2171,49921 + t3 2179,50116 + t3 2180,50157 + t5 2181,50172 + iSP 2185,50275 + goto NEXTINSTRUCTION;2186,50292 + t5 2194,50476 + iSP 2198,50581 + goto NEXTINSTRUCTION;2199,50598 + t5 2207,50792 + iSP 2211,50897 + goto NEXTINSTRUCTION;2212,50914 + t5 2220,51106 + iSP 2224,51211 + goto NEXTINSTRUCTION;2225,51228 + t5 2233,51412 + iSP 2237,51517 + goto NEXTINSTRUCTION;2238,51534 + t3 2246,51746 + t4 2247,51784 + t3 2248,51832 + t4 2249,51848 + iSP 2253,51953 + goto NEXTINSTRUCTION;2254,51970 + t1 2262,52171 + iSP 2266,52276 + goto NEXTINSTRUCTION;2267,52293 + t1 2275,52448 + iSP 2276,52468 + t2 2277,52485 + t2 2278,52502 + *(u64 *)iSP 2280,52545 + goto NEXTINSTRUCTION;2281,52565 + t3 2289,52728 + t4 2290,52771 + iSP 2294,52874 + goto NEXTINSTRUCTION;2295,52891 + t3 2303,53088 + iSP 2304,53138 + t5 2305,53155 + t5 2306,53172 + *(u64 *)iSP 2307,53189 + goto NEXTINSTRUCTION;2308,53209 + t3 2316,53400 + iSP 2317,53441 + t5 2318,53458 + t5 2319,53475 + *(u64 *)iSP 2320,53492 + goto NEXTINSTRUCTION;2321,53512 + t3 2329,53707 + t5 2330,53743 + iSP 2334,53848 + goto NEXTINSTRUCTION;2335,53865 + t3 2343,54078 + t5 2344,54119 + iSP 2348,54224 + goto NEXTINSTRUCTION;2349,54241 + t3 2357,54444 + iSP 2358,54492 + t5 2359,54509 + t5 2360,54526 + *(u64 *)iSP 2361,54543 + goto NEXTINSTRUCTION;2362,54563 + t5 2370,54731 + iSP 2374,54838 + goto NEXTINSTRUCTION;2375,54855 + t5 2383,55013 + iSP 2387,55118 + goto NEXTINSTRUCTION;2388,55135 + t5 2396,55317 + iSP 2400,55422 + goto NEXTINSTRUCTION;2401,55439 + t3 2409,55623 + iSP 2410,55660 + t5 2411,55677 + t5 2412,55694 + *(u64 *)iSP 2413,55711 + goto NEXTINSTRUCTION;2414,55731 + t3 2422,55922 + iSP 2423,55962 + t5 2424,55979 + t5 2425,55996 + *(u64 *)iSP 2426,56013 + goto NEXTINSTRUCTION;2427,56033 + t3 2435,56224 + t5 2436,56261 + iSP 2440,56364 + goto NEXTINSTRUCTION;2441,56381 + t3 2449,56580 + iSP 2450,56617 + t5 2451,56634 + t5 2452,56651 + *(u64 *)iSP 2453,56668 + goto NEXTINSTRUCTION;2454,56688 + t3 2462,56899 + iSP 2463,56939 + t5 2464,56956 + t5 2465,56973 + *(u64 *)iSP 2466,56990 + goto NEXTINSTRUCTION;2467,57010 + t3 2475,57221 + t5 2476,57258 + iSP 2480,57361 + goto NEXTINSTRUCTION;2481,57378 + t3 2489,57597 + iSP 2490,57635 + t5 2491,57652 + t5 2492,57669 + *(u64 *)iSP 2493,57686 + goto NEXTINSTRUCTION;2494,57706 + t3 2502,57928 + iSP 2503,57966 + t5 2504,57983 + t5 2505,58000 + *(u64 *)iSP 2506,58017 + goto NEXTINSTRUCTION;2507,58037 + t3 2515,58229 + t5 2516,58267 + iSP 2520,58370 + goto NEXTINSTRUCTION;2521,58387 + t3 2529,58611 + t5 2530,58653 + iSP 2534,58756 + goto NEXTINSTRUCTION;2535,58773 + t3 2543,59002 + goto NEXTINSTRUCTION;2544,59054 + t3 2552,59271 + t5 2553,59290 + iSP 2557,59393 + goto NEXTINSTRUCTION;2558,59410 + t3 2566,59624 + t5 2567,59643 + iSP 2571,59746 + goto NEXTINSTRUCTION;2572,59763 + t5 2580,59947 + iSP 2583,60034 + goto NEXTINSTRUCTION;2584,60051 + t5 2592,60219 + iSP 2595,60308 + goto NEXTINSTRUCTION;2596,60325 + arg5 2604,60479 + arg2 2605,60491 + goto illegaloperand;2606,60504 + t2 2616,60694 + t1 2618,60782 + t2 2620,60847 + t3 2622,60883 + t1 2623,60919 + t1 2628,61052 + iFP 2629,61074 + goto NEXTINSTRUCTION;2630,61086 + arg5 2631,61110 + arg2 2632,61122 + goto illegaloperand;2633,61135 + t2 2644,61330 + t1 2646,61418 + t2 2648,61483 + t3 2650,61519 + t1 2651,61555 + t1 2656,61688 + iLP 2657,61710 + goto NEXTINSTRUCTION;2658,61722 + arg5 2659,61746 + arg2 2660,61758 + goto illegaloperand;2661,61771 + t2 2672,61966 + t1 2674,62054 + t2 2676,62119 + t3 2678,62155 + t1 2679,62191 + t1 2684,62324 + iSP 2685,62346 + goto NEXTINSTRUCTION;2686,62358 + arg5 2687,62382 + arg2 2688,62394 + goto illegaloperand;2689,62407 + *(u64 *)&processor->stackcachebasevma stackcachebasevma2699,62624 + t1 2700,62672 + t1 2701,62717 + *(u64 *)&processor->stackcachetopvma stackcachetopvma2702,62735 + goto NEXTINSTRUCTION;2703,62780 + arg5 2704,62804 + arg2 2705,62816 + goto illegaloperand;2706,62829 + arg4 2715,63025 + arg4 2717,63082 + *(u64 *)&processor->continuation continuation2718,63104 + goto NEXTINSTRUCTION;2719,63147 + t1 2727,63350 + t1 2729,63409 + *(u64 *)&processor->aluandrotatecontrol aluandrotatecontrol2730,63424 + t2 2731,63474 + t2 2733,63522 + *(u64 *)&processor->aluop aluop2734,63538 + t3 2736,63604 + *(u64 *)&processor->bytesize bytesize2737,63622 + *(u64 *)&processor->byterotate byterotate2738,63659 + goto NEXTINSTRUCTION;2739,63698 + *(u32 *)&processor->control control2747,63896 + goto NEXTINSTRUCTION;2748,63934 + *(u64 *)&processor->ac0array ac0array2756,64158 + *(u64 *)&processor->ac1array ac1array2757,64197 + *(u64 *)&processor->ac2array ac2array2758,64236 + *(u64 *)&processor->ac3array ac3array2759,64275 + *(u64 *)&processor->ac4array ac4array2760,64314 + *(u64 *)&processor->ac5array ac5array2761,64353 + *(u64 *)&processor->ac6array ac6array2762,64392 + *(u64 *)&processor->ac7array ac7array2763,64431 + *(u32 *)&processor->ephemeraloldspace ephemeraloldspace2764,64470 + goto NEXTINSTRUCTION;2765,64518 + *(u32 *)&processor->zoneoldspace zoneoldspace2773,64737 + goto NEXTINSTRUCTION;2774,64780 + goto NEXTINSTRUCTION;2782,64994 + t3 2790,65193 + t3 2791,65234 + arg3 2792,65251 + t3 2793,65270 + *(u32 *)&processor->interruptreg interruptreg2794,65288 + *(u64 *)&processor->stop_interpreter stop_interpreter2797,65376 + goto NEXTINSTRUCTION;2798,65421 + t1 2806,65639 + t1 2807,65687 + t1 2808,65703 + *(u32 *)&processor->scovlimit scovlimit2809,65721 + goto NEXTINSTRUCTION;2810,65759 + goto NEXTINSTRUCTION;2818,65925 + *(u64 *)&processor->areventcount areventcount2826,66092 + goto NEXTINSTRUCTION;2827,66135 + arg4 2835,66336 + arg4 2837,66393 + *(u64 *)&processor->bindingstackpointer bindingstackpointer2838,66415 + goto NEXTINSTRUCTION;2839,66465 + arg4 2847,66660 + arg4 2849,66717 + *(u64 *)&processor->catchblock catchblock2850,66739 + goto NEXTINSTRUCTION;2851,66780 + *(u32 *)&processor->cslimit cslimit2859,66979 + goto NEXTINSTRUCTION;2860,67017 + *(u32 *)&processor->csextralimit csextralimit2868,67234 + goto NEXTINSTRUCTION;2869,67277 + arg4 2877,67484 + arg4 2879,67541 + *(u64 *)&processor->bindingstacklimit bindingstacklimit2880,67563 + goto NEXTINSTRUCTION;2881,67611 + arg4 2889,67801 + arg4 2891,67858 + *(u64 *)&processor->lcarea lcarea2892,67880 + goto NEXTINSTRUCTION;2893,67917 + arg4 2901,68112 + arg4 2903,68169 + *(u64 *)&processor->lcaddress lcaddress2904,68191 + goto NEXTINSTRUCTION;2905,68231 + *(u32 *)&processor->lclength lclength2913,68426 + goto NEXTINSTRUCTION;2914,68465 + arg4 2922,68668 + arg4 2924,68725 + *(u64 *)&processor->scarea scarea2925,68747 + goto NEXTINSTRUCTION;2926,68784 + arg4 2934,68999 + arg4 2936,69056 + *(u64 *)&processor->scaddress scaddress2937,69078 + goto NEXTINSTRUCTION;2938,69118 + *(u32 *)&processor->sclength sclength2946,69333 + goto NEXTINSTRUCTION;2947,69372 + arg4 2955,69595 + arg4 2957,69652 + *(u64 *)&processor->dbcbase dbcbase2958,69674 + goto NEXTINSTRUCTION;2959,69712 + arg4 2967,69938 + arg4 2969,69995 + *(u64 *)&processor->dbcmask dbcmask2970,70017 + goto NEXTINSTRUCTION;2971,70055 + *(u32 *)&processor->choiceptr choiceptr2979,70251 + goto NEXTINSTRUCTION;2980,70291 + *(u32 *)&processor->sstkchoiceptr sstkchoiceptr2988,70519 + goto NEXTINSTRUCTION;2989,70563 + *(u32 *)&processor->fepmodetrapvecaddress fepmodetrapvecaddress2997,70796 + goto NEXTINSTRUCTION;2998,70848 + goto NEXTINSTRUCTION;3006,71057 + arg5 3014,71223 + arg2 3015,71235 + goto illegaloperand;3016,71248 + arg1 3042,71965 + r0 3044,72036 + *(u64 *)&processor->cp cp3045,72086 + *(u64 *)&processor->epc epc3046,72118 + *(u64 *)&processor->sp sp3047,72151 + *(u64 *)&processor->fp fp3048,72183 + *(u64 *)&processor->lp lp3049,72215 + r9 3050,72247 + r10 3051,72283 + r11 3052,72321 + r12 3053,72359 + r13 3054,72397 + r15 3055,72435 + r27 3056,72473 + r29 3057,72511 + pv 3058,72549 + r0 3059,72560 + r9 3060,72619 + r10 3061,72655 + r11 3062,72693 + r12 3063,72731 + r13 3064,72769 + r15 3065,72807 + r27 3066,72845 + r29 3067,72883 + iCP 3068,72921 + iPC 3069,72955 + iSP 3070,72990 + iFP 3071,73024 + iLP 3072,73058 + t1 3074,73136 + t1 3075,73154 + iSP 3079,73263 + t1 3080,73280 + t1 3081,73297 + *(u64 *)iSP 3083,73359 + goto NEXTINSTRUCTION;3084,73379 + arg5 3088,73453 + arg2 3089,73465 + goto illegaloperand;3090,73478 + arg1 3115,74154 + arg2 3118,74257 + iSP 3120,74298 + t2 3121,74315 + t2 3122,74379 + t1 3127,74549 + t2 3128,74569 + t1 3129,74595 + t3 3130,74611 + t3 3132,74669 + t1 3136,74765 + iSP 3138,74804 + *(u64 *)&processor->continuation continuation3140,74858 + *(u64 *)&processor->continuationcp continuationcp3141,74899 + t1 3143,74963 + t2 3145,75002 + iSP 3147,75047 + t1 3148,75064 + t3 3149,75080 + t3 3151,75130 + t2 3155,75230 + iFP 3156,75278 + t2 3158,75365 + iFP 3160,75405 + t1 3162,75448 + t2 3164,75487 + iSP 3166,75532 + t1 3167,75549 + t3 3168,75565 + t3 3170,75615 + t2 3174,75715 + iLP 3175,75763 + t2 3177,75850 + iLP 3179,75890 + t1 3182,76012 + t2 3184,76076 + t1 3186,76129 + t2 3190,76218 + t1 3195,76385 + t2 3197,76456 + t2 3198,76482 + t3 3199,76498 + t2 3201,76575 + t1 3203,76644 + t2 3205,76704 + t1 3210,76899 + t2 3211,76919 + t1 3212,76945 + t3 3213,76961 + t3 3215,77009 + t1 3219,77104 + iSP 3221,77143 + t1 3222,77160 + *(u32 *)&processor->control control3223,77176 + goto g8193;3224,77212 + t2 3228,77268 + t2 3229,77317 + iPC 3236,77616 + t1 3237,77666 + *(u64 *)&processor->cp cp3238,77713 + *(u64 *)&processor->epc epc3239,77745 + *(u64 *)&processor->sp sp3240,77778 + *(u64 *)&processor->fp fp3241,77810 + *(u64 *)&processor->lp lp3242,77842 + r9 3243,77874 + r10 3244,77910 + r11 3245,77948 + r12 3246,77986 + r13 3247,78024 + r15 3248,78062 + r27 3249,78100 + r29 3250,78138 + pv 3251,78176 + r0 3252,78187 + r9 3253,78246 + r10 3254,78282 + r11 3255,78320 + r12 3256,78358 + r13 3257,78396 + r15 3258,78434 + r27 3259,78472 + r29 3260,78510 + iCP 3261,78548 + iPC 3262,78582 + iSP 3263,78617 + iFP 3264,78651 + iLP 3265,78685 + goto ICACHEMISS;3267,78775 + goto g8193;3268,78794 + t2 3272,78850 + t2 3273,78903 + arg2 3278,79038 + t1 3280,79101 + t2 3283,79208 + t4 3285,79281 + t3 3286,79322 + t3 3287,79340 + t2 3289,79404 + t2 3290,79442 + t2 3291,79458 + t3 3293,79495 + t2 3295,79532 + t4 3297,79575 + t2 3299,79617 + t3 3300,79633 + t3 3302,79711 + *(u64 *)&((CACHELINEP)t2)->pcdata pcdata3307,79811 + goto g8193;3312,79977 + t2 3316,80033 + t2 3317,80094 + arg2 3322,80256 + t8 3323,80276 + t8 3324,80308 + t7 3325,80326 + t7 3327,80401 + t8 3329,80454 + t8 3331,80537 + *(u64 *)&((ARRAYCACHEP)t7)->array array3335,80624 + goto g8193;3339,80730 + r0 3345,80868 + *(u64 *)&processor->cp cp3346,80919 + *(u64 *)&processor->epc epc3347,80951 + *(u64 *)&processor->sp sp3348,80984 + *(u64 *)&processor->fp fp3349,81016 + *(u64 *)&processor->lp lp3350,81048 + r9 3351,81080 + r10 3352,81116 + r11 3353,81154 + r12 3354,81192 + r13 3355,81230 + r15 3356,81268 + r27 3357,81306 + r29 3358,81344 + pv 3359,81382 + r0 3360,81393 + r9 3361,81452 + r10 3362,81488 + r11 3363,81526 + r12 3364,81564 + r13 3365,81602 + r15 3366,81640 + r27 3367,81678 + r29 3368,81716 + iCP 3369,81754 + iPC 3370,81788 + iSP 3371,81823 + iFP 3372,81857 + iLP 3373,81891 + goto g8193;3377,82008 + goto NEXTINSTRUCTION;3384,82106 + arg5 3388,82212 + arg2 3389,82224 + goto illegaloperand;3390,82237 + arg5 3394,82332 + arg2 3395,82344 + goto illegaloperand;3396,82357 + arg5 3400,82442 + arg2 3401,82454 + goto illegaloperand;3402,82467 + arg5 3406,82552 + arg2 3407,82564 + goto illegaloperand;3408,82577 + arg5 3412,82652 + arg2 3413,82664 + goto illegaloperand;3414,82677 + goto *ra;ra3423,82873 + arg1 3431,82990 + arg1 3432,83002 + arg1 3436,83081 + goto *ra;ra3439,83146 + +stub/ifuntran.c,1271 + t1 12,434 + r0 14,502 + iSP 16,577 + *(u64 *)&processor->linkage linkage17,618 + goto *t1;t118,656 + t1 27,824 + r0 29,892 + iSP 31,967 + *(u64 *)&processor->linkage linkage32,1008 + t1 34,1083 + r0 36,1151 + iSP 38,1226 + *(u64 *)&processor->linkage linkage39,1267 + goto *t1;t140,1305 + sp 48,1436 + *(u64 *)&processor->linkage linkage49,1452 + t11 50,1488 + t12 52,1577 + r0 53,1616 + *(u64 *)&processor->restartsp restartsp54,1631 + *(u64 *)sp 55,1670 + r0 56,1689 + goto carinternal;57,1715 + r0 59,1747 + *(u64 *)&processor->linkage linkage60,1766 + sp 61,1804 + goto *r0;r062,1819 + sp 70,1951 + *(u64 *)&processor->linkage linkage71,1967 + t11 72,2003 + t12 74,2092 + r0 75,2131 + *(u64 *)&processor->restartsp restartsp76,2146 + *(u64 *)sp 77,2185 + r0 78,2204 + goto cdrinternal;79,2230 + r0 81,2262 + *(u64 *)&processor->linkage linkage82,2281 + sp 83,2319 + goto *r0;r084,2334 + sp 92,2475 + *(u64 *)&processor->linkage linkage93,2491 + t11 94,2527 + t12 96,2616 + r0 97,2655 + *(u64 *)&processor->restartsp restartsp98,2670 + *(u64 *)sp 99,2709 + r0 100,2728 + goto carcdrinternal;101,2754 + r0 103,2789 + *(u64 *)&processor->linkage linkage104,2808 + sp 105,2846 + goto *r0;r0106,2861 + +stub/ifuntrap.c,21880 + t1 13,486 + t3 15,554 + t2 17,641 + t3 19,727 + t2 21,795 + *(u64 *)&processor->vma vma23,835 + t2 25,905 + t3 29,1003 + t3 33,1110 + t3 37,1213 + goto buserror;41,1309 + t4 49,1452 + t4 50,1491 + t2 52,1550 + t3 53,1598 + t2 55,1684 + t3 57,1724 + t6 58,1746 + t5 59,1772 + t6 60,1798 + t2 61,1814 + t1 62,1839 + t2 63,1865 + iSP 65,1900 + t1 66,1941 + t4 68,2005 + t3 70,2029 + t3 76,2184 + t3 78,2234 + t1 85,2342 + t4 86,2392 + t1 88,2445 + arg1 89,2461 + t5 90,2483 + t3 91,2498 + t4 93,2541 + t4 97,2617 + arg5 98,2657 + arg2 99,2669 + goto illegaloperand;100,2682 + t8 108,2812 + t10 109,2860 + t9 110,2880 + t6 111,2918 + t7 112,2936 + t8 114,2982 + t11 115,2998 + t9 117,3061 + t6 118,3097 + t7 119,3116 + t10 124,3187 + t11 125,3207 + t10 126,3233 + t8 135,3363 + t10 136,3411 + t9 137,3431 + arg1 138,3469 + t3 139,3489 + t8 141,3535 + t11 142,3551 + t9 144,3614 + arg1 145,3650 + t3 146,3673 + t10 151,3744 + t11 152,3764 + t10 153,3790 + arg1 154,3816 + t10 163,3940 + t12 164,3989 + t11 165,4011 + t9 166,4050 + t8 167,4068 + t10 169,4114 + t11 171,4152 + t9 172,4191 + t8 173,4210 + t10 178,4282 + t12 179,4328 + t10 180,4348 + t12 181,4374 + t9 187,4462 + t8 188,4478 + t8 189,4495 + t10 190,4511 + t9 191,4533 + t12 192,4551 + t11 193,4571 + t12 194,4607 + t12 198,4686 + t11 199,4705 + t10 201,4773 + t11 203,4839 + t10 205,4877 + *(u32 *)t9 206,4916 + t3 213,5039 + t3 214,5055 + t1 215,5072 + *(u32 *)&processor->bindingstackpointer bindingstackpointer217,5104 + t4 218,5152 + *(u32 *)&processor->control control219,5168 + t1 220,5204 + t3 221,5254 + t2 225,5355 + t3 226,5396 + t3 227,5411 + t2 228,5437 + *(u32 *)&processor->interruptreg interruptreg229,5453 + *(u64 *)&processor->stop_interpreter stop_interpreter232,5525 + t3 237,5655 + t1 239,5714 + t3 240,5731 + arg1 241,5756 + t2 242,5794 + t2 243,5813 + t2 244,5830 + t3 246,5864 + t3 247,5880 + iSP 251,5979 + t4 253,6024 + t4 254,6063 + t2 256,6122 + t3 257,6170 + t2 259,6256 + t3 261,6296 + t6 262,6318 + t5 263,6337 + t6 264,6362 + iPC 266,6419 + iPC 267,6435 + iPC 268,6453 + t1 269,6471 + arg1 270,6491 + t10 271,6511 + t5 272,6538 + t10 273,6564 + t6 275,6617 + t8 276,6634 + t7 278,6715 + t6 280,6767 + t7 282,6829 + arg1 283,6846 + t6 284,6867 + arg1 286,6930 + *(u32 *)&processor->control control287,6950 + t5 289,7005 + t5 290,7021 + t5 291,7038 + *(u64 *)&processor->catchblock catchblock292,7055 + goto interpretinstructionforbranch;293,7094 + goto dbunwindframetrap;298,7212 + t10 303,7287 + t10 305,7357 + *(u32 *)t10 307,7405 + goto g8769;310,7481 + t11 314,7537 + t10 316,7607 + t9 317,7632 + t8 319,7682 + goto g8760;320,7708 + arg1 327,7832 + goto g8759;328,7850 + t10 333,7953 + t12 336,8040 + *(u64 *)&processor->vma vma338,8101 + t12 340,8170 + t10 342,8225 + arg1 346,8284 + arg2 347,8298 + goto performmemoryaction;348,8310 + t9 352,8380 + t8 354,8449 + arg1 355,8471 + t3 357,8522 + goto g8750;358,8547 + t5 365,8671 + goto g8749;366,8689 + t11 371,8792 + t10 374,8878 + *(u64 *)&processor->vma vma376,8939 + t10 378,9006 + t11 380,9061 + arg1 384,9120 + arg2 385,9134 + goto performmemoryaction;386,9146 + t9 390,9216 + t8 392,9285 + t6 393,9307 + t7 395,9356 + goto g8740;396,9381 + t1 403,9505 + goto g8739;404,9521 + t11 409,9624 + t10 412,9710 + *(u64 *)&processor->vma vma414,9771 + t10 416,9838 + t11 418,9893 + arg1 422,9952 + arg2 423,9966 + goto performmemoryaction;424,9978 + t1 435,10367 + t1 443,10553 + t2 444,10587 + arg5 451,10740 + arg2 452,10753 + goto illegaloperand;453,10766 + t2 457,10831 + arg5 464,10986 + arg2 465,10999 + goto illegaloperand;466,11012 + t2 470,11077 + t2 476,11191 + arg5 486,11420 + arg2 487,11433 + goto illegaloperand;488,11446 + t2 492,11511 + t2 498,11626 + arg5 508,11858 + arg2 509,11871 + goto illegaloperand;510,11884 + t2 514,11949 + t2 520,12061 + arg5 530,12284 + arg2 531,12297 + goto illegaloperand;532,12310 + t2 536,12375 + t2 542,12489 + arg5 552,12696 + arg2 553,12709 + goto illegaloperand;554,12722 + t2 558,12787 + arg5 565,12930 + arg2 566,12943 + goto illegaloperand;567,12956 + t1 574,13063 + goto monitortrap;581,13227 + arg6 596,13513 + arg3 598,13550 + arg1 600,13595 + arg4 602,13634 + goto numericexception;603,13646 + arg6 608,13767 + arg3 610,13802 + arg1 612,13847 + arg4 614,13886 + goto listexception;615,13898 + arg6 620,14016 + arg3 622,14051 + arg1 624,14096 + arg4 626,14135 + goto listexception;627,14147 + t1 631,14231 + t1 633,14264 + t1 634,14281 + arg6 636,14333 + arg3 638,14368 + arg1 640,14413 + arg4 642,14452 + goto exception;643,14464 + arg6 648,14584 + arg3 650,14621 + arg1 652,14666 + arg4 654,14705 + goto unarynumericexception;655,14717 + arg6 660,14849 + arg3 662,14886 + arg1 664,14931 + arg4 666,14970 + goto unarynumericexception;667,14982 + t1 675,15137 + t1 677,15197 + goto exception;680,15249 + arg5 684,15319 + arg2 685,15331 + goto illegaloperand;686,15344 + t1 694,15504 + t1 696,15564 + goto exception;699,15621 + arg5 703,15701 + arg2 704,15713 + goto illegaloperand;705,15726 + t1 713,15867 + t1 715,15915 + goto exception;718,15965 + t1 722,16031 + t1 724,16087 + goto exception;727,16137 + arg5 731,16203 + arg2 732,16215 + goto illegaloperand;733,16228 + t1 741,16364 + t1 743,16423 + goto exception;746,16474 + t1 750,16542 + t1 752,16609 + goto exception;755,16660 + goto spareexception;759,16728 + t1 767,16865 + t1 769,16932 + goto exception;772,16983 + t1 779,17101 + t1 781,17156 + goto exception;784,17207 + goto illegaloperand;788,17275 + t2 799,17479 + iSP 801,17547 + arg2 803,17618 + t1 810,17805 + t3 812,17880 + arg5 817,18011 + t3 819,18050 + t4 821,18096 + t2 823,18170 + t4 825,18241 + arg5 833,18392 + t1 837,18481 + t3 838,18498 + t1 839,18517 + arg5 841,18571 + *(u32 *)&processor->immediate_arg immediate_arg845,18670 + t1 849,18754 + t1 850,18776 + t2 851,18801 + t3 852,18819 + t2 857,18961 + t1 858,19006 + t2 860,19095 + t2 862,19158 + t1 864,19198 + t2 865,19214 + arg5 867,19252 + arg5 868,19271 + goto g8806;869,19291 + arg5 874,19369 + iSP 879,19462 + arg2 884,19556 + arg2 886,19607 + t11 887,19628 + t1 890,19732 + t2 892,19805 + t1 893,19852 + t2 895,19900 + t2 897,19940 + *(u64 *)t1 899,19981 + t12 901,20007 + goto handleexception;902,20057 + t2 913,20245 + iSP 915,20313 + arg2 917,20384 + arg2 921,20510 + arg2 923,20553 + arg2 925,20604 + goto doublefloatexc;929,20712 + arg2 934,20813 + t1 936,20894 + t3 938,20969 + arg5 943,21100 + t3 945,21139 + t4 947,21185 + t2 949,21259 + t4 951,21330 + arg5 959,21481 + t1 963,21570 + t3 964,21587 + t1 965,21606 + arg5 967,21660 + *(u32 *)&processor->immediate_arg immediate_arg971,21759 + t1 975,21843 + t1 976,21865 + t2 977,21890 + t3 978,21908 + t2 983,22050 + t1 984,22095 + t2 986,22184 + t2 988,22247 + t1 990,22287 + t2 991,22303 + arg5 993,22341 + arg5 994,22360 + goto g8812;995,22380 + arg5 1000,22458 + iSP 1005,22551 + t4 1010,22647 + arg1 1012,22687 + t11 1013,22699 + t2 1014,22713 + arg1 1019,22830 + t11 1020,22842 + t2 1021,22869 + t11 1023,22930 + arg2 1028,23024 + t2 1029,23044 + arg2 1031,23103 + t2 1032,23125 + t11 1033,23140 + t11 1034,23164 + t11 1035,23184 + t1 1038,23297 + t2 1040,23370 + t1 1041,23427 + t2 1043,23475 + t2 1045,23515 + *(u64 *)t1 1047,23556 + t12 1049,23582 + goto handleexception;1050,23632 + t2 1058,23772 + iSP 1060,23840 + arg2 1062,23911 + t1 1069,24098 + t3 1071,24173 + arg5 1076,24304 + t3 1078,24343 + t4 1080,24389 + t2 1082,24463 + t4 1084,24534 + arg5 1092,24685 + t1 1096,24774 + t3 1097,24791 + t1 1098,24810 + arg5 1100,24864 + *(u32 *)&processor->immediate_arg immediate_arg1104,24963 + t1 1108,25047 + t1 1109,25069 + t2 1110,25094 + t3 1111,25112 + t2 1116,25254 + t1 1117,25299 + t2 1119,25388 + t2 1121,25451 + t1 1123,25491 + t2 1124,25507 + arg5 1126,25545 + arg5 1127,25564 + goto g8818;1128,25584 + arg5 1133,25662 + iSP 1138,25755 + arg2 1143,25849 + arg2 1145,25900 + t11 1146,25921 + t1 1149,26025 + t2 1151,26098 + t1 1152,26145 + t2 1154,26193 + t2 1156,26233 + *(u64 *)t1 1158,26274 + t12 1160,26300 + goto handleexception;1161,26314 + t1 1170,26485 + t4 1171,26497 + t9 1172,26533 + t8 1173,26585 + t5 1174,26627 + t6 1175,26650 + t5 1177,26694 + t6 1178,26710 + *(u32 *)&processor->control control1179,26725 + t7 1180,26761 + t8 1181,26776 + *(u64 *)&processor->tvi tvi1185,26865 + t9 1190,26962 + t6 1191,27010 + t7 1192,27029 + t3 1193,27067 + t2 1194,27084 + t9 1196,27129 + t5 1197,27145 + t7 1199,27207 + t3 1200,27243 + t2 1201,27262 + t6 1206,27332 + t5 1207,27351 + t6 1208,27375 + t3 1209,27399 + t5 1214,27453 + t5 1216,27511 + *(u32 *)&processor->control control1220,27581 + t8 1222,27659 + t5 1223,27697 + t6 1225,27750 + t5 1227,27840 + t5 1229,27891 + t6 1231,27950 + t8 1232,27972 + iFP 1236,28087 + iFP 1237,28114 + iFP 1238,28133 + t5 1241,28183 + arg1 1243,28230 + t5 1246,28282 + arg1 1248,28336 + t5 1251,28388 + arg1 1253,28443 + t5 1256,28495 + arg1 1258,28549 + iSP 1262,28610 + t5 1263,28628 + t7 1264,28669 + t5 1265,28716 + t8 1266,28732 + t4 1267,28753 + t7 1268,28769 + *(u32 *)iFP 1269,28786 + t8 1272,28862 + t8 1273,28878 + t6 1274,28894 + t8 1275,28919 + iLP 1279,29018 + t6 1280,29035 + t8 1281,29055 + t6 1286,29194 + t8 1288,29253 + t6 1289,29270 + t7 1294,29399 + t5 1296,29457 + t6 1298,29515 + t8 1300,29559 + t6 1302,29602 + t8 1304,29662 + t5 1305,29678 + t5 1306,29694 + t9 1308,29726 + t6 1309,29742 + t8 1310,29759 + t6 1313,29808 + t4 1315,29856 + t4 1317,29894 + t4 1319,29961 + *(u32 *)&processor->control control1320,29977 + t6 1322,30056 + t8 1324,30115 + t6 1325,30132 + *(u64 *)&processor->continuationcp continuationcp1326,30157 + *(u32 *)&processor->continuation continuation1328,30249 + iPC 1330,30331 + iPC 1331,30347 + iPC 1332,30365 + t6 1334,30414 + t4 1336,30457 + t8 1338,30506 + t9 1340,30589 + t8 1345,30745 + t9 1347,30804 + t4 1348,30849 + t9 1350,30938 + t9 1352,31000 + t4 1354,31040 + t9 1356,31083 + iCP 1362,31264 + t9 1364,31339 + t8 1365,31380 + t8 1366,31398 + iCP 1368,31462 + iCP 1369,31502 + iCP 1370,31521 + t8 1372,31560 + iCP 1374,31598 + t9 1376,31643 + iCP 1378,31685 + goto cachevalid;1379,31703 + goto fatalstackoverflow;1386,31849 + arg2 1390,31918 + goto stackcacheoverflowhandler;1391,31930 + t7 1395,32006 + t9 1397,32075 + t3 1398,32097 + t2 1400,32146 + goto g8824;1401,32171 + t8 1408,32294 + goto g8823;1409,32310 + t5 1414,32413 + t6 1417,32498 + *(u64 *)&processor->vma vma1419,32558 + t6 1421,32625 + t5 1423,32677 + t6 1427,32738 + t2 1430,32804 + t2 1431,32822 + goto g8834;1432,32865 + t6 1441,32965 + t7 1442,32998 + t9 1445,33067 + t6 1446,33083 + t9 1448,33140 + t7 1449,33156 + t7 1450,33166 + t9 1451,33203 + t9 1453,33258 + t7 1454,33274 + t9 1456,33318 + t3 1458,33357 + t6 1460,33398 + t8 1465,33518 + goto g8823;1466,33534 + goto dbcachemisstrap;1470,33590 + arg1 1475,33659 + arg2 1476,33672 + goto performmemoryaction;1477,33684 + goto illegaltrapvector;1481,33754 + *(u64 *)&processor->restartsp restartsp1489,33892 + t1 1491,33962 + t4 1492,33974 + t9 1493,34010 + t8 1494,34062 + t5 1495,34104 + t6 1496,34127 + t5 1498,34171 + t6 1499,34187 + *(u32 *)&processor->control control1500,34202 + t7 1501,34238 + t8 1502,34253 + *(u64 *)&processor->tvi tvi1506,34363 + t9 1511,34460 + t6 1512,34508 + t7 1513,34527 + t3 1514,34565 + t2 1515,34582 + t9 1517,34627 + t5 1518,34643 + t7 1520,34705 + t3 1521,34741 + t2 1522,34760 + t6 1527,34830 + t5 1528,34849 + t6 1529,34873 + t3 1530,34897 + t5 1535,34951 + t5 1537,35009 + *(u32 *)&processor->control control1541,35079 + t8 1543,35157 + t5 1544,35195 + t6 1546,35248 + t5 1548,35338 + t5 1550,35389 + t6 1552,35448 + t8 1553,35470 + iFP 1557,35585 + iFP 1558,35612 + iFP 1559,35631 + t5 1562,35681 + t5 1566,35761 + t5 1570,35848 + t5 1574,35936 + iSP 1579,36032 + t5 1580,36050 + t7 1581,36091 + t5 1582,36138 + t8 1583,36154 + t4 1584,36175 + t7 1585,36191 + *(u32 *)iFP 1586,36208 + t8 1589,36284 + t8 1590,36300 + t6 1591,36316 + t8 1592,36341 + iLP 1596,36440 + t6 1597,36457 + t8 1598,36477 + t6 1603,36637 + t8 1605,36696 + t6 1606,36713 + t7 1611,36842 + t5 1613,36900 + t6 1615,36958 + t8 1617,37002 + t6 1619,37045 + t8 1621,37105 + t5 1622,37121 + t5 1623,37137 + t9 1625,37169 + t6 1626,37185 + t8 1627,37202 + t6 1630,37251 + t4 1632,37299 + t4 1634,37337 + t4 1636,37404 + *(u32 *)&processor->control control1637,37420 + t6 1639,37499 + t8 1641,37558 + t6 1642,37575 + *(u64 *)&processor->continuationcp continuationcp1643,37600 + *(u32 *)&processor->continuation continuation1645,37692 + iPC 1647,37774 + iPC 1648,37790 + iPC 1649,37808 + t6 1651,37857 + t4 1653,37900 + t8 1655,37949 + t9 1657,38032 + t8 1662,38188 + t9 1664,38247 + t4 1665,38292 + t9 1667,38381 + t9 1669,38443 + t4 1671,38483 + t9 1673,38526 + iCP 1679,38707 + t9 1681,38782 + t8 1682,38823 + t8 1683,38841 + iCP 1685,38905 + iCP 1686,38945 + iCP 1687,38964 + t8 1689,39003 + iCP 1691,39041 + t9 1693,39086 + iCP 1695,39128 + goto cachevalid;1696,39146 + goto fatalstackoverflow;1703,39292 + arg2 1707,39361 + goto stackcacheoverflowhandler;1708,39373 + t7 1712,39449 + t9 1714,39518 + t3 1715,39540 + t2 1717,39589 + goto g8840;1718,39614 + t8 1725,39737 + goto g8839;1726,39753 + t5 1731,39856 + t6 1734,39941 + *(u64 *)&processor->vma vma1736,40001 + t6 1738,40068 + t5 1740,40120 + t6 1744,40181 + t2 1747,40247 + t2 1748,40265 + goto g8850;1749,40308 + t6 1758,40408 + t7 1759,40441 + t9 1762,40510 + t6 1763,40526 + t9 1765,40583 + t7 1766,40599 + t7 1767,40609 + t9 1768,40646 + t9 1770,40701 + t7 1771,40717 + t9 1773,40761 + t3 1775,40800 + t6 1777,40841 + t8 1782,40961 + goto g8839;1783,40977 + goto dbcachemisstrap;1787,41033 + arg1 1792,41102 + arg2 1793,41115 + goto performmemoryaction;1794,41127 + goto illegaltrapvector;1798,41197 + t2 1806,41330 + t4 1809,41409 + t9 1810,41445 + t8 1811,41497 + t5 1812,41539 + t6 1813,41562 + t5 1815,41606 + t6 1816,41622 + *(u32 *)&processor->control control1817,41637 + t7 1818,41673 + t8 1819,41688 + *(u64 *)&processor->tvi tvi1823,41777 + t9 1828,41874 + t6 1829,41922 + t7 1830,41941 + t3 1831,41979 + t2 1832,41996 + t9 1834,42041 + t5 1835,42057 + t7 1837,42119 + t3 1838,42155 + t2 1839,42174 + t6 1844,42244 + t5 1845,42263 + t6 1846,42287 + t3 1847,42311 + t5 1852,42365 + t5 1854,42423 + *(u32 *)&processor->control control1858,42493 + iSP 1859,42529 + t7 1861,42612 + t4 1862,42650 + t5 1864,42703 + t4 1866,42793 + t4 1868,42844 + t5 1870,42903 + t7 1871,42925 + t5 1875,43040 + t4 1876,43081 + t5 1877,43128 + t7 1878,43144 + t7 1879,43180 + t4 1880,43196 + iSP 1884,43296 + t6 1885,43313 + iSP 1889,43421 + t6 1890,43438 + t8 1891,43450 + iSP 1895,43553 + t6 1897,43613 + t8 1899,43672 + t6 1900,43689 + *(u32 *)&processor->continuation continuation1902,43761 + *(u64 *)&processor->continuationcp continuationcp1903,43802 + t9 1905,43867 + iSP 1909,43966 + goto *r0;r01910,43983 + arg2 1914,44047 + goto stackcacheoverflowhandler;1915,44059 + t7 1919,44135 + t9 1921,44204 + t3 1922,44226 + t2 1924,44275 + goto g8854;1925,44300 + t8 1932,44423 + goto g8853;1933,44439 + t5 1938,44542 + t6 1941,44627 + *(u64 *)&processor->vma vma1943,44687 + t6 1945,44754 + t5 1947,44806 + t6 1951,44867 + t2 1954,44933 + t2 1955,44951 + goto g8864;1956,44994 + t6 1965,45094 + t7 1966,45127 + t9 1969,45196 + t6 1970,45212 + t9 1972,45269 + t7 1973,45285 + t7 1974,45295 + t9 1975,45332 + t9 1977,45387 + t7 1978,45403 + t9 1980,45447 + t3 1982,45486 + t6 1984,45527 + t8 1989,45647 + goto g8853;1990,45663 + goto dbcachemisstrap;1994,45719 + arg1 1999,45788 + arg2 2000,45801 + goto performmemoryaction;2001,45813 + goto illegaltrapvector;2005,45883 + iFP 2013,46018 + iFP 2015,46112 + iLP 2017,46169 + t4 2019,46206 + t5 2021,46264 + t6 2023,46322 + t8 2025,46366 + t6 2027,46409 + t8 2029,46469 + t5 2030,46485 + t5 2031,46501 + t9 2033,46533 + t6 2034,46549 + t8 2035,46566 + t6 2038,46615 + t7 2040,46663 + t7 2042,46701 + t7 2044,46768 + *(u32 *)&processor->control control2045,46784 + iPC 2047,46861 + iPC 2048,46877 + iPC 2049,46895 + t7 2052,46972 + t8 2054,47021 + t9 2056,47104 + t8 2061,47260 + t9 2063,47319 + t7 2064,47364 + t9 2066,47453 + t9 2068,47515 + t7 2070,47555 + t9 2072,47598 + iCP 2078,47787 + t9 2080,47862 + t8 2081,47903 + t8 2082,47921 + iCP 2084,47985 + iCP 2085,48025 + iCP 2086,48044 + t8 2088,48083 + iCP 2090,48121 + t9 2092,48166 + iCP 2094,48208 + goto cachevalid;2095,48226 + t1 2105,48414 + t2 2107,48487 + t1 2108,48517 + t2 2110,48565 + t2 2112,48605 + *(u64 *)t1 2114,48646 + t1 2117,48703 + t10 2119,48750 + r0 2120,48776 + goto startpretrap;2121,48802 + t11 2123,48835 + iSP 2127,48942 + t11 2128,48959 + iSP 2132,49068 + goto finishpretrap;2133,49085 + t1 2143,49262 + t2 2145,49335 + t1 2146,49367 + t2 2148,49415 + t2 2150,49455 + *(u64 *)t1 2152,49496 + t1 2155,49553 + t10 2157,49600 + r0 2158,49626 + goto startpretrap;2159,49652 + goto finishpretrap;2161,49685 + t1 2171,49881 + t2 2173,49954 + t1 2174,49994 + t2 2176,50042 + t2 2178,50082 + *(u64 *)t1 2180,50123 + t12 2182,50149 + t11 2183,50170 + iSP 2185,50216 + t12 2186,50233 + *(u64 *)&processor->restartsp restartsp2187,50251 + t1 2189,50321 + t10 2191,50368 + r0 2192,50402 + goto startpretrap;2193,50428 + arg2 2195,50461 + iSP 2199,50570 + arg2 2201,50608 + iSP 2205,50713 + goto finishpretrap;2206,50730 + t1 2216,50910 + t2 2218,50983 + t1 2219,51015 + t2 2221,51063 + t2 2223,51103 + *(u64 *)t1 2225,51144 + t1 2228,51201 + t10 2230,51248 + r0 2231,51274 + goto startpretrap;2232,51300 + goto finishpretrap;2234,51333 + t1 2244,51532 + t2 2246,51605 + t1 2247,51646 + t2 2249,51694 + t2 2251,51734 + *(u64 *)t1 2253,51775 + t1 2256,51832 + t10 2258,51879 + r0 2259,51914 + goto startpretrap;2260,51940 + goto finishpretrap;2262,51973 + t1 2272,52202 + t2 2274,52275 + t1 2275,52327 + t2 2277,52375 + t2 2279,52415 + *(u64 *)t1 2281,52456 + t1 2284,52513 + t10 2286,52560 + r0 2287,52606 + goto startpretrap;2288,52632 + goto finishpretrap;2290,52665 + t1 2300,52898 + t2 2302,52971 + t1 2303,53022 + t2 2305,53070 + t2 2307,53110 + *(u64 *)t1 2309,53151 + t1 2312,53208 + t10 2314,53255 + r0 2315,53300 + goto startpretrap;2316,53326 + goto finishpretrap;2318,53359 + t1 2328,53570 + t2 2330,53643 + t1 2331,53683 + t2 2333,53731 + t2 2335,53771 + *(u64 *)t1 2337,53812 + t1 2340,53869 + t10 2342,53916 + r0 2343,53950 + goto startpretrap;2344,53976 + t11 2346,54009 + t12 2347,54060 + iSP 2351,54168 + goto finishpretrap;2352,54185 + t1 2362,54389 + t2 2364,54462 + t1 2365,54502 + t2 2367,54550 + t2 2369,54590 + *(u64 *)t1 2371,54631 + t1 2374,54688 + t10 2376,54735 + r0 2377,54769 + goto startpretrap;2378,54795 + t11 2380,54828 + t12 2381,54879 + iSP 2385,54987 + goto finishpretrap;2386,55004 + t1 2396,55196 + t2 2398,55269 + t1 2399,55303 + t2 2401,55351 + t2 2403,55391 + *(u64 *)t1 2405,55432 + t11 2408,55507 + t1 2410,55573 + t10 2412,55620 + r0 2413,55650 + goto startpretrap;2414,55676 + t12 2416,55709 + iSP 2420,55817 + goto finishpretrap;2421,55834 + t1 2431,56016 + t2 2433,56089 + t1 2434,56121 + t2 2436,56169 + t2 2438,56209 + *(u64 *)t1 2440,56250 + t11 2443,56325 + t1 2445,56391 + t10 2447,56438 + r0 2448,56466 + goto startpretrap;2449,56492 + t12 2451,56525 + iSP 2455,56633 + goto finishpretrap;2456,56650 + t1 2466,56842 + t2 2468,56915 + t1 2469,56955 + t2 2471,57003 + t2 2473,57043 + *(u64 *)t1 2475,57084 + t11 2478,57159 + t1 2480,57225 + t10 2482,57272 + r0 2483,57308 + goto startpretrap;2484,57334 + t12 2486,57367 + iSP 2490,57475 + goto finishpretrap;2491,57492 + t1 2501,57712 + t2 2503,57785 + t1 2504,57826 + t2 2506,57874 + t2 2508,57914 + *(u64 *)t1 2510,57955 + t11 2513,58030 + t1 2515,58096 + t10 2517,58143 + r0 2518,58180 + goto startpretrap;2519,58206 + t12 2521,58239 + iSP 2525,58347 + goto finishpretrap;2526,58364 + t1 2536,58565 + t2 2538,58638 + t1 2539,58677 + t2 2541,58725 + t2 2543,58765 + *(u64 *)t1 2545,58806 + t11 2548,58881 + t1 2550,58947 + t10 2552,58994 + r0 2553,59029 + goto startpretrap;2554,59055 + t12 2556,59088 + iSP 2560,59196 + goto finishpretrap;2561,59213 + t1 2572,59422 + t2 2574,59495 + t1 2575,59531 + t2 2577,59579 + t2 2579,59619 + *(u64 *)t1 2581,59660 + t11 2584,59735 + t1 2586,59801 + t10 2588,59848 + r0 2589,59879 + goto startpretrap;2590,59905 + t12 2592,59938 + iSP 2596,60046 + goto finishpretrap;2597,60063 + t1 2609,60349 + t2 2611,60422 + t1 2612,60471 + t2 2614,60519 + t2 2616,60559 + *(u64 *)t1 2618,60600 + t11 2621,60675 + t1 2623,60741 + t10 2625,60788 + r0 2626,60833 + goto startpretrap;2627,60859 + t12 2629,60892 + iSP 2633,61000 + goto finishpretrap;2634,61017 + t1 2644,61201 + t2 2646,61274 + t1 2647,61313 + t2 2649,61361 + t2 2651,61401 + *(u64 *)t1 2653,61442 + t11 2656,61517 + t1 2658,61583 + t10 2660,61630 + r0 2661,61665 + goto startpretrap;2662,61691 + t12 2664,61724 + iSP 2668,61832 + goto finishpretrap;2669,61849 + +stub/ihalt.c,1155 + t4 15,536 + *(u64 *)&processor->restartsp restartsp17,607 + r0 19,692 + t5 20,745 + *(u64 *)&processor->please_stop please_stop21,758 + t5 22,809 + *(u64 *)&processor->stop_interpreter stop_interpreter25,854 + t3 29,957 + r0 34,1141 + t4 36,1206 + t3 37,1223 + t4 45,1467 + goto highprioritysequencebreak;48,1573 + t3 52,1649 + goto lowprioritysequencebreak;62,1927 + t5 69,2110 + goto preemptrequesttrap;76,2361 + t1 84,2513 + goto stopinterp;85,2529 + t1 89,2616 + goto stopinterp;90,2644 + t1 94,2717 + goto stopinterp;95,2743 + t1 99,2830 + goto stopinterp;100,2868 + t1 104,2953 + goto stopinterp;105,2990 + r0 110,3092 + *(u32 *)&processor->please_stop please_stop112,3134 + *(u64 *)&processor->cp cp113,3176 + *(u64 *)&processor->epc epc114,3208 + *(u64 *)&processor->sp sp115,3241 + *(u64 *)&processor->fp fp116,3273 + *(u64 *)&processor->lp lp117,3305 + *(u64 *)&processor->runningp runningp119,3370 + r9 120,3409 + r10 121,3445 + r11 122,3483 + r12 123,3521 + r13 124,3559 + r15 125,3597 + r26 126,3635 + r27 127,3673 + r29 128,3711 + r30 129,3749 + r14 130,3787 + goto *ra;ra131,3825 + +stub/stub.c,2900 +#define _GNU_SOURCE4,35 +typedef unsigned char u8;23,324 +typedef unsigned short u16;24,350 +typedef unsigned int u32;25,378 +typedef unsigned long u64;26,404 +typedef char s8;28,432 +typedef int s32;29,449 +typedef long s64;30,466 +#define MemoryActionIndirect 32,485 +#define MemoryActionMonitor 33,517 +#define MemoryActionTransport 34,548 +#define MemoryActionTrap 35,581 +#define MemoryActionTransform 36,610 +#define MemoryActionBinding 37,644 +#define CACHELINESIZE 39,677 +#define TWOCACHELINESIZE 40,703 +#define FOURCACHELINESIZE 41,746 +#define AutoArrayRegMask 43,791 +#define AutoArrayRegSize 44,820 +#define AutoArrayRegShift 45,848 +#define PROCESSORSTATE_DATAREAD 47,877 +#define PROCESSORSTATE_DATAREAD_MASK 48,915 +#define r1 97,1699 +#define r2 98,1716 +#define r3 99,1733 +#define r4 100,1748 +#define r5 101,1763 +#define r6 102,1781 +#define r7 103,1796 +#define r8 104,1811 +#define r30 108,1970 +#define zero 112,2025 +#define t1 114,2043 +#define t2 115,2057 +#define t3 116,2071 +#define t4 117,2085 +#define t5 118,2099 +#define t6 119,2113 +#define t7 120,2127 +#define t8 121,2141 +#define iPC 122,2155 +#define iFP 123,2170 +#define iLP 124,2186 +#define iSP 125,2202 +#define iCP 126,2218 +#define arg1 127,2235 +#define arg2 128,2252 +#define arg3 129,2269 +#define arg4 130,2286 +#define arg5 131,2303 +#define arg6 132,2320 +#define t9 133,2337 +#define t10 134,2352 +#define t11 135,2368 +#define t12 136,2384 +#define ra 137,2400 +#define pv 138,2415 +#define gp 139,2430 +#define hwopmask 151,2616 +#define fwdispatch 152,2637 +#define hwdispatch 153,2660 +#define rdtscll(155,2684 +#define LDQ_U(160,2810 +#define STQ_U(161,2849 +static u64 f0,163,2896 +static u64 f0, f1,163,2896 +static u64 f0, f1, f2,163,2896 +static u64 f0, f1, f2, f3,163,2896 +static u64 f0, f1, f2, f3, f31;163,2896 +inline u64 CMPBGE(169,2969 +#define CHECK_OFLO32(190,3267 +#define CHECK_OFLO(203,3820 +int8_t oflo;207,3894 +void exception(209,3908 +char *halfwordnames[halfwordnames215,4037 +dumpstack(476,27923 +void *arexp arexp501,28294 +uint64_t iipsp 502,28308 +uint32_t _lastcode 506,28399 +uint64_t _lastinststart 507,28429 +struct rusage _rusage 508,28458 +uint64_t _exectimes[_exectimes509,28482 +int iInterpret 513,28539 +show_loc(586,30180 + processor 624,30871 + processor->halfworddispatch=halfworddispatch634,31311 + processor->fullworddispatch=fullworddispatch635,31369 + processor->internalregisterread1 internalregisterread1637,31428 + processor->internalregisterread2 internalregisterread2638,31498 + processor->internalregisterwrite1 internalregisterwrite1639,31568 + processor->internalregisterwrite2 internalregisterwrite2640,31640 +processor->stop_interpreter stop_interpreter642,31713 + arg1 644,31747 + ra 645,31769 + sp 647,31798 + DECODEFAULT 664,32082 + ICACHEMISS 665,32115 + goto iinterpret;669,32158 +void SpinWheels 707,32911 + +alpha-emulator/aistat.h,10764 +#define _AISTAT_5,172 +typedef struct processorstate 9,192 + uint64_t transpare3;10,224 + uint64_t transpare2;11,252 + uint64_t transpare1;12,280 + uint64_t carcdrsubroutine;13,308 + uint64_t cdrsubroutine;14,342 + uint64_t carsubroutine;15,373 + uint64_t linkage;16,404 + uint64_t resumeema;17,429 + char *statistics;statistics18,456 + char *trace_hook;trace_hook19,484 + int64_t instruction_count;20,512 + uint64_t long_pad0;21,547 + uint64_t asrr9;22,574 + uint64_t asrr10;23,597 + uint64_t asrr11;24,621 + uint64_t asrr12;25,645 + uint64_t asrr13;26,669 + uint64_t asrr14;27,693 + uint64_t asrr15;28,717 + uint64_t long_pad1;29,741 + uint64_t asrr26;30,768 + uint64_t asrr27;31,792 + uint64_t asrr29;32,816 + uint64_t asrr30;33,840 + uint64_t asrf2;34,864 + uint64_t asrf3;35,887 + uint64_t asrf4;36,910 + uint64_t asrf5;37,933 + uint64_t asrf6;38,956 + uint64_t asrf7;39,979 + uint64_t asrf8;40,1002 + uint64_t asrf9;41,1025 + char *meterdatabuff;meterdatabuff42,1048 + uint32_t meterpos;43,1079 + uint32_t metermax;44,1105 + uint32_t meterfreq;45,1131 + uint32_t metermask;46,1158 + uint32_t metervalue;47,1185 + uint32_t metercount;48,1213 + uint64_t choiceptr;49,1241 + uint64_t sstkchoiceptr;50,1268 + uint64_t dbcbase;51,1299 + uint64_t dbcmask;52,1324 + char *coprocessorreadhook;coprocessorreadhook53,1349 + char *coprocessorwritehook;coprocessorwritehook54,1386 + char *flushcaches_hook;flushcaches_hook55,1424 + char *i_stage_error_hook;i_stage_error_hook56,1458 + uint64_t sfp1;57,1494 + uint64_t fp0;58,1516 + uint64_t fp1;59,1537 + uint64_t floating_exception;60,1558 + uint64_t aluandrotatecontrol;61,1594 + uint64_t rotatelatch;62,1631 + uint64_t aluborrow;63,1660 + uint64_t aluoverflow;64,1687 + uint64_t alulessthan;65,1716 + uint64_t aluop;66,1745 + uint64_t byterotate;67,1768 + uint64_t bytesize;68,1796 + int64_t bindingstacklimit;69,1822 + int64_t bindingstackpointer;70,1857 + uint64_t catchblock;71,1894 + uint64_t extraandcatch;72,1922 + uint64_t msclockcache;73,1953 + uint64_t mscmultiplier;74,1983 + uint64_t previousrcpp;75,2014 + char *rlink;rlink76,2044 + uint32_t interruptreg;77,2067 + uint32_t zoneoldspace;78,2097 + uint32_t ephemeraloldspace;79,2127 + uint32_t int_pad0;80,2162 + uint64_t eqnoteql;81,2188 + uint32_t lclength;82,2214 + uint32_t sclength;83,2240 + uint64_t lcarea;84,2266 + uint64_t lcaddress;85,2290 + uint64_t scarea;86,2317 + uint64_t scaddress;87,2341 + uint64_t restartsp;88,2368 + uint64_t stop_interpreter;89,2395 + uint64_t immediate_arg;90,2429 + uint64_t continuationcp;91,2460 + int64_t continuation;92,2492 + int64_t control;93,2522 + int64_t niladdress;94,2547 + int64_t taddress;95,2575 + int64_t bar0;96,2601 + int64_t bar1;97,2623 + int64_t bar2;98,2645 + int64_t bar3;99,2667 + int64_t epc;100,2689 + int64_t fp;101,2710 + int64_t lp;102,2730 + int64_t sp;103,2750 + char *cp;cp104,2770 + uint64_t fccrmask;105,2790 + uint32_t cslimit;106,2816 + uint32_t csextralimit;107,2841 + char *trapmeterdata;trapmeterdata108,2871 + uint64_t fepmodetrapvecaddress;109,2902 + uint64_t trapvecbase;110,2941 + uint64_t tvi;111,2970 + uint64_t fccrtrapmask;112,2991 + char *ptrtype;ptrtype113,3021 + char *vmattributetable;vmattributetable114,3046 + uint64_t vma;115,3080 + int64_t mostnegativefixnum;116,3101 + char *icachebase;icachebase117,3137 + char *endicache;endicache118,3165 + uint64_t fullworddispatch;119,3192 + uint64_t halfworddispatch;120,3226 + int64_t areventcount;121,3260 + uint64_t stackcachesize;122,3290 + uint64_t stackcachetopvma;123,3322 + uint64_t cdrcodemask;124,3356 + char *stackcachedata;stackcachedata125,3385 + uint64_t stackcachebasevma;126,3417 + uint32_t scovlimit;127,3452 + uint32_t scovdumpcount;128,3479 + int64_t mostpositivefixnum;129,3510 + uint64_t internalregisterread1;130,3546 + uint64_t internalregisterread2;131,3585 + uint64_t internalregisterwrite1;132,3624 + uint64_t internalregisterwrite2;133,3664 + uint64_t dataread_mask;134,3704 + char *dataread;dataread135,3735 + uint64_t datawrite_mask;136,3761 + char *datawrite;datawrite137,3793 + uint64_t bindread_mask;138,3820 + char *bindread;bindread139,3851 + uint64_t bindwrite_mask;140,3877 + char *bindwrite;bindwrite141,3909 + uint64_t bindreadnomonitor_mask;142,3936 + char *bindreadnomonitor;bindreadnomonitor143,3976 + uint64_t bindwritenomonitor_mask;144,4011 + char *bindwritenomonitor;bindwritenomonitor145,4052 + uint64_t header_mask;146,4088 + char *header;header147,4117 + uint64_t structureoffset_mask;148,4141 + char *structureoffset;structureoffset149,4179 + uint64_t scavenge_mask;150,4212 + char *scavenge;scavenge151,4243 + uint64_t cdr_mask;152,4269 + char *cdr;cdr153,4295 + uint64_t gccopy_mask;154,4316 + char *gccopy;gccopy155,4345 + uint64_t raw_mask;156,4369 + char *raw;raw157,4395 + uint64_t rawtranslate_mask;158,4416 + char *rawtranslate;rawtranslate159,4451 + int32_t please_stop;160,4481 + int32_t please_trap;161,4510 + int64_t runningp;162,4539 + uint64_t ac0array;163,4565 + uint64_t ac0arword;164,4591 + uint64_t ac0locat;165,4618 + uint64_t ac0length;166,4644 + uint64_t ac1array;167,4671 + uint64_t ac1arword;168,4697 + uint64_t ac1locat;169,4724 + uint64_t ac1length;170,4750 + uint64_t ac2array;171,4777 + uint64_t ac2arword;172,4803 + uint64_t ac2locat;173,4830 + uint64_t ac2length;174,4856 + uint64_t ac3array;175,4883 + uint64_t ac3arword;176,4909 + uint64_t ac3locat;177,4936 + uint64_t ac3length;178,4962 + uint64_t ac4array;179,4989 + uint64_t ac4arword;180,5015 + uint64_t ac4locat;181,5042 + uint64_t ac4length;182,5068 + uint64_t ac5array;183,5095 + uint64_t ac5arword;184,5121 + uint64_t ac5locat;185,5148 + uint64_t ac5length;186,5174 + uint64_t ac6array;187,5201 + uint64_t ac6arword;188,5227 + uint64_t ac6locat;189,5254 + uint64_t ac6length;190,5280 + uint64_t ac7array;191,5307 + uint64_t ac7arword;192,5333 + uint64_t ac7locat;193,5360 + uint64_t ac7length;194,5386 + uint32_t tmcurrenttransaction;195,5413 + uint32_t tmwritestart;196,5451 + uint32_t tmwritecurrent;197,5481 + uint32_t tmwritelimit;198,5513 + uint32_t tmrecordingreads;199,5543 + uint32_t tmreadstart;200,5577 + uint32_t tmreadcurrent;201,5606 + uint32_t tmreadlimit;202,5637 + } PROCESSORSTATE, *PROCESSORSTATEP;PROCESSORSTATEP203,5666 +#define PROCESSORSTATE_SIZE 205,5704 +typedef struct cacheline 207,5738 + uint64_t annotation;208,5765 + uint32_t nextpcdata;209,5793 + uint32_t nextpctag;210,5821 + char *nextcp;nextcp211,5848 + uint32_t instruction;212,5872 + uint32_t operand;213,5901 + uint32_t pcdata;214,5926 + uint32_t pctag;215,5950 + char *code;code216,5973 + } CACHELINE, *CACHELINEP;CACHELINEP217,5995 +#define CACHELINE_SIZE 219,6023 +#define CacheLine_Bits 221,6050 +#define CacheLine_Mask 223,6077 +#define CacheLine_RShift 225,6108 +#define CacheLine_LShift 227,6137 +#define CacheLine_FillAmount 229,6165 +typedef struct arraycache 231,6198 + uint64_t array;232,6226 + uint64_t arword;233,6249 + uint64_t locat;234,6273 + uint64_t length;235,6296 + } ARRAYCACHE, *ARRAYCACHEP;ARRAYCACHEP236,6320 +#define AutoArrayReg_Mask 238,6350 +#define AutoArrayReg_Size 240,6381 +#define AutoArrayReg_Shift 242,6411 +#define MSclock_UnitsToMSShift 244,6441 +#define MSclock_UnitsPerMicrosecond 246,6476 +#define Stack_CacheSize 248,6522 +#define Stack_MaxFrameSize 250,6552 +#define Stack_CacheMargin 252,6584 +#define Stack_CacheDumpQuantum 254,6615 +#define IvoryMemory_Data 256,6651 +#define IvoryMemory_Tag 258,6680 +typedef struct savedregisters 260,6708 + uint64_t r9;261,6740 + uint64_t r10;262,6760 + uint64_t r11;263,6781 + uint64_t r12;264,6802 + uint64_t r13;265,6823 + uint64_t r14;266,6844 + uint64_t r15;267,6865 + uint64_t r29;268,6886 + uint64_t f2;269,6907 + uint64_t f3;270,6927 + uint64_t f4;271,6947 + uint64_t f5;272,6967 + uint64_t f6;273,6987 + uint64_t f7;274,7007 + uint64_t f8;275,7027 + uint64_t f9;276,7047 + } SAVEDREGISTERS, *SAVEDREGISTERSP;SAVEDREGISTERSP277,7067 +#define SAVEDREGISTERS_SIZE 279,7105 +typedef struct tracedata 281,7138 + uint64_t n_entries;282,7165 + uint32_t recording_p;283,7192 + uint32_t wrap_p;284,7221 + uint64_t start_pc;285,7245 + uint64_t stop_pc;286,7271 + char *records_start;records_start287,7296 + char *records_end;records_end288,7327 + char *current_entry;current_entry289,7356 + char *printer;printer290,7387 + } TRACEDATA, *TRACEDATAP;TRACEDATAP291,7412 +#define TRACEDATA_SIZE 293,7440 +typedef struct tracerecord 295,7467 + uint64_t counter;296,7496 + uint64_t epc;297,7521 + uint64_t tos;298,7542 + uint64_t sp;299,7563 + char *instruction;instruction300,7583 + uint64_t instruction_data;301,7612 + uint32_t operand;302,7646 + uint32_t trap_p;303,7671 + uint64_t trap_data_0;304,7695 + uint64_t trap_data_1;305,7724 + uint64_t trap_data_2;306,7753 + uint64_t trap_data_3;307,7782 + uint32_t catch_block_p;308,7811 + uint32_t int_pad0;309,7842 + uint64_t catch_block_0;310,7868 + uint64_t catch_block_1;311,7899 + uint64_t catch_block_2;312,7930 + uint64_t catch_block_3;313,7961 + } TRACERECORD, *TRACERECORDP;TRACERECORDP314,7992 +#define TRACERECORD_SIZE 316,8024 +#define CacheMeter_Pwr 318,8054 +#define CacheMeter_DefaultFreq 320,8081 + +c-emulator/dispatch.h,25725 +#define _DISPATCH_H4,42 +typedef enum _IvoryDispatch12,171 + DispatchCarFP,14,201 + DispatchCarLP,15,218 + DispatchCarSP,16,235 + DispatchCarImmediate,17,252 + DispatchCarPop,18,276 + DispatchCdrFP,19,294 + DispatchCdrLP,20,311 + DispatchCdrSP,21,328 + DispatchCdrImmediate,22,345 + DispatchCdrPop,23,369 + DispatchEndpFP,24,387 + DispatchEndpLP,25,405 + DispatchEndpSP,26,423 + DispatchEndpImmediate,27,441 + DispatchEndpPop,28,466 + DispatchSetup1dArrayFP,29,485 + DispatchSetup1dArrayLP,30,511 + DispatchSetup1dArraySP,31,537 + DispatchSetup1dArrayImmediate,32,563 + DispatchSetup1dArrayPop,33,596 + DispatchSetupForce1dArrayFP,34,623 + DispatchSetupForce1dArrayLP,35,654 + DispatchSetupForce1dArraySP,36,685 + DispatchSetupForce1dArrayImmediate,37,716 + DispatchSetupForce1dArrayPop,38,754 + DispatchBindLocativeFP,39,786 + DispatchBindLocativeLP,40,812 + DispatchBindLocativeSP,41,838 + DispatchBindLocativeImmediate,42,864 + DispatchBindLocativePop,43,897 + DispatchRestoreBindingStackFP,44,924 + DispatchRestoreBindingStackLP,45,957 + DispatchRestoreBindingStackSP,46,990 + DispatchRestoreBindingStackImmediate,47,1023 + DispatchRestoreBindingStackPop,48,1063 + DispatchEphemeralpFP,49,1097 + DispatchEphemeralpLP,50,1121 + DispatchEphemeralpSP,51,1145 + DispatchEphemeralpImmediate,52,1169 + DispatchEphemeralpPop,53,1200 + DispatchStartCallFP,54,1225 + DispatchStartCallLP,55,1248 + DispatchStartCallSP,56,1271 + DispatchStartCallImmediate,57,1294 + DispatchStartCallPop,58,1324 + DispatchJumpFP,59,1348 + DispatchJumpLP,60,1366 + DispatchJumpSP,61,1384 + DispatchJumpImmediate,62,1402 + DispatchJumpPop,63,1427 + DispatchTagFP,64,1446 + DispatchTagLP,65,1463 + DispatchTagSP,66,1480 + DispatchTagImmediate,67,1497 + DispatchTagPop,68,1521 + DispatchDereferenceFP,69,1539 + DispatchDereferenceLP,70,1564 + DispatchDereferenceSP,71,1589 + DispatchDereferenceImmediate,72,1614 + DispatchDereferencePop,73,1646 + DispatchLogicTailTestFP,74,1672 + DispatchLogicTailTestLP,75,1699 + DispatchLogicTailTestSP,76,1726 + DispatchLogicTailTestImmediate,77,1753 + DispatchLogicTailTestPop,78,1787 + DispatchProcBreakpointFP,79,1815 + DispatchProcBreakpointLP,80,1843 + DispatchProcBreakpointSP,81,1871 + DispatchProcBreakpointImmediate,82,1899 + DispatchProcBreakpointPop,83,1934 + DispatchPushLexicalVarFP,84,1963 + DispatchPushLexicalVarLP,85,1991 + DispatchPushLexicalVarSP,86,2019 + DispatchPushLexicalVarImmediate,87,2047 + DispatchPushLexicalVarPop,88,2082 + DispatchBlock0WriteFP,89,2111 + DispatchBlock0WriteLP,90,2136 + DispatchBlock0WriteSP,91,2161 + DispatchBlock0WriteImmediate,92,2186 + DispatchBlock0WritePop,93,2218 + DispatchBlock1WriteFP,94,2244 + DispatchBlock1WriteLP,95,2269 + DispatchBlock1WriteSP,96,2294 + DispatchBlock1WriteImmediate,97,2319 + DispatchBlock1WritePop,98,2351 + DispatchBlock2WriteFP,99,2377 + DispatchBlock2WriteLP,100,2402 + DispatchBlock2WriteSP,101,2427 + DispatchBlock2WriteImmediate,102,2452 + DispatchBlock2WritePop,103,2484 + DispatchBlock3WriteFP,104,2510 + DispatchBlock3WriteLP,105,2535 + DispatchBlock3WriteSP,106,2560 + DispatchBlock3WriteImmediate,107,2585 + DispatchBlock3WritePop,108,2617 + DispatchZeropFP,109,2643 + DispatchZeropLP,110,2662 + DispatchZeropSP,111,2681 + DispatchZeropImmediate,112,2700 + DispatchZeropPop,113,2726 + DispatchMinuspFP,114,2746 + DispatchMinuspLP,115,2766 + DispatchMinuspSP,116,2786 + DispatchMinuspImmediate,117,2806 + DispatchMinuspPop,118,2833 + DispatchPluspFP,119,2854 + DispatchPluspLP,120,2873 + DispatchPluspSP,121,2892 + DispatchPluspImmediate,122,2911 + DispatchPluspPop,123,2937 + DispatchTypeMember,124,2957 + DispatchTypeMemberNoPop,125,2979 + DispatchLocateLocals,126,3006 + DispatchCatchClose,127,3030 + DispatchGenericDispatch,128,3052 + DispatchMessageDispatch,129,3079 + DispatchCheckPreemptRequest,130,3106 + DispatchPushGlobalLogicVariable,131,3137 + DispatchNoOp,132,3172 + DispatchHalt,133,3188 + DispatchBranchTrue,134,3204 + DispatchBranchTrueElseExtraPop,135,3226 + DispatchBranchTrueAndExtraPop,136,3260 + DispatchBranchTrueExtraPop,137,3293 + DispatchBranchTrueNoPop,138,3323 + DispatchBranchTrueAndNoPop,139,3350 + DispatchBranchTrueElseNoPop,140,3380 + DispatchBranchTrueAndNoPopElseNoPopExtraPop,141,3411 + DispatchBranchFalse,142,3458 + DispatchBranchFalseElseExtraPop,143,3481 + DispatchBranchFalseAndExtraPop,144,3516 + DispatchBranchFalseExtraPop,145,3550 + DispatchBranchFalseNoPop,146,3581 + DispatchBranchFalseAndNoPop,147,3609 + DispatchBranchFalseElseNoPop,148,3640 + DispatchBranchFalseAndNoPopElseNoPopExtraPop,149,3672 + DispatchPushFP,150,3720 + DispatchPushLP,151,3738 + DispatchPushSP,152,3756 + DispatchPushImmediate,153,3774 + DispatchPushPop,154,3799 + DispatchPushNNils,155,3818 + DispatchPushAddressSpRelativeFP,156,3839 + DispatchPushAddressSpRelativeLP,157,3874 + DispatchPushAddressSpRelativeSP,158,3909 + DispatchPushAddressSpRelativeImmediate,159,3944 + DispatchPushAddressSpRelativePop,160,3986 + DispatchPushLocalLogicVariablesFP,161,4022 + DispatchPushLocalLogicVariablesLP,162,4059 + DispatchPushLocalLogicVariablesSP,163,4096 + DispatchPushLocalLogicVariablesImmediate,164,4133 + DispatchPushLocalLogicVariablesPop,165,4177 + DispatchReturnMultipleFP,166,4215 + DispatchReturnMultipleLP,167,4243 + DispatchReturnMultipleSP,168,4271 + DispatchReturnMultipleImmediate,169,4299 + DispatchReturnMultiplePop,170,4334 + DispatchReturnKludgeFP,171,4363 + DispatchReturnKludgeLP,172,4389 + DispatchReturnKludgeSP,173,4415 + DispatchReturnKludgeImmediate,174,4441 + DispatchReturnKludgePop,175,4474 + DispatchTakeValues,176,4501 + DispatchUnbindNImmediate,177,4523 + DispatchUnbindNPop,178,4551 + DispatchPushInstanceVariable,179,4573 + DispatchPushAddressInstanceVariable,180,4605 + DispatchPushInstanceVariableOrdered,181,4644 + DispatchPushAddressInstanceVariableOrdered,182,4683 + DispatchUnaryMinusFP,183,4729 + DispatchUnaryMinusLP,184,4753 + DispatchUnaryMinusSP,185,4777 + DispatchUnaryMinusImmediate,186,4801 + DispatchUnaryMinusPop,187,4832 + DispatchReturnSingleNIL,188,4857 + DispatchReturnSingleT,189,4884 + DispatchReturnSingleTOS,190,4909 + DispatchMemoryRead,191,4936 + DispatchMemoryReadAddress,192,4958 + DispatchBlock0Read,193,4987 + DispatchBlock1Read,194,5009 + DispatchBlock2Read,195,5031 + DispatchBlock3Read,196,5053 + DispatchBlock0ReadShift,197,5075 + DispatchBlock1ReadShift,198,5102 + DispatchBlock2ReadShift,199,5129 + DispatchBlock3ReadShift,200,5156 + DispatchBlock0ReadTest,201,5183 + DispatchBlock1ReadTest,202,5209 + DispatchBlock2ReadTest,203,5235 + DispatchBlock3ReadTest,204,5261 + DispatchFinishCallN,205,5287 + DispatchFinishCallNApply,206,5310 + DispatchFinishCallTos,207,5338 + DispatchFinishCallTosApply,208,5363 + DispatchSetToCarFP,209,5393 + DispatchSetToCarLP,210,5415 + DispatchSetToCarSP,211,5437 + DispatchSetToCarImmediate,212,5459 + DispatchSetToCarPop,213,5488 + DispatchSetToCdrFP,214,5511 + DispatchSetToCdrLP,215,5533 + DispatchSetToCdrSP,216,5555 + DispatchSetToCdrImmediate,217,5577 + DispatchSetToCdrPop,218,5606 + DispatchSetToCdrPushCarFP,219,5629 + DispatchSetToCdrPushCarLP,220,5658 + DispatchSetToCdrPushCarSP,221,5687 + DispatchSetToCdrPushCarImmediate,222,5716 + DispatchSetToCdrPushCarPop,223,5752 + DispatchIncrementFP,224,5782 + DispatchIncrementLP,225,5805 + DispatchIncrementSP,226,5828 + DispatchIncrementImmediate,227,5851 + DispatchIncrementPop,228,5881 + DispatchDecrementFP,229,5905 + DispatchDecrementLP,230,5928 + DispatchDecrementSP,231,5951 + DispatchDecrementImmediate,232,5974 + DispatchDecrementPop,233,6004 + DispatchPointerIncrementFP,234,6028 + DispatchPointerIncrementLP,235,6058 + DispatchPointerIncrementSP,236,6088 + DispatchPointerIncrementImmediate,237,6118 + DispatchPointerIncrementPop,238,6155 + DispatchSetCdrCode1FP,239,6186 + DispatchSetCdrCode1LP,240,6211 + DispatchSetCdrCode1SP,241,6236 + DispatchSetCdrCode1Immediate,242,6261 + DispatchSetCdrCode1Pop,243,6293 + DispatchSetCdrCode2FP,244,6319 + DispatchSetCdrCode2LP,245,6344 + DispatchSetCdrCode2SP,246,6369 + DispatchSetCdrCode2Immediate,247,6394 + DispatchSetCdrCode2Pop,248,6426 + DispatchPushAddressFP,249,6452 + DispatchPushAddressLP,250,6477 + DispatchPushAddressSP,251,6502 + DispatchPushAddressImmediate,252,6527 + DispatchPushAddressPop,253,6559 + DispatchSetSpToAddressFP,254,6585 + DispatchSetSpToAddressLP,255,6613 + DispatchSetSpToAddressSP,256,6641 + DispatchSetSpToAddressImmediate,257,6669 + DispatchSetSpToAddressPop,258,6704 + DispatchSetSpToAddressSaveTosFP,259,6733 + DispatchSetSpToAddressSaveTosLP,260,6768 + DispatchSetSpToAddressSaveTosSP,261,6803 + DispatchSetSpToAddressSaveTosImmediate,262,6838 + DispatchSetSpToAddressSaveTosPop,263,6880 + DispatchReadInternalRegister,264,6916 + DispatchWriteInternalRegister,265,6948 + DispatchCoprocessorRead,266,6981 + DispatchCoprocessorWrite,267,7008 + DispatchBlock0ReadAluFP,268,7036 + DispatchBlock0ReadAluLP,269,7063 + DispatchBlock0ReadAluSP,270,7090 + DispatchBlock0ReadAluImmediate,271,7117 + DispatchBlock0ReadAluPop,272,7151 + DispatchBlock1ReadAluFP,273,7179 + DispatchBlock1ReadAluLP,274,7206 + DispatchBlock1ReadAluSP,275,7233 + DispatchBlock1ReadAluImmediate,276,7260 + DispatchBlock1ReadAluPop,277,7294 + DispatchBlock2ReadAluFP,278,7322 + DispatchBlock2ReadAluLP,279,7349 + DispatchBlock2ReadAluSP,280,7376 + DispatchBlock2ReadAluImmediate,281,7403 + DispatchBlock2ReadAluPop,282,7437 + DispatchBlock3ReadAluFP,283,7465 + DispatchBlock3ReadAluLP,284,7492 + DispatchBlock3ReadAluSP,285,7519 + DispatchBlock3ReadAluImmediate,286,7546 + DispatchBlock3ReadAluPop,287,7580 + DispatchLdb,288,7608 + DispatchCharLdb,289,7623 + DispatchPLdb,290,7642 + DispatchPTagLdb,291,7658 + DispatchBranch,292,7677 + DispatchLoopDecrementTos,293,7695 + DispatchEntryRestAccepted,294,7723 + DispatchEntryRestNotAccepted,295,7752 + DispatchRplacaFP,296,7784 + DispatchRplacaLP,297,7804 + DispatchRplacaSP,298,7824 + DispatchRplacaImmediate,299,7844 + DispatchRplacaPop,300,7871 + DispatchRplacdFP,301,7892 + DispatchRplacdLP,302,7912 + DispatchRplacdSP,303,7932 + DispatchRplacdImmediate,304,7952 + DispatchRplacdPop,305,7979 + DispatchMultiplyFP,306,8000 + DispatchMultiplyLP,307,8022 + DispatchMultiplySP,308,8044 + DispatchMultiplyImmediate,309,8066 + DispatchMultiplyPop,310,8095 + DispatchQuotientFP,311,8118 + DispatchQuotientLP,312,8140 + DispatchQuotientSP,313,8162 + DispatchQuotientImmediate,314,8184 + DispatchQuotientPop,315,8213 + DispatchCeilingFP,316,8236 + DispatchCeilingLP,317,8257 + DispatchCeilingSP,318,8278 + DispatchCeilingImmediate,319,8299 + DispatchCeilingPop,320,8327 + DispatchFloorFP,321,8349 + DispatchFloorLP,322,8368 + DispatchFloorSP,323,8387 + DispatchFloorImmediate,324,8406 + DispatchFloorPop,325,8432 + DispatchTruncateFP,326,8452 + DispatchTruncateLP,327,8474 + DispatchTruncateSP,328,8496 + DispatchTruncateImmediate,329,8518 + DispatchTruncatePop,330,8547 + DispatchRoundFP,331,8570 + DispatchRoundLP,332,8589 + DispatchRoundSP,333,8608 + DispatchRoundImmediate,334,8627 + DispatchRoundPop,335,8653 + DispatchRationalQuotientFP,336,8673 + DispatchRationalQuotientLP,337,8703 + DispatchRationalQuotientSP,338,8733 + DispatchRationalQuotientImmediate,339,8763 + DispatchRationalQuotientPop,340,8800 + DispatchMinFP,341,8831 + DispatchMinLP,342,8848 + DispatchMinSP,343,8865 + DispatchMinImmediate,344,8882 + DispatchMinPop,345,8906 + DispatchMaxFP,346,8924 + DispatchMaxLP,347,8941 + DispatchMaxSP,348,8958 + DispatchMaxImmediate,349,8975 + DispatchMaxPop,350,8999 + DispatchAluFP,351,9017 + DispatchAluLP,352,9034 + DispatchAluSP,353,9051 + DispatchAluImmediate,354,9068 + DispatchAluPop,355,9092 + DispatchLogandFP,356,9110 + DispatchLogandLP,357,9130 + DispatchLogandSP,358,9150 + DispatchLogandImmediate,359,9170 + DispatchLogandPop,360,9197 + DispatchLogxorFP,361,9218 + DispatchLogxorLP,362,9238 + DispatchLogxorSP,363,9258 + DispatchLogxorImmediate,364,9278 + DispatchLogxorPop,365,9305 + DispatchLogiorFP,366,9326 + DispatchLogiorLP,367,9346 + DispatchLogiorSP,368,9366 + DispatchLogiorImmediate,369,9386 + DispatchLogiorPop,370,9413 + DispatchRotFP,371,9434 + DispatchRotLP,372,9451 + DispatchRotSP,373,9468 + DispatchRotImmediate,374,9485 + DispatchRotPop,375,9509 + DispatchLshFP,376,9527 + DispatchLshLP,377,9544 + DispatchLshSP,378,9561 + DispatchLshImmediate,379,9578 + DispatchLshPop,380,9602 + DispatchMultiplyDoubleFP,381,9620 + DispatchMultiplyDoubleLP,382,9648 + DispatchMultiplyDoubleSP,383,9676 + DispatchMultiplyDoubleImmediate,384,9704 + DispatchMultiplyDoublePop,385,9739 + DispatchLshcBignumStepFP,386,9768 + DispatchLshcBignumStepLP,387,9796 + DispatchLshcBignumStepSP,388,9824 + DispatchLshcBignumStepImmediate,389,9852 + DispatchLshcBignumStepPop,390,9887 + DispatchStackBltFP,391,9916 + DispatchStackBltLP,392,9938 + DispatchStackBltSP,393,9960 + DispatchStackBltImmediate,394,9982 + DispatchStackBltPop,395,10011 + DispatchRgetfFP,396,10034 + DispatchRgetfLP,397,10053 + DispatchRgetfSP,398,10072 + DispatchRgetfImmediate,399,10091 + DispatchRgetfPop,400,10117 + DispatchMemberFP,401,10137 + DispatchMemberLP,402,10157 + DispatchMemberSP,403,10177 + DispatchMemberImmediate,404,10197 + DispatchMemberPop,405,10224 + DispatchAssocFP,406,10245 + DispatchAssocLP,407,10264 + DispatchAssocSP,408,10283 + DispatchAssocImmediate,409,10302 + DispatchAssocPop,410,10328 + DispatchPointerPlusFP,411,10348 + DispatchPointerPlusLP,412,10373 + DispatchPointerPlusSP,413,10398 + DispatchPointerPlusImmediate,414,10423 + DispatchPointerPlusPop,415,10455 + DispatchPointerDifferenceFP,416,10481 + DispatchPointerDifferenceLP,417,10512 + DispatchPointerDifferenceSP,418,10543 + DispatchPointerDifferenceImmediate,419,10574 + DispatchPointerDifferencePop,420,10612 + DispatchAshFP,421,10644 + DispatchAshLP,422,10661 + DispatchAshSP,423,10678 + DispatchAshImmediate,424,10695 + DispatchAshPop,425,10719 + DispatchStoreConditionalFP,426,10737 + DispatchStoreConditionalLP,427,10767 + DispatchStoreConditionalSP,428,10797 + DispatchStoreConditionalImmediate,429,10827 + DispatchStoreConditionalPop,430,10864 + DispatchMemoryWriteFP,431,10895 + DispatchMemoryWriteLP,432,10920 + DispatchMemoryWriteSP,433,10945 + DispatchMemoryWriteImmediate,434,10970 + DispatchMemoryWritePop,435,11002 + DispatchPStoreContentsFP,436,11028 + DispatchPStoreContentsLP,437,11056 + DispatchPStoreContentsSP,438,11084 + DispatchPStoreContentsImmediate,439,11112 + DispatchPStoreContentsPop,440,11147 + DispatchBindLocativeToValueFP,441,11176 + DispatchBindLocativeToValueLP,442,11209 + DispatchBindLocativeToValueSP,443,11242 + DispatchBindLocativeToValueImmediate,444,11275 + DispatchBindLocativeToValuePop,445,11315 + DispatchUnifyFP,446,11349 + DispatchUnifyLP,447,11368 + DispatchUnifySP,448,11387 + DispatchUnifyImmediate,449,11406 + DispatchUnifyPop,450,11432 + DispatchPopLexicalVarFP,451,11452 + DispatchPopLexicalVarLP,452,11479 + DispatchPopLexicalVarSP,453,11506 + DispatchPopLexicalVarImmediate,454,11533 + DispatchPopLexicalVarPop,455,11567 + DispatchMovemLexicalVarFP,456,11595 + DispatchMovemLexicalVarLP,457,11624 + DispatchMovemLexicalVarSP,458,11653 + DispatchMovemLexicalVarImmediate,459,11682 + DispatchMovemLexicalVarPop,460,11718 + DispatchEqualNumberFP,461,11748 + DispatchEqualNumberLP,462,11773 + DispatchEqualNumberSP,463,11798 + DispatchEqualNumberImmediate,464,11823 + DispatchEqualNumberPop,465,11855 + DispatchLesspFP,466,11881 + DispatchLesspLP,467,11900 + DispatchLesspSP,468,11919 + DispatchLesspImmediate,469,11938 + DispatchLesspPop,470,11964 + DispatchGreaterpFP,471,11984 + DispatchGreaterpLP,472,12006 + DispatchGreaterpSP,473,12028 + DispatchGreaterpImmediate,474,12050 + DispatchGreaterpPop,475,12079 + DispatchEqlFP,476,12102 + DispatchEqlLP,477,12119 + DispatchEqlSP,478,12136 + DispatchEqlImmediate,479,12153 + DispatchEqlPop,480,12177 + DispatchEqualNumberNoPopFP,481,12195 + DispatchEqualNumberNoPopLP,482,12225 + DispatchEqualNumberNoPopSP,483,12255 + DispatchEqualNumberNoPopImmediate,484,12285 + DispatchEqualNumberNoPopPop,485,12322 + DispatchLesspNoPopFP,486,12353 + DispatchLesspNoPopLP,487,12377 + DispatchLesspNoPopSP,488,12401 + DispatchLesspNoPopImmediate,489,12425 + DispatchLesspNoPopPop,490,12456 + DispatchGreaterpNoPopFP,491,12481 + DispatchGreaterpNoPopLP,492,12508 + DispatchGreaterpNoPopSP,493,12535 + DispatchGreaterpNoPopImmediate,494,12562 + DispatchGreaterpNoPopPop,495,12596 + DispatchEqlNoPopFP,496,12624 + DispatchEqlNoPopLP,497,12646 + DispatchEqlNoPopSP,498,12668 + DispatchEqlNoPopImmediate,499,12690 + DispatchEqlNoPopPop,500,12719 + DispatchEqFP,501,12742 + DispatchEqLP,502,12758 + DispatchEqSP,503,12774 + DispatchEqImmediate,504,12790 + DispatchEqPop,505,12813 + DispatchLogtestFP,506,12830 + DispatchLogtestLP,507,12851 + DispatchLogtestSP,508,12872 + DispatchLogtestImmediate,509,12893 + DispatchLogtestPop,510,12921 + DispatchEqNoPopFP,511,12943 + DispatchEqNoPopLP,512,12964 + DispatchEqNoPopSP,513,12985 + DispatchEqNoPopImmediate,514,13006 + DispatchEqNoPopPop,515,13034 + DispatchLogtestNoPopFP,516,13056 + DispatchLogtestNoPopLP,517,13082 + DispatchLogtestNoPopSP,518,13108 + DispatchLogtestNoPopImmediate,519,13134 + DispatchLogtestNoPopPop,520,13167 + DispatchAddFP,521,13194 + DispatchAddLP,522,13211 + DispatchAddSP,523,13228 + DispatchAddImmediate,524,13245 + DispatchAddPop,525,13269 + DispatchSubFP,526,13287 + DispatchSubLP,527,13304 + DispatchSubSP,528,13321 + DispatchSubImmediate,529,13338 + DispatchSubPop,530,13362 + Dispatch32BitPlusFP,531,13380 + Dispatch32BitPlusLP,532,13403 + Dispatch32BitPlusSP,533,13426 + Dispatch32BitPlusImmediate,534,13449 + Dispatch32BitPlusPop,535,13479 + Dispatch32BitDifferenceFP,536,13503 + Dispatch32BitDifferenceLP,537,13532 + Dispatch32BitDifferenceSP,538,13561 + Dispatch32BitDifferenceImmediate,539,13590 + Dispatch32BitDifferencePop,540,13626 + DispatchAddBignumStepFP,541,13656 + DispatchAddBignumStepLP,542,13683 + DispatchAddBignumStepSP,543,13710 + DispatchAddBignumStepImmediate,544,13737 + DispatchAddBignumStepPop,545,13771 + DispatchSubBignumStepFP,546,13799 + DispatchSubBignumStepLP,547,13826 + DispatchSubBignumStepSP,548,13853 + DispatchSubBignumStepImmediate,549,13880 + DispatchSubBignumStepPop,550,13914 + DispatchMultiplyBignumStepFP,551,13942 + DispatchMultiplyBignumStepLP,552,13974 + DispatchMultiplyBignumStepSP,553,14006 + DispatchMultiplyBignumStepImmediate,554,14038 + DispatchMultiplyBignumStepPop,555,14077 + DispatchDivideBignumStepFP,556,14110 + DispatchDivideBignumStepLP,557,14140 + DispatchDivideBignumStepSP,558,14170 + DispatchDivideBignumStepImmediate,559,14200 + DispatchDivideBignumStepPop,560,14237 + DispatchAset1FP,561,14268 + DispatchAset1LP,562,14287 + DispatchAset1SP,563,14306 + DispatchAset1Immediate,564,14325 + DispatchAset1Pop,565,14351 + DispatchAllocateListBlockFP,566,14371 + DispatchAllocateListBlockLP,567,14402 + DispatchAllocateListBlockSP,568,14433 + DispatchAllocateListBlockImmediate,569,14464 + DispatchAllocateListBlockPop,570,14502 + DispatchAref1FP,571,14534 + DispatchAref1LP,572,14553 + DispatchAref1SP,573,14572 + DispatchAref1Immediate,574,14591 + DispatchAref1Pop,575,14617 + DispatchAloc1FP,576,14637 + DispatchAloc1LP,577,14656 + DispatchAloc1SP,578,14675 + DispatchAloc1Immediate,579,14694 + DispatchAloc1Pop,580,14720 + DispatchStoreArrayLeaderFP,581,14740 + DispatchStoreArrayLeaderLP,582,14770 + DispatchStoreArrayLeaderSP,583,14800 + DispatchStoreArrayLeaderImmediate,584,14830 + DispatchStoreArrayLeaderPop,585,14867 + DispatchAllocateStructureBlockFP,586,14898 + DispatchAllocateStructureBlockLP,587,14934 + DispatchAllocateStructureBlockSP,588,14970 + DispatchAllocateStructureBlockImmediate,589,15006 + DispatchAllocateStructureBlockPop,590,15049 + DispatchArrayLeaderFP,591,15086 + DispatchArrayLeaderLP,592,15111 + DispatchArrayLeaderSP,593,15136 + DispatchArrayLeaderImmediate,594,15161 + DispatchArrayLeaderPop,595,15193 + DispatchAlocLeaderFP,596,15219 + DispatchAlocLeaderLP,597,15243 + DispatchAlocLeaderSP,598,15267 + DispatchAlocLeaderImmediate,599,15291 + DispatchAlocLeaderPop,600,15322 + DispatchPopInstanceVariable,601,15347 + DispatchMovemInstanceVariable,602,15378 + DispatchPopInstanceVariableOrdered,603,15411 + DispatchMovemInstanceVariableOrdered,604,15449 + DispatchInstanceRefFP,605,15489 + DispatchInstanceRefLP,606,15514 + DispatchInstanceRefSP,607,15539 + DispatchInstanceRefImmediate,608,15564 + DispatchInstanceRefPop,609,15596 + DispatchInstanceSetFP,610,15622 + DispatchInstanceSetLP,611,15647 + DispatchInstanceSetSP,612,15672 + DispatchInstanceSetImmediate,613,15697 + DispatchInstanceSetPop,614,15729 + DispatchInstanceLocFP,615,15755 + DispatchInstanceLocLP,616,15780 + DispatchInstanceLocSP,617,15805 + DispatchInstanceLocImmediate,618,15830 + DispatchInstanceLocPop,619,15862 + DispatchSetTagFP,620,15888 + DispatchSetTagLP,621,15908 + DispatchSetTagSP,622,15928 + DispatchSetTagImmediate,623,15948 + DispatchSetTagPop,624,15975 + DispatchUnsignedLesspFP,625,15996 + DispatchUnsignedLesspLP,626,16023 + DispatchUnsignedLesspSP,627,16050 + DispatchUnsignedLesspImmediate,628,16077 + DispatchUnsignedLesspPop,629,16111 + DispatchUnsignedLesspNoPopFP,630,16139 + DispatchUnsignedLesspNoPopLP,631,16171 + DispatchUnsignedLesspNoPopSP,632,16203 + DispatchUnsignedLesspNoPopImmediate,633,16235 + DispatchUnsignedLesspNoPopPop,634,16274 + DispatchPopFP,635,16307 + DispatchPopLP,636,16324 + DispatchPopSP,637,16341 + DispatchPopImmediate,638,16358 + DispatchPopPop,639,16382 + DispatchMovemFP,640,16400 + DispatchMovemLP,641,16419 + DispatchMovemSP,642,16438 + DispatchMovemImmediate,643,16457 + DispatchMovemPop,644,16483 + DispatchMergeCdrNoPopFP,645,16503 + DispatchMergeCdrNoPopLP,646,16530 + DispatchMergeCdrNoPopSP,647,16557 + DispatchMergeCdrNoPopImmediate,648,16584 + DispatchMergeCdrNoPopPop,649,16618 + DispatchFastAref1FP,650,16646 + DispatchFastAref1LP,651,16669 + DispatchFastAref1SP,652,16692 + DispatchFastAref1Immediate,653,16715 + DispatchFastAref1Pop,654,16745 + DispatchFastAset1FP,655,16769 + DispatchFastAset1LP,656,16792 + DispatchFastAset1SP,657,16815 + DispatchFastAset1Immediate,658,16838 + DispatchFastAset1Pop,659,16868 + DispatchStackBltAddressFP,660,16892 + DispatchStackBltAddressLP,661,16921 + DispatchStackBltAddressSP,662,16950 + DispatchStackBltAddressImmediate,663,16979 + DispatchStackBltAddressPop,664,17015 + DispatchDpb,665,17045 + DispatchCharDpb,666,17060 + DispatchPDpb,667,17079 + DispatchPTagDpb,668,17095 + DispatchLoopIncrementTosLessThan,669,17114 + DispatchCatchOpen,670,17150 + DispatchHack,671,17171 + DispatchPushNull,672,17187 + DispatchPushMonitorForward,673,17207 + DispatchPushHeaderP,674,17237 + DispatchPushHeaderI,675,17260 + DispatchPushExternalValueCellPointer,676,17283 + DispatchPushOneQForward,677,17323 + DispatchPushHeaderForward,678,17350 + DispatchPushElementForward,679,17379 + DispatchPushFixnum,680,17409 + DispatchPushSmallRatio,681,17431 + DispatchPushSingleFloat,682,17457 + DispatchPushDoubleFloat,683,17484 + DispatchPushBignum,684,17511 + DispatchPushBigRatio,685,17533 + DispatchPushComplex,686,17557 + DispatchPushSpareNumber,687,17580 + DispatchPushInstance,688,17607 + DispatchPushListInstance,689,17631 + DispatchPushArrayInstance,690,17659 + DispatchPushStringInstance,691,17688 + DispatchPushNil,692,17718 + DispatchPushList,693,17737 + DispatchPushArray,694,17757 + DispatchPushString,695,17778 + DispatchPushSymbol,696,17800 + DispatchPushLocative,697,17822 + DispatchPushLexicalClosure,698,17846 + DispatchPushDynamicClosure,699,17876 + DispatchPushCompiledFunction,700,17906 + DispatchPushGenericFunction,701,17938 + DispatchPushSparePointer1,702,17969 + DispatchPushSparePointer2,703,17998 + DispatchPushPhysicalAddress,704,18027 + DispatchPushSpareImmediate1,705,18058 + DispatchPushBoundLocation,706,18089 + DispatchPushCharacter,707,18118 + DispatchPushLogicVariable,708,18143 + DispatchPushGcForward,709,18172 + DispatchPushEvenPc,710,18197 + DispatchPushOddPc,711,18219 + DispatchCallCompiledEven,712,18240 + DispatchCallCompiledOdd,713,18268 + DispatchCallIndirect,714,18295 + DispatchCallGeneric,715,18319 + DispatchCallCompiledEvenPrefetch,716,18342 + DispatchCallCompiledOddPrefetch,717,18378 + DispatchCallIndirectPrefetch,718,18413 + DispatchCallGenericPrefetch,719,18445 + DispatchPushPackedInstruction60,720,18476 + DispatchPushPackedInstruction61,721,18511 + DispatchPushPackedInstruction62,722,18546 + DispatchPushPackedInstruction63,723,18581 + DispatchPushPackedInstruction64,724,18616 + DispatchPushPackedInstruction65,725,18651 + DispatchPushPackedInstruction66,726,18686 + DispatchPushPackedInstruction67,727,18721 + DispatchPushPackedInstruction70,728,18756 + DispatchPushPackedInstruction71,729,18791 + DispatchPushPackedInstruction72,730,18826 + DispatchPushPackedInstruction73,731,18861 + DispatchPushPackedInstruction74,732,18896 + DispatchPushPackedInstruction75,733,18931 + DispatchPushPackedInstruction76,734,18966 + DispatchPushPackedInstruction77,735,19001 + DispatchInstructionCacheLookup,736,19036 + DispatchIllegalInstruction737,19070 +} IvoryDispatch;738,19099 + +c-emulator/emulator.h,4042 +#define _EMULATOR_H6,76 +typedef unsigned char Byte;10,118 +typedef unsigned char Tag;11,146 +typedef unsigned int Integer;12,173 +typedef int Boolean;13,203 +typedef float Float;14,224 +typedef void *Pointer;Pointer15,245 +#define False 17,269 +#define True 18,285 +#define ldb(20,301 +#define dpb(21,376 +#define ceiling(22,504 +#define SignExtend8(24,572 +#define SignExtend10(25,639 +#define SignExtend8(27,712 +#define SignExtend10(28,798 + struct _LispObj33,911 + unsigned int tag;36,954 + unsigned char tag;38,982 + unsigned int u;41,1024 + signed int s;42,1045 + float f;43,1064 + } data;44,1078 + } parts;45,1089 + unsigned long whole;47,1121 +} LispObj, PC;49,1153 +#define DATA 50,1168 +#define TAG 51,1192 +#define LispObjTag(53,1215 +#define LispObjData(54,1263 +typedef struct _InstructionCacheLine56,1316 + PC pc;58,1355 + PC next_pc;59,1364 + int code;60,1378 + int operand;61,1390 + unsigned int instruction;62,1405 + struct _InstructionCacheLine *next_cp;next_cp63,1433 +} InstructionCacheLine;64,1474 +#define InstructionCacheSize 66,1499 +#define InstructionCacheLineSize 67,1533 +#define PageSize 71,1611 +#define PageNumberMask 72,1634 +#define PageOffsetMask 73,1668 +#define AddressPageShift 74,1696 +#define QuantumSize 76,1724 +#define AddressQuantumShift 77,1753 +#define AddressQuantumNumber(79,1785 +#define AddressQuantumOffset(80,1850 +#define AddressPageNumber(81,1934 +#define AddressPageOffset(82,1993 +#define StackCacheSize 84,2050 +typedef struct _ProcessorState86,2076 + LispObj *sp;sp88,2109 + LispObj *restartsp;restartsp89,2124 + LispObj *fp;fp90,2146 + LispObj *lp;lp91,2161 + PC pc;92,2176 + PC continuation;93,2185 + InstructionCacheLine *InstructionCache;InstructionCache94,2204 + LispObj *StackCache;StackCache95,2246 + LispObj *StackCacheLimit;StackCacheLimit96,2269 + struct _bar 97,2297 + LispObj address;98,2313 + LispObj *mapped;mapped99,2339 + } bar[bar100,2358 + LispObj ListCacheArea;101,2375 + LispObj ListCacheAddress;102,2400 + LispObj StructureCacheArea;103,2428 + LispObj StructureCacheAddress;104,2458 + LispObj CatchBlockPointer;105,2491 + Integer control;107,2577 + Integer StackCacheBase;108,2596 + Integer ArrayEventCount;109,2622 + Integer ListCacheLength;110,2649 + Integer StructureCacheLength;111,2676 + Integer BindingStackPointer;112,2708 + Integer BindingStackLimit;113,2739 + Boolean DeepBoundP;114,2768 + Integer PreemptRegister;115,2790 + Integer AluAndRotateControl;116,2817 + Integer (*AluOp)AluOp117,2848 + Integer ByteSize;118,2870 + Integer ByteRotate;119,2890 + Integer RotateLatch;120,2912 + Boolean ALUOverflow;121,2935 + Boolean ALUBorrow;122,2958 + Boolean ALULessThan;123,2979 + Integer EphemeralOldspaceRegister;124,3002 + Integer ZoneOldspaceRegister;125,3039 + Integer ControlStackLimit;126,3071 + Integer ControlStackExtraLimit;127,3100 + Integer DynamicBindingCacheBase;128,3134 + Integer DynamicBindingCacheMask;129,3169 + Integer FEPModeTrapVectorAddress;130,3204 + Integer MappingTableCache;131,3240 + Integer MappingTableLength;132,3269 + Boolean running;133,3299 + unsigned int instruction_count;134,3318 +} ProcessorState;135,3352 +typedef enum _MemoryCycleTypes162,4423 + CycleDataRead,164,4456 + CycleDataWrite,165,4473 + CycleBindRead,166,4491 + CycleBindWrite,167,4508 + CycleBindReadNoMonitor,168,4526 + CycleBindWriteNoMonitor,169,4552 + CycleHeader,170,4579 + CycleStructureOffset,171,4594 + CycleScavenge,172,4618 + CycleCdr,173,4635 + CycleGCCopy,174,4647 + CycleRaw,175,4662 + CycleRawTranslate176,4674 +} MemoryCycleTypes;177,4694 +#define MemoryActionIndirect 179,4715 +#define MemoryActionMonitor 180,4747 +#define MemoryActionTransport 181,4778 +#define MemoryActionTrap 182,4811 +#define MemoryActionTransform 183,4840 +#define MemoryActionBinding 184,4874 +#define MemoryRead(190,5102 +#define MemoryReadData(191,5199 +#define MemoryReadHeader(192,5301 +#define MemoryReadCdr(193,5403 +#define StoreContents(194,5499 + +c-emulator/ivory.h,19133 +#define _IVORY_H8,107 +#define AddressNIL 10,125 +#define AddressT 11,155 +typedef enum _IvoryType13,184 + TypeNull,16,269 + TypeMonitorForward,17,341 + TypeHeaderP,18,399 + TypeHeaderI,19,462 + TypeExternalValueCellPointer,20,526 + TypeOneQForward,21,596 + TypeHeaderForward,22,663 + TypeElementForward,23,739 + TypeFixnum,25,841 + TypeSmallRatio,26,880 + TypeSingleFloat,27,951 + TypeDoubleFloat,28,1011 + TypeBignum,29,1071 + TypeBigRatio,30,1108 + TypeComplex,31,1175 + TypeSpareNumber,32,1216 + TypeInstance,34,1314 + TypeListInstance,35,1359 + TypeArrayInstance,36,1425 + TypeStringInstance,37,1494 + TypeNIL,39,1594 + TypeList,40,1631 + TypeArray,41,1661 + TypeString,42,1715 + TypeSymbol,43,1749 + TypeLocative,44,1798 + TypeLexicalClosure,45,1842 + TypeDynamicClosure,46,1904 + TypeCompiledFunction,47,1966 + TypeGenericFunction,48,2014 + TypeSparePointer1,49,2084 + TypeSparePointer2,50,2121 + TypePhysicalAddress,51,2158 + TypeSpareImmediate1,52,2208 + TypeBoundLocation,53,2247 + TypeCharacter,54,2296 + TypeLogicVariable,55,2352 + TypeGCForward,56,2413 + TypeEvenPC,57,2479 + TypeOddPC,58,2536 + TypeCallCompiledEven,60,2624 + TypeCallCompiledOdd,61,2699 + TypeCallIndirect,62,2773 + TypeCallGeneric,63,2840 + TypeCallCompiledEvenPrefetch,64,2909 + TypeCallCompiledOddPrefetch,65,2992 + TypeCallIndirectPrefetch,66,3074 + TypeCallGenericPrefetch,67,3153 + TypePackedInstruction60,69,3322 + TypePackedInstruction60, TypePackedInstruction61,69,3322 + TypePackedInstruction60, TypePackedInstruction61, TypePackedInstruction62,69,3322 + TypePackedInstruction63,70,3399 + TypePackedInstruction63, TypePackedInstruction64,70,3399 + TypePackedInstruction63, TypePackedInstruction64, TypePackedInstruction65,70,3399 + TypePackedInstruction66,71,3476 + TypePackedInstruction66, TypePackedInstruction67,71,3476 + TypePackedInstruction66, TypePackedInstruction67, TypePackedInstruction70,71,3476 + TypePackedInstruction71,72,3553 + TypePackedInstruction71, TypePackedInstruction72,72,3553 + TypePackedInstruction71, TypePackedInstruction72, TypePackedInstruction73,72,3553 + TypePackedInstruction74,73,3630 + TypePackedInstruction74, TypePackedInstruction75,73,3630 + TypePackedInstruction74, TypePackedInstruction75, TypePackedInstruction76,73,3630 + TypePackedInstruction7774,3707 +} IvoryType;75,3733 +typedef enum _IvoryCdr77,3747 + CdrNext,79,3772 + CdrNil,80,3783 + CdrNormal81,3793 +} IvoryCdr;82,3805 +#define TagTypeMask 84,3818 +#define TagCdrMask 85,3842 +#define TagType(86,3866 +#define TagCdr(87,3901 +#define SetTagCdr(88,3934 +#define MergeCdr(89,3982 +#define TypeEqualP(90,4051 +#define TypeFixnumP(91,4122 +#define TypeNumericP(92,4174 +#define TypeArrayP(93,4223 +#define TypeSpareP(94,4284 +#define PackedInstructionP(95,4445 +#define BinaryTypeFixnumP(96,4500 +#define BinaryTypeNumericP(97,4608 +#define StoreCdrNext(101,4753 +#define ObjectEqP(102,4842 +#define StoreCdrNext(104,4923 +#define ObjectEqP(105,5029 +#define ArrayHeaderTag 111,5179 +typedef enum _ArrayElementType113,5224 + ArrayElementTypeFixnum,115,5257 + ArrayElementTypeCharacter,116,5283 + ArrayElementTypeBoolean,117,5312 + ArrayElementTypeObject118,5339 +} ArrayElementType;119,5364 +#define ArrayLongPrefixP(121,5385 +#define ArrayShortLength(122,5425 +#define ArrayBytePacking(123,5467 +#define ArrayElementType(124,5509 +#define ArrayLeaderLength(125,5569 +#define ArrayRegisterByteOffset(127,5613 +#define ArrayRegisterEventCount(128,5662 +#define SetArrayRegisterEventCount(130,5758 +#define BytePackingSize(132,5825 +#define BytePackingRotation(133,5862 +#define ArrayElementLdb(134,5925 +#define ArrayElementDpb(135,6009 +typedef enum _IvoryValueDisposition166,6681 + ValueDispositionEffect,168,6719 + ValueDispositionValue,169,6745 + ValueDispositionReturn,170,6770 + ValueDispositionMultiple171,6796 +} IvoryValueDisposition;172,6823 +typedef enum _IvoryOpcode174,6849 + OpcodeCar 177,6903 + OpcodeCdr 178,6921 + OpcodeSetToCar 179,6939 + OpcodeSetToCdr 180,6964 + OpcodeSetToCdrPushCar 181,6989 + OpcodeRplaca 182,7021 + OpcodeRplacd 183,7044 + OpcodeRgetf 184,7067 + OpcodeMember 185,7089 + OpcodeAssoc 186,7112 + OpcodeDereference 188,7158 + OpcodeUnify 189,7185 + OpcodePushLocalLogicVariables 190,7207 + OpcodePushGlobalLogicVariable 191,7247 + OpcodeLogicTailTest 192,7286 + OpcodeEq 194,7341 + OpcodeEqNoPop 195,7360 + OpcodeEql 196,7384 + OpcodeEqlNoPop 197,7404 + OpcodeEqualNumber 198,7429 + OpcodeEqualNumberNoPop 199,7457 + OpcodeGreaterp 200,7490 + OpcodeGreaterpNoPop 201,7515 + OpcodeLessp 202,7545 + OpcodeLesspNoPop 203,7567 + OpcodeLogtest 204,7594 + OpcodeLogtestNoPop 205,7618 + OpcodeTypeMember 206,7647 + OpcodeTypeMemberNoPop 207,7691 + OpcodeEndp 209,7765 + OpcodePlusp 210,7784 + OpcodeMinusp 211,7805 + OpcodeZerop 212,7827 + OpcodeAdd 214,7875 + OpcodeSub 215,7895 + OpcodeUnaryMinus 216,7915 + OpcodeIncrement 217,7942 + OpcodeDecrement 218,7968 + OpcodeMultiply 219,7994 + OpcodeQuotient 220,8019 + OpcodeCeiling 221,8044 + OpcodeFloor 222,8068 + OpcodeTruncate 223,8090 + OpcodeRound 224,8115 + OpcodeRationalQuotient 225,8137 + OpcodeMax 226,8170 + OpcodeMin 227,8190 + OpcodeLogand 228,8210 + OpcodeLogior 229,8233 + OpcodeLogxor 230,8256 + OpcodeAsh 231,8279 + OpcodeRot 232,8299 + OpcodeLsh 233,8319 + Opcode32BitPlus 234,8339 + Opcode32BitDifference 235,8365 + OpcodeMultiplyDouble 236,8397 + OpcodeAddBignumStep 237,8428 + OpcodeSubBignumStep 238,8458 + OpcodeMultiplyBignumStep 239,8488 + OpcodeDivideBignumStep 240,8523 + OpcodeLshcBignumStep 241,8556 + OpcodePush 243,8609 + OpcodePop 244,8630 + OpcodeMovem 245,8650 + OpcodePushNNils 246,8672 + OpcodePushAddress 247,8698 + OpcodeSetSpToAddress 248,8726 + OpcodeSetSpToAddressSaveTos 249,8757 + OpcodePushAddressSpRelative 250,8795 + OpcodeStackBlt 251,8833 + OpcodeStackBltAddress 252,8858 + OpcodeLdb 254,8927 + OpcodeDpb 255,8947 + OpcodeCharLdb 256,8967 + OpcodeCharDpb 257,8991 + OpcodePLdb 258,9015 + OpcodePDpb 259,9036 + OpcodePTagLdb 260,9057 + OpcodePTagDpb 261,9081 + OpcodeAref1 263,9130 + OpcodeAset1 264,9152 + OpcodeAloc1 265,9174 + OpcodeSetup1DArray 266,9196 + OpcodeSetupForce1DArray 267,9223 + OpcodeFastAref1 268,9255 + OpcodeFastAset1 269,9281 + OpcodeArrayLeader 270,9307 + OpcodeStoreArrayLeader 271,9335 + OpcodeAlocLeader 272,9368 + OpcodeBranch 274,9423 + OpcodeBranchTrue 275,9446 + OpcodeBranchTrueElseExtraPop 276,9472 + OpcodeBranchTrueAndExtraPop 277,9510 + OpcodeBranchTrueExtraPop 278,9547 + OpcodeBranchTrueNoPop 279,9581 + OpcodeBranchTrueAndNoPop 280,9612 + OpcodeBranchTrueElseNoPop 281,9646 + OpcodeBranchTrueAndNoPopElseNoPopExtraPop 282,9681 + OpcodeBranchFalse 283,9732 + OpcodeBranchFalseElseExtraPop 284,9759 + OpcodeBranchFalseAndExtraPop 285,9798 + OpcodeBranchFalseExtraPop 286,9836 + OpcodeBranchFalseNoPop 287,9871 + OpcodeBranchFalseAndNoPop 288,9903 + OpcodeBranchFalseElseNoPop 289,9938 + OpcodeBranchFalseAndNoPopElseNoPopExtraPop 290,9974 + OpcodeLoopDecrementTos 291,10026 + OpcodeLoopIncrementTosLessThan 292,10059 + OpcodeBlock0Read 294,10127 + OpcodeBlock1Read 295,10154 + OpcodeBlock2Read 296,10181 + OpcodeBlock3Read 297,10208 + OpcodeBlock0ReadShift 298,10235 + OpcodeBlock1ReadShift 299,10267 + OpcodeBlock2ReadShift 300,10299 + OpcodeBlock3ReadShift 301,10331 + OpcodeBlock0ReadAlu 302,10363 + OpcodeBlock1ReadAlu 303,10393 + OpcodeBlock2ReadAlu 304,10423 + OpcodeBlock3ReadAlu 305,10453 + OpcodeBlock0ReadTest 306,10483 + OpcodeBlock1ReadTest 307,10514 + OpcodeBlock2ReadTest 308,10545 + OpcodeBlock3ReadTest 309,10576 + OpcodeBlock0Write 310,10607 + OpcodeBlock1Write 311,10634 + OpcodeBlock2Write 312,10661 + OpcodeBlock3Write 313,10688 + OpcodeStartCall 315,10740 + OpcodeFinishCallN 316,10765 + OpcodeFinishCallNApply 317,10793 + OpcodeFinishCallTos 318,10826 + OpcodeFinishCallTosApply 319,10856 + OpcodeEntryRestAccepted 320,10891 + OpcodeEntryRestNotAccepted 321,10925 + OpcodeLocateLocals 322,10962 + OpcodeReturnSingle 323,10990 + OpcodeReturnMultiple 324,11019 + OpcodeReturnKludge 325,11050 + OpcodeTakeValues 326,11079 + OpcodeBindLocativeToValue 328,11135 + OpcodeBindLocative 329,11171 + OpcodeUnbindN 330,11198 + OpcodeRestoreBindingStack 331,11222 + OpcodeCatchOpen 333,11270 + OpcodeCatchClose 334,11296 + OpcodePushLexicalVar 336,11371 + OpcodePopLexicalVar 337,11430 + OpcodeMovemLexicalVar 338,11496 + OpcodePushInstanceVariable 340,11591 + OpcodePopInstanceVariable 341,11628 + OpcodeMovemInstanceVariable 342,11664 + OpcodePushAddressInstanceVariable 343,11702 + OpcodePushInstanceVariableOrdered 344,11746 + OpcodePopInstanceVariableOrdered 345,11790 + OpcodeMovemInstanceVariableOrdered 346,11833 + OpcodePushAddressInstanceVariableOrdered 347,11878 + OpcodeInstanceRef 348,11929 + OpcodeInstanceSet 349,11957 + OpcodeInstanceLoc 350,11985 + OpcodeEphemeralp 352,12035 + OpcodeUnsignedLessp 353,12060 + OpcodeUnsignedLesspNoPop 354,12090 + OpcodeAlu 355,12125 + OpcodeAllocateListBlock 356,12145 + OpcodeAllocateStructureBlock 357,12179 + OpcodePointerPlus 358,12218 + OpcodePointerDifference 359,12246 + OpcodePointerIncrement 360,12280 + OpcodeReadInternalRegister 361,12313 + OpcodeWriteInternalRegister 362,12350 + OpcodeCoprocessorRead 363,12388 + OpcodeCoprocessorWrite 364,12420 + OpcodeMemoryRead 365,12453 + OpcodeMemoryReadAddress 366,12480 + OpcodeTag 367,12514 + OpcodeSetTag 368,12533 + OpcodeStoreConditional 369,12556 + OpcodeMemoryWrite 370,12589 + OpcodePStoreContents 371,12617 + OpcodeSetCdrCode1 372,12648 + OpcodeSetCdrCode2 373,12676 + OpcodeMergeCdrNoPop 374,12704 + OpcodeGenericDispatch 375,12734 + OpcodeMessageDispatch 376,12765 + OpcodeJump 377,12796 + OpcodeCheckPreemptRequest 378,12816 + OpcodeNoOp 379,12851 + OpcodeHalt 380,12871 +} IvoryOpcode;381,12890 +typedef enum _IvoryTrapMode383,12906 + TrapModeEmulator,385,12936 + TrapModeExtraStack,386,12956 + TrapModeIO,387,12978 + TrapModeFEP388,12992 +} IvoryTrapMode;389,13006 +#define ReadControlArgumentSize(391,13024 +#define ReadControlExtraArgument(392,13070 +#define ReadControlCallerFrameSize(393,13117 +#define ReadControlApply(394,13166 +#define ReadControlValueDisposition(395,13206 +#define ReadControlCleanupBits(396,13257 +#define ReadControlCleanupCatch(397,13303 +#define ReadControlCleanupBindings(398,13350 +#define ReadControlTrapOnExit(399,13400 +#define ReadControlTrapMode(400,13445 +#define ReadControlCallStarted(401,13488 +#define ReadControlCleanupInProgress(402,13534 +#define ReadControlInstructionTrace(403,13586 +#define ReadControlCallTrace(404,13637 +#define ReadControlTracePending(405,13681 +#define ControlApply 407,13729 +#define ControlCleanupBits 408,13758 +#define ControlTraceBits 409,13796 +#define ControlCallStarted 410,13833 +#define ControlExtraArgument 411,13870 +#define ControlArgumentSize 412,13904 +#define ControlCallerFrameSize 413,13937 +#define ControlValueDisposition 414,13976 +#define WriteControlArgumentSize(416,14018 +#define WriteControlExtraArgument(417,14075 +#define WriteControlCallerFrameSize(418,14133 +#define WriteControlApply(419,14193 +#define WriteControlValueDisposition(420,14244 +#define WriteControlCleanupBits(421,14306 +#define WriteControlCleanupCatch(422,14363 +#define WriteControlCleanupBindings(423,14421 +#define WriteControlTrapOnExit(424,14482 +#define WriteControlTrapMode(425,14538 +#define WriteControlCallStarted(426,14592 +#define WriteControlCleanupInProgress(427,14649 +#define WriteControlInstructionTrace(428,14712 +#define WriteControlCallTrace(429,14774 +#define WriteControlTracePending(430,14829 +typedef enum _InternalRegisters432,14888 + InternalRegisterEA 434,14922 + InternalRegisterFP 435,14949 + InternalRegisterLP 436,14976 + InternalRegisterSP 437,15003 + InternalRegisterMacroSP 438,15030 + InternalRegisterStackCacheLowerBound 439,15062 + InternalRegisterBAR0 440,15107 + InternalRegisterBAR1 441,15136 + InternalRegisterBAR2 442,15167 + InternalRegisterBAR3 443,15198 + InternalRegisterPHTHash0 444,15229 + InternalRegisterPHTHash1 445,15262 + InternalRegisterPHTHash2 446,15297 + InternalRegisterPHTHash3 447,15332 + InternalRegisterEPC 448,15367 + InternalRegisterDPC 449,15396 + InternalRegisterContinuation 450,15425 + InternalRegisterAluAndRotateControl 451,15463 + InternalRegisterControlRegister 452,15508 + InternalRegisterCRArgumentSize 453,15549 + InternalRegisterEphemeralOldspaceRegister 454,15589 + InternalRegisterZoneOldspaceRegister 455,15640 + InternalRegisterChipRevision 456,15686 + InternalRegisterFPCoprocessorPresent 457,15724 + InternalRegisterPreemptRegister 458,15770 + InternalRegisterIcacheControl 459,15811 + InternalRegisterPrefetcherControl 460,15850 + InternalRegisterMapCacheControl 461,15893 + InternalRegisterMemoryControl 462,15935 + InternalRegisterECCLog 463,15974 + InternalRegisterECCLogAddress 464,16006 + InternalRegisterInvalidateMap0 465,16045 + InternalRegisterInvalidateMap1 466,16085 + InternalRegisterInvalidateMap2 467,16126 + InternalRegisterInvalidateMap3 468,16167 + InternalRegisterLoadMap0 469,16208 + InternalRegisterLoadMap1 470,16242 + InternalRegisterLoadMap2 471,16277 + InternalRegisterLoadMap3 472,16312 + InternalRegisterStackCacheOverflowLimit 473,16347 + InternalRegisterUcodeROMContents 474,16396 + InternalRegisterAddressMask 475,16438 + InternalRegisterEntryMaximumArguments 476,16475 + InternalRegisterLexicalVariable 477,16522 + InternalRegisterInstruction 478,16563 + InternalRegisterMemoryData 479,16600 + InternalRegisterDataPins 480,16636 + InternalRegisterExtensionRegister 481,16670 + InternalRegisterMicrosecondClock 482,16713 + InternalRegisterArrayHeaderLength 483,16755 + InternalRegisterLoadBAR0 484,16798 + InternalRegisterLoadBAR1 485,16832 + InternalRegisterLoadBAR2 486,16867 + InternalRegisterLoadBAR3 487,16902 + InternalRegisterTOS 488,16937 + InternalRegisterEventCount 489,16968 + InternalRegisterBindingStackPointer 490,17006 + InternalRegisterCatchBlockList 491,17053 + InternalRegisterControlStackLimit 492,17095 + InternalRegisterControlStackExtraLimit 493,17140 + InternalRegisterBindingStackLimit 494,17190 + InternalRegisterPHTBase 495,17235 + InternalRegisterPHTMask 496,17270 + InternalRegisterCountMapReloads 497,17305 + InternalRegisterListCacheArea 498,17348 + InternalRegisterListCacheAddress 499,17389 + InternalRegisterListCacheLength 500,17433 + InternalRegisterStructureCacheArea 501,17476 + InternalRegisterStructureCacheAddress 502,17522 + InternalRegisterStructureCacheLength 503,17571 + InternalRegisterDynamicBindingCacheBase 504,17619 + InternalRegisterDynamicBindingCacheMask 505,17670 + InternalRegisterChoicePointer 506,17721 + InternalRegisterStructureStackChoicePointer 507,17762 + InternalRegisterFEPModeTrapVectorAddress 508,17817 + InternalRegisterMappingTableCache 509,17869 + InternalRegisterMappingTableLength 510,17914 + InternalRegisterStackFrameMaximumSize 511,17960 + InternalRegisterStackCacheDumpQuantum 512,18009 + InternalRegisterConstantNIL 513,18058 + InternalRegisterConstantT 514,18097 +} InternalRegisters;515,18133 +typedef enum _CoprocessorRegisters517,18155 + CoprocessorRegisterMicrosecondClock 519,18192 +} CoprocessorRegisters;520,18238 +#define TrapVectorBase 522,18263 +typedef enum _TrapVectors524,18298 + ArithmeticInstructionExceptionVector 526,18326 + InstructionExceptionVector 527,18370 + InterpreterFunctionVector 528,18408 + GenericDispatchVector 529,18445 + ErrorTrapVector 531,18481 + ResetTrapVector 532,18508 + PullApplyArgsTrapVector 533,18535 + StackOverflowTrapVector 534,18570 + TraceTrapVector 535,18605 + PreemptRequestTrapVector 536,18632 + TransportTrapVector 537,18668 + FepModeTrapVector 538,18699 + LowPrioritySequenceBreakTrapVector 540,18731 + HighPrioritySequenceBreakTrapVector 541,18777 + MonitorTrapVector 542,18824 + GenericDispatchTrapVector 544,18878 + MessageDispatchTrapVector 546,18940 + PageNotResidentTrapVector 549,19005 + PageFaultRequestTrapVector 550,19042 + PageWriteFaultTrapVector 551,19080 + UncorrectableMemoryErrorTrapVector 552,19116 + MemoryBusErrorTrapVector 553,19162 + DBCacheMissTrapVector 554,19198 + DBUnwindFrameTrapVector 555,19231 + DBUnwindCatchTrapVector 556,19266 +} TrapVectors;557,19300 +#define ReadALUCondition(561,19327 +#define ReadALUConditionSense(562,19383 +#define ReadALUOutputCondition(563,19431 +#define ReadALUEnableConditionException(564,19477 +#define ReadALUEnableLoadCin(565,19532 +#define ReadALUFunctionClass(566,19576 +#define ReadALUBooleanFunction(568,19641 +#define ReadALUByteRotate(570,19710 +#define ReadALUByteSize(571,19750 +#define ReadALUByteBackground(572,19788 +#define ReadALUByteRotateLatch(573,19854 +#define ReadALUByteFunction(574,19900 +#define ReadALUAdderCarryIn(576,19963 +#define ReadALUAdderOp2(577,20006 +typedef enum _ALUBooleanFunction579,20061 + BooleClear,581,20096 + BooleAnd,582,20110 + BooleAndC1,583,20122 + Boole2,584,20136 + BooleAndC2,585,20146 + Boole1,586,20160 + BooleXor,587,20170 + BooleIor,588,20182 + BooleNor,589,20194 + BooleEquiv,590,20206 + BooleC1,591,20220 + BooleOrC1,592,20231 + BooleC2,593,20244 + BooleOrC2,594,20255 + BooleNand,595,20268 + BooleSet596,20281 +} ALUBooleanFunction;597,20292 +typedef enum _ALUByteBackground599,20315 + ALUByteBackgroundOp1,601,20349 + ALUByteBackgroundRotateLatch,602,20373 + ALUByteBackgroundZero603,20405 +} ALUByteBackground;604,20429 +typedef enum _ALUByteFunction606,20451 + ALUByteFunctionDpb,608,20483 + ALUByteFunctionLdb609,20505 +} ALUByteFunction;610,20526 +typedef enum _ALUAdderOp2612,20546 + ALUAdderOp2Op2,614,20574 + ALUAdderOp2Zero,615,20592 + ALUAdderOp2Invert,616,20611 + ALUAdderOp2MinusOne617,20632 +} ALUAdderOp2;618,20654 +typedef enum _ALUCondition620,20670 + ConditionSignedLessThanOrEqual,622,20699 + ConditionSignedLessThan,623,20733 + ConditionNegative,624,20760 + ConditionSignedOverflow,625,20781 + ConditionUnsignedLessThanOrEqual,626,20808 + ConditionUnsignedLessThan,627,20844 + ConditionZero,628,20873 + ConditionHigh25Zero,629,20890 + ConditionEq,630,20913 + ConditionOp1Ephemeralp,631,20928 + ConditionOp1TypeAcceptable,632,20954 + ConditionOp1TypeCondition,633,20984 + ConditionResultTypeNil,634,21013 + ConditionOp2Fixnum,635,21039 + ConditionFalse,636,21061 + ConditionResultCdrLow,637,21079 + ConditionCleanupBitsSet,638,21104 + ConditionAddressInStackCache,639,21131 + ConditionPendingSequenceBreakEnabled,640,21163 + ConditionExtraStackMode,641,21203 + ConditionFepMode,642,21230 + ConditionFpCoprocessorPresent,643,21250 + ConditionOp1Oldspacep,644,21283 + ConditionStackCacheOverflow,645,21308 + ConditionOrLogicVariable646,21339 +} ALUCondition;647,21366 +#define PointerDataTypes 649,21383 +#define PointerTypeP(650,21424 +#define ReadVMAZoneNum(651,21477 +#define EphemeralAddressP(652,21515 +#define ReadVMAEphemeralHalf(653,21565 +#define ReadVMAEphemeralDemilevel(654,21609 + +c-emulator/memory.h,2117 +#define _MEMORY_H8,130 +typedef unsigned char VMAttribute;21,827 +#define VMAttributeAccessFault 23,863 +#define VMAttributeWriteFault 24,897 +#define VMAttributeTransportFault 25,930 +#define VMAttributeTransportDisable 26,967 +#define VMAttributeEphemeral 27,1007 +#define VMAttributeModified 28,1040 +#define VMAttributeExists 29,1072 +#define VMCreatedDefault 31,1104 +#define VMAccessFault(33,1199 +#define VMWriteFault(34,1233 +#define VMTransportFault(35,1266 +#define VMTransportDisable(36,1303 +#define VMEphemeral(37,1343 +#define VMModified(38,1376 +#define VMExists(39,1408 +#define SetVMAccessFault(41,1440 +#define SetVMWriteFault(42,1478 +#define SetVMTransportFault(43,1515 +#define SetVMTransportDisable(44,1556 +#define SetVMEphemeral(45,1600 +#define SetVMModified(46,1637 +#define SetVMExists(47,1673 +#define ClearVMAccessFault(49,1709 +#define ClearVMWriteFault(50,1750 +#define ClearVMTransportFault(51,1790 +#define ClearVMTransportDisable(52,1834 +#define ClearVMEphemeral(53,1881 +#define ClearVMModified(54,1921 +#define ClearVMExists(55,1960 +typedef enum _VMRegisterNumber57,1999 + VMRegisterCommand 59,2032 + VMRegisterAddress,60,2061 + VMRegisterExtent,61,2082 + VMRegisterAttributes,62,2102 + VMRegisterDestination,63,2126 + VMRegisterData64,2151 +} VMRegisterNumber;65,2168 +typedef enum _VMOpcode67,2189 + VMOpcodeLookup,69,2214 + VMOpcodeCreate,70,2256 + VMOpcodeDestroy,71,2274 + VMOpcodeReadAttributes,73,2294 + VMOpcodeWriteAttributes,74,2345 + VMOpcodeFill,76,2398 + VMOpcodeSearch,77,2460 + VMOpcodeCopy,78,2521 + VMOpcodeScan,80,2573 + VMOpcodeEnable81,2589 +} VMOpcode;82,2606 +typedef enum _VMResultCode84,2619 + VMResultSuccess,86,2648 + VMResultFailure87,2667 +} VMResultCode;88,2685 +#define VMCommandOpcode(90,2702 +#define VMCommandOperand(91,2766 +#define SetVMReplyResult(93,2826 +typedef struct _VMState95,2931 + Integer CommandRegister;97,2957 + Integer AddressRegister;98,2984 + Integer ExtentRegister;99,3011 + Integer AttributesRegister;100,3037 + Integer DestinationRegister;101,3067 + LispObj DataRegister;102,3098 +} VMState;103,3122 + +emulator/aihead.h,22198 +#define _AIHEAD_5,166 +#define Type_Null 9,186 +#define Type_MonitorForward 11,207 +#define Type_HeaderP 13,238 +#define Type_HeaderI 15,262 +#define Type_ExternalValueCellPointer 17,286 +#define Type_OneQForward 19,327 +#define Type_HeaderForward 21,355 +#define Type_ElementForward 23,385 +#define Type_Fixnum 25,416 +#define Type_SmallRatio 27,439 +#define Type_SingleFloat 29,466 +#define Type_DoubleFloat 31,495 +#define Type_Bignum 33,524 +#define Type_BigRatio 35,548 +#define Type_Complex 37,574 +#define Type_SpareNumber 39,599 +#define Type_Instance 41,628 +#define Type_ListInstance 43,654 +#define Type_ArrayInstance 45,684 +#define Type_StringInstance 47,715 +#define Type_NIL 49,747 +#define Type_List 51,768 +#define Type_Array 53,790 +#define Type_String 55,813 +#define Type_Symbol 57,837 +#define Type_Locative 59,861 +#define Type_LexicalClosure 61,887 +#define Type_DynamicClosure 63,919 +#define Type_CompiledFunction 65,951 +#define Type_GenericFunction 67,985 +#define Type_SparePointer1 69,1018 +#define Type_SparePointer2 71,1049 +#define Type_PhysicalAddress 73,1080 +#define Type_NativeInstruction 75,1113 +#define Type_BoundLocation 77,1148 +#define Type_Character 79,1179 +#define Type_LogicVariable 81,1206 +#define Type_GCForward 83,1237 +#define Type_EvenPC 85,1264 +#define Type_OddPC 87,1288 +#define Type_CallCompiledEven 89,1311 +#define Type_CallCompiledOdd 91,1345 +#define Type_CallIndirect 93,1378 +#define Type_CallGeneric 95,1408 +#define Type_CallCompiledEvenPrefetch 97,1437 +#define Type_CallCompiledOddPrefetch 99,1479 +#define Type_CallIndirectPrefetch 101,1520 +#define Type_CallGenericPrefetch 103,1558 +#define Type_PackedInstruction60 105,1595 +#define Type_TypePackedInstruction61 107,1632 +#define Type_TypePackedInstruction62 109,1673 +#define Type_PackedInstruction63 111,1714 +#define Type_TypePackedInstruction64 113,1751 +#define Type_TypePackedInstruction65 115,1792 +#define Type_PackedInstruction66 117,1833 +#define Type_TypePackedInstruction67 119,1870 +#define Type_TypePackedInstruction70 121,1911 +#define Type_PackedInstruction71 123,1952 +#define Type_TypePackedInstruction72 125,1989 +#define Type_TypePackedInstruction73 127,2030 +#define Type_PackedInstruction74 129,2071 +#define Type_TypePackedInstruction75 131,2108 +#define Type_TypePackedInstruction76 133,2149 +#define Type_PackedInstruction77 135,2190 +#define Cdr_Next 137,2227 +#define Cdr_Nil 139,2247 +#define Cdr_Normal 141,2266 +#define Array_ElementTypeFixnum 143,2288 +#define Array_ElementTypeCharacter 145,2323 +#define Array_ElementTypeBoolean 147,2361 +#define Array_ElementTypeObject 149,2397 +#define Array_TypeFieldPos 151,2432 +#define Array_TypeFieldSize 153,2463 +#define Array_TypeFieldMask 155,2494 +#define Array_ElementTypePos 157,2526 +#define Array_ElementTypeSize 159,2559 +#define Array_ElementTypeMask 161,2592 +#define Array_BytePackingPos 163,2625 +#define Array_BytePackingSize 165,2658 +#define Array_BytePackingMask 167,2691 +#define Array_ListBitPos 169,2724 +#define Array_ListBitSize 171,2753 +#define Array_ListBitMask 173,2782 +#define Array_NamedStructureBitPos 175,2811 +#define Array_NamedStructureBitSize 177,2850 +#define Array_NamedStructureBitMask 179,2889 +#define Array_Spare1Pos 181,2928 +#define Array_Spare1Size 183,2956 +#define Array_Spare1Mask 185,2984 +#define Array_LongPrefixBitPos 187,3012 +#define Array_LongPrefixBitSize 189,3047 +#define Array_LongPrefixBitMask 191,3082 +#define Array_LeaderLengthFieldPos 193,3117 +#define Array_LeaderLengthFieldSize 195,3156 +#define Array_LeaderLengthFieldMask 197,3195 +#define Array_LengthPos 199,3236 +#define Array_LengthSize 201,3263 +#define Array_LengthMask 203,3292 +#define Array_DisplacedBitPos 205,3324 +#define Array_DisplacedBitSize 207,3358 +#define Array_DisplacedBitMask 209,3392 +#define Array_DiscontiguousBitPos 211,3426 +#define Array_DiscontinuousBitSize 213,3464 +#define Array_DiscontiguousBitMask 215,3502 +#define Array_LongSparePos 217,3540 +#define Array_LongSpareSize 219,3570 +#define Array_LongSpareMask 221,3602 +#define Array_LongDimensionsFieldPos 223,3636 +#define Array_LongDimensionsFieldSize 225,3676 +#define Array_LongDimensionsFieldMask 227,3717 +#define Array_RegisterElementTypePos 229,3758 +#define Array_RegisterElementTypeSize 231,3799 +#define Array_RegisterElementTypeMask 233,3840 +#define Array_RegisterBytePackingPos 235,3881 +#define Array_RegisterBytePackingSize 237,3922 +#define Array_RegisterBytePackingMask 239,3963 +#define Array_RegisterByteOffsetPos 241,4004 +#define Array_RegisterByteOffsetSize 243,4044 +#define Array_RegisterByteOffsetMask 245,4084 +#define Array_RegisterEventCountPos 247,4125 +#define Array_RegisterEventCountSize 249,4164 +#define Array_RegisterEventCountMask 251,4205 +#define ValueDisposition_Effect 253,4251 +#define ValueDisposition_Value 255,4286 +#define ValueDisposition_Return 257,4320 +#define ValueDisposition_Multiple 259,4355 +#define Opcode_Car 261,4392 +#define Opcode_Cdr 263,4414 +#define Opcode_SetToCar 265,4436 +#define Opcode_SetToCdr 267,4464 +#define Opcode_SetToCdrPushCar 269,4492 +#define Opcode_Rplaca 271,4527 +#define Opcode_Rplacd 273,4554 +#define Opcode_Rgetf 275,4581 +#define Opcode_Member 277,4607 +#define Opcode_Assoc 279,4634 +#define Opcode_Dereference 281,4660 +#define Opcode_Unify 283,4691 +#define Opcode_PushLocalLogicVariables 285,4717 +#define Opcode_PushGlobalLogicVariable 287,4760 +#define Opcode_LogicTailTest 289,4803 +#define Opcode_Eq 291,4836 +#define Opcode_EqNoPop 293,4859 +#define Opcode_Eql 295,4887 +#define Opcode_EqlNoPop 297,4911 +#define Opcode_EqualNumber 299,4940 +#define Opcode_EqualNumberNoPop 301,4972 +#define Opcode_Greaterp 303,5009 +#define Opcode_GreaterpNoPop 305,5038 +#define Opcode_Lessp 307,5072 +#define Opcode_LesspNoPop 309,5098 +#define Opcode_Logtest 311,5129 +#define Opcode_LogtestNoPop 313,5157 +#define Opcode_TypeMember 315,5190 +#define Opcode_TypeMemberNoPop 317,5220 +#define Opcode_Endp 319,5255 +#define Opcode_Plusp 321,5278 +#define Opcode_Minusp 323,5303 +#define Opcode_Zerop 325,5329 +#define Opcode_Add 327,5354 +#define Opcode_Sub 329,5378 +#define Opcode_UnaryMinus 331,5402 +#define Opcode_Increment 333,5432 +#define Opcode_Decrement 335,5461 +#define Opcode_Multiply 337,5491 +#define Opcode_Quotient 339,5520 +#define Opcode_Ceiling 341,5549 +#define Opcode_Floor 343,5577 +#define Opcode_Truncate 345,5603 +#define Opcode_Round 347,5632 +#define Opcode_RationalQuotient 349,5658 +#define Opcode_Max 351,5695 +#define Opcode_Min 353,5719 +#define Opcode_Logand 355,5743 +#define Opcode_Logior 357,5770 +#define Opcode_Logxor 359,5797 +#define Opcode_Ash 361,5824 +#define Opcode_Rot 363,5848 +#define Opcode_Lsh 365,5872 +#define Opcode_32BitPlus 367,5896 +#define Opcode_32BitDifference 369,5926 +#define Opcode_MultiplyDouble 371,5962 +#define Opcode_AddBignumStep 373,5997 +#define Opcode_SubBignumStep 375,6031 +#define Opcode_MultiplyBignumStep 377,6065 +#define Opcode_DivideBignumStep 379,6104 +#define Opcode_LshcBignumStep 381,6141 +#define Opcode_DoubleFloatOp 383,6176 +#define Opcode_Push 385,6209 +#define Opcode_Pop 387,6233 +#define Opcode_Movem 389,6257 +#define Opcode_PushNNils 391,6283 +#define Opcode_PushAddress 393,6312 +#define Opcode_SetSpToAddress 395,6344 +#define Opcode_SetSpToAddressSaveTos 397,6379 +#define Opcode_PushAddressSpRelative 399,6421 +#define Opcode_StackBlt 401,6462 +#define Opcode_StackBltAddress 403,6491 +#define Opcode_Ldb 405,6527 +#define Opcode_Dpb 407,6551 +#define Opcode_CharLdb 409,6575 +#define Opcode_CharDpb 411,6603 +#define Opcode_PLdb 413,6631 +#define Opcode_PDpb 415,6656 +#define Opcode_PTagLdb 417,6681 +#define Opcode_PTagDpb 419,6709 +#define Opcode_Aref1 421,6737 +#define Opcode_Aset1 423,6763 +#define Opcode_Aloc1 425,6789 +#define Opcode_Setup1DArray 427,6815 +#define Opcode_SetupForce1DArray 429,6846 +#define Opcode_FastAref1 431,6882 +#define Opcode_FastAset1 433,6912 +#define Opcode_ArrayLeader 435,6942 +#define Opcode_StoreArrayLeader 437,6974 +#define Opcode_AlocLeader 439,7011 +#define Opcode_Branch 441,7042 +#define Opcode_BranchTrue 443,7069 +#define Opcode_BranchTrueElseExtraPop 445,7099 +#define Opcode_BranchTrueAndExtraPop 447,7141 +#define Opcode_BranchTrueExtraPop 449,7182 +#define Opcode_BranchTrueNoPop 451,7220 +#define Opcode_BranchTrueAndNoPop 453,7255 +#define Opcode_BranchTrueElseNoPop 455,7293 +#define Opcode_BranchTrueAndNoPopElseNoPopExtraPop 457,7332 +#define Opcode_BranchFalse 459,7387 +#define Opcode_BranchFalseElseExtraPop 461,7418 +#define Opcode_BranchFalseAndExtraPop 463,7461 +#define Opcode_BranchFalseExtraPop 465,7503 +#define Opcode_BranchFalseNoPop 467,7542 +#define Opcode_BranchFalseAndNoPop 469,7578 +#define Opcode_BranchFalseElseNoPop 471,7617 +#define Opcode_BranchFalseAndNoPopElseNoPopExtraPop 473,7657 +#define Opcode_LoopDecrementTos 475,7713 +#define Opcode_LoopIncrementTosLessThan 477,7750 +#define Opcode_Block0Read 479,7795 +#define Opcode_Block1Read 481,7825 +#define Opcode_Block2Read 483,7855 +#define Opcode_Block3Read 485,7885 +#define Opcode_Block0ReadShift 487,7915 +#define Opcode_Block1ReadShift 489,7950 +#define Opcode_Block2ReadShift 491,7985 +#define Opcode_Block3ReadShift 493,8020 +#define Opcode_Block0ReadAlu 495,8055 +#define Opcode_Block1ReadAlu 497,8089 +#define Opcode_Block2ReadAlu 499,8123 +#define Opcode_Block3ReadAlu 501,8157 +#define Opcode_Block0ReadTest 503,8191 +#define Opcode_Block1ReadTest 505,8225 +#define Opcode_Block2ReadTest 507,8259 +#define Opcode_Block3ReadTest 509,8293 +#define Opcode_Block0Write 511,8327 +#define Opcode_Block1Write 513,8358 +#define Opcode_Block2Write 515,8389 +#define Opcode_Block3Write 517,8420 +#define Opcode_StartCall 519,8451 +#define Opcode_FinishCallN 521,8479 +#define Opcode_FinishCallNApply 523,8510 +#define Opcode_FinishCallTos 525,8546 +#define Opcode_FinishCallTosApply 527,8579 +#define Opcode_EntryRestAccepted 529,8617 +#define Opcode_EntryRestNotAccepted 531,8655 +#define Opcode_LocateLocals 533,8696 +#define Opcode_ReturnSingle 535,8728 +#define Opcode_ReturnMultiple 537,8760 +#define Opcode_ReturnKludge 539,8794 +#define Opcode_TakeValues 541,8826 +#define Opcode_BindLocativeToValue 543,8856 +#define Opcode_BindLocative 545,8896 +#define Opcode_UnbindN 547,8927 +#define Opcode_RestoreBindingStack 549,8954 +#define Opcode_CatchOpen 551,8992 +#define Opcode_CatchClose 553,9022 +#define Opcode_PushLexicalVar 555,9052 +#define Opcode_PopLexicalVar 557,9086 +#define Opcode_MovemLexicalVar 559,9120 +#define Opcode_PushInstanceVariable 561,9156 +#define Opcode_PopInstanceVariable 563,9196 +#define Opcode_MovemInstanceVariable 565,9236 +#define Opcode_PushAddressInstanceVariable 567,9278 +#define Opcode_PushInstanceVariableOrdered 569,9325 +#define Opcode_PopInstanceVariableOrdered 571,9372 +#define Opcode_MovemInstanceVariableOrdered 573,9419 +#define Opcode_PushAddressInstanceVariableOrdered 575,9468 +#define Opcode_InstanceRef 577,9522 +#define Opcode_InstanceSet 579,9554 +#define Opcode_InstanceLoc 581,9586 +#define Opcode_Ephemeralp 583,9618 +#define Opcode_UnsignedLessp 585,9647 +#define Opcode_UnsignedLesspNoPop 587,9681 +#define Opcode_Alu 589,9720 +#define Opcode_AllocateListBlock 591,9744 +#define Opcode_AllocateStructureBlock 593,9782 +#define Opcode_PointerPlus 595,9825 +#define Opcode_PointerDifference 597,9857 +#define Opcode_PointerIncrement 599,9895 +#define Opcode_ReadInternalRegister 601,9932 +#define Opcode_WriteInternalRegister 603,9973 +#define Opcode_CoprocessorRead 605,10015 +#define Opcode_CoprocessorWrite 607,10051 +#define Opcode_MemoryRead 609,10088 +#define Opcode_MemoryReadAddress 611,10118 +#define Opcode_Tag 613,10155 +#define Opcode_SetTag 615,10178 +#define Opcode_StoreConditional 617,10205 +#define Opcode_MemoryWrite 619,10242 +#define Opcode_PStoreContents 621,10274 +#define Opcode_SetCdrCode1 623,10309 +#define Opcode_SetCdrCode2 625,10341 +#define Opcode_MergeCdrNoPop 627,10373 +#define Opcode_GenericDispatch 629,10407 +#define Opcode_MessageDispatch 631,10442 +#define Opcode_Jump 633,10477 +#define Opcode_CheckPreemptRequest 635,10500 +#define Opcode_NoOp 637,10539 +#define Opcode_Halt 639,10563 +#define Control_Apply 641,10587 +#define Control_CleanupBits 643,10617 +#define Control_CallStarted 645,10656 +#define Control_ExtraArgument 647,10693 +#define Control_ArgumentSize 649,10728 +#define Control_CallerFrameSize 651,10762 +#define Control_ValueDisposition 653,10802 +#define InternalRegister_EA 655,10843 +#define InternalRegister_FP 657,10874 +#define InternalRegister_LP 659,10905 +#define InternalRegister_SP 661,10936 +#define InternalRegister_MacroSP 663,10967 +#define InternalRegister_StackCacheLowerBound 665,11003 +#define InternalRegister_BAR0 667,11052 +#define InternalRegister_BAR1 669,11085 +#define InternalRegister_BAR2 671,11120 +#define InternalRegister_BAR3 673,11155 +#define InternalRegister_PHTHash0 675,11190 +#define InternalRegister_PHTHash1 677,11227 +#define InternalRegister_PHTHash2 679,11266 +#define InternalRegister_PHTHash3 681,11305 +#define InternalRegister_EPC 683,11344 +#define InternalRegister_DPC 685,11376 +#define InternalRegister_Continuation 687,11408 +#define InternalRegister_AluAndRotateControl 689,11450 +#define InternalRegister_ControlRegister 691,11499 +#define InternalRegister_CRArgumentSize 693,11544 +#define InternalRegister_EphemeralOldspaceRegister 695,11588 +#define InternalRegister_ZoneOldspaceRegister 697,11643 +#define InternalRegister_ChipRevision 699,11693 +#define InternalRegister_FPCoprocessorPresent 701,11735 +#define InternalRegister_PreemptRegister 703,11785 +#define InternalRegister_IcacheControl 705,11830 +#define InternalRegister_PrefetcherControl 707,11873 +#define InternalRegister_MapCacheControl 709,11920 +#define InternalRegister_MemoryControl 711,11965 +#define InternalRegister_ECCLog 713,12008 +#define InternalRegister_ECCLogAddress 715,12044 +#define InternalRegister_InvalidateMap0 717,12087 +#define InternalRegister_InvalidateMap1 719,12131 +#define InternalRegister_InvalidateMap2 721,12176 +#define InternalRegister_InvalidateMap3 723,12221 +#define InternalRegister_LoadMap0 725,12266 +#define InternalRegister_LoadMap1 727,12304 +#define InternalRegister_LoadMap2 729,12343 +#define InternalRegister_LoadMap3 731,12382 +#define InternalRegister_StackCacheOverflowLimit 733,12421 +#define InternalRegister_UcodeROMContents 735,12474 +#define InternalRegister_AddressMask 737,12520 +#define InternalRegister_EntryMaximumArguments 739,12561 +#define InternalRegister_LexicalVariable 741,12612 +#define InternalRegister_Instruction 743,12657 +#define InternalRegister_MemoryData 745,12698 +#define InternalRegister_DataPins 747,12738 +#define InternalRegister_ExtensionRegister 749,12776 +#define InternalRegister_MicrosecondClock 751,12823 +#define InternalRegister_ArrayHeaderLength 753,12869 +#define InternalRegister_LoadBAR0 755,12916 +#define InternalRegister_LoadBAR1 757,12954 +#define InternalRegister_LoadBAR2 759,12993 +#define InternalRegister_LoadBAR3 761,13032 +#define InternalRegister_TOS 763,13071 +#define InternalRegister_EventCount 765,13105 +#define InternalRegister_BindingStackPointer 767,13146 +#define InternalRegister_CatchBlockList 769,13196 +#define InternalRegister_ControlStackLimit 771,13241 +#define InternalRegister_ControlStackExtraLimit 773,13289 +#define InternalRegister_BindingStackLimit 775,13342 +#define InternalRegister_PHTBase 777,13390 +#define InternalRegister_PHTMask 779,13428 +#define InternalRegister_CountMapReloads 781,13466 +#define InternalRegister_ListCacheArea 783,13512 +#define InternalRegister_ListCacheAddress 785,13556 +#define InternalRegister_ListCacheLength 787,13603 +#define InternalRegister_StructureCacheArea 789,13649 +#define InternalRegister_StructureCacheAddress 791,13698 +#define InternalRegister_StructureCacheLength 793,13750 +#define InternalRegister_DynamicBindingCacheBase 795,13801 +#define InternalRegister_DynamicBindingCacheMask 797,13855 +#define InternalRegister_ChoicePointer 799,13909 +#define InternalRegister_StructureStackChoicePointer 801,13953 +#define InternalRegister_FEPModeTrapVectorAddress 803,14011 +#define InternalRegister_MappingTableCache 805,14066 +#define InternalRegister_MappingTableLength 807,14114 +#define InternalRegister_StackFrameMaximumSize 809,14163 +#define InternalRegister_StackCacheDumpQuantum 811,14215 +#define InternalRegister_ConstantNIL 813,14267 +#define InternalRegister_ConstantT 815,14309 +#define CoprocessorRegister_MicrosecondClock 817,14349 +#define CoprocessorRegister_HostInterrupt 819,14399 +#define CoprocessorRegister_VMRegisterCommand 821,14446 +#define CoprocessorRegister_VMRegisterAddress 823,14497 +#define CoprocessorRegister_VMRegisterExtent 825,14548 +#define CoprocessorRegister_VMRegisterAttributes 827,14598 +#define CoprocessorRegister_VMRegisterDestination 829,14652 +#define CoprocessorRegister_VMRegisterData 831,14707 +#define CoprocessorRegister_VMRegisterMaskLow 833,14755 +#define CoprocessorRegister_VMRegisterMaskHigh 835,14806 +#define CoprocessorRegister_VMRegisterCommandBlock 837,14858 +#define CoprocessorRegister_StackSwitch 839,14914 +#define CoprocessorRegister_FlushStackCache 841,14959 +#define CoprocessorRegister_FlushIDCaches 843,15008 +#define CoprocessorRegister_CalendarClock 845,15055 +#define CoprocessorRegister_FlushCachesForVMA 847,15102 +#define CoprocessorRegister_FlipToStack 849,15153 +#define CoprocessorRegister_UnwindStackForRestartOrApply 851,15198 +#define CoprocessorRegister_SaveWorld 853,15260 +#define CoprocessorRegister_ConsoleInputAvailableP 855,15303 +#define CoprocessorRegister_WaitForEvent 857,15359 +#define CoprocessorRegister_FlushHiddenArrayRegisters 859,15405 +#define CoprocessorRegister_ConsoleIO 861,15464 +#define CoprocessorRegister_AttachDiskChannel 863,15507 +#define CoprocessorRegister_GrowDiskPartition 865,15558 +#define CoprocessorRegister_DetachDiskChannel 867,15609 +#define CoprocessorRegister_UnixCrypt 869,15660 +#define Address_NIL 871,15703 +#define Address_T 873,15735 +#define ALUCondition_SignedLessThanOrEqual 875,15765 +#define ALUCondition_SignedLessThan 877,15811 +#define ALUCondition_Negative 879,15850 +#define ALUCondition_SignedOverflow 881,15883 +#define ALUCondition_UnsignedLessThanOrEqual 883,15922 +#define ALUCondition_UnsignedLessThan 885,15970 +#define ALUCondition_Zero 887,16011 +#define ALUCondition_High25Zero 889,16040 +#define ALUCondition_Eq 891,16075 +#define ALUCondition_Op1Ephemeralp 893,16102 +#define ALUCondition_Op1TypeAcceptable 895,16140 +#define ALUCondition_Op1TypeCondition 897,16183 +#define ALUCondition_ResultTypeNil 899,16225 +#define ALUCondition_Op2Fixnum 901,16264 +#define ALUCondition_False 903,16299 +#define ALUCondition_ResultCdrLow 905,16330 +#define ALUCondition_CleanupBitsSet 907,16368 +#define ALUCondition_AddressInStackCache 909,16408 +#define ALUCondition_PendingSequenceBreakEnabled 911,16453 +#define ALUCondition_ExtraStackMode 913,16506 +#define ALUCondition_FepMode 915,16546 +#define ALUCondition_FpCoprocessorPresent 917,16579 +#define ALUCondition_Op1Oldspacep 919,16625 +#define ALUCondition_StackCacheOverflow 921,16663 +#define ALUCondition_OrLogicVariable 923,16707 +#define ALUAdderOp2_Op2 925,16748 +#define ALUAdderOp2_Zero 927,16775 +#define ALUAdderOp2_Invert 929,16803 +#define ALUAdderOp2_MinusOne 931,16833 +#define ALUByteFunction_Dpb 933,16865 +#define ALUByteFunction_Ldb 935,16896 +#define ALUByteBackground_Op1 937,16927 +#define ALUByteBackground_RotateLatch 939,16960 +#define ALUByteBackground_Zero 941,17001 +#define Boole_Clear 943,17035 +#define Boole_And 945,17058 +#define Boole_AndC1 947,17079 +#define Boole_2 949,17102 +#define Boole_AndC2 951,17121 +#define Boole_1 953,17144 +#define Boole_Xor 955,17163 +#define Boole_Ior 957,17184 +#define Boole_Nor 959,17205 +#define Boole_Equiv 961,17226 +#define Boole_C1 963,17249 +#define Boole_OrC1 965,17270 +#define Boole_C2 967,17293 +#define Boole_OrC2 969,17314 +#define Boole_Nand 971,17337 +#define Boole_Set 973,17360 +#define ALUFunction_Boolean 975,17382 +#define ALUFunction_Byte 977,17413 +#define ALUFunction_Adder 979,17441 +#define ALUFunction_MultiplyDivide 981,17470 +#define Cycle_DataRead 983,17508 +#define Cycle_DataWrite 985,17534 +#define Cycle_BindRead 987,17561 +#define Cycle_BindWrite 989,17587 +#define Cycle_BindReadNoMonitor 991,17614 +#define Cycle_BindWriteNoMonitor 993,17649 +#define Cycle_Header 995,17685 +#define Cycle_StructureOffset 997,17709 +#define Cycle_Scavenge 999,17742 +#define Cycle_Cdr 1001,17768 +#define Cycle_GCCopy 1003,17789 +#define Cycle_Raw 1005,17814 +#define Cycle_RawTranslate 1007,17836 +#define MemoryAction_None 1009,17867 +#define MemoryAction_Indirect 1011,17896 +#define MemoryAction_Monitor 1013,17929 +#define MemoryAction_Transport 1015,17961 +#define MemoryAction_Trap 1017,17995 +#define MemoryAction_Transform 1019,18024 +#define MemoryAction_Binding 1021,18059 +#define TrapMode_Emulator 1023,18092 +#define TrapMode_ExtraStack 1025,18121 +#define TrapMode_IO 1027,18152 +#define TrapMode_FEP 1029,18175 +#define ReturnValue_Normal 1031,18199 +#define ReturnValue_Exception 1033,18229 +#define ReturnValue_IllegalOperand 1035,18262 +#define HaltReason_IllInstn 1037,18300 +#define HaltReason_Halted 1039,18331 +#define HaltReason_SpyCalled 1041,18360 +#define HaltReason_FatalStackOverflow 1043,18392 +#define HaltReason_IllegalTrapVector 1045,18433 +#define TrapReason_HighPrioritySequenceBreak 1047,18473 +#define TrapReason_LowPrioritySequenceBreak 1049,18521 +#define VMAttribute_AccessFault 1051,18568 +#define VMAttribute_WriteFault 1053,18603 +#define VMAttribute_TransportFault 1055,18637 +#define VMAttribute_TransportDisable 1057,18675 +#define VMAttribute_Ephemeral 1059,18715 +#define VMAttribute_Modified 1061,18749 +#define VMAttribute_Exists 1063,18782 +#define VMAttribute_CreatedDefault 1065,18813 +#define MemoryPage_Size 1067,18852 +#define MemoryPage_AddressShift 1069,18882 +#define DoubleFloatOp_Add 1071,18918 +#define DoubleFloatOp_Sub 1073,18947 +#define DoubleFloatOp_Multiply 1075,18976 +#define DoubleFloatOp_Divide 1077,19010 + +emulator/aistat.h,10764 +#define _AISTAT_5,172 +typedef struct processorstate 9,192 + uint64_t transpare3;10,224 + uint64_t transpare2;11,252 + uint64_t transpare1;12,280 + uint64_t carcdrsubroutine;13,308 + uint64_t cdrsubroutine;14,342 + uint64_t carsubroutine;15,373 + uint64_t linkage;16,404 + uint64_t resumeema;17,429 + char *statistics;statistics18,456 + char *trace_hook;trace_hook19,484 + int64_t instruction_count;20,512 + uint64_t long_pad0;21,547 + uint64_t asrr9;22,574 + uint64_t asrr10;23,597 + uint64_t asrr11;24,621 + uint64_t asrr12;25,645 + uint64_t asrr13;26,669 + uint64_t asrr14;27,693 + uint64_t asrr15;28,717 + uint64_t long_pad1;29,741 + uint64_t asrr26;30,768 + uint64_t asrr27;31,792 + uint64_t asrr29;32,816 + uint64_t asrr30;33,840 + uint64_t asrf2;34,864 + uint64_t asrf3;35,887 + uint64_t asrf4;36,910 + uint64_t asrf5;37,933 + uint64_t asrf6;38,956 + uint64_t asrf7;39,979 + uint64_t asrf8;40,1002 + uint64_t asrf9;41,1025 + char *meterdatabuff;meterdatabuff42,1048 + uint32_t meterpos;43,1079 + uint32_t metermax;44,1105 + uint32_t meterfreq;45,1131 + uint32_t metermask;46,1158 + uint32_t metervalue;47,1185 + uint32_t metercount;48,1213 + uint64_t choiceptr;49,1241 + uint64_t sstkchoiceptr;50,1268 + uint64_t dbcbase;51,1299 + uint64_t dbcmask;52,1324 + char *coprocessorreadhook;coprocessorreadhook53,1349 + char *coprocessorwritehook;coprocessorwritehook54,1386 + char *flushcaches_hook;flushcaches_hook55,1424 + char *i_stage_error_hook;i_stage_error_hook56,1458 + uint64_t sfp1;57,1494 + uint64_t fp0;58,1516 + uint64_t fp1;59,1537 + uint64_t floating_exception;60,1558 + uint64_t aluandrotatecontrol;61,1594 + uint64_t rotatelatch;62,1631 + uint64_t aluborrow;63,1660 + uint64_t aluoverflow;64,1687 + uint64_t alulessthan;65,1716 + uint64_t aluop;66,1745 + uint64_t byterotate;67,1768 + uint64_t bytesize;68,1796 + int64_t bindingstacklimit;69,1822 + int64_t bindingstackpointer;70,1857 + uint64_t catchblock;71,1894 + uint64_t extraandcatch;72,1922 + uint64_t msclockcache;73,1953 + uint64_t mscmultiplier;74,1983 + uint64_t previousrcpp;75,2014 + char *rlink;rlink76,2044 + uint32_t interruptreg;77,2067 + uint32_t zoneoldspace;78,2097 + uint32_t ephemeraloldspace;79,2127 + uint32_t int_pad0;80,2162 + uint64_t eqnoteql;81,2188 + uint32_t lclength;82,2214 + uint32_t sclength;83,2240 + uint64_t lcarea;84,2266 + uint64_t lcaddress;85,2290 + uint64_t scarea;86,2317 + uint64_t scaddress;87,2341 + uint64_t restartsp;88,2368 + uint64_t stop_interpreter;89,2395 + uint64_t immediate_arg;90,2429 + uint64_t continuationcp;91,2460 + int64_t continuation;92,2492 + int64_t control;93,2522 + int64_t niladdress;94,2547 + int64_t taddress;95,2575 + int64_t bar0;96,2601 + int64_t bar1;97,2623 + int64_t bar2;98,2645 + int64_t bar3;99,2667 + int64_t epc;100,2689 + int64_t fp;101,2710 + int64_t lp;102,2730 + int64_t sp;103,2750 + char *cp;cp104,2770 + uint64_t fccrmask;105,2790 + uint32_t cslimit;106,2816 + uint32_t csextralimit;107,2841 + char *trapmeterdata;trapmeterdata108,2871 + uint64_t fepmodetrapvecaddress;109,2902 + uint64_t trapvecbase;110,2941 + uint64_t tvi;111,2970 + uint64_t fccrtrapmask;112,2991 + char *ptrtype;ptrtype113,3021 + char *vmattributetable;vmattributetable114,3046 + uint64_t vma;115,3080 + int64_t mostnegativefixnum;116,3101 + char *icachebase;icachebase117,3137 + char *endicache;endicache118,3165 + uint64_t fullworddispatch;119,3192 + uint64_t halfworddispatch;120,3226 + int64_t areventcount;121,3260 + uint64_t stackcachesize;122,3290 + uint64_t stackcachetopvma;123,3322 + uint64_t cdrcodemask;124,3356 + char *stackcachedata;stackcachedata125,3385 + uint64_t stackcachebasevma;126,3417 + uint32_t scovlimit;127,3452 + uint32_t scovdumpcount;128,3479 + int64_t mostpositivefixnum;129,3510 + uint64_t internalregisterread1;130,3546 + uint64_t internalregisterread2;131,3585 + uint64_t internalregisterwrite1;132,3624 + uint64_t internalregisterwrite2;133,3664 + uint64_t dataread_mask;134,3704 + char *dataread;dataread135,3735 + uint64_t datawrite_mask;136,3761 + char *datawrite;datawrite137,3793 + uint64_t bindread_mask;138,3820 + char *bindread;bindread139,3851 + uint64_t bindwrite_mask;140,3877 + char *bindwrite;bindwrite141,3909 + uint64_t bindreadnomonitor_mask;142,3936 + char *bindreadnomonitor;bindreadnomonitor143,3976 + uint64_t bindwritenomonitor_mask;144,4011 + char *bindwritenomonitor;bindwritenomonitor145,4052 + uint64_t header_mask;146,4088 + char *header;header147,4117 + uint64_t structureoffset_mask;148,4141 + char *structureoffset;structureoffset149,4179 + uint64_t scavenge_mask;150,4212 + char *scavenge;scavenge151,4243 + uint64_t cdr_mask;152,4269 + char *cdr;cdr153,4295 + uint64_t gccopy_mask;154,4316 + char *gccopy;gccopy155,4345 + uint64_t raw_mask;156,4369 + char *raw;raw157,4395 + uint64_t rawtranslate_mask;158,4416 + char *rawtranslate;rawtranslate159,4451 + int32_t please_stop;160,4481 + int32_t please_trap;161,4510 + int64_t runningp;162,4539 + uint64_t ac0array;163,4565 + uint64_t ac0arword;164,4591 + uint64_t ac0locat;165,4618 + uint64_t ac0length;166,4644 + uint64_t ac1array;167,4671 + uint64_t ac1arword;168,4697 + uint64_t ac1locat;169,4724 + uint64_t ac1length;170,4750 + uint64_t ac2array;171,4777 + uint64_t ac2arword;172,4803 + uint64_t ac2locat;173,4830 + uint64_t ac2length;174,4856 + uint64_t ac3array;175,4883 + uint64_t ac3arword;176,4909 + uint64_t ac3locat;177,4936 + uint64_t ac3length;178,4962 + uint64_t ac4array;179,4989 + uint64_t ac4arword;180,5015 + uint64_t ac4locat;181,5042 + uint64_t ac4length;182,5068 + uint64_t ac5array;183,5095 + uint64_t ac5arword;184,5121 + uint64_t ac5locat;185,5148 + uint64_t ac5length;186,5174 + uint64_t ac6array;187,5201 + uint64_t ac6arword;188,5227 + uint64_t ac6locat;189,5254 + uint64_t ac6length;190,5280 + uint64_t ac7array;191,5307 + uint64_t ac7arword;192,5333 + uint64_t ac7locat;193,5360 + uint64_t ac7length;194,5386 + uint32_t tmcurrenttransaction;195,5413 + uint32_t tmwritestart;196,5451 + uint32_t tmwritecurrent;197,5481 + uint32_t tmwritelimit;198,5513 + uint32_t tmrecordingreads;199,5543 + uint32_t tmreadstart;200,5577 + uint32_t tmreadcurrent;201,5606 + uint32_t tmreadlimit;202,5637 + } PROCESSORSTATE, *PROCESSORSTATEP;PROCESSORSTATEP203,5666 +#define PROCESSORSTATE_SIZE 205,5704 +typedef struct cacheline 207,5738 + uint64_t annotation;208,5765 + uint32_t nextpcdata;209,5793 + uint32_t nextpctag;210,5821 + char *nextcp;nextcp211,5848 + uint32_t instruction;212,5872 + uint32_t operand;213,5901 + uint32_t pcdata;214,5926 + uint32_t pctag;215,5950 + char *code;code216,5973 + } CACHELINE, *CACHELINEP;CACHELINEP217,5995 +#define CACHELINE_SIZE 219,6023 +#define CacheLine_Bits 221,6050 +#define CacheLine_Mask 223,6077 +#define CacheLine_RShift 225,6108 +#define CacheLine_LShift 227,6137 +#define CacheLine_FillAmount 229,6165 +typedef struct arraycache 231,6198 + uint64_t array;232,6226 + uint64_t arword;233,6249 + uint64_t locat;234,6273 + uint64_t length;235,6296 + } ARRAYCACHE, *ARRAYCACHEP;ARRAYCACHEP236,6320 +#define AutoArrayReg_Mask 238,6350 +#define AutoArrayReg_Size 240,6381 +#define AutoArrayReg_Shift 242,6411 +#define MSclock_UnitsToMSShift 244,6441 +#define MSclock_UnitsPerMicrosecond 246,6476 +#define Stack_CacheSize 248,6522 +#define Stack_MaxFrameSize 250,6552 +#define Stack_CacheMargin 252,6584 +#define Stack_CacheDumpQuantum 254,6615 +#define IvoryMemory_Data 256,6651 +#define IvoryMemory_Tag 258,6680 +typedef struct savedregisters 260,6708 + uint64_t r9;261,6740 + uint64_t r10;262,6760 + uint64_t r11;263,6781 + uint64_t r12;264,6802 + uint64_t r13;265,6823 + uint64_t r14;266,6844 + uint64_t r15;267,6865 + uint64_t r29;268,6886 + uint64_t f2;269,6907 + uint64_t f3;270,6927 + uint64_t f4;271,6947 + uint64_t f5;272,6967 + uint64_t f6;273,6987 + uint64_t f7;274,7007 + uint64_t f8;275,7027 + uint64_t f9;276,7047 + } SAVEDREGISTERS, *SAVEDREGISTERSP;SAVEDREGISTERSP277,7067 +#define SAVEDREGISTERS_SIZE 279,7105 +typedef struct tracedata 281,7138 + uint64_t n_entries;282,7165 + uint32_t recording_p;283,7192 + uint32_t wrap_p;284,7221 + uint64_t start_pc;285,7245 + uint64_t stop_pc;286,7271 + char *records_start;records_start287,7296 + char *records_end;records_end288,7327 + char *current_entry;current_entry289,7356 + char *printer;printer290,7387 + } TRACEDATA, *TRACEDATAP;TRACEDATAP291,7412 +#define TRACEDATA_SIZE 293,7440 +typedef struct tracerecord 295,7467 + uint64_t counter;296,7496 + uint64_t epc;297,7521 + uint64_t tos;298,7542 + uint64_t sp;299,7563 + char *instruction;instruction300,7583 + uint64_t instruction_data;301,7612 + uint32_t operand;302,7646 + uint32_t trap_p;303,7671 + uint64_t trap_data_0;304,7695 + uint64_t trap_data_1;305,7724 + uint64_t trap_data_2;306,7753 + uint64_t trap_data_3;307,7782 + uint32_t catch_block_p;308,7811 + uint32_t int_pad0;309,7842 + uint64_t catch_block_0;310,7868 + uint64_t catch_block_1;311,7899 + uint64_t catch_block_2;312,7930 + uint64_t catch_block_3;313,7961 + } TRACERECORD, *TRACERECORDP;TRACERECORDP314,7992 +#define TRACERECORD_SIZE 316,8024 +#define CacheMeter_Pwr 318,8054 +#define CacheMeter_DefaultFreq 320,8081 + +emulator/asmfuns.h,23 +#define _ASMFUNS_4,56 + +emulator/BootComm.h,1589 +#define _BOOTCOM_6,140 +#define BootCommAreaAddress 11,204 +#define BootCommAreaSize 12,244 +#define BootCommSlotAddress(15,330 +#define ReadBootCommSlot(20,546 +#define ReadBootCommSlot(23,649 +#define WriteBootCommSlot(29,838 +#define WriteBootCommSlot(37,1054 + EmbWord embCommArea;46,1240 + EmbWord systemType;47,1320 + EmbWord stackBase;48,1382 + EmbWord stackSize;49,1402 + EmbWord spyPC;50,1422 + EmbWord spyCommandAddress;51,1438 + EmbWord spyStatusAddress;52,1482 + EmbWord spyBlockAddress;53,1525 + EmbWord crashAddress;54,1551 + EmbWord crashActionAddress;55,1591 + EmbWord bootPROMVersion;56,1636 + } BootCommArea;57,1662 +#define BootStackBase 61,1721 +#define BootStackSize 62,1755 +#define BootDataAreaAddress 67,1865 +#define BootDataAreaOffset 68,1905 +#define BootDataAreaSize 69,1935 +#define BootDataSlotAddress(72,2021 +#define ReadBootDataSlot(77,2258 +#define ReadBootDataSlot(80,2361 +#define WriteBootDataSlot(86,2550 +#define WriteBootDataSlot(94,2766 + EmbWord bootSpyCommand;103,2952 + EmbWord bootSpyStatus;104,2977 + EmbWord crashAction;105,3001 + EmbWord crashType;106,3023 + EmbWord crashFatalPC;109,3055 + EmbWord crashTrapNumber;110,3079 + } crashWord1;111,3106 + EmbWord crashFatalVMA;114,3136 + EmbWord crashTrapPC;115,3161 + } crashWord2;116,3184 + EmbWord crashFatalFEPVector;119,3214 + EmbWord crashTrapArgs;120,3245 + } crashWord3;121,3270 + EmbWord bootFEPKernelDPN;122,3288 + EmbWord bootDevicePROMVersion;123,3315 + EmbWord bootColorStartupFileDPN;124,3347 + EmbWord bootSelectedConsoleType;125,3381 + } BootDataArea;126,3415 + +emulator/FEPComm.h,4182 +#define _FEPCOM_6,125 +#define FEPCommAreaAddress 11,188 +#define FEPCommAreaSize 12,227 +#define FEPCommSlotAddress(15,312 +#define ReadFEPCommSlot(20,524 +#define ReadFEPCommSlot(23,625 +#define WriteFEPCommSlot(29,811 +#define WriteFEPCommSlot(37,1025 + EmbWord fepVersionNumber;48,1249 + EmbWord systemType;49,1276 + EmbWord fepStartup;50,1297 + EmbWord spyCommand;51,1318 + EmbWord spyStatus;52,1360 + EmbWord spyPC;53,1401 + EmbWord loadMapSize;54,1439 + EmbWord loadMapVMAAddress;55,1461 + EmbWord loadMapOpcodeAddress;56,1489 + EmbWord loadMapOperandAddress;57,1520 + EmbWord swapMapSize;58,1552 + EmbWord swapMapAddress;59,1574 + EmbWord swapMapDPNAddress;60,1599 + EmbWord mainMemoryMapSize;61,1627 + EmbWord mainMemoryMapAddress;62,1655 + EmbWord badMemoryPagesSize;63,1686 + EmbWord badMemoryPagesAddress;64,1715 + EmbWord fepPhysicalAddressHigh;65,1747 + EmbWord unwiredVirtualAddressLow;66,1780 + EmbWord unwiredVirtualAddressHigh;67,1815 + EmbWord unwiredPhysicalAddressLow;68,1851 + EmbWord unwiredPhysicalAddressHigh;69,1887 + EmbWord requestingLispToStop;70,1924 + EmbWord currentFEPOverlays;71,1955 + EmbWord embCommunicationArea;72,1984 + EmbWord loadedBandName;73,2015 + EmbWord netbootControlString;74,2040 + EmbWord softwareConfiguration;75,2071 + EmbWord netAddress1;76,2103 + EmbWord netAddress2;77,2125 + EmbWord primaryNetworkAddress;78,2147 + EmbWord fepCommandString;79,2179 + EmbWord fepCrashDataRequest;80,2206 + EmbWord coldLoadStreamReadCharacter;81,2236 + EmbWord coldLoadStreamListen;82,2274 + EmbWord coldLoadStreamReadHardwareCharacter;83,2305 + EmbWord coldLoadStreamDrawCharacter;84,2351 + EmbWord coldLoadStreamDisplayLozengedString;85,2389 + EmbWord coldLoadStreamSelect;86,2435 + EmbWord coldLoadStreamBeep;87,2466 + EmbWord coldLoadStreamFinish;88,2495 + EmbWord coldLoadStreamInsideSize;89,2526 + EmbWord coldLoadStreamSetCursorpos;90,2561 + EmbWord coldLoadStreamReadCursorpos;91,2598 + EmbWord coldLoadStreamComputeMotion;92,2636 + EmbWord coldLoadStreamClearBetweenCursorposes;93,2674 + EmbWord coldLoadStreamSetEdges;94,2722 + EmbWord mainScreenParameters;95,2755 + EmbWord wiredFormat;96,2786 + EmbWord fepSequenceBreak;97,2808 + EmbWord lispStoppedCleanly;98,2854 + EmbWord loadPagesToSwapAreaP;99,2883 + EmbWord remoteDebugLoop;100,2914 + EmbWord timezoneOffsetMinutes;101,2940 + EmbWord timezoneName;102,2972 + EmbWord namespaceDescriptorFile;103,2995 + EmbWord siteName;104,3029 + EmbWord savedLispRegisters;105,3048 + EmbWord lispStateSaved;106,3077 + EmbWord enableFPAp;107,3102 + EmbWord diskUnitTable;108,3123 + EmbWord hardwareConfiguration;109,3147 + EmbWord slaveBufferBaseAddress;110,3179 + EmbWord kernelCompressedStringArray;111,3212 + EmbWord domino8032State;112,3250 + } FEPCommArea;113,3276 + EmbWord fepVersionNumber;121,3370 + EmbWord systemType;122,3397 + EmbWord fepStartup;123,3418 + EmbWord embCommunicationArea;124,3439 + EmbWord memorySegmentFreeList;125,3470 + EmbWord unallocatedPhysicalMemory;126,3502 + EmbWord phtSize;127,3538 + EmbWord phtCollisionCountsBase;128,3556 + EmbWord phtCollisionCount;129,3589 + EmbWord phtRehashes;130,3617 + EmbWord unmappedMemoryBase;131,3639 + EmbWord allocatePhyiscalMemoryAtAddress;132,3668 + EmbWord allocatePhysicalMemory;133,3710 + EmbWord deallocatePhysicalMemory;134,3743 + EmbWord romPHTLookup;135,3778 + EmbWord romPHTPut;136,3801 + EmbWord romPHTRemove;137,3821 + EmbWord romPHTRehash;138,3844 + EmbWord romError;139,3867 + EmbWord clearMapCache;140,3886 + EmbWord localIPAddress0;141,3910 + EmbWord diagnosticIPAddress;142,3936 + EmbWord romMBINGetReceiveBuffer;143,3966 + EmbWord romMBINReturnReceiveBuffer;144,4000 + EmbWord romMBINGetTransmitBuffer;145,4037 + EmbWord romMBINSendTransmitBuffer;146,4072 + EmbWord initializeInteractor;147,4108 + EmbWord localIPAddress1;148,4139 + EmbWord localIPSubnetMask0;149,4165 + EmbWord localIPSubnetMask1;150,4194 + EmbWord gatewayIPAddress0;151,4223 + EmbWord gatewayIPAddress1;152,4251 + EmbWord loadServerIPAddress;153,4279 + EmbWord hardwareECORegisters;154,4309 + EmbWord ethernetDriver0;155,4340 + EmbWord ethernetDriver1;156,4366 + EmbWord romUpdateRendezvousParameters;157,4392 + } FEPCommArea;158,4432 + +emulator/ivory.h,14409 +#define _IVORY_H6,84 +#define AddressNIL 8,102 +#define AddressT 9,132 +typedef enum _IvoryType11,161 + TypeNull,14,246 + TypeMonitorForward,15,318 + TypeHeaderP,16,376 + TypeHeaderI,17,439 + TypeExternalValueCellPointer,18,503 + TypeOneQForward,19,573 + TypeHeaderForward,20,640 + TypeElementForward,21,716 + TypeFixnum,23,818 + TypeSmallRatio,24,857 + TypeSingleFloat,25,928 + TypeDoubleFloat,26,988 + TypeBignum,27,1048 + TypeBigRatio,28,1085 + TypeComplex,29,1152 + TypeSpareNumber,30,1193 + TypeInstance,32,1291 + TypeListInstance,33,1336 + TypeArrayInstance,34,1402 + TypeStringInstance,35,1471 + TypeNIL,37,1571 + TypeList,38,1608 + TypeArray,39,1638 + TypeString,40,1692 + TypeSymbol,41,1726 + TypeLocative,42,1775 + TypeLexicalClosure,43,1819 + TypeDynamicClosure,44,1881 + TypeCompiledFunction,45,1943 + TypeGenericFunction,46,1991 + TypeSparePointer1,47,2061 + TypeSparePointer2,48,2098 + TypePhysicalAddress,49,2135 + TypeSpareImmediate1,50,2185 + TypeBoundLocation,51,2224 + TypeCharacter,52,2273 + TypeLogicVariable,53,2329 + TypeGCForward,54,2390 + TypeEvenPC,55,2456 + TypeOddPC,56,2513 + TypeCallCompiledEven,58,2601 + TypeCallCompiledOdd,59,2676 + TypeCallIndirect,60,2750 + TypeCallGeneric,61,2817 + TypeCallCompiledEvenPrefetch,62,2886 + TypeCallCompiledOddPrefetch,63,2969 + TypeCallIndirectPrefetch,64,3051 + TypeCallGenericPrefetch,65,3130 + TypePackedInstruction60,67,3299 + TypePackedInstruction60, TypePackedInstruction61,67,3299 + TypePackedInstruction60, TypePackedInstruction61, TypePackedInstruction62,67,3299 + TypePackedInstruction63,68,3376 + TypePackedInstruction63, TypePackedInstruction64,68,3376 + TypePackedInstruction63, TypePackedInstruction64, TypePackedInstruction65,68,3376 + TypePackedInstruction66,69,3453 + TypePackedInstruction66, TypePackedInstruction67,69,3453 + TypePackedInstruction66, TypePackedInstruction67, TypePackedInstruction70,69,3453 + TypePackedInstruction71,70,3530 + TypePackedInstruction71, TypePackedInstruction72,70,3530 + TypePackedInstruction71, TypePackedInstruction72, TypePackedInstruction73,70,3530 + TypePackedInstruction74,71,3607 + TypePackedInstruction74, TypePackedInstruction75,71,3607 + TypePackedInstruction74, TypePackedInstruction75, TypePackedInstruction76,71,3607 + TypePackedInstruction7772,3684 +} IvoryType;73,3710 +typedef enum _IvoryCdr75,3724 + CdrNext,77,3749 + CdrNil,78,3760 + CdrNormal79,3770 +} IvoryCdr;80,3782 +#define TagTypeMask 82,3795 +#define TagCdrMask 83,3819 +#define TagType(84,3843 +#define TagCdr(85,3878 +#define SetTagCdr(86,3911 +#define TypeEqualP(87,3959 +#define TypeFixnumP(88,4026 +#define PackedInstructionP(89,4078 +#define BinaryTypeFixnumP(90,4131 +#define ArrayHeaderTag 92,4240 +typedef enum _ArrayElementType94,4285 + ArrayElementTypeFixnum,96,4318 + ArrayElementTypeCharacter,97,4344 + ArrayElementTypeBoolean,98,4373 + ArrayElementTypeObject99,4400 +} ArrayElementType;100,4425 +typedef enum _IvoryValueDisposition102,4446 + ValueDispositionEffect,104,4484 + ValueDispositionValue,105,4510 + ValueDispositionReturn,106,4535 + ValueDispositionMultiple107,4561 +} IvoryValueDisposition;108,4588 +typedef enum _IvoryOpcode110,4614 + OpcodeCar 113,4668 + OpcodeCdr 114,4686 + OpcodeSetToCar 115,4704 + OpcodeSetToCdr 116,4729 + OpcodeSetToCdrPushCar 117,4754 + OpcodeRplaca 118,4786 + OpcodeRplacd 119,4809 + OpcodeRgetf 120,4832 + OpcodeMember 121,4854 + OpcodeAssoc 122,4877 + OpcodeDereference 124,4923 + OpcodeUnify 125,4950 + OpcodePushLocalLogicVariables 126,4972 + OpcodePushGlobalLogicVariable 127,5012 + OpcodeLogicTailTest 128,5051 + OpcodeEq 130,5106 + OpcodeEqNoPop 131,5125 + OpcodeEql 132,5149 + OpcodeEqlNoPop 133,5169 + OpcodeEqualNumber 134,5194 + OpcodeEqualNumberNoPop 135,5222 + OpcodeGreaterp 136,5255 + OpcodeGreaterpNoPop 137,5280 + OpcodeLessp 138,5310 + OpcodeLesspNoPop 139,5332 + OpcodeLogtest 140,5359 + OpcodeLogtestNoPop 141,5383 + OpcodeTypeMember 142,5412 + OpcodeTypeMemberNoPop 143,5456 + OpcodeEndp 145,5530 + OpcodePlusp 146,5549 + OpcodeMinusp 147,5570 + OpcodeZerop 148,5592 + OpcodeAdd 150,5640 + OpcodeSub 151,5660 + OpcodeUnaryMinus 152,5680 + OpcodeIncrement 153,5707 + OpcodeDecrement 154,5733 + OpcodeMultiply 155,5759 + OpcodeQuotient 156,5784 + OpcodeCeiling 157,5809 + OpcodeFloor 158,5833 + OpcodeTruncate 159,5855 + OpcodeRound 160,5880 + OpcodeRationalQuotient 161,5902 + OpcodeMax 162,5935 + OpcodeMin 163,5955 + OpcodeLogand 164,5975 + OpcodeLogior 165,5998 + OpcodeLogxor 166,6021 + OpcodeAsh 167,6044 + OpcodeRot 168,6064 + OpcodeLsh 169,6084 + Opcode32BitPlus 170,6104 + Opcode32BitDifference 171,6130 + OpcodeMultiplyDouble 172,6162 + OpcodeAddBignumStep 173,6193 + OpcodeSubBignumStep 174,6223 + OpcodeMultiplyBignumStep 175,6253 + OpcodeDivideBignumStep 176,6288 + OpcodeLshcBignumStep 177,6321 + OpcodePush 179,6374 + OpcodePop 180,6395 + OpcodeMovem 181,6415 + OpcodePushNNils 182,6437 + OpcodePushAddress 183,6463 + OpcodeSetSpToAddress 184,6491 + OpcodeSetSpToAddressSaveTos 185,6522 + OpcodePushAddressSpRelative 186,6560 + OpcodeStackBlt 187,6598 + OpcodeStackBltAddress 188,6623 + OpcodeLdb 190,6692 + OpcodeDpb 191,6712 + OpcodeCharLdb 192,6732 + OpcodeCharDpb 193,6756 + OpcodePLdb 194,6780 + OpcodePDpb 195,6801 + OpcodePTagLdb 196,6822 + OpcodePTagDpb 197,6846 + OpcodeAref1 199,6895 + OpcodeAset1 200,6917 + OpcodeAloc1 201,6939 + OpcodeSetup1DArray 202,6961 + OpcodeSetupForce1DArray 203,6988 + OpcodeFastAref1 204,7020 + OpcodeFastAset1 205,7046 + OpcodeArrayLeader 206,7072 + OpcodeStoreArrayLeader 207,7100 + OpcodeAlocLeader 208,7133 + OpcodeBranch 210,7188 + OpcodeBranchTrue 211,7211 + OpcodeBranchTrueElseExtraPop 212,7237 + OpcodeBranchTrueAndExtraPop 213,7275 + OpcodeBranchTrueExtraPop 214,7312 + OpcodeBranchTrueNoPop 215,7346 + OpcodeBranchTrueAndNoPop 216,7377 + OpcodeBranchTrueElseNoPop 217,7411 + OpcodeBranchTrueAndNoPopElseNoPopExtraPop 218,7446 + OpcodeBranchFalse 219,7497 + OpcodeBranchFalseElseExtraPop 220,7524 + OpcodeBranchFalseAndExtraPop 221,7563 + OpcodeBranchFalseExtraPop 222,7601 + OpcodeBranchFalseNoPop 223,7636 + OpcodeBranchFalseAndNoPop 224,7668 + OpcodeBranchFalseElseNoPop 225,7703 + OpcodeBranchFalseAndNoPopElseNoPopExtraPop 226,7739 + OpcodeLoopDecrementTos 227,7791 + OpcodeLoopIncrementTosLessThan 228,7824 + OpcodeBlock0Read 230,7892 + OpcodeBlock1Read 231,7919 + OpcodeBlock2Read 232,7946 + OpcodeBlock3Read 233,7973 + OpcodeBlock0ReadShift 234,8000 + OpcodeBlock1ReadShift 235,8032 + OpcodeBlock2ReadShift 236,8064 + OpcodeBlock3ReadShift 237,8096 + OpcodeBlock0ReadAlu 238,8128 + OpcodeBlock1ReadAlu 239,8158 + OpcodeBlock2ReadAlu 240,8188 + OpcodeBlock3ReadAlu 241,8218 + OpcodeBlock0ReadTest 242,8248 + OpcodeBlock1ReadTest 243,8279 + OpcodeBlock2ReadTest 244,8310 + OpcodeBlock3ReadTest 245,8341 + OpcodeBlock0Write 246,8372 + OpcodeBlock1Write 247,8399 + OpcodeBlock2Write 248,8426 + OpcodeBlock3Write 249,8453 + OpcodeStartCall 251,8505 + OpcodeFinishCallN 252,8530 + OpcodeFinishCallNApply 253,8558 + OpcodeFinishCallTos 254,8591 + OpcodeFinishCallTosApply 255,8621 + OpcodeEntryRestAccepted 256,8656 + OpcodeEntryRestNotAccepted 257,8690 + OpcodeLocateLocals 258,8727 + OpcodeReturnSingle 259,8755 + OpcodeReturnMultiple 260,8784 + OpcodeReturnKludge 261,8815 + OpcodeTakeValues 262,8844 + OpcodeBindLocativeToValue 264,8900 + OpcodeBindLocative 265,8936 + OpcodeUnbindN 266,8963 + OpcodeRestoreBindingStack 267,8987 + OpcodeCatchOpen 269,9035 + OpcodeCatchClose 270,9061 + OpcodePushLexicalVar 272,9136 + OpcodePopLexicalVar 273,9195 + OpcodeMovemLexicalVar 274,9261 + OpcodePushInstanceVariable 276,9356 + OpcodePopInstanceVariable 277,9393 + OpcodeMovemInstanceVariable 278,9429 + OpcodePushAddressInstanceVariable 279,9467 + OpcodePushInstanceVariableOrdered 280,9511 + OpcodePopInstanceVariableOrdered 281,9555 + OpcodeMovemInstanceVariableOrdered 282,9598 + OpcodePushAddressInstanceVariableOrdered 283,9643 + OpcodeInstanceRef 284,9694 + OpcodeInstanceSet 285,9722 + OpcodeInstanceLoc 286,9750 + OpcodeEphemeralp 288,9800 + OpcodeUnsignedLessp 289,9825 + OpcodeUnsignedLesspNoPop 290,9855 + OpcodeAlu 291,9890 + OpcodeAllocateListBlock 292,9910 + OpcodeAllocateStructureBlock 293,9944 + OpcodePointerPlus 294,9983 + OpcodePointerDifference 295,10011 + OpcodePointerIncrement 296,10045 + OpcodeReadInternalRegister 297,10078 + OpcodeWriteInternalRegister 298,10115 + OpcodeCoprocessorRead 299,10153 + OpcodeCoprocessorWrite 300,10185 + OpcodeMemoryRead 301,10218 + OpcodeMemoryReadAddress 302,10245 + OpcodeTag 303,10279 + OpcodeSetTag 304,10298 + OpcodeStoreConditional 305,10321 + OpcodeMemoryWrite 306,10354 + OpcodePStoreContents 307,10382 + OpcodeSetCdrCode1 308,10413 + OpcodeSetCdrCode2 309,10441 + OpcodeMergeCdrNoPop 310,10469 + OpcodeGenericDispatch 311,10499 + OpcodeMessageDispatch 312,10530 + OpcodeJump 313,10561 + OpcodeCheckPreemptRequest 314,10581 + OpcodeNoOp 315,10616 + OpcodeHalt 316,10636 +} IvoryOpcode;317,10655 +#define ReadControlArgumentSize(319,10671 +#define ReadControlExtraArgument(320,10717 +#define ReadControlCallerFrameSize(321,10764 +#define ReadControlApply(322,10813 +#define ReadControlValueDisposition(323,10853 +#define ReadControlCleanupBits(324,10904 +#define ReadControlCleanupCatch(325,10950 +#define ReadControlCleanupBindings(326,10997 +#define ReadControlTrapOnExit(327,11047 +#define ReadControlTrapMode(328,11092 +#define ReadControlCallStarted(329,11135 +#define ReadControlCleanupInProgress(330,11181 +#define ReadControlInstructionTrace(331,11233 +#define ReadControlCallTrace(332,11284 +#define ReadControlTracePending(333,11328 +#define ControlApply 335,11376 +#define ControlCleanupBits 336,11405 +#define ControlCallStarted 337,11443 +#define ControlExtraArgument 338,11480 +#define ControlArgumentSize 339,11514 +#define ControlCallerFrameSize 340,11547 +#define ControlValueDisposition 341,11586 +#define WriteControlArgumentSize(343,11628 +#define WriteControlExtraArgument(344,11685 +#define WriteControlCallerFrameSize(345,11743 +#define WriteControlApply(346,11803 +#define WriteControlValueDisposition(347,11854 +#define WriteControlCleanupBits(348,11916 +#define WriteControlCleanupCatch(349,11973 +#define WriteControlCleanupBindings(350,12031 +#define WriteControlTrapOnExit(351,12092 +#define WriteControlTrapMode(352,12148 +#define WriteControlCallStarted(353,12202 +#define WriteControlCleanupInProgress(354,12259 +#define WriteControlInstructionTrace(355,12322 +#define WriteControlCallTrace(356,12384 +#define WriteControlTracePending(357,12439 +typedef enum _InternalRegisters359,12498 + InternalRegisterEA 361,12532 + InternalRegisterFP 362,12559 + InternalRegisterLP 363,12586 + InternalRegisterSP 364,12613 + InternalRegisterMacroSP 365,12640 + InternalRegisterStackCacheLowerBound 366,12672 + InternalRegisterBAR0 367,12717 + InternalRegisterBAR1 368,12746 + InternalRegisterBAR2 369,12777 + InternalRegisterBAR3 370,12808 + InternalRegisterPHTHash0 371,12839 + InternalRegisterPHTHash1 372,12872 + InternalRegisterPHTHash2 373,12907 + InternalRegisterPHTHash3 374,12942 + InternalRegisterEPC 375,12977 + InternalRegisterDPC 376,13006 + InternalRegisterContinuation 377,13035 + InternalRegisterAluAndRotateControl 378,13073 + InternalRegisterControlRegister 379,13118 + InternalRegisterCRArgumentSize 380,13159 + InternalRegisterEphemeralOldspaceRegister 381,13199 + InternalRegisterZoneOldspaceRegister 382,13250 + InternalRegisterChipRevision 383,13296 + InternalRegisterFPCoprocessorPresent 384,13334 + InternalRegisterPreemptRegister 385,13380 + InternalRegisterIcacheControl 386,13421 + InternalRegisterPrefetcherControl 387,13460 + InternalRegisterMapCacheControl 388,13503 + InternalRegisterMemoryControl 389,13545 + InternalRegisterECCLog 390,13584 + InternalRegisterECCLogAddress 391,13616 + InternalRegisterInvalidateMap0 392,13655 + InternalRegisterInvalidateMap1 393,13695 + InternalRegisterInvalidateMap2 394,13736 + InternalRegisterInvalidateMap3 395,13777 + InternalRegisterLoadMap0 396,13818 + InternalRegisterLoadMap1 397,13852 + InternalRegisterLoadMap2 398,13887 + InternalRegisterLoadMap3 399,13922 + InternalRegisterStackCacheOverflowLimit 400,13957 + InternalRegisterUcodeROMContents 401,14006 + InternalRegisterAddressMask 402,14048 + InternalRegisterEntryMaximumArguments 403,14085 + InternalRegisterLexicalVariable 404,14132 + InternalRegisterInstruction 405,14173 + InternalRegisterMemoryData 406,14210 + InternalRegisterDataPins 407,14246 + InternalRegisterExtensionRegister 408,14280 + InternalRegisterMicrosecondClock 409,14323 + InternalRegisterArrayHeaderLength 410,14365 + InternalRegisterLoadBAR0 411,14408 + InternalRegisterLoadBAR1 412,14442 + InternalRegisterLoadBAR2 413,14477 + InternalRegisterLoadBAR3 414,14512 + InternalRegisterTOS 415,14547 + InternalRegisterEventCount 416,14578 + InternalRegisterBindingStackPointer 417,14616 + InternalRegisterCatchBlockList 418,14663 + InternalRegisterControlStackLimit 419,14705 + InternalRegisterControlStackExtraLimit 420,14750 + InternalRegisterBindingStackLimit 421,14800 + InternalRegisterPHTBase 422,14845 + InternalRegisterPHTMask 423,14880 + InternalRegisterCountMapReloads 424,14915 + InternalRegisterListCacheArea 425,14958 + InternalRegisterListCacheAddress 426,14999 + InternalRegisterListCacheLength 427,15043 + InternalRegisterStructureCacheArea 428,15086 + InternalRegisterStructureCacheAddress 429,15132 + InternalRegisterStructureCacheLength 430,15181 + InternalRegisterDynamicBindingCacheBase 431,15229 + InternalRegisterDynamicBindingCacheMask 432,15280 + InternalRegisterChoicePointer 433,15331 + InternalRegisterStructureStackChoicePointer 434,15372 + InternalRegisterFEPModeTrapVectorAddress 435,15427 + InternalRegisterMappingTableCache 436,15479 + InternalRegisterMappingTableLength 437,15524 + InternalRegisterStackFrameMaximumSize 438,15570 + InternalRegisterStackCacheDumpQuantum 439,15619 + InternalRegisterConstantNIL 440,15668 + InternalRegisterConstantT 441,15707 +} InternalRegisters;442,15743 +typedef enum _CoprocessorRegisters444,15765 + CoprocessorRegisterMicrosecondClock 446,15802 +} CoprocessorRegisters;447,15848 + +emulator/ivoryrep.h,543 +#define _IVORYREP_7,262 +typedef struct _LispObj11,303 + uint32_t data:data14,361 + uint32_t tag:tag15,381 + uint32_t tag:tag17,406 + uint32_t data:data18,425 +} LispObjRecord, *LispObjRecordp;LispObjRecordp20,452 +typedef int64_t LispObj;22,487 +#define LispObjTag(24,513 +#define LispObjData(25,567 +#define MakeLispObj(26,623 +typedef int Boolean;29,752 +typedef unsigned char Byte;30,773 +typedef unsigned char Tag;31,801 +typedef unsigned int Integer;32,828 +typedef void *Pointer;Pointer81,2416 +#define DISPATCHTABLE(83,2440 + +emulator/life_prototypes.h,117 +#define begin_MUTEX_LOCKED(19,561 +#define end_MUTEX_LOCKED(26,863 +#define WaitUntilInitializationComplete(36,1357 + +emulator/life_types.h,451 +#define _LIFE_TYPES_6,107 +typedef int32_t EmbWord;10,150 +typedef uint32_t uEmbWord;11,219 +typedef EmbWord EmbPtr;13,290 +typedef uEmbWord SignalMask;14,370 +typedef EmbWord SignalNumber;15,434 +typedef EmbWord bool;16,497 +typedef unsigned char boolean;17,578 +typedef unsigned char byte;18,650 +typedef void* PtrV;19,714 +typedef void (*ProcPtrV)ProcPtrV20,793 +enum WindowInitialState23,924 + Iconic 25,952 + Unspecified,26,966 + Normal27,980 + +emulator/memory.h,1839 +#define _MEMORY_H8,130 +#define ldb(30,1230 +#define dpb(31,1305 +typedef unsigned char VMAttribute;36,1485 +#define VMAccessFault(41,1618 +#define VMWriteFault(42,1673 +#define VMTransportFault(43,1726 +#define VMTransportDisable(44,1787 +#define VMEphemeral(45,1852 +#define VMModified(46,1903 +#define VMExists(47,1952 +#define SetVMAccessFault(49,1998 +#define SetVMWriteFault(50,2057 +#define SetVMTransportFault(51,2114 +#define SetVMTransportDisable(52,2179 +#define SetVMEphemeral(53,2248 +#define SetVMModified(54,2303 +#define SetVMExists(55,2356 +#define ClearVMAccessFault(57,2406 +#define ClearVMWriteFault(58,2468 +#define ClearVMTransportFault(59,2528 +#define ClearVMTransportDisable(60,2596 +#define ClearVMEphemeral(61,2668 +#define ClearVMModified(62,2726 +#define ClearVMExists(63,2782 +typedef enum _VMOpcode65,2835 + VMOpcodeLookup,67,2860 + VMOpcodeCreate,68,2902 + VMOpcodeDestroy,69,2920 + VMOpcodeReadAttributes,71,2940 + VMOpcodeWriteAttributes,72,2991 + VMOpcodeFill,74,3044 + VMOpcodeSearch,75,3106 + VMOpcodeCopy,76,3167 + VMOpcodeScan,78,3219 + VMOpcodeEnable,79,3235 + VMOpcodePHTScan,80,3253 + VMOpcodeCopyandForward,81,3272 + VMOpcodeResidentScan,82,3298 + VMOpcodeSearchType,83,3322 + VMOpcodeSearchCDR84,3344 +} VMOpcode;85,3364 +typedef enum _VMResultCode87,3377 + VMResultSuccess,89,3406 + VMResultFailure90,3425 +} VMResultCode;91,3443 +#define VMCommandOpcode(95,3489 +#define VMCommandOperand(96,3553 +#define SetVMReplyResult(98,3613 +typedef struct _VMState100,3718 + Integer CommandRegister;102,3744 + Integer AddressRegister;103,3771 + Integer ExtentRegister;104,3798 + Integer AttributesRegister;105,3824 + Integer DestinationRegister;106,3854 + LispObj DataRegister;107,3885 + Integer MaskRegisterLow;108,3909 + Integer MaskRegisterHigh;109,3936 +} VMState;110,3964 + +emulator/pfilt_wrapper.h,275 +#define _PFILT_WRAPPER_6,158 +#define EmbNetFilter 17,348 +#define N_FILTERS 24,516 + struct sock_fprog fprog;27,555 + struct sock_filter filters[filters28,581 + } EmbNetFilter;29,622 +#define EmbNetFilter 33,688 +#define USE_LIBPCAP34,728 +#define EmbNetFilter 38,795 + +emulator/SystemComm.h,2601 +#define _SYSTEMCOM_6,131 +#define SystemCommAreaAddress 11,197 +#define SystemCommAreaSize 12,239 +#define SystemCommSlotAddress(15,330 +#define ReadSystemCommSlot(20,554 +#define ReadSystemCommSlot(23,661 +#define WriteSystemCommSlot(29,856 +#define WriteSystemCommSlot(37,1076 + EmbWord syscomMajorVersionNumber;48,1309 + EmbWord syscomMinorVersionNumber;49,1344 + EmbWord systemStartup;50,1379 + EmbWord addressSpaceMapAddress;51,1403 + EmbWord oblastFreeSize;52,1436 + EmbWord areaName;53,1461 + EmbWord areaMaximumQuantumSize;54,1480 + EmbWord areaRegionQuantumSize;55,1513 + EmbWord areaRegionList;56,1545 + EmbWord areaRegionBits;57,1570 + EmbWord regionQuantumOrigin;58,1595 + EmbWord regionQuantumLength;59,1625 + EmbWord regionFreePointer;60,1655 + EmbWord regionGCPointer;61,1683 + EmbWord regionBits;62,1709 + EmbWord regionListThread;63,1730 + EmbWord regionArea;64,1757 + EmbWord regionCreatedPages;65,1778 + EmbWord regionFreePointerBeforeFlip;66,1807 + EmbWord regionConsAlarm;67,1845 + EmbWord pageConsAlarm;68,1871 + EmbWord structureCacheRegion;69,1895 + EmbWord listCacheRegion;70,1926 + EmbWord defaultConsArea;71,1952 + EmbWord pht;72,1978 + EmbWord mmptY;73,1992 + EmbWord mmpt;74,2008 + EmbWord smpt;75,2023 + EmbWord loadBitmaps;76,2038 + EmbWord loadMap;77,2060 + EmbWord loadMapDPN;78,2102 + EmbWord swapMap;79,2147 + EmbWord swapMapDPN;80,2189 + EmbWord sysoutBitmaps;81,2234 + EmbWord phtCollisionCounts;82,2258 + EmbWord mmpt1;83,2287 + EmbWord storageColdBoot;84,2303 + EmbWord flushableQueueHead;85,2329 + EmbWord flushableQueueTail;86,2358 + EmbWord flushableQueueModified;87,2387 + EmbWord wiredPhysicalAddressHigh;88,2420 + EmbWord wiredVirtualAddressHigh;89,2455 + EmbWord enableSysoutAtColdBoot;90,2489 + EmbWord sysoutGenerationNumber;91,2522 + EmbWord sysoutTimestamp1;92,2555 + EmbWord sysoutTimestamp2;93,2582 + EmbWord sysoutParentTimestamp1;94,2609 + EmbWord sysoutParentTimestamp2;95,2642 + EmbWord initialStackGroup;96,2675 + EmbWord currentStackGroup;97,2703 + EmbWord stackGroupLock;98,2731 + EmbWord currentStackGroupStatusBits;99,2756 + EmbWord inhibitSchedulingFlag;100,2794 + EmbWord controlStackLow;101,2826 + EmbWord bindingStackLow;102,2852 + EmbWord floatOperatingMode;103,2878 + EmbWord floatOperationStatus;104,2907 + EmbWord packageNameTable;105,2938 + EmbWord lispReleaseString;106,2965 + EmbWord busMode;107,2993 + } SystemCommArea;108,3011 + EmbWord systemStartup;116,3111 + EmbWord allAreas;117,3135 + EmbWord allPackages;118,3154 + EmbWord saveWorldHeader;119,3176 + EmbWord kernelUseROMEthernet;120,3202 + } SystemCommArea;121,3233 + +emulator/testfunction.h,45 +#define TESTFCNLENGTH 2,1 +int TESTFCN 3,25 + +emulator/traps.h,1756 +#define _TRAPS_5,164 +#define TrapVector_StackOverflow 9,183 +#define TrapVector_InstructionException 11,222 +#define TrapVector_ArithmeticInstructionException 13,268 +#define TrapVector_Error 15,321 +#define TrapVector_Reset 17,352 +#define TrapVector_PullApplyArgs 19,383 +#define TrapVector_Trace 21,422 +#define TrapVector_PreemptRequest 23,453 +#define TrapVector_LowPrioritySequenceBreak 25,493 +#define TrapVector_HighPrioritySequenceBreak 27,543 +#define TrapVector_DBUnwindFrame 29,594 +#define TrapVector_DBUnwindCatch 31,633 +#define TrapVector_Transport 33,672 +#define TrapVector_Monitor 35,707 +#define TrapVector_PageNotResident 37,740 +#define TrapVector_PageFaultRequest 39,781 +#define TrapVector_PageWriteFault 41,823 +#define TrapVector_UncorrectableMemoryError 43,863 +#define TrapVector_MemoryBusError 45,913 +#define TrapVector_DBCacheMiss 47,953 +#define TrapMeter_StackOverflow 49,990 +#define TrapMeter_InstructionException 51,1025 +#define TrapMeter_ArithmeticInstructionException 53,1067 +#define TrapMeter_Error 55,1119 +#define TrapMeter_Reset 57,1146 +#define TrapMeter_PullApplyArgs 59,1173 +#define TrapMeter_Trace 61,1208 +#define TrapMeter_PreemptRequest 63,1235 +#define TrapMeter_LowPrioritySequenceBreak 65,1271 +#define TrapMeter_HighPrioritySequenceBreak 67,1317 +#define TrapMeter_DBUnwindFrame 69,1364 +#define TrapMeter_DBUnwindCatch 71,1400 +#define TrapMeter_Transport 73,1436 +#define TrapMeter_Monitor 75,1468 +#define TrapMeter_PageNotResident 77,1498 +#define TrapMeter_PageFaultRequest 79,1536 +#define TrapMeter_PageWriteFault 81,1575 +#define TrapMeter_UncorrectableMemoryError 83,1612 +#define TrapMeter_MemoryBusError 85,1659 +#define TrapMeter_DBCacheMiss 87,1696 +#define TrapMeter_NEntries 89,1730 + +g5-emulator/aistat.h,10391 +#define _AISTAT_5,169 +typedef struct processorstate 9,189 + uint64_t transpare3;10,221 + uint64_t transpare2;11,249 + uint64_t transpare1;12,277 + uint64_t carcdrsubroutine;13,305 + uint64_t cdrsubroutine;14,339 + uint64_t carsubroutine;15,370 + uint64_t linkage;16,401 + uint64_t resumeema;17,426 + char *statistics;statistics18,453 + char *trace_hook;trace_hook19,481 + int64_t instruction_count;20,509 + uint64_t iinterpret_sp;21,544 + uint64_t scratch0;22,575 + uint64_t scratch1;23,601 + uint64_t scratch2;24,627 + uint64_t scratch3;25,653 + uint64_t scratch4;26,679 + uint64_t scratch5;27,705 + uint64_t scratch6;28,731 + uint64_t scratch7;29,757 + char *meterdatabuff;meterdatabuff30,783 + uint32_t meterpos;31,814 + uint32_t metermax;32,840 + uint32_t meterfreq;33,866 + uint32_t metermask;34,893 + uint32_t metervalue;35,920 + uint32_t metercount;36,948 + uint64_t choiceptr;37,976 + uint64_t sstkchoiceptr;38,1003 + uint64_t dbcbase;39,1034 + uint64_t dbcmask;40,1059 + char *coprocessorreadhook;coprocessorreadhook41,1084 + char *coprocessorwritehook;coprocessorwritehook42,1121 + char *flushcaches_hook;flushcaches_hook43,1159 + char *i_stage_error_hook;i_stage_error_hook44,1193 + uint64_t sfp1;45,1229 + uint64_t fp0;46,1251 + uint64_t fp1;47,1272 + uint64_t floating_exception;48,1293 + uint64_t aluandrotatecontrol;49,1329 + uint64_t rotatelatch;50,1366 + uint64_t aluborrow;51,1395 + uint64_t aluoverflow;52,1422 + uint64_t alulessthan;53,1451 + uint64_t aluop;54,1480 + uint64_t byterotate;55,1503 + uint64_t bytesize;56,1531 + int64_t bindingstacklimit;57,1557 + int64_t bindingstackpointer;58,1592 + uint64_t catchblock;59,1629 + uint64_t extraandcatch;60,1657 + uint64_t msclockcache;61,1688 + uint64_t ticksperms;62,1718 + uint64_t previoustb;63,1746 + char *rlink;rlink64,1774 + uint32_t interruptreg;65,1797 + uint32_t zoneoldspace;66,1827 + uint32_t ephemeraloldspace;67,1857 + uint32_t int_pad0;68,1892 + uint64_t eqnoteql;69,1918 + uint32_t lclength;70,1944 + uint32_t sclength;71,1970 + uint64_t lcarea;72,1996 + uint64_t lcaddress;73,2020 + uint64_t scarea;74,2047 + uint64_t scaddress;75,2071 + uint64_t restartsp;76,2098 + uint64_t stop_interpreter;77,2125 + uint64_t immediate_arg;78,2159 + uint64_t continuationcp;79,2190 + int64_t continuation;80,2222 + int64_t control;81,2252 + int64_t niladdress;82,2277 + int64_t taddress;83,2305 + int64_t bar0;84,2331 + int64_t bar1;85,2353 + int64_t bar2;86,2375 + int64_t bar3;87,2397 + int64_t epc;88,2419 + int64_t fp;89,2440 + int64_t lp;90,2460 + int64_t sp;91,2480 + char *cp;cp92,2500 + uint64_t fccrmask;93,2520 + uint32_t cslimit;94,2546 + uint32_t csextralimit;95,2571 + char *trapmeterdata;trapmeterdata96,2601 + uint64_t fepmodetrapvecaddress;97,2632 + uint64_t trapvecbase;98,2671 + uint64_t tvi;99,2700 + uint64_t fccrtrapmask;100,2721 + char *ptrtype;ptrtype101,2751 + char *vmattributetable;vmattributetable102,2776 + uint64_t vma;103,2810 + int64_t mostnegativefixnum;104,2831 + char *icachebase;icachebase105,2867 + char *endicache;endicache106,2895 + uint64_t fullworddispatch;107,2922 + uint64_t halfworddispatch;108,2956 + int64_t areventcount;109,2990 + uint64_t stackcachesize;110,3020 + uint64_t stackcachetopvma;111,3052 + uint64_t cdrcodemask;112,3086 + char *stackcachedata;stackcachedata113,3115 + uint64_t stackcachebasevma;114,3147 + uint32_t scovlimit;115,3182 + uint32_t scovdumpcount;116,3209 + int64_t mostpositivefixnum;117,3240 + uint64_t internalregisterread1;118,3276 + uint64_t internalregisterread2;119,3315 + uint64_t internalregisterwrite1;120,3354 + uint64_t internalregisterwrite2;121,3394 + uint64_t dataread_mask;122,3434 + char *dataread;dataread123,3465 + uint64_t datawrite_mask;124,3491 + char *datawrite;datawrite125,3523 + uint64_t bindread_mask;126,3550 + char *bindread;bindread127,3581 + uint64_t bindwrite_mask;128,3607 + char *bindwrite;bindwrite129,3639 + uint64_t bindreadnomonitor_mask;130,3666 + char *bindreadnomonitor;bindreadnomonitor131,3706 + uint64_t bindwritenomonitor_mask;132,3741 + char *bindwritenomonitor;bindwritenomonitor133,3782 + uint64_t header_mask;134,3818 + char *header;header135,3847 + uint64_t structureoffset_mask;136,3871 + char *structureoffset;structureoffset137,3909 + uint64_t scavenge_mask;138,3942 + char *scavenge;scavenge139,3973 + uint64_t cdr_mask;140,3999 + char *cdr;cdr141,4025 + uint64_t gccopy_mask;142,4046 + char *gccopy;gccopy143,4075 + uint64_t raw_mask;144,4099 + char *raw;raw145,4125 + uint64_t rawtranslate_mask;146,4146 + char *rawtranslate;rawtranslate147,4181 + int32_t please_stop;148,4211 + int32_t please_trap;149,4240 + int64_t runningp;150,4269 + uint64_t ac0array;151,4295 + uint64_t ac0arword;152,4321 + uint64_t ac0locat;153,4348 + uint64_t ac0length;154,4374 + uint64_t ac1array;155,4401 + uint64_t ac1arword;156,4427 + uint64_t ac1locat;157,4454 + uint64_t ac1length;158,4480 + uint64_t ac2array;159,4507 + uint64_t ac2arword;160,4533 + uint64_t ac2locat;161,4560 + uint64_t ac2length;162,4586 + uint64_t ac3array;163,4613 + uint64_t ac3arword;164,4639 + uint64_t ac3locat;165,4666 + uint64_t ac3length;166,4692 + uint64_t ac4array;167,4719 + uint64_t ac4arword;168,4745 + uint64_t ac4locat;169,4772 + uint64_t ac4length;170,4798 + uint64_t ac5array;171,4825 + uint64_t ac5arword;172,4851 + uint64_t ac5locat;173,4878 + uint64_t ac5length;174,4904 + uint64_t ac6array;175,4931 + uint64_t ac6arword;176,4957 + uint64_t ac6locat;177,4984 + uint64_t ac6length;178,5010 + uint64_t ac7array;179,5037 + uint64_t ac7arword;180,5063 + uint64_t ac7locat;181,5090 + uint64_t ac7length;182,5116 + uint32_t tmcurrenttransaction;183,5143 + uint32_t tmwritestart;184,5181 + uint32_t tmwritecurrent;185,5211 + uint32_t tmwritelimit;186,5243 + uint32_t tmrecordingreads;187,5273 + uint32_t tmreadstart;188,5307 + uint32_t tmreadcurrent;189,5336 + uint32_t tmreadlimit;190,5367 + } PROCESSORSTATE, *PROCESSORSTATEP;PROCESSORSTATEP191,5396 +#define PROCESSORSTATE_SIZE 193,5434 +typedef struct cacheline 195,5468 + uint64_t annotation;196,5495 + uint32_t nextpcdata;197,5523 + uint32_t nextpctag;198,5551 + char *nextcp;nextcp199,5578 + uint32_t instruction;200,5602 + uint32_t operand;201,5631 + uint32_t pcdata;202,5656 + uint32_t pctag;203,5680 + char *code;code204,5703 + } CACHELINE, *CACHELINEP;CACHELINEP205,5725 +#define CACHELINE_SIZE 207,5753 +#define CacheLine_Bits 209,5780 +#define CacheLine_Mask 211,5807 +#define CacheLine_RShift 213,5838 +#define CacheLine_LShift 215,5867 +#define CacheLine_FillAmount 217,5895 +typedef struct arraycache 219,5928 + uint64_t array;220,5956 + uint64_t arword;221,5979 + uint64_t locat;222,6003 + uint64_t length;223,6026 + } ARRAYCACHE, *ARRAYCACHEP;ARRAYCACHEP224,6050 +#define AutoArrayReg_Mask 226,6080 +#define AutoArrayReg_Size 228,6111 +#define AutoArrayReg_Shift 230,6141 +#define MSclock_UnitsToMSShift 232,6171 +#define MSclock_UnitsPerMicrosecond 234,6205 +#define Stack_CacheSize 236,6244 +#define Stack_MaxFrameSize 238,6274 +#define Stack_CacheMargin 240,6306 +#define Stack_CacheDumpQuantum 242,6337 +#define IvoryMemory_Data 244,6373 +#define IvoryMemory_Tag 246,6402 +typedef struct savedregisters 248,6430 + uint64_t r9;249,6462 + uint64_t r10;250,6482 + uint64_t r11;251,6503 + uint64_t r12;252,6524 + uint64_t r13;253,6545 + uint64_t r14;254,6566 + uint64_t r15;255,6587 + uint64_t r29;256,6608 + uint64_t f2;257,6629 + uint64_t f3;258,6649 + uint64_t f4;259,6669 + uint64_t f5;260,6689 + uint64_t f6;261,6709 + uint64_t f7;262,6729 + uint64_t f8;263,6749 + uint64_t f9;264,6769 + } SAVEDREGISTERS, *SAVEDREGISTERSP;SAVEDREGISTERSP265,6789 +#define SAVEDREGISTERS_SIZE 267,6827 +typedef struct tracedata 269,6860 + uint64_t n_entries;270,6887 + uint32_t recording_p;271,6914 + uint32_t wrap_p;272,6943 + uint64_t start_pc;273,6967 + uint64_t stop_pc;274,6993 + char *records_start;records_start275,7018 + char *records_end;records_end276,7049 + char *current_entry;current_entry277,7078 + char *printer;printer278,7109 + } TRACEDATA, *TRACEDATAP;TRACEDATAP279,7134 +#define TRACEDATA_SIZE 281,7162 +typedef struct tracerecord 283,7189 + uint64_t counter;284,7218 + uint64_t epc;285,7243 + uint64_t tos;286,7264 + uint64_t sp;287,7285 + char *instruction;instruction288,7305 + uint64_t instruction_data;289,7334 + uint32_t operand;290,7368 + uint32_t trap_p;291,7393 + uint64_t trap_data_0;292,7417 + uint64_t trap_data_1;293,7446 + uint64_t trap_data_2;294,7475 + uint64_t trap_data_3;295,7504 + uint32_t catch_block_p;296,7533 + uint32_t int_pad0;297,7564 + uint64_t catch_block_0;298,7590 + uint64_t catch_block_1;299,7621 + uint64_t catch_block_2;300,7652 + uint64_t catch_block_3;301,7683 + } TRACERECORD, *TRACERECORDP;TRACERECORDP302,7714 +#define TRACERECORD_SIZE 304,7746 +#define CacheMeter_Pwr 306,7776 +#define CacheMeter_DefaultFreq 308,7803 + +include/spy.h,20 +#define _SPY_6,132 + +include/std.h,2012 +#define _STD_H_4,64 +#define _GNU_SOURCE6,81 +#define _THREAD_SAFE7,101 +#undef _FORTIFY_SOURCE9,145 +#define _FORTIFY_SOURCE 11,175 +#define OS_OSF15,263 +#define OS_LINUX17,299 +#define OS_DARWIN19,341 +#define OS_FREEBSD21,386 +#define ARCH_ALPHA27,486 +#define ARCH_PPC6429,556 +#define ARCH_X86_6431,601 +typedef void* pthread_addr_t;51,886 +typedef void (*pthread_cleanuproutine_t)pthread_cleanuproutine_t52,916 +typedef void* (*pthread_startroutine_t)pthread_startroutine_t53,966 +#define pthread_yield 56,1031 +typedef signed char int8_t;63,1303 +typedef short int int16_t;64,1339 +typedef int int32_t;65,1371 +typedef long int int64_t;66,1402 +typedef unsigned char uint8_t;67,1433 +typedef unsigned short int uint16_t;68,1465 +typedef unsigned int uint32_t;69,1502 +typedef unsigned long int uint64_t;70,1534 +typedef signed char int_least8_t;71,1570 +typedef short int int_least16_t;72,1609 +typedef int int_least32_t;73,1647 +typedef long int int_least64_t;74,1684 +typedef unsigned char uint_least8_t;75,1721 +typedef unsigned short int uint_least16_t;76,1759 +typedef unsigned int uint_least32_t;77,1802 +typedef unsigned long int uint_least64_t;78,1840 +typedef signed char int_fast8_t;79,1882 +typedef long int int_fast16_t;80,1920 +typedef long int int_fast32_t;81,1956 +typedef long int int_fast64_t;82,1992 +typedef unsigned char uint_fast8_t;83,2028 +typedef unsigned long int uint_fast16_t;84,2065 +typedef unsigned long int uint_fast32_t;85,2106 +typedef unsigned long int uint_fast64_t;86,2147 +typedef long int intptr_t;87,2188 +typedef unsigned long int uintptr_t;88,2220 +typedef long int intmax_t;89,2257 +typedef unsigned long int uintmax_t;90,2289 +#define TRUE 97,2399 +#define FALSE 98,2415 +#define ESUCCESS 99,2431 +#define _POSIX_PATH_MAX 105,2581 +#define _POSIX_ARG_MAX 108,2639 +typedef void (*sa_handler_t)sa_handler_t116,2772 +typedef void (*sa_sigaction_t)sa_sigaction_t117,2808 + +include/swapbytes.h,296 +#define _SWAPBYTES_4,57 +#define bswap_32(8,100 +#define bswap_16(14,271 +#define bswap32_block(20,442 +#define bswap16_block(34,734 +static __inline unsigned int bswap_32 51,1076 +static __inline unsigned short int bswap_16 55,1285 +#define bswap32_block(62,1462 +#define bswap16_block(69,1639 + +include/utilities.h,26 +#define _UTILITIES_6,107 + +include/VLM_configuration.h,2689 +#define _VLM_CONFIG_5,156 + char *xpHostName;xpHostName19,358 + long xpHostAddress;20,439 + int xpDisplay;21,498 + int xpScreen;22,567 + int xpInitialState;23,634 + char *xpGeometry;xpGeometry24,710 + char *xpForegroundColor;xpForegroundColor25,773 + char *xpBackgroundColor;xpBackgroundColor26,831 + char *xpBorderColor;xpBorderColor27,889 + int xpBorderWidth;28,940 + } XParams;29,995 +typedef struct NetworkInterface34,1068 + boolean present;36,1104 + char device[device37,1169 + unsigned short myProtocol;38,1253 + struct in_addr myAddress;39,1317 + struct in_addr myHostAddress;40,1379 + boolean haveMac;41,1464 + struct mac_addr 42,1544 + unsigned char bytes[bytes43,1565 + } myMac;44,1593 + char myOptions[myOptions46,1692 + struct NetworkInterface* anotherAddress;47,1760 + } NetworkInterface;49,1856 +#define MaxNetworkInterfaces 51,1880 +#define ETHERTYPE_CHAOS 52,1911 +#define EmbCommAreaAddress 59,2242 +#define DefaultEmbCommAreaSize 60,2281 +#define DefaultHostBufferSpace 61,2320 +#define DefaultGuestBufferSpace 62,2357 +#define DefaultVLMConfigFilePathname 64,2397 +#define DefaultVLMDebuggerPathname 66,2461 +#define DefaultGeneraWorldPathname 68,2531 +#define DefaultMinimaWorldPathname 69,2603 +#define DefaultWorldSearchPath 70,2671 +#define DefaultVirtualMemory 72,2743 +#define MinimumVirtualMemory 73,2778 +#define DiskQueueSize 78,2907 +#define ConsoleInputQueueSize 79,2934 +#define ConsoleOutputQueueSize 80,2968 +#define NetworkReceiverQueueSize 81,3003 +#define NetworkTransmitterQueueSize 82,3087 +#define RPCHostToGuestQueueSize 83,3145 +#define RPCGuestToHostQueueSize 84,3181 +#define SCSIQueueSize 85,3217 +#define ColdLoadInputQueueSize 86,3244 +#define ColdLoadOutputQueueSize 87,3298 +#define HostFileCommandQueueSize 88,3353 +#define HostFileReplyQueueSize 89,3389 +#define CommandQueueSize 90,3424 + boolean traceP;97,3519 + boolean tracePOST;98,3583 + int bufferSize;99,3642 + unsigned int startPC;100,3701 + unsigned int stopPC;101,3774 + char *outputFile;outputFile102,3846 +} TraceConfig;103,3910 + boolean enableSpy;110,3988 + TraceConfig tracing;111,4054 + size_t commAreaSize;112,4117 + size_t hostBufferSpace;113,4188 + size_t guestBufferSpace;114,4256 + char vlmDebuggerPath[vlmDebuggerPath115,4326 + char worldPath[worldPath116,4413 + char* worldSearchPath;118,4507 + boolean enableIDS;119,4578 + size_t virtualMemory;120,4648 + XParams coldLoadXParams;122,4722 + XParams generaXParams;123,4793 + struct in_addr diagnosticIPAddress;124,4862 + NetworkInterface interfaces[interfaces125,4943 + boolean testFunction;126,5024 + } VLMConfig;128,5145 + +include/world_tools.h,3100 +#define _WORLD_TOOLS_6,98 + Integer address;21,366 + Integer count:count25,483 + Integer opcode:opcode26,558 + Integer opcode:opcode28,639 + Integer count:count29,714 + } op;31,796 + LispObj data;32,806 + PtrV world;33,870 + } LoadMapEntry;34,938 +enum LoadMapEntryOpcode38,990 + LoadMapDataPages,40,1018 + LoadMapConstant,41,1077 + LoadMapConstantIncremented,42,1134 + LoadMapCopy 43,1219 +typedef struct World49,1325 + char* pathname;51,1350 + int fd;52,1407 + int format;53,1470 + int byteSwapped;54,1540 + int vlmDataPageBase;55,1617 + int vlmTagsPageBase;56,1694 + byte* vlmDataPage;57,1771 + byte* vlmTagsPage;58,1843 + byte* ivoryDataPage;59,1915 + int currentPageNumber;60,1991 + int currentQNumber;61,2070 + struct World* parentWorld;62,2137 + Integer sysoutGeneration;63,2211 + Integer sysoutTimestamp1;64,2291 + Integer sysoutTimestamp2;65,2362 + Integer sysoutParentTimestamp1;66,2408 + Integer sysoutParentTimestamp2;67,2493 + int nWiredMapEntries;68,2544 + LoadMapEntry* wiredMapEntries;69,2609 + int nMergedWiredMapEntries;70,2677 + LoadMapEntry* mergedWiredMapEntries;71,2760 + int nUnwiredMapEntries;72,2807 + LoadMapEntry* unwiredMapEntries;73,2889 + int nMergedUnwiredMapEntries;74,2974 + LoadMapEntry* mergedUnwiredMapEntries;75,3058 + } World;76,3107 +enum LoadFileFormat81,3156 + VLMWorldFormat,83,3180 + IvoryWorldFormat 84,3231 +#define VersionAndArchitectureQ 89,3336 +#define VLMWorldSuffix 94,3413 +#define VLMWorldFileCookie 96,3445 +#define VLMWorldFileCookieSwapped 97,3486 +#define VLMPageSizeQs 98,3534 +#define VLMBlockSize 99,3561 +#define VLMBlocksPerDataPage 100,3587 +#define VLMBlocksPerTagsPage 101,3618 +#define VLMMaximumHeaderBlocks 102,3649 +#define VLMDataPageSizeBytes 103,3683 +#define VLMTagsPageSizeBytes 104,3730 +#define VLMVersion1AndArchitecture 106,3774 +#define VLMWorldFileV1WiredCountQ 107,3819 +#define VLMWorldFileV1UnwiredCountQ 108,3855 +#define VLMWorldFileV1PageBasesQ 109,3893 +#define VLMWorldFileV1FirstSysoutQ 110,3928 +#define VLMWorldFileV1FirstMapQ 111,3965 +#define VLMVersion2AndArchitecture 113,4000 +#define VLMWorldFileV2WiredCountQ 114,4045 +#define VLMWorldFileV2UnwiredCountQ 115,4081 +#define VLMWorldFileV2PageBasesQ 116,4119 +#define VLMWorldFileV2FirstSysoutQ 117,4154 +#define VLMWorldFileV2FirstMapQ 118,4191 + Integer dataPageBase:dataPageBase125,4373 + Integer tagsPageBase:tagsPageBase126,4400 + Integer tagsPageBase:tagsPageBase128,4482 + Integer dataPageBase:dataPageBase129,4558 + } VLMPageBases;131,4592 +#define IvoryWorldSuffix 136,4656 +#define IvoryWorldFileCookie 139,4722 +#define IvoryWorldFileCookie 141,4771 +#define IvoryPageSizeQs 143,4821 +#define IvoryPageSizeBytes 144,4849 +#define IvoryWorldFileWiredCountQ 145,4881 +#define IvoryWorldFileUnwiredCountQ 146,4917 +#define IvoryWorldFileFirstSysoutQ 147,4955 +#define IvoryWorldFileFirstMapQ 148,4992 + Integer address;155,5124 + Integer extent;156,5195 + } SaveWorldEntry;157,5272 + Integer pathname;161,5313 + Integer entryCount;162,5384 + SaveWorldEntry entries[entries163,5456 + } SaveWorldData;164,5484 + +life-support/chaos.h,2579 +#define __chaos_h__2,20 +#define ETH_P_CHAOS 13,211 +#define ETH_P_ARP 14,238 +#define MIN_CHAOS_PACKET_SIZE 15,263 +#define MIN_ARP_CHAOS_PACKET_SIZE 16,296 +#define MAX_CHAOS_DATA_BYTES 17,333 +#define MAX_CHAOS_DATA_SHORTS 18,366 +#define MAX_CHAOS_DATA_WORDS 19,400 +#define CHAOS_MIN_HOST_NUM 20,433 +#define CHAOS_MAX_HOST_NUM 21,462 +#define CHAOS_MIN_SUBNET_NUM 22,493 +#define CHAOS_MAX_SUBNET_NUM 23,541 +#define CHAOS_OP_RFC 27,612 +#define CHAOS_OP_OPN 28,638 +#define CHAOS_OP_CLS 29,664 +#define CHAOS_OP_FWD 30,690 +#define CHAOS_OP_ANS 31,716 +#define CHAOS_OP_SNS 32,742 +#define CHAOS_OP_STS 33,768 +#define CHAOS_OP_RUT 34,794 +#define CHAOS_OP_LOS 35,820 +#define CHAOS_OP_LSN 36,846 +#define CHAOS_OP_MNT 37,872 +#define CHAOS_OP_EOF 38,898 +#define CHAOS_OP_UNC 39,924 +#define CHAOS_OP_BRD 40,950 +#define CHAOS_OP_DAT 41,976 +typedef uint8_t mac_address[mac_address45,1031 +typedef uint8_t *mac_address_p mac_address_p46,1071 +struct eth_header 50,1127 + mac_address eth_dst 51,1147 + mac_address eth_src 52,1171 + uint16_t eth_prot 53,1195 +struct arp_chaos_packet 56,1222 + struct eth_header eth 57,1248 + struct arphdr arp 58,1285 + mac_address src_mac 59,1321 + uint16_t src_chaos 60,1357 + mac_address dst_mac 61,1393 + uint16_t dst_chaos 62,1429 + uint8_t padding[padding64,1507 +struct arp_ip_packet 67,1562 + struct eth_header eth 68,1585 + struct arphdr arp 69,1623 + mac_address src_mac 70,1660 + struct in_addr src_ip 71,1697 + mac_address dst_mac 72,1734 + struct in_addr dst_ip 73,1771 + uint8_t padding[padding75,1851 +struct chaos_header 78,1907 + uint8_t prot 80,1975 + uint8_t opcode 81,1992 + uint8_t opcode 83,2017 + uint8_t prot 84,2036 + union { unsigned short lfcwhole;86,2060 + unsigned short nbytes:nbytes88,2108 + unsigned short fwd_count:fwd_count89,2171 + uint8_t dest_host 93,2288 + uint8_t dest_subnet 94,2310 + uint8_t dest_subnet 96,2340 + uint8_t dest_host 97,2364 + uint16_t dest_index_num 99,2393 + uint8_t source_host 101,2467 + uint8_t source_subnet 102,2491 + uint8_t source_subnet 104,2523 + uint8_t source_host 105,2549 + uint16_t source_index_num 107,2580 + uint16_t num 108,2610 + uint16_t ack_num 109,2627 +struct chaos_packet 112,2653 + struct chaos_header hd;113,2675 + uint8_t data8[data8115,2711 + uint16_t data16[data16116,2754 + uint32_t data32[data32117,2799 +struct eth_chaos_packet 121,2854 + struct eth_header eth 122,2880 + struct chaos_packet chaos 123,2906 +struct eth_ip_packet 126,2941 + struct eth_header eth 127,2964 + struct ip ip 128,2990 + +life-support/cold_load_keymappings.h,872 +#define COLD_LOAD_KEYMAPPINGS_2,32 +#define XK_MISCELLANY4,64 +#define XK_XKB_KEYS5,86 +#define XK_LATIN16,106 +enum KeyboardType 12,256 + Unknown,13,276 + DEC_LK401,14,287 + DEC_PC,15,300 + Apple_Pro,16,310 + German,17,323 + Us18,333 + short code;22,360 + KeySym keysym;23,374 +} coldmapentry;24,391 + KeySym code;27,425 + KeySym keysym;28,440 +} isol3mapentry;29,457 +static coldmapentry coldmapDECLK[coldmapDECLK34,502 +static short fkmapDECLK[fkmapDECLK53,975 +static coldmapentry coldmapDECPC[coldmapDECPC85,1999 +static short fkmapDECPC[fkmapDECPC110,2649 +static coldmapentry coldmapApple[coldmapApple140,3618 +static short fkmapApple[fkmapApple158,4077 +static coldmapentry coldmapGerman[coldmapGerman186,4749 +static short fkmapGerman[fkmapGerman205,5290 +static coldmapentry coldmapUs[coldmapUs233,6066 +static short fkmapUs[fkmapUs252,6603 + +life-support/embed.h,16099 +#define _EMBED_11,403 +#define NSignals 23,566 + pthread_t handlerThread;27,606 + bool handlerThreadSetup;28,677 + SignalMask signal;29,752 + ProcPtrV handlerFunction;30,818 + PtrV handlerArgument;31,902 + } SignalHandler;32,953 + EmbWord identifier;45,1281 + EmbWord version;46,1365 + EmbWord system_type;47,1443 + EmbWord number_of_slots;49,1531 + EmbWord comm_memory_size;50,1618 + EmbWord minor 56,1874 + EmbWord major 57,1895 + EmbWord major 59,1922 + EmbWord minor 60,1943 + } generaVersion;62,1971 + EmbWord minorRevision 66,2099 + EmbWord majorRevision 67,2127 + EmbWord minorRelease 68,2155 + EmbWord majorRelease 69,2182 + EmbWord testReleaseP 70,2209 + EmbWord testReleaseP 72,2242 + EmbWord majorRelease 73,2269 + EmbWord minorRelease 74,2296 + EmbWord majorRevision 75,2323 + EmbWord minorRevision 76,2351 + } osfVersion;78,2386 + EmbWord guest_major_version;79,2404 + EmbWord guest_minor_version;80,2434 + EmbWord fep_major_version;81,2464 + EmbWord fep_minor_version;82,2492 + EmbPtr guest_buffer_start;85,2546 + EmbWord guest_buffer_size;86,2631 + EmbPtr host_buffer_start;87,2696 + EmbWord host_buffer_size;88,2779 + EmbPtr fep_buffer_start;89,2843 + EmbWord fep_buffer_size;90,2920 + SignalMask guest_to_host_signals;93,2999 + SignalMask live_guest_to_host_signals;94,3073 + SignalMask host_to_guest_signals;95,3145 + SignalMask live_host_to_guest_signals;96,3219 + EmbPtr channel_table;99,3308 + EmbPtr consoleChannel;100,3376 + EmbPtr cold_load_channel;101,3439 + EmbPtr command_channel;102,3497 + EmbWord virtualMemorySize;105,3581 + EmbWord worldImageSize;106,3657 + EmbPtr bad_memory_map;107,3718 + EmbWord bad_memory_map_size;108,3800 + SignalNumber clock_signal;113,4033 + EmbWord clock_interval;114,4114 + EmbWord run_lights;115,4200 + EmbWord reset_request;116,4269 + EmbWord board_serial_number;117,4348 + EmbWord board_major_version;118,4410 + EmbWord board_minor_version;119,4479 + EmbWord spy_command;120,4548 + EmbWord spy_status;121,4588 + EmbWord stop_request;122,4628 + uEmbWord status:status126,4732 + uEmbWord cursor:cursor127,4811 + uEmbWord busy:busy128,4882 + uEmbWord error:error129,4942 + uEmbWord lisp_is_loaded:lisp_is_loaded130,5010 + uEmbWord 131,5093 + uEmbWord 133,5115 + uEmbWord lisp_is_loaded:lisp_is_loaded134,5131 + uEmbWord error:error135,5214 + uEmbWord busy:busy136,5282 + uEmbWord cursor:cursor137,5342 + uEmbWord status:status138,5413 + } fep;140,5499 + EmbWord restart_applications;141,5510 + EmbWord signal_interrupt_vector;142,5601 + EmbWord base_register;143,5699 + EmbWord hostVersion2;144,5760 + EmbWord hostVersion3;145,5798 + EmbWord data:data149,5881 + EmbWord 150,5958 + EmbWord 152,5979 + EmbWord data:data153,5994 + } MacIvory_NVRAM_settings;155,6078 + EmbPtr worldPathname;156,6109 + EmbPtr unixLoginName;157,6188 + uEmbWord unixUID;158,6263 + uEmbWord unixGID;159,6306 + EmbPtr unixCwd;160,6346 + EmbPtr UnixHomeDir;161,6419 + EmbWord pad0,166,6642 + pad1[pad1167,6706 + EmbWord guestStatus;183,7478 + pthread_attr_t pollThreadAttrs;185,7528 + bool pollThreadAttrsSetup;186,7610 + pthread_attr_t outputThreadAttrs;188,7690 + bool outputThreadAttrsSetup;189,7773 + pthread_attr_t inputThreadAttrs;191,7855 + bool inputThreadAttrsSetup;192,7936 + bool useSignalLocks;194,8017 + SignalHandler signalHandler[signalHandler195,8092 + SignalMask reawaken;196,8172 + pthread_mutex_t signalLock;197,8245 + bool signalLockSetup;198,8318 + pthread_cond_t signalSignal;199,8392 + bool signalSignalSetup;200,8462 + pthread_t pollingThread;202,8533 + bool pollingThreadSetup;203,8613 + long pollTime;204,8695 + long pollClockTime;205,8766 + pthread_mutex_t clockLock;207,8845 + bool clockLockSetup;208,8917 + pthread_cond_t clockSignal;209,8989 + bool clockSignalSetup;210,9061 + pthread_t clockThread;211,9128 + bool clockThreadSetup;212,9207 + long clockTime;213,9277 + EmbWord resetRequestCount;215,9354 + EmbWord restartApplicationsCount;216,9440 + bool inhibitDisk;218,9525 + EmbWord debugLevel;219,9596 + caddr_t slaveTrigger;221,9662 + pthread_mutex_t XLock;224,9786 + bool XLockSetup;225,9858 + pthread_mutex_t wakeupLock;227,9927 + bool wakeupLockSetup;228,10001 + pthread_cond_t wakeupSignal;229,10073 + bool wakeupSignalSetup;230,10147 + } EmbCommArea;233,10301 +enum system_type240,10474 + SystemTypeUX400G 242,10495 + SystemTypeXL400 243,10561 + SystemTypeMacIvory1 244,10621 + SystemTypeMacIvory2 245,10706 + SystemTypeUX400S 246,10791 + SystemTypeXL1200 247,10875 + SystemTypeUX1200S 248,10937 + SystemTypeUX1200G 249,11025 + SystemTypeMacIvory3 250,11095 + SystemTypeNXP1000 251,11179 + SystemTypeVLM 252,11265 +enum ResetRequest256,11366 + ReadNVRAMResetRequest 258,11388 + WriteNVRAMResetRequest,259,11454 + AreYouThereResetRequest,260,11518 + BootResetRequest,261,11591 + DevicePROMResetRequest,262,11671 + FEPResetRequest,263,11753 + NoResetRequest,264,11834 + LispResetRequest 265,11874 +enum GuestStatus269,12003 + NonexistentGuestStatus 271,12024 + BrokenGuestStatus 272,12086 + UninitializedGuestStatus 273,12155 + InitializingGuestStatus,274,12243 + InitializedGuestStatus,275,12328 + StartedGuestStatus,276,12404 + CrashedGuestStatus,277,12486 + RunningGuestStatus 278,12552 +enum FEPStatus282,12640 + HaltedFEPStatus 284,12659 + HaltedFEPStatus = 0xFF,xFF284,12659 + RunningFEPStatus 285,12744 + IdleFEPStatus 286,12790 +#define NullEmbPtr 293,12915 +#define HostPointer(297,13060 +#define GuestPointer(301,13235 + EmbWord length;308,13348 + EmbWord string;309,13410 + } EmbString;310,13488 + EmbWord element_size;317,13543 + EmbWord queue_size;318,13607 + EmbWord put_index;319,13668 + EmbWord take_index;320,13732 + SignalNumber signal;321,13794 + EmbWord first_element[first_element323,13906 + } EmbQueue;324,13969 + EmbWord type;344,14946 + EmbWord unit;345,15001 + EmbPtr next;346,15070 + } EmbChannel;348,15188 +enum EmbChannelType351,15239 + EmbDiskChannelType 353,15263 + EmbConsoleChannelType,354,15316 + EmbNetworkChannelType,355,15376 + EmbRPCChannelType,356,15422 + EmbSCSIChannelType,357,15472 + EmbColdLoadChannelType,358,15515 + EmbHostFileChannelType,359,15564 + EmbMessageChannelType 360,15628 +#define NIOVectors 366,15729 + EmbWord type;370,15771 + EmbWord unit;371,15815 + EmbPtr next;372,15856 + EmbWord number_of_pages;373,15901 + EmbPtr command_queue;375,16025 + EmbPtr status_queue;376,16080 + uEmbWord host_byte_order:host_byte_order381,16240 + uEmbWord read_only:read_only382,16323 + uEmbWord 383,16385 + uEmbWord 385,16407 + uEmbWord read_only:read_only386,16423 + uEmbWord host_byte_order:host_byte_order387,16485 + } flags;389,16575 + EmbWord hostState0;390,16588 + EmbWord hostState1;391,16665 + EmbWord blocksize 392,16748 +} EmbDiskChannel;393,16823 + EmbQueue *command_queue_ptr;command_queue_ptr399,16912 + EmbQueue *status_queue_ptr;status_queue_ptr400,16984 + bool error_pending;401,17023 + int fd;402,17102 + int blocksize 403,17171 + char* filename 404,17262 + struct iovec iovs[iovs405,17322 + } DiskChannelState;406,17402 + EmbPtr diskChannel;412,17529 + EmbWord filename;413,17605 + EmbWord ifNotFoundAction;414,17681 + EmbWord minimumLength;415,17752 + EmbWord result;416,17822 + EmbPtr errorMsg;417,17902 + EmbWord blockSize 418,17980 + } AttachDiskChannelRequest;419,18068 +enum IfNotFoundActions421,18100 + CreateIfNotFound,423,18127 + ErrorIfNotFound424,18146 + EmbPtr diskChannel;431,18272 + EmbWord newLength;432,18334 + EmbWord result;433,18411 + EmbPtr errorMsg;434,18491 + } GrowDiskPartitionRequest;435,18569 +enum EmbDiskCmd440,18719 + ReadCmd 442,18739 + WriteCmd,443,18785 + ResetCmd,444,18832 + InitializeCmd 445,18901 +enum EmbDiskStatus448,18983 + WonStatus 450,19006 + LostStatus,451,19070 + AbortStatus 452,19115 + EmbWord cryptPassword 459,19288 + EmbWord cryptSalt 460,19380 + EmbWord cryptResult 461,19464 + EmbPtr cryptString 462,19557 +} UnixCryptRequest 463,19662 + uEmbWord cmd:cmd468,19735 + uEmbWord tagged:tagged469,19780 + uEmbWord buffered:buffered470,19849 + uEmbWord 471,19927 + uEmbWord suppress_error_recovery:suppress_error_recovery472,19941 + uEmbWord 473,20023 + uEmbWord 474,20037 + uEmbWord 476,20058 + uEmbWord 477,20073 + uEmbWord suppress_error_recovery:suppress_error_recovery478,20087 + uEmbWord 479,20169 + uEmbWord buffered:buffered480,20183 + uEmbWord tagged:tagged481,20261 + uEmbWord cmd:cmd482,20330 + } EmbDiskOperation;484,20382 + EmbPtr address;488,20423 + EmbWord n_words;489,20467 + } EmbAddressPair;490,20526 + EmbWord id;494,20567 + EmbWord sync;495,20616 + EmbDiskOperation op;496,20693 + EmbWord page;497,20735 + EmbWord count;498,20793 + EmbWord n_addresses;499,20847 + EmbWord status;500,20908 + EmbWord error_code;501,20957 + EmbAddressPair addresses[addresses502,21029 + } EmbDiskQueueElement;503,21114 + EmbWord windowID;512,21336 + EmbWord nLights;513,21416 + EmbWord lightWidth;514,21476 + EmbWord lightHeight;515,21549 + EmbWord firstLightX;516,21600 + EmbWord firstLightY;517,21683 + EmbWord lightXSpacing;518,21734 + EmbWord lightYSpacing;519,21814 + EmbWord lightForeground;520,21867 + EmbWord lightBackground;521,21945 + EmbWord lightPlaneMask;522,21998 + } EmbConsoleRunLights;523,22045 + EmbWord type;528,22115 + EmbWord unit;529,22162 + EmbPtr next;530,22200 + EmbPtr outputRequestQueue;531,22245 + EmbPtr outputReplyQueue;532,22327 + EmbPtr inputRequestQueue;533,22414 + EmbPtr inputReplyQueue;534,22491 + EmbWord hostAddress;535,22556 + EmbWord displayNumber;536,22635 + EmbWord screenNumber;537,22714 + EmbWord initialState;538,22791 + EmbPtr geometry;539,22872 + EmbPtr foregroundColor;540,22952 + EmbPtr backgroundColor;541,23030 + EmbPtr borderColor;542,23109 + EmbPtr borderWidth;543,23181 + EmbWord inputAvailableP;544,23257 + EmbQueue *outputRequestQ;outputRequestQ546,23391 + EmbQueue *outputReplyQ;outputReplyQ547,23461 + EmbQueue *inputRequestQ;inputRequestQ548,23498 + EmbQueue *inputReplyQ;inputReplyQ549,23536 + pthread_t drawRunLights;550,23572 + bool drawRunLightsSetup;551,23641 + char *hostName;hostName552,23707 + void *display;display553,23781 + int fd;554,23839 + int openingState;555,23905 + int nextPixmapFormat;556,23974 + int nextRoot;557,24052 + int nextRootDepth;558,24108 + int nextRootDepthVisual;559,24174 + void *rlDisplay;rlDisplay560,24252 + EmbConsoleRunLights runLights;561,24316 + void *rlGC;rlGC562,24404 + EmbWord lastRunLights;563,24463 + } EmbConsoleChannel;564,24539 +enum OpeningState568,24659 + OpeningStateNone,570,24681 + OpeningStatePrefix,571,24739 + OpeningStateHeader,572,24805 + OpeningStateVendor,573,24871 + OpeningStatePixmapFormat,574,24944 + OpeningStateRoot,575,25019 + OpeningStateRootDepth,576,25095 + OpeningStateRootDepthVisual 577,25177 + EmbWord opcode;583,25342 + EmbWord id;584,25390 + EmbWord result;585,25448 + EmbWord data[data586,25527 + } EmbConsoleBuffer;587,25595 +enum EmbConsoleCommand589,25619 + EmbConsoleCommandOpenDisplay 591,25646 + EmbConsoleCommandCloseDisplay,592,25704 + EmbConsoleCommandNoOp,593,25761 + EmbConsoleCommandWrite,594,25838 + EmbConsoleCommandRead,595,25897 + EmbConsoleCommandInputWait,596,25978 + EmbConsoleCommandEnableRunLights,597,26050 + EmbConsoleCommandDisableRunLights 598,26117 + EmbWord lastRequestNumber;604,26305 + } EmbConsoleOpenDisplay;605,26389 + EmbWord address;611,26554 + EmbWord offset;612,26609 + EmbWord nBytes;613,26683 + } EmbConsoleDataTransfer;614,26738 + EmbWord timeout;619,26880 + EmbWord availableP;620,26954 + } EmbConsoleInputWait;621,27036 +#define ColdLoadCommandHistorySize 626,27100 +#define ColdLoadProgressStringSize 628,27186 + EmbWord type;632,27289 + EmbWord unit;633,27336 + EmbPtr next;634,27373 + EmbPtr keyboard_input_queue;635,27417 + EmbPtr display_output_queue;636,27482 + EmbWord display_width;637,27553 + EmbWord display_height;638,27611 + EmbWord character_width;639,27671 + EmbWord line_height;640,27735 + EmbWord numerator;643,27842 + EmbWord denominator;644,27908 + EmbWord string_total_size;645,27946 + EmbWord string_length;646,28024 + char string[string647,28100 + } progress_note;648,28183 + pthread_t coldLoadInput;650,28257 + bool coldLoadInputSetup;651,28333 + int fd;652,28395 + bool is_selected;653,28455 + EmbWord command_history_top;654,28519 + EmbWord command_history_wrapped;655,28593 + EmbWord command_history[command_history656,28672 +} EmbColdLoadChannel;657,28745 +#define MaxEmbNetPacketSize 662,28797 +typedef struct EmbNetARPReq667,28978 + struct EmbNetARPReq *next;next669,29010 + struct arpreq arp;670,29038 + } EmbNetARPReq;671,29059 + EmbWord type;676,29105 + EmbWord unit;677,29152 + EmbPtr next;678,29202 + EmbWord status;679,29263 + EmbPtr guestToHostQueue;680,29314 + EmbPtr guestToHostReturnQueue;681,29383 + EmbPtr hostToGuestSupplyQueue;682,29464 + EmbPtr hostToGuestQueue;683,29544 + EmbWord name0;684,29615 + EmbWord name1;685,29684 + EmbWord hardwareAddressHigh;686,29753 + EmbWord hardwareAddressLow;687,29838 + EmbWord hostPrimaryProtocol;688,29922 + EmbWord hostPrimaryAddress;689,30006 + EmbWord guestPrimaryProtocol;690,30083 + EmbWord guestPrimaryAddress;691,30169 + EmbWord nTransmitFailures;693,30261 + EmbWord nReceiveFailures;694,30341 + EmbWord nFalseReceiverWakeups;695,30425 + EmbWord nReceivedPacketsLost;696,30488 + EmbWord unusedMeters[unusedMeters697,30577 + EmbPtr addressString;698,30603 + EmbQueue *guestToHostQ;guestToHostQ700,30738 + EmbQueue *guestToHostReturnQ;guestToHostReturnQ701,30807 + EmbQueue *hostToGuestSupplyQ;hostToGuestSupplyQ702,30848 + EmbQueue *hostToGuestQ;hostToGuestQ703,30889 + pcap_t* pcap;705,30945 + int fd;708,30985 + unsigned int net_broken 709,31050 + struct sockaddr_ll sll;710,31138 + EmbNetARPReq *arpReq;arpReq711,31215 + EmbNetFilter filter;714,31307 + pthread_t receiverThread;715,31368 + boolean receiverThreadSetup;716,31439 + int alignmentPad;717,31514 + byte receiveBuffer[receiveBuffer718,31589 + } EmbNetChannel;719,31666 +#define EmbNetStatusHostReady 723,31737 +#define EmbNetStatusGuestReady 724,31815 + EmbWord nBytes;730,31987 + EmbWord data[data731,32040 + } EmbNetPacket;732,32076 + EmbWord type;739,32166 + EmbWord unit;740,32213 + EmbPtr next;741,32282 + EmbWord subtype;742,32343 + EmbPtr guestToHostQueue;743,32416 + EmbPtr guestToHostReturnQueue;744,32486 + EmbWord guestToHostImpulse;745,32563 + EmbPtr hostToGuestQueue;746,32648 + EmbPtr hostToGuestSupplyQueue;747,32716 + EmbWord hostToGuestImpulse;748,32793 + uEmbWord subtypeData0;749,32877 + uEmbWord subtypeData1;750,32955 + } EmbMessageChannel;751,33039 +enum EmbMessageChannelSubtype753,33063 + EmbMessageChannelSerialSubtype 755,33097 + EmbMessageChannelCommandSubtype,756,33165 + EmbMessageChannelMBINSubtype 757,33247 +enum EmbMessageImpulse760,33316 + EmbMessageImpulseNone 762,33343 +#define EmbMessageSubtypeDataHeader 767,33453 + EmbMessageSubtypeDataHeader;777,33754 + } EmbMessageSubtypeData;778,33787 +#define EmbMessageBufferHeader 783,33924 +#define EmbMessageBufferHeader 790,34116 + EmbMessageBufferHeader;800,34329 + EmbWord data[data801,34354 + } EmbMessageBuffer;802,34406 + EmbMessageSubtypeDataHeader;809,34486 + EmbQueue* guestToHostQueue;810,34516 + EmbQueue* guestToHostReturnQueue;811,34592 + } EmbCommandChannel;812,34638 +enum EmbCommandBufferOpcode814,34663 + EmbCommandBufferStartMBIN 816,34695 +#define EmbCommandBufferHeader 819,34771 + EmbCommandBufferHeader;825,34935 + EmbWord operands[operands826,34960 + } EmbCommandBuffer;827,35040 + EmbCommandBufferHeader;831,35083 + EmbPtr mbinChannel;832,35108 + } EmbCommandStartMBINBuffer;833,35187 + EmbMessageSubtypeDataHeader;842,35468 + EmbQueue* guestToHostQueue;843,35498 + EmbQueue* guestToHostReturnQueue;844,35574 + EmbQueue* hostToGuestQueue;845,35620 + EmbQueue* hostToGuestSupplyQueue;846,35661 + } EmbMBINChannel;847,35707 +enum EmbMBINImpulse849,35729 + EmbMBINImpulseShutdown 851,35753 + +life-support/FEPComm.h,4182 +#define _FEPCOM_6,125 +#define FEPCommAreaAddress 11,188 +#define FEPCommAreaSize 12,227 +#define FEPCommSlotAddress(15,312 +#define ReadFEPCommSlot(20,524 +#define ReadFEPCommSlot(23,625 +#define WriteFEPCommSlot(29,811 +#define WriteFEPCommSlot(37,1025 + EmbWord fepVersionNumber;48,1249 + EmbWord systemType;49,1276 + EmbWord fepStartup;50,1297 + EmbWord spyCommand;51,1318 + EmbWord spyStatus;52,1360 + EmbWord spyPC;53,1401 + EmbWord loadMapSize;54,1439 + EmbWord loadMapVMAAddress;55,1461 + EmbWord loadMapOpcodeAddress;56,1489 + EmbWord loadMapOperandAddress;57,1520 + EmbWord swapMapSize;58,1552 + EmbWord swapMapAddress;59,1574 + EmbWord swapMapDPNAddress;60,1599 + EmbWord mainMemoryMapSize;61,1627 + EmbWord mainMemoryMapAddress;62,1655 + EmbWord badMemoryPagesSize;63,1686 + EmbWord badMemoryPagesAddress;64,1715 + EmbWord fepPhysicalAddressHigh;65,1747 + EmbWord unwiredVirtualAddressLow;66,1780 + EmbWord unwiredVirtualAddressHigh;67,1815 + EmbWord unwiredPhysicalAddressLow;68,1851 + EmbWord unwiredPhysicalAddressHigh;69,1887 + EmbWord requestingLispToStop;70,1924 + EmbWord currentFEPOverlays;71,1955 + EmbWord embCommunicationArea;72,1984 + EmbWord loadedBandName;73,2015 + EmbWord netbootControlString;74,2040 + EmbWord softwareConfiguration;75,2071 + EmbWord netAddress1;76,2103 + EmbWord netAddress2;77,2125 + EmbWord primaryNetworkAddress;78,2147 + EmbWord fepCommandString;79,2179 + EmbWord fepCrashDataRequest;80,2206 + EmbWord coldLoadStreamReadCharacter;81,2236 + EmbWord coldLoadStreamListen;82,2274 + EmbWord coldLoadStreamReadHardwareCharacter;83,2305 + EmbWord coldLoadStreamDrawCharacter;84,2351 + EmbWord coldLoadStreamDisplayLozengedString;85,2389 + EmbWord coldLoadStreamSelect;86,2435 + EmbWord coldLoadStreamBeep;87,2466 + EmbWord coldLoadStreamFinish;88,2495 + EmbWord coldLoadStreamInsideSize;89,2526 + EmbWord coldLoadStreamSetCursorpos;90,2561 + EmbWord coldLoadStreamReadCursorpos;91,2598 + EmbWord coldLoadStreamComputeMotion;92,2636 + EmbWord coldLoadStreamClearBetweenCursorposes;93,2674 + EmbWord coldLoadStreamSetEdges;94,2722 + EmbWord mainScreenParameters;95,2755 + EmbWord wiredFormat;96,2786 + EmbWord fepSequenceBreak;97,2808 + EmbWord lispStoppedCleanly;98,2854 + EmbWord loadPagesToSwapAreaP;99,2883 + EmbWord remoteDebugLoop;100,2914 + EmbWord timezoneOffsetMinutes;101,2940 + EmbWord timezoneName;102,2972 + EmbWord namespaceDescriptorFile;103,2995 + EmbWord siteName;104,3029 + EmbWord savedLispRegisters;105,3048 + EmbWord lispStateSaved;106,3077 + EmbWord enableFPAp;107,3102 + EmbWord diskUnitTable;108,3123 + EmbWord hardwareConfiguration;109,3147 + EmbWord slaveBufferBaseAddress;110,3179 + EmbWord kernelCompressedStringArray;111,3212 + EmbWord domino8032State;112,3250 + } FEPCommArea;113,3276 + EmbWord fepVersionNumber;121,3370 + EmbWord systemType;122,3397 + EmbWord fepStartup;123,3418 + EmbWord embCommunicationArea;124,3439 + EmbWord memorySegmentFreeList;125,3470 + EmbWord unallocatedPhysicalMemory;126,3502 + EmbWord phtSize;127,3538 + EmbWord phtCollisionCountsBase;128,3556 + EmbWord phtCollisionCount;129,3589 + EmbWord phtRehashes;130,3617 + EmbWord unmappedMemoryBase;131,3639 + EmbWord allocatePhyiscalMemoryAtAddress;132,3668 + EmbWord allocatePhysicalMemory;133,3710 + EmbWord deallocatePhysicalMemory;134,3743 + EmbWord romPHTLookup;135,3778 + EmbWord romPHTPut;136,3801 + EmbWord romPHTRemove;137,3821 + EmbWord romPHTRehash;138,3844 + EmbWord romError;139,3867 + EmbWord clearMapCache;140,3886 + EmbWord localIPAddress0;141,3910 + EmbWord diagnosticIPAddress;142,3936 + EmbWord romMBINGetReceiveBuffer;143,3966 + EmbWord romMBINReturnReceiveBuffer;144,4000 + EmbWord romMBINGetTransmitBuffer;145,4037 + EmbWord romMBINSendTransmitBuffer;146,4072 + EmbWord initializeInteractor;147,4108 + EmbWord localIPAddress1;148,4139 + EmbWord localIPSubnetMask0;149,4165 + EmbWord localIPSubnetMask1;150,4194 + EmbWord gatewayIPAddress0;151,4223 + EmbWord gatewayIPAddress1;152,4251 + EmbWord loadServerIPAddress;153,4279 + EmbWord hardwareECORegisters;154,4309 + EmbWord ethernetDriver0;155,4340 + EmbWord ethernetDriver1;156,4366 + EmbWord romUpdateRendezvousParameters;157,4392 + } FEPCommArea;158,4432 + +life-support/life_prototypes.h,117 +#define begin_MUTEX_LOCKED(19,561 +#define end_MUTEX_LOCKED(26,863 +#define WaitUntilInitializationComplete(36,1357 + +life-support/life_types.h,451 +#define _LIFE_TYPES_6,107 +typedef int32_t EmbWord;10,150 +typedef uint32_t uEmbWord;11,219 +typedef EmbWord EmbPtr;13,290 +typedef uEmbWord SignalMask;14,370 +typedef EmbWord SignalNumber;15,434 +typedef EmbWord bool;16,497 +typedef unsigned char boolean;17,578 +typedef unsigned char byte;18,650 +typedef void* PtrV;19,714 +typedef void (*ProcPtrV)ProcPtrV20,793 +enum WindowInitialState23,924 + Iconic 25,952 + Unspecified,26,966 + Normal27,980 + +life-support/symbolics_characters.h,1236 +static char *s_char_rcsid s_char_rcsid67,3073 +#define SK_Null 72,3239 +#define SK_Suspend 73,3260 +#define SK_Clear_Input 74,3284 +#define SK_Function 75,3312 +#define SK_Help 76,3337 +#define SK_Rubout 77,3358 +#define SK_Backspace 78,3381 +#define SK_Tab 79,3407 +#define SK_Line 80,3427 +#define SK_Refresh 81,3448 +#define SK_Page 82,3472 +#define SK_Return 83,3493 +#define SK_Abort 84,3516 +#define SK_Resume 85,3538 +#define SK_End 86,3561 +#define SK_Square 87,3581 +#define SK_Circle 88,3604 +#define SK_Triangle 89,3627 +#define SK_Scroll 90,3652 +#define SK_Select 91,3675 +#define SK_Network 92,3698 +#define SK_Escape 93,3722 +#define SK_Complete 94,3745 +#define SK_Symbol_help 95,3770 +#define clsoDrawChar 99,3834 +#define clsoSetCursorpos 100,3867 +#define clsoClearRestOfLine 101,3903 +#define clsoClearRestOfWindow 102,3942 +#define clsoDisplayLozengedString 103,3983 +#define clsoLozengedChar 104,4025 +#define clsoBeep 105,4061 +#define clsoSelect 106,4090 +#define clsoDeselect 107,4121 +#define clsoInputChar 108,4154 +#define clsoSetSize 109,4188 +#define clOpCode(111,4221 +#define clOpBits(112,4260 +#define clOpChar(113,4300 +#define clMakeOp(114,4335 +#define ASCIItoLispMTranslations 118,4495 + +life-support/SystemComm.h,2601 +#define _SYSTEMCOM_6,131 +#define SystemCommAreaAddress 11,197 +#define SystemCommAreaSize 12,239 +#define SystemCommSlotAddress(15,330 +#define ReadSystemCommSlot(20,554 +#define ReadSystemCommSlot(23,661 +#define WriteSystemCommSlot(29,856 +#define WriteSystemCommSlot(37,1076 + EmbWord syscomMajorVersionNumber;48,1309 + EmbWord syscomMinorVersionNumber;49,1344 + EmbWord systemStartup;50,1379 + EmbWord addressSpaceMapAddress;51,1403 + EmbWord oblastFreeSize;52,1436 + EmbWord areaName;53,1461 + EmbWord areaMaximumQuantumSize;54,1480 + EmbWord areaRegionQuantumSize;55,1513 + EmbWord areaRegionList;56,1545 + EmbWord areaRegionBits;57,1570 + EmbWord regionQuantumOrigin;58,1595 + EmbWord regionQuantumLength;59,1625 + EmbWord regionFreePointer;60,1655 + EmbWord regionGCPointer;61,1683 + EmbWord regionBits;62,1709 + EmbWord regionListThread;63,1730 + EmbWord regionArea;64,1757 + EmbWord regionCreatedPages;65,1778 + EmbWord regionFreePointerBeforeFlip;66,1807 + EmbWord regionConsAlarm;67,1845 + EmbWord pageConsAlarm;68,1871 + EmbWord structureCacheRegion;69,1895 + EmbWord listCacheRegion;70,1926 + EmbWord defaultConsArea;71,1952 + EmbWord pht;72,1978 + EmbWord mmptY;73,1992 + EmbWord mmpt;74,2008 + EmbWord smpt;75,2023 + EmbWord loadBitmaps;76,2038 + EmbWord loadMap;77,2060 + EmbWord loadMapDPN;78,2102 + EmbWord swapMap;79,2147 + EmbWord swapMapDPN;80,2189 + EmbWord sysoutBitmaps;81,2234 + EmbWord phtCollisionCounts;82,2258 + EmbWord mmpt1;83,2287 + EmbWord storageColdBoot;84,2303 + EmbWord flushableQueueHead;85,2329 + EmbWord flushableQueueTail;86,2358 + EmbWord flushableQueueModified;87,2387 + EmbWord wiredPhysicalAddressHigh;88,2420 + EmbWord wiredVirtualAddressHigh;89,2455 + EmbWord enableSysoutAtColdBoot;90,2489 + EmbWord sysoutGenerationNumber;91,2522 + EmbWord sysoutTimestamp1;92,2555 + EmbWord sysoutTimestamp2;93,2582 + EmbWord sysoutParentTimestamp1;94,2609 + EmbWord sysoutParentTimestamp2;95,2642 + EmbWord initialStackGroup;96,2675 + EmbWord currentStackGroup;97,2703 + EmbWord stackGroupLock;98,2731 + EmbWord currentStackGroupStatusBits;99,2756 + EmbWord inhibitSchedulingFlag;100,2794 + EmbWord controlStackLow;101,2826 + EmbWord bindingStackLow;102,2852 + EmbWord floatOperatingMode;103,2878 + EmbWord floatOperationStatus;104,2907 + EmbWord packageNameTable;105,2938 + EmbWord lispReleaseString;106,2965 + EmbWord busMode;107,2993 + } SystemCommArea;108,3011 + EmbWord systemStartup;116,3111 + EmbWord allAreas;117,3135 + EmbWord allPackages;118,3154 + EmbWord saveWorldHeader;119,3176 + EmbWord kernelUseROMEthernet;120,3202 + } SystemCommArea;121,3233 + +x86_64-emulator/aistat.h,10764 +#define _AISTAT_5,172 +typedef struct processorstate 9,192 + uint64_t transpare3;10,224 + uint64_t transpare2;11,252 + uint64_t transpare1;12,280 + uint64_t carcdrsubroutine;13,308 + uint64_t cdrsubroutine;14,342 + uint64_t carsubroutine;15,373 + uint64_t linkage;16,404 + uint64_t resumeema;17,429 + char *statistics;statistics18,456 + char *trace_hook;trace_hook19,484 + int64_t instruction_count;20,512 + uint64_t long_pad0;21,547 + uint64_t asrr9;22,574 + uint64_t asrr10;23,597 + uint64_t asrr11;24,621 + uint64_t asrr12;25,645 + uint64_t asrr13;26,669 + uint64_t asrr14;27,693 + uint64_t asrr15;28,717 + uint64_t long_pad1;29,741 + uint64_t asrr26;30,768 + uint64_t asrr27;31,792 + uint64_t asrr29;32,816 + uint64_t asrr30;33,840 + uint64_t asrf2;34,864 + uint64_t asrf3;35,887 + uint64_t asrf4;36,910 + uint64_t asrf5;37,933 + uint64_t asrf6;38,956 + uint64_t asrf7;39,979 + uint64_t asrf8;40,1002 + uint64_t asrf9;41,1025 + char *meterdatabuff;meterdatabuff42,1048 + uint32_t meterpos;43,1079 + uint32_t metermax;44,1105 + uint32_t meterfreq;45,1131 + uint32_t metermask;46,1158 + uint32_t metervalue;47,1185 + uint32_t metercount;48,1213 + uint64_t choiceptr;49,1241 + uint64_t sstkchoiceptr;50,1268 + uint64_t dbcbase;51,1299 + uint64_t dbcmask;52,1324 + char *coprocessorreadhook;coprocessorreadhook53,1349 + char *coprocessorwritehook;coprocessorwritehook54,1386 + char *flushcaches_hook;flushcaches_hook55,1424 + char *i_stage_error_hook;i_stage_error_hook56,1458 + uint64_t sfp1;57,1494 + uint64_t fp0;58,1516 + uint64_t fp1;59,1537 + uint64_t floating_exception;60,1558 + uint64_t aluandrotatecontrol;61,1594 + uint64_t rotatelatch;62,1631 + uint64_t aluborrow;63,1660 + uint64_t aluoverflow;64,1687 + uint64_t alulessthan;65,1716 + uint64_t aluop;66,1745 + uint64_t byterotate;67,1768 + uint64_t bytesize;68,1796 + int64_t bindingstacklimit;69,1822 + int64_t bindingstackpointer;70,1857 + uint64_t catchblock;71,1894 + uint64_t extraandcatch;72,1922 + uint64_t msclockcache;73,1953 + uint64_t mscmultiplier;74,1983 + uint64_t previousrcpp;75,2014 + char *rlink;rlink76,2044 + uint32_t interruptreg;77,2067 + uint32_t zoneoldspace;78,2097 + uint32_t ephemeraloldspace;79,2127 + uint32_t int_pad0;80,2162 + uint64_t eqnoteql;81,2188 + uint32_t lclength;82,2214 + uint32_t sclength;83,2240 + uint64_t lcarea;84,2266 + uint64_t lcaddress;85,2290 + uint64_t scarea;86,2317 + uint64_t scaddress;87,2341 + uint64_t restartsp;88,2368 + uint64_t stop_interpreter;89,2395 + uint64_t immediate_arg;90,2429 + uint64_t continuationcp;91,2460 + int64_t continuation;92,2492 + int64_t control;93,2522 + int64_t niladdress;94,2547 + int64_t taddress;95,2575 + int64_t bar0;96,2601 + int64_t bar1;97,2623 + int64_t bar2;98,2645 + int64_t bar3;99,2667 + int64_t epc;100,2689 + int64_t fp;101,2710 + int64_t lp;102,2730 + int64_t sp;103,2750 + char *cp;cp104,2770 + uint64_t fccrmask;105,2790 + uint32_t cslimit;106,2816 + uint32_t csextralimit;107,2841 + char *trapmeterdata;trapmeterdata108,2871 + uint64_t fepmodetrapvecaddress;109,2902 + uint64_t trapvecbase;110,2941 + uint64_t tvi;111,2970 + uint64_t fccrtrapmask;112,2991 + char *ptrtype;ptrtype113,3021 + char *vmattributetable;vmattributetable114,3046 + uint64_t vma;115,3080 + int64_t mostnegativefixnum;116,3101 + char *icachebase;icachebase117,3137 + char *endicache;endicache118,3165 + uint64_t fullworddispatch;119,3192 + uint64_t halfworddispatch;120,3226 + int64_t areventcount;121,3260 + uint64_t stackcachesize;122,3290 + uint64_t stackcachetopvma;123,3322 + uint64_t cdrcodemask;124,3356 + char *stackcachedata;stackcachedata125,3385 + uint64_t stackcachebasevma;126,3417 + uint32_t scovlimit;127,3452 + uint32_t scovdumpcount;128,3479 + int64_t mostpositivefixnum;129,3510 + uint64_t internalregisterread1;130,3546 + uint64_t internalregisterread2;131,3585 + uint64_t internalregisterwrite1;132,3624 + uint64_t internalregisterwrite2;133,3664 + uint64_t dataread_mask;134,3704 + char *dataread;dataread135,3735 + uint64_t datawrite_mask;136,3761 + char *datawrite;datawrite137,3793 + uint64_t bindread_mask;138,3820 + char *bindread;bindread139,3851 + uint64_t bindwrite_mask;140,3877 + char *bindwrite;bindwrite141,3909 + uint64_t bindreadnomonitor_mask;142,3936 + char *bindreadnomonitor;bindreadnomonitor143,3976 + uint64_t bindwritenomonitor_mask;144,4011 + char *bindwritenomonitor;bindwritenomonitor145,4052 + uint64_t header_mask;146,4088 + char *header;header147,4117 + uint64_t structureoffset_mask;148,4141 + char *structureoffset;structureoffset149,4179 + uint64_t scavenge_mask;150,4212 + char *scavenge;scavenge151,4243 + uint64_t cdr_mask;152,4269 + char *cdr;cdr153,4295 + uint64_t gccopy_mask;154,4316 + char *gccopy;gccopy155,4345 + uint64_t raw_mask;156,4369 + char *raw;raw157,4395 + uint64_t rawtranslate_mask;158,4416 + char *rawtranslate;rawtranslate159,4451 + int32_t please_stop;160,4481 + int32_t please_trap;161,4510 + int64_t runningp;162,4539 + uint64_t ac0array;163,4565 + uint64_t ac0arword;164,4591 + uint64_t ac0locat;165,4618 + uint64_t ac0length;166,4644 + uint64_t ac1array;167,4671 + uint64_t ac1arword;168,4697 + uint64_t ac1locat;169,4724 + uint64_t ac1length;170,4750 + uint64_t ac2array;171,4777 + uint64_t ac2arword;172,4803 + uint64_t ac2locat;173,4830 + uint64_t ac2length;174,4856 + uint64_t ac3array;175,4883 + uint64_t ac3arword;176,4909 + uint64_t ac3locat;177,4936 + uint64_t ac3length;178,4962 + uint64_t ac4array;179,4989 + uint64_t ac4arword;180,5015 + uint64_t ac4locat;181,5042 + uint64_t ac4length;182,5068 + uint64_t ac5array;183,5095 + uint64_t ac5arword;184,5121 + uint64_t ac5locat;185,5148 + uint64_t ac5length;186,5174 + uint64_t ac6array;187,5201 + uint64_t ac6arword;188,5227 + uint64_t ac6locat;189,5254 + uint64_t ac6length;190,5280 + uint64_t ac7array;191,5307 + uint64_t ac7arword;192,5333 + uint64_t ac7locat;193,5360 + uint64_t ac7length;194,5386 + uint32_t tmcurrenttransaction;195,5413 + uint32_t tmwritestart;196,5451 + uint32_t tmwritecurrent;197,5481 + uint32_t tmwritelimit;198,5513 + uint32_t tmrecordingreads;199,5543 + uint32_t tmreadstart;200,5577 + uint32_t tmreadcurrent;201,5606 + uint32_t tmreadlimit;202,5637 + } PROCESSORSTATE, *PROCESSORSTATEP;PROCESSORSTATEP203,5666 +#define PROCESSORSTATE_SIZE 205,5704 +typedef struct cacheline 207,5738 + uint64_t annotation;208,5765 + uint32_t nextpcdata;209,5793 + uint32_t nextpctag;210,5821 + char *nextcp;nextcp211,5848 + uint32_t instruction;212,5872 + uint32_t operand;213,5901 + uint32_t pcdata;214,5926 + uint32_t pctag;215,5950 + char *code;code216,5973 + } CACHELINE, *CACHELINEP;CACHELINEP217,5995 +#define CACHELINE_SIZE 219,6023 +#define CacheLine_Bits 221,6050 +#define CacheLine_Mask 223,6077 +#define CacheLine_RShift 225,6108 +#define CacheLine_LShift 227,6137 +#define CacheLine_FillAmount 229,6165 +typedef struct arraycache 231,6198 + uint64_t array;232,6226 + uint64_t arword;233,6249 + uint64_t locat;234,6273 + uint64_t length;235,6296 + } ARRAYCACHE, *ARRAYCACHEP;ARRAYCACHEP236,6320 +#define AutoArrayReg_Mask 238,6350 +#define AutoArrayReg_Size 240,6381 +#define AutoArrayReg_Shift 242,6411 +#define MSclock_UnitsToMSShift 244,6441 +#define MSclock_UnitsPerMicrosecond 246,6476 +#define Stack_CacheSize 248,6522 +#define Stack_MaxFrameSize 250,6552 +#define Stack_CacheMargin 252,6584 +#define Stack_CacheDumpQuantum 254,6615 +#define IvoryMemory_Data 256,6651 +#define IvoryMemory_Tag 258,6680 +typedef struct savedregisters 260,6708 + uint64_t r9;261,6740 + uint64_t r10;262,6760 + uint64_t r11;263,6781 + uint64_t r12;264,6802 + uint64_t r13;265,6823 + uint64_t r14;266,6844 + uint64_t r15;267,6865 + uint64_t r29;268,6886 + uint64_t f2;269,6907 + uint64_t f3;270,6927 + uint64_t f4;271,6947 + uint64_t f5;272,6967 + uint64_t f6;273,6987 + uint64_t f7;274,7007 + uint64_t f8;275,7027 + uint64_t f9;276,7047 + } SAVEDREGISTERS, *SAVEDREGISTERSP;SAVEDREGISTERSP277,7067 +#define SAVEDREGISTERS_SIZE 279,7105 +typedef struct tracedata 281,7138 + uint64_t n_entries;282,7165 + uint32_t recording_p;283,7192 + uint32_t wrap_p;284,7221 + uint64_t start_pc;285,7245 + uint64_t stop_pc;286,7271 + char *records_start;records_start287,7296 + char *records_end;records_end288,7327 + char *current_entry;current_entry289,7356 + char *printer;printer290,7387 + } TRACEDATA, *TRACEDATAP;TRACEDATAP291,7412 +#define TRACEDATA_SIZE 293,7440 +typedef struct tracerecord 295,7467 + uint64_t counter;296,7496 + uint64_t epc;297,7521 + uint64_t tos;298,7542 + uint64_t sp;299,7563 + char *instruction;instruction300,7583 + uint64_t instruction_data;301,7612 + uint32_t operand;302,7646 + uint32_t trap_p;303,7671 + uint64_t trap_data_0;304,7695 + uint64_t trap_data_1;305,7724 + uint64_t trap_data_2;306,7753 + uint64_t trap_data_3;307,7782 + uint32_t catch_block_p;308,7811 + uint32_t int_pad0;309,7842 + uint64_t catch_block_0;310,7868 + uint64_t catch_block_1;311,7899 + uint64_t catch_block_2;312,7930 + uint64_t catch_block_3;313,7961 + } TRACERECORD, *TRACERECORDP;TRACERECORDP314,7992 +#define TRACERECORD_SIZE 316,8024 +#define CacheMeter_Pwr 318,8054 +#define CacheMeter_DefaultFreq 320,8081 + +alpha-emulator/aistat.lisp,14475 +(defconstant processorstate$q-transpare3 14,381 +(defconstant processorstate$q-transpare2 15,429 +(defconstant processorstate$q-transpare1 16,477 +(defconstant processorstate$q-carcdrsubroutine 17,525 +(defconstant processorstate$q-cdrsubroutine 18,579 +(defconstant processorstate$q-carsubroutine 19,630 +(defconstant processorstate$q-linkage 20,681 +(defconstant processorstate$q-resumeema 21,726 +(defconstant processorstate$p-statistics 22,773 +(defconstant processorstate$p-trace-hook 23,821 +(defconstant processorstate$q-instruction-count 24,869 +(defconstant processorstate$q-long-pad0 25,924 +(defconstant processorstate$q-asrr9 26,971 +(defconstant processorstate$q-asrr10 27,1014 +(defconstant processorstate$q-asrr11 28,1058 +(defconstant processorstate$q-asrr12 29,1102 +(defconstant processorstate$q-asrr13 30,1146 +(defconstant processorstate$q-asrr14 31,1190 +(defconstant processorstate$q-asrr15 32,1234 +(defconstant processorstate$q-long-pad1 33,1278 +(defconstant processorstate$q-asrr26 34,1325 +(defconstant processorstate$q-asrr27 35,1369 +(defconstant processorstate$q-asrr29 36,1413 +(defconstant processorstate$q-asrr30 37,1457 +(defconstant processorstate$q-asrf2 38,1501 +(defconstant processorstate$q-asrf3 39,1544 +(defconstant processorstate$q-asrf4 40,1587 +(defconstant processorstate$q-asrf5 41,1630 +(defconstant processorstate$q-asrf6 42,1673 +(defconstant processorstate$q-asrf7 43,1716 +(defconstant processorstate$q-asrf8 44,1759 +(defconstant processorstate$q-asrf9 45,1802 +(defconstant processorstate$p-meterdatabuff 46,1845 +(defconstant processorstate$l-meterpos 47,1896 +(defconstant processorstate$l-metermax 48,1942 +(defconstant processorstate$l-meterfreq 49,1988 +(defconstant processorstate$l-metermask 50,2035 +(defconstant processorstate$l-metervalue 51,2082 +(defconstant processorstate$l-metercount 52,2130 +(defconstant processorstate$q-choiceptr 53,2178 +(defconstant processorstate$q-sstkchoiceptr 54,2225 +(defconstant processorstate$q-dbcbase 55,2276 +(defconstant processorstate$q-dbcmask 56,2321 +(defconstant processorstate$p-coprocessorreadhook 57,2366 +(defconstant processorstate$p-coprocessorwritehook 58,2423 +(defconstant processorstate$p-flushcaches-hook 59,2481 +(defconstant processorstate$p-i-stage-error-hook 60,2535 +(defconstant processorstate$q-sfp1 61,2591 +(defconstant processorstate$q-fp0 62,2633 +(defconstant processorstate$q-fp1 63,2674 +(defconstant processorstate$q-floating-exception 64,2715 +(defconstant processorstate$q-aluandrotatecontrol 65,2771 +(defconstant processorstate$q-rotatelatch 66,2828 +(defconstant processorstate$q-aluborrow 67,2877 +(defconstant processorstate$q-aluoverflow 68,2924 +(defconstant processorstate$q-alulessthan 69,2973 +(defconstant processorstate$q-aluop 70,3022 +(defconstant processorstate$q-byterotate 71,3065 +(defconstant processorstate$q-bytesize 72,3113 +(defconstant processorstate$q-bindingstacklimit 73,3159 +(defconstant processorstate$q-bindingstackpointer 74,3213 +(defconstant processorstate$q-catchblock 75,3269 +(defconstant processorstate$q-extraandcatch 76,3316 +(defconstant processorstate$q-msclockcache 77,3366 +(defconstant processorstate$q-mscmultiplier 78,3415 +(defconstant processorstate$q-previousrcpp 79,3465 +(defconstant processorstate$p-rlink 80,3514 +(defconstant processorstate$l-interruptreg 81,3556 +(defconstant processorstate$l-zoneoldspace 82,3605 +(defconstant processorstate$l-ephemeraloldspace 83,3654 +(defconstant processorstate$l-int-pad0 84,3708 +(defconstant processorstate$q-eqnoteql 85,3753 +(defconstant processorstate$l-lclength 86,3798 +(defconstant processorstate$l-sclength 87,3843 +(defconstant processorstate$q-lcarea 88,3888 +(defconstant processorstate$q-lcaddress 89,3931 +(defconstant processorstate$q-scarea 90,3977 +(defconstant processorstate$q-scaddress 91,4020 +(defconstant processorstate$q-restartsp 92,4066 +(defconstant processorstate$q-stop-interpreter 93,4112 +(defconstant processorstate$q-immediate-arg 94,4165 +(defconstant processorstate$q-continuationcp 95,4215 +(defconstant processorstate$q-continuation 96,4266 +(defconstant processorstate$q-control 97,4315 +(defconstant processorstate$q-niladdress 98,4359 +(defconstant processorstate$q-taddress 99,4406 +(defconstant processorstate$q-bar0 100,4451 +(defconstant processorstate$q-bar1 101,4492 +(defconstant processorstate$q-bar2 102,4533 +(defconstant processorstate$q-bar3 103,4574 +(defconstant processorstate$q-epc 104,4615 +(defconstant processorstate$q-fp 105,4655 +(defconstant processorstate$q-lp 106,4694 +(defconstant processorstate$q-sp 107,4733 +(defconstant processorstate$p-cp 108,4772 +(defconstant processorstate$q-fccrmask 109,4811 +(defconstant processorstate$l-cslimit 110,4856 +(defconstant processorstate$l-csextralimit 111,4900 +(defconstant processorstate$p-trapmeterdata 112,4949 +(defconstant processorstate$q-fepmodetrapvecaddress 113,4999 +(defconstant processorstate$q-trapvecbase 114,5057 +(defconstant processorstate$q-tvi 115,5105 +(defconstant processorstate$q-fccrtrapmask 116,5145 +(defconstant processorstate$p-ptrtype 117,5194 +(defconstant processorstate$p-vmattributetable 118,5238 +(defconstant processorstate$q-vma 119,5291 +(defconstant processorstate$q-mostnegativefixnum 120,5331 +(defconstant processorstate$p-icachebase 121,5386 +(defconstant processorstate$p-endicache 122,5433 +(defconstant processorstate$q-fullworddispatch 123,5479 +(defconstant processorstate$q-halfworddispatch 124,5532 +(defconstant processorstate$q-areventcount 125,5585 +(defconstant processorstate$q-stackcachesize 126,5634 +(defconstant processorstate$q-stackcachetopvma 127,5685 +(defconstant processorstate$q-cdrcodemask 128,5738 +(defconstant processorstate$p-stackcachedata 129,5786 +(defconstant processorstate$q-stackcachebasevma 130,5837 +(defconstant processorstate$l-scovlimit 131,5891 +(defconstant processorstate$l-scovdumpcount 132,5937 +(defconstant processorstate$q-mostpositivefixnum 133,5987 +(defconstant processorstate$q-internalregisterread1 134,6042 +(defconstant processorstate$q-internalregisterread2 135,6100 +(defconstant processorstate$q-internalregisterwrite1 136,6158 +(defconstant processorstate$q-internalregisterwrite2 137,6217 +(defconstant processorstate$q-dataread-mask 138,6276 +(defconstant processorstate$p-dataread 139,6326 +(defconstant processorstate$q-datawrite-mask 140,6371 +(defconstant processorstate$p-datawrite 141,6422 +(defconstant processorstate$q-bindread-mask 142,6468 +(defconstant processorstate$p-bindread 143,6518 +(defconstant processorstate$q-bindwrite-mask 144,6563 +(defconstant processorstate$p-bindwrite 145,6614 +(defconstant processorstate$q-bindreadnomonitor-mask 146,6660 +(defconstant processorstate$p-bindreadnomonitor 147,6719 +(defconstant processorstate$q-bindwritenomonitor-mask 148,6773 +(defconstant processorstate$p-bindwritenomonitor 149,6833 +(defconstant processorstate$q-header-mask 150,6888 +(defconstant processorstate$p-header 151,6936 +(defconstant processorstate$q-structureoffset-mask 152,6979 +(defconstant processorstate$p-structureoffset 153,7036 +(defconstant processorstate$q-scavenge-mask 154,7088 +(defconstant processorstate$p-scavenge 155,7138 +(defconstant processorstate$q-cdr-mask 156,7183 +(defconstant processorstate$p-cdr 157,7228 +(defconstant processorstate$q-gccopy-mask 158,7268 +(defconstant processorstate$p-gccopy 159,7316 +(defconstant processorstate$q-raw-mask 160,7359 +(defconstant processorstate$p-raw 161,7404 +(defconstant processorstate$q-rawtranslate-mask 162,7444 +(defconstant processorstate$p-rawtranslate 163,7498 +(defconstant processorstate$l-please-stop 164,7547 +(defconstant processorstate$l-please-trap 165,7595 +(defconstant processorstate$q-runningp 166,7643 +(defconstant processorstate$q-ac0array 167,7688 +(defconstant processorstate$q-ac0arword 168,7733 +(defconstant processorstate$q-ac0locat 169,7779 +(defconstant processorstate$q-ac0length 170,7824 +(defconstant processorstate$q-ac1array 171,7870 +(defconstant processorstate$q-ac1arword 172,7915 +(defconstant processorstate$q-ac1locat 173,7961 +(defconstant processorstate$q-ac1length 174,8006 +(defconstant processorstate$q-ac2array 175,8052 +(defconstant processorstate$q-ac2arword 176,8097 +(defconstant processorstate$q-ac2locat 177,8143 +(defconstant processorstate$q-ac2length 178,8188 +(defconstant processorstate$q-ac3array 179,8234 +(defconstant processorstate$q-ac3arword 180,8279 +(defconstant processorstate$q-ac3locat 181,8325 +(defconstant processorstate$q-ac3length 182,8370 +(defconstant processorstate$q-ac4array 183,8416 +(defconstant processorstate$q-ac4arword 184,8461 +(defconstant processorstate$q-ac4locat 185,8507 +(defconstant processorstate$q-ac4length 186,8552 +(defconstant processorstate$q-ac5array 187,8598 +(defconstant processorstate$q-ac5arword 188,8643 +(defconstant processorstate$q-ac5locat 189,8689 +(defconstant processorstate$q-ac5length 190,8734 +(defconstant processorstate$q-ac6array 191,8780 +(defconstant processorstate$q-ac6arword 192,8824 +(defconstant processorstate$q-ac6locat 193,8869 +(defconstant processorstate$q-ac6length 194,8913 +(defconstant processorstate$q-ac7array 195,8958 +(defconstant processorstate$q-ac7arword 196,9002 +(defconstant processorstate$q-ac7locat 197,9047 +(defconstant processorstate$q-ac7length 198,9091 +(defconstant processorstate$l-tmcurrenttransaction 199,9136 +(defconstant processorstate$l-tmwritestart 200,9192 +(defconstant processorstate$l-tmwritecurrent 201,9240 +(defconstant processorstate$l-tmwritelimit 202,9290 +(defconstant processorstate$l-tmrecordingreads 203,9338 +(defconstant processorstate$l-tmreadstart 204,9390 +(defconstant processorstate$l-tmreadcurrent 205,9437 +(defconstant processorstate$l-tmreadlimit 206,9485 +(defconstant processorstate$k-size 208,9532 +(defconstant |PROCESSORSTATESIZE| 209,9573 +(defconstant cacheline$q-annotation 213,9639 +(defconstant cacheline$l-nextpcdata 214,9678 +(defconstant cacheline$l-nextpctag 215,9717 +(defconstant cacheline$p-nextcp 216,9756 +(defconstant cacheline$l-instruction 217,9792 +(defconstant cacheline$l-operand 218,9833 +(defconstant cacheline$l-pcdata 219,9870 +(defconstant cacheline$l-pctag 220,9906 +(defconstant cacheline$p-code 221,9941 +(defconstant cacheline$k-size 223,9976 +(defconstant |CACHELINESIZE| 224,10010 +(defparameter |cacheline|$k-|bits| 226,10044 +(defparameter |CacheLineBits| 227,10083 +(defparameter |cacheline|$k-|mask| 229,10118 +(defparameter |CacheLineMask| 230,10161 +(defparameter |cacheline|$k-|rshift| 232,10200 +(defparameter |CacheLineRShift| 233,10241 +(defparameter |cacheline|$k-|lshift| 235,10278 +(defparameter |CacheLineLShift| 236,10318 +(defparameter |cacheline|$k-|fillamount| 238,10354 +(defparameter |CacheLineFillAmount| 239,10399 +(defconstant arraycache$q-array 243,10466 +(defconstant arraycache$q-arword 244,10501 +(defconstant arraycache$q-locat 245,10537 +(defconstant arraycache$q-length 246,10573 +(defparameter |autoarrayreg|$k-|mask| 248,10611 +(defparameter |AutoArrayRegMask| 249,10654 +(defparameter |autoarrayreg|$k-|size| 251,10693 +(defparameter |AutoArrayRegSize| 252,10735 +(defparameter |autoarrayreg|$k-|shift| 254,10773 +(defparameter |AutoArrayRegShift| 255,10815 +(defparameter |msclock|$k-|unitstomsshift| 257,10853 +(defparameter |MSclockUnitsToMSShift| 258,10900 +(defparameter |msclock|$k-|unitspermicrosecond| 260,10943 +(defparameter |MSclockUnitsPerMicrosecond| 261,11001 +(defparameter |stack|$k-|cachesize| 263,11055 +(defparameter |StackCacheSize| 264,11097 +(defparameter |stack|$k-|maxframesize| 266,11135 +(defparameter |StackMaxFrameSize| 267,11179 +(defparameter |stack|$k-|cachemargin| 269,11219 +(defparameter |StackCacheMargin| 270,11262 +(defparameter |stack|$k-|cachedumpquantum| 272,11301 +(defparameter |StackCacheDumpQuantum| 273,11349 +(defconstant |ivorymemory|$k-|data| 275,11393 +(defconstant |IvoryMemoryData| 276,11433 +(defconstant |ivorymemory|$k-|tag| 278,11469 +(defconstant |IvoryMemoryTag| 279,11508 +(defconstant savedregisters$q-r9 283,11573 +(defconstant savedregisters$q-r10 284,11609 +(defconstant savedregisters$q-r11 285,11646 +(defconstant savedregisters$q-r12 286,11684 +(defconstant savedregisters$q-r13 287,11722 +(defconstant savedregisters$q-r14 288,11760 +(defconstant savedregisters$q-r15 289,11798 +(defconstant savedregisters$q-r29 290,11836 +(defconstant savedregisters$q-f2 291,11874 +(defconstant savedregisters$q-f3 292,11911 +(defconstant savedregisters$q-f4 293,11948 +(defconstant savedregisters$q-f5 294,11985 +(defconstant savedregisters$q-f6 295,12022 +(defconstant savedregisters$q-f7 296,12059 +(defconstant savedregisters$q-f8 297,12097 +(defconstant savedregisters$q-f9 298,12135 +(defconstant savedregisters$k-size 300,12174 +(defconstant |SAVEDREGISTERSSIZE| 301,12214 +(defconstant tracedata$q-n_entries 305,12279 +(defconstant tracedata$l-recording_p 306,12317 +(defconstant tracedata$l-wrap_p 307,12357 +(defconstant tracedata$q-start_pc 308,12393 +(defconstant tracedata$q-stop_pc 309,12431 +(defconstant tracedata$p-records_start 310,12468 +(defconstant tracedata$p-records_end 311,12511 +(defconstant tracedata$p-current_entry 312,12552 +(defconstant tracedata$p-printer 313,12595 +(defconstant tracedata$k-size 315,12633 +(defconstant |TRACEDATASIZE| 316,12667 +(defconstant tracerecord$q-counter 320,12728 +(defconstant tracerecord$q-epc 321,12766 +(defconstant tracerecord$q-tos 322,12800 +(defconstant tracerecord$q-sp 323,12835 +(defconstant tracerecord$p-instruction 324,12869 +(defconstant tracerecord$q-instruction_data 325,12912 +(defconstant tracerecord$l-operand 326,12960 +(defconstant tracerecord$l-trap_p 327,12999 +(defconstant tracerecord$q-trap_data_0 328,13037 +(defconstant tracerecord$q-trap_data_1 329,13080 +(defconstant tracerecord$q-trap_data_2 330,13123 +(defconstant tracerecord$q-trap_data_3 331,13166 +(defconstant tracerecord$l-catch_block_p 332,13209 +(defconstant tracerecord$l-int-pad0 333,13254 +(defconstant tracerecord$q-catch_block_0 334,13294 +(defconstant tracerecord$q-catch_block_1 335,13339 +(defconstant tracerecord$q-catch_block_2 336,13385 +(defconstant tracerecord$q-catch_block_3 337,13431 +(defconstant tracerecord$k-size 339,13478 +(defconstant |TRACERECORDSIZE| 340,13515 +(defparameter |cachemeter|$k-|pwr| 342,13552 +(defparameter |CacheMeterPwr| 343,13591 +(defparameter |cachemeter|$k-|defaultfreq| 345,13626 +(defparameter |CacheMeterDefaultFreq| 346,13675 + +alpha-emulator/alphamac.lisp,1458 +(defmacro load-aligned-zero-extended-word 48,1927 +(defmacro load-aligned-sign-extended-word 54,2157 +(defmacro load-aligned-zero-extended-byte 61,2423 +(defmacro load-aligned-sign-extended-byte 67,2653 +(defmacro store-aligned-word 74,2919 +(defmacro store-aligned-byte 83,3244 +(defmacro sign-extendq 92,3569 +(defmacro nop 100,3858 +(defmacro fnop 103,3944 +(defmacro mov 106,4032 +(defmacro fmov 109,4097 +(defmacro clr 112,4164 +(defmacro fclr 115,4255 +(defmacro negl 118,4348 +(defmacro negq 121,4450 +(defmacro negf 124,4552 +(defmacro negg 127,4654 +(defmacro negs 130,4756 +(defmacro negt 133,4858 +(defmacro fnegf 136,4960 +(defmacro fnegg 139,5066 +(defmacro fnegs 142,5172 +(defmacro fnegt 145,5278 +(defmacro ldgp 150,5433 +(defmacro divl 154,5555 +(defmacro divq 161,5841 +(defmacro divlu 168,6127 +(defmacro divqu 175,6415 +(defmacro reml 182,6703 +(defmacro remlu 189,6989 +(defmacro remq 196,7277 +(defmacro remqu 203,7563 +(defmacro external 210,7851 +(defmacro include-header 213,7928 +(defmacro define-procedure 216,8013 +(zwei:defindentation (define-procedure 224,8265 +(defun indent-define-procedure 227,8342 +(defvar *subroutine-linkage* 242,8920 +(defmacro define-subroutine 254,9657 +(defmacro BSR 276,10489 +(defmacro define-fast-subroutine 283,10830 +(defmacro defineframe 305,11628 +(defmacro saveregisters 312,11844 +(defmacro restoreregisters 328,12477 +(defmacro with-c-registers 349,13337 +(defmacro load-constant 369,14257 + +alpha-emulator/fcallmac.lisp,897 +(defmacro set-continuation2 5,135 +(defmacro set-continuation2r 9,334 +(defmacro get-continuation2 13,534 +(defmacro set-continuation 18,760 +(defmacro get-continuation 21,894 +(defmacro get-control-register 24,1028 +(defmacro set-control-register 27,1161 +(defmacro push-frame 34,1416 +(defmacro start-call-dispatch 57,2599 +(defmacro start-call-compiled 157,7128 +(defmacro start-call-lexical-closure167,7605 +(defmacro start-call-escape 180,8283 +(defmacro finish-call-guts 198,9167 +(defmacro b-apply-argument-supplied 254,12084 +(defmacro enter-function 283,13296 +(defmacro push-apply-args 295,13875 +(defmacro note-additional-spread-args 323,14877 +(defmacro pull-apply-args 337,15374 +(defmacro pull-apply-args-quickly 372,16895 +(defmacro pull-apply-args-slowly 455,19800 +(defmacro cleanup-frame 476,20895 +(defmacro do-unwind-protect 547,23819 +(defmacro abandon-frame-simple615,26946 + +alpha-emulator/imacarra.lisp,941 +(defmacro check-array-header 8,234 +(defmacro check-array-prefix 14,403 +(defmacro check-array-header-and-prefix 20,610 +(defmacro check-array-bounds 28,895 +(defmacro byte-packing-size 33,1063 +(defmacro byte-packing-mask 38,1211 +(defmacro byte-packing-mask-and-unmask-given-size 45,1439 +(defmacro byte-packing-modulus 52,1681 +(defmacro byte-packing-rotation 58,1859 +(defmacro byte-packing-modulus-and-rotation 65,2055 +(defmacro simple-case 75,2437 +(defmacro generate-array-element-ldb 185,6270 +(defmacro array-element-ldb 214,7405 +(defmacro array-element-ldb 228,8012 +(defmacro array-element-dpb 246,8814 +(defmacro array-element-dpb 282,10568 +(defmacro new-aref-1-internal 302,11410 +(defmacro aref-1-internal 390,14584 +(defmacro aset-1-internal 439,16658 +(defmacro recompute-array-register 508,19529 +(defmacro logical-shift 575,23131 +(defmacro setup-array-register 581,23403 +(defmacro setup-long-array-register 628,25474 + +alpha-emulator/imacbind.lisp,24 +(defmacro unbind 9,284 + +alpha-emulator/imacbits.lisp,64 +(defmacro ilogical 7,216 +(defmacro ilogical-immediate 28,1048 + +alpha-emulator/imacblok.lisp,187 +(defmacro i%block-n-read 23,877 +(defmacro i%block-n-write 57,2307 +(defmacro i%block-n-read-shift 68,2934 +(defmacro i%block-n-read-alu 103,4589 +(defmacro i%block-n-read-test 148,6558 + +alpha-emulator/imacfext.lisp,27 +(defmacro ldb-shift 7,147 + +alpha-emulator/imacgene.lisp,237 +(defmacro verify-generic-arity 6,175 +(defmacro instance-descriptor-info 18,629 +(defmacro non-instance-descriptor-info 54,2292 +(defmacro lookup-handler 70,3049 +(defmacro generic-dispatch 104,4224 +(defmacro message-dispatch 128,5374 + +alpha-emulator/imacialu.lisp,855 +(defmacro read-alu-condition 8,221 +(defmacro read-alu-condition-sense 13,361 +(defmacro read-alu-output-condition 18,510 +(defmacro read-alu-enable-condition-exception 23,661 +(defmacro read-alu-enable-load-con 28,822 +(defmacro read-alu-boolean-function 33,971 +(defmacro read-alu-byte-rotate 38,1128 +(defmacro read-alu-byte-size 42,1251 +(defmacro read-alu-byte-background 47,1390 +(defmacro read-alu-byte-rotate-latch 52,1539 +(defmacro read-alu-byte-function 57,1691 +(defmacro read-alu-adder-carry-in 62,1808 +(defmacro write-alu-adder-carry-in 67,1955 +(defmacro read-alu-adder-op2 75,2177 +(defmacro read-alu-function-class-bits 80,2308 +(defmacro alu-function-boolean 85,2465 +(defmacro alu-function-byte 124,3380 +(defmacro alu-function-adder 159,4654 +(defmacro alu-function-multiply-divide 194,5920 +(defmacro alu-compute-condition 197,6022 + +alpha-emulator/imacinst.lisp,157 +(defmacro locate-instance-variable-mapped 13,430 +(defmacro locate-instance-variable-unmapped 55,2334 +(defmacro locate-arbitrary-instance-variable 63,2677 + +alpha-emulator/imacjosh.lisp,553 +(defmacro get-structure-stack-pointer 7,212 +(defmacro set-structure-stack-pointer 10,300 +(defmacro get-structure-stack-pointer-data 13,388 +(defmacro set-structure-stack-pointer-data 17,503 +(defmacro get-structure-stack-pointer2 20,596 +(defmacro set-structure-stack-pointer2 25,778 +(defmacro get-trail-pointer 29,930 +(defmacro set-trail-pointer 32,1008 +(defmacro get-trail-pointer-data 35,1086 +(defmacro set-trail-pointer-data 39,1191 +(defmacro get-trail-pointer2 42,1274 +(defmacro set-trail-pointer2 47,1446 +(defmacro bind-location 60,1962 + +alpha-emulator/imaclexi.lisp,45 +(defmacro compute-lexical-var-address 8,248 + +alpha-emulator/imaclist.lisp,275 +(defmacro car-internal 8,265 +(defmacro cdr-internal 34,1051 +(defmacro carcdr-internal 74,2354 +(defmacro icar 133,4491 +(defmacro icdr 142,4913 +(defmacro isettocar 151,5335 +(defmacro isettocdr 163,5921 +(defmacro isettocdrpushcar 175,6497 +(defmacro carcdrloop 204,7807 + +alpha-emulator/imacloop.lisp,117 +(defmacro ibranchcond 8,249 +(defmacro iloop-decrement-tos 43,1826 +(defmacro iloop-increment-tos-less-than 80,3090 + +alpha-emulator/imacmath.lisp,961 +(defmacro CheckDivisionOverflow 9,265 +(defmacro floating-exception-checking-prelude 17,610 +(defmacro floating-exception-checking-postlude 24,904 +(defmacro with-floating-exception-checking 32,1230 +(defmacro CheckFloatingOverflow 38,1461 +(defmacro CheckBinaryFloatingOverflow 44,1648 +(defmacro CheckNotNan 55,1950 +(defmacro DoDivisionRounding 62,2135 +(defmacro DoFloatingDivisionRounding 87,3125 +(defmacro cons-double-float-internal 127,4802 +(defmacro fetch-double-float-internal 142,5487 +(defmacro with-simple-binary-fixnum-operation 167,6857 +(defmacro simple-binary-arithmetic-operation 209,8561 +(defmacro simple-binary-immediate-arithmetic-operation 334,13534 +(defmacro binary-arithmetic-division-prelude 372,15104 +(defmacro binary-arithmetic-two-value-division-operation 462,18265 +(defmacro binary-arithmetic-one-value-division-operation 526,21453 +(defmacro simple-binary-minmax 581,23857 +(defmacro simple-binary-immediate-minmax 639,25910 + +alpha-emulator/imacpred.lisp,258 +(defmacro simple-unary-arithmetic-predicate 10,341 +(defmacro simple-binary-arithmetic-predicate 39,1293 +(defmacro simple-binary-arithmetic-exceptions 97,3386 +(defmacro simple-binary-immediate-arithmetic-predicate 119,4212 +(defmacro itypemember 144,5045 + +alpha-emulator/imacsubp.lisp,273 +(defmacro %allocate-internal 8,226 +(defmacro cons-internal 48,1823 +(defmacro i%allocate-block 63,2521 +(defmacro i%set-cdr-code-n 105,4118 +(defmacro refill-oldspace-table 113,4444 +(defmacro check-preempt-request 145,5290 +(defmacro internal-register-dispatch 159,5859 + +alpha-emulator/imactrap.lisp,6160 +(defmacro prepare-trap 7,183 +(defmacro get-trap-vector-entry 22,885 +(defmacro take-post-trap 51,2022 +(defmacro stack-overflow-handler 143,5906 +(defmacro take-pre-trap-1 156,6326 +(defmacro start-pre-trap 163,6696 +(defmacro take-pre-trap-2 189,7835 +(defmacro finish-pre-trap 193,8047 +(defmacro illegal-operand-handler 236,10022 +(defmacro reset-trap-handler 245,10422 +(defmacro pull-apply-args-trap-handler 252,10707 +(defmacro trace-trap-handler 263,11231 +(defmacro preempt-request-trap-handler 269,11511 +(defmacro high-priority-sequence-break-handler 276,11833 +(defmacro low-priority-sequence-break-handler 283,12196 +(defmacro db-unwind-frame-trap-handler 290,12555 +(defmacro db-unwind-catch-trap-handler 299,12974 +(defmacro take-memory-trap 312,13459 +(defmacro transport-trap-handler 318,13738 +(defmacro monitor-trap-handler 324,13933 +(defmacro page-not-resident-handler 330,14122 +(defmacro page-fault-request-handler 336,14332 +(defmacro page-write-fault-handler 342,14545 +(defmacro uncorrectable-memory-error-handler 348,14752 +(defmacro bus-error-handler 354,14989 +(defmacro db-cache-miss-trap-handler 360,15189 +(defvar *instruction-exception-info* 390,16607 +(defvar *ivory-instruction-opcode-table* 391,16683 +(defmacro define-instruction-exception 709,37659 +(defun define-instruction-exception-1 712,37816 +(defun instruction-exception-info 721,38160 +(define-instruction-exception car 731,38502 +(define-instruction-exception cdr 732,38554 +(define-instruction-exception set-to-car 733,38606 +(define-instruction-exception set-to-cdr 734,38670 +(define-instruction-exception set-to-cdr-push-car 735,38734 +(define-instruction-exception rplaca 736,38814 +(define-instruction-exception rplacd 737,38872 +(define-instruction-exception rgetf 738,38930 +(define-instruction-exception member 739,38986 +(define-instruction-exception assoc 740,39044 +(define-instruction-exception eql 741,39100 +(define-instruction-exception eql-no-pop 742,39164 +(define-instruction-exception equal-number 743,39240 +(define-instruction-exception equal-number-no-pop 744,39321 +(define-instruction-exception greaterp 745,39414 +(define-instruction-exception greaterp-no-pop 746,39489 +(define-instruction-exception lessp 747,39575 +(define-instruction-exception lessp-no-pop 748,39643 +(define-instruction-exception plusp 749,39723 +(define-instruction-exception minusp 750,39791 +(define-instruction-exception zerop 751,39861 +(define-instruction-exception logtest 752,39929 +(define-instruction-exception logtest-no-pop 753,40001 +(define-instruction-exception add 754,40085 +(define-instruction-exception sub 755,40149 +(define-instruction-exception unary-minus 756,40213 +(define-instruction-exception increment 757,40292 +(define-instruction-exception decrement 758,40356 +(define-instruction-exception multiply 759,40420 +(define-instruction-exception quotient 760,40494 +(define-instruction-exception ceiling 761,40568 +(define-instruction-exception floor 762,40640 +(define-instruction-exception truncate 763,40708 +(define-instruction-exception round 764,40782 +(define-instruction-exception rational-quotient 766,40906 +(define-instruction-exception double-float-op 767,40997 +(define-instruction-exception max 768,41083 +(define-instruction-exception min 769,41147 +(define-instruction-exception logand 770,41211 +(define-instruction-exception logior 771,41281 +(define-instruction-exception logxor 772,41351 +(define-instruction-exception ash 773,41421 +(define-instruction-exception ldb 774,41485 +(define-instruction-exception dpb 775,41544 +(define-instruction-exception aref-1 776,41603 +(define-instruction-exception aset-1 777,41660 +(define-instruction-exception aloc-1 778,41717 +(define-instruction-exception setup-1d-array 779,41774 +(define-instruction-exception setup-force-1d-array 780,41846 +(define-instruction-exception fast-aref-1 781,41929 +(define-instruction-exception fast-aset-1 782,41995 +(define-instruction-exception array-leader 783,42061 +(define-instruction-exception store-array-leader 784,42130 +(define-instruction-exception aloc-leader 785,42210 +(define-instruction-exception loop-decrement-tos 786,42277 +(define-instruction-exception loop-increment-tos-less-than 787,42364 +(define-instruction-exception block-0-read-alu 788,42469 +(define-instruction-exception block-1-read-alu 789,42544 +(define-instruction-exception block-2-read-alu 790,42619 +(define-instruction-exception block-3-read-alu 791,42694 +(define-instruction-exception allocate-list-block 792,42769 +(define-instruction-exception allocate-structure-block 793,42851 +(define-instruction-exception unify 794,42943 +(define-instruction-exception logic-tail-test 795,42999 +(define-instruction-exception push-address-sp-relative 796,43073 +(define-instruction-exception stack-blt 797,43164 +(define-instruction-exception stack-blt-address 798,43227 +(define-instruction-exception char-ldb 799,43305 +(define-instruction-exception char-dpb 800,43373 +(define-instruction-exception bind-locative-to-value 801,43441 +(define-instruction-exception bind-locative 802,43528 +(define-instruction-exception restore-binding-stack 803,43599 +(define-instruction-exception push-lexical-var 804,43685 +(define-instruction-exception pop-lexical-var 805,43761 +(define-instruction-exception movem-lexical-var 806,43835 +(define-instruction-exception instance-ref 807,43913 +(define-instruction-exception instance-set 808,43982 +(define-instruction-exception instance-loc 809,44051 +(define-instruction-exception push-instance-variable 810,44120 +(define-instruction-exception pop-instance-variable 811,44208 +(define-instruction-exception movem-instance-variable 812,44294 +(define-instruction-exception push-address-instance-variable 813,44384 +(define-instruction-exception block-0-read-test 814,44487 +(define-instruction-exception block-1-read-test 815,44571 +(define-instruction-exception block-2-read-test 816,44655 +(define-instruction-exception block-3-read-test 817,44739 +(define-instruction-exception alu 818,44823 +(defmacro prepare-exception830,45432 +(defmacro exception-handler 863,46730 +(defmacro exception-handler-common-tail 959,50643 + +alpha-emulator/intrpmac.lisp,5603 +(defmacro check-temporaries 5,135 +(defvar *memoized-vmdata* 8,250 +(defvar *memoized-vmtags* 9,281 +(defvar *memoized-base* 10,312 +(defvar *memoized-limit* 11,342 +(defvar *memoized-action* 12,372 +(defvar *memoized-action-cycle* 13,403 +(defvar *cant-be-in-cache-p* 14,440 +(defvar *inhibit-alignment-in-memory-read* 17,512 +(defun check-temporaries-1 20,592 +(defmacro branch-true 43,1572 +(defmacro branch-false 46,1672 +(defmacro force-alignment 49,1773 +(defmacro PC-TO-iCACHEENT 58,2087 +(defmacro PC-TO-iCACHEENT 75,2899 +(defmacro convert-pc-to-continuation 93,3821 +(defmacro convert-continuation-to-pc 101,4136 +(defmacro SCAtoVMA 113,4572 +(defmacro VMAtoSCA 126,5049 +(defmacro VMAinStackCache 139,5466 +(defmacro VMAtoSCAmaybe 153,6209 +(defmacro TagTypeFromLispObj 174,7291 +(defmacro TagCdrFromLispObj 179,7461 +(defmacro PackedInstructionP 183,7646 +(defmacro TagType 194,8197 +(defmacro TagCdr 198,8321 +(defmacro SetTag 202,8443 +(defmacro CheckDataType 208,8674 +(defmacro CheckAdjacentDataTypes 214,8851 +(defmacro NumericTypeException 222,9221 +(defmacro UnaryNumericTypeException 226,9373 +(defmacro SpareTypeException 230,9535 +(defmacro ListTypeException 235,9719 +(defmacro ArrayTypeException 242,10031 +(defmacro maybe-icount 247,10215 +(defmacro maybe-statistics 257,10621 +(defmacro maybe-meter-hit 268,11169 +(defmacro maybe-meter-miss 292,12358 +(defun show-icache-histogram 319,13659 +(defmacro maybe-meter-trap 357,15163 +(defmacro maybe-trace 365,15512 +(defmacro ContinueToInterpretInstruction 440,19762 +(defmacro ContinueToInterpretInstruction-ValidateCache 445,19998 +(defmacro ContinueToNextInstruction 454,20560 +(defmacro GetNextPC 458,20743 +(defmacro PrefetchNextPC 461,20810 +(defmacro SetNextPC 464,20888 +(defmacro GetNextCP 467,20943 +(defmacro PrefetchNextCP 470,21006 +(defmacro SetNextCP 473,21080 +(defmacro GetNextPCandCP 476,21135 +(defmacro ContinueToNextInstruction-NoStall 482,21394 +(defmacro instruction-exception 486,21580 +(defmacro arithmetic-exception 489,21694 +(defmacro illegal-operand 493,21874 +(defmacro illegal-instruction 497,22038 +(defmacro halt-machine 500,22159 +(defmacro with-predicate-store 514,22734 +(defmacro with-predicate-push 538,23761 +(defmacro align4k 564,24620 +(defmacro align4Kskip8K 570,24851 +(defmacro align4kskip4k 577,25063 +(defmacro define-instruction 582,25184 +(clos:defgeneric expand-instruction-procedure-header 591,25649 +(clos:defgeneric expand-instruction-procedure-trailer 592,25740 +(clos:defmethod expand-instruction-procedure-header597,26020 +(clos:defmethod expand-instruction-procedure-trailer606,26375 +(clos:defmethod expand-instruction-procedure-header619,27025 +(clos:defmethod expand-instruction-procedure-trailer698,30410 +(clos:defmethod expand-instruction-procedure-header714,31145 +(clos:defmethod expand-instruction-procedure-trailer779,33995 +(defmacro immediate-handler 785,34214 +(clos:defmethod expand-instruction-procedure-header796,34602 +(clos:defmethod expand-instruction-procedure-trailer864,37603 +(clos:defmethod expand-instruction-procedure-header870,37829 +(clos:defmethod expand-instruction-procedure-trailer897,38972 +(clos:defmethod expand-instruction-procedure-header902,39179 +(clos:defmethod expand-instruction-procedure-trailer929,40335 +(clos:defmethod expand-instruction-procedure-header938,40757 +(clos:defmethod expand-instruction-procedure-trailer964,41978 +(clos:defmethod expand-instruction-procedure-header980,42778 +(clos:defmethod expand-instruction-procedure-trailer1007,44064 +(defmacro UnimplementedInstruction 1014,44274 +(defun last-instruction-is-branch-p 1027,44842 +(defmacro basic-dispatch 1039,45288 +(defmacro mondo-dispatch 1160,49324 +(defmacro cdr-code-dispatch 1207,50674 +(defmacro register-dispatch 1216,51035 +(defmacro type-dispatch 1220,51175 +(defmacro binary-type-dispatch 1226,51368 +(defmacro cache-ivory-state 1288,53765 +(defmacro decache-ivory-state 1295,54000 +(define-integer-register t1 1304,54294 +(define-integer-register t2 1305,54325 +(define-integer-register t3 1306,54356 +(define-integer-register t4 1307,54387 +(define-integer-register t5 1308,54418 +(define-integer-register t6 1309,54449 +(define-integer-register t7 1310,54480 +(define-integer-register t8 1311,54511 +(define-integer-register iPC 1312,54542 +(define-integer-register iFP 1313,54574 +(define-integer-register iLP 1314,54607 +(define-integer-register iSP 1315,54640 +(define-integer-register iCP 1316,54673 +(define-integer-register ivory 1317,54706 +(define-integer-register arg1 1318,54768 +(define-integer-register arg2 1319,54802 +(define-integer-register arg3 1320,54836 +(define-integer-register arg4 1321,54870 +(define-integer-register arg5 1322,54904 +(define-integer-register arg6 1323,54938 +(define-integer-register t9 1324,54972 +(define-integer-register t10 1325,55004 +(define-integer-register t11 1326,55037 +(define-integer-register t12 1327,55070 +(define-integer-register ra 1328,55103 +(define-integer-register pv 1329,55136 +(define-integer-register gp 1330,55169 +(define-integer-register sp 1331,55202 +(define-integer-register none 1333,55236 +(define-integer-register instn 1334,55270 +(define-integer-register iword 1335,55312 +(define-integer-register ecp 1336,55354 +(define-integer-register ocp 1337,55395 +(define-integer-register icsize 1338,55436 +(define-integer-register epc 1339,55502 +(define-integer-register opc 1340,55543 +(define-integer-register count 1341,55584 +(define-integer-register hwopmask 1342,55626 +(define-integer-register fwdispatch 1343,55702 +(define-integer-register hwdispatch 1344,55782 + +alpha-emulator/memoryem.lisp,1347 +(defconstant %memory-action-indirect 12,405 +(defconstant %memory-action-monitor-trap 13,445 +(defconstant %memory-action-transport 14,489 +(defconstant %memory-action-trap 15,530 +(defconstant %memory-action-transform 16,567 +(defconstant %memory-action-binding-trap 17,609 +(defsubst memory-action-index 20,735 +(defvar *memory-actions* 23,830 +(defparameter *memory-actions-table*25,908 +(defun initialize-memory-actions 54,2586 +(defsubst memory-action-entry 139,6283 +(defun memory-indirect-mask 142,6407 +(defun memory-action-mask 153,6757 +(defmacro decode-fault 165,7126 +(defmacro transport-trap 169,7264 +(defmacro miss-fault 172,7333 +(defmacro access-fault 175,7400 +(defmacro write-fault 178,7477 +(defmacro memory-action 181,7544 +(defmacro with-multiple-memory-reads 187,7731 +(defmacro using-multiple-memory-reads 209,8742 +(defmacro inhibit-alignment-in-memory-read 222,9294 +(defmacro VM-read 230,9630 +(defmacro VM-write 247,10264 +(defmacro check-access 269,11122 +(defvar *memory-subroutines* 409,15839 +(defmacro define-memory-subroutine412,15961 +(defmacro find-memory-subroutine430,16756 +(defun find-memory-subr-internal 439,17136 +(defun memory-read-internal 476,18727 +(defmacro memory-read 737,29219 +(defmacro memory-write 742,29557 +(defmacro store-contents 806,32471 +(defmacro store-conditional-internal 822,33211 + +alpha-emulator/stacklis.lisp,2375 +(defun process-stack-options 12,536 +(defmacro with-stack-options 20,811 +(defmacro stack-read-disp 31,1255 +(defmacro stack-read 38,1593 +(defmacro stack-read-data-disp 41,1685 +(defmacro stack-read-data 60,2416 +(defmacro stack-read-tag-disp 63,2518 +(defmacro stack-read-tag 74,2962 +(defmacro stack-read2-disp 77,3062 +(defmacro stack-read2-disp-signed 106,4081 +(defmacro stack-read2 111,4320 +(defmacro stack-read2-signed 118,4633 +(defmacro stack-top 125,4866 +(defmacro stack-top2 128,4945 +(defmacro stack-pop 131,5035 +(defmacro stack-pop-discard 135,5145 +(defmacro stack-pop-data 139,5275 +(defmacro stack-pop-tag 162,6048 +(defmacro stack-pop2 166,6171 +(defmacro stack-write-ir 201,7334 +(defmacro fp-stack-write-ir 205,7468 +(defmacro stack-write2 210,7732 +(defmacro stack-write2-disp 214,7875 +(defmacro stack-write-tag 227,8596 +(defmacro stack-write-data 230,8696 +(defmacro stack-write-tag-disp 233,8800 +(defmacro stack-write-data-disp 240,9147 +(defmacro combine-tag-data-word 245,9381 +(defmacro stack-write2c 254,9791 +(defmacro stack-write 261,10088 +(defmacro stack-write-disp 264,10185 +(defmacro stack-push2c 270,10446 +(defmacro stack-push2 277,10741 +(defmacro stack-push 282,10956 +(defmacro stack-push2c-with-cdr 295,11415 +(defmacro stack-push2-with-cdr 300,11614 +(defmacro stack-push-tag 304,11798 +(defmacro stack-push-tag-with-cdr 309,12008 +(defmacro stack-push-data 313,12187 +(defmacro stack-push-with-cdr 317,12308 +(defmacro stack-push-ir 322,12543 +(defmacro fp-stack-push-ir 327,12716 +(defmacro stack-push-ir-reverse 332,12968 +(defmacro stack-push-fixnumb 337,13239 +(defmacro stack-push-fixnum 346,13568 +(defmacro stack-push-nil 351,13747 +(defmacro stack-write-nil 357,13972 +(defmacro stack-push-t 362,14196 +(defmacro stack-write-t 368,14417 +(defmacro stack-write-nil-and-push-nil 373,14634 +(defmacro stack-set-cdr-code 380,14903 +(defmacro get-nil 387,15118 +(defmacro get-nil2 390,15245 +(defmacro get-t 395,15456 +(defmacro get-t2 398,15579 +(defmacro stack-overflow-p 406,15910 +(defmacro stack-overflow-check 420,16612 +(defmacro stack-fill 426,16856 +(defmacro stack-cache-underflow-check 442,17451 +(defmacro stack-cache-underflow-body 459,18231 +(defmacro stack-dump 496,20055 +(defmacro stack-cache-overflow-check 539,21665 +(defmacro stack-cache-overflow-handler 572,23055 +(defmacro stack-block-copy 634,26440 + +assembler/alphadsdl.lisp,2805 +(defvar *dsdl-objects*)11,306 +(defvar *dsdl-object-table*)13,331 +(defmacro define-dsdl-dispatch 15,361 +(defun get-dsdl-dispatch 22,594 +(defun set-dsdl-dispatch 26,752 +(defsetf get-dsdl-dispatch 29,848 +(defun get-dsdl-data 32,896 +(defun set-dsdl-data 37,1077 +(defsetf get-dsdl-data 42,1326 +(defun dsdl-no-op 45,1366 +(defvar *dsdl-new-type-scheme*)50,1458 +(defmacro with-dsdl-object-context 52,1491 +(defun find-dsdl-object-named 58,1672 +(defun add-dsdl-object-entry 61,1748 +(defun add-dsdl-object 70,2064 +(defun note-dsdl-reference 73,2179 +(defun process-dsdl-file 81,2425 +(defun write-dsdl-data 91,2825 +(defun dsdl 101,3390 +(defstruct dsdl116,3926 +(defun get-existing-structure 126,4069 +(define-dsdl-dispatch (define-structure 134,4343 +(define-dsdl-dispatch (define-fields 307,10779 +(defun process-dsdl-field-definitions 312,10971 +(define-dsdl-dispatch (define-values 354,12449 +(define-dsdl-dispatch (define-lisp-structure 366,12977 +(define-dsdl-dispatch (define-lisp-funcallable-structure 374,13389 +(define-dsdl-dispatch (define-initial-symbols 383,13851 +(defun genera-upcase 433,15717 +(define-dsdl-dispatch (:c 437,15786 +(define-dsdl-dispatch (:c 448,16164 +(define-dsdl-dispatch (:c 458,16475 +(defun dsdl-c-upper-name-component 461,16599 +(defun write-c-variable-declarations 482,17318 +(defun write-c-function-declarations 494,17846 +(defun write-c-constant 508,18404 +(defun write-c-lisp-index 516,18662 +(defun write-c-field 522,18859 +(defun write-c-structure 534,19250 +(defun write-c-lispstruct 610,22264 +(defun write-c-lispfnstruct 621,22764 +(defun write-c-initial-symbols 632,23295 +(define-dsdl-dispatch (:c-setup 643,23638 +(define-dsdl-dispatch (:c-setup 651,23946 +(define-dsdl-dispatch (:c-setup 656,24132 +(defun write-c-lispfnstruct 659,24262 +(defun write-c-setup-initial-symbols 672,24901 +(define-dsdl-dispatch (:asm 712,26645 +(define-dsdl-dispatch (:asm 719,26950 +(define-dsdl-dispatch (:asm 724,27132 +(defun dsdl-asm-upper-name-component 727,27258 +(defconstant *asm-token-length-max* 738,27640 +(defvar *asm-token-conflicts* 740,27716 +(defvar *conflicting-token-alist* 742,27780 +(defun check-asm-token 748,28103 +(defun write-asm-constant 762,28750 +(defun write-asm-field 772,29072 +(defun write-asm-structure 787,29646 +(defun write-asm-lispstruct 823,31201 +(defun write-asm-lispfnstruct 835,31749 +(defun write-asm-initial-symbols 847,32311 +(define-dsdl-dispatch (:lisp 864,32858 +(define-dsdl-dispatch (:lisp 881,33363 +(define-dsdl-dispatch (:lisp 886,33546 +(defun write-lisp-constant 891,33789 +(defun write-lisp-parameter 897,34116 +(defun write-lisp-field 903,34448 +(defun write-lisp-structure 915,34836 +(defun write-lisp-lispstruct 961,36612 +(defun write-lisp-lispfnstruct 969,37047 +(defun write-lisp-initial-symbols 978,37512 + +assembler/alpha.lisp,5198 +(defvar *instruction-database* 8,238 +(defvar *register-database* 9,288 +(defun find-instruction 11,336 +(defun find-register 15,462 +(clos:defclass instruction 21,551 +(clos:defmethod clos:initialize-instance 24,637 +(clos:defmethod clos:print-object 28,817 +(clos:defclass pseudo-instruction 32,1010 +(clos:defclass alpha-instruction 36,1108 +(clos:defclass memory-format-instruction 40,1265 +(clos:defclass memory-format-extended-instruction 43,1335 +(clos:defclass memory-format-branch-instruction 47,1528 +(clos:defclass branch-format-instruction 51,1710 +(clos:defclass operate-format-instruction 54,1780 +(clos:defclass FP-operate-format-instruction 57,1924 +(clos:defclass IEEE-FP-instruction 61,2040 +(clos:defclass IEEE-FP2-instruction 65,2149 +(clos:defclass VAX-FP-instruction 69,2249 +(clos:defclass miscellaneous-instruction 74,2358 +(clos:defclass fetch-instruction 77,2428 +(clos:defclass PAL-instruction 80,2490 +(clos:defclass unprivileged-openVMS-PAL-instruction 83,2550 +(clos:defclass priviliged-openVMS-PAL-instruction 86,2629 +(clos:defclass unpriviliged-OSF1-PAL-instruction 89,2706 +(clos:defclass priviliged-OSF1-PAL-instruction 92,2782 +(clos:defclass required-PAL-instruction 95,2856 +(clos:defclass reserved-PAL-instructions 98,2944 +(clos:defclass reserved-digital-instructions 101,3012 +(defvar *instruction-class-names* 107,3110 +(defvar *instruction-classes*113,3394 +(defvar *instruction-box-alist*131,4147 +(clos:defclass register 411,18001 +(clos:defmethod clos:print-object 416,18188 +(clos:defclass alpha-register 421,18376 +(clos:defclass integer-alpha-register 423,18422 +(clos:defclass FP-alpha-register 425,18482 +(clos:defmethod clos:initialize-instance 427,18541 +(defun register-number 442,19324 +(defmacro define-integer-register 448,19557 +(defvar *instruction-counter*)483,20805 +(defvar *n-previous-instructions* 484,20836 +(defvar *previous-instructions*)485,20875 +(defvar *last-instruction*)486,20908 +(defvar *func-name* 487,20936 +(defvar *block-name* 488,20961 +(clos:defgeneric emit-operation 495,21274 +(clos:defmethod emit-operation 497,21347 +(clos:defmethod emit-operation 502,21583 +(clos:defmethod emit-operation 507,21762 +(clos:defmethod push-operation512,21942 +(clos:defmethod compute-cycle-count 524,22567 +(defun intersection-p 586,24967 +(defun dual-issue-p 593,25212 +(defparameter *for-vms* 612,26082 +(defun instruction-pname 613,26111 +(clos:defmethod emit-operation 618,26243 +(clos:defmethod emit-operation 638,27270 +(clos:defmethod emit-operation 656,28054 +(clos:defmethod emit-operation 679,29112 +(clos:defmethod emit-operation 698,29951 +(clos:defmethod emit-operation 717,30782 +(clos:defmethod emit-operation 736,31615 +(clos:defmethod emit-operation 754,32411 +(clos:defmethod emit-operation 771,33196 +(clos:defmethod emit-operation 787,33946 +(defparameter *label-alignment* 798,34417 +(defparameter *function-alignment* 803,34634 +(clos:defmethod emit-operation 805,34673 +(clos:defgeneric coerce-to-register 868,37379 +(clos:defmethod coerce-to-register 870,37428 +(clos:defmethod coerce-to-register 875,37641 +(clos:defmethod coerce-to-register 878,37734 +(defun coerce-to-register-or-literal 882,37844 +(clos:defgeneric coerce-to-displacement 890,37999 +(clos:defmethod coerce-to-displacement 892,38056 +(clos:defmethod coerce-to-displacement 894,38134 +(defun asm-header 897,38214 +(defun asm-trailer 907,38672 +(defvar *function-being-processed* 911,38815 +(defvar *function-epilogue*)912,38855 +(defun collecting-function-epilogue 914,38885 +(defun process-asm-source 923,39295 +(defun process-asm-form 948,40314 +(defun macroexpand-asm-form 960,40834 +(defcom com-alpha-assemble-region977,41251 +(clos:defclass alpha-instruction-block 1038,43598 +(clos:defmethod emit-alphabits 1041,43681 +(clos:defgeneric coerce-to-register-number 1045,43852 +(clos:defmethod coerce-to-register-number 1047,43908 +(clos:defmethod coerce-to-register-number 1052,44135 +(clos:defmethod coerce-to-register-number 1055,44242 +(defun register-operandp 1059,44353 +(defun coerce-to-register-number-or-literal 1061,44410 +(defconstant %%alpha-inst-opcode 1071,44645 +(defconstant %%alpha-inst-ra 1073,44711 +(defconstant %%alpha-inst-rb 1075,44776 +(defconstant %%alpha-inst-litp 1077,44842 +(defconstant %%alpha-inst-literal 1079,44906 +(defconstant %%alpha-inst-function 1081,44965 +(defconstant %%alpha-inst-rc 1082,45013 +(defconstant %%alpha-inst-memory-disp 1084,45065 +(defconstant %%alpha-inst-branch-disp 1086,45127 +(clos:defgeneric assemble-operation 1092,45380 +(clos:defmethod assemble-operation 1094,45457 +(clos:defmethod assemble-operation 1099,45701 +(clos:defmethod assemble-operation 1114,46328 +(clos:defmethod assemble-operation 1129,46971 +(clos:defmethod assemble-operation 1143,47548 +(clos:defmethod assemble-operation 1167,48547 +(clos:defmethod assemble-operation 1183,49253 +(clos:defmethod assemble-operation 1199,49947 +(defun NYI 1215,50642 +(clos:defmethod assemble-operation 1217,50708 +(clos:defmethod assemble-operation 1221,50863 +(clos:defmethod assemble-operation 1225,51010 +(clos:defmethod assemble-operation 1230,51164 +(defun assemble-asm-form 1257,52020 +(defun testemit 1271,52412 + +assembler/alphapckg.lisp,37 +(defpackage ALPHA-AXP-INTERNALS3,86 + +assembler/powerdsdl.lisp,2805 +(defvar *dsdl-objects*)11,300 +(defvar *dsdl-object-table*)13,325 +(defmacro define-dsdl-dispatch 15,355 +(defun get-dsdl-dispatch 22,588 +(defun set-dsdl-dispatch 26,751 +(defsetf get-dsdl-dispatch 29,847 +(defun get-dsdl-data 32,895 +(defun set-dsdl-data 37,1076 +(defsetf get-dsdl-data 42,1325 +(defun dsdl-no-op 45,1365 +(defvar *dsdl-new-type-scheme*)51,1477 +(defmacro with-dsdl-object-context 53,1510 +(defun find-dsdl-object-named 59,1691 +(defun add-dsdl-object-entry 62,1767 +(defun add-dsdl-object 71,2083 +(defun note-dsdl-reference 74,2198 +(defun process-dsdl-file 82,2444 +(defun write-dsdl-data 92,2844 +(defun dsdl 102,3409 +(defstruct dsdl117,3936 +(defun get-existing-structure 127,4079 +(define-dsdl-dispatch (define-structure 135,4353 +(define-dsdl-dispatch (define-fields 308,10809 +(defun process-dsdl-field-definitions 313,11001 +(define-dsdl-dispatch (define-values 355,12479 +(define-dsdl-dispatch (define-lisp-structure 367,13007 +(define-dsdl-dispatch (define-lisp-funcallable-structure 375,13419 +(define-dsdl-dispatch (define-initial-symbols 384,13881 +(defun genera-upcase 434,15749 +(define-dsdl-dispatch (:c 438,15818 +(define-dsdl-dispatch (:c 449,16197 +(define-dsdl-dispatch (:c 459,16508 +(defun dsdl-c-upper-name-component 462,16632 +(defun write-c-variable-declarations 483,17351 +(defun write-c-function-declarations 495,17879 +(defun write-c-constant 509,18437 +(defun write-c-lisp-index 517,18695 +(defun write-c-field 523,18892 +(defun write-c-structure 535,19283 +(defun write-c-lispstruct 611,22832 +(defun write-c-lispfnstruct 622,23332 +(defun write-c-initial-symbols 633,23863 +(define-dsdl-dispatch (:c-setup 645,24246 +(define-dsdl-dispatch (:c-setup 653,24554 +(define-dsdl-dispatch (:c-setup 658,24740 +(defun write-c-lispfnstruct 661,24870 +(defun write-c-setup-initial-symbols 674,25509 +(define-dsdl-dispatch (:asm 714,27260 +(define-dsdl-dispatch (:asm 721,27565 +(define-dsdl-dispatch (:asm 726,27747 +(defun dsdl-asm-upper-name-component 729,27873 +(defconstant *asm-token-length-max* 740,28255 +(defvar *asm-token-conflicts* 742,28331 +(defvar *conflicting-token-alist* 744,28395 +(defun check-asm-token 750,28718 +(defun write-asm-constant 764,29365 +(defun write-asm-field 774,29687 +(defun write-asm-structure 789,30261 +(defun write-asm-lispstruct 825,31819 +(defun write-asm-lispfnstruct 837,32367 +(defun write-asm-initial-symbols 849,32929 +(define-dsdl-dispatch (:lisp 867,33516 +(define-dsdl-dispatch (:lisp 884,34019 +(define-dsdl-dispatch (:lisp 889,34202 +(defun write-lisp-constant 894,34445 +(defun write-lisp-parameter 900,34772 +(defun write-lisp-field 906,35104 +(defun write-lisp-structure 918,35492 +(defun write-lisp-lispstruct 964,37273 +(defun write-lisp-lispfnstruct 972,37708 +(defun write-lisp-initial-symbols 981,38173 + +assembler/power.lisp,5325 +(defvar *instruction-database* 8,218 +(defvar *register-database* 9,268 +(defun find-instruction 11,316 +(defun find-register 15,447 +(clos:defclass instruction 21,536 +(clos:defmethod clos:initialize-instance 24,622 +(clos:defmethod clos:print-object 28,802 +(clos:defclass pseudo-instruction 32,995 +(clos:defclass power-instruction 36,1093 +(clos:defclass i-form-instruction 41,1258 +(clos:defclass b-form-instruction 44,1321 +(clos:defclass sc-form-instruction 47,1384 +(clos:defclass d-form-instruction 50,1448 +(clos:defclass ds-form-instruction 53,1511 +(clos:defclass x-form-instruction 56,1575 +(clos:defclass x1-form-instruction 59,1687 +(clos:defclass x2-form-instruction 62,1800 +(clos:defclass x2l-form-instruction 65,1913 +(clos:defclass cmp-form-instruction 68,2027 +(clos:defclass fcmp-form-instruction 71,2141 +(clos:defclass xo-form-instruction 74,2256 +(clos:defclass xo2-form-instruction 77,2369 +(clos:defclass xs-form-instruction 80,2483 +(clos:defclass xl-form-instruction 83,2596 +(clos:defclass xfx-form-instruction 86,2709 +(clos:defclass xfl-form-instruction 89,2823 +(clos:defclass a-form-instruction 92,2937 +(clos:defclass mds-form-instruction 95,3049 +(clos:defclass md-form-instruction 98,3163 +(clos:defclass m-form-instruction 101,3276 +(defvar *instruction-class-names* 108,3418 +(defvar *instruction-classes*114,3702 +(defvar *instruction-box-alist*132,4455 +(clos:defclass register 346,13801 +(clos:defmethod clos:print-object 351,13988 +(clos:defclass power-register 355,14175 +(clos:defclass integer-power-register 357,14221 +(clos:defclass FP-power-register 359,14281 +(clos:defmethod clos:initialize-instance 361,14340 +(defun register-number 378,15191 +(defmacro define-integer-register 384,15424 +(defvar *instruction-counter* 418,16511 +(defvar *n-previous-instructions* 419,16544 +(defvar *previous-instructions* 420,16583 +(defvar *last-instruction* 421,16620 +(clos:defgeneric emit-operation 428,16939 +(clos:defmethod emit-operation 430,17012 +(clos:defmethod emit-operation 435,17248 +(clos:defmethod emit-operation 440,17427 +(clos:defmethod push-operation445,17607 +(clos:defmethod compute-cycle-count 457,18232 +(defun intersection-p 464,18502 +(defparameter *for-vms* 469,18610 +(defun instruction-pname 470,18639 +(clos:defmethod emit-operation 483,19013 +(clos:defmethod emit-operation 495,19514 +(clos:defmethod emit-operation 511,20166 +(clos:defmethod emit-operation 532,21009 +(clos:defmethod emit-operation 555,21941 +(clos:defmethod emit-operation 576,22800 +(clos:defmethod emit-operation 587,23246 +(clos:defmethod emit-operation 612,24316 +(clos:defmethod emit-operation 631,25120 +(clos:defmethod emit-operation 650,25893 +(clos:defmethod emit-operation 665,26500 +(clos:defmethod emit-operation 682,27181 +(clos:defmethod emit-operation 699,27839 +(clos:defmethod emit-operation 718,28613 +(clos:defmethod emit-operation 735,29294 +(clos:defmethod emit-operation 752,29898 +(clos:defmethod emit-operation 771,30636 +(clos:defmethod emit-operation 788,31313 +(clos:defmethod emit-operation 805,31975 +(clos:defmethod emit-operation 824,32748 +(clos:defmethod emit-operation 845,33601 +(defparameter *label-alignment* 866,34418 +(defparameter *function-alignment* 869,34501 +(defvar *func-name* 871,34540 +(defvar *func-is-external* 872,34565 +(defvar *func-nargs* 873,34597 +(defvar *func-is-fast* 874,34623 +(clos:defmethod emit-operation 876,34652 +(clos:defgeneric coerce-to-register 957,37682 +(clos:defmethod coerce-to-register 959,37731 +(clos:defmethod coerce-to-register 964,37944 +(clos:defmethod coerce-to-register 967,38037 +(clos:defmethod coerce-to-register 971,38147 +(defun coerce-to-register-or-literal 974,38258 +(clos:defgeneric coerce-to-displacement 986,38567 +(clos:defmethod coerce-to-displacement 988,38624 +(clos:defmethod coerce-to-displacement 990,38702 +(clos:defmethod coerce-to-displacement 992,38780 +(defun asm-header 995,38860 +(defun asm-trailer 1005,39321 +(defvar *function-being-processed* 1009,39460 +(defvar *function-epilogue*)1010,39500 +(defun collecting-function-epilogue 1012,39530 +(defun process-asm-source 1021,39940 +(defun process-asm-form 1046,40963 +(defun macroexpand-asm-form 1058,41483 +(defcom com-power-assemble-region1075,41900 +(clos:defclass power-instruction-block 1136,44251 +(clos:defmethod emit-powerbits 1139,44334 +(clos:defgeneric coerce-to-register-number 1144,44531 +(clos:defmethod coerce-to-register-number 1146,44587 +(clos:defmethod coerce-to-register-number 1151,44814 +(clos:defmethod coerce-to-register-number 1154,44921 +(defun register-operandp 1158,45032 +(defun coerce-to-register-number-or-literal 1160,45089 +(defun coerce-to-literal 1167,45257 +(defconstant %%power-inst-opcode 1178,45535 +(defconstant %%power-inst-ra 1180,45601 +(defconstant %%power-inst-rb 1182,45666 +(defconstant %%power-inst-litp 1184,45732 +(defconstant %%power-inst-literal 1186,45796 +(defconstant %%power-inst-function 1188,45855 +(defconstant %%power-inst-rc 1189,45903 +(defconstant %%power-inst-memory-disp 1191,45955 +(defconstant %%power-inst-branch-disp 1193,46017 +(clos:defgeneric assemble-operation 1199,46270 +(clos:defmethod assemble-operation 1201,46347 +(defun NYI 1206,46591 +(clos:defmethod assemble-operation 1211,46694 +(defun assemble-asm-form 1238,47550 +(defun testemit 1252,47942 + +assembler/powerpckg.lisp,35 +(defpackage POWERPC-INTERNALS3,86 + +assembler/power-sct-support.lisp,605 +(fs:define-canonical-type :dsdl 6,102 +(define-module-type :dsdl 8,142 +(defmethod (canonicalize-module-pathnames 11,233 +(defmethod (:compile 28,1034 +(defmethod (:load 43,1585 +(fs:define-canonical-type :assembler-source 61,2079 +(fs:define-canonical-type :assembler-dest 62,2129 +(define-module-type :powerpc-assembly 64,2177 +(defmethod (:compile 67,2297 +(define-module-type :copied-file 89,3036 +(defmethod (canonicalize-module-pathnames 92,3132 +(defmethod (:compile 109,3947 +(define-module-type :makefile 127,4456 +(defvar *vlm-host*)133,4546 +(cp:define-command (com-assemble-emulator 139,4667 + +assembler/sct-support.lisp,603 +(fs:define-canonical-type :dsdl 6,102 +(define-module-type :dsdl 8,142 +(defmethod (canonicalize-module-pathnames 11,233 +(defmethod (:compile 28,1034 +(defmethod (:load 43,1589 +(fs:define-canonical-type :assembler-source 61,2083 +(fs:define-canonical-type :assembler-dest 62,2133 +(define-module-type :alpha-assembly 64,2181 +(defmethod (:compile 67,2299 +(define-module-type :copied-file 89,3038 +(defmethod (canonicalize-module-pathnames 92,3134 +(defmethod (:compile 109,3949 +(define-module-type :makefile 126,4445 +(defvar *vlm-host*)132,4535 +(cp:define-command (com-assemble-emulator 138,4656 + +assembler/sysdcl.lisp,72 +(defsystem Alpha-AXP-Assembler3,85 +(defsystem POWERPC-Assembler12,273 + +emulator/aihead.lisp,54184 +(defconstant |type|$k-|null| 12,345 +(defconstant |TypeNull| 13,377 +(defconstant |type|$k-|monitorforward| 15,405 +(defconstant |TypeMonitorForward| 16,447 +(defconstant |type|$k-|headerp| 18,485 +(defconstant |TypeHeaderP| 19,520 +(defconstant |type|$k-|headeri| 21,551 +(defconstant |TypeHeaderI| 22,586 +(defconstant |type|$k-|externalvaluecellpointer| 24,617 +(defconstant |TypeExternalValueCellPointer| 25,669 +(defconstant |type|$k-|oneqforward| 27,717 +(defconstant |TypeOneQForward| 28,756 +(defconstant |type|$k-|headerforward| 30,791 +(defconstant |TypeHeaderForward| 31,832 +(defconstant |type|$k-|elementforward| 33,869 +(defconstant |TypeElementForward| 34,911 +(defconstant |type|$k-|fixnum| 36,949 +(defconstant |TypeFixnum| 37,983 +(defconstant |type|$k-|smallratio| 39,1013 +(defconstant |TypeSmallRatio| 40,1051 +(defconstant |type|$k-|singlefloat| 42,1085 +(defconstant |TypeSingleFloat| 43,1125 +(defconstant |type|$k-|doublefloat| 45,1161 +(defconstant |TypeDoubleFloat| 46,1201 +(defconstant |type|$k-|bignum| 48,1237 +(defconstant |TypeBignum| 49,1272 +(defconstant |type|$k-|bigratio| 51,1303 +(defconstant |TypeBigRatio| 52,1340 +(defconstant |type|$k-|complex| 54,1373 +(defconstant |TypeComplex| 55,1409 +(defconstant |type|$k-|sparenumber| 57,1441 +(defconstant |TypeSpareNumber| 58,1481 +(defconstant |type|$k-|instance| 60,1517 +(defconstant |TypeInstance| 61,1554 +(defconstant |type|$k-|listinstance| 63,1587 +(defconstant |TypeListInstance| 64,1628 +(defconstant |type|$k-|arrayinstance| 66,1665 +(defconstant |TypeArrayInstance| 67,1707 +(defconstant |type|$k-|stringinstance| 69,1745 +(defconstant |TypeStringInstance| 70,1788 +(defconstant |type|$k-nil 72,1827 +(defconstant |TypeNIL| 73,1857 +(defconstant |type|$k-|list| 75,1885 +(defconstant |TypeList| 76,1918 +(defconstant |type|$k-|array| 78,1947 +(defconstant |TypeArray| 79,1981 +(defconstant |type|$k-|string| 81,2011 +(defconstant |TypeString| 82,2046 +(defconstant |type|$k-|symbol| 84,2077 +(defconstant |TypeSymbol| 85,2112 +(defconstant |type|$k-|locative| 87,2143 +(defconstant |TypeLocative| 88,2180 +(defconstant |type|$k-|lexicalclosure| 90,2213 +(defconstant |TypeLexicalClosure| 91,2256 +(defconstant |type|$k-|dynamicclosure| 93,2295 +(defconstant |TypeDynamicClosure| 94,2338 +(defconstant |type|$k-|compiledfunction| 96,2377 +(defconstant |TypeCompiledFunction| 97,2422 +(defconstant |type|$k-|genericfunction| 99,2463 +(defconstant |TypeGenericFunction| 100,2507 +(defconstant |type|$k-|sparepointer1| 102,2547 +(defconstant |TypeSparePointer1| 103,2589 +(defconstant |type|$k-|sparepointer2| 105,2627 +(defconstant |TypeSparePointer2| 106,2669 +(defconstant |type|$k-|physicaladdress| 108,2707 +(defconstant |TypePhysicalAddress| 109,2751 +(defconstant |type|$k-|nativeinstruction| 111,2791 +(defconstant |TypeNativeInstruction| 112,2837 +(defconstant |type|$k-|boundlocation| 114,2879 +(defconstant |TypeBoundLocation| 115,2921 +(defconstant |type|$k-|character| 117,2959 +(defconstant |TypeCharacter| 118,2997 +(defconstant |type|$k-|logicvariable| 120,3031 +(defconstant |TypeLogicVariable| 121,3073 +(defconstant |type|$k-|gcforward| 123,3111 +(defconstant |TypeGCForward| 124,3149 +(defconstant |type|$k-|evenpc| 126,3183 +(defconstant |TypeEvenPC| 127,3218 +(defconstant |type|$k-|oddpc| 129,3249 +(defconstant |TypeOddPC| 130,3283 +(defconstant |type|$k-|callcompiledeven| 132,3313 +(defconstant |TypeCallCompiledEven| 133,3358 +(defconstant |type|$k-|callcompiledodd| 135,3399 +(defconstant |TypeCallCompiledOdd| 136,3443 +(defconstant |type|$k-|callindirect| 138,3483 +(defconstant |TypeCallIndirect| 139,3524 +(defconstant |type|$k-|callgeneric| 141,3561 +(defconstant |TypeCallGeneric| 142,3601 +(defconstant |type|$k-|callcompiledevenprefetch| 144,3637 +(defconstant |TypeCallCompiledEvenPrefetch| 145,3690 +(defconstant |type|$k-|callcompiledoddprefetch| 147,3739 +(defconstant |TypeCallCompiledOddPrefetch| 148,3791 +(defconstant |type|$k-|callindirectprefetch| 150,3839 +(defconstant |TypeCallIndirectPrefetch| 151,3888 +(defconstant |type|$k-|callgenericprefetch| 153,3933 +(defconstant |TypeCallGenericPrefetch| 154,3981 +(defconstant |type|$k-|packedinstruction60| 156,4025 +(defconstant |TypePackedInstruction60| 157,4073 +(defconstant |type|$k-|typepackedinstruction61| 159,4117 +(defconstant |TypeTypePackedInstruction61| 160,4169 +(defconstant |type|$k-|typepackedinstruction62| 162,4217 +(defconstant |TypeTypePackedInstruction62| 163,4269 +(defconstant |type|$k-|packedinstruction63| 165,4317 +(defconstant |TypePackedInstruction63| 166,4365 +(defconstant |type|$k-|typepackedinstruction64| 168,4409 +(defconstant |TypeTypePackedInstruction64| 169,4461 +(defconstant |type|$k-|typepackedinstruction65| 171,4509 +(defconstant |TypeTypePackedInstruction65| 172,4561 +(defconstant |type|$k-|packedinstruction66| 174,4609 +(defconstant |TypePackedInstruction66| 175,4657 +(defconstant |type|$k-|typepackedinstruction67| 177,4701 +(defconstant |TypeTypePackedInstruction67| 178,4753 +(defconstant |type|$k-|typepackedinstruction70| 180,4801 +(defconstant |TypeTypePackedInstruction70| 181,4853 +(defconstant |type|$k-|packedinstruction71| 183,4901 +(defconstant |TypePackedInstruction71| 184,4949 +(defconstant |type|$k-|typepackedinstruction72| 186,4993 +(defconstant |TypeTypePackedInstruction72| 187,5045 +(defconstant |type|$k-|typepackedinstruction73| 189,5093 +(defconstant |TypeTypePackedInstruction73| 190,5145 +(defconstant |type|$k-|packedinstruction74| 192,5193 +(defconstant |TypePackedInstruction74| 193,5241 +(defconstant |type|$k-|typepackedinstruction75| 195,5285 +(defconstant |TypeTypePackedInstruction75| 196,5337 +(defconstant |type|$k-|typepackedinstruction76| 198,5385 +(defconstant |TypeTypePackedInstruction76| 199,5437 +(defconstant |type|$k-|packedinstruction77| 201,5485 +(defconstant |TypePackedInstruction77| 202,5533 +(defconstant |cdr|$k-|next| 204,5577 +(defconstant |CdrNext| 205,5608 +(defconstant |cdr|$k-|nil| 207,5635 +(defconstant |CdrNil| 208,5665 +(defconstant |cdr|$k-|normal| 210,5691 +(defconstant |CdrNormal| 211,5724 +(defconstant |array|$k-|elementtypefixnum| 213,5753 +(defconstant |ArrayElementTypeFixnum| 214,5799 +(defconstant |array|$k-|elementtypecharacter| 216,5841 +(defconstant |ArrayElementTypeCharacter| 217,5890 +(defconstant |array|$k-|elementtypeboolean| 219,5935 +(defconstant |ArrayElementTypeBoolean| 220,5982 +(defconstant |array|$k-|elementtypeobject| 222,6025 +(defconstant |ArrayElementTypeObject| 223,6071 +(defconstant |array|$k-|typefieldpos| 225,6113 +(defconstant |ArrayTypeFieldPos| 226,6155 +(defconstant |array|$k-|typefieldsize| 228,6193 +(defconstant |ArrayTypeFieldSize| 229,6235 +(defconstant |array|$k-|typefieldmask| 231,6273 +(defconstant |ArrayTypeFieldMask| 232,6316 +(defconstant |array|$k-|elementtypepos| 234,6355 +(defconstant |ArrayElementTypePos| 235,6399 +(defconstant |array|$k-|elementtypesize| 237,6439 +(defconstant |ArrayElementTypeSize| 238,6483 +(defconstant |array|$k-|elementtypemask| 240,6523 +(defconstant |ArrayElementTypeMask| 241,6567 +(defconstant |array|$k-|bytepackingpos| 243,6607 +(defconstant |ArrayBytePackingPos| 244,6651 +(defconstant |array|$k-|bytepackingsize| 246,6691 +(defconstant |ArrayBytePackingSize| 247,6735 +(defconstant |array|$k-|bytepackingmask| 249,6775 +(defconstant |ArrayBytePackingMask| 250,6819 +(defconstant |array|$k-|listbitpos| 252,6859 +(defconstant |ArrayListBitPos| 253,6899 +(defconstant |array|$k-|listbitsize| 255,6935 +(defconstant |ArrayListBitSize| 256,6975 +(defconstant |array|$k-|listbitmask| 258,7011 +(defconstant |ArrayListBitMask| 259,7051 +(defconstant |array|$k-|namedstructurebitpos| 261,7087 +(defconstant |ArrayNamedStructureBitPos| 262,7137 +(defconstant |array|$k-|namedstructurebitsize| 264,7183 +(defconstant |ArrayNamedStructureBitSize| 265,7233 +(defconstant |array|$k-|namedstructurebitmask| 267,7279 +(defconstant |ArrayNamedStructureBitMask| 268,7329 +(defconstant |array|$k-|spare1pos| 270,7375 +(defconstant |ArraySpare1Pos| 271,7414 +(defconstant |array|$k-|spare1size| 273,7449 +(defconstant |ArraySpare1Size| 274,7488 +(defconstant |array|$k-|spare1mask| 276,7523 +(defconstant |ArraySpare1Mask| 277,7562 +(defconstant |array|$k-|longprefixbitpos| 279,7597 +(defconstant |ArrayLongPrefixBitPos| 280,7643 +(defconstant |array|$k-|longprefixbitsize| 282,7685 +(defconstant |ArrayLongPrefixBitSize| 283,7731 +(defconstant |array|$k-|longprefixbitmask| 285,7773 +(defconstant |ArrayLongPrefixBitMask| 286,7819 +(defconstant |array|$k-|leaderlengthfieldpos| 288,7861 +(defconstant |ArrayLeaderLengthFieldPos| 289,7911 +(defconstant |array|$k-|leaderlengthfieldsize| 291,7957 +(defconstant |ArrayLeaderLengthFieldSize| 292,8007 +(defconstant |array|$k-|leaderlengthfieldmask| 294,8053 +(defconstant |ArrayLeaderLengthFieldMask| 295,8105 +(defconstant |array|$k-|lengthpos| 297,8153 +(defconstant |ArrayLengthPos| 298,8191 +(defconstant |array|$k-|lengthsize| 300,8225 +(defconstant |ArrayLengthSize| 301,8265 +(defconstant |array|$k-|lengthmask| 303,8301 +(defconstant |ArrayLengthMask| 304,8344 +(defconstant |array|$k-|displacedbitpos| 306,8383 +(defconstant |ArrayDisplacedBitPos| 307,8428 +(defconstant |array|$k-|displacedbitsize| 309,8469 +(defconstant |ArrayDisplacedBitSize| 310,8514 +(defconstant |array|$k-|displacedbitmask| 312,8555 +(defconstant |ArrayDisplacedBitMask| 313,8600 +(defconstant |array|$k-|discontiguousbitpos| 315,8641 +(defconstant |ArrayDiscontiguousBitPos| 316,8690 +(defconstant |array|$k-|discontinuousbitsize| 318,8735 +(defconstant |ArrayDiscontinuousBitSize| 319,8784 +(defconstant |array|$k-|discontiguousbitmask| 321,8829 +(defconstant |ArrayDiscontiguousBitMask| 322,8878 +(defconstant |array|$k-|longsparepos| 324,8923 +(defconstant |ArrayLongSparePos| 325,8964 +(defconstant |array|$k-|longsparesize| 327,9001 +(defconstant |ArrayLongSpareSize| 328,9044 +(defconstant |array|$k-|longsparemask| 330,9083 +(defconstant |ArrayLongSpareMask| 331,9128 +(defconstant |array|$k-|longdimensionsfieldpos| 333,9169 +(defconstant |ArrayLongDimensionsFieldPos| 334,9220 +(defconstant |array|$k-|longdimensionsfieldsize| 336,9267 +(defconstant |ArrayLongDimensionsFieldSize| 337,9319 +(defconstant |array|$k-|longdimensionsfieldmask| 339,9367 +(defconstant |ArrayLongDimensionsFieldMask| 340,9419 +(defconstant |array|$k-|registerelementtypepos| 342,9467 +(defconstant |ArrayRegisterElementTypePos| 343,9519 +(defconstant |array|$k-|registerelementtypesize| 345,9567 +(defconstant |ArrayRegisterElementTypeSize| 346,9619 +(defconstant |array|$k-|registerelementtypemask| 348,9667 +(defconstant |ArrayRegisterElementTypeMask| 349,9719 +(defconstant |array|$k-|registerbytepackingpos| 351,9767 +(defconstant |ArrayRegisterBytePackingPos| 352,9819 +(defconstant |array|$k-|registerbytepackingsize| 354,9867 +(defconstant |ArrayRegisterBytePackingSize| 355,9919 +(defconstant |array|$k-|registerbytepackingmask| 357,9967 +(defconstant |ArrayRegisterBytePackingMask| 358,10019 +(defconstant |array|$k-|registerbyteoffsetpos| 360,10067 +(defconstant |ArrayRegisterByteOffsetPos| 361,10118 +(defconstant |array|$k-|registerbyteoffsetsize| 363,10165 +(defconstant |ArrayRegisterByteOffsetSize| 364,10216 +(defconstant |array|$k-|registerbyteoffsetmask| 366,10263 +(defconstant |ArrayRegisterByteOffsetMask| 367,10315 +(defconstant |array|$k-|registereventcountpos| 369,10363 +(defconstant |ArrayRegisterEventCountPos| 370,10413 +(defconstant |array|$k-|registereventcountsize| 372,10459 +(defconstant |ArrayRegisterEventCountSize| 373,10511 +(defconstant |array|$k-|registereventcountmask| 375,10559 +(defconstant |ArrayRegisterEventCountMask| 376,10616 +(defconstant |valuedisposition|$k-|effect| 378,10669 +(defconstant |ValueDispositionEffect| 379,10715 +(defconstant |valuedisposition|$k-|value| 381,10757 +(defconstant |ValueDispositionValue| 382,10802 +(defconstant |valuedisposition|$k-|return| 384,10843 +(defconstant |ValueDispositionReturn| 385,10889 +(defconstant |valuedisposition|$k-|multiple| 387,10931 +(defconstant |ValueDispositionMultiple| 388,10979 +(defconstant |opcode|$k-|car| 390,11023 +(defconstant |OpcodeCar| 391,11056 +(defconstant |opcode|$k-|cdr| 393,11085 +(defconstant |OpcodeCdr| 394,11118 +(defconstant |opcode|$k-|settocar| 396,11147 +(defconstant |OpcodeSetToCar| 397,11186 +(defconstant |opcode|$k-|settocdr| 399,11221 +(defconstant |OpcodeSetToCdr| 400,11260 +(defconstant |opcode|$k-|settocdrpushcar| 402,11295 +(defconstant |OpcodeSetToCdrPushCar| 403,11341 +(defconstant |opcode|$k-|rplaca| 405,11383 +(defconstant |OpcodeRplaca| 406,11421 +(defconstant |opcode|$k-|rplacd| 408,11455 +(defconstant |OpcodeRplacd| 409,11493 +(defconstant |opcode|$k-|rgetf| 411,11527 +(defconstant |OpcodeRgetf| 412,11564 +(defconstant |opcode|$k-|member| 414,11597 +(defconstant |OpcodeMember| 415,11635 +(defconstant |opcode|$k-|assoc| 417,11669 +(defconstant |OpcodeAssoc| 418,11706 +(defconstant |opcode|$k-|dereference| 420,11739 +(defconstant |OpcodeDereference| 421,11781 +(defconstant |opcode|$k-|unify| 423,11819 +(defconstant |OpcodeUnify| 424,11856 +(defconstant |opcode|$k-|pushlocallogicvariables| 426,11889 +(defconstant |OpcodePushLocalLogicVariables| 427,11943 +(defconstant |opcode|$k-|pushgloballogicvariable| 429,11993 +(defconstant |OpcodePushGlobalLogicVariable| 430,12047 +(defconstant |opcode|$k-|logictailtest| 432,12097 +(defconstant |OpcodeLogicTailTest| 433,12141 +(defconstant |opcode|$k-|eq| 435,12181 +(defconstant |OpcodeEq| 436,12215 +(defconstant |opcode|$k-|eqnopop| 438,12245 +(defconstant |OpcodeEqNoPop| 439,12284 +(defconstant |opcode|$k-|eql| 441,12319 +(defconstant |OpcodeEql| 442,12354 +(defconstant |opcode|$k-|eqlnopop| 444,12385 +(defconstant |OpcodeEqlNoPop| 445,12425 +(defconstant |opcode|$k-|equalnumber| 447,12461 +(defconstant |OpcodeEqualNumber| 448,12504 +(defconstant |opcode|$k-|equalnumbernopop| 450,12543 +(defconstant |OpcodeEqualNumberNoPop| 451,12591 +(defconstant |opcode|$k-|greaterp| 453,12635 +(defconstant |OpcodeGreaterp| 454,12675 +(defconstant |opcode|$k-|greaterpnopop| 456,12711 +(defconstant |OpcodeGreaterpNoPop| 457,12756 +(defconstant |opcode|$k-|lessp| 459,12797 +(defconstant |OpcodeLessp| 460,12834 +(defconstant |opcode|$k-|lesspnopop| 462,12867 +(defconstant |OpcodeLesspNoPop| 463,12909 +(defconstant |opcode|$k-|logtest| 465,12947 +(defconstant |OpcodeLogtest| 466,12986 +(defconstant |opcode|$k-|logtestnopop| 468,13021 +(defconstant |OpcodeLogtestNoPop| 469,13065 +(defconstant |opcode|$k-|typemember| 471,13105 +(defconstant |OpcodeTypeMember| 472,13146 +(defconstant |opcode|$k-|typemembernopop| 474,13183 +(defconstant |OpcodeTypeMemberNoPop| 475,13229 +(defconstant |opcode|$k-|endp| 477,13271 +(defconstant |OpcodeEndp| 478,13305 +(defconstant |opcode|$k-|plusp| 480,13335 +(defconstant |OpcodePlusp| 481,13371 +(defconstant |opcode|$k-|minusp| 483,13403 +(defconstant |OpcodeMinusp| 484,13440 +(defconstant |opcode|$k-|zerop| 486,13473 +(defconstant |OpcodeZerop| 487,13509 +(defconstant |opcode|$k-|add| 489,13541 +(defconstant |OpcodeAdd| 490,13576 +(defconstant |opcode|$k-|sub| 492,13607 +(defconstant |OpcodeSub| 493,13642 +(defconstant |opcode|$k-|unaryminus| 495,13673 +(defconstant |OpcodeUnaryMinus| 496,13714 +(defconstant |opcode|$k-|increment| 498,13751 +(defconstant |OpcodeIncrement| 499,13791 +(defconstant |opcode|$k-|decrement| 501,13827 +(defconstant |OpcodeDecrement| 502,13868 +(defconstant |opcode|$k-|multiply| 504,13905 +(defconstant |OpcodeMultiply| 505,13945 +(defconstant |opcode|$k-|quotient| 507,13981 +(defconstant |OpcodeQuotient| 508,14021 +(defconstant |opcode|$k-|ceiling| 510,14057 +(defconstant |OpcodeCeiling| 511,14096 +(defconstant |opcode|$k-|floor| 513,14131 +(defconstant |OpcodeFloor| 514,14168 +(defconstant |opcode|$k-|truncate| 516,14201 +(defconstant |OpcodeTruncate| 517,14241 +(defconstant |opcode|$k-|round| 519,14277 +(defconstant |OpcodeRound| 520,14314 +(defconstant |opcode|$k-|rationalquotient| 522,14347 +(defconstant |OpcodeRationalQuotient| 523,14395 +(defconstant |opcode|$k-|max| 525,14439 +(defconstant |OpcodeMax| 526,14474 +(defconstant |opcode|$k-|min| 528,14505 +(defconstant |OpcodeMin| 529,14540 +(defconstant |opcode|$k-|logand| 531,14571 +(defconstant |OpcodeLogand| 532,14609 +(defconstant |opcode|$k-|logior| 534,14643 +(defconstant |OpcodeLogior| 535,14681 +(defconstant |opcode|$k-|logxor| 537,14715 +(defconstant |OpcodeLogxor| 538,14753 +(defconstant |opcode|$k-|ash| 540,14787 +(defconstant |OpcodeAsh| 541,14822 +(defconstant |opcode|$k-|rot| 543,14853 +(defconstant |OpcodeRot| 544,14888 +(defconstant |opcode|$k-|lsh| 546,14919 +(defconstant |OpcodeLsh| 547,14954 +(defconstant |opcode|$k-|32bitplus| 549,14985 +(defconstant |Opcode32BitPlus| 550,15026 +(defconstant |opcode|$k-|32bitdifference| 552,15063 +(defconstant |Opcode32BitDifference| 553,15110 +(defconstant |opcode|$k-|multiplydouble| 555,15153 +(defconstant |OpcodeMultiplyDouble| 556,15199 +(defconstant |opcode|$k-|addbignumstep| 558,15241 +(defconstant |OpcodeAddBignumStep| 559,15286 +(defconstant |opcode|$k-|subbignumstep| 561,15327 +(defconstant |OpcodeSubBignumStep| 562,15372 +(defconstant |opcode|$k-|multiplybignumstep| 564,15413 +(defconstant |OpcodeMultiplyBignumStep| 565,15463 +(defconstant |opcode|$k-|dividebignumstep| 567,15509 +(defconstant |OpcodeDivideBignumStep| 568,15557 +(defconstant |opcode|$k-|lshcbignumstep| 570,15601 +(defconstant |OpcodeLshcBignumStep| 571,15647 +(defconstant |opcode|$k-|doublefloatop| 573,15689 +(defconstant |OpcodeDoubleFloatOp| 574,15733 +(defconstant |opcode|$k-|push| 576,15773 +(defconstant |OpcodePush| 577,15808 +(defconstant |opcode|$k-|pop| 579,15839 +(defconstant |OpcodePop| 580,15874 +(defconstant |opcode|$k-|movem| 582,15905 +(defconstant |OpcodeMovem| 583,15942 +(defconstant |opcode|$k-|pushnnils| 585,15975 +(defconstant |OpcodePushNNils| 586,16015 +(defconstant |opcode|$k-|pushaddress| 588,16051 +(defconstant |OpcodePushAddress| 589,16094 +(defconstant |opcode|$k-|setsptoaddress| 591,16133 +(defconstant |OpcodeSetSpToAddress| 592,16179 +(defconstant |opcode|$k-|setsptoaddresssavetos| 594,16221 +(defconstant |OpcodeSetSpToAddressSaveTos| 595,16274 +(defconstant |opcode|$k-|pushaddresssprelative| 597,16323 +(defconstant |OpcodePushAddressSpRelative| 598,16375 +(defconstant |opcode|$k-|stackblt| 600,16423 +(defconstant |OpcodeStackBlt| 601,16463 +(defconstant |opcode|$k-|stackbltaddress| 603,16499 +(defconstant |OpcodeStackBltAddress| 604,16546 +(defconstant |opcode|$k-|ldb| 606,16589 +(defconstant |OpcodeLdb| 607,16624 +(defconstant |opcode|$k-|dpb| 609,16655 +(defconstant |OpcodeDpb| 610,16690 +(defconstant |opcode|$k-|charldb| 612,16721 +(defconstant |OpcodeCharLdb| 613,16760 +(defconstant |opcode|$k-|chardpb| 615,16795 +(defconstant |OpcodeCharDpb| 616,16834 +(defconstant |opcode|$k-|pldb| 618,16869 +(defconstant |OpcodePLdb| 619,16905 +(defconstant |opcode|$k-|pdpb| 621,16937 +(defconstant |OpcodePDpb| 622,16973 +(defconstant |opcode|$k-|ptagldb| 624,17005 +(defconstant |OpcodePTagLdb| 625,17044 +(defconstant |opcode|$k-|ptagdpb| 627,17079 +(defconstant |OpcodePTagDpb| 628,17118 +(defconstant |opcode|$k-|aref1| 630,17153 +(defconstant |OpcodeAref1| 631,17190 +(defconstant |opcode|$k-|aset1| 633,17223 +(defconstant |OpcodeAset1| 634,17260 +(defconstant |opcode|$k-|aloc1| 636,17293 +(defconstant |OpcodeAloc1| 637,17330 +(defconstant |opcode|$k-|setup1darray| 639,17363 +(defconstant |OpcodeSetup1DArray| 640,17405 +(defconstant |opcode|$k-|setupforce1darray| 642,17443 +(defconstant |OpcodeSetupForce1DArray| 643,17490 +(defconstant |opcode|$k-|fastaref1| 645,17533 +(defconstant |OpcodeFastAref1| 646,17574 +(defconstant |opcode|$k-|fastaset1| 648,17611 +(defconstant |OpcodeFastAset1| 649,17652 +(defconstant |opcode|$k-|arrayleader| 651,17689 +(defconstant |OpcodeArrayLeader| 652,17732 +(defconstant |opcode|$k-|storearrayleader| 654,17771 +(defconstant |OpcodeStoreArrayLeader| 655,17819 +(defconstant |opcode|$k-|alocleader| 657,17863 +(defconstant |OpcodeAlocLeader| 658,17905 +(defconstant |opcode|$k-|branch| 660,17943 +(defconstant |OpcodeBranch| 661,17981 +(defconstant |opcode|$k-|branchtrue| 663,18015 +(defconstant |OpcodeBranchTrue| 664,18056 +(defconstant |opcode|$k-|branchtrueelseextrapop| 666,18093 +(defconstant |OpcodeBranchTrueElseExtraPop| 667,18146 +(defconstant |opcode|$k-|branchtrueandextrapop| 669,18195 +(defconstant |OpcodeBranchTrueAndExtraPop| 670,18247 +(defconstant |opcode|$k-|branchtrueextrapop| 672,18295 +(defconstant |OpcodeBranchTrueExtraPop| 673,18344 +(defconstant |opcode|$k-|branchtruenopop| 675,18389 +(defconstant |OpcodeBranchTrueNoPop| 676,18435 +(defconstant |opcode|$k-|branchtrueandnopop| 678,18477 +(defconstant |OpcodeBranchTrueAndNoPop| 679,18526 +(defconstant |opcode|$k-|branchtrueelsenopop| 681,18571 +(defconstant |OpcodeBranchTrueElseNoPop| 682,18621 +(defconstant |opcode|$k-|branchtrueandnopopelsenopopextrapop| 684,18667 +(defconstant |OpcodeBranchTrueAndNoPopElseNoPopExtraPop| 685,18733 +(defconstant |opcode|$k-|branchfalse| 687,18795 +(defconstant |OpcodeBranchFalse| 688,18837 +(defconstant |opcode|$k-|branchfalseelseextrapop| 690,18875 +(defconstant |OpcodeBranchFalseElseExtraPop| 691,18929 +(defconstant |opcode|$k-|branchfalseandextrapop| 693,18979 +(defconstant |OpcodeBranchFalseAndExtraPop| 694,19032 +(defconstant |opcode|$k-|branchfalseextrapop| 696,19081 +(defconstant |OpcodeBranchFalseExtraPop| 697,19131 +(defconstant |opcode|$k-|branchfalsenopop| 699,19177 +(defconstant |OpcodeBranchFalseNoPop| 700,19224 +(defconstant |opcode|$k-|branchfalseandnopop| 702,19267 +(defconstant |OpcodeBranchFalseAndNoPop| 703,19317 +(defconstant |opcode|$k-|branchfalseelsenopop| 705,19363 +(defconstant |OpcodeBranchFalseElseNoPop| 706,19414 +(defconstant |opcode|$k-|branchfalseandnopopelsenopopextrapop| 708,19461 +(defconstant |OpcodeBranchFalseAndNoPopElseNoPopExtraPop| 709,19528 +(defconstant |opcode|$k-|loopdecrementtos| 711,19591 +(defconstant |OpcodeLoopDecrementTos| 712,19639 +(defconstant |opcode|$k-|loopincrementtoslessthan| 714,19683 +(defconstant |OpcodeLoopIncrementTosLessThan| 715,19739 +(defconstant |opcode|$k-|block0read| 717,19791 +(defconstant |OpcodeBlock0Read| 718,19832 +(defconstant |opcode|$k-|block1read| 720,19869 +(defconstant |OpcodeBlock1Read| 721,19910 +(defconstant |opcode|$k-|block2read| 723,19947 +(defconstant |OpcodeBlock2Read| 724,19988 +(defconstant |opcode|$k-|block3read| 726,20025 +(defconstant |OpcodeBlock3Read| 727,20066 +(defconstant |opcode|$k-|block0readshift| 729,20103 +(defconstant |OpcodeBlock0ReadShift| 730,20149 +(defconstant |opcode|$k-|block1readshift| 732,20191 +(defconstant |OpcodeBlock1ReadShift| 733,20237 +(defconstant |opcode|$k-|block2readshift| 735,20279 +(defconstant |OpcodeBlock2ReadShift| 736,20325 +(defconstant |opcode|$k-|block3readshift| 738,20367 +(defconstant |OpcodeBlock3ReadShift| 739,20413 +(defconstant |opcode|$k-|block0readalu| 741,20455 +(defconstant |OpcodeBlock0ReadAlu| 742,20500 +(defconstant |opcode|$k-|block1readalu| 744,20541 +(defconstant |OpcodeBlock1ReadAlu| 745,20586 +(defconstant |opcode|$k-|block2readalu| 747,20627 +(defconstant |OpcodeBlock2ReadAlu| 748,20672 +(defconstant |opcode|$k-|block3readalu| 750,20713 +(defconstant |OpcodeBlock3ReadAlu| 751,20758 +(defconstant |opcode|$k-|block0readtest| 753,20799 +(defconstant |OpcodeBlock0ReadTest| 754,20844 +(defconstant |opcode|$k-|block1readtest| 756,20885 +(defconstant |OpcodeBlock1ReadTest| 757,20930 +(defconstant |opcode|$k-|block2readtest| 759,20971 +(defconstant |OpcodeBlock2ReadTest| 760,21016 +(defconstant |opcode|$k-|block3readtest| 762,21057 +(defconstant |OpcodeBlock3ReadTest| 763,21102 +(defconstant |opcode|$k-|block0write| 765,21143 +(defconstant |OpcodeBlock0Write| 766,21185 +(defconstant |opcode|$k-|block1write| 768,21223 +(defconstant |OpcodeBlock1Write| 769,21265 +(defconstant |opcode|$k-|block2write| 771,21303 +(defconstant |OpcodeBlock2Write| 772,21345 +(defconstant |opcode|$k-|block3write| 774,21383 +(defconstant |OpcodeBlock3Write| 775,21425 +(defconstant |opcode|$k-|startcall| 777,21463 +(defconstant |OpcodeStartCall| 778,21502 +(defconstant |opcode|$k-|finishcalln| 780,21537 +(defconstant |OpcodeFinishCallN| 781,21579 +(defconstant |opcode|$k-|finishcallnapply| 783,21617 +(defconstant |OpcodeFinishCallNApply| 784,21664 +(defconstant |opcode|$k-|finishcalltos| 786,21707 +(defconstant |OpcodeFinishCallTos| 787,21751 +(defconstant |opcode|$k-|finishcalltosapply| 789,21791 +(defconstant |OpcodeFinishCallTosApply| 790,21840 +(defconstant |opcode|$k-|entryrestaccepted| 792,21885 +(defconstant |OpcodeEntryRestAccepted| 793,21934 +(defconstant |opcode|$k-|entryrestnotaccepted| 795,21979 +(defconstant |OpcodeEntryRestNotAccepted| 796,22031 +(defconstant |opcode|$k-|locatelocals| 798,22079 +(defconstant |OpcodeLocateLocals| 799,22122 +(defconstant |opcode|$k-|returnsingle| 801,22161 +(defconstant |OpcodeReturnSingle| 802,22204 +(defconstant |opcode|$k-|returnmultiple| 804,22243 +(defconstant |OpcodeReturnMultiple| 805,22288 +(defconstant |opcode|$k-|returnkludge| 807,22329 +(defconstant |OpcodeReturnKludge| 808,22372 +(defconstant |opcode|$k-|takevalues| 810,22411 +(defconstant |OpcodeTakeValues| 811,22452 +(defconstant |opcode|$k-|bindlocativetovalue| 813,22489 +(defconstant |OpcodeBindLocativeToValue| 814,22540 +(defconstant |opcode|$k-|bindlocative| 816,22587 +(defconstant |OpcodeBindLocative| 817,22629 +(defconstant |opcode|$k-|unbindn| 819,22667 +(defconstant |OpcodeUnbindN| 820,22705 +(defconstant |opcode|$k-|restorebindingstack| 822,22739 +(defconstant |OpcodeRestoreBindingStack| 823,22788 +(defconstant |opcode|$k-|catchopen| 825,22833 +(defconstant |OpcodeCatchOpen| 826,22874 +(defconstant |opcode|$k-|catchclose| 828,22911 +(defconstant |OpcodeCatchClose| 829,22952 +(defconstant |opcode|$k-|pushlexicalvar| 831,22989 +(defconstant |OpcodePushLexicalVar| 832,23034 +(defconstant |opcode|$k-|poplexicalvar| 834,23075 +(defconstant |OpcodePopLexicalVar| 835,23120 +(defconstant |opcode|$k-|movemlexicalvar| 837,23161 +(defconstant |OpcodeMovemLexicalVar| 838,23208 +(defconstant |opcode|$k-|pushinstancevariable| 840,23251 +(defconstant |OpcodePushInstanceVariable| 841,23302 +(defconstant |opcode|$k-|popinstancevariable| 843,23349 +(defconstant |OpcodePopInstanceVariable| 844,23400 +(defconstant |opcode|$k-|moveminstancevariable| 846,23447 +(defconstant |OpcodeMovemInstanceVariable| 847,23500 +(defconstant |opcode|$k-|pushaddressinstancevariable| 849,23549 +(defconstant |OpcodePushAddressInstanceVariable| 850,23607 +(defconstant |opcode|$k-|pushinstancevariableordered| 852,23661 +(defconstant |OpcodePushInstanceVariableOrdered| 853,23719 +(defconstant |opcode|$k-|popinstancevariableordered| 855,23773 +(defconstant |OpcodePopInstanceVariableOrdered| 856,23831 +(defconstant |opcode|$k-|moveminstancevariableordered| 858,23885 +(defconstant |OpcodeMovemInstanceVariableOrdered| 859,23945 +(defconstant |opcode|$k-|pushaddressinstancevariableordered| 861,24001 +(defconstant |OpcodePushAddressInstanceVariableOrdered| 862,24066 +(defconstant |opcode|$k-|instanceref| 864,24127 +(defconstant |OpcodeInstanceRef| 865,24170 +(defconstant |opcode|$k-|instanceset| 867,24209 +(defconstant |OpcodeInstanceSet| 868,24252 +(defconstant |opcode|$k-|instanceloc| 870,24291 +(defconstant |OpcodeInstanceLoc| 871,24334 +(defconstant |opcode|$k-|ephemeralp| 873,24373 +(defconstant |OpcodeEphemeralp| 874,24413 +(defconstant |opcode|$k-|unsignedlessp| 876,24449 +(defconstant |OpcodeUnsignedLessp| 877,24494 +(defconstant |opcode|$k-|unsignedlesspnopop| 879,24535 +(defconstant |OpcodeUnsignedLesspNoPop| 880,24585 +(defconstant |opcode|$k-|alu| 882,24631 +(defconstant |OpcodeAlu| 883,24666 +(defconstant |opcode|$k-|allocatelistblock| 885,24697 +(defconstant |OpcodeAllocateListBlock| 886,24746 +(defconstant |opcode|$k-|allocatestructureblock| 888,24791 +(defconstant |OpcodeAllocateStructureBlock| 889,24845 +(defconstant |opcode|$k-|pointerplus| 891,24895 +(defconstant |OpcodePointerPlus| 892,24938 +(defconstant |opcode|$k-|pointerdifference| 894,24977 +(defconstant |OpcodePointerDifference| 895,25026 +(defconstant |opcode|$k-|pointerincrement| 897,25071 +(defconstant |OpcodePointerIncrement| 898,25119 +(defconstant |opcode|$k-|readinternalregister| 900,25163 +(defconstant |OpcodeReadInternalRegister| 901,25215 +(defconstant |opcode|$k-|writeinternalregister| 903,25263 +(defconstant |OpcodeWriteInternalRegister| 904,25316 +(defconstant |opcode|$k-|coprocessorread| 906,25365 +(defconstant |OpcodeCoprocessorRead| 907,25412 +(defconstant |opcode|$k-|coprocessorwrite| 909,25455 +(defconstant |OpcodeCoprocessorWrite| 910,25503 +(defconstant |opcode|$k-|memoryread| 912,25547 +(defconstant |OpcodeMemoryRead| 913,25588 +(defconstant |opcode|$k-|memoryreadaddress| 915,25625 +(defconstant |OpcodeMemoryReadAddress| 916,25673 +(defconstant |opcode|$k-|tag| 918,25717 +(defconstant |OpcodeTag| 919,25751 +(defconstant |opcode|$k-|settag| 921,25781 +(defconstant |OpcodeSetTag| 922,25819 +(defconstant |opcode|$k-|storeconditional| 924,25853 +(defconstant |OpcodeStoreConditional| 925,25901 +(defconstant |opcode|$k-|memorywrite| 927,25945 +(defconstant |OpcodeMemoryWrite| 928,25988 +(defconstant |opcode|$k-|pstorecontents| 930,26027 +(defconstant |OpcodePStoreContents| 931,26073 +(defconstant |opcode|$k-|setcdrcode1| 933,26115 +(defconstant |OpcodeSetCdrCode1| 934,26158 +(defconstant |opcode|$k-|setcdrcode2| 936,26197 +(defconstant |OpcodeSetCdrCode2| 937,26240 +(defconstant |opcode|$k-|mergecdrnopop| 939,26279 +(defconstant |OpcodeMergeCdrNoPop| 940,26324 +(defconstant |opcode|$k-|genericdispatch| 942,26365 +(defconstant |OpcodeGenericDispatch| 943,26411 +(defconstant |opcode|$k-|messagedispatch| 945,26453 +(defconstant |OpcodeMessageDispatch| 946,26499 +(defconstant |opcode|$k-|jump| 948,26541 +(defconstant |OpcodeJump| 949,26575 +(defconstant |opcode|$k-|checkpreemptrequest| 951,26605 +(defconstant |OpcodeCheckPreemptRequest| 952,26655 +(defconstant |opcode|$k-|noop| 954,26701 +(defconstant |OpcodeNoOp| 955,26736 +(defconstant |opcode|$k-|halt| 957,26767 +(defconstant |OpcodeHalt| 958,26802 +(defconstant |control|$k-|apply| 960,26833 +(defconstant |ControlApply| 961,26874 +(defconstant |control|$k-|cleanupbits| 963,26911 +(defconstant |ControlCleanupBits| 964,26961 +(defconstant |control|$k-|callstarted| 966,27007 +(defconstant |ControlCallStarted| 967,27055 +(defconstant |control|$k-|extraargument| 969,27099 +(defconstant |ControlExtraArgument| 970,27145 +(defconstant |control|$k-|argumentsize| 972,27187 +(defconstant |ControlArgumentSize| 973,27232 +(defconstant |control|$k-|callerframesize| 975,27273 +(defconstant |ControlCallerFrameSize| 976,27324 +(defconstant |control|$k-|valuedisposition| 978,27371 +(defconstant |ControlValueDisposition| 979,27423 +(defconstant |internalregister|$k-ea 981,27471 +(defconstant |InternalRegisterEA| 982,27511 +(defconstant |internalregister|$k-fp 984,27549 +(defconstant |InternalRegisterFP| 985,27589 +(defconstant |internalregister|$k-lp 987,27627 +(defconstant |InternalRegisterLP| 988,27667 +(defconstant |internalregister|$k-sp 990,27705 +(defconstant |InternalRegisterSP| 991,27745 +(defconstant |internalregister|$k-|macrosp| 993,27783 +(defconstant |InternalRegisterMacroSP| 994,27830 +(defconstant |internalregister|$k-|stackcachelowerbound| 996,27873 +(defconstant |InternalRegisterStackCacheLowerBound| 997,27933 +(defconstant |internalregister|$k-bar0 999,27989 +(defconstant |InternalRegisterBAR0| 1000,28031 +(defconstant |internalregister|$k-bar1 1002,28071 +(defconstant |InternalRegisterBAR1| 1003,28115 +(defconstant |internalregister|$k-bar2 1005,28157 +(defconstant |InternalRegisterBAR2| 1006,28201 +(defconstant |internalregister|$k-bar3 1008,28243 +(defconstant |InternalRegisterBAR3| 1009,28287 +(defconstant |internalregister|$k-|phthash0| 1011,28329 +(defconstant |InternalRegisterPHTHash0| 1012,28377 +(defconstant |internalregister|$k-|phthash1| 1014,28421 +(defconstant |InternalRegisterPHTHash1| 1015,28471 +(defconstant |internalregister|$k-|phthash2| 1017,28517 +(defconstant |InternalRegisterPHTHash2| 1018,28567 +(defconstant |internalregister|$k-|phthash3| 1020,28613 +(defconstant |InternalRegisterPHTHash3| 1021,28663 +(defconstant |internalregister|$k-epc 1023,28709 +(defconstant |InternalRegisterEPC| 1024,28750 +(defconstant |internalregister|$k-dpc 1026,28789 +(defconstant |InternalRegisterDPC| 1027,28830 +(defconstant |internalregister|$k-|continuation| 1029,28869 +(defconstant |InternalRegisterContinuation| 1030,28922 +(defconstant |internalregister|$k-|aluandrotatecontrol| 1032,28971 +(defconstant |InternalRegisterAluAndRotateControl| 1033,29031 +(defconstant |internalregister|$k-|controlregister| 1035,29087 +(defconstant |InternalRegisterControlRegister| 1036,29143 +(defconstant |internalregister|$k-|crargumentsize| 1038,29195 +(defconstant |InternalRegisterCRArgumentSize| 1039,29250 +(defconstant |internalregister|$k-|ephemeraloldspaceregister| 1041,29301 +(defconstant |InternalRegisterEphemeralOldspaceRegister| 1042,29367 +(defconstant |internalregister|$k-|zoneoldspaceregister| 1044,29429 +(defconstant |InternalRegisterZoneOldspaceRegister| 1045,29490 +(defconstant |internalregister|$k-|chiprevision| 1047,29547 +(defconstant |InternalRegisterChipRevision| 1048,29600 +(defconstant |internalregister|$k-|fpcoprocessorpresent| 1050,29649 +(defconstant |InternalRegisterFPCoprocessorPresent| 1051,29710 +(defconstant |internalregister|$k-|preemptregister| 1053,29767 +(defconstant |InternalRegisterPreemptRegister| 1054,29823 +(defconstant |internalregister|$k-|icachecontrol| 1056,29875 +(defconstant |InternalRegisterIcacheControl| 1057,29929 +(defconstant |internalregister|$k-|prefetchercontrol| 1059,29979 +(defconstant |InternalRegisterPrefetcherControl| 1060,30037 +(defconstant |internalregister|$k-|mapcachecontrol| 1062,30091 +(defconstant |InternalRegisterMapCacheControl| 1063,30147 +(defconstant |internalregister|$k-|memorycontrol| 1065,30199 +(defconstant |InternalRegisterMemoryControl| 1066,30253 +(defconstant |internalregister|$k-|ecclog| 1068,30303 +(defconstant |InternalRegisterECCLog| 1069,30350 +(defconstant |internalregister|$k-|ecclogaddress| 1071,30393 +(defconstant |InternalRegisterECCLogAddress| 1072,30447 +(defconstant |internalregister|$k-|invalidatemap0| 1074,30497 +(defconstant |InternalRegisterInvalidateMap0| 1075,30552 +(defconstant |internalregister|$k-|invalidatemap1| 1077,30603 +(defconstant |InternalRegisterInvalidateMap1| 1078,30659 +(defconstant |internalregister|$k-|invalidatemap2| 1080,30711 +(defconstant |InternalRegisterInvalidateMap2| 1081,30767 +(defconstant |internalregister|$k-|invalidatemap3| 1083,30819 +(defconstant |InternalRegisterInvalidateMap3| 1084,30875 +(defconstant |internalregister|$k-|loadmap0| 1086,30927 +(defconstant |InternalRegisterLoadMap0| 1087,30976 +(defconstant |internalregister|$k-|loadmap1| 1089,31021 +(defconstant |InternalRegisterLoadMap1| 1090,31071 +(defconstant |internalregister|$k-|loadmap2| 1092,31117 +(defconstant |InternalRegisterLoadMap2| 1093,31167 +(defconstant |internalregister|$k-|loadmap3| 1095,31213 +(defconstant |InternalRegisterLoadMap3| 1096,31263 +(defconstant |internalregister|$k-|stackcacheoverflowlimit| 1098,31309 +(defconstant |InternalRegisterStackCacheOverflowLimit| 1099,31373 +(defconstant |internalregister|$k-|ucoderomcontents| 1101,31433 +(defconstant |InternalRegisterUcodeROMContents| 1102,31490 +(defconstant |internalregister|$k-|addressmask| 1104,31543 +(defconstant |InternalRegisterAddressMask| 1105,31595 +(defconstant |internalregister|$k-|entrymaximumarguments| 1107,31643 +(defconstant |InternalRegisterEntryMaximumArguments| 1108,31705 +(defconstant |internalregister|$k-|lexicalvariable| 1110,31763 +(defconstant |InternalRegisterLexicalVariable| 1111,31819 +(defconstant |internalregister|$k-|instruction| 1113,31871 +(defconstant |InternalRegisterInstruction| 1114,31923 +(defconstant |internalregister|$k-|memorydata| 1116,31971 +(defconstant |InternalRegisterMemoryData| 1117,32022 +(defconstant |internalregister|$k-|datapins| 1119,32069 +(defconstant |InternalRegisterDataPins| 1120,32118 +(defconstant |internalregister|$k-|extensionregister| 1122,32163 +(defconstant |InternalRegisterExtensionRegister| 1123,32221 +(defconstant |internalregister|$k-|microsecondclock| 1125,32275 +(defconstant |InternalRegisterMicrosecondClock| 1126,32332 +(defconstant |internalregister|$k-|arrayheaderlength| 1128,32385 +(defconstant |InternalRegisterArrayHeaderLength| 1129,32443 +(defconstant |internalregister|$k-|loadbar0| 1131,32497 +(defconstant |InternalRegisterLoadBAR0| 1132,32546 +(defconstant |internalregister|$k-|loadbar1| 1134,32591 +(defconstant |InternalRegisterLoadBAR1| 1135,32641 +(defconstant |internalregister|$k-|loadbar2| 1137,32687 +(defconstant |InternalRegisterLoadBAR2| 1138,32737 +(defconstant |internalregister|$k-|loadbar3| 1140,32783 +(defconstant |InternalRegisterLoadBAR3| 1141,32833 +(defconstant |internalregister|$k-tos 1143,32879 +(defconstant |InternalRegisterTOS| 1144,32922 +(defconstant |internalregister|$k-|eventcount| 1146,32963 +(defconstant |InternalRegisterEventCount| 1147,33015 +(defconstant |internalregister|$k-|bindingstackpointer| 1149,33063 +(defconstant |InternalRegisterBindingStackPointer| 1150,33124 +(defconstant |internalregister|$k-|catchblocklist| 1152,33181 +(defconstant |InternalRegisterCatchBlockList| 1153,33237 +(defconstant |internalregister|$k-|controlstacklimit| 1155,33289 +(defconstant |InternalRegisterControlStackLimit| 1156,33348 +(defconstant |internalregister|$k-|controlstackextralimit| 1158,33403 +(defconstant |InternalRegisterControlStackExtraLimit| 1159,33467 +(defconstant |internalregister|$k-|bindingstacklimit| 1161,33527 +(defconstant |InternalRegisterBindingStackLimit| 1162,33586 +(defconstant |internalregister|$k-|phtbase| 1164,33641 +(defconstant |InternalRegisterPHTBase| 1165,33690 +(defconstant |internalregister|$k-|phtmask| 1167,33735 +(defconstant |InternalRegisterPHTMask| 1168,33784 +(defconstant |internalregister|$k-|countmapreloads| 1170,33829 +(defconstant |InternalRegisterCountMapReloads| 1171,33886 +(defconstant |internalregister|$k-|listcachearea| 1173,33939 +(defconstant |InternalRegisterListCacheArea| 1174,33994 +(defconstant |internalregister|$k-|listcacheaddress| 1176,34045 +(defconstant |InternalRegisterListCacheAddress| 1177,34103 +(defconstant |internalregister|$k-|listcachelength| 1179,34157 +(defconstant |InternalRegisterListCacheLength| 1180,34214 +(defconstant |internalregister|$k-|structurecachearea| 1182,34267 +(defconstant |InternalRegisterStructureCacheArea| 1183,34327 +(defconstant |internalregister|$k-|structurecacheaddress| 1185,34383 +(defconstant |InternalRegisterStructureCacheAddress| 1186,34446 +(defconstant |internalregister|$k-|structurecachelength| 1188,34505 +(defconstant |InternalRegisterStructureCacheLength| 1189,34567 +(defconstant |internalregister|$k-|dynamicbindingcachebase| 1191,34625 +(defconstant |InternalRegisterDynamicBindingCacheBase| 1192,34690 +(defconstant |internalregister|$k-|dynamicbindingcachemask| 1194,34751 +(defconstant |InternalRegisterDynamicBindingCacheMask| 1195,34816 +(defconstant |internalregister|$k-|choicepointer| 1197,34877 +(defconstant |InternalRegisterChoicePointer| 1198,34932 +(defconstant |internalregister|$k-|structurestackchoicepointer| 1200,34983 +(defconstant |InternalRegisterStructureStackChoicePointer| 1201,35052 +(defconstant |internalregister|$k-|fepmodetrapvectoraddress| 1203,35117 +(defconstant |InternalRegisterFEPModeTrapVectorAddress| 1204,35183 +(defconstant |internalregister|$k-|mappingtablecache| 1206,35245 +(defconstant |InternalRegisterMappingTableCache| 1207,35304 +(defconstant |internalregister|$k-|mappingtablelength| 1209,35359 +(defconstant |InternalRegisterMappingTableLength| 1210,35419 +(defconstant |internalregister|$k-|stackframemaximumsize| 1212,35475 +(defconstant |InternalRegisterStackFrameMaximumSize| 1213,35538 +(defconstant |internalregister|$k-|stackcachedumpquantum| 1215,35597 +(defconstant |InternalRegisterStackCacheDumpQuantum| 1216,35660 +(defconstant |internalregister|$k-|constantnil| 1218,35719 +(defconstant |InternalRegisterConstantNIL| 1219,35772 +(defconstant |internalregister|$k-|constantt| 1221,35821 +(defconstant |InternalRegisterConstantT| 1222,35872 +(defconstant |coprocessorregister|$k-|microsecondclock| 1224,35919 +(defconstant |CoprocessorRegisterMicrosecondClock| 1225,35980 +(defconstant |coprocessorregister|$k-|hostinterrupt| 1227,36037 +(defconstant |CoprocessorRegisterHostInterrupt| 1228,36095 +(defconstant |coprocessorregister|$k-|vmregistercommand| 1230,36149 +(defconstant |CoprocessorRegisterVMRegisterCommand| 1231,36211 +(defconstant |coprocessorregister|$k-|vmregisteraddress| 1233,36269 +(defconstant |CoprocessorRegisterVMRegisterAddress| 1234,36331 +(defconstant |coprocessorregister|$k-|vmregisterextent| 1236,36389 +(defconstant |CoprocessorRegisterVMRegisterExtent| 1237,36450 +(defconstant |coprocessorregister|$k-|vmregisterattributes| 1239,36507 +(defconstant |CoprocessorRegisterVMRegisterAttributes| 1240,36572 +(defconstant |coprocessorregister|$k-|vmregisterdestination| 1242,36633 +(defconstant |CoprocessorRegisterVMRegisterDestination| 1243,36699 +(defconstant |coprocessorregister|$k-|vmregisterdata| 1245,36761 +(defconstant |CoprocessorRegisterVMRegisterData| 1246,36820 +(defconstant |coprocessorregister|$k-|vmregistermasklow| 1248,36875 +(defconstant |CoprocessorRegisterVMRegisterMaskLow| 1249,36937 +(defconstant |coprocessorregister|$k-|vmregistermaskhigh| 1251,36995 +(defconstant |CoprocessorRegisterVMRegisterMaskHigh| 1252,37058 +(defconstant |coprocessorregister|$k-|vmregistercommandblock| 1254,37117 +(defconstant |CoprocessorRegisterVMRegisterCommandBlock| 1255,37184 +(defconstant |coprocessorregister|$k-|stackswitch| 1257,37247 +(defconstant |CoprocessorRegisterStackSwitch| 1258,37303 +(defconstant |coprocessorregister|$k-|flushstackcache| 1260,37355 +(defconstant |CoprocessorRegisterFlushStackCache| 1261,37415 +(defconstant |coprocessorregister|$k-|flushidcaches| 1263,37471 +(defconstant |CoprocessorRegisterFlushIDCaches| 1264,37529 +(defconstant |coprocessorregister|$k-|calendarclock| 1266,37583 +(defconstant |CoprocessorRegisterCalendarClock| 1267,37641 +(defconstant |coprocessorregister|$k-|flushcachesforvma| 1269,37695 +(defconstant |CoprocessorRegisterFlushCachesForVMA| 1270,37757 +(defconstant |coprocessorregister|$k-|fliptostack| 1272,37815 +(defconstant |CoprocessorRegisterFlipToStack| 1273,37871 +(defconstant |coprocessorregister|$k-|unwindstackforrestartorapply| 1275,37923 +(defconstant |CoprocessorRegisterUnwindStackForRestartOrApply| 1276,37996 +(defconstant |coprocessorregister|$k-|saveworld| 1278,38065 +(defconstant |CoprocessorRegisterSaveWorld| 1279,38119 +(defconstant |coprocessorregister|$k-|consoleinputavailablep| 1281,38169 +(defconstant |CoprocessorRegisterConsoleInputAvailableP| 1282,38236 +(defconstant |coprocessorregister|$k-|waitforevent| 1284,38299 +(defconstant |CoprocessorRegisterWaitForEvent| 1285,38356 +(defconstant |coprocessorregister|$k-|flushhiddenarrayregisters| 1287,38409 +(defconstant |CoprocessorRegisterFlushHiddenArrayRegisters| 1288,38479 +(defconstant |coprocessorregister|$k-|consoleio| 1290,38545 +(defconstant |CoprocessorRegisterConsoleIO| 1291,38599 +(defconstant |coprocessorregister|$k-|attachdiskchannel| 1293,38649 +(defconstant |CoprocessorRegisterAttachDiskChannel| 1294,38711 +(defconstant |coprocessorregister|$k-|growdiskpartition| 1296,38769 +(defconstant |CoprocessorRegisterGrowDiskPartition| 1297,38831 +(defconstant |coprocessorregister|$k-|detachdiskchannel| 1299,38889 +(defconstant |CoprocessorRegisterDetachDiskChannel| 1300,38951 +(defconstant |coprocessorregister|$k-|unixcrypt| 1302,39009 +(defconstant |CoprocessorRegisterUnixCrypt| 1303,39063 +(defconstant |address|$k-nil 1305,39113 +(defconstant |AddressNIL| 1306,39154 +(defconstant |address|$k-t 1308,39193 +(defconstant |AddressT| 1309,39232 +(defconstant |alucondition|$k-|signedlessthanorequal| 1311,39269 +(defconstant |ALUConditionSignedLessThanOrEqual| 1312,39326 +(defconstant |alucondition|$k-|signedlessthan| 1314,39379 +(defconstant |ALUConditionSignedLessThan| 1315,39429 +(defconstant |alucondition|$k-|negative| 1317,39475 +(defconstant |ALUConditionNegative| 1318,39519 +(defconstant |alucondition|$k-|signedoverflow| 1320,39559 +(defconstant |ALUConditionSignedOverflow| 1321,39609 +(defconstant |alucondition|$k-|unsignedlessthanorequal| 1323,39655 +(defconstant |ALUConditionUnsignedLessThanOrEqual| 1324,39714 +(defconstant |alucondition|$k-|unsignedlessthan| 1326,39769 +(defconstant |ALUConditionUnsignedLessThan| 1327,39821 +(defconstant |alucondition|$k-|zero| 1329,39869 +(defconstant |ALUConditionZero| 1330,39909 +(defconstant |alucondition|$k-|high25zero| 1332,39945 +(defconstant |ALUConditionHigh25Zero| 1333,39991 +(defconstant |alucondition|$k-|eq| 1335,40033 +(defconstant |ALUConditionEq| 1336,40071 +(defconstant |alucondition|$k-|op1ephemeralp| 1338,40105 +(defconstant |ALUConditionOp1Ephemeralp| 1339,40154 +(defconstant |alucondition|$k-|op1typeacceptable| 1341,40199 +(defconstant |ALUConditionOp1TypeAcceptable| 1342,40253 +(defconstant |alucondition|$k-|op1typecondition| 1344,40303 +(defconstant |ALUConditionOp1TypeCondition| 1345,40356 +(defconstant |alucondition|$k-|resulttypenil| 1347,40405 +(defconstant |ALUConditionResultTypeNil| 1348,40455 +(defconstant |alucondition|$k-|op2fixnum| 1350,40501 +(defconstant |ALUConditionOp2Fixnum| 1351,40547 +(defconstant |alucondition|$k-|false| 1353,40589 +(defconstant |ALUConditionFalse| 1354,40631 +(defconstant |alucondition|$k-|resultcdrlow| 1356,40669 +(defconstant |ALUConditionResultCdrLow| 1357,40718 +(defconstant |alucondition|$k-|cleanupbitsset| 1359,40763 +(defconstant |ALUConditionCleanupBitsSet| 1360,40814 +(defconstant |alucondition|$k-|addressinstackcache| 1362,40861 +(defconstant |ALUConditionAddressInStackCache| 1363,40917 +(defconstant |alucondition|$k-|pendingsequencebreakenabled| 1365,40969 +(defconstant |ALUConditionPendingSequenceBreakEnabled| 1366,41033 +(defconstant |alucondition|$k-|extrastackmode| 1368,41093 +(defconstant |ALUConditionExtraStackMode| 1369,41144 +(defconstant |alucondition|$k-|fepmode| 1371,41191 +(defconstant |ALUConditionFepMode| 1372,41235 +(defconstant |alucondition|$k-|fpcoprocessorpresent| 1374,41275 +(defconstant |ALUConditionFpCoprocessorPresent| 1375,41332 +(defconstant |alucondition|$k-|op1oldspacep| 1377,41385 +(defconstant |ALUConditionOp1Oldspacep| 1378,41434 +(defconstant |alucondition|$k-|stackcacheoverflow| 1380,41479 +(defconstant |ALUConditionStackCacheOverflow| 1381,41534 +(defconstant |alucondition|$k-|orlogicvariable| 1383,41585 +(defconstant |ALUConditionOrLogicVariable| 1384,41637 +(defconstant |aluadderop2|$k-|op2| 1386,41685 +(defconstant |ALUAdderOp2Op2| 1387,41723 +(defconstant |aluadderop2|$k-|zero| 1389,41757 +(defconstant |ALUAdderOp2Zero| 1390,41796 +(defconstant |aluadderop2|$k-|invert| 1392,41831 +(defconstant |ALUAdderOp2Invert| 1393,41872 +(defconstant |aluadderop2|$k-|minusone| 1395,41909 +(defconstant |ALUAdderOp2MinusOne| 1396,41952 +(defconstant |alubytefunction|$k-|dpb| 1398,41991 +(defconstant |ALUByteFunctionDpb| 1399,42033 +(defconstant |alubytefunction|$k-|ldb| 1401,42071 +(defconstant |ALUByteFunctionLdb| 1402,42113 +(defconstant |alubytebackground|$k-|op1| 1404,42151 +(defconstant |ALUByteBackgroundOp1| 1405,42195 +(defconstant |alubytebackground|$k-|rotatelatch| 1407,42235 +(defconstant |ALUByteBackgroundRotateLatch| 1408,42287 +(defconstant |alubytebackground|$k-|zero| 1410,42335 +(defconstant |ALUByteBackgroundZero| 1411,42380 +(defconstant |boole|$k-|clear| 1413,42421 +(defconstant |BooleClear| 1414,42455 +(defconstant |boole|$k-|and| 1416,42485 +(defconstant |BooleAnd| 1417,42517 +(defconstant |boole|$k-|andc1| 1419,42545 +(defconstant |BooleAndC1| 1420,42579 +(defconstant |boole|$k-|2| 1422,42609 +(defconstant |Boole2| 1423,42639 +(defconstant |boole|$k-|andc2| 1425,42665 +(defconstant |BooleAndC2| 1426,42699 +(defconstant |boole|$k-|1| 1428,42729 +(defconstant |Boole1| 1429,42759 +(defconstant |boole|$k-|xor| 1431,42785 +(defconstant |BooleXor| 1432,42817 +(defconstant |boole|$k-|ior| 1434,42845 +(defconstant |BooleIor| 1435,42877 +(defconstant |boole|$k-|nor| 1437,42905 +(defconstant |BooleNor| 1438,42937 +(defconstant |boole|$k-|equiv| 1440,42965 +(defconstant |BooleEquiv| 1441,42999 +(defconstant |boole|$k-c1 1443,43029 +(defconstant |BooleC1| 1444,43059 +(defconstant |boole|$k-|orc1| 1446,43087 +(defconstant |BooleOrC1| 1447,43121 +(defconstant |boole|$k-c2 1449,43151 +(defconstant |BooleC2| 1450,43181 +(defconstant |boole|$k-|orc2| 1452,43209 +(defconstant |BooleOrC2| 1453,43243 +(defconstant |boole|$k-|nand| 1455,43273 +(defconstant |BooleNand| 1456,43307 +(defconstant |boole|$k-|set| 1458,43337 +(defconstant |BooleSet| 1459,43370 +(defconstant |alufunction|$k-|boolean| 1461,43399 +(defconstant |ALUFunctionBoolean| 1462,43441 +(defconstant |alufunction|$k-|byte| 1464,43479 +(defconstant |ALUFunctionByte| 1465,43518 +(defconstant |alufunction|$k-|adder| 1467,43553 +(defconstant |ALUFunctionAdder| 1468,43593 +(defconstant |alufunction|$k-|multiplydivide| 1470,43629 +(defconstant |ALUFunctionMultiplyDivide| 1471,43678 +(defconstant |cycle|$k-|dataread| 1473,43723 +(defconstant |CycleDataRead| 1474,43760 +(defconstant |cycle|$k-|datawrite| 1476,43793 +(defconstant |CycleDataWrite| 1477,43831 +(defconstant |cycle|$k-|bindread| 1479,43865 +(defconstant |CycleBindRead| 1480,43902 +(defconstant |cycle|$k-|bindwrite| 1482,43935 +(defconstant |CycleBindWrite| 1483,43973 +(defconstant |cycle|$k-|bindreadnomonitor| 1485,44007 +(defconstant |CycleBindReadNoMonitor| 1486,44053 +(defconstant |cycle|$k-|bindwritenomonitor| 1488,44095 +(defconstant |CycleBindWriteNoMonitor| 1489,44142 +(defconstant |cycle|$k-|header| 1491,44185 +(defconstant |CycleHeader| 1492,44220 +(defconstant |cycle|$k-|structureoffset| 1494,44251 +(defconstant |CycleStructureOffset| 1495,44295 +(defconstant |cycle|$k-|scavenge| 1497,44335 +(defconstant |CycleScavenge| 1498,44372 +(defconstant |cycle|$k-|cdr| 1500,44405 +(defconstant |CycleCdr| 1501,44437 +(defconstant |cycle|$k-|gccopy| 1503,44465 +(defconstant |CycleGCCopy| 1504,44501 +(defconstant |cycle|$k-|raw| 1506,44533 +(defconstant |CycleRaw| 1507,44566 +(defconstant |cycle|$k-|rawtranslate| 1509,44595 +(defconstant |CycleRawTranslate| 1510,44637 +(defconstant |memoryaction|$k-|none| 1512,44675 +(defconstant |MemoryActionNone| 1513,44715 +(defconstant |memoryaction|$k-|indirect| 1515,44751 +(defconstant |MemoryActionIndirect| 1516,44795 +(defconstant |memoryaction|$k-|monitor| 1518,44835 +(defconstant |MemoryActionMonitor| 1519,44878 +(defconstant |memoryaction|$k-|transport| 1521,44917 +(defconstant |MemoryActionTransport| 1522,44962 +(defconstant |memoryaction|$k-|trap| 1524,45003 +(defconstant |MemoryActionTrap| 1525,45043 +(defconstant |memoryaction|$k-|transform| 1527,45079 +(defconstant |MemoryActionTransform| 1528,45125 +(defconstant |memoryaction|$k-|binding| 1530,45167 +(defconstant |MemoryActionBinding| 1531,45211 +(defconstant |trapmode|$k-|emulator| 1533,45251 +(defconstant |TrapModeEmulator| 1534,45291 +(defconstant |trapmode|$k-|extrastack| 1536,45327 +(defconstant |TrapModeExtraStack| 1537,45369 +(defconstant |trapmode|$k-io 1539,45407 +(defconstant |TrapModeIO| 1540,45439 +(defconstant |trapmode|$k-fep 1542,45469 +(defconstant |TrapModeFEP| 1543,45502 +(defconstant |returnvalue|$k-|normal| 1545,45533 +(defconstant |ReturnValueNormal| 1546,45574 +(defconstant |returnvalue|$k-|exception| 1548,45611 +(defconstant |ReturnValueException| 1549,45655 +(defconstant |returnvalue|$k-|illegaloperand| 1551,45695 +(defconstant |ReturnValueIllegalOperand| 1552,45744 +(defconstant |haltreason|$k-|illinstn| 1554,45789 +(defconstant |HaltReasonIllInstn| 1555,45831 +(defconstant |haltreason|$k-|halted| 1557,45869 +(defconstant |HaltReasonHalted| 1558,45909 +(defconstant |haltreason|$k-|spycalled| 1560,45945 +(defconstant |HaltReasonSpyCalled| 1561,45988 +(defconstant |haltreason|$k-|fatalstackoverflow| 1563,46027 +(defconstant |HaltReasonFatalStackOverflow| 1564,46079 +(defconstant |haltreason|$k-|illegaltrapvector| 1566,46127 +(defconstant |HaltReasonIllegalTrapVector| 1567,46178 +(defconstant |trapreason|$k-|highprioritysequencebreak| 1569,46225 +(defconstant |TrapReasonHighPrioritySequenceBreak| 1570,46284 +(defconstant |trapreason|$k-|lowprioritysequencebreak| 1572,46339 +(defconstant |TrapReasonLowPrioritySequenceBreak| 1573,46397 +(defconstant |vmattribute|$k-|accessfault| 1575,46451 +(defconstant |VMAttributeAccessFault| 1576,46497 +(defconstant |vmattribute|$k-|writefault| 1578,46539 +(defconstant |VMAttributeWriteFault| 1579,46584 +(defconstant |vmattribute|$k-|transportfault| 1581,46625 +(defconstant |VMAttributeTransportFault| 1582,46674 +(defconstant |vmattribute|$k-|transportdisable| 1584,46719 +(defconstant |VMAttributeTransportDisable| 1585,46770 +(defconstant |vmattribute|$k-|ephemeral| 1587,46817 +(defconstant |VMAttributeEphemeral| 1588,46862 +(defconstant |vmattribute|$k-|modified| 1590,46903 +(defconstant |VMAttributeModified| 1591,46947 +(defconstant |vmattribute|$k-|exists| 1593,46987 +(defconstant |VMAttributeExists| 1594,47029 +(defconstant |vmattribute|$k-|createddefault| 1596,47067 +(defconstant |VMAttributeCreatedDefault| 1597,47117 +(defconstant |memorypage|$k-|size| 1599,47163 +(defconstant |MemoryPageSize| 1600,47204 +(defconstant |memorypage|$k-|addressshift| 1602,47241 +(defconstant |MemoryPageAddressShift| 1603,47288 +(defconstant |doublefloatop|$k-|add| 1605,47331 +(defconstant |DoubleFloatOpAdd| 1606,47371 +(defconstant |doublefloatop|$k-|sub| 1608,47407 +(defconstant |DoubleFloatOpSub| 1609,47447 +(defconstant |doublefloatop|$k-|multiply| 1611,47483 +(defconstant |DoubleFloatOpMultiply| 1612,47528 +(defconstant |doublefloatop|$k-|divide| 1614,47569 +(defconstant |DoubleFloatOpDivide| 1615,47612 + +emulator/errortbl.lisp,71 +(defvar *all-conditions*11,297 +(defvar *vma-valid-conditions*99,3602 + +emulator/support-sysdcl.lisp,86 +(defsystem alpha-axp-emulator-support3,85 +(defsystem powerpc-emulator-support16,654 + +emulator/sysdcl.lisp,37 +(defsystem alpha-ivory-emulator3,85 + +emulator/traps.lisp,4218 +(defconstant |trapvector|$k-|stackoverflow| 12,344 +(defconstant |TrapVectorStackOverflow| 13,394 +(defconstant |trapvector|$k-|instructionexception| 15,440 +(defconstant |TrapVectorInstructionException| 16,497 +(defconstant |trapvector|$k-|arithmeticinstructionexception| 18,550 +(defconstant |TrapVectorArithmeticInstructionException| 19,614 +(defconstant |trapvector|$k-|error| 21,674 +(defconstant |TrapVectorError| 22,716 +(defconstant |trapvector|$k-|reset| 24,754 +(defconstant |TrapVectorReset| 25,796 +(defconstant |trapvector|$k-|pullapplyargs| 27,834 +(defconstant |TrapVectorPullApplyArgs| 28,884 +(defconstant |trapvector|$k-|trace| 30,930 +(defconstant |TrapVectorTrace| 31,972 +(defconstant |trapvector|$k-|preemptrequest| 33,1010 +(defconstant |TrapVectorPreemptRequest| 34,1061 +(defconstant |trapvector|$k-|lowprioritysequencebreak| 36,1108 +(defconstant |TrapVectorLowPrioritySequenceBreak| 37,1169 +(defconstant |trapvector|$k-|highprioritysequencebreak| 39,1226 +(defconstant |TrapVectorHighPrioritySequenceBreak| 40,1288 +(defconstant |trapvector|$k-|dbunwindframe| 42,1346 +(defconstant |TrapVectorDBUnwindFrame| 43,1396 +(defconstant |trapvector|$k-|dbunwindcatch| 45,1442 +(defconstant |TrapVectorDBUnwindCatch| 46,1492 +(defconstant |trapvector|$k-|transport| 48,1538 +(defconstant |TrapVectorTransport| 49,1584 +(defconstant |trapvector|$k-|monitor| 51,1626 +(defconstant |TrapVectorMonitor| 52,1670 +(defconstant |trapvector|$k-|pagenotresident| 54,1710 +(defconstant |TrapVectorPageNotResident| 55,1762 +(defconstant |trapvector|$k-|pagefaultrequest| 57,1810 +(defconstant |TrapVectorPageFaultRequest| 58,1863 +(defconstant |trapvector|$k-|pagewritefault| 60,1912 +(defconstant |TrapVectorPageWriteFault| 61,1963 +(defconstant |trapvector|$k-|uncorrectablememoryerror| 63,2010 +(defconstant |TrapVectorUncorrectableMemoryError| 64,2071 +(defconstant |trapvector|$k-|memorybuserror| 66,2128 +(defconstant |TrapVectorMemoryBusError| 67,2179 +(defconstant |trapvector|$k-|dbcachemiss| 69,2226 +(defconstant |TrapVectorDBCacheMiss| 70,2274 +(defconstant |trapmeter|$k-|stackoverflow| 72,2318 +(defconstant |TrapMeterStackOverflow| 73,2364 +(defconstant |trapmeter|$k-|instructionexception| 75,2406 +(defconstant |TrapMeterInstructionException| 76,2459 +(defconstant |trapmeter|$k-|arithmeticinstructionexception| 78,2508 +(defconstant |TrapMeterArithmeticInstructionException| 79,2571 +(defconstant |trapmeter|$k-|error| 81,2630 +(defconstant |TrapMeterError| 82,2668 +(defconstant |trapmeter|$k-|reset| 84,2702 +(defconstant |TrapMeterReset| 85,2740 +(defconstant |trapmeter|$k-|pullapplyargs| 87,2774 +(defconstant |TrapMeterPullApplyArgs| 88,2820 +(defconstant |trapmeter|$k-|trace| 90,2862 +(defconstant |TrapMeterTrace| 91,2900 +(defconstant |trapmeter|$k-|preemptrequest| 93,2934 +(defconstant |TrapMeterPreemptRequest| 94,2981 +(defconstant |trapmeter|$k-|lowprioritysequencebreak| 96,3024 +(defconstant |TrapMeterLowPrioritySequenceBreak| 97,3081 +(defconstant |trapmeter|$k-|highprioritysequencebreak| 99,3134 +(defconstant |TrapMeterHighPrioritySequenceBreak| 100,3192 +(defconstant |trapmeter|$k-|dbunwindframe| 102,3246 +(defconstant |TrapMeterDBUnwindFrame| 103,3293 +(defconstant |trapmeter|$k-|dbunwindcatch| 105,3336 +(defconstant |TrapMeterDBUnwindCatch| 106,3383 +(defconstant |trapmeter|$k-|transport| 108,3426 +(defconstant |TrapMeterTransport| 109,3469 +(defconstant |trapmeter|$k-|monitor| 111,3508 +(defconstant |TrapMeterMonitor| 112,3549 +(defconstant |trapmeter|$k-|pagenotresident| 114,3586 +(defconstant |TrapMeterPageNotResident| 115,3635 +(defconstant |trapmeter|$k-|pagefaultrequest| 117,3680 +(defconstant |TrapMeterPageFaultRequest| 118,3730 +(defconstant |trapmeter|$k-|pagewritefault| 120,3776 +(defconstant |TrapMeterPageWriteFault| 121,3824 +(defconstant |trapmeter|$k-|uncorrectablememoryerror| 123,3868 +(defconstant |TrapMeterUncorrectableMemoryError| 124,3926 +(defconstant |trapmeter|$k-|memorybuserror| 126,3980 +(defconstant |TrapMeterMemoryBusError| 127,4028 +(defconstant |trapmeter|$k-|dbcachemiss| 129,4072 +(defconstant |TrapMeterDBCacheMiss| 130,4117 +(defconstant |trapmeter|$k-|nentries| 132,4158 +(defconstant |TrapMeterNEntries| 133,4200 + +emulator/usagedatarpt.lisp,34 +(defun report-on-usage-data 5,86 + +g5-emulator/aistat.lisp,13919 +(defconstant processorstate$q-transpare3 14,376 +(defconstant processorstate$q-transpare2 15,424 +(defconstant processorstate$q-transpare1 16,472 +(defconstant processorstate$q-carcdrsubroutine 17,520 +(defconstant processorstate$q-cdrsubroutine 18,574 +(defconstant processorstate$q-carsubroutine 19,625 +(defconstant processorstate$q-linkage 20,676 +(defconstant processorstate$q-resumeema 21,721 +(defconstant processorstate$p-statistics 22,768 +(defconstant processorstate$p-trace-hook 23,816 +(defconstant processorstate$q-instruction-count 24,864 +(defconstant processorstate$q-iinterpret-sp 25,919 +(defconstant processorstate$q-scratch0 26,970 +(defconstant processorstate$q-scratch1 27,1016 +(defconstant processorstate$q-scratch2 28,1062 +(defconstant processorstate$q-scratch3 29,1108 +(defconstant processorstate$q-scratch4 30,1154 +(defconstant processorstate$q-scratch5 31,1200 +(defconstant processorstate$q-scratch6 32,1246 +(defconstant processorstate$q-scratch7 33,1292 +(defconstant processorstate$p-meterdatabuff 34,1338 +(defconstant processorstate$l-meterpos 35,1389 +(defconstant processorstate$l-metermax 36,1435 +(defconstant processorstate$l-meterfreq 37,1481 +(defconstant processorstate$l-metermask 38,1528 +(defconstant processorstate$l-metervalue 39,1575 +(defconstant processorstate$l-metercount 40,1623 +(defconstant processorstate$q-choiceptr 41,1671 +(defconstant processorstate$q-sstkchoiceptr 42,1718 +(defconstant processorstate$q-dbcbase 43,1769 +(defconstant processorstate$q-dbcmask 44,1814 +(defconstant processorstate$p-coprocessorreadhook 45,1859 +(defconstant processorstate$p-coprocessorwritehook 46,1916 +(defconstant processorstate$p-flushcaches-hook 47,1974 +(defconstant processorstate$p-i-stage-error-hook 48,2028 +(defconstant processorstate$q-sfp1 49,2084 +(defconstant processorstate$q-fp0 50,2126 +(defconstant processorstate$q-fp1 51,2167 +(defconstant processorstate$q-floating-exception 52,2208 +(defconstant processorstate$q-aluandrotatecontrol 53,2264 +(defconstant processorstate$q-rotatelatch 54,2321 +(defconstant processorstate$q-aluborrow 55,2370 +(defconstant processorstate$q-aluoverflow 56,2417 +(defconstant processorstate$q-alulessthan 57,2466 +(defconstant processorstate$q-aluop 58,2515 +(defconstant processorstate$q-byterotate 59,2558 +(defconstant processorstate$q-bytesize 60,2606 +(defconstant processorstate$q-bindingstacklimit 61,2652 +(defconstant processorstate$q-bindingstackpointer 62,2706 +(defconstant processorstate$q-catchblock 63,2762 +(defconstant processorstate$q-extraandcatch 64,2809 +(defconstant processorstate$q-msclockcache 65,2859 +(defconstant processorstate$q-ticksperms 66,2908 +(defconstant processorstate$q-previoustb 67,2955 +(defconstant processorstate$p-rlink 68,3002 +(defconstant processorstate$l-interruptreg 69,3044 +(defconstant processorstate$l-zoneoldspace 70,3093 +(defconstant processorstate$l-ephemeraloldspace 71,3142 +(defconstant processorstate$l-int-pad0 72,3196 +(defconstant processorstate$q-eqnoteql 73,3241 +(defconstant processorstate$l-lclength 74,3286 +(defconstant processorstate$l-sclength 75,3331 +(defconstant processorstate$q-lcarea 76,3376 +(defconstant processorstate$q-lcaddress 77,3419 +(defconstant processorstate$q-scarea 78,3465 +(defconstant processorstate$q-scaddress 79,3508 +(defconstant processorstate$q-restartsp 80,3554 +(defconstant processorstate$q-stop-interpreter 81,3600 +(defconstant processorstate$q-immediate-arg 82,3653 +(defconstant processorstate$q-continuationcp 83,3703 +(defconstant processorstate$q-continuation 84,3754 +(defconstant processorstate$q-control 85,3803 +(defconstant processorstate$q-niladdress 86,3847 +(defconstant processorstate$q-taddress 87,3894 +(defconstant processorstate$q-bar0 88,3939 +(defconstant processorstate$q-bar1 89,3980 +(defconstant processorstate$q-bar2 90,4021 +(defconstant processorstate$q-bar3 91,4062 +(defconstant processorstate$q-epc 92,4103 +(defconstant processorstate$q-fp 93,4143 +(defconstant processorstate$q-lp 94,4182 +(defconstant processorstate$q-sp 95,4221 +(defconstant processorstate$p-cp 96,4260 +(defconstant processorstate$q-fccrmask 97,4299 +(defconstant processorstate$l-cslimit 98,4344 +(defconstant processorstate$l-csextralimit 99,4388 +(defconstant processorstate$p-trapmeterdata 100,4437 +(defconstant processorstate$q-fepmodetrapvecaddress 101,4487 +(defconstant processorstate$q-trapvecbase 102,4545 +(defconstant processorstate$q-tvi 103,4593 +(defconstant processorstate$q-fccrtrapmask 104,4633 +(defconstant processorstate$p-ptrtype 105,4682 +(defconstant processorstate$p-vmattributetable 106,4726 +(defconstant processorstate$q-vma 107,4779 +(defconstant processorstate$q-mostnegativefixnum 108,4819 +(defconstant processorstate$p-icachebase 109,4874 +(defconstant processorstate$p-endicache 110,4921 +(defconstant processorstate$q-fullworddispatch 111,4967 +(defconstant processorstate$q-halfworddispatch 112,5020 +(defconstant processorstate$q-areventcount 113,5073 +(defconstant processorstate$q-stackcachesize 114,5122 +(defconstant processorstate$q-stackcachetopvma 115,5173 +(defconstant processorstate$q-cdrcodemask 116,5226 +(defconstant processorstate$p-stackcachedata 117,5274 +(defconstant processorstate$q-stackcachebasevma 118,5325 +(defconstant processorstate$l-scovlimit 119,5379 +(defconstant processorstate$l-scovdumpcount 120,5425 +(defconstant processorstate$q-mostpositivefixnum 121,5475 +(defconstant processorstate$q-internalregisterread1 122,5530 +(defconstant processorstate$q-internalregisterread2 123,5588 +(defconstant processorstate$q-internalregisterwrite1 124,5646 +(defconstant processorstate$q-internalregisterwrite2 125,5705 +(defconstant processorstate$q-dataread-mask 126,5764 +(defconstant processorstate$p-dataread 127,5814 +(defconstant processorstate$q-datawrite-mask 128,5859 +(defconstant processorstate$p-datawrite 129,5910 +(defconstant processorstate$q-bindread-mask 130,5956 +(defconstant processorstate$p-bindread 131,6006 +(defconstant processorstate$q-bindwrite-mask 132,6051 +(defconstant processorstate$p-bindwrite 133,6102 +(defconstant processorstate$q-bindreadnomonitor-mask 134,6148 +(defconstant processorstate$p-bindreadnomonitor 135,6207 +(defconstant processorstate$q-bindwritenomonitor-mask 136,6261 +(defconstant processorstate$p-bindwritenomonitor 137,6321 +(defconstant processorstate$q-header-mask 138,6376 +(defconstant processorstate$p-header 139,6424 +(defconstant processorstate$q-structureoffset-mask 140,6467 +(defconstant processorstate$p-structureoffset 141,6524 +(defconstant processorstate$q-scavenge-mask 142,6576 +(defconstant processorstate$p-scavenge 143,6626 +(defconstant processorstate$q-cdr-mask 144,6671 +(defconstant processorstate$p-cdr 145,6716 +(defconstant processorstate$q-gccopy-mask 146,6756 +(defconstant processorstate$p-gccopy 147,6804 +(defconstant processorstate$q-raw-mask 148,6847 +(defconstant processorstate$p-raw 149,6892 +(defconstant processorstate$q-rawtranslate-mask 150,6932 +(defconstant processorstate$p-rawtranslate 151,6986 +(defconstant processorstate$l-please-stop 152,7035 +(defconstant processorstate$l-please-trap 153,7083 +(defconstant processorstate$q-runningp 154,7131 +(defconstant processorstate$q-ac0array 155,7176 +(defconstant processorstate$q-ac0arword 156,7221 +(defconstant processorstate$q-ac0locat 157,7267 +(defconstant processorstate$q-ac0length 158,7312 +(defconstant processorstate$q-ac1array 159,7358 +(defconstant processorstate$q-ac1arword 160,7403 +(defconstant processorstate$q-ac1locat 161,7449 +(defconstant processorstate$q-ac1length 162,7494 +(defconstant processorstate$q-ac2array 163,7540 +(defconstant processorstate$q-ac2arword 164,7585 +(defconstant processorstate$q-ac2locat 165,7631 +(defconstant processorstate$q-ac2length 166,7676 +(defconstant processorstate$q-ac3array 167,7722 +(defconstant processorstate$q-ac3arword 168,7767 +(defconstant processorstate$q-ac3locat 169,7813 +(defconstant processorstate$q-ac3length 170,7858 +(defconstant processorstate$q-ac4array 171,7904 +(defconstant processorstate$q-ac4arword 172,7949 +(defconstant processorstate$q-ac4locat 173,7995 +(defconstant processorstate$q-ac4length 174,8040 +(defconstant processorstate$q-ac5array 175,8086 +(defconstant processorstate$q-ac5arword 176,8131 +(defconstant processorstate$q-ac5locat 177,8177 +(defconstant processorstate$q-ac5length 178,8222 +(defconstant processorstate$q-ac6array 179,8268 +(defconstant processorstate$q-ac6arword 180,8312 +(defconstant processorstate$q-ac6locat 181,8357 +(defconstant processorstate$q-ac6length 182,8401 +(defconstant processorstate$q-ac7array 183,8446 +(defconstant processorstate$q-ac7arword 184,8490 +(defconstant processorstate$q-ac7locat 185,8535 +(defconstant processorstate$q-ac7length 186,8579 +(defconstant processorstate$l-tmcurrenttransaction 187,8624 +(defconstant processorstate$l-tmwritestart 188,8680 +(defconstant processorstate$l-tmwritecurrent 189,8728 +(defconstant processorstate$l-tmwritelimit 190,8778 +(defconstant processorstate$l-tmrecordingreads 191,8826 +(defconstant processorstate$l-tmreadstart 192,8878 +(defconstant processorstate$l-tmreadcurrent 193,8925 +(defconstant processorstate$l-tmreadlimit 194,8973 +(defconstant processorstate$k-size 196,9020 +(defconstant |PROCESSORSTATESIZE| 197,9061 +(defconstant cacheline$q-annotation 201,9127 +(defconstant cacheline$l-nextpcdata 202,9166 +(defconstant cacheline$l-nextpctag 203,9205 +(defconstant cacheline$p-nextcp 204,9244 +(defconstant cacheline$l-instruction 205,9280 +(defconstant cacheline$l-operand 206,9321 +(defconstant cacheline$l-pcdata 207,9358 +(defconstant cacheline$l-pctag 208,9394 +(defconstant cacheline$p-code 209,9429 +(defconstant cacheline$k-size 211,9464 +(defconstant |CACHELINESIZE| 212,9498 +(defparameter |cacheline|$k-|bits| 214,9532 +(defparameter |CacheLineBits| 215,9571 +(defparameter |cacheline|$k-|mask| 217,9606 +(defparameter |CacheLineMask| 218,9649 +(defparameter |cacheline|$k-|rshift| 220,9688 +(defparameter |CacheLineRShift| 221,9729 +(defparameter |cacheline|$k-|lshift| 223,9766 +(defparameter |CacheLineLShift| 224,9806 +(defparameter |cacheline|$k-|fillamount| 226,9842 +(defparameter |CacheLineFillAmount| 227,9887 +(defconstant arraycache$q-array 231,9954 +(defconstant arraycache$q-arword 232,9989 +(defconstant arraycache$q-locat 233,10025 +(defconstant arraycache$q-length 234,10061 +(defparameter |autoarrayreg|$k-|mask| 236,10099 +(defparameter |AutoArrayRegMask| 237,10142 +(defparameter |autoarrayreg|$k-|size| 239,10181 +(defparameter |AutoArrayRegSize| 240,10223 +(defparameter |autoarrayreg|$k-|shift| 242,10261 +(defparameter |AutoArrayRegShift| 243,10303 +(defparameter |msclock|$k-|unitstomsshift| 245,10341 +(defparameter |MSclockUnitsToMSShift| 246,10387 +(defparameter |msclock|$k-|unitspermicrosecond| 248,10429 +(defparameter |MSclockUnitsPerMicrosecond| 249,10480 +(defparameter |stack|$k-|cachesize| 251,10527 +(defparameter |StackCacheSize| 252,10569 +(defparameter |stack|$k-|maxframesize| 254,10607 +(defparameter |StackMaxFrameSize| 255,10651 +(defparameter |stack|$k-|cachemargin| 257,10691 +(defparameter |StackCacheMargin| 258,10734 +(defparameter |stack|$k-|cachedumpquantum| 260,10773 +(defparameter |StackCacheDumpQuantum| 261,10821 +(defconstant |ivorymemory|$k-|data| 263,10865 +(defconstant |IvoryMemoryData| 264,10905 +(defconstant |ivorymemory|$k-|tag| 266,10941 +(defconstant |IvoryMemoryTag| 267,10980 +(defconstant savedregisters$q-r9 271,11045 +(defconstant savedregisters$q-r10 272,11081 +(defconstant savedregisters$q-r11 273,11118 +(defconstant savedregisters$q-r12 274,11156 +(defconstant savedregisters$q-r13 275,11194 +(defconstant savedregisters$q-r14 276,11232 +(defconstant savedregisters$q-r15 277,11270 +(defconstant savedregisters$q-r29 278,11308 +(defconstant savedregisters$q-f2 279,11346 +(defconstant savedregisters$q-f3 280,11383 +(defconstant savedregisters$q-f4 281,11420 +(defconstant savedregisters$q-f5 282,11457 +(defconstant savedregisters$q-f6 283,11494 +(defconstant savedregisters$q-f7 284,11531 +(defconstant savedregisters$q-f8 285,11569 +(defconstant savedregisters$q-f9 286,11607 +(defconstant savedregisters$k-size 288,11646 +(defconstant |SAVEDREGISTERSSIZE| 289,11686 +(defconstant tracedata$q-n_entries 293,11751 +(defconstant tracedata$l-recording_p 294,11789 +(defconstant tracedata$l-wrap_p 295,11829 +(defconstant tracedata$q-start_pc 296,11865 +(defconstant tracedata$q-stop_pc 297,11903 +(defconstant tracedata$p-records_start 298,11940 +(defconstant tracedata$p-records_end 299,11983 +(defconstant tracedata$p-current_entry 300,12024 +(defconstant tracedata$p-printer 301,12067 +(defconstant tracedata$k-size 303,12105 +(defconstant |TRACEDATASIZE| 304,12139 +(defconstant tracerecord$q-counter 308,12200 +(defconstant tracerecord$q-epc 309,12238 +(defconstant tracerecord$q-tos 310,12272 +(defconstant tracerecord$q-sp 311,12307 +(defconstant tracerecord$p-instruction 312,12341 +(defconstant tracerecord$q-instruction_data 313,12384 +(defconstant tracerecord$l-operand 314,12432 +(defconstant tracerecord$l-trap_p 315,12471 +(defconstant tracerecord$q-trap_data_0 316,12509 +(defconstant tracerecord$q-trap_data_1 317,12552 +(defconstant tracerecord$q-trap_data_2 318,12595 +(defconstant tracerecord$q-trap_data_3 319,12638 +(defconstant tracerecord$l-catch_block_p 320,12681 +(defconstant tracerecord$l-int-pad0 321,12726 +(defconstant tracerecord$q-catch_block_0 322,12766 +(defconstant tracerecord$q-catch_block_1 323,12811 +(defconstant tracerecord$q-catch_block_2 324,12857 +(defconstant tracerecord$q-catch_block_3 325,12903 +(defconstant tracerecord$k-size 327,12950 +(defconstant |TRACERECORDSIZE| 328,12987 +(defparameter |cachemeter|$k-|pwr| 330,13024 +(defparameter |CacheMeterPwr| 331,13063 +(defparameter |cachemeter|$k-|defaultfreq| 333,13098 +(defparameter |CacheMeterDefaultFreq| 334,13147 + +g5-emulator/fcallmac.lisp,897 +(defmacro set-continuation2 5,131 +(defmacro set-continuation2r 9,327 +(defmacro get-continuation2 13,524 +(defmacro set-continuation 18,750 +(defmacro get-continuation 21,884 +(defmacro get-control-register 24,1017 +(defmacro set-control-register 27,1152 +(defmacro push-frame 34,1409 +(defmacro start-call-dispatch 57,2589 +(defmacro start-call-compiled 157,7057 +(defmacro start-call-lexical-closure167,7529 +(defmacro start-call-escape 180,8201 +(defmacro finish-call-guts 198,9084 +(defmacro b-apply-argument-supplied 254,12020 +(defmacro enter-function 284,13322 +(defmacro push-apply-args 296,13907 +(defmacro note-additional-spread-args 326,14967 +(defmacro pull-apply-args 342,15553 +(defmacro pull-apply-args-quickly 377,17065 +(defmacro pull-apply-args-slowly 464,20200 +(defmacro cleanup-frame 485,21291 +(defmacro do-unwind-protect 559,24321 +(defmacro abandon-frame-simple627,27503 + +g5-emulator/imacarra.lisp,942 +(defmacro check-array-header 8,231 +(defmacro check-array-prefix 14,423 +(defmacro check-array-header-and-prefix 21,662 +(defmacro check-array-bounds 30,1002 +(defmacro byte-packing-size 35,1154 +(defmacro byte-packing-mask 40,1296 +(defmacro byte-packing-mask-and-unmask-given-size 47,1524 +(defmacro byte-packing-modulus 54,1772 +(defmacro byte-packing-rotation 60,1949 +(defmacro byte-packing-modulus-and-rotation 67,2139 +(defmacro simple-case 77,2522 +(defmacro generate-array-element-ldb 187,6605 +(defmacro array-element-ldb 218,7887 +(defmacro array-element-ldb 232,8494 +(defmacro array-element-dpb 250,9298 +(defmacro array-element-dpb 286,11047 +(defmacro new-aref-1-internal 306,11891 +(defmacro aref-1-internal 399,15292 +(defmacro aset-1-internal 448,17443 +(defmacro recompute-array-register 517,20440 +(defmacro logical-shift 585,24110 +(defmacro setup-array-register 602,24875 +(defmacro setup-long-array-register 651,27003 + +g5-emulator/imacbind.lisp,24 +(defmacro unbind 9,281 + +g5-emulator/imacbits.lisp,64 +(defmacro ilogical 7,214 +(defmacro ilogical-immediate 27,1079 + +g5-emulator/imacblok.lisp,187 +(defmacro i%block-n-read 23,875 +(defmacro i%block-n-write 65,2504 +(defmacro i%block-n-read-shift 76,3134 +(defmacro i%block-n-read-alu 112,4874 +(defmacro i%block-n-read-test 157,6839 + +g5-emulator/imacfext.lisp,27 +(defmacro ldb-shift 7,151 + +g5-emulator/imacgene.lisp,237 +(defmacro verify-generic-arity 6,171 +(defmacro instance-descriptor-info 18,624 +(defmacro non-instance-descriptor-info 54,2264 +(defmacro lookup-handler 70,3012 +(defmacro generic-dispatch 104,4212 +(defmacro message-dispatch 128,5433 + +g5-emulator/imacialu.lisp,855 +(defmacro read-alu-condition 7,214 +(defmacro read-alu-condition-sense 12,360 +(defmacro read-alu-output-condition 17,515 +(defmacro read-alu-enable-condition-exception 22,672 +(defmacro read-alu-enable-load-con 27,839 +(defmacro read-alu-boolean-function 32,994 +(defmacro read-alu-byte-rotate 37,1157 +(defmacro read-alu-byte-size 41,1285 +(defmacro read-alu-byte-background 46,1430 +(defmacro read-alu-byte-rotate-latch 51,1585 +(defmacro read-alu-byte-function 56,1743 +(defmacro read-alu-adder-carry-in 61,1866 +(defmacro write-alu-adder-carry-in 66,2019 +(defmacro read-alu-adder-op2 74,2266 +(defmacro read-alu-function-class-bits 79,2403 +(defmacro alu-function-boolean 84,2566 +(defmacro alu-function-byte 121,3419 +(defmacro alu-function-adder 156,4687 +(defmacro alu-function-multiply-divide 194,6152 +(defmacro alu-compute-condition 198,6302 + +g5-emulator/imacinst.lisp,156 +(defmacro locate-instance-variable-mapped 8,234 +(defmacro locate-instance-variable-unmapped 51,2239 +(defmacro locate-arbitrary-instance-variable 59,2581 + +g5-emulator/imacjosh.lisp,553 +(defmacro get-structure-stack-pointer 7,209 +(defmacro set-structure-stack-pointer 10,296 +(defmacro get-structure-stack-pointer-data 13,384 +(defmacro set-structure-stack-pointer-data 17,500 +(defmacro get-structure-stack-pointer2 20,595 +(defmacro set-structure-stack-pointer2 25,777 +(defmacro get-trail-pointer 29,927 +(defmacro set-trail-pointer 32,1004 +(defmacro get-trail-pointer-data 35,1082 +(defmacro set-trail-pointer-data 39,1188 +(defmacro get-trail-pointer2 42,1273 +(defmacro set-trail-pointer2 47,1445 +(defmacro bind-location 60,1959 + +g5-emulator/imaclexi.lisp,45 +(defmacro compute-lexical-var-address 8,246 + +g5-emulator/imaclist.lisp,275 +(defmacro car-internal 8,263 +(defmacro cdr-internal 34,1048 +(defmacro carcdr-internal 74,2335 +(defmacro icar 133,4465 +(defmacro icdr 142,4887 +(defmacro isettocar 151,5309 +(defmacro isettocdr 163,5899 +(defmacro isettocdrpushcar 175,6479 +(defmacro carcdrloop 204,7812 + +g5-emulator/imacloop.lisp,117 +(defmacro ibranchcond 8,247 +(defmacro iloop-decrement-tos 43,1910 +(defmacro iloop-increment-tos-less-than 80,3267 + +g5-emulator/imacmath.lisp,958 +(defmacro floating-exception-checking-prelude 8,309 +(defmacro floating-exception-checking-postlude 17,643 +(defmacro with-floating-exception-checking 26,952 +(defmacro set-rounding-mode 32,1197 +(defmacro CheckFloatingOverflow 57,1811 +(defmacro CheckBinaryFloatingOverflow 63,2021 +(defmacro CheckNotNan 74,2359 +(defmacro DoDivisionRounding 81,2555 +(defmacro DoFloatingDivisionRounding 107,3620 +(defmacro cons-double-float-internal 151,5437 +(defmacro fetch-double-float-internal 166,6122 +(defmacro with-simple-binary-fixnum-operation 191,7492 +(defmacro simple-binary-arithmetic-operation 232,9230 +(defmacro simple-binary-immediate-arithmetic-operation 363,14362 +(defmacro binary-arithmetic-division-prelude 408,16135 +(defmacro binary-arithmetic-two-value-division-operation 510,19722 +(defmacro binary-arithmetic-one-value-division-operation 566,22320 +(defmacro simple-binary-minmax 618,24509 +(defmacro simple-binary-immediate-minmax 686,26777 + +g5-emulator/imacpred.lisp,259 +(defmacro simple-unary-arithmetic-predicate 10,409 +(defmacro simple-binary-arithmetic-predicate 57,1833 +(defmacro simple-binary-arithmetic-exceptions 129,4296 +(defmacro simple-binary-immediate-arithmetic-predicate 159,5438 +(defmacro itypemember 187,6293 + +g5-emulator/imacsubp.lisp,273 +(defmacro %allocate-internal 7,219 +(defmacro cons-internal 52,2083 +(defmacro i%allocate-block 68,2869 +(defmacro i%set-cdr-code-n 112,4677 +(defmacro refill-oldspace-table 121,5019 +(defmacro check-preempt-request 157,5977 +(defmacro internal-register-dispatch 172,6669 + +g5-emulator/imactrap.lisp,6161 +(defmacro prepare-trap 7,179 +(defmacro get-trap-vector-entry 26,1010 +(defmacro take-post-trap 64,2439 +(defmacro stack-overflow-handler 164,6509 +(defmacro take-pre-trap-1 178,6942 +(defmacro start-pre-trap 188,7443 +(defmacro take-pre-trap-2 214,8571 +(defmacro finish-pre-trap 219,8802 +(defmacro illegal-operand-handler 267,10915 +(defmacro reset-trap-handler 276,11315 +(defmacro pull-apply-args-trap-handler 283,11600 +(defmacro trace-trap-handler 294,12124 +(defmacro preempt-request-trap-handler 301,12409 +(defmacro high-priority-sequence-break-handler 308,12731 +(defmacro low-priority-sequence-break-handler 315,13094 +(defmacro db-unwind-frame-trap-handler 322,13453 +(defmacro db-unwind-catch-trap-handler 331,13871 +(defmacro take-memory-trap 344,14355 +(defmacro transport-trap-handler 350,14633 +(defmacro monitor-trap-handler 356,14828 +(defmacro page-not-resident-handler 362,15017 +(defmacro page-fault-request-handler 368,15227 +(defmacro page-write-fault-handler 374,15440 +(defmacro uncorrectable-memory-error-handler 380,15647 +(defmacro bus-error-handler 386,15884 +(defmacro db-cache-miss-trap-handler 392,16084 +(defvar *instruction-exception-info* 422,17502 +(defvar *ivory-instruction-opcode-table* 423,17578 +(defmacro define-instruction-exception 741,38554 +(defun define-instruction-exception-1 744,38711 +(defun instruction-exception-info 753,39055 +(define-instruction-exception car 763,39397 +(define-instruction-exception cdr 764,39449 +(define-instruction-exception set-to-car 765,39501 +(define-instruction-exception set-to-cdr 766,39565 +(define-instruction-exception set-to-cdr-push-car 767,39629 +(define-instruction-exception rplaca 768,39709 +(define-instruction-exception rplacd 769,39767 +(define-instruction-exception rgetf 770,39825 +(define-instruction-exception member 771,39881 +(define-instruction-exception assoc 772,39939 +(define-instruction-exception eql 773,39995 +(define-instruction-exception eql-no-pop 774,40059 +(define-instruction-exception equal-number 775,40135 +(define-instruction-exception equal-number-no-pop 776,40216 +(define-instruction-exception greaterp 777,40309 +(define-instruction-exception greaterp-no-pop 778,40384 +(define-instruction-exception lessp 779,40470 +(define-instruction-exception lessp-no-pop 780,40538 +(define-instruction-exception plusp 781,40618 +(define-instruction-exception minusp 782,40686 +(define-instruction-exception zerop 783,40756 +(define-instruction-exception logtest 784,40824 +(define-instruction-exception logtest-no-pop 785,40896 +(define-instruction-exception add 786,40980 +(define-instruction-exception sub 787,41044 +(define-instruction-exception unary-minus 788,41108 +(define-instruction-exception increment 789,41187 +(define-instruction-exception decrement 790,41251 +(define-instruction-exception multiply 791,41315 +(define-instruction-exception quotient 792,41389 +(define-instruction-exception ceiling 793,41463 +(define-instruction-exception floor 794,41535 +(define-instruction-exception truncate 795,41603 +(define-instruction-exception round 796,41677 +(define-instruction-exception rational-quotient 798,41801 +(define-instruction-exception double-float-op 799,41892 +(define-instruction-exception max 800,41978 +(define-instruction-exception min 801,42042 +(define-instruction-exception logand 802,42106 +(define-instruction-exception logior 803,42176 +(define-instruction-exception logxor 804,42246 +(define-instruction-exception ash 805,42316 +(define-instruction-exception ldb 806,42380 +(define-instruction-exception dpb 807,42439 +(define-instruction-exception aref-1 808,42498 +(define-instruction-exception aset-1 809,42555 +(define-instruction-exception aloc-1 810,42612 +(define-instruction-exception setup-1d-array 811,42669 +(define-instruction-exception setup-force-1d-array 812,42741 +(define-instruction-exception fast-aref-1 813,42824 +(define-instruction-exception fast-aset-1 814,42890 +(define-instruction-exception array-leader 815,42956 +(define-instruction-exception store-array-leader 816,43025 +(define-instruction-exception aloc-leader 817,43105 +(define-instruction-exception loop-decrement-tos 818,43172 +(define-instruction-exception loop-increment-tos-less-than 819,43259 +(define-instruction-exception block-0-read-alu 820,43364 +(define-instruction-exception block-1-read-alu 821,43439 +(define-instruction-exception block-2-read-alu 822,43514 +(define-instruction-exception block-3-read-alu 823,43589 +(define-instruction-exception allocate-list-block 824,43664 +(define-instruction-exception allocate-structure-block 825,43746 +(define-instruction-exception unify 826,43838 +(define-instruction-exception logic-tail-test 827,43894 +(define-instruction-exception push-address-sp-relative 828,43968 +(define-instruction-exception stack-blt 829,44059 +(define-instruction-exception stack-blt-address 830,44122 +(define-instruction-exception char-ldb 831,44200 +(define-instruction-exception char-dpb 832,44268 +(define-instruction-exception bind-locative-to-value 833,44336 +(define-instruction-exception bind-locative 834,44423 +(define-instruction-exception restore-binding-stack 835,44494 +(define-instruction-exception push-lexical-var 836,44580 +(define-instruction-exception pop-lexical-var 837,44656 +(define-instruction-exception movem-lexical-var 838,44730 +(define-instruction-exception instance-ref 839,44808 +(define-instruction-exception instance-set 840,44877 +(define-instruction-exception instance-loc 841,44946 +(define-instruction-exception push-instance-variable 842,45015 +(define-instruction-exception pop-instance-variable 843,45103 +(define-instruction-exception movem-instance-variable 844,45189 +(define-instruction-exception push-address-instance-variable 845,45279 +(define-instruction-exception block-0-read-test 846,45382 +(define-instruction-exception block-1-read-test 847,45466 +(define-instruction-exception block-2-read-test 848,45550 +(define-instruction-exception block-3-read-test 849,45634 +(define-instruction-exception alu 850,45718 +(defmacro prepare-exception862,46327 +(defmacro exception-handler 900,47803 +(defmacro exception-handler-common-tail 999,51636 + +g5-emulator/intrpmac.lisp,5641 +(defmacro check-temporaries 5,131 +(defvar *memoized-vmdata* 8,246 +(defvar *memoized-vmtags* 9,277 +(defvar *memoized-base* 10,308 +(defvar *memoized-limit* 11,338 +(defvar *memoized-action* 12,368 +(defvar *memoized-action-cycle* 13,399 +(defvar *cant-be-in-cache-p* 14,436 +(defvar *inhibit-alignment-in-memory-read* 17,508 +(defun check-temporaries-1 20,588 +(defmacro branch-true 43,1564 +(defmacro long-branch-true 46,1678 +(defmacro branch-false 49,1802 +(defmacro long-branch-false 52,1914 +(defmacro force-alignment 55,2036 +(defmacro PC-TO-iCACHEENT 64,2350 +(defmacro PC-TO-iCACHEENT 80,3129 +(defmacro convert-pc-to-continuation 97,4014 +(defmacro convert-continuation-to-pc 105,4334 +(defmacro SCAtoVMA 117,4773 +(defmacro VMAtoSCA 130,5253 +(defmacro VMAinStackCache 144,5695 +(defmacro VMAtoSCAmaybe 158,6429 +(defmacro TagTypeFromLispObj 180,7525 +(defmacro TagCdrFromLispObj 185,7700 +(defmacro PackedInstructionP 189,7886 +(defmacro TagType 201,8448 +(defmacro TagCdr 205,8577 +(defmacro SetTag 209,8700 +(defmacro CheckDataType 215,8931 +(defmacro CheckAdjacentDataTypes 223,9215 +(defmacro NumericTypeException 233,9692 +(defmacro UnaryNumericTypeException 237,9844 +(defmacro SpareTypeException 241,10006 +(defmacro ListTypeException 246,10190 +(defmacro ArrayTypeException 253,10502 +(defmacro maybe-icount 258,10686 +(defmacro maybe-statistics 268,11091 +(defmacro maybe-meter-hit 280,11679 +(defmacro maybe-meter-miss 309,13009 +(defun show-icache-histogram 341,14452 +(defmacro maybe-meter-trap 379,15956 +(defmacro maybe-trace 388,16320 +(defmacro ContinueToInterpretInstruction 468,20763 +(defmacro ContinueToInterpretInstruction-ValidateCache 473,20993 +(defmacro ContinueToNextInstruction 482,21549 +(defmacro GetNextPC 486,21726 +(defmacro PrefetchNextPC 489,21792 +(defmacro SetNextPC 492,21869 +(defmacro GetNextCP 495,21919 +(defmacro PrefetchNextCP 498,21981 +(defmacro SetNextCP 501,22054 +(defmacro GetNextPCandCP 504,22104 +(defmacro ContinueToNextInstruction-NoStall 510,22361 +(defmacro instruction-exception 514,22541 +(defmacro arithmetic-exception 517,22655 +(defmacro illegal-operand 521,22835 +(defmacro illegal-instruction 525,22999 +(defmacro halt-machine 528,23120 +(defmacro with-predicate-store 542,23695 +(defmacro with-predicate-push 566,24742 +(defmacro align4k 592,25620 +(defmacro align4Kskip8K 598,25851 +(defmacro align4kskip4k 605,26033 +(defmacro define-instruction 610,26139 +(clos:defgeneric expand-instruction-procedure-header 619,26604 +(clos:defgeneric expand-instruction-procedure-trailer 620,26695 +(clos:defmethod expand-instruction-procedure-header625,26975 +(clos:defmethod expand-instruction-procedure-trailer634,27329 +(clos:defmethod expand-instruction-procedure-header647,27979 +(clos:defmethod expand-instruction-procedure-trailer736,31423 +(clos:defmethod expand-instruction-procedure-header752,32153 +(clos:defmethod expand-instruction-procedure-trailer828,35189 +(defmacro immediate-handler 834,35408 +(clos:defmethod expand-instruction-procedure-header845,35783 +(clos:defmethod expand-instruction-procedure-trailer923,38905 +(clos:defmethod expand-instruction-procedure-header929,39131 +(clos:defmethod expand-instruction-procedure-trailer956,40278 +(clos:defmethod expand-instruction-procedure-header961,40485 +(clos:defmethod expand-instruction-procedure-trailer988,41642 +(clos:defmethod expand-instruction-procedure-header997,42064 +(clos:defmethod expand-instruction-procedure-trailer1023,43295 +(clos:defmethod expand-instruction-procedure-header1039,44095 +(clos:defmethod expand-instruction-procedure-trailer1066,45379 +(defmacro UnimplementedInstruction 1073,45589 +(defun last-instruction-is-branch-p 1086,46157 +(defmacro basic-dispatch 1098,46602 +(defmacro mondo-dispatch 1216,50480 +(defmacro cdr-code-dispatch 1263,51857 +(defmacro register-dispatch 1272,52253 +(defmacro type-dispatch 1276,52406 +(defmacro binary-type-dispatch 1282,52621 +(defmacro cache-ivory-state 1345,55054 +(defmacro decache-ivory-state 1352,55284 +(define-integer-register sp 1362,55631 +(define-integer-register toc 1363,55663 +(define-integer-register env 1364,55696 +(define-integer-register tls 1365,55730 +(define-integer-register arg1 1366,55783 +(define-integer-register arg2 1367,55817 +(define-integer-register arg3 1368,55851 +(define-integer-register arg4 1369,55885 +(define-integer-register arg5 1370,55919 +(define-integer-register arg6 1371,55953 +(define-integer-register ivory 1372,55987 +(define-integer-register iPC 1373,56049 +(define-integer-register iFP 1374,56083 +(define-integer-register iLP 1375,56117 +(define-integer-register iSP 1376,56151 +(define-integer-register iCP 1377,56185 +(define-integer-register t1 1378,56219 +(define-integer-register t2 1379,56252 +(define-integer-register t3 1380,56285 +(define-integer-register t4 1381,56318 +(define-integer-register t5 1382,56351 +(define-integer-register t6 1383,56384 +(define-integer-register t7 1384,56417 +(define-integer-register t8 1385,56450 +(define-integer-register t9 1386,56483 +(define-integer-register t10 1387,56516 +(define-integer-register t11 1388,56550 +(define-integer-register t12 1389,56584 +(define-integer-register instn 1391,56644 +(define-integer-register iword 1392,56679 +(define-integer-register ecp 1393,56714 +(define-integer-register ocp 1394,56747 +(define-integer-register icsize 1395,56780 +(define-integer-register epc 1396,56840 +(define-integer-register opc 1397,56873 +(define-integer-register count 1398,56906 +(define-integer-register hwopmask 1399,56941 +(define-integer-register fwdispatch 1400,57010 +(define-integer-register hwdispatch 1401,57082 + +g5-emulator/memoryem.lisp,1347 +(defconstant %memory-action-indirect 11,400 +(defconstant %memory-action-monitor-trap 12,440 +(defconstant %memory-action-transport 13,484 +(defconstant %memory-action-trap 14,525 +(defconstant %memory-action-transform 15,562 +(defconstant %memory-action-binding-trap 16,604 +(defsubst memory-action-index 19,730 +(defvar *memory-actions* 22,825 +(defparameter *memory-actions-table*24,903 +(defun initialize-memory-actions 53,2581 +(defsubst memory-action-entry 138,6278 +(defun memory-indirect-mask 141,6402 +(defun memory-action-mask 152,6752 +(defmacro decode-fault 164,7121 +(defmacro transport-trap 168,7259 +(defmacro miss-fault 171,7328 +(defmacro access-fault 174,7395 +(defmacro write-fault 177,7472 +(defmacro memory-action 180,7539 +(defmacro with-multiple-memory-reads 186,7715 +(defmacro using-multiple-memory-reads 208,8725 +(defmacro inhibit-alignment-in-memory-read 221,9277 +(defmacro VM-read 229,9613 +(defmacro VM-write 243,10128 +(defmacro check-access 255,10688 +(defvar *memory-subroutines* 353,13983 +(defmacro define-memory-subroutine356,14105 +(defmacro find-memory-subroutine374,14891 +(defun find-memory-subr-internal 383,15263 +(defun memory-read-internal 422,16804 +(defmacro memory-read 694,27746 +(defmacro memory-write 699,28084 +(defmacro store-contents 758,30897 +(defmacro store-conditional-internal 774,31646 + +g5-emulator/powermac.lisp,1979 +(defconstant CondFalse 49,1851 +(defconstant CondTrue 50,1877 +(defconstant CR-LT 52,1904 +(defconstant CR-GT 53,1926 +(defconstant CR-EQ 54,1948 +(defconstant CR-SO 55,1970 +(defmacro bclong 57,1993 +(defmacro branch-if-nonzero 64,2210 +(defmacro long-branch-if-nonzero 68,2343 +(defmacro branch-if-zero 76,2594 +(defmacro long-branch-if-zero 80,2725 +(defmacro branch-if-less-than-zero 88,2975 +(defmacro branch-if-greater-than-zero 92,3116 +(defmacro branch-if-less-than-or-equal-to-zero 96,3260 +(defmacro branch-if-greater-than-or-equal-to-zero 100,3412 +(defmacro exts 105,3652 +(defmacro nop 118,4065 +(defmacro mov 121,4147 +(defmacro li 124,4238 +(defmacro clr 127,4333 +(defmacro clrldi 130,4422 +(defmacro clrrdi 133,4523 +(defmacro extldi 136,4631 +(defmacro extrdi 139,4740 +(defmacro rotldi 143,4883 +(defmacro rotrdi 146,4984 +(defmacro sldi 149,5093 +(defmacro srdi 152,5200 +(defmacro addw 155,5307 +(defmacro addwi 174,6093 +(defmacro subfw 178,6209 +(defmacro stzw 197,6999 +(defmacro stzd 201,7116 +(defmacro ldgp 210,7310 +(defmacro divl 214,7432 +(defmacro divq 221,7718 +(defmacro divlu 228,8004 +(defmacro divqu 235,8292 +(defmacro reml 242,8580 +(defmacro remlu 249,8866 +(defmacro remq 256,9154 +(defmacro remqu 263,9440 +(defmacro external 271,9732 +(defmacro include-header 274,9809 +(defun define-procedure-internal 277,9894 +(defmacro define-procedure 288,10258 +(defmacro define-external-procedure 292,10454 +(defun indent-define-procedure 297,10666 +(defvar *subroutine-in-progress?* 312,11244 +(defvar *subroutine-regs-to-save* 313,11283 +(defvar *subroutine-fast?* 314,11322 +(defun define-subroutine-internal 316,11355 +(defmacro define-subroutine 332,11941 +(defmacro define-external-subroutine 337,12182 +(defmacro define-fast-subroutine 342,12433 +(defmacro define-fast-external-subroutine 347,12686 +(defmacro elf-prologue 352,12950 +(defmacro elf-epilogue 374,13852 +(defmacro call-c-function 393,14706 +(defmacro load-constant 423,15793 + +g5-emulator/stacklis.lisp,2376 +(defun process-stack-options 12,532 +(defmacro with-stack-options 20,812 +(defmacro stack-read-disp 31,1256 +(defmacro stack-read 38,1588 +(defmacro stack-read-data-disp 41,1680 +(defmacro stack-read-data 60,2426 +(defmacro stack-read-tag-disp 63,2528 +(defmacro stack-read-tag 74,2961 +(defmacro stack-read2-disp 77,3061 +(defmacro stack-read2-disp-signed 106,4072 +(defmacro stack-read2 111,4311 +(defmacro stack-read2-signed 118,4624 +(defmacro stack-top 125,4857 +(defmacro stack-top2 128,4936 +(defmacro stack-pop 131,5026 +(defmacro stack-pop-discard 135,5137 +(defmacro stack-pop-data 139,5273 +(defmacro stack-pop-tag 162,6047 +(defmacro stack-pop2 166,6171 +(defmacro stack-write-ir 201,7330 +(defmacro fp-stack-write-ir 207,7632 +(defmacro stack-write2 212,7896 +(defmacro stack-write2-disp 216,8039 +(defmacro stack-write-tag 235,9033 +(defmacro stack-write-data 238,9133 +(defmacro stack-write-tag-disp 241,9237 +(defmacro stack-write-data-disp 248,9588 +(defmacro combine-tag-data-word 253,9829 +(defmacro stack-write2c 262,10239 +(defmacro stack-write 269,10536 +(defmacro stack-write-disp 272,10633 +(defmacro stack-push2c 278,10893 +(defmacro stack-push2 285,11192 +(defmacro stack-push 290,11407 +(defmacro stack-push2c-with-cdr 302,11884 +(defmacro stack-push2-with-cdr 307,12083 +(defmacro stack-push-tag 311,12267 +(defmacro stack-push-tag-with-cdr 316,12477 +(defmacro stack-push-data 320,12656 +(defmacro stack-push-with-cdr 324,12777 +(defmacro stack-push-ir 329,13012 +(defmacro fp-stack-push-ir 336,13352 +(defmacro stack-push-ir-reverse 341,13604 +(defmacro stack-push-fixnumb 346,13875 +(defmacro stack-push-fixnum 355,14199 +(defmacro stack-push-nil 360,14378 +(defmacro stack-write-nil 366,14549 +(defmacro stack-push-t 371,14708 +(defmacro stack-write-t 377,14875 +(defmacro stack-write-nil-and-push-nil 382,15027 +(defmacro stack-set-cdr-code 389,15231 +(defmacro get-nil 396,15451 +(defmacro get-nil2 399,15577 +(defmacro get-t 404,15788 +(defmacro get-t2 407,15910 +(defmacro stack-overflow-p 414,16236 +(defmacro stack-overflow-check 432,17026 +(defmacro stack-fill 438,17270 +(defmacro stack-cache-underflow-check 454,17884 +(defmacro stack-cache-underflow-body 471,18738 +(defmacro stack-dump 511,20637 +(defmacro stack-cache-overflow-check 546,21961 +(defmacro stack-cache-overflow-handler 586,23575 +(defmacro stack-block-copy 650,26949 + +OG2-patches/allow-multiple-ll-addresses.lisp,233 +(defwiredvar *emb-ethernet-net-address-1* 35,1511 +(defwiredvar *emb-ethernet-net-address-2* 46,1841 +(defwiredfun initialize-embedded-network 57,2171 +(defwiredfun emb-ethernet-transmit-epacket 82,3429 +(DEFMETHOD (:RESET 115,4597 + +OG2-patches/detect-keyboard-patch.lisp,402 +(defun-in-flavor (fill-keyboard-table-specific 96,4041 +(defparameter *keysym-name-table* 1078,52116 +(defparameter *keysym-legend-table* 1079,52195 +(defparameter *name-keysym-table* 1080,52278 +(defun maybe-define-signature 1087,52521 +(defun display-keyboard-layout-type 1114,53352 +(x-screen:define-keyboard-mapping :Xorg-pc-german 1143,54405 +(x-screen:define-keyboard-mapping :Xorg-pc1241,57125 + +OG2-patches/emb-bufs.lisp,56 +(defwiredfun map-over-emb-buf-sizes-and-counts 39,1839 + +OG2-patches/full-gc-patch.lisp,137 +(defun region-check 41,2105 +(defun make-static-regions-dynamic 100,4303 +(DEFUN IMMEDIATE-GC 151,6315 +(DEFUN REORDER-MEMORY 301,13558 + +OG2-patches/get-emb-host.lisp,29 +(defun get-emb-host 33,1537 + +OG2-patches/host-ll-address.lisp,34 +(DEFMETHOD (:ADD-NETWORK 38,1860 + +OG2-patches/modifier-loop-patch.lisp,58 +(defun-in-flavor (update-server-modifier-mapping 36,1955 + +OG2-patches/primary-network-address.lisp,44 +(defun get-primary-network-address 32,1470 + +OG2-patches/use-host-time.lisp,146 +(DEFUN READ-CALENDAR-CLOCK 39,2612 +(defun vlm-read-calendar-clock-internal 139,7035 +(DEFVAR *INITIALIZE-TIMEBASE-FROM-CALENDAR-CLOCK* 164,7971 + +stub/clisp-support.lisp,3324 +(defun %32-bit-difference 12,173 +(defmacro defsysconstant 31,610 +(defmacro defenumerated 36,714 +(defmacro defsysbyte 47,1242 +(DEFENUMERATED *DATA-TYPES* 69,2247 +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* 133,5781 +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 142,5970 +(DEFSYSBYTE %%CR.APPLY 143,6056 +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 144,6126 +(DEFSYSBYTE %%CR.CLEANUP-BITS 145,6196 +(DEFSYSBYTE %%CR.CLEANUP-CATCH 146,6257 +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 147,6349 +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 148,6439 +(DEFSYSBYTE %%CR.TRAP-MODE 149,6522 +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 153,6752 +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 154,6843 +(DEFSYSBYTE %%CR.CALL-STARTED 155,6915 +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 156,6991 +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 157,7035 +(DEFSYSBYTE %%CR.CALL-TRACE 158,7077 +(DEFSYSBYTE %%CR.TRACE-PENDING 159,7112 +(DEFSYSBYTE %%CR.TRACE-BITS 160,7150 +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 162,7186 +(DEFENUMERATED *VALUE-DISPOSITIONS* 164,7234 +(DEFENUMERATED *TRAP-MODES* 172,7592 +(DEFENUMERATED *MEMORY-CYCLE-TYPES* 178,7701 +(DEFSYSBYTE %%ALU-BYTE-R 198,8128 +(DEFSYSBYTE %%ALU-BYTE-S 199,8163 +(DEFSYSBYTE %%ALU-FUNCTION 200,8198 +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 201,8240 +(DEFSYSBYTE %%ALU-FUNCTION-BITS 202,8282 +(DEFSYSBYTE %%ALU-CONDITION 203,8324 +(DEFSYSBYTE %%ALU-CONDITION-SENSE 204,8362 +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 208,8539 +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 209,8581 +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 210,8633 +(DEFENUMERATED *ALU-CONDITION-SENSES*212,8675 +(DEFENUMERATED *ALU-CONDITIONS*216,8775 +(DEFENUMERATED *ALU-FUNCTION-CLASSES*244,9855 +(DEFENUMERATED *ALU-FUNCTIONS*250,10023 +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS*262,10364 +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH*267,10499 +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS*271,10602 +(DEFENUMERATED *ALU-ADDER-OPS*275,10686 +(defmacro %alu-function-dpb 279,10753 +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR 291,11052 +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR 292,11114 +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR 293,11168 +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR 294,11221 +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR 296,11271 +(DEFSYSCONSTANT %RESET-TRAP-VECTOR 297,11314 +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR 298,11357 +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR 299,11410 +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR 300,11462 +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR 301,11505 +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR 302,11558 +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR 303,11605 +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 305,11652 +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 306,11717 +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR 307,11783 +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR 309,11861 +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR 311,11950 +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR 314,12040 +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR 315,12095 +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR 316,12151 +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR 317,12205 +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR 318,12269 +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR 319,12323 +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR 320,12374 +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 321,12427 +(DEFCONSTANT *FINISH-CALL-N-OPCODE* 331,12632 + +stub/intrpmac.lisp,5569 +(defmacro check-temporaries 5,135 +(defvar *memoized-vmdata* 9,310 +(defvar *memoized-vmtags* 10,341 +(defvar *memoized-base* 11,372 +(defvar *memoized-limit* 12,402 +(defvar *memoized-action* 13,432 +(defvar *memoized-action-cycle* 14,463 +(defvar *cant-be-in-cache-p* 15,500 +(defvar *inhibit-alignment-in-memory-read* 18,572 +(defmacro branch-true 44,1637 +(defmacro branch-false 47,1737 +(defmacro force-alignment 50,1838 +(defmacro PC-TO-iCACHEENT 59,2152 +(defmacro PC-TO-iCACHEENT 76,2964 +(defmacro convert-pc-to-continuation 94,3886 +(defmacro convert-continuation-to-pc 102,4201 +(defmacro SCAtoVMA 114,4637 +(defmacro VMAtoSCA 127,5114 +(defmacro VMAinStackCache 140,5531 +(defmacro VMAtoSCAmaybe 154,6274 +(defmacro TagTypeFromLispObj 175,7356 +(defmacro TagCdrFromLispObj 180,7526 +(defmacro PackedInstructionP 184,7711 +(defmacro TagType 195,8262 +(defmacro TagCdr 199,8386 +(defmacro SetTag 203,8508 +(defmacro CheckDataType 209,8739 +(defmacro CheckAdjacentDataTypes 215,8916 +(defmacro NumericTypeException 223,9286 +(defmacro UnaryNumericTypeException 227,9438 +(defmacro SpareTypeException 231,9600 +(defmacro ListTypeException 236,9784 +(defmacro ArrayTypeException 243,10096 +(defmacro maybe-icount 248,10280 +(defmacro maybe-statistics 258,10686 +(defmacro maybe-meter-hit 274,11463 +(defmacro maybe-meter-miss 298,12652 +(defun show-icache-histogram 325,13953 +(defmacro maybe-meter-trap 363,15457 +(defmacro maybe-trace 371,15806 +(defmacro ContinueToInterpretInstruction 446,20056 +(defmacro ContinueToInterpretInstruction-ValidateCache 451,20292 +(defmacro ContinueToNextInstruction 460,20854 +(defmacro GetNextPC 464,21037 +(defmacro PrefetchNextPC 467,21104 +(defmacro SetNextPC 470,21182 +(defmacro GetNextCP 473,21237 +(defmacro PrefetchNextCP 476,21300 +(defmacro SetNextCP 479,21374 +(defmacro GetNextPCandCP 482,21429 +(defmacro ContinueToNextInstruction-NoStall 488,21688 +(defmacro instruction-exception 492,21874 +(defmacro arithmetic-exception 495,21988 +(defmacro illegal-operand 499,22168 +(defmacro illegal-instruction 503,22332 +(defmacro halt-machine 506,22453 +(defmacro with-predicate-store 520,23028 +(defmacro with-predicate-push 544,24055 +(defmacro align4k 570,24914 +(defmacro align4Kskip8K 576,25145 +(defmacro align4kskip4k 583,25357 +(defmacro define-instruction 588,25478 +(clos:defgeneric expand-instruction-procedure-header 597,25943 +(clos:defgeneric expand-instruction-procedure-trailer 598,26034 +(clos:defmethod expand-instruction-procedure-header603,26314 +(clos:defmethod expand-instruction-procedure-trailer612,26669 +(clos:defmethod expand-instruction-procedure-header625,27319 +(clos:defmethod expand-instruction-procedure-trailer704,30704 +(clos:defmethod expand-instruction-procedure-header720,31439 +(clos:defmethod expand-instruction-procedure-trailer785,34289 +(defmacro immediate-handler 791,34508 +(clos:defmethod expand-instruction-procedure-header802,34896 +(clos:defmethod expand-instruction-procedure-trailer870,37897 +(clos:defmethod expand-instruction-procedure-header876,38123 +(clos:defmethod expand-instruction-procedure-trailer903,39266 +(clos:defmethod expand-instruction-procedure-header908,39473 +(clos:defmethod expand-instruction-procedure-trailer935,40629 +(clos:defmethod expand-instruction-procedure-header944,41051 +(clos:defmethod expand-instruction-procedure-trailer970,42272 +(clos:defmethod expand-instruction-procedure-header986,43072 +(clos:defmethod expand-instruction-procedure-trailer1013,44358 +(defmacro UnimplementedInstruction 1020,44568 +(defun last-instruction-is-branch-p 1033,45136 +(defmacro basic-dispatch 1045,45582 +(defmacro mondo-dispatch 1166,49618 +(defmacro cdr-code-dispatch 1213,50968 +(defmacro register-dispatch 1222,51329 +(defmacro type-dispatch 1226,51469 +(defmacro binary-type-dispatch 1232,51662 +(defmacro cache-ivory-state 1294,54059 +(defmacro decache-ivory-state 1301,54294 +(define-integer-register t1 1310,54588 +(define-integer-register t2 1311,54619 +(define-integer-register t3 1312,54650 +(define-integer-register t4 1313,54681 +(define-integer-register t5 1314,54712 +(define-integer-register t6 1315,54743 +(define-integer-register t7 1316,54774 +(define-integer-register t8 1317,54805 +(define-integer-register iPC 1318,54836 +(define-integer-register iFP 1319,54868 +(define-integer-register iLP 1320,54901 +(define-integer-register iSP 1321,54934 +(define-integer-register iCP 1322,54967 +(define-integer-register ivory 1323,55000 +(define-integer-register arg1 1324,55062 +(define-integer-register arg2 1325,55096 +(define-integer-register arg3 1326,55130 +(define-integer-register arg4 1327,55164 +(define-integer-register arg5 1328,55198 +(define-integer-register arg6 1329,55232 +(define-integer-register t9 1330,55266 +(define-integer-register t10 1331,55298 +(define-integer-register t11 1332,55331 +(define-integer-register t12 1333,55364 +(define-integer-register ra 1334,55397 +(define-integer-register pv 1335,55430 +(define-integer-register gp 1336,55463 +(define-integer-register sp 1337,55496 +(define-integer-register none 1339,55530 +(define-integer-register instn 1340,55564 +(define-integer-register iword 1341,55606 +(define-integer-register ecp 1342,55648 +(define-integer-register ocp 1343,55689 +(define-integer-register icsize 1344,55730 +(define-integer-register epc 1345,55796 +(define-integer-register opc 1346,55837 +(define-integer-register count 1347,55878 +(define-integer-register hwopmask 1348,55920 +(define-integer-register fwdispatch 1349,55996 +(define-integer-register hwdispatch 1350,56076 + +stub/process.lisp,1990 +(defpackage ALPHA-AXP-INTERNALS21,392 +(defpackage I-LISP-COMPILER26,483 +(defmacro lc 32,605 +(defmacro defsubst 37,686 +(defmacro stack-let 42,812 +(defun circular-list 52,1111 +(defmacro define-integer-register 57,1224 +(defun register-asmname 59,1283 +(defun find-register 63,1372 +(defun %logdpb 69,1478 +(defparameter *function-alignment* 81,1890 +(defun coerce-to-register 83,1929 +(defun coerce-to-register-or-literal 86,1969 +(defun lsh 89,2026 +(defun c-header 99,2252 +(defun c-trailer 109,2708 +(defvar *function-being-processed* 113,2849 +(defvar *function-epilogue*)114,2889 +(defvar *do-check-oflo* 115,2918 +(defvar *do-check-ratquo* 116,2947 +(defun macroexpand-careful 119,2981 +(defun macroexpand-asm-form 125,3124 +(defun collecting-function-epilogue 141,3570 +(defmacro check-comment 156,4161 +(defun remap-arg 159,4247 +(defun isconstant 668,27893 +(defun split-by-one-char 701,28802 +(defun split-by-one-plus 708,28994 +(defun split-by-one-space 712,29105 +(defun split-by-one-star 716,29221 +(defun fixarg 719,29290 +(defun regnum 744,30215 +(defun notnumber 748,30292 +(defun decompose-args 756,30489 +(defun is-cachep-member 772,31074 +(defun is-cachep-ptr 779,31315 +(defun cacheline-ptr-str 782,31411 +(defun needs-cacheline-cast 787,31527 +(defun is-arrachcachep-member 793,31697 +(defun needs-arraycache-cast 798,31839 +(defun is-processorstatep-member 801,31918 +(defun needs-processorstate-cast 1001,38036 +(defun check-needs-cast 1004,38122 +(defun structptr 1016,38564 +(defun add-global-label-symbol 1024,38757 +(defun is-global-label 1027,38853 +(defun gotolabel 1034,39056 +(defun longnum 1040,39182 +(defun make-call-label 1048,39310 +(defun fix-passthrus 1057,39509 +(defun emit-operation 1097,40692 +(defun process-asm-form 2205,71652 +(defun process-asm-source 2217,72084 +(defun create-output-files 2229,72501 +(defun load-macros 2253,73280 +(defun load-macros-old 2275,73893 +(defun add-missing-global-symbols 2299,74820 +(defun build 2461,79819 + +support/clear-all-histories.lisp,60 +(define-debugger-command (com-Clear-Output-History 68,4190 + +support/clisp-packages.lisp,123 +(defpackage CLOS10,265 +(defpackage FUTURE-COMMON-LISP15,436 +(defpackage SYSTEM23,597 +(defpackage I-LISP-COMPILER27,660 + +support/clisp-support.lisp,3382 +(defmacro defsubst 12,252 +(defmacro stack-let 17,378 +(defun %32-bit-difference 40,917 +(defmacro defsysconstant 59,1354 +(defmacro defenumerated 64,1458 +(defmacro defsysbyte 75,1986 +(DEFENUMERATED *DATA-TYPES* 97,2991 +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* 161,6525 +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 170,6714 +(DEFSYSBYTE %%CR.APPLY 171,6800 +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 172,6870 +(DEFSYSBYTE %%CR.CLEANUP-BITS 173,6940 +(DEFSYSBYTE %%CR.CLEANUP-CATCH 174,7001 +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 175,7093 +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 176,7183 +(DEFSYSBYTE %%CR.TRAP-MODE 177,7266 +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 181,7496 +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 182,7587 +(DEFSYSBYTE %%CR.CALL-STARTED 183,7659 +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 184,7735 +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 185,7779 +(DEFSYSBYTE %%CR.CALL-TRACE 186,7821 +(DEFSYSBYTE %%CR.TRACE-PENDING 187,7856 +(DEFSYSBYTE %%CR.TRACE-BITS 188,7894 +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 190,7930 +(DEFENUMERATED *VALUE-DISPOSITIONS* 192,7978 +(DEFENUMERATED *TRAP-MODES* 200,8336 +(DEFENUMERATED *MEMORY-CYCLE-TYPES* 206,8445 +(DEFSYSBYTE %%ALU-BYTE-R 226,8872 +(DEFSYSBYTE %%ALU-BYTE-S 227,8907 +(DEFSYSBYTE %%ALU-FUNCTION 228,8942 +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 229,8984 +(DEFSYSBYTE %%ALU-FUNCTION-BITS 230,9026 +(DEFSYSBYTE %%ALU-CONDITION 231,9068 +(DEFSYSBYTE %%ALU-CONDITION-SENSE 232,9106 +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 236,9283 +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 237,9325 +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 238,9377 +(DEFENUMERATED *ALU-CONDITION-SENSES*240,9419 +(DEFENUMERATED *ALU-CONDITIONS*244,9519 +(DEFENUMERATED *ALU-FUNCTION-CLASSES*272,10599 +(DEFENUMERATED *ALU-FUNCTIONS*278,10767 +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS*290,11108 +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH*295,11243 +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS*299,11346 +(DEFENUMERATED *ALU-ADDER-OPS*303,11430 +(defmacro %alu-function-dpb 307,11497 +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR 319,11796 +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR 320,11858 +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR 321,11912 +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR 322,11965 +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR 324,12015 +(DEFSYSCONSTANT %RESET-TRAP-VECTOR 325,12058 +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR 326,12101 +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR 327,12154 +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR 328,12206 +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR 329,12249 +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR 330,12302 +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR 331,12349 +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 333,12396 +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 334,12461 +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR 335,12527 +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR 337,12605 +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR 339,12694 +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR 342,12784 +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR 343,12839 +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR 344,12895 +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR 345,12949 +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR 346,13013 +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR 347,13067 +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR 348,13118 +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 349,13171 +(DEFCONSTANT *FINISH-CALL-N-OPCODE* 359,13376 + +support/compile-Minima-for-VLM.lisp,154 +(defun compile-environment-file 79,4858 +(defun load-environment-file 158,8143 +(defun compile-a-file 228,10931 +(defun compile-form-to-stream 285,13141 + +support/control-register-view.lisp,198 +(define-view c 72,4468 +(defparameter *trap-mode-names*83,4770 +(defparameter *value-disposition-names*96,5177 +(define-presentation-method present 110,5613 +(defun print-control-register 124,6066 + +support/debug-kludges.lisp,170 +(defun tag-data-type 16,643 +(defun tag-cdr-code 19,693 +(defun instnref 22,736 +(defun emit-c-test-function 63,2013 +(defun emit-fcn-as-c 67,2214 +(defun fact3 95,3130 + +support/development-sysdcl.lisp,32 +(defsystem vlm-development3,85 + +support/more-VLM-access-path-hackery.lisp,53 +(defmethod udp-access-path-address-match-p 108,5872 + +support/openmcl-packages.lisp,174 +(defpackage LISP6,196 +(defpackage CLOS10,259 +(defpackage FUTURE-COMMON-LISP15,430 +(defpackage COMPILER19,522 +(defpackage SYSTEM23,585 +(defpackage I-LISP-COMPILER27,648 + +support/openmcl-support.lisp,3481 +(defmacro defsubst 7,114 +(defmacro stack-let 12,237 +(defun circular-list 23,561 +(ccl::defsubst %logldb 34,750 +(ccl::defsubst %logdpb 37,819 +(ccl::defsubst %32-bit-difference 43,1018 +(defmacro defsysconstant 48,1075 +(defmacro defenumerated 53,1179 +(defmacro defsysbyte 64,1707 +(DEFENUMERATED *DATA-TYPES* 86,2712 +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* 150,6246 +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 159,6435 +(DEFSYSBYTE %%CR.APPLY 160,6521 +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 161,6591 +(DEFSYSBYTE %%CR.CLEANUP-BITS 162,6661 +(DEFSYSBYTE %%CR.CLEANUP-CATCH 163,6722 +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 164,6814 +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 165,6904 +(DEFSYSBYTE %%CR.TRAP-MODE 166,6987 +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 170,7217 +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 171,7308 +(DEFSYSBYTE %%CR.CALL-STARTED 172,7380 +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 173,7456 +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 174,7500 +(DEFSYSBYTE %%CR.CALL-TRACE 175,7542 +(DEFSYSBYTE %%CR.TRACE-PENDING 176,7577 +(DEFSYSBYTE %%CR.TRACE-BITS 177,7615 +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 179,7651 +(DEFENUMERATED *VALUE-DISPOSITIONS* 181,7699 +(DEFENUMERATED *TRAP-MODES* 189,8057 +(DEFENUMERATED *MEMORY-CYCLE-TYPES* 195,8166 +(DEFSYSBYTE %%ALU-BYTE-R 215,8593 +(DEFSYSBYTE %%ALU-BYTE-S 216,8628 +(DEFSYSBYTE %%ALU-FUNCTION 217,8663 +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 218,8705 +(DEFSYSBYTE %%ALU-FUNCTION-BITS 219,8747 +(DEFSYSBYTE %%ALU-CONDITION 220,8789 +(DEFSYSBYTE %%ALU-CONDITION-SENSE 221,8827 +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 225,9004 +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 226,9046 +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 227,9098 +(DEFENUMERATED *ALU-CONDITION-SENSES*229,9140 +(DEFENUMERATED *ALU-CONDITIONS*233,9240 +(DEFENUMERATED *ALU-FUNCTION-CLASSES*261,10320 +(DEFENUMERATED *ALU-FUNCTIONS*267,10488 +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS*279,10829 +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH*284,10964 +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS*288,11067 +(DEFENUMERATED *ALU-ADDER-OPS*292,11151 +(defmacro %alu-function-dpb 296,11218 +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR 308,11517 +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR 309,11579 +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR 310,11633 +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR 311,11686 +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR 313,11736 +(DEFSYSCONSTANT %RESET-TRAP-VECTOR 314,11779 +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR 315,11822 +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR 316,11875 +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR 317,11927 +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR 318,11970 +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR 319,12023 +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR 320,12070 +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 322,12117 +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 323,12182 +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR 324,12248 +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR 326,12326 +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR 328,12415 +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR 331,12505 +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR 332,12560 +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR 333,12616 +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR 334,12670 +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR 335,12734 +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR 336,12788 +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR 337,12839 +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 338,12892 +(DEFCONSTANT *FINISH-CALL-N-OPCODE* 348,13097 + +support/robust-MBIN.lisp,155 +(defparameter *remote-memory-retransmission-interval* 148,9724 +(defmethod remote-memory-mbin-advance-output-buffer159,10044 +(defun save-world 215,11989 + +support/sbcl-packages.lisp,174 +(defpackage LISP6,196 +(defpackage CLOS10,259 +(defpackage FUTURE-COMMON-LISP15,430 +(defpackage COMPILER19,522 +(defpackage SYSTEM23,585 +(defpackage I-LISP-COMPILER27,648 + +support/sbcl-support.lisp,3382 +(defmacro defsubst 13,312 +(defmacro stack-let 18,438 +(defun %32-bit-difference 41,977 +(defmacro defsysconstant 60,1414 +(defmacro defenumerated 65,1518 +(defmacro defsysbyte 76,2046 +(DEFENUMERATED *DATA-TYPES* 98,3051 +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* 162,6585 +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 171,6774 +(DEFSYSBYTE %%CR.APPLY 172,6860 +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 173,6930 +(DEFSYSBYTE %%CR.CLEANUP-BITS 174,7000 +(DEFSYSBYTE %%CR.CLEANUP-CATCH 175,7061 +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 176,7153 +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 177,7243 +(DEFSYSBYTE %%CR.TRAP-MODE 178,7326 +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 182,7556 +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 183,7647 +(DEFSYSBYTE %%CR.CALL-STARTED 184,7719 +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 185,7795 +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 186,7839 +(DEFSYSBYTE %%CR.CALL-TRACE 187,7881 +(DEFSYSBYTE %%CR.TRACE-PENDING 188,7916 +(DEFSYSBYTE %%CR.TRACE-BITS 189,7954 +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 191,7990 +(DEFENUMERATED *VALUE-DISPOSITIONS* 193,8038 +(DEFENUMERATED *TRAP-MODES* 201,8396 +(DEFENUMERATED *MEMORY-CYCLE-TYPES* 207,8505 +(DEFSYSBYTE %%ALU-BYTE-R 227,8932 +(DEFSYSBYTE %%ALU-BYTE-S 228,8967 +(DEFSYSBYTE %%ALU-FUNCTION 229,9002 +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 230,9044 +(DEFSYSBYTE %%ALU-FUNCTION-BITS 231,9086 +(DEFSYSBYTE %%ALU-CONDITION 232,9128 +(DEFSYSBYTE %%ALU-CONDITION-SENSE 233,9166 +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 237,9343 +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 238,9385 +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 239,9437 +(DEFENUMERATED *ALU-CONDITION-SENSES*241,9479 +(DEFENUMERATED *ALU-CONDITIONS*245,9579 +(DEFENUMERATED *ALU-FUNCTION-CLASSES*273,10659 +(DEFENUMERATED *ALU-FUNCTIONS*279,10827 +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS*291,11168 +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH*296,11303 +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS*300,11406 +(DEFENUMERATED *ALU-ADDER-OPS*304,11490 +(defmacro %alu-function-dpb 308,11557 +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR 320,11856 +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR 321,11918 +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR 322,11972 +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR 323,12025 +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR 325,12075 +(DEFSYSCONSTANT %RESET-TRAP-VECTOR 326,12118 +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR 327,12161 +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR 328,12214 +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR 329,12266 +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR 330,12309 +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR 331,12362 +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR 332,12409 +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 334,12456 +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR 335,12521 +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR 336,12587 +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR 338,12665 +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR 340,12754 +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR 343,12844 +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR 344,12899 +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR 345,12955 +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR 346,13009 +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR 347,13073 +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR 348,13127 +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR 349,13178 +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 350,13231 +(DEFCONSTANT *FINISH-CALL-N-OPCODE* 360,13436 + +support/start-without-Load-World.lisp,113 +(define-debugger-command (com-Start-Application 75,4426 +(define-debugger-command (com-Start-Interactor 92,5085 + +support/unix-access-path.lisp,354 +(defclass remote-minima-udp-native-fep-access-path65,4097 +(defclass remote-minima-udp-native-genera-access-path81,4627 +(defclass dummy-remote-access-path98,5235 +(cp:define-command (com-create-emulator-access-path 113,5788 +(cp:define-command (com-remake-emulator-access-path 141,6965 +(defun divine-port-number 162,7836 +(defun numericalize 180,8506 + +translator/support-sysdcl.lisp,90 +(defsystem alpha-axp-translator-support3,85 +(defsystem powerpc-translator-support16,638 + +translator/sysdcl.lisp,37 +(defsystem alpha-axp-translator3,85 + +translator/tranrule.lisp,2523 +(def-halfword-translation SetSpToAddressHW 11,384 +(def-halfword-translation SetSpToAddressSaveTosHW 22,825 +(def-decoded-halfword-translation PushHW 34,1316 +(def-halfword-translation PopHW 46,1828 +(def-halfword-translation MovemHW 58,2292 +(def-halfword-translation PushAddressHW 70,2817 +(def-fullword-translation pushimmediateconstant 87,3611 +(def-halfword-translation TypeMemberHW 99,4105 +(def-decoded-halfword-translation PointerPlusHW 124,5217 +(def-decoded-halfword-translation PointerDifferenceHW 139,5842 +(defmacro unary-arithmetic-predicate-translation 153,6306 +(def-decoded-halfword-translation ZeropHW 192,7967 +(def-decoded-halfword-translation PluspHW 208,8609 +(def-decoded-halfword-translation MinuspHW 224,9252 +(def-decoded-halfword-translation EndpHW 240,9897 +(def-decoded-halfword-translation EqHW 270,11136 +(def-decoded-halfword-translation EqlHW 311,12900 +(defmacro simple-binary-arithmetic-translation 361,14982 +(defmacro unary-minus-translation 396,16538 +(def-decoded-halfword-translation AddHW 435,18040 +(def-decoded-halfword-translation SubHW 442,18389 +(def-decoded-halfword-translation MulHW 449,18738 +(def-halfword-translation LoopDecrementTosHW 457,19095 +(def-halfword-translation CarHW 488,20306 +(def-halfword-translation CdrHW 518,21473 +(def-halfword-translation SettoCarHW 547,22647 +(def-halfword-translation SettoCdrHW 581,24243 +(def-halfword-translation SettoCdrPushCarHW 614,25837 +(defmacro trbranchcond 646,27238 +(def-halfword-translation BranchTrueNoPopHW 683,28789 +(def-halfword-translation BranchTrueAndNoPopElseNoPopExtraPopHW 690,29099 +(def-halfword-translation BranchTrueAndNoPopHW 697,29421 +(def-halfword-translation BranchTrueElseExtraPopHW 704,29736 +(def-halfword-translation BranchTrueElseNoPopHW 711,30051 +(def-halfword-translation BranchTrueAndExtraPopHW 718,30370 +(def-halfword-translation BranchTrueHW 725,30678 +(def-halfword-translation BranchTrueExtraPopHW 732,30974 +(def-halfword-translation BranchFalseNoPopHW 739,31275 +(def-halfword-translation BranchFalseAndNoPopElseNoPopExtraPopHW 746,31585 +(def-halfword-translation BranchFalseAndNoPopHW 753,31914 +(def-halfword-translation BranchFalseElseExtraPopHW 760,32227 +(def-halfword-translation BranchFalseElseNoPopHW 767,32542 +(def-halfword-translation BranchFalseAndExtraPopHW 774,32857 +(def-halfword-translation BranchFalseHW 781,33159 +(def-halfword-translation BranchFalseExtraPopHW 788,33460 +(def-halfword-translation BranchHW 796,33760 +(def-halfword-translation TagHW 805,34089 + +translator/translat.lisp,14338 +(clos:defclass translation-state 14,631 +(clos:defclass decoded-function 28,1142 +(clos:defclass ivory-instruction 36,1363 +(clos:defclass fullword-instruction 46,1803 +(clos:defclass alpha-native-instruction 49,1897 +(clos:defclass alpha-native-branch-instruction 52,1969 +(clos:defclass halfword-instruction 55,2091 +(clos:defclass ibranch-format-instruction 58,2195 +(defun branch-format-hw-opcodep 62,2310 +(clos:defmethod instruction-labeledp 65,2390 +(clos:defmethod label-instruction 69,2505 +(clos:defmethod instruction-kind 76,2671 +(clos:defmethod instruction-kind 78,2749 +(clos:defmethod entry-instructionp 80,2827 +(clos:defmethod entry-instructionp 82,2900 +(clos:defmethod native-instructionp 86,3051 +(clos:defmethod native-instructionp 90,3222 +(defvar *Major-opcodes*93,3298 +(defvar *Opcode-Format*105,3674 +(defvar *register-names* 117,3993 +(defvar *op10-fcns* 123,4163 +(defvar *op11-fcns* 130,4566 +(defvar *op12-fcns*135,4807 +(defvar *op13-fcns* 142,5225 +(defun regname(145,5326 +(defun fcnname 147,5373 +(defvar *halfwordinstns* 159,5829 +(defvar *branch-format-opcodes* 418,12831 +(defvar *fullwordinstns* 677,21632 +(defun sign-extend 738,24429 +(clos:defmethod instruction-name 741,24531 +(clos:defmethod instruction-name 745,24672 +(defun i-lisp-compiler:vlm-print-native-instruction 750,24864 +(defun i-lisp-compiler:vlm-emulate-native-instruction 805,26869 +(clos:defmethod print-instruction 838,28053 +(clos:defmethod print-instruction 848,28520 +(clos:defmethod print-function 855,28840 +(clos:defmethod print-function 860,29035 +(defun tag-data-type 887,30363 +(defun tag-cdr-code 890,30413 +(defun instnref 893,30456 +(clos:defmethod findpc 910,31134 +(clos:defmethod abstract-branch-target 916,31337 +(clos:defmethod linkup-function 926,31774 +(defun i-lisp-compiler:vlm-decode-ivory-function 945,32621 +(defun make-hwinst 966,33346 +(defun make-fwinst 976,33670 +(clos:defmethod copy-instruction 984,33918 +(clos:defmethod copy-instruction 994,34210 +(clos:defmethod copy-instruction 1004,34499 +(defun make-alpha-instruction 1015,34825 +(clos:defmethod add-instruction 1028,35294 +(clos:defmethod decode-ivory-instruction 1039,35742 +(clos:defmethod set-instn-cdr-code 1077,37186 +(defmacro ivory-label 1081,37318 +(defmacro alpha-label 1084,37375 +(clos:defmethod setlabel 1087,37432 +(defmacro emit 1101,37939 +(clos:defmethod i-lisp-compiler:vlm-translate-function 1112,38294 +(clos:defmethod pack-instructions 1167,40791 +(defparameter *resume-emulated* 1325,46924 +(clos:defmethod set-instruction-mode 1327,47009 +(clos:defmethod emit-alphabits 1343,47499 +(defmacro make-escape 1363,48536 +(clos:defclass escape-block 1372,49031 +(clos:defmethod emit-make-escape 1377,49178 +(clos:defmethod emit-escape-blocks 1395,49878 +(clos:defmethod emit-block 1405,50270 +(defun map-cs-rel 1427,51212 +(defun map-ivory-register 1429,51272 +(defmacro decode-operand-specifier 1437,51547 +(defmacro compute-operand-value 1447,51884 +(defmacro compute-operand-value2 1450,52018 +(defmacro compute-operand-data 1453,52177 +(defmacro compute-operand-address 1456,52317 +(defmacro compute-operand-register-offset 1459,52419 +(clos:defmethod emit-compute-operand-value 1472,53163 +(clos:defmethod emit-compute-operand-value2 1498,54304 +(clos:defmethod emit-compute-operand-data 1518,55220 +(clos:defmethod emit-compute-operand-address 1540,56195 +(clos:defmethod emit-compute-operand-register-offset 1557,56861 +(defmacro TOSvalid 1584,58147 +(defmacro TOSstatus 1589,58283 +(defmacro cacheTOS 1593,58385 +(defmacro storeTOS 1599,58543 +(defmacro writeTOS 1601,58584 +(defmacro getTOStag 1609,58897 +(defmacro getTOSdata 1618,59208 +(defun allocate-registers 1628,59584 +(defun allocate-specific-registers 1634,59766 +(defun release-registers 1642,60008 +(defun release-specific-registers 1648,60163 +(defmacro with-temporary-registers 1653,60312 +(defmacro with-specific-registers 1662,60565 +(defmacro xlatSCAtoVMA 1671,60839 +(defmacro xlatConvertPcToContinuation 1678,61107 +(defmacro xlatConvertContinuationToPc 1683,61292 +(clos:defmethod allocate-register 1718,63362 +(clos:defmethod free-register 1725,63608 +(defmacro def-fullword-translation 1734,63996 +(defmacro def-halfword-translation 1737,64132 +(defmacro def-decoded-halfword-translation 1740,64268 +(defmacro do-default 1749,64595 +(clos:defmethod passthrough-ivory-instruction 1758,65065 +(def-halfword-translation Setup1DArrayHW 1778,66039 +(def-halfword-translation SetupForce1DArrayHW 1785,66327 +(def-halfword-translation BindLocativeHW 1792,66618 +(def-halfword-translation RestoreBindingStackHW 1799,66914 +(def-halfword-translation EphemeralpHW 1806,67205 +(def-halfword-translation StartCallHW 1813,67487 +(def-halfword-translation JumpHW 1820,67767 +(def-halfword-translation DereferenceHW 1827,68045 +(def-halfword-translation LogicTailTestHW 1834,68330 +(def-halfword-translation SpareOpHW 1841,68615 +(def-halfword-translation DoubleFloatOpHW 1848,68925 +(def-halfword-translation PushLexicalVarNHW 1855,69214 +(def-halfword-translation Block0WriteHW 1862,69502 +(def-halfword-translation Block1WriteHW 1869,69786 +(def-halfword-translation Block2WriteHW 1876,70070 +(def-halfword-translation Block3WriteHW 1883,70354 +(def-halfword-translation LocateLocalsHW 1890,70639 +(def-halfword-translation CatchCloseHW 1897,70925 +(def-halfword-translation GenericDispatchHW 1904,71211 +(def-halfword-translation MessageDispatchHW 1911,71502 +(def-halfword-translation CheckPreemptRequestHW 1918,71802 +(def-halfword-translation PushGlobalLogicVariableHW 1925,72107 +(def-halfword-translation NoOpHW 1932,72401 +(def-halfword-translation HaltHW 1939,72676 +(def-halfword-translation PushNNilsHW 1946,72958 +(def-halfword-translation PushAddressSpRelativeHW 1953,73259 +(def-halfword-translation PushLocalLogicVariablesHW 1960,73568 +(def-halfword-translation ReturnMultipleHW 1967,73868 +(def-halfword-translation ReturnKludgeHW 1974,74158 +(def-halfword-translation TakeValuesHW 1981,74451 +(def-halfword-translation UnbindNHW 1988,74734 +(def-halfword-translation PushInstanceVariableHW 1995,75028 +(def-halfword-translation PushAddressInstanceVariableHW 2002,75343 +(def-halfword-translation PushInstanceVariableOrderedHW 2009,75659 +(def-halfword-translation PushAddressInstanceVariableOrderedHW 2016,75979 +(def-halfword-translation UnaryMinusHW 2023,76293 +(def-halfword-translation ReturnSingleHW 2030,76579 +(def-halfword-translation MemoryReadHW 2037,76871 +(def-halfword-translation Block0ReadHW 2044,77161 +(def-halfword-translation Block1ReadHW 2051,77451 +(def-halfword-translation Block2ReadHW 2058,77741 +(def-halfword-translation Block3ReadHW 2065,78031 +(def-halfword-translation Block0ReadShiftHW 2072,78319 +(def-halfword-translation Block1ReadShiftHW 2079,78611 +(def-halfword-translation Block2ReadShiftHW 2086,78903 +(def-halfword-translation Block3ReadShiftHW 2093,79195 +(def-halfword-translation Block0ReadTestHW 2100,79487 +(def-halfword-translation Block1ReadTestHW 2107,79778 +(def-halfword-translation Block2ReadTestHW 2114,80069 +(def-halfword-translation Block3ReadTestHW 2121,80360 +(def-halfword-translation FinishCallNHW 2128,80649 +(def-halfword-translation FinishCallTosHW 2135,80935 +(def-halfword-translation FinishCallTosHW 2142,81224 +(def-halfword-translation IncrementHW 2149,81516 +(def-halfword-translation DecrementHW 2156,81804 +(def-halfword-translation PointerIncrementHW 2163,82096 +(def-halfword-translation SetCdrCode1HW 2170,82392 +(def-halfword-translation SetCdrCode2HW 2177,82682 +(def-halfword-translation ReadInternalRegisterHW 2184,82979 +(def-halfword-translation WriteInternalRegisterHW 2191,83286 +(def-halfword-translation CoprocessorReadHW 2198,83584 +(def-halfword-translation CoprocessorWriteHW 2205,83877 +(def-halfword-translation Block0ReadAluHW 2212,84169 +(def-halfword-translation Block1ReadAluHW 2219,84458 +(def-halfword-translation Block2ReadAluHW 2226,84747 +(def-halfword-translation Block3ReadAluHW 2233,85036 +(def-halfword-translation LdbHW 2240,85325 +(def-halfword-translation CharLdbHW 2247,85606 +(def-halfword-translation PLdbHW 2254,85890 +(def-halfword-translation PTagLdbHW 2261,86172 +(def-halfword-translation EntryRestAcceptedHW 2268,86457 +(def-halfword-translation EntryRestNotAcceptedHW 2275,86761 +(def-halfword-translation RplacaHW 2282,87059 +(def-halfword-translation RplacdHW 2289,87343 +(def-halfword-translation MultiplyHW 2296,87628 +(def-halfword-translation QuotientHW 2303,87915 +(def-halfword-translation CeilingHW 2310,88201 +(def-halfword-translation FloorHW 2317,88484 +(def-halfword-translation TruncateHW 2324,88767 +(def-halfword-translation RoundHW 2331,89052 +(def-halfword-translation RationalQuotientHW 2338,89334 +(def-halfword-translation MinHW 2345,89626 +(def-halfword-translation MaxHW 2352,89905 +(def-halfword-translation AluHW 2359,90179 +(def-halfword-translation LogandHW 2366,90460 +(def-halfword-translation LogxorHW 2373,90744 +(def-halfword-translation LogiorHW 2380,91028 +(def-halfword-translation RotHW 2387,91305 +(def-halfword-translation LshHW 2394,91584 +(def-halfword-translation MultiplyDoubleHW 2401,91869 +(def-halfword-translation LshcBignumStepHW 2408,92160 +(def-halfword-translation StackBltHW 2415,92448 +(def-halfword-translation RgetfHW 2422,92728 +(def-halfword-translation MemberHW 2429,93006 +(def-halfword-translation AssocHW 2436,93284 +(def-halfword-translation AshHW 2443,93565 +(def-halfword-translation StoreConditionalHW 2450,93847 +(def-halfword-translation MemoryWriteHW 2457,94143 +(def-halfword-translation PStoreContentsHW 2464,94430 +(def-halfword-translation BindLocativeToValueHW 2471,94730 +(def-halfword-translation UnifyHW 2478,95020 +(def-halfword-translation PopLexicalVarNHW 2485,95302 +(def-halfword-translation MovemLexicalVarNHW 2492,95594 +(def-halfword-translation EqualNumberHW 2499,95890 +(def-halfword-translation LesspHW 2506,96177 +(def-halfword-translation GreaterpHW 2513,96460 +(def-halfword-translation EqlHW 2520,96743 +(def-halfword-translation EqualNumberHW 2527,97026 +(def-halfword-translation LesspHW 2534,97313 +(def-halfword-translation GreaterpHW 2541,97596 +(def-halfword-translation LogtestHW 2548,97881 +(def-halfword-translation LogtestHW 2555,98166 +(def-halfword-translation SubHW 2562,98449 +(def-halfword-translation 32BitPlusHW 2569,98731 +(def-halfword-translation 32BitDifferenceHW 2576,99022 +(def-halfword-translation AddBignumStepHW 2583,99313 +(def-halfword-translation SubBignumStepHW 2590,99602 +(def-halfword-translation MultiplyBignumStepHW 2597,99894 +(def-halfword-translation DivideBignumStepHW 2604,100190 +(def-halfword-translation Aset1HW 2611,100478 +(def-halfword-translation AllocateListBlockHW 2618,100761 +(def-halfword-translation Aref1HW 2625,101050 +(def-halfword-translation Aloc1HW 2632,101327 +(def-halfword-translation StoreArrayLeaderHW 2639,101610 +(def-halfword-translation AllocateStructureBlockHW 2646,101914 +(def-halfword-translation ArrayLeaderHW 2653,102211 +(def-halfword-translation AlocLeaderHW 2660,102496 +(def-halfword-translation PopInstanceVariableHW 2667,102792 +(def-halfword-translation MovemInstanceVariableHW 2674,103097 +(def-halfword-translation PopInstanceVariableOrderedHW 2681,103408 +(def-halfword-translation MovemInstanceVariableOrderedHW 2688,103725 +(def-halfword-translation InstanceRefHW 2695,104028 +(def-halfword-translation InstanceSetHW 2702,104313 +(def-halfword-translation InstanceLocHW 2709,104598 +(def-halfword-translation SetTagHW 2716,104886 +(def-halfword-translation UnsignedLesspHW 2723,105173 +(def-halfword-translation MergeCdrNoPopHW 2730,105467 +(def-halfword-translation FastAref1HW 2737,105754 +(def-halfword-translation FastAset1HW 2744,106037 +(def-halfword-translation StackBltAddressHW 2751,106328 +(def-halfword-translation DpbHW 2758,106619 +(def-halfword-translation CharDpbHW 2765,106900 +(def-halfword-translation PDpbHW 2772,107184 +(def-halfword-translation PTagDpbHW 2779,107466 +(def-halfword-translation LoopIncrementTosLessThanHW 2786,107767 +(def-halfword-translation CatchOpenHW 2793,108065 +(def-halfword-translation SpareOpHW 2800,108347 +(def-fullword-translation pushconstantvalue 2809,108643 +(def-fullword-translation nullfw 2816,108919 +(def-fullword-translation monitorforwardfw 2823,109208 +(def-fullword-translation headerpfw 2830,109514 +(def-fullword-translation headerifw 2837,109806 +(def-fullword-translation valuecell 2844,110103 +(def-fullword-translation oneqforwardfw 2851,110416 +(def-fullword-translation headerforwardfw 2858,110720 +(def-fullword-translation elementforwardfw 2865,111028 +(def-fullword-translation boundlocationfw 2872,111337 +(def-fullword-translation logicvariablefw 2879,111644 +(def-fullword-translation gcforwardfw 2886,111949 +(def-fullword-translation callcompiledeven 2893,112249 +(def-fullword-translation callcompiledodd 2900,112561 +(def-fullword-translation callindirect 2907,112870 +(def-fullword-translation callgeneric 2914,113171 +(def-fullword-translation callcompiledevenprefetch 2921,113484 +(def-fullword-translation callcompiledoddprefetch 2928,113824 +(def-fullword-translation callindirectprefetch 2935,114154 +(def-fullword-translation callgenericprefetch 2942,114476 +(def-halfword-translation BranchTrueHW 2951,114824 +(def-halfword-translation BranchTrueElseExtraPopHW 2958,115126 +(def-halfword-translation BranchTrueAndExtraPopHW 2965,115439 +(def-halfword-translation BranchTrueExtraPopHW 2972,115743 +(def-halfword-translation BranchTrueNoPopHW 2979,116042 +(def-halfword-translation BranchTrueAndNoPopHW 2986,116340 +(def-halfword-translation BranchTrueElseNoPopHW 2993,116648 +(def-halfword-translation BranchTrueAndNoPopElseNoPopExtraPopHW 3000,116954 +(def-halfword-translation BranchFalseHW 3007,117267 +(def-halfword-translation BranchFalseElseExtraPopHW 3014,117569 +(def-halfword-translation BranchFalseAndExtraPopHW 3021,117884 +(def-halfword-translation BranchFalseExtraPopHW 3028,118196 +(def-halfword-translation BranchFalseNoPopHW 3035,118496 +(def-halfword-translation BranchFalseAndNoPopHW 3042,118802 +(def-halfword-translation BranchFalseElseNoPopHW 3049,119111 +(def-halfword-translation BranchFalseAndNoPopElseNoPopExtraPopHW 3056,119420 +(def-fullword-translation nativeinstruction 3064,119747 +(defun fib 3071,119913 +(defun tfib 3081,120074 + +translator/xtranrule.lisp,1890 +(def-halfword-translation SetSpToAddressHW 11,384 +(def-halfword-translation SetSpToAddressSaveTosHW 22,825 +(def-decoded-halfword-translation PushHW 31,1200 +(def-halfword-translation PopHW 43,1704 +(def-halfword-translation MovemHW 55,2151 +(def-halfword-translation PushAddressHW 65,2556 +(def-fullword-translation pushimmediateconstant 82,3344 +(def-halfword-translation TypeMemberHW 94,3802 +(def-halfword-translation PointerPlusHW 120,4898 +(def-halfword-translation PointerDifferenceHW 132,5396 +(def-decoded-halfword-translation ZeropHW 144,5895 +(defmacro simple-binary-arithmetic-translation 159,6335 +(def-decoded-halfword-translation AddHW 191,7711 +(def-decoded-halfword-translation SubHW 199,8081 +(def-decoded-halfword-translation MulHW 207,8451 +(def-halfword-translation LoopDecrementTosHW 216,8829 +(def-halfword-translation CarHW 243,9997 +(def-halfword-translation CdrHW 272,11228 +(def-halfword-translation SettoCdrHW 301,12464 +(defmacro trbranchcond 331,13699 +(def-halfword-translation BranchTrueNoPopHW 359,15124 +(def-halfword-translation BranchTrueAndNoPopElseNoPopExtraPopHW 366,15438 +(def-halfword-translation BranchTrueElseExtraPopHW 380,16087 +(def-halfword-translation BranchTrueElseNoPopHW 387,16406 +(def-halfword-translation BranchTrueAndExtraPopHW 394,16729 +(def-halfword-translation BranchTrueHW 401,17041 +(def-halfword-translation BranchTrueExtraPopHW 408,17345 +(def-halfword-translation BranchFalseNoPopHW 415,17650 +(def-halfword-translation BranchFalseAndNoPopElseNoPopExtraPopHW 422,17964 +(def-halfword-translation BranchFalseAndNoPopHW 429,18297 +(def-halfword-translation BranchFalseElseExtraPopHW 436,18614 +(def-halfword-translation BranchFalseElseNoPopHW 443,18933 +(def-halfword-translation BranchFalseAndExtraPopHW 450,19252 +(def-halfword-translation BranchFalseHW 457,19558 +(def-halfword-translation BranchFalseExtraPopHW 464,19867 + +translator/xtranslat.lisp,13764 +(clos:defclass translation-state 14,631 +(clos:defclass decoded-function 26,1064 +(clos:defclass ivory-instruction 34,1285 +(clos:defclass fullword-instruction 43,1774 +(clos:defclass alpha-native-instruction 46,1868 +(clos:defclass alpha-native-branch-instruction 49,1940 +(clos:defclass halfword-instruction 52,2062 +(clos:defclass ibranch-format-instruction 55,2166 +(defun branch-format-hw-opcodep 59,2281 +(clos:defmethod instruction-labeledp 62,2361 +(clos:defmethod label-instruction 66,2476 +(clos:defmethod instruction-kind 72,2643 +(clos:defmethod instruction-kind 74,2721 +(clos:defmethod entry-instructionp 76,2799 +(clos:defmethod entry-instructionp 78,2872 +(clos:defmethod native-instructionp 82,3023 +(clos:defmethod native-instructionp 86,3174 +(defvar *Major-opcodes*89,3250 +(defvar *Opcode-Format*101,3754 +(defvar *register-names* 113,4073 +(defvar *op10-fcns* 119,4243 +(defvar *op11-fcns* 126,4646 +(defvar *op12-fcns*131,4887 +(defvar *op13-fcns* 138,5305 +(defun regname(141,5406 +(defun fcnname 143,5453 +(defvar *halfwordinstns* 155,5909 +(defvar *branch-format-opcodes* 414,12911 +(defvar *fullwordinstns* 673,21712 +(defconstant *native-instruction-opcode* 724,24061 +(clos:defmethod instruction-name 736,24557 +(clos:defmethod instruction-name 740,24698 +(defun print-native-instruction 745,24890 +(clos:defmethod print-instruction 788,26488 +(clos:defmethod print-instruction 798,26935 +(clos:defmethod print-function 805,27255 +(clos:defmethod print-function 810,27450 +(defun tag-data-type 837,28778 +(defun tag-cdr-code 840,28828 +(defun instnref 843,28871 +(clos:defmethod findpc 852,29272 +(clos:defmethod abstract-branch-target 858,29475 +(clos:defmethod linkup-function 872,30086 +(defun decode-ivory-function 892,31033 +(defun make-hwinst 915,31770 +(defun make-fwinst 925,32094 +(clos:defmethod copy-instruction 933,32342 +(clos:defmethod copy-instruction 943,32634 +(clos:defmethod copy-instruction 953,32923 +(defun make-alpha-instruction 964,33249 +(clos:defmethod add-instruction 977,33698 +(clos:defmethod decode-ivory-instruction 988,34162 +(clos:defmethod set-instn-cdr-code 1026,35630 +(defmacro ivory-label 1030,35762 +(defmacro alpha-label 1033,35819 +(clos:defmethod setlabel 1036,35876 +(defmacro emit 1050,36395 +(clos:defmethod translate-function 1061,36750 +(clos:defmethod pack-instructions 1108,38883 +(defparameter *resume-emulated* 1270,45201 +(clos:defmethod set-instruction-mode 1272,45286 +(clos:defmethod emit-alphabits 1288,45776 +(defmacro make-escape 1308,46813 +(clos:defclass escape-block 1317,47277 +(clos:defmethod emit-make-escape 1321,47387 +(clos:defmethod emit-escape-blocks 1338,48060 +(clos:defmethod emit-block 1348,48452 +(defun map-cs-rel 1360,49031 +(defun map-ivory-register 1362,49091 +(defmacro decode-operand-specifier 1370,49366 +(defmacro compute-operand-value 1380,49715 +(defmacro compute-operand-value2 1383,49849 +(defmacro compute-operand-data 1386,50008 +(defmacro compute-operand-address 1389,50148 +(defmacro compute-operand-register-offset 1392,50250 +(clos:defmethod emit-compute-operand-value 1405,50994 +(clos:defmethod emit-compute-operand-value2 1429,52038 +(clos:defmethod emit-compute-operand-data 1448,52928 +(clos:defmethod emit-compute-operand-address 1469,53877 +(clos:defmethod emit-compute-operand-register-offset 1485,54520 +(defmacro TOSvalid 1511,55792 +(defmacro TOSstatus 1515,55891 +(defmacro cacheTOS 1519,55970 +(defmacro storeTOS 1525,56128 +(defmacro writeTOS 1527,56169 +(defmacro getTOStag 1535,56482 +(defmacro getTOSdata 1544,56793 +(defun allocate-registers 1554,57169 +(defun allocate-1specific-0registers 1560,57351 +(defun release-registers 1568,57617 +(defun release-1specific-0registers 1574,57772 +(defmacro with-temporary-registers 1579,57937 +(defmacro with-1specific0-registers 1588,58190 +(defmacro xlatSCAtoVMA 1597,58496 +(defmacro xlatConvertPcToContinuation 1604,58732 +(defmacro xlatConvertContinuationToPc 1609,58917 +(clos:defmethod allocate-register 1644,60987 +(clos:defmethod free-register 1651,61233 +(defmacro def-fullword-translation 1660,61621 +(defmacro def-halfword-translation 1663,61757 +(defmacro def-decoded-halfword-translation 1666,61893 +(defmacro do-default 1675,62220 +(clos:defmethod passthrough-ivory-instruction 1684,62690 +(def-halfword-translation CdrHW 1704,63664 +(def-halfword-translation EndpHW 1711,63942 +(def-halfword-translation Setup1DArrayHW 1718,64220 +(def-halfword-translation SetupForce1DArrayHW 1725,64508 +(def-halfword-translation BindLocativeHW 1732,64799 +(def-halfword-translation RestoreBindingStackHW 1739,65095 +(def-halfword-translation EphemeralpHW 1746,65386 +(def-halfword-translation StartCallHW 1753,65668 +(def-halfword-translation JumpHW 1760,65948 +(def-halfword-translation TagHW 1767,66227 +(def-halfword-translation DereferenceHW 1774,66504 +(def-halfword-translation LogicTailTestHW 1781,66789 +(def-halfword-translation SpareOpHW 1788,67074 +(def-halfword-translation DoubleFloatOpHW 1795,67384 +(def-halfword-translation PushLexicalVarNHW 1802,67673 +(def-halfword-translation Block0WriteHW 1809,67961 +(def-halfword-translation Block1WriteHW 1816,68245 +(def-halfword-translation Block2WriteHW 1823,68529 +(def-halfword-translation Block3WriteHW 1830,68813 +(def-halfword-translation MinuspHW 1837,69100 +(def-halfword-translation PluspHW 1844,69382 +(def-halfword-translation LocateLocalsHW 1851,69662 +(def-halfword-translation CatchCloseHW 1858,69948 +(def-halfword-translation GenericDispatchHW 1865,70234 +(def-halfword-translation MessageDispatchHW 1872,70525 +(def-halfword-translation CheckPreemptRequestHW 1879,70825 +(def-halfword-translation PushGlobalLogicVariableHW 1886,71130 +(def-halfword-translation NoOpHW 1893,71424 +(def-halfword-translation HaltHW 1900,71699 +(def-halfword-translation PushNNilsHW 1907,71981 +(def-halfword-translation PushAddressSpRelativeHW 1914,72282 +(def-halfword-translation PushLocalLogicVariablesHW 1921,72591 +(def-halfword-translation ReturnMultipleHW 1928,72891 +(def-halfword-translation ReturnKludgeHW 1935,73181 +(def-halfword-translation TakeValuesHW 1942,73474 +(def-halfword-translation UnbindNHW 1949,73757 +(def-halfword-translation PushInstanceVariableHW 1956,74051 +(def-halfword-translation PushAddressInstanceVariableHW 1963,74366 +(def-halfword-translation PushInstanceVariableOrderedHW 1970,74682 +(def-halfword-translation PushAddressInstanceVariableOrderedHW 1977,75002 +(def-halfword-translation UnaryMinusHW 1984,75316 +(def-halfword-translation ReturnSingleHW 1991,75602 +(def-halfword-translation MemoryReadHW 1998,75894 +(def-halfword-translation Block0ReadHW 2005,76184 +(def-halfword-translation Block1ReadHW 2012,76474 +(def-halfword-translation Block2ReadHW 2019,76764 +(def-halfword-translation Block3ReadHW 2026,77054 +(def-halfword-translation Block0ReadShiftHW 2033,77342 +(def-halfword-translation Block1ReadShiftHW 2040,77634 +(def-halfword-translation Block2ReadShiftHW 2047,77926 +(def-halfword-translation Block3ReadShiftHW 2054,78218 +(def-halfword-translation Block0ReadTestHW 2061,78510 +(def-halfword-translation Block1ReadTestHW 2068,78801 +(def-halfword-translation Block2ReadTestHW 2075,79092 +(def-halfword-translation Block3ReadTestHW 2082,79383 +(def-halfword-translation FinishCallNHW 2089,79672 +(def-halfword-translation FinishCallTosHW 2096,79958 +(def-halfword-translation FinishCallTosHW 2103,80247 +(def-halfword-translation SetToCarHW 2110,80539 +(def-halfword-translation SetToCdrHW 2117,80826 +(def-halfword-translation SetToCdrPushCarHW 2124,81116 +(def-halfword-translation IncrementHW 2131,81410 +(def-halfword-translation DecrementHW 2138,81698 +(def-halfword-translation PointerIncrementHW 2145,81990 +(def-halfword-translation SetCdrCode1HW 2152,82286 +(def-halfword-translation SetCdrCode2HW 2159,82576 +(def-halfword-translation ReadInternalRegisterHW 2166,82873 +(def-halfword-translation WriteInternalRegisterHW 2173,83180 +(def-halfword-translation CoprocessorReadHW 2180,83478 +(def-halfword-translation CoprocessorWriteHW 2187,83771 +(def-halfword-translation Block0ReadAluHW 2194,84063 +(def-halfword-translation Block1ReadAluHW 2201,84352 +(def-halfword-translation Block2ReadAluHW 2208,84641 +(def-halfword-translation Block3ReadAluHW 2215,84930 +(def-halfword-translation LdbHW 2222,85219 +(def-halfword-translation CharLdbHW 2229,85500 +(def-halfword-translation PLdbHW 2236,85784 +(def-halfword-translation PTagLdbHW 2243,86066 +(def-halfword-translation BranchHW 2250,86351 +(def-halfword-translation EntryRestAcceptedHW 2257,86635 +(def-halfword-translation EntryRestNotAcceptedHW 2264,86939 +(def-halfword-translation RplacaHW 2271,87237 +(def-halfword-translation RplacdHW 2278,87521 +(def-halfword-translation MultiplyHW 2285,87806 +(def-halfword-translation QuotientHW 2292,88093 +(def-halfword-translation CeilingHW 2299,88379 +(def-halfword-translation FloorHW 2306,88662 +(def-halfword-translation TruncateHW 2313,88945 +(def-halfword-translation RoundHW 2320,89230 +(def-halfword-translation RationalQuotientHW 2327,89512 +(def-halfword-translation MinHW 2334,89804 +(def-halfword-translation MaxHW 2341,90083 +(def-halfword-translation AluHW 2348,90357 +(def-halfword-translation LogandHW 2355,90638 +(def-halfword-translation LogxorHW 2362,90922 +(def-halfword-translation LogiorHW 2369,91206 +(def-halfword-translation RotHW 2376,91483 +(def-halfword-translation LshHW 2383,91762 +(def-halfword-translation MultiplyDoubleHW 2390,92047 +(def-halfword-translation LshcBignumStepHW 2397,92338 +(def-halfword-translation StackBltHW 2404,92626 +(def-halfword-translation RgetfHW 2411,92906 +(def-halfword-translation MemberHW 2418,93184 +(def-halfword-translation AssocHW 2425,93462 +(def-halfword-translation AshHW 2432,93743 +(def-halfword-translation StoreConditionalHW 2439,94025 +(def-halfword-translation MemoryWriteHW 2446,94321 +(def-halfword-translation PStoreContentsHW 2453,94608 +(def-halfword-translation BindLocativeToValueHW 2460,94908 +(def-halfword-translation UnifyHW 2467,95198 +(def-halfword-translation PopLexicalVarNHW 2474,95480 +(def-halfword-translation MovemLexicalVarNHW 2481,95772 +(def-halfword-translation EqualNumberHW 2488,96068 +(def-halfword-translation LesspHW 2495,96355 +(def-halfword-translation GreaterpHW 2502,96638 +(def-halfword-translation EqlHW 2509,96921 +(def-halfword-translation EqualNumberHW 2516,97204 +(def-halfword-translation LesspHW 2523,97491 +(def-halfword-translation GreaterpHW 2530,97774 +(def-halfword-translation EqlHW 2537,98057 +(def-halfword-translation EqHW 2544,98329 +(def-halfword-translation LogtestHW 2551,98609 +(def-halfword-translation LogtestHW 2558,98894 +(def-halfword-translation SubHW 2565,99177 +(def-halfword-translation 32BitPlusHW 2572,99459 +(def-halfword-translation 32BitDifferenceHW 2579,99750 +(def-halfword-translation AddBignumStepHW 2586,100041 +(def-halfword-translation SubBignumStepHW 2593,100330 +(def-halfword-translation MultiplyBignumStepHW 2600,100622 +(def-halfword-translation DivideBignumStepHW 2607,100918 +(def-halfword-translation Aset1HW 2614,101206 +(def-halfword-translation AllocateListBlockHW 2621,101489 +(def-halfword-translation Aref1HW 2628,101778 +(def-halfword-translation Aloc1HW 2635,102055 +(def-halfword-translation StoreArrayLeaderHW 2642,102338 +(def-halfword-translation AllocateStructureBlockHW 2649,102642 +(def-halfword-translation ArrayLeaderHW 2656,102939 +(def-halfword-translation AlocLeaderHW 2663,103224 +(def-halfword-translation PopInstanceVariableHW 2670,103520 +(def-halfword-translation MovemInstanceVariableHW 2677,103825 +(def-halfword-translation PopInstanceVariableOrderedHW 2684,104136 +(def-halfword-translation MovemInstanceVariableOrderedHW 2691,104453 +(def-halfword-translation InstanceRefHW 2698,104756 +(def-halfword-translation InstanceSetHW 2705,105041 +(def-halfword-translation InstanceLocHW 2712,105326 +(def-halfword-translation SetTagHW 2719,105614 +(def-halfword-translation UnsignedLesspHW 2726,105901 +(def-halfword-translation MergeCdrNoPopHW 2733,106195 +(def-halfword-translation FastAref1HW 2740,106482 +(def-halfword-translation FastAset1HW 2747,106765 +(def-halfword-translation StackBltAddressHW 2754,107056 +(def-halfword-translation DpbHW 2761,107347 +(def-halfword-translation CharDpbHW 2768,107628 +(def-halfword-translation PDpbHW 2775,107912 +(def-halfword-translation PTagDpbHW 2782,108194 +(def-halfword-translation LoopIncrementTosLessThanHW 2789,108495 +(def-halfword-translation CatchOpenHW 2796,108793 +(def-halfword-translation SpareOpHW 2803,109075 +(def-fullword-translation pushconstantvalue 2812,109371 +(def-fullword-translation nullfw 2819,109647 +(def-fullword-translation monitorforwardfw 2826,109936 +(def-fullword-translation headerpfw 2833,110242 +(def-fullword-translation headerifw 2840,110534 +(def-fullword-translation valuecell 2847,110831 +(def-fullword-translation oneqforwardfw 2854,111144 +(def-fullword-translation headerforwardfw 2861,111448 +(def-fullword-translation elementforwardfw 2868,111756 +(def-fullword-translation boundlocationfw 2875,112065 +(def-fullword-translation logicvariablefw 2882,112372 +(def-fullword-translation gcforwardfw 2889,112677 +(def-fullword-translation callcompiledeven 2896,112977 +(def-fullword-translation callcompiledodd 2903,113289 +(def-fullword-translation callindirect 2910,113598 +(def-fullword-translation callgeneric 2917,113899 +(def-fullword-translation callcompiledevenprefetch 2924,114212 +(def-fullword-translation callcompiledoddprefetch 2931,114552 +(def-fullword-translation callindirectprefetch 2938,114882 +(def-fullword-translation callgenericprefetch 2945,115204 +(def-fullword-translation nativeinstruction 2955,115541 +(defun fib 2962,115707 +(defun tfib 2972,115868 + +stub/ifunhead.c,0 + +life-support/network.c,0 + +g5-emulator/aistat.c,0 + +emulator/traps.c,0 + +emulator/aihead.c,0 + +alpha-emulator/aistat.c,0 diff --git a/TODO b/TODO new file mode 100644 index 0000000..ac67bbd --- /dev/null +++ b/TODO @@ -0,0 +1,25 @@ +plans for further development: + +- reconsider using the tap interface using a different method to pick up / + inject eth frames. A pf interface (BSD-like) isn't available for LINUX + in a usable fashion like on the alpha ?? maybe try and use libpcap + +- clean up the life-support routines (partly done) + +- move everything into an autoconf/automake project (partly done, + working at least) + +- instead of generating c-code maybe generate x64 assembly code directly - + not much performance gain to be expected and lots of tedious work. + with gcc, c-code is performant anyway... + +- build a time routine to be used instead of querying the network for + universal time at startup. At least with ip this is still taking ages at + startup, using chaosnet is faster, using a builtin routine would even be + faster than that. Also find a way to get the DST from the embedding system + because the LISP code used to dtermine DST is outdated and anyway only + working for US DST definitions. + +- add an option for setting the guest MAC address like + "tap0:MAC|01:02:03:04:05:06" to utilities.c and life-support/network-tap... + probably needed to set a MAC address for MACSYMA key generation diff --git a/acinclude.m4 b/acinclude.m4 new file mode 100644 index 0000000..d6b534d --- /dev/null +++ b/acinclude.m4 @@ -0,0 +1,461 @@ +dnl @synopsis ACX_PTHREAD([ACTION-IF-FOUND[, ACTION-IF-NOT-FOUND]]) +dnl +dnl @summary figure out how to build C programs using POSIX threads +dnl +dnl This macro figures out how to build C programs using POSIX threads. +dnl It sets the PTHREAD_LIBS output variable to the threads library and +dnl linker flags, and the PTHREAD_CFLAGS output variable to any special +dnl C compiler flags that are needed. (The user can also force certain +dnl compiler flags/libs to be tested by setting these environment +dnl variables.) +dnl +dnl Also sets PTHREAD_CC to any special C compiler that is needed for +dnl multi-threaded programs (defaults to the value of CC otherwise). +dnl (This is necessary on AIX to use the special cc_r compiler alias.) +dnl +dnl NOTE: You are assumed to not only compile your program with these +dnl flags, but also link it with them as well. e.g. you should link +dnl with $PTHREAD_CC $CFLAGS $PTHREAD_CFLAGS $LDFLAGS ... $PTHREAD_LIBS +dnl $LIBS +dnl +dnl If you are only building threads programs, you may wish to use +dnl these variables in your default LIBS, CFLAGS, and CC: +dnl +dnl LIBS="$PTHREAD_LIBS $LIBS" +dnl CFLAGS="$CFLAGS $PTHREAD_CFLAGS" +dnl CC="$PTHREAD_CC" +dnl +dnl In addition, if the PTHREAD_CREATE_JOINABLE thread-attribute +dnl constant has a nonstandard name, defines PTHREAD_CREATE_JOINABLE to +dnl that name (e.g. PTHREAD_CREATE_UNDETACHED on AIX). +dnl +dnl ACTION-IF-FOUND is a list of shell commands to run if a threads +dnl library is found, and ACTION-IF-NOT-FOUND is a list of commands to +dnl run it if it is not found. If ACTION-IF-FOUND is not specified, the +dnl default action will define HAVE_PTHREAD. +dnl +dnl Please let the authors know if this macro fails on any platform, or +dnl if you have any other suggestions or comments. This macro was based +dnl on work by SGJ on autoconf scripts for FFTW (www.fftw.org) (with +dnl help from M. Frigo), as well as ac_pthread and hb_pthread macros +dnl posted by Alejandro Forero Cuervo to the autoconf macro repository. +dnl We are also grateful for the helpful feedback of numerous users. +dnl +dnl @category InstalledPackages +dnl @author Steven G. Johnson +dnl @version 2006-05-29 +dnl @license GPLWithACException + +AC_DEFUN([ACX_PTHREAD], [ +AC_REQUIRE([AC_CANONICAL_HOST]) +AC_LANG_SAVE +AC_LANG_C +acx_pthread_ok=no + +# We used to check for pthread.h first, but this fails if pthread.h +# requires special compiler flags (e.g. on True64 or Sequent). +# It gets checked for in the link test anyway. + +# First of all, check if the user has set any of the PTHREAD_LIBS, +# etcetera environment variables, and if threads linking works using +# them: +if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + save_LIBS="$LIBS" + LIBS="$PTHREAD_LIBS $LIBS" + AC_MSG_CHECKING([for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS]) + AC_TRY_LINK_FUNC(pthread_join, acx_pthread_ok=yes) + AC_MSG_RESULT($acx_pthread_ok) + if test x"$acx_pthread_ok" = xno; then + PTHREAD_LIBS="" + PTHREAD_CFLAGS="" + fi + LIBS="$save_LIBS" + CFLAGS="$save_CFLAGS" +fi + +# We must check for the threads library under a number of different +# names; the ordering is very important because some systems +# (e.g. DEC) have both -lpthread and -lpthreads, where one of the +# libraries is broken (non-POSIX). + +# Create a list of thread flags to try. Items starting with a "-" are +# C compiler flags, and other items are library names, except for "none" +# which indicates that we try without any flags at all, and "pthread-config" +# which is a program returning the flags for the Pth emulation library. + +acx_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config" + +# The ordering *is* (sometimes) important. Some notes on the +# individual items follow: + +# pthreads: AIX (must check this before -lpthread) +# none: in case threads are in libc; should be tried before -Kthread and +# other compiler flags to prevent continual compiler warnings +# -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h) +# -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able) +# lthread: LinuxThreads port on FreeBSD (also preferred to -pthread) +# -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads) +# -pthreads: Solaris/gcc +# -mthreads: Mingw32/gcc, Lynx/gcc +# -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it +# doesn't hurt to check since this sometimes defines pthreads too; +# also defines -D_REENTRANT) +# ... -mt is also the pthreads flag for HP/aCC +# pthread: Linux, etcetera +# --thread-safe: KAI C++ +# pthread-config: use pthread-config program (for GNU Pth library) + +case "${host_cpu}-${host_os}" in + *solaris*) + + # On Solaris (at least, for some versions), libc contains stubbed + # (non-functional) versions of the pthreads routines, so link-based + # tests will erroneously succeed. (We need to link with -pthreads/-mt/ + # -lpthread.) (The stubs are missing pthread_cleanup_push, or rather + # a function called by this macro, so we could check for that, but + # who knows whether they'll stub that too in a future libc.) So, + # we'll just look for -pthreads and -lpthread first: + + acx_pthread_flags="-pthreads pthread -mt -pthread $acx_pthread_flags" + ;; +esac + +if test x"$acx_pthread_ok" = xno; then +for flag in $acx_pthread_flags; do + + case $flag in + none) + AC_MSG_CHECKING([whether pthreads work without any flags]) + ;; + + -*) + AC_MSG_CHECKING([whether pthreads work with $flag]) + PTHREAD_CFLAGS="$flag" + ;; + + pthread-config) + AC_CHECK_PROG(acx_pthread_config, pthread-config, yes, no) + if test x"$acx_pthread_config" = xno; then continue; fi + PTHREAD_CFLAGS="`pthread-config --cflags`" + PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`" + ;; + + *) + AC_MSG_CHECKING([for the pthreads library -l$flag]) + PTHREAD_LIBS="-l$flag" + ;; + esac + + save_LIBS="$LIBS" + save_CFLAGS="$CFLAGS" + LIBS="$PTHREAD_LIBS $LIBS" + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + + # Check for various functions. We must include pthread.h, + # since some functions may be macros. (On the Sequent, we + # need a special flag -Kthread to make this header compile.) + # We check for pthread_join because it is in -lpthread on IRIX + # while pthread_create is in libc. We check for pthread_attr_init + # due to DEC craziness with -lpthreads. We check for + # pthread_cleanup_push because it is one of the few pthread + # functions on Solaris that doesn't have a non-functional libc stub. + # We try pthread_create on general principles. + AC_TRY_LINK([#include ], + [pthread_t th; pthread_join(th, 0); + pthread_attr_init(0); pthread_cleanup_push(0, 0); + pthread_create(0,0,0,0); pthread_cleanup_pop(0); ], + [acx_pthread_ok=yes]) + + LIBS="$save_LIBS" + CFLAGS="$save_CFLAGS" + + AC_MSG_RESULT($acx_pthread_ok) + if test "x$acx_pthread_ok" = xyes; then + break; + fi + + PTHREAD_LIBS="" + PTHREAD_CFLAGS="" +done +fi + +# Various other checks: +if test "x$acx_pthread_ok" = xyes; then + save_LIBS="$LIBS" + LIBS="$PTHREAD_LIBS $LIBS" + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + + # Detect AIX lossage: JOINABLE attribute is called UNDETACHED. + AC_MSG_CHECKING([for joinable pthread attribute]) + attr_name=unknown + for attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do + AC_TRY_LINK([#include ], [int attr=$attr; return attr;], + [attr_name=$attr; break]) + done + AC_MSG_RESULT($attr_name) + if test "$attr_name" != PTHREAD_CREATE_JOINABLE; then + AC_DEFINE_UNQUOTED(PTHREAD_CREATE_JOINABLE, $attr_name, + [Define to necessary symbol if this constant + uses a non-standard name on your system.]) + fi + + AC_MSG_CHECKING([if more special flags are required for pthreads]) + flag=no + case "${host_cpu}-${host_os}" in + *-aix* | *-freebsd* | *-darwin*) flag="-D_THREAD_SAFE";; + *solaris* | *-osf* | *-hpux*) flag="-D_REENTRANT";; + esac + AC_MSG_RESULT(${flag}) + if test "x$flag" != xno; then + PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS" + fi + + LIBS="$save_LIBS" + CFLAGS="$save_CFLAGS" + + # More AIX lossage: must compile with xlc_r or cc_r + if test x"$GCC" != xyes; then + AC_CHECK_PROGS(PTHREAD_CC, xlc_r cc_r, ${CC}) + else + PTHREAD_CC=$CC + fi +else + PTHREAD_CC="$CC" +fi + +AC_SUBST(PTHREAD_LIBS) +AC_SUBST(PTHREAD_CFLAGS) +AC_SUBST(PTHREAD_CC) + +# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: +if test x"$acx_pthread_ok" = xyes; then + ifelse([$1],,AC_DEFINE(HAVE_PTHREAD,1,[Define if you have POSIX threads libraries and header files.]),[$1]) + : +else + acx_pthread_ok=no + $2 +fi +AC_LANG_RESTORE +])dnl ACX_PTHREAD + +# =========================================================================== +# https://www.gnu.org/software/autoconf-archive/ax_check_compile_flag.html +# =========================================================================== +# +# SYNOPSIS +# +# AX_CHECK_COMPILE_FLAG(FLAG, [ACTION-SUCCESS], [ACTION-FAILURE], [EXTRA-FLAGS], [INPUT]) +# +# DESCRIPTION +# +# Check whether the given FLAG works with the current language's compiler +# or gives an error. (Warnings, however, are ignored) +# +# ACTION-SUCCESS/ACTION-FAILURE are shell commands to execute on +# success/failure. +# +# If EXTRA-FLAGS is defined, it is added to the current language's default +# flags (e.g. CFLAGS) when the check is done. The check is thus made with +# the flags: "CFLAGS EXTRA-FLAGS FLAG". This can for example be used to +# force the compiler to issue an error when a bad flag is given. +# +# INPUT gives an alternative input source to AC_COMPILE_IFELSE. +# +# NOTE: Implementation based on AX_CFLAGS_GCC_OPTION. Please keep this +# macro in sync with AX_CHECK_{PREPROC,LINK}_FLAG. +# +# LICENSE +# +# Copyright (c) 2008 Guido U. Draheim +# Copyright (c) 2011 Maarten Bosmans +# +# This program is free software: you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by the +# Free Software Foundation, either version 3 of the License, or (at your +# option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General +# Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with this program. If not, see . +# +# As a special exception, the respective Autoconf Macro's copyright owner +# gives unlimited permission to copy, distribute and modify the configure +# scripts that are the output of Autoconf when processing the Macro. You +# need not follow the terms of the GNU General Public License when using +# or distributing such scripts, even though portions of the text of the +# Macro appear in them. The GNU General Public License (GPL) does govern +# all other use of the material that constitutes the Autoconf Macro. +# +# This special exception to the GPL applies to versions of the Autoconf +# Macro released by the Autoconf Archive. When you make and distribute a +# modified version of the Autoconf Macro, you may extend this special +# exception to the GPL to apply to your modified version as well. + +AC_DEFUN([AX_CHECK_COMPILE_FLAG], +[AC_PREREQ(2.64)dnl for _AC_LANG_PREFIX and AS_VAR_IF +AS_VAR_PUSHDEF([CACHEVAR],[ax_cv_check_[]_AC_LANG_ABBREV[]flags_$4_$1])dnl +AC_CACHE_CHECK([whether _AC_LANG compiler accepts $1], CACHEVAR, [ + ax_check_save_flags=$[]_AC_LANG_PREFIX[]FLAGS + _AC_LANG_PREFIX[]FLAGS="$[]_AC_LANG_PREFIX[]FLAGS $4 $1" + AC_COMPILE_IFELSE([m4_default([$5],[AC_LANG_PROGRAM()])], + [AS_VAR_SET(CACHEVAR,[yes])], + [AS_VAR_SET(CACHEVAR,[no])]) + _AC_LANG_PREFIX[]FLAGS=$ax_check_save_flags]) +AS_VAR_IF(CACHEVAR,yes, + [m4_default([$2], :)], + [m4_default([$3], :)]) +AS_VAR_POPDEF([CACHEVAR])dnl +])dnl AX_CHECK_COMPILE_FLAGS + +AC_DEFUN([AX_CFLAGS_GCC_OPTION_OLD], [dnl +AS_VAR_PUSHDEF([FLAGS],[CFLAGS])dnl +AS_VAR_PUSHDEF([VAR],[ac_cv_cflags_gcc_option_$2])dnl +AC_CACHE_CHECK([m4_ifval($1,$1,FLAGS) for gcc m4_ifval($2,$2,-option)], +VAR,[VAR="no, unknown" + AC_LANG_SAVE + AC_LANG_C + ac_save_[]FLAGS="$[]FLAGS" +for ac_arg dnl +in "-pedantic -Werror % m4_ifval($2,$2,-option)" dnl GCC + "-pedantic % m4_ifval($2,$2,-option) %% no, obsolete" dnl new GCC + # +do FLAGS="$ac_save_[]FLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + AC_TRY_COMPILE([],[return 0;], + [VAR=`echo $ac_arg | sed -e 's,.*% *,,'` ; break]) +done + FLAGS="$ac_save_[]FLAGS" + AC_LANG_RESTORE +]) +case ".$VAR" in + .ok|.ok,*) m4_ifvaln($3,$3) ;; + .|.no|.no,*) m4_ifvaln($4,$4) ;; + *) m4_ifvaln($3,$3,[ + if echo " $[]m4_ifval($1,$1,FLAGS) " | grep " $VAR " 2>&1 >/dev/null + then AC_RUN_LOG([: m4_ifval($1,$1,FLAGS) does contain $VAR]) + else AC_RUN_LOG([: m4_ifval($1,$1,FLAGS)="$m4_ifval($1,$1,FLAGS) $VAR"]) + m4_ifval($1,$1,FLAGS)="$m4_ifval($1,$1,FLAGS) $VAR" + fi ]) ;; +esac +AS_VAR_POPDEF([VAR])dnl +AS_VAR_POPDEF([FLAGS])dnl +]) + + +dnl the only difference - the LANG selection... and the default FLAGS + +AC_DEFUN([AX_CXXFLAGS_GCC_OPTION_OLD], [dnl +AS_VAR_PUSHDEF([FLAGS],[CXXFLAGS])dnl +AS_VAR_PUSHDEF([VAR],[ac_cv_cxxflags_gcc_option_$2])dnl +AC_CACHE_CHECK([m4_ifval($1,$1,FLAGS) for gcc m4_ifval($2,$2,-option)], +VAR,[VAR="no, unknown" + AC_LANG_SAVE + AC_LANG_CPLUSPLUS + ac_save_[]FLAGS="$[]FLAGS" +for ac_arg dnl +in "-pedantic -Werror % m4_ifval($2,$2,-option)" dnl GCC + "-pedantic % m4_ifval($2,$2,-option) %% no, obsolete" dnl new GCC + # +do FLAGS="$ac_save_[]FLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + AC_TRY_COMPILE([],[return 0;], + [VAR=`echo $ac_arg | sed -e 's,.*% *,,'` ; break]) +done + FLAGS="$ac_save_[]FLAGS" + AC_LANG_RESTORE +]) +case ".$VAR" in + .ok|.ok,*) m4_ifvaln($3,$3) ;; + .|.no|.no,*) m4_ifvaln($4,$4) ;; + *) m4_ifvaln($3,$3,[ + if echo " $[]m4_ifval($1,$1,FLAGS) " | grep " $VAR " 2>&1 >/dev/null + then AC_RUN_LOG([: m4_ifval($1,$1,FLAGS) does contain $VAR]) + else AC_RUN_LOG([: m4_ifval($1,$1,FLAGS)="$m4_ifval($1,$1,FLAGS) $VAR"]) + m4_ifval($1,$1,FLAGS)="$m4_ifval($1,$1,FLAGS) $VAR" + fi ]) ;; +esac +AS_VAR_POPDEF([VAR])dnl +AS_VAR_POPDEF([FLAGS])dnl +]) + +dnl ------------------------------------------------------------------------- + +AC_DEFUN([AX_CFLAGS_GCC_OPTION_NEW], [dnl +AS_VAR_PUSHDEF([FLAGS],[CFLAGS])dnl +AS_VAR_PUSHDEF([VAR],[ac_cv_cflags_gcc_option_$1])dnl +AC_CACHE_CHECK([m4_ifval($2,$2,FLAGS) for gcc m4_ifval($1,$1,-option)], +VAR,[VAR="no, unknown" + AC_LANG_SAVE + AC_LANG_C + ac_save_[]FLAGS="$[]FLAGS" +for ac_arg dnl +in "-pedantic -Werror % m4_ifval($1,$1,-option)" dnl GCC + "-pedantic % m4_ifval($1,$1,-option) %% no, obsolete" dnl new GCC + # +do FLAGS="$ac_save_[]FLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + AC_TRY_COMPILE([],[return 0;], + [VAR=`echo $ac_arg | sed -e 's,.*% *,,'` ; break]) +done + FLAGS="$ac_save_[]FLAGS" + AC_LANG_RESTORE +]) +case ".$VAR" in + .ok|.ok,*) m4_ifvaln($3,$3) ;; + .|.no|.no,*) m4_ifvaln($4,$4) ;; + *) m4_ifvaln($3,$3,[ + if echo " $[]m4_ifval($2,$2,FLAGS) " | grep " $VAR " 2>&1 >/dev/null + then AC_RUN_LOG([: m4_ifval($2,$2,FLAGS) does contain $VAR]) + else AC_RUN_LOG([: m4_ifval($2,$2,FLAGS)="$m4_ifval($2,$2,FLAGS) $VAR"]) + m4_ifval($2,$2,FLAGS)="$m4_ifval($2,$2,FLAGS) $VAR" + fi ]) ;; +esac +AS_VAR_POPDEF([VAR])dnl +AS_VAR_POPDEF([FLAGS])dnl +]) + + +dnl the only difference - the LANG selection... and the default FLAGS + +AC_DEFUN([AX_CXXFLAGS_GCC_OPTION_NEW], [dnl +AS_VAR_PUSHDEF([FLAGS],[CXXFLAGS])dnl +AS_VAR_PUSHDEF([VAR],[ac_cv_cxxflags_gcc_option_$1])dnl +AC_CACHE_CHECK([m4_ifval($2,$2,FLAGS) for gcc m4_ifval($1,$1,-option)], +VAR,[VAR="no, unknown" + AC_LANG_SAVE + AC_LANG_CPLUSPLUS + ac_save_[]FLAGS="$[]FLAGS" +for ac_arg dnl +in "-pedantic -Werror % m4_ifval($1,$1,-option)" dnl GCC + "-pedantic % m4_ifval($1,$1,-option) %% no, obsolete" dnl new GCC + # +do FLAGS="$ac_save_[]FLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + AC_TRY_COMPILE([],[return 0;], + [VAR=`echo $ac_arg | sed -e 's,.*% *,,'` ; break]) +done + FLAGS="$ac_save_[]FLAGS" + AC_LANG_RESTORE +]) +case ".$VAR" in + .ok|.ok,*) m4_ifvaln($3,$3) ;; + .|.no|.no,*) m4_ifvaln($4,$4) ;; + *) m4_ifvaln($3,$3,[ + if echo " $[]m4_ifval($2,$2,FLAGS) " | grep " $VAR " 2>&1 >/dev/null + then AC_RUN_LOG([: m4_ifval($2,$2,FLAGS) does contain $VAR]) + else AC_RUN_LOG([: m4_ifval($2,$2,FLAGS)="$m4_ifval($2,$2,FLAGS) $VAR"]) + m4_ifval($2,$2,FLAGS)="$m4_ifval($2,$2,FLAGS) $VAR" + fi ]) ;; +esac +AS_VAR_POPDEF([VAR])dnl +AS_VAR_POPDEF([FLAGS])dnl +]) + +AC_DEFUN([AX_CFLAGS_GCC_OPTION],[ifelse(m4_bregexp([$2],[-]),-1, +[AX_CFLAGS_GCC_OPTION_NEW($@)],[AX_CFLAGS_GCC_OPTION_OLD($@)])]) + +AC_DEFUN([AX_CXXFLAGS_GCC_OPTION],[ifelse(m4_bregexp([$2],[-]),-1, +[AX_CXXFLAGS_GCC_OPTION_NEW($@)],[AX_CXXFLAGS_GCC_OPTION_OLD($@)])]) diff --git a/admin/Beta-II-priorities.text b/admin/Beta-II-priorities.text new file mode 100644 index 0000000..e9805ea --- /dev/null +++ b/admin/Beta-II-priorities.text @@ -0,0 +1,132 @@ +-*- Mode: Text -*- + + +Priorities: + 0 - done or patch pending + 1 - Highest + 2 - Middle + 3 - Lowest + + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")Assignments for Applied Technology group members (with priorities): + +(2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")Item# Description 0 2 (assigned to)- priority - comments + +01 Genera / AXP running "without" a Namespace (ESC/JRD) - 1 - + Includes Set Site/ Define Site + +2 Installation Script (Tenny) - 1 - two weeks + +3 RPC (Tenny/Kaufman/Palter) - 1 - patch pending, more work may be + needed. + +4 Network Performance (ESC/JRD) - 2 - + Test to determine cause of congestion. + +5 Flatten Source Code (Inada) - 2 - + + + +1Advanced Development Assignments (with priorities): + +2Item# Description 0 2 (assigned to)- comments + +Completed: +0 +1. Command Line Interface (Palter) +2. Free Space Accounting (ptw) - patch pending +3. Test "Unaligned Kernel Access" (Palter) - done + A problem with DEC packet filter, it has been reported. +4. FIX/FLOAT mod to make CLIM work better (Paul/SWM) +5. EQUAL-NUMBER (Paul) - +6. Call DEC to find out about how thread priorities work. +7. Complete Pass for SYSTEM CASE (Palter/SWM) +8. Dike out unnecessary CP commands (Palter) + - including Fix CP commands. +9. Fix Clock (Paul) +10. Idle Loop (Palter) + +2Priority 10 + +1. Incremental Worlds (ptw/Palter) - one week each. + +2. Keyboard Support improvements (Jwatkins/Palter) - one week + Change the cold load window to use the same keyboard mapping as + Genera (Palter) + Printed keyboard template - + +3. SIGINT Handler (Palter) - Catch c-C and c-\ - use the same or similar + verbiage as is used in the Ivory/Shut Down menu item + +4. Array Register improvements (Paul) - + +5. Document NetInstaBooting. (ptw) - + +6. Sanitize Doc for terminology inconsistencies (Stratis/all) + - awaiting name of product. + +7. General Performance (swm/ptw/Paul) - + +2Priority 2 + +01. Idle Loop Part II (Palter) - three days + +2. FUNCTION-Q (Palter) - + +3. Proper Reset Mechanism (Palter) - + +4. Elementary Window System Locks (swm) - + +5. Patching facility for .c .h and .as file on the VLM. (swm) - + +6. Gabriel Performance (Paul) - + +7. Document the VLM Debugger (ptw/Stratis) - one day + +8. Document/fix HALT MACHINE add SHUTDOWN (ptw/Stratis) - two days + +9. Install the ether-buffer-area fix (Palter/ptw) - + +10. GC Performance (ptw) - + including Resident pages work. + including GC more coprocessor calls (e.g. find a structure) + - one to five five days + +2Priority 3 + +01. Page Fault Accounting (ptw) - need DEC to help on this. + +1Unassigned: + +2Item# Description 0 2 - priority - comments + +01. Revamp tv: and color: doc to use CLIM. - 2 - + +2. Implement IFUNCOM 1 and 2 - 3 - + +3. Take FSEdit out of LMFS and put back in Genera. - make it use CLIM? + +4. Fix arrow going to reverse video on scroll bar - reported by Dodds. + +5. New Herald with new name for FCS - 1- + +1Wait for VLM 2.0 + +2Item# Description 0 2 (assigned to)- priority - comments + +01. Multiple VLMs on a single host (qa) - document and test. +2. Floating point/Bignum "microcode" support () - +3. Make Weak Space Work () - - need to make transport trap work. +4. Motif Interface hack (swm) - +5. Make Genera have a single space type () - - currently cuts regions in + half +6. Statice () +7. Joshua () +8. Concordia () +9. Metering (swm) - +10. Tape (palter) - +11. Book Reader Documentation () - (Get Concordia to write Book Reader + files) +12. Gracefully degrade when there are insufficient map entries - e.g., + disable IDS and continue +13. Op Code reordering. \ No newline at end of file diff --git a/admin/Beta-test-customers.text b/admin/Beta-test-customers.text new file mode 100644 index 0000000..eef5d06 --- /dev/null +++ b/admin/Beta-test-customers.text @@ -0,0 +1,37 @@ + + +A list of Beta test customers. + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")MCC0 (Austin, TX) + +Clive Dawson - clive@mcc.com +Jan Voss - +Doug Lenat - Lenat@mcc.com +Mary Shephard - Mary@mcc.com +David Gadbois - Gadbois@mcc.com + - 512-338-3451 +Jamie Stevens - jamie@mcc.com + - 512-338-3727 + - Jamie is doing the instalation of Beta I. +R.V. Guha - Guha@mcc.com +Dexter Pratt - Dexter@mcc.com + +1EXXON0 (Baton Rouge, LA) + +(no electronic mail) +Harry Moore - primary contact + - 504-359-1356 +Craig Schiro - + +1Army A.I. + +0no know contact call Bill Wilkinson in the DC office. + +1U.S.West + +0Steve Laufman - project manager + - 303-541-6298 +Rick Blumenthal - technical Leader + - 303-541-6293 + +1Sandia diff --git a/admin/FCS-priorities.text b/admin/FCS-priorities.text new file mode 100644 index 0000000..1f4b487 --- /dev/null +++ b/admin/FCS-priorities.text @@ -0,0 +1,132 @@ +-*- Mode: Text -*- + + +Priorities: + 0 - done or patch pending + 1 - Highest + 2 - Middle + 3 - Lowest + + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")Assignments for Applied Technology group members (with priorities): + +(2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")Item# Description 0 2 (assigned to)- priority - comments + +01. Flatten Source Code (Inada) - 2 - + + +1Advanced Development Group0 1Assignments (with priorities): + +2Item# Description 0 2 (assigned to)- comments + +Completed: +0 +1. Command Line Interface (Palter) +2. Free Space Accounting (ptw) - patch pending +3. Test "Unaligned Kernel Access" (Palter) - done + A problem with DEC packet filter, it has been reported. +4. FIX/FLOAT mod to make CLIM work better (Paul/SWM) +5. EQUAL-NUMBER (Paul) - +6. Call DEC to find out about how thread priorities work. +7. Complete Pass for SYSTEM CASE (Palter/SWM) +8. Dike out unnecessary CP commands (Palter) + - including Fix CP commands. +9. Fix Clock (Paul) +10. Idle Loop Part I (Palter) +11. Keyboard Support improvements - Including change the cold load + window to use the same keyboard mapping as Genera. +12. Installation Script (Tenny) +13. RPC +14. Incremental Worlds +15. Genera / AXP running "without" a Namespace - + Includes Set Site/ Define Site +16. Document the VLM Debugger (ptw) +17. Document/fix HALT MACHINE add SHUTDOWN (ptw) +18. Array Register improvements (Paul) - +19. SIGINT Handler (Palter) - Catch c-C and c-\ - use the same or similar + verbiage as is used in the Ivory/Shut Down menu item + +2Priority 10 + +1. Document NetInstaBooting. (ptw) - + +2. Sanitize Doc for terminology inconsistencies (Stratis/all) + - awaiting name of product. + +3. General Performance (swm/ptw/Paul) - + +4. New Herald with new name for FCS - (JWatkins) + +5. Placement of Symbol Key - (JWatkins) + +6. Pathname Defaults - (JWatkins) - Reported by Sobeck + +2Priority 2 + +01. Idle Loop Part II (Palter) - three days + +2. FUNCTION-Q (Palter) - + +3. Proper Reset Mechanism (Palter) - + +4. Elementary Window System Locks (swm) - + +5. Patching facility for .c .h and .as file on the VLM. (swm) - + +6. Gabriel Performance (Paul) - + +7. Install the ether-buffer-area fix (Palter/ptw) - + +8. GC Performance (ptw) - + including Resident pages work. + including GC more coprocessor calls (e.g. find a structure) + - one to five five days + +2Priority 3 + +01. Page Fault Accounting (ptw) - need DEC to help on this. + +1Unassigned (for FCS?): + +2Item# Description 0 2 - priority - comments + +01. Fix arrow going to reverse video on scroll bar - reported by Dodds. + +2. Often unable to report bugs from the VLM debugger because you can + neither save the crash data to a file not cold boot lisp. - + reported by Sobeck. ptw claims these to be bugs. + +3. Async errors in X - 1 - reported by Wilkinson and Black Board + Technologies. + +1Wait for VLM 2.0 + +2Item# Description 0 2 (assigned to)- priority - comments + + +(This is what we have been told is approved so0 2far.) + +01. Statice () - +2. Joshua () - +3. Concordia (Stratis) - done, needs testing. +4. Metering (swm) - done +5. Translator (paul) - + +2(Not yet determined if these go in to release 2.0) + +01. Multiple VLMs on a single host (qa) - document and test. +2. Floating point/Bignum "microcode" support () - +3. Make Weak Space Work () - - need to make transport trap work. +4. Motif Interface hack (swm) - +5. Make Genera have a single space type () - - currently cuts regions in + half +6. Tape (palter) - half done, AXP support not there yet. +7. Book Reader Documentation () - (Get Concordia to write Book Reader + files) +8. Gracefully degrade when there are insufficient map entries - e.g., + disable IDS and continue +9. Op Code reordering. +10. Revamp tv: and color: doc to use CLIM. - 2 - +11. Implement IFUNCOM 1 and 2 - 3 - +12. Take FSEdit out of LMFS and put back in Genera. - make it use CLIM? + diff --git a/admin/V1-project-plan.text b/admin/V1-project-plan.text new file mode 100644 index 0000000..931173f --- /dev/null +++ b/admin/V1-project-plan.text @@ -0,0 +1,862 @@ +@device(LGP2) + +@device(lgp2) + +@style(date "8 March 1952") +@pageheading(Left "VLM",Center "DRAFT - @value(date)", Right "@value(page)") +@pagefooting(Center "Symbolics Confidential") + + +@begin(majorheading) +Virtual Lisp Machine Project + +Program Plan + +Draft @value(date) +@end(majorheading) + +@begin(enumerate) +Introduction + +Background + +Goals + +Marketing + +Implementation + +Staffing + +Milestones + +Futures +@end(enumerate) + +@heading(Introduction) +This document presents a skeleton of the Program Plan for the +Virtual Lisp Machine (VLM) Project. It includes general background +information, program goals, marketing approach, project plans, +and projected future directions. Because project planning is still +in preliminary stages, detailed plans and revision of staffing +and milestone projections are expected. In addition, the marketing +plans are also subject to significant revision. + +This draft should be viewed as the opening round of a dialogue to be conducted +via this document. Comments, revisions, additions, deletions and corrections +are all welcome as the program plan is fleshed out. + +@newpage +@heading(Background) +The Virtual Lisp Machine (VLM) Project is a port of the Genera +OS/Software Development Environment (SDE) to one or more standard +hardware architectures with standard operating systems, via a +software implementation of the Ivory instruction processor. The +inevitable loss of performance due to software implementation of +the Ivory architecture is intended to be partially compensated +by the use of a very high performance 64 bit architecture. In +addition, we expect to gain a significant advantage in cost of the +port and time to market by avoiding a very costly port of Genera to +a native lisp environment utilizing a standard lisp compiler. +After the initial port, by providing native support for parts of +Genera, great improvement in performance can be achieved. This includes +core Genera if ported to a native lisp compiler, but even more easily +includes things like disk and network I/O and window system +performance. + +More than one decade after its introduction by Symbolics, Genera +is still the premier software development environment. Genera OS +also has some powerful features (including advanced memory management +and reclamation, as well as a rich and featurefull file system) that +set Genera apart from standard operating systems accepted today. There is very +little indication that any group has both the knowledge and intent +to supersede Genera's SDE. However, the raw performance of simpler +SDE functionality on standard architectures and operating systems, combined with +starkly lower costs has already significantly eroded Genera's market +share. In the near future, raw performance alone will be enough to +render Genera inferior to SDE's that will still be function for function +inferior to Genera. Symbolics is no longer able to compete effectively +in the chip design arena, against competitors like Intel, IBM, DEC, +HP, Sun, and Motorola. Even if Symbolics could continue to compete in +this arena in terms of performance, the recurring costs of chip re-spins +and new designs, as well as the limited proprietary nature of the chip, +would result in little or no return on investment. If, however, Genera +could be ported to one or more popular standard architectures, a number +of immediate and eventual benefits would be realized. + +Firstly, Genera could compete more effectively against inferior, but +standard-based SDEs. The lifetime of Genera would be significantly +extended because its platform would be significantly less proprietary, +and because improvement in performance would come almost for free with +performance improvements in the underlying standard architecture. The +increase in basic life expectancy would make investment in Genera +reasonable, with the expectation that such further investment would +improve the product lifetime still further. Finally, the goal of making +Symbolics a software company could be realized. + +Porting the Genera SDE to a native lisp implementation is the `right' choice +from a purely engineering perspective. This approach maximizes the +performance and portability of Genera, two highly desirable advantages. +However, such a port must immediately grapple with difficult problems +related to either abandoning Genera's OS component, and its SDE advantages, +or finding a way to implement expanded OS services from a standard OS. +There is significant risk that the first product wouldn't get the OS +component right. In addition, such a port is enormously expensive. In +the past, Symbolics viewed the expense as prohibitive (but it is one of the +things that we could have and should have done), currently it is genuinely +impossible for Symbolics to make an investment on that scale. +It is worth mentioning here, that a port to a native lisp would certainly +involve language and OS changes that would break all current customer code. + +The alternative we have selected is to port Genera to a software Ivory +instruction interpreter. Clearly, this approach is less costly. Also, +the first version can faithfully render the Genera OS and its benefits. +In addition, the product can be anything from software only to a +Symbolics built workstation, giving management more flexibility in +structuring the difficult transition to a software only strategy. +Performance can be gradually improved by porting from interpreter +dependence to dependence on native code. Simultaneously, gradual +solution of the problem of Genera's OS features can be realized, +resulting in the gradual reduction of Symbolics' burden in supporting +an OS. Thus the expensive and risky parts of the port described +above can be realized during the life of the ported product, and the +costs can be distributed over the product life, rather than incurred at the +beginning and amortized. All of these advantages can only be realized +if the first version of the port can be made sufficiently fast. + +Early studies of the potential performance of an Ivory interpreter have +suggested that given an interpreter coded specifically to take advantage +of chip specific architecture, including on-chip memory management, +suitable 64 bit risc chips clocked at 66 to 200 Mhz could achieve +performance in the range of the XL400 to XL1200. Slightly smaller +clock rates could be accommodated if multiple effective instructions +could be issued per clock cycle. Our marketing intuition is that a +minimum of XL400 performance is needed in order to have a viable +product, though XL1200 level performance is clearly preferable. +During the life of the chip revision supporting the initial port, +performance can be improved through a number of software techniques. +Later revisions of the chip architecture will provide further +improvements in performance. It should also be noted that given +acceptable performance on at least one popular chip architecture, +alternate versions on less powerful processors, providing for example +a 3640 level of performance, could be a successful low-end, lower +cost version of Genera. + +Since the resulting interpreter is chip specific, Genera is limited +to run on architectures for which an interpreter has been written, +and for which a suitable OS/life-support mechanism is supported. +From a performance standpoint, the only currently available architectures +which can support at least XL400 performance are the Intel I860, +the MIPS R4000, and the DEC Alpha. IBM and SUN have announced that +64 bit, high speed versions of their Power and SPARC architectures will +soon be available. These are expected to be able to support at least +XL400 performance. The Intel P5 chip is probably borderline in terms +of expected performance. Of the currently available suitable chips, +DEC Alpha is the most promising from both a raw performance and +market acceptability standpoint. The future of the MIPS R4000 +architecture, outside of Silicon Graphics workstations, is unclear. +Although the I860 has been very successful in the realm of graphics +and floating-point co-processors, almost all of its workstation +design wins are no longer viable. + + +@newpage +@heading(Goals) +The overall goal of the project is to provide product revenue +at or above current levels during a period of transition to +software only products. In order to accomplish this, it is +necessary to extend the life of Genera with a supportable investment, +thus allowing the transition to a software and +services company. Extending the life of Genera means preventing (and +possibly reversing) the erosion in Genera's customer base, and providing +sufficient product revenue to stabilize the product side of the business. + +Advantages of this approach include: +@begin(itemize) +Removes obstacles to sales (proprietary chip and OS) + +Tracks industry chip performance curve + +Focuses technical staff on SDE + +Removes dependence on proprietary HW, OS + +Incremental approach to software only + +Retains connection with Ivory, current products -- smoother transition +@end(itemize) + +The following prioritized goals are intended to achieve this effect: + +@begin(enumerate) +At least XL400 performance in the product. + +PR for direction supports Ivory sales in the interim. + +FCS in June of 1993 or as soon thereafter as possible. + +XL1200 Window System performance or better, FCS. + +Runs existing customer code with at most a recompile at FCS. (Automatic + conversion is ok). + +Recognizable as Genera, FCS. + +Genera runs under the native OS, allows native processes to run concurrently. (But + not necessarily at FCS). + +Preserve Genera OS advantages, consistent with previous goal. + +XL1200 large scale program performance, or as close to it as possible, FCS. + +XL1200 benchmark performance, or as close to it as possible, FCS. + +Portability of VLM to other hardware/OS platforms. +@end(enumerate) + +@newpage +@heading(Marketing) +One of the advantages of the VLM approach to a software only +strategy is that the marketing will be only marginally different +than that needed for our current products. Unfortunately, our +current marketing practices don't quite measure up to those marketing +needs. Still, we derive a significant advantage from not having to completely +rethink fundamental aspects of the marketing plan. + +@subheading(The Market) +We currently market a proprietary hardware supported Lisp SDE with +a proprietary OS. Our customers are R&D groups in universities, +national laboratories, government agencies and contractors, commercial +and industrial organizations; and product and service deployment groups +in government agencies and commercial organizations. For several years +we have restricted ourselves to marketing within our original customer +base, thus marketing only to those groups who are already aware of the +benefits of using the Genera SDE. We can segment the market into three +groups: current customers, former customers, and non-customers. Our +primary goal with VLM products is to prevent erosion of the first segment. +A secondary goal is to regain customers who have left the fold. Only +by significantly changing and enhancing features of the current product, +as well as completely revamping our marketing approach, can we hope to +more than trivially penetrate the third segment. Thus, at least in its +initial form, the VLM product(s) will not address genuine expansion to new +markets. + +The most significant and growing segment of our current customers are +among commercial and industrial organizations with the need to deploy +information systems that radically improve the efficiency of their +operations. This portion of our market is characterized by the relatively +high level of complexity of the problem, and segments naturally along +vertical industry lines. Our largest and best customers come from +telecommunications, transportation (airlines), manufacturing, utility, +and finance. However, nothing in the VLM program directly addresses the +needs of marketing to these vertical industries, except the general need +to reduce costs and the proprietary nature of the hardware and OS in +our products. + +@subheading(Positioning) + +Positioning this product for sales within the current customer base is quite +simple. This is the product that Genera's future resides with. This is the +product whose performance will improve to beyond XL1200 capacity, and which will allow +software only delivery of Genera based applications. No more trying to convince +one's boss that it is ok to buy proprietary hardware from Symbolics. + +The same story could work for some of our `lost boys' if they really departed +unwillingly and solely because of platform issues. However, it is much more likely +that to mount a serious `lost boys' recovery program, we will have to identify and +position ourselves against the competition. In some cases this will be Sparcstations +running Lucid or Franz Common Lisp. In other cases we will be competing against +C++ on Sparcstations or other Unix boxes. To position against either of these we have +safe code, +better GC, better memory management in general, better large-scale program development +utilities, better SDE, and huge bodies of reusable code. + +If not at FCS, certainly within one year of FCS there will be native Alpha Lisps +available. Consequently, the interpreter based VLM will be outstripped for +delivery performance, and stressed with respect to performance issues for +development. We should be prepared to position VLM Genera as a development +environment with delivery on a native lisp as an option. In addition, on the +technical side we will be trying to replace the Ivory interpreter with native +Alpha code as quickly as possible. + +@subheading(Product Families) +We envision a high end product family, characterized by (eventually) +greater than XL1200 performance, on very fast deskside and desktop +workstations, using the fastest 64 bit standard chips. Genera will +run as a high priority process (or collection of processes) under the +native OS. Native processes will be able to run concurrently, so +the user will be able turn from Genera in an X or Motif or Win32 window, to +another program running in another such window. These products will +run on a very limited number of different architectures, e.g. Alpha +and possibly either SPARC or Power. Which architectures are selected +will depend on marketing analysis and strategic relations. +Within this product family, we will enhance the power and functionality +of Genera, and retain our leadership in providing software development +environments. By providing substrate to support development in other +languages, and concentrating on high level language independent tools, +we will expand the market potential for these products beyond those +groups who are tolerant of development in Lisp. + +We also envision a lower end product family, characterized by lower +performance, and possibly less OS integration, available on lower +performance desktop workstations based on the same chips as the above +family, and also including the Intel P series, beginning with P5. + +A third product family will involve Genera-based applications, targeted +at our vertical markets. + +@subheading(Sales) + +It is assumed that sales will continue to be through our direct sales force. +Many new possibilities open up through our relationship with DEC. We should +pursue the possibility of using our own or DEC's resources to mount a telemarketing +campaign into our population of `lost boys'. + +@subheading(Promotion) + +@b(???) + +@newpage +@heading(Implementation) +The Genera VLM port will be accomplished by providing two software +platforms to support the only slightly modified Genera code: the +Ivory Instruction Interpreter and the OSF/1 Genera Life Support. +@begin(verbatim) + + + ________________ + | Genera | + ________________ + / \ + ______________________ ________________ + | Ivory Interpreter | | Life Support | + ______________________ ________________ + \ / + ________________ + | OSF/1 | + ________________ + | + | + ________________ + | Alpha | + ________________ + +@end(verbatim) + +@subheading(Ivory Interpreter) +The Ivory Interpreter will be comprised of three main segments: +the kernel including instructions and instruction dispatch, +the memory management services, and the communications interface. +The communications and memory architecture segments will be written +in ANSI C for portability. We believe that acceptable performance will +result. The kernel will be coded in Alpha OSF/1 assembler, to maximize +performance of the interpreter. Also, to improve performance, the +kernel will support use of native on-chip memory management, rather than +faithfully emulate Ivory memory management. The kernel code will thus +also have to provide a suitable interface for storing and retrieving +ephemeral reference information for Genera's GC. + +The memory architecture implemented in the kernel +will support instruction and data read and write, +and mapping of virtual Genera addresses to physical memory. +Because Alpha traps on non-word aligned reads, we will be unable to use +a straightforward packed representation. At some cost in initial +performance, but with offsetting gains in real-program performance, +we will use a packed representation with tags stored separately from +data. Trade-offs will be examined to determine the optimal relative +locations for tags and data. If sufficient non-locality is chosen +for tags, Genera data structures can more easily be exchanged with +untagged data structures (i.e. data structures for other languages). + +Additional interpreter kernel issues are providing compatibility with +Ivory trap signalling, and consideration of floating point instructions. + +The memory management services are responsible for allocation and +management of OSF/1 memory used to implement the Ivory address space. +An issue here is investigation of whether locking of VLM's memory +should be used. + +The communications module will support and interface with the +Genera Life Support Module. + +Testing the core set of instructions will involve running relatively +small Ivory programs (via a ported version of the Minima remote debugger) +that provide complete coverage of Ivory instructions. Later testing, as well +as tuning, will be done using Genera as the test environment. + +@subheading(Life Support) +Life support will be patterned after the life support mechanisms for +the Sun embedding, the Silicon Graphics embed project, and to a +lesser extent the MacIvory embedding. Life support provides a layer +between Genera's interface to device drivers and the underlying OS, +in this case OSF/1. There are several interesting design decisions +that remain to be decided, all of which have significant implications +for this layer: + +@begin(itemize) +level of support for FEPFS, LMFS + +level of support for Generic Network + +level of support for Genera UI +@end(itemize) + +Currently, Solstice life support provides a full FEPFS implementation within +a single UNIX file. The VLM implementation will utilize the +UNIX file system more directly, with layering of some additional +functionality including direct support for LMFS. The network support +will be done as it is currently done for Solstice. Later, we may wish to +utilize the network services of OSF/1 more directly. The best long term answer +for UI is to re-host Genera +tool interfaces to CLIM 2.0, ported to Motif running under OSF/1. +Alternatively, the interfaces could be ported to X-based CLIM 2.0. +A third alternative, less attractive but possibly less time +consuming for the initial release would be a re-hosting of DW directly +onto X, rather than using the sheet window system. All three +approaches result in abandoning the sheet window system and the +tv-windows substrate, making a rather abrupt change to no +longer supporting old-style interfaces. + +The current decisions are to implement what gets us to +FCS fastest, and to plan re-implementing some features to derive +better performance or support characteristics for a future release. +One possible exception is to try to improve UI performance for +FCS, by improving the X hosting of the sheet window system. + +The major pieces of the life support effort are: +@begin(itemize) +basic embedding code, including signals, timers, memory layout, and initialization. + +disk I/O channel + +network channel + +cold load channel +@end(itemize) + +@subheading(Port of Genera) + +In some sense the port of Genera is the simple part, because we have designed the +two supports (Ivory Interpreter and Life Support) to minimize the work required +in Genera itself. However, this part of the work will also be the most person-power +extensive, since it also constitutes the system integration work of putting our +three modules together with OSF/1 running on the Alpha. + +The major tasks identified to date are work on the Ephemeral GC, system-case +specialization, support for loading the FEP (i.e. C code to replace boot ROM and device PROM +support), and debugging effort. Additional efforts may be made to improve the UI performance. + +@newpage +@heading(Staffing) + +Below we present a sketch of staffing requirements. + +@begin(comment) +Analysis and planning - 1 mo PR, 2 mo RL. +Ivory Interpreter - 4 mo PR +Layered Products - + Portable Statice - 24 mo Gmbh, 6 mo JW, 6 mo NF +@end(comment) + +@subheading(Preliminary Work) +@begin(verbatim) +Analysis and Planning - 3 Person Months +________________________________________ +Total - 3 Person Months +@end(verbatim) + +@subheading(Ivory Interpreter) + +@begin(verbatim) +Design & prep - 12 person weeks - done +Instructions - 6 to 18 person weeks - done +Instruction dispatch - 2 person weeks - done +Memory Management - 1 to 4 person weeks - done +Trap signalling - 2 to 8 person weeks - partially done +Memory init - 1 to 2 person weeks - done +Communication - 2 to 4 person weeks - done +Testing - 4 to 8 person weeks - partially done +Debugging - 2 to 6 person weeks +_________________________________________________ +Total - 32 to 64 person weeks + - 8 to 16 person months + +1 person 12 months +P Robertson +8 to 16 PM +@end(verbatim) + +@subheading(Genera Life Support) + +@begin(verbatim) +Design - 2 to 4 person weeks - done +Basic Support Code - 2 to 4 person weeks - done +Disk Channel - 1 person week - done +Cold load channel - 2 person weeks - done +Network Channel - 2 to 8 person weeks - partially done +_________________________________________________ +Total - 9 to 19 person weeks + - 2 to 5 person months + +2 people for 2.5 months +G Palter, J Anderson, D Tenny +2 to 5 PM +@end(verbatim) + +@subheading(Port of Genera) + +@begin(verbatim) +FEP loading - 3 to 5 person weeks - done +FEP port - 2 to 4 person weeks - done +Modify Ephemeral GC - 4 to 8 person weeks - partially done +Platform support - 2 to 8 person weeks - partially done +Boot - 4 person weeks +Run Genera - 8 to 32 person weeks +Debug Genera - 8 to 32 person weeks +Tune - 6 to 12 person weeks +_________________________________________________ +Total - 37 to 101 person weeks + - 9 to 25 person months + +2 persons for 2.5 months, plus 4 people for 5 months. +P Withington +G Palter +S Mckay +D Tenny +9 to 26 person months +@end(verbatim) + +@subheading(Documentation and QA) + +@begin(verbatim) +Doc - 1 person for 6 months. +QA - 2 persons for 3 to 6 months. +T Stratis +J Lown +C Anderson +12 to 18 PM +@end(verbatim) + +@begin(comment) +@subheading(Port of Layered Products: Statice, Concordia, Joshua) + +4 people 18 Months devo +1 person 6 months doc +1 person 6 months QA +NF +JGA +JW +tbd +TS +CA +60 PM +@end(verbatim) +@end(comment) + +@subheading(Costs) + +We can estimate the actual cost of Genera Senior Developers at $125K per +person year. The following chart summarizes the staffing estimates above. +The cost figure is based on the pessimistic staffing/task estimates, and +is in approximate agreement with original (24 month old) estimates on +project cost. + +@begin(verbatim) +Analysis 3 PM +Interpreter 8 to 16 PM +Life Support 2 to 5 PM +Genera 9 to 26 PM +QA, Doc 12 to 18 PM +___________________________________ + 34 to 68 PM + +5.7 Person years @ $125,000 = $708,000 +@end(verbatim) + +@newpage +@heading(Milestones) + +The following milestones are based on the optimistic versions of the staffing +plans and tasks, above. + +@begin(verbatim) +@begin(b) +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") Virtual Lisp Machine project schedule (preliminary) + ** Company Confidential ** +0@end(b) + +@begin(i) +(2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")! = important milestone, must be met at or near the specified date +* = date at risk due to possible hard-to-foresee difficulties +n = new or revised milestone + +Task Completion Personnel0 2Status + date +0@end(i) + +Get VLM debugger for C-emulator working 11/13/92 Judy Done 11/13 + +Get C-emulator working again to verify 11/13/92 Judy Done 11/13 + that the VLM debugger works + +Get C-based emulator working on Beta 11/20/92 PTW Done 12/2 + +Run Boyer benchmark on C-emulator on Beta, 11/20/92 PTW Done 12/9 + and get benchmark numbers + +Run experiments to determine that mmap 11/20/92 Judy,PTW Done 12/1 + and munmap will satisfy our needs for the + emulator storage system + +Glue VLM debugger to asm-emulator 11/23/92 Judy Done 12/1 + +Get KHS instruction tests to run to 11/25/92 PTW Done 12/4 + completion on C-based emulator (doesn't + have to pass completely) + +Get initial asm-emulator running on Beta, 11/25/92 Paul Punted 12/7 + and get initial benchmarks for instruction + decoding and a few basic instructions (TAK) + +Get console life support working 11/25/92 Judy Done 12/8 + +Life support core working 11/25/92 Gary Done 12/8 + +Get disk life support working 12/02/92 Gary Done 12/14 + +"Hello world" on Beta 12/04/92 Gary,Judy Done 12/9 + +Start bring up IFep under C-emulator 12/04/92 PTW,Judy,Gary Done 12/9 + to debug console and disk life support + +Asm-emulator runs Boyer benchmark 12/11/93! Paul Done 12/18 (~XL800) + +IFep mostly works under C-emulator 12/11/93! Judy,Gary Done 1/5 + +Research and experimentation on using 12/25/92 PTW Done 12/7 + native memory management to do PHT + (using C-emulator as the testbed) + +Bring up Minima under C-emulator 01/01/93 PTW,Gary Punted 1/5 + to debug network life support + (acceptable if no GC) + +Bring up IFEP under asm-emulator 01/05/93! Gary,PTW,SWM Done 2/1 + +Start investigations on removing 01/15/93 SWM Done 1/15 + unnecessary bottlenecks from the sheet + window system, by calling into X at + a higher level + +New machine type, file type, and world 01/15/93 Bob,SWM Done 2/2 + load type for the VLM; SCT support + +Investigate alternative world load 01/29/93 Gary Done 1/29 + format to improve performance of booting + and paging from world load (this requires + doing "world tools" in C) + +Unix-style command interface to start 02/05/93n Gary + up the VLM (takes arguments that augment + data gotten from any config files) + +Asm-emulator passes most instruction tests 02/12/93n PTW,SWM Done 2/26 + +Bring up Minima under asm-emulator 02/12/93!n Gary,PTW,SWM Done 2/26 + (acceptable if no GC) + +Get network life support working 02/19/93* Tenny,Gary + +Convert IFEP debugger into IFEP kernel 02/19/93n Eric,Gary + +Start designing, implementing RPC so 02/19/93 Tenny,Gary + that users can call out to OSF-1 + +Fix Genera Memory Management to use 02/26/93*n PTW +native Alpha Memory Management + +Genera sources conditionalized for VLM 02/19/93 Bob,SWM + machine type in order to eliminate all + code not needed by the VLM + +Genera hobbles along under asm-emulator 02/26/93!n Gary,PTW + (using native PHT, but acceptable if no GC) + +Emulator passes all instruction tests, 02/26/93n PTW,SWM + including all traps + +Genera works reasonably well 03/19/93n Everyone + (GC starting to work with native PHT) + +Alternative world load format installed, 03/19/93 Gary + if investigations are successful + +Asm-interpreter substantially tuned 03/29/93n Paul + +Genera's sheet window system now calls 03/29/93*n SWM,Bob + into X windows at a higher level + +Genera's sheet window system now calls 03/29/93*n SWM,Bob + into X Windows via an embedded channel + +Documentation effort under way 04/02/93 (Doc) + +Kit design under way 04/02/93 Carl + +Draft Alpha, QA, and Beta Plans written 04/09/93n Watkins + +Basic RPC support implemented 04/09/93n Tenny,Gary + +LMFS/DBFS w/o FEPFS + Host file channel 04/09/93n Gary + +Genera works well, including GC 04/26/93!*n Everyone + +Translator written, interfaced to asm 04/26/93n Paul +interpreter + +In-house Alpha testing and QA started 04/26/93n (QA) + +Continue doing performance work 04/30/93 Everyone + - tune emulator, extend implementation - Paul + to do more before trapping out + - tune memory management, paging, and GC - PTW + - tune disk and network life support - Gary,Tenny + - identify Genera translation targets - Paul,Bob + +Benchmarks translated and run 05/07/93n Bob + +Genera 8.4 Feature Freeze 05/07/93n + +Beta1 software ships 05/28/93! + +Genera 8.4 Final Freeze 07/16/93n + +FCS 08/27/93! +@end(verbatim) + +@newpage +@heading(Futures) + +@subheading(Subsequent Releases of VLM) + +The major goals for the second release of VLM, scheduled for 4 to 5 months after the +initial release, are performance and robustness improvements. We will drop the +requirement of supporting older code, particularly in the UI area, and be willing +to make more significant departures from current Genera and life support technology +to improve window system and I/O performance. We will attempt to better address +issues of large-scale production program performance. A third release of VLM will +most likely center on porting to a new, lower-cost platform. The lowest-cost port +would be to the DEC Alpha PC. + +@begin(itemize) +@tabclear +@tabdivide(3) +Release 1.0@\~XL800 Performance, high compatibility@\August 1993 + +Release 2.0@\> XL1200 Performance, More modern UI@\December 1993 + +Release 2.0@\~XL800 Performance, < $10K workstation@\June 1993 +@end(itemize) + +@subheading(Performance) + +There are several things we can do to improve the performance of the +VLM: + +@begin(itemize) +OS support for I/O + +UI speed improvements + +Tuning interpreter + +Translator improvements to interpreter + +Native compiler/runtime +@end(itemize) + +Efforts can be made to speed disk and network I/O, by going more directly +to OSF/1. There are numerous marketing and design issues here, related to the +degree to which we integrate with OSF/1 capabilities. + +Several ideas for improving UI performance were discussed earlier, +but one further idea would be to +consider providing a C-based substrate for CLIM 2.0 on top of +OSF/1 Motif and X directly. This substrate would implement +shared data-structures and native code for CLIM's graphics +model and output recording. While display and redisplay +would be handled by CLIM, replay and graphics drawing would be +handled by the substrate. + +The highest payoff general performance improvement for a small investment, +is augmenting the Ivory Interpreter with a translator. The translator will +convert portions of Ivory binaries to Alpha code, as a post compilation process. +The interpreter will be modified to expect this `escape to Alpha' code. For +small programs, that won't suffer too much from the resulting binary code bloat, +will run approximately 5 times faster. However, larger programs can be metered and +small but key portions translated for significant performance improvements. +This effort will be the major aspect of the performance enhancement VLM 2.0 +release. + +Changes to the Lisp compiler to support Alpha can range from defining new +Ivory codes that have better interpreter performance (such as combined code +sequences), to actually generating native Alpha code in some instances. Of +course, the greatest speed improvements will come from porting Genera from +the interpreter to a native Lisp. + +@subheading(Other Platforms) +One obvious and interesting platform is porting to the DEC Alpha PC running +Windows NT. This will involve little or no changes to the interpreter, it +is simply a port of VLM life support. Windows NT for the most part provides +functionality similar to OSF/1. This should be the key aspect of the third release +of VLM, for summer of 1994. The chief attraction of this port is that the Alpha +PC is slated to be available for under $10,000. + +Another possibility is to port the interpreter to Intel's Pentium. Given the +translator, and previous port to Windows NT for Alpha, this port shouldn't be +too expensive, and the performance, while not great, should be acceptable. + +Porting Genera to a modern compiler with a retargetable back-end is certainly preferable +from the standpoint of performance and technical longevity, but is also considerably +more expensive (perhaps an order of magnitude more expensive). The advantage of this +port, however, is that Genera could be made to run with credible performance (i.e. +XL1200 level) on Intel 486 platforms (of which there will be tens of millions). + +@subheading(Appearance) + +Several changes should be made to improve the appearance of Genera. It should +shed its old fashioned look, and take on a fresh new appearance. Of course, +rewriting all the user interfaces in Motif-based CLIM 2.0 will do a lot to +improve things, but it is still the case that basic UI design for many of +Genera's tools could be radically re-thought. Basic re-thinking involves +considering where more graphical interfaces might be appropriate, for +example, and where and how the desktop metaphor might be used. KMP's desktop like +approachability work might be worth reviving here. + +@subheading(Unbundling) + +We should give consideration to the need to unbundle our software, in order to make +more attractive pricing alternatives possible. This will involve not only re-thinking +modularity boundaries, but also possibly taking on projects to provide minimal +capabilities, so that more advanced capabilities in a necessary area (like networking) +can be reasonably unbundled. + +@subheading(Daughter of Genera) + +The VLM platform should be the platform in which we conduct the work to +develop the DOG technology (because this will be our strongest platform, and +the one we know we will be able to invest in). As mentioned above, among +the goals for this technology are providing substrate to support development in other +languages, and concentrating on high level language independent tools. Also +involved will be moving away from the file/text based approach to data in our +development environment, to a truly object (and persistent object) based approach. + +@subheading(Getting New Customers) + +Certainly many of the properties of the DOG technology will help us to attract +new customers. However, we need to also think about more short term things we might +do, both technically and in terms of marketing to address new customers. For a +couple of years now we have been saying that we want to build upon the successes of +providing solutions to key customers. In fact, within the contract and consulting arena +we have done just that. It is now time to figure out how to derive similar +benefits with new customers with our product business. diff --git a/admin/V2-priorities.text b/admin/V2-priorities.text new file mode 100644 index 0000000..2448f04 --- /dev/null +++ b/admin/V2-priorities.text @@ -0,0 +1,51 @@ + +VLM 2.0 Project planning: project tasks. + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")(This is what we have been told is approved so0 1far.) + +0Development time: + +1a.Make Weak Space Work (ptw) - two weeks of research and, + optimistically, four weeks to make it work. +1b. Slow DBFS -Statice () - Palter says two weeks. + +2. Joshua () - + +3. Translator (paul) - + +4. Concordia (Stratis) - done, needs testing. + +5. Metering (swm) - done + +Performance - + +Multiple VLMs on a single host (qa) - document and test. + +QA/SRG time - six weeks (30 days) after final freeze. + + + + + + + +1(Not yet determined if these go in to release 2.0) + +02. Floating point/Bignum "microcode" support () - +4. Motif Interface hack (swm) - +5. Make Genera have a single space type () - - currently cuts regions in + half +6. Tape (palter) - half done, AXP support not there yet. +7. Book Reader Documentation () - (Get Concordia to write Book Reader + files) +8. Gracefully degrade when there are insufficient map entries - e.g., + disable IDS and continue +9. Op Code reordering. +10. Revamp tv: and color: doc to use CLIM. - 2 - +11. Implement IFUNCOM 1 and 2 - 3 - +12. Take FSEdit out of LMFS and put back in Genera. - make it use CLIM? + +1Customer suggestions + +01. At LUV barmar suggested that we remove the disk meters in peek if +indeed they are not hooked to anything in open genera. - billw \ No newline at end of file diff --git a/admin/bl11-release-notes.ps b/admin/bl11-release-notes.ps new file mode 100644 index 0000000..2b9bdeb Binary files /dev/null and b/admin/bl11-release-notes.ps differ diff --git a/admin/bl12-release-notes.ps b/admin/bl12-release-notes.ps new file mode 100644 index 0000000..f4ac6f1 Binary files /dev/null and b/admin/bl12-release-notes.ps differ diff --git a/admin/digital-phone-numbers.text b/admin/digital-phone-numbers.text new file mode 100644 index 0000000..a3b4650 --- /dev/null +++ b/admin/digital-phone-numbers.text @@ -0,0 +1,65 @@ + + +VAR group in Burlington + (these are our primary business contacts, with whom we have the VAR agreement.) + + Debbie Power Bob Collins + Account Rep. Sales Manager + 617 273 6464 617 273 6664 + + +Alpha Migration Center in Merrimack, NH + (these are the people who lent us time on Alpha before we got our own) + + Jim Seagraves Bob Grosso + (Engineer ?) Manager, Migration Center + 603 884 2924 603 884 1651 + MS MK02-2/F10 + beau@decvax.dec.com + Digital Equipment Corporation + 1 Digital Dr. + Merrimack, NH 03054 + +Jim Damoulakis +jimd@nvsd4.enet.dec.com +Sr. Open Systems Consultant +Digital Equipment Corp. +Burlington, MA +617-273-6477 + + +OSF group in Nashua, NH. + +John Nordlinger +Compiler/Internals guy? +603-881-2894 + +John Dustin +Engineer for networking components of OSF +Reference from Jim Damoulakis (15-JAN-1993) +jsd@decvax.dec.com, jsd@zk3.dec.com +603-881-0326 + + +Field Service +1-800-354-9000 +Model # PE50A-A9. Internal name "Flamingo" for this model. +Serial # AY233C1955 + +Heather Grey +OSF Network Support @ DEC +603-881-1079 + +Andrew Duane +alpha something-or-other at DEC (concerned with alpha 'date' slowdown) +duane@aosg.gsf.dec.com - fails +duane@alpha.aosg.gsf.dec.com - ?? +duane@alpha.enet.dec.com - untried +"alpha::duane"@decwrl.pa.dec.com - untried +603-884-5873 +FAX: 603-884-1685 (MS GSF1-1/K13) + +Ashoke Rampuria +rampuria@zk3.dec.com +Investigating "mprotect" problem +603-881-2886 \ No newline at end of file diff --git a/admin/issues.text b/admin/issues.text new file mode 100644 index 0000000..d4cc9ae --- /dev/null +++ b/admin/issues.text @@ -0,0 +1,35 @@ +Open issues with DEC: + +Genera life support network issue -- Jim should have passed our question +about promiscuous mode/network packet filter/etc. to development. -- +Answer received, but unsatisfactory in practice. New much more involved +query sent 12/21. + +DBX fails with the emulator because of some error having to do with +select(). -- Have patch, but tape drive is croaked so can't load it! +[field service log # LB5ED0 for tape drive problem] [Tape drive fixed] + +mmap has limit of 192 discontiguous segments; asked how to increase. +Using more memory than you have hangs the machine; have program to test +for size of swap space but it doesn't work. [increased mmap segments] + +12/18: yduJ reported a hideous bug in BL10 where you can't reuse a port + number until N hours later when it has closed itself. + +12/18: yduJ sent off a crash dump to DEC from the tcp_output panic. + +12/21: Palter found a bug in the C compiler that causes it to dump core. + +12/21: Palter asked a bunch of threads questions about warnings from + header files and support level of dbx and thread-friendly x libraries. + +Genera command line should allow user to specify swap-image size and +pass in to genera (via life-support) to set *count-swap-pages*. This +will allow trading off Genera GC overhead vs. how much swap space it +tries to grab. + +Do stacks need to be chunk-aligned in Genera? I don't think so since +they should not ever get protected or transport trap. + +Genera "allows" 2000 regions, which could me you could have 2000 mmap +extents! \ No newline at end of file diff --git a/admin/ivory-rev-5.text b/admin/ivory-rev-5.text new file mode 100644 index 0000000..a0cf6e7 --- /dev/null +++ b/admin/ivory-rev-5.text @@ -0,0 +1,160 @@ +-*- Mode: Text -*- + +[Started by ptw 2 Oct 92] + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")Signed comments in italics please. + +0I've been giving some thought as to how to eliminate the need to +faithfully emulate Ivory memory hardware in VLIM but still retain the +benefits (primarily the support for ephemeral garbage collection). +Comment and discussion solicited. + +My basic idea is to have VLIM be "Ivory Rev. 5". To add some +instructions that replace macro functions in the garbage collector that +glean information from the memory hardware and to modify Genera to use +those instructions when running on rev. 5. Essentially, we'd just be +moving back more to the 36xx era when the microcode was programmable and +much more sophisticated. + +Since the information the memory hardware gives to Genera to support +garbage collection is mostly in the form of "hints", we can start with +very simple (conservative) microcode and supporting structures and +enhance them as necessary. We should be able to remodularize and debug +Genera without the microcode being finished; we can even prototype +performance impact somewhat by implementing "emulations" of the new +microcode in Lisp. + +One other idea I have for eliminating macrocode and overhead is that +Ivory rev. 5 be a virtual address only implementation. That is, Genera +will get completely out of the memory management business as far as +physical memory is concerned. At boot time, the mapping of virtual +addresses to world-load pages will be set up in the chip and the +microcode will handle all disk I/O for paging. We may still want to +support macro-code intercept of faults, since the IDS mechanism depends +on write faults and to sanity check that missing faults are for valid +addresses. If so, there will need to be instructions to set protection +on virtual addresses. I think it will be sufficient to have uncreated +pages fault and have the fault handler simply turn off the fault (with +the implication that if you touch an uncreated page that is not marked +to fault, the microcode simply creates it) and possibly initialize the +page. It will be completely up to the microcode to manage the working +set and keep the most-used virtual pages addressible. + +The types of instructions I'm thinking of (these are very high-level and +don't necessarily correspond to current Genera GC in any but an abstract +way) are things like: + + allocate-ephemeral-level + + Returns a base (virtual) address and extent, the (demi-)level-number + is encoded in the virtual address as in the current architecture. + The GC uses this instruction to get an address range to create + ephemeral regions in. The microcode keeps a correspondence of + level-number to address range to support ephemeral hints. + +1ptw: This assumes the micro-machine can efficiently map from +(potentially sparse) level addresses to its implementation memory. If +the implementation memory supports sparse addressing, perhaps the +mapping could be direct. Perhaps the micro-machine memory has two +regions (defined by hidden high bits) one mapping to the 32-bit pointer +words and the other to the 8-bit tag bytes. For the purposes of GC, you +only have to "hook" the vm activity of one of those regions. + +0 free-ephemeral-level + + Takes a level number (or perhaps the base address and extent for + sanity checking?). The GC uses this instruction to return a virtual + address range when it has reclaimed all the regions in it. + +1ptw: Is this sufficient granularity? Perhaps for ephemeral, where you +can't (?) have false oldspace, but is there an issue for dynamic? Do we +even really have to free levels? or is it sufficient for the GC to set +"missing-fault" on reclaimed regions? + +0 Similar instructions for dynamic zones. (Depending on how fancy we + want the microcode to get, these level/zone instructions might take a + desired size and we might allow a semi-inifinite number of them, + returning the associated level/zone number as a third result rather + than having them be directly computable from the address. If so, we + would need two more instructions ephemeral-level and dynamic-zone that + returned the corresponding number given a random address. Initially I + lean toward just using the current Ivory scheme of 32/31 to keep the + microcode's job and the changes to Genera managable.) + + set-oldspace-registers 1ephemeral zone + +0 Setting oldspace registers 1could 0work as normal, but I think having + an instruction is more perspicuous and I expect in rev. 5 the + instruction will also automatically enable transport faults on all + non-oldspace, non-disabled addresses. + + The microcode will still have to be responsible for recognizing + fetches of oldspace pointers and generating transport traps. If + this is too burdensome to do on every read cycle, we might want to + consider extending the execute mechanism to data too: fault on a + "page" basis and require clearing all references on the page before + proceeding. This leads to some inefficiency in collection, but the + microcode then need only implement it's oldspace check on a page + basis and can (in an initial implementation) just always trap. + + scan-for-oldspace1 address extent  address or NIL + +0 takes an address and extent, returns the next address in that range + that has an oldspace pointer in it, or NIL if none. Clears + transport fault for the "pages" in range when it returns NIL (the + macrocode is responsible for re-enabling the fault if it adds + oldspace references to the range, e.g., when appending to + copyspace). The microcode is free to use whatever techniques + available to optimize this scan. A simple one that occurs to me is + to scan the tags page first for pointer objects and only look at the + corresponding data entry when necessary. Clearly the microcode can + use its virtual memory implementation hardware to enhance this scan + in various ways similar to the way the current macrocode does. + + There may want to be a variant on this instruction, + scan-for-resident-oldspace, that only looks at currently paged in + pages, but this is not clear. In Genera resident and non-resident + are done in separate passes because the macrocode mechanism is so + different for the two cases. Where the mechanism will be completely + hidden in the microcode, the only reason for maintaining the two + passes is to not page out a page that needs scanning simply because + you asked for it in the wrong order. It's not clear this is needed + in the first implementation. + +1ptw: another thought is that the instruction might want to be +"block-transport" and it traps to "transport-trap" repeatedly? That +won't fly in Minima so well. The micro-machine has to know about +skipping missing pages for sparse objects. + +0 set-attributes1 type address extent +0 clear-attributes 1type0 1address0 1extent + +0 Type is a subset of {missing-fault, access-fault, write-fault, + transport-fault, transport-disable, wired}. By default, + missing-fault is automatically set for "new" addresses (addresses in + a just allocated level or zone) and transport-fault is re-set for + all non-oldspace, non-disabled pages by the set-oldspace-registers + instruction. Transport-disable tells the microcode 1not0 to + automatically enable transport faults on those addresses (in support + of safeguarded and weakspace). The microcode can validly optimize + out setting of other transport faults when it "knows" there are no + oldspace references in the page. Wired is 1advice0 to the microcode + that the range is likely to be frequently accessed. + +1ptw: Does setting missing-fault allow the micro-machine to reclaim the +page? Or do we need another more explicit mechanism. I don't think so, +since I can think of no other use for setting it. + +0 page-size + + not an instruction, but a new register. If rev. 5 changes the page + size, even though it is a virtual address machine, the GC will + probably interact best with the microcode when it knows the + underlying page size (in particular, it will need to know it if + page-based transport faults are implemented). + + miscellaneous + + I don't know off the top of my head how many "free" instructions are + available, but we will probably find it quite useful to re-microcode + some operations such as block-gc-copy-and-forward. diff --git a/admin/mprotect-bug.c b/admin/mprotect-bug.c new file mode 100644 index 0000000..bbc8f45 --- /dev/null +++ b/admin/mprotect-bug.c @@ -0,0 +1,95 @@ +#include +#include +#include +#include +#include +#include +#include + +#define PAGESIZE (1024*8) +#define MAPSIZE (1024*8*32) +#define NMAP 30 +#define MAPBASE 0x20000000000 + +long addrarr[NMAP]; +long maddrarr[NMAP]; + +void segv_handler (int sigval, int code, register struct sigcontext *scp) +{ + int ret; + caddr_t aligned_vma = (caddr_t) (scp->sc_traparg_a0 & ~(PAGESIZE -1)); + int prot = (random()&01)?(PROT_READ):(PROT_READ|PROT_WRITE); + + ret = mprotect(aligned_vma, PAGESIZE, prot); + if(ret == -1) + printf("mprotect/write failed @ 0x%lxprot %d, errno=%d\n", aligned_vma, prot, errno); + + ret = mvalid(aligned_vma, PAGESIZE, prot); + if(ret == -1) + printf("mvalid failed @ 0x%lx prot %d, errno=%d\n", aligned_vma, prot, errno); +} + +main(int argc, char *argv[]) + { + int i, ret; + long startaddr; + int fd; + struct sigaction action; + + fd = open(argv[1], O_RDONLY, 0); + if (fd == -1) { + printf("open failed, errno=%d\n", errno); + } + + startaddr = 0; + for(i=0; i +To: tenny@symbolics +Apparently-To: tenny@symbolics +Subject: OSF/1 QAR Info + + +Hi Dave, + +I have attached below the procedure for a seed unit customer to submit +a QAR. + +Also, the base level 11 and 12 release notes are only available in postscript. +I will send you the postscript files in follow-on messages. (Hopefully they +won't get truncated along the way!). + +Regards, + +Jim + + + DIGITAL EQUIPMENT CORPORATION + + PRODUCT SUPPORT FOR ALPHA DEVELOPMENT PRODUCTS IN THE U.S. + + + It is important to Digital that your early Alpha Development System be + employed effectively. We have organized special product support to + minimize time lost due to software changes or hardware downtime. You + were pre-registered for Alpha product support when you signed the Loan + of Development Product Agreement. + + All problems should first be logged by dialing 1-800-354-9000 and + pressing "3" as suggested by the automated call prompter. Enter the + special access code "1999" and identify yourself to the call screening + specialist as an Alpha Development System user. + + DSNLink and DSIN are also available from your VAX/VMS or RISC/ULTRIX + system, allowing for toll-free, electronic software support. For + further information, call 1-800-354-9000. + + Software problems will be addressed by the first available specialist + at the Customer Support Center. Alpha Development System users + receive high priority. Calls relating specifically to the use of + Alpha Migration Tools, the migration process, or migration activity + will be forwarded to the supporting Alpha Migration Center, which will + then contact you. + + If it is determined that an on-site repair visit is required, the + nearest Digital Service Center will be notified and you will receive + prompt support. + + If resolution cannot be accomplished by the engineer or specialist, + Digital Services will escalate the problem to engineering and notify + you that this has been done. Digital Services will monitor the status + of the problem and either resolve the problem or notify you when + resolution can be expected. + + Extended support coverage plans to meet particular needs can be + arranged by your local Digital Services office. + + diff --git a/admin/schedule.text b/admin/schedule.text new file mode 100644 index 0000000..82c80b2 --- /dev/null +++ b/admin/schedule.text @@ -0,0 +1,150 @@ + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") Virtual Lisp Machine project schedule (preliminary) + ** Company Confidential ** + + +(2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")! = important milestone, must be met at or near the specified date +* = date at risk due to possible hard-to-foresee difficulties +n = new or revised milestone + +Task Completion Personnel0 2Status + date + +0Get VLM debugger for C-emulator working 11/13/92 Judy Done 11/13 + +Get C-emulator working again to verify 11/13/92 Judy Done 11/13 + that the VLM debugger works + +Get C-based emulator working on Beta 11/20/92 PTW Done 12/2 + +Run Boyer benchmark on C-emulator on Beta, 11/20/92 PTW Done 12/9 + and get benchmark numbers + +Run experiments to determine that mmap 11/20/92 Judy,PTW Done 12/1 + and munmap will satisfy our needs for the + emulator storage system + +Glue VLM debugger to asm-emulator 11/23/92 Judy Done 12/1 + +Get KHS instruction tests to run to 11/25/92 PTW Done 12/4 + completion on C-based emulator (doesn't + have to pass completely) + +Get initial asm-emulator running on Beta, 11/25/92 Paul Punted 12/7 + and get initial benchmarks for instruction + decoding and a few basic instructions (TAK) + +Get console life support working 11/25/92 Judy Done 12/8 + +Life support core working 11/25/92 Gary Done 12/8 + +Get disk life support working 12/02/92 Gary Done 12/14 + +"Hello world" on Beta 12/04/92 Gary,Judy Done 12/9 + +Start bring up IFep under C-emulator 12/04/92 PTW,Judy,Gary Done 12/9 + to debug console and disk life support + +Asm-emulator runs Boyer benchmark 12/11/93! Paul Done 12/18 (~XL800) + +IFep mostly works under C-emulator 12/11/93! Judy,Gary Done 1/5 + +Research and experimentation on using 12/25/92 PTW Done 12/7 + native memory management to do PHT + (using C-emulator as the testbed) + +Bring up Minima under C-emulator 01/01/93 PTW,Gary Punted 1/5 + to debug network life support + (acceptable if no GC) + +Bring up IFEP under asm-emulator 01/05/93! Gary,PTW,SWM Done 2/1 + +Start investigations on removing 01/15/93 SWM Done 1/15 + unnecessary bottlenecks from the sheet + window system, by calling into X at + a higher level + +New machine type, file type, and world 01/15/93 Bob,SWM Done 2/2 + load type for the VLM; SCT support + +Investigate alternative world load 01/29/93 Gary Done 1/29 + format to improve performance of booting + and paging from world load (this requires + doing "world tools" in C) + +Unix-style command interface to start 02/05/93n Gary + up the VLM (takes arguments that augment + data gotten from any config files) + +Asm-emulator passes most instruction tests 02/12/93n PTW,SWM Done 2/26 + +Bring up Minima under asm-emulator 02/12/93!n Gary,PTW,SWM Done 2/26 + (acceptable if no GC) + +Get network life support working 02/19/93* Tenny,Gary Done 3/5 + +Convert IFEP debugger into IFEP kernel 02/19/93n Eric,Gary Done 3/19 + +Start designing, implementing RPC so 02/19/93 Tenny,Gary + that users can call out to OSF-1 + +Fix Genera Memory Management to use 02/26/93*n PTW +native Alpha Memory Management + +Genera sources conditionalized for VLM 02/19/93 Bob,SWM + machine type in order to eliminate all + code not needed by the VLM + +Genera hobbles along under asm-emulator 02/26/93!n Gary,PTW + (using native PHT, but acceptable if no GC) + +Emulator passes all instruction tests, 02/26/93n PTW,SWM Done 3/5 + including all traps + +Genera works reasonably well 03/19/93n Everyone + (GC starting to work with native PHT) + +Alternative world load format installed, 03/19/93 Gary + if investigations are successful + +Asm-interpreter substantially tuned 03/29/93n Paul + +Genera's sheet window system now calls 03/29/93*n SWM,Bob + into X windows at a higher level + +Genera's sheet window system now calls 03/29/93*n SWM,Bob + into X Windows via an embedded channel + +Documentation effort under way 04/02/93 (Doc) + +Kit design under way 04/02/93 Carl + +Draft Alpha, QA, and Beta Plans written 04/09/93n Watkins + +Basic RPC support implemented 04/09/93n Tenny,Gary + +LMFS/DBFS w/o FEPFS + Host file channel 04/09/93n Gary + +Genera works well, including GC 04/26/93!*n Everyone + +Translator written, interfaced to asm 04/26/93n Paul +interpreter + +In-house Alpha testing and QA started 04/26/93n (QA) + +Continue doing performance work 04/30/93 Everyone + - tune emulator, extend implementation - Paul + to do more before trapping out + - tune memory management, paging, and GC - PTW + - tune disk and network life support - Gary,Tenny + - identify Genera translation targets - Paul,Bob + +Benchmarks translated and run 05/07/93n Bob + +Genera 8.4 Feature Freeze 05/07/93n + +Beta1 software ships 05/28/93! + +Genera 8.4 Final Freeze 07/16/93n + +FCS 08/27/93! diff --git a/admin/swapstat.c b/admin/swapstat.c new file mode 100644 index 0000000..b302793 --- /dev/null +++ b/admin/swapstat.c @@ -0,0 +1,73 @@ + +/* +* Swap statistics for DEC OSF/1 (either V1.0 or V2.0, MIPS or ALPHA) +* +* To build: cc -o swapstat -O swapstat.c +* To install: install -g kmem -u bin -m 2755 -S -f /usr/sbin swapstat +* (you must be root to execute the above command) +* Results: +* Swap space free = 94.29% (241.4MB out of 256.0MB) +* Total swap space to physical memory = 200.05% (256.0MB to 128.0MB) +*/ + +#include +#include +#include +#include +#include +#include + +struct nlist nl[] = { + { "_vm_swap_space" }, +#define N_VM_SWAP_SPACE 0 + { "_vm_total_swap_space" }, +#define N_VM_TOTAL_SWAP_SPACE 1 + { "_physmem" }, +#define N_PHYSMEM 2 + { NULL }, +}; + +main( + int argc, + char *argv[]) +{ + vm_size_t vm_swap_space, vm_total_swap_space; + double to_mb = (double) getpagesize() / (1024.0*1024.0); + int kmem, physmem; + + if (nlist(_PATH_UNIX, nl) < 0) + exit(1); + + kmem = open(_PATH_KMEM, O_RDONLY); + if (kmem < 0) { + perror(_PATH_KMEM); + exit(1); + } + lseek(kmem, (off_t) nl[N_VM_SWAP_SPACE].n_value, SEEK_SET); + if (read(kmem, &vm_swap_space, sizeof(vm_swap_space)) != sizeof(vm_swap_space)) { + perror("vm_swap_space"); + exit(1); + } + lseek(kmem, (off_t) nl[N_VM_TOTAL_SWAP_SPACE].n_value, SEEK_SET); + if (read(kmem, &vm_total_swap_space, sizeof(vm_total_swap_space)) != sizeof(vm_swap_space)) { + perror("vm_total_swap_space"); + exit(1); + } + lseek(kmem, (off_t) nl[N_PHYSMEM].n_value, SEEK_SET); + if (read(kmem, &physmem, sizeof(physmem)) != sizeof(physmem)) { + perror("physmem"); + exit(1); + } + + printf("Swap space free = %.2lf%%", + (double) (vm_swap_space * 100.0 / vm_total_swap_space)); + printf(" (%.1lfMB out of %.1lfMB)\n", + (double) vm_swap_space * to_mb, + (double) vm_total_swap_space * to_mb); + printf("Total swap space to physical memory = %.2lf%%", + (double) (vm_total_swap_space * 100.0 / physmem)); + printf(" (%.1lfMB to %.1lfMB)\n", + (double) vm_total_swap_space * to_mb, + (double) physmem * to_mb); + return 0; +} diff --git a/admin/verification.text b/admin/verification.text new file mode 100644 index 0000000..f04494d --- /dev/null +++ b/admin/verification.text @@ -0,0 +1,49 @@ +-*- Mode: Text -*- + +How to run the verification suite: + +:Load File SYS:SITE;IMACH.TRANSLATIONS + +:Load System I-Verify :Version Newest + + (sysdcl in IMACH:I-VERIFY;I-VERIFY.LISP) + +:Load File IMACH:I-VERIFY;VLM-INTERFACE + + (which defines the verificationvlm interface) + +:Load File R:>ptw>work>emulator>minimaccess-changes + + (which extends the Minima Access protocols to accomodate the above, + primarily creating a write-buffer.) + +To run the tests: + +Select the emulator access path in the Minima Debugger + +(IV:INITIALIZE-VIRTUAL-LISP-MACHINE 4) + + [Stupidly, this assumes the current Minima Debugger access path to be + the emulator. We can fix this by making a Debugger command to do + this.] + +(IV:LOAD-WORLD-HACK :IMPLEMENTATION 4 :PATHNAMES ...) + + Pathnames should include at least MACROS and TRAPS, then whatever + tests you want to run. Some of the files depend on earlier files + (unfortunately you can only discover this by tiral and error). It + compiles the files afresh each time you load, so is fairly slow. We + could probably work out a way to save an image to load, I have not + investigated doing that. This should probably be part of the same + Debugger command, although I think you can load more files if you + don't initialize. + +:Run Tests :Disable Stack Cache Emptying Yes + + is some complex KHS-ism. A null pattern runs all the loaded +tests. You can run a particular test by using it's exact name (as +echoed when it is run). You can usually run the tests in a file by +using the file's name, e.g., the tests in LISTS can be run by "Run Tests +lists"; finally, you can select sets of tests, with boolean expressions +such as "Run Tests (and call (not flavors))". + diff --git a/admin/vlm-installation.text b/admin/vlm-installation.text new file mode 100644 index 0000000..3fe8f7f Binary files /dev/null and b/admin/vlm-installation.text differ diff --git a/alpha-emulator/aistat.c b/alpha-emulator/aistat.c new file mode 100644 index 0000000..911832f --- /dev/null +++ b/alpha-emulator/aistat.c @@ -0,0 +1,4 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid Any changes made to it will be lost. */ + + diff --git a/alpha-emulator/aistat.h b/alpha-emulator/aistat.h new file mode 100644 index 0000000..8286e12 --- /dev/null +++ b/alpha-emulator/aistat.h @@ -0,0 +1,326 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid Any changes made to it will be lost. */ + +#ifndef _AISTAT_ +#define _AISTAT_ + + + +typedef struct processorstate { + uint64_t transpare3; + uint64_t transpare2; + uint64_t transpare1; + uint64_t carcdrsubroutine; + uint64_t cdrsubroutine; + uint64_t carsubroutine; + uint64_t linkage; + uint64_t resumeema; + char *statistics; + char *trace_hook; + int64_t instruction_count; + uint64_t long_pad0; + uint64_t asrr9; + uint64_t asrr10; + uint64_t asrr11; + uint64_t asrr12; + uint64_t asrr13; + uint64_t asrr14; + uint64_t asrr15; + uint64_t long_pad1; + uint64_t asrr26; + uint64_t asrr27; + uint64_t asrr29; + uint64_t asrr30; + uint64_t asrf2; + uint64_t asrf3; + uint64_t asrf4; + uint64_t asrf5; + uint64_t asrf6; + uint64_t asrf7; + uint64_t asrf8; + uint64_t asrf9; + char *meterdatabuff; + uint32_t meterpos; + uint32_t metermax; + uint32_t meterfreq; + uint32_t metermask; + uint32_t metervalue; + uint32_t metercount; + uint64_t choiceptr; + uint64_t sstkchoiceptr; + uint64_t dbcbase; + uint64_t dbcmask; + char *coprocessorreadhook; + char *coprocessorwritehook; + char *flushcaches_hook; + char *i_stage_error_hook; + uint64_t sfp1; + uint64_t fp0; + uint64_t fp1; + uint64_t floating_exception; + uint64_t aluandrotatecontrol; + uint64_t rotatelatch; + uint64_t aluborrow; + uint64_t aluoverflow; + uint64_t alulessthan; + uint64_t aluop; + uint64_t byterotate; + uint64_t bytesize; + int64_t bindingstacklimit; + int64_t bindingstackpointer; + uint64_t catchblock; + uint64_t extraandcatch; + uint64_t msclockcache; + uint64_t mscmultiplier; + uint64_t previousrcpp; + char *rlink; + uint32_t interruptreg; + uint32_t zoneoldspace; + uint32_t ephemeraloldspace; + uint32_t int_pad0; + uint64_t eqnoteql; + uint32_t lclength; + uint32_t sclength; + uint64_t lcarea; + uint64_t lcaddress; + uint64_t scarea; + uint64_t scaddress; + uint64_t restartsp; + uint64_t stop_interpreter; + uint64_t immediate_arg; + uint64_t continuationcp; + int64_t continuation; + int64_t control; + int64_t niladdress; + int64_t taddress; + int64_t bar0; + int64_t bar1; + int64_t bar2; + int64_t bar3; + int64_t epc; + int64_t fp; + int64_t lp; + int64_t sp; + char *cp; + uint64_t fccrmask; + uint32_t cslimit; + uint32_t csextralimit; + char *trapmeterdata; + uint64_t fepmodetrapvecaddress; + uint64_t trapvecbase; + uint64_t tvi; + uint64_t fccrtrapmask; + char *ptrtype; + char *vmattributetable; + uint64_t vma; + int64_t mostnegativefixnum; + char *icachebase; + char *endicache; + uint64_t fullworddispatch; + uint64_t halfworddispatch; + int64_t areventcount; + uint64_t stackcachesize; + uint64_t stackcachetopvma; + uint64_t cdrcodemask; + char *stackcachedata; + uint64_t stackcachebasevma; + uint32_t scovlimit; + uint32_t scovdumpcount; + int64_t mostpositivefixnum; + uint64_t internalregisterread1; + uint64_t internalregisterread2; + uint64_t internalregisterwrite1; + uint64_t internalregisterwrite2; + uint64_t dataread_mask; + char *dataread; + uint64_t datawrite_mask; + char *datawrite; + uint64_t bindread_mask; + char *bindread; + uint64_t bindwrite_mask; + char *bindwrite; + uint64_t bindreadnomonitor_mask; + char *bindreadnomonitor; + uint64_t bindwritenomonitor_mask; + char *bindwritenomonitor; + uint64_t header_mask; + char *header; + uint64_t structureoffset_mask; + char *structureoffset; + uint64_t scavenge_mask; + char *scavenge; + uint64_t cdr_mask; + char *cdr; + uint64_t gccopy_mask; + char *gccopy; + uint64_t raw_mask; + char *raw; + uint64_t rawtranslate_mask; + char *rawtranslate; + int32_t please_stop; + int32_t please_trap; + int64_t runningp; + uint64_t ac0array; + uint64_t ac0arword; + uint64_t ac0locat; + uint64_t ac0length; + uint64_t ac1array; + uint64_t ac1arword; + uint64_t ac1locat; + uint64_t ac1length; + uint64_t ac2array; + uint64_t ac2arword; + uint64_t ac2locat; + uint64_t ac2length; + uint64_t ac3array; + uint64_t ac3arword; + uint64_t ac3locat; + uint64_t ac3length; + uint64_t ac4array; + uint64_t ac4arword; + uint64_t ac4locat; + uint64_t ac4length; + uint64_t ac5array; + uint64_t ac5arword; + uint64_t ac5locat; + uint64_t ac5length; + uint64_t ac6array; + uint64_t ac6arword; + uint64_t ac6locat; + uint64_t ac6length; + uint64_t ac7array; + uint64_t ac7arword; + uint64_t ac7locat; + uint64_t ac7length; + uint32_t tmcurrenttransaction; + uint32_t tmwritestart; + uint32_t tmwritecurrent; + uint32_t tmwritelimit; + uint32_t tmrecordingreads; + uint32_t tmreadstart; + uint32_t tmreadcurrent; + uint32_t tmreadlimit; + } PROCESSORSTATE, *PROCESSORSTATEP; + +#define PROCESSORSTATE_SIZE 1440 + +typedef struct cacheline { + uint64_t annotation; + uint32_t nextpcdata; + uint32_t nextpctag; + char *nextcp; + uint32_t instruction; + uint32_t operand; + uint32_t pcdata; + uint32_t pctag; + char *code; + } CACHELINE, *CACHELINEP; + +#define CACHELINE_SIZE 48 + +#define CacheLine_Bits 18 + +#define CacheLine_Mask 262143 + +#define CacheLine_RShift 16 + +#define CacheLine_LShift 6 + +#define CacheLine_FillAmount 20 + +typedef struct arraycache { + uint64_t array; + uint64_t arword; + uint64_t locat; + uint64_t length; + } ARRAYCACHE, *ARRAYCACHEP; + +#define AutoArrayReg_Mask 224 + +#define AutoArrayReg_Size 32 + +#define AutoArrayReg_Shift 0 + +#define MSclock_UnitsToMSShift 24 + +#define MSclock_UnitsPerMicrosecond 16777216 + +#define Stack_CacheSize 1792 + +#define Stack_MaxFrameSize 128 + +#define Stack_CacheMargin 128 + +#define Stack_CacheDumpQuantum 896 + +#define IvoryMemory_Data 35 + +#define IvoryMemory_Tag 33 + +typedef struct savedregisters { + uint64_t r9; + uint64_t r10; + uint64_t r11; + uint64_t r12; + uint64_t r13; + uint64_t r14; + uint64_t r15; + uint64_t r29; + uint64_t f2; + uint64_t f3; + uint64_t f4; + uint64_t f5; + uint64_t f6; + uint64_t f7; + uint64_t f8; + uint64_t f9; + } SAVEDREGISTERS, *SAVEDREGISTERSP; + +#define SAVEDREGISTERS_SIZE 128 + +typedef struct tracedata { + uint64_t n_entries; + uint32_t recording_p; + uint32_t wrap_p; + uint64_t start_pc; + uint64_t stop_pc; + char *records_start; + char *records_end; + char *current_entry; + char *printer; + } TRACEDATA, *TRACEDATAP; + +#define TRACEDATA_SIZE 64 + +typedef struct tracerecord { + uint64_t counter; + uint64_t epc; + uint64_t tos; + uint64_t sp; + char *instruction; + uint64_t instruction_data; + uint32_t operand; + uint32_t trap_p; + uint64_t trap_data_0; + uint64_t trap_data_1; + uint64_t trap_data_2; + uint64_t trap_data_3; + uint32_t catch_block_p; + uint32_t int_pad0; + uint64_t catch_block_0; + uint64_t catch_block_1; + uint64_t catch_block_2; + uint64_t catch_block_3; + } TRACERECORD, *TRACERECORDP; + +#define TRACERECORD_SIZE 128 + +#define CacheMeter_Pwr 14 + +#define CacheMeter_DefaultFreq 1000 +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid Any changes made to it will be lost. */ + +#endif + + diff --git a/alpha-emulator/aistat.lisp b/alpha-emulator/aistat.lisp new file mode 100644 index 0000000..9775bbd --- /dev/null +++ b/alpha-emulator/aistat.lisp @@ -0,0 +1,346 @@ +;;; -*- Mode: LISP; Package: ALPHA-AXP-INTERNALS; Base: 10; Syntax: Common-Lisp; -*- +;;; +;;; WARNING!! DO NOT MODIFY THIS FILE! +;;; It was automatically generated from vlm:alpha-emulator;aistat.sid. Any changes made to it will be lost. + +#+Alpha-AXP-Emulator +(in-package "ALPHA-AXP-INTERNALS") + +#+PowerPC-Emulator +(in-package "POWERPC-INTERNALS") + + +;;; Structure PROCESSORSTATE +(defconstant processorstate$q-transpare3 -1440) +(defconstant processorstate$q-transpare2 -1432) +(defconstant processorstate$q-transpare1 -1424) +(defconstant processorstate$q-carcdrsubroutine -1416) +(defconstant processorstate$q-cdrsubroutine -1408) +(defconstant processorstate$q-carsubroutine -1400) +(defconstant processorstate$q-linkage -1392) +(defconstant processorstate$q-resumeema -1384) +(defconstant processorstate$p-statistics -1376) +(defconstant processorstate$p-trace-hook -1368) +(defconstant processorstate$q-instruction-count -1360) +(defconstant processorstate$q-long-pad0 -1352) +(defconstant processorstate$q-asrr9 -1344) +(defconstant processorstate$q-asrr10 -1336) +(defconstant processorstate$q-asrr11 -1328) +(defconstant processorstate$q-asrr12 -1320) +(defconstant processorstate$q-asrr13 -1312) +(defconstant processorstate$q-asrr14 -1304) +(defconstant processorstate$q-asrr15 -1296) +(defconstant processorstate$q-long-pad1 -1288) +(defconstant processorstate$q-asrr26 -1280) +(defconstant processorstate$q-asrr27 -1272) +(defconstant processorstate$q-asrr29 -1264) +(defconstant processorstate$q-asrr30 -1256) +(defconstant processorstate$q-asrf2 -1248) +(defconstant processorstate$q-asrf3 -1240) +(defconstant processorstate$q-asrf4 -1232) +(defconstant processorstate$q-asrf5 -1224) +(defconstant processorstate$q-asrf6 -1216) +(defconstant processorstate$q-asrf7 -1208) +(defconstant processorstate$q-asrf8 -1200) +(defconstant processorstate$q-asrf9 -1192) +(defconstant processorstate$p-meterdatabuff -1184) +(defconstant processorstate$l-meterpos -1176) +(defconstant processorstate$l-metermax -1172) +(defconstant processorstate$l-meterfreq -1168) +(defconstant processorstate$l-metermask -1164) +(defconstant processorstate$l-metervalue -1160) +(defconstant processorstate$l-metercount -1156) +(defconstant processorstate$q-choiceptr -1152) +(defconstant processorstate$q-sstkchoiceptr -1144) +(defconstant processorstate$q-dbcbase -1136) +(defconstant processorstate$q-dbcmask -1128) +(defconstant processorstate$p-coprocessorreadhook -1120) +(defconstant processorstate$p-coprocessorwritehook -1112) +(defconstant processorstate$p-flushcaches-hook -1104) +(defconstant processorstate$p-i-stage-error-hook -1096) +(defconstant processorstate$q-sfp1 -1088) +(defconstant processorstate$q-fp0 -1080) +(defconstant processorstate$q-fp1 -1072) +(defconstant processorstate$q-floating-exception -1064) +(defconstant processorstate$q-aluandrotatecontrol -1056) +(defconstant processorstate$q-rotatelatch -1048) +(defconstant processorstate$q-aluborrow -1040) +(defconstant processorstate$q-aluoverflow -1032) +(defconstant processorstate$q-alulessthan -1024) +(defconstant processorstate$q-aluop -1016) +(defconstant processorstate$q-byterotate -1008) +(defconstant processorstate$q-bytesize -1000) +(defconstant processorstate$q-bindingstacklimit -992) +(defconstant processorstate$q-bindingstackpointer -984) +(defconstant processorstate$q-catchblock -976) +(defconstant processorstate$q-extraandcatch -968) +(defconstant processorstate$q-msclockcache -960) +(defconstant processorstate$q-mscmultiplier -952) +(defconstant processorstate$q-previousrcpp -944) +(defconstant processorstate$p-rlink -936) +(defconstant processorstate$l-interruptreg -928) +(defconstant processorstate$l-zoneoldspace -924) +(defconstant processorstate$l-ephemeraloldspace -920) +(defconstant processorstate$l-int-pad0 -916) +(defconstant processorstate$q-eqnoteql -912) +(defconstant processorstate$l-lclength -904) +(defconstant processorstate$l-sclength -900) +(defconstant processorstate$q-lcarea -896) +(defconstant processorstate$q-lcaddress -888) +(defconstant processorstate$q-scarea -880) +(defconstant processorstate$q-scaddress -872) +(defconstant processorstate$q-restartsp -864) +(defconstant processorstate$q-stop-interpreter -856) +(defconstant processorstate$q-immediate-arg -848) +(defconstant processorstate$q-continuationcp -840) +(defconstant processorstate$q-continuation -832) +(defconstant processorstate$q-control -824) +(defconstant processorstate$q-niladdress -816) +(defconstant processorstate$q-taddress -808) +(defconstant processorstate$q-bar0 -800) +(defconstant processorstate$q-bar1 -792) +(defconstant processorstate$q-bar2 -784) +(defconstant processorstate$q-bar3 -776) +(defconstant processorstate$q-epc -768) +(defconstant processorstate$q-fp -760) +(defconstant processorstate$q-lp -752) +(defconstant processorstate$q-sp -744) +(defconstant processorstate$p-cp -736) +(defconstant processorstate$q-fccrmask -728) +(defconstant processorstate$l-cslimit -720) +(defconstant processorstate$l-csextralimit -716) +(defconstant processorstate$p-trapmeterdata -712) +(defconstant processorstate$q-fepmodetrapvecaddress -704) +(defconstant processorstate$q-trapvecbase -696) +(defconstant processorstate$q-tvi -688) +(defconstant processorstate$q-fccrtrapmask -680) +(defconstant processorstate$p-ptrtype -672) +(defconstant processorstate$p-vmattributetable -664) +(defconstant processorstate$q-vma -656) +(defconstant processorstate$q-mostnegativefixnum -648) +(defconstant processorstate$p-icachebase -640) +(defconstant processorstate$p-endicache -632) +(defconstant processorstate$q-fullworddispatch -624) +(defconstant processorstate$q-halfworddispatch -616) +(defconstant processorstate$q-areventcount -608) +(defconstant processorstate$q-stackcachesize -600) +(defconstant processorstate$q-stackcachetopvma -592) +(defconstant processorstate$q-cdrcodemask -584) +(defconstant processorstate$p-stackcachedata -576) +(defconstant processorstate$q-stackcachebasevma -568) +(defconstant processorstate$l-scovlimit -560) +(defconstant processorstate$l-scovdumpcount -556) +(defconstant processorstate$q-mostpositivefixnum -552) +(defconstant processorstate$q-internalregisterread1 -544) +(defconstant processorstate$q-internalregisterread2 -536) +(defconstant processorstate$q-internalregisterwrite1 -528) +(defconstant processorstate$q-internalregisterwrite2 -520) +(defconstant processorstate$q-dataread-mask -512) +(defconstant processorstate$p-dataread -504) +(defconstant processorstate$q-datawrite-mask -496) +(defconstant processorstate$p-datawrite -488) +(defconstant processorstate$q-bindread-mask -480) +(defconstant processorstate$p-bindread -472) +(defconstant processorstate$q-bindwrite-mask -464) +(defconstant processorstate$p-bindwrite -456) +(defconstant processorstate$q-bindreadnomonitor-mask -448) +(defconstant processorstate$p-bindreadnomonitor -440) +(defconstant processorstate$q-bindwritenomonitor-mask -432) +(defconstant processorstate$p-bindwritenomonitor -424) +(defconstant processorstate$q-header-mask -416) +(defconstant processorstate$p-header -408) +(defconstant processorstate$q-structureoffset-mask -400) +(defconstant processorstate$p-structureoffset -392) +(defconstant processorstate$q-scavenge-mask -384) +(defconstant processorstate$p-scavenge -376) +(defconstant processorstate$q-cdr-mask -368) +(defconstant processorstate$p-cdr -360) +(defconstant processorstate$q-gccopy-mask -352) +(defconstant processorstate$p-gccopy -344) +(defconstant processorstate$q-raw-mask -336) +(defconstant processorstate$p-raw -328) +(defconstant processorstate$q-rawtranslate-mask -320) +(defconstant processorstate$p-rawtranslate -312) +(defconstant processorstate$l-please-stop -304) +(defconstant processorstate$l-please-trap -300) +(defconstant processorstate$q-runningp -296) +(defconstant processorstate$q-ac0array -288) +(defconstant processorstate$q-ac0arword -280) +(defconstant processorstate$q-ac0locat -272) +(defconstant processorstate$q-ac0length -264) +(defconstant processorstate$q-ac1array -256) +(defconstant processorstate$q-ac1arword -248) +(defconstant processorstate$q-ac1locat -240) +(defconstant processorstate$q-ac1length -232) +(defconstant processorstate$q-ac2array -224) +(defconstant processorstate$q-ac2arword -216) +(defconstant processorstate$q-ac2locat -208) +(defconstant processorstate$q-ac2length -200) +(defconstant processorstate$q-ac3array -192) +(defconstant processorstate$q-ac3arword -184) +(defconstant processorstate$q-ac3locat -176) +(defconstant processorstate$q-ac3length -168) +(defconstant processorstate$q-ac4array -160) +(defconstant processorstate$q-ac4arword -152) +(defconstant processorstate$q-ac4locat -144) +(defconstant processorstate$q-ac4length -136) +(defconstant processorstate$q-ac5array -128) +(defconstant processorstate$q-ac5arword -120) +(defconstant processorstate$q-ac5locat -112) +(defconstant processorstate$q-ac5length -104) +(defconstant processorstate$q-ac6array -96) +(defconstant processorstate$q-ac6arword -88) +(defconstant processorstate$q-ac6locat -80) +(defconstant processorstate$q-ac6length -72) +(defconstant processorstate$q-ac7array -64) +(defconstant processorstate$q-ac7arword -56) +(defconstant processorstate$q-ac7locat -48) +(defconstant processorstate$q-ac7length -40) +(defconstant processorstate$l-tmcurrenttransaction -32) +(defconstant processorstate$l-tmwritestart -28) +(defconstant processorstate$l-tmwritecurrent -24) +(defconstant processorstate$l-tmwritelimit -20) +(defconstant processorstate$l-tmrecordingreads -16) +(defconstant processorstate$l-tmreadstart -12) +(defconstant processorstate$l-tmreadcurrent -8) +(defconstant processorstate$l-tmreadlimit -4) + +(defconstant processorstate$k-size 1440) +(defconstant |PROCESSORSTATESIZE| 1440) + + +;;; Structure CACHELINE +(defconstant cacheline$q-annotation 0) +(defconstant cacheline$l-nextpcdata 8) +(defconstant cacheline$l-nextpctag 12) +(defconstant cacheline$p-nextcp 16) +(defconstant cacheline$l-instruction 24) +(defconstant cacheline$l-operand 28) +(defconstant cacheline$l-pcdata 32) +(defconstant cacheline$l-pctag 36) +(defconstant cacheline$p-code 40) + +(defconstant cacheline$k-size 48) +(defconstant |CACHELINESIZE| 48) + +(defparameter |cacheline|$k-|bits| 18) +(defparameter |CacheLineBits| 18) + +(defparameter |cacheline|$k-|mask| 262143) +(defparameter |CacheLineMask| 262143) + +(defparameter |cacheline|$k-|rshift| 16) +(defparameter |CacheLineRShift| 16) + +(defparameter |cacheline|$k-|lshift| 6) +(defparameter |CacheLineLShift| 6) + +(defparameter |cacheline|$k-|fillamount| 20) +(defparameter |CacheLineFillAmount| 20) + + +;;; Structure ARRAYCACHE +(defconstant arraycache$q-array 0) +(defconstant arraycache$q-arword 8) +(defconstant arraycache$q-locat 16) +(defconstant arraycache$q-length 24) + +(defparameter |autoarrayreg|$k-|mask| 224) +(defparameter |AutoArrayRegMask| 224) + +(defparameter |autoarrayreg|$k-|size| 32) +(defparameter |AutoArrayRegSize| 32) + +(defparameter |autoarrayreg|$k-|shift| 0) +(defparameter |AutoArrayRegShift| 0) + +(defparameter |msclock|$k-|unitstomsshift| 24) +(defparameter |MSclockUnitsToMSShift| 24) + +(defparameter |msclock|$k-|unitspermicrosecond| 16777216) +(defparameter |MSclockUnitsPerMicrosecond| 16777216) + +(defparameter |stack|$k-|cachesize| 1792) +(defparameter |StackCacheSize| 1792) + +(defparameter |stack|$k-|maxframesize| 128) +(defparameter |StackMaxFrameSize| 128) + +(defparameter |stack|$k-|cachemargin| 128) +(defparameter |StackCacheMargin| 128) + +(defparameter |stack|$k-|cachedumpquantum| 896) +(defparameter |StackCacheDumpQuantum| 896) + +(defconstant |ivorymemory|$k-|data| 35) +(defconstant |IvoryMemoryData| 35) + +(defconstant |ivorymemory|$k-|tag| 33) +(defconstant |IvoryMemoryTag| 33) + + +;;; Structure SAVEDREGISTERS +(defconstant savedregisters$q-r9 0) +(defconstant savedregisters$q-r10 8) +(defconstant savedregisters$q-r11 16) +(defconstant savedregisters$q-r12 24) +(defconstant savedregisters$q-r13 32) +(defconstant savedregisters$q-r14 40) +(defconstant savedregisters$q-r15 48) +(defconstant savedregisters$q-r29 56) +(defconstant savedregisters$q-f2 64) +(defconstant savedregisters$q-f3 72) +(defconstant savedregisters$q-f4 80) +(defconstant savedregisters$q-f5 88) +(defconstant savedregisters$q-f6 96) +(defconstant savedregisters$q-f7 104) +(defconstant savedregisters$q-f8 112) +(defconstant savedregisters$q-f9 120) + +(defconstant savedregisters$k-size 128) +(defconstant |SAVEDREGISTERSSIZE| 128) + + +;;; Structure TRACEDATA +(defconstant tracedata$q-n_entries 0) +(defconstant tracedata$l-recording_p 8) +(defconstant tracedata$l-wrap_p 12) +(defconstant tracedata$q-start_pc 16) +(defconstant tracedata$q-stop_pc 24) +(defconstant tracedata$p-records_start 32) +(defconstant tracedata$p-records_end 40) +(defconstant tracedata$p-current_entry 48) +(defconstant tracedata$p-printer 56) + +(defconstant tracedata$k-size 64) +(defconstant |TRACEDATASIZE| 64) + + +;;; Structure TRACERECORD +(defconstant tracerecord$q-counter 0) +(defconstant tracerecord$q-epc 8) +(defconstant tracerecord$q-tos 16) +(defconstant tracerecord$q-sp 24) +(defconstant tracerecord$p-instruction 32) +(defconstant tracerecord$q-instruction_data 40) +(defconstant tracerecord$l-operand 48) +(defconstant tracerecord$l-trap_p 52) +(defconstant tracerecord$q-trap_data_0 56) +(defconstant tracerecord$q-trap_data_1 64) +(defconstant tracerecord$q-trap_data_2 72) +(defconstant tracerecord$q-trap_data_3 80) +(defconstant tracerecord$l-catch_block_p 88) +(defconstant tracerecord$l-int-pad0 92) +(defconstant tracerecord$q-catch_block_0 96) +(defconstant tracerecord$q-catch_block_1 104) +(defconstant tracerecord$q-catch_block_2 112) +(defconstant tracerecord$q-catch_block_3 120) + +(defconstant tracerecord$k-size 128) +(defconstant |TRACERECORDSIZE| 128) + +(defparameter |cachemeter|$k-|pwr| 14) +(defparameter |CacheMeterPwr| 14) + +(defparameter |cachemeter|$k-|defaultfreq| 1000) +(defparameter |CacheMeterDefaultFreq| 1000) diff --git a/alpha-emulator/aistat.s b/alpha-emulator/aistat.s new file mode 100644 index 0000000..3bbc4d3 --- /dev/null +++ b/alpha-emulator/aistat.s @@ -0,0 +1,316 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid. Any changes made to it will be lost. */ + + + +/* Structure PROCESSORSTATE */ +PROCESSORSTATE_TRANSPARE3 = -1440 +PROCESSORSTATE_TRANSPARE2 = -1432 +PROCESSORSTATE_TRANSPARE1 = -1424 +PROCESSORSTATE_CARCDRSUBROUTINE = -1416 +PROCESSORSTATE_CDRSUBROUTINE = -1408 +PROCESSORSTATE_CARSUBROUTINE = -1400 +PROCESSORSTATE_LINKAGE = -1392 +PROCESSORSTATE_RESUMEEMA = -1384 +PROCESSORSTATE_STATISTICS = -1376 +PROCESSORSTATE_TRACE_HOOK = -1368 +PROCESSORSTATE_INSTRUCTION_COUNT = -1360 +PROCESSORSTATE_LONG_PAD0 = -1352 +PROCESSORSTATE_ASRR9 = -1344 +PROCESSORSTATE_ASRR10 = -1336 +PROCESSORSTATE_ASRR11 = -1328 +PROCESSORSTATE_ASRR12 = -1320 +PROCESSORSTATE_ASRR13 = -1312 +PROCESSORSTATE_ASRR14 = -1304 +PROCESSORSTATE_ASRR15 = -1296 +PROCESSORSTATE_LONG_PAD1 = -1288 +PROCESSORSTATE_ASRR26 = -1280 +PROCESSORSTATE_ASRR27 = -1272 +PROCESSORSTATE_ASRR29 = -1264 +PROCESSORSTATE_ASRR30 = -1256 +PROCESSORSTATE_ASRF2 = -1248 +PROCESSORSTATE_ASRF3 = -1240 +PROCESSORSTATE_ASRF4 = -1232 +PROCESSORSTATE_ASRF5 = -1224 +PROCESSORSTATE_ASRF6 = -1216 +PROCESSORSTATE_ASRF7 = -1208 +PROCESSORSTATE_ASRF8 = -1200 +PROCESSORSTATE_ASRF9 = -1192 +PROCESSORSTATE_METERDATABUFF = -1184 +PROCESSORSTATE_METERPOS = -1176 +PROCESSORSTATE_METERMAX = -1172 +PROCESSORSTATE_METERFREQ = -1168 +PROCESSORSTATE_METERMASK = -1164 +PROCESSORSTATE_METERVALUE = -1160 +PROCESSORSTATE_METERCOUNT = -1156 +PROCESSORSTATE_CHOICEPTR = -1152 +PROCESSORSTATE_SSTKCHOICEPTR = -1144 +PROCESSORSTATE_DBCBASE = -1136 +PROCESSORSTATE_DBCMASK = -1128 +PROCESSORSTATE_COPROCESSORREADHOOK = -1120 +PROCESSORSTATE_COPROCESSORWRITEHOOK = -1112 +PROCESSORSTATE_FLUSHCACHES_HOOK = -1104 +PROCESSORSTATE_I_STAGE_ERROR_HOOK = -1096 +PROCESSORSTATE_SFP1 = -1088 +PROCESSORSTATE_FP0 = -1080 +PROCESSORSTATE_FP1 = -1072 +PROCESSORSTATE_FLOATING_EXCEPTION = -1064 +PROCESSORSTATE_ALUANDROTATECONTROL = -1056 +PROCESSORSTATE_ROTATELATCH = -1048 +PROCESSORSTATE_ALUBORROW = -1040 +PROCESSORSTATE_ALUOVERFLOW = -1032 +PROCESSORSTATE_ALULESSTHAN = -1024 +PROCESSORSTATE_ALUOP = -1016 +PROCESSORSTATE_BYTEROTATE = -1008 +PROCESSORSTATE_BYTESIZE = -1000 +PROCESSORSTATE_BINDINGSTACKLIMIT = -992 +PROCESSORSTATE_BINDINGSTACKPOINTER = -984 +PROCESSORSTATE_CATCHBLOCK = -976 +PROCESSORSTATE_EXTRAANDCATCH = -968 +PROCESSORSTATE_MSCLOCKCACHE = -960 +PROCESSORSTATE_MSCMULTIPLIER = -952 +PROCESSORSTATE_PREVIOUSRCPP = -944 +PROCESSORSTATE_RLINK = -936 +PROCESSORSTATE_INTERRUPTREG = -928 +PROCESSORSTATE_ZONEOLDSPACE = -924 +PROCESSORSTATE_EPHEMERALOLDSPACE = -920 +PROCESSORSTATE_INT_PAD0 = -916 +PROCESSORSTATE_EQNOTEQL = -912 +PROCESSORSTATE_LCLENGTH = -904 +PROCESSORSTATE_SCLENGTH = -900 +PROCESSORSTATE_LCAREA = -896 +PROCESSORSTATE_LCADDRESS = -888 +PROCESSORSTATE_SCAREA = -880 +PROCESSORSTATE_SCADDRESS = -872 +PROCESSORSTATE_RESTARTSP = -864 +PROCESSORSTATE_STOP_INTERPRETER = -856 +PROCESSORSTATE_IMMEDIATE_ARG = -848 +PROCESSORSTATE_CONTINUATIONCP = -840 +PROCESSORSTATE_CONTINUATION = -832 +PROCESSORSTATE_CONTROL = -824 +PROCESSORSTATE_NILADDRESS = -816 +PROCESSORSTATE_TADDRESS = -808 +PROCESSORSTATE_BAR0 = -800 +PROCESSORSTATE_BAR1 = -792 +PROCESSORSTATE_BAR2 = -784 +PROCESSORSTATE_BAR3 = -776 +PROCESSORSTATE_EPC = -768 +PROCESSORSTATE_FP = -760 +PROCESSORSTATE_LP = -752 +PROCESSORSTATE_SP = -744 +PROCESSORSTATE_CP = -736 +PROCESSORSTATE_FCCRMASK = -728 +PROCESSORSTATE_CSLIMIT = -720 +PROCESSORSTATE_CSEXTRALIMIT = -716 +PROCESSORSTATE_TRAPMETERDATA = -712 +PROCESSORSTATE_FEPMODETRAPVECADDRESS = -704 +PROCESSORSTATE_TRAPVECBASE = -696 +PROCESSORSTATE_TVI = -688 +PROCESSORSTATE_FCCRTRAPMASK = -680 +PROCESSORSTATE_PTRTYPE = -672 +PROCESSORSTATE_VMATTRIBUTETABLE = -664 +PROCESSORSTATE_VMA = -656 +PROCESSORSTATE_MOSTNEGATIVEFIXNUM = -648 +PROCESSORSTATE_ICACHEBASE = -640 +PROCESSORSTATE_ENDICACHE = -632 +PROCESSORSTATE_FULLWORDDISPATCH = -624 +PROCESSORSTATE_HALFWORDDISPATCH = -616 +PROCESSORSTATE_AREVENTCOUNT = -608 +PROCESSORSTATE_STACKCACHESIZE = -600 +PROCESSORSTATE_STACKCACHETOPVMA = -592 +PROCESSORSTATE_CDRCODEMASK = -584 +PROCESSORSTATE_STACKCACHEDATA = -576 +PROCESSORSTATE_STACKCACHEBASEVMA = -568 +PROCESSORSTATE_SCOVLIMIT = -560 +PROCESSORSTATE_SCOVDUMPCOUNT = -556 +PROCESSORSTATE_MOSTPOSITIVEFIXNUM = -552 +PROCESSORSTATE_INTERNALREGISTERREAD1 = -544 +PROCESSORSTATE_INTERNALREGISTERREAD2 = -536 +PROCESSORSTATE_INTERNALREGISTERWRITE1 = -528 +PROCESSORSTATE_INTERNALREGISTERWRITE2 = -520 +PROCESSORSTATE_DATAREAD_MASK = -512 +PROCESSORSTATE_DATAREAD = -504 +PROCESSORSTATE_DATAWRITE_MASK = -496 +PROCESSORSTATE_DATAWRITE = -488 +PROCESSORSTATE_BINDREAD_MASK = -480 +PROCESSORSTATE_BINDREAD = -472 +PROCESSORSTATE_BINDWRITE_MASK = -464 +PROCESSORSTATE_BINDWRITE = -456 +PROCESSORSTATE_BINDREADNOMONITOR_MASK = -448 +PROCESSORSTATE_BINDREADNOMONITOR = -440 +PROCESSORSTATE_BINDWRITENOMONITOR_MASK = -432 +PROCESSORSTATE_BINDWRITENOMONITOR = -424 +PROCESSORSTATE_HEADER_MASK = -416 +PROCESSORSTATE_HEADER = -408 +PROCESSORSTATE_STRUCTUREOFFSET_MASK = -400 +PROCESSORSTATE_STRUCTUREOFFSET = -392 +PROCESSORSTATE_SCAVENGE_MASK = -384 +PROCESSORSTATE_SCAVENGE = -376 +PROCESSORSTATE_CDR_MASK = -368 +PROCESSORSTATE_CDR = -360 +PROCESSORSTATE_GCCOPY_MASK = -352 +PROCESSORSTATE_GCCOPY = -344 +PROCESSORSTATE_RAW_MASK = -336 +PROCESSORSTATE_RAW = -328 +PROCESSORSTATE_RAWTRANSLATE_MASK = -320 +PROCESSORSTATE_RAWTRANSLATE = -312 +PROCESSORSTATE_PLEASE_STOP = -304 +PROCESSORSTATE_PLEASE_TRAP = -300 +PROCESSORSTATE_RUNNINGP = -296 +PROCESSORSTATE_AC0ARRAY = -288 +PROCESSORSTATE_AC0ARWORD = -280 +PROCESSORSTATE_AC0LOCAT = -272 +PROCESSORSTATE_AC0LENGTH = -264 +PROCESSORSTATE_AC1ARRAY = -256 +PROCESSORSTATE_AC1ARWORD = -248 +PROCESSORSTATE_AC1LOCAT = -240 +PROCESSORSTATE_AC1LENGTH = -232 +PROCESSORSTATE_AC2ARRAY = -224 +PROCESSORSTATE_AC2ARWORD = -216 +PROCESSORSTATE_AC2LOCAT = -208 +PROCESSORSTATE_AC2LENGTH = -200 +PROCESSORSTATE_AC3ARRAY = -192 +PROCESSORSTATE_AC3ARWORD = -184 +PROCESSORSTATE_AC3LOCAT = -176 +PROCESSORSTATE_AC3LENGTH = -168 +PROCESSORSTATE_AC4ARRAY = -160 +PROCESSORSTATE_AC4ARWORD = -152 +PROCESSORSTATE_AC4LOCAT = -144 +PROCESSORSTATE_AC4LENGTH = -136 +PROCESSORSTATE_AC5ARRAY = -128 +PROCESSORSTATE_AC5ARWORD = -120 +PROCESSORSTATE_AC5LOCAT = -112 +PROCESSORSTATE_AC5LENGTH = -104 +PROCESSORSTATE_AC6ARRAY = -96 +PROCESSORSTATE_AC6ARWORD = -88 +PROCESSORSTATE_AC6LOCAT = -80 +PROCESSORSTATE_AC6LENGTH = -72 +PROCESSORSTATE_AC7ARRAY = -64 +PROCESSORSTATE_AC7ARWORD = -56 +PROCESSORSTATE_AC7LOCAT = -48 +PROCESSORSTATE_AC7LENGTH = -40 +PROCESSORSTATE_TMCURRENTTRANSACTION = -32 +PROCESSORSTATE_TMWRITESTART = -28 +PROCESSORSTATE_TMWRITECURRENT = -24 +PROCESSORSTATE_TMWRITELIMIT = -20 +PROCESSORSTATE_TMRECORDINGREADS = -16 +PROCESSORSTATE_TMREADSTART = -12 +PROCESSORSTATE_TMREADCURRENT = -8 +PROCESSORSTATE_TMREADLIMIT = -4 + +PROCESSORSTATESIZE = 0x5A0 + + +/* Structure CACHELINE */ +CACHELINE_ANNOTATION = 0 +CACHELINE_NEXTPCDATA = 8 +CACHELINE_NEXTPCTAG = 12 +CACHELINE_NEXTCP = 16 +CACHELINE_INSTRUCTION = 24 +CACHELINE_OPERAND = 28 +CACHELINE_PCDATA = 32 +CACHELINE_PCTAG = 36 +CACHELINE_CODE = 40 + +CACHELINESIZE = 0x30 + +CacheLineBits = 0x12 + +CacheLineMask = 0x3FFFF + +CacheLineRShift = 0x10 + +CacheLineLShift = 0x6 + +CacheLineFillAmount = 0x14 + + +/* Structure ARRAYCACHE */ +ARRAYCACHE_ARRAY = 0 +ARRAYCACHE_ARWORD = 8 +ARRAYCACHE_LOCAT = 16 +ARRAYCACHE_LENGTH = 24 + +AutoArrayRegMask = 0xE0 + +AutoArrayRegSize = 0x20 + +AutoArrayRegShift = 0x0 + +MSclockUnitsToMSShift = 0x18 + +MSclockUnitsPerMicrosecond = 0x1000000 + +StackCacheSize = 0x700 + +StackMaxFrameSize = 0x80 + +StackCacheMargin = 0x80 + +StackCacheDumpQuantum = 0x380 + +IvoryMemoryData = 0x23 + +IvoryMemoryTag = 0x21 + + +/* Structure SAVEDREGISTERS */ +SAVEDREGISTERS_R9 = 0 +SAVEDREGISTERS_R10 = 8 +SAVEDREGISTERS_R11 = 16 +SAVEDREGISTERS_R12 = 24 +SAVEDREGISTERS_R13 = 32 +SAVEDREGISTERS_R14 = 40 +SAVEDREGISTERS_R15 = 48 +SAVEDREGISTERS_R29 = 56 +SAVEDREGISTERS_F2 = 64 +SAVEDREGISTERS_F3 = 72 +SAVEDREGISTERS_F4 = 80 +SAVEDREGISTERS_F5 = 88 +SAVEDREGISTERS_F6 = 96 +SAVEDREGISTERS_F7 = 104 +SAVEDREGISTERS_F8 = 112 +SAVEDREGISTERS_F9 = 120 + +SAVEDREGISTERSSIZE = 0x80 + + +/* Structure TRACEDATA */ +TRACEDATA_N_ENTRIES = 0 +TRACEDATA_RECORDING_P = 8 +TRACEDATA_WRAP_P = 12 +TRACEDATA_START_PC = 16 +TRACEDATA_STOP_PC = 24 +TRACEDATA_RECORDS_START = 32 +TRACEDATA_RECORDS_END = 40 +TRACEDATA_CURRENT_ENTRY = 48 +TRACEDATA_PRINTER = 56 + +TRACEDATASIZE = 0x40 + + +/* Structure TRACERECORD */ +TRACERECORD_COUNTER = 0 +TRACERECORD_EPC = 8 +TRACERECORD_TOS = 16 +TRACERECORD_SP = 24 +TRACERECORD_INSTRUCTION = 32 +TRACERECORD_INSTRUCTION_DATA = 40 +TRACERECORD_OPERAND = 48 +TRACERECORD_TRAP_P = 52 +TRACERECORD_TRAP_DATA_0 = 56 +TRACERECORD_TRAP_DATA_1 = 64 +TRACERECORD_TRAP_DATA_2 = 72 +TRACERECORD_TRAP_DATA_3 = 80 +TRACERECORD_CATCH_BLOCK_P = 88 +TRACERECORD_INT_PAD0 = 92 +TRACERECORD_CATCH_BLOCK_0 = 96 +TRACERECORD_CATCH_BLOCK_1 = 104 +TRACERECORD_CATCH_BLOCK_2 = 112 +TRACERECORD_CATCH_BLOCK_3 = 120 + +TRACERECORDSIZE = 0x80 + +CacheMeterPwr = 0xE + +CacheMeterDefaultFreq = 0x3E8 diff --git a/alpha-emulator/aistat.sid b/alpha-emulator/aistat.sid new file mode 100644 index 0000000..5a053fb --- /dev/null +++ b/alpha-emulator/aistat.sid @@ -0,0 +1,428 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;;; The processor state object is the big daddy. It acts like a data segment +;;; for the interpreter. It constantly resides in a register, and provides +;;; direct addressing to its components. Everything that the interpreter +;;; needs can be found here. Note: this object should not be grown larger +;;; than 64 K bytes or 4K 64 bit words. + +;;; Note well! All of these slots are grouped in units of four "related" +;;; longwords to minimize Alpha dcache thrashing. Do *not* add or remove +;;; anything from these 4-longword groups. Instead, use a pad slot, or +;;; create a new 4-longword group. + +;;; This structure is indexed "backwards" from the Ivory register in +;;; assembly code (c.f., the :base-pointer slot which clues in the dsdl +;;; processor to emit proper offsets) and Lisp tagspace is indexed +;;; forwards from Ivory + +(define-structure (processorstate) + + ;; *** DO NOT REORDER THE FOLLOWING SLOTS *** + (:unsigned-long transpare3) + (:unsigned-long transpare2) + (:unsigned-long transpare1) + (:unsigned-long carcdrsubroutine) + + (:unsigned-long cdrsubroutine) + (:unsigned-long carsubroutine) + (:unsigned-long linkage) + (:unsigned-long resumeema) ;resume procedure address. + ;; *** END OF DO NOT REORDER *** + + (:pointer statistics) ; Instruction usage statistics + (:pointer trace-hook) ; function called to do instruction tracing + (:signed-long instruction-count) ; number of instructions executed so far. + (:unsigned-long long-pad0) + + (:unsigned-long asrr9) + (:unsigned-long asrr10) + (:unsigned-long asrr11) + (:unsigned-long asrr12) + + (:unsigned-long asrr13) + (:unsigned-long asrr14) + (:unsigned-long asrr15) + (:unsigned-long long-pad1) + + (:unsigned-long asrr26) + (:unsigned-long asrr27) + (:unsigned-long asrr29) + (:unsigned-long asrr30) + + ;; The floating point registers + (:unsigned-long asrf2) + (:unsigned-long asrf3) + (:unsigned-long asrf4) + (:unsigned-long asrf5) + + (:unsigned-long asrf6) + (:unsigned-long asrf7) + (:unsigned-long asrf8) + (:unsigned-long asrf9) + + ;; The following is a control block for cache miss metering. + ;; They can be removed when this facility is no longer required. + (:pointer meterdatabuff) ; the buffer that contains meter data. + (:unsigned-int meterpos) ; the place where the next data item goes. + (:unsigned-int metermax) ; the highest value ever recorded. + (:unsigned-int meterfreq) ; sample size. + (:unsigned-int metermask) ; mask for wrap + (:unsigned-int metervalue) ; current number of misses. + (:unsigned-int metercount) ; number remaining + + (:unsigned-long choiceptr) ; the choice pointer + (:unsigned-long sstkchoiceptr) ; the structure stack choice pointer + (:unsigned-long dbcbase) ; dynamic binding cache base + (:unsigned-long dbcmask) ; dynamic binding cache mask + + (:pointer coprocessorreadhook) ; function called to do coprocessor read + (:pointer coprocessorwritehook) ; function called to do coprocessor write + (:pointer flushcaches-hook) ; function called to flush I/D caches + (:pointer i-stage-error-hook) ; function called to generate an I-STAGE-ERROR + + (:unsigned-long sfp1) + (:unsigned-long fp0) + (:unsigned-long fp1) + (:unsigned-long floating-exception) + + ;; ALU support + (:unsigned-long aluandrotatecontrol) + (:unsigned-long rotatelatch) + (:unsigned-long aluborrow) + (:unsigned-long aluoverflow) + + (:unsigned-long alulessthan) + (:unsigned-long aluop) + (:unsigned-long byterotate) + (:unsigned-long bytesize) + + (:signed-long bindingstacklimit) ; binding stack limit + (:signed-long bindingstackpointer) ; binding stack pointer + (:unsigned-long catchblock) ; the catch block + (:unsigned-long extraandcatch) ; 1_8 + 1_26 + + (:unsigned-long msclockcache) ; Microsecond Clock cache + (:unsigned-long mscmultiplier) ; microsecond clock multiplier + (:unsigned-long previousrcpp) + (:pointer rlink) ; return address. + + (:unsigned-int interruptreg) ; the interrupt register, set only by the interpreter + (:unsigned-int zoneoldspace) ; the zone oldspace register + (:unsigned-int ephemeraloldspace) ; the ephemeral oldspace register + (:unsigned-int int-pad0) + (:unsigned-long eqnoteql) ; bit mask for types for which EQ is not EQL + (:unsigned-int lclength) ; list cache length + (:unsigned-int sclength) ; structure cache length + + (:unsigned-long lcarea) ; the list cache area + (:unsigned-long lcaddress) ; the list cache + (:unsigned-long scarea) ; the structure cache area + (:unsigned-long scaddress) ; the structure cache + + (:unsigned-long restartsp) + (:unsigned-long stop-interpreter) + (:unsigned-long immediate-arg) ; temp storage for immediates + (:unsigned-long continuationcp) ; cp of continuation (or zero) + + (:signed-long continuation) + (:signed-long control) + (:signed-long niladdress) + (:signed-long taddress) + + ;; The four BARs must be adjacent! + (:signed-long bar0) + (:signed-long bar1) + (:signed-long bar2) + (:signed-long bar3) + + (:signed-long epc) + (:signed-long fp) + (:signed-long lp) + (:signed-long sp) + + (:pointer cp) + (:unsigned-long fccrmask) ; finish call CR mask + (:unsigned-int cslimit) ; control stack limit + (:unsigned-int csextralimit) ; control stack extra limit + (:pointer trapmeterdata) ; the buffer containing trap meter data + + (:unsigned-long fepmodetrapvecaddress) + (:unsigned-long trapvecbase) + (:unsigned-long tvi) ; non-zero if the previous instruction trapped + (:unsigned-long fccrtrapmask) ; like fccrmask, but with trace bits, too + + (:pointer ptrtype) ; PTRTYPE[datatype] non-zero if it's a pointer + (:pointer vmattributetable) ; pointer to the VMAttributeTable from memory.c + (:unsigned-long vma) + (:signed-long mostnegativefixnum) ; - 1_31 + + (:pointer icachebase) ; the icache object. + (:pointer endicache) ; past the end of the icache object. + (:unsigned-long fullworddispatch) ; Fullword instruction dispatch table. + (:unsigned-long halfworddispatch) ; Halfword instruction dispatch table. + + (:signed-long areventcount) ; array register event count + (:unsigned-long stackcachesize) ; stack cache size + (:unsigned-long stackcachetopvma) ; highest address in stack cache + 1 + (:unsigned-long cdrcodemask) ; #xC00000000 + + (:pointer stackcachedata) ; storage used as the stack cache + (:unsigned-long stackcachebasevma) ; lowest address in stack cache + (:unsigned-int scovlimit) ; stack cache overflow limit + (:unsigned-int scovdumpcount) ; temporary while dumping stack cache + (:signed-long mostpositivefixnum) ; 1_31 - 1 + + ;; Dispatch tables for reading and writing internal registers + (:unsigned-long internalregisterread1) + (:unsigned-long internalregisterread2) + (:unsigned-long internalregisterwrite1) + (:unsigned-long internalregisterwrite2) + + ;; Memory Action Tables + (:unsigned-long dataread-mask) + (:pointer dataread) + (:unsigned-long datawrite-mask) + (:pointer datawrite) + + (:unsigned-long bindread-mask) + (:pointer bindread) + (:unsigned-long bindwrite-mask) + (:pointer bindwrite) + + (:unsigned-long bindreadnomonitor-mask) + (:pointer bindreadnomonitor) + (:unsigned-long bindwritenomonitor-mask) + (:pointer bindwritenomonitor) + + (:unsigned-long header-mask) + (:pointer header) + (:unsigned-long structureoffset-mask) + (:pointer structureoffset) + + (:unsigned-long scavenge-mask) + (:pointer scavenge) + (:unsigned-long cdr-mask) + (:pointer cdr) + + (:unsigned-long gccopy-mask) + (:pointer gccopy) + (:unsigned-long raw-mask) + (:pointer raw) + + (:unsigned-long rawtranslate-mask) + (:pointer rawtranslate) + ;; Magic bits: + ;; The following two longwords must be contiguous and aligned on a quadword boundary. + ;; The first is set only by the Spy and the second is set only by Life Support. + ;; Both are cleared only by the interpreter. + (:signed-int please-stop) ; request interpreter to halt if nonzero. + (:signed-int please-trap) ; request interpreter to trap if nonzero. + (:signed-long runningp) ; non-zero if running, zero if stopped. + + (:unsigned-long ac0array) ; the automatic array register 0 + (:unsigned-long ac0arword) + (:unsigned-long ac0locat) + (:unsigned-long ac0length) + + (:unsigned-long ac1array) ; the automatic array register 1 + (:unsigned-long ac1arword) + (:unsigned-long ac1locat) + (:unsigned-long ac1length) + + (:unsigned-long ac2array) ; the automatic array register 2 + (:unsigned-long ac2arword) + (:unsigned-long ac2locat) + (:unsigned-long ac2length) + + (:unsigned-long ac3array) ; the automatic array register 3 + (:unsigned-long ac3arword) + (:unsigned-long ac3locat) + (:unsigned-long ac3length) + + (:unsigned-long ac4array) ; the automatic array register 4 + (:unsigned-long ac4arword) + (:unsigned-long ac4locat) + (:unsigned-long ac4length) + + (:unsigned-long ac5array) ; the automatic array register 5 + (:unsigned-long ac5arword) + (:unsigned-long ac5locat) + (:unsigned-long ac5length) + + (:unsigned-long ac6array) ; the automatic array register 6 + (:unsigned-long ac6arword) + (:unsigned-long ac6locat) + (:unsigned-long ac6length) + + (:unsigned-long ac7array) ; the automatic array register 7 + (:unsigned-long ac7arword) + (:unsigned-long ac7locat) + (:unsigned-long ac7length) + + ;;transactional memory state + (:unsigned-int tmcurrenttransaction) ; current transaction id (0 means none) + (:unsigned-int tmwritestart) ; write buffer start + (:unsigned-int tmwritecurrent) ; write buffer next + (:unsigned-int tmwritelimit) ; write buffer can't write limit + (:unsigned-int tmrecordingreads) ; whether current transaction records reads (0 means not) + (:unsigned-int tmreadstart) ; read buffer start + (:unsigned-int tmreadcurrent) ; read buffer next + (:unsigned-int tmreadlimit) ; read buffer can't write limit + + :base-pointer ; Ivory register points here + (:size size)) ; the fixed size + + +;; The fields in a cacheline are carefully organized so that they are +;; fetched in ascending order in the NextInstruction loop +(define-structure (cacheline) + ;; The annotation field is used for branch-taken prediction and + ;; metering. In the branch-taken case, it will be fetched instead of + ;; NEXTPC/NEXTCP, so we put it here to start a fill (even though we + ;; then have to skip 2 quadwords). + (:unsigned-long annotation) ; serves multiple purposes + + ;; NEXTPCDATA/NEXTPCTAG and NEXTCP get used together, in that order. + ;; Even though these are not octaword-aligned, we expect cachelines + ;; for NextInstruction to typically already be loaded. + (:unsigned-int nextpcdata) ; the Ivory data for the next PC + (:unsigned-int nextpctag) ; the Ivory tag for the next PC + (:pointer nextcp) ; the cache entry for the next PC + + ;; PCDATA/PCTAG, INSTRUCTION/OPERAND, and CODE get used together, in + ;; that order (and after NEXTPC and NEXTCP) + + ;; Nota Bene: For full-word instructions, the operand and instruction + ;; fields are concatenated, so that the "pointer" field of the + ;; instruction can be stored as an unsigned long, that is the + ;; full-word operand. For packed instructions, the instruction field + ;; contains the "pointer" (needed by entry and spare ops) and the + ;; operand field contains the extracted operand. + (:unsigned-int instruction) ; the actual instruction for this PC + (:unsigned-int operand) ; the decoded operand + (:unsigned-int pcdata) ; the Ivory data for this PC + (:unsigned-int pctag) ; the Ivory tag for this PC + (:pointer code) ; pointer to emulator routine + + (:size size)) + +(define-values (|CacheLine| :parameter) + (|Bits| 18) ; Number of bits in cache mask + (|Mask| #.(1- (ash 1 18))) ; Mask for computing cache address. + (|RShift| 16) ; Shift to the right + (|LShift| 6) ; Shift to the left + ;; Must be <= (ash 1 LShift) and <= 1 vm page + ;; 10 == (floor Prefetch-size cacheline-size) + (|FillAmount| 20)) ; was 10 for 8k cache + + +(define-structure (arraycache) + (:unsigned-long array) + (:unsigned-long arword) + (:unsigned-long locat) + (:unsigned-long length)) + +(define-values (|AutoArrayReg| :parameter) + (|Mask| #xE0) + (|Size| 32) + (|Shift| 0)) + + +(define-values (|MSclock| :parameter) + (|UnitsToMSShift| 24) + (|UnitsPerMicrosecond| 16777216)) + + +;; Stack cache sized to not conflict with processor state in data cache. +;; State is aligned to top of cache and is < 2048 bytes, so stack cache +;; is (8192 - 2048)/8 slots +(define-values (|Stack| :parameter) + (|CacheSize| 1792) ;768 if 8k + (|MaxFrameSize| 128) ;128 + ;; Must be >= frame size + (|CacheMargin| 128) ;128 + ;; Must be >= 2 * cache margin, so that scrolling will clear overflow + ;; condition; and <= cache-size - (maxframe + 2*margin), so that + ;; scrolling does not scroll current frame out of stack. + (|CacheDumpQuantum| 896) ; 384 if 8K -- pr I found a horrible bug in how this is used in the code (stackcacheoverflowhandler) should be fixed+++ + ) + + +;;; These values represent the shift required to get the base address of ivory +;;; emulated memory. The data being at 1< (length registers) (length register-store)))) + `((decache-ivory-state) ;save the interpreter registers + ,@(loop for rts in registers + for pts in register-store + collect `(STQ ,rts ,pts (ivory))) + (restoreregisters t) ;restore C world registers + ,@body + (restoreregisters t) ;restore C world registers as though we entered again + ,@(loop for rts in registers + for pts in register-store + collect `(LDQ ,rts ,pts (ivory))) + (cache-ivory-state) ;restore the interpreter state + ))) + +(defmacro load-constant (reg constant &optional comment) + #+Genera (check-type constant fixnum) + #-Genera (check-type constant (integer #.(- (expt 2 31)) #.(1- (expt 2 31)))) + (let* ((low (dpb constant (byte 16 0) (- (ldb (byte 1 15) constant)))) + (high (sys:%32-bit-difference constant low))) + (assert (zerop (ldb (byte 16 0) high)) () + "Don't know how to load ~D" constant) + `(,@(cond + ((zerop constant) + `((BIS zero zero ,reg))) + ((zerop high) + `((LDA ,reg ,low (zero)))) + ((zerop low) + `((LDAH ,reg ,(ash high -16) (zero)))) + (t + `((LDA ,reg ,low (zero)) + (LDAH ,reg ,(ash high -16) (,reg))))) + ,@(unless (= constant (+ high low)) + `((EXTLL ,reg 0 ,reg)))) + )) + +;;; fin. + + + diff --git a/alpha-emulator/fcallmac.lisp b/alpha-emulator/fcallmac.lisp new file mode 100644 index 0000000..69e20fd --- /dev/null +++ b/alpha-emulator/fcallmac.lisp @@ -0,0 +1,695 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +(defmacro set-continuation2 (ctag cdata &optional comment) + `((STL ,ctag |PROCESSORSTATE_CONTINUATION+4| (ivory) ,@(if comment `(,comment))) + (STL ,cdata PROCESSORSTATE_CONTINUATION (ivory)))) + +(defmacro set-continuation2r (ctag cdata &optional comment) + `((STL ,cdata PROCESSORSTATE_CONTINUATION (ivory)) + (STL ,ctag |PROCESSORSTATE_CONTINUATION+4| (ivory) ,@(if comment `(,comment))))) + +(defmacro get-continuation2 (ctag cdata &optional comment) + `((LDL ,cdata PROCESSORSTATE_CONTINUATION (ivory)) + (LDL ,ctag |PROCESSORSTATE_CONTINUATION+4| (ivory) ,@(if comment `(,comment))) + (EXTLL ,cdata 0 ,cdata))) + +(defmacro set-continuation (cont &optional comment) + `((STQ ,cont PROCESSORSTATE_CONTINUATION (ivory) ,@(if comment `(,comment))))) + +(defmacro get-continuation (cont &optional comment) + `((LDQ ,cont PROCESSORSTATE_CONTINUATION (ivory) ,@(if comment `(,comment))))) + +(defmacro get-control-register (cont &optional comment) + `((LDL ,cont PROCESSORSTATE_CONTROL (ivory) ,@(if comment `(,comment))))) + +(defmacro set-control-register (cont &optional comment) + `((STL ,cont PROCESSORSTATE_CONTROL (ivory) ,@(if comment `(,comment))))) + +;;; Support macros for Function Calling/Frame manipulation. + +;;; Support macros for Function Calling/Frame manipulation. + +(defmacro push-frame (temp temp2 temp3 temp4 temp5 &optional etag edata) + (if (lisp:and etag edata) + (check-temporaries (etag edata) (temp temp2 temp3 temp4)) + (check-temporaries () (temp temp2 temp3 temp4))) + `((LDL ,temp2 PROCESSORSTATE_CONTINUATION+4 (ivory)) + (ADDQ iSP 16 iSP "prepare to push continuation/control register") + (LDL ,temp PROCESSORSTATE_CONTROL (ivory)) + (BIS zero |TypeFixnum+0xC0| ,temp5) + (LDL ,temp3 PROCESSORSTATE_CONTINUATION (ivory)) + (load-constant ,temp4 #.1_22 "cr.call-started") + (BIS ,temp2 #xC0 ,temp2 "Set CDR code 3") + (stack-write2-disp iSP -8 ,temp2 ,temp3 "push continuation") + (BIS ,temp ,temp4 ,temp3 "Set call started bit in CR") + (load-constant ,temp4 #.1_8 "cr.extra-argument") + (stack-write2 iSP ,temp5 ,temp "Push control register") + ,@(if etag + `((BIS ,temp3 ,temp4 ,temp3 "Set the extra arg bit") + (stack-push2 ,etag ,edata ,temp "Push the extra arg.")) + `((BIC ,temp3 ,temp4 ,temp3 "Clear the extra arg bit"))) + (STL ,temp3 PROCESSORSTATE_CONTROL (ivory) "Save control with new state") + (comment "End of push-frame"))) + +;; This, and all of the start-call macros, don't return +(defmacro start-call-dispatch (tag data extra-tag extra-data indirect temp temp2 temp3 temp6 temp7 temp8 temp9 startcallcompiledlabel startcallindirectlabel) + "Smashes tag and data, which is okay, since it never returns. + Startcallcompiledlabel is a label that can be branched to once tag and + data are set to even or odd pc, and extra-tag/extra-data set if + appropriate (there are no memory-reads in that branch, so + with-multiple-memory-reads need not be set up to go there. + Startcallindirectlabel is a label that can be branched to once + indirect (the address to fetch through) and and extra-tag/extra-data + are set up (extra-tag = 0 => none). This path does need + with-multiple-memory-reads set up." + (check-temporaries (tag data extra-tag extra-data indirect) (temp temp2 temp3 temp6 temp7 temp8 temp9)) + ;; The various flavors of start-call are all expanded in-line here, so + ;; that there are only two "tails" for the cases of pushing a frame + ;; with and without an extra argument + (let ((interp (gensym)) + (notpc (gensym)) + (again (gensym)) + (call (gensym)) + (call-extra (gensym)) + (push-extra (gensym)) + (hardway (gensym))) + `((label ,again) + ;; Constant shared by several branches + (LDQ ,temp PROCESSORSTATE_TRAPVECBASE (ivory)) + (type-dispatch ,tag ,temp2 ,temp3 + (|TypeCompiledFunction| + (label ,call) + (BIS zero zero ,extra-tag "No extra argument") + (label ,call-extra) + (BIS zero |TypeEvenPC| ,tag) + (label ,startcallcompiledlabel) + ;; (start-call-compiled |TypeEvenPC| tag data temp3 temp8 temp9 temp6 temp7) + (push-frame ,temp3 ,temp8 ,temp9 ,temp6 ,temp7) + (GetNextPCandCP) + (set-continuation2r ,tag ,data) + (STQ zero PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (BNE ,extra-tag ,push-extra) + (ContinueToNextInstruction-NoStall) + (label ,push-extra) + (LDL ,temp PROCESSORSTATE_CONTROL (ivory)) + (load-constant ,temp2 #.1_8 "cr.extra-argument") + (stack-push2 ,extra-tag ,extra-data ,temp3 "Push the extra arg.") + (BIS ,temp ,temp2 ,temp "Set the extra arg bit") + (STL ,temp PROCESSORSTATE_CONTROL (Ivory) "Save control with new state") + (ContinueToNextInstruction-NoStall)) + (|TypeGenericFunction| + ;; Build the constant PC for generic dispatch + (BIS ,tag zero ,extra-tag) + (EXTLL ,data 0 ,extra-data) + (LDA ,data #.sys:%generic-dispatch-trap-vector ,temp) + (BR zero ,call-extra)) + (|TypeInstance| + ;; Build the constant PC for message dispatch + (BIS ,tag zero ,extra-tag) + (EXTLL ,data 0 ,extra-data) + (LDA ,data #.sys:%message-dispatch-trap-vector ,temp) + (BR zero ,call-extra)) + (|TypeSymbol| + ;; We don't know what might be in the function-cell of a + ;; symbol, so do the full dispatch + (EXTLL ,data 0 ,data) + (BIS zero zero ,extra-tag "No extra argument") + (ADDQ ,data 2 ,indirect "Get to the function cell") + (BR zero ,startcallindirectlabel)) + (|TypeLexicalClosure| + ;; (start-call-lexical-closure tag data interp extra-data extra-tag temp2 temp temp6 temp7 temp8 temp9 indirect) + (EXTLL ,data 0 ,indirect) + #+ignore + ( + ;;Most lexicals are stack-consed, we assume no funny types in them + (VMAtoSCAmaybe ,indirect ,temp6 ,hardway ,temp7 ,temp8) + (stack-read2 ,temp6 ,extra-tag ,extra-data) + (stack-read2-disp ,temp6 8 ,tag ,data) + (CheckDataType ,tag |TypeCompiledFunction| ,again ,temp6) + (BR zero ,call-extra) + (label ,hardway)) + (memory-read ,indirect ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp7 ,temp8 ,temp9 nil t) + (BIS ,tag zero ,extra-tag) + (BIS ,data zero ,extra-data) + (ADDQ ,indirect 1 ,indirect) + (label ,startcallindirectlabel) + (memory-read ,indirect ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp7 ,temp8 ,temp9 nil t) + (CheckDataType ,tag |TypeCompiledFunction| ,again ,temp6) + (BR zero ,call-extra)) + (:else + (label ,interp) + ;; (start-call-escape tag data notpc temp temp2 temp3 extra-tag extra-data temp6 temp7 temp8) + (BIS ,tag zero ,extra-tag) + (BIS ,data zero ,extra-data) + (LDA ,temp3 #.sys:%interpreter-function-vector ,temp) + (TagType ,tag ,tag) + (ADDQ ,tag ,temp3 ,indirect) + (memory-read ,indirect ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp7 ,temp8 ,temp9 nil t) + ;; There aren't any odd ones, so we just disallow them! + (CheckAdjacentDataTypes ,tag |TypeEvenPC| 1 ,notpc ,temp3) + (BR zero ,call-extra))) + (label ,notpc) + ;; Blech! we "know" the VMA will be in temp (from start-call-escape) + (illegal-operand interpreter-table-contents-not-pc ,temp "Bad type for start-call")))) + +(defmacro start-call-compiled (impctag ctag cdata temp temp2 temp3 temp4 temp5 &optional etag edata) + (if (lisp:and etag edata) + (check-temporaries (ctag cdata etag edata) (temp temp2 temp3 temp4 temp5)) + (check-temporaries (ctag cdata) (temp temp2 temp3 temp4 temp5))) + `((push-frame ,temp ,temp2 ,temp3 ,temp4 ,temp5 ,etag ,edata) + (GetNextPCandCP) + (BIS zero ,impctag ,ctag) + (set-continuation2r ,ctag ,cdata) + (ContinueToNextInstruction-NoStall))) + +(defmacro start-call-lexical-closure + (tag data interp temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9) + (check-temporaries (tag data) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9)) + `((memory-read ,data ,temp2 ,temp PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8) + (ADDQ ,data 1 ,temp9) + (memory-read ,temp9 ,temp4 ,temp3 PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,temp4 |TypeCompiledFunction| ,interp ,temp5) + (push-frame ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 ,temp2 ,temp) + (GetNextPCandCP) + (BIS zero |TypeEvenPC| ,temp4) + (set-continuation2 ,temp4 ,temp3) + (ContinueToNextInstruction-NoStall))) + +(defmacro start-call-escape (tag data notpc temp temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (check-temporaries (tag data) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + `((LDQ ,temp2 PROCESSORSTATE_TRAPVECBASE (ivory)) + (LDA ,temp #.sys:%interpreter-function-vector ,temp2) + (TagType ,tag ,tag) + (ADDQ ,tag ,temp ,temp) + (memory-read ,temp ,temp4 ,temp3 PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckAdjacentDataTypes ,temp4 |TypeEvenPC| 2 ,notpc ,temp5) + (push-frame ,temp5 ,temp6 ,temp7 ,temp8 ,temp ,tag ,data) + (GetNextPCandCP) + (set-continuation2 ,temp4 ,temp3) + (ContinueToNextInstruction-NoStall))) + +;;; Support for finish-call + +;;; nargs is the number of args (args+apply+1)*8! +;;; disp is a register containing the two bit disposition. +;;; applyp really has this instruction's opcode, from which we extract the apply bit +(defmacro finish-call-guts (nargs disp applyp cr nfp temp temp2 temp3 temp4 temp5) + (check-temporaries (nargs disp applyp cr nfp 'arg2) (temp temp2 temp3 temp4 temp5)) + (let () + `((SRL ,applyp #.(- 10 3) ,applyp) + (stack-cache-overflow-check ,temp ,temp2 ,temp3 ,temp4 ,temp5) + (AND ,applyp 8 ,applyp "0 if not apply, 8 if apply") + (get-control-register ,cr "Get the control register") + (comment "Compute the new LP") + (LDA iLP 8 (iSP) "Assume not Apply case.") + (SUBQ iLP ,applyp iLP "For apply, iLP==iSP") + (comment "Compute the new FP") + (SRL ,cr 5 ,temp "extra arg bit<<3") + (SUBQ iSP ,nargs ,nfp) + (AND ,temp 8 ,temp "8 if extra arg, 0 otherwise.") + (SUBQ ,nfp ,temp ,nfp "This! is the new frame pointer!") + (comment "compute arg size") + (SUBQ iLP ,nfp ,temp2) + (SRL ,temp2 3 ,temp2 "arg size in words.") + (comment "compute caller frame size.") + (SUBQ ,nfp iFP ,temp3) + (SRL ,temp3 3 ,temp3 "caller frame size in words.") + (comment "Now hack the control register!") + (SLL ,disp 18 ,temp5 "Get value disposition into place") + (LDQ ,temp4 PROCESSORSTATE_FCCRMASK (ivory) "cr.caller-frame-size") + (SLL ,temp3 9 ,temp3 "Shift caller frame size into place") + (BIS ,temp5 ,temp2 ,temp5 "Add arg size to new bits.") + (SLL ,applyp 14 ,temp2 "Apply bit in place") + (BIS ,temp3 ,temp5 ,temp5 "Add frame size to new bits") + (BIS ,temp2 ,temp5 ,temp5 "All new bits assembled!") + (comment "Set the return continuation.") + (LDQ ,temp3 CACHELINE_NEXTPCDATA (iCP) "Next instruction hw format") + (AND ,cr ,temp4 ,cr "Mask off unwanted bits") + ;; inline (get-continuation2 temp temp2 "Get the new PC tag/data") + (LDL ,temp2 PROCESSORSTATE_CONTINUATION (Ivory) "Get the new PC tag/data") + (BIS ,cr ,temp5 ,cr "Add argsize, apply, disposition, caller FS") + (LDL ,temp PROCESSORSTATE_CONTINUATION+4 (Ivory)) + (comment "Update the PC") + (convert-pc-to-continuation ,temp3 ,temp4 ,temp5) + (EXTLL ,temp2 0 ,temp2) + (convert-continuation-to-pc ,temp ,temp2 iPC) + (set-continuation2r ,temp4 ,temp5 "Set return address") + (comment "Update CP") + (load-constant ,temp5 #.1_28 "cr.call-trace") + (LDQ ,temp3 CACHELINE_NEXTCP (iCP)) + (AND ,temp5 ,cr ,temp5) + (SRL ,temp5 1 ,temp5 "Shift into trace pending place") + (STQ ,temp3 PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (BIS ,cr ,temp5 ,cr "Set the cr.trace pending if appropriate.") + (set-control-register ,cr "Set the control register") + (BIS ,nfp zero iFP "Install the new frame pointer") + (LDQ arg2 CACHELINE_ANNOTATION (iCP)) + (stack-overflow-check ,cr nil ,temp ,temp2) ;destroys ,CR + (BNE arg2 InterpretInstructionPredicted) + (comment "Begin execution at the computed address") + (ContinueToInterpretInstruction-ValidateCache)))) + +(defmacro b-apply-argument-supplied (suppt temp temp2 temp3 &optional cr) + (if cr + (check-temporaries (cr) (temp temp2 temp3)) + (check-temporaries () (temp temp2 temp3))) + (let ((apply (gensym)) + (done (gensym))) + ;; If you are going to pull args, you are on the slow path + (push `((label ,apply) + (AND ,temp3 #x3F ,temp3) + (SUBQ ,temp3 |TypeNIL| ,temp3) + (BNE ,temp3 ,suppt "J. if apply args supplied not nil.") + (AND ,temp2 1 ,temp2 "keep just the apply bit!") + (SLL ,temp2 17 ,temp2 "reposition the apply bit") + (SUBQ iSP 8 iSP "Pop off the null applied arg.") + (BIC ,(or cr temp) ,temp2 ,(or cr temp) "Blast the apply arg bit away") + (set-control-register ,(or cr temp) "Reset the stored cr bit") + (BR zero ,done)) + *function-epilogue*) + `(,@(unless cr + `((get-control-register ,temp "Get the control register"))) + (SRL ,(or cr temp) 17 ,temp2) + (stack-read-tag iSP ,temp3 "Get the tag of the stack top.") + (force-alignment) + (BLBS ,temp2 ,apply "J. if apply args") + (unlikely-label ,done) + ))) + +;;; INDEX is an entry with an entry index in it. +;;; Branches back to the instruction interpreter when done. +(defmacro enter-function (index temp temp2) + (check-temporaries (index) (temp temp2)) + `((comment "Compute entry position and advance PC/CP accordingly.") + (LDQ iPC CACHELINE_NEXTPCDATA (iCP) "get the next PC") + (SLL ,index 1 ,temp "Adjust index to halfword") + (LDQ iCP CACHELINE_NEXTCP (iCP)) + (BEQ ,index InterpretInstruction "J. if index zero, no adjustment.") + (ADDQ iPC ,temp iPC "Compute the new address") + (BIC iPC 1 iPC "Make it an DTP-EVEN-PC") + (BR zero InterpretInstructionForJump))) + +;;; Branches back to the instruction interpreter when done. +(defmacro push-apply-args (min max temp temp2 temp3 &optional cr) + (if cr + (check-temporaries (min max cr) (temp temp2 temp3)) + (check-temporaries (min max) (temp temp2 temp3))) + (let ((l1 (gensym)) + (ent (gensym))) + `((stack-set-cdr-code iSP 1 ,temp) ;cdr-nil + (b-apply-argument-supplied ,l1 ,temp ,temp2 ,temp3 ,cr) + (S8ADDQ ,max iFP ,temp) + (SCAtoVMA ,temp ,temp2 ,temp3) + (stack-push-ir |TypeList| ,temp2 ,temp) + (BR zero ,ent) + (label ,l1) + (SUBQ iSP 8 ,temp) + (stack-set-cdr-code ,temp 2 ,temp3) ;cdr-normal + (S8ADDQ ,max iFP ,temp) + (SCAtoVMA ,temp ,temp2 ,temp3) + (stack-push-ir |TypeList| ,temp2 ,temp) + (ADDQ iLP 8 iLP) + ,@(unless cr + `((get-control-register ,temp3 "Get the control register"))) + (ADDQ ,(or cr temp3) 1 ,(or cr temp3)) + (set-control-register ,(or cr temp3)) + (label ,ent) + (SUBQ ,max ,min ,temp) + (ADDQ ,temp 1 ,temp) + (enter-function ,temp ,temp2 ,temp3)))) + +(defmacro note-additional-spread-args (n cr temp &optional turn-off-apply) + (if (numberp n) + (check-temporaries (cr) (temp)) + (check-temporaries (n cr) (temp))) + `((get-control-register ,cr) + (AND ,cr #xFF ,temp "Get current arg size.") + (BIC ,cr #xFF ,cr) + (ADDQ ,temp ,n ,temp) + (ADDQ ,temp ,cr ,cr "Update the arg size") + ,@(when turn-off-apply + `((load-constant ,temp #.1_17 "cr.apply") + (BIC ,cr ,temp ,cr "turn off cr.apply"))) + (set-control-register ,cr))) + +(defmacro pull-apply-args (n tag data done-label + temp temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (check-temporaries (n tag data) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + (let ((done (or done-label (gensym))) + (notincache (gensym))) + `((stack-top2 ,tag ,data) + (type-dispatch ,tag ,temp ,temp2 + (|TypeList| + (VMAtoSCAMaybe ,data ,temp ,notincache ,temp2 ,temp3) + (pull-apply-args-quickly + ,n ,temp ,done ,temp2 ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8)) + (|TypeNIL| + (get-control-register ,temp3 "Get the control register") + (load-constant ,temp4 #.1_17 "cr.apply") + (SUBQ iSP 8 iSP "Discard that silly nil") + (BIC ,temp3 ,temp4 ,temp3 "Blast away the apply arg bit.") + (set-control-register ,temp3) + ,@(when done-label + `((BR zero ,done-label)))) + (:else + ;; Pull-apply has no illegal operands, always takes exception + (BIS zero ,n arg1 "Pull apply args trap needs nargs in ARG1") + (external-branch |PULLAPPLYARGSTRAP|) + (label ,notincache) + (BIS zero ,n arg1) + (external-branch |PullApplyArgsSlowly|))) + ;; At this point, PROCESSORSTATE_RESTARTSP does *not* reflect the + ;; real state of iSP. If you have any code that can fault after + ;; calling this, you better store iSP! See VERIFY-GENERIC-ARITY, e.g. + ,@(unless done-label + `((label ,done)))))) + +;; Number of args in NARGS, rest arg is on top of stack +;; The idea is that we pull a single argument, update the state of the world, +;; and then re-execute the same instruction. +(defmacro pull-apply-args-quickly (n rest done-label + temp temp2 temp3 temp4 temp5 temp6 temp7) + "Expects rest-arg has been popped and its SCA is rest" + (check-temporaries (n rest) (temp temp2 temp3 temp4 temp5 temp6 temp7)) + (let ((top (gensym)) + (done (or done-label (gensym))) + (endloop (gensym)) + (notincache (gensym)) + (ranout (gensym)) + (maybedone (gensym)) + (loopentry (gensym)) + ;; readability + (count temp3) + (argtag temp4) + (argdata temp5) + ;; could share with argxxx + (listtag temp6) + (listdata temp7)) + `((BIS zero zero ,count) + (stack-cache-overflow-check ,temp ,temp2 ,temp4 ,temp6 ,temp7 iSP ,n) + (SUBQ iSP 8 iSP "Pop Stack.") + (BR zero ,loopentry) + (label ,top) + (stack-read2 ,rest ,argtag ,argdata) + ;; Assume we'll push this + (ADDQ ,count 1 ,count) + (ADDQ ,rest 8 ,rest) + (cdr-code-dispatch ,argtag ,temp ,temp2 + (|CdrNext| + (stack-push2 ,argtag ,argdata ,temp) + ;; Fast case, test and branch back + (CMPEQ ,count ,n ,temp) + (branch-false ,temp ,top) + (BR zero ,endloop)) + (|CdrNil| + (stack-push2 ,argtag ,argdata ,temp) + (label ,ranout) + ;; Turn off apply + (note-additional-spread-args ,count ,temp ,temp2 t) + (S8ADDQ ,count iLP iLP) + (BR zero ,done)) + (|CdrNormal| + (stack-push2 ,argtag ,argdata ,temp) + (stack-read2 ,rest ,listtag ,listdata) + (type-dispatch ,listtag ,temp ,temp2 + (|TypeList| + (VMAtoSCAmaybe ,listdata ,rest ,notincache ,temp ,temp2) + (BR zero ,loopentry)) + (|TypeNIL| + (BR zero ,ranout)) + (:else + (label ,notincache) + (stack-push2 ,listtag ,listdata ,temp) + (BR zero ,maybedone)))) + (:else + (SUBQ ,count 1 ,count) ;didn't push + (SUBQ ,rest 8 ,rest) + (BR zero ,endloop))) + (unlikely-label ,loopentry) + (CMPEQ ,count ,n ,temp) + (branch-false ,temp ,top) + (label ,endloop) + (comment "Here if count=n, or bad cdr") + (SCAtoVMA ,rest ,argdata ,temp) + (stack-push-ir |TypeList| ,argdata ,temp) + (label ,maybedone) + (note-additional-spread-args ,count ,temp ,temp2) + (S8ADDQ ,count iLP iLP) + (SUBQ ,n ,count arg1) ;exception handler wants ARG1 = args to pull + ;; If we're going to lose, we might as well do it via the slow arg + ;; puller, because we'll either manage to pull an argument more quickly + ;; than we would if we trapped or end up in the debugger, in which case + ;; the slight slowdown is of no consequence. + ,@(if done-label + `((BLE arg1 ,done) + (external-branch |PullApplyArgsSlowly|)) + `((BGT arg1 |PullApplyArgsSlowly|) + (label ,done)))))) + +;; Handle the case where we are pulling a cdr-coded rest arg entirely from +;; the stack cache. The idea is to pull a single argument, push it onto +;; the stack, replace the new rest arg on the stack, fix up the control +;; register, and then restart the instruction. +(defmacro pull-apply-args-slowly (nargs cr atag adata rtag rdata + temp temp2 temp3 temp4 temp5 temp6) + `((stack-top2 ,atag ,adata "Get the rest arg") + ;; Get the arg to push in atag/adata, and the new rest arg in rtag/rdata. + ;; Any exception doing this forces a pull-apply-args trap + (carcdr-internal ,atag ,adata ,rtag ,rdata + ((BIS zero ,nargs arg1) ;really need to trap now + (external-branch |PULLAPPLYARGSTRAP|)) + ,temp2 ,temp3 ,temp4 ,temp5 ,temp6) + ;; Push the new spread arg on the stack and update the rest arg. + ;; It's OK if we push null rest arg, because restarting the + ;; instruction will clean it up in a moment) + (stack-write2 iSP ,atag ,adata "Push the pulled argument") + (stack-push2 ,rtag ,rdata ,temp "Push the new rest arg") + ;; Note the single new spread arg and restart the instruction + ;; We don't need to fix up PROCESSORSTATE_RESTARTSP because we are + ;; about to go to InterpretInstruction anyway... + (note-additional-spread-args 1 ,cr ,temp2) + (ADDQ iLP 8 iLP) + (ContinueToInterpretInstruction))) + +(defmacro cleanup-frame (cr done-label + temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (check-temporaries (cr) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12)) + (let ((reallydone (or done-label (gensym))) + (done (gensym)) + (almostdone (gensym)) + (top (gensym)) + (more (gensym)) + (cfuwp 'HANDLEUNWINDPROTECT) + (cfdbt 'DBUNWINDFRAMETRAP)) + `( + (label ,top) + (load-constant ,temp #.1_26 "cr.cleanup-catch") + (LDL ,temp4 PROCESSORSTATE_CATCHBLOCK (ivory)) + (EXTLL ,temp4 0 ,temp4) + (AND ,temp ,cr ,temp2) + (BEQ ,temp2 ,almostdone "J. if cr.cleanup-catch is 0") + (VMAtoSCA ,temp4 ,temp3 ,temp2) + (stack-read2-disp ,temp3 16 ,temp5 ,temp6) ;temp5=cb-cleanup, temp6=cb-previous + (stack-read2-disp ,temp3 8 ,temp ,temp2) ;temp=tag temp2=binding-stack-level + (AND ,temp #x40 ,temp12) + (BNE ,temp12 ,cfuwp "J. if catch block is UWP variety.") + (load-constant ,temp3 #.1_26 "cr.cleanup-catch") + (AND ,temp5 #x40 ,temp2 "Extract the catchcleanup bit") + (SLL ,temp2 ,(- 26 6) ,temp2 "Shift into place for CR") + (BIC ,cr ,temp3 ,temp3) + (BIS ,temp3 ,temp2 ,cr) + (set-control-register ,cr) + (TagType ,temp5 ,temp5) + (SLL ,temp5 32 ,temp5) + (BIS ,temp6 ,temp5 ,temp6) + (STQ ,temp6 PROCESSORSTATE_CATCHBLOCK (ivory)) + (BR zero ,top) + (label ,almostdone) + (load-constant ,temp #.1_25 "cr.cleanup-bindings") + (AND ,temp ,cr ,temp2) + (LDQ ,temp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (BEQ ,temp2 ,done "J. if cr.cleanup-bindings is 0.") + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (SRL ,temp 32 ,temp4) + (CheckDataType ,temp4 |TypeLocative| ,cfdbt ,temp3) + (passthru "#endif") + (label ,more) + (unbind ,temp ,temp2 ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 ,temp10 ,temp11 ,temp12) + (get-control-register ,cr) + (load-constant ,temp #.1_25 "cr.cleanup-bindings") + (AND ,temp ,cr ,temp2) + (BNE ,temp2 ,more "J. if cr.cleanup-bindings is 0.") + ;; After we've unbound everything, check for a preempt request + (check-preempt-request nil ,temp2 ,temp3) + (label ,done) + (load-constant ,temp3 #.1_24 "cr.trap-on-exit-bit") + (AND ,temp3 ,cr ,temp2) + (BEQ ,temp2 ,reallydone) + (illegal-operand trap-on-exit zero) + +; (label ,cfuwp) +; (external-branch HANDLEUNWINDPROTECT "Tail call to handle UNWIND-PROTECT") +; +; (passthru "#ifdef MINIMA") +; (label ,cfdbt) +; (external-branch DBUNWINDFRAMETRAP "Tail call for deep-bound trap") +; (passthru "#endif") + + ,@(unless done-label + `((label ,reallydone)))))) + +;; This is branched to from cleanup-frame when an unwind-protect is +;; encountered. It does not need to be inlined, since the unwind +;; handler deals with retrying the instruction when it exits +(defmacro do-unwind-protect (cr temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (let ((pushpc (gensym)) + (restorebindings (gensym)) + (dupdbt 'DBUNWINDFRAMETRAP)) + `((LDL ,temp4 PROCESSORSTATE_CATCHBLOCK (ivory)) + (EXTLL ,temp4 0 ,temp4) + (VMAtoSCA ,temp4 ,temp3 ,temp2) + (stack-read2-disp ,temp3 16 ,temp5 ,temp6) ;temp5=cb-cleanup, temp6=cb-previous + (stack-read2-disp ,temp3 8 ,temp ,temp2) ;temp=tag temp2=binding-stack-level + (LDQ iSP PROCESSORSTATE_RESTARTSP (ivory) "Restore SP") + ;; Restore binding stack. temp2=bindingstacklevel + (LDQ ,temp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (passthru "#ifdef MINIMA") + (SRL ,temp 32 ,temp4) + (passthru "#endif") + (SUBL ,temp ,temp2 ,temp3) + (BEQ ,temp3 ,pushpc "J. if binding level= binding stack") + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (CheckDataType ,temp4 |TypeLocative| ,dupdbt ,temp3) + (passthru "#endif") + (label ,restorebindings) + (unbind ,temp ,cr ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 ,temp10 ,temp11 ,temp12) + (LDQ ,temp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (SUBL ,temp ,temp2 ,temp3) + (BNE ,temp3 ,restorebindings "J. if binding level/= binding stack") + ;; After we've unbound everything, check for a preempt request + (check-preempt-request ,pushpc ,temp2 ,temp3) + (label ,pushpc "Push PC with cleanup bits in CDR") + (convert-pc-to-continuation iPC ,temp3 ,temp ,temp2) + (get-control-register ,cr) + (SRL ,cr ,(- 23 6) ,temp2) + (BIS ,temp2 #x80 ,temp2) + (AND ,temp2 #xC0 ,temp2) + (TagType ,temp3 ,temp3) + (BIS ,temp3 ,temp2 ,temp3) + (stack-push2-with-cdr ,temp3 ,temp) + (comment "Load catch-block PC") + (LDL ,temp4 PROCESSORSTATE_CATCHBLOCK (ivory)) + (EXTLL ,temp4 0 ,temp4) + (VMAtoSCA ,temp4 ,temp3 ,temp2) + (stack-read2 ,temp3 ,temp5 ,temp6) ;catch block PC + (convert-continuation-to-pc ,temp5 ,temp6 iPC ,temp) + ;; set cleanup handling bit + (load-constant ,temp #.1_23 "cr.cleanup-in-progress") + (BIS ,cr ,temp ,cr) + (stack-read2-disp ,temp3 16 ,temp5 ,temp10) ;temp5 contains the bits in 38/39 + (AND ,temp5 #x80 ,temp6 "This is the extra-arg bit") + (LDL ,temp8 PROCESSORSTATE_EXTRAANDCATCH (ivory)) + (AND ,temp5 #x40 ,temp7 "This is the cleanup-catch bit") + (SLL ,temp6 ,(- 8 7) ,temp6 "Shift bit into place for cr") + (SLL ,temp7 ,(- 26 6) ,temp7 "Shift extra arg bit into place for cr") + (BIC ,cr ,temp8 ,cr) + (BIS ,temp6 ,temp7 ,temp6) + (BIS ,cr ,temp6 ,cr "update the bits extra-arg/cleanupcatch") + (set-control-register ,cr) + (tagType ,temp5 ,temp5) + (SLL ,temp5 32 ,temp5) + (BIS ,temp5 ,temp10 ,temp5) + (STQ ,temp5 PROCESSORSTATE_CATCHBLOCK (ivory)) + (ContinueToInterpretInstruction-ValidateCache "Execute cleanup") + (passthru "#ifdef MINIMA") + (label ,dupdbt) + (external-branch DBUNWINDFRAMETRAP "Tail call for deep-bound trap") + (passthru "#endif") + ))) + + +(defmacro abandon-frame-simple + (restorepctest cr cleanuplabel temp temp2 temp3 temp4 temp5 temp6 next-cp) + "If the pc is restored, you must go to InterpretInstructionForBranch to update the CP" + (check-temporaries (cr) (temp temp2 temp3 temp4 temp5 temp6 next-cp)) + (let ((afexc (gensym)) + (afgo (gensym)) + (norestore (gensym)) + (saved-control-data temp6)) + `((Comment "Restore machine state from frame header.") + ,@(let ((saved-continuation-tag temp2) + (saved-continuation-data temp3) + (continuation-tag temp4) + (continuation-data temp5)) + ;; Interleave: + ;; (get-continuation2 ,continuation-tag ,continuation-data) + ;; (stack-read-2 ,saved-continuation-tag ,saved-continuation-data) + ;; and check for cleanup + `((LDL ,saved-continuation-data 0 (iFP)) + (load-constant ,temp #.(* 7 1_24) "cleanup bits") + (LDL ,continuation-data PROCESSORSTATE_CONTINUATION (ivory)) + (AND ,cr ,temp ,temp "Mask") + (LDL ,saved-continuation-tag 4 (iFP)) + (BIS iCP zero ,next-cp) + (BNE ,temp ,cleanuplabel "Need to cleanup frame first") + (EXTLL ,saved-continuation-data 0 ,saved-continuation-data) + (LDL ,continuation-tag |PROCESSORSTATE_CONTINUATION+4| (ivory)) + (EXTLL ,continuation-data 0 ,continuation-data) + + (passthru "#ifdef IVERIFY") + (comment "check for instruction verification suite end-of-test") + (SUBL ,saved-continuation-tag |TypeNIL| ,saved-control-data "check for end of run") + (BEQ ,saved-control-data ,afexc) + (passthru "#endif") + + (stack-read-data-disp iFP 8 ,saved-control-data "Get saved control register" :signed t) + (TagType ,saved-continuation-tag ,saved-continuation-tag) + (comment "Restore the PC.") + ,@(when restorepctest + `(,@(cond ((atom restorepctest) `()) + ((eq (first restorepctest) 'not) + `((branch-false ,(second restorepctest) ,norestore))) + (t + `((branch-true ,(first restorepctest) ,norestore)))) + ;; inline (convert-continuation-to-pc continuation-tag + ;; continuation-data iPC temp) with load of continuationcp + (SLL ,continuation-data 1 iPC "Assume even PC") + (AND ,continuation-tag 1 ,temp) + (LDQ ,next-cp PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (ADDQ iPC ,temp iPC))) + (label ,norestore) + ;; (set-continuation2 ,saved-continuation-tag ,saved-continuation-data) + (comment "Restore the saved continuation") + (STL ,saved-continuation-tag |PROCESSORSTATE_CONTINUATION+4| (ivory)) + (SRL ,cr 9 ,temp "Get the caller frame size into place") ;+++ magic# + (STL ,saved-continuation-data PROCESSORSTATE_CONTINUATION (ivory)) + )) + (SUBQ iFP 8 iSP "Restore the stack pointer.") + (STQ zero PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (AND ,temp #xFF ,temp "Mask just the caller frame size.") + (S8ADDQ ,temp 0 ,temp "*8") + + (load-constant ,temp2 #.1_27 "cr.trace-pending") + (AND ,temp2 ,cr ,temp2) + (LDL ,temp3 PROCESSORSTATE_INTERRUPTREG (ivory) "Get the preempt-pending bit") + (BIS ,temp2 ,saved-control-data ,saved-control-data "Sticky trace pending bit.") + (LDQ ,temp4 PROCESSORSTATE_PLEASE_STOP (ivory) "Get the trap/suspend bits") + (SUBQ iFP ,temp iFP "Restore the frame pointer.") + (set-control-register ,saved-control-data "Restore the control register") + (AND ,saved-control-data #xFF ,temp "extract the argument size") + ;; Store OR of suspend, trap, and preempt-pending + (AND ,temp3 1 ,temp3) + (BIS ,temp4 ,temp3 ,temp3) + (STQ ,temp3 PROCESSORSTATE_STOP_INTERPRETER (ivory)) + (S8ADDQ ,temp iFP iLP "Restore the local pointer.") +; (passthru "#ifdef IVERIFY") +; (BR zero ,afgo) +; (label ,afexc) +; (halt-machine) +; (label ,afgo) +; (passthru "#endif") + ))) diff --git a/alpha-emulator/idispat.as b/alpha-emulator/idispat.as new file mode 100644 index 0000000..76a4b10 --- /dev/null +++ b/alpha-emulator/idispat.as @@ -0,0 +1,348 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(comment "This file implements the main instruction dispatch loop.") + +(include-header "kludges.s") ;+++ this will be unnecessary at some time + +(define-procedure |DummyDoNothingSubroutine| () + (BR zero continuecurrentinstruction)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Start of protected first page of cache. First class for frequent fliers ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(passthru ".globl NEXTINSTRUCTION") +(passthru ".globl INTERPRETINSTRUCTION") +(passthru ".globl ICACHEMISS") + + +;; Common memory subroutines --- here for lack of a better place. Only +;; the tails of these routines are used, and pretty rarely + +(define-memory-subroutine |MemoryReadData| + (arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-memory-subroutine |MemoryReadGeneral| + (arg2 arg5 arg6 arg3 t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-memory-subroutine |MemoryReadHeader| + (arg2 arg5 arg6 PROCESSORSTATE_HEADER t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-memory-subroutine |MemoryReadCdr| + (arg2 arg5 arg6 PROCESSORSTATE_CDR t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(align4k) ;starting at an arbitrary 4k boundary. + +;; Nota Bene: CACHELINE_INSTRUCTION/CACHELINE_OPERAND have a much more +;; complicated organization than you might think. For Full-word +;; instructions, CACHELINE_INSTRUCTION holds the instruction with the +;; cdr stripped (as a Quadword), for use by push-constant. For packed +;; instructions, CACHELINE_INSTRUCTION holds the instruction for +;; dispatching within instructions on opcode; and CACHELINE_OPERAND +;; holds the unsigned 10-bit operand in it's low word and a +;; sign-extended version in its high word. This whole mish-mash is +;; loaded into ARG3 by nextInstruction, with appropriate bits loaded out +;; by the various instruction entries. + +;; NB: T1 through T9, ARG5, and ARG6 are aliased to other register names +;; here, so don't use them for anything! +(define-procedure |DoICacheFill| () + ;; Here from an escape, hence we must recompute iCP according to the + ;; real PC. Also, sometimes cache-miss is because we tried to + ;; execute escape, so... + #+iCacheMiss-after-iInterpret (label TakeICacheMiss) + (label ICacheMiss) + (comment "Here when instruction cache miss detected. Fill the cache from") + (comment "PC and then resume interpreter loop") + (comment "First round the PC down to an even halfword address") + ;; Inlined call to (PC-TO-ICACHEENT epc ecp arg3 arg4) follows... + (LDQ arg2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (BIC iPC 1 epc "the even PC") + #-old-cache-hash (SRL epc |CacheLineRShift| ecp) + (load-constant arg1 #.|cacheline$K-mask|) + #-old-cache-hash (SLL ecp |CacheLineLShift| ecp) + (SRL iPC 1 instn "instn is instruction address here") + #-old-cache-hash (ADDQ epc ecp ecp) + #-old-cache-hash (AND ecp arg1 ecp) + #+old-cache-hash (AND epc arg1 ecp) + (SLL ecp 5 arg3 "temp=cpos*32") + (SLL ecp 4 ecp "cpos=cpos*16") + (ADDQ arg2 arg3 arg4 "temp2=base+cpos*32") + (ADDQ arg4 ecp ecp "cpos=base+cpos*48") + (BIS epc 1 opc "the odd PC") + (BIS ecp zero iCP "Assume iPC is the even PC") + (CMPEQ iPC opc arg1 "See if iPC is the odd PC") + ;; The odd PC's cache pointer immediately follows + (ADDQ ecp CACHELINESIZE ocp) + (CMOVNE arg1 ocp iCP "Stash the odd cache pointer if iPC is the odd PC") + (LDQ hwdispatch PROCESSORSTATE_HALFWORDDISPATCH (ivory)) + (load-constant hwopmask #x3FF "Halfword operand mask") + (LDQ fwdispatch PROCESSORSTATE_FULLWORDDISPATCH (ivory)) + (load-constant count #.|cacheline$K-fillamount|) + (VM-Read instn arg4 iword t10 t11 t) + (BR zero FillICachePrefetched) + + ;; These come before FillICache to get branch prediction right... + (label PCbackOne) + (comment "Wire in continuation for even half") + (STQ epc CACHELINE_NEXTPCDATA (ocp)) + (SUBQ ecp CACHELINESIZE t10 "Backup in cache too") + (STQ ecp CACHELINE_NEXTCP (ocp)) + (SUBQ epc 1 arg1 "Backup PC one halfword") + (STQ t10 CACHELINE_NEXTCP (ecp)) + (TagType arg4 arg4 "arg4=tag-cdr code") + (STQ arg1 CACHELINE_NEXTPCDATA (ecp)) + (comment "Wire in continuation for odd half") + (BR zero MaybeUnpack) + + (label PCadvOne) + (STQ opc CACHELINE_NEXTPCDATA (ecp) "Simple advance of PC one halfword.") + (ADDQ opc 1 arg1) + (STQ ocp CACHELINE_NEXTCP (ecp)) + (ADDQ ocp CACHELINESIZE t10) + (STQ arg1 CACHELINE_NEXTPCDATA (ocp)) + (TagType arg4 arg4 "arg4=tag-cdr code") + (STQ t10 CACHELINE_NEXTCP (ocp)) + (BR zero MaybeUnpack) + + (comment "This is the cache fill loop.") + (label FillICache) + (VM-Read instn arg4 iword t10 t11) + (label FillICachePrefetched) + (passthru "#ifdef CACHEMETERING") + (comment "Increment the fill count for both cache entries") + (LDL t10 CACHELINE_ANNOTATION (ecp)) + (LDL t11 CACHELINE_ANNOTATION (ocp)) + (EXTLL t10 0 t10) + (EXTLL t11 0 t11) + (ADDQ t10 1 t10) + (STL t10 CACHELINE_ANNOTATION (ecp)) + (ADDQ t11 1 t11) + (STL t11 CACHELINE_ANNOTATION (ocp)) + (passthru "#endif") + (STQ epc CACHELINE_PCDATA (ecp) "Set address of even cache posn.") + (AND arg4 #xC0 arg1 "CDR code << 6") + (TagType arg4 arg4 "Strip cdr") + (STQ opc CACHELINE_PCDATA (ocp) "Set address of odd cache posn.") + (EXTLL iword 0 iword "Strip nasty bits out.") + (force-alignment) + (SLL arg4 32 arg2 "ready to remerge") + (BEQ arg1 PCadvOne "Zerotag means advance one HW") + (SUBQ arg1 #x80 arg1 "2<<6") + (BEQ arg1 PCbackOne "Tag=2 means backup one HW") + (BLT arg1 PCendCF "Tag=1 means end of compiled function") + + (label PCadvTwo) + (comment "Tag=3 means advance over one full word") + (Comment "Wire in continuation for even half") + (ADDQ epc 2 arg1 "Next word") + (NOP) + (ADDQ ecp TWOCACHELINESIZE t10 "corresponding CP entry") + (STQ arg1 CACHELINE_NEXTPCDATA (ecp) "Next PC even of next word") + (ADDQ epc 4 arg1 "Skip one fullword") + (STQ t10 CACHELINE_NEXTCP (ecp) "Next CP") + (comment "Wire in continuation for odd half") + (ADDQ ecp FOURCACHELINESIZE t10 "corresponding CP entry") + (STQ arg1 CACHELINE_NEXTPCDATA (ocp)) + (TagType arg4 arg4 "arg4=tag-cdr code") + (STQ t10 CACHELINE_NEXTCP (ocp)) + (BR zero MaybeUnpack) + + ;; The feature FILL-PAST-CALL controls whether icache filling keeps + ;; going when it sees a FINISH-CALL instruction. + (label DecodePackedWord) + (comment "Here to decode a packed word") + (passthru "#ifdef CACHEMETERING") + (maybe-meter-miss t10 arg4 t12 t11 arg2 arg1) ; count the odd instruction. + (passthru "#endif") + (SRL iword 18 arg4 "arg4 contains the odd packedword") + (SRL iword 8 t10 "even opcode+2bits") + (STQ arg4 CACHELINE_INSTRUCTION (ocp) "Save the odd instruction") + (SLL iword #.(- 64 10) t11 "First phase of even operand sign extension.") + (AND iword hwopmask t12 "even operand+2bits") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + ;; Clear the annotation field (used for branch-taken cache) + (STQ zero CACHELINE_ANNOTATION (ocp)) + (passthru "#endif") + (AND t10 hwopmask t10 "even opcode") + (SRA t11 #.(- 64 10 16) t11 "Second phase of even operand sign extension.") + #-fill-past-call (SUBQ t10 #.I-LISP-COMPILER:*FINISH-CALL-N-OPCODE* arg2) + (S8ADDQ t10 hwdispatch t10) + (BIS t11 t12 t12 "Merge signed/unsigned even operand") + #-fill-past-call (BIC arg2 3 arg2) + (STL t12 CACHELINE_OPERAND (ecp)) + #-fill-past-call (CMOVEQ arg2 arg2 count "clear count if finish-call seen") + (SRL arg4 8 arg2 "odd opcode+2bits") + (SLL arg4 #.(- 64 10) t11 "First phase of odd operand sign extension.") + (AND arg4 hwopmask arg1 "odd operand+2bits") + (LDQ t10 0 (t10)) + (AND arg2 hwopmask arg2 "odd opcode") + (SRA t11 #.(- 64 10 16) t11 "Second phase of odd operand sign extension.") + (STQ t10 CACHELINE_CODE (ecp)) + #-fill-past-call (SUBQ arg2 #.I-LISP-COMPILER:*FINISH-CALL-N-OPCODE* t12) + (S8ADDQ arg2 hwdispatch arg2) + (BIS t11 arg1 arg1 "Merge signed/unsigned odd operand") + (STL arg1 CACHELINE_OPERAND (ocp)) + #-fill-past-call (BIC t12 3 t12) + (LDQ arg2 0 (arg2)) + #-fill-past-call (CMOVEQ t12 t12 count "clear count if finish-call seen") + (STQ arg2 CACHELINE_CODE (ocp)) + (BR zero EndDecode) + + (label MaybeUnpack) + ;; C.f., aistat.sid. We store the instruction as a Q, clobbering + ;; the overlapping operand field for full-word instructions. If + ;; this turns out to be packed instead, the operand field will get + ;; updated appropriately when we decode + (BIS arg2 iword iword "reassemble tag and word.") + (STQ iword CACHELINE_INSTRUCTION (ecp) "save the even instruction") + (SUBQ arg4 #o60 t10 "t10>=0 if packed") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + ;; Clear the annotation field (used for branch-taken cache) + (STQ zero CACHELINE_ANNOTATION (ecp)) + (passthru "#endif") + (passthru "#ifdef CACHEMETERING") + (maybe-meter-miss t11 t12 t10 arg1 arg2 epc) ; count the even instruction. + (passthru "#endif") + (BGE t10 DecodePackedWord "B. if a packed instruction") + (S8ADDQ arg4 fwdispatch t11 "t11 is the fwdispatch index") + (LDQ t12 PROCESSORSTATE_I_STAGE_ERROR_HOOK (ivory)) + #-fill-past-native (SUBQ arg4 #.|type$K-nativeinstruction| arg1) + (LDQ t11 0 (t11) "Extract the opcode handler") + (STQ t12 CACHELINE_CODE (ocp) "Store I-STATE-ERROR at odd pc") + #-fill-past-native (CMOVEQ arg1 arg1 count "clear count if native instn seen") + (STQ t11 CACHELINE_CODE (ecp)) + ;(BR zero EndDecode) + + (label EndDecode) + (comment "Here we decide if to stop filling the cache and return to the") + (comment "instruction interpretation stream, or whether to fill further") + (ADDQ instn 1 instn) + (BLE count cacheValid "If count is zero, resume") + (SLL instn 1 epc) + (SUBQ count 1 count "decrement count") + (BIS epc 1 opc) + (LDQ t10 PROCESSORSTATE_ENDICACHE (ivory) "pointer to the end of icache") + (ADDQ ocp TWOCACHELINESIZE ocp) + (ADDQ ecp TWOCACHELINESIZE ecp) + (SUBQ ocp t10 t10) + (BLE t10 FillICache "Still room for more") + (BR zero cacheValid) + + (label PCendCF) + (LDQ t11 PROCESSORSTATE_I_STAGE_ERROR_HOOK (ivory)) + (clr count "We reached the end of the fcn.") + (STQ t11 CACHELINE_CODE (ecp) "Store I-STATE-ERROR dispatch at even and odd pc") + (STQ t11 CACHELINE_CODE (ocp)) + (BR zero EndDecode) +) + + +(comment "These are the instruction reentry points. Instructions end by returning") +(comment "control to one of these tags. Most normal instructions reenter by jumping") +(comment "to NEXTINSTRUCTION, which advances the PC and continues normally. ") +(comment "Instructions that change the PC usually go directly to INTERPRETINSTRUCTION.") +(comment "Instructions that fail/trap/exception etc, go to one of the other places.") + +(define-procedure |iInterpret| (arg1 arg2) + (defineframe sp 1 r26) + + (saveregisters arg1) + (BIS arg1 zero ivory "Setup our processor object handle") + (comment "Upon entry, load cached state.") + (cache-ivory-state) + + (BNE iCP interpretinstruction "First time in iCP will be zero.") + (BR zero ICacheMiss "If this is the first time in cache is empty!") + + #+jump-prediction (label interpretInstructionForJump) + #+jump-prediction (LDQ arg2 CACHELINE_ANNOTATION (iCP)) + #+jump-prediction (BEQ arg2 interpretInstructionForBranch) + ;; Fall through to interpretInstructionPredicted... + + ;; This duplicates most of interpretInstruction, because it needs to + ;; verify the prediction and do things the hard way if the prediction + ;; is wrong, before smashing iCP (so the prediction can be fixed up) + (label interpretInstructionPredicted) + (LDQ t2 CACHELINE_PCDATA (arg2) "Get the PC to check cache hit.") + + ;; Don't bother resetting r30, we can't get here from a restart + (LDA arg1 0 (iFP) "Assume FP mode") + (LDQ R0 PROCESSORSTATE_STOP_INTERPRETER (ivory) "Have we been asked to stop?") + (LDA arg4 -8 (iSP) "SP-pop mode constant") + (LDQ arg3 CACHELINE_INSTRUCTION (arg2) "Grab the instruction/operand while stalled") + (SUBQ iPC t2 t1) + ;; On no match, recompute iCP before resorting to refilling cache + ;; (the assumption is that you have a mis-prediction in this case + (BNE t1 interpretInstructionForBranch) + (BIS arg2 zero iCP) + ;; Nota Bene: traporsuspendmachine must not smash any of the + ;; registers set up above: arg1, arg3, arg4, or t2, if it comes back + ;; to continuecurrentinstruction + (BNE R0 traporsuspendmachine "Stop the world! someone wants out.") + (FETCH 0 (arg2)) + (BR zero continuecurrentinstruction) + + #-jump-prediction (label interpretInstructionForJump) + + (label interpretInstructionForBranch) + ;; In effect, an inlined call to (PC-TO-iCACHEENT iPC iCP t4 t5) + (LDQ t5 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (load-constant t4 #.|cacheline$K-mask|) + ;; The next three are equivalent, but take one less stall + ;; #-old-cache-hash (SRL iPC |CacheLineRShift| arg2) + ;; #-old-cache-hash (SLL arg2 |CacheLineLShift| arg2) + #-old-cache-hash (SRL iPC #.(- |cacheline$K-rshift| |cacheline$K-lshift|) arg2) + #-old-cache-hash (load-constant t3 #.(dpb 0 (byte |cacheline$K-lshift| 0) -1)) + #-old-cache-hash (AND arg2 t3 arg2) + #-old-cache-hash (ADDQ iPC arg2 arg2) + #-old-cache-hash (AND arg2 t4 arg2) + #+old-cache-hash (AND iPC t4 arg2) + (SLL arg2 5 t4 "temp=cpos*32") + (SLL arg2 4 arg2 "cpos=cpos*16") + (ADDQ t5 t4 t5 "temp2=base+cpos*32") + (force-alignment) + (ADDQ t5 arg2 arg2 "cpos=base+cpos*48") + ;; We come here if the branch has previously cached the hash, with + ;; the arg2 in arg2 + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + ;; Save the computed branch-taken CP in ANNOTATION + (STQ arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + ;; See above (label interpretInstructionPredicted) + (FETCH 0 (arg2)) + (BIS arg2 zero iCP) + + (label interpretInstruction) + ;; If we come here from a restart, we flush any in-progress + ;; subroutine calls (pop the stack back) + (LDQ r30 PROCESSORSTATE_ASRR30 (ivory)) + (LDQ R0 PROCESSORSTATE_STOP_INTERPRETER (ivory) "Have we been asked to stop?") + (LDA arg1 0 (iFP) "Assume FP mode") + (LDQ arg3 CACHELINE_INSTRUCTION (iCP) "Grab the instruction/operand while stalled") + (LDA arg4 -8 (iSP) "SP-pop mode constant") + (LDQ t2 CACHELINE_PCDATA (iCP) "Get the PC to check cache hit.") + ;; Nota Bene: traporsuspendmachine must not smash any of the + ;; registers set up above: arg1, arg3, arg4, or t2, if it comes back + ;; to continuecurrentinstruction + (BNE R0 traporsuspendmachine "Stop the world! someone wants out.") + (BR zero continuecurrentinstruction) + + ) + +;;; nextInstruction moved to ifuncom1 to concatenate with DoPush, the +;;; most popular instruction + +;;; End of idispat + diff --git a/alpha-emulator/idispat.s b/alpha-emulator/idispat.s new file mode 100644 index 0000000..b04945f --- /dev/null +++ b/alpha-emulator/idispat.s @@ -0,0 +1,625 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/idispat.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* This file implements the main instruction dispatch loop. */ +#include "kludges.s" +.align 5 +.globl DummyDoNothingSubroutine +.ent DummyDoNothingSubroutine 0 +.align 3 +DummyDoNothingSubroutine: + br $31, CONTINUECURRENTINSTRUCTION # [1] +.end DummyDoNothingSubroutine +.globl NEXTINSTRUCTION +.globl INTERPRETINSTRUCTION +.globl ICACHEMISS +.align 5 +.globl MemoryReadData +.ent MemoryReadData 0 +.align 3 +MemoryReadData: + .frame $30, 0, $0 +/* Memory Read Internal */ +G13074: + addq $17, $14, $7 # [1-] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13076 # [1-] +G13075: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13078 # [0di] +G13084: + ret $31, ($0), 1 # [1] +.align 3 +MemoryReadDataDECODE: + beq $6, G13077 # [1] +.align 3 +G13076: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $21, 0($5) # [2] + ldl $20, 4($5) # Read from stack cache [1] + br $31, G13075 # [1] +.align 3 +G13078: + blbc $7, G13077 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13074 # [1-] +.align 3 +G13077: + ldq $8, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $7 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +.align 3 +G13081: + and $8, MemoryActionTransform, $7 # [3] + beq $7, G13080 # [1] + bic $20, 63, $20 # [1-] + bis $20, TypeExternalValueCellPointer, $20 # [1] + br $31, G13084 # [1-] +#ifndef MINIMA +G13080: +#endif +#ifdef MINIMA +.align 3 +G13080: + and $8, MemoryActionBinding, $7 # [1-] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G13079 # [1-] + sll $17, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $21, 4($6) # Fetch value [1] + subl $17, $5, $7 # Compare [2di] + bne $7, G13083 # Trap on miss [1] + extll $21, 0, $17 # Extract the pointer, and indirect [0di] + br $31, G13074 # This is another memory read tailcall. [1-] +.align 3 +G13083: + br $31, DBCACHEMISSTRAP +#endif +G13079: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.end MemoryReadData +.align 5 +.globl MemoryReadGeneral +.ent MemoryReadGeneral 0 +.align 3 +MemoryReadGeneral: + .frame $30, 0, $0 +/* Memory Read Internal */ +G13136: + addq $17, $14, $7 # [1] + s4addq $18, $31, $8 # Cycle-number -> table offset [1] + ldq_u $20, 0($7) # [1-] + s4addq $8, $14, $8 # [0di] + s4addq $7, $31, $21 # [1] + subq $17, $24, $5 # Stack cache offset [1] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($8) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [0di] + bne $6, G13138 # [1-] +G13137: + srl $8, $20, $8 # [1di] + extll $21, 0, $21 # [1] + blbs $8, G13140 # [1di] +G13146: + ret $31, ($0), 1 # [1] +.align 3 +MemoryReadGeneralDECODE: + beq $6, G13139 # [1] +.align 3 +G13138: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $21, 0($5) # [2] + ldl $20, 4($5) # Read from stack cache [1] + br $31, G13137 # [1] +.align 3 +G13140: +.align 3 +G13139: + s4addq $18, $31, $8 # Cycle-number -> table offset [1-] + s4addq $8, $14, $8 # [1] + ldq $8, PROCESSORSTATE_DATAREAD($8) # [2] +/* TagType. */ + and $20, 63, $7 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +.align 3 +G13144: + and $8, MemoryActionIndirect, $6 # [3] + beq $6, G13143 # [1] + extll $21, 0, $17 # Do the indirect thing [1-] + br $31, G13136 # [0di] +.align 3 +G13143: + and $8, MemoryActionTransform, $7 # [1-] + beq $7, G13142 # [1] + bic $20, 63, $20 # [1-] + bis $20, TypeExternalValueCellPointer, $20 # [1] + br $31, G13146 # [1-] +#ifndef MINIMA +G13142: +#endif +#ifdef MINIMA +.align 3 +G13142: + and $8, MemoryActionBinding, $7 # [1-] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G13141 # [1-] + sll $17, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $21, 4($6) # Fetch value [1] + subl $17, $5, $7 # Compare [2di] + bne $7, G13145 # Trap on miss [1] + extll $21, 0, $17 # Extract the pointer, and indirect [0di] + br $31, G13136 # This is another memory read tailcall. [1-] +.align 3 +G13145: + br $31, DBCACHEMISSTRAP +#endif +G13141: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, $18, $17 # [1] + br $31, PERFORMMEMORYACTION +.end MemoryReadGeneral +.align 5 +.globl MemoryReadHeader +.ent MemoryReadHeader 0 +.align 3 +MemoryReadHeader: + .frame $30, 0, $0 +/* Memory Read Internal */ +G13147: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13149 # [1-] +G13148: + lda $7, 64 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13151 # [0di] +G13155: + ret $31, ($0), 1 # [1] +.align 3 +MemoryReadHeaderDECODE: + beq $6, G13150 # [1] +.align 3 +G13149: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $21, 0($5) # [2] + ldl $20, 4($5) # Read from stack cache [1] + br $31, G13148 # [1] +.align 3 +G13151: + blbc $7, G13150 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13147 # [1-] +.align 3 +G13150: + ldq $8, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $7 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +G13152: +/* Perform memory action */ + bis $31, $8, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end MemoryReadHeader +.align 5 +.globl MemoryReadCdr +.ent MemoryReadCdr 0 +.align 3 +MemoryReadCdr: + .frame $30, 0, $0 +/* Memory Read Internal */ +G13156: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_CDR_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13158 # [1-] +G13157: + lda $7, 192 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13160 # [0di] +G13164: + ret $31, ($0), 1 # [1] +.align 3 +MemoryReadCdrDECODE: + beq $6, G13159 # [1] +.align 3 +G13158: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $21, 0($5) # [2] + ldl $20, 4($5) # Read from stack cache [1] + br $31, G13157 # [1] +.align 3 +G13160: + blbc $7, G13159 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13156 # [1-] +.align 3 +G13159: + ldq $8, PROCESSORSTATE_CDR($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $7 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +G13161: +/* Perform memory action */ + bis $31, $8, $16 # [3] + bis $31, 9, $17 # [1] + br $31, PERFORMMEMORYACTION +.end MemoryReadCdr +.align 12 +.align 5 +.globl DoICacheFill +.ent DoICacheFill 0 +.align 3 +DoICacheFill: +.align 3 +ICACHEMISS: +/* Here when instruction cache miss detected. Fill the cache from */ +/* PC and then resume interpreter loop */ +/* First round the PC down to an even halfword address */ + ldq $17, PROCESSORSTATE_ICACHEBASE($14) # get the base of the icache [1] + bic $9, 1, $6 # the even PC [0di] + srl $6, CacheLineRShift, $3 # [1] + lda $16, -1 # [1] + ldah $16, 4($16) # [1] + sll $3, CacheLineLShift, $3 # [1] + srl $9, 1, $1 # instn is instruction address here [1] + addq $6, $3, $3 # [1] + and $3, $16, $3 # [1] + sll $3, 5, $18 # temp=cpos*32 [1] + sll $3, 4, $3 # cpos=cpos*16 [1] + addq $17, $18, $19 # temp2=base+cpos*32 [1] + addq $19, $3, $3 # cpos=base+cpos*48 [1] + bis $6, 1, $7 # the odd PC [1] + bis $3, $31, $13 # Assume iPC is the even PC [1] + cmpeq $9, $7, $16 # See if iPC is the odd PC [1] + addq $3, CACHELINESIZE, $4 # [1] + cmovne $16, $4, $13 # Stash the odd cache pointer if iPC is the odd PC [1] + ldq $22, PROCESSORSTATE_HALFWORDDISPATCH($14) # [1-] + lda $20, 1023 # [0di] + ldq $21, PROCESSORSTATE_FULLWORDDISPATCH($14) # [1-] + lda $8, 20 # [0di] + addq $1, $14, $24 # [1] + s4addq $24, $31, $2 # [1] + fetch 0($24) # [1-] + ldq_u $19, 0($24) # [1] + fetch 0($2) # [1] + ldl $2, 0($2) # [1] + extbl $19, $24, $19 # [1-] + br $31, FILLICACHEPREFETCHED # [0di] +.align 3 +PCBACKONE: +/* Wire in continuation for even half */ + stq $6, CACHELINE_NEXTPCDATA($4) # [1] + subq $3, CACHELINESIZE, $23 # Backup in cache too [0di] + stq $3, CACHELINE_NEXTCP($4) # [1-] + subq $6, 1, $16 # Backup PC one halfword [0di] + stq $23, CACHELINE_NEXTCP($3) # [1-] +/* TagType. */ + and $19, 63, $19 # arg4=tag-cdr code [0di] + stq $16, CACHELINE_NEXTPCDATA($3) # [1-] +/* Wire in continuation for odd half */ + br $31, MAYBEUNPACK # [1] +.align 3 +PCADVONE: + stq $7, CACHELINE_NEXTPCDATA($3) # Simple advance of PC one halfword. [1] + addq $7, 1, $16 # [0di] + stq $4, CACHELINE_NEXTCP($3) # [1-] + addq $4, CACHELINESIZE, $23 # [0di] + stq $16, CACHELINE_NEXTPCDATA($4) # [1-] +/* TagType. */ + and $19, 63, $19 # arg4=tag-cdr code [0di] + stq $23, CACHELINE_NEXTCP($4) # [1-] + br $31, MAYBEUNPACK # [1] +/* This is the cache fill loop. */ +.align 3 +FILLICACHE: + addq $1, $14, $24 # [1-] + s4addq $24, $31, $2 # [1] + ldq_u $19, 0($24) # [1-] + ldl $2, 0($2) # [1] + extbl $19, $24, $19 # [2-] +.align 3 +FILLICACHEPREFETCHED: +#ifdef CACHEMETERING +/* Increment the fill count for both cache entries */ + ldl $23, CACHELINE_ANNOTATION($3) # [1-] + ldl $24, CACHELINE_ANNOTATION($4) # [1] + extll $23, 0, $23 # [2-] + extll $24, 0, $24 # [1] + addq $23, 1, $23 # [1] + stl $23, CACHELINE_ANNOTATION($3) # [0di] + addq $24, 1, $24 # [1-] + stl $24, CACHELINE_ANNOTATION($4) # [0di] +#endif + stq $6, CACHELINE_PCDATA($3) # Set address of even cache posn. [1] + and $19, 192, $16 # CDR code << 6 [0di] +/* TagType. */ + and $19, 63, $19 # Strip cdr [1] + stq $7, CACHELINE_PCDATA($4) # Set address of odd cache posn. [0di] + extll $2, 0, $2 # Strip nasty bits out. [1-] +.align 3 +G13165: + sll $19, 32, $17 # ready to remerge [1] + beq $16, PCADVONE # Zerotag means advance one HW [0di] + subq $16, 128, $16 # 2<<6 [1] + beq $16, PCBACKONE # Tag=2 means backup one HW [1] + blt $16, PCENDCF # Tag=1 means end of compiled function [1] +.align 3 +PCADVTWO: +/* Tag=3 means advance over one full word */ +/* Wire in continuation for even half */ + addq $6, 2, $16 # Next word [1] + bis $31, $31, $31 # [0] + addq $3, TWOCACHELINESIZE, $23 # corresponding CP entry [1] + stq $16, CACHELINE_NEXTPCDATA($3) # Next PC even of next word [0di] + addq $6, 4, $16 # Skip one fullword [1] + stq $23, CACHELINE_NEXTCP($3) # Next CP [0di] +/* Wire in continuation for odd half */ + addq $3, FOURCACHELINESIZE, $23 # corresponding CP entry [1] + stq $16, CACHELINE_NEXTPCDATA($4) # [0di] +/* TagType. */ + and $19, 63, $19 # arg4=tag-cdr code [1-] + stq $23, CACHELINE_NEXTCP($4) # [0di] + br $31, MAYBEUNPACK # [1] +.align 3 +DECODEPACKEDWORD: +/* Here to decode a packed word */ +#ifdef CACHEMETERING + ldl $16, PROCESSORSTATE_METERVALUE($14) # [1] + ldl $19, PROCESSORSTATE_METERCOUNT($14) # The number of remaining tokens. [1] + ldq $23, PROCESSORSTATE_METERDATABUFF($14) # The cache miss meter buffer. [1] + addq $16, 1, $16 # count the miss. [1di] + ldl $24, PROCESSORSTATE_METERPOS($14) # Position for new data. [1-] + stl $16, PROCESSORSTATE_METERVALUE($14) # [1] + bne $19, G13166 # [1] + ldl $17, PROCESSORSTATE_METERMASK($14) # [0di] + s4addq $24, $23, $23 # position of the current data item [1-] + addq $24, 1, $24 # [1] + and $24, $17, $24 # [1] + ldl $17, PROCESSORSTATE_METERMAX($14) # [1] + subq $16, $17, $25 # [3] + cmovgt $25, $16, $17 # [1] + stl $17, PROCESSORSTATE_METERMAX($14) # [1-] + stl $16, 0($23) # store the datapoint [1] + stl $24, PROCESSORSTATE_METERPOS($14) # Position for new data. [1] + stl $31, PROCESSORSTATE_METERVALUE($14) # [1] + ldl $19, PROCESSORSTATE_METERFREQ($14) # [1] +.align 3 +G13166: + stl $19, PROCESSORSTATE_METERCOUNT($14) # [1] +#endif + srl $2, 18, $19 # arg4 contains the odd packedword [1] + srl $2, 8, $23 # even opcode+2bits [1] + stq $19, CACHELINE_INSTRUCTION($4) # Save the odd instruction [0di] + sll $2, 54, $24 # First phase of even operand sign extension. [1-] + and $2, $20, $25 # even operand+2bits [1] +#ifndef CACHEMETERING + stq $31, CACHELINE_ANNOTATION($4) # [1-] +#endif + and $23, $20, $23 # even opcode [0di] + sra $24, 38, $24 # Second phase of even operand sign extension. [1] + subq $23, 92, $17 # [1] + s8addq $23, $22, $23 # [1] + bis $24, $25, $25 # Merge signed/unsigned even operand [1] + bic $17, 3, $17 # [1] + stl $25, CACHELINE_OPERAND($3) # [0di] + cmoveq $17, $17, $8 # clear count if finish-call seen [1-] + srl $19, 8, $17 # odd opcode+2bits [1] + sll $19, 54, $24 # First phase of odd operand sign extension. [1] + and $19, $20, $16 # odd operand+2bits [1] + ldq $23, 0($23) # [1-] + and $17, $20, $17 # odd opcode [0di] + sra $24, 38, $24 # Second phase of odd operand sign extension. [1] + stq $23, CACHELINE_CODE($3) # [0di] + subq $17, 92, $25 # [1-] + s8addq $17, $22, $17 # [1] + bis $24, $16, $16 # Merge signed/unsigned odd operand [1] + stl $16, CACHELINE_OPERAND($4) # [0di] + bic $25, 3, $25 # [1-] + ldq $17, 0($17) # [0di] + cmoveq $25, $25, $8 # clear count if finish-call seen [1-] + stq $17, CACHELINE_CODE($4) # [0di] + br $31, ENDDECODE # [1] +.align 3 +MAYBEUNPACK: + bis $17, $2, $2 # reassemble tag and word. [1-] + stq $2, CACHELINE_INSTRUCTION($3) # save the even instruction [0di] + subq $19, 48, $23 # t10>=0 if packed [1-] +#ifndef CACHEMETERING + stq $31, CACHELINE_ANNOTATION($3) # [0di] +#endif +#ifdef CACHEMETERING + ldl $6, PROCESSORSTATE_METERVALUE($14) # [1] + ldl $25, PROCESSORSTATE_METERCOUNT($14) # The number of remaining tokens. [1] + ldq $24, PROCESSORSTATE_METERDATABUFF($14) # The cache miss meter buffer. [1] + addq $6, 1, $6 # count the miss. [1di] + ldl $16, PROCESSORSTATE_METERPOS($14) # Position for new data. [1-] + stl $6, PROCESSORSTATE_METERVALUE($14) # [1] + bne $25, G13167 # [1] + ldl $17, PROCESSORSTATE_METERMASK($14) # [0di] + s4addq $16, $24, $24 # position of the current data item [1-] + addq $16, 1, $16 # [1] + and $16, $17, $16 # [1] + ldl $17, PROCESSORSTATE_METERMAX($14) # [1] + subq $6, $17, $23 # [3] + cmovgt $23, $6, $17 # [1] + stl $17, PROCESSORSTATE_METERMAX($14) # [1-] + stl $6, 0($24) # store the datapoint [1] + stl $16, PROCESSORSTATE_METERPOS($14) # Position for new data. [1] + stl $31, PROCESSORSTATE_METERVALUE($14) # [1] + ldl $25, PROCESSORSTATE_METERFREQ($14) # [1] +.align 3 +G13167: + stl $25, PROCESSORSTATE_METERCOUNT($14) # [1] +#endif + bge $23, DECODEPACKEDWORD # B. if a packed instruction [1] + s8addq $19, $21, $24 # t11 is the fwdispatch index [1-] + ldq $25, PROCESSORSTATE_I_STAGE_ERROR_HOOK($14) # [0di] + subq $19, 33, $16 # [1-] + ldq $24, 0($24) # Extract the opcode handler [1di] + stq $25, CACHELINE_CODE($4) # Store I-STATE-ERROR at odd pc [1] + cmoveq $16, $16, $8 # clear count if native instn seen [0di] + stq $24, CACHELINE_CODE($3) # [1-] +.align 3 +ENDDECODE: +/* Here we decide if to stop filling the cache and return to the */ +/* instruction interpretation stream, or whether to fill further */ + addq $1, 1, $1 # [1-] + ble $8, CACHEVALID # If count is zero, resume [0di] + sll $1, 1, $6 # [1-] + subq $8, 1, $8 # decrement count [1] + bis $6, 1, $7 # [1] + ldq $23, PROCESSORSTATE_ENDICACHE($14) # pointer to the end of icache [0di] + addq $4, TWOCACHELINESIZE, $4 # [1-] + addq $3, TWOCACHELINESIZE, $3 # [1] + subq $4, $23, $23 # [1] + ble $23, FILLICACHE # Still room for more [1] + br $31, CACHEVALID # [1] +.align 3 +PCENDCF: + ldq $24, PROCESSORSTATE_I_STAGE_ERROR_HOOK($14) # [1] + bis $31, $31, $8 # We reached the end of the fcn. [0di] + stq $24, CACHELINE_CODE($3) # Store I-STATE-ERROR dispatch at even and odd pc [1-] + stq $24, CACHELINE_CODE($4) # [1] + br $31, ENDDECODE # [1] +.end DoICacheFill +/* These are the instruction reentry points. Instructions end by returning */ +/* control to one of these tags. Most normal instructions reenter by jumping */ +/* to NEXTINSTRUCTION, which advances the PC and continues normally. */ +/* Instructions that change the PC usually go directly to INTERPRETINSTRUCTION. */ +/* Instructions that fail/trap/exception etc, go to one of the other places. */ +.align 5 +.globl iInterpret +.ent iInterpret 2 +.align 3 +iInterpret: + .frame $30, 1, $26 + stq $9, PROCESSORSTATE_ASRR9($16) # [1] + stq $10, PROCESSORSTATE_ASRR10($16) # [1] + stq $11, PROCESSORSTATE_ASRR11($16) # [1] + stq $12, PROCESSORSTATE_ASRR12($16) # [1] + stq $13, PROCESSORSTATE_ASRR13($16) # [1] + stq $15, PROCESSORSTATE_ASRR15($16) # [1] + stq $26, PROCESSORSTATE_ASRR26($16) # [1] + stq $27, PROCESSORSTATE_ASRR27($16) # [1] + stq $29, PROCESSORSTATE_ASRR29($16) # [1] + stq $30, PROCESSORSTATE_ASRR30($16) # [1] + stq $14, PROCESSORSTATE_ASRR14($16) # [1] + bis $16, $31, $14 # Setup our processor object handle [1] +/* Upon entry, load cached state. */ + ldq $13, PROCESSORSTATE_CP($14) # [2] + ldq $9, PROCESSORSTATE_EPC($14) # [1] + ldq $12, PROCESSORSTATE_SP($14) # [1] + ldq $10, PROCESSORSTATE_FP($14) # [1] + ldq $11, PROCESSORSTATE_LP($14) # [1] + bne $13, INTERPRETINSTRUCTION # First time in iCP will be zero. [0di] + br $31, ICACHEMISS # If this is the first time in cache is empty! [1] +.align 3 +INTERPRETINSTRUCTIONPREDICTED: + ldq $2, CACHELINE_PCDATA($17) # Get the PC to check cache hit. [1] + lda $16, 0($10) # Assume FP mode [0di] + ldq $0, PROCESSORSTATE_STOP_INTERPRETER($14) # Have we been asked to stop? [1-] + lda $19, -8($12) # SP-pop mode constant [0di] + ldq $18, CACHELINE_INSTRUCTION($17) # Grab the instruction/operand while stalled [1-] + subq $9, $2, $1 # [1di] + bne $1, INTERPRETINSTRUCTIONFORBRANCH # [1] + bis $17, $31, $13 # [0di] + bne $0, TRAPORSUSPENDMACHINE # Stop the world! someone wants out. [1-] + fetch 0($17) # [0di] + br $31, CONTINUECURRENTINSTRUCTION # [1] +.align 3 +INTERPRETINSTRUCTIONFORJUMP: +.align 3 +INTERPRETINSTRUCTIONFORBRANCH: + ldq $5, PROCESSORSTATE_ICACHEBASE($14) # get the base of the icache [1] + lda $4, -1 # [0di] + ldah $4, 4($4) # [1] + srl $9, 10, $17 # [1] + lda $3, -64 # [1] + and $17, $3, $17 # [1] + addq $9, $17, $17 # [1] + and $17, $4, $17 # [1] + sll $17, 5, $4 # temp=cpos*32 [1] + sll $17, 4, $17 # cpos=cpos*16 [1] + addq $5, $4, $5 # temp2=base+cpos*32 [1] +.align 3 +G13174: + addq $5, $17, $17 # cpos=base+cpos*48 [1] +#ifndef CACHEMETERING + stq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + fetch 0($17) # [2] + bis $17, $31, $13 # [0di] +.align 3 +INTERPRETINSTRUCTION: + ldq $30, PROCESSORSTATE_ASRR30($14) # [1-] + ldq $0, PROCESSORSTATE_STOP_INTERPRETER($14) # Have we been asked to stop? [1] + lda $16, 0($10) # Assume FP mode [1-] + ldq $18, CACHELINE_INSTRUCTION($13) # Grab the instruction/operand while stalled [0di] + lda $19, -8($12) # SP-pop mode constant [1-] + ldq $2, CACHELINE_PCDATA($13) # Get the PC to check cache hit. [0di] + bne $0, TRAPORSUSPENDMACHINE # Stop the world! someone wants out. [1-] + br $31, CONTINUECURRENTINSTRUCTION # [1] +.end iInterpret + + +/* End of file automatically generated from ../alpha-emulator/idispat.as */ diff --git a/alpha-emulator/idouble.as b/alpha-emulator/idouble.as new file mode 100644 index 0000000..a5782dc --- /dev/null +++ b/alpha-emulator/idouble.as @@ -0,0 +1,72 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Support for double precision floating point.") + +(define-subroutine |FetchDoubleFloat| + (arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (fetch-double-float-internal arg2 arg5 arg6 t5 t6 t7 t8) + )) + +(define-subroutine |ConsDoubleFloat| + (arg2 arg5 arg6 t5 t6 t7 t8 t9 t10) + (r0) + (cons-double-float-internal arg5 arg6 zero arg2 t5 t6 t7 t8 t9 t10)) + +(define-instruction |DoDoubleFloatOp| :operand-from-stack-immediate () + ;; The top four things are the stack are fixnums that represent the + ;; two double-float quantities. We don't bother to type-check them. + (LDL arg3 -24 (iSP) "X high") + (LDL arg4 -16 (iSP) "X low") + (LDL arg5 -8 (iSP) "Y high") + (LDL arg6 0 (iSP) "Y low") + (SLL arg3 32 arg3 "Get high part up top") + (EXTLL arg4 0 arg4) + (SLL arg5 32 arg5 "Get high part up top") + (EXTLL arg6 0 arg6) + (BIS arg3 arg4 arg3 "ARG3 is now X") + (BIS arg5 arg6 arg5 "ARG5 is now Y") + (STQ arg3 PROCESSORSTATE_FP0 (ivory)) + (STQ arg5 PROCESSORSTATE_FP1 (ivory)) + (SRL arg1 32 t2 "Immediate tag") + (EXTLL arg1 0 t1 "Immediate data") + (CheckDataType t2 |TypeFixnum| doublefloatiop t3) + (LDT f1 PROCESSORSTATE_FP0 (ivory)) + (LDT f2 PROCESSORSTATE_FP1 (ivory)) + (floating-exception-checking-prelude) + (register-dispatch t1 t2 t3 + (|DoubleFloatOpAdd| + (ADDT f1 f2 f1)) + (|DoubleFloatOpSub| + (SUBT f1 f2 f1)) + (|DoubleFloatOpMultiply| + (MULT f1 f2 f1)) + (|DoubleFloatOpDivide| + (DIVT f1 f2 f1))) + (floating-exception-checking-postlude doublefloatexc t1) + (get-nil t3 "There was no FP exception") + (unlikely-label doublefloatmerge) + (STT f1 PROCESSORSTATE_FP0 (ivory)) + (LDL t1 PROCESSORSTATE_FP0 (ivory)) + (LDL t2 |PROCESSORSTATE_FP0+4| (ivory)) + ;;+++ The next four lines should be made more efficient + (SUBQ iSP 32 iSP "Pop all the operands") + (stack-push-fixnum t2 t4 "Push high result") + (stack-push-fixnum t1 t4 "Push low result") + (stack-push t3 t4 "Push the exception predicate") + (ContinueToNextInstruction) + (label doublefloatexc) + ;; We don't signal a real exception because this gets used in Genera's + ;; floating point exception handlers, and we don't want recursive lossage. + (get-t t3 "Indicate an FP exception occurred") + (BR zero doublefloatmerge) + (label doublefloatiop) + (illegal-operand unknown-double-float-op)) + + +(comment "Fin.") diff --git a/alpha-emulator/idouble.s b/alpha-emulator/idouble.s new file mode 100644 index 0000000..e823233 --- /dev/null +++ b/alpha-emulator/idouble.s @@ -0,0 +1,289 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/idouble.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Support for double precision floating point. */ +.align 5 +.globl FetchDoubleFloat +.ent FetchDoubleFloat 11 +.align 3 +FetchDoubleFloat: + lda $30, -8($30) # [1] + .frame $30, 8, $0 +/* Memory Read Internal */ +G16002: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G16004 # [0di] +G16003: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G16006 # [1di] +G16013: + subq $20, TypeFixnum, $5 # [1-] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G16001 # [1] + stl $21, PROCESSORSTATE_FP0+4($14) # [1] + addq $17, 1, $17 # [1-] +/* Memory Read Internal */ +G16014: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G16016 # [0di] +G16015: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G16018 # [1di] +G16025: + subq $20, TypeFixnum, $5 # [1-] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G16001 # [1] + stl $21, PROCESSORSTATE_FP0($14) # [1] + lda $30, 8($30) # [1-] + ret $31, ($0), 1 # [0di] +.align 3 +G16018: + blbc $7, G16017 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G16014 # [2-] +.align 3 +G16017: +.align 3 +G16016: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G16025 # [1] +.align 3 +G16006: + blbc $7, G16005 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G16002 # [1-] +.align 3 +G16005: +.align 3 +G16004: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G16013 # [1] +.align 3 +G16001: + bis $31, TypeDoubleFloat, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.end FetchDoubleFloat +.align 5 +.globl ConsDoubleFloat +.ent ConsDoubleFloat 9 +.align 3 +ConsDoubleFloat: + lda $30, -8($30) # [1] + .frame $30, 8, $0 + ldl $21, PROCESSORSTATE_FP0($14) # [0di] + ldl $20, PROCESSORSTATE_FP0+4($14) # [1] + ldq $5, PROCESSORSTATE_LCAREA($14) # [1] + ldq $8, PROCESSORSTATE_NILADDRESS($14) # [1] + ldl $6, PROCESSORSTATE_LCLENGTH($14) # [1] + ldq $17, PROCESSORSTATE_LCADDRESS($14) # Fetch address [1] + cmpeq $5, $8, $7 # [1di] + bne $7, G16026 # Decached area [1] + subq $6, 2, $7 # Effectively an unsigned 32-bit compare [1] + blt $7, G16026 # Insufficient cache [1] + trapb # Force the trap to occur here [1] + stl $7, PROCESSORSTATE_LCLENGTH($14) # Store remaining length [1] + extll $17, 0, $8 # [0di] + addq $8, 2, $8 # Increment address [2] + stl $8, PROCESSORSTATE_LCADDRESS($14) # Store updated address [0di] + extll $17, 0, $17 # [1-] + bis $31, TypeFixnum, $22 # [1] + bis $22, 128, $22 # [1] + addq $17, $14, $5 # [1] + s4addq $5, $31, $8 # [1] + ldq_u $7, 0($5) # [1di] + insbl $22, $5, $6 # [1-] + mskbl $7, $5, $7 # [2] +.align 3 +G16027: + bis $7, $6, $7 # [2] + stq_u $7, 0($5) # [0di] + stl $20, 0($8) # [1] + addq $17, 1, $23 # [0di] + bis $31, TypeFixnum, $22 # [1] + bis $22, 64, $22 # [1] + addq $23, $14, $5 # [1] + s4addq $5, $31, $8 # [1] + ldq_u $7, 0($5) # [1-] + insbl $22, $5, $6 # [0di] + mskbl $7, $5, $7 # [3] +.align 3 +G16028: + bis $7, $6, $7 # [2] + stq_u $7, 0($5) # [0di] + stl $21, 0($8) # [1] + lda $30, 8($30) # [0di] + ret $31, ($0), 1 # [1-] +.align 3 +G16026: + bis $31, TypeDoubleFloat, $21 # arg6 = tag to dispatch on [3] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.end ConsDoubleFloat +.align 5 +.globl DoDoubleFloatOp +.ent DoDoubleFloatOp 0 +/* Halfword operand from stack instruction - DoDoubleFloatOp */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoDoubleFloatOpFP + .globl DoDoubleFloatOpSP + .globl DoDoubleFloatOpLP + .globl DoDoubleFloatOpIM +.align 3 +DoDoubleFloatOp: +#ifdef TRACING + .byte 0x82 + .asciiz "DoDoubleFloatOpIM" +#endif +.align 3 +DoDoubleFloatOpIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoDoubleFloatOp # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoDoubleFloatOpSP" +#endif +.align 3 +DoDoubleFloatOpSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoDoubleFloatOp # [0di] + .byte 0x90 + .asciiz "DoDoubleFloatOpLP" +#endif +.align 3 +DoDoubleFloatOpLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoDoubleFloatOp # [1] + .byte 0x84 + .asciiz "DoDoubleFloatOpFP" +#endif +.align 3 +DoDoubleFloatOpFP: # Entry point for FP relative +.align 3 +headDoDoubleFloatOp: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoDoubleFloatOp: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $18, -24($12) # X high [1] + ldl $19, -16($12) # X low [1] + ldl $20, -8($12) # Y high [1] + ldl $21, 0($12) # Y low [1] + sll $18, 32, $18 # Get high part up top [1-] + extll $19, 0, $19 # [1] + sll $20, 32, $20 # Get high part up top [1] + extll $21, 0, $21 # [1] + bis $18, $19, $18 # ARG3 is now X [1] + bis $20, $21, $20 # ARG5 is now Y [1] + stq $18, PROCESSORSTATE_FP0($14) # [1-] + stq $20, PROCESSORSTATE_FP1($14) # [1] + srl $16, 32, $2 # Immediate tag [1-] + extll $16, 0, $1 # Immediate data [1] + subq $2, TypeFixnum, $3 # [1] + and $3, 63, $3 # Strip CDR code [1] + bne $3, DOUBLEFLOATIOP # [1] + ldt $f1, PROCESSORSTATE_FP0($14) # [0di] + ldt $f2, PROCESSORSTATE_FP1($14) # [1] + lda $3, DoubleFloatOpAdd # [0di] + subq $1, $3, $3 # [1] + bne $3, G16030 # [1] +/* Here if argument DoubleFloatOpAdd */ + addt $f1, $f2, $f1 # [1] + br $31, G16029 # [1] +.align 3 +G16030: + lda $3, DoubleFloatOpSub # [1-] + subq $1, $3, $3 # [1] + bne $3, G16031 # [1] +/* Here if argument DoubleFloatOpSub */ + subt $f1, $f2, $f1 # [2] + br $31, G16029 # [1] +.align 3 +G16031: + lda $3, DoubleFloatOpMultiply # [1-] + subq $1, $3, $3 # [1] + bne $3, G16032 # [1] +/* Here if argument DoubleFloatOpMultiply */ + mult $f1, $f2, $f1 # [2] + br $31, G16029 # [1] +.align 3 +G16032: + lda $3, DoubleFloatOpDivide # [1-] + subq $1, $3, $3 # [1] + bne $3, G16033 # [1] +/* Here if argument DoubleFloatOpDivide */ + divt $f1, $f2, $f1 # [2] + br $31, G16029 # [1] +.align 3 +G16033: +.align 3 +G16029: + trapb # Force the trap to occur here [60] + ldq $3, PROCESSORSTATE_NILADDRESS($14) # There was no FP exception [1] +DOUBLEFLOATMERGE: + stt $f1, PROCESSORSTATE_FP0($14) # [1] + ldl $1, PROCESSORSTATE_FP0($14) # [1] + ldl $2, PROCESSORSTATE_FP0+4($14) # [1] + subq $12, 32, $12 # Pop all the operands [0di] + bis $31, TypeFixnum, $4 # [1] + stl $2, 8($12) # Push high result [1di] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $31, TypeFixnum, $4 # [1] + stl $1, 8($12) # Push low result [1di] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + addq $12, 8, $12 # [1] + sll $3, 26, $4 # [1] + srl $4, 26, $4 # [2] + stq $4, 0($12) # Push the exception predicate [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +DOUBLEFLOATEXC: + ldq $3, PROCESSORSTATE_TADDRESS($14) # Indicate an FP exception occurred [1] + br $31, DOUBLEFLOATMERGE # [1] +.align 3 +DOUBLEFLOATIOP: + bis $31, 0, $20 # [1-] + bis $31, 85, $17 # [1] + br $31, ILLEGALOPERAND +.end DoDoubleFloatOp +/* End of Halfword operand from stack instruction - DoDoubleFloatOp */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/idouble.as */ diff --git a/alpha-emulator/ifunarra.as b/alpha-emulator/ifunarra.as new file mode 100644 index 0000000..b0e7c96 --- /dev/null +++ b/alpha-emulator/ifunarra.as @@ -0,0 +1,377 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Array operations.") + + +;; |DoAref1| and |DoAset1| are in IFUNCOM2.AS +;; The following is all of their out-of-line code + +(define-procedure |Aref1Regset| () + (BIS arg4 zero t12) + (memory-read arg4 arg5 arg6 PROCESSORSTATE_HEADER t1 t2 t3 t4 nil nil) + (check-array-header-and-prefix arg5 arg6 Aref1Illegal |Aref1Exception| t1 t2) + ;; What we are about to do is strictly wrong -- but it works. If the + ;; memory read moved the array, we put the array into the WRONG register, + ;; and then use it. next time through, it will miss (because we put it + ;; in the wrong place), and the miss code will fix it up. It's better + ;; than slowing down the common case with a check. + (STL t12 ARRAYCACHE_ARRAY (t7) "store the array") + (LDA t2 |ArrayLengthMask| (zero)) + (AND arg6 t2 t1) ;get array length into t1 + ;; (check-array-bounds arg2 t1 Aref1Bounds t2) + (CMPULT arg2 t1 t2) + (branch-false t2 Aref1Bounds) + (STQ t1 ARRAYCACHE_LENGTH (t7) "store the array length [implicit fixnum]") + (SRL arg6 |ArrayRegisterBytePackingPos| t10) + (LDQ t8 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (SLL t10 |ArrayRegisterBytePackingPos| t10) + (ADDQ arg4 1 t9) + (ADDQ t10 t8 t10 "Construct the array register word") + (STL t10 ARRAYCACHE_ARWORD (t7) "store the array register word [implicit fixnum]") + (STQ t9 ARRAYCACHE_LOCAT (t7) "store the storage [implicit locative]") + (SRL arg6 |ArrayBytePackingPos| arg5 "get BP into arg5") + ;(SRL arg6 |ArrayRegisterByteOffsetPos| arg4) + (SRL arg6 |ArrayElementTypePos| arg6 "get element type into arg6") + (AND arg5 |ArrayBytePackingMask| arg5) + ;(AND arg4 |ArrayRegisterByteOffsetMask| arg4) + (BIS zero zero arg4) + (AND arg6 |ArrayElementTypeMask| arg6) + (BR zero aref1restart)) + +(define-procedure |Aref1RecomputeArrayRegister| () + (recompute-array-register arg1 fast-aref-1 t1 t2 t3 FastAref1Retry t4 t5 t6 t7 t8)) + +(define-procedure |Aref1Exception| () + ;(BR zero ReallyAref1Exc) + (STQ arg2 PROCESSORSTATE_ASRF4 (ivory) "Just a place to save these values") + (STQ t7 PROCESSORSTATE_ASRF5 (ivory) "Just a place to save these values") + (BIS t12 zero t9) ;unforwarded arrayr + (BIS arg3 zero arg2) ;atag + (BIS arg4 zero arg1) ;adata + (BIS arg5 zero t4) ; t4/t3 contains the header + (BIS arg6 zero t3) ; + (BIS zero zero t2) ;don't force it! + (ADDQ iSP 24 iSP) + (BSR r0 |Setup1DLongArray|) ;long array reg w/o trap! + (LDL arg2 PROCESSORSTATE_ASRF4 (ivory) "Just a place to save these values") + (LDQ t7 PROCESSORSTATE_ASRF5 (ivory) "Just a place to save these values") + (stack-pop2 t5 t1 "Length") + (stack-pop t5 "base") + (stack-pop t3 "control") + (stack-pop2 arg3 t9 "The original array") + (SUBQ iSP 24 iSP) + (STQ t1 ARRAYCACHE_LENGTH (t7)) + (STL t3 ARRAYCACHE_ARWORD (t7)) + (STL t5 ARRAYCACHE_LOCAT (t7)) + (STL t9 ARRAYCACHE_ARRAY (t7) "store the array") + (EXTLL t5 0 t9) + (CMPEQ t2 |ReturnValueException| t2) + (branch-true t2 ReallyAref1Exc) ; we really need that exception after all! + (CMPULT arg2 t1 t5) + (branch-false t5 Aref1Bounds) + (SRL t3 |ArrayBytePackingPos| arg5 "get BP into arg5") + (SRL t3 |ArrayElementTypePos| arg6 "get element type into arg6") + (SRL t3 |ArrayRegisterByteOffsetPos| arg4) + (AND arg5 |ArrayBytePackingMask| arg5) + (AND arg4 |ArrayRegisterByteOffsetMask| arg4) + (AND arg6 |ArrayElementTypeMask| arg6) + ;; Goes back to do (new-aref-1-internal arg3 t9 arg5 arg4 arg6 arg2 t1 t2 t3 t5 t6) + (BR zero aref1restart) + + (label ReallyAref1Exc) + ;; At this point, we know that the type of ARG2 is fixnum + ;(STQ zero ARRAYCACHE_ARRAY (t7)) + (BIS zero |TypeFixnum| arg1) + (SetTag arg1 arg2 t1) + (ArrayTypeException arg3 aref-1 t1 (array-access-type-check :binary)) + (label Aref1Illegal) + ;(STQ zero ARRAYCACHE_ARRAY (t7)) + (illegal-operand (array-access-type-check :binary)) + (label Aref1Bounds) + (STQ zero ARRAYCACHE_ARRAY (t7)) + (illegal-operand subscript-bounds-error)) + + +(define-procedure |Aset1Regset| () + (BIS arg4 zero t12) + (memory-read arg4 arg5 arg6 PROCESSORSTATE_HEADER t1 t2 t3 t4 nil nil) + (check-array-header-and-prefix arg5 arg6 aset1illegal |Aset1Exception| t1 t2) + ;; What we are about to do is strictly wrong -- but it works. If the + ;; memory read moved the array, we put the array into the WRONG register, + ;; and then use it. next time through, it will miss (because we put it + ;; in the wrong place), and the miss code will fix it up. It's better + ;; than slowing down the common case with a check. + (STL t12 ARRAYCACHE_ARRAY (t7) "store the array") + (LDA t2 |ArrayLengthMask| (zero)) + (AND arg6 t2 t1) ;get array length into t1 + ;; (check-array-bounds arg2 t1 Aref1Bounds t2) + (CMPULT arg2 t1 t2) + (branch-false t2 Aset1Bounds) + (STQ t1 ARRAYCACHE_LENGTH (t7) "store the array length [implicit fixnum]") + (SRL arg6 |ArrayRegisterBytePackingPos| t10) + (LDQ t8 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (SLL t10 |ArrayRegisterBytePackingPos| t10) + (ADDQ arg4 1 t9) + (ADDQ t10 t8 t10 "Construct the array register word") + (STL t10 ARRAYCACHE_ARWORD (t7) "store the array register word [implicit fixnum]") + (STQ t9 ARRAYCACHE_LOCAT (t7) "store the storage [implicit locative]") + (SRL arg6 |ArrayBytePackingPos| arg5 "get BP into arg5") + ;(SRL arg6 |ArrayRegisterByteOffsetPos| arg4) + (SRL arg6 |ArrayElementTypePos| arg6 "get element type into arg6") + (AND arg5 |ArrayBytePackingMask| arg5) + ;(AND arg4 |ArrayRegisterByteOffsetMask| arg4) + (BIS zero zero arg4) + (AND arg6 |ArrayElementTypeMask| arg6) + (BR zero aset1restart)) + +;(align16k) + +(define-procedure |Aset1RecomputeArrayRegister| () + (recompute-array-register arg1 fast-aset-1 t1 t2 t3 FastAset1Retry t4 t5 t6 t7 t8)) + +(define-procedure |Aset1Exception| () + ;(BR zero ReallyAset1Exc) + (STQ arg2 PROCESSORSTATE_ASRF4 (ivory) "Just a place to save these values") + (STQ t5 PROCESSORSTATE_ASRF3 (ivory) "Just a place to save these values") + (STQ t6 PROCESSORSTATE_ASRF6 (ivory) "Just a place to save these values") + (STQ t7 PROCESSORSTATE_ASRF5 (ivory) "Just a place to save these values") + (BIS t12 zero t9) ;unforwarded array + (BIS arg3 zero arg2) ;atag + (BIS arg4 zero arg1) ;adata + (BIS arg5 zero t4) ; t4/t3 contains the header + (BIS arg6 zero t3) ; + (BIS zero zero t2) ;don't force it! + (ADDQ iSP 24 iSP) + (BSR r0 |Setup1DLongArray|) ;long array reg w/o trap! + (CMPEQ t2 |ReturnValueException| t1) + (branch-true t1 reallyaset1exc) ; we really need that exception after all! + (LDL arg2 PROCESSORSTATE_ASRF4 (ivory) "Just a place to save these values") + (LDQ t5 PROCESSORSTATE_ASRF3 (ivory) "Just a place to save these values") + (LDQ t6 PROCESSORSTATE_ASRF6 (ivory) "Just a place to save these values") + (LDQ t7 PROCESSORSTATE_ASRF5 (ivory) "Just a place to save these values") + (stack-pop2 t2 t1 "Length") + (stack-pop t2 "base") + (stack-pop t3 "control") + (stack-pop2 arg3 t9 "The original array") + (SUBQ iSP 24 iSP) + (STQ t1 ARRAYCACHE_LENGTH (t7)) + (STL t3 ARRAYCACHE_ARWORD (t7)) + (STL t2 ARRAYCACHE_LOCAT (t7)) + (STL t9 ARRAYCACHE_ARRAY (t7) "store the array") + (EXTLL t2 0 t9) + (CMPULT arg2 t1 t2) + (branch-false t2 aset1bounds) + (SRL t3 |ArrayBytePackingPos| arg5 "get BP into arg5") + (SRL t3 |ArrayElementTypePos| arg6 "get element type into arg6") + (SRL t3 |ArrayRegisterByteOffsetPos| arg4) + (AND arg5 |ArrayBytePackingMask| arg5) + (AND arg4 |ArrayRegisterByteOffsetMask| arg4) + (AND arg6 |ArrayElementTypeMask| arg6) + (BR zero aset1restart) + + (label ReallyAset1Exc) + ;; At this point, we know that the type of ARG2 is fixnum + ;(STQ zero ARRAYCACHE_ARRAY (t7)) + (BIS zero |TypeFixnum| arg1) + (SetTag arg1 arg2 t1) + (ArrayTypeException arg3 aset-1 t1 (array-access-type-check :three-argument)) + (label Aset1Illegal) + ;(STQ zero ARRAYCACHE_ARRAY (t7)) + (illegal-operand (array-access-type-check :three-argument)) + (label Aset1Bounds) + (STQ zero ARRAYCACHE_ARRAY (t7)) + (illegal-operand subscript-bounds-error)) + + +(define-instruction |DoAloc1| :operand-from-stack-immediate (:own-immediate t) + (stack-pop2 arg3 arg4 "Get the array tag/data") + (EXTLL arg1 0 arg2 "Index Data") + (SRL arg1 32 arg1 "Index Tag") + (CheckDataType arg1 |TypeFixnum| aloc1illegal t1) + (label aloc1merge) + (CheckAdjacentDataTypes arg3 |TypeArray| 2 aloc1exception t1) + (memory-read arg4 arg5 arg6 PROCESSORSTATE_HEADER t1 t2 t3 t4 nil t) + (check-array-header-and-prefix arg5 arg6 aloc1illegal aloc1exception t1 t2) + (LDA t2 |ArrayLengthMask| (zero)) + (AND arg6 t2 t1) ;get array length into t1 + (check-array-bounds arg2 t1 aloc1illegal t3) + (SRL arg6 |ArrayElementTypePos| arg6 "get element type into arg6") + (ADDQ arg4 1 arg4) + (ADDQ arg4 arg2 arg4) + (AND arg6 |ArrayElementTypeMask| arg6) + (SUBQ arg6 |ArrayElementTypeObject| arg6) + (BNE arg6 aloc1notobject) + (stack-push-ir |TypeLocative| arg4 t1) + (ContinueToNextInstruction) + (label aloc1exception) + (BIS zero |TypeFixnum| arg1) + (SetTag arg1 arg2 t1) + (ArrayTypeException arg3 aloc-1 t1 (array-access-type-check :binary)) + (label aloc1illegal) + (illegal-operand (array-access-type-check :binary)) + (label aloc1bounds) + (illegal-operand subscript-bounds-error) + (label aloc1notobject) + (illegal-operand aloc-non-object-array) + (immediate-handler |DoAloc1|) + (stack-pop2 arg3 arg4 "Get the array tag/data") + (BR zero aloc1merge)) + + +(comment "Array register operations.") + +(define-instruction |DoSetup1DArray| :operand-from-stack-signed-immediate () + (SRL arg1 32 arg2 "Get the tag") + (EXTLL arg1 0 arg1 "and the data") + (BIS zero 0 t2 "Indicate not forcing 1d") + (setup-array-register setup-1d-array arg2 arg1 NextInstruction + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 arg6 arg5 arg4 arg3) + (ContinueToNextInstruction)) + +(define-instruction |DoSetupForce1DArray| :operand-from-stack-signed-immediate () + (SRL arg1 32 arg2 "Get the tag") + (EXTLL arg1 0 arg1 "and the data") + (BIS zero 1 t2 "Indicate forcing 1d") + (setup-array-register setup-force-1d-array arg2 arg1 NextInstruction + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 arg6 arg5 arg4 arg3) + (ContinueToNextInstruction)) + +(define-procedure |Setup1DLongArray| (t3 t9) + (setup-long-array-register arg2 arg1 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12 + arg6 arg5 arg4 arg3)) + + +;; |DoFastAref1| is in IFUNCOM2.AS + +(define-instruction |DoFastAset1| :operand-from-stack () + (stack-pop2 arg3 arg4 "Index") + (stack-pop2 t10 t11 "value") + (checkDataType arg3 |TypeFixnum| fastaset1iop t1) + (label FastAset1Retry) + ;; Get control register, base, and length, as we do above. + (LDL arg6 0 (arg1)) + (LDL t9 8 (arg1)) + (LDL t3 16 (arg1)) + (EXTLL arg6 0 arg6) + (EXTLL t9 0 t9) + (SLL arg6 #.(- 64 |array$K-registereventcountsize|) t5) + (EXTLL t3 0 t3) + (LDQ t4 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (SRL t5 #.(- 64 |array$K-registereventcountsize|) t5) + (check-array-bounds arg4 t3 fastaset1bounds t2) + (SUBQ t4 t5 t6) + (BNE t6 |Aset1RecomputeArrayRegister|) + (SRL arg6 |ArrayRegisterBytePackingPos| t6) + (SRL arg6 |ArrayRegisterByteOffsetPos| t7) + (SRL arg6 |ArrayRegisterElementTypePos| t8) + (AND t6 |ArrayRegisterBytePackingMask| t6) + (AND t7 |ArrayRegisterByteOffsetMask| t7) + (AND t8 |ArrayRegisterElementTypeMask| t8) + (aset-1-internal arg5 t9 t6 t7 t8 arg4 t10 t11 t1 t2 t3 t4 t5 t12 arg3) + (label fastaset1iop) + (illegal-operand fast-array-access-type-check) + (label fastaset1bounds) + (illegal-operand array-register-format-error-or-subscript-bounds-error)) + + +(comment "Array leaders.") + +(define-instruction |DoArrayLeader| :operand-from-stack-immediate (:own-immediate t) + (stack-pop2 arg3 arg4 "arg3=arraytag, arg4=arraydata") + (EXTLL arg1 0 arg2 "index data") + (SRL arg1 32 arg1 "index tag") + (CheckDataType arg1 |TypeFixnum| arrayleaderiop t1) + (label arrayleadermerge) + ;; Array or String + (CheckAdjacentDataTypes arg3 |TypeArray| 2 arrayleaderexception t1) + (with-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg4 arg6 arg5 PROCESSORSTATE_HEADER t1 t2 t3 t4 nil t) + (check-array-header arg6 arrayleaderiop t1) + (SRL arg5 |ArrayLeaderLengthFieldPos| t8) + (AND t8 |ArrayLeaderLengthFieldMask| t8) + (check-array-bounds arg2 t8 arrayleaderbounds t1) + (SUBQ arg4 arg2 arg2) + (SUBQ arg2 1 arg2) + (memory-read arg2 arg6 arg5 PROCESSORSTATE_DATAREAD t1 t2 t3 t4 nil t) + (stack-push2 arg6 arg5 t1) + (ContinueToNextInstruction)) + (label arrayleaderexception) + ;; At this point, we know that the type of ARG2 is fixnum + (BIS zero |TypeFixnum| arg1) + (SetTag arg1 arg2 t1) + (ArrayTypeException arg3 array-leader t1 (array-leader-access-type-check :binary)) + (label arrayleaderiop) + (illegal-operand (array-leader-access-type-check :binary)) + (label arrayleaderbounds) + (illegal-operand subscript-bounds-error) + (immediate-handler |DoArrayLeader|) + (stack-pop2 arg3 arg4 "arg3=arraytag, arg4=arraydata") + (BR zero arrayleadermerge)) + +(define-instruction |DoStoreArrayLeader| :operand-from-stack-immediate (:own-immediate t) + (stack-pop2 arg3 arg4 "arg3=arraytag, arg4=arraydata") + (stack-pop2 t6 t7 "t6=valuetag, t7=valuedata") + (EXTLL arg1 0 arg2 "index data") + (SRL arg1 32 arg1 "index tag") + (checkDataType arg1 |TypeFixnum| storearrayleaderiop t1) + (label storearrayleadermerge) + (CheckAdjacentDataTypes arg3 |TypeArray| 2 storearrayleaderexception t1) + (with-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg4 arg6 arg5 PROCESSORSTATE_HEADER t1 t2 t3 t4 nil t) + (check-array-header arg6 storearrayleaderiop t1) + (SRL arg5 |ArrayLeaderLengthFieldPos| t2) + (AND t2 |ArrayLeaderLengthFieldMask| t2) + (check-array-bounds arg2 t2 storearrayleaderbounds t1) + (SUBQ arg4 arg2 arg2) + (SUBQ arg2 1 arg2) + (store-contents arg2 t6 t7 PROCESSORSTATE_DATAWRITE t1 t2 t3 t4 t5 t8 + NextInstruction) + (ContinueToNextInstruction)) + (label storearrayleaderexception) + (BIS zero |TypeFixnum| arg1) + (SetTag arg1 arg2 t1) + (ArrayTypeException arg3 store-array-leader t1 (array-leader-access-type-check :three-argument)) + (label storearrayleaderiop) + (illegal-operand (array-leader-access-type-check :three-argument)) + (label storearrayleaderbounds) + (illegal-operand subscript-bounds-error) + (immediate-handler |DoStoreArrayLeader|) + (stack-pop2 arg3 arg4 "arg3=arraytag, arg4=arraydata") + (stack-pop2 t6 t7 "t6=valuetag, t7=valuedata") + (BR zero storearrayleadermerge)) + +(define-instruction |DoAlocLeader| :operand-from-stack-immediate (:own-immediate t) + (stack-pop2 arg3 arg4 "arg3=arraytag, arg4=arraydata") + (EXTLL arg1 0 arg2 "index data") + (SRL arg1 32 arg1 "index tag") + (checkDataType arg1 |TypeFixnum| alocleaderiop t1) + (label alocleadermerge) + (CheckAdjacentDataTypes arg3 |TypeArray| 2 alocleaderexception t1) + (memory-read arg4 arg6 arg5 PROCESSORSTATE_HEADER t1 t2 t3 t4 nil t) + (check-array-header arg6 alocleaderiop t1) + (SRL arg5 |ArrayLeaderLengthFieldPos| t9) + (AND t9 |ArrayLeaderLengthFieldMask| t9) + (check-array-bounds arg2 t9 alocleaderbounds t1) + (SUBQ arg4 arg2 arg2) + (SUBQ arg2 1 arg2) + (stack-push-ir |TypeLocative| arg2 t1) + (ContinueToNextInstruction) + (label alocleaderexception) + (BIS zero |TypeFixnum| arg1) + (SetTag arg1 arg2 t1) + (ArrayTypeException arg3 aloc-leader t1 (array-leader-access-type-check :binary)) + (label alocleaderiop) + (illegal-operand (array-leader-access-type-check :binary)) + (label alocleaderbounds) + (illegal-operand subscript-bounds-error) + (immediate-handler |DoAlocLeader|) + (stack-pop2 arg3 arg4 "arg3=arraytag, arg4=arraydata") + (BR zero alocleadermerge)) + +(comment "Fin.") + + diff --git a/alpha-emulator/ifunarra.s b/alpha-emulator/ifunarra.s new file mode 100644 index 0000000..d32884e --- /dev/null +++ b/alpha-emulator/ifunarra.s @@ -0,0 +1,2839 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunarra.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Array operations. */ +.align 5 +.globl Aref1Regset +.ent Aref1Regset 0 +.align 3 +Aref1Regset: + bis $19, $31, $25 # [1] +/* Memory Read Internal */ +G14810: + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $19, $14, $3 # [1-] + ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $3, $31, $21 # [1-] + ldq_u $20, 0($3) # [1di] + subq $19, $1, $1 # Stack cache offset [1-] + ldq $4, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $1, $2, $2 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $3, $20 # [1-] + bne $2, G14812 # [0di] +G14811: + lda $3, 64 # [1-] + srl $4, $20, $4 # [1] + srl $3, $20, $3 # [1] + extll $21, 0, $21 # [1] + blbs $4, G14814 # [1-] +G14819: +/* TagType. */ + and $20, 63, $1 # [0di] + srl $21, ArrayLongPrefixBitPos, $2 # [1] + subq $1, TypeHeaderI, $1 # [1] + bne $1, AREF1ILLEGAL # [1] + blbs $2, Aref1Exception # [1] + stl $25, ARRAYCACHE_ARRAY($7) # store the array [1] + lda $2, ArrayLengthMask # [0di] + and $21, $2, $1 # [1] + cmpult $17, $1, $2 # [1] + beq $2, AREF1BOUNDS # [1] + stq $1, ARRAYCACHE_LENGTH($7) # store the array length [implicit fixnum] [1] + srl $21, ArrayRegisterBytePackingPos, $23 # [1-] + ldq $8, PROCESSORSTATE_AREVENTCOUNT($14) # [0di] + sll $23, ArrayRegisterBytePackingPos, $23 # [2-] + addq $19, 1, $22 # [1] + addq $23, $8, $23 # Construct the array register word [1] + stl $23, ARRAYCACHE_ARWORD($7) # store the array register word [implicit fixnum] [0di] + stq $22, ARRAYCACHE_LOCAT($7) # store the storage [implicit locative] [1] + srl $21, ArrayBytePackingPos, $20 # get BP into arg5 [0di] + srl $21, ArrayElementTypePos, $21 # get element type into arg6 [1] + and $20, ArrayBytePackingMask, $20 # [1] + bis $31, $31, $19 # [1] + and $21, ArrayElementTypeMask, $21 # [1] + br $31, AREF1RESTART # [1-] +.align 3 +G14812: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $21, 0($1) # [2] + ldl $20, 4($1) # Read from stack cache [1] + br $31, G14811 # [1] +.align 3 +G14814: + blbc $3, G14813 # [1] + extll $21, 0, $19 # Do the indirect thing [0di] + br $31, G14810 # [1-] +.align 3 +G14813: + ldq $4, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $3 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $4, $3 # Adjust for a longword load [2di] + ldl $4, 0($3) # Get the memory action [2] +G14816: +/* Perform memory action */ + bis $31, $4, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end Aref1Regset +.align 5 +.globl Aref1RecomputeArrayRegister +.ent Aref1RecomputeArrayRegister 0 +.align 3 +Aref1RecomputeArrayRegister: + ldl $5, -8($16) # [1-] + ldl $4, -4($16) # [1] + extll $5, 0, $5 # [2-] + subq $4, TypeArray, $6 # [1] + and $6, 62, $6 # Strip CDR code, low bits [1] + bne $6, G14821 # [1] +/* Memory Read Internal */ +G14823: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $5, $14, $3 # [0di] + ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $3, $31, $6 # [0di] + ldq_u $7, 0($3) # [1-] + subq $5, $8, $8 # Stack cache offset [1di] + ldq $1, PROCESSORSTATE_HEADER_MASK($14) # [1-] + cmpult $8, $2, $2 # In range? [0di] + ldl $6, 0($6) # [1-] + extbl $7, $3, $7 # [0di] + bne $2, G14825 # [1-] +G14824: + lda $3, 64 # [0di] + srl $1, $7, $1 # [1] + srl $3, $7, $3 # [1] + extll $6, 0, $6 # [1] + blbs $1, G14827 # [0di] +G14832: +/* TagType. */ + and $7, 63, $8 # [1-] + srl $6, ArrayLongPrefixBitPos, $2 # [1] + subq $8, TypeHeaderI, $8 # [1] + bne $8, G14820 # [1] + blbs $2, G14822 # [1] + srl $6, ArrayBytePackingPos, $1 # [0di] + ldq $4, PROCESSORSTATE_AREVENTCOUNT($14) # [1-] + sll $1, ArrayRegisterBytePackingPos, $1 # [1di] + addq $5, 1, $2 # [1] + addq $1, $4, $1 # Construct the array register word [1] + stl $2, 8($16) # [1-] + lda $3, ArrayLengthMask # [0di] + and $6, $3, $3 # [1] + stl $1, 0($16) # [0di] + stl $3, 16($16) # [1] + br $31, FASTAREF1RETRY # [1] +.align 3 +G14822: + stq $16, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [1] + stq $23, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [1] + stq $24, PROCESSORSTATE_ASRF3($14) # Just a place to save these values [1] + stq $16, PROCESSORSTATE_ASRF6($14) # Just a place to save these values [1] + stq $17, PROCESSORSTATE_ASRF7($14) # Just a place to save these values [1] + stq $18, PROCESSORSTATE_ASRF8($14) # Just a place to save these values [1] + stq $19, PROCESSORSTATE_ASRF9($14) # Just a place to save these values [1] + ldl $22, -8($16) # [1] + ldl $17, -4($16) # [1] + extll $22, 0, $22 # [2di] + bis $5, $31, $16 # [1] + bis $7, $31, $4 # [1] + bis $6, $31, $3 # [1] + bis $31, 1, $2 # [1] + addq $12, 24, $12 # [1] + bsr $0, Setup1DLongArray + cmpeq $2, ReturnValueException, $4 # [1] + bne $4, G14821 # [1] + ldq $16, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [0di] + ldq $23, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [1] + ldq $24, PROCESSORSTATE_ASRF3($14) # Just a place to save these values [1] + ldq $16, PROCESSORSTATE_ASRF6($14) # Just a place to save these values [1] + ldq $17, PROCESSORSTATE_ASRF7($14) # Just a place to save these values [1] + ldq $18, PROCESSORSTATE_ASRF8($14) # Just a place to save these values [1] + ldq $19, PROCESSORSTATE_ASRF9($14) # Just a place to save these values [1] + ldq $3, 0($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + ldq $2, 0($12) # [2] + subq $12, 8, $12 # Pop Stack. [1] + ldq $1, 0($12) # [2] + subq $12, 8, $12 # Pop Stack. [1] + ldq $4, 0($12) # [2] + subq $12, 8, $12 # Pop Stack. [1] + subq $12, 24, $12 # [1] + stl $1, 0($16) # [0di] + stl $2, 8($16) # [1] + stl $3, 16($16) # [1] + br $31, FASTAREF1RETRY # [1] +.align 3 +G14821: + bis $31, $4, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 12, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +G14820: + bis $31, 0, $20 # [1] + bis $31, 12, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14825: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $2, $8 # reconstruct SCA [3] + ldl $6, 0($8) # [2] + ldl $7, 4($8) # Read from stack cache [1] + br $31, G14824 # [1] +.align 3 +G14827: + blbc $3, G14826 # [1] + extll $6, 0, $5 # Do the indirect thing [0di] + br $31, G14823 # [1-] +.align 3 +G14826: + ldq $1, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $7, 63, $3 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $1, $3 # Adjust for a longword load [2di] + ldl $1, 0($3) # Get the memory action [2] +G14829: +/* Perform memory action */ + bis $31, $1, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end Aref1RecomputeArrayRegister +.align 5 +.globl Aref1Exception +.ent Aref1Exception 0 +.align 3 +Aref1Exception: + stq $17, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [1-] + stq $7, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [1] + bis $25, $31, $22 # [1-] + bis $18, $31, $17 # [1] + bis $19, $31, $16 # [1] + bis $20, $31, $4 # [1] + bis $21, $31, $3 # [1] + bis $31, $31, $2 # [1] + addq $12, 24, $12 # [1] + bsr $0, Setup1DLongArray + ldl $17, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [0di] + ldq $7, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [1] + ldl $1, 0($12) # Length [1] + ldl $5, 4($12) # Length [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [1] + ldq $5, 0($12) # base [1di] + subq $12, 8, $12 # Pop Stack. [1] + ldq $3, 0($12) # control [2] + subq $12, 8, $12 # Pop Stack. [1] + ldl $22, 0($12) # The original array [2] + ldl $18, 4($12) # The original array [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $22, 0, $22 # [1] + subq $12, 24, $12 # [1] + stq $1, ARRAYCACHE_LENGTH($7) # [1-] + stl $3, ARRAYCACHE_ARWORD($7) # [1] + stl $5, ARRAYCACHE_LOCAT($7) # [1] + stl $22, ARRAYCACHE_ARRAY($7) # store the array [1] + extll $5, 0, $22 # [1] + cmpeq $2, ReturnValueException, $2 # [1] + bne $2, REALLYAREF1EXC # [1] + cmpult $17, $1, $5 # [0di] + beq $5, AREF1BOUNDS # [1] + srl $3, ArrayBytePackingPos, $20 # get BP into arg5 [0di] + srl $3, ArrayElementTypePos, $21 # get element type into arg6 [1] + srl $3, ArrayRegisterByteOffsetPos, $19 # [1] + and $20, ArrayBytePackingMask, $20 # [1] + and $19, ArrayRegisterByteOffsetMask, $19 # [1] + and $21, ArrayElementTypeMask, $21 # [1] + br $31, AREF1RESTART # [0di] +.align 3 +REALLYAREF1EXC: + bis $31, TypeFixnum, $16 # [1-] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $18, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 8, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +AREF1ILLEGAL: + bis $31, 0, $20 # [1] + bis $31, 8, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +AREF1BOUNDS: + stq $31, ARRAYCACHE_ARRAY($7) # [1-] + bis $31, 0, $20 # [0di] + bis $31, 74, $17 # [1] + br $31, ILLEGALOPERAND +.end Aref1Exception +.align 5 +.globl Aset1Regset +.ent Aset1Regset 0 +.align 3 +Aset1Regset: + bis $19, $31, $25 # [1] +/* Memory Read Internal */ +G14833: + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $19, $14, $3 # [1-] + ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $3, $31, $21 # [1-] + ldq_u $20, 0($3) # [1di] + subq $19, $1, $1 # Stack cache offset [1-] + ldq $4, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $1, $2, $2 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $3, $20 # [1-] + bne $2, G14835 # [0di] +G14834: + lda $3, 64 # [1-] + srl $4, $20, $4 # [1] + srl $3, $20, $3 # [1] + extll $21, 0, $21 # [1] + blbs $4, G14837 # [1-] +G14842: +/* TagType. */ + and $20, 63, $1 # [0di] + srl $21, ArrayLongPrefixBitPos, $2 # [1] + subq $1, TypeHeaderI, $1 # [1] + bne $1, ASET1ILLEGAL # [1] + blbs $2, Aset1Exception # [1] + stl $25, ARRAYCACHE_ARRAY($7) # store the array [1] + lda $2, ArrayLengthMask # [0di] + and $21, $2, $1 # [1] + cmpult $17, $1, $2 # [1] + beq $2, ASET1BOUNDS # [1] + stq $1, ARRAYCACHE_LENGTH($7) # store the array length [implicit fixnum] [1] + srl $21, ArrayRegisterBytePackingPos, $23 # [1-] + ldq $8, PROCESSORSTATE_AREVENTCOUNT($14) # [0di] + sll $23, ArrayRegisterBytePackingPos, $23 # [2-] + addq $19, 1, $22 # [1] + addq $23, $8, $23 # Construct the array register word [1] + stl $23, ARRAYCACHE_ARWORD($7) # store the array register word [implicit fixnum] [0di] + stq $22, ARRAYCACHE_LOCAT($7) # store the storage [implicit locative] [1] + srl $21, ArrayBytePackingPos, $20 # get BP into arg5 [0di] + srl $21, ArrayElementTypePos, $21 # get element type into arg6 [1] + and $20, ArrayBytePackingMask, $20 # [1] + bis $31, $31, $19 # [1] + and $21, ArrayElementTypeMask, $21 # [1] + br $31, ASET1RESTART # [1-] +.align 3 +G14835: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $21, 0($1) # [2] + ldl $20, 4($1) # Read from stack cache [1] + br $31, G14834 # [1] +.align 3 +G14837: + blbc $3, G14836 # [1] + extll $21, 0, $19 # Do the indirect thing [0di] + br $31, G14833 # [1-] +.align 3 +G14836: + ldq $4, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $3 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $4, $3 # Adjust for a longword load [2di] + ldl $4, 0($3) # Get the memory action [2] +G14839: +/* Perform memory action */ + bis $31, $4, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end Aset1Regset +.align 5 +.globl Aset1RecomputeArrayRegister +.ent Aset1RecomputeArrayRegister 0 +.align 3 +Aset1RecomputeArrayRegister: + ldl $5, -8($16) # [1-] + ldl $4, -4($16) # [1] + extll $5, 0, $5 # [2-] + subq $4, TypeArray, $6 # [1] + and $6, 62, $6 # Strip CDR code, low bits [1] + bne $6, G14844 # [1] +/* Memory Read Internal */ +G14846: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $5, $14, $3 # [0di] + ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $3, $31, $6 # [0di] + ldq_u $7, 0($3) # [1-] + subq $5, $8, $8 # Stack cache offset [1di] + ldq $1, PROCESSORSTATE_HEADER_MASK($14) # [1-] + cmpult $8, $2, $2 # In range? [0di] + ldl $6, 0($6) # [1-] + extbl $7, $3, $7 # [0di] + bne $2, G14848 # [1-] +G14847: + lda $3, 64 # [0di] + srl $1, $7, $1 # [1] + srl $3, $7, $3 # [1] + extll $6, 0, $6 # [1] + blbs $1, G14850 # [0di] +G14855: +/* TagType. */ + and $7, 63, $8 # [1-] + srl $6, ArrayLongPrefixBitPos, $2 # [1] + subq $8, TypeHeaderI, $8 # [1] + bne $8, G14843 # [1] + blbs $2, G14845 # [1] + srl $6, ArrayBytePackingPos, $1 # [0di] + ldq $4, PROCESSORSTATE_AREVENTCOUNT($14) # [1-] + sll $1, ArrayRegisterBytePackingPos, $1 # [1di] + addq $5, 1, $2 # [1] + addq $1, $4, $1 # Construct the array register word [1] + stl $2, 8($16) # [1-] + lda $3, ArrayLengthMask # [0di] + and $6, $3, $3 # [1] + stl $1, 0($16) # [0di] + stl $3, 16($16) # [1] + br $31, FASTASET1RETRY # [1] +.align 3 +G14845: + stq $16, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [1] + stq $23, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [1] + stq $24, PROCESSORSTATE_ASRF3($14) # Just a place to save these values [1] + stq $16, PROCESSORSTATE_ASRF6($14) # Just a place to save these values [1] + stq $17, PROCESSORSTATE_ASRF7($14) # Just a place to save these values [1] + stq $18, PROCESSORSTATE_ASRF8($14) # Just a place to save these values [1] + stq $19, PROCESSORSTATE_ASRF9($14) # Just a place to save these values [1] + ldl $22, -8($16) # [1] + ldl $17, -4($16) # [1] + extll $22, 0, $22 # [2di] + bis $5, $31, $16 # [1] + bis $7, $31, $4 # [1] + bis $6, $31, $3 # [1] + bis $31, 1, $2 # [1] + addq $12, 24, $12 # [1] + bsr $0, Setup1DLongArray + cmpeq $2, ReturnValueException, $4 # [1] + bne $4, G14844 # [1] + ldq $16, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [0di] + ldq $23, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [1] + ldq $24, PROCESSORSTATE_ASRF3($14) # Just a place to save these values [1] + ldq $16, PROCESSORSTATE_ASRF6($14) # Just a place to save these values [1] + ldq $17, PROCESSORSTATE_ASRF7($14) # Just a place to save these values [1] + ldq $18, PROCESSORSTATE_ASRF8($14) # Just a place to save these values [1] + ldq $19, PROCESSORSTATE_ASRF9($14) # Just a place to save these values [1] + ldq $3, 0($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + ldq $2, 0($12) # [2] + subq $12, 8, $12 # Pop Stack. [1] + ldq $1, 0($12) # [2] + subq $12, 8, $12 # Pop Stack. [1] + ldq $4, 0($12) # [2] + subq $12, 8, $12 # Pop Stack. [1] + subq $12, 24, $12 # [1] + stl $1, 0($16) # [0di] + stl $2, 8($16) # [1] + stl $3, 16($16) # [1] + br $31, FASTASET1RETRY # [1] +.align 3 +G14844: + bis $31, $4, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 3, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 12, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +G14843: + bis $31, 0, $20 # [1] + bis $31, 12, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14848: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $2, $8 # reconstruct SCA [3] + ldl $6, 0($8) # [2] + ldl $7, 4($8) # Read from stack cache [1] + br $31, G14847 # [1] +.align 3 +G14850: + blbc $3, G14849 # [1] + extll $6, 0, $5 # Do the indirect thing [0di] + br $31, G14846 # [1-] +.align 3 +G14849: + ldq $1, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $7, 63, $3 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $1, $3 # Adjust for a longword load [2di] + ldl $1, 0($3) # Get the memory action [2] +G14852: +/* Perform memory action */ + bis $31, $1, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end Aset1RecomputeArrayRegister +.align 5 +.globl Aset1Exception +.ent Aset1Exception 0 +.align 3 +Aset1Exception: + stq $17, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [1-] + stq $5, PROCESSORSTATE_ASRF3($14) # Just a place to save these values [1] + stq $6, PROCESSORSTATE_ASRF6($14) # Just a place to save these values [1] + stq $7, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [1] + bis $25, $31, $22 # [1-] + bis $18, $31, $17 # [1] + bis $19, $31, $16 # [1] + bis $20, $31, $4 # [1] + bis $21, $31, $3 # [1] + bis $31, $31, $2 # [1] + addq $12, 24, $12 # [1] + bsr $0, Setup1DLongArray + cmpeq $2, ReturnValueException, $1 # [1] + bne $1, REALLYASET1EXC # [1] + ldl $17, PROCESSORSTATE_ASRF4($14) # Just a place to save these values [0di] + ldq $5, PROCESSORSTATE_ASRF3($14) # Just a place to save these values [1] + ldq $6, PROCESSORSTATE_ASRF6($14) # Just a place to save these values [1] + ldq $7, PROCESSORSTATE_ASRF5($14) # Just a place to save these values [1] + ldl $1, 0($12) # Length [1] + ldl $2, 4($12) # Length [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [1] + ldq $2, 0($12) # base [1di] + subq $12, 8, $12 # Pop Stack. [1] + ldq $3, 0($12) # control [2] + subq $12, 8, $12 # Pop Stack. [1] + ldl $22, 0($12) # The original array [2] + ldl $18, 4($12) # The original array [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $22, 0, $22 # [1] + subq $12, 24, $12 # [1] + stq $1, ARRAYCACHE_LENGTH($7) # [1-] + stl $3, ARRAYCACHE_ARWORD($7) # [1] + stl $2, ARRAYCACHE_LOCAT($7) # [1] + stl $22, ARRAYCACHE_ARRAY($7) # store the array [1] + extll $2, 0, $22 # [1] + cmpult $17, $1, $2 # [1] + beq $2, ASET1BOUNDS # [1] + srl $3, ArrayBytePackingPos, $20 # get BP into arg5 [0di] + srl $3, ArrayElementTypePos, $21 # get element type into arg6 [1] + srl $3, ArrayRegisterByteOffsetPos, $19 # [1] + and $20, ArrayBytePackingMask, $20 # [1] + and $19, ArrayRegisterByteOffsetMask, $19 # [1] + and $21, ArrayElementTypeMask, $21 # [1] + br $31, ASET1RESTART # [0di] +.align 3 +REALLYASET1EXC: + bis $31, TypeFixnum, $16 # [1-] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $18, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 3, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 9, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +ASET1ILLEGAL: + bis $31, 0, $20 # [1] + bis $31, 9, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +ASET1BOUNDS: + stq $31, ARRAYCACHE_ARRAY($7) # [1-] + bis $31, 0, $20 # [0di] + bis $31, 74, $17 # [1] + br $31, ILLEGALOPERAND +.end Aset1Exception +.align 5 +.globl DoAloc1 +.ent DoAloc1 0 +/* Halfword operand from stack instruction - DoAloc1 */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAloc1FP + .globl DoAloc1SP + .globl DoAloc1LP + .globl DoAloc1IM +.align 3 +DoAloc1: +#ifdef TRACING + .byte 0x88 + .asciiz "DoAloc1SP" +#endif +.align 3 +DoAloc1SP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAloc1 # [0di] + .byte 0x90 + .asciiz "DoAloc1LP" +#endif +.align 3 +DoAloc1LP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAloc1 # [1] + .byte 0x84 + .asciiz "DoAloc1FP" +#endif +.align 3 +DoAloc1FP: # Entry point for FP relative +.align 3 +headDoAloc1: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAloc1: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # Get the array tag/data [1] + ldl $18, 4($12) # Get the array tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + extll $16, 0, $17 # Index Data [1] + srl $16, 32, $16 # Index Tag [1] + subq $16, TypeFixnum, $1 # [2] + and $1, 63, $1 # Strip CDR code [1] + bne $1, ALOC1ILLEGAL # [1] +.align 3 +ALOC1MERGE: + subq $18, TypeArray, $1 # [1] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, ALOC1EXCEPTION # [1] +/* Memory Read Internal */ +G14856: + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1] + addq $19, $14, $3 # [1-] + ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $3, $31, $21 # [1-] + ldq_u $20, 0($3) # [1di] + subq $19, $1, $1 # Stack cache offset [1-] + ldq $4, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $1, $2, $2 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $3, $20 # [1-] + bne $2, G14858 # [0di] +G14857: + lda $3, 64 # [1-] + srl $4, $20, $4 # [1] + srl $3, $20, $3 # [1] + blbs $4, G14860 # [1di] +G14865: +/* TagType. */ + and $20, 63, $1 # [1-] + srl $21, ArrayLongPrefixBitPos, $2 # [1] + subq $1, TypeHeaderI, $1 # [1] + bne $1, ALOC1ILLEGAL # [1] + blbs $2, ALOC1EXCEPTION # [1] + lda $2, ArrayLengthMask # [1] + and $21, $2, $1 # [1] + cmpult $17, $1, $3 # [1] + beq $3, ALOC1ILLEGAL # [1] + srl $21, ArrayElementTypePos, $21 # get element type into arg6 [0di] + addq $19, 1, $19 # [1] + addq $19, $17, $19 # [1] + and $21, ArrayElementTypeMask, $21 # [1] + subq $21, ArrayElementTypeObject, $21 # [1] + bne $21, ALOC1NOTOBJECT # [1] + bis $31, TypeLocative, $1 # [0di] + stl $19, 8($12) # [1-] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +ALOC1EXCEPTION: + bis $31, TypeFixnum, $16 # [1-] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $18, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 8, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +ALOC1ILLEGAL: + bis $31, 0, $20 # [1] + bis $31, 8, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +ALOC1BOUNDS: + bis $31, 0, $20 # [1] + bis $31, 74, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +ALOC1NOTOBJECT: + bis $31, 0, $20 # [1] + bis $31, 7, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + br $31, DoAloc1IM # [1-] + .byte 0x82 + .asciiz "DoAloc1IM" +#endif +.align 5 +.align 3 +DoAloc1IM: # Entry point for IMMEDIATE mode + ldl $19, 0($12) # Get the array tag/data [1] + ldl $18, 4($12) # Get the array tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + br $31, ALOC1MERGE # [1-] +.align 3 +G14858: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $21, 0($1) # [2] + ldl $20, 4($1) # Read from stack cache [1] + br $31, G14857 # [1] +.align 3 +G14860: + blbc $3, G14859 # [1] + extll $21, 0, $19 # Do the indirect thing [0di] + br $31, G14856 # [1-] +.align 3 +G14859: + ldq $4, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $3 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $4, $3 # Adjust for a longword load [2di] + ldl $4, 0($3) # Get the memory action [2] +G14862: +/* Perform memory action */ + bis $31, $4, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoAloc1 +/* End of Halfword operand from stack instruction - DoAloc1 */ +/* Array register operations. */ +.align 5 +.globl DoSetup1DArray +.ent DoSetup1DArray 0 +/* Halfword operand from stack instruction - DoSetup1DArray */ + .globl DoSetup1DArrayFP + .globl DoSetup1DArraySP + .globl DoSetup1DArrayLP + .globl DoSetup1DArrayIM +.align 3 +DoSetup1DArray: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoSetup1DArrayIM" +#endif +.align 3 +DoSetup1DArrayIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G14879: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoSetup1DArray # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetup1DArraySP" +#endif +.align 3 +DoSetup1DArraySP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoSetup1DArray # [0di] + .byte 0x90 + .asciiz "DoSetup1DArrayLP" +#endif +.align 3 +DoSetup1DArrayLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoSetup1DArray # [1] + .byte 0x84 + .asciiz "DoSetup1DArrayFP" +#endif +.align 3 +DoSetup1DArrayFP: # Entry point for FP relative +.align 3 +headDoSetup1DArray: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoSetup1DArray: +/* arg1 has the operand, sign extended if immediate. */ + srl $16, 32, $17 # Get the tag [3] + extll $16, 0, $16 # and the data [1] + bis $31, 0, $2 # Indicate not forcing 1d [1] + bis $16, $31, $22 # [1] + subq $17, TypeArray, $3 # [1] + and $3, 62, $3 # Strip CDR code, low bits [1] + bne $3, G14867 # [1] +/* Memory Read Internal */ +G14869: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $16, $14, $7 # [1-] + ldl $6, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $7, $31, $3 # [1-] + ldq_u $4, 0($7) # [1di] + subq $16, $5, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $5, $6, $6 # In range? [1-] + ldl $3, 0($3) # [0di] + extbl $4, $7, $4 # [1-] + bne $6, G14871 # [0di] +G14870: + lda $7, 64 # [1-] + srl $8, $4, $8 # [1] + srl $7, $4, $7 # [1] + extll $3, 0, $3 # [1] + blbs $8, G14873 # [1-] +G14878: +/* TagType. */ + and $4, 63, $5 # [0di] + srl $3, ArrayLongPrefixBitPos, $6 # [1] + subq $5, TypeHeaderI, $5 # [1] + bne $5, G14866 # [1] + blbs $6, G14868 # [1] + and $17, 63, $5 # set CDR-NEXT [1-] + stl $22, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + srl $3, ArrayRegisterBytePackingPos, $8 # [1] + bis $31, TypeFixnum, $7 # [1] + ldq $1, PROCESSORSTATE_AREVENTCOUNT($14) # [1-] + sll $8, ArrayRegisterBytePackingPos, $8 # [0di] + addq $16, 1, $5 # [1] + addq $8, $1, $8 # Construct the array register word [2] + and $7, 63, $6 # set CDR-NEXT [1] + stl $8, 8($12) # [0di] + stl $6, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $31, TypeLocative, $8 # [1] + stl $5, 8($12) # [1di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + lda $6, ArrayLengthMask # [1] + and $3, $6, $6 # [1] + and $7, 63, $8 # set CDR-NEXT [1] + stl $6, 8($12) # [0di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +G14867: +/* SetTag. */ + sll $17, 32, $6 # [1-] + bis $22, $6, $6 # [2] + bis $31, $17, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 71, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +G14866: + bis $31, 0, $20 # [1] + bis $31, 71, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14868: + bsr $0, Setup1DLongArray + cmpeq $2, ReturnValueNormal, $1 # [1] + bne $1, NEXTINSTRUCTION # [1] + cmpeq $2, ReturnValueException, $1 # [1] + bne $1, G14867 # [1] + cmpeq $2, ReturnValueIllegalOperand, $1 # [1] + bne $1, G14866 # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14871: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $3, 0($5) # [2] + ldl $4, 4($5) # Read from stack cache [1] + br $31, G14870 # [1] +.align 3 +G14873: + blbc $7, G14872 # [1] + extll $3, 0, $16 # Do the indirect thing [0di] + br $31, G14869 # [1-] +.align 3 +G14872: + ldq $8, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $7 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +G14875: +/* Perform memory action */ + bis $31, $8, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoSetup1DArray +/* End of Halfword operand from stack instruction - DoSetup1DArray */ +.align 5 +.globl DoSetupForce1DArray +.ent DoSetupForce1DArray 0 +/* Halfword operand from stack instruction - DoSetupForce1DArray */ + .globl DoSetupForce1DArrayFP + .globl DoSetupForce1DArraySP + .globl DoSetupForce1DArrayLP + .globl DoSetupForce1DArrayIM +.align 3 +DoSetupForce1DArray: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoSetupForce1DArrayIM" +#endif +.align 3 +DoSetupForce1DArrayIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G14893: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoSetupForce1DArray # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetupForce1DArraySP" +#endif +.align 3 +DoSetupForce1DArraySP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoSetupForce1DArray # [0di] + .byte 0x90 + .asciiz "DoSetupForce1DArrayLP" +#endif +.align 3 +DoSetupForce1DArrayLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoSetupForce1DArray # [1] + .byte 0x84 + .asciiz "DoSetupForce1DArrayFP" +#endif +.align 3 +DoSetupForce1DArrayFP: # Entry point for FP relative +.align 3 +headDoSetupForce1DArray: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoSetupForce1DArray: +/* arg1 has the operand, sign extended if immediate. */ + srl $16, 32, $17 # Get the tag [3] + extll $16, 0, $16 # and the data [1] + bis $31, 1, $2 # Indicate forcing 1d [1] + bis $16, $31, $22 # [1] + subq $17, TypeArray, $3 # [1] + and $3, 62, $3 # Strip CDR code, low bits [1] + bne $3, G14881 # [1] +/* Memory Read Internal */ +G14883: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $16, $14, $7 # [1-] + ldl $6, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $7, $31, $3 # [1-] + ldq_u $4, 0($7) # [1di] + subq $16, $5, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $5, $6, $6 # In range? [1-] + ldl $3, 0($3) # [0di] + extbl $4, $7, $4 # [1-] + bne $6, G14885 # [0di] +G14884: + lda $7, 64 # [1-] + srl $8, $4, $8 # [1] + srl $7, $4, $7 # [1] + extll $3, 0, $3 # [1] + blbs $8, G14887 # [1-] +G14892: +/* TagType. */ + and $4, 63, $5 # [0di] + srl $3, ArrayLongPrefixBitPos, $6 # [1] + subq $5, TypeHeaderI, $5 # [1] + bne $5, G14880 # [1] + blbs $6, G14882 # [1] + and $17, 63, $5 # set CDR-NEXT [1-] + stl $22, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + srl $3, ArrayRegisterBytePackingPos, $8 # [1] + bis $31, TypeFixnum, $7 # [1] + ldq $1, PROCESSORSTATE_AREVENTCOUNT($14) # [1-] + sll $8, ArrayRegisterBytePackingPos, $8 # [0di] + addq $16, 1, $5 # [1] + addq $8, $1, $8 # Construct the array register word [2] + and $7, 63, $6 # set CDR-NEXT [1] + stl $8, 8($12) # [0di] + stl $6, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $31, TypeLocative, $8 # [1] + stl $5, 8($12) # [1di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + lda $6, ArrayLengthMask # [1] + and $3, $6, $6 # [1] + and $7, 63, $8 # set CDR-NEXT [1] + stl $6, 8($12) # [0di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +G14881: +/* SetTag. */ + sll $17, 32, $6 # [1-] + bis $22, $6, $6 # [2] + bis $31, $17, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 71, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +G14880: + bis $31, 0, $20 # [1] + bis $31, 71, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14882: + bsr $0, Setup1DLongArray + cmpeq $2, ReturnValueNormal, $1 # [1] + bne $1, NEXTINSTRUCTION # [1] + cmpeq $2, ReturnValueException, $1 # [1] + bne $1, G14881 # [1] + cmpeq $2, ReturnValueIllegalOperand, $1 # [1] + bne $1, G14880 # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14885: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $3, 0($5) # [2] + ldl $4, 4($5) # Read from stack cache [1] + br $31, G14884 # [1] +.align 3 +G14887: + blbc $7, G14886 # [1] + extll $3, 0, $16 # Do the indirect thing [0di] + br $31, G14883 # [1-] +.align 3 +G14886: + ldq $8, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $7 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +G14889: +/* Perform memory action */ + bis $31, $8, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoSetupForce1DArray +/* End of Halfword operand from stack instruction - DoSetupForce1DArray */ +.align 5 +.globl Setup1DLongArray +.ent Setup1DLongArray 2 +.align 3 +Setup1DLongArray: +/* Read data from the header: alength offset indirect lengths&mults */ + lda $1, 1($16) # length=array+1 [1] +/* Memory Read Internal */ +G14903: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $23 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $19 # [1-] + ldq_u $6, 0($23) # [1di] + subq $1, $7, $7 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $8, $8 # In range? [1-] + ldl $19, 0($19) # [0di] + extbl $6, $23, $6 # [1-] + bne $8, G14905 # [0di] +G14904: + lda $23, 240 # [1-] + srl $24, $6, $24 # [1] + srl $23, $6, $23 # [1] + extll $19, 0, $19 # [1] + blbs $24, G14907 # [1-] +G14914: + subq $6, TypeFixnum, $8 # [0di] + and $8, 63, $8 # Strip CDR code [1] + bne $8, G14894 # [1] + lda $1, 1($1) # Offset is adata+2 [1-] +/* Memory Read Internal */ +G14915: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $23 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $18 # [1-] + ldq_u $6, 0($23) # [1di] + subq $1, $7, $7 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $8, $8 # In range? [1-] + ldl $18, 0($18) # [0di] + extbl $6, $23, $6 # [1-] + bne $8, G14917 # [0di] +G14916: + lda $23, 240 # [1-] + srl $24, $6, $24 # [1] + srl $23, $6, $23 # [1] + extll $18, 0, $18 # [1] + blbs $24, G14919 # [1-] +G14926: + subq $6, TypeFixnum, $8 # [0di] + and $8, 63, $8 # Strip CDR code [1] + bne $8, G14894 # [1] + lda $1, 1($1) # Indirect is adata+3 [1-] +/* Memory Read Internal */ +G14927: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $23 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $5 # [1-] + ldq_u $6, 0($23) # [1di] + subq $1, $7, $7 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $8, $8 # In range? [1-] + ldl $5, 0($5) # [0di] + extbl $6, $23, $6 # [1-] + bne $8, G14929 # [0di] +G14928: + lda $23, 240 # [1-] + srl $24, $6, $24 # [1] + srl $23, $6, $23 # [1] + extll $5, 0, $5 # [1] + blbs $24, G14931 # [1-] +G14938: + and $6, 63, $23 # Strip off any CDR code bits. [0di] + cmpeq $23, TypeLocative, $24 # [1] +.align 3 +G15003: + beq $24, G14940 # [1] +/* Here if argument TypeLocative */ +.align 3 +G14897: + and $17, 63, $23 # set CDR-NEXT [1-] + stl $22, 8($12) # [0di] + stl $23, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + srl $3, ArrayBytePackingPos, $8 # [1] + bis $31, TypeFixnum, $7 # [1] + ldq $1, PROCESSORSTATE_AREVENTCOUNT($14) # [1-] + sll $8, ArrayRegisterBytePackingPos, $8 # [0di] + addq $8, $1, $8 # Construct the array register word [3] + and $7, 63, $6 # set CDR-NEXT [1] + stl $8, 8($12) # [1-] + stl $6, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + bis $31, TypeLocative, $8 # [1] + stl $5, 8($12) # [1-] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + and $7, 63, $8 # set CDR-NEXT [1] + stl $19, 8($12) # [1-] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, G14902 # [0di] +.align 3 +G14940: + cmpeq $23, TypeFixnum, $24 # [1-] +.align 3 +G15004: + beq $24, G14941 # [1] +/* Here if argument TypeFixnum */ + br $31, G14897 # [1] +.align 3 +G14941: + cmpeq $23, TypeArray, $24 # [1-] +.align 3 +G15005: + beq $24, G14942 # [1] +/* Here if argument TypeArray */ +.align 3 +G14901: + and $3, 7, $1 # [1-] + cmpeq $1, 1, $1 # [1] + bis $1, $2, $1 # Force true if FORCE [2] + beq $1, G14894 # [1] + srl $3, ArrayBytePackingPos, $25 # [1-] + and $25, ArrayBytePackingMask, $25 # [2] + bis $18, $31, $2 # [1] +.align 3 +G14896: +/* Memory Read Internal */ +G14943: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $5, $14, $23 # [0di] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $23, $31, $4 # [0di] + ldq_u $6, 0($23) # [1-] + subq $5, $7, $7 # Stack cache offset [1di] + ldq $24, PROCESSORSTATE_HEADER_MASK($14) # [1-] + cmpult $7, $8, $8 # In range? [0di] + ldl $4, 0($4) # [1-] + extbl $6, $23, $6 # [0di] + bne $8, G14945 # [1-] +G14944: + lda $23, 64 # [0di] + srl $24, $6, $24 # [1] + srl $23, $6, $23 # [1] + extll $4, 0, $4 # [1] + blbs $24, G14947 # [0di] +G14952: + srl $4, ArrayBytePackingPos, $23 # [2-] + and $23, ArrayBytePackingMask, $23 # [2] + subq $25, $23, $16 # [1] + srl $4, ArrayLongPrefixBitPos, $7 # [1] + blbs $7, G14898 # [2] + addq $5, 1, $5 # increment beyond header [0di] + lda $8, 32767 # [1] + and $4, $8, $8 # [1] + subq $31, $16, $23 # [1] + srl $8, $23, $23 # [1] + sll $8, $16, $8 # [1] + cmovle $16, $23, $8 # [1] + addq $19, $18, $23 # [1] + subq $23, $8, $7 # [1] + cmovle $7, $23, $8 # [1] + bis $8, $31, $19 # [2] +.align 3 +G14895: + subq $19, $2, $19 # [1] + and $17, 63, $23 # set CDR-NEXT [1] + stl $22, 8($12) # [1-] + stl $23, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + bis $31, TypeFixnum, $7 # [1] + srl $3, ArrayRegisterBytePackingPos, $8 # [1] + ldq $1, PROCESSORSTATE_AREVENTCOUNT($14) # [0di] + sll $8, ArrayRegisterBytePackingPos, $8 # [2-] + subq $31, 1, $24 # -1 [1] + sll $24, $25, $24 # (LSH -1 byte-packing) [1] + bic $2, $24, $24 # [2] + sll $24, ArrayRegisterByteOffsetPos, $24 # [1] + addq $8, $1, $8 # Construct the array register word [1] + addq $24, $8, $8 # Add in the byte offset [1] + and $7, 63, $6 # set CDR-NEXT [1] + stl $8, 8($12) # [1-] + stl $6, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + cmovle $19, $31, $19 # [1] + beq $19, G14899 # [2] + subq $31, $25, $1 # [0di] + sll $2, $1, $1 # [1] + srl $2, $25, $2 # [1] + cmovle $25, $1, $2 # [1] + addq $2, $5, $5 # [2] +.align 3 +G14899: + bis $31, TypeLocative, $8 # [1] + stl $5, 8($12) # [0di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + and $7, 63, $8 # set CDR-NEXT [1] + stl $19, 8($12) # [1di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, G14902 # [1-] +.align 3 +G14898: + addq $5, 1, $1 # length=array+1 [1-] +/* Memory Read Internal */ +G14953: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $23 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $21 # [1-] + ldq_u $4, 0($23) # [1di] + subq $1, $7, $7 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $8, $8 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $4, $23, $4 # [1-] + bne $8, G14955 # [0di] +G14954: + lda $23, 240 # [1-] + srl $24, $4, $24 # [1] + srl $23, $4, $23 # [1] + extll $21, 0, $21 # [1] + blbs $24, G14957 # [1-] +G14964: + subq $4, TypeFixnum, $1 # [0di] + and $1, 63, $1 # Strip CDR code [1] + bne $1, G14894 # [1] + addq $5, 2, $1 # offset=array+2 [1] +/* Memory Read Internal */ +G14965: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $23 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $20 # [1-] + ldq_u $4, 0($23) # [1di] + subq $1, $7, $7 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $8, $8 # In range? [1-] + ldl $20, 0($20) # [0di] + extbl $4, $23, $4 # [1-] + bne $8, G14967 # [0di] +G14966: + lda $23, 240 # [1-] + srl $24, $4, $24 # [1] + srl $23, $4, $23 # [1] + extll $20, 0, $20 # [1] + blbs $24, G14969 # [1-] +G14976: + subq $4, TypeFixnum, $1 # [0di] + and $1, 63, $1 # Strip CDR code [1] + bne $1, G14894 # [1] + addq $5, 3, $1 # next=array+3 [1] +/* Memory Read Internal */ +G14977: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $23 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $5 # [1-] + ldq_u $4, 0($23) # [1di] + subq $1, $7, $7 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $8, $8 # In range? [1-] + ldl $5, 0($5) # [0di] + extbl $4, $23, $4 # [1-] + bne $8, G14979 # [0di] +G14978: + lda $23, 240 # [1-] + srl $24, $4, $24 # [1] + srl $23, $4, $23 # [1] + extll $5, 0, $5 # [1] + blbs $24, G14981 # [1-] +G14988: + subq $31, $16, $8 # [0di] + srl $21, $8, $8 # [1] + sll $21, $16, $23 # [1] + cmovle $16, $8, $23 # [1] + addq $19, $18, $8 # [1] + cmovle $23, $8, $23 # [1] + subq $23, $8, $7 # [2] + cmovle $7, $23, $8 # [1] + bis $8, $31, $19 # [2] + and $4, 63, $8 # Strip off any CDR code bits. [1] + cmpeq $8, TypeLocative, $23 # [1] +.align 3 +G14996: + beq $23, G14990 # [1] +/* Here if argument TypeLocative */ + br $31, G14895 # [1] +.align 3 +G14990: + cmpeq $8, TypeFixnum, $23 # [1-] +.align 3 +G14997: + beq $23, G14991 # [1] +/* Here if argument TypeFixnum */ + br $31, G14895 # [1] +.align 3 +G14991: + cmpeq $8, TypeArray, $23 # [1-] +.align 3 +G14998: + beq $23, G14992 # [1] +/* Here if argument TypeArray */ +.align 3 +G14900: + subq $31, $16, $7 # [1-] + srl $20, $7, $7 # [1] + sll $20, $16, $18 # [1] + cmovle $16, $7, $18 # [1] + addq $2, $18, $2 # [2] + br $31, G14896 # [0di] +.align 3 +G14992: + cmpeq $8, TypeString, $23 # [1-] +.align 3 +G14999: + beq $23, G14993 # [1] +/* Here if argument TypeString */ + br $31, G14900 # [1] +.align 3 +G14993: +/* Here for all other cases */ + br $31, G14894 # [1] +.align 3 +G14989: +.align 3 +G14942: + cmpeq $23, TypeString, $24 # [1-] +.align 3 +G15006: + beq $24, G15000 # [1] +/* Here if argument TypeString */ + br $31, G14901 # [1] +.align 3 +G15000: +/* Here for all other cases */ + br $31, G14894 # [1] +.align 3 +G14939: +.align 3 +G14894: + bis $31, ReturnValueException, $2 # [1-] + ret $31, ($0), 1 # [1] +.align 3 +G14902: + bis $31, ReturnValueNormal, $2 # [3] + ret $31, ($0), 1 # [1] +.align 3 +G14979: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $5, 0($7) # [2] + ldl $4, 4($7) # Read from stack cache [1] + br $31, G14978 # [1] +.align 3 +G14981: + blbc $23, G14980 # [1] + extll $5, 0, $1 # Do the indirect thing [0di] + br $31, G14977 # [1-] +.align 3 +G14980: + ldq $24, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +.align 3 +G14985: + and $24, MemoryActionTransform, $23 # [3] + beq $23, G14984 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G14988 # [1-] +#ifndef MINIMA +G14984: +#endif +#ifdef MINIMA +.align 3 +G14984: + and $24, MemoryActionBinding, $23 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $23, G14983 # [1-] + sll $1, 1, $7 # [0di] + ldq $23, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $23, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $5, 4($8) # Fetch value [1] + subl $1, $7, $23 # Compare [2di] + bne $23, G14987 # Trap on miss [1] + extll $5, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14977 # This is another memory read tailcall. [1-] +.align 3 +G14987: + br $31, DBCACHEMISSTRAP +#endif +G14983: +/* Perform memory action */ + bis $31, $24, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14967: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $20, 0($7) # [2] + ldl $4, 4($7) # Read from stack cache [1] + br $31, G14966 # [1] +.align 3 +G14969: + blbc $23, G14968 # [1] + extll $20, 0, $1 # Do the indirect thing [0di] + br $31, G14965 # [1-] +.align 3 +G14968: + ldq $24, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +.align 3 +G14973: + and $24, MemoryActionTransform, $23 # [3] + beq $23, G14972 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G14976 # [1-] +#ifndef MINIMA +G14972: +#endif +#ifdef MINIMA +.align 3 +G14972: + and $24, MemoryActionBinding, $23 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $23, G14971 # [1-] + sll $1, 1, $7 # [0di] + ldq $23, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $23, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $20, 4($8) # Fetch value [1] + subl $1, $7, $23 # Compare [2di] + bne $23, G14975 # Trap on miss [1] + extll $20, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14965 # This is another memory read tailcall. [1-] +.align 3 +G14975: + br $31, DBCACHEMISSTRAP +#endif +G14971: +/* Perform memory action */ + bis $31, $24, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14955: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $21, 0($7) # [2] + ldl $4, 4($7) # Read from stack cache [1] + br $31, G14954 # [1] +.align 3 +G14957: + blbc $23, G14956 # [1] + extll $21, 0, $1 # Do the indirect thing [0di] + br $31, G14953 # [1-] +.align 3 +G14956: + ldq $24, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +.align 3 +G14961: + and $24, MemoryActionTransform, $23 # [3] + beq $23, G14960 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G14964 # [1-] +#ifndef MINIMA +G14960: +#endif +#ifdef MINIMA +.align 3 +G14960: + and $24, MemoryActionBinding, $23 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $23, G14959 # [1-] + sll $1, 1, $7 # [0di] + ldq $23, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $23, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $21, 4($8) # Fetch value [1] + subl $1, $7, $23 # Compare [2di] + bne $23, G14963 # Trap on miss [1] + extll $21, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14953 # This is another memory read tailcall. [1-] +.align 3 +G14963: + br $31, DBCACHEMISSTRAP +#endif +G14959: +/* Perform memory action */ + bis $31, $24, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14945: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $4, 0($7) # [2] + ldl $6, 4($7) # Read from stack cache [1] + br $31, G14944 # [1] +.align 3 +G14947: + blbc $23, G14946 # [1] + extll $4, 0, $5 # Do the indirect thing [0di] + br $31, G14943 # [1-] +.align 3 +G14946: + ldq $24, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $6, 63, $23 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +G14949: +/* Perform memory action */ + bis $31, $24, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14929: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $5, 0($7) # [2] + ldl $6, 4($7) # Read from stack cache [1] + br $31, G14928 # [1] +.align 3 +G14931: + blbc $23, G14930 # [1] + extll $5, 0, $1 # Do the indirect thing [0di] + br $31, G14927 # [1-] +.align 3 +G14930: + ldq $24, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $6, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +.align 3 +G14935: + and $24, MemoryActionTransform, $23 # [3] + beq $23, G14934 # [1] + bic $6, 63, $6 # [1-] + bis $6, TypeExternalValueCellPointer, $6 # [1] + br $31, G14938 # [1-] +#ifndef MINIMA +G14934: +#endif +#ifdef MINIMA +.align 3 +G14934: + and $24, MemoryActionBinding, $23 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $23, G14933 # [1-] + sll $1, 1, $7 # [0di] + ldq $23, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $23, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $5, 4($8) # Fetch value [1] + subl $1, $7, $23 # Compare [2di] + bne $23, G14937 # Trap on miss [1] + extll $5, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14927 # This is another memory read tailcall. [1-] +.align 3 +G14937: + br $31, DBCACHEMISSTRAP +#endif +G14933: +/* Perform memory action */ + bis $31, $24, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14917: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $18, 0($7) # [2] + ldl $6, 4($7) # Read from stack cache [1] + br $31, G14916 # [1] +.align 3 +G14919: + blbc $23, G14918 # [1] + extll $18, 0, $1 # Do the indirect thing [0di] + br $31, G14915 # [1-] +.align 3 +G14918: + ldq $24, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $6, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +.align 3 +G14923: + and $24, MemoryActionTransform, $23 # [3] + beq $23, G14922 # [1] + bic $6, 63, $6 # [1-] + bis $6, TypeExternalValueCellPointer, $6 # [1] + br $31, G14926 # [1-] +#ifndef MINIMA +G14922: +#endif +#ifdef MINIMA +.align 3 +G14922: + and $24, MemoryActionBinding, $23 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $23, G14921 # [1-] + sll $1, 1, $7 # [0di] + ldq $23, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $23, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $18, 4($8) # Fetch value [1] + subl $1, $7, $23 # Compare [2di] + bne $23, G14925 # Trap on miss [1] + extll $18, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14915 # This is another memory read tailcall. [1-] +.align 3 +G14925: + br $31, DBCACHEMISSTRAP +#endif +G14921: +/* Perform memory action */ + bis $31, $24, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14905: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $19, 0($7) # [2] + ldl $6, 4($7) # Read from stack cache [1] + br $31, G14904 # [1] +.align 3 +G14907: + blbc $23, G14906 # [1] + extll $19, 0, $1 # Do the indirect thing [0di] + br $31, G14903 # [1-] +.align 3 +G14906: + ldq $24, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $6, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +.align 3 +G14911: + and $24, MemoryActionTransform, $23 # [3] + beq $23, G14910 # [1] + bic $6, 63, $6 # [1-] + bis $6, TypeExternalValueCellPointer, $6 # [1] + br $31, G14914 # [1-] +#ifndef MINIMA +G14910: +#endif +#ifdef MINIMA +.align 3 +G14910: + and $24, MemoryActionBinding, $23 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $23, G14909 # [1-] + sll $1, 1, $7 # [0di] + ldq $23, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $23, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $19, 4($8) # Fetch value [1] + subl $1, $7, $23 # Compare [2di] + bne $23, G14913 # Trap on miss [1] + extll $19, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14903 # This is another memory read tailcall. [1-] +.align 3 +G14913: + br $31, DBCACHEMISSTRAP +#endif +G14909: +/* Perform memory action */ + bis $31, $24, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.end Setup1DLongArray +.align 5 +.globl DoFastAset1 +.ent DoFastAset1 0 +/* Halfword operand from stack instruction - DoFastAset1 */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoFastAset1FP + .globl DoFastAset1SP + .globl DoFastAset1LP + .globl DoFastAset1IM +.align 3 +DoFastAset1: +#ifdef TRACING + .byte 0x88 + .asciiz "DoFastAset1SP" +#endif +.align 3 +DoFastAset1SP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoFastAset1 # [0di] + .byte 0x90 + .asciiz "DoFastAset1LP" +#endif +.align 3 +DoFastAset1LP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoFastAset1 # [1] + .byte 0x84 + .asciiz "DoFastAset1FP" +#endif +.align 3 +DoFastAset1FP: # Entry point for FP relative +.align 3 +beginDoFastAset1: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $19, 0($12) # Index [0di] + ldl $18, 4($12) # Index [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + ldl $24, 0($12) # value [1di] + ldl $23, 4($12) # value [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $24, 0, $24 # [1] + subq $18, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, FASTASET1IOP # [1] +.align 3 +FASTASET1RETRY: + ldl $21, 0($16) # [1-] + ldl $22, 8($16) # [1] + ldl $3, 16($16) # [1] + extll $21, 0, $21 # [1di] + extll $22, 0, $22 # [1] + sll $21, 42, $5 # [1] + extll $3, 0, $3 # [1] + ldq $4, PROCESSORSTATE_AREVENTCOUNT($14) # [0di] + srl $5, 42, $5 # [1-] + cmpult $19, $3, $2 # [1] + beq $2, FASTASET1BOUNDS # [1] + subq $4, $5, $6 # [0di] + bne $6, Aset1RecomputeArrayRegister # [1] + srl $21, ArrayRegisterBytePackingPos, $6 # [1] + srl $21, ArrayRegisterByteOffsetPos, $7 # [1] + srl $21, ArrayRegisterElementTypePos, $8 # [1] + and $6, ArrayRegisterBytePackingMask, $6 # [1] + and $7, ArrayRegisterByteOffsetMask, $7 # [1] + and $8, ArrayRegisterElementTypeMask, $8 # [1] +/* Element checking and foreplay. */ +/* TagType. */ + and $23, 63, $1 # [1] + cmpeq $8, ArrayElementTypeCharacter, $25 # [1] +.align 3 +G15017: + beq $25, G15013 # [1] +/* Here if argument ArrayElementTypeCharacter */ + subq $1, TypeCharacter, $2 # [0di] + beq $2, G15008 # [1] + bis $31, 0, $20 # [0di] + bis $31, 29, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15008: + beq $6, G15007 # Certainly will fit if not packed! [1-] + bis $31, 32, $2 # [0di] + srl $2, $6, $2 # Compute size of byte [1] + ornot $31, $31, $1 # [1] + sll $1, $2, $1 # [1] + ornot $31, $1, $1 # Compute mask for byte [2] + and $24, $1, $1 # [1] + subq $24, $1, $1 # [1] + beq $1, G15007 # J. if character fits. [1] + bis $31, 0, $20 # [0di] + bis $31, 62, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15013: + cmpeq $8, ArrayElementTypeFixnum, $25 # [1] +.align 3 +G15018: + beq $25, G15014 # [1] +/* Here if argument ArrayElementTypeFixnum */ + subq $1, TypeFixnum, $2 # [0di] + beq $2, G15007 # [1] + bis $31, 0, $20 # [0di] + bis $31, 33, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15014: + cmpeq $8, ArrayElementTypeBoolean, $25 # [1] +.align 3 +G15019: + beq $25, G15012 # [1] +/* Here if argument ArrayElementTypeBoolean */ + bis $31, 1, $24 # [0di] + subq $1, TypeNIL, $1 # [1] + bne $1, G15007 # J. if True [1] + bis $31, $31, $24 # [1-] + br $31, G15007 # J. if False [0di] +.align 3 +G15012: +/* Shove it in. */ +.align 3 +G15007: + bne $6, G15009 # J. if packed [1] + subq $8, ArrayElementTypeObject, $1 # [0di] + bne $1, G15009 # [1] +/* Here for the simple non packed case */ + addq $22, $19, $1 # [1] +/* Memory Read Internal */ +G15020: + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $1, $14, $25 # [0di] + ldl $5, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $25, $31, $3 # [0di] + ldq_u $2, 0($25) # [1-] + subq $1, $4, $4 # Stack cache offset [1di] + ldq $18, PROCESSORSTATE_DATAWRITE_MASK($14) # [1-] + cmpult $4, $5, $5 # In range? [0di] + ldl $3, 0($3) # [1-] + extbl $2, $25, $2 # [0di] + bne $5, G15022 # [1-] +G15021: + lda $25, 240 # [0di] + srl $18, $2, $18 # [1] + srl $25, $2, $25 # [1] + blbs $18, G15024 # [1-] +G15030: +/* Merge cdr-code */ + and $23, 63, $3 # [0di] + and $2, 192, $2 # [1] + bis $2, $3, $2 # [1] + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + addq $1, $14, $4 # [0di] + ldl $18, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $4, $31, $3 # [0di] + ldq_u $25, 0($4) # [1-] + subq $1, $5, $5 # Stack cache offset [1di] + cmpult $5, $18, $18 # In range? [1] + insbl $2, $4, $5 # [1] + mskbl $25, $4, $25 # [1] +.align 3 +G15032: + bis $25, $5, $25 # [2] + stq_u $25, 0($4) # [0di] + stl $24, 0($3) # [1] + bne $18, G15031 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +/* Here for the slow packed version */ +.align 3 +G15009: + addq $7, $19, $19 # [1-] + srl $19, $6, $1 # Convert byte index to word index [1] + addq $1, $22, $1 # Address of word containing byte [2] +/* Memory Read Internal */ +G15033: + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $4 # [1-] + ldl $3, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $4, $31, $22 # [1-] + ldq_u $20, 0($4) # [1di] + subq $1, $2, $2 # Stack cache offset [1-] + ldq $5, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $2, $3, $3 # In range? [1-] + ldl $22, 0($22) # [0di] + extbl $20, $4, $20 # [1-] + bne $3, G15035 # [0di] +G15034: + lda $4, 240 # [1-] + srl $5, $20, $5 # [1] + srl $4, $20, $4 # [1] + extll $22, 0, $22 # [1] + blbs $5, G15037 # [1-] +G15044: +/* Check fixnum element type */ +/* TagType. */ + and $20, 63, $2 # [0di] + subq $2, TypeFixnum, $2 # [1] + bne $2, G15010 # J. if element type not fixnum. [1] + beq $6, G15011 # J. if unpacked fixnum element type. [1] + ornot $31, $31, $25 # [0di] + sll $25, $6, $25 # [1] + subq $31, $6, $2 # [1] + bic $19, $25, $25 # Compute subword index [1] + addq $2, 5, $2 # [1] + sll $25, $2, $2 # Compute shift to get byte [1] + bis $31, 32, $25 # [1] + srl $25, $6, $25 # Compute size of byte [1] + ornot $31, $31, $3 # [1] + sll $3, $25, $3 # [1] + ornot $31, $3, $4 # Compute mask for byte [2] + beq $2, G15045 # inserting into the low byte is easy [1-] +/* Inserting the byte into any byte other than the low byte */ + addq $31, 64, $5 # [0di] + subq $5, $2, $25 # = the left shift rotate amount [1] + srl $22, $2, $5 # shift selected byte into low end of word. [1] + sll $22, $25, $22 # rotate low bits into high end of word. [1] + and $3, $5, $5 # Remove unwanted bits [1] + srl $22, $25, $22 # rotate low bits back into place. [1] + and $24, $4, $25 # Strip any extra bits from element [1] + bis $25, $5, $5 # Insert new bits. [1] + sll $5, $2, $5 # reposition bits [1] + bis $22, $5, $22 # Replace low order bits [2] + br $31, G15046 # [0di] +.align 3 +G15045: +/* Inserting the byte into the low byte */ + and $22, $3, $22 # Remove the old low byte [1-] + and $24, $4, $25 # Remove unwanted bits from the new byte [1] + bis $22, $25, $22 # Insert the new byte in place of the old byte [1] +.align 3 +G15046: + bis $22, $31, $24 # [1] +.align 3 +G15011: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + addq $1, $14, $2 # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $2, $31, $5 # [0di] + ldq_u $4, 0($2) # [1-] + subq $1, $3, $3 # Stack cache offset [1di] + cmpult $3, $25, $25 # In range? [1] + insbl $20, $2, $3 # [1] + mskbl $4, $2, $4 # [1] +.align 3 +G15048: + bis $4, $3, $4 # [2] + stq_u $4, 0($2) # [0di] + stl $24, 0($5) # [1] + bne $25, G15047 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15010: + bis $31, $1, $20 # [1-] + bis $31, 25, $17 # [1] + br $31, ILLEGALOPERAND # packed array data not in fixnum +.align 3 +FASTASET1IOP: + bis $31, 0, $20 # [1] + bis $31, 32, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +FASTASET1BOUNDS: + bis $31, 0, $20 # [1] + bis $31, 13, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15047: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15049: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $3, $3 # Stack cache offset [2di] + s8addq $3, $2, $2 # reconstruct SCA [1] + stl $24, 0($2) # Store in stack [2] + stl $20, 4($2) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15035: + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $2, $3, $2 # reconstruct SCA [3] + ldl $22, 0($2) # [2] + ldl $20, 4($2) # Read from stack cache [1] + br $31, G15034 # [1] +.align 3 +G15037: + blbc $4, G15036 # [1] + extll $22, 0, $1 # Do the indirect thing [0di] + br $31, G15033 # [1-] +.align 3 +G15036: + ldq $5, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $4 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $4, $5, $4 # Adjust for a longword load [2di] + ldl $5, 0($4) # Get the memory action [2] +.align 3 +G15041: + and $5, MemoryActionTransform, $4 # [3] + beq $4, G15040 # [1] + bic $20, 63, $20 # [1-] + bis $20, TypeExternalValueCellPointer, $20 # [1] + br $31, G15044 # [1-] +#ifndef MINIMA +G15040: +#endif +#ifdef MINIMA +.align 3 +G15040: + and $5, MemoryActionBinding, $4 # [1-] + ldq $3, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $4, G15039 # [1-] + sll $1, 1, $2 # [0di] + ldq $4, PROCESSORSTATE_DBCBASE($14) # [1-] + and $2, $3, $2 # Hash index [1di] + bis $31, 1, $3 # [1] + sll $3, IvoryMemoryData, $3 # [1] + addl $2, $4, $2 # [1] + extll $2, 0, $2 # Clear sign-extension [1] + s4addq $2, $3, $3 # [2] + ldl $2, 0($3) # Fetch the key [2] + ldl $22, 4($3) # Fetch value [1] + subl $1, $2, $4 # Compare [2di] + bne $4, G15043 # Trap on miss [1] + extll $22, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G15033 # This is another memory read tailcall. [1-] +.align 3 +G15043: + br $31, DBCACHEMISSTRAP +#endif +G15039: +/* Perform memory action */ + bis $31, $5, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15031: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15050: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $5, $5 # Stack cache offset [2di] + s8addq $5, $4, $4 # reconstruct SCA [1] + stl $24, 0($4) # Store in stack [2] + stl $2, 4($4) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15022: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $4, $5, $4 # reconstruct SCA [3] + ldl $3, 0($4) # [2] + ldl $2, 4($4) # Read from stack cache [1] + br $31, G15021 # [1] +.align 3 +G15024: + blbc $25, G15023 # [1] + extll $3, 0, $1 # Do the indirect thing [0di] + br $31, G15020 # [1-] +.align 3 +G15023: + ldq $18, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $25 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $25, $18, $25 # Adjust for a longword load [2di] + ldl $18, 0($25) # Get the memory action [2] +#ifndef MINIMA +G15027: +#endif +#ifdef MINIMA +.align 3 +G15027: + and $18, MemoryActionBinding, $25 # [3] + ldq $5, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $25, G15026 # [1-] + sll $1, 1, $4 # [0di] + ldq $25, PROCESSORSTATE_DBCBASE($14) # [1-] + and $4, $5, $4 # Hash index [1di] + bis $31, 1, $5 # [1] + sll $5, IvoryMemoryData, $5 # [1] + addl $4, $25, $4 # [1] + extll $4, 0, $4 # Clear sign-extension [1] + s4addq $4, $5, $5 # [2] + ldl $4, 0($5) # Fetch the key [2] + ldl $3, 4($5) # Fetch value [1] + subl $1, $4, $25 # Compare [2di] + bne $25, G15029 # Trap on miss [1] + extll $3, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G15020 # This is another memory read tailcall. [1-] +.align 3 +G15029: + br $31, DBCACHEMISSTRAP +#endif +G15026: +/* Perform memory action */ + bis $31, $18, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoFastAset1IM" +#endif +DoFastAset1IM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoFastAset1. +.end DoFastAset1 +/* End of Halfword operand from stack instruction - DoFastAset1 */ +/* Array leaders. */ +.align 5 +.globl DoArrayLeader +.ent DoArrayLeader 0 +/* Halfword operand from stack instruction - DoArrayLeader */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoArrayLeaderFP + .globl DoArrayLeaderSP + .globl DoArrayLeaderLP + .globl DoArrayLeaderIM +.align 3 +DoArrayLeader: +#ifdef TRACING + .byte 0x88 + .asciiz "DoArrayLeaderSP" +#endif +.align 3 +DoArrayLeaderSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoArrayLeader # [0di] + .byte 0x90 + .asciiz "DoArrayLeaderLP" +#endif +.align 3 +DoArrayLeaderLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoArrayLeader # [1] + .byte 0x84 + .asciiz "DoArrayLeaderFP" +#endif +.align 3 +DoArrayLeaderFP: # Entry point for FP relative +.align 3 +headDoArrayLeader: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoArrayLeader: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # arg3=arraytag, arg4=arraydata [1] + ldl $18, 4($12) # arg3=arraytag, arg4=arraydata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + extll $16, 0, $17 # index data [1] + srl $16, 32, $16 # index tag [1] + subq $16, TypeFixnum, $1 # [2] + and $1, 63, $1 # Strip CDR code [1] + bne $1, ARRAYLEADERIOP # [1] +.align 3 +ARRAYLEADERMERGE: + subq $18, TypeArray, $1 # [1] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, ARRAYLEADEREXCEPTION # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G15051: + addq $19, $14, $3 # [0di] + s4addq $3, $31, $20 # [1] + ldq_u $21, 0($3) # [1di] + subq $19, $24, $1 # Stack cache offset [1-] + ldq $4, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $1, $25, $2 # In range? [1-] + ldl $20, 0($20) # [0di] + extbl $21, $3, $21 # [1-] + bne $2, G15053 # [0di] +G15052: + lda $3, 64 # [1-] + srl $4, $21, $4 # [1] + srl $3, $21, $3 # [1] + blbs $4, G15055 # [1di] +G15060: +/* TagType. */ + and $21, 63, $1 # [1-] + subq $1, TypeHeaderI, $1 # [1] + bne $1, ARRAYLEADERIOP # [1] + srl $20, ArrayLeaderLengthFieldPos, $8 # [0di] + and $8, ArrayLeaderLengthFieldMask, $8 # [2] + cmpult $17, $8, $1 # [1] + beq $1, ARRAYLEADERBOUNDS # [1] + subq $19, $17, $17 # [0di] + subq $17, 1, $17 # [1] +/* Memory Read Internal */ +G15061: + addq $17, $14, $3 # [1] + s4addq $3, $31, $20 # [1] + ldq_u $21, 0($3) # [1di] + subq $17, $24, $1 # Stack cache offset [1-] + ldq $4, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $1, $25, $2 # In range? [1-] + ldl $20, 0($20) # [0di] + extbl $21, $3, $21 # [1-] + bne $2, G15063 # [0di] +G15062: + lda $3, 240 # [1-] + srl $4, $21, $4 # [1] + srl $3, $21, $3 # [1] + blbs $4, G15065 # [1di] +G15072: + and $21, 63, $1 # set CDR-NEXT [1-] + stl $20, 8($12) # [0di] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +ARRAYLEADEREXCEPTION: + bis $31, TypeFixnum, $16 # [1-] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $18, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 10, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +ARRAYLEADERIOP: + bis $31, 0, $20 # [1] + bis $31, 10, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +ARRAYLEADERBOUNDS: + bis $31, 0, $20 # [1] + bis $31, 74, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + br $31, DoArrayLeaderIM # [1-] + .byte 0x82 + .asciiz "DoArrayLeaderIM" +#endif +.align 5 +.align 3 +DoArrayLeaderIM: # Entry point for IMMEDIATE mode + ldl $19, 0($12) # arg3=arraytag, arg4=arraydata [1] + ldl $18, 4($12) # arg3=arraytag, arg4=arraydata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + br $31, ARRAYLEADERMERGE # [1-] +.align 3 +G15063: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $20, 0($1) # [2] + ldl $21, 4($1) # Read from stack cache [1] + br $31, G15062 # [1] +.align 3 +G15065: + blbc $3, G15064 # [1] + extll $20, 0, $17 # Do the indirect thing [0di] + br $31, G15061 # [1-] +.align 3 +G15064: + ldq $4, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $21, 63, $3 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $4, $3 # Adjust for a longword load [2di] + ldl $4, 0($3) # Get the memory action [2] +.align 3 +G15069: + and $4, MemoryActionTransform, $3 # [3] + beq $3, G15068 # [1] + bic $21, 63, $21 # [1-] + bis $21, TypeExternalValueCellPointer, $21 # [1] + br $31, G15072 # [1-] +#ifndef MINIMA +G15068: +#endif +#ifdef MINIMA +.align 3 +G15068: + and $4, MemoryActionBinding, $3 # [1-] + ldq $2, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $3, G15067 # [1-] + sll $17, 1, $1 # [0di] + ldq $3, PROCESSORSTATE_DBCBASE($14) # [1-] + and $1, $2, $1 # Hash index [1di] + bis $31, 1, $2 # [1] + sll $2, IvoryMemoryData, $2 # [1] + addl $1, $3, $1 # [1] + extll $1, 0, $1 # Clear sign-extension [1] + s4addq $1, $2, $2 # [2] + ldl $1, 0($2) # Fetch the key [2] + ldl $20, 4($2) # Fetch value [1] + subl $17, $1, $3 # Compare [2di] + bne $3, G15071 # Trap on miss [1] + extll $20, 0, $17 # Extract the pointer, and indirect [0di] + br $31, G15061 # This is another memory read tailcall. [1-] +.align 3 +G15071: + br $31, DBCACHEMISSTRAP +#endif +G15067: +/* Perform memory action */ + bis $31, $4, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15053: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $20, 0($1) # [2] + ldl $21, 4($1) # Read from stack cache [1] + br $31, G15052 # [1] +.align 3 +G15055: + blbc $3, G15054 # [1] + extll $20, 0, $19 # Do the indirect thing [0di] + br $31, G15051 # [1-] +.align 3 +G15054: + ldq $4, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $21, 63, $3 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $4, $3 # Adjust for a longword load [2di] + ldl $4, 0($3) # Get the memory action [2] +G15057: +/* Perform memory action */ + bis $31, $4, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoArrayLeader +/* End of Halfword operand from stack instruction - DoArrayLeader */ +.align 5 +.globl DoStoreArrayLeader +.ent DoStoreArrayLeader 0 +/* Halfword operand from stack instruction - DoStoreArrayLeader */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoStoreArrayLeaderFP + .globl DoStoreArrayLeaderSP + .globl DoStoreArrayLeaderLP + .globl DoStoreArrayLeaderIM +.align 3 +DoStoreArrayLeader: +#ifdef TRACING + .byte 0x88 + .asciiz "DoStoreArrayLeaderSP" +#endif +.align 3 +DoStoreArrayLeaderSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoStoreArrayLeader # [0di] + .byte 0x90 + .asciiz "DoStoreArrayLeaderLP" +#endif +.align 3 +DoStoreArrayLeaderLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoStoreArrayLeader # [1] + .byte 0x84 + .asciiz "DoStoreArrayLeaderFP" +#endif +.align 3 +DoStoreArrayLeaderFP: # Entry point for FP relative +.align 3 +headDoStoreArrayLeader: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoStoreArrayLeader: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # arg3=arraytag, arg4=arraydata [1] + ldl $18, 4($12) # arg3=arraytag, arg4=arraydata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + ldl $7, 0($12) # t6=valuetag, t7=valuedata [1-] + ldl $6, 4($12) # t6=valuetag, t7=valuedata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $7, 0, $7 # [1] + extll $16, 0, $17 # index data [1] + srl $16, 32, $16 # index tag [1] + subq $16, TypeFixnum, $1 # [2] + and $1, 63, $1 # Strip CDR code [1] + bne $1, STOREARRAYLEADERIOP # [1] +.align 3 +STOREARRAYLEADERMERGE: + subq $18, TypeArray, $1 # [1] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, STOREARRAYLEADEREXCEPTION # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G15073: + addq $19, $14, $3 # [0di] + s4addq $3, $31, $20 # [1] + ldq_u $21, 0($3) # [1di] + subq $19, $24, $1 # Stack cache offset [1-] + ldq $4, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $1, $25, $2 # In range? [1-] + ldl $20, 0($20) # [0di] + extbl $21, $3, $21 # [1-] + bne $2, G15075 # [0di] +G15074: + lda $3, 64 # [1-] + srl $4, $21, $4 # [1] + srl $3, $21, $3 # [1] + blbs $4, G15077 # [1di] +G15082: +/* TagType. */ + and $21, 63, $1 # [1-] + subq $1, TypeHeaderI, $1 # [1] + bne $1, STOREARRAYLEADERIOP # [1] + srl $20, ArrayLeaderLengthFieldPos, $2 # [0di] + and $2, ArrayLeaderLengthFieldMask, $2 # [2] + cmpult $17, $2, $1 # [1] + beq $1, STOREARRAYLEADERBOUNDS # [1] + subq $19, $17, $17 # [0di] + subq $17, 1, $17 # [1] +/* Memory Read Internal */ +G15083: + addq $17, $14, $5 # [1] + s4addq $5, $31, $2 # [1] + ldq_u $1, 0($5) # [1di] + subq $17, $24, $3 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAWRITE_MASK($14) # [0di] + cmpult $3, $25, $4 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $5, $1 # [1-] + bne $4, G15085 # [0di] +G15084: + lda $5, 240 # [1-] + srl $8, $1, $8 # [1] + srl $5, $1, $5 # [1] + blbs $8, G15087 # [1di] +G15093: +/* Merge cdr-code */ + and $6, 63, $2 # [1-] + and $1, 192, $1 # [1] + bis $1, $2, $1 # [1] + addq $17, $14, $3 # [1] + s4addq $3, $31, $2 # [1] + ldq_u $5, 0($3) # [1di] + subq $17, $24, $4 # Stack cache offset [1-] + cmpult $4, $25, $8 # In range? [1] + insbl $1, $3, $4 # [1] + mskbl $5, $3, $5 # [1] +.align 3 +G15095: + bis $5, $4, $5 # [2] + stq_u $5, 0($3) # [0di] + stl $7, 0($2) # [1] + bne $8, G15094 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +STOREARRAYLEADEREXCEPTION: + bis $31, TypeFixnum, $16 # [1-] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $18, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 3, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 11, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +STOREARRAYLEADERIOP: + bis $31, 0, $20 # [1] + bis $31, 11, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +STOREARRAYLEADERBOUNDS: + bis $31, 0, $20 # [1] + bis $31, 74, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + br $31, DoStoreArrayLeaderIM # [1-] + .byte 0x82 + .asciiz "DoStoreArrayLeaderIM" +#endif +.align 5 +.align 3 +DoStoreArrayLeaderIM: # Entry point for IMMEDIATE mode + ldl $19, 0($12) # arg3=arraytag, arg4=arraydata [1] + ldl $18, 4($12) # arg3=arraytag, arg4=arraydata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + ldl $7, 0($12) # t6=valuetag, t7=valuedata [1-] + ldl $6, 4($12) # t6=valuetag, t7=valuedata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $7, 0, $7 # [1] + br $31, STOREARRAYLEADERMERGE # [1-] +.align 3 +G15094: + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $17, $24, $4 # Stack cache offset [0di] + s8addq $4, $3, $3 # reconstruct SCA [3] + stl $7, 0($3) # Store in stack [2] + stl $1, 4($3) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15085: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $2, 0($3) # [2] + ldl $1, 4($3) # Read from stack cache [1] + br $31, G15084 # [1] +.align 3 +G15087: + blbc $5, G15086 # [1] + extll $2, 0, $17 # Do the indirect thing [0di] + br $31, G15083 # [1-] +.align 3 +G15086: + ldq $8, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $5 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $5, $8, $5 # Adjust for a longword load [2di] + ldl $8, 0($5) # Get the memory action [2] +#ifndef MINIMA +G15090: +#endif +#ifdef MINIMA +.align 3 +G15090: + and $8, MemoryActionBinding, $5 # [3] + ldq $4, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $5, G15089 # [1-] + sll $17, 1, $3 # [0di] + ldq $5, PROCESSORSTATE_DBCBASE($14) # [1-] + and $3, $4, $3 # Hash index [1di] + bis $31, 1, $4 # [1] + sll $4, IvoryMemoryData, $4 # [1] + addl $3, $5, $3 # [1] + extll $3, 0, $3 # Clear sign-extension [1] + s4addq $3, $4, $4 # [2] + ldl $3, 0($4) # Fetch the key [2] + ldl $2, 4($4) # Fetch value [1] + subl $17, $3, $5 # Compare [2di] + bne $5, G15092 # Trap on miss [1] + extll $2, 0, $17 # Extract the pointer, and indirect [0di] + br $31, G15083 # This is another memory read tailcall. [1-] +.align 3 +G15092: + br $31, DBCACHEMISSTRAP +#endif +G15089: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15075: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $20, 0($1) # [2] + ldl $21, 4($1) # Read from stack cache [1] + br $31, G15074 # [1] +.align 3 +G15077: + blbc $3, G15076 # [1] + extll $20, 0, $19 # Do the indirect thing [0di] + br $31, G15073 # [1-] +.align 3 +G15076: + ldq $4, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $21, 63, $3 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $4, $3 # Adjust for a longword load [2di] + ldl $4, 0($3) # Get the memory action [2] +G15079: +/* Perform memory action */ + bis $31, $4, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoStoreArrayLeader +/* End of Halfword operand from stack instruction - DoStoreArrayLeader */ +.align 5 +.globl DoAlocLeader +.ent DoAlocLeader 0 +/* Halfword operand from stack instruction - DoAlocLeader */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAlocLeaderFP + .globl DoAlocLeaderSP + .globl DoAlocLeaderLP + .globl DoAlocLeaderIM +.align 3 +DoAlocLeader: +#ifdef TRACING + .byte 0x88 + .asciiz "DoAlocLeaderSP" +#endif +.align 3 +DoAlocLeaderSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAlocLeader # [0di] + .byte 0x90 + .asciiz "DoAlocLeaderLP" +#endif +.align 3 +DoAlocLeaderLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAlocLeader # [1] + .byte 0x84 + .asciiz "DoAlocLeaderFP" +#endif +.align 3 +DoAlocLeaderFP: # Entry point for FP relative +.align 3 +headDoAlocLeader: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAlocLeader: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # arg3=arraytag, arg4=arraydata [1] + ldl $18, 4($12) # arg3=arraytag, arg4=arraydata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + extll $16, 0, $17 # index data [1] + srl $16, 32, $16 # index tag [1] + subq $16, TypeFixnum, $1 # [2] + and $1, 63, $1 # Strip CDR code [1] + bne $1, ALOCLEADERIOP # [1] +.align 3 +ALOCLEADERMERGE: + subq $18, TypeArray, $1 # [1] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, ALOCLEADEREXCEPTION # [1] +/* Memory Read Internal */ +G15096: + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1] + addq $19, $14, $3 # [1-] + ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $3, $31, $20 # [1-] + ldq_u $21, 0($3) # [1di] + subq $19, $1, $1 # Stack cache offset [1-] + ldq $4, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $1, $2, $2 # In range? [1-] + ldl $20, 0($20) # [0di] + extbl $21, $3, $21 # [1-] + bne $2, G15098 # [0di] +G15097: + lda $3, 64 # [1-] + srl $4, $21, $4 # [1] + srl $3, $21, $3 # [1] + blbs $4, G15100 # [1di] +G15105: +/* TagType. */ + and $21, 63, $1 # [1-] + subq $1, TypeHeaderI, $1 # [1] + bne $1, ALOCLEADERIOP # [1] + srl $20, ArrayLeaderLengthFieldPos, $22 # [0di] + and $22, ArrayLeaderLengthFieldMask, $22 # [2] + cmpult $17, $22, $1 # [1] + beq $1, ALOCLEADERBOUNDS # [1] + subq $19, $17, $17 # [0di] + subq $17, 1, $17 # [1] + bis $31, TypeLocative, $1 # [1] + stl $17, 8($12) # [1-] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +ALOCLEADEREXCEPTION: + bis $31, TypeFixnum, $16 # [1-] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $18, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 10, $17 # [1] + br $31, ARRAYEXCEPTION +.align 3 +ALOCLEADERIOP: + bis $31, 0, $20 # [1] + bis $31, 10, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +ALOCLEADERBOUNDS: + bis $31, 0, $20 # [1] + bis $31, 74, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + br $31, DoAlocLeaderIM # [1-] + .byte 0x82 + .asciiz "DoAlocLeaderIM" +#endif +.align 5 +.align 3 +DoAlocLeaderIM: # Entry point for IMMEDIATE mode + ldl $19, 0($12) # arg3=arraytag, arg4=arraydata [1] + ldl $18, 4($12) # arg3=arraytag, arg4=arraydata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + br $31, ALOCLEADERMERGE # [1-] +.align 3 +G15098: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $20, 0($1) # [2] + ldl $21, 4($1) # Read from stack cache [1] + br $31, G15097 # [1] +.align 3 +G15100: + blbc $3, G15099 # [1] + extll $20, 0, $19 # Do the indirect thing [0di] + br $31, G15096 # [1-] +.align 3 +G15099: + ldq $4, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $21, 63, $3 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $4, $3 # Adjust for a longword load [2di] + ldl $4, 0($3) # Get the memory action [2] +G15102: +/* Perform memory action */ + bis $31, $4, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoAlocLeader +/* End of Halfword operand from stack instruction - DoAlocLeader */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunarra.as */ diff --git a/alpha-emulator/ifunbind.as b/alpha-emulator/ifunbind.as new file mode 100644 index 0000000..82a324d --- /dev/null +++ b/alpha-emulator/ifunbind.as @@ -0,0 +1,169 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Binding Instructions.") + +;;+++ Figure out if we can use WITH-MULTIPLE-MEMORY-READS +(define-instruction |DoBindLocativeToValue| :operand-from-stack-signed-immediate () + (stack-pop2 arg5 arg6 "ltag/ldata") + (LDQ arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (SRL arg1 32 arg2 "new tag") + (LDQ arg4 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory)) + (EXTLL arg1 0 arg1 "new data") + (CheckDataType arg5 |TypeLocative| bindloctovaliop t1) + (passthru "#ifdef MINIMA") + (SRL arg3 32 t2) + (passthru "#endif") + (EXTLL arg3 0 arg3) + (EXTLL arg4 0 arg4) + (SUBQ arg3 arg4 t1) + (BGE t1 bindloctovalov "J. if binding stack overflow") + (ADDQ arg3 1 t3) + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (CheckDataType t2 |TypeLocative| bindloctovaldeep t1) + (passthru "#endif") + (get-control-register t9) + (BIS arg6 zero t8) + (memory-read t8 t2 t1 PROCESSORSTATE_BINDREAD t4 t5 t6 t7 nil t) + ;; set the ls cdcode bit for ltag ifcleanupbindings + (SRL t9 #.(- 25 6) t10) + (TagType arg5 t8) + (AND t10 #x40 t10 "Extract the CR.cleanup-bindings bit") + (BIS t10 t8 t11) + (memory-write t3 t11 arg6 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (ADDQ arg3 2 t3) + (memory-write t3 t2 t1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (load-constant t1 #.1_25 "cr.cleanup-bindings") + (store-contents arg6 arg2 arg1 PROCESSORSTATE_BINDWRITE t4 t5 t6 t7 t8 t10) + (BIS t1 t9 t9 "Set cr.cleanup-bindings bit") + (set-control-register t9) + (STL t3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory) "vma only") + (ContinueToNextInstruction) + (label bindloctovalov) + (illegal-operand binding-stack-overflow) + (label bindloctovaliop) ;+++ exception if spare pointer type + (illegal-operand bind-locative-type-error) + (label bindloctovaldeep) + (LDQ t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand shallow-binding-operation-in-deep-binding-mode t2)) + +;;+++ Figure out if we can use WITH-MULTIPLE-MEMORY-READS +(define-instruction |DoBindLocative| :operand-from-stack () + (LDQ arg1 0 (arg1) "Get the operand") + (LDQ arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (SRL arg1 32 arg5 "tag") + (LDQ arg4 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory)) + (EXTLL arg1 0 arg6 "data") + (CheckDataType arg5 |TypeLocative| bindlociop t1) + (passthru "#ifdef MINIMA") + (SRL arg3 32 t2) + (passthru "#endif") + (EXTLL arg3 0 arg3) + (EXTLL arg4 0 arg4) + (SUBQ arg3 arg4 t1) + (BGE t1 bindlocov "J. if binding stack overflow") + (ADDQ arg3 1 t3) + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (CheckDataType t2 |TypeLocative| bindlocdeep t1) + (passthru "#endif") + (get-control-register t9) + (BIS arg6 zero t8) + (memory-read t8 t2 t1 PROCESSORSTATE_BINDREAD t4 t5 t6 t7 nil t) + ;; set the ls cdcode bit for ltag ifcleanupbindings + (SRL t9 #.(- 25 6) t10) + (TagType arg5 t8) + (AND t10 #x40 t10 "Extract the CR.cleanup-bindings bit") + (BIS t10 t8 t11) + (memory-write t3 t11 arg6 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (ADDQ arg3 2 t3) + (memory-write t3 t2 t1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (load-constant t1 #.1_25 "cr.cleanup-bindings") + (BIS t1 t9 t9 "Set cr.cleanup-bindings bit") + (set-control-register t9) + (STL t3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory) "vma only") + (ContinueToNextInstruction) + (label bindlocov) + (illegal-operand binding-stack-overflow) + (label bindlociop) + (illegal-operand bind-locative-type-error) + (label bindlocdeep) + (LDQ t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand shallow-binding-operation-in-deep-binding-mode t2)) + + +;(align16k) + +(define-instruction |DoUnbindN| :operand-from-stack-immediate () + (passthru "#ifdef MINIMA") + (LDQ arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (passthru "#endif") + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (CheckDataType arg2 |TypeFixnum| unbindniop t1) + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (SRL arg3 32 t2) + (CheckDataType t2 |TypeLocative| unbindndeep t1) + (passthru "#endif") + (with-multiple-memory-reads (t9 t10 t11 t12) + (BR zero unbindnendloop) + (label unbindntoploop) + (SUBQ arg1 1 arg1) + (unbind t1 t2 t3 t4 t5 t6 t7 t8 arg3 arg4 arg5 arg6) + (label unbindnendloop) + (BGT arg1 unbindntoploop) + ;; After we've unbound everything, check for a preempt request + (check-preempt-request NextInstruction t3 t4) + (ContinueToNextInstruction)) + (label unbindniop) + (illegal-operand one-operand-fixnum-type-error) + (passthru "#ifdef MINIMA") + (label unbindndeep) + (LDQ t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand shallow-binding-operation-in-deep-binding-mode t2) + (passthru "#endif")) + + +(define-instruction |DoRestoreBindingStack| :operand-from-stack-immediate () + (passthru "#ifdef MINIMA") + (LDQ arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (passthru "#endif") + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (CheckDataType arg2 |TypeLocative| restorebsiop t1) + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (SRL arg3 32 t2) + (CheckDataType t2 |TypeLocative| restorebsdeep t1) + (passthru "#endif") + (LDQ t1 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (BR zero restorebsendloop) + (label restorebstoploop) + ;; Leaves T1 as the new binding stack pointer + (unbind t1 t2 t3 t4 t5 t6 t7 t8 arg3 arg4 arg5 arg6) + (label restorebsendloop) + (SUBL t1 arg1 arg4) + (BGT arg4 restorebstoploop) + ;; After we've unbound everything, check for a preempt request + (check-preempt-request NextInstruction t3 t4) + (ContinueToNextInstruction)) + (label restorebsiop) + (illegal-operand operand-locative-type-error) + (passthru "#ifdef MINIMA") + (label restorebsdeep) + (LDQ t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand operand-locative-type-error t2) + (passthru "#endif")) + + +(comment "Fin.") diff --git a/alpha-emulator/ifunbind.s b/alpha-emulator/ifunbind.s new file mode 100644 index 0000000..65c60b8 --- /dev/null +++ b/alpha-emulator/ifunbind.s @@ -0,0 +1,1056 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunbind.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Binding Instructions. */ +.align 5 +.globl DoBindLocativeToValue +.ent DoBindLocativeToValue 0 +/* Halfword operand from stack instruction - DoBindLocativeToValue */ + .globl DoBindLocativeToValueFP + .globl DoBindLocativeToValueSP + .globl DoBindLocativeToValueLP + .globl DoBindLocativeToValueIM +.align 3 +DoBindLocativeToValue: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoBindLocativeToValueIM" +#endif +.align 3 +DoBindLocativeToValueIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G15776: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoBindLocativeToValue # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoBindLocativeToValueSP" +#endif +.align 3 +DoBindLocativeToValueSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoBindLocativeToValue # [0di] + .byte 0x90 + .asciiz "DoBindLocativeToValueLP" +#endif +.align 3 +DoBindLocativeToValueLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoBindLocativeToValue # [1] + .byte 0x84 + .asciiz "DoBindLocativeToValueFP" +#endif +.align 3 +DoBindLocativeToValueFP: # Entry point for FP relative +.align 3 +headDoBindLocativeToValue: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoBindLocativeToValue: +/* arg1 has the operand, sign extended if immediate. */ + ldl $21, 0($12) # ltag/ldata [1] + ldl $20, 4($12) # ltag/ldata [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $21, 0, $21 # [1] + ldq $18, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1-] + srl $16, 32, $17 # new tag [0di] + ldq $19, PROCESSORSTATE_BINDINGSTACKLIMIT($14) # [1-] + extll $16, 0, $16 # new data [0di] + subq $20, TypeLocative, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, BINDLOCTOVALIOP # [1] +#ifdef MINIMA + srl $18, 32, $2 # [0di] +#endif + extll $18, 0, $18 # [1] + extll $19, 0, $19 # [1] + subq $18, $19, $1 # [2] + bge $1, BINDLOCTOVALOV # J. if binding stack overflow [1] + addq $18, 1, $3 # [1-] +#ifdef MINIMA +/* BSP not a locative -> Deep-bound */ + subq $2, TypeLocative, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, BINDLOCTOVALDEEP # [1] +#endif + ldl $22, PROCESSORSTATE_CONTROL($14) # [1-] + bis $21, $31, $8 # [0di] +/* Memory Read Internal */ +G15744: + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $8, $14, $6 # [0di] + ldl $5, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $6, $31, $1 # [0di] + ldq_u $2, 0($6) # [1-] + subq $8, $4, $4 # Stack cache offset [1di] + ldq $7, PROCESSORSTATE_BINDREAD_MASK($14) # [1-] + cmpult $4, $5, $5 # In range? [0di] + ldl $1, 0($1) # [1-] + extbl $2, $6, $2 # [0di] + bne $5, G15746 # [1-] +G15745: + lda $6, 224 # [0di] + srl $7, $2, $7 # [1] + srl $6, $2, $6 # [1] + blbs $7, G15748 # [1-] +G15753: + srl $22, 19, $23 # [0di] +/* TagType. */ + and $20, 63, $8 # [1] + and $23, 64, $23 # Extract the CR.cleanup-bindings bit [1] + bis $23, $8, $24 # [1] + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $3, $14, $4 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $4, $31, $7 # [1-] + ldq_u $6, 0($4) # [1di] + subq $3, $5, $5 # Stack cache offset [1-] + cmpult $5, $8, $8 # In range? [1] + insbl $24, $4, $5 # [1] + mskbl $6, $4, $6 # [1] +.align 3 +G15756: + bis $6, $5, $6 # [2] + stq_u $6, 0($4) # [0di] + stl $21, 0($7) # [1] + bne $8, G15755 # J. if in cache [1] +G15754: + addq $18, 2, $3 # [1-] + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $3, $14, $4 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $4, $31, $7 # [1-] + ldq_u $6, 0($4) # [1di] + subq $3, $5, $5 # Stack cache offset [1-] + cmpult $5, $8, $8 # In range? [1] + insbl $2, $4, $5 # [1] + mskbl $6, $4, $6 # [1] +.align 3 +G15759: + bis $6, $5, $6 # [2] + stq_u $6, 0($4) # [0di] + stl $1, 0($7) # [1] + bne $8, G15758 # J. if in cache [1] +G15757: + ldah $1, 512 # [1-] +/* Memory Read Internal */ +G15760: + ldq $6, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $21, $14, $8 # [1-] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $8, $31, $5 # [1-] + ldq_u $4, 0($8) # [1di] + subq $21, $6, $6 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_BINDWRITE_MASK($14) # [0di] + cmpult $6, $7, $7 # In range? [1-] + ldl $5, 0($5) # [0di] + extbl $4, $8, $4 # [1-] + bne $7, G15762 # [0di] +G15761: + lda $8, 224 # [1-] + srl $23, $4, $23 # [1] + srl $8, $4, $8 # [1] + blbs $23, G15764 # [1di] +G15769: +/* Merge cdr-code */ + and $17, 63, $5 # [1-] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $21, $14, $6 # [1-] + ldl $23, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $6, $31, $5 # [1-] + ldq_u $8, 0($6) # [1di] + subq $21, $7, $7 # Stack cache offset [1-] + cmpult $7, $23, $23 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G15772: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $16, 0($5) # [1] + bne $23, G15771 # J. if in cache [1] +G15770: + bis $1, $22, $22 # Set cr.cleanup-bindings bit [1-] + stl $22, PROCESSORSTATE_CONTROL($14) # [0di] + stl $3, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # vma only [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +BINDLOCTOVALOV: + bis $31, 0, $20 # [1-] + bis $31, 19, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +BINDLOCTOVALIOP: + bis $31, 0, $20 # [1] + bis $31, 18, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +BINDLOCTOVALDEEP: + ldq $1, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] +/* Convert stack cache address to VMA */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $1, $3, $3 # stack cache base relative offset [2di] + srl $3, 3, $3 # convert byte address to word address [1] + addq $3, $2, $2 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 72, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15771: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15773: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $21, $7, $7 # Stack cache offset [2di] + s8addq $7, $6, $6 # reconstruct SCA [1] + stl $16, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, G15770 # [1] +.align 3 +G15762: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G15761 # [1] +.align 3 +G15764: + blbc $8, G15763 # [1] + extll $5, 0, $21 # Do the indirect thing [0di] + br $31, G15760 # [1-] +.align 3 +G15763: + ldq $23, PROCESSORSTATE_BINDWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $21, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $23, $8 # Adjust for a longword load [2di] + ldl $23, 0($8) # Get the memory action [2] +G15766: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 3, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15758: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15774: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $3, $5, $5 # Stack cache offset [2di] + s8addq $5, $4, $4 # reconstruct SCA [1] + stl $1, 0($4) # Store in stack [2] + stl $2, 4($4) # write the stack cache [1] + br $31, G15757 # [1] +.align 3 +G15755: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] +.align 3 +G15775: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $3, $5, $5 # Stack cache offset [2di] + s8addq $5, $4, $4 # reconstruct SCA [1] + stl $21, 0($4) # Store in stack [2] + stl $24, 4($4) # write the stack cache [1] + br $31, G15754 # [1] +.align 3 +G15746: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $4, $5, $4 # reconstruct SCA [3] + ldl $1, 0($4) # [2] + ldl $2, 4($4) # Read from stack cache [1] + br $31, G15745 # [1] +.align 3 +G15748: + blbc $6, G15747 # [1] + extll $1, 0, $8 # Do the indirect thing [0di] + br $31, G15744 # [1-] +.align 3 +G15747: + ldq $7, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $8, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $7, $6 # Adjust for a longword load [2di] + ldl $7, 0($6) # Get the memory action [2] +G15750: +/* Perform memory action */ + bis $31, $7, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoBindLocativeToValue +/* End of Halfword operand from stack instruction - DoBindLocativeToValue */ +.align 5 +.globl DoBindLocative +.ent DoBindLocative 0 +/* Halfword operand from stack instruction - DoBindLocative */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoBindLocativeFP + .globl DoBindLocativeSP + .globl DoBindLocativeLP + .globl DoBindLocativeIM +.align 3 +DoBindLocative: +#ifdef TRACING + .byte 0x88 + .asciiz "DoBindLocativeSP" +#endif +.align 3 +DoBindLocativeSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoBindLocative # [0di] + .byte 0x90 + .asciiz "DoBindLocativeLP" +#endif +.align 3 +DoBindLocativeLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoBindLocative # [1] + .byte 0x84 + .asciiz "DoBindLocativeFP" +#endif +.align 3 +DoBindLocativeFP: # Entry point for FP relative +.align 3 +beginDoBindLocative: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] + ldq $18, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] + srl $16, 32, $20 # tag [2di] + ldq $19, PROCESSORSTATE_BINDINGSTACKLIMIT($14) # [1-] + extll $16, 0, $21 # data [0di] + subq $20, TypeLocative, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, BINDLOCIOP # [1] +#ifdef MINIMA + srl $18, 32, $2 # [0di] +#endif + extll $18, 0, $18 # [1] + extll $19, 0, $19 # [1] + subq $18, $19, $1 # [2] + bge $1, BINDLOCOV # J. if binding stack overflow [1] + addq $18, 1, $3 # [1-] +#ifdef MINIMA +/* BSP not a locative -> Deep-bound */ + subq $2, TypeLocative, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, BINDLOCDEEP # [1] +#endif + ldl $22, PROCESSORSTATE_CONTROL($14) # [1-] + bis $21, $31, $8 # [0di] +/* Memory Read Internal */ +G15777: + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $8, $14, $6 # [0di] + ldl $5, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $6, $31, $1 # [0di] + ldq_u $2, 0($6) # [1-] + subq $8, $4, $4 # Stack cache offset [1di] + ldq $7, PROCESSORSTATE_BINDREAD_MASK($14) # [1-] + cmpult $4, $5, $5 # In range? [0di] + ldl $1, 0($1) # [1-] + extbl $2, $6, $2 # [0di] + bne $5, G15779 # [1-] +G15778: + lda $6, 224 # [0di] + srl $7, $2, $7 # [1] + srl $6, $2, $6 # [1] + blbs $7, G15781 # [1-] +G15786: + srl $22, 19, $23 # [0di] +/* TagType. */ + and $20, 63, $8 # [1] + and $23, 64, $23 # Extract the CR.cleanup-bindings bit [1] + bis $23, $8, $24 # [1] + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $3, $14, $4 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $4, $31, $7 # [1-] + ldq_u $6, 0($4) # [1di] + subq $3, $5, $5 # Stack cache offset [1-] + cmpult $5, $8, $8 # In range? [1] + insbl $24, $4, $5 # [1] + mskbl $6, $4, $6 # [1] +.align 3 +G15789: + bis $6, $5, $6 # [2] + stq_u $6, 0($4) # [0di] + stl $21, 0($7) # [1] + bne $8, G15788 # J. if in cache [1] +G15787: + addq $18, 2, $3 # [1-] + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $3, $14, $4 # [1-] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $4, $31, $7 # [1-] + ldq_u $6, 0($4) # [1di] + subq $3, $5, $5 # Stack cache offset [1-] + cmpult $5, $8, $8 # In range? [1] + insbl $2, $4, $5 # [1] + mskbl $6, $4, $6 # [1] +.align 3 +G15792: + bis $6, $5, $6 # [2] + stq_u $6, 0($4) # [0di] + stl $1, 0($7) # [1] + bne $8, G15791 # J. if in cache [1] +G15790: + ldah $1, 512 # [1-] + bis $1, $22, $22 # Set cr.cleanup-bindings bit [1] + stl $22, PROCESSORSTATE_CONTROL($14) # [1-] + stl $3, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # vma only [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +BINDLOCOV: + bis $31, 0, $20 # [1-] + bis $31, 19, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +BINDLOCIOP: + bis $31, 0, $20 # [1] + bis $31, 18, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +BINDLOCDEEP: + ldq $1, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] +/* Convert stack cache address to VMA */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $1, $3, $3 # stack cache base relative offset [2di] + srl $3, 3, $3 # convert byte address to word address [1] + addq $3, $2, $2 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 72, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15791: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15793: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $3, $5, $5 # Stack cache offset [2di] + s8addq $5, $4, $4 # reconstruct SCA [1] + stl $1, 0($4) # Store in stack [2] + stl $2, 4($4) # write the stack cache [1] + br $31, G15790 # [1] +.align 3 +G15788: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] +.align 3 +G15794: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $3, $5, $5 # Stack cache offset [2di] + s8addq $5, $4, $4 # reconstruct SCA [1] + stl $21, 0($4) # Store in stack [2] + stl $24, 4($4) # write the stack cache [1] + br $31, G15787 # [1] +.align 3 +G15779: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $4, $5, $4 # reconstruct SCA [3] + ldl $1, 0($4) # [2] + ldl $2, 4($4) # Read from stack cache [1] + br $31, G15778 # [1] +.align 3 +G15781: + blbc $6, G15780 # [1] + extll $1, 0, $8 # Do the indirect thing [0di] + br $31, G15777 # [1-] +.align 3 +G15780: + ldq $7, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $8, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $7, $6 # Adjust for a longword load [2di] + ldl $7, 0($6) # Get the memory action [2] +G15783: +/* Perform memory action */ + bis $31, $7, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoBindLocativeIM" +#endif +DoBindLocativeIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoBindLocative. +.end DoBindLocative +/* End of Halfword operand from stack instruction - DoBindLocative */ +.align 5 +.globl DoUnbindN +.ent DoUnbindN 0 +/* Halfword operand from stack instruction - DoUnbindN */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoUnbindNFP + .globl DoUnbindNSP + .globl DoUnbindNLP + .globl DoUnbindNIM +.align 3 +DoUnbindN: +#ifdef TRACING + .byte 0x82 + .asciiz "DoUnbindNIM" +#endif +.align 3 +DoUnbindNIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoUnbindN # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoUnbindNSP" +#endif +.align 3 +DoUnbindNSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoUnbindN # [0di] + .byte 0x90 + .asciiz "DoUnbindNLP" +#endif +.align 3 +DoUnbindNLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoUnbindN # [1] + .byte 0x84 + .asciiz "DoUnbindNFP" +#endif +.align 3 +DoUnbindNFP: # Entry point for FP relative +.align 3 +headDoUnbindN: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoUnbindN: +/* arg1 has the operand, not sign extended if immediate. */ +#ifdef MINIMA + ldq $18, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] +#endif + srl $16, 32, $17 # [2di] + extll $16, 0, $16 # [1] + subq $17, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, UNBINDNIOP # [1] +#ifdef MINIMA +/* BSP not a locative -> Deep-bound */ + srl $18, 32, $2 # [1-] + subq $2, TypeLocative, $1 # [2] + and $1, 63, $1 # Strip CDR code [1] + bne $1, UNBINDNDEEP # [1] +#endif + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + br $31, UNBINDNENDLOOP # [1] +.align 3 +UNBINDNTOPLOOP: + subq $16, 1, $16 # [1-] + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [0di] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1] + extll $1, 0, $1 # vma only [2di] + ldah $2, 512 # [1] + subq $1, 1, $5 # [1] + and $4, $2, $3 # [1] + bic $4, $2, $4 # Turn off the bit [1] + bne $3, G15795 # [1-] + ldq $4, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [0di] + bis $31, 0, $20 # [1-] + bis $31, 20, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15795: +/* Memory Read Internal */ +G15796: + addq $1, $14, $19 # [1] + s4addq $19, $31, $6 # [1] + ldq_u $7, 0($19) # [1-] + subq $1, $24, $8 # Stack cache offset [0di] + ldq $20, PROCESSORSTATE_BINDREAD_MASK($14) # [1-] + cmpult $8, $25, $18 # In range? [0di] + ldl $6, 0($6) # [1-] + extbl $7, $19, $7 # [1di] + bne $18, G15798 # [1-] +G15797: + lda $19, 224 # [0di] + srl $20, $7, $20 # [1] + srl $19, $7, $19 # [1] + blbs $20, G15800 # [1-] +G15805: +/* Memory Read Internal */ +G15806: + addq $5, $14, $19 # [0di] + s4addq $19, $31, $2 # [1] + ldq_u $3, 0($19) # [1di] + subq $5, $24, $8 # Stack cache offset [1-] + ldq $20, PROCESSORSTATE_BINDREAD_MASK($14) # [0di] + cmpult $8, $25, $18 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $3, $19, $3 # [1-] + bne $18, G15808 # [0di] +G15807: + lda $19, 224 # [1-] + srl $20, $3, $20 # [1] + srl $19, $3, $19 # [1] + extll $2, 0, $2 # [1] + blbs $20, G15810 # [1-] +G15815: +/* Memory Read Internal */ +G15816: + addq $2, $14, $21 # [1di] + s4addq $21, $31, $18 # [1] + ldq_u $8, 0($21) # [1di] + subq $2, $24, $19 # Stack cache offset [1-] + cmpult $19, $25, $20 # In range? [1] + ldl $18, 0($18) # [1-] + extbl $8, $21, $8 # [0di] + bne $20, G15818 # [1-] +G15817: + ldq $19, PROCESSORSTATE_BINDWRITE_MASK($14) # [0di] + lda $21, 224 # [1-] + srl $19, $8, $19 # [2] + srl $21, $8, $21 # [1] + blbs $19, G15820 # [1di] +G15825: +/* Merge cdr-code */ + and $7, 63, $18 # [1-] + and $8, 192, $8 # [1] + bis $8, $18, $8 # [1] + addq $2, $14, $19 # [1] + s4addq $19, $31, $18 # [1] + ldq_u $21, 0($19) # [1di] + insbl $8, $19, $20 # [1-] + mskbl $21, $19, $21 # [2] +.align 3 +G15828: + bis $21, $20, $21 # [2] + stq_u $21, 0($19) # [0di] + ldl $19, PROCESSORSTATE_SCOVLIMIT($14) # [1] + subq $2, $24, $20 # Stack cache offset [0di] + cmpult $20, $19, $19 # In range? [3] + stl $6, 0($18) # [0di] + bne $19, G15827 # J. if in cache [1] +G15826: + and $3, 64, $3 # Get the old cleanup-bindings bit [0di] + sll $3, 19, $3 # [1] + subq $1, 2, $1 # [1] + stl $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # vma only [1-] + bis $4, $3, $4 # [0di] + stl $4, PROCESSORSTATE_CONTROL($14) # [1-] +.align 3 +UNBINDNENDLOOP: + bgt $16, UNBINDNTOPLOOP # [1] + ldl $3, PROCESSORSTATE_INTERRUPTREG($14) # [0di] + and $3, 2, $4 # [3] + cmpeq $4, 2, $4 # [1] + bis $3, $4, $3 # [2] + stl $3, PROCESSORSTATE_INTERRUPTREG($14) # [0di] + beq $3, NEXTINSTRUCTION # [1] + stq $3, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +UNBINDNIOP: + bis $31, 0, $20 # [1-] + bis $31, 63, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef MINIMA +.align 3 +UNBINDNDEEP: + ldq $1, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] +/* Convert stack cache address to VMA */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $1, $3, $3 # stack cache base relative offset [2di] + srl $3, 3, $3 # convert byte address to word address [1] + addq $3, $2, $2 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 72, $17 # [1] + br $31, ILLEGALOPERAND +#endif +.align 3 +G15827: + ldq $19, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $20, $19, $19 # reconstruct SCA [3] + stl $6, 0($19) # Store in stack [2] + stl $8, 4($19) # write the stack cache [1] + br $31, G15826 # [1] +.align 3 +G15818: + ldq $20, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $19, $20, $19 # reconstruct SCA [3] + ldl $18, 0($19) # [2] + ldl $8, 4($19) # Read from stack cache [1] + br $31, G15817 # [1] +.align 3 +G15820: + blbc $21, G15819 # [1] + extll $18, 0, $2 # Do the indirect thing [0di] + br $31, G15816 # [1-] +.align 3 +G15819: + ldq $19, PROCESSORSTATE_BINDWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $8, 63, $21 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $21, $19, $21 # Adjust for a longword load [2di] + ldl $19, 0($21) # Get the memory action [2] +G15822: +/* Perform memory action */ + bis $31, $19, $16 # [3] + bis $31, 3, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15808: + ldq $18, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $18, $8 # reconstruct SCA [3] + ldl $2, 0($8) # [2] + ldl $3, 4($8) # Read from stack cache [1] + br $31, G15807 # [1] +.align 3 +G15810: + blbc $19, G15809 # [1] + extll $2, 0, $5 # Do the indirect thing [0di] + br $31, G15806 # [1-] +.align 3 +G15809: + ldq $20, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $3, 63, $19 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $19, $20, $19 # Adjust for a longword load [2di] + ldl $20, 0($19) # Get the memory action [2] +G15812: +/* Perform memory action */ + bis $31, $20, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15798: + ldq $18, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $18, $8 # reconstruct SCA [3] + ldl $6, 0($8) # [2] + ldl $7, 4($8) # Read from stack cache [1] + br $31, G15797 # [1] +.align 3 +G15800: + blbc $19, G15799 # [1] + extll $6, 0, $1 # Do the indirect thing [0di] + br $31, G15796 # [1-] +.align 3 +G15799: + ldq $20, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $7, 63, $19 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $19, $20, $19 # Adjust for a longword load [2di] + ldl $20, 0($19) # Get the memory action [2] +G15802: +/* Perform memory action */ + bis $31, $20, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoUnbindN +/* End of Halfword operand from stack instruction - DoUnbindN */ +.align 5 +.globl DoRestoreBindingStack +.ent DoRestoreBindingStack 0 +/* Halfword operand from stack instruction - DoRestoreBindingStack */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoRestoreBindingStackFP + .globl DoRestoreBindingStackSP + .globl DoRestoreBindingStackLP + .globl DoRestoreBindingStackIM +.align 3 +DoRestoreBindingStack: +#ifdef TRACING + .byte 0x82 + .asciiz "DoRestoreBindingStackIM" +#endif +.align 3 +DoRestoreBindingStackIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoRestoreBindingStack # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoRestoreBindingStackSP" +#endif +.align 3 +DoRestoreBindingStackSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoRestoreBindingStack # [0di] + .byte 0x90 + .asciiz "DoRestoreBindingStackLP" +#endif +.align 3 +DoRestoreBindingStackLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoRestoreBindingStack # [1] + .byte 0x84 + .asciiz "DoRestoreBindingStackFP" +#endif +.align 3 +DoRestoreBindingStackFP: # Entry point for FP relative +.align 3 +headDoRestoreBindingStack: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoRestoreBindingStack: +/* arg1 has the operand, not sign extended if immediate. */ +#ifdef MINIMA + ldq $18, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] +#endif + srl $16, 32, $17 # [2di] + extll $16, 0, $16 # [1] + subq $17, TypeLocative, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, RESTOREBSIOP # [1] +#ifdef MINIMA +/* BSP not a locative -> Deep-bound */ + srl $18, 32, $2 # [1-] + subq $2, TypeLocative, $1 # [2] + and $1, 63, $1 # Strip CDR code [1] + bne $1, RESTOREBSDEEP # [1] +#endif + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + br $31, RESTOREBSENDLOOP # [1] +.align 3 +RESTOREBSTOPLOOP: + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1] + extll $1, 0, $1 # vma only [2-] + ldah $2, 512 # [1] + subq $1, 1, $5 # [1] + and $4, $2, $3 # [1] + bic $4, $2, $4 # Turn off the bit [1] + bne $3, G15829 # [0di] + ldq $4, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] + bis $31, 0, $20 # [0di] + bis $31, 20, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15829: +/* Memory Read Internal */ +G15830: + addq $1, $14, $19 # [1] + s4addq $19, $31, $6 # [1] + ldq_u $7, 0($19) # [1-] + subq $1, $24, $8 # Stack cache offset [0di] + ldq $20, PROCESSORSTATE_BINDREAD_MASK($14) # [1-] + cmpult $8, $25, $18 # In range? [0di] + ldl $6, 0($6) # [1-] + extbl $7, $19, $7 # [1di] + bne $18, G15832 # [1-] +G15831: + lda $19, 224 # [0di] + srl $20, $7, $20 # [1] + srl $19, $7, $19 # [1] + blbs $20, G15834 # [1-] +G15839: +/* Memory Read Internal */ +G15840: + addq $5, $14, $19 # [0di] + s4addq $19, $31, $2 # [1] + ldq_u $3, 0($19) # [1di] + subq $5, $24, $8 # Stack cache offset [1-] + ldq $20, PROCESSORSTATE_BINDREAD_MASK($14) # [0di] + cmpult $8, $25, $18 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $3, $19, $3 # [1-] + bne $18, G15842 # [0di] +G15841: + lda $19, 224 # [1-] + srl $20, $3, $20 # [1] + srl $19, $3, $19 # [1] + extll $2, 0, $2 # [1] + blbs $20, G15844 # [1-] +G15849: +/* Memory Read Internal */ +G15850: + addq $2, $14, $21 # [1di] + s4addq $21, $31, $18 # [1] + ldq_u $8, 0($21) # [1di] + subq $2, $24, $19 # Stack cache offset [1-] + cmpult $19, $25, $20 # In range? [1] + ldl $18, 0($18) # [1-] + extbl $8, $21, $8 # [0di] + bne $20, G15852 # [1-] +G15851: + ldq $19, PROCESSORSTATE_BINDWRITE_MASK($14) # [0di] + lda $21, 224 # [1-] + srl $19, $8, $19 # [2] + srl $21, $8, $21 # [1] + blbs $19, G15854 # [1di] +G15859: +/* Merge cdr-code */ + and $7, 63, $18 # [1-] + and $8, 192, $8 # [1] + bis $8, $18, $8 # [1] + addq $2, $14, $19 # [1] + s4addq $19, $31, $18 # [1] + ldq_u $21, 0($19) # [1di] + insbl $8, $19, $20 # [1-] + mskbl $21, $19, $21 # [2] +.align 3 +G15862: + bis $21, $20, $21 # [2] + stq_u $21, 0($19) # [0di] + ldl $19, PROCESSORSTATE_SCOVLIMIT($14) # [1] + subq $2, $24, $20 # Stack cache offset [0di] + cmpult $20, $19, $19 # In range? [3] + stl $6, 0($18) # [0di] + bne $19, G15861 # J. if in cache [1] +G15860: + and $3, 64, $3 # Get the old cleanup-bindings bit [0di] + sll $3, 19, $3 # [1] + subq $1, 2, $1 # [1] + stl $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # vma only [1-] + bis $4, $3, $4 # [0di] + stl $4, PROCESSORSTATE_CONTROL($14) # [1-] +.align 3 +RESTOREBSENDLOOP: + subl $1, $16, $19 # [1-] + bgt $19, RESTOREBSTOPLOOP # [1] + ldl $3, PROCESSORSTATE_INTERRUPTREG($14) # [1-] + and $3, 2, $4 # [3] + cmpeq $4, 2, $4 # [1] + bis $3, $4, $3 # [2] + stl $3, PROCESSORSTATE_INTERRUPTREG($14) # [1-] + beq $3, NEXTINSTRUCTION # [1] + stq $3, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +RESTOREBSIOP: + bis $31, 0, $20 # [1-] + bis $31, 66, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef MINIMA +.align 3 +RESTOREBSDEEP: + ldq $1, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] +/* Convert stack cache address to VMA */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $1, $3, $3 # stack cache base relative offset [2di] + srl $3, 3, $3 # convert byte address to word address [1] + addq $3, $2, $2 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 66, $17 # [1] + br $31, ILLEGALOPERAND +#endif +.align 3 +G15861: + ldq $19, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $20, $19, $19 # reconstruct SCA [3] + stl $6, 0($19) # Store in stack [2] + stl $8, 4($19) # write the stack cache [1] + br $31, G15860 # [1] +.align 3 +G15852: + ldq $20, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $19, $20, $19 # reconstruct SCA [3] + ldl $18, 0($19) # [2] + ldl $8, 4($19) # Read from stack cache [1] + br $31, G15851 # [1] +.align 3 +G15854: + blbc $21, G15853 # [1] + extll $18, 0, $2 # Do the indirect thing [0di] + br $31, G15850 # [1-] +.align 3 +G15853: + ldq $19, PROCESSORSTATE_BINDWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $8, 63, $21 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $21, $19, $21 # Adjust for a longword load [2di] + ldl $19, 0($21) # Get the memory action [2] +G15856: +/* Perform memory action */ + bis $31, $19, $16 # [3] + bis $31, 3, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15842: + ldq $18, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $18, $8 # reconstruct SCA [3] + ldl $2, 0($8) # [2] + ldl $3, 4($8) # Read from stack cache [1] + br $31, G15841 # [1] +.align 3 +G15844: + blbc $19, G15843 # [1] + extll $2, 0, $5 # Do the indirect thing [0di] + br $31, G15840 # [1-] +.align 3 +G15843: + ldq $20, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $3, 63, $19 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $19, $20, $19 # Adjust for a longword load [2di] + ldl $20, 0($19) # Get the memory action [2] +G15846: +/* Perform memory action */ + bis $31, $20, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15832: + ldq $18, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $18, $8 # reconstruct SCA [3] + ldl $6, 0($8) # [2] + ldl $7, 4($8) # Read from stack cache [1] + br $31, G15831 # [1] +.align 3 +G15834: + blbc $19, G15833 # [1] + extll $6, 0, $1 # Do the indirect thing [0di] + br $31, G15830 # [1-] +.align 3 +G15833: + ldq $20, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $7, 63, $19 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $19, $20, $19 # Adjust for a longword load [2di] + ldl $20, 0($19) # Get the memory action [2] +G15836: +/* Perform memory action */ + bis $31, $20, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoRestoreBindingStack +/* End of Halfword operand from stack instruction - DoRestoreBindingStack */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunbind.as */ diff --git a/alpha-emulator/ifunbits.as b/alpha-emulator/ifunbits.as new file mode 100644 index 0000000..bb63b8c --- /dev/null +++ b/alpha-emulator/ifunbits.as @@ -0,0 +1,110 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Bits.") + +(define-instruction |DoLogand| :operand-from-stack-immediate (:own-immediate t) + (ilogical logand AND) + (immediate-handler |DoLogand|) + (ilogical-immediate logand AND)) + +(define-instruction |DoLogior| :operand-from-stack-immediate (:own-immediate t) + (ilogical logior BIS) + (immediate-handler |DoLogior|) + (ilogical-immediate logior BIS)) + + +(define-instruction |DoLogxor| :operand-from-stack-immediate (:own-immediate t) + (ilogical logxor XOR) + (immediate-handler |DoLogxor|) + (ilogical-immediate logxor XOR)) + + +;;; arg1 on stack = number to shift +;;; arg2 operand = shift count +(define-instruction |DoAsh| :operand-from-stack-signed-immediate () + (stack-read2 iSP arg3 arg4 "Get ARG1.") + (SRL arg1 32 arg2 "Get ARG2's tag.") + (sign-extendq 32 arg1 arg1 "Sign extended the rotation amount.") + (binary-type-dispatch (arg2 arg3 t1 t2 t3 t4) + ((|TypeFixnum| |TypeFixnum|) + (BEQ arg4 zerash "B. if ash of zero -- trivial case") + (BLE arg1 negash "B. if negative ash.") + (sign-extendq 32 arg4 arg4 "Sign extend ARG1 before shifting.") + (SUBQ arg1 32 arg5) + (BGT arg5 ashovexc) + (SLL arg4 arg1 arg5 "Shift Left") + (XOR arg4 arg5 arg6) + (SRL arg6 31 arg6 "arg6<0>=1 if overflow, 0 otherwise") + (TagType arg2 arg2) ;strip cdr code from DTP-FIXNUM + (BNE arg6 ashovexc "J. if overflow") + (stack-write2 iSP arg2 arg5) ;simulate push. + (ContinueToNextInstruction) + (label negash) + (SUBQ zero arg1 arg1) + (sign-extendq 32 arg4 arg4 "Sign extend ARG1 before shifting.") + (SRA arg4 arg1 arg5 "Shift Right") + (TagType arg2 arg2) ;strip cdr code from DTP-FIXNUM + (stack-write2 iSP arg2 arg5) ;simulate push. + (ContinueToNextInstruction) + (label zerash) + (stack-write-ir |TypeFixnum| arg4 arg5) + (continueToNextInstruction)) + (:else1 + (EXTLL arg1 0 arg1) + (SetTag arg2 arg1 t2) + (NumericTypeException arg2 ash t2)) + (:else2 + (EXTLL arg1 0 arg1) + (SetTag arg2 arg1 t2) + (NumericTypeException arg3 ash t2))) + (label ashovexc) + (EXTLL arg1 0 arg1) + (SetTag arg2 arg1 t1) + (prepare-exception ash 0 t1 arg2) + (instruction-exception)) + +;;; Really signed-immediate but taking low five bits eliminates the need to be careful +(define-instruction |DoRot| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |DoRot|) + (AND t2 #x1F t2 "Get low 5 bits of the rotation") + (SLL t1 t2 t3 "Shift left to get new high bits") + (EXTLL t3 4 t6 "Get new low bits") + (BIS t3 t6 t3 "Glue two parts of shifted operand together"))) + +(define-instruction |DoLsh| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |DoLsh| nil t) + (BLT t2 neglsh "B. if negative lsh.") + ;;compare to 32, if greater, result is zero + (SUBQ t2 32 t3) + (BGE t3 returnzero) + (SLL t1 t2 t3 "Shift Left") + (BR zero lshdone) + (label neglsh) + (SUBQ zero t2 t2) + (SUBQ t2 32 t3) + (BGE T3 returnzero) + (SRL t1 t2 t3 "Shift Right") + (BR zero lshdone) + ;; BROKEN Non-branching version + ;; (AND t2 #x1F t4 "Get low 5 bits of the rotation") + ;; (SLL t1 t4 t6 "Shift Left") + ;; (EXTLL t6 4 t3 "Shift Right") + ;; (CMOVGE t2 t6 t3) + (label returnzero) + (BIC t3 t3 t3) ;answer is zero if (abs ) >= 32 + (label lshdone))) + + +(define-instruction |Do32BitPlus| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |Do32BitPlus|) + (ADDQ t1 t2 t3 "Perform the 32 bit Add."))) + +(define-instruction |Do32BitDifference| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |Do32BitDifference|) + (SUBQ t1 t2 t3 "Perform the 32 bit Difference."))) + +(comment "Fin.") diff --git a/alpha-emulator/ifunbits.s b/alpha-emulator/ifunbits.s new file mode 100644 index 0000000..49c258a --- /dev/null +++ b/alpha-emulator/ifunbits.s @@ -0,0 +1,846 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunbits.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Bits. */ +.align 5 +.globl DoLogand +.ent DoLogand 0 +/* Halfword operand from stack instruction - DoLogand */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoLogandFP + .globl DoLogandSP + .globl DoLogandLP + .globl DoLogandIM +.align 3 +DoLogand: +#ifdef TRACING + .byte 0x88 + .asciiz "DoLogandSP" +#endif +.align 3 +DoLogandSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoLogand # [0di] + .byte 0x90 + .asciiz "DoLogandLP" +#endif +.align 3 +DoLogandLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoLogand # [1] + .byte 0x84 + .asciiz "DoLogandFP" +#endif +.align 3 +DoLogandFP: # Entry point for FP relative +.align 3 +headDoLogand: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoLogand: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $3, 4($12) # Get tag from ARG1 [1] + ldl $4, 0($12) # Grab data for ARG1 [1] + extbl $16, 4, $1 # Get tag from ARG2 [1-] + subq $3, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15444 # [1] + subq $1, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15445 # [1] +/* Here we know that both args are fixnums! */ + and $4, $16, $4 # Do the operation [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, $31, $31 # [0] + extll $4, 0, $4 # Strip high bits [1] + bis $31, TypeFixnum, $1 # [1] + stl $4, 0($12) # Push result [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15444: # Here if ARG1 not fixnum + bis $31, $3, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15445: # Here if ARG2 not fixnum + bis $31, $1, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +#ifdef TRACING + br $31, DoLogandIM # [1-] + .byte 0x82 + .asciiz "DoLogandIM" +#endif +.align 5 +.align 3 +DoLogandIM: # Entry point for IMMEDIATE mode + ldl $3, 4($12) # Get tag from ARG1 [1] + sll $17, 56, $17 # [0di] + ldl $4, 0($12) # Grab data for ARG1 [1-] + sra $17, 56, $17 # [1di] + subq $3, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15446 # [1] +/* Here we know that both args are fixnums! */ + and $4, $17, $4 # Do the operation [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, $31, $31 # [0] + extll $4, 0, $4 # Strip high bits [1] + bis $31, TypeFixnum, $1 # [1] + stl $4, 0($12) # Push result [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15446: # Here if ARG1 not fixnum + bis $31, TypeFixnum, $16 # [1-] + extll $17, 0, $17 # [1] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $3, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.end DoLogand +/* End of Halfword operand from stack instruction - DoLogand */ +.align 5 +.globl DoLogior +.ent DoLogior 0 +/* Halfword operand from stack instruction - DoLogior */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoLogiorFP + .globl DoLogiorSP + .globl DoLogiorLP + .globl DoLogiorIM +.align 3 +DoLogior: +#ifdef TRACING + .byte 0x88 + .asciiz "DoLogiorSP" +#endif +.align 3 +DoLogiorSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoLogior # [0di] + .byte 0x90 + .asciiz "DoLogiorLP" +#endif +.align 3 +DoLogiorLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoLogior # [1] + .byte 0x84 + .asciiz "DoLogiorFP" +#endif +.align 3 +DoLogiorFP: # Entry point for FP relative +.align 3 +headDoLogior: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoLogior: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $3, 4($12) # Get tag from ARG1 [1] + ldl $4, 0($12) # Grab data for ARG1 [1] + extbl $16, 4, $1 # Get tag from ARG2 [1-] + subq $3, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15447 # [1] + subq $1, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15448 # [1] +/* Here we know that both args are fixnums! */ + bis $4, $16, $4 # Do the operation [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, $31, $31 # [0] + extll $4, 0, $4 # Strip high bits [1] + bis $31, TypeFixnum, $1 # [1] + stl $4, 0($12) # Push result [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15447: # Here if ARG1 not fixnum + bis $31, $3, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15448: # Here if ARG2 not fixnum + bis $31, $1, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +#ifdef TRACING + br $31, DoLogiorIM # [1-] + .byte 0x82 + .asciiz "DoLogiorIM" +#endif +.align 5 +.align 3 +DoLogiorIM: # Entry point for IMMEDIATE mode + ldl $3, 4($12) # Get tag from ARG1 [1] + sll $17, 56, $17 # [0di] + ldl $4, 0($12) # Grab data for ARG1 [1-] + sra $17, 56, $17 # [1di] + subq $3, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15449 # [1] +/* Here we know that both args are fixnums! */ + bis $4, $17, $4 # Do the operation [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, $31, $31 # [0] + extll $4, 0, $4 # Strip high bits [1] + bis $31, TypeFixnum, $1 # [1] + stl $4, 0($12) # Push result [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15449: # Here if ARG1 not fixnum + bis $31, TypeFixnum, $16 # [1-] + extll $17, 0, $17 # [1] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $3, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.end DoLogior +/* End of Halfword operand from stack instruction - DoLogior */ +.align 5 +.globl DoLogxor +.ent DoLogxor 0 +/* Halfword operand from stack instruction - DoLogxor */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoLogxorFP + .globl DoLogxorSP + .globl DoLogxorLP + .globl DoLogxorIM +.align 3 +DoLogxor: +#ifdef TRACING + .byte 0x88 + .asciiz "DoLogxorSP" +#endif +.align 3 +DoLogxorSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoLogxor # [0di] + .byte 0x90 + .asciiz "DoLogxorLP" +#endif +.align 3 +DoLogxorLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoLogxor # [1] + .byte 0x84 + .asciiz "DoLogxorFP" +#endif +.align 3 +DoLogxorFP: # Entry point for FP relative +.align 3 +headDoLogxor: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoLogxor: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $3, 4($12) # Get tag from ARG1 [1] + ldl $4, 0($12) # Grab data for ARG1 [1] + extbl $16, 4, $1 # Get tag from ARG2 [1-] + subq $3, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15450 # [1] + subq $1, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15451 # [1] +/* Here we know that both args are fixnums! */ + xor $4, $16, $4 # Do the operation [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, $31, $31 # [0] + extll $4, 0, $4 # Strip high bits [1] + bis $31, TypeFixnum, $1 # [1] + stl $4, 0($12) # Push result [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15450: # Here if ARG1 not fixnum + bis $31, $3, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15451: # Here if ARG2 not fixnum + bis $31, $1, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +#ifdef TRACING + br $31, DoLogxorIM # [1-] + .byte 0x82 + .asciiz "DoLogxorIM" +#endif +.align 5 +.align 3 +DoLogxorIM: # Entry point for IMMEDIATE mode + ldl $3, 4($12) # Get tag from ARG1 [1] + sll $17, 56, $17 # [0di] + ldl $4, 0($12) # Grab data for ARG1 [1-] + sra $17, 56, $17 # [1di] + subq $3, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, G15452 # [1] +/* Here we know that both args are fixnums! */ + xor $4, $17, $4 # Do the operation [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, $31, $31 # [0] + extll $4, 0, $4 # Strip high bits [1] + bis $31, TypeFixnum, $1 # [1] + stl $4, 0($12) # Push result [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15452: # Here if ARG1 not fixnum + bis $31, TypeFixnum, $16 # [1-] + extll $17, 0, $17 # [1] +/* SetTag. */ + sll $16, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $3, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.end DoLogxor +/* End of Halfword operand from stack instruction - DoLogxor */ +.align 5 +.globl DoAsh +.ent DoAsh 0 +/* Halfword operand from stack instruction - DoAsh */ + .globl DoAshFP + .globl DoAshSP + .globl DoAshLP + .globl DoAshIM +.align 3 +DoAsh: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoAshIM" +#endif +.align 3 +DoAshIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G15466: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoAsh # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoAshSP" +#endif +.align 3 +DoAshSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAsh # [0di] + .byte 0x90 + .asciiz "DoAshLP" +#endif +.align 3 +DoAshLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAsh # [1] + .byte 0x84 + .asciiz "DoAshFP" +#endif +.align 3 +DoAshFP: # Entry point for FP relative +.align 3 +headDoAsh: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAsh: +/* arg1 has the operand, sign extended if immediate. */ + ldl $19, 0($12) # Get ARG1. [1] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2-] + srl $16, 32, $17 # Get ARG2's tag. [1] + addl $16, $31, $16 # Sign extended the rotation amount. [1] + and $17, 63, $1 # Strip off any CDR code bits. [1] + and $18, 63, $3 # Strip off any CDR code bits. [1] + cmpeq $1, TypeFixnum, $2 # [1] +.align 3 +G15465: + beq $2, G15458 # [1] +/* Here if argument TypeFixnum */ + cmpeq $3, TypeFixnum, $4 # [0di] +.align 3 +G15462: + beq $4, G15455 # [1] +/* Here if argument TypeFixnum */ + beq $19, ZERASH # B. if ash of zero -- trivial case [1] + ble $16, NEGASH # B. if negative ash. [1] + addl $19, $31, $19 # Sign extend ARG1 before shifting. [0di] + subq $16, 32, $20 # [1] + bgt $20, ASHOVEXC # [1] + sll $19, $16, $20 # Shift Left [1] + xor $19, $20, $21 # [2] + srl $21, 31, $21 # arg6<0>=1 if overflow, 0 otherwise [1] +/* TagType. */ + and $17, 63, $17 # [1] + bne $21, ASHOVEXC # J. if overflow [1-] + stl $20, 0($12) # [1] + stl $17, 4($12) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +NEGASH: + subq $31, $16, $16 # [1-] + addl $19, $31, $19 # Sign extend ARG1 before shifting. [1] + sra $19, $16, $20 # Shift Right [1] +/* TagType. */ + and $17, 63, $17 # [1] + stl $20, 0($12) # [1-] + stl $17, 4($12) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +ZERASH: + bis $31, TypeFixnum, $20 # [1-] + stl $19, 0($12) # [0di] + stl $20, 4($12) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15459: +.align 3 +G15458: +/* Here for all other cases */ +.align 3 +G15454: + extll $16, 0, $16 # [1-] +/* SetTag. */ + sll $17, 32, $2 # [1] + bis $16, $2, $2 # [2] + bis $31, $17, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G15456 # [0di] +.align 3 +G15455: + extll $16, 0, $16 # [1-] +/* SetTag. */ + sll $17, 32, $2 # [1] + bis $16, $2, $2 # [2] + bis $31, $18, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15456: +.align 3 +G15457: +.align 3 +ASHOVEXC: + extll $16, 0, $16 # [1] +/* SetTag. */ + sll $17, 32, $1 # [1] + bis $16, $1, $1 # [2] + bis $31, $17, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.end DoAsh +/* End of Halfword operand from stack instruction - DoAsh */ +.align 5 +.globl DoRot +.ent DoRot 0 +/* Halfword operand from stack instruction - DoRot */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoRotFP + .globl DoRotSP + .globl DoRotLP + .globl DoRotIM +.align 3 +DoRot: +#ifdef TRACING + .byte 0x88 + .asciiz "DoRotSP" +#endif +.align 3 +DoRotSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + bne $17, beginDoRot # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoRot # [0di] + .byte 0x90 + .asciiz "DoRotLP" +#endif +.align 3 +DoRotLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoRot # [1] + .byte 0x84 + .asciiz "DoRotFP" +#endif +.align 3 +DoRotFP: # Entry point for FP relative +.align 3 +beginDoRot: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] +.align 3 +G15468: + extll $21, 4, $4 # Arg1 on the stack [1] + ldq $7, CACHELINE_NEXTPCDATA($13) # [0di] + extll $21, 0, $1 # Arg1 on the stack [1-] + ldl $5, 4($16) # Arg2 from operand [0di] + and $4, 63, $4 # Strip CDR code if any. [1-] + ldl $2, 0($16) # Arg2 from operand [0di] + subq $4, TypeFixnum, $4 # [1-] + ldq $8, CACHELINE_NEXTCP($13) # [0di] + and $5, 63, $5 # Strip CDR code if any. [1-] + bne $4, G15467 # [0di] + extll $2, 0, $2 # [1-] + subq $5, TypeFixnum, $5 # [1] +.align 3 +G15469: + bne $5, G15467 # [1] + and $2, 31, $2 # Get low 5 bits of the rotation [0di] + sll $1, $2, $3 # Shift left to get new high bits [1] + extll $3, 4, $6 # Get new low bits [2] + bis $3, $6, $3 # Glue two parts of shifted operand together [2] +.align 3 +G15470: + bis $7, $31, $9 # [1] + stl $3, 0($12) # Put the result back on the stack [0di] + bis $8, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +#ifdef TRACING + br $31, DoRotIM # [1] + .byte 0x82 + .asciiz "DoRotIM" +#endif +.align 5 +.align 3 +DoRotIM: # Entry point for IMMEDIATE mode + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + br $31, G15468 # [1-] +.align 3 +G15467: + bis $31, 0, $20 # [1-] + bis $31, 80, $17 # [1] + br $31, ILLEGALOPERAND +.end DoRot +/* End of Halfword operand from stack instruction - DoRot */ +.align 5 +.globl DoLsh +.ent DoLsh 0 +/* Halfword operand from stack instruction - DoLsh */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoLshFP + .globl DoLshSP + .globl DoLshLP + .globl DoLshIM +.align 3 +DoLsh: +#ifdef TRACING + .byte 0x88 + .asciiz "DoLshSP" +#endif +.align 3 +DoLshSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + bne $17, beginDoLsh # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoLsh # [0di] + .byte 0x90 + .asciiz "DoLshLP" +#endif +.align 3 +DoLshLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoLsh # [1] + .byte 0x84 + .asciiz "DoLshFP" +#endif +.align 3 +DoLshFP: # Entry point for FP relative +.align 3 +beginDoLsh: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] +.align 3 +G15472: + extll $21, 4, $4 # Arg1 on the stack [1] + ldq $7, CACHELINE_NEXTPCDATA($13) # [0di] + extll $21, 0, $1 # Arg1 on the stack [1-] + ldl $5, 4($16) # Arg2 from operand [0di] + and $4, 63, $4 # Strip CDR code if any. [1-] + ldl $2, 0($16) # Arg2 from operand [0di] + subq $4, TypeFixnum, $4 # [1-] + ldq $8, CACHELINE_NEXTCP($13) # [0di] + and $5, 63, $5 # Strip CDR code if any. [1-] + bne $4, G15471 # [0di] + subq $5, TypeFixnum, $5 # [1-] +.align 3 +G15473: + bne $5, G15471 # [1] + blt $2, NEGLSH # B. if negative lsh. [1] + subq $2, 32, $3 # [1-] + bge $3, RETURNZERO # [1] + sll $1, $2, $3 # Shift Left [1] + br $31, LSHDONE # [0di] +.align 3 +NEGLSH: + subq $31, $2, $2 # [1-] + subq $2, 32, $3 # [1] + bge $3, RETURNZERO # [1] + srl $1, $2, $3 # Shift Right [1] + br $31, LSHDONE # [1-] +.align 3 +RETURNZERO: + bic $3, $3, $3 # [1-] +.align 3 +LSHDONE: +.align 3 +G15474: + bis $7, $31, $9 # [1] + stl $3, 0($12) # Put the result back on the stack [0di] + bis $8, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +#ifdef TRACING + br $31, DoLshIM # [1] + .byte 0x82 + .asciiz "DoLshIM" +#endif +.align 5 +.align 3 +DoLshIM: # Entry point for IMMEDIATE mode + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G15475: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + br $31, G15472 # [0di] +.align 3 +G15471: + bis $31, 0, $20 # [1-] + bis $31, 80, $17 # [1] + br $31, ILLEGALOPERAND +.end DoLsh +/* End of Halfword operand from stack instruction - DoLsh */ +.align 5 +.globl Do32BitPlus +.ent Do32BitPlus 0 +/* Halfword operand from stack instruction - Do32BitPlus */ +/* arg2 has the preloaded 8 bit operand. */ + .globl Do32BitPlusFP + .globl Do32BitPlusSP + .globl Do32BitPlusLP + .globl Do32BitPlusIM +.align 3 +Do32BitPlus: +#ifdef TRACING + .byte 0x88 + .asciiz "Do32BitPlusSP" +#endif +.align 3 +Do32BitPlusSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + bne $17, beginDo32BitPlus # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDo32BitPlus # [0di] + .byte 0x90 + .asciiz "Do32BitPlusLP" +#endif +.align 3 +Do32BitPlusLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDo32BitPlus # [1] + .byte 0x84 + .asciiz "Do32BitPlusFP" +#endif +.align 3 +Do32BitPlusFP: # Entry point for FP relative +.align 3 +beginDo32BitPlus: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] +.align 3 +G15477: + extll $21, 4, $4 # Arg1 on the stack [1] + ldq $7, CACHELINE_NEXTPCDATA($13) # [0di] + extll $21, 0, $1 # Arg1 on the stack [1-] + ldl $5, 4($16) # Arg2 from operand [0di] + and $4, 63, $4 # Strip CDR code if any. [1-] + ldl $2, 0($16) # Arg2 from operand [0di] + subq $4, TypeFixnum, $4 # [1-] + ldq $8, CACHELINE_NEXTCP($13) # [0di] + and $5, 63, $5 # Strip CDR code if any. [1-] + bne $4, G15476 # [0di] + extll $2, 0, $2 # [1-] + subq $5, TypeFixnum, $5 # [1] +.align 3 +G15478: + bne $5, G15476 # [1] + addq $1, $2, $3 # Perform the 32 bit Add. [0di] +.align 3 +G15479: + bis $7, $31, $9 # [1] + stl $3, 0($12) # Put the result back on the stack [0di] + bis $8, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +#ifdef TRACING + br $31, Do32BitPlusIM # [1] + .byte 0x82 + .asciiz "Do32BitPlusIM" +#endif +.align 5 +.align 3 +Do32BitPlusIM: # Entry point for IMMEDIATE mode + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + br $31, G15477 # [1-] +.align 3 +G15476: + bis $31, 0, $20 # [1-] + bis $31, 80, $17 # [1] + br $31, ILLEGALOPERAND +.end Do32BitPlus +/* End of Halfword operand from stack instruction - Do32BitPlus */ +.align 5 +.globl Do32BitDifference +.ent Do32BitDifference 0 +/* Halfword operand from stack instruction - Do32BitDifference */ +/* arg2 has the preloaded 8 bit operand. */ + .globl Do32BitDifferenceFP + .globl Do32BitDifferenceSP + .globl Do32BitDifferenceLP + .globl Do32BitDifferenceIM +.align 3 +Do32BitDifference: +#ifdef TRACING + .byte 0x88 + .asciiz "Do32BitDifferenceSP" +#endif +.align 3 +Do32BitDifferenceSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + bne $17, beginDo32BitDifference # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDo32BitDifference # [0di] + .byte 0x90 + .asciiz "Do32BitDifferenceLP" +#endif +.align 3 +Do32BitDifferenceLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDo32BitDifference # [1] + .byte 0x84 + .asciiz "Do32BitDifferenceFP" +#endif +.align 3 +Do32BitDifferenceFP: # Entry point for FP relative +.align 3 +beginDo32BitDifference: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] +.align 3 +G15481: + extll $21, 4, $4 # Arg1 on the stack [1] + ldq $7, CACHELINE_NEXTPCDATA($13) # [0di] + extll $21, 0, $1 # Arg1 on the stack [1-] + ldl $5, 4($16) # Arg2 from operand [0di] + and $4, 63, $4 # Strip CDR code if any. [1-] + ldl $2, 0($16) # Arg2 from operand [0di] + subq $4, TypeFixnum, $4 # [1-] + ldq $8, CACHELINE_NEXTCP($13) # [0di] + and $5, 63, $5 # Strip CDR code if any. [1-] + bne $4, G15480 # [0di] + extll $2, 0, $2 # [1-] + subq $5, TypeFixnum, $5 # [1] +.align 3 +G15482: + bne $5, G15480 # [1] + subq $1, $2, $3 # Perform the 32 bit Difference. [0di] +.align 3 +G15483: + bis $7, $31, $9 # [1] + stl $3, 0($12) # Put the result back on the stack [0di] + bis $8, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +#ifdef TRACING + br $31, Do32BitDifferenceIM # [1] + .byte 0x82 + .asciiz "Do32BitDifferenceIM" +#endif +.align 5 +.align 3 +Do32BitDifferenceIM: # Entry point for IMMEDIATE mode + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + br $31, G15481 # [1-] +.align 3 +G15480: + bis $31, 0, $20 # [1-] + bis $31, 80, $17 # [1] + br $31, ILLEGALOPERAND +.end Do32BitDifference +/* End of Halfword operand from stack instruction - Do32BitDifference */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunbits.as */ diff --git a/alpha-emulator/ifunblok.as b/alpha-emulator/ifunblok.as new file mode 100644 index 0000000..861172d --- /dev/null +++ b/alpha-emulator/ifunblok.as @@ -0,0 +1,85 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Block Instructions.") + +(define-instruction |DoBlock0Read| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR0 (ivory)) + (BR zero |BlockRead|)) + +;; |DoBlock3Read|, |DoBlock2Read|, and |DoBlock1Read| are in IFUNCOM1.AS + + +(define-instruction |DoBlock0Write| :operand-from-stack-signed-immediate () + (LDL arg3 PROCESSORSTATE_BAR0 (ivory)) + (LDA arg2 PROCESSORSTATE_BAR0 (ivory)) + (BR zero |BlockWrite|)) + +;; |DoBlock3Write|, |DoBlock2Write|, and |DoBlock1Write| are in IFUNCOM1.AS + + +(define-instruction |DoBlock0ReadShift| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR0 (ivory)) + (BR zero |BlockReadShift|)) + +(define-instruction |DoBlock3ReadShift| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR3 (ivory)) + (BR zero |BlockReadShift|)) + +(define-instruction |DoBlock2ReadShift| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR2 (ivory)) + (BR zero |BlockReadShift|)) + +;; ARG1 has the cycle type and flags, put the proper BAR into ARG2 +(define-instruction |DoBlock1ReadShift| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR1 (ivory)) + (label |BlockReadShift|) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (i%block-n-read-shift arg2 arg1 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12))) + + +(define-instruction |DoBlock0ReadAlu| :operand-from-stack () + (LDA arg2 PROCESSORSTATE_BAR0 (ivory)) + (BR zero |BlockReadAlu|)) + +(define-instruction |DoBlock3ReadAlu| :operand-from-stack () + (LDA arg2 PROCESSORSTATE_BAR3 (ivory)) + (BR zero |BlockReadAlu|)) + +(define-instruction |DoBlock2ReadAlu| :operand-from-stack () + (LDA arg2 PROCESSORSTATE_BAR2 (ivory)) + (BR zero |BlockReadAlu|)) + +(align4kskip4k) + +;; ARG1 has address of boolean op, put the proper BAR into ARG2 +(define-instruction |DoBlock1ReadAlu| :operand-from-stack () + (LDA arg2 PROCESSORSTATE_BAR1 (ivory)) + (label |BlockReadAlu|) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (i%block-n-read-alu arg2 arg1 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12))) + + +(define-instruction |DoBlock0ReadTest| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR0 (ivory)) + (BR zero |BlockReadTest|)) + +(define-instruction |DoBlock3ReadTest| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR3 (ivory)) + (BR zero |BlockReadTest|)) + +(define-instruction |DoBlock2ReadTest| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR2 (ivory)) + (BR zero |BlockReadTest|)) + +;; ARG1 has the cycle type and flags, put the proper BAR into ARG2 +(define-instruction |DoBlock1ReadTest| :10-bit-immediate () + (LDA arg2 PROCESSORSTATE_BAR1 (ivory)) + (label |BlockReadTest|) + (i%block-n-read-test arg2 arg1 arg3 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12)) + + +(comment "Fin.") diff --git a/alpha-emulator/ifunblok.s b/alpha-emulator/ifunblok.s new file mode 100644 index 0000000..a19b371 --- /dev/null +++ b/alpha-emulator/ifunblok.s @@ -0,0 +1,1872 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunblok.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Block Instructions. */ +.align 5 +.globl DoBlock0Read +.ent DoBlock0Read 0 +/* Halfword 10 bit immediate instruction - DoBlock0Read */ + .globl DoBlock0ReadFP + .globl DoBlock0ReadSP + .globl DoBlock0ReadLP + .globl DoBlock0ReadIM +.align 3 +DoBlock0Read: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock0Read" +#endif +.align 3 +DoBlock0ReadIM: +.align 3 +DoBlock0ReadSP: +.align 3 +DoBlock0ReadLP: +.align 3 +DoBlock0ReadFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR0($14) # [1] + br $31, BlockRead # [1-] +.end DoBlock0Read +/* End of Halfword operand from stack instruction - DoBlock0Read */ +.align 5 +.globl DoBlock0Write +.ent DoBlock0Write 0 +/* Halfword operand from stack instruction - DoBlock0Write */ + .globl DoBlock0WriteFP + .globl DoBlock0WriteSP + .globl DoBlock0WriteLP + .globl DoBlock0WriteIM +.align 3 +DoBlock0Write: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoBlock0WriteIM" +#endif +.align 3 +DoBlock0WriteIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G15484: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoBlock0Write # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock0WriteSP" +#endif +.align 3 +DoBlock0WriteSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoBlock0Write # [0di] + .byte 0x90 + .asciiz "DoBlock0WriteLP" +#endif +.align 3 +DoBlock0WriteLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoBlock0Write # [1] + .byte 0x84 + .asciiz "DoBlock0WriteFP" +#endif +.align 3 +DoBlock0WriteFP: # Entry point for FP relative +.align 3 +headDoBlock0Write: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoBlock0Write: +/* arg1 has the operand, sign extended if immediate. */ + ldl $18, PROCESSORSTATE_BAR0($14) # [1] + lda $17, PROCESSORSTATE_BAR0($14) # [0di] + br $31, BlockWrite # [1-] +.end DoBlock0Write +/* End of Halfword operand from stack instruction - DoBlock0Write */ +.align 5 +.globl DoBlock0ReadShift +.ent DoBlock0ReadShift 0 +/* Halfword 10 bit immediate instruction - DoBlock0ReadShift */ + .globl DoBlock0ReadShiftFP + .globl DoBlock0ReadShiftSP + .globl DoBlock0ReadShiftLP + .globl DoBlock0ReadShiftIM +.align 3 +DoBlock0ReadShift: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock0ReadShift" +#endif +.align 3 +DoBlock0ReadShiftIM: +.align 3 +DoBlock0ReadShiftSP: +.align 3 +DoBlock0ReadShiftLP: +.align 3 +DoBlock0ReadShiftFP: + extwl $18, 4, $16 # [2-] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR0($14) # [1] + br $31, BlockReadShift # [1-] +.end DoBlock0ReadShift +/* End of Halfword operand from stack instruction - DoBlock0ReadShift */ +.align 5 +.globl DoBlock3ReadShift +.ent DoBlock3ReadShift 0 +/* Halfword 10 bit immediate instruction - DoBlock3ReadShift */ + .globl DoBlock3ReadShiftFP + .globl DoBlock3ReadShiftSP + .globl DoBlock3ReadShiftLP + .globl DoBlock3ReadShiftIM +.align 3 +DoBlock3ReadShift: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock3ReadShift" +#endif +.align 3 +DoBlock3ReadShiftIM: +.align 3 +DoBlock3ReadShiftSP: +.align 3 +DoBlock3ReadShiftLP: +.align 3 +DoBlock3ReadShiftFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR3($14) # [1] + br $31, BlockReadShift # [1-] +.end DoBlock3ReadShift +/* End of Halfword operand from stack instruction - DoBlock3ReadShift */ +.align 5 +.globl DoBlock2ReadShift +.ent DoBlock2ReadShift 0 +/* Halfword 10 bit immediate instruction - DoBlock2ReadShift */ + .globl DoBlock2ReadShiftFP + .globl DoBlock2ReadShiftSP + .globl DoBlock2ReadShiftLP + .globl DoBlock2ReadShiftIM +.align 3 +DoBlock2ReadShift: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock2ReadShift" +#endif +.align 3 +DoBlock2ReadShiftIM: +.align 3 +DoBlock2ReadShiftSP: +.align 3 +DoBlock2ReadShiftLP: +.align 3 +DoBlock2ReadShiftFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR2($14) # [1] + br $31, BlockReadShift # [1-] +.end DoBlock2ReadShift +/* End of Halfword operand from stack instruction - DoBlock2ReadShift */ +.align 5 +.globl DoBlock1ReadShift +.ent DoBlock1ReadShift 0 +/* Halfword 10 bit immediate instruction - DoBlock1ReadShift */ + .globl DoBlock1ReadShiftFP + .globl DoBlock1ReadShiftSP + .globl DoBlock1ReadShiftLP + .globl DoBlock1ReadShiftIM +.align 3 +DoBlock1ReadShift: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock1ReadShift" +#endif +.align 3 +DoBlock1ReadShiftIM: +.align 3 +DoBlock1ReadShiftSP: +.align 3 +DoBlock1ReadShiftLP: +.align 3 +DoBlock1ReadShiftFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR1($14) # [1] +.align 3 +BlockReadShift: + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $2, 0($17) # Get the vma [1] + srl $16, 6, $1 # cycle type [0di] + and $16, 4, $4 # =no-incrementp [1] + and $16, 16, $5 # =cdr-code-nextp [1] + and $16, 32, $6 # =fixnum onlyp [1] + extll $2, 0, $2 # [1] +/* Memory Read Internal */ +G15489: + addq $2, $14, $24 # [2] + s4addq $1, $31, $25 # Cycle-number -> table offset [1] + ldq_u $8, 0($24) # [1-] + s4addq $25, $14, $25 # [0di] + s4addq $24, $31, $7 # [1] + subq $2, $20, $22 # Stack cache offset [1] + ldq $25, PROCESSORSTATE_DATAREAD_MASK($25) # [1-] + cmpult $22, $21, $23 # In range? [0di] + ldl $7, 0($7) # [1-] + extbl $8, $24, $8 # [0di] + bne $23, G15491 # [1-] +G15490: + srl $25, $8, $25 # [1di] + extll $7, 0, $7 # [1] + blbs $25, G15493 # [1di] +G15500: + beq $6, G15485 # J. if we don't have to test for fixnump. [1] + subq $8, TypeFixnum, $22 # [0di] + and $22, 63, $22 # Strip CDR code [1] + bne $22, G15488 # [1] +.align 3 +G15485: + bne $4, G15486 # J. if we don't have to increment the address. [1] + addq $2, 1, $2 # Increment the address [0di] +.align 3 +G15486: + stl $2, 0($17) # Store updated vma in BAR [1-] + beq $5, G15487 # J. if we don't have to clear CDR codes. [1] + and $8, 63, $8 # [1-] +.align 3 +G15487: + lda $1, 21504 # [1] + ldq $3, PROCESSORSTATE_BYTEROTATE($14) # Get rotate [0di] + ldq $4, PROCESSORSTATE_BYTESIZE($14) # Get bytesize [1] +/* Get background */ + srl $1, 10, $2 # [0di] + and $2, 3, $2 # Extract the byte background [2] + cmpeq $2, ALUByteBackgroundOp1, $5 # [1] +.align 3 +G15507: + beq $5, G15503 # [1] +/* Here if argument ALUByteBackgroundOp1 */ + bis $1, $31, $2 # [0di] +.align 3 +G15502: + srl $1, 12, $6 # [1] + and $6, 1, $6 # Extractthe byte rotate latch [2] + sll $7, $3, $7 # [1] + extll $7, 4, $5 # [2] + extll $7, 0, $7 # [1] + bis $7, $5, $7 # OP2 rotated [2] + beq $6, G15501 # Don't update rotate latch if not requested [1-] + stq $7, PROCESSORSTATE_ROTATELATCH($14) # [1] +.align 3 +G15501: + lda $6, -2 # [1-] + sll $6, $4, $6 # [1] + ornot $31, $6, $6 # Compute mask [2] +/* Get byte function */ + srl $1, 13, $5 # [1] + and $5, 1, $5 # [2] + cmpeq $5, ALUByteFunctionDpb, $4 # [1] +.align 3 +G15512: + beq $4, G15509 # [1] +/* Here if argument ALUByteFunctionDpb */ + sll $6, $3, $6 # Position mask [0di] +.align 3 +G15508: + and $7, $6, $7 # rotated&mask [2] + bic $2, $6, $2 # background&~mask [1] + bis $7, $2, $7 # [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $7, 8($12) # [1] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +G15488: + bis $31, $2, $20 # [1-] + bis $31, 23, $17 # [1] + br $31, ILLEGALOPERAND # Not a fixnum +.align 3 +G15509: + cmpeq $5, ALUByteFunctionLdb, $4 # [1] +.align 3 +G15513: + bne $4, G15508 # [1] + br $31, G15508 # [1] +.align 3 +G15503: + cmpeq $2, ALUByteBackgroundRotateLatch, $5 # [1-] +.align 3 +G15514: + beq $5, G15504 # [1] +/* Here if argument ALUByteBackgroundRotateLatch */ + ldq $2, PROCESSORSTATE_ROTATELATCH($14) # [0di] + br $31, G15502 # [1] +.align 3 +G15504: + cmpeq $2, ALUByteBackgroundZero, $5 # [2-] +.align 3 +G15515: + beq $5, G15502 # [1] +/* Here if argument ALUByteBackgroundZero */ + bis $31, $31, $2 # [0di] + br $31, G15502 # [1-] +.align 3 +G15491: + ldq $23, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $22, $23, $22 # reconstruct SCA [3] + ldl $7, 0($22) # [2] + ldl $8, 4($22) # Read from stack cache [1] + br $31, G15490 # [1] +.align 3 +G15493: +.align 3 +G15492: + s4addq $1, $31, $25 # Cycle-number -> table offset [1-] + s4addq $25, $14, $25 # [1] + ldq $25, PROCESSORSTATE_DATAREAD($25) # [2] +/* TagType. */ + and $8, 63, $24 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $24, $25, $24 # Adjust for a longword load [2di] + ldl $25, 0($24) # Get the memory action [2] +.align 3 +G15498: + and $25, MemoryActionIndirect, $23 # [3] + beq $23, G15497 # [1] + extll $7, 0, $2 # Do the indirect thing [1-] + br $31, G15489 # [0di] +.align 3 +G15497: + and $25, MemoryActionTransform, $24 # [1-] + beq $24, G15496 # [1] + bic $8, 63, $8 # [1-] + bis $8, TypeExternalValueCellPointer, $8 # [1] + br $31, G15500 # [1-] +#ifndef MINIMA +G15496: +#endif +#ifdef MINIMA +.align 3 +G15496: + and $25, MemoryActionBinding, $24 # [1-] + ldq $23, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $24, G15495 # [1-] + sll $2, 1, $22 # [0di] + ldq $24, PROCESSORSTATE_DBCBASE($14) # [1-] + and $22, $23, $22 # Hash index [1di] + bis $31, 1, $23 # [1] + sll $23, IvoryMemoryData, $23 # [1] + addl $22, $24, $22 # [1] + extll $22, 0, $22 # Clear sign-extension [1] + s4addq $22, $23, $23 # [2] + ldl $22, 0($23) # Fetch the key [2] + ldl $7, 4($23) # Fetch value [1] + subl $2, $22, $24 # Compare [2di] + bne $24, G15499 # Trap on miss [1] + extll $7, 0, $2 # Extract the pointer, and indirect [0di] + br $31, G15489 # This is another memory read tailcall. [1-] +.align 3 +G15499: + br $31, DBCACHEMISSTRAP +#endif +G15495: +/* Perform memory action */ + bis $31, $25, $16 # [1-] + bis $31, $1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoBlock1ReadShift +/* End of Halfword operand from stack instruction - DoBlock1ReadShift */ +.align 5 +.globl DoBlock0ReadAlu +.ent DoBlock0ReadAlu 0 +/* Halfword operand from stack instruction - DoBlock0ReadAlu */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoBlock0ReadAluFP + .globl DoBlock0ReadAluSP + .globl DoBlock0ReadAluLP + .globl DoBlock0ReadAluIM +.align 3 +DoBlock0ReadAlu: +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock0ReadAluSP" +#endif +.align 3 +DoBlock0ReadAluSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoBlock0ReadAlu # [0di] + .byte 0x90 + .asciiz "DoBlock0ReadAluLP" +#endif +.align 3 +DoBlock0ReadAluLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoBlock0ReadAlu # [1] + .byte 0x84 + .asciiz "DoBlock0ReadAluFP" +#endif +.align 3 +DoBlock0ReadAluFP: # Entry point for FP relative +.align 3 +beginDoBlock0ReadAlu: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lda $17, PROCESSORSTATE_BAR0($14) # [1] + br $31, BlockReadAlu # [1-] +#ifdef TRACING + .byte 0x82 + .asciiz "DoBlock0ReadAluIM" +#endif +DoBlock0ReadAluIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoBlock0ReadAlu. +.end DoBlock0ReadAlu +/* End of Halfword operand from stack instruction - DoBlock0ReadAlu */ +.align 5 +.globl DoBlock3ReadAlu +.ent DoBlock3ReadAlu 0 +/* Halfword operand from stack instruction - DoBlock3ReadAlu */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoBlock3ReadAluFP + .globl DoBlock3ReadAluSP + .globl DoBlock3ReadAluLP + .globl DoBlock3ReadAluIM +.align 3 +DoBlock3ReadAlu: +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock3ReadAluSP" +#endif +.align 3 +DoBlock3ReadAluSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoBlock3ReadAlu # [0di] + .byte 0x90 + .asciiz "DoBlock3ReadAluLP" +#endif +.align 3 +DoBlock3ReadAluLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoBlock3ReadAlu # [1] + .byte 0x84 + .asciiz "DoBlock3ReadAluFP" +#endif +.align 3 +DoBlock3ReadAluFP: # Entry point for FP relative +.align 3 +beginDoBlock3ReadAlu: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lda $17, PROCESSORSTATE_BAR3($14) # [1] + br $31, BlockReadAlu # [1-] +#ifdef TRACING + .byte 0x82 + .asciiz "DoBlock3ReadAluIM" +#endif +DoBlock3ReadAluIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoBlock3ReadAlu. +.end DoBlock3ReadAlu +/* End of Halfword operand from stack instruction - DoBlock3ReadAlu */ +.align 5 +.globl DoBlock2ReadAlu +.ent DoBlock2ReadAlu 0 +/* Halfword operand from stack instruction - DoBlock2ReadAlu */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoBlock2ReadAluFP + .globl DoBlock2ReadAluSP + .globl DoBlock2ReadAluLP + .globl DoBlock2ReadAluIM +.align 3 +DoBlock2ReadAlu: +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock2ReadAluSP" +#endif +.align 3 +DoBlock2ReadAluSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoBlock2ReadAlu # [0di] + .byte 0x90 + .asciiz "DoBlock2ReadAluLP" +#endif +.align 3 +DoBlock2ReadAluLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoBlock2ReadAlu # [1] + .byte 0x84 + .asciiz "DoBlock2ReadAluFP" +#endif +.align 3 +DoBlock2ReadAluFP: # Entry point for FP relative +.align 3 +beginDoBlock2ReadAlu: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lda $17, PROCESSORSTATE_BAR2($14) # [1] + br $31, BlockReadAlu # [1-] +#ifdef TRACING + .byte 0x82 + .asciiz "DoBlock2ReadAluIM" +#endif +DoBlock2ReadAluIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoBlock2ReadAlu. +.end DoBlock2ReadAlu +/* End of Halfword operand from stack instruction - DoBlock2ReadAlu */ +.align 12 + and $31, $31, $31 # [1] +.align 12 +.align 5 +.globl DoBlock1ReadAlu +.ent DoBlock1ReadAlu 0 +/* Halfword operand from stack instruction - DoBlock1ReadAlu */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoBlock1ReadAluFP + .globl DoBlock1ReadAluSP + .globl DoBlock1ReadAluLP + .globl DoBlock1ReadAluIM +.align 3 +DoBlock1ReadAlu: +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock1ReadAluSP" +#endif +.align 3 +DoBlock1ReadAluSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoBlock1ReadAlu # [0di] + .byte 0x90 + .asciiz "DoBlock1ReadAluLP" +#endif +.align 3 +DoBlock1ReadAluLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoBlock1ReadAlu # [1] + .byte 0x84 + .asciiz "DoBlock1ReadAluFP" +#endif +.align 3 +DoBlock1ReadAluFP: # Entry point for FP relative +.align 3 +beginDoBlock1ReadAlu: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lda $17, PROCESSORSTATE_BAR1($14) # [1] +.align 3 +BlockReadAlu: + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $1, 0($17) # Get the vma [1] + ldl $5, 0($16) # [1] + ldl $4, 4($16) # [1] + extll $5, 0, $5 # [2di] + subq $4, TypeFixnum, $22 # [1] + and $22, 63, $22 # Strip CDR code [1] + bne $22, G15516 # [1] + extll $1, 0, $1 # [0di] +/* Memory Read Internal */ +G15518: + addq $1, $14, $24 # [2] + s4addq $24, $31, $3 # [1] + ldq_u $2, 0($24) # [1-] + subq $1, $20, $22 # Stack cache offset [0di] + ldq $25, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $22, $21, $23 # In range? [0di] + ldl $3, 0($3) # [1-] + extbl $2, $24, $2 # [1di] + bne $23, G15520 # [1-] +G15519: + lda $24, 240 # [0di] + srl $25, $2, $25 # [1] + srl $24, $2, $24 # [1] + extll $3, 0, $3 # [1] + blbs $25, G15522 # [0di] +G15529: + subq $2, TypeFixnum, $22 # [1-] + and $22, 63, $22 # Strip CDR code [1] + bne $22, G15517 # [1] + addq $1, 1, $1 # Increment the address [0di] + stl $1, 0($17) # Store updated vma in BAR [1-] + ldq $6, PROCESSORSTATE_ALUOP($14) # [1] + stq $31, PROCESSORSTATE_ALUOVERFLOW($14) # [1] + ldq $7, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1] + cmpeq $6, ALUFunctionBoolean, $1 # [1-] +.align 3 +G15590: + beq $1, G15531 # [1] +/* Here if argument ALUFunctionBoolean */ + srl $7, 10, $8 # [1di] + and $8, 15, $8 # Extract the ALU boolean function [2] + cmpeq $8, BooleClear, $1 # [1] +.align 3 +G15550: + bne $1, G15532 # [1] +.align 3 +G15533: + cmpeq $8, BooleAnd, $1 # [1] +.align 3 +G15551: + beq $1, G15534 # [1] +/* Here if argument BooleAnd */ + and $3, $5, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15534: + cmpeq $8, BooleAndC1, $1 # [1-] +.align 3 +G15552: + beq $1, G15535 # [1] +/* Here if argument BooleAndC1 */ + bic $5, $3, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15535: + cmpeq $8, Boole2, $1 # [1-] +.align 3 +G15553: + beq $1, G15536 # [1] +/* Here if argument Boole2 */ + bis $5, $31, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15536: + cmpeq $8, BooleAndC2, $1 # [1-] +.align 3 +G15554: + beq $1, G15537 # [1] +/* Here if argument BooleAndC2 */ + bic $3, $5, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15537: + cmpeq $8, Boole1, $1 # [1-] +.align 3 +G15555: + beq $1, G15538 # [1] +/* Here if argument Boole1 */ + bis $3, $31, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15538: + cmpeq $8, BooleXor, $1 # [1-] +.align 3 +G15556: + beq $1, G15539 # [1] +/* Here if argument BooleXor */ + xor $3, $5, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15539: + cmpeq $8, BooleIor, $1 # [1-] +.align 3 +G15557: + beq $1, G15540 # [1] +/* Here if argument BooleIor */ + bis $3, $5, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15540: + cmpeq $8, BooleNor, $1 # [1-] +.align 3 +G15558: + beq $1, G15541 # [1] +/* Here if argument BooleNor */ + bis $3, $5, $8 # [0di] + ornot $31, $8, $8 # [1] + br $31, G15532 # [0di] +.align 3 +G15541: + cmpeq $8, BooleEquiv, $1 # [1-] +.align 3 +G15559: + beq $1, G15542 # [1] +/* Here if argument BooleEquiv */ + xor $3, $5, $8 # [0di] + ornot $31, $8, $8 # [1] + br $31, G15532 # [0di] +.align 3 +G15542: + cmpeq $8, BooleC1, $1 # [1-] +.align 3 +G15560: + beq $1, G15543 # [1] +/* Here if argument BooleC1 */ + ornot $31, $3, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15543: + cmpeq $8, BooleOrC1, $1 # [1-] +.align 3 +G15561: + beq $1, G15544 # [1] +/* Here if argument BooleOrC1 */ + ornot $5, $3, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15544: + cmpeq $8, BooleC2, $1 # [1-] +.align 3 +G15562: + beq $1, G15545 # [1] +/* Here if argument BooleC2 */ + ornot $31, $5, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15545: + cmpeq $8, BooleOrC2, $1 # [1-] +.align 3 +G15563: + beq $1, G15546 # [1] +/* Here if argument BooleOrC2 */ + bic $3, $5, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15546: + cmpeq $8, BooleNand, $1 # [1-] +.align 3 +G15564: + beq $1, G15547 # [1] +/* Here if argument BooleNand */ + and $3, $5, $8 # [0di] + br $31, G15532 # [1-] +.align 3 +G15547: + cmpeq $8, BooleSet, $1 # [1-] +.align 3 +G15565: + beq $1, G15532 # [1] +/* Here if argument BooleSet */ + ornot $31, $31, $8 # [0di] +.align 3 +G15532: + stl $8, 0($16) # [1-] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15531: + cmpeq $6, ALUFunctionByte, $1 # [1-] +.align 3 +G15591: + beq $1, G15566 # [1] +/* Here if argument ALUFunctionByte */ + ldq $22, PROCESSORSTATE_BYTEROTATE($14) # Get rotate [0di] + ldq $23, PROCESSORSTATE_BYTESIZE($14) # Get bytesize [1] +/* Get background */ + srl $7, 10, $1 # [0di] + and $1, 3, $1 # Extract the byte background [2] + cmpeq $1, ALUByteBackgroundOp1, $24 # [1] +.align 3 +G15573: + beq $24, G15569 # [1] +/* Here if argument ALUByteBackgroundOp1 */ + bis $3, $31, $1 # [0di] +.align 3 +G15568: + srl $7, 12, $25 # [1] + and $25, 1, $25 # Extractthe byte rotate latch [2] + sll $5, $22, $8 # [1] + extll $8, 4, $24 # [2] + extll $8, 0, $8 # [1] + bis $8, $24, $8 # OP2 rotated [2] + beq $25, G15567 # Don't update rotate latch if not requested [1-] + stq $8, PROCESSORSTATE_ROTATELATCH($14) # [1] +.align 3 +G15567: + lda $25, -2 # [1-] + sll $25, $23, $25 # [1] + ornot $31, $25, $25 # Compute mask [2] +/* Get byte function */ + srl $7, 13, $24 # [1] + and $24, 1, $24 # [2] + cmpeq $24, ALUByteFunctionDpb, $23 # [1] +.align 3 +G15578: + beq $23, G15575 # [1] +/* Here if argument ALUByteFunctionDpb */ + sll $25, $22, $25 # Position mask [0di] +.align 3 +G15574: + and $8, $25, $8 # rotated&mask [2] + bic $1, $25, $1 # background&~mask [1] + bis $8, $1, $8 # [1] + stl $8, 0($16) # [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15566: + cmpeq $6, ALUFunctionAdder, $1 # [1-] +.align 3 +G15592: + beq $1, G15579 # [1] +/* Here if argument ALUFunctionAdder */ + srl $7, 11, $23 # [0di] + and $23, 3, $23 # Extract the op2 [2] + srl $7, 10, $22 # [1] + and $22, 1, $22 # Extract the adder carry in [2] + cmpeq $23, ALUAdderOp2Op2, $24 # [1] +.align 3 +G15587: + beq $24, G15582 # [1] +/* Here if argument ALUAdderOp2Op2 */ + bis $5, $31, $1 # [0di] +.align 3 +G15581: + addq $3, $1, $8 # [1] + addq $8, $22, $8 # [1] + srl $8, 31, $23 # Sign bit [1] + srl $8, 32, $24 # Next bit [1] + xor $23, $24, $23 # Low bit is now overflow indicator [2] + srl $7, 24, $24 # Get the load-carry-in bit [1] + stq $23, PROCESSORSTATE_ALUOVERFLOW($14) # [1-] + blbc $24, G15580 # [1] + extll $8, 4, $23 # Get the carry [1-] + lda $24, 1024 # [1] + bic $7, $24, $7 # [1] + and $23, 1, $24 # [1] + sll $24, 10, $24 # [1] + bis $7, $24, $7 # Set the adder carry in [2] + stq $7, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1-] +.align 3 +G15580: + cmplt $3, $1, $23 # [1-] + stq $23, PROCESSORSTATE_ALUBORROW($14) # [0di] + addl $3, $31, $3 # [1-] + addl $5, $31, $5 # [1] + cmplt $3, $1, $23 # [1] + stq $23, PROCESSORSTATE_ALULESSTHAN($14) # [0di] + stl $8, 0($16) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15579: + cmpeq $6, ALUFunctionMultiplyDivide, $1 # [1-] +.align 3 +G15593: + beq $1, G15530 # [1] +/* Here if argument ALUFunctionMultiplyDivide */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND + stl $8, 0($16) # [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15530: +.align 3 +G15516: +/* Convert stack cache address to VMA */ + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $16, $22, $22 # stack cache base relative offset [3] + srl $22, 3, $22 # convert byte address to word address [1] + addq $22, $20, $1 # reconstruct VMA [2] + bis $31, $1, $20 # [1] + bis $31, 23, $17 # [1] + br $31, ILLEGALOPERAND # Not a fixnum +.align 3 +G15517: + bis $31, $1, $20 # [1] + bis $31, 23, $17 # [1] + br $31, ILLEGALOPERAND # Not a fixnum +.align 3 +G15582: + cmpeq $23, ALUAdderOp2Zero, $24 # [1] +.align 3 +G15594: + beq $24, G15583 # [1] +/* Here if argument ALUAdderOp2Zero */ + bis $31, $31, $1 # [0di] + br $31, G15581 # [1-] +.align 3 +G15583: + cmpeq $23, ALUAdderOp2Invert, $24 # [1-] +.align 3 +G15595: + beq $24, G15584 # [1] +/* Here if argument ALUAdderOp2Invert */ + addl $5, $31, $1 # [0di] + subq $31, $1, $1 # [1] + extll $1, 0, $1 # [1] + br $31, G15581 # [1-] +.align 3 +G15584: + cmpeq $23, ALUAdderOp2MinusOne, $24 # [1-] +.align 3 +G15596: + beq $24, G15581 # [1] +/* Here if argument ALUAdderOp2MinusOne */ + ornot $31, $31, $1 # [0di] + extll $1, 0, $1 # [1] + br $31, G15581 # [0di] +.align 3 +G15575: + cmpeq $24, ALUByteFunctionLdb, $23 # [1-] +.align 3 +G15597: + bne $23, G15574 # [1] + br $31, G15574 # [1] +.align 3 +G15569: + cmpeq $1, ALUByteBackgroundRotateLatch, $24 # [1-] +.align 3 +G15598: + beq $24, G15570 # [1] +/* Here if argument ALUByteBackgroundRotateLatch */ + ldq $1, PROCESSORSTATE_ROTATELATCH($14) # [0di] + br $31, G15568 # [1] +.align 3 +G15570: + cmpeq $1, ALUByteBackgroundZero, $24 # [2-] +.align 3 +G15599: + beq $24, G15568 # [1] +/* Here if argument ALUByteBackgroundZero */ + bis $31, $31, $1 # [0di] + br $31, G15568 # [1-] +.align 3 +G15520: + ldq $23, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $22, $23, $22 # reconstruct SCA [3] + ldl $3, 0($22) # [2] + ldl $2, 4($22) # Read from stack cache [1] + br $31, G15519 # [1] +.align 3 +G15522: + blbc $24, G15521 # [1] + extll $3, 0, $1 # Do the indirect thing [0di] + br $31, G15518 # [1-] +.align 3 +G15521: + ldq $25, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $24 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $24, $25, $24 # Adjust for a longword load [2di] + ldl $25, 0($24) # Get the memory action [2] +.align 3 +G15526: + and $25, MemoryActionTransform, $24 # [3] + beq $24, G15525 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G15529 # [1-] +#ifndef MINIMA +G15525: +#endif +#ifdef MINIMA +.align 3 +G15525: + and $25, MemoryActionBinding, $24 # [1-] + ldq $23, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $24, G15524 # [1-] + sll $1, 1, $22 # [0di] + ldq $24, PROCESSORSTATE_DBCBASE($14) # [1-] + and $22, $23, $22 # Hash index [1di] + bis $31, 1, $23 # [1] + sll $23, IvoryMemoryData, $23 # [1] + addl $22, $24, $22 # [1] + extll $22, 0, $22 # Clear sign-extension [1] + s4addq $22, $23, $23 # [2] + ldl $22, 0($23) # Fetch the key [2] + ldl $3, 4($23) # Fetch value [1] + subl $1, $22, $24 # Compare [2di] + bne $24, G15528 # Trap on miss [1] + extll $3, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G15518 # This is another memory read tailcall. [1-] +.align 3 +G15528: + br $31, DBCACHEMISSTRAP +#endif +G15524: +/* Perform memory action */ + bis $31, $25, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoBlock1ReadAluIM" +#endif +DoBlock1ReadAluIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoBlock1ReadAlu. +.end DoBlock1ReadAlu +/* End of Halfword operand from stack instruction - DoBlock1ReadAlu */ +.align 5 +.globl DoBlock0ReadTest +.ent DoBlock0ReadTest 0 +/* Halfword 10 bit immediate instruction - DoBlock0ReadTest */ + .globl DoBlock0ReadTestFP + .globl DoBlock0ReadTestSP + .globl DoBlock0ReadTestLP + .globl DoBlock0ReadTestIM +.align 3 +DoBlock0ReadTest: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock0ReadTest" +#endif +.align 3 +DoBlock0ReadTestIM: +.align 3 +DoBlock0ReadTestSP: +.align 3 +DoBlock0ReadTestLP: +.align 3 +DoBlock0ReadTestFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR0($14) # [1] + br $31, BlockReadTest # [1-] +.end DoBlock0ReadTest +/* End of Halfword operand from stack instruction - DoBlock0ReadTest */ +.align 5 +.globl DoBlock3ReadTest +.ent DoBlock3ReadTest 0 +/* Halfword 10 bit immediate instruction - DoBlock3ReadTest */ + .globl DoBlock3ReadTestFP + .globl DoBlock3ReadTestSP + .globl DoBlock3ReadTestLP + .globl DoBlock3ReadTestIM +.align 3 +DoBlock3ReadTest: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock3ReadTest" +#endif +.align 3 +DoBlock3ReadTestIM: +.align 3 +DoBlock3ReadTestSP: +.align 3 +DoBlock3ReadTestLP: +.align 3 +DoBlock3ReadTestFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR3($14) # [1] + br $31, BlockReadTest # [1-] +.end DoBlock3ReadTest +/* End of Halfword operand from stack instruction - DoBlock3ReadTest */ +.align 5 +.globl DoBlock2ReadTest +.ent DoBlock2ReadTest 0 +/* Halfword 10 bit immediate instruction - DoBlock2ReadTest */ + .globl DoBlock2ReadTestFP + .globl DoBlock2ReadTestSP + .globl DoBlock2ReadTestLP + .globl DoBlock2ReadTestIM +.align 3 +DoBlock2ReadTest: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock2ReadTest" +#endif +.align 3 +DoBlock2ReadTestIM: +.align 3 +DoBlock2ReadTestSP: +.align 3 +DoBlock2ReadTestLP: +.align 3 +DoBlock2ReadTestFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR2($14) # [1] + br $31, BlockReadTest # [1-] +.end DoBlock2ReadTest +/* End of Halfword operand from stack instruction - DoBlock2ReadTest */ +.align 5 +.globl DoBlock1ReadTest +.ent DoBlock1ReadTest 0 +/* Halfword 10 bit immediate instruction - DoBlock1ReadTest */ + .globl DoBlock1ReadTestFP + .globl DoBlock1ReadTestSP + .globl DoBlock1ReadTestLP + .globl DoBlock1ReadTestIM +.align 3 +DoBlock1ReadTest: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock1ReadTest" +#endif +.align 3 +DoBlock1ReadTestIM: +.align 3 +DoBlock1ReadTestSP: +.align 3 +DoBlock1ReadTestLP: +.align 3 +DoBlock1ReadTestFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $17, PROCESSORSTATE_BAR1($14) # [1] +.align 3 +BlockReadTest: + ldl $18, 0($17) # Get the vma [2] + srl $16, 6, $1 # cycle type [0di] + ldl $5, 0($12) # [1-] + ldl $4, 4($12) # [1] + extll $5, 0, $5 # [2-] + extll $18, 0, $18 # [1] +/* Memory Read Internal */ +G15606: + ldq $22, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $18, $14, $24 # [1di] + ldl $23, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $1, $31, $25 # Cycle-number -> table offset [0di] + ldq_u $2, 0($24) # [1-] + s4addq $25, $14, $25 # [0di] + s4addq $24, $31, $3 # [1] + subq $18, $22, $22 # Stack cache offset [1] + ldq $25, PROCESSORSTATE_DATAREAD_MASK($25) # [1-] + cmpult $22, $23, $23 # In range? [0di] + ldl $3, 0($3) # [1-] + extbl $2, $24, $2 # [0di] + bne $23, G15608 # [1-] +G15607: + srl $25, $2, $25 # [1di] + extll $3, 0, $3 # [1] + blbs $25, G15610 # [1di] +G15617: + and $16, 32, $1 # =fixnum onlyp [1-] + beq $1, G15600 # J. if we don't have to test for fixnump. [1] + subq $2, TypeFixnum, $22 # [1-] + and $22, 63, $22 # Strip CDR code [1] + bne $22, G15603 # [1] + subq $4, TypeFixnum, $22 # [1] + and $22, 63, $22 # Strip CDR code [1] + bne $22, G15604 # [1] +.align 3 +G15600: + and $16, 16, $1 # =cdr-code-nextp [1-] + beq $1, G15602 # J. if we don't have to clear CDR codes. [1] +/* TagType. */ + and $2, 63, $2 # [1-] +.align 3 +G15602: + ldq $6, PROCESSORSTATE_ALUOP($14) # [1-] + stq $31, PROCESSORSTATE_ALUOVERFLOW($14) # [1] + ldq $7, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1] + cmpeq $6, ALUFunctionBoolean, $1 # [1di] +.align 3 +G15678: + beq $1, G15619 # [1] +/* Here if argument ALUFunctionBoolean */ + srl $7, 10, $8 # [1di] + and $8, 15, $8 # Extract the ALU boolean function [2] + cmpeq $8, BooleClear, $1 # [1] +.align 3 +G15638: + bne $1, G15620 # [1] +.align 3 +G15621: + cmpeq $8, BooleAnd, $1 # [1] +.align 3 +G15639: + beq $1, G15622 # [1] +/* Here if argument BooleAnd */ + and $3, $5, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15622: + cmpeq $8, BooleAndC1, $1 # [1-] +.align 3 +G15640: + beq $1, G15623 # [1] +/* Here if argument BooleAndC1 */ + bic $5, $3, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15623: + cmpeq $8, Boole2, $1 # [1-] +.align 3 +G15641: + beq $1, G15624 # [1] +/* Here if argument Boole2 */ + bis $5, $31, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15624: + cmpeq $8, BooleAndC2, $1 # [1-] +.align 3 +G15642: + beq $1, G15625 # [1] +/* Here if argument BooleAndC2 */ + bic $3, $5, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15625: + cmpeq $8, Boole1, $1 # [1-] +.align 3 +G15643: + beq $1, G15626 # [1] +/* Here if argument Boole1 */ + bis $3, $31, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15626: + cmpeq $8, BooleXor, $1 # [1-] +.align 3 +G15644: + beq $1, G15627 # [1] +/* Here if argument BooleXor */ + xor $3, $5, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15627: + cmpeq $8, BooleIor, $1 # [1-] +.align 3 +G15645: + beq $1, G15628 # [1] +/* Here if argument BooleIor */ + bis $3, $5, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15628: + cmpeq $8, BooleNor, $1 # [1-] +.align 3 +G15646: + beq $1, G15629 # [1] +/* Here if argument BooleNor */ + bis $3, $5, $8 # [0di] + ornot $31, $8, $8 # [1] + br $31, G15620 # [0di] +.align 3 +G15629: + cmpeq $8, BooleEquiv, $1 # [1-] +.align 3 +G15647: + beq $1, G15630 # [1] +/* Here if argument BooleEquiv */ + xor $3, $5, $8 # [0di] + ornot $31, $8, $8 # [1] + br $31, G15620 # [0di] +.align 3 +G15630: + cmpeq $8, BooleC1, $1 # [1-] +.align 3 +G15648: + beq $1, G15631 # [1] +/* Here if argument BooleC1 */ + ornot $31, $3, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15631: + cmpeq $8, BooleOrC1, $1 # [1-] +.align 3 +G15649: + beq $1, G15632 # [1] +/* Here if argument BooleOrC1 */ + ornot $5, $3, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15632: + cmpeq $8, BooleC2, $1 # [1-] +.align 3 +G15650: + beq $1, G15633 # [1] +/* Here if argument BooleC2 */ + ornot $31, $5, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15633: + cmpeq $8, BooleOrC2, $1 # [1-] +.align 3 +G15651: + beq $1, G15634 # [1] +/* Here if argument BooleOrC2 */ + bic $3, $5, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15634: + cmpeq $8, BooleNand, $1 # [1-] +.align 3 +G15652: + beq $1, G15635 # [1] +/* Here if argument BooleNand */ + and $3, $5, $8 # [0di] + br $31, G15620 # [1-] +.align 3 +G15635: + cmpeq $8, BooleSet, $1 # [1-] +.align 3 +G15653: + beq $1, G15620 # [1] +/* Here if argument BooleSet */ + ornot $31, $31, $8 # [0di] +.align 3 +G15620: +.align 3 +G15618: + srl $7, 16, $1 # [1] + and $1, 31, $1 # Extract ALU condition [2] + ldq $23, PROCESSORSTATE_ALUOVERFLOW($14) # [1-] + ldq $24, PROCESSORSTATE_ALUBORROW($14) # [1] + ldq $25, PROCESSORSTATE_ALULESSTHAN($14) # [1] + cmpeq $1, ALUConditionSignedLessThanOrEqual, $22 # [0di] +.align 3 +G15710: + beq $22, G15683 # [1] +/* Here if argument ALUConditionSignedLessThanOrEqual */ + bne $25, G15679 # [2] + beq $8, G15679 # [1] +.align 3 +G15682: +.align 3 +G15680: + bis $31, $31, $1 # [1-] + br $31, G15681 # [0di] +.align 3 +G15679: + bis $31, 1, $1 # [1-] +.align 3 +G15681: + srl $7, 21, $22 # [1] + and $22, 1, $22 # Extract the condition sense [2] + xor $1, $22, $1 # [1] + bne $1, G15605 # [1] + and $16, 4, $1 # =no-incrementp [1] + bne $1, G15601 # J. if we don't have to increment the address. [1] + addq $18, 1, $18 # Increment the address [1-] +.align 3 +G15601: + stl $18, 0($17) # Store updated vma in BAR [1-] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15605: + ldl $23, -8($12) # [1] + ldl $22, -4($12) # [1] + extll $23, 0, $23 # [2-] + sll $23, 1, $23 # [2] + and $22, 1, $9 # [1] + addq $9, $23, $9 # [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [1-] +.align 3 +G15604: +/* Convert stack cache address to VMA */ + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $18, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $22, $22 # stack cache base relative offset [2-] + srl $22, 3, $22 # convert byte address to word address [1] + addq $22, $18, $18 # reconstruct VMA [2] + bis $31, $18, $20 # [1] + bis $31, 23, $17 # [1] + br $31, ILLEGALOPERAND # Not a fixnum +.align 3 +G15603: + bis $31, $18, $20 # [1] + bis $31, 23, $17 # [1] + br $31, ILLEGALOPERAND # Not a fixnum +.align 3 +G15683: + cmpeq $1, ALUConditionSignedLessThan, $22 # [1] +.align 3 +G15711: + beq $22, G15684 # [1] +/* Here if argument ALUConditionSignedLessThan */ + bne $25, G15679 # [1] + br $31, G15682 # [1] +.align 3 +G15684: + cmpeq $1, ALUConditionNegative, $22 # [1-] +.align 3 +G15712: + beq $22, G15685 # [1] +/* Here if argument ALUConditionNegative */ + blt $8, G15679 # [1] + br $31, G15682 # [1] +.align 3 +G15685: + cmpeq $1, ALUConditionSignedOverflow, $22 # [1-] +.align 3 +G15713: + beq $22, G15686 # [1] +/* Here if argument ALUConditionSignedOverflow */ + bne $23, G15679 # [1] + br $31, G15682 # [1] +.align 3 +G15686: + cmpeq $1, ALUConditionUnsignedLessThanOrEqual, $22 # [1-] +.align 3 +G15714: + beq $22, G15687 # [1] +/* Here if argument ALUConditionUnsignedLessThanOrEqual */ + bne $24, G15679 # [1] + beq $8, G15679 # [1] + br $31, G15682 # [1] +.align 3 +G15687: + cmpeq $1, ALUConditionUnsignedLessThan, $22 # [1-] +.align 3 +G15715: + beq $22, G15688 # [1] +/* Here if argument ALUConditionUnsignedLessThan */ + bne $24, G15679 # [1] + br $31, G15682 # [1] +.align 3 +G15688: + cmpeq $1, ALUConditionZero, $22 # [1-] +.align 3 +G15716: + beq $22, G15689 # [1] +/* Here if argument ALUConditionZero */ + beq $8, G15679 # [1] + br $31, G15682 # [1] +.align 3 +G15689: + cmpeq $1, ALUConditionHigh25Zero, $22 # [1-] +.align 3 +G15717: + beq $22, G15690 # [1] +/* Here if argument ALUConditionHigh25Zero */ + srl $8, 7, $1 # [0di] + beq $1, G15679 # [2] + br $31, G15682 # [1] +.align 3 +G15690: + cmpeq $1, ALUConditionEq, $22 # [1-] +.align 3 +G15718: + beq $22, G15691 # [1] +/* Here if argument ALUConditionEq */ + bne $8, G15680 # [1] + xor $2, $4, $22 # [1-] +/* TagType. */ + and $22, 63, $22 # [1] + beq $22, G15679 # [1] + br $31, G15682 # [1] +.align 3 +G15691: + cmpeq $1, ALUConditionOp1Ephemeralp, $22 # [1-] +.align 3 +G15719: + beq $22, G15692 # [1] +/* Here if argument ALUConditionOp1Ephemeralp */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15692: + cmpeq $1, ALUConditionResultTypeNil, $22 # [1] +.align 3 +G15720: + beq $22, G15693 # [1] +/* Here if argument ALUConditionResultTypeNil */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15693: + cmpeq $1, ALUConditionOp2Fixnum, $22 # [1] +.align 3 +G15721: + beq $22, G15694 # [1] +/* Here if argument ALUConditionOp2Fixnum */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15694: + cmpeq $1, ALUConditionFalse, $22 # [1] +.align 3 +G15722: + beq $22, G15695 # [1] +/* Here if argument ALUConditionFalse */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15695: + cmpeq $1, ALUConditionResultCdrLow, $22 # [1] +.align 3 +G15723: + beq $22, G15696 # [1] +/* Here if argument ALUConditionResultCdrLow */ +/* TagCdr. */ + srl $2, 6, $22 # [1] + and $22, 1, $1 # [2] + br $31, G15681 # [0di] +.align 3 +G15696: + cmpeq $1, ALUConditionCleanupBitsSet, $22 # [1-] +.align 3 +G15724: + beq $22, G15697 # [1] +/* Here if argument ALUConditionCleanupBitsSet */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15697: + cmpeq $1, ALUConditionAddressInStackCache, $22 # [1] +.align 3 +G15725: + beq $22, G15698 # [1] +/* Here if argument ALUConditionAddressInStackCache */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15698: + cmpeq $1, ALUConditionExtraStackMode, $22 # [1] +.align 3 +G15726: + beq $22, G15699 # [1] +/* Here if argument ALUConditionExtraStackMode */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15699: + cmpeq $1, ALUConditionFepMode, $22 # [1] +.align 3 +G15727: + beq $22, G15700 # [1] +/* Here if argument ALUConditionFepMode */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15700: + cmpeq $1, ALUConditionFpCoprocessorPresent, $22 # [1] +.align 3 +G15728: + beq $22, G15701 # [1] +/* Here if argument ALUConditionFpCoprocessorPresent */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15701: + cmpeq $1, ALUConditionOp1Oldspacep, $22 # [1] +.align 3 +G15729: + beq $22, G15702 # [1] +/* Here if argument ALUConditionOp1Oldspacep */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15702: + cmpeq $1, ALUConditionPendingSequenceBreakEnabled, $22 # [1] +.align 3 +G15730: + beq $22, G15703 # [1] +/* Here if argument ALUConditionPendingSequenceBreakEnabled */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15703: + cmpeq $1, ALUConditionOp1TypeAcceptable, $22 # [1] +.align 3 +G15731: + beq $22, G15704 # [1] +/* Here if argument ALUConditionOp1TypeAcceptable */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15704: + cmpeq $1, ALUConditionOp1TypeCondition, $22 # [1] +.align 3 +G15732: + beq $22, G15705 # [1] +/* Here if argument ALUConditionOp1TypeCondition */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15705: + cmpeq $1, ALUConditionStackCacheOverflow, $22 # [1] +.align 3 +G15733: + beq $22, G15706 # [1] +/* Here if argument ALUConditionStackCacheOverflow */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15706: + cmpeq $1, ALUConditionOrLogicVariable, $22 # [1] +.align 3 +G15734: + beq $22, G15707 # [1] +/* Here if argument ALUConditionOrLogicVariable */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15707: +/* Here for all other cases */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [1] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15619: + cmpeq $6, ALUFunctionByte, $1 # [1] +.align 3 +G15735: + beq $1, G15654 # [1] +/* Here if argument ALUFunctionByte */ + ldq $22, PROCESSORSTATE_BYTEROTATE($14) # Get rotate [0di] + ldq $23, PROCESSORSTATE_BYTESIZE($14) # Get bytesize [1] +/* Get background */ + srl $7, 10, $1 # [0di] + and $1, 3, $1 # Extract the byte background [2] + cmpeq $1, ALUByteBackgroundOp1, $24 # [1] +.align 3 +G15661: + beq $24, G15657 # [1] +/* Here if argument ALUByteBackgroundOp1 */ + bis $3, $31, $1 # [0di] +.align 3 +G15656: + srl $7, 12, $25 # [1] + and $25, 1, $25 # Extractthe byte rotate latch [2] + sll $5, $22, $8 # [1] + extll $8, 4, $24 # [2] + extll $8, 0, $8 # [1] + bis $8, $24, $8 # OP2 rotated [2] + beq $25, G15655 # Don't update rotate latch if not requested [1-] + stq $8, PROCESSORSTATE_ROTATELATCH($14) # [1] +.align 3 +G15655: + lda $25, -2 # [1-] + sll $25, $23, $25 # [1] + ornot $31, $25, $25 # Compute mask [2] +/* Get byte function */ + srl $7, 13, $24 # [1] + and $24, 1, $24 # [2] + cmpeq $24, ALUByteFunctionDpb, $23 # [1] +.align 3 +G15666: + beq $23, G15663 # [1] +/* Here if argument ALUByteFunctionDpb */ + sll $25, $22, $25 # Position mask [0di] +.align 3 +G15662: + and $8, $25, $8 # rotated&mask [2] + bic $1, $25, $1 # background&~mask [1] + bis $8, $1, $8 # [1] + br $31, G15618 # [0di] +.align 3 +G15654: + cmpeq $6, ALUFunctionAdder, $1 # [1-] +.align 3 +G15736: + beq $1, G15667 # [1] +/* Here if argument ALUFunctionAdder */ + srl $7, 11, $23 # [0di] + and $23, 3, $23 # Extract the op2 [2] + srl $7, 10, $22 # [1] + and $22, 1, $22 # Extract the adder carry in [2] + cmpeq $23, ALUAdderOp2Op2, $24 # [1] +.align 3 +G15675: + beq $24, G15670 # [1] +/* Here if argument ALUAdderOp2Op2 */ + bis $5, $31, $1 # [0di] +.align 3 +G15669: + addq $3, $1, $8 # [1] + addq $8, $22, $8 # [1] + srl $8, 31, $23 # Sign bit [1] + srl $8, 32, $24 # Next bit [1] + xor $23, $24, $23 # Low bit is now overflow indicator [2] + srl $7, 24, $24 # Get the load-carry-in bit [1] + stq $23, PROCESSORSTATE_ALUOVERFLOW($14) # [1-] + blbc $24, G15668 # [1] + extll $8, 4, $23 # Get the carry [1-] + lda $24, 1024 # [1] + bic $7, $24, $7 # [1] + and $23, 1, $24 # [1] + sll $24, 10, $24 # [1] + bis $7, $24, $7 # Set the adder carry in [2] + stq $7, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1-] +.align 3 +G15668: + cmplt $3, $1, $23 # [1-] + stq $23, PROCESSORSTATE_ALUBORROW($14) # [0di] + addl $3, $31, $3 # [1-] + addl $5, $31, $5 # [1] + cmplt $3, $1, $23 # [1] + stq $23, PROCESSORSTATE_ALULESSTHAN($14) # [0di] + br $31, G15618 # [1] +.align 3 +G15667: + cmpeq $6, ALUFunctionMultiplyDivide, $1 # [1-] +.align 3 +G15737: + beq $1, G15618 # [1] +/* Here if argument ALUFunctionMultiplyDivide */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15670: + cmpeq $23, ALUAdderOp2Zero, $24 # [1] +.align 3 +G15738: + beq $24, G15671 # [1] +/* Here if argument ALUAdderOp2Zero */ + bis $31, $31, $1 # [0di] + br $31, G15669 # [1-] +.align 3 +G15671: + cmpeq $23, ALUAdderOp2Invert, $24 # [1-] +.align 3 +G15739: + beq $24, G15672 # [1] +/* Here if argument ALUAdderOp2Invert */ + addl $5, $31, $1 # [0di] + subq $31, $1, $1 # [1] + extll $1, 0, $1 # [1] + br $31, G15669 # [1-] +.align 3 +G15672: + cmpeq $23, ALUAdderOp2MinusOne, $24 # [1-] +.align 3 +G15740: + beq $24, G15669 # [1] +/* Here if argument ALUAdderOp2MinusOne */ + ornot $31, $31, $1 # [0di] + extll $1, 0, $1 # [1] + br $31, G15669 # [0di] +.align 3 +G15663: + cmpeq $24, ALUByteFunctionLdb, $23 # [1-] +.align 3 +G15741: + bne $23, G15662 # [1] + br $31, G15662 # [1] +.align 3 +G15657: + cmpeq $1, ALUByteBackgroundRotateLatch, $24 # [1-] +.align 3 +G15742: + beq $24, G15658 # [1] +/* Here if argument ALUByteBackgroundRotateLatch */ + ldq $1, PROCESSORSTATE_ROTATELATCH($14) # [0di] + br $31, G15656 # [1] +.align 3 +G15658: + cmpeq $1, ALUByteBackgroundZero, $24 # [2-] +.align 3 +G15743: + beq $24, G15656 # [1] +/* Here if argument ALUByteBackgroundZero */ + bis $31, $31, $1 # [0di] + br $31, G15656 # [1-] +.align 3 +G15608: + ldq $23, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $22, $23, $22 # reconstruct SCA [3] + ldl $3, 0($22) # [2] + ldl $2, 4($22) # Read from stack cache [1] + br $31, G15607 # [1] +.align 3 +G15610: +.align 3 +G15609: + s4addq $1, $31, $25 # Cycle-number -> table offset [1-] + s4addq $25, $14, $25 # [1] + ldq $25, PROCESSORSTATE_DATAREAD($25) # [2] +/* TagType. */ + and $2, 63, $24 # Discard the CDR code [0di] + stq $18, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $24, $25, $24 # Adjust for a longword load [2di] + ldl $25, 0($24) # Get the memory action [2] +.align 3 +G15615: + and $25, MemoryActionIndirect, $23 # [3] + beq $23, G15614 # [1] + extll $3, 0, $18 # Do the indirect thing [1-] + br $31, G15606 # [0di] +.align 3 +G15614: + and $25, MemoryActionTransform, $24 # [1-] + beq $24, G15613 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G15617 # [1-] +#ifndef MINIMA +G15613: +#endif +#ifdef MINIMA +.align 3 +G15613: + and $25, MemoryActionBinding, $24 # [1-] + ldq $23, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $24, G15612 # [1-] + sll $18, 1, $22 # [0di] + ldq $24, PROCESSORSTATE_DBCBASE($14) # [1-] + and $22, $23, $22 # Hash index [1di] + bis $31, 1, $23 # [1] + sll $23, IvoryMemoryData, $23 # [1] + addl $22, $24, $22 # [1] + extll $22, 0, $22 # Clear sign-extension [1] + s4addq $22, $23, $23 # [2] + ldl $22, 0($23) # Fetch the key [2] + ldl $3, 4($23) # Fetch value [1] + subl $18, $22, $24 # Compare [2di] + bne $24, G15616 # Trap on miss [1] + extll $3, 0, $18 # Extract the pointer, and indirect [0di] + br $31, G15606 # This is another memory read tailcall. [1-] +.align 3 +G15616: + br $31, DBCACHEMISSTRAP +#endif +G15612: +/* Perform memory action */ + bis $31, $25, $16 # [1-] + bis $31, $1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoBlock1ReadTest +/* End of Halfword operand from stack instruction - DoBlock1ReadTest */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunblok.as */ diff --git a/alpha-emulator/ifunbnum.as b/alpha-emulator/ifunbnum.as new file mode 100644 index 0000000..2fee682 --- /dev/null +++ b/alpha-emulator/ifunbnum.as @@ -0,0 +1,130 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Bignums.") + +;;; no stack level change +(define-instruction |DoAddBignumStep| :operand-from-stack-immediate () + (LDL arg2 0 (isp) "Get arg2") + (LDL t2 4 (isp) "and its tag") + (SRL arg1 32 t3) + (EXTLL arg1 0 arg1 "Strip type from arg3") + (CheckDataType t3 |TypeFixnum| addbignumsteplose t4) + (LDL arg3 -8 (isp) "Get arg1") + (LDL t1 -4 (isp) "and its tag") + (EXTLL arg2 0 arg2 "Clear sign extension from arg2") + (CheckDataType t2 |TypeFixnum| addbignumsteplose t4) + (EXTLL arg3 0 arg3 "Clear sign extension") + (CheckDataType t1 |TypeFixnum| addbignumsteplose t4) + (ADDQ arg1 arg2 arg4) + (ADDQ arg3 arg4 arg5) + (SRL arg5 32 arg6 "Shift the carry into arg6") + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2-disp iSP -8 t1 arg5 "Store fixnum result") + (stack-write2 iSP t1 arg6 "Store the carry if any") + (ContinueToNextInstruction-NoStall) + (label addbignumsteplose) + (illegal-operand three-operand-fixnum-type-error)) + +;;; no stack level change +(define-instruction |DoSubBignumStep| :operand-from-stack-immediate () + (LDL arg2 0 (isp) "Get arg2") + (LDL t2 4 (isp) "and its tag") + (SRL arg1 32 t3) + (EXTLL arg1 0 arg1 "Strip type from arg3") + (CheckDataType t3 |TypeFixnum| subbignumsteplose t4) + (LDL arg3 -8 (isp) "Get arg1") + (LDL t1 -4 (isp) "and its tag") + (EXTLL arg2 0 arg2 "Clear sign extension from arg2") + (CheckDataType t2 |TypeFixnum| subbignumsteplose t4) + (EXTLL arg3 0 arg3 "Clear sign extension") + (CheckDataType t1 |TypeFixnum| subbignumsteplose t4) + (SUBQ arg3 arg2 arg4 "arg1-arg2") + (CMPLT arg4 zero arg6 "arg6=1 if we borrowed in 1st step") + (EXTLL arg4 0 arg4 "Truncate 1st step to 32-bits") + (SUBQ arg4 arg1 arg5 "(arg1-arg2)-arg3") + (CMPLT arg5 zero t6 "t6=1 if we borrowed in 2nd step") + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2-disp iSP -8 t1 arg5 "Store fixnum result") + (ADDQ arg6 t6 arg6 "Compute borrow") + (stack-write2 iSP t1 arg6 "Store the borrow if any") + (ContinueToNextInstruction-NoStall) + (label subbignumsteplose) + (illegal-operand three-operand-fixnum-type-error)) + +(define-instruction |DoMultiplyBignumStep| :operand-from-stack-immediate () + (LDL arg2 0 (isp) "Get arg1") + (LDL t1 4 (isp)) + (SRL arg1 32 t2) + (EXTLL arg1 0 arg1 "Strip type from arg2") + (CheckDataType t2 |TypeFixnum| multbignumsteplose t4) + (EXTLL arg2 0 arg2) + (CheckDataType t1 |TypeFixnum| multbignumsteplose t4) + (MULQ arg2 arg1 arg3 "arg1*arg2") + (EXTLL arg3 4 arg6 "arg6=high order word") + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2 iSP t1 arg3 "Store fixnum result ls word") + (stack-push2-with-cdr t1 arg6 "Store ms word") + (ContinueToNextInstruction-NoStall) + (label multbignumsteplose) + (illegal-operand two-operand-fixnum-type-error)) + +;;+++ Needs to signal DIVIDE-OVERFLOW if final carry is non-zero +(define-instruction |DoDivideBignumStep| :operand-from-stack-immediate () + (LDL arg2 0 (isp) "Get arg2") + (LDL t1 4 (isp)) + (SRL arg1 32 t2) + (EXTLL arg1 0 arg1) ;this is an unsigned divide + (CheckDataType t2 |TypeFixnum| divbignumsteplose1 t4) + (BEQ arg1 divbignumsteplose2 "J. if division by zero") + (EXTLL arg2 0 arg2) + (LDL arg3 -8 (isp) "Get arg1") + (LDL t3 -4 (isp)) + (CheckDataType t1 |TypeFixnum| divbignumsteplose1 t4) + (SLL arg2 32 arg2 "arg2=(ash arg2 32)") + (EXTLL arg3 0 arg3) + (CheckDataType t3 |TypeFixnum| divbignumsteplose1 t4) + (BIS arg3 arg2 arg4 "arg1+(ash arg2 32)") + (DIVQU arg4 arg1 t1 "t1 is now the quotient") + (MULQ t1 arg1 t2) + (SUBQ arg4 t2 t2 "t2 is now the remainder") + (STL t1 -8 (iSP) "store quotient (already fixnum)") + (STL t2 0 (iSP) "store remainder (already fixnum)") + (ContinueToNextInstruction) + (label divbignumsteplose1) + (illegal-operand three-operand-fixnum-type-error) + (label divbignumsteplose2) + (illegal-operand %divide-bignum-step-not-fixnum-or-zero)) + +(define-instruction |DoLshcBignumStep| :operand-from-stack-signed-immediate () + (LDL arg2 0 (isp) "Get arg2") + (LDL t2 4 (isp)) + (SUBQ isp 8 isp "Pop Stack") + (SRL arg1 32 t3) + (EXTLL arg1 0 arg1 "Strip type from arg3") + (CheckDataType t3 |TypeFixnum| lshcbignumsteplose t4) + (EXTLL arg2 0 arg2) + (LDL arg3 0 (isp) "Get arg1") + (LDL t1 4 (isp)) + (CheckDataType t2 |TypeFixnum| lshcbignumsteplose t4) + (SLL arg2 32 arg2 "arg2=(ash arg2 32)") + (EXTLL arg3 0 arg3) + (CheckDataType t1 |TypeFixnum| lshcbignumsteplose t4) + (BIS arg3 arg2 arg4 "arg1+(ash arg2 32)") + (SLL arg4 arg1 arg5) + (SRA arg5 32 arg6 "Extract the result") + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2 iSP t1 arg6 "Store the result as a fixnum") + (ContinueToNextInstruction-NoStall) + (label lshcbignumsteplose) + (illegal-operand three-operand-fixnum-type-error)) + + +(comment "Fin.") diff --git a/alpha-emulator/ifunbnum.s b/alpha-emulator/ifunbnum.s new file mode 100644 index 0000000..78187a7 --- /dev/null +++ b/alpha-emulator/ifunbnum.s @@ -0,0 +1,440 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunbnum.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Bignums. */ +.align 5 +.globl DoAddBignumStep +.ent DoAddBignumStep 0 +/* Halfword operand from stack instruction - DoAddBignumStep */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAddBignumStepFP + .globl DoAddBignumStepSP + .globl DoAddBignumStepLP + .globl DoAddBignumStepIM +.align 3 +DoAddBignumStep: +#ifdef TRACING + .byte 0x82 + .asciiz "DoAddBignumStepIM" +#endif +.align 3 +DoAddBignumStepIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoAddBignumStep # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoAddBignumStepSP" +#endif +.align 3 +DoAddBignumStepSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAddBignumStep # [0di] + .byte 0x90 + .asciiz "DoAddBignumStepLP" +#endif +.align 3 +DoAddBignumStepLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAddBignumStep # [1] + .byte 0x84 + .asciiz "DoAddBignumStepFP" +#endif +.align 3 +DoAddBignumStepFP: # Entry point for FP relative +.align 3 +headDoAddBignumStep: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAddBignumStep: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $17, 0($12) # Get arg2 [1] + ldl $2, 4($12) # and its tag [1] + srl $16, 32, $3 # [1-] + extll $16, 0, $16 # Strip type from arg3 [1] + subq $3, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, ADDBIGNUMSTEPLOSE # [1] + ldl $18, -8($12) # Get arg1 [0di] + ldl $1, -4($12) # and its tag [1] + extll $17, 0, $17 # Clear sign extension from arg2 [0di] + subq $2, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, ADDBIGNUMSTEPLOSE # [1] + extll $18, 0, $18 # Clear sign extension [0di] + subq $1, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, ADDBIGNUMSTEPLOSE # [1] + addq $16, $17, $19 # [0di] + addq $18, $19, $20 # [1] + srl $20, 32, $21 # Shift the carry into arg6 [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $20, -8($12) # Store fixnum result [1] + stl $1, -4($12) # write the stack cache [1] + stl $21, 0($12) # Store the carry if any [1] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +ADDBIGNUMSTEPLOSE: + bis $31, 0, $20 # [1-] + bis $31, 76, $17 # [1] + br $31, ILLEGALOPERAND +.end DoAddBignumStep +/* End of Halfword operand from stack instruction - DoAddBignumStep */ +.align 5 +.globl DoSubBignumStep +.ent DoSubBignumStep 0 +/* Halfword operand from stack instruction - DoSubBignumStep */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSubBignumStepFP + .globl DoSubBignumStepSP + .globl DoSubBignumStepLP + .globl DoSubBignumStepIM +.align 3 +DoSubBignumStep: +#ifdef TRACING + .byte 0x82 + .asciiz "DoSubBignumStepIM" +#endif +.align 3 +DoSubBignumStepIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoSubBignumStep # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoSubBignumStepSP" +#endif +.align 3 +DoSubBignumStepSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoSubBignumStep # [0di] + .byte 0x90 + .asciiz "DoSubBignumStepLP" +#endif +.align 3 +DoSubBignumStepLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoSubBignumStep # [1] + .byte 0x84 + .asciiz "DoSubBignumStepFP" +#endif +.align 3 +DoSubBignumStepFP: # Entry point for FP relative +.align 3 +headDoSubBignumStep: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoSubBignumStep: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $17, 0($12) # Get arg2 [1] + ldl $2, 4($12) # and its tag [1] + srl $16, 32, $3 # [1-] + extll $16, 0, $16 # Strip type from arg3 [1] + subq $3, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, SUBBIGNUMSTEPLOSE # [1] + ldl $18, -8($12) # Get arg1 [0di] + ldl $1, -4($12) # and its tag [1] + extll $17, 0, $17 # Clear sign extension from arg2 [0di] + subq $2, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, SUBBIGNUMSTEPLOSE # [1] + extll $18, 0, $18 # Clear sign extension [0di] + subq $1, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, SUBBIGNUMSTEPLOSE # [1] + subq $18, $17, $19 # arg1-arg2 [0di] + cmplt $19, $31, $21 # arg6=1 if we borrowed in 1st step [1] + extll $19, 0, $19 # Truncate 1st step to 32-bits [1] + subq $19, $16, $20 # (arg1-arg2)-arg3 [2] + cmplt $20, $31, $6 # t6=1 if we borrowed in 2nd step [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $20, -8($12) # Store fixnum result [1] + stl $1, -4($12) # write the stack cache [1] + addq $21, $6, $21 # Compute borrow [1-] + stl $21, 0($12) # Store the borrow if any [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +SUBBIGNUMSTEPLOSE: + bis $31, 0, $20 # [1-] + bis $31, 76, $17 # [1] + br $31, ILLEGALOPERAND +.end DoSubBignumStep +/* End of Halfword operand from stack instruction - DoSubBignumStep */ +.align 5 +.globl DoMultiplyBignumStep +.ent DoMultiplyBignumStep 0 +/* Halfword operand from stack instruction - DoMultiplyBignumStep */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMultiplyBignumStepFP + .globl DoMultiplyBignumStepSP + .globl DoMultiplyBignumStepLP + .globl DoMultiplyBignumStepIM +.align 3 +DoMultiplyBignumStep: +#ifdef TRACING + .byte 0x82 + .asciiz "DoMultiplyBignumStepIM" +#endif +.align 3 +DoMultiplyBignumStepIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoMultiplyBignumStep # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoMultiplyBignumStepSP" +#endif +.align 3 +DoMultiplyBignumStepSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoMultiplyBignumStep # [0di] + .byte 0x90 + .asciiz "DoMultiplyBignumStepLP" +#endif +.align 3 +DoMultiplyBignumStepLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoMultiplyBignumStep # [1] + .byte 0x84 + .asciiz "DoMultiplyBignumStepFP" +#endif +.align 3 +DoMultiplyBignumStepFP: # Entry point for FP relative +.align 3 +headDoMultiplyBignumStep: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoMultiplyBignumStep: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $17, 0($12) # Get arg1 [1] + ldl $1, 4($12) # [1] + srl $16, 32, $2 # [1-] + extll $16, 0, $16 # Strip type from arg2 [1] + subq $2, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, MULTBIGNUMSTEPLOSE # [1] + extll $17, 0, $17 # [0di] + subq $1, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, MULTBIGNUMSTEPLOSE # [1] + mulq $17, $16, $18 # arg1*arg2 [0di] + extll $18, 4, $21 # arg6=high order word [23] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $18, 0($12) # Store fixnum result ls word [1] + stl $1, 4($12) # write the stack cache [1] + stl $21, 8($12) # Store ms word [1] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +MULTBIGNUMSTEPLOSE: + bis $31, 0, $20 # [1-] + bis $31, 80, $17 # [1] + br $31, ILLEGALOPERAND +.end DoMultiplyBignumStep +/* End of Halfword operand from stack instruction - DoMultiplyBignumStep */ +.align 5 +.globl DoDivideBignumStep +.ent DoDivideBignumStep 0 +/* Halfword operand from stack instruction - DoDivideBignumStep */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoDivideBignumStepFP + .globl DoDivideBignumStepSP + .globl DoDivideBignumStepLP + .globl DoDivideBignumStepIM +.align 3 +DoDivideBignumStep: +#ifdef TRACING + .byte 0x82 + .asciiz "DoDivideBignumStepIM" +#endif +.align 3 +DoDivideBignumStepIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoDivideBignumStep # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoDivideBignumStepSP" +#endif +.align 3 +DoDivideBignumStepSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoDivideBignumStep # [0di] + .byte 0x90 + .asciiz "DoDivideBignumStepLP" +#endif +.align 3 +DoDivideBignumStepLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoDivideBignumStep # [1] + .byte 0x84 + .asciiz "DoDivideBignumStepFP" +#endif +.align 3 +DoDivideBignumStepFP: # Entry point for FP relative +.align 3 +headDoDivideBignumStep: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoDivideBignumStep: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $17, 0($12) # Get arg2 [1] + ldl $1, 4($12) # [1] + srl $16, 32, $2 # [1-] + extll $16, 0, $16 # [1] + subq $2, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, DIVBIGNUMSTEPLOSE1 # [1] + beq $16, DIVBIGNUMSTEPLOSE2 # J. if division by zero [1] + extll $17, 0, $17 # [1-] + ldl $18, -8($12) # Get arg1 [0di] + ldl $3, -4($12) # [1] + subq $1, TypeFixnum, $4 # [0di] + and $4, 63, $4 # Strip CDR code [1] + bne $4, DIVBIGNUMSTEPLOSE1 # [1] + sll $17, 32, $17 # arg2=(ash arg2 32) [1-] + extll $18, 0, $18 # [1] + subq $3, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, DIVBIGNUMSTEPLOSE1 # [1] + bis $18, $17, $19 # arg1+(ash arg2 32) [0di] + divqu $19, $16, $1 # t1 is now the quotient + mulq $1, $16, $2 # [1] + subq $19, $2, $2 # t2 is now the remainder [23] + stl $1, -8($12) # store quotient (already fixnum) [1-] + stl $2, 0($12) # store remainder (already fixnum) [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +DIVBIGNUMSTEPLOSE1: + bis $31, 0, $20 # [1-] + bis $31, 76, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +DIVBIGNUMSTEPLOSE2: + bis $31, 0, $20 # [1] + bis $31, 2, $17 # [1] + br $31, ILLEGALOPERAND +.end DoDivideBignumStep +/* End of Halfword operand from stack instruction - DoDivideBignumStep */ +.align 5 +.globl DoLshcBignumStep +.ent DoLshcBignumStep 0 +/* Halfword operand from stack instruction - DoLshcBignumStep */ + .globl DoLshcBignumStepFP + .globl DoLshcBignumStepSP + .globl DoLshcBignumStepLP + .globl DoLshcBignumStepIM +.align 3 +DoLshcBignumStep: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoLshcBignumStepIM" +#endif +.align 3 +DoLshcBignumStepIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G15863: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoLshcBignumStep # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoLshcBignumStepSP" +#endif +.align 3 +DoLshcBignumStepSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoLshcBignumStep # [0di] + .byte 0x90 + .asciiz "DoLshcBignumStepLP" +#endif +.align 3 +DoLshcBignumStepLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoLshcBignumStep # [1] + .byte 0x84 + .asciiz "DoLshcBignumStepFP" +#endif +.align 3 +DoLshcBignumStepFP: # Entry point for FP relative +.align 3 +headDoLshcBignumStep: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoLshcBignumStep: +/* arg1 has the operand, sign extended if immediate. */ + ldl $17, 0($12) # Get arg2 [1] + ldl $2, 4($12) # [1] + subq $12, 8, $12 # Pop Stack [1] + srl $16, 32, $3 # [1] + extll $16, 0, $16 # Strip type from arg3 [1] + subq $3, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, LSHCBIGNUMSTEPLOSE # [1] + extll $17, 0, $17 # [1-] + ldl $18, 0($12) # Get arg1 [0di] + ldl $1, 4($12) # [1] + subq $2, TypeFixnum, $4 # [0di] + and $4, 63, $4 # Strip CDR code [1] + bne $4, LSHCBIGNUMSTEPLOSE # [1] + sll $17, 32, $17 # arg2=(ash arg2 32) [1-] + extll $18, 0, $18 # [1] + subq $1, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, LSHCBIGNUMSTEPLOSE # [1] + bis $18, $17, $19 # arg1+(ash arg2 32) [0di] + sll $19, $16, $20 # [1] + sra $20, 32, $21 # Extract the result [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $21, 0($12) # Store the result as a fixnum [1] + stl $1, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +LSHCBIGNUMSTEPLOSE: + bis $31, 0, $20 # [1-] + bis $31, 76, $17 # [1] + br $31, ILLEGALOPERAND +.end DoLshcBignumStep +/* End of Halfword operand from stack instruction - DoLshcBignumStep */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunbnum.as */ diff --git a/alpha-emulator/ifuncom1.as b/alpha-emulator/ifuncom1.as new file mode 100644 index 0000000..c2cc64c --- /dev/null +++ b/alpha-emulator/ifuncom1.as @@ -0,0 +1,681 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "The most commonly used instructions, part 1. ") + +;;; The functions in this file are pretty much in order of usage count for +;;; a set of representative "benchmarks" (compiler, window system, UI). +;;; The exception to the ordering is that sometimes short procedures are +;;; placed just before another longer one that will be tail-called, in +;;; order to get better instruction fetching behavior. + + +;;; From IFUNMOVE.AS + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline. Not only that, but we +;; even do the NextInstruction here, which saves us three cycles over +;; branching to NextInstruction. Since PushFP accounts for nearly 1/10 +;; of all instructions executed, this is nothing to sneeze at. +(define-instruction |DoPush| :operand-from-stack (:own-immediate t) + (GetNextPC) + (ADDQ iSP 8 iSP "Push the new value") + (GetNextCP) + (stack-read2 arg1 t1 t2 "Get the tag/data" :signed t) + (stack-write-data iSP t2 "Store the data word") + (force-alignment) + (TagType t1 t1 "make it CDR NEXT") + (stack-write-tag iSP t1 "Store the TAG - this *DOES* dual issue!") + ;; Falls through to cacheValid +) + +;; From idispat, this is here so DoPush can fall into it, saving a +;; branch and cycle +(define-procedure |nextInstruction| () + (label cacheValid) + (LDQ arg3 CACHELINE_INSTRUCTION (iCP) "Grab the instruction/operand while stalled") + (LDA arg1 0 (iFP) "Assume FP mode") + (LDQ t2 CACHELINE_PCDATA (iCP) "Get the PC to check cache hit.") + (LDA arg4 -8 (iSP) "SP-pop mode constant") + (label continuecurrentinstruction) + (LDQ t3 CACHELINE_CODE (iCP) "Instruction handler") + (LDA arg5 #.(* -255 8) (iSP) "SP mode constant") + (STQ iSP PROCESSORSTATE_RESTARTSP (ivory) "Need this in case we take a trap") + (EXTBL arg3 5 t4 "Get the mode bits") + (SUBQ t2 iPC t2 "check for HIT.") + (LDQ arg6 0 (iSP) "Load TOS in free di slot") + (EXTBL arg3 4 arg2 "Extract (8-bit, unsigned) operand") + (BNE t2 TakeICacheMiss "PC didn't match, take a cache miss") + (CMOVLBS t4 iLP arg1 "LP or Immediate mode") + (passthru "#ifdef TRACING") + (maybe-icount t4) + (maybe-trace t4 t5 t6 t7 t8 t9 t3) + (passthru "#endif") + (passthru "#ifdef STATISTICS") + (maybe-statistics t4 t5 t6 t7 t8 t9) + (passthru "#endif") + (passthru "#ifdef CACHEMETERING") + (maybe-meter-hit t4 t5 t6 t7 t8 t9) + (passthru "#endif") + (passthru "#ifdef DEBUGGING") + (BEQ t3 haltmachine "Just in case...") + (passthru "#endif") + + ;; Carefully hand-calculated constant that the assembler should + ;; generate for us --- If you re-arrange nextInstruction and/or + ;; DoPush, you have to re-calculate this: + ;; (ldb (byte 14 2) (- DoPushFP .+1)) + ;; where .+1 is the pc after the JMP + (JMP zero t3 #x3FE6 "Jump to the handler") + + (comment "Here to advance the PC and begin a new instruction. Most") + (comment "instructions come here when they have finished. Instructions") + (comment "that explicitly update the PC (and CP) go to interpretInstruction.") + (label nextInstruction) + (LDQ iPC CACHELINE_NEXTPCDATA (iCP) "Load the next PC from the cache") + (LDQ iCP CACHELINE_NEXTCP (iCP) "Advance cache position") + (BR zero cacheValid) + + ;; When ICacheFill precedes iInterpret, we put this label here in + ;; order to get conditional branch prediction right + #-iCacheMiss-after-iInterpret (label TakeICacheMiss) + #-iCacheMiss-after-iInterpret (external-branch ICacheMiss) +) + +(define-procedure |DoPushImmediateHandler| () + (immediate-handler |DoPush|) + (GetNextPCandCP) + (stack-push-ir |TypeFixnum| arg2 t4 "Push it with CDR-NEXT onto the stack") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNLOOP.AS + +(define-instruction |DoBranchTrue| :10-bit-signed-immediate (:own-immediate t :needs-tos t) + (ibranchcond nil t t nil |BranchException|)) ;and-pop else-pop + +(define-instruction |DoBranchFalse| :10-bit-signed-immediate (:own-immediate t :needs-tos t) + (ibranchcond t t t nil |BranchException|)) ;invert and-pop else-pop + + +;;; From IFUNFCAL.AS + +;; Register conventions for return instruction: +;; arg1 is 10-bit immediate (unused) +;; arg2 is 8-bits of that +;; arg3 is the return value (with cdr already cleared) +;; arg4 is the disposition dispatch +;; arg5 is the control register +;; arg6 is stack-cache-data (for underflow check) + +;; Return completes by branching to StackCacheUnderflowCheck, which goes +;; to NextInstruction after dealing with underflow. In the for-return +;; case, this re-executes the instruction one frame up. We only need +;; the low bit of the immediate argument, which is already available in +;; arg2, so we use :own-immediate. +(define-instruction |DoReturnSingle| :10-bit-immediate (:own-immediate t :needs-tos t) + (comment "Fetch value based on immediate, interleaved with compute disposition dispatch") + (get-control-register arg5) + ;; inline (stack-top arg3 :tos-valid t) + (SLL arg6 #.(- 64 38) arg3 "Clear cdr") + (load-constant t3 #.(* 3 1_18) "value disposition mask") + (get-nil t1) + (SRL arg3 #.(- 64 38) arg3 "Clear cdr") + (get-t t2) + (AND t3 arg5 t3 "mask disposition bits") + (SRL t3 18 t3 "shift disposition bits into place") + (LDQ arg6 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (comment "arg2 is 8 bits of \"kludge operand\" 0=TOS 40=NIL 41=T") + (CMOVGT arg2 t1 arg3) + (SUBQ t3 2 arg4 "arg4 -2=effect -1=value 0=return 1=multiple") + (CMOVLBS arg2 t2 arg3) + ;; Return-multiple comes here for effect and value cases after + ;; loading arg3, arg4, arg5, and arg6 appropriately + (label returncommontail) + ;; Load's pc if arg4 /= 0 + (abandon-frame-simple (not arg4) arg5 returnsinglecleanup t1 t2 t3 t4 t5 t6 t7) + (force-alignment) + (CMPULT iFP arg6 arg6 "ARG6 = stack-cache underflow") + (comment "arg4 -2=effect -1=value 0=return 1=multiple") + (BEQ arg4 returnsinglereturn) + (BLBC arg4 returnsingleeffect) + ;; Cdr already cleared, so we can use raw push here + (stack-push-with-cdr arg3) + (BGT arg4 returnsinglemultiple) + (label returnsingleeffect) + (label returnsingledone) + (branch-true arg6 returnsingleunderflow) +;; Unneeded +;; (BEQ arg4 returnsingleretry "For return, simply retry") + (BEQ t7 interpretInstructionForBranch "No prediction, validate cache") + ;; Duplicate code from (label interpretInstructionPredicted) + (FETCH 0 (t7)) + (BIS t7 zero iCP) + (ContinueToInterpretInstruction) + (label returnsinglemultiple) + (stack-push-fixnumb 1 t8 "Multiple-value group") + (BR zero returnsingledone) + (label returnsinglereturn) + ;; repush arg only if TOS arg, + (BNE arg2 returnsingledone) + (stack-push-with-cdr arg3) + (BR zero returnsingledone) + (label returnsinglecleanup) + (external-branch handleframecleanup) + (label returnsingleunderflow) + (external-branch |StackCacheUnderflowCheck|)) + + +;;; From IFUNFULL.AS + +(passthru ".globl callindirectprefetch") +#|| +(define-instruction |callindirect| :full-word-instruction () + (label |callindirectprefetch|) ;the same as |callindirect| + (EXTLL arg3 0 arg2 "Get operand") + (BIS zero zero arg3 "No extra arg") + (with-multiple-memory-reads (t9 t10 t11 t12) + (BR zero startcallindirect) + )) +||# +(passthru ".globl startcallagain") +(define-instruction |callindirect| :full-word-instruction () + (label |callindirectprefetch|) ;the same as |callindirect| + (EXTLL arg3 0 arg2 "Get operand") + (with-multiple-memory-reads (t9 t10 t11 t12) + (BIS zero zero arg3 "No extra arg") + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t) + (CheckDataType arg5 |TypeCompiledFunction| startcallagain t5) + (BIS zero |TypeEvenPC| arg5) + (push-frame t3 t7 t8 t5 t6) + (GetNextPCandCP) + (set-continuation2r arg5 arg6) + (STQ zero PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (BNE arg3 |callindirectextra|) + (ContinueToNextInstruction-NoStall) + (label |callindirectextra|) + (LDL t1 PROCESSORSTATE_CONTROL (ivory)) + (load-constant t2 #.1_8 "cr.extra-argument") + (stack-push2 arg3 arg4 t3 "Push the extra arg.") + (BIS t1 t2 t1 "Set the extra arg bit") + (STL t1 PROCESSORSTATE_CONTROL (Ivory) "Save control with new state") + (ContinueToNextInstruction-NoStall))) + +;;; From IFUNFCAL.AS + +;; This handles both the apply and the non-apply cases +(define-instruction |DoFinishCallN| :10-bit-immediate (:own-immediate t) + (comment "arg2 contains the 8 bit N+1") + (EXTBL arg3 5 arg1 "arg1 contains the disposition (two bits)") + (S8ADDQ arg2 zero arg2 "convert N to words (stacked words that is)") + (label finishcallmerge) + ;; ARG3 contains opcode, from which we compute apply-p + (finish-call-guts arg2 arg1 arg3 t1 t2 t3 t4 t5 t6 t7)) + +(define-instruction |DoEntryRestNotAccepted| :entry-instruction () + (SRL arg5 27 t2 "Get the cr.trace-pending bit") + (AND arg5 #xFF t1 "The supplied args") + (BLBS t2 TraceTrap) + (b-apply-argument-supplied applysupprna t2 t3 t4 arg5) + (SUBQ t1 arg2 t2 "t2=supplied-minimum") + (BLT t2 retryernatoofew "B. if too few args.") + (SUBQ arg4 t1 arg1 "maximum-supplied") + (BLT arg1 retryernatoomany "B. if too many args.") + (enter-function t2 t3 t4) ;doesn't return + (label applysupprna) + (SUBQ arg4 t1 arg1) + ;; Not LT, since the apply arg is at least one argument! If you + ;; need to pull 0, you have too many args + (BLE arg1 retryernatoomany "B. if too many args.") + ;; Pulls arg1 args and retries the instruction + (BR zero |PullApplyArgs|) + (label retryernatoomany) + (illegal-operand too-many-arguments) + (label retryernatoofew) + (illegal-operand too-few-arguments)) + + +;;; This small trampoline is near it's popular callee so you gan get to +;;; the PullApplyArgs tail from xxx-dispatch without a cache miss +(define-procedure |VerifyGenericArity| () + (verify-generic-arity arg2 arg5 t11)) + +;; Not clear where this really belongs. Kept it here with it's most +;; popular caller + +(define-procedure |PullApplyArgs| (arg1) + ;; W-M-M-R for VMAinStackCache, which is used several times + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (pull-apply-args arg1 t1 t2 InterpretInstruction t4 t5 t6 t7 t8 t9 t10 t11))) + + +;;; From IFUNFULL.AS + +(define-instruction |valuecell| :full-word-instruction () + (EXTLL arg3 0 arg2 "Get address") + (with-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)) + (GetNextPCandCP) + (stack-push2 arg5 arg6 t3 "Push the result") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |pushconstantvalue| :full-word-instruction () + (GetNextPCandCP) + (stack-push-with-cdr arg3) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNPRED.AS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoZerop| :operand-from-stack (:own-immediate t) + (simple-unary-arithmetic-predicate zerop CMOVEQ FBEQ) + ;; This is a VERY common idiom used to push NIL or T using a halfword + ;; instruction. + (immediate-handler |DoZerop|) + (LDQ t2 PROCESSORSTATE_TADDRESS (ivory)) + (ADDQ iSP 8 iSP) + (LDQ t1 PROCESSORSTATE_NILADDRESS (ivory)) + (GetNextPCandCP) + (CMOVEQ arg2 t2 t1) + (stack-write iSP t1 "yes Virginia, we dual issue with above yahoo") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoSetSpToAddress| :operand-from-stack () + (GetNextPCandCP) + (BIS zero arg1 iSP "Set iSP=address of operand") + (ContinueToNextInstruction-NoStall)) + +;;; From IFUNPRED.AS + +;; DoEqNoPop is handled here, too... +;; Note the |DoEqIM| is in IFUNCOM2.AS (yeah, it's wierd) +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoEq| :operand-from-stack (:own-immediate t :needs-tos t) + (LDQ t11 PROCESSORSTATE_NILADDRESS (ivory)) + (SRL arg3 #.(+ 10 2) arg3) + (LDQ t12 PROCESSORSTATE_TADDRESS (ivory)) + (stack-read arg1 arg1 "load op2") + (GetNextPC) + (AND arg3 1 arg3 "1 if no-pop, 0 if pop") + (GetNextCP) + ;; inline (stack-top t3 "Load op1 into t3" :tos-valid t) + (XOR arg6 arg1 t3 "compare tag and data") + (SLL t3 #.(- 32 6) t3 "shift off the cdr code") + (S8ADDQ arg3 iSP iSP "Either a stack-push or a stack-write") + (CMOVEQ t3 t12 t11 "pick up T or NIL") + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoAref1| :operand-from-stack-immediate (:own-immediate t :needs-tos t) + (stack-top2 arg3 arg4 "Get the array tag/data" :tos-valid t) + (ADDL arg1 0 arg2 "(sign-extended, for fast bounds check) Index Data") + (LDA t8 |AutoArrayRegMask| (zero)) + (AND arg4 t8 t8) + ;(SLL t8 |AutoArrayRegShift| t8) ; mask is in place, so shift is zero. + (SRL arg1 32 arg1 "Index Tag") + (LDA t7 PROCESSORSTATE_AC0ARRAY (ivory)) + (ADDQ t7 t8 t7 "This is the address if the array register block.") + (CheckDataType arg1 |TypeFixnum| Aref1Illegal t1) + (label aref1merge) + (BEQ arg4 |Aref1Regset|) ;+++ + (LDQ t8 ARRAYCACHE_ARRAY (t7) "Cached array object.") + ;; Array or String + (CheckAdjacentDataTypes arg3 |TypeArray| 2 ReallyAref1Exc t1) + (CMPEQ arg4 t8 t8 "t8==1 iff cached array is ours.") + (branch-false t8 |Aref1Regset| "Go and setup the array register.") + (passthru "#ifdef SLOWARRAYS") + (BR zero |Aref1Regset|) + (passthru "#endif") + ;; Get control register, base, and length. Don't need any data types + ;; since we checked all that when we set up the array register. + (LDQ arg6 ARRAYCACHE_ARWORD (t7)) + (LDQ t9 ARRAYCACHE_LOCAT (t7) "high order bits all zero") + (LDQ t3 ARRAYCACHE_LENGTH (t7) "high order bits all zero") + (SLL arg6 #.(- 64 |array$K-registereventcountsize|) t5) + (LDQ t4 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (SRL t5 #.(- 64 |array$K-registereventcountsize|) t5) + ;; (check-array-bounds arg2 t3 Aref1Bounds t2) + (CMPULT arg2 t3 t2) + (SUBQ t4 t5 t6) + (BNE t6 |Aref1Regset| "J. if event count ticked.") + (branch-false t2 Aref1Bounds) + (SRL arg6 |ArrayRegisterBytePackingPos| arg5) + (SRL arg6 |ArrayRegisterByteOffsetPos| arg4) + (SRL arg6 |ArrayRegisterElementTypePos| t8) + (AND arg4 |ArrayRegisterByteOffsetMask| arg4) + (AND arg5 |ArrayRegisterBytePackingMask| arg5) + (AND t8 |ArrayRegisterElementTypeMask| arg6) + (label Aref1Restart) + (new-aref-1-internal arg3 t9 arg5 arg4 arg6 arg2 t1 t2 t3 t5 t6) + (immediate-handler |DoAref1|) + (LDA t8 |AutoArrayRegMask| (zero)) + (stack-top2 arg3 arg4 "Get the array tag/data") + (LDA t7 PROCESSORSTATE_AC0ARRAY (ivory)) + (AND arg4 t8 t8) + ;(SLL t8 |AutoArrayRegShift| t8) + (ADDQ t7 t8 t7 "This is the address of the array register block.") + (BR zero aref1merge)) + +(define-instruction |DoTypeMember| :10-bit-immediate (:own-immediate t) + (itypemember)) + +;;; From IFUNSUBP.AS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoPointerPlus| :operand-from-stack (:own-immediate t :needs-tos t) + (GetNextPCandCP) + (stack-read-data arg1 t2 "Get the data of op2" :signed t :tos-valid t) + ;; inline (stack-read-data iSP t1 "Get the data of op1" :signed t :tos-valid t) + (ADDL arg6 t2 t3 "(%32-bit-plus (data arg1) (data arg2))") + (stack-write-data iSP t3 "Put result back on the stack") + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoPointerPlus|) + (SLL arg2 #.(- 64 8) t2) + (GetNextPCandCP) + (SRA t2 #.(- 64 8) t2) + (force-alignment) + ;; inline (stack-read-data iSP t1 "Get the data of op1" :signed t :tos-valid t) + (ADDL arg6 t2 t3 "(%32-bit-plus (data arg1) (data arg2))") + (stack-write-data iSP t3 "Put result back on the stack") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNFEXT.AS + +;; Must implement this as if it were a ROT followed by a LOGAND as the +;; compiler will generate a LDB instruction instead of a ROT instruction +;; for constant rotations. +(define-instruction |DoLdb| :field-extraction (:needs-tos t) + (stack-read2 iSP arg3 arg4 "get ARG1 tag/data" :tos-valid t) + ;; inline (CheckDataType arg3 |TypeFixnum| LdbException t8) + (TagType arg3 t8) + (SUBQ t8 |TypeFixnum| t9) + (SLL arg4 arg2 t3 "Shift ARG1 left to get new high bits") + (BNE t9 LdbException "Not a fixnum") ;in |OutOfLineExceptions| + (load-constant t7 -2) + (GetNextPC) + (EXTLL t3 4 t6 "Get new low bits") + (GetNextCP) + (SLL t7 arg1 t7 "Unmask") + (BIS t3 t6 t3 "Glue two parts of shifted operand together") + (stack-write-tag iSP t8 "T8 is TypeFixnum from above") + (BIC t3 t7 t3 "T3= masked value.") + (stack-write-data iSP t3) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMOVE.AS + +#+experiment +;; Also handles DoSetSpToAddressSaveTos +(define-instruction |DoSetSpToAddress| :operand-from-stack () + (GetNextPC) + (SRL arg3 10 arg3 "LBC iff save tos") + (GetNextCP) + (BIS zero arg1 iSP "Set iSP=address of operand") + (BLBS arg3 cachevalid) + ;; inline (stack-read iSP t1 "Read current stack top." :tos-valid t) + (stack-write arg1 arg6 "Restore the TOS.") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoSetSpToAddressSaveTos| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + (BIS arg1 zero iSP "Set the stack top as specified.") + ;; inline (stack-read iSP t1 "Read current stack top." :tos-valid t) + (stack-write arg1 arg6 "Restore the TOS.") + (ContinueToNextInstruction-NoStall)) + +;; --- sp-pop mode can't be valid for this op? +(define-instruction |DoPop| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + ;; inline (stack-pop t3 "Pop the operand" :tos-valid t) + (SUBQ iSP 8 iSP "Pop Stack.") + (stack-write arg1 arg6 "Store all 40 bits on stack") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoMovem| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + ;; inline (stack-read iSP t3 "Get TOS" :tos-valid t) + (stack-write arg1 arg6 "Store all 40 bits of TOS on stack") + (ContinueToNextInstruction-NoStall)) + +#+experiment +;; Also handles DoPop +(define-instruction |DoMovem| :operand-from-stack (:needs-tos t) + (GetNextPC) + (SRL arg3 10 arg3 "LBC iff pop") + (GetNextCP) + (SUBQ iSP 8 t1 "Maybe pop Stack.") + ;; inline (stack-read iSP t3 "Get TOS" :tos-valid t) + (stack-write arg1 arg6 "Store all 40 bits of TOS on stack") + (CMOVLBC arg3 t1 iSP "Maybe pop Stack.") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMOVE.AS + +(define-instruction |DoPushAddress| :operand-from-stack () + (SCAtoVMA arg1 t1 t2) + (GetNextPCandCP) + (stack-push-ir |TypeLocative| t1 t3) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNSUBP.AS + +;; DoMemoryReadAddress is handled here, too... +(define-instruction |DoMemoryRead| :10-bit-immediate (:needs-tos t) + (SRL arg3 10 t1 "Low bit clear if memory-read, set if memory-read-address") + (AND arg1 #x20 t2 "T2 = fixnum check") + (AND arg1 #x10 t3 "T3 = reset CDR code") + (SRL arg1 6 arg3 "arg3 = cycle type") + (stack-read2 iSP arg1 arg2 "Get tag/data" :tos-valid t) + (with-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg2 arg5 arg6 arg3 t5 t6 t7 t8 nil t)) + (BEQ t2 mrdataok "J. if no check for fixnum.") + ;; --- Should make memory-read do the fixnum check by getting funny + ;; trap tables + (CheckDataType arg5 |TypeFixnum| mrnotfixnum t5) + (label mrdataok) + (GetNextPC) + (CMOVLBS t1 arg1 arg5 "Get original tag if memory-read-address") + (BEQ t3 mrcdrunch "J. if no reset CDR code") + (TagType arg5 arg5) + (label mrcdrunch) + (GetNextCP) + (CMOVLBS t1 arg2 arg6 "Get forwarded address if memory-read-address") + (stack-write2 iSP arg5 arg6) + (ContinueToNextInstruction-NoStall) + (label mrnotfixnum) + (illegal-operand %memory-read-transport-and-fixnum-type-check)) + +;;; From IFUNLOOP.AS + +(define-instruction |DoBranch| :10-bit-signed-immediate () + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LDQ arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (ADDQ iPC arg1 iPC "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (BNE arg2 interpretInstructionPredicted) + (passthru "#endif") + (BR zero interpretInstructionForBranch)) + + +;;; From IFUNGENE.AS + +(define-instruction |DoGenericDispatch| :operand-from-stack () + (generic-dispatch arg1 t1 arg3 arg4 t4 t9 t6 t7 arg2 arg5 t3 t2)) + +;; Takes generic function tag/data in ARG1/t1 and instance tag/data in ARG3/ARG4. +;; Returns mask data in t2, table data in t3, parameter tag/data in T6/T7, +;; and method tag/data in T4/arg3. Clobbers T1 through T5, and T10. +;; Linkage register is R0 +(define-subroutine |LookupHandler| () (r0) + ;; Note well! Don't change these memo registers without also fixing + ;; the call to USING-MULTIPLE-MEMORY-READS in |LookupHandlerMemoryRead| + (with-multiple-memory-reads (t9 t10 t11 t12) + (instance-descriptor-info + arg3 arg4 t2 t3 arg2 arg5 arg6 t5 t6 t7 t8) + ;; Watch it! We're clobbering ARG3/ARG4 to save some cycles! + (lookup-handler + ;; looks bad, but we know t6/t7 are set last thing when they are + ;; no longer needed for temps + arg1 t1 t3 t2 t6 t7 t4 arg3 arg4 arg2 arg5 arg6 t5 t6 t7 t8)) + (BIS arg3 zero t9) ;sigh + ) + +;;; From IFUNSUBP.AS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoSetTag| :operand-from-stack (:own-immediate t) + (stack-read2 arg1 t1 arg2 "Get tag/data of op2" :signed t) + (CheckDataType t1 |TypeFixnum| settagexc t3) + ;; Sneaky immediate handler + (immediate-handler |DoSetTag|) + (GetNextPCandCP) + (stack-write-tag iSP arg2 "Set TAG of op1") + (ContinueToNextInstruction-NoStall) + (label settagexc) + (illegal-operand one-operand-fixnum-type-error)) + +;;; From IFUNLIST.AS + +(define-instruction |DoCar| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (icar arg1 arg5 arg6 arg2 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + #+list-inline (car-internal arg5 arg6 car arg2 t5 t6 t7 t8 t) + #-list-inline (BSR r0 |CarInternal|) + (stack-push2 arg5 arg6 t5) + (ContinueToNextInstruction))) + +#-list-inline +;; --- All the temps aren't really arguments, but they are smashed +(define-subroutine |CarInternal| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (car-internal arg5 arg6 car arg2 t5 t6 t7 t8))) + +(define-instruction |DoCdr| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (icdr arg1 arg5 arg6 arg2 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + #+list-inline (cdr-internal arg5 arg6 cdr arg2 t5 t6 t7 t8 t) + #-list-inline (BSR r0 |CdrInternal|) + (stack-push2 arg5 arg6 t5) + (ContinueToNextInstruction))) + +#-list-inline +;; --- All the temps aren't really arguments, but they are smashed +(define-subroutine |CdrInternal| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (cdr-internal arg5 arg6 cdr arg2 t5 t6 t7 t8))) + + +;;; From IFUNSUBP.AS + +(define-instruction |DoReadInternalRegister| :10-bit-immediate () + (internal-register-dispatch arg1 nil |ReadRegisterError| t1 t2 t3)) + +(define-instruction |DoWriteInternalRegister| :10-bit-immediate (:needs-tos t) + (stack-pop2 arg2 arg3 "Arg2=tag arg3=data" :tos-valid t) + (internal-register-dispatch arg1 t |WriteRegisterError| t1 t2 t3)) + +(define-procedure |WriteRegisterBARx| () + (SRL arg1 7 t2 "BAR number into T2") + (GetNextPC) + (SLL arg2 32 t3 "Make a quadword from tag and data") + (GetNextCP) + (LDA t1 PROCESSORSTATE_BAR0 (ivory)) + (S8ADDQ t2 t1 t1 "Now T1 points to the BAR") + (BIS t3 arg3 t3 "Construct the combined word") + (STQ t3 0 (t1)) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNBLOK.AS + +(define-instruction |DoBlock3Read| :10-bit-immediate () + (LDA arg4 PROCESSORSTATE_BAR3 (ivory)) + (BR zero |BlockRead|)) + +(define-instruction |DoBlock2Read| :10-bit-immediate () + (LDA arg4 PROCESSORSTATE_BAR2 (ivory)) + (BR zero |BlockRead|)) + +(define-instruction |DoBlock1Read| :10-bit-immediate () + (LDA arg4 PROCESSORSTATE_BAR1 (ivory)) + (label |BlockRead|) + (with-multiple-memory-reads (t9 t10 t11 t12) + (i%block-n-read arg4 arg1 arg2 arg5 arg6 arg3 t1 t2 t3 t4 t5 t6 t7 t8))) + +(define-instruction |DoBlock2Write| :operand-from-stack-signed-immediate () + (LDL arg3 PROCESSORSTATE_BAR2 (ivory)) + (LDA arg2 PROCESSORSTATE_BAR2 (ivory)) + (BR zero |BlockWrite|)) + +;; ARG1 has the data to write, put the proper BAR into ARG2 +(define-instruction |DoBlock1Write| :operand-from-stack-signed-immediate () + (LDL arg3 PROCESSORSTATE_BAR1 (ivory)) + (LDA arg2 PROCESSORSTATE_BAR1 (ivory)) + (label |BlockWrite|) + ;; This is a trick, mostly to separate the EXTLL from the LDL + ;; (above). Note that with-multiple-memory-reads really should be + ;; called with-multiple-memory-operations + (with-multiple-memory-reads (t9 t10 t11 t12) + (EXTLL arg3 0 arg3 "Unsigned vma") + (i%block-n-write arg2 arg3 arg1 t1 t2 t3 t4 t5 t6 t7 t8))) + + + +;;; From IFUNLOOP.AS + +(define-instruction |DoBranchTrueNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil nil nil |BranchException|)) ; + +(define-instruction |DoBranchFalseNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil nil nil |BranchException|)) ;invert + +;; The next two are here, not because they are frequent, but they are +;; miniscule and drop right into the start-call code +(passthru ".globl callgenericprefetch") +(define-instruction |callgeneric| :full-word-instruction () + (label |callgenericprefetch|) ;the same as |callgeneric| + (LDQ t3 PROCESSORSTATE_TRAPVECBASE (ivory)) + (BIS arg3 zero arg4 "Get operand") + (BIS zero |TypeGenericFunction| arg3) + ;; Build the constant PC for generic dispatch + (BIS zero |TypeEvenPC| arg5) + (LDA arg6 #.sys:%generic-dispatch-trap-vector t3) + (BR zero startcallcompiledmerge)) + +(passthru ".globl callcompiledevenprefetch") +(define-instruction |callcompiledeven| :full-word-instruction () + (label |callcompiledevenprefetch|) ;the same as |callcompiledeven| + (BIS arg3 zero arg6 "Get operand") + (BIS zero |TypeEvenPC| arg5) + (BIS zero zero arg3 "No extra arg") + (BR zero startcallcompiledmerge)) ;push new frame and exit + +;; Strictly speaking, |DoStartCall| doesn't belong here, but we put it +;; here so that it gets fetched along with |callindirect| +(define-instruction |DoStartCall| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + (stack-read2 arg1 arg5 arg6 :signed t) + (label startcallagain) + (start-call-dispatch arg5 arg6 arg3 arg4 arg2 t1 t2 t3 t5 t6 t7 t8 + startcallcompiledmerge startcallindirect))) + +(comment "Fin.") diff --git a/alpha-emulator/ifuncom1.s b/alpha-emulator/ifuncom1.s new file mode 100644 index 0000000..38584f9 --- /dev/null +++ b/alpha-emulator/ifuncom1.s @@ -0,0 +1,3580 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuncom1.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* The most commonly used instructions, part 1. */ +.align 5 +.globl DoPush +.ent DoPush 0 +/* Halfword operand from stack instruction - DoPush */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPushFP + .globl DoPushSP + .globl DoPushLP + .globl DoPushIM +.align 3 +DoPush: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPushSP" +#endif +.align 3 +DoPushSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoPush # [0di] + .byte 0x90 + .asciiz "DoPushLP" +#endif +.align 3 +DoPushLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPush # [1] + .byte 0x84 + .asciiz "DoPushFP" +#endif +.align 3 +DoPushFP: # Entry point for FP relative +.align 3 +beginDoPush: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + addq $12, 8, $12 # Push the new value [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + ldl $1, 4($16) # Get the tag/data [1] + ldl $2, 0($16) # [1] + stl $2, 0($12) # Store the data word [1] +.align 3 +G13228: +/* TagType. */ + and $1, 63, $1 # make it CDR NEXT [1-] + stl $1, 4($12) # Store the TAG - this *DOES* dual issue! [0di] +.end DoPush +/* End of Halfword operand from stack instruction - DoPush */ +.align 5 +.globl nextInstruction +.ent nextInstruction 0 +.align 3 +nextInstruction: +.align 3 +CACHEVALID: + ldq $18, CACHELINE_INSTRUCTION($13) # Grab the instruction/operand while stalled [1] + lda $16, 0($10) # Assume FP mode [0di] + ldq $2, CACHELINE_PCDATA($13) # Get the PC to check cache hit. [1-] + lda $19, -8($12) # SP-pop mode constant [0di] +.align 3 +CONTINUECURRENTINSTRUCTION: + ldq $3, CACHELINE_CODE($13) # Instruction handler [1-] + lda $20, -2040($12) # SP mode constant [0di] + stq $12, PROCESSORSTATE_RESTARTSP($14) # Need this in case we take a trap [1-] + extbl $18, 5, $4 # Get the mode bits [0di] + subq $2, $9, $2 # check for HIT. [1] + ldq $21, 0($12) # Load TOS in free di slot [0di] + extbl $18, 4, $17 # Extract (8-bit, unsigned) operand [1-] + bne $2, TAKEICACHEMISS # PC didn't match, take a cache miss [0di] + cmovlbs $4, $11, $16 # LP or Immediate mode [1-] +#ifdef TRACING +/* Update the instruction count. */ + ldq $4, PROCESSORSTATE_INSTRUCTION_COUNT($14) # [1] + subq $4, 1, $4 # Decrement the instruction count. [3] + bne $4, G13282 # J. if not reached stop point. [1] + bis $31, $31, $31 # put a breakpoint here to catch stops [0] +.align 3 +G13282: + stq $4, PROCESSORSTATE_INSTRUCTION_COUNT($14) # [1-] +/* Trace instructions if requested. */ + ldq $4, PROCESSORSTATE_TRACE_HOOK($14) # [1] + beq $4, G13287 # J. if not tracing. [3] +/* Record an instruction trace entry */ + ldl $5, TRACEDATA_RECORDING_P($4) # [0di] + ldq $6, TRACEDATA_START_PC($4) # [1] + bne $5, G13283 # Jump if recording is on [2di] + cmpeq $6, $9, $6 # Turn recording on if at the start PC [1-] + stl $6, TRACEDATA_RECORDING_P($4) # [0di] + beq $6, G13287 # Jump if not at the start PC [1] +.align 3 +G13283: + ldq $5, TRACEDATA_CURRENT_ENTRY($4) # Get address of next trace record [1-] + ldq $6, PROCESSORSTATE_INSTRUCTION_COUNT($14) # [1] + stq $9, TRACERECORD_EPC($5) # Save current PC [2] + stq $6, TRACERECORD_COUNTER($5) # Save instruction count [1] + ldq $6, 0($12) # [1] +/* Convert stack cache address to VMA */ + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $8, $8 # stack cache base relative offset [2di] + srl $8, 3, $8 # convert byte address to word address [1] + addq $8, $7, $7 # reconstruct VMA [2] + stq $6, TRACERECORD_TOS($5) # Save current value of TOS [1-] + stq $7, TRACERECORD_SP($5) # Save current SP [1] + ldl $6, CACHELINE_OPERAND($13) # [1] + ldq $7, CACHELINE_CODE($13) # [1] + stl $6, TRACERECORD_OPERAND($5) # Save current instruction's operand [1] + stq $7, TRACERECORD_INSTRUCTION($5) # Save pointer to current instruction code [1] + ldq $7, PROCESSORSTATE_CONTROL($14) # [1] + ldq $8, CACHELINE_INSTRUCTION($13) # [1] + stl $31, TRACERECORD_CATCH_BLOCK_P($5) # We don't yet record catch blocks [1] + stq $7, TRACERECORD_CATCH_BLOCK_0($5) # Save control register [1] + ldq $6, PROCESSORSTATE_TVI($14) # [1] + stq $8, TRACERECORD_INSTRUCTION_DATA($5) # Save full word instruction operand [1] + stl $6, TRACERECORD_TRAP_P($5) # Save trap indiciator [1] + beq $6, G13284 # Jump if didn't trap [1] + ldq $6, 16($10) # [1] + stq $31, PROCESSORSTATE_TVI($14) # Zero flag to avoid false trap entries [1] + ldq $7, 24($10) # [1] + stq $6, TRACERECORD_TRAP_DATA_0($5) # Save trap vector index [1] + ldq $8, 32($10) # [1] + stq $7, TRACERECORD_TRAP_DATA_1($5) # Save fault PC [1] + ldq $22, 40($10) # [1] + stq $8, TRACERECORD_TRAP_DATA_2($5) # Save two additional arguments [1] + stq $22, TRACERECORD_TRAP_DATA_3($5) # [1] +.align 3 +G13284: + addq $5, TRACERECORDSIZE, $5 # Bump to next trace record [1-] + ldq $6, TRACEDATA_RECORDS_START($4) # Get pointer to start of trace records [0di] + stq $5, TRACEDATA_CURRENT_ENTRY($4) # Set record pointer to keep printer happy [1] + ldq $7, TRACEDATA_RECORDS_END($4) # Get pointer to end of trace record [1] + ldq $8, TRACEDATA_PRINTER($4) # Function to print trace if non-zero [1] + cmple $7, $5, $7 # Non-zero iff we're about to wrap the circular buffer [2di] + cmovne $7, $6, $5 # Update next record pointer iff we wrapped [2] + cmoveq $7, $31, $8 # Don't print if we didn't wrap [1] + beq $8, G13285 # Jump if we don't need to print [2] + stq $13, PROCESSORSTATE_CP($14) # [1] + stq $9, PROCESSORSTATE_EPC($14) # [1] + stq $12, PROCESSORSTATE_SP($14) # [1] + stq $10, PROCESSORSTATE_FP($14) # [1] + stq $11, PROCESSORSTATE_LP($14) # [1] + stq $16, PROCESSORSTATE_ASRF2($14) # [1] + stq $17, PROCESSORSTATE_ASRF3($14) # [1] + stq $18, PROCESSORSTATE_ASRF4($14) # [1] + stq $19, PROCESSORSTATE_ASRF5($14) # [1] + stq $20, PROCESSORSTATE_ASRF6($14) # [1] + stq $21, PROCESSORSTATE_ASRF7($14) # [1] + stq $4, PROCESSORSTATE_ASRF8($14) # [1] + stq $5, PROCESSORSTATE_ASRF9($14) # [1] + stq $3, PROCESSORSTATE_LONG_PAD1($14) # [1] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + bis $8, $31, $27 # [0di] + jsr $26, ($8), 0 # [1-] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + ldq $16, PROCESSORSTATE_ASRF2($14) # [1] + ldq $17, PROCESSORSTATE_ASRF3($14) # [1] + ldq $18, PROCESSORSTATE_ASRF4($14) # [1] + ldq $19, PROCESSORSTATE_ASRF5($14) # [1] + ldq $20, PROCESSORSTATE_ASRF6($14) # [1] + ldq $21, PROCESSORSTATE_ASRF7($14) # [1] + ldq $4, PROCESSORSTATE_ASRF8($14) # [1] + ldq $5, PROCESSORSTATE_ASRF9($14) # [1] + ldq $3, PROCESSORSTATE_LONG_PAD1($14) # [1] + ldq $13, PROCESSORSTATE_CP($14) # [1] + ldq $9, PROCESSORSTATE_EPC($14) # [1] + ldq $12, PROCESSORSTATE_SP($14) # [1] + ldq $10, PROCESSORSTATE_FP($14) # [1] + ldq $11, PROCESSORSTATE_LP($14) # [1] + bis $31, $31, $7 # Claim we didn't wrap [0di] +.align 3 +G13285: + stq $5, TRACEDATA_CURRENT_ENTRY($4) # Save next record pointer [1-] + beq $7, G13286 # Jump if we didn't wrap [1] + stl $7, TRACEDATA_WRAP_P($4) # Set flag indicating that we wrapped [1] +.align 3 +G13286: + ldq $5, TRACEDATA_STOP_PC($4) # [1] + cmpeq $5, $9, $5 # Non-zero if at PC where we should stop tracing [3] + cmpeq $5, 0, $5 # Non-zero if not at the PC [2] + stl $5, TRACEDATA_RECORDING_P($4) # Update recording flag [0di] +.align 3 +G13287: +#endif +#ifdef STATISTICS + ldq $4, CACHELINE_CODE($13) # The instruction. [1] + ldq $5, PROCESSORSTATE_STATISTICS($14) # The usage statistics array [1] + lda $22, 8191 # [1-] + srl $4, 4, $6 # [1] + and $6, $22, $6 # Extract the address [2] + s4addq $6, $5, $7 # Compute the index to the usage data for this instn. [1] + ldl $8, 0($7) # Get current usage data [2] + addq $8, 1, $8 # Increment [3] + stl $8, 0($7) # Set current usage data [1-] +#endif +#ifdef CACHEMETERING + ldl $5, PROCESSORSTATE_METERCOUNT($14) # The number of remaining tokens. [1] + ldq $4, PROCESSORSTATE_METERDATABUFF($14) # The cache miss meter buffer. [1] + ldl $7, PROCESSORSTATE_METERPOS($14) # Position for new data. [1] + subq $5, 1, $5 # record a cache hit [1-] + bne $5, G13288 # [1] + ldl $8, PROCESSORSTATE_METERMASK($14) # [1-] + s4addq $7, $4, $4 # position of the current data item [0di] + ldl $22, PROCESSORSTATE_METERVALUE($14) # [1-] + addq $7, 1, $7 # [0di] + and $7, $8, $7 # [2] + ldl $8, PROCESSORSTATE_METERMAX($14) # [1] + subq $22, $8, $6 # [3] + cmovgt $6, $22, $8 # [1] + stl $8, PROCESSORSTATE_METERMAX($14) # [1-] + stl $22, 0($4) # store the datapoint [1] + stl $7, PROCESSORSTATE_METERPOS($14) # Position for new data. [1] + stl $31, PROCESSORSTATE_METERVALUE($14) # [1] + ldl $5, PROCESSORSTATE_METERFREQ($14) # [1] +.align 3 +G13288: + stl $5, PROCESSORSTATE_METERCOUNT($14) # [1] +#endif +#ifdef DEBUGGING + beq $3, HALTMACHINE # Just in case... [1] +#endif + jmp $31, ($3), 16358 # Jump to the handler [1] +/* Here to advance the PC and begin a new instruction. Most */ +/* instructions come here when they have finished. Instructions */ +/* that explicitly update the PC (and CP) go to interpretInstruction. */ +.align 3 +NEXTINSTRUCTION: + ldq $9, CACHELINE_NEXTPCDATA($13) # Load the next PC from the cache [1] + ldq $13, CACHELINE_NEXTCP($13) # Advance cache position [1] + br $31, CACHEVALID # [1] +.align 3 +TAKEICACHEMISS: + br $31, ICACHEMISS +.end nextInstruction +.align 5 +.globl DoPushImmediateHandler +.ent DoPushImmediateHandler 0 +.align 3 +DoPushImmediateHandler: +#ifdef TRACING + br $31, DoPushIM # [1] + .byte 0x82 + .asciiz "DoPushIM" +#endif +.align 5 +.align 3 +DoPushIM: # Entry point for IMMEDIATE mode + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $4 # [1-] + stl $17, 8($12) # Push it with CDR-NEXT onto the stack [0di] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.end DoPushImmediateHandler +.align 5 +.globl DoBranchTrue +.ent DoBranchTrue 0 +/* Halfword 10 bit immediate instruction - DoBranchTrue */ + .globl DoBranchTrueFP + .globl DoBranchTrueSP + .globl DoBranchTrueLP + .globl DoBranchTrueIM +.align 3 +DoBranchTrue: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrue" +#endif +.align 3 +DoBranchTrueIM: +.align 3 +DoBranchTrueSP: +.align 3 +DoBranchTrueLP: +.align 3 +DoBranchTrueFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, DoBrPopElsePop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrPopElsePop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrue +/* End of Halfword operand from stack instruction - DoBranchTrue */ +.align 5 +.globl DoBranchFalse +.ent DoBranchFalse 0 +/* Halfword 10 bit immediate instruction - DoBranchFalse */ + .globl DoBranchFalseFP + .globl DoBranchFalseSP + .globl DoBranchFalseLP + .globl DoBranchFalseIM +.align 3 +DoBranchFalse: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalse" +#endif +.align 3 +DoBranchFalseIM: +.align 3 +DoBranchFalseSP: +.align 3 +DoBranchFalseLP: +.align 3 +DoBranchFalseFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, DoBrnPopElsePop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrnPopElsePop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalse +/* End of Halfword operand from stack instruction - DoBranchFalse */ +.align 5 +.globl DoReturnSingle +.ent DoReturnSingle 0 +/* Halfword 10 bit immediate instruction - DoReturnSingle */ + .globl DoReturnSingleFP + .globl DoReturnSingleSP + .globl DoReturnSingleLP + .globl DoReturnSingleIM +.align 3 +DoReturnSingle: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoReturnSingle" +#endif +.align 3 +DoReturnSingleIM: +.align 3 +DoReturnSingleSP: +.align 3 +DoReturnSingleLP: +.align 3 +DoReturnSingleFP: +/* arg1 has operand preloaded. */ +/* Fetch value based on immediate, interleaved with compute disposition dispatch */ + ldl $20, PROCESSORSTATE_CONTROL($14) # [1] + sll $21, 26, $18 # Clear cdr [0di] + ldah $3, 12 # [1] + ldq $1, PROCESSORSTATE_NILADDRESS($14) # [0di] + srl $18, 26, $18 # Clear cdr [1-] + ldq $2, PROCESSORSTATE_TADDRESS($14) # [0di] + and $3, $20, $3 # mask disposition bits [1-] + srl $3, 18, $3 # shift disposition bits into place [1] + ldq $21, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] +/* arg2 is 8 bits of "kludge operand" 0=TOS 40=NIL 41=T */ + cmovgt $17, $1, $18 # [0di] + subq $3, 2, $19 # arg4 -2=effect -1=value 0=return 1=multiple [1] + cmovlbs $17, $2, $18 # [1] +.align 3 +RETURNCOMMONTAIL: +/* Restore machine state from frame header. */ + ldl $3, 0($10) # [1-] + ldah $1, 1792 # [0di] + ldl $5, PROCESSORSTATE_CONTINUATION($14) # [1-] + and $20, $1, $1 # Mask [0di] + ldl $2, 4($10) # [1-] + bis $13, $31, $7 # [0di] + bne $1, RETURNSINGLECLEANUP # Need to cleanup frame first [1-] + extll $3, 0, $3 # [0di] + ldl $4, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + extll $5, 0, $5 # [0di] +#ifdef IVERIFY +/* check for instruction verification suite end-of-test */ + subl $2, TypeNIL, $6 # check for end of run [1] + beq $6, G13313 # [1] +#endif + ldl $6, 8($10) # Get saved control register [1] +/* TagType. */ + and $2, 63, $2 # [0di] +/* Restore the PC. */ + beq $19, G13315 # [1-] + sll $5, 1, $9 # Assume even PC [0di] + and $4, 1, $1 # [1] + ldq $7, PROCESSORSTATE_CONTINUATIONCP($14) # [0di] + addq $9, $1, $9 # [1-] +.align 3 +G13315: +/* Restore the saved continuation */ + stl $2, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + srl $20, 9, $1 # Get the caller frame size into place [0di] + stl $3, PROCESSORSTATE_CONTINUATION($14) # [1-] + subq $10, 8, $12 # Restore the stack pointer. [0di] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [1-] + and $1, 255, $1 # Mask just the caller frame size. [0di] + s8addq $1, 0, $1 # *8 [1] + ldah $2, 2048 # [1] + and $2, $20, $2 # [1] + ldl $3, PROCESSORSTATE_INTERRUPTREG($14) # Get the preempt-pending bit [0di] + bis $2, $6, $6 # Sticky trace pending bit. [1-] + ldq $4, PROCESSORSTATE_PLEASE_STOP($14) # Get the trap/suspend bits [0di] + subq $10, $1, $10 # Restore the frame pointer. [1-] + stl $6, PROCESSORSTATE_CONTROL($14) # Restore the control register [0di] + and $6, 255, $1 # extract the argument size [1-] + and $3, 1, $3 # [1] + bis $4, $3, $3 # [1] + stq $3, PROCESSORSTATE_STOP_INTERPRETER($14) # [0di] + s8addq $1, $10, $11 # Restore the local pointer. [1-] +.align 3 +G13316: + cmpult $10, $21, $21 # ARG6 = stack-cache underflow [1] +/* arg4 -2=effect -1=value 0=return 1=multiple */ + beq $19, RETURNSINGLERETURN # [0di] + blbc $19, RETURNSINGLEEFFECT # [1] + stq $18, 8($12) # [1] + addq $12, 8, $12 # [1-] + bgt $19, RETURNSINGLEMULTIPLE # [0di] +.align 3 +RETURNSINGLEEFFECT: +.align 3 +RETURNSINGLEDONE: + bne $21, RETURNSINGLEUNDERFLOW # [1] + beq $7, INTERPRETINSTRUCTIONFORBRANCH # No prediction, validate cache [1] + fetch 0($7) # [1-] + bis $7, $31, $13 # [0di] + br $31, INTERPRETINSTRUCTION # [1-] +.align 3 +RETURNSINGLEMULTIPLE: + bis $31, TypeFixnum, $8 # Multiple-value group [1-] + sll $8, 32, $8 # [1] + addq $12, 8, $12 # [1] + bis $8, 1, $8 # [1] + stq $8, 0($12) # Push Fixnum [1-] + br $31, RETURNSINGLEDONE # [1] +.align 3 +RETURNSINGLERETURN: + bne $17, RETURNSINGLEDONE # [1] + stq $18, 8($12) # [1] + addq $12, 8, $12 # [1-] + br $31, RETURNSINGLEDONE # [0di] +.align 3 +RETURNSINGLECLEANUP: + br $31, HANDLEFRAMECLEANUP +.align 3 +RETURNSINGLEUNDERFLOW: + br $31, StackCacheUnderflowCheck +.end DoReturnSingle +/* End of Halfword operand from stack instruction - DoReturnSingle */ +.globl callindirectprefetch +.globl startcallagain +.align 5 +.globl callindirect +.ent callindirect 0 +/* Fullword instruction - callindirect */ +#ifdef TRACING + .byte 0x80 + .asciiz "callindirect" +#endif +.align 3 +callindirect: +.align 3 +callindirectprefetch: + extll $18, 0, $17 # Get operand [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + bis $31, $31, $18 # No extra arg [0di] +/* Memory Read Internal */ +G13333: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13335 # [1-] +G13334: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13337 # [1-] +G13344: + subq $20, TypeCompiledFunction, $5 # [0di] + and $5, 63, $5 # Strip CDR code [1] + bne $5, STARTCALLAGAIN # [1] + bis $31, TypeEvenPC, $20 # [1-] + ldl $7, PROCESSORSTATE_CONTINUATION+4($14) # [0di] + addq $12, 16, $12 # prepare to push continuation/control register [1-] + ldl $3, PROCESSORSTATE_CONTROL($14) # [0di] + bis $31, TypeFixnum+0xC0, $6 # [1-] + ldl $8, PROCESSORSTATE_CONTINUATION($14) # [0di] + ldah $5, 64 # [1-] + bis $7, 192, $7 # Set CDR code 3 [1] + stl $8, -8($12) # push continuation [1-] + stl $7, -4($12) # write the stack cache [1] + bis $3, $5, $8 # Set call started bit in CR [1-] + lda $5, 256 # [1] + stl $3, 0($12) # Push control register [1-] + stl $6, 4($12) # write the stack cache [1] + bic $8, $5, $8 # Clear the extra arg bit [1-] + stl $8, PROCESSORSTATE_CONTROL($14) # Save control with new state [0di] +/* End of push-frame */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $21, PROCESSORSTATE_CONTINUATION($14) # [1] + stl $20, PROCESSORSTATE_CONTINUATION+4($14) # [1] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [1] + bne $18, callindirectextra # [1] + br $31, CACHEVALID # [1] +.align 3 +callindirectextra: + ldl $1, PROCESSORSTATE_CONTROL($14) # [1] + lda $2, 256 # [0di] + and $18, 63, $3 # set CDR-NEXT [1] + stl $19, 8($12) # Push the extra arg. [0di] + stl $3, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $1, $2, $1 # Set the extra arg bit [1] + stl $1, PROCESSORSTATE_CONTROL($14) # Save control with new state [0di] + br $31, CACHEVALID # [1] +.align 3 +G13337: + blbc $7, G13336 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13333 # [1-] +.align 3 +G13336: +.align 3 +G13335: + bsr $0, MemoryReadDataDECODE + br $31, G13344 # [1] +.end callindirect +/* End of Fullword instruction - callindirect */ +.align 5 +.globl DoFinishCallN +.ent DoFinishCallN 0 +/* Halfword 10 bit immediate instruction - DoFinishCallN */ + .globl DoFinishCallNFP + .globl DoFinishCallNSP + .globl DoFinishCallNLP + .globl DoFinishCallNIM +.align 3 +DoFinishCallN: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoFinishCallN" +#endif +.align 3 +DoFinishCallNIM: +.align 3 +DoFinishCallNSP: +.align 3 +DoFinishCallNLP: +.align 3 +DoFinishCallNFP: +/* arg1 has operand preloaded. */ +/* arg2 contains the 8 bit N+1 */ + extbl $18, 5, $16 # arg1 contains the disposition (two bits) [1-] + s8addq $17, $31, $17 # convert N to words (stacked words that is) [1] +.align 3 +FINISHCALLMERGE: + srl $18, 7, $18 # [1] + ldl $6, PROCESSORSTATE_SCOVLIMIT($14) # Current stack cache limit (words) [0di] + lda $3, 128 # [1-] + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [0di] + s8addq $3, $12, $3 # SCA of desired end of cache [1-] + s8addq $6, $4, $4 # SCA of current end of cache [2] + cmple $3, $4, $6 # [1] + beq $6, G13353 # We're done if new SCA is within bounds [1] + and $18, 8, $18 # 0 if not apply, 8 if apply [1-] + ldl $1, PROCESSORSTATE_CONTROL($14) # Get the control register [0di] +/* Compute the new LP */ + lda $11, 8($12) # Assume not Apply case. [1-] + subq $11, $18, $11 # For apply, iLP==iSP [1] +/* Compute the new FP */ + srl $1, 5, $3 # extra arg bit<<3 [1] + subq $12, $17, $2 # [1] + and $3, 8, $3 # 8 if extra arg, 0 otherwise. [1] + subq $2, $3, $2 # This! is the new frame pointer! [1] +/* compute arg size */ + subq $11, $2, $4 # [1] + srl $4, 3, $4 # arg size in words. [1] +/* compute caller frame size. */ + subq $2, $10, $5 # [1] + srl $5, 3, $5 # caller frame size in words. [1] +/* Now hack the control register! */ + sll $16, 18, $7 # Get value disposition into place [1] + ldq $6, PROCESSORSTATE_FCCRMASK($14) # cr.caller-frame-size [0di] + sll $5, 9, $5 # Shift caller frame size into place [1-] + bis $7, $4, $7 # Add arg size to new bits. [1] + sll $18, 14, $4 # Apply bit in place [1] + bis $5, $7, $7 # Add frame size to new bits [1] + bis $4, $7, $7 # All new bits assembled! [1] +/* Set the return continuation. */ + ldq $5, CACHELINE_NEXTPCDATA($13) # Next instruction hw format [0di] + and $1, $6, $1 # Mask off unwanted bits [1-] + ldl $4, PROCESSORSTATE_CONTINUATION($14) # Get the new PC tag/data [0di] + bis $1, $7, $1 # Add argsize, apply, disposition, caller FS [1-] + ldl $3, PROCESSORSTATE_CONTINUATION+4($14) # [0di] +/* Update the PC */ +/* Convert PC to a real continuation. */ + and $5, 1, $6 # [1-] + srl $5, 1, $7 # convert PC to a real word address. [1] + lda $6, TypeEvenPC($6) # [1] + extll $4, 0, $4 # [1] +/* Convert real continuation to PC. */ + and $3, 1, $9 # [1] + addq $4, $9, $9 # [1] + addq $4, $9, $9 # [1] + stl $7, PROCESSORSTATE_CONTINUATION($14) # [0di] + stl $6, PROCESSORSTATE_CONTINUATION+4($14) # Set return address [1] +/* Update CP */ + ldah $7, 4096 # [0di] + ldq $5, CACHELINE_NEXTCP($13) # [1-] + and $7, $1, $7 # [0di] + srl $7, 1, $7 # Shift into trace pending place [1] + stq $5, PROCESSORSTATE_CONTINUATIONCP($14) # [0di] + bis $1, $7, $1 # Set the cr.trace pending if appropriate. [2-] + stl $1, PROCESSORSTATE_CONTROL($14) # Set the control register [0di] + bis $2, $31, $10 # Install the new frame pointer [1-] + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +/* Check for stack overflow */ + srl $1, 30, $1 # Isolate trap mode [1-] + ldl $3, PROCESSORSTATE_CSLIMIT($14) # Limit for emulator mode [0di] + ldl $4, PROCESSORSTATE_CSEXTRALIMIT($14) # Limit for extra stack and higher modes [1] + cmovne $1, $4, $3 # Get the right limit for the current trap mode [3] + extll $3, 0, $3 # Might have been sign extended [2] +/* Convert stack cache address to VMA */ + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $4, $4 # stack cache base relative offset [2di] + srl $4, 3, $4 # convert byte address to word address [1] + addq $4, $1, $1 # reconstruct VMA [2] + cmplt $1, $3, $4 # Check for overflow [1] + beq $4, STACKOVERFLOW # Jump if overflow [1] + bne $17, INTERPRETINSTRUCTIONPREDICTED # [1] +/* Begin execution at the computed address */ + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.align 3 +G13353: + bis $31, 0, $17 # [1-] + br $31, StackCacheOverflowHandler # [0di] +.end DoFinishCallN +/* End of Halfword operand from stack instruction - DoFinishCallN */ +.align 5 +.globl DoEntryRestNotAccepted +.ent DoEntryRestNotAccepted 0 +/* Field Extraction instruction - DoEntryRestNotAccepted */ + .globl DoEntryRestNotAcceptedFP + .globl DoEntryRestNotAcceptedSP + .globl DoEntryRestNotAcceptedLP + .globl DoEntryRestNotAcceptedIM +.align 3 +DoEntryRestNotAccepted: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xB0 + .asciiz "DoEntryRestNotAccepted" +#endif +.align 3 +DoEntryRestNotAcceptedIM: +.align 3 +DoEntryRestNotAcceptedSP: +.align 3 +DoEntryRestNotAcceptedLP: +.align 3 +DoEntryRestNotAcceptedFP: + ldl $20, PROCESSORSTATE_CONTROL($14) # The control register [1] + srl $18, 18, $19 # Pull down the number of optionals [0di] + extbl $18, 5, $16 # Extract the 'ptr' field while we are waiting [1] + and $19, 255, $19 # [1] +/* arg1=ptr field, arg2=required, arg3=instn, arg4=optionals arg5=control-register */ + srl $20, 27, $2 # Get the cr.trace-pending bit [1] + and $20, 255, $1 # The supplied args [1] + blbs $2, TRACETRAP # [1-] + srl $20, 17, $3 # [0di] + ldl $4, 4($12) # Get the tag of the stack top. [1-] +.align 3 +G13364: + blbs $3, G13362 # J. if apply args [1-] +G13363: + subq $1, $17, $2 # t2=supplied-minimum [0di] + blt $2, RETRYERNATOOFEW # B. if too few args. [1] + subq $19, $1, $16 # maximum-supplied [0di] + blt $16, RETRYERNATOOMANY # B. if too many args. [1] +/* Compute entry position and advance PC/CP accordingly. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # get the next PC [0di] + sll $2, 1, $3 # Adjust index to halfword [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + beq $2, INTERPRETINSTRUCTION # J. if index zero, no adjustment. [1-] + addq $9, $3, $9 # Compute the new address [1di] + bic $9, 1, $9 # Make it an DTP-EVEN-PC [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [0di] +.align 3 +APPLYSUPPRNA: + subq $19, $1, $16 # [1-] + ble $16, RETRYERNATOOMANY # B. if too many args. [1] + br $31, PullApplyArgs # [1] +.align 3 +RETRYERNATOOMANY: + bis $31, 0, $20 # [1-] + bis $31, 78, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +RETRYERNATOOFEW: + bis $31, 0, $20 # [1] + bis $31, 77, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13362: + and $4, 63, $4 # [1] + subq $4, TypeNIL, $4 # [1] + bne $4, APPLYSUPPRNA # J. if apply args supplied not nil. [1] + and $3, 1, $3 # keep just the apply bit! [0di] + sll $3, 17, $3 # reposition the apply bit [1] + subq $12, 8, $12 # Pop off the null applied arg. [1] + bic $20, $3, $20 # Blast the apply arg bit away [1] + stl $20, PROCESSORSTATE_CONTROL($14) # Reset the stored cr bit [0di] + br $31, G13363 # [1] +.end DoEntryRestNotAccepted +/* End of Halfword operand from stack instruction - DoEntryRestNotAccepted */ +.align 5 +.globl VerifyGenericArity +.ent VerifyGenericArity 0 +.align 3 +VerifyGenericArity: + ldah $24, 2 # [1-] + and $24, $17, $24 # [1] + beq $24, G13373 # not applying [1] + subq $31, $20, $16 # 4 - argsize [0di] + br $31, PullApplyArgs # [1-] +.align 3 +G13373: + bis $31, 0, $20 # [1-] + bis $31, 77, $17 # [1] + br $31, ILLEGALOPERAND +.end VerifyGenericArity +.align 5 +.globl PullApplyArgs +.ent PullApplyArgs 1 +.align 3 +PullApplyArgs: + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $2, 0($12) # [1] + ldl $1, 4($12) # [1] + extll $2, 0, $2 # [2-] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $4, TypeList, $5 # [1] +.align 3 +G13402: + beq $5, G13376 # [1] +/* Here if argument TypeList */ + subq $2, $20, $5 # Stack cache offset [1] + cmpult $5, $21, $6 # In range? [1] + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + beq $6, G13374 # J. if not in cache [1-] + s8addq $5, $4, $4 # reconstruct SCA [2di] + bis $31, $31, $7 # [1] + lda $5, 128 # [1] + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1-] + addq $5, $16, $5 # Account for what we're about to push [0di] + s8addq $5, $12, $5 # SCA of desired end of cache [1] + s8addq $21, $6, $6 # SCA of current end of cache [2] + cmple $5, $6, $23 # [1] + beq $23, G13383 # We're done if new SCA is within bounds [1] + subq $12, 8, $12 # Pop Stack. [1-] + br $31, G13382 # [0di] +.align 3 +G13377: + ldl $22, 0($4) # [1] + ldl $8, 4($4) # [1] + extll $22, 0, $22 # [2-] + addq $7, 1, $7 # [1] + addq $4, 8, $4 # [1] + and $8, 192, $5 # Extract CDR code. [1] + bne $5, G13385 # [1] +/* Here if argument 0 */ + and $8, 63, $5 # set CDR-NEXT [1] + stl $22, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + cmpeq $7, $16, $5 # [1] + beq $5, G13377 # [1] + br $31, G13378 # [1] +.align 3 +G13385: + cmpeq $5, 64, $6 # [1-] +.align 3 +G13397: + beq $6, G13386 # [1] +/* Here if argument 64 */ + and $8, 63, $5 # set CDR-NEXT [0di] + stl $22, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] +.align 3 +G13380: + ldl $5, PROCESSORSTATE_CONTROL($14) # [1-] + and $5, 255, $6 # Get current arg size. [3] + bic $5, 255, $5 # [1] + addq $6, $7, $6 # [1] + addq $6, $5, $5 # Update the arg size [1] + ldah $6, 2 # [1] + bic $5, $6, $5 # turn off cr.apply [1] + stl $5, PROCESSORSTATE_CONTROL($14) # [0di] + s8addq $7, $11, $11 # [1-] + br $31, INTERPRETINSTRUCTION # [0di] +.align 3 +G13386: + cmpeq $5, 128, $6 # [1-] +.align 3 +G13398: + beq $6, G13387 # [1] +/* Here if argument 128 */ + and $8, 63, $5 # set CDR-NEXT [0di] + stl $22, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + ldl $24, 0($4) # [0di] + ldl $23, 4($4) # [1] + extll $24, 0, $24 # [2di] + and $23, 63, $5 # Strip off any CDR code bits. [1] + cmpeq $5, TypeList, $6 # [1] +.align 3 +G13393: + beq $6, G13389 # [1] +/* Here if argument TypeList */ + subq $24, $20, $5 # Stack cache offset [0di] + cmpult $5, $21, $6 # In range? [1] + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + beq $6, G13379 # J. if not in cache [1-] + s8addq $5, $4, $4 # reconstruct SCA [2di] + br $31, G13382 # [1-] +.align 3 +G13389: + cmpeq $5, TypeNIL, $6 # [1-] +.align 3 +G13394: + beq $6, G13390 # [1] +/* Here if argument TypeNIL */ + br $31, G13380 # [1] +.align 3 +G13390: +/* Here for all other cases */ +.align 3 +G13379: + and $23, 63, $5 # set CDR-NEXT [1-] + stl $24, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, G13381 # [1-] +.align 3 +G13388: +.align 3 +G13387: +/* Here for all other cases */ + subq $7, 1, $7 # [1-] + subq $4, 8, $4 # [1] + br $31, G13378 # [1-] +.align 3 +G13384: +G13382: + cmpeq $7, $16, $5 # [1-] + beq $5, G13377 # [1] +.align 3 +G13378: +/* Here if count=n, or bad cdr */ +/* Convert stack cache address to VMA */ + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $4, $5, $5 # stack cache base relative offset [3] + srl $5, 3, $5 # convert byte address to word address [1] + addq $5, $20, $22 # reconstruct VMA [2] + bis $31, TypeList, $5 # [1] + stl $22, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] +.align 3 +G13381: + ldl $5, PROCESSORSTATE_CONTROL($14) # [1-] + and $5, 255, $6 # Get current arg size. [3] + bic $5, 255, $5 # [1] + addq $6, $7, $6 # [1] + addq $6, $5, $5 # Update the arg size [1] + stl $5, PROCESSORSTATE_CONTROL($14) # [0di] + s8addq $7, $11, $11 # [1-] + subq $16, $7, $16 # [1] + ble $16, INTERPRETINSTRUCTION # [1] + br $31, PullApplyArgsSlowly +.align 3 +G13376: + cmpeq $4, TypeNIL, $5 # [1-] +.align 3 +G13403: + beq $5, G13399 # [1] +/* Here if argument TypeNIL */ + ldl $6, PROCESSORSTATE_CONTROL($14) # Get the control register [0di] + ldah $7, 2 # [1-] + subq $12, 8, $12 # Discard that silly nil [1] + bic $6, $7, $6 # Blast away the apply arg bit. [1] + stl $6, PROCESSORSTATE_CONTROL($14) # [0di] + br $31, INTERPRETINSTRUCTION # [1] +.align 3 +G13399: +/* Here for all other cases */ + bis $31, $16, $16 # Pull apply args trap needs nargs in ARG1 [1-] + br $31, PULLAPPLYARGSTRAP +.align 3 +G13374: + bis $31, $16, $16 # [1] + br $31, PullApplyArgsSlowly +.align 3 +G13375: +.align 3 +G13383: + bis $31, $16, $17 # [1] + br $31, StackCacheOverflowHandler # [0di] +.end PullApplyArgs +.align 5 +.globl valuecell +.ent valuecell 0 +/* Fullword instruction - valuecell */ +#ifdef TRACING + .byte 0x80 + .asciiz "valuecell" +#endif +.align 3 +valuecell: + extll $18, 0, $17 # Get address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G13404: + addq $17, $14, $7 # [1di] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13406 # [0di] +G13405: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13408 # [1di] +G13415: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + and $20, 63, $3 # set CDR-NEXT [1-] + stl $21, 8($12) # Push the result [0di] + stl $3, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +G13408: + blbc $7, G13407 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13404 # [1-] +.align 3 +G13407: +.align 3 +G13406: + bsr $0, MemoryReadDataDECODE + br $31, G13415 # [1] +.end valuecell +/* End of Fullword instruction - valuecell */ +.align 5 +.globl pushconstantvalue +.ent pushconstantvalue 0 +/* Fullword instruction - pushconstantvalue */ +#ifdef TRACING + .byte 0x80 + .asciiz "pushconstantvalue" +#endif +.align 3 +pushconstantvalue: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stq $18, 8($12) # [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.end pushconstantvalue +/* End of Fullword instruction - pushconstantvalue */ +.align 5 +.globl DoZerop +.ent DoZerop 0 +/* Halfword operand from stack instruction - DoZerop */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoZeropFP + .globl DoZeropSP + .globl DoZeropLP + .globl DoZeropIM +.align 3 +DoZerop: +#ifdef TRACING + .byte 0x88 + .asciiz "DoZeropSP" +#endif +.align 3 +DoZeropSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoZerop # [0di] + .byte 0x90 + .asciiz "DoZeropLP" +#endif +.align 3 +DoZeropLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoZerop # [1] + .byte 0x84 + .asciiz "DoZeropFP" +#endif +.align 3 +DoZeropFP: # Entry point for FP relative +.align 3 +beginDoZerop: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldq $6, CACHELINE_NEXTPCDATA($13) # [1] + ldl $1, 4($16) # [1] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1] + ldl $2, 0($16) # [1] + lds $f1, 0($16) # [1] + and $1, 63, $4 # Strip off any CDR code bits. [0di] + cmpeq $4, TypeFixnum, $5 # [1] +.align 3 +G13421: + beq $5, G13417 # [1] +/* Here if argument TypeFixnum */ + bis $6, $31, $9 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmoveq $2, $25, $24 # T if predicate succeeds [0di] + stq $24, 8($12) # [1-] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +G13417: + cmpeq $4, TypeSingleFloat, $5 # [1-] +.align 3 +G13422: + beq $5, G13418 # [1] +/* Here if argument TypeSingleFloat */ + bis $6, $31, $9 # [0di] + stq $25, 8($12) # [1-] + addq $12, 8, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + fbeq $f1, CACHEVALID # [0di] + stq $24, 0($12) # Didn't branch, answer is NIL [1-] + br $31, CACHEVALID # [1] +.align 3 +G13418: +/* Here for all other cases */ + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, UNARYNUMERICEXCEPTION +.align 3 +G13416: +#ifdef TRACING + br $31, DoZeropIM # [1-] + .byte 0x82 + .asciiz "DoZeropIM" +#endif +.align 5 +.align 3 +DoZeropIM: # Entry point for IMMEDIATE mode + ldq $2, PROCESSORSTATE_TADDRESS($14) # [1] + addq $12, 8, $12 # [0di] + ldq $1, PROCESSORSTATE_NILADDRESS($14) # [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + cmoveq $17, $2, $1 # [0di] + stq $1, 0($12) # yes Virginia, we dual issue with above yahoo [1-] + br $31, CACHEVALID # [1] +.end DoZerop +/* End of Halfword operand from stack instruction - DoZerop */ +.align 5 +.globl DoSetSpToAddress +.ent DoSetSpToAddress 0 +/* Halfword operand from stack instruction - DoSetSpToAddress */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetSpToAddressFP + .globl DoSetSpToAddressSP + .globl DoSetSpToAddressLP + .globl DoSetSpToAddressIM +.align 3 +DoSetSpToAddress: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetSpToAddressSP" +#endif +.align 3 +DoSetSpToAddressSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoSetSpToAddress # [0di] + .byte 0x90 + .asciiz "DoSetSpToAddressLP" +#endif +.align 3 +DoSetSpToAddressLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetSpToAddress # [1] + .byte 0x84 + .asciiz "DoSetSpToAddressFP" +#endif +.align 3 +DoSetSpToAddressFP: # Entry point for FP relative +.align 3 +beginDoSetSpToAddress: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, $16, $12 # Set iSP=address of operand [0di] + br $31, CACHEVALID # [1-] +#ifdef TRACING + .byte 0x82 + .asciiz "DoSetSpToAddressIM" +#endif +DoSetSpToAddressIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoSetSpToAddress. +.end DoSetSpToAddress +/* End of Halfword operand from stack instruction - DoSetSpToAddress */ +.align 5 +.globl DoEq +.ent DoEq 0 +/* Halfword operand from stack instruction - DoEq */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoEqFP + .globl DoEqSP + .globl DoEqLP + .globl DoEqIM +.align 3 +DoEq: +#ifdef TRACING + .byte 0x88 + .asciiz "DoEqSP" +#endif +.align 3 +DoEqSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoEq # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoEq # [0di] + .byte 0x90 + .asciiz "DoEqLP" +#endif +.align 3 +DoEqLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoEq # [1] + .byte 0x84 + .asciiz "DoEqFP" +#endif +.align 3 +DoEqFP: # Entry point for FP relative +.align 3 +beginDoEq: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + srl $18, 12, $18 # [1-] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [0di] + ldq $16, 0($16) # load op2 [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + and $18, 1, $18 # 1 if no-pop, 0 if pop [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + xor $21, $16, $3 # compare tag and data [1-] + sll $3, 26, $3 # shift off the cdr code [1] + s8addq $18, $12, $12 # Either a stack-push or a stack-write [1] + cmoveq $3, $25, $24 # pick up T or NIL [1] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.end DoEq +/* End of Halfword operand from stack instruction - DoEq */ +.align 5 +.globl DoAref1 +.ent DoAref1 0 +/* Halfword operand from stack instruction - DoAref1 */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAref1FP + .globl DoAref1SP + .globl DoAref1LP + .globl DoAref1IM +.align 3 +DoAref1: +#ifdef TRACING + .byte 0x88 + .asciiz "DoAref1SP" +#endif +.align 3 +DoAref1SP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, headDoAref1 # [0di] + bis $21, $31, $16 # SP-pop mode, TOS->arg1 [1-] + ldq $21, 0($19) # Reload TOS [1] + bis $19, $31, $12 # Adjust SP [1-] + br $31, beginDoAref1 # [0di] +#ifdef TRACING + br $31, headDoAref1 # [1] + .byte 0x90 + .asciiz "DoAref1LP" +#endif +.align 3 +DoAref1LP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAref1 # [1] + .byte 0x84 + .asciiz "DoAref1FP" +#endif +.align 3 +DoAref1FP: # Entry point for FP relative +.align 3 +headDoAref1: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAref1: +/* arg1 has the operand, not sign extended if immediate. */ + extll $21, 4, $18 # [1-] + extll $21, 0, $19 # Get the array tag/data [1] + addl $16, 0, $17 # (sign-extended, for fast bounds check) Index Data [1] + lda $8, AutoArrayRegMask # [1] + and $19, $8, $8 # [1] + srl $16, 32, $16 # Index Tag [1] + lda $7, PROCESSORSTATE_AC0ARRAY($14) # [1] + addq $7, $8, $7 # This is the address if the array register block. [1] + subq $16, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, AREF1ILLEGAL # [1] +.align 3 +AREF1MERGE: + beq $19, Aref1Regset # [1] + ldq $8, ARRAYCACHE_ARRAY($7) # Cached array object. [0di] + subq $18, TypeArray, $1 # [1-] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, REALLYAREF1EXC # [1] + cmpeq $19, $8, $8 # t8==1 iff cached array is ours. [0di] + beq $8, Aref1Regset # Go and setup the array register. [1] +#ifdef SLOWARRAYS + br $31, Aref1Regset # [1] +#endif + ldq $21, ARRAYCACHE_ARWORD($7) # [1] + ldq $22, ARRAYCACHE_LOCAT($7) # high order bits all zero [1] + ldq $3, ARRAYCACHE_LENGTH($7) # high order bits all zero [1] + sll $21, 42, $5 # [1di] + ldq $4, PROCESSORSTATE_AREVENTCOUNT($14) # [1-] + srl $5, 42, $5 # [1di] + cmpult $17, $3, $2 # [1] + subq $4, $5, $6 # [1] + bne $6, Aref1Regset # J. if event count ticked. [1] + beq $2, AREF1BOUNDS # [1] + srl $21, ArrayRegisterBytePackingPos, $20 # [1-] + srl $21, ArrayRegisterByteOffsetPos, $19 # [1] + srl $21, ArrayRegisterElementTypePos, $8 # [1] + and $19, ArrayRegisterByteOffsetMask, $19 # [1] + and $20, ArrayRegisterBytePackingMask, $20 # [1] + and $8, ArrayRegisterElementTypeMask, $21 # [1] +.align 3 +AREF1RESTART: + bne $20, G13431 # [1-] + addq $22, $17, $1 # [0di] +.align 3 +G13432: +/* Memory Read Internal */ +G13439: + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $1, $14, $5 # [0di] + ldl $3, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $5, $31, $22 # [0di] + ldq_u $18, 0($5) # [1-] + subq $1, $2, $2 # Stack cache offset [1di] + ldq $6, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $2, $3, $3 # In range? [0di] + ldl $22, 0($22) # [1-] + extbl $18, $5, $18 # [0di] + bne $3, G13441 # [1-] +G13440: + lda $5, 240 # [0di] + srl $6, $18, $6 # [1] + srl $5, $18, $5 # [1] + extll $22, 0, $22 # [1] + blbs $6, G13443 # [0di] +G13450: + bne $20, G13433 # [1] +.align 3 +G13434: + bis $31, $31, $31 # [0] + subq $21, 2, $1 # [1] + ble $1, G13435 # [1] +/* TagType. */ + and $18, 63, $18 # [0di] +.align 3 +G13436: + stl $18, 4($12) # [1-] + cmpeq $20, 0, $5 # [0di] + beq $5, CASE_OTHERS_7 # [1] +.align 3 +CASE_0_1: + bis $31, $31, $31 # [0] + beq $1, G13437 # [0di] + stl $22, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_2_2: +/* AREF1-8B */ + bis $31, $31, $31 # [0] + and $17, 3, $5 # [1] + extbl $22, $5, $6 # [1] + beq $1, G13437 # [0di] + stl $6, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_3_3: +/* AREF1-4B */ + bis $31, $31, $31 # [0] + and $17, 7, $5 # byte-index [1] + sll $5, 2, $5 # byte-position [1] + srl $22, $5, $6 # byte in position [2] + and $6, 15, $6 # byte masked [2] + beq $1, G13437 # [0di] + stl $6, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_5_4: +/* AREF1-1B */ + bis $31, $31, $31 # [0] + and $17, 31, $5 # byte-index [1] + bis $31, $31, $31 # [0] + srl $22, $5, $6 # byte in position [1] + and $6, 1, $6 # byte masked [2] + beq $1, G13437 # [0di] + stl $6, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_1_5: +/* AREF1-16B */ + and $17, 1, $5 # [1-] + addq $5, $5, $5 # Bletch, it's a byte ref [1] + extwl $22, $5, $6 # [1] + beq $1, G13437 # [0di] + stl $6, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_OTHERS_7: + bis $31, $31, $31 # [0] + cmpeq $20, 2, $5 # [1] + cmpeq $20, 3, $6 # [1] + bne $5, CASE_2_2 # [0di] + cmpeq $20, 5, $5 # [1] + bne $6, CASE_3_3 # [0di] + cmpeq $20, 1, $6 # [1] + bne $5, CASE_5_4 # [0di] + bne $6, CASE_1_5 # [1] +.align 3 +CASE_4_6: +/* AREF1-2B */ + bis $31, $31, $31 # [0] + and $17, 15, $5 # byte-index [1] + sll $5, 1, $5 # byte-position [1] + srl $22, $5, $6 # byte in position [2] + and $6, 3, $6 # byte masked [2] + beq $1, G13437 # [0di] + stl $6, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13431: + addq $19, $17, $17 # [1-] + srl $17, $20, $1 # Convert byte index to word index [1] + addq $1, $22, $1 # Address of word containing byte [2] + br $31, G13432 # [0di] +.align 3 +G13433: + subq $18, TypeFixnum, $1 # [1-] + and $1, 63, $1 # Strip CDR code [1] + bne $1, G13438 # [1] + br $31, G13434 # [1] +.align 3 +G13435: + bis $31, TypeCharacter, $18 # [1-] + blbs $21, G13436 # [0di] + bis $31, TypeFixnum, $18 # [1-] + beq $21, G13436 # [0di] + ldq $2, PROCESSORSTATE_NILADDRESS($14) # [1-] + ldq $3, PROCESSORSTATE_TADDRESS($14) # [1] + br $31, G13436 # [1] +.align 3 +G13437: + cmovne $6, $3, $2 # [2-] + stq $2, 0($12) # [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13438: + bis $31, $1, $20 # [1-] + bis $31, 25, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + br $31, DoAref1IM # [1-] + .byte 0x82 + .asciiz "DoAref1IM" +#endif +.align 5 +.align 3 +DoAref1IM: # Entry point for IMMEDIATE mode + lda $8, AutoArrayRegMask # [1-] + ldl $19, 0($12) # Get the array tag/data [0di] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2di] + lda $7, PROCESSORSTATE_AC0ARRAY($14) # [1] + and $19, $8, $8 # [1] + addq $7, $8, $7 # This is the address of the array register block. [1] + br $31, AREF1MERGE # [0di] +.align 3 +G13441: + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $2, $3, $2 # reconstruct SCA [3] + ldl $22, 0($2) # [2] + ldl $18, 4($2) # Read from stack cache [1] + br $31, G13440 # [1] +.align 3 +G13443: + blbc $5, G13442 # [1] + extll $22, 0, $1 # Do the indirect thing [0di] + br $31, G13439 # [1-] +.align 3 +G13442: + ldq $6, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $18, 63, $5 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $5, $6, $5 # Adjust for a longword load [2di] + ldl $6, 0($5) # Get the memory action [2] +.align 3 +G13447: + and $6, MemoryActionTransform, $5 # [3] + beq $5, G13446 # [1] + bic $18, 63, $18 # [1-] + bis $18, TypeExternalValueCellPointer, $18 # [1] + br $31, G13450 # [1-] +#ifndef MINIMA +G13446: +#endif +#ifdef MINIMA +.align 3 +G13446: + and $6, MemoryActionBinding, $5 # [1-] + ldq $3, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $5, G13445 # [1-] + sll $1, 1, $2 # [0di] + ldq $5, PROCESSORSTATE_DBCBASE($14) # [1-] + and $2, $3, $2 # Hash index [1di] + bis $31, 1, $3 # [1] + sll $3, IvoryMemoryData, $3 # [1] + addl $2, $5, $2 # [1] + extll $2, 0, $2 # Clear sign-extension [1] + s4addq $2, $3, $3 # [2] + ldl $2, 0($3) # Fetch the key [2] + ldl $22, 4($3) # Fetch value [1] + subl $1, $2, $5 # Compare [2di] + bne $5, G13449 # Trap on miss [1] + extll $22, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G13439 # This is another memory read tailcall. [1-] +.align 3 +G13449: + br $31, DBCACHEMISSTRAP +#endif +G13445: +/* Perform memory action */ + bis $31, $6, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoAref1 +/* End of Halfword operand from stack instruction - DoAref1 */ +.align 5 +.globl DoTypeMember +.ent DoTypeMember 0 +/* Halfword 10 bit immediate instruction - DoTypeMember */ + .globl DoTypeMemberFP + .globl DoTypeMemberSP + .globl DoTypeMemberLP + .globl DoTypeMemberIM +.align 3 +DoTypeMember: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoTypeMember" +#endif +.align 3 +DoTypeMemberIM: +.align 3 +DoTypeMemberSP: +.align 3 +DoTypeMemberLP: +.align 3 +DoTypeMemberFP: +/* arg1 has operand preloaded. */ + srl $18, 6, $6 # Position the opcode [1] + ldq $4, PROCESSORSTATE_TADDRESS($14) # [0di] + ldl $19, 4($12) # get op1's tag [1] + bis $31, 1, $1 # [0di] + ldq $5, PROCESSORSTATE_NILADDRESS($14) # [1-] + srl $18, 12, $7 # Get pop-bit while stalled [0di] + and $6, 60, $16 # Get field-number*4 from the opcode [1] +/* TagType. */ + and $19, 63, $19 # Strip off CDR code. [1] + sll $1, $19, $1 # T1 is type type code bit position. [1] + and $7, 1, $7 # Pop bit [1] + sll $17, $16, $2 # t2 is the mask. [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + s8addq $7, $12, $12 # [0di] + and $2, $1, $3 # t3 is the result. [1] +.align 3 +G13459: + cmovne $3, $4, $5 # [1] + stq $5, 0($12) # [0di] + br $31, CACHEVALID # [1] +.end DoTypeMember +/* End of Halfword operand from stack instruction - DoTypeMember */ +.align 5 +.globl DoPointerPlus +.ent DoPointerPlus 0 +/* Halfword operand from stack instruction - DoPointerPlus */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPointerPlusFP + .globl DoPointerPlusSP + .globl DoPointerPlusLP + .globl DoPointerPlusIM +.align 3 +DoPointerPlus: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPointerPlusSP" +#endif +.align 3 +DoPointerPlusSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoPointerPlus # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoPointerPlus # [0di] + .byte 0x90 + .asciiz "DoPointerPlusLP" +#endif +.align 3 +DoPointerPlusLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPointerPlus # [1] + .byte 0x84 + .asciiz "DoPointerPlusFP" +#endif +.align 3 +DoPointerPlusFP: # Entry point for FP relative +.align 3 +beginDoPointerPlus: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + ldl $2, 0($16) # Get the data of op2 [1] + addl $21, $2, $3 # (%32-bit-plus (data arg1) (data arg2)) [3] + stl $3, 0($12) # Put result back on the stack [0di] + br $31, CACHEVALID # [1] +#ifdef TRACING + br $31, DoPointerPlusIM # [1] + .byte 0x82 + .asciiz "DoPointerPlusIM" +#endif +.align 5 +.align 3 +DoPointerPlusIM: # Entry point for IMMEDIATE mode + sll $17, 56, $2 # [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + sra $2, 56, $2 # [1di] +.align 3 +G13460: + addl $21, $2, $3 # (%32-bit-plus (data arg1) (data arg2)) [2] + stl $3, 0($12) # Put result back on the stack [0di] + br $31, CACHEVALID # [1] +.end DoPointerPlus +/* End of Halfword operand from stack instruction - DoPointerPlus */ +.align 5 +.globl DoLdb +.ent DoLdb 0 +/* Field Extraction instruction - DoLdb */ + .globl DoLdbFP + .globl DoLdbSP + .globl DoLdbLP + .globl DoLdbIM +.align 3 +DoLdb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoLdb" +#endif +.align 3 +DoLdbIM: +.align 3 +DoLdbSP: +.align 3 +DoLdbLP: +.align 3 +DoLdbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [1-] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + extll $21, 4, $18 # [1] + extll $21, 0, $19 # get ARG1 tag/data [1] +/* TagType. */ + and $18, 63, $8 # [1] + subq $8, TypeFixnum, $22 # [1] + sll $19, $17, $3 # Shift ARG1 left to get new high bits [1] + bne $22, LDBEXCEPTION # Not a fixnum [1-] + lda $7, -2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + extll $3, 4, $6 # Get new low bits [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + sll $7, $16, $7 # Unmask [0di] + bis $3, $6, $3 # Glue two parts of shifted operand together [1] + stl $8, 4($12) # T8 is TypeFixnum from above [0di] + bic $3, $7, $3 # T3= masked value. [1-] + stl $3, 0($12) # [0di] + br $31, CACHEVALID # [1] +.end DoLdb +/* End of Halfword operand from stack instruction - DoLdb */ +.align 5 +.globl DoSetSpToAddressSaveTos +.ent DoSetSpToAddressSaveTos 0 +/* Halfword operand from stack instruction - DoSetSpToAddressSaveTos */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetSpToAddressSaveTosFP + .globl DoSetSpToAddressSaveTosSP + .globl DoSetSpToAddressSaveTosLP + .globl DoSetSpToAddressSaveTosIM +.align 3 +DoSetSpToAddressSaveTos: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetSpToAddressSaveTosSP" +#endif +.align 3 +DoSetSpToAddressSaveTosSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoSetSpToAddressSaveTos # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoSetSpToAddressSaveTos # [0di] + .byte 0x90 + .asciiz "DoSetSpToAddressSaveTosLP" +#endif +.align 3 +DoSetSpToAddressSaveTosLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetSpToAddressSaveTos # [1] + .byte 0x84 + .asciiz "DoSetSpToAddressSaveTosFP" +#endif +.align 3 +DoSetSpToAddressSaveTosFP: # Entry point for FP relative +.align 3 +beginDoSetSpToAddressSaveTos: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $16, $31, $12 # Set the stack top as specified. [0di] + stq $21, 0($16) # Restore the TOS. [1-] + br $31, CACHEVALID # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoSetSpToAddressSaveTosIM" +#endif +DoSetSpToAddressSaveTosIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoSetSpToAddressSaveTos. +.end DoSetSpToAddressSaveTos +/* End of Halfword operand from stack instruction - DoSetSpToAddressSaveTos */ +.align 5 +.globl DoPop +.ent DoPop 0 +/* Halfword operand from stack instruction - DoPop */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPopFP + .globl DoPopSP + .globl DoPopLP + .globl DoPopIM +.align 3 +DoPop: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPopSP" +#endif +.align 3 +DoPopSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoPop # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoPop # [0di] + .byte 0x90 + .asciiz "DoPopLP" +#endif +.align 3 +DoPopLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPop # [1] + .byte 0x84 + .asciiz "DoPopFP" +#endif +.align 3 +DoPopFP: # Entry point for FP relative +.align 3 +beginDoPop: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # Pop Stack. [0di] + stq $21, 0($16) # Store all 40 bits on stack [1-] + br $31, CACHEVALID # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoPopIM" +#endif +DoPopIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoPop. +.end DoPop +/* End of Halfword operand from stack instruction - DoPop */ +.align 5 +.globl DoMovem +.ent DoMovem 0 +/* Halfword operand from stack instruction - DoMovem */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMovemFP + .globl DoMovemSP + .globl DoMovemLP + .globl DoMovemIM +.align 3 +DoMovem: +#ifdef TRACING + .byte 0x88 + .asciiz "DoMovemSP" +#endif +.align 3 +DoMovemSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoMovem # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoMovem # [0di] + .byte 0x90 + .asciiz "DoMovemLP" +#endif +.align 3 +DoMovemLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMovem # [1] + .byte 0x84 + .asciiz "DoMovemFP" +#endif +.align 3 +DoMovemFP: # Entry point for FP relative +.align 3 +beginDoMovem: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stq $21, 0($16) # Store all 40 bits of TOS on stack [1] + br $31, CACHEVALID # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoMovemIM" +#endif +DoMovemIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoMovem. +.end DoMovem +/* End of Halfword operand from stack instruction - DoMovem */ +.align 5 +.globl DoPushAddress +.ent DoPushAddress 0 +/* Halfword operand from stack instruction - DoPushAddress */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPushAddressFP + .globl DoPushAddressSP + .globl DoPushAddressLP + .globl DoPushAddressIM +.align 3 +DoPushAddress: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPushAddressSP" +#endif +.align 3 +DoPushAddressSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoPushAddress # [0di] + .byte 0x90 + .asciiz "DoPushAddressLP" +#endif +.align 3 +DoPushAddressLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPushAddress # [1] + .byte 0x84 + .asciiz "DoPushAddressFP" +#endif +.align 3 +DoPushAddressFP: # Entry point for FP relative +.align 3 +beginDoPushAddress: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $16, $2, $2 # stack cache base relative offset [2di] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeLocative, $3 # [1-] + stl $1, 8($12) # [0di] + stl $3, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +#ifdef TRACING + .byte 0x82 + .asciiz "DoPushAddressIM" +#endif +DoPushAddressIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoPushAddress. +.end DoPushAddress +/* End of Halfword operand from stack instruction - DoPushAddress */ +.align 5 +.globl DoMemoryRead +.ent DoMemoryRead 0 +/* Halfword 10 bit immediate instruction - DoMemoryRead */ + .globl DoMemoryReadFP + .globl DoMemoryReadSP + .globl DoMemoryReadLP + .globl DoMemoryReadIM +.align 3 +DoMemoryRead: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoMemoryRead" +#endif +.align 3 +DoMemoryReadIM: +.align 3 +DoMemoryReadSP: +.align 3 +DoMemoryReadLP: +.align 3 +DoMemoryReadFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + srl $18, 10, $1 # Low bit clear if memory-read, set if memory-read-address [1] + and $16, 32, $2 # T2 = fixnum check [1] + and $16, 16, $3 # T3 = reset CDR code [1] + srl $16, 6, $18 # arg3 = cycle type [1] + extll $21, 4, $16 # [1] + extll $21, 0, $17 # Get tag/data [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G13477: + addq $17, $14, $7 # [1di] + s4addq $18, $31, $8 # Cycle-number -> table offset [1] + ldq_u $20, 0($7) # [1di] + s4addq $8, $14, $8 # [1-] + s4addq $7, $31, $21 # [1] + subq $17, $24, $5 # Stack cache offset [1] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($8) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13479 # [0di] +G13478: + srl $8, $20, $8 # [2-] + blbs $8, G13481 # [2] +G13488: + beq $2, MRDATAOK # J. if no check for fixnum. [1] + subq $20, TypeFixnum, $5 # [0di] + and $5, 63, $5 # Strip CDR code [1] + bne $5, MRNOTFIXNUM # [1] +.align 3 +MRDATAOK: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + cmovlbs $1, $16, $20 # Get original tag if memory-read-address [0di] + beq $3, MRCDRUNCH # J. if no reset CDR code [1-] +/* TagType. */ + and $20, 63, $20 # [1di] +.align 3 +MRCDRUNCH: + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovlbs $1, $17, $21 # Get forwarded address if memory-read-address [0di] + stl $21, 0($12) # [1-] + stl $20, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +MRNOTFIXNUM: + bis $31, 0, $20 # [1-] + bis $31, 5, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13481: +.align 3 +G13479: + bsr $0, MemoryReadGeneralDECODE + br $31, G13488 # [1-] +.end DoMemoryRead +/* End of Halfword operand from stack instruction - DoMemoryRead */ +.align 5 +.globl DoBranch +.ent DoBranch 0 +/* Halfword 10 bit immediate instruction - DoBranch */ + .globl DoBranchFP + .globl DoBranchSP + .globl DoBranchLP + .globl DoBranchIM +.align 3 +DoBranch: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranch" +#endif +.align 3 +DoBranchIM: +.align 3 +DoBranchSP: +.align 3 +DoBranchLP: +.align 3 +DoBranchFP: + sra $18, 48, $16 # [1-] +/* arg1 has signed operand preloaded. */ +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + addq $9, $16, $9 # Update the PC in halfwords [2-] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [1di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranch +/* End of Halfword operand from stack instruction - DoBranch */ +.align 5 +.globl DoGenericDispatch +.ent DoGenericDispatch 0 +/* Halfword operand from stack instruction - DoGenericDispatch */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoGenericDispatchFP + .globl DoGenericDispatchSP + .globl DoGenericDispatchLP + .globl DoGenericDispatchIM +.align 3 +DoGenericDispatch: +#ifdef TRACING + .byte 0x88 + .asciiz "DoGenericDispatchSP" +#endif +.align 3 +DoGenericDispatchSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoGenericDispatch # [0di] + .byte 0x90 + .asciiz "DoGenericDispatchLP" +#endif +.align 3 +DoGenericDispatchLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoGenericDispatch # [1] + .byte 0x84 + .asciiz "DoGenericDispatchFP" +#endif +.align 3 +DoGenericDispatchFP: # Entry point for FP relative +.align 3 +beginDoGenericDispatch: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $17, PROCESSORSTATE_CONTROL($14) # [1] + ldl $16, 20($10) # get generic tag and data [1] + ldl $1, 16($10) # [1] + and $17, 255, $20 # get number of arguments [1-] + ldl $18, 28($10) # get instance tag and data [0di] + ldl $19, 24($10) # [1] + subq $20, 4, $20 # done if 2 or more arguments (plus 2 extra words) [0di] + blt $20, VerifyGenericArity # [1] + extll $1, 0, $1 # [0di] + extll $19, 0, $19 # [2] + bsr $0, LookupHandler + subq $4, TypeEvenPC, $3 # [1] + and $3, 62, $3 # Strip CDR code, low bits [1] + bne $3, G13490 # [1] + and $6, 63, $3 # Strip CDR code [1] + subq $3, TypeNIL, $3 # [1] + beq $3, G13489 # [1] + stl $7, 16($10) # [1] + stl $6, 20($10) # write the stack cache [1] +.align 3 +G13489: +/* Convert real continuation to PC. */ + and $4, 1, $9 # [1-] + addq $22, $9, $9 # [1] + addq $22, $9, $9 # [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [0di] +.align 3 +G13490: +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $2, $2 # stack cache base relative offset [2-] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $3, $3 # reconstruct VMA [2] + bis $31, $3, $20 # [1] + bis $31, 37, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + .byte 0x82 + .asciiz "DoGenericDispatchIM" +#endif +DoGenericDispatchIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoGenericDispatch. +.end DoGenericDispatch +/* End of Halfword operand from stack instruction - DoGenericDispatch */ +.align 5 +.globl LookupHandler +.ent LookupHandler 0 +.align 3 +LookupHandler: + lda $30, -8($30) # [1] + .frame $30, 8, $0 + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + subq $18, TypeInstance, $5 # [0di] + and $5, 60, $5 # Strip CDR code, low bits [1] + bne $5, G13494 # [1] + bis $19, $31, $17 # Don't clobber instance if it's forwarded [1-] +/* Memory Read Internal */ +G13495: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13497 # [0di] +G13496: + lda $7, 64 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13499 # [1-] +G13504: +.align 3 +G13493: + bis $21, $31, $17 # [1-] +/* Memory Read Internal */ +G13505: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13507 # [0di] +G13506: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13509 # [1-] +G13516: + bis $21, $31, $2 # [1di] + subq $20, TypeFixnum, $5 # [1] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G13491 # [1] + addq $17, 1, $17 # [0di] +/* Memory Read Internal */ +G13517: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13519 # [1-] +G13518: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13521 # [0di] +G13528: + bis $21, $31, $3 # [2-] + subq $20, TypeLocative, $5 # [1] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G13492 # [1] + and $2, $1, $17 # [1-] + sll $17, 1, $5 # [1] + addq $17, $5, $19 # (* (logand mask data) 3) [2] +/* TagType. */ + and $16, 63, $16 # [1] +.align 3 +G13530: + addq $3, $19, $17 # [1] + addq $19, 3, $19 # [1] +/* Read key */ +/* Memory Read Internal */ +G13531: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13533 # [1-] +G13532: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13535 # [1-] +G13542: +/* TagType. */ + and $20, 63, $20 # [0di] + cmpeq $20, TypeNIL, $5 # [1] + bne $5, G13529 # [1] + cmpeq $16, $20, $5 # [1] + beq $5, G13530 # [1] + subl $1, $21, $5 # [1] + bne $5, G13530 # [1] +.align 3 +G13529: +/* Read method */ + addq $17, 1, $17 # [1-] +/* Memory Read Internal */ +G13543: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13545 # [0di] +G13544: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13547 # [1-] +G13554: + bis $20, $31, $4 # [0di] + bis $21, $31, $18 # [1] +/* Read parameter */ + addq $17, 1, $17 # [1] +/* Memory Read Internal */ +G13555: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13557 # [1-] +G13556: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13559 # [0di] +G13566: + bis $20, $31, $6 # [1-] + bis $21, $31, $7 # [1] + bis $18, $31, $22 # [1] + lda $30, 8($30) # [1] + ret $31, ($0), 1 # [1-] +.align 3 +G13559: + blbc $7, G13558 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13555 # [2-] +.align 3 +G13558: +.align 3 +G13557: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13566 # [1] +.align 3 +G13547: + blbc $7, G13546 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13543 # [1-] +.align 3 +G13546: +.align 3 +G13545: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13554 # [1] +.align 3 +G13535: + blbc $7, G13534 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13531 # [1-] +.align 3 +G13534: +.align 3 +G13533: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13542 # [1] +.align 3 +G13521: + blbc $7, G13520 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13517 # [1-] +.align 3 +G13520: +.align 3 +G13519: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13528 # [1] +.align 3 +G13509: + blbc $7, G13508 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13505 # [1-] +.align 3 +G13508: +.align 3 +G13507: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13516 # [1] +.align 3 +G13499: + blbc $7, G13498 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13495 # [1-] +.align 3 +G13498: +.align 3 +G13497: + stq $0, 0($30) # [1] + bsr $0, MemoryReadHeaderDECODE + ldq $0, 0($30) # [1] + br $31, G13504 # [1] +.align 3 +G13494: +/* not an instance, flavor description comes from magic vector */ + ldq $17, PROCESSORSTATE_TRAPVECBASE($14) # [1] +/* TagType. */ + and $18, 63, $5 # [0di] + lda $17, 2560($17) # [3] + addq $5, $17, $17 # [1] +/* Memory Read Internal */ +G13567: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13569 # [1-] +G13568: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13571 # [0di] + br $31, G13493 # [1] +.align 3 +G13491: + bis $31, $17, $20 # [1-] + bis $31, 34, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13492: + bis $31, $17, $20 # [1] + bis $31, 35, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13571: + blbc $7, G13570 # [1-] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13567 # [1-] +.align 3 +G13570: +.align 3 +G13569: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13493 # [1] +.end LookupHandler +.align 5 +.globl DoSetTag +.ent DoSetTag 0 +/* Halfword operand from stack instruction - DoSetTag */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetTagFP + .globl DoSetTagSP + .globl DoSetTagLP + .globl DoSetTagIM +.align 3 +DoSetTag: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetTagSP" +#endif +.align 3 +DoSetTagSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoSetTag # [0di] + .byte 0x90 + .asciiz "DoSetTagLP" +#endif +.align 3 +DoSetTagLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetTag # [1] + .byte 0x84 + .asciiz "DoSetTagFP" +#endif +.align 3 +DoSetTagFP: # Entry point for FP relative +.align 3 +beginDoSetTag: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $1, 4($16) # Get tag/data of op2 [2] + ldl $17, 0($16) # [1] + subq $1, TypeFixnum, $3 # [2di] + and $3, 63, $3 # Strip CDR code [1] + bne $3, SETTAGEXC # [1] +#ifdef TRACING + br $31, DoSetTagIM # [1] + .byte 0x82 + .asciiz "DoSetTagIM" +#endif +.align 5 +.align 3 +DoSetTagIM: # Entry point for IMMEDIATE mode + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $17, 4($12) # Set TAG of op1 [1] + br $31, CACHEVALID # [1] +.align 3 +SETTAGEXC: + bis $31, 0, $20 # [1-] + bis $31, 63, $17 # [1] + br $31, ILLEGALOPERAND +.end DoSetTag +/* End of Halfword operand from stack instruction - DoSetTag */ +.align 5 +.globl DoCar +.ent DoCar 0 +/* Halfword operand from stack instruction - DoCar */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoCarFP + .globl DoCarSP + .globl DoCarLP + .globl DoCarIM +.align 3 +DoCar: +#ifdef TRACING + .byte 0x88 + .asciiz "DoCarSP" +#endif +.align 3 +DoCarSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoCar # [0di] + .byte 0x90 + .asciiz "DoCarLP" +#endif +.align 3 +DoCarLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoCar # [1] + .byte 0x84 + .asciiz "DoCarFP" +#endif +.align 3 +DoCarFP: # Entry point for FP relative +.align 3 +beginDoCar: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $20, 4($16) # Get the operand from the stack. [1] + ldl $21, 0($16) # [1] + bsr $0, CarInternal + and $20, 63, $5 # set CDR-NEXT [2di] + stl $21, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +#ifdef TRACING + .byte 0x82 + .asciiz "DoCarIM" +#endif +DoCarIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoCar. +.end DoCar +/* End of Halfword operand from stack instruction - DoCar */ +.align 5 +.globl CarInternal +.ent CarInternal 11 +.align 3 +CarInternal: + lda $30, -8($30) # [1-] + .frame $30, 8, $0 + extll $21, $31, $17 # [1] + and $20, 63, $5 # Strip off any CDR code bits. [1] + cmpeq $5, TypeList, $6 # [1] +.align 3 +G13598: + beq $6, G13581 # [1] +/* Here if argument TypeList */ +G13578: +/* Memory Read Internal */ +G13582: + addq $17, $14, $7 # [0di] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13584 # [0di] +G13583: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13586 # [1-] +G13593: +.align 3 +G13580: +.align 3 +G13579: + lda $30, 8($30) # [1-] + ret $31, ($0), 1 # [0di] +.align 3 +G13581: + cmpeq $5, TypeNIL, $6 # [1-] +.align 3 +G13599: + bne $6, G13580 # [1] +.align 3 +G13594: + cmpeq $5, TypeLocative, $6 # [1] +.align 3 +G13600: + bne $6, G13578 # [1] +.align 3 +G13595: +/* Here for all other cases */ + bis $31, $20, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, LISTEXCEPTION +.align 3 +G13586: + blbc $7, G13585 # [1-] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13582 # [1-] +.align 3 +G13585: +.align 3 +G13584: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13593 # [1] +.end CarInternal +.align 5 +.globl DoCdr +.ent DoCdr 0 +/* Halfword operand from stack instruction - DoCdr */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoCdrFP + .globl DoCdrSP + .globl DoCdrLP + .globl DoCdrIM +.align 3 +DoCdr: +#ifdef TRACING + .byte 0x88 + .asciiz "DoCdrSP" +#endif +.align 3 +DoCdrSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoCdr # [0di] + .byte 0x90 + .asciiz "DoCdrLP" +#endif +.align 3 +DoCdrLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoCdr # [1] + .byte 0x84 + .asciiz "DoCdrFP" +#endif +.align 3 +DoCdrFP: # Entry point for FP relative +.align 3 +beginDoCdr: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $20, 4($16) # Get the operand from the stack. [1] + ldl $21, 0($16) # [1] + bsr $0, CdrInternal + and $20, 63, $5 # set CDR-NEXT [2di] + stl $21, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +#ifdef TRACING + .byte 0x82 + .asciiz "DoCdrIM" +#endif +DoCdrIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoCdr. +.end DoCdr +/* End of Halfword operand from stack instruction - DoCdr */ +.align 5 +.globl CdrInternal +.ent CdrInternal 11 +.align 3 +CdrInternal: + lda $30, -8($30) # [1-] + .frame $30, 8, $0 + extll $21, 0, $17 # [1] + and $20, 63, $5 # Strip off any CDR code bits. [1] + cmpeq $5, TypeList, $6 # [1] +.align 3 +G13636: + beq $6, G13604 # [1] +/* Here if argument TypeList */ +/* Memory Read Internal */ +G13605: + addq $17, $14, $7 # [0di] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_CDR_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13607 # [0di] +G13606: + lda $7, 192 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13609 # [1di] +G13614: + and $20, 192, $5 # Extract CDR code. [1-] + bne $5, G13616 # [1] +/* Here if argument 0 */ + addq $17, 1, $21 # Address of next position is CDR [1-] + bis $31, TypeList, $20 # [1] +.align 3 +G13615: +.align 3 +G13603: +.align 3 +G13602: + lda $30, 8($30) # [1] + ret $31, ($0), 1 # [0di] +.align 3 +G13604: + cmpeq $5, TypeNIL, $6 # [1-] +.align 3 +G13637: + bne $6, G13603 # [1] +.align 3 +G13632: + cmpeq $5, TypeLocative, $6 # [1] +.align 3 +G13638: + bne $6, G13601 # [1] +.align 3 +G13633: +/* Here for all other cases */ + bis $31, $20, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, LISTEXCEPTION +.align 3 +G13616: + cmpeq $5, 128, $6 # [1] +.align 3 +G13639: + beq $6, G13617 # [1] +/* Here if argument 128 */ + addq $17, 1, $17 # [0di] +.align 3 +G13601: +/* Memory Read Internal */ +G13618: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13620 # [1-] +G13619: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13622 # [0di] + br $31, G13602 # [1] +.align 3 +G13617: + cmpeq $5, 64, $6 # [1-] +.align 3 +G13640: + beq $6, G13629 # [1] +/* Here if argument 64 */ + ldl $21, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldl $20, PROCESSORSTATE_NILADDRESS+4($14) # [1] + extll $21, 0, $21 # [2di] + br $31, G13602 # [1-] +.align 3 +G13629: +/* Here for all other cases */ + bis $31, $17, $20 # [1-] + bis $31, 15, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13622: + blbc $7, G13621 # [1-] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13618 # [1-] +.align 3 +G13621: +.align 3 +G13620: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G13602 # [1] +.align 3 +G13609: + blbc $7, G13608 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13605 # [1-] +.align 3 +G13608: +.align 3 +G13607: + stq $0, 0($30) # [1] + bsr $0, MemoryReadCdrDECODE + ldq $0, 0($30) # [1] + br $31, G13614 # [1] +.end CdrInternal +.align 5 +.globl DoReadInternalRegister +.ent DoReadInternalRegister 0 +/* Halfword 10 bit immediate instruction - DoReadInternalRegister */ + .globl DoReadInternalRegisterFP + .globl DoReadInternalRegisterSP + .globl DoReadInternalRegisterLP + .globl DoReadInternalRegisterIM +.align 3 +DoReadInternalRegister: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoReadInternalRegister" +#endif +.align 3 +DoReadInternalRegisterIM: +.align 3 +DoReadInternalRegisterSP: +.align 3 +DoReadInternalRegisterLP: +.align 3 +DoReadInternalRegisterFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + ldq $2, PROCESSORSTATE_INTERNALREGISTERREAD2($14) # [0di] + subl $16, 512, $3 # [2-] + ldq $1, PROCESSORSTATE_INTERNALREGISTERREAD1($14) # [0di] + bge $3, G13641 # We're in the 1000's [1-] + and $16, 63, $3 # Keep only six bits [1] + cmple $3, 42, $2 # In range for the low registers? [1] + s8addq $3, $1, $3 # [1] + beq $2, ReadRegisterError # [1-] + ldq $3, 0($3) # [1di] + jmp $31, ($3), 0 # Jump to the handler [3] +.align 3 +G13641: + cmple $3, 33, $1 # In range for the high registers? [1-] + s8addq $3, $2, $3 # [1] + beq $1, ReadRegisterError # [1-] + ldq $3, 0($3) # [1di] + jmp $31, ($3), 0 # Jump to the handler [3] +.end DoReadInternalRegister +/* End of Halfword operand from stack instruction - DoReadInternalRegister */ +.align 5 +.globl DoWriteInternalRegister +.ent DoWriteInternalRegister 0 +/* Halfword 10 bit immediate instruction - DoWriteInternalRegister */ + .globl DoWriteInternalRegisterFP + .globl DoWriteInternalRegisterSP + .globl DoWriteInternalRegisterLP + .globl DoWriteInternalRegisterIM +.align 3 +DoWriteInternalRegister: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoWriteInternalRegister" +#endif +.align 3 +DoWriteInternalRegisterIM: +.align 3 +DoWriteInternalRegisterSP: +.align 3 +DoWriteInternalRegisterLP: +.align 3 +DoWriteInternalRegisterFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + extll $21, 4, $17 # [1] + extll $21, 0, $18 # Arg2=tag arg3=data [1] + subq $12, 8, $12 # Pop Stack. [1] + ldq $2, PROCESSORSTATE_INTERNALREGISTERWRITE2($14) # [1-] + subl $16, 512, $3 # [0di] + ldq $1, PROCESSORSTATE_INTERNALREGISTERWRITE1($14) # [1-] + bge $3, G13642 # We're in the 1000's [0di] + and $16, 63, $3 # Keep only six bits [1] + cmple $3, 42, $2 # In range for the low registers? [1] + s8addq $3, $1, $3 # [1] + beq $2, WriteRegisterError # [0di] + ldq $3, 0($3) # [2-] + jmp $31, ($3), 0 # Jump to the handler [3] +.align 3 +G13642: + cmple $3, 33, $1 # In range for the high registers? [1-] + s8addq $3, $2, $3 # [1] + beq $1, WriteRegisterError # [1-] + ldq $3, 0($3) # [1di] + jmp $31, ($3), 0 # Jump to the handler [3] +.end DoWriteInternalRegister +/* End of Halfword operand from stack instruction - DoWriteInternalRegister */ +.align 5 +.globl WriteRegisterBARx +.ent WriteRegisterBARx 0 +.align 3 +WriteRegisterBARx: + srl $16, 7, $2 # BAR number into T2 [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + sll $17, 32, $3 # Make a quadword from tag and data [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + lda $1, PROCESSORSTATE_BAR0($14) # [1-] + s8addq $2, $1, $1 # Now T1 points to the BAR [1] + bis $3, $18, $3 # Construct the combined word [1] + stq $3, 0($1) # [1di] + br $31, CACHEVALID # [1] +.end WriteRegisterBARx +.align 5 +.globl DoBlock3Read +.ent DoBlock3Read 0 +/* Halfword 10 bit immediate instruction - DoBlock3Read */ + .globl DoBlock3ReadFP + .globl DoBlock3ReadSP + .globl DoBlock3ReadLP + .globl DoBlock3ReadIM +.align 3 +DoBlock3Read: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock3Read" +#endif +.align 3 +DoBlock3ReadIM: +.align 3 +DoBlock3ReadSP: +.align 3 +DoBlock3ReadLP: +.align 3 +DoBlock3ReadFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $19, PROCESSORSTATE_BAR3($14) # [1] + br $31, BlockRead # [1-] +.end DoBlock3Read +/* End of Halfword operand from stack instruction - DoBlock3Read */ +.align 5 +.globl DoBlock2Read +.ent DoBlock2Read 0 +/* Halfword 10 bit immediate instruction - DoBlock2Read */ + .globl DoBlock2ReadFP + .globl DoBlock2ReadSP + .globl DoBlock2ReadLP + .globl DoBlock2ReadIM +.align 3 +DoBlock2Read: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock2Read" +#endif +.align 3 +DoBlock2ReadIM: +.align 3 +DoBlock2ReadSP: +.align 3 +DoBlock2ReadLP: +.align 3 +DoBlock2ReadFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $19, PROCESSORSTATE_BAR2($14) # [1] + br $31, BlockRead # [1-] +.end DoBlock2Read +/* End of Halfword operand from stack instruction - DoBlock2Read */ +.align 5 +.globl DoBlock1Read +.ent DoBlock1Read 0 +/* Halfword 10 bit immediate instruction - DoBlock1Read */ + .globl DoBlock1ReadFP + .globl DoBlock1ReadSP + .globl DoBlock1ReadLP + .globl DoBlock1ReadIM +.align 3 +DoBlock1Read: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoBlock1Read" +#endif +.align 3 +DoBlock1ReadIM: +.align 3 +DoBlock1ReadSP: +.align 3 +DoBlock1ReadLP: +.align 3 +DoBlock1ReadFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + lda $19, PROCESSORSTATE_BAR1($14) # [1] +.align 3 +BlockRead: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $17, 0($19) # Get the vma [1] + srl $16, 6, $18 # cycle type [0di] + and $16, 4, $2 # =no-incrementp [1] + and $16, 16, $3 # =cdr-code-nextp [1] + and $16, 32, $4 # =fixnum onlyp [1] + extll $17, 0, $17 # [1] +/* Do the read cycle */ +/* Memory Read Internal */ +G13646: + addq $17, $14, $7 # [2] + s4addq $18, $31, $8 # Cycle-number -> table offset [1] + ldq_u $20, 0($7) # [1-] + s4addq $8, $14, $8 # [0di] + s4addq $7, $31, $21 # [1] + subq $17, $24, $5 # Stack cache offset [1] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($8) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [0di] + bne $6, G13648 # [1-] +G13647: + srl $8, $20, $8 # [1di] + blbs $8, G13650 # [2] +G13657: + bne $4, G13643 # J. if we have to test for fixnump. [1] +G13644: + addq $17, 1, $4 # Compute Incremented address [1] +.align 3 +G13658: + cmoveq $2, $4, $17 # Conditionally update address [1] + stl $17, 0($19) # Store updated vma in BAR [0di] + and $20, 63, $2 # Compute CDR-NEXT [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + cmovne $3, $2, $20 # Conditionally Set CDR-NEXT [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + stl $21, 8($12) # [1] + stl $20, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G13645: + bis $31, $17, $20 # [1-] + bis $31, 23, $17 # [1] + br $31, ILLEGALOPERAND # Not a fixnum +.align 3 +G13650: +.align 3 +G13648: + bsr $0, MemoryReadGeneralDECODE + br $31, G13657 # [1-] +.align 3 +G13643: + subq $20, TypeFixnum, $5 # [1-] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G13645 # [1] + br $31, G13644 # [1] +.end DoBlock1Read +/* End of Halfword operand from stack instruction - DoBlock1Read */ +.align 5 +.globl DoBlock2Write +.ent DoBlock2Write 0 +/* Halfword operand from stack instruction - DoBlock2Write */ + .globl DoBlock2WriteFP + .globl DoBlock2WriteSP + .globl DoBlock2WriteLP + .globl DoBlock2WriteIM +.align 3 +DoBlock2Write: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoBlock2WriteIM" +#endif +.align 3 +DoBlock2WriteIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G13675: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoBlock2Write # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock2WriteSP" +#endif +.align 3 +DoBlock2WriteSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoBlock2Write # [0di] + .byte 0x90 + .asciiz "DoBlock2WriteLP" +#endif +.align 3 +DoBlock2WriteLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoBlock2Write # [1] + .byte 0x84 + .asciiz "DoBlock2WriteFP" +#endif +.align 3 +DoBlock2WriteFP: # Entry point for FP relative +.align 3 +headDoBlock2Write: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoBlock2Write: +/* arg1 has the operand, sign extended if immediate. */ + ldl $18, PROCESSORSTATE_BAR2($14) # [1] + lda $17, PROCESSORSTATE_BAR2($14) # [0di] + br $31, BlockWrite # [1-] +.end DoBlock2Write +/* End of Halfword operand from stack instruction - DoBlock2Write */ +.align 5 +.globl DoBlock1Write +.ent DoBlock1Write 0 +/* Halfword operand from stack instruction - DoBlock1Write */ + .globl DoBlock1WriteFP + .globl DoBlock1WriteSP + .globl DoBlock1WriteLP + .globl DoBlock1WriteIM +.align 3 +DoBlock1Write: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoBlock1WriteIM" +#endif +.align 3 +DoBlock1WriteIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G13679: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoBlock1Write # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock1WriteSP" +#endif +.align 3 +DoBlock1WriteSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoBlock1Write # [0di] + .byte 0x90 + .asciiz "DoBlock1WriteLP" +#endif +.align 3 +DoBlock1WriteLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoBlock1Write # [1] + .byte 0x84 + .asciiz "DoBlock1WriteFP" +#endif +.align 3 +DoBlock1WriteFP: # Entry point for FP relative +.align 3 +headDoBlock1Write: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoBlock1Write: +/* arg1 has the operand, sign extended if immediate. */ + ldl $18, PROCESSORSTATE_BAR1($14) # [1] + lda $17, PROCESSORSTATE_BAR1($14) # [0di] +.align 3 +BlockWrite: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $18, 0, $18 # Unsigned vma [1-] + srl $16, 32, $2 # Get tag [1] + extll $16, 0, $3 # Get data [1] + addq $18, $14, $8 # [1] + s4addq $8, $31, $6 # [1] + ldq_u $5, 0($8) # [1di] + subq $18, $24, $4 # Stack cache offset [1-] + cmpult $4, $25, $7 # In range? [1] + insbl $2, $8, $4 # [1] + mskbl $5, $8, $5 # [1] +.align 3 +G13678: + bis $5, $4, $5 # [2] + stq_u $5, 0($8) # [0di] + stl $3, 0($6) # [1] + bne $7, G13677 # J. if in cache [1] +G13676: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + addq $18, 1, $18 # Increment the address [1-] + stl $18, 0($17) # Store updated vma in BAR [0di] + br $31, CACHEVALID # [1] +.align 3 +G13677: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $18, $24, $4 # Stack cache offset [0di] + s8addq $4, $8, $8 # reconstruct SCA [3] + stl $3, 0($8) # Store in stack [2] + stl $2, 4($8) # write the stack cache [1] + br $31, G13676 # [1] +.end DoBlock1Write +/* End of Halfword operand from stack instruction - DoBlock1Write */ +.align 5 +.globl DoBranchTrueNoPop +.ent DoBranchTrueNoPop 0 +/* Halfword 10 bit immediate instruction - DoBranchTrueNoPop */ + .globl DoBranchTrueNoPopFP + .globl DoBranchTrueNoPopSP + .globl DoBranchTrueNoPopLP + .globl DoBranchTrueNoPopIM +.align 3 +DoBranchTrueNoPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrueNoPop" +#endif +.align 3 +DoBranchTrueNoPopIM: +.align 3 +DoBranchTrueNoPopSP: +.align 3 +DoBranchTrueNoPopLP: +.align 3 +DoBranchTrueNoPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, NEXTINSTRUCTION # [1] + beq $16, BranchException # Can't branch to ourself [1] + addq $9, $16, $9 # Update the PC in halfwords [0di] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [1-] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrueNoPop +/* End of Halfword operand from stack instruction - DoBranchTrueNoPop */ +.align 5 +.globl DoBranchFalseNoPop +.ent DoBranchFalseNoPop 0 +/* Halfword 10 bit immediate instruction - DoBranchFalseNoPop */ + .globl DoBranchFalseNoPopFP + .globl DoBranchFalseNoPopSP + .globl DoBranchFalseNoPopLP + .globl DoBranchFalseNoPopIM +.align 3 +DoBranchFalseNoPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalseNoPop" +#endif +.align 3 +DoBranchFalseNoPopIM: +.align 3 +DoBranchFalseNoPopSP: +.align 3 +DoBranchFalseNoPopLP: +.align 3 +DoBranchFalseNoPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, NEXTINSTRUCTION # [1] + beq $16, BranchException # Can't branch to ourself [1] + addq $9, $16, $9 # Update the PC in halfwords [0di] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [1-] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalseNoPop +/* End of Halfword operand from stack instruction - DoBranchFalseNoPop */ +.globl callgenericprefetch +.align 5 +.globl callgeneric +.ent callgeneric 0 +/* Fullword instruction - callgeneric */ +#ifdef TRACING + .byte 0x80 + .asciiz "callgeneric" +#endif +.align 3 +callgeneric: +.align 3 +callgenericprefetch: + ldq $3, PROCESSORSTATE_TRAPVECBASE($14) # [1] + bis $18, $31, $19 # Get operand [0di] + bis $31, TypeGenericFunction, $18 # [1] + bis $31, TypeEvenPC, $20 # [1] + lda $21, 2636($3) # [1] + br $31, STARTCALLCOMPILEDMERGE # [0di] +.end callgeneric +/* End of Fullword instruction - callgeneric */ +.globl callcompiledevenprefetch +.align 5 +.globl callcompiledeven +.ent callcompiledeven 0 +/* Fullword instruction - callcompiledeven */ +#ifdef TRACING + .byte 0x80 + .asciiz "callcompiledeven" +#endif +.align 3 +callcompiledeven: +.align 3 +callcompiledevenprefetch: + bis $18, $31, $21 # Get operand [1-] + bis $31, TypeEvenPC, $20 # [1] + bis $31, $31, $18 # No extra arg [1] + br $31, STARTCALLCOMPILEDMERGE # [0di] +.end callcompiledeven +/* End of Fullword instruction - callcompiledeven */ +.align 5 +.globl DoStartCall +.ent DoStartCall 0 +/* Halfword operand from stack instruction - DoStartCall */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoStartCallFP + .globl DoStartCallSP + .globl DoStartCallLP + .globl DoStartCallIM +.align 3 +DoStartCall: +#ifdef TRACING + .byte 0x88 + .asciiz "DoStartCallSP" +#endif +.align 3 +DoStartCallSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoStartCall # [0di] + .byte 0x90 + .asciiz "DoStartCallLP" +#endif +.align 3 +DoStartCallLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoStartCall # [1] + .byte 0x84 + .asciiz "DoStartCallFP" +#endif +.align 3 +DoStartCallFP: # Entry point for FP relative +.align 3 +beginDoStartCall: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $20, 4($16) # [1] + ldl $21, 0($16) # [1] +.align 3 +STARTCALLAGAIN: +.align 3 +G13682: + ldq $1, PROCESSORSTATE_TRAPVECBASE($14) # [1] + and $20, 63, $2 # Strip off any CDR code bits. [1di] + cmpeq $2, TypeCompiledFunction, $3 # [1] +.align 3 +G13731: + beq $3, G13688 # [1] +/* Here if argument TypeCompiledFunction */ +.align 3 +G13683: + bis $31, $31, $18 # No extra argument [1-] +.align 3 +G13684: + bis $31, TypeEvenPC, $20 # [1] +.align 3 +STARTCALLCOMPILEDMERGE: + ldl $7, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + addq $12, 16, $12 # prepare to push continuation/control register [0di] + ldl $3, PROCESSORSTATE_CONTROL($14) # [1-] + bis $31, TypeFixnum+0xC0, $6 # [0di] + ldl $8, PROCESSORSTATE_CONTINUATION($14) # [1-] + ldah $5, 64 # [0di] + bis $7, 192, $7 # Set CDR code 3 [1] + stl $8, -8($12) # push continuation [0di] + stl $7, -4($12) # write the stack cache [1] + bis $3, $5, $8 # Set call started bit in CR [0di] + lda $5, 256 # [1] + stl $3, 0($12) # Push control register [0di] + stl $6, 4($12) # write the stack cache [1] + bic $8, $5, $8 # Clear the extra arg bit [0di] + stl $8, PROCESSORSTATE_CONTROL($14) # Save control with new state [1-] +/* End of push-frame */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $21, PROCESSORSTATE_CONTINUATION($14) # [1] + stl $20, PROCESSORSTATE_CONTINUATION+4($14) # [1] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [1] + bne $18, G13685 # [1] + br $31, CACHEVALID # [1] +.align 3 +G13685: + ldl $1, PROCESSORSTATE_CONTROL($14) # [1] + lda $2, 256 # [0di] + and $18, 63, $3 # set CDR-NEXT [1] + stl $19, 8($12) # Push the extra arg. [0di] + stl $3, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $1, $2, $1 # Set the extra arg bit [1] + stl $1, PROCESSORSTATE_CONTROL($14) # Save control with new state [0di] + br $31, CACHEVALID # [1] +.align 3 +G13688: + cmpeq $2, TypeGenericFunction, $3 # [1-] +.align 3 +G13732: + beq $3, G13689 # [1] +/* Here if argument TypeGenericFunction */ + bis $20, $31, $18 # [0di] + extll $21, 0, $19 # [1] + lda $21, 2636($1) # [1] + br $31, G13684 # [1-] +.align 3 +G13689: + cmpeq $2, TypeInstance, $3 # [1-] +.align 3 +G13733: + beq $3, G13690 # [1] +/* Here if argument TypeInstance */ + bis $20, $31, $18 # [0di] + extll $21, 0, $19 # [1] + lda $21, 2638($1) # [1] + br $31, G13684 # [1-] +.align 3 +G13690: + cmpeq $2, TypeSymbol, $3 # [1-] +.align 3 +G13734: + beq $3, G13691 # [1] +/* Here if argument TypeSymbol */ + extll $21, 0, $21 # [0di] + bis $31, $31, $18 # No extra argument [1] + addq $21, 2, $17 # Get to the function cell [1] + br $31, STARTCALLINDIRECT # [1-] +.align 3 +G13691: + cmpeq $2, TypeLexicalClosure, $3 # [1-] +.align 3 +G13735: + beq $3, G13692 # [1] +/* Here if argument TypeLexicalClosure */ + extll $21, 0, $17 # [0di] +/* Memory Read Internal */ +G13693: + addq $17, $14, $7 # [2] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13695 # [1-] +G13694: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13697 # [1-] +G13704: + bis $20, $31, $18 # [0di] + bis $21, $31, $19 # [1] + addq $17, 1, $17 # [1] +.align 3 +STARTCALLINDIRECT: +/* Memory Read Internal */ +G13705: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13707 # [1-] +G13706: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13709 # [1-] +G13716: + subq $20, TypeCompiledFunction, $5 # [0di] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G13682 # [1] + br $31, G13684 # [1] +.align 3 +G13692: +/* Here for all other cases */ +.align 3 +G13680: + bis $20, $31, $18 # [1-] + bis $21, $31, $19 # [1] + lda $3, 2304($1) # [1] +/* TagType. */ + and $20, 63, $20 # [1] + addq $20, $3, $17 # [1] +/* Memory Read Internal */ +G13718: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13720 # [0di] +G13719: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13722 # [1di] +G13729: + subq $20, TypeEvenPC, $3 # [1-] + and $3, 63, $3 # Strip CDR code, low bits [1] + bne $3, G13681 # [1] + br $31, G13684 # [1] +.align 3 +G13687: +.align 3 +G13681: + bis $31, $1, $20 # [1-] + bis $31, 51, $17 # [1] + br $31, ILLEGALOPERAND # Bad type for start-call +.align 3 +G13722: + blbc $7, G13721 # [1-] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13718 # [1-] +.align 3 +G13721: +.align 3 +G13720: + bsr $0, MemoryReadDataDECODE + br $31, G13729 # [1] +.align 3 +G13709: + blbc $7, G13708 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13705 # [1-] +.align 3 +G13708: +.align 3 +G13707: + bsr $0, MemoryReadDataDECODE + br $31, G13716 # [1] +.align 3 +G13697: + blbc $7, G13696 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13693 # [1-] +.align 3 +G13696: +.align 3 +G13695: + bsr $0, MemoryReadDataDECODE + br $31, G13704 # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoStartCallIM" +#endif +DoStartCallIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoStartCall. +.end DoStartCall +/* End of Halfword operand from stack instruction - DoStartCall */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifuncom1.as */ diff --git a/alpha-emulator/ifuncom2.as b/alpha-emulator/ifuncom2.as new file mode 100644 index 0000000..fdd1fb9 --- /dev/null +++ b/alpha-emulator/ifuncom2.as @@ -0,0 +1,402 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "The most commonly used instructions, part 2.") + +;;; The functions in this file are pretty much in order of usage count for +;;; a set of representative "benchmarks" (compiler, window system, UI). +;;; The exception to the ordering is that sometimes short procedures are +;;; placed just before another longer one that will be tail-called, in +;;; order to get better instruction fetching behavior. + +;;; From IFUNINST.AS + +;; This really only takes an 8-bit immediate +(define-instruction |DoPushInstanceVariable| :10-bit-immediate (:own-immediate t) + (BIS arg2 zero arg1) ;need arg2 in arg1 since arg2 is "vma" + (with-multiple-memory-reads (t9 t10 t11 t12) + (locate-instance-variable-mapped arg1 arg2 IVBadMap IVBadInst IVBadIndex PushIVException + arg5 arg6 t1 t2 t3 t4 t5 t6 t7 t8) + + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)) + (GetNextPCandCP) + (stack-push2 arg5 arg6 t7) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMATH.AS + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline +(define-instruction |DoAdd| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-operation add ADDL ADDS DoAddOvfl) + (immediate-handler |DoAdd|) + (simple-binary-immediate-arithmetic-operation |DoAdd| ADDL nil DoAddOvfl)) + + +;;; From IFUNBLOK.AS + +(define-instruction |DoBlock3Write| :operand-from-stack-signed-immediate () + (LDL arg3 PROCESSORSTATE_BAR3 (ivory)) + (LDA arg2 PROCESSORSTATE_BAR3 (ivory)) + (BR zero |BlockWrite|)) + + +;;; From IFUNARRA.AS + +;;; arg1, on stack=array +;;; arg2, operand =index + +(define-instruction |DoAset1| :operand-from-stack-immediate (:own-immediate t) + (stack-pop2 arg3 arg4 "Get the array tag/data") + (stack-pop2 t5 t6 "Get the new value tag/data") + (ADDL arg1 0 arg2 "(sign-extended, for fast bounds check) Index Data") + (LDA t8 |AutoArrayRegMask| (zero)) + (AND arg4 t8 t8) + ;(SLL t8 |AutoArrayRegShift| t8) ; mask is in place, so shift is zero. + (SRL arg1 32 arg1 "Index Tag") + (LDA t7 PROCESSORSTATE_AC0ARRAY (ivory)) + (ADDQ t7 t8 t7 "This is the address if the array register block.") + (CheckDataType arg1 |TypeFixnum| Aset1Illegal t1) + (label aset1merge) + (BEQ arg4 |Aset1Regset|) ;+++ + (LDQ t8 ARRAYCACHE_ARRAY (t7) "Cached array object.") + ;; Array or String + (CheckAdjacentDataTypes arg3 |TypeArray| 2 ReallyAset1Exc t1) + (CMPEQ arg4 t8 t8 "t8==1 iff cached array is ours.") + (branch-false t8 |Aset1Regset| "Go and setup the array register.") + (passthru "#ifdef SLOWARRAYS") + (BR zero |Aset1Regset|) + (passthru "#endif") + ;; Get control register, base, and length. Don't need any data types + ;; since we checked all that when we set up the array register. + (LDQ arg6 ARRAYCACHE_ARWORD (t7)) + (LDQ t9 ARRAYCACHE_LOCAT (t7) "high order bits all zero") + (LDQ t3 ARRAYCACHE_LENGTH (t7) "high order bits all zero") + (SLL arg6 #.(- 64 |array$K-registereventcountsize|) t11) + (LDQ t4 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (SRL t11 #.(- 64 |array$K-registereventcountsize|) t11) + ;; (check-array-bounds arg2 t3 Aref1Bounds t2) + (CMPULT arg2 t3 t2) + (SUBQ t4 t11 t12) + (BNE t12 |Aset1Regset| "J. if event count ticked.") + (branch-false t2 aset1bounds) + (SRL arg6 |ArrayRegisterBytePackingPos| arg5) + (SRL arg6 |ArrayRegisterElementTypePos| t8) + (SRL arg6 |ArrayRegisterByteOffsetPos| arg4) + (AND arg5 |ArrayRegisterBytePackingMask| arg5) + (AND arg4 |ArrayRegisterByteOffsetMask| arg4) + (AND t8 |ArrayRegisterElementTypeMask| arg6) + (label Aset1Restart) + (aset-1-internal arg3 t9 arg5 arg4 arg6 arg2 t5 t6 t1 t2 t3 t4 t7 t8 arg1) + (immediate-handler |DoAset1|) + (LDA t8 |AutoArrayRegMask| (zero)) + (stack-pop2 arg3 arg4 "Get the array tag/data") + (LDA t7 PROCESSORSTATE_AC0ARRAY (ivory)) + (AND arg4 t8 t8) + ;(SLL t8 |AutoArrayRegShift| t8) + (ADDQ t7 t8 t7 "This is the address of the array register block.") + (stack-pop2 t5 t6 "Get the new value tag/data") + (BR zero aset1merge)) + +(define-instruction |DoFastAref1| :operand-from-stack (:needs-tos t) + (stack-read2 iSP arg3 arg4 :tos-valid t :signed t) + (CheckDataType arg3 |TypeFixnum| fastaref1iop t1) + (label FastAref1Retry) + ;; Get control register, base, and length. Don't need any data types + ;; since we checked all that when we set up the array register. + (LDL arg6 0 (arg1)) + (LDL t9 8 (arg1)) + (LDL t3 16 (arg1)) + (EXTLL arg6 0 arg6) + (EXTLL t9 0 t9) + (SLL arg6 #.(- 64 |array$K-registereventcountsize|) t5) + (EXTLL t3 0 t3) + (LDQ t4 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (SRL t5 #.(- 64 |array$K-registereventcountsize|) t5) + ;; (check-array-bounds arg4 t3 fastaref1bounds t2) + (CMPULT arg4 t3 t2) + (branch-false t2 fastaref1bounds) + (SUBQ t4 t5 t6) + (BNE t6 |Aref1RecomputeArrayRegister|) ;branches back to FastAref1Retry + (SRL arg6 |ArrayRegisterBytePackingPos| t6) + (SRL arg6 |ArrayRegisterByteOffsetPos| t7) + (SRL arg6 |ArrayRegisterElementTypePos| t8) + (AND t6 |ArrayRegisterBytePackingMask| t6) + (AND t7 |ArrayRegisterByteOffsetMask| t7) + (AND t8 |ArrayRegisterElementTypeMask| t8) + (new-aref-1-internal arg5 t9 t6 t7 t8 arg4 t1 t2 t3 t4 t5) + (label fastaref1iop) + (illegal-operand fast-array-access-type-check) + (label fastaref1bounds) + (illegal-operand array-register-format-error-or-subscript-bounds-error)) + + +;;; From IFUNLIST.AS + +(define-instruction |DoRplaca| :operand-from-stack-signed-immediate (:needs-tos t) + (with-multiple-memory-reads (t9 t10 t11 t12) ;must be the same as in |DoRplacd| + (stack-pop2 t1 arg2 "Read ARG1, the list" :tos-valid t) + (TagType t1 t3) + (SUBQ t3 |TypeList| t4) ;t4=0 if list, t4=4 if locative + (BIC t4 4 t4) ;t4=0 iff list or locative + (BNE t4 RplacaException) ;in |OutOfLineExceptions| + (label |RplacStore|) + (SRL arg1 32 t2 "Tag for t2") + (EXTLL arg1 0 arg1 "data for t2") + (store-contents arg2 t2 arg1 PROCESSORSTATE_DATAWRITE arg5 arg6 t5 t6 t7 t8 + NextInstruction) + (ContinueToNextInstruction))) + +(define-memory-subroutine |MemoryReadWrite| + (arg2 arg5 arg6 PROCESSORSTATE_DATAWRITE t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-instruction |DoRplacd| :operand-from-stack-signed-immediate (:needs-tos t) + (with-multiple-memory-reads (t9 t10 t11 t12) ;must be the same as in |DoRplaca| + (stack-pop2 t1 arg2 "Read ARG1, the list" :tos-valid t) + (TagType t1 t3) + (SUBQ t3 |TypeLocative| t4) + (BEQ t4 |RplacStore|) + (SUBQ t3 |TypeList| t4) + (BNE t4 RplacdException) ;in |OutOfLineExceptions| + (memory-read arg2 arg5 arg6 PROCESSORSTATE_CDR t5 t6 t7 t8 nil t) + (TagCdr arg5 arg5) + (SUBQ arg5 |CdrNormal| arg5) + (BNE arg5 RplacdException "J. if CDR coded") + (ADDQ arg2 1 arg2 "address of CDR") + (BR zero |RplacStore|))) + +;;; From IFUNLOOP.AS + +(define-instruction |DoBranchTrueAndExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil t nil t |BranchException|)) ;and-pop extra-pop + +(define-instruction |DoBranchFalseAndExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t t nil t |BranchException|)) ;invert and-pop extra-pop + +(define-instruction |DoBranchTrueAndNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil t nil |BranchException|)) ;else-pop + +(define-instruction |DoBranchFalseAndNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil t nil |BranchException|)) ;invert else-pop + +(define-instruction |DoBranchFalseElseNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t t nil nil |BranchException|)) ;invert and-pop + + +;;; From IFUNPRED.AS + +;; Handles DoEqualNumberNoPop as well +(define-instruction |DoEqualNumber| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + equal-number SUBL CMOVEQ CMPTEQ FBNE t |EqualNumberMMExc|) + (immediate-handler |DoEqualNumber|) + (simple-binary-immediate-arithmetic-predicate + equal-number SUBL CMOVEQ t)) + + +;;; From IFUNLIST.AS + +(define-instruction |DoSetToCdrPushCar| :operand-from-stack () + ;; (isettocdrpushcar arg1 t1 t2 arg5 arg6 arg2 t4 t3 arg3 arg4 t5 t6 t7 t8) + (with-multiple-memory-reads (t9 t10 t11 t12) + (stack-read2 arg1 t1 t2 "Get the operand from the stack.") + (AND t1 192 t3 "Save the old CDR code") + (SUBQ t1 |TypeLocative| t5) + (AND t5 63 t5 "Strip CDR code") + (BEQ t5 settocdrpushcarlocative) + #+list-inline (carcdr-internal t1 t2 arg5 arg6 set-to-cdr-push-car arg2 t5 t6 t7 t8 t) + #-list-inline (BSR r0 |CarCdrInternal|) + (TagType arg5 arg5) + (BIS arg5 t3 arg5 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (stack-push2 t1 t2 t5) + (ContinueToNextInstruction) + )) + +;;; From IFUNMATH.AS + +;; Same deal as |DoAdd|... +(define-instruction |DoSub| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-operation sub SUBL SUBS DoSubOvfl) + (immediate-handler |DoSub|) + (simple-binary-immediate-arithmetic-operation |DoSub| SUBL nil DoSubOvfl)) + + +;;; From IFUNSUBP.AS + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline +(define-instruction |DoTag| :operand-from-stack (:provide-immediate t) + (GetNextPC) + (stack-read-tag arg1 arg1 "Get the tag of the operand") + (GetNextCP) + (stack-push-ir-reverse |TypeFixnum| arg1 t3) + (ContinueToNextInstruction-NoStall) +) + + +;;; From IFUNPRED.AS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoEndp| :operand-from-stack (:own-immediate t) + (LDQ t1 PROCESSORSTATE_NILADDRESS (ivory)) + (stack-read-tag arg1 arg2 "Get tag.") + (LDQ t2 PROCESSORSTATE_TADDRESS (ivory)) + (TagType arg2 arg2) + (SUBQ arg2 |TypeNIL| t6 "Compare") + (BNE t6 endpnotnil) + ;(label endpt) + (GetNextPCandCP) + (stack-push-with-cdr t2) + (ContinueToNextInstruction-NoStall) + (label endpnil) + (GetNextPCandCP) + (stack-push-with-cdr t1) + (ContinueToNextInstruction-NoStall) + (label endpnotnil) + (SUBQ t6 1 t6 "Now check for list") ;DTP-LIST = DTP-NIL + 1 (yow!) + (BEQ t6 endpnil) + (SUBQ arg2 |TypeListInstance| t6) + (BEQ t6 endpnil) + (immediate-handler |DoEndp|) ;silly really + (illegal-operand one-operand-list-type-error)) + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoMinusp| :operand-from-stack (:own-immediate t) + (simple-unary-arithmetic-predicate minusp CMOVLT FBLT) + (immediate-handler |DoMinusp|) + (LDQ t1 PROCESSORSTATE_NILADDRESS (ivory)) + (SLL arg2 #.(- 64 8) arg2 "Turned into a signed number") + (LDQ t2 PROCESSORSTATE_TADDRESS (ivory)) + (ADDQ iSP 8 iSP) + (GetNextPCandCP) + (CMOVLT arg2 t2 t1 "stall 2 then di") + (stack-write iSP t1 "yes Virginia, we dual issue with above yahoo") + (ContinueToNextInstruction-NoStall)) + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoPlusp| :operand-from-stack (:own-immediate t) + (simple-unary-arithmetic-predicate plusp CMOVGT FBGT) + (immediate-handler |DoPlusp|) + (LDQ t1 PROCESSORSTATE_NILADDRESS (ivory)) + (SLL arg2 #.(- 64 8) arg2 "Turned into a signed number") + (LDQ t2 PROCESSORSTATE_TADDRESS (ivory)) + (ADDQ iSP 8 iSP) + (GetNextPCandCP) + (CMOVGT arg2 t2 t1 "stall 2 then di") + (stack-write iSP t1 "yes Virginia, we dual issue with above yahoo") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNPRED.AS + +;; Handles DoLesspNoPop as well +(define-instruction |DoLessp| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + lessp SUBQ CMOVLT CMPTLT FBNE t |LesspMMExc|) + (immediate-handler |DoLessp|) + (simple-binary-immediate-arithmetic-predicate + lessp SUBQ CMOVLT t)) + + +;;; From IFUNMATH.AS + +(define-instruction |DoDecrement| :operand-from-stack () + (stack-read2 arg1 arg2 arg3 "read tag/data of arg1") + (type-dispatch arg2 t1 t2 + (|TypeFixnum| + (LDQ t2 PROCESSORSTATE_MOSTNEGATIVEFIXNUM (ivory)) + (SUBQ arg3 1 t3) + (CMPEQ arg3 t2 t2) ;overflow if most-negative-fixnum + (branch-true t2 DecrementException) ;in |OutOfLineExceptions| + (GetNextPCandCP) + (stack-write2 arg1 arg2 t3) + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (with-floating-exception-checking (DecrementException t2) + ;(CheckFloatingOverflow arg3 DecrementException t2) + (LDS f1 0 (arg1) "Get the floating data") + (LDS f2 PROCESSORSTATE_SFP1 (ivory) "constant 1.0") + (SUBS f1 f2 f0)) + (GetNextPCandCP) + (STS f0 0 (arg1) "Put the floating result") + (ContinueToNextInstruction-NoStall)) + (:else + (BR zero DecrementException)))) + + +;;; From IFUNSUBP.AS + +(define-instruction |DoMergeCdrNoPop| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + (stack-read-tag arg1 t1 "Get the CDR CODE/TAG of arg2") + (stack-read-tag iSP t2 "Get the CDR CODE/TAG of arg1" :tos-valid t) + (force-alignment) + (AND t2 #xC0 t2 "Get Just the CDR code in position") + (AND t1 #x3F t1 "Get the TAG of arg1") + (BIS t1 t2 t3 "Merge the tag of arg2 with the cdr code of arg1") + (STL t3 4 (arg1) "Replace tag/cdr code no pop") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNPRED.AS, by way of IFUNCOM1.AS + +(define-procedure |DoEqImmediateHandler| () + (immediate-handler |DoEq|) + (SLL arg2 #.(- 64 8) arg2) + (stack-read2 iSP t4 t3 "t4=tag t3=data" :signed t) + (SRL arg3 #.(+ 10 2) arg3) + (LDQ t11 PROCESSORSTATE_NILADDRESS (ivory)) + (SRA arg2 #.(- 64 8) arg2 "Sign extension of arg2 is complete") + (TagType t4 t4) + (LDQ t12 PROCESSORSTATE_TADDRESS (ivory)) + (AND arg3 1 arg3 "1 if no-pop, 0 if pop") + (SUBL t3 arg2 arg2) + (XOR t4 |TypeFixnum| t4) + (S8ADDQ arg3 iSP iSP "Either a stack-push or a stack-write") + (GetNextPC) + (BIS arg2 t4 t4) + (GetNextCP) + (CMOVEQ t4 t12 t11) + (stack-write iSP t11 "Yes Virginia, this does dual issue with above") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMATH.AS + +(define-instruction |DoIncrement| :operand-from-stack () + (stack-read2 arg1 arg2 arg3 "read tag/data of arg1") + (type-dispatch arg2 t1 t2 + (|TypeFixnum| + (LDQ t2 PROCESSORSTATE_MOSTPOSITIVEFIXNUM (ivory)) + (ADDQ arg3 1 t3) + (CMPEQ arg3 t2 t2) ;overflow if most-positive-fixnum + (branch-true t2 IncrementException) ;in |OutOfLineExceptions| + (GetNextPCandCP) + (stack-write2 arg1 arg2 t3) + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (with-floating-exception-checking (IncrementException t2) + ;(CheckFloatingOverflow arg3 IncrementException t2) + (LDS f1 0 (arg1) "Get the floating data") + (LDS f2 PROCESSORSTATE_SFP1 (ivory) "constant 1.0") + (ADDS f1 f2 f0)) + (GetNextPCandCP) + (STS f0 0 (arg1) "Put the floating result") + (ContinueToNextInstruction-NoStall)) + (:else + (BR zero IncrementException)))) + + +(comment "Fin.") diff --git a/alpha-emulator/ifuncom2.s b/alpha-emulator/ifuncom2.s new file mode 100644 index 0000000..f1ee37b --- /dev/null +++ b/alpha-emulator/ifuncom2.s @@ -0,0 +1,3026 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuncom2.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* The most commonly used instructions, part 2. */ +.align 5 +.globl DoPushInstanceVariable +.ent DoPushInstanceVariable 0 +/* Halfword 10 bit immediate instruction - DoPushInstanceVariable */ + .globl DoPushInstanceVariableFP + .globl DoPushInstanceVariableSP + .globl DoPushInstanceVariableLP + .globl DoPushInstanceVariableIM +.align 3 +DoPushInstanceVariable: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPushInstanceVariable" +#endif +.align 3 +DoPushInstanceVariableIM: +.align 3 +DoPushInstanceVariableSP: +.align 3 +DoPushInstanceVariableLP: +.align 3 +DoPushInstanceVariableFP: +/* arg1 has operand preloaded. */ + bis $17, $31, $16 # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Instance Variable Mapped */ + ldl $17, 16($10) # Map [1] + ldl $20, 20($10) # [1] + extll $17, 0, $17 # [2di] + subq $20, TypeArray, $2 # [1] + and $2, 63, $2 # Strip CDR code [1] + bne $2, IVBADMAP # [1] +/* Memory Read Internal */ +G13739: + addq $17, $14, $7 # [0di] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13741 # [0di] +G13740: + lda $7, 64 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13743 # [1di] +G13748: + and $21, ArrayLengthMask, $21 # [1-] + subq $21, $16, $3 # [1] + ble $3, IVBADINDEX # J. if mapping-table-index-out-of-bounds [1] + addq $17, $16, $17 # [0di] + addq $17, 1, $17 # [1] +/* Memory Read Internal */ +G13749: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13751 # [0di] +G13750: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13753 # [1-] +G13760: + bis $21, $31, $1 # [1di] + subq $20, TypeFixnum, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, PUSHIVEXCEPTION # [1] + ldl $17, 24($10) # Self [0di] + ldl $4, 28($10) # [1] + extll $17, 0, $17 # [2di] + subq $4, TypeInstance, $3 # [1] + and $3, 60, $3 # Strip CDR code, low bits [1] + bne $3, IVBADINST # [1] + and $4, 192, $3 # Unshifted cdr code [1] + subq $3, 64, $3 # Check for CDR code 1 [1] + bne $3, G13738 # J. if CDR code is not 1 [1] +.align 3 +G13737: + addq $17, $1, $17 # [1-] +.align 3 +G13736: +/* Memory Read Internal */ +G13761: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13763 # [1-] +G13762: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13765 # [1-] +G13772: + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + and $20, 63, $7 # set CDR-NEXT [0di] + stl $21, 8($12) # [1-] + stl $7, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G13765: + blbc $7, G13764 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13761 # [1-] +.align 3 +G13764: +.align 3 +G13763: + bsr $0, MemoryReadDataDECODE + br $31, G13772 # [1] +.align 3 +G13753: + blbc $7, G13752 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13749 # [1-] +.align 3 +G13752: +.align 3 +G13751: + bsr $0, MemoryReadDataDECODE + br $31, G13760 # [1] +.align 3 +G13743: + blbc $7, G13742 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13739 # [1-] +.align 3 +G13742: +.align 3 +G13741: + bsr $0, MemoryReadHeaderDECODE + br $31, G13748 # [1] +.align 3 +G13738: + bis $17, $31, $3 # [1-] +/* Memory Read Internal */ +G13773: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G13775 # [0di] +G13774: + lda $7, 64 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13777 # [1-] +G13782: + subq $3, $17, $3 # [0di] + bne $3, G13737 # [1] +/* TagType. */ + and $4, 63, $4 # [0di] + bis $4, 64, $4 # Set CDR code to 1 [1] + stl $17, 24($10) # Update self [0di] + stl $4, 28($10) # write the stack cache [1] + br $31, G13737 # [1] +.align 3 +G13777: + blbc $7, G13776 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13773 # [1-] +.align 3 +G13776: +.align 3 +G13775: + bsr $0, MemoryReadHeaderDECODE + br $31, G13782 # [1] +.end DoPushInstanceVariable +/* End of Halfword operand from stack instruction - DoPushInstanceVariable */ +.align 5 +.globl DoAdd +.ent DoAdd 0 +/* Halfword operand from stack instruction - DoAdd */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAddFP + .globl DoAddSP + .globl DoAddLP + .globl DoAddIM +.align 3 +DoAdd: +#ifdef TRACING + .byte 0x88 + .asciiz "DoAddSP" +#endif +.align 3 +DoAddSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoAdd # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoAdd # [0di] + .byte 0x90 + .asciiz "DoAddLP" +#endif +.align 3 +DoAddLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoAdd # [1] + .byte 0x84 + .asciiz "DoAddFP" +#endif +.align 3 +DoAddFP: # Entry point for FP relative +.align 3 +beginDoAdd: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lds $f1, 0($12) # [0di] + extll $21, 4, $1 # ARG1 tag [1-] + ldl $3, 4($16) # ARG2 tag [1di] + addl $21, $31, $2 # ARG1 data [1-] + ldl $4, 0($16) # ARG2 data [0di] + lds $f2, 0($16) # [1] + and $1, 63, $22 # Strip off any CDR code bits. [0di] + and $3, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $22, TypeFixnum, $23 # [1] +.align 3 +G13822: + beq $23, G13793 # [1] +/* Here if argument TypeFixnum */ + cmpeq $24, TypeFixnum, $25 # [0di] +.align 3 +G13799: + beq $25, G13795 # [1] +/* Here if argument TypeFixnum */ + ldq $6, CACHELINE_NEXTPCDATA($13) # [0di] + addlv $2, $4, $5 # compute 64-bit result [1-] + ldq $7, CACHELINE_NEXTCP($13) # [0di] + trapb # Force the trap to occur here [3] + stl $22, 4($12) # Semi-cheat, we know temp2 has CDRNext/TypeFixnum [1] + bis $6, $31, $9 # [1-] + stl $5, 0($12) # [0di] + bis $7, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G13795: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G13800: + beq $25, G13796 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqt $f1, $f1 # [6] + br $31, G13783 # [1] +.align 3 +G13796: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G13801: + beq $25, G13790 # [1] +/* Here if argument TypeDoubleFloat */ + cvtlq $f1, $f1 # [3] + cvtqt $f1, $f1 # [6] + br $31, G13786 # [1] +.align 3 +G13794: +.align 3 +G13793: + cmpeq $22, TypeSingleFloat, $23 # [1-] +.align 3 +G13823: + beq $23, G13802 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $24, TypeSingleFloat, $25 # [0di] +.align 3 +G13808: + beq $25, G13804 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G13783: + adds $f1, $f2, $f0 # [2] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeSingleFloat, $8 # [1-] + stl $8, 4($12) # write the stack cache [0di] + sts $f0, 0($12) # [1] + br $31, CACHEVALID # [1] +.align 3 +G13804: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G13809: + beq $25, G13805 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqt $f2, $f2 # [6] + br $31, G13783 # [1] +.align 3 +G13805: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G13810: + beq $25, G13790 # [1] +/* Here if argument TypeDoubleFloat */ +.align 3 +G13786: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + br $31, G13787 # [1] +.align 3 +G13803: +.align 3 +G13802: + cmpeq $22, TypeDoubleFloat, $23 # [1-] +.align 3 +G13824: + beq $23, G13811 # [1] +/* Here if argument TypeDoubleFloat */ + cmpeq $24, TypeDoubleFloat, $25 # [0di] +.align 3 +G13817: + beq $25, G13813 # [1] +/* Here if argument TypeDoubleFloat */ + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [0di] + bsr $0, FetchDoubleFloat + ldt $f1, PROCESSORSTATE_FP0($14) # [1-] +.align 3 +G13787: + extll $4, 0, $17 # [1-] + bsr $0, FetchDoubleFloat + ldt $f2, PROCESSORSTATE_FP0($14) # [0di] +.align 3 +G13784: + addt $f1, $f2, $f0 # [3] + stt $f0, PROCESSORSTATE_FP0($14) # [0di] + bsr $0, ConsDoubleFloat + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeDoubleFloat, $8 # [1-] + stl $17, 0($12) # [0di] + stl $8, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G13813: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G13818: + beq $25, G13814 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G13785: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [1-] + bsr $0, FetchDoubleFloat + ldt $f1, PROCESSORSTATE_FP0($14) # [0di] + br $31, G13784 # [1] +.align 3 +G13814: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G13819: + beq $25, G13790 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqt $f2, $f2 # [6] + br $31, G13785 # [1] +.align 3 +G13812: +.align 3 +G13811: +/* Here for all other cases */ +.align 3 +G13789: +.align 3 +DOADDOVFL: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G13791 # [1-] +.align 3 +G13790: + bis $3, $31, $1 # [1-] + br $31, DOADDOVFL # [0di] +.align 3 +G13791: +.align 3 +G13792: +#ifdef TRACING + br $31, DoAddIM # [1] + .byte 0x82 + .asciiz "DoAddIM" +#endif +.align 5 +.align 3 +DoAddIM: # Entry point for IMMEDIATE mode + extll $21, 4, $1 # [1-] + addl $21, $31, $2 # get ARG1 tag/data [1] + and $1, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $24, TypeFixnum, $25 # [1] +.align 3 +G13829: + beq $25, G13826 # [1] +/* Here if argument TypeFixnum */ + addq $2, $17, $3 # compute 64-bit result [0di] + ldq $4, CACHELINE_NEXTPCDATA($13) # [1-] + addl $3, $31, $23 # compute 32-bit sign-extended result [0di] + ldq $5, CACHELINE_NEXTCP($13) # [1-] + cmpeq $3, $23, $23 # is it the same as the 64-bit result? [0di] + beq $23, DOADDOVFL # if not, we overflowed [1] + stl $24, 4($12) # Semi-cheat, we know temp2 has CDRNext/TypeFixnum [1] + bis $4, $31, $9 # [1-] + stl $3, 0($12) # [0di] + bis $5, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G13826: +/* Here for all other cases */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + bis $31, $31, $17 # [1] + br $31, beginDoAdd # [0di] +.align 3 +G13825: +.end DoAdd +/* End of Halfword operand from stack instruction - DoAdd */ +.align 5 +.globl DoBlock3Write +.ent DoBlock3Write 0 +/* Halfword operand from stack instruction - DoBlock3Write */ + .globl DoBlock3WriteFP + .globl DoBlock3WriteSP + .globl DoBlock3WriteLP + .globl DoBlock3WriteIM +.align 3 +DoBlock3Write: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoBlock3WriteIM" +#endif +.align 3 +DoBlock3WriteIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G13863: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoBlock3Write # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoBlock3WriteSP" +#endif +.align 3 +DoBlock3WriteSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoBlock3Write # [0di] + .byte 0x90 + .asciiz "DoBlock3WriteLP" +#endif +.align 3 +DoBlock3WriteLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoBlock3Write # [1] + .byte 0x84 + .asciiz "DoBlock3WriteFP" +#endif +.align 3 +DoBlock3WriteFP: # Entry point for FP relative +.align 3 +headDoBlock3Write: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoBlock3Write: +/* arg1 has the operand, sign extended if immediate. */ + ldl $18, PROCESSORSTATE_BAR3($14) # [1] + lda $17, PROCESSORSTATE_BAR3($14) # [0di] + br $31, BlockWrite # [1-] +.end DoBlock3Write +/* End of Halfword operand from stack instruction - DoBlock3Write */ +.align 5 +.globl DoAset1 +.ent DoAset1 0 +/* Halfword operand from stack instruction - DoAset1 */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAset1FP + .globl DoAset1SP + .globl DoAset1LP + .globl DoAset1IM +.align 3 +DoAset1: +#ifdef TRACING + .byte 0x88 + .asciiz "DoAset1SP" +#endif +.align 3 +DoAset1SP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAset1 # [0di] + .byte 0x90 + .asciiz "DoAset1LP" +#endif +.align 3 +DoAset1LP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAset1 # [1] + .byte 0x84 + .asciiz "DoAset1FP" +#endif +.align 3 +DoAset1FP: # Entry point for FP relative +.align 3 +headDoAset1: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAset1: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # Get the array tag/data [1] + ldl $18, 4($12) # Get the array tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + ldl $6, 0($12) # Get the new value tag/data [1-] + ldl $5, 4($12) # Get the new value tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $6, 0, $6 # [1] + addl $16, 0, $17 # (sign-extended, for fast bounds check) Index Data [1] + lda $8, AutoArrayRegMask # [1] + and $19, $8, $8 # [1] + srl $16, 32, $16 # Index Tag [1] + lda $7, PROCESSORSTATE_AC0ARRAY($14) # [1] + addq $7, $8, $7 # This is the address if the array register block. [1] + subq $16, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, ASET1ILLEGAL # [1] +.align 3 +ASET1MERGE: + beq $19, Aset1Regset # [1] + ldq $8, ARRAYCACHE_ARRAY($7) # Cached array object. [0di] + subq $18, TypeArray, $1 # [1-] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, REALLYASET1EXC # [1] + cmpeq $19, $8, $8 # t8==1 iff cached array is ours. [0di] + beq $8, Aset1Regset # Go and setup the array register. [1] +#ifdef SLOWARRAYS + br $31, Aset1Regset # [1] +#endif + ldq $21, ARRAYCACHE_ARWORD($7) # [1] + ldq $22, ARRAYCACHE_LOCAT($7) # high order bits all zero [1] + ldq $3, ARRAYCACHE_LENGTH($7) # high order bits all zero [1] + sll $21, 42, $24 # [1di] + ldq $4, PROCESSORSTATE_AREVENTCOUNT($14) # [1-] + srl $24, 42, $24 # [1di] + cmpult $17, $3, $2 # [1] + subq $4, $24, $25 # [1] + bne $25, Aset1Regset # J. if event count ticked. [1] + beq $2, ASET1BOUNDS # [1] + srl $21, ArrayRegisterBytePackingPos, $20 # [1-] + srl $21, ArrayRegisterElementTypePos, $8 # [1] + srl $21, ArrayRegisterByteOffsetPos, $19 # [1] + and $20, ArrayRegisterBytePackingMask, $20 # [1] + and $19, ArrayRegisterByteOffsetMask, $19 # [1] + and $8, ArrayRegisterElementTypeMask, $21 # [1] +.align 3 +ASET1RESTART: +/* Element checking and foreplay. */ +/* TagType. */ + and $5, 63, $1 # [1] + cmpeq $21, ArrayElementTypeCharacter, $8 # [1] +.align 3 +G13874: + beq $8, G13870 # [1] +/* Here if argument ArrayElementTypeCharacter */ + subq $1, TypeCharacter, $2 # [0di] + beq $2, G13865 # [1] + bis $31, 0, $20 # [0di] + bis $31, 29, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13865: + beq $20, G13864 # Certainly will fit if not packed! [1-] + bis $31, 32, $2 # [0di] + srl $2, $20, $2 # Compute size of byte [1] + ornot $31, $31, $1 # [1] + sll $1, $2, $1 # [1] + ornot $31, $1, $1 # Compute mask for byte [2] + and $6, $1, $1 # [1] + subq $6, $1, $1 # [1] + beq $1, G13864 # J. if character fits. [1] + bis $31, 0, $20 # [0di] + bis $31, 62, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13870: + cmpeq $21, ArrayElementTypeFixnum, $8 # [1] +.align 3 +G13875: + beq $8, G13871 # [1] +/* Here if argument ArrayElementTypeFixnum */ + subq $1, TypeFixnum, $2 # [0di] + beq $2, G13864 # [1] + bis $31, 0, $20 # [0di] + bis $31, 33, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13871: + cmpeq $21, ArrayElementTypeBoolean, $8 # [1] +.align 3 +G13876: + beq $8, G13869 # [1] +/* Here if argument ArrayElementTypeBoolean */ + bis $31, 1, $6 # [0di] + subq $1, TypeNIL, $1 # [1] + bne $1, G13864 # J. if True [1] + bis $31, $31, $6 # [1-] + br $31, G13864 # J. if False [0di] +.align 3 +G13869: +/* Shove it in. */ +.align 3 +G13864: + bne $20, G13866 # J. if packed [1] + subq $21, ArrayElementTypeObject, $1 # [0di] + bne $1, G13866 # [1] +/* Here for the simple non packed case */ + addq $22, $17, $1 # [1] +/* Memory Read Internal */ +G13877: + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $1, $14, $8 # [0di] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $8, $31, $3 # [0di] + ldq_u $2, 0($8) # [1-] + subq $1, $4, $4 # Stack cache offset [1di] + ldq $16, PROCESSORSTATE_DATAWRITE_MASK($14) # [1-] + cmpult $4, $7, $7 # In range? [0di] + ldl $3, 0($3) # [1-] + extbl $2, $8, $2 # [0di] + bne $7, G13879 # [1-] +G13878: + lda $8, 240 # [0di] + srl $16, $2, $16 # [1] + srl $8, $2, $8 # [1] + blbs $16, G13881 # [1-] +G13887: +/* Merge cdr-code */ + and $5, 63, $3 # [0di] + and $2, 192, $2 # [1] + bis $2, $3, $2 # [1] + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + addq $1, $14, $4 # [0di] + ldl $16, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $4, $31, $3 # [0di] + ldq_u $8, 0($4) # [1-] + subq $1, $7, $7 # Stack cache offset [1di] + cmpult $7, $16, $16 # In range? [1] + insbl $2, $4, $7 # [1] + mskbl $8, $4, $8 # [1] +.align 3 +G13889: + bis $8, $7, $8 # [2] + stq_u $8, 0($4) # [0di] + stl $6, 0($3) # [1] + bne $16, G13888 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +/* Here for the slow packed version */ +.align 3 +G13866: + addq $19, $17, $17 # [1-] + srl $17, $20, $1 # Convert byte index to word index [1] + addq $1, $22, $1 # Address of word containing byte [2] +/* Memory Read Internal */ +G13890: + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $4 # [1-] + ldl $3, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $4, $31, $22 # [1-] + ldq_u $18, 0($4) # [1di] + subq $1, $2, $2 # Stack cache offset [1-] + ldq $7, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $2, $3, $3 # In range? [1-] + ldl $22, 0($22) # [0di] + extbl $18, $4, $18 # [1-] + bne $3, G13892 # [0di] +G13891: + lda $4, 240 # [1-] + srl $7, $18, $7 # [1] + srl $4, $18, $4 # [1] + extll $22, 0, $22 # [1] + blbs $7, G13894 # [1-] +G13901: +/* Check fixnum element type */ +/* TagType. */ + and $18, 63, $2 # [0di] + subq $2, TypeFixnum, $2 # [1] + bne $2, G13867 # J. if element type not fixnum. [1] + beq $20, G13868 # J. if unpacked fixnum element type. [1] + ornot $31, $31, $8 # [0di] + sll $8, $20, $8 # [1] + subq $31, $20, $2 # [1] + bic $17, $8, $8 # Compute subword index [1] + addq $2, 5, $2 # [1] + sll $8, $2, $2 # Compute shift to get byte [1] + bis $31, 32, $8 # [1] + srl $8, $20, $8 # Compute size of byte [1] + ornot $31, $31, $3 # [1] + sll $3, $8, $3 # [1] + ornot $31, $3, $4 # Compute mask for byte [2] + beq $2, G13902 # inserting into the low byte is easy [1-] +/* Inserting the byte into any byte other than the low byte */ + addq $31, 64, $7 # [0di] + subq $7, $2, $8 # = the left shift rotate amount [1] + srl $22, $2, $7 # shift selected byte into low end of word. [1] + sll $22, $8, $22 # rotate low bits into high end of word. [1] + and $3, $7, $7 # Remove unwanted bits [1] + srl $22, $8, $22 # rotate low bits back into place. [1] + and $6, $4, $8 # Strip any extra bits from element [1] + bis $8, $7, $7 # Insert new bits. [1] + sll $7, $2, $7 # reposition bits [1] + bis $22, $7, $22 # Replace low order bits [2] + br $31, G13903 # [0di] +.align 3 +G13902: +/* Inserting the byte into the low byte */ + and $22, $3, $22 # Remove the old low byte [1-] + and $6, $4, $8 # Remove unwanted bits from the new byte [1] + bis $22, $8, $22 # Insert the new byte in place of the old byte [1] +.align 3 +G13903: + bis $22, $31, $6 # [1] +.align 3 +G13868: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + addq $1, $14, $2 # [0di] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $2, $31, $7 # [0di] + ldq_u $4, 0($2) # [1-] + subq $1, $3, $3 # Stack cache offset [1di] + cmpult $3, $8, $8 # In range? [1] + insbl $18, $2, $3 # [1] + mskbl $4, $2, $4 # [1] +.align 3 +G13905: + bis $4, $3, $4 # [2] + stq_u $4, 0($2) # [0di] + stl $6, 0($7) # [1] + bne $8, G13904 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13867: + bis $31, $1, $20 # [1-] + bis $31, 25, $17 # [1] + br $31, ILLEGALOPERAND # packed array data not in fixnum +#ifdef TRACING + br $31, DoAset1IM # [1-] + .byte 0x82 + .asciiz "DoAset1IM" +#endif +.align 5 +.align 3 +DoAset1IM: # Entry point for IMMEDIATE mode + lda $8, AutoArrayRegMask # [1-] + ldl $19, 0($12) # Get the array tag/data [0di] + ldl $18, 4($12) # Get the array tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + lda $7, PROCESSORSTATE_AC0ARRAY($14) # [1] + and $19, $8, $8 # [1] + addq $7, $8, $7 # This is the address of the array register block. [1] + ldl $6, 0($12) # Get the new value tag/data [1-] + ldl $5, 4($12) # Get the new value tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $6, 0, $6 # [1] + br $31, ASET1MERGE # [1-] +.align 3 +G13904: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] +.align 3 +G13906: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $3, $3 # Stack cache offset [2di] + s8addq $3, $2, $2 # reconstruct SCA [1] + stl $6, 0($2) # Store in stack [2] + stl $18, 4($2) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13892: + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $2, $3, $2 # reconstruct SCA [3] + ldl $22, 0($2) # [2] + ldl $18, 4($2) # Read from stack cache [1] + br $31, G13891 # [1] +.align 3 +G13894: + blbc $4, G13893 # [1] + extll $22, 0, $1 # Do the indirect thing [0di] + br $31, G13890 # [1-] +.align 3 +G13893: + ldq $7, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $18, 63, $4 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $4, $7, $4 # Adjust for a longword load [2di] + ldl $7, 0($4) # Get the memory action [2] +.align 3 +G13898: + and $7, MemoryActionTransform, $4 # [3] + beq $4, G13897 # [1] + bic $18, 63, $18 # [1-] + bis $18, TypeExternalValueCellPointer, $18 # [1] + br $31, G13901 # [1-] +#ifndef MINIMA +G13897: +#endif +#ifdef MINIMA +.align 3 +G13897: + and $7, MemoryActionBinding, $4 # [1-] + ldq $3, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $4, G13896 # [1-] + sll $1, 1, $2 # [0di] + ldq $4, PROCESSORSTATE_DBCBASE($14) # [1-] + and $2, $3, $2 # Hash index [1di] + bis $31, 1, $3 # [1] + sll $3, IvoryMemoryData, $3 # [1] + addl $2, $4, $2 # [1] + extll $2, 0, $2 # Clear sign-extension [1] + s4addq $2, $3, $3 # [2] + ldl $2, 0($3) # Fetch the key [2] + ldl $22, 4($3) # Fetch value [1] + subl $1, $2, $4 # Compare [2di] + bne $4, G13900 # Trap on miss [1] + extll $22, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G13890 # This is another memory read tailcall. [1-] +.align 3 +G13900: + br $31, DBCACHEMISSTRAP +#endif +G13896: +/* Perform memory action */ + bis $31, $7, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G13888: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G13907: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $7, $7 # Stack cache offset [2di] + s8addq $7, $4, $4 # reconstruct SCA [1] + stl $6, 0($4) # Store in stack [2] + stl $2, 4($4) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13879: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $4, $7, $4 # reconstruct SCA [3] + ldl $3, 0($4) # [2] + ldl $2, 4($4) # Read from stack cache [1] + br $31, G13878 # [1] +.align 3 +G13881: + blbc $8, G13880 # [1] + extll $3, 0, $1 # Do the indirect thing [0di] + br $31, G13877 # [1-] +.align 3 +G13880: + ldq $16, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $8 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $16, $8 # Adjust for a longword load [2di] + ldl $16, 0($8) # Get the memory action [2] +#ifndef MINIMA +G13884: +#endif +#ifdef MINIMA +.align 3 +G13884: + and $16, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G13883 # [1-] + sll $1, 1, $4 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $4, $7, $4 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $4, $8, $4 # [1] + extll $4, 0, $4 # Clear sign-extension [1] + s4addq $4, $7, $7 # [2] + ldl $4, 0($7) # Fetch the key [2] + ldl $3, 4($7) # Fetch value [1] + subl $1, $4, $8 # Compare [2di] + bne $8, G13886 # Trap on miss [1] + extll $3, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G13877 # This is another memory read tailcall. [1-] +.align 3 +G13886: + br $31, DBCACHEMISSTRAP +#endif +G13883: +/* Perform memory action */ + bis $31, $16, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoAset1 +/* End of Halfword operand from stack instruction - DoAset1 */ +.align 5 +.globl DoFastAref1 +.ent DoFastAref1 0 +/* Halfword operand from stack instruction - DoFastAref1 */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoFastAref1FP + .globl DoFastAref1SP + .globl DoFastAref1LP + .globl DoFastAref1IM +.align 3 +DoFastAref1: +#ifdef TRACING + .byte 0x88 + .asciiz "DoFastAref1SP" +#endif +.align 3 +DoFastAref1SP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + bne $17, beginDoFastAref1 # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoFastAref1 # [0di] + .byte 0x90 + .asciiz "DoFastAref1LP" +#endif +.align 3 +DoFastAref1LP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoFastAref1 # [1] + .byte 0x84 + .asciiz "DoFastAref1FP" +#endif +.align 3 +DoFastAref1FP: # Entry point for FP relative +.align 3 +beginDoFastAref1: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + extll $21, 4, $18 # [1] + addl $21, $31, $19 # [1] + subq $18, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, FASTAREF1IOP # [1] +.align 3 +FASTAREF1RETRY: + ldl $21, 0($16) # [1-] + ldl $22, 8($16) # [1] + ldl $3, 16($16) # [1] + extll $21, 0, $21 # [1di] + extll $22, 0, $22 # [1] + sll $21, 42, $5 # [1] + extll $3, 0, $3 # [1] + ldq $4, PROCESSORSTATE_AREVENTCOUNT($14) # [0di] + srl $5, 42, $5 # [1-] + cmpult $19, $3, $2 # [1] + beq $2, FASTAREF1BOUNDS # [1] + subq $4, $5, $6 # [0di] + bne $6, Aref1RecomputeArrayRegister # [1] + srl $21, ArrayRegisterBytePackingPos, $6 # [1] + srl $21, ArrayRegisterByteOffsetPos, $7 # [1] + srl $21, ArrayRegisterElementTypePos, $8 # [1] + and $6, ArrayRegisterBytePackingMask, $6 # [1] + and $7, ArrayRegisterByteOffsetMask, $7 # [1] + and $8, ArrayRegisterElementTypeMask, $8 # [1] + bne $6, G13908 # [0di] + addq $22, $19, $1 # [1-] +.align 3 +G13909: +/* Memory Read Internal */ +G13916: + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $1, $14, $4 # [0di] + ldl $3, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $4, $31, $22 # [0di] + ldq_u $20, 0($4) # [1-] + subq $1, $2, $2 # Stack cache offset [1di] + ldq $5, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $2, $3, $3 # In range? [0di] + ldl $22, 0($22) # [1-] + extbl $20, $4, $20 # [0di] + bne $3, G13918 # [1-] +G13917: + lda $4, 240 # [0di] + srl $5, $20, $5 # [1] + srl $4, $20, $4 # [1] + extll $22, 0, $22 # [1] + blbs $5, G13920 # [0di] +G13927: + bne $6, G13910 # [1] +.align 3 +G13911: + bis $31, $31, $31 # [0] + subq $8, 2, $1 # [1] + ble $1, G13912 # [1] +/* TagType. */ + and $20, 63, $20 # [0di] +.align 3 +G13913: + stl $20, 4($12) # [1-] + cmpeq $6, 0, $4 # [0di] + beq $4, CASE_OTHERS_14 # [1] +.align 3 +CASE_0_8: + bis $31, $31, $31 # [0] + beq $1, G13914 # [0di] + stl $22, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_2_9: +/* AREF1-8B */ + bis $31, $31, $31 # [0] + and $19, 3, $4 # [1] + extbl $22, $4, $5 # [1] + beq $1, G13914 # [0di] + stl $5, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_3_10: +/* AREF1-4B */ + bis $31, $31, $31 # [0] + and $19, 7, $4 # byte-index [1] + sll $4, 2, $4 # byte-position [1] + srl $22, $4, $5 # byte in position [2] + and $5, 15, $5 # byte masked [2] + beq $1, G13914 # [0di] + stl $5, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_5_11: +/* AREF1-1B */ + bis $31, $31, $31 # [0] + and $19, 31, $4 # byte-index [1] + bis $31, $31, $31 # [0] + srl $22, $4, $5 # byte in position [1] + and $5, 1, $5 # byte masked [2] + beq $1, G13914 # [0di] + stl $5, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_1_12: +/* AREF1-16B */ + and $19, 1, $4 # [1-] + addq $4, $4, $4 # Bletch, it's a byte ref [1] + extwl $22, $4, $5 # [1] + beq $1, G13914 # [0di] + stl $5, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CASE_OTHERS_14: + bis $31, $31, $31 # [0] + cmpeq $6, 2, $4 # [1] + cmpeq $6, 3, $5 # [1] + bne $4, CASE_2_9 # [0di] + cmpeq $6, 5, $4 # [1] + bne $5, CASE_3_10 # [0di] + cmpeq $6, 1, $5 # [1] + bne $4, CASE_5_11 # [0di] + bne $5, CASE_1_12 # [1] +.align 3 +CASE_4_13: +/* AREF1-2B */ + bis $31, $31, $31 # [0] + and $19, 15, $4 # byte-index [1] + sll $4, 1, $4 # byte-position [1] + srl $22, $4, $5 # byte in position [2] + and $5, 3, $5 # byte masked [2] + beq $1, G13914 # [0di] + stl $5, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13908: + addq $7, $19, $19 # [1-] + srl $19, $6, $1 # Convert byte index to word index [1] + addq $1, $22, $1 # Address of word containing byte [2] + br $31, G13909 # [0di] +.align 3 +G13910: + subq $20, TypeFixnum, $1 # [1-] + and $1, 63, $1 # Strip CDR code [1] + bne $1, G13915 # [1] + br $31, G13911 # [1] +.align 3 +G13912: + bis $31, TypeCharacter, $20 # [1-] + blbs $8, G13913 # [0di] + bis $31, TypeFixnum, $20 # [1-] + beq $8, G13913 # [0di] + ldq $2, PROCESSORSTATE_NILADDRESS($14) # [1-] + ldq $3, PROCESSORSTATE_TADDRESS($14) # [1] + br $31, G13913 # [1] +.align 3 +G13914: + cmovne $5, $3, $2 # [2-] + stq $2, 0($12) # [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13915: + bis $31, $1, $20 # [1-] + bis $31, 25, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +FASTAREF1IOP: + bis $31, 0, $20 # [1] + bis $31, 32, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +FASTAREF1BOUNDS: + bis $31, 0, $20 # [1] + bis $31, 13, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G13918: + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $2, $3, $2 # reconstruct SCA [3] + ldl $22, 0($2) # [2] + ldl $20, 4($2) # Read from stack cache [1] + br $31, G13917 # [1] +.align 3 +G13920: + blbc $4, G13919 # [1] + extll $22, 0, $1 # Do the indirect thing [0di] + br $31, G13916 # [1-] +.align 3 +G13919: + ldq $5, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $4 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $4, $5, $4 # Adjust for a longword load [2di] + ldl $5, 0($4) # Get the memory action [2] +.align 3 +G13924: + and $5, MemoryActionTransform, $4 # [3] + beq $4, G13923 # [1] + bic $20, 63, $20 # [1-] + bis $20, TypeExternalValueCellPointer, $20 # [1] + br $31, G13927 # [1-] +#ifndef MINIMA +G13923: +#endif +#ifdef MINIMA +.align 3 +G13923: + and $5, MemoryActionBinding, $4 # [1-] + ldq $3, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $4, G13922 # [1-] + sll $1, 1, $2 # [0di] + ldq $4, PROCESSORSTATE_DBCBASE($14) # [1-] + and $2, $3, $2 # Hash index [1di] + bis $31, 1, $3 # [1] + sll $3, IvoryMemoryData, $3 # [1] + addl $2, $4, $2 # [1] + extll $2, 0, $2 # Clear sign-extension [1] + s4addq $2, $3, $3 # [2] + ldl $2, 0($3) # Fetch the key [2] + ldl $22, 4($3) # Fetch value [1] + subl $1, $2, $4 # Compare [2di] + bne $4, G13926 # Trap on miss [1] + extll $22, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G13916 # This is another memory read tailcall. [1-] +.align 3 +G13926: + br $31, DBCACHEMISSTRAP +#endif +G13922: +/* Perform memory action */ + bis $31, $5, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoFastAref1IM" +#endif +DoFastAref1IM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoFastAref1. +.end DoFastAref1 +/* End of Halfword operand from stack instruction - DoFastAref1 */ +.align 5 +.globl DoRplaca +.ent DoRplaca 0 +/* Halfword operand from stack instruction - DoRplaca */ + .globl DoRplacaFP + .globl DoRplacaSP + .globl DoRplacaLP + .globl DoRplacaIM +.align 3 +DoRplaca: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoRplacaIM" +#endif +.align 3 +DoRplacaIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G13941: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoRplaca # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoRplacaSP" +#endif +.align 3 +DoRplacaSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, headDoRplaca # [0di] + bis $21, $31, $16 # SP-pop mode, TOS->arg1 [1-] + ldq $21, 0($19) # Reload TOS [1] + bis $19, $31, $12 # Adjust SP [1-] + br $31, beginDoRplaca # [0di] +#ifdef TRACING + br $31, headDoRplaca # [1] + .byte 0x90 + .asciiz "DoRplacaLP" +#endif +.align 3 +DoRplacaLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoRplaca # [1] + .byte 0x84 + .asciiz "DoRplacaFP" +#endif +.align 3 +DoRplacaFP: # Entry point for FP relative +.align 3 +headDoRplaca: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoRplaca: +/* arg1 has the operand, sign extended if immediate. */ + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $21, 4, $1 # [1-] + extll $21, 0, $17 # Read ARG1, the list [1] + subq $12, 8, $12 # Pop Stack. [1] +/* TagType. */ + and $1, 63, $3 # [1] + subq $3, TypeList, $4 # [1] + bic $4, 4, $4 # [1] + bne $4, RPLACAEXCEPTION # [1] +.align 3 +RplacStore: + srl $16, 32, $2 # Tag for t2 [1-] + extll $16, 0, $16 # data for t2 [1] +/* Memory Read Internal */ +G13928: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAWRITE_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13930 # [1-] +G13929: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13932 # [1-] +G13938: +/* Merge cdr-code */ + and $2, 63, $21 # [0di] + and $20, 192, $20 # [1] + bis $20, $21, $20 # [1] + addq $17, $14, $5 # [1] + s4addq $5, $31, $21 # [1] + ldq_u $7, 0($5) # [1-] + subq $17, $24, $6 # Stack cache offset [0di] + cmpult $6, $25, $8 # In range? [1] + insbl $20, $5, $6 # [1] + mskbl $7, $5, $7 # [1] +.align 3 +G13940: + bis $7, $6, $7 # [2] + stq_u $7, 0($5) # [0di] + stl $16, 0($21) # [1] + bne $8, G13939 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13939: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $17, $24, $6 # Stack cache offset [0di] + s8addq $6, $5, $5 # reconstruct SCA [3] + stl $16, 0($5) # Store in stack [2] + stl $20, 4($5) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G13930: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $21, 0($5) # [2] + ldl $20, 4($5) # Read from stack cache [1] + br $31, G13929 # [1] +.align 3 +G13932: + blbc $7, G13931 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13928 # [1-] +.align 3 +G13931: + ldq $8, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $7 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +#ifndef MINIMA +G13935: +#endif +#ifdef MINIMA +.align 3 +G13935: + and $8, MemoryActionBinding, $7 # [3] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G13934 # [1-] + sll $17, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $21, 4($6) # Fetch value [1] + subl $17, $5, $7 # Compare [2di] + bne $7, G13937 # Trap on miss [1] + extll $21, 0, $17 # Extract the pointer, and indirect [0di] + br $31, G13928 # This is another memory read tailcall. [1-] +.align 3 +G13937: + br $31, DBCACHEMISSTRAP +#endif +G13934: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoRplaca +/* End of Halfword operand from stack instruction - DoRplaca */ +.align 5 +.globl MemoryReadWrite +.ent MemoryReadWrite 0 +.align 3 +MemoryReadWrite: + .frame $30, 0, $0 +/* Memory Read Internal */ +G13942: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAWRITE_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13944 # [1-] +G13943: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G13946 # [0di] +G13951: + ret $31, ($0), 1 # [1] +.align 3 +MemoryReadWriteDECODE: + beq $6, G13945 # [1] +.align 3 +G13944: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $21, 0($5) # [2] + ldl $20, 4($5) # Read from stack cache [1] + br $31, G13943 # [1] +.align 3 +G13946: + blbc $7, G13945 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13942 # [1-] +.align 3 +G13945: + ldq $8, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $7 # Discard the CDR code [0di] + stq $17, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +#ifndef MINIMA +G13948: +#endif +#ifdef MINIMA +.align 3 +G13948: + and $8, MemoryActionBinding, $7 # [3] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G13947 # [1-] + sll $17, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $21, 4($6) # Fetch value [1] + subl $17, $5, $7 # Compare [2di] + bne $7, G13950 # Trap on miss [1] + extll $21, 0, $17 # Extract the pointer, and indirect [0di] + br $31, G13942 # This is another memory read tailcall. [1-] +.align 3 +G13950: + br $31, DBCACHEMISSTRAP +#endif +G13947: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end MemoryReadWrite +.align 5 +.globl DoRplacd +.ent DoRplacd 0 +/* Halfword operand from stack instruction - DoRplacd */ + .globl DoRplacdFP + .globl DoRplacdSP + .globl DoRplacdLP + .globl DoRplacdIM +.align 3 +DoRplacd: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoRplacdIM" +#endif +.align 3 +DoRplacdIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G13962: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoRplacd # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoRplacdSP" +#endif +.align 3 +DoRplacdSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, headDoRplacd # [0di] + bis $21, $31, $16 # SP-pop mode, TOS->arg1 [1-] + ldq $21, 0($19) # Reload TOS [1] + bis $19, $31, $12 # Adjust SP [1-] + br $31, beginDoRplacd # [0di] +#ifdef TRACING + br $31, headDoRplacd # [1] + .byte 0x90 + .asciiz "DoRplacdLP" +#endif +.align 3 +DoRplacdLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoRplacd # [1] + .byte 0x84 + .asciiz "DoRplacdFP" +#endif +.align 3 +DoRplacdFP: # Entry point for FP relative +.align 3 +headDoRplacd: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoRplacd: +/* arg1 has the operand, sign extended if immediate. */ + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $21, 4, $1 # [1-] + extll $21, 0, $17 # Read ARG1, the list [1] + subq $12, 8, $12 # Pop Stack. [1] +/* TagType. */ + and $1, 63, $3 # [1] + subq $3, TypeLocative, $4 # [1] + beq $4, RplacStore # [1] + subq $3, TypeList, $4 # [1] + bne $4, RPLACDEXCEPTION # [1] +/* Memory Read Internal */ +G13952: + addq $17, $14, $7 # [1-] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_CDR_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G13954 # [1-] +G13953: + lda $7, 192 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G13956 # [1-] +G13961: +/* TagCdr. */ + srl $20, 6, $20 # [0di] + subq $20, CdrNormal, $20 # [2] + bne $20, RPLACDEXCEPTION # J. if CDR coded [1] + addq $17, 1, $17 # address of CDR [1-] + br $31, RplacStore # [0di] +.align 3 +G13956: + blbc $7, G13955 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G13952 # [1-] +.align 3 +G13955: +.align 3 +G13954: + bsr $0, MemoryReadCdrDECODE + br $31, G13961 # [1] +.end DoRplacd +/* End of Halfword operand from stack instruction - DoRplacd */ +.align 5 +.globl DoBranchTrueAndExtraPop +.ent DoBranchTrueAndExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchTrueAndExtraPop */ + .globl DoBranchTrueAndExtraPopFP + .globl DoBranchTrueAndExtraPopSP + .globl DoBranchTrueAndExtraPopLP + .globl DoBranchTrueAndExtraPopIM +.align 3 +DoBranchTrueAndExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrueAndExtraPop" +#endif +.align 3 +DoBranchTrueAndExtraPopIM: +.align 3 +DoBranchTrueAndExtraPopSP: +.align 3 +DoBranchTrueAndExtraPopLP: +.align 3 +DoBranchTrueAndExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, DoBrPopExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrPopExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 16, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrueAndExtraPop +/* End of Halfword operand from stack instruction - DoBranchTrueAndExtraPop */ +.align 5 +.globl DoBranchFalseAndExtraPop +.ent DoBranchFalseAndExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchFalseAndExtraPop */ + .globl DoBranchFalseAndExtraPopFP + .globl DoBranchFalseAndExtraPopSP + .globl DoBranchFalseAndExtraPopLP + .globl DoBranchFalseAndExtraPopIM +.align 3 +DoBranchFalseAndExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalseAndExtraPop" +#endif +.align 3 +DoBranchFalseAndExtraPopIM: +.align 3 +DoBranchFalseAndExtraPopSP: +.align 3 +DoBranchFalseAndExtraPopLP: +.align 3 +DoBranchFalseAndExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, DoBrnPopExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrnPopExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 16, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalseAndExtraPop +/* End of Halfword operand from stack instruction - DoBranchFalseAndExtraPop */ +.align 5 +.globl DoBranchTrueAndNoPop +.ent DoBranchTrueAndNoPop 0 +/* Halfword 10 bit immediate instruction - DoBranchTrueAndNoPop */ + .globl DoBranchTrueAndNoPopFP + .globl DoBranchTrueAndNoPopSP + .globl DoBranchTrueAndNoPopLP + .globl DoBranchTrueAndNoPopIM +.align 3 +DoBranchTrueAndNoPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrueAndNoPop" +#endif +.align 3 +DoBranchTrueAndNoPopIM: +.align 3 +DoBranchTrueAndNoPopSP: +.align 3 +DoBranchTrueAndNoPopLP: +.align 3 +DoBranchTrueAndNoPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, DoBrElsePop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrElsePop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + addq $9, $16, $9 # Update the PC in halfwords [0di] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [1-] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrueAndNoPop +/* End of Halfword operand from stack instruction - DoBranchTrueAndNoPop */ +.align 5 +.globl DoBranchFalseAndNoPop +.ent DoBranchFalseAndNoPop 0 +/* Halfword 10 bit immediate instruction - DoBranchFalseAndNoPop */ + .globl DoBranchFalseAndNoPopFP + .globl DoBranchFalseAndNoPopSP + .globl DoBranchFalseAndNoPopLP + .globl DoBranchFalseAndNoPopIM +.align 3 +DoBranchFalseAndNoPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalseAndNoPop" +#endif +.align 3 +DoBranchFalseAndNoPopIM: +.align 3 +DoBranchFalseAndNoPopSP: +.align 3 +DoBranchFalseAndNoPopLP: +.align 3 +DoBranchFalseAndNoPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, DoBrnElsePop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrnElsePop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + addq $9, $16, $9 # Update the PC in halfwords [0di] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [1-] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalseAndNoPop +/* End of Halfword operand from stack instruction - DoBranchFalseAndNoPop */ +.align 5 +.globl DoBranchFalseElseNoPop +.ent DoBranchFalseElseNoPop 0 +/* Halfword 10 bit immediate instruction - DoBranchFalseElseNoPop */ + .globl DoBranchFalseElseNoPopFP + .globl DoBranchFalseElseNoPopSP + .globl DoBranchFalseElseNoPopLP + .globl DoBranchFalseElseNoPopIM +.align 3 +DoBranchFalseElseNoPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalseElseNoPop" +#endif +.align 3 +DoBranchFalseElseNoPopIM: +.align 3 +DoBranchFalseElseNoPopSP: +.align 3 +DoBranchFalseElseNoPopLP: +.align 3 +DoBranchFalseElseNoPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, NEXTINSTRUCTION # [1] + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalseElseNoPop +/* End of Halfword operand from stack instruction - DoBranchFalseElseNoPop */ +.align 5 +.globl DoEqualNumber +.ent DoEqualNumber 0 +/* Halfword operand from stack instruction - DoEqualNumber */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoEqualNumberFP + .globl DoEqualNumberSP + .globl DoEqualNumberLP + .globl DoEqualNumberIM +.align 3 +DoEqualNumber: +#ifdef TRACING + .byte 0x88 + .asciiz "DoEqualNumberSP" +#endif +.align 3 +DoEqualNumberSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoEqualNumber # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoEqualNumber # [0di] + .byte 0x90 + .asciiz "DoEqualNumberLP" +#endif +.align 3 +DoEqualNumberLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoEqualNumber # [1] + .byte 0x84 + .asciiz "DoEqualNumberFP" +#endif +.align 3 +DoEqualNumberFP: # Entry point for FP relative +.align 3 +beginDoEqualNumber: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + srl $18, 12, $7 # [1-] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [0di] + extll $21, 4, $18 # Get ARG1 tag [1-] + ldl $1, 4($16) # t1 is tag of arg2 [0di] + lds $f1, 0($12) # [1] + and $7, 1, $7 # [0di] + ldl $17, 0($16) # [1-] + addl $21, $31, $19 # [0di] + lds $f2, 0($16) # [1-] + and $18, 63, $5 # Strip off any CDR code bits. [0di] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $5, TypeFixnum, $6 # [1] +.align 3 +G13980: + beq $6, G13968 # [1] +/* Here if argument TypeFixnum */ + cmpeq $4, TypeFixnum, $3 # [0di] +.align 3 +G13972: + beq $3, G13963 # [1] +/* Here if argument TypeFixnum */ + subl $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # Pop/No-pop [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmoveq $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G13969: +.align 3 +G13968: + cmpeq $5, TypeSingleFloat, $6 # [1-] +.align 3 +G13981: + beq $6, G13973 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $4, TypeSingleFloat, $3 # [0di] +.align 3 +G13977: + beq $3, G13963 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +EqualNumberMMExcFLTFLT: + cmpteq $f1, $f2, $f3 # [1] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + s8addq $7, $12, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + stq $25, 0($12) # [1] + fbne $f3, CACHEVALID # [3-] + stq $24, 0($12) # Didn't branch, answer is NIL [0di] + br $31, CACHEVALID # [1] +.align 3 +G13974: +.align 3 +G13973: +/* Here for all other cases */ +.align 3 +G13963: + br $31, EqualNumberMMExc # [1] +.align 3 +G13967: +#ifdef TRACING + br $31, DoEqualNumberIM # [1] + .byte 0x82 + .asciiz "DoEqualNumberIM" +#endif +.align 5 +.align 3 +DoEqualNumberIM: # Entry point for IMMEDIATE mode + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1] + sll $17, 56, $17 # First half of sign extension [0di] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1-] + srl $18, 12, $7 # [0di] + extll $21, 4, $18 # [1] + addl $21, $31, $19 # [1] + sra $17, 56, $17 # Second half of sign extension [1] + and $7, 1, $7 # [1] + and $18, 63, $3 # Strip off any CDR code bits. [1] + cmpeq $3, TypeFixnum, $4 # [1] +.align 3 +G13986: + beq $4, G13983 # [1] +/* Here if argument TypeFixnum */ + subl $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmoveq $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G13983: +/* Here for all other cases */ + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G13982: +.end DoEqualNumber +/* End of Halfword operand from stack instruction - DoEqualNumber */ +.align 5 +.globl DoSetToCdrPushCar +.ent DoSetToCdrPushCar 0 +/* Halfword operand from stack instruction - DoSetToCdrPushCar */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetToCdrPushCarFP + .globl DoSetToCdrPushCarSP + .globl DoSetToCdrPushCarLP + .globl DoSetToCdrPushCarIM +.align 3 +DoSetToCdrPushCar: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetToCdrPushCarSP" +#endif +.align 3 +DoSetToCdrPushCarSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoSetToCdrPushCar # [0di] + .byte 0x90 + .asciiz "DoSetToCdrPushCarLP" +#endif +.align 3 +DoSetToCdrPushCarLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetToCdrPushCar # [1] + .byte 0x84 + .asciiz "DoSetToCdrPushCarFP" +#endif +.align 3 +DoSetToCdrPushCarFP: # Entry point for FP relative +.align 3 +beginDoSetToCdrPushCar: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $2, 0($16) # Get the operand from the stack. [1] + ldl $1, 4($16) # [1] + extll $2, 0, $2 # [2di] + and $1, 192, $3 # Save the old CDR code [1] + subq $1, TypeLocative, $5 # [1] + and $5, 63, $5 # Strip CDR code [1] + beq $5, SETTOCDRPUSHCARLOCATIVE # [1] + bsr $0, CarCdrInternal +/* TagType. */ + and $20, 63, $20 # [1-] + bis $20, $3, $20 # Put back the original CDR codes [1] + stl $21, 0($16) # [1-] + stl $20, 4($16) # write the stack cache [1] + and $1, 63, $5 # set CDR-NEXT [1-] + stl $2, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +#ifdef TRACING + .byte 0x82 + .asciiz "DoSetToCdrPushCarIM" +#endif +DoSetToCdrPushCarIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoSetToCdrPushCar. +.end DoSetToCdrPushCar +/* End of Halfword operand from stack instruction - DoSetToCdrPushCar */ +.align 5 +.globl DoSub +.ent DoSub 0 +/* Halfword operand from stack instruction - DoSub */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSubFP + .globl DoSubSP + .globl DoSubLP + .globl DoSubIM +.align 3 +DoSub: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSubSP" +#endif +.align 3 +DoSubSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoSub # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoSub # [0di] + .byte 0x90 + .asciiz "DoSubLP" +#endif +.align 3 +DoSubLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSub # [1] + .byte 0x84 + .asciiz "DoSubFP" +#endif +.align 3 +DoSubFP: # Entry point for FP relative +.align 3 +beginDoSub: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lds $f1, 0($12) # [0di] + extll $21, 4, $1 # ARG1 tag [1-] + ldl $3, 4($16) # ARG2 tag [1di] + addl $21, $31, $2 # ARG1 data [1-] + ldl $4, 0($16) # ARG2 data [0di] + lds $f2, 0($16) # [1] + and $1, 63, $22 # Strip off any CDR code bits. [0di] + and $3, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $22, TypeFixnum, $23 # [1] +.align 3 +G14026: + beq $23, G13997 # [1] +/* Here if argument TypeFixnum */ + cmpeq $24, TypeFixnum, $25 # [0di] +.align 3 +G14003: + beq $25, G13999 # [1] +/* Here if argument TypeFixnum */ + ldq $6, CACHELINE_NEXTPCDATA($13) # [0di] + sublv $2, $4, $5 # compute 64-bit result [1-] + ldq $7, CACHELINE_NEXTCP($13) # [0di] + trapb # Force the trap to occur here [3] + stl $22, 4($12) # Semi-cheat, we know temp2 has CDRNext/TypeFixnum [1] + bis $6, $31, $9 # [1-] + stl $5, 0($12) # [0di] + bis $7, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G13999: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14004: + beq $25, G14000 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqt $f1, $f1 # [6] + br $31, G13987 # [1] +.align 3 +G14000: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G14005: + beq $25, G13994 # [1] +/* Here if argument TypeDoubleFloat */ + cvtlq $f1, $f1 # [3] + cvtqt $f1, $f1 # [6] + br $31, G13990 # [1] +.align 3 +G13998: +.align 3 +G13997: + cmpeq $22, TypeSingleFloat, $23 # [1-] +.align 3 +G14027: + beq $23, G14006 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $24, TypeSingleFloat, $25 # [0di] +.align 3 +G14012: + beq $25, G14008 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G13987: + subs $f1, $f2, $f0 # [2] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeSingleFloat, $8 # [1-] + stl $8, 4($12) # write the stack cache [0di] + sts $f0, 0($12) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14008: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G14013: + beq $25, G14009 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqt $f2, $f2 # [6] + br $31, G13987 # [1] +.align 3 +G14009: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G14014: + beq $25, G13994 # [1] +/* Here if argument TypeDoubleFloat */ +.align 3 +G13990: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + br $31, G13991 # [1] +.align 3 +G14007: +.align 3 +G14006: + cmpeq $22, TypeDoubleFloat, $23 # [1-] +.align 3 +G14028: + beq $23, G14015 # [1] +/* Here if argument TypeDoubleFloat */ + cmpeq $24, TypeDoubleFloat, $25 # [0di] +.align 3 +G14021: + beq $25, G14017 # [1] +/* Here if argument TypeDoubleFloat */ + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [0di] + bsr $0, FetchDoubleFloat + ldt $f1, PROCESSORSTATE_FP0($14) # [1-] +.align 3 +G13991: + extll $4, 0, $17 # [1-] + bsr $0, FetchDoubleFloat + ldt $f2, PROCESSORSTATE_FP0($14) # [0di] +.align 3 +G13988: + subt $f1, $f2, $f0 # [3] + stt $f0, PROCESSORSTATE_FP0($14) # [0di] + bsr $0, ConsDoubleFloat + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeDoubleFloat, $8 # [1-] + stl $17, 0($12) # [0di] + stl $8, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G14017: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14022: + beq $25, G14018 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G13989: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [1-] + bsr $0, FetchDoubleFloat + ldt $f1, PROCESSORSTATE_FP0($14) # [0di] + br $31, G13988 # [1] +.align 3 +G14018: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G14023: + beq $25, G13994 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqt $f2, $f2 # [6] + br $31, G13989 # [1] +.align 3 +G14016: +.align 3 +G14015: +/* Here for all other cases */ +.align 3 +G13993: +.align 3 +DOSUBOVFL: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G13995 # [1-] +.align 3 +G13994: + bis $3, $31, $1 # [1-] + br $31, DOSUBOVFL # [0di] +.align 3 +G13995: +.align 3 +G13996: +#ifdef TRACING + br $31, DoSubIM # [1] + .byte 0x82 + .asciiz "DoSubIM" +#endif +.align 5 +.align 3 +DoSubIM: # Entry point for IMMEDIATE mode + extll $21, 4, $1 # [1-] + addl $21, $31, $2 # get ARG1 tag/data [1] + and $1, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $24, TypeFixnum, $25 # [1] +.align 3 +G14033: + beq $25, G14030 # [1] +/* Here if argument TypeFixnum */ + subq $2, $17, $3 # compute 64-bit result [0di] + ldq $4, CACHELINE_NEXTPCDATA($13) # [1-] + addl $3, $31, $23 # compute 32-bit sign-extended result [0di] + ldq $5, CACHELINE_NEXTCP($13) # [1-] + cmpeq $3, $23, $23 # is it the same as the 64-bit result? [0di] + beq $23, DOSUBOVFL # if not, we overflowed [1] + stl $24, 4($12) # Semi-cheat, we know temp2 has CDRNext/TypeFixnum [1] + bis $4, $31, $9 # [1-] + stl $3, 0($12) # [0di] + bis $5, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G14030: +/* Here for all other cases */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + bis $31, $31, $17 # [1] + br $31, beginDoSub # [0di] +.align 3 +G14029: +.end DoSub +/* End of Halfword operand from stack instruction - DoSub */ +.align 5 +.globl DoTag +.ent DoTag 0 +/* Halfword operand from stack instruction - DoTag */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoTagFP + .globl DoTagSP + .globl DoTagLP + .globl DoTagIM +.align 3 +DoTag: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x82 + .asciiz "DoTagIM" +#endif +.align 3 +DoTagIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + bis $31, $31, $17 # [1] + br $31, beginDoTag # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoTagSP" +#endif +.align 3 +DoTagSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoTag # [0di] + .byte 0x90 + .asciiz "DoTagLP" +#endif +.align 3 +DoTagLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoTag # [1] + .byte 0x84 + .asciiz "DoTagFP" +#endif +.align 3 +DoTagFP: # Entry point for FP relative +.align 3 +beginDoTag: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldl $16, 4($16) # Get the tag of the operand [2] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $3 # [1-] + stl $3, 12($12) # write the stack cache [0di] + stl $16, 8($12) # [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.end DoTag +/* End of Halfword operand from stack instruction - DoTag */ +.align 5 +.globl DoEndp +.ent DoEndp 0 +/* Halfword operand from stack instruction - DoEndp */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoEndpFP + .globl DoEndpSP + .globl DoEndpLP + .globl DoEndpIM +.align 3 +DoEndp: +#ifdef TRACING + .byte 0x88 + .asciiz "DoEndpSP" +#endif +.align 3 +DoEndpSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoEndp # [0di] + .byte 0x90 + .asciiz "DoEndpLP" +#endif +.align 3 +DoEndpLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoEndp # [1] + .byte 0x84 + .asciiz "DoEndpFP" +#endif +.align 3 +DoEndpFP: # Entry point for FP relative +.align 3 +beginDoEndp: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $1, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldl $17, 4($16) # Get tag. [2] + ldq $2, PROCESSORSTATE_TADDRESS($14) # [1] +/* TagType. */ + and $17, 63, $17 # [2-] + subq $17, TypeNIL, $6 # Compare [1] + bne $6, ENDPNOTNIL # [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stq $2, 8($12) # [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +ENDPNIL: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stq $1, 8($12) # [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +ENDPNOTNIL: + subq $6, 1, $6 # Now check for list [1-] + beq $6, ENDPNIL # [1] + subq $17, TypeListInstance, $6 # [1] + beq $6, ENDPNIL # [1] +#ifdef TRACING + br $31, DoEndpIM # [1] + .byte 0x82 + .asciiz "DoEndpIM" +#endif +.align 5 +.align 3 +DoEndpIM: # Entry point for IMMEDIATE mode + bis $31, 0, $20 # [1-] + bis $31, 64, $17 # [1] + br $31, ILLEGALOPERAND +.end DoEndp +/* End of Halfword operand from stack instruction - DoEndp */ +.align 5 +.globl DoMinusp +.ent DoMinusp 0 +/* Halfword operand from stack instruction - DoMinusp */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMinuspFP + .globl DoMinuspSP + .globl DoMinuspLP + .globl DoMinuspIM +.align 3 +DoMinusp: +#ifdef TRACING + .byte 0x88 + .asciiz "DoMinuspSP" +#endif +.align 3 +DoMinuspSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoMinusp # [0di] + .byte 0x90 + .asciiz "DoMinuspLP" +#endif +.align 3 +DoMinuspLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMinusp # [1] + .byte 0x84 + .asciiz "DoMinuspFP" +#endif +.align 3 +DoMinuspFP: # Entry point for FP relative +.align 3 +beginDoMinusp: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldq $6, CACHELINE_NEXTPCDATA($13) # [1] + ldl $1, 4($16) # [1] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1] + ldl $2, 0($16) # [1] + lds $f1, 0($16) # [1] + and $1, 63, $4 # Strip off any CDR code bits. [0di] + cmpeq $4, TypeFixnum, $5 # [1] +.align 3 +G14039: + beq $5, G14035 # [1] +/* Here if argument TypeFixnum */ + bis $6, $31, $9 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovlt $2, $25, $24 # T if predicate succeeds [0di] + stq $24, 8($12) # [1-] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +G14035: + cmpeq $4, TypeSingleFloat, $5 # [1-] +.align 3 +G14040: + beq $5, G14036 # [1] +/* Here if argument TypeSingleFloat */ + bis $6, $31, $9 # [0di] + stq $25, 8($12) # [1-] + addq $12, 8, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + fblt $f1, CACHEVALID # [0di] + stq $24, 0($12) # Didn't branch, answer is NIL [1-] + br $31, CACHEVALID # [1] +.align 3 +G14036: +/* Here for all other cases */ + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, UNARYNUMERICEXCEPTION +.align 3 +G14034: +#ifdef TRACING + br $31, DoMinuspIM # [1-] + .byte 0x82 + .asciiz "DoMinuspIM" +#endif +.align 5 +.align 3 +DoMinuspIM: # Entry point for IMMEDIATE mode + ldq $1, PROCESSORSTATE_NILADDRESS($14) # [1] + sll $17, 56, $17 # Turned into a signed number [0di] + ldq $2, PROCESSORSTATE_TADDRESS($14) # [1-] + addq $12, 8, $12 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + cmovlt $17, $2, $1 # stall 2 then di [1-] + stq $1, 0($12) # yes Virginia, we dual issue with above yahoo [0di] + br $31, CACHEVALID # [1] +.end DoMinusp +/* End of Halfword operand from stack instruction - DoMinusp */ +.align 5 +.globl DoPlusp +.ent DoPlusp 0 +/* Halfword operand from stack instruction - DoPlusp */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPluspFP + .globl DoPluspSP + .globl DoPluspLP + .globl DoPluspIM +.align 3 +DoPlusp: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPluspSP" +#endif +.align 3 +DoPluspSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoPlusp # [0di] + .byte 0x90 + .asciiz "DoPluspLP" +#endif +.align 3 +DoPluspLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPlusp # [1] + .byte 0x84 + .asciiz "DoPluspFP" +#endif +.align 3 +DoPluspFP: # Entry point for FP relative +.align 3 +beginDoPlusp: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldq $6, CACHELINE_NEXTPCDATA($13) # [1] + ldl $1, 4($16) # [1] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1] + ldl $2, 0($16) # [1] + lds $f1, 0($16) # [1] + and $1, 63, $4 # Strip off any CDR code bits. [0di] + cmpeq $4, TypeFixnum, $5 # [1] +.align 3 +G14046: + beq $5, G14042 # [1] +/* Here if argument TypeFixnum */ + bis $6, $31, $9 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovgt $2, $25, $24 # T if predicate succeeds [0di] + stq $24, 8($12) # [1-] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +G14042: + cmpeq $4, TypeSingleFloat, $5 # [1-] +.align 3 +G14047: + beq $5, G14043 # [1] +/* Here if argument TypeSingleFloat */ + bis $6, $31, $9 # [0di] + stq $25, 8($12) # [1-] + addq $12, 8, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + fbgt $f1, CACHEVALID # [0di] + stq $24, 0($12) # Didn't branch, answer is NIL [1-] + br $31, CACHEVALID # [1] +.align 3 +G14043: +/* Here for all other cases */ + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, UNARYNUMERICEXCEPTION +.align 3 +G14041: +#ifdef TRACING + br $31, DoPluspIM # [1-] + .byte 0x82 + .asciiz "DoPluspIM" +#endif +.align 5 +.align 3 +DoPluspIM: # Entry point for IMMEDIATE mode + ldq $1, PROCESSORSTATE_NILADDRESS($14) # [1] + sll $17, 56, $17 # Turned into a signed number [0di] + ldq $2, PROCESSORSTATE_TADDRESS($14) # [1-] + addq $12, 8, $12 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + cmovgt $17, $2, $1 # stall 2 then di [1-] + stq $1, 0($12) # yes Virginia, we dual issue with above yahoo [0di] + br $31, CACHEVALID # [1] +.end DoPlusp +/* End of Halfword operand from stack instruction - DoPlusp */ +.align 5 +.globl DoLessp +.ent DoLessp 0 +/* Halfword operand from stack instruction - DoLessp */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoLesspFP + .globl DoLesspSP + .globl DoLesspLP + .globl DoLesspIM +.align 3 +DoLessp: +#ifdef TRACING + .byte 0x88 + .asciiz "DoLesspSP" +#endif +.align 3 +DoLesspSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoLessp # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoLessp # [0di] + .byte 0x90 + .asciiz "DoLesspLP" +#endif +.align 3 +DoLesspLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoLessp # [1] + .byte 0x84 + .asciiz "DoLesspFP" +#endif +.align 3 +DoLesspFP: # Entry point for FP relative +.align 3 +beginDoLessp: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + srl $18, 12, $7 # [1-] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [0di] + extll $21, 4, $18 # Get ARG1 tag [1-] + ldl $1, 4($16) # t1 is tag of arg2 [0di] + lds $f1, 0($12) # [1] + and $7, 1, $7 # [0di] + ldl $17, 0($16) # [1-] + addl $21, $31, $19 # [0di] + lds $f2, 0($16) # [1-] + and $18, 63, $5 # Strip off any CDR code bits. [0di] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $5, TypeFixnum, $6 # [1] +.align 3 +G14065: + beq $6, G14053 # [1] +/* Here if argument TypeFixnum */ + cmpeq $4, TypeFixnum, $3 # [0di] +.align 3 +G14057: + beq $3, G14048 # [1] +/* Here if argument TypeFixnum */ + subq $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # Pop/No-pop [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovlt $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G14054: +.align 3 +G14053: + cmpeq $5, TypeSingleFloat, $6 # [1-] +.align 3 +G14066: + beq $6, G14058 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $4, TypeSingleFloat, $3 # [0di] +.align 3 +G14062: + beq $3, G14048 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +LesspMMExcFLTFLT: + cmptlt $f1, $f2, $f3 # [1] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + s8addq $7, $12, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + stq $25, 0($12) # [1] + fbne $f3, CACHEVALID # [3-] + stq $24, 0($12) # Didn't branch, answer is NIL [0di] + br $31, CACHEVALID # [1] +.align 3 +G14059: +.align 3 +G14058: +/* Here for all other cases */ +.align 3 +G14048: + br $31, LesspMMExc # [1] +.align 3 +G14052: +#ifdef TRACING + br $31, DoLesspIM # [1] + .byte 0x82 + .asciiz "DoLesspIM" +#endif +.align 5 +.align 3 +DoLesspIM: # Entry point for IMMEDIATE mode + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1] + sll $17, 56, $17 # First half of sign extension [0di] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1-] + srl $18, 12, $7 # [0di] + extll $21, 4, $18 # [1] + addl $21, $31, $19 # [1] + sra $17, 56, $17 # Second half of sign extension [1] + and $7, 1, $7 # [1] + and $18, 63, $3 # Strip off any CDR code bits. [1] + cmpeq $3, TypeFixnum, $4 # [1] +.align 3 +G14071: + beq $4, G14068 # [1] +/* Here if argument TypeFixnum */ + subq $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovlt $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G14068: +/* Here for all other cases */ + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G14067: +.end DoLessp +/* End of Halfword operand from stack instruction - DoLessp */ +.align 5 +.globl DoDecrement +.ent DoDecrement 0 +/* Halfword operand from stack instruction - DoDecrement */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoDecrementFP + .globl DoDecrementSP + .globl DoDecrementLP + .globl DoDecrementIM +.align 3 +DoDecrement: +#ifdef TRACING + .byte 0x88 + .asciiz "DoDecrementSP" +#endif +.align 3 +DoDecrementSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoDecrement # [0di] + .byte 0x90 + .asciiz "DoDecrementLP" +#endif +.align 3 +DoDecrementLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoDecrement # [1] + .byte 0x84 + .asciiz "DoDecrementFP" +#endif +.align 3 +DoDecrementFP: # Entry point for FP relative +.align 3 +beginDoDecrement: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $18, 0($16) # read tag/data of arg1 [2] + ldl $17, 4($16) # [1] + extll $18, 0, $18 # [2di] + and $17, 63, $1 # Strip off any CDR code bits. [1] + cmpeq $1, TypeFixnum, $2 # [1] +.align 3 +G14077: + beq $2, G14073 # [1] +/* Here if argument TypeFixnum */ + ldq $2, PROCESSORSTATE_MOSTNEGATIVEFIXNUM($14) # [1] + subq $18, 1, $3 # [1-] + cmpeq $18, $2, $2 # [2] + bne $2, DECREMENTEXCEPTION # [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $3, 0($16) # [1] + stl $17, 4($16) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G14073: + cmpeq $1, TypeSingleFloat, $2 # [1-] +.align 3 +G14078: + beq $2, G14074 # [1] +/* Here if argument TypeSingleFloat */ + lds $f1, 0($16) # Get the floating data [0di] + lds $f2, PROCESSORSTATE_SFP1($14) # constant 1.0 [1] + subs $f1, $f2, $f0 # [3] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + sts $f0, 0($16) # Put the floating result [1] + br $31, CACHEVALID # [1] +.align 3 +G14074: +/* Here for all other cases */ + br $31, DECREMENTEXCEPTION # [1] +.align 3 +G14072: +#ifdef TRACING + .byte 0x82 + .asciiz "DoDecrementIM" +#endif +DoDecrementIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoDecrement. +.end DoDecrement +/* End of Halfword operand from stack instruction - DoDecrement */ +.align 5 +.globl DoMergeCdrNoPop +.ent DoMergeCdrNoPop 0 +/* Halfword operand from stack instruction - DoMergeCdrNoPop */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMergeCdrNoPopFP + .globl DoMergeCdrNoPopSP + .globl DoMergeCdrNoPopLP + .globl DoMergeCdrNoPopIM +.align 3 +DoMergeCdrNoPop: +#ifdef TRACING + .byte 0x88 + .asciiz "DoMergeCdrNoPopSP" +#endif +.align 3 +DoMergeCdrNoPopSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoMergeCdrNoPop # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoMergeCdrNoPop # [0di] + .byte 0x90 + .asciiz "DoMergeCdrNoPopLP" +#endif +.align 3 +DoMergeCdrNoPopLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMergeCdrNoPop # [1] + .byte 0x84 + .asciiz "DoMergeCdrNoPopFP" +#endif +.align 3 +DoMergeCdrNoPopFP: # Entry point for FP relative +.align 3 +beginDoMergeCdrNoPop: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + ldl $1, 4($16) # Get the CDR CODE/TAG of arg2 [1] + extll $21, 4, $2 # Get the CDR CODE/TAG of arg1 [1-] +.align 3 +G14079: + and $2, 192, $2 # Get Just the CDR code in position [2] + and $1, 63, $1 # Get the TAG of arg1 [1] + bis $1, $2, $3 # Merge the tag of arg2 with the cdr code of arg1 [1] + stl $3, 4($16) # Replace tag/cdr code no pop [0di] + br $31, CACHEVALID # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoMergeCdrNoPopIM" +#endif +DoMergeCdrNoPopIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoMergeCdrNoPop. +.end DoMergeCdrNoPop +/* End of Halfword operand from stack instruction - DoMergeCdrNoPop */ +.align 5 +.globl DoEqImmediateHandler +.ent DoEqImmediateHandler 0 +.align 3 +DoEqImmediateHandler: +#ifdef TRACING + br $31, DoEqIM # [1] + .byte 0x82 + .asciiz "DoEqIM" +#endif +.align 5 +.align 3 +DoEqIM: # Entry point for IMMEDIATE mode + sll $17, 56, $17 # [1-] + ldl $4, 4($12) # t4=tag t3=data [0di] + ldl $3, 0($12) # [1] + srl $18, 12, $18 # [0di] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1-] + sra $17, 56, $17 # Sign extension of arg2 is complete [0di] +/* TagType. */ + and $4, 63, $4 # [1] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [0di] + and $18, 1, $18 # 1 if no-pop, 0 if pop [1-] + subl $3, $17, $17 # [1] + xor $4, TypeFixnum, $4 # [1] + s8addq $18, $12, $12 # Either a stack-push or a stack-write [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + bis $17, $4, $4 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmoveq $4, $25, $24 # [0di] + stq $24, 0($12) # Yes Virginia, this does dual issue with above [1-] + br $31, CACHEVALID # [1] +.end DoEqImmediateHandler +.align 5 +.globl DoIncrement +.ent DoIncrement 0 +/* Halfword operand from stack instruction - DoIncrement */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoIncrementFP + .globl DoIncrementSP + .globl DoIncrementLP + .globl DoIncrementIM +.align 3 +DoIncrement: +#ifdef TRACING + .byte 0x88 + .asciiz "DoIncrementSP" +#endif +.align 3 +DoIncrementSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoIncrement # [0di] + .byte 0x90 + .asciiz "DoIncrementLP" +#endif +.align 3 +DoIncrementLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoIncrement # [1] + .byte 0x84 + .asciiz "DoIncrementFP" +#endif +.align 3 +DoIncrementFP: # Entry point for FP relative +.align 3 +beginDoIncrement: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $18, 0($16) # read tag/data of arg1 [2] + ldl $17, 4($16) # [1] + extll $18, 0, $18 # [2di] + and $17, 63, $1 # Strip off any CDR code bits. [1] + cmpeq $1, TypeFixnum, $2 # [1] +.align 3 +G14085: + beq $2, G14081 # [1] +/* Here if argument TypeFixnum */ + ldq $2, PROCESSORSTATE_MOSTPOSITIVEFIXNUM($14) # [1] + addq $18, 1, $3 # [1-] + cmpeq $18, $2, $2 # [2] + bne $2, INCREMENTEXCEPTION # [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $3, 0($16) # [1] + stl $17, 4($16) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G14081: + cmpeq $1, TypeSingleFloat, $2 # [1-] +.align 3 +G14086: + beq $2, G14082 # [1] +/* Here if argument TypeSingleFloat */ + lds $f1, 0($16) # Get the floating data [0di] + lds $f2, PROCESSORSTATE_SFP1($14) # constant 1.0 [1] + adds $f1, $f2, $f0 # [3] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + sts $f0, 0($16) # Put the floating result [1] + br $31, CACHEVALID # [1] +.align 3 +G14082: +/* Here for all other cases */ + br $31, INCREMENTEXCEPTION # [1] +.align 3 +G14080: +#ifdef TRACING + .byte 0x82 + .asciiz "DoIncrementIM" +#endif +DoIncrementIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoIncrement. +.end DoIncrement +/* End of Halfword operand from stack instruction - DoIncrement */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifuncom2.as */ diff --git a/alpha-emulator/ifunfcal.as b/alpha-emulator/ifunfcal.as new file mode 100644 index 0000000..f5ad1a4 --- /dev/null +++ b/alpha-emulator/ifunfcal.as @@ -0,0 +1,328 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Function calling.") + +(comment "Start call.") + +;; |DoStartCall| is in IFUNCOM1.AS + + +(comment "Finish call.") + +;; |DoFinishCallN| (and hence |DoFinishCallNApply|) are in IFUNCOM1.AS + +;; This handles both the apply and the non-apply cases (opcode in ARG3) +(define-instruction |DoFinishCallTos| :10-bit-immediate (:own-immediate t) + (EXTBL arg3 5 arg1 "arg1 contains the disposition (two bits)") + (LDL arg2 0 (isp) "Get the number of args") + (SUBQ isp 8 isp "Pop stack") + ;(EXTLL arg2 0 arg2) ;no need, the number is positive + (S8ADDQ arg2 8 arg2 "Add 1 and convert to stacked word address") + (BR zero finishcallmerge)) + + +(comment "Function entry.") + +;; |DoEntryRestNotAccepted| is in IFUNCOM1.AS + +(define-instruction |DoEntryRestAccepted| :entry-instruction () + (SRL arg5 27 t2 "Get the cr.trace-pending bit") + (AND arg5 #xFF t1 "The supplied args") + (BLBS t2 TraceTrap) + (b-apply-argument-supplied applysuppra t2 t3 t4 arg5) + (SUBQ t1 arg2 t2 "t2=supplied-minimum") + (BLT t2 retryeratoofew "B. if too few args.") + (SUBQ arg4 t1 arg1 "maximum-supplied") + (BLT arg1 retryerarest "B. rest args.") + (enter-function t2 t3 t4) ;doesn't return + (label applysuppra) + (SUBQ arg4 t1 arg1 "maximum-supplied") + (BLT arg1 retryerarest "B. rest args.") + (BGT arg1 |PullApplyArgs| "try pulling from applied args.") + (stack-set-cdr-code iSP 1 t6) ;CDR-NIL + (SUBQ t1 arg2 t2 "t2=supplied-minimum") + (ADDQ t2 1 t2) + (enter-function t2 t3 t4) ;doesn't return + (label retryeratoofew) + (illegal-operand too-few-arguments) + (label retryerarest) + (push-apply-args arg2 arg4 t1 t2 t3 arg5)) ;calls ENTER-FUNCTION and doesn't return + +#-list-inline +;; --- All the temps aren't really arguments, but they are smashed +(define-subroutine |CarCdrInternal| + (t1 t2 arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (carcdr-internal t1 t2 arg5 arg6 set-to-cdr-push-car arg2 t5 t6 t7 t8))) + +(align4kskip4k) + +;; It might be slow, but not as slow as trapping out to Lisp! +;; ARG1 contains the number of args to pull +;; Rest argument is on the top of the stack +(define-procedure |PullApplyArgsSlowly| () + (with-multiple-memory-reads (t9 t10 t11 t12) + (pull-apply-args-slowly arg1 arg2 arg3 arg4 arg5 arg6 t1 t2 t3 t4 t5 t6))) + +(define-instruction |DoLocateLocals| :operand-from-stack () + (get-control-register t1 "The control register") + (BIS iSP zero iLP) + (SUBQ iLP iFP t3 "arg size including the fudge 2") + (SRL t3 3 t3 "adjust arg size to words") + (AND t1 #xFF t2 "argument size") + (SUBQ t2 2 t2 "corrected arg size") + (BIC t1 #xFF t1) + (BIS t1 t3 t1 "replace the arg size") + (stack-push-fixnum t2 t4) + (set-control-register t1) + (ContinueToNextInstruction)) + +(comment "Returning.") + +;; |DoReturnSingle| is in IFUNCOM1.AS + +;; Register conventions for return-multiple instruction: +;; arg1 is number of values +;; arg2 is the pop(0)/immediate(1) flag +;; These are shared with return conventions for effect and value cases +;; arg3 is the return value (with cdr already cleared) +;; arg4 is the disposition dispatch +;; arg5 is the control register +;; arg6 is stack-cache-data (for underflow check) + +;; Return completes by branching to StackCacheUnderflowCheck which goes +;; to NextInstruction after dealing with underflow. In the for-return +;; case, this re-executes the instruction one frame up. --- +;; Return-multiple is only ever called in immediate or sp-pop mode, make +;; a custom entry that takes advantage of that +(define-instruction |DoReturnMultiple| :operand-from-stack (:own-immediate t) + ;; Here we know we were called with sp|pop + (LDL t1 4 (arg1) "Fetch the tag for type-check") + (LDL arg1 0 (arg1) "Fetch the data") + (CheckDataType t1 |TypeFixnum| returnmultipleio t2) + (EXTLL arg1 0 arg1 "Discard dtp-fixnum tag word") + (label returnmultipletop) + (get-control-register arg5) + (load-constant t3 #.(* 3 1_18) "value disposition mask") + (ADDQ iSP 8 t2) + (SLL arg1 3 t1 "Value bytes") + (AND t3 arg5 t3 "Mask") + (SRL t3 18 t3 "Shift disposition bits into place.") + (SUBQ t2 t1 arg3 "Compute position of value(s)") + (LDQ arg6 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (SUBQ t3 2 arg4 "arg4 -2=effect -1=value 0=return 1=multiple") + (BLT arg4 returnmultiplesingle) + (abandon-frame-simple (not arg4) arg5 HandleFrameCleanup t1 t2 t3 t4 t5 t6 t7) + (CMPULT iFP arg6 arg6 "ARG6 = stack-cache underflow") + ;;+++ check for frame overflow here before copying in values + (ADDQ iSP 8 t4 "Compute destination of copy") + (BIS arg1 zero t3 "Values") + (stack-block-copy arg3 t4 t3 t nil t1 t2) + (S8ADDQ arg1 iSP iSP "Adjust iSP over returned values") + (comment "arg4 -2=effect -1=value 0=return 1=multiple") + (BEQ arg4 returnmultiplereturn) + (label returnmultiplemultiple) + (stack-push-fixnum arg1 t1 "push the MV return count") + (label returnmultipledone) + (branch-true arg6 returnmultipleunderflow) + (BIS t7 zero arg2) + (BNE t7 InterpretInstructionPredicted) + ;; PC was loaded if arg4 /= 0 + (BNE arg4 interpretInstructionForBranch) + (ContinueToInterpretInstruction "Return-multiple done") + (label returnmultipleunderflow) + (external-branch |StackCacheUnderflowCheck|) + + ;; Here for the cases that do not preserve multiple values (effect, value) + ;; fetch the first value (or NIL if there are no values) + (label returnmultiplesingle) + (stack-read arg3 arg3) + (get-nil t1) + (SLL arg3 #.(- 64 38) arg3 "Clear cdr") + (SRL arg3 #.(- 64 38) arg3 "Clear cdr") + (CMOVEQ arg1 t1 arg3) + (BR zero returncommontail) + + (label returnmultiplereturn) + ;; If this was SP|POP, must push that back before retry + (branch-true arg2 returnmultipledone) + (stack-push-ir |TypeFixnum| arg1 t1) + (BR zero returnmultipledone) + + (immediate-handler |DoReturnMultiple|) + (BIS arg2 zero arg1) + ;; Not SP|POP + (load-constant arg2 1 "arg2 = (not sp|pop)") + (BR zero returnmultipletop) + + (label returnmultipleio) + (illegal-operand one-operand-fixnum-type-error)) + +(define-procedure handleframecleanup () + (LDQ iSP PROCESSORSTATE_RESTARTSP (ivory) "Restore SP to instruction start") + (get-control-register arg5 "Get control register") + (cleanup-frame arg5 InterpretInstruction t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12) + (ContinueToInterpretInstruction "Retry the instruction")) + +(define-procedure |StackCacheUnderflowCheck| () + ;; iCP may not be valid yet, so we continue through + ;; InterpretInstructionForBranch, which will validate it + (stack-cache-underflow-check iFP InterpretInstructionForBranch |StackCacheUnderflow| t1 t2 t3 t4)) + +;; FROM, TO, and COUNT must be in T1, T2, and T3 +(define-procedure |StackCacheUnderflow| () + (stack-cache-underflow-body t1 t2 t3 t4 t5 t6 t7) + (RET zero R0 1)) + +(define-procedure |StackCacheOverflowHandler| (iSP arg2) + ;; arg2 is nwords beyond iSP needed + (stack-cache-overflow-handler t1 t2 t3 t4 t5)) + +(define-instruction |DoReturnKludge| :operand-from-stack (:own-immediate t) + (stack-read2 arg1 t1 arg2 :signed t) + (CheckDataType t1 |TypeFixnum| returnkludgeio t2) + (EXTLL arg2 0 arg2) + (immediate-handler |DoReturnKludge|) + (LDQ arg6 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (S8SUBQ arg2 8 t1) + (get-control-register t2) + (SUBQ iSP t1 t1 "t1 is the values block") + (abandon-frame-simple t t2 returnkludgecleanup t3 t4 t5 t6 t7 t8 t9) + (CMPULT iFP arg6 arg6 "ARG6 = stack-cache underflow") + (BEQ arg2 rkloopdone) + (label rklooptop) + (stack-read t1 t4 "Read a 40 bit word from the values block") + (SUBQ arg2 1 arg2) + (stack-write-disp iSP 8 t4 "Push value onto stack cdr codes and all") + (ADDQ t1 8 t1) + (ADDQ iSP 8 iSP) + (BGT arg2 rklooptop) + (label rkloopdone) + (branch-true arg6 returnkludgeunderflow) + (BEQ t9 interpretInstructionForBranch "No prediction, validate cache") + ;; Duplicate code from (label interpretInstructionPredicted) + (FETCH 0 (t9)) + (BIS t9 zero iCP) + (ContinueToInterpretInstruction) + + (label returnkludgeio) + (illegal-operand one-operand-fixnum-type-error) + (label returnkludgecleanup) + (external-branch handleframecleanup) + (label returnkludgeunderflow) + (external-branch |StackCacheUnderflowCheck|)) + +;;+++ Should signal TAKE-VALUES-TYPE-ERROR if args are not fixnums +(define-instruction |DoTakeValues| :operand-from-stack-immediate () + (LDQ arg6 PROCESSORSTATE_NILADDRESS (ivory)) + (EXTLL arg1 0 arg1 "Number of values expected") + (stack-pop2 arg3 arg4 "Number of values provided") ;+++ only arg4 needed + (SUBQ arg1 arg4 arg2) + (BLT arg2 takevalueslose "J. if too many args supplied") + (BGT arg2 takevaluespad "J. if too few values supplied") + (ContinueToNextInstruction) + (label takevalueslose) + (S8ADDQ arg2 iSP iSP "Remove the unwanted values") ;arg2 is -ve + (ContinueToNextInstruction) + (label takevaluespad) + (stack-cache-overflow-check t1 t2 t3 t4 t5 iSP arg2) + (label takevaluespadloop) + (stack-push-with-cdr arg6 "Push NIL") + (SUBQ arg2 1 arg2) + (BGT arg2 takevaluespadloop) + (ContinueToNextInstruction)) + + +(comment "Catch Instructions") + +(define-instruction |DoCatchOpen| :10-bit-immediate () + (AND arg1 1 t10 "t10=1 if unwind-protect, t10=0 if catch") + (LDL t3 |PROCESSORSTATE_CATCHBLOCK+4| (ivory) "tag") + (SLL t10 #.(+ 6 32) t10) + (LDL t4 |PROCESSORSTATE_CATCHBLOCK| (ivory) "data") + (LDQ t2 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (SCAtoVMA iSP t9 t1) + (BIS t10 t2 t1) + (stack-push-with-cdr t1) + (get-control-register t11) + (SRL t11 #.(- 26 6) t2 "Get old cleanup catch bit") + (AND t2 #x40 t2) + (SRL t11 #.(- 8 7) t1 "Get old extra arg bit") + (AND t1 #x80 t1) + (BIS t1 t2 t1) + (TagType t3 t2) ;+++ will never be a cdr code? + (BIS t1 t2 t1 "T1 now has new tag") + (stack-push2-with-cdr t1 t4) + (BNE t10 catchopen2) + (get-continuation2 t1 t2) + (TagType t1 t1) + (AND arg1 #xC0 t3 "T3 has the disposition bits in place") + (BIS t1 t3 t1) + (stack-push2-with-cdr t1 t2) + (label catchopen2) + (BIS zero |TypeLocative| t1) + (STL t1 |PROCESSORSTATE_CATCHBLOCK+4| (ivory) "tag") + (STL t9 PROCESSORSTATE_CATCHBLOCK (ivory) "data") + (load-constant t1 #.1_26 "cr.cleanup-catch") + (BIS t1 t11 t1 "set it") + (set-control-register t1) + (ContinueToNextInstruction)) + +(define-instruction |DoCatchClose| :operand-from-stack () + (LDL t1 PROCESSORSTATE_CATCHBLOCK (ivory) "data") + (EXTLL t1 0 t1) + (VMAtoSCA t1 t10 t3) ;t10 is now an SCA + (stack-read2-disp t10 8 arg3 arg4 "bstag bsdata") + (LDQ t4 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-read2-disp t10 16 arg5 arg6 "prtag prdata") + (SRL t4 32 t3) + (SUBL arg4 t4 t5) + (BEQ t5 catchcloseld) + (CheckDataType t3 |TypeLocative| catchclosedbt t1) + (label catchcloselt) + (unbind t1 t2 t3 t4 t5 t6 t7 t8 t9 arg1 arg2 t11) ;t1 gets new BSP + (SUBL arg4 t1 t5) + (BNE t5 catchcloselt) + ;; After we've unbound everything, check for a preempt request + (check-preempt-request nil t3 t4) + (label catchcloseld) + (TagType arg5 t1) + (STL t1 |PROCESSORSTATE_CATCHBLOCK+4| (ivory) "tag") + (AND arg5 #x80 t2 "extra argument bit") + (LDQ t6 PROCESSORSTATE_EXTRAANDCATCH (ivory) "mask for two bits") + (SLL t2 1 t2 "position in place for control register.") + (STL arg6 PROCESSORSTATE_CATCHBLOCK (ivory) "data") + (AND arg5 #x40 t3 "cleanup catch bit") + (SLL t3 #.(- 26 6) t3 "position in place for cr") + (get-control-register t4) + (BIS t2 t3 t5 "coalesce the two bits") + (BIC t4 t6 t4 "Turn off extra-arg and cleanup-catch") + (BIS t4 t5 t4 "Maybe turn them back on") + (set-control-register t4) + (AND arg3 #x40 t6 "uwp bit") + (BEQ t6 NextInstruction) + (comment "Handle unwind-protect cleanup here") + (stack-read2 t10 arg1 arg2 "pctag pcdata") + (SRL t4 #.(- 23 6) t8 "Cleanup in progress bit into cdr code pos") + ;; Get the next PC + (ADDQ iPC 1 t7 "Next PC") + (convert-pc-to-continuation t7 t8 t10 t1) + (TagType t8 t7) + (AND t8 #x40 t8) + (load-constant t9 #.1_23 "cr.cleanup-in-progress") + (BIS t8 #x80 t8) + (BIS t7 t8 t7) + (stack-push2-with-cdr t7 t10) + (BIS t4 t9 t4 "set cr.cleanup-in-progress") + (set-control-register t4) + (convert-continuation-to-pc arg1 arg2 iPC t1) + (BR zero InterpretInstructionForJump) + (label catchclosedbt) + (external-branch DBUNWINDCATCHTRAP)) + +(comment "Fin.") diff --git a/alpha-emulator/ifunfcal.s b/alpha-emulator/ifunfcal.s new file mode 100644 index 0000000..4eee53e --- /dev/null +++ b/alpha-emulator/ifunfcal.s @@ -0,0 +1,2056 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunfcal.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Function calling. */ +/* Start call. */ +/* Finish call. */ +.align 5 +.globl DoFinishCallTos +.ent DoFinishCallTos 0 +/* Halfword 10 bit immediate instruction - DoFinishCallTos */ + .globl DoFinishCallTosFP + .globl DoFinishCallTosSP + .globl DoFinishCallTosLP + .globl DoFinishCallTosIM +.align 3 +DoFinishCallTos: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoFinishCallTos" +#endif +.align 3 +DoFinishCallTosIM: +.align 3 +DoFinishCallTosSP: +.align 3 +DoFinishCallTosLP: +.align 3 +DoFinishCallTosFP: +/* arg1 has operand preloaded. */ + extbl $18, 5, $16 # arg1 contains the disposition (two bits) [1] + ldl $17, 0($12) # Get the number of args [0di] + subq $12, 8, $12 # Pop stack [1] + s8addq $17, 8, $17 # Add 1 and convert to stacked word address [2] + br $31, FINISHCALLMERGE # [1-] +.end DoFinishCallTos +/* End of Halfword operand from stack instruction - DoFinishCallTos */ +/* Function entry. */ +.align 5 +.globl DoEntryRestAccepted +.ent DoEntryRestAccepted 0 +/* Field Extraction instruction - DoEntryRestAccepted */ + .globl DoEntryRestAcceptedFP + .globl DoEntryRestAcceptedSP + .globl DoEntryRestAcceptedLP + .globl DoEntryRestAcceptedIM +.align 3 +DoEntryRestAccepted: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xB0 + .asciiz "DoEntryRestAccepted" +#endif +.align 3 +DoEntryRestAcceptedIM: +.align 3 +DoEntryRestAcceptedSP: +.align 3 +DoEntryRestAcceptedLP: +.align 3 +DoEntryRestAcceptedFP: + ldl $20, PROCESSORSTATE_CONTROL($14) # The control register [1] + srl $18, 18, $19 # Pull down the number of optionals [0di] + extbl $18, 5, $16 # Extract the 'ptr' field while we are waiting [1] + and $19, 255, $19 # [1] +/* arg1=ptr field, arg2=required, arg3=instn, arg4=optionals arg5=control-register */ + srl $20, 27, $2 # Get the cr.trace-pending bit [1] + and $20, 255, $1 # The supplied args [1] + blbs $2, TRACETRAP # [1-] + srl $20, 17, $3 # [0di] + ldl $4, 4($12) # Get the tag of the stack top. [1-] +.align 3 +G14092: + blbs $3, G14090 # J. if apply args [1-] +G14091: + subq $1, $17, $2 # t2=supplied-minimum [0di] + blt $2, RETRYERATOOFEW # B. if too few args. [1] + subq $19, $1, $16 # maximum-supplied [0di] + blt $16, RETRYERAREST # B. rest args. [1] +/* Compute entry position and advance PC/CP accordingly. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # get the next PC [0di] + sll $2, 1, $3 # Adjust index to halfword [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + beq $2, INTERPRETINSTRUCTION # J. if index zero, no adjustment. [1-] + addq $9, $3, $9 # Compute the new address [1di] + bic $9, 1, $9 # Make it an DTP-EVEN-PC [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [0di] +.align 3 +APPLYSUPPRA: + subq $19, $1, $16 # maximum-supplied [1-] + blt $16, RETRYERAREST # B. rest args. [1] + bgt $16, PullApplyArgs # try pulling from applied args. [1] + ldl $6, 4($12) # get tag [0di] + and $6, 63, $6 # [3] + bis $6, 64, $6 # [1] + stl $6, 4($12) # set tag [1-] + subq $1, $17, $2 # t2=supplied-minimum [0di] + addq $2, 1, $2 # [1] +/* Compute entry position and advance PC/CP accordingly. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # get the next PC [0di] + sll $2, 1, $3 # Adjust index to halfword [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + beq $2, INTERPRETINSTRUCTION # J. if index zero, no adjustment. [1-] + addq $9, $3, $9 # Compute the new address [1di] + bic $9, 1, $9 # Make it an DTP-EVEN-PC [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [0di] +.align 3 +RETRYERATOOFEW: + bis $31, 0, $20 # [1-] + bis $31, 77, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +RETRYERAREST: + ldl $1, 4($12) # get tag [1-] + and $1, 63, $1 # [3] + bis $1, 64, $1 # [1] + stl $1, 4($12) # set tag [0di] + srl $20, 17, $2 # [1-] + ldl $3, 4($12) # Get the tag of the stack top. [0di] +.align 3 +G14097: + blbs $2, G14095 # J. if apply args [2-] +G14096: + s8addq $19, $10, $1 # [0di] +/* Convert stack cache address to VMA */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $1, $3, $3 # stack cache base relative offset [2-] + srl $3, 3, $3 # convert byte address to word address [1] + addq $3, $2, $2 # reconstruct VMA [2] + bis $31, TypeList, $1 # [1] + stl $2, 8($12) # [1-] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, G14094 # [0di] +.align 3 +G14093: + subq $12, 8, $1 # [1-] + ldl $3, 4($1) # get tag [2] + and $3, 63, $3 # [3] + bis $3, 128, $3 # [1] + stl $3, 4($1) # set tag [1-] + s8addq $19, $10, $1 # [0di] +/* Convert stack cache address to VMA */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $1, $3, $3 # stack cache base relative offset [2-] + srl $3, 3, $3 # convert byte address to word address [1] + addq $3, $2, $2 # reconstruct VMA [2] + bis $31, TypeList, $1 # [1] + stl $2, 8($12) # [1-] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + addq $11, 8, $11 # [1] + addq $20, 1, $20 # [1] + stl $20, PROCESSORSTATE_CONTROL($14) # [0di] +.align 3 +G14094: + subq $19, $17, $1 # [1-] + addq $1, 1, $1 # [1] +/* Compute entry position and advance PC/CP accordingly. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # get the next PC [1-] + sll $1, 1, $2 # Adjust index to halfword [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + beq $1, INTERPRETINSTRUCTION # J. if index zero, no adjustment. [0di] + addq $9, $2, $9 # Compute the new address [2-] + bic $9, 1, $9 # Make it an DTP-EVEN-PC [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [1-] +.align 3 +G14095: + and $3, 63, $3 # [1-] + subq $3, TypeNIL, $3 # [1] + bne $3, G14093 # J. if apply args supplied not nil. [1] + and $2, 1, $2 # keep just the apply bit! [0di] + sll $2, 17, $2 # reposition the apply bit [1] + subq $12, 8, $12 # Pop off the null applied arg. [1] + bic $20, $2, $20 # Blast the apply arg bit away [1] + stl $20, PROCESSORSTATE_CONTROL($14) # Reset the stored cr bit [0di] + br $31, G14096 # [1] +.align 3 +G14090: + and $4, 63, $4 # [1-] + subq $4, TypeNIL, $4 # [1] + bne $4, APPLYSUPPRA # J. if apply args supplied not nil. [1] + and $3, 1, $3 # keep just the apply bit! [0di] + sll $3, 17, $3 # reposition the apply bit [1] + subq $12, 8, $12 # Pop off the null applied arg. [1] + bic $20, $3, $20 # Blast the apply arg bit away [1] + stl $20, PROCESSORSTATE_CONTROL($14) # Reset the stored cr bit [0di] + br $31, G14091 # [1] +.end DoEntryRestAccepted +/* End of Halfword operand from stack instruction - DoEntryRestAccepted */ +.align 5 +.globl CarCdrInternal +.ent CarCdrInternal 13 +.align 3 +CarCdrInternal: + lda $30, -8($30) # [1-] + .frame $30, 8, $0 + extll $2, $31, $17 # [1] + and $1, 63, $5 # Strip off any CDR code bits. [1] + cmpeq $5, TypeList, $6 # [1] +.align 3 +G14145: + beq $6, G14102 # [1] +/* Here if argument TypeList */ +/* Memory Read Internal */ +G14103: + addq $17, $14, $7 # [0di] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G14105 # [0di] +G14104: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G14107 # [1-] +G14114: + subl $17, $2, $5 # [0di] + bne $5, G14098 # CAR forwarded, must CDR the hard way [1] + bis $20, $31, $1 # [0di] + bis $21, $31, $2 # [1] +.align 3 +G14100: + and $20, 192, $5 # Extract CDR code. [1] + bne $5, G14116 # [1] +/* Here if argument 0 */ + addq $17, 1, $21 # Address of next position is CDR [1-] + bis $31, TypeList, $20 # [1] +.align 3 +G14115: +.align 3 +G14101: +.align 3 +G14099: + lda $30, 8($30) # [1] + ret $31, ($0), 1 # [0di] +.align 3 +G14102: + cmpeq $5, TypeNIL, $6 # [1-] +.align 3 +G14146: + beq $6, G14132 # [1] +/* Here if argument TypeNIL */ + ldl $21, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldl $20, PROCESSORSTATE_NILADDRESS+4($14) # [1] + extll $21, 0, $21 # [2di] + br $31, G14101 # [1-] +.align 3 +G14132: +/* Here for all other cases */ + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, LISTEXCEPTION +.align 3 +G14098: + extll $2, $31, $17 # [1] + bis $20, $31, $1 # [1] + bis $21, $31, $2 # [1] +/* Memory Read Internal */ +G14134: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_CDR_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G14136 # [0di] +G14135: + lda $7, 192 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G14138 # [1di] +G14143: + br $31, G14100 # [1] +.align 3 +G14138: + blbc $7, G14137 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G14134 # [1-] +.align 3 +G14137: +.align 3 +G14136: + stq $0, 0($30) # [1] + bsr $0, MemoryReadCdrDECODE + ldq $0, 0($30) # [1] + br $31, G14143 # [1] +.align 3 +G14116: + cmpeq $5, 128, $6 # [1-] +.align 3 +G14147: + beq $6, G14117 # [1] +/* Here if argument 128 */ + addq $17, 1, $17 # [0di] +/* Memory Read Internal */ +G14118: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G14120 # [1-] +G14119: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + extll $21, 0, $21 # [1] + blbs $8, G14122 # [0di] + br $31, G14099 # [1] +.align 3 +G14117: + cmpeq $5, 64, $6 # [1-] +.align 3 +G14148: + beq $6, G14129 # [1] +/* Here if argument 64 */ + ldl $21, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldl $20, PROCESSORSTATE_NILADDRESS+4($14) # [1] + extll $21, 0, $21 # [2di] + br $31, G14099 # [1-] +.align 3 +G14129: +/* Here for all other cases */ + bis $31, $17, $20 # [1-] + bis $31, 15, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14122: + blbc $7, G14121 # [1-] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G14118 # [1-] +.align 3 +G14121: +.align 3 +G14120: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G14099 # [1] +.align 3 +G14107: + blbc $7, G14106 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G14103 # [1-] +.align 3 +G14106: +.align 3 +G14105: + stq $0, 0($30) # [1] + bsr $0, MemoryReadDataDECODE + ldq $0, 0($30) # [1] + br $31, G14114 # [1] +.end CarCdrInternal +.align 12 + and $31, $31, $31 # [1] +.align 12 +.align 5 +.globl PullApplyArgsSlowly +.ent PullApplyArgsSlowly 0 +.align 3 +PullApplyArgsSlowly: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $19, 0($12) # Get the rest arg [1] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2-] + extll $19, $31, $2 # [2] + and $18, 63, $3 # Strip off any CDR code bits. [1] + cmpeq $3, TypeList, $4 # [1] +.align 3 +G14196: + beq $4, G14153 # [1] +/* Here if argument TypeList */ +/* Memory Read Internal */ +G14154: + addq $2, $14, $5 # [0di] + s4addq $5, $31, $21 # [1] + ldq_u $20, 0($5) # [1di] + subq $2, $24, $3 # Stack cache offset [1-] + ldq $6, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $3, $25, $4 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $5, $20 # [1-] + bne $4, G14156 # [0di] +G14155: + lda $5, 240 # [1-] + srl $6, $20, $6 # [1] + srl $5, $20, $5 # [1] + extll $21, 0, $21 # [1] + blbs $6, G14158 # [1-] +G14165: + subl $2, $19, $3 # [0di] + bne $3, G14149 # CAR forwarded, must CDR the hard way [1] + bis $20, $31, $18 # [0di] + bis $21, $31, $19 # [1] +.align 3 +G14151: + and $20, 192, $3 # Extract CDR code. [1] + bne $3, G14167 # [1] +/* Here if argument 0 */ + addq $2, 1, $21 # Address of next position is CDR [1-] + bis $31, TypeList, $20 # [1] +.align 3 +G14166: +.align 3 +G14152: +.align 3 +G14150: + stl $19, 0($12) # Push the pulled argument [1-] + stl $18, 4($12) # write the stack cache [1] + and $20, 63, $1 # set CDR-NEXT [1-] + stl $21, 8($12) # Push the new rest arg [0di] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + ldl $17, PROCESSORSTATE_CONTROL($14) # [1-] + and $17, 255, $2 # Get current arg size. [3] + bic $17, 255, $17 # [1] + addq $2, 1, $2 # [1] + addq $2, $17, $17 # Update the arg size [1] + stl $17, PROCESSORSTATE_CONTROL($14) # [0di] + addq $11, 8, $11 # [1-] + br $31, INTERPRETINSTRUCTION # [0di] +.align 3 +G14153: + cmpeq $3, TypeNIL, $4 # [1-] +.align 3 +G14197: + beq $4, G14183 # [1] +/* Here if argument TypeNIL */ + ldl $21, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldl $20, PROCESSORSTATE_NILADDRESS+4($14) # [1] + extll $21, 0, $21 # [2di] + br $31, G14152 # [1-] +.align 3 +G14183: +/* Here for all other cases */ + bis $31, $16, $16 # [1-] + br $31, PULLAPPLYARGSTRAP +.align 3 +G14149: + extll $19, $31, $2 # [1] + bis $20, $31, $18 # [1] + bis $21, $31, $19 # [1] +/* Memory Read Internal */ +G14185: + addq $2, $14, $5 # [1] + s4addq $5, $31, $21 # [1] + ldq_u $20, 0($5) # [1di] + subq $2, $24, $3 # Stack cache offset [1-] + ldq $6, PROCESSORSTATE_CDR_MASK($14) # [0di] + cmpult $3, $25, $4 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $5, $20 # [1-] + bne $4, G14187 # [0di] +G14186: + lda $5, 192 # [1-] + srl $6, $20, $6 # [1] + srl $5, $20, $5 # [1] + blbs $6, G14189 # [1di] +G14194: + br $31, G14151 # [1] +.align 3 +G14187: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $21, 0($3) # [2] + ldl $20, 4($3) # Read from stack cache [1] + br $31, G14186 # [1] +.align 3 +G14189: + blbc $5, G14188 # [1] + extll $21, 0, $2 # Do the indirect thing [0di] + br $31, G14185 # [1-] +.align 3 +G14188: + ldq $6, PROCESSORSTATE_CDR($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $5 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $5, $6, $5 # Adjust for a longword load [2di] + ldl $6, 0($5) # Get the memory action [2] +G14191: +/* Perform memory action */ + bis $31, $6, $16 # [3] + bis $31, 9, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14167: + cmpeq $3, 128, $4 # [1] +.align 3 +G14198: + beq $4, G14168 # [1] +/* Here if argument 128 */ + addq $2, 1, $2 # [0di] +/* Memory Read Internal */ +G14169: + addq $2, $14, $5 # [1] + s4addq $5, $31, $21 # [1] + ldq_u $20, 0($5) # [1-] + subq $2, $24, $3 # Stack cache offset [0di] + ldq $6, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $3, $25, $4 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $5, $20 # [1di] + bne $4, G14171 # [1-] +G14170: + lda $5, 240 # [0di] + srl $6, $20, $6 # [1] + srl $5, $20, $5 # [1] + extll $21, 0, $21 # [1] + blbs $6, G14173 # [0di] + br $31, G14150 # [1] +.align 3 +G14168: + cmpeq $3, 64, $4 # [1-] +.align 3 +G14199: + beq $4, G14180 # [1] +/* Here if argument 64 */ + ldl $21, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldl $20, PROCESSORSTATE_NILADDRESS+4($14) # [1] + extll $21, 0, $21 # [2di] + br $31, G14150 # [1-] +.align 3 +G14180: +/* Here for all other cases */ + bis $31, $2, $20 # [1-] + bis $31, 15, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14171: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $21, 0($3) # [2] + ldl $20, 4($3) # Read from stack cache [1] + br $31, G14170 # [1] +.align 3 +G14173: + blbc $5, G14172 # [1] + extll $21, 0, $2 # Do the indirect thing [0di] + br $31, G14169 # [1-] +.align 3 +G14172: + ldq $6, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $5 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $5, $6, $5 # Adjust for a longword load [2di] + ldl $6, 0($5) # Get the memory action [2] +.align 3 +G14177: + and $6, MemoryActionTransform, $5 # [3] + beq $5, G14176 # [1] + bic $20, 63, $20 # [1-] + bis $20, TypeExternalValueCellPointer, $20 # [1] + br $31, G14150 # [1-] +#ifndef MINIMA +G14176: +#endif +#ifdef MINIMA +.align 3 +G14176: + and $6, MemoryActionBinding, $5 # [1-] + ldq $4, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $5, G14175 # [1-] + sll $2, 1, $3 # [0di] + ldq $5, PROCESSORSTATE_DBCBASE($14) # [1-] + and $3, $4, $3 # Hash index [1di] + bis $31, 1, $4 # [1] + sll $4, IvoryMemoryData, $4 # [1] + addl $3, $5, $3 # [1] + extll $3, 0, $3 # Clear sign-extension [1] + s4addq $3, $4, $4 # [2] + ldl $3, 0($4) # Fetch the key [2] + ldl $21, 4($4) # Fetch value [1] + subl $2, $3, $5 # Compare [2di] + bne $5, G14179 # Trap on miss [1] + extll $21, 0, $2 # Extract the pointer, and indirect [0di] + br $31, G14169 # This is another memory read tailcall. [1-] +.align 3 +G14179: + br $31, DBCACHEMISSTRAP +#endif +G14175: +/* Perform memory action */ + bis $31, $6, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14156: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $21, 0($3) # [2] + ldl $20, 4($3) # Read from stack cache [1] + br $31, G14155 # [1] +.align 3 +G14158: + blbc $5, G14157 # [1] + extll $21, 0, $2 # Do the indirect thing [0di] + br $31, G14154 # [1-] +.align 3 +G14157: + ldq $6, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $20, 63, $5 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $5, $6, $5 # Adjust for a longword load [2di] + ldl $6, 0($5) # Get the memory action [2] +.align 3 +G14162: + and $6, MemoryActionTransform, $5 # [3] + beq $5, G14161 # [1] + bic $20, 63, $20 # [1-] + bis $20, TypeExternalValueCellPointer, $20 # [1] + br $31, G14165 # [1-] +#ifndef MINIMA +G14161: +#endif +#ifdef MINIMA +.align 3 +G14161: + and $6, MemoryActionBinding, $5 # [1-] + ldq $4, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $5, G14160 # [1-] + sll $2, 1, $3 # [0di] + ldq $5, PROCESSORSTATE_DBCBASE($14) # [1-] + and $3, $4, $3 # Hash index [1di] + bis $31, 1, $4 # [1] + sll $4, IvoryMemoryData, $4 # [1] + addl $3, $5, $3 # [1] + extll $3, 0, $3 # Clear sign-extension [1] + s4addq $3, $4, $4 # [2] + ldl $3, 0($4) # Fetch the key [2] + ldl $21, 4($4) # Fetch value [1] + subl $2, $3, $5 # Compare [2di] + bne $5, G14164 # Trap on miss [1] + extll $21, 0, $2 # Extract the pointer, and indirect [0di] + br $31, G14154 # This is another memory read tailcall. [1-] +.align 3 +G14164: + br $31, DBCACHEMISSTRAP +#endif +G14160: +/* Perform memory action */ + bis $31, $6, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.end PullApplyArgsSlowly +.align 5 +.globl DoLocateLocals +.ent DoLocateLocals 0 +/* Halfword operand from stack instruction - DoLocateLocals */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoLocateLocalsFP + .globl DoLocateLocalsSP + .globl DoLocateLocalsLP + .globl DoLocateLocalsIM +.align 3 +DoLocateLocals: +#ifdef TRACING + .byte 0x88 + .asciiz "DoLocateLocalsSP" +#endif +.align 3 +DoLocateLocalsSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoLocateLocals # [0di] + .byte 0x90 + .asciiz "DoLocateLocalsLP" +#endif +.align 3 +DoLocateLocalsLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoLocateLocals # [1] + .byte 0x84 + .asciiz "DoLocateLocalsFP" +#endif +.align 3 +DoLocateLocalsFP: # Entry point for FP relative +.align 3 +beginDoLocateLocals: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $1, PROCESSORSTATE_CONTROL($14) # The control register [0di] + bis $12, $31, $11 # [1-] + subq $11, $10, $3 # arg size including the fudge 2 [1] + srl $3, 3, $3 # adjust arg size to words [1] + and $1, 255, $2 # argument size [1] + subq $2, 2, $2 # corrected arg size [1] + bic $1, 255, $1 # [1] + bis $1, $3, $1 # replace the arg size [1] + bis $31, TypeFixnum, $4 # [1] + stl $2, 8($12) # [1-] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + stl $1, PROCESSORSTATE_CONTROL($14) # [0di] + br $31, NEXTINSTRUCTION # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoLocateLocalsIM" +#endif +DoLocateLocalsIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoLocateLocals. +.end DoLocateLocals +/* End of Halfword operand from stack instruction - DoLocateLocals */ +/* Returning. */ +.align 5 +.globl DoReturnMultiple +.ent DoReturnMultiple 0 +/* Halfword operand from stack instruction - DoReturnMultiple */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoReturnMultipleFP + .globl DoReturnMultipleSP + .globl DoReturnMultipleLP + .globl DoReturnMultipleIM +.align 3 +DoReturnMultiple: +#ifdef TRACING + .byte 0x88 + .asciiz "DoReturnMultipleSP" +#endif +.align 3 +DoReturnMultipleSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoReturnMultiple # [0di] + .byte 0x90 + .asciiz "DoReturnMultipleLP" +#endif +.align 3 +DoReturnMultipleLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoReturnMultiple # [1] + .byte 0x84 + .asciiz "DoReturnMultipleFP" +#endif +.align 3 +DoReturnMultipleFP: # Entry point for FP relative +.align 3 +beginDoReturnMultiple: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $1, 4($16) # Fetch the tag for type-check [2] + ldl $16, 0($16) # Fetch the data [1] + subq $1, TypeFixnum, $2 # [2di] + and $2, 63, $2 # Strip CDR code [1] + bne $2, RETURNMULTIPLEIO # [1] + extll $16, 0, $16 # Discard dtp-fixnum tag word [1-] +.align 3 +RETURNMULTIPLETOP: + ldl $20, PROCESSORSTATE_CONTROL($14) # [1-] + ldah $3, 12 # [0di] + addq $12, 8, $2 # [1] + sll $16, 3, $1 # Value bytes [1] + and $3, $20, $3 # Mask [1] + srl $3, 18, $3 # Shift disposition bits into place. [1] + subq $2, $1, $18 # Compute position of value(s) [1] + ldq $21, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + subq $3, 2, $19 # arg4 -2=effect -1=value 0=return 1=multiple [1-] + blt $19, RETURNMULTIPLESINGLE # [1] +/* Restore machine state from frame header. */ + ldl $3, 0($10) # [1-] + ldah $1, 1792 # [0di] + ldl $5, PROCESSORSTATE_CONTINUATION($14) # [1-] + and $20, $1, $1 # Mask [0di] + ldl $2, 4($10) # [1-] + bis $13, $31, $7 # [0di] + bne $1, HANDLEFRAMECLEANUP # Need to cleanup frame first [1-] + extll $3, 0, $3 # [0di] + ldl $4, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + extll $5, 0, $5 # [0di] +#ifdef IVERIFY +/* check for instruction verification suite end-of-test */ + subl $2, TypeNIL, $6 # check for end of run [1] + beq $6, G14200 # [1] +#endif + ldl $6, 8($10) # Get saved control register [1] +/* TagType. */ + and $2, 63, $2 # [0di] +/* Restore the PC. */ + beq $19, G14202 # [1-] + sll $5, 1, $9 # Assume even PC [0di] + and $4, 1, $1 # [1] + ldq $7, PROCESSORSTATE_CONTINUATIONCP($14) # [0di] + addq $9, $1, $9 # [1-] +.align 3 +G14202: +/* Restore the saved continuation */ + stl $2, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + srl $20, 9, $1 # Get the caller frame size into place [0di] + stl $3, PROCESSORSTATE_CONTINUATION($14) # [1-] + subq $10, 8, $12 # Restore the stack pointer. [0di] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [1-] + and $1, 255, $1 # Mask just the caller frame size. [0di] + s8addq $1, 0, $1 # *8 [1] + ldah $2, 2048 # [1] + and $2, $20, $2 # [1] + ldl $3, PROCESSORSTATE_INTERRUPTREG($14) # Get the preempt-pending bit [0di] + bis $2, $6, $6 # Sticky trace pending bit. [1-] + ldq $4, PROCESSORSTATE_PLEASE_STOP($14) # Get the trap/suspend bits [0di] + subq $10, $1, $10 # Restore the frame pointer. [1-] + stl $6, PROCESSORSTATE_CONTROL($14) # Restore the control register [0di] + and $6, 255, $1 # extract the argument size [1-] + and $3, 1, $3 # [1] + bis $4, $3, $3 # [1] + stq $3, PROCESSORSTATE_STOP_INTERPRETER($14) # [0di] + s8addq $1, $10, $11 # Restore the local pointer. [1-] + cmpult $10, $21, $21 # ARG6 = stack-cache underflow [1] + addq $12, 8, $4 # Compute destination of copy [1] + bis $16, $31, $3 # Values [1] + ldq $1, PROCESSORSTATE_CDRCODEMASK($14) # mask for CDR codes [1-] + br $31, G14203 # [1] +.align 3 +G14204: + subq $3, 1, $3 # [1-] + ldq $2, 0($18) # Get a word from source [0di] + addq $18, 8, $18 # advance from position [1] + bic $2, $1, $2 # Strip off CDR code [2] + stq $2, 0($4) # Put word in destination [1-] + addq $4, 8, $4 # advance to position [0di] +G14203: + bgt $3, G14204 # [1-] + s8addq $16, $12, $12 # Adjust iSP over returned values [0di] +/* arg4 -2=effect -1=value 0=return 1=multiple */ + beq $19, RETURNMULTIPLERETURN # [1-] +.align 3 +RETURNMULTIPLEMULTIPLE: + bis $31, TypeFixnum, $1 # [1-] + stl $16, 8($12) # push the MV return count [0di] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] +.align 3 +RETURNMULTIPLEDONE: + bne $21, RETURNMULTIPLEUNDERFLOW # [1-] + bis $7, $31, $17 # [0di] + bne $7, INTERPRETINSTRUCTIONPREDICTED # [1-] + bne $19, INTERPRETINSTRUCTIONFORBRANCH # [1] + br $31, INTERPRETINSTRUCTION # Return-multiple done [1] +.align 3 +RETURNMULTIPLEUNDERFLOW: + br $31, StackCacheUnderflowCheck +.align 3 +RETURNMULTIPLESINGLE: + ldq $18, 0($18) # [1] + ldq $1, PROCESSORSTATE_NILADDRESS($14) # [1] + sll $18, 26, $18 # Clear cdr [2-] + srl $18, 26, $18 # Clear cdr [2] + cmoveq $16, $1, $18 # [1] + br $31, RETURNCOMMONTAIL # [0di] +.align 3 +RETURNMULTIPLERETURN: + bne $17, RETURNMULTIPLEDONE # [1] + bis $31, TypeFixnum, $1 # [0di] + stl $16, 8($12) # [1-] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, RETURNMULTIPLEDONE # [0di] +#ifdef TRACING + br $31, DoReturnMultipleIM # [1] + .byte 0x82 + .asciiz "DoReturnMultipleIM" +#endif +.align 5 +.align 3 +DoReturnMultipleIM: # Entry point for IMMEDIATE mode + bis $17, $31, $16 # [1-] + lda $17, 1 # [1] + br $31, RETURNMULTIPLETOP # [1-] +.align 3 +RETURNMULTIPLEIO: + bis $31, 0, $20 # [1-] + bis $31, 63, $17 # [1] + br $31, ILLEGALOPERAND +.end DoReturnMultiple +/* End of Halfword operand from stack instruction - DoReturnMultiple */ +.align 5 +.globl HANDLEFRAMECLEANUP +.ent HANDLEFRAMECLEANUP 0 +.align 3 +HANDLEFRAMECLEANUP: + ldq $12, PROCESSORSTATE_RESTARTSP($14) # Restore SP to instruction start [1-] + ldl $20, PROCESSORSTATE_CONTROL($14) # Get control register [1] +.align 3 +G14207: + ldah $1, 1024 # [1-] + ldl $4, PROCESSORSTATE_CATCHBLOCK($14) # [0di] + extll $4, 0, $4 # [3] + and $1, $20, $2 # [1] + beq $2, G14206 # J. if cr.cleanup-catch is 0 [1] +/* Convert VMA to stack cache address */ + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $4, $2, $2 # stack cache base relative offset [2di] + s8addq $2, $3, $3 # reconstruct SCA [1] + ldl $6, 16($3) # [2] + ldl $5, 20($3) # [1] + extll $6, 0, $6 # [2di] + ldl $2, 8($3) # [1-] + ldl $1, 12($3) # [1] + extll $2, 0, $2 # [2-] + and $1, 64, $25 # [1] + bne $25, HANDLEUNWINDPROTECT # J. if catch block is UWP variety. [1] + ldah $3, 1024 # [0di] + and $5, 64, $2 # Extract the catchcleanup bit [1] + sll $2, 20, $2 # Shift into place for CR [1] + bic $20, $3, $3 # [1] + bis $3, $2, $20 # [1] + stl $20, PROCESSORSTATE_CONTROL($14) # [1-] +/* TagType. */ + and $5, 63, $5 # [0di] + sll $5, 32, $5 # [1] + bis $6, $5, $6 # [2] + stq $6, PROCESSORSTATE_CATCHBLOCK($14) # [1-] + br $31, G14207 # [1] +.align 3 +G14206: + ldah $1, 512 # [1-] + and $1, $20, $2 # [1] + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] + beq $2, G14205 # J. if cr.cleanup-bindings is 0. [0di] +#ifdef MINIMA +/* BSP not a locative -> Deep-bound */ + srl $1, 32, $4 # [3-] + subq $4, TypeLocative, $3 # [2] + and $3, 63, $3 # Strip CDR code [1] + bne $3, DBUNWINDFRAMETRAP # [1] +#endif +.align 3 +G14208: + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1-] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1] + extll $1, 0, $1 # vma only [2-] + ldah $2, 512 # [1] + subq $1, 1, $5 # [1] + and $4, $2, $3 # [1] + bic $4, $2, $4 # Turn off the bit [1] + bne $3, G14209 # [0di] + ldq $4, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] + bis $31, 0, $20 # [0di] + bis $31, 20, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14209: +/* Memory Read Internal */ +G14210: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $1, $14, $23 # [0di] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $23, $31, $6 # [0di] + ldq_u $7, 0($23) # [1-] + subq $1, $8, $8 # Stack cache offset [1di] + ldq $24, PROCESSORSTATE_BINDREAD_MASK($14) # [1-] + cmpult $8, $22, $22 # In range? [0di] + ldl $6, 0($6) # [1-] + extbl $7, $23, $7 # [0di] + bne $22, G14212 # [1-] +G14211: + lda $23, 224 # [0di] + srl $24, $7, $24 # [1] + srl $23, $7, $23 # [1] + blbs $24, G14214 # [1-] +G14219: +/* Memory Read Internal */ +G14220: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $5, $14, $23 # [1-] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $2 # [1-] + ldq_u $3, 0($23) # [1di] + subq $5, $8, $8 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_BINDREAD_MASK($14) # [0di] + cmpult $8, $22, $22 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $3, $23, $3 # [1-] + bne $22, G14222 # [0di] +G14221: + lda $23, 224 # [1-] + srl $24, $3, $24 # [1] + srl $23, $3, $23 # [1] + extll $2, 0, $2 # [1] + blbs $24, G14224 # [1-] +G14229: +/* Memory Read Internal */ +G14230: + ldq $23, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $2, $14, $25 # [1-] + ldl $24, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $25, $31, $22 # [1-] + ldq_u $8, 0($25) # [1di] + subq $2, $23, $23 # Stack cache offset [1-] + cmpult $23, $24, $24 # In range? [1] + ldl $22, 0($22) # [1-] + extbl $8, $25, $8 # [0di] + bne $24, G14232 # [1-] +G14231: + ldq $23, PROCESSORSTATE_BINDWRITE_MASK($14) # [0di] + lda $25, 224 # [1-] + srl $23, $8, $23 # [2] + srl $25, $8, $25 # [1] + blbs $23, G14234 # [1di] +G14239: +/* Merge cdr-code */ + and $7, 63, $22 # [1-] + and $8, 192, $8 # [1] + bis $8, $22, $8 # [1] + addq $2, $14, $23 # [1] + s4addq $23, $31, $22 # [1] + ldq_u $25, 0($23) # [1di] + insbl $8, $23, $24 # [1-] + mskbl $25, $23, $25 # [2] +.align 3 +G14242: + bis $25, $24, $25 # [2] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + stq_u $25, 0($23) # [1] + ldl $23, PROCESSORSTATE_SCOVLIMIT($14) # [1] + subq $2, $24, $24 # Stack cache offset [1-] + cmpult $24, $23, $23 # In range? [2] + stl $6, 0($22) # [1-] + bne $23, G14241 # J. if in cache [1] +G14240: + and $3, 64, $3 # Get the old cleanup-bindings bit [1-] + sll $3, 19, $3 # [1] + subq $1, 2, $1 # [1] + stl $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # vma only [0di] + bis $4, $3, $4 # [1-] + stl $4, PROCESSORSTATE_CONTROL($14) # [0di] + ldl $20, PROCESSORSTATE_CONTROL($14) # [1] + ldah $1, 512 # [0di] + and $1, $20, $2 # [3] + bne $2, G14208 # J. if cr.cleanup-bindings is 0. [1] + ldl $2, PROCESSORSTATE_INTERRUPTREG($14) # [1] + and $2, 2, $3 # [3] + cmpeq $3, 2, $3 # [1] + bis $2, $3, $2 # [2] + stl $2, PROCESSORSTATE_INTERRUPTREG($14) # [1-] + beq $2, G14243 # [1] + stq $2, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] +.align 3 +G14243: +.align 3 +G14205: + ldah $3, 256 # [1-] + and $3, $20, $2 # [1] + beq $2, INTERPRETINSTRUCTION # [1] + bis $31, $31, $20 # [0di] + bis $31, 79, $17 # [1] + br $31, ILLEGALOPERAND + br $31, INTERPRETINSTRUCTION # Retry the instruction [0di] +.align 3 +G14241: + ldq $23, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $24, $23, $23 # reconstruct SCA [3] + stl $6, 0($23) # Store in stack [2] + stl $8, 4($23) # write the stack cache [1] + br $31, G14240 # [1] +.align 3 +G14232: + ldq $24, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $23, $24, $23 # reconstruct SCA [3] + ldl $22, 0($23) # [2] + ldl $8, 4($23) # Read from stack cache [1] + br $31, G14231 # [1] +.align 3 +G14234: + blbc $25, G14233 # [1] + extll $22, 0, $2 # Do the indirect thing [0di] + br $31, G14230 # [1-] +.align 3 +G14233: + ldq $23, PROCESSORSTATE_BINDWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $8, 63, $25 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $25, $23, $25 # Adjust for a longword load [2di] + ldl $23, 0($25) # Get the memory action [2] +G14236: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 3, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14222: + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $22, $8 # reconstruct SCA [3] + ldl $2, 0($8) # [2] + ldl $3, 4($8) # Read from stack cache [1] + br $31, G14221 # [1] +.align 3 +G14224: + blbc $23, G14223 # [1] + extll $2, 0, $5 # Do the indirect thing [0di] + br $31, G14220 # [1-] +.align 3 +G14223: + ldq $24, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $3, 63, $23 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +G14226: +/* Perform memory action */ + bis $31, $24, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14212: + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $22, $8 # reconstruct SCA [3] + ldl $6, 0($8) # [2] + ldl $7, 4($8) # Read from stack cache [1] + br $31, G14211 # [1] +.align 3 +G14214: + blbc $23, G14213 # [1] + extll $6, 0, $1 # Do the indirect thing [0di] + br $31, G14210 # [1-] +.align 3 +G14213: + ldq $24, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $7, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +G14216: +/* Perform memory action */ + bis $31, $24, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.end HANDLEFRAMECLEANUP +.align 5 +.globl StackCacheUnderflowCheck +.ent StackCacheUnderflowCheck 0 +.align 3 +StackCacheUnderflowCheck: + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + ldq $4, PROCESSORSTATE_RESTARTSP($14) # Preserve through instruction's original SP [1] + subq $1, $10, $3 # Number of words*8 to fill iff positive [2-] + ble $3, INTERPRETINSTRUCTIONFORBRANCH # [1] + sra $3, 3, $3 # Convert to a word count [1] + addq $4, 8, $4 # Account for the inclusive limit [1] + ble $3, INTERPRETINSTRUCTIONFORBRANCH # in case only low three bits nonzero [1-] + bsr $0, StackCacheUnderflow + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end StackCacheUnderflowCheck +.align 5 +.globl StackCacheUnderflow +.ent StackCacheUnderflow 0 +.align 3 +StackCacheUnderflow: + s8addq $3, $1, $2 # Compute target address for shift [1-] + subq $4, $1, $5 # Compute number of elements to preserve [1] + sra $5, 3, $5 # Convert to word count [1] +/* Shove everything up */ + s8addq $5, $1, $1 # Adjust to end of source block [2] + s8addq $5, $2, $2 # Adjust to end of target block [1] + br $31, G14244 # [0di] +.align 3 +G14245: + subq $1, 8, $1 # advance from position [1-] + subq $5, 1, $5 # [1] + ldq $7, 0($1) # Get a word from source [1-] + subq $2, 8, $2 # advance to position [0di] + stq $7, 0($2) # Put word in destination [2] +G14244: + bgt $5, G14245 # [1] +/* Adjust stack cache relative registers */ + s8addq $3, $10, $10 # [1-] + ldq $4, PROCESSORSTATE_RESTARTSP($14) # [0di] + s8addq $3, $12, $12 # [1-] + s8addq $3, $11, $11 # [1] + s8addq $3, $4, $4 # [1] +/* Fill freshly opened slots of stack cache from memory */ + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + stq $4, PROCESSORSTATE_RESTARTSP($14) # [1] + subq $1, $3, $1 # Compute new base address of stack cache [1-] + ldq $4, PROCESSORSTATE_STACKCACHETOPVMA($14) # Top of cache [0di] + stq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $4, $3, $4 # Adjust top of cache [2di] + stq $4, PROCESSORSTATE_STACKCACHETOPVMA($14) # [1-] + addq $1, $14, $7 # [0di] + s4addq $7, $31, $5 # [1] + fetch 0($7) # [1di] + ldq_u $4, 0($7) # [1] + fetch 0($5) # [1] + ldl $5, 0($5) # [1] + extbl $4, $7, $4 # [1di] + br $31, G14246 # [1-] +.align 3 +G14247: + addq $1, $14, $7 # [1-] + s4addq $7, $31, $5 # [1] + ldq_u $4, 0($7) # [1-] + ldl $5, 0($5) # [1] + extbl $4, $7, $4 # [2-] + subq $3, 1, $3 # [1] + addq $1, 1, $1 # advance vma position [1] + stl $5, 0($2) # [0di] + stl $4, 4($2) # write the stack cache [1] + addq $2, 8, $2 # advance sca position [0di] +G14246: + bgt $3, G14247 # [1-] +#ifdef TRACING +/* Trace instructions if requested. */ + ldq $4, PROCESSORSTATE_TRACE_HOOK($14) # [0di] + beq $4, G14252 # J. if not tracing. [3] +/* Record an instruction trace entry */ + ldl $5, TRACEDATA_RECORDING_P($4) # [0di] + ldq $1, TRACEDATA_START_PC($4) # [1] + bne $5, G14248 # Jump if recording is on [2di] + cmpeq $1, $9, $1 # Turn recording on if at the start PC [1-] + stl $1, TRACEDATA_RECORDING_P($4) # [0di] + beq $1, G14252 # Jump if not at the start PC [1] +.align 3 +G14248: + ldq $5, TRACEDATA_CURRENT_ENTRY($4) # Get address of next trace record [1-] + ldq $1, PROCESSORSTATE_INSTRUCTION_COUNT($14) # [1] + stq $9, TRACERECORD_EPC($5) # Save current PC [2] + stq $1, TRACERECORD_COUNTER($5) # Save instruction count [1] + ldq $1, 0($12) # [1] +/* Convert stack cache address to VMA */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $3, $3 # stack cache base relative offset [2di] + srl $3, 3, $3 # convert byte address to word address [1] + addq $3, $2, $2 # reconstruct VMA [2] + stq $1, TRACERECORD_TOS($5) # Save current value of TOS [1-] + stq $2, TRACERECORD_SP($5) # Save current SP [1] + ldl $1, CACHELINE_OPERAND($13) # [1] + ldq $2, CACHELINE_CODE($13) # [1] + stl $1, TRACERECORD_OPERAND($5) # Save current instruction's operand [1] + stq $2, TRACERECORD_INSTRUCTION($5) # Save pointer to current instruction code [1] + ldq $2, PROCESSORSTATE_CONTROL($14) # [1] + ldq $3, CACHELINE_INSTRUCTION($13) # [1] + stl $31, TRACERECORD_CATCH_BLOCK_P($5) # We don't yet record catch blocks [1] + stq $2, TRACERECORD_CATCH_BLOCK_0($5) # Save control register [1] + ldq $1, PROCESSORSTATE_TVI($14) # [1] + stq $3, TRACERECORD_INSTRUCTION_DATA($5) # Save full word instruction operand [1] + stl $1, TRACERECORD_TRAP_P($5) # Save trap indiciator [1] + beq $1, G14249 # Jump if didn't trap [1] + ldq $1, 16($10) # [1] + stq $31, PROCESSORSTATE_TVI($14) # Zero flag to avoid false trap entries [1] + ldq $2, 24($10) # [1] + stq $1, TRACERECORD_TRAP_DATA_0($5) # Save trap vector index [1] + ldq $3, 32($10) # [1] + stq $2, TRACERECORD_TRAP_DATA_1($5) # Save fault PC [1] + ldq $6, 40($10) # [1] + stq $3, TRACERECORD_TRAP_DATA_2($5) # Save two additional arguments [1] + stq $6, TRACERECORD_TRAP_DATA_3($5) # [1] +.align 3 +G14249: + addq $5, TRACERECORDSIZE, $5 # Bump to next trace record [1-] + ldq $1, TRACEDATA_RECORDS_START($4) # Get pointer to start of trace records [0di] + stq $5, TRACEDATA_CURRENT_ENTRY($4) # Set record pointer to keep printer happy [1] + ldq $2, TRACEDATA_RECORDS_END($4) # Get pointer to end of trace record [1] + ldq $3, TRACEDATA_PRINTER($4) # Function to print trace if non-zero [1] + cmple $2, $5, $2 # Non-zero iff we're about to wrap the circular buffer [2di] + cmovne $2, $1, $5 # Update next record pointer iff we wrapped [2] + cmoveq $2, $31, $3 # Don't print if we didn't wrap [1] + beq $3, G14250 # Jump if we don't need to print [2] + stq $13, PROCESSORSTATE_CP($14) # [1] + stq $9, PROCESSORSTATE_EPC($14) # [1] + stq $12, PROCESSORSTATE_SP($14) # [1] + stq $10, PROCESSORSTATE_FP($14) # [1] + stq $11, PROCESSORSTATE_LP($14) # [1] + stq $16, PROCESSORSTATE_ASRF2($14) # [1] + stq $17, PROCESSORSTATE_ASRF3($14) # [1] + stq $18, PROCESSORSTATE_ASRF4($14) # [1] + stq $19, PROCESSORSTATE_ASRF5($14) # [1] + stq $20, PROCESSORSTATE_ASRF6($14) # [1] + stq $21, PROCESSORSTATE_ASRF7($14) # [1] + stq $4, PROCESSORSTATE_ASRF8($14) # [1] + stq $5, PROCESSORSTATE_ASRF9($14) # [1] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + bis $3, $31, $27 # [1-] + jsr $26, ($3), 0 # [0di] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + ldq $16, PROCESSORSTATE_ASRF2($14) # [1] + ldq $17, PROCESSORSTATE_ASRF3($14) # [1] + ldq $18, PROCESSORSTATE_ASRF4($14) # [1] + ldq $19, PROCESSORSTATE_ASRF5($14) # [1] + ldq $20, PROCESSORSTATE_ASRF6($14) # [1] + ldq $21, PROCESSORSTATE_ASRF7($14) # [1] + ldq $4, PROCESSORSTATE_ASRF8($14) # [1] + ldq $5, PROCESSORSTATE_ASRF9($14) # [1] + ldq $13, PROCESSORSTATE_CP($14) # [1] + ldq $9, PROCESSORSTATE_EPC($14) # [1] + ldq $12, PROCESSORSTATE_SP($14) # [1] + ldq $10, PROCESSORSTATE_FP($14) # [1] + ldq $11, PROCESSORSTATE_LP($14) # [1] + bis $31, $31, $2 # Claim we didn't wrap [0di] +.align 3 +G14250: + stq $5, TRACEDATA_CURRENT_ENTRY($4) # Save next record pointer [1-] + beq $2, G14251 # Jump if we didn't wrap [1] + stl $2, TRACEDATA_WRAP_P($4) # Set flag indicating that we wrapped [1] +.align 3 +G14251: + ldq $5, TRACEDATA_STOP_PC($4) # [1] + cmpeq $5, $9, $5 # Non-zero if at PC where we should stop tracing [3] + cmpeq $5, 0, $5 # Non-zero if not at the PC [2] + stl $5, TRACEDATA_RECORDING_P($4) # Update recording flag [0di] +.align 3 +G14252: +#endif + ret $31, ($0), 1 # [1] +.end StackCacheUnderflow +.align 5 +.globl StackCacheOverflowHandler +.ent StackCacheOverflowHandler 2 +.align 3 +StackCacheOverflowHandler: +/* Stack cache overflow detected */ + lda $1, 256 # [3] + addq $1, $17, $1 # Account for what we're about to push [1] + s8addq $1, $12, $1 # SCA of desired end of cache [1] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # [1] + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1] + subq $1, $4, $4 # New limit*8 [3] + srl $4, 3, $4 # [1] + stl $4, PROCESSORSTATE_SCOVLIMIT($14) # Update stack cache limit [0di] +/* Check that the page underlying the end of the stack cache is accessible */ +/* Convert stack cache address to VMA */ + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $1, $4, $4 # stack cache base relative offset [2-] + srl $4, 3, $4 # convert byte address to word address [1] + addq $4, $3, $3 # reconstruct VMA [2] + ldq $5, PROCESSORSTATE_VMATTRIBUTETABLE($14) # Per-page attributes table [0di] + srl $3, MemoryPageAddressShift, $4 # Index into the attributes table [1-] + addq $4, $5, $5 # Address of the page's attributes [2] + ldq_u $4, 0($5) # Get the quadword with the page's attributes [2] + stq $3, PROCESSORSTATE_VMA($14) # Stash the VMA [1] + extbl $4, $5, $4 # Extract the page's attributes [2-] + beq $4, PAGENOTRESIDENT # Non-existent page [2] + and $4, VMAttributeAccessFault, $5 # [1-] + bne $5, PAGEFAULTREQUESTHANDLER # Access fault [1] + and $4, VMAttributeWriteFault, $5 # [1] + bne $5, PAGEWRITEFAULT # Write fault [1] +/* Check if we must dump the cache */ + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # New stack cache limit (words) [1-] + ldq $5, PROCESSORSTATE_STACKCACHESIZE($14) # Absolute size of the cache (words) [1] + cmple $4, $5, $5 # [3] + bne $5, INTERPRETINSTRUCTION # We're done if new limit is less than absolute limit [1] +/* Dump the stack cache to make room */ + lda $1, 896 # [1-] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Stack cache base VMA [0di] + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1] + stl $1, PROCESSORSTATE_SCOVDUMPCOUNT($14) # Will be destructively modified [1] + addq $2, $14, $5 # Starting address of tags [1-] + s4addq $5, $31, $2 # Starting address of data [1] +/* Dump the data */ + fetch 0($3) # [1-] + fetch_m 0($2) # [1] + br $31, G14253 # [1] +.align 3 +G14254: + ldl $4, 0($3) # Get data word [1] + subq $1, 1, $1 # [0di] + addq $3, 8, $3 # Advance SCA position [1] + stl $4, 0($2) # Save data word [0di] + addq $2, 4, $2 # Advance VMA position [1-] +G14253: + bgt $1, G14254 # [0di] +/* Dump the tags */ + ldl $1, PROCESSORSTATE_SCOVDUMPCOUNT($14) # Restore the count [1] + bis $31, $5, $2 # Restore tag VMA [0di] + sll $1, 3, $4 # [3] + subq $3, $4, $3 # Restore orginal SCA [2] + fetch 0($3) # [2] + fetch_m 0($2) # [1] + br $31, G14255 # [1] +.align 3 +G14256: + subq $1, 1, $1 # [1-] + ldl $4, 4($3) # Get tag word [0di] + addq $3, 8, $3 # Advance SCA position [1] + ldq_u $5, 0($2) # Get packed tags word [0di] + insbl $4, $2, $4 # Position the new tag [2-] + mskbl $5, $2, $5 # Remove old tag [1] + bis $4, $5, $5 # Put in new byte [2] + stq_u $5, 0($2) # Save packed tags word [0di] + addq $2, 1, $2 # Advance VMA position [1-] +G14255: + bgt $1, G14256 # [0di] + lda $1, 896 # [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Stack cache base VMA [0di] + ldq $4, PROCESSORSTATE_STACKCACHETOPVMA($14) # Top of cache [1] + ldl $5, PROCESSORSTATE_SCOVLIMIT($14) # Cache limit in words [1] + addq $2, $1, $2 # Adjust cache base VMA [1-] + addq $4, $1, $4 # Adjust top of cache [1] + subq $5, $1, $5 # Adjust limit [1] + stq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Save update [0di] + stq $4, PROCESSORSTATE_STACKCACHETOPVMA($14) # [1] + stl $5, PROCESSORSTATE_SCOVLIMIT($14) # [1] +/* Move the cache down */ + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1] + s8addq $1, $3, $2 # SCA of first word of new base [3] + br $31, G14257 # [1-] +.align 3 +G14258: + subq $1, 1, $1 # [1-] + ldq $5, 0($2) # Get a word from source [0di] + addq $2, 8, $2 # advance from position [1] + stq $5, 0($3) # Put word in destination [0di] + addq $3, 8, $3 # advance to position [1-] +G14257: + bgt $1, G14258 # [0di] +/* Adjust stack cache relative registers */ + lda $1, 896 # [1] + sll $1, 3, $1 # Convert to SCA adjustment [1] + subq $12, $1, $12 # [2] + subq $10, $1, $10 # [1] + subq $11, $1, $11 # [1] + stq $12, PROCESSORSTATE_RESTARTSP($14) # [0di] + br $31, INTERPRETINSTRUCTION # [1] +.end StackCacheOverflowHandler +.align 5 +.globl DoReturnKludge +.ent DoReturnKludge 0 +/* Halfword operand from stack instruction - DoReturnKludge */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoReturnKludgeFP + .globl DoReturnKludgeSP + .globl DoReturnKludgeLP + .globl DoReturnKludgeIM +.align 3 +DoReturnKludge: +#ifdef TRACING + .byte 0x88 + .asciiz "DoReturnKludgeSP" +#endif +.align 3 +DoReturnKludgeSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoReturnKludge # [0di] + .byte 0x90 + .asciiz "DoReturnKludgeLP" +#endif +.align 3 +DoReturnKludgeLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoReturnKludge # [1] + .byte 0x84 + .asciiz "DoReturnKludgeFP" +#endif +.align 3 +DoReturnKludgeFP: # Entry point for FP relative +.align 3 +beginDoReturnKludge: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $1, 4($16) # [2] + ldl $17, 0($16) # [1] + subq $1, TypeFixnum, $2 # [2di] + and $2, 63, $2 # Strip CDR code [1] + bne $2, RETURNKLUDGEIO # [1] + extll $17, 0, $17 # [1-] +#ifdef TRACING + br $31, DoReturnKludgeIM # [0di] + .byte 0x82 + .asciiz "DoReturnKludgeIM" +#endif +.align 5 +.align 3 +DoReturnKludgeIM: # Entry point for IMMEDIATE mode + ldq $21, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8subq $17, 8, $1 # [1di] + ldl $2, PROCESSORSTATE_CONTROL($14) # [1-] + subq $12, $1, $1 # t1 is the values block [0di] +/* Restore machine state from frame header. */ + ldl $5, 0($10) # [1-] + ldah $3, 1792 # [0di] + ldl $7, PROCESSORSTATE_CONTINUATION($14) # [1-] + and $2, $3, $3 # Mask [1di] + ldl $4, 4($10) # [1-] + bis $13, $31, $22 # [0di] + bne $3, RETURNKLUDGECLEANUP # Need to cleanup frame first [1-] + extll $5, 0, $5 # [0di] + ldl $6, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + extll $7, 0, $7 # [0di] +#ifdef IVERIFY +/* check for instruction verification suite end-of-test */ + subl $4, TypeNIL, $8 # check for end of run [1] + beq $8, G14259 # [1] +#endif + ldl $8, 8($10) # Get saved control register [1] +/* TagType. */ + and $4, 63, $4 # [0di] +/* Restore the PC. */ + sll $7, 1, $9 # Assume even PC [1] + and $6, 1, $3 # [1] + ldq $22, PROCESSORSTATE_CONTINUATIONCP($14) # [1-] + addq $9, $3, $9 # [0di] +.align 3 +G14261: +/* Restore the saved continuation */ + stl $4, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + srl $2, 9, $3 # Get the caller frame size into place [0di] + stl $5, PROCESSORSTATE_CONTINUATION($14) # [1-] + subq $10, 8, $12 # Restore the stack pointer. [0di] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [1-] + and $3, 255, $3 # Mask just the caller frame size. [0di] + s8addq $3, 0, $3 # *8 [1] + ldah $4, 2048 # [1] + and $4, $2, $4 # [1] + ldl $5, PROCESSORSTATE_INTERRUPTREG($14) # Get the preempt-pending bit [0di] + bis $4, $8, $8 # Sticky trace pending bit. [1-] + ldq $6, PROCESSORSTATE_PLEASE_STOP($14) # Get the trap/suspend bits [0di] + subq $10, $3, $10 # Restore the frame pointer. [1-] + stl $8, PROCESSORSTATE_CONTROL($14) # Restore the control register [0di] + and $8, 255, $3 # extract the argument size [1-] + and $5, 1, $5 # [1] + bis $6, $5, $5 # [1] + stq $5, PROCESSORSTATE_STOP_INTERPRETER($14) # [0di] + s8addq $3, $10, $11 # Restore the local pointer. [1-] + cmpult $10, $21, $21 # ARG6 = stack-cache underflow [1] + beq $17, RKLOOPDONE # [1-] +.align 3 +RKLOOPTOP: + ldq $4, 0($1) # Read a 40 bit word from the values block [1-] + subq $17, 1, $17 # [0di] + stq $4, 8($12) # Push value onto stack cdr codes and all [1-] + addq $1, 8, $1 # [0di] + addq $12, 8, $12 # [1] + bgt $17, RKLOOPTOP # [0di] +.align 3 +RKLOOPDONE: + bne $21, RETURNKLUDGEUNDERFLOW # [1] + beq $22, INTERPRETINSTRUCTIONFORBRANCH # No prediction, validate cache [1] + fetch 0($22) # [1-] + bis $22, $31, $13 # [0di] + br $31, INTERPRETINSTRUCTION # [1-] +.align 3 +RETURNKLUDGEIO: + bis $31, 0, $20 # [1-] + bis $31, 63, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +RETURNKLUDGECLEANUP: + br $31, HANDLEFRAMECLEANUP +.align 3 +RETURNKLUDGEUNDERFLOW: + br $31, StackCacheUnderflowCheck +.end DoReturnKludge +/* End of Halfword operand from stack instruction - DoReturnKludge */ +.align 5 +.globl DoTakeValues +.ent DoTakeValues 0 +/* Halfword operand from stack instruction - DoTakeValues */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoTakeValuesFP + .globl DoTakeValuesSP + .globl DoTakeValuesLP + .globl DoTakeValuesIM +.align 3 +DoTakeValues: +#ifdef TRACING + .byte 0x82 + .asciiz "DoTakeValuesIM" +#endif +.align 3 +DoTakeValuesIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoTakeValues # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoTakeValuesSP" +#endif +.align 3 +DoTakeValuesSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoTakeValues # [0di] + .byte 0x90 + .asciiz "DoTakeValuesLP" +#endif +.align 3 +DoTakeValuesLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoTakeValues # [1] + .byte 0x84 + .asciiz "DoTakeValuesFP" +#endif +.align 3 +DoTakeValuesFP: # Entry point for FP relative +.align 3 +headDoTakeValues: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoTakeValues: +/* arg1 has the operand, not sign extended if immediate. */ + ldq $21, PROCESSORSTATE_NILADDRESS($14) # [1] + extll $16, 0, $16 # Number of values expected [2di] + ldl $19, 0($12) # Number of values provided [1-] + ldl $18, 4($12) # Number of values provided [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + subq $16, $19, $17 # [2] + blt $17, TAKEVALUESLOSE # J. if too many args supplied [1] + bgt $17, TAKEVALUESPAD # J. if too few values supplied [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +TAKEVALUESLOSE: + s8addq $17, $12, $12 # Remove the unwanted values [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +TAKEVALUESPAD: + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # Current stack cache limit (words) [1] + lda $1, 128 # [0di] + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1-] + addq $1, $17, $1 # Account for what we're about to push [0di] + s8addq $1, $12, $1 # SCA of desired end of cache [1] + s8addq $4, $2, $2 # SCA of current end of cache [2] + cmple $1, $2, $4 # [1] + beq $4, StackCacheOverflowHandler # We're done if new SCA is within bounds [1] +.align 3 +TAKEVALUESPADLOOP: + stq $21, 8($12) # Push NIL [1] + addq $12, 8, $12 # [0di] + subq $17, 1, $17 # [1] + bgt $17, TAKEVALUESPADLOOP # [1] + br $31, NEXTINSTRUCTION # [1] +.end DoTakeValues +/* End of Halfword operand from stack instruction - DoTakeValues */ +/* Catch Instructions */ +.align 5 +.globl DoCatchOpen +.ent DoCatchOpen 0 +/* Halfword 10 bit immediate instruction - DoCatchOpen */ + .globl DoCatchOpenFP + .globl DoCatchOpenSP + .globl DoCatchOpenLP + .globl DoCatchOpenIM +.align 3 +DoCatchOpen: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoCatchOpen" +#endif +.align 3 +DoCatchOpenIM: +.align 3 +DoCatchOpenSP: +.align 3 +DoCatchOpenLP: +.align 3 +DoCatchOpenFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + and $16, 1, $23 # t10=1 if unwind-protect, t10=0 if catch [2] + ldl $3, PROCESSORSTATE_CATCHBLOCK+4($14) # tag [1-] + sll $23, 38, $23 # [0di] + ldl $4, PROCESSORSTATE_CATCHBLOCK($14) # data [1-] + ldq $2, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] +/* Convert stack cache address to VMA */ + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $22, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $1, $1 # stack cache base relative offset [2-] + srl $1, 3, $1 # convert byte address to word address [1] + addq $1, $22, $22 # reconstruct VMA [2] + bis $23, $2, $1 # [1] + stq $1, 8($12) # [1-] + addq $12, 8, $12 # [0di] + ldl $24, PROCESSORSTATE_CONTROL($14) # [1-] + srl $24, 20, $2 # Get old cleanup catch bit [3] + and $2, 64, $2 # [2] + srl $24, 1, $1 # Get old extra arg bit [1] + and $1, 128, $1 # [2] + bis $1, $2, $1 # [1] +/* TagType. */ + and $3, 63, $2 # [1] + bis $1, $2, $1 # T1 now has new tag [1] + stl $4, 8($12) # [1-] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + bne $23, CATCHOPEN2 # [0di] + ldl $2, PROCESSORSTATE_CONTINUATION($14) # [1-] + ldl $1, PROCESSORSTATE_CONTINUATION+4($14) # [1] + extll $2, 0, $2 # [2-] +/* TagType. */ + and $1, 63, $1 # [1] + and $16, 192, $3 # T3 has the disposition bits in place [1] + bis $1, $3, $1 # [1] + stl $2, 8($12) # [1-] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] +.align 3 +CATCHOPEN2: + bis $31, TypeLocative, $1 # [1] + stl $1, PROCESSORSTATE_CATCHBLOCK+4($14) # tag [0di] + stl $22, PROCESSORSTATE_CATCHBLOCK($14) # data [1] + ldah $1, 1024 # [0di] + bis $1, $24, $1 # set it [1] + stl $1, PROCESSORSTATE_CONTROL($14) # [0di] + br $31, NEXTINSTRUCTION # [1] +.end DoCatchOpen +/* End of Halfword operand from stack instruction - DoCatchOpen */ +.align 5 +.globl DoCatchClose +.ent DoCatchClose 0 +/* Halfword operand from stack instruction - DoCatchClose */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoCatchCloseFP + .globl DoCatchCloseSP + .globl DoCatchCloseLP + .globl DoCatchCloseIM +.align 3 +DoCatchClose: +#ifdef TRACING + .byte 0x88 + .asciiz "DoCatchCloseSP" +#endif +.align 3 +DoCatchCloseSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoCatchClose # [0di] + .byte 0x90 + .asciiz "DoCatchCloseLP" +#endif +.align 3 +DoCatchCloseLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoCatchClose # [1] + .byte 0x84 + .asciiz "DoCatchCloseFP" +#endif +.align 3 +DoCatchCloseFP: # Entry point for FP relative +.align 3 +beginDoCatchClose: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $1, PROCESSORSTATE_CATCHBLOCK($14) # data [0di] + extll $1, 0, $1 # [3] +/* Convert VMA to stack cache address */ + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldq $23, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $3, $3 # stack cache base relative offset [2di] + s8addq $3, $23, $23 # reconstruct SCA [1] + ldl $19, 8($23) # bstag bsdata [2] + ldl $18, 12($23) # [1] + extll $19, 0, $19 # [2di] + ldq $4, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1-] + ldl $21, 16($23) # prtag prdata [1] + ldl $20, 20($23) # [1] + extll $21, 0, $21 # [2di] + srl $4, 32, $3 # [1] + subl $19, $4, $5 # [1] + beq $5, CATCHCLOSELD # [1] + subq $3, TypeLocative, $1 # [0di] + and $1, 63, $1 # Strip CDR code [1] + bne $1, CATCHCLOSEDBT # [1] +.align 3 +CATCHCLOSELT: + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1] + extll $1, 0, $1 # vma only [2-] + ldah $2, 512 # [1] + subq $1, 1, $5 # [1] + and $4, $2, $3 # [1] + bic $4, $2, $4 # Turn off the bit [1] + bne $3, G14263 # [0di] + ldq $4, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] + bis $31, 0, $20 # [0di] + bis $31, 20, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14263: +/* Memory Read Internal */ +G14264: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $1, $14, $16 # [0di] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $16, $31, $6 # [0di] + ldq_u $7, 0($16) # [1-] + subq $1, $8, $8 # Stack cache offset [1di] + ldq $17, PROCESSORSTATE_BINDREAD_MASK($14) # [1-] + cmpult $8, $22, $22 # In range? [0di] + ldl $6, 0($6) # [1-] + extbl $7, $16, $7 # [0di] + bne $22, G14266 # [1-] +G14265: + lda $16, 224 # [0di] + srl $17, $7, $17 # [1] + srl $16, $7, $16 # [1] + blbs $17, G14268 # [1-] +G14273: +/* Memory Read Internal */ +G14274: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $5, $14, $16 # [1-] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $16, $31, $2 # [1-] + ldq_u $3, 0($16) # [1di] + subq $5, $8, $8 # Stack cache offset [1-] + ldq $17, PROCESSORSTATE_BINDREAD_MASK($14) # [0di] + cmpult $8, $22, $22 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $3, $16, $3 # [1-] + bne $22, G14276 # [0di] +G14275: + lda $16, 224 # [1-] + srl $17, $3, $17 # [1] + srl $16, $3, $16 # [1] + extll $2, 0, $2 # [1] + blbs $17, G14278 # [1-] +G14283: +/* Memory Read Internal */ +G14284: + ldq $16, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $2, $14, $24 # [1-] + ldl $17, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $24, $31, $22 # [1-] + ldq_u $8, 0($24) # [1di] + subq $2, $16, $16 # Stack cache offset [1-] + cmpult $16, $17, $17 # In range? [1] + ldl $22, 0($22) # [1-] + extbl $8, $24, $8 # [0di] + bne $17, G14286 # [1-] +G14285: + ldq $16, PROCESSORSTATE_BINDWRITE_MASK($14) # [0di] + lda $24, 224 # [1-] + srl $16, $8, $16 # [2] + srl $24, $8, $24 # [1] + blbs $16, G14288 # [1di] +G14293: +/* Merge cdr-code */ + and $7, 63, $22 # [1-] + and $8, 192, $8 # [1] + bis $8, $22, $8 # [1] + addq $2, $14, $16 # [1] + s4addq $16, $31, $22 # [1] + ldq_u $24, 0($16) # [1di] + insbl $8, $16, $17 # [1-] + mskbl $24, $16, $24 # [2] +.align 3 +G14296: + bis $24, $17, $24 # [2] + ldq $17, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + stq_u $24, 0($16) # [1] + ldl $16, PROCESSORSTATE_SCOVLIMIT($14) # [1] + subq $2, $17, $17 # Stack cache offset [1-] + cmpult $17, $16, $16 # In range? [2] + stl $6, 0($22) # [1-] + bne $16, G14295 # J. if in cache [1] +G14294: + and $3, 64, $3 # Get the old cleanup-bindings bit [1-] + sll $3, 19, $3 # [1] + subq $1, 2, $1 # [1] + stl $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # vma only [0di] + bis $4, $3, $4 # [1-] + stl $4, PROCESSORSTATE_CONTROL($14) # [0di] + subl $19, $1, $5 # [1-] + bne $5, CATCHCLOSELT # [1] + ldl $3, PROCESSORSTATE_INTERRUPTREG($14) # [1-] + and $3, 2, $4 # [3] + cmpeq $4, 2, $4 # [1] + bis $3, $4, $3 # [2] + stl $3, PROCESSORSTATE_INTERRUPTREG($14) # [1-] + beq $3, G14297 # [1] + stq $3, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] +.align 3 +G14297: +.align 3 +CATCHCLOSELD: +/* TagType. */ + and $20, 63, $1 # [1-] + stl $1, PROCESSORSTATE_CATCHBLOCK+4($14) # tag [0di] + and $20, 128, $2 # extra argument bit [1-] + ldq $6, PROCESSORSTATE_EXTRAANDCATCH($14) # mask for two bits [0di] + sll $2, 1, $2 # position in place for control register. [1-] + stl $21, PROCESSORSTATE_CATCHBLOCK($14) # data [0di] + and $20, 64, $3 # cleanup catch bit [1-] + sll $3, 20, $3 # position in place for cr [1] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1-] + bis $2, $3, $5 # coalesce the two bits [1di] + bic $4, $6, $4 # Turn off extra-arg and cleanup-catch [2] + bis $4, $5, $4 # Maybe turn them back on [1] + stl $4, PROCESSORSTATE_CONTROL($14) # [1-] + and $18, 64, $6 # uwp bit [0di] + beq $6, NEXTINSTRUCTION # [1] +/* Handle unwind-protect cleanup here */ + ldl $17, 0($23) # pctag pcdata [0di] + ldl $16, 4($23) # [1] + extll $17, 0, $17 # [2di] + srl $4, 17, $8 # Cleanup in progress bit into cdr code pos [1] + addq $9, 1, $7 # Next PC [1] +/* Convert PC to a real continuation. */ + and $7, 1, $8 # [1] + srl $7, 1, $23 # convert PC to a real word address. [1] + lda $8, TypeEvenPC($8) # [1] +/* TagType. */ + and $8, 63, $7 # [1] + and $8, 64, $8 # [1] + ldah $22, 128 # [1] + bis $8, 128, $8 # [1] + bis $7, $8, $7 # [1] + stl $23, 8($12) # [1-] + stl $7, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + bis $4, $22, $4 # set cr.cleanup-in-progress [1] + stl $4, PROCESSORSTATE_CONTROL($14) # [1-] +/* Convert real continuation to PC. */ + and $16, 1, $9 # [0di] + addq $17, $9, $9 # [1] + addq $17, $9, $9 # [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [1-] +.align 3 +CATCHCLOSEDBT: + br $31, DBUNWINDCATCHTRAP +.align 3 +G14295: + ldq $16, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $17, $16, $16 # reconstruct SCA [3] + stl $6, 0($16) # Store in stack [2] + stl $8, 4($16) # write the stack cache [1] + br $31, G14294 # [1] +.align 3 +G14286: + ldq $17, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $16, $17, $16 # reconstruct SCA [3] + ldl $22, 0($16) # [2] + ldl $8, 4($16) # Read from stack cache [1] + br $31, G14285 # [1] +.align 3 +G14288: + blbc $24, G14287 # [1] + extll $22, 0, $2 # Do the indirect thing [0di] + br $31, G14284 # [1-] +.align 3 +G14287: + ldq $16, PROCESSORSTATE_BINDWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $8, 63, $24 # Discard the CDR code [0di] + stq $2, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $24, $16, $24 # Adjust for a longword load [2di] + ldl $16, 0($24) # Get the memory action [2] +G14290: +/* Perform memory action */ + bis $31, $16, $16 # [3] + bis $31, 3, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14276: + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $22, $8 # reconstruct SCA [3] + ldl $2, 0($8) # [2] + ldl $3, 4($8) # Read from stack cache [1] + br $31, G14275 # [1] +.align 3 +G14278: + blbc $16, G14277 # [1] + extll $2, 0, $5 # Do the indirect thing [0di] + br $31, G14274 # [1-] +.align 3 +G14277: + ldq $17, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $3, 63, $16 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $16, $17, $16 # Adjust for a longword load [2di] + ldl $17, 0($16) # Get the memory action [2] +G14280: +/* Perform memory action */ + bis $31, $17, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14266: + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $22, $8 # reconstruct SCA [3] + ldl $6, 0($8) # [2] + ldl $7, 4($8) # Read from stack cache [1] + br $31, G14265 # [1] +.align 3 +G14268: + blbc $16, G14267 # [1] + extll $6, 0, $1 # Do the indirect thing [0di] + br $31, G14264 # [1-] +.align 3 +G14267: + ldq $17, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $7, 63, $16 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $16, $17, $16 # Adjust for a longword load [2di] + ldl $17, 0($16) # Get the memory action [2] +G14270: +/* Perform memory action */ + bis $31, $17, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoCatchCloseIM" +#endif +DoCatchCloseIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoCatchClose. +.end DoCatchClose +/* End of Halfword operand from stack instruction - DoCatchClose */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunfcal.as */ diff --git a/alpha-emulator/ifunfext.as b/alpha-emulator/ifunfext.as new file mode 100644 index 0000000..a31520c --- /dev/null +++ b/alpha-emulator/ifunfext.as @@ -0,0 +1,174 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Field extraction instruction.") + + +;; |DoLdb| is is IFUNCOM1.AS + +(define-instruction |DoCharLdb| :field-extraction () + (SUBQ zero 1 t7 "t7= -1") + (stack-read2-signed iSP arg3 arg4 "get ARG1 tag/data") + (LDA arg1 1 arg1 "Size of field") + (SLL t7 arg1 t7 "Unmask") + (TagType arg3 t8) + (SUBQ t8 |TypeCharacter| t9) + (EXTLL arg4 0 arg4 "Clear sign extension now") + (BNE t9 charldbexc "Not a character") + (SLL arg4 arg2 t4 "T4= shifted value if PP==0") + (GetNextPC) + (SRL t4 32 t5 "T5= shifted value if PP<>0") + (GetNextCP) + (CMOVEQ arg2 t4 t5 "T5= shifted value") + (BIC t5 t7 t3 "T3= masked value.") + (stack-write-ir |TypeFixnum| t3 t4) + (ContinueToNextInstruction-NoStall) + (label charldbexc) + (illegal-operand char-ldb-type-error)) + +(define-instruction |DoPLdb| :field-extraction () + (stack-read2 iSP t1 t2 "get arg1 tag/data") + (SUBQ t1 |TypePhysicalAddress| t3) + (AND t3 #x3F t3) + (BEQ t3 pldbillop) + ;; We don't use the tag here, but MEMORY-READ needs it + (memory-read t2 arg3 arg4 PROCESSORSTATE_RAW t3 t4 t5 t6) + (SUBQ zero 1 t7 "t7= -1") + (ADDQ arg1 1 arg1 "Size of field") + (SLL arg4 arg2 t4 "T4= shifted value if PP==0") + (SRL t4 32 t5 "T5= shifted value if PP<>0") + (SLL t7 arg1 t7 "Unmask") + (CMOVEQ arg2 t4 t5 "T5= shifted value") + (BIC t5 t7 t3 "T3= masked value.") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4) + (ContinueToNextInstruction-NoStall) + (label pldbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + +(define-instruction |DoPTagLdb| :field-extraction () + (stack-read2 iSP t1 t2 "get arg1 tag/data") + (SUBQ t1 |TypePhysicalAddress| t3) + (AND t3 #x3F t3) + (BEQ t3 ptagldbillop) + ;; We don't use the data here, but MEMORY-READ needs it + (memory-read t2 arg3 arg4 PROCESSORSTATE_RAW t3 t4 t5 t6 nil t) + (SUBQ zero 1 t7 "t7= -1") + (ADDQ arg1 1 arg1 "Size of field") + (SLL arg3 arg2 t4 "T4= shifted value if PP==0") + (SRL t4 32 t5 "T5= shifted value if PP<>0") + (SLL t7 arg1 t7 "Unmask") + (CMOVEQ arg2 t4 t5 "T5= shifted value") + (BIC t5 t7 t3 "T3= masked value.") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4) + (ContinueToNextInstruction-NoStall) + (label ptagldbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + + +;;; arg1 new-value iSP-8 +;;; arg2 integer iSP +;;; arg3 bytespec instn operand +(define-instruction |DoDpb| :field-extraction () + (stack-pop2 t5 t6 "Get arg2 tag/data") + (stack-read2 iSP arg3 arg4 "get arg1 tag/data") + (binary-type-dispatch (t5 arg3 t1 t2 arg6 arg5) + ((|TypeFixnum| |TypeFixnum|) + (SUBQ zero 2 t7 "t7= -2") ;11111111111111111110 + (SLL t7 arg1 t7 "Unmask") ;11111111111111110000 + (ORNOT zero t7 t5 "reuse t5 as mask") ;00000000000000001111 + (BIC arg4 t7 t3 "T3= masked new value.") ;unshifted new bits t3 + (SLL t5 arg2 t5 "t5 is the inplace mask") ;00000001111000000 t5 + (SLL t3 arg2 t4 "t4 is the shifted field") ;0000000bbbb000000 t4 + (BIC t6 t5 t6 "Clear out existing bits in arg2 field") + (BIS t4 t6 t6 "Put the new bits in") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t6 t4) + (ContinueToNextInstruction-NoStall)) + (:else1 + (NumericTypeException t5 dpb)) + (:else2 + (NumericTypeException arg3 dpb)))) + +(define-instruction |DoCharDpb| :field-extraction () + (stack-pop2 t5 t6 "Get arg2 tag/data") + (stack-read2 iSP arg3 arg4 "get arg1 tag/data") + (binary-type-dispatch (t5 arg3 t1 t2 arg6 arg5) + ((|TypeCharacter| |TypeFixnum|) + (SUBQ zero 2 t7 "t7= -2") ;11111111111111111110 + (SLL t7 arg1 t7 "Unmask") ;11111111111111110000 + (ORNOT zero t7 t5 "reuse t5 as mask") ;00000000000000001111 + (BIC arg4 t7 t3 "T3= masked new value.") ;unshifted new bits t3 + (SLL t5 arg2 t5 "t5 is the inplace mask") ;00000001111000000 t5 + (SLL t3 arg2 t4 "t4 is the shifted field") ;0000000bbbb000000 t4 + (BIC t6 t5 t6 "Clear out existing bits in arg2 field") + (BIS t4 t6 t6 "Put the new bits in") + (GetNextPCandCP) + (stack-write-ir |TypeCharacter| t6 t4) + (ContinueToNextInstruction-NoStall)) + (:else1 + (SpareTypeException t5 char-dpb nil char-dpb-type-error)) + (:else2 + (illegal-operand char-dpb-type-error)))) + +(define-instruction |DoPDpb| :field-extraction () + (stack-pop2 t1 t2 "Get arg2 tag/data") + (SUBQ t1 |TypePhysicalAddress| t3) + (AND t3 #x3F t3) + (BEQ t3 pdpbillop) + (stack-pop2 arg3 arg4 "get arg1 tag/data") + (memory-read t2 t8 t6 PROCESSORSTATE_RAW t3 t4 t1 t5) + (EXTLL t6 0 t6) + (type-dispatch arg3 t1 t10 + (|TypeFixnum| + (SUBQ zero 2 t7 "t7= -2") ;11111111111111111110 + (SLL t7 arg1 t7 "Unmask") ;11111111111111110000 + (ORNOT zero t7 t5 "reuse t5 as mask") ;00000000000000001111 + (BIC arg4 t7 t3 "T3= masked new value.") ;unshifted new bits t3 + (SLL t5 arg2 t5 "t5 is the inplace mask") ;00000001111000000 t5 + (SLL t3 arg2 t4 "t4 is the shifted field") ;0000000bbbb000000 t4 + (BIC t6 t5 t6 "Clear out existing bits in arg2 field") + (BIS t4 t6 t6 "Put the new bits in") + (memory-write t2 t8 t6 PROCESSORSTATE_RAW t3 t4 t1 t5 t10 + NextInstruction) + (ContinueToNextInstruction)) + (:else + (illegal-operand %p-dpb-type-error))) + (label pdpbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + +(define-instruction |DoPTagDpb| :field-extraction () + (stack-pop2 t1 t2 "Get arg2 tag/data") + (SUBQ t1 |TypePhysicalAddress| t3) + (AND t3 #x3F t3) + (BEQ t3 ptagdpbillop) + (stack-pop2 arg3 arg4 "get arg1 tag/data") + (memory-read t2 t6 t8 PROCESSORSTATE_RAW t3 t4 t1 t5 nil t) + (type-dispatch arg3 t1 t10 + (|TypeFixnum| + (SUBQ zero 2 t7 "t7= -2") ;11111111111111111110 + (SLL t7 arg1 t7 "Unmask") ;11111111111111110000 + (ORNOT zero t7 t5 "reuse t5 as mask") ;00000000000000001111 + (BIC arg4 t7 t3 "T3= masked new value.") ;unshifted new bits t3 + (SLL t5 arg2 t5 "t5 is the inplace mask") ;00000001111000000 t5 + (SLL t3 arg2 t4 "t4 is the shifted field") ;0000000bbbb000000 t4 + (BIC t6 t5 t6 "Clear out existing bits in arg2 field") + (BIS t4 t6 t6 "Put the new bits in") + (memory-write t2 t6 t8 PROCESSORSTATE_RAW t3 t4 t1 t5 t10 + NextInstruction) + (ContinueToNextInstruction)) + (:else + (illegal-operand %p-dpb-type-error))) + (label ptagdpbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + + +(comment "Fin.") diff --git a/alpha-emulator/ifunfext.s b/alpha-emulator/ifunfext.s new file mode 100644 index 0000000..4d55cc9 --- /dev/null +++ b/alpha-emulator/ifunfext.s @@ -0,0 +1,643 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunfext.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Field extraction instruction. */ +.align 5 +.globl DoCharLdb +.ent DoCharLdb 0 +/* Field Extraction instruction - DoCharLdb */ + .globl DoCharLdbFP + .globl DoCharLdbSP + .globl DoCharLdbLP + .globl DoCharLdbIM +.align 3 +DoCharLdb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoCharLdb" +#endif +.align 3 +DoCharLdbIM: +.align 3 +DoCharLdbSP: +.align 3 +DoCharLdbLP: +.align 3 +DoCharLdbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [1] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + subq $31, 1, $7 # t7= -1 [1] + ldl $18, 4($12) # get ARG1 tag/data [1-] + ldl $19, 0($12) # [1] + lda $16, 1($16) # Size of field [1-] + sll $7, $16, $7 # Unmask [1] +/* TagType. */ + and $18, 63, $8 # [1] + subq $8, TypeCharacter, $22 # [1] + extll $19, 0, $19 # Clear sign extension now [1] + bne $22, CHARLDBEXC # Not a character [0di] + sll $19, $17, $4 # T4= shifted value if PP==0 [2-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + srl $4, 32, $5 # T5= shifted value if PP<>0 [2-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + cmoveq $17, $4, $5 # T5= shifted value [1-] + bic $5, $7, $3 # T3= masked value. [2] + bis $31, TypeFixnum, $4 # [1] + stl $3, 0($12) # [0di] + stl $4, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +CHARLDBEXC: + bis $31, 0, $20 # [1-] + bis $31, 28, $17 # [1] + br $31, ILLEGALOPERAND +.end DoCharLdb +/* End of Halfword operand from stack instruction - DoCharLdb */ +.align 5 +.globl DoPLdb +.ent DoPLdb 0 +/* Field Extraction instruction - DoPLdb */ + .globl DoPLdbFP + .globl DoPLdbSP + .globl DoPLdbLP + .globl DoPLdbIM +.align 3 +DoPLdb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPLdb" +#endif +.align 3 +DoPLdbIM: +.align 3 +DoPLdbSP: +.align 3 +DoPLdbLP: +.align 3 +DoPLdbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [1] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + ldl $2, 0($12) # get arg1 tag/data [0di] + ldl $1, 4($12) # [1] + extll $2, 0, $2 # [2di] + subq $1, TypePhysicalAddress, $3 # [1] + and $3, 63, $3 # [1] + beq $3, PLDBILLOP # [1] +/* Memory Read Internal */ +G15328: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1] + addq $2, $14, $5 # [1-] + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $5, $31, $19 # [1-] + ldq_u $18, 0($5) # [1di] + subq $2, $3, $3 # Stack cache offset [1-] + cmpult $3, $4, $4 # In range? [1] + ldl $19, 0($19) # [1-] + extbl $18, $5, $18 # [0di] + bne $4, G15330 # [1-] +G15329: + extll $19, 0, $19 # [2di] +G15336: + subq $31, 1, $7 # t7= -1 [1] + addq $16, 1, $16 # Size of field [1] + sll $19, $17, $4 # T4= shifted value if PP==0 [1] + srl $4, 32, $5 # T5= shifted value if PP<>0 [2] + sll $7, $16, $7 # Unmask [1] + cmoveq $17, $4, $5 # T5= shifted value [1] + bic $5, $7, $3 # T3= masked value. [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $4 # [0di] + stl $3, 0($12) # [1-] + stl $4, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +PLDBILLOP: +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $2, $2 # stack cache base relative offset [2-] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 57, $17 # [1] + br $31, ILLEGALOPERAND # Physical not supported +.align 3 +G15330: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $19, 0($3) # [2] + ldl $18, 4($3) # Read from stack cache [1] + br $31, G15329 # [1] +.end DoPLdb +/* End of Halfword operand from stack instruction - DoPLdb */ +.align 5 +.globl DoPTagLdb +.ent DoPTagLdb 0 +/* Field Extraction instruction - DoPTagLdb */ + .globl DoPTagLdbFP + .globl DoPTagLdbSP + .globl DoPTagLdbLP + .globl DoPTagLdbIM +.align 3 +DoPTagLdb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPTagLdb" +#endif +.align 3 +DoPTagLdbIM: +.align 3 +DoPTagLdbSP: +.align 3 +DoPTagLdbLP: +.align 3 +DoPTagLdbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [2-] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + ldl $2, 0($12) # get arg1 tag/data [0di] + ldl $1, 4($12) # [1] + extll $2, 0, $2 # [2di] + subq $1, TypePhysicalAddress, $3 # [1] + and $3, 63, $3 # [1] + beq $3, PTAGLDBILLOP # [1] +/* Memory Read Internal */ +G15337: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1] + addq $2, $14, $5 # [1-] + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $5, $31, $19 # [1-] + ldq_u $18, 0($5) # [1di] + subq $2, $3, $3 # Stack cache offset [1-] + cmpult $3, $4, $4 # In range? [1] + ldl $19, 0($19) # [1-] + extbl $18, $5, $18 # [0di] + bne $4, G15339 # [1-] +G15338: +G15345: + subq $31, 1, $7 # t7= -1 [0di] + addq $16, 1, $16 # Size of field [1] + sll $18, $17, $4 # T4= shifted value if PP==0 [1] + srl $4, 32, $5 # T5= shifted value if PP<>0 [2] + sll $7, $16, $7 # Unmask [1] + cmoveq $17, $4, $5 # T5= shifted value [1] + bic $5, $7, $3 # T3= masked value. [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $4 # [1-] + stl $3, 0($12) # [0di] + stl $4, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +PTAGLDBILLOP: +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $2, $2 # stack cache base relative offset [2-] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 57, $17 # [1] + br $31, ILLEGALOPERAND # Physical not supported +.align 3 +G15339: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $19, 0($3) # [2] + ldl $18, 4($3) # Read from stack cache [1] + br $31, G15338 # [1] +.end DoPTagLdb +/* End of Halfword operand from stack instruction - DoPTagLdb */ +.align 5 +.globl DoDpb +.ent DoDpb 0 +/* Field Extraction instruction - DoDpb */ + .globl DoDpbFP + .globl DoDpbSP + .globl DoDpbLP + .globl DoDpbIM +.align 3 +DoDpb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoDpb" +#endif +.align 3 +DoDpbIM: +.align 3 +DoDpbSP: +.align 3 +DoDpbLP: +.align 3 +DoDpbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [2-] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + ldl $6, 0($12) # Get arg2 tag/data [0di] + ldl $5, 4($12) # Get arg2 tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $6, 0, $6 # [1] + ldl $19, 0($12) # get arg1 tag/data [1di] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2di] + and $5, 63, $1 # Strip off any CDR code bits. [1] + and $18, 63, $21 # Strip off any CDR code bits. [1] + cmpeq $1, TypeFixnum, $2 # [1] +.align 3 +G15358: + beq $2, G15351 # [1] +/* Here if argument TypeFixnum */ + cmpeq $21, TypeFixnum, $20 # [0di] +.align 3 +G15355: + beq $20, G15348 # [1] +/* Here if argument TypeFixnum */ + subq $31, 2, $7 # t7= -2 [0di] + sll $7, $16, $7 # Unmask [1] + ornot $31, $7, $5 # reuse t5 as mask [2] + bic $19, $7, $3 # T3= masked new value. [1] + sll $5, $17, $5 # t5 is the inplace mask [1] + sll $3, $17, $4 # t4 is the shifted field [1] + bic $6, $5, $6 # Clear out existing bits in arg2 field [1] + bis $4, $6, $6 # Put the new bits in [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $4 # [0di] + stl $6, 0($12) # [1-] + stl $4, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15352: +.align 3 +G15351: +/* Here for all other cases */ +.align 3 +G15347: + bis $31, $5, $21 # arg6 = tag to dispatch on [1-] + bis $31, 1, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G15349 # [1-] +.align 3 +G15348: + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 1, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15349: +.align 3 +G15350: +.end DoDpb +/* End of Halfword operand from stack instruction - DoDpb */ +.align 5 +.globl DoCharDpb +.ent DoCharDpb 0 +/* Field Extraction instruction - DoCharDpb */ + .globl DoCharDpbFP + .globl DoCharDpbSP + .globl DoCharDpbLP + .globl DoCharDpbIM +.align 3 +DoCharDpb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoCharDpb" +#endif +.align 3 +DoCharDpbIM: +.align 3 +DoCharDpbSP: +.align 3 +DoCharDpbLP: +.align 3 +DoCharDpbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [1] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + ldl $6, 0($12) # Get arg2 tag/data [0di] + ldl $5, 4($12) # Get arg2 tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $6, 0, $6 # [1] + ldl $19, 0($12) # get arg1 tag/data [1di] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2di] + and $5, 63, $1 # Strip off any CDR code bits. [1] + and $18, 63, $21 # Strip off any CDR code bits. [1] + cmpeq $1, TypeCharacter, $2 # [1] +.align 3 +G15371: + beq $2, G15364 # [1] +/* Here if argument TypeCharacter */ + cmpeq $21, TypeFixnum, $20 # [0di] +.align 3 +G15368: + beq $20, G15361 # [1] +/* Here if argument TypeFixnum */ + subq $31, 2, $7 # t7= -2 [0di] + sll $7, $16, $7 # Unmask [1] + ornot $31, $7, $5 # reuse t5 as mask [2] + bic $19, $7, $3 # T3= masked new value. [1] + sll $5, $17, $5 # t5 is the inplace mask [1] + sll $3, $17, $4 # t4 is the shifted field [1] + bic $6, $5, $6 # Clear out existing bits in arg2 field [1] + bis $4, $6, $6 # Put the new bits in [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeCharacter, $4 # [0di] + stl $6, 0($12) # [1-] + stl $4, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G15365: +.align 3 +G15364: +/* Here for all other cases */ +.align 3 +G15360: + bis $31, $5, $21 # arg6 = tag to dispatch on [1-] + bis $31, 1, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # [1] + bis $31, 27, $17 # [1] + br $31, SPAREEXCEPTION + br $31, G15362 # [1-] +.align 3 +G15361: + bis $31, 0, $20 # [1-] + bis $31, 27, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15362: +.align 3 +G15363: +.end DoCharDpb +/* End of Halfword operand from stack instruction - DoCharDpb */ +.align 5 +.globl DoPDpb +.ent DoPDpb 0 +/* Field Extraction instruction - DoPDpb */ + .globl DoPDpbFP + .globl DoPDpbSP + .globl DoPDpbLP + .globl DoPDpbIM +.align 3 +DoPDpb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPDpb" +#endif +.align 3 +DoPDpbIM: +.align 3 +DoPDpbSP: +.align 3 +DoPDpbLP: +.align 3 +DoPDpbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [1] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + ldl $2, 0($12) # Get arg2 tag/data [0di] + ldl $1, 4($12) # Get arg2 tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $2, 0, $2 # [1] + subq $1, TypePhysicalAddress, $3 # [1] + and $3, 63, $3 # [1] + beq $3, PDPBILLOP # [1] + ldl $19, 0($12) # get arg1 tag/data [1-] + ldl $18, 4($12) # get arg1 tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] +/* Memory Read Internal */ +G15372: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $2, $14, $1 # [0di] + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $1, $31, $6 # [0di] + ldq_u $8, 0($1) # [1-] + subq $2, $3, $3 # Stack cache offset [1di] + cmpult $3, $4, $4 # In range? [1] + ldl $6, 0($6) # [0di] + extbl $8, $1, $8 # [1-] + bne $4, G15374 # [0di] +G15373: + extll $6, 0, $6 # [2-] +G15380: + extll $6, 0, $6 # [2] + and $18, 63, $1 # Strip off any CDR code bits. [1] + cmpeq $1, TypeFixnum, $23 # [1] +.align 3 +G15387: + beq $23, G15382 # [1] +/* Here if argument TypeFixnum */ + subq $31, 2, $7 # t7= -2 [0di] + sll $7, $16, $7 # Unmask [1] + ornot $31, $7, $5 # reuse t5 as mask [2] + bic $19, $7, $3 # T3= masked new value. [1] + sll $5, $17, $5 # t5 is the inplace mask [1] + sll $3, $17, $4 # t4 is the shifted field [1] + bic $6, $5, $6 # Clear out existing bits in arg2 field [1] + bis $4, $6, $6 # Put the new bits in [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + addq $2, $14, $3 # [1-] + ldl $23, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $3, $31, $5 # [1-] + ldq_u $1, 0($3) # [1di] + subq $2, $4, $4 # Stack cache offset [1-] + cmpult $4, $23, $23 # In range? [1] + insbl $8, $3, $4 # [1] + mskbl $1, $3, $1 # [1] +.align 3 +G15384: + bis $1, $4, $1 # [2] + stq_u $1, 0($3) # [0di] + stl $6, 0($5) # [1] + bne $23, G15383 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15382: +/* Here for all other cases */ + bis $31, 0, $20 # [1-] + bis $31, 6, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15381: +.align 3 +PDPBILLOP: +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $2, $2 # stack cache base relative offset [2-] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 57, $17 # [1] + br $31, ILLEGALOPERAND # Physical not supported +.align 3 +G15383: + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15388: + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $2, $4, $4 # Stack cache offset [2di] + s8addq $4, $3, $3 # reconstruct SCA [1] + stl $6, 0($3) # Store in stack [2] + stl $8, 4($3) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15374: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $6, 0($3) # [2] + ldl $8, 4($3) # Read from stack cache [1] + br $31, G15373 # [1] +.end DoPDpb +/* End of Halfword operand from stack instruction - DoPDpb */ +.align 5 +.globl DoPTagDpb +.ent DoPTagDpb 0 +/* Field Extraction instruction - DoPTagDpb */ + .globl DoPTagDpbFP + .globl DoPTagDpbSP + .globl DoPTagDpbLP + .globl DoPTagDpbIM +.align 3 +DoPTagDpb: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPTagDpb" +#endif +.align 3 +DoPTagDpbIM: +.align 3 +DoPTagDpbSP: +.align 3 +DoPTagDpbLP: +.align 3 +DoPTagDpbFP: + srl $18, 37, $16 # Shift the 'size-1' bits into place [1-] + and $17, 31, $17 # mask out the unwanted bits in arg2 [1] + and $16, 31, $16 # mask out the unwanted bits in arg1 [1] +/* arg1 has size-1, arg2 has position. */ + ldl $2, 0($12) # Get arg2 tag/data [0di] + ldl $1, 4($12) # Get arg2 tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $2, 0, $2 # [1] + subq $1, TypePhysicalAddress, $3 # [1] + and $3, 63, $3 # [1] + beq $3, PTAGDPBILLOP # [1] + ldl $19, 0($12) # get arg1 tag/data [1-] + ldl $18, 4($12) # get arg1 tag/data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] +/* Memory Read Internal */ +G15389: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $2, $14, $1 # [0di] + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $1, $31, $8 # [0di] + ldq_u $6, 0($1) # [1-] + subq $2, $3, $3 # Stack cache offset [1di] + cmpult $3, $4, $4 # In range? [1] + ldl $8, 0($8) # [0di] + extbl $6, $1, $6 # [1-] + bne $4, G15391 # [0di] +G15390: +G15397: + and $18, 63, $1 # Strip off any CDR code bits. [1-] + cmpeq $1, TypeFixnum, $23 # [1] +.align 3 +G15404: + beq $23, G15399 # [1] +/* Here if argument TypeFixnum */ + subq $31, 2, $7 # t7= -2 [0di] + sll $7, $16, $7 # Unmask [1] + ornot $31, $7, $5 # reuse t5 as mask [2] + bic $19, $7, $3 # T3= masked new value. [1] + sll $5, $17, $5 # t5 is the inplace mask [1] + sll $3, $17, $4 # t4 is the shifted field [1] + bic $6, $5, $6 # Clear out existing bits in arg2 field [1] + bis $4, $6, $6 # Put the new bits in [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + addq $2, $14, $3 # [1-] + ldl $23, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $3, $31, $5 # [1-] + ldq_u $1, 0($3) # [1di] + subq $2, $4, $4 # Stack cache offset [1-] + cmpult $4, $23, $23 # In range? [1] + insbl $6, $3, $4 # [1] + mskbl $1, $3, $1 # [1] +.align 3 +G15401: + bis $1, $4, $1 # [2] + stq_u $1, 0($3) # [0di] + stl $8, 0($5) # [1] + bne $23, G15400 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15399: +/* Here for all other cases */ + bis $31, 0, $20 # [1-] + bis $31, 6, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15398: +.align 3 +PTAGDPBILLOP: +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $2, $2 # stack cache base relative offset [2-] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + bis $31, $2, $20 # [1] + bis $31, 57, $17 # [1] + br $31, ILLEGALOPERAND # Physical not supported +.align 3 +G15400: + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15405: + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $2, $4, $4 # Stack cache offset [2di] + s8addq $4, $3, $3 # reconstruct SCA [1] + stl $8, 0($3) # Store in stack [2] + stl $6, 4($3) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15391: + ldq $4, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $3, $4, $3 # reconstruct SCA [3] + ldl $8, 0($3) # [2] + ldl $6, 4($3) # Read from stack cache [1] + br $31, G15390 # [1] +.end DoPTagDpb +/* End of Halfword operand from stack instruction - DoPTagDpb */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunfext.as */ diff --git a/alpha-emulator/ifunfull.as b/alpha-emulator/ifunfull.as new file mode 100644 index 0000000..198b771 --- /dev/null +++ b/alpha-emulator/ifunfull.as @@ -0,0 +1,92 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "The full word instructions") + +(define-instruction |DoIStageError| :full-word-instruction () + (illegal-operand i-stage-error)) + +(define-instruction |nullfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-null))) + +(define-instruction |monitorforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-monitor-forward))) + +(define-instruction |headerpfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-header-p))) + +(define-instruction |headerifw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-header-i))) + +(define-instruction |oneqforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-one-q-forward))) + +(define-instruction |headerforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-header-forward))) + +(define-instruction |elementforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-element-forward))) + +(define-instruction |gcforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-gc-forward))) + +(define-instruction |boundlocationfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-bound-location))) + +(define-instruction |logicvariablefw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-logic-variable))) + +;; |valuecell| is in IFUNCOM1.AS + +;; |pushconstantvalue| is in IFUNCOM1.AS + +(define-instruction |pushsparepointer3| :full-word-instruction () + (LDQ arg1 CACHELINE_INSTRUCTION (iCP) "Get operand") + (UnimplementedInstruction)) + +(define-instruction |pushsparepointer4| :full-word-instruction () + (LDQ arg1 CACHELINE_INSTRUCTION (iCP) "Get operand") + (UnimplementedInstruction)) + +(passthru ".globl callcompiledoddprefetch") +(define-instruction |callcompiledodd| :full-word-instruction () + (label |callcompiledoddprefetch|) ;the same as |callcompiledodd| + (BIS arg3 zero arg6 "Get operand") + (BIS zero |TypeOddPC| arg5) + (BIS zero zero arg3 "No extra arg") + (BR zero startcallcompiledmerge)) ;push new frame and exit + +;; |callindirect|, |callindirectprefetch|, |callcompiledeven|, and +;; |callgeneric| are in IFUNCOM1.AS + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Native Instruction Support ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-instruction |nativeinstruction| :full-word-instruction () + ;; RESTARTSP already set when we get here + (BIC iPC 1 arg1 "arg1 is instruction address*2 here") + (ADDQ arg1 arg1 arg1 "Select the DATA address") + (S4ADDQ Ivory arg1 arg1 "Add in the memory base") + (JSR r0 arg1 0 "Jump into the Ivory code") + ;; On return, fall-through to resumeemulated + ) + +;; Native mode returns to here with the return address in arg1 (why not r0)? +(define-procedure |resumeemulated| () + ;; RESTARTSP will be set by nextInstruction + (LDQ arg2 CACHELINE_ANNOTATION (iCP)) + (S4SUBQ Ivory arg1 iPC) + (SUBQ zero iPC iPC) + (SRL iPC 1 iPC) + ;; --- Don't need to check sequence-break on this path, now that + ;; branch translations do it directly + (BNE arg2 interpretInstructionPredicted) + (BR zero interpretInstructionforBranch) +) + + +(comment "Fin.") diff --git a/alpha-emulator/ifunfull.s b/alpha-emulator/ifunfull.s new file mode 100644 index 0000000..47aed75 --- /dev/null +++ b/alpha-emulator/ifunfull.s @@ -0,0 +1,256 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunfull.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* The full word instructions */ +.align 5 +.globl DoIStageError +.ent DoIStageError 0 +/* Fullword instruction - DoIStageError */ +#ifdef TRACING + .byte 0x80 + .asciiz "DoIStageError" +#endif +.align 3 +DoIStageError: + bis $31, 0, $20 # [1] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.end DoIStageError +/* End of Fullword instruction - DoIStageError */ +.align 5 +.globl nullfw +.ent nullfw 0 +/* Fullword instruction - nullfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "nullfw" +#endif +.align 3 +nullfw: + bis $31, 0, $20 # [1] + bis $31, 47, $17 # [1] + br $31, ILLEGALOPERAND +.end nullfw +/* End of Fullword instruction - nullfw */ +.align 5 +.globl monitorforwardfw +.ent monitorforwardfw 0 +/* Fullword instruction - monitorforwardfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "monitorforwardfw" +#endif +.align 3 +monitorforwardfw: + bis $31, 0, $20 # [1] + bis $31, 46, $17 # [1] + br $31, ILLEGALOPERAND +.end monitorforwardfw +/* End of Fullword instruction - monitorforwardfw */ +.align 5 +.globl headerpfw +.ent headerpfw 0 +/* Fullword instruction - headerpfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "headerpfw" +#endif +.align 3 +headerpfw: + bis $31, 0, $20 # [1] + bis $31, 44, $17 # [1] + br $31, ILLEGALOPERAND +.end headerpfw +/* End of Fullword instruction - headerpfw */ +.align 5 +.globl headerifw +.ent headerifw 0 +/* Fullword instruction - headerifw */ +#ifdef TRACING + .byte 0x80 + .asciiz "headerifw" +#endif +.align 3 +headerifw: + bis $31, 0, $20 # [1] + bis $31, 43, $17 # [1] + br $31, ILLEGALOPERAND +.end headerifw +/* End of Fullword instruction - headerifw */ +.align 5 +.globl oneqforwardfw +.ent oneqforwardfw 0 +/* Fullword instruction - oneqforwardfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "oneqforwardfw" +#endif +.align 3 +oneqforwardfw: + bis $31, 0, $20 # [1] + bis $31, 48, $17 # [1] + br $31, ILLEGALOPERAND +.end oneqforwardfw +/* End of Fullword instruction - oneqforwardfw */ +.align 5 +.globl headerforwardfw +.ent headerforwardfw 0 +/* Fullword instruction - headerforwardfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "headerforwardfw" +#endif +.align 3 +headerforwardfw: + bis $31, 0, $20 # [1] + bis $31, 42, $17 # [1] + br $31, ILLEGALOPERAND +.end headerforwardfw +/* End of Fullword instruction - headerforwardfw */ +.align 5 +.globl elementforwardfw +.ent elementforwardfw 0 +/* Fullword instruction - elementforwardfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "elementforwardfw" +#endif +.align 3 +elementforwardfw: + bis $31, 0, $20 # [1] + bis $31, 40, $17 # [1] + br $31, ILLEGALOPERAND +.end elementforwardfw +/* End of Fullword instruction - elementforwardfw */ +.align 5 +.globl gcforwardfw +.ent gcforwardfw 0 +/* Fullword instruction - gcforwardfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "gcforwardfw" +#endif +.align 3 +gcforwardfw: + bis $31, 0, $20 # [1] + bis $31, 41, $17 # [1] + br $31, ILLEGALOPERAND +.end gcforwardfw +/* End of Fullword instruction - gcforwardfw */ +.align 5 +.globl boundlocationfw +.ent boundlocationfw 0 +/* Fullword instruction - boundlocationfw */ +#ifdef TRACING + .byte 0x80 + .asciiz "boundlocationfw" +#endif +.align 3 +boundlocationfw: + bis $31, 0, $20 # [1] + bis $31, 39, $17 # [1] + br $31, ILLEGALOPERAND +.end boundlocationfw +/* End of Fullword instruction - boundlocationfw */ +.align 5 +.globl logicvariablefw +.ent logicvariablefw 0 +/* Fullword instruction - logicvariablefw */ +#ifdef TRACING + .byte 0x80 + .asciiz "logicvariablefw" +#endif +.align 3 +logicvariablefw: + bis $31, 0, $20 # [1] + bis $31, 45, $17 # [1] + br $31, ILLEGALOPERAND +.end logicvariablefw +/* End of Fullword instruction - logicvariablefw */ +.align 5 +.globl pushsparepointer3 +.ent pushsparepointer3 0 +/* Fullword instruction - pushsparepointer3 */ +#ifdef TRACING + .byte 0x80 + .asciiz "pushsparepointer3" +#endif +.align 3 +pushsparepointer3: + ldq $16, CACHELINE_INSTRUCTION($13) # Get operand [1-] +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.end pushsparepointer3 +/* End of Fullword instruction - pushsparepointer3 */ +.align 5 +.globl pushsparepointer4 +.ent pushsparepointer4 0 +/* Fullword instruction - pushsparepointer4 */ +#ifdef TRACING + .byte 0x80 + .asciiz "pushsparepointer4" +#endif +.align 3 +pushsparepointer4: + ldq $16, CACHELINE_INSTRUCTION($13) # Get operand [1-] +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND +.end pushsparepointer4 +/* End of Fullword instruction - pushsparepointer4 */ +.globl callcompiledoddprefetch +.align 5 +.globl callcompiledodd +.ent callcompiledodd 0 +/* Fullword instruction - callcompiledodd */ +#ifdef TRACING + .byte 0x80 + .asciiz "callcompiledodd" +#endif +.align 3 +callcompiledodd: +.align 3 +callcompiledoddprefetch: + bis $18, $31, $21 # Get operand [1] + bis $31, TypeOddPC, $20 # [1] + bis $31, $31, $18 # No extra arg [1] + br $31, STARTCALLCOMPILEDMERGE # [0di] +.end callcompiledodd +/* End of Fullword instruction - callcompiledodd */ +.align 5 +.globl nativeinstruction +.ent nativeinstruction 0 +/* Fullword instruction - nativeinstruction */ +#ifdef TRACING + .byte 0x80 + .asciiz "nativeinstruction" +#endif +.align 3 +nativeinstruction: + bic $9, 1, $16 # arg1 is instruction address*2 here [1-] + addq $16, $16, $16 # Select the DATA address [1] + s4addq $14, $16, $16 # Add in the memory base [1] + jsr $0, ($16), 0 # Jump into the Ivory code [2] +.end nativeinstruction +/* End of Fullword instruction - nativeinstruction */ +.align 5 +.globl resumeemulated +.ent resumeemulated 0 +.align 3 +resumeemulated: + ldq $17, CACHELINE_ANNOTATION($13) # [1] + s4subq $14, $16, $9 # [0di] + subq $31, $9, $9 # [1] + srl $9, 1, $9 # [1] + bne $17, INTERPRETINSTRUCTIONPREDICTED # [1-] + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end resumeemulated +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunfull.as */ diff --git a/alpha-emulator/ifungene.as b/alpha-emulator/ifungene.as new file mode 100644 index 0000000..f54bf4d --- /dev/null +++ b/alpha-emulator/ifungene.as @@ -0,0 +1,27 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Generic dispatching an method lookup") + +;; |DoGenericDispatch| and |LookupHandler| are in IFUNCOM1.AS + +(define-instruction |DoMessageDispatch| :operand-from-stack () + (message-dispatch arg1 t1 arg3 arg4 t4 t9 t6 t7 arg2 arg5 t3 t2)) + + +#+obsolete +;; Branched to from |LookupHandler| if the object is not an instance. +;; Branches back to |LookupHandlerInstance| when done. +(define-procedure |LookupHandlerNonInstance| () + ;; Note well! Don't change these memo registers without also fixing + ;; the call to WITH-MULTIPLE-MEMORY-READS in |LookupHandlerInstance|. + (using-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (non-instance-descriptor-info + arg3 arg4 arg5 arg6 t1 t2 t3 t4 t5 t6 t7 + |LookupHandlerInstance| |LookupHandlerNonInstance|))) + + +(comment "Fin.") diff --git a/alpha-emulator/ifungene.s b/alpha-emulator/ifungene.s new file mode 100644 index 0000000..db32b58 --- /dev/null +++ b/alpha-emulator/ifungene.s @@ -0,0 +1,100 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifungene.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Generic dispatching an method lookup */ +.align 5 +.globl DoMessageDispatch +.ent DoMessageDispatch 0 +/* Halfword operand from stack instruction - DoMessageDispatch */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMessageDispatchFP + .globl DoMessageDispatchSP + .globl DoMessageDispatchLP + .globl DoMessageDispatchIM +.align 3 +DoMessageDispatch: +#ifdef TRACING + .byte 0x88 + .asciiz "DoMessageDispatchSP" +#endif +.align 3 +DoMessageDispatchSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoMessageDispatch # [0di] + .byte 0x90 + .asciiz "DoMessageDispatchLP" +#endif +.align 3 +DoMessageDispatchLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMessageDispatch # [1] + .byte 0x84 + .asciiz "DoMessageDispatchFP" +#endif +.align 3 +DoMessageDispatchFP: # Entry point for FP relative +.align 3 +beginDoMessageDispatch: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $17, PROCESSORSTATE_CONTROL($14) # [1] + ldl $16, 28($10) # get message tag and data [1] + ldl $1, 24($10) # [1] + and $17, 255, $20 # get number of arguments [1-] + ldl $18, 20($10) # get instance tag and data [0di] + ldl $19, 16($10) # [1] + subq $20, 4, $20 # done if 2 or more arguments (plus 2 extra words) [0di] + blt $20, VerifyGenericArity # [1] + extll $1, 0, $1 # [0di] + extll $19, 0, $19 # [2] + bsr $0, LookupHandler + ldq $19, 16($10) # clobbered by |LookupHandler| [1] + subq $4, TypeEvenPC, $3 # [1-] + and $3, 62, $3 # Strip CDR code, low bits [1] + bne $3, G14089 # [1] + and $6, 63, $3 # Strip CDR code [1] + subq $3, TypeNIL, $3 # [1] + beq $3, G14087 # [1] + stl $7, 16($10) # [1] + stl $6, 20($10) # write the stack cache [1] + br $31, G14088 # [1] +.align 3 +G14087: + stl $1, 16($10) # swap message/instance in the frame [1] + stl $16, 20($10) # write the stack cache [1] +.align 3 +G14088: + stq $19, 24($10) # [1] +/* Convert real continuation to PC. */ + and $4, 1, $9 # [0di] + addq $22, $9, $9 # [1] + addq $22, $9, $9 # [1] + br $31, INTERPRETINSTRUCTIONFORJUMP # [1-] +.align 3 +G14089: +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $2, $2 # stack cache base relative offset [2-] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $3, $3 # reconstruct VMA [2] + bis $31, $3, $20 # [1] + bis $31, 37, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + .byte 0x82 + .asciiz "DoMessageDispatchIM" +#endif +DoMessageDispatchIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoMessageDispatch. +.end DoMessageDispatch +/* End of Halfword operand from stack instruction - DoMessageDispatch */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifungene.as */ diff --git a/alpha-emulator/ifunhead.as b/alpha-emulator/ifunhead.as new file mode 100644 index 0000000..5ad511d --- /dev/null +++ b/alpha-emulator/ifunhead.as @@ -0,0 +1,13 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(comment "Entry points into the interpretation loop.") + +(external "HALTMACHINE") +(external "ILLEGALINSTRUCTION") +(external "ILLEGALOPERAND") +(external "SUSPENDMACHINE") +(external "ICACHEMISS") +(external "INTERPRETINSTRUCTION") +(external "NEXTINSTRUCTION") + +(comment "Fin.") diff --git a/alpha-emulator/ifunhead.s b/alpha-emulator/ifunhead.s new file mode 100644 index 0000000..f04e7bc --- /dev/null +++ b/alpha-emulator/ifunhead.s @@ -0,0 +1,17 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunhead.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Entry points into the interpretation loop. */ + .extern HALTMACHINE + .extern ILLEGALINSTRUCTION + .extern ILLEGALOPERAND + .extern SUSPENDMACHINE + .extern ICACHEMISS + .extern INTERPRETINSTRUCTION + .extern NEXTINSTRUCTION +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunhead.as */ diff --git a/alpha-emulator/ifuninst.as b/alpha-emulator/ifuninst.as new file mode 100644 index 0000000..855ecdb --- /dev/null +++ b/alpha-emulator/ifuninst.as @@ -0,0 +1,142 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Instance variable accessors..") + +;; |DoPushInstanceVariable| is in IFUNCOM1.AS + +(define-instruction |DoPopInstanceVariable| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6 :cant-be-in-cache-p t) + (locate-instance-variable-mapped arg2 arg1 IVBadMap IVBadInst IVBadIndex popiviex + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + (stack-pop2 t2 t1) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label popiviex) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception pop-instance-variable 1 t1 t2) + (instruction-exception)) + +(define-instruction |DoMovemInstanceVariable| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6 :cant-be-in-cache-p t) + (locate-instance-variable-mapped arg2 arg1 IVBadMap IVBadInst IVBadIndex movemiviex + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + (stack-read2 iSP t2 t1) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label movemiviex) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception movem-instance-variable 0 t1 t2) + (instruction-exception)) + +;(align16k) + +(define-instruction |DoPushAddressInstanceVariable| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6 :cant-be-in-cache-p t) + (locate-instance-variable-mapped arg2 arg1 IVBadMap IVBadInst IVBadIndex pushadiviex + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + (stack-push-ir |TypeLocative| arg1 t7) + (ContinueToNextInstruction) + (label pushadiviex) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception push-address-instance-variable 0 t1 t2) + (instruction-exception)) + + +(define-instruction |DoPushInstanceVariableOrdered| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (memory-read arg1 t2 t1 PROCESSORSTATE_DATAREAD t4 t5 t6 t7 nil t)) + (GetNextPCandCP) + (stack-push2 t2 t1 t7) + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoPopInstanceVariableOrdered| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (stack-pop2 t2 t1) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction)) + +(define-instruction |DoMovemInstanceVariableOrdered| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (stack-read2 iSP t2 t1) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction)) + + +(define-instruction |DoPushAddressInstanceVariableOrdered| :10-bit-immediate () + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (stack-push-ir |TypeLocative| arg1 t7) + (ContinueToNextInstruction) + (label IVBadMap) + (illegal-operand self-mapping-table-type-error) + (label IVBadIndex) + (illegal-operand mapping-table-index-out-of-bounds) + (label IVBadInst) + (illegal-operand self-type-error)) + + +(define-instruction |DoInstanceRef| :operand-from-stack-immediate () + (stack-read2 iSP arg3 arg4) + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (with-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (locate-arbitrary-instance-variable arg3 arg4 arg2 arg1 arg5 + IVRefBadInst IVRefBadOffset + t1 t2 t3 t4 t5 t6 t7 t8)) + (memory-read arg5 t2 t1 PROCESSORSTATE_DATAREAD t4 t5 t6 t7 nil t) + (AND t2 #x3F t2 "set CDR-NEXT") + (GetNextPCandCP) + (stack-write2 iSP t2 t1) + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoInstanceSet| :operand-from-stack-immediate () + (stack-pop2 arg3 arg4) + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (with-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (locate-arbitrary-instance-variable arg3 arg4 arg2 arg1 arg5 + IVRefBadInst3 IVRefBadOffset + t1 t2 t3 t4 t5 t6 t7 t8)) + (stack-pop2 t2 t1) + (with-multiple-memory-reads (t9 t10 t11 t12) + (store-contents arg5 t2 t1 PROCESSORSTATE_DATAWRITE t3 t4 t5 t6 t7 t8 + NextInstruction)) + (ContinueToNextInstruction) + (label IVRefBadInst3) + (illegal-operand (%instance-reference-type-error :three-argument))) + +(define-instruction |DoInstanceLoc| :operand-from-stack-immediate () + (stack-read2 iSP arg3 arg4) + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (with-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (locate-arbitrary-instance-variable arg3 arg4 arg2 arg1 arg5 + IVRefBadInst IVRefBadOffset + t1 t2 t3 t4 t5 t6 t7 t8)) + (stack-write-ir |TypeLocative| arg5 t7) + (ContinueToNextInstruction) + (label IVRefBadInst) + (illegal-operand (%instance-reference-type-error :binary)) + (label IVRefBadOffset) + (illegal-operand illegal-instance-variable-index-from-memory)) + + +(comment "Fin.") diff --git a/alpha-emulator/ifuninst.s b/alpha-emulator/ifuninst.s new file mode 100644 index 0000000..d9a6af9 --- /dev/null +++ b/alpha-emulator/ifuninst.s @@ -0,0 +1,2183 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuninst.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Instance variable accessors.. */ +.align 5 +.globl DoPopInstanceVariable +.ent DoPopInstanceVariable 0 +/* Halfword 10 bit immediate instruction - DoPopInstanceVariable */ + .globl DoPopInstanceVariableFP + .globl DoPopInstanceVariableSP + .globl DoPopInstanceVariableLP + .globl DoPopInstanceVariableIM +.align 3 +DoPopInstanceVariable: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPopInstanceVariable" +#endif +.align 3 +DoPopInstanceVariableIM: +.align 3 +DoPopInstanceVariableSP: +.align 3 +DoPopInstanceVariableLP: +.align 3 +DoPopInstanceVariableFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Instance Variable Mapped */ + ldl $16, 16($10) # Map [1] + ldl $1, 20($10) # [1] + extll $16, 0, $16 # [2di] + subq $1, TypeArray, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, IVBADMAP # [1] +/* Memory Read Internal */ +G14349: + addq $16, $14, $22 # [0di] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14351 # [0di] +G14350: + lda $22, 64 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + blbs $23, G14353 # [1di] +G14358: + and $2, ArrayLengthMask, $2 # [1-] + subq $2, $17, $5 # [1] + ble $5, IVBADINDEX # J. if mapping-table-index-out-of-bounds [1] + addq $16, $17, $16 # [0di] + addq $16, 1, $16 # [1] +/* Memory Read Internal */ +G14359: + addq $16, $14, $22 # [1] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14361 # [0di] +G14360: + lda $22, 240 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + extll $2, 0, $2 # [1] + blbs $23, G14363 # [1-] +G14370: + bis $2, $31, $3 # [1di] + subq $1, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, POPIVIEX # [1] + ldl $16, 24($10) # Self [0di] + ldl $6, 28($10) # [1] + extll $16, 0, $16 # [2di] + subq $6, TypeInstance, $5 # [1] + and $5, 60, $5 # Strip CDR code, low bits [1] + bne $5, IVBADINST # [1] + and $6, 192, $5 # Unshifted cdr code [1] + subq $5, 64, $5 # Check for CDR code 1 [1] + bne $5, G14348 # J. if CDR code is not 1 [1] +.align 3 +G14347: + addq $16, $3, $16 # [1-] +.align 3 +G14346: + ldl $1, 0($12) # [1-] + ldl $2, 4($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [1] + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G14371: + addq $16, $14, $8 # [1-] + s4addq $8, $31, $5 # [1] + ldq_u $4, 0($8) # [1-] + subq $16, $20, $6 # Stack cache offset [0di] + ldq $22, PROCESSORSTATE_DATAWRITE_MASK($14) # [1-] + cmpult $6, $21, $7 # In range? [0di] + ldl $5, 0($5) # [1-] + extbl $4, $8, $4 # [1di] + bne $7, G14373 # [1-] +G14372: + lda $8, 240 # [0di] + srl $22, $4, $22 # [1] + srl $8, $4, $8 # [1] + blbs $22, G14375 # [1-] +G14381: +/* Merge cdr-code */ + and $2, 63, $5 # [0di] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + addq $16, $14, $6 # [1] + s4addq $6, $31, $5 # [1] + ldq_u $8, 0($6) # [1-] + subq $16, $20, $7 # Stack cache offset [0di] + cmpult $7, $21, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G14383: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $1, 0($5) # [1] + bne $22, G14382 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +POPIVIEX: + lda $1, 8 # [1-] +/* SetTag. */ + sll $1, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $2, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +G14382: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + subq $16, $20, $7 # Stack cache offset [0di] + s8addq $7, $6, $6 # reconstruct SCA [3] + stl $1, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14373: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G14372 # [1] +.align 3 +G14375: + blbc $8, G14374 # [1] + extll $5, 0, $16 # Do the indirect thing [0di] + br $31, G14371 # [1-] +.align 3 +G14374: + ldq $22, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $22, $8 # Adjust for a longword load [2di] + ldl $22, 0($8) # Get the memory action [2] +#ifndef MINIMA +G14378: +#endif +#ifdef MINIMA +.align 3 +G14378: + and $22, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G14377 # [1-] + sll $16, 1, $6 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $6, $7, $6 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $6, $8, $6 # [1] + extll $6, 0, $6 # Clear sign-extension [1] + s4addq $6, $7, $7 # [2] + ldl $6, 0($7) # Fetch the key [2] + ldl $5, 4($7) # Fetch value [1] + subl $16, $6, $8 # Compare [2di] + bne $8, G14380 # Trap on miss [1] + extll $5, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14371 # This is another memory read tailcall. [1-] +.align 3 +G14380: + br $31, DBCACHEMISSTRAP +#endif +G14377: +/* Perform memory action */ + bis $31, $22, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14361: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14360 # [1] +.align 3 +G14363: + blbc $22, G14362 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14359 # [1-] +.align 3 +G14362: + ldq $23, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +.align 3 +G14367: + and $23, MemoryActionTransform, $22 # [3] + beq $22, G14366 # [1] + bic $1, 63, $1 # [1-] + bis $1, TypeExternalValueCellPointer, $1 # [1] + br $31, G14370 # [1-] +#ifndef MINIMA +G14366: +#endif +#ifdef MINIMA +.align 3 +G14366: + and $23, MemoryActionBinding, $22 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $22, G14365 # [1-] + sll $16, 1, $7 # [0di] + ldq $22, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $22, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $2, 4($8) # Fetch value [1] + subl $16, $7, $22 # Compare [2di] + bne $22, G14369 # Trap on miss [1] + extll $2, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14359 # This is another memory read tailcall. [1-] +.align 3 +G14369: + br $31, DBCACHEMISSTRAP +#endif +G14365: +/* Perform memory action */ + bis $31, $23, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14351: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14350 # [1] +.align 3 +G14353: + blbc $22, G14352 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14349 # [1-] +.align 3 +G14352: + ldq $23, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +G14355: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14348: + bis $16, $31, $5 # [1] +/* Memory Read Internal */ +G14384: + addq $16, $14, $22 # [1] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14386 # [0di] +G14385: + lda $22, 64 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + extll $2, 0, $2 # [1] + blbs $23, G14388 # [1-] +G14393: + subq $5, $16, $5 # [0di] + bne $5, G14347 # [1] +/* TagType. */ + and $6, 63, $6 # [0di] + bis $6, 64, $6 # Set CDR code to 1 [1] + stl $16, 24($10) # Update self [0di] + stl $6, 28($10) # write the stack cache [1] + br $31, G14347 # [1] +.align 3 +G14386: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14385 # [1] +.align 3 +G14388: + blbc $22, G14387 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14384 # [1-] +.align 3 +G14387: + ldq $23, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +G14390: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoPopInstanceVariable +/* End of Halfword operand from stack instruction - DoPopInstanceVariable */ +.align 5 +.globl DoMovemInstanceVariable +.ent DoMovemInstanceVariable 0 +/* Halfword 10 bit immediate instruction - DoMovemInstanceVariable */ + .globl DoMovemInstanceVariableFP + .globl DoMovemInstanceVariableSP + .globl DoMovemInstanceVariableLP + .globl DoMovemInstanceVariableIM +.align 3 +DoMovemInstanceVariable: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoMovemInstanceVariable" +#endif +.align 3 +DoMovemInstanceVariableIM: +.align 3 +DoMovemInstanceVariableSP: +.align 3 +DoMovemInstanceVariableLP: +.align 3 +DoMovemInstanceVariableFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Instance Variable Mapped */ + ldl $16, 16($10) # Map [1] + ldl $1, 20($10) # [1] + extll $16, 0, $16 # [2di] + subq $1, TypeArray, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, IVBADMAP # [1] +/* Memory Read Internal */ +G14397: + addq $16, $14, $22 # [0di] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14399 # [0di] +G14398: + lda $22, 64 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + blbs $23, G14401 # [1di] +G14406: + and $2, ArrayLengthMask, $2 # [1-] + subq $2, $17, $5 # [1] + ble $5, IVBADINDEX # J. if mapping-table-index-out-of-bounds [1] + addq $16, $17, $16 # [0di] + addq $16, 1, $16 # [1] +/* Memory Read Internal */ +G14407: + addq $16, $14, $22 # [1] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14409 # [0di] +G14408: + lda $22, 240 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + extll $2, 0, $2 # [1] + blbs $23, G14411 # [1-] +G14418: + bis $2, $31, $3 # [1di] + subq $1, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, MOVEMIVIEX # [1] + ldl $16, 24($10) # Self [0di] + ldl $6, 28($10) # [1] + extll $16, 0, $16 # [2di] + subq $6, TypeInstance, $5 # [1] + and $5, 60, $5 # Strip CDR code, low bits [1] + bne $5, IVBADINST # [1] + and $6, 192, $5 # Unshifted cdr code [1] + subq $5, 64, $5 # Check for CDR code 1 [1] + bne $5, G14396 # J. if CDR code is not 1 [1] +.align 3 +G14395: + addq $16, $3, $16 # [1-] +.align 3 +G14394: + ldl $1, 0($12) # [1-] + ldl $2, 4($12) # [1] + extll $1, 0, $1 # [2-] + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G14419: + addq $16, $14, $8 # [0di] + s4addq $8, $31, $5 # [1] + ldq_u $4, 0($8) # [1di] + subq $16, $20, $6 # Stack cache offset [1-] + ldq $22, PROCESSORSTATE_DATAWRITE_MASK($14) # [0di] + cmpult $6, $21, $7 # In range? [1-] + ldl $5, 0($5) # [0di] + extbl $4, $8, $4 # [1-] + bne $7, G14421 # [0di] +G14420: + lda $8, 240 # [1-] + srl $22, $4, $22 # [1] + srl $8, $4, $8 # [1] + blbs $22, G14423 # [1di] +G14429: +/* Merge cdr-code */ + and $2, 63, $5 # [1-] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + addq $16, $14, $6 # [1] + s4addq $6, $31, $5 # [1] + ldq_u $8, 0($6) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + cmpult $7, $21, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G14431: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $1, 0($5) # [1] + bne $22, G14430 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +MOVEMIVIEX: + lda $1, 8 # [1-] +/* SetTag. */ + sll $1, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $2, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +G14430: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + subq $16, $20, $7 # Stack cache offset [0di] + s8addq $7, $6, $6 # reconstruct SCA [3] + stl $1, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14421: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G14420 # [1] +.align 3 +G14423: + blbc $8, G14422 # [1] + extll $5, 0, $16 # Do the indirect thing [0di] + br $31, G14419 # [1-] +.align 3 +G14422: + ldq $22, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $22, $8 # Adjust for a longword load [2di] + ldl $22, 0($8) # Get the memory action [2] +#ifndef MINIMA +G14426: +#endif +#ifdef MINIMA +.align 3 +G14426: + and $22, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G14425 # [1-] + sll $16, 1, $6 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $6, $7, $6 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $6, $8, $6 # [1] + extll $6, 0, $6 # Clear sign-extension [1] + s4addq $6, $7, $7 # [2] + ldl $6, 0($7) # Fetch the key [2] + ldl $5, 4($7) # Fetch value [1] + subl $16, $6, $8 # Compare [2di] + bne $8, G14428 # Trap on miss [1] + extll $5, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14419 # This is another memory read tailcall. [1-] +.align 3 +G14428: + br $31, DBCACHEMISSTRAP +#endif +G14425: +/* Perform memory action */ + bis $31, $22, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14409: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14408 # [1] +.align 3 +G14411: + blbc $22, G14410 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14407 # [1-] +.align 3 +G14410: + ldq $23, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +.align 3 +G14415: + and $23, MemoryActionTransform, $22 # [3] + beq $22, G14414 # [1] + bic $1, 63, $1 # [1-] + bis $1, TypeExternalValueCellPointer, $1 # [1] + br $31, G14418 # [1-] +#ifndef MINIMA +G14414: +#endif +#ifdef MINIMA +.align 3 +G14414: + and $23, MemoryActionBinding, $22 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $22, G14413 # [1-] + sll $16, 1, $7 # [0di] + ldq $22, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $22, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $2, 4($8) # Fetch value [1] + subl $16, $7, $22 # Compare [2di] + bne $22, G14417 # Trap on miss [1] + extll $2, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14407 # This is another memory read tailcall. [1-] +.align 3 +G14417: + br $31, DBCACHEMISSTRAP +#endif +G14413: +/* Perform memory action */ + bis $31, $23, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14399: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14398 # [1] +.align 3 +G14401: + blbc $22, G14400 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14397 # [1-] +.align 3 +G14400: + ldq $23, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +G14403: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14396: + bis $16, $31, $5 # [1] +/* Memory Read Internal */ +G14432: + addq $16, $14, $22 # [1] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14434 # [0di] +G14433: + lda $22, 64 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + extll $2, 0, $2 # [1] + blbs $23, G14436 # [1-] +G14441: + subq $5, $16, $5 # [0di] + bne $5, G14395 # [1] +/* TagType. */ + and $6, 63, $6 # [0di] + bis $6, 64, $6 # Set CDR code to 1 [1] + stl $16, 24($10) # Update self [0di] + stl $6, 28($10) # write the stack cache [1] + br $31, G14395 # [1] +.align 3 +G14434: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14433 # [1] +.align 3 +G14436: + blbc $22, G14435 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14432 # [1-] +.align 3 +G14435: + ldq $23, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +G14438: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoMovemInstanceVariable +/* End of Halfword operand from stack instruction - DoMovemInstanceVariable */ +.align 5 +.globl DoPushAddressInstanceVariable +.ent DoPushAddressInstanceVariable 0 +/* Halfword 10 bit immediate instruction - DoPushAddressInstanceVariable */ + .globl DoPushAddressInstanceVariableFP + .globl DoPushAddressInstanceVariableSP + .globl DoPushAddressInstanceVariableLP + .globl DoPushAddressInstanceVariableIM +.align 3 +DoPushAddressInstanceVariable: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPushAddressInstanceVariable" +#endif +.align 3 +DoPushAddressInstanceVariableIM: +.align 3 +DoPushAddressInstanceVariableSP: +.align 3 +DoPushAddressInstanceVariableLP: +.align 3 +DoPushAddressInstanceVariableFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Instance Variable Mapped */ + ldl $16, 16($10) # Map [1] + ldl $1, 20($10) # [1] + extll $16, 0, $16 # [2di] + subq $1, TypeArray, $4 # [1] + and $4, 63, $4 # Strip CDR code [1] + bne $4, IVBADMAP # [1] +/* Memory Read Internal */ +G14445: + addq $16, $14, $22 # [0di] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14447 # [0di] +G14446: + lda $22, 64 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + blbs $23, G14449 # [1di] +G14454: + and $2, ArrayLengthMask, $2 # [1-] + subq $2, $17, $5 # [1] + ble $5, IVBADINDEX # J. if mapping-table-index-out-of-bounds [1] + addq $16, $17, $16 # [0di] + addq $16, 1, $16 # [1] +/* Memory Read Internal */ +G14455: + addq $16, $14, $22 # [1] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14457 # [0di] +G14456: + lda $22, 240 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + extll $2, 0, $2 # [1] + blbs $23, G14459 # [1-] +G14466: + bis $2, $31, $3 # [1di] + subq $1, TypeFixnum, $6 # [1] + and $6, 63, $6 # Strip CDR code [1] + bne $6, PUSHADIVIEX # [1] + ldl $16, 24($10) # Self [0di] + ldl $6, 28($10) # [1] + extll $16, 0, $16 # [2di] + subq $6, TypeInstance, $5 # [1] + and $5, 60, $5 # Strip CDR code, low bits [1] + bne $5, IVBADINST # [1] + and $6, 192, $5 # Unshifted cdr code [1] + subq $5, 64, $5 # Check for CDR code 1 [1] + bne $5, G14444 # J. if CDR code is not 1 [1] +.align 3 +G14443: + addq $16, $3, $16 # [1-] +.align 3 +G14442: + bis $31, TypeLocative, $7 # [1] + stl $16, 8($12) # [0di] + stl $7, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +PUSHADIVIEX: + lda $1, 8 # [1-] +/* SetTag. */ + sll $1, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $2, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +G14457: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14456 # [1] +.align 3 +G14459: + blbc $22, G14458 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14455 # [1-] +.align 3 +G14458: + ldq $23, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +.align 3 +G14463: + and $23, MemoryActionTransform, $22 # [3] + beq $22, G14462 # [1] + bic $1, 63, $1 # [1-] + bis $1, TypeExternalValueCellPointer, $1 # [1] + br $31, G14466 # [1-] +#ifndef MINIMA +G14462: +#endif +#ifdef MINIMA +.align 3 +G14462: + and $23, MemoryActionBinding, $22 # [1-] + ldq $8, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $22, G14461 # [1-] + sll $16, 1, $7 # [0di] + ldq $22, PROCESSORSTATE_DBCBASE($14) # [1-] + and $7, $8, $7 # Hash index [1di] + bis $31, 1, $8 # [1] + sll $8, IvoryMemoryData, $8 # [1] + addl $7, $22, $7 # [1] + extll $7, 0, $7 # Clear sign-extension [1] + s4addq $7, $8, $8 # [2] + ldl $7, 0($8) # Fetch the key [2] + ldl $2, 4($8) # Fetch value [1] + subl $16, $7, $22 # Compare [2di] + bne $22, G14465 # Trap on miss [1] + extll $2, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14455 # This is another memory read tailcall. [1-] +.align 3 +G14465: + br $31, DBCACHEMISSTRAP +#endif +G14461: +/* Perform memory action */ + bis $31, $23, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14447: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14446 # [1] +.align 3 +G14449: + blbc $22, G14448 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14445 # [1-] +.align 3 +G14448: + ldq $23, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +G14451: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14444: + bis $16, $31, $5 # [1] +/* Memory Read Internal */ +G14467: + addq $16, $14, $22 # [1] + s4addq $22, $31, $2 # [1] + ldq_u $1, 0($22) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + ldq $23, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $7, $21, $8 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $1, $22, $1 # [1-] + bne $8, G14469 # [0di] +G14468: + lda $22, 64 # [1-] + srl $23, $1, $23 # [1] + srl $22, $1, $22 # [1] + extll $2, 0, $2 # [1] + blbs $23, G14471 # [1-] +G14476: + subq $5, $16, $5 # [0di] + bne $5, G14443 # [1] +/* TagType. */ + and $6, 63, $6 # [0di] + bis $6, 64, $6 # Set CDR code to 1 [1] + stl $16, 24($10) # Update self [0di] + stl $6, 28($10) # write the stack cache [1] + br $31, G14443 # [1] +.align 3 +G14469: + ldq $8, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $7, $8, $7 # reconstruct SCA [3] + ldl $2, 0($7) # [2] + ldl $1, 4($7) # Read from stack cache [1] + br $31, G14468 # [1] +.align 3 +G14471: + blbc $22, G14470 # [1] + extll $2, 0, $16 # Do the indirect thing [0di] + br $31, G14467 # [1-] +.align 3 +G14470: + ldq $23, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $1, 63, $22 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $22, $23, $22 # Adjust for a longword load [2di] + ldl $23, 0($22) # Get the memory action [2] +G14473: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoPushAddressInstanceVariable +/* End of Halfword operand from stack instruction - DoPushAddressInstanceVariable */ +.align 5 +.globl DoPushInstanceVariableOrdered +.ent DoPushInstanceVariableOrdered 0 +/* Halfword 10 bit immediate instruction - DoPushInstanceVariableOrdered */ + .globl DoPushInstanceVariableOrderedFP + .globl DoPushInstanceVariableOrderedSP + .globl DoPushInstanceVariableOrderedLP + .globl DoPushInstanceVariableOrderedIM +.align 3 +DoPushInstanceVariableOrdered: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPushInstanceVariableOrdered" +#endif +.align 3 +DoPushInstanceVariableOrderedIM: +.align 3 +DoPushInstanceVariableOrderedSP: +.align 3 +DoPushInstanceVariableOrderedLP: +.align 3 +DoPushInstanceVariableOrderedFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Instance Variable Unmapped */ + ldl $2, 24($10) # self [1] + ldl $1, 28($10) # [1] + extll $2, 0, $2 # [2di] + subq $1, TypeInstance, $3 # [1] + and $3, 60, $3 # Strip CDR code, low bits [1] + bne $3, IVBADINST # [1] + addq $2, $17, $16 # [0di] +/* Memory Read Internal */ +G14477: + addq $16, $14, $6 # [1] + s4addq $6, $31, $1 # [1] + ldq_u $2, 0($6) # [1-] + subq $16, $20, $4 # Stack cache offset [0di] + ldq $7, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $4, $21, $5 # In range? [0di] + ldl $1, 0($1) # [1-] + extbl $2, $6, $2 # [1di] + bne $5, G14479 # [1-] +G14478: + lda $6, 240 # [0di] + srl $7, $2, $7 # [1] + srl $6, $2, $6 # [1] + blbs $7, G14481 # [1-] +G14488: + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + and $2, 63, $7 # set CDR-NEXT [0di] + stl $1, 8($12) # [1-] + stl $7, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G14479: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $4, $5, $4 # reconstruct SCA [3] + ldl $1, 0($4) # [2] + ldl $2, 4($4) # Read from stack cache [1] + br $31, G14478 # [1] +.align 3 +G14481: + blbc $6, G14480 # [1] + extll $1, 0, $16 # Do the indirect thing [0di] + br $31, G14477 # [1-] +.align 3 +G14480: + ldq $7, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $7, $6 # Adjust for a longword load [2di] + ldl $7, 0($6) # Get the memory action [2] +.align 3 +G14485: + and $7, MemoryActionTransform, $6 # [3] + beq $6, G14484 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G14488 # [1-] +#ifndef MINIMA +G14484: +#endif +#ifdef MINIMA +.align 3 +G14484: + and $7, MemoryActionBinding, $6 # [1-] + ldq $5, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $6, G14483 # [1-] + sll $16, 1, $4 # [0di] + ldq $6, PROCESSORSTATE_DBCBASE($14) # [1-] + and $4, $5, $4 # Hash index [1di] + bis $31, 1, $5 # [1] + sll $5, IvoryMemoryData, $5 # [1] + addl $4, $6, $4 # [1] + extll $4, 0, $4 # Clear sign-extension [1] + s4addq $4, $5, $5 # [2] + ldl $4, 0($5) # Fetch the key [2] + ldl $1, 4($5) # Fetch value [1] + subl $16, $4, $6 # Compare [2di] + bne $6, G14487 # Trap on miss [1] + extll $1, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14477 # This is another memory read tailcall. [1-] +.align 3 +G14487: + br $31, DBCACHEMISSTRAP +#endif +G14483: +/* Perform memory action */ + bis $31, $7, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoPushInstanceVariableOrdered +/* End of Halfword operand from stack instruction - DoPushInstanceVariableOrdered */ +.align 5 +.globl DoPopInstanceVariableOrdered +.ent DoPopInstanceVariableOrdered 0 +/* Halfword 10 bit immediate instruction - DoPopInstanceVariableOrdered */ + .globl DoPopInstanceVariableOrderedFP + .globl DoPopInstanceVariableOrderedSP + .globl DoPopInstanceVariableOrderedLP + .globl DoPopInstanceVariableOrderedIM +.align 3 +DoPopInstanceVariableOrdered: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPopInstanceVariableOrdered" +#endif +.align 3 +DoPopInstanceVariableOrderedIM: +.align 3 +DoPopInstanceVariableOrderedSP: +.align 3 +DoPopInstanceVariableOrderedLP: +.align 3 +DoPopInstanceVariableOrderedFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Instance Variable Unmapped */ + ldl $2, 24($10) # self [1] + ldl $1, 28($10) # [1] + extll $2, 0, $2 # [2di] + subq $1, TypeInstance, $3 # [1] + and $3, 60, $3 # Strip CDR code, low bits [1] + bne $3, IVBADINST # [1] + addq $2, $17, $16 # [0di] + ldl $1, 0($12) # [1-] + ldl $2, 4($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [1] +/* Memory Read Internal */ +G14489: + addq $16, $14, $8 # [1] + s4addq $8, $31, $5 # [1] + ldq_u $4, 0($8) # [1-] + subq $16, $20, $6 # Stack cache offset [0di] + ldq $22, PROCESSORSTATE_DATAWRITE_MASK($14) # [1-] + cmpult $6, $21, $7 # In range? [0di] + ldl $5, 0($5) # [1-] + extbl $4, $8, $4 # [1di] + bne $7, G14491 # [1-] +G14490: + lda $8, 240 # [0di] + srl $22, $4, $22 # [1] + srl $8, $4, $8 # [1] + blbs $22, G14493 # [1-] +G14499: +/* Merge cdr-code */ + and $2, 63, $5 # [0di] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + addq $16, $14, $6 # [1] + s4addq $6, $31, $5 # [1] + ldq_u $8, 0($6) # [1-] + subq $16, $20, $7 # Stack cache offset [0di] + cmpult $7, $21, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G14501: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $1, 0($5) # [1] + bne $22, G14500 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14500: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $16, $20, $7 # Stack cache offset [0di] + s8addq $7, $6, $6 # reconstruct SCA [3] + stl $1, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14491: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G14490 # [1] +.align 3 +G14493: + blbc $8, G14492 # [1] + extll $5, 0, $16 # Do the indirect thing [0di] + br $31, G14489 # [1-] +.align 3 +G14492: + ldq $22, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $22, $8 # Adjust for a longword load [2di] + ldl $22, 0($8) # Get the memory action [2] +#ifndef MINIMA +G14496: +#endif +#ifdef MINIMA +.align 3 +G14496: + and $22, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G14495 # [1-] + sll $16, 1, $6 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $6, $7, $6 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $6, $8, $6 # [1] + extll $6, 0, $6 # Clear sign-extension [1] + s4addq $6, $7, $7 # [2] + ldl $6, 0($7) # Fetch the key [2] + ldl $5, 4($7) # Fetch value [1] + subl $16, $6, $8 # Compare [2di] + bne $8, G14498 # Trap on miss [1] + extll $5, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14489 # This is another memory read tailcall. [1-] +.align 3 +G14498: + br $31, DBCACHEMISSTRAP +#endif +G14495: +/* Perform memory action */ + bis $31, $22, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoPopInstanceVariableOrdered +/* End of Halfword operand from stack instruction - DoPopInstanceVariableOrdered */ +.align 5 +.globl DoMovemInstanceVariableOrdered +.ent DoMovemInstanceVariableOrdered 0 +/* Halfword 10 bit immediate instruction - DoMovemInstanceVariableOrdered */ + .globl DoMovemInstanceVariableOrderedFP + .globl DoMovemInstanceVariableOrderedSP + .globl DoMovemInstanceVariableOrderedLP + .globl DoMovemInstanceVariableOrderedIM +.align 3 +DoMovemInstanceVariableOrdered: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoMovemInstanceVariableOrdered" +#endif +.align 3 +DoMovemInstanceVariableOrderedIM: +.align 3 +DoMovemInstanceVariableOrderedSP: +.align 3 +DoMovemInstanceVariableOrderedLP: +.align 3 +DoMovemInstanceVariableOrderedFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Instance Variable Unmapped */ + ldl $2, 24($10) # self [1] + ldl $1, 28($10) # [1] + extll $2, 0, $2 # [2di] + subq $1, TypeInstance, $3 # [1] + and $3, 60, $3 # Strip CDR code, low bits [1] + bne $3, IVBADINST # [1] + addq $2, $17, $16 # [0di] + ldl $1, 0($12) # [1-] + ldl $2, 4($12) # [1] + extll $1, 0, $1 # [2-] +/* Memory Read Internal */ +G14502: + addq $16, $14, $8 # [1] + s4addq $8, $31, $5 # [1] + ldq_u $4, 0($8) # [1di] + subq $16, $20, $6 # Stack cache offset [1-] + ldq $22, PROCESSORSTATE_DATAWRITE_MASK($14) # [0di] + cmpult $6, $21, $7 # In range? [1-] + ldl $5, 0($5) # [0di] + extbl $4, $8, $4 # [1-] + bne $7, G14504 # [0di] +G14503: + lda $8, 240 # [1-] + srl $22, $4, $22 # [1] + srl $8, $4, $8 # [1] + blbs $22, G14506 # [1di] +G14512: +/* Merge cdr-code */ + and $2, 63, $5 # [1-] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + addq $16, $14, $6 # [1] + s4addq $6, $31, $5 # [1] + ldq_u $8, 0($6) # [1di] + subq $16, $20, $7 # Stack cache offset [1-] + cmpult $7, $21, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G14514: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $1, 0($5) # [1] + bne $22, G14513 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14513: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $16, $20, $7 # Stack cache offset [0di] + s8addq $7, $6, $6 # reconstruct SCA [3] + stl $1, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14504: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G14503 # [1] +.align 3 +G14506: + blbc $8, G14505 # [1] + extll $5, 0, $16 # Do the indirect thing [0di] + br $31, G14502 # [1-] +.align 3 +G14505: + ldq $22, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $22, $8 # Adjust for a longword load [2di] + ldl $22, 0($8) # Get the memory action [2] +#ifndef MINIMA +G14509: +#endif +#ifdef MINIMA +.align 3 +G14509: + and $22, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G14508 # [1-] + sll $16, 1, $6 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $6, $7, $6 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $6, $8, $6 # [1] + extll $6, 0, $6 # Clear sign-extension [1] + s4addq $6, $7, $7 # [2] + ldl $6, 0($7) # Fetch the key [2] + ldl $5, 4($7) # Fetch value [1] + subl $16, $6, $8 # Compare [2di] + bne $8, G14511 # Trap on miss [1] + extll $5, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G14502 # This is another memory read tailcall. [1-] +.align 3 +G14511: + br $31, DBCACHEMISSTRAP +#endif +G14508: +/* Perform memory action */ + bis $31, $22, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoMovemInstanceVariableOrdered +/* End of Halfword operand from stack instruction - DoMovemInstanceVariableOrdered */ +.align 5 +.globl DoPushAddressInstanceVariableOrdered +.ent DoPushAddressInstanceVariableOrdered 0 +/* Halfword 10 bit immediate instruction - DoPushAddressInstanceVariableOrdered */ + .globl DoPushAddressInstanceVariableOrderedFP + .globl DoPushAddressInstanceVariableOrderedSP + .globl DoPushAddressInstanceVariableOrderedLP + .globl DoPushAddressInstanceVariableOrderedIM +.align 3 +DoPushAddressInstanceVariableOrdered: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoPushAddressInstanceVariableOrdered" +#endif +.align 3 +DoPushAddressInstanceVariableOrderedIM: +.align 3 +DoPushAddressInstanceVariableOrderedSP: +.align 3 +DoPushAddressInstanceVariableOrderedLP: +.align 3 +DoPushAddressInstanceVariableOrderedFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ +/* Locate Instance Variable Unmapped */ + ldl $2, 24($10) # self [0di] + ldl $1, 28($10) # [1] + extll $2, 0, $2 # [2di] + subq $1, TypeInstance, $3 # [1] + and $3, 60, $3 # Strip CDR code, low bits [1] + bne $3, IVBADINST # [1] + addq $2, $17, $16 # [0di] + bis $31, TypeLocative, $7 # [1] + stl $16, 8($12) # [0di] + stl $7, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +IVBADMAP: + bis $31, 0, $20 # [1-] + bis $31, 68, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +IVBADINDEX: + bis $31, 0, $20 # [1] + bis $31, 53, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +IVBADINST: + bis $31, 0, $20 # [1] + bis $31, 69, $17 # [1] + br $31, ILLEGALOPERAND +.end DoPushAddressInstanceVariableOrdered +/* End of Halfword operand from stack instruction - DoPushAddressInstanceVariableOrdered */ +.align 5 +.globl DoInstanceRef +.ent DoInstanceRef 0 +/* Halfword operand from stack instruction - DoInstanceRef */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoInstanceRefFP + .globl DoInstanceRefSP + .globl DoInstanceRefLP + .globl DoInstanceRefIM +.align 3 +DoInstanceRef: +#ifdef TRACING + .byte 0x82 + .asciiz "DoInstanceRefIM" +#endif +.align 3 +DoInstanceRefIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoInstanceRef # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoInstanceRefSP" +#endif +.align 3 +DoInstanceRefSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoInstanceRef # [0di] + .byte 0x90 + .asciiz "DoInstanceRefLP" +#endif +.align 3 +DoInstanceRefLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoInstanceRef # [1] + .byte 0x84 + .asciiz "DoInstanceRefFP" +#endif +.align 3 +DoInstanceRefFP: # Entry point for FP relative +.align 3 +headDoInstanceRef: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoInstanceRef: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # [1] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2-] + srl $16, 32, $17 # [1] + extll $16, 0, $16 # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Arbitrary Instance Variable */ + subq $18, TypeInstance, $1 # [0di] + and $1, 60, $1 # Strip CDR code, low bits [1] + bne $1, IVREFBADINST # [1] + subq $17, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, IVREFBADOFFSET # [1] +/* Memory Read Internal */ +G14515: + addq $19, $14, $7 # [0di] + s4addq $7, $31, $1 # [1] + ldq_u $2, 0($7) # [1di] + subq $19, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $1, 0($1) # [0di] + extbl $2, $7, $2 # [1-] + bne $6, G14517 # [0di] +G14516: + lda $7, 64 # [1-] + srl $8, $2, $8 # [1] + srl $7, $2, $7 # [1] + extll $1, 0, $1 # [1] + blbs $8, G14519 # [1-] +G14524: + subq $1, 1, $1 # [1di] +/* Memory Read Internal */ +G14525: + addq $1, $14, $7 # [1] + s4addq $7, $31, $2 # [1] + ldq_u $4, 0($7) # [1-] + subq $1, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $2, 0($2) # [1-] + extbl $4, $7, $4 # [1di] + bne $6, G14527 # [1-] +G14526: + lda $7, 240 # [0di] + srl $8, $4, $8 # [1] + srl $7, $4, $7 # [1] + blbs $8, G14529 # [1-] +G14536: + subq $4, TypeFixnum, $5 # [0di] + and $5, 63, $5 # Strip CDR code [1] + bne $5, IVREFBADOFFSET # [1] + blt $16, IVREFBADOFFSET # J. if offset <0 [1] + subq $16, $2, $4 # [0di] + bge $4, IVREFBADOFFSET # J. if offset out of bounds [1] + addq $16, $19, $20 # [0di] +/* Memory Read Internal */ +G14537: + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $20, $14, $6 # [0di] + ldl $5, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $6, $31, $1 # [0di] + ldq_u $2, 0($6) # [1-] + subq $20, $4, $4 # Stack cache offset [1di] + ldq $7, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $4, $5, $5 # In range? [0di] + ldl $1, 0($1) # [1-] + extbl $2, $6, $2 # [0di] + bne $5, G14539 # [1-] +G14538: + lda $6, 240 # [0di] + srl $7, $2, $7 # [1] + srl $6, $2, $6 # [1] + blbs $7, G14541 # [1-] +G14548: + and $2, 63, $2 # set CDR-NEXT [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $1, 0($12) # [1] + stl $2, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G14539: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $4, $5, $4 # reconstruct SCA [3] + ldl $1, 0($4) # [2] + ldl $2, 4($4) # Read from stack cache [1] + br $31, G14538 # [1] +.align 3 +G14541: + blbc $6, G14540 # [1] + extll $1, 0, $20 # Do the indirect thing [0di] + br $31, G14537 # [1-] +.align 3 +G14540: + ldq $7, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $20, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $7, $6 # Adjust for a longword load [2di] + ldl $7, 0($6) # Get the memory action [2] +.align 3 +G14545: + and $7, MemoryActionTransform, $6 # [3] + beq $6, G14544 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G14548 # [1-] +#ifndef MINIMA +G14544: +#endif +#ifdef MINIMA +.align 3 +G14544: + and $7, MemoryActionBinding, $6 # [1-] + ldq $5, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $6, G14543 # [1-] + sll $20, 1, $4 # [0di] + ldq $6, PROCESSORSTATE_DBCBASE($14) # [1-] + and $4, $5, $4 # Hash index [1di] + bis $31, 1, $5 # [1] + sll $5, IvoryMemoryData, $5 # [1] + addl $4, $6, $4 # [1] + extll $4, 0, $4 # Clear sign-extension [1] + s4addq $4, $5, $5 # [2] + ldl $4, 0($5) # Fetch the key [2] + ldl $1, 4($5) # Fetch value [1] + subl $20, $4, $6 # Compare [2di] + bne $6, G14547 # Trap on miss [1] + extll $1, 0, $20 # Extract the pointer, and indirect [0di] + br $31, G14537 # This is another memory read tailcall. [1-] +.align 3 +G14547: + br $31, DBCACHEMISSTRAP +#endif +G14543: +/* Perform memory action */ + bis $31, $7, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14527: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $2, 0($5) # [2] + ldl $4, 4($5) # Read from stack cache [1] + br $31, G14526 # [1] +.align 3 +G14529: + blbc $7, G14528 # [1] + extll $2, 0, $1 # Do the indirect thing [0di] + br $31, G14525 # [1-] +.align 3 +G14528: + ldq $8, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $7 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +.align 3 +G14533: + and $8, MemoryActionTransform, $7 # [3] + beq $7, G14532 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G14536 # [1-] +#ifndef MINIMA +G14532: +#endif +#ifdef MINIMA +.align 3 +G14532: + and $8, MemoryActionBinding, $7 # [1-] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G14531 # [1-] + sll $1, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $2, 4($6) # Fetch value [1] + subl $1, $5, $7 # Compare [2di] + bne $7, G14535 # Trap on miss [1] + extll $2, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14525 # This is another memory read tailcall. [1-] +.align 3 +G14535: + br $31, DBCACHEMISSTRAP +#endif +G14531: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14517: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $1, 0($5) # [2] + ldl $2, 4($5) # Read from stack cache [1] + br $31, G14516 # [1] +.align 3 +G14519: + blbc $7, G14518 # [1] + extll $1, 0, $19 # Do the indirect thing [0di] + br $31, G14515 # [1-] +.align 3 +G14518: + ldq $8, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $7 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +G14521: +/* Perform memory action */ + bis $31, $8, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoInstanceRef +/* End of Halfword operand from stack instruction - DoInstanceRef */ +.align 5 +.globl DoInstanceSet +.ent DoInstanceSet 0 +/* Halfword operand from stack instruction - DoInstanceSet */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoInstanceSetFP + .globl DoInstanceSetSP + .globl DoInstanceSetLP + .globl DoInstanceSetIM +.align 3 +DoInstanceSet: +#ifdef TRACING + .byte 0x82 + .asciiz "DoInstanceSetIM" +#endif +.align 3 +DoInstanceSetIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoInstanceSet # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoInstanceSetSP" +#endif +.align 3 +DoInstanceSetSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoInstanceSet # [0di] + .byte 0x90 + .asciiz "DoInstanceSetLP" +#endif +.align 3 +DoInstanceSetLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoInstanceSet # [1] + .byte 0x84 + .asciiz "DoInstanceSetFP" +#endif +.align 3 +DoInstanceSetFP: # Entry point for FP relative +.align 3 +headDoInstanceSet: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoInstanceSet: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # [1] + ldl $18, 4($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + srl $16, 32, $17 # [1] + extll $16, 0, $16 # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Arbitrary Instance Variable */ + subq $18, TypeInstance, $1 # [1-] + and $1, 60, $1 # Strip CDR code, low bits [1] + bne $1, IVREFBADINST3 # [1] + subq $17, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, IVREFBADOFFSET # [1] +/* Memory Read Internal */ +G14549: + addq $19, $14, $7 # [1-] + s4addq $7, $31, $1 # [1] + ldq_u $2, 0($7) # [1-] + subq $19, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $1, 0($1) # [1-] + extbl $2, $7, $2 # [1di] + bne $6, G14551 # [1-] +G14550: + lda $7, 64 # [0di] + srl $8, $2, $8 # [1] + srl $7, $2, $7 # [1] + extll $1, 0, $1 # [1] + blbs $8, G14553 # [0di] +G14558: + subq $1, 1, $1 # [2-] +/* Memory Read Internal */ +G14559: + addq $1, $14, $7 # [1] + s4addq $7, $31, $2 # [1] + ldq_u $4, 0($7) # [1di] + subq $1, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $2, 0($2) # [0di] + extbl $4, $7, $4 # [1-] + bne $6, G14561 # [0di] +G14560: + lda $7, 240 # [1-] + srl $8, $4, $8 # [1] + srl $7, $4, $7 # [1] + blbs $8, G14563 # [1di] +G14570: + subq $4, TypeFixnum, $5 # [1-] + and $5, 63, $5 # Strip CDR code [1] + bne $5, IVREFBADOFFSET # [1] + blt $16, IVREFBADOFFSET # J. if offset <0 [1] + subq $16, $2, $4 # [1-] + bge $4, IVREFBADOFFSET # J. if offset out of bounds [1] + addq $16, $19, $20 # [1-] + ldl $1, 0($12) # [0di] + ldl $2, 4($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G14571: + addq $20, $14, $7 # [0di] + s4addq $7, $31, $4 # [1] + ldq_u $3, 0($7) # [1di] + subq $20, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAWRITE_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $4, 0($4) # [0di] + extbl $3, $7, $3 # [1-] + bne $6, G14573 # [0di] +G14572: + lda $7, 240 # [1-] + srl $8, $3, $8 # [1] + srl $7, $3, $7 # [1] + blbs $8, G14575 # [1di] +G14581: +/* Merge cdr-code */ + and $2, 63, $4 # [1-] + and $3, 192, $3 # [1] + bis $3, $4, $3 # [1] + addq $20, $14, $5 # [1] + s4addq $5, $31, $4 # [1] + ldq_u $7, 0($5) # [1di] + subq $20, $24, $6 # Stack cache offset [1-] + cmpult $6, $25, $8 # In range? [1] + insbl $3, $5, $6 # [1] + mskbl $7, $5, $7 # [1] +.align 3 +G14583: + bis $7, $6, $7 # [2] + stq_u $7, 0($5) # [0di] + stl $1, 0($4) # [1] + bne $8, G14582 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +IVREFBADINST3: + bis $31, 0, $20 # [1-] + bis $31, 4, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14582: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + subq $20, $24, $6 # Stack cache offset [0di] + s8addq $6, $5, $5 # reconstruct SCA [3] + stl $1, 0($5) # Store in stack [2] + stl $3, 4($5) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14573: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $4, 0($5) # [2] + ldl $3, 4($5) # Read from stack cache [1] + br $31, G14572 # [1] +.align 3 +G14575: + blbc $7, G14574 # [1] + extll $4, 0, $20 # Do the indirect thing [0di] + br $31, G14571 # [1-] +.align 3 +G14574: + ldq $8, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $3, 63, $7 # Discard the CDR code [0di] + stq $20, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +#ifndef MINIMA +G14578: +#endif +#ifdef MINIMA +.align 3 +G14578: + and $8, MemoryActionBinding, $7 # [3] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G14577 # [1-] + sll $20, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $4, 4($6) # Fetch value [1] + subl $20, $5, $7 # Compare [2di] + bne $7, G14580 # Trap on miss [1] + extll $4, 0, $20 # Extract the pointer, and indirect [0di] + br $31, G14571 # This is another memory read tailcall. [1-] +.align 3 +G14580: + br $31, DBCACHEMISSTRAP +#endif +G14577: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14561: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $2, 0($5) # [2] + ldl $4, 4($5) # Read from stack cache [1] + br $31, G14560 # [1] +.align 3 +G14563: + blbc $7, G14562 # [1] + extll $2, 0, $1 # Do the indirect thing [0di] + br $31, G14559 # [1-] +.align 3 +G14562: + ldq $8, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $7 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +.align 3 +G14567: + and $8, MemoryActionTransform, $7 # [3] + beq $7, G14566 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G14570 # [1-] +#ifndef MINIMA +G14566: +#endif +#ifdef MINIMA +.align 3 +G14566: + and $8, MemoryActionBinding, $7 # [1-] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G14565 # [1-] + sll $1, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $2, 4($6) # Fetch value [1] + subl $1, $5, $7 # Compare [2di] + bne $7, G14569 # Trap on miss [1] + extll $2, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14559 # This is another memory read tailcall. [1-] +.align 3 +G14569: + br $31, DBCACHEMISSTRAP +#endif +G14565: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14551: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $1, 0($5) # [2] + ldl $2, 4($5) # Read from stack cache [1] + br $31, G14550 # [1] +.align 3 +G14553: + blbc $7, G14552 # [1] + extll $1, 0, $19 # Do the indirect thing [0di] + br $31, G14549 # [1-] +.align 3 +G14552: + ldq $8, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $7 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +G14555: +/* Perform memory action */ + bis $31, $8, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoInstanceSet +/* End of Halfword operand from stack instruction - DoInstanceSet */ +.align 5 +.globl DoInstanceLoc +.ent DoInstanceLoc 0 +/* Halfword operand from stack instruction - DoInstanceLoc */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoInstanceLocFP + .globl DoInstanceLocSP + .globl DoInstanceLocLP + .globl DoInstanceLocIM +.align 3 +DoInstanceLoc: +#ifdef TRACING + .byte 0x82 + .asciiz "DoInstanceLocIM" +#endif +.align 3 +DoInstanceLocIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoInstanceLoc # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoInstanceLocSP" +#endif +.align 3 +DoInstanceLocSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoInstanceLoc # [0di] + .byte 0x90 + .asciiz "DoInstanceLocLP" +#endif +.align 3 +DoInstanceLocLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoInstanceLoc # [1] + .byte 0x84 + .asciiz "DoInstanceLocFP" +#endif +.align 3 +DoInstanceLocFP: # Entry point for FP relative +.align 3 +headDoInstanceLoc: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoInstanceLoc: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $19, 0($12) # [1] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2-] + srl $16, 32, $17 # [1] + extll $16, 0, $16 # [1] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Locate Arbitrary Instance Variable */ + subq $18, TypeInstance, $1 # [0di] + and $1, 60, $1 # Strip CDR code, low bits [1] + bne $1, IVREFBADINST # [1] + subq $17, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, IVREFBADOFFSET # [1] +/* Memory Read Internal */ +G14584: + addq $19, $14, $7 # [0di] + s4addq $7, $31, $1 # [1] + ldq_u $2, 0($7) # [1di] + subq $19, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_HEADER_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $1, 0($1) # [0di] + extbl $2, $7, $2 # [1-] + bne $6, G14586 # [0di] +G14585: + lda $7, 64 # [1-] + srl $8, $2, $8 # [1] + srl $7, $2, $7 # [1] + extll $1, 0, $1 # [1] + blbs $8, G14588 # [1-] +G14593: + subq $1, 1, $1 # [1di] +/* Memory Read Internal */ +G14594: + addq $1, $14, $7 # [1] + s4addq $7, $31, $2 # [1] + ldq_u $4, 0($7) # [1-] + subq $1, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $2, 0($2) # [1-] + extbl $4, $7, $4 # [1di] + bne $6, G14596 # [1-] +G14595: + lda $7, 240 # [0di] + srl $8, $4, $8 # [1] + srl $7, $4, $7 # [1] + blbs $8, G14598 # [1-] +G14605: + subq $4, TypeFixnum, $5 # [0di] + and $5, 63, $5 # Strip CDR code [1] + bne $5, IVREFBADOFFSET # [1] + blt $16, IVREFBADOFFSET # J. if offset <0 [1] + subq $16, $2, $4 # [0di] + bge $4, IVREFBADOFFSET # J. if offset out of bounds [1] + addq $16, $19, $20 # [0di] + bis $31, TypeLocative, $7 # [1] + stl $20, 0($12) # [0di] + stl $7, 4($12) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +IVREFBADINST: + bis $31, 0, $20 # [1-] + bis $31, 3, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +IVREFBADOFFSET: + bis $31, 0, $20 # [1] + bis $31, 49, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14596: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $2, 0($5) # [2] + ldl $4, 4($5) # Read from stack cache [1] + br $31, G14595 # [1] +.align 3 +G14598: + blbc $7, G14597 # [1] + extll $2, 0, $1 # Do the indirect thing [0di] + br $31, G14594 # [1-] +.align 3 +G14597: + ldq $8, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $7 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +.align 3 +G14602: + and $8, MemoryActionTransform, $7 # [3] + beq $7, G14601 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G14605 # [1-] +#ifndef MINIMA +G14601: +#endif +#ifdef MINIMA +.align 3 +G14601: + and $8, MemoryActionBinding, $7 # [1-] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G14600 # [1-] + sll $1, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $2, 4($6) # Fetch value [1] + subl $1, $5, $7 # Compare [2di] + bne $7, G14604 # Trap on miss [1] + extll $2, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G14594 # This is another memory read tailcall. [1-] +.align 3 +G14604: + br $31, DBCACHEMISSTRAP +#endif +G14600: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G14586: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $1, 0($5) # [2] + ldl $2, 4($5) # Read from stack cache [1] + br $31, G14585 # [1] +.align 3 +G14588: + blbc $7, G14587 # [1] + extll $1, 0, $19 # Do the indirect thing [0di] + br $31, G14584 # [1-] +.align 3 +G14587: + ldq $8, PROCESSORSTATE_HEADER($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $7 # Discard the CDR code [0di] + stq $19, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +G14590: +/* Perform memory action */ + bis $31, $8, $16 # [3] + bis $31, 6, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoInstanceLoc +/* End of Halfword operand from stack instruction - DoInstanceLoc */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifuninst.as */ diff --git a/alpha-emulator/ifunjosh.as b/alpha-emulator/ifunjosh.as new file mode 100644 index 0000000..950780b --- /dev/null +++ b/alpha-emulator/ifunjosh.as @@ -0,0 +1,70 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "'AI' instructions.") + +(define-instruction |DoDereference| :operand-from-stack-signed-immediate () + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (type-dispatch arg2 t1 t2 + ((|TypeOneQForward| |TypeElementForward| |TypeHeaderForward| + |TypeExternalValueCellPointer|) + (memory-read arg1 t4 t3 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t) + (stack-push2 t4 t3 t5) + (ContinueToNextInstruction)) + (|TypeLogicVariable| + (stack-push-ir |TypeExternalValueCellPointer| arg1 t5) + (ContinueToNextInstruction)) + (:else + (stack-push2 arg2 arg1 t5) + (ContinueToNextInstruction)))) + +(define-instruction |DoUnify| :operand-from-stack-signed-immediate () + (UnimplementedInstruction) ;let's do this one when my brain is in! + (ContinueToNextInstruction)) + +(define-instruction |DoPushLocalLogicVariables| :operand-from-stack-immediate () + (BIS zero |TypeLogicVariable| arg6) + (SRL arg1 32 t1) + (EXTLL arg1 0 arg2) + (CheckDataType t1 |TypeFixnum| pllvillop t2) + (stack-cache-overflow-check t1 t2 t3 t4 t5 iSP arg2) + (BR zero pllvloopend) + (label pllvlooptop) + (stack-push2-with-cdr arg6 iSP) ;+++ wrongo + (label pllvloopend) + (SUBQ arg2 1 arg2) + (BGE arg2 pllvlooptop "J. If iterations to go.") + (ContinueToNextInstruction) + (label pllvillop) + (illegal-operand one-operand-fixnum-type-error)) ;+++ microcode doesn't do this + +(define-instruction |DoPushGlobalLogicVariable| :operand-from-stack-signed-immediate () + (LDL t1 PROCESSORSTATE_BAR2 (ivory) "Get the structure stack pointer") + (BIS zero |TypeExternalValueCellPointer| t3) + (stack-push2-with-cdr t3 t1) + (store-contents t1 t3 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9) + (ADDQ t1 1 t2 "Increment the structure-stack-pointer") + (STL t2 PROCESSORSTATE_BAR2 (ivory) "Set the structure stack pointer") + (ContinueToNextInstruction)) + +(define-instruction |DoLogicTailTest| :operand-from-stack-signed-immediate () + (SRL arg1 32 arg2) + (type-dispatch arg2 t1 t2 + (|TypeList| + (stack-push-nil t3 t4) + (ContinueToNextInstruction)) + (|TypeExternalValueCellPointer| + (stack-push-t t3 t4) + (ContinueToNextInstruction)) + (|TypeListInstance| + (stack-push-nil t3 t4) + (ContinueToNextInstruction)) + (:else + (prepare-exception logic-tail-test 0 arg1 t2) + (instruction-exception)))) + +(comment "Fin.") diff --git a/alpha-emulator/ifunjosh.s b/alpha-emulator/ifunjosh.s new file mode 100644 index 0000000..063942c --- /dev/null +++ b/alpha-emulator/ifunjosh.s @@ -0,0 +1,606 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunjosh.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* 'AI' instructions. */ +.align 5 +.globl DoDereference +.ent DoDereference 0 +/* Halfword operand from stack instruction - DoDereference */ + .globl DoDereferenceFP + .globl DoDereferenceSP + .globl DoDereferenceLP + .globl DoDereferenceIM +.align 3 +DoDereference: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoDereferenceIM" +#endif +.align 3 +DoDereferenceIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G16058: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoDereference # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoDereferenceSP" +#endif +.align 3 +DoDereferenceSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoDereference # [0di] + .byte 0x90 + .asciiz "DoDereferenceLP" +#endif +.align 3 +DoDereferenceLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoDereference # [1] + .byte 0x84 + .asciiz "DoDereferenceFP" +#endif +.align 3 +DoDereferenceFP: # Entry point for FP relative +.align 3 +headDoDereference: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoDereference: +/* arg1 has the operand, sign extended if immediate. */ + srl $16, 32, $17 # [3] + extll $16, 0, $16 # [1] + and $17, 63, $1 # Strip off any CDR code bits. [1] + cmpeq $1, TypeOneQForward, $2 # [1] +.align 3 +G16053: + bne $2, G16049 # [1] + cmpeq $1, TypeElementForward, $2 # [1] +.align 3 +G16054: + bne $2, G16049 # [1] + cmpeq $1, TypeHeaderForward, $2 # [1] +.align 3 +G16055: + bne $2, G16049 # [1] + cmpeq $1, TypeExternalValueCellPointer, $2 # [1] +.align 3 +G16056: + beq $2, G16036 # [1] +.align 3 +G16049: +/* Here if argument (TypeOneQForward TypeElementForward TypeHeaderForward TypeExternalValueCellPointer) */ +/* Memory Read Internal */ +G16037: + ldq $5, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $16, $14, $7 # [0di] + ldl $6, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $7, $31, $3 # [0di] + ldq_u $4, 0($7) # [1-] + subq $16, $5, $5 # Stack cache offset [1di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $6, $6 # In range? [0di] + ldl $3, 0($3) # [1-] + extbl $4, $7, $4 # [0di] + bne $6, G16039 # [1-] +G16038: + lda $7, 240 # [0di] + srl $8, $4, $8 # [1] + srl $7, $4, $7 # [1] + blbs $8, G16041 # [1-] +G16048: + and $4, 63, $5 # set CDR-NEXT [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +G16036: + cmpeq $1, TypeLogicVariable, $2 # [1-] +.align 3 +G16057: + beq $2, G16050 # [1] +/* Here if argument TypeLogicVariable */ + bis $31, TypeExternalValueCellPointer, $5 # [0di] + stl $16, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +G16050: +/* Here for all other cases */ + and $17, 63, $5 # set CDR-NEXT [1-] + stl $16, 8($12) # [1di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +G16035: +.align 3 +G16039: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $5, $6, $5 # reconstruct SCA [3] + ldl $3, 0($5) # [2] + ldl $4, 4($5) # Read from stack cache [1] + br $31, G16038 # [1] +.align 3 +G16041: + blbc $7, G16040 # [1] + extll $3, 0, $16 # Do the indirect thing [0di] + br $31, G16037 # [1-] +.align 3 +G16040: + ldq $8, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $7 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $7, $8, $7 # Adjust for a longword load [2di] + ldl $8, 0($7) # Get the memory action [2] +.align 3 +G16045: + and $8, MemoryActionTransform, $7 # [3] + beq $7, G16044 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G16048 # [1-] +#ifndef MINIMA +G16044: +#endif +#ifdef MINIMA +.align 3 +G16044: + and $8, MemoryActionBinding, $7 # [1-] + ldq $6, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $7, G16043 # [1-] + sll $16, 1, $5 # [0di] + ldq $7, PROCESSORSTATE_DBCBASE($14) # [1-] + and $5, $6, $5 # Hash index [1di] + bis $31, 1, $6 # [1] + sll $6, IvoryMemoryData, $6 # [1] + addl $5, $7, $5 # [1] + extll $5, 0, $5 # Clear sign-extension [1] + s4addq $5, $6, $6 # [2] + ldl $5, 0($6) # Fetch the key [2] + ldl $3, 4($6) # Fetch value [1] + subl $16, $5, $7 # Compare [2di] + bne $7, G16047 # Trap on miss [1] + extll $3, 0, $16 # Extract the pointer, and indirect [0di] + br $31, G16037 # This is another memory read tailcall. [1-] +.align 3 +G16047: + br $31, DBCACHEMISSTRAP +#endif +G16043: +/* Perform memory action */ + bis $31, $8, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoDereference +/* End of Halfword operand from stack instruction - DoDereference */ +.align 5 +.globl DoUnify +.ent DoUnify 0 +/* Halfword operand from stack instruction - DoUnify */ + .globl DoUnifyFP + .globl DoUnifySP + .globl DoUnifyLP + .globl DoUnifyIM +.align 3 +DoUnify: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoUnifyIM" +#endif +.align 3 +DoUnifyIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G16059: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoUnify # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoUnifySP" +#endif +.align 3 +DoUnifySP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoUnify # [0di] + .byte 0x90 + .asciiz "DoUnifyLP" +#endif +.align 3 +DoUnifyLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoUnify # [1] + .byte 0x84 + .asciiz "DoUnifyFP" +#endif +.align 3 +DoUnifyFP: # Entry point for FP relative +.align 3 +headDoUnify: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoUnify: +/* arg1 has the operand, sign extended if immediate. */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [1-] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND + br $31, NEXTINSTRUCTION # [1-] +.end DoUnify +/* End of Halfword operand from stack instruction - DoUnify */ +.align 5 +.globl DoPushLocalLogicVariables +.ent DoPushLocalLogicVariables 0 +/* Halfword operand from stack instruction - DoPushLocalLogicVariables */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPushLocalLogicVariablesFP + .globl DoPushLocalLogicVariablesSP + .globl DoPushLocalLogicVariablesLP + .globl DoPushLocalLogicVariablesIM +.align 3 +DoPushLocalLogicVariables: +#ifdef TRACING + .byte 0x82 + .asciiz "DoPushLocalLogicVariablesIM" +#endif +.align 3 +DoPushLocalLogicVariablesIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoPushLocalLogicVariables # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoPushLocalLogicVariablesSP" +#endif +.align 3 +DoPushLocalLogicVariablesSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoPushLocalLogicVariables # [0di] + .byte 0x90 + .asciiz "DoPushLocalLogicVariablesLP" +#endif +.align 3 +DoPushLocalLogicVariablesLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoPushLocalLogicVariables # [1] + .byte 0x84 + .asciiz "DoPushLocalLogicVariablesFP" +#endif +.align 3 +DoPushLocalLogicVariablesFP: # Entry point for FP relative +.align 3 +headDoPushLocalLogicVariables: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoPushLocalLogicVariables: +/* arg1 has the operand, not sign extended if immediate. */ + bis $31, TypeLogicVariable, $21 # [1-] + srl $16, 32, $1 # [2] + extll $16, 0, $17 # [1] + subq $1, TypeFixnum, $2 # [1] + and $2, 63, $2 # Strip CDR code [1] + bne $2, PLLVILLOP # [1] + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # Current stack cache limit (words) [1-] + lda $1, 128 # [0di] + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1-] + addq $1, $17, $1 # Account for what we're about to push [0di] + s8addq $1, $12, $1 # SCA of desired end of cache [1] + s8addq $4, $2, $2 # SCA of current end of cache [2] + cmple $1, $2, $4 # [1] + beq $4, StackCacheOverflowHandler # We're done if new SCA is within bounds [1] + br $31, PLLVLOOPEND # [1] +.align 3 +PLLVLOOPTOP: + stl $12, 8($12) # [1] + stl $21, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] +.align 3 +PLLVLOOPEND: + subq $17, 1, $17 # [1] + bge $17, PLLVLOOPTOP # J. If iterations to go. [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +PLLVILLOP: + bis $31, 0, $20 # [1-] + bis $31, 63, $17 # [1] + br $31, ILLEGALOPERAND +.end DoPushLocalLogicVariables +/* End of Halfword operand from stack instruction - DoPushLocalLogicVariables */ +.align 5 +.globl DoPushGlobalLogicVariable +.ent DoPushGlobalLogicVariable 0 +/* Halfword operand from stack instruction - DoPushGlobalLogicVariable */ + .globl DoPushGlobalLogicVariableFP + .globl DoPushGlobalLogicVariableSP + .globl DoPushGlobalLogicVariableLP + .globl DoPushGlobalLogicVariableIM +.align 3 +DoPushGlobalLogicVariable: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoPushGlobalLogicVariableIM" +#endif +.align 3 +DoPushGlobalLogicVariableIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G16076: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoPushGlobalLogicVariable # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoPushGlobalLogicVariableSP" +#endif +.align 3 +DoPushGlobalLogicVariableSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoPushGlobalLogicVariable # [0di] + .byte 0x90 + .asciiz "DoPushGlobalLogicVariableLP" +#endif +.align 3 +DoPushGlobalLogicVariableLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoPushGlobalLogicVariable # [1] + .byte 0x84 + .asciiz "DoPushGlobalLogicVariableFP" +#endif +.align 3 +DoPushGlobalLogicVariableFP: # Entry point for FP relative +.align 3 +headDoPushGlobalLogicVariable: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoPushGlobalLogicVariable: +/* arg1 has the operand, sign extended if immediate. */ + ldl $1, PROCESSORSTATE_BAR2($14) # Get the structure stack pointer [1] + bis $31, TypeExternalValueCellPointer, $3 # [0di] + stl $1, 8($12) # [1-] + stl $3, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] +/* Memory Read Internal */ +G16061: + ldq $6, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $1, $14, $8 # [1-] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $8, $31, $5 # [1-] + ldq_u $4, 0($8) # [1di] + subq $1, $6, $6 # Stack cache offset [1-] + ldq $22, PROCESSORSTATE_DATAWRITE_MASK($14) # [0di] + cmpult $6, $7, $7 # In range? [1-] + ldl $5, 0($5) # [0di] + extbl $4, $8, $4 # [1-] + bne $7, G16063 # [0di] +G16062: + lda $8, 240 # [1-] + srl $22, $4, $22 # [1] + srl $8, $4, $8 # [1] + blbs $22, G16065 # [1di] +G16071: +/* Merge cdr-code */ + and $3, 63, $5 # [1-] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $1, $14, $6 # [1-] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $6, $31, $5 # [1-] + ldq_u $8, 0($6) # [1di] + subq $1, $7, $7 # Stack cache offset [1-] + cmpult $7, $22, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G16074: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $1, 0($5) # [1] + bne $22, G16073 # J. if in cache [1] +G16072: + addq $1, 1, $2 # Increment the structure-stack-pointer [1-] + stl $2, PROCESSORSTATE_BAR2($14) # Set the structure stack pointer [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G16073: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] +.align 3 +G16075: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $7, $7 # Stack cache offset [2di] + s8addq $7, $6, $6 # reconstruct SCA [1] + stl $1, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, G16072 # [1] +.align 3 +G16063: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G16062 # [1] +.align 3 +G16065: + blbc $8, G16064 # [1] + extll $5, 0, $1 # Do the indirect thing [0di] + br $31, G16061 # [1-] +.align 3 +G16064: + ldq $22, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $22, $8 # Adjust for a longword load [2di] + ldl $22, 0($8) # Get the memory action [2] +#ifndef MINIMA +G16068: +#endif +#ifdef MINIMA +.align 3 +G16068: + and $22, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G16067 # [1-] + sll $1, 1, $6 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $6, $7, $6 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $6, $8, $6 # [1] + extll $6, 0, $6 # Clear sign-extension [1] + s4addq $6, $7, $7 # [2] + ldl $6, 0($7) # Fetch the key [2] + ldl $5, 4($7) # Fetch value [1] + subl $1, $6, $8 # Compare [2di] + bne $8, G16070 # Trap on miss [1] + extll $5, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G16061 # This is another memory read tailcall. [1-] +.align 3 +G16070: + br $31, DBCACHEMISSTRAP +#endif +G16067: +/* Perform memory action */ + bis $31, $22, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoPushGlobalLogicVariable +/* End of Halfword operand from stack instruction - DoPushGlobalLogicVariable */ +.align 5 +.globl DoLogicTailTest +.ent DoLogicTailTest 0 +/* Halfword operand from stack instruction - DoLogicTailTest */ + .globl DoLogicTailTestFP + .globl DoLogicTailTestSP + .globl DoLogicTailTestLP + .globl DoLogicTailTestIM +.align 3 +DoLogicTailTest: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoLogicTailTestIM" +#endif +.align 3 +DoLogicTailTestIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G16086: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoLogicTailTest # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoLogicTailTestSP" +#endif +.align 3 +DoLogicTailTestSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoLogicTailTest # [0di] + .byte 0x90 + .asciiz "DoLogicTailTestLP" +#endif +.align 3 +DoLogicTailTestLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoLogicTailTest # [1] + .byte 0x84 + .asciiz "DoLogicTailTestFP" +#endif +.align 3 +DoLogicTailTestFP: # Entry point for FP relative +.align 3 +headDoLogicTailTest: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoLogicTailTest: +/* arg1 has the operand, sign extended if immediate. */ + srl $16, 32, $17 # [3] + and $17, 63, $1 # Strip off any CDR code bits. [2] + cmpeq $1, TypeList, $2 # [1] +.align 3 +G16083: + beq $2, G16078 # [1] +/* Here if argument TypeList */ + ldq $3, PROCESSORSTATE_NILADDRESS($14) # [0di] + stq $3, 8($12) # push the data [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +G16078: + cmpeq $1, TypeExternalValueCellPointer, $2 # [1-] +.align 3 +G16084: + beq $2, G16079 # [1] +/* Here if argument TypeExternalValueCellPointer */ + ldq $3, PROCESSORSTATE_TADDRESS($14) # [0di] + stq $3, 8($12) # push the data [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +G16079: + cmpeq $1, TypeListInstance, $2 # [1-] +.align 3 +G16085: + beq $2, G16080 # [1] +/* Here if argument TypeListInstance */ + ldq $3, PROCESSORSTATE_NILADDRESS($14) # [0di] + stq $3, 8($12) # push the data [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +G16080: +/* Here for all other cases */ + bis $31, $2, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +G16077: +.end DoLogicTailTest +/* End of Halfword operand from stack instruction - DoLogicTailTest */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunjosh.as */ diff --git a/alpha-emulator/ifunlexi.as b/alpha-emulator/ifunlexi.as new file mode 100644 index 0000000..bc96db9 --- /dev/null +++ b/alpha-emulator/ifunlexi.as @@ -0,0 +1,72 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Lexical variable accessors.") + +;(align16k) + +(define-instruction |DoPushLexicalVarN| :operand-from-stack () + (SRL arg3 10 t4 "Position the opcode") + ;; in-line (stack-read2 arg1 t2 t1) + (LDL t1 0 (arg1)) + (LDL t2 4 (arg1)) + (AND t4 7 t4 "Get the lexical var number") + (EXTLL t1 0 t1) + (TagType t2 t3) + (SUBQ t3 |TypeList| t3) + (BIC t3 4 t3) + (ADDQ t1 t4 t1 "Compute the address of the lexical variable.") + (BNE t3 pushlexvariop) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (memory-read t1 t2 t3 PROCESSORSTATE_DATAREAD t4 t5 t6 t7 nil t)) + (GetNextPCandCP) + (stack-push2 t2 t3 t4) + (ContinueToNextInstruction-NoStall) + (label pushlexvariop) + (illegal-operand unary-lexical-environment-type-error nil "Not a list or locative")) + +(define-instruction |DoPopLexicalVarN| :operand-from-stack () + (SRL arg3 10 t4 "Position the opcode") + ;; in-line (stack-read2 arg1 t2 t1) + (LDL t1 0 (arg1)) + (LDL t2 4 (arg1)) + (AND t4 7 t4 "Get the lexical var number") + (EXTLL t1 0 t1) + (TagType t2 t3) + (SUBQ t3 |TypeList| t3) + (BIC t3 4 t3) + (ADDQ t1 t4 t1 "Compute the address of the lexical variable.") + (BNE t3 poplexvariop) + (stack-pop2 t2 t3) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents t1 t2 t3 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label poplexvariop) + (illegal-operand binary-lexical-environment-type-error nil "Not a list or locative")) + +(define-instruction |DoMovemLexicalVarN| :operand-from-stack () + (SRL arg3 10 t4 "Position the opcode") + ;; in-line (stack-read2 arg1 t2 t1) + (LDL t1 0 (arg1)) + (LDL t2 4 (arg1)) + (AND t4 7 t4 "Get the lexical var number") + (EXTLL t1 0 t1) + (TagType t2 t3) + (SUBQ t3 |TypeList| t3) + (BIC t3 4 t3) + (ADDQ t1 t4 t1 "Compute the address of the lexical variable.") + (BNE t3 movemlexvariop) + (stack-read2 iSP t2 t3) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents t1 t2 t3 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label movemlexvariop) + (illegal-operand binary-lexical-environment-type-error nil "Not a list or locative")) + + +(comment "Fin.") diff --git a/alpha-emulator/ifunlexi.s b/alpha-emulator/ifunlexi.s new file mode 100644 index 0000000..f44184f --- /dev/null +++ b/alpha-emulator/ifunlexi.s @@ -0,0 +1,484 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunlexi.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Lexical variable accessors. */ +.align 5 +.globl DoPushLexicalVarN +.ent DoPushLexicalVarN 0 +/* Halfword operand from stack instruction - DoPushLexicalVarN */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPushLexicalVarNFP + .globl DoPushLexicalVarNSP + .globl DoPushLexicalVarNLP + .globl DoPushLexicalVarNIM +.align 3 +DoPushLexicalVarN: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPushLexicalVarNSP" +#endif +.align 3 +DoPushLexicalVarNSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoPushLexicalVarN # [0di] + .byte 0x90 + .asciiz "DoPushLexicalVarNLP" +#endif +.align 3 +DoPushLexicalVarNLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPushLexicalVarN # [1] + .byte 0x84 + .asciiz "DoPushLexicalVarNFP" +#endif +.align 3 +DoPushLexicalVarNFP: # Entry point for FP relative +.align 3 +beginDoPushLexicalVarN: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + srl $18, 10, $4 # Position the opcode [1] + ldl $1, 0($16) # [1-] + ldl $2, 4($16) # [1] + and $4, 7, $4 # Get the lexical var number [1-] + extll $1, 0, $1 # [1] +/* TagType. */ + and $2, 63, $3 # [1] + subq $3, TypeList, $3 # [1] + bic $3, 4, $3 # [1] + addq $1, $4, $1 # Compute the address of the lexical variable. [1] + bne $3, PUSHLEXVARIOP # [1-] + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G15406: + addq $1, $14, $6 # [0di] + s4addq $6, $31, $3 # [1] + ldq_u $2, 0($6) # [1di] + subq $1, $20, $4 # Stack cache offset [1-] + ldq $7, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $4, $21, $5 # In range? [1-] + ldl $3, 0($3) # [0di] + extbl $2, $6, $2 # [1-] + bne $5, G15408 # [0di] +G15407: + lda $6, 240 # [1-] + srl $7, $2, $7 # [1] + srl $6, $2, $6 # [1] + blbs $7, G15410 # [1di] +G15417: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + and $2, 63, $4 # set CDR-NEXT [1-] + stl $3, 8($12) # [0di] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +PUSHLEXVARIOP: + bis $31, 0, $20 # [1-] + bis $31, 82, $17 # [1] + br $31, ILLEGALOPERAND # Not a list or locative +.align 3 +G15408: + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $4, $5, $4 # reconstruct SCA [3] + ldl $3, 0($4) # [2] + ldl $2, 4($4) # Read from stack cache [1] + br $31, G15407 # [1] +.align 3 +G15410: + blbc $6, G15409 # [1] + extll $3, 0, $1 # Do the indirect thing [0di] + br $31, G15406 # [1-] +.align 3 +G15409: + ldq $7, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $7, $6 # Adjust for a longword load [2di] + ldl $7, 0($6) # Get the memory action [2] +.align 3 +G15414: + and $7, MemoryActionTransform, $6 # [3] + beq $6, G15413 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G15417 # [1-] +#ifndef MINIMA +G15413: +#endif +#ifdef MINIMA +.align 3 +G15413: + and $7, MemoryActionBinding, $6 # [1-] + ldq $5, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $6, G15412 # [1-] + sll $1, 1, $4 # [0di] + ldq $6, PROCESSORSTATE_DBCBASE($14) # [1-] + and $4, $5, $4 # Hash index [1di] + bis $31, 1, $5 # [1] + sll $5, IvoryMemoryData, $5 # [1] + addl $4, $6, $4 # [1] + extll $4, 0, $4 # Clear sign-extension [1] + s4addq $4, $5, $5 # [2] + ldl $4, 0($5) # Fetch the key [2] + ldl $3, 4($5) # Fetch value [1] + subl $1, $4, $6 # Compare [2di] + bne $6, G15416 # Trap on miss [1] + extll $3, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G15406 # This is another memory read tailcall. [1-] +.align 3 +G15416: + br $31, DBCACHEMISSTRAP +#endif +G15412: +/* Perform memory action */ + bis $31, $7, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoPushLexicalVarNIM" +#endif +DoPushLexicalVarNIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoPushLexicalVarN. +.end DoPushLexicalVarN +/* End of Halfword operand from stack instruction - DoPushLexicalVarN */ +.align 5 +.globl DoPopLexicalVarN +.ent DoPopLexicalVarN 0 +/* Halfword operand from stack instruction - DoPopLexicalVarN */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPopLexicalVarNFP + .globl DoPopLexicalVarNSP + .globl DoPopLexicalVarNLP + .globl DoPopLexicalVarNIM +.align 3 +DoPopLexicalVarN: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPopLexicalVarNSP" +#endif +.align 3 +DoPopLexicalVarNSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoPopLexicalVarN # [0di] + .byte 0x90 + .asciiz "DoPopLexicalVarNLP" +#endif +.align 3 +DoPopLexicalVarNLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPopLexicalVarN # [1] + .byte 0x84 + .asciiz "DoPopLexicalVarNFP" +#endif +.align 3 +DoPopLexicalVarNFP: # Entry point for FP relative +.align 3 +beginDoPopLexicalVarN: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + srl $18, 10, $4 # Position the opcode [1] + ldl $1, 0($16) # [1-] + ldl $2, 4($16) # [1] + and $4, 7, $4 # Get the lexical var number [1-] + extll $1, 0, $1 # [1] +/* TagType. */ + and $2, 63, $3 # [1] + subq $3, TypeList, $3 # [1] + bic $3, 4, $3 # [1] + addq $1, $4, $1 # Compute the address of the lexical variable. [1] + bne $3, POPLEXVARIOP # [1-] + ldl $3, 0($12) # [1] + ldl $2, 4($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $3, 0, $3 # [1] + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G15418: + addq $1, $14, $8 # [0di] + s4addq $8, $31, $5 # [1] + ldq_u $4, 0($8) # [1di] + subq $1, $20, $6 # Stack cache offset [1-] + ldq $22, PROCESSORSTATE_DATAWRITE_MASK($14) # [0di] + cmpult $6, $21, $7 # In range? [1-] + ldl $5, 0($5) # [0di] + extbl $4, $8, $4 # [1-] + bne $7, G15420 # [0di] +G15419: + lda $8, 240 # [1-] + srl $22, $4, $22 # [1] + srl $8, $4, $8 # [1] + blbs $22, G15422 # [1di] +G15428: +/* Merge cdr-code */ + and $2, 63, $5 # [1-] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + addq $1, $14, $6 # [1] + s4addq $6, $31, $5 # [1] + ldq_u $8, 0($6) # [1di] + subq $1, $20, $7 # Stack cache offset [1-] + cmpult $7, $21, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G15430: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $3, 0($5) # [1] + bne $22, G15429 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +POPLEXVARIOP: + bis $31, 0, $20 # [1-] + bis $31, 17, $17 # [1] + br $31, ILLEGALOPERAND # Not a list or locative +.align 3 +G15429: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + subq $1, $20, $7 # Stack cache offset [0di] + s8addq $7, $6, $6 # reconstruct SCA [3] + stl $3, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15420: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G15419 # [1] +.align 3 +G15422: + blbc $8, G15421 # [1] + extll $5, 0, $1 # Do the indirect thing [0di] + br $31, G15418 # [1-] +.align 3 +G15421: + ldq $22, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $22, $8 # Adjust for a longword load [2di] + ldl $22, 0($8) # Get the memory action [2] +#ifndef MINIMA +G15425: +#endif +#ifdef MINIMA +.align 3 +G15425: + and $22, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G15424 # [1-] + sll $1, 1, $6 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $6, $7, $6 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $6, $8, $6 # [1] + extll $6, 0, $6 # Clear sign-extension [1] + s4addq $6, $7, $7 # [2] + ldl $6, 0($7) # Fetch the key [2] + ldl $5, 4($7) # Fetch value [1] + subl $1, $6, $8 # Compare [2di] + bne $8, G15427 # Trap on miss [1] + extll $5, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G15418 # This is another memory read tailcall. [1-] +.align 3 +G15427: + br $31, DBCACHEMISSTRAP +#endif +G15424: +/* Perform memory action */ + bis $31, $22, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoPopLexicalVarNIM" +#endif +DoPopLexicalVarNIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoPopLexicalVarN. +.end DoPopLexicalVarN +/* End of Halfword operand from stack instruction - DoPopLexicalVarN */ +.align 5 +.globl DoMovemLexicalVarN +.ent DoMovemLexicalVarN 0 +/* Halfword operand from stack instruction - DoMovemLexicalVarN */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMovemLexicalVarNFP + .globl DoMovemLexicalVarNSP + .globl DoMovemLexicalVarNLP + .globl DoMovemLexicalVarNIM +.align 3 +DoMovemLexicalVarN: +#ifdef TRACING + .byte 0x88 + .asciiz "DoMovemLexicalVarNSP" +#endif +.align 3 +DoMovemLexicalVarNSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoMovemLexicalVarN # [0di] + .byte 0x90 + .asciiz "DoMovemLexicalVarNLP" +#endif +.align 3 +DoMovemLexicalVarNLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMovemLexicalVarN # [1] + .byte 0x84 + .asciiz "DoMovemLexicalVarNFP" +#endif +.align 3 +DoMovemLexicalVarNFP: # Entry point for FP relative +.align 3 +beginDoMovemLexicalVarN: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + srl $18, 10, $4 # Position the opcode [1] + ldl $1, 0($16) # [1-] + ldl $2, 4($16) # [1] + and $4, 7, $4 # Get the lexical var number [1-] + extll $1, 0, $1 # [1] +/* TagType. */ + and $2, 63, $3 # [1] + subq $3, TypeList, $3 # [1] + bic $3, 4, $3 # [1] + addq $1, $4, $1 # Compute the address of the lexical variable. [1] + bne $3, MOVEMLEXVARIOP # [1-] + ldl $3, 0($12) # [1] + ldl $2, 4($12) # [1] + extll $3, 0, $3 # [2di] + ldq $20, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $21, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] +/* Memory Read Internal */ +G15431: + addq $1, $14, $8 # [1-] + s4addq $8, $31, $5 # [1] + ldq_u $4, 0($8) # [1-] + subq $1, $20, $6 # Stack cache offset [0di] + ldq $22, PROCESSORSTATE_DATAWRITE_MASK($14) # [1-] + cmpult $6, $21, $7 # In range? [0di] + ldl $5, 0($5) # [1-] + extbl $4, $8, $4 # [1di] + bne $7, G15433 # [1-] +G15432: + lda $8, 240 # [0di] + srl $22, $4, $22 # [1] + srl $8, $4, $8 # [1] + blbs $22, G15435 # [1-] +G15441: +/* Merge cdr-code */ + and $2, 63, $5 # [0di] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + addq $1, $14, $6 # [1] + s4addq $6, $31, $5 # [1] + ldq_u $8, 0($6) # [1-] + subq $1, $20, $7 # Stack cache offset [0di] + cmpult $7, $21, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G15443: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $3, 0($5) # [1] + bne $22, G15442 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +MOVEMLEXVARIOP: + bis $31, 0, $20 # [1-] + bis $31, 17, $17 # [1] + br $31, ILLEGALOPERAND # Not a list or locative +.align 3 +G15442: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + subq $1, $20, $7 # Stack cache offset [0di] + s8addq $7, $6, $6 # reconstruct SCA [3] + stl $3, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15433: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G15432 # [1] +.align 3 +G15435: + blbc $8, G15434 # [1] + extll $5, 0, $1 # Do the indirect thing [0di] + br $31, G15431 # [1-] +.align 3 +G15434: + ldq $22, PROCESSORSTATE_DATAWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $8 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $8, $22, $8 # Adjust for a longword load [2di] + ldl $22, 0($8) # Get the memory action [2] +#ifndef MINIMA +G15438: +#endif +#ifdef MINIMA +.align 3 +G15438: + and $22, MemoryActionBinding, $8 # [3] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $8, G15437 # [1-] + sll $1, 1, $6 # [0di] + ldq $8, PROCESSORSTATE_DBCBASE($14) # [1-] + and $6, $7, $6 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $6, $8, $6 # [1] + extll $6, 0, $6 # Clear sign-extension [1] + s4addq $6, $7, $7 # [2] + ldl $6, 0($7) # Fetch the key [2] + ldl $5, 4($7) # Fetch value [1] + subl $1, $6, $8 # Compare [2di] + bne $8, G15440 # Trap on miss [1] + extll $5, 0, $1 # Extract the pointer, and indirect [0di] + br $31, G15431 # This is another memory read tailcall. [1-] +.align 3 +G15440: + br $31, DBCACHEMISSTRAP +#endif +G15437: +/* Perform memory action */ + bis $31, $22, $16 # [1-] + bis $31, 1, $17 # [1] + br $31, PERFORMMEMORYACTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoMovemLexicalVarNIM" +#endif +DoMovemLexicalVarNIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoMovemLexicalVarN. +.end DoMovemLexicalVarN +/* End of Halfword operand from stack instruction - DoMovemLexicalVarN */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunlexi.as */ diff --git a/alpha-emulator/ifunlist.as b/alpha-emulator/ifunlist.as new file mode 100644 index 0000000..424108e --- /dev/null +++ b/alpha-emulator/ifunlist.as @@ -0,0 +1,137 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "List Operations.") + +;; |DoCar| and |DoCdr| are in IFUNCOM1.AS + + +(define-instruction |DoSetToCar| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (isettocar arg1 arg5 arg6 arg2 t1 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + (and arg5 192 t2 "Save the old CDR code") + #+list-inline (car-internal arg5 arg6 set-to-car arg2 t5 t6 t7 t8 t) + #-list-inline (BSR r0 |CarInternal|) + (TagType arg5 arg5) + (BIS arg5 t2 arg5 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (ContinueToNextInstruction))) + +(define-instruction |DoSetToCdr| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (isettocdr arg1 arg5 arg6 arg2 t1 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + (and arg5 192 t2 "Save the old CDR code") + #+list-inline (cdr-internal arg5 arg6 set-to-cdr arg2 t5 t6 t7 t8 t) + #-list-inline (BSR r0 |CdrInternal|) + (TagType arg5 arg5) + (BIS arg5 t2 arg5 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (ContinueToNextInstruction))) + + +;; |DoSetToCdrPushCar| is in IFUNCOM1.AS + +(define-procedure |SetToCdrPushCarLocative| () + (label settocdrpushcarlocative) + (BIS zero t2 arg2) + (using-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)) + (TagType t1 t1) + (stack-push2-with-cdr arg5 arg6) + (BIS t1 t3 t1 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (ContinueToNextInstruction)) + +;; |DoRplaca| and |DoRplacd| are in IFUNCOM2.AS + +(define-instruction |DoAssoc| :operand-from-stack (:needs-tos t) + (carcdrloop (assoc arg3 arg4 t1 t2 arg5 arg6 arg2 assoccdr assocexc + t4 t5 t6 t7 t8 t9 t10 t11 t12) + (;; Loop top: nothing + ) + (;; Loop body: look for alist element + (type-dispatch t1 t7 t8 + (|TypeList| + (BIS t2 zero arg2) ;MEM-READ can clobber its VMA arg + ;; save/restore arg5/arg6 (the cdr) around memory-read + (BIS arg5 zero t3) + (BIS arg6 zero arg1) + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t) + (TagType arg5 t5) + (BIS t3 zero arg5) + (SUBL arg4 arg6 t6 "t6=0 if data same") + (BIS arg1 zero arg6) + (BNE t6 assoccdr "J. if different") + (SUBQ arg3 t5 t5 "t5 zero if same tag") + (BNE t5 assoccdr "J. if tags different") + (comment "we found a match!") + (TagType t1 t1) + (stack-write2 iSP t1 t2) + (ContinueToNextInstruction)) ;loop exit succeed + (|TypeNIL| ;skip this element + (BR zero assoccdr)) + (:else ;+++ should do spare list exception + (SetTag arg4 arg5 t1) + (illegal-operand assoc-list-element-not-list t1)))) + (;; Loop step: nothing, macro automatically cdrs + ) + (;; Loop end: return nil + (stack-write-nil iSP t1 t2 "Return NIL") + (ContinueToNextInstruction)))) + +(define-instruction |DoMember| :operand-from-stack (:needs-tos t) + (carcdrloop (member arg3 arg4 t1 t2 arg5 arg6 arg2 membercdr memberexc + t4 t5 t6 t7 t8 t9 t10 t11 t12) + (;; Loop top: remember list in t3/arg1 + (TagType t1 t3) + (BIS t2 zero arg1)) + (;; Loop body: compare car + (TagType t1 t5) + (SUBQ arg4 t2 t7 "t7=0 if data same") + (BNE t7 membercdr "J. if different") + (SUBQ arg3 t5 t6 "t6 zero if same tag") + (BNE t6 membercdr "J. if tags different") + (comment "we found a match!") + (stack-write2 iSP t3 arg1) + (ContinueToNextInstruction)) + (;; Loop step: nothing, macro automatically cdrs + ) + (;; Loop end: return nil + (stack-write-nil iSP t1 t2 "Return NIL") + (ContinueToNextInstruction)))) + +(define-instruction |DoRgetf| :operand-from-stack (:needs-tos t) + (carcdrloop (rgetf arg3 arg4 t1 t2 arg5 arg6 arg2 rgetfcdr rgetfexc + t4 t5 t6 t7 t8 t9 t10 t11 t12) + (;; Loop top: nothing + ) + (;; Loop body: compare car + (TagType t1 t5) + (SUBQ arg4 t2 t7 "t7=0 if data same") + (BNE t7 rgetfcdr "J. if different") + (SUBQ arg3 t5 t6 "t6 zero if same tag") + (BNE t6 rgetfcdr "J. if tags different") + (comment "we found a match!") + (TagType arg5 t1 "Strip CDR code") + (SUBQ t1 |TypeNIL| t5 "t5=0 if end of list") + (BEQ t5 rgetfexc "after all this effort we lose!") + (BIS arg6 zero t2) + #+list-inline (car-internal arg5 arg6 rgetf arg2 t5 t6 t7 t8 t) + #-list-inline (BSR r0 |CarInternal|) ;cadr of init + (TagType arg5 arg5 "Strip the CDR code") + (stack-write2 iSP arg5 arg6) ;return value 1 + (stack-push2 t1 t2 arg2 "Push the second result") ;cdr of init + (ContinueToNextInstruction)) + (;; Loop step: cdr over value + CDR + ) + (;; Loop end: return (values nil nil) + (stack-write-nil-and-push-nil iSP arg2 "Return NIL") ;fail exit + (ContinueToNextInstruction)))) + +(comment "Fin.") diff --git a/alpha-emulator/ifunlist.s b/alpha-emulator/ifunlist.s new file mode 100644 index 0000000..b745705 --- /dev/null +++ b/alpha-emulator/ifunlist.s @@ -0,0 +1,559 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunlist.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* List Operations. */ +.align 5 +.globl DoSetToCar +.ent DoSetToCar 0 +/* Halfword operand from stack instruction - DoSetToCar */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetToCarFP + .globl DoSetToCarSP + .globl DoSetToCarLP + .globl DoSetToCarIM +.align 3 +DoSetToCar: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetToCarSP" +#endif +.align 3 +DoSetToCarSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoSetToCar # [0di] + .byte 0x90 + .asciiz "DoSetToCarLP" +#endif +.align 3 +DoSetToCarLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetToCar # [1] + .byte 0x84 + .asciiz "DoSetToCarFP" +#endif +.align 3 +DoSetToCarFP: # Entry point for FP relative +.align 3 +beginDoSetToCar: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $20, 4($16) # Get the operand from the stack. [1] + ldl $21, 0($16) # [1] + and $20, 192, $2 # Save the old CDR code [2di] + bsr $0, CarInternal +/* TagType. */ + and $20, 63, $20 # [1] + bis $20, $2, $20 # Put back the original CDR codes [1] + stl $21, 0($16) # [1-] + stl $20, 4($16) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoSetToCarIM" +#endif +DoSetToCarIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoSetToCar. +.end DoSetToCar +/* End of Halfword operand from stack instruction - DoSetToCar */ +.align 5 +.globl DoSetToCdr +.ent DoSetToCdr 0 +/* Halfword operand from stack instruction - DoSetToCdr */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetToCdrFP + .globl DoSetToCdrSP + .globl DoSetToCdrLP + .globl DoSetToCdrIM +.align 3 +DoSetToCdr: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetToCdrSP" +#endif +.align 3 +DoSetToCdrSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoSetToCdr # [0di] + .byte 0x90 + .asciiz "DoSetToCdrLP" +#endif +.align 3 +DoSetToCdrLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetToCdr # [1] + .byte 0x84 + .asciiz "DoSetToCdrFP" +#endif +.align 3 +DoSetToCdrFP: # Entry point for FP relative +.align 3 +beginDoSetToCdr: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + ldl $20, 4($16) # Get the operand from the stack. [1] + ldl $21, 0($16) # [1] + and $20, 192, $2 # Save the old CDR code [2di] + bsr $0, CdrInternal +/* TagType. */ + and $20, 63, $20 # [1] + bis $20, $2, $20 # Put back the original CDR codes [1] + stl $21, 0($16) # [1-] + stl $20, 4($16) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoSetToCdrIM" +#endif +DoSetToCdrIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoSetToCdr. +.end DoSetToCdr +/* End of Halfword operand from stack instruction - DoSetToCdr */ +.align 5 +.globl SetToCdrPushCarLocative +.ent SetToCdrPushCarLocative 0 +.align 3 +SetToCdrPushCarLocative: +.align 3 +SETTOCDRPUSHCARLOCATIVE: + bis $31, $2, $17 # [1-] +/* Memory Read Internal */ +G14306: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1di] + subq $17, $24, $5 # Stack cache offset [1-] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $5, $25, $6 # In range? [1-] + ldl $21, 0($21) # [0di] + extbl $20, $7, $20 # [1-] + bne $6, G14308 # [0di] +G14307: + lda $7, 240 # [1-] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G14310 # [1di] +G14317: +/* TagType. */ + and $1, 63, $1 # [1-] + stl $21, 8($12) # [0di] + stl $20, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $1, $3, $1 # Put back the original CDR codes [1] + stl $21, 0($16) # [0di] + stl $20, 4($16) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14310: + blbc $7, G14309 # [1] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G14306 # [1-] +.align 3 +G14309: +.align 3 +G14308: + bsr $0, MemoryReadDataDECODE + br $31, G14317 # [1] +.end SetToCdrPushCarLocative +.align 5 +.globl DoAssoc +.ent DoAssoc 0 +/* Halfword operand from stack instruction - DoAssoc */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAssocFP + .globl DoAssocSP + .globl DoAssocLP + .globl DoAssocIM +.align 3 +DoAssoc: +#ifdef TRACING + .byte 0x88 + .asciiz "DoAssocSP" +#endif +.align 3 +DoAssocSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoAssoc # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoAssoc # [0di] + .byte 0x90 + .asciiz "DoAssocLP" +#endif +.align 3 +DoAssocLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoAssoc # [1] + .byte 0x84 + .asciiz "DoAssocFP" +#endif +.align 3 +DoAssocFP: # Entry point for FP relative +.align 3 +beginDoAssoc: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + lda $5, -2048 # [0di] + ldah $5, 1($5) # [1] + extll $21, 4, $18 # [1] + extll $21, 0, $19 # [1] + ldl $1, 4($16) # [0di] + ldl $2, 0($16) # [1] +/* TagType. */ + and $18, 63, $18 # Get the object type bits [0di] + srl $5, $18, $5 # Low bit will set iff EQ-NOT-EQL [1] +/* TagType. */ + and $1, 63, $1 # Strip cdr code [1] + extll $2, 0, $2 # Remove sign-extension [1] + blbs $5, ASSOCEXC # [0di] + bis $31, $31, $6 # [1-] + br $31, G14319 # [0di] +.align 3 +ASSOCCDR: + ldq $6, PROCESSORSTATE_STOP_INTERPRETER($14) # Have we been asked to stop or trap? [1] +/* Move cdr to car for next carcdr-internal */ +/* TagType. */ + and $20, 63, $1 # [0di] + bis $21, $31, $2 # [1] +.align 3 +G14319: + subq $1, TypeNIL, $5 # [1] + bne $6, G14318 # Asked to stop, check for sequence break [1di] + beq $5, G14320 # [1] + bsr $0, CarCdrInternal + and $1, 63, $7 # Strip off any CDR code bits. [0di] + cmpeq $7, TypeList, $8 # [1] +.align 3 +G14338: + beq $8, G14322 # [1] +/* Here if argument TypeList */ + bis $2, $31, $17 # [0di] + bis $20, $31, $3 # [1] + bis $21, $31, $16 # [1] +/* Memory Read Internal */ +G14323: + addq $17, $14, $7 # [1] + s4addq $7, $31, $21 # [1] + ldq_u $20, 0($7) # [1-] + subq $17, $24, $5 # Stack cache offset [0di] + ldq $8, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $5, $25, $6 # In range? [0di] + ldl $21, 0($21) # [1-] + extbl $20, $7, $20 # [1di] + bne $6, G14325 # [1-] +G14324: + lda $7, 240 # [0di] + srl $8, $20, $8 # [1] + srl $7, $20, $7 # [1] + blbs $8, G14327 # [1-] +G14334: +/* TagType. */ + and $20, 63, $5 # [0di] + bis $3, $31, $20 # [1] + subl $19, $21, $6 # t6=0 if data same [1] + bis $16, $31, $21 # [1] + bne $6, ASSOCCDR # J. if different [0di] + subq $18, $5, $5 # t5 zero if same tag [1-] + bne $5, ASSOCCDR # J. if tags different [1] +/* we found a match! */ +/* TagType. */ + and $1, 63, $1 # [1-] + stl $2, 0($12) # [0di] + stl $1, 4($12) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14322: + cmpeq $7, TypeNIL, $8 # [1-] +.align 3 +G14339: + beq $8, G14335 # [1] +/* Here if argument TypeNIL */ + br $31, ASSOCCDR # [1] +.align 3 +G14335: +/* Here for all other cases */ +/* SetTag. */ + sll $19, 32, $1 # [1-] + bis $20, $1, $1 # [2] + bis $31, $1, $20 # [1] + bis $31, 14, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G14321: +.align 3 +G14320: + ldq $1, PROCESSORSTATE_NILADDRESS($14) # Return NIL [1-] + stq $1, 0($12) # push the data [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +ASSOCEXC: + bis $31, 0, $18 # arg3 = stackp [1-] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +G14327: + blbc $7, G14326 # [1-] + extll $21, 0, $17 # Do the indirect thing [0di] + br $31, G14323 # [1-] +.align 3 +G14326: +.align 3 +G14325: + bsr $0, MemoryReadDataDECODE + br $31, G14334 # [1] +.align 3 +G14318: + ldq $12, PROCESSORSTATE_RESTARTSP($14) # [1] + br $31, INTERPRETINSTRUCTION # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoAssocIM" +#endif +DoAssocIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoAssoc. +.end DoAssoc +/* End of Halfword operand from stack instruction - DoAssoc */ +.align 5 +.globl DoMember +.ent DoMember 0 +/* Halfword operand from stack instruction - DoMember */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMemberFP + .globl DoMemberSP + .globl DoMemberLP + .globl DoMemberIM +.align 3 +DoMember: +#ifdef TRACING + .byte 0x88 + .asciiz "DoMemberSP" +#endif +.align 3 +DoMemberSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoMember # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoMember # [0di] + .byte 0x90 + .asciiz "DoMemberLP" +#endif +.align 3 +DoMemberLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMember # [1] + .byte 0x84 + .asciiz "DoMemberFP" +#endif +.align 3 +DoMemberFP: # Entry point for FP relative +.align 3 +beginDoMember: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + lda $5, -2048 # [0di] + ldah $5, 1($5) # [1] + extll $21, 4, $18 # [1] + extll $21, 0, $19 # [1] + ldl $1, 4($16) # [0di] + ldl $2, 0($16) # [1] +/* TagType. */ + and $18, 63, $18 # Get the object type bits [0di] + srl $5, $18, $5 # Low bit will set iff EQ-NOT-EQL [1] +/* TagType. */ + and $1, 63, $1 # Strip cdr code [1] + extll $2, 0, $2 # Remove sign-extension [1] + blbs $5, MEMBEREXC # [0di] + bis $31, $31, $6 # [1-] + br $31, G14341 # [0di] +.align 3 +MEMBERCDR: + ldq $6, PROCESSORSTATE_STOP_INTERPRETER($14) # Have we been asked to stop or trap? [1] +/* Move cdr to car for next carcdr-internal */ +/* TagType. */ + and $20, 63, $1 # [0di] + bis $21, $31, $2 # [1] +.align 3 +G14341: +/* TagType. */ + and $1, 63, $3 # [1] + bis $2, $31, $16 # [1] + subq $1, TypeNIL, $5 # [1] + bne $6, G14340 # Asked to stop, check for sequence break [0di] + beq $5, G14342 # [1] + bsr $0, CarCdrInternal +/* TagType. */ + and $1, 63, $5 # [1] + subq $19, $2, $7 # t7=0 if data same [1] + bne $7, MEMBERCDR # J. if different [1] + subq $18, $5, $6 # t6 zero if same tag [1-] + bne $6, MEMBERCDR # J. if tags different [1] +/* we found a match! */ + stl $16, 0($12) # [1] + stl $3, 4($12) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G14342: + ldq $1, PROCESSORSTATE_NILADDRESS($14) # Return NIL [1] + stq $1, 0($12) # push the data [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +MEMBEREXC: + bis $31, 0, $18 # arg3 = stackp [1-] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +G14340: + ldq $12, PROCESSORSTATE_RESTARTSP($14) # [1-] + br $31, INTERPRETINSTRUCTION # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoMemberIM" +#endif +DoMemberIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoMember. +.end DoMember +/* End of Halfword operand from stack instruction - DoMember */ +.align 5 +.globl DoRgetf +.ent DoRgetf 0 +/* Halfword operand from stack instruction - DoRgetf */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoRgetfFP + .globl DoRgetfSP + .globl DoRgetfLP + .globl DoRgetfIM +.align 3 +DoRgetf: +#ifdef TRACING + .byte 0x88 + .asciiz "DoRgetfSP" +#endif +.align 3 +DoRgetfSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoRgetf # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoRgetf # [0di] + .byte 0x90 + .asciiz "DoRgetfLP" +#endif +.align 3 +DoRgetfLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoRgetf # [1] + .byte 0x84 + .asciiz "DoRgetfFP" +#endif +.align 3 +DoRgetfFP: # Entry point for FP relative +.align 3 +beginDoRgetf: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + lda $5, -2048 # [0di] + ldah $5, 1($5) # [1] + extll $21, 4, $18 # [1] + extll $21, 0, $19 # [1] + ldl $1, 4($16) # [0di] + ldl $2, 0($16) # [1] +/* TagType. */ + and $18, 63, $18 # Get the object type bits [0di] + srl $5, $18, $5 # Low bit will set iff EQ-NOT-EQL [1] +/* TagType. */ + and $1, 63, $1 # Strip cdr code [1] + extll $2, 0, $2 # Remove sign-extension [1] + blbs $5, RGETFEXC # [0di] + bis $31, $31, $6 # [1-] + br $31, G14344 # [0di] +.align 3 +RGETFCDR: + bsr $0, CdrInternal + ldq $6, PROCESSORSTATE_STOP_INTERPRETER($14) # Have we been asked to stop or trap? [1] +/* Move cdr to car for next carcdr-internal */ +/* TagType. */ + and $20, 63, $1 # [0di] + bis $21, $31, $2 # [1] +.align 3 +G14344: + subq $1, TypeNIL, $5 # [1] + bne $6, G14343 # Asked to stop, check for sequence break [1di] + beq $5, G14345 # [1] + bsr $0, CarCdrInternal +/* TagType. */ + and $1, 63, $5 # [1] + subq $19, $2, $7 # t7=0 if data same [1] + bne $7, RGETFCDR # J. if different [1] + subq $18, $5, $6 # t6 zero if same tag [1-] + bne $6, RGETFCDR # J. if tags different [1] +/* we found a match! */ +/* TagType. */ + and $20, 63, $1 # Strip CDR code [1-] + subq $1, TypeNIL, $5 # t5=0 if end of list [1] + beq $5, RGETFEXC # after all this effort we lose! [1] + bis $21, $31, $2 # [0di] + bsr $0, CarInternal +/* TagType. */ + and $20, 63, $20 # Strip the CDR code [1] + stl $21, 0($12) # [0di] + stl $20, 4($12) # write the stack cache [1] + and $1, 63, $17 # set CDR-NEXT [0di] + stl $2, 8($12) # Push the second result [1-] + stl $17, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +G14345: + ldq $17, PROCESSORSTATE_NILADDRESS($14) # Return NIL [1] + stq $17, 0($12) # [1] + stq $17, 8($12) # push the data [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +RGETFEXC: + bis $31, 0, $18 # arg3 = stackp [1-] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +G14343: + ldq $12, PROCESSORSTATE_RESTARTSP($14) # [1-] + br $31, INTERPRETINSTRUCTION # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoRgetfIM" +#endif +DoRgetfIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoRgetf. +.end DoRgetf +/* End of Halfword operand from stack instruction - DoRgetf */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunlist.as */ diff --git a/alpha-emulator/ifunloop.as b/alpha-emulator/ifunloop.as new file mode 100644 index 0000000..437cdd1 --- /dev/null +++ b/alpha-emulator/ifunloop.as @@ -0,0 +1,78 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Branch and loop instructions.") + +;;; First the most commonly used branches + +;; |DoBranch| is in IFUNCOM1.AS + + +;; |DoBranchTrue| and |DoBranchFalse| are in IFUNCOM1.AS + + +;; |DoBranchTrueNoPop| and |DoBranchFalseNoPop| is is IFUNCOM1.AS + + +;; |DoBranchTrueAndExtraPop| and |DoBranchFalseAndExtraPop| are in IFUNCOM2.AS + + +;; |DoBranchTrueAndNoPop| and |DoBranchFalseAndNoPop| are in IFUNCOM2.as + + +(define-instruction |DoBranchTrueElseNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil t nil nil |BranchException|)) ;and-pop + +;; |DoBranchFalseElseNoPop| is in IFUNCOM2.AS + + +(define-instruction |DoBranchTrueElseExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil t t |BranchException|)) ;else-pop extra-pop + +(define-instruction |DoBranchFalseElseExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil t t |BranchException|)) ;invert else-pop extra-pop + + +;; |DoBranchTrueExtraPop| is less commonly used, so it's down below +(define-instruction |DoBranchFalseExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t t t t |BranchException|)) ;invert and-pop else-pop extra-pop + + +;;; Then the loop instructions + +(define-instruction |DoLoopDecrementTos| :10-bit-signed-immediate (:needs-tos t) + (iloop-decrement-tos)) + +(define-instruction |DoLoopIncrementTosLessThan| :10-bit-signed-immediate (:needs-tos t) + (iloop-increment-tos-less-than)) + + +;;; Finally the less commonly used branches + +(define-instruction |DoBranchTrueExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil t t t |BranchException|)) ;and-pop else-pop extra-pop + +(define-instruction |DoBranchTrueAndNoPopElseNoPopExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil nil t |BranchException|)) ;extra-pop + +(define-instruction |DoBranchFalseAndNoPopElseNoPopExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil nil t |BranchException|)) ;invert extra-pop + + +;; All conditional branch exceptions end up here +(define-procedure |BranchException| () + (illegal-operand branch-dot-error)) + + +(comment "Fin.") + diff --git a/alpha-emulator/ifunloop.s b/alpha-emulator/ifunloop.s new file mode 100644 index 0000000..ed3fc7f --- /dev/null +++ b/alpha-emulator/ifunloop.s @@ -0,0 +1,499 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunloop.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Branch and loop instructions. */ +.align 5 +.globl DoBranchTrueElseNoPop +.ent DoBranchTrueElseNoPop 0 +/* Halfword 10 bit immediate instruction - DoBranchTrueElseNoPop */ + .globl DoBranchTrueElseNoPopFP + .globl DoBranchTrueElseNoPopSP + .globl DoBranchTrueElseNoPopLP + .globl DoBranchTrueElseNoPopIM +.align 3 +DoBranchTrueElseNoPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrueElseNoPop" +#endif +.align 3 +DoBranchTrueElseNoPopIM: +.align 3 +DoBranchTrueElseNoPopSP: +.align 3 +DoBranchTrueElseNoPopLP: +.align 3 +DoBranchTrueElseNoPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, NEXTINSTRUCTION # [1] + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrueElseNoPop +/* End of Halfword operand from stack instruction - DoBranchTrueElseNoPop */ +.align 5 +.globl DoBranchTrueElseExtraPop +.ent DoBranchTrueElseExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchTrueElseExtraPop */ + .globl DoBranchTrueElseExtraPopFP + .globl DoBranchTrueElseExtraPopSP + .globl DoBranchTrueElseExtraPopLP + .globl DoBranchTrueElseExtraPopIM +.align 3 +DoBranchTrueElseExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrueElseExtraPop" +#endif +.align 3 +DoBranchTrueElseExtraPopIM: +.align 3 +DoBranchTrueElseExtraPopSP: +.align 3 +DoBranchTrueElseExtraPopLP: +.align 3 +DoBranchTrueElseExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, DoBrElsePopExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 16, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrElsePopExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrueElseExtraPop +/* End of Halfword operand from stack instruction - DoBranchTrueElseExtraPop */ +.align 5 +.globl DoBranchFalseElseExtraPop +.ent DoBranchFalseElseExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchFalseElseExtraPop */ + .globl DoBranchFalseElseExtraPopFP + .globl DoBranchFalseElseExtraPopSP + .globl DoBranchFalseElseExtraPopLP + .globl DoBranchFalseElseExtraPopIM +.align 3 +DoBranchFalseElseExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalseElseExtraPop" +#endif +.align 3 +DoBranchFalseElseExtraPopIM: +.align 3 +DoBranchFalseElseExtraPopSP: +.align 3 +DoBranchFalseElseExtraPopLP: +.align 3 +DoBranchFalseElseExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, DoBrnElsePopExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 16, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrnElsePopExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalseElseExtraPop +/* End of Halfword operand from stack instruction - DoBranchFalseElseExtraPop */ +.align 5 +.globl DoBranchFalseExtraPop +.ent DoBranchFalseExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchFalseExtraPop */ + .globl DoBranchFalseExtraPopFP + .globl DoBranchFalseExtraPopSP + .globl DoBranchFalseExtraPopLP + .globl DoBranchFalseExtraPopIM +.align 3 +DoBranchFalseExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalseExtraPop" +#endif +.align 3 +DoBranchFalseExtraPopIM: +.align 3 +DoBranchFalseExtraPopSP: +.align 3 +DoBranchFalseExtraPopLP: +.align 3 +DoBranchFalseExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, DoBrnPopElsePopExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 16, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrnPopElsePopExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 16, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalseExtraPop +/* End of Halfword operand from stack instruction - DoBranchFalseExtraPop */ +.align 5 +.globl DoLoopDecrementTos +.ent DoLoopDecrementTos 0 +/* Halfword 10 bit immediate instruction - DoLoopDecrementTos */ + .globl DoLoopDecrementTosFP + .globl DoLoopDecrementTosSP + .globl DoLoopDecrementTosLP + .globl DoLoopDecrementTosIM +.align 3 +DoLoopDecrementTos: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoLoopDecrementTos" +#endif +.align 3 +DoLoopDecrementTosIM: +.align 3 +DoLoopDecrementTosSP: +.align 3 +DoLoopDecrementTosLP: +.align 3 +DoLoopDecrementTosFP: + sra $18, 48, $16 # [1-] +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # [1] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [1-] +#endif + extll $21, 0, $2 # [0di] + subq $1, TypeFixnum, $3 # [1] + and $3, 63, $3 # Strip CDR code [1] + bne $3, G14298 # [1] + subl $2, 1, $3 # [1] + cmplt $3, $2, $4 # [1] + beq $4, G14300 # [1] + bis $31, TypeFixnum, $6 # [1-] + stl $3, 0($12) # [0di] + stl $6, 4($12) # write the stack cache [1] + ble $3, NEXTINSTRUCTION # [1] +/* Here if branch taken. */ + addq $9, $16, $9 # Update the PC in halfwords [1-] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.align 3 +G14298: + subq $1, TypeFixnum, $3 # [1-] + and $3, 56, $3 # Strip CDR code, low bits [1] + bne $3, G14299 # [1] +.align 3 +G14300: + addq $9, $16, $20 # Compute next-pc [1-] + bis $31, 1, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, LOOPEXCEPTION +.align 3 +G14299: + bis $31, 0, $20 # [1] + bis $31, 81, $17 # [1] + br $31, ILLEGALOPERAND +.end DoLoopDecrementTos +/* End of Halfword operand from stack instruction - DoLoopDecrementTos */ +.align 5 +.globl DoLoopIncrementTosLessThan +.ent DoLoopIncrementTosLessThan 0 +/* Halfword 10 bit immediate instruction - DoLoopIncrementTosLessThan */ + .globl DoLoopIncrementTosLessThanFP + .globl DoLoopIncrementTosLessThanSP + .globl DoLoopIncrementTosLessThanLP + .globl DoLoopIncrementTosLessThanIM +.align 3 +DoLoopIncrementTosLessThan: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoLoopIncrementTosLessThan" +#endif +.align 3 +DoLoopIncrementTosLessThanIM: +.align 3 +DoLoopIncrementTosLessThanSP: +.align 3 +DoLoopIncrementTosLessThanLP: +.align 3 +DoLoopIncrementTosLessThanFP: + sra $18, 48, $16 # [1] +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # [1] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [1-] +#endif + extll $21, 0, $2 # [0di] + subq $1, TypeFixnum, $5 # [1] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G14301 # [1] + ldl $4, -8($12) # Get arg1. [0di] + ldl $3, -4($12) # [1] + extll $4, 0, $4 # [2di] + subq $3, TypeFixnum, $5 # [1] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G14302 # [1] + addl $2, 1, $5 # [1] + cmple $2, $5, $6 # [1] + beq $6, G14303 # [1] + bis $31, TypeFixnum, $6 # [1] + stl $5, 0($12) # [0di] + stl $6, 4($12) # write the stack cache [1] + cmple $5, $4, $6 # [1] + beq $6, NEXTINSTRUCTION # [1] +/* Here if branch taken. */ +.align 3 +G14305: + addq $9, $16, $9 # Update the PC in halfwords [1-] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.align 3 +G14301: + subq $1, TypeFixnum, $5 # [1-] + and $5, 56, $5 # Strip CDR code, low bits [1] + bne $5, G14304 # [1] +.align 3 +G14302: + subq $3, TypeFixnum, $5 # [1] + and $5, 56, $5 # Strip CDR code, low bits [1] + bne $5, G14304 # [1] +.align 3 +G14303: + addq $9, $16, $20 # Compute next-pc [1-] + bis $31, 1, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, LOOPEXCEPTION +.align 3 +G14304: + bis $31, 0, $20 # [1] + bis $31, 16, $17 # [1] + br $31, ILLEGALOPERAND +.end DoLoopIncrementTosLessThan +/* End of Halfword operand from stack instruction - DoLoopIncrementTosLessThan */ +.align 5 +.globl DoBranchTrueExtraPop +.ent DoBranchTrueExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchTrueExtraPop */ + .globl DoBranchTrueExtraPopFP + .globl DoBranchTrueExtraPopSP + .globl DoBranchTrueExtraPopLP + .globl DoBranchTrueExtraPopIM +.align 3 +DoBranchTrueExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrueExtraPop" +#endif +.align 3 +DoBranchTrueExtraPopIM: +.align 3 +DoBranchTrueExtraPopSP: +.align 3 +DoBranchTrueExtraPopLP: +.align 3 +DoBranchTrueExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, DoBrPopElsePopExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 16, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrPopElsePopExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 16, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrueExtraPop +/* End of Halfword operand from stack instruction - DoBranchTrueExtraPop */ +.align 5 +.globl DoBranchTrueAndNoPopElseNoPopExtraPop +.ent DoBranchTrueAndNoPopElseNoPopExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchTrueAndNoPopElseNoPopExtraPop */ + .globl DoBranchTrueAndNoPopElseNoPopExtraPopFP + .globl DoBranchTrueAndNoPopElseNoPopExtraPopSP + .globl DoBranchTrueAndNoPopElseNoPopExtraPopLP + .globl DoBranchTrueAndNoPopElseNoPopExtraPopIM +.align 3 +DoBranchTrueAndNoPopElseNoPopExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchTrueAndNoPopElseNoPopExtraPop" +#endif +.align 3 +DoBranchTrueAndNoPopElseNoPopExtraPopIM: +.align 3 +DoBranchTrueAndNoPopElseNoPopExtraPopSP: +.align 3 +DoBranchTrueAndNoPopElseNoPopExtraPopLP: +.align 3 +DoBranchTrueAndNoPopElseNoPopExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + bne $1, DoBrExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchTrueAndNoPopElseNoPopExtraPop +/* End of Halfword operand from stack instruction - DoBranchTrueAndNoPopElseNoPopExtraPop */ +.align 5 +.globl DoBranchFalseAndNoPopElseNoPopExtraPop +.ent DoBranchFalseAndNoPopElseNoPopExtraPop 0 +/* Halfword 10 bit immediate instruction - DoBranchFalseAndNoPopElseNoPopExtraPop */ + .globl DoBranchFalseAndNoPopElseNoPopExtraPopFP + .globl DoBranchFalseAndNoPopElseNoPopExtraPopSP + .globl DoBranchFalseAndNoPopElseNoPopExtraPopLP + .globl DoBranchFalseAndNoPopElseNoPopExtraPopIM +.align 3 +DoBranchFalseAndNoPopElseNoPopExtraPop: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA1 + .asciiz "DoBranchFalseAndNoPopElseNoPopExtraPop" +#endif +.align 3 +DoBranchFalseAndNoPopElseNoPopExtraPopIM: +.align 3 +DoBranchFalseAndNoPopElseNoPopExtraPopSP: +.align 3 +DoBranchFalseAndNoPopElseNoPopExtraPopLP: +.align 3 +DoBranchFalseAndNoPopElseNoPopExtraPopFP: +/* arg1 has signed operand preloaded. */ + extll $21, 4, $1 # Check tag of word in TOS. [1-] +#ifndef CACHEMETERING + ldq $17, CACHELINE_ANNOTATION($13) # [0di] +#endif + sra $18, 48, $16 # Get signed 10-bit immediate arg [1-] +/* TagType. */ + and $1, 63, $1 # strip the cdr code off. [1] + subq $1, TypeNIL, $1 # Compare to NIL [1] + beq $1, DoBrnExtraPop # [1] +/* Here if branch not taken. Pop the argument. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + subq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +DoBrnExtraPop: # Here to take the branch + beq $16, BranchException # Can't branch to ourself [1] + subq $12, 8, $12 # [0di] + addq $9, $16, $9 # Update the PC in halfwords [1] +#ifndef CACHEMETERING + bne $17, INTERPRETINSTRUCTIONPREDICTED # [0di] +#endif + br $31, INTERPRETINSTRUCTIONFORBRANCH # [1] +.end DoBranchFalseAndNoPopElseNoPopExtraPop +/* End of Halfword operand from stack instruction - DoBranchFalseAndNoPopElseNoPopExtraPop */ +.align 5 +.globl BranchException +.ent BranchException 0 +.align 3 +BranchException: + bis $31, 0, $20 # [1-] + bis $31, 24, $17 # [1] + br $31, ILLEGALOPERAND +.end BranchException +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunloop.as */ diff --git a/alpha-emulator/ifunmath.as b/alpha-emulator/ifunmath.as new file mode 100644 index 0000000..44971a8 --- /dev/null +++ b/alpha-emulator/ifunmath.as @@ -0,0 +1,131 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Arithmetic.") + + +;; |DoAdd| and |DoSub| is in IFUNCOM2.AS + + +;; Same deal as |DoAdd| and |DoSub|... +(define-instruction |DoUnaryMinus| :operand-from-stack (:own-immediate t) + (PrefetchNextPC t6) + (PrefetchNextCP t7) + (stack-read-tag arg1 arg5 "tag of ARG2") + (stack-read-data arg1 arg6 :signed t) + (LDQ t2 PROCESSORSTATE_MOSTNEGATIVEFIXNUM (ivory)) + (stack-read-data arg1 f1 :floating t) + (type-dispatch arg5 t5 t4 + (|TypeFixnum| + (SUBL arg6 t2 t2) ;overflow if most-negative-fixnum + (SUBL zero arg6 arg2) + (BEQ t2 unaryminusexc) + (SetNextPC t6) + (stack-write-tag-disp iSP 8 t5 "Semi-cheat, we know t5 has CDRNext/TypeFixnum") + (SetNextCP t7) + (stack-push-data arg2 "Push the data") + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (with-floating-exception-checking (unaryminusexc t2) + ;(CheckFloatingOverflow arg6 unaryminusexc t2) + (SUBS f31 f1 f0)) + ;; (fp-stack-push-ir |TypeSingleFloat| f0 t7) + (SetNextPC t6) + (stack-write-tag-disp iSP 8 t5 "Semi-cheat, we know t5 has CDRNext/TypeSingleFloat") + (SetNextCP t7) + (stack-push-data f0 "Push the data" :floating t) + (ContinueToNextInstruction-NoStall)) + (:else + (label unaryminusexc) + (UnaryNumericTypeException arg5 unary-minus))) + (immediate-handler |DoUnaryMinus|) + (SUBL zero arg2 arg2 "Negate the 8 bit immediate operand") + (GetNextPCandCP) + (stack-push-ir |TypeFixnum| arg2 t7) + (ContinueToNextInstruction-NoStall)) + +;; Same deal |DoAdd| and |DoSub|... +(define-instruction |DoMultiply| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-operation multiply MULL MULS DoMulOvfl) + (immediate-handler |DoMultiply|) + (simple-binary-immediate-arithmetic-operation |DoMultiply| MULL t DoMulOvfl)) + + +;; |DoIncrement| and |DoDecrement| are in IFUNCOM2.AS + + +(align4kskip4k) + +(define-subroutine |BinaryArithmeticDivisionPrelude| + ;; --- Arguments need to be regularized + () + (r0) + ;; --- Instruction is irrelevant + (binary-arithmetic-division-prelude quotient)) + +;; Why bother optimizing this one, DIVL is already so fucking slow... +(define-instruction |DoQuotient| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (BSR r0 |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-one-value-division-operation :truncate)) + +;; Same thing, but inexact fixnum results trap out to become ratios. +;; Maybe cons them here some day? +(define-instruction |DoRationalQuotient| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (BSR r0 |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-one-value-division-operation :rational)) + +(define-instruction |DoFloor| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (BSR r0 |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :down)) + +(define-instruction |DoCeiling| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (BSR r0 |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :up)) + +(define-instruction |DoTruncate| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (BSR r0 |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :truncate)) + +(define-instruction |DoRound| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (BSR r0 |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :round)) + +(comment "Other arithmetic.") + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline +(define-instruction |DoMax| :operand-from-stack + (:provide-immediate t :signed-immediate t :needs-tos t) + (simple-binary-minmax max)) + +;; Same deal as |DoMax|... +(define-instruction |DoMin| :operand-from-stack + (:provide-immediate t :signed-immediate t :needs-tos t) + (simple-binary-minmax min)) + + +(define-instruction |DoMultiplyDouble| :operand-from-stack-signed-immediate () + (SRL arg1 32 t2 "ARG2 tag") + ;; We don't use STACK-READ2, because it clears the sign extension + (LDL t3 0 (iSP) "ARG1 data, sign extended") + (ADDL arg1 0 t4 "ARG2 data, sign extended") + (LDL t1 4 (iSP) "ARG1 tag") + (TagType t1 t1 "Strip CDR code if any.") + (SUBQ t1 |TypeFixnum| t1) + (TagType t2 t2 "Strip CDR code if any.") + (MULQ t3 t4 t5 "Perform the 63 bit multiply.") + (SUBQ t2 |TypeFixnum| t2) + (BNE t1 muldexc) + (BNE t2 muldexc) + (EXTLL t5 0 t6 "Get the low 32 bit half.") + (EXTLL t5 4 t5 "Get the high 32 bit half.") + (STL t6 0 (iSP) "Put the result back on the stack") + (stack-push-ir |TypeFixnum| t5 t1 "Push high order half") + (ContinueToNextInstruction) + (label muldexc) + (illegal-operand two-operand-fixnum-type-error)) + +(comment "Fin.") diff --git a/alpha-emulator/ifunmath.s b/alpha-emulator/ifunmath.s new file mode 100644 index 0000000..b2058b7 --- /dev/null +++ b/alpha-emulator/ifunmath.s @@ -0,0 +1,1608 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunmath.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Arithmetic. */ +.align 5 +.globl DoUnaryMinus +.ent DoUnaryMinus 0 +/* Halfword operand from stack instruction - DoUnaryMinus */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoUnaryMinusFP + .globl DoUnaryMinusSP + .globl DoUnaryMinusLP + .globl DoUnaryMinusIM +.align 3 +DoUnaryMinus: +#ifdef TRACING + .byte 0x88 + .asciiz "DoUnaryMinusSP" +#endif +.align 3 +DoUnaryMinusSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoUnaryMinus # [0di] + .byte 0x90 + .asciiz "DoUnaryMinusLP" +#endif +.align 3 +DoUnaryMinusLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoUnaryMinus # [1] + .byte 0x84 + .asciiz "DoUnaryMinusFP" +#endif +.align 3 +DoUnaryMinusFP: # Entry point for FP relative +.align 3 +beginDoUnaryMinus: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $6, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $7, CACHELINE_NEXTCP($13) # [1] + ldl $20, 4($16) # tag of ARG2 [1] + ldl $21, 0($16) # [1] + ldq $2, PROCESSORSTATE_MOSTNEGATIVEFIXNUM($14) # [1] + lds $f1, 0($16) # [1] + and $20, 63, $5 # Strip off any CDR code bits. [0di] + cmpeq $5, TypeFixnum, $4 # [1] +.align 3 +G14611: + beq $4, G14607 # [1] +/* Here if argument TypeFixnum */ + subl $21, $2, $2 # [0di] + subl $31, $21, $17 # [1] + beq $2, UNARYMINUSEXC # [0di] + bis $6, $31, $9 # [1-] + stl $5, 12($12) # Semi-cheat, we know t5 has CDRNext/TypeFixnum [0di] + bis $7, $31, $13 # [1-] + stl $17, 8($12) # Push the data [0di] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G14607: + cmpeq $5, TypeSingleFloat, $4 # [1-] +.align 3 +G14612: + beq $4, G14608 # [1] +/* Here if argument TypeSingleFloat */ + subs $f31, $f1, $f0 # [1] + trapb # Force the trap to occur here [4] + bis $6, $31, $9 # [1] + stl $5, 12($12) # Semi-cheat, we know t5 has CDRNext/TypeSingleFloat [1-] + bis $7, $31, $13 # [0di] + sts $f0, 8($12) # Push the data [1] + addq $12, 8, $12 # [1] + br $31, CACHEVALID # [1-] +.align 3 +G14608: +/* Here for all other cases */ +.align 3 +UNARYMINUSEXC: + bis $31, $20, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, UNARYNUMERICEXCEPTION +.align 3 +G14606: +#ifdef TRACING + br $31, DoUnaryMinusIM # [1-] + .byte 0x82 + .asciiz "DoUnaryMinusIM" +#endif +.align 5 +.align 3 +DoUnaryMinusIM: # Entry point for IMMEDIATE mode + subl $31, $17, $17 # Negate the 8 bit immediate operand [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $7 # [0di] + stl $17, 8($12) # [1-] + stl $7, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.end DoUnaryMinus +/* End of Halfword operand from stack instruction - DoUnaryMinus */ +.align 5 +.globl DoMultiply +.ent DoMultiply 0 +/* Halfword operand from stack instruction - DoMultiply */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMultiplyFP + .globl DoMultiplySP + .globl DoMultiplyLP + .globl DoMultiplyIM +.align 3 +DoMultiply: +#ifdef TRACING + .byte 0x88 + .asciiz "DoMultiplySP" +#endif +.align 3 +DoMultiplySP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoMultiply # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoMultiply # [0di] + .byte 0x90 + .asciiz "DoMultiplyLP" +#endif +.align 3 +DoMultiplyLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMultiply # [1] + .byte 0x84 + .asciiz "DoMultiplyFP" +#endif +.align 3 +DoMultiplyFP: # Entry point for FP relative +.align 3 +beginDoMultiply: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lds $f1, 0($12) # [0di] + extll $21, 4, $1 # ARG1 tag [1-] + ldl $3, 4($16) # ARG2 tag [1di] + addl $21, $31, $2 # ARG1 data [1-] + ldl $4, 0($16) # ARG2 data [0di] + lds $f2, 0($16) # [1] + and $1, 63, $22 # Strip off any CDR code bits. [0di] + and $3, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $22, TypeFixnum, $23 # [1] +.align 3 +G14652: + beq $23, G14623 # [1] +/* Here if argument TypeFixnum */ + cmpeq $24, TypeFixnum, $25 # [0di] +.align 3 +G14629: + beq $25, G14625 # [1] +/* Here if argument TypeFixnum */ + ldq $6, CACHELINE_NEXTPCDATA($13) # [0di] + mullv $2, $4, $5 # compute 64-bit result [1-] + ldq $7, CACHELINE_NEXTCP($13) # [0di] + trapb # Force the trap to occur here [21] + stl $22, 4($12) # Semi-cheat, we know temp2 has CDRNext/TypeFixnum [20] + bis $6, $31, $9 # [1-] + stl $5, 0($12) # [0di] + bis $7, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G14625: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14630: + beq $25, G14626 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqt $f1, $f1 # [6] + br $31, G14613 # [1] +.align 3 +G14626: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G14631: + beq $25, G14620 # [1] +/* Here if argument TypeDoubleFloat */ + cvtlq $f1, $f1 # [3] + cvtqt $f1, $f1 # [6] + br $31, G14616 # [1] +.align 3 +G14624: +.align 3 +G14623: + cmpeq $22, TypeSingleFloat, $23 # [1-] +.align 3 +G14653: + beq $23, G14632 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $24, TypeSingleFloat, $25 # [0di] +.align 3 +G14638: + beq $25, G14634 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G14613: + muls $f1, $f2, $f0 # [2] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeSingleFloat, $8 # [1-] + stl $8, 4($12) # write the stack cache [0di] + sts $f0, 0($12) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14634: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G14639: + beq $25, G14635 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqt $f2, $f2 # [6] + br $31, G14613 # [1] +.align 3 +G14635: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G14640: + beq $25, G14620 # [1] +/* Here if argument TypeDoubleFloat */ +.align 3 +G14616: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + br $31, G14617 # [1] +.align 3 +G14633: +.align 3 +G14632: + cmpeq $22, TypeDoubleFloat, $23 # [1-] +.align 3 +G14654: + beq $23, G14641 # [1] +/* Here if argument TypeDoubleFloat */ + cmpeq $24, TypeDoubleFloat, $25 # [0di] +.align 3 +G14647: + beq $25, G14643 # [1] +/* Here if argument TypeDoubleFloat */ + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [0di] + bsr $0, FetchDoubleFloat + ldt $f1, PROCESSORSTATE_FP0($14) # [1-] +.align 3 +G14617: + extll $4, 0, $17 # [1-] + bsr $0, FetchDoubleFloat + ldt $f2, PROCESSORSTATE_FP0($14) # [0di] +.align 3 +G14614: + mult $f1, $f2, $f0 # [3] + stt $f0, PROCESSORSTATE_FP0($14) # [0di] + bsr $0, ConsDoubleFloat + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeDoubleFloat, $8 # [1-] + stl $17, 0($12) # [0di] + stl $8, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G14643: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14648: + beq $25, G14644 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G14615: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [1-] + bsr $0, FetchDoubleFloat + ldt $f1, PROCESSORSTATE_FP0($14) # [0di] + br $31, G14614 # [1] +.align 3 +G14644: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G14649: + beq $25, G14620 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqt $f2, $f2 # [6] + br $31, G14615 # [1] +.align 3 +G14642: +.align 3 +G14641: +/* Here for all other cases */ +.align 3 +G14619: +.align 3 +DOMULOVFL: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G14621 # [1-] +.align 3 +G14620: + bis $3, $31, $1 # [1-] + br $31, DOMULOVFL # [0di] +.align 3 +G14621: +.align 3 +G14622: +#ifdef TRACING + br $31, DoMultiplyIM # [1] + .byte 0x82 + .asciiz "DoMultiplyIM" +#endif +.align 5 +.align 3 +DoMultiplyIM: # Entry point for IMMEDIATE mode + sll $17, 56, $17 # [1-] + extll $21, 4, $1 # [1] + addl $21, $31, $2 # get ARG1 tag/data [1] + sra $17, 56, $17 # [1] + and $1, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $24, TypeFixnum, $25 # [1] +.align 3 +G14659: + beq $25, G14656 # [1] +/* Here if argument TypeFixnum */ + mulq $2, $17, $3 # compute 64-bit result [0di] + ldq $4, CACHELINE_NEXTPCDATA($13) # [1-] + addl $3, $31, $23 # compute 32-bit sign-extended result [22di] + ldq $5, CACHELINE_NEXTCP($13) # [1-] + cmpeq $3, $23, $23 # is it the same as the 64-bit result? [0di] + beq $23, DOMULOVFL # if not, we overflowed [1] + stl $24, 4($12) # Semi-cheat, we know temp2 has CDRNext/TypeFixnum [1] + bis $4, $31, $9 # [1-] + stl $3, 0($12) # [0di] + bis $5, $31, $13 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +G14656: +/* Here for all other cases */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + bis $31, $31, $17 # [1] + br $31, beginDoMultiply # [0di] +.align 3 +G14655: +.end DoMultiply +/* End of Halfword operand from stack instruction - DoMultiply */ +.align 12 + and $31, $31, $31 # [1] +.align 12 +.align 5 +.globl BinaryArithmeticDivisionPrelude +.ent BinaryArithmeticDivisionPrelude 0 +.align 3 +BinaryArithmeticDivisionPrelude: + lda $30, -8($30) # [1] + .frame $30, 8, $0 + lds $f1, 0($12) # [0di] + addl $21, $31, $2 # ARG1 data [1-] + ldl $4, 0($16) # ARG2 data [0di] + extll $21, 4, $1 # ARG1 tag [1-] + ldl $3, 4($16) # ARG2 tag [0di] + lds $f2, 0($16) # [1] + and $1, 63, $22 # Strip off any CDR code bits. [1di] + and $3, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $22, TypeFixnum, $23 # [1] +.align 3 +G14697: + beq $23, G14670 # [1] +/* Here if argument TypeFixnum */ + cmpeq $24, TypeFixnum, $25 # [0di] +.align 3 +G14676: + beq $25, G14672 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f1, $f1 # [1] + cvtlq $f2, $f2 # [1] + cvtqt $f1, $f1 # [5] + cvtqt $f2, $f2 # [1] +.align 3 +G14671: +.align 3 +G14669: +.align 3 +G14660: + lda $30, 8($30) # [1-] + ret $31, ($0), 1 # [0di] +.align 3 +G14670: + cmpeq $22, TypeSingleFloat, $23 # [1-] +.align 3 +G14698: + beq $23, G14677 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $24, TypeSingleFloat, $25 # [0di] +.align 3 +G14683: + bne $25, G14660 # [1] +.align 3 +G14679: + cmpeq $24, TypeFixnum, $25 # [1] +.align 3 +G14684: + beq $25, G14680 # [1] +/* Here if argument TypeFixnum */ + bis $31, $1, $3 # contagion [0di] + cvtlq $f2, $f2 # [1-] + cvtqt $f2, $f2 # [6] + br $31, G14660 # [1] +.align 3 +G14680: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G14685: + beq $25, G14667 # [1] +/* Here if argument TypeDoubleFloat */ +.align 3 +G14662: + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + br $31, G14663 # [1] +.align 3 +G14678: +.align 3 +G14677: + cmpeq $22, TypeDoubleFloat, $23 # [1-] +.align 3 +G14699: + beq $23, G14686 # [1] +/* Here if argument TypeDoubleFloat */ + cmpeq $24, TypeDoubleFloat, $25 # [0di] +.align 3 +G14692: + beq $25, G14688 # [1] +/* Here if argument TypeDoubleFloat */ + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [0di] + stq $0, 0($30) # [1-] + bsr $0, FetchDoubleFloat + ldq $0, 0($30) # [1] + ldt $f1, PROCESSORSTATE_FP0($14) # [1] +.align 3 +G14663: + extll $4, 0, $17 # [1-] + stq $0, 0($30) # [0di] + bsr $0, FetchDoubleFloat + ldq $0, 0($30) # [1] + ldt $f2, PROCESSORSTATE_FP0($14) # [1] + br $31, G14660 # [1] +.align 3 +G14688: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14693: + beq $25, G14689 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G14661: + bis $31, $1, $3 # contagion [1-] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + extll $2, 0, $17 # [0di] + stq $0, 0($30) # [1-] + bsr $0, FetchDoubleFloat + ldq $0, 0($30) # [1] + ldt $f1, PROCESSORSTATE_FP0($14) # [1] + br $31, G14660 # [1] +.align 3 +G14689: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G14694: + beq $25, G14667 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqt $f2, $f2 # [6] + br $31, G14661 # [1] +.align 3 +G14687: +.align 3 +G14686: +/* Here for all other cases */ +.align 3 +G14666: +.align 3 +G14664: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G14668 # [1-] +.align 3 +G14667: + bis $3, $31, $1 # [1-] + br $31, G14664 # [0di] +.align 3 +G14668: +.align 3 +G14672: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14700: + beq $25, G14673 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqt $f1, $f1 # [6] + br $31, G14660 # [1] +.align 3 +G14673: + cmpeq $24, TypeDoubleFloat, $25 # [1-] +.align 3 +G14701: + beq $25, G14667 # [1] +/* Here if argument TypeDoubleFloat */ + cvtlq $f1, $f1 # [3] + cvtqt $f1, $f1 # [6] + br $31, G14662 # [1] +.end BinaryArithmeticDivisionPrelude +.align 5 +.globl DoQuotient +.ent DoQuotient 0 +/* Halfword operand from stack instruction - DoQuotient */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoQuotientFP + .globl DoQuotientSP + .globl DoQuotientLP + .globl DoQuotientIM +.align 3 +DoQuotient: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoQuotientIM" +#endif +.align 3 +DoQuotientIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoQuotient # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoQuotientSP" +#endif +.align 3 +DoQuotientSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoQuotient # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoQuotient # [0di] + .byte 0x90 + .asciiz "DoQuotientLP" +#endif +.align 3 +DoQuotientLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoQuotient # [1] + .byte 0x84 + .asciiz "DoQuotientFP" +#endif +.align 3 +DoQuotientFP: # Entry point for FP relative +.align 3 +beginDoQuotient: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + bsr $0, BinaryArithmeticDivisionPrelude + and $3, 63, $8 # Strip off any CDR code bits. [1] + cmpeq $8, TypeFixnum, $22 # [1] +.align 3 +G14707: + beq $22, G14703 # [1] +/* Here if argument TypeFixnum */ + divt $f1, $f2, $f0 # [1] + cvttqvc $f0, $f0 # [63] + cvtqlv $f0, $f0 # [6] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] +.align 3 +G14702: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14703: + cmpeq $8, TypeSingleFloat, $22 # [1-] +.align 3 +G14708: + beq $22, G14704 # [1] +/* Here if argument TypeSingleFloat */ + divs $f1, $f2, $f0 # [1] + trapb # Force the trap to occur here [32] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + br $31, G14702 # [1] +.align 3 +G14704: + cmpeq $8, TypeDoubleFloat, $22 # [1-] +.align 3 +G14709: + beq $22, G14702 # [1] +/* Here if argument TypeDoubleFloat */ + divt $f1, $f2, $f0 # [24] + stt $f0, PROCESSORSTATE_FP0($14) # [1-] + bsr $0, ConsDoubleFloat + bis $31, TypeDoubleFloat, $8 # [1] + stl $17, 0($12) # [1-] + stl $8, 4($12) # write the stack cache [1] + br $31, G14702 # [1] +.end DoQuotient +/* End of Halfword operand from stack instruction - DoQuotient */ +.align 5 +.globl DoRationalQuotient +.ent DoRationalQuotient 0 +/* Halfword operand from stack instruction - DoRationalQuotient */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoRationalQuotientFP + .globl DoRationalQuotientSP + .globl DoRationalQuotientLP + .globl DoRationalQuotientIM +.align 3 +DoRationalQuotient: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoRationalQuotientIM" +#endif +.align 3 +DoRationalQuotientIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoRationalQuotient # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoRationalQuotientSP" +#endif +.align 3 +DoRationalQuotientSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoRationalQuotient # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoRationalQuotient # [0di] + .byte 0x90 + .asciiz "DoRationalQuotientLP" +#endif +.align 3 +DoRationalQuotientLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoRationalQuotient # [1] + .byte 0x84 + .asciiz "DoRationalQuotientFP" +#endif +.align 3 +DoRationalQuotientFP: # Entry point for FP relative +.align 3 +beginDoRationalQuotient: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + bsr $0, BinaryArithmeticDivisionPrelude + and $3, 63, $8 # Strip off any CDR code bits. [1] + cmpeq $8, TypeFixnum, $22 # [1] +.align 3 +G14715: + beq $22, G14711 # [1] +/* Here if argument TypeFixnum */ + divt $f1, $f2, $f0 # [42] + cvttqsvi $f0, $f0 # [63] + cvtqlv $f0, $f0 # [6] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] +.align 3 +G14710: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14711: + cmpeq $8, TypeSingleFloat, $22 # [1-] +.align 3 +G14716: + beq $22, G14712 # [1] +/* Here if argument TypeSingleFloat */ + divs $f1, $f2, $f0 # [1] + trapb # Force the trap to occur here [32] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + br $31, G14710 # [1] +.align 3 +G14712: + cmpeq $8, TypeDoubleFloat, $22 # [1-] +.align 3 +G14717: + beq $22, G14710 # [1] +/* Here if argument TypeDoubleFloat */ + divt $f1, $f2, $f0 # [24] + stt $f0, PROCESSORSTATE_FP0($14) # [1-] + bsr $0, ConsDoubleFloat + bis $31, TypeDoubleFloat, $8 # [1] + stl $17, 0($12) # [1-] + stl $8, 4($12) # write the stack cache [1] + br $31, G14710 # [1] +.end DoRationalQuotient +/* End of Halfword operand from stack instruction - DoRationalQuotient */ +.align 5 +.globl DoFloor +.ent DoFloor 0 +/* Halfword operand from stack instruction - DoFloor */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoFloorFP + .globl DoFloorSP + .globl DoFloorLP + .globl DoFloorIM +.align 3 +DoFloor: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoFloorIM" +#endif +.align 3 +DoFloorIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoFloor # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoFloorSP" +#endif +.align 3 +DoFloorSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoFloor # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoFloor # [0di] + .byte 0x90 + .asciiz "DoFloorLP" +#endif +.align 3 +DoFloorLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoFloor # [1] + .byte 0x84 + .asciiz "DoFloorFP" +#endif +.align 3 +DoFloorFP: # Entry point for FP relative +.align 3 +beginDoFloor: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + bsr $0, BinaryArithmeticDivisionPrelude + divt $f1, $f2, $f0 # [45di] + cvttqvm $f0, $f0 # [63] + cvtqt $f0, $f3 # [6] + mult $f3, $f2, $f3 # [6] + subt $f1, $f3, $f3 # [6] + cvtqlv $f0, $f0 # [1] + and $3, 63, $8 # Strip off any CDR code bits. [0di] + cmpeq $8, TypeFixnum, $22 # [1] +.align 3 +G14723: + beq $22, G14719 # [1] +/* Here if argument TypeFixnum */ + cvttq $f3, $f3 # [3] + cvtql $f3, $f3 # [6] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [0di] + sts $f0, 0($12) # [1] + bis $31, TypeFixnum, $8 # [1] + stl $8, 12($12) # write the stack cache [1-] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] +.align 3 +G14718: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14719: + cmpeq $8, TypeSingleFloat, $22 # [1-] +.align 3 +G14724: + beq $22, G14720 # [1] +/* Here if argument TypeSingleFloat */ + cvtts $f3, $f3 # [1] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 12($12) # write the stack cache [0di] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] + br $31, G14718 # [1-] +.align 3 +G14720: + cmpeq $8, TypeDoubleFloat, $22 # [1-] +.align 3 +G14725: + beq $22, G14718 # [1] +/* Here if argument TypeDoubleFloat */ + trapb # Force the trap to occur here [1] + stt $f3, PROCESSORSTATE_FP0($14) # [1] + bsr $0, ConsDoubleFloat + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeDoubleFloat, $8 # [1] + stl $17, 8($12) # [0di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, G14718 # [1-] +.end DoFloor +/* End of Halfword operand from stack instruction - DoFloor */ +.align 5 +.globl DoCeiling +.ent DoCeiling 0 +/* Halfword operand from stack instruction - DoCeiling */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoCeilingFP + .globl DoCeilingSP + .globl DoCeilingLP + .globl DoCeilingIM +.align 3 +DoCeiling: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoCeilingIM" +#endif +.align 3 +DoCeilingIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoCeiling # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoCeilingSP" +#endif +.align 3 +DoCeilingSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoCeiling # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoCeiling # [0di] + .byte 0x90 + .asciiz "DoCeilingLP" +#endif +.align 3 +DoCeilingLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoCeiling # [1] + .byte 0x84 + .asciiz "DoCeilingFP" +#endif +.align 3 +DoCeilingFP: # Entry point for FP relative +.align 3 +beginDoCeiling: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + bsr $0, BinaryArithmeticDivisionPrelude + cpysn $f2, $f2, $f2 # [1] + divt $f1, $f2, $f0 # [1] + cvttqvm $f0, $f0 # [63] + cvtqt $f0, $f3 # [6] + cpysn $f3, $f3, $f0 # [1] + cvttq $f0, $f0 # [1] + mult $f3, $f2, $f3 # [4] + subt $f1, $f3, $f3 # [6] + cvtqlv $f0, $f0 # [1] + and $3, 63, $8 # Strip off any CDR code bits. [1-] + cmpeq $8, TypeFixnum, $22 # [1] +.align 3 +G14731: + beq $22, G14727 # [1] +/* Here if argument TypeFixnum */ + cvttq $f3, $f3 # [2] + cvtql $f3, $f3 # [6] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [0di] + sts $f0, 0($12) # [1] + bis $31, TypeFixnum, $8 # [1] + stl $8, 12($12) # write the stack cache [1-] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] +.align 3 +G14726: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14727: + cmpeq $8, TypeSingleFloat, $22 # [1-] +.align 3 +G14732: + beq $22, G14728 # [1] +/* Here if argument TypeSingleFloat */ + cvtts $f3, $f3 # [1] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 12($12) # write the stack cache [0di] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] + br $31, G14726 # [1-] +.align 3 +G14728: + cmpeq $8, TypeDoubleFloat, $22 # [1-] +.align 3 +G14733: + beq $22, G14726 # [1] +/* Here if argument TypeDoubleFloat */ + trapb # Force the trap to occur here [1] + stt $f3, PROCESSORSTATE_FP0($14) # [1] + bsr $0, ConsDoubleFloat + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeDoubleFloat, $8 # [1] + stl $17, 8($12) # [0di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, G14726 # [1-] +.end DoCeiling +/* End of Halfword operand from stack instruction - DoCeiling */ +.align 5 +.globl DoTruncate +.ent DoTruncate 0 +/* Halfword operand from stack instruction - DoTruncate */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoTruncateFP + .globl DoTruncateSP + .globl DoTruncateLP + .globl DoTruncateIM +.align 3 +DoTruncate: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoTruncateIM" +#endif +.align 3 +DoTruncateIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoTruncate # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoTruncateSP" +#endif +.align 3 +DoTruncateSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoTruncate # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoTruncate # [0di] + .byte 0x90 + .asciiz "DoTruncateLP" +#endif +.align 3 +DoTruncateLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoTruncate # [1] + .byte 0x84 + .asciiz "DoTruncateFP" +#endif +.align 3 +DoTruncateFP: # Entry point for FP relative +.align 3 +beginDoTruncate: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + bsr $0, BinaryArithmeticDivisionPrelude + divt $f1, $f2, $f0 # [0di] + cvttqvc $f0, $f0 # [63] + cvtqt $f0, $f3 # [6] + mult $f3, $f2, $f3 # [6] + subt $f1, $f3, $f3 # [6] + cvtqlv $f0, $f0 # [1] + and $3, 63, $8 # Strip off any CDR code bits. [0di] + cmpeq $8, TypeFixnum, $22 # [1] +.align 3 +G14748: + beq $22, G14744 # [1] +/* Here if argument TypeFixnum */ + cvttq $f3, $f3 # [3] + cvtql $f3, $f3 # [6] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [0di] + sts $f0, 0($12) # [1] + bis $31, TypeFixnum, $8 # [1] + stl $8, 12($12) # write the stack cache [1-] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] +.align 3 +G14743: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14744: + cmpeq $8, TypeSingleFloat, $22 # [1-] +.align 3 +G14749: + beq $22, G14745 # [1] +/* Here if argument TypeSingleFloat */ + cvtts $f3, $f3 # [1] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 12($12) # write the stack cache [0di] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] + br $31, G14743 # [1-] +.align 3 +G14745: + cmpeq $8, TypeDoubleFloat, $22 # [1-] +.align 3 +G14750: + beq $22, G14743 # [1] +/* Here if argument TypeDoubleFloat */ + trapb # Force the trap to occur here [1] + stt $f3, PROCESSORSTATE_FP0($14) # [1] + bsr $0, ConsDoubleFloat + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeDoubleFloat, $8 # [1] + stl $17, 8($12) # [0di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, G14743 # [1-] +.end DoTruncate +/* End of Halfword operand from stack instruction - DoTruncate */ +.align 5 +.globl DoRound +.ent DoRound 0 +/* Halfword operand from stack instruction - DoRound */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoRoundFP + .globl DoRoundSP + .globl DoRoundLP + .globl DoRoundIM +.align 3 +DoRound: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoRoundIM" +#endif +.align 3 +DoRoundIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoRound # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoRoundSP" +#endif +.align 3 +DoRoundSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoRound # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoRound # [0di] + .byte 0x90 + .asciiz "DoRoundLP" +#endif +.align 3 +DoRoundLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoRound # [1] + .byte 0x84 + .asciiz "DoRoundFP" +#endif +.align 3 +DoRoundFP: # Entry point for FP relative +.align 3 +beginDoRound: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + bsr $0, BinaryArithmeticDivisionPrelude + divt $f1, $f2, $f0 # [0di] + cvttqv $f0, $f0 # [63] + cvtqt $f0, $f3 # [6] + mult $f3, $f2, $f3 # [6] + subt $f1, $f3, $f3 # [6] + cvtqlv $f0, $f0 # [1] + and $3, 63, $8 # Strip off any CDR code bits. [0di] + cmpeq $8, TypeFixnum, $22 # [1] +.align 3 +G14756: + beq $22, G14752 # [1] +/* Here if argument TypeFixnum */ + cvttq $f3, $f3 # [3] + cvtql $f3, $f3 # [6] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [0di] + sts $f0, 0($12) # [1] + bis $31, TypeFixnum, $8 # [1] + stl $8, 12($12) # write the stack cache [1-] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] +.align 3 +G14751: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14752: + cmpeq $8, TypeSingleFloat, $22 # [1-] +.align 3 +G14757: + beq $22, G14753 # [1] +/* Here if argument TypeSingleFloat */ + cvtts $f3, $f3 # [1] + trapb # Force the trap to occur here [4] + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 12($12) # write the stack cache [0di] + sts $f3, 8($12) # [1] + addq $12, 8, $12 # [1] + br $31, G14751 # [1-] +.align 3 +G14753: + cmpeq $8, TypeDoubleFloat, $22 # [1-] +.align 3 +G14758: + beq $22, G14751 # [1] +/* Here if argument TypeDoubleFloat */ + trapb # Force the trap to occur here [1] + stt $f3, PROCESSORSTATE_FP0($14) # [1] + bsr $0, ConsDoubleFloat + bis $31, TypeFixnum, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f0, 0($12) # [1] + bis $31, TypeDoubleFloat, $8 # [1] + stl $17, 8($12) # [0di] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, G14751 # [1-] +.end DoRound +/* End of Halfword operand from stack instruction - DoRound */ +/* Other arithmetic. */ +.align 5 +.globl DoMax +.ent DoMax 0 +/* Halfword operand from stack instruction - DoMax */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMaxFP + .globl DoMaxSP + .globl DoMaxLP + .globl DoMaxIM +.align 3 +DoMax: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoMaxIM" +#endif +.align 3 +DoMaxIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoMax # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoMaxSP" +#endif +.align 3 +DoMaxSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoMax # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoMax # [0di] + .byte 0x90 + .asciiz "DoMaxLP" +#endif +.align 3 +DoMaxLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMax # [1] + .byte 0x84 + .asciiz "DoMaxFP" +#endif +.align 3 +DoMaxFP: # Entry point for FP relative +.align 3 +beginDoMax: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lds $f1, 0($12) # [0di] + extll $21, 4, $1 # ARG1 tag [1-] + ldl $3, 4($16) # ARG2 tag [1di] + addl $21, $31, $2 # ARG1 data [1-] + ldl $4, 0($16) # ARG2 data [0di] + lds $f2, 0($16) # [1] + and $1, 63, $22 # Strip off any CDR code bits. [0di] + and $3, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $22, TypeFixnum, $23 # [1] +.align 3 +G14782: + beq $23, G14766 # [1] +/* Here if argument TypeFixnum */ + cmpeq $24, TypeFixnum, $25 # [0di] +.align 3 +G14771: + beq $25, G14768 # [1] +/* Here if argument TypeFixnum */ + subq $2, $4, $5 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + cmovgt $5, $2, $4 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + stl $4, 0($12) # We know temp2 has CDRNext/TypeFixnum [1] + stl $22, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G14768: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14772: + beq $25, G14763 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqs $f1, $f1 # [6] + br $31, G14760 # [1] +.align 3 +G14767: +.align 3 +G14766: + cmpeq $22, TypeSingleFloat, $23 # [1-] +.align 3 +G14783: + beq $23, G14773 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $24, TypeSingleFloat, $25 # [0di] +.align 3 +G14778: + beq $25, G14775 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G14760: + subs $f1, $f2, $f0 # [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + fcmovgt $f0, $f1, $f2 # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + trapb # Force the trap to occur here [3] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f2, 0($12) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14775: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G14779: + beq $25, G14763 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqs $f2, $f2 # [6] + br $31, G14760 # [1] +.align 3 +G14774: +.align 3 +G14773: +/* Here for all other cases */ +.align 3 +G14762: +.align 3 +G14759: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G14764 # [1-] +.align 3 +G14763: + bis $3, $31, $1 # [1-] + br $31, G14759 # [0di] +.align 3 +G14764: +.align 3 +G14765: +.end DoMax +/* End of Halfword operand from stack instruction - DoMax */ +.align 5 +.globl DoMin +.ent DoMin 0 +/* Halfword operand from stack instruction - DoMin */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoMinFP + .globl DoMinSP + .globl DoMinLP + .globl DoMinIM +.align 3 +DoMin: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoMinIM" +#endif +.align 3 +DoMinIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $16 # sign extend the byte argument. [1-] + bis $31, $31, $17 # [1] + sra $16, 56, $16 # Rest of sign extension [1] + stl $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + lda $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoMin # [0di] +#ifdef TRACING + .byte 0x88 + .asciiz "DoMinSP" +#endif +.align 3 +DoMinSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + bne $17, beginDoMin # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoMin # [0di] + .byte 0x90 + .asciiz "DoMinLP" +#endif +.align 3 +DoMinLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoMin # [1] + .byte 0x84 + .asciiz "DoMinFP" +#endif +.align 3 +DoMinFP: # Entry point for FP relative +.align 3 +beginDoMin: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + lds $f1, 0($12) # [0di] + extll $21, 4, $1 # ARG1 tag [1-] + ldl $3, 4($16) # ARG2 tag [1di] + addl $21, $31, $2 # ARG1 data [1-] + ldl $4, 0($16) # ARG2 data [0di] + lds $f2, 0($16) # [1] + and $1, 63, $22 # Strip off any CDR code bits. [0di] + and $3, 63, $24 # Strip off any CDR code bits. [1] + cmpeq $22, TypeFixnum, $23 # [1] +.align 3 +G14807: + beq $23, G14791 # [1] +/* Here if argument TypeFixnum */ + cmpeq $24, TypeFixnum, $25 # [0di] +.align 3 +G14796: + beq $25, G14793 # [1] +/* Here if argument TypeFixnum */ + subq $2, $4, $5 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + cmovlt $5, $2, $4 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + stl $4, 0($12) # We know temp2 has CDRNext/TypeFixnum [1] + stl $22, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.align 3 +G14793: + cmpeq $24, TypeSingleFloat, $25 # [1-] +.align 3 +G14797: + beq $25, G14788 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqs $f1, $f1 # [6] + br $31, G14785 # [1] +.align 3 +G14792: +.align 3 +G14791: + cmpeq $22, TypeSingleFloat, $23 # [1-] +.align 3 +G14808: + beq $23, G14798 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $24, TypeSingleFloat, $25 # [0di] +.align 3 +G14803: + beq $25, G14800 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +G14785: + subs $f1, $f2, $f0 # [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + fcmovlt $f0, $f1, $f2 # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + trapb # Force the trap to occur here [3] + bis $31, TypeSingleFloat, $8 # [1] + stl $8, 4($12) # write the stack cache [1-] + sts $f2, 0($12) # [1] + br $31, CACHEVALID # [1] +.align 3 +G14800: + cmpeq $24, TypeFixnum, $25 # [1-] +.align 3 +G14804: + beq $25, G14788 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqs $f2, $f2 # [6] + br $31, G14785 # [1] +.align 3 +G14799: +.align 3 +G14798: +/* Here for all other cases */ +.align 3 +G14787: +.align 3 +G14784: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G14789 # [1-] +.align 3 +G14788: + bis $3, $31, $1 # [1-] + br $31, G14784 # [0di] +.align 3 +G14789: +.align 3 +G14790: +.end DoMin +/* End of Halfword operand from stack instruction - DoMin */ +.align 5 +.globl DoMultiplyDouble +.ent DoMultiplyDouble 0 +/* Halfword operand from stack instruction - DoMultiplyDouble */ + .globl DoMultiplyDoubleFP + .globl DoMultiplyDoubleSP + .globl DoMultiplyDoubleLP + .globl DoMultiplyDoubleIM +.align 3 +DoMultiplyDouble: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoMultiplyDoubleIM" +#endif +.align 3 +DoMultiplyDoubleIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G14809: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoMultiplyDouble # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoMultiplyDoubleSP" +#endif +.align 3 +DoMultiplyDoubleSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoMultiplyDouble # [0di] + .byte 0x90 + .asciiz "DoMultiplyDoubleLP" +#endif +.align 3 +DoMultiplyDoubleLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoMultiplyDouble # [1] + .byte 0x84 + .asciiz "DoMultiplyDoubleFP" +#endif +.align 3 +DoMultiplyDoubleFP: # Entry point for FP relative +.align 3 +headDoMultiplyDouble: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoMultiplyDouble: +/* arg1 has the operand, sign extended if immediate. */ + srl $16, 32, $2 # ARG2 tag [3] + ldl $3, 0($12) # ARG1 data, sign extended [0di] + addl $16, 0, $4 # ARG2 data, sign extended [1-] + ldl $1, 4($12) # ARG1 tag [0di] +/* TagType. */ + and $1, 63, $1 # Strip CDR code if any. [3] + subq $1, TypeFixnum, $1 # [1] +/* TagType. */ + and $2, 63, $2 # Strip CDR code if any. [1] + mulq $3, $4, $5 # Perform the 63 bit multiply. [1] + subq $2, TypeFixnum, $2 # [1] + bne $1, MULDEXC # [0di] + bne $2, MULDEXC # [1] + extll $5, 0, $6 # Get the low 32 bit half. [21di] + extll $5, 4, $5 # Get the high 32 bit half. [1] + stl $6, 0($12) # Put the result back on the stack [0di] + bis $31, TypeFixnum, $1 # [1-] + stl $5, 8($12) # Push high order half [0di] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.align 3 +MULDEXC: + bis $31, 0, $20 # [1-] + bis $31, 80, $17 # [1] + br $31, ILLEGALOPERAND +.end DoMultiplyDouble +/* End of Halfword operand from stack instruction - DoMultiplyDouble */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunmath.as */ diff --git a/alpha-emulator/ifunmove.as b/alpha-emulator/ifunmove.as new file mode 100644 index 0000000..c8742b2 --- /dev/null +++ b/alpha-emulator/ifunmove.as @@ -0,0 +1,112 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Data movement.") + +;; |DoPush|, |DoPop|, and |DoMovem| are in IFUNCOM1.AS + + +(define-instruction |DoPushNNils| :operand-from-stack-immediate (:own-immediate t) + (EXTLL arg1 0 arg2 "Get the data") + (SRL arg1 32 t1 "and the tag") + (CheckDataType t1 |TypeFixnum| pushnnbadop t5) + (immediate-handler |DoPushNNils|) + (stack-cache-overflow-check t1 t2 t3 t4 t5 iSP arg2) + (LDQ arg6 PROCESSORSTATE_NILADDRESS (ivory)) + (BR zero pushnnilsl2) + (label pushnnilsl1) + (stack-push-with-cdr arg6 "Push NIL") + (SUBQ arg2 1 arg2) + (unlikely-label pushnnilsl2) + (BGT arg2 pushnnilsl1) + (ContinueToNextInstruction) + (label pushnnbadop) + (illegal-operand one-operand-fixnum-type-error)) ;+++ hmm + + +;; |DoPushAddress| is in IFUNCOM1.AS + + +;; |DoSetSpToAddress| and |DoSetSpToAddressSaveTos| are in IFUNCOM1.AS + + +(define-instruction |DoPushAddressSpRelative| :operand-from-stack-immediate () + (LDQ t4 PROCESSORSTATE_RESTARTSP (ivory) "SP before any popping") + (SRL arg1 32 t1) + (EXTLL arg1 0 arg1) + (LDQ t6 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LDQ t7 PROCESSORSTATE_STACKCACHEDATA (ivory) "THe stack cache data block") + (type-dispatch t1 t2 t3 + (|TypeFixnum| + (S8ADDQ arg1 8 arg1) + (SUBQ t4 arg1 t5 "Compute stack relative pointer") + ;; +++ SCAtoVMA ? + (SUBQ t5 t7 t5 "Index into stack data") + (SRL t5 3 t5 "Convert to word index") + (ADDQ t6 t5 t5 "Convert to an ivory word address") + (GetNextPCandCP) + (stack-push-ir |TypeLocative| t5 t6) + (ContinueToNextInstruction-NoStall)) + (:else + (illegal-operand one-operand-fixnum-type-error)))) + +;;+++ Should signal STACK-BLT-TYPE-ERROR if arguments are not locatives +(define-instruction |DoStackBlt| :operand-from-stack-immediate () + (stack-pop2 t2 t3 "Destination locative") + (EXTLL arg1 0 t1) + (VMAtoSCA t1 arg1 t4) + (LDQ t4 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LDQ t5 PROCESSORSTATE_STACKCACHETOPVMA (ivory) "End ofthe stack cache") + (LDQ t1 PROCESSORSTATE_STACKCACHEDATA (ivory) "THe stack cache data block") + (SUBQ t3 t4 t6 "BAse of Stack Cache.") + (SUBQ t3 t5 t7 "Top of Stack Cache.") + (BLT t6 stkbltexc "J. if vma below stack cache") + (BGE t7 stkbltexc "J. if vma above stack cache") + (S8ADDQ t6 t1 t6 "Compute the stackcache address") + (BR zero stkbltloopend) + (label stkbltloop) + (addq arg1 8 arg1 "Advance Source") + (addq t6 8 t6 "Advance destination") + (unlikely-label stkbltloopend) + (stack-read arg1 t1 "Read a word from the source") + (SUBQ arg1 iSP t4) + (stack-write t6 t1 "copy the word") + (BNE t4 stkbltloop "J. if sourse not stack top") + (BIS t6 zero iSP "Update the SP to point at the last written location") + (ContinueToNextInstruction) + (label stkbltexc) + (illegal-operand stack-blt-type-error)) + +;;; arg1 = ARG2 = FROM address +;;; tos = ARG1 = TO +(define-instruction |DoStackBltAddress| :operand-from-stack () + (stack-pop2 t2 t3 "Destination locative") + (LDQ t4 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LDQ t5 PROCESSORSTATE_STACKCACHETOPVMA (ivory) "End ofthe stack cache") + (LDQ t1 PROCESSORSTATE_STACKCACHEDATA (ivory) "THe stack cache data block") + (SUBQ t3 t4 t6 "Base of Stack Cache.") + (SUBQ t3 t5 t7 "Top of Stack Cache.") + (BLT t6 stkbltadrexc "J. if vma below stack cache") + (BGE t7 stkbltadrexc "J. if vma above stack cache") + (S8ADDQ t6 t1 t6 "Compute the stackcache address") + (BR zero stkbltaddloopend) + (label stkbltaddloop) + (addq arg1 8 arg1 "Advance Source") + (addq t6 8 t6 "Advance destination") + (unlikely-label stkbltaddloopend) + (stack-read arg1 t1 "Read a word from the source") + (SUBQ arg1 iSP t4) + (stack-write t6 t1 "copy the word") + (BNE t4 stkbltaddloop "J. if sourse not stack top") + (BIS t6 zero iSP "Update the SP to point at the last written location") + (ContinueToNextInstruction) + (label stkbltadrexc) + (illegal-operand stack-blt-type-error)) + + +(comment "Fin.") + + diff --git a/alpha-emulator/ifunmove.s b/alpha-emulator/ifunmove.s new file mode 100644 index 0000000..1002d96 --- /dev/null +++ b/alpha-emulator/ifunmove.s @@ -0,0 +1,336 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunmove.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Data movement. */ +.align 5 +.globl DoPushNNils +.ent DoPushNNils 0 +/* Halfword operand from stack instruction - DoPushNNils */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPushNNilsFP + .globl DoPushNNilsSP + .globl DoPushNNilsLP + .globl DoPushNNilsIM +.align 3 +DoPushNNils: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPushNNilsSP" +#endif +.align 3 +DoPushNNilsSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoPushNNils # [0di] + .byte 0x90 + .asciiz "DoPushNNilsLP" +#endif +.align 3 +DoPushNNilsLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoPushNNils # [1] + .byte 0x84 + .asciiz "DoPushNNilsFP" +#endif +.align 3 +DoPushNNilsFP: # Entry point for FP relative +.align 3 +headDoPushNNils: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoPushNNils: +/* arg1 has the operand, not sign extended if immediate. */ + extll $16, 0, $17 # Get the data [3] + srl $16, 32, $1 # and the tag [1] + subq $1, TypeFixnum, $5 # [2] + and $5, 63, $5 # Strip CDR code [1] + bne $5, PUSHNNBADOP # [1] +#ifdef TRACING + br $31, DoPushNNilsIM # [1] + .byte 0x82 + .asciiz "DoPushNNilsIM" +#endif +.align 5 +.align 3 +DoPushNNilsIM: # Entry point for IMMEDIATE mode + ldl $4, PROCESSORSTATE_SCOVLIMIT($14) # Current stack cache limit (words) [1] + lda $1, 128 # [0di] + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1-] + addq $1, $17, $1 # Account for what we're about to push [0di] + s8addq $1, $12, $1 # SCA of desired end of cache [1] + s8addq $4, $2, $2 # SCA of current end of cache [2] + cmple $1, $2, $4 # [1] + beq $4, StackCacheOverflowHandler # We're done if new SCA is within bounds [1] + ldq $21, PROCESSORSTATE_NILADDRESS($14) # [1-] + br $31, PUSHNNILSL2 # [1] +.align 3 +PUSHNNILSL1: + stq $21, 8($12) # Push NIL [1] + addq $12, 8, $12 # [0di] + subq $17, 1, $17 # [1] +PUSHNNILSL2: + bgt $17, PUSHNNILSL1 # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +PUSHNNBADOP: + bis $31, 0, $20 # [1-] + bis $31, 63, $17 # [1] + br $31, ILLEGALOPERAND +.end DoPushNNils +/* End of Halfword operand from stack instruction - DoPushNNils */ +.align 5 +.globl DoPushAddressSpRelative +.ent DoPushAddressSpRelative 0 +/* Halfword operand from stack instruction - DoPushAddressSpRelative */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPushAddressSpRelativeFP + .globl DoPushAddressSpRelativeSP + .globl DoPushAddressSpRelativeLP + .globl DoPushAddressSpRelativeIM +.align 3 +DoPushAddressSpRelative: +#ifdef TRACING + .byte 0x82 + .asciiz "DoPushAddressSpRelativeIM" +#endif +.align 3 +DoPushAddressSpRelativeIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoPushAddressSpRelative # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoPushAddressSpRelativeSP" +#endif +.align 3 +DoPushAddressSpRelativeSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoPushAddressSpRelative # [0di] + .byte 0x90 + .asciiz "DoPushAddressSpRelativeLP" +#endif +.align 3 +DoPushAddressSpRelativeLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoPushAddressSpRelative # [1] + .byte 0x84 + .asciiz "DoPushAddressSpRelativeFP" +#endif +.align 3 +DoPushAddressSpRelativeFP: # Entry point for FP relative +.align 3 +headDoPushAddressSpRelative: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoPushAddressSpRelative: +/* arg1 has the operand, not sign extended if immediate. */ + ldq $4, PROCESSORSTATE_RESTARTSP($14) # SP before any popping [1] + srl $16, 32, $1 # [2di] + extll $16, 0, $16 # [1] + ldq $6, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of the stack cache [0di] + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # THe stack cache data block [1] + and $1, 63, $2 # Strip off any CDR code bits. [0di] + cmpeq $2, TypeFixnum, $3 # [1] +.align 3 +G15111: + beq $3, G15108 # [1] +/* Here if argument TypeFixnum */ + s8addq $16, 8, $16 # [0di] + subq $4, $16, $5 # Compute stack relative pointer [1] + subq $5, $7, $5 # Index into stack data [1] + srl $5, 3, $5 # Convert to word index [1] + addq $6, $5, $5 # Convert to an ivory word address [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeLocative, $6 # [1-] + stl $5, 8($12) # [0di] + stl $6, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +G15108: +/* Here for all other cases */ + bis $31, 0, $20 # [1-] + bis $31, 63, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15107: +.end DoPushAddressSpRelative +/* End of Halfword operand from stack instruction - DoPushAddressSpRelative */ +.align 5 +.globl DoStackBlt +.ent DoStackBlt 0 +/* Halfword operand from stack instruction - DoStackBlt */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoStackBltFP + .globl DoStackBltSP + .globl DoStackBltLP + .globl DoStackBltIM +.align 3 +DoStackBlt: +#ifdef TRACING + .byte 0x82 + .asciiz "DoStackBltIM" +#endif +.align 3 +DoStackBltIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoStackBlt # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoStackBltSP" +#endif +.align 3 +DoStackBltSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoStackBlt # [0di] + .byte 0x90 + .asciiz "DoStackBltLP" +#endif +.align 3 +DoStackBltLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoStackBlt # [1] + .byte 0x84 + .asciiz "DoStackBltFP" +#endif +.align 3 +DoStackBltFP: # Entry point for FP relative +.align 3 +headDoStackBlt: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoStackBlt: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $3, 0($12) # Destination locative [1] + ldl $2, 4($12) # Destination locative [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $3, 0, $3 # [1] + extll $16, 0, $1 # [1] +/* Convert VMA to stack cache address */ + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldq $16, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $4, $4 # stack cache base relative offset [2di] + s8addq $4, $16, $16 # reconstruct SCA [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of the stack cache [1] + ldq $5, PROCESSORSTATE_STACKCACHETOPVMA($14) # End ofthe stack cache [1] + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # THe stack cache data block [1] + subq $3, $4, $6 # BAse of Stack Cache. [1-] + subq $3, $5, $7 # Top of Stack Cache. [1] + blt $6, STKBLTEXC # J. if vma below stack cache [1-] + bge $7, STKBLTEXC # J. if vma above stack cache [1] + s8addq $6, $1, $6 # Compute the stackcache address [1-] + br $31, STKBLTLOOPEND # [0di] +.align 3 +STKBLTLOOP: + addq $16, 8, $16 # Advance Source [1-] + addq $6, 8, $6 # Advance destination [1] +STKBLTLOOPEND: + ldq $1, 0($16) # Read a word from the source [1-] + subq $16, $12, $4 # [0di] + stq $1, 0($6) # copy the word [1-] + bne $4, STKBLTLOOP # J. if sourse not stack top [1] + bis $6, $31, $12 # Update the SP to point at the last written location [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +STKBLTEXC: + bis $31, 0, $20 # [1-] + bis $31, 73, $17 # [1] + br $31, ILLEGALOPERAND +.end DoStackBlt +/* End of Halfword operand from stack instruction - DoStackBlt */ +.align 5 +.globl DoStackBltAddress +.ent DoStackBltAddress 0 +/* Halfword operand from stack instruction - DoStackBltAddress */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoStackBltAddressFP + .globl DoStackBltAddressSP + .globl DoStackBltAddressLP + .globl DoStackBltAddressIM +.align 3 +DoStackBltAddress: +#ifdef TRACING + .byte 0x88 + .asciiz "DoStackBltAddressSP" +#endif +.align 3 +DoStackBltAddressSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoStackBltAddress # [0di] + .byte 0x90 + .asciiz "DoStackBltAddressLP" +#endif +.align 3 +DoStackBltAddressLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoStackBltAddress # [1] + .byte 0x84 + .asciiz "DoStackBltAddressFP" +#endif +.align 3 +DoStackBltAddressFP: # Entry point for FP relative +.align 3 +beginDoStackBltAddress: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $3, 0($12) # Destination locative [0di] + ldl $2, 4($12) # Destination locative [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $3, 0, $3 # [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of the stack cache [0di] + ldq $5, PROCESSORSTATE_STACKCACHETOPVMA($14) # End ofthe stack cache [1] + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # THe stack cache data block [1] + subq $3, $4, $6 # Base of Stack Cache. [1-] + subq $3, $5, $7 # Top of Stack Cache. [1] + blt $6, STKBLTADREXC # J. if vma below stack cache [1-] + bge $7, STKBLTADREXC # J. if vma above stack cache [1] + s8addq $6, $1, $6 # Compute the stackcache address [1-] + br $31, STKBLTADDLOOPEND # [0di] +.align 3 +STKBLTADDLOOP: + addq $16, 8, $16 # Advance Source [1-] + addq $6, 8, $6 # Advance destination [1] +STKBLTADDLOOPEND: + ldq $1, 0($16) # Read a word from the source [1-] + subq $16, $12, $4 # [0di] + stq $1, 0($6) # copy the word [1-] + bne $4, STKBLTADDLOOP # J. if sourse not stack top [1] + bis $6, $31, $12 # Update the SP to point at the last written location [1-] + br $31, NEXTINSTRUCTION # [0di] +.align 3 +STKBLTADREXC: + bis $31, 0, $20 # [1-] + bis $31, 73, $17 # [1] + br $31, ILLEGALOPERAND +#ifdef TRACING + .byte 0x82 + .asciiz "DoStackBltAddressIM" +#endif +DoStackBltAddressIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoStackBltAddress. +.end DoStackBltAddress +/* End of Halfword operand from stack instruction - DoStackBltAddress */ +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunmove.as */ diff --git a/alpha-emulator/ifunpred.as b/alpha-emulator/ifunpred.as new file mode 100644 index 0000000..fa74d78 --- /dev/null +++ b/alpha-emulator/ifunpred.as @@ -0,0 +1,112 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Predicates.") + + +;; |DoEq| and |DoEqNoPop| are in IFUNCOM2.AS + + +;; DoEqNoPop is handled here, too... +(define-instruction |DoEql| :operand-from-stack-immediate (:own-immediate t) + (SRL arg3 #.(+ 10 2) arg6) + ;; These LDA/LDAH pair are really (load-constant t4 #xf800), which + ;; is the magic mask for EQ-NOT-EQL + (stack-top t3 "Load arg1 into t3") + (LDA t4 -2048 (zero) "Low part of EQ-NOT-EQL mask") + (LDQ t11 PROCESSORSTATE_NILADDRESS (ivory)) + (LDAH t4 1 (t4) "High part of EQ-NOT-EQL mask") + (LDQ t12 PROCESSORSTATE_TADDRESS (ivory) "Assume result will be T") + (XOR arg1 t3 t5) + (SLL t5 #.(- 32 6) t5 "Shift left to lose CDRCODE.") + (AND arg6 1 arg6 "1 if no-pop, 0 if pop") + (BEQ t5 eqldone) + (comment "They are not EQ, if types different or not numeric return nil") + (SRL t5 #.(+ 32 (- 32 6)) t5 "Get the tag alone") + (BIS t11 zero t12 "Now assume result will be NIL") + (BNE t5 eqldone "Return NIL if tags different") + (SRL t3 32 t3 "Get tag, check for numeric") + (TagType t3 t3) + (SRL t4 t3 t4 "Type is now a bit mask") + (BLBS t4 eqlexc "If funny numeric type, exception") + (label eqldone) + (S8ADDQ arg6 iSP iSP "Either a stack-push or a stack-write") + (GetNextPCandCP) + (stack-write iSP t12) + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoEql|) + (SLL arg2 #.(- 64 8) arg2) + (stack-read2-disp-signed iSP 0 t4 t3 "t4=tag t3=data") + (SRL arg3 #.(+ 10 2) arg6) + (SRA arg2 #.(- 64 8) arg2 "Sign extension of arg2 is complete") + (EXTLL t3 0 t3) + (LDQ t11 PROCESSORSTATE_NILADDRESS (ivory)) + (TagType t4 t4) + (LDQ t12 PROCESSORSTATE_TADDRESS (ivory)) + (SUBL t3 arg2 arg2) + (XOR t4 |TypeFixnum| t4) + (AND arg6 1 arg6 "1 if no-pop, 0 if pop") + (BIS arg2 t4 t4) + (S8ADDQ arg6 iSP iSP "Either a stack-push or a stack-write") + (GetNextPCandCP) + (CMOVEQ t4 t12 t11) + (stack-write iSP t11 "Yes Virginia, this does dual issue with above") + (ContinueToNextInstruction-NoStall) + (label eqlexc) + (prepare-exception eql 0 arg1) + (arithmetic-exception)) + + +;; |DoEndp| is in IFUNCOM2.AS + + +;; |DoEqualNumber| and |DoEqualNumberNoPop| are in IFUNCOM2.AS + +;; |DoLessp| and |DoLesspNoPop| are in IFUNCOM2.AS + +;; Handles DoGreaterpNoPop as well +(define-instruction |DoGreaterp| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + greaterp SUBQ CMOVGT CMPTLE FBEQ t |GreaterpMMExc|) + (immediate-handler |DoGreaterp|) + (simple-binary-immediate-arithmetic-predicate + greaterp SUBQ CMOVGT t)) + +;; Handles DoLogtestNoPop as well +(define-instruction |DoLogtest| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + logtest AND CMOVNE nil nil) + (immediate-handler |DoLogtest|) + (simple-binary-immediate-arithmetic-predicate + logtest AND CMOVNE t)) + + +;;; Here are exception handlers for predicates. We have moved them out of +;;; line because they are rarely used, and we get better code packing by +;;; taking these cases out of line. Since they either trap, or avoid what +;;; would otherwise have been a trap, the cost of jumping out of line is +;;; negligible, while the benefits of code packing help the normal cases. + +;; --- These should all be a single routine now --- + +;; Exception case for EqualNumber and EqualNumberNoPop +(simple-binary-arithmetic-exceptions equal-number |EqualNumberMMExc| :else1 t) +;; Exception case for Lessp and LesspNoPop +(simple-binary-arithmetic-exceptions lessp |LesspMMExc| :else1 t) +;; Exception case for Greaterp and Greaterp +(simple-binary-arithmetic-exceptions greaterp |GreaterpMMExc| :else1 t) + + +;; |DoZerop| is in IFUNCOM1.AS + +;; |DoMinusp| and |DoPlusp| are in IFUNCOM2.AS + +;; |DoTypeMember| is in IFUNCOM1.AS + + + +(comment "Fin.") + diff --git a/alpha-emulator/ifunpred.s b/alpha-emulator/ifunpred.s new file mode 100644 index 0000000..fda1c94 --- /dev/null +++ b/alpha-emulator/ifunpred.s @@ -0,0 +1,579 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunpred.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Predicates. */ +.align 5 +.globl DoEql +.ent DoEql 0 +/* Halfword operand from stack instruction - DoEql */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoEqlFP + .globl DoEqlSP + .globl DoEqlLP + .globl DoEqlIM +.align 3 +DoEql: +#ifdef TRACING + .byte 0x88 + .asciiz "DoEqlSP" +#endif +.align 3 +DoEqlSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoEql # [0di] + .byte 0x90 + .asciiz "DoEqlLP" +#endif +.align 3 +DoEqlLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoEql # [1] + .byte 0x84 + .asciiz "DoEqlFP" +#endif +.align 3 +DoEqlFP: # Entry point for FP relative +.align 3 +headDoEql: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoEql: +/* arg1 has the operand, not sign extended if immediate. */ + srl $18, 12, $21 # [1-] + ldq $3, 0($12) # Load arg1 into t3 [0di] + lda $4, -2048 # Low part of EQ-NOT-EQL mask [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + ldah $4, 1($4) # High part of EQ-NOT-EQL mask [1-] + ldq $25, PROCESSORSTATE_TADDRESS($14) # Assume result will be T [0di] + xor $16, $3, $5 # [1-] + sll $5, 26, $5 # Shift left to lose CDRCODE. [1] + and $21, 1, $21 # 1 if no-pop, 0 if pop [1] + beq $5, EQLDONE # [1di] +/* They are not EQ, if types different or not numeric return nil */ + srl $5, 58, $5 # Get the tag alone [1] + bis $24, $31, $25 # Now assume result will be NIL [1] + bne $5, EQLDONE # Return NIL if tags different [1-] + srl $3, 32, $3 # Get tag, check for numeric [0di] +/* TagType. */ + and $3, 63, $3 # [2] + srl $4, $3, $4 # Type is now a bit mask [1] + blbs $4, EQLEXC # If funny numeric type, exception [2] +.align 3 +EQLDONE: + s8addq $21, $12, $12 # Either a stack-push or a stack-write [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stq $25, 0($12) # [1] + br $31, CACHEVALID # [1] +#ifdef TRACING + br $31, DoEqlIM # [1] + .byte 0x82 + .asciiz "DoEqlIM" +#endif +.align 5 +.align 3 +DoEqlIM: # Entry point for IMMEDIATE mode + sll $17, 56, $17 # [1-] + ldl $4, 4($12) # t4=tag t3=data [0di] + ldl $3, 0($12) # [1] + srl $18, 12, $21 # [0di] + sra $17, 56, $17 # Sign extension of arg2 is complete [1] + extll $3, 0, $3 # [2] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1-] +/* TagType. */ + and $4, 63, $4 # [0di] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1-] + subl $3, $17, $17 # [0di] + xor $4, TypeFixnum, $4 # [1] + and $21, 1, $21 # 1 if no-pop, 0 if pop [1] + bis $17, $4, $4 # [1] + s8addq $21, $12, $12 # Either a stack-push or a stack-write [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + cmoveq $4, $25, $24 # [1-] + stq $24, 0($12) # Yes Virginia, this does dual issue with above [0di] + br $31, CACHEVALID # [1] +.align 3 +EQLEXC: + bis $31, 0, $18 # arg3 = stackp [1-] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.end DoEql +/* End of Halfword operand from stack instruction - DoEql */ +.align 5 +.globl DoGreaterp +.ent DoGreaterp 0 +/* Halfword operand from stack instruction - DoGreaterp */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoGreaterpFP + .globl DoGreaterpSP + .globl DoGreaterpLP + .globl DoGreaterpIM +.align 3 +DoGreaterp: +#ifdef TRACING + .byte 0x88 + .asciiz "DoGreaterpSP" +#endif +.align 3 +DoGreaterpSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + bne $17, beginDoGreaterp # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoGreaterp # [0di] + .byte 0x90 + .asciiz "DoGreaterpLP" +#endif +.align 3 +DoGreaterpLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoGreaterp # [1] + .byte 0x84 + .asciiz "DoGreaterpFP" +#endif +.align 3 +DoGreaterpFP: # Entry point for FP relative +.align 3 +beginDoGreaterp: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + srl $18, 12, $7 # [1-] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [0di] + extll $21, 4, $18 # Get ARG1 tag [1-] + ldl $1, 4($16) # t1 is tag of arg2 [0di] + lds $f1, 0($12) # [1] + and $7, 1, $7 # [0di] + ldl $17, 0($16) # [1-] + addl $21, $31, $19 # [0di] + lds $f2, 0($16) # [1-] + and $18, 63, $5 # Strip off any CDR code bits. [0di] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $5, TypeFixnum, $6 # [1] +.align 3 +G15129: + beq $6, G15117 # [1] +/* Here if argument TypeFixnum */ + cmpeq $4, TypeFixnum, $3 # [0di] +.align 3 +G15121: + beq $3, G15112 # [1] +/* Here if argument TypeFixnum */ + subq $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # Pop/No-pop [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovgt $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G15118: +.align 3 +G15117: + cmpeq $5, TypeSingleFloat, $6 # [1-] +.align 3 +G15130: + beq $6, G15122 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $4, TypeSingleFloat, $3 # [0di] +.align 3 +G15126: + beq $3, G15112 # [1] +/* Here if argument TypeSingleFloat */ +.align 3 +GreaterpMMExcFLTFLT: + cmptle $f1, $f2, $f3 # [1] + trapb # Force the trap to occur here [4] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + s8addq $7, $12, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + stq $25, 0($12) # [1] + fbeq $f3, CACHEVALID # [3-] + stq $24, 0($12) # Didn't branch, answer is NIL [0di] + br $31, CACHEVALID # [1] +.align 3 +G15123: +.align 3 +G15122: +/* Here for all other cases */ +.align 3 +G15112: + br $31, GreaterpMMExc # [1] +.align 3 +G15116: +#ifdef TRACING + br $31, DoGreaterpIM # [1] + .byte 0x82 + .asciiz "DoGreaterpIM" +#endif +.align 5 +.align 3 +DoGreaterpIM: # Entry point for IMMEDIATE mode + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1] + sll $17, 56, $17 # First half of sign extension [0di] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1-] + srl $18, 12, $7 # [0di] + extll $21, 4, $18 # [1] + addl $21, $31, $19 # [1] + sra $17, 56, $17 # Second half of sign extension [1] + and $7, 1, $7 # [1] + and $18, 63, $3 # Strip off any CDR code bits. [1] + cmpeq $3, TypeFixnum, $4 # [1] +.align 3 +G15135: + beq $4, G15132 # [1] +/* Here if argument TypeFixnum */ + subq $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovgt $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G15132: +/* Here for all other cases */ + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15131: +.end DoGreaterp +/* End of Halfword operand from stack instruction - DoGreaterp */ +.align 5 +.globl DoLogtest +.ent DoLogtest 0 +/* Halfword operand from stack instruction - DoLogtest */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoLogtestFP + .globl DoLogtestSP + .globl DoLogtestLP + .globl DoLogtestIM +.align 3 +DoLogtest: +#ifdef TRACING + .byte 0x88 + .asciiz "DoLogtestSP" +#endif +.align 3 +DoLogtestSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + bne $17, beginDoLogtest # [0di] + ldq $21, 0($19) # SP-pop, Reload TOS [1-] + bis $12, $31, $16 # SP-pop mode [0di] + bis $19, $31, $12 # Adjust SP [1] +#ifdef TRACING + br $31, beginDoLogtest # [0di] + .byte 0x90 + .asciiz "DoLogtestLP" +#endif +.align 3 +DoLogtestLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoLogtest # [1] + .byte 0x84 + .asciiz "DoLogtestFP" +#endif +.align 3 +DoLogtestFP: # Entry point for FP relative +.align 3 +beginDoLogtest: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [0di] + srl $18, 12, $7 # [1-] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [0di] + extll $21, 4, $18 # Get ARG1 tag [1-] + ldl $17, 0($16) # [0di] + lds $f1, 0($12) # [1] + and $7, 1, $7 # [0di] + ldl $1, 4($16) # t1 is tag of arg2 [1-] + extll $21, 0, $19 # [0di] + extll $17, 0, $17 # [1] + lds $f2, 0($16) # [0di] + and $18, 63, $5 # Strip off any CDR code bits. [1-] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $5, TypeFixnum, $6 # [1] +.align 3 +G15148: + beq $6, G15141 # [1] +/* Here if argument TypeFixnum */ + cmpeq $4, TypeFixnum, $3 # [0di] +.align 3 +G15145: + beq $3, G15138 # [1] +/* Here if argument TypeFixnum */ + and $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # Pop/No-pop [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovne $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G15142: +.align 3 +G15141: +/* Here for all other cases */ +.align 3 +G15137: + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G15139 # [1-] +.align 3 +G15138: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15139: +.align 3 +G15140: +#ifdef TRACING + br $31, DoLogtestIM # [1-] + .byte 0x82 + .asciiz "DoLogtestIM" +#endif +.align 5 +.align 3 +DoLogtestIM: # Entry point for IMMEDIATE mode + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1] + sll $17, 56, $17 # First half of sign extension [0di] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1-] + srl $18, 12, $7 # [0di] + extll $21, 4, $18 # [1] + addl $21, $31, $19 # [1] + sra $17, 56, $17 # Second half of sign extension [1] + and $7, 1, $7 # [1] + and $18, 63, $3 # Strip off any CDR code bits. [1] + cmpeq $3, TypeFixnum, $4 # [1] +.align 3 +G15153: + beq $4, G15150 # [1] +/* Here if argument TypeFixnum */ + and $19, $17, $2 # [0di] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + s8addq $7, $12, $12 # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1-] + cmovne $2, $25, $24 # T if the test succeeds [0di] + stq $24, 0($12) # [1-] + br $31, CACHEVALID # [1] +.align 3 +G15150: +/* Here for all other cases */ + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15149: +.end DoLogtest +/* End of Halfword operand from stack instruction - DoLogtest */ +.align 5 +.globl EqualNumberMMExc +.ent EqualNumberMMExc 0 +.align 3 +EqualNumberMMExc: + and $18, 63, $5 # Strip off any CDR code bits. [1] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $5, TypeFixnum, $6 # [1] +.align 3 +G15171: + beq $6, G15159 # [1] +/* Here if argument TypeFixnum */ + cmpeq $4, TypeSingleFloat, $3 # [0di] +.align 3 +G15163: + beq $3, G15156 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqs $f1, $f1 # [6] + br $31, EqualNumberMMExcFLTFLT # [1] +.align 3 +G15160: +.align 3 +G15159: + cmpeq $5, TypeSingleFloat, $6 # [1-] +.align 3 +G15172: + beq $6, G15164 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $4, TypeFixnum, $3 # [0di] +.align 3 +G15168: + beq $3, G15156 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqs $f2, $f2 # [6] + br $31, EqualNumberMMExcFLTFLT # [1] +.align 3 +G15165: +.align 3 +G15164: +/* Here for all other cases */ +.align 3 +G15155: + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G15157 # [1-] +.align 3 +G15156: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15157: +.align 3 +G15158: +.end EqualNumberMMExc +.align 5 +.globl LesspMMExc +.ent LesspMMExc 0 +.align 3 +LesspMMExc: + and $18, 63, $5 # Strip off any CDR code bits. [1] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $5, TypeFixnum, $6 # [1] +.align 3 +G15190: + beq $6, G15178 # [1] +/* Here if argument TypeFixnum */ + cmpeq $4, TypeSingleFloat, $3 # [0di] +.align 3 +G15182: + beq $3, G15175 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqs $f1, $f1 # [6] + br $31, LesspMMExcFLTFLT # [1] +.align 3 +G15179: +.align 3 +G15178: + cmpeq $5, TypeSingleFloat, $6 # [1-] +.align 3 +G15191: + beq $6, G15183 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $4, TypeFixnum, $3 # [0di] +.align 3 +G15187: + beq $3, G15175 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqs $f2, $f2 # [6] + br $31, LesspMMExcFLTFLT # [1] +.align 3 +G15184: +.align 3 +G15183: +/* Here for all other cases */ +.align 3 +G15174: + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G15176 # [1-] +.align 3 +G15175: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15176: +.align 3 +G15177: +.end LesspMMExc +.align 5 +.globl GreaterpMMExc +.ent GreaterpMMExc 0 +.align 3 +GreaterpMMExc: + and $18, 63, $5 # Strip off any CDR code bits. [1] + and $1, 63, $4 # Strip off any CDR code bits. [1] + cmpeq $5, TypeFixnum, $6 # [1] +.align 3 +G15209: + beq $6, G15197 # [1] +/* Here if argument TypeFixnum */ + cmpeq $4, TypeSingleFloat, $3 # [0di] +.align 3 +G15201: + beq $3, G15194 # [1] +/* Here if argument TypeSingleFloat */ + cvtlq $f1, $f1 # [1] + cvtqs $f1, $f1 # [6] + br $31, GreaterpMMExcFLTFLT # [1] +.align 3 +G15198: +.align 3 +G15197: + cmpeq $5, TypeSingleFloat, $6 # [1-] +.align 3 +G15210: + beq $6, G15202 # [1] +/* Here if argument TypeSingleFloat */ + cmpeq $4, TypeFixnum, $3 # [0di] +.align 3 +G15206: + beq $3, G15194 # [1] +/* Here if argument TypeFixnum */ + cvtlq $f2, $f2 # [1] + cvtqs $f2, $f2 # [6] + br $31, GreaterpMMExcFLTFLT # [1] +.align 3 +G15203: +.align 3 +G15202: +/* Here for all other cases */ +.align 3 +G15193: + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION + br $31, G15195 # [1-] +.align 3 +G15194: + bis $31, $1, $21 # arg6 = tag to dispatch on [1-] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 1, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +G15195: +.align 3 +G15196: +.end GreaterpMMExc +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunpred.as */ diff --git a/alpha-emulator/ifunsubp.as b/alpha-emulator/ifunsubp.as new file mode 100644 index 0000000..e3c6738 --- /dev/null +++ b/alpha-emulator/ifunsubp.as @@ -0,0 +1,825 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Subprimitives.") + +(define-instruction |DoEphemeralp| :operand-from-stack-signed-immediate () + (LDQ t1 PROCESSORSTATE_PTRTYPE (ivory) "ptr type array") + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (TagType arg2 arg2) + (S4ADDQ arg2 t1 t2) + (SRL arg1 27 arg1) + (LDL t3 0 (t2) "=0 if not a pointer") + (GetNextPCandCP) + (BNE arg1 nonephem "J. if zone not ephemeral") + (BEQ t3 nonephem "J. if not a pointer") + (stack-push-t t6 t7) + (ContinueToNextInstruction-NoStall) + (label nonephem) + (stack-push-nil t6 t7) + (ContinueToNextInstruction-NoStall)) + +(align4kskip4k) + +;; Handles DoUnsignedLesspNoPop as well... +(define-instruction |DoUnsignedLessp| :operand-from-stack-immediate (:own-immediate t) + (LDL t2 0 (iSP) "Get data from arg1") + (SRL arg3 #.(+ 10 2) arg3) + (LDQ t11 PROCESSORSTATE_NILADDRESS (ivory)) + (EXTLL arg1 0 t4 "Get unsigned data from arg2") + (LDQ t12 PROCESSORSTATE_TADDRESS (ivory)) + (AND arg3 1 arg3 "1 if no-pop, 0 if pop") + (EXTLL t2 0 t2 "Unsigned arg1") + (S8ADDQ arg3 iSP iSP "Either a stack-push or a stack-write") + (SUBQ t4 t2 t6 "t6:=arg2-arg1 unsigned") + (CMOVGT t6 t12 t11) + (GetNextPCandCP) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoUnsignedLessp|) + (LDL t2 0 (iSP) "Get data from arg1") + (SRL arg3 #.(+ 10 2) arg3) + (LDQ t11 PROCESSORSTATE_NILADDRESS (ivory)) + (EXTLL t2 0 t2 "...") + (LDQ t12 PROCESSORSTATE_TADDRESS (ivory)) + (AND arg3 1 arg3 "1 if no-pop, 0 if pop") + (SUBQ arg2 t2 t6 "t6:=arg2-arg1 unsigned") + (S8ADDQ arg3 iSP iSP "Either a stack-push or a stack-write") + (CMOVGT t6 t12 t11) + (GetNextPCandCP) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + + +(define-instruction |DoAllocateListBlock| :operand-from-stack-immediate () + (i%allocate-block t)) + +(define-instruction |DoAllocateStructureBlock| :operand-from-stack-immediate () + (i%allocate-block nil)) + + +;; |DoPointerPlus| is in IFUNCOM1.AS + +(define-instruction |DoPointerDifference| :operand-from-stack-immediate (:own-immediate t) + (LDL t1 0 (iSP) "Get the data of ARG1") + (EXTLL arg1 0 t2 "Get the data of ARG2") + ;(EXTLL t1 0 t1) + (SUBL t1 t2 t3 "(%32-bit-difference (data arg1) (data arg2))") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4 "Save result and coerce to a FIXNUM") + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoPointerDifference|) + (SLL arg2 #.(- 64 8) t2) + (LDL t1 0 (iSP) "Get the data of arg1") + (SRA t2 #.(- 64 8) t2) + ;(EXTLL t1 0 t1) + (SUBL t1 t2 t3 "(%32-bit-difference (data arg1) (data arg2))") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4 "Save result and coerce to a FIXNUM") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoPointerIncrement| :operand-from-stack () + (LDL t2 0 (arg1) "Get the data of arg2") + (ADDL t2 1 t3 "(%32-bit-plus (data arg1) 1)") + (GetNextPCandCP) + (STL t3 0 (arg1) "Put result back") + (ContinueToNextInstruction-NoStall)) + + +;; |DoMemoryRead| and |DoMemoryReadAddress| are in IFUNCOM1.AS + + +;; |DoTag| is in IFUNCOM2.AS + +;; |DoSetTag| is in IFUNCOM1.AS + + +(define-instruction |DoStoreConditional| :operand-from-stack-signed-immediate () + (SRL arg1 32 arg2) + (stack-pop2 arg3 arg4 "old tag and data") + (EXTLL arg1 0 arg1) + (stack-pop2 arg5 arg6 "address tag and data") + (TagType arg5 t1) + (CheckDataType t1 |TypeLocative| storecondiop t2) + (store-conditional-internal arg6 arg3 arg4 arg2 arg1 storecondnil t1 t2 t3 t4 t5 t6) + (GetNextPCandCP) + (stack-push-t t6 t7) + (ContinueToNextInstruction-NoStall) + (label storecondnil) + (GetNextPCandCP) + (stack-push-nil t6 t7) + (ContinueToNextInstruction-NoStall) + (label storecondiop) + (illegal-operand (operand-1-type-error (dtp-locative)))) + +(define-instruction |DoMemoryWrite| :operand-from-stack-signed-immediate () + (stack-pop2 arg3 arg4) ;+++ actually only need the vma + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + ;; Perform a RAW write + (memory-write arg4 arg2 arg1 PROCESSORSTATE_RAW t1 t2 t3 t4 t5 + NextInstruction) + (ContinueToNextInstruction)) + +(define-instruction |DoPStoreContents| :operand-from-stack-signed-immediate () + (stack-pop2 arg3 arg4 "address tag and data") + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (store-contents arg4 arg2 arg1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8 t9 + NextInstruction) + (ContinueToNextInstruction)) + + +(define-instruction |DoSetCdrCode1| :operand-from-stack () + (i%set-cdr-code-n arg1 1 t1)) + +(define-instruction |DoSetCdrCode2| :operand-from-stack () + (i%set-cdr-code-n arg1 2 t1)) + +;; |DoMergeCdrNoPop| is in IFUNCOM2.AS + +(define-instruction |DoJump| :operand-from-stack () + (stack-read2 arg1 t3 t4 "Read address and even/odd PC tag.") + (CheckAdjacentDataTypes t3 |TypeEvenPC| 2 jexc t5) + (SLL t4 1 t4) + (AND t3 1 iPC) + (ADDQ iPC t4 iPC) + (AND t3 #x80 t5) + (BEQ t5 InterpretInstructionForJump) + (comment "Bit 39=1 indicates we need to update control reg") + (AND t3 #x40 t6 "Get the cleanup bit") + (LDQ t5 PROCESSORSTATE_CONTROL (ivory) "Processor control register.") + (SLL t6 #.(- 23 6) t6 "shift into cleanup-in-progress place") + (load-constant t7 #.1_23 "cr.cleanup-in-progress") + (BIC t5 t7 t5 "Mask") + (BIS t5 t6 t5 "Set") + (STQ t5 PROCESSORSTATE_CONTROL (ivory)) + (BR zero InterpretInstructionForJump) + (label jexc) + (prepare-exception %jump 0) + (instruction-exception)) + +;;+++ Do we need to check for trap? +(define-instruction |DoCheckPreemptRequest| :10-bit-immediate () + (check-preempt-request NextInstruction t1 t2) + (ContinueToNextInstruction)) + + +(define-instruction |DoHalt| :10-bit-immediate () + (get-control-register t1) + (SRL t1 30 t1 "Isolate current trap mode (FEP mode = -1)") + (ADDL t1 1 t1 "t1 is zero iff we're in trap mode FEP") + (BNE t1 haltexc) + (halt-machine) + (label haltexc) + (prepare-exception %halt 0) + (instruction-exception)) + + +(define-instruction |DoNoOp| :10-bit-immediate () + (ContinueToNextInstruction)) + + +;;; This implementation is based on the PTW 'C' implementation. +(define-instruction |DoAlu| :operand-from-stack-signed-immediate () + (SRL arg1 32 arg2 "Get tag of ARG2") + (EXTLL arg1 0 arg1 "Get data of ARG2") + (stack-read2 iSP arg3 arg4 "Get ARG1") + (CheckDataType arg2 |TypeFixnum| aluexc t1) + (CheckDataType arg3 |TypeFixnum| aluexc t1) + (LDQ arg5 PROCESSORSTATE_ALUOP (ivory)) + (STQ zero PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LDQ arg6 PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (basic-dispatch arg5 t1 + (|ALUFunctionBoolean| + (alu-function-boolean arg6 t10 arg4 arg1 t1) + (STL t10 0 (iSP)) + (ContinueToNextInstruction)) + (|ALUFunctionByte| + (alu-function-byte arg6 arg4 arg1 t10 t1 t2 t3 t4 t5) + (STL t10 0 (iSP)) + (ContinueToNextInstruction)) + (|ALUFunctionAdder| + (alu-function-adder arg6 arg4 arg1 t10 t1 t2 t3 t4) + (STL t10 0 (iSP)) + (ContinueToNextInstruction)) + (|ALUFunctionMultiplyDivide| + (alu-function-multiply-divide arg6 arg4 arg1 t10 t1 t2) + (STL t10 0 (iSP)) + (ContinueToNextInstruction))) + (label aluexc) + (illegal-operand two-operand-fixnum-type-error)) + +;;; This says unimplemented, but that is the correct implementation of it! +(define-instruction |DoSpareOp| :10-bit-immediate () + (LDQ t1 CACHELINE_INSTRUCTION (iCP) "Get the instruction") + (SRL t1 10 t1 "Position the opcode") + (AND t1 #xFF t1 "Extract it") + ;; PREPARE-EXCEPTION can't be used as the opcode is variable, + ;; so we expand it by hand. + (BIS zero 0 arg1 "arg1 = instruction arity") + (BIS zero t1 arg2 "arg2 = instruction opcode") + (BIS zero 1 arg3 "arg3 = stackp") + (BIS zero 0 arg4 "arg4 = arithmeticp") + (BIS zero 0 arg5 "when not stackp arg5=the arg") + (BIS zero 0 arg6 "arg6=tag to dispatch on") + (instruction-exception "Unimplemented") + (ContinueToNextInstruction)) + + + +(comment "Reading and writing internal registers") + +;; |DoReadInternalRegister| is in IFUNCOM1.AS + +(define-procedure |ReadRegisterFP| () + (SCAtoVMA iFP t4 t5) + (stack-push-ir |TypeLocative| t4 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterLP| () + (SCAtoVMA iLP t4 t5) + (stack-push-ir |TypeLocative| t4 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterSP| () + (SCAtoVMA iSP t4 t5) + (stack-push-ir |TypeLocative| t4 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackCacheLowerBound| () + (LDQ t3 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (stack-push-ir |TypeLocative| t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterBARx| () + (SRL arg1 7 t2 "BAR number into T2") + (GetNextPC) + (LDA t1 PROCESSORSTATE_BAR0 (ivory)) + (GetNextCP) + (S8ADDQ t2 t1 t1 "Now T1 points to the BAR") + (LDQ t3 0 (t1)) + (stack-push-ir |TypeLocative| t3 t4) + (ContinueToNextInstruction-NoStall)) + +(define-procedure |ReadRegisterContinuation| () + (LDQ t3 PROCESSORSTATE_CONTINUATION (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterAluAndRotateControl| () + (LDQ t3 PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterControlRegister| () + (get-control-register t3) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterCRArgumentSize| () + (get-control-register t3) + (AND t3 #xFF t3 "Get the argument size field") + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterEphemeralOldspaceRegister| () + (LDL t3 PROCESSORSTATE_EPHEMERALOLDSPACE (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterZoneOldspaceRegister| () + (LDL t3 PROCESSORSTATE_ZONEOLDSPACE (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterChipRevision| () + (BIS zero 5 t3) ;+++ magic number + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterFPCoprocessorPresent| () + (stack-push-fixnum zero t4) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPreemptRegister| () + (LDL t3 PROCESSORSTATE_INTERRUPTREG (ivory)) + (AND t3 3 t3) ;+++ 3 is a bit magic! + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterIcacheControl| () + (stack-push-fixnum zero t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPrefetcherControl| () + (stack-push-fixnum zero t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterMapCacheControl| () + (stack-push-fixnum zero t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterMemoryControl| () + (stack-push-fixnum zero t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackCacheOverflowLimit| () + (LDL t3 PROCESSORSTATE_SCOVLIMIT (ivory)) + (LDQ t4 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (ADDQ t3 t4 t3) + (stack-push-ir |TypeLocative| t3 t4) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterMicrosecondClock| () + (stack-push-ir |TypeFixnum| zero t1) + (ContinueToNextInstruction)) ;+++ an approximation for now! + +(define-procedure |ReadRegisterTOS| () + (stack-top t1) + (stack-push t1 t2 "Push CDR-NEXT TOS") + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterEventCount| () + (LDQ t3 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (stack-push-fixnum t3 t4) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterBindingStackPointer| () + (LDQ t3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterCatchBlockList| () + (LDQ t3 PROCESSORSTATE_CATCHBLOCK (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterControlStackLimit| () + (LDL t3 PROCESSORSTATE_CSLIMIT (ivory)) + (stack-push-ir |TypeLocative| t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterControlStackExtraLimit| () + (LDL t3 PROCESSORSTATE_CSEXTRALIMIT (ivory)) + (stack-push-ir |TypeLocative| t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterBindingStackLimit| () + (LDQ t3 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPHTBase| () + (stack-push-ir |TypeLocative| zero t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPHTMask| () + (stack-push-fixnum zero t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterCountMapReloads| () + (stack-push-fixnum zero t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterListCacheArea| () + (LDQ t3 PROCESSORSTATE_LCAREA (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterListCacheAddress| () + (LDQ t3 PROCESSORSTATE_LCADDRESS (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterListCacheLength| () + (LDL t3 PROCESSORSTATE_LCLENGTH (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureCacheArea| () + (LDQ t3 PROCESSORSTATE_SCAREA (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureCacheAddress| () + (LDQ t3 PROCESSORSTATE_SCADDRESS (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureCacheLength| () + (LDL t3 PROCESSORSTATE_SCLENGTH (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterDynamicBindingCacheBase| () + (LDQ t3 PROCESSORSTATE_DBCBASE (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterDynamicBindingCacheMask| () + (LDQ t3 PROCESSORSTATE_DBCMASK (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterChoicePointer| () + (LDL t3 PROCESSORSTATE_CHOICEPTR (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureStackChoicePointer| () + (LDL t3 PROCESSORSTATE_SSTKCHOICEPTR (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterFEPModeTrapVectorAddress| () + (LDQ t3 PROCESSORSTATE_FEPMODETRAPVECADDRESS (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackFrameMaximumSize| () + (load-constant t3 #.|stack$K-maxframesize|) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackCacheDumpQuantum| () + (load-constant t3 #.|stack$K-cachedumpquantum|) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterConstantNIL| () + (stack-push-T t5 t6) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterConstantT| () + (stack-push-NIL t5 t6) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterError| () + (illegal-operand unknown-internal-register)) + + +;; |DoWriteInternalRegister| is in IFUNCOM1.AS + +(define-procedure |WriteRegisterFP| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (VMAtoSCAmaybe arg3 t1 badregister t2 t3) + (BIS t1 zero iFP) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +(define-procedure |WriteRegisterLP| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (VMAtoSCAmaybe arg3 t1 badregister t2 t3) + (BIS t1 zero iLP) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +(define-procedure |WriteRegisterSP| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (VMAtoSCAmaybe arg3 t1 badregister t2 t3) + (BIS t1 zero iSP) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +(define-procedure |WriteRegisterStackCacheLowerBound| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (STQ arg3 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (LDQ t1 PROCESSORSTATE_STACKCACHESIZE (ivory)) + (ADDQ arg3 t1 t1) + (STQ t1 PROCESSORSTATE_STACKCACHETOPVMA (ivory)) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +;; |WriteRegisterBARx| is in IFUNCOM1.AS + +(define-procedure |WriteRegisterContinuation| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_CONTINUATION (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterAluAndRotateControl| () + (read-alu-function-class-bits arg3 t1) + (STQ arg3 PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (read-alu-byte-size arg3 t2) + (STQ t1 PROCESSORSTATE_ALUOP (ivory)) + (read-alu-byte-rotate arg3 t3) + (STQ t2 PROCESSORSTATE_BYTESIZE (ivory)) + (STQ t3 PROCESSORSTATE_BYTEROTATE (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterControlRegister| () + (STL arg3 PROCESSORSTATE_CONTROL (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterEphemeralOldspaceRegister| () + ;; Invalidate all automatic array registers upon flip. + (STQ zero PROCESSORSTATE_AC0ARRAY (ivory)) + (STQ zero PROCESSORSTATE_AC1ARRAY (ivory)) + (STQ zero PROCESSORSTATE_AC2ARRAY (ivory)) + (STQ zero PROCESSORSTATE_AC3ARRAY (ivory)) + (STQ zero PROCESSORSTATE_AC4ARRAY (ivory)) + (STQ zero PROCESSORSTATE_AC5ARRAY (ivory)) + (STQ zero PROCESSORSTATE_AC6ARRAY (ivory)) + (STQ zero PROCESSORSTATE_AC7ARRAY (ivory)) + (STL arg3 PROCESSORSTATE_EPHEMERALOLDSPACE (ivory)) + #+obsolete (refill-oldspace-table) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterZoneOldspaceRegister| () + (STL arg3 PROCESSORSTATE_ZONEOLDSPACE (ivory)) + ;;+++ Minima writes both registers simultaneously -- This is written first. + #+ignore (refill-oldspace-table) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterFPCoprocessorPresent| () ;+++ + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterPreemptRegister| () + (LDL t3 PROCESSORSTATE_INTERRUPTREG (ivory)) + (BIC t3 3 t3) + (AND arg3 3 arg3) + (BIS t3 arg3 t3) + (STL t3 PROCESSORSTATE_INTERRUPTREG (ivory)) + ;; Only set flag if preempt-pending is set + (BLBC t3 NextInstruction) + (STQ t3 PROCESSORSTATE_STOP_INTERPRETER (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStackCacheOverflowLimit| () + (LDQ t1 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (EXTLL t1 0 t1) + (SUBQ arg3 t1 t1) + (STL t1 PROCESSORSTATE_SCOVLIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterTOS| () + ;;+++ What's the right thing to do here? + #+ignore (stack-write2 iSP arg2 arg3) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterEventCount| () + (STQ arg3 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterBindingStackPointer| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterCatchBlockList| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_CATCHBLOCK (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterControlStackLimit| () + (STL arg3 PROCESSORSTATE_CSLIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterControlStackExtraLimit| () + (STL arg3 PROCESSORSTATE_CSEXTRALIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterBindingStackLimit| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterListCacheArea| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_LCAREA (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterListCacheAddress| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_LCADDRESS (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterListCacheLength| () + (STL arg3 PROCESSORSTATE_LCLENGTH (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureCacheArea| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_SCAREA (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureCacheAddress| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_SCADDRESS (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureCacheLength| () + (STL arg3 PROCESSORSTATE_SCLENGTH (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterDynamicBindingCacheBase| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_DBCBASE (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterDynamicBindingCacheMask| () + (combine-tag-data-word arg2 arg3 arg4) + (STQ arg4 PROCESSORSTATE_DBCMASK (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterChoicePointer| () + (STL arg3 PROCESSORSTATE_CHOICEPTR (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureStackChoicePointer| () + (STL arg3 PROCESSORSTATE_SSTKCHOICEPTR (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterFEPModeTrapVectorAddress| () + (STL arg3 PROCESSORSTATE_FEPMODETRAPVECADDRESS (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterMappingTableCache| () + ;;+++ Ignore for now, but this would sure be nice + #+ignore (STQ arg3 PROCESSORSTATE_MAPPINGTABLECACHE (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterError| () + (illegal-operand unknown-internal-register)) + + +(comment "Coprocessor read and write are implemented in C in order to") +(comment "encourage creativity! The hooks are in aicoproc.c") + +(define-instruction |DoCoprocessorRead| :10-bit-immediate () + ;; +++ This code, which attempts to use RPCC to implement our microsecond + ;; +++ clock, has a serious bug which causes it to malfunction on faster + ;; +++ AXPs (e.g., the 600 and 800). Symptoms of the malfunction include + ;; +++ negative CPU times as measured by the Gabriel benchmarks, a breakdown + ;; +++ of the universal time mechanism resulting in a hung wholine, and + ;; +++ massive scheduler problems (e.g., sleeping indefinitely). + ;; (LDA t1 |CoprocessorRegisterMicrosecondClock| (zero)) + ;; (SUBL arg1 t1 t2 "Zero if Microsecond Clock") + ;; (BNE t2 cpreadnormal "J. if not read coprocessor clock") + ;; + ;; (LDQ t5 PROCESSORSTATE_PREVIOUSRCPP (ivory)) + ;; (RPCC t3 "Get the current cycle counter") + ;; (SLL t3 32 t6) + ;; (SLL t5 32 t7) + ;; (STQ t3 PROCESSORSTATE_PREVIOUSRCPP (ivory)) + ;; (BEQ t5 cpreadnormalresetclock "J. if decache request (rpcc set to zero)") + ;; (ADDQ t3 t6 t6 "Construct cycle count from two halves") + ;; (LDQ t10 PROCESSORSTATE_MSCMULTIPLIER (ivory) "Get the cycle to internal units multiplier") + ;; (SRL t6 32 t6 "Current number of ticks") + ;; (LDQ t9 PROCESSORSTATE_MSCLOCKCACHE (ivory)) + ;; (ADDQ t5 t7 t7 "Construct cycle count from two halves") + ;; (SRL t7 32 t7 "Previous number of ticks") + ;; (SUBQ t6 t7 t8 "Number of clocks passed since previous") + ;; (BLT t8 cpreadnormalresetclock "J. if counter wrapped.") + ;; (MULQ t8 t10 t11 "Number of internal units since last clock read") + ;; (ADDQ t11 t9 t9 "New time") + ;; (STQ t9 PROCESSORSTATE_MSCLOCKCACHE (ivory)) + ;; (SRL t9 |MSclockUnitsToMSShift| t12 "Convert internal units to microseconds.") + ;; (stack-push-fixnum t12 t1 "Push the microsecond clock") + ;; (ContinueToNextInstruction) + ;; (label cpreadnormalresetclock) + ;; ;(NOP) ;just for debugging, remove later+++ + ;; + ;; (label cpreadnormal) + (LDQ R0 PROCESSORSTATE_COPROCESSORREADHOOK (ivory)) + (with-c-registers (t8) + (BIS R0 zero pv) + (JSR RA R0 0)) + (comment "Long -1 is never a valid LISP value") + (load-constant t1 -1) + (CMPEQ R0 t1 t1) + (branch-true t1 cpreadexc "J. if CoprocessorRead exception return") + (stack-push R0 t1 "Push the result of coprocessor read!") + (ContinueToNextInstruction) + (label cpreadexc) + (illegal-operand unknown-internal-register)) + +(define-instruction |DoCoprocessorWrite| :10-bit-immediate () + (stack-pop arg2 "The value to be written") + (register-dispatch arg1 t1 t2 + (|CoprocessorRegisterUnwindStackForRestartOrApply| + (stack-top2 t2 t1 "peek at new continuation to look at tag") + (CheckAdjacentDataTypes t2 |TypeEvenPC| 2 unwindillegalcontinuation t3) + (stack-pop t1 "Get new continuation") + (set-continuation t1 "Update continuation register") + (STQ zero PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (stack-pop2 t2 t1 "Get new FP") + (CheckDataType t2 |TypeLocative| unwindillegalFP t3) + (VMAtoSCA t1 iFP t2) + (stack-pop2 t2 t1 "Get new LP") + (CheckDataType t2 |TypeLocative| unwindillegalLP t3) + (VMAtoSCA t1 iLP t2) + (comment "Update CDR-CODEs to make it a legitimate frame") + (stack-read-tag iFP t1 "Tag of saved continuation register") + (stack-read-tag-disp iFP 8 t2 "Tag of saved control register") + (BIS t1 #xC0 t1 "Set CDR-CODE to 3") + (stack-write-tag iFP t1 "Put it back") + (BIS t2 #xC0 t2 "Set CDR-CODE to 3") + (stack-write-tag-disp iFP 8 t2 "Put it back") + (comment "Copy the current trap-on-exit bit into the saved control register") + (get-control-register t1 "Get control register") + (stack-read-data-disp iFP 8 t2 "Get saved control register") + (load-constant t3 #.1_24 "cr.trap-on-exit-bit") + (BIC t2 t3 t2 "Remove saved control register's trap-on-exit bit") + (AND t1 t3 t1 "Extract control register's trap-on-exit bit") + (BIS t2 t1 t2 "Copy it into saved control register") + (stack-write-data-disp iFP 8 t2 "Update saved control register") + (comment "Restore the new control register with proper trap mode") + (stack-top2 t2 t1 "peek at new control register to look at tag") + (CheckDataType t2 |TypeFixnum| unwindillegalcontrol t3) + (stack-pop-data t1 "Get new control register") + (set-control-register t1)) + (|CoprocessorRegisterFlushIDCaches| + (comment "We're about to flush the instruction cache so we can't rely") + (comment "on ContinueToNextInstruction working. Instead, we must load") + (comment "the next PC now and explicitly fill the cache.") + (LDQ iPC CACHELINE_NEXTPCDATA (iCP)) + (LDQ t1 PROCESSORSTATE_FLUSHCACHES_HOOK (ivory)) + (with-c-registers (t8) + (BIS t1 zero pv) + (JSR RA t1 0)) + (comment "Compute proper iCP after FlushCaches resets it.") + ;; (PC-TO-iCACHEENT iPC iCP t1 t2) done by ICacheMiss + (external-branch ICacheMiss)) + (|CoprocessorRegisterFlushCachesForVMA| + (EXTLL arg2 0 arg2 "Extract the VMA") +; (BIS zero |TypeEvenPC| arg3 "Treat it as an even PC") +; (convert-continuation-to-pc arg3 arg2 t1 t2) + (SLL arg2 1 t1 "convert continuation to an even pc") + (PC-to-iCACHEENT t1 t2 t3 t4) + (LDQ t3 CACHELINE_PCDATA (t2)) + (CMPEQ t1 t3 t3 "Is this VMA in the cache?") + (branch-false t3 dcwnotincache "No.") + (STQ zero CACHELINE_PCDATA (t2) "Yes, flush it") + (STQ zero CACHELINE_PCDATA+CACHELINESIZE (t2)) + (label dcwnotincache)) + (|CoprocessorRegisterFlushHiddenArrayRegisters| + (EXTLL arg2 0 arg2 "Get the VMA of the new stack array") + (LDA t8 |AutoArrayRegMask| (zero)) + (AND arg2 t8 t8) +; (SLL t8 |AutoArrayRegShift| t8) ; mask is in place, so shift is zero. + (LDA t7 PROCESSORSTATE_AC0ARRAY (ivory)) + (ADDQ t7 t8 t7 "Here is our array register block") + (LDQ t8 ARRAYCACHE_ARRAY (t7) "And here is the cached array") + (CMPEQ arg2 t8 t8 "t8==1 iff cached array is ours") + (branch-false t8 arraynotincache) + (STQ zero ARRAYCACHE_ARRAY (t7) "Flush it") + (label arraynotincache)) + (:else + (comment "Standard coprocessor register processing") + (LDQ R0 PROCESSORSTATE_COPROCESSORWRITEHOOK (ivory)) + (with-c-registers (t8) + (BIS R0 zero pv) + (JSR RA R0 0)) + (BEQ R0 cpreadexc "J. if CoprocessorWrite exception return"))) + (ContinueToNextInstruction) + (label unwindillegalcontinuation) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label unwindillegalcontrol) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label unwindillegalFP) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label unwindillegalLP) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label cpwriteexc) + (illegal-operand unknown-internal-register)) + + +;;; Microsecond clock support + +(define-fast-subroutine |GetRPCC| (arg1 arg2) (ra) +; (RPCC R0) +; (SLL R0 32 arg1) +; (ADDQ R0 arg1 arg1) +; (SRL arg1 32 R0)) +) + +(define-fast-subroutine |SpinWheels| (arg1) (ra) + (BIS zero 1 arg1) + (SLL arg1 25 arg1) ; #x2000000 + (label spinwheelaxis) + (ADDQ arg1 -1 arg1) + (BGT arg1 spinwheelaxis)) + + +(comment "Fin.") diff --git a/alpha-emulator/ifunsubp.s b/alpha-emulator/ifunsubp.s new file mode 100644 index 0000000..279636a --- /dev/null +++ b/alpha-emulator/ifunsubp.s @@ -0,0 +1,2852 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunsubp.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* Subprimitives. */ +.align 5 +.globl DoEphemeralp +.ent DoEphemeralp 0 +/* Halfword operand from stack instruction - DoEphemeralp */ + .globl DoEphemeralpFP + .globl DoEphemeralpSP + .globl DoEphemeralpLP + .globl DoEphemeralpIM +.align 3 +DoEphemeralp: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoEphemeralpIM" +#endif +.align 3 +DoEphemeralpIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G15211: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoEphemeralp # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoEphemeralpSP" +#endif +.align 3 +DoEphemeralpSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoEphemeralp # [0di] + .byte 0x90 + .asciiz "DoEphemeralpLP" +#endif +.align 3 +DoEphemeralpLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoEphemeralp # [1] + .byte 0x84 + .asciiz "DoEphemeralpFP" +#endif +.align 3 +DoEphemeralpFP: # Entry point for FP relative +.align 3 +headDoEphemeralp: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoEphemeralp: +/* arg1 has the operand, sign extended if immediate. */ + ldq $1, PROCESSORSTATE_PTRTYPE($14) # ptr type array [1] + srl $16, 32, $17 # [2di] + extll $16, 0, $16 # [1] +/* TagType. */ + and $17, 63, $17 # [1] + s4addq $17, $1, $2 # [1] + srl $16, 27, $16 # [1] + ldl $3, 0($2) # =0 if not a pointer [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bne $16, NONEPHEM # J. if zone not ephemeral [0di] + beq $3, NONEPHEM # J. if not a pointer [1] + ldq $6, PROCESSORSTATE_TADDRESS($14) # [0di] + stq $6, 8($12) # push the data [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.align 3 +NONEPHEM: + ldq $6, PROCESSORSTATE_NILADDRESS($14) # [1] + stq $6, 8($12) # push the data [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.end DoEphemeralp +/* End of Halfword operand from stack instruction - DoEphemeralp */ +.align 12 + and $31, $31, $31 # [1] +.align 12 +.align 5 +.globl DoUnsignedLessp +.ent DoUnsignedLessp 0 +/* Halfword operand from stack instruction - DoUnsignedLessp */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoUnsignedLesspFP + .globl DoUnsignedLesspSP + .globl DoUnsignedLesspLP + .globl DoUnsignedLesspIM +.align 3 +DoUnsignedLessp: +#ifdef TRACING + .byte 0x88 + .asciiz "DoUnsignedLesspSP" +#endif +.align 3 +DoUnsignedLesspSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoUnsignedLessp # [0di] + .byte 0x90 + .asciiz "DoUnsignedLesspLP" +#endif +.align 3 +DoUnsignedLesspLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoUnsignedLessp # [1] + .byte 0x84 + .asciiz "DoUnsignedLesspFP" +#endif +.align 3 +DoUnsignedLesspFP: # Entry point for FP relative +.align 3 +headDoUnsignedLessp: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoUnsignedLessp: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $2, 0($12) # Get data from arg1 [1] + srl $18, 12, $18 # [0di] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1-] + extll $16, 0, $4 # Get unsigned data from arg2 [1di] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1-] + and $18, 1, $18 # 1 if no-pop, 0 if pop [0di] + extll $2, 0, $2 # Unsigned arg1 [1] + s8addq $18, $12, $12 # Either a stack-push or a stack-write [1] + subq $4, $2, $6 # t6:=arg2-arg1 unsigned [1] + cmovgt $6, $25, $24 # [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stq $24, 0($12) # [1] + br $31, CACHEVALID # [1] +#ifdef TRACING + br $31, DoUnsignedLesspIM # [1] + .byte 0x82 + .asciiz "DoUnsignedLesspIM" +#endif +.align 5 +.align 3 +DoUnsignedLesspIM: # Entry point for IMMEDIATE mode + ldl $2, 0($12) # Get data from arg1 [1] + srl $18, 12, $18 # [0di] + ldq $24, PROCESSORSTATE_NILADDRESS($14) # [1-] + extll $2, 0, $2 # ... [2di] + ldq $25, PROCESSORSTATE_TADDRESS($14) # [1-] + and $18, 1, $18 # 1 if no-pop, 0 if pop [0di] + subq $17, $2, $6 # t6:=arg2-arg1 unsigned [1] + s8addq $18, $12, $12 # Either a stack-push or a stack-write [1] + cmovgt $6, $25, $24 # [1] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stq $24, 0($12) # [1] + br $31, CACHEVALID # [1] +.end DoUnsignedLessp +/* End of Halfword operand from stack instruction - DoUnsignedLessp */ +.align 5 +.globl DoAllocateListBlock +.ent DoAllocateListBlock 0 +/* Halfword operand from stack instruction - DoAllocateListBlock */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAllocateListBlockFP + .globl DoAllocateListBlockSP + .globl DoAllocateListBlockLP + .globl DoAllocateListBlockIM +.align 3 +DoAllocateListBlock: +#ifdef TRACING + .byte 0x82 + .asciiz "DoAllocateListBlockIM" +#endif +.align 3 +DoAllocateListBlockIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoAllocateListBlock # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoAllocateListBlockSP" +#endif +.align 3 +DoAllocateListBlockSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAllocateListBlock # [0di] + .byte 0x90 + .asciiz "DoAllocateListBlockLP" +#endif +.align 3 +DoAllocateListBlockLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAllocateListBlock # [1] + .byte 0x84 + .asciiz "DoAllocateListBlockFP" +#endif +.align 3 +DoAllocateListBlockFP: # Entry point for FP relative +.align 3 +headDoAllocateListBlock: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAllocateListBlock: +/* arg1 has the operand, not sign extended if immediate. */ + ldq $1, PROCESSORSTATE_LCAREA($14) # [1] + ldq $18, 0($12) # [1] + srl $16, 32, $17 # [1-] + extll $16, 0, $16 # [1] + subq $17, TypeFixnum, $5 # [1] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G15212 # [1] + ldl $4, PROCESSORSTATE_LCLENGTH($14) # [0di] + cmpeq $18, $1, $2 # [1-] + beq $2, G15213 # Wrong area [1] + subq $4, $16, $2 # Effectively an unsigned 32-bit compare [1] + blt $2, G15213 # Insufficient cache [1] + ldq $1, PROCESSORSTATE_LCADDRESS($14) # Fetch address [1-] + ldah $3, -16384 # [0di] + extll $3, 0, $3 # [1] + stl $2, PROCESSORSTATE_LCLENGTH($14) # Store remaining length [0di] + stq $1, 0($12) # Cache address/tag -> TOS [1] + stl $1, PROCESSORSTATE_BAR1($14) # Cache address -> BAR1 [1] + extll $1, 0, $1 # [1] + ldl $4, PROCESSORSTATE_CONTROL($14) # Verify trap mode [0di] + addq $1, $16, $1 # Increment address [2-] + stl $1, PROCESSORSTATE_LCADDRESS($14) # Store updated address [0di] + and $3, $4, $3 # [1-] + bne $3, NEXTINSTRUCTION # Already above emulator mode [1] + ldah $3, 16384 # [1] + bis $4, $3, $4 # [1] + stl $4, PROCESSORSTATE_CONTROL($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15212: + bis $31, 0, $20 # [1-] + bis $31, 1, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15213: +/* SetTag. */ + sll $17, 32, $1 # [1] + bis $16, $1, $1 # [2] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.end DoAllocateListBlock +/* End of Halfword operand from stack instruction - DoAllocateListBlock */ +.align 5 +.globl DoAllocateStructureBlock +.ent DoAllocateStructureBlock 0 +/* Halfword operand from stack instruction - DoAllocateStructureBlock */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoAllocateStructureBlockFP + .globl DoAllocateStructureBlockSP + .globl DoAllocateStructureBlockLP + .globl DoAllocateStructureBlockIM +.align 3 +DoAllocateStructureBlock: +#ifdef TRACING + .byte 0x82 + .asciiz "DoAllocateStructureBlockIM" +#endif +.align 3 +DoAllocateStructureBlockIM: # Entry point for IMMEDIATE mode +/* This sequence is lukewarm */ + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoAllocateStructureBlock # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoAllocateStructureBlockSP" +#endif +.align 3 +DoAllocateStructureBlockSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAllocateStructureBlock # [0di] + .byte 0x90 + .asciiz "DoAllocateStructureBlockLP" +#endif +.align 3 +DoAllocateStructureBlockLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAllocateStructureBlock # [1] + .byte 0x84 + .asciiz "DoAllocateStructureBlockFP" +#endif +.align 3 +DoAllocateStructureBlockFP: # Entry point for FP relative +.align 3 +headDoAllocateStructureBlock: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAllocateStructureBlock: +/* arg1 has the operand, not sign extended if immediate. */ + ldq $1, PROCESSORSTATE_SCAREA($14) # [1] + ldq $18, 0($12) # [1] + srl $16, 32, $17 # [1-] + extll $16, 0, $16 # [1] + subq $17, TypeFixnum, $5 # [1] + and $5, 63, $5 # Strip CDR code [1] + bne $5, G15214 # [1] + ldl $4, PROCESSORSTATE_SCLENGTH($14) # [0di] + cmpeq $18, $1, $2 # [1-] + beq $2, G15215 # Wrong area [1] + subq $4, $16, $2 # Effectively an unsigned 32-bit compare [1] + blt $2, G15215 # Insufficient cache [1] + ldq $1, PROCESSORSTATE_SCADDRESS($14) # Fetch address [1-] + ldah $3, -16384 # [0di] + extll $3, 0, $3 # [1] + stl $2, PROCESSORSTATE_SCLENGTH($14) # Store remaining length [0di] + stq $1, 0($12) # Cache address/tag -> TOS [1] + stl $1, PROCESSORSTATE_BAR1($14) # Cache address -> BAR1 [1] + extll $1, 0, $1 # [1] + ldl $4, PROCESSORSTATE_CONTROL($14) # Verify trap mode [0di] + addq $1, $16, $1 # Increment address [2-] + stl $1, PROCESSORSTATE_SCADDRESS($14) # Store updated address [0di] + and $3, $4, $3 # [1-] + bne $3, NEXTINSTRUCTION # Already above emulator mode [1] + ldah $3, 16384 # [1] + bis $4, $3, $4 # [1] + stl $4, PROCESSORSTATE_CONTROL($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15214: + bis $31, 0, $20 # [1-] + bis $31, 1, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15215: +/* SetTag. */ + sll $17, 32, $1 # [1] + bis $16, $1, $1 # [2] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.end DoAllocateStructureBlock +/* End of Halfword operand from stack instruction - DoAllocateStructureBlock */ +.align 5 +.globl DoPointerDifference +.ent DoPointerDifference 0 +/* Halfword operand from stack instruction - DoPointerDifference */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPointerDifferenceFP + .globl DoPointerDifferenceSP + .globl DoPointerDifferenceLP + .globl DoPointerDifferenceIM +.align 3 +DoPointerDifference: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPointerDifferenceSP" +#endif +.align 3 +DoPointerDifferenceSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoPointerDifference # [0di] + .byte 0x90 + .asciiz "DoPointerDifferenceLP" +#endif +.align 3 +DoPointerDifferenceLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoPointerDifference # [1] + .byte 0x84 + .asciiz "DoPointerDifferenceFP" +#endif +.align 3 +DoPointerDifferenceFP: # Entry point for FP relative +.align 3 +headDoPointerDifference: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoPointerDifference: +/* arg1 has the operand, not sign extended if immediate. */ + ldl $1, 0($12) # Get the data of ARG1 [1] + extll $16, 0, $2 # Get the data of ARG2 [2di] + subl $1, $2, $3 # (%32-bit-difference (data arg1) (data arg2)) [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $4 # [0di] + stl $3, 0($12) # Save result and coerce to a FIXNUM [1-] + stl $4, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +#ifdef TRACING + br $31, DoPointerDifferenceIM # [1] + .byte 0x82 + .asciiz "DoPointerDifferenceIM" +#endif +.align 5 +.align 3 +DoPointerDifferenceIM: # Entry point for IMMEDIATE mode + sll $17, 56, $2 # [1-] + ldl $1, 0($12) # Get the data of arg1 [0di] + sra $2, 56, $2 # [2-] + subl $1, $2, $3 # (%32-bit-difference (data arg1) (data arg2)) [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + bis $31, TypeFixnum, $4 # [1-] + stl $3, 0($12) # Save result and coerce to a FIXNUM [0di] + stl $4, 4($12) # write the stack cache [1] + br $31, CACHEVALID # [1] +.end DoPointerDifference +/* End of Halfword operand from stack instruction - DoPointerDifference */ +.align 5 +.globl DoPointerIncrement +.ent DoPointerIncrement 0 +/* Halfword operand from stack instruction - DoPointerIncrement */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoPointerIncrementFP + .globl DoPointerIncrementSP + .globl DoPointerIncrementLP + .globl DoPointerIncrementIM +.align 3 +DoPointerIncrement: +#ifdef TRACING + .byte 0x88 + .asciiz "DoPointerIncrementSP" +#endif +.align 3 +DoPointerIncrementSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoPointerIncrement # [0di] + .byte 0x90 + .asciiz "DoPointerIncrementLP" +#endif +.align 3 +DoPointerIncrementLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoPointerIncrement # [1] + .byte 0x84 + .asciiz "DoPointerIncrementFP" +#endif +.align 3 +DoPointerIncrementFP: # Entry point for FP relative +.align 3 +beginDoPointerIncrement: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $2, 0($16) # Get the data of arg2 [2] + addl $2, 1, $3 # (%32-bit-plus (data arg1) 1) [3] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $13, CACHELINE_NEXTCP($13) # [1] + stl $3, 0($16) # Put result back [1] + br $31, CACHEVALID # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoPointerIncrementIM" +#endif +DoPointerIncrementIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoPointerIncrement. +.end DoPointerIncrement +/* End of Halfword operand from stack instruction - DoPointerIncrement */ +.align 5 +.globl DoStoreConditional +.ent DoStoreConditional 0 +/* Halfword operand from stack instruction - DoStoreConditional */ + .globl DoStoreConditionalFP + .globl DoStoreConditionalSP + .globl DoStoreConditionalLP + .globl DoStoreConditionalIM +.align 3 +DoStoreConditional: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoStoreConditionalIM" +#endif +.align 3 +DoStoreConditionalIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G15232: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoStoreConditional # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoStoreConditionalSP" +#endif +.align 3 +DoStoreConditionalSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoStoreConditional # [0di] + .byte 0x90 + .asciiz "DoStoreConditionalLP" +#endif +.align 3 +DoStoreConditionalLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoStoreConditional # [1] + .byte 0x84 + .asciiz "DoStoreConditionalFP" +#endif +.align 3 +DoStoreConditionalFP: # Entry point for FP relative +.align 3 +headDoStoreConditional: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoStoreConditional: +/* arg1 has the operand, sign extended if immediate. */ + srl $16, 32, $17 # [3] + ldl $19, 0($12) # old tag and data [0di] + ldl $18, 4($12) # old tag and data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + extll $16, 0, $16 # [1] + ldl $21, 0($12) # address tag and data [1-] + ldl $20, 4($12) # address tag and data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $21, 0, $21 # [1] +/* TagType. */ + and $20, 63, $1 # [1] + subq $1, TypeLocative, $2 # [1] + and $2, 63, $2 # Strip CDR code [1] + bne $2, STORECONDIOP # [1] +/* Read the location, checking write access */ +/* Memory Read Internal */ +G15216: + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $21, $14, $3 # [0di] + ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $3, $31, $5 # [0di] + ldq_u $4, 0($3) # [1-] + subq $21, $1, $1 # Stack cache offset [1di] + cmpult $1, $2, $2 # In range? [1] + ldl $5, 0($5) # [0di] + extbl $4, $3, $4 # [1-] + bne $2, G15218 # [0di] +G15217: + ldq $1, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + lda $3, 240 # [0di] + srl $1, $4, $1 # [3] + srl $3, $4, $3 # [1] + blbs $1, G15220 # [1-] +G15227: + subl $19, $5, $1 # Check for data match - NOT [1] + xor $18, $4, $2 # Zero if tags match [1] + bne $1, STORECONDNIL # Jump if data didn't match [0di] +/* TagType. */ + and $2, 63, $2 # Stip result of comparing CDR-CODEs [1-] + bne $2, STORECONDNIL # Jump if tags don't match [1] + and $17, 63, $1 # Strip CDR-CODE [1-] + and $4, 192, $4 # Retain CDR-CODE [1] + bis $1, $4, $4 # Merge new tag with old CDR-CODE [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $21, $14, $1 # [1-] + ldl $6, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $1, $31, $5 # [1-] + ldq_u $3, 0($1) # [1di] + subq $21, $2, $2 # Stack cache offset [1-] + cmpult $2, $6, $6 # In range? [1] + insbl $4, $1, $2 # [1] + mskbl $3, $1, $3 # [1] +.align 3 +G15230: + bis $3, $2, $3 # [2] + stq_u $3, 0($1) # [0di] + stl $16, 0($5) # [1] + bne $6, G15229 # J. if in cache [1] +G15228: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [1] + ldq $6, PROCESSORSTATE_TADDRESS($14) # [1] + stq $6, 8($12) # push the data [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +STORECONDNIL: + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + ldq $6, PROCESSORSTATE_NILADDRESS($14) # [1] + stq $6, 8($12) # push the data [1] + addq $12, 8, $12 # [1-] + br $31, CACHEVALID # [0di] +.align 3 +STORECONDIOP: + bis $31, 0, $20 # [1-] + bis $31, 65, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15229: + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] +.align 3 +G15231: + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $21, $2, $2 # Stack cache offset [2di] + s8addq $2, $1, $1 # reconstruct SCA [1] + stl $16, 0($1) # Store in stack [2] + stl $4, 4($1) # write the stack cache [1] + br $31, G15228 # [1] +.align 3 +G15218: + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $1, $2, $1 # reconstruct SCA [3] + ldl $5, 0($1) # [2] + ldl $4, 4($1) # Read from stack cache [1] + br $31, G15217 # [1] +.align 3 +G15220: + blbc $3, G15219 # [1] + extll $5, 0, $21 # Do the indirect thing [0di] + br $31, G15216 # [1-] +.align 3 +G15219: + ldq $1, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $4, 63, $3 # Discard the CDR code [0di] + stq $21, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $3, $1, $3 # Adjust for a longword load [2di] + ldl $1, 0($3) # Get the memory action [2] +.align 3 +G15224: + and $1, MemoryActionTransform, $3 # [3] + beq $3, G15223 # [1] + bic $4, 63, $4 # [1-] + bis $4, TypeExternalValueCellPointer, $4 # [1] + br $31, G15227 # [1-] +#ifndef MINIMA +G15223: +#endif +#ifdef MINIMA +.align 3 +G15223: + and $1, MemoryActionBinding, $3 # [1-] + ldq $2, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $3, G15222 # [1-] + sll $21, 1, $1 # [0di] + ldq $3, PROCESSORSTATE_DBCBASE($14) # [1-] + and $1, $2, $1 # Hash index [1di] + bis $31, 1, $2 # [1] + sll $2, IvoryMemoryData, $2 # [1] + addl $1, $3, $1 # [1] + extll $1, 0, $1 # Clear sign-extension [1] + s4addq $1, $2, $2 # [2] + ldl $1, 0($2) # Fetch the key [2] + ldl $5, 4($2) # Fetch value [1] + subl $21, $1, $3 # Compare [2di] + bne $3, G15226 # Trap on miss [1] + extll $5, 0, $21 # Extract the pointer, and indirect [0di] + br $31, G15216 # This is another memory read tailcall. [1-] +.align 3 +G15226: + br $31, DBCACHEMISSTRAP +#endif +G15222: +/* Perform memory action */ + bis $31, $1, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.end DoStoreConditional +/* End of Halfword operand from stack instruction - DoStoreConditional */ +.align 5 +.globl DoMemoryWrite +.ent DoMemoryWrite 0 +/* Halfword operand from stack instruction - DoMemoryWrite */ + .globl DoMemoryWriteFP + .globl DoMemoryWriteSP + .globl DoMemoryWriteLP + .globl DoMemoryWriteIM +.align 3 +DoMemoryWrite: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoMemoryWriteIM" +#endif +.align 3 +DoMemoryWriteIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1] +.align 3 +G15236: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoMemoryWrite # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoMemoryWriteSP" +#endif +.align 3 +DoMemoryWriteSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoMemoryWrite # [0di] + .byte 0x90 + .asciiz "DoMemoryWriteLP" +#endif +.align 3 +DoMemoryWriteLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoMemoryWrite # [1] + .byte 0x84 + .asciiz "DoMemoryWriteFP" +#endif +.align 3 +DoMemoryWriteFP: # Entry point for FP relative +.align 3 +headDoMemoryWrite: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoMemoryWrite: +/* arg1 has the operand, sign extended if immediate. */ + ldl $19, 0($12) # [1] + ldl $18, 4($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + srl $16, 32, $17 # [1] + extll $16, 0, $16 # [1] + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + addq $19, $14, $1 # [0di] + ldl $5, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $1, $31, $4 # [0di] + ldq_u $3, 0($1) # [1-] + subq $19, $2, $2 # Stack cache offset [1di] + cmpult $2, $5, $5 # In range? [1] + insbl $17, $1, $2 # [1] + mskbl $3, $1, $3 # [1] +.align 3 +G15234: + bis $3, $2, $3 # [2] + stq_u $3, 0($1) # [0di] + stl $16, 0($4) # [1] + bne $5, G15233 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15233: + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] +.align 3 +G15235: + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $19, $2, $2 # Stack cache offset [2di] + s8addq $2, $1, $1 # reconstruct SCA [1] + stl $16, 0($1) # Store in stack [2] + stl $17, 4($1) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.end DoMemoryWrite +/* End of Halfword operand from stack instruction - DoMemoryWrite */ +.align 5 +.globl DoPStoreContents +.ent DoPStoreContents 0 +/* Halfword operand from stack instruction - DoPStoreContents */ + .globl DoPStoreContentsFP + .globl DoPStoreContentsSP + .globl DoPStoreContentsLP + .globl DoPStoreContentsIM +.align 3 +DoPStoreContents: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoPStoreContentsIM" +#endif +.align 3 +DoPStoreContentsIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G15249: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoPStoreContents # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoPStoreContentsSP" +#endif +.align 3 +DoPStoreContentsSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoPStoreContents # [0di] + .byte 0x90 + .asciiz "DoPStoreContentsLP" +#endif +.align 3 +DoPStoreContentsLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoPStoreContents # [1] + .byte 0x84 + .asciiz "DoPStoreContentsFP" +#endif +.align 3 +DoPStoreContentsFP: # Entry point for FP relative +.align 3 +headDoPStoreContents: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoPStoreContents: +/* arg1 has the operand, sign extended if immediate. */ + ldl $19, 0($12) # address tag and data [1] + ldl $18, 4($12) # address tag and data [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $19, 0, $19 # [1] + srl $16, 32, $17 # [1] + extll $16, 0, $16 # [1] +/* Memory Read Internal */ +G15237: + ldq $6, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $19, $14, $8 # [0di] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $8, $31, $5 # [0di] + ldq_u $4, 0($8) # [1-] + subq $19, $6, $6 # Stack cache offset [1di] + cmpult $6, $7, $7 # In range? [1] + ldl $5, 0($5) # [0di] + extbl $4, $8, $4 # [1-] + bne $7, G15239 # [0di] +G15238: +G15245: +/* Merge cdr-code */ + and $17, 63, $5 # [1-] + and $4, 192, $4 # [1] + bis $4, $5, $4 # [1] + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + addq $19, $14, $6 # [1-] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $6, $31, $5 # [1-] + ldq_u $8, 0($6) # [1di] + subq $19, $7, $7 # Stack cache offset [1-] + cmpult $7, $22, $22 # In range? [1] + insbl $4, $6, $7 # [1] + mskbl $8, $6, $8 # [1] +.align 3 +G15247: + bis $8, $7, $8 # [2] + stq_u $8, 0($6) # [0di] + stl $16, 0($5) # [1] + bne $22, G15246 # J. if in cache [1] + br $31, NEXTINSTRUCTION # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15246: + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] +.align 3 +G15248: + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $19, $7, $7 # Stack cache offset [2di] + s8addq $7, $6, $6 # reconstruct SCA [1] + stl $16, 0($6) # Store in stack [2] + stl $4, 4($6) # write the stack cache [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15239: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $6, $7, $6 # reconstruct SCA [3] + ldl $5, 0($6) # [2] + ldl $4, 4($6) # Read from stack cache [1] + br $31, G15238 # [1] +.end DoPStoreContents +/* End of Halfword operand from stack instruction - DoPStoreContents */ +.align 5 +.globl DoSetCdrCode1 +.ent DoSetCdrCode1 0 +/* Halfword operand from stack instruction - DoSetCdrCode1 */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetCdrCode1FP + .globl DoSetCdrCode1SP + .globl DoSetCdrCode1LP + .globl DoSetCdrCode1IM +.align 3 +DoSetCdrCode1: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetCdrCode1SP" +#endif +.align 3 +DoSetCdrCode1SP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoSetCdrCode1 # [0di] + .byte 0x90 + .asciiz "DoSetCdrCode1LP" +#endif +.align 3 +DoSetCdrCode1LP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetCdrCode1 # [1] + .byte 0x84 + .asciiz "DoSetCdrCode1FP" +#endif +.align 3 +DoSetCdrCode1FP: # Entry point for FP relative +.align 3 +beginDoSetCdrCode1: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $1, 4($16) # Get CDR CODE/TAG of operand [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + and $1, 63, $1 # Strip off any existing CDR code bits [1-] + bis $1, 64, $1 # OR in the CDR [1] + stl $1, 4($16) # Replace the CDE CODE/TAG [1-] + br $31, CACHEVALID # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoSetCdrCode1IM" +#endif +DoSetCdrCode1IM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoSetCdrCode1. +.end DoSetCdrCode1 +/* End of Halfword operand from stack instruction - DoSetCdrCode1 */ +.align 5 +.globl DoSetCdrCode2 +.ent DoSetCdrCode2 0 +/* Halfword operand from stack instruction - DoSetCdrCode2 */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoSetCdrCode2FP + .globl DoSetCdrCode2SP + .globl DoSetCdrCode2LP + .globl DoSetCdrCode2IM +.align 3 +DoSetCdrCode2: +#ifdef TRACING + .byte 0x88 + .asciiz "DoSetCdrCode2SP" +#endif +.align 3 +DoSetCdrCode2SP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoSetCdrCode2 # [0di] + .byte 0x90 + .asciiz "DoSetCdrCode2LP" +#endif +.align 3 +DoSetCdrCode2LP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoSetCdrCode2 # [1] + .byte 0x84 + .asciiz "DoSetCdrCode2FP" +#endif +.align 3 +DoSetCdrCode2FP: # Entry point for FP relative +.align 3 +beginDoSetCdrCode2: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $1, 4($16) # Get CDR CODE/TAG of operand [2] + ldq $9, CACHELINE_NEXTPCDATA($13) # [1] + ldq $13, CACHELINE_NEXTCP($13) # [1] + and $1, 63, $1 # Strip off any existing CDR code bits [1-] + bis $1, 128, $1 # OR in the CDR [1] + stl $1, 4($16) # Replace the CDE CODE/TAG [1-] + br $31, CACHEVALID # [1] +#ifdef TRACING + .byte 0x82 + .asciiz "DoSetCdrCode2IM" +#endif +DoSetCdrCode2IM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoSetCdrCode2. +.end DoSetCdrCode2 +/* End of Halfword operand from stack instruction - DoSetCdrCode2 */ +.align 5 +.globl DoJump +.ent DoJump 0 +/* Halfword operand from stack instruction - DoJump */ +/* arg2 has the preloaded 8 bit operand. */ + .globl DoJumpFP + .globl DoJumpSP + .globl DoJumpLP + .globl DoJumpIM +.align 3 +DoJump: +#ifdef TRACING + .byte 0x88 + .asciiz "DoJumpSP" +#endif +.align 3 +DoJumpSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, beginDoJump # [0di] + .byte 0x90 + .asciiz "DoJumpLP" +#endif +.align 3 +DoJumpLP: # Entry point for LP relative +#ifdef TRACING + br $31, beginDoJump # [1] + .byte 0x84 + .asciiz "DoJumpFP" +#endif +.align 3 +DoJumpFP: # Entry point for FP relative +.align 3 +beginDoJump: +/* arg1 has the operand address. */ + s8addq $17, $16, $16 # Compute operand address [1-] + ldl $4, 0($16) # Read address and even/odd PC tag. [2] + ldl $3, 4($16) # [1] + extll $4, 0, $4 # [2di] + subq $3, TypeEvenPC, $5 # [1] + and $5, 62, $5 # Strip CDR code, low bits [1] + bne $5, JEXC # [1] + sll $4, 1, $4 # [0di] + and $3, 1, $9 # [1] + addq $9, $4, $9 # [1] + and $3, 128, $5 # [1] + beq $5, INTERPRETINSTRUCTIONFORJUMP # [1] +/* Bit 39=1 indicates we need to update control reg */ + and $3, 64, $6 # Get the cleanup bit [1-] + ldq $5, PROCESSORSTATE_CONTROL($14) # Processor control register. [0di] + sll $6, 17, $6 # shift into cleanup-in-progress place [1-] + ldah $7, 128 # [1] + bic $5, $7, $5 # Mask [1] + bis $5, $6, $5 # Set [1] + stq $5, PROCESSORSTATE_CONTROL($14) # [1-] + br $31, INTERPRETINSTRUCTIONFORJUMP # [1] +.align 3 +JEXC: + bis $31, 1, $18 # arg3 = stackp [1-] + bis $31, 0, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +#ifdef TRACING + .byte 0x82 + .asciiz "DoJumpIM" +#endif +DoJumpIM: # Entry point for IMMEDIATE mode + br $31, DoIStageError # IMMEDIATE mode not legal in DoJump. +.end DoJump +/* End of Halfword operand from stack instruction - DoJump */ +.align 5 +.globl DoCheckPreemptRequest +.ent DoCheckPreemptRequest 0 +/* Halfword 10 bit immediate instruction - DoCheckPreemptRequest */ + .globl DoCheckPreemptRequestFP + .globl DoCheckPreemptRequestSP + .globl DoCheckPreemptRequestLP + .globl DoCheckPreemptRequestIM +.align 3 +DoCheckPreemptRequest: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoCheckPreemptRequest" +#endif +.align 3 +DoCheckPreemptRequestIM: +.align 3 +DoCheckPreemptRequestSP: +.align 3 +DoCheckPreemptRequestLP: +.align 3 +DoCheckPreemptRequestFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldl $1, PROCESSORSTATE_INTERRUPTREG($14) # [0di] + and $1, 2, $2 # [3] + cmpeq $2, 2, $2 # [1] + bis $1, $2, $1 # [2] + stl $1, PROCESSORSTATE_INTERRUPTREG($14) # [0di] + beq $1, NEXTINSTRUCTION # [1] + stq $1, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end DoCheckPreemptRequest +/* End of Halfword operand from stack instruction - DoCheckPreemptRequest */ +.align 5 +.globl DoHalt +.ent DoHalt 0 +/* Halfword 10 bit immediate instruction - DoHalt */ + .globl DoHaltFP + .globl DoHaltSP + .globl DoHaltLP + .globl DoHaltIM +.align 3 +DoHalt: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoHalt" +#endif +.align 3 +DoHaltIM: +.align 3 +DoHaltSP: +.align 3 +DoHaltLP: +.align 3 +DoHaltFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + ldl $1, PROCESSORSTATE_CONTROL($14) # [0di] + srl $1, 30, $1 # Isolate current trap mode (FEP mode = -1) [3] + addl $1, 1, $1 # t1 is zero iff we're in trap mode FEP [2] + bne $1, HALTEXC # [1] + br $31, HALTMACHINE +.align 3 +HALTEXC: + bis $31, 1, $18 # arg3 = stackp [1-] + bis $31, 0, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.end DoHalt +/* End of Halfword operand from stack instruction - DoHalt */ +.align 5 +.globl DoNoOp +.ent DoNoOp 0 +/* Halfword 10 bit immediate instruction - DoNoOp */ + .globl DoNoOpFP + .globl DoNoOpSP + .globl DoNoOpLP + .globl DoNoOpIM +.align 3 +DoNoOp: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoNoOp" +#endif +.align 3 +DoNoOpIM: +.align 3 +DoNoOpSP: +.align 3 +DoNoOpLP: +.align 3 +DoNoOpFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + br $31, NEXTINSTRUCTION # [0di] +.end DoNoOp +/* End of Halfword operand from stack instruction - DoNoOp */ +.align 5 +.globl DoAlu +.ent DoAlu 0 +/* Halfword operand from stack instruction - DoAlu */ + .globl DoAluFP + .globl DoAluSP + .globl DoAluLP + .globl DoAluIM +.align 3 +DoAlu: +/* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING + .byte 0x83 + .asciiz "DoAluIM" +#endif +.align 3 +DoAluIM: # Entry point for IMMEDIATE mode +/* This sequence only sucks a moderate amount */ + sll $17, 56, $17 # sign extend the byte argument. [1-] +.align 3 +G15320: + sra $17, 56, $17 # Rest of sign extension [2] + stl $17, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] + ldq $16, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1] + br $31, beginDoAlu # [1] +#ifdef TRACING + .byte 0x88 + .asciiz "DoAluSP" +#endif +.align 3 +DoAluSP: # Entry point for SP relative + bis $20, $31, $16 # Assume SP mode [1-] + cmoveq $17, $12, $16 # SP-pop mode [1] + cmoveq $17, $19, $12 # Adjust SP if SP-pop mode [1] +#ifdef TRACING + br $31, headDoAlu # [0di] + .byte 0x90 + .asciiz "DoAluLP" +#endif +.align 3 +DoAluLP: # Entry point for LP relative +#ifdef TRACING + br $31, headDoAlu # [1] + .byte 0x84 + .asciiz "DoAluFP" +#endif +.align 3 +DoAluFP: # Entry point for FP relative +.align 3 +headDoAlu: + s8addq $17, $16, $16 # Compute operand address [1-] + ldq $16, 0($16) # Get the operand [2] +.align 3 +beginDoAlu: +/* arg1 has the operand, sign extended if immediate. */ + srl $16, 32, $17 # Get tag of ARG2 [3] + extll $16, 0, $16 # Get data of ARG2 [1] + ldl $19, 0($12) # Get ARG1 [1-] + ldl $18, 4($12) # [1] + extll $19, 0, $19 # [2-] + subq $17, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, ALUEXC # [1] + subq $18, TypeFixnum, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, ALUEXC # [1] + ldq $20, PROCESSORSTATE_ALUOP($14) # [0di] + stq $31, PROCESSORSTATE_ALUOVERFLOW($14) # [1] + ldq $21, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1] + cmpeq $20, ALUFunctionBoolean, $1 # [1-] +.align 3 +G15310: + beq $1, G15251 # [1] +/* Here if argument ALUFunctionBoolean */ + srl $21, 10, $23 # [1di] + and $23, 15, $23 # Extract the ALU boolean function [2] + cmpeq $23, BooleClear, $1 # [1] +.align 3 +G15270: + bne $1, G15252 # [1] +.align 3 +G15253: + cmpeq $23, BooleAnd, $1 # [1] +.align 3 +G15271: + beq $1, G15254 # [1] +/* Here if argument BooleAnd */ + and $19, $16, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15254: + cmpeq $23, BooleAndC1, $1 # [1-] +.align 3 +G15272: + beq $1, G15255 # [1] +/* Here if argument BooleAndC1 */ + bic $16, $19, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15255: + cmpeq $23, Boole2, $1 # [1-] +.align 3 +G15273: + beq $1, G15256 # [1] +/* Here if argument Boole2 */ + bis $16, $31, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15256: + cmpeq $23, BooleAndC2, $1 # [1-] +.align 3 +G15274: + beq $1, G15257 # [1] +/* Here if argument BooleAndC2 */ + bic $19, $16, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15257: + cmpeq $23, Boole1, $1 # [1-] +.align 3 +G15275: + beq $1, G15258 # [1] +/* Here if argument Boole1 */ + bis $19, $31, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15258: + cmpeq $23, BooleXor, $1 # [1-] +.align 3 +G15276: + beq $1, G15259 # [1] +/* Here if argument BooleXor */ + xor $19, $16, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15259: + cmpeq $23, BooleIor, $1 # [1-] +.align 3 +G15277: + beq $1, G15260 # [1] +/* Here if argument BooleIor */ + bis $19, $16, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15260: + cmpeq $23, BooleNor, $1 # [1-] +.align 3 +G15278: + beq $1, G15261 # [1] +/* Here if argument BooleNor */ + bis $19, $16, $23 # [0di] + ornot $31, $23, $23 # [1] + br $31, G15252 # [0di] +.align 3 +G15261: + cmpeq $23, BooleEquiv, $1 # [1-] +.align 3 +G15279: + beq $1, G15262 # [1] +/* Here if argument BooleEquiv */ + xor $19, $16, $23 # [0di] + ornot $31, $23, $23 # [1] + br $31, G15252 # [0di] +.align 3 +G15262: + cmpeq $23, BooleC1, $1 # [1-] +.align 3 +G15280: + beq $1, G15263 # [1] +/* Here if argument BooleC1 */ + ornot $31, $19, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15263: + cmpeq $23, BooleOrC1, $1 # [1-] +.align 3 +G15281: + beq $1, G15264 # [1] +/* Here if argument BooleOrC1 */ + ornot $16, $19, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15264: + cmpeq $23, BooleC2, $1 # [1-] +.align 3 +G15282: + beq $1, G15265 # [1] +/* Here if argument BooleC2 */ + ornot $31, $16, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15265: + cmpeq $23, BooleOrC2, $1 # [1-] +.align 3 +G15283: + beq $1, G15266 # [1] +/* Here if argument BooleOrC2 */ + bic $19, $16, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15266: + cmpeq $23, BooleNand, $1 # [1-] +.align 3 +G15284: + beq $1, G15267 # [1] +/* Here if argument BooleNand */ + and $19, $16, $23 # [0di] + br $31, G15252 # [1-] +.align 3 +G15267: + cmpeq $23, BooleSet, $1 # [1-] +.align 3 +G15285: + beq $1, G15252 # [1] +/* Here if argument BooleSet */ + ornot $31, $31, $23 # [0di] +.align 3 +G15252: + stl $23, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15251: + cmpeq $20, ALUFunctionByte, $1 # [1-] +.align 3 +G15311: + beq $1, G15286 # [1] +/* Here if argument ALUFunctionByte */ + ldq $2, PROCESSORSTATE_BYTEROTATE($14) # Get rotate [0di] + ldq $3, PROCESSORSTATE_BYTESIZE($14) # Get bytesize [1] +/* Get background */ + srl $21, 10, $1 # [0di] + and $1, 3, $1 # Extract the byte background [2] + cmpeq $1, ALUByteBackgroundOp1, $4 # [1] +.align 3 +G15293: + beq $4, G15289 # [1] +/* Here if argument ALUByteBackgroundOp1 */ + bis $19, $31, $1 # [0di] +.align 3 +G15288: + srl $21, 12, $5 # [1] + and $5, 1, $5 # Extractthe byte rotate latch [2] + sll $16, $2, $23 # [1] + extll $23, 4, $4 # [2] + extll $23, 0, $23 # [1] + bis $23, $4, $23 # OP2 rotated [2] + beq $5, G15287 # Don't update rotate latch if not requested [1-] + stq $23, PROCESSORSTATE_ROTATELATCH($14) # [1] +.align 3 +G15287: + lda $5, -2 # [1-] + sll $5, $3, $5 # [1] + ornot $31, $5, $5 # Compute mask [2] +/* Get byte function */ + srl $21, 13, $4 # [1] + and $4, 1, $4 # [2] + cmpeq $4, ALUByteFunctionDpb, $3 # [1] +.align 3 +G15298: + beq $3, G15295 # [1] +/* Here if argument ALUByteFunctionDpb */ + sll $5, $2, $5 # Position mask [0di] +.align 3 +G15294: + and $23, $5, $23 # rotated&mask [2] + bic $1, $5, $1 # background&~mask [1] + bis $23, $1, $23 # [1] + stl $23, 0($12) # [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15286: + cmpeq $20, ALUFunctionAdder, $1 # [1-] +.align 3 +G15312: + beq $1, G15299 # [1] +/* Here if argument ALUFunctionAdder */ + srl $21, 11, $3 # [0di] + and $3, 3, $3 # Extract the op2 [2] + srl $21, 10, $2 # [1] + and $2, 1, $2 # Extract the adder carry in [2] + cmpeq $3, ALUAdderOp2Op2, $4 # [1] +.align 3 +G15307: + beq $4, G15302 # [1] +/* Here if argument ALUAdderOp2Op2 */ + bis $16, $31, $1 # [0di] +.align 3 +G15301: + addq $19, $1, $23 # [1] + addq $23, $2, $23 # [1] + srl $23, 31, $3 # Sign bit [1] + srl $23, 32, $4 # Next bit [1] + xor $3, $4, $3 # Low bit is now overflow indicator [2] + srl $21, 24, $4 # Get the load-carry-in bit [1] + stq $3, PROCESSORSTATE_ALUOVERFLOW($14) # [1-] + blbc $4, G15300 # [1] + extll $23, 4, $3 # Get the carry [1-] + lda $4, 1024 # [1] + bic $21, $4, $21 # [1] + and $3, 1, $4 # [1] + sll $4, 10, $4 # [1] + bis $21, $4, $21 # Set the adder carry in [2] + stq $21, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1-] +.align 3 +G15300: + cmplt $19, $1, $3 # [1-] + stq $3, PROCESSORSTATE_ALUBORROW($14) # [0di] + addl $19, $31, $19 # [1-] + addl $16, $31, $16 # [1] + cmplt $19, $1, $3 # [1] + stq $3, PROCESSORSTATE_ALULESSTHAN($14) # [0di] + stl $23, 0($12) # [1] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15299: + cmpeq $20, ALUFunctionMultiplyDivide, $1 # [1-] +.align 3 +G15313: + beq $1, G15250 # [1] +/* Here if argument ALUFunctionMultiplyDivide */ +/* This instruction has not been written yet. */ + bis $31, 0, $20 # [0di] + bis $31, 38, $17 # [1] + br $31, ILLEGALOPERAND + stl $23, 0($12) # [0di] + br $31, NEXTINSTRUCTION # [1] +.align 3 +G15250: +.align 3 +ALUEXC: + bis $31, 0, $20 # [1-] + bis $31, 80, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15302: + cmpeq $3, ALUAdderOp2Zero, $4 # [1] +.align 3 +G15314: + beq $4, G15303 # [1] +/* Here if argument ALUAdderOp2Zero */ + bis $31, $31, $1 # [0di] + br $31, G15301 # [1-] +.align 3 +G15303: + cmpeq $3, ALUAdderOp2Invert, $4 # [1-] +.align 3 +G15315: + beq $4, G15304 # [1] +/* Here if argument ALUAdderOp2Invert */ + addl $16, $31, $1 # [0di] + subq $31, $1, $1 # [1] + extll $1, 0, $1 # [1] + br $31, G15301 # [1-] +.align 3 +G15304: + cmpeq $3, ALUAdderOp2MinusOne, $4 # [1-] +.align 3 +G15316: + beq $4, G15301 # [1] +/* Here if argument ALUAdderOp2MinusOne */ + ornot $31, $31, $1 # [0di] + extll $1, 0, $1 # [1] + br $31, G15301 # [0di] +.align 3 +G15295: + cmpeq $4, ALUByteFunctionLdb, $3 # [1-] +.align 3 +G15317: + bne $3, G15294 # [1] + br $31, G15294 # [1] +.align 3 +G15289: + cmpeq $1, ALUByteBackgroundRotateLatch, $4 # [1-] +.align 3 +G15318: + beq $4, G15290 # [1] +/* Here if argument ALUByteBackgroundRotateLatch */ + ldq $1, PROCESSORSTATE_ROTATELATCH($14) # [0di] + br $31, G15288 # [1] +.align 3 +G15290: + cmpeq $1, ALUByteBackgroundZero, $4 # [2-] +.align 3 +G15319: + beq $4, G15288 # [1] +/* Here if argument ALUByteBackgroundZero */ + bis $31, $31, $1 # [0di] + br $31, G15288 # [1-] +.end DoAlu +/* End of Halfword operand from stack instruction - DoAlu */ +.align 5 +.globl DoSpareOp +.ent DoSpareOp 0 +/* Halfword 10 bit immediate instruction - DoSpareOp */ + .globl DoSpareOpFP + .globl DoSpareOpSP + .globl DoSpareOpLP + .globl DoSpareOpIM +.align 3 +DoSpareOp: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoSpareOp" +#endif +.align 3 +DoSpareOpIM: +.align 3 +DoSpareOpSP: +.align 3 +DoSpareOpLP: +.align 3 +DoSpareOpFP: + extwl $18, 4, $16 # [1-] +/* arg1 has operand preloaded. */ + ldq $1, CACHELINE_INSTRUCTION($13) # Get the instruction [0di] + srl $1, 10, $1 # Position the opcode [3] + and $1, 255, $1 # Extract it [2] + bis $31, 0, $16 # arg1 = instruction arity [1] + bis $31, $1, $17 # arg2 = instruction opcode [1] + bis $31, 1, $18 # arg3 = stackp [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + bis $31, 0, $20 # when not stackp arg5=the arg [1] + bis $31, 0, $21 # arg6=tag to dispatch on [1] + br $31, EXCEPTION # Unimplemented + br $31, NEXTINSTRUCTION # [1-] +.end DoSpareOp +/* End of Halfword operand from stack instruction - DoSpareOp */ +/* Reading and writing internal registers */ +.align 5 +.globl ReadRegisterFP +.ent ReadRegisterFP 0 +.align 3 +ReadRegisterFP: +/* Convert stack cache address to VMA */ + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $10, $5, $5 # stack cache base relative offset [2-] + srl $5, 3, $5 # convert byte address to word address [1] + addq $5, $4, $4 # reconstruct VMA [2] + bis $31, TypeLocative, $5 # [1] + stl $4, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterFP +.align 5 +.globl ReadRegisterLP +.ent ReadRegisterLP 0 +.align 3 +ReadRegisterLP: +/* Convert stack cache address to VMA */ + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $11, $5, $5 # stack cache base relative offset [2-] + srl $5, 3, $5 # convert byte address to word address [1] + addq $5, $4, $4 # reconstruct VMA [2] + bis $31, TypeLocative, $5 # [1] + stl $4, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterLP +.align 5 +.globl ReadRegisterSP +.ent ReadRegisterSP 0 +.align 3 +ReadRegisterSP: +/* Convert stack cache address to VMA */ + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $5, $5 # stack cache base relative offset [2-] + srl $5, 3, $5 # convert byte address to word address [1] + addq $5, $4, $4 # reconstruct VMA [2] + bis $31, TypeLocative, $5 # [1] + stl $4, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterSP +.align 5 +.globl ReadRegisterStackCacheLowerBound +.ent ReadRegisterStackCacheLowerBound 0 +.align 3 +ReadRegisterStackCacheLowerBound: + ldq $3, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + bis $31, TypeLocative, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterStackCacheLowerBound +.align 5 +.globl ReadRegisterBARx +.ent ReadRegisterBARx 0 +.align 3 +ReadRegisterBARx: + srl $16, 7, $2 # BAR number into T2 [1-] + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + lda $1, PROCESSORSTATE_BAR0($14) # [1-] + ldq $13, CACHELINE_NEXTCP($13) # [0di] + s8addq $2, $1, $1 # Now T1 points to the BAR [1-] + ldq $3, 0($1) # [2] + bis $31, TypeLocative, $4 # [1-] + stl $3, 8($12) # [0di] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, CACHEVALID # [1-] +.end ReadRegisterBARx +.align 5 +.globl ReadRegisterContinuation +.ent ReadRegisterContinuation 0 +.align 3 +ReadRegisterContinuation: + ldq $3, PROCESSORSTATE_CONTINUATION($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterContinuation +.align 5 +.globl ReadRegisterAluAndRotateControl +.ent ReadRegisterAluAndRotateControl 0 +.align 3 +ReadRegisterAluAndRotateControl: + ldq $3, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterAluAndRotateControl +.align 5 +.globl ReadRegisterControlRegister +.ent ReadRegisterControlRegister 0 +.align 3 +ReadRegisterControlRegister: + ldl $3, PROCESSORSTATE_CONTROL($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterControlRegister +.align 5 +.globl ReadRegisterCRArgumentSize +.ent ReadRegisterCRArgumentSize 0 +.align 3 +ReadRegisterCRArgumentSize: + ldl $3, PROCESSORSTATE_CONTROL($14) # [1] + and $3, 255, $3 # Get the argument size field [3] + bis $31, TypeFixnum, $5 # [1] + stl $3, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterCRArgumentSize +.align 5 +.globl ReadRegisterEphemeralOldspaceRegister +.ent ReadRegisterEphemeralOldspaceRegister 0 +.align 3 +ReadRegisterEphemeralOldspaceRegister: + ldl $3, PROCESSORSTATE_EPHEMERALOLDSPACE($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterEphemeralOldspaceRegister +.align 5 +.globl ReadRegisterZoneOldspaceRegister +.ent ReadRegisterZoneOldspaceRegister 0 +.align 3 +ReadRegisterZoneOldspaceRegister: + ldl $3, PROCESSORSTATE_ZONEOLDSPACE($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterZoneOldspaceRegister +.align 5 +.globl ReadRegisterChipRevision +.ent ReadRegisterChipRevision 0 +.align 3 +ReadRegisterChipRevision: + bis $31, 5, $3 # [1-] + bis $31, TypeFixnum, $5 # [1] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterChipRevision +.align 5 +.globl ReadRegisterFPCoprocessorPresent +.ent ReadRegisterFPCoprocessorPresent 0 +.align 3 +ReadRegisterFPCoprocessorPresent: + bis $31, TypeFixnum, $4 # [1-] + stl $31, 8($12) # [1di] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterFPCoprocessorPresent +.align 5 +.globl ReadRegisterPreemptRegister +.ent ReadRegisterPreemptRegister 0 +.align 3 +ReadRegisterPreemptRegister: + ldl $3, PROCESSORSTATE_INTERRUPTREG($14) # [1] + and $3, 3, $3 # [3] + bis $31, TypeFixnum, $5 # [1] + stl $3, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterPreemptRegister +.align 5 +.globl ReadRegisterIcacheControl +.ent ReadRegisterIcacheControl 0 +.align 3 +ReadRegisterIcacheControl: + bis $31, TypeFixnum, $5 # [1-] + stl $31, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterIcacheControl +.align 5 +.globl ReadRegisterPrefetcherControl +.ent ReadRegisterPrefetcherControl 0 +.align 3 +ReadRegisterPrefetcherControl: + bis $31, TypeFixnum, $5 # [1-] + stl $31, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterPrefetcherControl +.align 5 +.globl ReadRegisterMapCacheControl +.ent ReadRegisterMapCacheControl 0 +.align 3 +ReadRegisterMapCacheControl: + bis $31, TypeFixnum, $5 # [1-] + stl $31, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterMapCacheControl +.align 5 +.globl ReadRegisterMemoryControl +.ent ReadRegisterMemoryControl 0 +.align 3 +ReadRegisterMemoryControl: + bis $31, TypeFixnum, $5 # [1-] + stl $31, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterMemoryControl +.align 5 +.globl ReadRegisterStackCacheOverflowLimit +.ent ReadRegisterStackCacheOverflowLimit 0 +.align 3 +ReadRegisterStackCacheOverflowLimit: + ldl $3, PROCESSORSTATE_SCOVLIMIT($14) # [1] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + addq $3, $4, $3 # [3] + bis $31, TypeLocative, $4 # [1] + stl $3, 8($12) # [1-] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterStackCacheOverflowLimit +.align 5 +.globl ReadRegisterMicrosecondClock +.ent ReadRegisterMicrosecondClock 0 +.align 3 +ReadRegisterMicrosecondClock: + bis $31, TypeFixnum, $1 # [1-] + stl $31, 8($12) # [1di] + stl $1, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterMicrosecondClock +.align 5 +.globl ReadRegisterTOS +.ent ReadRegisterTOS 0 +.align 3 +ReadRegisterTOS: + ldq $1, 0($12) # [1] + addq $12, 8, $12 # [1] + sll $1, 26, $2 # [2] + srl $2, 26, $2 # [2] + stq $2, 0($12) # Push CDR-NEXT TOS [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterTOS +.align 5 +.globl ReadRegisterEventCount +.ent ReadRegisterEventCount 0 +.align 3 +ReadRegisterEventCount: + ldq $3, PROCESSORSTATE_AREVENTCOUNT($14) # [1] + bis $31, TypeFixnum, $4 # [0di] + stl $3, 8($12) # [1-] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterEventCount +.align 5 +.globl ReadRegisterBindingStackPointer +.ent ReadRegisterBindingStackPointer 0 +.align 3 +ReadRegisterBindingStackPointer: + ldq $3, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterBindingStackPointer +.align 5 +.globl ReadRegisterCatchBlockList +.ent ReadRegisterCatchBlockList 0 +.align 3 +ReadRegisterCatchBlockList: + ldq $3, PROCESSORSTATE_CATCHBLOCK($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterCatchBlockList +.align 5 +.globl ReadRegisterControlStackLimit +.ent ReadRegisterControlStackLimit 0 +.align 3 +ReadRegisterControlStackLimit: + ldl $3, PROCESSORSTATE_CSLIMIT($14) # [1] + bis $31, TypeLocative, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterControlStackLimit +.align 5 +.globl ReadRegisterControlStackExtraLimit +.ent ReadRegisterControlStackExtraLimit 0 +.align 3 +ReadRegisterControlStackExtraLimit: + ldl $3, PROCESSORSTATE_CSEXTRALIMIT($14) # [1] + bis $31, TypeLocative, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterControlStackExtraLimit +.align 5 +.globl ReadRegisterBindingStackLimit +.ent ReadRegisterBindingStackLimit 0 +.align 3 +ReadRegisterBindingStackLimit: + ldq $3, PROCESSORSTATE_BINDINGSTACKLIMIT($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterBindingStackLimit +.align 5 +.globl ReadRegisterPHTBase +.ent ReadRegisterPHTBase 0 +.align 3 +ReadRegisterPHTBase: + bis $31, TypeLocative, $5 # [1-] + stl $31, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterPHTBase +.align 5 +.globl ReadRegisterPHTMask +.ent ReadRegisterPHTMask 0 +.align 3 +ReadRegisterPHTMask: + bis $31, TypeFixnum, $5 # [1-] + stl $31, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterPHTMask +.align 5 +.globl ReadRegisterCountMapReloads +.ent ReadRegisterCountMapReloads 0 +.align 3 +ReadRegisterCountMapReloads: + bis $31, TypeFixnum, $5 # [1-] + stl $31, 8($12) # [0di] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, NEXTINSTRUCTION # [1-] +.end ReadRegisterCountMapReloads +.align 5 +.globl ReadRegisterListCacheArea +.ent ReadRegisterListCacheArea 0 +.align 3 +ReadRegisterListCacheArea: + ldq $3, PROCESSORSTATE_LCAREA($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterListCacheArea +.align 5 +.globl ReadRegisterListCacheAddress +.ent ReadRegisterListCacheAddress 0 +.align 3 +ReadRegisterListCacheAddress: + ldq $3, PROCESSORSTATE_LCADDRESS($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterListCacheAddress +.align 5 +.globl ReadRegisterListCacheLength +.ent ReadRegisterListCacheLength 0 +.align 3 +ReadRegisterListCacheLength: + ldl $3, PROCESSORSTATE_LCLENGTH($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterListCacheLength +.align 5 +.globl ReadRegisterStructureCacheArea +.ent ReadRegisterStructureCacheArea 0 +.align 3 +ReadRegisterStructureCacheArea: + ldq $3, PROCESSORSTATE_SCAREA($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterStructureCacheArea +.align 5 +.globl ReadRegisterStructureCacheAddress +.ent ReadRegisterStructureCacheAddress 0 +.align 3 +ReadRegisterStructureCacheAddress: + ldq $3, PROCESSORSTATE_SCADDRESS($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterStructureCacheAddress +.align 5 +.globl ReadRegisterStructureCacheLength +.ent ReadRegisterStructureCacheLength 0 +.align 3 +ReadRegisterStructureCacheLength: + ldl $3, PROCESSORSTATE_SCLENGTH($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterStructureCacheLength +.align 5 +.globl ReadRegisterDynamicBindingCacheBase +.ent ReadRegisterDynamicBindingCacheBase 0 +.align 3 +ReadRegisterDynamicBindingCacheBase: + ldq $3, PROCESSORSTATE_DBCBASE($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterDynamicBindingCacheBase +.align 5 +.globl ReadRegisterDynamicBindingCacheMask +.ent ReadRegisterDynamicBindingCacheMask 0 +.align 3 +ReadRegisterDynamicBindingCacheMask: + ldq $3, PROCESSORSTATE_DBCMASK($14) # [1] + addq $12, 8, $12 # [0di] + sll $3, 26, $5 # [3] + srl $5, 26, $5 # [2] + stq $5, 0($12) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterDynamicBindingCacheMask +.align 5 +.globl ReadRegisterChoicePointer +.ent ReadRegisterChoicePointer 0 +.align 3 +ReadRegisterChoicePointer: + ldl $3, PROCESSORSTATE_CHOICEPTR($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterChoicePointer +.align 5 +.globl ReadRegisterStructureStackChoicePointer +.ent ReadRegisterStructureStackChoicePointer 0 +.align 3 +ReadRegisterStructureStackChoicePointer: + ldl $3, PROCESSORSTATE_SSTKCHOICEPTR($14) # [1] + bis $31, TypeFixnum, $5 # [0di] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterStructureStackChoicePointer +.align 5 +.globl ReadRegisterFEPModeTrapVectorAddress +.ent ReadRegisterFEPModeTrapVectorAddress 0 +.align 3 +ReadRegisterFEPModeTrapVectorAddress: + ldq $3, PROCESSORSTATE_FEPMODETRAPVECADDRESS($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end ReadRegisterFEPModeTrapVectorAddress +.align 5 +.globl ReadRegisterStackFrameMaximumSize +.ent ReadRegisterStackFrameMaximumSize 0 +.align 3 +ReadRegisterStackFrameMaximumSize: + lda $3, 128 # [1-] + bis $31, TypeFixnum, $5 # [1] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterStackFrameMaximumSize +.align 5 +.globl ReadRegisterStackCacheDumpQuantum +.ent ReadRegisterStackCacheDumpQuantum 0 +.align 3 +ReadRegisterStackCacheDumpQuantum: + lda $3, 896 # [1-] + bis $31, TypeFixnum, $5 # [1] + stl $3, 8($12) # [1-] + stl $5, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterStackCacheDumpQuantum +.align 5 +.globl ReadRegisterConstantNIL +.ent ReadRegisterConstantNIL 0 +.align 3 +ReadRegisterConstantNIL: + ldq $5, PROCESSORSTATE_TADDRESS($14) # [1] + stq $5, 8($12) # push the data [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterConstantNIL +.align 5 +.globl ReadRegisterConstantT +.ent ReadRegisterConstantT 0 +.align 3 +ReadRegisterConstantT: + ldq $5, PROCESSORSTATE_NILADDRESS($14) # [1] + stq $5, 8($12) # push the data [1] + addq $12, 8, $12 # [1-] + br $31, NEXTINSTRUCTION # [0di] +.end ReadRegisterConstantT +.align 5 +.globl ReadRegisterError +.ent ReadRegisterError 0 +.align 3 +ReadRegisterError: + bis $31, 0, $20 # [1-] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.end ReadRegisterError +.align 5 +.globl WriteRegisterFP +.ent WriteRegisterFP 0 +.align 3 +WriteRegisterFP: +#ifdef IVERIFY + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of the stack cache [1-] + ldl $1, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + subq $18, $2, $2 # Stack cache offset [2-] + cmpult $2, $1, $3 # In range? [1] + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + beq $3, BADREGISTER # J. if not in cache [0di] + s8addq $2, $1, $1 # reconstruct SCA [3-] + bis $1, $31, $10 # [1] + br $31, NEXTINSTRUCTION # [1-] +#else + bis $31, 0, $20 # [0di] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +#endif +.end WriteRegisterFP +.align 5 +.globl WriteRegisterLP +.ent WriteRegisterLP 0 +.align 3 +WriteRegisterLP: +#ifdef IVERIFY + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of the stack cache [1-] + ldl $1, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + subq $18, $2, $2 # Stack cache offset [2-] + cmpult $2, $1, $3 # In range? [1] + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + beq $3, BADREGISTER # J. if not in cache [0di] + s8addq $2, $1, $1 # reconstruct SCA [3-] + bis $1, $31, $11 # [1] + br $31, NEXTINSTRUCTION # [1-] +#else + bis $31, 0, $20 # [0di] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +#endif +.end WriteRegisterLP +.align 5 +.globl WriteRegisterSP +.ent WriteRegisterSP 0 +.align 3 +WriteRegisterSP: +#ifdef IVERIFY + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of the stack cache [1-] + ldl $1, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + subq $18, $2, $2 # Stack cache offset [2-] + cmpult $2, $1, $3 # In range? [1] + ldq $1, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + beq $3, BADREGISTER # J. if not in cache [0di] + s8addq $2, $1, $1 # reconstruct SCA [3-] + bis $1, $31, $12 # [1] + br $31, NEXTINSTRUCTION # [1-] +#else + bis $31, 0, $20 # [0di] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +#endif +.end WriteRegisterSP +.align 5 +.globl WriteRegisterStackCacheLowerBound +.ent WriteRegisterStackCacheLowerBound 0 +.align 3 +WriteRegisterStackCacheLowerBound: +#ifdef IVERIFY + stq $18, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldq $1, PROCESSORSTATE_STACKCACHESIZE($14) # [1] + addq $18, $1, $1 # [3] + stq $1, PROCESSORSTATE_STACKCACHETOPVMA($14) # [0di] + br $31, NEXTINSTRUCTION # [1] +#else + bis $31, 0, $20 # [0di] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +#endif +.end WriteRegisterStackCacheLowerBound +.align 5 +.globl WriteRegisterContinuation +.ent WriteRegisterContinuation 0 +.align 3 +WriteRegisterContinuation: + sll $17, 32, $19 # [1] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_CONTINUATION($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterContinuation +.align 5 +.globl WriteRegisterAluAndRotateControl +.ent WriteRegisterAluAndRotateControl 0 +.align 3 +WriteRegisterAluAndRotateControl: + srl $18, 14, $1 # [1-] + and $1, 3, $1 # Extract the function class bits [2] + stq $18, PROCESSORSTATE_ALUANDROTATECONTROL($14) # [1-] + srl $18, 5, $2 # [0di] + and $2, 31, $2 # Extract the byte size [2] + stq $1, PROCESSORSTATE_ALUOP($14) # [0di] + and $18, 31, $3 # Extract the Byte Rotate [1-] + stq $2, PROCESSORSTATE_BYTESIZE($14) # [0di] + stq $3, PROCESSORSTATE_BYTEROTATE($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterAluAndRotateControl +.align 5 +.globl WriteRegisterControlRegister +.ent WriteRegisterControlRegister 0 +.align 3 +WriteRegisterControlRegister: + stl $18, PROCESSORSTATE_CONTROL($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterControlRegister +.align 5 +.globl WriteRegisterEphemeralOldspaceRegister +.ent WriteRegisterEphemeralOldspaceRegister 0 +.align 3 +WriteRegisterEphemeralOldspaceRegister: + stq $31, PROCESSORSTATE_AC0ARRAY($14) # [1] + stq $31, PROCESSORSTATE_AC1ARRAY($14) # [1] + stq $31, PROCESSORSTATE_AC2ARRAY($14) # [1] + stq $31, PROCESSORSTATE_AC3ARRAY($14) # [1] + stq $31, PROCESSORSTATE_AC4ARRAY($14) # [1] + stq $31, PROCESSORSTATE_AC5ARRAY($14) # [1] + stq $31, PROCESSORSTATE_AC6ARRAY($14) # [1] + stq $31, PROCESSORSTATE_AC7ARRAY($14) # [1] + stl $18, PROCESSORSTATE_EPHEMERALOLDSPACE($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterEphemeralOldspaceRegister +.align 5 +.globl WriteRegisterZoneOldspaceRegister +.ent WriteRegisterZoneOldspaceRegister 0 +.align 3 +WriteRegisterZoneOldspaceRegister: + stl $18, PROCESSORSTATE_ZONEOLDSPACE($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterZoneOldspaceRegister +.align 5 +.globl WriteRegisterFPCoprocessorPresent +.ent WriteRegisterFPCoprocessorPresent 0 +.align 3 +WriteRegisterFPCoprocessorPresent: + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterFPCoprocessorPresent +.align 5 +.globl WriteRegisterPreemptRegister +.ent WriteRegisterPreemptRegister 0 +.align 3 +WriteRegisterPreemptRegister: + ldl $3, PROCESSORSTATE_INTERRUPTREG($14) # [1] + bic $3, 3, $3 # [3] + and $18, 3, $18 # [1] + bis $3, $18, $3 # [1] + stl $3, PROCESSORSTATE_INTERRUPTREG($14) # [1-] + blbc $3, NEXTINSTRUCTION # [1] + stq $3, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterPreemptRegister +.align 5 +.globl WriteRegisterStackCacheOverflowLimit +.ent WriteRegisterStackCacheOverflowLimit 0 +.align 3 +WriteRegisterStackCacheOverflowLimit: + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + extll $1, 0, $1 # [3] + subq $18, $1, $1 # [2] + stl $1, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterStackCacheOverflowLimit +.align 5 +.globl WriteRegisterTOS +.ent WriteRegisterTOS 0 +.align 3 +WriteRegisterTOS: + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterTOS +.align 5 +.globl WriteRegisterEventCount +.ent WriteRegisterEventCount 0 +.align 3 +WriteRegisterEventCount: + stq $18, PROCESSORSTATE_AREVENTCOUNT($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterEventCount +.align 5 +.globl WriteRegisterBindingStackPointer +.ent WriteRegisterBindingStackPointer 0 +.align 3 +WriteRegisterBindingStackPointer: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterBindingStackPointer +.align 5 +.globl WriteRegisterCatchBlockList +.ent WriteRegisterCatchBlockList 0 +.align 3 +WriteRegisterCatchBlockList: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_CATCHBLOCK($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterCatchBlockList +.align 5 +.globl WriteRegisterControlStackLimit +.ent WriteRegisterControlStackLimit 0 +.align 3 +WriteRegisterControlStackLimit: + stl $18, PROCESSORSTATE_CSLIMIT($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterControlStackLimit +.align 5 +.globl WriteRegisterControlStackExtraLimit +.ent WriteRegisterControlStackExtraLimit 0 +.align 3 +WriteRegisterControlStackExtraLimit: + stl $18, PROCESSORSTATE_CSEXTRALIMIT($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterControlStackExtraLimit +.align 5 +.globl WriteRegisterBindingStackLimit +.ent WriteRegisterBindingStackLimit 0 +.align 3 +WriteRegisterBindingStackLimit: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_BINDINGSTACKLIMIT($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterBindingStackLimit +.align 5 +.globl WriteRegisterListCacheArea +.ent WriteRegisterListCacheArea 0 +.align 3 +WriteRegisterListCacheArea: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_LCAREA($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterListCacheArea +.align 5 +.globl WriteRegisterListCacheAddress +.ent WriteRegisterListCacheAddress 0 +.align 3 +WriteRegisterListCacheAddress: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_LCADDRESS($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterListCacheAddress +.align 5 +.globl WriteRegisterListCacheLength +.ent WriteRegisterListCacheLength 0 +.align 3 +WriteRegisterListCacheLength: + stl $18, PROCESSORSTATE_LCLENGTH($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterListCacheLength +.align 5 +.globl WriteRegisterStructureCacheArea +.ent WriteRegisterStructureCacheArea 0 +.align 3 +WriteRegisterStructureCacheArea: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_SCAREA($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterStructureCacheArea +.align 5 +.globl WriteRegisterStructureCacheAddress +.ent WriteRegisterStructureCacheAddress 0 +.align 3 +WriteRegisterStructureCacheAddress: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_SCADDRESS($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterStructureCacheAddress +.align 5 +.globl WriteRegisterStructureCacheLength +.ent WriteRegisterStructureCacheLength 0 +.align 3 +WriteRegisterStructureCacheLength: + stl $18, PROCESSORSTATE_SCLENGTH($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterStructureCacheLength +.align 5 +.globl WriteRegisterDynamicBindingCacheBase +.ent WriteRegisterDynamicBindingCacheBase 0 +.align 3 +WriteRegisterDynamicBindingCacheBase: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_DBCBASE($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterDynamicBindingCacheBase +.align 5 +.globl WriteRegisterDynamicBindingCacheMask +.ent WriteRegisterDynamicBindingCacheMask 0 +.align 3 +WriteRegisterDynamicBindingCacheMask: + sll $17, 32, $19 # [1-] + bis $19, $18, $19 # construct the combined word [2] + stq $19, PROCESSORSTATE_DBCMASK($14) # [1-] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterDynamicBindingCacheMask +.align 5 +.globl WriteRegisterChoicePointer +.ent WriteRegisterChoicePointer 0 +.align 3 +WriteRegisterChoicePointer: + stl $18, PROCESSORSTATE_CHOICEPTR($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterChoicePointer +.align 5 +.globl WriteRegisterStructureStackChoicePointer +.ent WriteRegisterStructureStackChoicePointer 0 +.align 3 +WriteRegisterStructureStackChoicePointer: + stl $18, PROCESSORSTATE_SSTKCHOICEPTR($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterStructureStackChoicePointer +.align 5 +.globl WriteRegisterFEPModeTrapVectorAddress +.ent WriteRegisterFEPModeTrapVectorAddress 0 +.align 3 +WriteRegisterFEPModeTrapVectorAddress: + stl $18, PROCESSORSTATE_FEPMODETRAPVECADDRESS($14) # [1] + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterFEPModeTrapVectorAddress +.align 5 +.globl WriteRegisterMappingTableCache +.ent WriteRegisterMappingTableCache 0 +.align 3 +WriteRegisterMappingTableCache: + br $31, NEXTINSTRUCTION # [1] +.end WriteRegisterMappingTableCache +.align 5 +.globl WriteRegisterError +.ent WriteRegisterError 0 +.align 3 +WriteRegisterError: + bis $31, 0, $20 # [1-] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.end WriteRegisterError +/* Coprocessor read and write are implemented in C in order to */ +/* encourage creativity! The hooks are in aicoproc.c */ +.align 5 +.globl DoCoprocessorRead +.ent DoCoprocessorRead 0 +/* Halfword 10 bit immediate instruction - DoCoprocessorRead */ + .globl DoCoprocessorReadFP + .globl DoCoprocessorReadSP + .globl DoCoprocessorReadLP + .globl DoCoprocessorReadIM +.align 3 +DoCoprocessorRead: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoCoprocessorRead" +#endif +.align 3 +DoCoprocessorReadIM: +.align 3 +DoCoprocessorReadSP: +.align 3 +DoCoprocessorReadLP: +.align 3 +DoCoprocessorReadFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $0, PROCESSORSTATE_COPROCESSORREADHOOK($14) # [0di] + stq $13, PROCESSORSTATE_CP($14) # [1] + stq $9, PROCESSORSTATE_EPC($14) # [1] + stq $12, PROCESSORSTATE_SP($14) # [1] + stq $10, PROCESSORSTATE_FP($14) # [1] + stq $11, PROCESSORSTATE_LP($14) # [1] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + bis $0, $31, $27 # [0di] + jsr $26, ($0), 0 # [1-] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + ldq $13, PROCESSORSTATE_CP($14) # [1] + ldq $9, PROCESSORSTATE_EPC($14) # [1] + ldq $12, PROCESSORSTATE_SP($14) # [1] + ldq $10, PROCESSORSTATE_FP($14) # [1] + ldq $11, PROCESSORSTATE_LP($14) # [1] +/* Long -1 is never a valid LISP value */ + lda $1, -1 # [1-] + cmpeq $0, $1, $1 # [1] + bne $1, CPREADEXC # J. if CoprocessorRead exception return [1] + addq $12, 8, $12 # [0di] + sll $0, 26, $1 # [1] + srl $1, 26, $1 # [2] + stq $1, 0($12) # Push the result of coprocessor read! [1-] + br $31, NEXTINSTRUCTION # [1] +.align 3 +CPREADEXC: + bis $31, 0, $20 # [1-] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.end DoCoprocessorRead +/* End of Halfword operand from stack instruction - DoCoprocessorRead */ +.align 5 +.globl DoCoprocessorWrite +.ent DoCoprocessorWrite 0 +/* Halfword 10 bit immediate instruction - DoCoprocessorWrite */ + .globl DoCoprocessorWriteFP + .globl DoCoprocessorWriteSP + .globl DoCoprocessorWriteLP + .globl DoCoprocessorWriteIM +.align 3 +DoCoprocessorWrite: +/* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING + .byte 0xA0 + .asciiz "DoCoprocessorWrite" +#endif +.align 3 +DoCoprocessorWriteIM: +.align 3 +DoCoprocessorWriteSP: +.align 3 +DoCoprocessorWriteLP: +.align 3 +DoCoprocessorWriteFP: + extwl $18, 4, $16 # [1] +/* arg1 has operand preloaded. */ + ldq $17, 0($12) # The value to be written [0di] + subq $12, 8, $12 # Pop Stack. [1] + lda $2, CoprocessorRegisterUnwindStackForRestartOrApply # [1] + subq $16, $2, $2 # [1] + bne $2, G15322 # [1] +/* Here if argument CoprocessorRegisterUnwindStackForRestartOrApply */ + ldl $1, 0($12) # peek at new continuation to look at tag [1-] + ldl $2, 4($12) # [1] + extll $1, 0, $1 # [2-] + subq $2, TypeEvenPC, $3 # [1] + and $3, 62, $3 # Strip CDR code, low bits [1] + bne $3, UNWINDILLEGALCONTINUATION # [1] + ldq $1, 0($12) # Get new continuation [1-] + subq $12, 8, $12 # Pop Stack. [1] + stq $1, PROCESSORSTATE_CONTINUATION($14) # Update continuation register [1-] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [1] + ldl $1, 0($12) # Get new FP [1] + ldl $2, 4($12) # Get new FP [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [1] + subq $2, TypeLocative, $3 # [1] + and $3, 63, $3 # Strip CDR code [1] + bne $3, UNWINDILLEGALFP # [1] +/* Convert VMA to stack cache address */ + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [0di] + ldq $10, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $2, $2 # stack cache base relative offset [2di] + s8addq $2, $10, $10 # reconstruct SCA [1] + ldl $1, 0($12) # Get new LP [0di] + ldl $2, 4($12) # Get new LP [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [1] + subq $2, TypeLocative, $3 # [1] + and $3, 63, $3 # Strip CDR code [1] + bne $3, UNWINDILLEGALLP # [1] +/* Convert VMA to stack cache address */ + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldq $11, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $1, $2, $2 # stack cache base relative offset [2-] + s8addq $2, $11, $11 # reconstruct SCA [1] +/* Update CDR-CODEs to make it a legitimate frame */ + ldl $1, 4($10) # Tag of saved continuation register [1-] + ldl $2, 12($10) # Tag of saved control register [1] + bis $1, 192, $1 # Set CDR-CODE to 3 [2-] + stl $1, 4($10) # Put it back [0di] + bis $2, 192, $2 # Set CDR-CODE to 3 [1-] + stl $2, 12($10) # Put it back [0di] +/* Copy the current trap-on-exit bit into the saved control register */ + ldl $1, PROCESSORSTATE_CONTROL($14) # Get control register [1] + ldl $2, 8($10) # Get saved control register [1] + extll $2, 0, $2 # [3] + ldah $3, 256 # [1] + bic $2, $3, $2 # Remove saved control register's trap-on-exit bit [1] + and $1, $3, $1 # Extract control register's trap-on-exit bit [1] + bis $2, $1, $2 # Copy it into saved control register [1] + stl $2, 8($10) # Update saved control register [0di] +/* Restore the new control register with proper trap mode */ + ldl $1, 0($12) # peek at new control register to look at tag [1] + ldl $2, 4($12) # [1] + extll $1, 0, $1 # [2-] + subq $2, TypeFixnum, $3 # [1] + and $3, 63, $3 # Strip CDR code [1] + bne $3, UNWINDILLEGALCONTROL # [1] + ldl $1, 0($12) # Get new control register [1-] + subq $12, 8, $12 # Pop Stack. [1] + extll $1, 0, $1 # [2] + stl $1, PROCESSORSTATE_CONTROL($14) # [0di] + br $31, G15321 # [1] +.align 3 +G15322: + lda $2, CoprocessorRegisterFlushIDCaches # [1-] + subq $16, $2, $2 # [1] + bne $2, G15323 # [1] +/* Here if argument CoprocessorRegisterFlushIDCaches */ +/* We're about to flush the instruction cache so we can't rely */ +/* on ContinueToNextInstruction working. Instead, we must load */ +/* the next PC now and explicitly fill the cache. */ + ldq $9, CACHELINE_NEXTPCDATA($13) # [0di] + ldq $1, PROCESSORSTATE_FLUSHCACHES_HOOK($14) # [1] + stq $13, PROCESSORSTATE_CP($14) # [1] + stq $9, PROCESSORSTATE_EPC($14) # [1] + stq $12, PROCESSORSTATE_SP($14) # [1] + stq $10, PROCESSORSTATE_FP($14) # [1] + stq $11, PROCESSORSTATE_LP($14) # [1] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + bis $1, $31, $27 # [1-] + jsr $26, ($1), 0 # [0di] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + ldq $13, PROCESSORSTATE_CP($14) # [1] + ldq $9, PROCESSORSTATE_EPC($14) # [1] + ldq $12, PROCESSORSTATE_SP($14) # [1] + ldq $10, PROCESSORSTATE_FP($14) # [1] + ldq $11, PROCESSORSTATE_LP($14) # [1] +/* Compute proper iCP after FlushCaches resets it. */ + br $31, ICACHEMISS + br $31, G15321 # [1] +.align 3 +G15323: + lda $2, CoprocessorRegisterFlushCachesForVMA # [1-] + subq $16, $2, $2 # [1] + bne $2, G15324 # [1] +/* Here if argument CoprocessorRegisterFlushCachesForVMA */ + extll $17, 0, $17 # Extract the VMA [0di] + sll $17, 1, $1 # convert continuation to an even pc [2] +/* Convert a halfword address into a CP pointer. */ + srl $1, CacheLineRShift, $2 # Get third byte into bottom [2] + ldq $4, PROCESSORSTATE_ICACHEBASE($14) # get the base of the icache [1-] + lda $3, -1 # [0di] + ldah $3, 4($3) # [1] + sll $2, CacheLineLShift, $2 # Now third byte is zero-shifted [1] + addq $1, $2, $2 # [2] + and $2, $3, $2 # [1] + sll $2, 5, $3 # temp=cpos*32 [1] + sll $2, 4, $2 # cpos=cpos*16 [1] + addq $4, $3, $4 # temp2=base+cpos*32 [1] + addq $4, $2, $2 # cpos=base+cpos*48 [1] + ldq $3, CACHELINE_PCDATA($2) # [2] + cmpeq $1, $3, $3 # Is this VMA in the cache? [3] + beq $3, DCWNOTINCACHE # No. [1] + stq $31, CACHELINE_PCDATA($2) # Yes, flush it [1] + stq $31, CACHELINE_PCDATA+CACHELINESIZE($2) # [1] +.align 3 +DCWNOTINCACHE: + br $31, G15321 # [1] +.align 3 +G15324: + lda $2, CoprocessorRegisterFlushHiddenArrayRegisters # [1-] + subq $16, $2, $2 # [1] + bne $2, G15325 # [1] +/* Here if argument CoprocessorRegisterFlushHiddenArrayRegisters */ + extll $17, 0, $17 # Get the VMA of the new stack array [0di] + lda $8, AutoArrayRegMask # [1] + and $17, $8, $8 # [1] + lda $7, PROCESSORSTATE_AC0ARRAY($14) # [1] + addq $7, $8, $7 # Here is our array register block [1] + ldq $8, ARRAYCACHE_ARRAY($7) # And here is the cached array [2] + cmpeq $17, $8, $8 # t8==1 iff cached array is ours [3] + beq $8, ARRAYNOTINCACHE # [1] + stq $31, ARRAYCACHE_ARRAY($7) # Flush it [1] +.align 3 +ARRAYNOTINCACHE: + br $31, G15321 # [1] +.align 3 +G15325: +/* Here for all other cases */ +/* Standard coprocessor register processing */ + ldq $0, PROCESSORSTATE_COPROCESSORWRITEHOOK($14) # [1] + stq $13, PROCESSORSTATE_CP($14) # [1] + stq $9, PROCESSORSTATE_EPC($14) # [1] + stq $12, PROCESSORSTATE_SP($14) # [1] + stq $10, PROCESSORSTATE_FP($14) # [1] + stq $11, PROCESSORSTATE_LP($14) # [1] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + bis $0, $31, $27 # [1-] + jsr $26, ($0), 0 # [0di] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + ldq $13, PROCESSORSTATE_CP($14) # [1] + ldq $9, PROCESSORSTATE_EPC($14) # [1] + ldq $12, PROCESSORSTATE_SP($14) # [1] + ldq $10, PROCESSORSTATE_FP($14) # [1] + ldq $11, PROCESSORSTATE_LP($14) # [1] + beq $0, CPREADEXC # J. if CoprocessorWrite exception return [0di] + br $31, G15321 # [1] +.align 3 +G15326: +.align 3 +G15321: + br $31, NEXTINSTRUCTION # [1] +.align 3 +UNWINDILLEGALCONTINUATION: + bis $31, 0, $20 # [1-] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +UNWINDILLEGALCONTROL: + bis $31, 0, $20 # [1] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +UNWINDILLEGALFP: + bis $31, 0, $20 # [1] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +UNWINDILLEGALLP: + bis $31, 0, $20 # [1] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +CPWRITEEXC: + bis $31, 0, $20 # [1] + bis $31, 84, $17 # [1] + br $31, ILLEGALOPERAND +.end DoCoprocessorWrite +/* End of Halfword operand from stack instruction - DoCoprocessorWrite */ +.align 5 +.globl GetRPCC +.ent GetRPCC 2 +.align 3 +GetRPCC: + .frame $30, 0, $26 + rpcc $0 # [1-] + sll $0, 32, $16 # [0di] + addq $0, $16, $16 # [2] + srl $16, 32, $0 # [1] + ret $31, ($26), 1 # [1-] +.end GetRPCC +.align 5 +.globl SpinWheels +.ent SpinWheels 1 +.align 3 +SpinWheels: + .frame $30, 0, $26 + bis $31, 1, $16 # [3] + sll $16, 25, $16 # [1] +.align 3 +SPINWHEELAXIS: + addq $16, -1, $16 # [2] + bgt $16, SPINWHEELAXIS # [1] + ret $31, ($26), 1 # [1] +.end SpinWheels +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifunsubp.as */ diff --git a/alpha-emulator/ifuntran.as b/alpha-emulator/ifuntran.as new file mode 100644 index 0000000..a55786c --- /dev/null +++ b/alpha-emulator/ifuntran.as @@ -0,0 +1,63 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(define-procedure |NativeException| () + (LDQ t1 PROCESSORSTATE_LINKAGE (Ivory) "Load linkage to escape block") + (LDQ r0 PROCESSORSTATE_RESUMEEMA (Ivory) "Re-load resumemulator") + (LDQ iSP PROCESSORSTATE_RESTARTSP (Ivory) "Restore SP (Just in case?)") + (stq zero PROCESSORSTATE_LINKAGE (ivory)) + (RET zero t1 0 "Escape")) + +;;; In Q3, get to top of Q4. + +(align4kSkip4k) ; Q3 + +(define-procedure |PadPastAref1| () + (LDQ t1 PROCESSORSTATE_LINKAGE (Ivory) "Load linkage to escape block") + (LDQ r0 PROCESSORSTATE_RESUMEEMA (Ivory) "Re-load resumemulator") + (LDQ iSP PROCESSORSTATE_RESTARTSP (Ivory) "Restore SP (Just in case?)") + (stq zero PROCESSORSTATE_LINKAGE (ivory)) + (LDQ t1 PROCESSORSTATE_LINKAGE (Ivory) "Load linkage to escape block") + (LDQ r0 PROCESSORSTATE_RESUMEEMA (Ivory) "Re-load resumemulator") + (LDQ iSP PROCESSORSTATE_RESTARTSP (Ivory) "Restore SP (Just in case?)") + (stq zero PROCESSORSTATE_LINKAGE (ivory)) + (RET zero t1 0 "Escape")) + +(define-subroutine |CarSubroutine| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + ;; --- make part of define-translator-subroutine + (stq r0 PROCESSORSTATE_LINKAGE (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (ADDQ r0 4 r0) + (STQ iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (BSR r0 |CarInternal|) + ;; --- make part of define-translator-subroutine + (stq zero PROCESSORSTATE_LINKAGE (ivory)) + )) + +(define-subroutine |CdrSubroutine| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + ;; --- make part of define-translator-subroutine + (stq r0 PROCESSORSTATE_LINKAGE (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (ADDQ r0 4 r0) + (STQ iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (BSR r0 |CdrInternal|) + ;; --- make part of define-translator-subroutine + (stq zero PROCESSORSTATE_LINKAGE (ivory)) + )) + +(define-subroutine |CarCdrSubroutine| + (t1 t2 arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + ;; --- make part of define-translator-subroutine + (stq r0 PROCESSORSTATE_LINKAGE (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (ADDQ r0 4 r0) + (STQ iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (BSR r0 |CarCdrInternal|) + ;; --- make part of define-translator-subroutine + (stq zero PROCESSORSTATE_LINKAGE (ivory)) + )) + diff --git a/alpha-emulator/ifuntran.s b/alpha-emulator/ifuntran.s new file mode 100644 index 0000000..5877edb --- /dev/null +++ b/alpha-emulator/ifuntran.s @@ -0,0 +1,94 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuntran.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +.align 5 +.globl NativeException +.ent NativeException 0 +.align 3 +NativeException: + ldq $1, PROCESSORSTATE_LINKAGE($14) # Load linkage to escape block [1] + ldq $0, PROCESSORSTATE_RESUMEEMA($14) # Re-load resumemulator [1] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # Restore SP (Just in case?) [1] + stq $31, PROCESSORSTATE_LINKAGE($14) # [1] + ret $31, ($1), 0 # Escape [1] +.end NativeException +.align 12 + and $31, $31, $31 # [3] +.align 12 +.align 5 +.globl PadPastAref1 +.ent PadPastAref1 0 +.align 3 +PadPastAref1: + ldq $1, PROCESSORSTATE_LINKAGE($14) # Load linkage to escape block [1-] + ldq $0, PROCESSORSTATE_RESUMEEMA($14) # Re-load resumemulator [1] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # Restore SP (Just in case?) [1] + stq $31, PROCESSORSTATE_LINKAGE($14) # [1] + ldq $1, PROCESSORSTATE_LINKAGE($14) # Load linkage to escape block [1] + ldq $0, PROCESSORSTATE_RESUMEEMA($14) # Re-load resumemulator [1] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # Restore SP (Just in case?) [1] + stq $31, PROCESSORSTATE_LINKAGE($14) # [1] + ret $31, ($1), 0 # Escape [1] +.end PadPastAref1 +.align 5 +.globl CarSubroutine +.ent CarSubroutine 11 +.align 3 +CarSubroutine: + lda $30, -8($30) # [1-] + .frame $30, 8, $0 + stq $0, PROCESSORSTATE_LINKAGE($14) # [0di] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + addq $0, 4, $0 # [1-] + stq $12, PROCESSORSTATE_RESTARTSP($14) # [0di] + stq $0, 0($30) # [1] + bsr $0, CarInternal + ldq $0, 0($30) # [1] + stq $31, PROCESSORSTATE_LINKAGE($14) # [1] + lda $30, 8($30) # [0di] + ret $31, ($0), 1 # [2-] +.end CarSubroutine +.align 5 +.globl CdrSubroutine +.ent CdrSubroutine 11 +.align 3 +CdrSubroutine: + lda $30, -8($30) # [1-] + .frame $30, 8, $0 + stq $0, PROCESSORSTATE_LINKAGE($14) # [0di] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + addq $0, 4, $0 # [1-] + stq $12, PROCESSORSTATE_RESTARTSP($14) # [0di] + stq $0, 0($30) # [1] + bsr $0, CdrInternal + ldq $0, 0($30) # [1] + stq $31, PROCESSORSTATE_LINKAGE($14) # [1] + lda $30, 8($30) # [0di] + ret $31, ($0), 1 # [2-] +.end CdrSubroutine +.align 5 +.globl CarCdrSubroutine +.ent CarCdrSubroutine 13 +.align 3 +CarCdrSubroutine: + lda $30, -8($30) # [1-] + .frame $30, 8, $0 + stq $0, PROCESSORSTATE_LINKAGE($14) # [0di] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + ldl $25, PROCESSORSTATE_SCOVLIMIT($14) # Size of the stack cache (words) [1] + addq $0, 4, $0 # [1-] + stq $12, PROCESSORSTATE_RESTARTSP($14) # [0di] + stq $0, 0($30) # [1] + bsr $0, CarCdrInternal + ldq $0, 0($30) # [1] + stq $31, PROCESSORSTATE_LINKAGE($14) # [1] + lda $30, 8($30) # [0di] + ret $31, ($0), 1 # [2-] +.end CarCdrSubroutine + + +/* End of file automatically generated from ../alpha-emulator/ifuntran.as */ diff --git a/alpha-emulator/ifuntrap.as b/alpha-emulator/ifuntrap.as new file mode 100644 index 0000000..1ba5573 --- /dev/null +++ b/alpha-emulator/ifuntrap.as @@ -0,0 +1,216 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +(include-header "traps.s") +;(include-header "ifunhead.s") + + +;;; Shared Tail Calls + +(define-procedure DecodeFault () + (comment "We come here when a memory access faults to figure out why") + ;;+++ probably can elide this and just pass VMA in argX + (LDQ t1 PROCESSORSTATE_VMA (ivory) "retrieve the trapping VMA") + (check-access t1 t2 t3 PageNotResident PageFaultRequestHandler + PageWriteFault TransportTrap) + (external-branch BusError)) + +(define-procedure HANDLEUNWINDPROTECT () + (do-unwind-protect arg1 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12)) + +(define-procedure PerformMemoryAction () + (comment "We get here when a memory action that will trap is detected.") + (comment "ARG1 contains the memory action code with the Transport bit removed.") + (comment "ARG2 contains the memory cycle so we can generate the proper microstate.") + (basic-dispatch arg1 t1 + (|MemoryActionTrap| + (LDQ t1 PROCESSORSTATE_VMA (ivory) "Get the failing VMA") + (basic-dispatch arg2 t2 + (|CycleDataRead| + (illegal-operand (memory-data-error data-read) t1)) + (|CycleDataWrite| + (illegal-operand (memory-data-error data-write) t1)) + ((|CycleBindRead| |CycleBindReadNoMonitor|) + (illegal-operand (memory-data-error bind-read) t1)) + ((|CycleBindWrite| |CycleBindWriteNoMonitor|) + (illegal-operand (memory-data-error bind-write) t1)) + ((|CycleHeader| |CycleStructureOffset|) + (illegal-operand (memory-data-error header-read) t1)) + ((|CycleScavenge| |CycleGCCopy|) + (illegal-operand (memory-data-error scavenge) t1)) + (|CycleCdr| + (illegal-operand (memory-data-error cdr-read) t1)))) + (|MemoryActionMonitor| + (external-branch MonitorTrap)))) + + +;;; Exception Handlers. + +;;; These all come from IFUNCOM1 and IFUNCOM2 +(define-procedure |OutOfLineExceptions| () + (label LdbException) + (NumericTypeException arg3 ldb) + (label RplacaException) + (ListTypeException t1 rplaca arg1) + (label RplacdException) + (ListTypeException t1 rplacd arg1) + (label PushIVException) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception push-instance-variable 0 t1 t2) + (instruction-exception) + (label IncrementException) + (UnaryNumericTypeException arg2 increment arg1) + (label DecrementException) + (UnaryNumericTypeException arg2 decrement arg1)) + +;;; Common code for dispatching between exception or illegal operand. +;;; PREPARE-EXCEPTION has set up exception dispatching info, includeing +;;; TAG in arg6 +(define-procedure NumericException () + (CheckAdjacentDataTypes arg6 |TypeFixnum| 8 notnumeric t1) + (instruction-exception "Numeric") + (label notnumeric) + (illegal-operand binary-arithmetic-operand-type-error)) + +(define-procedure UnaryNumericException () + (CheckAdjacentDataTypes arg6 |TypeFixnum| 8 unarynotnumeric t1) + (instruction-exception "Numeric") + (label unarynotnumeric) + (illegal-operand unary-arithmetic-operand-type-error)) + +(define-procedure ListException () + (CheckDataType arg6 |TypeList| notlist1 t1) + (instruction-exception "List") + (label notlist1) + (CheckDataType arg6 |TypeListInstance| notlist2 t1) + (instruction-exception "List Instance") + (label notlist2) + ;; SET-TO-CAR-CDR-LIST-TYPE-ERROR is decoded exactly the same way + (illegal-operand car-cdr-list-type-error)) + +(define-procedure ArrayException () + (CheckAdjacentDataTypes arg6 |TypeArray| 2 notarray1 t1) + (instruction-exception "Array") + (label notarray1) + (CheckAdjacentDataTypes arg6 |TypeArrayInstance| 2 notarray2 t1) + (instruction-exception "Array Instance") + (label notarray2) + (external-branch SpareException)) + +(define-procedure SpareException () + (CheckAdjacentDataTypes arg6 |TypeSparePointer1| 2 notspare1 t1) + (instruction-exception "Spare Pointer") + (label notspare1) +; Spare-immediate-1 usurped for native-mode instructions +; (CheckDataType arg6 |TypeSpareImmediate1| notspare2 t1) +; (instruction-exception "Spare Immediate") + (label notspare2) + (CheckDataType arg6 |TypeSpareNumber| notspare3 t1) + (instruction-exception "Spare Number") + (label notspare3) + ;; If we get here, the prepare-trap should already have been done, + ;; all we have to do is take it! + (external-branch illegaloperand "Must be illegal op after all")) + +(define-procedure Exception () + (BNE arg4 ArithmeticException "J. if arithmetic exception") + (exception-handler nil t11 t12 |HandleException|) + ;; + ;; must define label arex directly before the + ;; arithmetic exception handler + ;; gcc code generation won't set the right context + ;; otherwise... + ;; + (label "arex")) + +(define-procedure ArithmeticException () + (exception-handler :arithmetic t11 t12 |HandleException|)) + +(define-procedure LoopException () + (exception-handler :loop t11 t12 |HandleException|)) + +(define-procedure |HandleException| (t11 arg1 t12) + (exception-handler-common-tail t11 arg1 t12)) + + +;;; Trap handlers + +(define-procedure StackOverflow () + (stack-overflow-handler)) + + +(define-procedure |StartPreTrap| () + (start-pre-trap t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (RET zero R0 1)) + +(define-procedure |FinishPreTrap| () + ;; Exits via InterpretInstruction + (finish-pre-trap t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + + +;; Microstate is in ARG2, VMA is in ARG5. C.f., prepare-exception which +;; puts the opcode in ARG2 and vma in arg5 (but computes them in +;; exception-handler, so they are free for us) +(define-procedure IllegalOperand () + (illegal-operand-handler)) + +(define-procedure ResetTrap () + (reset-trap-handler)) + +;; Number of args to pull is in ARG1 +(define-procedure PullApplyArgsTrap () + (pull-apply-args-trap-handler arg1 arg2)) + +(define-procedure TraceTrap () + (trace-trap-handler)) + +(define-procedure PreemptRequestTrap () + (preempt-request-trap-handler)) + +(define-procedure HighPrioritySequenceBreak () + (high-priority-sequence-break-handler)) + +(define-procedure LowPrioritySequenceBreak () + (low-priority-sequence-break-handler)) + +(define-procedure DBUnwindFrameTrap () + (db-unwind-frame-trap-handler)) + +(define-procedure DBUnwindCatchTrap () + (db-unwind-catch-trap-handler)) + + +(define-procedure TransportTrap () + (transport-trap-handler)) + +(define-procedure MonitorTrap () + (monitor-trap-handler)) + +(define-procedure PageNotResident () + (page-not-resident-handler)) + +(define-procedure PageFaultRequestHandler () + (page-fault-request-handler)) + +(define-procedure PageWriteFault () + (page-write-fault-handler)) + +(passthru "#ifdef MINIMA") +(define-procedure DBCacheMissTrap () + (db-cache-miss-trap-handler)) +(passthru "#endif") + +(comment "The following handlers should never be invoked.") + +(align4kskip4k) + +(define-procedure UncorrectableMemoryError () + (uncorrectable-memory-error-handler)) + +(define-procedure BusError () + (bus-error-handler)) + +(comment "Fin.") diff --git a/alpha-emulator/ifuntrap.s b/alpha-emulator/ifuntrap.s new file mode 100644 index 0000000..5360ee0 --- /dev/null +++ b/alpha-emulator/ifuntrap.s @@ -0,0 +1,1843 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuntrap.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +#include "traps.s" +.align 5 +.globl DECODEFAULT +.ent DECODEFAULT 0 +.align 3 +DECODEFAULT: +/* We come here when a memory access faults to figure out why */ + ldq $1, PROCESSORSTATE_VMA($14) # retrieve the trapping VMA [1] + ldq $3, PROCESSORSTATE_VMATTRIBUTETABLE($14) # Per-page attributes table [1] + srl $1, MemoryPageAddressShift, $2 # Index into the attributes table [2-] + addq $2, $3, $3 # Address of the page's attributes [2] + ldq_u $2, 0($3) # Get the quadword with the page's attributes [2] + stq $1, PROCESSORSTATE_VMA($14) # Stash the VMA [1] + extbl $2, $3, $2 # Extract the page's attributes [2-] + beq $2, PAGENOTRESIDENT # Non-existent page [2] + and $2, VMAttributeAccessFault, $3 # [1-] + bne $3, PAGEFAULTREQUESTHANDLER # Access fault [1] + and $2, VMAttributeTransportFault, $3 # [1] + bne $3, TRANSPORTTRAP # Transport fault [1] + and $2, VMAttributeWriteFault, $3 # [1] + bne $3, PAGEWRITEFAULT # Write fault [1] + br $31, BUSERROR +.end DECODEFAULT +.align 5 +.globl HANDLEUNWINDPROTECT +.ent HANDLEUNWINDPROTECT 0 +.align 3 +HANDLEUNWINDPROTECT: + ldl $4, PROCESSORSTATE_CATCHBLOCK($14) # [1-] + extll $4, 0, $4 # [3] +/* Convert VMA to stack cache address */ + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $4, $2, $2 # stack cache base relative offset [2-] + s8addq $2, $3, $3 # reconstruct SCA [1] + ldl $6, 16($3) # [2] + ldl $5, 20($3) # [1] + extll $6, 0, $6 # [2-] + ldl $2, 8($3) # [0di] + ldl $1, 12($3) # [1] + extll $2, 0, $2 # [2di] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # Restore SP [1-] + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] +#ifdef MINIMA + srl $1, 32, $4 # [3] +#endif + subl $1, $2, $3 # [1] + beq $3, G15864 # J. if binding level= binding stack [1] +#ifdef MINIMA +/* BSP not a locative -> Deep-bound */ + subq $4, TypeLocative, $3 # [1] + and $3, 63, $3 # Strip CDR code [1] + bne $3, DBUNWINDFRAMETRAP # [1] +#endif +.align 3 +G15865: + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1-] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1] + extll $1, 0, $1 # vma only [2-] + ldah $16, 512 # [1] + subq $1, 1, $5 # [1] + and $4, $16, $3 # [1] + bic $4, $16, $4 # Turn off the bit [1] + bne $3, G15866 # [0di] + ldq $4, PROCESSORSTATE_RESTARTSP($14) # Get the SP, ->op2 [1-] + bis $31, 0, $20 # [0di] + bis $31, 20, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15866: +/* Memory Read Internal */ +G15867: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1-] + addq $1, $14, $23 # [0di] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $23, $31, $6 # [0di] + ldq_u $7, 0($23) # [1-] + subq $1, $8, $8 # Stack cache offset [1di] + ldq $24, PROCESSORSTATE_BINDREAD_MASK($14) # [1-] + cmpult $8, $22, $22 # In range? [0di] + ldl $6, 0($6) # [1-] + extbl $7, $23, $7 # [0di] + bne $22, G15869 # [1-] +G15868: + lda $23, 224 # [0di] + srl $24, $7, $24 # [1] + srl $23, $7, $23 # [1] + blbs $24, G15871 # [1-] +G15876: +/* Memory Read Internal */ +G15877: + ldq $8, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $5, $14, $23 # [1-] + ldl $22, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $23, $31, $16 # [1-] + ldq_u $3, 0($23) # [1di] + subq $5, $8, $8 # Stack cache offset [1-] + ldq $24, PROCESSORSTATE_BINDREAD_MASK($14) # [0di] + cmpult $8, $22, $22 # In range? [1-] + ldl $16, 0($16) # [0di] + extbl $3, $23, $3 # [1-] + bne $22, G15879 # [0di] +G15878: + lda $23, 224 # [1-] + srl $24, $3, $24 # [1] + srl $23, $3, $23 # [1] + extll $16, 0, $16 # [1] + blbs $24, G15881 # [1-] +G15886: +/* Memory Read Internal */ +G15887: + ldq $23, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] + addq $16, $14, $25 # [1-] + ldl $24, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $25, $31, $22 # [1-] + ldq_u $8, 0($25) # [1di] + subq $16, $23, $23 # Stack cache offset [1-] + cmpult $23, $24, $24 # In range? [1] + ldl $22, 0($22) # [1-] + extbl $8, $25, $8 # [0di] + bne $24, G15889 # [1-] +G15888: + ldq $23, PROCESSORSTATE_BINDWRITE_MASK($14) # [0di] + lda $25, 224 # [1-] + srl $23, $8, $23 # [2] + srl $25, $8, $25 # [1] + blbs $23, G15891 # [1di] +G15896: +/* Merge cdr-code */ + and $7, 63, $22 # [1-] + and $8, 192, $8 # [1] + bis $8, $22, $8 # [1] + addq $16, $14, $23 # [1] + s4addq $23, $31, $22 # [1] + ldq_u $25, 0($23) # [1di] + insbl $8, $23, $24 # [1-] + mskbl $25, $23, $25 # [2] +.align 3 +G15899: + bis $25, $24, $25 # [2] + ldq $24, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + stq_u $25, 0($23) # [1] + ldl $23, PROCESSORSTATE_SCOVLIMIT($14) # [1] + subq $16, $24, $24 # Stack cache offset [1-] + cmpult $24, $23, $23 # In range? [2] + stl $6, 0($22) # [1-] + bne $23, G15898 # J. if in cache [1] +G15897: + and $3, 64, $3 # Get the old cleanup-bindings bit [1-] + sll $3, 19, $3 # [1] + subq $1, 2, $1 # [1] + stl $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # vma only [0di] + bis $4, $3, $4 # [1-] + stl $4, PROCESSORSTATE_CONTROL($14) # [0di] + ldq $1, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1] + subl $1, $2, $3 # [3] + bne $3, G15865 # J. if binding level/= binding stack [1] + ldl $2, PROCESSORSTATE_INTERRUPTREG($14) # [0di] + and $2, 2, $3 # [3] + cmpeq $3, 2, $3 # [1] + bis $2, $3, $2 # [2] + stl $2, PROCESSORSTATE_INTERRUPTREG($14) # [0di] + beq $2, G15864 # [1] + stq $2, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] +.align 3 +G15864: # Push PC with cleanup bits in CDR +/* Convert PC to a real continuation. */ + and $9, 1, $3 # [1-] + srl $9, 1, $1 # convert PC to a real word address. [1] + lda $3, TypeEvenPC($3) # [1] + ldl $16, PROCESSORSTATE_CONTROL($14) # [0di] + srl $16, 17, $2 # [3] + bis $2, 128, $2 # [2] + and $2, 192, $2 # [1] +/* TagType. */ + and $3, 63, $3 # [1] + bis $3, $2, $3 # [1] + stl $1, 8($12) # [0di] + stl $3, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] +/* Load catch-block PC */ + ldl $4, PROCESSORSTATE_CATCHBLOCK($14) # [1-] + extll $4, 0, $4 # [3] +/* Convert VMA to stack cache address */ + ldq $2, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1-] + ldq $3, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + subq $4, $2, $2 # stack cache base relative offset [2-] + s8addq $2, $3, $3 # reconstruct SCA [1] + ldl $6, 0($3) # [2] + ldl $5, 4($3) # [1] + extll $6, 0, $6 # [2-] +/* Convert real continuation to PC. */ + and $5, 1, $9 # [1] + addq $6, $9, $9 # [1] + addq $6, $9, $9 # [1] + ldah $1, 128 # [1] + bis $16, $1, $16 # [1] + ldl $23, 16($3) # [1-] + ldl $5, 20($3) # [1] + extll $23, 0, $23 # [2-] + and $5, 128, $6 # This is the extra-arg bit [1] + ldl $8, PROCESSORSTATE_EXTRAANDCATCH($14) # [1-] + and $5, 64, $7 # This is the cleanup-catch bit [0di] + sll $6, 1, $6 # Shift bit into place for cr [1] + sll $7, 20, $7 # Shift extra arg bit into place for cr [1] + bic $16, $8, $16 # [1] + bis $6, $7, $6 # [1] + bis $16, $6, $16 # update the bits extra-arg/cleanupcatch [1] + stl $16, PROCESSORSTATE_CONTROL($14) # [0di] +/* TagType. */ + and $5, 63, $5 # [1-] + sll $5, 32, $5 # [1] + bis $5, $23, $5 # [2] + stq $5, PROCESSORSTATE_CATCHBLOCK($14) # [0di] + br $31, INTERPRETINSTRUCTIONFORBRANCH # Execute cleanup [1] +#ifdef MINIMA +.align 3 +DBUNWINDFRAMETRAP: + br $31, DBUNWINDFRAMETRAP # Tail call for deep-bound trap +#endif +.align 3 +G15898: + ldq $23, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $24, $23, $23 # reconstruct SCA [3] + stl $6, 0($23) # Store in stack [2] + stl $8, 4($23) # write the stack cache [1] + br $31, G15897 # [1] +.align 3 +G15889: + ldq $24, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $23, $24, $23 # reconstruct SCA [3] + ldl $22, 0($23) # [2] + ldl $8, 4($23) # Read from stack cache [1] + br $31, G15888 # [1] +.align 3 +G15891: + blbc $25, G15890 # [1] + extll $22, 0, $16 # Do the indirect thing [0di] + br $31, G15887 # [1-] +.align 3 +G15890: + ldq $23, PROCESSORSTATE_BINDWRITE($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $8, 63, $25 # Discard the CDR code [0di] + stq $16, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $25, $23, $25 # Adjust for a longword load [2di] + ldl $23, 0($25) # Get the memory action [2] +G15893: +/* Perform memory action */ + bis $31, $23, $16 # [3] + bis $31, 3, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15879: + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $22, $8 # reconstruct SCA [3] + ldl $16, 0($8) # [2] + ldl $3, 4($8) # Read from stack cache [1] + br $31, G15878 # [1] +.align 3 +G15881: + blbc $23, G15880 # [1] + extll $16, 0, $5 # Do the indirect thing [0di] + br $31, G15877 # [1-] +.align 3 +G15880: + ldq $24, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $3, 63, $23 # Discard the CDR code [0di] + stq $5, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +G15883: +/* Perform memory action */ + bis $31, $24, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15869: + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + s8addq $8, $22, $8 # reconstruct SCA [3] + ldl $6, 0($8) # [2] + ldl $7, 4($8) # Read from stack cache [1] + br $31, G15868 # [1] +.align 3 +G15871: + blbc $23, G15870 # [1] + extll $6, 0, $1 # Do the indirect thing [0di] + br $31, G15867 # [1-] +.align 3 +G15870: + ldq $24, PROCESSORSTATE_BINDREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $7, 63, $23 # Discard the CDR code [0di] + stq $1, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $23, $24, $23 # Adjust for a longword load [2di] + ldl $24, 0($23) # Get the memory action [2] +G15873: +/* Perform memory action */ + bis $31, $24, $16 # [3] + bis $31, 2, $17 # [1] + br $31, PERFORMMEMORYACTION +.end HANDLEUNWINDPROTECT +.align 5 +.globl PERFORMMEMORYACTION +.ent PERFORMMEMORYACTION 0 +.align 3 +PERFORMMEMORYACTION: +/* We get here when a memory action that will trap is detected. */ +/* ARG1 contains the memory action code with the Transport bit removed. */ +/* ARG2 contains the memory cycle so we can generate the proper microstate. */ + cmpeq $16, MemoryActionTrap, $1 # [1] +.align 3 +G15928: + beq $1, G15901 # [1] +/* Here if argument MemoryActionTrap */ + ldq $1, PROCESSORSTATE_VMA($14) # Get the failing VMA [1] + cmpeq $17, CycleDataRead, $2 # [1-] +.align 3 +G15915: + beq $2, G15903 # [1] +/* Here if argument CycleDataRead */ + bis $31, $1, $20 # [1di] + bis $31, 57, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15903: + cmpeq $17, CycleDataWrite, $2 # [1] +.align 3 +G15916: + beq $2, G15904 # [1] +/* Here if argument CycleDataWrite */ + bis $31, $1, $20 # [0di] + bis $31, 58, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15904: + cmpeq $17, CycleBindRead, $2 # [1] +.align 3 +G15917: + bne $2, G15906 # [1] + cmpeq $17, CycleBindReadNoMonitor, $2 # [1] +.align 3 +G15918: + beq $2, G15905 # [1] +.align 3 +G15906: +/* Here if argument (CycleBindRead CycleBindReadNoMonitor) */ + bis $31, $1, $20 # [1-] + bis $31, 54, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15905: + cmpeq $17, CycleBindWrite, $2 # [1] +.align 3 +G15919: + bne $2, G15908 # [1] + cmpeq $17, CycleBindWriteNoMonitor, $2 # [1] +.align 3 +G15920: + beq $2, G15907 # [1] +.align 3 +G15908: +/* Here if argument (CycleBindWrite CycleBindWriteNoMonitor) */ + bis $31, $1, $20 # [1-] + bis $31, 55, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15907: + cmpeq $17, CycleHeader, $2 # [1] +.align 3 +G15921: + bne $2, G15910 # [1] + cmpeq $17, CycleStructureOffset, $2 # [1] +.align 3 +G15922: + beq $2, G15909 # [1] +.align 3 +G15910: +/* Here if argument (CycleHeader CycleStructureOffset) */ + bis $31, $1, $20 # [1-] + bis $31, 59, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15909: + cmpeq $17, CycleScavenge, $2 # [1] +.align 3 +G15923: + bne $2, G15912 # [1] + cmpeq $17, CycleGCCopy, $2 # [1] +.align 3 +G15924: + beq $2, G15911 # [1] +.align 3 +G15912: +/* Here if argument (CycleScavenge CycleGCCopy) */ + bis $31, $1, $20 # [1-] + bis $31, 60, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15911: + cmpeq $17, CycleCdr, $2 # [1] +.align 3 +G15925: + beq $2, G15902 # [1] +/* Here if argument CycleCdr */ + bis $31, $1, $20 # [0di] + bis $31, 56, $17 # [1] + br $31, ILLEGALOPERAND +.align 3 +G15902: +.align 3 +G15901: + cmpeq $16, MemoryActionMonitor, $1 # [1] +.align 3 +G15929: + beq $1, G15900 # [1] +/* Here if argument MemoryActionMonitor */ + br $31, MONITORTRAP +.align 3 +G15900: +.end PERFORMMEMORYACTION +.align 5 +.globl OutOfLineExceptions +.ent OutOfLineExceptions 0 +.align 3 +OutOfLineExceptions: +.align 3 +LDBEXCEPTION: + bis $31, $18, $21 # arg6 = tag to dispatch on [1-] + bis $31, 1, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, NUMERICEXCEPTION +.align 3 +RPLACAEXCEPTION: + bis $31, $1, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, LISTEXCEPTION +.align 3 +RPLACDEXCEPTION: + bis $31, $1, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 2, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, LISTEXCEPTION +.align 3 +PUSHIVEXCEPTION: + lda $1, 8 # [1] +/* SetTag. */ + sll $1, 32, $1 # [1] + bis $17, $1, $1 # [2] + bis $31, $2, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, EXCEPTION +.align 3 +INCREMENTEXCEPTION: + bis $31, $17, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, UNARYNUMERICEXCEPTION +.align 3 +DECREMENTEXCEPTION: + bis $31, $17, $21 # arg6 = tag to dispatch on [1] + bis $31, 0, $18 # arg3 = stackp [1] + bis $31, 1, $16 # arg1 = instruction arity [1] + bis $31, 0, $19 # arg4 = arithmeticp [1] + br $31, UNARYNUMERICEXCEPTION +.end OutOfLineExceptions +.align 5 +.globl NUMERICEXCEPTION +.ent NUMERICEXCEPTION 0 +.align 3 +NUMERICEXCEPTION: + subq $21, TypeFixnum, $1 # [1] + and $1, 56, $1 # Strip CDR code, low bits [1] + bne $1, NOTNUMERIC # [1] + br $31, EXCEPTION # Numeric +.align 3 +NOTNUMERIC: + bis $31, 0, $20 # [1-] + bis $31, 16, $17 # [1] + br $31, ILLEGALOPERAND +.end NUMERICEXCEPTION +.align 5 +.globl UNARYNUMERICEXCEPTION +.ent UNARYNUMERICEXCEPTION 0 +.align 3 +UNARYNUMERICEXCEPTION: + subq $21, TypeFixnum, $1 # [1] + and $1, 56, $1 # Strip CDR code, low bits [1] + bne $1, UNARYNOTNUMERIC # [1] + br $31, EXCEPTION # Numeric +.align 3 +UNARYNOTNUMERIC: + bis $31, 0, $20 # [1-] + bis $31, 81, $17 # [1] + br $31, ILLEGALOPERAND +.end UNARYNUMERICEXCEPTION +.align 5 +.globl LISTEXCEPTION +.ent LISTEXCEPTION 0 +.align 3 +LISTEXCEPTION: + subq $21, TypeList, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, NOTLIST1 # [1] + br $31, EXCEPTION # List +.align 3 +NOTLIST1: + subq $21, TypeListInstance, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, NOTLIST2 # [1] + br $31, EXCEPTION # List Instance +.align 3 +NOTLIST2: + bis $31, 0, $20 # [1-] + bis $31, 26, $17 # [1] + br $31, ILLEGALOPERAND +.end LISTEXCEPTION +.align 5 +.globl ARRAYEXCEPTION +.ent ARRAYEXCEPTION 0 +.align 3 +ARRAYEXCEPTION: + subq $21, TypeArray, $1 # [1] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, NOTARRAY1 # [1] + br $31, EXCEPTION # Array +.align 3 +NOTARRAY1: + subq $21, TypeArrayInstance, $1 # [1] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, NOTARRAY2 # [1] + br $31, EXCEPTION # Array Instance +.align 3 +NOTARRAY2: + br $31, SPAREEXCEPTION +.end ARRAYEXCEPTION +.align 5 +.globl SPAREEXCEPTION +.ent SPAREEXCEPTION 0 +.align 3 +SPAREEXCEPTION: + subq $21, TypeSparePointer1, $1 # [1] + and $1, 62, $1 # Strip CDR code, low bits [1] + bne $1, NOTSPARE1 # [1] + br $31, EXCEPTION # Spare Pointer +.align 3 +NOTSPARE1: +.align 3 +NOTSPARE2: + subq $21, TypeSpareNumber, $1 # [1] + and $1, 63, $1 # Strip CDR code [1] + bne $1, NOTSPARE3 # [1] + br $31, EXCEPTION # Spare Number +.align 3 +NOTSPARE3: + br $31, ILLEGALOPERAND # Must be illegal op after all +.end SPAREEXCEPTION +.align 5 +.globl EXCEPTION +.ent EXCEPTION 0 +.align 3 +EXCEPTION: + bne $19, ARITHMETICEXCEPTION # J. if arithmetic exception [1] + ldq $2, PROCESSORSTATE_LINKAGE($14) # [0di] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # fix the stack pointer [1] + ldq $17, CACHELINE_INSTRUCTION($13) # fetch the real opcode [1] + bne $2, NativeException # [1-] + bne $18, G15931 # J. if arguments stacked [1] + extwl $17, 4, $1 # Get original operand [1-] + cmpeq $1, 512, $3 # t3 is non-zero iff SP|POP operand [2] + bne $3, G15931 # SP|POP operand recovered by restoring SP [1] + lda $20, 0($10) # Assume FP mode [0di] + lda $3, -2040($12) # SP mode constant [1] + extbl $17, 5, $4 # Get the mode bits [1] + extbl $17, 4, $2 # Extract (8-bit, unsigned) operand [1] + subq $4, 2, $4 # t4 = -2 FP, -1 LP, 0 SP, 1 Imm [1] + cmovlbs $4, $11, $20 # LP or Immediate mode [1] + cmoveq $4, $3, $20 # SP mode [1] + s8addq $2, $20, $20 # Compute operand address [2] + ble $4, G15932 # Not immediate mode [0di] + sll $2, 56, $1 # [1-] + srl $17, 16, $3 # [1] + sra $1, 56, $1 # [1] + lda $20, PROCESSORSTATE_IMMEDIATE_ARG($14) # Immediate mode constant [1] + cmovlbc $3, $1, $2 # Signed immediate [1] + stl $2, PROCESSORSTATE_IMMEDIATE_ARG($14) # [0di] +.align 3 +G15932: + lda $1, -32768 # [1-] + ldah $1, 2($1) # [1] + and $17, $1, $2 # [1] + cmpeq $1, $2, $3 # [1] + beq $3, G15933 # J. if not address-format operand [1] +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $20, $2, $2 # stack cache base relative offset [2di] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + bis $31, TypeLocative, $2 # [1] +/* SetTag. */ + sll $2, 32, $20 # [1] + bis $1, $20, $20 # [2] + br $31, G15934 # [0di] +.align 3 +G15933: + ldq $20, 0($20) # Fetch the arg [2] +.align 3 +G15934: + stq $20, 8($12) # [1] + addq $12, 8, $12 # [0di] +.align 3 +G15931: + srl $17, 10, $17 # Shift opcode into position [1] + and $17, 255, $17 # Just 8-bits of opcode [2] + lda $24, TrapVectorInstructionException($17) # [1] +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [0di] + lda $2, TrapVectorInstructionException # get the vector index [1-] + s8addq $2, $1, $1 # [2] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [1-] +#endif + ldq $25, CACHELINE_NEXTPCDATA($13) # [1] + br $31, HandleException # [1] +.end EXCEPTION +.align 5 +.globl ARITHMETICEXCEPTION +.ent ARITHMETICEXCEPTION 0 +.align 3 +ARITHMETICEXCEPTION: + ldq $2, PROCESSORSTATE_LINKAGE($14) # [1] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # fix the stack pointer [1] + ldq $17, CACHELINE_INSTRUCTION($13) # fetch the real opcode [1] + bne $2, NativeException # [1di] + srl $17, 10, $17 # get opcode into low byte [2-] + and $17, 255, $17 # low byte only [2] + cmpeq $17, OpcodeDoubleFloatOp, $17 # is it DoubleFloatOp ? [1] + beq $17, G15941 # not a doublefloat [1] + br $31, DOUBLEFLOATEXC # it's a double float exc +.align 3 +G15941: + ldq $17, CACHELINE_INSTRUCTION($13) # fetch the real opcode again [1] + extwl $17, 4, $1 # Get original operand [3] + cmpeq $1, 512, $3 # t3 is non-zero iff SP|POP operand [2] + bne $3, G15937 # SP|POP operand recovered by restoring SP [1] + lda $20, 0($10) # Assume FP mode [1-] + lda $3, -2040($12) # SP mode constant [1] + extbl $17, 5, $4 # Get the mode bits [1] + extbl $17, 4, $2 # Extract (8-bit, unsigned) operand [1] + subq $4, 2, $4 # t4 = -2 FP, -1 LP, 0 SP, 1 Imm [1] + cmovlbs $4, $11, $20 # LP or Immediate mode [1] + cmoveq $4, $3, $20 # SP mode [1] + s8addq $2, $20, $20 # Compute operand address [2] + ble $4, G15938 # Not immediate mode [1-] + sll $2, 56, $1 # [0di] + srl $17, 16, $3 # [1] + sra $1, 56, $1 # [1] + lda $20, PROCESSORSTATE_IMMEDIATE_ARG($14) # Immediate mode constant [1] + cmovlbc $3, $1, $2 # Signed immediate [1] + stl $2, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] +.align 3 +G15938: + lda $1, -32768 # [1-] + ldah $1, 2($1) # [1] + and $17, $1, $2 # [1] + cmpeq $1, $2, $3 # [1] + beq $3, G15939 # J. if not address-format operand [1] +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $20, $2, $2 # stack cache base relative offset [2di] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + bis $31, TypeLocative, $2 # [1] +/* SetTag. */ + sll $2, 32, $20 # [1] + bis $1, $20, $20 # [2] + br $31, G15940 # [0di] +.align 3 +G15939: + ldq $20, 0($20) # Fetch the arg [2] +.align 3 +G15940: + stq $20, 8($12) # [1] + addq $12, 8, $12 # [0di] +.align 3 +G15937: + srl $17, 17, $4 # Get unary/nary bit of opcode [1] + bis $31, 1, $16 # Assume unary [1] + bis $31, $31, $24 # [1] + bis $12, $31, $2 # [1] + blbc $4, G15936 # J. if not binary arithmetic dispatch [1-] + bis $31, 2, $16 # Nary -> Binary [0di] + ldl $24, 4($12) # [1-] + subq $2, 8, $2 # [0di] + and $24, 7, $24 # low three bits has opcode tag for op2 [3] +.align 3 +G15936: + srl $17, 4, $17 # Shift opcode into position [1] + ldl $2, 4($2) # [0di] + and $17, 1984, $17 # five bits from the opcode [2-] + and $2, 7, $2 # [1] + s8addq $2, $24, $24 # [1] + bis $17, $24, $24 # [1] + lda $24, TrapVectorArithmeticInstructionException($24) # [1] +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [0di] + lda $2, TrapVectorArithmeticInstructionException # get the vector index [1-] + s8addq $2, $1, $1 # [2] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [1-] +#endif + ldq $25, CACHELINE_NEXTPCDATA($13) # [1] + br $31, HandleException # [1] +.end ARITHMETICEXCEPTION +.align 5 +.globl LOOPEXCEPTION +.ent LOOPEXCEPTION 0 +.align 3 +LOOPEXCEPTION: + ldq $2, PROCESSORSTATE_LINKAGE($14) # [1] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # fix the stack pointer [1] + ldq $17, CACHELINE_INSTRUCTION($13) # fetch the real opcode [1] + bne $2, NativeException # [1di] + bne $18, G15943 # J. if arguments stacked [1] + extwl $17, 4, $1 # Get original operand [1di] + cmpeq $1, 512, $3 # t3 is non-zero iff SP|POP operand [2] + bne $3, G15943 # SP|POP operand recovered by restoring SP [1] + lda $20, 0($10) # Assume FP mode [1-] + lda $3, -2040($12) # SP mode constant [1] + extbl $17, 5, $4 # Get the mode bits [1] + extbl $17, 4, $2 # Extract (8-bit, unsigned) operand [1] + subq $4, 2, $4 # t4 = -2 FP, -1 LP, 0 SP, 1 Imm [1] + cmovlbs $4, $11, $20 # LP or Immediate mode [1] + cmoveq $4, $3, $20 # SP mode [1] + s8addq $2, $20, $20 # Compute operand address [2] + ble $4, G15944 # Not immediate mode [1-] + sll $2, 56, $1 # [0di] + srl $17, 16, $3 # [1] + sra $1, 56, $1 # [1] + lda $20, PROCESSORSTATE_IMMEDIATE_ARG($14) # Immediate mode constant [1] + cmovlbc $3, $1, $2 # Signed immediate [1] + stl $2, PROCESSORSTATE_IMMEDIATE_ARG($14) # [1-] +.align 3 +G15944: + lda $1, -32768 # [1-] + ldah $1, 2($1) # [1] + and $17, $1, $2 # [1] + cmpeq $1, $2, $3 # [1] + beq $3, G15945 # J. if not address-format operand [1] +/* Convert stack cache address to VMA */ + ldq $2, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $20, $2, $2 # stack cache base relative offset [2di] + srl $2, 3, $2 # convert byte address to word address [1] + addq $2, $1, $1 # reconstruct VMA [2] + bis $31, TypeLocative, $2 # [1] +/* SetTag. */ + sll $2, 32, $20 # [1] + bis $1, $20, $20 # [2] + br $31, G15946 # [0di] +.align 3 +G15945: + ldq $20, 0($20) # Fetch the arg [2] +.align 3 +G15946: + stq $20, 8($12) # [1] + addq $12, 8, $12 # [0di] +.align 3 +G15943: + srl $17, 10, $17 # Shift opcode into position [1] + and $17, 255, $17 # Just 8-bits of opcode [2] + lda $24, TrapVectorInstructionException($17) # [1] +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [0di] + lda $2, TrapVectorInstructionException # get the vector index [1-] + s8addq $2, $1, $1 # [2] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [1-] +#endif + bis $20, $31, $25 # [0di] + br $31, HandleException # [1-] +.end LOOPEXCEPTION +.align 5 +.globl HandleException +.ent HandleException 3 +.align 3 +HandleException: + bis $10, $31, $1 # save old frame pointer [1-] + ldl $4, PROCESSORSTATE_CONTROL($14) # [0di] + ldq $22, PROCESSORSTATE_FEPMODETRAPVECADDRESS($14) # [1] + ldq $8, PROCESSORSTATE_TRAPVECBASE($14) # [1] + ldah $5, -16384 # [1-] + srl $4, 30, $6 # [1] + bis $4, $5, $5 # Set trap mode to 3 [1] + and $6, 3, $6 # [1] + stl $5, PROCESSORSTATE_CONTROL($14) # [1-] + subq $6, 3, $7 # [0di] + addq $8, $24, $8 # [1] + cmoveq $7, $22, $8 # [1] + stq $8, PROCESSORSTATE_TVI($14) # Record TVI for tracing (if enabled) [1-] +/* Memory Read Internal */ +G15951: + ldq $22, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1] + addq $8, $14, $6 # [1-] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # [0di] + s4addq $6, $31, $3 # [1-] + ldq_u $2, 0($6) # [1di] + subq $8, $22, $22 # Stack cache offset [1-] + ldq $5, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] + cmpult $22, $7, $7 # In range? [1-] + ldl $3, 0($3) # [0di] + extbl $2, $6, $2 # [1-] + bne $7, G15953 # [0di] +G15952: + lda $6, 240 # [1-] + srl $5, $2, $5 # [1] + srl $6, $2, $6 # [1] + extll $3, 0, $3 # [1] + blbs $5, G15955 # [1-] +G15962: + subq $2, TypeEvenPC, $5 # [1] + and $5, 62, $5 # Strip CDR code, low bits [1] + bne $5, G15950 # [1] + stl $4, PROCESSORSTATE_CONTROL($14) # Restore the cr [1] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # Current stack cache limit (words) [1] + lda $5, 128 # [1-] + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [0di] + addq $5, 8, $5 # Account for what we're about to push [1-] + s8addq $5, $12, $5 # SCA of desired end of cache [1] + s8addq $8, $6, $6 # SCA of current end of cache [1] + cmple $5, $6, $8 # [1] + beq $8, G15963 # We're done if new SCA is within bounds [1] + s8addq $16, $31, $10 # [0di] + subq $12, $10, $10 # [1] + addq $10, 8, $10 # [1] + beq $16, G15948 # [1-] + ldq $5, 0($12) # [0di] + stq $5, 32($12) # [1] + subq $16, 1, $16 # [0di] + beq $16, G15948 # [1] + ldq $5, -8($12) # [0di] + stq $5, 24($12) # [1] + subq $16, 1, $16 # [0di] + beq $16, G15948 # [1] + ldq $5, -16($12) # [0di] + stq $5, 16($12) # [1] + subq $16, 1, $16 # [0di] + beq $16, G15948 # [1] + ldq $5, -24($12) # [0di] + stq $5, 8($12) # [1] + subq $16, 1, $16 # [0di] +.align 3 +G15948: + addq $12, 32, $12 # [1] + ldl $5, PROCESSORSTATE_CONTINUATION($14) # [0di] + ldl $7, PROCESSORSTATE_CONTINUATION+4($14) # [1] + extll $5, 0, $5 # [2di] + ldah $8, 8192 # [1] + extll $4, 0, $4 # [1] + bis $7, 192, $7 # [1] + stl $5, 0($10) # [0di] + stl $7, 4($10) # write the stack cache [1] + and $4, $8, $8 # [0di] + srl $8, 2, $8 # [1] + bis $31, TypeFixnum+0xC0, $6 # [1] + bis $4, $8, $8 # [1] + stl $8, 8($10) # [0di] + stl $6, 12($10) # write the stack cache [1] + addq $12, 8, $11 # [0di] + bis $31, TypeFixnum, $6 # [1] + bis $31, $24, $8 # [1] + stl $8, 16($10) # [1-] + stl $6, 20($10) # write the stack cache [1] +/* Convert PC to a real continuation. */ + and $9, 1, $6 # [1] + srl $9, 1, $8 # convert PC to a real word address. [1] + lda $6, TypeEvenPC($6) # [1] + stl $8, 24($10) # [0di] + stl $6, 28($10) # write the stack cache [1] + ldq $7, PROCESSORSTATE_FCCRTRAPMASK($14) # Get CR mask [1] + ldah $5, ValueDispositionValue*4 # 1<<18! [1-] + subq $11, $10, $6 # Arg size [1] + subq $10, $1, $8 # Caller Frame Size [1] + srl $6, 3, $6 # Arg size in words [1] + sll $8, 6, $8 # Caller Frame Size in words in place [1] + bis $5, $6, $5 # [1] + bis $5, $8, $5 # [1] +/* TagCdr. */ + srl $2, 6, $22 # [1] + srl $4, 30, $6 # [1] + subq $22, $6, $8 # [2] + cmovge $8, $22, $6 # [1] + sll $6, 30, $6 # [2] + and $4, $7, $4 # Mask off unwanted bits [1] + bis $4, $6, $4 # Add trap mode [1] + bis $4, $5, $4 # Add argsize, apply, disposition, caller FS [1] + stl $4, PROCESSORSTATE_CONTROL($14) # [0di] +/* Convert PC to a real continuation. */ + and $25, 1, $6 # [1-] + srl $25, 1, $8 # convert PC to a real word address. [1] + lda $6, TypeEvenPC($6) # [1] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [0di] + stl $6, PROCESSORSTATE_CONTINUATION+4($14) # [1] + stl $8, PROCESSORSTATE_CONTINUATION($14) # [1] +/* Convert real continuation to PC. */ + and $2, 1, $9 # [1-] + addq $3, $9, $9 # [1] + addq $3, $9, $9 # [1] + srl $4, 30, $6 # Save current trap mode [1] + srl $4, 30, $4 # Isolate trap mode [1] + ldl $8, PROCESSORSTATE_CSLIMIT($14) # Limit for emulator mode [0di] + ldl $22, PROCESSORSTATE_CSEXTRALIMIT($14) # Limit for extra stack and higher modes [1] + cmovne $4, $22, $8 # Get the right limit for the current trap mode [3] + extll $8, 0, $8 # Might have been sign extended [2] +/* Convert stack cache address to VMA */ + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $22, $22 # stack cache base relative offset [2di] + srl $22, 3, $22 # convert byte address to word address [1] + addq $22, $4, $4 # reconstruct VMA [2] + cmplt $4, $8, $22 # Check for overflow [1] + beq $22, G15949 # Jump if overflow [1] +/* Convert a halfword address into a CP pointer. */ + srl $9, CacheLineRShift, $13 # Get third byte into bottom [1-] + ldq $22, PROCESSORSTATE_ICACHEBASE($14) # get the base of the icache [0di] + lda $8, -1 # [1-] + ldah $8, 4($8) # [1] + sll $13, CacheLineLShift, $13 # Now third byte is zero-shifted [1] + addq $9, $13, $13 # [2] + and $13, $8, $13 # [1] + sll $13, 5, $8 # temp=cpos*32 [1] + sll $13, 4, $13 # cpos=cpos*16 [1] + addq $22, $8, $22 # temp2=base+cpos*32 [1] + addq $22, $13, $13 # cpos=base+cpos*48 [1] + br $31, CACHEVALID # [0di] +.align 3 +G15949: + beq $6, STACKOVERFLOW # Take the overflow if in emulator mode [1] + br $31, FATALSTACKOVERFLOW +.align 3 +G15963: + bis $31, 8, $17 # [1-] + br $31, StackCacheOverflowHandler # [0di] +.align 3 +G15953: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $22, $7, $22 # reconstruct SCA [3] + ldl $3, 0($22) # [2] + ldl $2, 4($22) # Read from stack cache [1] + br $31, G15952 # [1] +.align 3 +G15955: + blbc $6, G15954 # [1] + extll $3, 0, $8 # Do the indirect thing [0di] + br $31, G15951 # [1-] +.align 3 +G15954: + ldq $5, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $8, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $5, $6 # Adjust for a longword load [2di] + ldl $5, 0($6) # Get the memory action [2] +.align 3 +G15959: + and $5, MemoryActionTransform, $6 # [3] + beq $6, G15958 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G15962 # [1-] +#ifndef MINIMA +G15958: +#endif +#ifdef MINIMA +.align 3 +G15958: + and $5, MemoryActionBinding, $6 # [1-] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $6, G15957 # [1-] + sll $8, 1, $22 # [0di] + ldq $6, PROCESSORSTATE_DBCBASE($14) # [1-] + and $22, $7, $22 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $22, $6, $22 # [1] + extll $22, 0, $22 # Clear sign-extension [1] + s4addq $22, $7, $7 # [2] + ldl $22, 0($7) # Fetch the key [2] + ldl $3, 4($7) # Fetch value [1] + subl $8, $22, $6 # Compare [2di] + bne $6, G15961 # Trap on miss [1] + extll $3, 0, $8 # Extract the pointer, and indirect [0di] + br $31, G15951 # This is another memory read tailcall. [1-] +.align 3 +G15961: + br $31, DBCACHEMISSTRAP +#endif +G15957: +/* Perform memory action */ + bis $31, $5, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15950: + br $31, ILLEGALTRAPVECTOR +.end HandleException +.align 5 +.globl STACKOVERFLOW +.ent STACKOVERFLOW 0 +.align 3 +STACKOVERFLOW: + stq $12, PROCESSORSTATE_RESTARTSP($14) # [1-] + bis $10, $31, $1 # save old frame pointer [0di] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1-] + ldq $22, PROCESSORSTATE_FEPMODETRAPVECADDRESS($14) # [1] + ldq $8, PROCESSORSTATE_TRAPVECBASE($14) # [1] + ldah $5, -16384 # [0di] + srl $4, 30, $6 # [1] + bis $4, $5, $5 # Set trap mode to 3 [1] + and $6, 3, $6 # [1] + stl $5, PROCESSORSTATE_CONTROL($14) # [0di] + subq $6, 3, $7 # [1-] + addq $8, TrapVectorStackOverflow, $8 # [1] + cmoveq $7, $22, $8 # [1] + stq $8, PROCESSORSTATE_TVI($14) # Record TVI for tracing (if enabled) [0di] +/* Memory Read Internal */ +G15967: + ldq $22, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1] + addq $8, $14, $6 # [1di] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $6, $31, $3 # [0di] + ldq_u $2, 0($6) # [1-] + subq $8, $22, $22 # Stack cache offset [0di] + ldq $5, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $22, $7, $7 # In range? [1di] + ldl $3, 0($3) # [1-] + extbl $2, $6, $2 # [0di] + bne $7, G15969 # [1-] +G15968: + lda $6, 240 # [0di] + srl $5, $2, $5 # [1] + srl $6, $2, $6 # [1] + extll $3, 0, $3 # [1] + blbs $5, G15971 # [0di] +G15978: + subq $2, TypeEvenPC, $5 # [1] + and $5, 62, $5 # Strip CDR code, low bits [1] + bne $5, G15966 # [1] + stl $4, PROCESSORSTATE_CONTROL($14) # Restore the cr [1] + ldl $8, PROCESSORSTATE_SCOVLIMIT($14) # Current stack cache limit (words) [1] + lda $5, 128 # [0di] + ldq $6, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [1-] + addq $5, 8, $5 # Account for what we're about to push [0di] + s8addq $5, $12, $5 # SCA of desired end of cache [1] + s8addq $8, $6, $6 # SCA of current end of cache [2] + cmple $5, $6, $8 # [1] + beq $8, G15979 # We're done if new SCA is within bounds [1] + s8addq $31, $31, $10 # [1-] + subq $12, $10, $10 # [1] + addq $10, 8, $10 # [1] + beq $31, G15964 # [0di] + ldq $5, 0($12) # [1-] + stq $5, 32($12) # [1] + subq $31, 1, $31 # [1-] + beq $31, G15964 # [1] + ldq $5, -8($12) # [1-] + stq $5, 24($12) # [1] + subq $31, 1, $31 # [1-] + beq $31, G15964 # [1] + ldq $5, -16($12) # [1-] + stq $5, 16($12) # [1] + subq $31, 1, $31 # [1-] + beq $31, G15964 # [1] + ldq $5, -24($12) # [1-] + stq $5, 8($12) # [1] + subq $31, 1, $31 # [1-] +.align 3 +G15964: + addq $12, 32, $12 # [1] + ldl $5, PROCESSORSTATE_CONTINUATION($14) # [0di] + ldl $7, PROCESSORSTATE_CONTINUATION+4($14) # [1] + extll $5, 0, $5 # [2di] + ldah $8, 8192 # [1] + extll $4, 0, $4 # [1] + bis $7, 192, $7 # [1] + stl $5, 0($10) # [0di] + stl $7, 4($10) # write the stack cache [1] + and $4, $8, $8 # [0di] + srl $8, 2, $8 # [1] + bis $31, TypeFixnum+0xC0, $6 # [1] + bis $4, $8, $8 # [1] + stl $8, 8($10) # [0di] + stl $6, 12($10) # write the stack cache [1] + addq $12, 8, $11 # [0di] + bis $31, TypeFixnum, $6 # [1] + bis $31, TrapVectorStackOverflow, $8 # [1] + stl $8, 16($10) # [1-] + stl $6, 20($10) # write the stack cache [1] +/* Convert PC to a real continuation. */ + and $9, 1, $6 # [1] + srl $9, 1, $8 # convert PC to a real word address. [1] + lda $6, TypeEvenPC($6) # [1] + stl $8, 24($10) # [0di] + stl $6, 28($10) # write the stack cache [1] + ldq $7, PROCESSORSTATE_FCCRTRAPMASK($14) # Get CR mask [1] + ldah $5, ValueDispositionValue*4 # 1<<18! [1-] + subq $11, $10, $6 # Arg size [1] + subq $10, $1, $8 # Caller Frame Size [1] + srl $6, 3, $6 # Arg size in words [1] + sll $8, 6, $8 # Caller Frame Size in words in place [1] + bis $5, $6, $5 # [1] + bis $5, $8, $5 # [1] +/* TagCdr. */ + srl $2, 6, $22 # [1] + srl $4, 30, $6 # [1] + subq $22, $6, $8 # [2] + cmovge $8, $22, $6 # [1] + sll $6, 30, $6 # [2] + and $4, $7, $4 # Mask off unwanted bits [1] + bis $4, $6, $4 # Add trap mode [1] + bis $4, $5, $4 # Add argsize, apply, disposition, caller FS [1] + stl $4, PROCESSORSTATE_CONTROL($14) # [0di] +/* Convert PC to a real continuation. */ + and $9, 1, $6 # [1-] + srl $9, 1, $8 # convert PC to a real word address. [1] + lda $6, TypeEvenPC($6) # [1] + stq $31, PROCESSORSTATE_CONTINUATIONCP($14) # [0di] + stl $6, PROCESSORSTATE_CONTINUATION+4($14) # [1] + stl $8, PROCESSORSTATE_CONTINUATION($14) # [1] +/* Convert real continuation to PC. */ + and $2, 1, $9 # [1-] + addq $3, $9, $9 # [1] + addq $3, $9, $9 # [1] + srl $4, 30, $6 # Save current trap mode [1] + srl $4, 30, $4 # Isolate trap mode [1] + ldl $8, PROCESSORSTATE_CSLIMIT($14) # Limit for emulator mode [0di] + ldl $22, PROCESSORSTATE_CSEXTRALIMIT($14) # Limit for extra stack and higher modes [1] + cmovne $4, $22, $8 # Get the right limit for the current trap mode [3] + extll $8, 0, $8 # Might have been sign extended [2] +/* Convert stack cache address to VMA */ + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [0di] + ldq $4, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $22, $22 # stack cache base relative offset [2di] + srl $22, 3, $22 # convert byte address to word address [1] + addq $22, $4, $4 # reconstruct VMA [2] + cmplt $4, $8, $22 # Check for overflow [1] + beq $22, G15965 # Jump if overflow [1] +/* Convert a halfword address into a CP pointer. */ + srl $9, CacheLineRShift, $13 # Get third byte into bottom [1-] + ldq $22, PROCESSORSTATE_ICACHEBASE($14) # get the base of the icache [0di] + lda $8, -1 # [1-] + ldah $8, 4($8) # [1] + sll $13, CacheLineLShift, $13 # Now third byte is zero-shifted [1] + addq $9, $13, $13 # [2] + and $13, $8, $13 # [1] + sll $13, 5, $8 # temp=cpos*32 [1] + sll $13, 4, $13 # cpos=cpos*16 [1] + addq $22, $8, $22 # temp2=base+cpos*32 [1] + addq $22, $13, $13 # cpos=base+cpos*48 [1] + br $31, CACHEVALID # [0di] +.align 3 +G15965: + beq $6, STACKOVERFLOW # Take the overflow if in emulator mode [1] + br $31, FATALSTACKOVERFLOW +.align 3 +G15979: + bis $31, 8, $17 # [1-] + br $31, StackCacheOverflowHandler # [0di] +.align 3 +G15969: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $22, $7, $22 # reconstruct SCA [3] + ldl $3, 0($22) # [2] + ldl $2, 4($22) # Read from stack cache [1] + br $31, G15968 # [1] +.align 3 +G15971: + blbc $6, G15970 # [1] + extll $3, 0, $8 # Do the indirect thing [0di] + br $31, G15967 # [1-] +.align 3 +G15970: + ldq $5, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $8, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $5, $6 # Adjust for a longword load [2di] + ldl $5, 0($6) # Get the memory action [2] +.align 3 +G15975: + and $5, MemoryActionTransform, $6 # [3] + beq $6, G15974 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G15978 # [1-] +#ifndef MINIMA +G15974: +#endif +#ifdef MINIMA +.align 3 +G15974: + and $5, MemoryActionBinding, $6 # [1-] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $6, G15973 # [1-] + sll $8, 1, $22 # [0di] + ldq $6, PROCESSORSTATE_DBCBASE($14) # [1-] + and $22, $7, $22 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $22, $6, $22 # [1] + extll $22, 0, $22 # Clear sign-extension [1] + s4addq $22, $7, $7 # [2] + ldl $22, 0($7) # Fetch the key [2] + ldl $3, 4($7) # Fetch value [1] + subl $8, $22, $6 # Compare [2di] + bne $6, G15977 # Trap on miss [1] + extll $3, 0, $8 # Extract the pointer, and indirect [0di] + br $31, G15967 # This is another memory read tailcall. [1-] +.align 3 +G15977: + br $31, DBCACHEMISSTRAP +#endif +G15973: +/* Perform memory action */ + bis $31, $5, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15966: + br $31, ILLEGALTRAPVECTOR +.end STACKOVERFLOW +.align 5 +.globl StartPreTrap +.ent StartPreTrap 0 +.align 3 +StartPreTrap: + ldq $2, PROCESSORSTATE_LINKAGE($14) # [1-] + bne $2, NativeException # [3] + ldl $4, PROCESSORSTATE_CONTROL($14) # [1-] + ldq $22, PROCESSORSTATE_FEPMODETRAPVECADDRESS($14) # [1] + ldq $8, PROCESSORSTATE_TRAPVECBASE($14) # [1] + ldah $5, -16384 # [0di] + srl $4, 30, $6 # [1] + bis $4, $5, $5 # Set trap mode to 3 [1] + and $6, 3, $6 # [1] + stl $5, PROCESSORSTATE_CONTROL($14) # [0di] + subq $6, 3, $7 # [1-] + addq $8, $23, $8 # [1] + cmoveq $7, $22, $8 # [1] + stq $8, PROCESSORSTATE_TVI($14) # Record TVI for tracing (if enabled) [0di] +/* Memory Read Internal */ +G15981: + ldq $22, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [1] + addq $8, $14, $6 # [1di] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # [1-] + s4addq $6, $31, $3 # [0di] + ldq_u $2, 0($6) # [1-] + subq $8, $22, $22 # Stack cache offset [0di] + ldq $5, PROCESSORSTATE_DATAREAD_MASK($14) # [1-] + cmpult $22, $7, $7 # In range? [1di] + ldl $3, 0($3) # [1-] + extbl $2, $6, $2 # [0di] + bne $7, G15983 # [1-] +G15982: + lda $6, 240 # [0di] + srl $5, $2, $5 # [1] + srl $6, $2, $6 # [1] + extll $3, 0, $3 # [1] + blbs $5, G15985 # [0di] +G15992: + subq $2, TypeEvenPC, $5 # [1] + and $5, 62, $5 # Strip CDR code, low bits [1] + bne $5, G15980 # [1] + stl $4, PROCESSORSTATE_CONTROL($14) # Restore the cr [1] + ldq $12, PROCESSORSTATE_RESTARTSP($14) # [1] + ldl $7, PROCESSORSTATE_SCOVLIMIT($14) # Current stack cache limit (words) [1] + lda $4, 128 # [1-] + ldq $5, PROCESSORSTATE_STACKCACHEDATA($14) # Alpha base of stack cache [0di] + addq $4, 8, $4 # Account for what we're about to push [1-] + s8addq $4, $12, $4 # SCA of desired end of cache [1] + s8addq $7, $5, $5 # SCA of current end of cache [1] + cmple $4, $5, $7 # [1] + beq $7, G15993 # We're done if new SCA is within bounds [1] + ldl $5, PROCESSORSTATE_CONTINUATION($14) # [0di] + ldl $4, PROCESSORSTATE_CONTINUATION+4($14) # [1] + extll $5, 0, $5 # [2di] + ldl $7, PROCESSORSTATE_CONTROL($14) # [1-] + extll $7, 0, $7 # [3] + bis $4, 192, $4 # [1] + stl $5, 8($12) # [0di] + stl $4, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $31, TypeFixnum+0xC0, $6 # [1] + stl $7, 8($12) # [1di] + stl $6, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $31, $23, $6 # [1] + bis $31, TypeFixnum, $8 # [1] + stl $6, 8($12) # [1-] + stl $8, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] +/* Convert PC to a real continuation. */ + and $9, 1, $6 # [1] + srl $9, 1, $8 # convert PC to a real word address. [1] + lda $6, TypeEvenPC($6) # [1] + stl $6, PROCESSORSTATE_CONTINUATION+4($14) # [1-] + stl $8, PROCESSORSTATE_CONTINUATION($14) # [1] + stq $13, PROCESSORSTATE_CONTINUATIONCP($14) # [1] + and $6, 63, $22 # set CDR-NEXT [0di] + stl $8, 8($12) # [1-] + stl $22, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + ret $31, ($0), 1 # [0di] +.align 3 +G15993: + bis $31, 8, $17 # [3] + br $31, StackCacheOverflowHandler # [0di] +.align 3 +G15983: + ldq $7, PROCESSORSTATE_STACKCACHEDATA($14) # [1] + s8addq $22, $7, $22 # reconstruct SCA [3] + ldl $3, 0($22) # [2] + ldl $2, 4($22) # Read from stack cache [1] + br $31, G15982 # [1] +.align 3 +G15985: + blbc $6, G15984 # [1] + extll $3, 0, $8 # Do the indirect thing [0di] + br $31, G15981 # [1-] +.align 3 +G15984: + ldq $5, PROCESSORSTATE_DATAREAD($14) # Load the memory action table for cycle [1] +/* TagType. */ + and $2, 63, $6 # Discard the CDR code [0di] + stq $8, PROCESSORSTATE_VMA($14) # stash the VMA for the (likely) trap [1-] + s4addq $6, $5, $6 # Adjust for a longword load [2di] + ldl $5, 0($6) # Get the memory action [2] +.align 3 +G15989: + and $5, MemoryActionTransform, $6 # [3] + beq $6, G15988 # [1] + bic $2, 63, $2 # [1-] + bis $2, TypeExternalValueCellPointer, $2 # [1] + br $31, G15992 # [1-] +#ifndef MINIMA +G15988: +#endif +#ifdef MINIMA +.align 3 +G15988: + and $5, MemoryActionBinding, $6 # [1-] + ldq $7, PROCESSORSTATE_DBCMASK($14) # [0di] + beq $6, G15987 # [1-] + sll $8, 1, $22 # [0di] + ldq $6, PROCESSORSTATE_DBCBASE($14) # [1-] + and $22, $7, $22 # Hash index [1di] + bis $31, 1, $7 # [1] + sll $7, IvoryMemoryData, $7 # [1] + addl $22, $6, $22 # [1] + extll $22, 0, $22 # Clear sign-extension [1] + s4addq $22, $7, $7 # [2] + ldl $22, 0($7) # Fetch the key [2] + ldl $3, 4($7) # Fetch value [1] + subl $8, $22, $6 # Compare [2di] + bne $6, G15991 # Trap on miss [1] + extll $3, 0, $8 # Extract the pointer, and indirect [0di] + br $31, G15981 # This is another memory read tailcall. [1-] +.align 3 +G15991: + br $31, DBCACHEMISSTRAP +#endif +G15987: +/* Perform memory action */ + bis $31, $5, $16 # [1-] + bis $31, 0, $17 # [1] + br $31, PERFORMMEMORYACTION +.align 3 +G15980: + br $31, ILLEGALTRAPVECTOR +.end StartPreTrap +.align 5 +.globl FinishPreTrap +.ent FinishPreTrap 0 +.align 3 +FinishPreTrap: + ldq $10, PROCESSORSTATE_RESTARTSP($14) # [1-] + addq $10, 8, $10 # iFP now points to the start of our new frame [3] + addq $12, 8, $11 # Points beyond the last argument [1] + ldq $4, PROCESSORSTATE_FCCRTRAPMASK($14) # Get CR mask [0di] + ldah $5, ValueDispositionValue*4 # 1<<18! [1-] + subq $11, $10, $6 # Arg size [1] + subq $10, $1, $8 # Caller Frame Size [1] + srl $6, 3, $6 # Arg size in words [1] + sll $8, 6, $8 # Caller Frame Size in words in place [1] + bis $5, $6, $5 # [1] + bis $5, $8, $5 # [1] +/* TagCdr. */ + srl $2, 6, $22 # [1] + srl $7, 30, $6 # [1] + subq $22, $6, $8 # [2] + cmovge $8, $22, $6 # [1] + sll $6, 30, $6 # [2] + and $7, $4, $7 # Mask off unwanted bits [1] + bis $7, $6, $7 # Add trap mode [1] + bis $7, $5, $7 # Add argsize, apply, disposition, caller FS [1] + stl $7, PROCESSORSTATE_CONTROL($14) # [0di] +/* Convert real continuation to PC. */ + and $2, 1, $9 # [1-] + addq $3, $9, $9 # [1] + addq $3, $9, $9 # [1] +/* Check for stack overflow */ + srl $7, 30, $7 # Isolate trap mode [1] + ldl $8, PROCESSORSTATE_CSLIMIT($14) # Limit for emulator mode [1-] + ldl $22, PROCESSORSTATE_CSEXTRALIMIT($14) # Limit for extra stack and higher modes [1] + cmovne $7, $22, $8 # Get the right limit for the current trap mode [3] + extll $8, 0, $8 # Might have been sign extended [2] +/* Convert stack cache address to VMA */ + ldq $22, PROCESSORSTATE_STACKCACHEDATA($14) # [1-] + ldq $7, PROCESSORSTATE_STACKCACHEBASEVMA($14) # [1] + subq $12, $22, $22 # stack cache base relative offset [2-] + srl $22, 3, $22 # convert byte address to word address [1] + addq $22, $7, $7 # reconstruct VMA [2] + cmplt $7, $8, $22 # Check for overflow [1] + beq $22, STACKOVERFLOW # Jump if overflow [1] +/* Convert a halfword address into a CP pointer. */ + srl $9, CacheLineRShift, $13 # Get third byte into bottom [0di] + ldq $22, PROCESSORSTATE_ICACHEBASE($14) # get the base of the icache [1-] + lda $8, -1 # [0di] + ldah $8, 4($8) # [1] + sll $13, CacheLineLShift, $13 # Now third byte is zero-shifted [1] + addq $9, $13, $13 # [2] + and $13, $8, $13 # [1] + sll $13, 5, $8 # temp=cpos*32 [1] + sll $13, 4, $13 # cpos=cpos*16 [1] + addq $22, $8, $22 # temp2=base+cpos*32 [1] + addq $22, $13, $13 # cpos=base+cpos*48 [1] + br $31, CACHEVALID # [1-] +.end FinishPreTrap +.align 5 +.globl ILLEGALOPERAND +.ent ILLEGALOPERAND 0 +.align 3 +ILLEGALOPERAND: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterError # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorError, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeFixnum, $24 # [1] + stl $17, 8($12) # [0di] + stl $24, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + bis $31, TypeLocative, $24 # [1] + stl $20, 8($12) # [1di] + stl $24, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [0di] + br $31, FinishPreTrap # [1-] +.end ILLEGALOPERAND +.align 5 +.globl RESETTRAP +.ent RESETTRAP 0 +.align 3 +RESETTRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorReset # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorReset, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + br $31, FinishPreTrap # [1-] +.end RESETTRAP +.align 5 +.globl PULLAPPLYARGSTRAP +.ent PULLAPPLYARGSTRAP 0 +.align 3 +PULLAPPLYARGSTRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorPullApplyArgs # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldl $25, 0($12) # [1] + ldl $24, 4($12) # [1] + subq $12, 8, $12 # Pop Stack. [1] + extll $25, 0, $25 # [1] + stq $12, PROCESSORSTATE_RESTARTSP($14) # [1-] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorPullApplyArgs, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeFixnum, $17 # [1] + stl $16, 8($12) # [1-] + stl $17, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + and $24, 63, $17 # set CDR-NEXT [1] + stl $25, 8($12) # [1-] + stl $17, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end PULLAPPLYARGSTRAP +.align 5 +.globl TRACETRAP +.ent TRACETRAP 0 +.align 3 +TRACETRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorTrace # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorTrace, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + br $31, FinishPreTrap # [1-] +.end TRACETRAP +.align 5 +.globl PREEMPTREQUESTTRAP +.ent PREEMPTREQUESTTRAP 0 +.align 3 +PREEMPTREQUESTTRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorPreemptRequest # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorPreemptRequest, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + br $31, FinishPreTrap # [1-] +.end PREEMPTREQUESTTRAP +.align 5 +.globl HIGHPRIORITYSEQUENCEBREAK +.ent HIGHPRIORITYSEQUENCEBREAK 0 +.align 3 +HIGHPRIORITYSEQUENCEBREAK: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorHighPrioritySequenceBreak # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorHighPrioritySequenceBreak, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + br $31, FinishPreTrap # [1-] +.end HIGHPRIORITYSEQUENCEBREAK +.align 5 +.globl LOWPRIORITYSEQUENCEBREAK +.ent LOWPRIORITYSEQUENCEBREAK 0 +.align 3 +LOWPRIORITYSEQUENCEBREAK: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorLowPrioritySequenceBreak # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorLowPrioritySequenceBreak, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + br $31, FinishPreTrap # [1-] +.end LOWPRIORITYSEQUENCEBREAK +.align 5 +.globl DBUNWINDFRAMETRAP +.ent DBUNWINDFRAMETRAP 0 +.align 3 +DBUNWINDFRAMETRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorDBUnwindFrame # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorDBUnwindFrame, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + ldq $24, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1-] + bis $31, TypeLocative, $25 # [0di] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end DBUNWINDFRAMETRAP +.align 5 +.globl DBUNWINDCATCHTRAP +.ent DBUNWINDCATCHTRAP 0 +.align 3 +DBUNWINDCATCHTRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapVectorDBUnwindCatch # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + bis $10, $31, $1 # save old frame pointer [1-] + bis $31, TrapVectorDBUnwindCatch, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + ldq $24, PROCESSORSTATE_BINDINGSTACKPOINTER($14) # [1-] + bis $31, TypeLocative, $25 # [0di] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end DBUNWINDCATCHTRAP +.align 5 +.globl TRANSPORTTRAP +.ent TRANSPORTTRAP 0 +.align 3 +TRANSPORTTRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterTransport # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorTransport, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end TRANSPORTTRAP +.align 5 +.globl MONITORTRAP +.ent MONITORTRAP 0 +.align 3 +MONITORTRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterMonitor # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorMonitor, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end MONITORTRAP +.align 5 +.globl PAGENOTRESIDENT +.ent PAGENOTRESIDENT 0 +.align 3 +PAGENOTRESIDENT: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterPageNotResident # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorPageNotResident, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end PAGENOTRESIDENT +.align 5 +.globl PAGEFAULTREQUESTHANDLER +.ent PAGEFAULTREQUESTHANDLER 0 +.align 3 +PAGEFAULTREQUESTHANDLER: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterPageFaultRequest # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorPageFaultRequest, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end PAGEFAULTREQUESTHANDLER +.align 5 +.globl PAGEWRITEFAULT +.ent PAGEWRITEFAULT 0 +.align 3 +PAGEWRITEFAULT: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterPageWriteFault # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorPageWriteFault, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end PAGEWRITEFAULT +#ifdef MINIMA +.align 5 +.globl DBCACHEMISSTRAP +.ent DBCACHEMISSTRAP 0 +.align 3 +DBCACHEMISSTRAP: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterDBCacheMiss # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorDBCacheMiss, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end DBCACHEMISSTRAP +#endif +/* The following handlers should never be invoked. */ +.align 12 + and $31, $31, $31 # [1] +.align 12 +.align 5 +.globl UNCORRECTABLEMEMORYERROR +.ent UNCORRECTABLEMEMORYERROR 0 +.align 3 +UNCORRECTABLEMEMORYERROR: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1-] + lda $2, TrapMeterUncorrectableMemoryError # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorUncorrectableMemoryError, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end UNCORRECTABLEMEMORYERROR +.align 5 +.globl BUSERROR +.ent BUSERROR 0 +.align 3 +BUSERROR: +#ifdef TRAPMETERING + ldq $1, PROCESSORSTATE_TRAPMETERDATA($14) # pointer to trap data vector [1] + lda $2, TrapMeterMemoryBusError # get the vector index [0di] + s8addq $2, $1, $1 # [3] + ldq $2, 0($1) # get the old value [2] + lda $2, 1($2) # increment it [3] + stq $2, 0($1) # and store it back [0di] +#endif + ldq $24, PROCESSORSTATE_VMA($14) # Preserve VMA against reading trap vector [1] + bis $10, $31, $1 # save old frame pointer [0di] + bis $31, TrapVectorMemoryBusError, $23 # save the trap vector index [1] + bsr $0, StartPreTrap + bis $31, TypeLocative, $25 # [1] + stl $24, 8($12) # [1-] + stl $25, 12($12) # write the stack cache [1] + addq $12, 8, $12 # [1-] + br $31, FinishPreTrap # [0di] +.end BUSERROR +/* Fin. */ + + +/* End of file automatically generated from ../alpha-emulator/ifuntrap.as */ diff --git a/alpha-emulator/ihalt.as b/alpha-emulator/ihalt.as new file mode 100644 index 0000000..b23fab9 --- /dev/null +++ b/alpha-emulator/ihalt.as @@ -0,0 +1,97 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(comment "This file implements the out-of-line parts of the instruction dispatch loop.") + +;(include "alphamac") ; load the alpha macros +;(include "intrpmac") ; load the interpreter macros. + +;(include-header "aihead.s") +;(include-header "aistat.s") + +(passthru ".globl SUSPENDMACHINE") +(passthru ".globl ILLEGALINSTRUCTION") +(passthru ".globl HALTMACHINE") + +(define-procedure |iOutOfLine| () + + ;; The following must not clobber T2, or ARG3 if it takes the + ;; branch back to CONTINUECURRENTINSTRUCTION + (label traporsuspendmachine "Here when someone wants the emulator to trap or stop.") + ;; We use a conditional store to clear the suspend/interrupt + ;; register. We don't care if our store fails, that simply means + ;; another thread ran and posted an interrupt; in which case we + ;; won't have clobbered it and will deal with it next cycle. If the + ;; clear succeeds, we also clear stop_interpreter, since we know + ;; that there are no new interrupts and we will handle the current + ;; ones in priority order. There is no sense leaving + ;; stop_interpreter set to penalize every branch or go in the + ;; interrupt handler. It also gets reset if there are other pending + ;; interrupts or preempts on the next function return (which is the + ;; soonest possible time you could deal with them anyways). + (get-control-register t4) + (STQ iSP PROCESSORSTATE_RESTARTSP (ivory) "Be sure this is up-to-date") + (LDQ_L R0 PROCESSORSTATE_PLEASE_STOP (ivory) "Has the spy asked us to stop or trap?") + (BIS zero zero t5) + (STQ_C t5 PROCESSORSTATE_PLEASE_STOP (ivory)) + (BEQ t5 collision) +; #+ignore ;;I think this is the culprit in RGETF hang -- Kalman + (STQ zero PROCESSORSTATE_STOP_INTERPRETER (ivory)) + (unlikely-label collision) + (CMPBGE R0 |HaltReasonIllInstn| t3 "t3<0>=1 if we've been asked to stop") + (BLBS t3 suspendmachine) + + (comment "Here when someone wants the emulator to trap.") + (EXTLL R0 4 R0 "Extract PROCESSORSTATE_PLEASE_TRAP (ivory)") + (SRL t4 30 t4 "Isolate current trap mode") + (basic-dispatch R0 t3 + (|TrapReasonHighPrioritySequenceBreak| + (CMPULE t4 |TrapModeExtraStack| t4 "Only interrupts EXTRA-STACK and EMULATOR") + (branch-false t4 continuecurrentinstruction) + (external-branch highprioritysequencebreak)) + ;; --- This wouldn't work if we needed it, since high-pri can + ;; clobber low-pri; Luckily, we don't use low-pri! + (|TrapReasonLowPrioritySequenceBreak| + ;; (CMPULE t4 |TrapModeEmulator| t4 "Only interrupts EMULATOR") + ;; (branch-false t4 continuecurrentinstruction) + (BNE t4 continuecurrentinstruction "Only interrupts EMULATOR") + (external-branch lowprioritysequencebreak)) + (:else + (comment "Check for preempt-request trap") + (LDL t5 PROCESSORSTATE_INTERRUPTREG (ivory) "Get the preempt-pending bit") + ;; (CMPULE t4 |TrapModeEmulator| t4 "Only interrupts EMULATOR") + ;; (branch-true t4 dopreemptrequest) + (BNE t4 continuecurrentinstruction "Don't take preempt trap unless in emulator mode") + (BLBC t5 continuecurrentinstruction "Jump if preempt request not pending") + (external-branch preemptrequesttrap))) + + (label suspendmachine "Here when someone wants to stop the emulator.") + (EXTLL R0 0 t1 "Get the reason") + (BR zero stopinterp) + + (label illegalinstruction "Here if we detect an illegal instruction.") + (BIS zero |HaltReasonIllInstn| t1) + (BR zero stopinterp) + + (label haltmachine "Here to halt machine") + (BIS zero |HaltReasonHalted| t1) + (BR zero stopinterp) + + (label fatalstackoverflow "Here if we detected a fatal stack overflow") + (BIS zero |HaltReasonFatalStackOverflow| t1) + (BR zero stopinterp) + + (label illegaltrapvector "Here if we detected a non-PC in a trap vector") + (BIS zero |HaltReasonIllegalTrapVector| t1) + (BR zero stopinterp) + + (label stopinterp) + ;; cleanup and leave! here +++ save interpreter state! + (BIS t1 zero r0 "Return the halt reason") + (STL zero PROCESSORSTATE_PLEASE_STOP (ivory) "Clear the request flag") + (decache-ivory-state) + (STQ zero PROCESSORSTATE_RUNNINGP (ivory) "Stop the (emulated) chip") + (restoreregisters) + (RET zero RA 1 "Home") +) + +;;; End of ihalt diff --git a/alpha-emulator/ihalt.s b/alpha-emulator/ihalt.s new file mode 100644 index 0000000..7ed180c --- /dev/null +++ b/alpha-emulator/ihalt.s @@ -0,0 +1,102 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ihalt.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* This file implements the out-of-line parts of the instruction dispatch loop. */ +.globl SUSPENDMACHINE +.globl ILLEGALINSTRUCTION +.globl HALTMACHINE +.align 5 +.globl iOutOfLine +.ent iOutOfLine 0 +.align 3 +iOutOfLine: +.align 3 +TRAPORSUSPENDMACHINE: # Here when someone wants the emulator to trap or stop. + ldl $4, PROCESSORSTATE_CONTROL($14) # [1] + stq $12, PROCESSORSTATE_RESTARTSP($14) # Be sure this is up-to-date [1] + ldq_l $0, PROCESSORSTATE_PLEASE_STOP($14) # Has the spy asked us to stop or trap? [1] + bis $31, $31, $5 # [0di] + stq_c $5, PROCESSORSTATE_PLEASE_STOP($14) # [1-] + beq $5, COLLISION # [1] + stq $31, PROCESSORSTATE_STOP_INTERPRETER($14) # [1] +COLLISION: + cmpbge $0, HaltReasonIllInstn, $3 # t3<0>=1 if we've been asked to stop [0di] + blbs $3, SUSPENDMACHINE # [1] +/* Here when someone wants the emulator to trap. */ + extll $0, 4, $0 # Extract PROCESSORSTATE_PLEASE_TRAP (ivory) [0di] + srl $4, 30, $4 # Isolate current trap mode [1] + cmpeq $0, TrapReasonHighPrioritySequenceBreak, $3 # [1] +.align 3 +G15999: + beq $3, G15995 # [1] +/* Here if argument TrapReasonHighPrioritySequenceBreak */ + cmpule $4, TrapModeExtraStack, $4 # Only interrupts EXTRA-STACK and EMULATOR [0di] + beq $4, CONTINUECURRENTINSTRUCTION # [1] + br $31, HIGHPRIORITYSEQUENCEBREAK +.align 3 +G15995: + cmpeq $0, TrapReasonLowPrioritySequenceBreak, $3 # [1-] +.align 3 +G16000: + beq $3, G15996 # [1] +/* Here if argument TrapReasonLowPrioritySequenceBreak */ + bne $4, CONTINUECURRENTINSTRUCTION # Only interrupts EMULATOR [1] + br $31, LOWPRIORITYSEQUENCEBREAK +.align 3 +G15996: +/* Here for all other cases */ +/* Check for preempt-request trap */ + ldl $5, PROCESSORSTATE_INTERRUPTREG($14) # Get the preempt-pending bit [1-] + bne $4, CONTINUECURRENTINSTRUCTION # Don't take preempt trap unless in emulator mode [0di] + blbc $5, CONTINUECURRENTINSTRUCTION # Jump if preempt request not pending [3] + br $31, PREEMPTREQUESTTRAP +.align 3 +G15994: +.align 3 +SUSPENDMACHINE: # Here when someone wants to stop the emulator. + extll $0, 0, $1 # Get the reason [1-] + br $31, STOPINTERP # [0di] +.align 3 +ILLEGALINSTRUCTION: # Here if we detect an illegal instruction. + bis $31, HaltReasonIllInstn, $1 # [1-] + br $31, STOPINTERP # [0di] +.align 3 +HALTMACHINE: # Here to halt machine + bis $31, HaltReasonHalted, $1 # [1-] + br $31, STOPINTERP # [0di] +.align 3 +FATALSTACKOVERFLOW: # Here if we detected a fatal stack overflow + bis $31, HaltReasonFatalStackOverflow, $1 # [1-] + br $31, STOPINTERP # [0di] +.align 3 +ILLEGALTRAPVECTOR: # Here if we detected a non-PC in a trap vector + bis $31, HaltReasonIllegalTrapVector, $1 # [1-] + br $31, STOPINTERP # [0di] +.align 3 +STOPINTERP: + bis $1, $31, $0 # Return the halt reason [1-] + stl $31, PROCESSORSTATE_PLEASE_STOP($14) # Clear the request flag [0di] + stq $13, PROCESSORSTATE_CP($14) # [1] + stq $9, PROCESSORSTATE_EPC($14) # [1] + stq $12, PROCESSORSTATE_SP($14) # [1] + stq $10, PROCESSORSTATE_FP($14) # [1] + stq $11, PROCESSORSTATE_LP($14) # [1] + stq $31, PROCESSORSTATE_RUNNINGP($14) # Stop the (emulated) chip [1] + ldq $9, PROCESSORSTATE_ASRR9($14) # [1] + ldq $10, PROCESSORSTATE_ASRR10($14) # [1] + ldq $11, PROCESSORSTATE_ASRR11($14) # [1] + ldq $12, PROCESSORSTATE_ASRR12($14) # [1] + ldq $13, PROCESSORSTATE_ASRR13($14) # [1] + ldq $15, PROCESSORSTATE_ASRR15($14) # [1] + ldq $26, PROCESSORSTATE_ASRR26($14) # [1] + ldq $27, PROCESSORSTATE_ASRR27($14) # [1] + ldq $29, PROCESSORSTATE_ASRR29($14) # [1] + ldq $30, PROCESSORSTATE_ASRR30($14) # [1] + ldq $14, PROCESSORSTATE_ASRR14($14) # [1] + ret $31, ($26), 1 # Home [1] +.end iOutOfLine + + +/* End of file automatically generated from ../alpha-emulator/ihalt.as */ diff --git a/alpha-emulator/imacarra.lisp b/alpha-emulator/imacarra.lisp new file mode 100644 index 0000000..3567669 --- /dev/null +++ b/alpha-emulator/imacarra.lisp @@ -0,0 +1,791 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; This file contains macros supporting array instructions. These are +;;; mostly in ifunarra.as + +(defmacro check-array-header (tag iolab temp) + (check-temporaries (tag) (temp)) + `((TagType ,tag ,temp) + (SUBQ ,temp |TypeHeaderI| ,temp) + (BNE ,temp ,iolab))) + +(defmacro check-array-prefix (header ielab temp) + (check-temporaries (header) (temp)) + (assert (= |array$K-longprefixbitmask| 1)) + `((SRL ,header |ArrayLongPrefixBitPos| ,temp) + (BLBS ,temp ,ielab))) + +(defmacro check-array-header-and-prefix (tag header iolab ielab temp1 temp2) + (check-temporaries (tag) (temp1 temp2)) + `((TagType ,tag ,temp1) + (SRL ,header |ArrayLongPrefixBitPos| ,temp2) + (SUBQ ,temp1 |TypeHeaderI| ,temp1) + (BNE ,temp1 ,iolab) + (BLBS ,temp2 ,ielab))) + +(defmacro check-array-bounds (data bound ioplab temp) + (check-temporaries (data bound) (temp)) + `((CMPULT ,data ,bound ,temp) + (branch-false ,temp ,ioplab))) + +(defmacro byte-packing-size (bp size) + (check-temporaries (bp) (size)) + `((BIS zero 32 ,size) + (SRL ,size ,bp ,size "Compute size of byte"))) + +(defmacro byte-packing-mask (bp mask temp) + (check-temporaries (bp) (mask temp)) + `((byte-packing-size ,bp ,temp) + (ORNOT zero zero ,mask) + (SLL ,mask ,temp ,mask) + (ORNOT zero ,mask ,mask "Compute mask for byte"))) + +(defmacro byte-packing-mask-and-unmask-given-size (bp mask unmask size) + (check-temporaries (bp size) (mask unmask)) + `((ORNOT zero zero ,unmask) + (SLL ,unmask ,size ,unmask) + (ORNOT zero ,unmask ,mask "Compute mask for byte"))) + +#|| +(defmacro byte-packing-modulus (bp x res) + (check-temporaries (bp x) (res)) + `((ORNOT zero zero ,res) + (SLL ,res ,bp ,res) + (BIC ,x ,res ,res "Compute subword index"))) + +(defmacro byte-packing-rotation (bp index rot) + (check-temporaries (bp index) (rot)) + `((SUBQ zero ,bp ,rot) + (ADDQ ,rot 5 ,rot) + (SLL ,index ,rot ,rot "Compute shift to get byte"))) +||# + +(defmacro byte-packing-modulus-and-rotation (bp index modulus rotation) + (check-temporaries (bp index) (modulus rotation)) + `((ORNOT zero zero ,modulus) + (SLL ,modulus ,bp ,modulus) + (SUBQ zero ,bp ,rotation) + (BIC ,index ,modulus ,modulus "Compute subword index") + (ADDQ ,rotation 5 ,rotation) + (SLL ,modulus ,rotation ,rotation "Compute shift to get byte"))) + + +(defmacro simple-case ((test-var temp temp2 &optional done-label) &body clauses) + "Only deals with singleton, constant keys. Optimizes dispatch + according to clause order." + (flet ((make-label (base) (gentemp (substitute #\_ #\- (format nil "CASE-~A-" base))))) + (let* ((clauses (copy-list clauses)) + (keys (map 'list #'(lambda (c) (eval (first c))) clauses)) + (sorted-keys (sort (copy-list keys) #'<)) + (labels (map 'list #'make-label keys)) + (others (make-label 'others)) + (done (or done-label (make-label 'done))) + ) + (if (lisp:and (<= (length clauses) 4) + (loop for (a b) on sorted-keys always (or (null b) (= (1+ a) b)))) + ;; short, contiguous case: search for a combination of bias + ;; and tests that let you dispatch without comparing + (let* ((bias ) + (tests + (loop repeat (1+ (length keys)) + as try = + (loop for (key . rest) on keys + with candidates = `( + (,#'(lambda (k) (< k 0)) + (BLT ,test-var) (BGE ,test-var)) + (,#'(lambda (k) (= k 0)) + (BEQ ,test-var) (BNE ,test-var)) + (,#'(lambda (k) (> k 0)) + (BGT ,test-var) (BLE ,test-var)) + (,#'(lambda (k) (oddp k)) + (BLBS ,test-var) (BLBC ,test-var)) + (,#'(lambda (k) (evenp k)) + (BLBC ,test-var) (BLBS ,test-var)) + (,#'(lambda (k) + (lisp:and bias (< (- k bias) 0))) + (BLT ,temp) (BGE ,temp)) + (,#'(lambda (k) + (lisp:and bias (= (- k bias) 0))) + (BEQ ,temp) (BNE ,temp)) + (,#'(lambda (k) + (lisp:and bias (> (- k bias) 0))) + (BGT ,temp) (BLE ,temp)) + (,#'(lambda (k) + (lisp:and bias (oddp (- k bias)))) + (BLBS ,temp) (BLBC ,temp)) + (,#'(lambda (k) + (lisp:and bias (evenp (- k bias)))) + (BLBC ,temp) (BLBS ,temp)) + ) + collect + (rest + (find-if + #'(lambda (cand) + (let ((verifier (first cand))) + (lisp:and (funcall verifier key) + (notany verifier rest)))) + candidates))) + ;; do (format t "~&Bias ~D, Try: ~S" bias try) + do (when (notany #'null try) + (return try)) + (if bias + (incf bias) + (setq bias (first sorted-keys))) + finally (error "Can't find test chain") + ))) + `((SUBQ ,test-var ,bias ,temp) + (,@(second (pop tests)) ,others) + (label ,(pop labels)) + ,@(rest (pop clauses)) + (BR zero ,done) + ,@(loop for clause in (butlast clauses) + for label in labels + collect `((label ,label) + ,@(rest clause) + (BR zero ,done))) + (label ,others) + ,@(loop for test in (butlast tests) + for label in labels + collect `(,@(first test) ,label)) + (label ,(car (last labels))) + ,@(rest (car (last clauses))) + ,(if done-label + `(BR zero ,done) + `(label ,done)))) + ;; Interleave compares and branches for dual-issue + `((CMPEQ ,test-var ,(pop keys) ,temp) + (branch-false ,temp ,others) + (label ,(pop labels)) + ,@(rest (pop clauses)) + (BR zero ,done) + ,@(loop for clause in (butlast clauses) + for label in labels + collect `((label ,label) + ,@(rest clause) + (BR zero ,done))) + (label ,others) + (NOP) + ,@(loop for previous = nil then this + for this in (append (butlast keys) '(nil)) + for prreg = nil then thisreg + for thisreg in (circular-list temp temp2) + for prlabel in (append '(nil) labels) + collect `(,@(when this + `((CMPEQ ,test-var ,(eval this) ,thisreg))) + ,@(when previous + `((branch-true ,prreg ,prlabel))))) + (label ,(car (last labels))) + ,@(rest (car (last clauses))) + ,(if done-label + `(BR zero ,done) + `(label ,done))))))) + +(defmacro generate-array-element-ldb (bp element data index temp) + "Emits optimal ldb code for known BP" + (let* ( + ;; we don't care about the list bit + (index-mask (lognot (lsh -1 bp))) + (index-shift (- 5 bp)) + (element-mask (lognot (lsh -1 (lsh 32 (- bp))))) + (value element)) + ;; The stack push of the result is interleaved with the + ;; load for dual-issue and stall reduction + `((comment ,(format nil "AREF1-~AB" (lsh 1 (- 5 bp)))) + ,@(case bp + (0 ;; Hack alert! we don't need to move data at all! + (progn (setq value data) nil)) + (1 `((AND ,index ,index-mask ,temp) + (ADDQ ,temp ,temp ,temp "Bletch, it's a byte ref") + (EXTWL ,data ,temp ,value))) + (2 `((NOP) + (AND ,index ,index-mask ,temp) + (EXTBL ,data ,temp ,value))) + (t `((NOP) + (AND ,index ,index-mask ,temp "byte-index") + ,(if (plusp index-shift) + `(SLL ,temp ,index-shift ,temp "byte-position") + `(NOP)) + (SRL ,data ,temp ,value "byte in position") + (AND ,value ,element-mask ,value "byte masked"))))))) + +;;; extract from 'word' the 'element' given 'bp' and 'index' +(defmacro array-element-ldb (bp index word element temp temp2) + (check-temporaries (bp index word) (element temp temp2)) + `((byte-packing-modulus-and-rotation ,bp ,index ,temp ,element) + (byte-packing-mask ,bp ,temp ,temp2) + (SRL ,word ,element ,element "Shift the byte into place") + (AND ,temp ,element ,element "Mask out unwanted bits."))) + +;; (array-element-ldb t1 t2 t3 t4 t5 t6) +#|| +;; Experimental +;; 13-cycle version of same +;; Total magic: Note that the shift instructions only pay attention to +;; the low 6 bits of shift and that (ldb (byte 6 0) (- 64 x)) == (ldb +;; (byte 6 0) (- x)) +(defmacro array-element-ldb (bp index word element temp temp2) + (check-temporaries (bp index word) (element temp temp2)) + (load-constant ,temp -1) + (SLL ,temp ,bp ,temp "modulus mask") + (load-constant ,temp2 5) + (BIC ,index ,temp ,temp "byte-index") + (SUBQ ,temp2 ,bp ,temp2 "(LOG byte-size 2)") + (SLL ,temp ,temp2 ,temp "byte-position") + (load-constant ,element -32) + (SRA ,element ,bp ,temp2 "64 - size") + (SUBQ ,temp2 ,temp ,temp "64 - (size + pos)") + (SLL ,word ,temp ,element "clear high bits: element = word<<(64 - (size + pos))") + (SRL ,element ,temp2 ,element "shift into place: element >>= 64 - size")) +||# + +;;; shove 'element' into 'word' at position indicated by 'bp' and 'index' +;;; this is fairly expensive, around 27 cycles! unpacked case (bp=0) +;;; should avoid this path! +(defmacro array-element-dpb (element bp index word + temp temp2 temp3 temp4 temp5) + (check-temporaries (element bp index word) (temp temp2 temp3 temp4 temp5)) + (let ((simple (gensym)) + (done (gensym))) + `((byte-packing-modulus-and-rotation ,bp ,index ,temp ,temp2) + (byte-packing-size ,bp ,temp) ;temp is the byte size + (byte-packing-mask-and-unmask-given-size ,bp ,temp4 ,temp3 ,temp) + (BEQ ,temp2 ,simple "inserting into the low byte is easy") + (comment "Inserting the byte into any byte other than the low byte") + (ADDQ zero 64 ,temp5) + (SUBQ ,temp5 ,temp2 ,temp "= the left shift rotate amount") + (SRL ,word ,temp2 ,temp5 "shift selected byte into low end of word.") + (SLL ,word ,temp ,word "rotate low bits into high end of word.") + (AND ,temp3 ,temp5 ,temp5 "Remove unwanted bits") + (SRL ,word ,temp ,word "rotate low bits back into place.") + (AND ,element ,temp4 ,temp "Strip any extra bits from element") + (BIS ,temp ,temp5 ,temp5 "Insert new bits.") + (SLL ,temp5 ,temp2 ,temp5 "reposition bits") + (BIS ,word ,temp5 ,word "Replace low order bits") + (BR zero ,done) + (label ,simple) + (comment "Inserting the byte into the low byte") + (AND ,word ,temp3 ,word "Remove the old low byte") + (AND ,element ,temp4 ,temp "Remove unwanted bits from the new byte") + (BIS ,word ,temp ,word "Insert the new byte in place of the old byte") + (label ,done)))) + +;; (array-element-dpb t1 t2 t3 t4 t5 t6 t7 t8 t9) + +#|| +;; Experimental +;; 16-cycle version of same +;; Total magic: Note that the shift instructions only pay attention to +;; the low 6 bits of shift and that (ldb (byte 6 0) (- 64 x)) == (ldb +;; (byte 6 0) (- x)) +(defmacro array-element-dpb (element bp index word temp temp2 temp3 temp4 temp5) + (check-temporaries (element bp index word) (temp temp2 temp3 temp4 temp5)) + `((load-constant ,temp4 -1) + (SLL ,temp4 ,bp ,temp "modulus mask") + (load-constant ,temp2 5) + (BIC ,index ,temp ,temp "byte-index") + (SUBQ ,temp2 ,bp ,temp2 "(LOG byte-size 2)") + (SLL ,temp ,temp2 ,temp "byte-position") + (load-constant ,temp5 -32) + (SRA ,temp5 ,bp ,temp5 "64 - size") + (SLL ,element ,temp ,temp3 "temp3 = element<l+o sl=l+o + (BIS ,temp8 zero ,length) + + (label ,leafarray) ; here when leaf array located. + (SUBQ ,length ,totaloffset ,length) + (stack-push2 ,atag ,temp9 ,temp10) ; push the array -- unforwarded. + (BIS zero |TypeFixnum| ,temp7) + (SRL ,temp3 |ArrayRegisterBytePackingPos| ,temp8) + (LDQ ,temp PROCESSORSTATE_AREVENTCOUNT (ivory)) + (SLL ,temp8 |ArrayRegisterBytePackingPos| ,temp8) ; reposition the bytepacking. + (SUBQ zero 1 ,temp11 "-1") + (SLL ,temp11 ,bp ,temp11 "(LSH -1 byte-packing)") + (BIC ,totaloffset ,temp11 ,temp11) + (SLL ,temp11 |ArrayRegisterByteOffsetPos| ,temp11) + (ADDQ ,temp8 ,temp ,temp8 "Construct the array register word") + (ADDQ ,temp11 ,temp8 ,temp8 "Add in the byte offset") + (stack-push2 ,temp7 ,temp8 ,temp6) ; push the control word. + (cmovle ,length zero ,length) + (BEQ ,length ,zerolength) + (logical-shift ,totaloffset ,bp ,totaloffset ,temp :direction :right) + (ADDQ ,totaloffset ,indirect ,indirect) ; displace the array. + (label ,zerolength) + (stack-push-ir |TypeLocative| ,indirect ,temp8) ; pushes with CDR-NEXT + (stack-push2 ,temp7 ,length ,temp8) + (BR zero ,done) + + (label ,tailindirect) + (ADDQ ,indirect 1 ,temp "length=array+1") + (memory-read ,temp ,temp4 ,thislength processorstate_dataread ,temp7 ,temp8 ,temp10 ,temp11) + (CheckDataType ,temp4 |TypeFixnum| ,iex ,temp) ; if bad length, give up. + (ADDQ ,indirect 2 ,temp "offset=array+2") + (memory-read ,temp ,temp4 ,indexoffset processorstate_dataread ,temp7 ,temp8 ,temp10 ,temp11) + (CheckDataType ,temp4 |TypeFixnum| ,iex ,temp) ; if bad offset, give up. + (ADDQ ,indirect 3 ,temp "next=array+3") + (memory-read ,temp ,temp4 ,indirect processorstate_dataread ,temp7 ,temp8 ,temp10 ,temp11) + (logical-shift ,thislength ,bpd ,temp10 ,temp8) + (ADDQ ,length ,offset ,temp8) ; compute length + (CMOVLE ,temp10 ,temp8 ,temp10) ; if sl<0 sl=l+o + (SUBQ ,temp10 ,temp8 ,temp7) ; t7=sl-l+0 + (CMOVLE ,temp7 ,temp10 ,temp8) ; if l+o>sl l+0=sl + (BIS ,temp8 zero ,length) + + (type-dispatch ,temp4 ,temp8 ,temp10 + (|TypeLocative| + (BR zero ,leafarray)) + (|TypeFixnum| + (BR zero ,leafarray)) + (|TypeArray| + (label ,arrayind) + ;; Here with another array indirection. + (logical-shift ,indexoffset ,bpd ,offset ,temp7) + (ADDQ ,totaloffset ,offset ,totaloffset) + (BR zero ,chaseloop)) + (|TypeString| + (BR zero ,arrayind)) + (:else (BR zero ,iex)))))) + + ;; The string case is the same as the array case -- so go do it. + (|TypeString| + (BR zero ,doarray)) + (:else (BR zero ,iex))) ; take the exception on error case. + + (label ,iex) + (BIS zero |ReturnValueException| ,temp2) + (RET zero R0 1) + (label ,done) + (BIS zero |ReturnValueNormal| ,temp2) + (RET zero R0 1)))) + +;;; Fin. diff --git a/alpha-emulator/imacbind.lisp b/alpha-emulator/imacbind.lisp new file mode 100644 index 0000000..b19ebb1 --- /dev/null +++ b/alpha-emulator/imacbind.lisp @@ -0,0 +1,33 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; This file contains macros supporting binding instructions. These are +;;; mostly in ifunbind.as + +;; Returns BSP as the new binding stack pointer +(defmacro unbind (bsp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (let ((unbind (gensym))) + `((LDQ ,bsp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (get-control-register ,temp4) ;temp4 = CR + (EXTLL ,bsp 0 ,bsp "vma only") + (load-constant ,temp2 #.1_25 "cr.cleanup-bindings") + (SUBQ ,bsp 1 ,temp5) ;temp5 = BSP-1 + (AND ,temp4 ,temp2 ,temp3) ;temp3 = cleanup bit from CR + (BIC ,temp4 ,temp2 ,temp4 "Turn off the bit") ;temp4 = new CR (cleanup bit off) + (BNE ,temp3 ,unbind) ;lose if the cleanup bit was not set + (LDQ ,temp4 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (illegal-operand binding-stack-underflow) + (label ,unbind) + (memory-read ,bsp ,temp7 ,temp6 PROCESSORSTATE_BINDREAD ,temp8 ,temp9 ,temp10 ,temp11 nil t) + (memory-read ,temp5 ,temp3 ,temp2 PROCESSORSTATE_BINDREAD ,temp8 ,temp9 ,temp10 ,temp11) + (store-contents ,temp2 ,temp7 ,temp6 PROCESSORSTATE_BINDWRITE + ,temp8 ,temp9 ,temp10 ,temp11, temp12) + (AND ,temp3 #x40 ,temp3 "Get the old cleanup-bindings bit") + (SLL ,temp3 ,(- 25 6) ,temp3) + (SUBQ ,bsp 2 ,bsp) + (STL ,bsp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory) "vma only") + (BIS ,temp4 ,temp3 ,temp4) ;new CR with old cleanup bit + (set-control-register ,temp4)))) + +;;; Fin. diff --git a/alpha-emulator/imacbits.lisp b/alpha-emulator/imacbits.lisp new file mode 100644 index 0000000..67c354a --- /dev/null +++ b/alpha-emulator/imacbits.lisp @@ -0,0 +1,49 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of logical instructions. These are mostly in ifunbits.as + +(defmacro ilogical (name operator) + (let ((tag1notfix (gensym)) + (tag2notfix (gensym))) + `((LDL t3 4 (iSP) "Get tag from ARG1") + (LDL t4 0 (iSP) "Grab data for ARG1") + (EXTBL arg1 4 t1 "Get tag from ARG2") + (CheckDataType t3 |TypeFixnum| ,tag1notfix t6) + (CheckDataType t1 |TypeFixnum| ,tag2notfix t6) + (comment "Here we know that both args are fixnums!") + (,operator t4 arg1 t4 "Do the operation") + (GetNextPCandCP) + (NOP) + ,@(when (not (eq name 'AND)) + `((EXTLL t4 0 t4 "Strip high bits"))) + (stack-write-ir |TypeFixnum| t4 t1 "Push result") + (ContinueToNextInstruction-NoStall) + (label ,tag1notfix "Here if ARG1 not fixnum") + (NumericTypeException t3 ,name arg1) + (label ,tag2notfix "Here if ARG2 not fixnum") + (NumericTypeException t1 ,name arg1)))) + +(defmacro ilogical-immediate (name operator) + (let ((tag1notfix (gensym))) + `((LDL t3 4 (iSP) "Get tag from ARG1") + (SLL arg2 #.(- 64 8) arg2) + (LDL t4 0 (iSP) "Grab data for ARG1") + (SRA arg2 #.(- 64 8) arg2) + (CheckDataType t3 |TypeFixnum| ,tag1notfix t6) + (comment "Here we know that both args are fixnums!") + (,operator t4 arg2 t4 "Do the operation") + (GetNextPCandCP) + (NOP) + ,@(when (not (eq name 'AND)) + `((EXTLL t4 0 t4 "Strip high bits"))) + (stack-write-ir |TypeFixnum| t4 t1 "Push result") + (ContinueToNextInstruction-NoStall) + (label ,tag1notfix "Here if ARG1 not fixnum") + (BIS zero |TypeFixnum| arg1) + (EXTLL arg2 0 arg2) + (SetTag arg1 arg2 t1) + (NumericTypeException t3 ,name t1)))) + +;;; Fin diff --git a/alpha-emulator/imacblok.lisp b/alpha-emulator/imacblok.lisp new file mode 100644 index 0000000..13b7a73 --- /dev/null +++ b/alpha-emulator/imacblok.lisp @@ -0,0 +1,210 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of block instructions. These are mostly in ifunblok.as + + +(assert (lisp:and (< (integer-length processorstate$q-bar0) 15) + (< (integer-length processorstate$q-bar1) 15) + (< (integer-length processorstate$q-bar2) 15) + (< (integer-length processorstate$q-bar3) 15)) + () + "The BAR registers have an offset of more than 15 bits") + +;;; Note well! We always store the updated VMA back into the BAR, even +;;; in the no-increment case. This is because the BAR must get the result +;;; of having followed forwarding pointers. + +;;; Note well! We always store the updated VMA back into the BAR, even +;;; in the no-increment case. This is because the BAR must get the result +;;; of having followed forwarding pointers. + +(defmacro i%block-n-read (bar op vma tag data cycle temp3 temp4 temp5 temp6 temp9 temp10 temp11 temp12) + (check-temporaries (bar op) (cycle vma temp3 temp4 temp5 temp6 data tag temp9 temp10 temp11 temp12)) + (let ((fntest (gensym)) + (nofntest (gensym)) + (ielab (gensym))) + (push + `((label ,fntest) + (CheckDataType ,tag |TypeFixnum| ,ielab ,temp9) + (BR zero ,nofntest)) + *function-epilogue*) + `((LDL ,vma 0 (,bar) "Get the vma") + (SRL ,op 6 ,cycle "cycle type") + (AND ,op 4 ,temp4 "=no-incrementp") + ;;; we don't care about last-word + (AND ,op 16 ,temp5 "=cdr-code-nextp") + (AND ,op 32 ,temp6 "=fixnum onlyp") + (EXTLL ,vma 0 ,vma) + (comment "Do the read cycle") + (memory-read ,vma ,tag ,data ,cycle ,temp9 ,temp10 ,temp11 ,temp12 nil t) + (BNE ,temp6 ,fntest "J. if we have to test for fixnump.") + (unlikely-label ,nofntest) + (ADDQ ,vma 1 ,temp6 "Compute Incremented address") + (force-alignment) + (CMOVEQ ,temp4 ,temp6 ,vma "Conditionally update address") + (STL ,vma 0 (,bar) "Store updated vma in BAR") + (AND ,tag #x3F ,temp4 "Compute CDR-NEXT") + (GetNextPC) + (CMOVNE ,temp5 ,temp4 ,tag "Conditionally Set CDR-NEXT") + (GetNextCP) + (stack-push2-with-cdr ,tag ,data) + (ContinueToNextInstruction-NoStall) + (label ,ielab) + (illegal-operand block-read-transport-and-fixnum-type-check ,vma "Not a fixnum")))) + +(defmacro i%block-n-write (bar-register bar-vma data temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9) + (check-temporaries (bar-register bar-vma data) (temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + `((SRL ,data 32 ,temp3 "Get tag") + (EXTLL ,data 0 ,temp4 "Get data") + (memory-write ,bar-vma ,temp3 ,temp4 PROCESSORSTATE_RAW ,temp9 ,temp5 ,temp6 ,temp7 ,temp8) + (GetNextPCandCP) + (ADDQ ,bar-vma 1 ,bar-vma "Increment the address") + ;; Can't side-effect the BAR until after the write in case it would trap. + (STL ,bar-vma 0 (,bar-register) "Store updated vma in BAR") + (ContinueToNextInstruction-NoStall))) + +(defmacro i%block-n-read-shift (bar op temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (check-temporaries (bar op) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12)) + (let ((nofntest (gensym)) + (noincp (gensym)) + (noclrcdr (gensym)) + (ielab (gensym))) + `((LDL ,temp2 0 (,bar) "Get the vma") + (SRL ,op 6 ,temp "cycle type") + (AND ,op 4 ,temp4 "=no-incrementp") + ;;; we don't care about last-word + (AND ,op 16 ,temp5 "=cdr-code-nextp") + (AND ,op 32 ,temp6 "=fixnum onlyp") + (EXTLL ,temp2 0 ,temp2) + (memory-read ,temp2 ,temp8 ,temp7 ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (BEQ ,temp6 ,nofntest "J. if we don't have to test for fixnump.") + (CheckDataType ,temp8 |TypeFixnum| ,ielab ,temp9) + (label ,nofntest) + (BNE ,temp4 ,noincp "J. if we don't have to increment the address.") + (ADDQ ,temp2 1 ,temp2 "Increment the address") + (label ,noincp) + (STL ,temp2 0 (,bar) "Store updated vma in BAR") + (BEQ ,temp5 ,noclrcdr "J. if we don't have to clear CDR codes.") + (AND ,temp8 #x3F ,temp8) + (label ,noclrcdr) + (load-constant ,temp #.(dpb (sys:%alu-function-dpb sys:%alu-byte-background-rotate-latch + sys:%alu-byte-set-rotate-latch) + sys:%%alu-function 0) + "Create a fake ALU control register") + (alu-function-byte ,temp ,temp ,temp7 ,temp7 ,temp2 ,temp3 ,temp4 ,temp5 ,temp6) + (GetNextPCandCP) + (stack-push2-with-cdr ,temp8 ,temp7) + (ContinueToNextInstruction-NoStall) + (label ,ielab) + (illegal-operand block-read-transport-and-fixnum-type-check ,temp2 "Not a fixnum")))) + +(defmacro i%block-n-read-alu (bar addr temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (check-temporaries (bar addr) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12)) + (let ((ielab2 (gensym)) + (ielab1 (gensym)) + (op1tag temp2) + (op1data temp3) + (op2tag temp4) + (op2data temp5) + (aluop temp6) + (control temp7) + (result temp8)) + `((LDL ,temp 0 (,bar) "Get the vma") + (stack-read2 ,addr ,op2tag ,op2data) + (CheckDataType ,op2tag |TypeFixnum| ,ielab2 ,temp9) + (EXTLL ,temp 0 ,temp) + (memory-read ,temp ,op1tag ,op1data PROCESSORSTATE_DATAREAD ,temp9 ,temp10 ,temp11 ,temp12) + (CheckDataType ,op1tag |TypeFixnum| ,ielab1 ,temp9) + (ADDQ ,temp 1 ,temp "Increment the address") + (STL ,temp 0 (,bar) "Store updated vma in BAR") + (LDQ ,aluop PROCESSORSTATE_ALUOP (ivory)) + (STQ zero PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LDQ ,control PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (basic-dispatch ,aluop ,temp + (|ALUFunctionBoolean| + (alu-function-boolean ,control ,result ,op1data ,op2data ,temp) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction)) + (|ALUFunctionByte| + (alu-function-byte ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction)) + (|ALUFunctionAdder| + (alu-function-adder ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction)) + (|ALUFunctionMultiplyDivide| + (alu-function-multiply-divide ,control ,op1data ,op2data ,result ,temp ,temp9) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction))) + (label ,ielab2) + (SCAtoVMA ,addr ,temp ,temp9) + (illegal-operand block-read-transport-and-fixnum-type-check ,temp "Not a fixnum") + (label ,ielab1) + (illegal-operand block-read-transport-and-fixnum-type-check ,temp "Not a fixnum")))) + +(defmacro i%block-n-read-test (bar op vma temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (check-temporaries (bar op) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12)) + (let ((nofntest (gensym)) + (noincp (gensym)) + (noclrcdr (gensym)) + (ielab1 (gensym)) + (ielab2 (gensym)) + (taken (gensym)) + (op1tag temp2 ) + (op1data temp3) + (op2tag temp4) + (op2data temp5) + (aluop temp6) + (control temp7) + (result temp8)) + `((LDL ,vma 0 (,bar) "Get the vma") + (SRL ,op 6 ,temp "cycle type") + (stack-read2 iSP ,op2tag ,op2data) + (EXTLL ,vma 0 ,vma) + (memory-read ,vma ,op1tag ,op1data ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (AND ,op 32 ,temp "=fixnum onlyp") + (BEQ ,temp ,nofntest "J. if we don't have to test for fixnump.") + (CheckDataType ,op1tag |TypeFixnum| ,ielab1 ,temp9) + (CheckDataType ,op2tag |TypeFixnum| ,ielab2 ,temp9) + (label ,nofntest) + (AND ,op 16 ,temp "=cdr-code-nextp") + (BEQ ,temp ,noclrcdr "J. if we don't have to clear CDR codes.") + (TagType ,op1tag ,op1tag) + (label ,noclrcdr) + (LDQ ,aluop PROCESSORSTATE_ALUOP (ivory)) + (STQ zero PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LDQ ,control PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (basic-dispatch ,aluop ,temp + (|ALUFunctionBoolean| + (alu-function-boolean ,control ,result ,op1data ,op2data ,temp)) + (|ALUFunctionByte| + (alu-function-byte ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11 ,temp12)) + (|ALUFunctionAdder| + (alu-function-adder ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11)) + (|ALUFunctionMultiplyDivide| + (alu-function-multiply-divide ,control ,op1data ,op2data ,result ,temp ,temp9))) + (alu-compute-condition ,control ,op1tag ,op2tag ,result ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (branch-true ,temp ,taken) + (AND ,op 4 ,temp "=no-incrementp") + (BNE ,temp ,noincp "J. if we don't have to increment the address.") + (ADDQ ,vma 1 ,vma "Increment the address") + (label ,noincp) + (STL ,vma 0 (,bar) "Store updated vma in BAR") + (ContinueToNextInstruction) + (label ,taken) + (stack-read2-disp iSP -8 ,temp9 ,temp10) + #+++ignore (CheckAdjacentDataTypes ,temp9 |TypeEvenPC| 2 ,except ,temp10) + (SLL ,temp10 1 ,temp10) + (AND ,temp9 1 iPC) + (ADDQ iPC ,temp10 iPC) + (BR zero InterpretInstructionForJump) + (label ,ielab2) + (SCAtoVMA iSP ,vma ,temp9) + (illegal-operand block-read-transport-and-fixnum-type-check ,vma "Not a fixnum") + (label ,ielab1) + (illegal-operand block-read-transport-and-fixnum-type-check ,vma "Not a fixnum")))) + +;;; Fin. diff --git a/alpha-emulator/imacfext.lisp b/alpha-emulator/imacfext.lisp new file mode 100644 index 0000000..43decec --- /dev/null +++ b/alpha-emulator/imacfext.lisp @@ -0,0 +1,12 @@ +;;; -*- Package: ALPHA-HACKS; Syntax: Common-Lisp; Mode: LISP -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of field extraction. + +(defmacro ldb-shift (value position result) + (let ((noshift (gensym))) + `((BEQ ,position ,noshift "No shifting needed when byte position is zero") + (SLL ,value ,position ,result) + (SRL ,result 32 ,result "t4 is the shifted field") + (label ,noshift)))) diff --git a/alpha-emulator/imacgene.lisp b/alpha-emulator/imacgene.lisp new file mode 100644 index 0000000..0396b34 --- /dev/null +++ b/alpha-emulator/imacgene.lisp @@ -0,0 +1,156 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;; This ensures there are two arguments +(defmacro verify-generic-arity (cr nargs temp4) + (let ((recheck (gensym))) + `((load-constant ,temp4 #.1_17 "cr.apply") + (AND ,temp4 ,cr ,temp4) + (BEQ ,temp4 ,recheck "not applying") + (SUBQ zero ,nargs arg1 "4 - argsize") + ;; Pulls arg1 args and retries + (BR zero |PullApplyArgs|) + (label ,recheck) + (illegal-operand too-few-arguments)))) + +;; Reads the instance itag/idata and returns mask data and mapping table data +(defmacro instance-descriptor-info (itag idata mask-data table-data + vma tag data temp temp2 temp3 temp4) + (let ((masknotfix (gensym)) + (notlocative (gensym)) + (instance-tag (gensym)) + (non-instance-tag (gensym))) + (push + `((label ,non-instance-tag) + (comment "not an instance, flavor description comes from magic vector") + (LDQ ,vma PROCESSORSTATE_TRAPVECBASE (ivory)) + (TagType ,itag ,temp) + (LDA ,vma #.sys:%generic-dispatch-vector (,vma)) + (ADDQ ,temp ,vma ,vma) + ;; We know the m-m-r is active when we are called + (using-multiple-memory-reads + (,*memoized-vmdata* ,*memoized-vmtags* ,*memoized-base* ,*memoized-limit*) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4 + ,instance-tag)) + (label ,masknotfix) + (illegal-operand (flavor-search-mask-not-fixnum data-read) ,vma) + (label ,notlocative) + (illegal-operand (flavor-search-table-pointer-not-locative data-read) ,vma)) + *function-epilogue*) + `((CheckAdjacentDataTypes ,itag |TypeInstance| 4 ,non-instance-tag ,temp) + (BIS ,idata zero ,vma "Don't clobber instance if it's forwarded") + (memory-read ,vma ,tag ,data PROCESSORSTATE_HEADER ,temp ,temp2 ,temp3 ,temp4) + (label ,instance-tag) + (BIS ,data zero ,vma) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4) + (BIS ,data zero ,mask-data) + (CheckDataType ,tag |TypeFixnum| ,masknotfix ,temp) + (ADDQ ,vma 1 ,vma) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4) + (BIS ,data zero ,table-data) + (CheckDataType ,tag |TypeLocative| ,notlocative ,temp)))) + +(defmacro non-instance-descriptor-info (itag idata mask-data table-data + temp temp2 temp3 temp4 temp5 temp6 temp7 + instance-tag non-instance-tag) + (declare (ignore idata table-data temp7 non-instance-tag)) + `((comment "not an instance, flavor description comes from magic vector") + (LDQ ,temp5 PROCESSORSTATE_TRAPVECBASE (ivory)) + (TagType ,itag ,mask-data) + (load-constant ,temp6 #.sys:%generic-dispatch-vector "Damned 8-bit literals!") + (ADDQ ,mask-data ,temp5 ,mask-data) + (ADDQ ,mask-data ,temp6 ,mask-data) + (memory-read ,mask-data ,temp5 ,temp6 PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4 + ,instance-tag) + ;; (BR zero ,instance) done by MEMORY-READ + )) + +;; Returns parameter ptag/pdata and method mtag/mdata +(defmacro lookup-handler (gtag gdata table mask ptag pdata mtag mdata + offset vma tag data temp2 temp3 temp4 temp5) + (let ((found (gensym)) + (loop (gensym)) + ) + `((AND ,mask ,gdata ,vma) + (SLL ,vma 1 ,temp2) + (ADDQ ,vma ,temp2 ,offset "(* (logand mask data) 3)") + (TagType ,gtag ,gtag) + (label ,loop) + (ADDQ ,table ,offset ,vma) + (ADDQ ,offset 3 ,offset) + (comment "Read key") + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5 nil t) + (TagType ,tag ,tag) + (CMPEQ ,tag |TypeNIL| ,temp2) + (branch-true ,temp2 ,found) + (CMPEQ ,gtag ,tag ,temp2) + (branch-false ,temp2 ,loop) + (SUBL ,gdata ,data ,temp2) + (branch-true ,temp2 ,loop) + (label ,found) + (comment "Read method") + (addq ,vma 1 ,vma) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5) + (BIS ,tag zero ,mtag) + (BIS ,data zero ,mdata) + (comment "Read parameter") + (addq ,vma 1 ,vma) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5) + (BIS ,tag zero ,ptag) + (BIS ,data zero ,pdata) + ))) + +(defmacro generic-dispatch (gtag gdata itag idata mtag mdata ptag pdata cr nargs temp2 temp3) + (let ((isnil (gensym)) + (notpc (gensym))) + `((get-control-register ,cr) + (stack-read2-disp-signed iFP ,(* 2 8) ,gtag ,gdata "get generic tag and data") + (AND ,cr #xFF ,nargs "get number of arguments") + (stack-read2-disp-signed iFP ,(* 3 8) ,itag ,idata "get instance tag and data") + (SUBQ ,nargs 4 ,nargs "done if 2 or more arguments (plus 2 extra words)") + (BLT ,nargs |VerifyGenericArity|) ;CR in ARG6, restarts instruction + (EXTLL ,gdata 0 ,gdata) + (EXTLL ,idata 0 ,idata) + (BSR R0 |LookupHandler|) ;clobbers T1-T5, T10 + (CheckAdjacentDataTypes ,mtag |TypeEvenPC| 2 ,notpc ,temp2) + (AND ,ptag #x3F ,temp2 "Strip CDR code") + (SUBQ ,temp2 |TypeNIL| ,temp2) + (BEQ ,temp2 ,isnil) + (stack-write2-disp iFP ,(* 2 8) ,ptag ,pdata) + (label ,isnil) + (convert-continuation-to-pc ,mtag ,mdata iPC ,temp2) + (BR zero interpretInstructionForJump) + (label ,notpc) + (SCAtoVMA iSP ,temp2 ,temp3) + (illegal-operand (generic-search-table-entry-not-pc data-read) ,temp2)))) + +(defmacro message-dispatch (gtag gdata itag idata mtag mdata ptag pdata cr nargs temp2 temp3) + (let ((isnil (gensym)) + (isntnil (gensym)) + (notpc (gensym))) + `((get-control-register ,cr) + (stack-read2-disp-signed iFP ,(* 3 8) ,gtag ,gdata "get message tag and data") + (AND ,cr #xFF ,nargs "get number of arguments") + (stack-read2-disp-signed iFP ,(* 2 8) ,itag ,idata "get instance tag and data") + (SUBQ ,nargs 4 ,nargs "done if 2 or more arguments (plus 2 extra words)") + (BLT ,nargs |VerifyGenericArity|) ;CR in ARG6, restarts instruction + (EXTLL ,gdata 0 ,gdata) + (EXTLL ,idata 0 ,idata) + (BSR R0 |LookupHandler|) ;clobbers T1-T5, T10 + (stack-read-disp iFP ,(* 2 8) ,idata "clobbered by |LookupHandler|") + (CheckAdjacentDataTypes ,mtag |TypeEvenPC| 2 ,notpc ,temp2) + (AND ,ptag #x3F ,temp2 "Strip CDR code") + (SUBQ ,temp2 |TypeNIL| ,temp2) + (BEQ ,temp2 ,isnil) + (stack-write2-disp iFP ,(* 2 8) ,ptag ,pdata) + (BR zero ,isntnil) + (label ,isnil) + (stack-write2-disp iFP ,(* 2 8) ,gtag ,gdata "swap message/instance in the frame") + (label ,isntnil) + (stack-write-disp iFP ,(* 3 8) ,idata) + (convert-continuation-to-pc ,mtag ,mdata iPC ,temp2) + (BR zero interpretInstructionForJump) + (label ,notpc) + (SCAtoVMA iSP ,temp2 ,temp3) + (illegal-operand (generic-search-table-entry-not-pc data-read) ,temp2)))) diff --git a/alpha-emulator/imacialu.lisp b/alpha-emulator/imacialu.lisp new file mode 100644 index 0000000..ec3ced3 --- /dev/null +++ b/alpha-emulator/imacialu.lisp @@ -0,0 +1,286 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of the alu instructions. These are mostly +;;; in ifunsubp.as + +(defmacro read-alu-condition (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 16 ,r1) + (AND ,r1 #x1F ,r1 "Extract ALU condition"))) + +(defmacro read-alu-condition-sense (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 21 ,r1) + (AND ,r1 1 ,r1 "Extract the condition sense"))) + +(defmacro read-alu-output-condition (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 22 ,r1) + (AND ,r1 1 ,r1 "Extract the output condition"))) + +(defmacro read-alu-enable-condition-exception (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 23 ,r1) + (AND ,r1 1 ,r1 "Extract the enable condition"))) + +(defmacro read-alu-enable-load-con (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 24 ,r1) + (AND ,r1 1 ,r1 "Extract the enable load cin"))) + +(defmacro read-alu-boolean-function (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 10 ,r1) + (AND ,r1 #xF ,r1 "Extract the ALU boolean function"))) + +(defmacro read-alu-byte-rotate (a1 r1) + (check-temporaries (a1) (r1)) + `((AND ,a1 #x1F ,r1 "Extract the Byte Rotate"))) + +(defmacro read-alu-byte-size (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 5 ,r1) + (AND ,r1 #x1F ,r1 "Extract the byte size"))) + +(defmacro read-alu-byte-background (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 10 ,r1) + (AND ,r1 3 ,r1 "Extract the byte background"))) + +(defmacro read-alu-byte-rotate-latch (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 12 ,r1) + (AND ,r1 1 ,r1 "Extractthe byte rotate latch"))) + +(defmacro read-alu-byte-function (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 13 ,r1) + (AND ,r1 1 ,r1))) + +(defmacro read-alu-adder-carry-in (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 10 ,r1) + (AND ,r1 1 ,r1 "Extract the adder carry in"))) + +(defmacro write-alu-adder-carry-in (a1 r1 t1) + (check-temporaries (a1) (r1)) + `((load-constant ,t1 #.1_10) + (BIC ,a1 ,t1 ,a1) + (AND ,r1 1 ,t1) + (SLL ,t1 10 ,t1) + (BIS ,a1 ,t1 ,a1 "Set the adder carry in"))) + +(defmacro read-alu-adder-op2 (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 11 ,r1) + (AND ,r1 3 ,r1 "Extract the op2"))) + +(defmacro read-alu-function-class-bits (a1 r1) + (check-temporaries (a1) (r1)) + `((SRL ,a1 14 ,r1) + (AND ,r1 3 ,r1 "Extract the function class bits"))) + +(defmacro alu-function-boolean (alu res op1 op2 temp) + `((read-alu-boolean-function ,alu ,res) + (basic-dispatch ,res ,temp ;+++ efficancy hack pf + (|BooleClear| + ;; (BIS zero zero ,res) ;Commented out because res IS zero + ) + (|BooleAnd| + (AND ,op1 ,op2 ,res)) + (|BooleAndC1| + (BIC ,op2 ,op1 ,res)) + (|Boole2| + (BIS ,op2 zero ,res)) + (|BooleAndC2| + (BIC ,op1 ,op2 ,res)) + (|Boole1| + (BIS ,op1 zero ,res)) + (|BooleXor| + (XOR ,op1 ,op2 ,res)) + (|BooleIor| + (BIS ,op1 ,op2 ,res)) + (|BooleNor| + (BIS ,op1 ,op2 ,res) + (ORNOT zero ,res ,res)) + (|BooleEquiv| + (XOR ,op1 ,op2 ,res) + (ORNOT zero ,res ,res)) + (|BooleC1| + (ORNOT zero ,op1 ,res)) + (|BooleOrC1| + (ORNOT ,op2 ,op1 ,res)) + (|BooleC2| + (ORNOT zero ,op2 ,res)) + (|BooleOrC2| + (BIC ,op1 ,op2 ,res)) + (|BooleNand| + (AND ,op1 ,op2 ,res)) + (|BooleSet| + (ORNOT zero zero ,res))))) + +(defmacro alu-function-byte (alu op1 op2 res bgnd rot siz temp temp2) + (let ((hrl (gensym)) + (mask temp2)) + `((LDQ ,rot PROCESSORSTATE_BYTEROTATE (ivory) "Get rotate") + (LDQ ,siz PROCESSORSTATE_BYTESIZE (ivory) "Get bytesize") + (comment "Get background") + (read-alu-byte-background ,alu ,bgnd) + (basic-dispatch ,bgnd ,temp + (|ALUByteBackgroundOp1| + (BIS ,op1 zero ,bgnd)) + (|ALUByteBackgroundRotateLatch| + (LDQ ,bgnd PROCESSORSTATE_ROTATELATCH (ivory))) + (|ALUByteBackgroundZero| + (BIS zero zero ,bgnd))) + (read-alu-byte-rotate-latch ,alu ,temp2) + (SLL ,op2 ,rot ,res) + (EXTLL ,res 4 ,temp) + (EXTLL ,res 0 ,res) + (BIS ,res ,temp ,res "OP2 rotated") + (BEQ ,temp2 ,hrl "Don't update rotate latch if not requested") + (STQ ,res PROCESSORSTATE_ROTATELATCH (ivory)) + (label ,hrl) + (load-constant ,mask -2) + (SLL ,mask ,siz ,mask) + (ORNOT zero ,mask ,mask "Compute mask") + (comment "Get byte function") + (read-alu-byte-function ,alu ,temp) + (basic-dispatch ,temp ,siz + (|ALUByteFunctionDpb| + (SLL ,mask ,rot ,mask "Position mask")) + (|ALUByteFunctionLdb|)) + (AND ,res ,mask ,res "rotated&mask") + (BIC ,bgnd ,mask ,bgnd "background&~mask") + (BIS ,res ,bgnd ,res)))) + +(defmacro alu-function-adder (alu op1 op2 res op2a carryin temp temp2) + (let ((skipcinupdate (gensym))) + `((read-alu-adder-op2 ,alu ,temp) + (read-alu-adder-carry-in ,alu ,carryin) + (basic-dispatch ,temp ,temp2 + (|ALUAdderOp2Op2| + (BIS ,op2 zero ,op2a)) + (|ALUAdderOp2Zero| + (BIS zero zero ,op2a)) + (|ALUAdderOp2Invert| + (sign-extendq 32 ,op2 ,op2a) + (SUBQ zero ,op2a ,op2a) + (EXTLL ,op2a 0 ,op2a)) + (|ALUAdderOp2MinusOne| + (ORNOT zero zero ,op2a) + (EXTLL ,op2a 0 ,op2a))) + (ADDQ ,op1 ,op2a ,res) + (ADDQ ,res ,carryin ,res) + (SRL ,res 31 ,temp "Sign bit") + (SRL ,res 32 ,temp2 "Next bit") + (XOR ,temp ,temp2 ,temp "Low bit is now overflow indicator") + (SRL ,alu 24 ,temp2 "Get the load-carry-in bit") + (STQ ,temp PROCESSORSTATE_ALUOVERFLOW (ivory)) + (BLBC ,temp2 ,skipcinupdate) + (EXTLL ,res 4 ,temp "Get the carry") + (write-alu-adder-carry-in ,alu ,temp ,temp2) + (STQ ,alu PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (label ,skipcinupdate) + (CMPLT ,op1 ,op2a ,temp) + (STQ ,temp PROCESSORSTATE_ALUBORROW (ivory)) + (sign-extendq 32 ,op1 ,op1) + (sign-extendq 32 ,op2 ,op2) + (CMPLT ,op1 ,op2a ,temp) + (STQ ,temp PROCESSORSTATE_ALULESSTHAN (ivory))))) + +(defmacro alu-function-multiply-divide (alu op1 op2 res temp temp2) + `((UnimplementedInstruction))) + +(defmacro alu-compute-condition (alu op1tag op2tag result condition temp temp2 temp3 temp4) + (let ((labone (gensym)) + (labzero (gensym)) + (done (gensym)) + (ov temp2) + (bo temp3) + (lt temp4) + ) + `((read-alu-condition ,alu ,condition) + (LDQ ,ov PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LDQ ,bo PROCESSORSTATE_ALUBORROW (ivory)) + (LDQ ,lt PROCESSORSTATE_ALULESSTHAN (ivory)) + (basic-dispatch ,condition ,temp + (|ALUConditionSignedLessThanOrEqual| + (BNE ,lt ,labone) + (BEQ ,result ,labone)) + (|ALUConditionSignedLessThan| + (BNE ,lt ,labone)) + (|ALUConditionNegative| + (BLT ,result ,labone)) + (|ALUConditionSignedOverflow| + (BNE ,ov ,labone)) + (|ALUConditionUnsignedLessThanOrEqual| + (BNE ,bo ,labone) + (BEQ ,result ,labone)) + (|ALUConditionUnsignedLessThan| + (BNE ,bo ,labone)) + (|ALUConditionZero| + (BEQ ,result ,labone)) + (|ALUConditionHigh25Zero| + (SRL ,result 7 ,condition) + (BEQ ,condition ,labone)) + (|ALUConditionEq| + (BNE ,result ,labzero) + (XOR ,op1tag ,op2tag ,temp) + (TagType ,temp ,temp) + (BEQ ,temp ,labone)) + (|ALUConditionOp1Ephemeralp| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionResultTypeNil| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp2Fixnum| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionFalse| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionResultCdrLow| + (TagCdr ,op1tag ,temp) + (AND ,temp #x01 ,condition) + (BR zero ,done)) + (|ALUConditionCleanupBitsSet| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionAddressInStackCache| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionExtraStackMode| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionFepMode| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionFpCoprocessorPresent| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp1Oldspacep| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionPendingSequenceBreakEnabled| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp1TypeAcceptable| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp1TypeCondition| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionStackCacheOverflow| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOrLogicVariable| + (UnimplementedInstruction)) ;+++ NYI + (:else + (UnimplementedInstruction)) ;+++ NYI + ) + (label ,labzero) + ;; Control arrives here iff the condition tested was false. + (BIS zero zero ,condition) + (BR zero ,done) + (label ,labone) + (BIS zero 1 ,condition) + (label ,done) + ;; CONDITION is now 1 if the condition tested TRUE and 0 if it tested FALSE. + ;; The condition sense will be 0 if we want to branch on TRUE and 1 to branch on FALSE. + ;; Therefore, we can XOR the CONDITION and condition sense together to produce + ;; a 1 if we should branch and a 0 if we shouldn't. + (read-alu-condition-sense ,alu ,temp) + (XOR ,condition ,temp ,condition) + ))) + +;;; Fin. diff --git a/alpha-emulator/imacinst.lisp b/alpha-emulator/imacinst.lisp new file mode 100644 index 0000000..6ac8b2e --- /dev/null +++ b/alpha-emulator/imacinst.lisp @@ -0,0 +1,82 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; This file contains macros supporting instance instructions. These are +;;; mostly in ifuninst.as + +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-HACKS; Base: 10; Lowercase: T -*- + +;;; This file contains macros supporting instance instructions. These are +;;; mostly in ifuninst.as + +(defmacro locate-instance-variable-mapped (n vma mapiop selfiop indexiop iex + tag data temp1 temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (check-temporaries (n vma) (tag data temp1 temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + (let ((done (gensym)) + (doit (gensym)) + (update (gensym))) + (push `((label ,update) + (BIS ,vma zero ,temp3) + ;; We know the m-m-r is active when we are called + (using-multiple-memory-reads + (,*memoized-vmdata* ,*memoized-vmtags* ,*memoized-base* ,*memoized-limit*) + (memory-read ,vma ,tag ,data PROCESSORSTATE_HEADER ,temp5 ,temp6 ,temp7 ,temp8)) + (SUBQ ,temp3 ,vma ,temp3) + (BNE ,temp3 ,doit) + (TagType ,temp4 ,temp4) + (BIS ,temp4 #x40 ,temp4 "Set CDR code to 1") + (stack-write2-disp iFP ,(* 3 8) ,temp4 ,vma "Update self") + (BR zero ,doit)) + *function-epilogue*) + + `((comment "Locate Instance Variable Mapped") + (stack-read2-disp iFP ,(* 2 8) ,tag ,vma "Map") + (CheckDataType ,tag |TypeArray| ,mapiop ,temp2) + (memory-read ,vma ,tag ,data PROCESSORSTATE_HEADER ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (AND ,data |ArrayLengthMask| ,data) + (SUBQ ,data ,n ,temp3) + (BLE ,temp3 ,indexiop "J. if mapping-table-index-out-of-bounds") + (ADDQ ,vma ,n ,vma) + (ADDQ ,vma 1 ,vma) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8) + (BIS ,data zero ,temp1) + (CheckDataType ,tag |TypeFixnum| ,iex ,temp4) ;mapping table entry not fixnum + (stack-read2-disp iFP ,(* 3 8) ,temp4 ,vma "Self") + (CheckAdjacentDataTypes ,temp4 |TypeInstance| 4 ,selfiop ,temp3) + (AND ,temp4 #xC0 ,temp3 "Unshifted cdr code") + (SUBQ ,temp3 #x40 ,temp3 "Check for CDR code 1") + (BNE ,temp3 ,update "J. if CDR code is not 1") + (label ,doit) + (ADDQ ,vma ,temp1 ,vma) + (label ,done)))) + +;; ADDR gets the address of the ordered IV +(defmacro locate-instance-variable-unmapped (n addr iop temp temp2 temp3) + (check-temporaries (n addr) (temp temp2 temp3)) + (let () + `((comment "Locate Instance Variable Unmapped") + (stack-read2-disp iFP ,(* 3 8) ,temp ,temp2 "self") + (CheckAdjacentDataTypes ,temp |TypeInstance| 4 ,iop ,temp3) + (ADDQ ,temp2 ,n ,addr)))) + +(defmacro locate-arbitrary-instance-variable (itag idata otag odata addr instanceiop offsetiop + temp temp2 temp3 temp4 temp5 + temp6 temp7 temp8) + (check-temporaries (itag idata otag odata addr) + (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + (let () + `((comment "Locate Arbitrary Instance Variable") + ;;+++ Needs to check for spare dtp before signalling illegal operand! + (CheckAdjacentDataTypes ,itag |TypeInstance| 4 ,instanceiop ,temp) + (CheckDataType ,otag |TypeFixnum| ,offsetiop ,temp) + (memory-read ,idata ,temp2 ,temp PROCESSORSTATE_HEADER ,temp5 ,temp6 ,temp7 ,temp8) + (SUBQ ,temp 1 ,temp) + (memory-read ,temp ,temp4 ,temp2 PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,temp4 |TypeFixnum| ,offsetiop ,temp5) + (BLT ,odata ,offsetiop "J. if offset <0") ; +++ optimioze this + (SUBQ ,odata ,temp2 ,temp4) + (BGE ,temp4 ,offsetiop "J. if offset out of bounds") + (ADDQ ,odata ,idata ,addr)))) + +;;; Fin. diff --git a/alpha-emulator/imacjosh.lisp b/alpha-emulator/imacjosh.lisp new file mode 100644 index 0000000..c757081 --- /dev/null +++ b/alpha-emulator/imacjosh.lisp @@ -0,0 +1,93 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of AI instructions. These are mostly in ifunjosh.as + +(defmacro get-structure-stack-pointer (to) + `((LDQ ,to PROCESSORSTATE_BAR2 (ivory)))) + +(defmacro set-structure-stack-pointer (to) + `((STQ ,to PROCESSORSTATE_BAR2 (ivory)))) + +(defmacro get-structure-stack-pointer-data (to) + `((LDQ ,to PROCESSORSTATE_BAR2 (ivory)) + (EXTLL ,to 0 ,to))) + +(defmacro set-structure-stack-pointer-data (to) + `((STL ,to PROCESSORSTATE_BAR2 (ivory)))) + +(defmacro get-structure-stack-pointer2 (totag todata) + `((LDL ,todata PROCESSORSTATE_BAR2 (ivory)) + (LDL ,totag |PROCESSORSTATE_BAR2+4| (ivory)) + (EXTLL ,todata 0 ,todata))) + +(defmacro set-structure-stack-pointer2 (totag todata) + `((STL ,totag |PROCESSORSTATE_BAR2+4| (ivory)) + (STL ,todata PROCESSORSTATE_BAR2 (ivory)))) + +(defmacro get-trail-pointer (to) + `((LDQ ,to PROCESSORSTATE_BAR3 (ivory)))) + +(defmacro set-trail-pointer (to) + `((STQ ,to PROCESSORSTATE_BAR3 (ivory)))) + +(defmacro get-trail-pointer-data (to) + `((LDQ ,to PROCESSORSTATE_BAR3 (ivory)) + (EXTLL ,to 0 ,to))) + +(defmacro set-trail-pointer-data (to) + `((STL ,to PROCESSORSTATE_BAR3 (ivory)))) + +(defmacro get-trail-pointer2 (totag todata) + `((LDL ,todata PROCESSORSTATE_BAR3 (ivory)) + (LDL ,totag |PROCESSORSTATE_BAR3+4| (ivory)) + (EXTLL ,todata 0 ,todata))) + +(defmacro set-trail-pointer2 (totag todata) + `((STL ,totag |PROCESSORSTATE_BAR3+4| (ivory)) + (STL ,todata PROCESSORSTATE_BAR3 (ivory)))) + +;;; bind-location (location data) +;;; unless choice-pointer < location <= stackpointer +;;; or structure-stack-choice-pointer < location <= structure-stackpointer +;;; read(location %memory-scavenge) => X (the old contents of location) +;;; if (X not DTP-logic-variable) exception +;;; Store X in trail +;;; increment trail +;;; finally store data in location. + +(defmacro bind-location (loctag locdata valtag valdata exclab temp temp2 temp3 + temp4 temp5 temp6 temp7) + (check-temporaries (loctag locdata valtag valdata) + (temp temp2 temp3 temp4 temp5 temp6 temp7)) + (let ((maketrail (gensym)) + (maybestructure (gensym)) + (notrail (gensym))) + `((get-choice-pointer-data ,temp) + (get-structure-choice-pointer-data ,temp2) + (SUBQ ,temp ,locdata ,temp4) + (SUBQ ,locdata iSP ,temp5) + (get-structure-stack-pointer-data ,temp3) + (BLE ,temp4 ,maybestructure "J. if below choice pointer") + (BLE ,temp5 ,notrail "J. if between choice pointer and stack pointer") + (label ,maybestructure) + (SUBQ ,temp2 ,locdata ,temp4) + (SUBQ ,locdata ,temp3 ,temp5) + (BLE ,temp4 ,maketrail "J. if below structure-choice-pointer") + (BLE ,temp5 ,notrail "J. if between structure choice and stack pointer") + (label ,maketrail) + (memory-read ,locdata ,temp2 ,temp PROCESSORSTATE_SCAVENGE + ,temp3 ,temp4 ,temp5 ,temp6 nil t) + (TagType ,temp2 ,temp3) + (SUBQ ,temp3 |TypeLogicVariable| ,temp3) + (BNE ,temp3 ,exclab "J. to exception if not logic variable") + (get-trail-pointer-data ,temp3) + (memory-write ,temp3 ,temp2 ,temp PROCESSORSTATE_DATAWRITE + ,temp4 ,temp5 ,temp6 ,temp7) + (ADDQ ,temp3 1 ,temp3) + (set-trail-pointer-data ,temp3) + (label ,notrail) + (memory-write ,locdata ,valtag ,valdata PROCESSORSTATE_DATAWRITE + ,temp ,temp2 ,temp3 ,temp4)))) +;;; Fin. diff --git a/alpha-emulator/imaclexi.lisp b/alpha-emulator/imaclexi.lisp new file mode 100644 index 0000000..e490695 --- /dev/null +++ b/alpha-emulator/imaclexi.lisp @@ -0,0 +1,21 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of lexical instructions. These are mostly in ifunlexi.as +;;; Lexical variable accessors. + +(defmacro compute-lexical-var-address (arg lexical temp temp2 temp3 common-tail) + `( + (stack-read2-signed ,arg ,temp ,lexical) + (SRL arg3 10 ,temp3 "Position the opcode") + (TagType ,temp ,temp2) + (EXTLL ,lexical 0 ,lexical) + (SUBQ ,temp2 |TypeList| ,temp2) ;temp2=0 if list, temp2=4 if locative + (BIC ,temp2 4 ,temp2) ;temp2=0 iff list or locative + (AND ,temp3 7 ,temp3 "Get the lexical var number") + (ADDQ ,lexical ,temp3 ,lexical "Compute the address of the lexical variable.") + (BEQ ,temp2 ,common-tail))) + + +;;; Fin. diff --git a/alpha-emulator/imaclist.lisp b/alpha-emulator/imaclist.lisp new file mode 100644 index 0000000..85a67e9 --- /dev/null +++ b/alpha-emulator/imaclist.lisp @@ -0,0 +1,260 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of list instructions. These are mostly in ifunlist.as + +;;; Destructively reads car(tag/data) into tag/data +(defmacro car-internal (tag data opcode vma temp3 temp4 temp5 temp6 &optional signedp) + (assert (member signedp '(t nil)) () "Barf") + (check-temporaries (tag data) (vma temp3 temp4 temp5 temp6)) + (let ((loccase (gensym)) + (endcar (gensym))) + `(;; Allows arg-fetch to be signed + (EXTLL ,data zero ,vma) + (type-dispatch ,tag ,temp3 ,temp4 + (|TypeList| + (unlikely-label ,loccase) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 + nil ,signedp) + ;; Fall through + ) + (|TypeNIL| + ;; NIL case is trivial, return self! + ) + (|TypeLocative| + ,loccase) + (:else + ,@(if (listp opcode) + `(,opcode) + `((ListTypeException ,tag ,opcode))))) + (label ,endcar)))) + +;;; Destructively reads cdr(tag/data) into tag/data. +(defmacro cdr-internal (tag data opcode vma temp3 temp4 temp5 temp6 &optional signedp) + (assert (member signedp '(t nil)) () "Barf") + (check-temporaries (tag data) (vma temp3 temp4 temp5 temp6)) + (let ((readcdr (gensym)) + (endcdr (gensym))) + `(;; Allows arg-fetch to be signed + (EXTLL ,data 0 ,vma) + (type-dispatch ,tag ,temp3 ,temp4 + (|TypeList| + (memory-read ,vma ,tag ,data PROCESSORSTATE_CDR ,temp3 ,temp4 ,temp5 ,temp6 nil t) + (cdr-code-dispatch ,tag ,temp3 ,temp4 + (|CdrNext| + (ADDQ ,vma 1 ,data "Address of next position is CDR") + (BIS zero |TypeList| ,tag) + ;; First clauses fall through + ;; (BR zero ,endcdr) + ) + (|CdrNormal| + (ADDQ ,vma 1 ,vma) + (label ,readcdr) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 + ,endcdr ,signedp) + ) + (|CdrNil| + (get-nil2 ,tag ,data) + (BR zero ,endcdr)) + (:else + (illegal-operand bad-cdr-code-in-memory ,vma)))) + (|TypeNIL| + ;; NIL case is trivial, return self! + ) + (|TypeLocative| + ,readcdr) + (:else + ,@(if (listp opcode) + `(,opcode) + `((ListTypeException ,tag ,opcode))))) + (label ,endcdr)))) + +;;; Destructively reads car(tag/data) into tag/data, and puts cdr(tag/data) into dtag/ddata. +(defmacro carcdr-internal (tag data dtag ddata opcode vma temp3 temp4 temp5 temp6 + &optional signedp) + "DTAG and DDATA should be the canonical tag/data registers" + (assert (member signedp '(t nil)) () "Barf") + (check-temporaries (tag data dtag ddata) (vma temp3 temp4 temp5 temp6)) + (let ((forwarded (gensym)) + (end-carcdr (gensym)) + (cdr-ed (gensym))) + `(;; Allows arg-fetch to be signed + (EXTLL ,data zero ,vma) + (type-dispatch ,tag ,temp3 ,temp4 + (|TypeList| + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 nil ,signedp) + (SUBL ,vma ,data ,temp3) + (BNE ,temp3 ,forwarded "CAR forwarded, must CDR the hard way") + ;; Save the CAR values + (BIS ,dtag zero ,tag) + (BIS ,ddata zero ,data) + (label ,cdr-ed) + ;; Note: dispatches on the CDR reg tag (may have been + ;; re-fetched if forwarded) + (cdr-code-dispatch ,dtag ,temp3 ,temp4 + (|CdrNext| + (ADDQ ,vma 1 ,ddata "Address of next position is CDR") + (BIS zero |TypeList| ,dtag) + ;; First clauses fall through + ;;(BR zero ,end-carcdr) + ) + (|CdrNormal| + (ADDQ ,vma 1 ,vma) + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 + ,end-carcdr ,signedp) + ) + (|CdrNil| + (get-nil2 ,dtag ,ddata) + (BR zero ,end-carcdr)) + (:else + (illegal-operand bad-cdr-code-in-memory ,vma)))) + (|TypeNIL| + (get-nil2 ,dtag ,ddata)) + ;; Locative illegal for car-cdr + (:else + ,@(if (listp opcode) + `(,opcode) + `((ListTypeException ,tag ,opcode ,temp3))) + ;; Clever spot + (label ,forwarded) + ;; Sigh, we have the car, but in the cdr regs, and we need to + ;; re-read the car address (comes in the car-data reg) for + ;; cdr-code. We know if we come here we have a list, so + ;; rather than a full cdr, we just reread the vma and tag and + ;; branch back to the fast code above + (EXTLL ,data zero ,vma) + (BIS ,dtag zero ,tag) + (BIS ,ddata zero ,data) + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_CDR ,temp3 ,temp4 ,temp5 ,temp6 nil t) + (BR zero ,cdr-ed))) + (label ,end-carcdr)))) + +(defmacro icar (poperand tag data vma temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack." :signed t) + (car-internal ,tag ,data car ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (stack-push2 ,tag ,data ,temp5) + (ContinueToNextInstruction))) + +(defmacro icdr (poperand tag data vma temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack." :signed t) + (cdr-internal ,tag ,data cdr ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (stack-push2 ,tag ,data ,temp5) + (ContinueToNextInstruction))) + +(defmacro isettocar (poperand tag data vma temp2 temp9 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8 temp9)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack." :signed t) + (AND ,tag #xC0 ,temp9 "Save the old CDR code") + (car-internal ,tag ,data set-to-car ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (TagType ,tag ,tag) + (BIS ,tag ,temp9 ,tag "Put back the original CDR codes") + (stack-write2 ,poperand ,tag ,data) + (ContinueToNextInstruction))) + +(defmacro isettocdr (poperand tag data vma temp2 temp9 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8 temp9)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack.") + (AND ,tag #xC0 ,temp9 "Save the old CDR code") + (cdr-internal ,tag ,data set-to-cdr ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (TagType ,tag ,tag) + (BIS ,tag ,temp9 ,tag "Put back the original CDR codes") + (stack-write2 ,poperand ,tag ,data) + (ContinueToNextInstruction))) + +(defmacro isettocdrpushcar (poperand tag data dtag ddata vma temp2 temp9 temp3 temp4 temp5 temp6 temp7 temp8) + "DTAG and DDATA should be the canonical tag/data registers" + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8 temp9)) + (let ((loclab (gensym))) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack.") + (AND ,tag #xC0 ,temp9 "Save the old CDR code") + (SUBQ ,tag |TypeLocative| ,temp5) + (AND ,temp5 #x3F ,temp5 "Strip CDR code") + (BEQ ,temp5 ,loclab) + (carcdr-internal ,tag ,data ,dtag ,ddata set-to-cdr-push-car ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (TagType ,dtag ,dtag) + (BIS ,dtag ,temp9 ,dtag "Put back the original CDR codes") + (stack-write2 ,poperand ,dtag ,ddata) + ;; Stack-push clears CDR + (stack-push2 ,tag ,data ,temp5) + (ContinueToNextInstruction) + (label ,loclab) + ;; car/cdr of locative both the same + (BIS zero ,data ,vma) + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (TagType ,tag ,tag) + (stack-push2-with-cdr ,dtag ,ddata) + (BIS ,tag ,temp9 ,tag "Put back the original CDR codes") + (stack-write2 ,poperand ,dtag ,ddata) + (ContinueToNextInstruction)))) + + +(defmacro carcdrloop ((instruction obj-tag obj-data car-tag car-data cdr-tag cdr-data + vma nextlabel exceptionlabel + temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (&body looptop) (&body loopbody) (&optional loopstep) (&body loopend)) + "Uses car/cdr subroutine to implement a general loop for cdr-ing down + a list testing cars. Loads OP1 from TOS into obj-tag/data and OP2 + (the list) from arg1, fetching car and cdr of the list each time + around the loop" + ;; only used by subroutines + (declare (ignore vma temp4 temp7 temp8) + #+Genera (zwei:indentation 0 5 1 2)) + (let ((break (gensym)) + (enter (gensym)) + (end (gensym))) + (push `((label ,break) + ;; If STOP_INTERPRETER is set during a long List instruction, it is + ;; sufficient for us to simply restart the instruction. That will + ;; take the sequence-break and when done the instruction will get + ;; retried. + (LDQ iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (ContinueToInterpretInstruction)) + *function-epilogue*) + `(with-multiple-memory-reads (,temp9 ,temp10 ,temp11 ,temp12) + (load-constant ,temp5 #xf800 "EQ-NOT-EQL mask") + (stack-read2 iSP ,obj-tag ,obj-data :tos-valid t) + (stack-read2 arg1 ,car-tag ,car-data :signed t) + (TagType ,obj-tag ,obj-tag "Get the object type bits") + (SRL ,temp5 ,obj-tag ,temp5 "Low bit will set iff EQ-NOT-EQL") + (TagType ,car-tag ,car-tag "Strip cdr code") + (EXTLL ,car-data 0 ,car-data "Remove sign-extension") + (BLBS ,temp5 ,exceptionlabel) + (BIS zero zero ,temp6) + (BR zero ,enter) + (label ,nextlabel) + ,@(ecase loopstep + (CDR `(#+list-inline + (cdr-internal ,cdr-tag ,cdr-data ,instruction ,vma ,temp5 ,temp6 ,temp7 ,temp8) ;cddr of init + #-list-inline + (BSR r0 |CdrInternal|))) + ((NIL) ())) + (LDQ ,temp6 PROCESSORSTATE_STOP_INTERPRETER (ivory) "Have we been asked to stop or trap?") + (comment "Move cdr to car for next carcdr-internal") + (TagType ,cdr-tag ,car-tag) + (BIS ,cdr-data zero ,car-data) + (label ,enter) + ,@looptop + (SUBQ ,car-tag |TypeNIL| ,temp5) + (BNE ,temp6 ,break "Asked to stop, check for sequence break") + (BEQ ,temp5 ,end) + #+list-inline (carcdr-internal ,car-tag ,car-data ,cdr-tag ,cdr-data ,instruction ,vma ,temp5 ,temp6 ,temp7 ,temp8) + #-list-inline (BSR r0 |CarCdrInternal|) + ,@loopbody + (label ,end) + ,@loopend + (label ,exceptionlabel) + (prepare-exception ,instruction 0) + (instruction-exception)))) diff --git a/alpha-emulator/imacloop.lisp b/alpha-emulator/imacloop.lisp new file mode 100644 index 0000000..6575502 --- /dev/null +++ b/alpha-emulator/imacloop.lisp @@ -0,0 +1,126 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of branch instructions. These are mostly in ifunloop.as +;;; Branch and loop instructions. + +(defmacro ibranchcond (invertp popp elsepopp extrapopp brielab) + "Expects to be called as :10-bit-signed-immediate :own-immediate t" + (let ((dolab (intern (format nil "DoBr~a~a~a~a" + (if invertp "n" "") + (if popp "Pop" "") + (if elsepopp "ElsePop" "") + (if extrapopp "ExtraPop" "")))) + (popbr (+ (if popp 1 0) (if extrapopp 1 0))) ;pops if branch taken + (popnbr (+ (if elsepopp 1 0) (if extrapopp 1 0)))) ;pops if taken NOT! + `(;; branch offset in arg1. + (EXTLL arg6 4 t1 "Check tag of word in TOS.") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LDQ arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (SRA arg3 48 arg1 "Get signed 10-bit immediate arg") + (TagType t1 t1 "strip the cdr code off.") + (SUBQ t1 |TypeNIL| t1 "Compare to NIL") + ,@(if (> popnbr 0) + `((,(if invertp 'BEQ 'BNE) t1 ,dolab) + (comment "Here if branch not taken. Pop the argument.") + (GetNextPCandCP) + (SUBQ iSP ,(* 8 popnbr) iSP) + (ContinueToNextInstruction-NoStall) + (label ,dolab "Here to take the branch")) + `((,(if invertp 'BNE 'BEQ) t1 NextInstruction))) + (BEQ arg1 ,brielab "Can't branch to ourself") + ,@(if (> popbr 0) `((SUBQ iSP ,(* 8 popbr) iSP))) + (ADDQ iPC arg1 iPC "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (BNE arg2 interpretInstructionPredicted) + (passthru "#endif") + (BR zero interpretInstructionForBranch)))) + +(defmacro iloop-decrement-tos () + (let ((tag 't1) ;just for readability. + (data 't2) + (exception (gensym)) + (notnumeric (gensym)) + (overflow (gensym))) + `((EXTLL arg6 4 ,tag) + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LDQ arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (EXTLL arg6 0 ,data) + (CheckDataType ,tag |TypeFixnum| ,exception t3) + (SUBL ,data 1 t3) + (CMPLT t3 ,data t4) + (branch-false t4 ,overflow) + (stack-write-ir |TypeFixnum| t3 t6) + (BLE t3 NextInstruction) + (comment "Here if branch taken.") + (ADDQ iPC arg1 iPC "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (BNE arg2 interpretInstructionPredicted) + (passthru "#endif") + (BR zero interpretInstructionForBranch) + (label ,exception) + (CheckAdjacentDataTypes ,tag |TypeFixnum| 8 ,notnumeric t3) + (label ,overflow) + ;; Exception handler is uses the branch target as next-pc (to + ;; set in continuation) + (ADDQ iPC arg1 arg5 "Compute next-pc") + (prepare-exception loop-decrement-tos 0) + (external-branch loopexception) + (label ,notnumeric) + (illegal-operand unary-arithmetic-operand-type-error)))) + + +(defmacro iloop-increment-tos-less-than () + (let ((tag 't1) ;just for readability. + (data 't2) + (tag2 't3) + (data2 't4) + (exception1 (gensym)) + (exception2 (gensym)) + (overflow (gensym)) + (notnumeric (gensym))) + `((EXTLL arg6 4 ,tag) + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LDQ arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (EXTLL arg6 0 ,data) + (CheckDataType ,tag |TypeFixnum| ,exception1 t5) + (stack-read2-disp iSP -8 ,tag2 ,data2 "Get arg1.") + (CheckDataType ,tag2 |TypeFixnum| ,exception2 t5) + (ADDL ,data 1 t5) + (CMPLE ,data t5 t6) + (branch-false t6 ,overflow) + (stack-write-ir |TypeFixnum| t5 t6) + (CMPLE t5 ,data2 t6) + (branch-false t6 NextInstruction) + (comment "Here if branch taken.") + (force-alignment) + (ADDQ iPC arg1 iPC "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (BNE arg2 interpretInstructionPredicted) + (passthru "#endif") + (BR zero interpretInstructionForBranch) + (label ,exception1) + (CheckAdjacentDataTypes ,tag |TypeFixnum| 8 ,notnumeric t5) + (label ,exception2) + (CheckAdjacentDataTypes ,tag2 |TypeFixnum| 8 ,notnumeric t5) + (label ,overflow) + ;; Exception handler is uses the branch target as next-pc (to + ;; set in continuation) + (ADDQ iPC arg1 arg5 "Compute next-pc") + (prepare-exception loop-increment-tos-less-than 0) + (external-branch loopexception) + (label ,notnumeric) + (illegal-operand binary-arithmetic-operand-type-error)))) + + +;;; Fin. diff --git a/alpha-emulator/imacmath.lisp b/alpha-emulator/imacmath.lisp new file mode 100644 index 0000000..26e0a55 --- /dev/null +++ b/alpha-emulator/imacmath.lisp @@ -0,0 +1,669 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of arithmetic instructions. These are mostly in +;;; ifunmath.as + +;; Branches iff op1 = 1<<31 and op2 = -1 +(defmacro CheckDivisionOverflow (op1 op2 exc temp temp2) + `((LDQ ,temp PROCESSORSTATE_MOSTNEGATIVEFIXNUM (ivory)) + (ADDL ,op2 1 ,temp2) + (SUBL ,temp ,op1 ,temp) + (BIS ,temp2 ,temp ,temp2) + (BEQ ,temp2 ,exc "J. if op1=1<<31 and op2= -1"))) + +;;; Prepares to check for an exception before execution of some floating point instructions +(defmacro floating-exception-checking-prelude () + `((comment)) + #+do-we-need-this + `((TRAPB "Force unwanted traps to occur here") + (STQ zero PROCESSORSTATE_FLOATING_EXCEPTION (ivory) "Allow exceptions"))) + +;;; Checks for an exception after execution of some floating point instructions +(defmacro floating-exception-checking-postlude (exc temp) + `(#+do-we-need-this + (BIS zero 1 ,temp) + (TRAPB "Force the trap to occur here") + #+do-we-need-this + (STQ ,temp PROCESSORSTATE_FLOATING_EXCEPTION (ivory) "Inhibit exceptions"))) + +;;; Checks for a floating point exception by combining the above two macros +(defmacro with-floating-exception-checking ((exc temp) &body body) + `((floating-exception-checking-prelude) + ,@body + (floating-exception-checking-postlude ,exc ,temp))) + +;;; Branches if IEEE + infinity , - infinity, or NAN +(defmacro CheckFloatingOverflow (val exc temp) + `((SRL ,val 23 ,temp) + (AND ,temp #xFF ,temp) ;+++ a test from ivorystate needed + (SUBQ ,temp #xFF ,temp) + (BEQ ,temp ,exc))) + +(defmacro CheckBinaryFloatingOverflow (val1 val2 exc temp1 temp2) + `((SRL ,val1 23 ,temp1) + (SRL ,val2 23 ,temp2) + (AND ,temp1 #xFF ,temp1) + (XOR ,temp1 #xFF ,temp1) + (AND ,temp2 #xFF ,temp2) + (BEQ ,temp1 ,exc) + (XOR ,temp2 #xFF ,temp2) + (BEQ ,temp2 ,exc))) + +;;; Branches if NAN. +(defmacro CheckNotNan (val exc temp) + `((SRL ,val 22 ,temp) + (LDA ,temp -511 (,temp)) + (BEQ ,temp ,exc))) + + +;; Implements rounding for division operators that return two values +(defmacro DoDivisionRounding (quotient remainder op2 direction temp temp2) + (let ((resultrounded (gensym))) + `(,@(unless (eql direction :truncate) + `((BEQ ,remainder ,resultrounded "done if no rounding required") + (sign-extendq 32 ,op2 ,temp2 "Sign extend ARG2") + (CMPLE zero ,remainder ,temp "=1 if rem>=0") + (CMPLE zero ,temp2 ,temp2 "=1 if ARG2>=0") + (XOR ,temp ,temp2 ,temp2))) + ,@(ecase direction + (:up + `((BNE ,temp2 ,resultrounded) + (ADDQ ,quotient 1 ,quotient "round towards + infinity") + (SUBL ,remainder ,op2 ,remainder))) + (:down + `((BEQ ,temp2 ,resultrounded) + (SUBQ ,quotient 1 ,quotient "round towards -infinity") + (ADDL ,remainder ,op2 ,remainder))) + (:truncate)) + ,@(unless (eql direction :truncate) + `((label ,resultrounded))) + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| ,quotient ,temp) + (stack-push-ir |TypeFixnum| ,remainder ,temp) + (ContinueToNextInstruction-NoStall)))) + +(defmacro DoFloatingDivisionRounding (quotient remainder op2 direction overflow + temp temp2 ftemp) + (let ((resultrounded (gensym))) + `(,@(unless (or (eql direction :truncate) (eql direction :round)) + `((FBEQ ,remainder ,resultrounded "done if no rounding required") + (CMPTLE f31 ,remainder ,ftemp "=2.0 if rem>=0") + (STS ,ftemp PROCESSORSTATE_FP0 (ivory)) + (CMPTLE f31 ,op2 ,ftemp "=2.0 if ARG2>=0") + (STS ,ftemp PROCESSORSTATE_FP1 (ivory)) + (LDL ,temp PROCESSORSTATE_FP0 (ivory)) + (LDL ,temp2 PROCESSORSTATE_FP1 (ivory)) + (LDS ,ftemp PROCESSORSTATE_SFP1 (ivory) "constant 1.0") + (XOR ,temp ,temp2 ,temp2))) + ,@(ecase direction + (:up + `((BNE ,temp2 ,resultrounded) + (ADDS ,quotient ,ftemp ,quotient "round towards + infinity") + (SUBS ,remainder ,op2 ,remainder))) + (:down + `((BEQ ,temp2 ,resultrounded) + (SUBS ,quotient ,ftemp ,quotient "round towards -infinity") + (ADDS ,remainder ,op2 ,remainder))) + (:truncate) + (:round)) + ,@(unless (or (eql direction :truncate) (eql direction :round)) + `((label ,resultrounded))) + ,(if (eql direction :round) + `(CVTTQ f31 ,quotient ,ftemp "round normally") + `(CVTTQ/C f31 ,quotient ,ftemp "chop off to integer")) + (STT ,ftemp PROCESSORSTATE_FP0 (ivory)) + (LDQ ,temp2 PROCESSORSTATE_FP0 (ivory)) + (ADDL ,temp2 0 ,temp "Quick sign extend") + (SUBQ ,temp ,temp2 ,temp "Did we overflow into bignums?") + (BNE ,temp ,overflow) + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| ,temp2 ,temp) + (fp-stack-push-ir |TypeSingleFloat| ,remainder ,temp) + (ContinueToNextInstruction-NoStall)))) + + +(defmacro cons-double-float-internal (hi lo area vma temp1 temp2 temp3 temp4 temp5 temp6) + "Conses the double-float in PROCESSORSTATE_FP0 into DEFAULT-CONS-AREA; + returns cons in VMA" + (check-temporaries (hi lo area vma) (temp1 temp2 temp3 temp4 temp5 temp6)) + (let ((exception (gensym))) + ;; On any problems, trap out and do things the hard way + (push `((label ,exception) + (NumericTypeException |TypeDoubleFloat| ADD)) + *function-epilogue*) + `((ldl ,lo processorstate_fp0 (Ivory)) + (ldl ,hi processorstate_fp0+4 (Ivory)) + (cons-internal |TypeFixnum| ,hi |TypeFixnum| ,lo ,area + ,exception ,vma + ,temp1 ,temp2 ,temp3 ,temp4 ,temp5 ,temp6)))) + +(defmacro fetch-double-float-internal (vma tag data temp5 temp6 temp7 temp8) + "Fetches a double float at ADDRESS into PROCESSORSTATE_FP0; callee can + then load the float into the appropriate float register" + (check-temporaries (vma tag data) (temp5 temp6 temp7 temp8)) + (let ((exception (gensym))) + ;; On any problems, trap out and do things the hard way + (push `((label ,exception) + (NumericTypeException |TypeDoubleFloat| ADD)) + *function-epilogue*) + ;; --- If we had a special double-float area that we knew to always + ;; be aligned, we could optimize more; Even barring that, the + ;; consecutive memory-reads should/could be merged to load a single tag + ;; word (where possible)? Same could apply to car/cdr !?!? + `((memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,tag |TypeFixnum| ,exception ,temp5) + (stl ,data processorstate_fp0+4 (Ivory)) + (addq ,vma 1 ,vma) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,tag |TypeFixnum| ,exception ,temp5) + (stl ,data processorstate_fp0 (Ivory)) + ;; (ldt ,float-register processorstate_fp0 (Ivory)) + ))) + +;;; This macro must be used with care because it assumes the arg OK before +;;; checking in order get dual issue on the non fail case. +(defmacro with-simple-binary-fixnum-operation ((a1 a2 ar t1 t2 temp1 temp2 &optional inst a1-signed a2-signed) + &body body) + (check-temporaries (a1 a2 ar t1 t2) (temp1 temp2)) + (let ((iolab (gensym)) + (doit (gensym))) + `( (label ,doit) + (stack-read-tag iSP ,t1 "Arg1 on the stack" :tos-valid t) + (PrefetchNextPC ,temp1) + (stack-read-data iSP ,a1 "Arg1 on the stack" :tos-valid t :signed ,a1-signed) + (stack-read-tag arg1 ,t2 "Arg2 from operand") + (AND ,t1 #x3F ,t1 "Strip CDR code if any.") + (stack-read-data arg1 ,a2 "Arg2 from operand" :signed t) + (SUBQ ,t1 |TypeFixnum| ,t1) + (PrefetchNextCP ,temp2) + (AND ,t2 #x3F ,t2 "Strip CDR code if any.") + (BNE ,t1 ,iolab) + ,@(unless a2-signed + `((EXTLL ,a2 0 ,a2))) + (SUBQ ,t2 |TypeFixnum| ,t2) + (force-alignment) + (BNE ,t2 ,iolab) + ,@body ;assume args ok to get di. + (force-alignment) + (SetNextPC ,temp1) + ;; --- don't need to rewrite tag, to clear cdr? + (stack-write-data iSP ,ar "Put the result back on the stack") + (SetNextCP ,temp2) + (ContinueToNextInstruction-NoStall) + (immediate-handler ,inst) + ,@(when a2-signed + `((SLL arg2 #.(- 64 8) arg2 "sign extend the byte argument.") + (force-alignment) + (SRA arg2 #.(- 64 8) arg2 "Rest of sign extension"))) + (STL arg2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDA arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BR zero ,doit) + (label ,iolab) + (illegal-operand two-operand-fixnum-type-error)))) + + +;; Note well: this is counting on being used in the kludge :OPERAND-FROM-STACK +;; mode with :OWN-IMMEDIATE T! +(defmacro simple-binary-arithmetic-operation (inst opfn opflt &optional (ovflow (gensym))) + (let ((new (cdr (assoc opfn '((ADDL . ADDL/V) (SUBL . SUBL/V) (MULL . MULL/V)))))) + (setq opfn (or new opfn))) + (let ((dofloat (gensym)) + (dodouble (gensym)) + (opdouble (intern (substitute #\T #\S (string opflt) :start 3))) + (doublesingle (gensym)) + (singledouble (gensym)) + (loaddoubleop2 (gensym)) + ;; Mnemonics + (op1-tag 't1) + (op1-data 't2) + (op2-tag 't3) + (op2-data 't4) + (result-data 't5) + (next-pc 't6) + (next-cp 't7) + (temp1 't8) + (temp2 't9) + (temp3 't10) + (temp4 't11) + (temp5 't12) + (result-float-data 'f0) + (op1-float-data 'f1) + (op2-float-data 'f2)) + `((stack-read-data iSP ,op1-float-data :floating t :tos-valid t) + (stack-read-tag iSP ,op1-tag "ARG1 tag" :tos-valid t) + (stack-read-tag arg1 ,op2-tag "ARG2 tag") + (stack-read-data iSP ,op1-data "ARG1 data" :signed t :tos-valid t) + (stack-read-data arg1 ,op2-data "ARG2 data" :signed t) + (stack-read-data arg1 ,op2-float-data :floating t :tos-valid t) + (floating-exception-checking-prelude) + (binary-type-dispatch (,op1-tag ,op2-tag ,temp2 ,temp3 ,temp4 ,temp5) + ((|TypeFixnum| |TypeFixnum|) + (PrefetchNextPC ,next-pc) + ,@(if (eq opfn 'DIVL) + `((CVTLQ f31 ,op1-float-data ,op1-float-data) + (CVTLQ f31 ,op2-float-data ,op2-float-data) + (CVTQT f31 ,op1-float-data ,op1-float-data) + (CVTQT f31 ,op2-float-data ,op2-float-data) + (DIVT ,op1-float-data ,op2-float-data ,result-float-data) + ,@(if (eq inst 'rational-quotient) + ;; Rounding mode irrelevant, any non-integral + ;; result is an exception + `((CVTTQ/SVI f31 ,result-float-data ,result-float-data)) + ;; Chopped rounding (zl:/ == 1st value of truncate) + `((CVTTQ/VC f31 ,result-float-data ,result-float-data))) + (CVTQL/V f31 ,result-float-data ,result-float-data)) + `((,opfn ,op1-data ,op2-data ,result-data "compute 64-bit result"))) + (PrefetchNextCP ,next-cp) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-tag iSP ,temp2 "Semi-cheat, we know temp2 has CDRNext/TypeFixnum") + (SetNextPC ,next-pc) + ,@(if (eq opfn 'DIVL) + `((stack-write-data iSP ,result-float-data :floating t)) + `((stack-write-data iSP ,result-data))) + (SetNextCP ,next-cp) + (ContinueToNextInstruction-NoStall)) + ((|TypeSingleFloat| |TypeSingleFloat|) + (label ,dofloat) + (,opflt ,op1-float-data ,op2-float-data ,result-float-data) + (floating-exception-checking-postlude nil ,temp1) + (GetNextPCandCP) + ;; Can't use cheat as above, since may come here from mixed case + (fp-stack-write-ir |TypeSingleFloat| ,result-float-data ,temp1) + (ContinueToNextInstruction-NoStall)) + ((|TypeFixnum| |TypeSingleFloat|) + (CVTLQ f31 ,op1-float-data ,op1-float-data) + (CVTQT f31 ,op1-float-data ,op1-float-data) + (BR zero ,dofloat)) + ((|TypeSingleFloat| |TypeFixnum|) + (CVTLQ f31 ,op2-float-data ,op2-float-data) + (CVTQT f31 ,op2-float-data ,op2-float-data) + (BR zero ,dofloat)) + ((|TypeDoubleFloat| |TypeDoubleFloat|) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (extll ,op1-data 0 arg2) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (bsr r0 |FetchDoubleFloat|) + (ldt ,op1-float-data processorstate_fp0 (Ivory)) + (label ,loaddoubleop2) + (extll ,op2-data 0 arg2) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (bsr r0 |FetchDoubleFloat|) + (ldt ,op2-float-data processorstate_fp0 (Ivory))) + (label ,dodouble) + (,opdouble ,op1-float-data ,op2-float-data ,result-float-data) + (stt ,result-float-data processorstate_fp0 (Ivory)) + ;; N.B.! ConsDoubleFloat inserts the TRAPB just before it + ;; actually conses, for fewer stalls + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 (result-data .. temp4) + (bsr r0 |ConsDoubleFloat|) + (GetNextPCandCP) + ;; Can't use cheat as above, since may come here from mixed case + (stack-write-ir |TypeDoubleFloat| arg2 ,temp1) + (ContinueToNextInstruction-NoStall)) + ((|TypeSingleFloat| |TypeDoubleFloat|) + ;; S is converted to T on fetch + (label ,singledouble) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (br zero ,loaddoubleop2))) + ((|TypeFixnum| |TypeDoubleFloat|) + (CVTLQ f31 ,op1-float-data ,op1-float-data) + (CVTQT f31 ,op1-float-data ,op1-float-data) + (br zero ,singledouble)) + ((|TypeDoubleFloat| |TypeSingleFloat|) + ;; S is converted to T on fetch + (label ,doublesingle) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (extll ,op1-data 0 arg2) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (bsr r0 |FetchDoubleFloat|) + (ldt ,op1-float-data processorstate_fp0 (Ivory)) + (br zero ,dodouble))) + ((|TypeDoubleFloat| |TypeFixnum|) + (CVTLQ f31 ,op2-float-data ,op2-float-data) + (CVTQT f31 ,op2-float-data ,op2-float-data) + (br zero ,doublesingle)) + (:else1 + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst)) + (:else2 + (BIS ,op2-tag zero ,op1-tag) + (BR zero ,ovflow)))))) + +(defmacro simple-binary-immediate-arithmetic-operation (name opfn &optional sign-extend-immp (ovflow (gensym))) + (let ((new (cdr (assoc opfn '((ADDL . ADDQ) (SUBL . SUBQ) (MULL . MULQ)))))) + (setq opfn (or new opfn))) + (let (;; Mnemonics + (immediate-data 'arg2) + (op1-tag 't1) + (op1-data 't2) + (result-data 't3) + (next-pc 't4) + (next-cp 't5) + (temp1 't10) + (temp2 't11) + (temp3 't12)) + `(,@(if sign-extend-immp `((SLL ,immediate-data #.(- 64 8) ,immediate-data))) + (stack-read2-signed iSP ,op1-tag ,op1-data "get ARG1 tag/data" :tos-valid t) + ,@(if sign-extend-immp `((SRA ,immediate-data #.(- 64 8) ,immediate-data))) + (type-dispatch ,op1-tag ,temp2 ,temp3 + (|TypeFixnum| + ;; Handle fixnum-immediate case optimally + (,opfn ,op1-data ,immediate-data ,result-data "compute 64-bit result") + (PrefetchNextPC ,next-pc) + (sign-extendq 32 ,result-data ,temp1 "compute 32-bit sign-extended result") + (PrefetchNextCP ,next-cp) + (CMPEQ ,result-data ,temp1 ,temp1 "is it the same as the 64-bit result?") + (branch-false ,temp1 ,ovflow "if not, we overflowed") + (stack-write-tag iSP ,temp2 "Semi-cheat, we know temp2 has CDRNext/TypeFixnum") + (SetNextPC ,next-pc) + (stack-write-data iSP ,result-data) + (SetNextCP ,next-cp) + (ContinueToNextInstruction-NoStall)) + (:else + ;; Otherwise simulate immediate arg and branch to normal body + (STL ,immediate-data PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDA arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BIS zero zero arg2) + (BR zero ,(format nil "begin~a" name))))))) + + +(defmacro binary-arithmetic-division-prelude (inst) + "Loads any mixture of float, single, double into F1 and F2 as T + floats, in preparation for a division operation" + (let ((done (gensym)) + (doublesingle (gensym)) + (singledouble (gensym)) + (loaddoubleop2 (gensym)) + (ovflow (gensym)) + ;; Mnemonics + (op1-tag 't1) + (op1-data 't2) + (op2-tag 't3) + (op2-data 't4) + (temp2 't9) + (temp3 't10) + (temp4 't11) + (temp5 't12) + (op1-float-data 'f1) + (op2-float-data 'f2) + ) + `((stack-read-data iSP ,op1-float-data :floating t :tos-valid t) + (stack-read-data iSP ,op1-data "ARG1 data" :signed t :tos-valid t) + (stack-read-data arg1 ,op2-data "ARG2 data" :signed t) + (stack-read-tag iSP ,op1-tag "ARG1 tag" :tos-valid t) + (stack-read-tag arg1 ,op2-tag "ARG2 tag") + (stack-read-data arg1 ,op2-float-data :floating t :tos-valid t) + ;; Convert both args to T floats + (binary-type-dispatch (,op1-tag ,op2-tag ,temp2 ,temp3 ,temp4 ,temp5) + ((|TypeFixnum| |TypeFixnum|) + (CVTLQ f31 ,op1-float-data ,op1-float-data) + (CVTLQ f31 ,op2-float-data ,op2-float-data) + (CVTQT f31 ,op1-float-data ,op1-float-data) + (CVTQT f31 ,op2-float-data ,op2-float-data) + ;; fall through + ) + ((|TypeSingleFloat| |TypeSingleFloat|) + ;; S is converted to T on fetch + ,done) + ((|TypeFixnum| |TypeSingleFloat|) + (CVTLQ f31 ,op1-float-data ,op1-float-data) + (CVTQT f31 ,op1-float-data ,op1-float-data) + (br zero ,done)) + ((|TypeSingleFloat| |TypeFixnum|) + (BIS zero ,op1-tag ,op2-tag "contagion") + (CVTLQ f31 ,op2-float-data ,op2-float-data) + (CVTQT f31 ,op2-float-data ,op2-float-data) + (br zero ,done)) + ((|TypeDoubleFloat| |TypeDoubleFloat|) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (extll ,op1-data 0 arg2) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (bsr r0 |FetchDoubleFloat|) + (ldt ,op1-float-data processorstate_fp0 (Ivory)) + (label ,loaddoubleop2) + (extll ,op2-data 0 arg2) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (bsr r0 |FetchDoubleFloat|) + (ldt ,op2-float-data processorstate_fp0 (Ivory))) + (br zero ,done)) + ((|TypeSingleFloat| |TypeDoubleFloat|) + ;; S is converted to T on fetch + (label ,singledouble) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (br zero ,loaddoubleop2))) + ((|TypeFixnum| |TypeDoubleFloat|) + (CVTLQ f31 ,op1-float-data ,op1-float-data) + (CVTQT f31 ,op1-float-data ,op1-float-data) + (br zero ,singledouble)) + ((|TypeDoubleFloat| |TypeSingleFloat|) + ;; S is converted to T on fetch + (label ,doublesingle) + (BIS zero ,op1-tag ,op2-tag "contagion") + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (extll ,op1-data 0 arg2) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (bsr r0 |FetchDoubleFloat|) + (ldt ,op1-float-data processorstate_fp0 (Ivory))) + (br zero ,done)) + ((|TypeDoubleFloat| |TypeFixnum|) + (CVTLQ f31 ,op2-float-data ,op2-float-data) + (CVTQT f31 ,op2-float-data ,op2-float-data) + (br zero ,doublesingle)) + (:else1 + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst)) + (:else2 + (BIS ,op2-tag zero ,op1-tag) + (BR zero ,ovflow))) + (label ,done)))) + +(defmacro binary-arithmetic-two-value-division-operation (rounding) + "Expects op1 and op2 as T floats in F1 and F2, op2-tag in T3 directs + the conversion of the remainder" + (let (;; Mnemonics + (op2-tag 't3) + (temp1 't8) + (temp2 't9) + (result-float-data 'f0) + (op1-float-data 'f1) + (op2-float-data 'f2) + (remainder-float-data 'f3)) + `( + ,@(when (eq rounding :rational) + `((CPYSN ,op2-float-data ,op2-float-data ,op2-float-data))) + ,@(unless (member rounding '(:down :up :truncate :round)) + `((DIVT ,op1-float-data ,op2-float-data ,result-float-data))) + ,@(case rounding + ;; Any rounding is an exception for :rational mode + (:rational `((CVTTQ/SVI f31 ,result-float-data ,result-float-data))) + (:truncate + ;;`((CVTTQ/VC f31 ,result-float-data ,result-float-data))) + `((LIBMTRUNC ,op1-float-data ,op2-float-data ,remainder-float-data ,result-float-data))) + ;; Dynamic mode in the emulator is not always plus, so we + ;; use minus and compensate below... + (:down + ;; `((CVTTQ/VM f31 ,result-float-data ,result-float-data))) + `((LIBMFLOOR ,op1-float-data ,op2-float-data ,remainder-float-data ,result-float-data))) + (:up + `((LIBMCEIL ,op1-float-data ,op2-float-data ,remainder-float-data ,result-float-data))) + (:round + `((LIBMRINT ,op1-float-data ,op2-float-data ,remainder-float-data ,result-float-data)))) + ;;`((CVTTQ/V f31 ,result-float-data ,result-float-data)))) + ,@(unless (member rounding '(:down :up :truncate :round)) + `((CVTQT f31 ,result-float-data ,remainder-float-data))) + ,@(unless (member rounding '(:down :up :truncate :round)) + `((CPYSN ,remainder-float-data ,remainder-float-data ,result-float-data) + (CVTTQ f31 ,result-float-data ,result-float-data))) + ,@(unless (member rounding '(:down :up :truncate :round)) + `((MULT ,remainder-float-data ,op2-float-data ,remainder-float-data) + (SUBT ,op1-float-data ,remainder-float-data ,remainder-float-data) + (CVTQL/V f31 ,result-float-data ,result-float-data))) + (type-dispatch ,op2-tag ,temp1 ,temp2 + (|TypeFixnum| + (CVTTQ f31 ,remainder-float-data ,remainder-float-data) + (CVTQL f31 ,remainder-float-data ,remainder-float-data) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating t) + (stack-push-ir |TypeFixnum| ,remainder-float-data ,temp1 :floating t) + ) + (|TypeSingleFloat| + (CVTTS f31 ,remainder-float-data ,remainder-float-data) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating t) + (stack-push-ir |TypeSingleFloat| ,remainder-float-data ,temp1 :floating t)) + (|TypeDoubleFloat| + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stt ,remainder-float-data processorstate_fp0 (Ivory)) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 (result-data .. temp4) + (bsr r0 |ConsDoubleFloat|) + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating t) + (stack-push-ir |TypeDoubleFloat| arg2 ,temp1))) + (GetNextPCandCP) + (ContinueToNextInstruction-NoStall)))) + +(defmacro binary-arithmetic-one-value-division-operation (rounding) + "Expects op1 and op2 as T floats in F1 and F2, op2-tag in T3 directs + the conversion of the quotient" + (let (;; Mnemonics + (op2-tag 't3) + (temp1 't8) + (temp2 't9) + (result-float-data 'f0) + (op1-float-data 'f1) + (op2-float-data 'f2) + (op1-fix 't2) + (op2-fix 't4) +; (remainder-float-data 'f3) + ) + `((type-dispatch ,op2-tag ,temp1 ,temp2 + (|TypeFixnum| + ,@(when (eq rounding :up) + `((CPSYN ,op2-float-data ,op2-float-data ,op2-float-data))) + ,@(unless (eq rounding :rational) + `((DIVT ,op1-float-data ,op2-float-data ,result-float-data))) + ,@(case rounding + ;; Any rounding is an exception for :rational mode +; (:rational `((CVTTQ/SVI f31 ,result-float-data ,result-float-data))) + (:rational `((X64RATQUO ,result-float-data ,op1-fix ,op2-fix))) + (:truncate `((CVTTQ/VC f31 ,result-float-data ,result-float-data))) + ;; Dynamic mode in the emulator is not always plus, so we + ;; use minus and compensate below... + ((:up :down) `((CVTTQ/VM f31 ,result-float-data ,result-float-data))) + (:round `((CVTTQ/V f31 ,result-float-data ,result-float-data)))) + ,@(when (eq rounding :up) + `((CVTQT f31 ,result-float-data ,result-float-data) + (CPSYN ,result-float-data ,result-float-data ,result-float-data) + (CVTTQ f31 ,result-float-data ,result-float-data))) + ,@(unless (eq rounding :rational) + `((CVTQL/V f31 ,result-float-data ,result-float-data))) + + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating t) + ) + (|TypeSingleFloat| + (DIVS ,op1-float-data ,op2-float-data ,result-float-data) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeSingleFloat| ,result-float-data ,temp1 :floating t)) + (|TypeDoubleFloat| + (DIVT ,op1-float-data ,op2-float-data ,result-float-data) + (stt ,result-float-data processorstate_fp0 (Ivory)) + ;; Cons does the exception-checking before consing... + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 (result-data .. temp4) + (bsr r0 |ConsDoubleFloat|) + (stack-write-ir |TypeDoubleFloat| arg2 ,temp1))) + (GetNextPCandCP) + (ContinueToNextInstruction-NoStall)))) + +;; Note well: this is counting on being used in the kludge :OPERAND-FROM-STACK +;; mode with :OWN-IMMEDIATE T! +(defmacro simple-binary-minmax (inst &optional (ovflow (gensym))) + (let ((instn (if (eq inst 'max) 'CMOVGT 'CMOVLT)) + (finstn (if (eq inst 'max) 'FCMOVGT 'FCMOVLT)) + (dofloat (gensym)) + ;; Mnemonics + (op1-tag 't1) + (op1-data 't2) + (op2-tag 't3) + (op2-data 't4) + (result-data 't5) + (temp1 't8) + (temp2 't9) + (temp3 't10) + (temp4 't11) + (temp5 't12) + (result-float-data 'f0) + (op1-float-data 'f1) + (op2-float-data 'f2)) + `((stack-read-data iSP ,op1-float-data :floating t :tos-valid t) + (stack-read-tag iSP ,op1-tag "ARG1 tag" :tos-valid t) + (stack-read-tag arg1 ,op2-tag "ARG2 tag") + (stack-read-data iSP ,op1-data "ARG1 data" :signed t :tos-valid t) + (stack-read-data arg1 ,op2-data "ARG2 data" :signed t) + (stack-read-data arg1 ,op2-float-data :floating t :tos-valid t) + (binary-type-dispatch (,op1-tag ,op2-tag ,temp2 ,temp3 ,temp4 ,temp5) + ((|TypeFixnum| |TypeFixnum|) + (SUBQ ,op1-data ,op2-data ,result-data) + (GetNextPC) + (,instn ,result-data ,op1-data ,op2-data) + (GetNextCP) + (stack-write2 iSP ,temp2 ,op2-data "We know temp2 has CDRNext/TypeFixnum") + (ContinueToNextInstruction-NoStall)) + ((|TypeSingleFloat| |TypeSingleFloat|) + (label ,dofloat) + (floating-exception-checking-prelude) + (SUBS ,op1-float-data ,op2-float-data ,result-float-data) + (GetNextPC) + (,finstn ,result-float-data ,op1-float-data ,op2-float-data) + (GetNextCP) + (floating-exception-checking-postlude ,ovflow ,temp1) + ;; Can't use cheat as above, since may come here from mixed case + (fp-stack-write-ir |TypeSingleFloat| ,op2-float-data ,temp1) + (ContinueToNextInstruction-NoStall)) + ((|TypeFixnum| |TypeSingleFloat|) + (CVTLQ f31 ,op1-float-data ,op1-float-data) + (CVTQS f31 ,op1-float-data ,op1-float-data) + (BR zero ,dofloat)) + ((|TypeSingleFloat| |TypeFixnum|) + (CVTLQ f31 ,op2-float-data ,op2-float-data) + (CVTQS f31 ,op2-float-data ,op2-float-data) + (BR zero ,dofloat)) + (:else1 + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst)) + (:else2 + (BIS ,op2-tag zero ,op1-tag) + (BR zero ,ovflow)))))) + +(defmacro simple-binary-immediate-minmax (inst &optional sign-extend-immp (ovflow (gensym) o-p)) + (let ((instn (if (eq inst 'max) 'CMOVGT 'CMOVLT)) + (finstn (if (eq inst 'max) 'FCMOVGT 'FCMOVLT)) + ;; Mnemonics + (immediate-data 'arg2) + (op1-tag 't1) + (op1-data 't2) + (result-data 't3) + (temp1 't10) + (temp2 't11) + (temp3 't12)) + `(,@(if sign-extend-immp `((SLL ,immediate-data #.(- 64 8) ,immediate-data))) + (stack-read2-signed iSP ,op1-tag ,op1-data "get ARG1 tag/data" :tos-valid t) + ,@(if sign-extend-immp `((SRA ,immediate-data #.(- 64 8) ,immediate-data))) + (type-dispatch ,op1-tag ,temp2 ,temp3 + (|TypeFixnum| + (SUBQ ,op1-data ,immediate-data ,result-data) + (GetNextPC) + (,instn ,result-data ,op1-data ,immediate-data) + (GetNextCP) + (stack-write2 iSP ,temp2 ,immediate-data "We know temp2 has CDRNext/TypeFixnum") + (ContinueToNextInstruction-NoStall)) + ,(if o-p + `(:else-label ,ovflow) + `(:else + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst))))))) + + +;;; Fin. + diff --git a/alpha-emulator/imacpred.lisp b/alpha-emulator/imacpred.lisp new file mode 100644 index 0000000..21b492a --- /dev/null +++ b/alpha-emulator/imacpred.lisp @@ -0,0 +1,165 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of predicate instructions. These are mostly in +;;; ifunpred.as + +;; IMOVE is a conditional move instruction, such as CMOVEQ. +;; FBRANCH is a floating branch instruction, such as FBEQ. +(defmacro simple-unary-arithmetic-predicate (inst imove fbranch) + (let () + `((Get-NIL t11) + (PrefetchNextPC t6) + (stack-read-tag arg1 t1) + (Get-T t12) + (stack-read-data arg1 t2 :signed t) + (stack-read-data arg1 f1 :floating t) + (type-dispatch t1 t4 t5 + (|TypeFixnum| + (SetNextPC t6) + (GetNextCP) + (,imove t2 t12 t11 "T if predicate succeeds") + (stack-push-with-cdr t11) + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (SetNextPC t6) + (stack-push-with-cdr t12) + (GetNextCP) + (,fbranch f1 cacheValid) + (stack-write iSP t11 "Didn't branch, answer is NIL") + (ContinueToNextInstruction-NoStall)) + (:else + (UnaryNumericTypeException t1 ,inst)))))) + +;; ITEST is a "combiner", such as SUBL or SUBQ, or AND. +;; IMOVE is a conditional move instruction, such as CMOVEQ. +;; FTEST is a floating test function, such as CMPTEQ or CMPTLE. +;; FBRANCH is a floating branch instruction, such as FBEQ. +(defmacro simple-binary-arithmetic-predicate + (inst itest imove ftest fbranch &optional sign-extendp excool) + (let ((fltcase (intern (format nil "~aFLTFLT" excool)))) + `((Get-NIL t11) + (SRL arg3 #.(+ 10 2) t7) + (Get-T t12) + (stack-read-tag iSP arg3 :tos-valid t "Get ARG1 tag") + ,(if sign-extendp + `(stack-read-tag arg1 t1 "t1 is tag of arg2") + ;; Deal with sign-extension below, after stalls + `(stack-read-data arg1 arg2 :signed t)) + ;; Free! di with AND + (stack-read-data iSP f1 :floating t :tos-valid t) + (AND t7 1 t7) + ;(SRL arg1 32 t1 "t1 is tag of arg2") + ,(if sign-extendp + `(stack-read-data arg1 arg2 :signed t) + `(stack-read-tag arg1 t1 "t1 is tag of arg2")) + (stack-read-data iSP arg4 :signed ,sign-extendp :tos-valid t) + ,@(unless sign-extendp + `((EXTLL arg2 0 arg2))) + ;; Free! di with 1st instruction in type-dispatch + (stack-read-data arg1 f2 :floating t) + (binary-type-dispatch (arg3 t1 t5 t6 t4 t3) + ((|TypeFixnum| |TypeFixnum|) + (,itest arg4 arg2 t2) + (GetNextPC) + (S8ADDQ t7 iSP iSP "Pop/No-pop") + (GetNextCP) + (,imove t2 t12 t11 "T if the test succeeds") + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + ,@(when ftest + `(((|TypeSingleFloat| |TypeSingleFloat|) + ;; We're just comparing, no need to check for any of this + ;(floating-exception-checking-prelude) + ;(CheckBinaryFloatingOverflow arg1 arg4 ,exclab1 t2 t5) + ;; Come here to do flt operation when args massaged + ,@(when excool + `((label ,fltcase))) + (,ftest f1 f2 f3) + (floating-exception-checking-postlude nil nil) + (GetNextPC) + (S8ADDQ t7 iSP iSP) + (GetNextCP) + (stack-write iSP t12) + (,fbranch f3 cacheValid) + (stack-write iSP t11 "Didn't branch, answer is NIL") + (ContinueToNextInstruction-NoStall)) + )) + ,@(if excool + `((:else + (BR zero ,(format nil "~a" excool)))) + `((:else1 + (NumericTypeException arg3 ,inst)) + (:else2 + (NumericTypeException t1 ,inst)))))))) + +(defmacro simple-binary-arithmetic-exceptions (inst excool version &optional sign-extendp) + (declare (ignore version sign-extendp)) + (let ((fltcase (intern (format nil "~aFLTFLT" excool)))) + `(define-procedure ,(format nil "~a" excool) () + ;; f1 and f2 already loaded, simply convert the fixnum (or + ;; exception) + (binary-type-dispatch (arg3 t1 t5 t6 t4 t3) + ((|TypeFixnum| |TypeSingleFloat|) + (CVTLQ f31 f1 f1) + (CVTQS f31 f1 f1) + (BR zero ,fltcase)) + ((|TypeSingleFloat| |TypeFixnum|) + (CVTLQ f31 f2 f2) + (CVTQS f31 f2 f2) + (BR zero ,fltcase)) + (:else1 + (NumericTypeException arg3 ,inst)) + (:else2 + (NumericTypeException t1 ,inst)))))) + +;; ITEST is a "combiner", such as SUBL or SUBQ, or AND. +;; IMOVE is a conditional move instruction, such as CMOVEQ. +(defmacro simple-binary-immediate-arithmetic-predicate + (inst itest imove &optional sign-extendp) + (let () + `((Get-NIL t11) + (SLL arg2 #.(- 64 8) arg2 "First half of sign extension") + (Get-T t12) + (SRL arg3 #.(+ 10 2) t7) + (stack-read2 iSP arg3 arg4 :signed ,sign-extendp :tos-valid t) + (SRA arg2 #.(- 64 8) arg2 "Second half of sign extension") + (AND t7 1 t7) + (type-dispatch arg3 t3 t4 + (|TypeFixnum| + (,itest arg4 arg2 t2) + (GetNextPC) + (S8ADDQ t7 iSP iSP) + (GetNextCP) + (,imove t2 t12 t11 "T if the test succeeds") + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + (:else + (NumericTypeException arg3 ,inst)))))) + + +;;; arg2 has 8 bit mask; arg3 is the instruction, the field number is +;;; (byte 4 8) from that, but we want field-number*4; byte (1 12) is popp +(defmacro itypemember () + `((SRL arg3 6 t6 "Position the opcode") + (LDQ t4 PROCESSORSTATE_TADDRESS (ivory)) + (stack-read-tag iSP arg4 "get op1's tag") + (BIS zero 1 t1) + (LDQ t5 PROCESSORSTATE_NILADDRESS (ivory)) + (SRL arg3 12 t7 "Get pop-bit while stalled") + (AND t6 #.(dpb -1 (byte 4 2) 0) arg1 "Get field-number*4 from the opcode") + (TagType arg4 arg4 "Strip off CDR code.") + (SLL t1 arg4 t1 "T1 is type type code bit position.") + (AND t7 1 t7 "Pop bit") + (SLL arg2 arg1 t2 "t2 is the mask.") + (GetNextPCandCP) + (S8ADDQ t7 iSP iSP) + (AND t2 t1 t3 "t3 is the result.") + (force-alignment) + (CMOVNE t3 t4 t5) + (STQ t5 0 (iSP)) + (ContinueToNextInstruction-NoStall))) + + +;;; Fin. diff --git a/alpha-emulator/imacsubp.lisp b/alpha-emulator/imacsubp.lisp new file mode 100644 index 0000000..e3a96bb --- /dev/null +++ b/alpha-emulator/imacsubp.lisp @@ -0,0 +1,185 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of subprimitive instructions. These are mostly +;;; in ifunsubp.as + +(defmacro %allocate-internal (type area amount escape address t1 t2 t3 t4 &environment env) + "Internal version of ALLOCATE fo use in math instructions that need to + cons" + (if (constantp amount env) + (check-temporaries (area address) (t1 t2 t3 t4)) + (check-temporaries (area amount address) (t1 t2 t3 t4))) + (multiple-value-bind (cache-area cache-address cache-length) + (ecase type + (:list + (values + 'PROCESSORSTATE_LCAREA + 'PROCESSORSTATE_LCADDRESS + 'PROCESSORSTATE_LCLENGTH)) + (:structure + (values + 'PROCESSORSTATE_SCAREA + 'PROCESSORSTATE_SCADDRESS + 'PROCESSORSTATE_SCLENGTH))) + + `((LDQ ,t1 ,cache-area (ivory)) + ;; --- Implement default-cons-area and check against that + #-ign (Get-Nil ,t4) + (LDL ,t2 ,cache-length (ivory)) + (LDQ ,address ,cache-address (ivory) "Fetch address") + #+ign (CMPEQ ,area ,t1 ,t3) + #+ign (branch-false ,t3 ,escape "Wrong area") + #-ign (CMPEQ ,t1 ,t4 ,t3) + #-ign (branch-true ,t3 ,escape "Decached area") + (SUBQ ,t2 ,amount ,t3 "Effectively an unsigned 32-bit compare") + (BLT ,t3 ,escape "Insufficient cache") + ;; Ensure any arithmetic exceptions are taken before you commit to consing + (floating-exception-checking-postlude nil ,t1) ;Ensure traps complete + (STL ,t3 ,cache-length (ivory) "Store remaining length") + ;(stack-write iSP t1 "Cache address/tag -> TOS") + ;(STL t1 PROCESSORSTATE_BAR1 (ivory) "Cache address -> BAR1") + (EXTLL ,address 0 ,t4) + (ADDQ ,t4 ,amount ,t4 "Increment address") + (STL ,t4 ,cache-address (ivory) "Store updated address") + ))) + +(defmacro cons-internal (car-type car-data cdr-type cdr-data area escape pointer t1 t2 t3 t4 t5 t6) + "Cons and write car/cdr, returning address of cons in POINTER. Branch + to ESCAPE on any irregularity. Type fields assumed to be CDR-NEXT." + (check-temporaries ( car-data cdr-data area pointer) (t1 t2 t3 t4)) + `((%allocate-internal :list ,area 2 ,escape ,pointer ,t1 ,t2 ,t3 ,t4) + (extll ,pointer 0 ,pointer) + (bis zero ,car-type ,t5) + (bis ,t5 ,(lsh |cdr|$k-|normal| 6) ,t5) + (VM-Write ,pointer ,t5 ,car-data ,t1 ,t2 ,t3 ,t4) + (addq ,pointer 1 ,t6) + (bis zero ,cdr-type ,t5) + (bis ,t5 ,(lsh |cdr|$k-|nil| 6) ,t5) + (VM-Write ,t6 ,t5 ,cdr-data ,t1 ,t2 ,t3 ,t4) + )) + +(defmacro i%allocate-block (listp) + (let ((len (if listp 'PROCESSORSTATE_LCLENGTH 'PROCESSORSTATE_SCLENGTH)) + (adr (if listp 'PROCESSORSTATE_LCADDRESS 'PROCESSORSTATE_SCADDRESS)) + (area (if listp 'PROCESSORSTATE_LCAREA 'PROCESSORSTATE_SCAREA)) + (illoplab (gensym)) + (ielab (gensym))) + `((LDQ t1 ,area (ivory)) + (stack-read iSP arg3) + (SRL arg1 32 arg2) + (EXTLL arg1 0 arg1) + (CheckDataType arg2 |TypeFixnum| ,illoplab t5) + (LDL t4 ,len (ivory)) + (CMPEQ arg3 t1 t2) + (branch-false t2 ,ielab "Wrong area") + (SUBQ t4 arg1 t2 "Effectively an unsigned 32-bit compare") + (BLT t2 ,ielab "Insufficient cache") + (LDQ t1 ,adr (ivory) "Fetch address") + (load-constant t3 #.(sys:%logdpb sys:trap-mode-fep sys:%%cr.trap-mode 0)) + (EXTLL t3 0 t3) + (STL t2 ,len (ivory) "Store remaining length") + (stack-write iSP t1 "Cache address/tag -> TOS") + (STL t1 PROCESSORSTATE_BAR1 (ivory) "Cache address -> BAR1") + (EXTLL t1 0 t1) + (get-control-register t4 "Verify trap mode") + (ADDQ t1 arg1 t1 "Increment address") + (STL t1 ,adr (ivory) "Store updated address") + (AND t3 t4 t3) + (BNE t3 NextInstruction "Already above emulator mode") + (load-constant t3 #.1_30) ;+++ magic # + (BIS t4 t3 t4) + (set-control-register t4) + (ContinueToNextInstruction) + (label ,illoplab) + (illegal-operand %allocate-type-error) + (label ,ielab) + (SetTag arg2 arg1 t1) + (prepare-exception + ,(if listp 'allocate-list-block 'allocate-structure-block) + 0 + t1) + (instruction-exception)))) + +(defmacro i%set-cdr-code-n (ptr n temp) + `((LDL ,temp 4 (,ptr) "Get CDR CODE/TAG of operand") + (GetNextPCandCP) + (AND ,temp #x3F ,temp "Strip off any existing CDR code bits") + (BIS ,temp ,(ash n 6) ,temp "OR in the CDR") + (STL ,temp 4 (,ptr) "Replace the CDE CODE/TAG") + (ContinueToNextInstruction-NoStall))) + +(defmacro refill-oldspace-table () + (flet ((doephemeral (offset) + `((ZAP t3 t2 t4) + (STQ t4 ,offset (t1)) + (ORNOT zero t4 t4) + (STQ t4 ,(+ offset 32) (t1)) + (SRL t2 8 t2))) + (dozone () + `((SRL t2 1 t2) + (load-constant t3 -1) + (CMOVLBC t2 zero t3) + (STQ t3 0 (t1)) + (STQ t3 8 (t1)) + (STQ t3 16 (t1)) + (STQ t3 24 (t1)) + (STQ t3 32 (t1)) + (STQ t3 40 (t1)) + (STQ t3 48 (t1)) + (STQ t3 56 (t1)) + (ADDQ t1 64 t1)))) + `((LDA t1 PROCESSORSTATE_OLDSPACE (ivory)) + (load-constant t3 -1) + (LDL t2 PROCESSORSTATE_EPHEMERALOLDSPACE (ivory)) + ,@(doephemeral 0) + ,@(doephemeral 8) + ,@(doephemeral 16) + ,@(doephemeral 24) + (ADDQ t1 64 t1) + (LDL t2 PROCESSORSTATE_ZONEOLDSPACE (ivory)) + ,@(loop repeat 31 + append (dozone))))) + +(defmacro check-preempt-request (done-label temp1 temp2) + (let ((done (or done-label (gensym)))) + `((LDL ,temp1 PROCESSORSTATE_INTERRUPTREG (ivory)) + (AND ,temp1 2 ,temp2) + (CMPEQ ,temp2 2 ,temp2) + (BIS ,temp1 ,temp2 ,temp1) + (STL ,temp1 PROCESSORSTATE_INTERRUPTREG (ivory)) + (BEQ ,temp1 ,done) + (STQ ,temp1 PROCESSORSTATE_STOP_INTERPRETER (ivory)) + ,@(unless done-label + `((label ,done)))))) + +;; For the first three or four internal registers, this is slower than +;; just using REGISTER-DISPATCH, but after that this wins big. +(defmacro internal-register-dispatch (reg writep error temp1 temp2 temp3) + (let ((low-slot (if writep + 'PROCESSORSTATE_INTERNALREGISTERWRITE1 + 'PROCESSORSTATE_INTERNALREGISTERREAD1)) + (high-slot (if writep + 'PROCESSORSTATE_INTERNALREGISTERWRITE2 + 'PROCESSORSTATE_INTERNALREGISTERREAD2)) + (high-ones (gensym))) + ;;+++ The constants #o1000, #o52, and #o41 are kind of poor... + `((LDQ ,temp2 ,high-slot (ivory)) + (SUBL ,reg #o1000 ,temp3) + (LDQ ,temp1 ,low-slot (ivory)) + (BGE ,temp3 ,high-ones "We're in the 1000's") + (AND ,reg #o77 ,temp3 "Keep only six bits") + (CMPLE ,temp3 #o52 ,temp2 "In range for the low registers?") + (S8ADDQ ,temp3 ,temp1 ,temp3) + (branch-false ,temp2 ,error) + (LDQ ,temp3 0 (,temp3)) + (JMP zero ,temp3 0 "Jump to the handler") + (label ,high-ones) + (CMPLE ,temp3 #o41 ,temp1 "In range for the high registers?") + (S8ADDQ ,temp3 ,temp2 ,temp3) + (branch-false ,temp1 ,error) + (LDQ ,temp3 0 (,temp3)) + (JMP zero ,temp3 0 "Jump to the handler")))) + +;;; Fin. diff --git a/alpha-emulator/imactrap.lisp b/alpha-emulator/imactrap.lisp new file mode 100644 index 0000000..09029a3 --- /dev/null +++ b/alpha-emulator/imactrap.lisp @@ -0,0 +1,963 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; Macros in support of traps and exceptions. + +(defmacro prepare-trap (popped condition &optional vma) + (declare (ignore popped)) + (let ((position (position condition *all-conditions* :test #'equal)) + (condition (if (listp condition) (first condition) condition))) + (assert (not (null position)) (condition) + "~S is not a known condition" condition) + (when (member condition *vma-valid-conditions*) + (assert (not (null vma)) () + "You need to supply a VMA for the condition ~S" condition)) + (let ((microstate (1+ position))) ;we don't like zero + `((BIS zero ,(or vma 0) arg5) + ;; This is second in case vma is in arg2! + (BIS zero ,microstate arg2))))) + +;;; takes index in 'index' and returns entry in 'tag' and 'data' +(defmacro get-trap-vector-entry (index tag data cr temp2 temp3 temp4 temp5 temp6) + (check-temporaries (tag data cr) (temp2 temp3 temp4 temp5 temp6)) + (let ((tventrybad (gensym))) + (push + `((label ,tventrybad) + (halt-machine HaltReasonIllegalTrapVector) ;+++ fixup later + ) + *function-epilogue*) + `((get-control-register ,cr) + (LDQ ,temp6 PROCESSORSTATE_FEPMODETRAPVECADDRESS (ivory)) + (LDQ ,temp5 PROCESSORSTATE_TRAPVECBASE (ivory)) + (load-constant ,temp2 #.(sys:%logdpb 3 (byte 2 30) 0)) + (SRL ,cr 30 ,temp3) + (BIS ,cr ,temp2 ,temp2 "Set trap mode to 3") + (AND ,temp3 3 ,temp3) + (set-control-register ,temp2) + (SUBQ ,temp3 3 ,temp4) + (ADDQ ,temp5 ,index ,temp5) + (CMOVEQ ,temp4 ,temp6 ,temp5) + (STQ ,temp5 PROCESSORSTATE_TVI (ivory) "Record TVI for tracing (if enabled)") + (memory-read ,temp5 ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp4 ,temp3 ,temp2) + (CheckAdjacentDataTypes ,tag |TypeEvenPC| 2 ,tventrybad ,temp2) + (set-control-register ,cr "Restore the cr")))) + + +;;; The post traps + +;;; Note that all of these routines shared registers! + +(defmacro take-post-trap (tvi arity temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 + &optional next-pc next-cp) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + (let ((label (gensym)) + (tag temp2) + (data temp3) + (cr temp4) + (overflow (gensym))) + `((BIS iFP zero ,temp "save old frame pointer") + (get-trap-vector-entry ,tvi ,tag ,data ,cr ,temp5 ,temp6 ,temp7 ,temp8 ,temp9) + (stack-cache-overflow-check ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 iSP 8) + (S8ADDQ ,arity zero iFP) + (SUBQ iSP iFP iFP) + (ADDQ iFP 8 iFP) + ;; Move operands up stack to make foom for fixed args. + ,@(loop for i upfrom 0 below 4 + nconc `((BEQ ,arity ,label) + (stack-read-disp isp ,(* (- i) 8) ,temp5) + (stack-write-disp isp ,(* (- 4 i) 8) ,temp5) + (SUBQ ,arity 1 ,arity))) + (label ,label) + (ADDQ iSP ,(* 8 4) iSP) + ;; Build frame header for trap. + (get-continuation2 ,temp7 ,temp5) + (load-constant ,temp8 #.1_29 "cr.instruction-trace") + (EXTLL ,cr 0 ,cr) + (BIS ,temp7 #xC0 ,temp7) + ;; Setup FP|0 (continuation register) + (stack-write2 iFP ,temp7 ,temp5) + ;; Setup FP|1 (control register) + (AND ,cr ,temp8 ,temp8) + (SRL ,temp8 2 ,temp8) + (BIS zero |TypeFixnum+0xC0| ,temp6) + (BIS ,cr ,temp8 ,temp8) + (stack-write2-disp iFP 8 ,temp6 ,temp8) + ;; Setup iLP + (ADDQ iSP 8 iLP) + ;; Fill in the two fixed arguments. + (BIS zero |TypeFixnum| ,temp6) + (BIS zero ,tvi ,temp8) + (stack-write2-disp iFP ,(* 2 8) ,temp6 ,temp8) + (convert-pc-to-continuation iPC ,temp6 ,temp8 ,temp9) + (stack-write2-disp iFP ,(* 3 8) ,temp6 ,temp8) + ;; Set the control register + (LDQ ,temp7 PROCESSORSTATE_FCCRTRAPMASK (ivory) "Get CR mask") + (LDAH ,temp5 |ValueDispositionValue*4| (zero) "1<<18!") + (SUBQ iLP iFP ,temp6 "Arg size") + (SUBQ iFP ,temp ,temp8 "Caller Frame Size") + (SRL ,temp6 3 ,temp6 "Arg size in words") + (SLL ,temp8 ,(- 9 3) ,temp8 "Caller Frame Size in words in place") + (BIS ,temp5 ,temp6 ,temp5) + (BIS ,temp5 ,temp8 ,temp5) + ;; Compute trap mode + (TagCdr ,tag ,temp9) + (SRL ,cr 30 ,temp6) + (SUBQ ,temp9 ,temp6 ,temp8) + (CMOVGE ,temp8 ,temp9 ,temp6) + (SLL ,temp6 30 ,temp6) + (AND ,cr ,temp7 ,cr "Mask off unwanted bits") + (BIS ,cr ,temp6 ,cr "Add trap mode") + (BIS ,cr ,temp5 ,cr "Add argsize, apply, disposition, caller FS") + (set-control-register ,cr) + ;; Set Continuation + ,@(cond ((null next-pc) + `(;; --- Overkill to Ensure iCP is accurate + (PC-TO-iCACHEENT iPC iCP ,temp6 ,temp8) + (LDQ ,temp9 CACHELINE_NEXTPCDATA (iCP)) + (convert-pc-to-continuation ,temp9 ,temp6 ,temp8 ,temp10) + (LDQ ,temp9 CACHELINE_NEXTCP (iCP)) + (STQ ,temp9 PROCESSORSTATE_CONTINUATIONCP (Ivory)))) + (t + `((convert-pc-to-continuation ,next-pc ,temp6 ,temp8 ,temp9) + ,@(if next-cp + `((STQ ,next-cp PROCESSORSTATE_CONTINUATIONCP (Ivory))) + `((STQ zero PROCESSORSTATE_CONTINUATIONCP (Ivory))))))) + (set-continuation2 ,temp6 ,temp8) + ;; Set PC + (convert-continuation-to-pc ,tag ,data iPC ,temp9) + (SRL ,cr 30 ,temp6 "Save current trap mode") + (stack-overflow-p ,cr nil ,temp8 ,temp9 ,overflow) ;Destroys CR. + ;; Can't use this as it will smash the annotation field to point to + ;; the PC of the trap-handler, punting any useful annotation. + ;; Worse, it will trigger a cache fill even if the correct CP is + ;; already valid!!! + ;; (ContinueToInterpretInstruction-ValidateCache) + (PC-TO-iCACHEENT iPC iCP ,temp8 ,temp9) + (ContinueToNextInstruction-NoStall) + (label ,overflow) + (BEQ ,temp6 STACKOVERFLOW "Take the overflow if in emulator mode") + (halt-machine HaltReasonFatalStackOverflow) + ))) + +(defmacro stack-overflow-handler () + `( + ;; If we come here, we have already advanced the PC and pushed a new + ;; frame on the stack, so we must preserve iSP in the restartSP for + ;; retry to work + (STQ iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (take-post-trap |TrapVectorStackOverflow| zero t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 iPC))) + + +;;; The pre traps + +;;; Note that all of these routines shared registers! + +(defmacro take-pre-trap-1 (tvi temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + `((BIS iFP zero ,temp "save old frame pointer") + (BIS zero ,tvi ,temp10 "save the trap vector index") + (BSR R0 |StartPreTrap|))) + +;; TVI has been set into TEMP10, old iFP in TEMP +(defmacro start-pre-trap (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + `((LDQ ,temp2 PROCESSORSTATE_LINKAGE (Ivory)) + (branch-true ,temp2 |NativeException|) + (get-trap-vector-entry ,temp10 ,temp2 ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 ,temp9) + ;; Restore stack pointer + (LDQ iSP PROCESSORSTATE_RESTARTSP (ivory)) + (stack-cache-overflow-check ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 iSP 8) + ;; Build frame header for trap handler. + (get-continuation2 ,temp4 ,temp5) + (get-control-register ,temp7) + (EXTLL ,temp7 0 ,temp7) + (BIS ,temp4 #xC0 ,temp4) + ;; Setup FP|0 + (stack-push2-with-cdr ,temp4 ,temp5) + ;; Setup FP|1 + (BIS zero |TypeFixnum+0xC0| ,temp6) + (stack-push2-with-cdr ,temp6 ,temp7) + ;; Push the TVI and fault PC + (BIS zero ,temp10 ,temp6) + (stack-push-ir |TypeFixnum| ,temp6 ,temp8) + (convert-pc-to-continuation iPC ,temp6 ,temp8 ,temp9) + (set-continuation2 ,temp6 ,temp8) + (STQ iCP PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (stack-push2 ,temp6 ,temp8 ,temp9))) + +(defmacro take-pre-trap-2 (tvi temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + `((BR zero |FinishPreTrap|))) + +(defmacro finish-pre-trap (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + `(;; Finish call + ;; Establish new frame pointer. + (LDQ iFP PROCESSORSTATE_RESTARTSP (ivory)) + (ADDQ iFP 8 iFP "iFP now points to the start of our new frame") + ;; Setup iLP + (ADDQ iSP 8 iLP "Points beyond the last argument") + ;; Setup the control register. + (LDQ ,temp4 PROCESSORSTATE_FCCRTRAPMASK (ivory) "Get CR mask") + (LDAH ,temp5 |ValueDispositionValue*4| (zero) "1<<18!") + (SUBQ iLP iFP ,temp6 "Arg size") + (SUBQ iFP ,temp ,temp8 "Caller Frame Size") + (SRL ,temp6 3 ,temp6 "Arg size in words") + (SLL ,temp8 ,(- 9 3) ,temp8 "Caller Frame Size in words in place") + (BIS ,temp5 ,temp6 ,temp5) + (BIS ,temp5 ,temp8 ,temp5) + ;; Compute trap mode + (TagCdr ,temp2 ,temp9) + (SRL ,temp7 30 ,temp6) + (SUBQ ,temp9 ,temp6 ,temp8) + (CMOVGE ,temp8 ,temp9 ,temp6) + (SLL ,temp6 30 ,temp6) + (AND ,temp7 ,temp4 ,temp7 "Mask off unwanted bits") + (BIS ,temp7 ,temp6 ,temp7 "Add trap mode") + (BIS ,temp7 ,temp5 ,temp7 "Add argsize, apply, disposition, caller FS") + (set-control-register ,temp7) + ;; Set Continuation is handled above + ;; Set the PC + (convert-continuation-to-pc ,temp2 ,temp3 iPC ,temp9) + (stack-overflow-check ,temp7 nil ,temp8 ,temp9) ;Destroys TEMP7 + ;; Can't use this as it will smash the annotation field to point to + ;; the PC of the trap-handler, punting any useful annotation. + ;; Worse, it will trigger a cache fill even if the correct CP is + ;; already valid!!! + ;; (ContinueToInterpretInstruction-ValidateCache) + (PC-TO-iCACHEENT iPC iCP ,temp8 ,temp9) + (ContinueToNextInstruction-NoStall) + )) + +;; Microstate is in ARG2, VMA is in ARG5. C.f., prepare-exception which +;; puts the opcode in ARG2 and vma in arg5 (but computes them in +;; exception-handler, so they are free for us) +(defmacro illegal-operand-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterError| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorError| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (stack-push-ir |TypeFixnum| arg2 t11) ;the microstate + (stack-push-ir |TypeLocative| arg5 t11) ;the vma + (take-pre-trap-2 |TrapVectorError| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro reset-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorReset| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorReset| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorReset| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro pull-apply-args-trap-handler (argstopull temp13) + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorPullApplyArgs| t1 t2) + (passthru "#endif") + (stack-pop2 t11 t12) + (STQ iSP PROCESSORSTATE_RESTARTSP (ivory)) ;yes, we do mean to do this! + (take-pre-trap-1 |TrapVectorPullApplyArgs| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (stack-push-ir |TypeFixnum| ,argstopull ,temp13) + (stack-push2 t11 t12 ,temp13) + (take-pre-trap-2 |TrapVectorPullApplyArgs| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro trace-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorTrace| t1 t2) + (passthru "#endif")(take-pre-trap-1 |TrapVectorTrace| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorTrace| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro preempt-request-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorPreemptRequest| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorPreemptRequest| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorPreemptRequest| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro high-priority-sequence-break-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorHighPrioritySequenceBreak| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorHighPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorHighPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro low-priority-sequence-break-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorLowPrioritySequenceBreak| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorLowPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorLowPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro db-unwind-frame-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorDBUnwindFrame| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorDBUnwindFrame| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (LDQ t11 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-push-ir |TypeLocative| t11 t12) + (take-pre-trap-2 |TrapVectorDBUnwindFrame| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro db-unwind-catch-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorDBUnwindCatch| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorDBUnwindCatch| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (LDQ t11 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-push-ir |TypeLocative| t11 t12) + (take-pre-trap-2 |TrapVectorDBUnwindCatch| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + + +;;; The Memory Traps. + +;;; No physical addresses to worry about! +(defmacro take-memory-trap (tvi) + `((LDQ t11 PROCESSORSTATE_VMA (ivory) "Preserve VMA against reading trap vector") + (take-pre-trap-1 ,tvi t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (stack-push-ir |TypeLocative| t11 t12) + (take-pre-trap-2 ,tvi t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro transport-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterTransport| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorTransport|))) + +(defmacro monitor-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterMonitor| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorMonitor|))) + +(defmacro page-not-resident-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterPageNotResident| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorPageNotResident|))) + +(defmacro page-fault-request-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterPageFaultRequest| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorPageFaultRequest|))) + +(defmacro page-write-fault-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterPageWriteFault| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorPageWriteFault|))) + +(defmacro uncorrectable-memory-error-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterUncorrectableMemoryError| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorUncorrectableMemoryError|))) + +(defmacro bus-error-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterMemoryBusError| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorMemoryBusError|))) + +(defmacro db-cache-miss-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterDBCacheMiss| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorDBCacheMiss|))) + + +;;; Instruction exceptions, which are special cases of post traps. + +;;; The information here is taken verbatim from the iSoft emulator, but the +;;; way that the information is used if different. We define the information +;;; here for the macroexpanders to create customized exception handler calls. + +#|| +*instruction-exception-info* is a per-opcode table of information we need to +take an instruction exception. Each entry is either NIL, meaning an exception +shouldn't happen for that instruction, or a fixnum with the following fields: +(byte 2 0) arity, the number of arguments to be passed to the trap handler. + Note that this isn't always the same as the number of operands + the instruction takes, see ldb for example. +(byte 1 2) format. 0 means the last argument can be retrieved by looking + at bits in the instruction. For reference: +(byte 2 15.) is 00 or 01 for signed, 10 for unsigned, 11 for + address-operand. + 1 means the last argument is on the stack. This is used for + ldb, dpb, and a few other strange ones. +(byte 1 3) 0 if normal, 1 if arithmetic dispatch. +||# + +;; ---*** OpenMCL fills an array with 0 by default??? +(defvar *instruction-exception-info* (make-array 400 :initial-element nil)) +(defvar *ivory-instruction-opcode-table* (make-hash-table)) + +;; Have to fill in table, as many instructions default their exception +;; info, but we still need to look up the opcode +(progn + (setf (gethash 'car *ivory-instruction-opcode-table*) |opcode$K-car|) + (setf (gethash 'cdr *ivory-instruction-opcode-table*) |opcode$K-cdr|) + (setf (gethash 'endp *ivory-instruction-opcode-table*) |opcode$K-endp|) + (setf (gethash 'setup-1d-array *ivory-instruction-opcode-table*) |opcode$K-setup1darray|) + (setf (gethash 'setup-force-1d-array *ivory-instruction-opcode-table*) + |opcode$K-setupforce1darray|) + (setf (gethash 'bind-locative *ivory-instruction-opcode-table*) |opcode$K-bindlocative|) + (setf (gethash '%restore-binding-stack *ivory-instruction-opcode-table*) + |opcode$K-restorebindingstack|) + (setf (gethash '%ephemeralp *ivory-instruction-opcode-table*) |opcode$K-ephemeralp|) + (setf (gethash 'start-call *ivory-instruction-opcode-table*) |opcode$K-startcall|) + (setf (gethash '%jump *ivory-instruction-opcode-table*) |opcode$K-jump|) + (setf (gethash '%tag *ivory-instruction-opcode-table*) |opcode$K-tag|) + (setf (gethash 'dereference *ivory-instruction-opcode-table*) |opcode$K-dereference|) + (setf (gethash 'logic-tail-test *ivory-instruction-opcode-table*) |opcode$K-logictailtest|) + #|| (setf (gethash '%proc-breakpoint *ivory-instruction-opcode-table*) + |opcode$K-%proc-breakpoint|) ||# + (setf (gethash 'double-float-op *ivory-instruction-opcode-table*) |opcode$K-doublefloatop|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash '%block-0-write *ivory-instruction-opcode-table*) |opcode$K-block0write|) + (setf (gethash '%block-1-write *ivory-instruction-opcode-table*) |opcode$K-block1write|) + (setf (gethash '%block-2-write *ivory-instruction-opcode-table*) |opcode$K-block2write|) + (setf (gethash '%block-3-write *ivory-instruction-opcode-table*) |opcode$K-block3write|) + (setf (gethash 'zerop *ivory-instruction-opcode-table*) |opcode$K-zerop|) + (setf (gethash 'minusp *ivory-instruction-opcode-table*) |opcode$K-minusp|) + (setf (gethash 'plusp *ivory-instruction-opcode-table*) |opcode$K-plusp|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'locate-locals *ivory-instruction-opcode-table*) |opcode$K-locatelocals|) + (setf (gethash 'catch-close *ivory-instruction-opcode-table*) |opcode$K-catchclose|) + (setf (gethash '%generic-dispatch *ivory-instruction-opcode-table*) + |opcode$K-genericdispatch|) + (setf (gethash '%message-dispatch *ivory-instruction-opcode-table*) + |opcode$K-messagedispatch|) + (setf (gethash '%check-preempt-request *ivory-instruction-opcode-table*) + |opcode$K-checkpreemptrequest|) + (setf (gethash 'push-global-logic-variable *ivory-instruction-opcode-table*) + |opcode$K-pushgloballogicvariable|) + (setf (gethash 'no-op *ivory-instruction-opcode-table*) |opcode$K-noop|) + (setf (gethash '%halt *ivory-instruction-opcode-table*) |opcode$K-halt|) + (setf (gethash 'branch-true *ivory-instruction-opcode-table*) |opcode$K-branchtrue|) + (setf (gethash 'branch-true-else-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueelseextrapop|) + (setf (gethash 'branch-true-and-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueandextrapop|) + (setf (gethash 'branch-true-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueextrapop|) + (setf (gethash 'branch-true-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtruenopop|) + (setf (gethash 'branch-true-and-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueandnopop|) + (setf (gethash 'branch-true-else-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueelsenopop|) + (setf (gethash 'branch-true-and-no-pop-else-no-pop-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueandnopopelsenopopextrapop|) + (setf (gethash 'branch-false *ivory-instruction-opcode-table*) |opcode$K-branchfalse|) + (setf (gethash 'branch-false-else-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseelseextrapop|) + (setf (gethash 'branch-false-and-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseandextrapop|) + (setf (gethash 'branch-false-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseextrapop|) + (setf (gethash 'branch-false-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalsenopop|) + (setf (gethash 'branch-false-and-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseandnopop|) + (setf (gethash 'branch-false-else-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseelsenopop|) + (setf (gethash 'branch-false-and-no-pop-else-no-pop-extra-pop + *ivory-instruction-opcode-table*) + |opcode$K-branchfalseandnopopelsenopopextrapop|) + (setf (gethash 'push *ivory-instruction-opcode-table*) |opcode$K-push|) + (setf (gethash 'push-n-nils *ivory-instruction-opcode-table*) |opcode$K-pushnnils|) + (setf (gethash 'push-address-sp-relative *ivory-instruction-opcode-table*) + |opcode$K-pushaddresssprelative|) + (setf (gethash 'push-local-logic-variables *ivory-instruction-opcode-table*) + |opcode$K-pushlocallogicvariables|) + (setf (gethash 'return-multiple *ivory-instruction-opcode-table*) |opcode$K-returnmultiple|) + (setf (gethash 'return-kludge *ivory-instruction-opcode-table*) |opcode$K-returnkludge|) + (setf (gethash 'take-values *ivory-instruction-opcode-table*) |opcode$K-takevalues|) + (setf (gethash 'unbind-n *ivory-instruction-opcode-table*) |opcode$K-unbindn|) + (setf (gethash 'push-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-pushinstancevariable|) + (setf (gethash 'push-address-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-pushaddressinstancevariable|) + (setf (gethash 'push-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-pushinstancevariableordered|) + (setf (gethash 'push-address-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-pushaddressinstancevariableordered|) + (setf (gethash 'unary-minus *ivory-instruction-opcode-table*) |opcode$K-unaryminus|) + (setf (gethash 'return-single *ivory-instruction-opcode-table*) |opcode$K-returnsingle|) + (setf (gethash '%memory-read *ivory-instruction-opcode-table*) |opcode$K-memoryread|) + (setf (gethash '%memory-read-address *ivory-instruction-opcode-table*) + |opcode$K-memoryreadaddress|) + (setf (gethash '%block-0-read *ivory-instruction-opcode-table*) |opcode$K-block0read|) + (setf (gethash '%block-1-read *ivory-instruction-opcode-table*) |opcode$K-block1read|) + (setf (gethash '%block-2-read *ivory-instruction-opcode-table*) |opcode$K-block2read|) + (setf (gethash '%block-3-read *ivory-instruction-opcode-table*) |opcode$K-block3read|) + (setf (gethash '%block-0-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block0readshift|) + (setf (gethash '%block-1-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block1readshift|) + (setf (gethash '%block-2-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block2readshift|) + (setf (gethash '%block-3-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block3readshift|) + (setf (gethash '%block-0-read-test *ivory-instruction-opcode-table*) + |opcode$K-block0readtest|) + (setf (gethash '%block-1-read-test *ivory-instruction-opcode-table*) + |opcode$K-block1readtest|) + (setf (gethash '%block-2-read-test *ivory-instruction-opcode-table*) + |opcode$K-block2readtest|) + (setf (gethash '%block-3-read-test *ivory-instruction-opcode-table*) + |opcode$K-block3readtest|) + (setf (gethash 'finish-call-n *ivory-instruction-opcode-table*) |opcode$K-finishcalln|) + (setf (gethash 'finish-call-n-apply *ivory-instruction-opcode-table*) + |opcode$K-finishcallnapply|) + (setf (gethash 'finish-call-tos *ivory-instruction-opcode-table*) |opcode$K-finishcalltos|) + (setf (gethash 'finish-call-tos-apply *ivory-instruction-opcode-table*) + |opcode$K-finishcalltosapply|) + (setf (gethash 'set-to-car *ivory-instruction-opcode-table*) |opcode$K-settocar|) + (setf (gethash 'set-to-cdr *ivory-instruction-opcode-table*) |opcode$K-settocdr|) + (setf (gethash 'set-to-cdr-push-car *ivory-instruction-opcode-table*) + |opcode$K-settocdrpushcar|) + (setf (gethash 'increment *ivory-instruction-opcode-table*) |opcode$K-increment|) + (setf (gethash 'decrement *ivory-instruction-opcode-table*) |opcode$K-decrement|) + (setf (gethash '%pointer-increment *ivory-instruction-opcode-table*) + |opcode$K-pointerincrement|) + (setf (gethash '%set-cdr-code-1 *ivory-instruction-opcode-table*) |opcode$K-setcdrcode1|) + (setf (gethash '%set-cdr-code-2 *ivory-instruction-opcode-table*) |opcode$K-setcdrcode2|) + (setf (gethash 'push-address *ivory-instruction-opcode-table*) |opcode$K-pushaddress|) + (setf (gethash 'set-sp-to-address *ivory-instruction-opcode-table*) + |opcode$K-setsptoaddress|) + (setf (gethash 'set-sp-to-address-save-tos *ivory-instruction-opcode-table*) + |opcode$K-setsptoaddresssavetos|) + (setf (gethash '%read-internal-register *ivory-instruction-opcode-table*) + |opcode$K-readinternalregister|) + (setf (gethash '%write-internal-register *ivory-instruction-opcode-table*) + |opcode$K-writeinternalregister|) + (setf (gethash '%coprocessor-read *ivory-instruction-opcode-table*) + |opcode$K-coprocessorread|) + (setf (gethash '%coprocessor-write *ivory-instruction-opcode-table*) + |opcode$K-coprocessorwrite|) + (setf (gethash '%block-0-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block0readalu|) + (setf (gethash '%block-1-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block1readalu|) + (setf (gethash '%block-2-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block2readalu|) + (setf (gethash '%block-3-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block3readalu|) + (setf (gethash 'ldb *ivory-instruction-opcode-table*) |opcode$K-ldb|) + (setf (gethash 'char-ldb *ivory-instruction-opcode-table*) |opcode$K-charldb|) + (setf (gethash '%p-ldb *ivory-instruction-opcode-table*) |opcode$K-pldb|) + (setf (gethash '%p-tag-ldb *ivory-instruction-opcode-table*) |opcode$K-ptagldb|) + (setf (gethash 'branch *ivory-instruction-opcode-table*) |opcode$K-branch|) + (setf (gethash 'loop-decrement-tos *ivory-instruction-opcode-table*) + |opcode$K-loopdecrementtos|) + (setf (gethash 'entry-rest-accepted *ivory-instruction-opcode-table*) + |opcode$K-entryrestaccepted|) + (setf (gethash 'entry-rest-not-accepted *ivory-instruction-opcode-table*) + |opcode$K-entryrestnotaccepted|) + (setf (gethash 'rplaca *ivory-instruction-opcode-table*) |opcode$K-rplaca|) + (setf (gethash 'rplacd *ivory-instruction-opcode-table*) |opcode$K-rplacd|) + (setf (gethash 'multiply *ivory-instruction-opcode-table*) |opcode$K-multiply|) + (setf (gethash 'quotient *ivory-instruction-opcode-table*) |opcode$K-quotient|) + (setf (gethash 'ceiling *ivory-instruction-opcode-table*) |opcode$K-ceiling|) + (setf (gethash 'floor *ivory-instruction-opcode-table*) |opcode$K-floor|) + (setf (gethash 'truncate *ivory-instruction-opcode-table*) |opcode$K-truncate|) + (setf (gethash 'round *ivory-instruction-opcode-table*) |opcode$K-round|) + (setf (gethash 'rational-quotient *ivory-instruction-opcode-table*) + |opcode$K-rationalquotient|) + (setf (gethash 'min *ivory-instruction-opcode-table*) |opcode$K-min|) + (setf (gethash 'max *ivory-instruction-opcode-table*) |opcode$K-max|) + (setf (gethash '%alu *ivory-instruction-opcode-table*) |opcode$K-alu|) + (setf (gethash 'logand *ivory-instruction-opcode-table*) |opcode$K-logand|) + (setf (gethash 'logxor *ivory-instruction-opcode-table*) |opcode$K-logxor|) + (setf (gethash 'logior *ivory-instruction-opcode-table*) |opcode$K-logior|) + (setf (gethash 'rot *ivory-instruction-opcode-table*) |opcode$K-rot|) + (setf (gethash 'lsh *ivory-instruction-opcode-table*) |opcode$K-lsh|) + (setf (gethash '%multiply-double *ivory-instruction-opcode-table*) + |opcode$K-multiplydouble|) + (setf (gethash '%lshc-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-lshcbignumstep|) + (setf (gethash 'stack-blt *ivory-instruction-opcode-table*) |opcode$K-stackblt|) + (setf (gethash 'rgetf *ivory-instruction-opcode-table*) |opcode$K-rgetf|) + (setf (gethash 'member *ivory-instruction-opcode-table*) |opcode$K-member|) + (setf (gethash 'assoc *ivory-instruction-opcode-table*) |opcode$K-assoc|) + (setf (gethash '%pointer-plus *ivory-instruction-opcode-table*) |opcode$K-pointerplus|) + (setf (gethash '%pointer-difference *ivory-instruction-opcode-table*) + |opcode$K-pointerdifference|) + (setf (gethash 'ash *ivory-instruction-opcode-table*) |opcode$K-ash|) + (setf (gethash 'store-conditional *ivory-instruction-opcode-table*) + |opcode$K-storeconditional|) + (setf (gethash '%memory-write *ivory-instruction-opcode-table*) |opcode$K-memorywrite|) + (setf (gethash '%p-store-contents *ivory-instruction-opcode-table*) + |opcode$K-pstorecontents|) + (setf (gethash 'bind-locative-to-value *ivory-instruction-opcode-table*) + |opcode$K-bindlocativetovalue|) + (setf (gethash 'unify *ivory-instruction-opcode-table*) |opcode$K-unify|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'equal-number *ivory-instruction-opcode-table*) |opcode$K-equalnumber|) + (setf (gethash 'lessp *ivory-instruction-opcode-table*) |opcode$K-lessp|) + (setf (gethash 'greaterp *ivory-instruction-opcode-table*) |opcode$K-greaterp|) + (setf (gethash 'eql *ivory-instruction-opcode-table*) |opcode$K-eql|) + (setf (gethash 'equal-number-no-pop *ivory-instruction-opcode-table*) + |opcode$K-equalnumbernopop|) + (setf (gethash 'lessp-no-pop *ivory-instruction-opcode-table*) |opcode$K-lesspnopop|) + (setf (gethash 'greaterp-no-pop *ivory-instruction-opcode-table*) |opcode$K-greaterpnopop|) + (setf (gethash 'eql-no-pop *ivory-instruction-opcode-table*) |opcode$K-eqlnopop|) + (setf (gethash 'eq *ivory-instruction-opcode-table*) |opcode$K-eq|) + (setf (gethash 'logtest *ivory-instruction-opcode-table*) |opcode$K-logtest|) + (setf (gethash 'eq-no-pop *ivory-instruction-opcode-table*) |opcode$K-eqnopop|) + (setf (gethash 'logtest-no-pop *ivory-instruction-opcode-table*) |opcode$K-logtestnopop|) + (setf (gethash 'add *ivory-instruction-opcode-table*) |opcode$K-add|) + (setf (gethash 'sub *ivory-instruction-opcode-table*) |opcode$K-sub|) + (setf (gethash '%32-bit-plus *ivory-instruction-opcode-table*) |opcode$K-32bitplus|) + (setf (gethash '%32-bit-difference *ivory-instruction-opcode-table*) + |opcode$K-32bitdifference|) + (setf (gethash '%add-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-addbignumstep|) + (setf (gethash '%sub-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-subbignumstep|) + (setf (gethash '%multiply-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-multiplybignumstep|) + (setf (gethash '%divide-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-dividebignumstep|) + (setf (gethash 'aset-1 *ivory-instruction-opcode-table*) |opcode$K-aset1|) + (setf (gethash '%allocate-list-block *ivory-instruction-opcode-table*) + |opcode$K-allocatelistblock|) + (setf (gethash 'aref-1 *ivory-instruction-opcode-table*) |opcode$K-aref1|) + (setf (gethash 'aloc-1 *ivory-instruction-opcode-table*) |opcode$K-aloc1|) + (setf (gethash 'store-array-leader *ivory-instruction-opcode-table*) + |opcode$K-storearrayleader|) + (setf (gethash '%allocate-structure-block *ivory-instruction-opcode-table*) + |opcode$K-allocatestructureblock|) + (setf (gethash 'array-leader *ivory-instruction-opcode-table*) |opcode$K-arrayleader|) + (setf (gethash 'aloc-leader *ivory-instruction-opcode-table*) |opcode$K-alocleader|) + (setf (gethash 'pop-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-popinstancevariable|) + (setf (gethash 'movem-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-moveminstancevariable|) + (setf (gethash 'pop-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-popinstancevariableordered|) + (setf (gethash 'movem-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-moveminstancevariableordered|) + (setf (gethash '%instance-ref *ivory-instruction-opcode-table*) |opcode$K-instanceref|) + (setf (gethash '%instance-set *ivory-instruction-opcode-table*) |opcode$K-instanceset|) + (setf (gethash '%instance-loc *ivory-instruction-opcode-table*) |opcode$K-instanceloc|) + (setf (gethash '%set-tag *ivory-instruction-opcode-table*) |opcode$K-settag|) + (setf (gethash '%unsigned-lessp *ivory-instruction-opcode-table*) |opcode$K-unsignedlessp|) + (setf (gethash '%unsigned-lessp-no-pop *ivory-instruction-opcode-table*) + |opcode$K-unsignedlesspnopop|) + (setf (gethash 'pop *ivory-instruction-opcode-table*) |opcode$K-pop|) + (setf (gethash 'movem *ivory-instruction-opcode-table*) |opcode$K-movem|) + (setf (gethash '%merge-cdr-no-pop *ivory-instruction-opcode-table*) + |opcode$K-mergecdrnopop|) + (setf (gethash 'fast-aref-1 *ivory-instruction-opcode-table*) |opcode$K-fastaref1|) + (setf (gethash 'fast-aset-1 *ivory-instruction-opcode-table*) |opcode$K-fastaset1|) + (setf (gethash 'stack-blt-address *ivory-instruction-opcode-table*) + |opcode$K-stackbltaddress|) + (setf (gethash 'dpb *ivory-instruction-opcode-table*) |opcode$K-dpb|) + (setf (gethash 'char-dpb *ivory-instruction-opcode-table*) |opcode$K-chardpb|) + (setf (gethash '%p-dpb *ivory-instruction-opcode-table*) |opcode$K-pdpb|) + (setf (gethash '%p-tag-dpb *ivory-instruction-opcode-table*) |opcode$K-ptagdpb|) + (setf (gethash 'loop-increment-tos-less-than *ivory-instruction-opcode-table*) + |opcode$K-loopincrementtoslessthan|) + (setf (gethash 'catch-open *ivory-instruction-opcode-table*) |opcode$K-catchopen|) + #|| (setf (gethash '%hack *ivory-instruction-opcode-table*) |opcode$K-hack|) ||# + ) + + + +(defmacro define-instruction-exception (instruction opcode arity &rest options) + `(define-instruction-exception-1 ',instruction ,opcode ,arity ',options)) + +(defun define-instruction-exception-1 (instruction opcode arity options) + (setf (gethash instruction *ivory-instruction-opcode-table*) opcode) + (setf (aref *instruction-exception-info* opcode) + (dpb (if (member :stack options) 1 0) + (byte 1 3) + (dpb (if (member :arithmetic options) 1 0) + (byte 1 4) + arity)))) + +(defun instruction-exception-info (opcode) + #+Genera (declare (values arity stack? arithmetic?)) + (let ((info (aref *instruction-exception-info* opcode))) + (if (not (null info)) + (values (ldb (byte 3 0) info) + (ldb-test (byte 1 3) info) + (ldb-test (byte 1 4) info)) + ;; Undefined instruction exception. + (values 0 t nil)))) + +(define-instruction-exception car |opcode$K-car| 1) +(define-instruction-exception cdr |opcode$K-cdr| 1) +(define-instruction-exception set-to-car |opcode$K-settocar| 1) +(define-instruction-exception set-to-cdr |opcode$K-settocdr| 1) +(define-instruction-exception set-to-cdr-push-car |opcode$K-settocdrpushcar| 1) +(define-instruction-exception rplaca |opcode$K-rplaca| 2) +(define-instruction-exception rplacd |opcode$K-rplacd| 2) +(define-instruction-exception rgetf |opcode$K-rgetf| 2) +(define-instruction-exception member |opcode$K-member| 2) +(define-instruction-exception assoc |opcode$K-assoc| 2) +(define-instruction-exception eql |opcode$K-eql| 2 :arithmetic) +(define-instruction-exception eql-no-pop |opcode$K-eqlnopop| 2 :arithmetic) +(define-instruction-exception equal-number |opcode$K-equalnumber| 2 :arithmetic) +(define-instruction-exception equal-number-no-pop |opcode$K-equalnumbernopop| 2 :arithmetic) +(define-instruction-exception greaterp |opcode$K-greaterp| 2 :arithmetic) +(define-instruction-exception greaterp-no-pop |opcode$K-greaterpnopop| 2 :arithmetic) +(define-instruction-exception lessp |opcode$K-lessp| 2 :arithmetic) +(define-instruction-exception lessp-no-pop |opcode$K-lesspnopop| 2 :arithmetic) +(define-instruction-exception plusp |opcode$K-plusp| 1 :arithmetic) +(define-instruction-exception minusp |opcode$K-minusp| 1 :arithmetic) +(define-instruction-exception zerop |opcode$K-zerop| 1 :arithmetic) +(define-instruction-exception logtest |opcode$K-logtest| 2 :arithmetic) +(define-instruction-exception logtest-no-pop |opcode$K-logtestnopop| 2 :arithmetic) +(define-instruction-exception add |opcode$K-add| 2 :arithmetic) +(define-instruction-exception sub |opcode$K-sub| 2 :arithmetic) +(define-instruction-exception unary-minus |opcode$K-unaryminus| 1 :arithmetic) +(define-instruction-exception increment |opcode$K-increment| 1) +(define-instruction-exception decrement |opcode$K-decrement| 1) +(define-instruction-exception multiply |opcode$K-multiply| 2 :arithmetic) +(define-instruction-exception quotient |opcode$K-quotient| 2 :arithmetic) +(define-instruction-exception ceiling |opcode$K-ceiling| 2 :arithmetic) +(define-instruction-exception floor |opcode$K-floor| 2 :arithmetic) +(define-instruction-exception truncate |opcode$K-truncate| 2 :arithmetic) +(define-instruction-exception round |opcode$K-round| 2 :arithmetic) +;(define-instruction-exception remainder 2 :arithmetic) +(define-instruction-exception rational-quotient |opcode$K-rationalquotient| 2 :arithmetic) +(define-instruction-exception double-float-op |opcode$K-doublefloatop| 5 :arithmetic) +(define-instruction-exception max |opcode$K-max| 2 :arithmetic) +(define-instruction-exception min |opcode$K-min| 2 :arithmetic) +(define-instruction-exception logand |opcode$K-logand| 2 :arithmetic) +(define-instruction-exception logior |opcode$K-logior| 2 :arithmetic) +(define-instruction-exception logxor |opcode$K-logxor| 2 :arithmetic) +(define-instruction-exception ash |opcode$K-ash| 2 :arithmetic) +(define-instruction-exception ldb |opcode$K-ldb| 1 :stack) +(define-instruction-exception dpb |opcode$K-dpb| 2 :stack) +(define-instruction-exception aref-1 |opcode$K-aref1| 2) +(define-instruction-exception aset-1 |opcode$K-aset1| 3) +(define-instruction-exception aloc-1 |opcode$K-aloc1| 2) +(define-instruction-exception setup-1d-array |opcode$K-setup1darray| 1) +(define-instruction-exception setup-force-1d-array |opcode$K-setupforce1darray| 1) +(define-instruction-exception fast-aref-1 |opcode$K-fastaref1| 2) +(define-instruction-exception fast-aset-1 |opcode$K-fastaset1| 3) +(define-instruction-exception array-leader |opcode$K-arrayleader| 2) +(define-instruction-exception store-array-leader |opcode$K-storearrayleader| 3) +(define-instruction-exception aloc-leader |opcode$K-alocleader| 2) +(define-instruction-exception loop-decrement-tos |opcode$K-loopdecrementtos| 1 :stack) +(define-instruction-exception loop-increment-tos-less-than |opcode$K-loopincrementtoslessthan| 2 :stack) +(define-instruction-exception block-0-read-alu |opcode$K-block0readalu| 1) +(define-instruction-exception block-1-read-alu |opcode$K-block1readalu| 1) +(define-instruction-exception block-2-read-alu |opcode$K-block2readalu| 1) +(define-instruction-exception block-3-read-alu |opcode$K-block3readalu| 1) +(define-instruction-exception allocate-list-block |opcode$K-allocatelistblock| 2) +(define-instruction-exception allocate-structure-block |opcode$K-allocatestructureblock| 2) +(define-instruction-exception unify |opcode$K-unify| 2) +(define-instruction-exception logic-tail-test |opcode$K-logictailtest| 1) +(define-instruction-exception push-address-sp-relative |opcode$K-pushaddresssprelative| 1) +(define-instruction-exception stack-blt |opcode$K-stackblt| 2) +(define-instruction-exception stack-blt-address |opcode$K-stackbltaddress| 2) +(define-instruction-exception char-ldb |opcode$K-charldb| 1 :stack) +(define-instruction-exception char-dpb |opcode$K-chardpb| 2 :stack) +(define-instruction-exception bind-locative-to-value |opcode$K-bindlocativetovalue| 2) +(define-instruction-exception bind-locative |opcode$K-bindlocative| 1) +(define-instruction-exception restore-binding-stack |opcode$K-restorebindingstack| 1) +(define-instruction-exception push-lexical-var |opcode$K-pushlexicalvar| 1) +(define-instruction-exception pop-lexical-var |opcode$K-poplexicalvar| 2) +(define-instruction-exception movem-lexical-var |opcode$K-movemlexicalvar| 2) +(define-instruction-exception instance-ref |opcode$K-instanceref| 2) +(define-instruction-exception instance-set |opcode$K-instanceset| 3) +(define-instruction-exception instance-loc |opcode$K-instanceloc| 2) +(define-instruction-exception push-instance-variable |opcode$K-pushinstancevariable| 1) +(define-instruction-exception pop-instance-variable |opcode$K-popinstancevariable| 2) +(define-instruction-exception movem-instance-variable |opcode$K-moveminstancevariable| 2) +(define-instruction-exception push-address-instance-variable |opcode$K-pushaddressinstancevariable| 1) +(define-instruction-exception block-0-read-test |opcode$K-block0readtest| 2 :stack) +(define-instruction-exception block-1-read-test |opcode$K-block1readtest| 2 :stack) +(define-instruction-exception block-2-read-test |opcode$K-block2readtest| 2 :stack) +(define-instruction-exception block-3-read-test |opcode$K-block3readtest| 2 :stack) +(define-instruction-exception alu |opcode$K-alu| 2) + +;;; Macro to get the instruction exception information into args before +;;; jumping to the instruction exception routine. 'instruction' is the +;;; instruction name, popped is a number representing the number of stack +;;; pops that have occured when this exception was started. + +;;; Macro to get the instruction exception information into args before +;;; jumping to the instruction exception routine. 'instruction' is the +;;; instruction name, popped is a number representing the number of stack +;;; pops that have occured when this exception was started. + +(defmacro prepare-exception + (instruction popped + &optional operand tag + (fixed-arity nil arity-p) (fixed-arithmetic? nil arith-p)) + (declare (ignore operand popped)) + (let ((opcode (gethash instruction *ivory-instruction-opcode-table*))) + (assert (not (null opcode)) (instruction) + "~S is not a known instruction" instruction) + (multiple-value-bind (arity stack? arithmetic?) + (instruction-exception-info opcode) + `(,@(cond + (stack? + `(;; operand not needed + ,@(when tag + `((BIS zero ,tag arg6 "arg6 = tag to dispatch on"))) + (BIS zero ,1 arg3 "arg3 = stackp"))) + (t + `(,@(when tag + `((BIS zero ,tag arg6 "arg6 = tag to dispatch on"))) + (BIS zero ,0 arg3 "arg3 = stackp") + ;; If this is an address-format opcode, arg5 is the SCA + ;; and will be converted appropriately in the handler + ))) + ,@(if arity-p + (assert (eq arity fixed-arity) () "You lied") + `((BIS zero ,arity arg1 "arg1 = instruction arity"))) + ;; The Handler always loads the opcode (correctly) from iCP, so + ;; that multiple opcodes can share the same preparation + ,@(if arith-p + (assert (eq arithmetic? fixed-arithmetic?) () "You lied") + `((BIS zero ,(if arithmetic? 1 0) arg4 "arg4 = arithmeticp"))) + )))) + +(defmacro exception-handler (specialp tvi next-pc taillabel &optional fixed-arity) + (check-temporaries (tvi next-pc) ('arg1 'arg2 'arg3 'arg5 't1 't2 't3 't4)) + (let ((l1 (gensym)) + (l2 (gensym)) + (l3 (gensym)) + (l4 (gensym)) + (l5 (gensym)) + (l6 (gensym))) + `((LDQ t2 PROCESSORSTATE_LINKAGE (Ivory)) + (LDQ iSP PROCESSORSTATE_RESTARTSP (ivory) "fix the stack pointer") + (LDQ arg2 CACHELINE_INSTRUCTION (iCP) "fetch the real opcode") + (branch-true t2 |NativeException|) + ,@(when fixed-arity + `((load-constant arg1 ,fixed-arity))) + ,@(when (eq specialp :arithmetic) + ;; check for doublefloatop + `( + (SRL arg2 10 arg2 "get opcode into low byte") + (AND arg2 255 arg2 "low byte only") + (CMPEQ arg2 |Opcode_DoubleFloatOp| arg2 "is it DoubleFloatOp ?") + (branch-false arg2 ,l6 "not a doublefloat") + (external-branch DOUBLEFLOATEXC "it's a double float exc") + (label ,l6) + (LDQ arg2 CACHELINE_INSTRUCTION (iCP) "fetch the real opcode again"))) + ,@(unless (eq specialp :arithmetic) + ;; all arithmetic exceptions have an unstacked operand + `((BNE arg3 ,l2 "J. if arguments stacked"))) + ;; --- Should be a subroutine + ;; Push unstacked argument + (EXTWL arg2 4 t1 "Get original operand") + (CMPEQ t1 #o1000 t3 "t3 is non-zero iff SP|POP operand") + (branch-true t3 ,l2 "SP|POP operand recovered by restoring SP") + (LDA arg5 0 (iFP) "Assume FP mode") + (LDA t3 #.(* -255 8) (iSP) "SP mode constant") + (EXTBL arg2 5 t4 "Get the mode bits") + (EXTBL arg2 4 t2 "Extract (8-bit, unsigned) operand") + (SUBQ t4 2 t4 "t4 = -2 FP, -1 LP, 0 SP, 1 Imm") + (CMOVLBS t4 iLP arg5 "LP or Immediate mode") + (CMOVEQ t4 t3 arg5 "SP mode") + (S8ADDQ t2 arg5 arg5 "Compute operand address") + (BLE t4 ,l3 "Not immediate mode") + (SLL t2 #.(- 64 8) t1) + (SRL arg2 #.(+ 6 10) t3) + (SRA t1 #.(- 64 8) t1) + (LDA arg5 PROCESSORSTATE_IMMEDIATE_ARG (Ivory) "Immediate mode constant") + (CMOVLBC t3 t1 t2 "Signed immediate") + (STL t2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (label ,l3) + (load-constant t1 #.(dpb -1 (byte 2 (+ 5 10)) 0)) + (AND arg2 t1 t2) + (CMPEQ t1 t2 t3) + (branch-false t3 ,l4 "J. if not address-format operand") + (SCAtoVMA arg5 t1 t2) + (BIS zero |TypeLocative| t2) + (SetTag t2 t1 arg5) + (BR zero ,l5) + (label ,l4) + (LDQ arg5 0 (arg5) "Fetch the arg") + (label ,l5) + (stack-push-with-cdr arg5) + (label ,l2) + ,@(if (eq specialp :arithmetic) + `((SRL arg2 17 t4 "Get unary/nary bit of opcode") + (BIS zero 1 arg1 "Assume unary") + ;(SUBQ arg1 1 t4) + (BIS zero zero ,tvi) + (BIS iSP zero t2) + (BLBC t4 ,l1 "J. if not binary arithmetic dispatch") + (BIS zero 2 arg1 "Nary -> Binary") + (stack-read-tag iSP ,tvi) + (SUBQ t2 8 t2) + (AND ,tvi 7 ,tvi "low three bits has opcode tag for op2") + (label ,l1) + (SRL arg2 #.(- 10 6) arg2 "Shift opcode into position") + (stack-read-tag t2 t2) + (AND arg2 #.(dpb -1 (byte 5 6) 0) arg2 "five bits from the opcode") + (AND t2 7 t2) + (S8ADDQ t2 ,tvi ,tvi) + (BIS arg2 ,tvi ,tvi) + (LDA ,tvi |TrapVectorArithmeticInstructionException| (,tvi)) + (passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorArithmeticInstructionException| t1 t2) + (passthru "#endif") + ) + `((SRL arg2 10 arg2 "Shift opcode into position") + (AND arg2 #.(dpb -1 (byte 8 0) 0) arg2 "Just 8-bits of opcode") + (LDA ,tvi |TrapVectorInstructionException| (arg2)) + (passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorInstructionException| t1 t2) + (passthru "#endif") + )) + ,@(if (eq specialp :loop) + `((BIS arg5 zero ,next-pc)) + `((LDQ ,next-pc CACHELINE_NEXTPCDATA (iCP)))) + (BR zero ,taillabel)))) + +(defmacro exception-handler-common-tail (tvi arity next-pc) + (check-temporaries (tvi arity next-pc) ('t1 't2 't3 't4 't5 't6 't7 't8 't9 't10)) + `((take-post-trap ,tvi ,arity t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 ,next-pc))) + +;;; Fin. diff --git a/alpha-emulator/intrpmac.lisp b/alpha-emulator/intrpmac.lisp new file mode 100644 index 0000000..9be1489 --- /dev/null +++ b/alpha-emulator/intrpmac.lisp @@ -0,0 +1,1345 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +(defmacro check-temporaries ((&rest lives) (&rest temps)) + `(check-temporaries-1 (list ,@lives) (list ,@temps))) + +(defvar *memoized-vmdata* nil) +(defvar *memoized-vmtags* nil) +(defvar *memoized-base* nil) +(defvar *memoized-limit* nil) +(defvar *memoized-action* nil) +(defvar *memoized-action-cycle* nil) +(defvar *cant-be-in-cache-p* nil) + +;;+++ Is this ever a kludge or what! +(defvar *inhibit-alignment-in-memory-read* nil) + +(eval-when (compile load eval) +(defun check-temporaries-1 (lives temps) + (let ((shared (intersection lives temps + :test #'(lambda (r1 r2) + (eql (register-asmname (find-register r1)) + (register-asmname (find-register r2))))))) + (when shared + (compiler:warn "The following registers are used as both live ~ + registers and temps in ~A:~%~A" + *function-being-processed* shared))) + (when *memoized-vmdata* + (stack-let ((sc-memos (list *memoized-vmdata* *memoized-vmtags* + *memoized-base* *memoized-limit*)) + (memos (list *memoized-vmdata* *memoized-vmtags*)) + (regs (append lives temps))) + (let ((shared (intersection (if *cant-be-in-cache-p* memos sc-memos) regs + :test #'(lambda (r1 r2) + (eql (register-asmname (find-register r1)) + (register-asmname (find-register r2))))))) + (when shared + (compiler:warn "The following memoized registers are being reused in ~A:~%~A" + *function-being-processed* shared)))))) +) ;eval-when + +(defmacro branch-true (r label &optional comment) + `((BNE ,r ,label ,@(if comment `(,comment))))) + +(defmacro branch-false (r label &optional comment) + `((BEQ ,r ,label ,@(if comment `(,comment))))) + +(defmacro force-alignment () + `((label ,(gensym)))) + + +;;; This macro assumes that the PC is a halfword address where the lsbit +;;; is 1 for odd, 0 for even. +;;; If you are using this, chances are you want to just jump to either +;;; InterpretInstructionForJump or InterpretInstructionForBranch... +#+old-cache-hash +(defmacro PC-TO-iCACHEENT (address cpos temp temp2) + (check-temporaries (address cpos) (temp temp2)) + `((comment "Convert a halfword address into a CP pointer.") + ;; In the case where the cache line mask is 16 or fewer bits, this + ;; will expand to an LDA... + (load-constant ,temp ,(eval |cacheline$K-mask|)) + (LDQ ,temp2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (AND ,address ,temp ,cpos) + ;; Knowing that cachelinesize is 48 bytes 3<<4 + (SLL ,cpos 5 ,temp "temp=cpos*32") + (SLL ,cpos 4 ,cpos "cpos=cpos*16") + (ADDQ ,temp2 ,temp ,temp2 "temp2=base+cpos*32") + (ADDQ ,temp2 ,cpos ,cpos "cpos=base+cpos*48"))) + +;;; New version tries to use some of the higher order bits in order to +;;; get better distribution through the instruction cache +#-old-cache-hash +(defmacro PC-TO-iCACHEENT (address cpos temp temp2) + (check-temporaries (address cpos) (temp temp2)) + `((comment "Convert a halfword address into a CP pointer.") + ;; In the case where the cache line mask is 16 or fewer bits, this + ;; will expand to an LDA... + (SRL ,address |CacheLineRShift| ,cpos "Get third byte into bottom") + (LDQ ,temp2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (load-constant ,temp ,(eval |cacheline$K-mask|)) + (SLL ,cpos |CacheLineLShift| ,cpos "Now third byte is zero-shifted") + (ADDQ ,address ,cpos ,cpos) + (AND ,cpos ,temp ,cpos) + ;; Knowing that cachelinesize is 48 bytes 3<<4 + (SLL ,cpos 5 ,temp "temp=cpos*32") + (SLL ,cpos 4 ,cpos "cpos=cpos*16") + (ADDQ ,temp2 ,temp ,temp2 "temp2=base+cpos*32") + (ADDQ ,temp2 ,cpos ,cpos "cpos=base+cpos*48"))) + +;;; The next two macros deal with translating between halfword addresses and PC's +(defmacro convert-pc-to-continuation (apc ctag cdata &optional ignore) + (declare (ignore ignore)) + (check-temporaries (apc) (ctag cdata)) + `((comment "Convert PC to a real continuation.") + (AND ,apc 1 ,ctag) + (SRL ,apc 1 ,cdata "convert PC to a real word address.") + (LDA ,ctag |TypeEvenPC| (,ctag)))) + +(defmacro convert-continuation-to-pc (ctag cdata apc &optional ignore) + (declare (ignore ignore)) + (check-temporaries (ctag cdata) (apc)) + `((comment "Convert real continuation to PC.") + (AND ,ctag 1 ,apc) + (ADDQ ,cdata ,apc ,apc) + (ADDQ ,cdata ,apc ,apc))) + + +;;; The next two macros deal with converting between stack cache addresses +;;; and vma's. Both of these macros assume that SCA / VMA are stack cache +;;; addresses +(defmacro SCAtoVMA (SCA VMA temp) + (check-temporaries (SCA) (VMA temp)) + `((comment "Convert stack cache address to VMA") + (LDQ ,temp PROCESSORSTATE_STACKCACHEDATA (ivory)) + ,@(if *memoized-base* + `() + `( + (LDQ ,vma PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + )) + (SUBQ ,sca ,temp ,temp "stack cache base relative offset") + (SRL ,temp 3 ,temp "convert byte address to word address") + (ADDQ ,temp ,(or *memoized-base* vma) ,vma "reconstruct VMA"))) + +(defmacro VMAtoSCA (VMA SCA temp) + (check-temporaries (VMA) (SCA temp)) + `((comment "Convert VMA to stack cache address") + ,@(if *memoized-base* + `() + `( + (LDQ ,temp PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + )) + (LDQ ,sca PROCESSORSTATE_STACKCACHEDATA (ivory)) + (SUBQ ,vma ,(or *memoized-base* temp) ,temp "stack cache base relative offset") + (S8ADDQ ,temp ,sca ,sca "reconstruct SCA"))) + + +(defmacro VMAinStackCache (VMA notincache word-offset temp2) + "Branches to NOTINCACHE if out of range, leaves stack-cache word-offset in WORD-OFFSET" + (check-temporaries (VMA) (word-offset temp2)) + (assert (not (eq VMA word-offset)) () "Can't use ~A as ~A" VMA 'word-offset) + `(,@(if (lisp:and *memoized-base* *memoized-limit*) + `() + `( + (LDQ ,word-offset PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the cache") + (LDL ,temp2 PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)") + )) + (SUBQ ,VMA ,(or *memoized-base* word-offset) ,word-offset "Stack cache offset") + (CMPULT ,word-offset ,(or *memoized-limit* temp2) ,temp2 "In range?") + (branch-false ,temp2 ,notincache "J. if not in cache"))) + +(defmacro VMAtoSCAmaybe (VMA SCA notincache temp temp2) + "Either branches to notincache or converts VMA" + (check-temporaries (VMA SCA) (temp temp2)) + `(;; In-line (VMAinStackCache ,VMA ,notincache ,temp ,SCA) for dual-issue + ,@(if (lisp:and *memoized-base* *memoized-limit*) + `() + `( + (LDQ ,temp PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LDL ,sca PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)") + )) + (SUBQ ,vma ,(or *memoized-base* temp) ,temp "Stack cache offset") + (CMPULT ,temp ,(or *memoized-limit* sca) ,temp2 "In range?") + (LDQ ,sca PROCESSORSTATE_STACKCACHEDATA (ivory)) + (branch-false ,temp2 ,notincache "J. if not in cache") + ;; Depends on VMAinStackCache leaving TEMP in a useful state + (S8ADDQ ,temp ,sca ,sca "reconstruct SCA"))) + +;;; These pseud instructions extract parts from a packed Ivory word. In such a word, +;;; the most significantthree bytes are zero, the next byte is TAG, the next 32 bits +;;; are data. Within the interpreter Ivory words are passed around like this. + +(defmacro TagTypeFromLispObj (from to &optional comment) + `((comment "TagType from LispObj.") + (SRL ,from 32 ,to ,@(if comment `(,comment))) + (AND ,to 63 ,to))) + +(defmacro TagCdrFromLispObj (from to &optional comment) + `((comment "TagCdr from LispObj.") + (SRL ,from ,(+ 32 6) ,to ,@(if comment `(,comment))))) + +(defmacro PackedInstructionP (iword temp &optional comment) + (check-temporaries (iword) (temp)) + `((comment "Identifiy a packed instruction type.") + (EXTBL ,iword 4 ,temp "Extract the tag byte") + (AND ,temp #o60 ,temp "Select two bits") + (SUBQ ,temp #o60 ,temp "temp==0 if packed"))) + +;;; These pseudo instructions extract parts from unpacked pieces. A register contains +;;; either a tag in the least significant byte, zeros elsewhere, or a datum in the +;;; least significant longword, zeros elsewhere. + +(defmacro TagType (from to &optional comment) + `((comment "TagType.") + (AND ,from 63 ,to ,@(if comment `(,comment))))) + +(defmacro TagCdr (from to &optional comment) + `((comment "TagCdr.") + (SRL ,from 6 ,to ,@(if comment `(,comment))))) + +(defmacro SetTag (tag data word &optional comment) + (assert (not (eq data word)) () "~A would be smashed before used" data) + `((comment "SetTag.") + (SLL ,tag 32 ,word) + (BIS ,data ,word ,word ,@(if comment `(,comment))))) + +(defmacro CheckDataType (tag type labl temp) + (check-temporaries (tag) (temp)) + `((SUBQ ,tag ,type ,temp) + (AND ,temp #x3F ,temp "Strip CDR code") + (BNE ,temp ,labl))) + +(defmacro CheckAdjacentDataTypes (tag base-type ntypes labl temp) + (check-temporaries (tag) (temp)) + (assert (zerop (mod ntypes (lsh 1 (1- (integer-length ntypes))))) (ntypes) + "NTYPES (~D) must be a power of two." ntypes) + `((SUBQ ,tag ,base-type ,temp) + (AND ,temp ,(logand #x3F (lognot (1- ntypes))) ,temp "Strip CDR code, low bits") + (BNE ,temp ,labl))) + +(defmacro NumericTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch numericexception))) + +(defmacro UnaryNumericTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch unarynumericexception))) + +(defmacro SpareTypeException (tag instruction op condition) + `((prepare-exception ,instruction 0 ,op ,tag) + (prepare-trap 0 ,condition nil) + (external-branch spareexception))) + +(defmacro ListTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch listexception))) + +;; Idea here is that prepare-trap saves the relevant microstate in case +;; we decide we don't have an exception, but rather just have a plain +;; old illegal operand. +(defmacro ArrayTypeException (tag instruction op condition) + `((prepare-exception ,instruction 0 ,op ,tag) + (prepare-trap 0 ,condition nil) + (external-branch arrayexception))) + +(defmacro maybe-icount (r) + (let ((lb (gensym))) + `((comment "Update the instruction count.") + (LDQ ,r PROCESSORSTATE_INSTRUCTION_COUNT (ivory)) + (SUBQ ,r 1 ,r "Decrement the instruction count.") + (BNE ,r ,lb "J. if not reached stop point.") + (BIS zero zero zero "put a breakpoint here to catch stops") + (label ,lb) + (STQ ,r PROCESSORSTATE_INSTRUCTION_COUNT (ivory))))) + +(defmacro maybe-statistics (temp temp2 temp3 temp4 temp5 temp6) + `((LDQ ,temp CACHELINE_CODE (iCP) "The instruction.") + (LDQ ,temp2 PROCESSORSTATE_STATISTICS (ivory) "The usage statistics array") + (load-constant ,temp6 #x1FFF) + (SRL ,temp 4 ,temp3) + (AND ,temp3 ,temp6 ,temp3 "Extract the address") + (S4ADDQ ,temp3 ,temp2 ,temp4 "Compute the index to the usage data for this instn.") + (LDL ,temp5 0 (,temp4) "Get current usage data") + (ADDQ ,temp5 1 ,temp5 "Increment") + (STL ,temp5 0 (,temp4) "Set current usage data"))) + +(defmacro maybe-meter-hit (temp temp2 temp3 temp4 temp5 temp6) + (let ((done (gensym))) + `((LDL ,temp2 PROCESSORSTATE_METERCOUNT (ivory) "The number of remaining tokens.") + (LDQ ,temp PROCESSORSTATE_METERDATABUFF (ivory) "The cache miss meter buffer.") + (LDL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (SUBQ ,temp2 1 ,temp2 "record a cache hit") + (BNE ,temp2 ,done) + ;; Here is we reached the end of our gathering window. + (LDL ,temp5 PROCESSORSTATE_METERMASK (ivory)) + (S4ADDQ ,temp4 ,temp ,temp "position of the current data item") + (LDL ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (ADDQ ,temp4 1 ,temp4) + (AND ,temp4 ,temp5 ,temp4) + (LDL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (SUBQ ,temp6 ,temp5 ,temp3) + (CMOVGT ,temp3 ,temp6 ,temp5) + (STL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (STL ,temp6 0 (,temp) "store the datapoint") + (STL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (STL zero PROCESSORSTATE_METERVALUE (ivory)) + (LDL ,temp2 PROCESSORSTATE_METERFREQ (ivory)) + (label ,done) + (STL ,temp2 PROCESSORSTATE_METERCOUNT (ivory))))) + +(defmacro maybe-meter-miss (temp temp2 temp3 temp4 temp5 temp6) + (let ((done (gensym))) + `((LDL ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (LDL ,temp2 PROCESSORSTATE_METERCOUNT (ivory) "The number of remaining tokens.") + (LDQ ,temp PROCESSORSTATE_METERDATABUFF (ivory) "The cache miss meter buffer.") + ;(SUBQ ,temp2 1 ,temp2 "record a cache miss") + (ADDQ ,temp6 1 ,temp6 "count the miss.") + (LDL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (STL ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (BNE ,temp2 ,done) + ;; Here is we reached the end of our gathering window. + (LDL ,temp5 PROCESSORSTATE_METERMASK (ivory)) + (S4ADDQ ,temp4 ,temp ,temp "position of the current data item") + (ADDQ ,temp4 1 ,temp4) + (AND ,temp4 ,temp5 ,temp4) + (LDL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (SUBQ ,temp6 ,temp5 ,temp3) + (CMOVGT ,temp3 ,temp6 ,temp5) + (STL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (STL ,temp6 0 (,temp) "store the datapoint") + (STL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (STL zero PROCESSORSTATE_METERVALUE (ivory)) + (LDL ,temp2 PROCESSORSTATE_METERFREQ (ivory)) + (label ,done) + (STL ,temp2 PROCESSORSTATE_METERCOUNT (ivory))))) + +#+Genera +(defun show-icache-histogram (&optional pathname (stream *standard-output*)) + (declare (special sct:*vlm-destination*)) + (when (null pathname) + (setq pathname (merge-pathnames "cachedata.lisp" sct:*vlm-destination*))) + (let ((cache-data (with-open-file (s pathname :direction :input) + (read s))) + (sum 0)) + (destructuring-bind ((size max freq) missdata filldata) cache-data + ;; The idea here is to draw a histogram in chunks that are + ;; about as wide as the viewport. We do this because if we + ;; draw the entire histogram in one chunk, it takes forever to + ;; do horizontal scrolling because the underlying window system + ;; spends forever drawing lines. + (fresh-line stream) + (let ((vw (floor (clim:bounding-rectangle-width (clim:window-viewport stream)) 2)) + (x 0) + (p missdata)) + (clim:with-end-of-line-action (stream :allow) + (clim:with-room-for-graphics (stream) + (loop while p doing + (let ((segments nil)) + (dotimes (i vw) + (when (null p) (return)) + (let* ((raw-y (pop p)) + (y (round raw-y 10))) + (setq segments (nconc segments (list x 0 x y))) + (incf sum raw-y) + (incf x))) + (clim:draw-lines* stream segments))))) + (fresh-line stream) + (let* ((avg (float (/ sum size))) + (std (let ((diffs 0)) + (dolist (y missdata) + (incf diffs (* (- y avg) (- y avg)))) + (sqrt (/ diffs size))))) + (format stream "Average is ~D (deviation ~D) fills per ~D cycles" + avg std freq)))))) + +(defmacro maybe-meter-trap (tvi temp temp2) + `((LDQ ,temp PROCESSORSTATE_TRAPMETERDATA (ivory) "pointer to trap data vector") + (LDA ,temp2 ,tvi (zero) "get the vector index") + (S8ADDQ ,temp2 ,temp ,temp) + (LDQ ,temp2 0 (,temp) "get the old value") + (LDA ,temp2 1 ,temp2 "increment it") + (STQ ,temp2 0 (,temp) "and store it back"))) + +(defmacro maybe-trace (temp temp2 temp3 temp4 temp5 temp6 &optional dispatch) + (let ((dotrace (gensym)) + (finishtrace (gensym)) + (noprint (gensym)) + (nowrap (gensym)) + (notrace (gensym))) + `((comment "Trace instructions if requested.") + (LDQ ,temp PROCESSORSTATE_TRACE_HOOK (ivory)) + (BEQ ,temp ,notrace "J. if not tracing.") + (comment "Record an instruction trace entry") + (LDL ,temp2 TRACEDATA_RECORDING_P (,temp)) + (LDQ ,temp3 TRACEDATA_START_PC (,temp)) + (branch-true ,temp2 ,dotrace "Jump if recording is on") + (CMPEQ ,temp3 iPC ,temp3 "Turn recording on if at the start PC") + (STL ,temp3 TRACEDATA_RECORDING_P (,temp)) + (branch-false ,temp3 ,notrace "Jump if not at the start PC") + (label ,dotrace) + (LDQ ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Get address of next trace record ") + (LDQ ,temp3 PROCESSORSTATE_INSTRUCTION_COUNT (ivory)) + (STQ iPC TRACERECORD_EPC (,temp2) "Save current PC") + (STQ ,temp3 TRACERECORD_COUNTER (,temp2) "Save instruction count") + (LDQ ,temp3 0 (iSP)) + (SCAtoVMA iSP ,temp4 ,temp5) + (STQ ,temp3 TRACERECORD_TOS (,temp2) "Save current value of TOS") + (STQ ,temp4 TRACERECORD_SP (,temp2) "Save current SP") + (LDL ,temp3 CACHELINE_OPERAND (iCP)) + (LDQ ,temp4 CACHELINE_CODE (iCP)) + (STL ,temp3 TRACERECORD_OPERAND (,temp2) "Save current instruction's operand") + (STQ ,temp4 TRACERECORD_INSTRUCTION (,temp2) "Save pointer to current instruction code") + (LDQ ,temp4 PROCESSORSTATE_CONTROL (ivory)) ;+++TEMPORARY + (LDQ ,temp5 CACHELINE_INSTRUCTION (iCP)) + (STL zero TRACERECORD_CATCH_BLOCK_P (,temp2) "We don't yet record catch blocks") + (STQ ,temp4 TRACERECORD_CATCH_BLOCK_0 (,temp2) "Save control register") ;+++TEMPORARY + (LDQ ,temp3 PROCESSORSTATE_TVI (ivory)) + (STQ ,temp5 TRACERECORD_INSTRUCTION_DATA (,temp2) "Save full word instruction operand") + (STL ,temp3 TRACERECORD_TRAP_P (,temp2) "Save trap indiciator") + (BEQ ,temp3 ,finishtrace "Jump if didn't trap") + (stack-read-disp iFP #.(* 8 2) ,temp3) + (STQ zero PROCESSORSTATE_TVI (ivory) "Zero flag to avoid false trap entries") + (stack-read-disp iFP #.(* 8 3) ,temp4) + (STQ ,temp3 TRACERECORD_TRAP_DATA_0 (,temp2) "Save trap vector index") + (stack-read-disp iFP #.(* 8 4) ,temp5) + (STQ ,temp4 TRACERECORD_TRAP_DATA_1 (,temp2) "Save fault PC") + (stack-read-disp iFP #.(* 8 5) ,temp6) + (STQ ,temp5 TRACERECORD_TRAP_DATA_2 (,temp2) "Save two additional arguments") + (STQ ,temp6 TRACERECORD_TRAP_DATA_3 (,temp2)) + (label ,finishtrace) + (ADDQ ,temp2 TRACERECORDSIZE ,temp2 "Bump to next trace record") + (LDQ ,temp3 TRACEDATA_RECORDS_START (,temp) "Get pointer to start of trace records") + (STQ ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Set record pointer to keep printer happy") + (LDQ ,temp4 TRACEDATA_RECORDS_END (,temp) "Get pointer to end of trace record") + (LDQ ,temp5 TRACEDATA_PRINTER (,temp) "Function to print trace if non-zero") + (CMPLE ,temp4 ,temp2 ,temp4 "Non-zero iff we're about to wrap the circular buffer") + (CMOVNE ,temp4 ,temp3 ,temp2 "Update next record pointer iff we wrapped") + (CMOVEQ ,temp4 zero ,temp5 "Don't print if we didn't wrap") + (BEQ ,temp5 ,noprint "Jump if we don't need to print") + (with-c-registers (,temp6 arg1 arg2 arg3 arg4 arg5 arg6 ,temp ,temp2 + ,@(if dispatch `(,dispatch))) + (BIS ,temp5 zero pv) + (JSR RA ,temp5 0)) + (BIS zero zero ,temp4 "Claim we didn't wrap") + (label ,noprint) + (STQ ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Save next record pointer") + (BEQ ,temp4 ,nowrap "Jump if we didn't wrap") + (STL ,temp4 TRACEDATA_WRAP_P (,temp) "Set flag indicating that we wrapped") + (label ,nowrap) + (LDQ ,temp2 TRACEDATA_STOP_PC (,temp)) + (CMPEQ ,temp2 iPC ,temp2 "Non-zero if at PC where we should stop tracing") + (CMPEQ ,temp2 0 ,temp2 "Non-zero if not at the PC") + (STL ,temp2 TRACEDATA_RECORDING_P (,temp) "Update recording flag") + (label ,notrace)))) + +;; This means "iPC and iCP have been set up, so execute that instruction". +;; Note the interpretInstruction also checks to see if we have been +;; requested to stop. +(defmacro ContinueToInterpretInstruction (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero interpretinstruction ,@(if comment `(,comment))))) + +;; Use this if you have only set up the PC +(defmacro ContinueToInterpretInstruction-ValidateCache (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero interpretInstructionForBranch ,@(if comment `(,comment))))) + +;; This means "increment the PC by 1 (by picking up iPC and iCP from the +;; current instruction's cache line) and execute that instruction". That +;; is, this is used to continue executing straight-line code, and hence +;; does not check to see if the emulator has been requested to stop. +;; This can often dual issue with previous instruction. +(defmacro ContinueToNextInstruction (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero nextinstruction ,@(if comment `(,comment))))) + +(defmacro GetNextPC () + `((LDQ iPC CACHELINE_NEXTPCDATA (iCP)))) + +(defmacro PrefetchNextPC (temp) + `((LDQ ,temp CACHELINE_NEXTPCDATA (iCP)))) + +(defmacro SetNextPC (temp) + `((BIS ,temp zero iPC))) + +(defmacro GetNextCP () + `((LDQ iCP CACHELINE_NEXTCP (iCP)))) + +(defmacro PrefetchNextCP (temp) + `((LDQ ,temp CACHELINE_NEXTCP (iCP)))) + +(defmacro SetNextCP (temp) + `((BIS ,temp zero iCP))) + +(defmacro GetNextPCandCP () + `((LDQ iPC CACHELINE_NEXTPCDATA (iCP)) + (LDQ iCP CACHELINE_NEXTCP (iCP)))) + +;; Like ContinueToNextInstruction, except that the new iPC and iCP have been +;; set up, which means that we can avoid some stalls in nextInstruction. +(defmacro ContinueToNextInstruction-NoStall (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero cacheValid ,@(if comment `(,comment))))) + +(defmacro instruction-exception (&optional comment) + `((external-branch exception ,@(if comment `(,comment))))) + +(defmacro arithmetic-exception (&optional comment) + `((external-branch exception ,@(if comment `(,comment))))) + +;; Condition to microstate computation now handled in prepare-trap +(defmacro illegal-operand (condition &optional vma comment) + `((prepare-trap 0 ,condition ,vma) + (external-branch illegaloperand ,@(if comment `(,comment))))) + +(defmacro illegal-instruction (&optional comment) + `((external-branch illegalinstruction ,@(if comment `(,comment))))) + +(defmacro halt-machine (&optional (reason 'HaltReasonHalted) comment) + (ecase reason + (HaltReasonHalted + `((external-branch haltmachine ,@(if comment `(,comment))))) + (HaltReasonFatalStackOverflow + `((external-branch fatalstackoverflow ,@(if comment `(,comment))))) + (HaltReasonIllegalTrapVector + `((external-branch illegaltrapvector ,@(if comment `(,comment))))))) + + +;;; Macros for predicate support. + +;;; If the body can trap, be sure to supply :CAN-TRAP T, otherwise iPC and +;;; iCP will get clobbered prematurely and the trap handler will lose! +(defmacro with-predicate-store ((ttag niltag fall-into t1 t2 &key can-trap) + &body body) + (let* ((prelude `(,(if fall-into `(get-t ,t1) `(get-nil ,t2)) + (force-alignment) ; if in same word separate! + ,(if fall-into `(get-nil ,t2) `(get-t ,t1)) + ,@(unless can-trap `((GetNextPCandCP))))) + (tclause `((label ,ttag "Here to push T") + (STQ ,t1 0 (iSP)) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall)))) + (nilclause `((comment "here to push NIL") + (label ,niltag) + (STQ ,t2 0 (iSP)) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall))))) + (if fall-into + (append prelude `(,@body) tclause nilclause) + (append prelude `(,@body) nilclause tclause)))) + +;;; We now increment iSP *before* the body, so if body uses iSP *BEWARE*! +;;; If the body can trap, be sure to supply :CAN-TRAP T, otherwise iPC and +;;; iCP will get clobbered prematurely and the trap handler will lose! +(defmacro with-predicate-push ((ttag niltag fall-into t1 t2 &key can-trap) + &body body) + (let* ((prelude `((force-alignment) + ,(if fall-into `(get-t ,t1) `(get-nil ,t2)) + (force-alignment) + ,(if fall-into `(get-nil ,t2) `(get-t ,t1)) + ,@(unless can-trap `((GetNextPCandCP))))) + (tclause `((label ,ttag "Here to push T") + (STQ ,t1 8 (iSP)) + (ADDQ iSP 8 iSP) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall)))) + (nilclause `((comment "here to push NIL") + (label ,niltag) + (STQ ,t2 8 (iSP)) + (ADDQ iSP 8 iSP) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall))))) + (if fall-into + (append prelude `(,@body) tclause nilclause) + (append prelude `(,@body) nilclause tclause)))) + + + +(defmacro align4k () + `((passthru ,(format nil ".align ~D" 12)) #|| 2^ 12 = 4096 ||#)) + +;;; This will get us to the end of the current 4k chunk (which must be the second 4K +;;; chunk of the page. Then two 4k chunks are skipped. + +(defmacro align4Kskip8K () + `((align4k) ; skip to end of current 4k chunk + (AND zero zero zero) + (align4k) ; skip a half page + (AND zero zero zero) + (align4k))) ; skip another half page + +(defmacro align4kskip4k () + `((align4k) ; skip to end of current 4k chunk + (AND zero zero zero) + (align4k))) + +(defmacro define-instruction (name format (&rest options) &body body &environment env) + #+Genera (declare (zwei:indentation . indent-define-procedure)) + (let ((*function-being-processed* name)) + `((start ,name) + ,@(apply #'expand-instruction-procedure-header format name options) + ,@(collecting-function-epilogue body env) + #---ignore ,@(apply #'expand-instruction-procedure-trailer format name options) + #+++ignore (end ,name ,format)))) + +(clos:defgeneric expand-instruction-procedure-header (format name &key &allow-other-keys)) +(clos:defgeneric expand-instruction-procedure-trailer (format name &key &allow-other-keys)) + +;;; A :full-word-instruction has a single entry point defined to be 'name' +;;; No default unpacking is necessary. All information about the instruction +;;; is available via iCP and iPC. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :full-word-instruction)) name &key) + `((comment ,(format nil "Fullword instruction - ~a" name)) + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x80")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" name)))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :full-word-instruction)) name &key) + `((end ,name) + (comment ,(format nil "End of Fullword instruction - ~a" name)))) + + +;;; A :operand-from-stack has four entrypoints, FP LP SP and IM, IM is an +;;; error case, the other cases generate operand loading code and then fall +;;; into the body. The operand obtained is left in 'arg1'. +;;; the SP pop mode falls into the body. This mode needs to be +;;; watched carefully since the arg2 is left with a pointer beyond the top +;;; of the stack. The operand value must be read before the stack is pushed +;;; or it will be overwritten. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack)) name + &key own-immediate needs-tos + provide-immediate signed-immediate) + (assert (not (lisp:and own-immediate provide-immediate)) () "Huh?") + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (comment "arg2 has the preloaded 8 bit operand.") + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + + ,@(when provide-immediate + `((comment "arg2 has the preloaded 8 bit operand.") + (passthru "#ifdef TRACING") + ,@(if signed-immediate + `((passthru ,(format nil " .byte 0x83"))) + `((passthru ,(format nil " .byte 0x82")))) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + ,@(if signed-immediate + `((comment "This sequence only sucks a moderate amount") + ;; Careful! We are using arg1 as a temp so we can + ;; clear arg2 in the stall slot + (SLL arg2 #.(- 64 8) arg1 "sign extend the byte argument.") + (BIS zero zero arg2) + (SRA arg1 #.(- 64 8) arg1 "Rest of sign extension") + (STL arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDA arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory))) + `((comment "This sequence is lukewarm") + (STL arg2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDA arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BIS zero zero arg2))) + (BR zero ,bodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciiz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (BIS arg5 zero arg1 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((BNE arg2 ,bodyname) + (LDQ arg6 0 (arg4) "SP-pop, Reload TOS") + (BIS iSP zero arg1 "SP-pop mode") + (BIS arg4 zero iSP "Adjust SP")) + `((CMOVEQ arg2 iSP arg1 "SP-pop mode") + (CMOVEQ arg2 arg4 iSP "Adjust SP if SP-pop mode"))) + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciiz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciiz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (comment "arg1 has the operand address.") + (S8ADDQ arg2 arg1 arg1 "Compute operand address") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack)) name &key own-immediate provide-immediate) + (let ((imname (format nil "~aIM" name))) + `(;; put this here for lack of a better spot + ,@(unless (or own-immediate provide-immediate) + `((passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (unlikely-label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (external-branch |DoIStageError| ,(format nil "IMMEDIATE mode not legal in ~a." + name)))) + (end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name))))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack-immediate)) name &key own-immediate needs-tos) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "head~a" name)) + (realbodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (comment "arg2 has the preloaded 8 bit operand.") + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + ,@(unless own-immediate + `((passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (comment "This sequence is lukewarm") + (STL arg2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDQ arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BR zero ,realbodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciiz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (BIS arg5 zero arg1 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((BNE arg2 ,bodyname) + (BIS arg6 zero arg1 "SP-pop mode, TOS->arg1") + (LDQ arg6 0 (arg4) "Reload TOS") + (BIS arg4 zero iSP "Adjust SP") + (BR zero ,realbodyname)) + `((CMOVEQ arg2 iSP arg1 "SP-pop mode") + (CMOVEQ arg2 arg4 iSP "Adjust SP if SP-pop mode"))) + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciiz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciiz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (S8ADDQ arg2 arg1 arg1 "Compute operand address") + (LDQ arg1 0 (arg1) "Get the operand") + (label ,realbodyname) + (comment "arg1 has the operand, not sign extended if immediate.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +(defmacro immediate-handler (name) + (let ((imname (format nil "~aIM" name))) + `((passthru "#ifdef TRACING") + (BR zero ,imname) + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciiz \"~aIM\"" name)) + (passthru "#endif") + (passthru ,(format nil ".align ~D" *function-alignment*)) + (label ,imname "Entry point for IMMEDIATE mode")))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack-signed-immediate)) name &key own-immediate needs-tos) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "head~a" name)) + (realbodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + ,@(unless own-immediate + `((comment "arg2 has the preloaded 8 bit operand.") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x83")) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (comment "This sequence only sucks a moderate amount") + (SLL arg2 #.(- 64 8) arg2 "sign extend the byte argument.") + (force-alignment) + (SRA arg2 #.(- 64 8) arg2 "Rest of sign extension") + (STL arg2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDQ arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BR zero ,realbodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciiz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (BIS arg5 zero arg1 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((BNE arg2 ,bodyname) + (BIS arg6 zero arg1 "SP-pop mode, TOS->arg1") + (LDQ arg6 0 (arg4) "Reload TOS") + (BIS arg4 zero iSP "Adjust SP") + (BR zero ,realbodyname)) + `((CMOVEQ arg2 iSP arg1 "SP-pop mode") + (CMOVEQ arg2 arg4 iSP "Adjust SP if SP-pop mode"))) + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciiz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciiz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (S8ADDQ arg2 arg1 arg1 "Compute operand address") + (LDQ arg1 0 (arg1) "Get the operand") + (label ,realbodyname) + (comment "arg1 has the operand, sign extended if immediate.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack-signed-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :10-bit-immediate)) name &key own-immediate needs-tos) + (declare (ignore needs-tos)) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Halfword 10 bit immediate instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA0")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + ,@(unless own-immediate + `((EXTWL arg3 4 arg1))) + (comment "arg1 has operand preloaded.") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :10-bit-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :10-bit-signed-immediate)) name &key own-immediate needs-tos) + (declare (ignore needs-tos)) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Halfword 10 bit immediate instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA1")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + ,@(unless own-immediate + `((SRA arg3 48 arg1))) + (comment "arg1 has signed operand preloaded.") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :10-bit-signed-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + +;;; 10 bit operand encoded position= ls 5 bits size=ms5 bits. +;;; 10 bit operand is in arg1, truncated 8 bit is in arg2 +;;; shift arg1 right by 5 bits to give 'size-1' +;;; mask arg2 by #x1F to give position. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :field-extraction)) name &key) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Field Extraction instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA0")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + (SRL arg3 #.(+ 32 5) arg1 "Shift the 'size-1' bits into place") + (AND arg2 #x1F arg2 "mask out the unwanted bits in arg2") + (AND arg1 #x1F arg1 "mask out the unwanted bits in arg1") + (comment "arg1 has size-1, arg2 has position.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :field-extraction)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +;;; AH! this is a fun one +;;; This instruction type is actually a fullword in disguise! It therefore +;;; is always on an even instruction boundary! +;;; upon entry, arg2 already has the number of required args. +;;; arg1 has the 10 bit immediate, of which two bits are the ptr field. +;;; we'll shift them into place. We must load the instruction from the cache +;;; to get at the rest of the bits. +;;; we lose two cycles to stalling, and we get no dual. We may want to +;;; pull out the last two instructions and hand position them. Especially as +;;; there are very few of these instructions. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :entry-instruction)) name &key) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Field Extraction instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xB0")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + (get-control-register arg5 "The control register") + (SRL arg3 18 arg4 "Pull down the number of optionals") + (EXTBL arg3 5 arg1 "Extract the 'ptr' field while we are waiting") + (AND arg4 #xFF arg4) + (comment "arg1=ptr field, arg2=required, arg3=instn, arg4=optionals arg5=control-register")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :entry-instruction)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + + +(defmacro UnimplementedInstruction () + `((comment "This instruction has not been written yet.") + (illegal-operand i-stage-error))) + +;;; Section Conditional macros. + +;;; because the dispatch table for all types is large and prohibitive for +;;; repeating over many instructions, we will attempt to dispatch sequentially. +;;; It is imperative that the order be chosen very carefully! +;;; 1 cycle + 3 cycles per clause until match. +;;; so match on the first clause costs 4 cycles + body of clause +;;; match on second clause costs 7 cycles + body of clause etc. + +(defun last-instruction-is-branch-p (body) + (loop named branchp for clause in (reverse body) do + (loop for instruction = clause then (car instruction) do + (when (atom instruction) + (cond ((member instruction '(label unlikely-label comment)) + (return nil)) + ((member instruction '(BR external-branch)) + (return-from branchp t)) + (t + (return-from branchp nil))))))) + +;;; deals with tags of up to 8 bits only +(defmacro basic-dispatch (t1 t2 &body clauses &environment env) + (let* ((expanded ()) + (end-label (gensym)) + (else-label (assoc :else-label clauses)) + (fall-through nil) + ) + (when else-label + (setq clauses (remove else-label clauses) + else-label (second else-label))) + (loop for rest-label = nil then label + as label = (gensym) + for (clause . rest) on clauses do ;dolist (clause clauses) + (when (null rest) + (if else-label + (setq label else-label) + (setq label end-label))) + (destructuring-bind (key &rest body) clause + (let* ((body (if (lisp:and (atom (car body)) (null (cdr body))) + (car body) + (macroexpand-asm-form body env))) + (dont-emit-branch + (cond + ;; An atom for a clause body means the clause's body + ;; is implemented by branching to that atom (as a + ;; label) + ((atom body) t) + ;; On the first clause, we never emit a branch. If + ;; the clause does not end in a branch, we arrange + ;; for it to "fall-through" to the end-label by + ;; moving the other clauses out of line. If it does + ;; end in a branch, we don't move the other clauses + ;; out of line, but we still don't need to emit a + ;; branch + ((null rest-label) + (setq fall-through (not (last-instruction-is-branch-p body))) + t) + ;; On the last clause, we emit a branch if it doesn't + ;; end in one and the first clause is going to fall + ;; through (otherwise the last clause does) + ((null rest) + (or (null fall-through) + (last-instruction-is-branch-p body))) + ;; Otherwise, we emit a branch if the clause does not supply it's own + (t (last-instruction-is-branch-p body))))) + (cond ((member key '(:else :otherwise 'else 'otherwise)) + (assert (null rest) () "Else clause not last in dispatch") + (push + `(,@(when rest-label + `((label ,rest-label))) + (comment ,(format nil "Here for all other cases")) + ,@body + ,@(unless dont-emit-branch + `((BR zero ,end-label)))) + expanded)) + ((listp key) + (let ((matchlabel (gensym))) + (push + `(,@(when rest-label + `((label ,rest-label))) + ,@(loop for (cl . rest) on key + collect + (if (lisp:and (integerp cl) (zerop cl)) + `(,@(if (null rest) + `((BNE ,t1 ,label)) + `((BEQ ,t1 ,matchlabel)))) + `((CMPEQ ,t1 ,cl ,t2) + ;; Can't di with SUBQ, so align to possibly + ;; di with first instruction of body + (force-alignment) + ,@(if (null rest) + `((branch-false ,t2 ,label)) + `((branch-true ,t2 ,matchlabel)))))) + (label ,matchlabel) + (comment ,(format nil "Here if argument ~a" key)) + ,@body + ,@(unless dont-emit-branch + `((BR zero ,end-label)))) + expanded))) + (t + (push + `(,@(when rest-label + `((label ,rest-label))) + ,(if (lisp:and (integerp key) (zerop key)) + (cond ((null body) + `(BEQ ,t1 ,end-label)) + ((atom body) + `(BEQ ,t1 ,body)) + (t + `(BNE ,t1 ,label))) + `((CMPEQ ,t1 ,key ,t2) + ;; Can't di with SUBQ, so align to possibly + ;; di with first instruction of body + (force-alignment) + ,(cond ((null body) + `(branch-true ,t2 ,end-label)) + ((atom body) + `(branch-true ,t2 ,body)) + (t + `(branch-false ,t2 ,label))))) + ,@(if (atom body) + ;; When last dispatch would fall-though on no + ;; match, have to create an else clause + (when (null rest) + `((BR zero ,label))) + `(((comment ,(format nil "Here if argument ~a" key)) + ,@body + ,@(unless dont-emit-branch + `((BR zero ,end-label))))))) + expanded)))))) + (setq expanded (nreverse expanded)) + (if fall-through + (let ((first (pop expanded))) + (when expanded + (push (apply #'nconc expanded) + *function-epilogue*)) + `(,first + (label ,end-label))) + `(,@(apply #'nconc expanded) + (label ,end-label))))) + +;;; deals with tags of up to 16 bits only +(defmacro mondo-dispatch (t1 t2 &body clauses) + (let* ((expanded ()) + (nlabels (let ((n 0)) + (dolist (clause clauses) + (if (listp (car clause)) + (incf n (length (car clause))) + (incf n 1))) + n)) + (end-label (gensym)) + (i 0) + (label (gensym))) + (dolist (clause clauses) + (cond ((member (car clause) '(:else :otherwise 'else 'otherwise)) + (push + `((comment ,(format nil "Here for all other cases")) + ,@(cdr clause) + ,@(unless (= i nlabels) `((BR zero ,end-label))) + (label ,label)) + expanded)) + ((listp (car clause)) ;+++ this generates more code than it should + (dolist (cl (car clause)) + (push + `((LDA ,t2 ,cl (zero)) + (SUBQ ,t1 ,t2 ,t2) + (BNE ,t2 ,label) + (comment ,(format nil "Here if argument ~a" cl)) + ,@(cdr clause) + ,@(unless (= i nlabels) `((BR zero ,end-label))) + (label ,label)) + expanded) + (incf i) + (setq label (gensym)))) + (t + (push + `((LDA ,t2 ,(car clause) (zero)) + (SUBQ ,t1 ,t2 ,t2) + (BNE ,t2 ,label) + (comment ,(format nil "Here if argument ~a" (car clause))) + ,@(cdr clause) + ,@(unless (= i nlabels) `((BR zero ,end-label))) + (label ,label)) + expanded))) + (incf i) + (setq label (gensym))) + `(,@(apply #'nconc (nreverse expanded)) + (label ,end-label)))) + +(defmacro cdr-code-dispatch (tagreg t1 t2 &body clauses) + (check-temporaries (tagreg) (t1 t2)) + `((AND ,tagreg #b11000000 ,t1 "Extract CDR code.") + (basic-dispatch ,t1 ,t2 ,@(sublis `((|CdrNext| . ,(lsh |cdr|$k-|next| 6)) + (|CdrNormal| . ,(lsh |cdr|$k-|normal| 6)) + (|CdrNil| . ,(lsh |cdr|$k-|nil| 6)) + (3 . ,(lsh 3 6))) + clauses)))) + +(defmacro register-dispatch (tagreg t1 t2 &body clauses) + (check-temporaries (tagreg) (t1 t2)) + `(mondo-dispatch ,tagreg ,t2 ,@clauses)) + +(defmacro type-dispatch (tagreg t1 t2 &body clauses) + (check-temporaries (tagreg) (t1 t2)) + `((AND ,tagreg #x3F ,t1 "Strip off any CDR code bits.") + (basic-dispatch ,t1 ,t2 ,@clauses))) + + +(defmacro binary-type-dispatch ((tag1 tag2 tag1-stripped t2 tag2-stripped t4) &body clauses) + (check-temporaries (tag1 tag2) (tag1-stripped t2 tag2-stripped t4)) + "Clauses are ((type1 type2) . body) or (:else1 . body), (:else2 . + body), or (:else . body)" + (let ((subclause-alist ()) + (inner-dispatches ()) + (elseclause nil) + (else1clause nil) + (else2clause nil) + (eclabel (gensym)) + (ec1label (gensym)) + (ec2label (gensym)) + (done (gensym))) + ;; For each clause, sort into first type, subclauses + ;; Next make a nested type-dispatch + (dolist (cl clauses) + (cond ((eq (car cl) :else1) + (setq else1clause `((label ,ec1label) ,@(cdr cl)))) + ((eq (car cl) :else2) + (setq else2clause `((label ,ec2label) ,@(cdr cl)))) + ((eq (car cl) :else) + (setq elseclause `((label ,eclabel) ,@(cdr cl)))) + (t (let ((scl (assoc (caar cl) subclause-alist))) + (if scl + (setf (cdr scl) (cons `(,(cadar cl) ,@(cdr cl)) (cdr scl))) + (push `(,(caar cl) (,(cadar cl) ,@(cdr cl))) subclause-alist)))))) + (assert (not (lisp:and elseclause (or else1clause else2clause))) () + "Can't have :else and :else") + (assert (or elseclause (lisp:and else1clause else2clause)) () + "Must supply both :else1 and :else2") + ;; Add else clauses to the embedded dispatches if required + (cond (else2clause + (dolist (cl subclause-alist) + (push `(:else-label ,ec2label) (cdr cl)))) + (elseclause + (dolist (cl subclause-alist) + (push `(:else-label ,eclabel) (cdr cl))))) + ;; All clauses have been organized, now construct the inner type-dispatches + ;; Clauses are reversed in alist entries. + (dolist (cl subclause-alist) + (push `(,(car cl) + ;; Cdr stripped in top-level + (basic-dispatch ,tag2-stripped ,t4 ,@(nreverse (cdr cl)))) inner-dispatches)) + + ;; Finally emit the outer dispatch! + `(;; Touch the tags in 1/2 order, as callee might expect + (AND ,tag1 #x3F ,tag1-stripped "Strip off any CDR code bits.") + (AND ,tag2 #x3F ,tag2-stripped "Strip off any CDR code bits.") + (basic-dispatch ,tag1-stripped ,t2 + ,@inner-dispatches + (:else + ,@elseclause + ,@else1clause + ,@(when else2clause + `((BR zero ,done) + ,@else2clause + (label ,done)))))))) + +;;; State Saving and restoring, register definitions. + +;;; Macros to save and restore the cached state of the machine in the ivory object. + +(defmacro cache-ivory-state () + `((LDQ iCP PROCESSORSTATE_CP (ivory)) + (LDQ iPC PROCESSORSTATE_EPC (ivory)) + (LDQ iSP PROCESSORSTATE_SP (ivory)) + (LDQ iFP PROCESSORSTATE_FP (ivory)) + (LDQ iLP PROCESSORSTATE_LP (ivory)))) + +(defmacro decache-ivory-state () + `((STQ iCP PROCESSORSTATE_CP (ivory)) + (STQ iPC PROCESSORSTATE_EPC (ivory)) + (STQ iSP PROCESSORSTATE_SP (ivory)) + (STQ iFP PROCESSORSTATE_FP (ivory)) + (STQ iLP PROCESSORSTATE_LP (ivory)))) + +(eval-when (compile load eval) +;;; Register definitions. +(define-integer-register t1 1) +(define-integer-register t2 2) +(define-integer-register t3 3) +(define-integer-register t4 4) +(define-integer-register t5 5) +(define-integer-register t6 6) +(define-integer-register t7 7) +(define-integer-register t8 8) +(define-integer-register iPC 9) +(define-integer-register iFP 10) +(define-integer-register iLP 11) +(define-integer-register iSP 12) +(define-integer-register iCP 13) +(define-integer-register ivory 14) ; ivory processor object +(define-integer-register arg1 16) +(define-integer-register arg2 17) +(define-integer-register arg3 18) +(define-integer-register arg4 19) +(define-integer-register arg5 20) +(define-integer-register arg6 21) +(define-integer-register t9 22) +(define-integer-register t10 23) +(define-integer-register t11 24) +(define-integer-register t12 25) +(define-integer-register ra r26) +(define-integer-register pv r27) +(define-integer-register gp r29) +(define-integer-register sp r30) + +(define-integer-register none 31) +(define-integer-register instn 1) ; = T1 +(define-integer-register iword 2) ; = T2 +(define-integer-register ecp 3) ; = T3 +(define-integer-register ocp 4) ; = T4 +(define-integer-register icsize 5) ; = T5 (icache size in bytes) +(define-integer-register epc 6) ; = T6 +(define-integer-register opc 7) ; = T7 +(define-integer-register count 8) ; = T8 +(define-integer-register hwopmask 20) ; = ARG5 (the halfword operand mask) +(define-integer-register fwdispatch 21) ; = ARG6 (the fullword dispatch table) +(define-integer-register hwdispatch 22) ; = T9 (the halfword dispatch table) +) diff --git a/alpha-emulator/kludges.s b/alpha-emulator/kludges.s new file mode 100644 index 0000000..9d7e41b --- /dev/null +++ b/alpha-emulator/kludges.s @@ -0,0 +1,2 @@ +TWOCACHELINESIZE = CACHELINESIZE+CACHELINESIZE +FOURCACHELINESIZE = TWOCACHELINESIZE+TWOCACHELINESIZE diff --git a/alpha-emulator/memoryem.lisp b/alpha-emulator/memoryem.lisp new file mode 100644 index 0000000..7aa12f2 --- /dev/null +++ b/alpha-emulator/memoryem.lisp @@ -0,0 +1,843 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; This file implements the memory operations. These are responsible +;;; for ensuring that proper traps are taken, and forwarding pointers +;;; etc, are done. + +;;;; Memory actions, stolen from ISOFT:EMULATOR;DEFS, used to compute +;;;; constant masks and action tables + +(defconstant %memory-action-indirect 1) +(defconstant %memory-action-monitor-trap 2) +(defconstant %memory-action-transport 4) +(defconstant %memory-action-trap 10) +(defconstant %memory-action-transform 20) +(defconstant %memory-action-binding-trap 40) + +;;; Instead of making *memory-actions* a 2d array, we use this indexing scheme. +(defsubst memory-action-index (data-type cycle-type) + (dpb cycle-type (byte 4 6) data-type)) + +(defvar *memory-actions* (make-array 2000 :element-type '(unsigned-byte 8))) + +(defparameter *memory-actions-table* + ;; DATA NULL HEAD HFWD EFWD 1FWD EVCP GC MON PTR BL LV + `((,sys:%memory-data-read + () trap trap ind ind ind ind trap mtrap trans btrap xfrm ) + (,sys:%memory-data-write + () () trap ind ind ind ind trap mtrap () btrap () ) + (,sys:%memory-bind-read + () () trap ind ind ind () trap mtrap trans () () ) + (,sys:%memory-bind-write + () () trap ind ind ind () trap mtrap () () () ) + (,sys:%memory-bind-read-no-monitor + () () trap ind ind ind () trap ind trans () () ) + (,sys:%memory-bind-write-no-monitor + () () trap ind ind ind () trap ind () () () ) + (,sys:%memory-header + trap trap () ind trap trap trap trap trap trans trap trap ) + (,sys:%memory-structure-offset + () () () ind () () () trap () () () () ) + (,sys:%memory-scavenge + () () () () () () () trap () trans () () ) + (,sys:%memory-cdr + () () trap ind ind () () trap () () () () ) + (,sys:%memory-gc-copy + () () () () () () () trap () () () () ) + (,sys:%memory-raw + () () () () () () () () () () () () ) + (,sys:%memory-raw-translate + () () () () () () () () () () () xfrm ))) + +(defun initialize-memory-actions () + (let ((pointer-data-types + (list + sys:dtp-double-float sys:dtp-bignum sys:dtp-big-ratio + sys:dtp-complex sys:dtp-spare-number sys:dtp-instance + sys:dtp-list-instance sys:dtp-array-instance + sys:dtp-string-instance sys:dtp-nil sys:dtp-list + sys:dtp-array sys:dtp-string sys:dtp-symbol + sys:dtp-locative sys:dtp-lexical-closure + sys:dtp-dynamic-closure sys:dtp-compiled-function + sys:dtp-generic-function sys:dtp-spare-pointer-1 + sys:dtp-spare-pointer-2 sys:dtp-bound-location + sys:dtp-logic-variable sys:dtp-even-pc sys:dtp-odd-pc + sys:dtp-call-compiled-even sys:dtp-call-compiled-odd + sys:dtp-call-indirect sys:dtp-call-generic + sys:dtp-call-compiled-even-prefetch + sys:dtp-call-compiled-odd-prefetch + sys:dtp-call-indirect-prefetch + sys:dtp-call-generic-prefetch)) + (immediate-data-types + (list + sys:dtp-fixnum sys:dtp-small-ratio + sys:dtp-single-float sys:dtp-physical-address + sys:dtp-spare-immediate-1 sys:dtp-character + sys:dtp-packed-instruction-60 + sys:dtp-packed-instruction-61 sys:dtp-packed-instruction-62 + sys:dtp-packed-instruction-63 sys:dtp-packed-instruction-64 sys:dtp-packed-instruction-65 + sys:dtp-packed-instruction-66 sys:dtp-packed-instruction-67 sys:dtp-packed-instruction-70 + sys:dtp-packed-instruction-71 sys:dtp-packed-instruction-72 sys:dtp-packed-instruction-73 + sys:dtp-packed-instruction-74 sys:dtp-packed-instruction-75 sys:dtp-packed-instruction-76 + sys:dtp-packed-instruction-77))) + (fill *memory-actions* 0) + (loop for cycle-actions in *memory-actions-table* do + (destructuring-bind (cycle-type data null head hfwd efwd 1fwd evcp gc mon ptr bl lv) + cycle-actions + (labels ((translate-symbolic-action (symbol) + (ecase symbol + ((nil) 0) + (ind (logior %memory-action-indirect %memory-action-transport)) + (trans %memory-action-transport) + (trap %memory-action-trap) + (mtrap (logior %memory-action-monitor-trap %memory-action-transport)) + (xfrm %memory-action-transform) + (btrap (logior %memory-action-binding-trap %memory-action-transport)))) + (initialize-cycle (action &rest type-specs) + (dolist (type-spec type-specs) + (typecase type-spec + (symbol + (let ((index + (memory-action-index (symbol-value type-spec) cycle-type))) + (setf (aref *memory-actions* index) + (logior + (aref *memory-actions* index) + (translate-symbolic-action action))))) + (fixnum + (let ((index (memory-action-index type-spec cycle-type))) + (setf (aref *memory-actions* index) + (logior + (aref *memory-actions* index) + (translate-symbolic-action action))))) + (list + (dolist (type type-spec) + (initialize-cycle action type))))))) + (initialize-cycle data immediate-data-types pointer-data-types) + (initialize-cycle null sys:dtp-null) + (initialize-cycle head sys:dtp-header-i sys:dtp-header-p) + (initialize-cycle hfwd sys:dtp-header-forward) + (initialize-cycle efwd sys:dtp-element-forward) + (initialize-cycle 1fwd sys:dtp-one-q-forward) + (initialize-cycle evcp sys:dtp-external-value-cell-pointer) + (initialize-cycle gc sys:dtp-gc-forward) + (initialize-cycle mon sys:dtp-monitor-forward) + (initialize-cycle ptr + pointer-data-types + sys:dtp-null + sys:dtp-header-p + sys:dtp-header-forward + sys:dtp-element-forward + sys:dtp-one-q-forward + sys:dtp-external-value-cell-pointer + sys:dtp-monitor-forward) + (initialize-cycle bl sys:dtp-bound-location) + (initialize-cycle lv sys:dtp-logic-variable)))))) +(initialize-memory-actions) + +(defsubst memory-action-entry (data-type cycle-type) + (aref *memory-actions* (memory-action-index data-type cycle-type))) + +(defun memory-indirect-mask (cycle-type) + (loop with mask = 0 for data-type below 64 + when (not (zerop + (logand + (memory-action-entry data-type cycle-type) + %memory-action-indirect))) + do (setq mask (logior mask (ash 1 data-type))) + finally (if (logbitp 63 mask) + (return (dpb mask (byte 64 0) -1)) + (return mask)))) + +(defun memory-action-mask (cycle-type) + (loop with mask = 0 for data-type below 64 + when (not (zerop + (logandc2 + (memory-action-entry data-type cycle-type) + %memory-action-transport))) + do (setq mask (logior mask (ash 1 data-type))) + finally (if (logbitp 63 mask) + (return (dpb mask (byte 64 0) -1)) + (return mask)))) + +;; Fault handling +(defmacro decode-fault (vma) + `((STQ ,vma PROCESSORSTATE_VMA (ivory) "stash the VMA") + (external-branch |DECODEFAULT| "Go figure"))) + +(defmacro transport-trap () + `((external-branch |TRANSPORTTRAP|))) + +(defmacro miss-fault () + `((external-branch |PAGENOTRESIDENT|))) + +(defmacro access-fault () + `((external-branch |PAGEFAULTREQUESTHANDLER|))) + +(defmacro write-fault () + `((external-branch |PAGEWRITEFAULT|))) + +(defmacro memory-action (mat cycle-number) + `((comment "Perform memory action") + (BIS zero ,mat arg1) + (BIS zero ,cycle-number arg2) + (external-branch |PERFORMMEMORYACTION|))) + +(defmacro with-multiple-memory-reads ((vmdata vmtags base limit + &key inhibit-alignment cant-be-in-cache-p) + &body body &environment env) + (when *memoized-vmdata* + (error "You are already inside of a call to ~S" 'with-multiple-memory-reads)) + ;; --- need to bind these even in can't-be-in-cache-p for memory + ;; subrs to work + (setq cant-be-in-cache-p nil) + (let ((*memoized-vmdata* vmdata) + (*memoized-vmtags* vmtags) + (*memoized-base* (lisp:and (not cant-be-in-cache-p) base)) + (*memoized-limit* (lisp:and (not cant-be-in-cache-p) limit)) + (*inhibit-alignment-in-memory-read* inhibit-alignment) + (*cant-be-in-cache-p* cant-be-in-cache-p)) + `( + ,@(unless cant-be-in-cache-p + `((LDQ ,base PROCESSORSTATE_STACKCACHEBASEVMA (ivory)))) + ,@(unless cant-be-in-cache-p + `((LDL ,limit PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)"))) + ,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body)))) + +;; Use the memoized data from some other call +(defmacro using-multiple-memory-reads ((vmdata vmtags base limit + &key cant-be-in-cache-p) + &body body &environment env) + ;; --- need to bind these even in can't-be-in-cache-p for memory + ;; subrs to work + (setq cant-be-in-cache-p nil) + (let ((*memoized-vmdata* vmdata) + (*memoized-vmtags* vmtags) + (*memoized-base* (lisp:and (not cant-be-in-cache-p) base)) + (*memoized-limit* (lisp:and (not cant-be-in-cache-p) limit)) + (*cant-be-in-cache-p* cant-be-in-cache-p)) + `(,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body)))) + +(defmacro inhibit-alignment-in-memory-read (&body body &environment env) + (let ((*inhibit-alignment-in-memory-read* t)) + `(,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body )))) + +;; (VM-read t1 t2 t3 t4 t5) +;; (with-multiple-memory-reads (arg1 arg2 arg3 arg4) (VM-read t1 t2 t3 t4 t5)) + +;; Raw read from emulated memory. +(defmacro VM-read (vma tag data temp temp2 &optional prefetchp) + (check-temporaries (vma) (tag data temp)) + (assert (not (stringp prefetchp)) () "VM-Read does not accept comments") + (let () + `( + (ADDQ ,vma Ivory ,temp2) + (S4ADDQ ,temp2 zero ,data) + ,@(when prefetchp `((FETCH 0 (,temp2)))) ; load tag word + (LDQ_U ,tag 0 (,temp2)) + ,@(when prefetchp `((FETCH 0 (,data)))) + (LDL ,data 0 (,data)) ; load data + (EXTBL ,tag ,temp2 ,tag) ; extract the correct tag + ))) + +;; (with-multiple-memory-reads (arg1 arg2 arg3 arg4) (VM-write t1 t2 t3 t4 t5 t6 t7)) + +;; Raw write to emulated memory +(defmacro VM-write (vma tag data temp temp2 temp3 temp4 &optional prefetchp) + (check-temporaries (vma tag data) (temp temp2 temp3 temp4)) + (assert (not (stringp prefetchp)) () "VM-Write does not accept comments") + (let () + `((ADDQ ,vma Ivory ,temp) + (S4ADDQ ,temp zero ,temp4) + ,@(when prefetchp + `((FETCH_M 0 (,temp)) + (force-alignment))) + (LDQ_U ,temp3 0 (,temp)) ; temp here is the tag address + (INSBL ,tag ,temp ,temp2) ; temp2 is the positioned tag + (MSKBL ,temp3 ,temp ,temp3) ; remove old byte + ,@(if prefetchp + `((FETCH_M 0 (,temp4))) + `((force-alignment))) + (BIS ,temp3 ,temp2 ,temp3) ; add new byte + (STQ_U ,temp3 0 (,temp)) + ;; Must happen last, in case of write-first fault + (STL ,data 0 (,temp4)) ; store data + ))) + +;; Decode fault according to page attributes +(defmacro check-access (vma temp temp2 pagemissing faultrequest &optional writefault transportfault) + (let ((access temp)) + `((LDQ ,temp2 PROCESSORSTATE_VMATTRIBUTETABLE (ivory) "Per-page attributes table") + (SRL ,vma |MemoryPageAddressShift| ,access "Index into the attributes table") + (ADDQ ,access ,temp2 ,temp2 "Address of the page's attributes") + (LDQ_U ,access 0 (,temp2) "Get the quadword with the page's attributes") + (STQ ,vma PROCESSORSTATE_VMA (ivory) "Stash the VMA") + (EXTBL ,access ,temp2 ,access "Extract the page's attributes") + (BEQ ,access ,pagemissing "Non-existent page") + (AND ,access |VMAttributeAccessFault| ,temp2) + (BNE ,temp2 ,faultrequest "Access fault") + ,@(when transportfault + `((AND ,access |VMAttributeTransportFault| ,temp2) + (BNE ,temp2 ,transportfault "Transport fault"))) + ,@(when writefault + `((AND ,access |VMAttributeWriteFault| ,temp2) + (BNE ,temp2 ,writefault "Write fault")))))) + +#|Ideal| + +;; This is the current coed without multiples. Takes 11 cycles with no +;; funny business. + +;/* Memory Read Internal */ +;G177721: +; bis $31, 1, $18 # [1] +; ldq $1, PROCESSORSTATE_STACKCACHEBASEVMA($14) # Base of stack cache [0di] +; ldah $3, 16384($16) # [1-] +; ldl $2, PROCESSORSTATE_SCOVLIMIT($14) # Size of stack cache [0di] +; sll $18, IvoryMemoryData, $18 # [1-] +; ldq $4, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] +; ldq_u $17, 0($3) # [1] +; subq $16, $1, $1 # Stack cache offset [0di] +; s4addq $16, $18, $18 # [1] +; cmpult $1, $2, $2 # In range? [1] +; extbl $17, $3, $17 # [1] +; bne $2, G177723 # [0di] +; ldl $18, 0($18) # [1] +;G177722: +; srl $4, $17, $4 # [1di] +; extll $18, 0, $18 # [2] +; blbs $4, G177724 # [0di] + +;; This is the current code, assuming with-multiple-memory-reads is +;; active. Takes 10 cycles if there is no funny-business. + +;/* Memory Read Internal */ +;G177711: +; ldah $3, 16384($16) # [1] +; ldq $4, PROCESSORSTATE_DATAREAD_MASK($14) # [0di] +; s4addq $16, $25, $18 # [1-] +; ldq_u $17, 0($3) # [1di] +; subq $16, $23, $1 # Stack cache offset [1-] +; cmpult $1, $22, $2 # In range? [1] +; extbl $17, $3, $17 # [1] +; bne $2, G177713 # [0di] +; ldl $18, 0($18) # [1] +;G177712: +; srl $4, $17, $4 # [1di] +; extll $18, 0, $18 # [2] +; blbs $4, G177714 # [0di] + + +;; This assumes everything could be based off the IVORY register: that +;; the procesorstate is accessed using negative offsets and tags are +;; accessed using positive offsets and that the stack-cache is only 1 +;; page. Additionally, we assume IVORY is some nice power of 2 >= 1_32 +;; so that multiplying the tag address by 4 takes you to the data +;; address. 10 cycles, whether you have BASEVMA in a register already +;; or not. + +( + (ldq t4 processorstate_stackcachebasevma (ivory)) + (addq arg1 ivory t1) + (ldl t5 processorstate_scovlimit (ivory)) + (s4addq t1 zero arg3) + (ldq_u arg2 0 (t1)) + (subq arg1 t4 t2) + (ldq t3 processorstate_dataread_mask (ivory)) + (cmpult t2 t5 t2) + (ldl arg3 0 (arg3)) + ;; force-alignment creates di, but to no avail + (extbl arg2 t1 arg2) + (bne t2 incache) + (srl t3 arg2 t3) + ;; force-alignment creates di, but to no avail + (extll arg3 0 arg3) + (blbs t3 memoryaction) + ) + +;; Here is a scheme for inside multiple-memory-reads: cache the tag and +;; data quadword in the first two mmr registers (now unused), detect +;; reading odd vma's and skip the load and cache checks. Resulting code +;; is still 10 cycles, but 7 in the skip case + +;; Assumes t9, t10 available, base and limit in t11, t12 +( + (ldq t3 processorstate_dataread_mask (ivory)) + (addq arg1 ivory t1) + (s4addq t1 zero t4) + (BLBS arg1 memory-read-odd) + (ldq_u t9 0 (t1)) + (subq arg1 t11 t2) + (ldq_u t10 0 (t4)) + (cmpult t2 t12 t2) + (bne t2 incache) + (label memory-read-odd) + (extbl t9 t1 arg2) + (lda t1 240 (zero)) + (srl t3 arg2 t3) + (srl t1 arg2 t1) + (extll t10 t4 arg3) + (blbs t3 memoryaction) + ) + +;; This assumes that tags can be some small offset above zero, and that +;; data is based at IVORY, again with the processorstate being negative +;; offsets from IVORY and the stack-cache being 1 page. 9 cycles, +;; whether you have BASEVMA in a register or not. There are no stalls +;; in this code. +( + (ldq_u arg2 smalloffset (arg1)) + (s4addq arg1 ivory t2) + (ldq t4 processorstate_stackcachebasevma (ivory)) + (ldq t3 processorstate_dataread_mask (ivory)) + (ldl arg3 0 (t2)) + (extbl arg2 arg1 arg2) + (subq arg1 t4 t2) + (srl t3 arg2 t3) + (cmpult t2 #x2000 t2) + (bne t2 incache) + (extll arg3 0 arg3) + (blbs t3 memoryaction) + ) + + +||# + + + +(defvar *memory-subroutines* nil + "A list of memory subroutines with their parameters for substitution by memory-read") + +(defmacro define-memory-subroutine + (name + (vma tag data cycle temp temp2 temp3 temp4) + (vmdata vmtags base limit) + (linkage)) + "Defines a common memory (fast-) subroutine, noting it on + *memory-subroutines* so that memory-read can replace common code" + (let* ((args (list vma tag data)) + (temps (list temp temp2 temp3 temp4)) + (caches (list vmdata vmtags base limit))) + (let ((datum `((,args ,cycle ,temps ,caches) ,name ,linkage))) + (setq *memory-subroutines* (remove name *memory-subroutines* + :key #'second :test #'equal)) + (push datum *memory-subroutines*)) + `(define-fast-subroutine ,name () (,linkage) + (using-multiple-memory-reads (,vmdata ,vmtags ,base ,limit) + (memory-read ,vma ,tag ,data ,cycle ,temp ,temp2 ,temp3 ,temp4 nil nil t))))) + +(defmacro find-memory-subroutine + ((vma tag data cycle temp temp2 temp3 temp4) + (vmdata vmtags base limit)) + #+Genera (declare (values subr args linkage)) + `(stack-let ((args (list ,vma ,tag ,data)) + (temps (list ,temp ,temp2 ,temp3 ,temp4)) + (caches (list ,vmdata ,vmtags ,base ,limit))) + (funcall 'find-memory-subr-internal args ,cycle temps caches))) + +(defun find-memory-subr-internal (args cycle temps caches) + #+Genera (declare (values subr args linkage)) + (let () #+ign ((args (map 'list #'real-reg args)) + (temps (map 'list #'real-reg temps)) + (caches (map 'list #'real-reg caches))) + (loop with bname and bargs and blinkage and bmerit + for ((targs tcycle ttemps tcaches) name linkage) in *memory-subroutines* do + (when (lisp:and (equal cycle tcycle) + (equal temps ttemps) + (equal caches tcaches)) + (if (equal args targs) + (return (values name nil linkage)) + (let ((merit (loop for ta in targs for a in args count (not (eq ta a))))) + (when (or (null bmerit) (< merit bmerit)) + (setq bname name bargs targs blinkage linkage bmerit merit))))) + finally + (when bname + (destructuring-bind (vma tag data) args + (destructuring-bind (bvma btag bdata) bargs + (return + (values bname + `(,(if (equal vma bvma) nil bvma) + ,(if (equal tag btag) nil btag) + ,(if (equal data bdata) nil bdata)) + blinkage)))))))) + + +;; Test-case for macro-expanding +;; (define-procedure test () (with-multiple-memory-reads (t12 t11 t10 t9 :cant-be-in-cache-p nil) (extll arg1 0 arg1) (memory-read arg1 arg2 arg3 PROCESSORSTATE_DATAREAD t1 t2 t3 t4 nil nil))) + +;;; Implements all memory-read operations, optimizing when cycle is known + +;;; --- There are 3 stall slots that you could move instructions into (someday) + +;;; --- Someday make store-contents and store-conditional have another +;;; temp so temp4 is available (currently, the code is poorer without +;;; temp4) +(defun memory-read-internal (vma tag data cycle temp temp2 temp3 &optional temp4 done-label signedp inlinep &aux subr args linkage) + "Cycle is either a constant cycle type or a register containing the + cycle number." + #+memory-inline (setq inlinep t) + (if temp4 + (check-temporaries (vma tag data) (temp temp2 temp3 temp4)) + (check-temporaries (vma tag data) (temp temp2 temp3))) + (unless inlinep + (multiple-value-setq (subr args linkage) + (find-memory-subroutine + (vma tag data cycle temp temp2 temp3 temp4) + (*memoized-vmdata* *memoized-vmtags* *memoized-base* *memoized-limit*)))) + (let* ((cycle-number (case cycle + (processorstate_dataread 0) + (processorstate_datawrite 1) + (processorstate_bindread 2) + (processorstate_bindwrite 3) + (processorstate_bindreadnomonitor 4) + (processorstate_bindwritenomonitor 5) + (processorstate_header 6) + (processorstate_structureoffset 7) + (processorstate_scavenge 8) + (processorstate_cdr 9) + (processorstate_gccopy 10) + (processorstate_raw 11) + (processorstate_rawtranslate 12) + (t + ;; Make sure cycle is a (non-conflicting) register + (check-temporaries (cycle) (vma tag data temp temp2 temp3)) + (shiftf cycle :general)))) + (cycle-mask (unless (eq cycle :general) + (intern (concatenate 'string (string cycle) "_MASK")))) + #+obsolete + (cantransport (member cycle '(:general + processorstate_dataread + processorstate_bindread + processorstate_bindreadnomonitor + processorstate_header + processorstate_scavenge))) + (canindirect (not (member cycle '(processorstate_scavenge + processorstate_gccopy + processorstate_raw + processorstate_rawtranslate)))) + (cycle-indirect-mask (when canindirect + (unless (eq cycle :general) + (memory-indirect-mask cycle-number)))) + (cantransform (member cycle '(:general + processorstate_dataread + processorstate_rawtranslate))) + (canlookup (member cycle '(:general + processorstate_dataread + processorstate_datawrite))) + (top (gensym)) + (wasincache (gensym)) + (incache (gensym)) + (notindirect (gensym)) + (decodeaction (gensym)) + (decodecommontail (if #-memory-inline inlinep #+memory-inline nil + (intern (concatenate 'string (string *function-being-processed*) + "DECODE")) + (gensym))) + (doaction (gensym)) + (checklookup (if canlookup (gensym) doaction)) + (checktransform (if cantransform (gensym) checklookup)) + (checkindirect (if canindirect (gensym) checktransform)) + (dbcachemiss (gensym)) + (done (or done-label (gensym))) + ;; readability + (temp1 temp) + (action-memoized (lisp:and *memoized-action* (eq *memoized-action-cycle* cycle))) + (action (if action-memoized *memoized-action* (or temp4 temp)))) + (flet ((main-expansion () + `((comment "Memory Read Internal") + (unlikely-label ,top) + ;; VM-read to validate access, but then check for cached + + ;; The next sequence is equivalent (believe it or not) to: + ;; (VM-read ,vma ,tag ,data ,temp2 ,temp3 "Read the emulated Ivory Word") + ;; (VMAtoSCAmaybe ,vma ,temp ,notincache ,temp2 ,temp3) + ;; (stack-read2 ,temp1 ,tag ,data "Read from stack cache") + ,@(unless (or *memoized-base* *cant-be-in-cache-p*) + `((LDQ ,temp1 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of stack cache"))) + (ADDQ ,vma Ivory ,temp3) + ,@(unless (or *memoized-limit* *cant-be-in-cache-p*) + `((LDL ,temp2 PROCESSORSTATE_SCOVLIMIT (ivory)))) + ,@(if (lisp:and (eq cycle :general) (or temp4 *cant-be-in-cache-p*)) + `((S4ADDQ ,cycle-number zero ,action "Cycle-number -> table offset")) + `((S4ADDQ ,temp3 zero ,data))) + (LDQ_U ,tag 0 (,temp3)) + ,@(if (lisp:and (eq cycle :general) (or temp4 *cant-be-in-cache-p*)) + `((S4ADDQ ,action Ivory ,action)) + (unless *cant-be-in-cache-p* + `((SUBQ ,vma ,(or *memoized-base* temp1) ,temp1 "Stack cache offset")))) + ,@(when (or temp4 *cant-be-in-cache-p*) + (cond ((eq cycle 'processorstate_raw) ()) + ((eq cycle :general) + `(;; Table offset == cycle-number * 16 + (S4ADDQ ,temp3 zero ,data) + ,@(unless *cant-be-in-cache-p* + `((SUBQ ,vma ,(or *memoized-base* temp1) ,temp1 "Stack cache offset"))) + (LDQ ,action PROCESSORSTATE_DATAREAD_MASK (,action)))) + (t `((LDQ ,action ,cycle-mask (ivory)) + )))) + ,@(unless *cant-be-in-cache-p* + `((CMPULT ,temp1 ,(or *memoized-limit* temp2) ,temp2 "In range?"))) + (LDL ,data 0 (,data)) + (EXTBL ,tag ,temp3 ,tag) + ,@(unless *cant-be-in-cache-p* + `((branch-true ,temp2 ,incache))) + (unlikely-label ,wasincache) + ,@(unless (or temp4 *cant-be-in-cache-p*) + (cond ((eq cycle 'processorstate_raw) ()) + ((eq cycle :general) + `(;; Table offset == cycle-number * 16 + (S4ADDQ ,cycle-number zero ,action "Cycle-number -> table offset") + (S4ADDQ ,action Ivory ,action) + (LDQ ,action PROCESSORSTATE_DATAREAD_MASK (,action)))) + (t `((LDQ ,action ,cycle-mask (ivory)) + )))) + ,@(if (eq cycle 'processorstate_raw) + `(,@(unless signedp `((EXTLL ,data 0 ,data)))) + ;; NOTE: SRL "ignores" the cdr-code (only uses low 6 bits for shift) + `(,@(when cycle-indirect-mask + `((load-constant ,temp3 ,cycle-indirect-mask))) + (SRL ,action ,tag ,action) + ,@(when cycle-indirect-mask + `((SRL ,temp3 ,tag ,temp3))) + ,@(unless signedp `((EXTLL ,data 0 ,data))) + (BLBS ,action ,decodeaction))) + ,@(if done-label + `((BR zero ,done)) + `((unlikely-label ,done)))))) + (unless inlinep + (when subr + (if (null args) + (return-from memory-read-internal + (let ((todecode (intern (concatenate 'string (string subr) "DECODE")))) + #+debug + (format *trace-output* "~&In ~A Used ~A" + *function-being-processed* subr) + (if (eq cycle 'processorstate_raw) + (unless *cant-be-in-cache-p* + (push + `((label ,incache) + (BSR ,linkage ,todecode) + (BR zero ,done)) + *function-epilogue*)) + (push + `((label ,decodeaction) + ,@(when cycle-indirect-mask + `((BLBC ,temp3 ,notindirect) + (EXTLL ,data 0 ,vma "Do the indirect thing") + (BR zero ,top) + (label ,notindirect))) + (label ,incache) + (BSR ,linkage ,todecode) + (BR zero ,done)) + *function-epilogue*)) + (main-expansion) + )) + #+debug + (format *trace-output* "~&In ~A Couldn't use ~A ~A->~A" + *function-being-processed* subr args `(,vma ,tag ,data))))) + #+debug + (format *trace-output* "~&In ~A VMA=~A TAG=~A DATA=~A CYCLE=~A" + *function-being-processed* vma tag data cycle) + ;; Unlikely expansion + (progn + (unless (eq cycle 'processorstate_raw) + (push + `( + (label ,decodeaction) + ,@(when cycle-indirect-mask + `((BLBC ,temp3 ,notindirect) + (EXTLL ,data 0 ,vma "Do the indirect thing") + (BR zero ,top))) + (label ,notindirect) + ,@(if (eq cycle :general) + `(;; Table offset == cycle-number * 16 + (S4ADDQ ,cycle-number zero ,action "Cycle-number -> table offset") + (S4ADDQ ,action Ivory ,action) + (LDQ ,action PROCESSORSTATE_DATAREAD (,action))) + `((LDQ ,action ,cycle (ivory) "Load the memory action table for cycle"))) + (TagType ,tag ,temp3 "Discard the CDR code") + (STQ ,vma PROCESSORSTATE_VMA (ivory) "stash the VMA for the (likely) trap") + (S4ADDQ ,temp3 ,action ,temp3 "Adjust for a longword load") + (LDL ,action 0 (,temp3) "Get the memory action") + ,@(when (lisp:and canindirect (not cycle-indirect-mask)) + `((label ,checkindirect) + (AND ,action |MemoryActionIndirect| ,temp2) + (BEQ ,temp2 ,checktransform) + (EXTLL ,data 0 ,vma "Do the indirect thing") + (BR zero ,top))) + ,@(when cantransform + `((label ,checktransform) + (AND ,action |MemoryActionTransform| ,temp3) + (BEQ ,temp3 ,checklookup) + (BIC ,tag #x3F ,tag) + (BIS ,tag |TypeExternalValueCellPointer| ,tag) + (BR zero ,done))) + ,@(when canlookup + ;; +++ Caveat emptor: we do not follow the microcode + ;; implementation. In order to implement this at all + ;; reasonably, we require that the binding cache be + ;; safeguarded (hence implying it is scavenged at flip + ;; time). Minima does this. + `( + (passthru "#ifndef MINIMA") + (unlikely-label ,checklookup) + (passthru "#endif") + (passthru "#ifdef MINIMA") + (label ,checklookup) + (AND ,action |MemoryActionBinding| ,temp3) + (LDQ ,temp2 PROCESSORSTATE_DBCMASK (ivory)) + (BEQ ,temp3 ,doaction) + (SLL ,vma 1 ,temp1) + ;; --- Could save LDQ/S4ADDQ below by storing DBCBASE + ;; as an index into Ivory VM data rather than a vma + (LDQ ,temp3 PROCESSORSTATE_DBCBASE (ivory)) + (AND ,temp1 ,temp2 ,temp1 "Hash index") + ;; Don't need tag, inline: (VM-Read ,vma ,temp1 ,temp2 ,temp3 ,tag) + (BIS zero 1 ,temp2) + (SLL ,temp2 |IvoryMemoryData| ,temp2) + ;; --- Why is ADDQ not sufficient instead of next two? + (ADDL ,temp1 ,temp3 ,temp1) + (EXTLL ,temp1 0 ,temp1 "Clear sign-extension") + (S4ADDQ ,temp1 ,temp2 ,temp2) + (LDL ,temp1 0 (,temp2) "Fetch the key") + ;; Get the vma from next location and indirect + ;; Don't need tag, inline: (VM-Read ,vma ,tag ,data ,temp2 ,temp3) + (LDL ,data 4 (,temp2) "Fetch value") + (SUBL ,vma ,temp1 ,temp3 "Compare") + (BNE ,temp3 ,dbcachemiss "Trap on miss") + (EXTLL ,data 0 ,vma "Extract the pointer, and indirect") + (BR zero ,top "This is another memory read tailcall.") + (label ,dbcachemiss) + (external-branch DBCACHEMISSTRAP) + (passthru "#endif") + )) + (unlikely-label ,doaction) + (memory-action ,action ,cycle-number)) + *function-epilogue*)) + (unless *cant-be-in-cache-p* + (push + `(;; Memory common tail: disambiguate incache from exception + ,@(when inlinep + `((label ,decodecommontail) + ,@(unless (eq cycle 'processorstate_raw) + `((branch-false ,temp2 ,notindirect))))) + (label ,incache) + (LDQ ,temp2 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (S8ADDQ ,temp1 ,temp2 ,temp1 "reconstruct SCA") + (LDL ,data 0 (,temp1)) + (LDL ,tag 4 (,temp1) "Read from stack cache") + (BR zero ,wasincache)) + *function-epilogue*))) + (main-expansion)))) + + +;;; External interfaces + +(defmacro memory-read (vma tag data cycle temp temp2 temp3 temp4 &optional done-label signedp inlinep) + (check-temporaries (vma) (tag data temp temp temp2 temp3 temp4)) + (assert (lisp:and (not (eql tag 'zero)) (not (eql data 'zero)))) + `(,@(memory-read-internal vma tag data cycle temp temp2 temp3 temp4 done-label signedp inlinep))) + +(defmacro memory-write (vma tag data cycle temp temp2 temp3 temp4 &optional temp5 done-label) + (if temp5 + (check-temporaries (vma tag data) (temp temp2 temp3 temp4 temp5)) + (check-temporaries (vma tag data) (temp temp2 temp3 temp4))) + (assert (lisp:and (not (eql tag 'zero)) (not (eql data 'zero)))) + (assert (eq cycle 'PROCESSORSTATE_RAW) () "You probably meant STORE-CONTENTS") + (let ((done (or done-label (gensym))) + (incache (gensym))) + (unless *cant-be-in-cache-p* + (push + `((label ,incache) + ,@(if temp5 + `(;; Have to reload this due to insufficient registers + ,@(unless *memoized-base* + `((LDQ ,temp2 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (force-alignment))) + (LDQ ,temp PROCESSORSTATE_STACKCACHEDATA (ivory)) + (SUBQ ,vma ,(or *memoized-base* temp2) ,temp2 "Stack cache offset")) + `((LDQ ,temp PROCESSORSTATE_STACKCACHEDATA (ivory)))) + (S8ADDQ ,temp2 ,temp ,temp "reconstruct SCA") + (stack-write2 ,temp ,tag ,data "Store in stack") + (BR zero ,done)) + *function-epilogue*)) + `( +; (force-alignment) ;tuned for aligned + ;; VM-write to validate access, but then check for cached + ;; Below is in-lined: + ;; (VM-write vma tag data temp temp2 temp3 temp4) + ;; (VMAtoSCAmaybe vma temp done temp2 temp3) + ;; for better dual-issue + ,@(unless (or *cant-be-in-cache-p* *memoized-base* (null temp5)) + `((LDQ ,temp2 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)))) + (ADDQ ,vma Ivory ,temp) + ,@(unless (or *cant-be-in-cache-p* *memoized-limit* (null temp5)) + `((LDL ,temp5 PROCESSORSTATE_SCOVLIMIT (ivory)))) + (S4ADDQ ,temp zero ,temp4) + (LDQ_U ,temp3 0 (,temp)) + ,@(unless (or *cant-be-in-cache-p* (null temp5)) + `((SUBQ ,vma ,(or *memoized-base* temp2) ,temp2 "Stack cache offset") + (CMPULT ,temp2 ,(or *memoized-limit* temp5) ,temp5 "In range?"))) + (INSBL ,tag ,temp ,temp2) + (MSKBL ,temp3 ,temp ,temp3) + (force-alignment) + (BIS ,temp3 ,temp2 ,temp3) + ,@(unless (or *cant-be-in-cache-p* *memoized-base* temp5) + `((LDQ ,temp2 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)))) + (STQ_U ,temp3 0 (,temp)) + ,@(unless (or *cant-be-in-cache-p* temp5) + `((LDL ,temp PROCESSORSTATE_SCOVLIMIT (ivory)) + (SUBQ ,vma ,(or *memoized-base* temp2) ,temp2 "Stack cache offset") + (CMPULT ,temp2 ,temp ,temp "In range?"))) + (STL ,data 0 (,temp4)) + ,@(unless *cant-be-in-cache-p* + `((branch-true ,(or temp5 temp) ,incache "J. if in cache"))) + ,@(if done-label + `((BR zero ,done)) + `((unlikely-label ,done)))))) + +;; (store-contents arg1 arg2 arg3 processorstate_dataread t1 t2 t3 t4 t5) + +;; Basically, memory-write, but preserve the cdr-code. Of course, that +;; means you have to read the old location to get the cdr-code. You +;; might optimize not bothering to read the old data, but that's needed +;; to get access/transport checks to go off +(defmacro store-contents (vma new-tag new-data cycle tag data temp temp2 temp3 + &optional temp4 done-label) + (if temp4 + (check-temporaries (vma new-tag new-data) (tag data temp temp2 temp3 temp4)) + (check-temporaries (vma new-tag new-data) (tag data temp temp2 temp3))) + (assert (lisp:and (not (eql new-tag 'zero)) (not (eql new-data 'zero)))) + `(,@(memory-read-internal vma tag data cycle temp temp2 temp3 temp4 nil t) + (comment "Merge cdr-code") + (AND ,new-tag #x3F ,data) + (AND ,tag #xC0 ,tag) + (BIS ,tag ,data ,tag) + (memory-write ,vma ,tag ,new-data PROCESSORSTATE_RAW ,temp ,temp2 ,temp3 ,data ,temp4 + ,done-label))) + +;; Here for optimization purposes (so the memory primitives do not +;; escape). +(defmacro store-conditional-internal (vma oldtag olddata newtag newdata faillab + temp temp2 temp3 temp4 temp5 &optional temp6 done-label) + (let (;; readability + (tag temp4) + (data temp5)) + `((comment "Read the location, checking write access") + ,@(memory-read-internal vma tag data 'PROCESSORSTATE_DATAREAD temp temp2 temp3 nil nil t) + (SUBL ,olddata ,data ,temp "Check for data match - NOT") +; (CMPEQ ,olddata ,data ,temp "Check for data match") + (XOR ,oldtag ,tag ,temp2 "Zero if tags match") + (branch-true ,temp ,faillab "Jump if data didn't match") + (TagType ,temp2 ,temp2 "Stip result of comparing CDR-CODEs") + (BNE ,temp2 ,faillab "Jump if tags don't match") + (AND ,newtag #x3F ,temp "Strip CDR-CODE") + (AND ,tag #xC0 ,tag "Retain CDR-CODE") + (BIS ,temp ,tag ,tag "Merge new tag with old CDR-CODE") + ;; Update the object + (memory-write ,vma ,tag ,newdata PROCESSORSTATE_RAW ,temp ,temp2 ,temp3 ,temp5 ,temp6 + ,done-label)))) + + + diff --git a/alpha-emulator/stacklis.lisp b/alpha-emulator/stacklis.lisp new file mode 100644 index 0000000..ede1340 --- /dev/null +++ b/alpha-emulator/stacklis.lisp @@ -0,0 +1,662 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; This file is intended to provide a clean interface to the stack. +;;; this way, it is hoped that we can experiment with the stack implementation. +;;; With these primitives, VMA is always a pointer within the stackcache, +;;; and read/write is always to the stackcache and NOT to main memory. + +;; For backwards compatibility, we let all the stack ops take an +;; optional comment plus keyword options +(defun process-stack-options (options) + (if (or (null options) (stringp (first options)) (null (first options))) + options + (let ((comment (find-if #'stringp options))) + (cond (comment + (list* comment (remove comment options))) + (t (list* nil options)))))) + +(defmacro with-stack-options ((comment &rest keys) options &body body) + `(destructuring-bind (&optional ,comment ,@keys) + (process-stack-options ,options) + ,@(when (member 'tos-valid keys) + `((setq tos-valid (case tos-valid + (:invalid nil) + (t tos-valid))))) + (progn ,@body))) + +;;; Read the stack location addressed by vma and put result in dest +;;; 1 cycle, good dual opportunities, but 2 cycle data ready delay. +(defmacro stack-read-disp (vma disp dest &rest options) + (with-stack-options (comment &key tos-valid) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) (member tos-valid `(:arg6 t))) + `(,@(unless (eq dest 'arg6) + `((BIS arg6 zero ,dest ,@(if comment `(,comment)))))) + `((LDQ ,dest ,disp (,vma) ,@(if comment `(,comment))))))) + +(defmacro stack-read (vma dest &rest options) + `(stack-read-disp ,vma 0 ,dest ,@options)) + +(defmacro stack-read-data-disp (vma disp dest &rest options) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) tos-valid (not floating)) + (if signed + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq dest 'arg6) + `((BIS arg6 zero ,dest ,@(if comment `(,comment)))))) + ((:arg6 t) + `((ADDL arg6 zero ,dest ,@(if comment `(,comment))))))) + `((EXTLL arg6 0 ,dest ,@(if comment `(,comment))))) + (cond (signed + `((LDL ,dest ,disp (,vma) ,@(if comment `(,comment))))) + (floating + `((LDS ,dest ,disp (,vma) ,@(if comment `(,comment))))) + (t + `((LDL ,dest ,disp (,vma) ,@(if comment `(,comment))) + (EXTLL ,dest 0 ,dest))))))) + +(defmacro stack-read-data (vma dest &rest options) + `(stack-read-data-disp ,vma 0 ,dest ,@options)) + +(defmacro stack-read-tag-disp (vma disp dest &rest options) + (with-stack-options (comment &key tos-valid) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) tos-valid) + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq dest 'arg5) + `((BIS arg5 zero ,dest ,@(if comment `(,comment)))))) + ((:arg6 t) + `((extll arg6 4 ,dest ,@(if comment `(,comment))))))) + `((LDL ,dest ,(+ disp 4) (,vma) ,@(if comment `(,comment))))))) + +(defmacro stack-read-tag (vma dest &rest options) + `(stack-read-tag-disp ,vma 0 ,dest ,@options)) + +(defmacro stack-read2-disp (vma disp tag data &rest options) + (check-temporaries (vma) (tag data)) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) tos-valid (not floating)) + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq tag 'arg5) + `((BIS arg5 zero ,tag)))) + ((:arg6 t) + `((EXTLL arg6 4 ,tag)))) + ,@(if signed + (ecase tos-valid + (:arg5arg6 + (unless (eq data 'arg6) + `((BIS arg6 zero ,data ,@(if comment `(,comment)))))) + ((:arg6 t) + `((ADDL arg6 zero ,data ,@(if comment `(,comment)))))) + `((EXTLL arg6 0 ,data ,@(if comment `(,comment)))))) + (cond (signed + `((LDL ,tag ,(+ disp 4) (,vma) ,@(if comment `(,comment))) + (LDL ,data ,disp (,vma)))) + (floating + `((LDS ,data ,disp (,vma) ,@(if comment `(,comment))) + (LDL ,tag ,(+ disp 4) (,vma)))) + (t + `((LDL ,data ,disp (,vma) ,@(if comment `(,comment))) + (LDL ,tag ,(+ disp 4) (,vma)) + (EXTLL ,data 0 ,data))))))) + +(defmacro stack-read2-disp-signed (vma disp tag data &rest options) + (check-temporaries (vma) (tag data)) + (with-stack-options (comment &rest options) options + `(stack-read2-disp ,vma ,disp ,tag ,data ,comment :signed t ,@options))) + +(defmacro stack-read2 (vma tag data &rest options) + (check-temporaries (vma) (tag data)) + `(stack-read2-disp ,vma 0 ,tag ,data ,@options)) + +;;; Used for reading things that are probably fixnums. Reads the +;;; tag first, since that's what we generally need to test first. +;;; data comes sign extended for free. +(defmacro stack-read2-signed (vma tag data &rest options) + (check-temporaries (vma) (tag data)) + (with-stack-options (comment &rest options) options + `(stack-read2 ,vma ,tag ,data ,comment :signed t ,@options))) + +;;; stack pop + +(defmacro stack-top (dest &rest options) + `(stack-read iSP ,dest ,@options)) + +(defmacro stack-top2 (tag data &rest options) + `(stack-read2 iSP ,tag ,data ,@options)) + +(defmacro stack-pop (dest &rest options) + `((stack-top ,dest ,@options) + (SUBQ iSP 8 iSP "Pop Stack."))) + +(defmacro stack-pop-discard (dest &optional comment) + (declare (ignore dest)) + `((SUBQ iSP 8 iSP ,(or comment "Pop Stack.")))) + +(defmacro stack-pop-data (dest &rest options) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and tos-valid (not floating)) + `(,@(if signed + (ecase tos-valid + (:arg5arg6 + (unless (eq dest 'arg6) + `((BIS arg6 zero ,dest) ,@(if comment `(,comment))))) + ((:arg6 t) + `((ADDL arg6 zero ,dest ,@(if comment `(,comment)))))) + `((EXTLL arg6 0 ,dest))) + (SUBQ iSP 8 iSP "Pop Stack.")) + (cond (signed + `((LDL ,dest 0 (iSP) ,@(if comment `(,comment))) + (SUBQ iSP 8 iSP "Pop Stack."))) + (floating + `((LDS ,dest 0 (iSP) ,@(if comment `(,comment))) + (SUBQ iSP 8 iSP "Pop Stack."))) + (t + `((LDL ,dest 0 (iSP) ,@(if comment `(,comment))) + (SUBQ iSP 8 iSP "Pop Stack.") + (EXTLL ,dest 0 ,dest))))))) + +(defmacro stack-pop-tag (dest &rest options) + `((stack-read-tag iSP ,dest ,@options) + (SUBQ iSP 8 iSP "Pop Stack."))) + +(defmacro stack-pop2 (tag data &rest options) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and tos-valid (not floating)) + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq tag 'arg5) + `((BIS arg5 zero ,tag)))) + ((:arg6 t) + `((EXTLL arg6 4 ,tag)))) + ,@(if signed + (ecase tos-valid + (:arg5arg6 + (unless (eq data 'arg6) + `((BIS arg6 zero ,data ,@(if comment `(,comment)))))) + ((:arg6 t) + `((ADDL arg6 zero ,data ,@(if comment `(,comment)))))) + `((EXTLL arg6 0 ,data ,@(if comment `(,comment))))) + (SUBQ iSP 8 iSP "Pop Stack.")) + (cond (signed + `((LDL ,tag 4 (iSP) ,@(if comment `(,comment))) + (LDL ,data 0 (iSP) ,@(if comment `(,comment))) + (SUBQ iSP 8 iSP "Pop Stack."))) + (floating + `((LDS ,data 0 (iSP) ,@(if comment `(,comment))) + (LDL ,tag 4 (iSP) ,@(if comment `(,comment))) + (SUBQ iSP 8 iSP "Pop Stack."))) + (t + `((LDL ,data 0 (iSP) ,@(if comment `(,comment))) + (LDL ,tag 4 (iSP) ,@(if comment `(,comment))) + (SUBQ iSP 8 iSP "Pop Stack.") + (EXTLL ,data 0 ,data))))))) + + + +;;; Stores an immediate TAG and register data in two cycles. +(defmacro stack-write-ir (imtag data temp &rest options) + `((BIS zero ,imtag ,temp) + (stack-write2 iSP ,temp ,data ,@options))) + +(defmacro fp-stack-write-ir (imtag data temp &rest options) + (with-stack-options (comment &rest options) options + `((stack-write-ir ,imtag ,data ,temp ,comment :floating t ,@options)))) + +;;; Write specified tag and dataword. two cycles but good dual chances. +(defmacro stack-write2 (vma tag data &rest options) + `(stack-write2-disp ,vma 0 ,tag ,data ,@options)) + +;;; Write specified tag and dataword. +(defmacro stack-write2-disp (vma disp tag data &rest options) + ;; Floating stores dual-issue better if tag-first + (with-stack-options (comment &key floating set-cdr-next (tag-first floating)) options + ;; Allow set-cdr-next to be tag, for the translator case of keeping TOS valid + (when set-cdr-next (check-temporaries ( data) (set-cdr-next))) + `(,@(when set-cdr-next + `((AND ,tag #x3F ,set-cdr-next "set CDR-NEXT"))) + ,@(when tag-first + `((STL ,(or set-cdr-next tag) ,(+ disp 4) (,vma) "write the stack cache"))) + (,(if floating 'STS 'STL) ,data ,disp (,vma) ,@(if comment `(,comment))) + ,@(unless tag-first + `((STL ,(or set-cdr-next tag) ,(+ disp 4) (,vma) "write the stack cache")))))) + +(defmacro stack-write-tag (vma tag &rest options) + `(stack-write-tag-disp ,vma 0 ,tag ,@options)) + +(defmacro stack-write-data (vma data &rest options) + `(stack-write-data-disp ,vma 0 ,data ,@options)) + +(defmacro stack-write-tag-disp (vma disp tag &rest options) + (with-stack-options (comment &key set-cdr-next) options + (when set-cdr-next (check-temporaries (tag) (set-cdr-next))) + `(,@(when set-cdr-next + `((AND ,tag #x3F ,set-cdr-next "set CDR-NEXT"))) + (STL ,(or set-cdr-next tag) ,(+ disp 4) (,vma) ,@(if comment `(,comment)))))) + +(defmacro stack-write-data-disp (vma disp data &rest options) + (with-stack-options (comment &key floating) options + `((,(if floating 'STS 'STL) ,data ,disp (,vma) ,@(if comment `(,comment)))))) + +;;; word can be tag, but not word. +(defmacro combine-tag-data-word (tag data word &optional comment) + (check-temporaries (tag data) (word)) + `((SLL ,tag 32 ,word ,@(if comment `(,comment))) + (BIS ,word ,data ,word "construct the combined word"))) + +;;; This generates the combined word in 'word' as well as writing the stack. +;;; the BIS is duel issued with the STQ, three cycles are taken (one stall +;;; between the SLL and BIS. + +(defmacro stack-write2c (vma tag data word &optional comment) + (check-temporaries (vma tag data) (word)) + `((combine-tag-data-word ,tag ,data ,word ,comment) + (stack-write ,vma ,word))) + +;;; As above except that the word is tag and data combined. +;;; This takes less cycles, so is preferred. +(defmacro stack-write (vma word &optional comment) + `(stack-write-disp ,vma 0 ,word ,comment)) + +(defmacro stack-write-disp (vma disp word &optional comment) + `((STQ ,word ,disp (,vma) ,@(if comment `(,comment))))) + +;;; Push and push2 are like write and write2 except the stack is pushed. + +;;; ADDQ doesn't stall, takes five cycles, one stall for the SLL. +(defmacro stack-push2c (tag data word &optional comment) + (check-temporaries (tag data) (word)) + `((ADDQ iSP 8 iSP ,@(if comment `(,comment))) + (AND ,tag #x3F ,word "Set CDR-NEXT") + (stack-write2c iSP ,word ,data ,word))) + +;;; two cycles, but ADDQ will stall if iSP used in next instn. +(defmacro stack-push2 (tag data temp &rest options) + (with-stack-options (comment &rest options) options + `((stack-write2-disp iSP 8 ,tag ,data ,comment ,@options :set-cdr-next ,temp) + (ADDQ iSP 8 iSP)))) + +(defmacro stack-push (word temp &rest options) + (when temp (check-temporaries (word) (temp))) + (with-stack-options (comment &key (set-cdr-next t)) options + (if set-cdr-next + `((ADDQ iSP 8 iSP) ;here, in case word just fetched + (SLL ,word ,(- 32 6) ,temp) + (SRL ,temp ,(- 32 6) ,temp) + (stack-write-disp iSP 0 ,temp ,comment)) + `((stack-write-disp iSP 8 ,word ,comment) + (ADDQ iSP 8 iSP))))) + +;;; These are like above, but don't force CDR-NEXT + +(defmacro stack-push2c-with-cdr (tag data temp &optional comment) + (check-temporaries (tag data) (temp)) + `((ADDQ iSP 8 iSP ,@(if comment `(,comment))) + (stack-write2c iSP ,tag ,data ,temp))) + +(defmacro stack-push2-with-cdr (tag data &rest options) + (with-stack-options (comment &rest options) options + `(stack-push2 ,tag ,data nil ,comment :set-cdr-next nil ,@options))) + +(defmacro stack-push-tag (tag temp &rest options) + (with-stack-options (comment &rest options) options + `((stack-write-tag-disp iSP 8 ,tag ,comment ,@options :set-cdr-next ,temp) + (ADDQ iSP 8 iSP)))) + +(defmacro stack-push-tag-with-cdr (tag &rest options) + (with-stack-options (comment &rest options) options + `(stack-push-tag ,tag nil ,comment :set-cdr-next nil ,@options))) + +(defmacro stack-push-data (data &rest options) + `((stack-write-data-disp iSP 8 ,data ,@options) + (ADDQ iSP 8 iSP))) + +(defmacro stack-push-with-cdr (word &rest options) + (with-stack-options (comment &rest options) options + `(stack-push ,word nil ,comment :set-cdr-next nil ,@options))) + +;;; Stores an immediate TAG and register data in two cycles. +(defmacro stack-push-ir (imtag data temp &rest options) + (check-temporaries (data) (temp)) + `((BIS zero ,imtag ,temp) + (stack-push2-with-cdr ,temp ,data ,@options))) + +(defmacro fp-stack-push-ir (imtag data temp &rest options) + (with-stack-options (comment &rest options) options + `(stack-push-ir ,imtag ,data ,temp ,comment :floating t ,@options))) + +;; If storing the data first would stall, this can do better... +(defmacro stack-push-ir-reverse (imtag data temp &rest options) + (with-stack-options (comment &rest options) options + `(stack-push-ir ,imtag ,data ,temp ,comment :tag-first t ,@options))) + +;;; Makes a Fixnum from 32 bit data and pushes it. Leaves fixnum in temp. 4 +(defmacro stack-push-fixnumb (data temp &optional comment) + (check-temporaries () (temp)) + `((BIS zero |TypeFixnum| ,temp ,@(if comment `(,comment))) + (SLL ,temp 32 ,temp) + (ADDQ iSP 8 iSP) + (BIS ,temp ,data ,temp) + (STQ ,temp 0 (iSP) "Push Fixnum"))) + +;;; Pushes a constructed fixnum from 32 bit data in 2 cycles! +(defmacro stack-push-fixnum (data temp &optional comment) + (check-temporaries (data) (temp)) + `((stack-push-ir |TypeFixnum| ,data ,temp ,comment))) + +;;; Pushed NIL in 2 cycles. +(defmacro stack-push-nil (temp temp2 &optional comment) + (check-temporaries () (temp temp2)) + `((LDQ ,temp PROCESSORSTATE_NILADDRESS (ivory)) + (STQ ,temp 8 (iSP) "push the data") + (ADDQ iSP 8 iSP))) + +(defmacro stack-write-nil (vma temp temp2 &optional comment) + (check-temporaries (vma) (temp temp2)) + `((LDQ ,temp PROCESSORSTATE_NILADDRESS (ivory) ,@(if comment `(,comment))) + (STQ ,temp 0 (,vma) "push the data"))) + +(defmacro stack-push-t (temp temp2 &optional comment) + (check-temporaries () (temp temp2)) + `((LDQ ,temp PROCESSORSTATE_TADDRESS (ivory)) + (STQ ,temp 8 (iSP) "push the data") + (ADDQ iSP 8 iSP))) + +(defmacro stack-write-t (vma temp temp2 &optional comment) + (check-temporaries () (temp temp2)) + `((LDQ ,temp PROCESSORSTATE_TADDRESS (ivory) ,@(if comment `(,comment))) + (STQ ,temp 0 (,vma) "push the data"))) + +(defmacro stack-write-nil-and-push-nil (vma temp &optional comment) + (check-temporaries (vma) (temp)) + `((LDQ ,temp PROCESSORSTATE_NILADDRESS (ivory) ,@(if comment `(,comment))) + (STQ ,temp 0 (iSP)) + (STQ ,temp 8 (iSP) "push the data") + (ADDQ iSP 8 iSP))) + +(defmacro stack-set-cdr-code (asp code temp) + (check-temporaries (asp) (temp)) + `((LDL ,temp 4 (,asp) "get tag") + (AND ,temp #x3F ,temp) + (BIS ,temp ,(* 64 code) ,temp) + (STL ,temp 4 (,asp) "set tag"))) + +(defmacro get-nil (dest &optional comment) + `((LDQ ,dest PROCESSORSTATE_NILADDRESS (ivory) ,@(if comment `(,comment))))) + +(defmacro get-nil2 (tag data &optional comment) + `((LDL ,data PROCESSORSTATE_NILADDRESS (ivory)) + (LDL ,tag |PROCESSORSTATE_NILADDRESS+4| (ivory) ,@(if comment `(,comment))) + (EXTLL ,data 0 ,data))) + +(defmacro get-t (dest &optional comment) + `((LDQ ,dest PROCESSORSTATE_TADDRESS (ivory) ,@(if comment `(,comment))))) + +(defmacro get-t2 (tag data &optional comment) + `( + (LDL ,data PROCESSORSTATE_TADDRESS (ivory)) + (LDL ,tag |PROCESSORSTATE_TADDRESS+4| (ivory) ,@(if comment `(,comment))) + (EXTLL ,data 0 ,data))) + +;;; One of our callers (TAKE-POST-TRAP) needs to check for recursive stack overflows. +;;; Destroys the value in CR ... +(defmacro stack-overflow-p (cr no-overflow temp temp2 &optional overflow) + (let ((limit temp) + (sp cr)) + `((SRL ,cr 30 ,cr "Isolate trap mode") + (LDL ,limit PROCESSORSTATE_CSLIMIT (ivory) "Limit for emulator mode") + (LDL ,temp2 PROCESSORSTATE_CSEXTRALIMIT (ivory) "Limit for extra stack and higher modes") + (CMOVNE ,cr ,temp2 ,limit "Get the right limit for the current trap mode") + (EXTLL ,limit 0 ,limit "Might have been sign extended") + (SCAtoVMA iSP ,sp ,temp2) + (CMPLT ,sp ,limit ,temp2 "Check for overflow") + ,@(if no-overflow + `((branch-true ,temp2 ,no-overflow "Jump if no overflow")) + `((branch-false ,temp2 ,overflow "Jump if overflow")))))) + +(defmacro stack-overflow-check (cr done-label temp temp2) + `((comment "Check for stack overflow") + (stack-overflow-p ,cr ,done-label ,temp ,temp2 STACKOVERFLOW) + ,@(when done-label + `((external-branch STACKOVERFLOW "Take the trap"))))) + +(defmacro stack-fill (VMA SCA count temp temp2 temp3 temp4) + (check-temporaries (VMA SCA count) (temp temp2)) + (let ((l1 (gensym)) + (l2 (gensym))) + `((VM-Read ,vma ,temp ,temp2 ,temp3 ,temp4 t) ; read and prefetch + (BR zero ,l1) + (label ,l2) + (VM-Read ,vma ,temp ,temp2 ,temp3 ,temp4) + (SUBQ ,count 1 ,count) + (ADDQ ,vma 1 ,vma "advance vma position") + (stack-write2 ,sca ,temp ,temp2) + (ADDQ ,sca 8 ,sca "advance sca position") + (unlikely-label ,l1) + (BGT ,count ,l2)))) + +;; ARG indicates which stack pointer to look at -- generally iFP +(defmacro stack-cache-underflow-check (arg done-label underflow-routine + from to count stack-pointer + &rest regs-to-adjust) + (declare (ignore to regs-to-adjust)) + (let ((done (or done-label (gensym)))) + `((LDQ ,from PROCESSORSTATE_STACKCACHEDATA (ivory)) + (LDQ ,stack-pointer PROCESSORSTATE_RESTARTSP (ivory) "Preserve through instruction's original SP") + (SUBQ ,from ,arg ,count "Number of words*8 to fill iff positive") + (BLE ,count ,done) + (SRA ,count 3 ,count "Convert to a word count") + (ADDQ ,stack-pointer 8 ,stack-pointer "Account for the inclusive limit") + (BLE ,count ,done "in case only low three bits nonzero") + (BSR R0 ,underflow-routine) + ,(if done-label + `(BR zero ,done) + `(label ,done))))) + +(defmacro stack-cache-underflow-body (from to count stack-pointer + temp2 temp6 temp7 &rest regs-to-adjust) + (let ((temp stack-pointer) + (temp3 from) + (temp4 to) + (temp5 count)) + `((S8ADDQ ,count ,from ,to "Compute target address for shift") + (SUBQ ,stack-pointer ,from ,temp2 "Compute number of elements to preserve") + (SRA ,temp2 3 ,temp2 "Convert to word count") + (comment "Shove everything up") + (stack-block-copy ,from ,to ,temp2 nil t ,temp6 ,temp7) + (comment "Adjust stack cache relative registers") + (S8ADDQ ,count iFP iFP) + (LDQ ,temp PROCESSORSTATE_RESTARTSP (ivory)) + (S8ADDQ ,count iSP iSP) + (S8ADDQ ,count iLP iLP) + (S8ADDQ ,count ,temp ,temp) + ,@(loop for reg in regs-to-adjust + collect `(S8ADDQ ,count ,reg ,reg)) + (comment "Fill freshly opened slots of stack cache from memory") + (LDQ ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (LDQ ,to PROCESSORSTATE_STACKCACHEDATA (ivory)) + (STQ ,temp PROCESSORSTATE_RESTARTSP (ivory)) + (SUBQ ,from ,count ,from "Compute new base address of stack cache") + (LDQ ,temp PROCESSORSTATE_STACKCACHETOPVMA (ivory) "Top of cache") + (STQ ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (SUBQ ,temp ,count ,temp "Adjust top of cache") + (STQ ,temp PROCESSORSTATE_STACKCACHETOPVMA (ivory)) + (stack-fill ,from ,to ,count ,temp ,temp2 ,temp6 ,temp7) + (passthru "#ifdef TRACING") + (maybe-trace ,temp ,temp2 ,temp3 ,temp4 ,temp5 ,temp6) + (passthru "#endif")))) + +;;; Hand coded versions of stack-read2 and VM-Write to use fewer registers. +;;; We don't have to worry about the data cache as we're dumping from the +;;; stack cache which was never in the data cache in the first place. +;;; --- s/b in memoryem, so all memory code is in one place! +(defmacro stack-dump (VMA SCA count temp temp2) + (check-temporaries (VMA SCA count) (temp temp2)) + (let ((datal1 (gensym)) + (datal2 (gensym)) + (tagl1 (gensym)) + (tagl2 (gensym))) + `((STL ,count PROCESSORSTATE_SCOVDUMPCOUNT (ivory) "Will be destructively modified") + (ADDQ ,vma Ivory ,temp2 "Starting address of tags") + (S4ADDQ ,temp2 zero ,vma "Starting address of data") + (comment "Dump the data") + (FETCH 0 (,sca)) + (FETCH_M 0 (,vma)) + (BR zero ,datal1) + (label ,datal2) + (LDL ,temp 0 (,sca) "Get data word") + (SUBQ ,count 1 ,count) + (ADDQ ,sca 8 ,sca "Advance SCA position") + (STL ,temp 0 (,vma) "Save data word") + (ADDQ ,vma 4 ,vma "Advance VMA position") + (unlikely-label ,datal1) + (BGT ,count ,datal2) + (comment "Dump the tags") + (LDL ,count PROCESSORSTATE_SCOVDUMPCOUNT (ivory) "Restore the count") + (BIS zero ,temp2 ,vma "Restore tag VMA") + (SLL ,count 3 ,temp) + (SUBQ ,sca ,temp ,sca "Restore orginal SCA") + (FETCH 0 (,sca)) + (FETCH_M 0 (,vma)) + (BR zero ,tagl1) + (label ,tagl2) + (SUBQ ,count 1 ,count) + (LDL ,temp 4 (,sca) "Get tag word") + (ADDQ ,sca 8 ,sca "Advance SCA position") + (LDQ_U ,temp2 0 (,vma) "Get packed tags word") + (INSBL ,temp ,vma ,temp "Position the new tag") + (MSKBL ,temp2 ,vma ,temp2 "Remove old tag") + (BIS ,temp ,temp2 ,temp2 "Put in new byte") + (STQ_U ,temp2 0 (,vma) "Save packed tags word") + (ADDQ ,vma 1 ,vma "Advance VMA position") + (unlikely-label ,tagl1) + (BGT ,count ,tagl2) + ))) + +(defmacro stack-cache-overflow-check (temp temp2 temp3 temp4 temp5 + &optional + (sp 'iSP) + (nwords 0) + &aux + (handler '|StackCacheOverflowHandler|) + (handler-arg 'arg2)) + ;; don't need temp3, temp5 + (assert (eq sp 'iSP) () "That won't work") + (check-temporaries (sp handler-arg) (temp temp2 temp3 temp4 temp5)) + (let ((newSCA temp) + (oldSCA temp2) + (not-done (gensym))) + (unless (eq nwords handler-arg) + (push + `((label ,not-done) + (BIS zero ,nwords ,handler-arg) + (BR zero ,handler)) + *function-epilogue*)) + `(,@(unless *memoized-limit* + `((LDL ,temp4 PROCESSORSTATE_SCOVLIMIT (ivory) "Current stack cache limit (words)"))) + (load-constant ,newSCA ,(eval |stack$K-cachemargin|) "Must always have this much room") + (LDQ ,oldSCA PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + ,@(unless (eql nwords 0) + `((ADDQ ,newSCA ,nwords ,newSCA "Account for what we're about to push"))) + (S8ADDQ ,newSCA ,sp ,newSCA "SCA of desired end of cache") + (S8ADDQ ,(or *memoized-limit* temp4) ,oldSCA ,oldSCA "SCA of current end of cache") + (CMPLE ,newSCA ,oldSCA ,temp4) + ,@(if (eq nwords handler-arg) + `((branch-false ,temp4 ,handler "We're done if new SCA is within bounds")) + `((branch-false ,temp4 ,not-done "We're done if new SCA is within bounds"))) + ))) + +(defmacro stack-cache-overflow-handler (temp temp2 temp3 temp4 temp5 + &aux (sp 'iSP) (nwords 'arg2)) + (check-temporaries (sp nwords) (temp temp2 temp3 temp4 temp5)) + (let ((pagemissing 'PAGENOTRESIDENT) + (faultrequest 'PAGEFAULTREQUESTHANDLER) + (writefault 'PAGEWRITEFAULT) + ;; retry the instruction + (done 'INTERPRETINSTRUCTION) + (newsca temp) + (count temp) + (from temp2) + (to temp3)) + `((comment "Stack cache overflow detected") + ;; We add another margin (effectively scrolling) to avoid + ;; immediately overflowing again + (load-constant ,newSCA ,(eval (* |stack$K-cachemargin| 2))) + (ADDQ ,newSCA ,nwords ,newSCA "Account for what we're about to push") + (S8ADDQ ,newSCA iSP ,newSCA "SCA of desired end of cache") + ;; Restore the SP for retry + (LDQ iSP PROCESSORSTATE_RESTARTSP (ivory)) + (LDQ ,temp4 PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + (SUBQ ,newSCA ,temp4 ,temp4 "New limit*8") + (SRL ,temp4 3 ,temp4) + (STL ,temp4 PROCESSORSTATE_SCOVLIMIT (ivory) "Update stack cache limit") + (comment "Check that the page underlying the end of the stack cache is accessible") + (SCAtoVMA ,newSCA ,to ,temp4) + (check-access ,to ,temp4 ,temp5 ,pagemissing ,faultrequest ,writefault) + (comment "Check if we must dump the cache") + (LDL ,temp4 PROCESSORSTATE_SCOVLIMIT (ivory) "New stack cache limit (words)") + (LDQ ,temp5 PROCESSORSTATE_STACKCACHESIZE (ivory) "Absolute size of the cache (words)") + (CMPLE ,temp4 ,temp5 ,temp5) + (branch-true ,temp5 ,done "We're done if new limit is less than absolute limit") + (comment "Dump the stack cache to make room") + (load-constant ,count ,(eval |stack$K-cachedumpquantum|) "Always dump this amount") + (LDQ ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Stack cache base VMA") + (LDQ ,to PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + (stack-dump ,from ,to ,count ,temp4 ,temp5) + (load-constant ,count ,(eval |stack$K-cachedumpquantum|) "Always dump this amount") + (LDQ ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Stack cache base VMA") + (LDQ ,temp4 PROCESSORSTATE_STACKCACHETOPVMA (ivory) "Top of cache") + (LDL ,temp5 PROCESSORSTATE_SCOVLIMIT (ivory) "Cache limit in words") + (ADDQ ,from ,count ,from "Adjust cache base VMA") + (ADDQ ,temp4 ,count ,temp4 "Adjust top of cache") + (SUBQ ,temp5 ,count ,temp5 "Adjust limit") + (STQ ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Save update") + (STQ ,temp4 PROCESSORSTATE_STACKCACHETOPVMA (ivory)) + (STL ,temp5 PROCESSORSTATE_SCOVLIMIT (ivory)) + (comment "Move the cache down") + (LDQ ,to PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + (S8ADDQ ,count ,to ,from "SCA of first word of new base") + (stack-block-copy ,from ,to ,count nil nil ,temp4 ,temp5) + (comment "Adjust stack cache relative registers") + (load-constant ,count ,(eval |stack$K-cachedumpquantum|) "Always dump this amount") + (SLL ,count 3 ,count "Convert to SCA adjustment") + (SUBQ iSP ,count iSP) + (SUBQ iFP ,count iFP) + (SUBQ iLP ,count iLP) + ;; Store adjusted (restored) SP + (STQ iSP PROCESSORSTATE_RESTARTSP (ivory)) + (ContinueToInterpretInstruction)))) + +;;; This macro destructively advances count, from and to registers. +(defmacro stack-block-copy (from to count ccp upp temp temp2) + (check-temporaries (from to count) (temp temp2)) + (let ((l1 (gensym)) + (l2 (gensym))) + `(,@(when ccp + `((LDQ ,temp PROCESSORSTATE_CDRCODEMASK (ivory) "mask for CDR codes"))) + ,@(when upp + `((S8ADDQ ,count ,from ,from "Adjust to end of source block") + (S8ADDQ ,count ,to ,to "Adjust to end of target block"))) + (BR zero ,l1) + (label ,l2) + ,@(when upp + `((SUBQ ,from 8 ,from "advance from position"))) + (SUBQ ,count 1 ,count) + (stack-read ,from ,temp2 "Get a word from source") + ,@(when (not upp) + `((ADDQ ,from 8 ,from "advance from position"))) + ,@(when upp + `((SUBQ ,to 8 ,to "advance to position"))) + ,@(when ccp + `((BIC ,temp2 ,temp ,temp2 "Strip off CDR code"))) + (stack-write ,to ,temp2 "Put word in destination") + ,@(when (not upp) + `((ADDQ ,to 8 ,to "advance to position"))) + (unlikely-label ,l1) + (BGT ,count ,l2)))) + +;;; Fin. + diff --git a/assembler/alpha.lisp b/assembler/alpha.lisp new file mode 100644 index 0000000..6811a7e --- /dev/null +++ b/assembler/alpha.lisp @@ -0,0 +1,1295 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: Yes -*- + +(in-package "ALPHA-AXP-INTERNALS") + +;;; ALPHA Instructions From Instruction Encodings - Appendix C AARM +(eval-when (compile load eval) + +(defvar *instruction-database* (make-hash-table)) +(defvar *register-database* (make-hash-table)) + +(defun find-instruction (name) + (or (gethash name *instruction-database* ()) + (error "No such instruction ~A." name))) + +(defun find-register (name) + (gethash name *register-database* ())) + + +;;; Instructions + +(clos:defclass instruction () + ((name :initarg :name :reader instruction-name))) + +(clos:defmethod clos:initialize-instance :after ((inst instruction) &key &allow-other-keys) + (clos:with-slots (name) inst + (setf (gethash name *instruction-database*) inst))) + +(clos:defmethod clos:print-object ((inst instruction) stream) + (future-common-lisp:print-unreadable-object (inst stream :type t :identity t) + (princ (clos:slot-value inst 'name) stream))) + +(clos:defclass pseudo-instruction (instruction) + ((args :accessor pseudo-instruction-args))) + + +(clos:defclass alpha-instruction (instruction) + ((code :initarg :code :reader instruction-code) + (class :initarg :class :reader instruction-class))) + +(clos:defclass memory-format-instruction (alpha-instruction) + ()) + +(clos:defclass memory-format-extended-instruction (memory-format-instruction) + ((extended-code :initarg :extended-code :reader instruction-extended-code)) + (:default-initargs :code #x18)) + +(clos:defclass memory-format-branch-instruction (memory-format-instruction) + ((branchtype :initarg :branchtype :reader instruction-branchtype)) + (:default-initargs :code #x1A)) + +(clos:defclass branch-format-instruction (alpha-instruction) + ()) + +(clos:defclass operate-format-instruction (alpha-instruction) + ((function-code :initarg :function-code :reader instruction-function-code))) + +(clos:defclass FP-operate-format-instruction (operate-format-instruction) + () + (:default-initargs :code #x17)) + +(clos:defclass IEEE-FP-instruction (FP-operate-format-instruction) + () + (:default-initargs :code #x16)) + +(clos:defclass IEEE-FP2-instruction (IEEE-FP-instruction) + () + (:default-initargs :code #x16)) + +(clos:defclass VAX-FP-instruction (FP-operate-format-instruction) + () + (:default-initargs :code #x15)) + + +(clos:defclass miscellaneous-instruction (alpha-instruction) + ()) + +(clos:defclass fetch-instruction (alpha-instruction) + ()) + +(clos:defclass PAL-instruction (alpha-instruction) + ()) + +(clos:defclass unprivileged-openVMS-PAL-instruction (PAL-instruction) + ()) + +(clos:defclass priviliged-openVMS-PAL-instruction (PAL-instruction) + ()) + +(clos:defclass unpriviliged-OSF1-PAL-instruction (PAL-instruction) + ()) + +(clos:defclass priviliged-OSF1-PAL-instruction (PAL-instruction) + ()) + +(clos:defclass required-PAL-instruction (PAL-instruction) + ()) ;+++ unfinished + +(clos:defclass reserved-PAL-instructions (PAL-instruction) + ()) + +(clos:defclass reserved-digital-instructions (PAL-instruction) + ()) + + +;;; Instruction classes + +(defvar *instruction-class-names* + '(LD JSR IADDLOG SHIFTCM ICMP IMULL IMULQ FPOP FDIVS FDIVT)) + +;; First element of each entry is the consumer, and the rest of +;; the entry is the possible producers. In order, they are: +;; LD JSR IADDLOG SHIFTCM ICMP IMULL IMULQ FPOP FDIVS FDIVT +(defvar *instruction-classes* + '((LD 3 3 2 2 2 21 23 NIL NIL NIL) + ;; First value is for base, second for data + (ST 3 3 (2 0) (2 0) (2 0) (21 20) (23 22) 4 32 61) + (IBR 3 3 1 2 1 21 23 NIL NIL NIL) + (JSR 3 3 2 2 2 21 23 NIL NIL NIL) + (IADDLOG 3 3 1 2 2 21 23 NIL NIL NIL) + (SHIFTCM 3 3 1 2 2 21 23 NIL NIL NIL) + (ICMP 3 3 1 2 2 21 23 NIL NIL NIL) + ;; First is for data-dependency, second for execution + (IMULL 3 3 1 2 2 (21 19) (23 21) NIL NIL NIL) + (IMULQ 3 3 1 2 2 21 23 NIL NIL NIL) + (FBR 3 NIL NIL NIL NIL NIL NIL 6 34 63) + (FPOP 3 NIL NIL NIL NIL NIL NIL 6 34 63) + (FDIVS 3 NIL NIL NIL NIL NIL NIL 6 34 63) + ;; First is for data-dependency, second for execution + (FDIVT 3 NIL NIL NIL NIL NIL NIL 6 (34 30) (63 59)))) + +(defvar *instruction-box-alist* + '((LD Abox) (ST Abox) (IBR Ebox) (JSR Ebox) + (IADDLOG Ebox) (SHIFTCM Ebox) (ICMP Ebox) + (IMULL Ebox) (IMULQ Ebox) (FBR Fbox) + (FPOP Fbox) (FDIVS Fbox) (FDIVT Fbox))) + + +;;; Fill instruction table + +;; Memory format, LD (load) class +(loop for (name code) in '((LDG #x21) (LDQ #x29) (LDS #x22) + (LDL #x28) (LDQ_L #x2B) (LDT #x23) + (LDF #x20) (LDL_L #x2A) (LDQ_U #x0B)) + do (clos:make-instance 'memory-format-instruction + :name name :code code :class 'LD)) + +;; Memory format, IADDLOG (load) class +(loop for (name code) in '((LDA #x08) (LDAH #x09)) + do (clos:make-instance 'memory-format-instruction + :name name :code code :class 'IADDLOG)) + +;; Memory format, ST (store) class +;; If you change these, you must update dual-issue-p +(loop for (name code) in '((STG #x25) (STQ #x2D) (STS #x26) + (STL #x2C) (STQ_C #x2F) (STT #x27) + (STF #x24) (STL_C #x2E) (STQ_U #x0F)) + do (clos:make-instance 'memory-format-instruction + :name name :code code :class 'ST)) + +(loop for (name type) in '((JMP 0) (JSR 1) (RET 2) (JSR_COROUTINE 3)) + do (clos:make-instance 'memory-format-branch-instruction + :name name :branchtype type :class 'JSR)) + +;; Unconditional branches are in JSR class for issue/latency purposes +(loop for (name code) in '((BR #x30) (BSR #x34)) + do (clos:make-instance 'branch-format-instruction + :name name :code code :class 'JSR)) + +;; Integer conditional branches, IBR class +(loop for (name code) in '((BLBC #x38) (BLBS #x3C) + (BEQ #x39) (BLT #x3A) (BLE #x3B) + (BNE #x3D) (BGE #x3E) (BGT #x3F)) + do (clos:make-instance 'branch-format-instruction + :name name :code code :class 'IBR)) + +;; Floating point conditional branches, FBR class +(loop for (name code) in '((FBEQ #x31) (FBLT #x32) (FBLE #x33) + (FBNE #x35) (FBGE #x36) (FBGT #x37)) + do (clos:make-instance 'branch-format-instruction + :name name :code code :class 'FBR)) + +;; Class IADDLOG: addition/subtraction/logical operators +(loop for (name code function) in + '((ADDL #x10 #x00) (ADDL/V #x10 #x40) (ADDQ #x10 #x20) + (ADDQ/V #x10 #x60) (SUBL #x10 #x09) (SUBL/V #x10 #x49) + (SUBQ #x10 #x29) (SUBQ/V #x10 #x69) (S4ADDL #x10 #x02) + (S4ADDQ #x10 #x22) (S4SUBL #x10 #x0B) (S4SUBQ #x10 #x2B) + (S8ADDL #x10 #x12) (S8ADDQ #x10 #x32) (S8SUBL #x10 #x1B) + (S8SUBQ #x10 #x3B) (AND #x11 #x00) (BIC #x11 #x08) + (BIS #x11 #x20) (EQV #x11 #x48) (ORNOT #x11 #x28) + (XOR #x11 #x40)) + do (clos:make-instance 'operate-format-instruction + :name name :code code :function-code function :class 'IADDLOG)) + +;; Class SHIFTCM: integer shift instructions +(loop for (name code function) in + '((EXTBL #x12 #x06) (EXTLH #x12 #x6A) (EXTLL #x12 #x26) + (EXTQH #x12 #x7A) (EXTQL #x12 #x36) (EXTWH #x12 #x5A) + (EXTWL #x12 #x16) (INSBL #x12 #x0B) (INSLH #x12 #x67) + (INSLL #x12 #x2B) (INSQH #x12 #x77) (INSQL #x12 #x3B) + (INSWH #x12 #x57) (INSWL #x12 #x1B) (MSKBL #x12 #x02) + (MSKLH #x12 #x62) (MSKLL #x12 #x22) (MSKQH #x12 #x72) + (MSKQL #x12 #x32) (MSKWH #x12 #x52) (MSKWL #x12 #x12) + (SLL #x12 #x39) (SRA #x12 #x3C) (SRL #x12 #x34) + (ZAP #x12 #x30) (ZAPNOT #x12 #x31) (CMOVEQ #x11 #x24) + (CMOVLBC #x11 #x16) (CMOVLBS #x11 #x14) (CMOVGE #x11 #x46) + (CMOVGT #x11 #x66) (CMOVLE #x11 #x64) (CMOVLT #x11 #x44) + (CMOVNE #x11 #x26)) + do (clos:make-instance 'operate-format-instruction + :name name :code code :function-code function :class 'SHIFTCM)) + +;; Class ICMP: integer comparison +(loop for (name code function) in + '((CMPBGE #x10 #x0F) (CMPEQ #x10 #x2D) + (CMPLE #x10 #x6D) (CMPLT #x10 #x4D) + (CMPULE #x10 #x3D) (CMPULT #x10 #x1D)) + do (clos:make-instance 'operate-format-instruction + :name name :code code :function-code function :class 'ICMP)) + +;; Class IMULL: Integer multiply +(loop for (name code function) in '((MULL #x13 #x00) (MULL/V #x13 #x40)) + do (clos:make-instance 'operate-format-instruction + :name name :code code :function-code function :class 'IMULL)) + +;; Class IMULQ: Integer multiply, quadword +(loop for (name code function) in '((MULQ #x13 #x20) (MULQ/V #x13 #x60) (UMULH #x13 #x30)) + do (clos:make-instance 'operate-format-instruction + :name name :code code :function-code function :class 'IMULQ)) + +;; What classes are these in? +++ +(loop for (name function) in + '((CPYS #x020) (CPYSE #x022) (CPYSN #x021) (FCMOVEQ #x02A) + (FCMOVGE #x02D) (FCMOVGT #x02F) (FCMOVLE #x02E) (FCMOVLT #x02C) + (FCMOVNE #x02B) (MF_FPCR #x025) (MT_FPCR #x024) + (X64RATQUO #x00) (X64EXECTIMES #x00) (LIBMFLOOR #x00) + (LIBMCEIL #x00) (LIBMTRUNC #x00) (LIBMRINT #x00)) + do (clos:make-instance 'FP-operate-format-instruction + :name name :function-code function :class 'UNKNOWN)) + +(loop for (name function) in + '((ADDS #x080) (ADDS/C #x000) (ADDS/M #x040) (ADDS/D #x0c0) + (ADDS/U #x180) (ADDS/UC #x100) (ADDS/UM #x140) (ADDS/UD #x1C0) + (ADDT #x0A0) (ADDT/C #x020) (ADDT/M #x060) (ADDT/D #x0E0) + (ADDT/U #x1A0) (ADDT/UC #x120) (ADDT/UM #x160) (ADDT/UD #x1E0) + (CMPTEQ #x0A5) (CMPTLT #x0A6) (CMPTLE #x0A7) (CMPTUN #x0A4) + (MULS #x082) (MULS/C #x002) (MULS/M #x042) (MULS/D #x0C2) + (MULS/U #x182) (MULS/UC #x102) (MULS/UM #x142) (MULS/UD #x1C2) + (MULT #x0A2) (MULT/C #x022) (MULT/M #x062) (MULT/D #x0E2) + (MULT/U #x1A2) (MULT/UC #x122) (MULT/UM #x162) (MULT/UD #x1E2) + (SUBS #x081) (SUBS/C #x001) (SUBS/M #x041) (SUBS/D #x1c0) + (SUBS/U #x181) (SUBS/UC #x101) (SUBS/UM #x141) (SUBS/UD #x1C1) + (SUBT #x0A1) (SUBT/C #x021) (SUBT/M #x061) (SUBT/D #x0E1) + (SUBT/U #x1A1) (SUBT/UC #x121) (SUBT/UM #x161) (SUBT/UD #x1E1) + (ADDS/SU #x580) (ADDS/SUC #x500) (ADDS/SUM #x540) (ADDS/SUD #x5C0) + (ADDS/SUI #x780) (ADDS/SUIC #x700) (ADDS/SUIM #x740) (ADDS/SUID #x7C0) + (ADDT/SU #x5A0) (ADDT/SUC #x520) (ADDT/SUM #x560) (ADDT/SUD #x5E0) + (ADDT/SUI #x7A0) (ADDT/SUIC #x720) (ADDT/SUIM #x760) (ADDT/SUID #x7E0) + (CMPTEQ/SU #x5A5) (CMPTLT/SU #x5A6) (CMPTLE/SU #x5A7) (CMPTUN/SU #x5A4) + (MULS/SU #x582) (MULS/SUC #x502) (MULS/SUM #x542) (MULS/SUD #x5C2) + (MULS/SUI #x7A2) (MULS/SUIC #x722) (MULS/SUIM #x762) (MULS/SUID #x7E2) + (MULT/SU #x5A2) (MULT/SUC #x522) (MULT/SUM #x562) (MULT/SUD #x5E2) + (MULT/SUI #x7A2) (MULT/SUIC #x722) (MULT/SUIM #x762) (MULT/SUID #x7E2) + (SUBS/SU #x581) (SUBS/SUC #x501) (SUBS/SUM #x541) (SUBS/SUD #x5C1) + (SUBS/SUI #x781) (SUBS/SUIC #x701) (SUBS/SUIM #x741) (SUBS/SUID #x7C1) + (SUBT/SU #x5A1) (SUBT/SUC #x521) (SUBT/SUM #x561) (SUBT/SUD #x5E1) + (SUBT/SUI #x7A1) (SUBT/SUIC #x721) (SUBT/SUIM #x761) (SUBT/SUID #x7E1)) + do (clos:make-instance 'IEEE-FP-instruction + :name name :function-code function :class 'FPOP)) + +(loop for (name function) in ;2 operand instructions handled specially + '((CVTLQ #x010) (CVTQL #x030) (CVTQL/SV #x530) (CVTQL/V #x130) + (CVTQS #x0BC) (CVTQS/C #x03C) (CVTQS/M #x07C) (CVTQS/D #x0FC) + (CVTQT #x0BE) (CVTQT/C #x03E) (CVTQT/M #x07E) (CVTQT/D #x0FE) + (CVTTS #x0AC) (CVTTS/C #x02C) (CVTTS/M #x06C) (CVTTS/D #x0EC) + (CVTTS/U #x1AC) (CVTTS/UC #x12C) (CVTTS/UM #x16C) (CVTTS/UD #x1EC) + (CVTQS/SUI #x7BC) (CVTQS/SUIC #x73C) (CVTQS/SUIM #x77C) (CVTQS/SUID #x7FC) + (CVTQT/SUI #x7BE) (CVTQT/SUIC #x73E) (CVTQT/SUIM #x77E) (CVTQT/SUID #x7FE) + (CVTTS/SU #x5Ac) (CVTTS/SUC #x52C) (CVTTS/SUM #x56C) (CVTTS/SUD #x5EC) + (CVTTS/SUI #x7AC) (CVTTS/SUIC #x72C) (CVTTS/SUIM #x76C) (CVTTS/SUID #x7EC) + (CVTTQ #x0AF) (CVTTQ/C #x02F) (CVTTQ/V #x1AF) (CVTTQ/VC #x12F) + (CVTTQ/SV #x5AF) (CVTTQ/SVC #x52F) (CVTTQ/SVI #x7AF) (CVTTQ/SVIC #x72F) + (CVTTQ/D #x0EF) (CVTTQ/VD #x1EF) (CVTTQ/SVD #x5EF) (CVTTQ/SVID #x7EF) + (CVTTQ/M #x06F) (CVTTQ/VM #x16F) (CVTTQ/SVM #x56F) (CVTTQ/SVIM #x76F)) + do (clos:make-instance 'IEEE-FP2-instruction + :name name :function-code function :class 'FPOP)) + +(loop for (name function) in + '((DIVS #x083) (DIVS/C #x003) (DIVS/M #x043) (DIVS/D #x0C3) + (DIVS/U #x183) (DIVS/UC #x103) (DIVS/UM #x143) (DIVS/UD #x1C3) + (DIVS/SU #x583) (DIVS/SUC #x503) (DIVS/SUM #x543) (DIVS/SUD #x5C3) + (DIVS/SUI #x783) (DIVS/SUIC #x703) (DIVS/SUIM #x743) (DIVS/SUID #x7C3)) + do (clos:make-instance 'IEEE-FP-instruction + :name name :function-code function :class 'FDIVS)) + +(loop for (name function) in + '((DIVT #x0A3) (DIVT/C #x023) (DIVT/M #x063) (DIVT/D #x0E3) + (DIVT/U #x1A3) (DIVT/UC #x123) (DIVT/UM #x163) (DIVT/UD #x1E3) + (DIVT/SU #x5A3) (DIVT/SUC #x523) (DIVT/SUM #x563) (DIVT/SUD #x5E3) + (DIVT/SUI #x7A3) (DIVT/SUIC #x723) (DIVT/SUIM #x763) (DIVT/SUID #x7E3)) + do (clos:make-instance 'IEEE-FP-instruction + :name name :function-code function :class 'FDIVT)) + +#|| +;;; *VAX-Floating-Point-Instructions* + '( + ;; None /C /U /UC /S /SC /SU /SUC + (ADDF #x080 #x000 #x180 #x100 #x480 #x400 #x580 #x500) + (CVTDG #x09E #x01E #x19E #x11E #x49E #x41E #x59E #x51E) + (ADDG #x0A0 #x020 #x1A0 #x120 #x4A0 #x420 #x5A0 #x520) + (CMPGEQ #x0A5 -1 -1 -1 #x4A5) + (CMPGLT #x0A6 -1 -1 -1 #x4A6) + (CMPGLE #x0A7 -1 -1 -1 #x4A7) + (CVTGF #x0AC #x02C #x1AC #x12C #x4AC #x42C #x5AC #x52C) + (CVTGD #x0AD #x02D #x1AD #x12D #x4AD #x42D #x5AD #x52D) + (CVTQF #x0BC #x03C) + (CVTQG #x0BE #x03E) + (DIVF #x083 #x003 #x183 #x103 #x483 #x403 #x583 #x503) + (DIVG #x0A3 #x023 #x1A3 #x123 #x4A3 #x423 #x5A3 #x523) + (MULF #x082 #x002 #x182 #x102 #x482 #x402 #x582 #x502) + (MULG #x0A2 #x022 #x1A2 #x122 #x4A2 #x422 #x5A2 #x522) + (SUBF #x081 #x001 #x181 #x101 #x481 #x401 #x581 #x501) + (SUBG #x0A1 #x021 #x1A1 #x121 #x4A1 #x421 #x5A1 #x521) + ;; None /C /V /VC /S /SC /SV /SVC + (CVTGQ #x0AF #x02F #x1AF #x12F #x4AF #x42F #x5AF #x52F)) +||# + +;; Miscellaneous instructions +;; These appear to be in the LD class for issue/latency +(loop for (name code) in '((RC #xE000) (RPCC #xC000) (MB #x4000) (RS #xF000)) + do (clos:make-instance 'miscellaneous-instruction + :name name :code code :class 'LD)) + +;; The theory is that this is like a ST-class for issue/latency +(loop for (name code) in '((TRAPB #x0000)) ;--- EXCB? + do (clos:make-instance 'miscellaneous-instruction + :name name :code code :class 'ST)) + +;; These appear to be in the LD class, but poor info... +(loop for (name code) in '((FETCH #x8000) (FETCH_M #xA000)) + do (clos:make-instance 'fetch-instruction + :name name :code code :class 'LD)) + +(loop for (name code) in '((AMOVRM #x00A1) (AMOVRR #x00A0) (BPT #x0080) (BUGCHK #x0081) + (CHME #x0082) (CHMK #x0083) (CHMS #x0084) (CHMU #x0085) + (GENTRAP #x00AA) (IMB #x0086) + (INSQHIL #x0087) (INSQHILR #x00A2) + (INSQHIQ #x0089) (INSQHIQR #x00A4) (INSQTIL #x0088) + (INSQTILR #x00A3) (INSQTIQ #x008A) (INSQTIQR #x00A5) + (INSQUEL #x008B) (INSQUEL/D #x008D) (INSQUEQ #x008C) + (INSQUQ/D #x008E) (PROBER #x008F) (PROBEW #x0090) (RD_PS #x0091) + (READ_UNQ #x009E) (REI #x0092) + (REMQHIL #x0093) (REMQHILR #x00A6) + (REMQHIQ #x0095) (REMQHIQR #x00A8) (REMQTIL #x0094) + (REMQTILR #x00A7) (REMQTIQ #x0096) (REMQTIQR #x00A9) + (REMQUEL #x0097) (REMQUEL/D #x0099) (REMQUEQ #x0098) + (REMQUEQ/D #x009A) (RSCC #x009D) (SWASTEN #x009B) + (WRITE_UNQ #x009F) (WR_PS_SW #x009C)) + do (clos:make-instance 'unprivileged-openVMS-PAL-instruction + :name name :code code :class 'PAL)) + +(loop for (name code) in '((CFLUSH #x0001) (DRAINA #x0002) (HALT #x0000) (LDQP #x0003) + (MFPR_ASN #x0006) (MFPR_ASTEN #x0026) (MFPR_ASTSR #x0027) + (MFPR_ESP #x001E) (MFPR_FEN #x000B) (MFPR_IPL #x000E) + (MFPR_MCES #x0010) (MFPR_PCBB #x0012) (MFPR_PRBR #x0013) + (MFPR_PTBR #x0015) (MFPR_SCBB #x0016) (MFPR_SISR #x0019) + (MFPR_SSP #x0020) (MFPR_TBCHK #x001A) (MFPR_USP #x0022) + (MFPR_VPTB #x0029) (MFPR_WHAMI #x003F) (MTPR_ASTEN #x0007) + (MTPR_ASTSR #x0008) (MTPR_DATFX #x002E) (MTPR_ESP #x001F) + (MTPR_FEN #x000C) (MTPR_IPIR #x000D) (MTPR_IPL #x000F) + (MTPR_MCES #x0011) (MTPR_PERFMON #x002B) (MTPR_PRBR #x0014) + (MTPR_SCBB #x0017) (MTPR_SIRR #x0018) (MTPR_SSP #x0021) + (MTPR_TBIA #x001B) (MTPR_TBIAP #x001C) (MTPR_TBIS #x001D) + (MTPR_TBISD #x0024) (MTPR_TBISI #x0025) (MTPR_USP #x0023) + (MTPR_VPTB #x002A) (STQP #x0004) (SWPCTX #x0005) + (unused1 #x0009) (unused2 #x000A)) + do (clos:make-instance 'priviliged-openVMS-PAL-instruction + :name name :code code :class 'PAL)) + +(loop for (name code) in '((BPT #x0080) (BUGCHK #x0081) (CALLSYS #x0083) (GENTRAP #x00AA) + (IMB #x0086) (RDUNIQUE #x009E) (WRUNIQUE #x009F)) + do (clos:make-instance 'unpriviliged-OSF1-PAL-instruction + :name name :code code :class 'PAL)) + +(loop for (name code) in '((HALT #x0000) (RDPS #x0036) (RDUSP #x003A) (RDVAL #x0032) + (RETSYS #x003D) (RTI #x003F) (SWPCTX #x0030) (SWPIPL #x0035) + (TBI #x0033) (WHAMI #x003C) (WRENT #x0034) (WRFEN #x002B) + (WRKGP #x0037) (WRUSP #x0038) (WRVAL #x0031) (WRVPTPTR #x002D)) + do (clos:make-instance 'priviliged-OSF1-PAL-instruction + :name name :code code :class 'PAL)) + +#|| +;;; *Required-PALcode-Instructions* + '((DRAINA P #x00 #x0002) + (HALT P #x00 #x0000) + (IMB U #x00 #x0086)) +||# + +(loop for (name code) in '((PAL19 #x19) (PAL1B #x1B) (PAL1D #x1D) (PAL1E #x1E) (PAL1F #x1F)) + do (clos:make-instance 'reserved-PAL-instructions + :name name :code code :class 'PAL)) + +(loop for (name code) in '((OPC01 #x01) (OPC02 #x02) (OPC03 #x03) (OPC04 #x04) (OPC05 #x05) + (OPC06 #x06) (OPC07 #x07) (OPC0A #x0A) (OPC0C #x0C) (OPC0D #x0D) + (OPC0E #x0E) (OPC14 #x14) (OPC1C #x1C)) + do (clos:make-instance 'reserved-digital-instructions + :name name :code code :class 'RESERVED)) + + +;;; Registers + +(clos:defclass register () + ((name :initarg :name :reader register-name) + (code :initarg :code :reader register-code) + (asmname :initarg :asmname :reader register-asmname))) + +(clos:defmethod clos:print-object ((reg register) stream) + (future-common-lisp:print-unreadable-object (reg stream :type t :identity t) + (princ (clos:slot-value reg 'name) stream))) + + +(clos:defclass alpha-register (register) ()) + +(clos:defclass integer-alpha-register (alpha-register) ()) + +(clos:defclass FP-alpha-register (alpha-register) ()) + +(clos:defmethod clos:initialize-instance :after ((reg register) &key &allow-other-keys) + (clos:with-slots (name) reg + (setf (gethash name *register-database*) reg))) + +(loop for (name code aname) in + '((r0 0 $0) (r1 1 $1) (r2 2 $2) (r3 3 $3) (r4 4 $4) (r5 5 $5) (r6 6 $6) (r7 7 $7) + (r8 8 $8) (r9 9 $9) (r10 10 $10) (r11 11 $11) (r12 12 $12) (r13 13 $13) + (r14 14 $14) (r15 15 $15) + (r16 16 $16) (r17 17 $17) (r18 18 $18) (r19 19 $19) (r20 20 $20) (r21 21 $21) + (r22 22 $22) (r23 23 $23) + (r24 24 $24) (r25 25 $25) (r26 26 $26) (r27 27 $27) (r28 28 $28) (r29 29 $29) + (r30 30 $30) (r31 31 $31) + (at 28 |$at|) (gp 29 |$gp|) (sp 30 |$sp|) (zero 31 $31)) + do (clos:make-instance 'integer-alpha-register :name name :code code :asmname aname)) + +(defun register-number (reg) + (cond ((numberp reg) reg) + ((symbolp reg) (register-code (find-register reg))) + ((consp reg) (register-code (find-register (car reg)))) + (:otherwise (error "~a is not a valid register designator.")))) + +(defmacro define-integer-register + (name reg &optional (printas (intern (format nil "$~a" + (register-number reg) + (find-package "ALPHA-AXP-INTERNALS"))))) + `(clos:make-instance 'integer-alpha-register + :name ',name + :code ,(register-number reg) + :asmname ',printas)) + +(loop for (name code aname) in + '((f0 0 |$f0|) (f1 1 |$f1|) (f2 2 |$f2|) (f3 3 |$f3|) (f4 4 |$f4|) (f5 5 |$f5|) + (f6 6 |$f6|) (f7 7 |$f7|) + (f8 8 |$f8|) (f9 9 |$f9|) (f10 10 |$f10|) (f11 11 |$f11|) (f12 12 |$f12|) + (f13 13 |$f13|) (f14 14 |$f14|) (f15 15 |$f15|) + (f16 16 |$f16|) (f17 17 |$f17|) (f18 18 |$f18|) (f19 19 |$f19|) (f20 20 |$f20|) + (f21 21 |$f21|) (f22 22 |$f22|) (f23 23 |$f23|) + (f24 24 |$f24|) (f25 25 |$f25|) (f26 26 |$f26|) (f27 27 |$f27|) (f28 28 |$f28|) + (f29 29 |$f29|) (f30 30 |$f30|) (f31 31 |$f31|) + (|DoubleFloatExc| 32 |DoubleFloatExc|)) + do (clos:make-instance 'FP-alpha-register :name name :code code :asmname aname)) + +) ;eval-when + + +;;; Pseudo operations + +(loop for name in '(start end mark + label unlikely-label external-branch call-subroutine + comment include passthru) + do (clos:make-instance 'pseudo-instruction :name name)) + + + +;;; Assembler emitter + +(defvar *instruction-counter*) +(defvar *n-previous-instructions* 24.) +(defvar *previous-instructions*) +(defvar *last-instruction*) +(defvar *func-name* nil) +(defvar *block-name* nil) + +;;; emit-operation takes an operation and emits the representation of the operation if any. +;;; the operation may be a pseudo operation and so may not emit anything at all, or may +;;; emit a lot. It may emit instructions asembler directives comments or any combination +;;; thereof. + +(clos:defgeneric emit-operation (operation &optional destination args)) + +(clos:defmethod emit-operation ((operation list) &optional (destination nil) (args nil)) + (let ((instruction (find-instruction (car operation)))) + (assert (null args)) + (emit-operation instruction destination (cdr operation)))) + +(clos:defmethod emit-operation :after ((operation alpha-instruction) + &optional destination args) + (declare (ignore destination args)) + (incf *instruction-counter*)) + +(clos:defmethod emit-operation :after ((operation instruction) + &optional destination args) + (declare (ignore destination args)) + (setq *last-instruction* operation)) + +(clos:defmethod push-operation + ((operation alpha-instruction) reads writes cycles) + ;; Prepare the previous instruction stack for a new entry + (replace *previous-instructions* *previous-instructions* + :start1 1 :end1 (- *n-previous-instructions* 1) + :start2 0 :end2 (- *n-previous-instructions* 2)) + ;; Set it + (setf (aref *previous-instructions* 0) (list operation reads writes cycles))) + +;; The idea here is that we have to spend at least one cycle on the current +;; instruction (unless is was dual-issued), plus zero or more latent cycles +;; if there a register dependencies or instruction class dependencies. +(clos:defmethod compute-cycle-count + ((operation alpha-instruction) reads writes &optional indexreg) + #+Genera (declare (values cycles dual-issue)) + ;; ST class instructions take a 2-cycle stall if the index was + ;; produced by the previous instruction, otherwise they are free. + ;; Only ST class instructions pass in indexreg + (let* ((consumer-class (instruction-class operation)) + (latencies (cdr (assoc consumer-class *instruction-classes*))) + (cycles 1) + (cycles-so-far 0) + (dual-issue nil) + (dual-issue-permitted (oddp *instruction-counter*))) + (cond ((lisp:and (eql (instruction-name operation) 'BIS) + (every #'(lambda (x) (eql x '$31)) reads) + (every #'(lambda (x) (eql x '$31)) writes)) + (setq cycles 0)) + (latencies + (dotimes (i *n-previous-instructions*) + (let ((producer (aref *previous-instructions* i))) + (destructuring-bind (&optional producer preads pwrites pcycles) producer + (when (null producer) (return)) + (let* ((producer-class (instruction-class producer)) + (pcn (position producer-class *instruction-class-names*)) + (latency (lisp:and pcn (nth pcn latencies))) + (data-dependent (if indexreg + (member indexreg pwrites) + ;; Kludge for TRAPB/EXCB + (or (member :all reads) + (intersection-p reads pwrites))))) + (unless (or data-dependent (consp latency)) + (setq latency nil)) + (if (consp latency) + (if data-dependent + (setq latency (first latency)) + (setq latency (second latency)))) + (when (lisp:and (zerop i) + (if indexreg + (not (member indexreg pwrites)) + (lisp:and + (not (intersection-p reads pwrites)) + (not (intersection-p writes pwrites)) + ;; --- this may be + ;; overconservative, the + ;; comments indicate read/write + ;; can dual issue in some cases + (not (intersection-p writes preads)))) + (dual-issue-p operation producer)) + (setq dual-issue t)) + (when latency + (setq cycles (max (- latency + (if (lisp:and dual-issue-permitted dual-issue) + (1- cycles-so-far) + cycles-so-far)) + cycles)))) + (incf cycles-so-far pcycles)))))) + ;;+++ If we couldn't find latencies, we return a cycle count of 1 + (if dual-issue + (if dual-issue-permitted + (values (1- cycles) "di") + (values cycles "-")) + (values cycles "")))) + +(defun intersection-p (list1 list2) + (dolist (l list1 nil) + (when (member l list2) + (return t)))) + +;; We can only dual issue when the instruction counter is odd (second half of +;; a quadword), but that gets checked at a higher level... +(defun dual-issue-p (op1 op2) + (let ((op1-name (instruction-name op1)) + (op1-class (instruction-class op1)) + (op2-name (instruction-name op2)) + (op2-class (instruction-class op2))) + (flet ((dual-issue (name1 class1 name2 class2) + (lisp:and (or (member class1 '(LD FBR IADDLOG SHIFTCM ICMP IMULL IMULQ)) + ;; Only floating stores in instruction 1 + (member name1 '(STF STG STS STT))) + (or (member class2 '(LD IBR FPOP FDIVS FDIVT JSR PAL)) + ;; Only integer stores in instruction 2 + (member name2 '(STL STQ STL_C STQ_C STQ_U))) + (not (or (lisp:and (member class1 '(LD ST JSR)) + (member class2 '(LD ST JSR))) + (lisp:and (member class1 '(JSR IBR FBR)) + (member class2 '(JSR IBR FBR)))))))) + (or (dual-issue op1-name op1-class op2-name op2-class) + (dual-issue op2-name op2-class op1-name op1-class))))) + +(defparameter *for-vms* nil) +(defun instruction-pname (name) + (if *for-vms* + (symbol-name name) + (delete #\/ (string-downcase (symbol-name name))))) + +(clos:defmethod emit-operation ((operation memory-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name class) operation + (destructuring-bind (reg disp index &optional comment) args + (let* ((thereg (coerce-to-register reg)) + (indexreg (coerce-to-register index)) + (reads (cond ((member class '(LD IADDLOG)) (list indexreg)) + ((eql class 'ST) (list thereg)) + (t (list indexreg thereg)))) + (writes (if (member class '(LD IADDLOG)) (list thereg) nil))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes (lisp:and (eql class 'ST) indexreg)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a, " thereg) + (format destination "~a" (coerce-to-displacement disp)) + (unless (= (register-number index) 31) (format destination "(~a)" indexreg)) + (format destination " # ~@[~a~] ~@[[~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + cycles))))) + +(clos:defmethod emit-operation ((operation memory-format-branch-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (reg index hint &optional comment) args + (let* ((thereg (coerce-to-register reg)) + (indexreg (coerce-to-register index)) + (reads (list indexreg)) + (writes (list thereg))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a, " thereg) + (format destination "(~a), " indexreg) + (format destination "~a" hint) + (format destination " #~@[ ~a~]~@[ [~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + cycles))))) + +(clos:defmethod emit-operation ((operation branch-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (reg disp &optional comment) args + (let* ((thereg (coerce-to-register reg)) + (reads (list thereg)) + (writes nil)) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a, " thereg) + (format destination "~a" disp) + (format destination " #~@[ ~a~]~@[ [~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + (when (lisp:and (eql (instruction-name operation) 'BR) + (typep *last-instruction* 'pseudo-instruction) + (or (eql (instruction-name *last-instruction*) 'label) + (eql (instruction-name *last-instruction*) 'unlikely-label))) + (warn "The label ~A in ~S branches unconditionally to ~A" + (first (pseudo-instruction-args *last-instruction*)) + *block-name* disp)) + cycles))))) + +(clos:defmethod emit-operation ((operation operate-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (let* ((thereg (coerce-to-register reg1)) + (theop2 (coerce-to-register-or-literal op2)) + (thedest (coerce-to-register destreg)) + (reads (list thereg theop2)) + (writes (list thedest))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a, " thereg) + (format destination "~a, " theop2) + (format destination "~a " thedest) + (format destination " #~@[ ~a~]~@[ [~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + cycles))))) + +(clos:defmethod emit-operation ((operation FP-operate-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (let* ((thereg (coerce-to-register reg1)) + (theop2 (coerce-to-register op2)) + (thedest (coerce-to-register destreg)) + (reads (list thereg theop2)) + (writes (list thedest))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a, " thereg) + (format destination "~a, " theop2) + (format destination "~a " thedest) + (format destination " #~@[ ~a~]~@[ [~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + cycles))))) + +(clos:defmethod emit-operation ((operation IEEE-FP-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (let* ((thereg (coerce-to-register reg1)) + (theop2 (coerce-to-register-or-literal op2)) + (thedest (coerce-to-register destreg)) + (reads (list thereg theop2)) + (writes (list thedest))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a, " thereg) + (format destination "~a, " theop2) + (format destination "~a " thedest) + (format destination " #~@[ ~a~]~@[ [~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + cycles))))) + +(clos:defmethod emit-operation ((operation IEEE-FP2-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (let* ((thereg (coerce-to-register reg1)) + (theop2 (coerce-to-register-or-literal op2)) + (thedest (coerce-to-register destreg)) + (reads (list thereg theop2)) + (writes (list thedest))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a, " theop2) + (format destination "~a " thedest) + (format destination " #~@[ ~a~]~@[ [~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + cycles))))) + +(clos:defmethod emit-operation ((operation miscellaneous-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (&optional arg comment) args + (when (stringp arg) (shiftf comment arg nil)) + (when arg (setq arg (coerce-to-register arg))) + ;; for the purposes of TRAPB/EXCB, we consider all registers to be + ;; read + (let ((reads (if (member name '(trapb excb)) '(:all) nil))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads nil) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~@[~a~] " arg) + (format destination " # ~@[~a~] ~@[[~a~a]~]" comment cycles dual-issue) + (push-operation operation nil nil 0) + cycles))))) + +(clos:defmethod emit-operation ((operation fetch-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name class) operation + (destructuring-bind (disp index &optional comment) args + (let* ((indexreg (coerce-to-register index)) + (reads (list indexreg)) + (writes nil)) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes nil) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a" (coerce-to-displacement disp)) + (unless (= (register-number index) 31) (format destination "(~a)" indexreg)) + (format destination " # ~@[~a~] ~@[[~a~a]~]" comment cycles dual-issue) + (push-operation operation reads writes cycles) + cycles))))) + +(clos:defmethod emit-operation ((operation PAL-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (&optional comment) args + (format destination "~& ~a " (instruction-pname name)) + (format destination " #~@[ ~a~]" comment) + (push-operation operation nil nil 0) + 0))) + +;; The label alignment is 3 because branching to a label in the odd half +;; of a quadword take several stalls. +(defparameter *label-alignment* 3) + +;; The function alignment is 3 so that calling into a new procedure +;; causes all a large number of the instructions following the initial +;; instruction to be read into the cache. +(defparameter *function-alignment* 5) + +(clos:defmethod emit-operation ((operation pseudo-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (setf (pseudo-instruction-args operation) args) + (case name + (start + (destructuring-bind (func &optional (nargs 0)) args + (setq *func-name* func + *block-name* func) + (format destination "~&.align ~D" *function-alignment*) + (setq *instruction-counter* (logand (+ *instruction-counter* 1) -2)) + (format destination "~&.globl ~A" func) + (format destination "~&.ent ~A ~A" func nargs))) + (end + (destructuring-bind (func &optional comment) args + (assert (string= *func-name* func) () "Mis-matched START/END") + (unless (null comment) (format destination " # ~a" comment)) + (when *block-name* + (format destination "~&.end ~A" (shiftf *block-name* nil))) + (setq *func-name* nil))) + (mark + (destructuring-bind (markname &optional comment) args + (when *block-name* + (format destination "~&.end ~A" *block-name*)) + (format destination "~&.align ~D" *label-alignment*) + (setq *instruction-counter* (logand (+ *instruction-counter* 1) -2)) + (format destination "~&.ent ~A" (setq *block-name* markname)) + (unless (null comment) (format destination " # ~a" comment)))) + (label + (destructuring-bind (labelname &optional comment) args + (format destination "~&.align ~D" *label-alignment*) + (setq *instruction-counter* (logand (+ *instruction-counter* 1) -2)) + (format destination "~&~a:" labelname) + (unless (null comment) (format destination " # ~a" comment)))) + (unlikely-label + (destructuring-bind (labelname &optional comment) args + ;; Unlikely labels stay unaligned + (format destination "~&~a:" labelname) + (unless (null comment) (format destination " # ~a" comment)))) + (external-branch + (destructuring-bind (labelname &optional comment) args + (format destination "~& br $31, ~A" labelname) + (unless (null comment) (format destination " # ~a" comment)))) + (call-subroutine + (destructuring-bind (linkage labelname &optional comment) args + (format destination "~& bsr ~A, ~A" + (coerce-to-register linkage) + labelname) + (unless (null comment) (format destination " # ~a" comment)))) + (comment + (destructuring-bind (&optional comment) args + (unless (null comment) (format destination "~&/* ~a */" comment)))) + (include + (destructuring-bind (includefile) args + (load includefile :verbose t))) + (passthru + (destructuring-bind (astring &optional comment) args + (format destination "~&~a" astring) + (unless (null comment) (format destination " # ~a" comment)))) + (otherwise + (error "Unimplemented pseudo operation ~a." name))) + 0)) + +(clos:defgeneric coerce-to-register (register)) + +(clos:defmethod coerce-to-register ((register symbol)) + (let ((aregister (find-register register))) + (if (null aregister) (error "Register named ~A not found." register)) + (coerce-to-register aregister))) + +(clos:defmethod coerce-to-register ((register cons)) + (coerce-to-register (car register))) + +(clos:defmethod coerce-to-register ((register register)) + (clos:with-slots (asmname) register + asmname)) + +(defun coerce-to-register-or-literal (datum) + (if (numberp datum) + datum + (if (find-register datum) + (coerce-to-register datum) + datum))) + + +(clos:defgeneric coerce-to-displacement (displacement)) + +(clos:defmethod coerce-to-displacement ((displacement fixnum)) displacement) + +(clos:defmethod coerce-to-displacement ((displacement symbol)) displacement) + + +(defun asm-header (destination sourcename) + (format destination + "~&/************************************************************************") + (format destination + "~& * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED") + (format destination + "~& * FROM ~a. ANY CHANGES MADE TO THIS FILE WILL BE LOST" sourcename) + (format destination + "~& ************************************************************************/~%~%")) + +(defun asm-trailer (destination sourcename) + (format destination + "~%~%~%/* End of file automatically generated from ~a */~%" sourcename)) + +(defvar *function-being-processed* nil) +(defvar *function-epilogue*) + +(defun collecting-function-epilogue (body env) + (let ((*function-epilogue* nil)) + `(,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body) + ,@(loop while *function-epilogue* + append (mapcar #'(lambda (x) (macroexpand-asm-form x env)) + (shiftf *function-epilogue* nil)))))) + +;;; Loop through the asm source file and emit the instructions expanding any macros found +;;; along the way. +(defun process-asm-source (sourcefilename targetname) + (with-open-file (sfs sourcefilename :direction :input) + (with-open-file (tfs targetname :direction :output + #-Genera :if-exists #-Genera :supersede) + (let ((*package* (find-package "ALPHA-AXP-INTERNALS")) + (*read-base* 10) + (*print-base* 10) + (*previous-instructions* + (make-array *n-previous-instructions* :initial-element nil)) + (*last-instruction* nil) + (*instruction-counter* 0) + (*function-being-processed* nil) + (*func-name* nil) + (*block-name* nil)) + (asm-header tfs sourcefilename) + (do ((form (read sfs nil :eof) (read sfs nil :eof))) + ((eq form :eof) nil) + (when (consp form) + (process-asm-form form tfs))) + (asm-trailer tfs sourcefilename))))) + +;;; PROCESS-ASM-FORM handles the expansion of assembler macros. An +;;; assembler macro expands into a list of assembler operations any one of +;;; these may also be a macro The result of this loop is the linearization +;;; of assembler macros. +(defun process-asm-form (form destination &optional env) + (if (consp (first form)) + (loop for meform in form + summing (process-asm-form meform destination env)) + (let ((expanded (macroexpand form env))) + (if (eq expanded form) + (emit-operation form destination) + (loop for meform in expanded + summing (process-asm-form meform destination env)))))) + +;;; Like MACROEXPAND. Some macros might require this. It's needed because +;;; the evaluation semantics of our little assembler are not so hot. +(defun macroexpand-asm-form (form &optional env) + (if (consp (first form)) + (loop for meform in form + as expanded = (macroexpand-asm-form meform env) + if (consp (first expanded)) + append expanded + else + collect expanded) + (let ((expanded (macroexpand form env))) + (if (eq expanded form) + form + (macroexpand-asm-form expanded env))))) + +#+Genera +(in-package "ZWEI") + +#+Genera +(defcom com-alpha-assemble-region + "Assemble the region, putting output in the typeout window. +With a numeric argument, inserts the typeout into the buffer" () + (let ((ncycles 0) + nwords) + (definition-region-bps (sbp ebp) + (with-undo-save-if (and *numeric-arg-p* (plusp *numeric-arg*)) + ("Insert assembled code" + (copy-bp (point) :normal) (forward-sexp (point) 1 t) t) + (with-interval-stream (input-stream sbp ebp t) + (let ((output-stream (rest-of-interval-stream ebp)) + (cl:*package* (cl:find-package "ALPHA-AXP-INTERNALS")) + (cl:*read-base* 10) + (cl:*print-base* 10) + (axpi::*previous-instructions* + (cl:make-array axpi::*n-previous-instructions* :initial-element nil)) + (axpi::*last-instruction* nil) + (axpi::*instruction-counter* 0) + (axpi::*function-being-processed* nil) + (axpi::*function-epilogue* nil) + (axpi::*func-name* nil) + (axpi::*block-name* nil)) + (do ((form (cl:read input-stream nil :eof) (cl:read input-stream nil :eof))) + ((eq form :eof) nil) + (when (cl:consp form) + (incf ncycles + (axpi::process-asm-form + form (if *numeric-arg-p* + (if (plusp *numeric-arg*) output-stream 'sys:null-stream) + cl:*standard-output*))))) + (dolist (form axpi::*function-epilogue*) + (when (cl:consp form) + (incf ncycles + (axpi::process-asm-form + form (if *numeric-arg-p* + (if (plusp *numeric-arg*) output-stream 'sys:null-stream) + cl:*standard-output*))))) + (setq nwords axpi::*instruction-counter*) + (close output-stream))))) + (zwei:typein-line "Total of ~D cycles in ~D instructions (~$ CPI)" ncycles nwords + (float (lisp:/ ncycles nwords)))) + (if *numeric-arg-p* dis-text dis-none)) + +#+Genera +(set-comtab *standard-comtab* + '(#\c-m-sh-M com-alpha-assemble-region + #\c-m-sh-A com-alpha-assemble-region)) + +#+Genera +(eval-when (compile load eval) (future-common-lisp:in-package "POWERPC-INTERNALS")) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Native Alpha Assembler Support ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; This provides support for assembling the standard Alpha instruction +;;; format into 'bits' (rather than writing an ascii file). It is used by +;;; the translator to generate DTP-NATIVEINSTRUCTIONs + +(clos:defclass alpha-instruction-block () + ((iblock :initform (make-array 10)))) + +(clos:defmethod emit-alphabits ((destination alpha-instruction-block) bits &optional disp) + (clos:with-slots (iblock) destination + (vector-push-extend bits iblock))) + +(clos:defgeneric coerce-to-register-number (register)) + +(clos:defmethod coerce-to-register-number ((register symbol)) + (let ((aregister (find-register register))) + (if (null aregister) (error "Register named ~A not found." register)) + (coerce-to-register-number aregister))) + +(clos:defmethod coerce-to-register-number ((register cons)) + (coerce-to-register-number (car register))) + +(clos:defmethod coerce-to-register-number ((register register)) + (clos:with-slots (code) register + code)) + +(defun register-operandp (datum) (find-register datum)) + +(defun coerce-to-register-number-or-literal (datum) + (if (numberp datum) + datum + (if (find-register datum) + (coerce-to-register-number datum) + datum))) + +;;; useful instruction format byte positions + +;;; all instructions +(defconstant %%alpha-inst-opcode (byte 6 26)) +;;; all but palcode +(defconstant %%alpha-inst-ra (byte 5 21)) +;;; memory and operate +(defconstant %%alpha-inst-rb (byte 5 16)) +;;; operate literal bit +(defconstant %%alpha-inst-litp (byte 1 12)) +;;; operate literal +(defconstant %%alpha-inst-literal (byte 8 13)) +;;; operate +(defconstant %%alpha-inst-function (byte 10 5)) +(defconstant %%alpha-inst-rc (byte 5 0)) +;;; memory +(defconstant %%alpha-inst-memory-disp (byte 16 0)) +;;; branch +(defconstant %%alpha-inst-branch-disp (byte 21 0)) + +;;; assemble-operation takes an operation and emits the bit pattern of the operation if any. +;;; the operation may be a pseudo operation and so may not emit anything at all, or may +;;; emit a lot. + +(clos:defgeneric assemble-operation (operation &optional destination args)) + +(clos:defmethod assemble-operation ((operation list) &optional (destination nil) (args nil)) + (let ((instruction (find-instruction (car operation)))) + (assert (null args)) + (assemble-operation instruction destination (cdr operation)))) + +(clos:defmethod assemble-operation ((operation memory-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (code) operation + (destructuring-bind (reg disp index &optional comment) args + (declare (ignore comment)) + (let* ((thereg (coerce-to-register-number reg)) + (indexreg (coerce-to-register-number index)) + (disp (coerce-to-displacement disp)) + (bits (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb indexreg %%alpha-inst-rb + (dpb disp %%alpha-inst-memory-disp 0)))))) + (if destination (emit-alphabits destination bits)) + bits)))) + +(clos:defmethod assemble-operation ((operation memory-format-branch-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (code) operation + (destructuring-bind (reg index hint &optional comment) args + (declare (ignore comment)) + (let* ((thereg (coerce-to-register-number reg)) + (indexreg (coerce-to-register-number index)) + (hint (coerce-to-displacement hint)) ;+++ disp +++ + (bits (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb indexreg %%alpha-inst-rb + (dpb hint %%alpha-inst-memory-disp 0)))))) + (if destination (emit-alphabits destination bits)) + bits)))) + +(clos:defmethod assemble-operation ((operation branch-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (code) operation + (destructuring-bind (reg disp &optional comment) args + (declare (ignore comment)) + (let* ((thereg (coerce-to-register-number reg)) + (displac 0) + (bits (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb displac %%alpha-inst-branch-disp 0))))) + ;(break "in branch-format instruction!") + (if destination (emit-alphabits destination bits disp)) ; +++ what about disp! + bits)))) + +(clos:defmethod assemble-operation ((operation operate-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (code function-code) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (declare (ignore comment)) + (let* ((thereg (coerce-to-register-number reg1)) + (theop2 (coerce-to-register-number-or-literal op2)) + (regp (register-operandp op2)) + (thedest (coerce-to-register-number destreg)) + (bits (if regp + (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb theop2 %%alpha-inst-rb + (dpb function-code %%alpha-inst-function + (dpb thedest %%alpha-inst-rc 0))))) + (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb theop2 %%alpha-inst-literal + (dpb 1 %%alpha-inst-litp + (dpb function-code %%alpha-inst-function + (dpb thedest %%alpha-inst-rc 0))))))))) + (if destination (emit-alphabits destination bits)) + bits)))) + +(clos:defmethod assemble-operation ((operation FP-operate-format-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (code function-code) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (declare (ignore comment)) + (let* ((thereg (coerce-to-register-number reg1)) + (theop2 (coerce-to-register-number-or-literal op2)) + (thedest (coerce-to-register-number destreg)) + (bits (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb theop2 %%alpha-inst-rb + (dpb function-code %%alpha-inst-function + (dpb thedest %%alpha-inst-rc 0))))))) + (if destination (emit-alphabits destination bits)) + bits)))) + +(clos:defmethod assemble-operation ((operation IEEE-FP-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (code function-code) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (declare (ignore comment)) + (let* ((thereg (coerce-to-register-number reg1)) + (theop2 (coerce-to-register-number-or-literal op2)) + (thedest (coerce-to-register-number destreg)) + (bits (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb theop2 %%alpha-inst-rb + (dpb function-code %%alpha-inst-function + (dpb thedest %%alpha-inst-rc 0))))))) + (if destination (emit-alphabits destination bits)) + bits)))) + +(clos:defmethod assemble-operation ((operation IEEE-FP2-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (code function-code) operation + (destructuring-bind (reg1 op2 destreg &optional comment) args + (declare (ignore comment)) + (let* ((thereg (coerce-to-register-number reg1)) + (theop2 (coerce-to-register-number-or-literal op2)) + (thedest (coerce-to-register-number destreg)) + (bits (dpb code %%alpha-inst-opcode + (dpb thereg %%alpha-inst-ra + (dpb theop2 %%alpha-inst-rb + (dpb function-code %%alpha-inst-function + (dpb thedest %%alpha-inst-rc 0))))))) + (if destination (emit-alphabits destination bits)) + bits)))) + +(defun NYI (&rest args) (error "Operation not yet implemented")) + +(clos:defmethod assemble-operation ((operation miscellaneous-instruction) + &optional (destination nil) (args nil)) + (nyi operation destination args)) + +(clos:defmethod assemble-operation ((operation fetch-instruction) + &optional (destination nil) (args nil)) + (nyi operation destination args)) + +(clos:defmethod assemble-operation ((operation PAL-instruction) + &optional (destination nil) (args nil)) + (nyi operation destination args)) + +#+ignore +(clos:defmethod assemble-operation ((operation pseudo-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (setf (pseudo-instruction-args operation) args) + (ecase name + (label + (destructuring-bind (labelname &optional comment) args + (declare (ignore comment)) + ;; --- force-alignment + (setlabel destination labelname) + )) + (unlikely-label + (destructuring-bind (labelname &optional comment) args + (declare (ignore comment)) + ;; Unlikely labels stay unaligned + (setlabel destination labelname))) + + (comment + ) + )) + nil) + + +;;; assemble-asm-FORM handles the expansion of assembler macros. An +;;; assembler macro expands into a list of assembler operations any one of +;;; these may also be a macro The result of this loop is the linearization +;;; of assembler macros. +(defun assemble-asm-form (form destination &optional env) + (if (consp (first form)) + (loop for meform in form + doing (assemble-asm-form meform destination env)) + (let ((expanded (macroexpand form env))) + (if (eq expanded form) + (assemble-operation form destination) + (loop for meform in expanded + doing (assemble-asm-form meform destination env)))))) + + + +;;; Tests + +(defun testemit (operation) + (with-output-to-string (strm) + (emit-operation operation strm))) + +;;; test memory format instructions with and without an index +;;; (testemit '(LDL R2 112345 R3 "Load the next PC from the cache")) +;;; (testemit '(LDL R2 112345 R31 "Load the next PC from the cache")) +;;; test branch format instructions +;;; (testemit '(BR R31 foo123456 "Jump to 123456")) +;;; test Operate format instructions +;;; (testemit '(ADDL R3 R4 R5 "R3+R4->R5")) +;;; test Floating point operate format instructions +;;; (testemit '(CPYS F1 F2 F3 "foo on you")) +;;; test PAL format instructions +;;; (testemit '(IMB "Call PAL IMB")) +;;; test pseudo operations +;;; (testemit '(label foo)) +;;; (testemit '(comment "able was I ere I saw Elba")) +;;; (testemit '(passthru ".foo 42" "this is a passthru!")) +;;; (testemit '(AND t1 #x3F t1 "Strip of any CDR code bits.")) +;;; (testemit '(JMP zero t1 0 "Jump to the handler")) +;;; (testemit '(LDL hwopmask packedoperandmask none)) + + +;;; Fin. diff --git a/assembler/alphadsdl.lisp b/assembler/alphadsdl.lisp new file mode 100644 index 0000000..712935e --- /dev/null +++ b/assembler/alphadsdl.lisp @@ -0,0 +1,987 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: Yes -*- + +(in-package "ALPHA-AXP-INTERNALS") + +(eval-when (compile load eval) + (pushnew :64bitmachine *features*) + (pushnew :alpha-axp-emulator *features*)) + +;;; DSDL-alpha is derived from the CLOE DSDL facility. + +(defvar *dsdl-objects*) + +(defvar *dsdl-object-table*) + +(defmacro define-dsdl-dispatch (name arglist &body body) + #+Genera `(defun (:property ,@name) ,arglist ,@body) + #-Genera `(setf (get ',(first name) ',(second name)) + #'(lambda ,arglist + (block ,(second name) ,@body)))) + + +(defun get-dsdl-dispatch (thing dispatch-name) + (or (get thing dispatch-name) + (error "Can't find dispatch property ~S for ~S." thing dispatch-name))) + +(defun set-dsdl-dispatch (thing dispatch-name value) + (setf (get thing dispatch-name) value)) + +(defsetf get-dsdl-dispatch set-dsdl-dispatch) + + +(defun get-dsdl-data (thing kind indicator) + (dolist (e *dsdl-objects*) + (when (lisp:and (eq (first e) thing) (eq (second e) kind)) + (return (getf (cddr e) indicator))))) + +(defun set-dsdl-data (thing kind indicator value) + (dolist (e *dsdl-objects* (error "No entry found for a ~S ~S." thing kind)) + (when (lisp:and (eq (first e) thing) (eq (second e) kind)) + (return (setf (getf (cddr e) indicator) value))))) + +(defsetf get-dsdl-data set-dsdl-data) + + +(defun dsdl-no-op (&rest ignore) + #+CLOE (declare (sys::downward-rest-argument)) + nil) + + +(defvar *dsdl-new-type-scheme*) + +(defmacro with-dsdl-object-context (&body body) + `(let ((*dsdl-objects* nil) + (*dsdl-object-table* (make-hash-table :test #'equal)) + (*dsdl-new-type-scheme* nil)) + ,@body)) + +(defun find-dsdl-object-named (name) + (gethash name *dsdl-object-table*)) + +(defun add-dsdl-object-entry (entry) + (let ((v (gethash (car entry) *dsdl-object-table*))) + (when v + (warn "~S, being defined as a ~S, is already defined as a ~S." + (car entry) (cadr entry) (cadr v))) + (push entry *dsdl-objects*) + (setf (gethash (car entry) *dsdl-object-table*) entry)) + entry) + +(defun add-dsdl-object (name type value &optional plist) + (add-dsdl-object-entry (list* name type value plist))) + +(defun note-dsdl-reference (name type) + (let ((v (gethash name *dsdl-object-table*))) + (if v + (warn "~S, being defined as a ~S, is already defined as a ~S." + name type (cadr v)) + (setf (gethash name *dsdl-object-table*) v)))) + + +(defun process-dsdl-file (filename) + (with-open-file (s filename :if-does-not-exist :error) + (let ((eof (list nil)) dispfun) + (loop for form = (read s nil eof) until (eq form eof) + do (if (lisp:and (consp form) + (symbolp (car form)) + (setq dispfun (get-dsdl-dispatch (car form) 'dsdl-toplevel))) + (funcall dispfun form) + (error "Unrecognized form: ~S." form)))))) + +(defun write-dsdl-data (input-file filename language) + (with-open-file (s filename :direction :output #-Genera :if-exists #-Genera :supersede) + (let ((indicator-writers (get-dsdl-dispatch language 'dsdl-indicator-writers))) + (funcall (get-dsdl-dispatch language 'write-file-header) input-file filename s) + (dolist (e *dsdl-objects*) + (let ((handler (getf indicator-writers (second e)))) + (when handler + (apply handler (first e) (third e) s (cdddr e))))) + (funcall (get-dsdl-dispatch language 'write-file-trailer) input-file filename s)))) + +(defun dsdl (input-file language-or-languages &key (new-type-scheme t)) + (with-dsdl-object-context + (setq *dsdl-new-type-scheme* new-type-scheme) + (process-dsdl-file input-file) + (setq *dsdl-objects* (nreverse *dsdl-objects*)) + (dolist (language (if (listp language-or-languages) + (adjoin :c-setup language-or-languages) + (list language-or-languages))) + (write-dsdl-data input-file + (funcall (get-dsdl-dispatch language 'name-output-file) input-file) + language)))) + + +;;;; Structures + +(defstruct dsdl + name + size + source-components + relocatable + absolute + (base 0 :type fixnum) + (pointer-type nil) + (free-pointer nil)) + +(defun get-existing-structure (name) + (let ((v (find-dsdl-object-named name))) + (cond ((not v) (error "Can't find dsdl structure named ~S." name)) + ((not (eq (second v) :structure)) + (error "Existing dsdl object ~S is not a structure." name)) + (t (third v))))) + + +(define-dsdl-dispatch (define-structure dsdl-toplevel) (form) + (destructuring-bind (name &rest stuff) (cdr form) + (let ((relocatable nil) + (absolute nil) + (point 0) + (base-pointer-p nil) + (components stuff) + z + (base 0) + (new-components nil) + (pointer-type nil) + (included nil) + (free-pointer nil)) + (declare (fixnum point base)) + (when (consp name) + (dolist (x (prog1 (cdr name) (setq name (car name)))) + (ecase (if (atom x) x (car x)) + (:include + (setq included (or (get-existing-structure (cadr x)) + (error "~S, included by ~S, is not defined." + (cadr x) name))) + (setq components (append (dsdl-source-components included) components)) + (unless pointer-type (setq pointer-type (dsdl-pointer-type included)))) + (:pointer-type (setq pointer-type (cdr x)))))) + (dolist (x components) + (cond ((atom x) + (if (eq x :base-pointer) + (cond ((not base-pointer-p) + (cond ((logtest point 3) (error ":BASE-POINTER non-longword-aligned")) + ((logtest point 7) (warn ":BASE-POINTER non-quadword-aligned"))) + (setq base point) + (dolist (e relocatable (setq base-pointer-p point point 0)) + (decf (the fixnum (second e)) point))) + ((/= point 0) + (error "Multiple ~S keywords in DSDL." :base-pointer))) + (error "Unrecognized atomic keyword in DSDL: ~S." x)) + (push x new-components)) + ( + #+:32bitmachine + (setq z (cdr (assoc (car x) + '((:long :unsigned-long 4 4) + (:unsigned-long :unsigned-long 4 4) + (:signed-long :signed-long 4 4) + (:pointer :pointer 4 4) + (:pointer-to :pointer 4 4) + (:word :unsigned-word 2 2) + (:unsigned-word :unsigned-word 2 2) + (:signed-word :signed-word 2 2) + (:byte :unsigned-byte 1 1) + (:unsigned-byte :unsigned-byte 1 1) + (:signed-byte :signed-byte 1 1) + (:quad :quad 8 4) + (:quadword :quad 8 4) + (:octa :octa 16 4) + (:octaword :octa 16 4) + (:included-structure :included-structure nil 1))))) + #+:64bitmachine + (setq z (cdr (assoc (car x) + '((:long :unsigned-long 8 8) + (:unsigned-long :unsigned-long 8 8) + (:signed-long :signed-long 8 8) + (:int :unsigned-int 4 4) + (:unsigned-int :unsigned-int 4 4) + (:signed-int :signed-int 4 4) + (:pointer :pointer 8 8) + (:pointer-to :pointer 8 8) + (:word :unsigned-word 2 2) + (:unsigned-word :unsigned-word 2 2) + (:signed-word :signed-word 2 2) + (:byte :unsigned-byte 1 1) + (:unsigned-byte :unsigned-byte 1 1) + (:signed-byte :signed-byte 1 1) + (:quad :quad 8 8) + (:quadword :quad 8 8) + (:octa :octa 16 8) + (:octaword :octa 16 8) + (:included-structure :included-structure nil 1))))) + (push x new-components) + (unless (zerop (mod point (the fixnum (third z)))) + (error "~S doesn't occur on a ~D-byte boundary in ~s." x (third z) name)) + (let ((type (first z)) (cruft (cddr x)) (pl nil) (inc 0)) + (declare (fixnum inc)) + (cond ((eq type :pointer-to) + (setq type `(:pointer-to ,(pop x))) + (unless (get-existing-structure (second type)) + (error "Type ~S pointed to by ~S is not defined." + (second type) name))) + ((eq type :included-structure) + (setq pl `(:included-type ,(third x)) + inc (dsdl-size (or (get-existing-structure (third x)) + (error "~S undefined :include in ~S." + (third x) name))) + cruft (cdddr x))) + (t (setq inc (second z)))) + (let ((data `(,(cadr x) ,point ,type ,@pl))) + (note-dsdl-reference (list name (cadr x)) :structure-component) + (push data relocatable) + (dolist (y cruft) + (let ((k y) (v nil)) + (unless (atom k) (setq k (car y) v (cdr y))) + (ecase k + (:lisp-index + (when (or (null v) (car v)) + (when (logtest point 3) + (error "Quantity too small to use :LISP-INDEX: ~S in ~S." + x name)) + (setf (getf (cdddr data) :lisp-index) t))) + ((:field :fields) + (process-dsdl-field-definitions + name (if (eq k :field) (list v) v) (ash inc 3))))))) + (incf point inc))) + ((eq (car x) :fields) + (push x new-components) + (let ((p 0) (fields nil)) + (declare (fixnum p)) + (dolist (y (cdr x)) + (note-dsdl-reference (list name (car y)) :structure-component) + (push (list (car y) p (cadr y)) fields) + (incf p (cadr y))) + (multiple-value-bind (a b) (ceiling p 8) + (declare (fixnum a b)) + (unless (= b 0) + (warn ":FIELDS group not byte aligned, adding a dummy field ~d bits long." + (- b)) + (push (list 'intrnl-dummy p (- b)) fields)) + (push `(nil ,point :direct-fields + :fields ,(nreverse fields)) + relocatable) + (incf point a)))) + ((eq (car x) :size) + (let ((u (if (cddr x) + (or (cdr (assoc (caddr x) '((:pointer 4) + (:long . 4) + (:word . 2) + (:byte . 1) + (:quad . 8)))) + (error "Unknown size unit in ~S." x)) + 1)) + (size (if base-pointer-p (+ point base-pointer-p) point))) + (declare (fixnum u size)) + (unless (zerop (mod size u)) + (warn "Size ~S is not aligned in ~S." x name)) + (note-dsdl-reference (list name (cadr x)) :structure-attribute) + (push `(,(cadr x) ,(truncate size u) :constant) absolute))) + ((eq (car x) :free-pointer) + (note-dsdl-reference (list name (cadr x)) :structure-attribute) + (setq free-pointer + (cons (cadr x) + (mapcar + #'(lambda (x) + (let ((macname (car x)) type arrayp z) + (when (eq (setq type (cadr x)) :array) + (setq arrayp t type (caddr x))) + (when (setq z (assoc type '((:long . :unsigned-long) + (:int . :unsigned-int) + (:word . :unsigned-word) + (:byte . :unsigned-byte)))) + (setq type (cdr z))) + (list macname type arrayp))) + (cddr x))))) + (t (error "~S unrecognized option in define-structure of ~S." (car x) name)))) + (add-dsdl-object name :structure (make-dsdl + :name name + :base base + :size (+ point base) + :source-components (nreverse new-components) + :relocatable (nreverse relocatable) + :absolute (nreverse absolute) + :pointer-type pointer-type + :free-pointer free-pointer)) + (values name "Structure")))) + + +(define-dsdl-dispatch (define-fields dsdl-toplevel) (form) + (destructuring-bind (name &rest stuff) (cdr form) + (process-dsdl-field-definitions name stuff) + (list name "Field Group"))) + +(defun process-dsdl-field-definitions (root-name spec &optional (bitmax most-positive-fixnum) + &aux (warnmax (integer-length most-positive-fixnum)) + (defs nil)) + (declare (fixnum bitmax warnmax)) + (setq defs (sort (mapcar + #'(lambda (x) + (let* ((name (car x)) + (position (cadr x)) + (size (if (cddr x) (caddr x) 1)) + (endpos (+ position size))) + (declare (fixnum position size endpos)) + (cond ((> endpos bitmax) + (error "~S field of ~S extends beyond its slot or containing structure." + name root-name)) + ((> endpos warnmax) + (warn "~S field of ~S extends beyond the width of a fixnum." + name root-name))) + `((,root-name ,name) :field (,position ,size)))) + spec) + #'(lambda (x y) + (setq x (third x) y (third y)) + (< (the fixnum (+ (first x) (second x))) + (the fixnum (+ (first y) (second y))))))) + (do ((lastpos (+ (first (third (car defs))) + (second (third (car defs)))) + (+ p (the fixnum (second z)))) + (prevthing (car defs) (car l)) + (z nil) + (p 0) + (l (cdr defs) (cdr l))) + ((null l)) + (declare (fixnum lastpos p)) + (setq p (first (setq z (third (car l))))) + (when (/= p lastpos) + (warn (if (> p lastpos) + "In structure ~S, there is a gap between fields ~S and ~S." + "In structure ~S, fields ~S and ~S overlap.") + root-name (car prevthing) (caar l)))) + (mapc #'add-dsdl-object-entry defs) + defs) + + +(define-dsdl-dispatch (define-values dsdl-toplevel) (form) + (destructuring-bind (root-name &rest stuff) (cdr form) + (let* ((type (cond ((atom root-name) :constant) + (t (assert (member (second root-name) '(:constant :parameter))) + (second root-name)))) + (root-name (if (atom root-name) root-name (first root-name)))) + (dolist (x stuff) + (let ((name (car x)) (value (cadr x))) + (check-type value integer) + (add-dsdl-object (list root-name name) type value))) + (values root-name "Value Group")))) + +(define-dsdl-dispatch (define-lisp-structure dsdl-toplevel) (form) + (destructuring-bind (name &rest slot-names) (cdr form) + (dolist (slot-name slot-names) + (note-dsdl-reference (list name slot-name) :lisp-structure-component)) + (add-dsdl-object name :lisp-structure slot-names) + (add-dsdl-object (list name 'structuresize) :constant (1+ (length slot-names))) + (values name "Lisp Structure"))) + +(define-dsdl-dispatch (define-lisp-funcallable-structure dsdl-toplevel) (form) + (destructuring-bind (name &rest slot-names) (cdr form) + (dolist (slot-name slot-names) + (note-dsdl-reference (list name slot-name) :lisp-funcallable-structure-component)) + (add-dsdl-object name :lisp-funcallable-structure slot-names) + (add-dsdl-object (list name 'structuresize) :constant (1+ (length slot-names))) + (values name "Lisp Funcallable Structure"))) + + +(define-dsdl-dispatch (define-initial-symbols dsdl-toplevel) (form) + (destructuring-bind (&rest symbols-list) (cdr form) + (let ((known-pkgs '(("LISP" . "LISP") ("CLOE" . "CLOE") + ("SYSTEM" . "SYSTEM") ("SYS" . "SYSTEM") + ("CLOS" . "CLOS") ("CLOS-INTERNALS" . "CLOSI") + ("ALPHAOSF1" . "ALPHAOSF1"))) + (symsetups nil) + (fdecls nil) + (clocs nil)) + (dolist (x symbols-list) + (destructuring-bind (symbol &key package location + (value nil value-p) (constant nil constant-p) + function documentation) x + (unless package (setq package (package-name (symbol-package symbol)))) + (let ((z (assoc package known-pkgs :test #'string=))) + (cond (z (setq package (cdr z))) + (t (warn "~S unknown package in symbol definition of ~S; SYSTEM will be used." + package symbol) + (setq package "SYSTEM")))) + (unless (listp documentation) + (setq documentation (list (cond (value-p 'variable) + (function 'function) + (t (error "Why does ~S have documentation?" symbol))) + documentation))) + (when function (pushnew function fdecls :test #'string=)) + (when location (push location clocs)) + (push (list symbol + package + location + (cond (value-p :variable) (constant-p :constant)) + (if value-p value constant) + function + documentation) + symsetups))) + (add-dsdl-object '*initial-symbols* :initial-symbols + (list (nreverse symsetups) (nreverse fdecls) (nreverse clocs))) + (values nil "Initial Symbols")))) + + +;;;; C (include) + +(setf (get-dsdl-dispatch :c 'dsdl-indicator-writers) + '(:field write-c-field + :constant write-c-constant + :parameter write-c-constant + :structure write-c-structure + :lisp-structure write-c-lispstruct + :lisp-funcallable-structure write-c-lispfnstruct + :initial-symbols write-c-initial-symbols)) + +(defun genera-upcase (x) + #+Genera (string-upcase x) + #-Genera x) + +(define-dsdl-dispatch (:c write-file-header) (input-file filename stream) + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A Any changes made to it will be lost. */ + +#ifndef _~a_ +#define _~a_ +~2%" + input-file + (string-upcase (pathname-name (pathname filename))) + (string-upcase (pathname-name (pathname filename))))) + +(define-dsdl-dispatch (:c write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A Any changes made to it will be lost. */ + +#endif +~2%" + input-file)) + +(define-dsdl-dispatch (:c name-output-file) (input-file) + (make-pathname :type (genera-upcase "h") :defaults input-file)) + +(defun dsdl-c-upper-name-component (x) + (map 'string #'(lambda (c) + (declare (string-char c)) + (cond ((lisp:and (alpha-char-p c) (upper-case-p c)) c) + ((lisp:and (alpha-char-p c) (lower-case-p c)) c) + ((digit-char-p c) c) + ((char= c #\-) #\_) + ((char= c #\_) #\_) + (t (error "Can't put ~S in a C name component." c)))) + (the string (string x)))) + + (defun dsdl-c-lower-name-component (x) + (map 'string #'(lambda (c) + (declare (string-char c)) + (cond ((lisp:and (alpha-char-p c) (upper-case-p c)) (char-downcase c)) + ((digit-char-p c) c) + ((char= c #\-) #\_) + ((char= c #\_) #\_) + (t (error "Can't put ~S in a C name component." c)))) + (the string (string x)))) + +(defun write-c-variable-declarations (prefix-string items stream) + (when items + (let* ((prefix-size (1+ (length prefix-string))) (pos prefix-size)) + (declare (fixnum prefix-size n)) + (format stream "~2&~A " prefix-string) + (do () (nil) + (write-string (car items) stream) + (setq pos (+ pos 1 (length (car items)))) + (cond ((null (setq items (cdr items))) (return (format stream ";~%"))) + ((> pos 70) (format stream ";~%~A " prefix-string) (setq pos prefix-size)) + (t (write-char #\, stream))))))) + +(defun write-c-function-declarations (prefix-string items stream) + (when items + (let* ((prefix-size (1+ (length prefix-string))) (pos prefix-size)) + (declare (fixnum prefix-size n)) + (format stream "~2&~A " prefix-string) + (do () (nil) + (write-string (car items) stream) + (write-string "()" stream) + (setq pos (+ pos 3 (length (car items)))) + (cond ((null (setq items (cdr items))) (return (format stream ";~%"))) + ((> pos 70) (format stream ";~%~A " prefix-string) (setq pos prefix-size)) + (t (write-char #\, stream))))))) + + +(defun write-c-constant (name value stream) + (format stream (if (typep value 'bignum) + "~2&#define ~A_~A 0x~X~%" + "~2&#define ~A_~A ~D~%") + (dsdl-c-upper-name-component (first name)) + (dsdl-c-upper-name-component (second name)) + value)) + +(defun write-c-lisp-index (name value stream) + (format stream "~2&#define ~A_I_~A ~D~%" + (dsdl-c-upper-name-component (first name)) + (dsdl-c-upper-name-component (second name)) + value)) + +(defun write-c-field (name value stream) + (let ((root (dsdl-c-upper-name-component (first name))) + (ending (dsdl-c-upper-name-component (second name))) + (pp (first value)) + (ss (second value))) + (format stream "~2&#define ~A_V_~A ~D~@ + #define ~A_S_~A ~D~@ + #define ~A_M_~A 0x~x~%" + root ending pp + root ending ss + root ending (ash (1- (ash 1 ss)) pp)))) + +(defun write-c-structure (root-name value stream + &aux (rupper (dsdl-c-upper-name-component root-name)) + (rlower (dsdl-c-lower-name-component root-name)) + (pointer-type (dsdl-pointer-type value)) + (typename + (lisp:and pointer-type + (format nil "~:[ETT~;TC~]_~A" + *dsdl-new-type-scheme* + (dsdl-c-upper-name-component + (if *dsdl-new-type-scheme* + (first pointer-type) + (or (second pointer-type) "OTHERS"))))))) + (format stream "~2&typedef struct ~A {" rlower) + (loop for (name nil type . plist) in (dsdl-relocatable value) + do (cond ((eq type :direct-fields) + (loop for (fname nil size) in (getf plist :fields) + do (format stream "~& unsigned long ~a : ~d;" + (dsdl-c-lower-name-component fname) size))) + (t (format stream "~& ") + (write-string + (ecase type + (:signed-long "int64_t ") + (:unsigned-long "uint64_t ") + (:signed-int "int32_t ") + (:unsigned-int "uint32_t ") + (:signed-byte "int8_t ") + (:unsigned-byte "uint8_t ") + (:signed-word "int16_t ") + (:unsigned-word "uint16_t ") + (:pointer "char *") + (:included-structure + (format nil "~A " + (dsdl-c-upper-name-component + (getf plist :included-type))))) + stream) + (write-string (dsdl-c-lower-name-component name) stream) + (write-char #\; stream)))) + (format stream "~% } ~A, *~:*~AP;~%" rupper) + (when pointer-type + (let ((first-structure-slot-offset (second (first (dsdl-relocatable value))))) + ;;Should be 0 or negative. + (assert (not (plusp first-structure-slot-offset))) + #+notneeded + (format stream "~%#define ~A_PTYPE ~A~@ + #define BARE~A(obj) ((~:*~aP)(((char *)(obj))-~d-~A_PTYPE))~%" + rupper typename + rupper (- first-structure-slot-offset) rupper))) + (loop for (name value nil . plist) in (dsdl-relocatable value) + do (when (getf plist :lisp-index) + (write-c-lisp-index (list root-name name) (ash value -2) stream))) + (loop for (name value type) in (dsdl-absolute value) + do (if (eq type :field) + (write-c-field (list root-name name) value stream) + (write-c-constant (list root-name name) value stream))) + (let ((fp (dsdl-free-pointer value))) + (when fp + (let ((offset (- (dsdl-size value) (dsdl-base value)))) + (format stream "~%#define ~A_~A (~D-~A)~%" + rupper (dsdl-c-upper-name-component (first fp)) + offset typename) + (dolist (x (cdr fp)) + (let ((mname (first x)) (type (second x)) (arrayp (third x))) + (format stream "#define ~A_~A(~A) ~:[(*~;~]((~A *)(((char *)(~A))+~A-~A))~:[)~;~]~%" + rupper (dsdl-c-upper-name-component mname) rlower arrayp + (ecase type + (:unsigned-long "uint64_t") + (:signed-long "int64_t") + (:unsigned-int "uint32_t") + (:signed-int "int32_t") + (:unsigned-word "uint16_t") + (:signed-word "int16_t") + (:unsigned-byte "uint8_t") + (:signed-byte "int8_t") + (:pointer "char *")) + rlower offset typename arrayp))))))) + +(defun write-c-lispstruct (root-name value stream) + (format stream "~2&/* LISP Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-c-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-c-upper-name-component slot-name) + do (format stream "#define ~A_I_~A ~d~%" rc sc index) + (format stream "#define ~A_P_~A ~d~%" rc sc (ash index 2)) + (format stream "#define ~A_~A(foo) STREF((foo),~D)~%" rc sc index))) + (terpri stream)) + +(defun write-c-lispfnstruct (root-name value stream) + (format stream "~2&/* LISP Funcallable Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-c-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-c-upper-name-component slot-name) + do (format stream "#define ~A_I_~A ~d~%" rc sc index) + (format stream "#define ~A_P_~A ~d~%" rc sc (ash index 2)) + (format stream "#define ~A_~A(foo) ((TRAMPOLINE_VALUES((foo)))[~D])~%" rc sc index))) + (terpri stream)) + +(defun write-c-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (destructuring-bind (symsetups fdecls clocs) value + (write-c-variable-declarations "extern char *" clocs stream))) + + +;;;; C (setup) + +(setf (get-dsdl-dispatch :c-setup 'dsdl-indicator-writers) + '(:initial-symbols write-c-setup-initial-symbols)) + +(define-dsdl-dispatch (:c-setup write-file-header) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A Any changes made to it will be lost. */ +~2%" + input-file)) + +(define-dsdl-dispatch (:c-setup write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore input-file filename stream)) + #+OpenMCL input-file filename stream + nil) + +(define-dsdl-dispatch (:c-setup name-output-file) (input-file) + (make-pathname :type (genera-upcase "c") :defaults input-file)) + +(defun write-c-lispfnstruct (root-name value stream) + (format stream "~2&/* LISP Funcallable Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-c-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-c-upper-name-component slot-name) + do ;; @@@@ Removed because they never seem to be used and we have run out of #define space... + ;; (format stream "#define ~A_I_~A ~d~%" rc sc index) + (format stream "#define ~A_P_~A ~d~%" rc sc (ash index 2)) + (format stream "#define ~A_~A(foo) ((TRAMPOLINE_VALUES((foo)))[~D])~%" rc sc index))) + (terpri stream)) + + +(defun write-c-setup-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (destructuring-bind (symsetups fdecls clocs) value + (write-c-function-declarations "extern char *" fdecls stream) + (write-c-variable-declarations "char *" clocs stream) + (format stream "~%initsymbols()~%{ /* First intern everything, setting locations if they have them. */~%") + (loop for (sym pkg location vartype varinit function) in symsetups + do (if location + (format stream " ~A = intern(\"~a\",~A);~%" location sym pkg) + (format stream " intern(\"~a\",~A);~%" sym pkg))) + (format stream " /* Now do all the initializations. */~%") + (loop for (sym pkg location vartype varinit function) in symsetups + do (when (or vartype function) + (unless location (setq location (or location (format nil "intern(\"~A\",\"~A\")" sym pkg)))) + (when vartype + (format stream " ~a(~a,~a);~%" + (if (eq vartype :variable) "makvar" "makconst") + location + (if (stringp varinit) varinit + (let ((z (or (assoc varinit symsetups) + (warn "Initial value ~S for variable ~S is unknown." varinit sym) + '(nil nil "nilsymb")))) + (or (third z) + (format nil "intern(\"~A\",\"~A\")" (first z) (second z))))))) + (when function + (format stream " setspfun(~a,makCfn(~a));~%" location function)))) + (format stream "~%}~%"))) + + +;;;; Assembly Language (Include) + +(setf (get-dsdl-dispatch :asm 'dsdl-indicator-writers) + '(:field write-asm-field + :constant write-asm-constant + :parameter write-asm-constant + :structure write-asm-structure + :lisp-structure write-asm-lispstruct + :lisp-funcallable-structure write-asm-lispfnstruct + :initial-symbols write-asm-initial-symbols)) + +(define-dsdl-dispatch (:asm write-file-header) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A. Any changes made to it will be lost. */~2%" + input-file)) + +(define-dsdl-dispatch (:asm write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore input-file filename stream)) + #+OpenMCL input-file filename stream + nil) + +(define-dsdl-dispatch (:asm name-output-file) (input-file) + (make-pathname :type (genera-upcase "s") :defaults input-file)) + +(defun dsdl-asm-upper-name-component (x) + (map 'string #'(lambda (c) + (declare (string-char c)) + (cond ((lisp:and (alpha-char-p c) (upper-case-p c)) c) + ((lisp:and (alpha-char-p c) (lower-case-p c)) c) + ((digit-char-p c) c) + ((char= c #\-) #\_) + ((char= c #\_) #\_) + (t (error "Can't put ~S in an ASM name component." c)))) + (the string (string x)))) + +(defconstant *asm-token-length-max* 31) ;tokens longer than this may lose! + +(defvar *asm-token-conflicts* (make-hash-table :test #'equal)) + +(defvar *conflicting-token-alist* + '(("INSTANCE_INFORMATION_I_DISPATCH_MASK" . "I_I_I_DISPATCH_MASK") + ("INSTANCE_INFORMATION_P_DISPATCH_MASK" . "I_I_P_DISPATCH_MASK") + ("INSTANCE_INFORMATION_I_DISPATCH_ADDRESS" . "I_I_I_DISPATCH_ADDRESS") + ("INSTANCE_INFORMATION_P_DISPATCH_ADDRESS" . "I_I_P_DISPATCH_ADDRESS") )) + +(defun check-asm-token (token) + (let ((newtoken (cdr (assoc token *conflicting-token-alist* :test #'equal)))) + (when (null newtoken) (setq newtoken token)) + (when (> (length token) *asm-token-length-max*) + (let* ((subtoken (subseq token 0 *asm-token-length-max*)) + (conflict (gethash subtoken *asm-token-conflicts*)) + (badguys (cons token conflict))) + (setf (gethash subtoken *asm-token-conflicts*) badguys) + (when (lisp:and (cdr badguys) (equal token newtoken)) + (warn "Add ~A to *CONFLICTING-TOKEN-ALIST*~%~ + and try again; it's not unique within ~d. characters." + token *asm-token-length-max*)))) + newtoken)) + +(defun write-asm-constant (name value stream &aux token) + (setq token (check-asm-token (format nil "~A~A" + (dsdl-asm-upper-name-component (first name)) + (dsdl-asm-upper-name-component (second name))))) + (format stream (if (typep value 'bignum) + "~2&~A = ~D~%" + "~2&~A = 0x~X~%") + token + value)) + +(defun write-asm-field (name value stream &optional direct-p) + (let* ((root (dsdl-asm-upper-name-component (first name))) + (ending (dsdl-asm-upper-name-component (second name))) + (pp (first value)) + (ss (second value)) + (vname (check-asm-token (format nil "~A_V_~A" root ending))) + (sname (check-asm-token (format nil "~A_S_~A" root ending))) + (mname (check-asm-token (format nil "~A_M_~A" root ending)))) + (format stream "~2&~A = ~D~@ + ~A = ~D~@ + ~A = 0x~x~%" + vname pp + sname ss + mname (ash (1- (ash 1 ss)) (if direct-p 0 pp))))) + +(defun write-asm-structure (root-name value stream + &aux (rupper (dsdl-asm-upper-name-component root-name)) + (pointer-type (dsdl-pointer-type value)) + (typename + (lisp:and pointer-type + (format nil "~:[ETT~;TC~]_~A" + *dsdl-new-type-scheme* + (dsdl-asm-upper-name-component + (if *dsdl-new-type-scheme* + (first pointer-type) + (or (second pointer-type) "OTHERS"))))))) + (format stream "~2%/* Structure ~S */~%" root-name) + (loop for (name value type . plist) in (dsdl-relocatable value) + do (setq name (dsdl-asm-upper-name-component name)) + (cond ((eq type :direct-fields) + (let ((offset (ash value 3))) + (declare (fixnum offset)) + (loop for (fname pos size) (nil fixnum fixnum) in (getf plist :fields) + do (write-asm-field (list root-name fname) + (list (+ pos offset) size) + stream t)))) + (t (format stream "~A_~A = ~D~%" rupper name value) + (when (getf plist :lisp-index) + (format stream "~A_I_~A = ~D~%" rupper name (ash value -2)))))) + (loop for (name value type . plist) in (dsdl-absolute value) + do (case type + (:field (write-asm-field (list root-name name) value stream)) + (t (write-asm-constant (list root-name name) value stream)))) + (when pointer-type + (format stream "~%~A_PTYPE = ~A~%" rupper typename)) + (let ((fp (dsdl-free-pointer value))) + (when fp + (format stream "~A_~A = ~D-~A~%" + rupper (dsdl-asm-upper-name-component (car fp)) + (- (dsdl-size value) (dsdl-base value)) typename)))) + +(defun write-asm-lispstruct (root-name value stream) + (format stream "~2&/* LISP Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-asm-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-asm-upper-name-component slot-name) + do (format stream "~A = ~d~%" + (check-asm-token (format nil "~A_I_~A" rc (dsdl-asm-upper-name-component slot-name))) + index) + (format stream "~A = ~d~%" (check-asm-token (format nil "~A_P_~A" rc sc)) (ash index 2)))) + (terpri stream)) + +(defun write-asm-lispfnstruct (root-name value stream) + (format stream "~2&/* LISP Funcallable Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-asm-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-asm-upper-name-component slot-name) + do (format stream "~A = ~d~%" + (check-asm-token (format nil "~A_I_~A" rc (dsdl-asm-upper-name-component slot-name))) + index) + (format stream "~A = ~d~%" (check-asm-token (format nil "~A_P_~A" rc sc)) (ash index 2)))) + (terpri stream)) + +(defun write-asm-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (destructuring-bind (symsetups fdecls clocs) value + (format stream "~2&~{/. .extrn ~a:dword~%~}" clocs))) + + +;;;; Lisp (setup) + +(setf (get-dsdl-dispatch :lisp 'dsdl-indicator-writers) + '(:field write-lisp-field + :constant write-lisp-constant + :parameter write-lisp-parameter + :structure write-lisp-structure + :lisp-structure write-lisp-lispstruct + :lisp-funcallable-structure write-lisp-lispfnstruct + :initial-symbols write-lisp-initial-symbols)) + +(define-dsdl-dispatch (:lisp write-file-header) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "~ +;;; -*- Mode: LISP; Package: ALPHA-AXP-INTERNALS; Base: 10; Syntax: Common-Lisp; -*- +;;; +;;; WARNING!! DO NOT MODIFY THIS FILE! +;;; It was automatically generated from ~A. Any changes made to it will be lost. + +#+Alpha-AXP-Emulator +(in-package \"ALPHA-AXP-INTERNALS\") + +#+PowerPC-Emulator +(in-package \"POWERPC-INTERNALS\") +" + input-file)) + +(define-dsdl-dispatch (:lisp write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore input-file filename stream)) + #+OpenMCL input-file filename stream + nil) + +(define-dsdl-dispatch (:lisp name-output-file) (input-file) + (make-pathname :type (genera-upcase "lisp") :defaults input-file)) + +;;; ---*** TODO: Remove the $K definition ... +;;; ---*** Make similar changes to fields and structures ... +(defun write-lisp-constant (name value stream) + (format stream "~2&(defconstant ~(~s$k-~s~) ~D)~%" (first name) (second name) value) + (format stream "(defconstant |~A~A| ~D)~%" (dsdl-asm-upper-name-component (first name)) + (dsdl-asm-upper-name-component (second name)) + value)) + +(defun write-lisp-parameter (name value stream) + (format stream "~2&(defparameter ~(~s$k-~s~) ~D)~%" (first name) (second name) value) + (format stream "(defparameter |~A~A| ~D)~%" (dsdl-asm-upper-name-component (first name)) + (dsdl-asm-upper-name-component (second name)) + value)) + +(defun write-lisp-field (name value stream &optional direct-p) + (let ((root (first name)) + (ending (second name)) + (pp (first value)) + (ss (second value))) + (format stream "~2&~((defconstant ~s$v-~s ~D)~@ + (defconstant ~s$S-~s ~D)~@ + (defconstant ~s$m-~s #x~x)~)~%" + root ending pp + root ending ss + root ending (ash (1- (ash 1 ss)) (if direct-p 0 pp))))) + +(defun write-lisp-structure (root-name value stream + &aux (pointer-type (dsdl-pointer-type value)) + (typename + (lisp:and pointer-type + (intern (concatenate + 'string + (if *dsdl-new-type-scheme* "TC$K-" "ETT$K-") + (string (if *dsdl-new-type-scheme* + (first pointer-type) + (or (second pointer-type) 'others)))))))) + (format stream "~2%;;; Structure ~S~%" root-name) + (loop for (name value type . plist) in (dsdl-relocatable value) + do (cond ((eq type :direct-fields) + (let ((offset (ash value 3))) + (declare (fixnum offset)) + (loop for (fname pos size) (nil fixnum fixnum) in (getf plist :fields) + do (write-lisp-field (list root-name fname) + (list (+ pos offset) size) + stream t)))) + (t (format stream "(defconstant ~(~s$~a-~s~) ~D)~%" + root-name + (ecase type + ((:signed-long :unsigned-long) "q") + ((:signed-int :unsigned-int) "l") + ((:signed-word :unsigned-word) "w") + ((:signed-byte :unsigned-byte) "b") + (:quad "q") + (:octa "o") + (:pointer "p") + (:included-structure "a") ;byte address + ) + name value))) + (when (getf plist :lisp-index) + (format stream "(defconstant ~(~s$i-~s~) ~D)~%" root-name name (ash value -2)))) + (loop for (name value type) in (dsdl-absolute value) + do (if (eq type :field) + (write-lisp-field (list root-name name) value stream) + (write-lisp-constant (list root-name name) value stream))) + (when pointer-type + (format stream "~((defconstant ~s$k-ptype ~s)~)~%" + root-name typename)) + (let ((fp (dsdl-free-pointer value))) + (when fp + (format stream "~((defconstant ~s$k-~s ~S)~)~%" + root-name (car fp) `(- ,(- (dsdl-size value) (dsdl-base value)) ,typename))))) + +(defun write-lisp-lispstruct (name value stream) + (format stream "~2&;;; LISP Structure Information for ~S.~%" name) + (loop for slot-name in value + for i from 1 + do (format stream "(defconstant ~(~a$i-~a~) ~D)~%" name slot-name i) + (format stream "(defconstant ~(~a$p-~a~) ~D)~%" name slot-name (ash i 2))) + (format stream "(setf (system::sys%get '~(~s~) 'system::lispstruct-slots) '~((system::structure ~s)~))~2%" name value)) + +(defun write-lisp-lispfnstruct (name value stream) + (format stream "~2&;;; LISP Funcallable Structure Information for ~S.~%" name) + (loop for slot-name in value + for i from 1 + do (format stream "(defconstant ~(~a$i-~a~) ~D)~%" name slot-name i) + (format stream "(defconstant ~(~a$p-~a~) ~D)~%" name slot-name (ash i 2))) + (format stream "(setf (system::sys%get '~(~s~) 'system::lispstruct-slots) '~((system::funcallable-structure ~s)~))~2%" + name value)) + +(defun write-lisp-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (flet ((f (x) + (let ((*package* (symbol-package x))) + (format stream "~(~s~)" x)))) + (loop for (sym pkg location vartype varinit function documentation) in (first value) + do (when documentation + (format stream "~&(setf (sys::sys%get '~(~a~)::" pkg) + (f sym) + (format stream " 'documentation) '~s)~%" documentation))))) diff --git a/assembler/alphapckg.lisp b/assembler/alphapckg.lisp new file mode 100644 index 0000000..09da8cf --- /dev/null +++ b/assembler/alphapckg.lisp @@ -0,0 +1,9 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*- + +(defpackage ALPHA-AXP-INTERNALS + (:nicknames AXPI) + #+Genera (:use SCL LISP) + #-Genera (:use COMMON-LISP) + (:shadow AND) + #+OpenMCL (:import-from CCL LSH DEFSUBST STACK-LET CIRCULAR-LIST)) + diff --git a/assembler/power-sct-support.lisp b/assembler/power-sct-support.lisp new file mode 100644 index 0000000..5e70325 --- /dev/null +++ b/assembler/power-sct-support.lisp @@ -0,0 +1,215 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + + +;;; DSDL files + +(fs:define-canonical-type :dsdl "SID") + +(define-module-type :dsdl :dsdl :null-type + compilable-module no-load-or-compile-module) + +(defmethod (canonicalize-module-pathnames dsdl-module) (system) + (loop for input in inputs + as input-file = (if (listp input) (first input) input) + as real-input = (merge-pathname-with-defaults + input-file (source-file-type-default self) system) + as explicit-output = (listp input) + as output-file = (if (listp input) (second input) input-file) + as real-output = (merge-pathname-with-defaults + output-file :lisp system ;--- will do for now + ;; Force the output type if none was given explicitly + :force-type (null explicit-output) + ;; Destination files go to the destination pathname + :destination-file t) + do (add-pathname-to-system system real-input real-output) + collect `(,real-input ,real-output) into inputs-and-outputs + finally (setq inputs inputs-and-outputs))) + +(defmethod (:compile dsdl-module) (system-op &rest keys + &key recompile no-compile &allow-other-keys) + (unless no-compile + (when (eq system-op :compile) + (lexpr-funcall #'default-compile + self system-op recompile + #'(named-lambda lisp-compile-driver + (source bin module &rest ignore) + bin module + (let ((cl:*package* (pkg-find-package "POWERPC-INTERNALS"))) + (funcall (intern "DSDL" "POWERPC-INTERNALS") + source '(:c :asm :lisp)))) + '("Translate" "Translating" "Translated") + keys)))) + +(defmethod (:load dsdl-module) (system-op &rest keys + &key never-load reload &allow-other-keys) + (unless never-load + (lexpr-funcall #'default-load + self system-op reload + #'(named-lambda bin-load-driver + (bin ignore module &rest ignore) + (cl:load bin + :verbose nil + :default-package (system-default-package *system*) + :package (package-for-module module)) + (send bin :truename)) + '("Load" "Loading" "Loaded") + keys))) + + +;;; Assembly files + +(fs:define-canonical-type :assembler-source "AS") +(fs:define-canonical-type :assembler-dest "S") + +(define-module-type :powerpc-assembly :assembler-source :assembler-dest + compilable-module no-load-or-compile-module) + +(defmethod (:compile powerpc-assembly-module) (system-op &rest keys + &key recompile no-compile &allow-other-keys) + (unless no-compile + (when (eq system-op :compile) + (lexpr-funcall #'default-compile + self system-op recompile + #'(named-lambda lisp-compile-driver + (source bin module &rest ignore) + module + (let-if (system-default-package *system*) + ;; Bind PACKAGE to the default package in case + ;; the override mechanism supplies NIL + ((package (pkg-find-package + (system-default-package *system*)))) + (funcall (intern "PROCESS-ASM-SOURCE" "POWERPC-INTERNALS") + source bin))) + '("Translate" "Translating" "Translated") + keys)))) + + +;;; Copied files + +(define-module-type :copied-file nil :null-type + compilable-module no-load-or-compile-module) + +(defmethod (canonicalize-module-pathnames copied-file-module) (system) + (loop for input in inputs + as input-file = (if (listp input) (first input) input) + as real-input = (merge-pathname-with-defaults + input-file (source-file-type-default self) system) + as explicit-output = (listp input) + as output-file = (if (listp input) (second input) input-file) + as real-output = (merge-pathname-with-defaults + output-file (send real-input :canonical-type) system + ;; Force the output type if none was given explicitly + :force-type (null explicit-output) + ;; Destination files go to the destination pathname + :destination-file t) + do (add-pathname-to-system system real-input real-output) + collect `(,real-input ,real-output) into inputs-and-outputs + finally (setq inputs inputs-and-outputs))) + +(defmethod (:compile copied-file-module) (system-op &rest keys + &key recompile no-compile &allow-other-keys) + (unless no-compile + (when (eq system-op :compile) + (lexpr-funcall #'default-compile + self system-op recompile + #'(named-lambda lisp-compile-driver + (source bin module &rest ignore) + module + #+ignore + (copyf source (send bin :new-canonical-type + (send source :canonical-type)))) + '("Copy" "Copying" "Copied") + keys)))) + + +;;; Make files + +(define-module-type :makefile :null-type :null-type + copied-file-module) + + +;;; Commands + +(defvar *vlm-host*) + +(add-initialization "Reset VLM Target Host" + '(makunbound '*vlm-host*) + '(:before-cold)) + +(cp:define-command (com-assemble-emulator :command-table "System Maintenance") + ((system-spec '((scl:type-or-string sct:system)) + :default (sct:find-system-named 'powerpc-linux-vlm) + :default-type 'sct:system + :confirm t + :documentation "Emulator system to assemble") + &key + (reset-target 'scl:boolean + :default nil + :mentioned-default t + :documentation "Whether to ask for the target host for translation") + (condition '((cl:member :always :new-source)) + :default :new-source + :documentation "Whether to compile each source") + (query '((cl:member :everything :yes :confirm-only :no)) + :mentioned-default :everything + :default :no + :documentation + "Whether to ask about compiling each file, just confirm the list of files, or don't ask") + (redefinitions-ok 'scl:boolean + :default nil + :mentioned-default t + :documentation + "Whether to proceed through redefinition warnings") + (silent 'scl:boolean + :default nil + :mentioned-default t + :documentation "Whether to suppress all terminal output") + (batch `(or scl:boolean + ((fs:pathname) + :default-name ,(if (typep system-spec 'sct:system) + (sct:system-short-name system-spec) + system-spec) + :default-type :cwarns)) + :default nil + :mentioned-default t + :documentation + "Whether to save compiler warnings in a file, rather than printing them")) + (let ((system (sct:find-system-named system-spec nil nil t)) + (ok-to-proceed t) + (compile-system-options nil)) + (setq system (sct:system-name system)) + (setq compile-system-options + (selectq condition + (:always (append compile-system-options '(:recompile t))) + (:new-source (append compile-system-options '(:recompile nil))))) + (setq compile-system-options + (selectq query + ((:yes :everything) (append compile-system-options '(:query t))) + (:confirm-only (append compile-system-options '(:query :confirm))) + (:no (append compile-system-options '(:query :no-confirm))))) + (setq compile-system-options + (append compile-system-options + `(:no-warn ,(and redefinitions-ok (or silent :just-warn))))) + (when (cl:pathnamep batch) + (when (null (fs:pathname-name batch)) + (setq batch (send batch :new-name (string system)))) + (when (null (fs:pathname-type batch)) + (setq batch (send batch :new-type :cwarns)))) + (setq compile-system-options + (append compile-system-options + `(:silent ,silent + :batch ,batch + :include-components nil + :increment-version nil + :update-directory nil))) + (if ok-to-proceed + (progn + (when reset-target + (makunbound '*vlm-host*)) + (unless (boundp '*vlm-host*) + (let ((system (sct:find-system-named system nil))) + (when system + (setf (sct:system-modules system) :need-to-reload-system-declaration) + (sct:load-system-declaration-if-compressed system :newest)))) + (lexpr-funcall 'sct:compile-system system-spec compile-system-options)) + (format t "~& Compile System aborted.~2&")))) diff --git a/assembler/power.lisp b/assembler/power.lisp new file mode 100644 index 0000000..1958fe1 --- /dev/null +++ b/assembler/power.lisp @@ -0,0 +1,1295 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: Yes -*- + +(in-package "POWERPC-INTERNALS") + +;;; POWERPC Instructions From Instruction Encodings +(eval-when (compile load eval) + +(defvar *instruction-database* (make-hash-table)) +(defvar *register-database* (make-hash-table)) + +(defun find-instruction (name) + (lisp:or (gethash name *instruction-database* ()) + (error "No such instruction ~A." name))) + +(defun find-register (name) + (gethash name *register-database* ())) + + +;;; Instructions + +(clos:defclass instruction () + ((name :initarg :name :reader instruction-name))) + +(clos:defmethod clos:initialize-instance :after ((inst instruction) &key &allow-other-keys) + (clos:with-slots (name) inst + (setf (gethash name *instruction-database*) inst))) + +(clos:defmethod clos:print-object ((inst instruction) stream) + (future-common-lisp:print-unreadable-object (inst stream :type t :identity t) + (princ (clos:slot-value inst 'name) stream))) + +(clos:defclass pseudo-instruction (instruction) + ((args :accessor pseudo-instruction-args))) + + +(clos:defclass power-instruction (instruction) + ((code :initarg :code :reader instruction-code) + ;;(class :initarg :class :reader instruction-class) + )) + +(clos:defclass i-form-instruction (power-instruction) + ()) + +(clos:defclass b-form-instruction (power-instruction) + ()) + +(clos:defclass sc-form-instruction (power-instruction) + ()) + +(clos:defclass d-form-instruction (power-instruction) + ()) + +(clos:defclass ds-form-instruction (power-instruction) + ()) + +(clos:defclass x-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass x1-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass x2-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass x2l-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass cmp-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass fcmp-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass xo-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass xo2-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass xs-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass xl-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass xfx-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass xfl-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass a-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass mds-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass md-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + +(clos:defclass m-form-instruction (power-instruction) + ((xcode :initarg :xcode :reader instruction-xcode))) + + +#|| +;;; Instruction classes + +(defvar *instruction-class-names* + '(LD JSR IADDLOG SHIFTCM ICMP IMULL IMULQ FPOP FDIVS FDIVT)) + +;; First element of each entry is the consumer, and the rest of +;; the entry is the possible producers. In order, they are: +;; LD JSR IADDLOG SHIFTCM ICMP IMULL IMULQ FPOP FDIVS FDIVT +(defvar *instruction-classes* + '((LD 3 3 2 2 2 21 23 NIL NIL NIL) + ;; First value is for base, second for data + (ST 3 3 (2 0) (2 0) (2 0) (21 20) (23 22) 4 32 61) + (IBR 3 3 1 2 1 21 23 NIL NIL NIL) + (JSR 3 3 2 2 2 21 23 NIL NIL NIL) + (IADDLOG 3 3 1 2 2 21 23 NIL NIL NIL) + (SHIFTCM 3 3 1 2 2 21 23 NIL NIL NIL) + (ICMP 3 3 1 2 2 21 23 NIL NIL NIL) + ;; First is for data-dependency, second for execution + (IMULL 3 3 1 2 2 (21 19) (23 21) NIL NIL NIL) + (IMULQ 3 3 1 2 2 21 23 NIL NIL NIL) + (FBR 3 NIL NIL NIL NIL NIL NIL 6 34 63) + (FPOP 3 NIL NIL NIL NIL NIL NIL 6 34 63) + (FDIVS 3 NIL NIL NIL NIL NIL NIL 6 34 63) + ;; First is for data-dependency, second for execution + (FDIVT 3 NIL NIL NIL NIL NIL NIL 6 (34 30) (63 59)))) + +(defvar *instruction-box-alist* + '((LD Abox) (ST Abox) (IBR Ebox) (JSR Ebox) + (IADDLOG Ebox) (SHIFTCM Ebox) (ICMP Ebox) + (IMULL Ebox) (IMULQ Ebox) (FBR Fbox) + (FPOP Fbox) (FDIVS Fbox) (FDIVT Fbox))) +||# + +;;; Fill instruction table + +;; I-FORM class +(loop for (name code) in '((b 18) (ba 18) (bl 18) (bla 18)) + do (clos:make-instance 'i-form-instruction + :name name :code code)) + +;; B-FORM class +(loop for (name code) in '((bc 16)) + do (clos:make-instance 'b-form-instruction + :name name :code code)) + +;; SC-FORM class +(loop for (name code) in '((sc 17)) + do (clos:make-instance 'sc-form-instruction + :name name :code code)) + +;; D-FORM class +(loop for (name code) in '((addi 14) (subi 14) (addic 12) (addic-dot 13) (addis 15) + (andi-dot 28) + (andis-dot 29) (lbz 34) (lbzu 35) (lfd 50) + (lfdu 51) (lfs 48) (lfsu 49) (lha 42) (lhau 43) (lhz 40) (lhzu 41) + (lmw 46) (lwz 32) (lwzu 33) (mulli 7) (ori 24) (oris 25) (stb 38) + (stbu 39) (stfd 54) (stfdu 55) (stfs 52) (stfsu 53) (sth 44) + (sthu 45) (stmw 47) (stw 36) (stwu 37) (subfic 8) (tdi 2) (twi 3) + (xori 26) (xoris 27)) + do (clos:make-instance 'd-form-instruction + :name name :code code)) + +;; DS-FORM class +(loop for (name code xcode) in '((ld 58 0) (ldu 58 1) (lwa 58 2) (std 62 0) (stdu 62 1)) + do (clos:make-instance 'ds-form-instruction + :name name :code code :xcode xcode)) + +;; X-FORM class +(loop for (name code xcode) in '((and 31 28) (and-dot 31 28) (andc 31 60) (andc-dot 31 60) + (dcba 31 758) (dcbf 31 86) + (dcbi 31 470) (dcbst 31 54) (dcbt 31 278) (dcbtst 31 246) + (dcbz 31 1014) (eciwx 31 310) (ecowx 31 438) (eieio 31 854) + (eqv 31 284) (eqv-dot 31 284) + (icbi 31 982) (lbzux 31 119) (lbzx 31 87) (ldarx 31 84) + (ldux 31 53) (ldx 31 21) (lfdux 31 631) (lfdx 31 599) + (lfsux 31 567)(lfsx 31 535) (lhaux 31 375) (lhax 31 343) + (lhbrx 31 790) (lhzux 31 311) (lhzx 31 279) (lswi 31 597) + (lswx 31 533) (lsarx 31 20) (lwaux 31 373) (lwax 31 341) + (lwbrx 31 534) (lwzux 31 55) (lwzx 31 23) (mcrfs 63 64) (mfmsr 31 83) + (mfsr 31 595) (mfsrin 31 659) + (mtmsr 31 146) (mtmsrd 31 178) (mtsr 31 210) + (mtsrd 31 82) (mtsrin 31 242) (mtsrdin 31 114) + (nand 31 476) (nand-dot 31 476) (nor 31 124) (nor-dot 31 124) + (or 31 444) (or-dot 31 444) (orc 31 412) (orc-dot 31 412) (sibia 31 498) + (slbie 31 434) (sld 31 27) (sld-dot 31 27) (slw 31 24) (slw-dot 31 24) + (srad 31 794) (srad-dot 31 794) (sraw 31 792) (sraw-dot 31 792) + (srawi 31 824) (srawi-dot 31 824) (srd 31 539) (srd-dot 31 539) + (srw 31 536) (srw-dot 31 536) + (stbux 31 247) (stbx 31 215) (stdcx-dot 31 214) (stdux 31 181) + (stdx 31 149) (stfdux 31 759) (stfdx 31 727) (stfiwx 31 983) + (stfsux 31 695) (stfsx 31 663) (sthbrx 31 918) (sthux 31 439) + (sthx 31 407) (stswi 31 725) (stswx 31 661) (stwbrx 31 662) + (stwcx-dot 31 150) (stwux 31 183) (stwx 31 151) (sync 31 598) + (td 31 68) (tibia 31 370) (tibie 31 306) (tibsync 31 566) + (tw 31 4) (xor 31 316) (xor-dot 31 316)) + + do (clos:make-instance 'x-form-instruction + :name name :code code :xcode xcode)) + +;; X1-FORM class +(loop for (name code xcode) in '((mcrxr 31 512) (mfcr 31 19) + (mffs 63 583) (mffs-dot 63 583) + (mtfsb0 63 70) (mtfsb0-dot 63 70) + (mtfsb1 63 38) (mtfsb1-dot 63 38)) + do (clos:make-instance 'x1-form-instruction + :name name :code code :xcode xcode)) + +;; X2-FORM class +(loop for (name code xcode) in '((cntlzd 31 58) (cntlzd-dot 31 58) + (cntlzw 31 26) (cntlzw-dot 31 26) + (extsb 31 954) (extsb-dot 31 954) + (extsh 31 922) (extsh-dot 31 922) + (extsw 31 986) (extsw-dot 31 986) + (fabs 63 264) (fabs-dot 63 264) + (fmr 63 72) (fmr-dot 63 72) + (fnabs 63 136) (fnabs-dot 63 136) + (fneg 63 40) (fneg-dot 63 40) + (frsp 63 12) (frsp-dot 63 12) + (fcfid 63 846) (fcfid-dot 63 846) + (fctid 63 814) (fctid-dot 63 814) + (fctidz 63 815) (fctidz-dot 63 815) + (fctiw 63 14) (fctiw-dot 63 14) + (fctiwz 63 15) (fctiwz-dot 63 15) + (mtfsfi 63 134) (mtfsfi-dot 63 134)) + do (clos:make-instance 'x2-form-instruction + :name name :code code :xcode xcode)) + +;; X2L-FORM class +(loop for (name code xcode) in '((mtfsfi 63 134) (mtfsfi-dot 63 134)) + do (clos:make-instance 'x2l-form-instruction + :name name :code code :xcode xcode)) + +;; CMP-FORM class +(loop for (name code xcode) in '((cmp 31 0) (cmpi 11 -1) (cmpl 31 32) (cmpli 10 -1)) + do (clos:make-instance 'cmp-form-instruction + :name name :code code :xcode xcode)) + +;; FCMP-FORM class +(loop for (name code xcode) in '((fcmpo 63 32) (fcmpu 63 0)) + do (clos:make-instance 'fcmp-form-instruction + :name name :code code :xcode xcode)) + +;; XO-FORM class +(loop for (name code xcode) in '((add -1 -1) (add-dot -1 -1) (addo -1 -1) (addo-dot -1 -1) + (addc -1 -1) (addc-dot -1 -1) (addco -1 -1) (addco-dot -1 -1) + (adde -1 -1) (adde-dot -1 -1) (addeo -1 -1) (addeo-dot -1 -1) + (addme -1 -1) (addme-dot -1 -1) (addmeo -1 -1) (addmeo-dot -1 -1) + (addze -1 -1) (addze-dot -1 -1) (addzeo -1 -1) (addzeo-dot -1 -1) + (divd -1 -1) (divd-dot -1 -1) (divdo -1 -1) (divdo-dot -1 -1) + (divdu -1 -1) (divdu-dot -1 -1) (divduo -1 -1) (divduo-dot -1 -1) + (divw -1 -1) (divw-dot -1 -1) (divwo -1 -1) (divwo-dot -1 -1) + (divwu -1 -1) (divwu-dot -1 -1) (divwuo -1 -1) (divwuo-dot -1 -1) + (mulhd -1 -1) (mulhd-dot -1 -1) (mulhdu -1 -1) (mulhdu-dot -1 -1) + (mulhw -1 -1) (mulhw-dot -1 -1) (mulhwu -1 -1) (mulhwu-dot -1 -1) + (mulld -1 -1) (mulld-dot -1 -1) (mulldo -1 -1) (mulldo-dot -1 -1) + (mullw -1 -1) (mullw-dot -1 -1) (mullwo -1 -1) (mullwo-dot -1 -1) + (neg -1 -1) (neg-dot -1 -1) (nego -1 -1) (nego-dot -1 -1) + (subf -1 -1) (subf-dot -1 -1) (subfo -1 -1) (subfo-dot -1 -1) + (subfc -1 -1) (subfc-dot -1 -1) (subfco -1 -1) (subfco-dot -1 -1) + (subfe -1 -1) (subfe-dot -1 -1) (subfeo -1 -1) (subfeo-dot -1 -1) + (subfme -1 -1) (subfme-dot -1 -1) (subfmeo -1 -1) (subfmeo-dot -1 -1) + (subfze -1 -1) (subfze-dot -1 -1) (subfzeo -1 -1) (subfzeo-dot -1 -1)) + do (clos:make-instance 'xo-form-instruction + :name name :code code :xcode xcode)) + +;; XO2-FORM class +(loop for (name code xcode) in '((addme -1 -1) (addme-dot -1 -1) (addmeo -1 -1) (addmeo-dot -1 -1) + (addze -1 -1) (addze-dot -1 -1) (addzeo -1 -1) (addzeo-dot -1 -1) + (neg -1 -1) (neg-dot -1 -1) (nego -1 -1) (nego-dot -1 -1) + (subfme -1 -1) (subfme-dot -1 -1) (subfmeo -1 -1) (subfmeo-dot -1 -1) + (subfze -1 -1) (subfze-dot -1 -1) (subfzeo -1 -1) (subfzeo-dot -1 -1)) + do (clos:make-instance 'xo2-form-instruction + :name name :code code :xcode xcode)) + +;; XL-FORM class +(loop for (name code xcode) in '((bcctr -1 -1) (bcctrl -1 -1) (bclr -1 -1) (bclrl -1 -1) + (crand -1 -1) (crandc -1 -1) (creqv -1 -1) (crnand -1 -1) + (crnor -1 -1) (cror -1 -1) (crorc -1 -1) (crxor -1 -1) + (isync -1 -1) (mcrf -1 -1) (rfi -1 -1) (rfid -1 -1)) + + do (clos:make-instance 'xl-form-instruction + :name name :code code :xcode xcode)) + +;; XFX-FORM class +(loop for (name code xcode) in '((mfspr -1 -1) (mftb -1 -1) (mtcrf -1 -1) (mtspr -1 -1)) + + do (clos:make-instance 'xfx-form-instruction + :name name :code code :xcode xcode)) + +;; XS-FORM class +(loop for (name code xcode) in '((sradi -1 -1) (sradi-dot -1 -1)) + + do (clos:make-instance 'xs-form-instruction + :name name :code code :xcode xcode)) + +;; XFL-FORM class +(loop for (name code xcode) in '((mtfsf -1 -1) (mtfsf-dot -1 -1)) + + do (clos:make-instance 'xfl-form-instruction + :name name :code code :xcode xcode)) + +;; A-FORM class +(loop for (name code xcode) in '((fadd -1 -1) (fadd-dot -1 -1) (fadds -1 -1) (fadds-dot -1 -1) + (fdiv -1 -1) (fdiv-dot -1 -1) (fdivs -1 -1) (fdivs-dot -1 -1) + (fmadd -1 -1) (fmadd-dot -1 -1) (fmadds -1 -1) (fmadds-dot -1 -1) + (fmsub -1 -1) (fmsub-dot -1 -1) (fmsubs -1 -1) (fmsubs-dot -1 -1) + (fmul -1 -1) (fmul-dot -1 -1) (fmuls -1 -1) (fmuls-dot -1 -1) + (fnmadd -1 -1) (fnmadd-dot -1 -1) (fnmadds -1 -1) (fnmadds-dot -1 -1) + (fnmsub -1 -1) (fnmsub-dot -1 -1) (fnmsubs -1 -1) (fnmsubs-dot -1 -1) + (fres -1 -1) (fres-dot -1 -1) + (frsqrte -1 -1) (frsqrte-dot -1 -1) + (fsel -1 -1) (fsel-dot -1 -1) + (fsqrt -1 -1) (fsqrt-dot -1 -1) (fsqrts -1 -1) (fsqrts-dot -1 -1) + (fsub -1 -1) (fsub-dot -1 -1) (fsubs -1 -1) (fsubs-dot -1 -1)) + + do (clos:make-instance 'a-form-instruction + :name name :code code :xcode xcode)) + +;; MDS-FORM class +(loop for (name code xcode) in '((rldcl -1 -1) (rldcl-dot -1 -1) (rldcr -1 -1) (rldcr-dot -1 -1)) + + do (clos:make-instance 'mds-form-instruction + :name name :code code :xcode xcode)) + +;; MD-FORM class +(loop for (name code xcode) in '((rldic -1 -1) (rldic-dot -1 -1) (rldicl -1 -1) (rldicl-dot -1 -1) + (rldicr -1 -1) (rldicr-dot -1 -1) (rldimi -1 -1) (rldimi-dot -1 -1)) + + do (clos:make-instance 'md-form-instruction + :name name :code code :xcode xcode)) + +;; M-FORM class +(loop for (name code xcode) in '((rlwimi -1 -1) (rlwimi-dot -1 -1) (rlwinm -1 -1) (rlwinm-dot -1 -1) + (rlwnm -1 -1) (rlwnm-dot -1 -1)) + + do (clos:make-instance 'm-form-instruction + :name name :code code :xcode xcode)) + +;;; Registers + +(clos:defclass register () + ((name :initarg :name :reader register-name) + (code :initarg :code :reader register-code) + (asmname :initarg :asmname :reader register-asmname))) + +(clos:defmethod clos:print-object ((reg register) stream) + (future-common-lisp:print-unreadable-object (reg stream :type t :identity t) + (princ (clos:slot-value reg 'name) stream))) + +(clos:defclass power-register (register) ()) + +(clos:defclass integer-power-register (power-register) ()) + +(clos:defclass FP-power-register (power-register) ()) + +(clos:defmethod clos:initialize-instance :after ((reg register) &key &allow-other-keys) + (clos:with-slots (name) reg + (setf (gethash name *register-database*) reg))) + +(loop for (name code aname) in + '((r0 0 0) (r1 1 1) (r2 2 2) (r3 3 3) + (r4 4 4) (r5 5 5) (r6 6 6) (r7 7 7) + (r8 8 8) (r9 9 9) (r10 10 10) (r11 11 11) + (r12 12 12) (r13 13 13) (r14 14 14) (r15 15 15) + (r16 16 16) (r17 17 17) (r18 18 18) (r19 19 19) + (r20 20 20) (r21 21 21) (r22 22 22) (r23 23 23) + (r24 24 24) (r25 25 25) (r26 26 26) (r27 27 27) + (r28 28 28) (r29 29 29) (r30 30 30) (r31 31 31) + ;; (at 28 |$at|) (gp 29 |$gp|) (sp 30 |$sp|) + (cr -1 |$cr|) (fpscr -1 |$fpscr|) (xer -1 |$xer|) (lr -1 |$lr|) (ctr -1 |$ctr|)) + do (clos:make-instance 'integer-power-register :name name :code code :asmname aname)) + +(defun register-number (reg) + (cond ((numberp reg) reg) + ((symbolp reg) (register-code (find-register reg))) + ((consp reg) (register-code (find-register (car reg)))) + (:otherwise (error "~a is not a valid register designator.")))) + +(defmacro define-integer-register + (name reg &optional (printas (intern (format nil "~a" + (register-number reg) + (find-package "POWERPC-INTERNALS"))))) + `(clos:make-instance 'integer-power-register + :name ',name + :code ,(register-number reg) + :asmname ',printas)) + +(loop for (name code aname) in + '((f0 0 0) (f1 1 1) (f2 2 2) (f3 3 3) + (f4 4 4) (f5 5 5) (f6 6 6) (f7 7 7) + (f8 8 8) (f9 9 9) (f10 10 10) (f11 11 11) + (f12 12 12) (f13 13 13) (f14 14 14) (f15 15 15) + (f16 16 16) (f17 17 17) (f18 18 18) (f19 19 19) + (f20 20 20) (f21 21 21) (f22 22 22) (f23 23 23) + (f24 24 24) (f25 25 25) (f26 26 26) (f27 27 27) + (f28 28 28) (f29 29 29) (f30 30 30) (f31 31 31)) + do (clos:make-instance 'FP-power-register :name name :code code :asmname aname)) + +) ;eval-when + + +;;; Pseudo operations + +(loop for name in '(start end mark + label unlikely-label external-branch call-subroutine + comment include passthru) + do (clos:make-instance 'pseudo-instruction :name name)) + + + +;;; Assembler emitter + +(defvar *instruction-counter* 0) +(defvar *n-previous-instructions* 24.) +(defvar *previous-instructions* nil) +(defvar *last-instruction* nil) + +;;; emit-operation takes an operation and emits the representation of the operation if any. +;;; the operation may be a pseudo operation and so may not emit anything at all, or may +;;; emit a lot. It may emit instructions asembler directives comments or any combination +;;; thereof. + +(clos:defgeneric emit-operation (operation &optional destination args)) + +(clos:defmethod emit-operation ((operation list) &optional (destination nil) (args nil)) + (let ((instruction (find-instruction (car operation)))) + (assert (null args)) + (emit-operation instruction destination (cdr operation)))) + +(clos:defmethod emit-operation :after ((operation power-instruction) + &optional destination args) + (declare (ignore destination args)) + (incf *instruction-counter*)) + +(clos:defmethod emit-operation :after ((operation instruction) + &optional destination args) + (declare (ignore destination args)) + (setq *last-instruction* operation)) + +(clos:defmethod push-operation + ((operation power-instruction) reads writes cycles) + ;; Prepare the previous instruction stack for a new entry + (replace *previous-instructions* *previous-instructions* + :start1 1 :end1 (- *n-previous-instructions* 1) + :start2 0 :end2 (- *n-previous-instructions* 2)) + ;; Set it + (setf (aref *previous-instructions* 0) (list operation reads writes cycles))) + +;; The idea here is that we have to spend at least one cycle on the current +;; instruction (unless is was dual-issued), plus zero or more latent cycles +;; if there a register dependencies or instruction class dependencies. +(clos:defmethod compute-cycle-count + ((operation power-instruction) reads writes &optional indexreg) + #+Genera (declare (values cycles dual-issue)) + (declare (ignore reads writes indexreg)) + ;; ---*** TODO: Don't know how to compute this yet ... + (values 0 nil)) + +(defun intersection-p (list1 list2) + (dolist (l list1 nil) + (when (member l list2) + (return t)))) + +(defparameter *for-vms* nil) +(defun instruction-pname (name) + (let* ((iname (if *for-vms* + (symbol-name name) + (delete #\/ (string-downcase (symbol-name name))))) + (slen (length iname))) + (if (> slen 4) + (let* ((head (subseq iname 0 (- slen 4))) + (tail (subseq iname (- slen 4)))) + (if (equal (string-downcase tail) "-dot") + (format nil "~a." head) + iname)) + iname))) + +(clos:defmethod emit-operation ((operation i-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (disp &optional comment) args + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation nil nil) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a" (coerce-to-displacement disp)) + (format destination "~@[ # ~a~]" comment) + cycles)))) + +(clos:defmethod emit-operation ((operation b-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (bo bi target &optional comment) args + (let* ((BO-num (coerce-to-literal bo)) + (BI-num (coerce-to-literal bi))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation nil nil) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," BO-num) + (format destination "~a," BI-num) + (format destination "~a" target) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation md-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd regs sh mb &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (theregs (coerce-to-register regs)) + (SH-num (coerce-to-literal sh)) + (MB-num (coerce-to-literal mb)) + (reads (list theregs)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a," theregs) + (format destination "~a," SH-num) + (format destination "~a" MB-num) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation m-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd regs sh mb me &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (theregs (coerce-to-register regs)) + (SH-num (coerce-to-register-or-literal sh)) + (ME-num (coerce-to-literal me)) + (MB-num (coerce-to-literal mb)) + (reads (list theregs)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a," theregs) + (format destination "~a," SH-num) + (format destination "~a," MB-num) + (format destination "~a" ME-num) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation mds-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd regs regb mb &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (theregb (coerce-to-register regb)) + (theregs (coerce-to-register regs)) + (MB-num (coerce-to-literal mb)) + (reads (list theregb theregs)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a," theregs) + (format destination "~a," theregb) + (format destination "~a" MB-num) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation sc-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (&optional comment) args + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation nil nil) + (declare (ignore dual-issue)) + (format destination "~& ~a" (instruction-pname name)) + (format destination "~@[ # ~a~]" comment) + cycles)))) + +(clos:defmethod emit-operation ((operation d-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (reg1 lit reg2 &optional comment) args + (let* ((theregd (coerce-to-register reg1))) + (multiple-value-bind (thelit thelit-type) + (coerce-to-register-or-literal lit) + (multiple-value-bind (therega therega-type) + (coerce-to-register-or-literal reg2) + (let ((reads (list therega)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (cond ((lisp:and (eq thelit-type :literal) (eq therega-type :register)) + (format destination "~a" thelit) + (format destination "(~a)" therega)) + (t + (format destination "~a," thelit) + (format destination "~a" therega))) + (format destination "~@[ # ~a~]" comment) + cycles)))))))) + +(clos:defmethod emit-operation ((operation ds-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd disp &optional index comment) args + (let* ((theregd (coerce-to-register regd)) + (thedisp (coerce-to-displacement disp)) + (theindex (if index (coerce-to-register index) nil)) + (reads (list theindex)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a" thedisp) + (if theindex (format destination "(~a)" theindex)) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation x-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd reg1 reg2 &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (thereg1 (coerce-to-register reg1)) + (thereg2 (coerce-to-register reg2)) + (reads (list thereg1 thereg2)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a," thereg1) + (format destination "~a" thereg2) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation x1-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd &optional comment) args + (let* ((theregd (coerce-to-register-or-literal regd)) + (reads (list theregd)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a" theregd) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation x2-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd reg1 &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (thereg1 (coerce-to-register reg1)) + (reads (list thereg1)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a" thereg1) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation x2l-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (lit1 lit2 &optional comment) args + (let* ((thelit1 (coerce-to-literal lit1)) + (thelit2 (coerce-to-literal lit2)) + (reads nil) + (writes nil)) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," thelit1) + (format destination "~a" thelit2) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation xo-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd reg1 reg2 &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (thereg1 (coerce-to-register reg1)) + (thereg2 (coerce-to-register reg2)) + (reads (list thereg1 thereg2)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a," thereg1) + (format destination "~a" thereg2) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation xo2-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd reg1 &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (thereg1 (coerce-to-register reg1)) + (reads (list thereg1)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a" thereg1) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation xl-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (bo bi &optional comment) args + (let* ((BO-num bo) + (BI-num bi) + (reads nil) + (writes nil)) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," BO-num) + (format destination "~a" BI-num) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation xs-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd regs sh &optional comment) args + (let* ((SH-num sh) + (theregd (coerce-to-register regd)) + (theregs (coerce-to-register regs)) + (reads (list theregs)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a," theregs) + (format destination "~a" SH-num) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation xfx-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd spr &optional comment) args + (let* ((theregd (coerce-to-register-or-literal regd)) + (thelit (coerce-to-register-or-literal spr)) + (reads nil) + (writes nil)) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a" thelit) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation xfl-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (flm regb &optional comment) args + (let* ((thelit (coerce-to-literal flm)) + (theregb (coerce-to-register regb)) + (reads (list regb)) + (writes nil)) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," thelit) + (format destination "~a" theregb) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation a-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (regd reg1 reg2 &optional comment) args + (let* ((theregd (coerce-to-register regd)) + (thereg1 (coerce-to-register reg1)) + (thereg2 (coerce-to-register reg2)) + (reads (list thereg1 thereg2)) + (writes (list theregd))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," theregd) + (format destination "~a," thereg1) + (format destination "~a" thereg2) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation cmp-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (BF L reg1 reg2 &optional comment) args + (let* ((BF-num (coerce-to-literal BF)) + (L-num (coerce-to-literal L)) + (thereg1 (coerce-to-register reg1)) + (thereg2 (coerce-to-register-or-literal reg2)) + (reads (list thereg1 thereg2)) + (writes (list thereg1))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," BF-num) + (format destination "~a," L-num) + (format destination "~a," thereg1) + (format destination "~a" thereg2) + (format destination "~@[ # ~a~]" comment) + cycles))))) + +(clos:defmethod emit-operation ((operation fcmp-form-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (destructuring-bind (BF reg1 reg2 &optional comment) args + (let* ((BF-num (coerce-to-literal BF)) + (thereg1 (coerce-to-register reg1)) + (thereg2 (coerce-to-register reg2)) + (reads (list thereg1 thereg2)) + (writes (list thereg1))) + (multiple-value-bind (cycles dual-issue) + (compute-cycle-count operation reads writes) + (declare (ignore dual-issue)) + (format destination "~& ~a " (instruction-pname name)) + (format destination "~a," BF-num) + (format destination "~a," thereg1) + (format destination "~a" thereg2) + (format destination "~@[ # ~a~]" comment) + cycles))))) + + +;;;---*** TODO: IS THIS MEANINGFUL ON POWERPC? +(defparameter *label-alignment* 2) + +;;;---*** TODO: IS THIS MEANINGFUL ON POWERPC? +(defparameter *function-alignment* 3) + +(defvar *func-name* nil) +(defvar *func-is-external* nil) +(defvar *func-nargs* nil) +(defvar *func-is-fast* nil) + +(clos:defmethod emit-operation ((operation pseudo-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (setf (pseudo-instruction-args operation) args) + (labels ((emit (fmt &rest args) + (apply #'format destination "~&~@?" fmt args))) + (case name + (start + (destructuring-bind (func &key external (nargs 0) fast) args + (setq *func-name* func + *func-is-external* external + *func-nargs* nargs + *func-is-fast* fast) + (when external + (emit " .section \".toc\",\"aw\"")) + (emit " .section \".text\"") + (emit " .align 2") + (emit " .globl ~A" func) + (emit " .section \".opd\",\"aw\"") + (emit " .align 3") + (if external + (progn + (emit "~A:" func) + (emit " .quad .~A,.TOC.@tocbase,0" func) + (emit " .previous") + (emit " .size ~A,24" func) + (emit " .type .~A,@function" func) + (emit " .globl .~A" func) + (emit ".~A:" func)) + (emit " .previous")) + (setq *instruction-counter* (logand (+ *instruction-counter* 1) -2)))) + (end + (destructuring-bind (func &optional comment) args + (assert (string= *func-name* func) () "Mis-matched START/END") + (unless (null comment) + (emit "# ~A" comment)) + (when *func-is-external* + (emit " .long 0") + ;;---*** TODO: EXPLAIN THIS? + ;; We save all GPRs but no FPR (PARMS ON STACK?) + (emit " .byte 0,12,~D,1,128,18,~D,1" (if *func-is-fast* 20 0) *func-nargs*) + (emit " .size .~A,.-.~A" func func)) + (setq *func-name* nil + *func-is-external* nil + *func-nargs* nil + *func-is-fast* nil))) + (mark + (error "This architecture does implement the ~S psuedo operation." 'mark)) + (label + (destructuring-bind (labelname &optional comment) args + ;;---*** TODO: DOES THIS HELP? + (emit "~& .align ~D" *label-alignment*) + ;;---*** (setq *instruction-counter* (logand (+ *instruction-counter* 1) -2)) + (emit "~&~A:~@[ # ~A~]" labelname comment))) + (unlikely-label + (destructuring-bind (labelname &optional comment) args + ;; Unlikely labels stay unaligned + (emit "~&~A:~@[ # ~A~]" labelname comment))) + (external-branch + (destructuring-bind (labelname &optional comment) args + (emit "~& B ~A~@[ # ~A~]" labelname comment))) + (call-subroutine + (when *func-is-fast* + (error "Can't ~S in ~S as it is a fast subroutine." 'call-subroutine *func-name*)) + (destructuring-bind (labelname &optional comment) args + (emit "~& BL ~A~@[ # ~A~]" + ;;(coerce-to-register linkage) + labelname comment))) + (comment + (destructuring-bind (&optional comment) args + (unless (null comment) (emit"~&# ~A" comment)))) + (include + (destructuring-bind (includefile) args + (load includefile :verbose t))) + (passthru + (destructuring-bind (astring &optional comment) args + (emit "~&~A~@[ # ~A~]" astring comment))) + (otherwise + (error "Unimplemented pseudo operation ~a." name)))) + 0)) + +(clos:defgeneric coerce-to-register (register)) + +(clos:defmethod coerce-to-register ((register symbol)) + (let ((aregister (find-register register))) + (if (null aregister) (error "Register named ~A not found." register)) + (coerce-to-register aregister))) + +(clos:defmethod coerce-to-register ((register cons)) + (coerce-to-register (car register))) + +(clos:defmethod coerce-to-register ((register register)) + (clos:with-slots (asmname) register + asmname)) + +(clos:defmethod coerce-to-register ((register number)) + (error "~D is not a valid register name." register)) + +(defun coerce-to-register-or-literal (datum) + #+Genera (declare (values datum type)) + (cond ((numberp datum) + (values datum :literal)) + ((find-register datum) + (values (coerce-to-register datum) :register)) + ((consp datum) + (coerce-to-register-or-literal (car datum))) + (t + (values datum :literal)))) + + +(clos:defgeneric coerce-to-displacement (displacement)) + +(clos:defmethod coerce-to-displacement ((displacement fixnum)) displacement) + +(clos:defmethod coerce-to-displacement ((displacement symbol)) displacement) + +(clos:defmethod coerce-to-displacement ((displacement string)) displacement) + + +(defun asm-header (destination sourcename) + (format destination + "~&# ************************************************************************") + (format destination + "~&# * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED") + (format destination + "~&# * FROM ~A. ANY CHANGES MADE TO THIS FILE WILL BE LOST" sourcename) + (format destination + "~&# ************************************************************************~%~%")) + +(defun asm-trailer (destination sourcename) + (format destination + "~%~%~%# End of file automatically generated from ~A~%" sourcename)) + +(defvar *function-being-processed* nil) +(defvar *function-epilogue*) + +(defun collecting-function-epilogue (body env) + (let ((*function-epilogue* nil)) + `(,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body) + ,@(loop while *function-epilogue* + append (mapcar #'(lambda (x) (macroexpand-asm-form x env)) + (shiftf *function-epilogue* nil)))))) + +;;; Loop through the asm source file and emit the instructions expanding any macros found +;;; along the way. +(defun process-asm-source (sourcefilename targetname) + (with-open-file (sfs sourcefilename :direction :input) + (with-open-file (tfs targetname :direction :output + #-Genera :if-exists #-Genera :supersede) + (let ((*package* (find-package "POWERPC-INTERNALS")) + (*read-base* 10) + (*print-base* 10) + (*previous-instructions* + (make-array *n-previous-instructions* :initial-element nil)) + (*last-instruction* nil) + (*instruction-counter* 0) + (*function-being-processed* nil) + (*func-name* nil) + (*func-is-external* nil)) + (asm-header tfs sourcefilename) + (do ((form (read sfs nil :eof) (read sfs nil :eof))) + ((eq form :eof) nil) + (when (consp form) + (process-asm-form form tfs))) + (asm-trailer tfs sourcefilename))))) + +;;; PROCESS-ASM-FORM handles the expansion of assembler macros. An +;;; assembler macro expands into a list of assembler operations any one of +;;; these may also be a macro The result of this loop is the linearization +;;; of assembler macros. +(defun process-asm-form (form destination &optional env) + (if (consp (first form)) + (loop for meform in form + summing (process-asm-form meform destination env)) + (let ((expanded (macroexpand form env))) + (if (eq expanded form) + (emit-operation form destination) + (loop for meform in expanded + summing (process-asm-form meform destination env)))))) + +;;; Like MACROEXPAND. Some macros might require this. It's needed because +;;; the evaluation semantics of our little assembler are not so hot. +(defun macroexpand-asm-form (form &optional env) + (if (consp (first form)) + (loop for meform in form + as expanded = (macroexpand-asm-form meform env) + if (consp (first expanded)) + append expanded + else + collect expanded) + (let ((expanded (macroexpand form env))) + (if (eq expanded form) + form + (macroexpand-asm-form expanded env))))) + +#+genera +(in-package "ZWEI") + +#+genera +(defcom com-power-assemble-region + "Assemble the region, putting output in the typeout window. +With a numeric argument, inserts the typeout into the buffer" () + (let ((ncycles 0) + nwords) + (definition-region-bps (sbp ebp) + (with-undo-save-if (and *numeric-arg-p* (plusp *numeric-arg*)) + ("Insert assembled code" + (copy-bp (point) :normal) (forward-sexp (point) 1 t) t) + (with-interval-stream (input-stream sbp ebp t) + (let ((output-stream (rest-of-interval-stream ebp)) + (cl:*package* (cl:find-package "POWERPC-INTERNALS")) + (cl:*read-base* 10) + (cl:*print-base* 10) + (ppci::*previous-instructions* + (cl:make-array ppci::*n-previous-instructions* :initial-element nil)) + (ppci::*last-instruction* nil) + (ppci::*instruction-counter* 0) + (ppci::*function-being-processed* nil) + (ppci::*function-epilogue* nil) + (ppci::*func-name* nil) + (ppci::*func-is-external* nil)) + (do ((form (cl:read input-stream nil :eof) (cl:read input-stream nil :eof))) + ((eq form :eof) nil) + (when (cl:consp form) + (incf ncycles + (ppci::process-asm-form + form (if *numeric-arg-p* + (if (plusp *numeric-arg*) output-stream 'sys:null-stream) + cl:*standard-output*))))) + (dolist (form ppci::*function-epilogue*) + (when (cl:consp form) + (incf ncycles + (ppci::process-asm-form + form (if *numeric-arg-p* + (if (plusp *numeric-arg*) output-stream 'sys:null-stream) + cl:*standard-output*))))) + (setq nwords ppci::*instruction-counter*) + (close output-stream))))) + (zwei:typein-line "Total of ~D cycles in ~D instructions (~$ CPI)" ncycles nwords + (float (lisp:/ ncycles nwords)))) + (if *numeric-arg-p* dis-text dis-none)) + +#+genera +(set-comtab *standard-comtab* + '(#\c-m-sh-M com-power-assemble-region + #\c-m-sh-A com-power-assemble-region)) + +#+genera +(eval-when (compile load eval) (future-common-lisp:in-package "POWERPC-INTERNALS")) + + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Native Power Assembler Support ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; This provides support for assembling the standard Power instruction +;;; format into 'bits' (rather than writing an ascii file). It is used by +;;; the translator to generate DTP-NATIVEINSTRUCTIONs + +(clos:defclass power-instruction-block () + ((iblock :initform (make-array 10)))) + +(clos:defmethod emit-powerbits ((destination power-instruction-block) bits &optional disp) + (declare (ignore disp)) + (clos:with-slots (iblock) destination + (vector-push-extend bits iblock))) + +(clos:defgeneric coerce-to-register-number (register)) + +(clos:defmethod coerce-to-register-number ((register symbol)) + (let ((aregister (find-register register))) + (if (null aregister) (error "Register named ~A not found." register)) + (coerce-to-register-number aregister))) + +(clos:defmethod coerce-to-register-number ((register cons)) + (coerce-to-register-number (car register))) + +(clos:defmethod coerce-to-register-number ((register register)) + (clos:with-slots (code) register + code)) + +(defun register-operandp (datum) (find-register datum)) + +(defun coerce-to-register-number-or-literal (datum) + (if (numberp datum) + datum + (if (find-register datum) + (coerce-to-register-number datum) + datum))) + +(defun coerce-to-literal (datum) + (if (numberp datum) + datum + (if (find-register datum) + (error "Register ~a found where a literal was expected." + (coerce-to-register-number datum)) + datum))) + +;;; useful instruction format byte positions + +;;; all instructions +(defconstant %%power-inst-opcode (byte 6 26)) +;;; all but palcode +(defconstant %%power-inst-ra (byte 5 21)) +;;; memory and operate +(defconstant %%power-inst-rb (byte 5 16)) +;;; operate literal bit +(defconstant %%power-inst-litp (byte 1 12)) +;;; operate literal +(defconstant %%power-inst-literal (byte 8 13)) +;;; operate +(defconstant %%power-inst-function (byte 10 5)) +(defconstant %%power-inst-rc (byte 5 0)) +;;; memory +(defconstant %%power-inst-memory-disp (byte 16 0)) +;;; branch +(defconstant %%power-inst-branch-disp (byte 21 0)) + +;;; assemble-operation takes an operation and emits the bit pattern of the operation if any. +;;; the operation may be a pseudo operation and so may not emit anything at all, or may +;;; emit a lot. + +(clos:defgeneric assemble-operation (operation &optional destination args)) + +(clos:defmethod assemble-operation ((operation list) &optional (destination nil) (args nil)) + (let ((instruction (find-instruction (car operation)))) + (assert (null args)) + (assemble-operation instruction destination (cdr operation)))) + +(defun NYI (&rest args) + (declare (ignore args)) + (error "Operation not yet implemented")) + +#+ignore +(clos:defmethod assemble-operation ((operation pseudo-instruction) + &optional (destination nil) (args nil)) + (clos:with-slots (name) operation + (setf (pseudo-instruction-args operation) args) + (ecase name + (label + (destructuring-bind (labelname &optional comment) args + (declare (ignore comment)) + ;; --- force-alignment + (setlabel destination labelname) + )) + (unlikely-label + (destructuring-bind (labelname &optional comment) args + (declare (ignore comment)) + ;; Unlikely labels stay unaligned + (setlabel destination labelname))) + + (comment + ) + )) + nil) + + +;;; assemble-asm-FORM handles the expansion of assembler macros. An +;;; assembler macro expands into a list of assembler operations any one of +;;; these may also be a macro The result of this loop is the linearization +;;; of assembler macros. +(defun assemble-asm-form (form destination &optional env) + (if (consp (first form)) + (loop for meform in form + doing (assemble-asm-form meform destination env)) + (let ((expanded (macroexpand form env))) + (if (eq expanded form) + (assemble-operation form destination) + (loop for meform in expanded + doing (assemble-asm-form meform destination env)))))) + + + +;;; Tests + +(defun testemit (operation) + (with-output-to-string (strm) + (emit-operation operation strm))) + +;;; test memory format instructions with and without an index +;;; i-form +;;; (testemit '(B foo123456 "Jump to 123456")) +;;; b-form +;;; (testemit '(BC 12 0 foo123456 "Jump to 123456")) +;;; d-form +;;; (testemit '(ADDI R4 R5 -45)) +;;; (testemit '(LBZ R4 45 (R7))) +;;; ds-form +;;; (testemit '(LD R3 1234 R0)) +;;; (testemit '(LD R3 1234)) +;;; x-form +;;; (testemit '(ANDC R1 R2 R3 "foo")) +;;; xo-form +;;; (testemit '(add R2 R3 R5 "Wow.")) +;;; xs-form +;;; (testemit '(sradi R4 R5 42 "Shift right 42 bits algebraic")) +;;; xl-form +;;; (testemit '(bclr 12 0)) +;;; xfx-form +;;; (testemit '(mfspr R5 8 "Get the link register")) +;;; xfl-form +;;; NYI +;;; a-form +;;; (testemit '(fadds F2 F3 F4 "Look i'm using floating point!")) +;;; m-form +;;; (testemit '(rlwimi R3 R4 27 42 12)) +;;; md-form +;;; (testemit '(rldic R3 R4 27 9)) +;;; mds-form +;;; (testemit '(rldcl R3 R4 R5 27)) + +;;; test pseudo operations +;;; (testemit '(label foo)) +;;; (testemit '(comment "able was I ere I saw Elba")) +;;; (testemit '(passthru ".foo 42" "this is a passthru!")) + + + +;;; Fin. diff --git a/assembler/powerdsdl.lisp b/assembler/powerdsdl.lisp new file mode 100644 index 0000000..9b376a2 --- /dev/null +++ b/assembler/powerdsdl.lisp @@ -0,0 +1,990 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: Yes -*- + +(in-package "POWERPC-INTERNALS") + +(eval-when (compile load eval) + (pushnew :64bitmachine *features*) + (pushnew :powerpc-emulator *features*)) + +;;; DSDL-power is derived from the CLOE DSDL facility. + +(defvar *dsdl-objects*) + +(defvar *dsdl-object-table*) + +(defmacro define-dsdl-dispatch (name arglist &body body) + #+Genera `(defun (:property ,@name) ,arglist ,@body) + #-Genera `(setf (get ',(first name) ',(second name)) + #'(lambda ,arglist + (block ,(second name) ,@body)))) + + +(defun get-dsdl-dispatch (thing dispatch-name) + (lisp:or (get thing dispatch-name) + (error "Can't find dispatch property ~S for ~S." thing dispatch-name))) + +(defun set-dsdl-dispatch (thing dispatch-name value) + (setf (get thing dispatch-name) value)) + +(defsetf get-dsdl-dispatch set-dsdl-dispatch) + + +(defun get-dsdl-data (thing kind indicator) + (dolist (e *dsdl-objects*) + (when (lisp:and (eq (first e) thing) (eq (second e) kind)) + (return (getf (cddr e) indicator))))) + +(defun set-dsdl-data (thing kind indicator value) + (dolist (e *dsdl-objects* (error "No entry found for a ~S ~S." thing kind)) + (when (lisp:and (eq (first e) thing) (eq (second e) kind)) + (return (setf (getf (cddr e) indicator) value))))) + +(defsetf get-dsdl-data set-dsdl-data) + + +(defun dsdl-no-op (&rest ignore) + (declare (ignore ignore) + #+CLOE (sys::downward-rest-argument)) + nil) + + +(defvar *dsdl-new-type-scheme*) + +(defmacro with-dsdl-object-context (&body body) + `(let ((*dsdl-objects* nil) + (*dsdl-object-table* (make-hash-table :test #'equal)) + (*dsdl-new-type-scheme* nil)) + ,@body)) + +(defun find-dsdl-object-named (name) + (gethash name *dsdl-object-table*)) + +(defun add-dsdl-object-entry (entry) + (let ((v (gethash (car entry) *dsdl-object-table*))) + (when v + (warn "~S, being defined as a ~S, is already defined as a ~S." + (car entry) (cadr entry) (cadr v))) + (push entry *dsdl-objects*) + (setf (gethash (car entry) *dsdl-object-table*) entry)) + entry) + +(defun add-dsdl-object (name type value &optional plist) + (add-dsdl-object-entry (list* name type value plist))) + +(defun note-dsdl-reference (name type) + (let ((v (gethash name *dsdl-object-table*))) + (if v + (warn "~S, being defined as a ~S, is already defined as a ~S." + name type (cadr v)) + (setf (gethash name *dsdl-object-table*) v)))) + + +(defun process-dsdl-file (filename) + (with-open-file (s filename :if-does-not-exist :error) + (let ((eof (list nil)) dispfun) + (loop for form = (read s nil eof) until (eq form eof) + do (if (lisp:and (consp form) + (symbolp (car form)) + (setq dispfun (get-dsdl-dispatch (car form) 'dsdl-toplevel))) + (funcall dispfun form) + (error "Unrecognized form: ~S." form)))))) + +(defun write-dsdl-data (input-file filename language) + (with-open-file (s filename :direction :output #-Genera :if-exists #-Genera :supersede) + (let ((indicator-writers (get-dsdl-dispatch language 'dsdl-indicator-writers))) + (funcall (get-dsdl-dispatch language 'write-file-header) input-file filename s) + (dolist (e *dsdl-objects*) + (let ((handler (getf indicator-writers (second e)))) + (when handler + (apply handler (first e) (third e) s (cdddr e))))) + (funcall (get-dsdl-dispatch language 'write-file-trailer) input-file filename s)))) + +(defun dsdl (input-file language-or-languages &key (new-type-scheme t)) + (with-dsdl-object-context + (setq *dsdl-new-type-scheme* new-type-scheme) + (process-dsdl-file input-file) + (setq *dsdl-objects* (nreverse *dsdl-objects*)) + (dolist (language (if (listp language-or-languages) + (adjoin :c-setup language-or-languages) + (list language-or-languages))) + (write-dsdl-data input-file + (funcall (get-dsdl-dispatch language 'name-output-file) input-file) + language)))) + + +;;;; Structures + +(defstruct dsdl + name + size + source-components + relocatable + absolute + (base 0 :type fixnum) + (pointer-type nil) + (free-pointer nil)) + +(defun get-existing-structure (name) + (let ((v (find-dsdl-object-named name))) + (cond ((not v) (error "Can't find dsdl structure named ~S." name)) + ((not (eq (second v) :structure)) + (error "Existing dsdl object ~S is not a structure." name)) + (t (third v))))) + + +(define-dsdl-dispatch (define-structure dsdl-toplevel) (form) + (destructuring-bind (name &rest stuff) (cdr form) + (let ((relocatable nil) + (absolute nil) + (point 0) + (base-pointer-p nil) + (components stuff) + z + (base 0) + (new-components nil) + (pointer-type nil) + (included nil) + (free-pointer nil)) + (declare (fixnum point base)) + (when (consp name) + (dolist (x (prog1 (cdr name) (setq name (car name)))) + (ecase (if (atom x) x (car x)) + (:include + (setq included (lisp:or (get-existing-structure (cadr x)) + (error "~S, included by ~S, is not defined." + (cadr x) name))) + (setq components (append (dsdl-source-components included) components)) + (unless pointer-type (setq pointer-type (dsdl-pointer-type included)))) + (:pointer-type (setq pointer-type (cdr x)))))) + (dolist (x components) + (cond ((atom x) + (if (eq x :base-pointer) + (cond ((not base-pointer-p) + (cond ((logtest point 3) (error ":BASE-POINTER non-longword-aligned")) + ((logtest point 7) (warn ":BASE-POINTER non-quadword-aligned"))) + (setq base point) + (dolist (e relocatable (setq base-pointer-p point point 0)) + (decf (the fixnum (second e)) point))) + ((/= point 0) + (error "Multiple ~S keywords in DSDL." :base-pointer))) + (error "Unrecognized atomic keyword in DSDL: ~S." x)) + (push x new-components)) + ( + #+:32bitmachine + (setq z (cdr (assoc (car x) + '((:long :unsigned-long 4 4) + (:unsigned-long :unsigned-long 4 4) + (:signed-long :signed-long 4 4) + (:pointer :pointer 4 4) + (:pointer-to :pointer 4 4) + (:word :unsigned-word 2 2) + (:unsigned-word :unsigned-word 2 2) + (:signed-word :signed-word 2 2) + (:byte :unsigned-byte 1 1) + (:unsigned-byte :unsigned-byte 1 1) + (:signed-byte :signed-byte 1 1) + (:quad :quad 8 4) + (:quadword :quad 8 4) + (:octa :octa 16 4) + (:octaword :octa 16 4) + (:included-structure :included-structure nil 1))))) + #+:64bitmachine + (setq z (cdr (assoc (car x) + '((:long :unsigned-long 8 8) + (:unsigned-long :unsigned-long 8 8) + (:signed-long :signed-long 8 8) + (:int :unsigned-int 4 4) + (:unsigned-int :unsigned-int 4 4) + (:signed-int :signed-int 4 4) + (:pointer :pointer 8 8) + (:pointer-to :pointer 8 8) + (:word :unsigned-word 2 2) + (:unsigned-word :unsigned-word 2 2) + (:signed-word :signed-word 2 2) + (:byte :unsigned-byte 1 1) + (:unsigned-byte :unsigned-byte 1 1) + (:signed-byte :signed-byte 1 1) + (:quad :quad 8 8) + (:quadword :quad 8 8) + (:octa :octa 16 8) + (:octaword :octa 16 8) + (:included-structure :included-structure nil 1))))) + (push x new-components) + (unless (zerop (mod point (the fixnum (third z)))) + (error "~S doesn't occur on a ~D-byte boundary in ~s." x (third z) name)) + (let ((type (first z)) (cruft (cddr x)) (pl nil) (inc 0)) + (declare (fixnum inc)) + (cond ((eq type :pointer-to) + (setq type `(:pointer-to ,(pop x))) + (unless (get-existing-structure (second type)) + (error "Type ~S pointed to by ~S is not defined." + (second type) name))) + ((eq type :included-structure) + (setq pl `(:included-type ,(third x)) + inc (dsdl-size (lisp:or (get-existing-structure (third x)) + (error "~S undefined :include in ~S." + (third x) name))) + cruft (cdddr x))) + (t (setq inc (second z)))) + (let ((data `(,(cadr x) ,point ,type ,@pl))) + (note-dsdl-reference (list name (cadr x)) :structure-component) + (push data relocatable) + (dolist (y cruft) + (let ((k y) (v nil)) + (unless (atom k) (setq k (car y) v (cdr y))) + (ecase k + (:lisp-index + (when (lisp:or (null v) (car v)) + (when (logtest point 3) + (error "Quantity too small to use :LISP-INDEX: ~S in ~S." + x name)) + (setf (getf (cdddr data) :lisp-index) t))) + ((:field :fields) + (process-dsdl-field-definitions + name (if (eq k :field) (list v) v) (ash inc 3))))))) + (incf point inc))) + ((eq (car x) :fields) + (push x new-components) + (let ((p 0) (fields nil)) + (declare (fixnum p)) + (dolist (y (cdr x)) + (note-dsdl-reference (list name (car y)) :structure-component) + (push (list (car y) p (cadr y)) fields) + (incf p (cadr y))) + (multiple-value-bind (a b) (ceiling p 8) + (declare (fixnum a b)) + (unless (= b 0) + (warn ":FIELDS group not byte aligned, adding a dummy field ~d bits long." + (- b)) + (push (list 'intrnl-dummy p (- b)) fields)) + (push `(nil ,point :direct-fields + :fields ,(nreverse fields)) + relocatable) + (incf point a)))) + ((eq (car x) :size) + (let ((u (if (cddr x) + (lisp:or (cdr (assoc (caddr x) '((:pointer 4) + (:long . 4) + (:word . 2) + (:byte . 1) + (:quad . 8)))) + (error "Unknown size unit in ~S." x)) + 1)) + (size (if base-pointer-p (+ point base-pointer-p) point))) + (declare (fixnum u size)) + (unless (zerop (mod size u)) + (warn "Size ~S is not aligned in ~S." x name)) + (note-dsdl-reference (list name (cadr x)) :structure-attribute) + (push `(,(cadr x) ,(truncate size u) :constant) absolute))) + ((eq (car x) :free-pointer) + (note-dsdl-reference (list name (cadr x)) :structure-attribute) + (setq free-pointer + (cons (cadr x) + (mapcar + #'(lambda (x) + (let ((macname (car x)) type arrayp z) + (when (eq (setq type (cadr x)) :array) + (setq arrayp t type (caddr x))) + (when (setq z (assoc type '((:long . :unsigned-long) + (:int . :unsigned-int) + (:word . :unsigned-word) + (:byte . :unsigned-byte)))) + (setq type (cdr z))) + (list macname type arrayp))) + (cddr x))))) + (t (error "~S unrecognized option in define-structure of ~S." (car x) name)))) + (add-dsdl-object name :structure (make-dsdl + :name name + :base base + :size (+ point base) + :source-components (nreverse new-components) + :relocatable (nreverse relocatable) + :absolute (nreverse absolute) + :pointer-type pointer-type + :free-pointer free-pointer)) + (values name "Structure")))) + + +(define-dsdl-dispatch (define-fields dsdl-toplevel) (form) + (destructuring-bind (name &rest stuff) (cdr form) + (process-dsdl-field-definitions name stuff) + (list name "Field Group"))) + +(defun process-dsdl-field-definitions (root-name spec &optional (bitmax most-positive-fixnum) + &aux (warnmax (integer-length most-positive-fixnum)) + (defs nil)) + (declare (fixnum bitmax warnmax)) + (setq defs (sort (mapcar + #'(lambda (x) + (let* ((name (car x)) + (position (cadr x)) + (size (if (cddr x) (caddr x) 1)) + (endpos (+ position size))) + (declare (fixnum position size endpos)) + (cond ((> endpos bitmax) + (error "~S field of ~S extends beyond its slot or containing structure." + name root-name)) + ((> endpos warnmax) + (warn "~S field of ~S extends beyond the width of a fixnum." + name root-name))) + `((,root-name ,name) :field (,position ,size)))) + spec) + #'(lambda (x y) + (setq x (third x) y (third y)) + (< (the fixnum (+ (first x) (second x))) + (the fixnum (+ (first y) (second y))))))) + (do ((lastpos (+ (first (third (car defs))) + (second (third (car defs)))) + (+ p (the fixnum (second z)))) + (prevthing (car defs) (car l)) + (z nil) + (p 0) + (l (cdr defs) (cdr l))) + ((null l)) + (declare (fixnum lastpos p)) + (setq p (first (setq z (third (car l))))) + (when (/= p lastpos) + (warn (if (> p lastpos) + "In structure ~S, there is a gap between fields ~S and ~S." + "In structure ~S, fields ~S and ~S overlap.") + root-name (car prevthing) (caar l)))) + (mapc #'add-dsdl-object-entry defs) + defs) + + +(define-dsdl-dispatch (define-values dsdl-toplevel) (form) + (destructuring-bind (root-name &rest stuff) (cdr form) + (let* ((type (cond ((atom root-name) :constant) + (t (assert (member (second root-name) '(:constant :parameter))) + (second root-name)))) + (root-name (if (atom root-name) root-name (first root-name)))) + (dolist (x stuff) + (let ((name (car x)) (value (cadr x))) + (check-type value integer) + (add-dsdl-object (list root-name name) type value))) + (values root-name "Value Group")))) + +(define-dsdl-dispatch (define-lisp-structure dsdl-toplevel) (form) + (destructuring-bind (name &rest slot-names) (cdr form) + (dolist (slot-name slot-names) + (note-dsdl-reference (list name slot-name) :lisp-structure-component)) + (add-dsdl-object name :lisp-structure slot-names) + (add-dsdl-object (list name 'structuresize) :constant (1+ (length slot-names))) + (values name "Lisp Structure"))) + +(define-dsdl-dispatch (define-lisp-funcallable-structure dsdl-toplevel) (form) + (destructuring-bind (name &rest slot-names) (cdr form) + (dolist (slot-name slot-names) + (note-dsdl-reference (list name slot-name) :lisp-funcallable-structure-component)) + (add-dsdl-object name :lisp-funcallable-structure slot-names) + (add-dsdl-object (list name 'structuresize) :constant (1+ (length slot-names))) + (values name "Lisp Funcallable Structure"))) + + +(define-dsdl-dispatch (define-initial-symbols dsdl-toplevel) (form) + (destructuring-bind (&rest symbols-list) (cdr form) + (let ((known-pkgs '(("LISP" . "LISP") ("CLOE" . "CLOE") + ("SYSTEM" . "SYSTEM") ("SYS" . "SYSTEM") + ("CLOS" . "CLOS") ("CLOS-INTERNALS" . "CLOSI") + ("POWERLINUX" . "POWERLINUX"))) + (symsetups nil) + (fdecls nil) + (clocs nil)) + (dolist (x symbols-list) + (destructuring-bind (symbol &key package location + (value nil value-p) (constant nil constant-p) + function documentation) x + (unless package (setq package (package-name (symbol-package symbol)))) + (let ((z (assoc package known-pkgs :test #'string=))) + (cond (z (setq package (cdr z))) + (t (warn "~S unknown package in symbol definition of ~S; SYSTEM will be used." + package symbol) + (setq package "SYSTEM")))) + (unless (listp documentation) + (setq documentation (list (cond (value-p 'variable) + (function 'function) + (t (error "Why does ~S have documentation?" symbol))) + documentation))) + (when function (pushnew function fdecls :test #'string=)) + (when location (push location clocs)) + (push (list symbol + package + location + (cond (value-p :variable) (constant-p :constant)) + (if value-p value constant) + function + documentation) + symsetups))) + (add-dsdl-object '*initial-symbols* :initial-symbols + (list (nreverse symsetups) (nreverse fdecls) (nreverse clocs))) + (values nil "Initial Symbols")))) + + +;;;; C (include) + +(setf (get-dsdl-dispatch :c 'dsdl-indicator-writers) + '(:field write-c-field + :constant write-c-constant + :parameter write-c-constant + :structure write-c-structure + :lisp-structure write-c-lispstruct + :lisp-funcallable-structure write-c-lispfnstruct + :initial-symbols write-c-initial-symbols)) + +(defun genera-upcase (x) + #+Genera (string-upcase x) + #-Genera x) + +(define-dsdl-dispatch (:c write-file-header) (input-file filename stream) + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A Any changes made to it will be lost. */ + +#ifndef _~a_ +#define _~a_ +~2%" + input-file + (string-upcase (pathname-name (pathname filename))) + (string-upcase (pathname-name (pathname filename))))) + +(define-dsdl-dispatch (:c write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A Any changes made to it will be lost. */ + +#endif +~2%" + input-file)) + +(define-dsdl-dispatch (:c name-output-file) (input-file) + (make-pathname :type (genera-upcase "h") :defaults input-file)) + +(defun dsdl-c-upper-name-component (x) + (map 'string #'(lambda (c) + (declare (string-char c)) + (cond ((lisp:and (alpha-char-p c) (upper-case-p c)) c) + ((lisp:and (alpha-char-p c) (lower-case-p c)) c) + ((digit-char-p c) c) + ((char= c #\-) #\_) + ((char= c #\_) #\_) + (t (error "Can't put ~S in a C name component." c)))) + (the string (string x)))) + + (defun dsdl-c-lower-name-component (x) + (map 'string #'(lambda (c) + (declare (string-char c)) + (cond ((lisp:and (alpha-char-p c) (upper-case-p c)) (char-downcase c)) + ((digit-char-p c) c) + ((char= c #\-) #\_) + ((char= c #\_) #\_) + (t (error "Can't put ~S in a C name component." c)))) + (the string (string x)))) + +(defun write-c-variable-declarations (prefix-string items stream) + (when items + (let* ((prefix-size (1+ (length prefix-string))) (pos prefix-size)) + (declare (fixnum prefix-size n)) + (format stream "~2&~A " prefix-string) + (do () (nil) + (write-string (car items) stream) + (setq pos (+ pos 1 (length (car items)))) + (cond ((null (setq items (cdr items))) (return (format stream ";~%"))) + ((> pos 70) (format stream ";~%~A " prefix-string) (setq pos prefix-size)) + (t (write-char #\, stream))))))) + +(defun write-c-function-declarations (prefix-string items stream) + (when items + (let* ((prefix-size (1+ (length prefix-string))) (pos prefix-size)) + (declare (fixnum prefix-size n)) + (format stream "~2&~A " prefix-string) + (do () (nil) + (write-string (car items) stream) + (write-string "()" stream) + (setq pos (+ pos 3 (length (car items)))) + (cond ((null (setq items (cdr items))) (return (format stream ";~%"))) + ((> pos 70) (format stream ";~%~A " prefix-string) (setq pos prefix-size)) + (t (write-char #\, stream))))))) + + +(defun write-c-constant (name value stream) + (format stream (if (typep value 'bignum) + "~2&#define ~A_~A 0x~X~%" + "~2&#define ~A_~A ~D~%") + (dsdl-c-upper-name-component (first name)) + (dsdl-c-upper-name-component (second name)) + value)) + +(defun write-c-lisp-index (name value stream) + (format stream "~2&#define ~A_I_~A ~D~%" + (dsdl-c-upper-name-component (first name)) + (dsdl-c-upper-name-component (second name)) + value)) + +(defun write-c-field (name value stream) + (let ((root (dsdl-c-upper-name-component (first name))) + (ending (dsdl-c-upper-name-component (second name))) + (pp (first value)) + (ss (second value))) + (format stream "~2&#define ~A_V_~A ~D~@ + #define ~A_S_~A ~D~@ + #define ~A_M_~A 0x~x~%" + root ending pp + root ending ss + root ending (ash (1- (ash 1 ss)) pp)))) + +(defun write-c-structure (root-name value stream + &aux (rupper (dsdl-c-upper-name-component root-name)) + (rlower (dsdl-c-lower-name-component root-name)) + (pointer-type (dsdl-pointer-type value)) + (typename + (lisp:and pointer-type + (format nil "~:[ETT~;TC~]_~A" + *dsdl-new-type-scheme* + (dsdl-c-upper-name-component + (if *dsdl-new-type-scheme* + (first pointer-type) + (lisp:or (second pointer-type) "OTHERS"))))))) + (format stream "~2&typedef struct ~A {" rlower) + (loop for (name nil type . plist) in (dsdl-relocatable value) + do (cond ((eq type :direct-fields) + (loop for (fname nil size) in (getf plist :fields) + do (format stream "~& unsigned long ~a : ~d;" + (dsdl-c-lower-name-component fname) size))) + (t (format stream "~& ") + (write-string + (ecase type + (:signed-long "int64_t ") + (:unsigned-long "uint64_t ") + (:signed-int "int32_t ") + (:unsigned-int "uint32_t ") + (:signed-byte "int8_t ") + (:unsigned-byte "uint8_t ") + (:signed-word "int16_t ") + (:unsigned-word "uint16_t ") + (:pointer "char *") + (:included-structure + (format nil "~A " + (dsdl-c-upper-name-component + (getf plist :included-type))))) + stream) + (write-string (dsdl-c-lower-name-component name) stream) + (write-char #\; stream)))) + (format stream "~% } ~A, *~:*~AP;~%" rupper) + (when pointer-type + (let ((first-structure-slot-offset (second (first (dsdl-relocatable value))))) + ;;Should be 0 or negative. + (assert (not (plusp first-structure-slot-offset))) + #+notneeded + (format stream "~%#define ~A_PTYPE ~A~@ + #define BARE~A(obj) ((~:*~aP)(((char *)(obj))-~d-~A_PTYPE))~%" + rupper typename + rupper (- first-structure-slot-offset) rupper))) + (loop for (name value nil . plist) in (dsdl-relocatable value) + do (when (getf plist :lisp-index) + (write-c-lisp-index (list root-name name) (ash value -2) stream))) + (loop for (name value type) in (dsdl-absolute value) + do (if (eq type :field) + (write-c-field (list root-name name) value stream) + (write-c-constant (list root-name name) value stream))) + (let ((fp (dsdl-free-pointer value))) + (when fp + (let ((offset (- (dsdl-size value) (dsdl-base value)))) + (format stream "~%#define ~A_~A (~D-~A)~%" + rupper (dsdl-c-upper-name-component (first fp)) + offset typename) + (dolist (x (cdr fp)) + (let ((mname (first x)) (type (second x)) (arrayp (third x))) + (format stream "#define ~A_~A(~A) ~:[(*~;~]((~A *)(((char *)(~A))+~A-~A))~:[)~;~]~%" + rupper (dsdl-c-upper-name-component mname) rlower arrayp + (ecase type + (:signed-long "int64_t ") + (:unsigned-long "uint64_t ") + (:signed-int "int32_t ") + (:unsigned-int "uint32_t ") + (:signed-byte "int8_t ") + (:unsigned-byte "uint8_t ") + (:signed-word "int16_t ") + (:unsigned-word "uint16_t ") + (:pointer "char *")) + rlower offset typename arrayp))))))) + +(defun write-c-lispstruct (root-name value stream) + (format stream "~2&/* LISP Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-c-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-c-upper-name-component slot-name) + do (format stream "#define ~A_I_~A ~d~%" rc sc index) + (format stream "#define ~A_P_~A ~d~%" rc sc (ash index 2)) + (format stream "#define ~A_~A(foo) STREF((foo),~D)~%" rc sc index))) + (terpri stream)) + +(defun write-c-lispfnstruct (root-name value stream) + (format stream "~2&/* LISP Funcallable Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-c-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-c-upper-name-component slot-name) + do (format stream "#define ~A_I_~A ~d~%" rc sc index) + (format stream "#define ~A_P_~A ~d~%" rc sc (ash index 2)) + (format stream "#define ~A_~A(foo) ((TRAMPOLINE_VALUES((foo)))[~D])~%" rc sc index))) + (terpri stream)) + +(defun write-c-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (destructuring-bind (symsetups fdecls clocs) value + (declare (ignore symsetups fdecls)) + (write-c-variable-declarations "extern char *" clocs stream))) + + +;;;; C (setup) + +(setf (get-dsdl-dispatch :c-setup 'dsdl-indicator-writers) + '(:initial-symbols write-c-setup-initial-symbols)) + +(define-dsdl-dispatch (:c-setup write-file-header) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A Any changes made to it will be lost. */ +~2%" + input-file)) + +(define-dsdl-dispatch (:c-setup write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore input-file filename stream)) + #+OpenMCL input-file filename stream + nil) + +(define-dsdl-dispatch (:c-setup name-output-file) (input-file) + (make-pathname :type (genera-upcase "c") :defaults input-file)) + +(defun write-c-lispfnstruct (root-name value stream) + (format stream "~2&/* LISP Funcallable Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-c-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-c-upper-name-component slot-name) + do ;; @@@@ Removed because they never seem to be used and we have run out of #define space... + ;; (format stream "#define ~A_I_~A ~d~%" rc sc index) + (format stream "#define ~A_P_~A ~d~%" rc sc (ash index 2)) + (format stream "#define ~A_~A(foo) ((TRAMPOLINE_VALUES((foo)))[~D])~%" rc sc index))) + (terpri stream)) + + +(defun write-c-setup-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (destructuring-bind (symsetups fdecls clocs) value + (write-c-function-declarations "extern char *" fdecls stream) + (write-c-variable-declarations "char *" clocs stream) + (format stream "~%initsymbols()~%{ /* First intern everything, setting locations if they have them. */~%") + (loop for (sym pkg location nil nil nil) in symsetups + do (if location + (format stream " ~A = intern(\"~a\",~A);~%" location sym pkg) + (format stream " intern(\"~a\",~A);~%" sym pkg))) + (format stream " /* Now do all the initializations. */~%") + (loop for (sym pkg location vartype varinit function) in symsetups + do (when (lisp:or vartype function) + (unless location (setq location (lisp:or location (format nil "intern(\"~A\",\"~A\")" sym pkg)))) + (when vartype + (format stream " ~a(~a,~a);~%" + (if (eq vartype :variable) "makvar" "makconst") + location + (if (stringp varinit) varinit + (let ((z (lisp:or (assoc varinit symsetups) + (warn "Initial value ~S for variable ~S is unknown." varinit sym) + '(nil nil "nilsymb")))) + (lisp:or (third z) + (format nil "intern(\"~A\",\"~A\")" (first z) (second z))))))) + (when function + (format stream " setspfun(~a,makCfn(~a));~%" location function)))) + (format stream "~%}~%"))) + + +;;;; Assembly Language (Include) + +(setf (get-dsdl-dispatch :asm 'dsdl-indicator-writers) + '(:field write-asm-field + :constant write-asm-constant + :parameter write-asm-constant + :structure write-asm-structure + :lisp-structure write-asm-lispstruct + :lisp-funcallable-structure write-asm-lispfnstruct + :initial-symbols write-asm-initial-symbols)) + +(define-dsdl-dispatch (:asm write-file-header) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from ~A. Any changes made to it will be lost. */~2%" + input-file)) + +(define-dsdl-dispatch (:asm write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore input-file filename stream)) + #+OpenMCL input-file filename stream + nil) + +(define-dsdl-dispatch (:asm name-output-file) (input-file) + (make-pathname :type (genera-upcase "s") :defaults input-file)) + +(defun dsdl-asm-upper-name-component (x) + (map 'string #'(lambda (c) + (declare (string-char c)) + (cond ((lisp:and (alpha-char-p c) (upper-case-p c)) c) + ((lisp:and (alpha-char-p c) (lower-case-p c)) c) + ((digit-char-p c) c) + ((char= c #\-) #\_) + ((char= c #\_) #\_) + (t (error "Can't put ~S in an ASM name component." c)))) + (the string (string x)))) + +(defconstant *asm-token-length-max* 31) ;tokens longer than this may lose! + +(defvar *asm-token-conflicts* (make-hash-table :test #'equal)) + +(defvar *conflicting-token-alist* + '(("INSTANCE_INFORMATION_I_DISPATCH_MASK" . "I_I_I_DISPATCH_MASK") + ("INSTANCE_INFORMATION_P_DISPATCH_MASK" . "I_I_P_DISPATCH_MASK") + ("INSTANCE_INFORMATION_I_DISPATCH_ADDRESS" . "I_I_I_DISPATCH_ADDRESS") + ("INSTANCE_INFORMATION_P_DISPATCH_ADDRESS" . "I_I_P_DISPATCH_ADDRESS") )) + +(defun check-asm-token (token) + (let ((newtoken (cdr (assoc token *conflicting-token-alist* :test #'equal)))) + (when (null newtoken) (setq newtoken token)) + (when (> (length token) *asm-token-length-max*) + (let* ((subtoken (subseq token 0 *asm-token-length-max*)) + (conflict (gethash subtoken *asm-token-conflicts*)) + (badguys (cons token conflict))) + (setf (gethash subtoken *asm-token-conflicts*) badguys) + (when (lisp:and (cdr badguys) (equal token newtoken)) + (warn "Add ~A to *CONFLICTING-TOKEN-ALIST*~%~ + and try again; it's not unique within ~d. characters." + token *asm-token-length-max*)))) + newtoken)) + +(defun write-asm-constant (name value stream &aux token) + (setq token (check-asm-token (format nil "~A~A" + (dsdl-asm-upper-name-component (first name)) + (dsdl-asm-upper-name-component (second name))))) + (format stream (if (typep value 'bignum) + "~2&~A = ~D~%" + "~2&~A = 0x~X~%") + token + value)) + +(defun write-asm-field (name value stream &optional direct-p) + (let* ((root (dsdl-asm-upper-name-component (first name))) + (ending (dsdl-asm-upper-name-component (second name))) + (pp (first value)) + (ss (second value)) + (vname (check-asm-token (format nil "~A_V_~A" root ending))) + (sname (check-asm-token (format nil "~A_S_~A" root ending))) + (mname (check-asm-token (format nil "~A_M_~A" root ending)))) + (format stream "~2&~A = ~D~@ + ~A = ~D~@ + ~A = 0x~x~%" + vname pp + sname ss + mname (ash (1- (ash 1 ss)) (if direct-p 0 pp))))) + +(defun write-asm-structure (root-name value stream + &aux (rupper (dsdl-asm-upper-name-component root-name)) + (pointer-type (dsdl-pointer-type value)) + (typename + (lisp:and pointer-type + (format nil "~:[ETT~;TC~]_~A" + *dsdl-new-type-scheme* + (dsdl-asm-upper-name-component + (if *dsdl-new-type-scheme* + (first pointer-type) + (lisp:or (second pointer-type) "OTHERS"))))))) + (format stream "~2%/* Structure ~S */~%" root-name) + (loop for (name value type . plist) in (dsdl-relocatable value) + do (setq name (dsdl-asm-upper-name-component name)) + (cond ((eq type :direct-fields) + (let ((offset (ash value 3))) + (declare (fixnum offset)) + (loop for (fname pos size) (nil fixnum fixnum) in (getf plist :fields) + do (write-asm-field (list root-name fname) + (list (+ pos offset) size) + stream t)))) + (t (format stream "~A_~A = ~D~%" rupper name value) + (when (getf plist :lisp-index) + (format stream "~A_I_~A = ~D~%" rupper name (ash value -2)))))) + (loop for (name value type . nil) in (dsdl-absolute value) + do (case type + (:field (write-asm-field (list root-name name) value stream)) + (t (write-asm-constant (list root-name name) value stream)))) + (when pointer-type + (format stream "~%~A_PTYPE = ~A~%" rupper typename)) + (let ((fp (dsdl-free-pointer value))) + (when fp + (format stream "~A_~A = ~D-~A~%" + rupper (dsdl-asm-upper-name-component (car fp)) + (- (dsdl-size value) (dsdl-base value)) typename)))) + +(defun write-asm-lispstruct (root-name value stream) + (format stream "~2&/* LISP Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-asm-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-asm-upper-name-component slot-name) + do (format stream "~A = ~d~%" + (check-asm-token (format nil "~A_I_~A" rc (dsdl-asm-upper-name-component slot-name))) + index) + (format stream "~A = ~d~%" (check-asm-token (format nil "~A_P_~A" rc sc)) (ash index 2)))) + (terpri stream)) + +(defun write-asm-lispfnstruct (root-name value stream) + (format stream "~2&/* LISP Funcallable Structure Constants for ~S */~%" root-name) + (let ((rc (dsdl-asm-upper-name-component root-name))) + (loop for slot-name in value + for index from 1 + as sc = (dsdl-asm-upper-name-component slot-name) + do (format stream "~A = ~d~%" + (check-asm-token (format nil "~A_I_~A" rc (dsdl-asm-upper-name-component slot-name))) + index) + (format stream "~A = ~d~%" (check-asm-token (format nil "~A_P_~A" rc sc)) (ash index 2)))) + (terpri stream)) + +(defun write-asm-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (destructuring-bind (symsetups fdecls clocs) value + (declare (ignore symsetups fdecls)) + (format stream "~2&~{/. .extrn ~a:dword~%~}" clocs))) + + +;;;; Lisp (setup) + +(setf (get-dsdl-dispatch :lisp 'dsdl-indicator-writers) + '(:field write-lisp-field + :constant write-lisp-constant + :parameter write-lisp-parameter + :structure write-lisp-structure + :lisp-structure write-lisp-lispstruct + :lisp-funcallable-structure write-lisp-lispfnstruct + :initial-symbols write-lisp-initial-symbols)) + +(define-dsdl-dispatch (:lisp write-file-header) (input-file filename stream) + #-OpenMCL (declare (ignore filename)) + #+OpenMCL filename + (format stream "~ +;;; -*- Mode: LISP; Package: POWERPC-INTERNALS; Base: 10; Syntax: Common-Lisp; -*- +;;; +;;; WARNING!! DO NOT MODIFY THIS FILE! +;;; It was automatically generated from ~A. Any changes made to it will be lost. + +#+Alpha-AXP-Emulator +(in-package \"ALPHA-AXP-INTERNALS\") + +#+PowerPC-Emulator +(in-package \"POWERPC-INTERNALS\") +" + input-file)) + +(define-dsdl-dispatch (:lisp write-file-trailer) (input-file filename stream) + #-OpenMCL (declare (ignore input-file filename stream)) + #+OpenMCL input-file filename stream + nil) + +(define-dsdl-dispatch (:lisp name-output-file) (input-file) + (make-pathname :type (genera-upcase "lisp") :defaults input-file)) + +;;; ---*** TODO: Remove the $K definition ... +;;; ---*** Make similar changes to fields and structures ... +(defun write-lisp-constant (name value stream) + (format stream "~2&(defconstant ~(~s$k-~s~) ~D)~%" (first name) (second name) value) + (format stream "(defconstant |~A~A| ~D)~%" (dsdl-asm-upper-name-component (first name)) + (dsdl-asm-upper-name-component (second name)) + value)) + +(defun write-lisp-parameter (name value stream) + (format stream "~2&(defparameter ~(~s$k-~s~) ~D)~%" (first name) (second name) value) + (format stream "(defparameter |~A~A| ~D)~%" (dsdl-asm-upper-name-component (first name)) + (dsdl-asm-upper-name-component (second name)) + value)) + +(defun write-lisp-field (name value stream &optional direct-p) + (let ((root (first name)) + (ending (second name)) + (pp (first value)) + (ss (second value))) + (format stream "~2&~((defconstant ~s$v-~s ~D)~@ + (defconstant ~s$S-~s ~D)~@ + (defconstant ~s$m-~s #x~x)~)~%" + root ending pp + root ending ss + root ending (ash (1- (ash 1 ss)) (if direct-p 0 pp))))) + +(defun write-lisp-structure (root-name value stream + &aux (pointer-type (dsdl-pointer-type value)) + (typename + (lisp:and pointer-type + (intern (concatenate + 'string + (if *dsdl-new-type-scheme* "TC$K-" "ETT$K-") + (string (if *dsdl-new-type-scheme* + (first pointer-type) + (lisp:or (second pointer-type) 'others)))))))) + (format stream "~2%;;; Structure ~S~%" root-name) + (loop for (name value type . plist) in (dsdl-relocatable value) + do (cond ((eq type :direct-fields) + (let ((offset (ash value 3))) + (declare (fixnum offset)) + (loop for (fname pos size) (nil fixnum fixnum) in (getf plist :fields) + do (write-lisp-field (list root-name fname) + (list (+ pos offset) size) + stream t)))) + (t (format stream "(defconstant ~(~s$~a-~s~) ~D)~%" + root-name + (ecase type + ((:signed-long :unsigned-long) "q") + ((:signed-int :unsigned-int) "l") + ((:signed-word :unsigned-word) "w") + ((:signed-byte :unsigned-byte) "b") + (:quad "q") + (:octa "o") + (:pointer "p") + (:included-structure "a") ;byte address + ) + name value))) + (when (getf plist :lisp-index) + (format stream "(defconstant ~(~s$i-~s~) ~D)~%" root-name name (ash value -2)))) + (loop for (name value type) in (dsdl-absolute value) + do (if (eq type :field) + (write-lisp-field (list root-name name) value stream) + (write-lisp-constant (list root-name name) value stream))) + (when pointer-type + (format stream "~((defconstant ~s$k-ptype ~s)~)~%" + root-name typename)) + (let ((fp (dsdl-free-pointer value))) + (when fp + (format stream "~((defconstant ~s$k-~s ~S)~)~%" + root-name (car fp) `(- ,(- (dsdl-size value) (dsdl-base value)) ,typename))))) + +(defun write-lisp-lispstruct (name value stream) + (format stream "~2&;;; LISP Structure Information for ~S.~%" name) + (loop for slot-name in value + for i from 1 + do (format stream "(defconstant ~(~a$i-~a~) ~D)~%" name slot-name i) + (format stream "(defconstant ~(~a$p-~a~) ~D)~%" name slot-name (ash i 2))) + (format stream "(setf (system::sys%get '~(~s~) 'system::lispstruct-slots) '~((system::structure ~s)~))~2%" name value)) + +(defun write-lisp-lispfnstruct (name value stream) + (format stream "~2&;;; LISP Funcallable Structure Information for ~S.~%" name) + (loop for slot-name in value + for i from 1 + do (format stream "(defconstant ~(~a$i-~a~) ~D)~%" name slot-name i) + (format stream "(defconstant ~(~a$p-~a~) ~D)~%" name slot-name (ash i 2))) + (format stream "(setf (system::sys%get '~(~s~) 'system::lispstruct-slots) '~((system::funcallable-structure ~s)~))~2%" + name value)) + +(defun write-lisp-initial-symbols (root-name value stream) + (declare (ignore root-name)) + (flet ((f (x) + (let ((*package* (symbol-package x))) + (format stream "~(~s~)" x)))) + (loop for (sym pkg nil nil nil nil documentation) in (first value) + do (when documentation + (format stream "~&(setf (sys::sys%get '~(~a~)::" pkg) + (f sym) + (format stream " 'documentation) '~s)~%" documentation))))) diff --git a/assembler/powerpckg.lisp b/assembler/powerpckg.lisp new file mode 100644 index 0000000..39d1a49 --- /dev/null +++ b/assembler/powerpckg.lisp @@ -0,0 +1,9 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Lowercase: Yes -*- + +(defpackage POWERPC-INTERNALS + (:nicknames PPCI) + #+Genera (:use SCL LISP) + #-Genera (:use COMMON-LISP) + (:shadow AND OR) + #+OpenMCL (:import-from CCL LSH DEFSUBST STACK-LET CIRCULAR-LIST)) + diff --git a/assembler/sct-support.lisp b/assembler/sct-support.lisp new file mode 100644 index 0000000..f8584e2 --- /dev/null +++ b/assembler/sct-support.lisp @@ -0,0 +1,214 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + + +;;; DSDL files + +(fs:define-canonical-type :dsdl "SID") + +(define-module-type :dsdl :dsdl :null-type + compilable-module no-load-or-compile-module) + +(defmethod (canonicalize-module-pathnames dsdl-module) (system) + (loop for input in inputs + as input-file = (if (listp input) (first input) input) + as real-input = (merge-pathname-with-defaults + input-file (source-file-type-default self) system) + as explicit-output = (listp input) + as output-file = (if (listp input) (second input) input-file) + as real-output = (merge-pathname-with-defaults + output-file :lisp system ;--- will do for now + ;; Force the output type if none was given explicitly + :force-type (null explicit-output) + ;; Destination files go to the destination pathname + :destination-file t) + do (add-pathname-to-system system real-input real-output) + collect `(,real-input ,real-output) into inputs-and-outputs + finally (setq inputs inputs-and-outputs))) + +(defmethod (:compile dsdl-module) (system-op &rest keys + &key recompile no-compile &allow-other-keys) + (unless no-compile + (when (eq system-op :compile) + (lexpr-funcall #'default-compile + self system-op recompile + #'(named-lambda lisp-compile-driver + (source bin module &rest ignore) + bin module + (let ((cl:*package* (pkg-find-package "ALPHA-AXP-INTERNALS"))) + (funcall (intern "DSDL" "ALPHA-AXP-INTERNALS") + source '(:c :asm :lisp)))) + '("Translate" "Translating" "Translated") + keys)))) + +(defmethod (:load dsdl-module) (system-op &rest keys + &key never-load reload &allow-other-keys) + (unless never-load + (lexpr-funcall #'default-load + self system-op reload + #'(named-lambda bin-load-driver + (bin ignore module &rest ignore) + (cl:load bin + :verbose nil + :default-package (system-default-package *system*) + :package (package-for-module module)) + (send bin :truename)) + '("Load" "Loading" "Loaded") + keys))) + + +;;; Assembly files + +(fs:define-canonical-type :assembler-source "AS") +(fs:define-canonical-type :assembler-dest "S") + +(define-module-type :alpha-assembly :assembler-source :assembler-dest + compilable-module no-load-or-compile-module) + +(defmethod (:compile alpha-assembly-module) (system-op &rest keys + &key recompile no-compile &allow-other-keys) + (unless no-compile + (when (eq system-op :compile) + (lexpr-funcall #'default-compile + self system-op recompile + #'(named-lambda lisp-compile-driver + (source bin module &rest ignore) + module + (let-if (system-default-package *system*) + ;; Bind PACKAGE to the default package in case + ;; the override mechanism supplies NIL + ((package (pkg-find-package + (system-default-package *system*)))) + (funcall (intern "PROCESS-ASM-SOURCE" "ALPHA-AXP-INTERNALS") + source bin))) + '("Translate" "Translating" "Translated") + keys)))) + + +;;; Copied files + +(define-module-type :copied-file nil :null-type + compilable-module no-load-or-compile-module) + +(defmethod (canonicalize-module-pathnames copied-file-module) (system) + (loop for input in inputs + as input-file = (if (listp input) (first input) input) + as real-input = (merge-pathname-with-defaults + input-file (source-file-type-default self) system) + as explicit-output = (listp input) + as output-file = (if (listp input) (second input) input-file) + as real-output = (merge-pathname-with-defaults + output-file (send real-input :canonical-type) system + ;; Force the output type if none was given explicitly + :force-type (null explicit-output) + ;; Destination files go to the destination pathname + :destination-file t) + do (add-pathname-to-system system real-input real-output) + collect `(,real-input ,real-output) into inputs-and-outputs + finally (setq inputs inputs-and-outputs))) + +(defmethod (:compile copied-file-module) (system-op &rest keys + &key recompile no-compile &allow-other-keys) + (unless no-compile + (when (eq system-op :compile) + (lexpr-funcall #'default-compile + self system-op recompile + #'(named-lambda lisp-compile-driver + (source bin module &rest ignore) + module + (copyf source (send bin :new-canonical-type + (send source :canonical-type)))) + '("Copy" "Copying" "Copied") + keys)))) + + +;;; Make files + +(define-module-type :makefile :null-type :null-type + copied-file-module) + + +;;; Commands + +(defvar *vlm-host*) + +(add-initialization "Reset VLM Target Host" + '(makunbound '*vlm-host*) + '(:before-cold)) + +(cp:define-command (com-assemble-emulator :command-table "System Maintenance") + ((system-spec '((scl:type-or-string sct:system)) + :default (sct:find-system-named 'alpha-axp-osf-vlm) + :default-type 'sct:system + :confirm t + :documentation "Emulator system to assemble") + &key + (reset-target 'scl:boolean + :default nil + :mentioned-default t + :documentation "Whether to ask for the target host for translation") + (condition '((cl:member :always :new-source)) + :default :new-source + :documentation "Whether to compile each source") + (query '((cl:member :everything :yes :confirm-only :no)) + :mentioned-default :everything + :default :no + :documentation + "Whether to ask about compiling each file, just confirm the list of files, or don't ask") + (redefinitions-ok 'scl:boolean + :default nil + :mentioned-default t + :documentation + "Whether to proceed through redefinition warnings") + (silent 'scl:boolean + :default nil + :mentioned-default t + :documentation "Whether to suppress all terminal output") + (batch `(or scl:boolean + ((fs:pathname) + :default-name ,(if (typep system-spec 'sct:system) + (sct:system-short-name system-spec) + system-spec) + :default-type :cwarns)) + :default nil + :mentioned-default t + :documentation + "Whether to save compiler warnings in a file, rather than printing them")) + (let ((system (sct:find-system-named system-spec nil nil t)) + (ok-to-proceed t) + (compile-system-options nil)) + (setq system (sct:system-name system)) + (setq compile-system-options + (selectq condition + (:always (append compile-system-options '(:recompile t))) + (:new-source (append compile-system-options '(:recompile nil))))) + (setq compile-system-options + (selectq query + ((:yes :everything) (append compile-system-options '(:query t))) + (:confirm-only (append compile-system-options '(:query :confirm))) + (:no (append compile-system-options '(:query :no-confirm))))) + (setq compile-system-options + (append compile-system-options + `(:no-warn ,(and redefinitions-ok (or silent :just-warn))))) + (when (cl:pathnamep batch) + (when (null (fs:pathname-name batch)) + (setq batch (send batch :new-name (string system)))) + (when (null (fs:pathname-type batch)) + (setq batch (send batch :new-type :cwarns)))) + (setq compile-system-options + (append compile-system-options + `(:silent ,silent + :batch ,batch + :include-components nil + :increment-version nil + :update-directory nil))) + (if ok-to-proceed + (progn + (when reset-target + (makunbound '*vlm-host*)) + (unless (boundp '*vlm-host*) + (let ((system (sct:find-system-named system nil))) + (when system + (setf (sct:system-modules system) :need-to-reload-system-declaration) + (sct:load-system-declaration-if-compressed system :newest)))) + (lexpr-funcall 'sct:compile-system system-spec compile-system-options)) + (format t "~& Compile System aborted.~2&")))) diff --git a/assembler/sysdcl.lisp b/assembler/sysdcl.lisp new file mode 100644 index 0000000..23bb4c7 --- /dev/null +++ b/assembler/sysdcl.lisp @@ -0,0 +1,19 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + +(defsystem Alpha-AXP-Assembler + (:pretty-name "Alpha AXP Assembler" + :default-pathname "VLM:ASSEMBLER;") + (:serial + "alphapckg" + "alphadsdl" + "alpha" + "sct-support")) + +(defsystem POWERPC-Assembler + (:pretty-name "PowerPC Assembler" + :default-pathname "VLM:ASSEMBLER;") + (:serial + "powerpckg" + "powerdsdl" + "power" + "power-sct-support")) diff --git a/c-emulator/dispatch.c b/c-emulator/dispatch.c new file mode 100644 index 0000000..ebe469a --- /dev/null +++ b/c-emulator/dispatch.c @@ -0,0 +1,2304 @@ +/* -*- Mode:C -*- */ + +/**** Instruction decoding ****/ + +#include +#include + +#include "emulator.h" +#include "dispatch.h" +#include "ivory.h" +#include "memory.h" + +typedef struct _DecoderPair +{ + int dispatch; + void (*decode) (); +} DecoderPair; + +static const int ReturnInstructionDecoder[3] = +{ + DispatchReturnSingleNIL, + DispatchReturnSingleT, + DispatchReturnSingleTOS +}; + +static const int WordInstructionDecoder[64] = +{ + DispatchPushNull, + DispatchPushMonitorForward, + DispatchPushHeaderP, + DispatchPushHeaderI, + DispatchPushExternalValueCellPointer, + DispatchPushOneQForward, + DispatchPushHeaderForward, + DispatchPushElementForward, + DispatchPushFixnum, + DispatchPushSmallRatio, + DispatchPushSingleFloat, + DispatchPushDoubleFloat, + DispatchPushBignum, + DispatchPushBigRatio, + DispatchPushComplex, + DispatchPushSpareNumber, + DispatchPushInstance, + DispatchPushListInstance, + DispatchPushArrayInstance, + DispatchPushStringInstance, + DispatchPushNil, + DispatchPushList, + DispatchPushArray, + DispatchPushString, + DispatchPushSymbol, + DispatchPushLocative, + DispatchPushLexicalClosure, + DispatchPushDynamicClosure, + DispatchPushCompiledFunction, + DispatchPushGenericFunction, + DispatchPushSparePointer1, + DispatchPushSparePointer2, + DispatchPushPhysicalAddress, + DispatchPushSpareImmediate1, + DispatchPushBoundLocation, + DispatchPushCharacter, + DispatchPushLogicVariable, + DispatchPushGcForward, + DispatchPushEvenPc, + DispatchPushOddPc, + DispatchCallCompiledEven, + DispatchCallCompiledOdd, + DispatchCallIndirect, + DispatchCallGeneric, + DispatchCallCompiledEvenPrefetch, + DispatchCallCompiledOddPrefetch, + DispatchCallIndirectPrefetch, + DispatchCallGenericPrefetch, + DispatchPushPackedInstruction60, + DispatchPushPackedInstruction61, + DispatchPushPackedInstruction62, + DispatchPushPackedInstruction63, + DispatchPushPackedInstruction64, + DispatchPushPackedInstruction65, + DispatchPushPackedInstruction66, + DispatchPushPackedInstruction67, + DispatchPushPackedInstruction70, + DispatchPushPackedInstruction71, + DispatchPushPackedInstruction72, + DispatchPushPackedInstruction73, + DispatchPushPackedInstruction74, + DispatchPushPackedInstruction75, + DispatchPushPackedInstruction76, + DispatchPushPackedInstruction77, +}; + +static const int PopInstructionDecoder[256] = +{ + DispatchCarPop, + DispatchCdrPop, + DispatchEndpPop, + DispatchSetup1dArrayPop, + DispatchSetupForce1dArrayPop, + DispatchBindLocativePop, + DispatchRestoreBindingStackPop, + DispatchEphemeralpPop, + DispatchStartCallPop, + DispatchJumpPop, + DispatchTagPop, + DispatchDereferencePop, + DispatchLogicTailTestPop, + DispatchProcBreakpointPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchPushLexicalVarPop, + DispatchPushLexicalVarPop, + DispatchPushLexicalVarPop, + DispatchPushLexicalVarPop, + DispatchPushLexicalVarPop, + DispatchPushLexicalVarPop, + DispatchPushLexicalVarPop, + DispatchPushLexicalVarPop, + DispatchBlock0WritePop, + DispatchBlock1WritePop, + DispatchBlock2WritePop, + DispatchBlock3WritePop, + DispatchZeropPop, + DispatchMinuspPop, + DispatchPluspPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchPushPop, + DispatchIllegalInstruction, + DispatchPushAddressSpRelativePop, + DispatchPushLocalLogicVariablesPop, + DispatchReturnMultiplePop, + DispatchReturnKludgePop, + DispatchIllegalInstruction, + DispatchUnbindNPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchUnaryMinusPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchSetToCarPop, + DispatchSetToCdrPop, + DispatchSetToCdrPushCarPop, + DispatchIncrementPop, + DispatchDecrementPop, + DispatchPointerIncrementPop, + DispatchSetCdrCode1Pop, + DispatchSetCdrCode2Pop, + DispatchPushAddressPop, + DispatchSetSpToAddressPop, + DispatchSetSpToAddressSaveTosPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchBlock0ReadAluPop, + DispatchBlock1ReadAluPop, + DispatchBlock2ReadAluPop, + DispatchBlock3ReadAluPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchRplacaPop, + DispatchRplacdPop, + DispatchMultiplyPop, + DispatchQuotientPop, + DispatchCeilingPop, + DispatchFloorPop, + DispatchTruncatePop, + DispatchRoundPop, + DispatchIllegalInstruction, + DispatchRationalQuotientPop, + DispatchMinPop, + DispatchMaxPop, + DispatchAluPop, + DispatchLogandPop, + DispatchLogxorPop, + DispatchLogiorPop, + DispatchRotPop, + DispatchLshPop, + DispatchMultiplyDoublePop, + DispatchLshcBignumStepPop, + DispatchStackBltPop, + DispatchRgetfPop, + DispatchMemberPop, + DispatchAssocPop, + DispatchPointerPlusPop, + DispatchPointerDifferencePop, + DispatchAshPop, + DispatchStoreConditionalPop, + DispatchMemoryWritePop, + DispatchPStoreContentsPop, + DispatchBindLocativeToValuePop, + DispatchUnifyPop, + DispatchPopLexicalVarPop, + DispatchPopLexicalVarPop, + DispatchPopLexicalVarPop, + DispatchPopLexicalVarPop, + DispatchPopLexicalVarPop, + DispatchPopLexicalVarPop, + DispatchPopLexicalVarPop, + DispatchPopLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchMovemLexicalVarPop, + DispatchEqualNumberPop, + DispatchLesspPop, + DispatchGreaterpPop, + DispatchEqlPop, + DispatchEqualNumberNoPopPop, + DispatchLesspNoPopPop, + DispatchGreaterpNoPopPop, + DispatchEqlNoPopPop, + DispatchEqPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchLogtestPop, + DispatchEqNoPopPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchLogtestNoPopPop, + DispatchAddPop, + DispatchSubPop, + Dispatch32BitPlusPop, + Dispatch32BitDifferencePop, + DispatchAddBignumStepPop, + DispatchSubBignumStepPop, + DispatchMultiplyBignumStepPop, + DispatchDivideBignumStepPop, + DispatchAset1Pop, + DispatchAllocateListBlockPop, + DispatchAref1Pop, + DispatchAloc1Pop, + DispatchStoreArrayLeaderPop, + DispatchAllocateStructureBlockPop, + DispatchArrayLeaderPop, + DispatchAlocLeaderPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchInstanceRefPop, + DispatchInstanceSetPop, + DispatchInstanceLocPop, + DispatchSetTagPop, + DispatchIllegalInstruction, + DispatchUnsignedLesspPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchUnsignedLesspNoPopPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchPopPop, + DispatchMovemPop, + DispatchMergeCdrNoPopPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchFastAref1Pop, + DispatchFastAset1Pop, + DispatchStackBltAddressPop, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, + DispatchIllegalInstruction, +}; + +static const int IllegalInstructionDecoder = DispatchIllegalInstruction; + +static void DecodeNoneFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = 0; +} + +static InstructionCacheLine InstructionCacheLookupCPRepresentation = + { TypeOddPC, -1, TypeOddPC, -1, DispatchInstructionCacheLookup, 0, 0, NULL }; + +static void Decode8BitUnsignedOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = i & 0377; +} + +static void Decode8BitSignedOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = SignExtend8 (i); +} + +static void Decode10BitUnsignedOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = i & 01777; +} + +static void Decode12BitUnsignedOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = i & 07777; +} + +static void DecodeFPOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = (i & 0377); +} + +static void DecodeLPOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = (i & 0377); +} + +static void DecodeSPOperandFunction (int i, InstructionCacheLine *cp) +{ + int offset = i & 0377; + + if (offset == 0) + { + cp->code = PopInstructionDecoder [ldb (8,10,i)]; + cp->operand = 0; + } + else + cp->operand = (offset - 255); +} + +static void DecodeBranchOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = SignExtend10 (i); +} + +static void DecodeReturnOperandFunction (int i, InstructionCacheLine *cp) +{ + switch (i & 01777) + { + case 01000: + cp->code = ReturnInstructionDecoder [2]; /*TOS*/ + cp->operand = 0; + break; + case 01040: + cp->code = ReturnInstructionDecoder [0]; /*NIL*/ + cp->operand = 0; + break; + case 01041: + cp->code = ReturnInstructionDecoder [1]; /*T*/ + cp->operand = 0; + break; + } +} + +static void DecodeEntryOperandFunction (int i, InstructionCacheLine *cp) +{ + cp->operand = dpb (ldb (8,18,i), 8, 8, i & 0377); +} + +static const DecoderPair PackedInstructionDecoder[1024] = +{ + { DispatchCarFP, DecodeFPOperandFunction }, + { DispatchCarLP, DecodeLPOperandFunction }, + { DispatchCarSP, DecodeSPOperandFunction }, + { DispatchCarImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchCdrFP, DecodeFPOperandFunction }, + { DispatchCdrLP, DecodeLPOperandFunction }, + { DispatchCdrSP, DecodeSPOperandFunction }, + { DispatchCdrImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchEndpFP, DecodeFPOperandFunction }, + { DispatchEndpLP, DecodeLPOperandFunction }, + { DispatchEndpSP, DecodeSPOperandFunction }, + { DispatchEndpImmediate, Decode8BitSignedOperandFunction }, + { DispatchSetup1dArrayFP, DecodeFPOperandFunction }, + { DispatchSetup1dArrayLP, DecodeLPOperandFunction }, + { DispatchSetup1dArraySP, DecodeSPOperandFunction }, + { DispatchSetup1dArrayImmediate, Decode8BitSignedOperandFunction }, + { DispatchSetupForce1dArrayFP, DecodeFPOperandFunction }, + { DispatchSetupForce1dArrayLP, DecodeLPOperandFunction }, + { DispatchSetupForce1dArraySP, DecodeSPOperandFunction }, + { DispatchSetupForce1dArrayImmediate, Decode8BitSignedOperandFunction }, + { DispatchBindLocativeFP, DecodeFPOperandFunction }, + { DispatchBindLocativeLP, DecodeLPOperandFunction }, + { DispatchBindLocativeSP, DecodeSPOperandFunction }, + { DispatchBindLocativeImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchRestoreBindingStackFP, DecodeFPOperandFunction }, + { DispatchRestoreBindingStackLP, DecodeLPOperandFunction }, + { DispatchRestoreBindingStackSP, DecodeSPOperandFunction }, + { DispatchRestoreBindingStackImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchEphemeralpFP, DecodeFPOperandFunction }, + { DispatchEphemeralpLP, DecodeLPOperandFunction }, + { DispatchEphemeralpSP, DecodeSPOperandFunction }, + { DispatchEphemeralpImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchStartCallFP, DecodeFPOperandFunction }, + { DispatchStartCallLP, DecodeLPOperandFunction }, + { DispatchStartCallSP, DecodeSPOperandFunction }, + { DispatchStartCallImmediate, Decode8BitSignedOperandFunction }, + { DispatchJumpFP, DecodeFPOperandFunction }, + { DispatchJumpLP, DecodeLPOperandFunction }, + { DispatchJumpSP, DecodeSPOperandFunction }, + { DispatchJumpImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchTagFP, DecodeFPOperandFunction }, + { DispatchTagLP, DecodeLPOperandFunction }, + { DispatchTagSP, DecodeSPOperandFunction }, + { DispatchTagImmediate, Decode8BitSignedOperandFunction }, + { DispatchDereferenceFP, DecodeFPOperandFunction }, + { DispatchDereferenceLP, DecodeLPOperandFunction }, + { DispatchDereferenceSP, DecodeSPOperandFunction }, + { DispatchDereferenceImmediate, Decode8BitSignedOperandFunction }, + { DispatchLogicTailTestFP, DecodeFPOperandFunction }, + { DispatchLogicTailTestLP, DecodeLPOperandFunction }, + { DispatchLogicTailTestSP, DecodeSPOperandFunction }, + { DispatchLogicTailTestImmediate, Decode8BitSignedOperandFunction }, + { DispatchProcBreakpointFP, DecodeFPOperandFunction }, + { DispatchProcBreakpointLP, DecodeLPOperandFunction }, + { DispatchProcBreakpointSP, DecodeSPOperandFunction }, + { DispatchProcBreakpointImmediate, Decode8BitSignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPushLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPushLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPushLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPushLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchBlock0WriteFP, DecodeFPOperandFunction }, + { DispatchBlock0WriteLP, DecodeLPOperandFunction }, + { DispatchBlock0WriteSP, DecodeSPOperandFunction }, + { DispatchBlock0WriteImmediate, Decode8BitSignedOperandFunction }, + { DispatchBlock1WriteFP, DecodeFPOperandFunction }, + { DispatchBlock1WriteLP, DecodeLPOperandFunction }, + { DispatchBlock1WriteSP, DecodeSPOperandFunction }, + { DispatchBlock1WriteImmediate, Decode8BitSignedOperandFunction }, + { DispatchBlock2WriteFP, DecodeFPOperandFunction }, + { DispatchBlock2WriteLP, DecodeLPOperandFunction }, + { DispatchBlock2WriteSP, DecodeSPOperandFunction }, + { DispatchBlock2WriteImmediate, Decode8BitSignedOperandFunction }, + { DispatchBlock3WriteFP, DecodeFPOperandFunction }, + { DispatchBlock3WriteLP, DecodeLPOperandFunction }, + { DispatchBlock3WriteSP, DecodeSPOperandFunction }, + { DispatchBlock3WriteImmediate, Decode8BitSignedOperandFunction }, + { DispatchZeropFP, DecodeFPOperandFunction }, + { DispatchZeropLP, DecodeLPOperandFunction }, + { DispatchZeropSP, DecodeSPOperandFunction }, + { DispatchZeropImmediate, Decode8BitSignedOperandFunction }, + { DispatchMinuspFP, DecodeFPOperandFunction }, + { DispatchMinuspLP, DecodeLPOperandFunction }, + { DispatchMinuspSP, DecodeSPOperandFunction }, + { DispatchMinuspImmediate, Decode8BitSignedOperandFunction }, + { DispatchPluspFP, DecodeFPOperandFunction }, + { DispatchPluspLP, DecodeLPOperandFunction }, + { DispatchPluspSP, DecodeSPOperandFunction }, + { DispatchPluspImmediate, Decode8BitSignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMember, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchTypeMemberNoPop, Decode12BitUnsignedOperandFunction }, + { DispatchLocateLocals, DecodeNoneFunction }, + { DispatchLocateLocals, DecodeNoneFunction }, + { DispatchLocateLocals, DecodeNoneFunction }, + { DispatchLocateLocals, DecodeNoneFunction }, + { DispatchCatchClose, DecodeNoneFunction }, + { DispatchCatchClose, DecodeNoneFunction }, + { DispatchCatchClose, DecodeNoneFunction }, + { DispatchCatchClose, DecodeNoneFunction }, + { DispatchGenericDispatch, DecodeNoneFunction }, + { DispatchGenericDispatch, DecodeNoneFunction }, + { DispatchGenericDispatch, DecodeNoneFunction }, + { DispatchGenericDispatch, DecodeNoneFunction }, + { DispatchMessageDispatch, DecodeNoneFunction }, + { DispatchMessageDispatch, DecodeNoneFunction }, + { DispatchMessageDispatch, DecodeNoneFunction }, + { DispatchMessageDispatch, DecodeNoneFunction }, + { DispatchCheckPreemptRequest, DecodeNoneFunction }, + { DispatchCheckPreemptRequest, DecodeNoneFunction }, + { DispatchCheckPreemptRequest, DecodeNoneFunction }, + { DispatchCheckPreemptRequest, DecodeNoneFunction }, + { DispatchPushGlobalLogicVariable, DecodeNoneFunction }, + { DispatchPushGlobalLogicVariable, DecodeNoneFunction }, + { DispatchPushGlobalLogicVariable, DecodeNoneFunction }, + { DispatchPushGlobalLogicVariable, DecodeNoneFunction }, + { DispatchNoOp, DecodeNoneFunction }, + { DispatchNoOp, DecodeNoneFunction }, + { DispatchNoOp, DecodeNoneFunction }, + { DispatchNoOp, DecodeNoneFunction }, + { DispatchHalt, DecodeNoneFunction }, + { DispatchHalt, DecodeNoneFunction }, + { DispatchHalt, DecodeNoneFunction }, + { DispatchHalt, DecodeNoneFunction }, + { DispatchBranchTrue, DecodeBranchOperandFunction }, + { DispatchBranchTrue, DecodeBranchOperandFunction }, + { DispatchBranchTrue, DecodeBranchOperandFunction }, + { DispatchBranchTrue, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchTrueAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalse, DecodeBranchOperandFunction }, + { DispatchBranchFalse, DecodeBranchOperandFunction }, + { DispatchBranchFalse, DecodeBranchOperandFunction }, + { DispatchBranchFalse, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseElseNoPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchBranchFalseAndNoPopElseNoPopExtraPop, DecodeBranchOperandFunction }, + { DispatchPushFP, DecodeFPOperandFunction }, + { DispatchPushLP, DecodeLPOperandFunction }, + { DispatchPushSP, DecodeSPOperandFunction }, + { DispatchPushImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchPushNNils, Decode8BitUnsignedOperandFunction }, + { DispatchPushNNils, Decode8BitUnsignedOperandFunction }, + { DispatchPushNNils, Decode8BitUnsignedOperandFunction }, + { DispatchPushNNils, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressSpRelativeFP, DecodeFPOperandFunction }, + { DispatchPushAddressSpRelativeLP, DecodeLPOperandFunction }, + { DispatchPushAddressSpRelativeSP, DecodeSPOperandFunction }, + { DispatchPushAddressSpRelativeImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchPushLocalLogicVariablesFP, DecodeFPOperandFunction }, + { DispatchPushLocalLogicVariablesLP, DecodeLPOperandFunction }, + { DispatchPushLocalLogicVariablesSP, DecodeSPOperandFunction }, + { DispatchPushLocalLogicVariablesImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchReturnMultipleFP, DecodeFPOperandFunction }, + { DispatchReturnMultipleLP, DecodeLPOperandFunction }, + { DispatchReturnMultipleSP, DecodeSPOperandFunction }, + { DispatchReturnMultipleImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchReturnKludgeFP, DecodeFPOperandFunction }, + { DispatchReturnKludgeLP, DecodeLPOperandFunction }, + { DispatchReturnKludgeSP, DecodeSPOperandFunction }, + { DispatchReturnKludgeImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchTakeValues, Decode8BitUnsignedOperandFunction }, + { DispatchTakeValues, Decode8BitUnsignedOperandFunction }, + { DispatchTakeValues, Decode8BitUnsignedOperandFunction }, + { DispatchTakeValues, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, Decode8BitUnsignedOperandFunction }, + { DispatchUnbindNImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPushInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchUnaryMinusFP, DecodeFPOperandFunction }, + { DispatchUnaryMinusLP, DecodeLPOperandFunction }, + { DispatchUnaryMinusSP, DecodeSPOperandFunction }, + { DispatchUnaryMinusImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchReturnSingleTOS, DecodeReturnOperandFunction }, + { DispatchReturnSingleTOS, DecodeReturnOperandFunction }, + { DispatchReturnSingleTOS, DecodeReturnOperandFunction }, + { DispatchReturnSingleTOS, DecodeReturnOperandFunction }, + { DispatchMemoryRead, Decode10BitUnsignedOperandFunction }, + { DispatchMemoryRead, Decode10BitUnsignedOperandFunction }, + { DispatchMemoryRead, Decode10BitUnsignedOperandFunction }, + { DispatchMemoryRead, Decode10BitUnsignedOperandFunction }, + { DispatchMemoryReadAddress, Decode10BitUnsignedOperandFunction }, + { DispatchMemoryReadAddress, Decode10BitUnsignedOperandFunction }, + { DispatchMemoryReadAddress, Decode10BitUnsignedOperandFunction }, + { DispatchMemoryReadAddress, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3Read, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadShift, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock1ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock2ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchBlock3ReadTest, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallN, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallN, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallN, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallN, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallNApply, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallNApply, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallNApply, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallNApply, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTos, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTos, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTos, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTos, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTosApply, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTosApply, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTosApply, Decode10BitUnsignedOperandFunction }, + { DispatchFinishCallTosApply, Decode10BitUnsignedOperandFunction }, + { DispatchSetToCarFP, DecodeFPOperandFunction }, + { DispatchSetToCarLP, DecodeLPOperandFunction }, + { DispatchSetToCarSP, DecodeSPOperandFunction }, + { DispatchSetToCarImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSetToCdrFP, DecodeFPOperandFunction }, + { DispatchSetToCdrLP, DecodeLPOperandFunction }, + { DispatchSetToCdrSP, DecodeSPOperandFunction }, + { DispatchSetToCdrImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSetToCdrPushCarFP, DecodeFPOperandFunction }, + { DispatchSetToCdrPushCarLP, DecodeLPOperandFunction }, + { DispatchSetToCdrPushCarSP, DecodeSPOperandFunction }, + { DispatchSetToCdrPushCarImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIncrementFP, DecodeFPOperandFunction }, + { DispatchIncrementLP, DecodeLPOperandFunction }, + { DispatchIncrementSP, DecodeSPOperandFunction }, + { DispatchIncrementImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchDecrementFP, DecodeFPOperandFunction }, + { DispatchDecrementLP, DecodeLPOperandFunction }, + { DispatchDecrementSP, DecodeSPOperandFunction }, + { DispatchDecrementImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchPointerIncrementFP, DecodeFPOperandFunction }, + { DispatchPointerIncrementLP, DecodeLPOperandFunction }, + { DispatchPointerIncrementSP, DecodeSPOperandFunction }, + { DispatchPointerIncrementImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSetCdrCode1FP, DecodeFPOperandFunction }, + { DispatchSetCdrCode1LP, DecodeLPOperandFunction }, + { DispatchSetCdrCode1SP, DecodeSPOperandFunction }, + { DispatchSetCdrCode1Immediate, Decode8BitUnsignedOperandFunction }, + { DispatchSetCdrCode2FP, DecodeFPOperandFunction }, + { DispatchSetCdrCode2LP, DecodeLPOperandFunction }, + { DispatchSetCdrCode2SP, DecodeSPOperandFunction }, + { DispatchSetCdrCode2Immediate, Decode8BitUnsignedOperandFunction }, + { DispatchPushAddressFP, DecodeFPOperandFunction }, + { DispatchPushAddressLP, DecodeLPOperandFunction }, + { DispatchPushAddressSP, DecodeSPOperandFunction }, + { DispatchPushAddressImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSetSpToAddressFP, DecodeFPOperandFunction }, + { DispatchSetSpToAddressLP, DecodeLPOperandFunction }, + { DispatchSetSpToAddressSP, DecodeSPOperandFunction }, + { DispatchSetSpToAddressImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSetSpToAddressSaveTosFP, DecodeFPOperandFunction }, + { DispatchSetSpToAddressSaveTosLP, DecodeLPOperandFunction }, + { DispatchSetSpToAddressSaveTosSP, DecodeSPOperandFunction }, + { DispatchSetSpToAddressSaveTosImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchReadInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchReadInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchReadInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchReadInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchWriteInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchWriteInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchWriteInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchWriteInternalRegister, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorRead, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorRead, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorRead, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorRead, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorWrite, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorWrite, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorWrite, Decode10BitUnsignedOperandFunction }, + { DispatchCoprocessorWrite, Decode10BitUnsignedOperandFunction }, + { DispatchBlock0ReadAluFP, DecodeFPOperandFunction }, + { DispatchBlock0ReadAluLP, DecodeLPOperandFunction }, + { DispatchBlock0ReadAluSP, DecodeSPOperandFunction }, + { DispatchBlock0ReadAluImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchBlock1ReadAluFP, DecodeFPOperandFunction }, + { DispatchBlock1ReadAluLP, DecodeLPOperandFunction }, + { DispatchBlock1ReadAluSP, DecodeSPOperandFunction }, + { DispatchBlock1ReadAluImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchBlock2ReadAluFP, DecodeFPOperandFunction }, + { DispatchBlock2ReadAluLP, DecodeLPOperandFunction }, + { DispatchBlock2ReadAluSP, DecodeSPOperandFunction }, + { DispatchBlock2ReadAluImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchBlock3ReadAluFP, DecodeFPOperandFunction }, + { DispatchBlock3ReadAluLP, DecodeLPOperandFunction }, + { DispatchBlock3ReadAluSP, DecodeSPOperandFunction }, + { DispatchBlock3ReadAluImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchLdb, Decode10BitUnsignedOperandFunction }, + { DispatchLdb, Decode10BitUnsignedOperandFunction }, + { DispatchLdb, Decode10BitUnsignedOperandFunction }, + { DispatchLdb, Decode10BitUnsignedOperandFunction }, + { DispatchCharLdb, Decode10BitUnsignedOperandFunction }, + { DispatchCharLdb, Decode10BitUnsignedOperandFunction }, + { DispatchCharLdb, Decode10BitUnsignedOperandFunction }, + { DispatchCharLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagLdb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagLdb, Decode10BitUnsignedOperandFunction }, + { DispatchBranch, DecodeBranchOperandFunction }, + { DispatchBranch, DecodeBranchOperandFunction }, + { DispatchBranch, DecodeBranchOperandFunction }, + { DispatchBranch, DecodeBranchOperandFunction }, + { DispatchLoopDecrementTos, DecodeBranchOperandFunction }, + { DispatchLoopDecrementTos, DecodeBranchOperandFunction }, + { DispatchLoopDecrementTos, DecodeBranchOperandFunction }, + { DispatchLoopDecrementTos, DecodeBranchOperandFunction }, + { DispatchEntryRestAccepted, DecodeEntryOperandFunction }, + { DispatchEntryRestAccepted, DecodeEntryOperandFunction }, + { DispatchEntryRestAccepted, DecodeEntryOperandFunction }, + { DispatchEntryRestAccepted, DecodeEntryOperandFunction }, + { DispatchEntryRestNotAccepted, DecodeEntryOperandFunction }, + { DispatchEntryRestNotAccepted, DecodeEntryOperandFunction }, + { DispatchEntryRestNotAccepted, DecodeEntryOperandFunction }, + { DispatchEntryRestNotAccepted, DecodeEntryOperandFunction }, + { DispatchRplacaFP, DecodeFPOperandFunction }, + { DispatchRplacaLP, DecodeLPOperandFunction }, + { DispatchRplacaSP, DecodeSPOperandFunction }, + { DispatchRplacaImmediate, Decode8BitSignedOperandFunction }, + { DispatchRplacdFP, DecodeFPOperandFunction }, + { DispatchRplacdLP, DecodeLPOperandFunction }, + { DispatchRplacdSP, DecodeSPOperandFunction }, + { DispatchRplacdImmediate, Decode8BitSignedOperandFunction }, + { DispatchMultiplyFP, DecodeFPOperandFunction }, + { DispatchMultiplyLP, DecodeLPOperandFunction }, + { DispatchMultiplySP, DecodeSPOperandFunction }, + { DispatchMultiplyImmediate, Decode8BitSignedOperandFunction }, + { DispatchQuotientFP, DecodeFPOperandFunction }, + { DispatchQuotientLP, DecodeLPOperandFunction }, + { DispatchQuotientSP, DecodeSPOperandFunction }, + { DispatchQuotientImmediate, Decode8BitSignedOperandFunction }, + { DispatchCeilingFP, DecodeFPOperandFunction }, + { DispatchCeilingLP, DecodeLPOperandFunction }, + { DispatchCeilingSP, DecodeSPOperandFunction }, + { DispatchCeilingImmediate, Decode8BitSignedOperandFunction }, + { DispatchFloorFP, DecodeFPOperandFunction }, + { DispatchFloorLP, DecodeLPOperandFunction }, + { DispatchFloorSP, DecodeSPOperandFunction }, + { DispatchFloorImmediate, Decode8BitSignedOperandFunction }, + { DispatchTruncateFP, DecodeFPOperandFunction }, + { DispatchTruncateLP, DecodeLPOperandFunction }, + { DispatchTruncateSP, DecodeSPOperandFunction }, + { DispatchTruncateImmediate, Decode8BitSignedOperandFunction }, + { DispatchRoundFP, DecodeFPOperandFunction }, + { DispatchRoundLP, DecodeLPOperandFunction }, + { DispatchRoundSP, DecodeSPOperandFunction }, + { DispatchRoundImmediate, Decode8BitSignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchRationalQuotientFP, DecodeFPOperandFunction }, + { DispatchRationalQuotientLP, DecodeLPOperandFunction }, + { DispatchRationalQuotientSP, DecodeSPOperandFunction }, + { DispatchRationalQuotientImmediate, Decode8BitSignedOperandFunction }, + { DispatchMinFP, DecodeFPOperandFunction }, + { DispatchMinLP, DecodeLPOperandFunction }, + { DispatchMinSP, DecodeSPOperandFunction }, + { DispatchMinImmediate, Decode8BitSignedOperandFunction }, + { DispatchMaxFP, DecodeFPOperandFunction }, + { DispatchMaxLP, DecodeLPOperandFunction }, + { DispatchMaxSP, DecodeSPOperandFunction }, + { DispatchMaxImmediate, Decode8BitSignedOperandFunction }, + { DispatchAluFP, DecodeFPOperandFunction }, + { DispatchAluLP, DecodeLPOperandFunction }, + { DispatchAluSP, DecodeSPOperandFunction }, + { DispatchAluImmediate, Decode8BitSignedOperandFunction }, + { DispatchLogandFP, DecodeFPOperandFunction }, + { DispatchLogandLP, DecodeLPOperandFunction }, + { DispatchLogandSP, DecodeSPOperandFunction }, + { DispatchLogandImmediate, Decode8BitSignedOperandFunction }, + { DispatchLogxorFP, DecodeFPOperandFunction }, + { DispatchLogxorLP, DecodeLPOperandFunction }, + { DispatchLogxorSP, DecodeSPOperandFunction }, + { DispatchLogxorImmediate, Decode8BitSignedOperandFunction }, + { DispatchLogiorFP, DecodeFPOperandFunction }, + { DispatchLogiorLP, DecodeLPOperandFunction }, + { DispatchLogiorSP, DecodeSPOperandFunction }, + { DispatchLogiorImmediate, Decode8BitSignedOperandFunction }, + { DispatchRotFP, DecodeFPOperandFunction }, + { DispatchRotLP, DecodeLPOperandFunction }, + { DispatchRotSP, DecodeSPOperandFunction }, + { DispatchRotImmediate, Decode8BitSignedOperandFunction }, + { DispatchLshFP, DecodeFPOperandFunction }, + { DispatchLshLP, DecodeLPOperandFunction }, + { DispatchLshSP, DecodeSPOperandFunction }, + { DispatchLshImmediate, Decode8BitSignedOperandFunction }, + { DispatchMultiplyDoubleFP, DecodeFPOperandFunction }, + { DispatchMultiplyDoubleLP, DecodeLPOperandFunction }, + { DispatchMultiplyDoubleSP, DecodeSPOperandFunction }, + { DispatchMultiplyDoubleImmediate, Decode8BitSignedOperandFunction }, + { DispatchLshcBignumStepFP, DecodeFPOperandFunction }, + { DispatchLshcBignumStepLP, DecodeLPOperandFunction }, + { DispatchLshcBignumStepSP, DecodeSPOperandFunction }, + { DispatchLshcBignumStepImmediate, Decode8BitSignedOperandFunction }, + { DispatchStackBltFP, DecodeFPOperandFunction }, + { DispatchStackBltLP, DecodeLPOperandFunction }, + { DispatchStackBltSP, DecodeSPOperandFunction }, + { DispatchStackBltImmediate, Decode8BitSignedOperandFunction }, + { DispatchRgetfFP, DecodeFPOperandFunction }, + { DispatchRgetfLP, DecodeLPOperandFunction }, + { DispatchRgetfSP, DecodeSPOperandFunction }, + { DispatchRgetfImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchMemberFP, DecodeFPOperandFunction }, + { DispatchMemberLP, DecodeLPOperandFunction }, + { DispatchMemberSP, DecodeSPOperandFunction }, + { DispatchMemberImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchAssocFP, DecodeFPOperandFunction }, + { DispatchAssocLP, DecodeLPOperandFunction }, + { DispatchAssocSP, DecodeSPOperandFunction }, + { DispatchAssocImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchPointerPlusFP, DecodeFPOperandFunction }, + { DispatchPointerPlusLP, DecodeLPOperandFunction }, + { DispatchPointerPlusSP, DecodeSPOperandFunction }, + { DispatchPointerPlusImmediate, Decode8BitSignedOperandFunction }, + { DispatchPointerDifferenceFP, DecodeFPOperandFunction }, + { DispatchPointerDifferenceLP, DecodeLPOperandFunction }, + { DispatchPointerDifferenceSP, DecodeSPOperandFunction }, + { DispatchPointerDifferenceImmediate, Decode8BitSignedOperandFunction }, + { DispatchAshFP, DecodeFPOperandFunction }, + { DispatchAshLP, DecodeLPOperandFunction }, + { DispatchAshSP, DecodeSPOperandFunction }, + { DispatchAshImmediate, Decode8BitSignedOperandFunction }, + { DispatchStoreConditionalFP, DecodeFPOperandFunction }, + { DispatchStoreConditionalLP, DecodeLPOperandFunction }, + { DispatchStoreConditionalSP, DecodeSPOperandFunction }, + { DispatchStoreConditionalImmediate, Decode8BitSignedOperandFunction }, + { DispatchMemoryWriteFP, DecodeFPOperandFunction }, + { DispatchMemoryWriteLP, DecodeLPOperandFunction }, + { DispatchMemoryWriteSP, DecodeSPOperandFunction }, + { DispatchMemoryWriteImmediate, Decode8BitSignedOperandFunction }, + { DispatchPStoreContentsFP, DecodeFPOperandFunction }, + { DispatchPStoreContentsLP, DecodeLPOperandFunction }, + { DispatchPStoreContentsSP, DecodeSPOperandFunction }, + { DispatchPStoreContentsImmediate, Decode8BitSignedOperandFunction }, + { DispatchBindLocativeToValueFP, DecodeFPOperandFunction }, + { DispatchBindLocativeToValueLP, DecodeLPOperandFunction }, + { DispatchBindLocativeToValueSP, DecodeSPOperandFunction }, + { DispatchBindLocativeToValueImmediate, Decode8BitSignedOperandFunction }, + { DispatchUnifyFP, DecodeFPOperandFunction }, + { DispatchUnifyLP, DecodeLPOperandFunction }, + { DispatchUnifySP, DecodeSPOperandFunction }, + { DispatchUnifyImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchPopLexicalVarFP, DecodeFPOperandFunction }, + { DispatchPopLexicalVarLP, DecodeLPOperandFunction }, + { DispatchPopLexicalVarSP, DecodeSPOperandFunction }, + { DispatchPopLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchMovemLexicalVarFP, DecodeFPOperandFunction }, + { DispatchMovemLexicalVarLP, DecodeLPOperandFunction }, + { DispatchMovemLexicalVarSP, DecodeSPOperandFunction }, + { DispatchMovemLexicalVarImmediate, Decode8BitSignedOperandFunction }, + { DispatchEqualNumberFP, DecodeFPOperandFunction }, + { DispatchEqualNumberLP, DecodeLPOperandFunction }, + { DispatchEqualNumberSP, DecodeSPOperandFunction }, + { DispatchEqualNumberImmediate, Decode8BitSignedOperandFunction }, + { DispatchLesspFP, DecodeFPOperandFunction }, + { DispatchLesspLP, DecodeLPOperandFunction }, + { DispatchLesspSP, DecodeSPOperandFunction }, + { DispatchLesspImmediate, Decode8BitSignedOperandFunction }, + { DispatchGreaterpFP, DecodeFPOperandFunction }, + { DispatchGreaterpLP, DecodeLPOperandFunction }, + { DispatchGreaterpSP, DecodeSPOperandFunction }, + { DispatchGreaterpImmediate, Decode8BitSignedOperandFunction }, + { DispatchEqlFP, DecodeFPOperandFunction }, + { DispatchEqlLP, DecodeLPOperandFunction }, + { DispatchEqlSP, DecodeSPOperandFunction }, + { DispatchEqlImmediate, Decode8BitSignedOperandFunction }, + { DispatchEqualNumberNoPopFP, DecodeFPOperandFunction }, + { DispatchEqualNumberNoPopLP, DecodeLPOperandFunction }, + { DispatchEqualNumberNoPopSP, DecodeSPOperandFunction }, + { DispatchEqualNumberNoPopImmediate, Decode8BitSignedOperandFunction }, + { DispatchLesspNoPopFP, DecodeFPOperandFunction }, + { DispatchLesspNoPopLP, DecodeLPOperandFunction }, + { DispatchLesspNoPopSP, DecodeSPOperandFunction }, + { DispatchLesspNoPopImmediate, Decode8BitSignedOperandFunction }, + { DispatchGreaterpNoPopFP, DecodeFPOperandFunction }, + { DispatchGreaterpNoPopLP, DecodeLPOperandFunction }, + { DispatchGreaterpNoPopSP, DecodeSPOperandFunction }, + { DispatchGreaterpNoPopImmediate, Decode8BitSignedOperandFunction }, + { DispatchEqlNoPopFP, DecodeFPOperandFunction }, + { DispatchEqlNoPopLP, DecodeLPOperandFunction }, + { DispatchEqlNoPopSP, DecodeSPOperandFunction }, + { DispatchEqlNoPopImmediate, Decode8BitSignedOperandFunction }, + { DispatchEqFP, DecodeFPOperandFunction }, + { DispatchEqLP, DecodeLPOperandFunction }, + { DispatchEqSP, DecodeSPOperandFunction }, + { DispatchEqImmediate, Decode8BitSignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchLogtestFP, DecodeFPOperandFunction }, + { DispatchLogtestLP, DecodeLPOperandFunction }, + { DispatchLogtestSP, DecodeSPOperandFunction }, + { DispatchLogtestImmediate, Decode8BitSignedOperandFunction }, + { DispatchEqNoPopFP, DecodeFPOperandFunction }, + { DispatchEqNoPopLP, DecodeLPOperandFunction }, + { DispatchEqNoPopSP, DecodeSPOperandFunction }, + { DispatchEqNoPopImmediate, Decode8BitSignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchLogtestNoPopFP, DecodeFPOperandFunction }, + { DispatchLogtestNoPopLP, DecodeLPOperandFunction }, + { DispatchLogtestNoPopSP, DecodeSPOperandFunction }, + { DispatchLogtestNoPopImmediate, Decode8BitSignedOperandFunction }, + { DispatchAddFP, DecodeFPOperandFunction }, + { DispatchAddLP, DecodeLPOperandFunction }, + { DispatchAddSP, DecodeSPOperandFunction }, + { DispatchAddImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSubFP, DecodeFPOperandFunction }, + { DispatchSubLP, DecodeLPOperandFunction }, + { DispatchSubSP, DecodeSPOperandFunction }, + { DispatchSubImmediate, Decode8BitUnsignedOperandFunction }, + { Dispatch32BitPlusFP, DecodeFPOperandFunction }, + { Dispatch32BitPlusLP, DecodeLPOperandFunction }, + { Dispatch32BitPlusSP, DecodeSPOperandFunction }, + { Dispatch32BitPlusImmediate, Decode8BitUnsignedOperandFunction }, + { Dispatch32BitDifferenceFP, DecodeFPOperandFunction }, + { Dispatch32BitDifferenceLP, DecodeLPOperandFunction }, + { Dispatch32BitDifferenceSP, DecodeSPOperandFunction }, + { Dispatch32BitDifferenceImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchAddBignumStepFP, DecodeFPOperandFunction }, + { DispatchAddBignumStepLP, DecodeLPOperandFunction }, + { DispatchAddBignumStepSP, DecodeSPOperandFunction }, + { DispatchAddBignumStepImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSubBignumStepFP, DecodeFPOperandFunction }, + { DispatchSubBignumStepLP, DecodeLPOperandFunction }, + { DispatchSubBignumStepSP, DecodeSPOperandFunction }, + { DispatchSubBignumStepImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchMultiplyBignumStepFP, DecodeFPOperandFunction }, + { DispatchMultiplyBignumStepLP, DecodeLPOperandFunction }, + { DispatchMultiplyBignumStepSP, DecodeSPOperandFunction }, + { DispatchMultiplyBignumStepImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchDivideBignumStepFP, DecodeFPOperandFunction }, + { DispatchDivideBignumStepLP, DecodeLPOperandFunction }, + { DispatchDivideBignumStepSP, DecodeSPOperandFunction }, + { DispatchDivideBignumStepImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchAset1FP, DecodeFPOperandFunction }, + { DispatchAset1LP, DecodeLPOperandFunction }, + { DispatchAset1SP, DecodeSPOperandFunction }, + { DispatchAset1Immediate, Decode8BitUnsignedOperandFunction }, + { DispatchAllocateListBlockFP, DecodeFPOperandFunction }, + { DispatchAllocateListBlockLP, DecodeLPOperandFunction }, + { DispatchAllocateListBlockSP, DecodeSPOperandFunction }, + { DispatchAllocateListBlockImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchAref1FP, DecodeFPOperandFunction }, + { DispatchAref1LP, DecodeLPOperandFunction }, + { DispatchAref1SP, DecodeSPOperandFunction }, + { DispatchAref1Immediate, Decode8BitUnsignedOperandFunction }, + { DispatchAloc1FP, DecodeFPOperandFunction }, + { DispatchAloc1LP, DecodeLPOperandFunction }, + { DispatchAloc1SP, DecodeSPOperandFunction }, + { DispatchAloc1Immediate, Decode8BitUnsignedOperandFunction }, + { DispatchStoreArrayLeaderFP, DecodeFPOperandFunction }, + { DispatchStoreArrayLeaderLP, DecodeLPOperandFunction }, + { DispatchStoreArrayLeaderSP, DecodeSPOperandFunction }, + { DispatchStoreArrayLeaderImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchAllocateStructureBlockFP, DecodeFPOperandFunction }, + { DispatchAllocateStructureBlockLP, DecodeLPOperandFunction }, + { DispatchAllocateStructureBlockSP, DecodeSPOperandFunction }, + { DispatchAllocateStructureBlockImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchArrayLeaderFP, DecodeFPOperandFunction }, + { DispatchArrayLeaderLP, DecodeLPOperandFunction }, + { DispatchArrayLeaderSP, DecodeSPOperandFunction }, + { DispatchArrayLeaderImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchAlocLeaderFP, DecodeFPOperandFunction }, + { DispatchAlocLeaderLP, DecodeLPOperandFunction }, + { DispatchAlocLeaderSP, DecodeSPOperandFunction }, + { DispatchAlocLeaderImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariable, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchPopInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchMovemInstanceVariableOrdered, Decode8BitUnsignedOperandFunction }, + { DispatchInstanceRefFP, DecodeFPOperandFunction }, + { DispatchInstanceRefLP, DecodeLPOperandFunction }, + { DispatchInstanceRefSP, DecodeSPOperandFunction }, + { DispatchInstanceRefImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchInstanceSetFP, DecodeFPOperandFunction }, + { DispatchInstanceSetLP, DecodeLPOperandFunction }, + { DispatchInstanceSetSP, DecodeSPOperandFunction }, + { DispatchInstanceSetImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchInstanceLocFP, DecodeFPOperandFunction }, + { DispatchInstanceLocLP, DecodeLPOperandFunction }, + { DispatchInstanceLocSP, DecodeSPOperandFunction }, + { DispatchInstanceLocImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchSetTagFP, DecodeFPOperandFunction }, + { DispatchSetTagLP, DecodeLPOperandFunction }, + { DispatchSetTagSP, DecodeSPOperandFunction }, + { DispatchSetTagImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchUnsignedLesspFP, DecodeFPOperandFunction }, + { DispatchUnsignedLesspLP, DecodeLPOperandFunction }, + { DispatchUnsignedLesspSP, DecodeSPOperandFunction }, + { DispatchUnsignedLesspImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchUnsignedLesspNoPopFP, DecodeFPOperandFunction }, + { DispatchUnsignedLesspNoPopLP, DecodeLPOperandFunction }, + { DispatchUnsignedLesspNoPopSP, DecodeSPOperandFunction }, + { DispatchUnsignedLesspNoPopImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchPopFP, DecodeFPOperandFunction }, + { DispatchPopLP, DecodeLPOperandFunction }, + { DispatchPopSP, DecodeSPOperandFunction }, + { DispatchPopImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchMovemFP, DecodeFPOperandFunction }, + { DispatchMovemLP, DecodeLPOperandFunction }, + { DispatchMovemSP, DecodeSPOperandFunction }, + { DispatchMovemImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchMergeCdrNoPopFP, DecodeFPOperandFunction }, + { DispatchMergeCdrNoPopLP, DecodeLPOperandFunction }, + { DispatchMergeCdrNoPopSP, DecodeSPOperandFunction }, + { DispatchMergeCdrNoPopImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchFastAref1FP, DecodeFPOperandFunction }, + { DispatchFastAref1LP, DecodeLPOperandFunction }, + { DispatchFastAref1SP, DecodeSPOperandFunction }, + { DispatchFastAref1Immediate, Decode8BitUnsignedOperandFunction }, + { DispatchFastAset1FP, DecodeFPOperandFunction }, + { DispatchFastAset1LP, DecodeLPOperandFunction }, + { DispatchFastAset1SP, DecodeSPOperandFunction }, + { DispatchFastAset1Immediate, Decode8BitUnsignedOperandFunction }, + { DispatchStackBltAddressFP, DecodeFPOperandFunction }, + { DispatchStackBltAddressLP, DecodeLPOperandFunction }, + { DispatchStackBltAddressSP, DecodeSPOperandFunction }, + { DispatchStackBltAddressImmediate, Decode8BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchDpb, Decode10BitUnsignedOperandFunction }, + { DispatchDpb, Decode10BitUnsignedOperandFunction }, + { DispatchDpb, Decode10BitUnsignedOperandFunction }, + { DispatchDpb, Decode10BitUnsignedOperandFunction }, + { DispatchCharDpb, Decode10BitUnsignedOperandFunction }, + { DispatchCharDpb, Decode10BitUnsignedOperandFunction }, + { DispatchCharDpb, Decode10BitUnsignedOperandFunction }, + { DispatchCharDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagDpb, Decode10BitUnsignedOperandFunction }, + { DispatchPTagDpb, Decode10BitUnsignedOperandFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchIllegalInstruction, DecodeNoneFunction }, + { DispatchLoopIncrementTosLessThan, DecodeBranchOperandFunction }, + { DispatchLoopIncrementTosLessThan, DecodeBranchOperandFunction }, + { DispatchLoopIncrementTosLessThan, DecodeBranchOperandFunction }, + { DispatchLoopIncrementTosLessThan, DecodeBranchOperandFunction }, + { DispatchCatchOpen, Decode8BitUnsignedOperandFunction }, + { DispatchCatchOpen, Decode8BitUnsignedOperandFunction }, + { DispatchCatchOpen, Decode8BitUnsignedOperandFunction }, + { DispatchCatchOpen, Decode8BitUnsignedOperandFunction }, + { DispatchHack, Decode10BitUnsignedOperandFunction }, + { DispatchHack, Decode10BitUnsignedOperandFunction }, + { DispatchHack, Decode10BitUnsignedOperandFunction }, + { DispatchHack, Decode10BitUnsignedOperandFunction }, +}; + +const char *ivory_dispatch_names[] = { + "CarFP", + "CarLP", + "CarSP", + "CarImmediate", + "CarPop", + "CdrFP", + "CdrLP", + "CdrSP", + "CdrImmediate", + "CdrPop", + "EndpFP", + "EndpLP", + "EndpSP", + "EndpImmediate", + "EndpPop", + "Setup1dArrayFP", + "Setup1dArrayLP", + "Setup1dArraySP", + "Setup1dArrayImmediate", + "Setup1dArrayPop", + "SetupForce1dArrayFP", + "SetupForce1dArrayLP", + "SetupForce1dArraySP", + "SetupForce1dArrayImmediate", + "SetupForce1dArrayPop", + "BindLocativeFP", + "BindLocativeLP", + "BindLocativeSP", + "BindLocativeImmediate", + "BindLocativePop", + "RestoreBindingStackFP", + "RestoreBindingStackLP", + "RestoreBindingStackSP", + "RestoreBindingStackImmediate", + "RestoreBindingStackPop", + "EphemeralpFP", + "EphemeralpLP", + "EphemeralpSP", + "EphemeralpImmediate", + "EphemeralpPop", + "StartCallFP", + "StartCallLP", + "StartCallSP", + "StartCallImmediate", + "StartCallPop", + "JumpFP", + "JumpLP", + "JumpSP", + "JumpImmediate", + "JumpPop", + "TagFP", + "TagLP", + "TagSP", + "TagImmediate", + "TagPop", + "DereferenceFP", + "DereferenceLP", + "DereferenceSP", + "DereferenceImmediate", + "DereferencePop", + "LogicTailTestFP", + "LogicTailTestLP", + "LogicTailTestSP", + "LogicTailTestImmediate", + "LogicTailTestPop", + "ProcBreakpointFP", + "ProcBreakpointLP", + "ProcBreakpointSP", + "ProcBreakpointImmediate", + "ProcBreakpointPop", + "PushLexicalVarFP", + "PushLexicalVarLP", + "PushLexicalVarSP", + "PushLexicalVarImmediate", + "PushLexicalVarPop", + "Block0WriteFP", + "Block0WriteLP", + "Block0WriteSP", + "Block0WriteImmediate", + "Block0WritePop", + "Block1WriteFP", + "Block1WriteLP", + "Block1WriteSP", + "Block1WriteImmediate", + "Block1WritePop", + "Block2WriteFP", + "Block2WriteLP", + "Block2WriteSP", + "Block2WriteImmediate", + "Block2WritePop", + "Block3WriteFP", + "Block3WriteLP", + "Block3WriteSP", + "Block3WriteImmediate", + "Block3WritePop", + "ZeropFP", + "ZeropLP", + "ZeropSP", + "ZeropImmediate", + "ZeropPop", + "MinuspFP", + "MinuspLP", + "MinuspSP", + "MinuspImmediate", + "MinuspPop", + "PluspFP", + "PluspLP", + "PluspSP", + "PluspImmediate", + "PluspPop", + "TypeMember", + "TypeMemberNoPop", + "LocateLocals", + "CatchClose", + "GenericDispatch", + "MessageDispatch", + "CheckPreemptRequest", + "PushGlobalLogicVariable", + "NoOp", + "Halt", + "BranchTrue", + "BranchTrueElseExtraPop", + "BranchTrueAndExtraPop", + "BranchTrueExtraPop", + "BranchTrueNoPop", + "BranchTrueAndNoPop", + "BranchTrueElseNoPop", + "BranchTrueAndNoPopElseNoPopExtraPop", + "BranchFalse", + "BranchFalseElseExtraPop", + "BranchFalseAndExtraPop", + "BranchFalseExtraPop", + "BranchFalseNoPop", + "BranchFalseAndNoPop", + "BranchFalseElseNoPop", + "BranchFalseAndNoPopElseNoPopExtraPop", + "PushFP", + "PushLP", + "PushSP", + "PushImmediate", + "PushPop", + "PushNNils", + "PushAddressSpRelativeFP", + "PushAddressSpRelativeLP", + "PushAddressSpRelativeSP", + "PushAddressSpRelativeImmediate", + "PushAddressSpRelativePop", + "PushLocalLogicVariablesFP", + "PushLocalLogicVariablesLP", + "PushLocalLogicVariablesSP", + "PushLocalLogicVariablesImmediate", + "PushLocalLogicVariablesPop", + "ReturnMultipleFP", + "ReturnMultipleLP", + "ReturnMultipleSP", + "ReturnMultipleImmediate", + "ReturnMultiplePop", + "ReturnKludgeFP", + "ReturnKludgeLP", + "ReturnKludgeSP", + "ReturnKludgeImmediate", + "ReturnKludgePop", + "TakeValues", + "UnbindNImmediate", + "UnbindNPop", + "PushInstanceVariable", + "PushAddressInstanceVariable", + "PushInstanceVariableOrdered", + "PushAddressInstanceVariableOrdered", + "UnaryMinusFP", + "UnaryMinusLP", + "UnaryMinusSP", + "UnaryMinusImmediate", + "UnaryMinusPop", + "ReturnSingleNIL", + "ReturnSingleT", + "ReturnSingleTOS", + "MemoryRead", + "MemoryReadAddress", + "Block0Read", + "Block1Read", + "Block2Read", + "Block3Read", + "Block0ReadShift", + "Block1ReadShift", + "Block2ReadShift", + "Block3ReadShift", + "Block0ReadTest", + "Block1ReadTest", + "Block2ReadTest", + "Block3ReadTest", + "FinishCallN", + "FinishCallNApply", + "FinishCallTos", + "FinishCallTosApply", + "SetToCarFP", + "SetToCarLP", + "SetToCarSP", + "SetToCarImmediate", + "SetToCarPop", + "SetToCdrFP", + "SetToCdrLP", + "SetToCdrSP", + "SetToCdrImmediate", + "SetToCdrPop", + "SetToCdrPushCarFP", + "SetToCdrPushCarLP", + "SetToCdrPushCarSP", + "SetToCdrPushCarImmediate", + "SetToCdrPushCarPop", + "IncrementFP", + "IncrementLP", + "IncrementSP", + "IncrementImmediate", + "IncrementPop", + "DecrementFP", + "DecrementLP", + "DecrementSP", + "DecrementImmediate", + "DecrementPop", + "PointerIncrementFP", + "PointerIncrementLP", + "PointerIncrementSP", + "PointerIncrementImmediate", + "PointerIncrementPop", + "SetCdrCode1FP", + "SetCdrCode1LP", + "SetCdrCode1SP", + "SetCdrCode1Immediate", + "SetCdrCode1Pop", + "SetCdrCode2FP", + "SetCdrCode2LP", + "SetCdrCode2SP", + "SetCdrCode2Immediate", + "SetCdrCode2Pop", + "PushAddressFP", + "PushAddressLP", + "PushAddressSP", + "PushAddressImmediate", + "PushAddressPop", + "SetSpToAddressFP", + "SetSpToAddressLP", + "SetSpToAddressSP", + "SetSpToAddressImmediate", + "SetSpToAddressPop", + "SetSpToAddressSaveTosFP", + "SetSpToAddressSaveTosLP", + "SetSpToAddressSaveTosSP", + "SetSpToAddressSaveTosImmediate", + "SetSpToAddressSaveTosPop", + "ReadInternalRegister", + "WriteInternalRegister", + "CoprocessorRead", + "CoprocessorWrite", + "Block0ReadAluFP", + "Block0ReadAluLP", + "Block0ReadAluSP", + "Block0ReadAluImmediate", + "Block0ReadAluPop", + "Block1ReadAluFP", + "Block1ReadAluLP", + "Block1ReadAluSP", + "Block1ReadAluImmediate", + "Block1ReadAluPop", + "Block2ReadAluFP", + "Block2ReadAluLP", + "Block2ReadAluSP", + "Block2ReadAluImmediate", + "Block2ReadAluPop", + "Block3ReadAluFP", + "Block3ReadAluLP", + "Block3ReadAluSP", + "Block3ReadAluImmediate", + "Block3ReadAluPop", + "Ldb", + "CharLdb", + "PLdb", + "PTagLdb", + "Branch", + "LoopDecrementTos", + "EntryRestAccepted", + "EntryRestNotAccepted", + "RplacaFP", + "RplacaLP", + "RplacaSP", + "RplacaImmediate", + "RplacaPop", + "RplacdFP", + "RplacdLP", + "RplacdSP", + "RplacdImmediate", + "RplacdPop", + "MultiplyFP", + "MultiplyLP", + "MultiplySP", + "MultiplyImmediate", + "MultiplyPop", + "QuotientFP", + "QuotientLP", + "QuotientSP", + "QuotientImmediate", + "QuotientPop", + "CeilingFP", + "CeilingLP", + "CeilingSP", + "CeilingImmediate", + "CeilingPop", + "FloorFP", + "FloorLP", + "FloorSP", + "FloorImmediate", + "FloorPop", + "TruncateFP", + "TruncateLP", + "TruncateSP", + "TruncateImmediate", + "TruncatePop", + "RoundFP", + "RoundLP", + "RoundSP", + "RoundImmediate", + "RoundPop", + "RationalQuotientFP", + "RationalQuotientLP", + "RationalQuotientSP", + "RationalQuotientImmediate", + "RationalQuotientPop", + "MinFP", + "MinLP", + "MinSP", + "MinImmediate", + "MinPop", + "MaxFP", + "MaxLP", + "MaxSP", + "MaxImmediate", + "MaxPop", + "AluFP", + "AluLP", + "AluSP", + "AluImmediate", + "AluPop", + "LogandFP", + "LogandLP", + "LogandSP", + "LogandImmediate", + "LogandPop", + "LogxorFP", + "LogxorLP", + "LogxorSP", + "LogxorImmediate", + "LogxorPop", + "LogiorFP", + "LogiorLP", + "LogiorSP", + "LogiorImmediate", + "LogiorPop", + "RotFP", + "RotLP", + "RotSP", + "RotImmediate", + "RotPop", + "LshFP", + "LshLP", + "LshSP", + "LshImmediate", + "LshPop", + "MultiplyDoubleFP", + "MultiplyDoubleLP", + "MultiplyDoubleSP", + "MultiplyDoubleImmediate", + "MultiplyDoublePop", + "LshcBignumStepFP", + "LshcBignumStepLP", + "LshcBignumStepSP", + "LshcBignumStepImmediate", + "LshcBignumStepPop", + "StackBltFP", + "StackBltLP", + "StackBltSP", + "StackBltImmediate", + "StackBltPop", + "RgetfFP", + "RgetfLP", + "RgetfSP", + "RgetfImmediate", + "RgetfPop", + "MemberFP", + "MemberLP", + "MemberSP", + "MemberImmediate", + "MemberPop", + "AssocFP", + "AssocLP", + "AssocSP", + "AssocImmediate", + "AssocPop", + "PointerPlusFP", + "PointerPlusLP", + "PointerPlusSP", + "PointerPlusImmediate", + "PointerPlusPop", + "PointerDifferenceFP", + "PointerDifferenceLP", + "PointerDifferenceSP", + "PointerDifferenceImmediate", + "PointerDifferencePop", + "AshFP", + "AshLP", + "AshSP", + "AshImmediate", + "AshPop", + "StoreConditionalFP", + "StoreConditionalLP", + "StoreConditionalSP", + "StoreConditionalImmediate", + "StoreConditionalPop", + "MemoryWriteFP", + "MemoryWriteLP", + "MemoryWriteSP", + "MemoryWriteImmediate", + "MemoryWritePop", + "PStoreContentsFP", + "PStoreContentsLP", + "PStoreContentsSP", + "PStoreContentsImmediate", + "PStoreContentsPop", + "BindLocativeToValueFP", + "BindLocativeToValueLP", + "BindLocativeToValueSP", + "BindLocativeToValueImmediate", + "BindLocativeToValuePop", + "UnifyFP", + "UnifyLP", + "UnifySP", + "UnifyImmediate", + "UnifyPop", + "PopLexicalVarFP", + "PopLexicalVarLP", + "PopLexicalVarSP", + "PopLexicalVarImmediate", + "PopLexicalVarPop", + "MovemLexicalVarFP", + "MovemLexicalVarLP", + "MovemLexicalVarSP", + "MovemLexicalVarImmediate", + "MovemLexicalVarPop", + "EqualNumberFP", + "EqualNumberLP", + "EqualNumberSP", + "EqualNumberImmediate", + "EqualNumberPop", + "LesspFP", + "LesspLP", + "LesspSP", + "LesspImmediate", + "LesspPop", + "GreaterpFP", + "GreaterpLP", + "GreaterpSP", + "GreaterpImmediate", + "GreaterpPop", + "EqlFP", + "EqlLP", + "EqlSP", + "EqlImmediate", + "EqlPop", + "EqualNumberNoPopFP", + "EqualNumberNoPopLP", + "EqualNumberNoPopSP", + "EqualNumberNoPopImmediate", + "EqualNumberNoPopPop", + "LesspNoPopFP", + "LesspNoPopLP", + "LesspNoPopSP", + "LesspNoPopImmediate", + "LesspNoPopPop", + "GreaterpNoPopFP", + "GreaterpNoPopLP", + "GreaterpNoPopSP", + "GreaterpNoPopImmediate", + "GreaterpNoPopPop", + "EqlNoPopFP", + "EqlNoPopLP", + "EqlNoPopSP", + "EqlNoPopImmediate", + "EqlNoPopPop", + "EqFP", + "EqLP", + "EqSP", + "EqImmediate", + "EqPop", + "LogtestFP", + "LogtestLP", + "LogtestSP", + "LogtestImmediate", + "LogtestPop", + "EqNoPopFP", + "EqNoPopLP", + "EqNoPopSP", + "EqNoPopImmediate", + "EqNoPopPop", + "LogtestNoPopFP", + "LogtestNoPopLP", + "LogtestNoPopSP", + "LogtestNoPopImmediate", + "LogtestNoPopPop", + "AddFP", + "AddLP", + "AddSP", + "AddImmediate", + "AddPop", + "SubFP", + "SubLP", + "SubSP", + "SubImmediate", + "SubPop", + "32BitPlusFP", + "32BitPlusLP", + "32BitPlusSP", + "32BitPlusImmediate", + "32BitPlusPop", + "32BitDifferenceFP", + "32BitDifferenceLP", + "32BitDifferenceSP", + "32BitDifferenceImmediate", + "32BitDifferencePop", + "AddBignumStepFP", + "AddBignumStepLP", + "AddBignumStepSP", + "AddBignumStepImmediate", + "AddBignumStepPop", + "SubBignumStepFP", + "SubBignumStepLP", + "SubBignumStepSP", + "SubBignumStepImmediate", + "SubBignumStepPop", + "MultiplyBignumStepFP", + "MultiplyBignumStepLP", + "MultiplyBignumStepSP", + "MultiplyBignumStepImmediate", + "MultiplyBignumStepPop", + "DivideBignumStepFP", + "DivideBignumStepLP", + "DivideBignumStepSP", + "DivideBignumStepImmediate", + "DivideBignumStepPop", + "Aset1FP", + "Aset1LP", + "Aset1SP", + "Aset1Immediate", + "Aset1Pop", + "AllocateListBlockFP", + "AllocateListBlockLP", + "AllocateListBlockSP", + "AllocateListBlockImmediate", + "AllocateListBlockPop", + "Aref1FP", + "Aref1LP", + "Aref1SP", + "Aref1Immediate", + "Aref1Pop", + "Aloc1FP", + "Aloc1LP", + "Aloc1SP", + "Aloc1Immediate", + "Aloc1Pop", + "StoreArrayLeaderFP", + "StoreArrayLeaderLP", + "StoreArrayLeaderSP", + "StoreArrayLeaderImmediate", + "StoreArrayLeaderPop", + "AllocateStructureBlockFP", + "AllocateStructureBlockLP", + "AllocateStructureBlockSP", + "AllocateStructureBlockImmediate", + "AllocateStructureBlockPop", + "ArrayLeaderFP", + "ArrayLeaderLP", + "ArrayLeaderSP", + "ArrayLeaderImmediate", + "ArrayLeaderPop", + "AlocLeaderFP", + "AlocLeaderLP", + "AlocLeaderSP", + "AlocLeaderImmediate", + "AlocLeaderPop", + "PopInstanceVariable", + "MovemInstanceVariable", + "PopInstanceVariableOrdered", + "MovemInstanceVariableOrdered", + "InstanceRefFP", + "InstanceRefLP", + "InstanceRefSP", + "InstanceRefImmediate", + "InstanceRefPop", + "InstanceSetFP", + "InstanceSetLP", + "InstanceSetSP", + "InstanceSetImmediate", + "InstanceSetPop", + "InstanceLocFP", + "InstanceLocLP", + "InstanceLocSP", + "InstanceLocImmediate", + "InstanceLocPop", + "SetTagFP", + "SetTagLP", + "SetTagSP", + "SetTagImmediate", + "SetTagPop", + "UnsignedLesspFP", + "UnsignedLesspLP", + "UnsignedLesspSP", + "UnsignedLesspImmediate", + "UnsignedLesspPop", + "UnsignedLesspNoPopFP", + "UnsignedLesspNoPopLP", + "UnsignedLesspNoPopSP", + "UnsignedLesspNoPopImmediate", + "UnsignedLesspNoPopPop", + "PopFP", + "PopLP", + "PopSP", + "PopImmediate", + "PopPop", + "MovemFP", + "MovemLP", + "MovemSP", + "MovemImmediate", + "MovemPop", + "MergeCdrNoPopFP", + "MergeCdrNoPopLP", + "MergeCdrNoPopSP", + "MergeCdrNoPopImmediate", + "MergeCdrNoPopPop", + "FastAref1FP", + "FastAref1LP", + "FastAref1SP", + "FastAref1Immediate", + "FastAref1Pop", + "FastAset1FP", + "FastAset1LP", + "FastAset1SP", + "FastAset1Immediate", + "FastAset1Pop", + "StackBltAddressFP", + "StackBltAddressLP", + "StackBltAddressSP", + "StackBltAddressImmediate", + "StackBltAddressPop", + "Dpb", + "CharDpb", + "PDpb", + "PTagDpb", + "LoopIncrementTosLessThan", + "CatchOpen", + "Hack", + "PushNull", + "PushMonitorForward", + "PushHeaderP", + "PushHeaderI", + "PushExternalValueCellPointer", + "PushOneQForward", + "PushHeaderForward", + "PushElementForward", + "PushFixnum", + "PushSmallRatio", + "PushSingleFloat", + "PushDoubleFloat", + "PushBignum", + "PushBigRatio", + "PushComplex", + "PushSpareNumber", + "PushInstance", + "PushListInstance", + "PushArrayInstance", + "PushStringInstance", + "PushNil", + "PushList", + "PushArray", + "PushString", + "PushSymbol", + "PushLocative", + "PushLexicalClosure", + "PushDynamicClosure", + "PushCompiledFunction", + "PushGenericFunction", + "PushSparePointer1", + "PushSparePointer2", + "PushPhysicalAddress", + "PushSpareImmediate1", + "PushBoundLocation", + "PushCharacter", + "PushLogicVariable", + "PushGcForward", + "PushEvenPc", + "PushOddPc", + "CallCompiledEven", + "CallCompiledOdd", + "CallIndirect", + "CallGeneric", + "CallCompiledEvenPrefetch", + "CallCompiledOddPrefetch", + "CallIndirectPrefetch", + "CallGenericPrefetch", + "PushPackedInstruction60", + "PushPackedInstruction61", + "PushPackedInstruction62", + "PushPackedInstruction63", + "PushPackedInstruction64", + "PushPackedInstruction65", + "PushPackedInstruction66", + "PushPackedInstruction67", + "PushPackedInstruction70", + "PushPackedInstruction71", + "PushPackedInstruction72", + "PushPackedInstruction73", + "PushPackedInstruction74", + "PushPackedInstruction75", + "PushPackedInstruction76", + "PushPackedInstruction77", + "InstructionCacheLookup", + "IllegalInstruction" +}; + +int InstructionCacheMiss (void) +{ + Integer block_vma; + InstructionCacheLine *block_cp; + LispObj *block_instruction; + + block_vma = (processor->pc.DATA.u & ~((InstructionCacheLineSize >> 1) - 1)); + block_cp = processor->InstructionCache + ((block_vma << 1) & (InstructionCacheSize - 1)); + + { + Integer bound_vma = block_vma + (InstructionCacheLineSize>>1); + Integer vma; + InstructionCacheLine *even_cp, *odd_cp; + LispObj instruction_block[(InstructionCacheLineSize>>1)]; + LispObj *instruction = &instruction_block[0]; + Tag tag; + Integer data; + + VirtualMemoryReadBlock(block_vma, instruction_block, (InstructionCacheLineSize>>1)); + + for (vma = block_vma, even_cp = block_cp, odd_cp = block_cp + 1; + vma < bound_vma; + vma++, instruction++, even_cp += 2, odd_cp += 2) + { + tag = instruction->TAG; + data = instruction->DATA.u; + even_cp->pc.DATA.u = vma; + odd_cp->pc.DATA.u = vma; + switch (TagCdr(tag)) + { + case 0: + even_cp->next_pc.TAG = TypeOddPC; + even_cp->next_pc.DATA.u = vma; + even_cp->next_cp = odd_cp; + odd_cp->next_pc.TAG = TypeEvenPC; + odd_cp->next_pc.DATA.u = vma + 1; + odd_cp->next_cp = even_cp + 2; + goto DecodePackedWord; + + case 3: + even_cp->next_pc.TAG = TypeEvenPC; + even_cp->next_pc.DATA.u = vma + 1; + even_cp->next_cp = even_cp + 2; + odd_cp->next_pc.TAG = TypeEvenPC; + odd_cp->next_pc.DATA.u = vma + 2; + odd_cp->next_cp = even_cp + 4; + break; + + case 2: + even_cp->next_pc.TAG = TypeOddPC; + even_cp->next_pc.DATA.u = vma - 1; + even_cp->next_cp = odd_cp - 2; + odd_cp->next_pc.TAG = TypeEvenPC; + odd_cp->next_pc.DATA.u = vma; + odd_cp->next_cp = &InstructionCacheLookupCPRepresentation; + break; + + case 1: + even_cp->code = IllegalInstructionDecoder; + even_cp->operand = 0; + even_cp->instruction = 0; + odd_cp->code = IllegalInstructionDecoder; + odd_cp->operand = 0; + odd_cp->instruction = 0; + goto SkipDecode; + } + + if (!PackedInstructionP (tag)) + { + even_cp->code = WordInstructionDecoder [TagType(tag)]; + even_cp->operand = data; + even_cp->instruction = 0; + odd_cp->code = IllegalInstructionDecoder; + odd_cp->operand = 0; + odd_cp->instruction = 0; + } + else + { + DecodePackedWord: + { Integer instruction; + register const DecoderPair *p; + + instruction = data & 0777777; + even_cp->instruction = instruction; + p = PackedInstructionDecoder + (instruction >> 8); + even_cp->code = (int) (p->dispatch); + (p->decode) (data, even_cp); + + instruction = ((tag & 017) << 14) | ldb(14,18,data); + odd_cp->instruction = instruction; + p = PackedInstructionDecoder + (instruction >> 8); + odd_cp->code = (int) (p->dispatch); + (p->decode) (instruction, odd_cp); + } + } + SkipDecode: {} + } + /* Because of instruction sequencing, some of the cache pointer assignments we + made may actually point out of this cache line. Go back and look at the possibly + errant pointers, and force a cache lookup if necessary. */ + if (block_cp->next_pc.DATA.u < block_vma) + block_cp->next_cp = &InstructionCacheLookupCPRepresentation; + even_cp = block_cp + InstructionCacheLineSize - 4; + if (even_cp->next_pc.DATA.u >= bound_vma) + even_cp->next_cp = &InstructionCacheLookupCPRepresentation; + if ((++even_cp)->next_pc.DATA.u >= bound_vma) + even_cp->next_cp = &InstructionCacheLookupCPRepresentation; + if ((++even_cp)->next_pc.DATA.u >= bound_vma) + even_cp->next_cp = &InstructionCacheLookupCPRepresentation; + if ((++even_cp)->next_pc.DATA.u >= bound_vma) + even_cp->next_cp = &InstructionCacheLookupCPRepresentation; + } + return (0); +} diff --git a/c-emulator/dispatch.h b/c-emulator/dispatch.h new file mode 100644 index 0000000..4c7c53c --- /dev/null +++ b/c-emulator/dispatch.h @@ -0,0 +1,740 @@ +/* -*- Mode:C -*- */ + +#ifndef _DISPATCH_H +#define _DISPATCH_H + +#include "emulator.h" + +extern int InstructionCacheMiss (void); + +extern const char *ivory_dispatch_names[]; + +typedef enum _IvoryDispatch +{ + DispatchCarFP, + DispatchCarLP, + DispatchCarSP, + DispatchCarImmediate, + DispatchCarPop, + DispatchCdrFP, + DispatchCdrLP, + DispatchCdrSP, + DispatchCdrImmediate, + DispatchCdrPop, + DispatchEndpFP, + DispatchEndpLP, + DispatchEndpSP, + DispatchEndpImmediate, + DispatchEndpPop, + DispatchSetup1dArrayFP, + DispatchSetup1dArrayLP, + DispatchSetup1dArraySP, + DispatchSetup1dArrayImmediate, + DispatchSetup1dArrayPop, + DispatchSetupForce1dArrayFP, + DispatchSetupForce1dArrayLP, + DispatchSetupForce1dArraySP, + DispatchSetupForce1dArrayImmediate, + DispatchSetupForce1dArrayPop, + DispatchBindLocativeFP, + DispatchBindLocativeLP, + DispatchBindLocativeSP, + DispatchBindLocativeImmediate, + DispatchBindLocativePop, + DispatchRestoreBindingStackFP, + DispatchRestoreBindingStackLP, + DispatchRestoreBindingStackSP, + DispatchRestoreBindingStackImmediate, + DispatchRestoreBindingStackPop, + DispatchEphemeralpFP, + DispatchEphemeralpLP, + DispatchEphemeralpSP, + DispatchEphemeralpImmediate, + DispatchEphemeralpPop, + DispatchStartCallFP, + DispatchStartCallLP, + DispatchStartCallSP, + DispatchStartCallImmediate, + DispatchStartCallPop, + DispatchJumpFP, + DispatchJumpLP, + DispatchJumpSP, + DispatchJumpImmediate, + DispatchJumpPop, + DispatchTagFP, + DispatchTagLP, + DispatchTagSP, + DispatchTagImmediate, + DispatchTagPop, + DispatchDereferenceFP, + DispatchDereferenceLP, + DispatchDereferenceSP, + DispatchDereferenceImmediate, + DispatchDereferencePop, + DispatchLogicTailTestFP, + DispatchLogicTailTestLP, + DispatchLogicTailTestSP, + DispatchLogicTailTestImmediate, + DispatchLogicTailTestPop, + DispatchProcBreakpointFP, + DispatchProcBreakpointLP, + DispatchProcBreakpointSP, + DispatchProcBreakpointImmediate, + DispatchProcBreakpointPop, + DispatchPushLexicalVarFP, + DispatchPushLexicalVarLP, + DispatchPushLexicalVarSP, + DispatchPushLexicalVarImmediate, + DispatchPushLexicalVarPop, + DispatchBlock0WriteFP, + DispatchBlock0WriteLP, + DispatchBlock0WriteSP, + DispatchBlock0WriteImmediate, + DispatchBlock0WritePop, + DispatchBlock1WriteFP, + DispatchBlock1WriteLP, + DispatchBlock1WriteSP, + DispatchBlock1WriteImmediate, + DispatchBlock1WritePop, + DispatchBlock2WriteFP, + DispatchBlock2WriteLP, + DispatchBlock2WriteSP, + DispatchBlock2WriteImmediate, + DispatchBlock2WritePop, + DispatchBlock3WriteFP, + DispatchBlock3WriteLP, + DispatchBlock3WriteSP, + DispatchBlock3WriteImmediate, + DispatchBlock3WritePop, + DispatchZeropFP, + DispatchZeropLP, + DispatchZeropSP, + DispatchZeropImmediate, + DispatchZeropPop, + DispatchMinuspFP, + DispatchMinuspLP, + DispatchMinuspSP, + DispatchMinuspImmediate, + DispatchMinuspPop, + DispatchPluspFP, + DispatchPluspLP, + DispatchPluspSP, + DispatchPluspImmediate, + DispatchPluspPop, + DispatchTypeMember, + DispatchTypeMemberNoPop, + DispatchLocateLocals, + DispatchCatchClose, + DispatchGenericDispatch, + DispatchMessageDispatch, + DispatchCheckPreemptRequest, + DispatchPushGlobalLogicVariable, + DispatchNoOp, + DispatchHalt, + DispatchBranchTrue, + DispatchBranchTrueElseExtraPop, + DispatchBranchTrueAndExtraPop, + DispatchBranchTrueExtraPop, + DispatchBranchTrueNoPop, + DispatchBranchTrueAndNoPop, + DispatchBranchTrueElseNoPop, + DispatchBranchTrueAndNoPopElseNoPopExtraPop, + DispatchBranchFalse, + DispatchBranchFalseElseExtraPop, + DispatchBranchFalseAndExtraPop, + DispatchBranchFalseExtraPop, + DispatchBranchFalseNoPop, + DispatchBranchFalseAndNoPop, + DispatchBranchFalseElseNoPop, + DispatchBranchFalseAndNoPopElseNoPopExtraPop, + DispatchPushFP, + DispatchPushLP, + DispatchPushSP, + DispatchPushImmediate, + DispatchPushPop, + DispatchPushNNils, + DispatchPushAddressSpRelativeFP, + DispatchPushAddressSpRelativeLP, + DispatchPushAddressSpRelativeSP, + DispatchPushAddressSpRelativeImmediate, + DispatchPushAddressSpRelativePop, + DispatchPushLocalLogicVariablesFP, + DispatchPushLocalLogicVariablesLP, + DispatchPushLocalLogicVariablesSP, + DispatchPushLocalLogicVariablesImmediate, + DispatchPushLocalLogicVariablesPop, + DispatchReturnMultipleFP, + DispatchReturnMultipleLP, + DispatchReturnMultipleSP, + DispatchReturnMultipleImmediate, + DispatchReturnMultiplePop, + DispatchReturnKludgeFP, + DispatchReturnKludgeLP, + DispatchReturnKludgeSP, + DispatchReturnKludgeImmediate, + DispatchReturnKludgePop, + DispatchTakeValues, + DispatchUnbindNImmediate, + DispatchUnbindNPop, + DispatchPushInstanceVariable, + DispatchPushAddressInstanceVariable, + DispatchPushInstanceVariableOrdered, + DispatchPushAddressInstanceVariableOrdered, + DispatchUnaryMinusFP, + DispatchUnaryMinusLP, + DispatchUnaryMinusSP, + DispatchUnaryMinusImmediate, + DispatchUnaryMinusPop, + DispatchReturnSingleNIL, + DispatchReturnSingleT, + DispatchReturnSingleTOS, + DispatchMemoryRead, + DispatchMemoryReadAddress, + DispatchBlock0Read, + DispatchBlock1Read, + DispatchBlock2Read, + DispatchBlock3Read, + DispatchBlock0ReadShift, + DispatchBlock1ReadShift, + DispatchBlock2ReadShift, + DispatchBlock3ReadShift, + DispatchBlock0ReadTest, + DispatchBlock1ReadTest, + DispatchBlock2ReadTest, + DispatchBlock3ReadTest, + DispatchFinishCallN, + DispatchFinishCallNApply, + DispatchFinishCallTos, + DispatchFinishCallTosApply, + DispatchSetToCarFP, + DispatchSetToCarLP, + DispatchSetToCarSP, + DispatchSetToCarImmediate, + DispatchSetToCarPop, + DispatchSetToCdrFP, + DispatchSetToCdrLP, + DispatchSetToCdrSP, + DispatchSetToCdrImmediate, + DispatchSetToCdrPop, + DispatchSetToCdrPushCarFP, + DispatchSetToCdrPushCarLP, + DispatchSetToCdrPushCarSP, + DispatchSetToCdrPushCarImmediate, + DispatchSetToCdrPushCarPop, + DispatchIncrementFP, + DispatchIncrementLP, + DispatchIncrementSP, + DispatchIncrementImmediate, + DispatchIncrementPop, + DispatchDecrementFP, + DispatchDecrementLP, + DispatchDecrementSP, + DispatchDecrementImmediate, + DispatchDecrementPop, + DispatchPointerIncrementFP, + DispatchPointerIncrementLP, + DispatchPointerIncrementSP, + DispatchPointerIncrementImmediate, + DispatchPointerIncrementPop, + DispatchSetCdrCode1FP, + DispatchSetCdrCode1LP, + DispatchSetCdrCode1SP, + DispatchSetCdrCode1Immediate, + DispatchSetCdrCode1Pop, + DispatchSetCdrCode2FP, + DispatchSetCdrCode2LP, + DispatchSetCdrCode2SP, + DispatchSetCdrCode2Immediate, + DispatchSetCdrCode2Pop, + DispatchPushAddressFP, + DispatchPushAddressLP, + DispatchPushAddressSP, + DispatchPushAddressImmediate, + DispatchPushAddressPop, + DispatchSetSpToAddressFP, + DispatchSetSpToAddressLP, + DispatchSetSpToAddressSP, + DispatchSetSpToAddressImmediate, + DispatchSetSpToAddressPop, + DispatchSetSpToAddressSaveTosFP, + DispatchSetSpToAddressSaveTosLP, + DispatchSetSpToAddressSaveTosSP, + DispatchSetSpToAddressSaveTosImmediate, + DispatchSetSpToAddressSaveTosPop, + DispatchReadInternalRegister, + DispatchWriteInternalRegister, + DispatchCoprocessorRead, + DispatchCoprocessorWrite, + DispatchBlock0ReadAluFP, + DispatchBlock0ReadAluLP, + DispatchBlock0ReadAluSP, + DispatchBlock0ReadAluImmediate, + DispatchBlock0ReadAluPop, + DispatchBlock1ReadAluFP, + DispatchBlock1ReadAluLP, + DispatchBlock1ReadAluSP, + DispatchBlock1ReadAluImmediate, + DispatchBlock1ReadAluPop, + DispatchBlock2ReadAluFP, + DispatchBlock2ReadAluLP, + DispatchBlock2ReadAluSP, + DispatchBlock2ReadAluImmediate, + DispatchBlock2ReadAluPop, + DispatchBlock3ReadAluFP, + DispatchBlock3ReadAluLP, + DispatchBlock3ReadAluSP, + DispatchBlock3ReadAluImmediate, + DispatchBlock3ReadAluPop, + DispatchLdb, + DispatchCharLdb, + DispatchPLdb, + DispatchPTagLdb, + DispatchBranch, + DispatchLoopDecrementTos, + DispatchEntryRestAccepted, + DispatchEntryRestNotAccepted, + DispatchRplacaFP, + DispatchRplacaLP, + DispatchRplacaSP, + DispatchRplacaImmediate, + DispatchRplacaPop, + DispatchRplacdFP, + DispatchRplacdLP, + DispatchRplacdSP, + DispatchRplacdImmediate, + DispatchRplacdPop, + DispatchMultiplyFP, + DispatchMultiplyLP, + DispatchMultiplySP, + DispatchMultiplyImmediate, + DispatchMultiplyPop, + DispatchQuotientFP, + DispatchQuotientLP, + DispatchQuotientSP, + DispatchQuotientImmediate, + DispatchQuotientPop, + DispatchCeilingFP, + DispatchCeilingLP, + DispatchCeilingSP, + DispatchCeilingImmediate, + DispatchCeilingPop, + DispatchFloorFP, + DispatchFloorLP, + DispatchFloorSP, + DispatchFloorImmediate, + DispatchFloorPop, + DispatchTruncateFP, + DispatchTruncateLP, + DispatchTruncateSP, + DispatchTruncateImmediate, + DispatchTruncatePop, + DispatchRoundFP, + DispatchRoundLP, + DispatchRoundSP, + DispatchRoundImmediate, + DispatchRoundPop, + DispatchRationalQuotientFP, + DispatchRationalQuotientLP, + DispatchRationalQuotientSP, + DispatchRationalQuotientImmediate, + DispatchRationalQuotientPop, + DispatchMinFP, + DispatchMinLP, + DispatchMinSP, + DispatchMinImmediate, + DispatchMinPop, + DispatchMaxFP, + DispatchMaxLP, + DispatchMaxSP, + DispatchMaxImmediate, + DispatchMaxPop, + DispatchAluFP, + DispatchAluLP, + DispatchAluSP, + DispatchAluImmediate, + DispatchAluPop, + DispatchLogandFP, + DispatchLogandLP, + DispatchLogandSP, + DispatchLogandImmediate, + DispatchLogandPop, + DispatchLogxorFP, + DispatchLogxorLP, + DispatchLogxorSP, + DispatchLogxorImmediate, + DispatchLogxorPop, + DispatchLogiorFP, + DispatchLogiorLP, + DispatchLogiorSP, + DispatchLogiorImmediate, + DispatchLogiorPop, + DispatchRotFP, + DispatchRotLP, + DispatchRotSP, + DispatchRotImmediate, + DispatchRotPop, + DispatchLshFP, + DispatchLshLP, + DispatchLshSP, + DispatchLshImmediate, + DispatchLshPop, + DispatchMultiplyDoubleFP, + DispatchMultiplyDoubleLP, + DispatchMultiplyDoubleSP, + DispatchMultiplyDoubleImmediate, + DispatchMultiplyDoublePop, + DispatchLshcBignumStepFP, + DispatchLshcBignumStepLP, + DispatchLshcBignumStepSP, + DispatchLshcBignumStepImmediate, + DispatchLshcBignumStepPop, + DispatchStackBltFP, + DispatchStackBltLP, + DispatchStackBltSP, + DispatchStackBltImmediate, + DispatchStackBltPop, + DispatchRgetfFP, + DispatchRgetfLP, + DispatchRgetfSP, + DispatchRgetfImmediate, + DispatchRgetfPop, + DispatchMemberFP, + DispatchMemberLP, + DispatchMemberSP, + DispatchMemberImmediate, + DispatchMemberPop, + DispatchAssocFP, + DispatchAssocLP, + DispatchAssocSP, + DispatchAssocImmediate, + DispatchAssocPop, + DispatchPointerPlusFP, + DispatchPointerPlusLP, + DispatchPointerPlusSP, + DispatchPointerPlusImmediate, + DispatchPointerPlusPop, + DispatchPointerDifferenceFP, + DispatchPointerDifferenceLP, + DispatchPointerDifferenceSP, + DispatchPointerDifferenceImmediate, + DispatchPointerDifferencePop, + DispatchAshFP, + DispatchAshLP, + DispatchAshSP, + DispatchAshImmediate, + DispatchAshPop, + DispatchStoreConditionalFP, + DispatchStoreConditionalLP, + DispatchStoreConditionalSP, + DispatchStoreConditionalImmediate, + DispatchStoreConditionalPop, + DispatchMemoryWriteFP, + DispatchMemoryWriteLP, + DispatchMemoryWriteSP, + DispatchMemoryWriteImmediate, + DispatchMemoryWritePop, + DispatchPStoreContentsFP, + DispatchPStoreContentsLP, + DispatchPStoreContentsSP, + DispatchPStoreContentsImmediate, + DispatchPStoreContentsPop, + DispatchBindLocativeToValueFP, + DispatchBindLocativeToValueLP, + DispatchBindLocativeToValueSP, + DispatchBindLocativeToValueImmediate, + DispatchBindLocativeToValuePop, + DispatchUnifyFP, + DispatchUnifyLP, + DispatchUnifySP, + DispatchUnifyImmediate, + DispatchUnifyPop, + DispatchPopLexicalVarFP, + DispatchPopLexicalVarLP, + DispatchPopLexicalVarSP, + DispatchPopLexicalVarImmediate, + DispatchPopLexicalVarPop, + DispatchMovemLexicalVarFP, + DispatchMovemLexicalVarLP, + DispatchMovemLexicalVarSP, + DispatchMovemLexicalVarImmediate, + DispatchMovemLexicalVarPop, + DispatchEqualNumberFP, + DispatchEqualNumberLP, + DispatchEqualNumberSP, + DispatchEqualNumberImmediate, + DispatchEqualNumberPop, + DispatchLesspFP, + DispatchLesspLP, + DispatchLesspSP, + DispatchLesspImmediate, + DispatchLesspPop, + DispatchGreaterpFP, + DispatchGreaterpLP, + DispatchGreaterpSP, + DispatchGreaterpImmediate, + DispatchGreaterpPop, + DispatchEqlFP, + DispatchEqlLP, + DispatchEqlSP, + DispatchEqlImmediate, + DispatchEqlPop, + DispatchEqualNumberNoPopFP, + DispatchEqualNumberNoPopLP, + DispatchEqualNumberNoPopSP, + DispatchEqualNumberNoPopImmediate, + DispatchEqualNumberNoPopPop, + DispatchLesspNoPopFP, + DispatchLesspNoPopLP, + DispatchLesspNoPopSP, + DispatchLesspNoPopImmediate, + DispatchLesspNoPopPop, + DispatchGreaterpNoPopFP, + DispatchGreaterpNoPopLP, + DispatchGreaterpNoPopSP, + DispatchGreaterpNoPopImmediate, + DispatchGreaterpNoPopPop, + DispatchEqlNoPopFP, + DispatchEqlNoPopLP, + DispatchEqlNoPopSP, + DispatchEqlNoPopImmediate, + DispatchEqlNoPopPop, + DispatchEqFP, + DispatchEqLP, + DispatchEqSP, + DispatchEqImmediate, + DispatchEqPop, + DispatchLogtestFP, + DispatchLogtestLP, + DispatchLogtestSP, + DispatchLogtestImmediate, + DispatchLogtestPop, + DispatchEqNoPopFP, + DispatchEqNoPopLP, + DispatchEqNoPopSP, + DispatchEqNoPopImmediate, + DispatchEqNoPopPop, + DispatchLogtestNoPopFP, + DispatchLogtestNoPopLP, + DispatchLogtestNoPopSP, + DispatchLogtestNoPopImmediate, + DispatchLogtestNoPopPop, + DispatchAddFP, + DispatchAddLP, + DispatchAddSP, + DispatchAddImmediate, + DispatchAddPop, + DispatchSubFP, + DispatchSubLP, + DispatchSubSP, + DispatchSubImmediate, + DispatchSubPop, + Dispatch32BitPlusFP, + Dispatch32BitPlusLP, + Dispatch32BitPlusSP, + Dispatch32BitPlusImmediate, + Dispatch32BitPlusPop, + Dispatch32BitDifferenceFP, + Dispatch32BitDifferenceLP, + Dispatch32BitDifferenceSP, + Dispatch32BitDifferenceImmediate, + Dispatch32BitDifferencePop, + DispatchAddBignumStepFP, + DispatchAddBignumStepLP, + DispatchAddBignumStepSP, + DispatchAddBignumStepImmediate, + DispatchAddBignumStepPop, + DispatchSubBignumStepFP, + DispatchSubBignumStepLP, + DispatchSubBignumStepSP, + DispatchSubBignumStepImmediate, + DispatchSubBignumStepPop, + DispatchMultiplyBignumStepFP, + DispatchMultiplyBignumStepLP, + DispatchMultiplyBignumStepSP, + DispatchMultiplyBignumStepImmediate, + DispatchMultiplyBignumStepPop, + DispatchDivideBignumStepFP, + DispatchDivideBignumStepLP, + DispatchDivideBignumStepSP, + DispatchDivideBignumStepImmediate, + DispatchDivideBignumStepPop, + DispatchAset1FP, + DispatchAset1LP, + DispatchAset1SP, + DispatchAset1Immediate, + DispatchAset1Pop, + DispatchAllocateListBlockFP, + DispatchAllocateListBlockLP, + DispatchAllocateListBlockSP, + DispatchAllocateListBlockImmediate, + DispatchAllocateListBlockPop, + DispatchAref1FP, + DispatchAref1LP, + DispatchAref1SP, + DispatchAref1Immediate, + DispatchAref1Pop, + DispatchAloc1FP, + DispatchAloc1LP, + DispatchAloc1SP, + DispatchAloc1Immediate, + DispatchAloc1Pop, + DispatchStoreArrayLeaderFP, + DispatchStoreArrayLeaderLP, + DispatchStoreArrayLeaderSP, + DispatchStoreArrayLeaderImmediate, + DispatchStoreArrayLeaderPop, + DispatchAllocateStructureBlockFP, + DispatchAllocateStructureBlockLP, + DispatchAllocateStructureBlockSP, + DispatchAllocateStructureBlockImmediate, + DispatchAllocateStructureBlockPop, + DispatchArrayLeaderFP, + DispatchArrayLeaderLP, + DispatchArrayLeaderSP, + DispatchArrayLeaderImmediate, + DispatchArrayLeaderPop, + DispatchAlocLeaderFP, + DispatchAlocLeaderLP, + DispatchAlocLeaderSP, + DispatchAlocLeaderImmediate, + DispatchAlocLeaderPop, + DispatchPopInstanceVariable, + DispatchMovemInstanceVariable, + DispatchPopInstanceVariableOrdered, + DispatchMovemInstanceVariableOrdered, + DispatchInstanceRefFP, + DispatchInstanceRefLP, + DispatchInstanceRefSP, + DispatchInstanceRefImmediate, + DispatchInstanceRefPop, + DispatchInstanceSetFP, + DispatchInstanceSetLP, + DispatchInstanceSetSP, + DispatchInstanceSetImmediate, + DispatchInstanceSetPop, + DispatchInstanceLocFP, + DispatchInstanceLocLP, + DispatchInstanceLocSP, + DispatchInstanceLocImmediate, + DispatchInstanceLocPop, + DispatchSetTagFP, + DispatchSetTagLP, + DispatchSetTagSP, + DispatchSetTagImmediate, + DispatchSetTagPop, + DispatchUnsignedLesspFP, + DispatchUnsignedLesspLP, + DispatchUnsignedLesspSP, + DispatchUnsignedLesspImmediate, + DispatchUnsignedLesspPop, + DispatchUnsignedLesspNoPopFP, + DispatchUnsignedLesspNoPopLP, + DispatchUnsignedLesspNoPopSP, + DispatchUnsignedLesspNoPopImmediate, + DispatchUnsignedLesspNoPopPop, + DispatchPopFP, + DispatchPopLP, + DispatchPopSP, + DispatchPopImmediate, + DispatchPopPop, + DispatchMovemFP, + DispatchMovemLP, + DispatchMovemSP, + DispatchMovemImmediate, + DispatchMovemPop, + DispatchMergeCdrNoPopFP, + DispatchMergeCdrNoPopLP, + DispatchMergeCdrNoPopSP, + DispatchMergeCdrNoPopImmediate, + DispatchMergeCdrNoPopPop, + DispatchFastAref1FP, + DispatchFastAref1LP, + DispatchFastAref1SP, + DispatchFastAref1Immediate, + DispatchFastAref1Pop, + DispatchFastAset1FP, + DispatchFastAset1LP, + DispatchFastAset1SP, + DispatchFastAset1Immediate, + DispatchFastAset1Pop, + DispatchStackBltAddressFP, + DispatchStackBltAddressLP, + DispatchStackBltAddressSP, + DispatchStackBltAddressImmediate, + DispatchStackBltAddressPop, + DispatchDpb, + DispatchCharDpb, + DispatchPDpb, + DispatchPTagDpb, + DispatchLoopIncrementTosLessThan, + DispatchCatchOpen, + DispatchHack, + DispatchPushNull, + DispatchPushMonitorForward, + DispatchPushHeaderP, + DispatchPushHeaderI, + DispatchPushExternalValueCellPointer, + DispatchPushOneQForward, + DispatchPushHeaderForward, + DispatchPushElementForward, + DispatchPushFixnum, + DispatchPushSmallRatio, + DispatchPushSingleFloat, + DispatchPushDoubleFloat, + DispatchPushBignum, + DispatchPushBigRatio, + DispatchPushComplex, + DispatchPushSpareNumber, + DispatchPushInstance, + DispatchPushListInstance, + DispatchPushArrayInstance, + DispatchPushStringInstance, + DispatchPushNil, + DispatchPushList, + DispatchPushArray, + DispatchPushString, + DispatchPushSymbol, + DispatchPushLocative, + DispatchPushLexicalClosure, + DispatchPushDynamicClosure, + DispatchPushCompiledFunction, + DispatchPushGenericFunction, + DispatchPushSparePointer1, + DispatchPushSparePointer2, + DispatchPushPhysicalAddress, + DispatchPushSpareImmediate1, + DispatchPushBoundLocation, + DispatchPushCharacter, + DispatchPushLogicVariable, + DispatchPushGcForward, + DispatchPushEvenPc, + DispatchPushOddPc, + DispatchCallCompiledEven, + DispatchCallCompiledOdd, + DispatchCallIndirect, + DispatchCallGeneric, + DispatchCallCompiledEvenPrefetch, + DispatchCallCompiledOddPrefetch, + DispatchCallIndirectPrefetch, + DispatchCallGenericPrefetch, + DispatchPushPackedInstruction60, + DispatchPushPackedInstruction61, + DispatchPushPackedInstruction62, + DispatchPushPackedInstruction63, + DispatchPushPackedInstruction64, + DispatchPushPackedInstruction65, + DispatchPushPackedInstruction66, + DispatchPushPackedInstruction67, + DispatchPushPackedInstruction70, + DispatchPushPackedInstruction71, + DispatchPushPackedInstruction72, + DispatchPushPackedInstruction73, + DispatchPushPackedInstruction74, + DispatchPushPackedInstruction75, + DispatchPushPackedInstruction76, + DispatchPushPackedInstruction77, + DispatchInstructionCacheLookup, + DispatchIllegalInstruction +} IvoryDispatch; + +#endif diff --git a/c-emulator/emulator.c b/c-emulator/emulator.c new file mode 100644 index 0000000..78de442 --- /dev/null +++ b/c-emulator/emulator.c @@ -0,0 +1,4634 @@ +/* -*- Mode:C; Lowercase: Yes -*- */ + +#include +#include +#include +#include +#include +#include +#include + +#ifdef profile +#include +#else +#define MARK(tag) +#endif + +#include "dispatch.h" +#include "emulator.h" +#include "ivory.h" +#include "memory.h" + +volatile int suspend = 0; + +typedef enum _SuspendType +{ + SuspendNone, + SuspendSpy, + SuspendLowPriority, + SuspendHighPriority, + SuspendReset +} SuspendType; + +static jmp_buf trap_environment; +static LispObj trap_vma = { TypeLocative, 0 }; +static LispObj trap_microstate = { TypeFixnum, 0 }; +Integer memory_vma; + +/* General memory trap signalling */ +void TakeMemoryTrap(int vector, Integer vma) +{ + trap_vma.DATA.u = vma; + longjmp(trap_environment, vector); +} + +void TakeIllegalOperandTrap(int microstate, LispObj* operand) +{ + trap_microstate.DATA.s = microstate; + trap_vma.DATA.u = processor->StackCacheBase + (operand - processor->StackCache); + longjmp(trap_environment, ErrorTrapVector); +} + +void TakeInstructionExceptionTrap() +{ + longjmp(trap_environment, InstructionExceptionVector); +} + +/* Convert SEGV's into appropriate trap */ +static void segv_handler (int number) +{ + /* --- figure out real fault reason: r/o, transport?, missing */ + TakeMemoryTrap(PageNotResidentTrapVector, memory_vma); +} + +/* Go to spy when IO pending */ +static void io_handler (int number) +{ + suspend = SuspendSpy; +} + +void SendInterruptToEmulator () +{ + suspend = SuspendHighPriority; +} + +static void ProcessSuspend() +{ + register SuspendType s = suspend; + + suspend = SuspendNone; + switch (s) + { + case SuspendSpy: + longjmp(trap_environment, -1); + case SuspendLowPriority: + longjmp(trap_environment, LowPrioritySequenceBreakTrapVector); + case SuspendHighPriority: + longjmp(trap_environment, HighPrioritySequenceBreakTrapVector); + case SuspendReset: + longjmp(trap_environment, ResetTrapVector); + } +} + +/* Memory interface */ + +int ReadVirtualMemory (Integer vma, LispObj *object) +{ + Integer stack_cache_index = vma - processor->StackCacheBase; + + if (stack_cache_index < StackCacheSize * PageSize) + { + *object = processor->StackCache[stack_cache_index]; + return(0); + } + VirtualMemoryRead (vma, object); + return(0); +} + +int WriteVirtualMemory (Integer vma, LispObj *object) +{ + Integer stack_cache_index = vma - processor->StackCacheBase; + + if (stack_cache_index < StackCacheSize * PageSize) + processor->StackCache[stack_cache_index] = *object; + VirtualMemoryWrite (vma, object); + return(0); +} + +int ReadVirtualMemoryBlock (Integer vma, LispObj *object, int count) +{ + Integer stack_cache_index = vma - processor->StackCacheBase; + + if (stack_cache_index < StackCacheSize * PageSize) + { + for ( ; count--; vma++, object++) + ReadVirtualMemory(vma, object); + return(0); + } + VirtualMemoryReadBlock (vma, object, count); + return(0); +} + +int WriteVirtualMemoryBlock (Integer vma, LispObj *object, int count) +{ + Integer stack_cache_index = vma - processor->StackCacheBase; + + if (stack_cache_index < StackCacheSize * PageSize) + { + for ( ; count--; vma++, object++) + WriteVirtualMemory(vma, object); + return(0); + } + VirtualMemoryWriteBlock (vma, object, count); +} + +void StackCacheScrollUp (void) +{ + Integer shadow; + int i; + + if (Trace) + fprintf (stderr, "StackCacheScrollUp\n"); + /* --- PageSize s/b StackCacheScrollAmount */ + VirtualMemoryWriteBlock(processor->StackCacheBase, processor->StackCache, PageSize); + + for (i = (StackCacheSize - 1); i--; ) + { + memcpy((char *)&processor->StackCache[i*PageSize], + (char *)&processor->StackCache[(1 + i)*PageSize], + sizeof(LispObj [PageSize])); + } + processor->fp -= PageSize; + processor->sp -= PageSize; + processor->lp -= PageSize; + processor->StackCacheBase += PageSize; +} + +void StackCacheScrollDown (void) +{ + int i; + + if (Trace) + fprintf (stderr, "StackCacheScrollDown\n"); + /* --- PageSize s/b StackCacheScrollAmount */ + for (i = (StackCacheSize - 1); i--; ) + { + memcpy((char *)&processor->StackCache[(1 + i)*PageSize], + (char *)&processor->StackCache[i*PageSize], + sizeof(LispObj [PageSize])); + } + processor->fp += PageSize; + processor->sp += PageSize; + processor->lp += PageSize; + processor->StackCacheBase -= PageSize; + VirtualMemoryReadBlock(processor->StackCacheBase, processor->StackCache, PageSize); +} + +Boolean EphemeralP (LispObj *obj) +{ + return(PointerTypeP(TagType(obj->TAG)) && EphemeralAddressP(obj->DATA.u)); +} + +Boolean OldspaceAddressP (vma) +{ + register ProcessorState *ps = processor; + register int zone = ReadVMAZoneNum(vma); + + if (zone == 0) + return (ReadVMAEphemeralHalf(vma) == + ((ps->EphemeralOldspaceRegister >> ReadVMAEphemeralDemilevel(vma))&01)); + else + return (ps->ZoneOldspaceRegister & (1 << zone)); +} + +Boolean OldspaceP (LispObj *obj) +{ + return(PointerTypeP(TagType(obj->TAG)) && OldspaceAddressP(obj->DATA.u)); +} + +Byte MemoryActionTable[12][64] = +{ + { 014, 06, 014, 010, 05, 05, 05, 05, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 044, 0, 024, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 06, 010, 010, 05, 05, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 044, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 04, 06, 014, 010, 04, 05, 05, 05, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 04, 0, 04, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 06, 010, 010, 0, 05, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 04, 05, 014, 010, 04, 05, 05, 05, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 04, 0, 04, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 05, 010, 010, 0, 05, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 014, 014, 04, 0, 014, 014, 05, 014, 010, 010, 010, 014, 014, 014, + 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, + 014, 014, 014, 014, 010, 010, 014, 010, 014, 010, 014, 014, 014, 014, + 014, 014, 014, 014, 014, 014, 010, 010, 010, 010, 010, 010, 010, 010, + 010, 010, 010, 010, 010, 010, 010, 010 }, + { 0, 0, 0, 0, 0, 0, 05, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 04, 04, 04, 0, 04, 04, 04, 04, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 04, 0, 04, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 010, 010, 0, 0, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 } +}; + +Integer MemoryReadInternal (Integer vma, LispObj *object, Byte row[]) +{ + register int action; + + loop: + ReadVirtualMemory (vma, object); + action = row[TagType(object->TAG)]; + + /* Transport takes precedence over anything but trap */ + if (action & (MemoryActionTransport|MemoryActionTrap) == MemoryActionTransport) + { + if (OldspaceAddressP(object->DATA.u)) + TakeMemoryTrap(TransportTrapVector, vma); + } + switch (action&~MemoryActionTransport) + { + case 0: + return (vma); + case MemoryActionTrap: + TakeMemoryTrap(ErrorTrapVector, vma); + case MemoryActionTransform: + object->TAG = MergeCdr(object->TAG, TypeExternalValueCellPointer); + return(vma); + /* --- + case MemoryActionBinding: + vma = LookupDeepBinding(vma); + goto loop; + */ + case MemoryActionMonitor: + TakeMemoryTrap(MonitorTrapVector, vma); + case MemoryActionIndirect: + vma = object->DATA.u; + goto loop; + default: + fprintf(stderr, "Bad memory action\n"); + exit(1); + } +} + +int StoreContentsInternal (Integer vma, LispObj *object, Byte row[]) +{ + LispObj dest; + + vma = MemoryReadInternal(vma, &dest, row); + + dest.TAG = MergeCdr(dest.TAG, object->TAG); + dest.DATA.u = object->DATA.u; + return (WriteVirtualMemory(vma, &dest)); +} + +/**** Lists ****/ + +#ifdef __GNUC__ +/*++inline++*/ +#endif +static int CarInternal (LispObj *l, LispObj *result) +{ + switch (TagType(l->TAG)) + { + case TypeList: + MemoryReadData (l->DATA.u, result); + result->TAG &= TagTypeMask; + return (0); + case TypeNIL: + *result = ObjectNIL; + return (0); + case TypeLocative: + MemoryReadData (l->DATA.u, result); + result->TAG &= TagTypeMask; + return (0); + default: + return (1); + } +} + +#ifdef __GNUC__ +/*++inline++*/ +#endif +static int CdrInternal (LispObj *l, LispObj *result) +{ + LispObj cdr; Integer vma; + + switch(TagType(l->TAG)) + { + case TypeList: + vma = MemoryReadCdr (l->DATA.u, &cdr); + switch (TagCdr (cdr.TAG)) + { + case CdrNil: + *result = ObjectNIL; + return (0); + case CdrNext: + result->TAG = TypeList; + result->DATA.u = vma + 1; + return (0); + case CdrNormal: + MemoryReadData (vma + 1, result); + result->TAG &= TagTypeMask; + return (0); + default: + return (1); + } + case TypeNIL: + *result = ObjectNIL; + return (0); + case TypeLocative: + MemoryReadData (l->DATA.u, result); + result->TAG &= TagTypeMask; + return (0); + default: + return (1); + } +} + +#ifdef __GNUC__ +/*++inline++*/ +#endif +static int CarCdrInternal (LispObj *l, LispObj *car, LispObj *cdr) +{ + /* l may be eq to car, so must save it for cdring*/ + LispObj templ = *l; + + /* CarCdr is not allowed on Locatives */ + if (!TypeEqualP(l->TAG,TypeLocative) && !CarInternal (l, car)) + { + if (!CdrInternal (&templ, cdr)) + return (0); + } + return (1); +} + + +/**** Arrays ****/ + +#ifdef __GNUC__ +/*++inline++*/ +#endif +static void Aref1Internal (Integer vma, int packing, int offset, ArrayElementType type, int index, LispObj* result) +{ + LispObj q; + + if (type == ArrayElementTypeObject && packing == 0) + { + MemoryReadData(vma + index, &q); + StoreCdrNext(*result, q); + return; + } + + index += offset; + MemoryReadData(vma + (index >> packing), &q); + if (!TypeFixnumP(q.TAG)) + TakeMemoryTrap(ErrorTrapVector, vma + (index >> packing)); + if (packing) + q.DATA.u = ArrayElementLdb(packing, index, q.DATA.u); + + switch (type) + { + case ArrayElementTypeFixnum: + result->TAG = TypeFixnum; + result->DATA = q.DATA; + break; + case ArrayElementTypeCharacter: + result->TAG = TypeCharacter; + result->DATA = q.DATA; + break; + case ArrayElementTypeBoolean: + if (q.DATA.u) + *result = ObjectT; + else + *result = ObjectNIL; + break; + case ArrayElementTypeObject: + TakeMemoryTrap(ErrorTrapVector, vma - 1); + } +} + + +#ifdef __GNUC__ +/*++inline++*/ +#endif +static void Aset1Internal (Integer vma, int packing, int offset, ArrayElementType type, int index, LispObj* value) +{ + if (type == ArrayElementTypeObject && packing == 0) + { + StoreContents(vma + index, value, CycleDataWrite); + return; + } + + { + Integer data = value->DATA.u; + LispObj q; + + switch (type) + { + case ArrayElementTypeFixnum: + if (!TypeFixnumP(value->TAG)) + TakeIllegalOperandTrap(0, value); + break; + case ArrayElementTypeCharacter: + if (!TypeEqualP(value->TAG, TypeCharacter) || + ArrayElementLdb(packing,0,data) != data) + TakeIllegalOperandTrap(0, value); + break; + case ArrayElementTypeBoolean: + if (TypeEqualP(value->TAG, TypeNIL)) + data = 0; + else + data = -1; + break; + case ArrayElementTypeObject: + TakeMemoryTrap(ErrorTrapVector, vma - 1); + } + + index += offset; + vma = MemoryReadData(vma + (index >> packing), &q); + if (!TypeFixnumP(q.TAG)) + TakeMemoryTrap(ErrorTrapVector, vma); + if (packing) + q.DATA.u = ArrayElementDpb(data,packing,index,q.DATA.u); + else + q.DATA.u = data; + WriteVirtualMemory(vma, &q); + } +} + +static void RecomputeArrayRegister(LispObj* areg, int count) +{ + switch (TagType(areg[-1].TAG)) + { + case TypeArray: case TypeString: + { + LispObj header; + Integer vma; + + vma = MemoryReadHeader(areg[-1].DATA.u, &header); + if (header.TAG != ArrayHeaderTag) + TakeIllegalOperandTrap(0, areg); + if (ArrayLongPrefixP(header.DATA.u)) + TakeInstructionExceptionTrap(); + areg[0].DATA.u = SetArrayRegisterEventCount(count, header.DATA.u); + areg[1].DATA.u = vma + 1; + areg[2].DATA.s = ArrayShortLength(header.DATA.u); + } + break; + case TypeArrayInstance: case TypeStringInstance: + TakeInstructionExceptionTrap(); + default: + if (TypeSpareP(areg[-1].TAG)) + TakeInstructionExceptionTrap(); + TakeIllegalOperandTrap(0, areg); + } +} + +/**** Instances ****/ + +static Integer LocateInstanceVariableMapped (LispObj *map, LispObj *self, Integer n) +{ + LispObj header, offset; + Integer vma; + + if (!TypeEqualP(map->TAG, TypeArray)) + TakeIllegalOperandTrap(0, map); + MemoryReadHeader(map->DATA.u, &header); + if (n >= ArrayShortLength(header.DATA.u)) + TakeIllegalOperandTrap(0, map); /* --- should be op2 */ + MemoryReadData(map->DATA.u + n + 1, &offset); + if (!TypeFixnumP(offset.TAG)) + TakeInstructionExceptionTrap(); + if (ldb(4, 2, self->TAG) != ldb(4, 2, TypeInstance)) + TakeIllegalOperandTrap(0, self); + if (TagCdr(self->TAG) == 1) + return (self->DATA.u + offset.DATA.u); + vma = MemoryReadHeader(self->DATA.u, &header); + if (vma == self->DATA.u) + self->TAG = SetTagCdr(self->TAG, 1); + return (vma + offset.DATA.u); +} + +static Integer LocateArbitraryInstanceVariable (LispObj *instance, LispObj *offset) +{ + LispObj flavor, size; + Integer vma; + + if (ldb(4, 2, instance->TAG) != ldb(4, 2, TypeInstance)) + if (TypeSpareP(instance->TAG)) + TakeInstructionExceptionTrap(); + else + TakeIllegalOperandTrap(0, instance); + if (!TypeFixnumP(offset->TAG)) + TakeIllegalOperandTrap(0, offset); + vma = MemoryReadHeader(instance->DATA.u, &flavor); + MemoryReadData(flavor.DATA.u - 1, &size); + if (!TypeFixnumP(size.TAG) || + offset->DATA.u >= size.DATA.s) + TakeIllegalOperandTrap(0, offset); + return (vma + offset->DATA.u); +} + +int PullApplyArgsQuickly (int count) +{ + register ProcessorState *ps = processor; + register LispObj *sp = ps->sp; + LispObj *rest = &ps->StackCache[(*sp--).DATA.u - ps->StackCacheBase]; + int supplied = ReadControlArgumentSize(ps->control); + register int i; + + for (i = 0; i < count; i++) + { + if (sp >= ps->StackCacheLimit) + { + ps->sp = sp; + StackCacheScrollUp(); + /* adjust rest for scroll */ + rest += ps->sp - sp; + sp = ps->sp; + } + switch (TagCdr(rest->TAG)) + { + case CdrNext: + StoreCdrNext(*++sp, *rest++); + break; + case CdrNil: + StoreCdrNext(*++sp, *rest); + WriteControlApply(ps->control, 0); + WriteControlArgumentSize(ps->control, supplied + i + 1); + ps->lp += i + 1; + ps->sp = sp; + return(0); + case CdrNormal: + StoreCdrNext(*++sp, *rest++); + switch (TagType(rest->TAG)) + { + case TypeNIL: + WriteControlApply(ps->control, 0); + WriteControlArgumentSize(ps->control, supplied + i + 1); + ps->lp += i + 1; + ps->sp = sp; + return(0); + case TypeList: + { + Integer offset = rest->DATA.u - ps->StackCacheBase; + if (offset < StackCacheSize * PageSize) + { + rest = &ps->StackCache[offset]; + break; + } + /* not in memory, fall through */ + } + default: + StoreCdrNext(*++sp, *rest); + WriteControlArgumentSize(ps->control, supplied + i + 1); + ps->lp += i + 1; + ps->sp = sp; + return(count - (i + 1)); + } + default: + /* Contrary to KHS's emulator, ucode Traps on bad CDR */ + goto trap; + } + } + trap: + ++sp; + sp->TAG = TypeList; + sp->DATA.u = ps->StackCacheBase + (rest - ps->StackCache); + WriteControlArgumentSize(ps->control, supplied + i); + ps->lp += i; + ps->sp = sp; + return(count - i); +} + +/**** Bindings ****/ + +static int Unbind(void) +{ + LispObj old, loc; + Integer bsp = processor->BindingStackPointer; + + if (!ReadControlCleanupBindings(processor->control)) + return (-1); + if (Trace) + fprintf(stderr, "Unbind\n"); + MemoryRead(bsp, &old, CycleBindRead); + MemoryRead(bsp - 1, &loc, CycleBindRead); + StoreContents(loc.DATA.u, &old, CycleBindWrite); + /* no more chance of pclsr-ing */ + processor->BindingStackPointer = bsp - 2; + WriteControlCleanupBindings(processor->control, ldb(1,6,loc.TAG)); + if (ldb(1,1,processor->PreemptRegister)) + processor->PreemptRegister |= 1; + return (0); +} + +/**** ALU Functions ****/ + +Integer ALUFunctionBoolean(Integer ALU, Integer op1, Integer op2) +{ + switch (ReadALUBooleanFunction(ALU)) + { + case BooleClear: return(0); + case BooleAnd: return(op1&op2); + case BooleAndC1: return(~op1&op2); + case Boole2: return(op2); + case BooleAndC2: return(op1&~op2); + case Boole1: return(op1); + case BooleXor: return(op1^op2); + case BooleIor: return(op1|op2); + case BooleNor: return(~(op1|op2)); + case BooleEquiv: return(~(op1^op2)); + case BooleC1: return(~op1); + case BooleOrC1: return(~op1|op2); + case BooleC2: return(~op2); + case BooleOrC2: return(op1|~op2); + case BooleNand: return(~(op1&op2)); + case BooleSet: return( -1 ); + } +} + +Integer ALUFunctionByte(Integer ALU, Integer op1, Integer op2) +{ + Integer background; + int rotate = processor->ByteRotate; + int size = processor->ByteSize; + int rotated, mask; + + switch (ReadALUByteBackground(ALU)) + { + case ALUByteBackgroundOp1: + background = op1; break; + case ALUByteBackgroundRotateLatch: + background = processor->RotateLatch; break; + case ALUByteBackgroundZero: + background = 0; break; + } + + switch (ReadALUByteFunction(ALU)) + { + case ALUByteFunctionDpb: + rotated = op2 << rotate; + mask = (~(-2 << size)) << rotate; + if (ReadALUByteRotateLatch(ALU)) + processor->RotateLatch = rotated | ((unsigned)op2 >> ((32 - rotate) & 0x1f)); + return((rotated&mask)|(background&~mask)); + case ALUByteFunctionLdb: + rotated = (unsigned)op2 >> ((32 - rotate) & 0x1f); + mask = ~(-2 << size); + if (ReadALUByteRotateLatch(ALU)) + processor->RotateLatch = rotated | (op2 << rotate); + return((rotated&mask)|(background&~mask)); + } +} + +Integer ALUFunctionAdder(Integer ALU, Integer op1, Integer op2) +{ + int sum; + + switch (ReadALUAdderOp2(ALU)) + { + case ALUAdderOp2Op2: break; + case ALUAdderOp2Zero: op2 = 0; + case ALUAdderOp2Invert: op2 = -op2; + case ALUAdderOp2MinusOne: op2 = -1; + } + + sum = op1 + op2 + ReadALUAdderCarryIn(ALU); + processor->ALUOverflow = ((sum >= op1) != (op2 >= 0)); + processor->ALUBorrow = ((unsigned)op1 < (unsigned)op2); + processor->ALULessThan = (op1 < op2); + return((Integer)sum); +} + +Integer ALUFunctionMultiplyDivide(Integer ALU, Integer op1, Integer op2) +{ + fprintf(stderr, "Bullshit\n"); +} + +Integer (*ALUFunctionClass[4])() = +{ + ALUFunctionBoolean, + ALUFunctionByte, + ALUFunctionAdder, + ALUFunctionMultiplyDivide +}; + +Boolean ALUComputeCondition (Integer ALU, LispObj *op1, LispObj *op2, int result) +{ + Boolean overflow = processor->ALUOverflow; + Boolean borrow = processor->ALUBorrow; + Boolean lessthan = processor->ALULessThan; + + switch (ReadALUCondition(ALU)) + { + case ConditionSignedLessThanOrEqual: + return(lessthan || !result); + case ConditionSignedLessThan: + return(lessthan); + case ConditionNegative: + return(result < 0); + case ConditionSignedOverflow: + return(overflow); + case ConditionUnsignedLessThanOrEqual: + return(borrow || !result); + case ConditionUnsignedLessThan: + return(borrow); + case ConditionZero: + return(!result); + case ConditionHigh25Zero: + return(!ldb(25,7,result)); + case ConditionEq: + return(ObjectEqP(*op1, *op2)); + case ConditionOp1Ephemeralp: + return(EphemeralP(op1)); + case ConditionResultTypeNil: + return(TypeEqualP(op1->TAG, TypeNIL)); + case ConditionOp2Fixnum: + return(TypeFixnumP(op2->TAG)); + case ConditionFalse: + return(0); + case ConditionResultCdrLow: + return(TagCdr(op1->TAG)&01); + case ConditionCleanupBitsSet: + return(ReadControlCleanupBits(processor->control)); + case ConditionAddressInStackCache: + return(op1->DATA.u - processor->StackCacheBase < StackCacheSize * PageSize); + case ConditionExtraStackMode: + return(!ReadControlTrapMode(processor->control)); + case ConditionFepMode: + return(ReadControlTrapMode(processor->control) == 3); + case ConditionFpCoprocessorPresent: + return(0); + case ConditionOp1Oldspacep: + return(OldspaceP(op1)); + case ConditionPendingSequenceBreakEnabled: + ; + case ConditionOp1TypeAcceptable: + ; + case ConditionOp1TypeCondition: + ; + case ConditionStackCacheOverflow: + ; + case ConditionOrLogicVariable: + ; + default: + fprintf(stderr, "Unimplemented Condition %d\n", ReadALUCondition(ALU)) ; + } +} + +/**** Instruction execution ****/ + +#define AddressImmediateOperand() (op2 = &immediate, op2->DATA.s = cp->operand) +#define AddressSPOperand() (op2 = &sp[cp->operand]) +#define AddressFPOperand() (op2 = &fp[cp->operand]) +#define AddressLPOperand() (op2 = &lp[cp->operand]) +#define AddressPopOperand() (op2 = sp--) +#define AddressBAR(n) (bar = &processor->bar[n]) + +/* Be careful not to side-effect TOS before setting (in case TOS is your arg!) */ +#define PushObject(object) { StoreCdrNext(sp[1],*(object)); sp++; } +#define PushFixnum(integer) { sp[1].DATA.s = (integer); sp[1].TAG = TypeFixnum; sp++; } +#define PushNIL() { sp[1] = ObjectNIL; sp++; } +#define PushT() { sp[1] = ObjectT; sp++; } +#define PushConstant(typearg,dataarg) { Tag tag = (typearg); Integer data = (dataarg); sp[1].TAG = tag; sp[1].DATA.u = data; sp++;} +#define PushPredicate(v) { if (v) { PushT (); } else { PushNIL (); } } +#define PopObject(object) { *(object) = *sp--; } +#define MoveObject(object) { *(object) = *sp; } + +/* Convenience macros for setting TOS */ +#define SetObject(object) StoreCdrNext(*sp,*(object)) +#define SetFixnum(integer) { sp->DATA.s = (integer); sp->TAG = TypeFixnum; } +#define SetNIL() (*sp = ObjectNIL) +#define SetT() (*sp = ObjectT) +#define SetPredicate(v) { if (v) { SetT (); } else { SetNIL (); } } +#define SetConstant(typearg,dataarg) { Tag tag = (typearg); Integer data = (dataarg); sp->TAG = tag; sp->DATA.u = data; } + +#define BranchConditionTrue ((sp->TAG & TagTypeMask) != TypeNIL) +#define BranchConditionFalse ((sp->TAG & TagTypeMask) == TypeNIL) +#define TakeBranch(pops) { sp -= (pops); goto BranchTaken; } +#define DontTakeBranch(pops) { sp -= (pops); goto BranchNotTaken; } + +#define NextInstruction goto NextInstructionTag +#define UnimplementedInstruction goto UnimplementedInstructionTag +#define InstructionException goto InstructionExceptionTag +#define IllegalOperand goto IllegalOperandTag +#define AllowSequenceBreaks { if (suspend) ProcessSuspend(); } + +#define PushContinuation(c) PushConstant(c.TAG|0300,c.DATA.u) +#define PushControl(c) PushConstant(TypeFixnum|0300,c) + +#define DecacheRegisters() { ps->sp=sp; ps->restartsp=restartsp; ps->fp=fp; ps->lp=lp; ps->pc=pc; } +#define EncacheRegisters() { sp=ps->sp; restartsp=ps->restartsp; fp=ps->fp; lp=ps->lp; pc=ps->pc; } + +void IncrementPC(LispObj* pc, int offset) +{ + pc->DATA.u += (offset >> 1); + if (pc->TAG & 1) + if (offset & 1) + { + pc->TAG = TypeEvenPC; + pc->DATA.u++; + } + else + pc->TAG = TypeOddPC; + else + if (offset & 1) + pc->TAG = TypeOddPC; + else + pc->TAG = TypeEvenPC; +} + +void InstructionSequencer (void) +{ + /* Do not use register decls without considering setjmp/longjmp effects */ + /* register */ InstructionCacheLine *cp; + /* register */ ProcessorState *ps = processor; + /* register */ LispObj *sp = ps->sp; + LispObj *restartsp = ps->sp; + /* register */ LispObj *fp = ps->fp; + /* register */ LispObj *lp = ps->lp; + PC pc = ps->pc; + LispObj *op1; + /* register */ LispObj *op2; + LispObj scratch_representation; + LispObj *scratch = &scratch_representation; + LispObj immediate = { TypeFixnum, 0 }; + struct _bar *bar; + int i; + void (*old_io_handler) () = signal(SIGIO, io_handler); + void (*old_segv_handler) () = signal(SIGSEGV, segv_handler); + int vector; + + if (vector = setjmp(trap_environment)) + { + DecacheRegisters(); + switch (vector) + { + /* Special "Spy" vector */ + case -1: + if (Trace) fprintf(stderr, "Spy\n"); + return; + + /* Traps with no arguments */ + case HighPrioritySequenceBreakTrapVector: + case LowPrioritySequenceBreakTrapVector: + case ResetTrapVector: + if (Trace) + fprintf(stderr, "%08x Trap at PC %08x, VMA %08x, #%d\n", vector, pc.DATA.u, + trap_vma.DATA.u, ps->instruction_count); + if (!TakePreTrap(vector, 0, 0)) + goto halt; + break; + + /* ErrorTrap takes an two arguments */ + case ErrorTrapVector: + if (Trace) + fprintf(stderr, "Illegal operand at PC %08x, VMA %08x, #%d\n", pc.DATA.u, + trap_vma.DATA.u, ps->instruction_count); + /* Check for errors in a bad spot */ + if (!((trap_vma.DATA.u^(TrapVectorBase + ResetTrapVector))&PageNumberMask)) + goto halt; + if (!TakePreTrap(vector, &trap_microstate, &trap_vma)) + goto halt; + break; + + /* Memory traps with one argument */ + case MonitorTrapVector: + case TransportTrapVector: + case PageNotResidentTrapVector: + if (Trace) + fprintf(stderr, "%08x Trap at PC %08x, VMA %08x, #%d\n", vector, pc.DATA.u, + trap_vma.DATA.u, ps->instruction_count); + /* Check for errors in a bad spot */ + if (!((trap_vma.DATA.u^(TrapVectorBase + ResetTrapVector))&PageNumberMask)) + goto halt; + if (!TakePreTrap(vector, &trap_vma, 0)) + goto halt; + break; + + /* InstructionExceptions */ + case InstructionExceptionVector: + if (Trace) + fprintf(stderr, "Instruction exception at PC %08x, #%d\n", pc.DATA.u, ps->instruction_count); + if(!TakeInstructionException(cp->instruction, op2, &cp->next_pc)) + goto halt; + break; + + default: + fprintf(stderr, "Bad Trap code %o\n", vector); + exit(1); + } + EncacheRegisters(); + } + goto InstructionCacheLookup; + +BranchNotTaken: +MARK(NextInstruction); +NextInstructionTag: + pc = cp->next_pc; + cp = cp->next_cp; + +Dispatch: + /* Here for things that advance the PC non-sequentially, e.g., branch */ + restartsp = sp; + /* --- for debugging (single-step) only; after each pc advance */ + AllowSequenceBreaks; + + if (cp->code != DispatchInstructionCacheLookup) + { + ps->instruction_count++; + if (Trace) + { + fprintf(stderr, "PC %08x(%s), SP: %08x, TOS: %x.%02x.%08x, %s(%d)\n", + cp->pc.DATA.u, (cp->pc.TAG&1)?"Odd ":"Even", + ps->StackCacheBase + (sp - ps->StackCache), + TagCdr(sp->TAG), TagType(sp->TAG), sp->DATA.u, + ivory_dispatch_names[cp->code], + cp->operand); + } + } + switch (cp->code) + { + case DispatchInstructionCacheLookup: + InstructionCacheLookup: + /* --- debug: returned to top frame */ + if (TypeEqualP(pc.TAG, TypeNIL)) + goto save_and_halt; + /* --- debug */ + if (!(TypeEqualP(pc.TAG, TypeEvenPC) || TypeEqualP(pc.TAG, TypeOddPC))) + InstructionException; + if (Trace) + { + fprintf(stderr, "Icache lookup at PC %08x(%s)\n", pc.DATA.u, (pc.TAG&1)?"Odd ":"Even"); + } + cp = ps->InstructionCache + + ((pc.DATA.u << 1) & (InstructionCacheSize-1)) + (pc.TAG & 1); + if (cp->pc.DATA.u != pc.DATA.u) + { + DecacheRegisters(); + if (InstructionCacheMiss()) goto halt; + EncacheRegisters(); + } + goto Dispatch; + + case DispatchIllegalInstruction: + goto UnimplementedInstructionTag; + + case DispatchBranch: + BranchTaken: + if (!cp->operand) + IllegalOperand; + pc.DATA.u += (cp->operand >> 1); + if (pc.TAG & 1) + if (cp->operand & 1) + { + pc.TAG = TypeEvenPC; + pc.DATA.u++; + } + else + pc.TAG = TypeOddPC; + else + if (cp->operand & 1) + pc.TAG = TypeOddPC; + else + pc.TAG = TypeEvenPC; + goto InstructionCacheLookup; + + case DispatchCarSP: AddressSPOperand (); goto ExecuteCar; + case DispatchCarFP: AddressFPOperand (); goto ExecuteCar; + case DispatchCarLP: AddressLPOperand (); goto ExecuteCar; + case DispatchCarPop: AddressPopOperand (); goto ExecuteCar; + ExecuteCar: + MARK(Car); + if (!CarInternal (op2, sp+1)) + { + sp++; + NextInstruction; + } + goto Op2ListExceptions; + + case DispatchCdrSP: AddressSPOperand (); goto ExecuteCdr; + case DispatchCdrFP: AddressFPOperand (); goto ExecuteCdr; + case DispatchCdrLP: AddressLPOperand (); goto ExecuteCdr; + case DispatchCdrPop:AddressPopOperand (); goto ExecuteCdr; + ExecuteCdr: + MARK(Cdr); + if (!CdrInternal (op2, sp+1)) + { + sp++; + NextInstruction; + } + goto Op2ListExceptions; + + case DispatchSetToCarSP: AddressSPOperand (); goto ExecuteSetToCar; + case DispatchSetToCarFP: AddressFPOperand (); goto ExecuteSetToCar; + case DispatchSetToCarLP: AddressLPOperand (); goto ExecuteSetToCar; + ExecuteSetToCar: + MARK(SetToCar); + if (!CarInternal (op2, scratch)) + { + op2->TAG = MergeCdr(op2->TAG, scratch->TAG); + op2->DATA = scratch->DATA; + NextInstruction; + } + goto Op2ListExceptions; + + case DispatchSetToCdrSP: AddressSPOperand (); goto ExecuteSetToCdr; + case DispatchSetToCdrFP: AddressFPOperand (); goto ExecuteSetToCdr; + case DispatchSetToCdrLP: AddressLPOperand (); goto ExecuteSetToCdr; + ExecuteSetToCdr: + MARK(SetToCdr); + if (!CdrInternal (op2, scratch)) + { + op2->TAG = MergeCdr(op2->TAG, scratch->TAG); + op2->DATA = scratch->DATA; + NextInstruction; + } + goto Op2ListExceptions; + + case DispatchSetToCdrPushCarSP: AddressSPOperand (); goto ExecuteSetToCdrPushCar; + case DispatchSetToCdrPushCarFP: AddressFPOperand (); goto ExecuteSetToCdrPushCar; + case DispatchSetToCdrPushCarLP: AddressLPOperand (); goto ExecuteSetToCdrPushCar; + ExecuteSetToCdrPushCar: + MARK(SetToCdrPushCar); + if (!CarInternal (op2, sp+1) && !CdrInternal (op2, scratch)) + { + op2->TAG = MergeCdr(op2->TAG, scratch->TAG); + op2->DATA = scratch->DATA; + sp++; + NextInstruction; + } + goto Op2ListExceptions; + + case DispatchRplacaImmediate: AddressImmediateOperand (); goto ExecuteRplaca; + case DispatchRplacaSP: AddressSPOperand (); goto ExecuteRplaca; + case DispatchRplacaFP: AddressFPOperand (); goto ExecuteRplaca; + case DispatchRplacaLP: AddressLPOperand (); goto ExecuteRplaca; + case DispatchRplacaPop: AddressPopOperand (); goto ExecuteRplaca; + ExecuteRplaca: + MARK(Rplaca); + switch (TagType (sp->TAG)) + { + case TypeList: + case TypeLocative: + StoreContents (sp->DATA.u, op2, CycleDataWrite); + sp--; + NextInstruction; + } + goto SpListExceptions; + + case DispatchRplacdImmediate: AddressImmediateOperand (); goto ExecuteRplacd; + case DispatchRplacdSP: AddressSPOperand (); goto ExecuteRplacd; + case DispatchRplacdFP: AddressFPOperand (); goto ExecuteRplacd; + case DispatchRplacdLP: AddressLPOperand (); goto ExecuteRplacd; + case DispatchRplacdPop: AddressPopOperand (); goto ExecuteRplacd; + ExecuteRplacd: + MARK(Rplacd); + switch (TagType (sp->TAG)) + { + case TypeList: + { + LispObj cdr; Integer vma; + + vma = MemoryReadCdr (sp->DATA.u, &cdr); + switch (TagCdr (cdr.TAG)) + { + case CdrNormal: + StoreContents (vma + 1, op2, CycleDataWrite); + sp--; + NextInstruction; + default: InstructionException; + } + } + case TypeLocative: + StoreContents (sp->DATA.u, op2, CycleDataWrite); + sp--; + NextInstruction; + } + goto SpListExceptions; + + case DispatchRgetfSP: AddressSPOperand (); goto ExecuteRgetf; + case DispatchRgetfFP: AddressFPOperand (); goto ExecuteRgetf; + case DispatchRgetfLP: AddressLPOperand (); goto ExecuteRgetf; + case DispatchRgetfPop: AddressPopOperand (); goto ExecuteRgetf; + ExecuteRgetf: + MARK(Rgetf); + if ((TypeDoubleFloat <= (TagType (sp->TAG))) && + ((TagType (sp->TAG)) <= TypeSpareNumber)) + /* EQL is different from EQ for these, so trap */ + InstructionException; + *scratch = *op2; + for ( ; ; ) + { + LispObj car_rep, cdr_rep; + LispObj *car = &car_rep, *cdr = &cdr_rep; + + if ( (TagType (scratch->TAG)) == TypeNIL ) + { + SetNIL (); + PushNIL (); + NextInstruction; + } + if (CarCdrInternal (scratch, car, cdr)) + goto ScratchListExceptions; + if ( ObjectEqP(*car, *sp) ) + switch (TagType (cdr->TAG)) + { + case TypeList: + if (CarInternal (cdr, sp)) + InstructionException; + PushObject (cdr); + NextInstruction; + case TypeNIL: case TypeListInstance: + InstructionException; + default: + IllegalOperand; + } + else + if (CdrInternal (cdr, scratch)) + if (TypeEqualP(cdr->TAG,TypeListInstance) || TypeSpareP(cdr->TAG)) + InstructionException; + else + IllegalOperand; + AllowSequenceBreaks; + } + + case DispatchMemberSP: AddressSPOperand (); goto ExecuteMember; + case DispatchMemberFP: AddressFPOperand (); goto ExecuteMember; + case DispatchMemberLP: AddressLPOperand (); goto ExecuteMember; + case DispatchMemberPop: AddressPopOperand (); goto ExecuteMember; + ExecuteMember: + MARK(Member); + if ((TypeDoubleFloat <= (TagType (sp->TAG))) && + ((TagType (sp->TAG)) <= TypeSpareNumber)) + /* EQL is different from EQ for these, so trap */ + InstructionException; + *scratch = *op2; + for ( ; ; ) + { + LispObj car_rep, cdr_rep; + LispObj *car = &car_rep, *cdr = &cdr_rep; + + if ( (TagType (scratch->TAG)) == TypeNIL ) + { + SetNIL (); + NextInstruction; + } + if (CarCdrInternal (scratch, car, cdr)) + goto ScratchListExceptions; + if ( ObjectEqP(*car, *sp) ) + { + SetObject (scratch); + NextInstruction; + } + else + *scratch = *cdr; + AllowSequenceBreaks; + } + + case DispatchAssocSP: AddressSPOperand (); goto ExecuteAssoc; + case DispatchAssocFP: AddressFPOperand (); goto ExecuteAssoc; + case DispatchAssocLP: AddressLPOperand (); goto ExecuteAssoc; + case DispatchAssocPop: AddressPopOperand (); goto ExecuteAssoc; + ExecuteAssoc: + MARK(Assoc); + /* + * (assoc x list) + * x is at TOS, list is in op2. + */ + if ((TypeDoubleFloat <= (TagType (sp->TAG))) && + ((TagType (sp->TAG)) <= TypeSpareNumber)) + /* EQL is different from EQ for these, so trap */ + InstructionException; + *scratch = *op2; + for ( ; ; ) + { + LispObj car_rep, cdr_rep; + LispObj *car = &car_rep, *cdr = &cdr_rep; + + if ( (TagType (scratch->TAG)) == TypeNIL ) + { + SetNIL (); + NextInstruction; + } + if (CarCdrInternal (scratch, car, cdr)) + goto ScratchListExceptions; + switch (TagType (car->TAG)) + { + case TypeNIL: break; + case TypeList: + { + LispObj keyrep; + LispObj *key = &keyrep; + + if (CarInternal (car, key)) + InstructionException; + if ( ObjectEqP(*key, *sp) ) + { + SetObject (car); + NextInstruction; + } + break; + } + case TypeListInstance: + InstructionException; + default: + IllegalOperand; + } + *scratch = *cdr; + AllowSequenceBreaks; + } + + case DispatchEqImmediate: + SetPredicate(TypeFixnumP(sp->TAG) && (sp->DATA.s == cp->operand)); + NextInstruction; + case DispatchEqSP: AddressSPOperand (); goto ExecuteEq; + case DispatchEqFP: AddressFPOperand (); goto ExecuteEq; + case DispatchEqLP: AddressLPOperand (); goto ExecuteEq; + case DispatchEqPop: AddressPopOperand (); goto ExecuteEq; + ExecuteEq: + MARK(Eq); + SetPredicate ( ObjectEqP(*op2, *sp) ); + NextInstruction; + + case DispatchEqNoPopImmediate: + PushPredicate(TypeFixnumP(sp->TAG) && (sp->DATA.s == cp->operand)); + NextInstruction; + case DispatchEqNoPopSP: AddressSPOperand (); goto ExecuteEqNoPop; + case DispatchEqNoPopFP: AddressFPOperand (); goto ExecuteEqNoPop; + case DispatchEqNoPopLP: AddressLPOperand (); goto ExecuteEqNoPop; + case DispatchEqNoPopPop: AddressPopOperand (); goto ExecuteEqNoPop; + ExecuteEqNoPop: + MARK(EqNoPop); + PushPredicate ( ObjectEqP(*op2, *sp) ); + NextInstruction; + + case DispatchEqlImmediate: + SetPredicate(TypeFixnumP(sp->TAG) && (sp->DATA.s == cp->operand)); + NextInstruction; + case DispatchEqlSP: AddressSPOperand (); goto ExecuteEql; + case DispatchEqlFP: AddressFPOperand (); goto ExecuteEql; + case DispatchEqlLP: AddressLPOperand (); goto ExecuteEql; + case DispatchEqlPop: AddressPopOperand (); goto ExecuteEql; + ExecuteEql: + MARK(Eql); + /* + * (eql x y) + * x at TOS, y in op2. + */ + if (!TypeEqualP(sp->TAG, op2->TAG)) /* type mismatch? */ + { + SetNIL(); /* bash TOS to NIL (return value) */ + NextInstruction; /* next insn please */ + } + if (sp->DATA.u == op2->DATA.u) /* pointer portion match? */ + { + SetT(); /* bash TOS to T (return value) */ + NextInstruction; /* next insn please */ + } + switch (TagType(sp->TAG)) + { + case TypeDoubleFloat: + case TypeBignum: + case TypeBigRatio: + case TypeComplex: + case TypeSpareNumber: + /* + * Data types are equal but the data aren't. If the data + * types are extended numbers call the escape function, + * otherwise nil. + */ + InstructionException; + default: + SetNIL(); /* bash TOS to NIL (return value) */ + NextInstruction; + } + + case DispatchEqlNoPopImmediate: + PushPredicate(TypeFixnumP(sp->TAG) && (sp->DATA.s == cp->operand)); + NextInstruction; + case DispatchEqlNoPopSP: AddressSPOperand (); goto ExecuteEqlNoPop; + case DispatchEqlNoPopFP: AddressFPOperand (); goto ExecuteEqlNoPop; + case DispatchEqlNoPopLP: AddressLPOperand (); goto ExecuteEqlNoPop; + case DispatchEqlNoPopPop: AddressPopOperand (); goto ExecuteEqlNoPop; + ExecuteEqlNoPop: + MARK(EqlNoPop); + /* + * (eql x y) + * x at TOS, y in op2. + */ + if (!TypeEqualP(sp->TAG, op2->TAG)) /* type mismatch? */ + { + PushNIL(); /* push NIL (return value) */ + NextInstruction; /* next insn please */ + } + if (sp->DATA.u == op2->DATA.u) /* pointer portion match? */ + { + PushT(); /* push T (return value) */ + NextInstruction; /* next insn please */ + } + else + switch (TagType(sp->TAG)) + { + case TypeDoubleFloat: + case TypeBignum: + case TypeBigRatio: + case TypeComplex: + case TypeSpareNumber: + /* + * Data types are equal but the data aren't. If the data + * types are extended numbers call the escape function, + * otherwise nil. + */ + InstructionException; + default: + PushNIL(); /* push NIL (return value) */ + NextInstruction; + } + + case DispatchEqualNumberImmediate: + SetPredicate(TypeFixnumP(sp->TAG) && (sp->DATA.s == cp->operand)); + NextInstruction; + case DispatchEqualNumberSP: AddressSPOperand (); goto ExecuteEqualNumber; + case DispatchEqualNumberFP: AddressFPOperand (); goto ExecuteEqualNumber; + case DispatchEqualNumberLP: AddressLPOperand (); goto ExecuteEqualNumber; + case DispatchEqualNumberPop: AddressPopOperand (); goto ExecuteEqualNumber; + ExecuteEqualNumber: + MARK(EqualNumber); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + SetPredicate (op2->DATA.s == sp->DATA.s); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchEqualNumberNoPopImmediate: + PushPredicate(TypeFixnumP(sp->TAG) && (sp->DATA.s == cp->operand)); + NextInstruction; + case DispatchEqualNumberNoPopSP: AddressSPOperand (); goto ExecuteEqualNumberNoPop; + case DispatchEqualNumberNoPopFP: AddressFPOperand (); goto ExecuteEqualNumberNoPop; + case DispatchEqualNumberNoPopLP: AddressLPOperand (); goto ExecuteEqualNumberNoPop; + case DispatchEqualNumberNoPopPop: AddressPopOperand (); goto ExecuteEqualNumberNoPop; + ExecuteEqualNumberNoPop: + MARK(EqualNumberNoPop); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + PushPredicate (op2->DATA.s == sp->DATA.s); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchGreaterpImmediate: AddressImmediateOperand (); goto ExecuteGreaterp; + case DispatchGreaterpSP: AddressSPOperand (); goto ExecuteGreaterp; + case DispatchGreaterpFP: AddressFPOperand (); goto ExecuteGreaterp; + case DispatchGreaterpLP: AddressLPOperand (); goto ExecuteGreaterp; + case DispatchGreaterpPop: AddressPopOperand (); goto ExecuteGreaterp; + ExecuteGreaterp: + MARK(Greaterp); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + /* --- Need some assembly hacking to check for overflow */ + SetPredicate (sp->DATA.s > op2->DATA.s); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchGreaterpNoPopImmediate: AddressImmediateOperand (); goto ExecuteGreaterpNoPop; + case DispatchGreaterpNoPopSP: AddressSPOperand (); goto ExecuteGreaterpNoPop; + case DispatchGreaterpNoPopFP: AddressFPOperand (); goto ExecuteGreaterpNoPop; + case DispatchGreaterpNoPopLP: AddressLPOperand (); goto ExecuteGreaterpNoPop; + case DispatchGreaterpNoPopPop: AddressPopOperand (); goto ExecuteGreaterpNoPop; + ExecuteGreaterpNoPop: + MARK(GreaterpNoPop); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + /* --- Need some assembly hacking to check for overflow */ + PushPredicate (sp->DATA.s > op2->DATA.s); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLesspImmediate: AddressImmediateOperand (); goto ExecuteLessp; + case DispatchLesspSP: AddressSPOperand (); goto ExecuteLessp; + case DispatchLesspFP: AddressFPOperand (); goto ExecuteLessp; + case DispatchLesspLP: AddressLPOperand (); goto ExecuteLessp; + case DispatchLesspPop: AddressPopOperand (); goto ExecuteLessp; + ExecuteLessp: + MARK(Lessp); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + /* --- Need some assembly hacking to check for overflow */ + SetPredicate (sp->DATA.s < op2->DATA.s); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLesspNoPopImmediate: AddressImmediateOperand (); goto ExecuteLesspNoPop; + case DispatchLesspNoPopSP: AddressSPOperand (); goto ExecuteLesspNoPop; + case DispatchLesspNoPopFP: AddressFPOperand (); goto ExecuteLesspNoPop; + case DispatchLesspNoPopLP: AddressLPOperand (); goto ExecuteLesspNoPop; + case DispatchLesspNoPopPop: AddressPopOperand (); goto ExecuteLesspNoPop; + ExecuteLesspNoPop: + MARK(LesspNoPop); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + /* --- Need some assembly hacking to check for overflow */ + PushPredicate (sp->DATA.s < op2->DATA.s); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLogtestImmediate: AddressImmediateOperand (); goto ExecuteLogtest; + case DispatchLogtestSP: AddressSPOperand (); goto ExecuteLogtest; + case DispatchLogtestFP: AddressFPOperand (); goto ExecuteLogtest; + case DispatchLogtestLP: AddressLPOperand (); goto ExecuteLogtest; + case DispatchLogtestPop: AddressPopOperand (); goto ExecuteLogtest; + ExecuteLogtest: + MARK(Logtest); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + SetPredicate (sp->DATA.u & op2->DATA.u); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLogtestNoPopImmediate: AddressImmediateOperand (); goto ExecuteLogtestNoPop; + case DispatchLogtestNoPopSP: AddressSPOperand (); goto ExecuteLogtestNoPop; + case DispatchLogtestNoPopFP: AddressFPOperand (); goto ExecuteLogtestNoPop; + case DispatchLogtestNoPopLP: AddressLPOperand (); goto ExecuteLogtestNoPop; + case DispatchLogtestNoPopPop: AddressPopOperand (); goto ExecuteLogtestNoPop; + ExecuteLogtestNoPop: + MARK(LogtestNoPop); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + PushPredicate (sp->DATA.u & op2->DATA.u); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchTypeMember: + /* + * (typep-member x types) + * x is at TOS, types is 12-bit immediate arg + * for immediate arg, use cp, rather than op2 + */ + { + short n = (cp->operand >> 8) & 0x0F; + short mask = cp->operand & 0xFF; + short dtp = ((int) TagType(sp->TAG)) - (n * 4); + + SetPredicate((0 <= dtp) && + (dtp <= 7) && + ((1 << dtp) & mask)); + NextInstruction; + } + + case DispatchTypeMemberNoPop: + /* + * (typep-member x types) + * x is at TOS, types is 12-bit immediate arg + * for immediate arg, use cp, rather than op2 + */ + { + short n = (cp->operand >> 8) & 0x0F; + short mask = cp->operand & 0xFF; + short dtp = ((int) TagType(sp->TAG)) - (n * 4); + + PushPredicate((0 <= dtp) && + (dtp <= 7) && + ((1 << dtp) & mask)); + NextInstruction; + } + + case DispatchEndpImmediate: + IllegalOperand; + case DispatchEndpSP: AddressSPOperand (); goto ExecuteEndp; + case DispatchEndpFP: AddressFPOperand (); goto ExecuteEndp; + case DispatchEndpLP: AddressLPOperand (); goto ExecuteEndp; + case DispatchEndpPop: AddressPopOperand (); goto ExecuteEndp; + ExecuteEndp: + MARK(Endp); + switch (TagType(op2->TAG)) + { + case TypeList: case TypeListInstance: + PushNIL (); + NextInstruction; + case TypeNIL: + PushT (); + NextInstruction; + } + goto Op2ListExceptions; + + case DispatchPluspImmediate: + PushPredicate (cp->operand > 0); + NextInstruction; + case DispatchPluspSP: AddressSPOperand (); goto ExecutePlusp; + case DispatchPluspFP: AddressFPOperand (); goto ExecutePlusp; + case DispatchPluspLP: AddressLPOperand (); goto ExecutePlusp; + case DispatchPluspPop: AddressPopOperand (); goto ExecutePlusp; + ExecutePlusp: + MARK(Plusp); + if (TypeFixnumP (op2->TAG)) + { + PushPredicate (op2->DATA.s > 0); + NextInstruction; + } + goto Op2FixnumExceptions; + + case DispatchMinuspImmediate: + PushPredicate (cp->operand < 0); + NextInstruction; + case DispatchMinuspSP: AddressSPOperand (); goto ExecuteMinusp; + case DispatchMinuspFP: AddressFPOperand (); goto ExecuteMinusp; + case DispatchMinuspLP: AddressLPOperand (); goto ExecuteMinusp; + case DispatchMinuspPop: AddressPopOperand (); goto ExecuteMinusp; + ExecuteMinusp: + MARK(Minusp); + if (TypeFixnumP (op2->TAG)) + { + PushPredicate (op2->DATA.s < 0); + NextInstruction; + } + goto Op2FixnumExceptions; + + case DispatchZeropImmediate: + PushPredicate (cp->operand == 0); + NextInstruction; + case DispatchZeropSP: AddressSPOperand (); goto ExecuteZerop; + case DispatchZeropFP: AddressFPOperand (); goto ExecuteZerop; + case DispatchZeropLP: AddressLPOperand (); goto ExecuteZerop; + case DispatchZeropPop: AddressPopOperand (); goto ExecuteZerop; + ExecuteZerop: + MARK(Zerop); + if (TypeFixnumP (op2->TAG)) + { + PushPredicate (op2->DATA.s == 0); + NextInstruction; + } + goto Op2FixnumExceptions; + + /* --- maybe handle single-floats */ + case DispatchAddImmediate: AddressImmediateOperand (); goto ExecuteAdd; + case DispatchAddSP: AddressSPOperand (); goto ExecuteAdd; + case DispatchAddFP: AddressFPOperand (); goto ExecuteAdd; + case DispatchAddLP: AddressLPOperand (); goto ExecuteAdd; + case DispatchAddPop: AddressPopOperand (); goto ExecuteAdd; + ExecuteAdd: + MARK(Add); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG) && + ((i = sp->DATA.s + op2->DATA.s) >= sp->DATA.s) == (op2->DATA.s>=0)) + { + sp->DATA.s = i; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + /* --- maybe handle single-floats */ + case DispatchSubImmediate: AddressImmediateOperand (); goto ExecuteSub; + case DispatchSubSP: AddressSPOperand (); goto ExecuteSub; + case DispatchSubFP: AddressFPOperand (); goto ExecuteSub; + case DispatchSubLP: AddressLPOperand (); goto ExecuteSub; + case DispatchSubPop: AddressPopOperand (); goto ExecuteSub; + ExecuteSub: + MARK(Sub); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG) && + ((i = sp->DATA.s - op2->DATA.s) <= sp->DATA.s) == (op2->DATA.s >= 0)) + { + sp->DATA.s = i; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + /* --- maybe handle single-floats */ + case DispatchUnaryMinusImmediate: + PushFixnum (- cp->operand); + NextInstruction; + case DispatchUnaryMinusSP: AddressSPOperand (); goto ExecuteUnaryMinus; + case DispatchUnaryMinusFP: AddressFPOperand (); goto ExecuteUnaryMinus; + case DispatchUnaryMinusLP: AddressLPOperand (); goto ExecuteUnaryMinus; + case DispatchUnaryMinusPop: AddressPopOperand (); goto ExecuteUnaryMinus; + ExecuteUnaryMinus: + MARK(UnaryMinus); + if (TypeFixnumP (op2->TAG) && + op2->DATA.s != (-1 << 31)) + { + PushFixnum (-op2->DATA.s); + NextInstruction; + } + goto Op2FixnumExceptions; + + /* --- maybe handle single-floats */ + case DispatchIncrementSP: AddressSPOperand (); goto ExecuteIncrement; + case DispatchIncrementFP: AddressFPOperand (); goto ExecuteIncrement; + case DispatchIncrementLP: AddressLPOperand (); goto ExecuteIncrement; + ExecuteIncrement: + MARK(Increment); + if (TypeFixnumP (op2->TAG) && + op2->DATA.s != ~(-1 << 31)) + { + op2->DATA.s++; + NextInstruction; + } + goto Op2FixnumExceptions; + + /* --- maybe handle single-floats */ + case DispatchDecrementSP: AddressSPOperand (); goto ExecuteDecrement; + case DispatchDecrementFP: AddressFPOperand (); goto ExecuteDecrement; + case DispatchDecrementLP: AddressLPOperand (); goto ExecuteDecrement; + ExecuteDecrement: + MARK(Decrement); + if (TypeFixnumP (op2->TAG) && + op2->DATA.s != (-1 << 31)) + { + op2->DATA.s--; + NextInstruction; + } + goto Op2FixnumExceptions; + + /* --- This needs to detect overflows, and maybe handle single-floats */ + case DispatchMultiplyImmediate: AddressImmediateOperand (); goto ExecuteMultiply; + case DispatchMultiplySP: AddressSPOperand (); goto ExecuteMultiply; + case DispatchMultiplyFP: AddressFPOperand (); goto ExecuteMultiply; + case DispatchMultiplyLP: AddressLPOperand (); goto ExecuteMultiply; + case DispatchMultiplyPop: AddressPopOperand (); goto ExecuteMultiply; + ExecuteMultiply: + MARK(Multiply); + { + /* --- overflow-checking relies on 64-bit multiply */ + long value = (long) sp->DATA.s; + + if (BinaryTypeFixnumP (op2->TAG, sp->TAG) && + (value *= (long) op2->DATA.s) >= (int)(-1 << 31) && + value <= ~(int)(-1 << 31)) + { + sp->DATA.s = (int) value; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + } + + /* --- Maybe handle single-floats */ + case DispatchQuotientImmediate: AddressImmediateOperand (); goto ExecuteQuotient; + case DispatchQuotientSP: AddressSPOperand (); goto ExecuteQuotient; + case DispatchQuotientFP: AddressFPOperand (); goto ExecuteQuotient; + case DispatchQuotientLP: AddressLPOperand (); goto ExecuteQuotient; + case DispatchQuotientPop: AddressPopOperand (); goto ExecuteQuotient; + ExecuteQuotient: + MARK(Quotient); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + if (!op2->DATA.s) + IllegalOperand; + if (sp->DATA.s == (-1 << 31) && op2->DATA.s == -1) + InstructionException; + sp->DATA.s = sp->DATA.s / op2->DATA.s; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchFloorImmediate: AddressImmediateOperand (); goto ExecuteFloor; + case DispatchFloorSP: AddressSPOperand (); goto ExecuteFloor; + case DispatchFloorFP: AddressFPOperand (); goto ExecuteFloor; + case DispatchFloorLP: AddressLPOperand (); goto ExecuteFloor; + case DispatchFloorPop: AddressPopOperand (); goto ExecuteFloor; + ExecuteFloor: + MARK(Floor); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + int quotient, remainder; + + if (!op2->DATA.s) + IllegalOperand; + if (sp->DATA.s == (-1 << 31) && op2->DATA.s == -1) + InstructionException; + quotient = sp->DATA.s / op2->DATA.s; + remainder = sp->DATA.s - (op2->DATA.s * quotient); + if (remainder == 0) + { + SetFixnum (quotient); + PushFixnum (remainder); + } + else + { + if ((remainder >= 0) != (op2->DATA.s >= 0)) + { + quotient--; + remainder += op2->DATA.s; + } + SetFixnum (quotient); + PushFixnum (remainder); + } + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + + case DispatchCeilingImmediate: AddressImmediateOperand (); goto ExecuteCeiling; + case DispatchCeilingSP: AddressSPOperand (); goto ExecuteCeiling; + case DispatchCeilingFP: AddressFPOperand (); goto ExecuteCeiling; + case DispatchCeilingLP: AddressLPOperand (); goto ExecuteCeiling; + case DispatchCeilingPop: AddressPopOperand (); goto ExecuteCeiling; + ExecuteCeiling: + MARK(Ceiling); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + int quotient, remainder; + + if (!op2->DATA.s) + IllegalOperand; + if (sp->DATA.s == (-1 << 31) && op2->DATA.s == -1) + InstructionException; + quotient = sp->DATA.s / op2->DATA.s; + remainder = sp->DATA.s - (op2->DATA.s * quotient); + if (remainder == 0) + { + SetFixnum (quotient); + PushFixnum (remainder); + } + else + { + if ((remainder >= 0) == (op2->DATA.s >= 0)) + { + quotient++; + remainder -= op2->DATA.s; + } + SetFixnum (quotient); + PushFixnum (remainder); + } + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchTruncateImmediate: AddressImmediateOperand (); goto ExecuteTruncate; + case DispatchTruncateSP: AddressSPOperand (); goto ExecuteTruncate; + case DispatchTruncateFP: AddressFPOperand (); goto ExecuteTruncate; + case DispatchTruncateLP: AddressLPOperand (); goto ExecuteTruncate; + case DispatchTruncatePop: AddressPopOperand (); goto ExecuteTruncate; + ExecuteTruncate: + MARK(Truncate); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + int quotient, remainder; + + if (!op2->DATA.s) + IllegalOperand; + if (sp->DATA.s == (-1 << 31) && op2->DATA.s == -1) + InstructionException; + quotient = sp->DATA.s / op2->DATA.s; + remainder = sp->DATA.s - (op2->DATA.s * quotient); + SetFixnum (quotient); + PushFixnum (remainder); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchRoundImmediate: AddressImmediateOperand (); goto ExecuteRound; + case DispatchRoundSP: AddressSPOperand (); goto ExecuteRound; + case DispatchRoundFP: AddressFPOperand (); goto ExecuteRound; + case DispatchRoundLP: AddressLPOperand (); goto ExecuteRound; + case DispatchRoundPop: AddressPopOperand (); goto ExecuteRound; + ExecuteRound: + MARK(Round); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + int quotient, remainder, temp; + + if (!op2->DATA.s) + IllegalOperand; + if (sp->DATA.s == (-1 << 31) && op2->DATA.s == -1) + InstructionException; + quotient = sp->DATA.s / op2->DATA.s; + remainder = sp->DATA.s - (op2->DATA.s * quotient); + temp = op2->DATA.s - remainder - remainder; + if ((!temp)?(quotient&1):((op2->DATA.s>0)?(temp<0):(temp>0))) + { + SetFixnum (quotient + 1); + PushFixnum (remainder - op2->DATA.s); + } + else + { + SetFixnum (quotient); + PushFixnum (remainder); + } + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + /* --- maybe hack single-float */ + case DispatchRationalQuotientImmediate: AddressImmediateOperand (); goto ExecuteRationalQuotient; + case DispatchRationalQuotientSP: AddressSPOperand (); goto ExecuteRationalQuotient; + case DispatchRationalQuotientFP: AddressFPOperand (); goto ExecuteRationalQuotient; + case DispatchRationalQuotientLP: AddressLPOperand (); goto ExecuteRationalQuotient; + case DispatchRationalQuotientPop: AddressPopOperand (); goto ExecuteRationalQuotient; + ExecuteRationalQuotient: + MARK(RationalQuotient); + if (BinaryTypeFixnumP(sp->TAG, op2->TAG)) + { + int quotient, remainder; + + if (!op2->DATA.s) + IllegalOperand; + if (sp->DATA.s == (-1 << 31) && op2->DATA.s == -1) + InstructionException; + quotient = sp->DATA.s / op2->DATA.s; + remainder = sp->DATA.s - (op2->DATA.s * quotient); + if (!remainder) + { + sp->DATA.s = quotient; + NextInstruction; + } + } + goto BinaryTypeFixnumExceptions; + + /* --- Maybe handle single-floats */ + case DispatchMaxImmediate: AddressImmediateOperand (); goto ExecuteMax; + case DispatchMaxSP: AddressSPOperand (); goto ExecuteMax; + case DispatchMaxFP: AddressFPOperand (); goto ExecuteMax; + case DispatchMaxLP: AddressLPOperand (); goto ExecuteMax; + case DispatchMaxPop: AddressPopOperand (); goto ExecuteMax; + ExecuteMax: + MARK(Max); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + if (op2->DATA.s > sp->DATA.s) + SetObject (op2); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + /* --- Maybe handle single-floats */ + case DispatchMinImmediate: AddressImmediateOperand (); goto ExecuteMin; + case DispatchMinSP: AddressSPOperand (); goto ExecuteMin; + case DispatchMinFP: AddressFPOperand (); goto ExecuteMin; + case DispatchMinLP: AddressLPOperand (); goto ExecuteMin; + case DispatchMinPop: AddressPopOperand (); goto ExecuteMin; + ExecuteMin: + MARK(Min); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + if (op2->DATA.s < sp->DATA.s) + SetObject (op2); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLogandImmediate: AddressImmediateOperand (); goto ExecuteLogand; + case DispatchLogandSP: AddressSPOperand (); goto ExecuteLogand; + case DispatchLogandFP: AddressFPOperand (); goto ExecuteLogand; + case DispatchLogandLP: AddressLPOperand (); goto ExecuteLogand; + case DispatchLogandPop: AddressPopOperand (); goto ExecuteLogand; + ExecuteLogand: + MARK(Logand); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + sp->DATA.u &= op2->DATA.u; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLogiorImmediate: AddressImmediateOperand (); goto ExecuteLogior; + case DispatchLogiorSP: AddressSPOperand (); goto ExecuteLogior; + case DispatchLogiorFP: AddressFPOperand (); goto ExecuteLogior; + case DispatchLogiorLP: AddressLPOperand (); goto ExecuteLogior; + case DispatchLogiorPop: AddressPopOperand (); goto ExecuteLogior; + ExecuteLogior: + MARK(Logior); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + sp->DATA.u |= op2->DATA.u; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLogxorImmediate: AddressImmediateOperand (); goto ExecuteLogxor; + case DispatchLogxorSP: AddressSPOperand (); goto ExecuteLogxor; + case DispatchLogxorFP: AddressFPOperand (); goto ExecuteLogxor; + case DispatchLogxorLP: AddressLPOperand (); goto ExecuteLogxor; + case DispatchLogxorPop: AddressPopOperand (); goto ExecuteLogxor; + ExecuteLogxor: + MARK(Logxor); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + sp->DATA.u ^= op2->DATA.u; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchAshImmediate: AddressImmediateOperand (); goto ExecuteAsh; + case DispatchAshSP: AddressSPOperand (); goto ExecuteAsh; + case DispatchAshFP: AddressFPOperand (); goto ExecuteAsh; + case DispatchAshLP: AddressLPOperand (); goto ExecuteAsh; + case DispatchAshPop: AddressPopOperand (); goto ExecuteAsh; + ExecuteAsh: + MARK(Ash); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + int places = op2->DATA.s; + + if (places == 0 || sp->DATA.s == 0) + NextInstruction; + else if (places > 0) + { + if ((sp->DATA.s < 0) == ((i = sp->DATA.s << places) < 0) && + i != 0) + SetFixnum (i) + else + InstructionException; + } + else + SetFixnum (sp->DATA.s >> (- places)); + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchLshImmediate: AddressImmediateOperand (); goto ExecuteLsh; + case DispatchLshSP: AddressSPOperand (); goto ExecuteLsh; + case DispatchLshFP: AddressFPOperand (); goto ExecuteLsh; + case DispatchLshLP: AddressLPOperand (); goto ExecuteLsh; + case DispatchLshPop: AddressPopOperand (); goto ExecuteLsh; + ExecuteLsh: + MARK(Lsh); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + int places = op2->DATA.s; + + if (places == 0) + NextInstruction; + else if ((places > 31) || (places < -31)) + SetFixnum(0) + else if (places > 0) + SetFixnum (sp->DATA.u << places) + else + SetFixnum (sp->DATA.u >> (- places)); + NextInstruction; + } + else + IllegalOperand; + + case DispatchRotImmediate: AddressImmediateOperand (); goto ExecuteRot; + case DispatchRotSP: AddressSPOperand (); goto ExecuteRot; + case DispatchRotFP: AddressFPOperand (); goto ExecuteRot; + case DispatchRotLP: AddressLPOperand (); goto ExecuteRot; + case DispatchRotPop: AddressPopOperand (); goto ExecuteRot; + ExecuteRot: + MARK(Rot); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + int places = op2->DATA.s & 0x1F; + + if (places == 0) + NextInstruction; + sp->DATA.u = ((sp->DATA.u << places) | (sp->DATA.u >> (32 - places))); + NextInstruction; + } + else + IllegalOperand; + + case Dispatch32BitPlusImmediate: + if (TypeFixnumP (sp->TAG)) + { + sp->DATA.u += cp->operand; + NextInstruction; + } + else + IllegalOperand; + case Dispatch32BitPlusSP: AddressSPOperand (); goto Execute32BitPlus; + case Dispatch32BitPlusFP: AddressFPOperand (); goto Execute32BitPlus; + case Dispatch32BitPlusLP: AddressLPOperand (); goto Execute32BitPlus; + case Dispatch32BitPlusPop: AddressPopOperand (); goto Execute32BitPlus; + Execute32BitPlus: + MARK(32BitPlus); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + sp->DATA.u += op2->DATA.u; + NextInstruction; + } + else + IllegalOperand; + + case Dispatch32BitDifferenceImmediate: + if (TypeFixnumP (sp->TAG)) + { + sp->DATA.u -= cp->operand; + NextInstruction; + } + else + IllegalOperand; + case Dispatch32BitDifferenceSP: AddressSPOperand (); goto Execute32BitDifference; + case Dispatch32BitDifferenceFP: AddressFPOperand (); goto Execute32BitDifference; + case Dispatch32BitDifferenceLP: AddressLPOperand (); goto Execute32BitDifference; + case Dispatch32BitDifferencePop: AddressPopOperand (); goto Execute32BitDifference; + Execute32BitDifference: + MARK(32BitDifference); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + sp->DATA.u -= op2->DATA.u; + NextInstruction; + } + else + IllegalOperand; + + case DispatchMultiplyDoubleImmediate: AddressImmediateOperand (); goto ExecuteMultiplyDouble; + case DispatchMultiplyDoubleSP: AddressSPOperand (); goto ExecuteMultiplyDouble; + case DispatchMultiplyDoubleFP: AddressFPOperand (); goto ExecuteMultiplyDouble; + case DispatchMultiplyDoubleLP: AddressLPOperand (); goto ExecuteMultiplyDouble; + case DispatchMultiplyDoublePop: AddressPopOperand (); goto ExecuteMultiplyDouble; + ExecuteMultiplyDouble: + MARK(MultiplyDouble); + UnimplementedInstruction; + + case DispatchAddBignumStepImmediate: AddressImmediateOperand (); goto ExecuteAddBignumStep; + case DispatchAddBignumStepSP: AddressSPOperand (); goto ExecuteAddBignumStep; + case DispatchAddBignumStepFP: AddressFPOperand (); goto ExecuteAddBignumStep; + case DispatchAddBignumStepLP: AddressLPOperand (); goto ExecuteAddBignumStep; + case DispatchAddBignumStepPop: AddressPopOperand (); goto ExecuteAddBignumStep; + ExecuteAddBignumStep: + MARK(AddBignumStep); + UnimplementedInstruction; + + case DispatchSubBignumStepImmediate: AddressImmediateOperand (); goto ExecuteSubBignumStep; + case DispatchSubBignumStepSP: AddressSPOperand (); goto ExecuteSubBignumStep; + case DispatchSubBignumStepFP: AddressFPOperand (); goto ExecuteSubBignumStep; + case DispatchSubBignumStepLP: AddressLPOperand (); goto ExecuteSubBignumStep; + case DispatchSubBignumStepPop: AddressPopOperand (); goto ExecuteSubBignumStep; + ExecuteSubBignumStep: + MARK(SubBignumStep); + UnimplementedInstruction; + + case DispatchMultiplyBignumStepImmediate: AddressImmediateOperand (); goto ExecuteMultiplyBignumStep; + case DispatchMultiplyBignumStepSP: AddressSPOperand (); goto ExecuteMultiplyBignumStep; + case DispatchMultiplyBignumStepFP: AddressFPOperand (); goto ExecuteMultiplyBignumStep; + case DispatchMultiplyBignumStepLP: AddressLPOperand (); goto ExecuteMultiplyBignumStep; + case DispatchMultiplyBignumStepPop: AddressPopOperand (); goto ExecuteMultiplyBignumStep; + ExecuteMultiplyBignumStep: + MARK(MultiplyBignumStep); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + long value = (long)op2->DATA.u * (long)sp->DATA.u; + unsigned int low = value & 0xFFFFFFFFL, + high = (value >> 32) & 0xFFFFFFFFL; + SetFixnum (*(int*)&low); + PushFixnum (*(int*)&high); + NextInstruction; + } + IllegalOperand; + + case DispatchDivideBignumStepImmediate: AddressImmediateOperand (); goto ExecuteDivideBignumStep; + case DispatchDivideBignumStepSP: AddressSPOperand (); goto ExecuteDivideBignumStep; + case DispatchDivideBignumStepFP: AddressFPOperand (); goto ExecuteDivideBignumStep; + case DispatchDivideBignumStepLP: AddressLPOperand (); goto ExecuteDivideBignumStep; + case DispatchDivideBignumStepPop: AddressPopOperand (); goto ExecuteDivideBignumStep; + ExecuteDivideBignumStep: + MARK(DivideBignumStep); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG) && TypeFixnumP(sp[-1].TAG)) + { + long dividend = (sp->DATA.u << 32) | sp[-1].DATA.u; + long divisor = (long)op2->DATA.u; + long quotient = dividend / divisor; + + if (quotient>>32) IllegalOperand; + sp[-1].DATA.u = (unsigned int)quotient; + sp->DATA.u = (unsigned int)(dividend - (quotient * divisor)); + NextInstruction; + } + IllegalOperand; + + case DispatchLshcBignumStepImmediate: AddressImmediateOperand (); goto ExecuteLshcBignumStep; + case DispatchLshcBignumStepSP: AddressSPOperand (); goto ExecuteLshcBignumStep; + case DispatchLshcBignumStepFP: AddressFPOperand (); goto ExecuteLshcBignumStep; + case DispatchLshcBignumStepLP: AddressLPOperand (); goto ExecuteLshcBignumStep; + case DispatchLshcBignumStepPop: AddressPopOperand (); goto ExecuteLshcBignumStep; + ExecuteLshcBignumStep: + MARK(LshcBignumStep); + UnimplementedInstruction; + + case DispatchPushImmediate: + PushFixnum(cp->operand); + NextInstruction; + case DispatchPushPop: NextInstruction; + case DispatchPushSP: AddressSPOperand (); PushObject (op2); NextInstruction; + case DispatchPushLP: AddressLPOperand (); PushObject (op2); NextInstruction; + case DispatchPushFP: AddressFPOperand (); PushObject (op2); NextInstruction; + + case DispatchPopSP: AddressSPOperand (); PopObject (op2); NextInstruction; + case DispatchPopFP: AddressFPOperand (); PopObject (op2); NextInstruction; + case DispatchPopLP: AddressLPOperand (); PopObject (op2); NextInstruction; + + case DispatchMovemPop: NextInstruction; + case DispatchMovemSP: AddressSPOperand (); MoveObject (op2); NextInstruction; + case DispatchMovemFP: AddressFPOperand (); MoveObject (op2); NextInstruction; + case DispatchMovemLP: AddressLPOperand (); MoveObject (op2); NextInstruction; + + case DispatchPushNNils: + i = cp->operand; + PushNNilsInternal: + for (; i--; ) + { + PushNIL(); + /* --- Check for stack overflow */ + } + NextInstruction; + + case DispatchPushAddressSP: AddressSPOperand (); goto ExecutePushAddress; + case DispatchPushAddressFP: AddressFPOperand (); goto ExecutePushAddress; + case DispatchPushAddressLP: AddressLPOperand (); goto ExecutePushAddress; + ExecutePushAddress: + MARK(PushAddress); + PushConstant(TypeLocative, ps->StackCacheBase + (op2 - ps->StackCache)); + NextInstruction; + + case DispatchSetSpToAddressSP: sp = AddressSPOperand (); NextInstruction; + case DispatchSetSpToAddressFP: sp = AddressFPOperand (); NextInstruction; + case DispatchSetSpToAddressLP: sp = AddressLPOperand (); NextInstruction; + + case DispatchSetSpToAddressSaveTosSP: AddressSPOperand (); goto ExecuteSetSpToAddressSaveTos; + case DispatchSetSpToAddressSaveTosFP: AddressFPOperand (); goto ExecuteSetSpToAddressSaveTos; + case DispatchSetSpToAddressSaveTosLP: AddressLPOperand (); goto ExecuteSetSpToAddressSaveTos; + ExecuteSetSpToAddressSaveTos: + MARK(SetSpToAddressSaveTos); + *op2 = *sp; + sp = op2; + NextInstruction; + + case DispatchPushAddressSpRelativeImmediate: + PushConstant(TypeLocative, ps->StackCacheBase + (sp - ps->StackCache) - cp->operand - 1); + NextInstruction; + case DispatchPushAddressSpRelativeSP: AddressSPOperand (); goto ExecutePushAddressSpRelative; + case DispatchPushAddressSpRelativeFP: AddressFPOperand (); goto ExecutePushAddressSpRelative; + case DispatchPushAddressSpRelativeLP: AddressLPOperand (); goto ExecutePushAddressSpRelative; + case DispatchPushAddressSpRelativePop: AddressPopOperand (); goto ExecutePushAddressSpRelative; + ExecutePushAddressSpRelative: + MARK(PushAddressSpRelative); + if (TypeFixnumP(op2->TAG)) + { + /* Use restartsp, since calculation is supposed to be on sp before operand pop */ + PushConstant(TypeLocative, ps->StackCacheBase + (restartsp - ps->StackCache) - op2->DATA.u - 1); + NextInstruction; + } + else + IllegalOperand; + + case DispatchStackBltSP: AddressSPOperand (); goto ExecuteStackBlt; + case DispatchStackBltFP: AddressFPOperand (); goto ExecuteStackBlt; + case DispatchStackBltLP: AddressLPOperand (); goto ExecuteStackBlt; + case DispatchStackBltPop: AddressPopOperand (); goto ExecuteStackBlt; + ExecuteStackBlt: + MARK(StackBlt); + if (!TypeEqualP (op2->TAG, TypeLocative)) + goto Op2SpareExceptions; + op2 = &ps->StackCache[op2->DATA.u - ps->StackCacheBase]; + goto ExecuteStackBltAddress; + + case DispatchStackBltAddressSP: AddressSPOperand (); goto ExecuteStackBltAddress; + case DispatchStackBltAddressFP: AddressFPOperand (); goto ExecuteStackBltAddress; + case DispatchStackBltAddressLP: AddressLPOperand (); goto ExecuteStackBltAddress; + case DispatchStackBltAddressPop: AddressPopOperand (); goto ExecuteStackBltAddress; + ExecuteStackBltAddress: + MARK(StackBltAddress); + if (!TypeEqualP (sp->TAG, TypeLocative)) + goto SpSpareExceptions; + + i = sp - op2; + op1 = &ps->StackCache[sp[0].DATA.u - ps->StackCacheBase]; + + if ((op1 > op2) || (op1 < fp) || (op2 >= sp)) + IllegalOperand; + for ( ; i--; ) + *op1++ = *op2++; + sp = op1 - 1; + NextInstruction; + + case DispatchLdb: + /* + * (ldb (byte ss pp) x) + * x on stack, ppss encoded in 10 bit immediate arg + */ + if (TypeFixnumP (sp->TAG)) + { + /* Bottom 5 bits are pp, next 5 are ss - 1 */ + short pp = (32 - cp->operand) & 0x1F; + short ss = ((cp->operand >> 5) & 0x1F); + + /* replace x with result */ + SetFixnum ((sp->DATA.s >> pp) & ~(-2 << ss)); + NextInstruction; + } + goto SpFixnumExceptions; + + case DispatchCharLdb: + if (TypeEqualP (sp->TAG, TypeCharacter)) + { + short pp = (32 - cp->operand) & 0x1F; + short ss = ((cp->operand >> 5) & 0x1F); + + SetFixnum ((sp->DATA.s >> pp) & ~(-2 << ss)); + NextInstruction; + } + goto SpSpareExceptions; + + case DispatchPLdb: + /* + * (%p-ldb (byte ss pp) ptr) + * TOS -> ptr + * ppss encoded in 10bit immed arg + */ + if (TypeEqualP (sp->TAG, TypePhysicalAddress)) + InstructionException; + { + short pp = (32 - cp->operand) & 0x1F; + short ss = ((cp->operand >> 5) & 0x1F); + LispObj word_rep; + LispObj *word = &word_rep; + + /* don't care what type the word is */ + ReadVirtualMemory(sp->DATA.s, word); + + /* replace ptr with result */ + SetFixnum ((word->DATA.s >> pp) & ~(-2 << ss)); + NextInstruction; + } + + case DispatchPTagLdb: + if (TypeEqualP (sp->TAG, TypePhysicalAddress)) + InstructionException; + { + short pp = (32 - cp->operand) & 0x1F; + short ss = ((cp->operand >> 5) & 0x1F); + LispObj word_rep; + LispObj *word = &word_rep; + + /* don't care what type the word is */ + ReadVirtualMemory(sp->DATA.u, word); + + /* replace ptr with result loaded from tag*/ + SetFixnum ((word->TAG >> pp) & ~(-2 << ss)); + NextInstruction; + } + + case DispatchDpb: + /* + * (dpb newbyte (byte ss pp) x) + * TOS -> x + * SP|1 -> newbyte + * ppss encoded in 10 bit immediate arg + */ + if (BinaryTypeFixnumP(sp->TAG, sp[-1].TAG)) + { + /* Bottom 5 bits are pp, next 5 are ss - 1 */ + short pp = cp->operand & 0x1F; + short ss = ((cp->operand >> 5) & 0x1F); + unsigned int newbyte_mask; + + sp--; + newbyte_mask = ((unsigned int )~(-2 << ss)) << pp; + sp[0].DATA.u = (sp[1].DATA.u & (~newbyte_mask)) | + ((sp[0].DATA.u << pp) & newbyte_mask); + NextInstruction; + } + if (BinaryTypeNumericP(sp->TAG, sp[-1].TAG)) + InstructionException; + else + IllegalOperand; + + case DispatchCharDpb: + if (!TypeFixnumP(sp[-1].TAG)) + IllegalOperand; + if (TypeEqualP(sp->TAG, TypeCharacter)) + { + short pp = (cp->operand & 0x1F); + short ss = ((cp->operand >> 5) & 0x1F); + unsigned int newbyte_mask; + + sp--; + newbyte_mask = ((unsigned int )~(-2 << ss)) << pp; + sp[0].DATA.u = (sp[1].DATA.u & (~newbyte_mask)) | + ((sp[0].DATA.u << pp) & newbyte_mask); + sp[0].TAG = TypeCharacter; + NextInstruction; + } + goto SpSpareExceptions; + + case DispatchPDpb: + /* + * (%p-dpb newbyte (byte ss pp) ptr) + * TOS -> ptr + * SP|1 -> newbyte + * ppss encoded in 10 bit immediate arg + */ + if (!TypeFixnumP (sp[-1].TAG)) + IllegalOperand; + if (TypeEqualP (sp->TAG, TypePhysicalAddress)) + InstructionException; + { + short pp = (cp->operand & 0x1F); + short ss = ((cp->operand >> 5) & 0x1F); + unsigned int newbyte_mask; + + sp -= 2; + ReadVirtualMemory(sp[2].DATA.u, scratch); + newbyte_mask = ((unsigned int )~(-2 << ss)) << pp; + scratch->DATA.u = (scratch->DATA.u & (~newbyte_mask)) | + ((sp[1].DATA.u << pp) & newbyte_mask); + WriteVirtualMemory(sp[2].DATA.u, scratch); + /* returns no values */ + NextInstruction; + } + + case DispatchPTagDpb: + if (!TypeFixnumP (sp[-1].TAG)) + IllegalOperand; + if (TypeEqualP (sp->TAG, TypePhysicalAddress)) + InstructionException; + { + short pp = (cp->operand & 0x1F); + short ss = ((cp->operand >> 5) & 0x1F); + unsigned int newbyte_mask; + + sp -= 2; + ReadVirtualMemory(sp[2].DATA.u, scratch); + newbyte_mask = ((unsigned int )~(-2 << ss)) << pp; + scratch->TAG = (scratch->TAG & (~newbyte_mask)) | + ((sp[1].DATA.u << pp) & newbyte_mask); + WriteVirtualMemory(sp[2].DATA.u, scratch); + /* returns no values */ + NextInstruction; + } + + case DispatchAref1Immediate: AddressImmediateOperand(); goto ExecuteAref1; + case DispatchAref1SP: AddressSPOperand (); goto ExecuteAref1; + case DispatchAref1FP: AddressFPOperand (); goto ExecuteAref1; + case DispatchAref1LP: AddressLPOperand (); goto ExecuteAref1; + case DispatchAref1Pop: AddressPopOperand (); goto ExecuteAref1; + ExecuteAref1: + MARK(Aref1); + if (!TypeFixnumP (op2->TAG)) IllegalOperand; + if (TypeArrayP(sp->TAG)) + { + LispObj header; + Integer vma; + + vma = MemoryReadHeader (sp->DATA.u, &header); + if (header.TAG != ArrayHeaderTag) + IllegalOperand; + if (ArrayLongPrefixP(header.DATA.u)) + InstructionException; + if (op2->DATA.u >= ArrayShortLength(header.DATA.u)) + IllegalOperand; + Aref1Internal(vma + 1, ArrayBytePacking(header.DATA.u), 0, + ArrayElementType(header.DATA.u), op2->DATA.u, sp); + NextInstruction; + } + goto SpArrayExceptions; + + case DispatchAset1Immediate: AddressImmediateOperand(); goto ExecuteAset1; + case DispatchAset1SP: AddressSPOperand (); goto ExecuteAset1; + case DispatchAset1FP: AddressFPOperand (); goto ExecuteAset1; + case DispatchAset1LP: AddressLPOperand (); goto ExecuteAset1; + case DispatchAset1Pop: AddressPopOperand (); goto ExecuteAset1; + ExecuteAset1: + MARK(Aset1); + if (!TypeFixnumP (op2->TAG)) IllegalOperand; + if (TypeArrayP(sp->TAG)) + { + LispObj header; + Integer vma; + + vma = MemoryReadHeader (sp->DATA.u, &header); + if (header.TAG != ArrayHeaderTag) + IllegalOperand; + if (ArrayLongPrefixP(header.DATA.u)) + InstructionException; + if (op2->DATA.u >= ArrayShortLength(header.DATA.u)) + IllegalOperand; + Aset1Internal(vma + 1, ArrayBytePacking(header.DATA.u), 0, + ArrayElementType(header.DATA.u), op2->DATA.u, &sp[-1]); + sp -= 2; + NextInstruction; + } + goto SpArrayExceptions; + + case DispatchAloc1Immediate: AddressImmediateOperand (); goto ExecuteAloc1; + case DispatchAloc1SP: AddressSPOperand (); goto ExecuteAloc1; + case DispatchAloc1FP: AddressFPOperand (); goto ExecuteAloc1; + case DispatchAloc1LP: AddressLPOperand (); goto ExecuteAloc1; + case DispatchAloc1Pop: AddressPopOperand (); goto ExecuteAloc1; + ExecuteAloc1: + MARK(Aloc1); + if (!TypeFixnumP (op2->TAG)) IllegalOperand; + if (TypeArrayP(sp->TAG)) + { + LispObj header; + Integer vma; + + vma = MemoryReadHeader (sp->DATA.u, &header); + if (header.TAG != ArrayHeaderTag) + IllegalOperand; + if (ArrayLongPrefixP(header.DATA.u)) + InstructionException; + if (op2->DATA.u >= ArrayShortLength(header.DATA.u) || + ArrayElementType(header.DATA.u) != ArrayElementTypeObject) + IllegalOperand; + + SetConstant(TypeLocative, vma + 1 + op2->DATA.u); + NextInstruction; + } + goto SpArrayExceptions; + + case DispatchSetup1dArrayImmediate: + UnimplementedInstruction; + case DispatchSetup1dArraySP: AddressSPOperand (); goto ExecuteSetup1dArray; + case DispatchSetup1dArrayFP: AddressFPOperand (); goto ExecuteSetup1dArray; + case DispatchSetup1dArrayLP: AddressLPOperand (); goto ExecuteSetup1dArray; + case DispatchSetup1dArrayPop: AddressPopOperand (); goto ExecuteSetup1dArray; + + case DispatchSetupForce1dArrayImmediate: + UnimplementedInstruction; + /* Believe it or not, setup-force-1d-array really wants do exactly + * the same thing as setup-1d-array. They both trap for interesting + * arrays, and the trap-handlers do subtly different things, based on + * instruction opcode. + */ + case DispatchSetupForce1dArraySP: AddressSPOperand (); goto ExecuteSetupForce1dArray; + case DispatchSetupForce1dArrayFP: AddressFPOperand (); goto ExecuteSetupForce1dArray; + case DispatchSetupForce1dArrayLP: AddressLPOperand (); goto ExecuteSetupForce1dArray; + case DispatchSetupForce1dArrayPop: AddressPopOperand (); goto ExecuteSetupForce1dArray; + ExecuteSetupForce1dArray: + MARK(SetupForce1dArray); + ExecuteSetup1dArray: + /* + * (setup-1d-array array) + * One arg, in op2 + * leaves 4 values on stack; array, control-word, locative, limit + */ + if (TypeArrayP(op2->TAG)) + { + LispObj header; + Integer vma; + + vma = MemoryReadHeader(op2->DATA.u, &header); + if (header.TAG != ArrayHeaderTag) + IllegalOperand; + if (ArrayLongPrefixP(header.DATA.u)) + InstructionException; + PushConstant(TagType(op2->TAG), vma); + PushFixnum(SetArrayRegisterEventCount(ps->ArrayEventCount, header.DATA.u)); + PushConstant(TypeLocative, vma + 1); + PushFixnum(ArrayShortLength(header.DATA.u)); + NextInstruction; + } + goto Op2ArrayExceptions; + + case DispatchFastAref1SP: AddressSPOperand (); goto ExecuteFastAref1; + case DispatchFastAref1FP: AddressFPOperand (); goto ExecuteFastAref1; + case DispatchFastAref1LP: AddressLPOperand (); goto ExecuteFastAref1; + ExecuteFastAref1: + MARK(FastAref1); + /* + * (fast-aref-1 index array-register-control-word) + * TOS -> index + * op2 -> array-register-control-word + * a-r-c-w is word 1 of a 4-word array-register, on + * the stack someplace. Need to do by-hand addressing to get + * hold of the other pieces. + */ + if (!TypeFixnumP(sp->TAG)) IllegalOperand; + /* --- Check array-register format? */ + { + Integer control = op2[0].DATA.u; + Integer vma = op2[1].DATA.u; + int length = op2[2].DATA.s; + + if (sp->DATA.u >= length) IllegalOperand; + if (ArrayRegisterEventCount(control) != ps->ArrayEventCount) + { + RecomputeArrayRegister(op2, ps->ArrayEventCount); + goto ExecuteFastAref1; + } + Aref1Internal(vma, ArrayBytePacking(control), ArrayRegisterByteOffset(control), + ArrayElementType(control), sp->DATA.s, sp); + NextInstruction; + } + + case DispatchFastAset1SP: AddressSPOperand (); goto ExecuteFastAset1; + case DispatchFastAset1FP: AddressFPOperand (); goto ExecuteFastAset1; + case DispatchFastAset1LP: AddressLPOperand (); goto ExecuteFastAset1; + ExecuteFastAset1: + MARK(FastAset1); + /* + * (fast-aset-1 value index array-register-control-word) + * TOS -> index + * sp|1 -> value + * op2 -> array-register-control-word + * a-r-c-w is word 1 of a 4-word array-register, on + * the stack someplace. Need to do by-hand addressing to get + * hold of the other pieces. + */ + if (!TypeFixnumP(sp->TAG)) IllegalOperand; + /* --- Check array-register format? */ + { + Integer control = op2[0].DATA.u; + Integer vma = op2[1].DATA.u; + int length = op2[2].DATA.s; + + if (sp->DATA.u >= length) IllegalOperand; + if (ArrayRegisterEventCount(control) != ps->ArrayEventCount) + { + RecomputeArrayRegister(op2, ps->ArrayEventCount); + goto ExecuteFastAset1; + } + Aset1Internal(vma, ArrayBytePacking(control), ArrayRegisterByteOffset(control), + ArrayElementType(control), sp->DATA.s, &sp[-1]); + sp -= 2; + NextInstruction; + } + + case DispatchArrayLeaderImmediate: AddressImmediateOperand (); goto ExecuteArrayLeader; + case DispatchArrayLeaderSP: AddressSPOperand (); goto ExecuteArrayLeader; + case DispatchArrayLeaderFP: AddressFPOperand (); goto ExecuteArrayLeader; + case DispatchArrayLeaderLP: AddressLPOperand (); goto ExecuteArrayLeader; + case DispatchArrayLeaderPop: AddressPopOperand (); goto ExecuteArrayLeader; + ExecuteArrayLeader: + MARK(ArrayLeader); + /* + * (array-leader array index) + * TOS -> array + * op2 -> index + */ + if (!TypeFixnumP(op2->TAG)) IllegalOperand; + if (TypeArrayP(sp->TAG)) + { + LispObj header, q; + Integer vma; + + vma = MemoryReadHeader (sp[0].DATA.u, &header); + if (header.TAG != ArrayHeaderTag || + op2->DATA.u >= ArrayLeaderLength(header.DATA.u)) + IllegalOperand; + + MemoryReadData(vma - (1 + op2->DATA.u), &q); + SetObject(&q); + NextInstruction; + } + goto SpArrayExceptions; + + case DispatchStoreArrayLeaderImmediate: AddressImmediateOperand(); goto ExecuteStoreArrayLeader; + case DispatchStoreArrayLeaderSP: AddressSPOperand (); goto ExecuteStoreArrayLeader; + case DispatchStoreArrayLeaderFP: AddressFPOperand (); goto ExecuteStoreArrayLeader; + case DispatchStoreArrayLeaderLP: AddressLPOperand (); goto ExecuteStoreArrayLeader; + case DispatchStoreArrayLeaderPop: AddressPopOperand (); goto ExecuteStoreArrayLeader; + ExecuteStoreArrayLeader: + MARK(StoreArrayLeader); + /* + * (store-array-leader value array index) + * TOS -> array + * SP|1 -> value + * op2 -> index + */ + if (!TypeFixnumP(op2->TAG)) IllegalOperand; + if (TypeArrayP(sp->TAG)) + { + LispObj header; + Integer vma; + + vma = MemoryReadHeader (sp[0].DATA.u, &header); + if (header.TAG != ArrayHeaderTag || + op2->DATA.u >= ArrayLeaderLength(header.DATA.u)) + IllegalOperand; + + StoreContents(vma - (1 + op2->DATA.u), &sp[-1], CycleDataWrite); + sp -= 2; + NextInstruction; + } + goto SpArrayExceptions; + + case DispatchAlocLeaderImmediate: AddressImmediateOperand (); goto ExecuteAlocLeader; + case DispatchAlocLeaderSP: AddressSPOperand (); goto ExecuteAlocLeader; + case DispatchAlocLeaderFP: AddressFPOperand (); goto ExecuteAlocLeader; + case DispatchAlocLeaderLP: AddressLPOperand (); goto ExecuteAlocLeader; + case DispatchAlocLeaderPop: AddressPopOperand (); goto ExecuteAlocLeader; + ExecuteAlocLeader: + MARK(AlocLeader); + /* + * (aloc-leader array index) + * TOS -> array + * op2 -> index + */ + if (!TypeFixnumP(op2->TAG)) IllegalOperand; + if (TypeArrayP(sp->TAG)) + { + LispObj header; + Integer vma; + + vma = MemoryReadHeader (sp[0].DATA.u, &header); + if (header.TAG != ArrayHeaderTag || + op2->DATA.u >= ArrayLeaderLength(header.DATA.u)) + IllegalOperand; + + SetConstant(TypeLocative, vma - (1 + op2->DATA.u)); + NextInstruction; + } + goto SpArrayExceptions; + + case DispatchBranchTrue: + if (!BranchConditionTrue) DontTakeBranch (1); TakeBranch (1); + case DispatchBranchTrueElseExtraPop: + if (!BranchConditionTrue) DontTakeBranch (2); TakeBranch (1); + case DispatchBranchTrueAndExtraPop: + if (!BranchConditionTrue) DontTakeBranch (1); TakeBranch (2); + case DispatchBranchTrueExtraPop: + if (!BranchConditionTrue) DontTakeBranch (2); TakeBranch (2); + case DispatchBranchTrueNoPop: + if (!BranchConditionTrue) DontTakeBranch (0); TakeBranch (0); + case DispatchBranchTrueAndNoPop: + if (!BranchConditionTrue) DontTakeBranch (1); TakeBranch (0); + case DispatchBranchTrueElseNoPop: + if (!BranchConditionTrue) DontTakeBranch (0); TakeBranch (1); + case DispatchBranchTrueAndNoPopElseNoPopExtraPop: + if (!BranchConditionTrue) DontTakeBranch (1); TakeBranch (1); + + case DispatchBranchFalse: + if (!BranchConditionFalse) DontTakeBranch (1); TakeBranch (1); + case DispatchBranchFalseElseExtraPop: + if (!BranchConditionFalse) DontTakeBranch (2); TakeBranch (1); + case DispatchBranchFalseAndExtraPop: + if (!BranchConditionFalse) DontTakeBranch (1); TakeBranch (2); + case DispatchBranchFalseExtraPop: + if (!BranchConditionFalse) DontTakeBranch (2); TakeBranch (2); + case DispatchBranchFalseNoPop: + if (!BranchConditionFalse) DontTakeBranch (0); TakeBranch (0); + case DispatchBranchFalseAndNoPop: + if (!BranchConditionFalse) DontTakeBranch (1); TakeBranch (0); + case DispatchBranchFalseElseNoPop: + if (!BranchConditionFalse) DontTakeBranch (0); TakeBranch (1); + case DispatchBranchFalseAndNoPopElseNoPopExtraPop: + if (!BranchConditionFalse) DontTakeBranch (1); TakeBranch (1); + + case DispatchLoopDecrementTos: + if (TypeFixnumP (sp->TAG) && + (i = sp->DATA.s - 1) < sp->DATA.s) + { + sp->TAG = TypeFixnum; /* clear counter cdr-code */ + if ((sp->DATA.s = i) > 0) TakeBranch(0); DontTakeBranch(0); + } + if (TypeNumericP (sp->TAG)) + FollowPCInstructionException: + { + /* Exceptions see followed PC as continuation */ + LispObj next_pc = pc; + + IncrementPC(&next_pc, cp->operand); + DecacheRegisters(); + if(!TakeInstructionException(cp->instruction, op2, &next_pc)) + goto halt; + EncacheRegisters(); + goto InstructionCacheLookup; + } + else + IllegalOperand; + + case DispatchLoopIncrementTosLessThan: + op2 = sp - 1; + if (BinaryTypeFixnumP (op2->TAG, sp->TAG) && + (i = sp->DATA.s + 1) > sp->DATA.s) + { + sp->TAG = TypeFixnum; /* clear counter cdr-code */ + if ((sp->DATA.s = i) <= op2->DATA.s) TakeBranch(0); DontTakeBranch(0); + } + if BinaryTypeNumericP (op2->TAG, sp->TAG) + /* Exceptions see followed PC */ + goto FollowPCInstructionException; + else + IllegalOperand; + + case DispatchBlock1Read: AddressBAR (1); goto ExecuteBlockRead; + case DispatchBlock2Read: AddressBAR (2); goto ExecuteBlockRead; + case DispatchBlock3Read: AddressBAR (3); goto ExecuteBlockRead; + ExecuteBlockRead: + MARK(BlockRead); + { + int cycle = (cp->operand & 01700) >> 6; + int fixnum_only = (cp->operand & 040); + int cdr_next = (cp->operand & 020); + Integer vma = bar->address.DATA.u; + + MemoryRead (vma,&sp[1],cycle); + if (fixnum_only && !TypeFixnumP(sp[1].TAG)) + InstructionException; + sp++; + if (cdr_next) + sp->TAG = TagType(sp->TAG); + if (!(cp->operand & 0x004)) + bar->address.DATA.u++; + NextInstruction; + } + + case DispatchBlock1ReadShift: AddressBAR (1); goto ExecuteBlockReadShift; + case DispatchBlock2ReadShift: AddressBAR (2); goto ExecuteBlockReadShift; + case DispatchBlock3ReadShift: AddressBAR (3); goto ExecuteBlockReadShift; + ExecuteBlockReadShift: + MARK(BlockReadShift); + UnimplementedInstruction; + + case DispatchBlock1ReadTest: AddressBAR (1); goto ExecuteBlockReadTest; + case DispatchBlock2ReadTest: AddressBAR (2); goto ExecuteBlockReadTest; + case DispatchBlock3ReadTest: AddressBAR (3); goto ExecuteBlockReadTest; + ExecuteBlockReadTest: + MARK(BlockReadTest); + UnimplementedInstruction; + + case DispatchBlock1ReadAluSP: + AddressSPOperand (); AddressBAR (1); goto ExecuteBlockReadAlu; + case DispatchBlock1ReadAluFP: + AddressFPOperand (); AddressBAR (1); goto ExecuteBlockReadAlu; + case DispatchBlock1ReadAluLP: + AddressLPOperand (); AddressBAR (1); goto ExecuteBlockReadAlu; + case DispatchBlock2ReadAluSP: + AddressSPOperand (); AddressBAR (2); goto ExecuteBlockReadAlu; + case DispatchBlock2ReadAluFP: + AddressFPOperand (); AddressBAR (2); goto ExecuteBlockReadAlu; + case DispatchBlock2ReadAluLP: + AddressLPOperand (); AddressBAR (2); goto ExecuteBlockReadAlu; + case DispatchBlock3ReadAluSP: + AddressSPOperand (); AddressBAR (3); goto ExecuteBlockReadAlu; + case DispatchBlock3ReadAluFP: + AddressFPOperand (); AddressBAR (3); goto ExecuteBlockReadAlu; + case DispatchBlock3ReadAluLP: + AddressLPOperand (); AddressBAR (3); goto ExecuteBlockReadAlu; + ExecuteBlockReadAlu: + MARK(BlockReadAlu); + UnimplementedInstruction; + + case DispatchBlock1WriteImmediate: AddressImmediateOperand (); AddressBAR (1); goto ExecuteBlockWrite; + case DispatchBlock2WriteImmediate: AddressImmediateOperand (); AddressBAR (2); goto ExecuteBlockWrite; + case DispatchBlock3WriteImmediate: AddressImmediateOperand (); AddressBAR (3); goto ExecuteBlockWrite; + case DispatchBlock1WriteSP: AddressSPOperand (); AddressBAR (1); goto ExecuteBlockWrite; + case DispatchBlock1WriteFP: AddressFPOperand (); AddressBAR (1); goto ExecuteBlockWrite; + case DispatchBlock1WriteLP: AddressLPOperand (); AddressBAR (1); goto ExecuteBlockWrite; + case DispatchBlock1WritePop: AddressPopOperand (); AddressBAR (1); goto ExecuteBlockWrite; + case DispatchBlock2WriteSP: AddressSPOperand (); AddressBAR (2); goto ExecuteBlockWrite; + case DispatchBlock2WriteFP: AddressFPOperand (); AddressBAR (2); goto ExecuteBlockWrite; + case DispatchBlock2WriteLP: AddressLPOperand (); AddressBAR (2); goto ExecuteBlockWrite; + case DispatchBlock2WritePop: AddressPopOperand (); AddressBAR (2); goto ExecuteBlockWrite; + case DispatchBlock3WriteSP: AddressSPOperand (); AddressBAR (3); goto ExecuteBlockWrite; + case DispatchBlock3WriteFP: AddressFPOperand (); AddressBAR (3); goto ExecuteBlockWrite; + case DispatchBlock3WriteLP: AddressLPOperand (); AddressBAR (3); goto ExecuteBlockWrite; + case DispatchBlock3WritePop: AddressPopOperand (); AddressBAR (3); goto ExecuteBlockWrite; + ExecuteBlockWrite: + MARK(BlockWrite); + WriteVirtualMemory(bar->address.DATA.u, op2); + bar->address.DATA.u++; + NextInstruction; + + case DispatchStartCallSP: AddressSPOperand (); goto ExecuteStartCall; + case DispatchStartCallFP: AddressFPOperand (); goto ExecuteStartCall; + case DispatchStartCallLP: AddressLPOperand (); goto ExecuteStartCall; + case DispatchStartCallPop: AddressPopOperand (); goto ExecuteStartCall; + ExecuteStartCall: + MARK(StartCall); + *scratch = *op2; + goto StartCallDispatch; + + case DispatchCallCompiledEven: + case DispatchCallCompiledEvenPrefetch: + PushContinuation (ps->continuation); + PushControl (ps->control); + ps->control = ((ps->control | ControlCallStarted) & (~ControlExtraArgument)); + ps->continuation.TAG = TypeEvenPC; + ps->continuation.DATA.u = cp->operand; + NextInstruction; + + case DispatchCallCompiledOdd: + case DispatchCallCompiledOddPrefetch: + PushContinuation (ps->continuation); + PushControl (ps->control); + ps->control = ((ps->control | ControlCallStarted) & (~ControlExtraArgument)); + ps->continuation.TAG = TypeOddPC; + ps->continuation.DATA.u = cp->operand; + NextInstruction; + + case DispatchCallGeneric: + case DispatchCallGenericPrefetch: + scratch->TAG = TypeGenericFunction; + scratch->DATA.u = cp->operand; + goto StartCallDispatch; + + case DispatchCallIndirect: + case DispatchCallIndirectPrefetch: + MemoryReadData (cp->operand, scratch); + goto StartCallDispatch; + + StartCallDispatch: + switch (TagType(scratch->TAG)) + { + case TypeCompiledFunction: + PushContinuation (ps->continuation); + PushControl (ps->control); + ps->control = ((ps->control | ControlCallStarted) & (~ControlExtraArgument)); + ps->continuation.TAG = TypeEvenPC; + ps->continuation.DATA.u = scratch->DATA.u; + NextInstruction; + + case TypeLexicalClosure: + { + LispObj environment, function; + + MemoryReadData (scratch->DATA.u, &environment); + MemoryReadData (scratch->DATA.u + 1, &function); + if (TypeEqualP (function.TAG, TypeCompiledFunction)) + { + PushContinuation (ps->continuation); + PushControl (ps->control); + PushObject(&environment); + ps->control = (ps->control | ControlCallStarted | ControlExtraArgument); + ps->continuation.TAG = TypeEvenPC; + ps->continuation.DATA.u = function.DATA.u; + NextInstruction; + } + } + + default: + { + LispObj InterpreterFunction; + + MemoryReadData(TrapVectorBase + InterpreterFunctionVector + TagType(scratch->TAG), + &InterpreterFunction); + switch (TagType(InterpreterFunction.TAG)) + { + case TypeEvenPC: case TypeOddPC: + PushContinuation (ps->continuation); + PushControl (ps->control); + PushObject(scratch); + ps->control = ((ps->control | ControlCallStarted) | ControlExtraArgument); + ps->continuation = InterpreterFunction; + NextInstruction; + } + IllegalOperand; + } + } + + case DispatchFinishCallN: + op1 = sp - ldb(8,0,cp->operand) - ReadControlExtraArgument (ps->control); + op2 = sp + 1; + ps->control = + /* First clear a bunch of fields */ + (ps->control & ~(ControlApply | + ControlCleanupBits | + ControlExtraArgument | + ControlCallStarted | + ControlArgumentSize | + ControlValueDisposition | + ControlCallerFrameSize)) + /* Set CR.ArgumentSize */ + | (op2 - op1) + /* Move value disposition from operand<9:8> to control<19:18> */ + | ((cp->operand & 01400) << 10) + /* Set CR.CallerFrameSize */ + | ((op1 - fp) << 9); + goto FinishCallInternal; + + case DispatchFinishCallNApply: + op1 = sp - ldb(8,0,cp->operand) - ReadControlExtraArgument (ps->control); + op2 = sp + 1 - 1; + ps->control = + /* First clear a bunch of fields */ + (ps->control & ~(ControlCleanupBits | + ControlExtraArgument | + ControlCallStarted | + ControlArgumentSize | + ControlValueDisposition | + ControlCallerFrameSize)) + | ControlApply + /* Set CR.ArgumentSize */ + | (op2 - op1) + /* Move value disposition from operand<9:8> to control<19:18> */ + | ((cp->operand & 01400) << 10) + /* Set CR.CallerFrameSize */ + | ((op1 - fp) << 9); + goto FinishCallInternal; + + case DispatchFinishCallTos: + PopObject (scratch); + op1 = sp - (scratch->DATA.s + 1) - ReadControlExtraArgument (ps->control); + op2 = sp + 1; + ps->control = + /* First clear a bunch of fields */ + (ps->control & ~(ControlApply | + ControlCleanupBits | + ControlExtraArgument | + ControlCallStarted | + ControlArgumentSize | + ControlValueDisposition | + ControlCallerFrameSize)) + /* Set CR.ArgumentSize */ + | (op2 - op1) + /* Move value disposition from operand<9:8> to control<19:18> */ + | ((cp->operand & 01400) << 10) + /* Set CR.CallerFrameSize */ + | ((op1 - fp) << 9); + goto FinishCallInternal; + + case DispatchFinishCallTosApply: + PopObject (scratch); + op1 = sp - (scratch->DATA.u + 1) - ReadControlExtraArgument (ps->control); + op2 = sp + 1 - 1; + ps->control = + /* First clear a bunch of fields */ + (ps->control & ~(ControlCleanupBits | + ControlExtraArgument | + ControlCallStarted | + ControlArgumentSize | + ControlValueDisposition | + ControlCallerFrameSize)) + | ControlApply + /* Set CR.ArgumentSize */ + | (op2 - op1) + /* Move value disposition from operand<9:8> to control<19:18> */ + | ((cp->operand & 01400) << 10) + /* Set CR.CallerFrameSize */ + | ((op1 - fp) << 9); + goto FinishCallInternal; + + FinishCallInternal: + /* --- debug + if ((op1 - fp) > 128 || (op2 - op1) > 128) + InstructionException; + */ + + /* New FP in op1, new LP in op2 */ + fp = op1; + lp = op2; + pc = ps->continuation; + ps->continuation = cp->next_pc; + if (fp > ps->StackCacheLimit) + { + DecacheRegisters(); + StackCacheScrollUp(); + EncacheRegisters(); + } + goto InstructionCacheLookup; + + case DispatchEntryRestAccepted: + RetryRestAccepted: + { + register int supplied; + register int minimum = ldb(8,0,cp->operand); + register int maximum = ldb(8,8,cp->operand); + + /* --- debug + if ((fp[0].TAG&-2) != ((TypeEvenPC&-2)|(3<<6))) + InstructionException; + */ + + supplied = ReadControlArgumentSize(ps->control); + if (ReadControlApply (ps->control)) + { + if (TypeEqualP (sp->TAG, TypeNIL)) + { + sp--; + WriteControlApply (ps->control, 0); + goto applynil; + } + if (supplied > maximum) + { + sp[0].TAG = SetTagCdr(sp[0].TAG, CdrNil); + sp[-1].TAG = SetTagCdr(sp[-1].TAG, CdrNormal); + PushConstant (TypeList, ps->StackCacheBase + (fp - ps->StackCache) + maximum); + lp++; + WriteControlArgumentSize(ps->control, 1 + supplied); + pc.DATA.u += (maximum - minimum + 2); + } + else if (supplied < maximum) + switch (TagType(sp[0].TAG)) + { + case TypeNIL: + sp--; + WriteControlApply(ps->control, 0); + goto applynil; + case TypeList: + i = maximum - supplied; + if ((sp[0].DATA.u - ps->StackCacheBase) < StackCacheSize * PageSize) + { + DecacheRegisters(); + i = PullApplyArgsQuickly(i); + EncacheRegisters(); + } + if (i) + goto PullApplyArgsTrap; + else + goto RetryRestAccepted; + /* Always trap to handler, not IllegalOperand */ + default: + i = maximum - supplied; + goto PullApplyArgsTrap; + } + else + pc.DATA.u += (supplied - minimum + 2); + } + else + { + applynil: + if (supplied > maximum) + { + sp[0].TAG = SetTagCdr(sp[0].TAG, CdrNil); + PushConstant (TypeList, ps->StackCacheBase + (fp - ps->StackCache) + maximum); + pc.DATA.u += (maximum - minimum + 2); + } + else if (supplied < minimum) + IllegalOperand; + else + pc.DATA.u += (supplied - minimum + 1); + } + goto InstructionCacheLookup; + } + + case DispatchEntryRestNotAccepted: + RetryRestNotAccepted: + { + register int supplied = ReadControlArgumentSize (ps->control); + register int minimum = ldb(8,0,cp->operand); + register int maximum = ldb(8,8,cp->operand); + + /* --- debug + if ((fp[0].TAG&-2) != ((TypeEvenPC&-2)|(3<<6))) + InstructionException; + */ + + if (ReadControlApply (ps->control)) + { + if (TypeEqualP (sp->TAG, TypeNIL)) + { + sp--; + WriteControlApply (ps->control, 0); + goto applynil2; + } + if (supplied >= maximum) + IllegalOperand; + if (TypeEqualP (sp->TAG, TypeList)) + { + i = maximum - supplied; + if ((sp[0].DATA.u - ps->StackCacheBase) < StackCacheSize * PageSize) + { + DecacheRegisters(); + i = PullApplyArgsQuickly(maximum - supplied); + EncacheRegisters(); + } + if (i) + goto PullApplyArgsTrap; + else + goto RetryRestNotAccepted; + } + else + { + /* Always trap to handler, not IllegalOperand */ + i = maximum - supplied; + goto PullApplyArgsTrap; + } + } + else + { + applynil2: + if ((minimum <= supplied) && (supplied <= maximum)) + { + pc.DATA.u += (supplied - minimum + 1); + goto InstructionCacheLookup; + } + else + IllegalOperand; + } + } + + case DispatchLocateLocals: + lp = sp; + PushFixnum(ReadControlArgumentSize(ps->control) - 2); + WriteControlArgumentSize(ps->control, lp - fp); + NextInstruction; + + case DispatchReturnSingleTOS: + *scratch = *sp; + goto ReturnSingleInternal; + case DispatchReturnSingleNIL: + *scratch = ObjectNIL; + goto ReturnSingleInternal; + case DispatchReturnSingleT: + *scratch = ObjectT; + goto ReturnSingleInternal; + + ReturnSingleInternal: + { + IvoryValueDisposition disp; + Integer control; + + retryReturnSingle: + disp = ReadControlValueDisposition (ps->control); + control = fp[1].DATA.u; + + /* --- debug + if ((fp[-ReadControlCallerFrameSize(ps->control)].TAG&-2) != ((TypeEvenPC&-2)|(3<<6))) + InstructionException; + */ + if (ReadControlCleanupBits (ps->control)) + { + for (; ReadControlCleanupCatch (ps->control); ) + { + /* cbp[0] == pc, cbp[1] == binding stack, cbp[2] == previous */ + LispObj *cbp = &ps->StackCache[ps->CatchBlockPointer.DATA.u - ps->StackCacheBase]; + Integer control = ps->control; + + if (ldb(1,6,cbp[1].TAG)) + goto HandleUnwindProtect; + WriteControlExtraArgument(control, ldb(1,7,cbp[2].TAG)); + ps->control = WriteControlCleanupCatch(control, ldb(1,6,cbp[2].TAG)); + StoreCdrNext(ps->CatchBlockPointer, cbp[2]); + } + if (ReadControlCleanupBindings (ps->control)) + { + if (ps->DeepBoundP) + UnimplementedInstruction; + for (; ReadControlCleanupBindings (ps->control); ) + Unbind(); + } + if (ReadControlTrapOnExit (ps->control)) + IllegalOperand; + } + /* --- debug + if (TypeEqualP (fp[0].TAG, TypeNIL)) + goto save_and_halt; + */ + if (disp != ValueDispositionReturn) + pc = ps->continuation; + ps->continuation = fp[0]; + sp = fp - 1; + fp = fp - ReadControlCallerFrameSize (ps->control); + lp = fp + ReadControlArgumentSize (control); + ps->control = control; + + switch (disp) + { + case ValueDispositionEffect: + break; + + case ValueDispositionValue: + PushObject (scratch); + break; + + case ValueDispositionMultiple: + PushObject (scratch); + PushFixnum (1); + break; + + case ValueDispositionReturn: + break; + } + if (fp < ps->StackCache) + { + DecacheRegisters(); + StackCacheScrollDown(); + EncacheRegisters(); + } + if (disp == ValueDispositionReturn) + { + AllowSequenceBreaks; + goto retryReturnSingle; + } + goto InstructionCacheLookup; + } + + case DispatchReturnMultipleImmediate: AddressImmediateOperand (); goto ExecuteReturnMultiple; + case DispatchReturnMultiplePop: AddressPopOperand (); goto ExecuteReturnMultiple; + ExecuteReturnMultiple: + MARK(ReturnMultiple); + if (!TypeFixnumP (op2->TAG)) + IllegalOperand; + { + int count = op2->DATA.s; + IvoryValueDisposition disp; + int framesize; + Integer control; + LispObj *valueblock; + + retryReturnMultiple: + + /* --- debug + if ((fp[-ReadControlCallerFrameSize(ps->control)].TAG&-2) != ((TypeEvenPC&-2)|(3<<6))) + InstructionException; + */ + disp = ReadControlValueDisposition (ps->control); + framesize = ReadControlCallerFrameSize (ps->control); + control = fp[1].DATA.u; + valueblock = &sp[-(count - 1)]; + if ((disp == ValueDispositionMultiple || disp == ValueDispositionReturn) && + (framesize + count + 1 > 112)) + IllegalOperand; + + if (ReadControlCleanupBits (ps->control)) + { + for (; ReadControlCleanupCatch (ps->control); ) + { + /* cbp[0] == pc, cbp[1] == binding stack, cbp[2] == previous */ + LispObj *cbp = &ps->StackCache[ps->CatchBlockPointer.DATA.u - ps->StackCacheBase]; + Integer control = ps->control; + + if (ldb(1,6,cbp[1].TAG)) + goto HandleUnwindProtect; + WriteControlExtraArgument(control, ldb(1,7,cbp[2].TAG)); + ps->control = WriteControlCleanupCatch(control, ldb(1,6,cbp[2].TAG)); + StoreCdrNext(ps->CatchBlockPointer, cbp[2]); + } + if (ReadControlCleanupBindings (ps->control)) + { + if (ps->DeepBoundP) + UnimplementedInstruction; + for (; ReadControlCleanupBindings (ps->control); ) + Unbind(); + } + if (ReadControlTrapOnExit (ps->control)) + IllegalOperand; + } + + /* --- debug + if (TypeEqualP (fp[0].TAG, TypeNIL)) + goto save_and_halt; + */ + if (disp != ValueDispositionReturn) + pc = ps->continuation; + ps->continuation = fp[0]; + sp = fp - 1; + fp -= framesize; + lp = fp + ReadControlArgumentSize (control); /* from new control */ + ps->control = control; /* --- trace-pending is sticky? */ + switch (disp) + { + case ValueDispositionEffect: + break; + case ValueDispositionValue: + if (count > 0) + PushObject (valueblock) + else + PushNIL (); + break; + case ValueDispositionMultiple: + for (i = count; i--;) + StoreCdrNext(*++sp, *valueblock++); + PushFixnum(count); + break; + case ValueDispositionReturn: + for (i = count; i--;) + *++sp = *valueblock++; + } + if (fp < ps->StackCache) + { + DecacheRegisters(); + StackCacheScrollDown(); + /* adjust valueblock for scroll */ + valueblock += ps->sp - sp; + EncacheRegisters(); + } + if (disp == ValueDispositionReturn) + { + AllowSequenceBreaks; + goto retryReturnMultiple; + } + goto InstructionCacheLookup; + } + + case DispatchReturnKludgeImmediate: AddressImmediateOperand (); goto ExecuteReturnKludge; + case DispatchReturnKludgePop: AddressPopOperand (); goto ExecuteReturnKludge; + ExecuteReturnKludge: + MARK(ReturnKludge); + if (TypeFixnumP(op2->TAG)) + { + int count = op2->DATA.s; + int framesize = ReadControlCallerFrameSize (ps->control); + Integer control = fp[1].DATA.u; + LispObj *valueblock = &sp[-(count - 1)]; + + if (framesize + count + 1 > 112) + IllegalOperand; + if (ReadControlCleanupBits (ps->control)) + { + for (; ReadControlCleanupCatch (ps->control); ) + { + /* cbp[0] == pc, cbp[1] == binding stack, cbp[2] == previous */ + LispObj *cbp = &ps->StackCache[ps->CatchBlockPointer.DATA.u - ps->StackCacheBase]; + Integer control = ps->control; + + if (ldb(1,6,cbp[1].TAG)) + goto HandleUnwindProtect; + WriteControlExtraArgument(control, ldb(1,7,cbp[2].TAG)); + ps->control = WriteControlCleanupCatch(control, ldb(1,6,cbp[2].TAG)); + StoreCdrNext(ps->CatchBlockPointer, cbp[2]); + } + if (ReadControlCleanupBindings (ps->control)) + { + if (ps->DeepBoundP) + UnimplementedInstruction; + for (; ReadControlCleanupBindings (ps->control); ) + Unbind(); + } + if (ReadControlTrapOnExit (ps->control)) + IllegalOperand; + } + /* --- debug + if (TypeEqualP (fp[0].TAG, TypeNIL)) + goto save_and_halt; + */ + pc = ps->continuation; + ps->continuation = fp[0]; + sp = fp - 1; + fp -= framesize; + lp = fp + ReadControlArgumentSize (ps->control = control); + for (i = count; i--;) + *++sp = *valueblock++; + + /* --- goto StackCacheUnderflowCheck; */ + if (fp < ps->StackCache) + { + DecacheRegisters(); + StackCacheScrollDown(); + /* adjust valueblock for scroll */ + valueblock += ps->sp - sp; + EncacheRegisters(); + } + goto InstructionCacheLookup; + } + IllegalOperand; + + case DispatchTakeValues: + if (!TypeFixnumP(sp->TAG)) IllegalOperand; + i = cp->operand - sp->DATA.s; + sp--; + if (i > 0) + goto PushNNilsInternal; + if (i < 0) + sp += i; + NextInstruction; + + case DispatchBindLocativeToValueImmediate: AddressImmediateOperand (); goto ExecuteBindLocativeToValue; + case DispatchBindLocativeToValueSP: AddressSPOperand (); goto ExecuteBindLocativeToValue; + case DispatchBindLocativeToValueFP: AddressFPOperand (); goto ExecuteBindLocativeToValue; + case DispatchBindLocativeToValueLP: AddressLPOperand (); goto ExecuteBindLocativeToValue; + case DispatchBindLocativeToValuePop: AddressPopOperand (); goto ExecuteBindLocativeToValue; + ExecuteBindLocativeToValue: + MARK(BindLocativeToValue); + if (TypeEqualP(sp->TAG, TypeLocative)) + { + LispObj loc = *sp--; + + if (ps->BindingStackPointer >= ps->BindingStackLimit || + ps->DeepBoundP) + IllegalOperand; + MemoryRead(loc.DATA.u, scratch, CycleBindRead); + loc.TAG |= (ReadControlCleanupBindings(ps->control) << 6); + WriteVirtualMemory(ps->BindingStackPointer + 1, &loc); + WriteVirtualMemory(ps->BindingStackPointer + 2, scratch); + StoreContents(loc.DATA.u, op2, CycleBindWrite); + /* no more chance of pclsr-ing */ + WriteControlCleanupBindings(ps->control, 1); + ps->BindingStackPointer += 2; + NextInstruction; + } + goto SpSpareExceptions; + + case DispatchBindLocativeSP: AddressSPOperand (); goto ExecuteBindLocative; + case DispatchBindLocativeFP: AddressFPOperand (); goto ExecuteBindLocative; + case DispatchBindLocativeLP: AddressLPOperand (); goto ExecuteBindLocative; + case DispatchBindLocativePop: AddressPopOperand (); goto ExecuteBindLocative; + ExecuteBindLocative: + MARK(BindLocative); + if (TypeEqualP(op2->TAG, TypeLocative)) + { + LispObj loc = *op2; + + if (ps->BindingStackPointer >= ps->BindingStackLimit || + ps->DeepBoundP) + IllegalOperand; + MemoryRead(loc.DATA.u, scratch, CycleBindRead); + loc.TAG |= (ReadControlCleanupBindings(ps->control) << 6); + WriteVirtualMemory(ps->BindingStackPointer + 1, &loc); + WriteVirtualMemory(ps->BindingStackPointer + 2, scratch); + /* no more chance of pclsr-ing */ + WriteControlCleanupBindings(ps->control, 1); + ps->BindingStackPointer += 2; + NextInstruction; + } + goto Op2SpareExceptions; + + case DispatchUnbindNImmediate: AddressImmediateOperand (); goto ExecuteUnbindN; + case DispatchUnbindNPop: AddressPopOperand (); goto ExecuteUnbindN; + ExecuteUnbindN: + MARK(UnbindN); + if (!TypeFixnumP(op2->TAG) || + ps->DeepBoundP) + IllegalOperand; + for (i = op2->DATA.u; i--; ) + if (Unbind()) + IllegalOperand; + NextInstruction; + + case DispatchRestoreBindingStackImmediate: AddressImmediateOperand (); goto ExecuteRestoreBindingStack; + case DispatchRestoreBindingStackSP: AddressSPOperand (); goto ExecuteRestoreBindingStack; + case DispatchRestoreBindingStackFP: AddressFPOperand (); goto ExecuteRestoreBindingStack; + case DispatchRestoreBindingStackLP: AddressLPOperand (); goto ExecuteRestoreBindingStack; + case DispatchRestoreBindingStackPop: AddressPopOperand (); goto ExecuteRestoreBindingStack; + ExecuteRestoreBindingStack: + MARK(RestoreBindingStack); + if (TypeEqualP(op2->TAG, TypeLocative)) + { + if (ps->DeepBoundP) + IllegalOperand; + for (; ps->BindingStackPointer > op2->DATA.u; ) + if (Unbind()) + IllegalOperand; + NextInstruction; + } + goto Op2SpareExceptions; + + case DispatchCatchOpen: + { + Integer newpointer = ps->StackCacheBase + (sp - ps->StackCache); + int unwindprotect = ldb(1,0,cp->operand); + + PushConstant(SetTagCdr(TypeLocative, unwindprotect), ps->BindingStackPointer); + PushConstant(SetTagCdr(ps->CatchBlockPointer.TAG, + dpb(ReadControlExtraArgument(ps->control), + 1, 1, + ReadControlCleanupCatch(ps->control))), + ps->CatchBlockPointer.DATA.u); + if (!unwindprotect) + PushConstant(SetTagCdr(ps->continuation.TAG, ldb(2,6,cp->operand)), + ps->continuation.DATA.u); + ps->CatchBlockPointer.TAG = TypeLocative; + ps->CatchBlockPointer.DATA.u = newpointer; + WriteControlCleanupCatch(ps->control,1); + NextInstruction; + } + + case DispatchCatchClose: + { + /* cbp[0] == pc, cbp[1] == binding stack, cbp[2] == previous */ + LispObj *cbp = &ps->StackCache[ps->CatchBlockPointer.DATA.u - ps->StackCacheBase]; + register Integer control = ps->control; + + if (ps->BindingStackPointer != cbp[1].DATA.u) + { + if (ps->DeepBoundP) + UnimplementedInstruction; + else + for (; ps->BindingStackPointer > cbp[1].DATA.u; ) + if (Unbind()) + IllegalOperand; + } + WriteControlExtraArgument(control, ldb(1,7,cbp[2].TAG)); + ps->control = WriteControlCleanupCatch(control, ldb(1,6,cbp[2].TAG)); + StoreCdrNext(ps->CatchBlockPointer, cbp[2]); + if (ldb(1,6,cbp[1].TAG)) + { + PushConstant(SetTagCdr(cp->next_pc.TAG, + dpb(ReadControlCleanupInProgress(ps->control), 1, 0, 2)), + cp->next_pc.DATA.u); + WriteControlCleanupInProgress(ps->control,1); + pc = cbp[0]; + goto InstructionCacheLookup; + } + NextInstruction; + } + + case DispatchPushLexicalVarImmediate: + UnimplementedInstruction; + case DispatchPushLexicalVarSP: AddressSPOperand (); goto ExecutePushLexicalVar; + case DispatchPushLexicalVarFP: AddressFPOperand (); goto ExecutePushLexicalVar; + case DispatchPushLexicalVarLP: AddressLPOperand (); goto ExecutePushLexicalVar; + case DispatchPushLexicalVarPop: AddressPopOperand (); goto ExecutePushLexicalVar; + ExecutePushLexicalVar: + MARK(PushLexicalVar); + switch (TagType(op2->TAG)) + { + case TypeList: + case TypeLocative: + MemoryReadData (op2->DATA.u + ldb(3,10,cp->instruction), scratch); + PushObject(scratch); + NextInstruction; + } + IllegalOperand; + + case DispatchPopLexicalVarImmediate: + UnimplementedInstruction; + case DispatchPopLexicalVarSP: AddressSPOperand (); goto ExecutePopLexicalVar; + case DispatchPopLexicalVarFP: AddressFPOperand (); goto ExecutePopLexicalVar; + case DispatchPopLexicalVarLP: AddressLPOperand (); goto ExecutePopLexicalVar; + case DispatchPopLexicalVarPop: AddressPopOperand (); goto ExecutePopLexicalVar; + ExecutePopLexicalVar: + MARK(PopLexicalVar); + switch (TagType(op2->TAG)) + { + case TypeList: + case TypeLocative: + StoreContents (op2->DATA.u + ldb(3,10,cp->instruction), sp, CycleDataWrite); + sp--; + NextInstruction; + } + IllegalOperand; + + case DispatchMovemLexicalVarImmediate: + UnimplementedInstruction; + case DispatchMovemLexicalVarSP: AddressSPOperand (); goto ExecuteMovemLexicalVar; + case DispatchMovemLexicalVarFP: AddressFPOperand (); goto ExecuteMovemLexicalVar; + case DispatchMovemLexicalVarLP: AddressLPOperand (); goto ExecuteMovemLexicalVar; + case DispatchMovemLexicalVarPop: AddressPopOperand (); goto ExecuteMovemLexicalVar; + ExecuteMovemLexicalVar: + MARK(MovemLexicalVar); + switch (TagType(op2->TAG)) + { + case TypeList: + case TypeLocative: + StoreContents (op2->DATA.u + ldb(3,10,cp->instruction), sp, CycleDataWrite); + NextInstruction; + } + IllegalOperand; + + case DispatchPushInstanceVariable: + i = LocateInstanceVariableMapped(&fp[2], &fp[3], cp->operand); + MemoryReadData(i, &sp[1]); + sp++; + NextInstruction; + + case DispatchPopInstanceVariable: + i = LocateInstanceVariableMapped(&fp[2], &fp[3], cp->operand); + StoreContents(i, &sp[0], CycleDataWrite); + sp--; + NextInstruction; + + case DispatchMovemInstanceVariable: + i = LocateInstanceVariableMapped(&fp[2], &fp[3], cp->operand); + StoreContents(i, &sp[0], CycleDataWrite); + NextInstruction; + + case DispatchPushAddressInstanceVariable: + i = LocateInstanceVariableMapped(&fp[2], &fp[3], cp->operand); + PushConstant(TypeLocative, i); + NextInstruction; + + case DispatchPushInstanceVariableOrdered: + if (ldb(4, 2, fp[3].TAG) != ldb(4, 2, TypeInstance)) + IllegalOperand; + MemoryReadData(fp[3].DATA.u + cp->operand, &sp[1]); + sp++; + NextInstruction; + + case DispatchPopInstanceVariableOrdered: + if (ldb(4, 2, fp[3].TAG) != ldb(4, 2, TypeInstance)) + IllegalOperand; + StoreContents(fp[3].DATA.u + cp->operand, &sp[0], CycleDataWrite); + sp--; + NextInstruction; + + case DispatchMovemInstanceVariableOrdered: + if (ldb(4, 2, fp[3].TAG) != ldb(4, 2, TypeInstance)) + IllegalOperand; + StoreContents(fp[3].DATA.u + cp->operand, &sp[0], CycleDataWrite); + NextInstruction; + + case DispatchPushAddressInstanceVariableOrdered: + if (ldb(4, 2, fp[3].TAG) != ldb(4, 2, TypeInstance)) + IllegalOperand; + PushConstant(TypeLocative, fp[3].DATA.u + cp->operand); + NextInstruction; + + case DispatchInstanceRefImmediate: AddressImmediateOperand (); goto ExecuteInstanceRef; + case DispatchInstanceRefSP: AddressSPOperand (); goto ExecuteInstanceRef; + case DispatchInstanceRefFP: AddressFPOperand (); goto ExecuteInstanceRef; + case DispatchInstanceRefLP: AddressLPOperand (); goto ExecuteInstanceRef; + case DispatchInstanceRefPop: AddressPopOperand (); goto ExecuteInstanceRef; + ExecuteInstanceRef: + MARK(InstanceRef); + i = LocateArbitraryInstanceVariable(sp, op2); + MemoryReadData(i, scratch); + SetObject(scratch); + NextInstruction; + + case DispatchInstanceSetImmediate: AddressImmediateOperand (); goto ExecuteInstanceSet; + case DispatchInstanceSetSP: AddressSPOperand (); goto ExecuteInstanceSet; + case DispatchInstanceSetFP: AddressFPOperand (); goto ExecuteInstanceSet; + case DispatchInstanceSetLP: AddressLPOperand (); goto ExecuteInstanceSet; + case DispatchInstanceSetPop: AddressPopOperand (); goto ExecuteInstanceSet; + ExecuteInstanceSet: + MARK(InstanceSet); + i = LocateArbitraryInstanceVariable(&sp[-1], op2); + StoreContents(i, &sp[0], CycleDataWrite); + sp -= 2; + NextInstruction; + + + case DispatchInstanceLocImmediate: AddressImmediateOperand (); goto ExecuteInstanceSet; + case DispatchInstanceLocSP: AddressSPOperand (); goto ExecuteInstanceLoc; + case DispatchInstanceLocFP: AddressFPOperand (); goto ExecuteInstanceLoc; + case DispatchInstanceLocLP: AddressLPOperand (); goto ExecuteInstanceLoc; + case DispatchInstanceLocPop: AddressPopOperand (); goto ExecuteInstanceLoc; + ExecuteInstanceLoc: + MARK(InstanceLoc); + i = LocateArbitraryInstanceVariable(sp, op2); + SetConstant(TypeLocative, i); + NextInstruction; + + + case DispatchEphemeralpImmediate: + UnimplementedInstruction; + case DispatchEphemeralpSP: AddressSPOperand (); goto ExecuteEphemeralp; + case DispatchEphemeralpFP: AddressFPOperand (); goto ExecuteEphemeralp; + case DispatchEphemeralpLP: AddressLPOperand (); goto ExecuteEphemeralp; + case DispatchEphemeralpPop: AddressPopOperand (); goto ExecuteEphemeralp; + ExecuteEphemeralp: + MARK(Ephemeralp); + UnimplementedInstruction; + + case DispatchUnsignedLesspImmediate: + SetPredicate (sp->DATA.u < (unsigned int)cp->operand); + NextInstruction; + case DispatchUnsignedLesspSP: AddressSPOperand (); goto ExecuteUnsignedLessp; + case DispatchUnsignedLesspFP: AddressFPOperand (); goto ExecuteUnsignedLessp; + case DispatchUnsignedLesspLP: AddressLPOperand (); goto ExecuteUnsignedLessp; + case DispatchUnsignedLesspPop: AddressPopOperand (); goto ExecuteUnsignedLessp; + ExecuteUnsignedLessp: + MARK(UnsignedLessp); + SetPredicate (sp->DATA.u < op2->DATA.u); + NextInstruction; + + case DispatchUnsignedLesspNoPopImmediate: + PushPredicate (sp->DATA.u < (unsigned int)cp->operand); + NextInstruction; + case DispatchUnsignedLesspNoPopSP: AddressSPOperand (); goto ExecuteUnsignedLesspNoPop; + case DispatchUnsignedLesspNoPopFP: AddressFPOperand (); goto ExecuteUnsignedLesspNoPop; + case DispatchUnsignedLesspNoPopLP: AddressLPOperand (); goto ExecuteUnsignedLesspNoPop; + case DispatchUnsignedLesspNoPopPop: AddressPopOperand (); goto ExecuteUnsignedLesspNoPop; + ExecuteUnsignedLesspNoPop: + MARK(UnsignedLesspNoPop); + PushPredicate (sp->DATA.u < op2->DATA.u); + NextInstruction; + + case DispatchAluImmediate: AddressImmediateOperand(); goto ExecuteAlu; + case DispatchAluSP: AddressSPOperand (); goto ExecuteAlu; + case DispatchAluFP: AddressFPOperand (); goto ExecuteAlu; + case DispatchAluLP: AddressLPOperand (); goto ExecuteAlu; + case DispatchAluPop: AddressPopOperand (); goto ExecuteAlu; + ExecuteAlu: + MARK(Alu); + if (BinaryTypeFixnumP (op2->TAG, sp->TAG)) + { + Integer result; + + ps->ALUOverflow = 0; + result = (*(ps->AluOp))(ps->AluAndRotateControl, sp->DATA.u, op2->DATA.u); + if (ps->ALUOverflow) + InstructionException; + sp->DATA.u = result; + NextInstruction; + } + goto BinaryTypeFixnumExceptions; + + case DispatchAllocateListBlockImmediate: AddressImmediateOperand (); goto ExecuteAllocateListBlock; + case DispatchAllocateListBlockSP: AddressSPOperand (); goto ExecuteAllocateListBlock; + case DispatchAllocateListBlockFP: AddressFPOperand (); goto ExecuteAllocateListBlock; + case DispatchAllocateListBlockLP: AddressLPOperand (); goto ExecuteAllocateListBlock; + case DispatchAllocateListBlockPop: AddressPopOperand (); goto ExecuteAllocateListBlock; + ExecuteAllocateListBlock: + MARK(AllocateListBlock); + if (!TypeFixnumP(op2->TAG)) + IllegalOperand; + if (!ObjectEqP(ps->ListCacheArea, *sp) || + (op2->DATA.u > ps->ListCacheLength)) + InstructionException; + SetObject(&(ps->ListCacheAddress)); + ps->bar[1].address = ps->ListCacheAddress; + if (ReadControlTrapMode(ps->control) < 1) + WriteControlTrapMode(ps->control, 1); + ps->ListCacheLength -= op2->DATA.u; + ps->ListCacheAddress.DATA.u += op2->DATA.u; + NextInstruction; + + case DispatchAllocateStructureBlockImmediate: AddressImmediateOperand (); goto ExecuteAllocateListBlock; + case DispatchAllocateStructureBlockSP: AddressSPOperand (); goto ExecuteAllocateStructureBlock; + case DispatchAllocateStructureBlockFP: AddressFPOperand (); goto ExecuteAllocateStructureBlock; + case DispatchAllocateStructureBlockLP: AddressLPOperand (); goto ExecuteAllocateStructureBlock; + case DispatchAllocateStructureBlockPop: AddressPopOperand (); goto ExecuteAllocateStructureBlock; + ExecuteAllocateStructureBlock: + MARK(AllocateStructureBlock); + if (!TypeFixnumP(op2->TAG)) + IllegalOperand; + if (!ObjectEqP(ps->StructureCacheArea, *sp) || + (op2->DATA.u > ps->StructureCacheLength)) + InstructionException; + SetObject(&(ps->StructureCacheAddress)); + ps->bar[1].address = ps->StructureCacheAddress; + if (ReadControlTrapMode(ps->control) < 1) + WriteControlTrapMode(ps->control, 1); + ps->StructureCacheLength -= op2->DATA.u; + ps->StructureCacheAddress.DATA.u += op2->DATA.u; + NextInstruction; + + case DispatchPointerPlusImmediate: + sp->DATA.u += cp->operand; + NextInstruction; + case DispatchPointerPlusSP: AddressSPOperand (); goto ExecutePointerPlus; + case DispatchPointerPlusFP: AddressFPOperand (); goto ExecutePointerPlus; + case DispatchPointerPlusLP: AddressLPOperand (); goto ExecutePointerPlus; + case DispatchPointerPlusPop: AddressPopOperand (); goto ExecutePointerPlus; + ExecutePointerPlus: + MARK(PointerPlus); + sp->DATA.u += op2->DATA.u; + NextInstruction; + + case DispatchPointerDifferenceImmediate: + SetFixnum(sp->DATA.u - cp->operand); + NextInstruction; + case DispatchPointerDifferenceSP: AddressSPOperand (); goto ExecutePointerDifference; + case DispatchPointerDifferenceFP: AddressFPOperand (); goto ExecutePointerDifference; + case DispatchPointerDifferenceLP: AddressLPOperand (); goto ExecutePointerDifference; + case DispatchPointerDifferencePop: AddressPopOperand (); goto ExecutePointerDifference; + ExecutePointerDifference: + MARK(PointerDifference); + SetFixnum(sp->DATA.u - op2->DATA.u); + NextInstruction; + + case DispatchPointerIncrementSP: AddressSPOperand (); goto ExecutePointerIncrement; + case DispatchPointerIncrementFP: AddressFPOperand (); goto ExecutePointerIncrement; + case DispatchPointerIncrementLP: AddressLPOperand (); goto ExecutePointerIncrement; + ExecutePointerIncrement: + MARK(PointerIncrement); + op2->DATA.u += 1; + NextInstruction; + + case DispatchReadInternalRegister: + switch ((unsigned int)cp->operand) + { + case InternalRegisterFP: + PushConstant(TypeLocative, ps->StackCacheBase + (fp - ps->StackCache)); + break; + case InternalRegisterLP: + PushConstant(TypeLocative, ps->StackCacheBase + (lp - ps->StackCache)); + break; + case InternalRegisterEA: + InstructionException; + case InternalRegisterMacroSP: + case InternalRegisterSP: + PushConstant(TypeLocative, ps->StackCacheBase + (sp - ps->StackCache)); + break; + case InternalRegisterStackCacheLowerBound: + PushConstant(TypeLocative, ps->StackCacheBase); + break; + case InternalRegisterBAR0: + InstructionException; + case InternalRegisterBAR1: + PushObject(&ps->bar[1].address); + break; + case InternalRegisterBAR2: + PushObject(&ps->bar[1].address); + break; + case InternalRegisterBAR3: + PushObject(&ps->bar[1].address); + break; + case InternalRegisterPHTHash0: + InstructionException; + case InternalRegisterPHTHash1: + InstructionException; + case InternalRegisterPHTHash2: + InstructionException; + case InternalRegisterPHTHash3: + InstructionException; + case InternalRegisterEPC: /* the current PC */ + InstructionException; + case InternalRegisterDPC: /* the current PC + 2 */ + InstructionException; + case InternalRegisterContinuation: + PushObject(&ps->continuation); + break; + case InternalRegisterAluAndRotateControl: + PushFixnum(ps->AluAndRotateControl); + break; + case InternalRegisterControlRegister: + PushFixnum(ps->control); + break; + case InternalRegisterCRArgumentSize: + PushFixnum (3); + break; + case InternalRegisterEphemeralOldspaceRegister: + PushFixnum(ps->EphemeralOldspaceRegister); + break; + case InternalRegisterZoneOldspaceRegister: + PushFixnum(ps->ZoneOldspaceRegister); + break; + case InternalRegisterChipRevision: + PushFixnum (5); /* "alpha" */ + break; + case InternalRegisterFPCoprocessorPresent: + PushFixnum(0); + break; + case InternalRegisterPreemptRegister: + PushFixnum(ps->PreemptRegister); + break; + case InternalRegisterIcacheControl: + InstructionException; + case InternalRegisterPrefetcherControl: + InstructionException; + case InternalRegisterMapCacheControl: + InstructionException; + case InternalRegisterMemoryControl: + InstructionException; + case InternalRegisterECCLog: + InstructionException; + case InternalRegisterECCLogAddress: + InstructionException; + case InternalRegisterStackCacheOverflowLimit: + PushConstant(TypeLocative, ps->StackCacheBase + + (ps->StackCacheLimit - ps->StackCache)); + break; + case InternalRegisterAddressMask: + InstructionException; + case InternalRegisterEntryMaximumArguments: + InstructionException; + case InternalRegisterLexicalVariable: + InstructionException; + case InternalRegisterInstruction: + InstructionException; + case InternalRegisterMemoryData: + InstructionException; + case InternalRegisterDataPins: + InstructionException; + case InternalRegisterExtensionRegister: + InstructionException; + case InternalRegisterMicrosecondClock: + goto Read_Microsecond_Clock; + case InternalRegisterArrayHeaderLength: + InstructionException; + case InternalRegisterTOS: + PushObject(&sp[0]); + break; + case InternalRegisterEventCount: + PushFixnum(ps->ArrayEventCount); + break; + case InternalRegisterBindingStackPointer: + PushConstant (TypeLocative, ps->BindingStackPointer); + break; + case InternalRegisterBindingStackLimit: + PushConstant (TypeLocative, ps->BindingStackLimit); + break; + case InternalRegisterCatchBlockList: + PushObject (&ps->CatchBlockPointer); + break; + case InternalRegisterControlStackLimit: + PushConstant (TypeLocative, ps->ControlStackLimit); + break; + case InternalRegisterControlStackExtraLimit: + PushConstant (TypeLocative, ps->ControlStackExtraLimit); + break; + case InternalRegisterPHTBase: + InstructionException; + case InternalRegisterPHTMask: + InstructionException; + case InternalRegisterCountMapReloads: + InstructionException; + case InternalRegisterListCacheArea: + PushObject(&ps->ListCacheArea); + break; + case InternalRegisterListCacheAddress: + PushObject(&ps->ListCacheAddress); + break; + case InternalRegisterListCacheLength: + PushFixnum(ps->ListCacheLength); + break; + case InternalRegisterStructureCacheArea: + PushObject(&ps->StructureCacheArea); + break; + case InternalRegisterStructureCacheAddress: + PushObject(&ps->StructureCacheAddress); + break; + case InternalRegisterStructureCacheLength: + PushFixnum(ps->StructureCacheLength); + break; + case InternalRegisterDynamicBindingCacheBase: + PushConstant (TypeLocative, ps->DynamicBindingCacheBase); + break; + case InternalRegisterDynamicBindingCacheMask: + PushFixnum (ps->DynamicBindingCacheMask); + break; + case InternalRegisterChoicePointer: + InstructionException; + case InternalRegisterStructureStackChoicePointer: + InstructionException; + case InternalRegisterFEPModeTrapVectorAddress: + PushConstant (TypeLocative, ps->FEPModeTrapVectorAddress); + break; + case InternalRegisterMappingTableCache: + PushConstant (TypeLocative, ps->MappingTableCache); + break; + case InternalRegisterMappingTableLength: + PushFixnum (ps->MappingTableLength); + break; + case InternalRegisterStackFrameMaximumSize: + InstructionException; + case InternalRegisterStackCacheDumpQuantum: + PushFixnum (PageSize); + break; + case InternalRegisterConstantNIL: + PushNIL (); + break; + case InternalRegisterConstantT: + PushT (); + break; + default: + InstructionException; + } + NextInstruction; + + case DispatchWriteInternalRegister: + switch ((unsigned int)cp->operand) + { + case InternalRegisterFP: + InstructionException; + case InternalRegisterLP: + InstructionException; + case InternalRegisterSP: + InstructionException; + case InternalRegisterStackCacheLowerBound: + InstructionException; + case InternalRegisterBAR0: + InstructionException; + case InternalRegisterBAR1: + ps->bar[1].address = *sp; + break; + case InternalRegisterBAR2: + ps->bar[2].address = *sp; + break; + case InternalRegisterBAR3: + ps->bar[3].address = *sp; + break; + case InternalRegisterContinuation: + ps->continuation = *sp; + break; + case InternalRegisterAluAndRotateControl: + ps->AluAndRotateControl = sp->DATA.u; + ps->AluOp = ReadALUFunctionClass(sp->DATA.u); + ps->ByteSize = ReadALUByteSize(sp->DATA.u); + ps->ByteRotate = ReadALUByteRotate(sp->DATA.u); + break; + case InternalRegisterControlRegister: + ps->control = sp[0].DATA.u; + break; + case InternalRegisterEphemeralOldspaceRegister: + ps->EphemeralOldspaceRegister = sp[0].DATA.u; + break; + case InternalRegisterZoneOldspaceRegister: + ps->ZoneOldspaceRegister = sp[0].DATA.u; + break; + case InternalRegisterFPCoprocessorPresent: + break; + case InternalRegisterPreemptRegister: + ps->PreemptRegister = sp[0].DATA.u; + break; + case InternalRegisterIcacheControl: + InstructionException; + case InternalRegisterPrefetcherControl: + InstructionException; + case InternalRegisterMapCacheControl: + InstructionException; + case InternalRegisterMemoryControl: + InstructionException; + case InternalRegisterInvalidateMap0: + InstructionException; + case InternalRegisterInvalidateMap1: + InstructionException; + case InternalRegisterInvalidateMap2: + InstructionException; + case InternalRegisterInvalidateMap3: + InstructionException; + case InternalRegisterLoadMap0: + InstructionException; + case InternalRegisterLoadMap1: + InstructionException; + case InternalRegisterLoadMap2: + InstructionException; + case InternalRegisterLoadMap3: + InstructionException; + case InternalRegisterStackCacheOverflowLimit: + InstructionException; + case InternalRegisterAddressMask: + InstructionException; + case InternalRegisterInstruction: + InstructionException; + case InternalRegisterDataPins: + InstructionException; + case InternalRegisterExtensionRegister: + InstructionException; + case InternalRegisterMicrosecondClock: + goto Write_Microsecond_Clock; + case InternalRegisterLoadBAR0: + InstructionException; + case InternalRegisterLoadBAR1: + InstructionException; + case InternalRegisterLoadBAR2: + InstructionException; + case InternalRegisterLoadBAR3: + InstructionException; + case InternalRegisterTOS: + /* essentially a no-op, since our TOS is always "valid" */ + break; + case InternalRegisterEventCount: + ps->ArrayEventCount = sp->DATA.u; + break; + case InternalRegisterBindingStackPointer: + ps->BindingStackPointer = sp->DATA.u; + break; + case InternalRegisterBindingStackLimit: + ps->BindingStackLimit = sp->DATA.u; + break; + case InternalRegisterCatchBlockList: + ps->CatchBlockPointer = *sp; + break; + case InternalRegisterControlStackLimit: + ps->ControlStackLimit = sp[0].DATA.u; + break; + case InternalRegisterControlStackExtraLimit: + ps->ControlStackExtraLimit = sp[0].DATA.u; + break; + case InternalRegisterPHTBase: + InstructionException; + case InternalRegisterPHTMask: + InstructionException; + case InternalRegisterCountMapReloads: + InstructionException; + case InternalRegisterListCacheArea: + ps->ListCacheArea = *sp; + break; + case InternalRegisterListCacheAddress: + ps->ListCacheAddress = *sp; + break; + case InternalRegisterListCacheLength: + ps->ListCacheLength = sp->DATA.u; + break; + case InternalRegisterStructureCacheArea: + ps->StructureCacheArea = *sp; + break; + case InternalRegisterStructureCacheAddress: + ps->StructureCacheAddress = *sp; + break; + case InternalRegisterStructureCacheLength: + ps->StructureCacheLength = sp->DATA.u; + break; + case InternalRegisterDynamicBindingCacheBase: + ps->DynamicBindingCacheBase = sp[0].DATA.u; + break; + case InternalRegisterDynamicBindingCacheMask: + ps->DynamicBindingCacheMask = sp[0].DATA.u; + break; + case InternalRegisterChoicePointer: + InstructionException; + case InternalRegisterStructureStackChoicePointer: + InstructionException; + case InternalRegisterFEPModeTrapVectorAddress: + ps->FEPModeTrapVectorAddress = sp[0].DATA.u; + break; + case InternalRegisterMappingTableCache: + ps->MappingTableCache = sp[0].DATA.u; + break; + case InternalRegisterMappingTableLength: + ps->MappingTableLength = sp[0].DATA.u; + break; + case InternalRegisterStackFrameMaximumSize: + InstructionException; + case InternalRegisterStackCacheDumpQuantum: + InstructionException; + default: + InstructionException; + } + sp--; + NextInstruction; + + case DispatchCoprocessorRead: + switch ((unsigned int)cp->operand) + { + case CoprocessorRegisterMicrosecondClock: + Read_Microsecond_Clock: + { +#ifdef USE_WALL_TIME + struct timeval current_time; + + gettimeofday (¤t_time, NULL); + /* High 12 bits are seconds, low 20 bits are microseconds */ + PushFixnum (((unsigned int) current_time.tv_sec * 1000000) + + (unsigned int) current_time.tv_usec); +#else + long tps = sysconf(_SC_CLK_TCK); + struct tms tms; + + times(&tms); + PushFixnum ((unsigned int)((long) (tms.tms_utime + tms.tms_stime) + * 1000000 / tps)); +#endif + break; + } + case VMRegisterCommand: + PushFixnum(VM.CommandRegister); + break; + case VMRegisterAddress: + PushConstant(TypeLocative, VM.AddressRegister); + break; + case VMRegisterExtent: + PushFixnum(VM.ExtentRegister); + break; + case VMRegisterAttributes: + PushFixnum(VM.AttributesRegister); + break; + case VMRegisterDestination: + PushConstant(TypeLocative, VM.DestinationRegister); + break; + case VMRegisterData: + PushObject(&VM.DataRegister); + break; + default: + InstructionException; + } + NextInstruction; + + case DispatchCoprocessorWrite: + switch ((unsigned int)cp->operand) + { + case 01010: /* --- Compatible w/ MacIvory */ + SendInterruptToLifeSupport(); + break; + case CoprocessorRegisterMicrosecondClock: + Write_Microsecond_Clock: + /* --- This is a no-op. Too bad. */ + break; + case VMRegisterCommand: + VM.CommandRegister = VMCommand(sp->DATA.u); + break; + case VMRegisterAddress: + VM.AddressRegister = sp->DATA.u; + break; + case VMRegisterExtent: + VM.ExtentRegister = sp->DATA.u; + break; + case VMRegisterAttributes: + VM.AttributesRegister = sp->DATA.u; + break; + case VMRegisterDestination: + VM.DestinationRegister = sp->DATA.u; + break; + case VMRegisterData: + VM.DataRegister = *sp; + break; + default: + InstructionException; + } + sp--; + NextInstruction; + + case DispatchMemoryRead: + { + int cycle = (cp->operand & 01700) >> 6; + int fixnum_only = (cp->operand & 040); + int cdr_next = (cp->operand & 020); + + MemoryRead (sp->DATA.u, scratch, cycle); + if (fixnum_only && !TypeFixnumP(scratch->TAG)) + IllegalOperand; + *sp = *scratch; + if (cdr_next) + sp->TAG = TagType(sp->TAG); + NextInstruction; + } + + case DispatchMemoryReadAddress: + { + int cycle = (cp->operand & 01700) >> 6; + int fixnum_only = (cp->operand & 040); + int cdr_next = (cp->operand & 020); + Integer vma = sp->DATA.u; + + vma = MemoryRead (vma, scratch, cycle); + if (fixnum_only && !TypeFixnumP(scratch->TAG)) + IllegalOperand; + sp->DATA.u = (unsigned int)vma; + if (cdr_next) + sp->TAG = TagType(sp->TAG); + NextInstruction; + } + + case DispatchTagImmediate: + PushFixnum(TypeFixnum); + NextInstruction; + case DispatchTagSP: AddressSPOperand (); goto ExecuteTag; + case DispatchTagFP: AddressFPOperand (); goto ExecuteTag; + case DispatchTagLP: AddressLPOperand (); goto ExecuteTag; + case DispatchTagPop: AddressPopOperand (); goto ExecuteTag; + ExecuteTag: + MARK(Tag); + PushFixnum(op2->TAG); + NextInstruction; + + case DispatchSetTagImmediate: + sp->TAG = cp->operand; + NextInstruction; + case DispatchSetTagSP: AddressSPOperand (); goto ExecuteSetTag; + case DispatchSetTagFP: AddressFPOperand (); goto ExecuteSetTag; + case DispatchSetTagLP: AddressLPOperand (); goto ExecuteSetTag; + case DispatchSetTagPop: AddressPopOperand (); goto ExecuteSetTag; + ExecuteSetTag: + MARK(SetTag); + if (TypeEqualP(op2->TAG, TypeFixnum)) + { + sp->TAG = op2->DATA.u; + NextInstruction; + } + else + InstructionException; + + case DispatchStoreConditionalImmediate: AddressImmediateOperand (); goto ExecuteStoreConditional; + case DispatchStoreConditionalSP: AddressSPOperand (); goto ExecuteStoreConditional; + case DispatchStoreConditionalFP: AddressFPOperand (); goto ExecuteStoreConditional; + case DispatchStoreConditionalLP: AddressLPOperand (); goto ExecuteStoreConditional; + case DispatchStoreConditionalPop: AddressPopOperand (); goto ExecuteStoreConditional; + ExecuteStoreConditional: + MARK(StoreConditional); + if (TypeEqualP(TagType(sp[-1].TAG), TypeLocative)) + { + Integer vma = MemoryReadData (sp[-1].DATA.u, scratch); + + if (ObjectEqP(sp[0], *scratch)) + { + WriteVirtualMemory(vma, op2); + sp--; + SetT(); + } + else + { + sp--; + SetNIL(); + } + NextInstruction; + } + if (TypeSpareP(sp[-1].TAG)) + InstructionException; + IllegalOperand; + + case DispatchMemoryWriteImmediate: AddressImmediateOperand (); goto ExecuteMemoryWrite; + case DispatchMemoryWriteSP: AddressSPOperand (); goto ExecuteMemoryWrite; + case DispatchMemoryWriteFP: AddressFPOperand (); goto ExecuteMemoryWrite; + case DispatchMemoryWriteLP: AddressLPOperand (); goto ExecuteMemoryWrite; + case DispatchMemoryWritePop: AddressPopOperand (); goto ExecuteMemoryWrite; + ExecuteMemoryWrite: + MARK(MemoryWrite); + if (!TypeEqualP(sp[0].TAG, TypePhysicalAddress)) + { + WriteVirtualMemory(sp[0].DATA.u, op2); + sp--; + NextInstruction; + } + InstructionException; + + case DispatchPStoreContentsImmediate: AddressImmediateOperand (); goto ExecutePStoreContents; + case DispatchPStoreContentsSP: AddressSPOperand (); goto ExecutePStoreContents; + case DispatchPStoreContentsFP: AddressFPOperand (); goto ExecutePStoreContents; + case DispatchPStoreContentsLP: AddressLPOperand (); goto ExecutePStoreContents; + case DispatchPStoreContentsPop: AddressPopOperand (); goto ExecutePStoreContents; + ExecutePStoreContents: + MARK(PStoreContents); + if (!TypeEqualP(sp->TAG, TypePhysicalAddress)) + { + StoreContents (sp->DATA.u, op2, CycleRaw); + sp--; + NextInstruction; + } + InstructionException; + + case DispatchSetCdrCode1SP: AddressSPOperand (); goto ExecuteSetCdrCode1; + case DispatchSetCdrCode1FP: AddressFPOperand (); goto ExecuteSetCdrCode1; + case DispatchSetCdrCode1LP: AddressLPOperand (); goto ExecuteSetCdrCode1; + ExecuteSetCdrCode1: + MARK(SetCdrCode1); + op2->TAG = ((1 << 6) | TagType(op2->TAG)); + NextInstruction; + + case DispatchSetCdrCode2SP: AddressSPOperand (); goto ExecuteSetCdrCode2; + case DispatchSetCdrCode2FP: AddressFPOperand (); goto ExecuteSetCdrCode2; + case DispatchSetCdrCode2LP: AddressLPOperand (); goto ExecuteSetCdrCode2; + ExecuteSetCdrCode2: + MARK(SetCdrCode2); + op2->TAG = ((2 << 6) | TagType(op2->TAG)); + NextInstruction; + + case DispatchMergeCdrNoPopSP: AddressSPOperand (); goto ExecuteMergeCdrNoPop; + case DispatchMergeCdrNoPopFP: AddressFPOperand (); goto ExecuteMergeCdrNoPop; + case DispatchMergeCdrNoPopLP: AddressLPOperand (); goto ExecuteMergeCdrNoPop; + ExecuteMergeCdrNoPop: + MARK(MergeCdrNoPop); + op2->TAG = MergeCdr(sp->TAG, op2->TAG); + NextInstruction; + + case DispatchGenericDispatch: + UnimplementedInstruction; + + case DispatchMessageDispatch: + UnimplementedInstruction; + + case DispatchJumpSP: AddressSPOperand (); goto ExecuteJump; + case DispatchJumpFP: AddressFPOperand (); goto ExecuteJump; + case DispatchJumpLP: AddressLPOperand (); goto ExecuteJump; + case DispatchJumpPop: AddressPopOperand (); goto ExecuteJump; + ExecuteJump: + MARK(Jump); + switch (TagType(op2->TAG)) + { + case TypeEvenPC: + case TypeOddPC: + pc = *op2; + if (ldb(1,7,op2->TAG)) + WriteControlCleanupInProgress(processor->control, ldb(1,6,op2->TAG)); + goto InstructionCacheLookup; + } + InstructionException; + + case DispatchCheckPreemptRequest: + UnimplementedInstruction; + + case DispatchNoOp: + NextInstruction; + + case DispatchHalt: + goto save_and_halt; + + case DispatchPushExternalValueCellPointer: + MemoryReadData (cp->operand, sp + 1); + sp++; + sp->TAG &= TagTypeMask; + NextInstruction; + + case DispatchPushFixnum: PushConstant (TypeFixnum, cp->operand); NextInstruction; + case DispatchPushSmallRatio: PushConstant (TypeSmallRatio, cp->operand); NextInstruction; + case DispatchPushSingleFloat: PushConstant (TypeSingleFloat, cp->operand); NextInstruction; + case DispatchPushDoubleFloat: PushConstant (TypeDoubleFloat, cp->operand); NextInstruction; + case DispatchPushBignum: PushConstant (TypeBignum, cp->operand); NextInstruction; + case DispatchPushBigRatio: PushConstant (TypeBigRatio, cp->operand); NextInstruction; + case DispatchPushComplex: PushConstant (TypeComplex, cp->operand); NextInstruction; + case DispatchPushSpareNumber: PushConstant (TypeSpareNumber, cp->operand); NextInstruction; + case DispatchPushInstance: PushConstant (TypeInstance, cp->operand); NextInstruction; + case DispatchPushListInstance: PushConstant (TypeListInstance, cp->operand); NextInstruction; + case DispatchPushArrayInstance: PushConstant (TypeArrayInstance, cp->operand); NextInstruction; + case DispatchPushStringInstance: PushConstant (TypeStringInstance, cp->operand); NextInstruction; + case DispatchPushNil: PushConstant (TypeNIL, cp->operand); NextInstruction; + case DispatchPushList: PushConstant (TypeList, cp->operand); NextInstruction; + case DispatchPushArray: PushConstant (TypeArray, cp->operand); NextInstruction; + case DispatchPushString: PushConstant (TypeString, cp->operand); NextInstruction; + case DispatchPushSymbol: PushConstant (TypeSymbol, cp->operand); NextInstruction; + case DispatchPushLocative: PushConstant (TypeLocative, cp->operand); NextInstruction; + case DispatchPushLexicalClosure: PushConstant (TypeLexicalClosure, cp->operand); NextInstruction; + case DispatchPushDynamicClosure: PushConstant (TypeDynamicClosure, cp->operand); NextInstruction; + case DispatchPushCompiledFunction: PushConstant (TypeCompiledFunction, cp->operand); NextInstruction; + case DispatchPushGenericFunction: PushConstant (TypeGenericFunction, cp->operand); NextInstruction; + case DispatchPushSparePointer1: PushConstant (TypeSparePointer1, cp->operand); NextInstruction; + case DispatchPushSparePointer2: PushConstant (TypeSparePointer2, cp->operand); NextInstruction; + case DispatchPushPhysicalAddress: PushConstant (TypePhysicalAddress, cp->operand); NextInstruction; + case DispatchPushSpareImmediate1: PushConstant (TypeSpareImmediate1, cp->operand); NextInstruction; + case DispatchPushBoundLocation: PushConstant (TypeBoundLocation, cp->operand); NextInstruction; + case DispatchPushCharacter: PushConstant (TypeCharacter, cp->operand); NextInstruction; + case DispatchPushLogicVariable: PushConstant (TypeLogicVariable, cp->operand); NextInstruction; + case DispatchPushGcForward: PushConstant (TypeGCForward, cp->operand); NextInstruction; + case DispatchPushEvenPc: PushConstant (TypeEvenPC, cp->operand); NextInstruction; + case DispatchPushOddPc: PushConstant (TypeOddPC, cp->operand); NextInstruction; + + case DispatchDereferenceSP: AddressSPOperand (); goto ExecuteDereference; + case DispatchDereferenceFP: AddressFPOperand (); goto ExecuteDereference; + case DispatchDereferenceLP: AddressLPOperand (); goto ExecuteDereference; + case DispatchDereferencePop: AddressPopOperand (); goto ExecuteDereference; + ExecuteDereference: + MARK(Dereference); + UnimplementedInstruction; + + case DispatchUnifySP: AddressSPOperand (); goto ExecuteUnify; + case DispatchUnifyFP: AddressFPOperand (); goto ExecuteUnify; + case DispatchUnifyLP: AddressLPOperand (); goto ExecuteUnify; + case DispatchUnifyPop: AddressPopOperand (); goto ExecuteUnify; + ExecuteUnify: + MARK(Unify); + UnimplementedInstruction; + + case DispatchPushLocalLogicVariablesImmediate: + UnimplementedInstruction; + case DispatchPushLocalLogicVariablesSP: AddressSPOperand (); goto ExecutePushLocalLogicVariables; + case DispatchPushLocalLogicVariablesFP: AddressFPOperand (); goto ExecutePushLocalLogicVariables; + case DispatchPushLocalLogicVariablesLP: AddressLPOperand (); goto ExecutePushLocalLogicVariables; + case DispatchPushLocalLogicVariablesPop: AddressPopOperand (); goto ExecutePushLocalLogicVariables; + ExecutePushLocalLogicVariables: + MARK(PushLocalLogicVariables); + UnimplementedInstruction; + + case DispatchPushGlobalLogicVariable: + UnimplementedInstruction; + + case DispatchLogicTailTestImmediate: + UnimplementedInstruction; + case DispatchLogicTailTestSP: AddressSPOperand (); goto ExecuteLogicTailTest; + case DispatchLogicTailTestFP: AddressFPOperand (); goto ExecuteLogicTailTest; + case DispatchLogicTailTestLP: AddressLPOperand (); goto ExecuteLogicTailTest; + case DispatchLogicTailTestPop: AddressPopOperand (); goto ExecuteLogicTailTest; + ExecuteLogicTailTest: + MARK(LogicTailTest); + UnimplementedInstruction; + + default: UnimplementedInstruction; + } + + Op2FixnumExceptions: + if (TypeNumericP(op2->TAG)) + InstructionException; + IllegalOperand; + + Op2ListExceptions: + if (TypeEqualP(op2->TAG,TypeListInstance)) + InstructionException; + goto Op2SpareExceptions; + + Op2ArrayExceptions: + switch (TagType(op2->TAG)) + { + case TypeArrayInstance: case TypeStringInstance: + InstructionException; + } + goto Op2SpareExceptions; + + Op2SpareExceptions: + if (TypeSpareP(op2->TAG)) + InstructionException; + IllegalOperand; + + BinaryTypeFixnumExceptions: + if BinaryTypeNumericP(op2->TAG, sp->TAG) + InstructionException; + IllegalOperand; + + SpFixnumExceptions: + if (TypeNumericP (sp->TAG)) + InstructionException; + IllegalOperand; + + SpListExceptions: + if (TypeEqualP(sp->TAG,TypeListInstance)) + InstructionException; + goto SpSpareExceptions; + + SpArrayExceptions: + switch (TagType(sp->TAG)) + { + case TypeArrayInstance: case TypeStringInstance: + InstructionException; + } + goto SpSpareExceptions; + + SpSpareExceptions: + if (TypeSpareP(sp->TAG)) + InstructionException; + IllegalOperand; + + ScratchListExceptions: + if (TypeEqualP(scratch->TAG,TypeListInstance)) + InstructionException; + goto ScratchSpareExceptions; + + ScratchSpareExceptions: + if (TypeSpareP(scratch->TAG)) + InstructionException; + IllegalOperand; + + HandleUnwindProtect: + { + /* cbp[0] == pc, cbp[1] == binding stack, cbp[2] == previous */ + LispObj *cbp = &ps->StackCache[ps->CatchBlockPointer.DATA.u - ps->StackCacheBase]; + register Integer control = ps->control; + sp = restartsp; + + if (ps->BindingStackPointer != cbp[1].DATA.u) + { + if (ps->DeepBoundP) + UnimplementedInstruction; + else + for (; ps->BindingStackPointer > cbp[1].DATA.u; ) + if (Unbind()) + IllegalOperand; + } + PushConstant(SetTagCdr(pc.TAG, dpb(ReadControlCleanupInProgress(control), 1, 0, 2)), + pc.DATA.u); + WriteControlCleanupInProgress(control, 1); + WriteControlExtraArgument(control, ldb(1,7,cbp[2].TAG)); + ps->control = WriteControlCleanupCatch(control, ldb(1,6,cbp[2].TAG)); + StoreCdrNext(ps->CatchBlockPointer, cbp[2]); + pc = cbp[0]; + goto InstructionCacheLookup; + } + + PullApplyArgsTrap: + { + LispObj pull = { TypeFixnum, 0 }; + LispObj apply = *sp--; + + restartsp = sp; + pull.DATA.s = i; + DecacheRegisters(); + if (!TakePreTrap(PullApplyArgsTrapVector, &pull, &apply)) + goto halt; + EncacheRegisters(); + goto InstructionCacheLookup; + } + + UnimplementedInstructionTag: + if (Trace) + fprintf(stderr, "Unimplemented instruction at PC %08x, #%d\n", pc.DATA.u, ps->instruction_count); + { + LispObj microstate; + + microstate.TAG = TypeFixnum; + /* --- pass a microstate somehow */ + microstate.DATA.s = 0; + DecacheRegisters(); + if (!TakePreTrap(ErrorTrapVector, µstate, &pc)) + goto halt; + EncacheRegisters(); + goto InstructionCacheLookup; + } + + IllegalOperandTag: + if (Trace) + fprintf(stderr, "Illegal operand at PC %08x, #%d\n", pc.DATA.u, ps->instruction_count); + { + LispObj microstate, vma; + + microstate.TAG = TypeFixnum; + /* --- pass a microstate somehow */ + microstate.DATA.s = 0; + vma.TAG = TypeLocative; + /* --- not always op2, but maybe the non-op2 cases vma is not valid anyways? */ + vma.DATA.u = ps->StackCacheBase + (op2 - ps->StackCache); + DecacheRegisters(); + if (!TakePreTrap(ErrorTrapVector, µstate, &vma)) + goto halt; + EncacheRegisters(); + goto InstructionCacheLookup; + } + + InstructionExceptionTag: + if (Trace) + fprintf(stderr, "Instruction exception at PC %08x, #%d\n", pc.DATA.u, ps->instruction_count); + { + DecacheRegisters(); + if(!TakeInstructionException(cp->instruction, op2, &cp->next_pc)) + goto halt; + EncacheRegisters(); + goto InstructionCacheLookup; + } + + save_and_halt: + DecacheRegisters(); + halt: + ps->running = 0; + signal(SIGIO, old_io_handler); + signal(SIGSEGV, old_segv_handler); + return; +} diff --git a/c-emulator/emulator.h b/c-emulator/emulator.h new file mode 100644 index 0000000..5c43447 --- /dev/null +++ b/c-emulator/emulator.h @@ -0,0 +1,196 @@ +/* -*- Mode:C -*- */ + +/**** Language supplements ****/ + +#ifndef _EMULATOR_H +#define _EMULATOR_H + +#include + +typedef unsigned char Byte; +typedef unsigned char Tag; +typedef unsigned int Integer; +typedef int Boolean; +typedef float Float; +typedef void *Pointer; + +#define False 0 +#define True 1 + +#define ldb(ss,pp,source) ((int) (((source) >> (pp)) & ((1 << (ss)) - 1))) +#define dpb(field,ss,pp,background) ((((field) & ((1 << (ss)) - 1)) << (pp)) | ((background) & (~(((1 << (ss)) - 1) << (pp))))) +#define ceiling(n,d) (((n) + ((d) - 1)) / (d)) +#if (WORD_BIT == 32) +#define SignExtend8(i) (((int)((unsigned int)i << 24)) / 16777216) +#define SignExtend10(i) (((int)((unsigned int)i << 22)) / 4194304) +#else +#define SignExtend8(i) (((int)((unsigned int)i << (WORD_BIT-8))) / (1<<(WORD_BIT-8))) +#define SignExtend10(i) (((int)((unsigned int)i << (WORD_BIT-10))) / (1<<(WORD_BIT-10))) +#endif + +typedef union +{ + struct _LispObj + { +#if (LONG_BIT == 64) + unsigned int tag; +#else + unsigned char tag; +#endif + union { + unsigned int u; + signed int s; + float f; + } data; + } parts; +#if (LONG_BIT == 64) + unsigned long whole; +#endif +} LispObj, PC; +#define DATA parts.data +#define TAG parts.tag + +#define LispObjTag(lo) (((LispObj*)(&lo))->TAG) +#define LispObjData(lo) (((LispObj*)(&lo))->DATA.u) + +typedef struct _InstructionCacheLine +{ + PC pc; + PC next_pc; + int code; + int operand; + unsigned int instruction; + struct _InstructionCacheLine *next_cp; +} InstructionCacheLine; + +#define InstructionCacheSize 2048 +#define InstructionCacheLineSize 64 + +/**** Processor state definitions ****/ + +#define PageSize 0x100 +#define PageNumberMask 0xffffff00 +#define PageOffsetMask 0xff +#define AddressPageShift 8 + +#define QuantumSize 0x100000 +#define AddressQuantumShift 20 + +#define AddressQuantumNumber(vma) ((vma) >> AddressQuantumShift) +#define AddressQuantumOffset(vma) (((vma) & (QuantumSize - 1)) >> AddressPageShift) +#define AddressPageNumber(vma) ((vma) >> AddressPageShift) +#define AddressPageOffset(vma) ((vma) & (PageSize - 1)) + +#define StackCacheSize 4 + +typedef struct _ProcessorState +{ + LispObj *sp; + LispObj *restartsp; + LispObj *fp; + LispObj *lp; + PC pc; + PC continuation; + InstructionCacheLine *InstructionCache; + LispObj *StackCache; + LispObj *StackCacheLimit; + struct _bar { + LispObj address; + LispObj *mapped; + } bar[4]; + LispObj ListCacheArea; + LispObj ListCacheAddress; + LispObj StructureCacheArea; + LispObj StructureCacheAddress; + LispObj CatchBlockPointer; +/* Integer fields are at the end for better alignment */ + Integer control; + Integer StackCacheBase; + Integer ArrayEventCount; + Integer ListCacheLength; + Integer StructureCacheLength; + Integer BindingStackPointer; + Integer BindingStackLimit; + Boolean DeepBoundP; + Integer PreemptRegister; + Integer AluAndRotateControl; + Integer (*AluOp)(); + Integer ByteSize; + Integer ByteRotate; + Integer RotateLatch; + Boolean ALUOverflow; + Boolean ALUBorrow; + Boolean ALULessThan; + Integer EphemeralOldspaceRegister; + Integer ZoneOldspaceRegister; + Integer ControlStackLimit; + Integer ControlStackExtraLimit; + Integer DynamicBindingCacheBase; + Integer DynamicBindingCacheMask; + Integer FEPModeTrapVectorAddress; + Integer MappingTableCache; + Integer MappingTableLength; + Boolean running; + unsigned int instruction_count; +} ProcessorState; + +extern ProcessorState *processor; +extern Boolean Trace; + +extern void InitializeIvoryProcessor (Integer *dataBase, Tag *tagsBase); +extern Boolean IvoryProcessorSystemStartup (Boolean bootingP); +extern Boolean Runningp (void); +extern void PushOneFakeFrame (void); +extern void PopOneFakeFrame (void); +extern void HaltMachine (void); +extern void StartMachine (void); +extern void ResetMachine (void); +Boolean ReadInternalRegister (int regno, LispObj* val); +Boolean WriteInternalRegister (int regno, LispObj* val); +extern void SendInterruptToEmulator (void); +extern void SendInterruptToLifeSupport (void); + +extern void InstructionSequencer (void); +extern void OutOfMemory(char *Where, int HowMuch); +extern void StackCacheScrollDown (void); +extern void StackCacheScrollUp (void); +extern int WriteVirtualMemoryBlock (Integer vma, LispObj *object, int count); +extern int ReadVirtualMemoryBlock (Integer vma, LispObj *object, int count); +extern int WriteVirtualMemory (Integer vma, LispObj *object); +extern int ReadVirtualMemory (Integer vma, LispObj *object); + +typedef enum _MemoryCycleTypes +{ + CycleDataRead, + CycleDataWrite, + CycleBindRead, + CycleBindWrite, + CycleBindReadNoMonitor, + CycleBindWriteNoMonitor, + CycleHeader, + CycleStructureOffset, + CycleScavenge, + CycleCdr, + CycleGCCopy, + CycleRaw, + CycleRawTranslate +} MemoryCycleTypes; + +#define MemoryActionIndirect 01 +#define MemoryActionMonitor 02 +#define MemoryActionTransport 04 +#define MemoryActionTrap 010 +#define MemoryActionTransform 020 +#define MemoryActionBinding 040 + +extern Byte MemoryActionTable[12][64]; +extern Integer MemoryReadInternal (Integer vma, LispObj *object, Byte row[]); +extern int StoreContentsInternal (Integer vma, LispObj *object, Byte row[]); + +#define MemoryRead(vma, object, cycle) MemoryReadInternal(vma, object, MemoryActionTable[cycle]) +#define MemoryReadData(vma, object) MemoryReadInternal(vma, object, MemoryActionTable[CycleDataRead]) +#define MemoryReadHeader(vma, object) MemoryReadInternal(vma, object, MemoryActionTable[CycleHeader]) +#define MemoryReadCdr(vma, object) MemoryReadInternal(vma, object, MemoryActionTable[CycleCdr]) +#define StoreContents(vma, object, cycle) StoreContentsInternal(vma, object, MemoryActionTable[cycle]) + +#endif diff --git a/c-emulator/initialization.c b/c-emulator/initialization.c new file mode 100644 index 0000000..a4b940a --- /dev/null +++ b/c-emulator/initialization.c @@ -0,0 +1,241 @@ +/* -*- Mode:C -*- */ + +#include +#include +#include + +#include "emulator.h" +#include "ivory.h" +#include "memory.h" + +static Boolean allocatedCaches = FALSE; +volatile int run = 1; +extern int suspend; + +static void quit_handler (int number) +{ + suspend = 1; + run = 0; +} + +static ProcessorState ps; + +ProcessorState *processor = &ps; + +Boolean Runningp (void) +{ + return run; +} + +void HaltMachine (void) +{ + if (Runningp()) { + suspend = 1; + } +} + +void ResetMachine (void) +{ } + +void StartMachine (void) +{ + run = 1; + suspend = 0; +} + +Boolean IvoryProcessorSystemStartup (Boolean bootingP) +{ LispObj q; + if (bootingP) { + InitializeIvoryProcessor (MapVirtualAddressData (0), MapVirtualAddressTag (0)); + if ((!ReadVirtualMemory(0xf8041002L, &q) && (LispObjTag(q) == TypeCompiledFunction)) || +#ifndef MINIMA + (!ReadVirtualMemory(0xf8041102L, &q) && (LispObjTag(q) == TypeCompiledFunction)) +#else + (!ReadVirtualMemory(0xf8041100L, &q) && (LispObjTag(q) == TypeCompiledFunction)) +#endif + ) { + processor->fp[0].TAG = 0xc0 | TypeEvenPC; + processor->fp[0].DATA.u = LispObjData(q); + } + else return (FALSE); + } + ResetMachine(); + /* Pop our two fake frames */ + PopOneFakeFrame(); + PopOneFakeFrame(); + StartMachine(); + return (TRUE); +} + +void PushOneFakeFrame () +{ + LispObj *fp; + fp = processor->sp + 1; + fp[0] = processor->continuation; + fp[0].TAG |= 0xc0; + fp[1].TAG = 0xc0 | TypeFixnum; + fp[1].DATA.u = processor->control; + processor->control = 0; + WriteControlArgumentSize(processor->control, 2); + WriteControlCallerFrameSize(processor->control, fp - processor->fp); + processor->continuation = processor->pc; + processor->fp = fp; + processor->sp = fp + 1; +} + +void PopOneFakeFrame () +{ + LispObj *fp; + fp = processor->fp; + processor->sp = fp - 1; + processor->fp = fp - ReadControlCallerFrameSize(processor->control); + processor->pc = processor->continuation; + processor->continuation = fp[0]; + processor->control = fp[1].DATA.u; + processor->lp = processor->fp + ReadControlArgumentSize (processor->control); +} + +void InitializeIvoryProcessor (Integer *dataBase, Tag *tagsBase) +{ + LispObj *p, **q; + int i, j; + + if (!allocatedCaches) { + processor->InstructionCache = (InstructionCacheLine *) malloc (sizeof (InstructionCacheLine) * InstructionCacheSize); + if (!processor->InstructionCache) + OutOfMemory("Initialize InstructionCache", sizeof (InstructionCacheLine) * InstructionCacheSize); + processor->StackCache = (LispObj *) malloc (sizeof (LispObj) * PageSize * StackCacheSize); + if (!processor->StackCache) + OutOfMemory("Initialize StackCache", sizeof (LispObj) * PageSize * StackCacheSize); + processor->StackCacheLimit = processor->StackCache + PageSize*StackCacheSize - 128; + allocatedCaches = TRUE; + } + + processor->running = 0; + processor->instruction_count = 0; + + for (i = 0; i < InstructionCacheSize; i+=2) + { + processor->InstructionCache[i].pc.TAG = TypeEvenPC; + processor->InstructionCache[i].pc.DATA.u = -1; + processor->InstructionCache[i+1].pc.TAG = TypeOddPC; + processor->InstructionCache[i+1].pc.DATA.u = -1; + } + + processor->StackCacheBase = 0xf8000100; + for (i = 0; i < PageSize*StackCacheSize; i++) + { + processor->StackCache[i].TAG = TypeNull; + processor->StackCache[i].DATA.u = processor->StackCacheBase + i; + } + + processor->fp = processor->StackCache + 4; + processor->sp = processor->StackCache + 5; + processor->lp = processor->StackCache + 6; + processor->control = 0; + WriteControlArgumentSize (processor->control, 2); + WriteControlCallerFrameSize (processor->control, 2); + WriteControlTrapMode (processor->control, TrapModeFEP); + processor->pc.TAG = 0xc0 | TypeNIL; + processor->pc.DATA.u = 0; + processor->continuation = processor->pc; + + /* + * Push initial frames: These are a lie, they will be popped when you + * start, so that the "continuation" at 4 becomes the PC. The + * continuation and control for the running frame are NIL and 0, + * respectively, thus returning from that frame will not adjust the FP + * and the sequencer will know to halt on seeing NIL as a PC. + */ + PushOneFakeFrame (); + PushOneFakeFrame (); + + EnsureVirtualAddressRange (0xf8000100, 0xf00); /* 0xf8000100 - 0xf8001000 */ + EnsureVirtualAddressRange (0xf8062000, 0x9e000); /* 0xf8062000 - 0xf8100000 */ +} + +void OutOfMemory(char *Where, int HowMuch) +{ + fprintf(stderr, "%s was unable to allocate %ld bytes.\n", Where, HowMuch); + exit(-1); +} + +Boolean ReadInternalRegister (int regno, LispObj *val) +{ + switch (regno) + { + case InternalRegisterFP: + val->TAG = TypeLocative; + val->DATA.u = processor->StackCacheBase + (processor->fp - processor->StackCache); + break; + + case InternalRegisterLP: + val->TAG = TypeLocative; + val->DATA.u = processor->StackCacheBase + (processor->lp - processor->StackCache); + break; + + case InternalRegisterSP: + val->TAG = TypeLocative; + val->DATA.u = processor->StackCacheBase + (processor->sp - processor->StackCache); + break; + + case InternalRegisterBAR0: case InternalRegisterBAR1: + case InternalRegisterBAR2: case InternalRegisterBAR3: + *val = processor->bar[ldb(2,7,regno)].address; + break; + + case InternalRegisterContinuation: + *val = processor->continuation; + break; + + case InternalRegisterControlRegister: + val->TAG = TypeFixnum; + val->DATA.u = processor->control; + break; + + default: + return (FALSE); + } + + return (TRUE); +} + +Boolean WriteInternalRegister (int regno, LispObj* val) +{ + switch (regno) + { + case InternalRegisterFP: + processor->fp = processor->StackCache + (val->DATA.u - processor->StackCacheBase); + while (processor->fp < processor->StackCache) + StackCacheScrollDown(); + while (processor->fp > processor->StackCacheLimit) + StackCacheScrollUp(); + break; + + case InternalRegisterSP: + processor->sp = processor->StackCache + (val->DATA.u - processor->StackCacheBase); + break; + + case InternalRegisterLP: + processor->lp = processor->StackCache + (val->DATA.u - processor->StackCacheBase); + break; + + case InternalRegisterBAR0: case InternalRegisterBAR1: + case InternalRegisterBAR2: case InternalRegisterBAR3: + processor->bar[ldb(2,7,regno)].address = *val; + break; + + case InternalRegisterContinuation: + processor->continuation = *val; + break; + + case InternalRegisterControlRegister: + processor->control = val->DATA.u; + break; + + default: + return (FALSE); + } + + return (TRUE); +} diff --git a/c-emulator/ivory.h b/c-emulator/ivory.h new file mode 100644 index 0000000..13ef21b --- /dev/null +++ b/c-emulator/ivory.h @@ -0,0 +1,658 @@ +/* -*- Mode:C -*- */ + +/**** Ivory architectural definitions ****/ + +#include "emulator.h" + +#ifndef _IVORY_H +#define _IVORY_H + +#define AddressNIL 0xf8041200 +#define AddressT 0xf8041208 + +typedef enum _IvoryType +{ + /* Headers, special markers, and forwarding pointers. */ + TypeNull, /* 00 Unbound variable/function, uninitialized storage */ + TypeMonitorForward, /* 01 This cell being monitored */ + TypeHeaderP, /* 02 Structure header, with pointer field */ + TypeHeaderI, /* 03 Structure header, with immediate bits */ + TypeExternalValueCellPointer, /* 04 Invisible except for binding */ + TypeOneQForward, /* 05 Invisible pointer (forwards one cell) */ + TypeHeaderForward, /* 06 Invisible pointer (forwards whole structure) */ + TypeElementForward, /* 07 Invisible pointer in element of structure */ + /* Numeric data types. */ + TypeFixnum, /* 10 Small integer */ + TypeSmallRatio, /* 11 Ratio with small numerator and denominator */ + TypeSingleFloat, /* 12 SinglePrecision floating point */ + TypeDoubleFloat, /* 13 DoublePrecision floating point */ + TypeBignum, /* 14 Big integer */ + TypeBigRatio, /* 15 Ratio with big numerator or denominator */ + TypeComplex, /* 16 Complex number */ + TypeSpareNumber, /* 17 A number to the hardware trap mechanism */ + /* Instance data types. */ + TypeInstance, /* 20 Ordinary instance */ + TypeListInstance, /* 21 Instance that masquerades as a cons */ + TypeArrayInstance, /* 22 Instance that masquerades as an array */ + TypeStringInstance, /* 23 Instance that masquerades as a string */ + /* Primitive data types. */ + TypeNIL, /* 24 The symbol NIL */ + TypeList, /* 25 A cons */ + TypeArray, /* 26 An array that is not a string */ + TypeString, /* 27 A string */ + TypeSymbol, /* 30 A symbol other than NIL */ + TypeLocative, /* 31 Locative pointer */ + TypeLexicalClosure, /* 32 Lexical closure of a function */ + TypeDynamicClosure, /* 33 Dynamic closure of a function */ + TypeCompiledFunction, /* 34 Compiled code */ + TypeGenericFunction, /* 35 Generic function (see later section) */ + TypeSparePointer1, /* 36 Spare */ + TypeSparePointer2, /* 37 Spare */ + TypePhysicalAddress, /* 40 Physical address */ + TypeSpareImmediate1, /* 41 Spare */ + TypeBoundLocation, /* 42 Deep bound marker */ + TypeCharacter, /* 43 Common Lisp character object */ + TypeLogicVariable, /* 44 Unbound logic variable marker */ + TypeGCForward, /* 45 ObjectMoved flag for garbage collector */ + TypeEvenPC, /* 46 PC at first instruction in word */ + TypeOddPC, /* 47 PC at second instruction in word */ + /* FullWord instructions. */ + TypeCallCompiledEven, /* 50 Start call, address is compiled function */ + TypeCallCompiledOdd, /* 51 Start call, address is compiled function */ + TypeCallIndirect, /* 52 Start call, address is function cell */ + TypeCallGeneric, /* 53 Start call, address is generic function */ + TypeCallCompiledEvenPrefetch, /* 54 Like above, but prefetching is desireable */ + TypeCallCompiledOddPrefetch, /* 55 Like above, but prefetching is desireable */ + TypeCallIndirectPrefetch, /* 56 Like above, but prefetching is desireable */ + TypeCallGenericPrefetch, /* 57 Like above, but prefetching is desireable */ + /* HalfWord (packed) instructions consume 4 bits of data type field (opcodes 60..77). */ + TypePackedInstruction60, TypePackedInstruction61, TypePackedInstruction62, + TypePackedInstruction63, TypePackedInstruction64, TypePackedInstruction65, + TypePackedInstruction66, TypePackedInstruction67, TypePackedInstruction70, + TypePackedInstruction71, TypePackedInstruction72, TypePackedInstruction73, + TypePackedInstruction74, TypePackedInstruction75, TypePackedInstruction76, + TypePackedInstruction77 +} IvoryType; + +typedef enum _IvoryCdr +{ + CdrNext, + CdrNil, + CdrNormal +} IvoryCdr; + +#define TagTypeMask 077 +#define TagCdrMask 0300 +#define TagType(tag) ((tag) & 077) +#define TagCdr(tag) ((tag) >> 6) +#define SetTagCdr(tag,cdr) ((tag) | (cdr) << 6) +#define MergeCdr(cdr,type) (((cdr)&TagCdrMask)|((type)&TagTypeMask)) +#define TypeEqualP(tag1,tag2) ((((tag1) ^ (tag2)) & TagTypeMask) == 0) +#define TypeFixnumP(tag) TypeEqualP(tag,TypeFixnum) +#define TypeNumericP(tag) (((tag) & 070) == 010) +#define TypeArrayP(tag) (((tag) & 076) == (TypeArray & 076)) +#define TypeSpareP(tag) (((tag) & 076) == (TypeSparePointer1 & 076) || ((tag) & TagTypeMask) == TypeSpareImmediate1 || ((tag) & TagTypeMask) == TypeSpareNumber) +#define PackedInstructionP(tag) (((tag) & 060) == 060) +#define BinaryTypeFixnumP(tag1,tag2) (((((tag1) ^ TypeFixnum) | ((tag2) ^ TypeFixnum)) & TagTypeMask) == 0) +#define BinaryTypeNumericP(tag1,tag2) (((tag1) & 070) == 010 && ((tag2) & 070) == 010) + +#if (LONG_BIT == 64) +extern const LispObj ObjectCdrMask; +#define StoreCdrNext(dest,source) ((dest).whole = (source).whole&(~ObjectCdrMask.whole)) +#define ObjectEqP(a,b) ((((a).whole^(b).whole)&(~ObjectCdrMask.whole))==0) +#else +#define StoreCdrNext(dest,source) { (dest).TAG = (source).TAG&TagTypeMask; (dest).DATA = (source).DATA; } +#define ObjectEqP(a,b) (((a).DATA == (b).DATA) && TypeEqualP((a).TAG,(b).TAG)) +#endif + +extern const LispObj ObjectT; +extern const LispObj ObjectNIL; + +#define ArrayHeaderTag (0100 | TypeHeaderI) + +typedef enum _ArrayElementType +{ + ArrayElementTypeFixnum, + ArrayElementTypeCharacter, + ArrayElementTypeBoolean, + ArrayElementTypeObject +} ArrayElementType; + +#define ArrayLongPrefixP(a) (a&(1<<23)) +#define ArrayShortLength(a) (ldb(15,0,a)) +#define ArrayBytePacking(a) (ldb(3,27,a)) +#define ArrayElementType(a) ((ArrayElementType)ldb(2,30,a)) +#define ArrayLeaderLength(a) (ldb(8,15,a)) + +#define ArrayRegisterByteOffset(r) (ldb(5,22,r)) +#define ArrayRegisterEventCount(r) (ldb(22,0,r)) +/* Stores event count, clearing byte offset */ +#define SetArrayRegisterEventCount(c,r) (dpb(ldb(22,0,c),27,0,r)) + +#define BytePackingSize(b) (32>>(b)) +#define BytePackingRotation(b,i) (((~(-1<<(b)))&(i))<<(5-(b))) +#define ArrayElementLdb(b,i,w) (ldb(BytePackingSize(b),BytePackingRotation(b,i),w)) +#define ArrayElementDpb(e,b,i,w) (dpb(e,BytePackingSize(b),BytePackingRotation(b,i),w)) + +/* --- bad idea? +typedef union _IvoryArrayHeader +{ + unsigned int header; + struct { + unsigned int pad0:15; + unsigned int length:8; + } leader; + struct { + unsigned int pad0:25; + unsigned int named:1; + unsigned int list:1; + unsigned int packing:3; + unsigned int element:2; + } type; + struct { + unsigned int dimensions:3; + unsigned int spare:10; + unsigned int displaced:1; + unsigned int discontiguous:1; + unsigned int pad0:8; + unsigned int prefix:1; + } longarray; + struct { + unsigned int length:15; + } shortarray; +} IvoryArrayHeader; +*/ + +typedef enum _IvoryValueDisposition +{ + ValueDispositionEffect, + ValueDispositionValue, + ValueDispositionReturn, + ValueDispositionMultiple +} IvoryValueDisposition; + +typedef enum _IvoryOpcode +{ + /* List manipulation */ + OpcodeCar = 00, + OpcodeCdr = 01, + OpcodeSetToCar = 0140, + OpcodeSetToCdr = 0141, + OpcodeSetToCdrPushCar = 0142, + OpcodeRplaca = 0200, + OpcodeRplacd = 0201, + OpcodeRgetf = 0225, + OpcodeMember = 0226, + OpcodeAssoc = 0227, + /* AI Instructions */ + OpcodeDereference = 013, + OpcodeUnify = 0237, + OpcodePushLocalLogicVariables = 0103, + OpcodePushGlobalLogicVariable = 055, + OpcodeLogicTailTest = 014, + /* Binary predicates */ + OpcodeEq = 0270, + OpcodeEqNoPop = 0274, + OpcodeEql = 0263, + OpcodeEqlNoPop = 0267, + OpcodeEqualNumber = 0260, + OpcodeEqualNumberNoPop = 0264, + OpcodeGreaterp = 0262, + OpcodeGreaterpNoPop = 0266, + OpcodeLessp = 0261, + OpcodeLesspNoPop = 0265, + OpcodeLogtest = 0273, + OpcodeLogtestNoPop = 0277, + OpcodeTypeMember = 040, /* 41, 42, 43 */ + OpcodeTypeMemberNoPop = 044, /* 45, 46, 47 */ + /* Unary predicates */ + OpcodeEndp = 02, + OpcodePlusp = 036, + OpcodeMinusp = 035, + OpcodeZerop = 034, + /* Numeric operations */ + OpcodeAdd = 0300, + OpcodeSub = 0301, + OpcodeUnaryMinus = 0114, + OpcodeIncrement = 0143, + OpcodeDecrement = 0144, + OpcodeMultiply = 0202, + OpcodeQuotient = 0203, + OpcodeCeiling = 0204, + OpcodeFloor = 0205, + OpcodeTruncate = 0206, + OpcodeRound = 0207, + OpcodeRationalQuotient = 0211, + OpcodeMax = 0213, + OpcodeMin = 0212, + OpcodeLogand = 0215, + OpcodeLogior = 0217, + OpcodeLogxor = 0216, + OpcodeAsh = 0232, + OpcodeRot = 0220, + OpcodeLsh = 0221, + Opcode32BitPlus = 0302, + Opcode32BitDifference = 0303, + OpcodeMultiplyDouble = 0222, + OpcodeAddBignumStep = 0304, + OpcodeSubBignumStep = 0305, + OpcodeMultiplyBignumStep = 0306, + OpcodeDivideBignumStep = 0307, + OpcodeLshcBignumStep = 0223, + /* Data movement */ + OpcodePush = 0100, + OpcodePop = 0340, + OpcodeMovem = 0341, + OpcodePushNNils = 0101, + OpcodePushAddress = 0150, + OpcodeSetSpToAddress = 0151, + OpcodeSetSpToAddressSaveTos = 0152, + OpcodePushAddressSpRelative = 0102, + OpcodeStackBlt = 0224, + OpcodeStackBltAddress = 0352, + /* FieldExtraction instructions */ + OpcodeLdb = 0170, + OpcodeDpb = 0370, + OpcodeCharLdb = 0171, + OpcodeCharDpb = 0371, + OpcodePLdb = 0172, + OpcodePDpb = 0372, + OpcodePTagLdb = 0173, + OpcodePTagDpb = 0373, + /* Array operations */ + OpcodeAref1 = 0312, + OpcodeAset1 = 0310, + OpcodeAloc1 = 0313, + OpcodeSetup1DArray = 03, + OpcodeSetupForce1DArray = 04, + OpcodeFastAref1 = 0350, + OpcodeFastAset1 = 0351, + OpcodeArrayLeader = 0316, + OpcodeStoreArrayLeader = 0314, + OpcodeAlocLeader = 0317, + /* Branch instructions */ + OpcodeBranch = 0174, + OpcodeBranchTrue = 060, + OpcodeBranchTrueElseExtraPop = 061, + OpcodeBranchTrueAndExtraPop = 062, + OpcodeBranchTrueExtraPop = 063, + OpcodeBranchTrueNoPop = 064, + OpcodeBranchTrueAndNoPop = 065, + OpcodeBranchTrueElseNoPop = 066, + OpcodeBranchTrueAndNoPopElseNoPopExtraPop = 067, + OpcodeBranchFalse = 070, + OpcodeBranchFalseElseExtraPop = 071, + OpcodeBranchFalseAndExtraPop = 072, + OpcodeBranchFalseExtraPop = 073, + OpcodeBranchFalseNoPop = 074, + OpcodeBranchFalseAndNoPop = 075, + OpcodeBranchFalseElseNoPop = 076, + OpcodeBranchFalseAndNoPopElseNoPopExtraPop = 077, + OpcodeLoopDecrementTos = 0175, + OpcodeLoopIncrementTosLessThan = 0375, + /* Block instructions */ + OpcodeBlock0Read = 0120, + OpcodeBlock1Read = 0121, + OpcodeBlock2Read = 0122, + OpcodeBlock3Read = 0123, + OpcodeBlock0ReadShift = 0124, + OpcodeBlock1ReadShift = 0125, + OpcodeBlock2ReadShift = 0126, + OpcodeBlock3ReadShift = 0127, + OpcodeBlock0ReadAlu = 0160, + OpcodeBlock1ReadAlu = 0161, + OpcodeBlock2ReadAlu = 0162, + OpcodeBlock3ReadAlu = 0163, + OpcodeBlock0ReadTest = 0130, + OpcodeBlock1ReadTest = 0131, + OpcodeBlock2ReadTest = 0132, + OpcodeBlock3ReadTest = 0133, + OpcodeBlock0Write = 030, + OpcodeBlock1Write = 031, + OpcodeBlock2Write = 032, + OpcodeBlock3Write = 033, + /* Function calling */ + OpcodeStartCall = 010, + OpcodeFinishCallN = 0134, + OpcodeFinishCallNApply = 0135, + OpcodeFinishCallTos = 0136, + OpcodeFinishCallTosApply = 0137, + OpcodeEntryRestAccepted = 0176, + OpcodeEntryRestNotAccepted = 0177, + OpcodeLocateLocals = 050, + OpcodeReturnSingle = 0115, + OpcodeReturnMultiple = 0104, + OpcodeReturnKludge = 0105, + OpcodeTakeValues = 0106, + /* Binding instructions */ + OpcodeBindLocativeToValue = 0236, + OpcodeBindLocative = 05, + OpcodeUnbindN = 0107, + OpcodeRestoreBindingStack = 06, + /* Catch */ + OpcodeCatchOpen = 0376, + OpcodeCatchClose = 051, + /* Lexical variables - Each takes 8 opcodes */ + OpcodePushLexicalVar = 020, /* 21 22 23 24 25 26 27 */ + OpcodePopLexicalVar = 0240, /* 241 242 243 244 245 246 247 */ + OpcodeMovemLexicalVar = 0250, /* 251 252 253 254 255 256 257 */ + /* Instance variables */ + OpcodePushInstanceVariable = 0110, + OpcodePopInstanceVariable = 0320, + OpcodeMovemInstanceVariable = 0321, + OpcodePushAddressInstanceVariable = 0111, + OpcodePushInstanceVariableOrdered = 0112, + OpcodePopInstanceVariableOrdered = 0322, + OpcodeMovemInstanceVariableOrdered = 0323, + OpcodePushAddressInstanceVariableOrdered = 0113, + OpcodeInstanceRef = 0324, + OpcodeInstanceSet = 0325, + OpcodeInstanceLoc = 0326, + /* Subprimitives */ + OpcodeEphemeralp = 07, + OpcodeUnsignedLessp = 0331, + OpcodeUnsignedLesspNoPop = 0335, + OpcodeAlu = 0214, + OpcodeAllocateListBlock = 0311, + OpcodeAllocateStructureBlock = 0315, + OpcodePointerPlus = 0230, + OpcodePointerDifference = 0231, + OpcodePointerIncrement = 0145, + OpcodeReadInternalRegister = 0154, + OpcodeWriteInternalRegister = 0155, + OpcodeCoprocessorRead = 0156, + OpcodeCoprocessorWrite = 0157, + OpcodeMemoryRead = 0116, + OpcodeMemoryReadAddress = 0117, + OpcodeTag = 012, + OpcodeSetTag = 0327, + OpcodeStoreConditional = 0233, + OpcodeMemoryWrite = 0234, + OpcodePStoreContents = 0235, + OpcodeSetCdrCode1 = 0146, + OpcodeSetCdrCode2 = 0147, + OpcodeMergeCdrNoPop = 0342, + OpcodeGenericDispatch = 052, + OpcodeMessageDispatch = 053, + OpcodeJump = 011, + OpcodeCheckPreemptRequest = 054, + OpcodeNoOp = 056, + OpcodeHalt = 057 +} IvoryOpcode; + +typedef enum _IvoryTrapMode +{ + TrapModeEmulator, + TrapModeExtraStack, + TrapModeIO, + TrapModeFEP +} IvoryTrapMode; + +#define ReadControlArgumentSize(c) ldb(8,0,c) +#define ReadControlExtraArgument(c) ldb(1,8,c) +#define ReadControlCallerFrameSize(c) ldb(8,9,c) +#define ReadControlApply(c) ldb(1,17,c) +#define ReadControlValueDisposition(c) ldb(2,18,c) +#define ReadControlCleanupBits(c) ldb(3,24,c) +#define ReadControlCleanupCatch(c) ldb(1,26,c) +#define ReadControlCleanupBindings(c) ldb(1,25,c) +#define ReadControlTrapOnExit(c) ldb(1,24,c) +#define ReadControlTrapMode(c) ldb(2,30,c) +#define ReadControlCallStarted(c) ldb(1,22,c) +#define ReadControlCleanupInProgress(c) ldb(1,23,c) +#define ReadControlInstructionTrace(c) ldb(1,29,c) +#define ReadControlCallTrace(c) ldb(1,28,c) +#define ReadControlTracePending(c) ldb(1,27,c) + +#define ControlApply 0400000 +#define ControlCleanupBits 0700000000 +#define ControlTraceBits 07000000000 +#define ControlCallStarted 020000000 +#define ControlExtraArgument 0400 +#define ControlArgumentSize 0377 +#define ControlCallerFrameSize 0377000 +#define ControlValueDisposition 03000000 + +#define WriteControlArgumentSize(c,x) (c = dpb(x,8,0,c)) +#define WriteControlExtraArgument(c,x) (c = dpb(x,1,8,c)) +#define WriteControlCallerFrameSize(c,x) (c = dpb(x,8,9,c)) +#define WriteControlApply(c,x) (c = dpb(x,1,17,c)) +#define WriteControlValueDisposition(c,x) (c = dpb(x,2,18,c)) +#define WriteControlCleanupBits(c,x) (c = dpb(x,3,24,c)) +#define WriteControlCleanupCatch(c,x) (c = dpb(x,1,26,c)) +#define WriteControlCleanupBindings(c,x) (c = dpb(x,1,25,c)) +#define WriteControlTrapOnExit(c,x) (c = dpb(x,1,24,c)) +#define WriteControlTrapMode(c,x) (c = dpb(x,2,30,c)) +#define WriteControlCallStarted(c,x) (c = dpb(x,1,22,c)) +#define WriteControlCleanupInProgress(c,x) (c = dpb(x,1,23,c)) +#define WriteControlInstructionTrace(c,x) (c = dpb(x,1,29,c)) +#define WriteControlCallTrace(c,x) (c = dpb(x,1,28,c)) +#define WriteControlTracePending(c,x) (c = dpb(x,1,27,c)) + +typedef enum _InternalRegisters +{ + InternalRegisterEA = 00, + InternalRegisterFP = 01, + InternalRegisterLP = 02, + InternalRegisterSP = 03, + InternalRegisterMacroSP = 04, + InternalRegisterStackCacheLowerBound = 05, + InternalRegisterBAR0 = 06, + InternalRegisterBAR1 = 0206, + InternalRegisterBAR2 = 0406, + InternalRegisterBAR3 = 0606, + InternalRegisterPHTHash0 = 07, + InternalRegisterPHTHash1 = 0207, + InternalRegisterPHTHash2 = 0407, + InternalRegisterPHTHash3 = 0607, + InternalRegisterEPC = 010, + InternalRegisterDPC = 011, + InternalRegisterContinuation = 012, + InternalRegisterAluAndRotateControl = 013, + InternalRegisterControlRegister = 014, + InternalRegisterCRArgumentSize = 015, + InternalRegisterEphemeralOldspaceRegister = 016, + InternalRegisterZoneOldspaceRegister = 017, + InternalRegisterChipRevision = 020, + InternalRegisterFPCoprocessorPresent = 021, + InternalRegisterPreemptRegister = 023, + InternalRegisterIcacheControl = 024, + InternalRegisterPrefetcherControl = 025, + InternalRegisterMapCacheControl = 026, + InternalRegisterMemoryControl = 027, + InternalRegisterECCLog = 030, + InternalRegisterECCLogAddress = 031, + InternalRegisterInvalidateMap0 = 032, + InternalRegisterInvalidateMap1 = 0232, + InternalRegisterInvalidateMap2 = 0432, + InternalRegisterInvalidateMap3 = 0632, + InternalRegisterLoadMap0 = 033, + InternalRegisterLoadMap1 = 0233, + InternalRegisterLoadMap2 = 0433, + InternalRegisterLoadMap3 = 0633, + InternalRegisterStackCacheOverflowLimit = 034, + InternalRegisterUcodeROMContents = 035, + InternalRegisterAddressMask = 037, + InternalRegisterEntryMaximumArguments = 040, + InternalRegisterLexicalVariable = 041, + InternalRegisterInstruction = 042, + InternalRegisterMemoryData = 044, + InternalRegisterDataPins = 045, + InternalRegisterExtensionRegister = 046, + InternalRegisterMicrosecondClock = 047, + InternalRegisterArrayHeaderLength = 050, + InternalRegisterLoadBAR0 = 052, + InternalRegisterLoadBAR1 = 0252, + InternalRegisterLoadBAR2 = 0452, + InternalRegisterLoadBAR3 = 0652, + InternalRegisterTOS = 01000, + InternalRegisterEventCount = 01001, + InternalRegisterBindingStackPointer = 01002, + InternalRegisterCatchBlockList = 01003, + InternalRegisterControlStackLimit = 01004, + InternalRegisterControlStackExtraLimit = 01005, + InternalRegisterBindingStackLimit = 01006, + InternalRegisterPHTBase = 01007, + InternalRegisterPHTMask = 01010, + InternalRegisterCountMapReloads = 01011, + InternalRegisterListCacheArea = 01012, + InternalRegisterListCacheAddress = 01013, + InternalRegisterListCacheLength = 01014, + InternalRegisterStructureCacheArea = 01015, + InternalRegisterStructureCacheAddress = 01016, + InternalRegisterStructureCacheLength = 01017, + InternalRegisterDynamicBindingCacheBase = 01020, + InternalRegisterDynamicBindingCacheMask = 01021, + InternalRegisterChoicePointer = 01022, + InternalRegisterStructureStackChoicePointer = 01023, + InternalRegisterFEPModeTrapVectorAddress = 01024, + InternalRegisterMappingTableCache = 01026, + InternalRegisterMappingTableLength = 01027, + InternalRegisterStackFrameMaximumSize = 01030, + InternalRegisterStackCacheDumpQuantum = 01031, + InternalRegisterConstantNIL = 01040, + InternalRegisterConstantT = 01041 +} InternalRegisters; + +typedef enum _CoprocessorRegisters +{ + CoprocessorRegisterMicrosecondClock = 01002 +} CoprocessorRegisters; + +#define TrapVectorBase 0xf8040000 + +typedef enum _TrapVectors +{ + ArithmeticInstructionExceptionVector = 0, + InstructionExceptionVector = 04000, + InterpreterFunctionVector = 04400, + GenericDispatchVector = 05000, + + ErrorTrapVector = 05100, + ResetTrapVector = 05101, + PullApplyArgsTrapVector = 05102, + StackOverflowTrapVector = 05103, + TraceTrapVector = 05104, + PreemptRequestTrapVector = 05105, + TransportTrapVector = 05106, + FepModeTrapVector = 05107, + + LowPrioritySequenceBreakTrapVector = 05110, + HighPrioritySequenceBreakTrapVector = 05111, + MonitorTrapVector = 05112, + /* 05113 = Reserved */ + GenericDispatchTrapVector = 05114, + /* 05115 = Reserved */ + MessageDispatchTrapVector = 05116, + /* 05117 = Reserved */ + + PageNotResidentTrapVector = 05120, + PageFaultRequestTrapVector = 05121, + PageWriteFaultTrapVector = 05122, + UncorrectableMemoryErrorTrapVector = 05123, + MemoryBusErrorTrapVector = 05124, + DBCacheMissTrapVector = 05125, + DBUnwindFrameTrapVector = 05126, + DBUnwindCatchTrapVector = 05127 +} TrapVectors; + +/* ALU */ + +#define ReadALUCondition(a) ((ALUCondition)ldb(5,16,a)) +#define ReadALUConditionSense(a) (!ldb(1,21,a)) +#define ReadALUOutputCondition(a) ldb(1,22,a) +#define ReadALUEnableConditionException(a) ldb(1,23,a) +#define ReadALUEnableLoadCin(a) ldb(1,24,a) +#define ReadALUFunctionClass(a) (ALUFunctionClass[ldb(2,14,a)]) + +#define ReadALUBooleanFunction(a) ((ALUBooleanFunction)ldb(4,10,a)) + +#define ReadALUByteRotate(a) ldb(5,0,a) +#define ReadALUByteSize(a) ldb(5,5,a) +#define ReadALUByteBackground(a) ((ALUByteBackground)ldb(2,10,a)) +#define ReadALUByteRotateLatch(a) ldb(1,12,a) +#define ReadALUByteFunction(a) ((ALUByteFunction)ldb(1,13,a)) + +#define ReadALUAdderCarryIn(a) ldb(1,10,a) +#define ReadALUAdderOp2(a) ((ALUAdderOp2)ldb(2,11,a)) + +typedef enum _ALUBooleanFunction +{ + BooleClear, + BooleAnd, + BooleAndC1, + Boole2, + BooleAndC2, + Boole1, + BooleXor, + BooleIor, + BooleNor, + BooleEquiv, + BooleC1, + BooleOrC1, + BooleC2, + BooleOrC2, + BooleNand, + BooleSet +} ALUBooleanFunction; + +typedef enum _ALUByteBackground +{ + ALUByteBackgroundOp1, + ALUByteBackgroundRotateLatch, + ALUByteBackgroundZero +} ALUByteBackground; + +typedef enum _ALUByteFunction +{ + ALUByteFunctionDpb, + ALUByteFunctionLdb +} ALUByteFunction; + +typedef enum _ALUAdderOp2 +{ + ALUAdderOp2Op2, + ALUAdderOp2Zero, + ALUAdderOp2Invert, + ALUAdderOp2MinusOne +} ALUAdderOp2; + +typedef enum _ALUCondition +{ + ConditionSignedLessThanOrEqual, + ConditionSignedLessThan, + ConditionNegative, + ConditionSignedOverflow, + ConditionUnsignedLessThanOrEqual, + ConditionUnsignedLessThan, + ConditionZero, + ConditionHigh25Zero, + ConditionEq, + ConditionOp1Ephemeralp, + ConditionOp1TypeAcceptable, + ConditionOp1TypeCondition, + ConditionResultTypeNil, + ConditionOp2Fixnum, + ConditionFalse, + ConditionResultCdrLow, + ConditionCleanupBitsSet, + ConditionAddressInStackCache, + ConditionPendingSequenceBreakEnabled, + ConditionExtraStackMode, + ConditionFepMode, + ConditionFpCoprocessorPresent, + ConditionOp1Oldspacep, + ConditionStackCacheOverflow, + ConditionOrLogicVariable +} ALUCondition; + +#define PointerDataTypes 0xFFF4FFFFF8F7L +#define PointerTypeP(t) (!(PointerDataTypes&(1< +#include + +#include +#include + +/* --- need a better place */ + +const LispObj ObjectT = { TypeSymbol, AddressT }; +const LispObj ObjectNIL = { TypeNIL, AddressNIL }; +const LispObj ObjectCdrMask = { TagCdrMask, 0 }; + +extern Integer memory_vma; + +/* Superstition says threads go at 1<<32 */ +Tag *TagSpace = (Tag *)((long)2<<32); /* 1<<32 bytes of tages */ +Integer *DataSpace = (Integer *)((long)3<<32); /* 4<<32 bytes of data */ + +/* + --- We know underlying machine uses 8192-byte pages, we have to + create a page at a time, and tags are char (byte) sized, so we have + to create a page of tags at a time + */ + +#define MemoryPageSize 0x2000 +#define MemoryAddressPageShift 13 + +#define MemoryPageNumber(vma) ((vma) >> MemoryAddressPageShift) +#define MemoryPageOffset(vma) ((vma) & (MemoryPageSize - 1)) +#define PageNumberMemory(vpn) ((vpn) << MemoryAddressPageShift) + +/* This could be a sparse array, should someone want to implement it */ +VMAttribute VMAttributeTable[1<<(32-MemoryAddressPageShift)]; + +#define Created(vma) VMExists(VMAttributeTable[MemoryPageNumber(vma)]) +#define SetCreated(vma) (VMAttributeTable[MemoryPageNumber(vma)] = VMCreatedDefault) +#define ClearCreated(vma) (VMAttributeTable[MemoryPageNumber(vma)] = 0) + +/**** Virtual memory system ****/ + +Integer EnsureVirtualAddress (Integer vma) +{ + caddr_t data, tag; + Integer aligned_vma = vma - MemoryPageOffset(vma); + + if (Created(vma)) + return(vma); + + data = (caddr_t)&DataSpace[aligned_vma]; + tag = (caddr_t)&TagSpace[aligned_vma]; + if (data != mmap(data, sizeof(Integer[MemoryPageSize]), PROT_READ|PROT_WRITE, + MAP_ANONYMOUS|MAP_PRIVATE|MAP_FIXED,-1,0)) + punt ("Couldn't map data page at %x for VMA %x", data, vma); + if (tag != mmap(tag, sizeof(Tag[MemoryPageSize]), PROT_READ|PROT_WRITE, + MAP_ANONYMOUS|MAP_PRIVATE|MAP_FIXED,-1,0)) + punt ("Couldn't map tag page at %x for VMA %x", tag, vma); + + SetCreated(vma); + return(vma); +} + +Integer EnsureVirtualAddressRange (Integer vma, int count) +{ + int pages = ceiling(count, MemoryPageSize); + caddr_t data, tag; + Integer aligned_vma = vma - MemoryPageOffset(vma); + int n; + + while (pages) { + n = 0; + while (!Created (vma) && pages) { + n++; + pages--; + SetCreated(vma); + vma += MemoryPageSize; + } + if (n) { + data = (caddr_t)&DataSpace[aligned_vma]; + tag = (caddr_t)&TagSpace[aligned_vma]; + if (data != mmap(data, n * sizeof(Integer[MemoryPageSize]), PROT_READ|PROT_WRITE, + MAP_ANONYMOUS|MAP_PRIVATE|MAP_FIXED,-1,0)) + punt ("Couldn't map %d data pages at %x for VMA %x", n, data, aligned_vma); + if (tag != mmap(tag, n * sizeof(Tag[MemoryPageSize]), PROT_READ|PROT_WRITE, + MAP_ANONYMOUS|MAP_PRIVATE|MAP_FIXED,-1,0)) + punt ("Couldn't map %d tag pages at %x for VMA %x", n, tag, aligned_vma); + aligned_vma += n * MemoryPageSize; + } + while (Created (vma) && pages) { + pages--; + vma += MemoryPageSize; + aligned_vma += MemoryPageSize; + } + } + + return(vma); +} + +Integer DestroyVirtualAddress (Integer vma) +{ + caddr_t data, tag; + Integer aligned_vma = vma - MemoryPageOffset(vma); + + if (!Created(vma)) + return(vma); + + data = (caddr_t)&DataSpace[aligned_vma]; + tag = (caddr_t)&TagSpace[aligned_vma]; + if (munmap(data, sizeof(Integer[MemoryPageSize]))) + punt ("Couldn't unmap data page at %x for VMA %x", data, vma); + if (munmap(tag, sizeof(Tag[MemoryPageSize]))) + punt ("Couldn't unmap tag page at %x for VMA %x", tag, vma); + + ClearCreated(vma); + return(vma); +} + +Integer DestroyVirtualAddressRange (Integer vma, int count) +{ + int pages = ceiling(count, MemoryPageSize); + + for (; pages--; vma += MemoryPageSize) + DestroyVirtualAddress(vma); + + return(vma); +} + + +Integer* MapVirtualAddressData(Integer vma) +{ + return(&DataSpace[vma]); +} + +Tag* MapVirtualAddressTag(Integer vma) +{ + return(&TagSpace[vma]); +} + +int VirtualMemoryRead (Integer vma, LispObj *object) +{ + /* set memory_vma for SEGV handler */ + memory_vma = vma; + + object->DATA.u = DataSpace[vma]; + object->TAG = TagSpace[vma]; + return (0); +} + +int VirtualMemoryWrite (Integer vma, LispObj *object) +{ + /* set memory_vma for SEGV handler */ + memory_vma = vma; + + DataSpace[vma] = object->DATA.u; + TagSpace[vma] = object->TAG; + return (0); +} + +int VirtualMemoryReadBlock (Integer vma, LispObj *object, int count) +{ + Integer *data = &DataSpace[vma]; + Tag *tag = &TagSpace[vma]; + Integer *edata = &DataSpace[vma + count]; + + /* set memory_vma for SEGV handler */ + memory_vma = vma; + + for (; data < edata; object++, memory_vma++) + { + object->DATA.u = *data++; + object->TAG = *tag++; + } + return (0); +} + +int VirtualMemoryWriteBlock (Integer vma, LispObj *object, int count) +{ + Integer *data = &DataSpace[vma]; + Tag *tag = &TagSpace[vma]; + Integer *edata = &DataSpace[vma + count]; + + /* set memory_vma for SEGV handler */ + memory_vma = vma; + + for (; data < edata; object++, memory_vma++) + { + *data++ = object->DATA.u; + *tag++ = object->TAG; + } + return (0); +} + +int VirtualMemoryWriteBlockConstant (Integer vma, LispObj *object, int count, int increment) +{ + Integer *data = &DataSpace[vma]; + Tag *tag = &TagSpace[vma]; + Tag ctag = object->TAG; + Integer cdata = object->DATA.u; + Integer *edata = &DataSpace[vma + count]; + + /* set memory_vma for SEGV handler */ + memory_vma = vma; + + (void)memset((unsigned char *)tag, (unsigned char) ctag, count*sizeof(Tag)); + + switch (increment) + { + case 0: + if (cdata == 0) + (void)memset((unsigned char *)data, (unsigned char) 0, count*sizeof(Integer)); + else + for (; data < edata; *data++ = cdata, memory_vma++); + break; + case 1: + for(; data < edata; *data++ = cdata++, memory_vma++); + break; + default: + for(; data < edata; *data++ = cdata, cdata += increment, memory_vma++); + } + return (0); +} + +/* --- bleah, this probably has to use data-read cycles */ +Boolean VirtualMemorySearch (Integer *vma, LispObj *object, int count) +{ + Tag *tag = &TagSpace[*vma]; + Tag *etag = &TagSpace[*vma + count]; + Tag ctag = object->TAG; + Integer cdata = object->DATA.u; + + for( ; tag < etag; ) + { + tag = (Tag *)memchr((unsigned char *)tag, (unsigned char)ctag, (etag - tag)*sizeof(Tag)); + if (tag == NULL) + return(False); + + /* set memory_vma for SEGV handler */ + memory_vma = tag - TagSpace; + if (DataSpace[memory_vma] == cdata) + { + *vma = memory_vma; + return(True); + } + tag++; + } + return(False); +} + +int VirtualMemoryCopy (Integer from, Integer to, int count, Byte row[]) +{ + Integer *fromdata = &DataSpace[from]; + register Tag *fromtag = &TagSpace[from]; + register Tag *etag = &TagSpace[from + count]; + Integer *todata = &DataSpace[to]; + register Tag *totag = &TagSpace[to]; + LispObj obj; + Tag tag; + int action; + + /* set memory_vma for SEGV handler */ + memory_vma = from; + + if (row == MemoryActionTable[CycleRaw]) + { + (void)memmove((unsigned char *)totag, (unsigned char *)fromtag, count*sizeof(Tag)); + (void)memmove((unsigned char *)todata, (unsigned char *)fromdata, count*sizeof(Integer)); + return(0); + } + + for ( ; fromtag < etag; ) + { + /* Transport takes precedence over anything but trap */ + if ((action = row[tag = *fromtag]) & + (MemoryActionTransport|MemoryActionTrap) == MemoryActionTransport) + { + if (OldspaceAddressP(*fromdata)) + TakeMemoryTrap(TransportTrapVector, *fromdata); + } + + if (action) + { + MemoryReadInternal(fromtag - TagSpace, &obj, row); + *totag++ = obj.TAG; + *todata++ = obj.DATA.u; + fromtag++; + fromdata++; + } + else + { + *totag++ = tag; fromtag++; + *todata++ = *fromdata++; + } + memory_vma++; + } + + return (0); +} + +Boolean VirtualMemoryScan (Integer *vma, int count) +{ + VMAttribute *attr = &VMAttributeTable[MemoryPageNumber(*vma)]; + + for ( ; count > 0; attr++, count -= MemoryPageSize) + { + if (VMTransportFault(*attr)) + { + Integer scanvma = PageNumberMemory(attr - VMAttributeTable); + register Tag *tag = &TagSpace[scanvma]; + register Tag *etag = &TagSpace[scanvma + (MemoryPageSizeAddressRegister); + + return(SetVMReplyResult(vpn, VMExists(VMAttributeTable[vpn]))); + } + + case VMOpcodeCreate: + EnsureVirtualAddressRange(vm->AddressRegister, vm->ExtentRegister); + return(SetVMReplyResult(0, True)); + + case VMOpcodeDestroy: + DestroyVirtualAddressRange(vm->AddressRegister, vm->ExtentRegister); + return(SetVMReplyResult(0, True)); + + case VMOpcodeReadAttributes: + { + VMAttribute attr = VMAttributeTable[VMCommandOperand(command)]; + + if VMExists(attr) + { + vm->AttributesRegister = VMAttributeTable[VMCommandOperand(command)]; + return(SetVMReplyResult(command, True)); + } + else + return(SetVMReplyResult(command, False)); + } + + case VMOpcodeWriteAttributes: + { + VMAttribute attr = VMAttributeTable[VMCommandOperand(command)]; + + if VMExists(attr) + { + /* ensure Lisp doesn't clear exists bit */ + VMAttributeTable[VMCommandOperand(command)] = SetVMExists(vm->AttributesRegister); + return(SetVMReplyResult(command, True)); + } + else + return(SetVMReplyResult(command, False)); + } + + case VMOpcodeFill: + VirtualMemoryWriteBlockConstant(vm->AddressRegister, &vm->DataRegister, + vm->ExtentRegister, VMCommandOperand(command)); + return(SetVMReplyResult(0, True)); + + case VMOpcodeSearch: + { + Boolean result = VirtualMemorySearch(&vm->AddressRegister, &vm->DataRegister, + vm->ExtentRegister); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeCopy: + { + Boolean result = VirtualMemoryCopy(vm->AddressRegister, vm->DestinationRegister, + vm->ExtentRegister, + MemoryActionTable[VMCommandOperand(command)]); + return(SetVMReplyResult(0, result)); + } + case VMOpcodeScan: + { + Boolean result = VirtualMemoryScan(&vm->AddressRegister, vm->ExtentRegister); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeEnable: + { + VirtualMemoryEnable(vm->AddressRegister, vm->ExtentRegister); + return(SetVMReplyResult(0, True)); + } + } +} diff --git a/c-emulator/memory.h b/c-emulator/memory.h new file mode 100644 index 0000000..7ff993f --- /dev/null +++ b/c-emulator/memory.h @@ -0,0 +1,107 @@ +/* -*- Mode:C -*- */ + +/* + For historical reasons, the VM accessors return -1 on failure and 0 on success + */ + +#ifndef _MEMORY_H +#define _MEMORY_H + +extern int VirtualMemoryWriteBlockConstant (Integer vma, LispObj *object, int count, int increment); +extern int VirtualMemoryWriteBlock (Integer vma, LispObj *object, int count); +extern int VirtualMemoryReadBlock (Integer vma, LispObj *object, int count); +extern int VirtualMemoryWrite (Integer vma, LispObj *object); +extern int VirtualMemoryRead (Integer vma, LispObj *object); +extern Tag* MapVirtualAddressTag(Integer vma); +extern Integer* MapVirtualAddressData(Integer vma); +extern Integer EnsureVirtualAddressRange (Integer vma, int count, Boolean faultp); +extern Integer EnsureVirtualAddress (Integer vma, Boolean faultp); + +/* VLM virtual-memory "coprocessor" interface */ +typedef unsigned char VMAttribute; + +#define VMAttributeAccessFault 01 +#define VMAttributeWriteFault 02 +#define VMAttributeTransportFault 04 +#define VMAttributeTransportDisable 010 +#define VMAttributeEphemeral 020 +#define VMAttributeModified 040 +#define VMAttributeExists 0100 + +#define VMCreatedDefault (VMAttributeAccessFault|VMAttributeTransportFault|VMAttributeExists) + +#define VMAccessFault(a) ((a)&01) +#define VMWriteFault(a) ((a)&02) +#define VMTransportFault(a) ((a)&04) +#define VMTransportDisable(a) ((a)&010) +#define VMEphemeral(a) ((a)&020) +#define VMModified(a) ((a)&040) +#define VMExists(a) ((a)&0100) + +#define SetVMAccessFault(a) ((a)|=01) +#define SetVMWriteFault(a) ((a)|=02) +#define SetVMTransportFault(a) ((a)|=04) +#define SetVMTransportDisable(a) ((a)|=010) +#define SetVMEphemeral(a) ((a)|=020) +#define SetVMModified(a) ((a)|=040) +#define SetVMExists(a) ((a)|=0100) + +#define ClearVMAccessFault(a) ((a)&=~01) +#define ClearVMWriteFault(a) ((a)&=~02) +#define ClearVMTransportFault(a) ((a)&=~04) +#define ClearVMTransportDisable(a) ((a)&=~010) +#define ClearVMEphemeral(a) ((a)&=~020) +#define ClearVMModified(a) ((a)&=~040) +#define ClearVMExists(a) ((a)&=~0100) + +typedef enum _VMRegisterNumber +{ + VMRegisterCommand = 01100, + VMRegisterAddress, + VMRegisterExtent, + VMRegisterAttributes, + VMRegisterDestination, + VMRegisterData +} VMRegisterNumber; + +typedef enum _VMOpcode +{ + VMOpcodeLookup, /* reply is index */ + VMOpcodeCreate, + VMOpcodeDestroy, + + VMOpcodeReadAttributes, /* operand is index */ + VMOpcodeWriteAttributes, /* operand is index */ + + VMOpcodeFill, /* operand is increment (of fill data) */ + VMOpcodeSearch, /* operand is increment (of address) */ + VMOpcodeCopy, /* operand is memory-cycle? */ + + VMOpcodeScan, + VMOpcodeEnable +} VMOpcode; + +typedef enum _VMResultCode +{ + VMResultSuccess, + VMResultFailure +} VMResultCode; + +#define VMCommandOpcode(command) ((VMOpcode)ldb(13,19,command)) +#define VMCommandOperand(command) ((int)ldb(19,0,command)) + +#define SetVMReplyResult(reply,result) (dpb((int)(result?VMResultSuccess:VMResultFailure),13,19,reply)) + +typedef struct _VMState +{ + Integer CommandRegister; + Integer AddressRegister; + Integer ExtentRegister; + Integer AttributesRegister; + Integer DestinationRegister; + LispObj DataRegister; +} VMState; + +extern VMState VM; + +#endif diff --git a/c-emulator/traps.c b/c-emulator/traps.c new file mode 100644 index 0000000..5f77ccf --- /dev/null +++ b/c-emulator/traps.c @@ -0,0 +1,459 @@ +/* -*- Mode:C -*- */ + +#include "emulator.h" +#include "ivory.h" + +/* --- could figure out how to pack these */ +typedef struct _ExceptionInfo + { + int arity; + int stackp; + int arithp; + } +ExceptionInfo; + +const ExceptionInfo InstructionExceptionInfo[0400] = { + {1, False, False}, /* CAR */ + {1, False, False}, /* CDR */ + {0, True, False}, /* ENDP */ + {1, False, False}, /* SETUP-1D-ARRAY */ + {1, False, False}, /* SETUP-FORCE-1D-ARRAY */ + {1, False, False}, /* BIND-LOCATIVE */ + {1, False, False}, /* %RESTORE-BINDING-STACK */ + {0, True, False}, /* %EPHEMERALP */ + {0, True, False}, /* START-CALL */ + {0, True, False}, /* %JUMP */ + {0, True, False}, /* %TAG */ + {0, True, False}, /* DEREFERENCE */ + {1, False, False}, /* LOGIC-TAIL-TEST */ + {0, True, False}, /* %PROC-BREAKPOINT */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {1, False, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* PUSH-LEXICAL-VAR */ + {0, True, False}, /* %BLOCK-0-WRITE */ + {0, True, False}, /* %BLOCK-1-WRITE */ + {0, True, False}, /* %BLOCK-2-WRITE */ + {0, True, False}, /* %BLOCK-3-WRITE */ + {1, False, True}, /* ZEROP */ + {1, False, True}, /* MINUSP */ + {1, False, True}, /* PLUSP */ + {0, True, False}, /* Unused */ + {0, True, False}, /* TYPE-MEMBER */ + {0, True, False}, /* TYPE-MEMBER */ + {0, True, False}, /* TYPE-MEMBER */ + {0, True, False}, /* TYPE-MEMBER */ + {0, True, False}, /* TYPE-MEMBER-NO-POP */ + {0, True, False}, /* TYPE-MEMBER-NO-POP */ + {0, True, False}, /* TYPE-MEMBER-NO-POP */ + {0, True, False}, /* TYPE-MEMBER-NO-POP */ + {0, True, False}, /* LOCATE-LOCALS */ + {0, True, False}, /* CATCH-CLOSE */ + {0, True, False}, /* %GENERIC-DISPATCH */ + {0, True, False}, /* %MESSAGE-DISPATCH */ + {0, True, False}, /* %CHECK-PREEMPT-REQUEST */ + {0, True, False}, /* PUSH-GLOBAL-LOGIC-VARIABLE */ + {0, True, False}, /* NO-OP */ + {0, True, False}, /* %HALT */ + {0, True, False}, /* BRANCH-True */ + {0, True, False}, /* BRANCH-True-ELSE-EXTRA-POP */ + {0, True, False}, /* BRANCH-True-AND-EXTRA-POP */ + {0, True, False}, /* BRANCH-True-EXTRA-POP */ + {0, True, False}, /* BRANCH-True-NO-POP */ + {0, True, False}, /* BRANCH-True-AND-NO-POP */ + {0, True, False}, /* BRANCH-True-ELSE-NO-POP */ + {0, True, False}, /* BRANCH-True-AND-NO-POP-ELSE-NO-POP-EXTRA-POP */ + {0, True, False}, /* BRANCH-False */ + {0, True, False}, /* BRANCH-False-ELSE-EXTRA-POP */ + {0, True, False}, /* BRANCH-False-AND-EXTRA-POP */ + {0, True, False}, /* BRANCH-False-EXTRA-POP */ + {0, True, False}, /* BRANCH-False-NO-POP */ + {0, True, False}, /* BRANCH-False-AND-NO-POP */ + {0, True, False}, /* BRANCH-False-ELSE-NO-POP */ + {0, True, False}, /* BRANCH-False-AND-NO-POP-ELSE-NO-POP-EXTRA-POP */ + {0, True, False}, /* PUSH */ + {0, True, False}, /* PUSH-N-NILS */ + {1, False, False}, /* PUSH-ADDRESS-SP-RELATIVE */ + {0, True, False}, /* PUSH-LOCAL-LOGIC-VARIABLES */ + {0, True, False}, /* RETURN-MULTIPLE */ + {0, True, False}, /* RETURN-KLUDGE */ + {0, True, False}, /* TAKE-VALUES */ + {0, True, False}, /* UNBIND-N */ + {1, False, False}, /* PUSH-INSTANCE-VARIABLE */ + {1, False, False}, /* PUSH-ADDRESS-INSTANCE-VARIABLE */ + {0, True, False}, /* PUSH-INSTANCE-VARIABLE-ORDERED */ + {0, True, False}, /* PUSH-ADDRESS-INSTANCE-VARIABLE-ORDERED */ + {1, False, True}, /* UNARY-MINUS */ + {0, True, False}, /* RETURN-SINGLE */ + {0, True, False}, /* %MEMORY-READ */ + {0, True, False}, /* %MEMORY-READ-ADDRESS */ + {0, True, False}, /* %BLOCK-0-READ */ + {0, True, False}, /* %BLOCK-1-READ */ + {0, True, False}, /* %BLOCK-2-READ */ + {0, True, False}, /* %BLOCK-3-READ */ + {0, True, False}, /* %BLOCK-0-READ-SHIFT */ + {0, True, False}, /* %BLOCK-1-READ-SHIFT */ + {0, True, False}, /* %BLOCK-2-READ-SHIFT */ + {0, True, False}, /* %BLOCK-3-READ-SHIFT */ + {2, True, False}, /* %BLOCK-0-READ-TEST */ + {2, True, False}, /* %BLOCK-1-READ-TEST */ + {2, True, False}, /* %BLOCK-2-READ-TEST */ + {2, True, False}, /* %BLOCK-3-READ-TEST */ + {0, True, False}, /* FINISH-CALL-N */ + {0, True, False}, /* FINISH-CALL-N-APPLY */ + {0, True, False}, /* FINISH-CALL-TOS */ + {0, True, False}, /* FINISH-CALL-TOS-APPLY */ + {1, False, False}, /* SET-TO-CAR */ + {1, False, False}, /* SET-TO-CDR */ + {1, False, False}, /* SET-TO-CDR-PUSH-CAR */ + {1, False, False}, /* INCREMENT */ + {1, False, False}, /* DECREMENT */ + {0, True, False}, /* %POINTER-INCREMENT */ + {0, True, False}, /* %SET-CDR-CODE-1 */ + {0, True, False}, /* %SET-CDR-CODE-2 */ + {0, True, False}, /* PUSH-ADDRESS */ + {0, True, False}, /* SET-SP-TO-ADDRESS */ + {0, True, False}, /* SET-SP-TO-ADDRESS-SAVE-TOS */ + {0, True, False}, /* Unused */ + {0, True, False}, /* %READ-INTERNAL-REGISTER */ + {0, True, False}, /* %WRITE-INTERNAL-REGISTER */ + {0, True, False}, /* %COPROCESSOR-READ */ + {0, True, False}, /* %COPROCESSOR-WRITE */ + {1, False, False}, /* %BLOCK-0-READ-ALU */ + {1, False, False}, /* %BLOCK-1-READ-ALU */ + {1, False, False}, /* %BLOCK-2-READ-ALU */ + {1, False, False}, /* %BLOCK-3-READ-ALU */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {1, True, False}, /* LDB */ + {1, True, False}, /* CHAR-LDB */ + {0, True, False}, /* %P-LDB */ + {0, True, False}, /* %P-TAG-LDB */ + {0, True, False}, /* BRANCH */ + {1, True, False}, /* LOOP-DECREMENT-TOS */ + {0, True, False}, /* ENTRY-REST-ACCEPTED */ + {0, True, False}, /* ENTRY-REST-NOT-ACCEPTED */ + {2, False, False}, /* RPLACA */ + {2, False, False}, /* RPLACD */ + {2, False, True}, /* MULTIPLY */ + {2, False, True}, /* QUOTIENT */ + {2, False, True}, /* CEILING */ + {2, False, True}, /* FLOOR */ + {2, False, True}, /* TRUNCATE */ + {2, False, True}, /* ROUND */ + {0, True, False}, /* Unused */ + {2, False, True}, /* RATIONAL-QUOTIENT */ + {2, False, True}, /* MIN */ + {2, False, True}, /* MAX */ + {2, False, False}, /* %ALU */ + {2, False, True}, /* LOGAND */ + {2, False, True}, /* LOGXOR */ + {2, False, True}, /* LOGIOR */ + {0, True, False}, /* ROT */ + {0, True, False}, /* LSH */ + {0, True, False}, /* %MULTIPLY-DOUBLE */ + {0, True, False}, /* %LSHC-BIGNUM-STEP */ + {2, False, False}, /* STACK-BLT */ + {2, False, False}, /* RGETF */ + {2, False, False}, /* MEMBER */ + {2, False, False}, /* ASSOC */ + {0, True, False}, /* %POINTER-PLUS */ + {0, True, False}, /* %POINTER-DIFFERENCE */ + {2, False, True}, /* ASH */ + {0, True, False}, /* STORE-CONDITIONAL */ + {0, True, False}, /* %MEMORY-WRITE */ + {0, True, False}, /* %P-STORE-CONTENTS */ + {2, False, False}, /* BIND-LOCATIVE-TO-VALUE */ + {2, False, False}, /* UNIFY */ + {2, False, False}, /* POP-LEXICAL-VAR */ + {0, True, False}, /* POP-LEXICAL-VAR */ + {0, True, False}, /* POP-LEXICAL-VAR */ + {0, True, False}, /* POP-LEXICAL-VAR */ + {0, True, False}, /* POP-LEXICAL-VAR */ + {0, True, False}, /* POP-LEXICAL-VAR */ + {0, True, False}, /* POP-LEXICAL-VAR */ + {0, True, False}, /* POP-LEXICAL-VAR */ + {2, False, False}, /* MOVEM-LEXICAL-VAR */ + {0, True, False}, /* MOVEM-LEXICAL-VAR */ + {0, True, False}, /* MOVEM-LEXICAL-VAR */ + {0, True, False}, /* MOVEM-LEXICAL-VAR */ + {0, True, False}, /* MOVEM-LEXICAL-VAR */ + {0, True, False}, /* MOVEM-LEXICAL-VAR */ + {0, True, False}, /* MOVEM-LEXICAL-VAR */ + {0, True, False}, /* MOVEM-LEXICAL-VAR */ + {2, False, True}, /* EQUAL-NUMBER */ + {2, False, True}, /* LESSP */ + {2, False, True}, /* GREATERP */ + {2, False, True}, /* EQL */ + {2, False, True}, /* EQUAL-NUMBER-NO-POP */ + {2, False, True}, /* LESSP-NO-POP */ + {2, False, True}, /* GREATERP-NO-POP */ + {2, False, True}, /* EQL-NO-POP */ + {0, True, False}, /* EQ */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {2, False, True}, /* LOGTEST */ + {0, True, False}, /* EQ-NO-POP */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {2, False, True}, /* LOGTEST-NO-POP */ + {2, False, True}, /* ADD */ + {2, False, True}, /* SUB */ + {0, True, False}, /* %32-BIT-PLUS */ + {0, True, False}, /* %32-BIT-DIFFERENCE */ + {0, True, False}, /* %ADD-BIGNUM-STEP */ + {0, True, False}, /* %SUB-BIGNUM-STEP */ + {0, True, False}, /* %MULTIPLY-BIGNUM-STEP */ + {0, True, False}, /* %DIVIDE-BIGNUM-STEP */ + {3, False, False}, /* ASET-1 */ + {2, False, False}, /* %ALLOCATE-LIST-BLOCK */ + {2, False, False}, /* AREF-1 */ + {2, False, False}, /* ALOC-1 */ + {3, False, False}, /* STORE-ARRAY-LEADER */ + {2, False, False}, /* %ALLOCATE-STRUCTURE-BLOCK */ + {2, False, False}, /* ARRAY-LEADER */ + {2, False, False}, /* ALOC-LEADER */ + {2, False, False}, /* POP-INSTANCE-VARIABLE */ + {2, False, False}, /* MOVEM-INSTANCE-VARIABLE */ + {0, True, False}, /* POP-INSTANCE-VARIABLE-ORDERED */ + {0, True, False}, /* MOVEM-INSTANCE-VARIABLE-ORDERED */ + {2, False, False}, /* %INSTANCE-REF */ + {3, False, False}, /* %INSTANCE-SET */ + {2, False, False}, /* %INSTANCE-LOC */ + {0, True, False}, /* %SET-TAG */ + {0, True, False}, /* Unused */ + {0, True, False}, /* %UNSIGNED-LESSP */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* %UNSIGNED-LESSP-NO-POP */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* POP */ + {0, True, False}, /* MOVEM */ + {0, True, False}, /* %MERGE-CDR-NO-POP */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {2, False, False}, /* FAST-AREF-1 */ + {3, False, False}, /* FAST-ASET-1 */ + {2, False, False}, /* STACK-BLT-ADDRESS */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {0, True, False}, /* Unused */ + {2, True, False}, /* DPB */ + {2, True, False}, /* CHAR-DPB */ + {0, True, False}, /* %P-DPB */ + {0, True, False}, /* %P-TAG-DPB */ + {0, True, False}, /* Unused */ + {2, True, False}, /* LOOP-INCREMENT-TOS-LESS-THAN */ + {0, True, False}, /* CATCH-OPEN */ + {0, True, False}, /* %HACK */ + }; + +static int FetchTrapVectorEntry (Integer index, LispObj* entry) +{ + register ProcessorState *ps = processor; + int previous = ReadControlTrapMode(ps->control); + + WriteControlTrapMode(ps->control, 3); + MemoryReadData(TrapVectorBase + ((previous<3)?index:FepModeTrapVector), entry); + if (!(TypeEqualP(entry->TAG,TypeOddPC) || TypeEqualP(entry->TAG,TypeEvenPC))) + if (previous == 3 || !FetchTrapVectorEntry(index, entry)) + return(0); /* Real hardware would RESET */ + + WriteControlTrapMode(ps->control, previous); + return(1); +} + +int TakePreTrap (Integer index, LispObj* extra1, LispObj* extra2) +{ + register ProcessorState *ps = processor; + LispObj* oldfp = ps->fp; + LispObj* restartsp = ps->restartsp; + LispObj entry; + + ps->sp = restartsp; + if (ps->sp + 8 > ps->StackCacheLimit) + StackCacheScrollUp(); + /* PushContinuation (ps->continuation); */ + ps->sp[1].TAG = 0300 | ps->continuation.TAG; + ps->sp[1].DATA = ps->continuation.DATA; + ps->sp++; + /* PushControl (ps->control); */ + ps->sp[1].TAG = 0300 | TypeFixnum; + ps->sp[1].DATA.u = ps->control; + ps->sp++; + /* PushFixnum(index); */ + ps->sp[1].TAG = TypeFixnum; + ps->sp[1].DATA.u = index; + ps->sp++; + /* PushObject(ps->pc); */ + ps->sp[1].TAG = ps->pc.TAG & TagTypeMask; + ps->sp[1].DATA = ps->pc.DATA; + ps->sp++; + + /* push extra trap arguments */ + if (extra1) + { + ps->sp[1].TAG = extra1->TAG & TagTypeMask; + ps->sp[1].DATA = extra1->DATA; + ps->sp++; + } + if (extra2) + { + ps->sp[1].TAG = extra2->TAG & TagTypeMask; + ps->sp[1].DATA = extra2->DATA; + ps->sp++; + } + + ps->fp = restartsp + 1; + ps->lp = ps->sp + 1; + ps->control = + /* First clear a bunch of fields */ + (ps->control & ~(ControlApply | + ControlTraceBits | + ControlCleanupBits | + ControlExtraArgument | + ControlCallStarted | + ControlArgumentSize | + ControlValueDisposition | + ControlCallerFrameSize)) + /* Set CR.ArgumentSize */ + | (ps->lp - ps->fp) + /* Call for effect */ + | (ValueDispositionEffect << 10) + /* Set CR.CallerFrameSize */ + | ((ps->fp - oldfp) << 9); + /* return to erring instruction (pre-trap) */ + ps->continuation = ps->pc; + if (!FetchTrapVectorEntry(index, &entry)) + return(0); + /* Set Trap Mode */ + if (ReadControlTrapMode(ps->control) < TagCdr(entry.TAG)) + WriteControlTrapMode(ps->control, TagCdr(entry.TAG)); + ps->pc = entry; + /* --- check for control-stack overflow + if (ps->sp > ControlStackLimit()) + StackOverflow(); + */ + return(1); +} + +int TakePostTrap(int index, int arity, LispObj* nextpc) +{ + register ProcessorState *ps = processor; + LispObj* oldfp = ps->fp; + LispObj entry; + int i; + + if (ps->sp + 8 > ps->StackCacheLimit) + StackCacheScrollUp(); + /* move operands down to make room for frame */ + for (i = 0; i < arity; i++) + ps->sp[4-i] = ps->sp[-i]; + ps->fp = ps->sp - (arity - 1); + ps->sp += 4; + + /* PushContinuation (ps->continuation); */ + ps->fp[0].TAG = 0300 | ps->continuation.TAG; + ps->fp[0].DATA = ps->continuation.DATA; + /* PushControl (ps->control); */ + ps->fp[1].TAG = 0300 | TypeFixnum; + ps->fp[1].DATA.u = ps->control; + if (ReadControlInstructionTrace(ps->control)) + WriteControlTracePending(ps->fp[1].DATA.u, 1); + /* PushFixnum(index); */ + ps->fp[2].TAG = TypeFixnum; + ps->fp[2].DATA.u = index; + /* PushObject(ps->pc); */ + ps->fp[3].TAG = ps->pc.TAG & TagTypeMask; + ps->fp[3].DATA = ps->pc.DATA; + + ps->lp = ps->sp + 1; + ps->control = + /* First clear a bunch of fields */ + (ps->control & ~(ControlApply | + ControlTraceBits | + ControlCleanupBits | + ControlExtraArgument | + ControlCallStarted | + ControlArgumentSize | + ControlValueDisposition | + ControlCallerFrameSize)) + /* Set CR.ArgumentSize */ + | (ps->lp - ps->fp) + /* Call for effect */ + | (ValueDispositionEffect << 10) + /* Set CR.CallerFrameSize */ + | ((ps->fp - oldfp) << 9); + /* return to instruction's succesor (post-trap) */ + ps->continuation = *nextpc; + if (!FetchTrapVectorEntry(index, &entry)) + return(0); + /* Set Trap Mode */ + if (ReadControlTrapMode(ps->control) < TagCdr(entry.TAG)) + WriteControlTrapMode(ps->control, TagCdr(entry.TAG)); + ps->pc = entry; + /* --- check for control-stack overflow + if (ps->sp > ControlStackLimit()) + StackOverflow(); + */ + return(1); +} + +int TakeInstructionException(int instruction, LispObj* op2, LispObj* nextpc) +{ + int opcode = ldb(8,10,instruction); + const ExceptionInfo* ei = &InstructionExceptionInfo[opcode]; + register ProcessorState *ps = processor; + int vector; + + ps->sp = ps->restartsp; + if (!ei->stackp) + { + if (ldb(2,15,instruction) == 3) /* address operand */ + { + ps->sp[1].TAG = TypeLocative; + ps->sp[1].DATA.u = ps->StackCacheBase + (op2 - ps->StackCache); + ps->sp++; + } + else if (ldb(10,0,instruction) != 01000) /* (not) pop operand */ + { + ps->sp[1].TAG = op2->TAG & TagTypeMask; + ps->sp[1].DATA = op2->DATA; + ps->sp++; + } + } + + if (!ei->arithp) + vector = InstructionExceptionVector + opcode; + else if (ei->arity > 1) + vector = ArithmeticInstructionExceptionVector + + dpb(opcode,5,6,dpb(ps->sp[-1].TAG,3,3,ps->sp[0].TAG)); + else + vector = ArithmeticInstructionExceptionVector + + dpb(opcode,5,6,dpb(ps->sp[0].TAG,3,3,0)); + + return(TakePostTrap(vector, ei->arity, nextpc)); +} diff --git a/compile b/compile new file mode 100755 index 0000000..531136b --- /dev/null +++ b/compile @@ -0,0 +1,347 @@ +#! /bin/sh +# Wrapper for compilers which do not understand '-c -o'. + +scriptversion=2012-10-14.11; # UTC + +# Copyright (C) 1999-2013 Free Software Foundation, Inc. +# Written by Tom Tromey . +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# This file is maintained in Automake, please report +# bugs to or send patches to +# . + +nl=' +' + +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent tools from complaining about whitespace usage. +IFS=" "" $nl" + +file_conv= + +# func_file_conv build_file lazy +# Convert a $build file to $host form and store it in $file +# Currently only supports Windows hosts. If the determined conversion +# type is listed in (the comma separated) LAZY, no conversion will +# take place. +func_file_conv () +{ + file=$1 + case $file in + / | /[!/]*) # absolute file, and not a UNC file + if test -z "$file_conv"; then + # lazily determine how to convert abs files + case `uname -s` in + MINGW*) + file_conv=mingw + ;; + CYGWIN*) + file_conv=cygwin + ;; + *) + file_conv=wine + ;; + esac + fi + case $file_conv/,$2, in + *,$file_conv,*) + ;; + mingw/*) + file=`cmd //C echo "$file " | sed -e 's/"\(.*\) " *$/\1/'` + ;; + cygwin/*) + file=`cygpath -m "$file" || echo "$file"` + ;; + wine/*) + file=`winepath -w "$file" || echo "$file"` + ;; + esac + ;; + esac +} + +# func_cl_dashL linkdir +# Make cl look for libraries in LINKDIR +func_cl_dashL () +{ + func_file_conv "$1" + if test -z "$lib_path"; then + lib_path=$file + else + lib_path="$lib_path;$file" + fi + linker_opts="$linker_opts -LIBPATH:$file" +} + +# func_cl_dashl library +# Do a library search-path lookup for cl +func_cl_dashl () +{ + lib=$1 + found=no + save_IFS=$IFS + IFS=';' + for dir in $lib_path $LIB + do + IFS=$save_IFS + if $shared && test -f "$dir/$lib.dll.lib"; then + found=yes + lib=$dir/$lib.dll.lib + break + fi + if test -f "$dir/$lib.lib"; then + found=yes + lib=$dir/$lib.lib + break + fi + if test -f "$dir/lib$lib.a"; then + found=yes + lib=$dir/lib$lib.a + break + fi + done + IFS=$save_IFS + + if test "$found" != yes; then + lib=$lib.lib + fi +} + +# func_cl_wrapper cl arg... +# Adjust compile command to suit cl +func_cl_wrapper () +{ + # Assume a capable shell + lib_path= + shared=: + linker_opts= + for arg + do + if test -n "$eat"; then + eat= + else + case $1 in + -o) + # configure might choose to run compile as 'compile cc -o foo foo.c'. + eat=1 + case $2 in + *.o | *.[oO][bB][jJ]) + func_file_conv "$2" + set x "$@" -Fo"$file" + shift + ;; + *) + func_file_conv "$2" + set x "$@" -Fe"$file" + shift + ;; + esac + ;; + -I) + eat=1 + func_file_conv "$2" mingw + set x "$@" -I"$file" + shift + ;; + -I*) + func_file_conv "${1#-I}" mingw + set x "$@" -I"$file" + shift + ;; + -l) + eat=1 + func_cl_dashl "$2" + set x "$@" "$lib" + shift + ;; + -l*) + func_cl_dashl "${1#-l}" + set x "$@" "$lib" + shift + ;; + -L) + eat=1 + func_cl_dashL "$2" + ;; + -L*) + func_cl_dashL "${1#-L}" + ;; + -static) + shared=false + ;; + -Wl,*) + arg=${1#-Wl,} + save_ifs="$IFS"; IFS=',' + for flag in $arg; do + IFS="$save_ifs" + linker_opts="$linker_opts $flag" + done + IFS="$save_ifs" + ;; + -Xlinker) + eat=1 + linker_opts="$linker_opts $2" + ;; + -*) + set x "$@" "$1" + shift + ;; + *.cc | *.CC | *.cxx | *.CXX | *.[cC]++) + func_file_conv "$1" + set x "$@" -Tp"$file" + shift + ;; + *.c | *.cpp | *.CPP | *.lib | *.LIB | *.Lib | *.OBJ | *.obj | *.[oO]) + func_file_conv "$1" mingw + set x "$@" "$file" + shift + ;; + *) + set x "$@" "$1" + shift + ;; + esac + fi + shift + done + if test -n "$linker_opts"; then + linker_opts="-link$linker_opts" + fi + exec "$@" $linker_opts + exit 1 +} + +eat= + +case $1 in + '') + echo "$0: No command. Try '$0 --help' for more information." 1>&2 + exit 1; + ;; + -h | --h*) + cat <<\EOF +Usage: compile [--help] [--version] PROGRAM [ARGS] + +Wrapper for compilers which do not understand '-c -o'. +Remove '-o dest.o' from ARGS, run PROGRAM with the remaining +arguments, and rename the output as expected. + +If you are trying to build a whole package this is not the +right script to run: please start by reading the file 'INSTALL'. + +Report bugs to . +EOF + exit $? + ;; + -v | --v*) + echo "compile $scriptversion" + exit $? + ;; + cl | *[/\\]cl | cl.exe | *[/\\]cl.exe ) + func_cl_wrapper "$@" # Doesn't return... + ;; +esac + +ofile= +cfile= + +for arg +do + if test -n "$eat"; then + eat= + else + case $1 in + -o) + # configure might choose to run compile as 'compile cc -o foo foo.c'. + # So we strip '-o arg' only if arg is an object. + eat=1 + case $2 in + *.o | *.obj) + ofile=$2 + ;; + *) + set x "$@" -o "$2" + shift + ;; + esac + ;; + *.c) + cfile=$1 + set x "$@" "$1" + shift + ;; + *) + set x "$@" "$1" + shift + ;; + esac + fi + shift +done + +if test -z "$ofile" || test -z "$cfile"; then + # If no '-o' option was seen then we might have been invoked from a + # pattern rule where we don't need one. That is ok -- this is a + # normal compilation that the losing compiler can handle. If no + # '.c' file was seen then we are probably linking. That is also + # ok. + exec "$@" +fi + +# Name of file we expect compiler to create. +cofile=`echo "$cfile" | sed 's|^.*[\\/]||; s|^[a-zA-Z]:||; s/\.c$/.o/'` + +# Create the lock directory. +# Note: use '[/\\:.-]' here to ensure that we don't use the same name +# that we are using for the .o file. Also, base the name on the expected +# object file name, since that is what matters with a parallel build. +lockdir=`echo "$cofile" | sed -e 's|[/\\:.-]|_|g'`.d +while true; do + if mkdir "$lockdir" >/dev/null 2>&1; then + break + fi + sleep 1 +done +# FIXME: race condition here if user kills between mkdir and trap. +trap "rmdir '$lockdir'; exit 1" 1 2 15 + +# Run the compile. +"$@" +ret=$? + +if test -f "$cofile"; then + test "$cofile" = "$ofile" || mv "$cofile" "$ofile" +elif test -f "${cofile}bj"; then + test "${cofile}bj" = "$ofile" || mv "${cofile}bj" "$ofile" +fi + +rmdir "$lockdir" +exit $ret + +# Local Variables: +# mode: shell-script +# sh-indentation: 2 +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff --git a/compile-aistat.lisp b/compile-aistat.lisp new file mode 100644 index 0000000..30a785b --- /dev/null +++ b/compile-aistat.lisp @@ -0,0 +1,102 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: COMMON-LISP-USER; Base: 10; Lowercase: Yes -*- + +(in-package "COMMON-LISP-USER") + +;;; Compile the Alpha AXP (G5) assembly source files using OpenMCL + +;;; TODO: Integrate with MAKE? + +(setf (logical-pathname-translations "VLM") + (let* ((parent + (make-pathname :name nil :type nil :version nil :defaults *load-truename*)) + (target (format nil "~A/**/" parent))) + `(("VLM:VLM;**;" ,target) + ("VLM:**;" ,target)))) + +(defun compile-if-needed (file &optional force? &rest compile-options) + (let* ((input (merge-pathnames file (make-pathname :type "lisp"))) + (output (apply #'compile-file-pathname input compile-options))) + (if (and (not force?) + (probe-file output) + (> (file-write-date output) (file-write-date input))) + (load output :verbose t) + (apply #'compile-file input :verbose t :load t compile-options)))) + +(defun dsdl-if-needed (file &optional force?) + (let* ((input (pathname file)) + (output (merge-pathnames (make-pathname :type "lisp") input))) + (when (or force? + (not (probe-file output)) + (> (file-write-date input) (file-write-date output))) + (let ((*package* (find-package "ALPHA-AXP-INTERNALS"))) + (format t "~&;Translating ~S... " input) + (funcall (intern "DSDL" "ALPHA-AXP-INTERNALS") input '(:c :asm :lisp)))) + (load output :verbose t))) + +(defun assemble (file) + (let* ((input (merge-pathnames file (make-pathname :type "as"))) + (output (merge-pathnames (make-pathname :type "s") input))) + (format t "~&;Translating ~S... " input) + (funcall (intern "PROCESS-ASM-SOURCE" "ALPHA-AXP-INTERNALS") input output))) + +(defun translate () + ;; The actual emulator core + (dolist (file '("ifunhead" "idispat" "ifuncom1" "ifuncom2" + "ifungene" "ifunfcal" "ifunloop" "ifunlist" + "ifuninst" "ifunmath" "ifunarra" "ifunmove" + "ifunpred" "ifunsubp" "ifunfext" "ifunlexi" + "ifunbits" "ifunblok" "ifunbind" "ifunfull" + "ifunbnum" "ifuntrap" "ihalt" "idouble" + "ifunjosh" "ifuntran")) + (assemble (format nil "vlm:alpha-emulator;~A" file)))) + +(defun build (&optional force?) + ;; Provide several Genera only packages and a number of definitions + ;; from the SYSTEM (SYS) package that are used by the assembler and + ;; emulator macros. (In theory, these files should work with Lisp + ;; implementations other than OpenMCL with only minor tweaks.) + (load "vlm:support;openmcl-packages" :verbose t) + (compile-if-needed "vlm:support;openmcl-support" force?) + + ;; Alpha AXP Assembler + (load "vlm:assembler;alphapckg.lisp" :verbose t) + (compile-if-needed "vlm:assembler;alphadsdl" force?) + (compile-if-needed "vlm:assembler;alpha" force?) + + ;; Ivory data structures and type definitions used by the core emulator + ;; NOTE: These files are not automatically regenerated as they live + ;; in the CVS repository and there's no need to generate extra + ;; commits when all that changes is the header and trailer comments. + (dsdl-if-needed "vlm:alpha-emulator;aistat.sid" force?) + (dsdl-if-needed "vlm:emulator;aihead.sid" force?) + (dsdl-if-needed "vlm:emulator;traps.sid" force?) + (compile-if-needed "vlm:emulator;errortbl" force? :output-file "vlm:alpha-emulator;") + + ;; Macros + (dolist (file '("alphamac" "intrpmac" "stacklis" + "memoryem" "imaclist" "fcallmac" "imacbits" + "imacblok" "imaclexi" "imacgene" "imacinst" "imacialu" + "imacloop" "imacmath" "imacbind" "imacjosh" "imacarra" + "imacpred" "imacsubp" "imactrap")) + (compile-if-needed (format nil "vlm:alpha-emulator;~A" file) force?)) + + ;; The actual emulator core +(translate)) + +;;(build t) +(load "vlm:support;openmcl-packages" :verbose t) +(compile-if-needed "vlm:support;openmcl-support" t) + +;; Alpha AXP Assembler +(load "vlm:assembler;alphapckg.lisp" :verbose t) +(compile-if-needed "vlm:assembler;alphadsdl" t) +(compile-if-needed "vlm:assembler;alpha" t) + +;; Ivory data structures and type definitions used by the core emulator +;; NOTE: These files are not automatically regenerated as they live +;; in the CVS repository and there's no need to generate extra +;; commits when all that changes is the header and trailer comments. +(dsdl-if-needed "vlm:alpha-emulator;aistat.sid" t) +(dsdl-if-needed "vlm:emulator;aihead.sid" t) +(dsdl-if-needed "vlm:emulator;traps.sid" t) +(setq *quit-on-eof* t) diff --git a/compile-alpha-emulator.lisp b/compile-alpha-emulator.lisp new file mode 100644 index 0000000..efd9d9f --- /dev/null +++ b/compile-alpha-emulator.lisp @@ -0,0 +1,86 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: COMMON-LISP-USER; Base: 10; Lowercase: Yes -*- + +(in-package "COMMON-LISP-USER") + +;;; Compile the Alpha AXP (G5) assembly source files using OpenMCL + +;;; TODO: Integrate with MAKE? + +(setf (logical-pathname-translations "VLM") + (let* ((parent + (make-pathname :name nil :type nil :version nil :defaults *load-truename*)) + (target (format nil "~A/**/" parent))) + `(("VLM:VLM;**;" ,target) + ("VLM:**;" ,target)))) + +(defun compile-if-needed (file &optional force? &rest compile-options) + (let* ((input (merge-pathnames file (make-pathname :type "lisp"))) + (output (apply #'compile-file-pathname input compile-options))) + (if (and (not force?) + (probe-file output) + (> (file-write-date output) (file-write-date input))) + (load output :verbose t) + (apply #'compile-file input :verbose t :load t compile-options)))) + +(defun dsdl-if-needed (file &optional force?) + (let* ((input (pathname file)) + (output (merge-pathnames (make-pathname :type "lisp") input))) + (when (or force? + (not (probe-file output)) + (> (file-write-date input) (file-write-date output))) + (let ((*package* (find-package "ALPHA-AXP-INTERNALS"))) + (format t "~&;Translating ~S... " input) + (funcall (intern "DSDL" "ALPHA-AXP-INTERNALS") input '(:c :asm :lisp)))) + (load output :verbose t))) + +(defun assemble (file) + (let* ((input (merge-pathnames file (make-pathname :type "as"))) + (output (merge-pathnames (make-pathname :type "s") input))) + (format t "~&;Translating ~S... " input) + (funcall (intern "PROCESS-ASM-SOURCE" "ALPHA-AXP-INTERNALS") input output))) + +(defun translate () + ;; The actual emulator core + (dolist (file '("ifunhead" "idispat" "ifuncom1" "ifuncom2" + "ifungene" "ifunfcal" "ifunloop" "ifunlist" + "ifuninst" "ifunmath" "ifunarra" "ifunmove" + "ifunpred" "ifunsubp" "ifunfext" "ifunlexi" + "ifunbits" "ifunblok" "ifunbind" "ifunfull" + "ifunbnum" "ifuntrap" "ihalt" "idouble" + "ifunjosh" "ifuntran")) + (assemble (format nil "vlm:alpha-emulator;~A" file)))) + +(defun build (&optional force?) + ;; Provide several Genera only packages and a number of definitions + ;; from the SYSTEM (SYS) package that are used by the assembler and + ;; emulator macros. (In theory, these files should work with Lisp + ;; implementations other than OpenMCL with only minor tweaks.) + (load "vlm:support;openmcl-packages" :verbose t) + (compile-if-needed "vlm:support;openmcl-support" force?) + + ;; Alpha AXP Assembler + (load "vlm:assembler;alphapckg.lisp" :verbose t) + (compile-if-needed "vlm:assembler;alphadsdl" force?) + (compile-if-needed "vlm:assembler;alpha" force?) + + ;; Ivory data structures and type definitions used by the core emulator + ;; NOTE: These files are not automatically regenerated as they live + ;; in the CVS repository and there's no need to generate extra + ;; commits when all that changes is the header and trailer comments. + (dsdl-if-needed "vlm:alpha-emulator;aistat.sid") + (dsdl-if-needed "vlm:emulator;aihead.sid") + (dsdl-if-needed "vlm:emulator;traps.sid") + (compile-if-needed "vlm:emulator;errortbl" force? :output-file "vlm:alpha-emulator;") + + ;; Macros + (dolist (file '("alphamac" "intrpmac" "stacklis" + "memoryem" "imaclist" "fcallmac" "imacbits" + "imacblok" "imaclexi" "imacgene" "imacinst" "imacialu" + "imacloop" "imacmath" "imacbind" "imacjosh" "imacarra" + "imacpred" "imacsubp" "imactrap")) + (compile-if-needed (format nil "vlm:alpha-emulator;~A" file) force?)) + + ;; The actual emulator core + (translate)) + + (build) diff --git a/compile-g5-emulator.lisp b/compile-g5-emulator.lisp new file mode 100644 index 0000000..7a723fc --- /dev/null +++ b/compile-g5-emulator.lisp @@ -0,0 +1,86 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: COMMON-LISP-USER; Base: 10; Lowercase: Yes -*- + +(in-package "COMMON-LISP-USER") + +;;; Compile the PowerPC (G5) assembly source files using OpenMCL + +;;; TODO: Integrate with MAKE? + +(setf (logical-pathname-translations "VLM") + (let* ((parent + (make-pathname :name nil :type nil :version nil :defaults *load-truename*)) + (target (format nil "~A/**/" parent))) + `(("VLM:VLM;**;" ,target) + ("VLM:**;" ,target)))) + +(defun compile-if-needed (file &optional force? &rest compile-options) + (let* ((input (merge-pathnames file (make-pathname :type "lisp"))) + (output (apply #'compile-file-pathname input compile-options))) + (if (and (not force?) + (probe-file output) + (> (file-write-date output) (file-write-date input))) + (load output :verbose t) + (apply #'compile-file input :verbose t :load t compile-options)))) + +(defun dsdl-if-needed (file &optional force?) + (let* ((input (pathname file)) + (output (merge-pathnames (make-pathname :type "lisp") input))) + (when (or force? + (not (probe-file output)) + (> (file-write-date input) (file-write-date output))) + (let ((*package* (find-package "POWERPC-INTERNALS"))) + (format t "~&;Translating ~S... " input) + (funcall (intern "DSDL" "POWERPC-INTERNALS") input '(:c :asm :lisp)))) + (load output :verbose t))) + +(defun assemble (file) + (let* ((input (merge-pathnames file (make-pathname :type "ppcs"))) + (output (merge-pathnames (make-pathname :type "s") input))) + (format t "~&;Translating ~S... " input) + (funcall (intern "PROCESS-ASM-SOURCE" "POWERPC-INTERNALS") input output))) + +(defun translate () + ;; The actual emulator core + (dolist (file '("ifunhead" "idispat" "ifuncom1" "ifuncom2" + "ifungene" "ifunfcal" "ifunloop" "ifunlist" + "ifuninst" "ifunmath" "ifunarra" "ifunmove" + "ifunpred" "ifunsubp" "ifunfext" "ifunlexi" + "ifunbits" "ifunblok" "ifunbind" "ifunfull" + "ifunbnum" "ifuntrap" "ihalt" "idouble" + "ifunjosh" "ifuntran")) + (assemble (format nil "vlm:g5-emulator;~A" file)))) + +(defun build (&optional force?) + ;; Provide several Genera only packages and a number of definitions + ;; from the SYSTEM (SYS) package that are used by the assembler and + ;; emulator macros. (In theory, these files should work with Lisp + ;; implementations other than OpenMCL with only minor tweaks.) + (load "vlm:support;openmcl-packages" :verbose t) + (compile-if-needed "vlm:support;openmcl-support" force?) + + ;; PowerPC Assembler + (load "vlm:assembler;powerpckg.lisp" :verbose t) + (compile-if-needed "vlm:assembler;powerdsdl" force?) + (compile-if-needed "vlm:assembler;power" force?) + + ;; Ivory data structures and type definitions used by the core emulator + ;; NOTE: These files are not automatically regenerated as they live + ;; in the CVS repository and there's no need to generate extra + ;; commits when all that changes is the header and trailer comments. + (dsdl-if-needed "vlm:g5-emulator;aistat.sid") + (dsdl-if-needed "vlm:emulator;aihead.sid") + (dsdl-if-needed "vlm:emulator;traps.sid") + (compile-if-needed "vlm:emulator;errortbl" force? :output-file "vlm:g5-emulator;") + + ;; Macros + (dolist (file '("powermac" "intrpmac" "stacklis" + "memoryem" "imaclist" "fcallmac" "imacbits" + "imacblok" "imaclexi" "imacgene" "imacinst" "imacialu" + "imacloop" "imacmath" "imacbind" "imacjosh" "imacarra" + "imacpred" "imacsubp" "imactrap")) + (compile-if-needed (format nil "vlm:g5-emulator;~A" file) force?)) + + ;; The actual emulator core + (translate)) + +;; (build) diff --git a/configure b/configure new file mode 100755 index 0000000..ca1c065 --- /dev/null +++ b/configure @@ -0,0 +1,8917 @@ +#! /bin/sh +# Guess values for system-dependent variables and create Makefiles. +# Generated by GNU Autoconf 2.69 for vlm 0.99-1. +# +# Report bugs to . +# +# +# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. +# +# +# This configure script is free software; the Free Software Foundation +# gives unlimited permission to copy, distribute and modify it. +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + +# Use a proper internal environment variable to ensure we don't fall + # into an infinite loop, continuously re-executing ourselves. + if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then + _as_can_reexec=no; export _as_can_reexec; + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +as_fn_exit 255 + fi + # We don't want this to propagate to other subprocesses. + { _as_can_reexec=; unset _as_can_reexec;} +if test "x$CONFIG_SHELL" = x; then + as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which + # is contrary to our usage. Disable this feature. + alias -g '\${1+\"\$@\"}'='\"\$@\"' + setopt NO_GLOB_SUBST +else + case \`(set -o) 2>/dev/null\` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi +" + as_required="as_fn_return () { (exit \$1); } +as_fn_success () { as_fn_return 0; } +as_fn_failure () { as_fn_return 1; } +as_fn_ret_success () { return 0; } +as_fn_ret_failure () { return 1; } + +exitcode=0 +as_fn_success || { exitcode=1; echo as_fn_success failed.; } +as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } +as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } +as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } +if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : + +else + exitcode=1; echo positional parameters were not saved. +fi +test x\$exitcode = x0 || exit 1 +test -x / || exit 1" + as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO + as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO + eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && + test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1 +test \$(( 1 + 1 )) = 2 || exit 1" + if (eval "$as_required") 2>/dev/null; then : + as_have_required=yes +else + as_have_required=no +fi + if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : + +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +as_found=false +for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + as_found=: + case $as_dir in #( + /*) + for as_base in sh bash ksh sh5; do + # Try only shells that exist, to save several forks. + as_shell=$as_dir/$as_base + if { test -f "$as_shell" || test -f "$as_shell.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : + CONFIG_SHELL=$as_shell as_have_required=yes + if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : + break 2 +fi +fi + done;; + esac + as_found=false +done +$as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && + { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : + CONFIG_SHELL=$SHELL as_have_required=yes +fi; } +IFS=$as_save_IFS + + + if test "x$CONFIG_SHELL" != x; then : + export CONFIG_SHELL + # We cannot yet assume a decent shell, so we have to provide a +# neutralization value for shells without unset; and this also +# works around shells that cannot unset nonexistent variables. +# Preserve -v and -x to the replacement shell. +BASH_ENV=/dev/null +ENV=/dev/null +(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV +case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; +esac +exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} +# Admittedly, this is quite paranoid, since all the known shells bail +# out after a failed `exec'. +$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 +exit 255 +fi + + if test x$as_have_required = xno; then : + $as_echo "$0: This script requires a shell more modern than all" + $as_echo "$0: the shells that I found on your system." + if test x${ZSH_VERSION+set} = xset ; then + $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" + $as_echo "$0: be upgraded to zsh 4.3.4 or later." + else + $as_echo "$0: Please tell bug-autoconf@gnu.org and +$0: joachimq@achemich.de about your system, including any +$0: error possibly output before this message. Then install +$0: a modern shell, or manually run the script under such a +$0: shell if you do have one." + fi + exit 1 +fi +fi +fi +SHELL=${CONFIG_SHELL-/bin/sh} +export SHELL +# Unset more variables known to interfere with behavior of common tools. +CLICOLOR_FORCE= GREP_OPTIONS= +unset CLICOLOR_FORCE GREP_OPTIONS + +## --------------------- ## +## M4sh Shell Functions. ## +## --------------------- ## +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + + + as_lineno_1=$LINENO as_lineno_1a=$LINENO + as_lineno_2=$LINENO as_lineno_2a=$LINENO + eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && + test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { + # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) + sed -n ' + p + /[$]LINENO/= + ' <$as_myself | + sed ' + s/[$]LINENO.*/&-/ + t lineno + b + :lineno + N + :loop + s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ + t loop + s/-\n.*// + ' >$as_me.lineno && + chmod +x "$as_me.lineno" || + { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } + + # If we had to re-execute with $CONFIG_SHELL, we're ensured to have + # already done that, so ensure we don't try to do so again and fall + # in an infinite loop. This has already happened in practice. + _as_can_reexec=no; export _as_can_reexec + # Don't try to exec as it changes $[0], causing all sort of problems + # (the dirname of $[0] is not the place where we might find the + # original and so on. Autoconf is especially sensitive to this). + . "./$as_me.lineno" + # Exit status is that of the last command. + exit +} + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +test -n "$DJDIR" || exec 7<&0 &1 + +# Name of the host. +# hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, +# so uname gets run too. +ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` + +# +# Initializations. +# +ac_default_prefix=/usr/local +ac_clean_files= +ac_config_libobj_dir=. +LIBOBJS= +cross_compiling=no +subdirs= +MFLAGS= +MAKEFLAGS= + +# Identity of this package. +PACKAGE_NAME='vlm' +PACKAGE_TARNAME='vlm' +PACKAGE_VERSION='0.99-1' +PACKAGE_STRING='vlm 0.99-1' +PACKAGE_BUGREPORT='joachimq@achemich.de' +PACKAGE_URL='' + +# Factoring default headers for most tests. +ac_includes_default="\ +#include +#ifdef HAVE_SYS_TYPES_H +# include +#endif +#ifdef HAVE_SYS_STAT_H +# include +#endif +#ifdef STDC_HEADERS +# include +# include +#else +# ifdef HAVE_STDLIB_H +# include +# endif +#endif +#ifdef HAVE_STRING_H +# if !defined STDC_HEADERS && defined HAVE_MEMORY_H +# include +# endif +# include +#endif +#ifdef HAVE_STRINGS_H +# include +#endif +#ifdef HAVE_INTTYPES_H +# include +#endif +#ifdef HAVE_STDINT_H +# include +#endif +#ifdef HAVE_UNISTD_H +# include +#endif" + +ac_header_list= +ac_subst_vars='am__EXEEXT_FALSE +am__EXEEXT_TRUE +LTLIBOBJS +LIBOBJS +XMKMF +HCLISP_FALSE +HCLISP_TRUE +CLISP +PTHREAD_CFLAGS +PTHREAD_LIBS +PTHREAD_CC +acx_pthread_config +host_os +host_vendor +host_cpu +host +build_os +build_vendor +build_cpu +build +EGREP +GREP +CPP +RANLIB +am__fastdepCC_FALSE +am__fastdepCC_TRUE +CCDEPMODE +am__nodep +AMDEPBACKSLASH +AMDEP_FALSE +AMDEP_TRUE +am__quote +am__include +DEPDIR +OBJEXT +EXEEXT +ac_ct_CC +CPPFLAGS +LDFLAGS +CFLAGS +CC +AM_BACKSLASH +AM_DEFAULT_VERBOSITY +AM_DEFAULT_V +AM_V +am__untar +am__tar +AMTAR +am__leading_dot +SET_MAKE +AWK +mkdir_p +MKDIR_P +INSTALL_STRIP_PROGRAM +STRIP +install_sh +MAKEINFO +AUTOHEADER +AUTOMAKE +AUTOCONF +ACLOCAL +VERSION +PACKAGE +CYGPATH_W +am__isrc +INSTALL_DATA +INSTALL_SCRIPT +INSTALL_PROGRAM +target_alias +host_alias +build_alias +LIBS +ECHO_T +ECHO_N +ECHO_C +DEFS +mandir +localedir +libdir +psdir +pdfdir +dvidir +htmldir +infodir +docdir +oldincludedir +includedir +localstatedir +sharedstatedir +sysconfdir +datadir +datarootdir +libexecdir +sbindir +bindir +program_transform_name +prefix +exec_prefix +PACKAGE_URL +PACKAGE_BUGREPORT +PACKAGE_STRING +PACKAGE_VERSION +PACKAGE_TARNAME +PACKAGE_NAME +PATH_SEPARATOR +SHELL' +ac_subst_files='' +ac_user_opts=' +enable_option_checking +enable_silent_rules +enable_dependency_tracking +with_x +enable_debug +enable_fast +enable_genera +enable_debug_disk +enable_debug_network +enable_debug_network_ip +enable_debug_network_chaos +enable_debug_network_arp +enable_debug_network_icmp +with_tap +' + ac_precious_vars='build_alias +host_alias +target_alias +CC +CFLAGS +LDFLAGS +LIBS +CPPFLAGS +CPP +XMKMF' + + +# Initialize some variables set by options. +ac_init_help= +ac_init_version=false +ac_unrecognized_opts= +ac_unrecognized_sep= +# The variables have the same names as the options, with +# dashes changed to underlines. +cache_file=/dev/null +exec_prefix=NONE +no_create= +no_recursion= +prefix=NONE +program_prefix=NONE +program_suffix=NONE +program_transform_name=s,x,x, +silent= +site= +srcdir= +verbose= +x_includes=NONE +x_libraries=NONE + +# Installation directory options. +# These are left unexpanded so users can "make install exec_prefix=/foo" +# and all the variables that are supposed to be based on exec_prefix +# by default will actually change. +# Use braces instead of parens because sh, perl, etc. also accept them. +# (The list follows the same order as the GNU Coding Standards.) +bindir='${exec_prefix}/bin' +sbindir='${exec_prefix}/sbin' +libexecdir='${exec_prefix}/libexec' +datarootdir='${prefix}/share' +datadir='${datarootdir}' +sysconfdir='${prefix}/etc' +sharedstatedir='${prefix}/com' +localstatedir='${prefix}/var' +includedir='${prefix}/include' +oldincludedir='/usr/include' +docdir='${datarootdir}/doc/${PACKAGE_TARNAME}' +infodir='${datarootdir}/info' +htmldir='${docdir}' +dvidir='${docdir}' +pdfdir='${docdir}' +psdir='${docdir}' +libdir='${exec_prefix}/lib' +localedir='${datarootdir}/locale' +mandir='${datarootdir}/man' + +ac_prev= +ac_dashdash= +for ac_option +do + # If the previous option needs an argument, assign it. + if test -n "$ac_prev"; then + eval $ac_prev=\$ac_option + ac_prev= + continue + fi + + case $ac_option in + *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; + *=) ac_optarg= ;; + *) ac_optarg=yes ;; + esac + + # Accept the important Cygnus configure options, so we can diagnose typos. + + case $ac_dashdash$ac_option in + --) + ac_dashdash=yes ;; + + -bindir | --bindir | --bindi | --bind | --bin | --bi) + ac_prev=bindir ;; + -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) + bindir=$ac_optarg ;; + + -build | --build | --buil | --bui | --bu) + ac_prev=build_alias ;; + -build=* | --build=* | --buil=* | --bui=* | --bu=*) + build_alias=$ac_optarg ;; + + -cache-file | --cache-file | --cache-fil | --cache-fi \ + | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) + ac_prev=cache_file ;; + -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ + | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) + cache_file=$ac_optarg ;; + + --config-cache | -C) + cache_file=config.cache ;; + + -datadir | --datadir | --datadi | --datad) + ac_prev=datadir ;; + -datadir=* | --datadir=* | --datadi=* | --datad=*) + datadir=$ac_optarg ;; + + -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ + | --dataroo | --dataro | --datar) + ac_prev=datarootdir ;; + -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ + | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) + datarootdir=$ac_optarg ;; + + -disable-* | --disable-*) + ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=no ;; + + -docdir | --docdir | --docdi | --doc | --do) + ac_prev=docdir ;; + -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) + docdir=$ac_optarg ;; + + -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) + ac_prev=dvidir ;; + -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) + dvidir=$ac_optarg ;; + + -enable-* | --enable-*) + ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid feature name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"enable_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval enable_$ac_useropt=\$ac_optarg ;; + + -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ + | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ + | --exec | --exe | --ex) + ac_prev=exec_prefix ;; + -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ + | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ + | --exec=* | --exe=* | --ex=*) + exec_prefix=$ac_optarg ;; + + -gas | --gas | --ga | --g) + # Obsolete; use --with-gas. + with_gas=yes ;; + + -help | --help | --hel | --he | -h) + ac_init_help=long ;; + -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) + ac_init_help=recursive ;; + -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) + ac_init_help=short ;; + + -host | --host | --hos | --ho) + ac_prev=host_alias ;; + -host=* | --host=* | --hos=* | --ho=*) + host_alias=$ac_optarg ;; + + -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) + ac_prev=htmldir ;; + -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ + | --ht=*) + htmldir=$ac_optarg ;; + + -includedir | --includedir | --includedi | --included | --include \ + | --includ | --inclu | --incl | --inc) + ac_prev=includedir ;; + -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ + | --includ=* | --inclu=* | --incl=* | --inc=*) + includedir=$ac_optarg ;; + + -infodir | --infodir | --infodi | --infod | --info | --inf) + ac_prev=infodir ;; + -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) + infodir=$ac_optarg ;; + + -libdir | --libdir | --libdi | --libd) + ac_prev=libdir ;; + -libdir=* | --libdir=* | --libdi=* | --libd=*) + libdir=$ac_optarg ;; + + -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ + | --libexe | --libex | --libe) + ac_prev=libexecdir ;; + -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ + | --libexe=* | --libex=* | --libe=*) + libexecdir=$ac_optarg ;; + + -localedir | --localedir | --localedi | --localed | --locale) + ac_prev=localedir ;; + -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) + localedir=$ac_optarg ;; + + -localstatedir | --localstatedir | --localstatedi | --localstated \ + | --localstate | --localstat | --localsta | --localst | --locals) + ac_prev=localstatedir ;; + -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ + | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) + localstatedir=$ac_optarg ;; + + -mandir | --mandir | --mandi | --mand | --man | --ma | --m) + ac_prev=mandir ;; + -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) + mandir=$ac_optarg ;; + + -nfp | --nfp | --nf) + # Obsolete; use --without-fp. + with_fp=no ;; + + -no-create | --no-create | --no-creat | --no-crea | --no-cre \ + | --no-cr | --no-c | -n) + no_create=yes ;; + + -no-recursion | --no-recursion | --no-recursio | --no-recursi \ + | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) + no_recursion=yes ;; + + -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ + | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ + | --oldin | --oldi | --old | --ol | --o) + ac_prev=oldincludedir ;; + -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ + | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ + | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) + oldincludedir=$ac_optarg ;; + + -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) + ac_prev=prefix ;; + -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) + prefix=$ac_optarg ;; + + -program-prefix | --program-prefix | --program-prefi | --program-pref \ + | --program-pre | --program-pr | --program-p) + ac_prev=program_prefix ;; + -program-prefix=* | --program-prefix=* | --program-prefi=* \ + | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) + program_prefix=$ac_optarg ;; + + -program-suffix | --program-suffix | --program-suffi | --program-suff \ + | --program-suf | --program-su | --program-s) + ac_prev=program_suffix ;; + -program-suffix=* | --program-suffix=* | --program-suffi=* \ + | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) + program_suffix=$ac_optarg ;; + + -program-transform-name | --program-transform-name \ + | --program-transform-nam | --program-transform-na \ + | --program-transform-n | --program-transform- \ + | --program-transform | --program-transfor \ + | --program-transfo | --program-transf \ + | --program-trans | --program-tran \ + | --progr-tra | --program-tr | --program-t) + ac_prev=program_transform_name ;; + -program-transform-name=* | --program-transform-name=* \ + | --program-transform-nam=* | --program-transform-na=* \ + | --program-transform-n=* | --program-transform-=* \ + | --program-transform=* | --program-transfor=* \ + | --program-transfo=* | --program-transf=* \ + | --program-trans=* | --program-tran=* \ + | --progr-tra=* | --program-tr=* | --program-t=*) + program_transform_name=$ac_optarg ;; + + -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) + ac_prev=pdfdir ;; + -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) + pdfdir=$ac_optarg ;; + + -psdir | --psdir | --psdi | --psd | --ps) + ac_prev=psdir ;; + -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) + psdir=$ac_optarg ;; + + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + silent=yes ;; + + -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) + ac_prev=sbindir ;; + -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ + | --sbi=* | --sb=*) + sbindir=$ac_optarg ;; + + -sharedstatedir | --sharedstatedir | --sharedstatedi \ + | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ + | --sharedst | --shareds | --shared | --share | --shar \ + | --sha | --sh) + ac_prev=sharedstatedir ;; + -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ + | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ + | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ + | --sha=* | --sh=*) + sharedstatedir=$ac_optarg ;; + + -site | --site | --sit) + ac_prev=site ;; + -site=* | --site=* | --sit=*) + site=$ac_optarg ;; + + -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) + ac_prev=srcdir ;; + -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) + srcdir=$ac_optarg ;; + + -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ + | --syscon | --sysco | --sysc | --sys | --sy) + ac_prev=sysconfdir ;; + -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ + | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) + sysconfdir=$ac_optarg ;; + + -target | --target | --targe | --targ | --tar | --ta | --t) + ac_prev=target_alias ;; + -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) + target_alias=$ac_optarg ;; + + -v | -verbose | --verbose | --verbos | --verbo | --verb) + verbose=yes ;; + + -version | --version | --versio | --versi | --vers | -V) + ac_init_version=: ;; + + -with-* | --with-*) + ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=\$ac_optarg ;; + + -without-* | --without-*) + ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` + # Reject names that are not valid shell variable names. + expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && + as_fn_error $? "invalid package name: $ac_useropt" + ac_useropt_orig=$ac_useropt + ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` + case $ac_user_opts in + *" +"with_$ac_useropt" +"*) ;; + *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" + ac_unrecognized_sep=', ';; + esac + eval with_$ac_useropt=no ;; + + --x) + # Obsolete; use --with-x. + with_x=yes ;; + + -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ + | --x-incl | --x-inc | --x-in | --x-i) + ac_prev=x_includes ;; + -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ + | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) + x_includes=$ac_optarg ;; + + -x-libraries | --x-libraries | --x-librarie | --x-librari \ + | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) + ac_prev=x_libraries ;; + -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ + | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) + x_libraries=$ac_optarg ;; + + -*) as_fn_error $? "unrecognized option: \`$ac_option' +Try \`$0 --help' for more information" + ;; + + *=*) + ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` + # Reject names that are not valid shell variable names. + case $ac_envvar in #( + '' | [0-9]* | *[!_$as_cr_alnum]* ) + as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; + esac + eval $ac_envvar=\$ac_optarg + export $ac_envvar ;; + + *) + # FIXME: should be removed in autoconf 3.0. + $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 + expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && + $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" + ;; + + esac +done + +if test -n "$ac_prev"; then + ac_option=--`echo $ac_prev | sed 's/_/-/g'` + as_fn_error $? "missing argument to $ac_option" +fi + +if test -n "$ac_unrecognized_opts"; then + case $enable_option_checking in + no) ;; + fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; + *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; + esac +fi + +# Check all directory arguments for consistency. +for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ + datadir sysconfdir sharedstatedir localstatedir includedir \ + oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ + libdir localedir mandir +do + eval ac_val=\$$ac_var + # Remove trailing slashes. + case $ac_val in + */ ) + ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` + eval $ac_var=\$ac_val;; + esac + # Be sure to have absolute directory names. + case $ac_val in + [\\/$]* | ?:[\\/]* ) continue;; + NONE | '' ) case $ac_var in *prefix ) continue;; esac;; + esac + as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" +done + +# There might be people who depend on the old broken behavior: `$host' +# used to hold the argument of --host etc. +# FIXME: To remove some day. +build=$build_alias +host=$host_alias +target=$target_alias + +# FIXME: To remove some day. +if test "x$host_alias" != x; then + if test "x$build_alias" = x; then + cross_compiling=maybe + elif test "x$build_alias" != "x$host_alias"; then + cross_compiling=yes + fi +fi + +ac_tool_prefix= +test -n "$host_alias" && ac_tool_prefix=$host_alias- + +test "$silent" = yes && exec 6>/dev/null + + +ac_pwd=`pwd` && test -n "$ac_pwd" && +ac_ls_di=`ls -di .` && +ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || + as_fn_error $? "working directory cannot be determined" +test "X$ac_ls_di" = "X$ac_pwd_ls_di" || + as_fn_error $? "pwd does not report name of working directory" + + +# Find the source files, if location was not specified. +if test -z "$srcdir"; then + ac_srcdir_defaulted=yes + # Try the directory containing this script, then the parent directory. + ac_confdir=`$as_dirname -- "$as_myself" || +$as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_myself" : 'X\(//\)[^/]' \| \ + X"$as_myself" : 'X\(//\)$' \| \ + X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_myself" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + srcdir=$ac_confdir + if test ! -r "$srcdir/$ac_unique_file"; then + srcdir=.. + fi +else + ac_srcdir_defaulted=no +fi +if test ! -r "$srcdir/$ac_unique_file"; then + test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." + as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" +fi +ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" +ac_abs_confdir=`( + cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" + pwd)` +# When building in place, set srcdir=. +if test "$ac_abs_confdir" = "$ac_pwd"; then + srcdir=. +fi +# Remove unnecessary trailing slashes from srcdir. +# Double slashes in file names in object file debugging info +# mess up M-x gdb in Emacs. +case $srcdir in +*/) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; +esac +for ac_var in $ac_precious_vars; do + eval ac_env_${ac_var}_set=\${${ac_var}+set} + eval ac_env_${ac_var}_value=\$${ac_var} + eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} + eval ac_cv_env_${ac_var}_value=\$${ac_var} +done + +# +# Report the --help message. +# +if test "$ac_init_help" = "long"; then + # Omit some internal or obsolete options to make the list less imposing. + # This message is too long to be a string in the A/UX 3.1 sh. + cat <<_ACEOF +\`configure' configures vlm 0.99-1 to adapt to many kinds of systems. + +Usage: $0 [OPTION]... [VAR=VALUE]... + +To assign environment variables (e.g., CC, CFLAGS...), specify them as +VAR=VALUE. See below for descriptions of some of the useful variables. + +Defaults for the options are specified in brackets. + +Configuration: + -h, --help display this help and exit + --help=short display options specific to this package + --help=recursive display the short help of all the included packages + -V, --version display version information and exit + -q, --quiet, --silent do not print \`checking ...' messages + --cache-file=FILE cache test results in FILE [disabled] + -C, --config-cache alias for \`--cache-file=config.cache' + -n, --no-create do not create output files + --srcdir=DIR find the sources in DIR [configure dir or \`..'] + +Installation directories: + --prefix=PREFIX install architecture-independent files in PREFIX + [$ac_default_prefix] + --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX + [PREFIX] + +By default, \`make install' will install all the files in +\`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify +an installation prefix other than \`$ac_default_prefix' using \`--prefix', +for instance \`--prefix=\$HOME'. + +For better control, use the options below. + +Fine tuning of the installation directories: + --bindir=DIR user executables [EPREFIX/bin] + --sbindir=DIR system admin executables [EPREFIX/sbin] + --libexecdir=DIR program executables [EPREFIX/libexec] + --sysconfdir=DIR read-only single-machine data [PREFIX/etc] + --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] + --localstatedir=DIR modifiable single-machine data [PREFIX/var] + --libdir=DIR object code libraries [EPREFIX/lib] + --includedir=DIR C header files [PREFIX/include] + --oldincludedir=DIR C header files for non-gcc [/usr/include] + --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] + --datadir=DIR read-only architecture-independent data [DATAROOTDIR] + --infodir=DIR info documentation [DATAROOTDIR/info] + --localedir=DIR locale-dependent data [DATAROOTDIR/locale] + --mandir=DIR man documentation [DATAROOTDIR/man] + --docdir=DIR documentation root [DATAROOTDIR/doc/vlm] + --htmldir=DIR html documentation [DOCDIR] + --dvidir=DIR dvi documentation [DOCDIR] + --pdfdir=DIR pdf documentation [DOCDIR] + --psdir=DIR ps documentation [DOCDIR] +_ACEOF + + cat <<\_ACEOF + +Program names: + --program-prefix=PREFIX prepend PREFIX to installed program names + --program-suffix=SUFFIX append SUFFIX to installed program names + --program-transform-name=PROGRAM run sed PROGRAM on installed program names + +X features: + --x-includes=DIR X include files are in DIR + --x-libraries=DIR X library files are in DIR + +System types: + --build=BUILD configure for building on BUILD [guessed] + --host=HOST cross-compile to build programs to run on HOST [BUILD] +_ACEOF +fi + +if test -n "$ac_init_help"; then + case $ac_init_help in + short | recursive ) echo "Configuration of vlm 0.99-1:";; + esac + cat <<\_ACEOF + +Optional Features: + --disable-option-checking ignore unrecognized --enable/--with options + --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) + --enable-FEATURE[=ARG] include FEATURE [ARG=yes] + --enable-silent-rules less verbose build output (undo: "make V=1") + --disable-silent-rules verbose build output (undo: "make V=0") + --enable-dependency-tracking + do not reject slow dependency extractors + --disable-dependency-tracking + speeds up one-time build + --enable-debug enable debuggeable code (-g2) (default=no) + --disable-fast disable optimization for speed (default=no) + --enable-genera enable compilation for genera (default=yes) + --enable-debug-disk enable disk debugging (default=no) + --enable-debug-network enable network debugging (default=no) + --enable-debug-network-ip + enable IP network debugging (default=no) + --enable-debug-network-chaos + enable CHAOS network debugging (default=no) + --enable-debug-network-arp + enable ARP network debugging (default=no) + --enable-debug-network-icmp + enable ICMP network debugging (default=no) + +Optional Packages: + --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] + --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) + --with-x use the X Window System + --with-tap use tap network interface (default=yes) + +Some influential environment variables: + CC C compiler command + CFLAGS C compiler flags + LDFLAGS linker flags, e.g. -L if you have libraries in a + nonstandard directory + LIBS libraries to pass to the linker, e.g. -l + CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if + you have headers in a nonstandard directory + CPP C preprocessor + XMKMF Path to xmkmf, Makefile generator for X Window System + +Use these variables to override the choices made by `configure' or to help +it to find libraries and programs with nonstandard names/locations. + +Report bugs to . +_ACEOF +ac_status=$? +fi + +if test "$ac_init_help" = "recursive"; then + # If there are subdirs, report their specific --help. + for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue + test -d "$ac_dir" || + { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || + continue + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + cd "$ac_dir" || { ac_status=$?; continue; } + # Check for guested configure. + if test -f "$ac_srcdir/configure.gnu"; then + echo && + $SHELL "$ac_srcdir/configure.gnu" --help=recursive + elif test -f "$ac_srcdir/configure"; then + echo && + $SHELL "$ac_srcdir/configure" --help=recursive + else + $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 + fi || ac_status=$? + cd "$ac_pwd" || { ac_status=$?; break; } + done +fi + +test -n "$ac_init_help" && exit $ac_status +if $ac_init_version; then + cat <<\_ACEOF +vlm configure 0.99-1 +generated by GNU Autoconf 2.69 + +Copyright (C) 2012 Free Software Foundation, Inc. +This configure script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it. +_ACEOF + exit +fi + +## ------------------------ ## +## Autoconf initialization. ## +## ------------------------ ## + +# ac_fn_c_try_compile LINENO +# -------------------------- +# Try to compile conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext + if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest.$ac_objext; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_compile + +# ac_fn_c_try_run LINENO +# ---------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. Assumes +# that executables *can* be run. +ac_fn_c_try_run () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then : + ac_retval=0 +else + $as_echo "$as_me: program exited with status $ac_status" >&5 + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=$ac_status +fi + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_run + +# ac_fn_c_compute_int LINENO EXPR VAR INCLUDES +# -------------------------------------------- +# Tries to find the compile-time value of EXPR in a program that includes +# INCLUDES, setting VAR accordingly. Returns whether the value could be +# computed +ac_fn_c_compute_int () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if test "$cross_compiling" = yes; then + # Depending upon the size, compute the lo and hi bounds. +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=0 ac_mid=0 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid; break +else + as_fn_arith $ac_mid + 1 && ac_lo=$as_val + if test $ac_lo -le $ac_mid; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid + 1 && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) < 0)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=-1 ac_mid=-1 + while :; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) >= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_lo=$ac_mid; break +else + as_fn_arith '(' $ac_mid ')' - 1 && ac_hi=$as_val + if test $ac_mid -le $ac_hi; then + ac_lo= ac_hi= + break + fi + as_fn_arith 2 '*' $ac_mid && ac_mid=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + done +else + ac_lo= ac_hi= +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +# Binary search between lo and hi bounds. +while test "x$ac_lo" != "x$ac_hi"; do + as_fn_arith '(' $ac_hi - $ac_lo ')' / 2 + $ac_lo && ac_mid=$as_val + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +static int test_array [1 - 2 * !(($2) <= $ac_mid)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_hi=$ac_mid +else + as_fn_arith '(' $ac_mid ')' + 1 && ac_lo=$as_val +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done +case $ac_lo in #(( +?*) eval "$3=\$ac_lo"; ac_retval=0 ;; +'') ac_retval=1 ;; +esac + else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +static long int longval () { return $2; } +static unsigned long int ulongval () { return $2; } +#include +#include +int +main () +{ + + FILE *f = fopen ("conftest.val", "w"); + if (! f) + return 1; + if (($2) < 0) + { + long int i = longval (); + if (i != ($2)) + return 1; + fprintf (f, "%ld", i); + } + else + { + unsigned long int i = ulongval (); + if (i != ($2)) + return 1; + fprintf (f, "%lu", i); + } + /* Do not output a trailing newline, as this causes \r\n confusion + on some platforms. */ + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + echo >>conftest.val; read $3 &5 + (eval "$ac_cpp conftest.$ac_ext") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } > conftest.i && { + test -z "$ac_c_preproc_warn_flag$ac_c_werror_flag" || + test ! -s conftest.err + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_cpp + +# ac_fn_c_check_header_compile LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists and can be compiled using the include files in +# INCLUDES, setting the cache variable VAR accordingly. +ac_fn_c_check_header_compile () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_compile + +# ac_fn_c_try_link LINENO +# ----------------------- +# Try to link conftest.$ac_ext, and return whether this succeeded. +ac_fn_c_try_link () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + rm -f conftest.$ac_objext conftest$ac_exeext + if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + grep -v '^ *+' conftest.err >conftest.er1 + cat conftest.er1 >&5 + mv -f conftest.er1 conftest.err + fi + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && { + test -z "$ac_c_werror_flag" || + test ! -s conftest.err + } && test -s conftest$ac_exeext && { + test "$cross_compiling" = yes || + test -x conftest$ac_exeext + }; then : + ac_retval=0 +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + + ac_retval=1 +fi + # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information + # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would + # interfere with the next link command; also delete a directory that is + # left behind by Apple's compiler. We do this before executing the actions. + rm -rf conftest.dSYM conftest_ipa8_conftest.oo + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + as_fn_set_status $ac_retval + +} # ac_fn_c_try_link + +# ac_fn_c_check_header_mongrel LINENO HEADER VAR INCLUDES +# ------------------------------------------------------- +# Tests whether HEADER exists, giving a warning if it cannot be compiled using +# the include files in INCLUDES and setting the cache variable VAR +# accordingly. +ac_fn_c_check_header_mongrel () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + if eval \${$3+:} false; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +else + # Is the header compilable? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 usability" >&5 +$as_echo_n "checking $2 usability... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +#include <$2> +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_header_compiler=yes +else + ac_header_compiler=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_compiler" >&5 +$as_echo "$ac_header_compiler" >&6; } + +# Is the header present? +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking $2 presence" >&5 +$as_echo_n "checking $2 presence... " >&6; } +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include <$2> +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + ac_header_preproc=yes +else + ac_header_preproc=no +fi +rm -f conftest.err conftest.i conftest.$ac_ext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_header_preproc" >&5 +$as_echo "$ac_header_preproc" >&6; } + +# So? What about this header? +case $ac_header_compiler:$ac_header_preproc:$ac_c_preproc_warn_flag in #(( + yes:no: ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&5 +$as_echo "$as_me: WARNING: $2: accepted by the compiler, rejected by the preprocessor!" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} + ;; + no:yes:* ) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: present but cannot be compiled" >&5 +$as_echo "$as_me: WARNING: $2: present but cannot be compiled" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: check for missing prerequisite headers?" >&5 +$as_echo "$as_me: WARNING: $2: check for missing prerequisite headers?" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: see the Autoconf documentation" >&5 +$as_echo "$as_me: WARNING: $2: see the Autoconf documentation" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&5 +$as_echo "$as_me: WARNING: $2: section \"Present But Cannot Be Compiled\"" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $2: proceeding with the compiler's result" >&5 +$as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} +( $as_echo "## ----------------------------------- ## +## Report this to joachimq@achemich.de ## +## ----------------------------------- ##" + ) | sed "s/^/$as_me: WARNING: /" >&2 + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=\$ac_header_compiler" +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } +fi + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_header_mongrel + +# ac_fn_c_check_type LINENO TYPE VAR INCLUDES +# ------------------------------------------- +# Tests whether TYPE exists after having included INCLUDES, setting cache +# variable VAR accordingly. +ac_fn_c_check_type () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof ($2)) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$4 +int +main () +{ +if (sizeof (($2))) + return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + eval "$3=yes" +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_type + +# ac_fn_c_find_intX_t LINENO BITS VAR +# ----------------------------------- +# Finds a signed integer type with width BITS, setting cache variable VAR +# accordingly. +ac_fn_c_find_intX_t () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for int$2_t" >&5 +$as_echo_n "checking for int$2_t... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + # Order is important - never check a type that is potentially smaller + # than half of the expected target width. + for ac_type in int$2_t 'int' 'long int' \ + 'long long int' 'short int' 'signed char'; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default + enum { N = $2 / 2 - 1 }; +int +main () +{ +static int test_array [1 - 2 * !(0 < ($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 1))]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default + enum { N = $2 / 2 - 1 }; +int +main () +{ +static int test_array [1 - 2 * !(($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 1) + < ($ac_type) ((((($ac_type) 1 << N) << N) - 1) * 2 + 2))]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + case $ac_type in #( + int$2_t) : + eval "$3=yes" ;; #( + *) : + eval "$3=\$ac_type" ;; +esac +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if eval test \"x\$"$3"\" = x"no"; then : + +else + break +fi + done +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_find_intX_t + +# ac_fn_c_find_uintX_t LINENO BITS VAR +# ------------------------------------ +# Finds an unsigned integer type with width BITS, setting cache variable VAR +# accordingly. +ac_fn_c_find_uintX_t () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for uint$2_t" >&5 +$as_echo_n "checking for uint$2_t... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + eval "$3=no" + # Order is important - never check a type that is potentially smaller + # than half of the expected target width. + for ac_type in uint$2_t 'unsigned int' 'unsigned long int' \ + 'unsigned long long int' 'unsigned short int' 'unsigned char'; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +int +main () +{ +static int test_array [1 - 2 * !((($ac_type) -1 >> ($2 / 2 - 1)) >> ($2 / 2 - 1) == 3)]; +test_array [0] = 0; +return test_array [0]; + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + case $ac_type in #( + uint$2_t) : + eval "$3=yes" ;; #( + *) : + eval "$3=\$ac_type" ;; +esac +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + if eval test \"x\$"$3"\" = x"no"; then : + +else + break +fi + done +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_find_uintX_t + +# ac_fn_c_check_func LINENO FUNC VAR +# ---------------------------------- +# Tests whether FUNC exists, setting the cache variable VAR accordingly +ac_fn_c_check_func () +{ + as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 +$as_echo_n "checking for $2... " >&6; } +if eval \${$3+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +/* Define $2 to an innocuous variant, in case declares $2. + For example, HP-UX 11i declares gettimeofday. */ +#define $2 innocuous_$2 + +/* System header to define __stub macros and hopefully few prototypes, + which can conflict with char $2 (); below. + Prefer to if __STDC__ is defined, since + exists even on freestanding compilers. */ + +#ifdef __STDC__ +# include +#else +# include +#endif + +#undef $2 + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char $2 (); +/* The GNU C library defines this for functions which it implements + to always fail with ENOSYS. Some functions are actually named + something starting with __ and the normal name is an alias. */ +#if defined __stub_$2 || defined __stub___$2 +choke me +#endif + +int +main () +{ +return $2 (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + eval "$3=yes" +else + eval "$3=no" +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi +eval ac_res=\$$3 + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 +$as_echo "$ac_res" >&6; } + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno + +} # ac_fn_c_check_func +cat >config.log <<_ACEOF +This file contains any messages produced by compilers while +running configure, to aid debugging if configure makes a mistake. + +It was created by vlm $as_me 0.99-1, which was +generated by GNU Autoconf 2.69. Invocation command line was + + $ $0 $@ + +_ACEOF +exec 5>>config.log +{ +cat <<_ASUNAME +## --------- ## +## Platform. ## +## --------- ## + +hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` + +/bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` +/usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` +/bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` +/bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` + +_ASUNAME + +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + $as_echo "PATH: $as_dir" + done +IFS=$as_save_IFS + +} >&5 + +cat >&5 <<_ACEOF + + +## ----------- ## +## Core tests. ## +## ----------- ## + +_ACEOF + + +# Keep a trace of the command line. +# Strip out --no-create and --no-recursion so they do not pile up. +# Strip out --silent because we don't want to record it for future runs. +# Also quote any args containing shell meta-characters. +# Make two passes to allow for proper duplicate-argument suppression. +ac_configure_args= +ac_configure_args0= +ac_configure_args1= +ac_must_keep_next=false +for ac_pass in 1 2 +do + for ac_arg + do + case $ac_arg in + -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil) + continue ;; + *\'*) + ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + case $ac_pass in + 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; + 2) + as_fn_append ac_configure_args1 " '$ac_arg'" + if test $ac_must_keep_next = true; then + ac_must_keep_next=false # Got value, back to normal. + else + case $ac_arg in + *=* | --config-cache | -C | -disable-* | --disable-* \ + | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ + | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ + | -with-* | --with-* | -without-* | --without-* | --x) + case "$ac_configure_args0 " in + "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; + esac + ;; + -* ) ac_must_keep_next=true ;; + esac + fi + as_fn_append ac_configure_args " '$ac_arg'" + ;; + esac + done +done +{ ac_configure_args0=; unset ac_configure_args0;} +{ ac_configure_args1=; unset ac_configure_args1;} + +# When interrupted or exit'd, cleanup temporary files, and complete +# config.log. We remove comments because anyway the quotes in there +# would cause problems or look ugly. +# WARNING: Use '\'' to represent an apostrophe within the trap. +# WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. +trap 'exit_status=$? + # Save into config.log some information that might help in debugging. + { + echo + + $as_echo "## ---------------- ## +## Cache variables. ## +## ---------------- ##" + echo + # The following way of writing the cache mishandles newlines in values, +( + for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + (set) 2>&1 | + case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + sed -n \ + "s/'\''/'\''\\\\'\'''\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" + ;; #( + *) + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) + echo + + $as_echo "## ----------------- ## +## Output variables. ## +## ----------------- ##" + echo + for ac_var in $ac_subst_vars + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + + if test -n "$ac_subst_files"; then + $as_echo "## ------------------- ## +## File substitutions. ## +## ------------------- ##" + echo + for ac_var in $ac_subst_files + do + eval ac_val=\$$ac_var + case $ac_val in + *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; + esac + $as_echo "$ac_var='\''$ac_val'\''" + done | sort + echo + fi + + if test -s confdefs.h; then + $as_echo "## ----------- ## +## confdefs.h. ## +## ----------- ##" + echo + cat confdefs.h + echo + fi + test "$ac_signal" != 0 && + $as_echo "$as_me: caught signal $ac_signal" + $as_echo "$as_me: exit $exit_status" + } >&5 + rm -f core *.core core.conftest.* && + rm -f -r conftest* confdefs* conf$$* $ac_clean_files && + exit $exit_status +' 0 +for ac_signal in 1 2 13 15; do + trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal +done +ac_signal=0 + +# confdefs.h avoids OS command line length limits that DEFS can exceed. +rm -f -r conftest* confdefs.h + +$as_echo "/* confdefs.h */" > confdefs.h + +# Predefined preprocessor variables. + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_NAME "$PACKAGE_NAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_TARNAME "$PACKAGE_TARNAME" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_VERSION "$PACKAGE_VERSION" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_STRING "$PACKAGE_STRING" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" +_ACEOF + +cat >>confdefs.h <<_ACEOF +#define PACKAGE_URL "$PACKAGE_URL" +_ACEOF + + +# Let the site file select an alternate cache file if it wants to. +# Prefer an explicitly selected file to automatically selected ones. +ac_site_file1=NONE +ac_site_file2=NONE +if test -n "$CONFIG_SITE"; then + # We do not want a PATH search for config.site. + case $CONFIG_SITE in #(( + -*) ac_site_file1=./$CONFIG_SITE;; + */*) ac_site_file1=$CONFIG_SITE;; + *) ac_site_file1=./$CONFIG_SITE;; + esac +elif test "x$prefix" != xNONE; then + ac_site_file1=$prefix/share/config.site + ac_site_file2=$prefix/etc/config.site +else + ac_site_file1=$ac_default_prefix/share/config.site + ac_site_file2=$ac_default_prefix/etc/config.site +fi +for ac_site_file in "$ac_site_file1" "$ac_site_file2" +do + test "x$ac_site_file" = xNONE && continue + if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 +$as_echo "$as_me: loading site script $ac_site_file" >&6;} + sed 's/^/| /' "$ac_site_file" >&5 + . "$ac_site_file" \ + || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "failed to load site script $ac_site_file +See \`config.log' for more details" "$LINENO" 5; } + fi +done + +if test -r "$cache_file"; then + # Some versions of bash will fail to source /dev/null (special files + # actually), so we avoid doing that. DJGPP emulates it as a regular file. + if test /dev/null != "$cache_file" && test -f "$cache_file"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 +$as_echo "$as_me: loading cache $cache_file" >&6;} + case $cache_file in + [\\/]* | ?:[\\/]* ) . "$cache_file";; + *) . "./$cache_file";; + esac + fi +else + { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 +$as_echo "$as_me: creating cache $cache_file" >&6;} + >$cache_file +fi + +as_fn_append ac_header_list " stdlib.h" +as_fn_append ac_header_list " unistd.h" +as_fn_append ac_header_list " sys/param.h" +# Check that the precious variables saved in the cache have kept the same +# value. +ac_cache_corrupted=false +for ac_var in $ac_precious_vars; do + eval ac_old_set=\$ac_cv_env_${ac_var}_set + eval ac_new_set=\$ac_env_${ac_var}_set + eval ac_old_val=\$ac_cv_env_${ac_var}_value + eval ac_new_val=\$ac_env_${ac_var}_value + case $ac_old_set,$ac_new_set in + set,) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,set) + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 +$as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} + ac_cache_corrupted=: ;; + ,);; + *) + if test "x$ac_old_val" != "x$ac_new_val"; then + # differences in whitespace do not lead to failure. + ac_old_val_w=`echo x $ac_old_val` + ac_new_val_w=`echo x $ac_new_val` + if test "$ac_old_val_w" != "$ac_new_val_w"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 +$as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} + ac_cache_corrupted=: + else + { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 +$as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} + eval $ac_var=\$ac_old_val + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 +$as_echo "$as_me: former value: \`$ac_old_val'" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 +$as_echo "$as_me: current value: \`$ac_new_val'" >&2;} + fi;; + esac + # Pass precious variables to config.status. + if test "$ac_new_set" = set; then + case $ac_new_val in + *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; + *) ac_arg=$ac_var=$ac_new_val ;; + esac + case " $ac_configure_args " in + *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. + *) as_fn_append ac_configure_args " '$ac_arg'" ;; + esac + fi +done +if $ac_cache_corrupted; then + { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} + { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 +$as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} + as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 +fi +## -------------------- ## +## Main body of script. ## +## -------------------- ## + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +am__api_version='1.13' + +ac_aux_dir= +for ac_dir in "$srcdir" "$srcdir/.." "$srcdir/../.."; do + if test -f "$ac_dir/install-sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install-sh -c" + break + elif test -f "$ac_dir/install.sh"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/install.sh -c" + break + elif test -f "$ac_dir/shtool"; then + ac_aux_dir=$ac_dir + ac_install_sh="$ac_aux_dir/shtool install -c" + break + fi +done +if test -z "$ac_aux_dir"; then + as_fn_error $? "cannot find install-sh, install.sh, or shtool in \"$srcdir\" \"$srcdir/..\" \"$srcdir/../..\"" "$LINENO" 5 +fi + +# These three variables are undocumented and unsupported, +# and are intended to be withdrawn in a future Autoconf release. +# They can cause serious problems if a builder's source tree is in a directory +# whose full name contains unusual characters. +ac_config_guess="$SHELL $ac_aux_dir/config.guess" # Please don't use this var. +ac_config_sub="$SHELL $ac_aux_dir/config.sub" # Please don't use this var. +ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. + + +# Find a good install program. We prefer a C program (faster), +# so one script is as good as another. But avoid the broken or +# incompatible versions: +# SysV /etc/install, /usr/sbin/install +# SunOS /usr/etc/install +# IRIX /sbin/install +# AIX /bin/install +# AmigaOS /C/install, which installs bootblocks on floppy discs +# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag +# AFS /usr/afsws/bin/install, which mishandles nonexistent args +# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff" +# OS/2's system install, which has a completely different semantic +# ./install, which can be erroneously created by make from ./install.sh. +# Reject install programs that cannot install multiple files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 +$as_echo_n "checking for a BSD-compatible install... " >&6; } +if test -z "$INSTALL"; then +if ${ac_cv_path_install+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + # Account for people who put trailing slashes in PATH elements. +case $as_dir/ in #(( + ./ | .// | /[cC]/* | \ + /etc/* | /usr/sbin/* | /usr/etc/* | /sbin/* | /usr/afsws/bin/* | \ + ?:[\\/]os2[\\/]install[\\/]* | ?:[\\/]OS2[\\/]INSTALL[\\/]* | \ + /usr/ucb/* ) ;; + *) + # OSF1 and SCO ODT 3.0 have their own names for install. + # Don't use installbsd from OSF since it installs stuff as root + # by default. + for ac_prog in ginstall scoinst install; do + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then + if test $ac_prog = install && + grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # AIX install. It has an incompatible calling convention. + : + elif test $ac_prog = install && + grep pwplus "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then + # program-specific install script used by HP pwplus--don't use. + : + else + rm -rf conftest.one conftest.two conftest.dir + echo one > conftest.one + echo two > conftest.two + mkdir conftest.dir + if "$as_dir/$ac_prog$ac_exec_ext" -c conftest.one conftest.two "`pwd`/conftest.dir" && + test -s conftest.one && test -s conftest.two && + test -s conftest.dir/conftest.one && + test -s conftest.dir/conftest.two + then + ac_cv_path_install="$as_dir/$ac_prog$ac_exec_ext -c" + break 3 + fi + fi + fi + done + done + ;; +esac + + done +IFS=$as_save_IFS + +rm -rf conftest.one conftest.two conftest.dir + +fi + if test "${ac_cv_path_install+set}" = set; then + INSTALL=$ac_cv_path_install + else + # As a last resort, use the slow shell script. Don't cache a + # value for INSTALL within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + INSTALL=$ac_install_sh + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $INSTALL" >&5 +$as_echo "$INSTALL" >&6; } + +# Use test -z because SunOS4 sh mishandles braces in ${var-val}. +# It thinks the first close brace ends the variable substitution. +test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}' + +test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL}' + +test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644' + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether build environment is sane" >&5 +$as_echo_n "checking whether build environment is sane... " >&6; } +# Reject unsafe characters in $srcdir or the absolute working directory +# name. Accept space and tab only in the latter. +am_lf=' +' +case `pwd` in + *[\\\"\#\$\&\'\`$am_lf]*) + as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;; +esac +case $srcdir in + *[\\\"\#\$\&\'\`$am_lf\ \ ]*) + as_fn_error $? "unsafe srcdir value: '$srcdir'" "$LINENO" 5;; +esac + +# Do 'set' in a subshell so we don't clobber the current shell's +# arguments. Must try -L first in case configure is actually a +# symlink; some systems play weird games with the mod time of symlinks +# (eg FreeBSD returns the mod time of the symlink's containing +# directory). +if ( + am_has_slept=no + for am_try in 1 2; do + echo "timestamp, slept: $am_has_slept" > conftest.file + set X `ls -Lt "$srcdir/configure" conftest.file 2> /dev/null` + if test "$*" = "X"; then + # -L didn't work. + set X `ls -t "$srcdir/configure" conftest.file` + fi + if test "$*" != "X $srcdir/configure conftest.file" \ + && test "$*" != "X conftest.file $srcdir/configure"; then + + # If neither matched, then we have a broken ls. This can happen + # if, for instance, CONFIG_SHELL is bash and it inherits a + # broken ls alias from the environment. This has actually + # happened. Such a system could not be considered "sane". + as_fn_error $? "ls -t appears to fail. Make sure there is not a broken + alias in your environment" "$LINENO" 5 + fi + if test "$2" = conftest.file || test $am_try -eq 2; then + break + fi + # Just in case. + sleep 1 + am_has_slept=yes + done + test "$2" = conftest.file + ) +then + # Ok. + : +else + as_fn_error $? "newly created file is older than distributed files! +Check your system clock" "$LINENO" 5 +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +# If we didn't sleep, we still need to ensure time stamps of config.status and +# generated files are strictly newer. +am_sleep_pid= +if grep 'slept: no' conftest.file >/dev/null 2>&1; then + ( sleep 1 ) & + am_sleep_pid=$! +fi + +rm -f conftest.file + +test "$program_prefix" != NONE && + program_transform_name="s&^&$program_prefix&;$program_transform_name" +# Use a double $ so make ignores it. +test "$program_suffix" != NONE && + program_transform_name="s&\$&$program_suffix&;$program_transform_name" +# Double any \ or $. +# By default was `s,x,x', remove it if useless. +ac_script='s/[\\$]/&&/g;s/;s,x,x,$//' +program_transform_name=`$as_echo "$program_transform_name" | sed "$ac_script"` + +# Expand $ac_aux_dir to an absolute path. +am_aux_dir=`cd "$ac_aux_dir" && pwd` + +if test x"${MISSING+set}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + MISSING="\${SHELL} \"$am_aux_dir/missing\"" ;; + *) + MISSING="\${SHELL} $am_aux_dir/missing" ;; + esac +fi +# Use eval to expand $SHELL +if eval "$MISSING --is-lightweight"; then + am_missing_run="$MISSING " +else + am_missing_run= + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: 'missing' script is too old or missing" >&5 +$as_echo "$as_me: WARNING: 'missing' script is too old or missing" >&2;} +fi + +if test x"${install_sh}" != xset; then + case $am_aux_dir in + *\ * | *\ *) + install_sh="\${SHELL} '$am_aux_dir/install-sh'" ;; + *) + install_sh="\${SHELL} $am_aux_dir/install-sh" + esac +fi + +# Installed binaries are usually stripped using 'strip' when the user +# run "make install-strip". However 'strip' might not be the right +# tool to use in cross-compilation environments, therefore Automake +# will honor the 'STRIP' environment variable to overrule this program. +if test "$cross_compiling" != no; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}strip", so it can be a program name with args. +set dummy ${ac_tool_prefix}strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$STRIP"; then + ac_cv_prog_STRIP="$STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_STRIP="${ac_tool_prefix}strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +STRIP=$ac_cv_prog_STRIP +if test -n "$STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $STRIP" >&5 +$as_echo "$STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_STRIP"; then + ac_ct_STRIP=$STRIP + # Extract the first word of "strip", so it can be a program name with args. +set dummy strip; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_STRIP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_STRIP"; then + ac_cv_prog_ac_ct_STRIP="$ac_ct_STRIP" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_STRIP="strip" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_STRIP=$ac_cv_prog_ac_ct_STRIP +if test -n "$ac_ct_STRIP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_STRIP" >&5 +$as_echo "$ac_ct_STRIP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_STRIP" = x; then + STRIP=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + STRIP=$ac_ct_STRIP + fi +else + STRIP="$ac_cv_prog_STRIP" +fi + +fi +INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 +$as_echo_n "checking for a thread-safe mkdir -p... " >&6; } +if test -z "$MKDIR_P"; then + if ${ac_cv_path_mkdir+:} false; then : + $as_echo_n "(cached) " >&6 +else + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/opt/sfw/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in mkdir gmkdir; do + for ac_exec_ext in '' $ac_executable_extensions; do + as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext" || continue + case `"$as_dir/$ac_prog$ac_exec_ext" --version 2>&1` in #( + 'mkdir (GNU coreutils) '* | \ + 'mkdir (coreutils) '* | \ + 'mkdir (fileutils) '4.1*) + ac_cv_path_mkdir=$as_dir/$ac_prog$ac_exec_ext + break 3;; + esac + done + done + done +IFS=$as_save_IFS + +fi + + test -d ./--version && rmdir ./--version + if test "${ac_cv_path_mkdir+set}" = set; then + MKDIR_P="$ac_cv_path_mkdir -p" + else + # As a last resort, use the slow shell script. Don't cache a + # value for MKDIR_P within a source directory, because that will + # break other packages using the cache if that directory is + # removed, or if the value is a relative name. + MKDIR_P="$ac_install_sh -d" + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $MKDIR_P" >&5 +$as_echo "$MKDIR_P" >&6; } + +for ac_prog in gawk mawk nawk awk +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_AWK+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$AWK"; then + ac_cv_prog_AWK="$AWK" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_AWK="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +AWK=$ac_cv_prog_AWK +if test -n "$AWK"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $AWK" >&5 +$as_echo "$AWK" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$AWK" && break +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether ${MAKE-make} sets \$(MAKE)" >&5 +$as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } +set x ${MAKE-make} +ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat >conftest.make <<\_ACEOF +SHELL = /bin/sh +all: + @echo '@@@%%%=$(MAKE)=@@@%%%' +_ACEOF +# GNU make sometimes prints "make[1]: Entering ...", which would confuse us. +case `${MAKE-make} -f conftest.make 2>/dev/null` in + *@@@%%%=?*=@@@%%%*) + eval ac_cv_prog_make_${ac_make}_set=yes;; + *) + eval ac_cv_prog_make_${ac_make}_set=no;; +esac +rm -f conftest.make +fi +if eval test \$ac_cv_prog_make_${ac_make}_set = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } + SET_MAKE= +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + SET_MAKE="MAKE=${MAKE-make}" +fi + +rm -rf .tst 2>/dev/null +mkdir .tst 2>/dev/null +if test -d .tst; then + am__leading_dot=. +else + am__leading_dot=_ +fi +rmdir .tst 2>/dev/null + +# Check whether --enable-silent-rules was given. +if test "${enable_silent_rules+set}" = set; then : + enableval=$enable_silent_rules; +fi + +case $enable_silent_rules in # ((( + yes) AM_DEFAULT_VERBOSITY=0;; + no) AM_DEFAULT_VERBOSITY=1;; + *) AM_DEFAULT_VERBOSITY=1;; +esac +am_make=${MAKE-make} +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $am_make supports nested variables" >&5 +$as_echo_n "checking whether $am_make supports nested variables... " >&6; } +if ${am_cv_make_support_nested_variables+:} false; then : + $as_echo_n "(cached) " >&6 +else + if $as_echo 'TRUE=$(BAR$(V)) +BAR0=false +BAR1=true +V=1 +am__doit: + @$(TRUE) +.PHONY: am__doit' | $am_make -f - >/dev/null 2>&1; then + am_cv_make_support_nested_variables=yes +else + am_cv_make_support_nested_variables=no +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_make_support_nested_variables" >&5 +$as_echo "$am_cv_make_support_nested_variables" >&6; } +if test $am_cv_make_support_nested_variables = yes; then + AM_V='$(V)' + AM_DEFAULT_V='$(AM_DEFAULT_VERBOSITY)' +else + AM_V=$AM_DEFAULT_VERBOSITY + AM_DEFAULT_V=$AM_DEFAULT_VERBOSITY +fi +AM_BACKSLASH='\' + +if test "`cd $srcdir && pwd`" != "`pwd`"; then + # Use -I$(srcdir) only when $(srcdir) != ., so that make's output + # is not polluted with repeated "-I." + am__isrc=' -I$(srcdir)' + # test to see if srcdir already configured + if test -f $srcdir/config.status; then + as_fn_error $? "source directory already configured; run \"make distclean\" there first" "$LINENO" 5 + fi +fi + +# test whether we have cygpath +if test -z "$CYGPATH_W"; then + if (cygpath --version) >/dev/null 2>/dev/null; then + CYGPATH_W='cygpath -w' + else + CYGPATH_W=echo + fi +fi + + +# Define the identity of the package. + PACKAGE='vlm' + VERSION='0.99-1' + + +cat >>confdefs.h <<_ACEOF +#define PACKAGE "$PACKAGE" +_ACEOF + + +cat >>confdefs.h <<_ACEOF +#define VERSION "$VERSION" +_ACEOF + +# Some tools Automake needs. + +ACLOCAL=${ACLOCAL-"${am_missing_run}aclocal-${am__api_version}"} + + +AUTOCONF=${AUTOCONF-"${am_missing_run}autoconf"} + + +AUTOMAKE=${AUTOMAKE-"${am_missing_run}automake-${am__api_version}"} + + +AUTOHEADER=${AUTOHEADER-"${am_missing_run}autoheader"} + + +MAKEINFO=${MAKEINFO-"${am_missing_run}makeinfo"} + +# For better backward compatibility. To be removed once Automake 1.9.x +# dies out for good. For more background, see: +# +# +mkdir_p='$(MKDIR_P)' + +# We need awk for the "check" target. The system "awk" is bad on +# some platforms. +# Always define AMTAR for backward compatibility. Yes, it's still used +# in the wild :-( We should find a proper way to deprecate it ... +AMTAR='$${TAR-tar}' + + +# We'll loop over all known methods to create a tar archive until one works. +_am_tools='gnutar pax cpio none' + +am__tar='$${TAR-tar} chof - "$$tardir"' am__untar='$${TAR-tar} xf -' + + + + + + +#AC_CONFIG_SRCDIR([include/VLM_configuration.h]) +ac_config_headers="$ac_config_headers config.h" + +# Checks for programs. +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. +set dummy ${ac_tool_prefix}gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_CC"; then + ac_ct_CC=$CC + # Extract the first word of "gcc", so it can be a program name with args. +set dummy gcc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="gcc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +else + CC="$ac_cv_prog_CC" +fi + +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. +set dummy ${ac_tool_prefix}cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="${ac_tool_prefix}cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + fi +fi +if test -z "$CC"; then + # Extract the first word of "cc", so it can be a program name with args. +set dummy cc; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else + ac_prog_rejected=no +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then + ac_prog_rejected=yes + continue + fi + ac_cv_prog_CC="cc" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +if test $ac_prog_rejected = yes; then + # We found a bogon in the path, so make sure we never use it. + set dummy $ac_cv_prog_CC + shift + if test $# != 0; then + # We chose a different compiler from the bogus one. + # However, it has the same basename, so the bogon will be chosen + # first if we set CC to just the basename; use the full file name. + shift + ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" + fi +fi +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$CC"; then + if test -n "$ac_tool_prefix"; then + for ac_prog in cl.exe + do + # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. +set dummy $ac_tool_prefix$ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$CC"; then + ac_cv_prog_CC="$CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_CC="$ac_tool_prefix$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +CC=$ac_cv_prog_CC +if test -n "$CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 +$as_echo "$CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CC" && break + done +fi +if test -z "$CC"; then + ac_ct_CC=$CC + for ac_prog in cl.exe +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_CC"; then + ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_CC=$ac_cv_prog_ac_ct_CC +if test -n "$ac_ct_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 +$as_echo "$ac_ct_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$ac_ct_CC" && break +done + + if test "x$ac_ct_CC" = x; then + CC="" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + CC=$ac_ct_CC + fi +fi + +fi + + +test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "no acceptable C compiler found in \$PATH +See \`config.log' for more details" "$LINENO" 5; } + +# Provide some information about the compiler. +$as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 +set X $ac_compile +ac_compiler=$2 +for ac_option in --version -v -V -qversion; do + { { ac_try="$ac_compiler $ac_option >&5" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compiler $ac_option >&5") 2>conftest.err + ac_status=$? + if test -s conftest.err; then + sed '10a\ +... rest of stderr output deleted ... + 10q' conftest.err >conftest.er1 + cat conftest.er1 >&5 + fi + rm -f conftest.er1 conftest.err + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } +done + +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" +# Try to create an executable without -o first, disregard a.out. +# It will help us diagnose broken compilers, and finding out an intuition +# of exeext. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 +$as_echo_n "checking whether the C compiler works... " >&6; } +ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` + +# The possible output files: +ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" + +ac_rmfiles= +for ac_file in $ac_files +do + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + * ) ac_rmfiles="$ac_rmfiles $ac_file";; + esac +done +rm -f $ac_rmfiles + +if { { ac_try="$ac_link_default" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link_default") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. +# So ignore a value of `no', otherwise this would lead to `EXEEXT = no' +# in a Makefile. We should not override ac_cv_exeext if it was cached, +# so that the user can short-circuit this test for compilers unknown to +# Autoconf. +for ac_file in $ac_files '' +do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) + ;; + [ab].out ) + # We found the default executable, but exeext='' is most + # certainly right. + break;; + *.* ) + if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; + then :; else + ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + fi + # We set ac_cv_exeext here because the later test for it is not + # safe: cross compilers may not add the suffix if given an `-o' + # argument, so we may need to know it at that point already. + # Even if this section looks crufty: it has the advantage of + # actually working. + break;; + * ) + break;; + esac +done +test "$ac_cv_exeext" = no && ac_cv_exeext= + +else + ac_file='' +fi +if test -z "$ac_file"; then : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +$as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "C compiler cannot create executables +See \`config.log' for more details" "$LINENO" 5; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 +$as_echo_n "checking for C compiler default output file name... " >&6; } +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 +$as_echo "$ac_file" >&6; } +ac_exeext=$ac_cv_exeext + +rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 +$as_echo_n "checking for suffix of executables... " >&6; } +if { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + # If both `conftest.exe' and `conftest' are `present' (well, observable) +# catch `conftest.exe'. For instance with Cygwin, `ls conftest' will +# work properly (i.e., refer to `conftest.exe'), while it won't with +# `rm'. +for ac_file in conftest.exe conftest conftest.*; do + test -f "$ac_file" || continue + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; + *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` + break;; + * ) break;; + esac +done +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of executables: cannot compile and link +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest conftest$ac_cv_exeext +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 +$as_echo "$ac_cv_exeext" >&6; } + +rm -f conftest.$ac_ext +EXEEXT=$ac_cv_exeext +ac_exeext=$EXEEXT +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +FILE *f = fopen ("conftest.out", "w"); + return ferror (f) || fclose (f) != 0; + + ; + return 0; +} +_ACEOF +ac_clean_files="$ac_clean_files conftest.out" +# Check that the compiler produces executables we can run. If not, either +# the compiler is broken, or we cross compile. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 +$as_echo_n "checking whether we are cross compiling... " >&6; } +if test "$cross_compiling" != yes; then + { { ac_try="$ac_link" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_link") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + if { ac_try='./conftest$ac_cv_exeext' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + cross_compiling=no + else + if test "$cross_compiling" = maybe; then + cross_compiling=yes + else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot run C compiled programs. +If you meant to cross compile, use \`--host'. +See \`config.log' for more details" "$LINENO" 5; } + fi + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 +$as_echo "$cross_compiling" >&6; } + +rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out +ac_clean_files=$ac_clean_files_save +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 +$as_echo_n "checking for suffix of object files... " >&6; } +if ${ac_cv_objext+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +rm -f conftest.o conftest.obj +if { { ac_try="$ac_compile" +case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_compile") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; then : + for ac_file in conftest.o conftest.obj conftest.*; do + test -f "$ac_file" || continue; + case $ac_file in + *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; + *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` + break;; + esac +done +else + $as_echo "$as_me: failed program was:" >&5 +sed 's/^/| /' conftest.$ac_ext >&5 + +{ { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "cannot compute suffix of object files: cannot compile +See \`config.log' for more details" "$LINENO" 5; } +fi +rm -f conftest.$ac_cv_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 +$as_echo "$ac_cv_objext" >&6; } +OBJEXT=$ac_cv_objext +ac_objext=$OBJEXT +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 +$as_echo_n "checking whether we are using the GNU C compiler... " >&6; } +if ${ac_cv_c_compiler_gnu+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +#ifndef __GNUC__ + choke me +#endif + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_compiler_gnu=yes +else + ac_compiler_gnu=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +ac_cv_c_compiler_gnu=$ac_compiler_gnu + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 +$as_echo "$ac_cv_c_compiler_gnu" >&6; } +if test $ac_compiler_gnu = yes; then + GCC=yes +else + GCC= +fi +ac_test_CFLAGS=${CFLAGS+set} +ac_save_CFLAGS=$CFLAGS +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 +$as_echo_n "checking whether $CC accepts -g... " >&6; } +if ${ac_cv_prog_cc_g+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_save_c_werror_flag=$ac_c_werror_flag + ac_c_werror_flag=yes + ac_cv_prog_cc_g=no + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +else + CFLAGS="" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + +else + ac_c_werror_flag=$ac_save_c_werror_flag + CFLAGS="-g" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_g=yes +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + ac_c_werror_flag=$ac_save_c_werror_flag +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 +$as_echo "$ac_cv_prog_cc_g" >&6; } +if test "$ac_test_CFLAGS" = set; then + CFLAGS=$ac_save_CFLAGS +elif test $ac_cv_prog_cc_g = yes; then + if test "$GCC" = yes; then + CFLAGS="-g -O2" + else + CFLAGS="-g" + fi +else + if test "$GCC" = yes; then + CFLAGS="-O2" + else + CFLAGS= + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +DEPDIR="${am__leading_dot}deps" + +ac_config_commands="$ac_config_commands depfiles" + + +am_make=${MAKE-make} +cat > confinc << 'END' +am__doit: + @echo this is the am__doit target +.PHONY: am__doit +END +# If we don't find an include directive, just comment out the code. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for style of include used by $am_make" >&5 +$as_echo_n "checking for style of include used by $am_make... " >&6; } +am__include="#" +am__quote= +_am_result=none +# First try GNU make style include. +echo "include confinc" > confmf +# Ignore all kinds of additional output from 'make'. +case `$am_make -s -f confmf 2> /dev/null` in #( +*the\ am__doit\ target*) + am__include=include + am__quote= + _am_result=GNU + ;; +esac +# Now try BSD make style include. +if test "$am__include" = "#"; then + echo '.include "confinc"' > confmf + case `$am_make -s -f confmf 2> /dev/null` in #( + *the\ am__doit\ target*) + am__include=.include + am__quote="\"" + _am_result=BSD + ;; + esac +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $_am_result" >&5 +$as_echo "$_am_result" >&6; } +rm -f confinc confmf + +# Check whether --enable-dependency-tracking was given. +if test "${enable_dependency_tracking+set}" = set; then : + enableval=$enable_dependency_tracking; +fi + +if test "x$enable_dependency_tracking" != xno; then + am_depcomp="$ac_aux_dir/depcomp" + AMDEPBACKSLASH='\' + am__nodep='_no' +fi + if test "x$enable_dependency_tracking" != xno; then + AMDEP_TRUE= + AMDEP_FALSE='#' +else + AMDEP_TRUE='#' + AMDEP_FALSE= +fi + + + +depcc="$CC" am_compiler_list= + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 +$as_echo_n "checking dependency style of $depcc... " >&6; } +if ${am_cv_CC_dependencies_compiler_type+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then + # We make a subdir and do the tests there. Otherwise we can end up + # making bogus files that we don't know about and never remove. For + # instance it was reported that on HP-UX the gcc test will end up + # making a dummy file named 'D' -- because '-MD' means "put the output + # in D". + rm -rf conftest.dir + mkdir conftest.dir + # Copy depcomp to subdir because otherwise we won't find it if we're + # using a relative directory. + cp "$am_depcomp" conftest.dir + cd conftest.dir + # We will build objects and dependencies in a subdirectory because + # it helps to detect inapplicable dependency modes. For instance + # both Tru64's cc and ICC support -MD to output dependencies as a + # side effect of compilation, but ICC will put the dependencies in + # the current directory while Tru64 will put them in the object + # directory. + mkdir sub + + am_cv_CC_dependencies_compiler_type=none + if test "$am_compiler_list" = ""; then + am_compiler_list=`sed -n 's/^#*\([a-zA-Z0-9]*\))$/\1/p' < ./depcomp` + fi + am__universal=false + case " $depcc " in #( + *\ -arch\ *\ -arch\ *) am__universal=true ;; + esac + + for depmode in $am_compiler_list; do + # Setup a source with many dependencies, because some compilers + # like to wrap large dependency lists on column 80 (with \), and + # we should not choose a depcomp mode which is confused by this. + # + # We need to recreate these files for each test, as the compiler may + # overwrite some of them when testing with obscure command lines. + # This happens at least with the AIX C compiler. + : > sub/conftest.c + for i in 1 2 3 4 5 6; do + echo '#include "conftst'$i'.h"' >> sub/conftest.c + # Using ": > sub/conftst$i.h" creates only sub/conftst1.h with + # Solaris 10 /bin/sh. + echo '/* dummy */' > sub/conftst$i.h + done + echo "${am__include} ${am__quote}sub/conftest.Po${am__quote}" > confmf + + # We check with '-c' and '-o' for the sake of the "dashmstdout" + # mode. It turns out that the SunPro C++ compiler does not properly + # handle '-M -o', and we need to detect this. Also, some Intel + # versions had trouble with output in subdirs. + am__obj=sub/conftest.${OBJEXT-o} + am__minus_obj="-o $am__obj" + case $depmode in + gcc) + # This depmode causes a compiler race in universal mode. + test "$am__universal" = false || continue + ;; + nosideeffect) + # After this tag, mechanisms are not by side-effect, so they'll + # only be used when explicitly requested. + if test "x$enable_dependency_tracking" = xyes; then + continue + else + break + fi + ;; + msvc7 | msvc7msys | msvisualcpp | msvcmsys) + # This compiler won't grok '-c -o', but also, the minuso test has + # not run yet. These depmodes are late enough in the game, and + # so weak that their functioning should not be impacted. + am__obj=conftest.${OBJEXT-o} + am__minus_obj= + ;; + none) break ;; + esac + if depmode=$depmode \ + source=sub/conftest.c object=$am__obj \ + depfile=sub/conftest.Po tmpdepfile=sub/conftest.TPo \ + $SHELL ./depcomp $depcc -c $am__minus_obj sub/conftest.c \ + >/dev/null 2>conftest.err && + grep sub/conftst1.h sub/conftest.Po > /dev/null 2>&1 && + grep sub/conftst6.h sub/conftest.Po > /dev/null 2>&1 && + grep $am__obj sub/conftest.Po > /dev/null 2>&1 && + ${MAKE-make} -s -f confmf > /dev/null 2>&1; then + # icc doesn't choke on unknown options, it will just issue warnings + # or remarks (even with -Werror). So we grep stderr for any message + # that says an option was ignored or not supported. + # When given -MP, icc 7.0 and 7.1 complain thusly: + # icc: Command line warning: ignoring option '-M'; no argument required + # The diagnosis changed in icc 8.0: + # icc: Command line remark: option '-MP' not supported + if (grep 'ignoring option' conftest.err || + grep 'not supported' conftest.err) >/dev/null 2>&1; then :; else + am_cv_CC_dependencies_compiler_type=$depmode + break + fi + fi + done + + cd .. + rm -rf conftest.dir +else + am_cv_CC_dependencies_compiler_type=none +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $am_cv_CC_dependencies_compiler_type" >&5 +$as_echo "$am_cv_CC_dependencies_compiler_type" >&6; } +CCDEPMODE=depmode=$am_cv_CC_dependencies_compiler_type + + if + test "x$enable_dependency_tracking" != xno \ + && test "$am_cv_CC_dependencies_compiler_type" = gcc3; then + am__fastdepCC_TRUE= + am__fastdepCC_FALSE='#' +else + am__fastdepCC_TRUE='#' + am__fastdepCC_FALSE= +fi + + + case $ac_cv_prog_cc_stdc in #( + no) : + ac_cv_prog_cc_c99=no; ac_cv_prog_cc_c89=no ;; #( + *) : + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C99" >&5 +$as_echo_n "checking for $CC option to accept ISO C99... " >&6; } +if ${ac_cv_prog_cc_c99+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c99=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include +#include + +// Check varargs macros. These examples are taken from C99 6.10.3.5. +#define debug(...) fprintf (stderr, __VA_ARGS__) +#define showlist(...) puts (#__VA_ARGS__) +#define report(test,...) ((test) ? puts (#test) : printf (__VA_ARGS__)) +static void +test_varargs_macros (void) +{ + int x = 1234; + int y = 5678; + debug ("Flag"); + debug ("X = %d\n", x); + showlist (The first, second, and third items.); + report (x>y, "x is %d but y is %d", x, y); +} + +// Check long long types. +#define BIG64 18446744073709551615ull +#define BIG32 4294967295ul +#define BIG_OK (BIG64 / BIG32 == 4294967297ull && BIG64 % BIG32 == 0) +#if !BIG_OK + your preprocessor is broken; +#endif +#if BIG_OK +#else + your preprocessor is broken; +#endif +static long long int bignum = -9223372036854775807LL; +static unsigned long long int ubignum = BIG64; + +struct incomplete_array +{ + int datasize; + double data[]; +}; + +struct named_init { + int number; + const wchar_t *name; + double average; +}; + +typedef const char *ccp; + +static inline int +test_restrict (ccp restrict text) +{ + // See if C++-style comments work. + // Iterate through items via the restricted pointer. + // Also check for declarations in for loops. + for (unsigned int i = 0; *(text+i) != '\0'; ++i) + continue; + return 0; +} + +// Check varargs and va_copy. +static void +test_varargs (const char *format, ...) +{ + va_list args; + va_start (args, format); + va_list args_copy; + va_copy (args_copy, args); + + const char *str; + int number; + float fnumber; + + while (*format) + { + switch (*format++) + { + case 's': // string + str = va_arg (args_copy, const char *); + break; + case 'd': // int + number = va_arg (args_copy, int); + break; + case 'f': // float + fnumber = va_arg (args_copy, double); + break; + default: + break; + } + } + va_end (args_copy); + va_end (args); +} + +int +main () +{ + + // Check bool. + _Bool success = false; + + // Check restrict. + if (test_restrict ("String literal") == 0) + success = true; + char *restrict newvar = "Another string"; + + // Check varargs. + test_varargs ("s, d' f .", "string", 65, 34.234); + test_varargs_macros (); + + // Check flexible array members. + struct incomplete_array *ia = + malloc (sizeof (struct incomplete_array) + (sizeof (double) * 10)); + ia->datasize = 10; + for (int i = 0; i < ia->datasize; ++i) + ia->data[i] = i * 1.234; + + // Check named initializers. + struct named_init ni = { + .number = 34, + .name = L"Test wide string", + .average = 543.34343, + }; + + ni.number = 58; + + int dynamic_array[ni.number]; + dynamic_array[ni.number - 1] = 543; + + // work around unused variable warnings + return (!success || bignum == 0LL || ubignum == 0uLL || newvar[0] == 'x' + || dynamic_array[ni.number - 1] != 543); + + ; + return 0; +} +_ACEOF +for ac_arg in '' -std=gnu99 -std=c99 -c99 -AC99 -D_STDC_C99= -qlanglvl=extc99 +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c99=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c99" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c99" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c99" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c99" >&5 +$as_echo "$ac_cv_prog_cc_c99" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c99" != xno; then : + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c99 +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 +$as_echo_n "checking for $CC option to accept ISO C89... " >&6; } +if ${ac_cv_prog_cc_c89+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_prog_cc_c89=no +ac_save_CC=$CC +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +struct stat; +/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ +struct buf { int x; }; +FILE * (*rcsopen) (struct buf *, struct stat *, int); +static char *e (p, i) + char **p; + int i; +{ + return p[i]; +} +static char *f (char * (*g) (char **, int), char **p, ...) +{ + char *s; + va_list v; + va_start (v,p); + s = g (p, va_arg (v,int)); + va_end (v); + return s; +} + +/* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has + function prototypes and stuff, but not '\xHH' hex character constants. + These don't provoke an error unfortunately, instead are silently treated + as 'x'. The following induces an error, until -std is added to get + proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an + array size at least. It's necessary to write '\x00'==0 to get something + that's true only with -std. */ +int osf4_cc_array ['\x00' == 0 ? 1 : -1]; + +/* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters + inside strings and character constants. */ +#define FOO(x) 'x' +int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; + +int test (int i, double x); +struct s1 {int (*f) (int a);}; +struct s2 {int (*f) (double a);}; +int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); +int argc; +char **argv; +int +main () +{ +return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; + ; + return 0; +} +_ACEOF +for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ + -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" +do + CC="$ac_save_CC $ac_arg" + if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_prog_cc_c89=$ac_arg +fi +rm -f core conftest.err conftest.$ac_objext + test "x$ac_cv_prog_cc_c89" != "xno" && break +done +rm -f conftest.$ac_ext +CC=$ac_save_CC + +fi +# AC_CACHE_VAL +case "x$ac_cv_prog_cc_c89" in + x) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; + xno) + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; + *) + CC="$CC $ac_cv_prog_cc_c89" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 +$as_echo "$ac_cv_prog_cc_c89" >&6; } ;; +esac +if test "x$ac_cv_prog_cc_c89" != xno; then : + ac_cv_prog_cc_stdc=$ac_cv_prog_cc_c89 +else + ac_cv_prog_cc_stdc=no +fi + +fi + ;; +esac + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO Standard C" >&5 +$as_echo_n "checking for $CC option to accept ISO Standard C... " >&6; } + if ${ac_cv_prog_cc_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +fi + + case $ac_cv_prog_cc_stdc in #( + no) : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 +$as_echo "unsupported" >&6; } ;; #( + '') : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 +$as_echo "none needed" >&6; } ;; #( + *) : + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_stdc" >&5 +$as_echo "$ac_cv_prog_cc_stdc" >&6; } ;; +esac + +if test -n "$ac_tool_prefix"; then + # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. +set dummy ${ac_tool_prefix}ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$RANLIB"; then + ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +RANLIB=$ac_cv_prog_RANLIB +if test -n "$RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 +$as_echo "$RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + +fi +if test -z "$ac_cv_prog_RANLIB"; then + ac_ct_RANLIB=$RANLIB + # Extract the first word of "ranlib", so it can be a program name with args. +set dummy ranlib; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$ac_ct_RANLIB"; then + ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_ac_ct_RANLIB="ranlib" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB +if test -n "$ac_ct_RANLIB"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 +$as_echo "$ac_ct_RANLIB" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + if test "x$ac_ct_RANLIB" = x; then + RANLIB=":" + else + case $cross_compiling:$ac_tool_warned in +yes:) +{ $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 +$as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} +ac_tool_warned=yes ;; +esac + RANLIB=$ac_ct_RANLIB + fi +else + RANLIB="$ac_cv_prog_RANLIB" +fi + +#AC_PROG_CLISP + +if test "x$CC" != xcc; then + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC and cc understand -c and -o together" >&5 +$as_echo_n "checking whether $CC and cc understand -c and -o together... " >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether cc understands -c and -o together" >&5 +$as_echo_n "checking whether cc understands -c and -o together... " >&6; } +fi +set dummy $CC; ac_cc=`$as_echo "$2" | + sed 's/[^a-zA-Z0-9_]/_/g;s/^[0-9]/_/'` +if eval \${ac_cv_prog_cc_${ac_cc}_c_o+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ + + ; + return 0; +} +_ACEOF +# Make sure it works both with $CC and with simple cc. +# We do the test twice because some compilers refuse to overwrite an +# existing .o file with -o, though they will create one. +ac_try='$CC -c conftest.$ac_ext -o conftest2.$ac_objext >&5' +rm -f conftest2.* +if { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && + test -f conftest2.$ac_objext && { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; +then + eval ac_cv_prog_cc_${ac_cc}_c_o=yes + if test "x$CC" != xcc; then + # Test first that cc exists at all. + if { ac_try='cc -c conftest.$ac_ext >&5' + { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; }; then + ac_try='cc -c conftest.$ac_ext -o conftest2.$ac_objext >&5' + rm -f conftest2.* + if { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } && + test -f conftest2.$ac_objext && { { case "(($ac_try" in + *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; + *) ac_try_echo=$ac_try;; +esac +eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" +$as_echo "$ac_try_echo"; } >&5 + (eval "$ac_try") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; }; + then + # cc works too. + : + else + # cc exists but doesn't like -o. + eval ac_cv_prog_cc_${ac_cc}_c_o=no + fi + fi + fi +else + eval ac_cv_prog_cc_${ac_cc}_c_o=no +fi +rm -f core conftest* + +fi +if eval test \$ac_cv_prog_cc_${ac_cc}_c_o = yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 +$as_echo "yes" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } + +$as_echo "#define NO_MINUS_C_MINUS_O 1" >>confdefs.h + +fi + +# FIXME: we rely on the cache variable name because +# there is no other way. +set dummy $CC +am_cc=`echo $2 | sed 's/[^a-zA-Z0-9_]/_/g;s/^[0-9]/_/'` +eval am_t=\$ac_cv_prog_cc_${am_cc}_c_o +if test "$am_t" != yes; then + # Losing compiler, so override with the script. + # FIXME: It is wrong to rewrite CC. + # But if we don't then we get into trouble of one sort or another. + # A longer-term fix would be to have automake use am__CC in this case, + # and then we could set am__CC="\$(top_srcdir)/compile \$(CC)" + CC="$am_aux_dir/compile $CC" +fi + + +if test -z $GCC; then + as_fn_error $? "you probably need a gnu c (gcc) compiler to compile the vlm" "$LINENO" 5 +fi + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking how to run the C preprocessor" >&5 +$as_echo_n "checking how to run the C preprocessor... " >&6; } +# On Suns, sometimes $CPP names a directory. +if test -n "$CPP" && test -d "$CPP"; then + CPP= +fi +if test -z "$CPP"; then + if ${ac_cv_prog_CPP+:} false; then : + $as_echo_n "(cached) " >&6 +else + # Double quotes because CPP needs to be expanded + for CPP in "$CC -E" "$CC -E -traditional-cpp" "/lib/cpp" + do + ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + break +fi + + done + ac_cv_prog_CPP=$CPP + +fi + CPP=$ac_cv_prog_CPP +else + ac_cv_prog_CPP=$CPP +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $CPP" >&5 +$as_echo "$CPP" >&6; } +ac_preproc_ok=false +for ac_c_preproc_warn_flag in '' yes +do + # Use a header file that comes with gcc, so configuring glibc + # with a fresh cross-compiler works. + # Prefer to if __STDC__ is defined, since + # exists even on freestanding compilers. + # On the NeXT, cc -E runs the code through the compiler's parser, + # not just through cpp. "Syntax error" is here to catch this case. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifdef __STDC__ +# include +#else +# include +#endif + Syntax error +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + +else + # Broken: fails on valid input. +continue +fi +rm -f conftest.err conftest.i conftest.$ac_ext + + # OK, works on sane cases. Now check whether nonexistent headers + # can be detected and how. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # Broken: success on invalid input. +continue +else + # Passes both tests. +ac_preproc_ok=: +break +fi +rm -f conftest.err conftest.i conftest.$ac_ext + +done +# Because of `break', _AC_PREPROC_IFELSE's cleaning code was skipped. +rm -f conftest.i conftest.err conftest.$ac_ext +if $ac_preproc_ok; then : + +else + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error $? "C preprocessor \"$CPP\" fails sanity check +See \`config.log' for more details" "$LINENO" 5; } +fi + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 +$as_echo_n "checking for grep that handles long lines and -e... " >&6; } +if ${ac_cv_path_GREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -z "$GREP"; then + ac_path_GREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in grep ggrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_GREP" || continue +# Check for GNU ac_path_GREP and select it if it is found. + # Check for GNU $ac_path_GREP +case `"$ac_path_GREP" --version 2>&1` in +*GNU*) + ac_cv_path_GREP="$ac_path_GREP" ac_path_GREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'GREP' >> "conftest.nl" + "$ac_path_GREP" -e 'GREP$' -e '-(cannot match)-' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_GREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_GREP="$ac_path_GREP" + ac_path_GREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_GREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_GREP"; then + as_fn_error $? "no acceptable grep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_GREP=$GREP +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_GREP" >&5 +$as_echo "$ac_cv_path_GREP" >&6; } + GREP="$ac_cv_path_GREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 +$as_echo_n "checking for egrep... " >&6; } +if ${ac_cv_path_EGREP+:} false; then : + $as_echo_n "(cached) " >&6 +else + if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 + then ac_cv_path_EGREP="$GREP -E" + else + if test -z "$EGREP"; then + ac_path_EGREP_found=false + # Loop through the user's path and test for each of PROGNAME-LIST + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH$PATH_SEPARATOR/usr/xpg4/bin +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_prog in egrep; do + for ac_exec_ext in '' $ac_executable_extensions; do + ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext" + as_fn_executable_p "$ac_path_EGREP" || continue +# Check for GNU ac_path_EGREP and select it if it is found. + # Check for GNU $ac_path_EGREP +case `"$ac_path_EGREP" --version 2>&1` in +*GNU*) + ac_cv_path_EGREP="$ac_path_EGREP" ac_path_EGREP_found=:;; +*) + ac_count=0 + $as_echo_n 0123456789 >"conftest.in" + while : + do + cat "conftest.in" "conftest.in" >"conftest.tmp" + mv "conftest.tmp" "conftest.in" + cp "conftest.in" "conftest.nl" + $as_echo 'EGREP' >> "conftest.nl" + "$ac_path_EGREP" 'EGREP$' < "conftest.nl" >"conftest.out" 2>/dev/null || break + diff "conftest.out" "conftest.nl" >/dev/null 2>&1 || break + as_fn_arith $ac_count + 1 && ac_count=$as_val + if test $ac_count -gt ${ac_path_EGREP_max-0}; then + # Best one so far, save it but keep looking for a better one + ac_cv_path_EGREP="$ac_path_EGREP" + ac_path_EGREP_max=$ac_count + fi + # 10*(2^10) chars as input seems more than enough + test $ac_count -gt 10 && break + done + rm -f conftest.in conftest.tmp conftest.nl conftest.out;; +esac + + $ac_path_EGREP_found && break 3 + done + done + done +IFS=$as_save_IFS + if test -z "$ac_cv_path_EGREP"; then + as_fn_error $? "no acceptable egrep could be found in $PATH$PATH_SEPARATOR/usr/xpg4/bin" "$LINENO" 5 + fi +else + ac_cv_path_EGREP=$EGREP +fi + + fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_path_EGREP" >&5 +$as_echo "$ac_cv_path_EGREP" >&6; } + EGREP="$ac_cv_path_EGREP" + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 +$as_echo_n "checking for ANSI C header files... " >&6; } +if ${ac_cv_header_stdc+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#include +#include + +int +main () +{ + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdc=yes +else + ac_cv_header_stdc=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + +if test $ac_cv_header_stdc = yes; then + # SunOS 4.x string.h does not declare mem*, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "memchr" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include + +_ACEOF +if (eval "$ac_cpp conftest.$ac_ext") 2>&5 | + $EGREP "free" >/dev/null 2>&1; then : + +else + ac_cv_header_stdc=no +fi +rm -f conftest* + +fi + +if test $ac_cv_header_stdc = yes; then + # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi. + if test "$cross_compiling" = yes; then : + : +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +#include +#if ((' ' & 0x0FF) == 0x020) +# define ISLOWER(c) ('a' <= (c) && (c) <= 'z') +# define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c)) +#else +# define ISLOWER(c) \ + (('a' <= (c) && (c) <= 'i') \ + || ('j' <= (c) && (c) <= 'r') \ + || ('s' <= (c) && (c) <= 'z')) +# define TOUPPER(c) (ISLOWER(c) ? ((c) | 0x40) : (c)) +#endif + +#define XOR(e, f) (((e) && !(f)) || (!(e) && (f))) +int +main () +{ + int i; + for (i = 0; i < 256; i++) + if (XOR (islower (i), ISLOWER (i)) + || toupper (i) != TOUPPER (i)) + return 2; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + +else + ac_cv_header_stdc=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdc" >&5 +$as_echo "$ac_cv_header_stdc" >&6; } +if test $ac_cv_header_stdc = yes; then + +$as_echo "#define STDC_HEADERS 1" >>confdefs.h + +fi + +# On IRIX 5.3, sys/types and inttypes.h are conflicting. +for ac_header in sys/types.h sys/stat.h stdlib.h string.h memory.h strings.h \ + inttypes.h stdint.h unistd.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +# The cast to long int works around a bug in the HP C Compiler +# version HP92453-01 B.11.11.23709.GP, which incorrectly rejects +# declarations like `int a3[[(sizeof (unsigned char)) >= 0]];'. +# This bug is HP SR number 8606223364. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking size of int *" >&5 +$as_echo_n "checking size of int *... " >&6; } +if ${ac_cv_sizeof_int_p+:} false; then : + $as_echo_n "(cached) " >&6 +else + if ac_fn_c_compute_int "$LINENO" "(long int) (sizeof (int *))" "ac_cv_sizeof_int_p" "$ac_includes_default"; then : + +else + if test "$ac_cv_type_int_p" = yes; then + { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 +$as_echo "$as_me: error: in \`$ac_pwd':" >&2;} +as_fn_error 77 "cannot compute sizeof (int *) +See \`config.log' for more details" "$LINENO" 5; } + else + ac_cv_sizeof_int_p=0 + fi +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_sizeof_int_p" >&5 +$as_echo "$ac_cv_sizeof_int_p" >&6; } + + + +cat >>confdefs.h <<_ACEOF +#define SIZEOF_INT_P $ac_cv_sizeof_int_p +_ACEOF + + +if test $ac_cv_sizeof_int_p -ne 8 ; then + as_fn_error $? "you need a 64-bit environment to compile the vlm" "$LINENO" 5 +fi +# Checks for libraries. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for XKeysymToKeycode in -lX11" >&5 +$as_echo_n "checking for XKeysymToKeycode in -lX11... " >&6; } +if ${ac_cv_lib_X11_XKeysymToKeycode+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lX11 $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char XKeysymToKeycode (); +int +main () +{ +return XKeysymToKeycode (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_X11_XKeysymToKeycode=yes +else + ac_cv_lib_X11_XKeysymToKeycode=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_X11_XKeysymToKeycode" >&5 +$as_echo "$ac_cv_lib_X11_XKeysymToKeycode" >&6; } +if test "x$ac_cv_lib_X11_XKeysymToKeycode" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBX11 1 +_ACEOF + + LIBS="-lX11 $LIBS" + +else + as_fn_error $? "you need libX11 to compile the vlm" "$LINENO" 5 +fi + +# even if libxcb is found, don't link to it - not needed +# so, give AC_CHECK_LIB a null cmd for action-if-found +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for xcb_disconnect in -lxcb" >&5 +$as_echo_n "checking for xcb_disconnect in -lxcb... " >&6; } +if ${ac_cv_lib_xcb_xcb_disconnect+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lxcb $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char xcb_disconnect (); +int +main () +{ +return xcb_disconnect (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_xcb_xcb_disconnect=yes +else + ac_cv_lib_xcb_xcb_disconnect=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xcb_xcb_disconnect" >&5 +$as_echo "$ac_cv_lib_xcb_xcb_disconnect" >&6; } +if test "x$ac_cv_lib_xcb_xcb_disconnect" = xyes; then : + : +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for fprintf in -lc" >&5 +$as_echo_n "checking for fprintf in -lc... " >&6; } +if ${ac_cv_lib_c_fprintf+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lc $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char fprintf (); +int +main () +{ +return fprintf (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_c_fprintf=yes +else + ac_cv_lib_c_fprintf=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_c_fprintf" >&5 +$as_echo "$ac_cv_lib_c_fprintf" >&6; } +if test "x$ac_cv_lib_c_fprintf" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBC 1 +_ACEOF + + LIBS="-lc $LIBS" + +else + as_fn_error $? "you need libc to compile the vlm" "$LINENO" 5 +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for encrypt in -lcrypt" >&5 +$as_echo_n "checking for encrypt in -lcrypt... " >&6; } +if ${ac_cv_lib_crypt_encrypt+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lcrypt $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char encrypt (); +int +main () +{ +return encrypt (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_crypt_encrypt=yes +else + ac_cv_lib_crypt_encrypt=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_crypt_encrypt" >&5 +$as_echo "$ac_cv_lib_crypt_encrypt" >&6; } +if test "x$ac_cv_lib_crypt_encrypt" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBCRYPT 1 +_ACEOF + + LIBS="-lcrypt $LIBS" + +else + as_fn_error $? "you need libcrypt to compile the vlm" "$LINENO" 5 +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for dlopen in -ldl" >&5 +$as_echo_n "checking for dlopen in -ldl... " >&6; } +if ${ac_cv_lib_dl_dlopen+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-ldl $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char dlopen (); +int +main () +{ +return dlopen (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_dl_dlopen=yes +else + ac_cv_lib_dl_dlopen=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dl_dlopen" >&5 +$as_echo "$ac_cv_lib_dl_dlopen" >&6; } +if test "x$ac_cv_lib_dl_dlopen" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBDL 1 +_ACEOF + + LIBS="-ldl $LIBS" + +else + as_fn_error $? "you need libdl to compile the vlm" "$LINENO" 5 +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for floor in -lm" >&5 +$as_echo_n "checking for floor in -lm... " >&6; } +if ${ac_cv_lib_m_floor+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lm $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char floor (); +int +main () +{ +return floor (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_m_floor=yes +else + ac_cv_lib_m_floor=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_floor" >&5 +$as_echo "$ac_cv_lib_m_floor" >&6; } +if test "x$ac_cv_lib_m_floor" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBM 1 +_ACEOF + + LIBS="-lm $LIBS" + +else + as_fn_error $? "you need libm to compile the vlm" "$LINENO" 5 +fi + +# Make sure we can run config.sub. +$SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || + as_fn_error $? "cannot run $SHELL $ac_aux_dir/config.sub" "$LINENO" 5 + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 +$as_echo_n "checking build system type... " >&6; } +if ${ac_cv_build+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_build_alias=$build_alias +test "x$ac_build_alias" = x && + ac_build_alias=`$SHELL "$ac_aux_dir/config.guess"` +test "x$ac_build_alias" = x && + as_fn_error $? "cannot guess build type; you must specify one" "$LINENO" 5 +ac_cv_build=`$SHELL "$ac_aux_dir/config.sub" $ac_build_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $ac_build_alias failed" "$LINENO" 5 + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_build" >&5 +$as_echo "$ac_cv_build" >&6; } +case $ac_cv_build in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; +esac +build=$ac_cv_build +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_build +shift +build_cpu=$1 +build_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +build_os=$* +IFS=$ac_save_IFS +case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 +$as_echo_n "checking host system type... " >&6; } +if ${ac_cv_host+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "x$host_alias" = x; then + ac_cv_host=$ac_cv_build +else + ac_cv_host=`$SHELL "$ac_aux_dir/config.sub" $host_alias` || + as_fn_error $? "$SHELL $ac_aux_dir/config.sub $host_alias failed" "$LINENO" 5 +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_host" >&5 +$as_echo "$ac_cv_host" >&6; } +case $ac_cv_host in +*-*-*) ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; +esac +host=$ac_cv_host +ac_save_IFS=$IFS; IFS='-' +set x $ac_cv_host +shift +host_cpu=$1 +host_vendor=$2 +shift; shift +# Remember, the first character of IFS is used to create $*, +# except with old shells: +host_os=$* +IFS=$ac_save_IFS +case $host_os in *\ *) host_os=`echo "$host_os" | sed 's/ /-/g'`;; esac + + + + + +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + +acx_pthread_ok=no + +# We used to check for pthread.h first, but this fails if pthread.h +# requires special compiler flags (e.g. on True64 or Sequent). +# It gets checked for in the link test anyway. + +# First of all, check if the user has set any of the PTHREAD_LIBS, +# etcetera environment variables, and if threads linking works using +# them: +if test x"$PTHREAD_LIBS$PTHREAD_CFLAGS" != x; then + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + save_LIBS="$LIBS" + LIBS="$PTHREAD_LIBS $LIBS" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS" >&5 +$as_echo_n "checking for pthread_join in LIBS=$PTHREAD_LIBS with CFLAGS=$PTHREAD_CFLAGS... " >&6; } + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_join (); +int +main () +{ +return pthread_join (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + acx_pthread_ok=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_pthread_ok" >&5 +$as_echo "$acx_pthread_ok" >&6; } + if test x"$acx_pthread_ok" = xno; then + PTHREAD_LIBS="" + PTHREAD_CFLAGS="" + fi + LIBS="$save_LIBS" + CFLAGS="$save_CFLAGS" +fi + +# We must check for the threads library under a number of different +# names; the ordering is very important because some systems +# (e.g. DEC) have both -lpthread and -lpthreads, where one of the +# libraries is broken (non-POSIX). + +# Create a list of thread flags to try. Items starting with a "-" are +# C compiler flags, and other items are library names, except for "none" +# which indicates that we try without any flags at all, and "pthread-config" +# which is a program returning the flags for the Pth emulation library. + +acx_pthread_flags="pthreads none -Kthread -kthread lthread -pthread -pthreads -mthreads pthread --thread-safe -mt pthread-config" + +# The ordering *is* (sometimes) important. Some notes on the +# individual items follow: + +# pthreads: AIX (must check this before -lpthread) +# none: in case threads are in libc; should be tried before -Kthread and +# other compiler flags to prevent continual compiler warnings +# -Kthread: Sequent (threads in libc, but -Kthread needed for pthread.h) +# -kthread: FreeBSD kernel threads (preferred to -pthread since SMP-able) +# lthread: LinuxThreads port on FreeBSD (also preferred to -pthread) +# -pthread: Linux/gcc (kernel threads), BSD/gcc (userland threads) +# -pthreads: Solaris/gcc +# -mthreads: Mingw32/gcc, Lynx/gcc +# -mt: Sun Workshop C (may only link SunOS threads [-lthread], but it +# doesn't hurt to check since this sometimes defines pthreads too; +# also defines -D_REENTRANT) +# ... -mt is also the pthreads flag for HP/aCC +# pthread: Linux, etcetera +# --thread-safe: KAI C++ +# pthread-config: use pthread-config program (for GNU Pth library) + +case "${host_cpu}-${host_os}" in + *solaris*) + + # On Solaris (at least, for some versions), libc contains stubbed + # (non-functional) versions of the pthreads routines, so link-based + # tests will erroneously succeed. (We need to link with -pthreads/-mt/ + # -lpthread.) (The stubs are missing pthread_cleanup_push, or rather + # a function called by this macro, so we could check for that, but + # who knows whether they'll stub that too in a future libc.) So, + # we'll just look for -pthreads and -lpthread first: + + acx_pthread_flags="-pthreads pthread -mt -pthread $acx_pthread_flags" + ;; +esac + +if test x"$acx_pthread_ok" = xno; then +for flag in $acx_pthread_flags; do + + case $flag in + none) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthreads work without any flags" >&5 +$as_echo_n "checking whether pthreads work without any flags... " >&6; } + ;; + + -*) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether pthreads work with $flag" >&5 +$as_echo_n "checking whether pthreads work with $flag... " >&6; } + PTHREAD_CFLAGS="$flag" + ;; + + pthread-config) + # Extract the first word of "pthread-config", so it can be a program name with args. +set dummy pthread-config; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_acx_pthread_config+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$acx_pthread_config"; then + ac_cv_prog_acx_pthread_config="$acx_pthread_config" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_acx_pthread_config="yes" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + test -z "$ac_cv_prog_acx_pthread_config" && ac_cv_prog_acx_pthread_config="no" +fi +fi +acx_pthread_config=$ac_cv_prog_acx_pthread_config +if test -n "$acx_pthread_config"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_pthread_config" >&5 +$as_echo "$acx_pthread_config" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + if test x"$acx_pthread_config" = xno; then continue; fi + PTHREAD_CFLAGS="`pthread-config --cflags`" + PTHREAD_LIBS="`pthread-config --ldflags` `pthread-config --libs`" + ;; + + *) + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for the pthreads library -l$flag" >&5 +$as_echo_n "checking for the pthreads library -l$flag... " >&6; } + PTHREAD_LIBS="-l$flag" + ;; + esac + + save_LIBS="$LIBS" + save_CFLAGS="$CFLAGS" + LIBS="$PTHREAD_LIBS $LIBS" + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + + # Check for various functions. We must include pthread.h, + # since some functions may be macros. (On the Sequent, we + # need a special flag -Kthread to make this header compile.) + # We check for pthread_join because it is in -lpthread on IRIX + # while pthread_create is in libc. We check for pthread_attr_init + # due to DEC craziness with -lpthreads. We check for + # pthread_cleanup_push because it is one of the few pthread + # functions on Solaris that doesn't have a non-functional libc stub. + # We try pthread_create on general principles. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +pthread_t th; pthread_join(th, 0); + pthread_attr_init(0); pthread_cleanup_push(0, 0); + pthread_create(0,0,0,0); pthread_cleanup_pop(0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + acx_pthread_ok=yes +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + + LIBS="$save_LIBS" + CFLAGS="$save_CFLAGS" + + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $acx_pthread_ok" >&5 +$as_echo "$acx_pthread_ok" >&6; } + if test "x$acx_pthread_ok" = xyes; then + break; + fi + + PTHREAD_LIBS="" + PTHREAD_CFLAGS="" +done +fi + +# Various other checks: +if test "x$acx_pthread_ok" = xyes; then + save_LIBS="$LIBS" + LIBS="$PTHREAD_LIBS $LIBS" + save_CFLAGS="$CFLAGS" + CFLAGS="$CFLAGS $PTHREAD_CFLAGS" + + # Detect AIX lossage: JOINABLE attribute is called UNDETACHED. + { $as_echo "$as_me:${as_lineno-$LINENO}: checking for joinable pthread attribute" >&5 +$as_echo_n "checking for joinable pthread attribute... " >&6; } + attr_name=unknown + for attr in PTHREAD_CREATE_JOINABLE PTHREAD_CREATE_UNDETACHED; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +int attr=$attr; return attr; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + attr_name=$attr; break +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext + done + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $attr_name" >&5 +$as_echo "$attr_name" >&6; } + if test "$attr_name" != PTHREAD_CREATE_JOINABLE; then + +cat >>confdefs.h <<_ACEOF +#define PTHREAD_CREATE_JOINABLE $attr_name +_ACEOF + + fi + + { $as_echo "$as_me:${as_lineno-$LINENO}: checking if more special flags are required for pthreads" >&5 +$as_echo_n "checking if more special flags are required for pthreads... " >&6; } + flag=no + case "${host_cpu}-${host_os}" in + *-aix* | *-freebsd* | *-darwin*) flag="-D_THREAD_SAFE";; + *solaris* | *-osf* | *-hpux*) flag="-D_REENTRANT";; + esac + { $as_echo "$as_me:${as_lineno-$LINENO}: result: ${flag}" >&5 +$as_echo "${flag}" >&6; } + if test "x$flag" != xno; then + PTHREAD_CFLAGS="$flag $PTHREAD_CFLAGS" + fi + + LIBS="$save_LIBS" + CFLAGS="$save_CFLAGS" + + # More AIX lossage: must compile with xlc_r or cc_r + if test x"$GCC" != xyes; then + for ac_prog in xlc_r cc_r +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_prog_PTHREAD_CC+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test -n "$PTHREAD_CC"; then + ac_cv_prog_PTHREAD_CC="$PTHREAD_CC" # Let the user override the test. +else +as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_prog_PTHREAD_CC="$ac_prog" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + +fi +fi +PTHREAD_CC=$ac_cv_prog_PTHREAD_CC +if test -n "$PTHREAD_CC"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PTHREAD_CC" >&5 +$as_echo "$PTHREAD_CC" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$PTHREAD_CC" && break +done +test -n "$PTHREAD_CC" || PTHREAD_CC="${CC}" + + else + PTHREAD_CC=$CC + fi +else + PTHREAD_CC="$CC" +fi + + + + + +# Finally, execute ACTION-IF-FOUND/ACTION-IF-NOT-FOUND: +if test x"$acx_pthread_ok" = xyes; then + +$as_echo "#define HAVE_PTHREAD 1" >>confdefs.h + + : +else + acx_pthread_ok=no + as_fn_error $? "you need pthreads to compile the vlm" "$LINENO" 5 +fi +ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_cancel in -lpthread" >&5 +$as_echo_n "checking for pthread_cancel in -lpthread... " >&6; } +if ${ac_cv_lib_pthread_pthread_cancel+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_check_lib_save_LIBS=$LIBS +LIBS="-lpthread $LIBS" +cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +/* Override any GCC internal prototype to avoid an error. + Use char because int might match the return type of a GCC + builtin and then its argument prototype would still apply. */ +#ifdef __cplusplus +extern "C" +#endif +char pthread_cancel (); +int +main () +{ +return pthread_cancel (); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + ac_cv_lib_pthread_pthread_cancel=yes +else + ac_cv_lib_pthread_pthread_cancel=no +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +LIBS=$ac_check_lib_save_LIBS +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_cancel" >&5 +$as_echo "$ac_cv_lib_pthread_pthread_cancel" >&6; } +if test "x$ac_cv_lib_pthread_pthread_cancel" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_LIBPTHREAD 1 +_ACEOF + + LIBS="-lpthread $LIBS" + +else + as_fn_error $? "you need libpthread to compile the vlm" "$LINENO" 5 +fi + +# need clisp +for ac_prog in clisp +do + # Extract the first word of "$ac_prog", so it can be a program name with args. +set dummy $ac_prog; ac_word=$2 +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 +$as_echo_n "checking for $ac_word... " >&6; } +if ${ac_cv_path_CLISP+:} false; then : + $as_echo_n "(cached) " >&6 +else + case $CLISP in + [\\/]* | ?:[\\/]*) + ac_cv_path_CLISP="$CLISP" # Let the user override the test with a path. + ;; + *) + as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + for ac_exec_ext in '' $ac_executable_extensions; do + if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then + ac_cv_path_CLISP="$as_dir/$ac_word$ac_exec_ext" + $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 + break 2 + fi +done + done +IFS=$as_save_IFS + + ;; +esac +fi +CLISP=$ac_cv_path_CLISP +if test -n "$CLISP"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CLISP" >&5 +$as_echo "$CLISP" >&6; } +else + { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 +$as_echo "no" >&6; } +fi + + + test -n "$CLISP" && break +done + +if test -z "$CLISP" || test "X$CLISP" = "Xno"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: clisp has not been detected on your system. + You won't be able to (re)generate stub/*.c files + from alpha-emulator/*.as and ...*.lisp files" >&5 +$as_echo "$as_me: WARNING: clisp has not been detected on your system. + You won't be able to (re)generate stub/*.c files + from alpha-emulator/*.as and ...*.lisp files" >&2;} +fi + if test "x$CLISP" != x; then + HCLISP_TRUE= + HCLISP_FALSE='#' +else + HCLISP_TRUE='#' + HCLISP_FALSE= +fi + + +# Checks for header files. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for X" >&5 +$as_echo_n "checking for X... " >&6; } + + +# Check whether --with-x was given. +if test "${with_x+set}" = set; then : + withval=$with_x; +fi + +# $have_x is `yes', `no', `disabled', or empty when we do not yet know. +if test "x$with_x" = xno; then + # The user explicitly disabled X. + have_x=disabled +else + case $x_includes,$x_libraries in #( + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( + *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then : + $as_echo_n "(cached) " >&6 +else + # One or both of the vars are not set, and there is no cached value. +ac_x_includes=no ac_x_libraries=no +rm -f -r conftest.dir +if mkdir conftest.dir; then + cd conftest.dir + cat >Imakefile <<'_ACEOF' +incroot: + @echo incroot='${INCROOT}' +usrlibdir: + @echo usrlibdir='${USRLIBDIR}' +libdir: + @echo libdir='${LIBDIR}' +_ACEOF + if (export CC; ${XMKMF-xmkmf}) >/dev/null 2>/dev/null && test -f Makefile; then + # GNU make sometimes prints "make[1]: Entering ...", which would confuse us. + for ac_var in incroot usrlibdir libdir; do + eval "ac_im_$ac_var=\`\${MAKE-make} $ac_var 2>/dev/null | sed -n 's/^$ac_var=//p'\`" + done + # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR. + for ac_extension in a so sl dylib la dll; do + if test ! -f "$ac_im_usrlibdir/libX11.$ac_extension" && + test -f "$ac_im_libdir/libX11.$ac_extension"; then + ac_im_usrlibdir=$ac_im_libdir; break + fi + done + # Screen out bogus values from the imake configuration. They are + # bogus both because they are the default anyway, and because + # using them would break gcc on systems where it needs fixed includes. + case $ac_im_incroot in + /usr/include) ac_x_includes= ;; + *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes=$ac_im_incroot;; + esac + case $ac_im_usrlibdir in + /usr/lib | /usr/lib64 | /lib | /lib64) ;; + *) test -d "$ac_im_usrlibdir" && ac_x_libraries=$ac_im_usrlibdir ;; + esac + fi + cd .. + rm -f -r conftest.dir +fi + +# Standard set of common directories for X headers. +# Check X11 before X11Rn because it is often a symlink to the current release. +ac_x_header_dirs=' +/usr/X11/include +/usr/X11R7/include +/usr/X11R6/include +/usr/X11R5/include +/usr/X11R4/include + +/usr/include/X11 +/usr/include/X11R7 +/usr/include/X11R6 +/usr/include/X11R5 +/usr/include/X11R4 + +/usr/local/X11/include +/usr/local/X11R7/include +/usr/local/X11R6/include +/usr/local/X11R5/include +/usr/local/X11R4/include + +/usr/local/include/X11 +/usr/local/include/X11R7 +/usr/local/include/X11R6 +/usr/local/include/X11R5 +/usr/local/include/X11R4 + +/usr/X386/include +/usr/x386/include +/usr/XFree86/include/X11 + +/usr/include +/usr/local/include +/usr/unsupported/include +/usr/athena/include +/usr/local/x11r5/include +/usr/lpp/Xamples/include + +/usr/openwin/include +/usr/openwin/share/include' + +if test "$ac_x_includes" = no; then + # Guess where to find include files, by looking for Xlib.h. + # First, try using that file with no special directory specified. + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +_ACEOF +if ac_fn_c_try_cpp "$LINENO"; then : + # We can compile using X headers with no special include directory. +ac_x_includes= +else + for ac_dir in $ac_x_header_dirs; do + if test -r "$ac_dir/X11/Xlib.h"; then + ac_x_includes=$ac_dir + break + fi +done +fi +rm -f conftest.err conftest.i conftest.$ac_ext +fi # $ac_x_includes = no + +if test "$ac_x_libraries" = no; then + # Check for the libraries. + # See if we find them without any special options. + # Don't add to $LIBS permanently. + ac_save_LIBS=$LIBS + LIBS="-lX11 $LIBS" + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#include +int +main () +{ +XrmInitialize () + ; + return 0; +} +_ACEOF +if ac_fn_c_try_link "$LINENO"; then : + LIBS=$ac_save_LIBS +# We can link X programs with no special library path. +ac_x_libraries= +else + LIBS=$ac_save_LIBS +for ac_dir in `$as_echo "$ac_x_includes $ac_x_header_dirs" | sed s/include/lib/g` +do + # Don't even attempt the hair of trying to link an X program! + for ac_extension in a so sl dylib la dll; do + if test -r "$ac_dir/libX11.$ac_extension"; then + ac_x_libraries=$ac_dir + break 2 + fi + done +done +fi +rm -f core conftest.err conftest.$ac_objext \ + conftest$ac_exeext conftest.$ac_ext +fi # $ac_x_libraries = no + +case $ac_x_includes,$ac_x_libraries in #( + no,* | *,no | *\'*) + # Didn't find X, or a directory has "'" in its name. + ac_cv_have_x="have_x=no";; #( + *) + # Record where we found X for the cache. + ac_cv_have_x="have_x=yes\ + ac_x_includes='$ac_x_includes'\ + ac_x_libraries='$ac_x_libraries'" +esac +fi +;; #( + *) have_x=yes;; + esac + eval "$ac_cv_have_x" +fi # $with_x != no + +if test "$have_x" != yes; then + { $as_echo "$as_me:${as_lineno-$LINENO}: result: $have_x" >&5 +$as_echo "$have_x" >&6; } + no_x=yes +else + # If each of the values was on the command line, it overrides each guess. + test "x$x_includes" = xNONE && x_includes=$ac_x_includes + test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries + # Update the cache value to reflect the command line values. + ac_cv_have_x="have_x=yes\ + ac_x_includes='$x_includes'\ + ac_x_libraries='$x_libraries'" + { $as_echo "$as_me:${as_lineno-$LINENO}: result: libraries $x_libraries, headers $x_includes" >&5 +$as_echo "libraries $x_libraries, headers $x_includes" >&6; } +fi + +for ac_header in arpa/inet.h fcntl.h fenv.h limits.h malloc.h netdb.h netinet/in.h nlist.h paths.h stddef.h stdint.h stdlib.h string.h sys/file.h sys/ioctl.h sys/param.h sys/socket.h sys/time.h unistd.h utmp.h +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_mongrel "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + +for ac_header in X11/Xlib-xcb.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "X11/Xlib-xcb.h" "ac_cv_header_X11_Xlib_xcb_h" "$ac_includes_default" +if test "x$ac_cv_header_X11_Xlib_xcb_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_X11_XLIB_XCB_H 1 +_ACEOF + +else + as_fn_error $? "you need X11/Xlib-xcb.h to compile the vlm" "$LINENO" 5 +fi + +done + +for ac_header in dlfcn.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "dlfcn.h" "ac_cv_header_dlfcn_h" "$ac_includes_default" +if test "x$ac_cv_header_dlfcn_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_DLFCN_H 1 +_ACEOF + +else + as_fn_error $? "you need dlfcn.h to compile the vlm" "$LINENO" 5 +fi + +done + + +# Checks for typedefs, structures, and compiler characteristics. +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for stdbool.h that conforms to C99" >&5 +$as_echo_n "checking for stdbool.h that conforms to C99... " >&6; } +if ${ac_cv_header_stdbool_h+:} false; then : + $as_echo_n "(cached) " >&6 +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + + #include + #ifndef bool + "error: bool is not defined" + #endif + #ifndef false + "error: false is not defined" + #endif + #if false + "error: false is not 0" + #endif + #ifndef true + "error: true is not defined" + #endif + #if true != 1 + "error: true is not 1" + #endif + #ifndef __bool_true_false_are_defined + "error: __bool_true_false_are_defined is not defined" + #endif + + struct s { _Bool s: 1; _Bool t; } s; + + char a[true == 1 ? 1 : -1]; + char b[false == 0 ? 1 : -1]; + char c[__bool_true_false_are_defined == 1 ? 1 : -1]; + char d[(bool) 0.5 == true ? 1 : -1]; + /* See body of main program for 'e'. */ + char f[(_Bool) 0.0 == false ? 1 : -1]; + char g[true]; + char h[sizeof (_Bool)]; + char i[sizeof s.t]; + enum { j = false, k = true, l = false * true, m = true * 256 }; + /* The following fails for + HP aC++/ANSI C B3910B A.05.55 [Dec 04 2003]. */ + _Bool n[m]; + char o[sizeof n == m * sizeof n[0] ? 1 : -1]; + char p[-1 - (_Bool) 0 < 0 && -1 - (bool) 0 < 0 ? 1 : -1]; + /* Catch a bug in an HP-UX C compiler. See + http://gcc.gnu.org/ml/gcc-patches/2003-12/msg02303.html + http://lists.gnu.org/archive/html/bug-coreutils/2005-11/msg00161.html + */ + _Bool q = true; + _Bool *pq = &q; + +int +main () +{ + + bool e = &s; + *pq |= q; + *pq |= ! q; + /* Refer to every declared value, to avoid compiler optimizations. */ + return (!a + !b + !c + !d + !e + !f + !g + !h + !i + !!j + !k + !!l + + !m + !n + !o + !p + !q + !pq); + + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_header_stdbool_h=yes +else + ac_cv_header_stdbool_h=no +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdbool_h" >&5 +$as_echo "$ac_cv_header_stdbool_h" >&6; } + ac_fn_c_check_type "$LINENO" "_Bool" "ac_cv_type__Bool" "$ac_includes_default" +if test "x$ac_cv_type__Bool" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE__BOOL 1 +_ACEOF + + +fi + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 +$as_echo_n "checking for inline... " >&6; } +if ${ac_cv_c_inline+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_c_inline=no +for ac_kw in inline __inline__ __inline; do + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#ifndef __cplusplus +typedef int foo_t; +static $ac_kw foo_t static_foo () {return 0; } +$ac_kw foo_t foo () {return 0; } +#endif + +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_c_inline=$ac_kw +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext + test "$ac_cv_c_inline" != no && break +done + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_inline" >&5 +$as_echo "$ac_cv_c_inline" >&6; } + +case $ac_cv_c_inline in + inline | yes) ;; + *) + case $ac_cv_c_inline in + no) ac_val=;; + *) ac_val=$ac_cv_c_inline;; + esac + cat >>confdefs.h <<_ACEOF +#ifndef __cplusplus +#define inline $ac_val +#endif +_ACEOF + ;; +esac + +ac_fn_c_find_intX_t "$LINENO" "16" "ac_cv_c_int16_t" +case $ac_cv_c_int16_t in #( + no|yes) ;; #( + *) + +cat >>confdefs.h <<_ACEOF +#define int16_t $ac_cv_c_int16_t +_ACEOF +;; +esac + +ac_fn_c_find_intX_t "$LINENO" "32" "ac_cv_c_int32_t" +case $ac_cv_c_int32_t in #( + no|yes) ;; #( + *) + +cat >>confdefs.h <<_ACEOF +#define int32_t $ac_cv_c_int32_t +_ACEOF +;; +esac + +ac_fn_c_find_intX_t "$LINENO" "64" "ac_cv_c_int64_t" +case $ac_cv_c_int64_t in #( + no|yes) ;; #( + *) + +cat >>confdefs.h <<_ACEOF +#define int64_t $ac_cv_c_int64_t +_ACEOF +;; +esac + +ac_fn_c_find_intX_t "$LINENO" "8" "ac_cv_c_int8_t" +case $ac_cv_c_int8_t in #( + no|yes) ;; #( + *) + +cat >>confdefs.h <<_ACEOF +#define int8_t $ac_cv_c_int8_t +_ACEOF +;; +esac + +ac_fn_c_check_type "$LINENO" "off_t" "ac_cv_type_off_t" "$ac_includes_default" +if test "x$ac_cv_type_off_t" = xyes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define off_t long int +_ACEOF + +fi + +ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" +if test "x$ac_cv_type_size_t" = xyes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define size_t unsigned int +_ACEOF + +fi + +ac_fn_c_check_type "$LINENO" "ssize_t" "ac_cv_type_ssize_t" "$ac_includes_default" +if test "x$ac_cv_type_ssize_t" = xyes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define ssize_t int +_ACEOF + +fi + +ac_fn_c_find_uintX_t "$LINENO" "16" "ac_cv_c_uint16_t" +case $ac_cv_c_uint16_t in #( + no|yes) ;; #( + *) + + +cat >>confdefs.h <<_ACEOF +#define uint16_t $ac_cv_c_uint16_t +_ACEOF +;; + esac + +ac_fn_c_find_uintX_t "$LINENO" "32" "ac_cv_c_uint32_t" +case $ac_cv_c_uint32_t in #( + no|yes) ;; #( + *) + +$as_echo "#define _UINT32_T 1" >>confdefs.h + + +cat >>confdefs.h <<_ACEOF +#define uint32_t $ac_cv_c_uint32_t +_ACEOF +;; + esac + +ac_fn_c_find_uintX_t "$LINENO" "64" "ac_cv_c_uint64_t" +case $ac_cv_c_uint64_t in #( + no|yes) ;; #( + *) + +$as_echo "#define _UINT64_T 1" >>confdefs.h + + +cat >>confdefs.h <<_ACEOF +#define uint64_t $ac_cv_c_uint64_t +_ACEOF +;; + esac + +ac_fn_c_find_uintX_t "$LINENO" "8" "ac_cv_c_uint8_t" +case $ac_cv_c_uint8_t in #( + no|yes) ;; #( + *) + +$as_echo "#define _UINT8_T 1" >>confdefs.h + + +cat >>confdefs.h <<_ACEOF +#define uint8_t $ac_cv_c_uint8_t +_ACEOF +;; + esac + +ac_fn_c_check_type "$LINENO" "ptrdiff_t" "ac_cv_type_ptrdiff_t" "$ac_includes_default" +if test "x$ac_cv_type_ptrdiff_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_PTRDIFF_T 1 +_ACEOF + + +fi + +ac_fn_c_check_type "$LINENO" "ucontext_t" "ac_cv_type_ucontext_t" "#include +" +if test "x$ac_cv_type_ucontext_t" = xyes; then : + +cat >>confdefs.h <<_ACEOF +#define HAVE_UCONTEXT_T 1 +_ACEOF + + +fi + + +# Checks for library functions. +for ac_header in stdlib.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default" +if test "x$ac_cv_header_stdlib_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_STDLIB_H 1 +_ACEOF + +fi + +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU libc compatible malloc" >&5 +$as_echo_n "checking for GNU libc compatible malloc... " >&6; } +if ${ac_cv_func_malloc_0_nonnull+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_func_malloc_0_nonnull=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#if defined STDC_HEADERS || defined HAVE_STDLIB_H +# include +#else +char *malloc (); +#endif + +int +main () +{ +return ! malloc (0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_func_malloc_0_nonnull=yes +else + ac_cv_func_malloc_0_nonnull=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_malloc_0_nonnull" >&5 +$as_echo "$ac_cv_func_malloc_0_nonnull" >&6; } +if test $ac_cv_func_malloc_0_nonnull = yes; then : + +$as_echo "#define HAVE_MALLOC 1" >>confdefs.h + +else + $as_echo "#define HAVE_MALLOC 0" >>confdefs.h + + case " $LIBOBJS " in + *" malloc.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS malloc.$ac_objext" + ;; +esac + + +$as_echo "#define malloc rpl_malloc" >>confdefs.h + +fi + + + + + + for ac_header in $ac_header_list +do : + as_ac_Header=`$as_echo "ac_cv_header_$ac_header" | $as_tr_sh` +ac_fn_c_check_header_compile "$LINENO" "$ac_header" "$as_ac_Header" "$ac_includes_default +" +if eval test \"x\$"$as_ac_Header"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_header" | $as_tr_cpp` 1 +_ACEOF + +fi + +done + + + + + + + + +for ac_func in getpagesize +do : + ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize" +if test "x$ac_cv_func_getpagesize" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_GETPAGESIZE 1 +_ACEOF + +fi +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5 +$as_echo_n "checking for working mmap... " >&6; } +if ${ac_cv_func_mmap_fixed_mapped+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_func_mmap_fixed_mapped=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +$ac_includes_default +/* malloc might have been renamed as rpl_malloc. */ +#undef malloc + +/* Thanks to Mike Haertel and Jim Avera for this test. + Here is a matrix of mmap possibilities: + mmap private not fixed + mmap private fixed at somewhere currently unmapped + mmap private fixed at somewhere already mapped + mmap shared not fixed + mmap shared fixed at somewhere currently unmapped + mmap shared fixed at somewhere already mapped + For private mappings, we should verify that changes cannot be read() + back from the file, nor mmap's back from the file at a different + address. (There have been systems where private was not correctly + implemented like the infamous i386 svr4.0, and systems where the + VM page cache was not coherent with the file system buffer cache + like early versions of FreeBSD and possibly contemporary NetBSD.) + For shared mappings, we should conversely verify that changes get + propagated back to all the places they're supposed to be. + + Grep wants private fixed already mapped. + The main things grep needs to know about mmap are: + * does it exist and is it safe to write into the mmap'd area + * how to use it (BSD variants) */ + +#include +#include + +#if !defined STDC_HEADERS && !defined HAVE_STDLIB_H +char *malloc (); +#endif + +/* This mess was copied from the GNU getpagesize.h. */ +#ifndef HAVE_GETPAGESIZE +# ifdef _SC_PAGESIZE +# define getpagesize() sysconf(_SC_PAGESIZE) +# else /* no _SC_PAGESIZE */ +# ifdef HAVE_SYS_PARAM_H +# include +# ifdef EXEC_PAGESIZE +# define getpagesize() EXEC_PAGESIZE +# else /* no EXEC_PAGESIZE */ +# ifdef NBPG +# define getpagesize() NBPG * CLSIZE +# ifndef CLSIZE +# define CLSIZE 1 +# endif /* no CLSIZE */ +# else /* no NBPG */ +# ifdef NBPC +# define getpagesize() NBPC +# else /* no NBPC */ +# ifdef PAGESIZE +# define getpagesize() PAGESIZE +# endif /* PAGESIZE */ +# endif /* no NBPC */ +# endif /* no NBPG */ +# endif /* no EXEC_PAGESIZE */ +# else /* no HAVE_SYS_PARAM_H */ +# define getpagesize() 8192 /* punt totally */ +# endif /* no HAVE_SYS_PARAM_H */ +# endif /* no _SC_PAGESIZE */ + +#endif /* no HAVE_GETPAGESIZE */ + +int +main () +{ + char *data, *data2, *data3; + const char *cdata2; + int i, pagesize; + int fd, fd2; + + pagesize = getpagesize (); + + /* First, make a file with some known garbage in it. */ + data = (char *) malloc (pagesize); + if (!data) + return 1; + for (i = 0; i < pagesize; ++i) + *(data + i) = rand (); + umask (0); + fd = creat ("conftest.mmap", 0600); + if (fd < 0) + return 2; + if (write (fd, data, pagesize) != pagesize) + return 3; + close (fd); + + /* Next, check that the tail of a page is zero-filled. File must have + non-zero length, otherwise we risk SIGBUS for entire page. */ + fd2 = open ("conftest.txt", O_RDWR | O_CREAT | O_TRUNC, 0600); + if (fd2 < 0) + return 4; + cdata2 = ""; + if (write (fd2, cdata2, 1) != 1) + return 5; + data2 = (char *) mmap (0, pagesize, PROT_READ | PROT_WRITE, MAP_SHARED, fd2, 0L); + if (data2 == MAP_FAILED) + return 6; + for (i = 0; i < pagesize; ++i) + if (*(data2 + i)) + return 7; + close (fd2); + if (munmap (data2, pagesize)) + return 8; + + /* Next, try to mmap the file at a fixed address which already has + something else allocated at it. If we can, also make sure that + we see the same garbage. */ + fd = open ("conftest.mmap", O_RDWR); + if (fd < 0) + return 9; + if (data2 != mmap (data2, pagesize, PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_FIXED, fd, 0L)) + return 10; + for (i = 0; i < pagesize; ++i) + if (*(data + i) != *(data2 + i)) + return 11; + + /* Finally, make sure that changes to the mapped area do not + percolate back to the file as seen by read(). (This is a bug on + some variants of i386 svr4.0.) */ + for (i = 0; i < pagesize; ++i) + *(data2 + i) = *(data2 + i) + 1; + data3 = (char *) malloc (pagesize); + if (!data3) + return 12; + if (read (fd, data3, pagesize) != pagesize) + return 13; + for (i = 0; i < pagesize; ++i) + if (*(data + i) != *(data3 + i)) + return 14; + close (fd); + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_func_mmap_fixed_mapped=yes +else + ac_cv_func_mmap_fixed_mapped=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_mmap_fixed_mapped" >&5 +$as_echo "$ac_cv_func_mmap_fixed_mapped" >&6; } +if test $ac_cv_func_mmap_fixed_mapped = yes; then + +$as_echo "#define HAVE_MMAP 1" >>confdefs.h + +fi +rm -f conftest.mmap conftest.txt + +for ac_header in stdlib.h +do : + ac_fn_c_check_header_mongrel "$LINENO" "stdlib.h" "ac_cv_header_stdlib_h" "$ac_includes_default" +if test "x$ac_cv_header_stdlib_h" = xyes; then : + cat >>confdefs.h <<_ACEOF +#define HAVE_STDLIB_H 1 +_ACEOF + +fi + +done + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNU libc compatible realloc" >&5 +$as_echo_n "checking for GNU libc compatible realloc... " >&6; } +if ${ac_cv_func_realloc_0_nonnull+:} false; then : + $as_echo_n "(cached) " >&6 +else + if test "$cross_compiling" = yes; then : + ac_cv_func_realloc_0_nonnull=no +else + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ +#if defined STDC_HEADERS || defined HAVE_STDLIB_H +# include +#else +char *realloc (); +#endif + +int +main () +{ +return ! realloc (0, 0); + ; + return 0; +} +_ACEOF +if ac_fn_c_try_run "$LINENO"; then : + ac_cv_func_realloc_0_nonnull=yes +else + ac_cv_func_realloc_0_nonnull=no +fi +rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ + conftest.$ac_objext conftest.beam conftest.$ac_ext +fi + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_func_realloc_0_nonnull" >&5 +$as_echo "$ac_cv_func_realloc_0_nonnull" >&6; } +if test $ac_cv_func_realloc_0_nonnull = yes; then : + +$as_echo "#define HAVE_REALLOC 1" >>confdefs.h + +else + $as_echo "#define HAVE_REALLOC 0" >>confdefs.h + + case " $LIBOBJS " in + *" realloc.$ac_objext "* ) ;; + *) LIBOBJS="$LIBOBJS realloc.$ac_objext" + ;; +esac + + +$as_echo "#define realloc rpl_realloc" >>confdefs.h + +fi + + +for ac_func in alarm atexit clock_gettime floor ftruncate getcwd gethostbyaddr gethostbyname gethostname getpagesize gettimeofday inet_ntoa memchr memmove memset munmap rint socket stpcpy strchr strdup strerror strndup strrchr strtoul uname strncasecmp +do : + as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh` +ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var" +if eval test \"x\$"$as_ac_var"\" = x"yes"; then : + cat >>confdefs.h <<_ACEOF +#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1 +_ACEOF + +fi +done + + +# Check whether --enable-debug was given. +if test "${enable_debug+set}" = set; then : + enableval=$enable_debug; +else + enable_debug=no +fi + +if ! test -z $enable_debug && + test "x$enable_debug" = "xyes" +then + $as_echo "enabling debugging" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -g2" >&5 +$as_echo_n "checking CFLAGS for gcc -g2... " >&6; } +if ${ac_cv_cflags_gcc_option__g2+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__g2="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -g2" "-pedantic % -g2 %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__g2=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__g2" >&5 +$as_echo "$ac_cv_cflags_gcc_option__g2" >&6; } +case ".$ac_cv_cflags_gcc_option__g2" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__g2 " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__g2"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__g2) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__g2\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__g2") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__g2" + fi + ;; +esac + +else + $as_echo "disabling debugging" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -g0" >&5 +$as_echo_n "checking CFLAGS for gcc -g0... " >&6; } +if ${ac_cv_cflags_gcc_option__g0+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__g0="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -g0" "-pedantic % -g0 %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__g0=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__g0" >&5 +$as_echo "$ac_cv_cflags_gcc_option__g0" >&6; } +case ".$ac_cv_cflags_gcc_option__g0" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__g0 " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__g0"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__g0) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__g0\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__g0") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__g0" + fi + ;; +esac + +fi + +# Check whether --enable-fast was given. +if test "${enable_fast+set}" = set; then : + enableval=$enable_fast; +else + enable_fast=yes +fi + +if ! test -z $enable_fast && + test "x$enable_fast" = "xno" +then + $as_echo "disabling optimization for speed" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -O2" >&5 +$as_echo_n "checking CFLAGS for gcc -O2... " >&6; } +if ${ac_cv_cflags_gcc_option__O2+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__O2="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -O2" "-pedantic % -O2 %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__O2=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__O2" >&5 +$as_echo "$ac_cv_cflags_gcc_option__O2" >&6; } +case ".$ac_cv_cflags_gcc_option__O2" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__O2 " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__O2"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__O2) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__O2\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__O2") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__O2" + fi + ;; +esac + +else + $as_echo "enabling optimization for speed" + { $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -Ofast" >&5 +$as_echo_n "checking CFLAGS for gcc -Ofast... " >&6; } +if ${ac_cv_cflags_gcc_option__Ofast+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__Ofast="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -Ofast" "-pedantic % -Ofast %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__Ofast=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__Ofast" >&5 +$as_echo "$ac_cv_cflags_gcc_option__Ofast" >&6; } +case ".$ac_cv_cflags_gcc_option__Ofast" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__Ofast " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__Ofast"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__Ofast) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__Ofast\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__Ofast") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__Ofast" + fi + ;; +esac + +fi + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -rdynamic" >&5 +$as_echo_n "checking CFLAGS for gcc -rdynamic... " >&6; } +if ${ac_cv_cflags_gcc_option__rdynamic+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__rdynamic="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -rdynamic" "-pedantic % -rdynamic %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__rdynamic=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__rdynamic" >&5 +$as_echo "$ac_cv_cflags_gcc_option__rdynamic" >&6; } +case ".$ac_cv_cflags_gcc_option__rdynamic" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__rdynamic " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__rdynamic"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__rdynamic) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__rdynamic\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__rdynamic") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__rdynamic" + fi + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -fno-strict-aliasing" >&5 +$as_echo_n "checking CFLAGS for gcc -fno-strict-aliasing... " >&6; } +if ${ac_cv_cflags_gcc_option__fno_strict_aliasing+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__fno_strict_aliasing="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -fno-strict-aliasing" "-pedantic % -fno-strict-aliasing %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__fno_strict_aliasing=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__fno_strict_aliasing" >&5 +$as_echo "$ac_cv_cflags_gcc_option__fno_strict_aliasing" >&6; } +case ".$ac_cv_cflags_gcc_option__fno_strict_aliasing" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__fno_strict_aliasing " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__fno_strict_aliasing"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__fno_strict_aliasing) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__fno_strict_aliasing\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__fno_strict_aliasing") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__fno_strict_aliasing" + fi + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -march=native" >&5 +$as_echo_n "checking CFLAGS for gcc -march=native... " >&6; } +if ${ac_cv_cflags_gcc_option__march_native+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__march_native="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -march=native" "-pedantic % -march=native %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__march_native=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__march_native" >&5 +$as_echo "$ac_cv_cflags_gcc_option__march_native" >&6; } +case ".$ac_cv_cflags_gcc_option__march_native" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__march_native " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__march_native"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__march_native) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__march_native\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__march_native") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__march_native" + fi + ;; +esac + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking CFLAGS for gcc -Wall" >&5 +$as_echo_n "checking CFLAGS for gcc -Wall... " >&6; } +if ${ac_cv_cflags_gcc_option__Wall+:} false; then : + $as_echo_n "(cached) " >&6 +else + ac_cv_cflags_gcc_option__Wall="no, unknown" + + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + ac_save_CFLAGS="$CFLAGS" +for ac_arg in "-pedantic -Werror % -Wall" "-pedantic % -Wall %% no, obsolete" # +do CFLAGS="$ac_save_CFLAGS "`echo $ac_arg | sed -e 's,%%.*,,' -e 's,%,,'` + cat confdefs.h - <<_ACEOF >conftest.$ac_ext +/* end confdefs.h. */ + +int +main () +{ +return 0; + ; + return 0; +} +_ACEOF +if ac_fn_c_try_compile "$LINENO"; then : + ac_cv_cflags_gcc_option__Wall=`echo $ac_arg | sed -e 's,.*% *,,'` ; break +fi +rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext +done + CFLAGS="$ac_save_CFLAGS" + ac_ext=c +ac_cpp='$CPP $CPPFLAGS' +ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' +ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' +ac_compiler_gnu=$ac_cv_c_compiler_gnu + + +fi +{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cflags_gcc_option__Wall" >&5 +$as_echo "$ac_cv_cflags_gcc_option__Wall" >&6; } +case ".$ac_cv_cflags_gcc_option__Wall" in + .ok|.ok,*) ;; + .|.no|.no,*) ;; + *) + if echo " $CFLAGS " | grep " $ac_cv_cflags_gcc_option__Wall " 2>&1 >/dev/null + then { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS does contain \$ac_cv_cflags_gcc_option__Wall"; } >&5 + (: CFLAGS does contain $ac_cv_cflags_gcc_option__Wall) 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + else { { $as_echo "$as_me:${as_lineno-$LINENO}: : CFLAGS=\"\$CFLAGS \$ac_cv_cflags_gcc_option__Wall\""; } >&5 + (: CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__Wall") 2>&5 + ac_status=$? + $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 + test $ac_status = 0; } + CFLAGS="$CFLAGS $ac_cv_cflags_gcc_option__Wall" + fi + ;; +esac + + +# Check whether --enable-genera was given. +if test "${enable_genera+set}" = set; then : + enableval=$enable_genera; +else + enable_genera=yes +fi + +if ! test -z $enable_genera && + test "x$enable_genera" = "xno" +then + $as_echo "disabling compilation for genera" +else + $as_echo "enabling compilation for genera" + CPPFLAGS+=" -DGENERA -DAUTOSTART" +fi + +# Check whether --enable-debug-disk was given. +if test "${enable_debug_disk+set}" = set; then : + enableval=$enable_debug_disk; +else + enable_debug_disk=no +fi + +if test ! -z $enable_debug_disk && + test "x$enable_debug_disk" = "xyes" +then + $as_echo "enabling disk debugging" + CPPFLAGS+=" -DDEBUG_DISK" +else + $as_echo "disabling disk debugging" +fi + +# Check whether --enable-debug-network was given. +if test "${enable_debug_network+set}" = set; then : + enableval=$enable_debug_network; +else + enable_debug_network=no +fi + +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + $as_echo "enabling network debugging" + CPPFLAGS+=" -DDEBUG_NETWORK=1" +else + $as_echo "disabling network debugging" +fi + +# Check whether --enable-debug-network-ip was given. +if test "${enable_debug_network_ip+set}" = set; then : + enableval=$enable_debug_network_ip; +else + enable_debug_network_ip=no +fi + +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_ip && + test "x$enable_debug_network_ip" = "xyes" + then + $as_echo "enabling IP network debugging" + CPPFLAGS+=" -DDEBUG_IP=1" + else + $as_echo "disabling IP network debugging" + fi +else + if ! test -z $enable_debug_network_ip && + test "x$enable_debug_network_ip" = "xyes" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: enabling IP network debugging has no effect if network debugging is disabled" >&5 +$as_echo "$as_me: WARNING: enabling IP network debugging has no effect if network debugging is disabled" >&2;} + fi +fi + +# Check whether --enable-debug-network-chaos was given. +if test "${enable_debug_network_chaos+set}" = set; then : + enableval=$enable_debug_network_chaos; +else + enable_debug_network_chaos=no +fi + +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_chaos && + test "x$enable_debug_network_chaos" = "xyes" + then + $as_echo "enabling CHAOS network debugging" + CPPFLAGS+=" -DDEBUG_CHAOS=1" + else + $as_echo "disabling CHAOS network debugging" + fi +else + if ! test -z $enable_debug_network_chaos && + test "x$enable_debug_network_chaos" = "xyes" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: enabling CHAOS network debugging has no effect if network debugging is disabled" >&5 +$as_echo "$as_me: WARNING: enabling CHAOS network debugging has no effect if network debugging is disabled" >&2;} + fi +fi + +# Check whether --enable-debug-network-arp was given. +if test "${enable_debug_network_arp+set}" = set; then : + enableval=$enable_debug_network_arp; +else + enable_debug_network_arp=no +fi + +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_arp && + test "x$enable_debug_network_arp" = "xyes" + then + $as_echo "enabling ARP network debugging" + CPPFLAGS+=" -DDEBUG_ARP=1" + else + $as_echo "disabling ARP network debugging" + fi +else + if ! test -z $enable_debug_network_arp && + test "x$enable_debug_network_arp" = "xyes" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: enabling ARP network debugging has no effect if network debugging is disabled" >&5 +$as_echo "$as_me: WARNING: enabling ARP network debugging has no effect if network debugging is disabled" >&2;} + fi +fi + +# Check whether --enable-debug-network-icmp was given. +if test "${enable_debug_network_icmp+set}" = set; then : + enableval=$enable_debug_network_icmp; +else + enable_debug_network_icmp=no +fi + +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_icmp && + test "x$enable_debug_network_icmp" = "xyes" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: enabling IP network debugging to enable ICMP debugging" >&5 +$as_echo "$as_me: WARNING: enabling IP network debugging to enable ICMP debugging" >&2;} + $as_echo "enabling ICMP network debugging" + CPPFLAGS+=" -DDEBUG_IP -DDEBUG_ICMP=1" + else + $as_echo "disabling ICMP network debugging" + fi +else + if ! test -z $enable_debug_network_icmp && + test "x$enable_debug_network_icmp" = "xyes" + then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: enabling ICMP network debugging has no effect if network debugging is disabled" >&5 +$as_echo "$as_me: WARNING: enabling ICMP network debugging has no effect if network debugging is disabled" >&2;} + fi +fi + + +# Check whether --with-tap was given. +if test "${with_tap+set}" = set; then : + withval=$with_tap; +else + with_tap=yes +fi + +if test ! -z $with_tap && test "x$with_tap" = "xyes" +then + $as_echo "using tap network interface" + CPPFLAGS+=" -DUSE_TAP" +else + $as_echo "using tun network interface" + CPPFLAGS+=" -DUSE_TUN" +fi + +ac_config_files="$ac_config_files Makefile src/Makefile emulator/Makefile life-support/Makefile stub/Makefile" + +cat >confcache <<\_ACEOF +# This file is a shell script that caches the results of configure +# tests run on this system so they can be shared between configure +# scripts and configure runs, see configure's option --config-cache. +# It is not useful on other systems. If it contains results you don't +# want to keep, you may remove or edit it. +# +# config.status only pays attention to the cache file if you give it +# the --recheck option to rerun configure. +# +# `ac_cv_env_foo' variables (set or unset) will be overridden when +# loading this file, other *unset* `ac_cv_foo' will be assigned the +# following values. + +_ACEOF + +# The following way of writing the cache mishandles newlines in values, +# but we know of no workaround that is simple, portable, and efficient. +# So, we kill variables containing newlines. +# Ultrix sh set writes to stderr and can't be redirected directly, +# and sets the high bit in the cache file unless we assign to the vars. +( + for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do + eval ac_val=\$$ac_var + case $ac_val in #( + *${as_nl}*) + case $ac_var in #( + *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 +$as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; + esac + case $ac_var in #( + _ | IFS | as_nl) ;; #( + BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( + *) { eval $ac_var=; unset $ac_var;} ;; + esac ;; + esac + done + + (set) 2>&1 | + case $as_nl`(ac_space=' '; set) 2>&1` in #( + *${as_nl}ac_space=\ *) + # `set' does not quote correctly, so add quotes: double-quote + # substitution turns \\\\ into \\, and sed turns \\ into \. + sed -n \ + "s/'/'\\\\''/g; + s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" + ;; #( + *) + # `set' quotes correctly as required by POSIX, so do not add quotes. + sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" + ;; + esac | + sort +) | + sed ' + /^ac_cv_env_/b end + t clear + :clear + s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ + t end + s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ + :end' >>confcache +if diff "$cache_file" confcache >/dev/null 2>&1; then :; else + if test -w "$cache_file"; then + if test "x$cache_file" != "x/dev/null"; then + { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 +$as_echo "$as_me: updating cache $cache_file" >&6;} + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi + else + { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 +$as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} + fi +fi +rm -f confcache + +test "x$prefix" = xNONE && prefix=$ac_default_prefix +# Let make expand exec_prefix. +test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' + +DEFS=-DHAVE_CONFIG_H + +ac_libobjs= +ac_ltlibobjs= +U= +for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue + # 1. Remove the extension, and $U if already installed. + ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' + ac_i=`$as_echo "$ac_i" | sed "$ac_script"` + # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR + # will be set to the directory where LIBOBJS objects are built. + as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" + as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' +done +LIBOBJS=$ac_libobjs + +LTLIBOBJS=$ac_ltlibobjs + + +{ $as_echo "$as_me:${as_lineno-$LINENO}: checking that generated files are newer than configure" >&5 +$as_echo_n "checking that generated files are newer than configure... " >&6; } + if test -n "$am_sleep_pid"; then + # Hide warnings about reused PIDs. + wait $am_sleep_pid 2>/dev/null + fi + { $as_echo "$as_me:${as_lineno-$LINENO}: result: done" >&5 +$as_echo "done" >&6; } + if test -n "$EXEEXT"; then + am__EXEEXT_TRUE= + am__EXEEXT_FALSE='#' +else + am__EXEEXT_TRUE='#' + am__EXEEXT_FALSE= +fi + +if test -z "${AMDEP_TRUE}" && test -z "${AMDEP_FALSE}"; then + as_fn_error $? "conditional \"AMDEP\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${am__fastdepCC_TRUE}" && test -z "${am__fastdepCC_FALSE}"; then + as_fn_error $? "conditional \"am__fastdepCC\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi +if test -z "${HCLISP_TRUE}" && test -z "${HCLISP_FALSE}"; then + as_fn_error $? "conditional \"HCLISP\" was never defined. +Usually this means the macro was only invoked conditionally." "$LINENO" 5 +fi + +: "${CONFIG_STATUS=./config.status}" +ac_write_fail=0 +ac_clean_files_save=$ac_clean_files +ac_clean_files="$ac_clean_files $CONFIG_STATUS" +{ $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 +$as_echo "$as_me: creating $CONFIG_STATUS" >&6;} +as_write_fail=0 +cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 +#! $SHELL +# Generated by $as_me. +# Run this file to recreate the current configuration. +# Compiler output produced by configure, useful for debugging +# configure, is in config.log if it exists. + +debug=false +ac_cs_recheck=false +ac_cs_silent=false + +SHELL=\${CONFIG_SHELL-$SHELL} +export SHELL +_ASEOF +cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 +## -------------------- ## +## M4sh Initialization. ## +## -------------------- ## + +# Be more Bourne compatible +DUALCASE=1; export DUALCASE # for MKS sh +if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : + emulate sh + NULLCMD=: + # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which + # is contrary to our usage. Disable this feature. + alias -g '${1+"$@"}'='"$@"' + setopt NO_GLOB_SUBST +else + case `(set -o) 2>/dev/null` in #( + *posix*) : + set -o posix ;; #( + *) : + ;; +esac +fi + + +as_nl=' +' +export as_nl +# Printing a long string crashes Solaris 7 /usr/bin/printf. +as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo +as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo +# Prefer a ksh shell builtin over an external printf program on Solaris, +# but without wasting forks for bash or zsh. +if test -z "$BASH_VERSION$ZSH_VERSION" \ + && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='print -r --' + as_echo_n='print -rn --' +elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then + as_echo='printf %s\n' + as_echo_n='printf %s' +else + if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then + as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' + as_echo_n='/usr/ucb/echo -n' + else + as_echo_body='eval expr "X$1" : "X\\(.*\\)"' + as_echo_n_body='eval + arg=$1; + case $arg in #( + *"$as_nl"*) + expr "X$arg" : "X\\(.*\\)$as_nl"; + arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; + esac; + expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" + ' + export as_echo_n_body + as_echo_n='sh -c $as_echo_n_body as_echo' + fi + export as_echo_body + as_echo='sh -c $as_echo_body as_echo' +fi + +# The user is always right. +if test "${PATH_SEPARATOR+set}" != set; then + PATH_SEPARATOR=: + (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { + (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || + PATH_SEPARATOR=';' + } +fi + + +# IFS +# We need space, tab and new line, in precisely that order. Quoting is +# there to prevent editors from complaining about space-tab. +# (If _AS_PATH_WALK were called with IFS unset, it would disable word +# splitting by setting IFS to empty value.) +IFS=" "" $as_nl" + +# Find who we are. Look in the path if we contain no directory separator. +as_myself= +case $0 in #(( + *[\\/]* ) as_myself=$0 ;; + *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR +for as_dir in $PATH +do + IFS=$as_save_IFS + test -z "$as_dir" && as_dir=. + test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break + done +IFS=$as_save_IFS + + ;; +esac +# We did not find ourselves, most probably we were run as `sh COMMAND' +# in which case we are not to be found in the path. +if test "x$as_myself" = x; then + as_myself=$0 +fi +if test ! -f "$as_myself"; then + $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 + exit 1 +fi + +# Unset variables that we do not need and which cause bugs (e.g. in +# pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" +# suppresses any "Segmentation fault" message there. '((' could +# trigger a bug in pdksh 5.2.14. +for as_var in BASH_ENV ENV MAIL MAILPATH +do eval test x\${$as_var+set} = xset \ + && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : +done +PS1='$ ' +PS2='> ' +PS4='+ ' + +# NLS nuisances. +LC_ALL=C +export LC_ALL +LANGUAGE=C +export LANGUAGE + +# CDPATH. +(unset CDPATH) >/dev/null 2>&1 && unset CDPATH + + +# as_fn_error STATUS ERROR [LINENO LOG_FD] +# ---------------------------------------- +# Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are +# provided, also output the error to LOG_FD, referencing LINENO. Then exit the +# script with STATUS, using 1 if that was 0. +as_fn_error () +{ + as_status=$1; test $as_status -eq 0 && as_status=1 + if test "$4"; then + as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack + $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 + fi + $as_echo "$as_me: error: $2" >&2 + as_fn_exit $as_status +} # as_fn_error + + +# as_fn_set_status STATUS +# ----------------------- +# Set $? to STATUS, without forking. +as_fn_set_status () +{ + return $1 +} # as_fn_set_status + +# as_fn_exit STATUS +# ----------------- +# Exit the shell with STATUS, even in a "trap 0" or "set -e" context. +as_fn_exit () +{ + set +e + as_fn_set_status $1 + exit $1 +} # as_fn_exit + +# as_fn_unset VAR +# --------------- +# Portably unset VAR. +as_fn_unset () +{ + { eval $1=; unset $1;} +} +as_unset=as_fn_unset +# as_fn_append VAR VALUE +# ---------------------- +# Append the text in VALUE to the end of the definition contained in VAR. Take +# advantage of any shell optimizations that allow amortized linear growth over +# repeated appends, instead of the typical quadratic growth present in naive +# implementations. +if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : + eval 'as_fn_append () + { + eval $1+=\$2 + }' +else + as_fn_append () + { + eval $1=\$$1\$2 + } +fi # as_fn_append + +# as_fn_arith ARG... +# ------------------ +# Perform arithmetic evaluation on the ARGs, and store the result in the +# global $as_val. Take advantage of shells that can avoid forks. The arguments +# must be portable across $(()) and expr. +if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : + eval 'as_fn_arith () + { + as_val=$(( $* )) + }' +else + as_fn_arith () + { + as_val=`expr "$@" || test $? -eq 1` + } +fi # as_fn_arith + + +if expr a : '\(a\)' >/dev/null 2>&1 && + test "X`expr 00001 : '.*\(...\)'`" = X001; then + as_expr=expr +else + as_expr=false +fi + +if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then + as_basename=basename +else + as_basename=false +fi + +if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then + as_dirname=dirname +else + as_dirname=false +fi + +as_me=`$as_basename -- "$0" || +$as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ + X"$0" : 'X\(//\)$' \| \ + X"$0" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X/"$0" | + sed '/^.*\/\([^/][^/]*\)\/*$/{ + s//\1/ + q + } + /^X\/\(\/\/\)$/{ + s//\1/ + q + } + /^X\/\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + +# Avoid depending upon Character Ranges. +as_cr_letters='abcdefghijklmnopqrstuvwxyz' +as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' +as_cr_Letters=$as_cr_letters$as_cr_LETTERS +as_cr_digits='0123456789' +as_cr_alnum=$as_cr_Letters$as_cr_digits + +ECHO_C= ECHO_N= ECHO_T= +case `echo -n x` in #((((( +-n*) + case `echo 'xy\c'` in + *c*) ECHO_T=' ';; # ECHO_T is single tab character. + xy) ECHO_C='\c';; + *) echo `echo ksh88 bug on AIX 6.1` > /dev/null + ECHO_T=' ';; + esac;; +*) + ECHO_N='-n';; +esac + +rm -f conf$$ conf$$.exe conf$$.file +if test -d conf$$.dir; then + rm -f conf$$.dir/conf$$.file +else + rm -f conf$$.dir + mkdir conf$$.dir 2>/dev/null +fi +if (echo >conf$$.file) 2>/dev/null; then + if ln -s conf$$.file conf$$ 2>/dev/null; then + as_ln_s='ln -s' + # ... but there are two gotchas: + # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. + # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. + # In both cases, we have to default to `cp -pR'. + ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || + as_ln_s='cp -pR' + elif ln conf$$.file conf$$ 2>/dev/null; then + as_ln_s=ln + else + as_ln_s='cp -pR' + fi +else + as_ln_s='cp -pR' +fi +rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file +rmdir conf$$.dir 2>/dev/null + + +# as_fn_mkdir_p +# ------------- +# Create "$as_dir" as a directory, including parents if necessary. +as_fn_mkdir_p () +{ + + case $as_dir in #( + -*) as_dir=./$as_dir;; + esac + test -d "$as_dir" || eval $as_mkdir_p || { + as_dirs= + while :; do + case $as_dir in #( + *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( + *) as_qdir=$as_dir;; + esac + as_dirs="'$as_qdir' $as_dirs" + as_dir=`$as_dirname -- "$as_dir" || +$as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$as_dir" : 'X\(//\)[^/]' \| \ + X"$as_dir" : 'X\(//\)$' \| \ + X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$as_dir" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + test -d "$as_dir" && break + done + test -z "$as_dirs" || eval "mkdir $as_dirs" + } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" + + +} # as_fn_mkdir_p +if mkdir -p . 2>/dev/null; then + as_mkdir_p='mkdir -p "$as_dir"' +else + test -d ./-p && rmdir ./-p + as_mkdir_p=false +fi + + +# as_fn_executable_p FILE +# ----------------------- +# Test if FILE is an executable regular file. +as_fn_executable_p () +{ + test -f "$1" && test -x "$1" +} # as_fn_executable_p +as_test_x='test -x' +as_executable_p=as_fn_executable_p + +# Sed expression to map a string onto a valid CPP name. +as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" + +# Sed expression to map a string onto a valid variable name. +as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" + + +exec 6>&1 +## ----------------------------------- ## +## Main body of $CONFIG_STATUS script. ## +## ----------------------------------- ## +_ASEOF +test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# Save the log message, to keep $0 and so on meaningful, and to +# report actual input values of CONFIG_FILES etc. instead of their +# values after options handling. +ac_log=" +This file was extended by vlm $as_me 0.99-1, which was +generated by GNU Autoconf 2.69. Invocation command line was + + CONFIG_FILES = $CONFIG_FILES + CONFIG_HEADERS = $CONFIG_HEADERS + CONFIG_LINKS = $CONFIG_LINKS + CONFIG_COMMANDS = $CONFIG_COMMANDS + $ $0 $@ + +on `(hostname || uname -n) 2>/dev/null | sed 1q` +" + +_ACEOF + +case $ac_config_files in *" +"*) set x $ac_config_files; shift; ac_config_files=$*;; +esac + +case $ac_config_headers in *" +"*) set x $ac_config_headers; shift; ac_config_headers=$*;; +esac + + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# Files that config.status was made for. +config_files="$ac_config_files" +config_headers="$ac_config_headers" +config_commands="$ac_config_commands" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +ac_cs_usage="\ +\`$as_me' instantiates files and other configuration actions +from templates according to the current configuration. Unless the files +and actions are specified as TAGs, all are instantiated by default. + +Usage: $0 [OPTION]... [TAG]... + + -h, --help print this help, then exit + -V, --version print version number and configuration settings, then exit + --config print configuration, then exit + -q, --quiet, --silent + do not print progress messages + -d, --debug don't remove temporary files + --recheck update $as_me by reconfiguring in the same conditions + --file=FILE[:TEMPLATE] + instantiate the configuration file FILE + --header=FILE[:TEMPLATE] + instantiate the configuration header FILE + +Configuration files: +$config_files + +Configuration headers: +$config_headers + +Configuration commands: +$config_commands + +Report bugs to ." + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" +ac_cs_version="\\ +vlm config.status 0.99-1 +configured by $0, generated by GNU Autoconf 2.69, + with options \\"\$ac_cs_config\\" + +Copyright (C) 2012 Free Software Foundation, Inc. +This config.status script is free software; the Free Software Foundation +gives unlimited permission to copy, distribute and modify it." + +ac_pwd='$ac_pwd' +srcdir='$srcdir' +INSTALL='$INSTALL' +MKDIR_P='$MKDIR_P' +AWK='$AWK' +test -n "\$AWK" || AWK=awk +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# The default lists apply if the user does not specify any file. +ac_need_defaults=: +while test $# != 0 +do + case $1 in + --*=?*) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` + ac_shift=: + ;; + --*=) + ac_option=`expr "X$1" : 'X\([^=]*\)='` + ac_optarg= + ac_shift=: + ;; + *) + ac_option=$1 + ac_optarg=$2 + ac_shift=shift + ;; + esac + + case $ac_option in + # Handling of the options. + -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) + ac_cs_recheck=: ;; + --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) + $as_echo "$ac_cs_version"; exit ;; + --config | --confi | --conf | --con | --co | --c ) + $as_echo "$ac_cs_config"; exit ;; + --debug | --debu | --deb | --de | --d | -d ) + debug=: ;; + --file | --fil | --fi | --f ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + '') as_fn_error $? "missing file argument" ;; + esac + as_fn_append CONFIG_FILES " '$ac_optarg'" + ac_need_defaults=false;; + --header | --heade | --head | --hea ) + $ac_shift + case $ac_optarg in + *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; + esac + as_fn_append CONFIG_HEADERS " '$ac_optarg'" + ac_need_defaults=false;; + --he | --h) + # Conflict between --help and --header + as_fn_error $? "ambiguous option: \`$1' +Try \`$0 --help' for more information.";; + --help | --hel | -h ) + $as_echo "$ac_cs_usage"; exit ;; + -q | -quiet | --quiet | --quie | --qui | --qu | --q \ + | -silent | --silent | --silen | --sile | --sil | --si | --s) + ac_cs_silent=: ;; + + # This is an error. + -*) as_fn_error $? "unrecognized option: \`$1' +Try \`$0 --help' for more information." ;; + + *) as_fn_append ac_config_targets " $1" + ac_need_defaults=false ;; + + esac + shift +done + +ac_configure_extra_args= + +if $ac_cs_silent; then + exec 6>/dev/null + ac_configure_extra_args="$ac_configure_extra_args --silent" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +if \$ac_cs_recheck; then + set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion + shift + \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 + CONFIG_SHELL='$SHELL' + export CONFIG_SHELL + exec "\$@" +fi + +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +exec 5>>config.log +{ + echo + sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX +## Running $as_me. ## +_ASBOX + $as_echo "$ac_log" +} >&5 + +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +# +# INIT-COMMANDS +# +AMDEP_TRUE="$AMDEP_TRUE" ac_aux_dir="$ac_aux_dir" + +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + +# Handling of arguments. +for ac_config_target in $ac_config_targets +do + case $ac_config_target in + "config.h") CONFIG_HEADERS="$CONFIG_HEADERS config.h" ;; + "depfiles") CONFIG_COMMANDS="$CONFIG_COMMANDS depfiles" ;; + "Makefile") CONFIG_FILES="$CONFIG_FILES Makefile" ;; + "src/Makefile") CONFIG_FILES="$CONFIG_FILES src/Makefile" ;; + "emulator/Makefile") CONFIG_FILES="$CONFIG_FILES emulator/Makefile" ;; + "life-support/Makefile") CONFIG_FILES="$CONFIG_FILES life-support/Makefile" ;; + "stub/Makefile") CONFIG_FILES="$CONFIG_FILES stub/Makefile" ;; + + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; + esac +done + + +# If the user did not use the arguments to specify the items to instantiate, +# then the envvar interface is used. Set only those that are not. +# We use the long form for the default assignment because of an extremely +# bizarre bug on SunOS 4.1.3. +if $ac_need_defaults; then + test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files + test "${CONFIG_HEADERS+set}" = set || CONFIG_HEADERS=$config_headers + test "${CONFIG_COMMANDS+set}" = set || CONFIG_COMMANDS=$config_commands +fi + +# Have a temporary directory for convenience. Make it in the build tree +# simply because there is no reason against having it here, and in addition, +# creating and moving files from /tmp can sometimes cause problems. +# Hook for its removal unless debugging. +# Note that there is a small window in which the directory will not be cleaned: +# after its creation but before its name has been assigned to `$tmp'. +$debug || +{ + tmp= ac_tmp= + trap 'exit_status=$? + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status +' 0 + trap 'as_fn_exit 1' 1 2 13 15 +} +# Create a (secure) tmp directory for tmp files. + +{ + tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && + test -d "$tmp" +} || +{ + tmp=./conf$$-$RANDOM + (umask 077 && mkdir "$tmp") +} || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp + +# Set up the scripts for CONFIG_FILES section. +# No need to generate them if there are no CONFIG_FILES. +# This happens for instance with `./config.status config.h'. +if test -n "$CONFIG_FILES"; then + + +ac_cr=`echo X | tr X '\015'` +# On cygwin, bash can eat \r inside `` if the user requested igncr. +# But we know of no other shell where ac_cr would be empty at this +# point, so we can use a bashism as a fallback. +if test "x$ac_cr" = x; then + eval ac_cr=\$\'\\r\' +fi +ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` +if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then + ac_cs_awk_cr='\\r' +else + ac_cs_awk_cr=$ac_cr +fi + +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && +_ACEOF + + +{ + echo "cat >conf$$subs.awk <<_ACEOF" && + echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && + echo "_ACEOF" +} >conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 +ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` +ac_delim='%!_!# ' +for ac_last_try in false false false false false :; do + . ./conf$$subs.sh || + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + + ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` + if test $ac_delim_n = $ac_delim_num; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done +rm -f conf$$subs.sh + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && +_ACEOF +sed -n ' +h +s/^/S["/; s/!.*/"]=/ +p +g +s/^[^!]*!// +:repl +t repl +s/'"$ac_delim"'$// +t delim +:nl +h +s/\(.\{148\}\)..*/\1/ +t more1 +s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ +p +n +b repl +:more1 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t nl +:delim +h +s/\(.\{148\}\)..*/\1/ +t more2 +s/["\\]/\\&/g; s/^/"/; s/$/"/ +p +b +:more2 +s/["\\]/\\&/g; s/^/"/; s/$/"\\/ +p +g +s/.\{148\}// +t delim +' >$CONFIG_STATUS || ac_write_fail=1 +rm -f conf$$subs.awk +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +_ACAWK +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && + for (key in S) S_is_set[key] = 1 + FS = "" + +} +{ + line = $ 0 + nfields = split(line, field, "@") + substed = 0 + len = length(field[1]) + for (i = 2; i < nfields; i++) { + key = field[i] + keylen = length(key) + if (S_is_set[key]) { + value = S[key] + line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) + len += length(value) + length(field[++i]) + substed = 1 + } else + len += 1 + keylen + } + + print line +} + +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then + sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" +else + cat +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ + || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 +_ACEOF + +# VPATH may cause trouble with some makes, so we remove sole $(srcdir), +# ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and +# trailing colons and then remove the whole line if VPATH becomes empty +# (actually we leave an empty line to preserve line numbers). +if test "x$srcdir" = x.; then + ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ +h +s/// +s/^/:/ +s/[ ]*$/:/ +s/:\$(srcdir):/:/g +s/:\${srcdir}:/:/g +s/:@srcdir@:/:/g +s/^:*// +s/:*$// +x +s/\(=[ ]*\).*/\1/ +G +s/\n// +s/^[^=]*=[ ]*$// +}' +fi + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +fi # test -n "$CONFIG_FILES" + +# Set up the scripts for CONFIG_HEADERS section. +# No need to generate them if there are no CONFIG_HEADERS. +# This happens for instance with `./config.status Makefile'. +if test -n "$CONFIG_HEADERS"; then +cat >"$ac_tmp/defines.awk" <<\_ACAWK || +BEGIN { +_ACEOF + +# Transform confdefs.h into an awk script `defines.awk', embedded as +# here-document in config.status, that substitutes the proper values into +# config.h.in to produce config.h. + +# Create a delimiter string that does not exist in confdefs.h, to ease +# handling of long lines. +ac_delim='%!_!# ' +for ac_last_try in false false :; do + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then + break + elif $ac_last_try; then + as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 + else + ac_delim="$ac_delim!$ac_delim _$ac_delim!! " + fi +done + +# For the awk script, D is an array of macro values keyed by name, +# likewise P contains macro parameters if any. Preserve backslash +# newline sequences. + +ac_word_re=[_$as_cr_Letters][_$as_cr_alnum]* +sed -n ' +s/.\{148\}/&'"$ac_delim"'/g +t rset +:rset +s/^[ ]*#[ ]*define[ ][ ]*/ / +t def +d +:def +s/\\$// +t bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3"/p +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2"/p +d +:bsnl +s/["\\]/\\&/g +s/^ \('"$ac_word_re"'\)\(([^()]*)\)[ ]*\(.*\)/P["\1"]="\2"\ +D["\1"]=" \3\\\\\\n"\\/p +t cont +s/^ \('"$ac_word_re"'\)[ ]*\(.*\)/D["\1"]=" \2\\\\\\n"\\/p +t cont +d +:cont +n +s/.\{148\}/&'"$ac_delim"'/g +t clear +:clear +s/\\$// +t bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/"/p +d +:bsnlc +s/["\\]/\\&/g; s/^/"/; s/$/\\\\\\n"\\/p +b cont +' >$CONFIG_STATUS || ac_write_fail=1 + +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + for (key in D) D_is_set[key] = 1 + FS = "" +} +/^[\t ]*#[\t ]*(define|undef)[\t ]+$ac_word_re([\t (]|\$)/ { + line = \$ 0 + split(line, arg, " ") + if (arg[1] == "#") { + defundef = arg[2] + mac1 = arg[3] + } else { + defundef = substr(arg[1], 2) + mac1 = arg[2] + } + split(mac1, mac2, "(") #) + macro = mac2[1] + prefix = substr(line, 1, index(line, defundef) - 1) + if (D_is_set[macro]) { + # Preserve the white space surrounding the "#". + print prefix "define", macro P[macro] D[macro] + next + } else { + # Replace #undef with comments. This is necessary, for example, + # in the case of _POSIX_SOURCE, which is predefined and required + # on some systems where configure will not decide to define it. + if (defundef == "undef") { + print "/*", prefix defundef, macro, "*/" + next + } + } +} +{ print } +_ACAWK +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 + as_fn_error $? "could not setup config headers machinery" "$LINENO" 5 +fi # test -n "$CONFIG_HEADERS" + + +eval set X " :F $CONFIG_FILES :H $CONFIG_HEADERS :C $CONFIG_COMMANDS" +shift +for ac_tag +do + case $ac_tag in + :[FHLC]) ac_mode=$ac_tag; continue;; + esac + case $ac_mode$ac_tag in + :[FHL]*:*);; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; + :[FH]-) ac_tag=-:-;; + :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; + esac + ac_save_IFS=$IFS + IFS=: + set x $ac_tag + IFS=$ac_save_IFS + shift + ac_file=$1 + shift + + case $ac_mode in + :L) ac_source=$1;; + :[FH]) + ac_file_inputs= + for ac_f + do + case $ac_f in + -) ac_f="$ac_tmp/stdin";; + *) # Look for the file first in the build tree, then in the source tree + # (if the path is not absolute). The absolute path cannot be DOS-style, + # because $ac_f cannot contain `:'. + test -f "$ac_f" || + case $ac_f in + [\\/$]*) false;; + *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; + esac || + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; + esac + case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac + as_fn_append ac_file_inputs " '$ac_f'" + done + + # Let's still pretend it is `configure' which instantiates (i.e., don't + # use $as_me), people would be surprised to read: + # /* config.h. Generated by config.status. */ + configure_input='Generated from '` + $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' + `' by configure.' + if test x"$ac_file" != x-; then + configure_input="$ac_file. $configure_input" + { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 +$as_echo "$as_me: creating $ac_file" >&6;} + fi + # Neutralize special characters interpreted by sed in replacement strings. + case $configure_input in #( + *\&* | *\|* | *\\* ) + ac_sed_conf_input=`$as_echo "$configure_input" | + sed 's/[\\\\&|]/\\\\&/g'`;; #( + *) ac_sed_conf_input=$configure_input;; + esac + + case $ac_tag in + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + esac + ;; + esac + + ac_dir=`$as_dirname -- "$ac_file" || +$as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$ac_file" : 'X\(//\)[^/]' \| \ + X"$ac_file" : 'X\(//\)$' \| \ + X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$ac_file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir="$ac_dir"; as_fn_mkdir_p + ac_builddir=. + +case "$ac_dir" in +.) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; +*) + ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` + # A ".." for each directory in $ac_dir_suffix. + ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` + case $ac_top_builddir_sub in + "") ac_top_builddir_sub=. ac_top_build_prefix= ;; + *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; + esac ;; +esac +ac_abs_top_builddir=$ac_pwd +ac_abs_builddir=$ac_pwd$ac_dir_suffix +# for backward compatibility: +ac_top_builddir=$ac_top_build_prefix + +case $srcdir in + .) # We are building in place. + ac_srcdir=. + ac_top_srcdir=$ac_top_builddir_sub + ac_abs_top_srcdir=$ac_pwd ;; + [\\/]* | ?:[\\/]* ) # Absolute name. + ac_srcdir=$srcdir$ac_dir_suffix; + ac_top_srcdir=$srcdir + ac_abs_top_srcdir=$srcdir ;; + *) # Relative name. + ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix + ac_top_srcdir=$ac_top_build_prefix$srcdir + ac_abs_top_srcdir=$ac_pwd/$srcdir ;; +esac +ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix + + + case $ac_mode in + :F) + # + # CONFIG_FILE + # + + case $INSTALL in + [\\/$]* | ?:[\\/]* ) ac_INSTALL=$INSTALL ;; + *) ac_INSTALL=$ac_top_build_prefix$INSTALL ;; + esac + ac_MKDIR_P=$MKDIR_P + case $MKDIR_P in + [\\/$]* | ?:[\\/]* ) ;; + */*) ac_MKDIR_P=$ac_top_build_prefix$MKDIR_P ;; + esac +_ACEOF + +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +# If the template does not know about datarootdir, expand it. +# FIXME: This hack should be removed a few years after 2.60. +ac_datarootdir_hack=; ac_datarootdir_seen= +ac_sed_dataroot=' +/datarootdir/ { + p + q +} +/@datadir@/p +/@docdir@/p +/@infodir@/p +/@localedir@/p +/@mandir@/p' +case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in +*datarootdir*) ac_datarootdir_seen=yes;; +*@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 +$as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} +_ACEOF +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 + ac_datarootdir_hack=' + s&@datadir@&$datadir&g + s&@docdir@&$docdir&g + s&@infodir@&$infodir&g + s&@localedir@&$localedir&g + s&@mandir@&$mandir&g + s&\\\${datarootdir}&$datarootdir&g' ;; +esac +_ACEOF + +# Neutralize VPATH when `$srcdir' = `.'. +# Shell code in configure.ac might set extrasub. +# FIXME: do we really want to maintain this feature? +cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 +ac_sed_extra="$ac_vpsub +$extrasub +_ACEOF +cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 +:t +/@[a-zA-Z_][a-zA-Z_0-9]*@/!b +s|@configure_input@|$ac_sed_conf_input|;t t +s&@top_builddir@&$ac_top_builddir_sub&;t t +s&@top_build_prefix@&$ac_top_build_prefix&;t t +s&@srcdir@&$ac_srcdir&;t t +s&@abs_srcdir@&$ac_abs_srcdir&;t t +s&@top_srcdir@&$ac_top_srcdir&;t t +s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t +s&@builddir@&$ac_builddir&;t t +s&@abs_builddir@&$ac_abs_builddir&;t t +s&@abs_top_builddir@&$ac_abs_top_builddir&;t t +s&@INSTALL@&$ac_INSTALL&;t t +s&@MKDIR_P@&$ac_MKDIR_P&;t t +$ac_datarootdir_hack +" +eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + +test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&5 +$as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' +which seems to be undefined. Please make sure it is defined" >&2;} + + rm -f "$ac_tmp/stdin" + case $ac_file in + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; + esac \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + ;; + :H) + # + # CONFIG_HEADER + # + if test x"$ac_file" != x-; then + { + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then + { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 +$as_echo "$as_me: $ac_file is unchanged" >&6;} + else + rm -f "$ac_file" + mv "$ac_tmp/config.h" "$ac_file" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + fi + else + $as_echo "/* $configure_input */" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ + || as_fn_error $? "could not create -" "$LINENO" 5 + fi +# Compute "$ac_file"'s index in $config_headers. +_am_arg="$ac_file" +_am_stamp_count=1 +for _am_header in $config_headers :; do + case $_am_header in + $_am_arg | $_am_arg:* ) + break ;; + * ) + _am_stamp_count=`expr $_am_stamp_count + 1` ;; + esac +done +echo "timestamp for $_am_arg" >`$as_dirname -- "$_am_arg" || +$as_expr X"$_am_arg" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$_am_arg" : 'X\(//\)[^/]' \| \ + X"$_am_arg" : 'X\(//\)$' \| \ + X"$_am_arg" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$_am_arg" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'`/stamp-h$_am_stamp_count + ;; + + :C) { $as_echo "$as_me:${as_lineno-$LINENO}: executing $ac_file commands" >&5 +$as_echo "$as_me: executing $ac_file commands" >&6;} + ;; + esac + + + case $ac_file$ac_mode in + "depfiles":C) test x"$AMDEP_TRUE" != x"" || { + # Older Autoconf quotes --file arguments for eval, but not when files + # are listed without --file. Let's play safe and only enable the eval + # if we detect the quoting. + case $CONFIG_FILES in + *\'*) eval set x "$CONFIG_FILES" ;; + *) set x $CONFIG_FILES ;; + esac + shift + for mf + do + # Strip MF so we end up with the name of the file. + mf=`echo "$mf" | sed -e 's/:.*$//'` + # Check whether this is an Automake generated Makefile or not. + # We used to match only the files named 'Makefile.in', but + # some people rename them; so instead we look at the file content. + # Grep'ing the first line is not enough: some people post-process + # each Makefile.in and add a new line on top of each file to say so. + # Grep'ing the whole file is not good either: AIX grep has a line + # limit of 2048, but all sed's we know have understand at least 4000. + if sed -n 's,^#.*generated by automake.*,X,p' "$mf" | grep X >/dev/null 2>&1; then + dirpart=`$as_dirname -- "$mf" || +$as_expr X"$mf" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$mf" : 'X\(//\)[^/]' \| \ + X"$mf" : 'X\(//\)$' \| \ + X"$mf" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$mf" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + else + continue + fi + # Extract the definition of DEPDIR, am__include, and am__quote + # from the Makefile without running 'make'. + DEPDIR=`sed -n 's/^DEPDIR = //p' < "$mf"` + test -z "$DEPDIR" && continue + am__include=`sed -n 's/^am__include = //p' < "$mf"` + test -z "$am__include" && continue + am__quote=`sed -n 's/^am__quote = //p' < "$mf"` + # Find all dependency output files, they are included files with + # $(DEPDIR) in their names. We invoke sed twice because it is the + # simplest approach to changing $(DEPDIR) to its actual value in the + # expansion. + for file in `sed -n " + s/^$am__include $am__quote\(.*(DEPDIR).*\)$am__quote"'$/\1/p' <"$mf" | \ + sed -e 's/\$(DEPDIR)/'"$DEPDIR"'/g'`; do + # Make sure the directory exists. + test -f "$dirpart/$file" && continue + fdir=`$as_dirname -- "$file" || +$as_expr X"$file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$file" : 'X\(//\)[^/]' \| \ + X"$file" : 'X\(//\)$' \| \ + X"$file" : 'X\(/\)' \| . 2>/dev/null || +$as_echo X"$file" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q'` + as_dir=$dirpart/$fdir; as_fn_mkdir_p + # echo "creating $dirpart/$file" + echo '# dummy' > "$dirpart/$file" + done + done +} + ;; + + esac +done # for ac_tag + + +as_fn_exit 0 +_ACEOF +ac_clean_files=$ac_clean_files_save + +test $ac_write_fail = 0 || + as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 + + +# configure is writing to config.log, and then calls config.status. +# config.status does its own redirection, appending to config.log. +# Unfortunately, on DOS this fails, as config.log is still kept open +# by configure, so config.status won't be able to write to it; its +# output is simply discarded. So we exec the FD to /dev/null, +# effectively closing config.log, so it can be properly (re)opened and +# appended to by config.status. When coming back to configure, we +# need to make the FD available again. +if test "$no_create" != yes; then + ac_cs_success=: + ac_config_status_args= + test "$silent" = yes && + ac_config_status_args="$ac_config_status_args --quiet" + exec 5>/dev/null + $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false + exec 5>>config.log + # Use ||, not &&, to avoid exiting from the if with $? = 1, which + # would make configure fail if this is the last instruction. + $ac_cs_success || as_fn_exit 1 +fi +if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then + { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 +$as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} +fi + diff --git a/configure.ac b/configure.ac new file mode 100644 index 0000000..0d64c0c --- /dev/null +++ b/configure.ac @@ -0,0 +1,274 @@ +# -*- Autoconf -*- +# Process this file with autoconf to produce a configure script. +AC_PREREQ([2.69]) +AC_INIT([vlm], [0.99-1], [joachimq@achemich.de]) +AM_INIT_AUTOMAKE +#AC_CONFIG_SRCDIR([include/VLM_configuration.h]) +AC_CONFIG_HEADERS([config.h]) +# Checks for programs. +AC_PROG_CC +AC_PROG_CC_STDC +AC_PROG_RANLIB +#AC_PROG_CLISP +AC_PROG_INSTALL +AM_PROG_CC_C_O +if test -z $GCC; then + AC_MSG_ERROR([you probably need a gnu c (gcc) compiler to compile the vlm]) +fi + +AC_CHECK_SIZEOF([int *]) +if test $ac_cv_sizeof_int_p -ne 8 ; then + AC_MSG_ERROR([you need a 64-bit environment to compile the vlm]) +fi +# Checks for libraries. +AC_CHECK_LIB([X11], [XKeysymToKeycode],[], + [AC_MSG_ERROR([you need libX11 to compile the vlm])]) +# even if libxcb is found, don't link to it - not needed +# so, give AC_CHECK_LIB a null cmd for action-if-found +AC_CHECK_LIB([xcb], [xcb_disconnect],[:]) +AC_CHECK_LIB([c], [fprintf],[], + [AC_MSG_ERROR([you need libc to compile the vlm])]) +AC_CHECK_LIB([crypt], [encrypt],[], + [AC_MSG_ERROR([you need libcrypt to compile the vlm])]) +AC_CHECK_LIB([dl], [dlopen],[], + [AC_MSG_ERROR([you need libdl to compile the vlm])]) +AC_CHECK_LIB([m], [floor],[], + [AC_MSG_ERROR([you need libm to compile the vlm])]) +ACX_PTHREAD([], + [AC_MSG_ERROR([you need pthreads to compile the vlm])]) +AC_CHECK_LIB([pthread], [pthread_cancel],[], + [AC_MSG_ERROR([you need libpthread to compile the vlm])]) +# need clisp +AC_PATH_PROGS([CLISP],[clisp]) +if test -z "$CLISP" || test "X$CLISP" = "Xno"; then + AC_MSG_WARN([clisp has not been detected on your system. + You won't be able to (re)generate stub/*.c files + from alpha-emulator/*.as and ...*.lisp files]) +fi +AM_CONDITIONAL([HCLISP], [test "x$CLISP" != x]) + +# Checks for header files. +AC_PATH_X +AC_CHECK_HEADERS([arpa/inet.h fcntl.h fenv.h limits.h malloc.h netdb.h netinet/in.h nlist.h paths.h stddef.h stdint.h stdlib.h string.h sys/file.h sys/ioctl.h sys/param.h sys/socket.h sys/time.h unistd.h utmp.h]) + +AC_CHECK_HEADERS([X11/Xlib-xcb.h],[], + [AC_MSG_ERROR([you need X11/Xlib-xcb.h to compile the vlm])]) +AC_CHECK_HEADERS([dlfcn.h],[], + [AC_MSG_ERROR([you need dlfcn.h to compile the vlm])]) + +# Checks for typedefs, structures, and compiler characteristics. +AC_CHECK_HEADER_STDBOOL +AC_C_INLINE +AC_TYPE_INT16_T +AC_TYPE_INT32_T +AC_TYPE_INT64_T +AC_TYPE_INT8_T +AC_TYPE_OFF_T +AC_TYPE_SIZE_T +AC_TYPE_SSIZE_T +AC_TYPE_UINT16_T +AC_TYPE_UINT32_T +AC_TYPE_UINT64_T +AC_TYPE_UINT8_T +AC_CHECK_TYPES([ptrdiff_t]) +AC_CHECK_TYPES([ucontext_t],[], [], [[#include ]]) + +# Checks for library functions. +AC_FUNC_MALLOC +AC_FUNC_MMAP +AC_FUNC_REALLOC +AC_CHECK_FUNCS([alarm atexit clock_gettime floor ftruncate getcwd gethostbyaddr gethostbyname gethostname getpagesize gettimeofday inet_ntoa memchr memmove memset munmap rint socket stpcpy strchr strdup strerror strndup strrchr strtoul uname strncasecmp]) + +AC_ARG_ENABLE([debug], + AS_HELP_STRING([--enable-debug], + [enable debuggeable code (-g2) (default=no)]), + [], + [enable_debug=no]) +if ! test -z $enable_debug && + test "x$enable_debug" = "xyes" +then + AS_ECHO(["enabling debugging"]) + AX_CFLAGS_GCC_OPTION(-g2) +else + AS_ECHO(["disabling debugging"]) + AX_CFLAGS_GCC_OPTION(-g0) +fi + +AC_ARG_ENABLE([fast], + AS_HELP_STRING([--disable-fast], + [disable optimization for speed (default=no)]), + [], + [enable_fast=yes]) +if ! test -z $enable_fast && + test "x$enable_fast" = "xno" +then + AS_ECHO(["disabling optimization for speed"]) + AX_CFLAGS_GCC_OPTION(-O2) +else + AS_ECHO(["enabling optimization for speed"]) + AX_CFLAGS_GCC_OPTION(-Ofast) +fi + +AX_CFLAGS_GCC_OPTION(-rdynamic) +AX_CFLAGS_GCC_OPTION(-fno-strict-aliasing) +AX_CFLAGS_GCC_OPTION(-march=native) +AX_CFLAGS_GCC_OPTION(-Wall) + +AC_ARG_ENABLE([genera], + AS_HELP_STRING([--enable-genera], + [enable compilation for genera (default=yes)]), + [], + [enable_genera=yes]) +if ! test -z $enable_genera && + test "x$enable_genera" = "xno" +then + AS_ECHO(["disabling compilation for genera"]) +else + AS_ECHO(["enabling compilation for genera"]) + CPPFLAGS+=" -DGENERA -DAUTOSTART" +fi + +AC_ARG_ENABLE([debug-disk], + AS_HELP_STRING([--enable-debug-disk], + [enable disk debugging (default=no)]), + [], + [enable_debug_disk=no]) +if test ! -z $enable_debug_disk && + test "x$enable_debug_disk" = "xyes" +then + AS_ECHO("enabling disk debugging") + CPPFLAGS+=" -DDEBUG_DISK" +else + AS_ECHO("disabling disk debugging") +fi + +AC_ARG_ENABLE([debug-network], + AS_HELP_STRING([--enable-debug-network], + [enable network debugging (default=no)]), + [], + [enable_debug_network=no]) +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + AS_ECHO(["enabling network debugging"]) + CPPFLAGS+=" -DDEBUG_NETWORK=1" +else + AS_ECHO(["disabling network debugging"]) +fi + +AC_ARG_ENABLE([debug-network-ip], + AS_HELP_STRING([--enable-debug-network-ip], + [enable IP network debugging (default=no)]), + [], + [enable_debug_network_ip=no]) +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_ip && + test "x$enable_debug_network_ip" = "xyes" + then + AS_ECHO(["enabling IP network debugging"]) + CPPFLAGS+=" -DDEBUG_IP=1" + else + AS_ECHO(["disabling IP network debugging"]) + fi +else + if ! test -z $enable_debug_network_ip && + test "x$enable_debug_network_ip" = "xyes" + then + AC_MSG_WARN([enabling IP network debugging has no effect if network debugging is disabled]) + fi +fi + +AC_ARG_ENABLE([debug-network-chaos], + AS_HELP_STRING([--enable-debug-network-chaos], + [enable CHAOS network debugging (default=no)]), + [], + [enable_debug_network_chaos=no]) +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_chaos && + test "x$enable_debug_network_chaos" = "xyes" + then + AS_ECHO(["enabling CHAOS network debugging"]) + CPPFLAGS+=" -DDEBUG_CHAOS=1" + else + AS_ECHO(["disabling CHAOS network debugging"]) + fi +else + if ! test -z $enable_debug_network_chaos && + test "x$enable_debug_network_chaos" = "xyes" + then + AC_MSG_WARN([enabling CHAOS network debugging has no effect if network debugging is disabled]) + fi +fi + +AC_ARG_ENABLE([debug-network-arp], + AS_HELP_STRING([--enable-debug-network-arp], + [enable ARP network debugging (default=no)]), + [], + [enable_debug_network_arp=no]) +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_arp && + test "x$enable_debug_network_arp" = "xyes" + then + AS_ECHO(["enabling ARP network debugging"]) + CPPFLAGS+=" -DDEBUG_ARP=1" + else + AS_ECHO(["disabling ARP network debugging"]) + fi +else + if ! test -z $enable_debug_network_arp && + test "x$enable_debug_network_arp" = "xyes" + then + AC_MSG_WARN([enabling ARP network debugging has no effect if network debugging is disabled]) + fi +fi + +AC_ARG_ENABLE([debug-network-icmp], + AS_HELP_STRING([--enable-debug-network-icmp], + [enable ICMP network debugging (default=no)]), + [], + [enable_debug_network_icmp=no]) +if ! test -z $enable_debug_network && + test "x$enable_debug_network" = "xyes" +then + if ! test -z $enable_debug_network_icmp && + test "x$enable_debug_network_icmp" = "xyes" + then + AC_MSG_WARN([enabling IP network debugging to enable ICMP debugging]) + AS_ECHO(["enabling ICMP network debugging"]) + CPPFLAGS+=" -DDEBUG_IP -DDEBUG_ICMP=1" + else + AS_ECHO(["disabling ICMP network debugging"]) + fi +else + if ! test -z $enable_debug_network_icmp && + test "x$enable_debug_network_icmp" = "xyes" + then + AC_MSG_WARN([enabling ICMP network debugging has no effect if network debugging is disabled]) + fi +fi + +AC_ARG_WITH(tap, + AS_HELP_STRING([--with-tap], [use tap network interface (default=yes)]), + [], + [with_tap=yes]) +if test ! -z $with_tap && test "x$with_tap" = "xyes" +then + AS_ECHO(["using tap network interface"]) + CPPFLAGS+=" -DUSE_TAP" +else + AS_ECHO(["using tun network interface"]) + CPPFLAGS+=" -DUSE_TUN" +fi + +AC_CONFIG_FILES([Makefile + src/Makefile + emulator/Makefile + life-support/Makefile + stub/Makefile]) +AC_OUTPUT diff --git a/depcomp b/depcomp new file mode 100755 index 0000000..4ebd5b3 --- /dev/null +++ b/depcomp @@ -0,0 +1,791 @@ +#! /bin/sh +# depcomp - compile a program generating dependencies as side-effects + +scriptversion=2013-05-30.07; # UTC + +# Copyright (C) 1999-2013 Free Software Foundation, Inc. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +# Originally written by Alexandre Oliva . + +case $1 in + '') + echo "$0: No command. Try '$0 --help' for more information." 1>&2 + exit 1; + ;; + -h | --h*) + cat <<\EOF +Usage: depcomp [--help] [--version] PROGRAM [ARGS] + +Run PROGRAMS ARGS to compile a file, generating dependencies +as side-effects. + +Environment variables: + depmode Dependency tracking mode. + source Source file read by 'PROGRAMS ARGS'. + object Object file output by 'PROGRAMS ARGS'. + DEPDIR directory where to store dependencies. + depfile Dependency file to output. + tmpdepfile Temporary file to use when outputting dependencies. + libtool Whether libtool is used (yes/no). + +Report bugs to . +EOF + exit $? + ;; + -v | --v*) + echo "depcomp $scriptversion" + exit $? + ;; +esac + +# Get the directory component of the given path, and save it in the +# global variables '$dir'. Note that this directory component will +# be either empty or ending with a '/' character. This is deliberate. +set_dir_from () +{ + case $1 in + */*) dir=`echo "$1" | sed -e 's|/[^/]*$|/|'`;; + *) dir=;; + esac +} + +# Get the suffix-stripped basename of the given path, and save it the +# global variable '$base'. +set_base_from () +{ + base=`echo "$1" | sed -e 's|^.*/||' -e 's/\.[^.]*$//'` +} + +# If no dependency file was actually created by the compiler invocation, +# we still have to create a dummy depfile, to avoid errors with the +# Makefile "include basename.Plo" scheme. +make_dummy_depfile () +{ + echo "#dummy" > "$depfile" +} + +# Factor out some common post-processing of the generated depfile. +# Requires the auxiliary global variable '$tmpdepfile' to be set. +aix_post_process_depfile () +{ + # If the compiler actually managed to produce a dependency file, + # post-process it. + if test -f "$tmpdepfile"; then + # Each line is of the form 'foo.o: dependency.h'. + # Do two passes, one to just change these to + # $object: dependency.h + # and one to simply output + # dependency.h: + # which is needed to avoid the deleted-header problem. + { sed -e "s,^.*\.[$lower]*:,$object:," < "$tmpdepfile" + sed -e "s,^.*\.[$lower]*:[$tab ]*,," -e 's,$,:,' < "$tmpdepfile" + } > "$depfile" + rm -f "$tmpdepfile" + else + make_dummy_depfile + fi +} + +# A tabulation character. +tab=' ' +# A newline character. +nl=' +' +# Character ranges might be problematic outside the C locale. +# These definitions help. +upper=ABCDEFGHIJKLMNOPQRSTUVWXYZ +lower=abcdefghijklmnopqrstuvwxyz +digits=0123456789 +alpha=${upper}${lower} + +if test -z "$depmode" || test -z "$source" || test -z "$object"; then + echo "depcomp: Variables source, object and depmode must be set" 1>&2 + exit 1 +fi + +# Dependencies for sub/bar.o or sub/bar.obj go into sub/.deps/bar.Po. +depfile=${depfile-`echo "$object" | + sed 's|[^\\/]*$|'${DEPDIR-.deps}'/&|;s|\.\([^.]*\)$|.P\1|;s|Pobj$|Po|'`} +tmpdepfile=${tmpdepfile-`echo "$depfile" | sed 's/\.\([^.]*\)$/.T\1/'`} + +rm -f "$tmpdepfile" + +# Avoid interferences from the environment. +gccflag= dashmflag= + +# Some modes work just like other modes, but use different flags. We +# parameterize here, but still list the modes in the big case below, +# to make depend.m4 easier to write. Note that we *cannot* use a case +# here, because this file can only contain one case statement. +if test "$depmode" = hp; then + # HP compiler uses -M and no extra arg. + gccflag=-M + depmode=gcc +fi + +if test "$depmode" = dashXmstdout; then + # This is just like dashmstdout with a different argument. + dashmflag=-xM + depmode=dashmstdout +fi + +cygpath_u="cygpath -u -f -" +if test "$depmode" = msvcmsys; then + # This is just like msvisualcpp but w/o cygpath translation. + # Just convert the backslash-escaped backslashes to single forward + # slashes to satisfy depend.m4 + cygpath_u='sed s,\\\\,/,g' + depmode=msvisualcpp +fi + +if test "$depmode" = msvc7msys; then + # This is just like msvc7 but w/o cygpath translation. + # Just convert the backslash-escaped backslashes to single forward + # slashes to satisfy depend.m4 + cygpath_u='sed s,\\\\,/,g' + depmode=msvc7 +fi + +if test "$depmode" = xlc; then + # IBM C/C++ Compilers xlc/xlC can output gcc-like dependency information. + gccflag=-qmakedep=gcc,-MF + depmode=gcc +fi + +case "$depmode" in +gcc3) +## gcc 3 implements dependency tracking that does exactly what +## we want. Yay! Note: for some reason libtool 1.4 doesn't like +## it if -MD -MP comes after the -MF stuff. Hmm. +## Unfortunately, FreeBSD c89 acceptance of flags depends upon +## the command line argument order; so add the flags where they +## appear in depend2.am. Note that the slowdown incurred here +## affects only configure: in makefiles, %FASTDEP% shortcuts this. + for arg + do + case $arg in + -c) set fnord "$@" -MT "$object" -MD -MP -MF "$tmpdepfile" "$arg" ;; + *) set fnord "$@" "$arg" ;; + esac + shift # fnord + shift # $arg + done + "$@" + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + mv "$tmpdepfile" "$depfile" + ;; + +gcc) +## Note that this doesn't just cater to obsosete pre-3.x GCC compilers. +## but also to in-use compilers like IMB xlc/xlC and the HP C compiler. +## (see the conditional assignment to $gccflag above). +## There are various ways to get dependency output from gcc. Here's +## why we pick this rather obscure method: +## - Don't want to use -MD because we'd like the dependencies to end +## up in a subdir. Having to rename by hand is ugly. +## (We might end up doing this anyway to support other compilers.) +## - The DEPENDENCIES_OUTPUT environment variable makes gcc act like +## -MM, not -M (despite what the docs say). Also, it might not be +## supported by the other compilers which use the 'gcc' depmode. +## - Using -M directly means running the compiler twice (even worse +## than renaming). + if test -z "$gccflag"; then + gccflag=-MD, + fi + "$@" -Wp,"$gccflag$tmpdepfile" + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + echo "$object : \\" > "$depfile" + # The second -e expression handles DOS-style file names with drive + # letters. + sed -e 's/^[^:]*: / /' \ + -e 's/^['$alpha']:\/[^:]*: / /' < "$tmpdepfile" >> "$depfile" +## This next piece of magic avoids the "deleted header file" problem. +## The problem is that when a header file which appears in a .P file +## is deleted, the dependency causes make to die (because there is +## typically no way to rebuild the header). We avoid this by adding +## dummy dependencies for each header file. Too bad gcc doesn't do +## this for us directly. +## Some versions of gcc put a space before the ':'. On the theory +## that the space means something, we add a space to the output as +## well. hp depmode also adds that space, but also prefixes the VPATH +## to the object. Take care to not repeat it in the output. +## Some versions of the HPUX 10.20 sed can't process this invocation +## correctly. Breaking it into two sed invocations is a workaround. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^\\$//' -e '/^$/d' -e "s|.*$object$||" -e '/:$/d' \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +hp) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +sgi) + if test "$libtool" = yes; then + "$@" "-Wp,-MDupdate,$tmpdepfile" + else + "$@" -MDupdate "$tmpdepfile" + fi + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + + if test -f "$tmpdepfile"; then # yes, the sourcefile depend on other files + echo "$object : \\" > "$depfile" + # Clip off the initial element (the dependent). Don't try to be + # clever and replace this with sed code, as IRIX sed won't handle + # lines with more than a fixed number of characters (4096 in + # IRIX 6.2 sed, 8192 in IRIX 6.5). We also remove comment lines; + # the IRIX cc adds comments like '#:fec' to the end of the + # dependency line. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' \ + | tr "$nl" ' ' >> "$depfile" + echo >> "$depfile" + # The second pass generates a dummy entry for each header file. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^.*\.o://' -e 's/#.*$//' -e '/^$/ d' -e 's/$/:/' \ + >> "$depfile" + else + make_dummy_depfile + fi + rm -f "$tmpdepfile" + ;; + +xlc) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +aix) + # The C for AIX Compiler uses -M and outputs the dependencies + # in a .u file. In older versions, this file always lives in the + # current directory. Also, the AIX compiler puts '$object:' at the + # start of each line; $object doesn't have directory information. + # Version 6 uses the directory in both cases. + set_dir_from "$object" + set_base_from "$object" + if test "$libtool" = yes; then + tmpdepfile1=$dir$base.u + tmpdepfile2=$base.u + tmpdepfile3=$dir.libs/$base.u + "$@" -Wc,-M + else + tmpdepfile1=$dir$base.u + tmpdepfile2=$dir$base.u + tmpdepfile3=$dir$base.u + "$@" -M + fi + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + exit $stat + fi + + for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + do + test -f "$tmpdepfile" && break + done + aix_post_process_depfile + ;; + +tcc) + # tcc (Tiny C Compiler) understand '-MD -MF file' since version 0.9.26 + # FIXME: That version still under development at the moment of writing. + # Make that this statement remains true also for stable, released + # versions. + # It will wrap lines (doesn't matter whether long or short) with a + # trailing '\', as in: + # + # foo.o : \ + # foo.c \ + # foo.h \ + # + # It will put a trailing '\' even on the last line, and will use leading + # spaces rather than leading tabs (at least since its commit 0394caf7 + # "Emit spaces for -MD"). + "$@" -MD -MF "$tmpdepfile" + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + # Each non-empty line is of the form 'foo.o : \' or ' dep.h \'. + # We have to change lines of the first kind to '$object: \'. + sed -e "s|.*:|$object :|" < "$tmpdepfile" > "$depfile" + # And for each line of the second kind, we have to emit a 'dep.h:' + # dummy dependency, to avoid the deleted-header problem. + sed -n -e 's|^ *\(.*\) *\\$|\1:|p' < "$tmpdepfile" >> "$depfile" + rm -f "$tmpdepfile" + ;; + +## The order of this option in the case statement is important, since the +## shell code in configure will try each of these formats in the order +## listed in this file. A plain '-MD' option would be understood by many +## compilers, so we must ensure this comes after the gcc and icc options. +pgcc) + # Portland's C compiler understands '-MD'. + # Will always output deps to 'file.d' where file is the root name of the + # source file under compilation, even if file resides in a subdirectory. + # The object file name does not affect the name of the '.d' file. + # pgcc 10.2 will output + # foo.o: sub/foo.c sub/foo.h + # and will wrap long lines using '\' : + # foo.o: sub/foo.c ... \ + # sub/foo.h ... \ + # ... + set_dir_from "$object" + # Use the source, not the object, to determine the base name, since + # that's sadly what pgcc will do too. + set_base_from "$source" + tmpdepfile=$base.d + + # For projects that build the same source file twice into different object + # files, the pgcc approach of using the *source* file root name can cause + # problems in parallel builds. Use a locking strategy to avoid stomping on + # the same $tmpdepfile. + lockdir=$base.d-lock + trap " + echo '$0: caught signal, cleaning up...' >&2 + rmdir '$lockdir' + exit 1 + " 1 2 13 15 + numtries=100 + i=$numtries + while test $i -gt 0; do + # mkdir is a portable test-and-set. + if mkdir "$lockdir" 2>/dev/null; then + # This process acquired the lock. + "$@" -MD + stat=$? + # Release the lock. + rmdir "$lockdir" + break + else + # If the lock is being held by a different process, wait + # until the winning process is done or we timeout. + while test -d "$lockdir" && test $i -gt 0; do + sleep 1 + i=`expr $i - 1` + done + fi + i=`expr $i - 1` + done + trap - 1 2 13 15 + if test $i -le 0; then + echo "$0: failed to acquire lock after $numtries attempts" >&2 + echo "$0: check lockdir '$lockdir'" >&2 + exit 1 + fi + + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + # Each line is of the form `foo.o: dependent.h', + # or `foo.o: dep1.h dep2.h \', or ` dep3.h dep4.h \'. + # Do two passes, one to just change these to + # `$object: dependent.h' and one to simply `dependent.h:'. + sed "s,^[^:]*:,$object :," < "$tmpdepfile" > "$depfile" + # Some versions of the HPUX 10.20 sed can't process this invocation + # correctly. Breaking it into two sed invocations is a workaround. + sed 's,^[^:]*: \(.*\)$,\1,;s/^\\$//;/^$/d;/:$/d' < "$tmpdepfile" \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +hp2) + # The "hp" stanza above does not work with aCC (C++) and HP's ia64 + # compilers, which have integrated preprocessors. The correct option + # to use with these is +Maked; it writes dependencies to a file named + # 'foo.d', which lands next to the object file, wherever that + # happens to be. + # Much of this is similar to the tru64 case; see comments there. + set_dir_from "$object" + set_base_from "$object" + if test "$libtool" = yes; then + tmpdepfile1=$dir$base.d + tmpdepfile2=$dir.libs/$base.d + "$@" -Wc,+Maked + else + tmpdepfile1=$dir$base.d + tmpdepfile2=$dir$base.d + "$@" +Maked + fi + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile1" "$tmpdepfile2" + exit $stat + fi + + for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" + do + test -f "$tmpdepfile" && break + done + if test -f "$tmpdepfile"; then + sed -e "s,^.*\.[$lower]*:,$object:," "$tmpdepfile" > "$depfile" + # Add 'dependent.h:' lines. + sed -ne '2,${ + s/^ *// + s/ \\*$// + s/$/:/ + p + }' "$tmpdepfile" >> "$depfile" + else + make_dummy_depfile + fi + rm -f "$tmpdepfile" "$tmpdepfile2" + ;; + +tru64) + # The Tru64 compiler uses -MD to generate dependencies as a side + # effect. 'cc -MD -o foo.o ...' puts the dependencies into 'foo.o.d'. + # At least on Alpha/Redhat 6.1, Compaq CCC V6.2-504 seems to put + # dependencies in 'foo.d' instead, so we check for that too. + # Subdirectories are respected. + set_dir_from "$object" + set_base_from "$object" + + if test "$libtool" = yes; then + # Libtool generates 2 separate objects for the 2 libraries. These + # two compilations output dependencies in $dir.libs/$base.o.d and + # in $dir$base.o.d. We have to check for both files, because + # one of the two compilations can be disabled. We should prefer + # $dir$base.o.d over $dir.libs/$base.o.d because the latter is + # automatically cleaned when .libs/ is deleted, while ignoring + # the former would cause a distcleancheck panic. + tmpdepfile1=$dir$base.o.d # libtool 1.5 + tmpdepfile2=$dir.libs/$base.o.d # Likewise. + tmpdepfile3=$dir.libs/$base.d # Compaq CCC V6.2-504 + "$@" -Wc,-MD + else + tmpdepfile1=$dir$base.d + tmpdepfile2=$dir$base.d + tmpdepfile3=$dir$base.d + "$@" -MD + fi + + stat=$? + if test $stat -ne 0; then + rm -f "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + exit $stat + fi + + for tmpdepfile in "$tmpdepfile1" "$tmpdepfile2" "$tmpdepfile3" + do + test -f "$tmpdepfile" && break + done + # Same post-processing that is required for AIX mode. + aix_post_process_depfile + ;; + +msvc7) + if test "$libtool" = yes; then + showIncludes=-Wc,-showIncludes + else + showIncludes=-showIncludes + fi + "$@" $showIncludes > "$tmpdepfile" + stat=$? + grep -v '^Note: including file: ' "$tmpdepfile" + if test $stat -ne 0; then + rm -f "$tmpdepfile" + exit $stat + fi + rm -f "$depfile" + echo "$object : \\" > "$depfile" + # The first sed program below extracts the file names and escapes + # backslashes for cygpath. The second sed program outputs the file + # name when reading, but also accumulates all include files in the + # hold buffer in order to output them again at the end. This only + # works with sed implementations that can handle large buffers. + sed < "$tmpdepfile" -n ' +/^Note: including file: *\(.*\)/ { + s//\1/ + s/\\/\\\\/g + p +}' | $cygpath_u | sort -u | sed -n ' +s/ /\\ /g +s/\(.*\)/'"$tab"'\1 \\/p +s/.\(.*\) \\/\1:/ +H +$ { + s/.*/'"$tab"'/ + G + p +}' >> "$depfile" + echo >> "$depfile" # make sure the fragment doesn't end with a backslash + rm -f "$tmpdepfile" + ;; + +msvc7msys) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +#nosideeffect) + # This comment above is used by automake to tell side-effect + # dependency tracking mechanisms from slower ones. + +dashmstdout) + # Important note: in order to support this mode, a compiler *must* + # always write the preprocessed file to stdout, regardless of -o. + "$@" || exit $? + + # Remove the call to Libtool. + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + + # Remove '-o $object'. + IFS=" " + for arg + do + case $arg in + -o) + shift + ;; + $object) + shift + ;; + *) + set fnord "$@" "$arg" + shift # fnord + shift # $arg + ;; + esac + done + + test -z "$dashmflag" && dashmflag=-M + # Require at least two characters before searching for ':' + # in the target name. This is to cope with DOS-style filenames: + # a dependency such as 'c:/foo/bar' could be seen as target 'c' otherwise. + "$@" $dashmflag | + sed "s|^[$tab ]*[^:$tab ][^:][^:]*:[$tab ]*|$object: |" > "$tmpdepfile" + rm -f "$depfile" + cat < "$tmpdepfile" > "$depfile" + # Some versions of the HPUX 10.20 sed can't process this sed invocation + # correctly. Breaking it into two sed invocations is a workaround. + tr ' ' "$nl" < "$tmpdepfile" \ + | sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +dashXmstdout) + # This case only exists to satisfy depend.m4. It is never actually + # run, as this mode is specially recognized in the preamble. + exit 1 + ;; + +makedepend) + "$@" || exit $? + # Remove any Libtool call + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + # X makedepend + shift + cleared=no eat=no + for arg + do + case $cleared in + no) + set ""; shift + cleared=yes ;; + esac + if test $eat = yes; then + eat=no + continue + fi + case "$arg" in + -D*|-I*) + set fnord "$@" "$arg"; shift ;; + # Strip any option that makedepend may not understand. Remove + # the object too, otherwise makedepend will parse it as a source file. + -arch) + eat=yes ;; + -*|$object) + ;; + *) + set fnord "$@" "$arg"; shift ;; + esac + done + obj_suffix=`echo "$object" | sed 's/^.*\././'` + touch "$tmpdepfile" + ${MAKEDEPEND-makedepend} -o"$obj_suffix" -f"$tmpdepfile" "$@" + rm -f "$depfile" + # makedepend may prepend the VPATH from the source file name to the object. + # No need to regex-escape $object, excess matching of '.' is harmless. + sed "s|^.*\($object *:\)|\1|" "$tmpdepfile" > "$depfile" + # Some versions of the HPUX 10.20 sed can't process the last invocation + # correctly. Breaking it into two sed invocations is a workaround. + sed '1,2d' "$tmpdepfile" \ + | tr ' ' "$nl" \ + | sed -e 's/^\\$//' -e '/^$/d' -e '/:$/d' \ + | sed -e 's/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" "$tmpdepfile".bak + ;; + +cpp) + # Important note: in order to support this mode, a compiler *must* + # always write the preprocessed file to stdout. + "$@" || exit $? + + # Remove the call to Libtool. + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + + # Remove '-o $object'. + IFS=" " + for arg + do + case $arg in + -o) + shift + ;; + $object) + shift + ;; + *) + set fnord "$@" "$arg" + shift # fnord + shift # $arg + ;; + esac + done + + "$@" -E \ + | sed -n -e '/^# [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \ + -e '/^#line [0-9][0-9]* "\([^"]*\)".*/ s:: \1 \\:p' \ + | sed '$ s: \\$::' > "$tmpdepfile" + rm -f "$depfile" + echo "$object : \\" > "$depfile" + cat < "$tmpdepfile" >> "$depfile" + sed < "$tmpdepfile" '/^$/d;s/^ //;s/ \\$//;s/$/ :/' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +msvisualcpp) + # Important note: in order to support this mode, a compiler *must* + # always write the preprocessed file to stdout. + "$@" || exit $? + + # Remove the call to Libtool. + if test "$libtool" = yes; then + while test "X$1" != 'X--mode=compile'; do + shift + done + shift + fi + + IFS=" " + for arg + do + case "$arg" in + -o) + shift + ;; + $object) + shift + ;; + "-Gm"|"/Gm"|"-Gi"|"/Gi"|"-ZI"|"/ZI") + set fnord "$@" + shift + shift + ;; + *) + set fnord "$@" "$arg" + shift + shift + ;; + esac + done + "$@" -E 2>/dev/null | + sed -n '/^#line [0-9][0-9]* "\([^"]*\)"/ s::\1:p' | $cygpath_u | sort -u > "$tmpdepfile" + rm -f "$depfile" + echo "$object : \\" > "$depfile" + sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::'"$tab"'\1 \\:p' >> "$depfile" + echo "$tab" >> "$depfile" + sed < "$tmpdepfile" -n -e 's% %\\ %g' -e '/^\(.*\)$/ s::\1\::p' >> "$depfile" + rm -f "$tmpdepfile" + ;; + +msvcmsys) + # This case exists only to let depend.m4 do its work. It works by + # looking at the text of this script. This case will never be run, + # since it is checked for above. + exit 1 + ;; + +none) + exec "$@" + ;; + +*) + echo "Unknown depmode $depmode" 1>&2 + exit 1 + ;; +esac + +exit 0 + +# Local Variables: +# mode: shell-script +# sh-indentation: 2 +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff --git a/documentation/64-bit-porting-guide.txt b/documentation/64-bit-porting-guide.txt new file mode 100644 index 0000000..f3983e2 --- /dev/null +++ b/documentation/64-bit-porting-guide.txt @@ -0,0 +1,241 @@ +Date: Tue, 9 Feb 1993 16:48 EST +From: John Dustin +To: tenny@symbolics +Subject: 64-bit porting guide +cc: jsd@zk3.dec + + Vers: 1/14/92 + afd + + 64-bit "clean" Guidelines + ========================= + +By paying careful attention to data types you can make your code work +on both 32 bit and 64 bit systems. + +C compiler data types and bit sizes are as follows: + + Mips 32 bit Alpha 64 bit + C type Data Size Data Size + ====== ========= ============ + + short 16 bits 16 bits + + int 32 bits 32 bits + + long 32 bits 64 bits + + * (ptr) 32 bits 64 bits + + long long 64 bits 64 bits (coming in the future) + + +Declare any variable that you want to be 32 bits in size, as an "int", +not a "long". That way it will be 32 bits in size on both 32-bit mips +systems and 64-bit Alpha systems. + +If a variable should be 32 bits in size on a 32-bit mips system and +64 bits in size on a 64-bit Alpha system, then declare it as a "long". + +Watch out for arguments to functions where the argument is not +explicitly declared (and typed). You should explicitly declare the +formal parameters to routines or their sizes may not match up with the +caller (default is "int" which truncates 64-bit addresses). + +Remember that "register var" and "unsigned var" default to "int" (32-bits). + +Look at any variable declared "int". It may be used to hold an address! +Sizeof (int) does not equal sizeof (char *) on Alpha. + +Look at any variable declared "long". If it must be 32 bits, then you +have to change its type to "int". + +Constants are 32-bit quantities by default. Shift operations or bit +operations on constants will give 32-bit results. If you want a 64-bit +result you must follow the const with an "L", otherwise you get a +32-bit result. For example: + + long foo, bar; + foo = 1L << bar; + +Using a "0" where you should use "NULL" means that you get a 32-bit const. +On alpha that could mean 0 in the low 32 bits and garbage in the high 32 bits. +Using "NULL" from stdio.h will get the correct value for mips and alpha. + +Modifying a "char" is NOT atomic on Alpha. You will get a load of 32 +or 64 bits and then byte operations to extract, mask, and shift the +byte, followed by a store of 32 or 64 bits. + +Bitfields declared as "int" on Alpha generate load/store long (32 bits) +Bitfields declared as "long" on Alpha generate load/store quad (64 bits) + +Printf formats: %d and %x will print 32 bits worth of data. +Use %ld and %lx to get 64 bits. + + + Kernel Code and Drivers + ======================= + +Wherever there was a wbflush() call in mips code, you need an mb() +call in Alpha code. The "mb" stands for memory barrier. + +An mb() is occasionally needed even where a wbflush() was not needed. +In general, a memory barrier causes loads/stores to be serialized +(not out-of-order), empties memory pipelines and write buffers, and +assures that the data cache is coherent: + + The mb() call should be used to synchronize DMA buffers. Use it + before the host releases the buffer to the driver and before the + host access a buffer filled by the driver. + + Alpha does not guarantee to preserve write ordering, so memory + barriers are required between multiple writes to I/O registers + where order is important. + + The same is true for read ordering also. + + Use the memory barrier to prevent writes from being collapsed in the + write buffer. That is, to prevent bytes/shorts/ints from being merged + into one write. + + Whenever a cache flush is done, an mb() must precede and follow the + cache flush. + + + +------- End of Forwarded Message + + + + MORE 64-BIT PORTING HINTS + +The following hints are intended to serve as a reminder of some of the +more glaring non-portable programming practices. + +When porting from a 32-bit architecture to a 64-bit architecture, the main +thrust of the effort centers around cleaning up non-portable programming +assumptions. In some cases, it means doing away with just plain sloppy code. +In others, the original authors may have "done the right thing" at the time +that the code was developed, but the new architecture may necessitate taking +new approaches. + +A typical approach involves the following steps: + + +1) Grep for "long". Variables declared long are more likely to + cause problems elsewhere in the code. + +2) Run "grep" to locate "%d", "%s", and similar arguments to + printf() statements where coders have mixed ints and longs. + Note that "%D" should be changed to "%ld". + +3) Grep for "fseek" and "lseek" statements that have hard-wired + constants or inappropriate types. More about this later. + +4) Run lint to catch a treasure trove of incompatible casts and + other portability glitches. It's a good idea to run lint on + multiple source files at once instead of individual files. + + +And now for the list of gotchas... + +=========================================================================== +* MIXING POINTERS AND INTS + +- Function calls which pass ints to functions expecting pointers +- Implicit casts of function call return values + + +long n; + +n = foobar(100, 200); /* WRONG */ + +int foobar(first, last) + long first; + long last; +{ +} + + +=========================================================================== +* MIXING INTS AND LONGS + +long x, y; + +x = y & ~3; /* WRONG */ +x = y & ~3L; /* RIGHT */ + + +=========================================================================== +* EXPLICIT CASTS WHICH DIFFER FROM DECLARATIONS IN HEADERS + +char *foo; +foo = (char *)malloc(n); /* WRONG */ + +You should include instead of assuming that malloc() +returns a (char *) type. In , malloc() currently +returns (void *). Note that the string functions are often +declared incorrectly. + +=========================================================================== +* SEEK OFFSETS + + +lseek(d, 0); /* WRONG */ +lseek(d, 0L); /* MARGINAL - MAY WORK NOW, BUT MIGHT NOT + WORK IN THE FUTURE */ + +off_t offset; +lseek(d, offset); /* RIGHT */ + +lseek(d, (off_t)0) /* RIGHT */ + +=========================================================================== +* TRUNCATIONS AND EXTENSIONS + +int h; +long l = 0x1ffffeefe; + +h = l; /* WRONG */ + + +char c = 255; +long j; + +j = c; /* RIGHT */ +j = 255; /* RIGHT */ + + +Also, note that bit fields are limited to 32 bit ints only. +Anything greater than 32 bits may be truncated. Similarly, +switch constants are considered to be ints as well. + + +=========================================================================== +* IMPROPER USE OF sizeof + +"sizeof" returns "size_t", which is an unsigned int. This can +cause problems when combining it in an expression which contains +boths longs and ints. + +long x,y; (or char *x,*y;) + +x = y & ~(sizeof long - 1); /* WRONG */ +x = (long)(y & ~(sizeof long - 1)); /* STILL WRONG */ +x = y & ~(sizeof long - 1L); /* RIGHT */ +x = y & ~(long)(sizeof long - 1); /* MORE RIGHT */ + + +=========================================================================== +* GENERAL CONSIDERATIONS + +- Whenever possible, avoid making code "64-bit specific". Try + to make it scale to any architecture instead. + +- Watch the order of evaluation in expressions. + +- Pay special attention to byte ordering when mixing types. + + +------- End of Forwarded Message + diff --git a/documentation/vlm-installation.txt b/documentation/vlm-installation.txt new file mode 100644 index 0000000..6fba4e5 Binary files /dev/null and b/documentation/vlm-installation.txt differ diff --git a/dot.VLM b/dot.VLM new file mode 100644 index 0000000..cdebf93 --- /dev/null +++ b/dot.VLM @@ -0,0 +1,23 @@ +# more .VLM +genera.network: 192.245.4.23;mask=255.255.255.0 +genera.virtualMemory: 2048 + +#genera.enableIDS: yes +#genera.world: /home/brad/genera_8_3.ilod +#genera.world: /usr/lib/symbolics/G5a.vlod +#genera.world: /usr/lib/symbolics/G5.vlod +#genera.world: /usr/lib/symbolics/MIT.vlod +#genera.world: ../cvlm/CL-HTTP-A-CSAIL-8-5.vlod.bak +#genera.world: ../symbolics/Genera-8-5.vlod +genera.world: ../symbolics/MIT.vlod +#genera.world: /tmp/world.vlod + +genera.debugger: ../symbolics/VLM_debugger +genera.coldLoad.geometry: 800x600 + +#minima.network: og5-vlm1.ai.mit.edu;mask=255.255.255.0;gateway=128.52.39.10 +#minima.diagnosticHost: rainier-vlm.ai.mit.edu +#minima.spy: yes + +#iverify.diagnosticHost: rainier-vlm.ai.mit.edu +#iverify.spy: yes diff --git a/emulator/BootComm.h b/emulator/BootComm.h new file mode 100644 index 0000000..442a702 --- /dev/null +++ b/emulator/BootComm.h @@ -0,0 +1,130 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* The BootROM Communications and Data areas -- See SYS:I-SYS;SYSDF1 for details */ + +#ifndef _BOOTCOM_ +#define _BOOTCOM_ + +#include +#include "life_types.h" + +#define BootCommAreaAddress 0xFFFE0000L +#define BootCommAreaSize 64 + +/* Returns the address of a slot in the BootComm area */ +#define BootCommSlotAddress(slot) \ + ((ptrdiff_t)BootCommAreaAddress + offsetof(BootCommArea,slot)/sizeof(EmbWord)) + +/* Reads a slot of the BootComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define ReadBootCommSlot(slot,object) \ + VirtualMemoryRead (BootCommSlotAddress (slot), &object) +#else +#define ReadBootCommSlot(slot) \ + VirtualMemoryRead (BootCommSlotAddress (slot)) +#endif + +/* Writes a slot of the BootComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define WriteBootCommSlot(slot,datum,tag) \ + { \ + LispObj lispDatum; \ + lispDatum.DATA.u = (Integer)datum; \ + lispDatum.TAG = (Tag)tag; \ + VirtualMemoryWrite (BootCommSlotAddress (slot), &lispDatum); \ + } +#else +#define WriteBootCommSlot(slot,datum,tag) \ + VirtualMemoryWrite (BootCommSlotAddress (slot), MakeLispObj ((Tag)tag, (Integer)datum)) +#endif + + +/* The BootComm area */ + +typedef struct + { + EmbWord embCommArea; /* Ivory address of the embedded communications area */ + EmbWord systemType; /* Ivory system type (see embed.h) */ + EmbWord stackBase; + EmbWord stackSize; + EmbWord spyPC; + EmbWord spyCommandAddress; /* Obsolete */ + EmbWord spyStatusAddress; /* Obsolete */ + EmbWord spyBlockAddress; + EmbWord crashAddress; /* Obsolete */ + EmbWord crashActionAddress; /* Obsolete */ + EmbWord bootPROMVersion; + } BootCommArea; + +extern BootCommArea* BootCommAreaPtr; + +#define BootStackBase 0xF8000100L +#define BootStackSize 0xF00L + + +/* The base of the BootData area is reserved for the FEP to save registers */ + +#define BootDataAreaAddress 0xFFFE0040L +#define BootDataAreaOffset 46 +#define BootDataAreaSize 64 + +/* Returns the address of a slot in the BootData area */ +#define BootDataSlotAddress(slot) \ + ((ptrdiff_t)BootDataAreaAddress + offsetof(BootDataArea,slot)/sizeof(EmbWord) + BootDataAreaOffset) + +/* Reads a slot of the BootData area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define ReadBootDataSlot(slot,object) \ + VirtualMemoryRead (BootDataSlotAddress (slot), &object) +#else +#define ReadBootDataSlot(slot) \ + VirtualMemoryRead (BootDataSlotAddress (slot)) +#endif + +/* Writes a slot of the BootData area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define WriteBootDataSlot(slot,datum,tag) \ + { \ + LispObj lispDatum; \ + lispDatum.DATA.u = (Integer)datum; \ + lispDatum.TAG = (Tag)tag; \ + VirtualMemoryWrite (BootDataSlotAddress (slot), &lispDatum); \ + } +#else +#define WriteBootDataSlot(slot,datum,tag) \ + VirtualMemoryWrite (BootDataSlotAddress (slot), MakeLispObj ((Tag)tag, (Integer)datum)) +#endif + + +/* The BootData area */ + +typedef struct + { + EmbWord bootSpyCommand; + EmbWord bootSpyStatus; + EmbWord crashAction; + EmbWord crashType; + union + { + EmbWord crashFatalPC; + EmbWord crashTrapNumber; + } crashWord1; + union + { + EmbWord crashFatalVMA; + EmbWord crashTrapPC; + } crashWord2; + union + { + EmbWord crashFatalFEPVector; + EmbWord crashTrapArgs; + } crashWord3; + EmbWord bootFEPKernelDPN; + EmbWord bootDevicePROMVersion; + EmbWord bootColorStartupFileDPN; + EmbWord bootSelectedConsoleType; + } BootDataArea; + +extern BootDataArea* BootDataAreaPtr; + +#endif diff --git a/emulator/FEPComm.h b/emulator/FEPComm.h new file mode 100644 index 0000000..c12f229 --- /dev/null +++ b/emulator/FEPComm.h @@ -0,0 +1,164 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* The FEP Communications area -- See SYS:I-SYS;SYSDF1 for details */ + +#ifndef _FEPCOM_ +#define _FEPCOM_ + +#include +#include "life_types.h" + +#define FEPCommAreaAddress 0xF8041000L +#define FEPCommAreaSize 256 + +/* Returns the address of a slot in the FEPComm area */ +#define FEPCommSlotAddress(slot) \ + ((ptrdiff_t)FEPCommAreaAddress + offsetof(FEPCommArea,slot)/sizeof(EmbWord)) + +/* Reads a slot of the FEPComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define ReadFEPCommSlot(slot,object) \ + VirtualMemoryRead (FEPCommSlotAddress (slot), &object) +#else +#define ReadFEPCommSlot(slot) \ + VirtualMemoryRead (FEPCommSlotAddress (slot)) +#endif + +/* Writes a slot of the FEPComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define WriteFEPCommSlot(slot,datum,tag) \ + { \ + LispObj lispDatum; \ + lispDatum.DATA.u = (Integer)datum; \ + lispDatum.TAG = (Tag)tag; \ + VirtualMemoryWrite (FEPCommSlotAddress (slot), &lispDatum); \ + } +#else +#define WriteFEPCommSlot(slot,datum,tag) \ + VirtualMemoryWrite (FEPCommSlotAddress (slot), MakeLispObj ((Tag)tag, (Integer)datum)) +#endif + + +#ifndef MINIMA + +/* Genera version of FEP Communications area */ + +typedef struct + { + EmbWord fepVersionNumber; + EmbWord systemType; + EmbWord fepStartup; + EmbWord spyCommand; /* Obsolete */ + EmbWord spyStatus; /* Obsolete */ + EmbWord spyPC; /* Obsolete */ + EmbWord loadMapSize; + EmbWord loadMapVMAAddress; + EmbWord loadMapOpcodeAddress; + EmbWord loadMapOperandAddress; + EmbWord swapMapSize; + EmbWord swapMapAddress; + EmbWord swapMapDPNAddress; + EmbWord mainMemoryMapSize; + EmbWord mainMemoryMapAddress; + EmbWord badMemoryPagesSize; + EmbWord badMemoryPagesAddress; + EmbWord fepPhysicalAddressHigh; + EmbWord unwiredVirtualAddressLow; + EmbWord unwiredVirtualAddressHigh; + EmbWord unwiredPhysicalAddressLow; + EmbWord unwiredPhysicalAddressHigh; + EmbWord requestingLispToStop; + EmbWord currentFEPOverlays; + EmbWord embCommunicationArea; + EmbWord loadedBandName; + EmbWord netbootControlString; + EmbWord softwareConfiguration; + EmbWord netAddress1; + EmbWord netAddress2; + EmbWord primaryNetworkAddress; + EmbWord fepCommandString; + EmbWord fepCrashDataRequest; + EmbWord coldLoadStreamReadCharacter; + EmbWord coldLoadStreamListen; + EmbWord coldLoadStreamReadHardwareCharacter; + EmbWord coldLoadStreamDrawCharacter; + EmbWord coldLoadStreamDisplayLozengedString; + EmbWord coldLoadStreamSelect; + EmbWord coldLoadStreamBeep; + EmbWord coldLoadStreamFinish; + EmbWord coldLoadStreamInsideSize; + EmbWord coldLoadStreamSetCursorpos; + EmbWord coldLoadStreamReadCursorpos; + EmbWord coldLoadStreamComputeMotion; + EmbWord coldLoadStreamClearBetweenCursorposes; + EmbWord coldLoadStreamSetEdges; + EmbWord mainScreenParameters; + EmbWord wiredFormat; + EmbWord fepSequenceBreak; /* Obsolete */ + EmbWord lispStoppedCleanly; + EmbWord loadPagesToSwapAreaP; + EmbWord remoteDebugLoop; + EmbWord timezoneOffsetMinutes; + EmbWord timezoneName; + EmbWord namespaceDescriptorFile; + EmbWord siteName; + EmbWord savedLispRegisters; + EmbWord lispStateSaved; + EmbWord enableFPAp; + EmbWord diskUnitTable; + EmbWord hardwareConfiguration; + EmbWord slaveBufferBaseAddress; + EmbWord kernelCompressedStringArray; + EmbWord domino8032State; + } FEPCommArea; + +#else + +/* Minima version of FEP Communications Area */ + +typedef struct + { + EmbWord fepVersionNumber; + EmbWord systemType; + EmbWord fepStartup; + EmbWord embCommunicationArea; + EmbWord memorySegmentFreeList; + EmbWord unallocatedPhysicalMemory; + EmbWord phtSize; + EmbWord phtCollisionCountsBase; + EmbWord phtCollisionCount; + EmbWord phtRehashes; + EmbWord unmappedMemoryBase; + EmbWord allocatePhyiscalMemoryAtAddress; + EmbWord allocatePhysicalMemory; + EmbWord deallocatePhysicalMemory; + EmbWord romPHTLookup; + EmbWord romPHTPut; + EmbWord romPHTRemove; + EmbWord romPHTRehash; + EmbWord romError; + EmbWord clearMapCache; + EmbWord localIPAddress0; + EmbWord diagnosticIPAddress; + EmbWord romMBINGetReceiveBuffer; + EmbWord romMBINReturnReceiveBuffer; + EmbWord romMBINGetTransmitBuffer; + EmbWord romMBINSendTransmitBuffer; + EmbWord initializeInteractor; + EmbWord localIPAddress1; + EmbWord localIPSubnetMask0; + EmbWord localIPSubnetMask1; + EmbWord gatewayIPAddress0; + EmbWord gatewayIPAddress1; + EmbWord loadServerIPAddress; + EmbWord hardwareECORegisters; + EmbWord ethernetDriver0; + EmbWord ethernetDriver1; + EmbWord romUpdateRendezvousParameters; + } FEPCommArea; + +#endif + +extern FEPCommArea* FEPCommAreaPtr; + +#endif diff --git a/emulator/Makefile b/emulator/Makefile new file mode 100644 index 0000000..dffeb85 --- /dev/null +++ b/emulator/Makefile @@ -0,0 +1,544 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# emulator/Makefile. Generated from Makefile.in by configure. + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + + + + +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/vlm +pkgincludedir = $(includedir)/vlm +pkglibdir = $(libdir)/vlm +pkglibexecdir = $(libexecdir)/vlm +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = x86_64-suse-linux-gnu +host_triplet = x86_64-suse-linux-gnu +subdir = emulator +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +AR = ar +ARFLAGS = cru +AM_V_AR = $(am__v_AR_$(V)) +am__v_AR_ = $(am__v_AR_$(AM_DEFAULT_VERBOSITY)) +am__v_AR_0 = @echo " AR " $@; +am__v_AR_1 = +libem_a_AR = $(AR) $(ARFLAGS) +libem_a_LIBADD = +am_libem_a_OBJECTS = interfac.$(OBJEXT) interpds.$(OBJEXT) \ + externals.$(OBJEXT) memory.$(OBJEXT) +libem_a_OBJECTS = $(am_libem_a_OBJECTS) +AM_V_P = $(am__v_P_$(V)) +am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY)) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_$(V)) +am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY)) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_$(V)) +am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY)) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I. -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_$(V)) +am__v_CC_ = $(am__v_CC_$(AM_DEFAULT_VERBOSITY)) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_$(V)) +am__v_CCLD_ = $(am__v_CCLD_$(AM_DEFAULT_VERBOSITY)) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libem_a_SOURCES) +DIST_SOURCES = $(libem_a_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = ${SHELL} /home/lispm/snap5/jj-vlm/missing aclocal-1.13 +AMTAR = $${TAR-tar} +AM_DEFAULT_VERBOSITY = 0 +AUTOCONF = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoconf +AUTOHEADER = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoheader +AUTOMAKE = ${SHELL} /home/lispm/snap5/jj-vlm/missing automake-1.13 +AWK = gawk +CC = gcc -std=gnu99 +CCDEPMODE = depmode=gcc3 +CFLAGS = -g -O2 -g0 -Ofast -rdynamic -fno-strict-aliasing -march=native -Wall +CLISP = /usr/bin/clisp +CPP = gcc -std=gnu99 -E +CPPFLAGS = -DGENERA -DAUTOSTART -DUSE_TAP +CYGPATH_W = echo +DEFS = -DHAVE_CONFIG_H +DEPDIR = .deps +ECHO_C = +ECHO_N = -n +ECHO_T = +EGREP = /usr/bin/grep -E +EXEEXT = +GREP = /usr/bin/grep +INSTALL = /usr/bin/install -c +INSTALL_DATA = ${INSTALL} -m 644 +INSTALL_PROGRAM = ${INSTALL} +INSTALL_SCRIPT = ${INSTALL} +INSTALL_STRIP_PROGRAM = $(install_sh) -c -s +LDFLAGS = +LIBOBJS = +LIBS = -lpthread -lm -ldl -lcrypt -lc -lX11 +LTLIBOBJS = +MAKEINFO = ${SHELL} /home/lispm/snap5/jj-vlm/missing makeinfo +MKDIR_P = /usr/bin/mkdir -p +OBJEXT = o +PACKAGE = vlm +PACKAGE_BUGREPORT = joachimq@achemich.de +PACKAGE_NAME = vlm +PACKAGE_STRING = vlm 0.99-1 +PACKAGE_TARNAME = vlm +PACKAGE_URL = +PACKAGE_VERSION = 0.99-1 +PATH_SEPARATOR = : +PTHREAD_CC = gcc -std=gnu99 +PTHREAD_CFLAGS = -pthread +PTHREAD_LIBS = +RANLIB = ranlib +SET_MAKE = +SHELL = /bin/sh +STRIP = +VERSION = 0.99-1 +XMKMF = +abs_builddir = /home/lispm/snap5/jj-vlm/emulator +abs_srcdir = /home/lispm/snap5/jj-vlm/emulator +abs_top_builddir = /home/lispm/snap5/jj-vlm +abs_top_srcdir = /home/lispm/snap5/jj-vlm +ac_ct_CC = gcc +acx_pthread_config = +am__include = include +am__leading_dot = . +am__quote = +am__tar = $${TAR-tar} chof - "$$tardir" +am__untar = $${TAR-tar} xf - +bindir = ${exec_prefix}/bin +build = x86_64-suse-linux-gnu +build_alias = +build_cpu = x86_64 +build_os = linux-gnu +build_vendor = suse +builddir = . +datadir = ${datarootdir} +datarootdir = ${prefix}/share +docdir = ${datarootdir}/doc/${PACKAGE_TARNAME} +dvidir = ${docdir} +exec_prefix = ${prefix} +host = x86_64-suse-linux-gnu +host_alias = +host_cpu = x86_64 +host_os = linux-gnu +host_vendor = suse +htmldir = ${docdir} +includedir = ${prefix}/include +infodir = ${datarootdir}/info +install_sh = ${SHELL} /home/lispm/snap5/jj-vlm/install-sh +libdir = ${exec_prefix}/lib64 +libexecdir = ${exec_prefix}/lib +localedir = ${datarootdir}/locale +localstatedir = ${prefix}/var +mandir = ${datarootdir}/man +mkdir_p = $(MKDIR_P) +oldincludedir = /usr/include +pdfdir = ${docdir} +prefix = /usr/local +program_transform_name = s,x,x, +psdir = ${docdir} +sbindir = ${exec_prefix}/sbin +sharedstatedir = ${prefix}/com +srcdir = . +sysconfdir = ${prefix}/etc +target_alias = +top_build_prefix = ../ +top_builddir = .. +top_srcdir = .. + +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I/home/lispm/snap5/jj-vlm/include -I/home/lispm/snap5/jj-vlm/life-support -I/home/lispm/snap5/jj-vlm/emulator -I/home/lispm/snap5/jj-vlm/x86_64-emulator +noinst_LIBRARIES = libem.a +libem_a_SOURCES = interfac.c interpds.c externals.c memory.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu emulator/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu emulator/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) + +libem.a: $(libem_a_OBJECTS) $(libem_a_DEPENDENCIES) $(EXTRA_libem_a_DEPENDENCIES) + $(AM_V_at)-rm -f libem.a + $(AM_V_AR)$(libem_a_AR) libem.a $(libem_a_OBJECTS) $(libem_a_LIBADD) + $(AM_V_at)$(RANLIB) libem.a + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +include ./$(DEPDIR)/externals.Po +include ./$(DEPDIR)/interfac.Po +include ./$(DEPDIR)/interpds.Po +include ./$(DEPDIR)/memory.Po + +.c.o: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c $< + +.c.obj: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-local clean-noinstLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ + clean-local clean-noinstLIBRARIES cscopelist-am ctags ctags-am \ + distclean distclean-compile distclean-generic distclean-tags \ + distdir dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am + + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/emulator/Makefile.am b/emulator/Makefile.am new file mode 100644 index 0000000..5d0c481 --- /dev/null +++ b/emulator/Makefile.am @@ -0,0 +1,10 @@ +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS=-I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator + +noinst_LIBRARIES = libem.a +libem_a_SOURCES = interfac.c interpds.c externals.c memory.c + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ diff --git a/emulator/Makefile.in b/emulator/Makefile.in new file mode 100644 index 0000000..b2877f3 --- /dev/null +++ b/emulator/Makefile.in @@ -0,0 +1,544 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = emulator +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +AR = ar +ARFLAGS = cru +AM_V_AR = $(am__v_AR_@AM_V@) +am__v_AR_ = $(am__v_AR_@AM_DEFAULT_V@) +am__v_AR_0 = @echo " AR " $@; +am__v_AR_1 = +libem_a_AR = $(AR) $(ARFLAGS) +libem_a_LIBADD = +am_libem_a_OBJECTS = interfac.$(OBJEXT) interpds.$(OBJEXT) \ + externals.$(OBJEXT) memory.$(OBJEXT) +libem_a_OBJECTS = $(am_libem_a_OBJECTS) +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libem_a_SOURCES) +DIST_SOURCES = $(libem_a_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CLISP = @CLISP@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +OBJEXT = @OBJEXT@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +RANLIB = @RANLIB@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +XMKMF = @XMKMF@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +acx_pthread_config = @acx_pthread_config@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ + +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator +noinst_LIBRARIES = libem.a +libem_a_SOURCES = interfac.c interpds.c externals.c memory.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu emulator/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu emulator/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) + +libem.a: $(libem_a_OBJECTS) $(libem_a_DEPENDENCIES) $(EXTRA_libem_a_DEPENDENCIES) + $(AM_V_at)-rm -f libem.a + $(AM_V_AR)$(libem_a_AR) libem.a $(libem_a_OBJECTS) $(libem_a_LIBADD) + $(AM_V_at)$(RANLIB) libem.a + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/externals.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/interfac.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/interpds.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/memory.Po@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-local clean-noinstLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ + clean-local clean-noinstLIBRARIES cscopelist-am ctags ctags-am \ + distclean distclean-compile distclean-generic distclean-tags \ + distdir dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am + + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/emulator/SystemComm.h b/emulator/SystemComm.h new file mode 100644 index 0000000..2e10f0b --- /dev/null +++ b/emulator/SystemComm.h @@ -0,0 +1,127 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* The System Communications area -- See SYS:I-SYS;SYSDF1 for details */ + +#ifndef _SYSTEMCOM_ +#define _SYSTEMCOM_ + +#include +#include "life_types.h" + +#define SystemCommAreaAddress 0xF8041100L +#define SystemCommAreaSize 256 + +/* Returns the address of a slot in the SystemComm area */ +#define SystemCommSlotAddress(slot) \ + ((ptrdiff_t)SystemCommAreaAddress + offsetof(SystemCommArea,slot)/sizeof(EmbWord)) + +/* Reads a slot of the SystemComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define ReadSystemCommSlot(slot,object) \ + VirtualMemoryRead (SystemCommSlotAddress (slot), &object) +#else +#define ReadSystemCommSlot(slot) \ + VirtualMemoryRead (SystemCommSlotAddress (slot)) +#endif + +/* Writes a slot of the SystemComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define WriteSystemCommSlot(slot,datum,tag) \ + { \ + LispObj lispDatum; \ + lispDatum.DATA.u = (Integer)datum; \ + lispDatum.TAG = (Tag)tag; \ + VirtualMemoryWrite (SystemCommSlotAddress (slot), &lispDatum); \ + } +#else +#define WriteSystemCommSlot(slot,datum,tag) \ + VirtualMemoryWrite (SystemCommSlotAddress (slot), MakeLispObj ((Tag)tag, (Integer)datum)) +#endif + + +#ifndef MINIMA + +/* Genera version of System Communications area */ + +typedef struct + { + EmbWord syscomMajorVersionNumber; + EmbWord syscomMinorVersionNumber; + EmbWord systemStartup; + EmbWord addressSpaceMapAddress; + EmbWord oblastFreeSize; + EmbWord areaName; + EmbWord areaMaximumQuantumSize; + EmbWord areaRegionQuantumSize; + EmbWord areaRegionList; + EmbWord areaRegionBits; + EmbWord regionQuantumOrigin; + EmbWord regionQuantumLength; + EmbWord regionFreePointer; + EmbWord regionGCPointer; + EmbWord regionBits; + EmbWord regionListThread; + EmbWord regionArea; + EmbWord regionCreatedPages; + EmbWord regionFreePointerBeforeFlip; + EmbWord regionConsAlarm; + EmbWord pageConsAlarm; + EmbWord structureCacheRegion; + EmbWord listCacheRegion; + EmbWord defaultConsArea; + EmbWord pht; + EmbWord mmptY; + EmbWord mmpt; + EmbWord smpt; + EmbWord loadBitmaps; + EmbWord loadMap; /* Red herring */ + EmbWord loadMapDPN; /* Red herring */ + EmbWord swapMap; /* Red herring */ + EmbWord swapMapDPN; /* Red herring */ + EmbWord sysoutBitmaps; + EmbWord phtCollisionCounts; + EmbWord mmpt1; + EmbWord storageColdBoot; + EmbWord flushableQueueHead; + EmbWord flushableQueueTail; + EmbWord flushableQueueModified; + EmbWord wiredPhysicalAddressHigh; + EmbWord wiredVirtualAddressHigh; + EmbWord enableSysoutAtColdBoot; + EmbWord sysoutGenerationNumber; + EmbWord sysoutTimestamp1; + EmbWord sysoutTimestamp2; + EmbWord sysoutParentTimestamp1; + EmbWord sysoutParentTimestamp2; + EmbWord initialStackGroup; + EmbWord currentStackGroup; + EmbWord stackGroupLock; + EmbWord currentStackGroupStatusBits; + EmbWord inhibitSchedulingFlag; + EmbWord controlStackLow; + EmbWord bindingStackLow; + EmbWord floatOperatingMode; + EmbWord floatOperationStatus; + EmbWord packageNameTable; + EmbWord lispReleaseString; + EmbWord busMode; + } SystemCommArea; + +#else + +/* Minima version of System Communications Area */ + +typedef struct + { + EmbWord systemStartup; + EmbWord allAreas; + EmbWord allPackages; + EmbWord saveWorldHeader; + EmbWord kernelUseROMEthernet; + } SystemCommArea; + +#endif + +extern SystemCommArea* SystemCommAreaPtr; + +#endif diff --git a/emulator/aihead.c b/emulator/aihead.c new file mode 100644 index 0000000..990a3ef --- /dev/null +++ b/emulator/aihead.c @@ -0,0 +1,4 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;aihead.sid Any changes made to it will be lost. */ + + diff --git a/emulator/aihead.h b/emulator/aihead.h new file mode 100644 index 0000000..b04b444 --- /dev/null +++ b/emulator/aihead.h @@ -0,0 +1,1083 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;aihead.sid Any changes made to it will be lost. */ + +#ifndef _AIHEAD_ +#define _AIHEAD_ + + + +#define Type_Null 0 + +#define Type_MonitorForward 1 + +#define Type_HeaderP 2 + +#define Type_HeaderI 3 + +#define Type_ExternalValueCellPointer 4 + +#define Type_OneQForward 5 + +#define Type_HeaderForward 6 + +#define Type_ElementForward 7 + +#define Type_Fixnum 8 + +#define Type_SmallRatio 9 + +#define Type_SingleFloat 10 + +#define Type_DoubleFloat 11 + +#define Type_Bignum 12 + +#define Type_BigRatio 13 + +#define Type_Complex 14 + +#define Type_SpareNumber 15 + +#define Type_Instance 16 + +#define Type_ListInstance 17 + +#define Type_ArrayInstance 18 + +#define Type_StringInstance 19 + +#define Type_NIL 20 + +#define Type_List 21 + +#define Type_Array 22 + +#define Type_String 23 + +#define Type_Symbol 24 + +#define Type_Locative 25 + +#define Type_LexicalClosure 26 + +#define Type_DynamicClosure 27 + +#define Type_CompiledFunction 28 + +#define Type_GenericFunction 29 + +#define Type_SparePointer1 30 + +#define Type_SparePointer2 31 + +#define Type_PhysicalAddress 32 + +#define Type_NativeInstruction 33 + +#define Type_BoundLocation 34 + +#define Type_Character 35 + +#define Type_LogicVariable 36 + +#define Type_GCForward 37 + +#define Type_EvenPC 38 + +#define Type_OddPC 39 + +#define Type_CallCompiledEven 40 + +#define Type_CallCompiledOdd 41 + +#define Type_CallIndirect 42 + +#define Type_CallGeneric 43 + +#define Type_CallCompiledEvenPrefetch 44 + +#define Type_CallCompiledOddPrefetch 45 + +#define Type_CallIndirectPrefetch 46 + +#define Type_CallGenericPrefetch 47 + +#define Type_PackedInstruction60 48 + +#define Type_TypePackedInstruction61 49 + +#define Type_TypePackedInstruction62 50 + +#define Type_PackedInstruction63 51 + +#define Type_TypePackedInstruction64 52 + +#define Type_TypePackedInstruction65 53 + +#define Type_PackedInstruction66 54 + +#define Type_TypePackedInstruction67 55 + +#define Type_TypePackedInstruction70 56 + +#define Type_PackedInstruction71 57 + +#define Type_TypePackedInstruction72 58 + +#define Type_TypePackedInstruction73 59 + +#define Type_PackedInstruction74 60 + +#define Type_TypePackedInstruction75 61 + +#define Type_TypePackedInstruction76 62 + +#define Type_PackedInstruction77 63 + +#define Cdr_Next 0 + +#define Cdr_Nil 1 + +#define Cdr_Normal 2 + +#define Array_ElementTypeFixnum 0 + +#define Array_ElementTypeCharacter 1 + +#define Array_ElementTypeBoolean 2 + +#define Array_ElementTypeObject 3 + +#define Array_TypeFieldPos 26 + +#define Array_TypeFieldSize 6 + +#define Array_TypeFieldMask 63 + +#define Array_ElementTypePos 30 + +#define Array_ElementTypeSize 2 + +#define Array_ElementTypeMask 3 + +#define Array_BytePackingPos 27 + +#define Array_BytePackingSize 3 + +#define Array_BytePackingMask 7 + +#define Array_ListBitPos 26 + +#define Array_ListBitSize 1 + +#define Array_ListBitMask 1 + +#define Array_NamedStructureBitPos 25 + +#define Array_NamedStructureBitSize 1 + +#define Array_NamedStructureBitMask 1 + +#define Array_Spare1Pos 24 + +#define Array_Spare1Size 1 + +#define Array_Spare1Mask 1 + +#define Array_LongPrefixBitPos 23 + +#define Array_LongPrefixBitSize 1 + +#define Array_LongPrefixBitMask 1 + +#define Array_LeaderLengthFieldPos 15 + +#define Array_LeaderLengthFieldSize 8 + +#define Array_LeaderLengthFieldMask 255 + +#define Array_LengthPos 0 + +#define Array_LengthSize 15 + +#define Array_LengthMask 32767 + +#define Array_DisplacedBitPos 14 + +#define Array_DisplacedBitSize 1 + +#define Array_DisplacedBitMask 1 + +#define Array_DiscontiguousBitPos 13 + +#define Array_DiscontinuousBitSize 1 + +#define Array_DiscontiguousBitMask 1 + +#define Array_LongSparePos 3 + +#define Array_LongSpareSize 12 + +#define Array_LongSpareMask 4095 + +#define Array_LongDimensionsFieldPos 0 + +#define Array_LongDimensionsFieldSize 3 + +#define Array_LongDimensionsFieldMask 7 + +#define Array_RegisterElementTypePos 30 + +#define Array_RegisterElementTypeSize 2 + +#define Array_RegisterElementTypeMask 3 + +#define Array_RegisterBytePackingPos 27 + +#define Array_RegisterBytePackingSize 3 + +#define Array_RegisterBytePackingMask 7 + +#define Array_RegisterByteOffsetPos 22 + +#define Array_RegisterByteOffsetSize 5 + +#define Array_RegisterByteOffsetMask 31 + +#define Array_RegisterEventCountPos 0 + +#define Array_RegisterEventCountSize 22 + +#define Array_RegisterEventCountMask 4194303 + +#define ValueDisposition_Effect 0 + +#define ValueDisposition_Value 1 + +#define ValueDisposition_Return 2 + +#define ValueDisposition_Multiple 3 + +#define Opcode_Car 0 + +#define Opcode_Cdr 1 + +#define Opcode_SetToCar 96 + +#define Opcode_SetToCdr 97 + +#define Opcode_SetToCdrPushCar 98 + +#define Opcode_Rplaca 128 + +#define Opcode_Rplacd 129 + +#define Opcode_Rgetf 149 + +#define Opcode_Member 150 + +#define Opcode_Assoc 151 + +#define Opcode_Dereference 11 + +#define Opcode_Unify 159 + +#define Opcode_PushLocalLogicVariables 67 + +#define Opcode_PushGlobalLogicVariable 45 + +#define Opcode_LogicTailTest 12 + +#define Opcode_Eq 184 + +#define Opcode_EqNoPop 188 + +#define Opcode_Eql 179 + +#define Opcode_EqlNoPop 183 + +#define Opcode_EqualNumber 176 + +#define Opcode_EqualNumberNoPop 180 + +#define Opcode_Greaterp 178 + +#define Opcode_GreaterpNoPop 182 + +#define Opcode_Lessp 177 + +#define Opcode_LesspNoPop 181 + +#define Opcode_Logtest 187 + +#define Opcode_LogtestNoPop 191 + +#define Opcode_TypeMember 32 + +#define Opcode_TypeMemberNoPop 36 + +#define Opcode_Endp 2 + +#define Opcode_Plusp 30 + +#define Opcode_Minusp 29 + +#define Opcode_Zerop 28 + +#define Opcode_Add 192 + +#define Opcode_Sub 193 + +#define Opcode_UnaryMinus 76 + +#define Opcode_Increment 99 + +#define Opcode_Decrement 100 + +#define Opcode_Multiply 130 + +#define Opcode_Quotient 131 + +#define Opcode_Ceiling 132 + +#define Opcode_Floor 133 + +#define Opcode_Truncate 134 + +#define Opcode_Round 135 + +#define Opcode_RationalQuotient 137 + +#define Opcode_Max 139 + +#define Opcode_Min 138 + +#define Opcode_Logand 141 + +#define Opcode_Logior 143 + +#define Opcode_Logxor 142 + +#define Opcode_Ash 154 + +#define Opcode_Rot 144 + +#define Opcode_Lsh 145 + +#define Opcode_32BitPlus 194 + +#define Opcode_32BitDifference 195 + +#define Opcode_MultiplyDouble 146 + +#define Opcode_AddBignumStep 196 + +#define Opcode_SubBignumStep 197 + +#define Opcode_MultiplyBignumStep 198 + +#define Opcode_DivideBignumStep 199 + +#define Opcode_LshcBignumStep 147 + +#define Opcode_DoubleFloatOp 14 + +#define Opcode_Push 64 + +#define Opcode_Pop 224 + +#define Opcode_Movem 225 + +#define Opcode_PushNNils 65 + +#define Opcode_PushAddress 104 + +#define Opcode_SetSpToAddress 105 + +#define Opcode_SetSpToAddressSaveTos 106 + +#define Opcode_PushAddressSpRelative 66 + +#define Opcode_StackBlt 148 + +#define Opcode_StackBltAddress 234 + +#define Opcode_Ldb 120 + +#define Opcode_Dpb 248 + +#define Opcode_CharLdb 121 + +#define Opcode_CharDpb 249 + +#define Opcode_PLdb 122 + +#define Opcode_PDpb 250 + +#define Opcode_PTagLdb 123 + +#define Opcode_PTagDpb 251 + +#define Opcode_Aref1 202 + +#define Opcode_Aset1 200 + +#define Opcode_Aloc1 203 + +#define Opcode_Setup1DArray 3 + +#define Opcode_SetupForce1DArray 4 + +#define Opcode_FastAref1 232 + +#define Opcode_FastAset1 233 + +#define Opcode_ArrayLeader 206 + +#define Opcode_StoreArrayLeader 204 + +#define Opcode_AlocLeader 207 + +#define Opcode_Branch 124 + +#define Opcode_BranchTrue 48 + +#define Opcode_BranchTrueElseExtraPop 49 + +#define Opcode_BranchTrueAndExtraPop 50 + +#define Opcode_BranchTrueExtraPop 51 + +#define Opcode_BranchTrueNoPop 52 + +#define Opcode_BranchTrueAndNoPop 53 + +#define Opcode_BranchTrueElseNoPop 54 + +#define Opcode_BranchTrueAndNoPopElseNoPopExtraPop 55 + +#define Opcode_BranchFalse 56 + +#define Opcode_BranchFalseElseExtraPop 57 + +#define Opcode_BranchFalseAndExtraPop 58 + +#define Opcode_BranchFalseExtraPop 59 + +#define Opcode_BranchFalseNoPop 60 + +#define Opcode_BranchFalseAndNoPop 61 + +#define Opcode_BranchFalseElseNoPop 62 + +#define Opcode_BranchFalseAndNoPopElseNoPopExtraPop 63 + +#define Opcode_LoopDecrementTos 125 + +#define Opcode_LoopIncrementTosLessThan 253 + +#define Opcode_Block0Read 80 + +#define Opcode_Block1Read 81 + +#define Opcode_Block2Read 82 + +#define Opcode_Block3Read 83 + +#define Opcode_Block0ReadShift 84 + +#define Opcode_Block1ReadShift 85 + +#define Opcode_Block2ReadShift 86 + +#define Opcode_Block3ReadShift 87 + +#define Opcode_Block0ReadAlu 112 + +#define Opcode_Block1ReadAlu 113 + +#define Opcode_Block2ReadAlu 114 + +#define Opcode_Block3ReadAlu 115 + +#define Opcode_Block0ReadTest 88 + +#define Opcode_Block1ReadTest 89 + +#define Opcode_Block2ReadTest 90 + +#define Opcode_Block3ReadTest 91 + +#define Opcode_Block0Write 24 + +#define Opcode_Block1Write 25 + +#define Opcode_Block2Write 26 + +#define Opcode_Block3Write 27 + +#define Opcode_StartCall 8 + +#define Opcode_FinishCallN 92 + +#define Opcode_FinishCallNApply 93 + +#define Opcode_FinishCallTos 94 + +#define Opcode_FinishCallTosApply 95 + +#define Opcode_EntryRestAccepted 126 + +#define Opcode_EntryRestNotAccepted 127 + +#define Opcode_LocateLocals 40 + +#define Opcode_ReturnSingle 77 + +#define Opcode_ReturnMultiple 68 + +#define Opcode_ReturnKludge 69 + +#define Opcode_TakeValues 70 + +#define Opcode_BindLocativeToValue 158 + +#define Opcode_BindLocative 5 + +#define Opcode_UnbindN 71 + +#define Opcode_RestoreBindingStack 6 + +#define Opcode_CatchOpen 254 + +#define Opcode_CatchClose 41 + +#define Opcode_PushLexicalVar 16 + +#define Opcode_PopLexicalVar 160 + +#define Opcode_MovemLexicalVar 168 + +#define Opcode_PushInstanceVariable 72 + +#define Opcode_PopInstanceVariable 208 + +#define Opcode_MovemInstanceVariable 209 + +#define Opcode_PushAddressInstanceVariable 73 + +#define Opcode_PushInstanceVariableOrdered 74 + +#define Opcode_PopInstanceVariableOrdered 210 + +#define Opcode_MovemInstanceVariableOrdered 211 + +#define Opcode_PushAddressInstanceVariableOrdered 75 + +#define Opcode_InstanceRef 212 + +#define Opcode_InstanceSet 213 + +#define Opcode_InstanceLoc 214 + +#define Opcode_Ephemeralp 7 + +#define Opcode_UnsignedLessp 217 + +#define Opcode_UnsignedLesspNoPop 221 + +#define Opcode_Alu 140 + +#define Opcode_AllocateListBlock 201 + +#define Opcode_AllocateStructureBlock 205 + +#define Opcode_PointerPlus 152 + +#define Opcode_PointerDifference 153 + +#define Opcode_PointerIncrement 101 + +#define Opcode_ReadInternalRegister 108 + +#define Opcode_WriteInternalRegister 109 + +#define Opcode_CoprocessorRead 110 + +#define Opcode_CoprocessorWrite 111 + +#define Opcode_MemoryRead 78 + +#define Opcode_MemoryReadAddress 79 + +#define Opcode_Tag 10 + +#define Opcode_SetTag 215 + +#define Opcode_StoreConditional 155 + +#define Opcode_MemoryWrite 156 + +#define Opcode_PStoreContents 157 + +#define Opcode_SetCdrCode1 102 + +#define Opcode_SetCdrCode2 103 + +#define Opcode_MergeCdrNoPop 226 + +#define Opcode_GenericDispatch 42 + +#define Opcode_MessageDispatch 43 + +#define Opcode_Jump 9 + +#define Opcode_CheckPreemptRequest 44 + +#define Opcode_NoOp 46 + +#define Opcode_Halt 47 + +#define Control_Apply 131072 + +#define Control_CleanupBits 117440512 + +#define Control_CallStarted 4194304 + +#define Control_ExtraArgument 256 + +#define Control_ArgumentSize 255 + +#define Control_CallerFrameSize 130560 + +#define Control_ValueDisposition 786432 + +#define InternalRegister_EA 0 + +#define InternalRegister_FP 1 + +#define InternalRegister_LP 2 + +#define InternalRegister_SP 3 + +#define InternalRegister_MacroSP 4 + +#define InternalRegister_StackCacheLowerBound 5 + +#define InternalRegister_BAR0 6 + +#define InternalRegister_BAR1 134 + +#define InternalRegister_BAR2 262 + +#define InternalRegister_BAR3 390 + +#define InternalRegister_PHTHash0 7 + +#define InternalRegister_PHTHash1 135 + +#define InternalRegister_PHTHash2 263 + +#define InternalRegister_PHTHash3 391 + +#define InternalRegister_EPC 8 + +#define InternalRegister_DPC 9 + +#define InternalRegister_Continuation 10 + +#define InternalRegister_AluAndRotateControl 11 + +#define InternalRegister_ControlRegister 12 + +#define InternalRegister_CRArgumentSize 13 + +#define InternalRegister_EphemeralOldspaceRegister 14 + +#define InternalRegister_ZoneOldspaceRegister 15 + +#define InternalRegister_ChipRevision 16 + +#define InternalRegister_FPCoprocessorPresent 17 + +#define InternalRegister_PreemptRegister 19 + +#define InternalRegister_IcacheControl 20 + +#define InternalRegister_PrefetcherControl 21 + +#define InternalRegister_MapCacheControl 22 + +#define InternalRegister_MemoryControl 23 + +#define InternalRegister_ECCLog 24 + +#define InternalRegister_ECCLogAddress 25 + +#define InternalRegister_InvalidateMap0 26 + +#define InternalRegister_InvalidateMap1 154 + +#define InternalRegister_InvalidateMap2 282 + +#define InternalRegister_InvalidateMap3 410 + +#define InternalRegister_LoadMap0 27 + +#define InternalRegister_LoadMap1 155 + +#define InternalRegister_LoadMap2 283 + +#define InternalRegister_LoadMap3 411 + +#define InternalRegister_StackCacheOverflowLimit 28 + +#define InternalRegister_UcodeROMContents 29 + +#define InternalRegister_AddressMask 31 + +#define InternalRegister_EntryMaximumArguments 32 + +#define InternalRegister_LexicalVariable 33 + +#define InternalRegister_Instruction 34 + +#define InternalRegister_MemoryData 36 + +#define InternalRegister_DataPins 37 + +#define InternalRegister_ExtensionRegister 38 + +#define InternalRegister_MicrosecondClock 39 + +#define InternalRegister_ArrayHeaderLength 40 + +#define InternalRegister_LoadBAR0 42 + +#define InternalRegister_LoadBAR1 170 + +#define InternalRegister_LoadBAR2 298 + +#define InternalRegister_LoadBAR3 426 + +#define InternalRegister_TOS 512 + +#define InternalRegister_EventCount 513 + +#define InternalRegister_BindingStackPointer 514 + +#define InternalRegister_CatchBlockList 515 + +#define InternalRegister_ControlStackLimit 516 + +#define InternalRegister_ControlStackExtraLimit 517 + +#define InternalRegister_BindingStackLimit 518 + +#define InternalRegister_PHTBase 519 + +#define InternalRegister_PHTMask 520 + +#define InternalRegister_CountMapReloads 521 + +#define InternalRegister_ListCacheArea 522 + +#define InternalRegister_ListCacheAddress 523 + +#define InternalRegister_ListCacheLength 524 + +#define InternalRegister_StructureCacheArea 525 + +#define InternalRegister_StructureCacheAddress 526 + +#define InternalRegister_StructureCacheLength 527 + +#define InternalRegister_DynamicBindingCacheBase 528 + +#define InternalRegister_DynamicBindingCacheMask 529 + +#define InternalRegister_ChoicePointer 530 + +#define InternalRegister_StructureStackChoicePointer 531 + +#define InternalRegister_FEPModeTrapVectorAddress 532 + +#define InternalRegister_MappingTableCache 534 + +#define InternalRegister_MappingTableLength 535 + +#define InternalRegister_StackFrameMaximumSize 536 + +#define InternalRegister_StackCacheDumpQuantum 537 + +#define InternalRegister_ConstantNIL 544 + +#define InternalRegister_ConstantT 545 + +#define CoprocessorRegister_MicrosecondClock 514 + +#define CoprocessorRegister_HostInterrupt 520 + +#define CoprocessorRegister_VMRegisterCommand 576 + +#define CoprocessorRegister_VMRegisterAddress 577 + +#define CoprocessorRegister_VMRegisterExtent 578 + +#define CoprocessorRegister_VMRegisterAttributes 579 + +#define CoprocessorRegister_VMRegisterDestination 580 + +#define CoprocessorRegister_VMRegisterData 581 + +#define CoprocessorRegister_VMRegisterMaskLow 582 + +#define CoprocessorRegister_VMRegisterMaskHigh 583 + +#define CoprocessorRegister_VMRegisterCommandBlock 584 + +#define CoprocessorRegister_StackSwitch 640 + +#define CoprocessorRegister_FlushStackCache 641 + +#define CoprocessorRegister_FlushIDCaches 642 + +#define CoprocessorRegister_CalendarClock 643 + +#define CoprocessorRegister_FlushCachesForVMA 644 + +#define CoprocessorRegister_FlipToStack 645 + +#define CoprocessorRegister_UnwindStackForRestartOrApply 646 + +#define CoprocessorRegister_SaveWorld 647 + +#define CoprocessorRegister_ConsoleInputAvailableP 648 + +#define CoprocessorRegister_WaitForEvent 649 + +#define CoprocessorRegister_FlushHiddenArrayRegisters 650 + +#define CoprocessorRegister_ConsoleIO 651 + +#define CoprocessorRegister_AttachDiskChannel 652 + +#define CoprocessorRegister_GrowDiskPartition 653 + +#define CoprocessorRegister_DetachDiskChannel 654 + +#define CoprocessorRegister_UnixCrypt 655 + +#define Address_NIL 4161016320 + +#define Address_T 4161016328 + +#define ALUCondition_SignedLessThanOrEqual 0 + +#define ALUCondition_SignedLessThan 1 + +#define ALUCondition_Negative 2 + +#define ALUCondition_SignedOverflow 3 + +#define ALUCondition_UnsignedLessThanOrEqual 4 + +#define ALUCondition_UnsignedLessThan 5 + +#define ALUCondition_Zero 6 + +#define ALUCondition_High25Zero 7 + +#define ALUCondition_Eq 8 + +#define ALUCondition_Op1Ephemeralp 9 + +#define ALUCondition_Op1TypeAcceptable 10 + +#define ALUCondition_Op1TypeCondition 11 + +#define ALUCondition_ResultTypeNil 12 + +#define ALUCondition_Op2Fixnum 13 + +#define ALUCondition_False 14 + +#define ALUCondition_ResultCdrLow 15 + +#define ALUCondition_CleanupBitsSet 16 + +#define ALUCondition_AddressInStackCache 17 + +#define ALUCondition_PendingSequenceBreakEnabled 18 + +#define ALUCondition_ExtraStackMode 19 + +#define ALUCondition_FepMode 20 + +#define ALUCondition_FpCoprocessorPresent 21 + +#define ALUCondition_Op1Oldspacep 22 + +#define ALUCondition_StackCacheOverflow 23 + +#define ALUCondition_OrLogicVariable 24 + +#define ALUAdderOp2_Op2 0 + +#define ALUAdderOp2_Zero 1 + +#define ALUAdderOp2_Invert 2 + +#define ALUAdderOp2_MinusOne 3 + +#define ALUByteFunction_Dpb 0 + +#define ALUByteFunction_Ldb 1 + +#define ALUByteBackground_Op1 0 + +#define ALUByteBackground_RotateLatch 1 + +#define ALUByteBackground_Zero 2 + +#define Boole_Clear 0 + +#define Boole_And 1 + +#define Boole_AndC1 2 + +#define Boole_2 3 + +#define Boole_AndC2 4 + +#define Boole_1 5 + +#define Boole_Xor 6 + +#define Boole_Ior 7 + +#define Boole_Nor 8 + +#define Boole_Equiv 9 + +#define Boole_C1 10 + +#define Boole_OrC1 11 + +#define Boole_C2 12 + +#define Boole_OrC2 13 + +#define Boole_Nand 14 + +#define Boole_Set 15 + +#define ALUFunction_Boolean 0 + +#define ALUFunction_Byte 1 + +#define ALUFunction_Adder 2 + +#define ALUFunction_MultiplyDivide 3 + +#define Cycle_DataRead 0 + +#define Cycle_DataWrite 1 + +#define Cycle_BindRead 2 + +#define Cycle_BindWrite 3 + +#define Cycle_BindReadNoMonitor 4 + +#define Cycle_BindWriteNoMonitor 5 + +#define Cycle_Header 6 + +#define Cycle_StructureOffset 7 + +#define Cycle_Scavenge 8 + +#define Cycle_Cdr 9 + +#define Cycle_GCCopy 10 + +#define Cycle_Raw 11 + +#define Cycle_RawTranslate 12 + +#define MemoryAction_None 0 + +#define MemoryAction_Indirect 1 + +#define MemoryAction_Monitor 2 + +#define MemoryAction_Transport 4 + +#define MemoryAction_Trap 8 + +#define MemoryAction_Transform 16 + +#define MemoryAction_Binding 32 + +#define TrapMode_Emulator 0 + +#define TrapMode_ExtraStack 1 + +#define TrapMode_IO 2 + +#define TrapMode_FEP 3 + +#define ReturnValue_Normal 0 + +#define ReturnValue_Exception 1 + +#define ReturnValue_IllegalOperand 2 + +#define HaltReason_IllInstn 1 + +#define HaltReason_Halted 2 + +#define HaltReason_SpyCalled 3 + +#define HaltReason_FatalStackOverflow 4 + +#define HaltReason_IllegalTrapVector 5 + +#define TrapReason_HighPrioritySequenceBreak 1 + +#define TrapReason_LowPrioritySequenceBreak 2 + +#define VMAttribute_AccessFault 1 + +#define VMAttribute_WriteFault 2 + +#define VMAttribute_TransportFault 4 + +#define VMAttribute_TransportDisable 8 + +#define VMAttribute_Ephemeral 16 + +#define VMAttribute_Modified 32 + +#define VMAttribute_Exists 64 + +#define VMAttribute_CreatedDefault 69 + +#define MemoryPage_Size 8192 + +#define MemoryPage_AddressShift 13 + +#define DoubleFloatOp_Add 0 + +#define DoubleFloatOp_Sub 1 + +#define DoubleFloatOp_Multiply 2 + +#define DoubleFloatOp_Divide 3 +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;aihead.sid Any changes made to it will be lost. */ + +#endif + + diff --git a/emulator/aihead.lisp b/emulator/aihead.lisp new file mode 100644 index 0000000..85a081e --- /dev/null +++ b/emulator/aihead.lisp @@ -0,0 +1,1615 @@ +;;; -*- Mode: LISP; Package: ALPHA-AXP-INTERNALS; Base: 10; Syntax: Common-Lisp; -*- +;;; +;;; WARNING!! DO NOT MODIFY THIS FILE! +;;; It was automatically generated from vlm:emulator;aihead.sid. Any changes made to it will be lost. + +#+Alpha-AXP-Emulator +(in-package "ALPHA-AXP-INTERNALS") + +#+PowerPC-Emulator +(in-package "POWERPC-INTERNALS") + +(defconstant |type|$k-|null| 0) +(defconstant |TypeNull| 0) + +(defconstant |type|$k-|monitorforward| 1) +(defconstant |TypeMonitorForward| 1) + +(defconstant |type|$k-|headerp| 2) +(defconstant |TypeHeaderP| 2) + +(defconstant |type|$k-|headeri| 3) +(defconstant |TypeHeaderI| 3) + +(defconstant |type|$k-|externalvaluecellpointer| 4) +(defconstant |TypeExternalValueCellPointer| 4) + +(defconstant |type|$k-|oneqforward| 5) +(defconstant |TypeOneQForward| 5) + +(defconstant |type|$k-|headerforward| 6) +(defconstant |TypeHeaderForward| 6) + +(defconstant |type|$k-|elementforward| 7) +(defconstant |TypeElementForward| 7) + +(defconstant |type|$k-|fixnum| 8) +(defconstant |TypeFixnum| 8) + +(defconstant |type|$k-|smallratio| 9) +(defconstant |TypeSmallRatio| 9) + +(defconstant |type|$k-|singlefloat| 10) +(defconstant |TypeSingleFloat| 10) + +(defconstant |type|$k-|doublefloat| 11) +(defconstant |TypeDoubleFloat| 11) + +(defconstant |type|$k-|bignum| 12) +(defconstant |TypeBignum| 12) + +(defconstant |type|$k-|bigratio| 13) +(defconstant |TypeBigRatio| 13) + +(defconstant |type|$k-|complex| 14) +(defconstant |TypeComplex| 14) + +(defconstant |type|$k-|sparenumber| 15) +(defconstant |TypeSpareNumber| 15) + +(defconstant |type|$k-|instance| 16) +(defconstant |TypeInstance| 16) + +(defconstant |type|$k-|listinstance| 17) +(defconstant |TypeListInstance| 17) + +(defconstant |type|$k-|arrayinstance| 18) +(defconstant |TypeArrayInstance| 18) + +(defconstant |type|$k-|stringinstance| 19) +(defconstant |TypeStringInstance| 19) + +(defconstant |type|$k-nil 20) +(defconstant |TypeNIL| 20) + +(defconstant |type|$k-|list| 21) +(defconstant |TypeList| 21) + +(defconstant |type|$k-|array| 22) +(defconstant |TypeArray| 22) + +(defconstant |type|$k-|string| 23) +(defconstant |TypeString| 23) + +(defconstant |type|$k-|symbol| 24) +(defconstant |TypeSymbol| 24) + +(defconstant |type|$k-|locative| 25) +(defconstant |TypeLocative| 25) + +(defconstant |type|$k-|lexicalclosure| 26) +(defconstant |TypeLexicalClosure| 26) + +(defconstant |type|$k-|dynamicclosure| 27) +(defconstant |TypeDynamicClosure| 27) + +(defconstant |type|$k-|compiledfunction| 28) +(defconstant |TypeCompiledFunction| 28) + +(defconstant |type|$k-|genericfunction| 29) +(defconstant |TypeGenericFunction| 29) + +(defconstant |type|$k-|sparepointer1| 30) +(defconstant |TypeSparePointer1| 30) + +(defconstant |type|$k-|sparepointer2| 31) +(defconstant |TypeSparePointer2| 31) + +(defconstant |type|$k-|physicaladdress| 32) +(defconstant |TypePhysicalAddress| 32) + +(defconstant |type|$k-|nativeinstruction| 33) +(defconstant |TypeNativeInstruction| 33) + +(defconstant |type|$k-|boundlocation| 34) +(defconstant |TypeBoundLocation| 34) + +(defconstant |type|$k-|character| 35) +(defconstant |TypeCharacter| 35) + +(defconstant |type|$k-|logicvariable| 36) +(defconstant |TypeLogicVariable| 36) + +(defconstant |type|$k-|gcforward| 37) +(defconstant |TypeGCForward| 37) + +(defconstant |type|$k-|evenpc| 38) +(defconstant |TypeEvenPC| 38) + +(defconstant |type|$k-|oddpc| 39) +(defconstant |TypeOddPC| 39) + +(defconstant |type|$k-|callcompiledeven| 40) +(defconstant |TypeCallCompiledEven| 40) + +(defconstant |type|$k-|callcompiledodd| 41) +(defconstant |TypeCallCompiledOdd| 41) + +(defconstant |type|$k-|callindirect| 42) +(defconstant |TypeCallIndirect| 42) + +(defconstant |type|$k-|callgeneric| 43) +(defconstant |TypeCallGeneric| 43) + +(defconstant |type|$k-|callcompiledevenprefetch| 44) +(defconstant |TypeCallCompiledEvenPrefetch| 44) + +(defconstant |type|$k-|callcompiledoddprefetch| 45) +(defconstant |TypeCallCompiledOddPrefetch| 45) + +(defconstant |type|$k-|callindirectprefetch| 46) +(defconstant |TypeCallIndirectPrefetch| 46) + +(defconstant |type|$k-|callgenericprefetch| 47) +(defconstant |TypeCallGenericPrefetch| 47) + +(defconstant |type|$k-|packedinstruction60| 48) +(defconstant |TypePackedInstruction60| 48) + +(defconstant |type|$k-|typepackedinstruction61| 49) +(defconstant |TypeTypePackedInstruction61| 49) + +(defconstant |type|$k-|typepackedinstruction62| 50) +(defconstant |TypeTypePackedInstruction62| 50) + +(defconstant |type|$k-|packedinstruction63| 51) +(defconstant |TypePackedInstruction63| 51) + +(defconstant |type|$k-|typepackedinstruction64| 52) +(defconstant |TypeTypePackedInstruction64| 52) + +(defconstant |type|$k-|typepackedinstruction65| 53) +(defconstant |TypeTypePackedInstruction65| 53) + +(defconstant |type|$k-|packedinstruction66| 54) +(defconstant |TypePackedInstruction66| 54) + +(defconstant |type|$k-|typepackedinstruction67| 55) +(defconstant |TypeTypePackedInstruction67| 55) + +(defconstant |type|$k-|typepackedinstruction70| 56) +(defconstant |TypeTypePackedInstruction70| 56) + +(defconstant |type|$k-|packedinstruction71| 57) +(defconstant |TypePackedInstruction71| 57) + +(defconstant |type|$k-|typepackedinstruction72| 58) +(defconstant |TypeTypePackedInstruction72| 58) + +(defconstant |type|$k-|typepackedinstruction73| 59) +(defconstant |TypeTypePackedInstruction73| 59) + +(defconstant |type|$k-|packedinstruction74| 60) +(defconstant |TypePackedInstruction74| 60) + +(defconstant |type|$k-|typepackedinstruction75| 61) +(defconstant |TypeTypePackedInstruction75| 61) + +(defconstant |type|$k-|typepackedinstruction76| 62) +(defconstant |TypeTypePackedInstruction76| 62) + +(defconstant |type|$k-|packedinstruction77| 63) +(defconstant |TypePackedInstruction77| 63) + +(defconstant |cdr|$k-|next| 0) +(defconstant |CdrNext| 0) + +(defconstant |cdr|$k-|nil| 1) +(defconstant |CdrNil| 1) + +(defconstant |cdr|$k-|normal| 2) +(defconstant |CdrNormal| 2) + +(defconstant |array|$k-|elementtypefixnum| 0) +(defconstant |ArrayElementTypeFixnum| 0) + +(defconstant |array|$k-|elementtypecharacter| 1) +(defconstant |ArrayElementTypeCharacter| 1) + +(defconstant |array|$k-|elementtypeboolean| 2) +(defconstant |ArrayElementTypeBoolean| 2) + +(defconstant |array|$k-|elementtypeobject| 3) +(defconstant |ArrayElementTypeObject| 3) + +(defconstant |array|$k-|typefieldpos| 26) +(defconstant |ArrayTypeFieldPos| 26) + +(defconstant |array|$k-|typefieldsize| 6) +(defconstant |ArrayTypeFieldSize| 6) + +(defconstant |array|$k-|typefieldmask| 63) +(defconstant |ArrayTypeFieldMask| 63) + +(defconstant |array|$k-|elementtypepos| 30) +(defconstant |ArrayElementTypePos| 30) + +(defconstant |array|$k-|elementtypesize| 2) +(defconstant |ArrayElementTypeSize| 2) + +(defconstant |array|$k-|elementtypemask| 3) +(defconstant |ArrayElementTypeMask| 3) + +(defconstant |array|$k-|bytepackingpos| 27) +(defconstant |ArrayBytePackingPos| 27) + +(defconstant |array|$k-|bytepackingsize| 3) +(defconstant |ArrayBytePackingSize| 3) + +(defconstant |array|$k-|bytepackingmask| 7) +(defconstant |ArrayBytePackingMask| 7) + +(defconstant |array|$k-|listbitpos| 26) +(defconstant |ArrayListBitPos| 26) + +(defconstant |array|$k-|listbitsize| 1) +(defconstant |ArrayListBitSize| 1) + +(defconstant |array|$k-|listbitmask| 1) +(defconstant |ArrayListBitMask| 1) + +(defconstant |array|$k-|namedstructurebitpos| 25) +(defconstant |ArrayNamedStructureBitPos| 25) + +(defconstant |array|$k-|namedstructurebitsize| 1) +(defconstant |ArrayNamedStructureBitSize| 1) + +(defconstant |array|$k-|namedstructurebitmask| 1) +(defconstant |ArrayNamedStructureBitMask| 1) + +(defconstant |array|$k-|spare1pos| 24) +(defconstant |ArraySpare1Pos| 24) + +(defconstant |array|$k-|spare1size| 1) +(defconstant |ArraySpare1Size| 1) + +(defconstant |array|$k-|spare1mask| 1) +(defconstant |ArraySpare1Mask| 1) + +(defconstant |array|$k-|longprefixbitpos| 23) +(defconstant |ArrayLongPrefixBitPos| 23) + +(defconstant |array|$k-|longprefixbitsize| 1) +(defconstant |ArrayLongPrefixBitSize| 1) + +(defconstant |array|$k-|longprefixbitmask| 1) +(defconstant |ArrayLongPrefixBitMask| 1) + +(defconstant |array|$k-|leaderlengthfieldpos| 15) +(defconstant |ArrayLeaderLengthFieldPos| 15) + +(defconstant |array|$k-|leaderlengthfieldsize| 8) +(defconstant |ArrayLeaderLengthFieldSize| 8) + +(defconstant |array|$k-|leaderlengthfieldmask| 255) +(defconstant |ArrayLeaderLengthFieldMask| 255) + +(defconstant |array|$k-|lengthpos| 0) +(defconstant |ArrayLengthPos| 0) + +(defconstant |array|$k-|lengthsize| 15) +(defconstant |ArrayLengthSize| 15) + +(defconstant |array|$k-|lengthmask| 32767) +(defconstant |ArrayLengthMask| 32767) + +(defconstant |array|$k-|displacedbitpos| 14) +(defconstant |ArrayDisplacedBitPos| 14) + +(defconstant |array|$k-|displacedbitsize| 1) +(defconstant |ArrayDisplacedBitSize| 1) + +(defconstant |array|$k-|displacedbitmask| 1) +(defconstant |ArrayDisplacedBitMask| 1) + +(defconstant |array|$k-|discontiguousbitpos| 13) +(defconstant |ArrayDiscontiguousBitPos| 13) + +(defconstant |array|$k-|discontinuousbitsize| 1) +(defconstant |ArrayDiscontinuousBitSize| 1) + +(defconstant |array|$k-|discontiguousbitmask| 1) +(defconstant |ArrayDiscontiguousBitMask| 1) + +(defconstant |array|$k-|longsparepos| 3) +(defconstant |ArrayLongSparePos| 3) + +(defconstant |array|$k-|longsparesize| 12) +(defconstant |ArrayLongSpareSize| 12) + +(defconstant |array|$k-|longsparemask| 4095) +(defconstant |ArrayLongSpareMask| 4095) + +(defconstant |array|$k-|longdimensionsfieldpos| 0) +(defconstant |ArrayLongDimensionsFieldPos| 0) + +(defconstant |array|$k-|longdimensionsfieldsize| 3) +(defconstant |ArrayLongDimensionsFieldSize| 3) + +(defconstant |array|$k-|longdimensionsfieldmask| 7) +(defconstant |ArrayLongDimensionsFieldMask| 7) + +(defconstant |array|$k-|registerelementtypepos| 30) +(defconstant |ArrayRegisterElementTypePos| 30) + +(defconstant |array|$k-|registerelementtypesize| 2) +(defconstant |ArrayRegisterElementTypeSize| 2) + +(defconstant |array|$k-|registerelementtypemask| 3) +(defconstant |ArrayRegisterElementTypeMask| 3) + +(defconstant |array|$k-|registerbytepackingpos| 27) +(defconstant |ArrayRegisterBytePackingPos| 27) + +(defconstant |array|$k-|registerbytepackingsize| 3) +(defconstant |ArrayRegisterBytePackingSize| 3) + +(defconstant |array|$k-|registerbytepackingmask| 7) +(defconstant |ArrayRegisterBytePackingMask| 7) + +(defconstant |array|$k-|registerbyteoffsetpos| 22) +(defconstant |ArrayRegisterByteOffsetPos| 22) + +(defconstant |array|$k-|registerbyteoffsetsize| 5) +(defconstant |ArrayRegisterByteOffsetSize| 5) + +(defconstant |array|$k-|registerbyteoffsetmask| 31) +(defconstant |ArrayRegisterByteOffsetMask| 31) + +(defconstant |array|$k-|registereventcountpos| 0) +(defconstant |ArrayRegisterEventCountPos| 0) + +(defconstant |array|$k-|registereventcountsize| 22) +(defconstant |ArrayRegisterEventCountSize| 22) + +(defconstant |array|$k-|registereventcountmask| 4194303) +(defconstant |ArrayRegisterEventCountMask| 4194303) + +(defconstant |valuedisposition|$k-|effect| 0) +(defconstant |ValueDispositionEffect| 0) + +(defconstant |valuedisposition|$k-|value| 1) +(defconstant |ValueDispositionValue| 1) + +(defconstant |valuedisposition|$k-|return| 2) +(defconstant |ValueDispositionReturn| 2) + +(defconstant |valuedisposition|$k-|multiple| 3) +(defconstant |ValueDispositionMultiple| 3) + +(defconstant |opcode|$k-|car| 0) +(defconstant |OpcodeCar| 0) + +(defconstant |opcode|$k-|cdr| 1) +(defconstant |OpcodeCdr| 1) + +(defconstant |opcode|$k-|settocar| 96) +(defconstant |OpcodeSetToCar| 96) + +(defconstant |opcode|$k-|settocdr| 97) +(defconstant |OpcodeSetToCdr| 97) + +(defconstant |opcode|$k-|settocdrpushcar| 98) +(defconstant |OpcodeSetToCdrPushCar| 98) + +(defconstant |opcode|$k-|rplaca| 128) +(defconstant |OpcodeRplaca| 128) + +(defconstant |opcode|$k-|rplacd| 129) +(defconstant |OpcodeRplacd| 129) + +(defconstant |opcode|$k-|rgetf| 149) +(defconstant |OpcodeRgetf| 149) + +(defconstant |opcode|$k-|member| 150) +(defconstant |OpcodeMember| 150) + +(defconstant |opcode|$k-|assoc| 151) +(defconstant |OpcodeAssoc| 151) + +(defconstant |opcode|$k-|dereference| 11) +(defconstant |OpcodeDereference| 11) + +(defconstant |opcode|$k-|unify| 159) +(defconstant |OpcodeUnify| 159) + +(defconstant |opcode|$k-|pushlocallogicvariables| 67) +(defconstant |OpcodePushLocalLogicVariables| 67) + +(defconstant |opcode|$k-|pushgloballogicvariable| 45) +(defconstant |OpcodePushGlobalLogicVariable| 45) + +(defconstant |opcode|$k-|logictailtest| 12) +(defconstant |OpcodeLogicTailTest| 12) + +(defconstant |opcode|$k-|eq| 184) +(defconstant |OpcodeEq| 184) + +(defconstant |opcode|$k-|eqnopop| 188) +(defconstant |OpcodeEqNoPop| 188) + +(defconstant |opcode|$k-|eql| 179) +(defconstant |OpcodeEql| 179) + +(defconstant |opcode|$k-|eqlnopop| 183) +(defconstant |OpcodeEqlNoPop| 183) + +(defconstant |opcode|$k-|equalnumber| 176) +(defconstant |OpcodeEqualNumber| 176) + +(defconstant |opcode|$k-|equalnumbernopop| 180) +(defconstant |OpcodeEqualNumberNoPop| 180) + +(defconstant |opcode|$k-|greaterp| 178) +(defconstant |OpcodeGreaterp| 178) + +(defconstant |opcode|$k-|greaterpnopop| 182) +(defconstant |OpcodeGreaterpNoPop| 182) + +(defconstant |opcode|$k-|lessp| 177) +(defconstant |OpcodeLessp| 177) + +(defconstant |opcode|$k-|lesspnopop| 181) +(defconstant |OpcodeLesspNoPop| 181) + +(defconstant |opcode|$k-|logtest| 187) +(defconstant |OpcodeLogtest| 187) + +(defconstant |opcode|$k-|logtestnopop| 191) +(defconstant |OpcodeLogtestNoPop| 191) + +(defconstant |opcode|$k-|typemember| 32) +(defconstant |OpcodeTypeMember| 32) + +(defconstant |opcode|$k-|typemembernopop| 36) +(defconstant |OpcodeTypeMemberNoPop| 36) + +(defconstant |opcode|$k-|endp| 2) +(defconstant |OpcodeEndp| 2) + +(defconstant |opcode|$k-|plusp| 30) +(defconstant |OpcodePlusp| 30) + +(defconstant |opcode|$k-|minusp| 29) +(defconstant |OpcodeMinusp| 29) + +(defconstant |opcode|$k-|zerop| 28) +(defconstant |OpcodeZerop| 28) + +(defconstant |opcode|$k-|add| 192) +(defconstant |OpcodeAdd| 192) + +(defconstant |opcode|$k-|sub| 193) +(defconstant |OpcodeSub| 193) + +(defconstant |opcode|$k-|unaryminus| 76) +(defconstant |OpcodeUnaryMinus| 76) + +(defconstant |opcode|$k-|increment| 99) +(defconstant |OpcodeIncrement| 99) + +(defconstant |opcode|$k-|decrement| 100) +(defconstant |OpcodeDecrement| 100) + +(defconstant |opcode|$k-|multiply| 130) +(defconstant |OpcodeMultiply| 130) + +(defconstant |opcode|$k-|quotient| 131) +(defconstant |OpcodeQuotient| 131) + +(defconstant |opcode|$k-|ceiling| 132) +(defconstant |OpcodeCeiling| 132) + +(defconstant |opcode|$k-|floor| 133) +(defconstant |OpcodeFloor| 133) + +(defconstant |opcode|$k-|truncate| 134) +(defconstant |OpcodeTruncate| 134) + +(defconstant |opcode|$k-|round| 135) +(defconstant |OpcodeRound| 135) + +(defconstant |opcode|$k-|rationalquotient| 137) +(defconstant |OpcodeRationalQuotient| 137) + +(defconstant |opcode|$k-|max| 139) +(defconstant |OpcodeMax| 139) + +(defconstant |opcode|$k-|min| 138) +(defconstant |OpcodeMin| 138) + +(defconstant |opcode|$k-|logand| 141) +(defconstant |OpcodeLogand| 141) + +(defconstant |opcode|$k-|logior| 143) +(defconstant |OpcodeLogior| 143) + +(defconstant |opcode|$k-|logxor| 142) +(defconstant |OpcodeLogxor| 142) + +(defconstant |opcode|$k-|ash| 154) +(defconstant |OpcodeAsh| 154) + +(defconstant |opcode|$k-|rot| 144) +(defconstant |OpcodeRot| 144) + +(defconstant |opcode|$k-|lsh| 145) +(defconstant |OpcodeLsh| 145) + +(defconstant |opcode|$k-|32bitplus| 194) +(defconstant |Opcode32BitPlus| 194) + +(defconstant |opcode|$k-|32bitdifference| 195) +(defconstant |Opcode32BitDifference| 195) + +(defconstant |opcode|$k-|multiplydouble| 146) +(defconstant |OpcodeMultiplyDouble| 146) + +(defconstant |opcode|$k-|addbignumstep| 196) +(defconstant |OpcodeAddBignumStep| 196) + +(defconstant |opcode|$k-|subbignumstep| 197) +(defconstant |OpcodeSubBignumStep| 197) + +(defconstant |opcode|$k-|multiplybignumstep| 198) +(defconstant |OpcodeMultiplyBignumStep| 198) + +(defconstant |opcode|$k-|dividebignumstep| 199) +(defconstant |OpcodeDivideBignumStep| 199) + +(defconstant |opcode|$k-|lshcbignumstep| 147) +(defconstant |OpcodeLshcBignumStep| 147) + +(defconstant |opcode|$k-|doublefloatop| 14) +(defconstant |OpcodeDoubleFloatOp| 14) + +(defconstant |opcode|$k-|push| 64) +(defconstant |OpcodePush| 64) + +(defconstant |opcode|$k-|pop| 224) +(defconstant |OpcodePop| 224) + +(defconstant |opcode|$k-|movem| 225) +(defconstant |OpcodeMovem| 225) + +(defconstant |opcode|$k-|pushnnils| 65) +(defconstant |OpcodePushNNils| 65) + +(defconstant |opcode|$k-|pushaddress| 104) +(defconstant |OpcodePushAddress| 104) + +(defconstant |opcode|$k-|setsptoaddress| 105) +(defconstant |OpcodeSetSpToAddress| 105) + +(defconstant |opcode|$k-|setsptoaddresssavetos| 106) +(defconstant |OpcodeSetSpToAddressSaveTos| 106) + +(defconstant |opcode|$k-|pushaddresssprelative| 66) +(defconstant |OpcodePushAddressSpRelative| 66) + +(defconstant |opcode|$k-|stackblt| 148) +(defconstant |OpcodeStackBlt| 148) + +(defconstant |opcode|$k-|stackbltaddress| 234) +(defconstant |OpcodeStackBltAddress| 234) + +(defconstant |opcode|$k-|ldb| 120) +(defconstant |OpcodeLdb| 120) + +(defconstant |opcode|$k-|dpb| 248) +(defconstant |OpcodeDpb| 248) + +(defconstant |opcode|$k-|charldb| 121) +(defconstant |OpcodeCharLdb| 121) + +(defconstant |opcode|$k-|chardpb| 249) +(defconstant |OpcodeCharDpb| 249) + +(defconstant |opcode|$k-|pldb| 122) +(defconstant |OpcodePLdb| 122) + +(defconstant |opcode|$k-|pdpb| 250) +(defconstant |OpcodePDpb| 250) + +(defconstant |opcode|$k-|ptagldb| 123) +(defconstant |OpcodePTagLdb| 123) + +(defconstant |opcode|$k-|ptagdpb| 251) +(defconstant |OpcodePTagDpb| 251) + +(defconstant |opcode|$k-|aref1| 202) +(defconstant |OpcodeAref1| 202) + +(defconstant |opcode|$k-|aset1| 200) +(defconstant |OpcodeAset1| 200) + +(defconstant |opcode|$k-|aloc1| 203) +(defconstant |OpcodeAloc1| 203) + +(defconstant |opcode|$k-|setup1darray| 3) +(defconstant |OpcodeSetup1DArray| 3) + +(defconstant |opcode|$k-|setupforce1darray| 4) +(defconstant |OpcodeSetupForce1DArray| 4) + +(defconstant |opcode|$k-|fastaref1| 232) +(defconstant |OpcodeFastAref1| 232) + +(defconstant |opcode|$k-|fastaset1| 233) +(defconstant |OpcodeFastAset1| 233) + +(defconstant |opcode|$k-|arrayleader| 206) +(defconstant |OpcodeArrayLeader| 206) + +(defconstant |opcode|$k-|storearrayleader| 204) +(defconstant |OpcodeStoreArrayLeader| 204) + +(defconstant |opcode|$k-|alocleader| 207) +(defconstant |OpcodeAlocLeader| 207) + +(defconstant |opcode|$k-|branch| 124) +(defconstant |OpcodeBranch| 124) + +(defconstant |opcode|$k-|branchtrue| 48) +(defconstant |OpcodeBranchTrue| 48) + +(defconstant |opcode|$k-|branchtrueelseextrapop| 49) +(defconstant |OpcodeBranchTrueElseExtraPop| 49) + +(defconstant |opcode|$k-|branchtrueandextrapop| 50) +(defconstant |OpcodeBranchTrueAndExtraPop| 50) + +(defconstant |opcode|$k-|branchtrueextrapop| 51) +(defconstant |OpcodeBranchTrueExtraPop| 51) + +(defconstant |opcode|$k-|branchtruenopop| 52) +(defconstant |OpcodeBranchTrueNoPop| 52) + +(defconstant |opcode|$k-|branchtrueandnopop| 53) +(defconstant |OpcodeBranchTrueAndNoPop| 53) + +(defconstant |opcode|$k-|branchtrueelsenopop| 54) +(defconstant |OpcodeBranchTrueElseNoPop| 54) + +(defconstant |opcode|$k-|branchtrueandnopopelsenopopextrapop| 55) +(defconstant |OpcodeBranchTrueAndNoPopElseNoPopExtraPop| 55) + +(defconstant |opcode|$k-|branchfalse| 56) +(defconstant |OpcodeBranchFalse| 56) + +(defconstant |opcode|$k-|branchfalseelseextrapop| 57) +(defconstant |OpcodeBranchFalseElseExtraPop| 57) + +(defconstant |opcode|$k-|branchfalseandextrapop| 58) +(defconstant |OpcodeBranchFalseAndExtraPop| 58) + +(defconstant |opcode|$k-|branchfalseextrapop| 59) +(defconstant |OpcodeBranchFalseExtraPop| 59) + +(defconstant |opcode|$k-|branchfalsenopop| 60) +(defconstant |OpcodeBranchFalseNoPop| 60) + +(defconstant |opcode|$k-|branchfalseandnopop| 61) +(defconstant |OpcodeBranchFalseAndNoPop| 61) + +(defconstant |opcode|$k-|branchfalseelsenopop| 62) +(defconstant |OpcodeBranchFalseElseNoPop| 62) + +(defconstant |opcode|$k-|branchfalseandnopopelsenopopextrapop| 63) +(defconstant |OpcodeBranchFalseAndNoPopElseNoPopExtraPop| 63) + +(defconstant |opcode|$k-|loopdecrementtos| 125) +(defconstant |OpcodeLoopDecrementTos| 125) + +(defconstant |opcode|$k-|loopincrementtoslessthan| 253) +(defconstant |OpcodeLoopIncrementTosLessThan| 253) + +(defconstant |opcode|$k-|block0read| 80) +(defconstant |OpcodeBlock0Read| 80) + +(defconstant |opcode|$k-|block1read| 81) +(defconstant |OpcodeBlock1Read| 81) + +(defconstant |opcode|$k-|block2read| 82) +(defconstant |OpcodeBlock2Read| 82) + +(defconstant |opcode|$k-|block3read| 83) +(defconstant |OpcodeBlock3Read| 83) + +(defconstant |opcode|$k-|block0readshift| 84) +(defconstant |OpcodeBlock0ReadShift| 84) + +(defconstant |opcode|$k-|block1readshift| 85) +(defconstant |OpcodeBlock1ReadShift| 85) + +(defconstant |opcode|$k-|block2readshift| 86) +(defconstant |OpcodeBlock2ReadShift| 86) + +(defconstant |opcode|$k-|block3readshift| 87) +(defconstant |OpcodeBlock3ReadShift| 87) + +(defconstant |opcode|$k-|block0readalu| 112) +(defconstant |OpcodeBlock0ReadAlu| 112) + +(defconstant |opcode|$k-|block1readalu| 113) +(defconstant |OpcodeBlock1ReadAlu| 113) + +(defconstant |opcode|$k-|block2readalu| 114) +(defconstant |OpcodeBlock2ReadAlu| 114) + +(defconstant |opcode|$k-|block3readalu| 115) +(defconstant |OpcodeBlock3ReadAlu| 115) + +(defconstant |opcode|$k-|block0readtest| 88) +(defconstant |OpcodeBlock0ReadTest| 88) + +(defconstant |opcode|$k-|block1readtest| 89) +(defconstant |OpcodeBlock1ReadTest| 89) + +(defconstant |opcode|$k-|block2readtest| 90) +(defconstant |OpcodeBlock2ReadTest| 90) + +(defconstant |opcode|$k-|block3readtest| 91) +(defconstant |OpcodeBlock3ReadTest| 91) + +(defconstant |opcode|$k-|block0write| 24) +(defconstant |OpcodeBlock0Write| 24) + +(defconstant |opcode|$k-|block1write| 25) +(defconstant |OpcodeBlock1Write| 25) + +(defconstant |opcode|$k-|block2write| 26) +(defconstant |OpcodeBlock2Write| 26) + +(defconstant |opcode|$k-|block3write| 27) +(defconstant |OpcodeBlock3Write| 27) + +(defconstant |opcode|$k-|startcall| 8) +(defconstant |OpcodeStartCall| 8) + +(defconstant |opcode|$k-|finishcalln| 92) +(defconstant |OpcodeFinishCallN| 92) + +(defconstant |opcode|$k-|finishcallnapply| 93) +(defconstant |OpcodeFinishCallNApply| 93) + +(defconstant |opcode|$k-|finishcalltos| 94) +(defconstant |OpcodeFinishCallTos| 94) + +(defconstant |opcode|$k-|finishcalltosapply| 95) +(defconstant |OpcodeFinishCallTosApply| 95) + +(defconstant |opcode|$k-|entryrestaccepted| 126) +(defconstant |OpcodeEntryRestAccepted| 126) + +(defconstant |opcode|$k-|entryrestnotaccepted| 127) +(defconstant |OpcodeEntryRestNotAccepted| 127) + +(defconstant |opcode|$k-|locatelocals| 40) +(defconstant |OpcodeLocateLocals| 40) + +(defconstant |opcode|$k-|returnsingle| 77) +(defconstant |OpcodeReturnSingle| 77) + +(defconstant |opcode|$k-|returnmultiple| 68) +(defconstant |OpcodeReturnMultiple| 68) + +(defconstant |opcode|$k-|returnkludge| 69) +(defconstant |OpcodeReturnKludge| 69) + +(defconstant |opcode|$k-|takevalues| 70) +(defconstant |OpcodeTakeValues| 70) + +(defconstant |opcode|$k-|bindlocativetovalue| 158) +(defconstant |OpcodeBindLocativeToValue| 158) + +(defconstant |opcode|$k-|bindlocative| 5) +(defconstant |OpcodeBindLocative| 5) + +(defconstant |opcode|$k-|unbindn| 71) +(defconstant |OpcodeUnbindN| 71) + +(defconstant |opcode|$k-|restorebindingstack| 6) +(defconstant |OpcodeRestoreBindingStack| 6) + +(defconstant |opcode|$k-|catchopen| 254) +(defconstant |OpcodeCatchOpen| 254) + +(defconstant |opcode|$k-|catchclose| 41) +(defconstant |OpcodeCatchClose| 41) + +(defconstant |opcode|$k-|pushlexicalvar| 16) +(defconstant |OpcodePushLexicalVar| 16) + +(defconstant |opcode|$k-|poplexicalvar| 160) +(defconstant |OpcodePopLexicalVar| 160) + +(defconstant |opcode|$k-|movemlexicalvar| 168) +(defconstant |OpcodeMovemLexicalVar| 168) + +(defconstant |opcode|$k-|pushinstancevariable| 72) +(defconstant |OpcodePushInstanceVariable| 72) + +(defconstant |opcode|$k-|popinstancevariable| 208) +(defconstant |OpcodePopInstanceVariable| 208) + +(defconstant |opcode|$k-|moveminstancevariable| 209) +(defconstant |OpcodeMovemInstanceVariable| 209) + +(defconstant |opcode|$k-|pushaddressinstancevariable| 73) +(defconstant |OpcodePushAddressInstanceVariable| 73) + +(defconstant |opcode|$k-|pushinstancevariableordered| 74) +(defconstant |OpcodePushInstanceVariableOrdered| 74) + +(defconstant |opcode|$k-|popinstancevariableordered| 210) +(defconstant |OpcodePopInstanceVariableOrdered| 210) + +(defconstant |opcode|$k-|moveminstancevariableordered| 211) +(defconstant |OpcodeMovemInstanceVariableOrdered| 211) + +(defconstant |opcode|$k-|pushaddressinstancevariableordered| 75) +(defconstant |OpcodePushAddressInstanceVariableOrdered| 75) + +(defconstant |opcode|$k-|instanceref| 212) +(defconstant |OpcodeInstanceRef| 212) + +(defconstant |opcode|$k-|instanceset| 213) +(defconstant |OpcodeInstanceSet| 213) + +(defconstant |opcode|$k-|instanceloc| 214) +(defconstant |OpcodeInstanceLoc| 214) + +(defconstant |opcode|$k-|ephemeralp| 7) +(defconstant |OpcodeEphemeralp| 7) + +(defconstant |opcode|$k-|unsignedlessp| 217) +(defconstant |OpcodeUnsignedLessp| 217) + +(defconstant |opcode|$k-|unsignedlesspnopop| 221) +(defconstant |OpcodeUnsignedLesspNoPop| 221) + +(defconstant |opcode|$k-|alu| 140) +(defconstant |OpcodeAlu| 140) + +(defconstant |opcode|$k-|allocatelistblock| 201) +(defconstant |OpcodeAllocateListBlock| 201) + +(defconstant |opcode|$k-|allocatestructureblock| 205) +(defconstant |OpcodeAllocateStructureBlock| 205) + +(defconstant |opcode|$k-|pointerplus| 152) +(defconstant |OpcodePointerPlus| 152) + +(defconstant |opcode|$k-|pointerdifference| 153) +(defconstant |OpcodePointerDifference| 153) + +(defconstant |opcode|$k-|pointerincrement| 101) +(defconstant |OpcodePointerIncrement| 101) + +(defconstant |opcode|$k-|readinternalregister| 108) +(defconstant |OpcodeReadInternalRegister| 108) + +(defconstant |opcode|$k-|writeinternalregister| 109) +(defconstant |OpcodeWriteInternalRegister| 109) + +(defconstant |opcode|$k-|coprocessorread| 110) +(defconstant |OpcodeCoprocessorRead| 110) + +(defconstant |opcode|$k-|coprocessorwrite| 111) +(defconstant |OpcodeCoprocessorWrite| 111) + +(defconstant |opcode|$k-|memoryread| 78) +(defconstant |OpcodeMemoryRead| 78) + +(defconstant |opcode|$k-|memoryreadaddress| 79) +(defconstant |OpcodeMemoryReadAddress| 79) + +(defconstant |opcode|$k-|tag| 10) +(defconstant |OpcodeTag| 10) + +(defconstant |opcode|$k-|settag| 215) +(defconstant |OpcodeSetTag| 215) + +(defconstant |opcode|$k-|storeconditional| 155) +(defconstant |OpcodeStoreConditional| 155) + +(defconstant |opcode|$k-|memorywrite| 156) +(defconstant |OpcodeMemoryWrite| 156) + +(defconstant |opcode|$k-|pstorecontents| 157) +(defconstant |OpcodePStoreContents| 157) + +(defconstant |opcode|$k-|setcdrcode1| 102) +(defconstant |OpcodeSetCdrCode1| 102) + +(defconstant |opcode|$k-|setcdrcode2| 103) +(defconstant |OpcodeSetCdrCode2| 103) + +(defconstant |opcode|$k-|mergecdrnopop| 226) +(defconstant |OpcodeMergeCdrNoPop| 226) + +(defconstant |opcode|$k-|genericdispatch| 42) +(defconstant |OpcodeGenericDispatch| 42) + +(defconstant |opcode|$k-|messagedispatch| 43) +(defconstant |OpcodeMessageDispatch| 43) + +(defconstant |opcode|$k-|jump| 9) +(defconstant |OpcodeJump| 9) + +(defconstant |opcode|$k-|checkpreemptrequest| 44) +(defconstant |OpcodeCheckPreemptRequest| 44) + +(defconstant |opcode|$k-|noop| 46) +(defconstant |OpcodeNoOp| 46) + +(defconstant |opcode|$k-|halt| 47) +(defconstant |OpcodeHalt| 47) + +(defconstant |control|$k-|apply| 131072) +(defconstant |ControlApply| 131072) + +(defconstant |control|$k-|cleanupbits| 117440512) +(defconstant |ControlCleanupBits| 117440512) + +(defconstant |control|$k-|callstarted| 4194304) +(defconstant |ControlCallStarted| 4194304) + +(defconstant |control|$k-|extraargument| 256) +(defconstant |ControlExtraArgument| 256) + +(defconstant |control|$k-|argumentsize| 255) +(defconstant |ControlArgumentSize| 255) + +(defconstant |control|$k-|callerframesize| 130560) +(defconstant |ControlCallerFrameSize| 130560) + +(defconstant |control|$k-|valuedisposition| 786432) +(defconstant |ControlValueDisposition| 786432) + +(defconstant |internalregister|$k-ea 0) +(defconstant |InternalRegisterEA| 0) + +(defconstant |internalregister|$k-fp 1) +(defconstant |InternalRegisterFP| 1) + +(defconstant |internalregister|$k-lp 2) +(defconstant |InternalRegisterLP| 2) + +(defconstant |internalregister|$k-sp 3) +(defconstant |InternalRegisterSP| 3) + +(defconstant |internalregister|$k-|macrosp| 4) +(defconstant |InternalRegisterMacroSP| 4) + +(defconstant |internalregister|$k-|stackcachelowerbound| 5) +(defconstant |InternalRegisterStackCacheLowerBound| 5) + +(defconstant |internalregister|$k-bar0 6) +(defconstant |InternalRegisterBAR0| 6) + +(defconstant |internalregister|$k-bar1 134) +(defconstant |InternalRegisterBAR1| 134) + +(defconstant |internalregister|$k-bar2 262) +(defconstant |InternalRegisterBAR2| 262) + +(defconstant |internalregister|$k-bar3 390) +(defconstant |InternalRegisterBAR3| 390) + +(defconstant |internalregister|$k-|phthash0| 7) +(defconstant |InternalRegisterPHTHash0| 7) + +(defconstant |internalregister|$k-|phthash1| 135) +(defconstant |InternalRegisterPHTHash1| 135) + +(defconstant |internalregister|$k-|phthash2| 263) +(defconstant |InternalRegisterPHTHash2| 263) + +(defconstant |internalregister|$k-|phthash3| 391) +(defconstant |InternalRegisterPHTHash3| 391) + +(defconstant |internalregister|$k-epc 8) +(defconstant |InternalRegisterEPC| 8) + +(defconstant |internalregister|$k-dpc 9) +(defconstant |InternalRegisterDPC| 9) + +(defconstant |internalregister|$k-|continuation| 10) +(defconstant |InternalRegisterContinuation| 10) + +(defconstant |internalregister|$k-|aluandrotatecontrol| 11) +(defconstant |InternalRegisterAluAndRotateControl| 11) + +(defconstant |internalregister|$k-|controlregister| 12) +(defconstant |InternalRegisterControlRegister| 12) + +(defconstant |internalregister|$k-|crargumentsize| 13) +(defconstant |InternalRegisterCRArgumentSize| 13) + +(defconstant |internalregister|$k-|ephemeraloldspaceregister| 14) +(defconstant |InternalRegisterEphemeralOldspaceRegister| 14) + +(defconstant |internalregister|$k-|zoneoldspaceregister| 15) +(defconstant |InternalRegisterZoneOldspaceRegister| 15) + +(defconstant |internalregister|$k-|chiprevision| 16) +(defconstant |InternalRegisterChipRevision| 16) + +(defconstant |internalregister|$k-|fpcoprocessorpresent| 17) +(defconstant |InternalRegisterFPCoprocessorPresent| 17) + +(defconstant |internalregister|$k-|preemptregister| 19) +(defconstant |InternalRegisterPreemptRegister| 19) + +(defconstant |internalregister|$k-|icachecontrol| 20) +(defconstant |InternalRegisterIcacheControl| 20) + +(defconstant |internalregister|$k-|prefetchercontrol| 21) +(defconstant |InternalRegisterPrefetcherControl| 21) + +(defconstant |internalregister|$k-|mapcachecontrol| 22) +(defconstant |InternalRegisterMapCacheControl| 22) + +(defconstant |internalregister|$k-|memorycontrol| 23) +(defconstant |InternalRegisterMemoryControl| 23) + +(defconstant |internalregister|$k-|ecclog| 24) +(defconstant |InternalRegisterECCLog| 24) + +(defconstant |internalregister|$k-|ecclogaddress| 25) +(defconstant |InternalRegisterECCLogAddress| 25) + +(defconstant |internalregister|$k-|invalidatemap0| 26) +(defconstant |InternalRegisterInvalidateMap0| 26) + +(defconstant |internalregister|$k-|invalidatemap1| 154) +(defconstant |InternalRegisterInvalidateMap1| 154) + +(defconstant |internalregister|$k-|invalidatemap2| 282) +(defconstant |InternalRegisterInvalidateMap2| 282) + +(defconstant |internalregister|$k-|invalidatemap3| 410) +(defconstant |InternalRegisterInvalidateMap3| 410) + +(defconstant |internalregister|$k-|loadmap0| 27) +(defconstant |InternalRegisterLoadMap0| 27) + +(defconstant |internalregister|$k-|loadmap1| 155) +(defconstant |InternalRegisterLoadMap1| 155) + +(defconstant |internalregister|$k-|loadmap2| 283) +(defconstant |InternalRegisterLoadMap2| 283) + +(defconstant |internalregister|$k-|loadmap3| 411) +(defconstant |InternalRegisterLoadMap3| 411) + +(defconstant |internalregister|$k-|stackcacheoverflowlimit| 28) +(defconstant |InternalRegisterStackCacheOverflowLimit| 28) + +(defconstant |internalregister|$k-|ucoderomcontents| 29) +(defconstant |InternalRegisterUcodeROMContents| 29) + +(defconstant |internalregister|$k-|addressmask| 31) +(defconstant |InternalRegisterAddressMask| 31) + +(defconstant |internalregister|$k-|entrymaximumarguments| 32) +(defconstant |InternalRegisterEntryMaximumArguments| 32) + +(defconstant |internalregister|$k-|lexicalvariable| 33) +(defconstant |InternalRegisterLexicalVariable| 33) + +(defconstant |internalregister|$k-|instruction| 34) +(defconstant |InternalRegisterInstruction| 34) + +(defconstant |internalregister|$k-|memorydata| 36) +(defconstant |InternalRegisterMemoryData| 36) + +(defconstant |internalregister|$k-|datapins| 37) +(defconstant |InternalRegisterDataPins| 37) + +(defconstant |internalregister|$k-|extensionregister| 38) +(defconstant |InternalRegisterExtensionRegister| 38) + +(defconstant |internalregister|$k-|microsecondclock| 39) +(defconstant |InternalRegisterMicrosecondClock| 39) + +(defconstant |internalregister|$k-|arrayheaderlength| 40) +(defconstant |InternalRegisterArrayHeaderLength| 40) + +(defconstant |internalregister|$k-|loadbar0| 42) +(defconstant |InternalRegisterLoadBAR0| 42) + +(defconstant |internalregister|$k-|loadbar1| 170) +(defconstant |InternalRegisterLoadBAR1| 170) + +(defconstant |internalregister|$k-|loadbar2| 298) +(defconstant |InternalRegisterLoadBAR2| 298) + +(defconstant |internalregister|$k-|loadbar3| 426) +(defconstant |InternalRegisterLoadBAR3| 426) + +(defconstant |internalregister|$k-tos 512) +(defconstant |InternalRegisterTOS| 512) + +(defconstant |internalregister|$k-|eventcount| 513) +(defconstant |InternalRegisterEventCount| 513) + +(defconstant |internalregister|$k-|bindingstackpointer| 514) +(defconstant |InternalRegisterBindingStackPointer| 514) + +(defconstant |internalregister|$k-|catchblocklist| 515) +(defconstant |InternalRegisterCatchBlockList| 515) + +(defconstant |internalregister|$k-|controlstacklimit| 516) +(defconstant |InternalRegisterControlStackLimit| 516) + +(defconstant |internalregister|$k-|controlstackextralimit| 517) +(defconstant |InternalRegisterControlStackExtraLimit| 517) + +(defconstant |internalregister|$k-|bindingstacklimit| 518) +(defconstant |InternalRegisterBindingStackLimit| 518) + +(defconstant |internalregister|$k-|phtbase| 519) +(defconstant |InternalRegisterPHTBase| 519) + +(defconstant |internalregister|$k-|phtmask| 520) +(defconstant |InternalRegisterPHTMask| 520) + +(defconstant |internalregister|$k-|countmapreloads| 521) +(defconstant |InternalRegisterCountMapReloads| 521) + +(defconstant |internalregister|$k-|listcachearea| 522) +(defconstant |InternalRegisterListCacheArea| 522) + +(defconstant |internalregister|$k-|listcacheaddress| 523) +(defconstant |InternalRegisterListCacheAddress| 523) + +(defconstant |internalregister|$k-|listcachelength| 524) +(defconstant |InternalRegisterListCacheLength| 524) + +(defconstant |internalregister|$k-|structurecachearea| 525) +(defconstant |InternalRegisterStructureCacheArea| 525) + +(defconstant |internalregister|$k-|structurecacheaddress| 526) +(defconstant |InternalRegisterStructureCacheAddress| 526) + +(defconstant |internalregister|$k-|structurecachelength| 527) +(defconstant |InternalRegisterStructureCacheLength| 527) + +(defconstant |internalregister|$k-|dynamicbindingcachebase| 528) +(defconstant |InternalRegisterDynamicBindingCacheBase| 528) + +(defconstant |internalregister|$k-|dynamicbindingcachemask| 529) +(defconstant |InternalRegisterDynamicBindingCacheMask| 529) + +(defconstant |internalregister|$k-|choicepointer| 530) +(defconstant |InternalRegisterChoicePointer| 530) + +(defconstant |internalregister|$k-|structurestackchoicepointer| 531) +(defconstant |InternalRegisterStructureStackChoicePointer| 531) + +(defconstant |internalregister|$k-|fepmodetrapvectoraddress| 532) +(defconstant |InternalRegisterFEPModeTrapVectorAddress| 532) + +(defconstant |internalregister|$k-|mappingtablecache| 534) +(defconstant |InternalRegisterMappingTableCache| 534) + +(defconstant |internalregister|$k-|mappingtablelength| 535) +(defconstant |InternalRegisterMappingTableLength| 535) + +(defconstant |internalregister|$k-|stackframemaximumsize| 536) +(defconstant |InternalRegisterStackFrameMaximumSize| 536) + +(defconstant |internalregister|$k-|stackcachedumpquantum| 537) +(defconstant |InternalRegisterStackCacheDumpQuantum| 537) + +(defconstant |internalregister|$k-|constantnil| 544) +(defconstant |InternalRegisterConstantNIL| 544) + +(defconstant |internalregister|$k-|constantt| 545) +(defconstant |InternalRegisterConstantT| 545) + +(defconstant |coprocessorregister|$k-|microsecondclock| 514) +(defconstant |CoprocessorRegisterMicrosecondClock| 514) + +(defconstant |coprocessorregister|$k-|hostinterrupt| 520) +(defconstant |CoprocessorRegisterHostInterrupt| 520) + +(defconstant |coprocessorregister|$k-|vmregistercommand| 576) +(defconstant |CoprocessorRegisterVMRegisterCommand| 576) + +(defconstant |coprocessorregister|$k-|vmregisteraddress| 577) +(defconstant |CoprocessorRegisterVMRegisterAddress| 577) + +(defconstant |coprocessorregister|$k-|vmregisterextent| 578) +(defconstant |CoprocessorRegisterVMRegisterExtent| 578) + +(defconstant |coprocessorregister|$k-|vmregisterattributes| 579) +(defconstant |CoprocessorRegisterVMRegisterAttributes| 579) + +(defconstant |coprocessorregister|$k-|vmregisterdestination| 580) +(defconstant |CoprocessorRegisterVMRegisterDestination| 580) + +(defconstant |coprocessorregister|$k-|vmregisterdata| 581) +(defconstant |CoprocessorRegisterVMRegisterData| 581) + +(defconstant |coprocessorregister|$k-|vmregistermasklow| 582) +(defconstant |CoprocessorRegisterVMRegisterMaskLow| 582) + +(defconstant |coprocessorregister|$k-|vmregistermaskhigh| 583) +(defconstant |CoprocessorRegisterVMRegisterMaskHigh| 583) + +(defconstant |coprocessorregister|$k-|vmregistercommandblock| 584) +(defconstant |CoprocessorRegisterVMRegisterCommandBlock| 584) + +(defconstant |coprocessorregister|$k-|stackswitch| 640) +(defconstant |CoprocessorRegisterStackSwitch| 640) + +(defconstant |coprocessorregister|$k-|flushstackcache| 641) +(defconstant |CoprocessorRegisterFlushStackCache| 641) + +(defconstant |coprocessorregister|$k-|flushidcaches| 642) +(defconstant |CoprocessorRegisterFlushIDCaches| 642) + +(defconstant |coprocessorregister|$k-|calendarclock| 643) +(defconstant |CoprocessorRegisterCalendarClock| 643) + +(defconstant |coprocessorregister|$k-|flushcachesforvma| 644) +(defconstant |CoprocessorRegisterFlushCachesForVMA| 644) + +(defconstant |coprocessorregister|$k-|fliptostack| 645) +(defconstant |CoprocessorRegisterFlipToStack| 645) + +(defconstant |coprocessorregister|$k-|unwindstackforrestartorapply| 646) +(defconstant |CoprocessorRegisterUnwindStackForRestartOrApply| 646) + +(defconstant |coprocessorregister|$k-|saveworld| 647) +(defconstant |CoprocessorRegisterSaveWorld| 647) + +(defconstant |coprocessorregister|$k-|consoleinputavailablep| 648) +(defconstant |CoprocessorRegisterConsoleInputAvailableP| 648) + +(defconstant |coprocessorregister|$k-|waitforevent| 649) +(defconstant |CoprocessorRegisterWaitForEvent| 649) + +(defconstant |coprocessorregister|$k-|flushhiddenarrayregisters| 650) +(defconstant |CoprocessorRegisterFlushHiddenArrayRegisters| 650) + +(defconstant |coprocessorregister|$k-|consoleio| 651) +(defconstant |CoprocessorRegisterConsoleIO| 651) + +(defconstant |coprocessorregister|$k-|attachdiskchannel| 652) +(defconstant |CoprocessorRegisterAttachDiskChannel| 652) + +(defconstant |coprocessorregister|$k-|growdiskpartition| 653) +(defconstant |CoprocessorRegisterGrowDiskPartition| 653) + +(defconstant |coprocessorregister|$k-|detachdiskchannel| 654) +(defconstant |CoprocessorRegisterDetachDiskChannel| 654) + +(defconstant |coprocessorregister|$k-|unixcrypt| 655) +(defconstant |CoprocessorRegisterUnixCrypt| 655) + +(defconstant |address|$k-nil 4161016320) +(defconstant |AddressNIL| 4161016320) + +(defconstant |address|$k-t 4161016328) +(defconstant |AddressT| 4161016328) + +(defconstant |alucondition|$k-|signedlessthanorequal| 0) +(defconstant |ALUConditionSignedLessThanOrEqual| 0) + +(defconstant |alucondition|$k-|signedlessthan| 1) +(defconstant |ALUConditionSignedLessThan| 1) + +(defconstant |alucondition|$k-|negative| 2) +(defconstant |ALUConditionNegative| 2) + +(defconstant |alucondition|$k-|signedoverflow| 3) +(defconstant |ALUConditionSignedOverflow| 3) + +(defconstant |alucondition|$k-|unsignedlessthanorequal| 4) +(defconstant |ALUConditionUnsignedLessThanOrEqual| 4) + +(defconstant |alucondition|$k-|unsignedlessthan| 5) +(defconstant |ALUConditionUnsignedLessThan| 5) + +(defconstant |alucondition|$k-|zero| 6) +(defconstant |ALUConditionZero| 6) + +(defconstant |alucondition|$k-|high25zero| 7) +(defconstant |ALUConditionHigh25Zero| 7) + +(defconstant |alucondition|$k-|eq| 8) +(defconstant |ALUConditionEq| 8) + +(defconstant |alucondition|$k-|op1ephemeralp| 9) +(defconstant |ALUConditionOp1Ephemeralp| 9) + +(defconstant |alucondition|$k-|op1typeacceptable| 10) +(defconstant |ALUConditionOp1TypeAcceptable| 10) + +(defconstant |alucondition|$k-|op1typecondition| 11) +(defconstant |ALUConditionOp1TypeCondition| 11) + +(defconstant |alucondition|$k-|resulttypenil| 12) +(defconstant |ALUConditionResultTypeNil| 12) + +(defconstant |alucondition|$k-|op2fixnum| 13) +(defconstant |ALUConditionOp2Fixnum| 13) + +(defconstant |alucondition|$k-|false| 14) +(defconstant |ALUConditionFalse| 14) + +(defconstant |alucondition|$k-|resultcdrlow| 15) +(defconstant |ALUConditionResultCdrLow| 15) + +(defconstant |alucondition|$k-|cleanupbitsset| 16) +(defconstant |ALUConditionCleanupBitsSet| 16) + +(defconstant |alucondition|$k-|addressinstackcache| 17) +(defconstant |ALUConditionAddressInStackCache| 17) + +(defconstant |alucondition|$k-|pendingsequencebreakenabled| 18) +(defconstant |ALUConditionPendingSequenceBreakEnabled| 18) + +(defconstant |alucondition|$k-|extrastackmode| 19) +(defconstant |ALUConditionExtraStackMode| 19) + +(defconstant |alucondition|$k-|fepmode| 20) +(defconstant |ALUConditionFepMode| 20) + +(defconstant |alucondition|$k-|fpcoprocessorpresent| 21) +(defconstant |ALUConditionFpCoprocessorPresent| 21) + +(defconstant |alucondition|$k-|op1oldspacep| 22) +(defconstant |ALUConditionOp1Oldspacep| 22) + +(defconstant |alucondition|$k-|stackcacheoverflow| 23) +(defconstant |ALUConditionStackCacheOverflow| 23) + +(defconstant |alucondition|$k-|orlogicvariable| 24) +(defconstant |ALUConditionOrLogicVariable| 24) + +(defconstant |aluadderop2|$k-|op2| 0) +(defconstant |ALUAdderOp2Op2| 0) + +(defconstant |aluadderop2|$k-|zero| 1) +(defconstant |ALUAdderOp2Zero| 1) + +(defconstant |aluadderop2|$k-|invert| 2) +(defconstant |ALUAdderOp2Invert| 2) + +(defconstant |aluadderop2|$k-|minusone| 3) +(defconstant |ALUAdderOp2MinusOne| 3) + +(defconstant |alubytefunction|$k-|dpb| 0) +(defconstant |ALUByteFunctionDpb| 0) + +(defconstant |alubytefunction|$k-|ldb| 1) +(defconstant |ALUByteFunctionLdb| 1) + +(defconstant |alubytebackground|$k-|op1| 0) +(defconstant |ALUByteBackgroundOp1| 0) + +(defconstant |alubytebackground|$k-|rotatelatch| 1) +(defconstant |ALUByteBackgroundRotateLatch| 1) + +(defconstant |alubytebackground|$k-|zero| 2) +(defconstant |ALUByteBackgroundZero| 2) + +(defconstant |boole|$k-|clear| 0) +(defconstant |BooleClear| 0) + +(defconstant |boole|$k-|and| 1) +(defconstant |BooleAnd| 1) + +(defconstant |boole|$k-|andc1| 2) +(defconstant |BooleAndC1| 2) + +(defconstant |boole|$k-|2| 3) +(defconstant |Boole2| 3) + +(defconstant |boole|$k-|andc2| 4) +(defconstant |BooleAndC2| 4) + +(defconstant |boole|$k-|1| 5) +(defconstant |Boole1| 5) + +(defconstant |boole|$k-|xor| 6) +(defconstant |BooleXor| 6) + +(defconstant |boole|$k-|ior| 7) +(defconstant |BooleIor| 7) + +(defconstant |boole|$k-|nor| 8) +(defconstant |BooleNor| 8) + +(defconstant |boole|$k-|equiv| 9) +(defconstant |BooleEquiv| 9) + +(defconstant |boole|$k-c1 10) +(defconstant |BooleC1| 10) + +(defconstant |boole|$k-|orc1| 11) +(defconstant |BooleOrC1| 11) + +(defconstant |boole|$k-c2 12) +(defconstant |BooleC2| 12) + +(defconstant |boole|$k-|orc2| 13) +(defconstant |BooleOrC2| 13) + +(defconstant |boole|$k-|nand| 14) +(defconstant |BooleNand| 14) + +(defconstant |boole|$k-|set| 15) +(defconstant |BooleSet| 15) + +(defconstant |alufunction|$k-|boolean| 0) +(defconstant |ALUFunctionBoolean| 0) + +(defconstant |alufunction|$k-|byte| 1) +(defconstant |ALUFunctionByte| 1) + +(defconstant |alufunction|$k-|adder| 2) +(defconstant |ALUFunctionAdder| 2) + +(defconstant |alufunction|$k-|multiplydivide| 3) +(defconstant |ALUFunctionMultiplyDivide| 3) + +(defconstant |cycle|$k-|dataread| 0) +(defconstant |CycleDataRead| 0) + +(defconstant |cycle|$k-|datawrite| 1) +(defconstant |CycleDataWrite| 1) + +(defconstant |cycle|$k-|bindread| 2) +(defconstant |CycleBindRead| 2) + +(defconstant |cycle|$k-|bindwrite| 3) +(defconstant |CycleBindWrite| 3) + +(defconstant |cycle|$k-|bindreadnomonitor| 4) +(defconstant |CycleBindReadNoMonitor| 4) + +(defconstant |cycle|$k-|bindwritenomonitor| 5) +(defconstant |CycleBindWriteNoMonitor| 5) + +(defconstant |cycle|$k-|header| 6) +(defconstant |CycleHeader| 6) + +(defconstant |cycle|$k-|structureoffset| 7) +(defconstant |CycleStructureOffset| 7) + +(defconstant |cycle|$k-|scavenge| 8) +(defconstant |CycleScavenge| 8) + +(defconstant |cycle|$k-|cdr| 9) +(defconstant |CycleCdr| 9) + +(defconstant |cycle|$k-|gccopy| 10) +(defconstant |CycleGCCopy| 10) + +(defconstant |cycle|$k-|raw| 11) +(defconstant |CycleRaw| 11) + +(defconstant |cycle|$k-|rawtranslate| 12) +(defconstant |CycleRawTranslate| 12) + +(defconstant |memoryaction|$k-|none| 0) +(defconstant |MemoryActionNone| 0) + +(defconstant |memoryaction|$k-|indirect| 1) +(defconstant |MemoryActionIndirect| 1) + +(defconstant |memoryaction|$k-|monitor| 2) +(defconstant |MemoryActionMonitor| 2) + +(defconstant |memoryaction|$k-|transport| 4) +(defconstant |MemoryActionTransport| 4) + +(defconstant |memoryaction|$k-|trap| 8) +(defconstant |MemoryActionTrap| 8) + +(defconstant |memoryaction|$k-|transform| 16) +(defconstant |MemoryActionTransform| 16) + +(defconstant |memoryaction|$k-|binding| 32) +(defconstant |MemoryActionBinding| 32) + +(defconstant |trapmode|$k-|emulator| 0) +(defconstant |TrapModeEmulator| 0) + +(defconstant |trapmode|$k-|extrastack| 1) +(defconstant |TrapModeExtraStack| 1) + +(defconstant |trapmode|$k-io 2) +(defconstant |TrapModeIO| 2) + +(defconstant |trapmode|$k-fep 3) +(defconstant |TrapModeFEP| 3) + +(defconstant |returnvalue|$k-|normal| 0) +(defconstant |ReturnValueNormal| 0) + +(defconstant |returnvalue|$k-|exception| 1) +(defconstant |ReturnValueException| 1) + +(defconstant |returnvalue|$k-|illegaloperand| 2) +(defconstant |ReturnValueIllegalOperand| 2) + +(defconstant |haltreason|$k-|illinstn| 1) +(defconstant |HaltReasonIllInstn| 1) + +(defconstant |haltreason|$k-|halted| 2) +(defconstant |HaltReasonHalted| 2) + +(defconstant |haltreason|$k-|spycalled| 3) +(defconstant |HaltReasonSpyCalled| 3) + +(defconstant |haltreason|$k-|fatalstackoverflow| 4) +(defconstant |HaltReasonFatalStackOverflow| 4) + +(defconstant |haltreason|$k-|illegaltrapvector| 5) +(defconstant |HaltReasonIllegalTrapVector| 5) + +(defconstant |trapreason|$k-|highprioritysequencebreak| 1) +(defconstant |TrapReasonHighPrioritySequenceBreak| 1) + +(defconstant |trapreason|$k-|lowprioritysequencebreak| 2) +(defconstant |TrapReasonLowPrioritySequenceBreak| 2) + +(defconstant |vmattribute|$k-|accessfault| 1) +(defconstant |VMAttributeAccessFault| 1) + +(defconstant |vmattribute|$k-|writefault| 2) +(defconstant |VMAttributeWriteFault| 2) + +(defconstant |vmattribute|$k-|transportfault| 4) +(defconstant |VMAttributeTransportFault| 4) + +(defconstant |vmattribute|$k-|transportdisable| 8) +(defconstant |VMAttributeTransportDisable| 8) + +(defconstant |vmattribute|$k-|ephemeral| 16) +(defconstant |VMAttributeEphemeral| 16) + +(defconstant |vmattribute|$k-|modified| 32) +(defconstant |VMAttributeModified| 32) + +(defconstant |vmattribute|$k-|exists| 64) +(defconstant |VMAttributeExists| 64) + +(defconstant |vmattribute|$k-|createddefault| 69) +(defconstant |VMAttributeCreatedDefault| 69) + +(defconstant |memorypage|$k-|size| 8192) +(defconstant |MemoryPageSize| 8192) + +(defconstant |memorypage|$k-|addressshift| 13) +(defconstant |MemoryPageAddressShift| 13) + +(defconstant |doublefloatop|$k-|add| 0) +(defconstant |DoubleFloatOpAdd| 0) + +(defconstant |doublefloatop|$k-|sub| 1) +(defconstant |DoubleFloatOpSub| 1) + +(defconstant |doublefloatop|$k-|multiply| 2) +(defconstant |DoubleFloatOpMultiply| 2) + +(defconstant |doublefloatop|$k-|divide| 3) +(defconstant |DoubleFloatOpDivide| 3) diff --git a/emulator/aihead.s b/emulator/aihead.s new file mode 100644 index 0000000..8f77060 --- /dev/null +++ b/emulator/aihead.s @@ -0,0 +1,1073 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;aihead.sid. Any changes made to it will be lost. */ + + +TypeNull = 0x0 + +TypeMonitorForward = 0x1 + +TypeHeaderP = 0x2 + +TypeHeaderI = 0x3 + +TypeExternalValueCellPointer = 0x4 + +TypeOneQForward = 0x5 + +TypeHeaderForward = 0x6 + +TypeElementForward = 0x7 + +TypeFixnum = 0x8 + +TypeSmallRatio = 0x9 + +TypeSingleFloat = 0xA + +TypeDoubleFloat = 0xB + +TypeBignum = 0xC + +TypeBigRatio = 0xD + +TypeComplex = 0xE + +TypeSpareNumber = 0xF + +TypeInstance = 0x10 + +TypeListInstance = 0x11 + +TypeArrayInstance = 0x12 + +TypeStringInstance = 0x13 + +TypeNIL = 0x14 + +TypeList = 0x15 + +TypeArray = 0x16 + +TypeString = 0x17 + +TypeSymbol = 0x18 + +TypeLocative = 0x19 + +TypeLexicalClosure = 0x1A + +TypeDynamicClosure = 0x1B + +TypeCompiledFunction = 0x1C + +TypeGenericFunction = 0x1D + +TypeSparePointer1 = 0x1E + +TypeSparePointer2 = 0x1F + +TypePhysicalAddress = 0x20 + +TypeNativeInstruction = 0x21 + +TypeBoundLocation = 0x22 + +TypeCharacter = 0x23 + +TypeLogicVariable = 0x24 + +TypeGCForward = 0x25 + +TypeEvenPC = 0x26 + +TypeOddPC = 0x27 + +TypeCallCompiledEven = 0x28 + +TypeCallCompiledOdd = 0x29 + +TypeCallIndirect = 0x2A + +TypeCallGeneric = 0x2B + +TypeCallCompiledEvenPrefetch = 0x2C + +TypeCallCompiledOddPrefetch = 0x2D + +TypeCallIndirectPrefetch = 0x2E + +TypeCallGenericPrefetch = 0x2F + +TypePackedInstruction60 = 0x30 + +TypeTypePackedInstruction61 = 0x31 + +TypeTypePackedInstruction62 = 0x32 + +TypePackedInstruction63 = 0x33 + +TypeTypePackedInstruction64 = 0x34 + +TypeTypePackedInstruction65 = 0x35 + +TypePackedInstruction66 = 0x36 + +TypeTypePackedInstruction67 = 0x37 + +TypeTypePackedInstruction70 = 0x38 + +TypePackedInstruction71 = 0x39 + +TypeTypePackedInstruction72 = 0x3A + +TypeTypePackedInstruction73 = 0x3B + +TypePackedInstruction74 = 0x3C + +TypeTypePackedInstruction75 = 0x3D + +TypeTypePackedInstruction76 = 0x3E + +TypePackedInstruction77 = 0x3F + +CdrNext = 0x0 + +CdrNil = 0x1 + +CdrNormal = 0x2 + +ArrayElementTypeFixnum = 0x0 + +ArrayElementTypeCharacter = 0x1 + +ArrayElementTypeBoolean = 0x2 + +ArrayElementTypeObject = 0x3 + +ArrayTypeFieldPos = 0x1A + +ArrayTypeFieldSize = 0x6 + +ArrayTypeFieldMask = 0x3F + +ArrayElementTypePos = 0x1E + +ArrayElementTypeSize = 0x2 + +ArrayElementTypeMask = 0x3 + +ArrayBytePackingPos = 0x1B + +ArrayBytePackingSize = 0x3 + +ArrayBytePackingMask = 0x7 + +ArrayListBitPos = 0x1A + +ArrayListBitSize = 0x1 + +ArrayListBitMask = 0x1 + +ArrayNamedStructureBitPos = 0x19 + +ArrayNamedStructureBitSize = 0x1 + +ArrayNamedStructureBitMask = 0x1 + +ArraySpare1Pos = 0x18 + +ArraySpare1Size = 0x1 + +ArraySpare1Mask = 0x1 + +ArrayLongPrefixBitPos = 0x17 + +ArrayLongPrefixBitSize = 0x1 + +ArrayLongPrefixBitMask = 0x1 + +ArrayLeaderLengthFieldPos = 0xF + +ArrayLeaderLengthFieldSize = 0x8 + +ArrayLeaderLengthFieldMask = 0xFF + +ArrayLengthPos = 0x0 + +ArrayLengthSize = 0xF + +ArrayLengthMask = 0x7FFF + +ArrayDisplacedBitPos = 0xE + +ArrayDisplacedBitSize = 0x1 + +ArrayDisplacedBitMask = 0x1 + +ArrayDiscontiguousBitPos = 0xD + +ArrayDiscontinuousBitSize = 0x1 + +ArrayDiscontiguousBitMask = 0x1 + +ArrayLongSparePos = 0x3 + +ArrayLongSpareSize = 0xC + +ArrayLongSpareMask = 0xFFF + +ArrayLongDimensionsFieldPos = 0x0 + +ArrayLongDimensionsFieldSize = 0x3 + +ArrayLongDimensionsFieldMask = 0x7 + +ArrayRegisterElementTypePos = 0x1E + +ArrayRegisterElementTypeSize = 0x2 + +ArrayRegisterElementTypeMask = 0x3 + +ArrayRegisterBytePackingPos = 0x1B + +ArrayRegisterBytePackingSize = 0x3 + +ArrayRegisterBytePackingMask = 0x7 + +ArrayRegisterByteOffsetPos = 0x16 + +ArrayRegisterByteOffsetSize = 0x5 + +ArrayRegisterByteOffsetMask = 0x1F + +ArrayRegisterEventCountPos = 0x0 + +ArrayRegisterEventCountSize = 0x16 + +ArrayRegisterEventCountMask = 0x3FFFFF + +ValueDispositionEffect = 0x0 + +ValueDispositionValue = 0x1 + +ValueDispositionReturn = 0x2 + +ValueDispositionMultiple = 0x3 + +OpcodeCar = 0x0 + +OpcodeCdr = 0x1 + +OpcodeSetToCar = 0x60 + +OpcodeSetToCdr = 0x61 + +OpcodeSetToCdrPushCar = 0x62 + +OpcodeRplaca = 0x80 + +OpcodeRplacd = 0x81 + +OpcodeRgetf = 0x95 + +OpcodeMember = 0x96 + +OpcodeAssoc = 0x97 + +OpcodeDereference = 0xB + +OpcodeUnify = 0x9F + +OpcodePushLocalLogicVariables = 0x43 + +OpcodePushGlobalLogicVariable = 0x2D + +OpcodeLogicTailTest = 0xC + +OpcodeEq = 0xB8 + +OpcodeEqNoPop = 0xBC + +OpcodeEql = 0xB3 + +OpcodeEqlNoPop = 0xB7 + +OpcodeEqualNumber = 0xB0 + +OpcodeEqualNumberNoPop = 0xB4 + +OpcodeGreaterp = 0xB2 + +OpcodeGreaterpNoPop = 0xB6 + +OpcodeLessp = 0xB1 + +OpcodeLesspNoPop = 0xB5 + +OpcodeLogtest = 0xBB + +OpcodeLogtestNoPop = 0xBF + +OpcodeTypeMember = 0x20 + +OpcodeTypeMemberNoPop = 0x24 + +OpcodeEndp = 0x2 + +OpcodePlusp = 0x1E + +OpcodeMinusp = 0x1D + +OpcodeZerop = 0x1C + +OpcodeAdd = 0xC0 + +OpcodeSub = 0xC1 + +OpcodeUnaryMinus = 0x4C + +OpcodeIncrement = 0x63 + +OpcodeDecrement = 0x64 + +OpcodeMultiply = 0x82 + +OpcodeQuotient = 0x83 + +OpcodeCeiling = 0x84 + +OpcodeFloor = 0x85 + +OpcodeTruncate = 0x86 + +OpcodeRound = 0x87 + +OpcodeRationalQuotient = 0x89 + +OpcodeMax = 0x8B + +OpcodeMin = 0x8A + +OpcodeLogand = 0x8D + +OpcodeLogior = 0x8F + +OpcodeLogxor = 0x8E + +OpcodeAsh = 0x9A + +OpcodeRot = 0x90 + +OpcodeLsh = 0x91 + +Opcode32BitPlus = 0xC2 + +Opcode32BitDifference = 0xC3 + +OpcodeMultiplyDouble = 0x92 + +OpcodeAddBignumStep = 0xC4 + +OpcodeSubBignumStep = 0xC5 + +OpcodeMultiplyBignumStep = 0xC6 + +OpcodeDivideBignumStep = 0xC7 + +OpcodeLshcBignumStep = 0x93 + +OpcodeDoubleFloatOp = 0xE + +OpcodePush = 0x40 + +OpcodePop = 0xE0 + +OpcodeMovem = 0xE1 + +OpcodePushNNils = 0x41 + +OpcodePushAddress = 0x68 + +OpcodeSetSpToAddress = 0x69 + +OpcodeSetSpToAddressSaveTos = 0x6A + +OpcodePushAddressSpRelative = 0x42 + +OpcodeStackBlt = 0x94 + +OpcodeStackBltAddress = 0xEA + +OpcodeLdb = 0x78 + +OpcodeDpb = 0xF8 + +OpcodeCharLdb = 0x79 + +OpcodeCharDpb = 0xF9 + +OpcodePLdb = 0x7A + +OpcodePDpb = 0xFA + +OpcodePTagLdb = 0x7B + +OpcodePTagDpb = 0xFB + +OpcodeAref1 = 0xCA + +OpcodeAset1 = 0xC8 + +OpcodeAloc1 = 0xCB + +OpcodeSetup1DArray = 0x3 + +OpcodeSetupForce1DArray = 0x4 + +OpcodeFastAref1 = 0xE8 + +OpcodeFastAset1 = 0xE9 + +OpcodeArrayLeader = 0xCE + +OpcodeStoreArrayLeader = 0xCC + +OpcodeAlocLeader = 0xCF + +OpcodeBranch = 0x7C + +OpcodeBranchTrue = 0x30 + +OpcodeBranchTrueElseExtraPop = 0x31 + +OpcodeBranchTrueAndExtraPop = 0x32 + +OpcodeBranchTrueExtraPop = 0x33 + +OpcodeBranchTrueNoPop = 0x34 + +OpcodeBranchTrueAndNoPop = 0x35 + +OpcodeBranchTrueElseNoPop = 0x36 + +OpcodeBranchTrueAndNoPopElseNoPopExtraPop = 0x37 + +OpcodeBranchFalse = 0x38 + +OpcodeBranchFalseElseExtraPop = 0x39 + +OpcodeBranchFalseAndExtraPop = 0x3A + +OpcodeBranchFalseExtraPop = 0x3B + +OpcodeBranchFalseNoPop = 0x3C + +OpcodeBranchFalseAndNoPop = 0x3D + +OpcodeBranchFalseElseNoPop = 0x3E + +OpcodeBranchFalseAndNoPopElseNoPopExtraPop = 0x3F + +OpcodeLoopDecrementTos = 0x7D + +OpcodeLoopIncrementTosLessThan = 0xFD + +OpcodeBlock0Read = 0x50 + +OpcodeBlock1Read = 0x51 + +OpcodeBlock2Read = 0x52 + +OpcodeBlock3Read = 0x53 + +OpcodeBlock0ReadShift = 0x54 + +OpcodeBlock1ReadShift = 0x55 + +OpcodeBlock2ReadShift = 0x56 + +OpcodeBlock3ReadShift = 0x57 + +OpcodeBlock0ReadAlu = 0x70 + +OpcodeBlock1ReadAlu = 0x71 + +OpcodeBlock2ReadAlu = 0x72 + +OpcodeBlock3ReadAlu = 0x73 + +OpcodeBlock0ReadTest = 0x58 + +OpcodeBlock1ReadTest = 0x59 + +OpcodeBlock2ReadTest = 0x5A + +OpcodeBlock3ReadTest = 0x5B + +OpcodeBlock0Write = 0x18 + +OpcodeBlock1Write = 0x19 + +OpcodeBlock2Write = 0x1A + +OpcodeBlock3Write = 0x1B + +OpcodeStartCall = 0x8 + +OpcodeFinishCallN = 0x5C + +OpcodeFinishCallNApply = 0x5D + +OpcodeFinishCallTos = 0x5E + +OpcodeFinishCallTosApply = 0x5F + +OpcodeEntryRestAccepted = 0x7E + +OpcodeEntryRestNotAccepted = 0x7F + +OpcodeLocateLocals = 0x28 + +OpcodeReturnSingle = 0x4D + +OpcodeReturnMultiple = 0x44 + +OpcodeReturnKludge = 0x45 + +OpcodeTakeValues = 0x46 + +OpcodeBindLocativeToValue = 0x9E + +OpcodeBindLocative = 0x5 + +OpcodeUnbindN = 0x47 + +OpcodeRestoreBindingStack = 0x6 + +OpcodeCatchOpen = 0xFE + +OpcodeCatchClose = 0x29 + +OpcodePushLexicalVar = 0x10 + +OpcodePopLexicalVar = 0xA0 + +OpcodeMovemLexicalVar = 0xA8 + +OpcodePushInstanceVariable = 0x48 + +OpcodePopInstanceVariable = 0xD0 + +OpcodeMovemInstanceVariable = 0xD1 + +OpcodePushAddressInstanceVariable = 0x49 + +OpcodePushInstanceVariableOrdered = 0x4A + +OpcodePopInstanceVariableOrdered = 0xD2 + +OpcodeMovemInstanceVariableOrdered = 0xD3 + +OpcodePushAddressInstanceVariableOrdered = 0x4B + +OpcodeInstanceRef = 0xD4 + +OpcodeInstanceSet = 0xD5 + +OpcodeInstanceLoc = 0xD6 + +OpcodeEphemeralp = 0x7 + +OpcodeUnsignedLessp = 0xD9 + +OpcodeUnsignedLesspNoPop = 0xDD + +OpcodeAlu = 0x8C + +OpcodeAllocateListBlock = 0xC9 + +OpcodeAllocateStructureBlock = 0xCD + +OpcodePointerPlus = 0x98 + +OpcodePointerDifference = 0x99 + +OpcodePointerIncrement = 0x65 + +OpcodeReadInternalRegister = 0x6C + +OpcodeWriteInternalRegister = 0x6D + +OpcodeCoprocessorRead = 0x6E + +OpcodeCoprocessorWrite = 0x6F + +OpcodeMemoryRead = 0x4E + +OpcodeMemoryReadAddress = 0x4F + +OpcodeTag = 0xA + +OpcodeSetTag = 0xD7 + +OpcodeStoreConditional = 0x9B + +OpcodeMemoryWrite = 0x9C + +OpcodePStoreContents = 0x9D + +OpcodeSetCdrCode1 = 0x66 + +OpcodeSetCdrCode2 = 0x67 + +OpcodeMergeCdrNoPop = 0xE2 + +OpcodeGenericDispatch = 0x2A + +OpcodeMessageDispatch = 0x2B + +OpcodeJump = 0x9 + +OpcodeCheckPreemptRequest = 0x2C + +OpcodeNoOp = 0x2E + +OpcodeHalt = 0x2F + +ControlApply = 0x20000 + +ControlCleanupBits = 0x7000000 + +ControlCallStarted = 0x400000 + +ControlExtraArgument = 0x100 + +ControlArgumentSize = 0xFF + +ControlCallerFrameSize = 0x1FE00 + +ControlValueDisposition = 0xC0000 + +InternalRegisterEA = 0x0 + +InternalRegisterFP = 0x1 + +InternalRegisterLP = 0x2 + +InternalRegisterSP = 0x3 + +InternalRegisterMacroSP = 0x4 + +InternalRegisterStackCacheLowerBound = 0x5 + +InternalRegisterBAR0 = 0x6 + +InternalRegisterBAR1 = 0x86 + +InternalRegisterBAR2 = 0x106 + +InternalRegisterBAR3 = 0x186 + +InternalRegisterPHTHash0 = 0x7 + +InternalRegisterPHTHash1 = 0x87 + +InternalRegisterPHTHash2 = 0x107 + +InternalRegisterPHTHash3 = 0x187 + +InternalRegisterEPC = 0x8 + +InternalRegisterDPC = 0x9 + +InternalRegisterContinuation = 0xA + +InternalRegisterAluAndRotateControl = 0xB + +InternalRegisterControlRegister = 0xC + +InternalRegisterCRArgumentSize = 0xD + +InternalRegisterEphemeralOldspaceRegister = 0xE + +InternalRegisterZoneOldspaceRegister = 0xF + +InternalRegisterChipRevision = 0x10 + +InternalRegisterFPCoprocessorPresent = 0x11 + +InternalRegisterPreemptRegister = 0x13 + +InternalRegisterIcacheControl = 0x14 + +InternalRegisterPrefetcherControl = 0x15 + +InternalRegisterMapCacheControl = 0x16 + +InternalRegisterMemoryControl = 0x17 + +InternalRegisterECCLog = 0x18 + +InternalRegisterECCLogAddress = 0x19 + +InternalRegisterInvalidateMap0 = 0x1A + +InternalRegisterInvalidateMap1 = 0x9A + +InternalRegisterInvalidateMap2 = 0x11A + +InternalRegisterInvalidateMap3 = 0x19A + +InternalRegisterLoadMap0 = 0x1B + +InternalRegisterLoadMap1 = 0x9B + +InternalRegisterLoadMap2 = 0x11B + +InternalRegisterLoadMap3 = 0x19B + +InternalRegisterStackCacheOverflowLimit = 0x1C + +InternalRegisterUcodeROMContents = 0x1D + +InternalRegisterAddressMask = 0x1F + +InternalRegisterEntryMaximumArguments = 0x20 + +InternalRegisterLexicalVariable = 0x21 + +InternalRegisterInstruction = 0x22 + +InternalRegisterMemoryData = 0x24 + +InternalRegisterDataPins = 0x25 + +InternalRegisterExtensionRegister = 0x26 + +InternalRegisterMicrosecondClock = 0x27 + +InternalRegisterArrayHeaderLength = 0x28 + +InternalRegisterLoadBAR0 = 0x2A + +InternalRegisterLoadBAR1 = 0xAA + +InternalRegisterLoadBAR2 = 0x12A + +InternalRegisterLoadBAR3 = 0x1AA + +InternalRegisterTOS = 0x200 + +InternalRegisterEventCount = 0x201 + +InternalRegisterBindingStackPointer = 0x202 + +InternalRegisterCatchBlockList = 0x203 + +InternalRegisterControlStackLimit = 0x204 + +InternalRegisterControlStackExtraLimit = 0x205 + +InternalRegisterBindingStackLimit = 0x206 + +InternalRegisterPHTBase = 0x207 + +InternalRegisterPHTMask = 0x208 + +InternalRegisterCountMapReloads = 0x209 + +InternalRegisterListCacheArea = 0x20A + +InternalRegisterListCacheAddress = 0x20B + +InternalRegisterListCacheLength = 0x20C + +InternalRegisterStructureCacheArea = 0x20D + +InternalRegisterStructureCacheAddress = 0x20E + +InternalRegisterStructureCacheLength = 0x20F + +InternalRegisterDynamicBindingCacheBase = 0x210 + +InternalRegisterDynamicBindingCacheMask = 0x211 + +InternalRegisterChoicePointer = 0x212 + +InternalRegisterStructureStackChoicePointer = 0x213 + +InternalRegisterFEPModeTrapVectorAddress = 0x214 + +InternalRegisterMappingTableCache = 0x216 + +InternalRegisterMappingTableLength = 0x217 + +InternalRegisterStackFrameMaximumSize = 0x218 + +InternalRegisterStackCacheDumpQuantum = 0x219 + +InternalRegisterConstantNIL = 0x220 + +InternalRegisterConstantT = 0x221 + +CoprocessorRegisterMicrosecondClock = 0x202 + +CoprocessorRegisterHostInterrupt = 0x208 + +CoprocessorRegisterVMRegisterCommand = 0x240 + +CoprocessorRegisterVMRegisterAddress = 0x241 + +CoprocessorRegisterVMRegisterExtent = 0x242 + +CoprocessorRegisterVMRegisterAttributes = 0x243 + +CoprocessorRegisterVMRegisterDestination = 0x244 + +CoprocessorRegisterVMRegisterData = 0x245 + +CoprocessorRegisterVMRegisterMaskLow = 0x246 + +CoprocessorRegisterVMRegisterMaskHigh = 0x247 + +CoprocessorRegisterVMRegisterCommandBlock = 0x248 + +CoprocessorRegisterStackSwitch = 0x280 + +CoprocessorRegisterFlushStackCache = 0x281 + +CoprocessorRegisterFlushIDCaches = 0x282 + +CoprocessorRegisterCalendarClock = 0x283 + +CoprocessorRegisterFlushCachesForVMA = 0x284 + +CoprocessorRegisterFlipToStack = 0x285 + +CoprocessorRegisterUnwindStackForRestartOrApply = 0x286 + +CoprocessorRegisterSaveWorld = 0x287 + +CoprocessorRegisterConsoleInputAvailableP = 0x288 + +CoprocessorRegisterWaitForEvent = 0x289 + +CoprocessorRegisterFlushHiddenArrayRegisters = 0x28A + +CoprocessorRegisterConsoleIO = 0x28B + +CoprocessorRegisterAttachDiskChannel = 0x28C + +CoprocessorRegisterGrowDiskPartition = 0x28D + +CoprocessorRegisterDetachDiskChannel = 0x28E + +CoprocessorRegisterUnixCrypt = 0x28F + +AddressNIL = 0xF8041200 + +AddressT = 0xF8041208 + +ALUConditionSignedLessThanOrEqual = 0x0 + +ALUConditionSignedLessThan = 0x1 + +ALUConditionNegative = 0x2 + +ALUConditionSignedOverflow = 0x3 + +ALUConditionUnsignedLessThanOrEqual = 0x4 + +ALUConditionUnsignedLessThan = 0x5 + +ALUConditionZero = 0x6 + +ALUConditionHigh25Zero = 0x7 + +ALUConditionEq = 0x8 + +ALUConditionOp1Ephemeralp = 0x9 + +ALUConditionOp1TypeAcceptable = 0xA + +ALUConditionOp1TypeCondition = 0xB + +ALUConditionResultTypeNil = 0xC + +ALUConditionOp2Fixnum = 0xD + +ALUConditionFalse = 0xE + +ALUConditionResultCdrLow = 0xF + +ALUConditionCleanupBitsSet = 0x10 + +ALUConditionAddressInStackCache = 0x11 + +ALUConditionPendingSequenceBreakEnabled = 0x12 + +ALUConditionExtraStackMode = 0x13 + +ALUConditionFepMode = 0x14 + +ALUConditionFpCoprocessorPresent = 0x15 + +ALUConditionOp1Oldspacep = 0x16 + +ALUConditionStackCacheOverflow = 0x17 + +ALUConditionOrLogicVariable = 0x18 + +ALUAdderOp2Op2 = 0x0 + +ALUAdderOp2Zero = 0x1 + +ALUAdderOp2Invert = 0x2 + +ALUAdderOp2MinusOne = 0x3 + +ALUByteFunctionDpb = 0x0 + +ALUByteFunctionLdb = 0x1 + +ALUByteBackgroundOp1 = 0x0 + +ALUByteBackgroundRotateLatch = 0x1 + +ALUByteBackgroundZero = 0x2 + +BooleClear = 0x0 + +BooleAnd = 0x1 + +BooleAndC1 = 0x2 + +Boole2 = 0x3 + +BooleAndC2 = 0x4 + +Boole1 = 0x5 + +BooleXor = 0x6 + +BooleIor = 0x7 + +BooleNor = 0x8 + +BooleEquiv = 0x9 + +BooleC1 = 0xA + +BooleOrC1 = 0xB + +BooleC2 = 0xC + +BooleOrC2 = 0xD + +BooleNand = 0xE + +BooleSet = 0xF + +ALUFunctionBoolean = 0x0 + +ALUFunctionByte = 0x1 + +ALUFunctionAdder = 0x2 + +ALUFunctionMultiplyDivide = 0x3 + +CycleDataRead = 0x0 + +CycleDataWrite = 0x1 + +CycleBindRead = 0x2 + +CycleBindWrite = 0x3 + +CycleBindReadNoMonitor = 0x4 + +CycleBindWriteNoMonitor = 0x5 + +CycleHeader = 0x6 + +CycleStructureOffset = 0x7 + +CycleScavenge = 0x8 + +CycleCdr = 0x9 + +CycleGCCopy = 0xA + +CycleRaw = 0xB + +CycleRawTranslate = 0xC + +MemoryActionNone = 0x0 + +MemoryActionIndirect = 0x1 + +MemoryActionMonitor = 0x2 + +MemoryActionTransport = 0x4 + +MemoryActionTrap = 0x8 + +MemoryActionTransform = 0x10 + +MemoryActionBinding = 0x20 + +TrapModeEmulator = 0x0 + +TrapModeExtraStack = 0x1 + +TrapModeIO = 0x2 + +TrapModeFEP = 0x3 + +ReturnValueNormal = 0x0 + +ReturnValueException = 0x1 + +ReturnValueIllegalOperand = 0x2 + +HaltReasonIllInstn = 0x1 + +HaltReasonHalted = 0x2 + +HaltReasonSpyCalled = 0x3 + +HaltReasonFatalStackOverflow = 0x4 + +HaltReasonIllegalTrapVector = 0x5 + +TrapReasonHighPrioritySequenceBreak = 0x1 + +TrapReasonLowPrioritySequenceBreak = 0x2 + +VMAttributeAccessFault = 0x1 + +VMAttributeWriteFault = 0x2 + +VMAttributeTransportFault = 0x4 + +VMAttributeTransportDisable = 0x8 + +VMAttributeEphemeral = 0x10 + +VMAttributeModified = 0x20 + +VMAttributeExists = 0x40 + +VMAttributeCreatedDefault = 0x45 + +MemoryPageSize = 0x2000 + +MemoryPageAddressShift = 0xD + +DoubleFloatOpAdd = 0x0 + +DoubleFloatOpSub = 0x1 + +DoubleFloatOpMultiply = 0x2 + +DoubleFloatOpDivide = 0x3 diff --git a/emulator/aihead.sid b/emulator/aihead.sid new file mode 100644 index 0000000..496edb4 --- /dev/null +++ b/emulator/aihead.sid @@ -0,0 +1,605 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(define-values |Type| + (|Null| 0) ; 00 Unbound variable/function uninitialized storage + (|MonitorForward| 1) ; 01 This cell being monitored + (|HeaderP| 2) ; 02 Structure header with pointer field + (|HeaderI| 3) ; 03 Structure header with immediate bits + (|ExternalValueCellPointer| 4) ; 04 Invisible except for binding + (|OneQForward| 5) ; 05 Invisible pointer (forwards one cell) + (|HeaderForward| 6) ; 06 Invisible pointer (forwards whole structure) + (|ElementForward| 7) ; 07 Invisible pointer in element of structure + (|Fixnum| 8) ; 10 Small integer + (|SmallRatio| 9) ; 11 Ratio with small numerator and denominator + (|SingleFloat| 10) ; 12 SinglePrecision floating point + (|DoubleFloat| 11) ; 13 DoublePrecision floating point + (|Bignum| 12) ; 14 Big integer + (|BigRatio| 13) ; 15 Ratio with big numerator or denominator + (|Complex| 14) ; 16 Complex number + (|SpareNumber| 15) ; 17 A number to the hardware trap mechanism + (|Instance| 16) ; 20 Ordinary instance + (|ListInstance| 17) ; 21 Instance that masquerades as a cons + (|ArrayInstance| 18) ; 22 Instance that masquerades as an array + (|StringInstance| 19) ; 23 Instance that masquerades as a string + (NIL 20) ; 24 The symbol NIL + (|List| 21) ; 25 A cons + (|Array| 22) ; 26 An array that is not a string + (|String| 23) ; 27 A string + (|Symbol| 24) ; 30 A symbol other than NIL + (|Locative| 25) ; 31 Locative pointer + (|LexicalClosure| 26) ; 32 Lexical closure of a function + (|DynamicClosure| 27) ; 33 Dynamic closure of a function + (|CompiledFunction| 28) ; 34 Compiled code + (|GenericFunction| 29) ; 35 Generic function (see later section) + (|SparePointer1| 30) ; 36 Spare + (|SparePointer2| 31) ; 37 Spare + (|PhysicalAddress| 32) ; 40 Physical address + (|NativeInstruction| 33) ; 41 NativeInstruction + (|BoundLocation| 34) ; 42 Deep bound marker + (|Character| 35) ; 43 Common Lisp character object + (|LogicVariable| 36) ; 44 Unbound logic variable marker + (|GCForward| 37) ; 45 ObjectMoved flag for garbage collector + (|EvenPC| 38) ; 46 PC at first instruction in word + (|OddPC| 39) ; 47 PC at second instruction in word + (|CallCompiledEven| 40) ; 50 Start call address is compiled function + (|CallCompiledOdd| 41) ; 51 Start call address is compiled function + (|CallIndirect| 42) ; 52 Start call address is function cell + (|CallGeneric| 43) ; 53 Start call address is generic function + (|CallCompiledEvenPrefetch| 44) ; 54 Like above but prefetching is desireable + (|CallCompiledOddPrefetch| 45) ; 55 Like above but prefetching is desireable + (|CallIndirectPrefetch| 46) ; 56 Like above but prefetching is desireable + (|CallGenericPrefetch| 47) ; 57 Like above but prefetching is desireable + (|PackedInstruction60| 48) ;; HalfWord (packed) instructions consume 4 bits of data type field (opcodes 60..77). + (|TypePackedInstruction61| 49) + (|TypePackedInstruction62| 50) + (|PackedInstruction63| 51) + (|TypePackedInstruction64| 52) + (|TypePackedInstruction65| 53) + (|PackedInstruction66| 54) + (|TypePackedInstruction67| 55) + (|TypePackedInstruction70| 56) + (|PackedInstruction71| 57) + (|TypePackedInstruction72| 58) + (|TypePackedInstruction73| 59) + (|PackedInstruction74| 60) + (|TypePackedInstruction75| 61) + (|TypePackedInstruction76| 62) + (|PackedInstruction77| 63)) + +(define-values |Cdr| + (|Next| 0) + (|Nil| 1) + (|Normal| 2)) + +(define-values |Array| + (|ElementTypeFixnum| 0) + (|ElementTypeCharacter| 1) + (|ElementTypeBoolean| 2) + (|ElementTypeObject| 3) + ;; Prefix Header 32 bit field + (|TypeFieldPos| 26) + (|TypeFieldSize| 6) + (|TypeFieldMask| #x3F) + (|ElementTypePos| 30) + (|ElementTypeSize| 2) + (|ElementTypeMask| 3) + (|BytePackingPos| 27) + (|BytePackingSize| 3) + (|BytePackingMask| 7) + (|ListBitPos| 26) + (|ListBitSize| 1) + (|ListBitMask| 1) + (|NamedStructureBitPos| 25) + (|NamedStructureBitSize| 1) + (|NamedStructureBitMask| 1) + (|Spare1Pos| 24) + (|Spare1Size| 1) + (|Spare1Mask| 1) + (|LongPrefixBitPos| 23) + (|LongPrefixBitSize| 1) + (|LongPrefixBitMask| 1) + (|LeaderLengthFieldPos| 15) + (|LeaderLengthFieldSize| 8) + (|LeaderLengthFieldMask| #xFF) + + (|LengthPos| 0) ;For array-prefix-short + (|LengthSize| 15) + (|LengthMask| #x7FFF) + + (|DisplacedBitPos| 14) ;For array-prefix-long + (|DisplacedBitSize| 1) + (|DisplacedBitMask| 1) + (|DiscontiguousBitPos| 13) + (|DiscontinuousBitSize| 1) + (|DiscontiguousBitMask| 1) + (|LongSparePos| 3) + (|LongSpareSize| 12) + (|LongSpareMask| #xFFF) + (|LongDimensionsFieldPos| 0) + (|LongDimensionsFieldSize| 3) + (|LongDimensionsFieldMask| 7) + + ;; Array Register fileds + (|RegisterElementTypePos| 30) + (|RegisterElementTypeSize| 2) + (|RegisterElementTypeMask| 3) + (|RegisterBytePackingPos| 27) + (|RegisterBytePackingSize| 3) + (|RegisterBytePackingMask| 7) + (|RegisterByteOffsetPos| 22) + (|RegisterByteOffsetSize| 5) + (|RegisterByteOffsetMask| #x1F) + (|RegisterEventCountPos| 0) + (|RegisterEventCountSize| 22) + (|RegisterEventCountMask| #x3FFFFF)) + +(define-values |ValueDisposition| + (|Effect| 0) + (|Value| 1) + (|Return| 2) + (|Multiple| 3)) + +(define-values |Opcode| + ;; List manipulation + (|Car| #o00) + (|Cdr| #o01) + (|SetToCar| #o0140) + (|SetToCdr| #o0141) + (|SetToCdrPushCar| #o0142) + (|Rplaca| #o0200) + (|Rplacd| #o0201) + (|Rgetf| #o0225) + (|Member| #o0226) + (|Assoc| #o0227) + ;; AI Instructions + (|Dereference| #o013) + (|Unify| #o0237) + (|PushLocalLogicVariables| #o0103) + (|PushGlobalLogicVariable| #o055) + (|LogicTailTest| #o014) + ;; Binary predicates + (|Eq| #o0270) + (|EqNoPop| #o0274) + (|Eql| #o0263) + (|EqlNoPop| #o0267) + (|EqualNumber| #o0260) + (|EqualNumberNoPop| #o0264) + (|Greaterp| #o0262) + (|GreaterpNoPop| #o0266) + (|Lessp| #o0261) + (|LesspNoPop| #o0265) + (|Logtest| #o0273) + (|LogtestNoPop| #o0277) + (|TypeMember| #o040) ;also 41 42 43 + (|TypeMemberNoPop| #o044) ;also 45 46 47 + ;; Unary predicates + (|Endp| #o02) + (|Plusp| #o036) + (|Minusp| #o035) + (|Zerop| #o034) + ;; Numeric operations + (|Add| #o0300) + (|Sub| #o0301) + (|UnaryMinus| #o0114) + (|Increment| #o0143) + (|Decrement| #o0144) + (|Multiply| #o0202) + (|Quotient| #o0203) + (|Ceiling| #o0204) + (|Floor| #o0205) + (|Truncate| #o0206) + (|Round| #o0207) + (|RationalQuotient| #o0211) + (|Max| #o0213) + (|Min| #o0212) + (|Logand| #o0215) + (|Logior| #o0217) + (|Logxor| #o0216) + (|Ash| #o0232) + (|Rot| #o0220) + (|Lsh| #o0221) + (|32BitPlus| #o0302) + (|32BitDifference| #o0303) + (|MultiplyDouble| #o0222) + (|AddBignumStep| #o0304) + (|SubBignumStep| #o0305) + (|MultiplyBignumStep| #o0306) + (|DivideBignumStep| #o0307) + (|LshcBignumStep| #o0223) + (|DoubleFloatOp| #o016) + ;; Data movement + (|Push| #o0100) + (|Pop| #o0340) + (|Movem| #o0341) + (|PushNNils| #o0101) + (|PushAddress| #o0150) + (|SetSpToAddress| #o0151) + (|SetSpToAddressSaveTos| #o0152) + (|PushAddressSpRelative| #o0102) + (|StackBlt| #o0224) + (|StackBltAddress| #o0352) + ;; FieldExtraction instructions + (|Ldb| #o0170) + (|Dpb| #o0370) + (|CharLdb| #o0171) + (|CharDpb| #o0371) + (|PLdb| #o0172) + (|PDpb| #o0372) + (|PTagLdb| #o0173) + (|PTagDpb| #o0373) + ;; Array operations + (|Aref1| #o0312) + (|Aset1| #o0310) + (|Aloc1| #o0313) + (|Setup1DArray| #o03) + (|SetupForce1DArray| #o04) + (|FastAref1| #o0350) + (|FastAset1| #o0351) + (|ArrayLeader| #o0316) + (|StoreArrayLeader| #o0314) + (|AlocLeader| #o0317) + ;; Branch instructions + (|Branch| #o0174) + (|BranchTrue| #o060) + (|BranchTrueElseExtraPop| #o061) + (|BranchTrueAndExtraPop| #o062) + (|BranchTrueExtraPop| #o063) + (|BranchTrueNoPop| #o064) + (|BranchTrueAndNoPop| #o065) + (|BranchTrueElseNoPop| #o066) + (|BranchTrueAndNoPopElseNoPopExtraPop| #o067) + (|BranchFalse| #o070) + (|BranchFalseElseExtraPop| #o071) + (|BranchFalseAndExtraPop| #o072) + (|BranchFalseExtraPop| #o073) + (|BranchFalseNoPop| #o074) + (|BranchFalseAndNoPop| #o075) + (|BranchFalseElseNoPop| #o076) + (|BranchFalseAndNoPopElseNoPopExtraPop| #o077) + (|LoopDecrementTos| #o0175) + (|LoopIncrementTosLessThan| #o0375) + ;; Block instructions + (|Block0Read| #o0120) + (|Block1Read| #o0121) + (|Block2Read| #o0122) + (|Block3Read| #o0123) + (|Block0ReadShift| #o0124) + (|Block1ReadShift| #o0125) + (|Block2ReadShift| #o0126) + (|Block3ReadShift| #o0127) + (|Block0ReadAlu| #o0160) + (|Block1ReadAlu| #o0161) + (|Block2ReadAlu| #o0162) + (|Block3ReadAlu| #o0163) + (|Block0ReadTest| #o0130) + (|Block1ReadTest| #o0131) + (|Block2ReadTest| #o0132) + (|Block3ReadTest| #o0133) + (|Block0Write| #o030) + (|Block1Write| #o031) + (|Block2Write| #o032) + (|Block3Write| #o033) + ;;Instruction calling + (|StartCall| #o010) + (|FinishCallN| #o0134) + (|FinishCallNApply| #o0135) + (|FinishCallTos| #o0136) + (|FinishCallTosApply| #o0137) + (|EntryRestAccepted| #o0176) + (|EntryRestNotAccepted| #o0177) + (|LocateLocals| #o050) + (|ReturnSingle| #o0115) + (|ReturnMultiple| #o0104) + (|ReturnKludge| #o0105) + (|TakeValues| #o0106) + ;; Binding instructions + (|BindLocativeToValue| #o0236) + (|BindLocative| #o05) + (|UnbindN| #o0107) + (|RestoreBindingStack| #o06) + ;; Catch + (|CatchOpen| #o0376) + (|CatchClose| #o051) + ;; Lexical variables - Each takes 8 opcodes + (|PushLexicalVar| #o020) ;also 21 22 23 24 25 26 27 + (|PopLexicalVar| #o0240) ;also 241 242 243 244 245 246 247 + (|MovemLexicalVar| #o0250) ;also 251 252 253 254 255 256 257 + ;; Instance variables + (|PushInstanceVariable| #o0110) + (|PopInstanceVariable| #o0320) + (|MovemInstanceVariable| #o0321) + (|PushAddressInstanceVariable| #o0111) + (|PushInstanceVariableOrdered| #o0112) + (|PopInstanceVariableOrdered| #o0322) + (|MovemInstanceVariableOrdered| #o0323) + (|PushAddressInstanceVariableOrdered| #o0113) + (|InstanceRef| #o0324) + (|InstanceSet| #o0325) + (|InstanceLoc| #o0326) + ;; Subprimitives + (|Ephemeralp| #o07) + (|UnsignedLessp| #o0331) + (|UnsignedLesspNoPop| #o0335) + (|Alu| #o0214) + (|AllocateListBlock| #o0311) + (|AllocateStructureBlock| #o0315) + (|PointerPlus| #o0230) + (|PointerDifference| #o0231) + (|PointerIncrement| #o0145) + (|ReadInternalRegister| #o0154) + (|WriteInternalRegister| #o0155) + (|CoprocessorRead| #o0156) + (|CoprocessorWrite| #o0157) + (|MemoryRead| #o0116) + (|MemoryReadAddress| #o0117) + (|Tag| #o012) + (|SetTag| #o0327) + (|StoreConditional| #o0233) + (|MemoryWrite| #o0234) + (|PStoreContents| #o0235) + (|SetCdrCode1| #o0146) + (|SetCdrCode2| #o0147) + (|MergeCdrNoPop| #o0342) + (|GenericDispatch| #o052) + (|MessageDispatch| #o053) + (|Jump| #o011) + (|CheckPreemptRequest| #o054) + (|NoOp| #o056) + (|Halt| #o057)) + +(define-values |Control| + (|Apply| #o400000) + (|CleanupBits| #o700000000) + (|CallStarted| #o20000000) + (|ExtraArgument| #o400) ;1<<8 + (|ArgumentSize| #o377) + (|CallerFrameSize| #o377000) + (|ValueDisposition| #o3000000)) + +(define-values |InternalRegister| + (|EA| #o0) + (|FP| #o1) + (|LP| #o2) + (|SP| #o3) + (|MacroSP| #o4) + (|StackCacheLowerBound| #o5) + (|BAR0| #o6) + (|BAR1| #o206) + (|BAR2| #o406) + (|BAR3| #o606) + (|PHTHash0| #o7) + (|PHTHash1| #o207) + (|PHTHash2| #o407) + (|PHTHash3| #o607) + (|EPC| #o10) + (|DPC| #o11) + (|Continuation| #o12) + (|AluAndRotateControl| #o13) + (|ControlRegister| #o14) + (|CRArgumentSize| #o15) + (|EphemeralOldspaceRegister| #o16) + (|ZoneOldspaceRegister| #o17) + (|ChipRevision| #o20) + (|FPCoprocessorPresent| #o21) + (|PreemptRegister| #o23) + (|IcacheControl| #o24) + (|PrefetcherControl| #o25) + (|MapCacheControl| #o26) + (|MemoryControl| #o27) + (|ECCLog| #o30) + (|ECCLogAddress| #o31) + (|InvalidateMap0| #o32) + (|InvalidateMap1| #o232) + (|InvalidateMap2| #o432) + (|InvalidateMap3| #o632) + (|LoadMap0| #o33) + (|LoadMap1| #o233) + (|LoadMap2| #o433) + (|LoadMap3| #o633) + (|StackCacheOverflowLimit| #o34) + (|UcodeROMContents| #o35) + (|AddressMask| #o37) + (|EntryMaximumArguments| #o40) + (|LexicalVariable| #o41) + (|Instruction| #o42) + (|MemoryData| #o44) + (|DataPins| #o45) + (|ExtensionRegister| #o46) + (|MicrosecondClock| #o47) + (|ArrayHeaderLength| #o50) + (|LoadBAR0| #o52) + (|LoadBAR1| #o252) + (|LoadBAR2| #o452) + (|LoadBAR3| #o652) + (|TOS| #o1000) + (|EventCount| #o1001) + (|BindingStackPointer| #o1002) + (|CatchBlockList| #o1003) + (|ControlStackLimit| #o1004) + (|ControlStackExtraLimit| #o1005) + (|BindingStackLimit| #o1006) + (|PHTBase| #o1007) + (|PHTMask| #o1010) + (|CountMapReloads| #o1011) + (|ListCacheArea| #o1012) + (|ListCacheAddress| #o1013) + (|ListCacheLength| #o1014) + (|StructureCacheArea| #o1015) + (|StructureCacheAddress| #o1016) + (|StructureCacheLength| #o1017) + (|DynamicBindingCacheBase| #o1020) + (|DynamicBindingCacheMask| #o1021) + (|ChoicePointer| #o1022) + (|StructureStackChoicePointer| #o1023) + (|FEPModeTrapVectorAddress| #o1024) + (|MappingTableCache| #o1026) + (|MappingTableLength| #o1027) + (|StackFrameMaximumSize| #o1030) + (|StackCacheDumpQuantum| #o1031) + (|ConstantNIL| #o1040) + (|ConstantT| #o1041)) + +(define-values |CoprocessorRegister| + (|MicrosecondClock| #o1002) + (|HostInterrupt| #o1010) + (|VMRegisterCommand| #o1100) + (|VMRegisterAddress| #o1101) + (|VMRegisterExtent| #o1102) + (|VMRegisterAttributes| #o1103) + (|VMRegisterDestination| #o1104) + (|VMRegisterData| #o1105) + (|VMRegisterMaskLow| #o1106) + (|VMRegisterMaskHigh| #o1107) + (|VMRegisterCommandBlock| #o1110) + (|StackSwitch| #o1200) + (|FlushStackCache| #o1201) + (|FlushIDCaches| #o1202) + (|CalendarClock| #o1203) + (|FlushCachesForVMA| #o1204) + (|FlipToStack| #o1205) + (|UnwindStackForRestartOrApply| #o1206) + (|SaveWorld| #o1207) + (|ConsoleInputAvailableP| #o1210) + (|WaitForEvent| #o1211) + (|FlushHiddenArrayRegisters| #o1212) + (|ConsoleIO| #o1213) + (|AttachDiskChannel| #o1214) + (|GrowDiskPartition| #o1215) + (|DetachDiskChannel| #o1216) + (|UnixCrypt| #o1217)) + +(define-values |Address| + (|NIL| #xf8041200) + (|T| #xf8041208)) + +(define-values |ALUCondition| + (|SignedLessThanOrEqual| 0) + (|SignedLessThan| 1) + (|Negative| 2) + (|SignedOverflow| 3) + (|UnsignedLessThanOrEqual| 4) + (|UnsignedLessThan| 5) + (|Zero| 6) + (|High25Zero| 7) + (|Eq| 8) + (|Op1Ephemeralp| 9) + (|Op1TypeAcceptable| 10) + (|Op1TypeCondition| 11) + (|ResultTypeNil| 12) + (|Op2Fixnum| 13) + (|False| 14) + (|ResultCdrLow| 15) + (|CleanupBitsSet| 16) + (|AddressInStackCache| 17) + (|PendingSequenceBreakEnabled| 18) + (|ExtraStackMode| 19) + (|FepMode| 20) + (|FpCoprocessorPresent| 21) + (|Op1Oldspacep| 22) + (|StackCacheOverflow| 23) + (|OrLogicVariable| 24)) + +(define-values |ALUAdderOp2| + (|Op2| 0) + (|Zero| 1) + (|Invert| 2) + (|MinusOne| 3)) + +(define-values |ALUByteFunction| + (|Dpb| 0) + (|Ldb| 1)) + +(define-values |ALUByteBackground| + (|Op1| 0) + (|RotateLatch| 1) + (|Zero| 2)) + +(define-values |Boole| + (|Clear| 0) + (|And| 1) + (|AndC1| 2) + (|2| 3) + (|AndC2| 4) + (|1| 5) + (|Xor| 6) + (|Ior| 7) + (|Nor| 8) + (|Equiv| 9) + (|C1| 10) + (|OrC1| 11) + (|C2| 12) + (|OrC2| 13) + (|Nand| 14) + (|Set| 15)) + +(define-values |ALUFunction| + (|Boolean| 0) + (|Byte| 1) + (|Adder| 2) + (|MultiplyDivide| 3)) + +(define-values |Cycle| + (|DataRead| 0) + (|DataWrite| 1) + (|BindRead| 2) + (|BindWrite| 3) + (|BindReadNoMonitor| 4) + (|BindWriteNoMonitor| 5) + (|Header| 6) + (|StructureOffset| 7) + (|Scavenge| 8) + (|Cdr| 9) + (|GCCopy| 10) + (|Raw| 11) + (|RawTranslate| 12)) + +(define-values |MemoryAction| + (|None| #o0) + (|Indirect| #o1) + (|Monitor| #o2) + (|Transport| #o4) + (|Trap| #o10) + (|Transform| #o20) + (|Binding| #o40)) + +(define-values |TrapMode| + (|Emulator| 0) + (|ExtraStack| 1) + (|IO| 2) + (|FEP| 3)) + +(define-values |ReturnValue| + (|Normal| 0) + (|Exception| 1) + (|IllegalOperand| 2)) + +(define-values |HaltReason| + (|IllInstn| 1) + (|Halted| 2) + (|SpyCalled| 3) + (|FatalStackOverflow| 4) + (|IllegalTrapVector| 5)) + +(define-values |TrapReason| + (|HighPrioritySequenceBreak| 1) + (|LowPrioritySequenceBreak| 2)) + +(define-values |VMAttribute| + (|AccessFault| #o1) + (|WriteFault| #o2) + (|TransportFault| #o4) + (|TransportDisable| #o10) + (|Ephemeral| #o20) + (|Modified| #o40) + (|Exists| #o100) + (|CreatedDefault| #o105)) + +(define-values |MemoryPage| + (|Size| #x2000) + (|AddressShift| 13)) + +(define-values |DoubleFloatOp| + (|Add| #o0) + (|Sub| #o1) + (|Multiply| #o2) + (|Divide| #o3)) diff --git a/emulator/aistat.h b/emulator/aistat.h new file mode 100644 index 0000000..8286e12 --- /dev/null +++ b/emulator/aistat.h @@ -0,0 +1,326 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid Any changes made to it will be lost. */ + +#ifndef _AISTAT_ +#define _AISTAT_ + + + +typedef struct processorstate { + uint64_t transpare3; + uint64_t transpare2; + uint64_t transpare1; + uint64_t carcdrsubroutine; + uint64_t cdrsubroutine; + uint64_t carsubroutine; + uint64_t linkage; + uint64_t resumeema; + char *statistics; + char *trace_hook; + int64_t instruction_count; + uint64_t long_pad0; + uint64_t asrr9; + uint64_t asrr10; + uint64_t asrr11; + uint64_t asrr12; + uint64_t asrr13; + uint64_t asrr14; + uint64_t asrr15; + uint64_t long_pad1; + uint64_t asrr26; + uint64_t asrr27; + uint64_t asrr29; + uint64_t asrr30; + uint64_t asrf2; + uint64_t asrf3; + uint64_t asrf4; + uint64_t asrf5; + uint64_t asrf6; + uint64_t asrf7; + uint64_t asrf8; + uint64_t asrf9; + char *meterdatabuff; + uint32_t meterpos; + uint32_t metermax; + uint32_t meterfreq; + uint32_t metermask; + uint32_t metervalue; + uint32_t metercount; + uint64_t choiceptr; + uint64_t sstkchoiceptr; + uint64_t dbcbase; + uint64_t dbcmask; + char *coprocessorreadhook; + char *coprocessorwritehook; + char *flushcaches_hook; + char *i_stage_error_hook; + uint64_t sfp1; + uint64_t fp0; + uint64_t fp1; + uint64_t floating_exception; + uint64_t aluandrotatecontrol; + uint64_t rotatelatch; + uint64_t aluborrow; + uint64_t aluoverflow; + uint64_t alulessthan; + uint64_t aluop; + uint64_t byterotate; + uint64_t bytesize; + int64_t bindingstacklimit; + int64_t bindingstackpointer; + uint64_t catchblock; + uint64_t extraandcatch; + uint64_t msclockcache; + uint64_t mscmultiplier; + uint64_t previousrcpp; + char *rlink; + uint32_t interruptreg; + uint32_t zoneoldspace; + uint32_t ephemeraloldspace; + uint32_t int_pad0; + uint64_t eqnoteql; + uint32_t lclength; + uint32_t sclength; + uint64_t lcarea; + uint64_t lcaddress; + uint64_t scarea; + uint64_t scaddress; + uint64_t restartsp; + uint64_t stop_interpreter; + uint64_t immediate_arg; + uint64_t continuationcp; + int64_t continuation; + int64_t control; + int64_t niladdress; + int64_t taddress; + int64_t bar0; + int64_t bar1; + int64_t bar2; + int64_t bar3; + int64_t epc; + int64_t fp; + int64_t lp; + int64_t sp; + char *cp; + uint64_t fccrmask; + uint32_t cslimit; + uint32_t csextralimit; + char *trapmeterdata; + uint64_t fepmodetrapvecaddress; + uint64_t trapvecbase; + uint64_t tvi; + uint64_t fccrtrapmask; + char *ptrtype; + char *vmattributetable; + uint64_t vma; + int64_t mostnegativefixnum; + char *icachebase; + char *endicache; + uint64_t fullworddispatch; + uint64_t halfworddispatch; + int64_t areventcount; + uint64_t stackcachesize; + uint64_t stackcachetopvma; + uint64_t cdrcodemask; + char *stackcachedata; + uint64_t stackcachebasevma; + uint32_t scovlimit; + uint32_t scovdumpcount; + int64_t mostpositivefixnum; + uint64_t internalregisterread1; + uint64_t internalregisterread2; + uint64_t internalregisterwrite1; + uint64_t internalregisterwrite2; + uint64_t dataread_mask; + char *dataread; + uint64_t datawrite_mask; + char *datawrite; + uint64_t bindread_mask; + char *bindread; + uint64_t bindwrite_mask; + char *bindwrite; + uint64_t bindreadnomonitor_mask; + char *bindreadnomonitor; + uint64_t bindwritenomonitor_mask; + char *bindwritenomonitor; + uint64_t header_mask; + char *header; + uint64_t structureoffset_mask; + char *structureoffset; + uint64_t scavenge_mask; + char *scavenge; + uint64_t cdr_mask; + char *cdr; + uint64_t gccopy_mask; + char *gccopy; + uint64_t raw_mask; + char *raw; + uint64_t rawtranslate_mask; + char *rawtranslate; + int32_t please_stop; + int32_t please_trap; + int64_t runningp; + uint64_t ac0array; + uint64_t ac0arword; + uint64_t ac0locat; + uint64_t ac0length; + uint64_t ac1array; + uint64_t ac1arword; + uint64_t ac1locat; + uint64_t ac1length; + uint64_t ac2array; + uint64_t ac2arword; + uint64_t ac2locat; + uint64_t ac2length; + uint64_t ac3array; + uint64_t ac3arword; + uint64_t ac3locat; + uint64_t ac3length; + uint64_t ac4array; + uint64_t ac4arword; + uint64_t ac4locat; + uint64_t ac4length; + uint64_t ac5array; + uint64_t ac5arword; + uint64_t ac5locat; + uint64_t ac5length; + uint64_t ac6array; + uint64_t ac6arword; + uint64_t ac6locat; + uint64_t ac6length; + uint64_t ac7array; + uint64_t ac7arword; + uint64_t ac7locat; + uint64_t ac7length; + uint32_t tmcurrenttransaction; + uint32_t tmwritestart; + uint32_t tmwritecurrent; + uint32_t tmwritelimit; + uint32_t tmrecordingreads; + uint32_t tmreadstart; + uint32_t tmreadcurrent; + uint32_t tmreadlimit; + } PROCESSORSTATE, *PROCESSORSTATEP; + +#define PROCESSORSTATE_SIZE 1440 + +typedef struct cacheline { + uint64_t annotation; + uint32_t nextpcdata; + uint32_t nextpctag; + char *nextcp; + uint32_t instruction; + uint32_t operand; + uint32_t pcdata; + uint32_t pctag; + char *code; + } CACHELINE, *CACHELINEP; + +#define CACHELINE_SIZE 48 + +#define CacheLine_Bits 18 + +#define CacheLine_Mask 262143 + +#define CacheLine_RShift 16 + +#define CacheLine_LShift 6 + +#define CacheLine_FillAmount 20 + +typedef struct arraycache { + uint64_t array; + uint64_t arword; + uint64_t locat; + uint64_t length; + } ARRAYCACHE, *ARRAYCACHEP; + +#define AutoArrayReg_Mask 224 + +#define AutoArrayReg_Size 32 + +#define AutoArrayReg_Shift 0 + +#define MSclock_UnitsToMSShift 24 + +#define MSclock_UnitsPerMicrosecond 16777216 + +#define Stack_CacheSize 1792 + +#define Stack_MaxFrameSize 128 + +#define Stack_CacheMargin 128 + +#define Stack_CacheDumpQuantum 896 + +#define IvoryMemory_Data 35 + +#define IvoryMemory_Tag 33 + +typedef struct savedregisters { + uint64_t r9; + uint64_t r10; + uint64_t r11; + uint64_t r12; + uint64_t r13; + uint64_t r14; + uint64_t r15; + uint64_t r29; + uint64_t f2; + uint64_t f3; + uint64_t f4; + uint64_t f5; + uint64_t f6; + uint64_t f7; + uint64_t f8; + uint64_t f9; + } SAVEDREGISTERS, *SAVEDREGISTERSP; + +#define SAVEDREGISTERS_SIZE 128 + +typedef struct tracedata { + uint64_t n_entries; + uint32_t recording_p; + uint32_t wrap_p; + uint64_t start_pc; + uint64_t stop_pc; + char *records_start; + char *records_end; + char *current_entry; + char *printer; + } TRACEDATA, *TRACEDATAP; + +#define TRACEDATA_SIZE 64 + +typedef struct tracerecord { + uint64_t counter; + uint64_t epc; + uint64_t tos; + uint64_t sp; + char *instruction; + uint64_t instruction_data; + uint32_t operand; + uint32_t trap_p; + uint64_t trap_data_0; + uint64_t trap_data_1; + uint64_t trap_data_2; + uint64_t trap_data_3; + uint32_t catch_block_p; + uint32_t int_pad0; + uint64_t catch_block_0; + uint64_t catch_block_1; + uint64_t catch_block_2; + uint64_t catch_block_3; + } TRACERECORD, *TRACERECORDP; + +#define TRACERECORD_SIZE 128 + +#define CacheMeter_Pwr 14 + +#define CacheMeter_DefaultFreq 1000 +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid Any changes made to it will be lost. */ + +#endif + + diff --git a/emulator/asmfuns.h b/emulator/asmfuns.h new file mode 100644 index 0000000..59fed7c --- /dev/null +++ b/emulator/asmfuns.h @@ -0,0 +1,355 @@ +/* -*- Mode:C; Lowercase: Yes -*- */ + +#ifndef _ASMFUNS_ +#define _ASMFUNS_ + +/* Halfword Instruction Handler Routines */ +extern void DoCarFP(void), DoCarLP(void), DoCarSP(void), DoCarIM(void); +extern void DoCdrFP(void), DoCdrLP(void), DoCdrSP(void), DoCdrIM(void); +extern void DoEndpFP(void), DoEndpLP(void), DoEndpSP(void), DoEndpIM(void); +extern void DoSetup1DArrayFP(void), DoSetup1DArrayLP(void), DoSetup1DArraySP(void), DoSetup1DArrayIM(void); +extern void DoSetupForce1DArrayFP(void), DoSetupForce1DArrayLP(void), DoSetupForce1DArraySP(void), DoSetupForce1DArrayIM(void); +extern void DoBindLocativeFP(void), DoBindLocativeLP(void), DoBindLocativeSP(void), DoBindLocativeIM(void); +extern void DoRestoreBindingStackFP(void), DoRestoreBindingStackLP(void), DoRestoreBindingStackSP(void), DoRestoreBindingStackIM(void); +extern void DoEphemeralpFP(void), DoEphemeralpLP(void), DoEphemeralpSP(void), DoEphemeralpIM(void); +extern void DoStartCallFP(void), DoStartCallLP(void), DoStartCallSP(void), DoStartCallIM(void); +extern void DoJumpFP(void), DoJumpLP(void), DoJumpSP(void), DoJumpIM(void); +extern void DoTagFP(void), DoTagLP(void), DoTagSP(void), DoTagIM(void); +extern void DoDereferenceFP(void), DoDereferenceLP(void), DoDereferenceSP(void), DoDereferenceIM(void); +extern void DoLogicTailTestFP(void), DoLogicTailTestLP(void), DoLogicTailTestSP(void), DoLogicTailTestIM(void); +extern void DoPushLexicalVarNFP(void), DoPushLexicalVarNLP(void), DoPushLexicalVarNSP(void), DoPushLexicalVarNIM(void); +extern void DoBlock0WriteFP(void), DoBlock0WriteLP(void), DoBlock0WriteSP(void), DoBlock0WriteIM(void); +extern void DoBlock1WriteFP(void), DoBlock1WriteLP(void), DoBlock1WriteSP(void), DoBlock1WriteIM(void); +extern void DoBlock2WriteFP(void), DoBlock2WriteLP(void), DoBlock2WriteSP(void), DoBlock2WriteIM(void); +extern void DoBlock3WriteFP(void), DoBlock3WriteLP(void), DoBlock3WriteSP(void), DoBlock3WriteIM(void); +extern void DoZeropFP(void), DoZeropLP(void), DoZeropSP(void), DoZeropIM(void); +extern void DoMinuspFP(void), DoMinuspLP(void), DoMinuspSP(void), DoMinuspIM(void); +extern void DoPluspFP(void), DoPluspLP(void), DoPluspSP(void), DoPluspIM(void); +extern void DoTypeMemberFP(void), DoTypeMemberLP(void), DoTypeMemberSP(void), DoTypeMemberIM(void); +extern void DoLocateLocalsFP(void), DoLocateLocalsLP(void), DoLocateLocalsSP(void), DoLocateLocalsIM(void); +extern void DoCatchCloseFP(void), DoCatchCloseLP(void), DoCatchCloseSP(void), DoCatchCloseIM(void); +extern void DoGenericDispatchFP(void), DoGenericDispatchLP(void), DoGenericDispatchSP(void), DoGenericDispatchIM(void); +extern void DoMessageDispatchFP(void), DoMessageDispatchLP(void), DoMessageDispatchSP(void), DoMessageDispatchIM(void); +extern void DoCheckPreemptRequestFP(void), DoCheckPreemptRequestLP(void), DoCheckPreemptRequestSP(void), DoCheckPreemptRequestIM(void); +extern void DoPushGlobalLogicVariableFP(void), DoPushGlobalLogicVariableLP(void), DoPushGlobalLogicVariableSP(void), DoPushGlobalLogicVariableIM(void); +extern void DoNoOpFP(void), DoNoOpLP(void), DoNoOpSP(void), DoNoOpIM(void); +extern void DoHaltFP(void), DoHaltLP(void), DoHaltSP(void), DoHaltIM(void); +extern void DoBranchTrueFP(void), DoBranchTrueLP(void), DoBranchTrueSP(void), DoBranchTrueIM(void); +extern void DoBranchTrueElseExtraPopFP(void), DoBranchTrueElseExtraPopLP(void), DoBranchTrueElseExtraPopSP(void), DoBranchTrueElseExtraPopIM(void); +extern void DoBranchTrueAndExtraPopFP(void), DoBranchTrueAndExtraPopLP(void), DoBranchTrueAndExtraPopSP(void), DoBranchTrueAndExtraPopIM(void); +extern void DoBranchTrueExtraPopFP(void), DoBranchTrueExtraPopLP(void), DoBranchTrueExtraPopSP(void), DoBranchTrueExtraPopIM(void); +extern void DoBranchTrueNoPopFP(void), DoBranchTrueNoPopLP(void), DoBranchTrueNoPopSP(void), DoBranchTrueNoPopIM(void); +extern void DoBranchTrueAndNoPopFP(void), DoBranchTrueAndNoPopLP(void), DoBranchTrueAndNoPopSP(void), DoBranchTrueAndNoPopIM(void); +extern void DoBranchTrueElseNoPopFP(void), DoBranchTrueElseNoPopLP(void), DoBranchTrueElseNoPopSP(void), DoBranchTrueElseNoPopIM(void); +extern void DoBranchTrueAndNoPopElseNoPopExtraPopFP(void), DoBranchTrueAndNoPopElseNoPopExtraPopLP(void), DoBranchTrueAndNoPopElseNoPopExtraPopSP(void), DoBranchTrueAndNoPopElseNoPopExtraPopIM(void); +extern void DoBranchFalseFP(void), DoBranchFalseLP(void), DoBranchFalseSP(void), DoBranchFalseIM(void); +extern void DoBranchFalseElseExtraPopFP(void), DoBranchFalseElseExtraPopLP(void), DoBranchFalseElseExtraPopSP(void), DoBranchFalseElseExtraPopIM(void); +extern void DoBranchFalseAndExtraPopFP(void), DoBranchFalseAndExtraPopLP(void), DoBranchFalseAndExtraPopSP(void), DoBranchFalseAndExtraPopIM(void); +extern void DoBranchFalseExtraPopFP(void), DoBranchFalseExtraPopLP(void), DoBranchFalseExtraPopSP(void), DoBranchFalseExtraPopIM(void); +extern void DoBranchFalseNoPopFP(void), DoBranchFalseNoPopLP(void), DoBranchFalseNoPopSP(void), DoBranchFalseNoPopIM(void); +extern void DoBranchFalseAndNoPopFP(void), DoBranchFalseAndNoPopLP(void), DoBranchFalseAndNoPopSP(void), DoBranchFalseAndNoPopIM(void); +extern void DoBranchFalseElseNoPopFP(void), DoBranchFalseElseNoPopLP(void), DoBranchFalseElseNoPopSP(void), DoBranchFalseElseNoPopIM(void); +extern void DoBranchFalseAndNoPopElseNoPopExtraPopFP(void), DoBranchFalseAndNoPopElseNoPopExtraPopLP(void), DoBranchFalseAndNoPopElseNoPopExtraPopSP(void), DoBranchFalseAndNoPopElseNoPopExtraPopIM(void); +extern void DoPushFP(void), DoPushLP(void), DoPushSP(void), DoPushIM(void); +extern void DoPushNNilsFP(void), DoPushNNilsLP(void), DoPushNNilsSP(void), DoPushNNilsIM(void); +extern void DoPushAddressSpRelativeFP(void), DoPushAddressSpRelativeLP(void), DoPushAddressSpRelativeSP(void), DoPushAddressSpRelativeIM(void); +extern void DoPushLocalLogicVariablesFP(void), DoPushLocalLogicVariablesLP(void), DoPushLocalLogicVariablesSP(void), DoPushLocalLogicVariablesIM(void); +extern void DoReturnMultipleFP(void), DoReturnMultipleLP(void), DoReturnMultipleSP(void), DoReturnMultipleIM(void); +extern void DoReturnKludgeFP(void), DoReturnKludgeLP(void), DoReturnKludgeSP(void), DoReturnKludgeIM(void); +extern void DoTakeValuesFP(void), DoTakeValuesLP(void), DoTakeValuesSP(void), DoTakeValuesIM(void); +extern void DoUnbindNFP(void), DoUnbindNLP(void), DoUnbindNSP(void), DoUnbindNIM(void); +extern void DoPushInstanceVariableFP(void), DoPushInstanceVariableLP(void), DoPushInstanceVariableSP(void), DoPushInstanceVariableIM(void); +extern void DoPushAddressInstanceVariableFP(void), DoPushAddressInstanceVariableLP(void), DoPushAddressInstanceVariableSP(void), DoPushAddressInstanceVariableIM(void); +extern void DoPushInstanceVariableOrderedFP(void), DoPushInstanceVariableOrderedLP(void), DoPushInstanceVariableOrderedSP(void), DoPushInstanceVariableOrderedIM(void); +extern void DoPushAddressInstanceVariableOrderedFP(void), DoPushAddressInstanceVariableOrderedLP(void), DoPushAddressInstanceVariableOrderedSP(void), DoPushAddressInstanceVariableOrderedIM(void); +extern void DoUnaryMinusFP(void), DoUnaryMinusLP(void), DoUnaryMinusSP(void), DoUnaryMinusIM(void); +extern void DoReturnSingleFP(void), DoReturnSingleLP(void), DoReturnSingleSP(void), DoReturnSingleIM(void); +extern void DoMemoryReadFP(void), DoMemoryReadLP(void), DoMemoryReadSP(void), DoMemoryReadIM(void); +extern void DoBlock0ReadFP(void), DoBlock0ReadLP(void), DoBlock0ReadSP(void), DoBlock0ReadIM(void); +extern void DoBlock1ReadFP(void), DoBlock1ReadLP(void), DoBlock1ReadSP(void), DoBlock1ReadIM(void); +extern void DoBlock2ReadFP(void), DoBlock2ReadLP(void), DoBlock2ReadSP(void), DoBlock2ReadIM(void); +extern void DoBlock3ReadFP(void), DoBlock3ReadLP(void), DoBlock3ReadSP(void), DoBlock3ReadIM(void); +extern void DoBlock0ReadShiftFP(void), DoBlock0ReadShiftLP(void), DoBlock0ReadShiftSP(void), DoBlock0ReadShiftIM(void); +extern void DoBlock1ReadShiftFP(void), DoBlock1ReadShiftLP(void), DoBlock1ReadShiftSP(void), DoBlock1ReadShiftIM(void); +extern void DoBlock2ReadShiftFP(void), DoBlock2ReadShiftLP(void), DoBlock2ReadShiftSP(void), DoBlock2ReadShiftIM(void); +extern void DoBlock3ReadShiftFP(void), DoBlock3ReadShiftLP(void), DoBlock3ReadShiftSP(void), DoBlock3ReadShiftIM(void); +extern void DoBlock0ReadTestFP(void), DoBlock0ReadTestLP(void), DoBlock0ReadTestSP(void), DoBlock0ReadTestIM(void); +extern void DoBlock1ReadTestFP(void), DoBlock1ReadTestLP(void), DoBlock1ReadTestSP(void), DoBlock1ReadTestIM(void); +extern void DoBlock2ReadTestFP(void), DoBlock2ReadTestLP(void), DoBlock2ReadTestSP(void), DoBlock2ReadTestIM(void); +extern void DoBlock3ReadTestFP(void), DoBlock3ReadTestLP(void), DoBlock3ReadTestSP(void), DoBlock3ReadTestIM(void); +extern void DoFinishCallNFP(void), DoFinishCallNLP(void), DoFinishCallNSP(void), DoFinishCallNIM(void); +extern void DoFinishCallTosFP(void), DoFinishCallTosLP(void), DoFinishCallTosSP(void), DoFinishCallTosIM(void); +extern void DoSetToCarFP(void), DoSetToCarLP(void), DoSetToCarSP(void), DoSetToCarIM(void); +extern void DoSetToCdrFP(void), DoSetToCdrLP(void), DoSetToCdrSP(void), DoSetToCdrIM(void); +extern void DoSetToCdrPushCarFP(void), DoSetToCdrPushCarLP(void), DoSetToCdrPushCarSP(void), DoSetToCdrPushCarIM(void); +extern void DoIncrementFP(void), DoIncrementLP(void), DoIncrementSP(void), DoIncrementIM(void); +extern void DoDecrementFP(void), DoDecrementLP(void), DoDecrementSP(void), DoDecrementIM(void); +extern void DoPointerIncrementFP(void), DoPointerIncrementLP(void), DoPointerIncrementSP(void), DoPointerIncrementIM(void); +extern void DoSetCdrCode1FP(void), DoSetCdrCode1LP(void), DoSetCdrCode1SP(void), DoSetCdrCode1IM(void); +extern void DoSetCdrCode2FP(void), DoSetCdrCode2LP(void), DoSetCdrCode2SP(void), DoSetCdrCode2IM(void); +extern void DoPushAddressFP(void), DoPushAddressLP(void), DoPushAddressSP(void), DoPushAddressIM(void); +extern void DoSetSpToAddressFP(void), DoSetSpToAddressLP(void), DoSetSpToAddressSP(void), DoSetSpToAddressIM(void); +extern void DoSetSpToAddressSaveTosFP(void), DoSetSpToAddressSaveTosLP(void), DoSetSpToAddressSaveTosSP(void), DoSetSpToAddressSaveTosIM(void); +extern void DoReadInternalRegisterFP(void), DoReadInternalRegisterLP(void), DoReadInternalRegisterSP(void), DoReadInternalRegisterIM(void); +extern void DoWriteInternalRegisterFP(void), DoWriteInternalRegisterLP(void), DoWriteInternalRegisterSP(void), DoWriteInternalRegisterIM(void); +extern void DoCoprocessorReadFP(void), DoCoprocessorReadLP(void), DoCoprocessorReadSP(void), DoCoprocessorReadIM(void); +extern void DoCoprocessorWriteFP(void), DoCoprocessorWriteLP(void), DoCoprocessorWriteSP(void), DoCoprocessorWriteIM(void); +extern void DoBlock0ReadAluFP(void), DoBlock0ReadAluLP(void), DoBlock0ReadAluSP(void), DoBlock0ReadAluIM(void); +extern void DoBlock1ReadAluFP(void), DoBlock1ReadAluLP(void), DoBlock1ReadAluSP(void), DoBlock1ReadAluIM(void); +extern void DoBlock2ReadAluFP(void), DoBlock2ReadAluLP(void), DoBlock2ReadAluSP(void), DoBlock2ReadAluIM(void); +extern void DoBlock3ReadAluFP(void), DoBlock3ReadAluLP(void), DoBlock3ReadAluSP(void), DoBlock3ReadAluIM(void); +extern void DoLdbFP(void), DoLdbLP(void), DoLdbSP(void), DoLdbIM(void); +extern void DoCharLdbFP(void), DoCharLdbLP(void), DoCharLdbSP(void), DoCharLdbIM(void); +extern void DoPLdbFP(void), DoPLdbLP(void), DoPLdbSP(void), DoPLdbIM(void); +extern void DoPTagLdbFP(void), DoPTagLdbLP(void), DoPTagLdbSP(void), DoPTagLdbIM(void); +extern void DoBranchFP(void), DoBranchLP(void), DoBranchSP(void), DoBranchIM(void); +extern void DoLoopDecrementTosFP(void), DoLoopDecrementTosLP(void), DoLoopDecrementTosSP(void), DoLoopDecrementTosIM(void); +extern void DoEntryRestAcceptedFP(void), DoEntryRestAcceptedLP(void), DoEntryRestAcceptedSP(void), DoEntryRestAcceptedIM(void); +extern void DoEntryRestNotAcceptedFP(void), DoEntryRestNotAcceptedLP(void), DoEntryRestNotAcceptedSP(void), DoEntryRestNotAcceptedIM(void); +extern void DoRplacaFP(void), DoRplacaLP(void), DoRplacaSP(void), DoRplacaIM(void); +extern void DoRplacdFP(void), DoRplacdLP(void), DoRplacdSP(void), DoRplacdIM(void); +extern void DoMultiplyFP(void), DoMultiplyLP(void), DoMultiplySP(void), DoMultiplyIM(void); +extern void DoQuotientFP(void), DoQuotientLP(void), DoQuotientSP(void), DoQuotientIM(void); +extern void DoCeilingFP(void), DoCeilingLP(void), DoCeilingSP(void), DoCeilingIM(void); +extern void DoFloorFP(void), DoFloorLP(void), DoFloorSP(void), DoFloorIM(void); +extern void DoTruncateFP(void), DoTruncateLP(void), DoTruncateSP(void), DoTruncateIM(void); +extern void DoRoundFP(void), DoRoundLP(void), DoRoundSP(void), DoRoundIM(void); +extern void DoRationalQuotientFP(void), DoRationalQuotientLP(void), DoRationalQuotientSP(void), DoRationalQuotientIM(void); +extern void DoMinFP(void), DoMinLP(void), DoMinSP(void), DoMinIM(void); +extern void DoMaxFP(void), DoMaxLP(void), DoMaxSP(void), DoMaxIM(void); +extern void DoAluFP(void), DoAluLP(void), DoAluSP(void), DoAluIM(void); +extern void DoLogandFP(void), DoLogandLP(void), DoLogandSP(void), DoLogandIM(void); +extern void DoLogxorFP(void), DoLogxorLP(void), DoLogxorSP(void), DoLogxorIM(void); +extern void DoLogiorFP(void), DoLogiorLP(void), DoLogiorSP(void), DoLogiorIM(void); +extern void DoRotFP(void), DoRotLP(void), DoRotSP(void), DoRotIM(void); +extern void DoLshFP(void), DoLshLP(void), DoLshSP(void), DoLshIM(void); +extern void DoMultiplyDoubleFP(void), DoMultiplyDoubleLP(void), DoMultiplyDoubleSP(void), DoMultiplyDoubleIM(void); +extern void DoLshcBignumStepFP(void), DoLshcBignumStepLP(void), DoLshcBignumStepSP(void), DoLshcBignumStepIM(void); +extern void DoStackBltFP(void), DoStackBltLP(void), DoStackBltSP(void), DoStackBltIM(void); +extern void DoRgetfFP(void), DoRgetfLP(void), DoRgetfSP(void), DoRgetfIM(void); +extern void DoMemberFP(void), DoMemberLP(void), DoMemberSP(void), DoMemberIM(void); +extern void DoAssocFP(void), DoAssocLP(void), DoAssocSP(void), DoAssocIM(void); +extern void DoPointerPlusFP(void), DoPointerPlusLP(void), DoPointerPlusSP(void), DoPointerPlusIM(void); +extern void DoPointerDifferenceFP(void), DoPointerDifferenceLP(void), DoPointerDifferenceSP(void), DoPointerDifferenceIM(void); +extern void DoAshFP(void), DoAshLP(void), DoAshSP(void), DoAshIM(void); +extern void DoStoreConditionalFP(void), DoStoreConditionalLP(void), DoStoreConditionalSP(void), DoStoreConditionalIM(void); +extern void DoMemoryWriteFP(void), DoMemoryWriteLP(void), DoMemoryWriteSP(void), DoMemoryWriteIM(void); +extern void DoPStoreContentsFP(void), DoPStoreContentsLP(void), DoPStoreContentsSP(void), DoPStoreContentsIM(void); +extern void DoBindLocativeToValueFP(void), DoBindLocativeToValueLP(void), DoBindLocativeToValueSP(void), DoBindLocativeToValueIM(void); +extern void DoUnifyFP(void), DoUnifyLP(void), DoUnifySP(void), DoUnifyIM(void); +extern void DoPopLexicalVarNFP(void), DoPopLexicalVarNLP(void), DoPopLexicalVarNSP(void), DoPopLexicalVarNIM(void); +extern void DoMovemLexicalVarNFP(void), DoMovemLexicalVarNLP(void), DoMovemLexicalVarNSP(void), DoMovemLexicalVarNIM(void); +extern void DoEqualNumberFP(void), DoEqualNumberLP(void), DoEqualNumberSP(void), DoEqualNumberIM(void); +extern void DoLesspFP(void), DoLesspLP(void), DoLesspSP(void), DoLesspIM(void); +extern void DoGreaterpFP(void), DoGreaterpLP(void), DoGreaterpSP(void), DoGreaterpIM(void); +extern void DoEqlFP(void), DoEqlLP(void), DoEqlSP(void), DoEqlIM(void); +extern void DoEqFP(void), DoEqLP(void), DoEqSP(void), DoEqIM(void); +extern void DoLogtestFP(void), DoLogtestLP(void), DoLogtestSP(void), DoLogtestIM(void); +extern void DoAddFP(void), DoAddLP(void), DoAddSP(void), DoAddIM(void); +extern void DoSubFP(void), DoSubLP(void), DoSubSP(void), DoSubIM(void); +extern void Do32BitPlusFP(void), Do32BitPlusLP(void), Do32BitPlusSP(void), Do32BitPlusIM(void); +extern void Do32BitDifferenceFP(void), Do32BitDifferenceLP(void), Do32BitDifferenceSP(void), Do32BitDifferenceIM(void); +extern void DoAddBignumStepFP(void), DoAddBignumStepLP(void), DoAddBignumStepSP(void), DoAddBignumStepIM(void); +extern void DoSubBignumStepFP(void), DoSubBignumStepLP(void), DoSubBignumStepSP(void), DoSubBignumStepIM(void); +extern void DoMultiplyBignumStepFP(void), DoMultiplyBignumStepLP(void), DoMultiplyBignumStepSP(void), DoMultiplyBignumStepIM(void); +extern void DoDivideBignumStepFP(void), DoDivideBignumStepLP(void), DoDivideBignumStepSP(void), DoDivideBignumStepIM(void); +extern void DoAset1FP(void), DoAset1LP(void), DoAset1SP(void), DoAset1IM(void); +extern void DoAllocateListBlockFP(void), DoAllocateListBlockLP(void), DoAllocateListBlockSP(void), DoAllocateListBlockIM(void); +extern void DoAref1FP(void), DoAref1LP(void), DoAref1SP(void), DoAref1IM(void); +extern void DoAloc1FP(void), DoAloc1LP(void), DoAloc1SP(void), DoAloc1IM(void); +extern void DoStoreArrayLeaderFP(void), DoStoreArrayLeaderLP(void), DoStoreArrayLeaderSP(void), DoStoreArrayLeaderIM(void); +extern void DoAllocateStructureBlockFP(void), DoAllocateStructureBlockLP(void), DoAllocateStructureBlockSP(void), DoAllocateStructureBlockIM(void); +extern void DoArrayLeaderFP(void), DoArrayLeaderLP(void), DoArrayLeaderSP(void), DoArrayLeaderIM(void); +extern void DoAlocLeaderFP(void), DoAlocLeaderLP(void), DoAlocLeaderSP(void), DoAlocLeaderIM(void); +extern void DoPopInstanceVariableFP(void), DoPopInstanceVariableLP(void), DoPopInstanceVariableSP(void), DoPopInstanceVariableIM(void); +extern void DoMovemInstanceVariableFP(void), DoMovemInstanceVariableLP(void), DoMovemInstanceVariableSP(void), DoMovemInstanceVariableIM(void); +extern void DoPopInstanceVariableOrderedFP(void), DoPopInstanceVariableOrderedLP(void), DoPopInstanceVariableOrderedSP(void), DoPopInstanceVariableOrderedIM(void); +extern void DoMovemInstanceVariableOrderedFP(void), DoMovemInstanceVariableOrderedLP(void), DoMovemInstanceVariableOrderedSP(void), DoMovemInstanceVariableOrderedIM(void); +extern void DoInstanceRefFP(void), DoInstanceRefLP(void), DoInstanceRefSP(void), DoInstanceRefIM(void); +extern void DoInstanceSetFP(void), DoInstanceSetLP(void), DoInstanceSetSP(void), DoInstanceSetIM(void); +extern void DoInstanceLocFP(void), DoInstanceLocLP(void), DoInstanceLocSP(void), DoInstanceLocIM(void); +extern void DoSetTagFP(void), DoSetTagLP(void), DoSetTagSP(void), DoSetTagIM(void); +extern void DoUnsignedLesspFP(void), DoUnsignedLesspLP(void), DoUnsignedLesspSP(void), DoUnsignedLesspIM(void); +extern void DoPopFP(void), DoPopLP(void), DoPopSP(void), DoPopIM(void); +extern void DoMovemFP(void), DoMovemLP(void), DoMovemSP(void), DoMovemIM(void); +extern void DoMergeCdrNoPopFP(void), DoMergeCdrNoPopLP(void), DoMergeCdrNoPopSP(void), DoMergeCdrNoPopIM(void); +extern void DoFastAref1FP(void), DoFastAref1LP(void), DoFastAref1SP(void), DoFastAref1IM(void); +extern void DoFastAset1FP(void), DoFastAset1LP(void), DoFastAset1SP(void), DoFastAset1IM(void); +extern void DoStackBltAddressFP(void), DoStackBltAddressLP(void), DoStackBltAddressSP(void), DoStackBltAddressIM(void); +extern void DoDpbFP(void), DoDpbLP(void), DoDpbSP(void), DoDpbIM(void); +extern void DoCharDpbFP(void), DoCharDpbLP(void), DoCharDpbSP(void), DoCharDpbIM(void); +extern void DoPDpbFP(void), DoPDpbLP(void), DoPDpbSP(void), DoPDpbIM(void); +extern void DoPTagDpbFP(void), DoPTagDpbLP(void), DoPTagDpbSP(void), DoPTagDpbIM(void); +extern void DoLoopIncrementTosLessThanFP(void), DoLoopIncrementTosLessThanLP(void), DoLoopIncrementTosLessThanSP(void), DoLoopIncrementTosLessThanIM(void); +extern void DoCatchOpenFP(void), DoCatchOpenLP(void), DoCatchOpenSP(void), DoCatchOpenIM(void); +extern void DoSpareOpFP(void), DoSpareOpLP(void), DoSpareOpSP(void), DoSpareOpIM(void); + +/* New, VLM-only instructions */ +extern void DoDoubleFloatOpFP(void), DoDoubleFloatOpLP(void), DoDoubleFloatOpSP(void), DoDoubleFloatOpIM(void); + +/* FullWord Instruction Handler Routines */ +extern void DoIStageError(void); +extern void nullfw(void); +extern void monitorforwardfw(void); +extern void headerpfw(void); +extern void headerifw(void); +extern void valuecell(void); +extern void oneqforwardfw(void); +extern void headerforwardfw(void); +extern void elementforwardfw(void); +extern void valuecell(void); +extern void pushconstantvalue(void); +extern void boundlocationfw(void); +extern void logicvariablefw(void); +extern void gcforwardfw(void); +extern void callcompiledeven(void); +extern void callcompiledodd(void); +extern void callindirect(void); +extern void callgeneric(void); +extern void callcompiledevenprefetch(void); +extern void callcompiledoddprefetch(void); +extern void callindirectprefetch(void); +extern void callgenericprefetch(void); +extern void nativeinstruction(void); + +/* Internal register read routines */ +/* extern void ReadRegisterEA(void); */ +extern void ReadRegisterFP(void); +extern void ReadRegisterLP(void); +extern void ReadRegisterSP(void); +/* extern void ReadRegisterMacroSP(void); */ +extern void ReadRegisterStackCacheLowerBound(void); +extern void ReadRegisterBARx(void); +/* extern void ReadRegisterPHTHashx(void); */ +/* extern void ReadRegisterEPC(void); */ +/* extern void ReadRegisterDPC(void); */ +extern void ReadRegisterContinuation(void); +extern void ReadRegisterAluAndRotateControl(void); +extern void ReadRegisterControlRegister(void); +extern void ReadRegisterCRArgumentSize(void); +extern void ReadRegisterEphemeralOldspaceRegister(void); +extern void ReadRegisterZoneOldspaceRegister(void); +extern void ReadRegisterChipRevision(void); +extern void ReadRegisterFPCoprocessorPresent(void); +extern void ReadRegisterPreemptRegister(void); +extern void ReadRegisterIcacheControl(void); +extern void ReadRegisterPrefetcherControl(void); +extern void ReadRegisterMapCacheControl(void); +extern void ReadRegisterMemoryControl(void); +/* extern void ReadRegisterECCLog(void); */ +/* extern void ReadRegisterECCLogAddress(void); */ +/* extern void ReadRegisterInvalidateMapx(void); */ +/* extern void ReadRegisterLoadMapx(void); */ +extern void ReadRegisterStackCacheOverflowLimit(void); +/* extern void ReadRegisterUcodeROMContents(void); */ +/* extern void ReadRegisterAddressMask(void); */ +/* extern void ReadRegisterEntryMaximumArguments(void); */ +/* extern void ReadRegisterLexicalVariable(void); */ +/* extern void ReadRegisterInstruction(void); */ +/* extern void ReadRegisterMemoryData(void); */ +/* extern void ReadRegisterDataPins(void); */ +/* extern void ReadRegisterExtensionRegister(void); */ +extern void ReadRegisterMicrosecondClock(void); +/* extern void ReadRegisterArrayHeaderLength(void); */ +/* extern void ReadRegisterLoadBARx(void); */ +extern void ReadRegisterTOS(void); +extern void ReadRegisterEventCount(void); +extern void ReadRegisterBindingStackPointer(void); +extern void ReadRegisterCatchBlockList(void); +extern void ReadRegisterControlStackLimit(void); +extern void ReadRegisterControlStackExtraLimit(void); +extern void ReadRegisterBindingStackLimit(void); +extern void ReadRegisterPHTBase(void); +extern void ReadRegisterPHTMask(void); +extern void ReadRegisterCountMapReloads(void); +extern void ReadRegisterListCacheArea(void); +extern void ReadRegisterListCacheAddress(void); +extern void ReadRegisterListCacheLength(void); +extern void ReadRegisterStructureCacheArea(void); +extern void ReadRegisterStructureCacheAddress(void); +extern void ReadRegisterStructureCacheLength(void); +extern void ReadRegisterDynamicBindingCacheBase(void); +extern void ReadRegisterDynamicBindingCacheMask(void); +extern void ReadRegisterChoicePointer(void); +extern void ReadRegisterStructureStackChoicePointer(void); +extern void ReadRegisterFEPModeTrapVectorAddress(void); +/* extern void ReadRegisterMappingTableCache(void); */ +/* extern void ReadRegisterMappingTableLength(void); */ +extern void ReadRegisterStackFrameMaximumSize(void); +extern void ReadRegisterStackCacheDumpQuantum(void); +extern void ReadRegisterConstantNIL(void); +extern void ReadRegisterConstantT(void); +extern void ReadRegisterError(void); + +/* Internal register write routines */ +/* extern void WriteRegisterEA(void); */ +extern void WriteRegisterFP(void); +extern void WriteRegisterLP(void); +extern void WriteRegisterSP(void); +/* extern void WriteRegisterMacroSP(void); */ +extern void WriteRegisterStackCacheLowerBound(void); +extern void WriteRegisterBARx(void); +/* extern void WriteRegisterPHTHashx(void); */ +/* extern void WriteRegisterEPC(void); */ +/* extern void WriteRegisterDPC(void); */ +extern void WriteRegisterContinuation(void); +extern void WriteRegisterAluAndRotateControl(void); +extern void WriteRegisterControlRegister(void); +/* extern void WriteRegisterCRArgumentSize(void); */ +extern void WriteRegisterEphemeralOldspaceRegister(void); +extern void WriteRegisterZoneOldspaceRegister(void); +/* extern void WriteRegisterChipRevision(void); */ +extern void WriteRegisterFPCoprocessorPresent(void); +extern void WriteRegisterPreemptRegister(void); +/* extern void WriteRegisterIcacheControl(void); */ +/* extern void WriteRegisterPrefetcherControl(void); */ +/* extern void WriteRegisterMapCacheControl(void); */ +/* extern void WriteRegisterMemoryControl(void); */ +/* extern void WriteRegisterECCLog(void); */ +/* extern void WriteRegisterECCLogAddress(void); */ +/* extern void WriteRegisterInvalidateMapx(void); */ +/* extern void WriteRegisterLoadMapx(void); */ +extern void WriteRegisterStackCacheOverflowLimit(void); +/* extern void WriteRegisterUcodeROMContents(void); */ +/* extern void WriteRegisterAddressMask(void); */ +/* extern void WriteRegisterEntryMaximumArguments(void); */ +/* extern void WriteRegisterLexicalVariable(void); */ +/* extern void WriteRegisterInstruction(void); */ +/* extern void WriteRegisterMemoryData(void); */ +/* extern void WriteRegisterDataPins(void); */ +/* extern void WriteRegisterExtensionRegister(void); */ +/* extern void WriteRegisterMicrosecondClock(void); */ +/* extern void WriteRegisterArrayHeaderLength(void); */ +/* extern void WriteRegisterLoadBARx(void); */ +extern void WriteRegisterTOS(void); +extern void WriteRegisterEventCount(void); +extern void WriteRegisterBindingStackPointer(void); +extern void WriteRegisterCatchBlockList(void); +extern void WriteRegisterControlStackLimit(void); +extern void WriteRegisterControlStackExtraLimit(void); +extern void WriteRegisterBindingStackLimit(void); +/* extern void WriteRegisterPHTBase(void); */ +/* extern void WriteRegisterPHTMask(void); */ +/* extern void WriteRegisterCountMapReloads(void); */ +extern void WriteRegisterListCacheArea(void); +extern void WriteRegisterListCacheAddress(void); +extern void WriteRegisterListCacheLength(void); +extern void WriteRegisterStructureCacheArea(void); +extern void WriteRegisterStructureCacheAddress(void); +extern void WriteRegisterStructureCacheLength(void); +extern void WriteRegisterDynamicBindingCacheBase(void); +extern void WriteRegisterDynamicBindingCacheMask(void); +extern void WriteRegisterChoicePointer(void); +extern void WriteRegisterStructureStackChoicePointer(void); +extern void WriteRegisterFEPModeTrapVectorAddress(void); +extern void WriteRegisterMappingTableCache(void); +/* extern void WriteRegisterMappingTableLength(void); */ +/* extern void WriteRegisterStackFrameMaximumSize(void); */ +/* extern void WriteRegisterStackCacheDumpQuantum(void); */ +/* extern void WriteRegisterConstantNIL(void); */ +/* extern void WriteRegisterConstantT(void); */ +extern void WriteRegisterError(void); + +/* Fin */ + +#endif diff --git a/emulator/comments.text b/emulator/comments.text new file mode 100644 index 0000000..1e6f4e9 --- /dev/null +++ b/emulator/comments.text @@ -0,0 +1,216 @@ + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") Comments on the Ivory Emulator + + +(2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")General comments + +(3 0 (NIL 0) (NIL NIL :VERY-SMALL) "EINY7")When to sign extend vs. when not to sign extend: it looks like we need to avoid +sign extension when we have address quantities, but we must sign extend when we +have integer quantities. I don't think the code is careful enough about this. + +Do we do anything about the TOS register? It looks like we don't need to. + +0---- +2alphamac.lisp + +0---- +2intrpmac.lisp + +3Flush commented-out call to MULQ in PC-TO-iCACHEENT. + +Flush ADDRESS-TO-iCACHEENT, iPC-TO-iCACHEENT, and iCACHELOOKUP since nobody uses +them any more. + +0---- +2memoryem.lisp + +3MEMORY-READ, MEMORY-READ-VMA, MEMORY-READ-G, and MEMORY-READ-CDR should share +some underlying macro. This macro should not generate writes into the ZERO +register (that is, if it does write into ZERO, that means that the caller +wanted to just ignore that value -- see LOCATE-INSTANCE-VARIABLE-MAPPED and +LOCATE-ARBITRARY-INSTANCE-VARIABLE). + +Need to write OLMRACTION and TRANSPORTTRAP for the memory-read functions. + +Nobody uses MEMORY-READ-CDR, so fix it or flush it. + +Doesn't MEMORY-WRITE need to write into the stack-cache (4 0 (NIL 0) (NIL :ITALIC :VERY-SMALL) "EINY7")and3 the real VM, instead +of just into the stack cache? + +0---- +2stacklis.lisp + +0STACK-WRITE-NIL and STACK-WRITE-T take a VMA argument. Is it really a VMA, or +is it a stack-cache address (SCA)? Looks like an SCA. + +In fact, most of the macros in this file that have a VMA argument really take an +SCA. The arglists should be fixed. + +Should STACK-READ-DATA do an EXTLL to un-sign-extend the data word? May not be +worth it, but there should be better comments here. + +3Why do some things do (ADDQ iSP 8 (iSP)), whereas others do (ADDQ iSP 8 iSP)? + +0---- +2idispat.as + +0What about that clever cache-filling code that stopped at the ends of functions, +accounted for condition branches, etc? + +3Flush the trap-handling tags that are no longer in use, and the code that goes +with them. + +0---- +2ifunarra.as and imacarra.lisp + +0Microcode ensures that array register event count is a fixnum. That provides +some extra robustness, but do we care? +There should be a READ-ARRAY-HEADER macro for use by DoAref1, DoAset1, and +DoAloc1. (minor) + +There should be a macro that writes the bodies of DoArrayLeader, +DoStoreArrayLeader, and DoAlocLeader. (minor) + +3Bounds-checking is done using an unsigned comparison in the microcode; does the +right thing happen in the emulator? + +In the microcode, AREF pops the top two elements on the stack and pushes the +result. FAST-AREF just replaces the top element. It looks correct, but does +the emulator really maintain the proper stack discipline? + +DoAref1, DoAset1, and DoAloc1 need to ensure that the index is a fixnum. + +When recomputing an array register, the microcode can take a "recompute trap" +that needs to know whether the recompute was forced by FAST-AREF or FAST-ASET. + +The microcode ARRAY-LEADER and STORE-ARRAY-LEADER instructions seem to take +some kind of a transport trap when they see forwarding pointers (?) in the +array leader. What about the emulator? + +0---- +2ifunbind.as and imacbind.lisp + +3Don't think we need to worry about deep-bound-p... + +Not convinced that UNBIND needs to check the interrupt register each time around +the loop either. + +I don't really like the fact that UNBIND clears the cleanup bit every time it +undoes a single binding on behalf of DoUnbindN. Really DoUnbindN should check +it and signal an error if it is not set, then do the unbindings, and finally +clear the cleanup bit. + +0---- +2ifunbits.as and imacbits.lisp + +3Aren't the tag and data already in separate registers once we get into functions +like DoLogAnd? It sort of looks like ILOGICAL is doing a little too much work +up front, but I'm not sure. On second thought, ILOGICAL is probably doing the +right amount of work, but it's making a lot of assumptions about the contents of +various registers. + +0---- +2ifunblok.as and imacblok.lisp + +0I%BLOCK-N-READ-SHIFT should probably do (EXTLL ,TEMP2 0 ,TEMP2), just like +I%BLOCK-N-READ and I%BLOCK-N-WRITE do. And what's with the commented-out stuff +in I%BLOCK-N-READ that isn't commented out of I%BLOCK-N-READ-SHIFT? +And... I%BLOCK-N-READ-SHIFT doesn't shift! + +ReadAlu instructions not done. + +ReadTest instructions not done. + +---- +2ifunbnum.as + +3DoDivideBignumStep not done. + +0---- +2ifunfcal.as and fcallmac.lisp + +3START-CALL-ESCAPE not done. + +Typo in START-CALL-DISPATCH? Lexical closure case calls START-CALL-COMPILED +instead of START-CALL-LEXICAL-CLOSURE. + +START-CALL-LEXICAL-CLOSURE not done. + +0---- +2ifunfext.as + +0---- +2ifunfull.as + +3The PushSparePointer instructions are not done. + +CallGeneric and CallGenericPrefetch not done. + +0---- +2ifungene.as + +3DoGenericDispatch not done. + +DoMessageDispatch not done. + +0---- +2ifuninst.as and imacinst.lisp + +0---- +2ifunjosh.as and imacjosh.lisp + +0DoUnify not done. + +---- +2ifunlexi.as and imaclexi.lisp + +0---- +2ifunlist.as and imaclist.lisp + +3Fill in something for ALLOW-SEQUENCE-BREAK, otherwise DoMember, DoAssoc, and +DoRgetf can get into an uninterruptable loop on circular lists. (This brings up +the question of whether we are implementing the "too long" trap handler -- I +think we need to, otherwise one Lisp process stuck in DoMember will monopolize +the entire VLM.) + +IRPLAC only needs to read the cdr code. + +0---- +2ifunloop.as and imacloop.lisp + +0---- +2ifunmath.as and imacmath.lisp + +3Not only is the call to (EXTLL arg1 0 arg1 "Strip out tag bits") unnecessary in +SIMPLE-BINARY-MINMAX, it may well be harmful. Don't we need a real sign +extended quantity for MIN/MAX comparisons to work properly? + +Doesn't SIMPLE-BINARY-ARITHMETIC-OPERATION lose when the args are signed? ARG1 +would seem to have both tag and data in it (set by DEFINE-INSTRUCTION-PROCEDURE), +and ARG4 gets a zero-extended word put in it. Is it safe to do stuff as a +32-bit quantity in a 64-bit register? That may make it hard to detect overflow. + +DoQuotient, DoCeiling, DoFloor, DoTruncate, DoRound, DoRemainder, etc., have +the same problem as the above, I suspect. + +How are fixnum overflows detected? Need to trap for bignums... + +0---- +2ifunmove.as + +0---- +2ifunpred.as and imacpred.lisp + +3SIMPLE-BINARY-ARITHMETIC-PREDICATE and SIMPLE-UNARY-ARITHMETIC-PREDICATE should +handle the single-float cases. + +0---- +2ifunsubp.as and imacsubp.lisp, and imacialu.lisp + +0I%ALLOCATE-BLOCK doesn't handle the structure case properly, and doesn't seem to +hack areas, either. + +---- +2ifuntrap.as and imactrap.lisp + + diff --git a/emulator/emulator.S b/emulator/emulator.S new file mode 100644 index 0000000..a0adfea --- /dev/null +++ b/emulator/emulator.S @@ -0,0 +1,41 @@ + +/* This file defines the core emulator and the relative positions of the + * core components to each other. + */ + +#include "aihead.s" +#include "aistat.s" +#include "ifunhead.s" + +/* Note well: the ordering of idispat.s, ifuncom1.2, and ifuncom2.s is chosen + * to increase the likelihood that the instructions implemented in this files + * stay in the Alpha's instruction cache as much as possible. + */ + +#include "idispat.s" +#include "ifuncom1.s" +#include "ifuncom2.s" +#include "ifungene.s" +#include "ifunfcal.s" +#include "ifunloop.s" +#include "ifunlist.s" +#include "ifuninst.s" +#include "ifunmath.s" +#include "ifunarra.s" +#include "ifunmove.s" +#include "ifunpred.s" +#include "ifunsubp.s" +#include "ifunfext.s" +#include "ifunlexi.s" +#include "ifunbits.s" +#include "ifunblok.s" +#include "ifunbind.s" +#include "ifunfull.s" +#include "ifunbnum.s" +#include "ifuntrap.s" +#include "ihalt.s" +#include "idouble.s" +#include "ifunjosh.s" +#include "ifuntran.s" + +/* Fin */ diff --git a/emulator/errortbl.lisp b/emulator/errortbl.lisp new file mode 100644 index 0000000..80059d6 --- /dev/null +++ b/emulator/errortbl.lisp @@ -0,0 +1,111 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +#+Alpha-AXP-Emulator +(in-package "ALPHA-AXP-INTERNALS") + +#+PowerPC-Emulator +(in-package "POWERPC-INTERNALS") + +;;; *** If you change this file, be sure to change SYS:I-SYS;REV5-ERROR-TABLE.LISP *** + +(defvar *all-conditions* + '(%allocate-type-error + %divide-bignum-step-not-fixnum-or-zero + (%instance-reference-type-error :binary) + (%instance-reference-type-error :three-argument) + %memory-read-transport-and-fixnum-type-check + %p-dpb-type-error + aloc-non-object-array + (array-access-type-check :binary) + (array-access-type-check :three-argument) + (array-leader-access-type-check :binary) + (array-leader-access-type-check :three-argument) + array-register-format-error + array-register-format-error-or-subscript-bounds-error + assoc-list-element-not-list + bad-cdr-code-in-memory + binary-arithmetic-operand-type-error + binary-lexical-environment-type-error + bind-locative-type-error + binding-stack-overflow + binding-stack-underflow + block-read-binary-operation-transport-and-fixnum-type-check + block-read-test-transport-and-fixnum-type-check + block-read-transport-and-fixnum-type-check + branch-dot-error + byte-array-word-type-check + car-cdr-list-type-error + char-dpb-type-error + char-ldb-type-error + character-array-aset-type-error + divide-by-zero + divide-overflow + fast-array-access-type-check + fixnum-array-aset-type-error + (flavor-search-mask-not-fixnum data-read) + (flavor-search-table-pointer-not-locative data-read) + frame-overflow + (generic-search-table-entry-not-pc data-read) + i-stage-error + (illegal-full-word-instruction dtp-bound-location) + (illegal-full-word-instruction dtp-element-forward) + (illegal-full-word-instruction dtp-gc-forward) + (illegal-full-word-instruction dtp-header-forward) + (illegal-full-word-instruction dtp-header-i) + (illegal-full-word-instruction dtp-header-p) + (illegal-full-word-instruction dtp-logic-variable) + (illegal-full-word-instruction dtp-monitor-forward) + (illegal-full-word-instruction dtp-null) + (illegal-full-word-instruction dtp-one-q-forward) + illegal-instance-variable-index-from-memory + (instance-flavor-table-contents-not-locative data-read) + interpreter-table-contents-not-pc + list-operation-tail-not-list ;+++ assoc/member/rgetf should generate this + mapping-table-index-out-of-bounds + (memory-data-error bind-read) + (memory-data-error bind-write) + (memory-data-error cdr-read) + (memory-data-error data-read) + (memory-data-error data-write) + (memory-data-error header-read) + (memory-data-error scavenge) + non-16-bit-character + non-8-bit-character + one-operand-fixnum-type-error + one-operand-list-type-error + (operand-1-type-error (dtp-locative)) + operand-locative-type-error + rplaca-rplacd-list-type-error ;+++ rplaca/rplacd should generate this + self-mapping-table-type-error + self-type-error + set-to-car-cdr-list-type-error + setup-array-operand-not-array + shallow-binding-operation-in-deep-binding-mode + stack-blt-type-error + subscript-bounds-error + take-values-type-error + three-operand-fixnum-type-error + too-few-arguments + too-many-arguments + trap-on-exit + two-operand-fixnum-type-error + unary-arithmetic-operand-type-error + unary-lexical-environment-type-error + (unary-operand-type-error (dtp-odd-pc dtp-even-pc)) + unknown-internal-register ;emulator only + unknown-double-float-op ;emulator only + )) + +(defvar *vma-valid-conditions* + '(assoc-list-element-not-list + bad-cdr-code-in-memory + byte-array-word-type-check + flavor-search-mask-not-fixnum + flavor-search-table-pointer-not-locative + generic-search-table-entry-not-pc + instance-flavor-table-contents-not-locative + interpreter-table-contents-not-pc + list-operation-tail-not-list + memory-data-error + shallow-binding-operation-in-deep-binding-mode + trap-on-exit)) diff --git a/emulator/externals.c b/emulator/externals.c new file mode 100644 index 0000000..6240b4b --- /dev/null +++ b/emulator/externals.c @@ -0,0 +1,494 @@ +/* -*- Mode:C; Lowercase: Yes -*- */ + +/* Functions called by the emulator */ + +#include "std.h" + +#include +#include +#include + +#include +#include +#include +#include + +#include "aistat.h" /* Alpha-Ivory state */ +#include "aihead.h" /* Alpha-Ivory constants */ +#include "ivoryrep.h" /* Prototypes for this file */ +#include "memory.h" /* Memory definitions */ +#include "world_tools.h" +#include "life_prototypes.h" +#include "utilities.h" + + +/* CoprocessorWrite Protocol: + CoprocessorWrite is called from the interpreter when a %COPROCESSOR-WRITE + instruction is executed. The function should return TRUE if it recognizes + the register to be written and was able to write it successfully. + Otherwise, it must return FALSE to cause an instruction exception. */ + +int CoprocessorWrite (unsigned int operand, LispObj value) +{ + + switch (operand) { + case CoprocessorRegister_MicrosecondClock: + /* While Lisp may try to write this register, we can't actually do so ... */ + break; + + case CoprocessorRegister_HostInterrupt: + SendInterruptToLifeSupport (); + break; + + case CoprocessorRegister_VMRegisterCommand: + VM.CommandRegister = VMCommand(LispObjData(value)); + break; + case CoprocessorRegister_VMRegisterAddress: + VM.AddressRegister = LispObjData(value); + break; + case CoprocessorRegister_VMRegisterExtent: + VM.ExtentRegister = LispObjData(value); + break; + case CoprocessorRegister_VMRegisterAttributes: + VM.AttributesRegister = LispObjData(value); + break; + case CoprocessorRegister_VMRegisterDestination: + VM.DestinationRegister = LispObjData(value); + break; + case CoprocessorRegister_VMRegisterData: + VM.DataRegister = value; + break; + case CoprocessorRegister_VMRegisterMaskLow: + VM.MaskRegisterLow = LispObjData(value); + break; + case CoprocessorRegister_VMRegisterMaskHigh: + VM.MaskRegisterHigh = LispObjData(value); + break; + + case CoprocessorRegister_StackSwitch: + VirtualMemoryWriteBlockUncached ((unsigned int)processor->stackcachebasevma, + (LispObj*)processor->stackcachedata, + ((LispObj*)processor->sp - + (LispObj*)processor->stackcachedata) + 1); + processor->fp = (uint64_t)processor->stackcachedata; + processor->sp = processor->fp+8; + processor->lp = processor->sp+8; + processor->stackcachebasevma = LispObjData(value); + processor->stackcachetopvma = processor->stackcachebasevma + processor->stackcachesize; + processor->scovlimit = Stack_MaxFrameSize; + break; + + case CoprocessorRegister_FlushStackCache: + VirtualMemoryWriteBlockUncached ((unsigned int)processor->stackcachebasevma, + (LispObj*)processor->stackcachedata, + ((LispObj*)processor->sp - + (LispObj*)processor->stackcachedata) + 1); + break; + + case CoprocessorRegister_FlushIDCaches: + /* The emulator special-cases this register so we should never see it */ + return (FALSE); + + case CoprocessorRegister_CalendarClock: + /* This register is read-only ... */ + return (FALSE); + + case CoprocessorRegister_FlushCachesForVMA: + /* The emulator special-cases this register so we should never see it */ + return (FALSE); + + case CoprocessorRegister_FlipToStack: + /* Used by the VLM Debugger to implement INVOKE-ON-FEP-STACK ... */ + VirtualMemoryWriteBlockUncached ((unsigned int)processor->stackcachebasevma, + (LispObj*)processor->stackcachedata, + ((LispObj*)processor->sp - + (LispObj*)processor->stackcachedata) + 1); + processor->stackcachebasevma = LispObjData(value); + processor->stackcachetopvma = processor->stackcachebasevma + processor->stackcachesize; + break; + + case CoprocessorRegister_UnwindStackForRestartOrApply: + /* The emulator special-cases this register so we should never see it */ + return (FALSE); + + case CoprocessorRegister_SaveWorld: + if (Type_Locative != (LispObjTag (value) & 0x3F)) return (FALSE); + VirtualMemoryWriteBlockUncached ((unsigned int)processor->stackcachebasevma, + (LispObj*)processor->stackcachedata, + ((LispObj*)processor->sp - + (LispObj*)processor->stackcachedata) + 1); + SaveWorld (LispObjData (value)); + break; + + case CoprocessorRegister_ConsoleInputAvailableP: + /* This register is read-only ... */ + return (FALSE); + + case CoprocessorRegister_WaitForEvent: + SetIntervalTimer (LispObjData (value)); + break; + + case CoprocessorRegister_ConsoleIO: + DoConsoleIO ((EmbConsoleChannel*) HostPointer (EmbCommAreaPtr->consoleChannel), + (EmbConsoleBuffer*) HostPointer (LispObjData (value))); + break; + + case CoprocessorRegister_AttachDiskChannel: + AttachDiskChannel ((AttachDiskChannelRequest*) MapVirtualAddressData (LispObjData (value))); + break; + + case CoprocessorRegister_GrowDiskPartition: + GrowDiskPartition ((GrowDiskPartitionRequest*) MapVirtualAddressData (LispObjData (value))); + break; + + case CoprocessorRegister_DetachDiskChannel: + DetachDiskChannel ((EmbPtr) LispObjData (value)); + break; + + case CoprocessorRegister_UnixCrypt: + UnixCrypt ((UnixCryptRequest*) MapVirtualAddressData (LispObjData (value))); + break; + + default: + /* Force the interpreter to take an INSTRUCTION-EXCEPTION trap */ + return (FALSE); + } + + return (TRUE); /* Here iff the instruction is successfull */ +} + + +/* CoprocessorRead Protocol: + CoprocessorRead is called from the interpreter when a coprocessor read + instruction is executed. The function should return a LispObj that will + be pushed as the result of the read. If NULL is returned, the interpreter + will perform an 'instruction exception' + */ + +LispObj CoprocessorRead (unsigned int operand) +{ + /* struct tms tms; */ + /* int64_t tps; */ + /* clock_t mstime; */ + time_t tod; + struct tm *ut; + int64_t encodedUT; + int64_t mstimenumber; + /* int64_t inttimenum; */ + /* Result for invalid register => -1 (all ones), since NULL is valid! */ + LispObj INVALID = (LispObj) -1L; + +//printf("CoprocessorRead(operand = %x)\n", operand); + + switch (operand) { + case CoprocessorRegister_MicrosecondClock: + { + struct timeval tmv ; + struct timezone tz ; + gettimeofday ( &tmv, &tz ); + mstimenumber = tmv.tv_usec + tmv.tv_sec * 1000000; + } +/* /\* As is typical of Unix, the error value return by the times function is also a */ +/* valid return value. Until the "standard" is fixed, it seems riskier to check */ +/* for an error than to ignore it *\/ */ +/* tps = sysconf(_SC_CLK_TCK); */ +/* mstime = times(&tms); */ +/* mstimenumber= */ +/* //#define USE_CPU_FOR_MICROSECOND_CLOCK */ +/* #ifdef USE_CPU_FOR_MICROSECOND_CLOCK */ +/* (((int64_t)tms.tms_utime + (int64_t)tms.tms_stime) * 1000000L / tps); */ +/* #else */ +/* ((int64_t)mstime * 1000000L / tps); */ +/* #endif */ +/* { */ +/* static unsigned long basems = 0; */ +/* if (basems == 0) { */ +/* basems = ((int64_t)mstime * 1000000L / tps); */ +/* mstimenumber = 0; */ +/* } else */ +/* mstimenumber -= basems; */ +/* } */ +/* inttimenum=mstimenumber<processor->msclockcache) */ +/* processor->msclockcache=inttimenum; */ +//printf("CoprocessorRegister_MicrosecondClock: %p\n", (void *)mstimenumber); + return (MakeLispObj (Type_Fixnum, mstimenumber)); + break; + + case CoprocessorRegister_VMRegisterCommand: + return (MakeLispObj(Type_Fixnum, VM.CommandRegister)); + case CoprocessorRegister_VMRegisterAddress: + return (MakeLispObj(Type_Locative, VM.AddressRegister)); + case CoprocessorRegister_VMRegisterExtent: + return (MakeLispObj(Type_Fixnum, VM.ExtentRegister)); + case CoprocessorRegister_VMRegisterAttributes: + return (MakeLispObj(Type_Fixnum, VM.AttributesRegister)); + case CoprocessorRegister_VMRegisterDestination: + return (MakeLispObj(Type_Locative, VM.DestinationRegister)); + case CoprocessorRegister_VMRegisterData: + return (VM.DataRegister); + case CoprocessorRegister_VMRegisterMaskLow: + return (MakeLispObj(Type_Fixnum, VM.MaskRegisterLow)); + case CoprocessorRegister_VMRegisterMaskHigh: + return (MakeLispObj(Type_Fixnum, VM.MaskRegisterHigh)); + + case CoprocessorRegister_StackSwitch: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_FlushStackCache: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_FlushIDCaches: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_CalendarClock: + /* As is typical of Unix, the error value return by the time function is also a + valid return value. Until the "standard" is fixed, it seems riskier to check + for an error than to ignore it */ + tod = time(NULL); + ut = gmtime(&tod); + if (ut) { + encodedUT = (int64_t)(ut->tm_sec & 0x3F) + | ((int64_t)(ut->tm_min & 0x3F) << 6) + | ((int64_t)(ut->tm_hour & 0x1F) << 12) + | ((int64_t)(ut->tm_mday & 0x1F) << 17) + | ((int64_t)((ut->tm_mon + 1) & 0xF) << 22) + | ((int64_t)((ut->tm_year + 1900 - 1990) & 0x3F) << 26); + return (MakeLispObj(Type_Fixnum, (unsigned int)(encodedUT & 0xFFFFFFFFL))); + } + else + return (INVALID); /* Couldn't decode the clock reading */ + + case CoprocessorRegister_FlipToStack: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_UnwindStackForRestartOrApply: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_SaveWorld: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_ConsoleInputAvailableP: + if (ConsoleInputAvailableP()) + return (processor->taddress); + else + return (processor->niladdress); + + case CoprocessorRegister_WaitForEvent: + WaitForLifeSupport(); + return (processor->taddress); + + case CoprocessorRegister_ConsoleIO: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_AttachDiskChannel: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_GrowDiskPartition: + /* This register is write-only ... */ + return (INVALID); + + case CoprocessorRegister_DetachDiskChannel: + /* This register is write-only ... */ + return (INVALID); + + default: + /* Force the interpreter to take an INSTRUCTION-EXCEPTION trap */ + return (INVALID); + } +} + + +/* Flush instruction and data caches after updating oldspace registers */ + +void FlushCaches () +{ + flushicache(); +} + + +/* Instruction Tracing */ + +static TRACEDATA traceData; +static FILE *traceS = NULL; +static uint64_t lastCR = 0; + +void InitializeTracing (int bufferSize, unsigned int startPC, unsigned int stopPC, + char* outputFile) +{ + traceData.n_entries = bufferSize; + traceData.wrap_p = FALSE; + traceData.start_pc = (uint64_t) startPC << 1; + traceData.stop_pc = (uint64_t) stopPC << 1; + traceData.recording_p = (0 == startPC); + traceData.records_start = (char*)malloc(bufferSize*sizeof(TRACERECORD)); + if (NULL == traceData.records_start) vpunt (NULL, "Unable to allocate trace buffer"); + traceData.current_entry = traceData.records_start; + traceData.records_end = (char*)((TRACERECORD*)traceData.records_start + bufferSize); + + if (outputFile != NULL) { + traceS = fopen (outputFile, "w"); + if (traceS == NULL) vpunt (NULL, "Unable to create trace file: %s", outputFile); + traceData.printer = (char*) &PrintTrace; + } else { + traceS = stdout; + traceData.printer = NULL; + } + + processor->trace_hook = (char*)&traceData; +} + +#ifdef SLOW_TRACING +void EnterTrace () +{ TraceRecord *traceRecord; + LispObjRecord *args; + int i; + + if (!traceData.recordingP && (processor->epc == traceData.startPC)) + traceData.recordingP = TRUE; + + if (traceData.recordingP) { + traceRecord = traceData.records + traceData.currentEntry; + traceRecord->counter = 0 - processor->instruction_count; + traceRecord->epc = processor->epc; + traceRecord->TOS = *(LispObjRecord*)processor->sp; + traceRecord->SP = processor->stackcachebasevma + + ((processor->sp - (uint64_t)processor->stackcachedata) >> 3); + traceRecord->instruction = (char*) ((struct cacheline*)processor->cp)->code; + traceRecord->operand = ((struct cacheline*)processor->cp)->operand; + traceRecord->instructionData = ((struct cacheline*)processor->cp)->instruction; + traceRecord->trapP = (processor->tvi != 0); + if (traceRecord->trapP) { + for (i = 0, args = ((LispObjRecord*)processor->fp) + 2; i < 4; i++, args++) + traceRecord->trapData[i] = *args; + processor->tvi = 0; + } + traceRecord->catchBlockP = FALSE; + traceData.currentEntry++; + if (traceData.currentEntry == traceData.nEntries) { + traceData.currentEntry = 0; + traceData.wrapP = TRUE; + } + } + + if (traceData.recordingP && (processor->epc == traceData.stopPC)) + traceData.recordingP = FALSE; +} +#endif + +#define DecodeObject(object) (((LispObjRecord*)&object)->tag&0xC0)>>6, ((LispObjRecord*)&object)->tag&0x3F, ((LispObjRecord*)&object)->data + +static void PrintTraceRecord (TRACERECORD *traceRecord) +{ + Byte format; + int32_t immediate10BitOperand, immediateFromStackOperand; + + if (traceRecord->trap_p) { + fprintf (traceS, + "*** Trap %04o @ %x.%02x.%08x, microstate %x.%02x.%08x, VMA %x.%02x.%08x\n", + LispObjData(traceRecord->trap_data_0), DecodeObject(traceRecord->trap_data_1), + DecodeObject(traceRecord->trap_data_2), DecodeObject(traceRecord->trap_data_3)); + } + + if (traceRecord->catch_block_p) { + } + + if (lastCR != traceRecord->catch_block_0) { + fprintf (traceS, "*** Control Register %x.%02x.%08x (was %x.%02x.%08x)\n", + DecodeObject(traceRecord->catch_block_0), DecodeObject(lastCR)); + lastCR = traceRecord->catch_block_0; + } + + traceRecord->instruction--; + while ((((uint8_t)*traceRecord->instruction & 0x80) == 0) || + ((uint8_t)*traceRecord->instruction == 0xFF) || + ((uint8_t)*traceRecord->instruction == 0xFE)) + traceRecord->instruction--; + format = *traceRecord->instruction; + traceRecord->instruction++; + + fprintf (traceS, "%ld: PC %08lx(%s),%s SP: %08lx, TOS: %x.%02x.%08x, %s", + (0 - traceRecord->counter), + traceRecord->epc >> 1, + (traceRecord->epc & 1) ? "Odd" : "Even", (traceRecord->epc & 1) ? " " : "", + traceRecord->sp, + DecodeObject(traceRecord->tos), + traceRecord->instruction); + + immediate10BitOperand = traceRecord->operand & 0x3FF; + immediateFromStackOperand = traceRecord->operand & 0xFF; + + switch (format) { + case 0x80: + fprintf (traceS, "(%08lx)", traceRecord->instruction_data); + break; + case 0x83: + if (immediateFromStackOperand > 127) immediateFromStackOperand -= 256; + case 0x82: + fprintf (traceS, "(%d)", immediateFromStackOperand); + break; + case 0x84: + case 0x90: + fprintf (traceS, "(%d)", traceRecord->operand & 0xFF); + break; + case 0x88: + if (traceRecord->operand & 0xFF) + fprintf (traceS, "(%d)", (traceRecord->operand & 0xFF) - 255); + else + fprintf (traceS, "(POP)"); + break; + case 0xA0: + fprintf (traceS, "(%03x)", immediate10BitOperand); + break; + case 0xA1: + if (immediate10BitOperand > 511) immediate10BitOperand -= 1024; + fprintf (traceS, "(%d)", immediate10BitOperand); + break; + case 0xB0: + fprintf (traceS, "(%08lx)", traceRecord->instruction_data); + break; + } + + fprintf (traceS, "\n"); + + return; +} + +void PrintTrace () +{ TRACERECORD *traceRecord; + + if (traceData.wrap_p) + for (traceRecord = (TRACERECORD*) traceData.current_entry; + traceRecord < (TRACERECORD*) traceData.records_end; + traceRecord++) + PrintTraceRecord (traceRecord); + + for (traceRecord = (TRACERECORD*) traceData.records_start; + traceRecord < (TRACERECORD*) traceData.current_entry; + traceRecord++) + PrintTraceRecord (traceRecord); + + fflush (traceS); +} + +void MaybePrintTrace () +{ + if (Trace) PrintTrace (); + return; +} + +void TerminateTracing () +{ + if (traceS != NULL && traceS != stdout) { + fclose (traceS); + traceS = NULL; + } +} diff --git a/emulator/failures.text b/emulator/failures.text new file mode 100644 index 0000000..4c31cb0 Binary files /dev/null and b/emulator/failures.text differ diff --git a/emulator/fake_emulator.c b/emulator/fake_emulator.c new file mode 100644 index 0000000..bca5eb9 --- /dev/null +++ b/emulator/fake_emulator.c @@ -0,0 +1,853 @@ +#include "std.h" + +#include "aihead.h" +#include "ivoryrep.h" +#include "embed.h" + +static int first_call = 1; + +int iInterpret (PROCESSORSTATEP ivory) { + // printf("[iInterpret]\n"); + if (first_call) { + first_call = 0; + return(HaltReason_Halted); + } else { + sleep(1); + return(HaltReason_SpyCalled); + } +} + +void SpinWheels () { + int i; + for (i = 0; i < 0x2000000; i++); + } + +void ARITHMETICEXCEPTION () { } +void DECODEFAULT () { } + +void CarCdrSubroutine () { } +void CarSubroutine () { } +void CdrSubroutine () { } +void Do32BitDifferenceFP () { } +void Do32BitDifferenceIM () { } +void Do32BitDifferenceLP () { } +void Do32BitDifferenceSP () { } +void Do32BitPlusFP () { } +void Do32BitPlusIM () { } +void Do32BitPlusLP () { } +void Do32BitPlusSP () { } +void DoAddBignumStepFP () { } +void DoAddBignumStepIM () { } +void DoAddBignumStepLP () { } +void DoAddBignumStepSP () { } +void DoAddFP () { } +void DoAddIM () { } +void DoAddLP () { } +void DoAddSP () { } +void DoAllocateListBlockFP () { } +void DoAllocateListBlockIM () { } +void DoAllocateListBlockLP () { } +void DoAllocateListBlockSP () { } +void DoAllocateStructureBlockFP () { } +void DoAllocateStructureBlockIM () { } +void DoAllocateStructureBlockLP () { } +void DoAllocateStructureBlockSP () { } +void DoAloc1FP () { } +void DoAloc1IM () { } +void DoAloc1LP () { } +void DoAloc1SP () { } +void DoAlocLeaderFP () { } +void DoAlocLeaderIM () { } +void DoAlocLeaderLP () { } +void DoAlocLeaderSP () { } +void DoAluFP () { } +void DoAluIM () { } +void DoAluLP () { } +void DoAluSP () { } +void DoAref1FP () { } +void DoAref1IM () { } +void DoAref1LP () { } +void DoAref1SP () { } +void DoArrayLeaderFP () { } +void DoArrayLeaderIM () { } +void DoArrayLeaderLP () { } +void DoArrayLeaderSP () { } +void DoAset1FP () { } +void DoAset1IM () { } +void DoAset1LP () { } +void DoAset1SP () { } +void DoAshFP () { } +void DoAshIM () { } +void DoAshLP () { } +void DoAshSP () { } +void DoAssocFP () { } +void DoAssocIM () { } +void DoAssocLP () { } +void DoAssocSP () { } +void DoBindLocativeFP () { } +void DoBindLocativeIM () { } +void DoBindLocativeLP () { } +void DoBindLocativeSP () { } +void DoBindLocativeToValueFP () { } +void DoBindLocativeToValueIM () { } +void DoBindLocativeToValueLP () { } +void DoBindLocativeToValueSP () { } +void DoBlock0ReadAluFP () { } +void DoBlock0ReadAluIM () { } +void DoBlock0ReadAluLP () { } +void DoBlock0ReadAluSP () { } +void DoBlock0ReadFP () { } +void DoBlock0ReadIM () { } +void DoBlock0ReadLP () { } +void DoBlock0ReadSP () { } +void DoBlock0ReadShiftFP () { } +void DoBlock0ReadShiftIM () { } +void DoBlock0ReadShiftLP () { } +void DoBlock0ReadShiftSP () { } +void DoBlock0ReadTestFP () { } +void DoBlock0ReadTestIM () { } +void DoBlock0ReadTestLP () { } +void DoBlock0ReadTestSP () { } +void DoBlock0WriteFP () { } +void DoBlock0WriteIM () { } +void DoBlock0WriteLP () { } +void DoBlock0WriteSP () { } +void DoBlock1ReadAluFP () { } +void DoBlock1ReadAluIM () { } +void DoBlock1ReadAluLP () { } +void DoBlock1ReadAluSP () { } +void DoBlock1ReadFP () { } +void DoBlock1ReadIM () { } +void DoBlock1ReadLP () { } +void DoBlock1ReadSP () { } +void DoBlock1ReadShiftFP () { } +void DoBlock1ReadShiftIM () { } +void DoBlock1ReadShiftLP () { } +void DoBlock1ReadShiftSP () { } +void DoBlock1ReadTestFP () { } +void DoBlock1ReadTestIM () { } +void DoBlock1ReadTestLP () { } +void DoBlock1ReadTestSP () { } +void DoBlock1WriteFP () { } +void DoBlock1WriteIM () { } +void DoBlock1WriteLP () { } +void DoBlock1WriteSP () { } +void DoBlock2ReadAluFP () { } +void DoBlock2ReadAluIM () { } +void DoBlock2ReadAluLP () { } +void DoBlock2ReadAluSP () { } +void DoBlock2ReadFP () { } +void DoBlock2ReadIM () { } +void DoBlock2ReadLP () { } +void DoBlock2ReadSP () { } +void DoBlock2ReadShiftFP () { } +void DoBlock2ReadShiftIM () { } +void DoBlock2ReadShiftLP () { } +void DoBlock2ReadShiftSP () { } +void DoBlock2ReadTestFP () { } +void DoBlock2ReadTestIM () { } +void DoBlock2ReadTestLP () { } +void DoBlock2ReadTestSP () { } +void DoBlock2WriteFP () { } +void DoBlock2WriteIM () { } +void DoBlock2WriteLP () { } +void DoBlock2WriteSP () { } +void DoBlock3ReadAluFP () { } +void DoBlock3ReadAluIM () { } +void DoBlock3ReadAluLP () { } +void DoBlock3ReadAluSP () { } +void DoBlock3ReadFP () { } +void DoBlock3ReadIM () { } +void DoBlock3ReadLP () { } +void DoBlock3ReadSP () { } +void DoBlock3ReadShiftFP () { } +void DoBlock3ReadShiftIM () { } +void DoBlock3ReadShiftLP () { } +void DoBlock3ReadShiftSP () { } +void DoBlock3ReadTestFP () { } +void DoBlock3ReadTestIM () { } +void DoBlock3ReadTestLP () { } +void DoBlock3ReadTestSP () { } +void DoBlock3WriteFP () { } +void DoBlock3WriteIM () { } +void DoBlock3WriteLP () { } +void DoBlock3WriteSP () { } +void DoBranchFP () { } +void DoBranchFalseAndExtraPopFP () { } +void DoBranchFalseAndExtraPopIM () { } +void DoBranchFalseAndExtraPopLP () { } +void DoBranchFalseAndExtraPopSP () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopFP () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopIM () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopLP () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopSP () { } +void DoBranchFalseAndNoPopFP () { } +void DoBranchFalseAndNoPopIM () { } +void DoBranchFalseAndNoPopLP () { } +void DoBranchFalseAndNoPopSP () { } +void DoBranchFalseElseExtraPopFP () { } +void DoBranchFalseElseExtraPopIM () { } +void DoBranchFalseElseExtraPopLP () { } +void DoBranchFalseElseExtraPopSP () { } +void DoBranchFalseElseNoPopFP () { } +void DoBranchFalseElseNoPopIM () { } +void DoBranchFalseElseNoPopLP () { } +void DoBranchFalseElseNoPopSP () { } +void DoBranchFalseExtraPopFP () { } +void DoBranchFalseExtraPopIM () { } +void DoBranchFalseExtraPopLP () { } +void DoBranchFalseExtraPopSP () { } +void DoBranchFalseFP () { } +void DoBranchFalseIM () { } +void DoBranchFalseLP () { } +void DoBranchFalseNoPopFP () { } +void DoBranchFalseNoPopIM () { } +void DoBranchFalseNoPopLP () { } +void DoBranchFalseNoPopSP () { } +void DoBranchFalseSP () { } +void DoBranchIM () { } +void DoBranchLP () { } +void DoBranchSP () { } +void DoBranchTrueAndExtraPopFP () { } +void DoBranchTrueAndExtraPopIM () { } +void DoBranchTrueAndExtraPopLP () { } +void DoBranchTrueAndExtraPopSP () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopFP () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopIM () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopLP () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopSP () { } +void DoBranchTrueAndNoPopFP () { } +void DoBranchTrueAndNoPopIM () { } +void DoBranchTrueAndNoPopLP () { } +void DoBranchTrueAndNoPopSP () { } +void DoBranchTrueElseExtraPopFP () { } +void DoBranchTrueElseExtraPopIM () { } +void DoBranchTrueElseExtraPopLP () { } +void DoBranchTrueElseExtraPopSP () { } +void DoBranchTrueElseNoPopFP () { } +void DoBranchTrueElseNoPopIM () { } +void DoBranchTrueElseNoPopLP () { } +void DoBranchTrueElseNoPopSP () { } +void DoBranchTrueExtraPopFP () { } +void DoBranchTrueExtraPopIM () { } +void DoBranchTrueExtraPopLP () { } +void DoBranchTrueExtraPopSP () { } +void DoBranchTrueFP () { } +void DoBranchTrueIM () { } +void DoBranchTrueLP () { } +void DoBranchTrueNoPopFP () { } +void DoBranchTrueNoPopIM () { } +void DoBranchTrueNoPopLP () { } +void DoBranchTrueNoPopSP () { } +void DoBranchTrueSP () { } +void DoCarFP () { } +void DoCarIM () { } +void DoCarLP () { } +void DoCarSP () { } +void DoCatchCloseFP () { } +void DoCatchCloseIM () { } +void DoCatchCloseLP () { } +void DoCatchCloseSP () { } +void DoCatchOpenFP () { } +void DoCatchOpenIM () { } +void DoCatchOpenLP () { } +void DoCatchOpenSP () { } +void DoCdrFP () { } +void DoCdrIM () { } +void DoCdrLP () { } +void DoCdrSP () { } +void DoCeilingFP () { } +void DoCeilingIM () { } +void DoCeilingLP () { } +void DoCeilingSP () { } +void DoCharDpbFP () { } +void DoCharDpbIM () { } +void DoCharDpbLP () { } +void DoCharDpbSP () { } +void DoCharLdbFP () { } +void DoCharLdbIM () { } +void DoCharLdbLP () { } +void DoCharLdbSP () { } +void DoCheckPreemptRequestFP () { } +void DoCheckPreemptRequestIM () { } +void DoCheckPreemptRequestLP () { } +void DoCheckPreemptRequestSP () { } +void DoCoprocessorReadFP () { } +void DoCoprocessorReadIM () { } +void DoCoprocessorReadLP () { } +void DoCoprocessorReadSP () { } +void DoCoprocessorWriteFP () { } +void DoCoprocessorWriteIM () { } +void DoCoprocessorWriteLP () { } +void DoCoprocessorWriteSP () { } +void DoDecrementFP () { } +void DoDecrementIM () { } +void DoDecrementLP () { } +void DoDecrementSP () { } +void DoDereferenceFP () { } +void DoDereferenceIM () { } +void DoDereferenceLP () { } +void DoDereferenceSP () { } +void DoDivideBignumStepFP () { } +void DoDivideBignumStepIM () { } +void DoDivideBignumStepLP () { } +void DoDivideBignumStepSP () { } +void DoDoubleFloatOpFP () { } +void DoDoubleFloatOpIM () { } +void DoDoubleFloatOpLP () { } +void DoDoubleFloatOpSP () { } +void DoDpbFP () { } +void DoDpbIM () { } +void DoDpbLP () { } +void DoDpbSP () { } +void DoEndpFP () { } +void DoEndpIM () { } +void DoEndpLP () { } +void DoEndpSP () { } +void DoEntryRestAcceptedFP () { } +void DoEntryRestAcceptedIM () { } +void DoEntryRestAcceptedLP () { } +void DoEntryRestAcceptedSP () { } +void DoEntryRestNotAcceptedFP () { } +void DoEntryRestNotAcceptedIM () { } +void DoEntryRestNotAcceptedLP () { } +void DoEntryRestNotAcceptedSP () { } +void DoEphemeralpFP () { } +void DoEphemeralpIM () { } +void DoEphemeralpLP () { } +void DoEphemeralpSP () { } +void DoEqFP () { } +void DoEqIM () { } +void DoEqLP () { } +void DoEqSP () { } +void DoEqlFP () { } +void DoEqlIM () { } +void DoEqlLP () { } +void DoEqlSP () { } +void DoEqualNumberFP () { } +void DoEqualNumberIM () { } +void DoEqualNumberLP () { } +void DoEqualNumberSP () { } +void DoFastAref1FP () { } +void DoFastAref1IM () { } +void DoFastAref1LP () { } +void DoFastAref1SP () { } +void DoFastAset1FP () { } +void DoFastAset1IM () { } +void DoFastAset1LP () { } +void DoFastAset1SP () { } +void DoFinishCallNFP () { } +void DoFinishCallNIM () { } +void DoFinishCallNLP () { } +void DoFinishCallNSP () { } +void DoFinishCallTosFP () { } +void DoFinishCallTosIM () { } +void DoFinishCallTosLP () { } +void DoFinishCallTosSP () { } +void DoFloorFP () { } +void DoFloorIM () { } +void DoFloorLP () { } +void DoFloorSP () { } +void DoGenericDispatchFP () { } +void DoGenericDispatchIM () { } +void DoGenericDispatchLP () { } +void DoGenericDispatchSP () { } +void DoGreaterpFP () { } +void DoGreaterpIM () { } +void DoGreaterpLP () { } +void DoGreaterpSP () { } +void DoHaltFP () { } +void DoHaltIM () { } +void DoHaltLP () { } +void DoHaltSP () { } +void DoIStageError () { } +void DoIncrementFP () { } +void DoIncrementIM () { } +void DoIncrementLP () { } +void DoIncrementSP () { } +void DoInstanceLocFP () { } +void DoInstanceLocIM () { } +void DoInstanceLocLP () { } +void DoInstanceLocSP () { } +void DoInstanceRefFP () { } +void DoInstanceRefIM () { } +void DoInstanceRefLP () { } +void DoInstanceRefSP () { } +void DoInstanceSetFP () { } +void DoInstanceSetIM () { } +void DoInstanceSetLP () { } +void DoInstanceSetSP () { } +void DoJumpFP () { } +void DoJumpIM () { } +void DoJumpLP () { } +void DoJumpSP () { } +void DoLdbFP () { } +void DoLdbIM () { } +void DoLdbLP () { } +void DoLdbSP () { } +void DoLesspFP () { } +void DoLesspIM () { } +void DoLesspLP () { } +void DoLesspSP () { } +void DoLocateLocalsFP () { } +void DoLocateLocalsIM () { } +void DoLocateLocalsLP () { } +void DoLocateLocalsSP () { } +void DoLogandFP () { } +void DoLogandIM () { } +void DoLogandLP () { } +void DoLogandSP () { } +void DoLogicTailTestFP () { } +void DoLogicTailTestIM () { } +void DoLogicTailTestLP () { } +void DoLogicTailTestSP () { } +void DoLogiorFP () { } +void DoLogiorIM () { } +void DoLogiorLP () { } +void DoLogiorSP () { } +void DoLogtestFP () { } +void DoLogtestIM () { } +void DoLogtestLP () { } +void DoLogtestSP () { } +void DoLogxorFP () { } +void DoLogxorIM () { } +void DoLogxorLP () { } +void DoLogxorSP () { } +void DoLoopDecrementTosFP () { } +void DoLoopDecrementTosIM () { } +void DoLoopDecrementTosLP () { } +void DoLoopDecrementTosSP () { } +void DoLoopIncrementTosLessThanFP () { } +void DoLoopIncrementTosLessThanIM () { } +void DoLoopIncrementTosLessThanLP () { } +void DoLoopIncrementTosLessThanSP () { } +void DoLshFP () { } +void DoLshIM () { } +void DoLshLP () { } +void DoLshSP () { } +void DoLshcBignumStepFP () { } +void DoLshcBignumStepIM () { } +void DoLshcBignumStepLP () { } +void DoLshcBignumStepSP () { } +void DoMaxFP () { } +void DoMaxIM () { } +void DoMaxLP () { } +void DoMaxSP () { } +void DoMemberFP () { } +void DoMemberIM () { } +void DoMemberLP () { } +void DoMemberSP () { } +void DoMemoryReadFP () { } +void DoMemoryReadIM () { } +void DoMemoryReadLP () { } +void DoMemoryReadSP () { } +void DoMemoryWriteFP () { } +void DoMemoryWriteIM () { } +void DoMemoryWriteLP () { } +void DoMemoryWriteSP () { } +void DoMergeCdrNoPopFP () { } +void DoMergeCdrNoPopIM () { } +void DoMergeCdrNoPopLP () { } +void DoMergeCdrNoPopSP () { } +void DoMessageDispatchFP () { } +void DoMessageDispatchIM () { } +void DoMessageDispatchLP () { } +void DoMessageDispatchSP () { } +void DoMinFP () { } +void DoMinIM () { } +void DoMinLP () { } +void DoMinSP () { } +void DoMinuspFP () { } +void DoMinuspIM () { } +void DoMinuspLP () { } +void DoMinuspSP () { } +void DoMovemFP () { } +void DoMovemIM () { } +void DoMovemInstanceVariableFP () { } +void DoMovemInstanceVariableIM () { } +void DoMovemInstanceVariableLP () { } +void DoMovemInstanceVariableOrderedFP () { } +void DoMovemInstanceVariableOrderedIM () { } +void DoMovemInstanceVariableOrderedLP () { } +void DoMovemInstanceVariableOrderedSP () { } +void DoMovemInstanceVariableSP () { } +void DoMovemLP () { } +void DoMovemLexicalVarNFP () { } +void DoMovemLexicalVarNIM () { } +void DoMovemLexicalVarNLP () { } +void DoMovemLexicalVarNSP () { } +void DoMovemSP () { } +void DoMultiplyBignumStepFP () { } +void DoMultiplyBignumStepIM () { } +void DoMultiplyBignumStepLP () { } +void DoMultiplyBignumStepSP () { } +void DoMultiplyDoubleFP () { } +void DoMultiplyDoubleIM () { } +void DoMultiplyDoubleLP () { } +void DoMultiplyDoubleSP () { } +void DoMultiplyFP () { } +void DoMultiplyIM () { } +void DoMultiplyLP () { } +void DoMultiplySP () { } +void DoNoOpFP () { } +void DoNoOpIM () { } +void DoNoOpLP () { } +void DoNoOpSP () { } +void DoPDpbFP () { } +void DoPDpbIM () { } +void DoPDpbLP () { } +void DoPDpbSP () { } +void DoPLdbFP () { } +void DoPLdbIM () { } +void DoPLdbLP () { } +void DoPLdbSP () { } +void DoPStoreContentsFP () { } +void DoPStoreContentsIM () { } +void DoPStoreContentsLP () { } +void DoPStoreContentsSP () { } +void DoPTagDpbFP () { } +void DoPTagDpbIM () { } +void DoPTagDpbLP () { } +void DoPTagDpbSP () { } +void DoPTagLdbFP () { } +void DoPTagLdbIM () { } +void DoPTagLdbLP () { } +void DoPTagLdbSP () { } +void DoPluspFP () { } +void DoPluspIM () { } +void DoPluspLP () { } +void DoPluspSP () { } +void DoPointerDifferenceFP () { } +void DoPointerDifferenceIM () { } +void DoPointerDifferenceLP () { } +void DoPointerDifferenceSP () { } +void DoPointerIncrementFP () { } +void DoPointerIncrementIM () { } +void DoPointerIncrementLP () { } +void DoPointerIncrementSP () { } +void DoPointerPlusFP () { } +void DoPointerPlusIM () { } +void DoPointerPlusLP () { } +void DoPointerPlusSP () { } +void DoPopFP () { } +void DoPopIM () { } +void DoPopInstanceVariableFP () { } +void DoPopInstanceVariableIM () { } +void DoPopInstanceVariableLP () { } +void DoPopInstanceVariableOrderedFP () { } +void DoPopInstanceVariableOrderedIM () { } +void DoPopInstanceVariableOrderedLP () { } +void DoPopInstanceVariableOrderedSP () { } +void DoPopInstanceVariableSP () { } +void DoPopLP () { } +void DoPopLexicalVarNFP () { } +void DoPopLexicalVarNIM () { } +void DoPopLexicalVarNLP () { } +void DoPopLexicalVarNSP () { } +void DoPopSP () { } +void DoPushAddressFP () { } +void DoPushAddressIM () { } +void DoPushAddressInstanceVariableFP () { } +void DoPushAddressInstanceVariableIM () { } +void DoPushAddressInstanceVariableLP () { } +void DoPushAddressInstanceVariableOrderedFP () { } +void DoPushAddressInstanceVariableOrderedIM () { } +void DoPushAddressInstanceVariableOrderedLP () { } +void DoPushAddressInstanceVariableOrderedSP () { } +void DoPushAddressInstanceVariableSP () { } +void DoPushAddressLP () { } +void DoPushAddressSP () { } +void DoPushAddressSpRelativeFP () { } +void DoPushAddressSpRelativeIM () { } +void DoPushAddressSpRelativeLP () { } +void DoPushAddressSpRelativeSP () { } +void DoPushFP () { } +void DoPushGlobalLogicVariableFP () { } +void DoPushGlobalLogicVariableIM () { } +void DoPushGlobalLogicVariableLP () { } +void DoPushGlobalLogicVariableSP () { } +void DoPushIM () { } +void DoPushInstanceVariableFP () { } +void DoPushInstanceVariableIM () { } +void DoPushInstanceVariableLP () { } +void DoPushInstanceVariableOrderedFP () { } +void DoPushInstanceVariableOrderedIM () { } +void DoPushInstanceVariableOrderedLP () { } +void DoPushInstanceVariableOrderedSP () { } +void DoPushInstanceVariableSP () { } +void DoPushLP () { } +void DoPushLexicalVarNFP () { } +void DoPushLexicalVarNIM () { } +void DoPushLexicalVarNLP () { } +void DoPushLexicalVarNSP () { } +void DoPushLocalLogicVariablesFP () { } +void DoPushLocalLogicVariablesIM () { } +void DoPushLocalLogicVariablesLP () { } +void DoPushLocalLogicVariablesSP () { } +void DoPushNNilsFP () { } +void DoPushNNilsIM () { } +void DoPushNNilsLP () { } +void DoPushNNilsSP () { } +void DoPushSP () { } +void DoQuotientFP () { } +void DoQuotientIM () { } +void DoQuotientLP () { } +void DoQuotientSP () { } +void DoRationalQuotientFP () { } +void DoRationalQuotientIM () { } +void DoRationalQuotientLP () { } +void DoRationalQuotientSP () { } +void DoReadInternalRegisterFP () { } +void DoReadInternalRegisterIM () { } +void DoReadInternalRegisterLP () { } +void DoReadInternalRegisterSP () { } +void DoRestoreBindingStackFP () { } +void DoRestoreBindingStackIM () { } +void DoRestoreBindingStackLP () { } +void DoRestoreBindingStackSP () { } +void DoReturnKludgeFP () { } +void DoReturnKludgeIM () { } +void DoReturnKludgeLP () { } +void DoReturnKludgeSP () { } +void DoReturnMultipleFP () { } +void DoReturnMultipleIM () { } +void DoReturnMultipleLP () { } +void DoReturnMultipleSP () { } +void DoReturnSingleFP () { } +void DoReturnSingleIM () { } +void DoReturnSingleLP () { } +void DoReturnSingleSP () { } +void DoRgetfFP () { } +void DoRgetfIM () { } +void DoRgetfLP () { } +void DoRgetfSP () { } +void DoRotFP () { } +void DoRotIM () { } +void DoRotLP () { } +void DoRotSP () { } +void DoRoundFP () { } +void DoRoundIM () { } +void DoRoundLP () { } +void DoRoundSP () { } +void DoRplacaFP () { } +void DoRplacaIM () { } +void DoRplacaLP () { } +void DoRplacaSP () { } +void DoRplacdFP () { } +void DoRplacdIM () { } +void DoRplacdLP () { } +void DoRplacdSP () { } +void DoSetCdrCode1FP () { } +void DoSetCdrCode1IM () { } +void DoSetCdrCode1LP () { } +void DoSetCdrCode1SP () { } +void DoSetCdrCode2FP () { } +void DoSetCdrCode2IM () { } +void DoSetCdrCode2LP () { } +void DoSetCdrCode2SP () { } +void DoSetSpToAddressFP () { } +void DoSetSpToAddressIM () { } +void DoSetSpToAddressLP () { } +void DoSetSpToAddressSP () { } +void DoSetSpToAddressSaveTosFP () { } +void DoSetSpToAddressSaveTosIM () { } +void DoSetSpToAddressSaveTosLP () { } +void DoSetSpToAddressSaveTosSP () { } +void DoSetTagFP () { } +void DoSetTagIM () { } +void DoSetTagLP () { } +void DoSetTagSP () { } +void DoSetToCarFP () { } +void DoSetToCarIM () { } +void DoSetToCarLP () { } +void DoSetToCarSP () { } +void DoSetToCdrFP () { } +void DoSetToCdrIM () { } +void DoSetToCdrLP () { } +void DoSetToCdrPushCarFP () { } +void DoSetToCdrPushCarIM () { } +void DoSetToCdrPushCarLP () { } +void DoSetToCdrPushCarSP () { } +void DoSetToCdrSP () { } +void DoSetup1DArrayFP () { } +void DoSetup1DArrayIM () { } +void DoSetup1DArrayLP () { } +void DoSetup1DArraySP () { } +void DoSetupForce1DArrayFP () { } +void DoSetupForce1DArrayIM () { } +void DoSetupForce1DArrayLP () { } +void DoSetupForce1DArraySP () { } +void DoSpareOpFP () { } +void DoSpareOpIM () { } +void DoSpareOpLP () { } +void DoSpareOpSP () { } +void DoStackBltAddressFP () { } +void DoStackBltAddressIM () { } +void DoStackBltAddressLP () { } +void DoStackBltAddressSP () { } +void DoStackBltFP () { } +void DoStackBltIM () { } +void DoStackBltLP () { } +void DoStackBltSP () { } +void DoStartCallFP () { } +void DoStartCallIM () { } +void DoStartCallLP () { } +void DoStartCallSP () { } +void DoStoreArrayLeaderFP () { } +void DoStoreArrayLeaderIM () { } +void DoStoreArrayLeaderLP () { } +void DoStoreArrayLeaderSP () { } +void DoStoreConditionalFP () { } +void DoStoreConditionalIM () { } +void DoStoreConditionalLP () { } +void DoStoreConditionalSP () { } +void DoSubBignumStepFP () { } +void DoSubBignumStepIM () { } +void DoSubBignumStepLP () { } +void DoSubBignumStepSP () { } +void DoSubFP () { } +void DoSubIM () { } +void DoSubLP () { } +void DoSubSP () { } +void DoTagFP () { } +void DoTagIM () { } +void DoTagLP () { } +void DoTagSP () { } +void DoTakeValuesFP () { } +void DoTakeValuesIM () { } +void DoTakeValuesLP () { } +void DoTakeValuesSP () { } +void DoTruncateFP () { } +void DoTruncateIM () { } +void DoTruncateLP () { } +void DoTruncateSP () { } +void DoTypeMemberFP () { } +void DoTypeMemberIM () { } +void DoTypeMemberLP () { } +void DoTypeMemberSP () { } +void DoUnaryMinusFP () { } +void DoUnaryMinusIM () { } +void DoUnaryMinusLP () { } +void DoUnaryMinusSP () { } +void DoUnbindNFP () { } +void DoUnbindNIM () { } +void DoUnbindNLP () { } +void DoUnbindNSP () { } +void DoUnifyFP () { } +void DoUnifyIM () { } +void DoUnifyLP () { } +void DoUnifySP () { } +void DoUnsignedLesspFP () { } +void DoUnsignedLesspIM () { } +void DoUnsignedLesspLP () { } +void DoUnsignedLesspSP () { } +void DoWriteInternalRegisterFP () { } +void DoWriteInternalRegisterIM () { } +void DoWriteInternalRegisterLP () { } +void DoWriteInternalRegisterSP () { } +void DoZeropFP () { } +void DoZeropIM () { } +void DoZeropLP () { } +void DoZeropSP () { } +void ICACHEMISS () { } +void ReadRegisterAluAndRotateControl () { } +void ReadRegisterBARx () { } +void ReadRegisterBindingStackLimit () { } +void ReadRegisterBindingStackPointer () { } +void ReadRegisterCRArgumentSize () { } +void ReadRegisterCatchBlockList () { } +void ReadRegisterChipRevision () { } +void ReadRegisterChoicePointer () { } +void ReadRegisterConstantNIL () { } +void ReadRegisterConstantT () { } +void ReadRegisterContinuation () { } +void ReadRegisterControlRegister () { } +void ReadRegisterControlStackExtraLimit () { } +void ReadRegisterControlStackLimit () { } +void ReadRegisterCountMapReloads () { } +void ReadRegisterDynamicBindingCacheBase () { } +void ReadRegisterDynamicBindingCacheMask () { } +void ReadRegisterEphemeralOldspaceRegister () { } +void ReadRegisterError () { } +void ReadRegisterEventCount () { } +void ReadRegisterFEPModeTrapVectorAddress () { } +void ReadRegisterFP () { } +void ReadRegisterFPCoprocessorPresent () { } +void ReadRegisterIcacheControl () { } +void ReadRegisterLP () { } +void ReadRegisterListCacheAddress () { } +void ReadRegisterListCacheArea () { } +void ReadRegisterListCacheLength () { } +void ReadRegisterMapCacheControl () { } +void ReadRegisterMemoryControl () { } +void ReadRegisterMicrosecondClock () { } +void ReadRegisterPHTBase () { } +void ReadRegisterPHTMask () { } +void ReadRegisterPreemptRegister () { } +void ReadRegisterPrefetcherControl () { } +void ReadRegisterSP () { } +void ReadRegisterStackCacheDumpQuantum () { } +void ReadRegisterStackCacheLowerBound () { } +void ReadRegisterStackCacheOverflowLimit () { } +void ReadRegisterStackFrameMaximumSize () { } +void ReadRegisterStructureCacheAddress () { } +void ReadRegisterStructureCacheArea () { } +void ReadRegisterStructureCacheLength () { } +void ReadRegisterStructureStackChoicePointer () { } +void ReadRegisterTOS () { } +void ReadRegisterZoneOldspaceRegister () { } +void WriteRegisterAluAndRotateControl () { } +void WriteRegisterBARx () { } +void WriteRegisterBindingStackLimit () { } +void WriteRegisterBindingStackPointer () { } +void WriteRegisterCatchBlockList () { } +void WriteRegisterChoicePointer () { } +void WriteRegisterContinuation () { } +void WriteRegisterControlRegister () { } +void WriteRegisterControlStackExtraLimit () { } +void WriteRegisterControlStackLimit () { } +void WriteRegisterDynamicBindingCacheBase () { } +void WriteRegisterDynamicBindingCacheMask () { } +void WriteRegisterEphemeralOldspaceRegister () { } +void WriteRegisterError () { } +void WriteRegisterEventCount () { } +void WriteRegisterFEPModeTrapVectorAddress () { } +void WriteRegisterFP () { } +void WriteRegisterFPCoprocessorPresent () { } +void WriteRegisterLP () { } +void WriteRegisterListCacheAddress () { } +void WriteRegisterListCacheArea () { } +void WriteRegisterListCacheLength () { } +void WriteRegisterMappingTableCache () { } +void WriteRegisterPreemptRegister () { } +void WriteRegisterSP () { } +void WriteRegisterStackCacheLowerBound () { } +void WriteRegisterStackCacheOverflowLimit () { } +void WriteRegisterStructureCacheAddress () { } +void WriteRegisterStructureCacheArea () { } +void WriteRegisterStructureCacheLength () { } +void WriteRegisterStructureStackChoicePointer () { } +void WriteRegisterTOS () { } +void WriteRegisterZoneOldspaceRegister () { } +void boundlocationfw () { } +void callcompiledeven () { } +void callcompiledevenprefetch () { } +void callcompiledodd () { } +void callcompiledoddprefetch () { } +void callgeneric () { } +void callgenericprefetch () { } +void callindirect () { } +void callindirectprefetch () { } +void elementforwardfw () { } +void gcforwardfw () { } +void headerforwardfw () { } +void headerifw () { } +void headerpfw () { } +void logicvariablefw () { } +void monitorforwardfw () { } +void nativeinstruction () { } +void nullfw () { } +void oneqforwardfw () { } +void pushconstantvalue () { } +void resumeemulated () { } +void valuecell () { } diff --git a/emulator/interfac.c b/emulator/interfac.c new file mode 100644 index 0000000..750a8a8 --- /dev/null +++ b/emulator/interfac.c @@ -0,0 +1,1067 @@ +/* -*- Mode:C -*- */ + +#include "std.h" + +#include +#include +#include + +#include +#if defined(OS_DARWIN) || defined(__FreeBSD__) +#define MAP_ANONYMOUS MAP_ANON +#endif + +#include +#include +#include +#include +#include + +#include "aistat.h" /* Alpha-Ivory state */ +#include "aihead.h" /* Alpha-Ivory constants */ +#include "traps.h" /* Alpha-Ivory traps */ +#include "ivoryrep.h" /* Prototypes for this file */ +#include "memory.h" +#include "asmfuns.h" +#include "utilities.h" +#include "BootComm.h" +#include "FEPComm.h" +#include "SystemComm.h" + +#define SetIvoryWord(l,t,d) (*((int64_t *)(l))=((((int64_t)(t))<<32)|(d))) + +/* The machine state is kept in 'processor' the structure PROCESSORSTATE is defined + * in 'aistat.sid' which compiles into aistat.h for this C stub, and aistat.s + * for the ASM interpreter. The asm interpreter caches much of its state in + * alpha registers while running, so it is important for the interpreter to be + * halted before anyone 'dinks' with the state. The interpreter encaches the + * state when it states up and decaches the state when it halts. A couple of + * special exceptions are please-stop and runningp which are not cached, and are + * used to request the interpreter to stop, and test whether it has stopped + * or not. + */ + +PROCESSORSTATEP processor=NULL; + +char *haltreason (int reason) +{ switch (reason) { + case HaltReason_IllInstn: return "UNIMPLEMENTED INSTRUCTION"; + case HaltReason_Halted: return "HALTED"; + case HaltReason_SpyCalled: return "SPY CALLED"; + case HaltReason_FatalStackOverflow: return "STACK OVERFLOW NOT IN EMULATOR MODE"; + case HaltReason_IllegalTrapVector: return "NON-PC IN TRAP VECTOR"; + default: return "UNANTICIPATED ERROR"; + } +} + +/* + Good luck finding documentation on args 2&3 for ALPHA. + Supposedly this is a supported, required interface for + OSF Realtime (POSIX.4) and SVR4 compliance. +*/ + +/* In memory.c */ +#if defined(OS_OSF) +extern void segv_handler (int sigval, int code, struct sigcontext *scp); +#elif defined(OS_LINUX) +extern void segv_handler (int sigval, siginfo_t *si, void *uc); +#elif defined(OS_DARWIN) || defined(__FreeBSD__) +extern void segv_handler (int sigval, siginfo_t *si, void *uc); +#endif + +extern void DoIStageError(); +/* Just jam the PC to DoIStageError, which will "do the right thing"!!! */ +#if defined(OS_OSF) +void ill_handler (int sigval, int code, register struct sigcontext *scp) +{ + scp->sc_pc = (int64_t)DoIStageError; +} +#elif defined(OS_LINUX) && defined(ARCH_PPC64) +void ill_handler (int sigval, siginfo_t *si, void *uc) +{ + ((ucontext_t*)uc)->uc_mcontext.regs->nip = (uint64_t)DoIStageError; +} +#elif defined(OS_LINUX) && defined(ARCH_PPC64) +void ill_handler (int sigval, siginfo_t *si, void *uc) +{ + ((ucontext_t*)uc)->uc_mcontext.regs->nip = (uint64_t)DoIStageError; +} +#elif defined(OS_LINUX) && defined(ARCH_X86_64) +void ill_handler (int sigval, siginfo_t *si, void *uc) +{ + ((ucontext_t*)uc)->uc_mcontext.gregs[REG_RIP] = (uint64_t)DoIStageError; +} +#elif defined(OS_DARWIN) +void ill_handler (int sigval, siginfo_t *si, void *uc) +{ + ((ucontext_t*)uc)->uc_mcontext->ss.srr0 = (uint64_t)DoIStageError; +} +#elif defined(__FreeBSD__) +void ill_handler (int sigval, siginfo_t *si, void *uc) +{ + ((struct __ucontext*)uc)->uc_mcontext.mc_rip = (uint64_t)DoIStageError; +} +#endif + +extern void ARITHMETICEXCEPTION(); +/* Just jam the PC to ArithmeticException, which will "do the right thing"!!! */ +#if defined(OS_OSF) +void fpe_handler (int sigval, int code, register struct sigcontext *scp) +{ + scp->sc_pc = (int64_t)ARITHMETICEXCEPTION; +} +#elif defined(OS_LINUX) && defined(ARCH_PPC64) +void fpe_handler (int sigval, siginfo_t *si, void *uc) +{ + ((ucontext_t*)uc)->uc_mcontext.regs->nip = (uint64_t)ARITHMETICEXCEPTION; +} +#elif defined(OS_LINUX) && defined(ARCH_X86_64) +// +// jj +// +extern void *arexp ; +extern uint64_t iipsp ; +void fpe_handler (int sigval, siginfo_t *si, void *uc) +{ + uint64_t rsp = ((ucontext_t*)uc)->uc_mcontext.gregs[REG_RSP] ; + + // printf("trap: rsp = %llx, interpretr rsp = %llx\n", rsp, iipsp ); + if (rsp != iipsp) { + printf("oops: arithmetic exception outside of interpreter function\n"); + ((ucontext_t*)uc)->uc_mcontext.gregs[REG_RIP] = (uint64_t)ARITHMETICEXCEPTION; + } + else + ((ucontext_t*)uc)->uc_mcontext.gregs[REG_RIP] = (uint64_t)arexp; +} +// +// jj +// +#elif defined(OS_DARWIN) +void fpe_handler (int sigval, siginfo_t *si, void *uc) +{ + ((ucontext_t*)uc)->uc_mcontext->ss.srr0 = (uint64_t)ARITHMETICEXCEPTION; +} +#elif defined(__FreeBSD__) +void fpe_handler (int sigval, siginfo_t *si, void *uc) +{ + ((struct __ucontext*)uc)->uc_mcontext.mc_rip = (uint64_t)ARITHMETICEXCEPTION; +} +#endif + +int InstructionSequencer (void) +{ struct timespec interpreterSleep; + interpreterSleep.tv_sec = 0; + interpreterSleep.tv_nsec = 1000000; /* One millisecond */ + if (Runningp()) { + int reason; + struct sigaction action; + +#ifdef OS_OSF + action.sa_handler = (sa_handler_t)segv_handler; + action.sa_flags = 0; /* tried SA_RESTART too, no luck */ +#else + action.sa_sigaction = (sa_sigaction_t)segv_handler; + action.sa_flags = SA_SIGINFO; +#endif + sigemptyset(&action.sa_mask); + if (-1 == sigaction(SIGSEGV, &action, NULL)) + vpunt (NULL, "Unable to establish memory fault handler."); + +#ifdef OS_OSF + action.sa_handler = (sa_handler_t)fpe_handler; + action.sa_flags = 0; +#else + action.sa_sigaction = (sa_sigaction_t)fpe_handler; + action.sa_flags = SA_SIGINFO; +#endif + sigemptyset(&action.sa_mask); + if (-1 == sigaction(SIGFPE, &action, NULL)) + vpunt (NULL, "Unable to establish floating point exception handler"); + +#ifdef OS_OSF + action.sa_handler = (sa_handler_t)ill_handler; + action.sa_flags = 0; +#else + action.sa_sigaction = (sa_sigaction_t)ill_handler; + action.sa_flags = SA_SIGINFO; +#endif + sigemptyset(&action.sa_mask); + if (-1 == sigaction(SIGILL, &action, NULL)) + vpunt (NULL, "Unable to establish floating point exception handler"); + + reason=iInterpret((PROCESSORSTATEP)MapVirtualAddressTag(0)); + processor->please_stop=0; + processor->please_trap=0; /* ????? */ + if (reason!=HaltReason_SpyCalled) { +#ifdef TRACING + vwarn (NULL, "%s at instruction #%ld\n", haltreason (reason), + 0 - processor->instruction_count); + if (Trace) PrintTrace(); +#endif + } + return (reason); + } + else if (pthread_delay_np(&interpreterSleep)) + vpunt (NULL, "Unable to sleep in the main interpreter thread."); + return (0); +} + +/* Here is the trivial test program from KHS's emulator fib, for + * debugging purposes. + */ + +int FIBTestCode [51][3] = { + { 03, 060, 03376003 }, + { 00, 067, 030005200002 }, + { 03, 056, 0xF8000000L+06 }, + { 00, 065, 030002201424 }, /* 030002201424 */ + { 00, 061, 032003311377 }, +/* { 00, 064, 033040161772 }, */ + { 00, 062, 037000161772 }, + { 00, Type_CompiledFunction, 0xF8000000L+07 }, + { 03, 060, 03376003 }, + { 00, 073, 013402703377 }, + { 00, 064, 033000160002 }, + { 03, 056, 0xF8000000L+06 }, + { 00, 074, 03401200002 }, + { 03, 064, 02270402 }, + { 02, 056, 0xF8000000L+06 }, + { 00, 065, 030402603402 }, + { 00, 064, 033000601000 }, + { 01, 000, 0 } /* End of compiled code */ +}; + +#define WriteControlArgumentSize(c, argsize) (c=((c&(~0xFF))|argsize)) +#define WriteControlCallerFrameSize(c, cfs) (c=((c&(~0x1FE00))|(cfs<<9))) + +void PushOneFakeFrame (void) +{ LispObjRecordp fp; + + fp = ((LispObjRecordp)(processor->sp)) + 1; + fp[0] = *(((LispObjRecordp)(&(processor->continuation)))); + fp[0].tag |= 0xc0; + fp[1].tag = 0xc0 | Type_Fixnum; + fp[1].data =((unsigned int)(processor->control)&0x3FFFFFFF)|((unsigned int)TrapMode_FEP<<30); + processor->control = (unsigned int)TrapMode_FEP<<30; + WriteControlArgumentSize(processor->control, 2); + WriteControlCallerFrameSize(processor->control, (fp - ((LispObjRecordp)(processor->fp)))); + if (processor->epc&1) { /* Odd PC */ + SetIvoryWord(&(processor->continuation),Type_OddPC, processor->epc>>1); + } + else { + SetIvoryWord(&(processor->continuation),Type_EvenPC, processor->epc>>1); + } + processor->fp = *(((uint64_t *)&fp)); + processor->sp = *(((uint64_t *)&fp)) + 8; + processor->lp = *(((uint64_t *)&fp)) + 16; +} + +#define ReadControlArgumentSize(c) (c&0xFF) +#define ReadControlCallerFrameSize(c) ((c&0xFE00)>>9) + +void PopOneFakeFrame (void) +{ LispObjRecordp fp, pc; + fp = ((LispObjRecordp)(processor->fp)); + + processor->sp = *(((uint64_t *)&fp)) - 8; + processor->fp -= 8*ReadControlCallerFrameSize(processor->control); + pc = ((LispObjRecordp)(&(processor->continuation))); + processor->epc = (((uint64_t)(pc->data))<<1) + (pc->tag==Type_OddPC?1L:0L); + SetIvoryWord(&(processor->continuation), fp[0].tag, fp[0].data); + processor->lp = processor->fp + 8*ReadControlArgumentSize(processor->control); +} + + +void InitializeFIBTest () +{ int i; + LispObjRecord object; + LispObjRecord OneHundred; + OneHundred.tag=Type_Fixnum; + OneHundred.data=10; + // OneHundred.data=1; + + EnsureVirtualAddressRange(0xF8000000L,0x100, FALSE); + for (i=0; i<51; i++) { + object.tag = ((FIBTestCode[i][0])<<6) | FIBTestCode[i][1]; + object.data =FIBTestCode[i][2]; + VirtualMemoryWrite(i+0xF8000000L, *((LispObj *)(&object))); + } + processor->control = (unsigned int)TrapMode_FEP<<30; + WriteControlArgumentSize(processor->control, 3); + WriteControlCallerFrameSize(processor->control, 0); + processor->sp+=8; + *((LispObj *)(processor->sp))=*((LispObj *)(&OneHundred)); + processor->lp=processor->sp+8; +} + +#include "testfunction.h" + +void InitializeTestFunction () +{ int i; + LispObjRecord object; + /* LispObjRecord OneHundred; */ + /* OneHundred.tag=Type_Fixnum; */ + /* OneHundred.data=10; */ + + EnsureVirtualAddressRange(0xF8000000L,0x100, FALSE); + for (i=0; icontrol = (unsigned int)TrapMode_FEP<<30; + WriteControlArgumentSize(processor->control, 2); + WriteControlCallerFrameSize(processor->control, 0); + /* processor->sp+=8; + *((LispObj *)(processor->sp))=*((LispObj *)(&OneHundred)); + */ + processor->lp=processor->sp+8; +} + +void MakeArrayFromBits (uint64_t bits, char **tablePointer) +{ int *table, i; + + *tablePointer = (char*) malloc (64 * sizeof (int)); + if (NULL == (table = (int*)*tablePointer)) + vpunt (NULL, "Unable to allocate internal data structures"); + + for (i = 0; i < 64; i++) { + table[i] = (bits & 1) != 0; + bits = bits >> 1; + } +} + +static int first_time = 1; + +/* InitializeIvoryProcessor is called with addresses of the data and tag + * arrays. Both arrays are assumed to be alpha page aligned. Size is the + * size of the arrays in appropriate units. Basedata is an array of 32 bit + * words, basetag is an array of bytes. So a size of 1024 would indicate + * 1024 32 bit words for basedata and 1024 bytes for basetag. + */ +#define ALPHAPAGESIZE 8192 + +static int *debugcopymat; + +void CheckMat () +{ int i, j; + int *matline; + for (i = 0, matline=debugcopymat; + i < 13; + i++, matline+=64) + { int * e; + for (e = &MemoryActionTable[i][0],j=0 ; e < &MemoryActionTable[i][64]; e++, j++) { + if (matline[j]!=*e) + vwarn (NULL, "MAT difference found at [i=%d,j=%d] MAT=%d copymat=%d\n", + i, j, *e, matline[j]); + } + } +} + +#if defined(ARCH_ALPHA) +static void ComputeSpeed (int64_t *speed) { + extern void SpinWheels (); + struct tms tms; + int timebefore, timeafter, t1, tmin=0x7FFFFFFF, i; + int64_t tps = sysconf(_SC_CLK_TCK); + for (i=0; i<3; i++) { + times(&tms); + timebefore = ((int)((int64_t) (tms.tms_utime+tms.tms_stime)*1000000/tps)); + SpinWheels(); + times(&tms); + timeafter = ((int)((int64_t) (tms.tms_utime+tms.tms_stime)*1000000/tps)); + t1=timeafter-timebefore; + if (t1 < tmin) tmin=t1; + }; + *speed=((((int64_t) tmin)*1000000L)/0x4000000L); + processor->mscmultiplier=(*speed<<24)/1000000; +} + +#elif defined(ARCH_PPC64) +#define timebase() \ + ({ int64_t __value; \ + asm (" mftb 0,268\n std 0,%0" : "=g"(__value) : : "r0" ); \ + __value; }) + +volatile int gotit = 0; + +static void alarm_handler (int sigval, register siginfo_t *si, void *uc_p) { + gotit = 1; +} + +static void ComputeSpeed (int64_t *speed) { + struct sigaction action, oldaction; + int64_t start, stop; + action.sa_sigaction = (sa_sigaction_t)alarm_handler; + action.sa_flags = SA_SIGINFO; + sigemptyset(&action.sa_mask); + sigaction(SIGALRM, &action, &oldaction); + gotit = 0; + alarm(1); + start = timebase(); + while (!gotit); + stop = timebase(); + sigaction(SIGALRM, &oldaction, NULL); + *speed = processor->ticksperms = (stop - start) / 1000000; +} +#elif defined(ARCH_X86_64) +static void ComputeSpeed (int64_t *speed) { + extern void SpinWheels (); + struct tms tms; + int timebefore, timeafter, t1, tmin=0x7FFFFFFF, i; + int64_t tps = sysconf(_SC_CLK_TCK); + for (i=0; i<3; i++) { + times(&tms); + timebefore = ((int)((int64_t) (tms.tms_utime+tms.tms_stime)*1000000/tps)); + SpinWheels(); + times(&tms); + timeafter = ((int)((int64_t) (tms.tms_utime+tms.tms_stime)*1000000/tps)); + t1=timeafter-timebefore; + if (t1 < tmin) tmin=t1; + }; + *speed=((((int64_t) tmin)*1000000L)/0x4000000L); + processor->mscmultiplier=(*speed<<24)/1000000; +} +#endif + +static void RunPOST (int64_t speed) { + int mstimeb, mstimea, result; +#if defined(ARCH_ALPHA) || defined(ARCH_X86_64) + struct tms tms; + int64_t tps = sysconf(_SC_CLK_TCK); +#endif + vwarn("POST", "RunPOST"); +/* printf("RunPOST\n"); */ + if (TestFunction) + InitializeTestFunction (); + else + InitializeFIBTest (); /* This is the Power on self test */ + if (Trace) InitializeTracing (1000, processor->epc >> 1, 0, NULL); +#if defined(ARCH_ALPHA) || defined(ARCH_X86_64) + times(&tms); + mstimeb = (int)((int64_t) (tms.tms_utime+tms.tms_stime)*1000000/tps); +#elif defined(ARCH_PPC64) + mstimeb = timebase() / processor->ticksperms; +#endif + if (result=iInterpret((PROCESSORSTATEP)MapVirtualAddressTag(0)), + result!=HaltReason_Halted) + vwarn ("POST", "FAILED: %s", haltreason(result)); + else { +#if defined(ARCH_ALPHA) || defined(ARCH_X86_64) + times(&tms); + mstimea = ((int)((int64_t) (tms.tms_utime+tms.tms_stime)*1000000/tps)); +#elif defined(ARCH_PPC64) + mstimea = timebase() / processor->ticksperms; +#endif + vwarn ("POST", "OK %d %ld", mstimea-mstimeb, speed); +#ifdef STATISTICS +#ifdef STATISTICSNEVER + DumpInstructionUsageData(); +#else + InitializeStatistics(); /* reset statistics */ +#endif +#endif + } + if (Trace) PrintTrace(); + processor->trace_hook = 0; +} + +void InitializeIvoryProcessor (Integer *basedata, Tag *basetag) +{ char **tablePointer; + uint64_t *maskPointer; + int *copymat=NULL; + int *matline; + int i, j; + + /* Allocate ancillary data structures. Force page alignment + * of the data by roundup. We also add 13*64*4 bytes for the memory action table. + * we move the MAT into the controlled processor state cache to ensure that + * the memory reference doesn't disturb the datacache for processorstate. + * We also allocate the stack-cache in this block, so that stack-cache and + * processor-state references do not collide + */ + if (processor==NULL) { + /* processor state preceeds TagSpace, both accessed from Ivory register */ + caddr_t state_page = (caddr_t)MapVirtualAddressTag(0) - ALPHAPAGESIZE*2; /* pr */ + caddr_t block; + + if (state_page != mmap(state_page, 2*ALPHAPAGESIZE, PROT_READ|PROT_WRITE, /* pr */ + MAP_ANONYMOUS|MAP_PRIVATE|MAP_FIXED,-1,0)) + vpunt (NULL, "Couldn't create processor state page"); + /* allocate processor-state block (aligned to end of d-cache) */ + processor = (PROCESSORSTATEP)(state_page + 2*ALPHAPAGESIZE - PROCESSORSTATE_SIZE); /* pr */ + /* allocate stack-cache in the same page (aligned at 0 relative to d-cache) */ + stackcache = (LispObjRecordp)state_page; + + block=(caddr_t)malloc((16*64*sizeof(int)) /* 16 vs. 13 to get full block */ + +2*ALPHAPAGESIZE); + if (block==NULL) vpunt (NULL, "Unable to allocate internal data structures"); + /* align block */ + block = (caddr_t)(((uint64_t)block+ALPHAPAGESIZE-1)&(~(ALPHAPAGESIZE-1))); + /* allocate mat block (aligned at 0 relative to d-cache again) */ + debugcopymat = copymat = (int*)block; + /* skip (.5x d-cache size) */ + block += (16*64*sizeof(int)); + } + + /* Setup the memory state */ + + processor->vmattributetable=(char*)&VMAttributeTable; + + if (first_time) + /* Create the initial stack pages */ + EnsureVirtualAddressRange(BootStackBase, 0x4000, FALSE); + + /* Initialize magic state */ + if (processor->taddress!=MakeLispObj(Type_Symbol,Address_T)) { + float fpconstant1=1.0; + int *fpp=(int *)(&fpconstant1); + /* Prevent overwriting the machine state on subsequent initializations */ + /* printf("processor %p\n", (void *)processor); */ + processor->please_stop=0; + processor->please_trap=0; + processor->immediate_arg=MakeLispObj(Type_Fixnum,0); + processor->stop_interpreter=0; + if (first_time) + processor->runningp=1; + processor->cp=NULL; /* This is important for the first time */ + processor->epc=(0xF8000000L)<<1; + processor->control=0; + processor->continuation=0; + processor->bar0=0; + processor->bar1=0; + processor->bar2=0; + processor->bar3=0; + processor->sp=0; + processor->fp=0; + processor->lp=0; + processor->sfp1=*fpp; + processor->stackcachebasevma=0; + processor->stackcachetopvma=0; + processor->stackcachedata=NULL; + processor->areventcount=0; + processor->bindingstackpointer=0; + processor->bindingstacklimit=0; + processor->catchblock=0; + processor->cslimit=0; + processor->csextralimit=0; + processor->lclength=0; + processor->scarea=0; + processor->scaddress=0; + processor->icachebase=NULL; + processor->endicache=NULL; + /* must be power of two and less than one page */ + processor->interruptreg=0; + processor->ephemeraloldspace=0; + processor->zoneoldspace=0; + processor->sstkchoiceptr=0; + processor->choiceptr=0; + processor->dbcbase=0; + processor->dbcmask=0; + processor->trapvecbase=0xF8040000L; + processor->fepmodetrapvecaddress=0xF8040A47L; + processor->tvi=0; + for (i = 0, maskPointer = &processor->dataread_mask, + tablePointer = &processor->dataread, matline=copymat; + i < 13; + i++, maskPointer += 2, tablePointer += 2, matline+=64) + { int* e; + uint64_t mask = 0; + + *tablePointer = (char *)matline; /* (char*)&MemoryActionTable[i][0];*/ + /* VLM does not use transport bits, clear from table to save a cycle */ + for (e = &MemoryActionTable[i][0],j=0 ; e < &MemoryActionTable[i][64]; e++, j++) { + *e &= ~MemoryAction_Transport; + if (*e) mask |= (1L << j); /* accumulate mask of types with action */ + matline[j]=*e; /* copy bits into copymat */ + } + *maskPointer = mask; + } +/* ---*** TODO: WHY IS THIS HERE? + processor->long_pad1=0x34000000FFL; */ + processor->cdrcodemask=0xC000000000L; + MakeArrayFromBits (0x0000FFF4FFFFF8F7L, &processor->ptrtype); + SetIvoryWord(&(processor->niladdress),Type_NIL,Address_NIL); + SetIvoryWord(&(processor->taddress),Type_Symbol,Address_T); + + /* double-float, bignum, big-ratio, complex, and spare */ + processor->eqnoteql=(uint64_t)0x000000000000F800L; + + /* The 32 bit value of most positive and most negative fixnum */ + processor->mostpositivefixnum=(int64_t)((~(-1 << 31)) & 0xFFFFFFFF); + processor->mostnegativefixnum=(int64_t)(( (-1 << 31)) & 0xFFFFFFFF); + + processor->halfworddispatch=(int64_t)halfworddispatch; + processor->fullworddispatch=(int64_t)fullworddispatch; + processor->internalregisterread1=(int64_t)internalregisterread1; + processor->internalregisterread2=(int64_t)internalregisterread2; + processor->internalregisterwrite1=(int64_t)internalregisterwrite1; + processor->internalregisterwrite2=(int64_t)internalregisterwrite2; + processor->extraandcatch=(1L<<8 | 1L<<26); + processor->fccrmask= ~(0x074FFFFFL); + processor->fccrtrapmask= (processor->fccrmask)&~(7L<<27); + processor->coprocessorreadhook=(char*)&CoprocessorRead; + processor->coprocessorwritehook=(char*)&CoprocessorWrite; + processor->trace_hook = 0; /* Don't trace the self-test ... */ + processor->i_stage_error_hook=(char*)&DoIStageError; + processor->flushcaches_hook=(char*)&FlushCaches; + processor->statistics=(char *)malloc(0x2000*sizeof(int64_t)); + + /* Add the native code callout trampolines */ + processor->resumeema=(int64_t)(&resumeemulated); + processor->carsubroutine=(int64_t)(&CarSubroutine); + processor->cdrsubroutine=(int64_t)(&CdrSubroutine); + processor->carcdrsubroutine=(int64_t)(&CarCdrSubroutine); + + InitializeStatistics(); + } + + processor->instruction_count=0; + + /* Flush and initialize the instruction cache */ + + InitializeInstructionCache(); + processor->icachebase=(char*)instructioncache; + processor->endicache=((char*)instructioncache)+icachesize*sizeof(CACHELINE); + + /* Initialize the stack cache */ + + InitializeStackCache(); + processor->stackcachebasevma=BootStackBase; + processor->cslimit=processor->stackcachebasevma+0x800; /* pr */ + processor->csextralimit=processor->stackcachebasevma+0x1000; /* pr */ + processor->scovlimit=256; + processor->stackcachetopvma=(uint64_t)(((unsigned)BootStackBase)+(unsigned)stackcachesize); + processor->stackcachesize=(uint64_t)stackcachesize; + processor->stackcachedata=(char*)stackcache; + + /* Processor Initialization */ + + processor->fp=(int64_t)processor->stackcachedata; + processor->sp=(int64_t)processor->stackcachedata; + processor->lp=(int64_t)processor->stackcachedata; + + processor->control=2; + +#if defined(ARCH_ALPHA) + /* MS clock multiplier -- initial values */ + processor->mscmultiplier=109051; /* 6.5 ns clock RPCC N=1 */ + processor->msclockcache=0; + processor->previousrcpp = 0; +#elif defined(ARCH_PPC64) + /* MS clock -- initial values */ + processor->ticksperms = 33; /* 33 MHz timebase */ + processor->msclockcache = 0; + processor->previoustb = timebase (); +#elif defined(ARCH_X86_64) + /* MS clock -- initial values */ + processor->mscmultiplier=109051; /* 6.5 ns clock RPCC N=1 */ + processor->msclockcache=0; + processor->previousrcpp = 0; +#endif + + /* Initialize the interpreter state */ + /* Push an Initial Frame */ + *((int64_t *)(processor->sp))=((((int64_t)Type_NIL)<<32)|037001011000L); + processor->sp+=8; + *((int64_t *)(processor->sp))=((((int64_t)Type_NIL)<<32)|037001011000L); + processor->lp=processor->sp+8; + +#ifdef TRANSACTIONAL + /* setup transactional memory state */ + processor->tmcurrenttransaction = 0; +#endif + +#ifdef CACHEMETERING + /* setup the instruction cache miss metering block */ + processor->meterdatabuff = (void *)malloc(sizeof(int)<meterpos = 0; /* the place where the next data item goes. */ + processor->metermax = 0;/* the highest value ever recorded. */ + processor->meterfreq = CacheMeter_DefaultFreq; /* sample size. */ + processor->metermask = (1<metervalue = 0; /* current number of misses. */ + processor->metercount = processor->meterfreq; /* number remaining */ + { int i; /* set all entries to -1 to indicate that they haven't been used yet. */ + for (i=0; i<=processor->metermask; i++) ((int *)processor->meterdatabuff)[i]=-1; + } +#endif +#ifdef TRAPMETERING + processor->trapmeterdata = (void *)malloc(sizeof(int64_t)*TrapMeter_NEntries); + { int i; + for (i=0; itrapmeterdata)[i]=0; + } +#endif + + if (first_time) { + uint64_t plp=processor->lp, psp=processor->sp, pfp=processor->fp; + int64_t speed; + first_time = 0; + ComputeSpeed(&speed); + InitializeIvoryInterpreterState(); + RunPOST(speed); + processor->lp=plp, processor->sp=psp, processor->fp=pfp; + } + + ResetMachine(); + PushOneFakeFrame(); + PushOneFakeFrame(); + CheckMat(); +} + +int Runningp (void) +{ + return processor->runningp; +} + +void HaltMachine (void) +{ + if (Runningp()) { + processor->please_stop=HaltReason_SpyCalled; +printf("HaltMachine!!!\n"); + processor->stop_interpreter=1; + } +} + +void ResetMachine (void) +{ + processor->epc=0; + processor->continuation=MakeLispObj(Type_NIL,0); +} + +void StartMachine (Boolean resumeP) +{ + if (!resumeP) flushicache(); + processor->please_stop=0; + processor->please_trap=0; /* ????? */ + processor->runningp=1; +} + +int IvoryProcessorSystemStartup (int bootingP) +{ LispObj q; + if (bootingP) { + signal(SIGFPE, SIG_IGN); + InitializeIvoryProcessor (MapVirtualAddressData (0), MapVirtualAddressTag (0)); + if (((q = ReadFEPCommSlot(fepStartup)) && (LispObjTag(q) == Type_CompiledFunction)) || + ((q = ReadSystemCommSlot(systemStartup)) && (LispObjTag(q) == Type_CompiledFunction)) + ) { + LispObjRecordp fp; + fp = ((LispObjRecordp)(processor->fp)); + fp[0].tag = 0xc0 | Type_EvenPC; + fp[0].data = LispObjData(q); + } + else return (FALSE); + } + ResetMachine(); + /* Pop our two fake frames */ + PopOneFakeFrame(); + PopOneFakeFrame(); + StartMachine(FALSE); + return (TRUE); +} + +void SendInterruptToEmulator (void) +{ if (Runningp()) { + processor->please_trap=TrapReason_HighPrioritySequenceBreak; + processor->stop_interpreter=1; + } +} + +/* Convert a stack cache address to a vma */ +#define SCAtoVMA(sca) ((((uint64_t)(((char*)sca)-processor->stackcachedata))>>3)+processor->stackcachebasevma) + +/* Convert a vma to a stack cache address */ +#define VMAtoSCA(vma) ((int64_t)((((uint64_t)vma-processor->stackcachebasevma)<<3)+processor->stackcachedata)) + +/* Halfword PC to PC: + OK, here it goes. We keep PC's internally as a halfword address. This darling + little macro takes one of these guys and converts it into a good ol' Ivory PC with + a DTP-EvenPC or DTP-OddPC ... + so there + */ +#define HWPCtoPC(hwpc) (((((uint64_t)((((int)hwpc)&1)?Type_OddPC:Type_EvenPC)))<<32)|(((uint64_t)hwpc)>>1)) + +#define PCtoHWPC(pc) (((((((uint64_t)(pc))>>32)&0x3F)==Type_OddPC)?1:0)|(((uint64_t)(pc)&0xFFFFFFFF)<<1)) + + +LispObj WriteInternalRegister (int regno, LispObj val) +{ LispObjRecord object; + + *((LispObj *)&object)=val; + switch (regno) { + case InternalRegister_EA: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_FP: /* Register #1 */ + processor->fp=VMAtoSCA(object.data); + break; + + case InternalRegister_LP: /* Register #2 */ + processor->lp=VMAtoSCA(object.data); + break; + + case InternalRegister_SP: + processor->sp=VMAtoSCA(object.data); + break; + + case InternalRegister_StackCacheLowerBound: + processor->stackcachebasevma=object.data; + break; + + case InternalRegister_BAR0: + *((LispObjRecordp)&(processor->bar0))=object; + break; + + case InternalRegister_BAR1: +//printf("**set bar1 %p\n", (void *)object); + *((LispObjRecordp)&(processor->bar1))=object; + break; + + case InternalRegister_BAR2: + *((LispObjRecordp)&(processor->bar2))=object; + break; + + case InternalRegister_BAR3: + *((LispObjRecordp)&(processor->bar3))=object; + break; + + case InternalRegister_PHTHash0: + case InternalRegister_PHTHash1: + case InternalRegister_PHTHash2: + case InternalRegister_PHTHash3: + case InternalRegister_EPC: + case InternalRegister_DPC: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_Continuation: /* Register #10 */ + processor->continuation=(PCtoHWPC(val)); + break; + + case InternalRegister_AluAndRotateControl: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_ControlRegister: /* Register #12 */ + processor->control=MakeLispObj(Type_Fixnum,object.data); + break; + + case InternalRegister_CRArgumentSize: + case InternalRegister_EphemeralOldspaceRegister: + case InternalRegister_ZoneOldspaceRegister: + case InternalRegister_ChipRevision: + case InternalRegister_FPCoprocessorPresent: + case InternalRegister_PreemptRegister: + case InternalRegister_IcacheControl: + case InternalRegister_PrefetcherControl: + case InternalRegister_MapCacheControl: + case InternalRegister_MemoryControl: + case InternalRegister_ECCLog: + case InternalRegister_ECCLogAddress: + case InternalRegister_InvalidateMap0: + case InternalRegister_InvalidateMap1: + case InternalRegister_InvalidateMap2: + case InternalRegister_InvalidateMap3: + case InternalRegister_LoadMap0: + case InternalRegister_LoadMap1: + case InternalRegister_LoadMap2: + case InternalRegister_LoadMap3: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_StackCacheOverflowLimit: + processor->stackcachetopvma=object.data; + break; + + case InternalRegister_UcodeROMContents: + case InternalRegister_AddressMask: + case InternalRegister_EntryMaximumArguments: + case InternalRegister_LexicalVariable: + case InternalRegister_Instruction: + case InternalRegister_MemoryData: + case InternalRegister_DataPins: + case InternalRegister_ExtensionRegister: + case InternalRegister_MicrosecondClock: + case InternalRegister_ArrayHeaderLength: + case InternalRegister_LoadBAR0: + case InternalRegister_LoadBAR1: + case InternalRegister_LoadBAR2: + case InternalRegister_LoadBAR3: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_TOS: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_EventCount: + case InternalRegister_BindingStackPointer: + case InternalRegister_CatchBlockList: + + case InternalRegister_ControlStackLimit: + processor->cslimit=object.data; + break; + + case InternalRegister_ControlStackExtraLimit: + processor->csextralimit=object.data; + break; + + case InternalRegister_BindingStackLimit: + case InternalRegister_PHTBase: + case InternalRegister_PHTMask: + case InternalRegister_CountMapReloads: + case InternalRegister_ListCacheArea: + case InternalRegister_ListCacheAddress: + case InternalRegister_ListCacheLength: + case InternalRegister_StructureCacheArea: + case InternalRegister_StructureCacheAddress: + case InternalRegister_StructureCacheLength: + case InternalRegister_DynamicBindingCacheBase: + case InternalRegister_DynamicBindingCacheMask: + case InternalRegister_ChoicePointer: + case InternalRegister_StructureStackChoicePointer: + case InternalRegister_FEPModeTrapVectorAddress: + case InternalRegister_MappingTableCache: + case InternalRegister_MappingTableLength: + case InternalRegister_StackFrameMaximumSize: + case InternalRegister_StackCacheDumpQuantum: + case InternalRegister_ConstantNIL: + case InternalRegister_ConstantT: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + } + return (*((LispObj *)(&object))); +} + +LispObj ReadInternalRegister (int regno) +{ LispObjRecord object; + switch (regno) { + case InternalRegister_EA: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_FP: /* Register #1 */ + object.tag=Type_Locative; + object.data=(int)SCAtoVMA(processor->fp); + break; + + case InternalRegister_LP: /* Register #2 */ + object.tag=Type_Locative; + object.data=(int)SCAtoVMA(processor->lp); + break; + + case InternalRegister_SP: + object.tag=Type_Locative; + object.data=(int)SCAtoVMA(processor->sp); + break; + + case InternalRegister_StackCacheLowerBound: + object.tag=Type_Locative; + object.data=processor->stackcachebasevma; + break; + + case InternalRegister_BAR0: + object=*((LispObjRecordp)&(processor->bar0)); + break; + + case InternalRegister_BAR1: + object=*((LispObjRecordp)&(processor->bar1)); + break; + + case InternalRegister_BAR2: + object=*((LispObjRecordp)&(processor->bar2)); + break; + + case InternalRegister_BAR3: + object=*((LispObjRecordp)&(processor->bar3)); + break; + + case InternalRegister_PHTHash0: + case InternalRegister_PHTHash1: + case InternalRegister_PHTHash2: + case InternalRegister_PHTHash3: + case InternalRegister_EPC: + case InternalRegister_DPC: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_Continuation: /* Register #10 */ + return (HWPCtoPC(processor->continuation)); + + case InternalRegister_AluAndRotateControl: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_ControlRegister: /* Register #12 */ + object.tag=Type_Fixnum; + object.data=processor->control; + break; + + case InternalRegister_CRArgumentSize: + case InternalRegister_EphemeralOldspaceRegister: + case InternalRegister_ZoneOldspaceRegister: + case InternalRegister_ChipRevision: + case InternalRegister_FPCoprocessorPresent: + case InternalRegister_PreemptRegister: + case InternalRegister_IcacheControl: + case InternalRegister_PrefetcherControl: + case InternalRegister_MapCacheControl: + case InternalRegister_MemoryControl: + case InternalRegister_ECCLog: + case InternalRegister_ECCLogAddress: + case InternalRegister_InvalidateMap0: + case InternalRegister_InvalidateMap1: + case InternalRegister_InvalidateMap2: + case InternalRegister_InvalidateMap3: + case InternalRegister_LoadMap0: + case InternalRegister_LoadMap1: + case InternalRegister_LoadMap2: + case InternalRegister_LoadMap3: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_StackCacheOverflowLimit: + object.tag=Type_Locative; + object.data=processor->stackcachetopvma; + break; + + case InternalRegister_UcodeROMContents: + case InternalRegister_AddressMask: + case InternalRegister_EntryMaximumArguments: + case InternalRegister_LexicalVariable: + case InternalRegister_Instruction: + case InternalRegister_MemoryData: + case InternalRegister_DataPins: + case InternalRegister_ExtensionRegister: + case InternalRegister_MicrosecondClock: + case InternalRegister_ArrayHeaderLength: + case InternalRegister_LoadBAR0: + case InternalRegister_LoadBAR1: + case InternalRegister_LoadBAR2: + case InternalRegister_LoadBAR3: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_TOS: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + + case InternalRegister_EventCount: + case InternalRegister_BindingStackPointer: + case InternalRegister_CatchBlockList: + case InternalRegister_ControlStackLimit: + case InternalRegister_ControlStackExtraLimit: + case InternalRegister_BindingStackLimit: + case InternalRegister_PHTBase: + case InternalRegister_PHTMask: + case InternalRegister_CountMapReloads: + case InternalRegister_ListCacheArea: + case InternalRegister_ListCacheAddress: + case InternalRegister_ListCacheLength: + case InternalRegister_StructureCacheArea: + case InternalRegister_StructureCacheAddress: + case InternalRegister_StructureCacheLength: + case InternalRegister_DynamicBindingCacheBase: + case InternalRegister_DynamicBindingCacheMask: + case InternalRegister_ChoicePointer: + case InternalRegister_StructureStackChoicePointer: + case InternalRegister_FEPModeTrapVectorAddress: + case InternalRegister_MappingTableCache: + case InternalRegister_MappingTableLength: + case InternalRegister_StackFrameMaximumSize: + case InternalRegister_StackCacheDumpQuantum: + case InternalRegister_ConstantNIL: + case InternalRegister_ConstantT: + return (LispObj)(-1); /* -1 is the error result for an unimplemented register */ + } + return (*((LispObj *)(&object))); +} + +/* Fin */ diff --git a/emulator/interpds.c b/emulator/interpds.c new file mode 100644 index 0000000..5c17b83 --- /dev/null +++ b/emulator/interpds.c @@ -0,0 +1,1142 @@ +/* -*- Mode:C; Lowercase: Yes -*- */ +/* #define DEBUGICACHE 42 */ + +#include "std.h" + +#include + +#include +#include +#include +#include + +#include "aistat.h" /* Alpha-Ivory state */ +#include "aihead.h" /* Alpha-Ivory constants */ +#include "traps.h" /* Alpha-Ivory traps */ +#include "ivoryrep.h" /* Prototypes for this file */ +#include "asmfuns.h" /* Prototypes for the dispatch functions */ +#include "utilities.h" + +/* In this file, we establish all datastructures used by the ASM + * interpreter. Here we have functions for initializing the datastructures, + * accessing the datastructures, and debugging them. + */ + +/* This is the parameter section. Variables here adjust certain aspects + * of the implementation. + */ + +int icachesize = (CacheLine_Mask+1); /* around 65K instructions. */ +int stackcachesize = Stack_CacheSize; /* 16K Ivory words */ +LispObjRecordp stackcache=NULL; /* Allocate once only */ +CACHELINEP instructioncache=NULL; /* Allocate first time, then clear */ + +#ifdef DEBUGICACHE +extern void SUSPENDMACHINE(); +#endif + +/* These are the memory cycle action tables */ + +int MemoryActionTable[13][64] = +{ + { 014, 06, 014, 010, 05, 05, 05, 05, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 044, 0, 024, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 06, 010, 010, 05, 05, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 044, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 04, 06, 014, 010, 04, 05, 05, 05, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 04, 0, 04, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 06, 010, 010, 0, 05, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 04, 05, 014, 010, 04, 05, 05, 05, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 04, 0, 04, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 05, 010, 010, 0, 05, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 014, 014, 04, 0, 014, 014, 05, 014, 010, 010, 010, 014, 014, 014, + 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, 014, + 014, 014, 014, 014, 010, 010, 014, 010, 014, 010, 014, 014, 014, 014, + 014, 014, 014, 014, 014, 014, 010, 010, 010, 010, 010, 010, 010, 010, + 010, 010, 010, 010, 010, 010, 010, 010 }, + { 0, 0, 0, 0, 0, 0, 05, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 04, 04, 04, 0, 04, 04, 04, 04, 0, 0, 0, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, 04, + 04, 04, 04, 04, 0, 0, 04, 0, 04, 010, 04, 04, 04, 04, + 04, 04, 04, 04, 04, 04, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 010, 010, 0, 0, 05, 05, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 010, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 }, + { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 020, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0 } +}; + +/* These are the master dispatch tables. All entries are entry addresses of + * ASM coded interpretation routines. The halfword instructions are duplicated + * four times to provide operand decode speedup. This is a somewhat dubious + * speedup because of the effect on datacache misses, but if we get enough + * emulated iCache hits, it will more than make up for it, and this way we will + * benefit from future increases in Alpha DCache size increases. + */ +DISPATCHTABLE(halfworddispatch,256*4) +#ifdef DEBUGICACHE + ; +#else + = { + DoCarFP, DoCarLP, DoCarSP, DoCarIM, /* #o00 */ + DoCdrFP, DoCdrLP, DoCdrSP, DoCdrIM, /* #o01 */ + DoEndpFP, DoEndpLP, DoEndpSP, DoEndpIM, /* #o02 */ + DoSetup1DArrayFP, DoSetup1DArrayLP, DoSetup1DArraySP, DoSetup1DArrayIM, /* #o03 */ + DoSetupForce1DArrayFP, DoSetupForce1DArrayLP, DoSetupForce1DArraySP, DoSetupForce1DArrayIM, /* #o04 */ + DoBindLocativeFP, DoBindLocativeLP, DoBindLocativeSP, DoBindLocativeIM, /* #o05 */ + DoRestoreBindingStackFP, DoRestoreBindingStackLP, DoRestoreBindingStackSP, DoRestoreBindingStackIM, /* #o06 */ + DoEphemeralpFP, DoEphemeralpLP, DoEphemeralpSP, DoEphemeralpIM, /* #o07 */ + DoStartCallFP, DoStartCallLP, DoStartCallSP, DoStartCallIM, /* #o010 */ + DoJumpFP, DoJumpLP, DoJumpSP, DoJumpIM, /* #o011 */ + DoTagFP, DoTagLP, DoTagSP, DoTagIM, /* #o012 */ + DoDereferenceFP, DoDereferenceLP, DoDereferenceSP, DoDereferenceIM, /* #o013 */ + DoLogicTailTestFP, DoLogicTailTestLP, DoLogicTailTestSP, DoLogicTailTestIM, /* #o014 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /* #o015 +++ Used for breakpoints!!! */ + DoDoubleFloatOpFP, DoDoubleFloatOpLP, DoDoubleFloatOpSP, DoDoubleFloatOpIM, /* #o016 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /* #o017 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o020 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o021 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o022 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o023 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o024 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o025 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o026 */ + DoPushLexicalVarNFP, DoPushLexicalVarNLP, DoPushLexicalVarNSP, DoPushLexicalVarNIM, /* #o027 */ + DoBlock0WriteFP, DoBlock0WriteLP, DoBlock0WriteSP, DoBlock0WriteIM, /* #o030 */ + DoBlock1WriteFP, DoBlock1WriteLP, DoBlock1WriteSP, DoBlock1WriteIM, /* #o031 */ + DoBlock2WriteFP, DoBlock2WriteLP, DoBlock2WriteSP, DoBlock2WriteIM, /* #o032 */ + DoBlock3WriteFP, DoBlock3WriteLP, DoBlock3WriteSP, DoBlock3WriteIM, /* #o033 */ + DoZeropFP, DoZeropLP, DoZeropSP, DoZeropIM, /* #o034 */ + DoMinuspFP, DoMinuspLP, DoMinuspSP, DoMinuspIM, /* #o035 */ + DoPluspFP, DoPluspLP, DoPluspSP, DoPluspIM, /* #o036 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o037 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o040 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o041 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o042 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o043 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o044 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o045 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o046 */ + DoTypeMemberFP, DoTypeMemberLP, DoTypeMemberSP, DoTypeMemberIM, /* #o047 */ + DoLocateLocalsFP, DoLocateLocalsLP, DoLocateLocalsSP, DoLocateLocalsIM, /* #o050 */ + DoCatchCloseFP, DoCatchCloseLP, DoCatchCloseSP, DoCatchCloseIM, /* #o051 */ + DoGenericDispatchFP, DoGenericDispatchLP, DoGenericDispatchSP, DoGenericDispatchIM, /* #o052 */ + DoMessageDispatchFP, DoMessageDispatchLP, DoMessageDispatchSP, DoMessageDispatchIM, /* #o053 */ + DoCheckPreemptRequestFP, DoCheckPreemptRequestLP, DoCheckPreemptRequestSP, DoCheckPreemptRequestIM, /* #o054 */ + DoPushGlobalLogicVariableFP, DoPushGlobalLogicVariableLP, DoPushGlobalLogicVariableSP, DoPushGlobalLogicVariableIM, /* #o055 */ + DoNoOpFP, DoNoOpLP, DoNoOpSP, DoNoOpIM, /* #o056 */ + DoHaltFP, DoHaltLP, DoHaltSP, DoHaltIM, /* #o057 */ + DoBranchTrueFP, DoBranchTrueLP, DoBranchTrueSP, DoBranchTrueIM, /* #o060 */ + DoBranchTrueElseExtraPopFP, DoBranchTrueElseExtraPopLP, DoBranchTrueElseExtraPopSP, DoBranchTrueElseExtraPopIM, /* #o061 */ + DoBranchTrueAndExtraPopFP, DoBranchTrueAndExtraPopLP, DoBranchTrueAndExtraPopSP, DoBranchTrueAndExtraPopIM, /* #o062 */ + DoBranchTrueExtraPopFP, DoBranchTrueExtraPopLP, DoBranchTrueExtraPopSP, DoBranchTrueExtraPopIM, /* #o063 */ + DoBranchTrueNoPopFP, DoBranchTrueNoPopLP, DoBranchTrueNoPopSP, DoBranchTrueNoPopIM, /* #o064 */ + DoBranchTrueAndNoPopFP, DoBranchTrueAndNoPopLP, DoBranchTrueAndNoPopSP, DoBranchTrueAndNoPopIM, /* #o065 */ + DoBranchTrueElseNoPopFP, DoBranchTrueElseNoPopLP, DoBranchTrueElseNoPopSP, DoBranchTrueElseNoPopIM, /* #o066 */ + DoBranchTrueAndNoPopElseNoPopExtraPopFP, DoBranchTrueAndNoPopElseNoPopExtraPopLP, DoBranchTrueAndNoPopElseNoPopExtraPopSP, DoBranchTrueAndNoPopElseNoPopExtraPopIM, /* #o067 */ + DoBranchFalseFP, DoBranchFalseLP, DoBranchFalseSP, DoBranchFalseIM, /* #o070 */ + DoBranchFalseElseExtraPopFP, DoBranchFalseElseExtraPopLP, DoBranchFalseElseExtraPopSP, DoBranchFalseElseExtraPopIM, /* #o071 */ + DoBranchFalseAndExtraPopFP, DoBranchFalseAndExtraPopLP, DoBranchFalseAndExtraPopSP, DoBranchFalseAndExtraPopIM, /* #o072 */ + DoBranchFalseExtraPopFP, DoBranchFalseExtraPopLP, DoBranchFalseExtraPopSP, DoBranchFalseExtraPopIM, /* #o073 */ + DoBranchFalseNoPopFP, DoBranchFalseNoPopLP, DoBranchFalseNoPopSP, DoBranchFalseNoPopIM, /* #o074 */ + DoBranchFalseAndNoPopFP, DoBranchFalseAndNoPopLP, DoBranchFalseAndNoPopSP, DoBranchFalseAndNoPopIM, /* #o075 */ + DoBranchFalseElseNoPopFP, DoBranchFalseElseNoPopLP, DoBranchFalseElseNoPopSP, DoBranchFalseElseNoPopIM, /* #o076 */ + DoBranchFalseAndNoPopElseNoPopExtraPopFP, DoBranchFalseAndNoPopElseNoPopExtraPopLP, DoBranchFalseAndNoPopElseNoPopExtraPopSP, DoBranchFalseAndNoPopElseNoPopExtraPopIM, /* #o077 */ + DoPushFP, DoPushLP, DoPushSP, DoPushIM, /* #o0100 */ + DoPushNNilsFP, DoPushNNilsLP, DoPushNNilsSP, DoPushNNilsIM, /* #o0101 */ + DoPushAddressSpRelativeFP, DoPushAddressSpRelativeLP, DoPushAddressSpRelativeSP, DoPushAddressSpRelativeIM, /* #o0102 */ + DoPushLocalLogicVariablesFP, DoPushLocalLogicVariablesLP, DoPushLocalLogicVariablesSP, DoPushLocalLogicVariablesIM, /* #o0103 */ + DoReturnMultipleFP, DoReturnMultipleLP, DoReturnMultipleSP, DoReturnMultipleIM, /* #o0104 */ + DoReturnKludgeFP, DoReturnKludgeLP, DoReturnKludgeSP, DoReturnKludgeIM, /* #o0105 */ + DoTakeValuesFP, DoTakeValuesLP, DoTakeValuesSP, DoTakeValuesIM, /* #o0106 */ + DoUnbindNFP, DoUnbindNLP, DoUnbindNSP, DoUnbindNIM, /* #o0107 */ + DoPushInstanceVariableFP, DoPushInstanceVariableLP, DoPushInstanceVariableSP, DoPushInstanceVariableIM, /* #o0110 */ + DoPushAddressInstanceVariableFP, DoPushAddressInstanceVariableLP, DoPushAddressInstanceVariableSP, DoPushAddressInstanceVariableIM, /* #o0111 */ + DoPushInstanceVariableOrderedFP, DoPushInstanceVariableOrderedLP, DoPushInstanceVariableOrderedSP, DoPushInstanceVariableOrderedIM, /* #o0112 */ + DoPushAddressInstanceVariableOrderedFP, DoPushAddressInstanceVariableOrderedLP, DoPushAddressInstanceVariableOrderedSP, DoPushAddressInstanceVariableOrderedIM, /* #o0113 */ + DoUnaryMinusFP, DoUnaryMinusLP, DoUnaryMinusSP, DoUnaryMinusIM, /* #o0114 */ + DoReturnSingleFP, DoReturnSingleLP, DoReturnSingleSP, DoReturnSingleIM, /* #o0115 */ + DoMemoryReadFP, DoMemoryReadLP, DoMemoryReadSP, DoMemoryReadIM, /* #o0116 */ + DoMemoryReadFP, DoMemoryReadLP, DoMemoryReadSP, DoMemoryReadIM, /* #o0117 */ + DoBlock0ReadFP, DoBlock0ReadLP, DoBlock0ReadSP, DoBlock0ReadIM, /* #o0120 */ + DoBlock1ReadFP, DoBlock1ReadLP, DoBlock1ReadSP, DoBlock1ReadIM, /* #o0121 */ + DoBlock2ReadFP, DoBlock2ReadLP, DoBlock2ReadSP, DoBlock2ReadIM, /* #o0122 */ + DoBlock3ReadFP, DoBlock3ReadLP, DoBlock3ReadSP, DoBlock3ReadIM, /* #o0123 */ + DoBlock0ReadShiftFP, DoBlock0ReadShiftLP, DoBlock0ReadShiftSP, DoBlock0ReadShiftIM, /* #o0124 */ + DoBlock1ReadShiftFP, DoBlock1ReadShiftLP, DoBlock1ReadShiftSP, DoBlock1ReadShiftIM, /* #o0125 */ + DoBlock2ReadShiftFP, DoBlock2ReadShiftLP, DoBlock2ReadShiftSP, DoBlock2ReadShiftIM, /* #o0126 */ + DoBlock3ReadShiftFP, DoBlock3ReadShiftLP, DoBlock3ReadShiftSP, DoBlock3ReadShiftIM, /* #o0127 */ + DoBlock0ReadTestFP, DoBlock0ReadTestLP, DoBlock0ReadTestSP, DoBlock0ReadTestIM, /* #o0130 */ + DoBlock1ReadTestFP, DoBlock1ReadTestLP, DoBlock1ReadTestSP, DoBlock1ReadTestIM, /* #o0131 */ + DoBlock2ReadTestFP, DoBlock2ReadTestLP, DoBlock2ReadTestSP, DoBlock2ReadTestIM, /* #o0132 */ + DoBlock3ReadTestFP, DoBlock3ReadTestLP, DoBlock3ReadTestSP, DoBlock3ReadTestIM, /* #o0133 */ + DoFinishCallNFP, DoFinishCallNLP, DoFinishCallNSP, DoFinishCallNIM, /* #o0134 */ + DoFinishCallNFP, DoFinishCallNLP, DoFinishCallNSP, DoFinishCallNIM, /* #o0135 */ + DoFinishCallTosFP, DoFinishCallTosLP, DoFinishCallTosSP, DoFinishCallTosIM, /* #o0136 */ + DoFinishCallTosFP, DoFinishCallTosLP, DoFinishCallTosSP, DoFinishCallTosIM, /* #o0137 */ + DoSetToCarFP, DoSetToCarLP, DoSetToCarSP, DoSetToCarIM, /* #o0140 */ + DoSetToCdrFP, DoSetToCdrLP, DoSetToCdrSP, DoSetToCdrIM, /* #o0141 */ + DoSetToCdrPushCarFP, DoSetToCdrPushCarLP, DoSetToCdrPushCarSP, DoSetToCdrPushCarIM, /* #o0142 */ + DoIncrementFP, DoIncrementLP, DoIncrementSP, DoIncrementIM, /* #o0143 */ + DoDecrementFP, DoDecrementLP, DoDecrementSP, DoDecrementIM, /* #o0144 */ + DoPointerIncrementFP, DoPointerIncrementLP, DoPointerIncrementSP, DoPointerIncrementIM, /* #o0145 */ + DoSetCdrCode1FP, DoSetCdrCode1LP, DoSetCdrCode1SP, DoSetCdrCode1IM, /* #o0146 */ + DoSetCdrCode2FP, DoSetCdrCode2LP, DoSetCdrCode2SP, DoSetCdrCode2IM, /* #o0147 */ + DoPushAddressFP, DoPushAddressLP, DoPushAddressSP, DoPushAddressIM, /* #o0150 */ + DoSetSpToAddressFP, DoSetSpToAddressLP, DoSetSpToAddressSP, DoSetSpToAddressIM, /* #o0151 */ + DoSetSpToAddressSaveTosFP, DoSetSpToAddressSaveTosLP, DoSetSpToAddressSaveTosSP, DoSetSpToAddressSaveTosIM, /* #o0152 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0153 */ + DoReadInternalRegisterFP, DoReadInternalRegisterLP, DoReadInternalRegisterSP, DoReadInternalRegisterIM, /* #o0154 */ + DoWriteInternalRegisterFP, DoWriteInternalRegisterLP, DoWriteInternalRegisterSP, DoWriteInternalRegisterIM, /* #o0155 */ + DoCoprocessorReadFP, DoCoprocessorReadLP, DoCoprocessorReadSP, DoCoprocessorReadIM, /* #o0156 */ + DoCoprocessorWriteFP, DoCoprocessorWriteLP, DoCoprocessorWriteSP, DoCoprocessorWriteIM, /* #o0157 */ + DoBlock0ReadAluFP, DoBlock0ReadAluLP, DoBlock0ReadAluSP, DoBlock0ReadAluIM, /* #o0160 */ + DoBlock1ReadAluFP, DoBlock1ReadAluLP, DoBlock1ReadAluSP, DoBlock1ReadAluIM, /* #o0161 */ + DoBlock2ReadAluFP, DoBlock2ReadAluLP, DoBlock2ReadAluSP, DoBlock2ReadAluIM, /* #o0162 */ + DoBlock3ReadAluFP, DoBlock3ReadAluLP, DoBlock3ReadAluSP, DoBlock3ReadAluIM, /* #o0163 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0164 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0165 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0166 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0167 */ + DoLdbFP, DoLdbLP, DoLdbSP, DoLdbIM, /* #o0170 */ + DoCharLdbFP, DoCharLdbLP, DoCharLdbSP, DoCharLdbIM, /* #o0171 */ + DoPLdbFP, DoPLdbLP, DoPLdbSP, DoPLdbIM, /* #o0172 */ + DoPTagLdbFP, DoPTagLdbLP, DoPTagLdbSP, DoPTagLdbIM, /* #o0173 */ + DoBranchFP, DoBranchLP, DoBranchSP, DoBranchIM, /* #o0174 */ + DoLoopDecrementTosFP, DoLoopDecrementTosLP, DoLoopDecrementTosSP, DoLoopDecrementTosIM, /* #o0175 */ + DoEntryRestAcceptedFP, DoEntryRestAcceptedLP, DoEntryRestAcceptedSP, DoEntryRestAcceptedIM, /* #o0176 */ + DoEntryRestNotAcceptedFP, DoEntryRestNotAcceptedLP, DoEntryRestNotAcceptedSP, DoEntryRestNotAcceptedIM, /* #o0177 */ + DoRplacaFP, DoRplacaLP, DoRplacaSP, DoRplacaIM, /* #o0200 */ + DoRplacdFP, DoRplacdLP, DoRplacdSP, DoRplacdIM, /* #o0201 */ + DoMultiplyFP, DoMultiplyLP, DoMultiplySP, DoMultiplyIM, /* #o0202 */ + DoQuotientFP, DoQuotientLP, DoQuotientSP, DoQuotientIM, /* #o0203 */ + DoCeilingFP, DoCeilingLP, DoCeilingSP, DoCeilingIM, /* #o0204 */ + DoFloorFP, DoFloorLP, DoFloorSP, DoFloorIM, /* #o0205 */ + DoTruncateFP, DoTruncateLP, DoTruncateSP, DoTruncateIM, /* #o0206 */ + DoRoundFP, DoRoundLP, DoRoundSP, DoRoundIM, /* #o0207 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /* #o0210 +++ Use for DoRemainder */ + DoRationalQuotientFP, DoRationalQuotientLP, DoRationalQuotientSP, DoRationalQuotientIM, /* #o0211 */ + DoMinFP, DoMinLP, DoMinSP, DoMinIM, /* #o0212 */ + DoMaxFP, DoMaxLP, DoMaxSP, DoMaxIM, /* #o0213 */ + DoAluFP, DoAluLP, DoAluSP, DoAluIM, /* #o0214 */ + DoLogandFP, DoLogandLP, DoLogandSP, DoLogandIM, /* #o0215 */ + DoLogxorFP, DoLogxorLP, DoLogxorSP, DoLogxorIM, /* #o0216 */ + DoLogiorFP, DoLogiorLP, DoLogiorSP, DoLogiorIM, /* #o0217 */ + DoRotFP, DoRotLP, DoRotSP, DoRotIM, /* #o0220 */ + DoLshFP, DoLshLP, DoLshSP, DoLshIM, /* #o0221 */ + DoMultiplyDoubleFP, DoMultiplyDoubleLP, DoMultiplyDoubleSP, DoMultiplyDoubleIM, /* #o0222 */ + DoLshcBignumStepFP, DoLshcBignumStepLP, DoLshcBignumStepSP, DoLshcBignumStepIM, /* #o0223 */ + DoStackBltFP, DoStackBltLP, DoStackBltSP, DoStackBltIM, /* #o0224 */ + DoRgetfFP, DoRgetfLP, DoRgetfSP, DoRgetfIM, /* #o0225 */ + DoMemberFP, DoMemberLP, DoMemberSP, DoMemberIM, /* #o0226 */ + DoAssocFP, DoAssocLP, DoAssocSP, DoAssocIM, /* #o0227 */ + DoPointerPlusFP, DoPointerPlusLP, DoPointerPlusSP, DoPointerPlusIM, /* #o0230 */ + DoPointerDifferenceFP, DoPointerDifferenceLP, DoPointerDifferenceSP, DoPointerDifferenceIM, /* #o0231 */ + DoAshFP, DoAshLP, DoAshSP, DoAshIM, /* #o0232 */ + DoStoreConditionalFP, DoStoreConditionalLP, DoStoreConditionalSP, DoStoreConditionalIM, /* #o0233 */ + DoMemoryWriteFP, DoMemoryWriteLP, DoMemoryWriteSP, DoMemoryWriteIM, /* #o0234 */ + DoPStoreContentsFP, DoPStoreContentsLP, DoPStoreContentsSP, DoPStoreContentsIM, /* #o0235 */ + DoBindLocativeToValueFP, DoBindLocativeToValueLP, DoBindLocativeToValueSP, DoBindLocativeToValueIM, /* #o0236 */ + DoUnifyFP, DoUnifyLP, DoUnifySP, DoUnifyIM, /* #o0237 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0240 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0241 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0242 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0243 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0244 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0245 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0246 */ + DoPopLexicalVarNFP, DoPopLexicalVarNLP, DoPopLexicalVarNSP, DoPopLexicalVarNIM, /* #o0247 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0250 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0251 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0252 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0253 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0254 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0255 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0256 */ + DoMovemLexicalVarNFP, DoMovemLexicalVarNLP, DoMovemLexicalVarNSP, DoMovemLexicalVarNIM, /* #o0257 */ + DoEqualNumberFP, DoEqualNumberLP, DoEqualNumberSP, DoEqualNumberIM, /* #o0260 */ + DoLesspFP, DoLesspLP, DoLesspSP, DoLesspIM, /* #o0261 */ + DoGreaterpFP, DoGreaterpLP, DoGreaterpSP, DoGreaterpIM, /* #o0262 */ + DoEqlFP, DoEqlLP, DoEqlSP, DoEqlIM, /* #o0263 */ + DoEqualNumberFP, DoEqualNumberLP, DoEqualNumberSP, DoEqualNumberIM, /* #o0264 */ + DoLesspFP, DoLesspLP, DoLesspSP, DoLesspIM, /* #o0265 */ + DoGreaterpFP, DoGreaterpLP, DoGreaterpSP, DoGreaterpIM, /* #o0266 */ + DoEqlFP, DoEqlLP, DoEqlSP, DoEqlIM, /* #o0267 */ + DoEqFP, DoEqLP, DoEqSP, DoEqIM, /* #o0270 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /* #o0271 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /* #o0272 */ + DoLogtestFP, DoLogtestLP, DoLogtestSP, DoLogtestIM, /* #o0273 */ + DoEqFP, DoEqLP, DoEqSP, DoEqIM, /* #o0274 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /* #o0275 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /* #o0276 */ + DoLogtestFP, DoLogtestLP, DoLogtestSP, DoLogtestIM, /* #o0277 */ + DoAddFP, DoAddLP, DoAddSP, DoAddIM, /* #o0300 */ + DoSubFP, DoSubLP, DoSubSP, DoSubIM, /* #o0301 */ + Do32BitPlusFP, Do32BitPlusLP, Do32BitPlusSP, Do32BitPlusIM, /* #o0302 */ + Do32BitDifferenceFP, Do32BitDifferenceLP, Do32BitDifferenceSP, Do32BitDifferenceIM, /* #o0303 */ + DoAddBignumStepFP, DoAddBignumStepLP, DoAddBignumStepSP, DoAddBignumStepIM, /* #o0304 */ + DoSubBignumStepFP, DoSubBignumStepLP, DoSubBignumStepSP, DoSubBignumStepIM, /* #o0305 */ + DoMultiplyBignumStepFP, DoMultiplyBignumStepLP, DoMultiplyBignumStepSP, DoMultiplyBignumStepIM, /* #o0306 */ + DoDivideBignumStepFP, DoDivideBignumStepLP, DoDivideBignumStepSP, DoDivideBignumStepIM, /* #o0307 */ + DoAset1FP, DoAset1LP, DoAset1SP, DoAset1IM, /* #o0310 */ + DoAllocateListBlockFP, DoAllocateListBlockLP, DoAllocateListBlockSP, DoAllocateListBlockIM, /* #o0311 */ + DoAref1FP, DoAref1LP, DoAref1SP, DoAref1IM, /* #o0312 */ + DoAloc1FP, DoAloc1LP, DoAloc1SP, DoAloc1IM, /* #o0313 */ + DoStoreArrayLeaderFP, DoStoreArrayLeaderLP, DoStoreArrayLeaderSP, DoStoreArrayLeaderIM, /* #o0314 */ + DoAllocateStructureBlockFP, DoAllocateStructureBlockLP, DoAllocateStructureBlockSP, DoAllocateStructureBlockIM, /* #o0315 */ + DoArrayLeaderFP, DoArrayLeaderLP, DoArrayLeaderSP, DoArrayLeaderIM, /* #o0316 */ + DoAlocLeaderFP, DoAlocLeaderLP, DoAlocLeaderSP, DoAlocLeaderIM, /* #o0317 */ + DoPopInstanceVariableFP, DoPopInstanceVariableLP, DoPopInstanceVariableSP, DoPopInstanceVariableIM, /* #o0320 */ + DoMovemInstanceVariableFP, DoMovemInstanceVariableLP, DoMovemInstanceVariableSP, DoMovemInstanceVariableIM, /* #o0321 */ + DoPopInstanceVariableOrderedFP, DoPopInstanceVariableOrderedLP, DoPopInstanceVariableOrderedSP, DoPopInstanceVariableOrderedIM, /* #o0322 */ + DoMovemInstanceVariableOrderedFP, DoMovemInstanceVariableOrderedLP, DoMovemInstanceVariableOrderedSP, DoMovemInstanceVariableOrderedIM, /* #o0323 */ + DoInstanceRefFP, DoInstanceRefLP, DoInstanceRefSP, DoInstanceRefIM, /* #o0324 */ + DoInstanceSetFP, DoInstanceSetLP, DoInstanceSetSP, DoInstanceSetIM, /* #o0325 */ + DoInstanceLocFP, DoInstanceLocLP, DoInstanceLocSP, DoInstanceLocIM, /* #o0326 */ + DoSetTagFP, DoSetTagLP, DoSetTagSP, DoSetTagIM, /* #o0327 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0330 */ + DoUnsignedLesspFP, DoUnsignedLesspLP, DoUnsignedLesspSP, DoUnsignedLesspIM, /* #o0331 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0332 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0333 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0334 */ + DoUnsignedLesspFP, DoUnsignedLesspLP, DoUnsignedLesspSP, DoUnsignedLesspIM, /* #o0335 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0336 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0337 */ + DoPopFP, DoPopLP, DoPopSP, DoPopIM, /* #o0340 */ + DoMovemFP, DoMovemLP, DoMovemSP, DoMovemIM, /* #o0341 */ + DoMergeCdrNoPopFP, DoMergeCdrNoPopLP, DoMergeCdrNoPopSP, DoMergeCdrNoPopIM, /* #o0342 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0343 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0344 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0345 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0346 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0347 */ + DoFastAref1FP, DoFastAref1LP, DoFastAref1SP, DoFastAref1IM, /* #o0350 */ + DoFastAset1FP, DoFastAset1LP, DoFastAset1SP, DoFastAset1IM, /* #o0351 */ + DoStackBltAddressFP, DoStackBltAddressLP, DoStackBltAddressSP, DoStackBltAddressIM, /* #o0352 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0353 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0354 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0355 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0356 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0357 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0360 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0361 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0362 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0363 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0364 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0365 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0366 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0367 */ + DoDpbFP, DoDpbLP, DoDpbSP, DoDpbIM, /* #o0370 */ + DoCharDpbFP, DoCharDpbLP, DoCharDpbSP, DoCharDpbIM, /* #o0371 */ + DoPDpbFP, DoPDpbLP, DoPDpbSP, DoPDpbIM, /* #o0372 */ + DoPTagDpbFP, DoPTagDpbLP, DoPTagDpbSP, DoPTagDpbIM, /* #o0373 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0374 */ + DoLoopIncrementTosLessThanFP, DoLoopIncrementTosLessThanLP, DoLoopIncrementTosLessThanSP, DoLoopIncrementTosLessThanIM, /* #o0375 */ + DoCatchOpenFP, DoCatchOpenLP, DoCatchOpenSP, DoCatchOpenIM, /* #o0376 */ + DoSpareOpFP, DoSpareOpLP, DoSpareOpSP, DoSpareOpIM, /*#o0377 */ +}; +#endif + +DISPATCHTABLE(fullworddispatch,48) +#ifdef DEBUGICACHE + ; +#else + = { + nullfw, /* #o00 = DTP-NULL */ + monitorforwardfw, /* #o01 = DTP-MONITOR-FORWARD */ + headerpfw, /* #o02 = DTP-HEADER-P */ + headerifw, /* #o03 = DTP-HEADER-I */ + valuecell, /* #o04 = DTP-EXTERNAL-VALUE-CELL-POINTER */ + oneqforwardfw, /* #o05 = DTP-ONE-Q-FORWARD */ + headerforwardfw, /* #o06 = DTP-HEADER-FORWARD */ + elementforwardfw, /* #o07 = DTP-ELEMENT-FORWARD */ + pushconstantvalue, /* #o10 = DTP-FIXNUM */ + pushconstantvalue, /* #o11 = DTP-SMALL-RATIO */ + pushconstantvalue, /* #o12 = DTP-SINGLE-FLOAT */ + pushconstantvalue, /* #o13 = DTP-DOUBLE-FLOAT */ + pushconstantvalue, /* #o14 = DTP-BIGNUM */ + pushconstantvalue, /* #o15 = DTP-BIG-RATIO */ + pushconstantvalue, /* #o16 = DTP-COMPLEX */ + pushconstantvalue, /* #o17 = DTP-SPARE-NUMBER */ + pushconstantvalue, /* #o20 = DTP-INSTANCE */ + pushconstantvalue, /* #o21 = DTP-LIST-INSTANCE */ + pushconstantvalue, /* #o22 = DTP-ARRAY-INSTANCE */ + pushconstantvalue, /* #o23 = DTP-STRING-INSTANCE */ + pushconstantvalue, /* #o24 = DTP-NIL */ + pushconstantvalue, /* #o25 = DTP-LIST */ + pushconstantvalue, /* #o26 = DTP-ARRAY */ + pushconstantvalue, /* #o27 = DTP-STRING */ + pushconstantvalue, /* #o30 = DTP-SYMBOL */ + pushconstantvalue, /* #o31 = DTP-LOCATIVE */ + pushconstantvalue, /* #o32 = DTP-LEXICAL-CLOSURE */ + pushconstantvalue, /* #o33 = DTP-DYNAMIC-CLOSURE */ + pushconstantvalue, /* #o34 = DTP-COMPILED-FUNCTION */ + pushconstantvalue, /* #o35 = DTP-GENERIC-FUNCTION */ + pushconstantvalue, /* #o36 = DTP-SPARE-POINTER-1 */ + pushconstantvalue, /* #o37 = DTP-SPARE-POINTER-2 */ + pushconstantvalue, /* #o40 = DTP-PHYSICAL-ADDRESS */ + nativeinstruction, /* #o41 = DTP-SPARE-IMMEDIATE-1 *Hijacked for nativeinstruction **/ + boundlocationfw, /* #o42 = DTP-BOUND-LOCATION */ + pushconstantvalue, /* #o43 = DTP-CHARACTER */ + logicvariablefw, /* #o44 = DTP-LOGIC-VARIABLE */ + gcforwardfw, /* #o45 = DTP-GC-FORWARD */ + pushconstantvalue, /* #o46 = DTP-EVEN-PC */ + pushconstantvalue, /* #o47 = DTP-ODD-PC */ + callcompiledeven, /* #o50 = DTP-CALL-COMPILED-EVEN */ + callcompiledodd, /* #o51 = DTP-CALL-COMPILED-ODD */ + callindirect, /* #o52 = DTP-CALL-INDIRECT */ + callgeneric, /* #o53 = DTP-CALL-GENERIC */ + callcompiledevenprefetch, /* #o54 = DTP-CALL-COMPILED-EVEN-PREFETCH */ + callcompiledoddprefetch, /* #o55 = DTP-CALL-COMPILED-ODD-PREFETCH */ + callindirectprefetch, /* #o56 = DTP-CALL-INDIRECT-PREFETCH */ + callgenericprefetch /* #o57 = DTP-CALL-GENERIC-PREFETCH */ +}; +#endif + +DISPATCHTABLE(internalregisterread1,43) + = { + ReadRegisterError, /* ReadRegisterEA */ + ReadRegisterFP, + ReadRegisterLP, + ReadRegisterSP, + ReadRegisterError, /* ReadRegisterMacroSP */ + ReadRegisterStackCacheLowerBound, + ReadRegisterBARx, + ReadRegisterError, /* ReadRegisterPHTHashx */ + ReadRegisterError, /* ReadRegisterEPC */ + ReadRegisterError, /* ReadRegisterDPC */ + ReadRegisterContinuation, + ReadRegisterAluAndRotateControl, + ReadRegisterControlRegister, + ReadRegisterCRArgumentSize, + ReadRegisterEphemeralOldspaceRegister, + ReadRegisterZoneOldspaceRegister, + ReadRegisterChipRevision, + ReadRegisterFPCoprocessorPresent, + ReadRegisterError, + ReadRegisterPreemptRegister, + ReadRegisterIcacheControl, + ReadRegisterPrefetcherControl, + ReadRegisterMapCacheControl, + ReadRegisterMemoryControl, + ReadRegisterError, /* ReadRegisterECCLog */ + ReadRegisterError, /* ReadRegisterECCLogAddress */ + ReadRegisterError, /* ReadRegisterInvalidateMapx */ + ReadRegisterError, /* ReadRegisterLoadMapx */ + ReadRegisterStackCacheOverflowLimit, + ReadRegisterError, /* ReadRegisterUcodeROMContents */ + ReadRegisterError, + ReadRegisterError, /* ReadRegisterAddressMask */ + ReadRegisterError, /* ReadRegisterEntryMaximumArguments */ + ReadRegisterError, /* ReadRegisterLexicalVariable */ + ReadRegisterError, /* ReadRegisterInstruction */ + ReadRegisterError, + ReadRegisterError, /* ReadRegisterMemoryData */ + ReadRegisterError, /* ReadRegisterDataPins */ + ReadRegisterError, /* ReadRegisterExtensionRegister */ + ReadRegisterMicrosecondClock, + ReadRegisterError, /* ReadRegisterArrayHeaderLength */ + ReadRegisterError, + ReadRegisterError /* ReadRegisterLoadBAR */ +}; + +DISPATCHTABLE(internalregisterread2,34) + = { + ReadRegisterTOS, + ReadRegisterEventCount, + ReadRegisterBindingStackPointer, + ReadRegisterCatchBlockList, + ReadRegisterControlStackLimit, + ReadRegisterControlStackExtraLimit, + ReadRegisterBindingStackLimit, + ReadRegisterPHTBase, + ReadRegisterPHTMask, + ReadRegisterCountMapReloads, + ReadRegisterListCacheArea, + ReadRegisterListCacheAddress, + ReadRegisterListCacheLength, + ReadRegisterStructureCacheArea, + ReadRegisterStructureCacheAddress, + ReadRegisterStructureCacheLength, + ReadRegisterDynamicBindingCacheBase, + ReadRegisterDynamicBindingCacheMask, + ReadRegisterChoicePointer, + ReadRegisterStructureStackChoicePointer, + ReadRegisterFEPModeTrapVectorAddress, + ReadRegisterError, + ReadRegisterError, /* ReadRegisterMappingTableCache */ + ReadRegisterError, /* ReadRegisterMappingTableLength */ + ReadRegisterStackFrameMaximumSize, + ReadRegisterStackCacheDumpQuantum, + ReadRegisterError, + ReadRegisterError, + ReadRegisterError, + ReadRegisterError, + ReadRegisterError, + ReadRegisterError, + ReadRegisterConstantNIL, + ReadRegisterConstantT +}; + +DISPATCHTABLE(internalregisterwrite1,43) + = { + WriteRegisterError, /* WriteRegisterEA */ + WriteRegisterFP, + WriteRegisterLP, + WriteRegisterSP, + WriteRegisterError, /* WriteRegisterMacroSP */ + WriteRegisterStackCacheLowerBound, + WriteRegisterBARx, + WriteRegisterError, /* WriteRegisterPHTHashx */ + WriteRegisterError, /* WriteRegisterEPC */ + WriteRegisterError, /* WriteRegisterDPC */ + WriteRegisterContinuation, + WriteRegisterAluAndRotateControl, + WriteRegisterControlRegister, + WriteRegisterError, /* WriteRegisterCRArgumentSize */ + WriteRegisterEphemeralOldspaceRegister, + WriteRegisterZoneOldspaceRegister, + WriteRegisterError, /* WriteRegisterChipRevision */ + WriteRegisterFPCoprocessorPresent, + WriteRegisterError, + WriteRegisterPreemptRegister, + WriteRegisterError, /* WriteRegisterIcacheControl */ + WriteRegisterError, /* WriteRegisterPrefetcherControl */ + WriteRegisterError, /* WriteRegisterMapCacheControl */ + WriteRegisterError, /* WriteRegisterMemoryControl */ + WriteRegisterError, /* WriteRegisterECCLog */ + WriteRegisterError, /* WriteRegisterECCLogAddress */ + WriteRegisterError, /* WriteRegisterInvalidateMapx */ + WriteRegisterError, /* WriteRegisterLoadMapx */ + WriteRegisterStackCacheOverflowLimit, + WriteRegisterError, /* WriteRegisterUcodeROMContents */ + WriteRegisterError, + WriteRegisterError, /* WriteRegisterAddressMask */ + WriteRegisterError, /* WriteRegisterEntryMaximumArguments */ + WriteRegisterError, /* WriteRegisterLexicalVariable */ + WriteRegisterError, /* WriteRegisterInstruction */ + WriteRegisterError, + WriteRegisterError, /* WriteRegisterMemoryData */ + WriteRegisterError, /* WriteRegisterDataPins */ + WriteRegisterError, /* WriteRegisterExtensionRegister */ + WriteRegisterError, /* WriteRegisterMicrosecondClock */ + WriteRegisterError, /* WriteRegisterArrayHeaderLength */ + WriteRegisterError, + WriteRegisterError /* WriteRegisterLoadBAR */ +}; + +DISPATCHTABLE(internalregisterwrite2,34) + = { + WriteRegisterTOS, + WriteRegisterEventCount, + WriteRegisterBindingStackPointer, + WriteRegisterCatchBlockList, + WriteRegisterControlStackLimit, + WriteRegisterControlStackExtraLimit, + WriteRegisterBindingStackLimit, + WriteRegisterError, /* WriteRegisterPHTBase */ + WriteRegisterError, /* WriteRegisterPHTMask */ + WriteRegisterError, /* WriteRegisterCountMapReloads */ + WriteRegisterListCacheArea, + WriteRegisterListCacheAddress, + WriteRegisterListCacheLength, + WriteRegisterStructureCacheArea, + WriteRegisterStructureCacheAddress, + WriteRegisterStructureCacheLength, + WriteRegisterDynamicBindingCacheBase, + WriteRegisterDynamicBindingCacheMask, + WriteRegisterChoicePointer, + WriteRegisterStructureStackChoicePointer, + WriteRegisterFEPModeTrapVectorAddress, + WriteRegisterError, + WriteRegisterMappingTableCache, + WriteRegisterError, /* WriteRegisterMappingTableLength */ + WriteRegisterError, /* WriteRegisterStackFrameMaximumSize */ + WriteRegisterError, /* WriteRegisterStackCacheDumpQuantum */ + WriteRegisterError, + WriteRegisterError, + WriteRegisterError, + WriteRegisterError, + WriteRegisterError, + WriteRegisterError, + WriteRegisterError, /* WriteRegisterConstantNIL */ + WriteRegisterError /* WriteRegisterConstant */ +}; + +#ifdef STATISTICS +static char *halfwordnames [256*4] + = { + "DoCarFP", "DoCarLP", "DoCarSP", "DoCarIM", /* #o00 */ + "DoCdrFP", "DoCdrLP", "DoCdrSP", "DoCdrIM", /* #o01 */ + "DoEndpFP", "DoEndpLP", "DoEndpSP", "DoEndpIM", /* #o02 */ + "DoSetup1DArrayFP", "DoSetup1DArrayLP", "DoSetup1DArraySP", "DoSetup1DArrayIM", /* #o03 */ + "DoSetupForce1DArrayFP", "DoSetupForce1DArrayLP", "DoSetupForce1DArraySP", "DoSetupForce1DArrayIM", /* #o04 */ + "DoBindLocativeFP", "DoBindLocativeLP", "DoBindLocativeSP", "DoBindLocativeIM", /* #o05 */ + "DoRestoreBindingStackFP", "DoRestoreBindingStackLP", "DoRestoreBindingStackSP", "DoRestoreBindingStackIM", /* #o06 */ + "DoEphemeralpFP", "DoEphemeralpLP", "DoEphemeralpSP", "DoEphemeralpIM", /* #o07 */ + "DoStartCallFP", "DoStartCallLP", "DoStartCallSP", "DoStartCallIM", /* #o010 */ + "DoJumpFP", "DoJumpLP", "DoJumpSP", "DoJumpIM", /* #o011 */ + "DoTagFP", "DoTagLP", "DoTagSP", "DoTagIM", /* #o012 */ + "DoDereferenceFP", "DoDereferenceLP", "DoDereferenceSP", "DoDereferenceIM", /* #o013 */ + "DoLogicTailTestFP", "DoLogicTailTestLP", "DoLogicTailTestSP", "DoLogicTailTestIM", /* #o014 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /* #o015 +++ Used for breakpoints!!! */ + "DoDoubleFloatOpFP", "DoDoubleFloatOpLP", "DoDoubleFloatOpSP", "DoDoubleFloatOpIM", /* #o016 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /* #o017 */ + "DoPushLexicalVar0FP", "DoPushLexicalVar0LP", "DoPushLexicalVar0SP", "DoPushLexicalVar0IM", /* #o020 */ + "DoPushLexicalVar1FP", "DoPushLexicalVar1LP", "DoPushLexicalVar1SP", "DoPushLexicalVar1IM", /* #o021 */ + "DoPushLexicalVar2FP", "DoPushLexicalVar2LP", "DoPushLexicalVar2SP", "DoPushLexicalVar2IM", /* #o022 */ + "DoPushLexicalVar3FP", "DoPushLexicalVar3LP", "DoPushLexicalVar3SP", "DoPushLexicalVar3IM", /* #o023 */ + "DoPushLexicalVar4FP", "DoPushLexicalVar4LP", "DoPushLexicalVar4SP", "DoPushLexicalVar4IM", /* #o024 */ + "DoPushLexicalVar5FP", "DoPushLexicalVar5LP", "DoPushLexicalVar5SP", "DoPushLexicalVar5IM", /* #o025 */ + "DoPushLexicalVar6FP", "DoPushLexicalVar6LP", "DoPushLexicalVar6SP", "DoPushLexicalVar6IM", /* #o026 */ + "DoPushLexicalVar7FP", "DoPushLexicalVar7LP", "DoPushLexicalVar7SP", "DoPushLexicalVar7IM", /* #o027 */ + "DoBlock0WriteFP", "DoBlock0WriteLP", "DoBlock0WriteSP", "DoBlock0WriteIM", /* #o030 */ + "DoBlock1WriteFP", "DoBlock1WriteLP", "DoBlock1WriteSP", "DoBlock1WriteIM", /* #o031 */ + "DoBlock2WriteFP", "DoBlock2WriteLP", "DoBlock2WriteSP", "DoBlock2WriteIM", /* #o032 */ + "DoBlock3WriteFP", "DoBlock3WriteLP", "DoBlock3WriteSP", "DoBlock3WriteIM", /* #o033 */ + "DoZeropFP", "DoZeropLP", "DoZeropSP", "DoZeropIM", /* #o034 */ + "DoMinuspFP", "DoMinuspLP", "DoMinuspSP", "DoMinuspIM", /* #o035 */ + "DoPluspFP", "DoPluspLP", "DoPluspSP", "DoPluspIM", /* #o036 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o037 */ + "DoTypeMember0FP", "DoTypeMember0LP", "DoTypeMember0SP", "DoTypeMember0IM", /* #o040 */ + "DoTypeMember1FP", "DoTypeMember1LP", "DoTypeMember1SP", "DoTypeMember1IM", /* #o041 */ + "DoTypeMember2FP", "DoTypeMember2LP", "DoTypeMember2SP", "DoTypeMember2IM", /* #o042 */ + "DoTypeMember3FP", "DoTypeMember3LP", "DoTypeMember3SP", "DoTypeMember3IM", /* #o043 */ + "DoTypeMemberNoPop0FP", "DoTypeMemberNoPop0LP", "DoTypeMemberNoPop0SP", "DoTypeMemberNoPop0IM", /* #o044 */ + "DoTypeMemberNoPop1FP", "DoTypeMemberNoPop1LP", "DoTypeMemberNoPop1SP", "DoTypeMemberNoPop1IM", /* #o045 */ + "DoTypeMemberNoPop2FP", "DoTypeMemberNoPop2LP", "DoTypeMemberNoPop2SP", "DoTypeMemberNoPop2IM", /* #o046 */ + "DoTypeMemberNoPop3FP", "DoTypeMemberNoPop3LP", "DoTypeMemberNoPop3SP", "DoTypeMemberNoPop3IM", /* #o047 */ + "DoLocateLocalsFP", "DoLocateLocalsLP", "DoLocateLocalsSP", "DoLocateLocalsIM", /* #o050 */ + "DoCatchCloseFP", "DoCatchCloseLP", "DoCatchCloseSP", "DoCatchCloseIM", /* #o051 */ + "DoGenericDispatchFP", "DoGenericDispatchLP", "DoGenericDispatchSP", "DoGenericDispatchIM", /* #o052 */ + "DoMessageDispatchFP", "DoMessageDispatchLP", "DoMessageDispatchSP", "DoMessageDispatchIM", /* #o053 */ + "DoCheckPreemptRequestFP", "DoCheckPreemptRequestLP", "DoCheckPreemptRequestSP", "DoCheckPreemptRequestIM", /* #o054 */ + "DoPushGlobalLogicVariableFP", "DoPushGlobalLogicVariableLP", "DoPushGlobalLogicVariableSP", "DoPushGlobalLogicVariableIM", /* #o055 */ + "DoNoOpFP", "DoNoOpLP", "DoNoOpSP", "DoNoOpIM", /* #o056 */ + "DoHaltFP", "DoHaltLP", "DoHaltSP", "DoHaltIM", /* #o057 */ + "DoBranchTrueFP", "DoBranchTrueLP", "DoBranchTrueSP", "DoBranchTrueIM", /* #o060 */ + "DoBranchTrueElseExtraPopFP", "DoBranchTrueElseExtraPopLP", "DoBranchTrueElseExtraPopSP", "DoBranchTrueElseExtraPopIM", /* #o061 */ + "DoBranchTrueAndExtraPopFP", "DoBranchTrueAndExtraPopLP", "DoBranchTrueAndExtraPopSP", "DoBranchTrueAndExtraPopIM", /* #o062 */ + "DoBranchTrueExtraPopFP", "DoBranchTrueExtraPopLP", "DoBranchTrueExtraPopSP", "DoBranchTrueExtraPopIM", /* #o063 */ + "DoBranchTrueNoPopFP", "DoBranchTrueNoPopLP", "DoBranchTrueNoPopSP", "DoBranchTrueNoPopIM", /* #o064 */ + "DoBranchTrueAndNoPopFP", "DoBranchTrueAndNoPopLP", "DoBranchTrueAndNoPopSP", "DoBranchTrueAndNoPopIM", /* #o065 */ + "DoBranchTrueElseNoPopFP", "DoBranchTrueElseNoPopLP", "DoBranchTrueElseNoPopSP", "DoBranchTrueElseNoPopIM", /* #o066 */ + "DoBranchTrueAndNoPopElseNoPopExtraPopFP", "DoBranchTrueAndNoPopElseNoPopExtraPopLP", "DoBranchTrueAndNoPopElseNoPopExtraPopSP", "DoBranchTrueAndNoPopElseNoPopExtraPopIM", /* #o067 */ + "DoBranchFalseFP", "DoBranchFalseLP", "DoBranchFalseSP", "DoBranchFalseIM", /* #o070 */ + "DoBranchFalseElseExtraPopFP", "DoBranchFalseElseExtraPopLP", "DoBranchFalseElseExtraPopSP", "DoBranchFalseElseExtraPopIM", /* #o071 */ + "DoBranchFalseAndExtraPopFP", "DoBranchFalseAndExtraPopLP", "DoBranchFalseAndExtraPopSP", "DoBranchFalseAndExtraPopIM", /* #o072 */ + "DoBranchFalseExtraPopFP", "DoBranchFalseExtraPopLP", "DoBranchFalseExtraPopSP", "DoBranchFalseExtraPopIM", /* #o073 */ + "DoBranchFalseNoPopFP", "DoBranchFalseNoPopLP", "DoBranchFalseNoPopSP", "DoBranchFalseNoPopIM", /* #o074 */ + "DoBranchFalseAndNoPopFP", "DoBranchFalseAndNoPopLP", "DoBranchFalseAndNoPopSP", "DoBranchFalseAndNoPopIM", /* #o075 */ + "DoBranchFalseElseNoPopFP", "DoBranchFalseElseNoPopLP", "DoBranchFalseElseNoPopSP", "DoBranchFalseElseNoPopIM", /* #o076 */ + "DoBranchFalseAndNoPopElseNoPopExtraPopFP", "DoBranchFalseAndNoPopElseNoPopExtraPopLP", "DoBranchFalseAndNoPopElseNoPopExtraPopSP", "DoBranchFalseAndNoPopElseNoPopExtraPopIM", /* #o077 */ + "DoPushFP", "DoPushLP", "DoPushSP", "DoPushIM", /* #o0100 */ + "DoPushNNilsFP", "DoPushNNilsLP", "DoPushNNilsSP", "DoPushNNilsIM", /* #o0101 */ + "DoPushAddressSpRelativeFP", "DoPushAddressSpRelativeLP", "DoPushAddressSpRelativeSP", "DoPushAddressSpRelativeIM", /* #o0102 */ + "DoPushLocalLogicVariablesFP", "DoPushLocalLogicVariablesLP", "DoPushLocalLogicVariablesSP", "DoPushLocalLogicVariablesIM", /* #o0103 */ + "DoReturnMultipleFP", "DoReturnMultipleLP", "DoReturnMultipleSP", "DoReturnMultipleIM", /* #o0104 */ + "DoReturnKludgeFP", "DoReturnKludgeLP", "DoReturnKludgeSP", "DoReturnKludgeIM", /* #o0105 */ + "DoTakeValuesFP", "DoTakeValuesLP", "DoTakeValuesSP", "DoTakeValuesIM", /* #o0106 */ + "DoUnbindNFP", "DoUnbindNLP", "DoUnbindNSP", "DoUnbindNIM", /* #o0107 */ + "DoPushInstanceVariableFP", "DoPushInstanceVariableLP", "DoPushInstanceVariableSP", "DoPushInstanceVariableIM", /* #o0110 */ + "DoPushAddressInstanceVariableFP", "DoPushAddressInstanceVariableLP", "DoPushAddressInstanceVariableSP", "DoPushAddressInstanceVariableIM", /* #o0111 */ + "DoPushInstanceVariableOrderedFP", "DoPushInstanceVariableOrderedLP", "DoPushInstanceVariableOrderedSP", "DoPushInstanceVariableOrderedIM", /* #o0112 */ + "DoPushAddressInstanceVariableOrderedFP", "DoPushAddressInstanceVariableOrderedLP", "DoPushAddressInstanceVariableOrderedSP", "DoPushAddressInstanceVariableOrderedIM", /* #o0113 */ + "DoUnaryMinusFP", "DoUnaryMinusLP", "DoUnaryMinusSP", "DoUnaryMinusIM", /* #o0114 */ + "DoReturnSingleFP", "DoReturnSingleLP", "DoReturnSingleSP", "DoReturnSingleIM", /* #o0115 */ + "DoMemoryReadFP", "DoMemoryReadLP", "DoMemoryReadSP", "DoMemoryReadIM", /* #o0116 */ + "DoMemoryReadAddressFP", "DoMemoryReadAddressLP", "DoMemoryReadAddressSP", "DoMemoryReadAddressIM", /* #o0117 */ + "DoBlock0ReadFP", "DoBlock0ReadLP", "DoBlock0ReadSP", "DoBlock0ReadIM", /* #o0120 */ + "DoBlock1ReadFP", "DoBlock1ReadLP", "DoBlock1ReadSP", "DoBlock1ReadIM", /* #o0121 */ + "DoBlock2ReadFP", "DoBlock2ReadLP", "DoBlock2ReadSP", "DoBlock2ReadIM", /* #o0122 */ + "DoBlock3ReadFP", "DoBlock3ReadLP", "DoBlock3ReadSP", "DoBlock3ReadIM", /* #o0123 */ + "DoBlock0ReadShiftFP", "DoBlock0ReadShiftLP", "DoBlock0ReadShiftSP", "DoBlock0ReadShiftIM", /* #o0124 */ + "DoBlock1ReadShiftFP", "DoBlock1ReadShiftLP", "DoBlock1ReadShiftSP", "DoBlock1ReadShiftIM", /* #o0125 */ + "DoBlock2ReadShiftFP", "DoBlock2ReadShiftLP", "DoBlock2ReadShiftSP", "DoBlock2ReadShiftIM", /* #o0126 */ + "DoBlock3ReadShiftFP", "DoBlock3ReadShiftLP", "DoBlock3ReadShiftSP", "DoBlock3ReadShiftIM", /* #o0127 */ + "DoBlock0ReadTestFP", "DoBlock0ReadTestLP", "DoBlock0ReadTestSP", "DoBlock0ReadTestIM", /* #o0130 */ + "DoBlock1ReadTestFP", "DoBlock1ReadTestLP", "DoBlock1ReadTestSP", "DoBlock1ReadTestIM", /* #o0131 */ + "DoBlock2ReadTestFP", "DoBlock2ReadTestLP", "DoBlock2ReadTestSP", "DoBlock2ReadTestIM", /* #o0132 */ + "DoBlock3ReadTestFP", "DoBlock3ReadTestLP", "DoBlock3ReadTestSP", "DoBlock3ReadTestIM", /* #o0133 */ + "DoFinishCallNFP", "DoFinishCallNLP", "DoFinishCallNSP", "DoFinishCallNIM", /* #o0134 */ + "DoFinishCallNApplyFP", "DoFinishCallNApplyLP", "DoFinishCallNApplySP", "DoFinishCallNApplyIM", /* #o0135 */ + "DoFinishCallTosFP", "DoFinishCallTosLP", "DoFinishCallTosSP", "DoFinishCallTosIM", /* #o0136 */ + "DoFinishCallTosApplyFP", "DoFinishCallTosApplyLP", "DoFinishCallTosApplySP", "DoFinishCallTosApplyIM", /* #o0137 */ + "DoSetToCarFP", "DoSetToCarLP", "DoSetToCarSP", "DoSetToCarIM", /* #o0140 */ + "DoSetToCdrFP", "DoSetToCdrLP", "DoSetToCdrSP", "DoSetToCdrIM", /* #o0141 */ + "DoSetToCdrPushCarFP", "DoSetToCdrPushCarLP", "DoSetToCdrPushCarSP", "DoSetToCdrPushCarIM", /* #o0142 */ + "DoIncrementFP", "DoIncrementLP", "DoIncrementSP", "DoIncrementIM", /* #o0143 */ + "DoDecrementFP", "DoDecrementLP", "DoDecrementSP", "DoDecrementIM", /* #o0144 */ + "DoPointerIncrementFP", "DoPointerIncrementLP", "DoPointerIncrementSP", "DoPointerIncrementIM", /* #o0145 */ + "DoSetCdrCode1FP", "DoSetCdrCode1LP", "DoSetCdrCode1SP", "DoSetCdrCode1IM", /* #o0146 */ + "DoSetCdrCode2FP", "DoSetCdrCode2LP", "DoSetCdrCode2SP", "DoSetCdrCode2IM", /* #o0147 */ + "DoPushAddressFP", "DoPushAddressLP", "DoPushAddressSP", "DoPushAddressIM", /* #o0150 */ + "DoSetSpToAddressFP", "DoSetSpToAddressLP", "DoSetSpToAddressSP", "DoSetSpToAddressIM", /* #o0151 */ + "DoSetSpToAddressSaveTosFP", "DoSetSpToAddressSaveTosLP", "DoSetSpToAddressSaveTosSP", "DoSetSpToAddressSaveTosIM", /* #o0152 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0153 */ + "DoReadInternalRegisterFP", "DoReadInternalRegisterLP", "DoReadInternalRegisterSP", "DoReadInternalRegisterIM", /* #o0154 */ + "DoWriteInternalRegisterFP", "DoWriteInternalRegisterLP", "DoWriteInternalRegisterSP", "DoWriteInternalRegisterIM", /* #o0155 */ + "DoCoprocessorReadFP", "DoCoprocessorReadLP", "DoCoprocessorReadSP", "DoCoprocessorReadIM", /* #o0156 */ + "DoCoprocessorWriteFP", "DoCoprocessorWriteLP", "DoCoprocessorWriteSP", "DoCoprocessorWriteIM", /* #o0157 */ + "DoBlock0ReadAluFP", "DoBlock0ReadAluLP", "DoBlock0ReadAluSP", "DoBlock0ReadAluIM", /* #o0160 */ + "DoBlock1ReadAluFP", "DoBlock1ReadAluLP", "DoBlock1ReadAluSP", "DoBlock1ReadAluIM", /* #o0161 */ + "DoBlock2ReadAluFP", "DoBlock2ReadAluLP", "DoBlock2ReadAluSP", "DoBlock2ReadAluIM", /* #o0162 */ + "DoBlock3ReadAluFP", "DoBlock3ReadAluLP", "DoBlock3ReadAluSP", "DoBlock3ReadAluIM", /* #o0163 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0164 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0165 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0166 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0167 */ + "DoLdbFP", "DoLdbLP", "DoLdbSP", "DoLdbIM", /* #o0170 */ + "DoCharLdbFP", "DoCharLdbLP", "DoCharLdbSP", "DoCharLdbIM", /* #o0171 */ + "DoPLdbFP", "DoPLdbLP", "DoPLdbSP", "DoPLdbIM", /* #o0172 */ + "DoPTagLdbFP", "DoPTagLdbLP", "DoPTagLdbSP", "DoPTagLdbIM", /* #o0173 */ + "DoBranchFP", "DoBranchLP", "DoBranchSP", "DoBranchIM", /* #o0174 */ + "DoLoopDecrementTosFP", "DoLoopDecrementTosLP", "DoLoopDecrementTosSP", "DoLoopDecrementTosIM", /* #o0175 */ + "DoEntryRestAcceptedFP", "DoEntryRestAcceptedLP", "DoEntryRestAcceptedSP", "DoEntryRestAcceptedIM", /* #o0176 */ + "DoEntryRestNotAcceptedFP", "DoEntryRestNotAcceptedLP", "DoEntryRestNotAcceptedSP", "DoEntryRestNotAcceptedIM", /* #o0177 */ + "DoRplacaFP", "DoRplacaLP", "DoRplacaSP", "DoRplacaIM", /* #o0200 */ + "DoRplacdFP", "DoRplacdLP", "DoRplacdSP", "DoRplacdIM", /* #o0201 */ + "DoMultiplyFP", "DoMultiplyLP", "DoMultiplySP", "DoMultiplyIM", /* #o0202 */ + "DoQuotientFP", "DoQuotientLP", "DoQuotientSP", "DoQuotientIM", /* #o0203 */ + "DoCeilingFP", "DoCeilingLP", "DoCeilingSP", "DoCeilingIM", /* #o0204 */ + "DoFloorFP", "DoFloorLP", "DoFloorSP", "DoFloorIM", /* #o0205 */ + "DoTruncateFP", "DoTruncateLP", "DoTruncateSP", "DoTruncateIM", /* #o0206 */ + "DoRoundFP", "DoRoundLP", "DoRoundSP", "DoRoundIM", /* #o0207 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0210 */ + "DoRationalQuotientFP", "DoRationalQuotientLP", "DoRationalQuotientSP", "DoRationalQuotientIM", /* #o0211 */ + "DoMinFP", "DoMinLP", "DoMinSP", "DoMinIM", /* #o0212 */ + "DoMaxFP", "DoMaxLP", "DoMaxSP", "DoMaxIM", /* #o0213 */ + "DoAluFP", "DoAluLP", "DoAluSP", "DoAluIM", /* #o0214 */ + "DoLogandFP", "DoLogandLP", "DoLogandSP", "DoLogandIM", /* #o0215 */ + "DoLogxorFP", "DoLogxorLP", "DoLogxorSP", "DoLogxorIM", /* #o0216 */ + "DoLogiorFP", "DoLogiorLP", "DoLogiorSP", "DoLogiorIM", /* #o0217 */ + "DoRotFP", "DoRotLP", "DoRotSP", "DoRotIM", /* #o0220 */ + "DoLshFP", "DoLshLP", "DoLshSP", "DoLshIM", /* #o0221 */ + "DoMultiplyDoubleFP", "DoMultiplyDoubleLP", "DoMultiplyDoubleSP", "DoMultiplyDoubleIM", /* #o0222 */ + "DoLshcBignumStepFP", "DoLshcBignumStepLP", "DoLshcBignumStepSP", "DoLshcBignumStepIM", /* #o0223 */ + "DoStackBltFP", "DoStackBltLP", "DoStackBltSP", "DoStackBltIM", /* #o0224 */ + "DoRgetfFP", "DoRgetfLP", "DoRgetfSP", "DoRgetfIM", /* #o0225 */ + "DoMemberFP", "DoMemberLP", "DoMemberSP", "DoMemberIM", /* #o0226 */ + "DoAssocFP", "DoAssocLP", "DoAssocSP", "DoAssocIM", /* #o0227 */ + "DoPointerPlusFP", "DoPointerPlusLP", "DoPointerPlusSP", "DoPointerPlusIM", /* #o0230 */ + "DoPointerDifferenceFP", "DoPointerDifferenceLP", "DoPointerDifferenceSP", "DoPointerDifferenceIM", /* #o0231 */ + "DoAshFP", "DoAshLP", "DoAshSP", "DoAshIM", /* #o0232 */ + "DoStoreConditionalFP", "DoStoreConditionalLP", "DoStoreConditionalSP", "DoStoreConditionalIM", /* #o0233 */ + "DoMemoryWriteFP", "DoMemoryWriteLP", "DoMemoryWriteSP", "DoMemoryWriteIM", /* #o0234 */ + "DoPStoreContentsFP", "DoPStoreContentsLP", "DoPStoreContentsSP", "DoPStoreContentsIM", /* #o0235 */ + "DoBindLocativeToValueFP", "DoBindLocativeToValueLP", "DoBindLocativeToValueSP", "DoBindLocativeToValueIM", /* #o0236 */ + "DoUnifyFP", "DoUnifyLP", "DoUnifySP", "DoUnifyIM", /* #o0237 */ + "DoPopLexicalVar0FP", "DoPopLexicalVar0LP", "DoPopLexicalVar0SP", "DoPopLexicalVar0IM", /* #o0240 */ + "DoPopLexicalVar1FP", "DoPopLexicalVar1LP", "DoPopLexicalVar1SP", "DoPopLexicalVar1IM", /* #o0241 */ + "DoPopLexicalVar2FP", "DoPopLexicalVar2LP", "DoPopLexicalVar2SP", "DoPopLexicalVar2IM", /* #o0242 */ + "DoPopLexicalVar3FP", "DoPopLexicalVar3LP", "DoPopLexicalVar3SP", "DoPopLexicalVar3IM", /* #o0243 */ + "DoPopLexicalVar4FP", "DoPopLexicalVar4LP", "DoPopLexicalVar4SP", "DoPopLexicalVar4IM", /* #o0244 */ + "DoPopLexicalVar5FP", "DoPopLexicalVar5LP", "DoPopLexicalVar5SP", "DoPopLexicalVar5IM", /* #o0245 */ + "DoPopLexicalVar6FP", "DoPopLexicalVar6LP", "DoPopLexicalVar6SP", "DoPopLexicalVar6IM", /* #o0246 */ + "DoPopLexicalVar7FP", "DoPopLexicalVar7LP", "DoPopLexicalVar7SP", "DoPopLexicalVar7IM", /* #o0247 */ + "DoMovemLexicalVar0FP", "DoMovemLexicalVar0LP", "DoMovemLexicalVar0SP", "DoMovemLexicalVar0IM", /* #o0250 */ + "DoMovemLexicalVar1FP", "DoMovemLexicalVar1LP", "DoMovemLexicalVar1SP", "DoMovemLexicalVar1IM", /* #o0251 */ + "DoMovemLexicalVar2FP", "DoMovemLexicalVar2LP", "DoMovemLexicalVar2SP", "DoMovemLexicalVar2IM", /* #o0252 */ + "DoMovemLexicalVar3FP", "DoMovemLexicalVar3LP", "DoMovemLexicalVar3SP", "DoMovemLexicalVar3IM", /* #o0253 */ + "DoMovemLexicalVar4FP", "DoMovemLexicalVar4LP", "DoMovemLexicalVar4SP", "DoMovemLexicalVar4IM", /* #o0254 */ + "DoMovemLexicalVar5FP", "DoMovemLexicalVar5LP", "DoMovemLexicalVar5SP", "DoMovemLexicalVar5IM", /* #o0255 */ + "DoMovemLexicalVar6FP", "DoMovemLexicalVar6LP", "DoMovemLexicalVar6SP", "DoMovemLexicalVar6IM", /* #o0256 */ + "DoMovemLexicalVar7FP", "DoMovemLexicalVar7LP", "DoMovemLexicalVar7SP", "DoMovemLexicalVar7IM", /* #o0257 */ + "DoEqualNumberFP", "DoEqualNumberLP", "DoEqualNumberSP", "DoEqualNumberIM", /* #o0260 */ + "DoLesspFP", "DoLesspLP", "DoLesspSP", "DoLesspIM", /* #o0261 */ + "DoGreaterpFP", "DoGreaterpLP", "DoGreaterpSP", "DoGreaterpIM", /* #o0262 */ + "DoEqlFP", "DoEqlLP", "DoEqlSP", "DoEqlIM", /* #o0263 */ + "DoEqualNumberNoPopFP", "DoEqualNumberNoPopLP", "DoEqualNumberNoPopSP", "DoEqualNumberNoPopIM", /* #o0264 */ + "DoLesspNoPopFP", "DoLesspNoPopLP", "DoLesspNoPopSP", "DoLesspNoPopIM", /* #o0265 */ + "DoGreaterpNoPopFP", "DoGreaterpNoPopLP", "DoGreaterpNoPopSP", "DoGreaterpNoPopIM", /* #o0266 */ + "DoEqlNoPopFP", "DoEqlNoPopLP", "DoEqlNoPopSP", "DoEqlNoPopIM", /* #o0267 */ + "DoEqFP", "DoEqLP", "DoEqSP", "DoEqIM", /* #o0270 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0271 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0272 */ + "DoLogtestFP", "DoLogtestLP", "DoLogtestSP", "DoLogtestIM", /* #o0273 */ + "DoEqNoPopFP", "DoEqNoPopLP", "DoEqNoPopSP", "DoEqNoPopIM", /* #o0274 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0275 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0276 */ + "DoLogtestNoPopFP", "DoLogtestNoPopLP", "DoLogtestNoPopSP", "DoLogtestNoPopIM", /* #o0277 */ + "DoAddFP", "DoAddLP", "DoAddSP", "DoAddIM", /* #o0300 */ + "DoSubFP", "DoSubLP", "DoSubSP", "DoSubIM", /* #o0301 */ + "Do32BitPlusFP", "Do32BitPlusLP", "Do32BitPlusSP", "Do32BitPlusIM", /* #o0302 */ + "Do32BitDifferenceFP", "Do32BitDifferenceLP", "Do32BitDifferenceSP", "Do32BitDifferenceIM", /* #o0303 */ + "DoAddBignumStepFP", "DoAddBignumStepLP", "DoAddBignumStepSP", "DoAddBignumStepIM", /* #o0304 */ + "DoSubBignumStepFP", "DoSubBignumStepLP", "DoSubBignumStepSP", "DoSubBignumStepIM", /* #o0305 */ + "DoMultiplyBignumStepFP", "DoMultiplyBignumStepLP", "DoMultiplyBignumStepSP", "DoMultiplyBignumStepIM", /* #o0306 */ + "DoDivideBignumStepFP", "DoDivideBignumStepLP", "DoDivideBignumStepSP", "DoDivideBignumStepIM", /* #o0307 */ + "DoAset1FP", "DoAset1LP", "DoAset1SP", "DoAset1IM", /* #o0310 */ + "DoAllocateListBlockFP", "DoAllocateListBlockLP", "DoAllocateListBlockSP", "DoAllocateListBlockIM", /* #o0311 */ + "DoAref1FP", "DoAref1LP", "DoAref1SP", "DoAref1IM", /* #o0312 */ + "DoAloc1FP", "DoAloc1LP", "DoAloc1SP", "DoAloc1IM", /* #o0313 */ + "DoStoreArrayLeaderFP", "DoStoreArrayLeaderLP", "DoStoreArrayLeaderSP", "DoStoreArrayLeaderIM", /* #o0314 */ + "DoAllocateStructureBlockFP", "DoAllocateStructureBlockLP", "DoAllocateStructureBlockSP", "DoAllocateStructureBlockIM", /* #o0315 */ + "DoArrayLeaderFP", "DoArrayLeaderLP", "DoArrayLeaderSP", "DoArrayLeaderIM", /* #o0316 */ + "DoAlocLeaderFP", "DoAlocLeaderLP", "DoAlocLeaderSP", "DoAlocLeaderIM", /* #o0317 */ + "DoPopInstanceVariableFP", "DoPopInstanceVariableLP", "DoPopInstanceVariableSP", "DoPopInstanceVariableIM", /* #o0320 */ + "DoMovemInstanceVariableFP", "DoMovemInstanceVariableLP", "DoMovemInstanceVariableSP", "DoMovemInstanceVariableIM", /* #o0321 */ + "DoPopInstanceVariableOrderedFP", "DoPopInstanceVariableOrderedLP", "DoPopInstanceVariableOrderedSP", "DoPopInstanceVariableOrderedIM", /* #o0322 */ + "DoMovemInstanceVariableOrderedFP", "DoMovemInstanceVariableOrderedLP", "DoMovemInstanceVariableOrderedSP", "DoMovemInstanceVariableOrderedIM", /* #o0323 */ + "DoInstanceRefFP", "DoInstanceRefLP", "DoInstanceRefSP", "DoInstanceRefIM", /* #o0324 */ + "DoInstanceSetFP", "DoInstanceSetLP", "DoInstanceSetSP", "DoInstanceSetIM", /* #o0325 */ + "DoInstanceLocFP", "DoInstanceLocLP", "DoInstanceLocSP", "DoInstanceLocIM", /* #o0326 */ + "DoSetTagFP", "DoSetTagLP", "DoSetTagSP", "DoSetTagIM", /* #o0327 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0330 */ + "DoUnsignedLesspFP", "DoUnsignedLesspLP", "DoUnsignedLesspSP", "DoUnsignedLesspIM", /* #o0331 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0332 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0333 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0334 */ + "DoUnsignedLesspNoPopFP", "DoUnsignedLesspNoPopLP", "DoUnsignedLesspNoPopSP", "DoUnsignedLesspNoPopIM", /* #o0335 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0336 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0337 */ + "DoPopFP", "DoPopLP", "DoPopSP", "DoPopIM", /* #o0340 */ + "DoMovemFP", "DoMovemLP", "DoMovemSP", "DoMovemIM", /* #o0341 */ + "DoMergeCdrNoPopFP", "DoMergeCdrNoPopLP", "DoMergeCdrNoPopSP", "DoMergeCdrNoPopIM", /* #o0342 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0343 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0344 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0345 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0346 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0347 */ + "DoFastAref1FP", "DoFastAref1LP", "DoFastAref1SP", "DoFastAref1IM", /* #o0350 */ + "DoFastAset1FP", "DoFastAset1LP", "DoFastAset1SP", "DoFastAset1IM", /* #o0351 */ + "DoStackBltAddressFP", "DoStackBltAddressLP", "DoStackBltAddressSP", "DoStackBltAddressIM", /* #o0352 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0353 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0354 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0355 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0356 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0357 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0360 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0361 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0362 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0363 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0364 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0365 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0366 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0367 */ + "DoDpbFP", "DoDpbLP", "DoDpbSP", "DoDpbIM", /* #o0370 */ + "DoCharDpbFP", "DoCharDpbLP", "DoCharDpbSP", "DoCharDpbIM", /* #o0371 */ + "DoPDpbFP", "DoPDpbLP", "DoPDpbSP", "DoPDpbIM", /* #o0372 */ + "DoPTagDpbFP", "DoPTagDpbLP", "DoPTagDpbSP", "DoPTagDpbIM", /* #o0373 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0374 */ + "DoLoopIncrementTosLessThanFP", "DoLoopIncrementTosLessThanLP", "DoLoopIncrementTosLessThanSP", "DoLoopIncrementTosLessThanIM", /* #o0375 */ + "DoCatchOpenFP", "DoCatchOpenLP", "DoCatchOpenSP", "DoCatchOpenIM", /* #o0376 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0377 */ +}; + +static char *fullwordnames [48] + = { + "nullfw", /* #o00 = DTP-NULL */ + "monitorforwardfw", /* #o01 = DTP-MONITOR-FORWARD */ + "headerpfw", /* #o02 = DTP-HEADER-P */ + "headerifw", /* #o03 = DTP-HEADER-I */ + "valuecell", /* #o04 = DTP-EXTERNAL-VALUE-CELL-POINTER */ + "oneqforwardfw", /* #o05 = DTP-ONE-Q-FORWARD */ + "headerforwardfw", /* #o06 = DTP-HEADER-FORWARD */ + "elementforwardfw", /* #o07 = DTP-ELEMENT-FORWARD */ + "pushfixnum", /* #o10 = DTP-FIXNUM */ + "pushsmallratio", /* #o11 = DTP-SMALL-RATIO */ + "pushsinglefloat", /* #o12 = DTP-SINGLE-FLOAT */ + "pushdoublefloat", /* #o13 = DTP-DOUBLE-FLOAT */ + "pushbignum", /* #o14 = DTP-BIGNUM */ + "pushbigratio", /* #o15 = DTP-BIG-RATIO */ + "pushcomplex", /* #o16 = DTP-COMPLEX */ + "pushsparenumber", /* #o17 = DTP-SPARE-NUMBER */ + "pushinstance", /* #o20 = DTP-INSTANCE */ + "pushlistinstance", /* #o21 = DTP-LIST-INSTANCE */ + "pusharrayinstance", /* #o22 = DTP-ARRAY-INSTANCE */ + "pushstringinstance", /* #o23 = DTP-STRING-INSTANCE */ + "pushnil", /* #o24 = DTP-NIL */ + "pushlist", /* #o25 = DTP-LIST */ + "pusharray", /* #o26 = DTP-ARRAY */ + "pushstring", /* #o27 = DTP-STRING */ + "pushsymbol", /* #o30 = DTP-SYMBOL */ + "pushlocative", /* #o31 = DTP-LOCATIVE */ + "pushlexicalclosure", /* #o32 = DTP-LEXICAL-CLOSURE */ + "pushdynamicclosure", /* #o33 = DTP-DYNAMIC-CLOSURE */ + "pushcompiledfunction", /* #o34 = DTP-COMPILED-FUNCTION */ + "pushgenericfunction", /* #o35 = DTP-GENERIC-FUNCTION */ + "pushsparepointer1", /* #o36 = DTP-SPARE-POINTER-1 */ + "pushsparepointer2", /* #o37 = DTP-SPARE-POINTER-2 */ + "pushphysicaladdress", /* #o40 = DTP-PHYSICAL-ADDRESS */ + "pushspareimmediate1", /* #o41 = DTP-SPARE-IMMEDIATE-1 */ + "boundlocationfw", /* #o42 = DTP-BOUND-LOCATION */ + "pushcharacter", /* #o43 = DTP-CHARACTER */ + "logicvariablefw", /* #o44 = DTP-LOGIC-VARIABLE */ + "gcforwardfw", /* #o45 = DTP-GC-FORWARD */ + "pushevenpc", /* #o46 = DTP-EVEN-PC */ + "pushoddpc", /* #o47 = DTP-ODD-PC */ + "callcompiledeven", /* #o50 = DTP-CALL-COMPILED-EVEN */ + "callcompiledodd", /* #o51 = DTP-CALL-COMPILED-ODD */ + "callindirect", /* #o52 = DTP-CALL-INDIRECT */ + "callgeneric", /* #o53 = DTP-CALL-GENERIC */ + "callcompiledevenprefetch", /* #o54 = DTP-CALL-COMPILED-EVEN-PREFETCH */ + "callcompiledoddprefetch", /* #o55 = DTP-CALL-COMPILED-ODD-PREFETCH */ + "callindirectprefetch", /* #o56 = DTP-CALL-INDIRECT-PREFETCH */ + "callgenericprefetch" /* #o57 = DTP-CALL-GENERIC-PREFETCH */ +}; + +#define MUNGEDADDR(addr) ((((int64_t)addr)>>4)&0x1FFF) + +void *_copyhalfworddispatch[256*4]; +void *_copyfullworddispatch[48]; + +char *GetNameOfInterpreterEntryPoint (int index) +{ int i; + /* First search the halfword instructions */ + for (i=0; i<256*4; i++) + if (MUNGEDADDR(_copyhalfworddispatch[i])==index) return halfwordnames[i]; + + /* Next Search the fullword instructions */ + for (i=0; i<48; i++) + if (MUNGEDADDR(_copyfullworddispatch[i])==index) return fullwordnames[i]; + return "UnknownEntrypoint"; +} + +#ifdef EXECTIMES +extern uint64_t _exectimes[]; +#endif // EXECTIMES + +void DumpInstructionUsageData (void) +{ int i; + uint64_t total=0L; +#ifdef EXECTIMES + uint64_t totalet = 0; +#endif + uint64_t *usagedata = (uint64_t *)processor->statistics; + FILE *ud = fopen("usagedata.lisp", "w"); + FILE *udt = fopen("usagedata.text", "w"); + fprintf(ud, "(setq *iusedata* '(; Instruction usage data dump from a VLM\n\n"); +// fprintf(udt, "Instruction usage data dump from a VLM\n\n"); + for (i=0; i<0x2000; i++) + if (usagedata[i]>0) { + uint64_t amt=usagedata[i]; + char *name=GetNameOfInterpreterEntryPoint(i); +#ifdef EXECTIMES + uint64_t extime = _exectimes[i]; +#endif + total += amt; +#ifdef EXECTIMES + totalet += extime ; +#endif + fprintf(ud, " (\"%s\" %lu)\n", name, amt); +#ifdef EXECTIMES + fprintf(udt, "%12lu\t%12lu\t%s\n", amt, extime, name ); +#else + fprintf(udt, "%12lu\t%s\n", amt, name ); +#endif + }; + fprintf(ud, "))\n\n(setq *itotalused* %lu)\n\n", total); +#ifdef EXECTIMES + fprintf(udt, "\n%12lu\t%12lu\tttl instructions executed \n", total, totalet); +#else + fprintf(udt, "\n%12lu\tttl instructions executed \n", total ); +#endif + fclose(ud); + fclose(udt); +} + +void ResetIcacheMissHistory (void) +{ int i; + CACHELINEP cp = (CACHELINEP)processor->icachebase; + + processor->meterpos=0; + processor->metermax=0; + for (i=0; i<=processor->metermask; i++) ((int *)(processor->meterdatabuff))[i] = -1; + for (i=0; i<=CacheLine_Mask; i++) cp[i].annotation=0; +} + +void DumpIcacheMissHistory (void) +{ int i; + int *cachedata = (int *)processor->meterdatabuff; + int mask=processor->metermask; + int pos=processor->meterpos; + CACHELINEP cp = (CACHELINEP)processor->icachebase; + + FILE *ud = fopen("cachedata.lisp", "w"); + fprintf(ud, ";; Cache miss history data dump from a VLM\n\n"); + fprintf(ud, "((%d %d %d) ; size max freq\n", + mask+1, processor->metermax, processor->meterfreq); + fprintf(ud, " ("); + for (i=0; i<=mask; i++) { + int misses=cachedata[((i+pos)&mask)]; + if (misses>=0) { + if (i==0) { fprintf(ud, "%d", misses); } + else if ((i&15)==0) { fprintf(ud, "\n %d", misses); } + else { fprintf(ud, " %d", misses); } + } + } + fprintf(ud, ")\n ("); + for (i=0; i<=CacheLine_Mask; i++) { + if ((i&15)==0) { fprintf(ud, "\n %d", cp[i].annotation); } + else { fprintf(ud, " %d", cp[i].annotation); } + } + fprintf(ud, "))\n\n"); + fclose(ud); +} +#endif + +#ifdef TRAPMETERING +char *trapnames [TrapMeter_NEntries] + = {"StackOverflow", + "InstructionException", + "ArithmeticInstructionException", + "Error", + "Reset", + "PullApplyArgs", + "Trace", + "PreemptRequest", + "LowPrioritySequenceBreak", + "HighPrioritySequenceBreak", + "DBUnwindFrame", + "DBUnwindCatch", + "Transport", + "Monitor", + "PageNotResident", + "PageFaultRequest", + "PageWriteFault", + "UncorrectableMemoryError", + "MemoryBusError", + "DBCacheMiss" +}; + +void DumpTrapData (void) +{ int i; + int64_t *trapdata = (int64_t *)processor->trapmeterdata; + FILE *ud = fopen("trapdata.lisp", "w"); + + fprintf(ud, "(setq *trapdata* '(; Trap data dump from a VLM\n\n"); + for (i=0; itrapmeterdata)[i]=0; +} +#endif + +//hack +//extern void ICACHEMISS(void); +extern void *ICACHEMISS; + +#define FLUSHICACHE {CACHELINEP cp = &instructioncache[-1]; int i; for (i = 0; i < icachesize+4; i++, cp++) {cp->code = (char*)/*&*/ICACHEMISS; cp->nextcp = (char *)cp;}} +#define FLUSHSTACKCACHE memset(stackcache, 0, stackcachesize*sizeof(LispObjRecord)) + +void flushicache (void) +{ + processor->cp=NULL; + FLUSHICACHE; +} + +#define ALPHAPAGESIZE 8192 + +void InitializeInstructionCache (void) +{ + if (instructioncache!=NULL) { + /* We have been here before, simple flush the icache that already exists*/ + FLUSHICACHE; + } + else { + /* There are 4 extra cache lines allocated for the instruction cache + * so that entries at the front and end of the cache don't have to + * be patched up for pointing out of the cache. Instead the extra + * entries will either a) cause a cache-miss, due to the PC + * mismatching, or b) force a cache miss, because their .code field + * sends you there. There is one spare line at the front of the cache + * (for the backup case) and 3 spare lines at the end (for the forward + * 2 case). We align the cache on a page for better block fills. */ + caddr_t cp = (caddr_t)malloc((icachesize+4)*sizeof(CACHELINE) + +2*ALPHAPAGESIZE); + + if (!cp) vpunt (NULL, "Unable to allocate internal data structures"); + if (!(((uint64_t)cp)&(~(ALPHAPAGESIZE-1)))) + /* if already aligned, put a blank page at front */ + cp += ALPHAPAGESIZE; + else + /* move up to page bound */ + cp = (caddr_t)(((uint64_t)cp+ALPHAPAGESIZE-1)&(~(ALPHAPAGESIZE-1))); + + /* we know there is at least 1 cacheline in front of us (as required above) */ + instructioncache=(CACHELINEP)cp; + FLUSHICACHE; + } +} + +void InitializeStatistics (void) +{ +#ifdef STATISTICS + memset(processor->statistics, 0, 0x2000*sizeof(int64_t)); +#endif +} + +void InitializeIvoryInterpreterState (void) +{ +#ifdef DEBUGICACHE + int i; + for (i=0; i<256*4; i++) + halfworddispatch[i]= &SUSPENDMACHINE; + for (i=0; i<48; i++) + fullworddispatch[i]= &SUSPENDMACHINE; +#endif +} + +void InitializeStackCache (void) +{ + if (stackcache!=NULL) { + /* The stackcache is already allocated, lets flush it */ + FLUSHSTACKCACHE; + } + else { + /* --- we shouldn't get here any more since the cache is allocated with the + * processor structure for better d-cache utilization + */ + stackcache=(LispObjRecordp)malloc(stackcachesize*sizeof(LispObjRecord)); + if (!stackcache) vpunt (NULL, "Unable to allocate internal data structures"); + }; +} + +/* Fin */ diff --git a/emulator/ivory.h b/emulator/ivory.h new file mode 100644 index 0000000..7a74568 --- /dev/null +++ b/emulator/ivory.h @@ -0,0 +1,449 @@ +/* -*- Mode:C -*- */ + +/**** Ivory architectural definitions ****/ + +#ifndef _IVORY_H +#define _IVORY_H + +#define AddressNIL 0xf8041200 +#define AddressT 0xf8041208 + +typedef enum _IvoryType +{ + /* Headers, special markers, and forwarding pointers. */ + TypeNull, /* 00 Unbound variable/function, uninitialized storage */ + TypeMonitorForward, /* 01 This cell being monitored */ + TypeHeaderP, /* 02 Structure header, with pointer field */ + TypeHeaderI, /* 03 Structure header, with immediate bits */ + TypeExternalValueCellPointer, /* 04 Invisible except for binding */ + TypeOneQForward, /* 05 Invisible pointer (forwards one cell) */ + TypeHeaderForward, /* 06 Invisible pointer (forwards whole structure) */ + TypeElementForward, /* 07 Invisible pointer in element of structure */ + /* Numeric data types. */ + TypeFixnum, /* 10 Small integer */ + TypeSmallRatio, /* 11 Ratio with small numerator and denominator */ + TypeSingleFloat, /* 12 SinglePrecision floating point */ + TypeDoubleFloat, /* 13 DoublePrecision floating point */ + TypeBignum, /* 14 Big integer */ + TypeBigRatio, /* 15 Ratio with big numerator or denominator */ + TypeComplex, /* 16 Complex number */ + TypeSpareNumber, /* 17 A number to the hardware trap mechanism */ + /* Instance data types. */ + TypeInstance, /* 20 Ordinary instance */ + TypeListInstance, /* 21 Instance that masquerades as a cons */ + TypeArrayInstance, /* 22 Instance that masquerades as an array */ + TypeStringInstance, /* 23 Instance that masquerades as a string */ + /* Primitive data types. */ + TypeNIL, /* 24 The symbol NIL */ + TypeList, /* 25 A cons */ + TypeArray, /* 26 An array that is not a string */ + TypeString, /* 27 A string */ + TypeSymbol, /* 30 A symbol other than NIL */ + TypeLocative, /* 31 Locative pointer */ + TypeLexicalClosure, /* 32 Lexical closure of a function */ + TypeDynamicClosure, /* 33 Dynamic closure of a function */ + TypeCompiledFunction, /* 34 Compiled code */ + TypeGenericFunction, /* 35 Generic function (see later section) */ + TypeSparePointer1, /* 36 Spare */ + TypeSparePointer2, /* 37 Spare */ + TypePhysicalAddress, /* 40 Physical address */ + TypeSpareImmediate1, /* 41 Spare */ + TypeBoundLocation, /* 42 Deep bound marker */ + TypeCharacter, /* 43 Common Lisp character object */ + TypeLogicVariable, /* 44 Unbound logic variable marker */ + TypeGCForward, /* 45 ObjectMoved flag for garbage collector */ + TypeEvenPC, /* 46 PC at first instruction in word */ + TypeOddPC, /* 47 PC at second instruction in word */ + /* FullWord instructions. */ + TypeCallCompiledEven, /* 50 Start call, address is compiled function */ + TypeCallCompiledOdd, /* 51 Start call, address is compiled function */ + TypeCallIndirect, /* 52 Start call, address is function cell */ + TypeCallGeneric, /* 53 Start call, address is generic function */ + TypeCallCompiledEvenPrefetch, /* 54 Like above, but prefetching is desireable */ + TypeCallCompiledOddPrefetch, /* 55 Like above, but prefetching is desireable */ + TypeCallIndirectPrefetch, /* 56 Like above, but prefetching is desireable */ + TypeCallGenericPrefetch, /* 57 Like above, but prefetching is desireable */ + /* HalfWord (packed) instructions consume 4 bits of data type field (opcodes 60..77). */ + TypePackedInstruction60, TypePackedInstruction61, TypePackedInstruction62, + TypePackedInstruction63, TypePackedInstruction64, TypePackedInstruction65, + TypePackedInstruction66, TypePackedInstruction67, TypePackedInstruction70, + TypePackedInstruction71, TypePackedInstruction72, TypePackedInstruction73, + TypePackedInstruction74, TypePackedInstruction75, TypePackedInstruction76, + TypePackedInstruction77 +} IvoryType; + +typedef enum _IvoryCdr +{ + CdrNext, + CdrNil, + CdrNormal +} IvoryCdr; + +#define TagTypeMask 077 +#define TagCdrMask 0300 +#define TagType(tag) ((tag) & 077) +#define TagCdr(tag) ((tag) >> 6) +#define SetTagCdr(tag,cdr) ((tag) | (cdr) << 6) +#define TypeEqualP(tag1,tag2) (((tag1 ^ tag2) & TagTypeMask) == 0) +#define TypeFixnumP(tag) TypeEqualP(tag,TypeFixnum) +#define PackedInstructionP(tag) ((tag & 060) == 060) +#define BinaryTypeFixnumP(tag1,tag2) (((((tag1) ^ TypeFixnum) | ((tag2) ^ TypeFixnum)) & TagTypeMask) == 0) + +#define ArrayHeaderTag (0100 | TypeHeaderI) + +typedef enum _ArrayElementType +{ + ArrayElementTypeFixnum, + ArrayElementTypeCharacter, + ArrayElementTypeBoolean, + ArrayElementTypeObject +} ArrayElementType; + +typedef enum _IvoryValueDisposition +{ + ValueDispositionEffect, + ValueDispositionValue, + ValueDispositionReturn, + ValueDispositionMultiple +} IvoryValueDisposition; + +typedef enum _IvoryOpcode +{ + /* List manipulation */ + OpcodeCar = 00, + OpcodeCdr = 01, + OpcodeSetToCar = 0140, + OpcodeSetToCdr = 0141, + OpcodeSetToCdrPushCar = 0142, + OpcodeRplaca = 0200, + OpcodeRplacd = 0201, + OpcodeRgetf = 0225, + OpcodeMember = 0226, + OpcodeAssoc = 0227, + /* AI Instructions */ + OpcodeDereference = 013, + OpcodeUnify = 0237, + OpcodePushLocalLogicVariables = 0103, + OpcodePushGlobalLogicVariable = 055, + OpcodeLogicTailTest = 014, + /* Binary predicates */ + OpcodeEq = 0270, + OpcodeEqNoPop = 0274, + OpcodeEql = 0263, + OpcodeEqlNoPop = 0267, + OpcodeEqualNumber = 0260, + OpcodeEqualNumberNoPop = 0264, + OpcodeGreaterp = 0262, + OpcodeGreaterpNoPop = 0266, + OpcodeLessp = 0261, + OpcodeLesspNoPop = 0265, + OpcodeLogtest = 0273, + OpcodeLogtestNoPop = 0277, + OpcodeTypeMember = 040, /* 41, 42, 43 */ + OpcodeTypeMemberNoPop = 044, /* 45, 46, 47 */ + /* Unary predicates */ + OpcodeEndp = 02, + OpcodePlusp = 036, + OpcodeMinusp = 035, + OpcodeZerop = 034, + /* Numeric operations */ + OpcodeAdd = 0300, + OpcodeSub = 0301, + OpcodeUnaryMinus = 0114, + OpcodeIncrement = 0143, + OpcodeDecrement = 0144, + OpcodeMultiply = 0202, + OpcodeQuotient = 0203, + OpcodeCeiling = 0204, + OpcodeFloor = 0205, + OpcodeTruncate = 0206, + OpcodeRound = 0207, + OpcodeRationalQuotient = 0211, + OpcodeMax = 0213, + OpcodeMin = 0212, + OpcodeLogand = 0215, + OpcodeLogior = 0217, + OpcodeLogxor = 0216, + OpcodeAsh = 0232, + OpcodeRot = 0220, + OpcodeLsh = 0221, + Opcode32BitPlus = 0302, + Opcode32BitDifference = 0303, + OpcodeMultiplyDouble = 0222, + OpcodeAddBignumStep = 0304, + OpcodeSubBignumStep = 0305, + OpcodeMultiplyBignumStep = 0306, + OpcodeDivideBignumStep = 0307, + OpcodeLshcBignumStep = 0223, + /* Data movement */ + OpcodePush = 0100, + OpcodePop = 0340, + OpcodeMovem = 0341, + OpcodePushNNils = 0101, + OpcodePushAddress = 0150, + OpcodeSetSpToAddress = 0151, + OpcodeSetSpToAddressSaveTos = 0152, + OpcodePushAddressSpRelative = 0102, + OpcodeStackBlt = 0224, + OpcodeStackBltAddress = 0352, + /* FieldExtraction instructions */ + OpcodeLdb = 0170, + OpcodeDpb = 0370, + OpcodeCharLdb = 0171, + OpcodeCharDpb = 0371, + OpcodePLdb = 0172, + OpcodePDpb = 0372, + OpcodePTagLdb = 0173, + OpcodePTagDpb = 0373, + /* Array operations */ + OpcodeAref1 = 0312, + OpcodeAset1 = 0310, + OpcodeAloc1 = 0313, + OpcodeSetup1DArray = 03, + OpcodeSetupForce1DArray = 04, + OpcodeFastAref1 = 0350, + OpcodeFastAset1 = 0351, + OpcodeArrayLeader = 0316, + OpcodeStoreArrayLeader = 0314, + OpcodeAlocLeader = 0317, + /* Branch instructions */ + OpcodeBranch = 0174, + OpcodeBranchTrue = 060, + OpcodeBranchTrueElseExtraPop = 061, + OpcodeBranchTrueAndExtraPop = 062, + OpcodeBranchTrueExtraPop = 063, + OpcodeBranchTrueNoPop = 064, + OpcodeBranchTrueAndNoPop = 065, + OpcodeBranchTrueElseNoPop = 066, + OpcodeBranchTrueAndNoPopElseNoPopExtraPop = 067, + OpcodeBranchFalse = 070, + OpcodeBranchFalseElseExtraPop = 071, + OpcodeBranchFalseAndExtraPop = 072, + OpcodeBranchFalseExtraPop = 073, + OpcodeBranchFalseNoPop = 074, + OpcodeBranchFalseAndNoPop = 075, + OpcodeBranchFalseElseNoPop = 076, + OpcodeBranchFalseAndNoPopElseNoPopExtraPop = 077, + OpcodeLoopDecrementTos = 0175, + OpcodeLoopIncrementTosLessThan = 0375, + /* Block instructions */ + OpcodeBlock0Read = 0120, + OpcodeBlock1Read = 0121, + OpcodeBlock2Read = 0122, + OpcodeBlock3Read = 0123, + OpcodeBlock0ReadShift = 0124, + OpcodeBlock1ReadShift = 0125, + OpcodeBlock2ReadShift = 0126, + OpcodeBlock3ReadShift = 0127, + OpcodeBlock0ReadAlu = 0160, + OpcodeBlock1ReadAlu = 0161, + OpcodeBlock2ReadAlu = 0162, + OpcodeBlock3ReadAlu = 0163, + OpcodeBlock0ReadTest = 0130, + OpcodeBlock1ReadTest = 0131, + OpcodeBlock2ReadTest = 0132, + OpcodeBlock3ReadTest = 0133, + OpcodeBlock0Write = 030, + OpcodeBlock1Write = 031, + OpcodeBlock2Write = 032, + OpcodeBlock3Write = 033, + /* Function calling */ + OpcodeStartCall = 010, + OpcodeFinishCallN = 0134, + OpcodeFinishCallNApply = 0135, + OpcodeFinishCallTos = 0136, + OpcodeFinishCallTosApply = 0137, + OpcodeEntryRestAccepted = 0176, + OpcodeEntryRestNotAccepted = 0177, + OpcodeLocateLocals = 050, + OpcodeReturnSingle = 0115, + OpcodeReturnMultiple = 0104, + OpcodeReturnKludge = 0105, + OpcodeTakeValues = 0106, + /* Binding instructions */ + OpcodeBindLocativeToValue = 0236, + OpcodeBindLocative = 05, + OpcodeUnbindN = 0107, + OpcodeRestoreBindingStack = 06, + /* Catch */ + OpcodeCatchOpen = 0376, + OpcodeCatchClose = 051, + /* Lexical variables - Each takes 8 opcodes */ + OpcodePushLexicalVar = 020, /* 21 22 23 24 25 26 27 */ + OpcodePopLexicalVar = 0240, /* 241 242 243 244 245 246 247 */ + OpcodeMovemLexicalVar = 0250, /* 251 252 253 254 255 256 257 */ + /* Instance variables */ + OpcodePushInstanceVariable = 0110, + OpcodePopInstanceVariable = 0320, + OpcodeMovemInstanceVariable = 0321, + OpcodePushAddressInstanceVariable = 0111, + OpcodePushInstanceVariableOrdered = 0112, + OpcodePopInstanceVariableOrdered = 0322, + OpcodeMovemInstanceVariableOrdered = 0323, + OpcodePushAddressInstanceVariableOrdered = 0113, + OpcodeInstanceRef = 0324, + OpcodeInstanceSet = 0325, + OpcodeInstanceLoc = 0326, + /* Subprimitives */ + OpcodeEphemeralp = 07, + OpcodeUnsignedLessp = 0331, + OpcodeUnsignedLesspNoPop = 0335, + OpcodeAlu = 0214, + OpcodeAllocateListBlock = 0311, + OpcodeAllocateStructureBlock = 0315, + OpcodePointerPlus = 0230, + OpcodePointerDifference = 0231, + OpcodePointerIncrement = 0145, + OpcodeReadInternalRegister = 0154, + OpcodeWriteInternalRegister = 0155, + OpcodeCoprocessorRead = 0156, + OpcodeCoprocessorWrite = 0157, + OpcodeMemoryRead = 0116, + OpcodeMemoryReadAddress = 0117, + OpcodeTag = 012, + OpcodeSetTag = 0327, + OpcodeStoreConditional = 0233, + OpcodeMemoryWrite = 0234, + OpcodePStoreContents = 0235, + OpcodeSetCdrCode1 = 0146, + OpcodeSetCdrCode2 = 0147, + OpcodeMergeCdrNoPop = 0342, + OpcodeGenericDispatch = 052, + OpcodeMessageDispatch = 053, + OpcodeJump = 011, + OpcodeCheckPreemptRequest = 054, + OpcodeNoOp = 056, + OpcodeHalt = 057 +} IvoryOpcode; + +#define ReadControlArgumentSize(c) ldb(8,0,c) +#define ReadControlExtraArgument(c) ldb(1,8,c) +#define ReadControlCallerFrameSize(c) ldb(8,9,c) +#define ReadControlApply(c) ldb(1,17,c) +#define ReadControlValueDisposition(c) ldb(2,18,c) +#define ReadControlCleanupBits(c) ldb(3,24,c) +#define ReadControlCleanupCatch(c) ldb(1,26,c) +#define ReadControlCleanupBindings(c) ldb(1,25,c) +#define ReadControlTrapOnExit(c) ldb(1,24,c) +#define ReadControlTrapMode(c) ldb(2,30,c) +#define ReadControlCallStarted(c) ldb(1,22,c) +#define ReadControlCleanupInProgress(c) ldb(1,23,c) +#define ReadControlInstructionTrace(c) ldb(1,29,c) +#define ReadControlCallTrace(c) ldb(1,28,c) +#define ReadControlTracePending(c) ldb(1,27,c) + +#define ControlApply 0400000 +#define ControlCleanupBits 0700000000 +#define ControlCallStarted 020000000 +#define ControlExtraArgument 0400 +#define ControlArgumentSize 0377 +#define ControlCallerFrameSize 0377000 +#define ControlValueDisposition 03000000 + +#define WriteControlArgumentSize(c,x) (c = dpb(x,8,0,c)) +#define WriteControlExtraArgument(c,x) (c = dpb(x,1,8,c)) +#define WriteControlCallerFrameSize(c,x) (c = dpb(x,8,9,c)) +#define WriteControlApply(c,x) (c = dpb(x,1,17,c)) +#define WriteControlValueDisposition(c,x) (c = dpb(x,2,18,c)) +#define WriteControlCleanupBits(c,x) (c = dpb(x,3,24,c)) +#define WriteControlCleanupCatch(c,x) (c = dpb(x,1,26,c)) +#define WriteControlCleanupBindings(c,x) (c = dpb(x,1,25,c)) +#define WriteControlTrapOnExit(c,x) (c = dpb(x,1,24,c)) +#define WriteControlTrapMode(c,x) (c = dpb(x,2,30,c)) +#define WriteControlCallStarted(c,x) (c = dpb(x,1,22,c)) +#define WriteControlCleanupInProgress(c,x) (c = dpb(x,1,23,c)) +#define WriteControlInstructionTrace(c,x) (c = dpb(x,1,29,c)) +#define WriteControlCallTrace(c,x) (c = dpb(x,1,28,c)) +#define WriteControlTracePending(c,x) (c = dpb(x,1,27,c)) + +typedef enum _InternalRegisters +{ + InternalRegisterEA = 00, + InternalRegisterFP = 01, + InternalRegisterLP = 02, + InternalRegisterSP = 03, + InternalRegisterMacroSP = 04, + InternalRegisterStackCacheLowerBound = 05, + InternalRegisterBAR0 = 06, + InternalRegisterBAR1 = 0206, + InternalRegisterBAR2 = 0406, + InternalRegisterBAR3 = 0606, + InternalRegisterPHTHash0 = 07, + InternalRegisterPHTHash1 = 0207, + InternalRegisterPHTHash2 = 0407, + InternalRegisterPHTHash3 = 0607, + InternalRegisterEPC = 010, + InternalRegisterDPC = 011, + InternalRegisterContinuation = 012, + InternalRegisterAluAndRotateControl = 013, + InternalRegisterControlRegister = 014, + InternalRegisterCRArgumentSize = 015, + InternalRegisterEphemeralOldspaceRegister = 016, + InternalRegisterZoneOldspaceRegister = 017, + InternalRegisterChipRevision = 020, + InternalRegisterFPCoprocessorPresent = 021, + InternalRegisterPreemptRegister = 023, + InternalRegisterIcacheControl = 024, + InternalRegisterPrefetcherControl = 025, + InternalRegisterMapCacheControl = 026, + InternalRegisterMemoryControl = 027, + InternalRegisterECCLog = 030, + InternalRegisterECCLogAddress = 031, + InternalRegisterInvalidateMap0 = 032, + InternalRegisterInvalidateMap1 = 0232, + InternalRegisterInvalidateMap2 = 0432, + InternalRegisterInvalidateMap3 = 0632, + InternalRegisterLoadMap0 = 033, + InternalRegisterLoadMap1 = 0233, + InternalRegisterLoadMap2 = 0433, + InternalRegisterLoadMap3 = 0633, + InternalRegisterStackCacheOverflowLimit = 034, + InternalRegisterUcodeROMContents = 035, + InternalRegisterAddressMask = 037, + InternalRegisterEntryMaximumArguments = 040, + InternalRegisterLexicalVariable = 041, + InternalRegisterInstruction = 042, + InternalRegisterMemoryData = 044, + InternalRegisterDataPins = 045, + InternalRegisterExtensionRegister = 046, + InternalRegisterMicrosecondClock = 047, + InternalRegisterArrayHeaderLength = 050, + InternalRegisterLoadBAR0 = 052, + InternalRegisterLoadBAR1 = 0252, + InternalRegisterLoadBAR2 = 0452, + InternalRegisterLoadBAR3 = 0652, + InternalRegisterTOS = 01000, + InternalRegisterEventCount = 01001, + InternalRegisterBindingStackPointer = 01002, + InternalRegisterCatchBlockList = 01003, + InternalRegisterControlStackLimit = 01004, + InternalRegisterControlStackExtraLimit = 01005, + InternalRegisterBindingStackLimit = 01006, + InternalRegisterPHTBase = 01007, + InternalRegisterPHTMask = 01010, + InternalRegisterCountMapReloads = 01011, + InternalRegisterListCacheArea = 01012, + InternalRegisterListCacheAddress = 01013, + InternalRegisterListCacheLength = 01014, + InternalRegisterStructureCacheArea = 01015, + InternalRegisterStructureCacheAddress = 01016, + InternalRegisterStructureCacheLength = 01017, + InternalRegisterDynamicBindingCacheBase = 01020, + InternalRegisterDynamicBindingCacheMask = 01021, + InternalRegisterChoicePointer = 01022, + InternalRegisterStructureStackChoicePointer = 01023, + InternalRegisterFEPModeTrapVectorAddress = 01024, + InternalRegisterMappingTableCache = 01026, + InternalRegisterMappingTableLength = 01027, + InternalRegisterStackFrameMaximumSize = 01030, + InternalRegisterStackCacheDumpQuantum = 01031, + InternalRegisterConstantNIL = 01040, + InternalRegisterConstantT = 01041 +} InternalRegisters; + +typedef enum _CoprocessorRegisters +{ + CoprocessorRegisterMicrosecondClock = 01002 +} CoprocessorRegisters; + +#endif diff --git a/emulator/ivoryrep.h b/emulator/ivoryrep.h new file mode 100644 index 0000000..422da06 --- /dev/null +++ b/emulator/ivoryrep.h @@ -0,0 +1,103 @@ +/* This structure is use for passing around a 40 lisp value when talking to + * external support interfaces. It does not represent the way such data is + * represented in memory or passed around withing the innards of the asm interpreter. + */ + +#ifndef _IVORYREP_ +#define _IVORYREP_ + +#include "aistat.h" + +typedef struct _LispObj +{ +#if BYTE_ORDER == LITTLE_ENDIAN + uint32_t data:32; + uint32_t tag:32; +#else + uint32_t tag:32; + uint32_t data:32; +#endif +} LispObjRecord, *LispObjRecordp; + +typedef int64_t LispObj; + +#define LispObjTag(lo) (((LispObjRecordp)&(lo))->tag) +#define LispObjData(lo) (((LispObjRecordp)&(lo))->data) +#define MakeLispObj(tag,data) (((((uint64_t)tag))<<32)|(0xFFFFFFFF & ((uint64_t)data))) + +/* From C-emulator for compatibility */ +typedef int Boolean; +typedef unsigned char Byte; +typedef unsigned char Tag; +typedef unsigned int Integer; +char* TagSpaceLoc(); +char* DataSpaceLoc(); + +/* Prototypes for the ivory interpreter state access functions */ + +void InitializeIvoryInterpreterState (void); +void InitializeIvoryProcessor (Integer *basedata, Tag *basetag); +void InitializeInstructionCache (void); +void InitializeStackCache (void); +void InitializeStatistics (void); +int Runningp (void); +void HaltMachine (void); +void StartMachine (Boolean resumeP); +LispObj ReadInternalRegister (int regno); +LispObj WriteInternalRegister (int regno, LispObj val); +void PushOneFakeFrame (void); +void PopOneFakeFrame (void); +extern int iInterpret (PROCESSORSTATEP ivory); /* This is the ivory interpreter */ +int InstructionSequencer (void); +LispObj CoprocessorRead (unsigned int operand); +int CoprocessorWrite (unsigned int operand, LispObj value); +void FlushCaches (void); +void InitializeTracing (int bufferSize, unsigned int startPC, unsigned int stopPC, + char* outputFile); +void EnterTrace (void); +void PrintTrace (void); +void MaybePrintTrace (void); +void TerminateTracing (void); +void flushicache (void); +void ResetMachine (void); +void SendInterruptToEmulator (void); +void SendInterruptToLifeSupport (void); +void WaitForLifeSupport (void); +int IvoryProcessorSystemStartup (int bootingP); + +void resumeemulatedtr(void); +void resumeemulated(void); +void CarSubroutine(void); +void CdrSubroutine(void); +void CarCdrSubroutine(void); +void setpctr(void); +void setpc(void); +void excesctr(void); +void nativeexception(void); +void callouttr(void); +void nativecallout(void); + +/* External declarations for state statics */ +typedef void *Pointer; + +#define DISPATCHTABLE(name,size) void (*name[size]) (void) + +extern PROCESSORSTATEP processor; +extern DISPATCHTABLE(halfworddispatch,); +extern DISPATCHTABLE(fullworddispatch,); +extern DISPATCHTABLE(internalregisterread1,); +extern DISPATCHTABLE(internalregisterread2,); +extern DISPATCHTABLE(internalregisterwrite1,); +extern DISPATCHTABLE(internalregisterwrite2,); +extern int MemoryActionTable[13][64]; +extern LispObjRecordp stackcache; +extern CACHELINEP instructioncache; +extern int icachesize; +extern int stackcachesize; + +extern Boolean Trace; +extern Boolean TestFunction; + +/* Fin */ + +#endif diff --git a/emulator/life_prototypes.h b/emulator/life_prototypes.h new file mode 100644 index 0000000..0ba87c1 --- /dev/null +++ b/emulator/life_prototypes.h @@ -0,0 +1,181 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Function prototypes for all entrypoints in VLM Life Support */ + +#include +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "world_tools.h" + + +/* When executing code which may call a function that is a thread cancellation point + (e.g., nanosleep, read, write) while under the protection of a mutex (i.e., lock), + we must establish a cleanup handler that unlocks the mutex to prevent the possibility + of a deadlock during application shutdown. */ + +#define begin_MUTEX_LOCKED(lock) \ + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_mutex_unlock, \ + (void*)&EmbCommAreaPtr->lock); \ + if (pthread_mutex_lock (&EmbCommAreaPtr->lock)) \ + vpunt (NULL, "Unable to lock the Life Support " #lock " in thread %lx", \ + pthread_self ()); + +#define end_MUTEX_LOCKED(lock) \ + if (pthread_mutex_unlock (&EmbCommAreaPtr->lock)) \ + vpunt (NULL, "Unable to unlock the Life Support " #lock " in thread %lx", \ + pthread_self ()); \ + pthread_cleanup_pop (FALSE); + +/* Life Support initialization holds onto the signal lock (mutex) until it's safe for the + various threads which comprise Life Support to run free. Consequently, each thread + first locks and unlocks the signal lock to synchronize with Life Support initialization. */ + +#define WaitUntilInitializationComplete() \ + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) \ + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", \ + pthread_self ()); \ + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) \ + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", \ + pthread_self ()); + + +/*** initialization.c ***/ + +EmbPtr EmbCommAreaAlloc (size_t nBytes); +int InitializeLifeSupport (VLMConfig* config); +EmbPtr MakeEmbString (char* aString); +void TerminateLifeSupport (void); + +void ParseVersionNumber (char* versionString, int* majorVersion, int* minorVersion, int* majorRevision, int* minorRevision); +void SetupThreadAttrs (char* class, int priorityBoost, pthread_attr_t* threadAttrs, + bool* threadAttrsSetup); + + +/*** cold_load.c ***/ + +int InitializeColdLoadChannel (VLMConfig* config); +void ResetColdLoadChannel (EmbChannel* channel); +void TerminateColdLoadChannel (void); +void UpdateColdLoadNames (void); +int check_keyboard (XParams *params, boolean noWaiting); + + +/* Internal functions are prototyped in the source file */ + + +/*** console.h ***/ + +boolean ConsoleInputAvailableP (void); +void DoConsoleIO (EmbConsoleChannel* consoleChannel, EmbConsoleBuffer* command); +void InitializeConsoleChannel (VLMConfig* config); +void ResetConsoleChannel (EmbChannel* channel); +void TerminateConsoleChannel (void); + +void AdvanceOpeningState (EmbConsoleChannel* pConsoleChannel); +void CloseDisplay (EmbConsoleChannel* chanel); +void ConsoleDriver (EmbConsoleChannel* consoleChannel, EmbQueue* pRequestQueue, + EmbQueue* pReplyQueue); +void ConsoleInput (EmbConsoleChannel* consoleChannel); +int ConsoleInputWait (EmbConsoleChannel* pConsoleChannel, + EmbConsoleBuffer* pCommand); +void ConsoleOutput (EmbConsoleChannel* consoleChannel); +int ConsoleRead (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand); +int ConsoleWrite (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand); +void DisableRunLights (EmbConsoleChannel* consoleChannel); +void DrawRunLights (pthread_addr_t argument); +void EnableRunLights (EmbConsoleChannel* pConsoleChannel, + EmbConsoleBuffer* pCommand); +int OpenDisplay (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand); +int ProcessConnectionRequest (EmbConsoleChannel* pConsoleChannel, + EmbConsoleBuffer* pCommand); + + +/*** disks.c ***/ + +void AttachDiskChannel (AttachDiskChannelRequest* pRequest); +void GrowDiskPartition (GrowDiskPartitionRequest* pRequest); +void DetachDiskChannel (EmbPtr diskChannelPtr); +void ResetDiskChannel (EmbChannel* channel); +void TerminateDiskChannels (void); + +int DoDiskIO (EmbDiskChannel* diskChannel, DiskChannelState* diskState, + EmbDiskQueueElement* command); +void DiskLife (EmbDiskChannel* diskChannel); +void TerminateDiskChannel (EmbDiskChannel* diskChannel); + +/*** unixcrypt.c ***/ + +void UnixCrypt (UnixCryptRequest *pRequest); + +/*** message_channels.c ***/ + +void InitializeMessageChannels (VLMConfig* config); +void PollMessageChannels (void); +void ResetMessageChannel (EmbChannel* channel); +void TerminateMessageChannels (void); +void UnthreadMessageChannel (EmbMessageChannel* theChannel); + +void ExecuteGuestCommands (EmbCommandChannel* commandChannel); +void ThreadActiveMessageChannel (EmbMessageChannel* theChannel); + + +/*** network.c ***/ + +void InitializeNetworkChannels (VLMConfig* config); +void ResetNetworkChannel (EmbChannel* channel); +void TerminateNetworkChannels (void); + +void InitializeNetChannel (NetworkInterface* interface, int netUnit +#ifdef OS_OSF + , struct in_addr* localHostAddress +#else +#ifndef USE_LIBPCAP + , int ipSocket, struct ifconf* ifc +#endif +#endif + ); +void NetworkChannelReceiver (pthread_addr_t argument); +void NetworkChannelTransmitter (EmbNetChannel* pNetChannel); +#ifdef OS_OSF +void TerminateNetChannel (EmbNetChannel* netChannel); +#else +void TerminateNetChannel (EmbNetChannel* netChannel, int ipSocket); +#endif + + +/*** polling.c ***/ + +void IntervalTimerDriver (pthread_addr_t argument); +void IvoryLifePolling (pthread_addr_t argument); +void SetIntervalTimer (Integer relativeTimeout); + +void ProcessResetRequest (void); +void UpdateVLMStatus (void); +boolean VLMIsRunning (EmbCommArea* ep); +boolean VLMIsRunningLisp (EmbCommArea* ep); + + +/*** queues.c ***/ + +/* All other entrypoints are defined in embed.h */ + +EmbPtr CreateQueue (int nElements, int elementSize); +void ResetIncomingQueue (EmbQueue* q); +void ResetOutgoingQueue (EmbQueue* q); + + +/*** signals.c ***/ + +/* InstallSignalHandler, EmbSendSignal, SignalLater, and RemoveSignalHandler + are defined in embed.h */ + +void InitializeSignalHandlers (void); +void TerminateSignalHandlers (void); + +void NullSignalHandler (PtrV ignore); +void SignalHandlerTopLevel (pthread_addr_t argument); + +/* The prototypes for SendInterruptToLifeSupport and WaitForLifeSupport are in ivoryrep.h */ diff --git a/emulator/life_types.h b/emulator/life_types.h new file mode 100644 index 0000000..96fe8a3 --- /dev/null +++ b/emulator/life_types.h @@ -0,0 +1,30 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Common types used throughout Life Support */ + +#ifndef _LIFE_TYPES_ +#define _LIFE_TYPES_ + +#include + +typedef int32_t EmbWord; /* A word in the communications area */ +typedef uint32_t uEmbWord; /* A word in the communications area */ + +typedef EmbWord EmbPtr; /* "Pointer" to communication area = word offset */ +typedef uEmbWord SignalMask; /* 32-bit bit mask of signals */ +typedef EmbWord SignalNumber; /* Index into that bit mask */ +typedef EmbWord bool; /* Boolean value for use in embedded data structure */ +typedef unsigned char boolean; /* Boolean value for day-to-day use */ +typedef unsigned char byte; /* byte = unsigned 8-bit byte */ +typedef void* PtrV; /* PtrV is like Ptr but with better error checking */ +typedef void (*ProcPtrV)(PtrV); /* ProcPtrV is like ProcPtr but returns nothing */ + +/* Possible initial states of an X window */ +enum WindowInitialState + { + Iconic = -1, + Unspecified, + Normal + }; + +#endif diff --git a/emulator/memory.c b/emulator/memory.c new file mode 100644 index 0000000..b5c7768 --- /dev/null +++ b/emulator/memory.c @@ -0,0 +1,1788 @@ +/* -*- Mode:C -*- */ + +#include "std.h" + +#include +#if defined(OS_DARWIN) || defined(__FreeBSD__) +#define MAP_ANONYMOUS MAP_ANON +#endif + +#include "aistat.h" +#include "aihead.h" +#include "ivoryrep.h" +#include "memory.h" +#include "utilities.h" +#include +#include + +/* Forward references */ +void AdjustProtection(Integer vma, VMAttribute attr); +static int ComputeProtection(register VMAttribute attr); +#define ceiling(n,d) (((n) + ((d) - 1)) / (d)) +#ifndef OS_OSF +static int mvalid(caddr_t address, size_t count, int access); +#endif + +Integer memory_vma; +int mprotect_result; + +#if defined(OS_OSF) +/* Superstition says threads go at 1<<32 */ +Tag *TagSpace = (Tag *)((int64_t)1<<33); /* 1<<32 bytes of tages */ +/* Data space must be TagSpace*4 for Ivory-based address scheme */ +Integer *DataSpace = (Integer *)((int64_t)1<<35); /* 4<<32 bytes of data */ + +#elif defined(OS_LINUX) && defined(ARCH_PPC64) +Tag *TagSpace = (Tag *)((int64_t)1<<36); /* 1<<32 bytes of tages */ +/* Data space must be TagSpace*4 for Ivory-based address scheme */ +Integer *DataSpace = (Integer *)((int64_t)1<<38); /* 4<<32 bytes of data */ + +#elif defined(OS_LINUX) && defined(ARCH_X86_64) +Tag *TagSpace = (Tag *)((int64_t)1<<36); /* 1<<32 bytes of tages */ +/* Data space must be TagSpace*4 for Ivory-based address scheme */ +Integer *DataSpace = (Integer *)((int64_t)1<<38); /* 4<<32 bytes of data */ + +#elif defined(__FreeBSD__) +Tag *TagSpace = (Tag *)((int64_t)1<<36); /* 1<<32 bytes of tages */ +/* Data space must be TagSpace*4 for Ivory-based address scheme */ +Integer *DataSpace = (Integer *)((int64_t)1<<38); /* 4<<32 bytes of data */ + +#elif defined(OS_DARWIN) +Tag *TagSpace = (Tag *)((int64_t)/* TBD: 1<<33 */ 0); /* 1<<32 bytes of tages */ +/* Data space must be TagSpace*4 for Ivory-based address scheme */ +Integer *DataSpace = (Integer *)((int64_t)/* TBD: 1<<35 */ 0); /* 4<<32 bytes of data */ +#endif + + +/* Initially, just a record of the pages that have faulted recently */ +typedef Integer PHTEntry; +#define ResidentPages_Size 16384 + +static PHTEntry ResidentPages[16384]; /* --- size according to machine */ +static PHTEntry *ResidentPagesPointer = ResidentPages; +static Boolean ResidentPagesWrap = FALSE; + +#define VMAinStackCacheP(vma) ((uint64_t)vma - processor->stackcachebasevma) < processor->scovlimit + +/* + --- We know underlying machine uses 8192-byte pages, we have to + create a page at a time, and tags are char (byte) sized, so we have + to create a page of tags at a time + */ + +#define MemoryPageNumber(vma) ((vma) >> MemoryPage_AddressShift) +#define MemoryPageOffset(vma) ((vma) & (MemoryPage_Size - 1)) +#define PageNumberMemory(vpn) ((vpn) << MemoryPage_AddressShift) + +/* This could be a sparse array, should someone want to implement it */ +VMAttribute VMAttributeTable[1<<(32-MemoryPage_AddressShift)]; + +#define Created(vma) VMExists(VMAttributeTable[MemoryPageNumber(vma)]) +#define fault_mask (VMAttribute_TransportFault | VMAttribute_WriteFault | VMAttribute_AccessFault) +#define DefaultAttributes(faultp,worldp) ((VMAttribute_Exists|VMAttribute_Ephemeral) | (faultp?VMAttribute_AccessFault:0) | ((EnableIDS&&(worldp))?0:VMAttribute_Modified)) + +void SetCreated(Integer vma, Boolean faultp, Boolean worldp) +{ + AdjustProtection(vma, DefaultAttributes(faultp, worldp)); +} + +void ClearCreated(Integer vma) +{ + AdjustProtection(vma, 0); +} + + +/* Wads are clusters of pages for swap contiguity. The current value is + * chosen so that all the attributes of a wad fit in one long */ +#define MemoryWad_AddressShift 16 /* (+ MemoryPage_AddressShift 3) */ +#define MemoryWad_Size 65536 /* (1 << MemoryWad_AddressShift) */ +#define MemoryWadNumber(vma) ((vma) >> MemoryWad_AddressShift) +#define MemoryWadOffset(vma) ((vma) & (MemoryWad_Size - 1)) +#define WadNumberMemory(vwn) ((vwn) << MemoryWad_AddressShift) + +#define WadExistsMask 0x4040404040404040 /* f-ing poor excuse for a macro language */ +#define WadCreated(vma) ((((int64_t *)VMAttributeTable)[MemoryWadNumber(vma)])&WadExistsMask) + +#define EphemeralAddressP(vma) (!((vma)>>27)) +#define EphemeralDemiLevel(vma) ((vma)>>21) +#define EphemeralLevelNumber(vma) (((vma)>>21)&0x1f) +#define AddressZoneNumber(vma) (((vma)>>27)&0x1f) +#define TagType(tag) ((tag)&0x3f) + +/**** Virtual memory system ****/ + +Integer EnsureVirtualAddress (Integer vma, Boolean faultp) +{ + VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + + if (attr&VMAttribute_Exists) + { + /* All "created" pages are modified for our purposes */ + if (!(attr&VMAttribute_Modified)) + AdjustProtection(vma, attr|VMAttribute_Modified); + return(MemoryPage_Size); + } + + if(WadCreated(vma)) + { + SetCreated(vma, faultp, FALSE); + } + else + { + Integer aligned_vma = vma - MemoryWadOffset(vma); + VMAttribute attr = DefaultAttributes(faultp, FALSE); + int prot = ComputeProtection(attr); + caddr_t data = (caddr_t)&DataSpace[aligned_vma]; + caddr_t tag = (caddr_t)&TagSpace[aligned_vma]; + + VMAttributeTable[MemoryPageNumber(vma)] = attr; + + if (data != mmap(data, sizeof(Integer[MemoryWad_Size]), PROT_READ|PROT_WRITE|PROT_EXEC, + MAP_ANONYMOUS|MAP_PRIVATE|MAP_FIXED,-1,0)) + { + verror (NULL, "Couldn't create data wad at %lx for VMA %x", data, vma); + return(0); + } + /* Avoid spurious ephemeral traps by pointing null pointer into boundary zone */ + (void)memset((unsigned char *)data, (unsigned char) -1, sizeof(Integer[MemoryWad_Size])); + if (tag != mmap(tag, sizeof(Tag[MemoryWad_Size]), prot, + MAP_ANONYMOUS|MAP_PRIVATE|MAP_FIXED,-1,0)) + { + verror (NULL, "Couldn't create tag wad at %lx for VMA %x", tag, vma); + munmap(data, sizeof(Integer[MemoryWad_Size])); + return(0); + } + } + + return(MemoryPage_Size); +} + +Integer DestroyVirtualAddress (Integer vma) +{ + Integer result; + + if (!Created(vma)) + result = 0; + else + { + ClearCreated(vma); + result = (Integer)MemoryPage_Size; + } + + if (!WadCreated(vma)) + { + Integer aligned_vma = vma - MemoryWadOffset(vma); + caddr_t data = (caddr_t)&DataSpace[aligned_vma]; + caddr_t tag = (caddr_t)&TagSpace[aligned_vma]; + + if (munmap(data, sizeof(Integer[MemoryWad_Size]))) + { + verror (NULL, "Couldn't unmap data wad at %lx for VMA %x", data, vma); + result = 0; + } + if (munmap(tag, sizeof(Tag[MemoryWad_Size]))) + { + verror (NULL, "Couldn't unmap tag wad at %lx for VMA %x", tag, vma); + result = 0; + } + } + + return(result); +} + + +Integer EnsureVirtualAddressRange (Integer vma, int count, Boolean faultp) +{ + Integer result = 0; + int pages = ceiling(count + MemoryPageOffset(vma), MemoryPage_Size); + + for ( ; pages--; vma += MemoryPage_Size) + result += EnsureVirtualAddress(vma, faultp); + + return(result); +} + +Integer DestroyVirtualAddressRange (Integer vma, Integer count) +{ + Integer result = 0; + int pages = ceiling(count + MemoryPageOffset(vma), MemoryPage_Size); + + for (; pages--; vma += MemoryPage_Size) + { + if (Created(vma)) + result += DestroyVirtualAddress(vma); + } + + return(result); +} + + +static int unmapped_world_words = 0; +static int mapped_world_words = 0; +static int file_map_entries = 0; +static int swap_map_entries = 0; + +Integer MapWorldLoad(Integer vma, int length, int worldfile, off_t dataoffset, off_t tagoffset) +{ + caddr_t data, tag; + /* According to the doc, by mapping PRIVATE, writes to the address + * will not go to the file, so we get copy-on-write for free. The + * only reason we map read-only, is to catch modified for IDS */ + + /* --- for now, we don't try to discover modified: it seems to run us + * out of map entries */ + VMAttribute attr = DefaultAttributes(FALSE, TRUE); + int prot = ComputeProtection(attr); + size_t dataCount, tagCount; + int words; + + for (; length > 0; ) + { + /* sigh, have to copy partial pages and pages that already exist + * (e.g., shared FEP page) */ + for(; (length > 0) + && (MemoryWadOffset(vma) + || Created(vma) + || (length < MemoryWad_Size) + ) + ; ) + { + words = MemoryPage_Size - MemoryPageOffset(vma); + if (words > length) words = length; + EnsureVirtualAddress(vma, FALSE); + + dataCount = sizeof(Integer)*words; + if (dataoffset != lseek (worldfile, dataoffset, SEEK_SET)) + vpunt (NULL, "Unable to seek to data offset %d in world file", dataoffset); + if (dataCount != read (worldfile, MapVirtualAddressData(vma), dataCount)) + vpunt (NULL, "Unable to read data page %d from world file", MemoryPageNumber(vma)); + + tagCount = sizeof(Tag)*words; + if (tagoffset != lseek (worldfile, tagoffset, SEEK_SET)) + vpunt (NULL, "Unable to seek to tag offset %d in world file", tagoffset); + if (tagCount != read (worldfile, MapVirtualAddressTag(vma), tagCount)) + vpunt (NULL, "Unable to read tag page %d from world file", MemoryPageNumber(vma)); + + /* Adjust the protection to catch modifications to world pages */ + SetCreated(vma, FALSE, TRUE); + + vma += words; + dataoffset += dataCount; + tagoffset += tagCount; + length -= words; + unmapped_world_words += words; + } + swap_map_entries += 1; + + if (length > 0) + { + int limit = length - MemoryWadOffset(length); + + /* Set the attributes for mapped in pages */ + for (words = 0; (words < limit) && !WadCreated(vma + words);) + { + int wadlimit = words + MemoryWad_Size; + VMAttribute *pattr = &VMAttributeTable[MemoryPageNumber(vma+words)]; + + for ( ; words < wadlimit; words += MemoryPage_Size, pattr++) + *pattr = attr; + } + + data = (caddr_t)&DataSpace[vma]; + tag = (caddr_t)&TagSpace[vma]; + if (data != mmap(data, dataCount=sizeof(Integer)*words, PROT_READ|PROT_WRITE|PROT_EXEC, + MAP_FILE|MAP_PRIVATE|MAP_FIXED, worldfile, dataoffset)) + vpunt (NULL, "Couldn't map %d world data pages at %lx for VMA %x", + MemoryPageNumber(words), data, vma); + if (tag != mmap(tag, tagCount = sizeof(Tag)*words, prot, + MAP_FILE|MAP_PRIVATE|MAP_FIXED, worldfile, tagoffset)) + vpunt (NULL, "Couldn't map %d world tag pages at %lx for VMA %x", + MemoryPageNumber(words), tag, vma); + + vma += words; + dataoffset += dataCount; + tagoffset += tagCount; + length -= words; + mapped_world_words += words; + file_map_entries += 2; + } + } + return(vma); +} + + +Integer* MapVirtualAddressData(Integer vma) +{ + return(&DataSpace[vma]); +} + + +Tag* MapVirtualAddressTag(Integer vma) +{ + return(&TagSpace[vma]); +} + +LispObj VirtualMemoryReadUncached (Integer vma) +{ + VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + Integer aligned_vma = vma - MemoryPageOffset(vma); + int pagesize = sizeof(Tag)*MemoryPage_Size; + caddr_t address = (caddr_t) &TagSpace[aligned_vma]; + int protected = mvalid(address, pagesize, PROT_READ); + LispObj contents; + + if (protected) + if ((mprotect_result = mprotect(address, pagesize, PROT_READ) == -1)) + vpunt ("VirtualMemoryReadUncached", NULL); + + /* check exists done by spy */ + contents = MakeLispObj(TagSpace[vma], DataSpace[vma]); + + if (protected) + { + int prot = ComputeProtection(attr); + + if ((mprotect_result = mprotect(address, pagesize, prot) == -1)) + vpunt ("VirtualMemoryReadUncached", NULL); + } + + return (contents); +} + + +LispObj VirtualMemoryRead (unsigned int address) +{ + if (VMAinStackCacheP (address)) + /* We have got a stack cache hit, read the bits form the stack cache. */ + return (((LispObj *)processor->stackcachedata)[address-processor->stackcachebasevma]); + else + return (VirtualMemoryReadUncached (address)); +} + + +void VirtualMemoryWriteUncached (Integer vma, LispObj object) +{ + VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + Integer aligned_vma = vma - MemoryPageOffset(vma); + int pagesize = sizeof(Tag)*MemoryPage_Size; + caddr_t address = (caddr_t) &TagSpace[aligned_vma]; + int protected = mvalid(address, pagesize, PROT_WRITE); + + if (protected) + if ((mprotect_result = mprotect(address, pagesize, PROT_WRITE) == -1)) + vpunt ("VirtualMemoryWriteUncached", NULL); + + /* check exists done by spy*/ + DataSpace[vma] = LispObjData(object); + TagSpace[vma] = LispObjTag(object); + + if (protected) + { + int prot = ComputeProtection(attr); + + if ((mprotect_result = mprotect(address, pagesize, prot) == -1)) + vpunt ("VirtualMemoryReadUncached", NULL); + } +} + + +void VirtualMemoryWrite (unsigned int address, LispObj object) +{ + if (VMAinStackCacheP (address)) + /* We have a stack cache hit, put the bits in the stack cache */ + ((LispObj *)processor->stackcachedata)[address-processor->stackcachebasevma]=object; + else + /* Put the bits in the real memory */ + VirtualMemoryWriteUncached (address, object); +} + + +void VirtualMemoryReadBlockUncached (Integer vma, LispObj *object, int count) +{ + Integer *data = &DataSpace[vma]; + Tag *tag = &TagSpace[vma]; + Integer *edata = &DataSpace[vma + count]; + + /* check exists done by spy */ + for (; data < edata; object++, data++, tag++, memory_vma++) + *object = MakeLispObj(*tag, *data); +} + + +void VirtualMemoryReadBlock (unsigned int address, LispObj *object, int count) +{ + if ((uint64_t)address < processor->stackcachebasevma) { + int pc = ((uint64_t)(address+count-1) < processor->stackcachebasevma) ? count + : processor->stackcachebasevma - (uint64_t)address; + VirtualMemoryReadBlockUncached (address, object, pc); + count -= pc; + address += pc; + object += pc; + } + + while (VMAinStackCacheP (address) && (count > 0)) { + *object++ = VirtualMemoryRead (address++); + count--; + } + + if (count > 0) + VirtualMemoryReadBlockUncached (address, object, count); +} + + +void VirtualMemoryWriteBlockUncached (Integer vma, LispObj *object, int count) +{ + Integer *data = &DataSpace[vma]; + Tag *tag = &TagSpace[vma]; + Integer *edata = &DataSpace[vma + count]; + + /* check exists done by spy */ + for (; data < edata; object++, data++, tag++, memory_vma++) + { + *data = LispObjData(*object); + *tag = LispObjTag(*object); + } +} + + +void VirtualMemoryWriteBlock (unsigned int address, LispObj *object, int count) +{ + if ((uint64_t)address < processor->stackcachebasevma) { + int pc = ((uint64_t)(address+count-1) < processor->stackcachebasevma) ? count + : processor->stackcachebasevma - (uint64_t)address; + VirtualMemoryWriteBlockUncached (address, object, pc); + count -= pc; + address += pc; + object += pc; + } + + while (VMAinStackCacheP (address) && (count > 0)) { + VirtualMemoryWrite (address++, *object); + object++; + count--; + } + + if (count > 0) + VirtualMemoryWriteBlockUncached (address, object, count); +} + + +void VirtualMemoryWriteBlockConstantUncached (Integer vma, LispObj object, + int count, int increment) +{ + Integer *data = &DataSpace[vma]; + Tag *tag = &TagSpace[vma]; + Tag ctag = LispObjTag(object); + Integer cdata = LispObjData(object); + Integer *edata = &DataSpace[vma + count]; + + /* check exists doneby spy */ + (void)memset((unsigned char *)tag, (unsigned char) ctag, count*sizeof(Tag)); + + switch (increment) + { + case 0: + if (cdata == 0) + (void)memset((unsigned char *)data, (unsigned char) 0, count*sizeof(Integer)); + else + for (; data < edata; *data++ = cdata); + break; + case 1: + for(; data < edata; *data++ = cdata++); + break; + default: + for(; data < edata; *data++ = cdata, cdata += increment); + } +} + + +void VirtualMemoryWriteBlockConstant (unsigned int address, LispObj object, + int count, int increment) +{ + if ((uint64_t)address < processor->stackcachebasevma) { + int pc = ((uint64_t)(address+count-1) < processor->stackcachebasevma) ? count + : processor->stackcachebasevma - (uint64_t)address; + VirtualMemoryWriteBlockConstantUncached (address, object, pc, increment); + count -= pc; + address += pc; + LispObjData (object) += pc * increment; + } + + while (VMAinStackCacheP (address) && (count > 0)) { + VirtualMemoryWrite (address++, object); + LispObjData (object) += increment; + count--; + } + + if (count > 0) + VirtualMemoryWriteBlockConstantUncached (address, object, count, increment); +} + + +/* --- bleah, this probably has to use data-read cycles */ +Boolean VirtualMemorySearch (Integer *vma, LispObj object, int count) +{ + Tag *tag = &TagSpace[*vma]; + Tag *etag = &TagSpace[*vma + count]; + Tag ctag = LispObjTag(object); + Integer cdata = LispObjData(object); + Integer tvma; + + /* --- check exists */ + + for( ; tag < etag; ) + { + if (!(TagType(ctag ^ *tag))) { + tvma = tag - TagSpace; + if (DataSpace[tvma] == cdata) + { + *vma = tvma; + return(TRUE); + } + } + tag++; + } + return(FALSE); +} + +/* mode is currently ignored */ +Boolean VirtualMemoryCopy (Integer from, Integer to, int count, int mode) +{ + Integer *fromdata = &DataSpace[from]; + register Tag *fromtag = &TagSpace[from]; + Integer *todata = &DataSpace[to]; + register Tag *totag = &TagSpace[to]; + + (void)memmove((unsigned char *)totag, (unsigned char *)fromtag, count*sizeof(Tag)); + (void)memmove((unsigned char *)todata, (unsigned char *)fromdata, count*sizeof(Integer)); + return(TRUE); +} + +/* For Genera, the Disable bit overrides the Fault bit. The Fault bit + * is set at flip time, to mean the page should be scavenged. If the page + * is also disabled, it means that it should not fault (it is scavenged + * manually). Copyspace pages may have their disable bits twiddled on and + * off as objects are transported into them and they are subsequently + * scavenged. */ +void VirtualMemoryEnable (register Integer vma, int count, Boolean faultp) +{ + register VMAttribute *attr = &VMAttributeTable[MemoryPageNumber(vma)]; + register VMAttribute *eattr = &VMAttributeTable[MemoryPageNumber(vma + count + + MemoryPage_Size - 1)]; + register VMAttribute oa, a; + + if (!processor->zoneoldspace) + { + /* Ephemeral flip */ + for ( ; attr < eattr; attr++, vma += MemoryPage_Size) + if (VMExists(oa = *attr)) + { + /* On an ephemeral flip, we would like to not enable pages that can't + * possibly need scavenging, to minimize the number of read protects + * we do. But we have to be careful in copyspace, because those pages + * can get enabled before the GC has actually copied the bits onto the + * page, so the ephemeral bit is not necessarily correct */ + a = oa; + if (!faultp) { + /* Only copyspace and safeguarded space use faultp = NIL, we infer + * from that, that we should always turn on the fault and disable + * bits -- these pages are always scanned atomically anyways */ + SetVMTransportFault(a); + SetVMTransportDisable(a); + } + else if (VMEphemeral(a)) { + /* Normal space need only trap if there are already known ephemeral + * references on it */ + SetVMTransportFault(a); + ClearVMTransportDisable(a); + } else { + /* No epehmeral references, not copyspace => no need to fault */ + ClearVMTransportDisable(a); + ClearVMTransportFault(a); + } + if (a != oa) + AdjustProtection(vma, a); + } + } + else { + /* Dynamic flip */ + for ( ; attr < eattr; attr++, vma += MemoryPage_Size) + if (VMExists(oa = *attr)) + { +#ifdef notdef /* --- some day */ + if (VMDynamic(a = oa)) +#else + a = oa; +#endif + SetVMTransportFault(a); + + if (!faultp) + SetVMTransportDisable(a); + else + ClearVMTransportDisable(a); + + if (a != oa) + AdjustProtection(vma, a); + } + } +} + +/* Has hard-wired cycle-type of raw, hence really only useful to GC */ +Boolean VirtualMemorySearchCDR(Integer *vma, int count, register unsigned int cdr_mask) +{ + /* (semi-) fast pointer scan 8 at a time CAUTION! little-endian + * dependent code */ + Boolean forwardp = (count>0); + register uint64_t tagbits; + Integer startvma = *vma; + register Integer thisvma = forwardp ? (startvma&~07) : (startvma|07); + register Integer nextvma = thisvma + (forwardp?8:-8); + register Integer limitvma = startvma+count; + register int64_t *tags8 = &((int64_t *)TagSpace)[thisvma>>3]; + + if (forwardp) + { + for ( ; thisvma < limitvma ; tags8++, thisvma = nextvma, nextvma += 8) + { + /* get to first cdr */ + tagbits = ((*tags8)>>6); + for ( ; thisvma < nextvma; tagbits >>= 8, thisvma++) + if ((cdr_mask>>(tagbits&0x3))&01) + { + { + /* Don't return on addresses you weren't asked to scan! */ + if ((startvma <= thisvma) && (thisvma < limitvma)) + { + *vma = thisvma; + return(TRUE); + } + } + } + } + } + else + { + for ( ; thisvma > limitvma ; tags8--, thisvma = nextvma, nextvma -= 8) + { + /* get to first cdr */ + tagbits = ((*tags8)>>6); + for ( ; thisvma > nextvma; tagbits <<= 8, thisvma--) + if ((cdr_mask>>((tagbits>>56)&0x3))&01) + { + { + /* Don't return on addresses you weren't asked to scan! */ + if ((startvma >= thisvma) && (thisvma > limitvma)) + { + *vma = thisvma; + return(TRUE); + } + } + } + } + } + + return(FALSE); +} + +/* Has hard-wired cycle-type of raw, hence really only useful to GC */ +Boolean VirtualMemorySearchType(Integer *vma, int count, register uint64_t type_mask) +{ + /* (semi-) fast pointer scan 8 at a time CAUTION! little-endian + * dependent code */ + Boolean forwardp = (count>0); + register uint64_t tagbits; + Integer startvma = *vma; + register Integer thisvma = forwardp ? (startvma&~07) : (startvma|07); + register Integer nextvma = thisvma + (forwardp?8:-8); + register Integer limitvma = startvma+count; + register int64_t *tags8 = &((int64_t *)TagSpace)[thisvma>>3]; + + if (forwardp) + { + for ( ; thisvma < limitvma ; tags8++, thisvma = nextvma, nextvma += 8) + { + tagbits = *tags8; + for ( ; thisvma < nextvma; tagbits >>= 8, thisvma++) + if ((type_mask>>(tagbits&0x3f))&01) + { + { + /* Don't return on addresses you weren't asked to scan! */ + if ((startvma <= thisvma) && (thisvma < limitvma)) + { + *vma = thisvma; + return(TRUE); + } + } + } + } + } + else + { + for ( ; thisvma > limitvma ; tags8--, thisvma = nextvma, nextvma -= 8) + { + tagbits = *tags8; + for ( ; thisvma > nextvma; tagbits <<= 8, thisvma--) + if ((type_mask>>((tagbits>>56)&0x3f))&01) + { + { + /* Don't return on addresses you weren't asked to scan! */ + if ((startvma >= thisvma) && (thisvma > limitvma)) + { + *vma = thisvma; + return(TRUE); + } + } + } + } + } + + return(FALSE); +} + +/* Has hard-wired cycle-type of gc-copy. In particular, first searches + * for a gc-forward tag in the affected range and returns fail if found, + * otherwise does the copy and forward */ +Boolean VirtualMemoryCopyandForward (Integer from, Integer to, int count) +{ + register Integer *fromdata = &DataSpace[from]; + Tag *fromtag = &TagSpace[from]; + register Integer *todata = &DataSpace[to]; + Tag *totag = &TagSpace[to]; + register Integer *edata = &DataSpace[from + count]; + register Integer forward = to; + + if (memccpy((unsigned char *)totag, (unsigned char *)fromtag, + Type_GCForward, count*sizeof(Tag)) != NULL) + return(FALSE); + (void)memset((unsigned char *)fromtag, Type_GCForward|(Cdr_Nil<<6), count*sizeof(Tag)); + + for ( ; fromdata < edata; ) + { + *todata++ = *fromdata; + *fromdata++ = forward++; + } + + return (TRUE); +} + +/* complete cheat, but we know this generates SRA; BLBS (which + * only uses 6 bits) --- Added &0x3f to keep Paul happy */ +/* you have to define pointertypes appropriately in a register + * in the caller */ +# define PointerP(tag) ((pointertypes>>(tag&0x3f))&01) +# define ZoneOldspaceP(vma,oldbits) ((oldbits>>AddressZoneNumber(vma))&01) +/* Ephemeral bits duplicated inverted for high half */ +# define EphemeralOldspaceP(vma,oldbits) ((oldbits>>EphemeralDemiLevel(vma))&01) + +static Integer slowdata; +static Byte slowtag; +static Integer previousslowvma, lastslowvma; + +/* for debugging */ +Boolean SlowScanPage(Integer scanvma, Integer *vma, int count, Boolean update) +{ + register Byte *tag = &TagSpace[scanvma]; + register Byte *etag = tag + count; + register Integer *data = &DataSpace[scanvma]; + register uint64_t pointertypes = 0x0000FFF4FFFFF8F7L; + register uint64_t ephemeraloldbits; + register uint64_t zoneoldbits; + + if (mvalid((caddr_t)tag, + count, + PROT_READ)) + { + fprintf(stderr, + "SlowScanPage on inaccessible memory at %lx for %x (ATTRIBUTES=0%o)\n", + (uint64_t)scanvma, count, VMAttributeTable[MemoryPageNumber(scanvma)]); + } + + ephemeraloldbits = processor->ephemeraloldspace; + ephemeraloldbits = (ephemeraloldbits<<32)|((~ephemeraloldbits)&0xFFFFFFFF); + zoneoldbits = processor->zoneoldspace; + + for ( ; tag < etag ; data++, tag++) + { + if (PointerP(*tag)) + { + if (EphemeralAddressP(*data)) + { + if (!EphemeralOldspaceP(*data,ephemeraloldbits)) + continue; + } + else + { + if (!ZoneOldspaceP(*data,zoneoldbits)) + continue; + } + + { + slowtag = *tag; + slowdata = *data; + previousslowvma = lastslowvma; + *vma = lastslowvma = data - DataSpace; + return(TRUE); + } + } + } + + return(FALSE); +} + +/* Scans a page, returning any oldspace VMA. If no oldspace found, + * ensures entire page is scannned and updates ephemeral bit */ +Boolean ScanPage(Integer scanvma, Integer *vma, int count, Boolean update) +{ + Integer startvma = scanvma - MemoryPageOffset(scanvma); + Integer endvma = scanvma + count; + Boolean ephemeral = FALSE; + Boolean wrapped = FALSE; + + for ( ; ; wrapped = TRUE, update = TRUE) /* loop exits after update pass */ + { + { + /* (semi-) fast pointer scan 8 at a time CAUTION! little-endian + * dependent code */ + /* --- define in memory.h */ + register uint64_t pointertypes = 0x0000FFF4FFFFF8F7L; + /* registers in order of frequency of use */ + register uint64_t tagbits; + register Integer thisvma = (wrapped?startvma:scanvma)&~07; + register Integer nextvma = thisvma + 8; + register Integer limitvma = (wrapped?scanvma:endvma); + register int64_t *tags8 = &((int64_t *)TagSpace)[thisvma>>3]; + register Integer word; + register uint64_t ephemeraloldbits; + register uint64_t zoneoldbits; + + ephemeraloldbits = processor->ephemeraloldspace; + ephemeraloldbits = (ephemeraloldbits<<32)|((~ephemeraloldbits)&0xFFFFFFFF); + zoneoldbits = processor->zoneoldspace; + + for ( ; thisvma < limitvma ; tags8++, thisvma = nextvma, nextvma += 8) + { + tagbits = *tags8; + /* --- could use compare-bytes to test for all tags being + * packed instructions */ + for ( ; thisvma < nextvma; tagbits >>= 8, thisvma++) + if (PointerP(tagbits)) + { + if (update) + { + /* In update phase, just scan for ephemeral references. You are + * done as soon as you find one */ + if (ephemeral || (ephemeral = EphemeralAddressP(word = DataSpace[thisvma]))) + goto done; + } + else + { + if (EphemeralAddressP(word = DataSpace[thisvma])) + { + ephemeral = TRUE; + + if (!EphemeralOldspaceP(word,ephemeraloldbits)) + continue; + } + else + { + if (!ZoneOldspaceP(word,zoneoldbits)) + continue; + } + + { + /* Don't return on addresses you weren't asked to scan! */ + if ((scanvma <= thisvma) && (thisvma < endvma)) + { + *vma = thisvma; + return(TRUE); + } + } + } + } + } + } + + done: + if (update) { +#ifdef OPTIMISTICUPDATES + /* Lisp would be required to scan whole pages, unless it *knows* there + * is nothing beyond, e.g., a stack */ + if (!MemoryPageOffset(endvma)) +#endif + { + register VMAttribute oa = VMAttributeTable[MemoryPageNumber(scanvma)]; + register VMAttribute a = oa; + + /* We know we have completed scanning this page, so clear the fault bit */ + ClearVMTransportFault(a); + ClearVMTransportDisable(a); + + /* We have finished the page and can update ephemeral */ + if (ephemeral) + SetVMEphemeral(a); + else + ClearVMEphemeral(a); + + if (a != oa) + AdjustProtection(scanvma, a); + } + + return(FALSE); + } + } +} + +Boolean VirtualMemoryScan (Integer *vma, register int count, Boolean slowp) +{ + register Integer scanvma = *vma; + register VMAttribute *attr; + register int whack = MemoryPage_Size - MemoryPageOffset(scanvma); + register int mask; + register Boolean (*scan)() = slowp?SlowScanPage:ScanPage; + Boolean update = FALSE; +#ifdef DEBUGSCAN + Integer slowvma = FALSE; + Boolean slowfound = NULL; +#endif + + if (slowp) + mask = VMAttribute_Exists; + else if (!processor->zoneoldspace) + mask = VMAttribute_Ephemeral|VMAttribute_TransportFault; + else + /* --- some day do a dynamic bit */ + mask = VMAttribute_Exists|VMAttribute_TransportFault; + + if (!count && !MemoryPageOffset(scanvma)) { + /* Note that we may be called with a count of 0 if there is an + * oldspace reference in the last location of a chunk, but we still + * want to rescan the page to adjust the ephemeral bits */ + scanvma -= MemoryPage_Size; + count = MemoryPage_Size; + /* We will only do the update phase -- this could be false-oldspace, and we don't + * want to trap finishing the page */ + update = TRUE; + } + + attr = &VMAttributeTable[MemoryPageNumber(scanvma)]; + if (whack > count) whack = count; + + for ( ; count > 0; ) + { + register VMAttribute a = *attr; +#ifdef DEBUGSCAN + VMAttribute oa = a; +#endif + /* Always disable faults, even if you optimize out the scan */ + if (VMTransportFault(a) && !VMTransportDisable(a)) + { + SetVMTransportDisable(a); + AdjustProtection(scanvma, a); + } + +#ifdef DEBUGSCAN + if (VMExists(oa)) + { + slowfound = SlowScanPage(scanvma - MemoryPageOffset(scanvma), &slowvma, + whack + MemoryPageOffset(scanvma), FALSE); + } +#endif + + if ((a & mask) == mask) + { + if ((*scan)(scanvma, vma, whack, update)) + { +#ifdef DEBUGSCAN + if (!slowfound || slowvma != *vma) + { + fprintf(stderr, + "Slow/Fast mismatch. OA=%x A=%x SCAN=%lx WHACK=%x SLOW=%lx FAST=%lx\n\ + SLOWTAG=%x SLOWDATA=%lx FASTTAG=%x FASTDATA=%lx PREVIOUS=%lx\n", + oa, a, (uint64_t) scanvma, whack, + (uint64_t) slowvma, (uint64_t) *vma, + slowtag, (uint64_t)slowdata, + TagSpace[*vma], (uint64_t)DataSpace[*vma], (uint64_t)previousslowvma); + (*scan)(scanvma, vma, whack, update); + } +#endif + return(TRUE); + } + } + else if (!slowp) + { + /* We know we have completed scanning this page, so clear the fault bit */ + ClearVMTransportFault(a); + *attr = ClearVMTransportDisable(a); + } +#ifdef DEBUGSCAN + if (slowfound) + { + fprintf(stderr, + "Slow/Fast mismatch. OA=%x A=%x SCAN=%lx WHACK=%x SLOW=%lx FAST=%lx\n\ + SLOWTAG=%x SLOWDATA=%lx FASTTAG=%x FASTDATA=%lx PREVIOUS=%lx\n", + oa, a, (uint64_t) scanvma, whack, + (uint64_t) slowvma, (uint64_t) NULL, + slowtag, (uint64_t)slowdata, + NULL, NULL, (uint64_t)previousslowvma); + (*scan)(scanvma, vma, whack, update); + } +#endif + + attr++; + scanvma += whack; + count -= whack; + whack = (MemoryPage_Size 0); wad++, n -= MemoryWad_Size) + if (*wad & WadExistsMask) + break; + + if (attr < (VMAttribute *)wad) + attr = (VMAttribute *)wad; + + if (sense) + { + for ( ; (attr < eattr) && (n > 0); attr++, n -= MemoryPage_Size) + if ((*attr&mask) == mask) + { + *vma = PageNumberMemory(attr - VMAttributeTable); + return(TRUE); + } + } + else + { + for ( ; (attr < eattr) && (n > 0); attr++, n -= MemoryPage_Size) + if ((*attr&mask) != mask) + { + *vma = PageNumberMemory(attr - VMAttributeTable); + return(TRUE); + } + } + + return(FALSE); +} + +static PHTEntry *ResidentPagesScan = ResidentPages; + +Boolean VirtualMemoryResidentScan (Integer *vma, Integer *count, register VMAttribute mask, register int sense) +{ + register PHTEntry *scan = ResidentPagesScan; + register PHTEntry *escan = ResidentPagesWrap ? &ResidentPages[ResidentPages_Size] + : ResidentPagesPointer; + register VMAttribute *attr = VMAttributeTable; + + for ( ; scan <= escan; scan++) + { + if (sense) + { + if ((attr[MemoryPageNumber(*scan)] & mask) == mask) + { + *vma = *scan; + *count = escan-scan; + ResidentPagesScan = ++scan; + return (TRUE); + } + } + else + { + if ((attr[MemoryPageNumber(*scan)] & mask) != mask) + { + *vma = *scan; + *count = escan-scan; + ResidentPagesScan = ++scan; + return (TRUE); + } + } + + } + + ResidentPagesPointer = ResidentPagesScan = ResidentPages; + ResidentPagesWrap = FALSE; + return(FALSE); +} + + +VMState VM; + +int VMCommand(int command) +{ + register VMState *vm = &VM; + + switch VMCommandOpcode(command) + { + case VMOpcodeLookup: + { + register int vpn = MemoryPageNumber(vm->AddressRegister); + return(SetVMReplyResult(vpn, VMExists(VMAttributeTable[vpn]))); + } + + case VMOpcodeCreate: + { + register Integer vma = vm->AddressRegister; + register int vpn = MemoryPageNumber(vma); + register int words = vm->ExtentRegister; + + /* Optimization */ + if(WadCreated(vma) && (words <= MemoryPage_Size)) + { + SetCreated(vma, VMCommandOperand(command), FALSE); + vm->ExtentRegister = MemoryPage_Size; + } + else + vm->ExtentRegister = EnsureVirtualAddressRange(vma, words, VMCommandOperand(command)); + + return(SetVMReplyResult(vpn, TRUE)); + } + + case VMOpcodeDestroy: + /* --- optimize as above */ + vm->ExtentRegister = DestroyVirtualAddressRange(vm->AddressRegister, vm->ExtentRegister); + return(SetVMReplyResult(0, TRUE)); + + case VMOpcodeReadAttributes: + { + register VMAttribute attr = VMAttributeTable[VMCommandOperand(command)]; + + if VMExists(attr) + { + vm->AttributesRegister = attr; + return(SetVMReplyResult(command, TRUE)); + } + else + return(SetVMReplyResult(command, FALSE)); + } + + case VMOpcodeWriteAttributes: + { + register VMAttribute attr = VMAttributeTable[VMCommandOperand(command)]; + register Integer vpn = VMCommandOperand(command); + register Integer vma = PageNumberMemory(vpn); + + if VMExists(attr) + { + register VMAttribute nattr = vm->AttributesRegister; + + /* ensure Lisp doesn't mung exists, modified? bits */ + nattr &= ~(VMAttribute_Exists|VMAttribute_Modified); + nattr |= (attr & (VMAttribute_Exists|VMAttribute_Modified)); + + if (attr ^ nattr) + AdjustProtection(vma, nattr); + return(SetVMReplyResult(command, TRUE)); + } + else + return(SetVMReplyResult(command, FALSE)); + } + + case VMOpcodeFill: + VirtualMemoryWriteBlockConstant(vm->AddressRegister, vm->DataRegister, + vm->ExtentRegister, VMCommandOperand(command)); + return(SetVMReplyResult(0, TRUE)); + + case VMOpcodeSearch: + { + register Boolean result = VirtualMemorySearch(&vm->AddressRegister, vm->DataRegister, + vm->ExtentRegister); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeCopy: + { + Boolean result = VirtualMemoryCopy(vm->AddressRegister, vm->DestinationRegister, + vm->ExtentRegister, + VMCommandOperand(command)); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeScan: + { + register Boolean result = VirtualMemoryScan(&vm->AddressRegister, + vm->ExtentRegister, + VMCommandOperand(command)); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeEnable: + { + VirtualMemoryEnable(vm->AddressRegister, vm->ExtentRegister, VMCommandOperand(command)); + return(SetVMReplyResult(0, TRUE)); + } + + case VMOpcodePHTScan: + { + register Boolean result = VirtualMemoryPHTScan(&vm->AddressRegister, + vm->ExtentRegister, + vm->AttributesRegister, + VMCommandOperand(command)); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeCopyandForward: + { + register Boolean result = VirtualMemoryCopyandForward(vm->AddressRegister, + vm->DestinationRegister, + vm->ExtentRegister); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeResidentScan: + { + register Boolean result = VirtualMemoryResidentScan(&vm->AddressRegister, + &vm->ExtentRegister, + vm->AttributesRegister, + VMCommandOperand(command)); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeSearchType: + { + register Boolean result = + VirtualMemorySearchType(&vm->AddressRegister, + vm->ExtentRegister, + ((uint64_t) vm->MaskRegisterHigh << 32) + | vm->MaskRegisterLow); + return(SetVMReplyResult(0, result)); + } + + case VMOpcodeSearchCDR: + { + register Boolean result = + VirtualMemorySearchCDR(&vm->AddressRegister, + vm->ExtentRegister, + vm->MaskRegisterLow); + return(SetVMReplyResult(0, result)); + } + + default: + return(SetVMReplyResult(0, FALSE)); + } +} + +/* Computes the PROT_XXX setting for a particular combination of + * VMAttribute's. C.f., segv_handler, which translates resulting segfault + * back to appropriate Lisp fault */ +static int ComputeProtection(register VMAttribute attr) +{ + /* Don't cause transport faults if they are overridden */ + if (VMTransportDisable(attr)) + ClearVMTransportFault(attr); + + /* We would have liked Transport to use write-only pages, but that is + * not guaranteed by OSF/Unix, so we just use none */ + if ((attr & (VMAttribute_Exists|VMAttribute_TransportFault|VMAttribute_AccessFault)) + != VMAttribute_Exists) + return(PROT_NONE); + + /* Unless the modified and ephemeral bits are set, use read-only, so + * we can update them */ + if ((attr & (VMAttribute_Modified|VMAttribute_Ephemeral|VMAttribute_WriteFault)) + != (VMAttribute_Modified|VMAttribute_Ephemeral)) + return(PROT_READ|PROT_EXEC); + + return(PROT_READ|PROT_WRITE|PROT_EXEC); +} + +void AdjustProtection(Integer vma, VMAttribute new_attr) +{ + register VMAttribute *attr = &VMAttributeTable[MemoryPageNumber(vma)]; + register int old, new; + VMAttribute oa = *attr; + + old = ComputeProtection(oa); + new = ComputeProtection(new_attr); + + if (old != new) + { + register caddr_t address = (caddr_t)&TagSpace[vma - MemoryPageOffset(vma)]; + + if ((mprotect_result = mprotect(address, sizeof(Tag)*MemoryPage_Size, new))) + vpunt ("AdjustProtection", "mprotect(%lx, #, %lx) for VMA %x", + address, new, (uint64_t)vma); + } + +#ifdef OS_OSF + if (mvalid((caddr_t)&TagSpace[vma-MemoryPageOffset(vma)], + sizeof(Tag)*MemoryPage_Size, new)) { +#ifdef DEBUGMPROTECT + fprintf(stderr, + "Attribute/mprotect skew at %lx (ATTRIBUTES=0%o->0%o)\n", + (uint64_t)vma, oa, new_attr); +#endif + } else +#endif + *attr = new_attr; +} + +#ifndef OS_OSF +/* Memory management interface not provided by modern UNIX and/or Linux */ + +#define OK 0 +#define NO -1 + +static jmp_buf trap_environment; + +/* Catch SEGV's when poking at memory */ +static void simple_segv_handler (int sigval, register siginfo_t *si, void *uc_p) +{ + _longjmp(trap_environment, -1); +} + +static int mvalid (caddr_t address, size_t count, int access) +{ + struct sigaction action, oldaction; + sigset_t oldmask; + size_t page_size = getpagesize(); + caddr_t end = address + count; + caddr_t p=NULL; + int check_read = access & PROT_READ; + int check_write = access & PROT_WRITE; + int result = OK, reading=TRUE; + char datum=0; + + sigprocmask(SIG_SETMASK, NULL, &oldmask); + + action.sa_sigaction = (sa_sigaction_t)simple_segv_handler; + action.sa_flags = SA_SIGINFO; + sigemptyset(&action.sa_mask); + sigaction(SIGSEGV, &action, &oldaction); + + if (_setjmp(trap_environment)) { + sigprocmask(SIG_SETMASK, &oldmask, NULL); + if (reading & !check_read) goto CONTINUE; + result = NO; + goto FINISH; + } + + for (p = address; p < end; p += page_size) { + reading = TRUE; + datum = *p; + if (access == PROT_NONE) { + result = NO; + goto FINISH; + } +CONTINUE: + reading = FALSE; + if (check_write) + *p = datum; + } + +FINISH: + sigaction(SIGSEGV, &oldaction, NULL); + return(result); +} +#endif + + +static caddr_t last_vma = NULL; +static int times = 0; +//hack - brad +//extern void DECODEFAULT(); +extern void *DECODEFAULT; + +/* Here on a seg-fault */ + +#if defined (OS_OSF) +void segv_handler (int sigval, int code, register struct sigcontext *scp) +{ + /* emperically derived knowledge: traparg_a0 is the faulting address */ + register uint64_t maybevma = (uint64_t) ((Tag *)scp->sc_traparg_a0 - TagSpace); + register Integer vma = (Integer) maybevma; + register VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + + if (maybevma >> 32) { + /* Not a fault in Lisp space */ + vpunt (NULL, "Unexpected SEGV at PC %lx on VMA %lx", scp->sc_pc, scp->sc_traparg_a0); + } + + if (last_vma == (caddr_t)scp->sc_traparg_a0) + { + if (++times > 10) + { + /* make genera bus-error */ + processor->vma = (uint64_t)vma; + scp->sc_pc = (int64_t)DECODEFAULT; + return; + } + } + else + { + last_vma = (caddr_t)scp->sc_traparg_a0; + times = 1; + } + + switch (attr & (fault_mask | VMAttribute_TransportDisable | VMAttribute_Exists)) + { + case VMAttribute_Exists: + case VMAttribute_Exists|VMAttribute_TransportDisable: + case VMAttribute_Exists|VMAttribute_TransportDisable|VMAttribute_TransportFault: + { + /* no Lisp fault, just note ephemeral and modified and retry */ + register PHTEntry *ptr = ResidentPagesPointer; + + *ptr = vma; + if (++ptr >= &ResidentPages[ResidentPages_Size]) + { + ResidentPagesWrap = TRUE; + ptr = ResidentPages; + } + ResidentPagesPointer = ptr; + + AdjustProtection(vma, attr|(VMAttribute_Ephemeral|VMAttribute_Modified)); + } + break; + + default: + /* verify that it is a Lisp fault */ + { + register int instn1= (*((int *)(scp->sc_pc)) >> 26) & 0x3f; + + if ((scp->sc_regs[14] != (int64_t)TagSpace) /* ivory register not TagSpace */ + || ((instn1 != 0x0B) && (instn1 != 0x0F))) /* not LDQ_U/STQ_U */ + { + /* Not a Lisp fault */ + vpunt (NULL, "Unexpected SEGV at PC %lx on VMA %lx instn=%x", + scp->sc_pc, scp->sc_traparg_a0, instn1); + } + } + + /* a true fault, advance the pc into the fault handler */ + processor->vma = (uint64_t)vma; + scp->sc_pc = (int64_t)DECODEFAULT; + } +} + +#elif defined(OS_LINUX) && defined(ARCH_PPC64) +#define OPCODE_MASK 0xFC000000 +#define OPCODE_LBZ 0x88000000 +#define OPCODE_STB 0x98000000 + +void segv_handler (int sigval, register siginfo_t *si, void *uc_p) +{ + register ucontext_t *uc = (ucontext_t*)uc_p; + register uint64_t maybevma = (uint64_t) ((Tag *)si->si_addr - TagSpace); + register Integer vma = (Integer) maybevma; + register VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + + if (maybevma >> 32) { + /* Not a fault in Lisp space */ + vpunt (NULL, "Unexpected SEGV at PC %p on VMA %p", (void*)uc->uc_mcontext.regs->nip, + si->si_addr); + } + + if (last_vma == (caddr_t)si->si_addr) + { + if (++times > 10) + { + /* make genera bus-error */ + processor->vma = (uint64_t)vma; + uc->uc_mcontext.regs->nip = (uint64_t)DECODEFAULT; + return; + } + } + else + { + last_vma = (caddr_t)si->si_addr; + times = 1; + } + + switch (attr & (fault_mask | VMAttribute_TransportDisable | VMAttribute_Exists)) + { + case VMAttribute_Exists: + case VMAttribute_Exists|VMAttribute_TransportDisable: + case VMAttribute_Exists|VMAttribute_TransportDisable|VMAttribute_TransportFault: + { + /* no Lisp fault, just note ephemeral and modified and retry */ + register PHTEntry *ptr = ResidentPagesPointer; + + *ptr = vma; + if (++ptr >= &ResidentPages[ResidentPages_Size]) + { + ResidentPagesWrap = TRUE; + ptr = ResidentPages; + } + ResidentPagesPointer = ptr; + + AdjustProtection(vma, attr|(VMAttribute_Ephemeral|VMAttribute_Modified)); + } + break; + + default: + /* verify that it is a Lisp fault */ + { + uint32_t instn= *(uint32_t*)uc->uc_mcontext.regs->nip; + register uint32_t instn1 = instn & OPCODE_MASK; + + if ((uc->uc_mcontext.regs->gpr[30] != (uint64_t)TagSpace) /* ivory register not TagSpace */ + || ((instn1 != OPCODE_LBZ) && (instn1 != OPCODE_STB))) /* not lbz or stb */ + { + /* Not a Lisp fault */ + vpunt (NULL, "Unexpected SEGV at PC %p (instn=%p) on VMA %p", + (void*)uc->uc_mcontext.regs->nip, (void*)(uint64_t)instn, si->si_addr); + } + } + + /* a true fault, advance the pc into the fault handler */ + processor->vma = (uint64_t)vma; + uc->uc_mcontext.regs->nip = (uint64_t)DECODEFAULT; + } +} + +#elif defined(OS_LINUX) && defined(ARCH_X86_64) + +void segv_handler (int sigval, register siginfo_t *si, void *uc_p) +{ +#define CALL_SIZE 50 + void *call_buffer[CALL_SIZE]; + register ucontext_t *uc = (ucontext_t*)uc_p; + register uint64_t maybevma = (uint64_t) ((Tag *)si->si_addr - TagSpace); + register Integer vma = (Integer) maybevma; + register int num_calls ; + register VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + + if (maybevma >> 32) { + /* Not a fault in Lisp space */ + vwarn (NULL, "Unexpected SEGV at PC %p on VMA %p", + (void*)uc->uc_mcontext.gregs[REG_RIP], + si->si_addr); + num_calls = backtrace( call_buffer, CALL_SIZE ); + fprintf( stderr, "backtrace returned %d symbols\n", num_calls ); + fprintf ( stderr, "backtrace: \n"); + backtrace_symbols_fd((void * const *)call_buffer, num_calls, 2); + exit (-1); + } + + if (last_vma == (caddr_t)si->si_addr) + { + if (++times > 10) + { + /* make genera bus-error */ + processor->vma = (uint64_t)vma; + uc->uc_mcontext.gregs[REG_RIP] = (uint64_t)DECODEFAULT; + return; + } + } + else + { + last_vma = (caddr_t)si->si_addr; + times = 1; + } + + switch (attr & (fault_mask | VMAttribute_TransportDisable | VMAttribute_Exists)) + { + case VMAttribute_Exists: + case VMAttribute_Exists|VMAttribute_TransportDisable: + case VMAttribute_Exists|VMAttribute_TransportDisable|VMAttribute_TransportFault: + { + /* no Lisp fault, just note ephemeral and modified and retry */ + register PHTEntry *ptr = ResidentPagesPointer; + + *ptr = vma; + if (++ptr >= &ResidentPages[ResidentPages_Size]) + { + ResidentPagesWrap = TRUE; + ptr = ResidentPages; + } + ResidentPagesPointer = ptr; + + AdjustProtection(vma, attr|(VMAttribute_Ephemeral|VMAttribute_Modified)); + } + break; + + default: + /* verify that it is a Lisp fault */ + { +// uint32_t instn= *(uint32_t*)uc->uc_mcontext.gregs[REG_RIP]; +// register uint32_t instn1 = instn & OPCODE_MASK; +// +// /* ivory register not TagSpace */ +// if ((uc->uc_mcontext.gregs[30] != (uint64_t)TagSpace) +// /* not lbz or stb */ +// || ((instn1 != OPCODE_LBZ) && (instn1 != OPCODE_STB))) +// { +// /* Not a Lisp fault */ +// vpunt (NULL, "Unexpected SEGV at PC %p (instn=%p) on VMA %p", +// (void*)uc->uc_mcontext.gregs[REG_RIP], +// (void*)(uint64_t)instn, si->si_addr); +// } + } + + /* a true fault, advance the pc into the fault handler */ + processor->vma = (uint64_t)vma; +//printf("RIP = DECODEFAULT #2 (old rip %p)\n", (void *)uc->uc_mcontext.gregs[REG_RIP]); + uc->uc_mcontext.gregs[REG_RIP] = (uint64_t)DECODEFAULT; +//printf("RIP = DECODEFAULT #2 (new rip %p)\n", (void *)DECODEFAULT); + } +} + +#elif defined(OS_DARWIN) +#define OPCODE_MASK 0xFC000000 +#define OPCODE_LBZ 0x88000000 +#define OPCODE_STB 0x98000000 + +void segv_handler (int sigval, register siginfo_t *si, void *uc_p) +{ + register ucontext_t *uc = (ucontext_t*)uc_p; + register uint64_t maybevma = (uint64_t) ((Tag *)uc->uc_mcontext->es.dar - TagSpace); + register Integer vma = (Integer) maybevma; + register VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + + if (maybevma >> 32) { + /* Not a fault in Lisp space */ + vpunt (NULL, "Unexpected SEGV at PC %p on VMA %p", + (void*)uc->uc_mcontext->ss.srr0, (void*)uc->uc_mcontext->es.dar); + } + + if (last_vma == (caddr_t)uc->uc_mcontext->es.dar) + { + if (++times > 10) + { + /* make genera bus-error */ + processor->vma = (uint64_t)vma; + uc->uc_mcontext->ss.srr0 = (uint64_t)DECODEFAULT; + return; + } + } + else + { + last_vma = (caddr_t)uc->uc_mcontext->es.dar; + times = 1; + } + + switch (attr & (fault_mask | VMAttribute_TransportDisable | VMAttribute_Exists)) + { + case VMAttribute_Exists: + case VMAttribute_Exists|VMAttribute_TransportDisable: + case VMAttribute_Exists|VMAttribute_TransportDisable|VMAttribute_TransportFault: + { + /* no Lisp fault, just note ephemeral and modified and retry */ + register PHTEntry *ptr = ResidentPagesPointer; + + *ptr = vma; + if (++ptr >= &ResidentPages[ResidentPages_Size]) + { + ResidentPagesWrap = TRUE; + ptr = ResidentPages; + } + ResidentPagesPointer = ptr; + + AdjustProtection(vma, attr|(VMAttribute_Ephemeral|VMAttribute_Modified)); + } + break; + + default: + /* verify that it is a Lisp fault */ + { + uint32_t instn= *(uint32_t *)uc->uc_mcontext->ss.srr0; + register uint32_t instn1 = instn & OPCODE_MASK; + + if ((uc->uc_mcontext->ss.r30 != (uint64_t)TagSpace) /* ivory register not TagSpace */ + || ((instn1 != OPCODE_LBZ) && (instn1 != OPCODE_STB))) /* not lbz or stb */ + { + /* Not a Lisp fault */ + vpunt (NULL, "Unexpected SEGV at PC %p (instn=%p) on VMA %p", + (void*)uc->uc_mcontext->ss.srr0, + (void*)instn, + (void*)uc->uc_mcontext->es.dar); + } + } + + /* a true fault, advance the pc into the fault handler */ + processor->vma = (uint64_t)vma; + uc->uc_mcontext->ss.srr0 = (uint64_t)DECODEFAULT; + } +} + +#elif defined(__FreeBSD__) + +void segv_handler (int sigval, register siginfo_t *si, void *uc_p) +{ + register struct __ucontext *uc = (struct __ucontext*)uc_p; + register uint64_t maybevma = (uint64_t) ((Tag *)si->si_addr - TagSpace); + register Integer vma = (Integer) maybevma; + register VMAttribute attr = VMAttributeTable[MemoryPageNumber(vma)]; + + if (maybevma >> 32) { + /* Not a fault in Lisp space */ + vpunt (NULL, "Unexpected SEGV at PC %p on VMA %p", + (void*)uc->uc_mcontext.mc_rip, + (void *)si->si_addr); + } + + if (last_vma == (caddr_t)si->si_addr) + { + if (++times > 10) + { + /* make genera bus-error */ + processor->vma = (uint64_t)vma; + uc->uc_mcontext.mc_rip = (uint64_t)DECODEFAULT; + return; + } + } + else + { + last_vma = (caddr_t)si->si_addr; + times = 1; + } + + switch (attr & (fault_mask | VMAttribute_TransportDisable | VMAttribute_Exists)) + { + case VMAttribute_Exists: + case VMAttribute_Exists|VMAttribute_TransportDisable: + case VMAttribute_Exists|VMAttribute_TransportDisable|VMAttribute_TransportFault: + { + /* no Lisp fault, just note ephemeral and modified and retry */ + register PHTEntry *ptr = ResidentPagesPointer; + + *ptr = vma; + if (++ptr >= &ResidentPages[ResidentPages_Size]) + { + ResidentPagesWrap = TRUE; + ptr = ResidentPages; + } + ResidentPagesPointer = ptr; + + AdjustProtection(vma, attr|(VMAttribute_Ephemeral|VMAttribute_Modified)); + } + break; + + default: + /* verify that it is a Lisp fault */ + { + uint32_t instn= *(uint32_t*)uc->uc_mcontext.mc_rip; +// register uint32_t instn1 = instn & OPCODE_MASK; +// +// /* ivory register not TagSpace */ +// if ((uc->uc_mcontext.gregs[30] != (uint64_t)TagSpace) +// /* not lbz or stb */ +// || ((instn1 != OPCODE_LBZ) && (instn1 != OPCODE_STB))) +// { +// /* Not a Lisp fault */ +// vpunt (NULL, "Unexpected SEGV at PC %p (instn=%p) on VMA %p", +// (void*)uc->uc_mcontext.gregs[REG_RIP], +// (void*)(uint64_t)instn, si->si_addr); +// } + } + + /* a true fault, advance the pc into the fault handler */ + processor->vma = (uint64_t)vma; +//printf("RIP = DECODEFAULT #2 (old rip %p)\n", (void *)uc->uc_mcontext.gregs[REG_RIP]); + uc->uc_mcontext.mc_rip = (uint64_t)DECODEFAULT; +//printf("RIP = DECODEFAULT #2 (new rip %p)\n", (void *)DECODEFAULT); + } +} + +#endif diff --git a/emulator/memory.h b/emulator/memory.h new file mode 100644 index 0000000..976a63e --- /dev/null +++ b/emulator/memory.h @@ -0,0 +1,114 @@ +/* -*- Mode:C -*- */ + +/* + For historical reasons, the VM accessors return -1 on failure and 0 on success + */ + +#ifndef _MEMORY_H +#define _MEMORY_H + +#include "aihead.h" +#include "ivoryrep.h" + +Integer EnsureVirtualAddress (Integer vma, Boolean faultp); +Integer EnsureVirtualAddressRange (Integer vma, int count, Boolean faultp); +Integer MapWorldLoad(Integer vma, int length, int worldfile, off_t dataoffset, off_t tagoffset); +Integer* MapVirtualAddressData (Integer vma); +Tag* MapVirtualAddressTag (Integer vma); +LispObj VirtualMemoryRead (Integer vma); +LispObj VirtualMemoryReadUncached (Integer vma); +void VirtualMemoryReadBlock (Integer vma, LispObj *object, int count); +void VirtualMemoryReadBlockUncached (Integer vma, LispObj *object, int count); +void VirtualMemoryWrite (Integer vma, LispObj object); +void VirtualMemoryWriteUncached (Integer vma, LispObj object); +void VirtualMemoryWriteBlock (Integer vma, LispObj *object, int count); +void VirtualMemoryWriteBlockUncached (Integer vma, LispObj *object, int count); +void VirtualMemoryWriteBlockConstant (Integer vma, LispObj object, int count, int increment); +void VirtualMemoryWriteBlockConstantUncached (Integer vma, LispObj object, int count, + int increment); + +#define ldb(ss,pp,source) ((int) (((source) >> (pp)) & ((1 << (ss)) - 1))) +#define dpb(field,ss,pp,background) ((((field) & ((1 << (ss)) - 1)) << (pp)) | ((background) & (~(((1 << (ss)) - 1) << (pp))))) + + +/* VLM virtual-memory "coprocessor" interface */ + +typedef unsigned char VMAttribute; + +extern Boolean EnableIDS; +extern VMAttribute VMAttributeTable[1<<(32-MemoryPage_AddressShift)]; + +#define VMAccessFault(a) ((a)&VMAttribute_AccessFault) +#define VMWriteFault(a) ((a)&VMAttribute_WriteFault) +#define VMTransportFault(a) ((a)&VMAttribute_TransportFault) +#define VMTransportDisable(a) ((a)&VMAttribute_TransportDisable) +#define VMEphemeral(a) ((a)&VMAttribute_Ephemeral) +#define VMModified(a) ((a)&VMAttribute_Modified) +#define VMExists(a) ((a)&VMAttribute_Exists) + +#define SetVMAccessFault(a) ((a)|=VMAttribute_AccessFault) +#define SetVMWriteFault(a) ((a)|=VMAttribute_WriteFault) +#define SetVMTransportFault(a) ((a)|=VMAttribute_TransportFault) +#define SetVMTransportDisable(a) ((a)|=VMAttribute_TransportDisable) +#define SetVMEphemeral(a) ((a)|=VMAttribute_Ephemeral) +#define SetVMModified(a) ((a)|=VMAttribute_Modified) +#define SetVMExists(a) ((a)|=VMAttribute_Exists) + +#define ClearVMAccessFault(a) ((a)&=~VMAttribute_AccessFault) +#define ClearVMWriteFault(a) ((a)&=~VMAttribute_WriteFault) +#define ClearVMTransportFault(a) ((a)&=~VMAttribute_TransportFault) +#define ClearVMTransportDisable(a) ((a)&=~VMAttribute_TransportDisable) +#define ClearVMEphemeral(a) ((a)&=~VMAttribute_Ephemeral) +#define ClearVMModified(a) ((a)&=~VMAttribute_Modified) +#define ClearVMExists(a) ((a)&=~VMAttribute_Exists) + +typedef enum _VMOpcode +{ + VMOpcodeLookup, /* reply is index */ + VMOpcodeCreate, + VMOpcodeDestroy, + + VMOpcodeReadAttributes, /* operand is index */ + VMOpcodeWriteAttributes, /* operand is index */ + + VMOpcodeFill, /* operand is increment (of fill data) */ + VMOpcodeSearch, /* operand is increment (of address) */ + VMOpcodeCopy, /* operand is memory-cycle? */ + + VMOpcodeScan, + VMOpcodeEnable, + VMOpcodePHTScan, + VMOpcodeCopyandForward, + VMOpcodeResidentScan, + VMOpcodeSearchType, + VMOpcodeSearchCDR +} VMOpcode; + +typedef enum _VMResultCode +{ + VMResultSuccess, + VMResultFailure +} VMResultCode; + +int VMCommand(int command); + +#define VMCommandOpcode(command) ((VMOpcode)ldb(13,19,command)) +#define VMCommandOperand(command) ((int)ldb(19,0,command)) + +#define SetVMReplyResult(reply,result) (dpb((int)(result?VMResultSuccess:VMResultFailure),13,19,reply)) + +typedef struct _VMState +{ + Integer CommandRegister; + Integer AddressRegister; + Integer ExtentRegister; + Integer AttributesRegister; + Integer DestinationRegister; + LispObj DataRegister; + Integer MaskRegisterLow; + Integer MaskRegisterHigh; +} VMState; + +extern VMState VM; + +#endif diff --git a/emulator/pfilt_wrapper.h b/emulator/pfilt_wrapper.h new file mode 100644 index 0000000..5afe39b --- /dev/null +++ b/emulator/pfilt_wrapper.h @@ -0,0 +1,41 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Kludge because these standard header files don't use #ifndef FILE/#define FILE convention */ + +#ifndef _PFILT_WRAPPER_ +#define _PFILT_WRAPPER_ + +#include +#include + +#include +#include +#include + +#if defined(OS_OSF) +#include +#define EmbNetFilter struct enfilter + +#elif defined(OS_LINUX) +#include +#include +#include +#include +#define N_FILTERS 6 +typedef struct + { + struct sock_fprog fprog; + struct sock_filter filters[N_FILTERS]; + } EmbNetFilter; + +#elif defined(__FreeBSD__) +#include +#define EmbNetFilter struct bpf_program +#define USE_LIBPCAP + +#elif defined(OS_DARWIN) +#include +#define EmbNetFilter struct bpf_program +#endif + +#endif diff --git a/emulator/support-sysdcl.lisp b/emulator/support-sysdcl.lisp new file mode 100644 index 0000000..21aa499 --- /dev/null +++ b/emulator/support-sysdcl.lisp @@ -0,0 +1,27 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + +(defsystem alpha-axp-emulator-support + (:pretty-name "Alpha AXP Emulator Support" + :default-pathname "VLM:ALPHA-EMULATOR;" + :maintain-journals t + :patchable t + :required-systems ("Alpha-axp-Assembler")) + (:module translator-support ("Alpha-AXP-Translator-Support") (:type :system)) + (:module definitions ("memoryem" "imaclist" "fcallmac" "imacbits" + "imacblok" "imaclexi" "imacgene" "imacinst" "imacialu" + "imacloop" "imacmath" "imacbind" "imacjosh" "imacarra" + "imacpred" "imacsubp" "imactrap")) + (:serial translator-support definitions)) + +(defsystem powerpc-emulator-support + (:pretty-name "PowerPC Emulator Support" + :default-pathname "VLM:G5-EMULATOR;" + :maintain-journals t + :patchable t + :required-systems ("PowerPC-Assembler")) + (:module translator-support ("PowerPC-Translator-Support") (:type :system)) + (:module definitions ("memoryem" "imaclist" "fcallmac" "imacbits" + "imacblok" "imaclexi" "imacgene" "imacinst" "imacialu" + "imacloop" "imacmath" "imacbind" "imacjosh" "imacarra" + "imacpred" "imacsubp" "imactrap")) + (:serial translator-support definitions)) diff --git a/emulator/sysdcl.lisp b/emulator/sysdcl.lisp new file mode 100644 index 0000000..e144f05 --- /dev/null +++ b/emulator/sysdcl.lisp @@ -0,0 +1,68 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + +(defsystem alpha-ivory-emulator + (:pretty-name "Alpha Ivory Emulator" + :default-pathname "VLM:EMULATOR;" + :default-destination-pathname "BETA:/home/beta/palter/VLM/emulator/" + :required-systems ("Alpha-Assembler") + :maintain-journals nil + :patchable nil) + (:module includes (("aistat.sid" "vlm:emulator;aistat.lisp") + ("aihead.sid" "vlm:emulator;aihead.lisp") + ("traps.sid" "vlm:emulator;traps.lisp")) + (:type :dsdl)) + (:module error-table (("errortbl" "vlm:emulator;errortbl"))) + (:module macros (("alphamac" "vlm:emulator;alphamac") + ("intrpmac" "vlm:emulator;intrpmac"))) + (:module definitions (("memoryem" "vlm:emulator;memoryem") + ("stacklis" "vlm:emulator;stacklis") + ("imaclist" "vlm:emulator;imaclist") + ("fcallmac" "vlm:emulator;fcallmac") + ("imacbits" "vlm:emulator;imacbits") + ("imacblok" "vlm:emulator;imacblok") + ("imaclexi" "vlm:emulator;imaclexi") + ("imacgene" "vlm:emulator;imacgene") + ("imacinst" "vlm:emulator;imacinst") + ("imacialu" "vlm:emulator;imacialu") + ("imacloop" "vlm:emulator;imacloop") + ("imacmath" "vlm:emulator;imacmath") + ("imacbind" "vlm:emulator;imacbind") + ("imacjosh" "vlm:emulator;imacjosh") + ("imacarra" "vlm:emulator;imacarra") + ("imacpred" "vlm:emulator;imacpred") + ("imacsubp" "vlm:emulator;imacsubp") + ("imactrap" "vlm:emulator;imactrap"))) + (:module h-files ("ivoryrep.h" + "asmfuns.h" + "memory.h") + (:type :copied-file)) + (:module c-files ("interfac.c" + "interpds.c" + "externals.c" + "memory.c") + (:type :copied-file)) + (:module s-files ("kludges.s") + (:type :copied-file)) + (:module emulator ("ifunhead.as" + "idispat.as" + "ifunarra.as" + "ifunbind.as" + "ifunbits.as" + "ifunblok.as" + "ifunbnum.as" + "ifunfcal.as" + "ifunfext.as" + "ifunfull.as" + "ifungene.as" + "ifuninst.as" + "ifunjosh.as" + "ifunlexi.as" + "ifunlist.as" + "ifunloop.as" + "ifunmath.as" + "ifunmove.as" + "ifunpred.as" + "ifunsubp.as" + "ifuntrap.as") + (:type :alpha-assembly)) + (:serial includes error-table macros definitions h-files c-files s-files emulator)) diff --git a/emulator/testfunction.h b/emulator/testfunction.h new file mode 100644 index 0000000..5109576 --- /dev/null +++ b/emulator/testfunction.h @@ -0,0 +1,13 @@ + +#define TESTFCNLENGTH 9 +int TESTFCN [TESTFCNLENGTH][3] = { + { 0x03, 0x30, 0x0009FC02 }, + { 0x00, 0x34, 0x0C0D0301 }, + { 0x00, 0x33, 0x201C7003 }, + { 0x00, 0x38, 0x200D0002 }, + { 0x00, 0x3C, 0x1C078002 }, + { 0x00, 0x33, 0x9FEC7003 }, + { 0x00, 0x32, 0xF001A6FE }, + { 0x03, 0x3E, 0x1BFD1300 }, + { 01, 000, 0 } /* End of compiled code */ +}; diff --git a/emulator/traps.c b/emulator/traps.c new file mode 100644 index 0000000..b2f4b71 --- /dev/null +++ b/emulator/traps.c @@ -0,0 +1,4 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;traps.sid Any changes made to it will be lost. */ + + diff --git a/emulator/traps.h b/emulator/traps.h new file mode 100644 index 0000000..74f8209 --- /dev/null +++ b/emulator/traps.h @@ -0,0 +1,95 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;traps.sid Any changes made to it will be lost. */ + +#ifndef _TRAPS_ +#define _TRAPS_ + + + +#define TrapVector_StackOverflow 2627 + +#define TrapVector_InstructionException 2048 + +#define TrapVector_ArithmeticInstructionException 0 + +#define TrapVector_Error 2624 + +#define TrapVector_Reset 2625 + +#define TrapVector_PullApplyArgs 2626 + +#define TrapVector_Trace 2628 + +#define TrapVector_PreemptRequest 2629 + +#define TrapVector_LowPrioritySequenceBreak 2632 + +#define TrapVector_HighPrioritySequenceBreak 2633 + +#define TrapVector_DBUnwindFrame 2646 + +#define TrapVector_DBUnwindCatch 2647 + +#define TrapVector_Transport 2630 + +#define TrapVector_Monitor 2634 + +#define TrapVector_PageNotResident 2640 + +#define TrapVector_PageFaultRequest 2641 + +#define TrapVector_PageWriteFault 2642 + +#define TrapVector_UncorrectableMemoryError 2643 + +#define TrapVector_MemoryBusError 2644 + +#define TrapVector_DBCacheMiss 2645 + +#define TrapMeter_StackOverflow 0 + +#define TrapMeter_InstructionException 1 + +#define TrapMeter_ArithmeticInstructionException 2 + +#define TrapMeter_Error 3 + +#define TrapMeter_Reset 4 + +#define TrapMeter_PullApplyArgs 5 + +#define TrapMeter_Trace 6 + +#define TrapMeter_PreemptRequest 7 + +#define TrapMeter_LowPrioritySequenceBreak 8 + +#define TrapMeter_HighPrioritySequenceBreak 9 + +#define TrapMeter_DBUnwindFrame 10 + +#define TrapMeter_DBUnwindCatch 11 + +#define TrapMeter_Transport 12 + +#define TrapMeter_Monitor 13 + +#define TrapMeter_PageNotResident 14 + +#define TrapMeter_PageFaultRequest 15 + +#define TrapMeter_PageWriteFault 16 + +#define TrapMeter_UncorrectableMemoryError 17 + +#define TrapMeter_MemoryBusError 18 + +#define TrapMeter_DBCacheMiss 19 + +#define TrapMeter_NEntries 20 +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;traps.sid Any changes made to it will be lost. */ + +#endif + + diff --git a/emulator/traps.lisp b/emulator/traps.lisp new file mode 100644 index 0000000..2480d59 --- /dev/null +++ b/emulator/traps.lisp @@ -0,0 +1,133 @@ +;;; -*- Mode: LISP; Package: ALPHA-AXP-INTERNALS; Base: 10; Syntax: Common-Lisp; -*- +;;; +;;; WARNING!! DO NOT MODIFY THIS FILE! +;;; It was automatically generated from vlm:emulator;traps.sid. Any changes made to it will be lost. + +#+Alpha-AXP-Emulator +(in-package "ALPHA-AXP-INTERNALS") + +#+PowerPC-Emulator +(in-package "POWERPC-INTERNALS") + +(defconstant |trapvector|$k-|stackoverflow| 2627) +(defconstant |TrapVectorStackOverflow| 2627) + +(defconstant |trapvector|$k-|instructionexception| 2048) +(defconstant |TrapVectorInstructionException| 2048) + +(defconstant |trapvector|$k-|arithmeticinstructionexception| 0) +(defconstant |TrapVectorArithmeticInstructionException| 0) + +(defconstant |trapvector|$k-|error| 2624) +(defconstant |TrapVectorError| 2624) + +(defconstant |trapvector|$k-|reset| 2625) +(defconstant |TrapVectorReset| 2625) + +(defconstant |trapvector|$k-|pullapplyargs| 2626) +(defconstant |TrapVectorPullApplyArgs| 2626) + +(defconstant |trapvector|$k-|trace| 2628) +(defconstant |TrapVectorTrace| 2628) + +(defconstant |trapvector|$k-|preemptrequest| 2629) +(defconstant |TrapVectorPreemptRequest| 2629) + +(defconstant |trapvector|$k-|lowprioritysequencebreak| 2632) +(defconstant |TrapVectorLowPrioritySequenceBreak| 2632) + +(defconstant |trapvector|$k-|highprioritysequencebreak| 2633) +(defconstant |TrapVectorHighPrioritySequenceBreak| 2633) + +(defconstant |trapvector|$k-|dbunwindframe| 2646) +(defconstant |TrapVectorDBUnwindFrame| 2646) + +(defconstant |trapvector|$k-|dbunwindcatch| 2647) +(defconstant |TrapVectorDBUnwindCatch| 2647) + +(defconstant |trapvector|$k-|transport| 2630) +(defconstant |TrapVectorTransport| 2630) + +(defconstant |trapvector|$k-|monitor| 2634) +(defconstant |TrapVectorMonitor| 2634) + +(defconstant |trapvector|$k-|pagenotresident| 2640) +(defconstant |TrapVectorPageNotResident| 2640) + +(defconstant |trapvector|$k-|pagefaultrequest| 2641) +(defconstant |TrapVectorPageFaultRequest| 2641) + +(defconstant |trapvector|$k-|pagewritefault| 2642) +(defconstant |TrapVectorPageWriteFault| 2642) + +(defconstant |trapvector|$k-|uncorrectablememoryerror| 2643) +(defconstant |TrapVectorUncorrectableMemoryError| 2643) + +(defconstant |trapvector|$k-|memorybuserror| 2644) +(defconstant |TrapVectorMemoryBusError| 2644) + +(defconstant |trapvector|$k-|dbcachemiss| 2645) +(defconstant |TrapVectorDBCacheMiss| 2645) + +(defconstant |trapmeter|$k-|stackoverflow| 0) +(defconstant |TrapMeterStackOverflow| 0) + +(defconstant |trapmeter|$k-|instructionexception| 1) +(defconstant |TrapMeterInstructionException| 1) + +(defconstant |trapmeter|$k-|arithmeticinstructionexception| 2) +(defconstant |TrapMeterArithmeticInstructionException| 2) + +(defconstant |trapmeter|$k-|error| 3) +(defconstant |TrapMeterError| 3) + +(defconstant |trapmeter|$k-|reset| 4) +(defconstant |TrapMeterReset| 4) + +(defconstant |trapmeter|$k-|pullapplyargs| 5) +(defconstant |TrapMeterPullApplyArgs| 5) + +(defconstant |trapmeter|$k-|trace| 6) +(defconstant |TrapMeterTrace| 6) + +(defconstant |trapmeter|$k-|preemptrequest| 7) +(defconstant |TrapMeterPreemptRequest| 7) + +(defconstant |trapmeter|$k-|lowprioritysequencebreak| 8) +(defconstant |TrapMeterLowPrioritySequenceBreak| 8) + +(defconstant |trapmeter|$k-|highprioritysequencebreak| 9) +(defconstant |TrapMeterHighPrioritySequenceBreak| 9) + +(defconstant |trapmeter|$k-|dbunwindframe| 10) +(defconstant |TrapMeterDBUnwindFrame| 10) + +(defconstant |trapmeter|$k-|dbunwindcatch| 11) +(defconstant |TrapMeterDBUnwindCatch| 11) + +(defconstant |trapmeter|$k-|transport| 12) +(defconstant |TrapMeterTransport| 12) + +(defconstant |trapmeter|$k-|monitor| 13) +(defconstant |TrapMeterMonitor| 13) + +(defconstant |trapmeter|$k-|pagenotresident| 14) +(defconstant |TrapMeterPageNotResident| 14) + +(defconstant |trapmeter|$k-|pagefaultrequest| 15) +(defconstant |TrapMeterPageFaultRequest| 15) + +(defconstant |trapmeter|$k-|pagewritefault| 16) +(defconstant |TrapMeterPageWriteFault| 16) + +(defconstant |trapmeter|$k-|uncorrectablememoryerror| 17) +(defconstant |TrapMeterUncorrectableMemoryError| 17) + +(defconstant |trapmeter|$k-|memorybuserror| 18) +(defconstant |TrapMeterMemoryBusError| 18) + +(defconstant |trapmeter|$k-|dbcachemiss| 19) +(defconstant |TrapMeterDBCacheMiss| 19) + +(defconstant |trapmeter|$k-|nentries| 20) +(defconstant |TrapMeterNEntries| 20) diff --git a/emulator/traps.s b/emulator/traps.s new file mode 100644 index 0000000..782b3ac --- /dev/null +++ b/emulator/traps.s @@ -0,0 +1,85 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:emulator;traps.sid. Any changes made to it will be lost. */ + + +TrapVectorStackOverflow = 0xA43 + +TrapVectorInstructionException = 0x800 + +TrapVectorArithmeticInstructionException = 0x0 + +TrapVectorError = 0xA40 + +TrapVectorReset = 0xA41 + +TrapVectorPullApplyArgs = 0xA42 + +TrapVectorTrace = 0xA44 + +TrapVectorPreemptRequest = 0xA45 + +TrapVectorLowPrioritySequenceBreak = 0xA48 + +TrapVectorHighPrioritySequenceBreak = 0xA49 + +TrapVectorDBUnwindFrame = 0xA56 + +TrapVectorDBUnwindCatch = 0xA57 + +TrapVectorTransport = 0xA46 + +TrapVectorMonitor = 0xA4A + +TrapVectorPageNotResident = 0xA50 + +TrapVectorPageFaultRequest = 0xA51 + +TrapVectorPageWriteFault = 0xA52 + +TrapVectorUncorrectableMemoryError = 0xA53 + +TrapVectorMemoryBusError = 0xA54 + +TrapVectorDBCacheMiss = 0xA55 + +TrapMeterStackOverflow = 0x0 + +TrapMeterInstructionException = 0x1 + +TrapMeterArithmeticInstructionException = 0x2 + +TrapMeterError = 0x3 + +TrapMeterReset = 0x4 + +TrapMeterPullApplyArgs = 0x5 + +TrapMeterTrace = 0x6 + +TrapMeterPreemptRequest = 0x7 + +TrapMeterLowPrioritySequenceBreak = 0x8 + +TrapMeterHighPrioritySequenceBreak = 0x9 + +TrapMeterDBUnwindFrame = 0xA + +TrapMeterDBUnwindCatch = 0xB + +TrapMeterTransport = 0xC + +TrapMeterMonitor = 0xD + +TrapMeterPageNotResident = 0xE + +TrapMeterPageFaultRequest = 0xF + +TrapMeterPageWriteFault = 0x10 + +TrapMeterUncorrectableMemoryError = 0x11 + +TrapMeterMemoryBusError = 0x12 + +TrapMeterDBCacheMiss = 0x13 + +TrapMeterNEntries = 0x14 diff --git a/emulator/traps.sid b/emulator/traps.sid new file mode 100644 index 0000000..fe7a530 --- /dev/null +++ b/emulator/traps.sid @@ -0,0 +1,53 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(define-values |TrapVector| + ;; The post traps + (|StackOverflow| #o5103) + (|InstructionException| #o4000) + (|ArithmeticInstructionException| #o0) + + ;; The pre traps + (|Error| #o5100) + (|Reset| #o5101) + (|PullApplyArgs| #o5102) + (|Trace| #o5104) + (|PreemptRequest| #o5105) + (|LowPrioritySequenceBreak| #o5110) + (|HighPrioritySequenceBreak| #o5111) + (|DBUnwindFrame| #o5126) + (|DBUnwindCatch| #o5127) + + ;; The memory traps + (|Transport| #o5106) + (|Monitor| #o5112) + (|PageNotResident| #o5120) + (|PageFaultRequest| #o5121) + (|PageWriteFault| #o5122) + (|UncorrectableMemoryError| #o5123) + (|MemoryBusError| #o5124) + (|DBCacheMiss| #o5125)) + + +;; This matches the order of the above, but the values are different +(define-values |TrapMeter| + (|StackOverflow| 0) + (|InstructionException| 1) + (|ArithmeticInstructionException| 2) + (|Error| 3) + (|Reset| 4) + (|PullApplyArgs| 5) + (|Trace| 6) + (|PreemptRequest| 7) + (|LowPrioritySequenceBreak| 8) + (|HighPrioritySequenceBreak| 9) + (|DBUnwindFrame| 10) + (|DBUnwindCatch| 11) + (|Transport| 12) + (|Monitor| 13) + (|PageNotResident| 14) + (|PageFaultRequest| 15) + (|PageWriteFault| 16) + (|UncorrectableMemoryError| 17) + (|MemoryBusError| 18) + (|DBCacheMiss| 19) + (|NEntries| 20)) diff --git a/emulator/usagedatarpt.lisp b/emulator/usagedatarpt.lisp new file mode 100644 index 0000000..b84cb0d --- /dev/null +++ b/emulator/usagedatarpt.lisp @@ -0,0 +1,11 @@ +;;; -*- Package: CL-USER; Base: 10 -*- + +(declare (special *iusedata* *itotalused*)) + +(defun report-on-usage-data (&optional (path "usagereport.text")) + (with-open-file (report path :direction :output) + (let ((sorteddata (setq *iusedata* (cl:sort *iusedata* #'> :key #'cadr)))) + (dolist (item sorteddata) + (destructuring-bind (name usage) item + (format report "~a ~d/~d = ~a%~%" + name usage *itotalused* (* 100.0 (/ (* 1.0 usage) *itotalused*)))))))) diff --git a/g5-build.lisp b/g5-build.lisp new file mode 100644 index 0000000..0422f8b --- /dev/null +++ b/g5-build.lisp @@ -0,0 +1,4 @@ +(load "compile-g5-emulator.lisp") +(build) +(quit) + diff --git a/g5-emulator/aistat.c b/g5-emulator/aistat.c new file mode 100644 index 0000000..4c48470 --- /dev/null +++ b/g5-emulator/aistat.c @@ -0,0 +1,4 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:g5-emulator;aistat.sid Any changes made to it will be lost. */ + + diff --git a/g5-emulator/aistat.h b/g5-emulator/aistat.h new file mode 100644 index 0000000..392cb8f --- /dev/null +++ b/g5-emulator/aistat.h @@ -0,0 +1,314 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:g5-emulator;aistat.sid Any changes made to it will be lost. */ + +#ifndef _AISTAT_ +#define _AISTAT_ + + + +typedef struct processorstate { + uint64_t transpare3; + uint64_t transpare2; + uint64_t transpare1; + uint64_t carcdrsubroutine; + uint64_t cdrsubroutine; + uint64_t carsubroutine; + uint64_t linkage; + uint64_t resumeema; + char *statistics; + char *trace_hook; + int64_t instruction_count; + uint64_t iinterpret_sp; + uint64_t scratch0; + uint64_t scratch1; + uint64_t scratch2; + uint64_t scratch3; + uint64_t scratch4; + uint64_t scratch5; + uint64_t scratch6; + uint64_t scratch7; + char *meterdatabuff; + uint32_t meterpos; + uint32_t metermax; + uint32_t meterfreq; + uint32_t metermask; + uint32_t metervalue; + uint32_t metercount; + uint64_t choiceptr; + uint64_t sstkchoiceptr; + uint64_t dbcbase; + uint64_t dbcmask; + char *coprocessorreadhook; + char *coprocessorwritehook; + char *flushcaches_hook; + char *i_stage_error_hook; + uint64_t sfp1; + uint64_t fp0; + uint64_t fp1; + uint64_t floating_exception; + uint64_t aluandrotatecontrol; + uint64_t rotatelatch; + uint64_t aluborrow; + uint64_t aluoverflow; + uint64_t alulessthan; + uint64_t aluop; + uint64_t byterotate; + uint64_t bytesize; + int64_t bindingstacklimit; + int64_t bindingstackpointer; + uint64_t catchblock; + uint64_t extraandcatch; + uint64_t msclockcache; + uint64_t ticksperms; + uint64_t previoustb; + char *rlink; + uint32_t interruptreg; + uint32_t zoneoldspace; + uint32_t ephemeraloldspace; + uint32_t int_pad0; + uint64_t eqnoteql; + uint32_t lclength; + uint32_t sclength; + uint64_t lcarea; + uint64_t lcaddress; + uint64_t scarea; + uint64_t scaddress; + uint64_t restartsp; + uint64_t stop_interpreter; + uint64_t immediate_arg; + uint64_t continuationcp; + int64_t continuation; + int64_t control; + int64_t niladdress; + int64_t taddress; + int64_t bar0; + int64_t bar1; + int64_t bar2; + int64_t bar3; + int64_t epc; + int64_t fp; + int64_t lp; + int64_t sp; + char *cp; + uint64_t fccrmask; + uint32_t cslimit; + uint32_t csextralimit; + char *trapmeterdata; + uint64_t fepmodetrapvecaddress; + uint64_t trapvecbase; + uint64_t tvi; + uint64_t fccrtrapmask; + char *ptrtype; + char *vmattributetable; + uint64_t vma; + int64_t mostnegativefixnum; + char *icachebase; + char *endicache; + uint64_t fullworddispatch; + uint64_t halfworddispatch; + int64_t areventcount; + uint64_t stackcachesize; + uint64_t stackcachetopvma; + uint64_t cdrcodemask; + char *stackcachedata; + uint64_t stackcachebasevma; + uint32_t scovlimit; + uint32_t scovdumpcount; + int64_t mostpositivefixnum; + uint64_t internalregisterread1; + uint64_t internalregisterread2; + uint64_t internalregisterwrite1; + uint64_t internalregisterwrite2; + uint64_t dataread_mask; + char *dataread; + uint64_t datawrite_mask; + char *datawrite; + uint64_t bindread_mask; + char *bindread; + uint64_t bindwrite_mask; + char *bindwrite; + uint64_t bindreadnomonitor_mask; + char *bindreadnomonitor; + uint64_t bindwritenomonitor_mask; + char *bindwritenomonitor; + uint64_t header_mask; + char *header; + uint64_t structureoffset_mask; + char *structureoffset; + uint64_t scavenge_mask; + char *scavenge; + uint64_t cdr_mask; + char *cdr; + uint64_t gccopy_mask; + char *gccopy; + uint64_t raw_mask; + char *raw; + uint64_t rawtranslate_mask; + char *rawtranslate; + int32_t please_stop; + int32_t please_trap; + int64_t runningp; + uint64_t ac0array; + uint64_t ac0arword; + uint64_t ac0locat; + uint64_t ac0length; + uint64_t ac1array; + uint64_t ac1arword; + uint64_t ac1locat; + uint64_t ac1length; + uint64_t ac2array; + uint64_t ac2arword; + uint64_t ac2locat; + uint64_t ac2length; + uint64_t ac3array; + uint64_t ac3arword; + uint64_t ac3locat; + uint64_t ac3length; + uint64_t ac4array; + uint64_t ac4arword; + uint64_t ac4locat; + uint64_t ac4length; + uint64_t ac5array; + uint64_t ac5arword; + uint64_t ac5locat; + uint64_t ac5length; + uint64_t ac6array; + uint64_t ac6arword; + uint64_t ac6locat; + uint64_t ac6length; + uint64_t ac7array; + uint64_t ac7arword; + uint64_t ac7locat; + uint64_t ac7length; + uint32_t tmcurrenttransaction; + uint32_t tmwritestart; + uint32_t tmwritecurrent; + uint32_t tmwritelimit; + uint32_t tmrecordingreads; + uint32_t tmreadstart; + uint32_t tmreadcurrent; + uint32_t tmreadlimit; + } PROCESSORSTATE, *PROCESSORSTATEP; + +#define PROCESSORSTATE_SIZE 1344 + +typedef struct cacheline { + uint64_t annotation; + uint32_t nextpcdata; + uint32_t nextpctag; + char *nextcp; + uint32_t instruction; + uint32_t operand; + uint32_t pcdata; + uint32_t pctag; + char *code; + } CACHELINE, *CACHELINEP; + +#define CACHELINE_SIZE 48 + +#define CacheLine_Bits 18 + +#define CacheLine_Mask 262143 + +#define CacheLine_RShift 16 + +#define CacheLine_LShift 6 + +#define CacheLine_FillAmount 20 + +typedef struct arraycache { + uint64_t array; + uint64_t arword; + uint64_t locat; + uint64_t length; + } ARRAYCACHE, *ARRAYCACHEP; + +#define AutoArrayReg_Mask 224 + +#define AutoArrayReg_Size 32 + +#define AutoArrayReg_Shift 0 + +#define MSclock_UnitsToMSShift 0 + +#define MSclock_UnitsPerMicrosecond 1 + +#define Stack_CacheSize 1792 + +#define Stack_MaxFrameSize 128 + +#define Stack_CacheMargin 128 + +#define Stack_CacheDumpQuantum 896 + +#define IvoryMemory_Data 38 + +#define IvoryMemory_Tag 36 + +typedef struct savedregisters { + uint64_t r9; + uint64_t r10; + uint64_t r11; + uint64_t r12; + uint64_t r13; + uint64_t r14; + uint64_t r15; + uint64_t r29; + uint64_t f2; + uint64_t f3; + uint64_t f4; + uint64_t f5; + uint64_t f6; + uint64_t f7; + uint64_t f8; + uint64_t f9; + } SAVEDREGISTERS, *SAVEDREGISTERSP; + +#define SAVEDREGISTERS_SIZE 128 + +typedef struct tracedata { + uint64_t n_entries; + uint32_t recording_p; + uint32_t wrap_p; + uint64_t start_pc; + uint64_t stop_pc; + char *records_start; + char *records_end; + char *current_entry; + char *printer; + } TRACEDATA, *TRACEDATAP; + +#define TRACEDATA_SIZE 64 + +typedef struct tracerecord { + uint64_t counter; + uint64_t epc; + uint64_t tos; + uint64_t sp; + char *instruction; + uint64_t instruction_data; + uint32_t operand; + uint32_t trap_p; + uint64_t trap_data_0; + uint64_t trap_data_1; + uint64_t trap_data_2; + uint64_t trap_data_3; + uint32_t catch_block_p; + uint32_t int_pad0; + uint64_t catch_block_0; + uint64_t catch_block_1; + uint64_t catch_block_2; + uint64_t catch_block_3; + } TRACERECORD, *TRACERECORDP; + +#define TRACERECORD_SIZE 128 + +#define CacheMeter_Pwr 14 + +#define CacheMeter_DefaultFreq 1000 +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:g5-emulator;aistat.sid Any changes made to it will be lost. */ + +#endif + + diff --git a/g5-emulator/aistat.lisp b/g5-emulator/aistat.lisp new file mode 100644 index 0000000..e2c7175 --- /dev/null +++ b/g5-emulator/aistat.lisp @@ -0,0 +1,334 @@ +;;; -*- Mode: LISP; Package: POWERPC-INTERNALS; Base: 10; Syntax: Common-Lisp; -*- +;;; +;;; WARNING!! DO NOT MODIFY THIS FILE! +;;; It was automatically generated from vlm:g5-emulator;aistat.sid. Any changes made to it will be lost. + +#+Alpha-AXP-Emulator +(in-package "ALPHA-AXP-INTERNALS") + +#+PowerPC-Emulator +(in-package "POWERPC-INTERNALS") + + +;;; Structure PROCESSORSTATE +(defconstant processorstate$q-transpare3 -1344) +(defconstant processorstate$q-transpare2 -1336) +(defconstant processorstate$q-transpare1 -1328) +(defconstant processorstate$q-carcdrsubroutine -1320) +(defconstant processorstate$q-cdrsubroutine -1312) +(defconstant processorstate$q-carsubroutine -1304) +(defconstant processorstate$q-linkage -1296) +(defconstant processorstate$q-resumeema -1288) +(defconstant processorstate$p-statistics -1280) +(defconstant processorstate$p-trace-hook -1272) +(defconstant processorstate$q-instruction-count -1264) +(defconstant processorstate$q-iinterpret-sp -1256) +(defconstant processorstate$q-scratch0 -1248) +(defconstant processorstate$q-scratch1 -1240) +(defconstant processorstate$q-scratch2 -1232) +(defconstant processorstate$q-scratch3 -1224) +(defconstant processorstate$q-scratch4 -1216) +(defconstant processorstate$q-scratch5 -1208) +(defconstant processorstate$q-scratch6 -1200) +(defconstant processorstate$q-scratch7 -1192) +(defconstant processorstate$p-meterdatabuff -1184) +(defconstant processorstate$l-meterpos -1176) +(defconstant processorstate$l-metermax -1172) +(defconstant processorstate$l-meterfreq -1168) +(defconstant processorstate$l-metermask -1164) +(defconstant processorstate$l-metervalue -1160) +(defconstant processorstate$l-metercount -1156) +(defconstant processorstate$q-choiceptr -1152) +(defconstant processorstate$q-sstkchoiceptr -1144) +(defconstant processorstate$q-dbcbase -1136) +(defconstant processorstate$q-dbcmask -1128) +(defconstant processorstate$p-coprocessorreadhook -1120) +(defconstant processorstate$p-coprocessorwritehook -1112) +(defconstant processorstate$p-flushcaches-hook -1104) +(defconstant processorstate$p-i-stage-error-hook -1096) +(defconstant processorstate$q-sfp1 -1088) +(defconstant processorstate$q-fp0 -1080) +(defconstant processorstate$q-fp1 -1072) +(defconstant processorstate$q-floating-exception -1064) +(defconstant processorstate$q-aluandrotatecontrol -1056) +(defconstant processorstate$q-rotatelatch -1048) +(defconstant processorstate$q-aluborrow -1040) +(defconstant processorstate$q-aluoverflow -1032) +(defconstant processorstate$q-alulessthan -1024) +(defconstant processorstate$q-aluop -1016) +(defconstant processorstate$q-byterotate -1008) +(defconstant processorstate$q-bytesize -1000) +(defconstant processorstate$q-bindingstacklimit -992) +(defconstant processorstate$q-bindingstackpointer -984) +(defconstant processorstate$q-catchblock -976) +(defconstant processorstate$q-extraandcatch -968) +(defconstant processorstate$q-msclockcache -960) +(defconstant processorstate$q-ticksperms -952) +(defconstant processorstate$q-previoustb -944) +(defconstant processorstate$p-rlink -936) +(defconstant processorstate$l-interruptreg -928) +(defconstant processorstate$l-zoneoldspace -924) +(defconstant processorstate$l-ephemeraloldspace -920) +(defconstant processorstate$l-int-pad0 -916) +(defconstant processorstate$q-eqnoteql -912) +(defconstant processorstate$l-lclength -904) +(defconstant processorstate$l-sclength -900) +(defconstant processorstate$q-lcarea -896) +(defconstant processorstate$q-lcaddress -888) +(defconstant processorstate$q-scarea -880) +(defconstant processorstate$q-scaddress -872) +(defconstant processorstate$q-restartsp -864) +(defconstant processorstate$q-stop-interpreter -856) +(defconstant processorstate$q-immediate-arg -848) +(defconstant processorstate$q-continuationcp -840) +(defconstant processorstate$q-continuation -832) +(defconstant processorstate$q-control -824) +(defconstant processorstate$q-niladdress -816) +(defconstant processorstate$q-taddress -808) +(defconstant processorstate$q-bar0 -800) +(defconstant processorstate$q-bar1 -792) +(defconstant processorstate$q-bar2 -784) +(defconstant processorstate$q-bar3 -776) +(defconstant processorstate$q-epc -768) +(defconstant processorstate$q-fp -760) +(defconstant processorstate$q-lp -752) +(defconstant processorstate$q-sp -744) +(defconstant processorstate$p-cp -736) +(defconstant processorstate$q-fccrmask -728) +(defconstant processorstate$l-cslimit -720) +(defconstant processorstate$l-csextralimit -716) +(defconstant processorstate$p-trapmeterdata -712) +(defconstant processorstate$q-fepmodetrapvecaddress -704) +(defconstant processorstate$q-trapvecbase -696) +(defconstant processorstate$q-tvi -688) +(defconstant processorstate$q-fccrtrapmask -680) +(defconstant processorstate$p-ptrtype -672) +(defconstant processorstate$p-vmattributetable -664) +(defconstant processorstate$q-vma -656) +(defconstant processorstate$q-mostnegativefixnum -648) +(defconstant processorstate$p-icachebase -640) +(defconstant processorstate$p-endicache -632) +(defconstant processorstate$q-fullworddispatch -624) +(defconstant processorstate$q-halfworddispatch -616) +(defconstant processorstate$q-areventcount -608) +(defconstant processorstate$q-stackcachesize -600) +(defconstant processorstate$q-stackcachetopvma -592) +(defconstant processorstate$q-cdrcodemask -584) +(defconstant processorstate$p-stackcachedata -576) +(defconstant processorstate$q-stackcachebasevma -568) +(defconstant processorstate$l-scovlimit -560) +(defconstant processorstate$l-scovdumpcount -556) +(defconstant processorstate$q-mostpositivefixnum -552) +(defconstant processorstate$q-internalregisterread1 -544) +(defconstant processorstate$q-internalregisterread2 -536) +(defconstant processorstate$q-internalregisterwrite1 -528) +(defconstant processorstate$q-internalregisterwrite2 -520) +(defconstant processorstate$q-dataread-mask -512) +(defconstant processorstate$p-dataread -504) +(defconstant processorstate$q-datawrite-mask -496) +(defconstant processorstate$p-datawrite -488) +(defconstant processorstate$q-bindread-mask -480) +(defconstant processorstate$p-bindread -472) +(defconstant processorstate$q-bindwrite-mask -464) +(defconstant processorstate$p-bindwrite -456) +(defconstant processorstate$q-bindreadnomonitor-mask -448) +(defconstant processorstate$p-bindreadnomonitor -440) +(defconstant processorstate$q-bindwritenomonitor-mask -432) +(defconstant processorstate$p-bindwritenomonitor -424) +(defconstant processorstate$q-header-mask -416) +(defconstant processorstate$p-header -408) +(defconstant processorstate$q-structureoffset-mask -400) +(defconstant processorstate$p-structureoffset -392) +(defconstant processorstate$q-scavenge-mask -384) +(defconstant processorstate$p-scavenge -376) +(defconstant processorstate$q-cdr-mask -368) +(defconstant processorstate$p-cdr -360) +(defconstant processorstate$q-gccopy-mask -352) +(defconstant processorstate$p-gccopy -344) +(defconstant processorstate$q-raw-mask -336) +(defconstant processorstate$p-raw -328) +(defconstant processorstate$q-rawtranslate-mask -320) +(defconstant processorstate$p-rawtranslate -312) +(defconstant processorstate$l-please-stop -304) +(defconstant processorstate$l-please-trap -300) +(defconstant processorstate$q-runningp -296) +(defconstant processorstate$q-ac0array -288) +(defconstant processorstate$q-ac0arword -280) +(defconstant processorstate$q-ac0locat -272) +(defconstant processorstate$q-ac0length -264) +(defconstant processorstate$q-ac1array -256) +(defconstant processorstate$q-ac1arword -248) +(defconstant processorstate$q-ac1locat -240) +(defconstant processorstate$q-ac1length -232) +(defconstant processorstate$q-ac2array -224) +(defconstant processorstate$q-ac2arword -216) +(defconstant processorstate$q-ac2locat -208) +(defconstant processorstate$q-ac2length -200) +(defconstant processorstate$q-ac3array -192) +(defconstant processorstate$q-ac3arword -184) +(defconstant processorstate$q-ac3locat -176) +(defconstant processorstate$q-ac3length -168) +(defconstant processorstate$q-ac4array -160) +(defconstant processorstate$q-ac4arword -152) +(defconstant processorstate$q-ac4locat -144) +(defconstant processorstate$q-ac4length -136) +(defconstant processorstate$q-ac5array -128) +(defconstant processorstate$q-ac5arword -120) +(defconstant processorstate$q-ac5locat -112) +(defconstant processorstate$q-ac5length -104) +(defconstant processorstate$q-ac6array -96) +(defconstant processorstate$q-ac6arword -88) +(defconstant processorstate$q-ac6locat -80) +(defconstant processorstate$q-ac6length -72) +(defconstant processorstate$q-ac7array -64) +(defconstant processorstate$q-ac7arword -56) +(defconstant processorstate$q-ac7locat -48) +(defconstant processorstate$q-ac7length -40) +(defconstant processorstate$l-tmcurrenttransaction -32) +(defconstant processorstate$l-tmwritestart -28) +(defconstant processorstate$l-tmwritecurrent -24) +(defconstant processorstate$l-tmwritelimit -20) +(defconstant processorstate$l-tmrecordingreads -16) +(defconstant processorstate$l-tmreadstart -12) +(defconstant processorstate$l-tmreadcurrent -8) +(defconstant processorstate$l-tmreadlimit -4) + +(defconstant processorstate$k-size 1344) +(defconstant |PROCESSORSTATESIZE| 1344) + + +;;; Structure CACHELINE +(defconstant cacheline$q-annotation 0) +(defconstant cacheline$l-nextpcdata 8) +(defconstant cacheline$l-nextpctag 12) +(defconstant cacheline$p-nextcp 16) +(defconstant cacheline$l-instruction 24) +(defconstant cacheline$l-operand 28) +(defconstant cacheline$l-pcdata 32) +(defconstant cacheline$l-pctag 36) +(defconstant cacheline$p-code 40) + +(defconstant cacheline$k-size 48) +(defconstant |CACHELINESIZE| 48) + +(defparameter |cacheline|$k-|bits| 18) +(defparameter |CacheLineBits| 18) + +(defparameter |cacheline|$k-|mask| 262143) +(defparameter |CacheLineMask| 262143) + +(defparameter |cacheline|$k-|rshift| 16) +(defparameter |CacheLineRShift| 16) + +(defparameter |cacheline|$k-|lshift| 6) +(defparameter |CacheLineLShift| 6) + +(defparameter |cacheline|$k-|fillamount| 20) +(defparameter |CacheLineFillAmount| 20) + + +;;; Structure ARRAYCACHE +(defconstant arraycache$q-array 0) +(defconstant arraycache$q-arword 8) +(defconstant arraycache$q-locat 16) +(defconstant arraycache$q-length 24) + +(defparameter |autoarrayreg|$k-|mask| 224) +(defparameter |AutoArrayRegMask| 224) + +(defparameter |autoarrayreg|$k-|size| 32) +(defparameter |AutoArrayRegSize| 32) + +(defparameter |autoarrayreg|$k-|shift| 0) +(defparameter |AutoArrayRegShift| 0) + +(defparameter |msclock|$k-|unitstomsshift| 0) +(defparameter |MSclockUnitsToMSShift| 0) + +(defparameter |msclock|$k-|unitspermicrosecond| 1) +(defparameter |MSclockUnitsPerMicrosecond| 1) + +(defparameter |stack|$k-|cachesize| 1792) +(defparameter |StackCacheSize| 1792) + +(defparameter |stack|$k-|maxframesize| 128) +(defparameter |StackMaxFrameSize| 128) + +(defparameter |stack|$k-|cachemargin| 128) +(defparameter |StackCacheMargin| 128) + +(defparameter |stack|$k-|cachedumpquantum| 896) +(defparameter |StackCacheDumpQuantum| 896) + +(defconstant |ivorymemory|$k-|data| 38) +(defconstant |IvoryMemoryData| 38) + +(defconstant |ivorymemory|$k-|tag| 36) +(defconstant |IvoryMemoryTag| 36) + + +;;; Structure SAVEDREGISTERS +(defconstant savedregisters$q-r9 0) +(defconstant savedregisters$q-r10 8) +(defconstant savedregisters$q-r11 16) +(defconstant savedregisters$q-r12 24) +(defconstant savedregisters$q-r13 32) +(defconstant savedregisters$q-r14 40) +(defconstant savedregisters$q-r15 48) +(defconstant savedregisters$q-r29 56) +(defconstant savedregisters$q-f2 64) +(defconstant savedregisters$q-f3 72) +(defconstant savedregisters$q-f4 80) +(defconstant savedregisters$q-f5 88) +(defconstant savedregisters$q-f6 96) +(defconstant savedregisters$q-f7 104) +(defconstant savedregisters$q-f8 112) +(defconstant savedregisters$q-f9 120) + +(defconstant savedregisters$k-size 128) +(defconstant |SAVEDREGISTERSSIZE| 128) + + +;;; Structure TRACEDATA +(defconstant tracedata$q-n_entries 0) +(defconstant tracedata$l-recording_p 8) +(defconstant tracedata$l-wrap_p 12) +(defconstant tracedata$q-start_pc 16) +(defconstant tracedata$q-stop_pc 24) +(defconstant tracedata$p-records_start 32) +(defconstant tracedata$p-records_end 40) +(defconstant tracedata$p-current_entry 48) +(defconstant tracedata$p-printer 56) + +(defconstant tracedata$k-size 64) +(defconstant |TRACEDATASIZE| 64) + + +;;; Structure TRACERECORD +(defconstant tracerecord$q-counter 0) +(defconstant tracerecord$q-epc 8) +(defconstant tracerecord$q-tos 16) +(defconstant tracerecord$q-sp 24) +(defconstant tracerecord$p-instruction 32) +(defconstant tracerecord$q-instruction_data 40) +(defconstant tracerecord$l-operand 48) +(defconstant tracerecord$l-trap_p 52) +(defconstant tracerecord$q-trap_data_0 56) +(defconstant tracerecord$q-trap_data_1 64) +(defconstant tracerecord$q-trap_data_2 72) +(defconstant tracerecord$q-trap_data_3 80) +(defconstant tracerecord$l-catch_block_p 88) +(defconstant tracerecord$l-int-pad0 92) +(defconstant tracerecord$q-catch_block_0 96) +(defconstant tracerecord$q-catch_block_1 104) +(defconstant tracerecord$q-catch_block_2 112) +(defconstant tracerecord$q-catch_block_3 120) + +(defconstant tracerecord$k-size 128) +(defconstant |TRACERECORDSIZE| 128) + +(defparameter |cachemeter|$k-|pwr| 14) +(defparameter |CacheMeterPwr| 14) + +(defparameter |cachemeter|$k-|defaultfreq| 1000) +(defparameter |CacheMeterDefaultFreq| 1000) diff --git a/g5-emulator/aistat.s b/g5-emulator/aistat.s new file mode 100644 index 0000000..d381672 --- /dev/null +++ b/g5-emulator/aistat.s @@ -0,0 +1,304 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:g5-emulator;aistat.sid. Any changes made to it will be lost. */ + + + +/* Structure PROCESSORSTATE */ +PROCESSORSTATE_TRANSPARE3 = -1344 +PROCESSORSTATE_TRANSPARE2 = -1336 +PROCESSORSTATE_TRANSPARE1 = -1328 +PROCESSORSTATE_CARCDRSUBROUTINE = -1320 +PROCESSORSTATE_CDRSUBROUTINE = -1312 +PROCESSORSTATE_CARSUBROUTINE = -1304 +PROCESSORSTATE_LINKAGE = -1296 +PROCESSORSTATE_RESUMEEMA = -1288 +PROCESSORSTATE_STATISTICS = -1280 +PROCESSORSTATE_TRACE_HOOK = -1272 +PROCESSORSTATE_INSTRUCTION_COUNT = -1264 +PROCESSORSTATE_IINTERPRET_SP = -1256 +PROCESSORSTATE_SCRATCH0 = -1248 +PROCESSORSTATE_SCRATCH1 = -1240 +PROCESSORSTATE_SCRATCH2 = -1232 +PROCESSORSTATE_SCRATCH3 = -1224 +PROCESSORSTATE_SCRATCH4 = -1216 +PROCESSORSTATE_SCRATCH5 = -1208 +PROCESSORSTATE_SCRATCH6 = -1200 +PROCESSORSTATE_SCRATCH7 = -1192 +PROCESSORSTATE_METERDATABUFF = -1184 +PROCESSORSTATE_METERPOS = -1176 +PROCESSORSTATE_METERMAX = -1172 +PROCESSORSTATE_METERFREQ = -1168 +PROCESSORSTATE_METERMASK = -1164 +PROCESSORSTATE_METERVALUE = -1160 +PROCESSORSTATE_METERCOUNT = -1156 +PROCESSORSTATE_CHOICEPTR = -1152 +PROCESSORSTATE_SSTKCHOICEPTR = -1144 +PROCESSORSTATE_DBCBASE = -1136 +PROCESSORSTATE_DBCMASK = -1128 +PROCESSORSTATE_COPROCESSORREADHOOK = -1120 +PROCESSORSTATE_COPROCESSORWRITEHOOK = -1112 +PROCESSORSTATE_FLUSHCACHES_HOOK = -1104 +PROCESSORSTATE_I_STAGE_ERROR_HOOK = -1096 +PROCESSORSTATE_SFP1 = -1088 +PROCESSORSTATE_FP0 = -1080 +PROCESSORSTATE_FP1 = -1072 +PROCESSORSTATE_FLOATING_EXCEPTION = -1064 +PROCESSORSTATE_ALUANDROTATECONTROL = -1056 +PROCESSORSTATE_ROTATELATCH = -1048 +PROCESSORSTATE_ALUBORROW = -1040 +PROCESSORSTATE_ALUOVERFLOW = -1032 +PROCESSORSTATE_ALULESSTHAN = -1024 +PROCESSORSTATE_ALUOP = -1016 +PROCESSORSTATE_BYTEROTATE = -1008 +PROCESSORSTATE_BYTESIZE = -1000 +PROCESSORSTATE_BINDINGSTACKLIMIT = -992 +PROCESSORSTATE_BINDINGSTACKPOINTER = -984 +PROCESSORSTATE_CATCHBLOCK = -976 +PROCESSORSTATE_EXTRAANDCATCH = -968 +PROCESSORSTATE_MSCLOCKCACHE = -960 +PROCESSORSTATE_TICKSPERMS = -952 +PROCESSORSTATE_PREVIOUSTB = -944 +PROCESSORSTATE_RLINK = -936 +PROCESSORSTATE_INTERRUPTREG = -928 +PROCESSORSTATE_ZONEOLDSPACE = -924 +PROCESSORSTATE_EPHEMERALOLDSPACE = -920 +PROCESSORSTATE_INT_PAD0 = -916 +PROCESSORSTATE_EQNOTEQL = -912 +PROCESSORSTATE_LCLENGTH = -904 +PROCESSORSTATE_SCLENGTH = -900 +PROCESSORSTATE_LCAREA = -896 +PROCESSORSTATE_LCADDRESS = -888 +PROCESSORSTATE_SCAREA = -880 +PROCESSORSTATE_SCADDRESS = -872 +PROCESSORSTATE_RESTARTSP = -864 +PROCESSORSTATE_STOP_INTERPRETER = -856 +PROCESSORSTATE_IMMEDIATE_ARG = -848 +PROCESSORSTATE_CONTINUATIONCP = -840 +PROCESSORSTATE_CONTINUATION = -832 +PROCESSORSTATE_CONTROL = -824 +PROCESSORSTATE_NILADDRESS = -816 +PROCESSORSTATE_TADDRESS = -808 +PROCESSORSTATE_BAR0 = -800 +PROCESSORSTATE_BAR1 = -792 +PROCESSORSTATE_BAR2 = -784 +PROCESSORSTATE_BAR3 = -776 +PROCESSORSTATE_EPC = -768 +PROCESSORSTATE_FP = -760 +PROCESSORSTATE_LP = -752 +PROCESSORSTATE_SP = -744 +PROCESSORSTATE_CP = -736 +PROCESSORSTATE_FCCRMASK = -728 +PROCESSORSTATE_CSLIMIT = -720 +PROCESSORSTATE_CSEXTRALIMIT = -716 +PROCESSORSTATE_TRAPMETERDATA = -712 +PROCESSORSTATE_FEPMODETRAPVECADDRESS = -704 +PROCESSORSTATE_TRAPVECBASE = -696 +PROCESSORSTATE_TVI = -688 +PROCESSORSTATE_FCCRTRAPMASK = -680 +PROCESSORSTATE_PTRTYPE = -672 +PROCESSORSTATE_VMATTRIBUTETABLE = -664 +PROCESSORSTATE_VMA = -656 +PROCESSORSTATE_MOSTNEGATIVEFIXNUM = -648 +PROCESSORSTATE_ICACHEBASE = -640 +PROCESSORSTATE_ENDICACHE = -632 +PROCESSORSTATE_FULLWORDDISPATCH = -624 +PROCESSORSTATE_HALFWORDDISPATCH = -616 +PROCESSORSTATE_AREVENTCOUNT = -608 +PROCESSORSTATE_STACKCACHESIZE = -600 +PROCESSORSTATE_STACKCACHETOPVMA = -592 +PROCESSORSTATE_CDRCODEMASK = -584 +PROCESSORSTATE_STACKCACHEDATA = -576 +PROCESSORSTATE_STACKCACHEBASEVMA = -568 +PROCESSORSTATE_SCOVLIMIT = -560 +PROCESSORSTATE_SCOVDUMPCOUNT = -556 +PROCESSORSTATE_MOSTPOSITIVEFIXNUM = -552 +PROCESSORSTATE_INTERNALREGISTERREAD1 = -544 +PROCESSORSTATE_INTERNALREGISTERREAD2 = -536 +PROCESSORSTATE_INTERNALREGISTERWRITE1 = -528 +PROCESSORSTATE_INTERNALREGISTERWRITE2 = -520 +PROCESSORSTATE_DATAREAD_MASK = -512 +PROCESSORSTATE_DATAREAD = -504 +PROCESSORSTATE_DATAWRITE_MASK = -496 +PROCESSORSTATE_DATAWRITE = -488 +PROCESSORSTATE_BINDREAD_MASK = -480 +PROCESSORSTATE_BINDREAD = -472 +PROCESSORSTATE_BINDWRITE_MASK = -464 +PROCESSORSTATE_BINDWRITE = -456 +PROCESSORSTATE_BINDREADNOMONITOR_MASK = -448 +PROCESSORSTATE_BINDREADNOMONITOR = -440 +PROCESSORSTATE_BINDWRITENOMONITOR_MASK = -432 +PROCESSORSTATE_BINDWRITENOMONITOR = -424 +PROCESSORSTATE_HEADER_MASK = -416 +PROCESSORSTATE_HEADER = -408 +PROCESSORSTATE_STRUCTUREOFFSET_MASK = -400 +PROCESSORSTATE_STRUCTUREOFFSET = -392 +PROCESSORSTATE_SCAVENGE_MASK = -384 +PROCESSORSTATE_SCAVENGE = -376 +PROCESSORSTATE_CDR_MASK = -368 +PROCESSORSTATE_CDR = -360 +PROCESSORSTATE_GCCOPY_MASK = -352 +PROCESSORSTATE_GCCOPY = -344 +PROCESSORSTATE_RAW_MASK = -336 +PROCESSORSTATE_RAW = -328 +PROCESSORSTATE_RAWTRANSLATE_MASK = -320 +PROCESSORSTATE_RAWTRANSLATE = -312 +PROCESSORSTATE_PLEASE_STOP = -304 +PROCESSORSTATE_PLEASE_TRAP = -300 +PROCESSORSTATE_RUNNINGP = -296 +PROCESSORSTATE_AC0ARRAY = -288 +PROCESSORSTATE_AC0ARWORD = -280 +PROCESSORSTATE_AC0LOCAT = -272 +PROCESSORSTATE_AC0LENGTH = -264 +PROCESSORSTATE_AC1ARRAY = -256 +PROCESSORSTATE_AC1ARWORD = -248 +PROCESSORSTATE_AC1LOCAT = -240 +PROCESSORSTATE_AC1LENGTH = -232 +PROCESSORSTATE_AC2ARRAY = -224 +PROCESSORSTATE_AC2ARWORD = -216 +PROCESSORSTATE_AC2LOCAT = -208 +PROCESSORSTATE_AC2LENGTH = -200 +PROCESSORSTATE_AC3ARRAY = -192 +PROCESSORSTATE_AC3ARWORD = -184 +PROCESSORSTATE_AC3LOCAT = -176 +PROCESSORSTATE_AC3LENGTH = -168 +PROCESSORSTATE_AC4ARRAY = -160 +PROCESSORSTATE_AC4ARWORD = -152 +PROCESSORSTATE_AC4LOCAT = -144 +PROCESSORSTATE_AC4LENGTH = -136 +PROCESSORSTATE_AC5ARRAY = -128 +PROCESSORSTATE_AC5ARWORD = -120 +PROCESSORSTATE_AC5LOCAT = -112 +PROCESSORSTATE_AC5LENGTH = -104 +PROCESSORSTATE_AC6ARRAY = -96 +PROCESSORSTATE_AC6ARWORD = -88 +PROCESSORSTATE_AC6LOCAT = -80 +PROCESSORSTATE_AC6LENGTH = -72 +PROCESSORSTATE_AC7ARRAY = -64 +PROCESSORSTATE_AC7ARWORD = -56 +PROCESSORSTATE_AC7LOCAT = -48 +PROCESSORSTATE_AC7LENGTH = -40 +PROCESSORSTATE_TMCURRENTTRANSACTION = -32 +PROCESSORSTATE_TMWRITESTART = -28 +PROCESSORSTATE_TMWRITECURRENT = -24 +PROCESSORSTATE_TMWRITELIMIT = -20 +PROCESSORSTATE_TMRECORDINGREADS = -16 +PROCESSORSTATE_TMREADSTART = -12 +PROCESSORSTATE_TMREADCURRENT = -8 +PROCESSORSTATE_TMREADLIMIT = -4 + +PROCESSORSTATESIZE = 0x540 + + +/* Structure CACHELINE */ +CACHELINE_ANNOTATION = 0 +CACHELINE_NEXTPCDATA = 8 +CACHELINE_NEXTPCTAG = 12 +CACHELINE_NEXTCP = 16 +CACHELINE_INSTRUCTION = 24 +CACHELINE_OPERAND = 28 +CACHELINE_PCDATA = 32 +CACHELINE_PCTAG = 36 +CACHELINE_CODE = 40 + +CACHELINESIZE = 0x30 + +CacheLineBits = 0x12 + +CacheLineMask = 0x3FFFF + +CacheLineRShift = 0x10 + +CacheLineLShift = 0x6 + +CacheLineFillAmount = 0x14 + + +/* Structure ARRAYCACHE */ +ARRAYCACHE_ARRAY = 0 +ARRAYCACHE_ARWORD = 8 +ARRAYCACHE_LOCAT = 16 +ARRAYCACHE_LENGTH = 24 + +AutoArrayRegMask = 0xE0 + +AutoArrayRegSize = 0x20 + +AutoArrayRegShift = 0x0 + +MSclockUnitsToMSShift = 0x0 + +MSclockUnitsPerMicrosecond = 0x1 + +StackCacheSize = 0x700 + +StackMaxFrameSize = 0x80 + +StackCacheMargin = 0x80 + +StackCacheDumpQuantum = 0x380 + +IvoryMemoryData = 0x26 + +IvoryMemoryTag = 0x24 + + +/* Structure SAVEDREGISTERS */ +SAVEDREGISTERS_R9 = 0 +SAVEDREGISTERS_R10 = 8 +SAVEDREGISTERS_R11 = 16 +SAVEDREGISTERS_R12 = 24 +SAVEDREGISTERS_R13 = 32 +SAVEDREGISTERS_R14 = 40 +SAVEDREGISTERS_R15 = 48 +SAVEDREGISTERS_R29 = 56 +SAVEDREGISTERS_F2 = 64 +SAVEDREGISTERS_F3 = 72 +SAVEDREGISTERS_F4 = 80 +SAVEDREGISTERS_F5 = 88 +SAVEDREGISTERS_F6 = 96 +SAVEDREGISTERS_F7 = 104 +SAVEDREGISTERS_F8 = 112 +SAVEDREGISTERS_F9 = 120 + +SAVEDREGISTERSSIZE = 0x80 + + +/* Structure TRACEDATA */ +TRACEDATA_N_ENTRIES = 0 +TRACEDATA_RECORDING_P = 8 +TRACEDATA_WRAP_P = 12 +TRACEDATA_START_PC = 16 +TRACEDATA_STOP_PC = 24 +TRACEDATA_RECORDS_START = 32 +TRACEDATA_RECORDS_END = 40 +TRACEDATA_CURRENT_ENTRY = 48 +TRACEDATA_PRINTER = 56 + +TRACEDATASIZE = 0x40 + + +/* Structure TRACERECORD */ +TRACERECORD_COUNTER = 0 +TRACERECORD_EPC = 8 +TRACERECORD_TOS = 16 +TRACERECORD_SP = 24 +TRACERECORD_INSTRUCTION = 32 +TRACERECORD_INSTRUCTION_DATA = 40 +TRACERECORD_OPERAND = 48 +TRACERECORD_TRAP_P = 52 +TRACERECORD_TRAP_DATA_0 = 56 +TRACERECORD_TRAP_DATA_1 = 64 +TRACERECORD_TRAP_DATA_2 = 72 +TRACERECORD_TRAP_DATA_3 = 80 +TRACERECORD_CATCH_BLOCK_P = 88 +TRACERECORD_INT_PAD0 = 92 +TRACERECORD_CATCH_BLOCK_0 = 96 +TRACERECORD_CATCH_BLOCK_1 = 104 +TRACERECORD_CATCH_BLOCK_2 = 112 +TRACERECORD_CATCH_BLOCK_3 = 120 + +TRACERECORDSIZE = 0x80 + +CacheMeterPwr = 0xE + +CacheMeterDefaultFreq = 0x3E8 diff --git a/g5-emulator/aistat.sid b/g5-emulator/aistat.sid new file mode 100644 index 0000000..935b73b --- /dev/null +++ b/g5-emulator/aistat.sid @@ -0,0 +1,414 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;;; The processor state object is the big daddy. It acts like a data segment +;;; for the interpreter. It constantly resides in a register, and provides +;;; direct addressing to its components. Everything that the interpreter +;;; needs can be found here. Note: this object should not be grown larger +;;; than 64 K bytes or 4K 64 bit words. + +;;;---*** TODO: IS THERE A SIMILAR SET OF RULES FOR THE POWERPC DATA CACHE??? +;;;---*** TODO: IF SO, NOTE IT HERE AND MAKE CHANGES AS APPROPRIATE ... +;;; Note well! All of these slots are grouped in units of four "related" +;;; longwords to minimize Alpha dcache thrashing. Do *not* add or remove +;;; anything from these 4-longword groups. Instead, use a pad slot, or +;;; create a new 4-longword group. + +;;; This structure is indexed "backwards" from the Ivory register in +;;; assembly code (c.f., the :base-pointer slot which clues in the dsdl +;;; processor to emit proper offsets) and Lisp tagspace is indexed +;;; forwards from Ivory + +(define-structure (processorstate) + + ;; *** DO NOT REORDER THE FOLLOWING SLOTS *** + (:unsigned-long transpare3) + (:unsigned-long transpare2) + (:unsigned-long transpare1) + (:unsigned-long carcdrsubroutine) + + (:unsigned-long cdrsubroutine) + (:unsigned-long carsubroutine) + (:unsigned-long linkage) + (:unsigned-long resumeema) ;resume procedure address. + ;; *** END OF DO NOT REORDER *** + + (:pointer statistics) ; Instruction usage statistics + (:pointer trace-hook) ; function called to do instruction tracing + (:signed-long instruction-count) ; number of instructions executed so far. + (:unsigned-long iinterpret-sp) ; iInterpret's stack frame pointer + + (:unsigned-long scratch0) + (:unsigned-long scratch1) + (:unsigned-long scratch2) + (:unsigned-long scratch3) + + (:unsigned-long scratch4) + (:unsigned-long scratch5) + (:unsigned-long scratch6) + (:unsigned-long scratch7) + + ;; The following is a control block for cache miss metering. + ;; They can be removed when this facility is no longer required. + (:pointer meterdatabuff) ; the buffer that contains meter data. + (:unsigned-int meterpos) ; the place where the next data item goes. + (:unsigned-int metermax) ; the highest value ever recorded. + (:unsigned-int meterfreq) ; sample size. + (:unsigned-int metermask) ; mask for wrap + (:unsigned-int metervalue) ; current number of misses. + (:unsigned-int metercount) ; number remaining + + (:unsigned-long choiceptr) ; the choice pointer + (:unsigned-long sstkchoiceptr) ; the structure stack choice pointer + (:unsigned-long dbcbase) ; dynamic binding cache base + (:unsigned-long dbcmask) ; dynamic binding cache mask + + (:pointer coprocessorreadhook) ; function called to do coprocessor read + (:pointer coprocessorwritehook) ; function called to do coprocessor write + (:pointer flushcaches-hook) ; function called to flush I/D caches + (:pointer i-stage-error-hook) ; function called to generate an I-STAGE-ERROR + + (:unsigned-long sfp1) + (:unsigned-long fp0) + (:unsigned-long fp1) + (:unsigned-long floating-exception) + + ;; ALU support + (:unsigned-long aluandrotatecontrol) + (:unsigned-long rotatelatch) + (:unsigned-long aluborrow) + (:unsigned-long aluoverflow) + + (:unsigned-long alulessthan) + (:unsigned-long aluop) + (:unsigned-long byterotate) + (:unsigned-long bytesize) + + (:signed-long bindingstacklimit) ; binding stack limit + (:signed-long bindingstackpointer) ; binding stack pointer + (:unsigned-long catchblock) ; the catch block + (:unsigned-long extraandcatch) ; 1_8 + 1_26 + + (:unsigned-long msclockcache) ; Microsecond Clock cache + (:unsigned-long ticksperms) ; Timebase ticks per microsecond + (:unsigned-long previoustb) + (:pointer rlink) ; return address. + + (:unsigned-int interruptreg) ; the interrupt register, set only by the interpreter + (:unsigned-int zoneoldspace) ; the zone oldspace register + (:unsigned-int ephemeraloldspace) ; the ephemeral oldspace register + (:unsigned-int int-pad0) + (:unsigned-long eqnoteql) ; bit mask for types for which EQ is not EQL + (:unsigned-int lclength) ; list cache length + (:unsigned-int sclength) ; structure cache length + + (:unsigned-long lcarea) ; the list cache area + (:unsigned-long lcaddress) ; the list cache + (:unsigned-long scarea) ; the structure cache area + (:unsigned-long scaddress) ; the structure cache + + (:unsigned-long restartsp) + (:unsigned-long stop-interpreter) + (:unsigned-long immediate-arg) ; temp storage for immediates + (:unsigned-long continuationcp) ; cp of continuation (or zero) + + (:signed-long continuation) + (:signed-long control) + (:signed-long niladdress) + (:signed-long taddress) + + ;; The four BARs must be adjacent! + (:signed-long bar0) + (:signed-long bar1) + (:signed-long bar2) + (:signed-long bar3) + + (:signed-long epc) + (:signed-long fp) + (:signed-long lp) + (:signed-long sp) + + (:pointer cp) + (:unsigned-long fccrmask) ; finish call CR mask + (:unsigned-int cslimit) ; control stack limit + (:unsigned-int csextralimit) ; control stack extra limit + (:pointer trapmeterdata) ; the buffer containing trap meter data + + (:unsigned-long fepmodetrapvecaddress) + (:unsigned-long trapvecbase) + (:unsigned-long tvi) ; non-zero if the previous instruction trapped + (:unsigned-long fccrtrapmask) ; like fccrmask, but with trace bits, too + + (:pointer ptrtype) ; PTRTYPE[datatype] non-zero if it's a pointer + (:pointer vmattributetable) ; pointer to the VMAttributeTable from memory.c + (:unsigned-long vma) + (:signed-long mostnegativefixnum) ; - 1_31 + + (:pointer icachebase) ; the icache object. + (:pointer endicache) ; past the end of the icache object. + (:unsigned-long fullworddispatch) ; Fullword instruction dispatch table. + (:unsigned-long halfworddispatch) ; Halfword instruction dispatch table. + + (:signed-long areventcount) ; array register event count + (:unsigned-long stackcachesize) ; stack cache size + (:unsigned-long stackcachetopvma) ; highest address in stack cache + 1 + (:unsigned-long cdrcodemask) ; #xC00000000 + + (:pointer stackcachedata) ; storage used as the stack cache + (:unsigned-long stackcachebasevma) ; lowest address in stack cache + (:unsigned-int scovlimit) ; stack cache overflow limit + (:unsigned-int scovdumpcount) ; temporary while dumping stack cache + (:signed-long mostpositivefixnum) ; 1_31 - 1 + + ;; Dispatch tables for reading and writing internal registers + (:unsigned-long internalregisterread1) + (:unsigned-long internalregisterread2) + (:unsigned-long internalregisterwrite1) + (:unsigned-long internalregisterwrite2) + + ;; Memory Action Tables + (:unsigned-long dataread-mask) + (:pointer dataread) + (:unsigned-long datawrite-mask) + (:pointer datawrite) + + (:unsigned-long bindread-mask) + (:pointer bindread) + (:unsigned-long bindwrite-mask) + (:pointer bindwrite) + + (:unsigned-long bindreadnomonitor-mask) + (:pointer bindreadnomonitor) + (:unsigned-long bindwritenomonitor-mask) + (:pointer bindwritenomonitor) + + (:unsigned-long header-mask) + (:pointer header) + (:unsigned-long structureoffset-mask) + (:pointer structureoffset) + + (:unsigned-long scavenge-mask) + (:pointer scavenge) + (:unsigned-long cdr-mask) + (:pointer cdr) + + (:unsigned-long gccopy-mask) + (:pointer gccopy) + (:unsigned-long raw-mask) + (:pointer raw) + + (:unsigned-long rawtranslate-mask) + (:pointer rawtranslate) + ;; Magic bits: + ;; The following two longwords must be contiguous and aligned on a quadword boundary. + ;; The first is set only by the Spy and the second is set only by Life Support. + ;; Both are cleared only by the interpreter. + (:signed-int please-stop) ; request interpreter to halt if nonzero. + (:signed-int please-trap) ; request interpreter to trap if nonzero. + (:signed-long runningp) ; non-zero if running, zero if stopped. + + (:unsigned-long ac0array) ; the automatic array register 0 + (:unsigned-long ac0arword) + (:unsigned-long ac0locat) + (:unsigned-long ac0length) + + (:unsigned-long ac1array) ; the automatic array register 1 + (:unsigned-long ac1arword) + (:unsigned-long ac1locat) + (:unsigned-long ac1length) + + (:unsigned-long ac2array) ; the automatic array register 2 + (:unsigned-long ac2arword) + (:unsigned-long ac2locat) + (:unsigned-long ac2length) + + (:unsigned-long ac3array) ; the automatic array register 3 + (:unsigned-long ac3arword) + (:unsigned-long ac3locat) + (:unsigned-long ac3length) + + (:unsigned-long ac4array) ; the automatic array register 4 + (:unsigned-long ac4arword) + (:unsigned-long ac4locat) + (:unsigned-long ac4length) + + (:unsigned-long ac5array) ; the automatic array register 5 + (:unsigned-long ac5arword) + (:unsigned-long ac5locat) + (:unsigned-long ac5length) + + (:unsigned-long ac6array) ; the automatic array register 6 + (:unsigned-long ac6arword) + (:unsigned-long ac6locat) + (:unsigned-long ac6length) + + (:unsigned-long ac7array) ; the automatic array register 7 + (:unsigned-long ac7arword) + (:unsigned-long ac7locat) + (:unsigned-long ac7length) + + ;;transactional memory state + (:unsigned-int tmcurrenttransaction) ; current transaction id (0 means none) + (:unsigned-int tmwritestart) ; write buffer start + (:unsigned-int tmwritecurrent) ; write buffer next + (:unsigned-int tmwritelimit) ; write buffer can't write limit + (:unsigned-int tmrecordingreads) ; whether current transaction records reads (0 means not) + (:unsigned-int tmreadstart) ; read buffer start + (:unsigned-int tmreadcurrent) ; read buffer next + (:unsigned-int tmreadlimit) ; read buffer can't write limit + + :base-pointer ; Ivory register points here + (:size size)) ; the fixed size + + +;; The fields in a cacheline are carefully organized so that they are +;; fetched in ascending order in the NextInstruction loop +(define-structure (cacheline) + ;; The annotation field is used for branch-taken prediction and + ;; metering. In the branch-taken case, it will be fetched instead of + ;; NEXTPC/NEXTCP, so we put it here to start a fill (even though we + ;; then have to skip 2 quadwords). + (:unsigned-long annotation) ; serves multiple purposes + + ;; NEXTPCDATA/NEXTPCTAG and NEXTCP get used together, in that order. + ;; Even though these are not octaword-aligned, we expect cachelines + ;; for NextInstruction to typically already be loaded. + (:unsigned-int nextpcdata) ; the Ivory data for the next PC + (:unsigned-int nextpctag) ; the Ivory tag for the next PC + (:pointer nextcp) ; the cache entry for the next PC + + ;; PCDATA/PCTAG, INSTRUCTION/OPERAND, and CODE get used together, in + ;; that order (and after NEXTPC and NEXTCP) + + ;; Nota Bene: For full-word instructions, the operand and instruction + ;; fields are concatenated, so that the "pointer" field of the + ;; instruction can be stored as an unsigned long, that is the + ;; full-word operand. For packed instructions, the instruction field + ;; contains the "pointer" (needed by entry and spare ops) and the + ;; operand field contains the extracted operand. + (:unsigned-int instruction) ; the actual instruction for this PC + (:unsigned-int operand) ; the decoded operand + (:unsigned-int pcdata) ; the Ivory data for this PC + (:unsigned-int pctag) ; the Ivory tag for this PC + (:pointer code) ; pointer to emulator routine + + (:size size)) + +(define-values (|CacheLine| :parameter) + (|Bits| 18) ; Number of bits in cache mask + (|Mask| #.(1- (ash 1 18))) ; Mask for computing cache address. + (|RShift| 16) ; Shift to the right + (|LShift| 6) ; Shift to the left + ;; Must be <= (ash 1 LShift) and <= 1 vm page + ;; 10 == (floor Prefetch-size cacheline-size) + (|FillAmount| 20)) ; was 10 for 8k cache + + +(define-structure (arraycache) + (:unsigned-long array) + (:unsigned-long arword) + (:unsigned-long locat) + (:unsigned-long length)) + +(define-values (|AutoArrayReg| :parameter) + (|Mask| #xE0) + (|Size| 32) + (|Shift| 0)) + + +(define-values (|MSclock| :parameter) + (|UnitsToMSShift| 0) + (|UnitsPerMicrosecond| 1)) + + +;; Stack cache sized to not conflict with processor state in data cache. +;; State is aligned to top of cache and is < 2048 bytes, so stack cache +;; is (8192 - 2048)/8 slots +(define-values (|Stack| :parameter) + (|CacheSize| 1792) ;768 if 8k + (|MaxFrameSize| 128) ;128 + ;; Must be >= frame size + (|CacheMargin| 128) ;128 + ;; Must be >= 2 * cache margin, so that scrolling will clear overflow + ;; condition; and <= cache-size - (maxframe + 2*margin), so that + ;; scrolling does not scroll current frame out of stack. + (|CacheDumpQuantum| 896) ; 384 if 8K -- pr I found a horrible bug in how this is used in the code (stackcacheoverflowhandler) should be fixed+++ + ) + + +;;; These values represent the shift required to get the base address of ivory +;;; emulated memory. The data being at 1< none). This path does need + with-multiple-memory-reads set up." + (check-temporaries (tag data extra-tag extra-data indirect) (temp temp2 temp3 temp6 temp7 temp8 temp9)) + ;; The various flavors of start-call are all expanded in-line here, so + ;; that there are only two "tails" for the cases of pushing a frame + ;; with and without an extra argument + (let ((interp (gensym)) + (notpc (gensym)) + (again (gensym)) + (call (gensym)) + (call-extra (gensym)) + (push-extra (gensym)) + #+ignore (hardway (gensym))) + `((label ,again) + ;; Constant shared by several branches + (LD ,temp PROCESSORSTATE_TRAPVECBASE (ivory)) + (type-dispatch ,tag ,temp2 ,temp3 + (|TypeCompiledFunction| + (label ,call) + (clr ,extra-tag "No extra argument") + (label ,call-extra) + (li ,tag |TypeEvenPC|) + (label ,startcallcompiledlabel) + ;; (start-call-compiled |TypeEvenPC| tag data temp3 temp8 temp9 temp6 temp7) + (push-frame ,temp3 ,temp8 ,temp9 ,temp6 ,temp7) + (GetNextPCandCP) + (set-continuation2r ,tag ,data) + (stzd PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (branch-if-nonzero ,extra-tag ,push-extra) + (ContinueToNextInstruction-NoStall) + (label ,push-extra) + (LWA ,temp PROCESSORSTATE_CONTROL+4 (ivory)) + (load-constant ,temp2 #.1_8 "cr.extra-argument") + (stack-push2 ,extra-tag ,extra-data ,temp3 "Push the extra arg.") + (OR ,temp ,temp ,temp2 "Set the extra arg bit") + (STW ,temp PROCESSORSTATE_CONTROL+4 (Ivory) "Save control with new state") + (ContinueToNextInstruction-NoStall)) + (|TypeGenericFunction| + ;; Build the constant PC for generic dispatch + (mov ,extra-tag ,tag) + (clrldi ,extra-data ,data 32) + (ADDI ,data ,temp #.sys:%generic-dispatch-trap-vector) + (B ,call-extra)) + (|TypeInstance| + ;; Build the constant PC for message dispatch + (mov ,extra-tag ,tag) + (clrldi ,extra-data ,data 32) + (ADDI ,data ,temp #.sys:%message-dispatch-trap-vector) + (B ,call-extra)) + (|TypeSymbol| + ;; We don't know what might be in the function-cell of a + ;; symbol, so do the full dispatch + (clrldi ,data ,data 32) + (clr ,extra-tag "No extra argument") + (ADDI ,indirect ,data 2 "Get to the function cell") + (B ,startcallindirectlabel)) + (|TypeLexicalClosure| + ;; (start-call-lexical-closure tag data interp extra-data extra-tag temp2 temp temp6 temp7 temp8 temp9 indirect) + (clrldi ,indirect ,data 32) + #+ignore + ( + ;;Most lexicals are stack-consed, we assume no funny types in them + (VMAtoSCAmaybe ,indirect ,temp6 ,hardway ,temp7 ,temp8) + (stack-read2 ,temp6 ,extra-tag ,extra-data) + (stack-read2-disp ,temp6 8 ,tag ,data) + (CheckDataType ,tag |TypeCompiledFunction| ,again ,temp6) + (B ,call-extra) + (label ,hardway)) + (memory-read ,indirect ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp7 ,temp8 ,temp9 nil t) + (mov ,extra-tag ,tag) + (mov ,extra-data ,data) + (ADDI ,indirect ,indirect 1) + (label ,startcallindirectlabel) + (memory-read ,indirect ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp7 ,temp8 ,temp9 nil t) + (CheckDataType ,tag |TypeCompiledFunction| ,again ,temp6) + (B ,call-extra)) + (:else + (label ,interp) + ;; (start-call-escape tag data notpc temp temp2 temp3 extra-tag extra-data temp6 temp7 temp8) + (mov ,extra-tag ,tag) + (mov ,extra-data ,data) + (ADDI ,temp3 ,temp #.sys:%interpreter-function-vector) + (TagType ,tag ,tag) + (ADD ,indirect ,tag ,temp3) + (memory-read ,indirect ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp7 ,temp8 ,temp9 nil t) + ;; There aren't any odd ones, so we just disallow them! + (CheckAdjacentDataTypes ,tag |TypeEvenPC| 1 ,notpc ,temp3) + (B ,call-extra))) + (label ,notpc) + ;; Blech! we "know" the VMA will be in temp (from start-call-escape) + (illegal-operand interpreter-table-contents-not-pc ,temp "Bad type for start-call")))) + +(defmacro start-call-compiled (impctag ctag cdata temp temp2 temp3 temp4 temp5 &optional etag edata) + (if (lisp:and etag edata) + (check-temporaries (ctag cdata etag edata) (temp temp2 temp3 temp4 temp5)) + (check-temporaries (ctag cdata) (temp temp2 temp3 temp4 temp5))) + `((push-frame ,temp ,temp2 ,temp3 ,temp4 ,temp5 ,etag ,edata) + (GetNextPCandCP) + (mov ,ctag ,impctag) + (set-continuation2r ,ctag ,cdata) + (ContinueToNextInstruction-NoStall))) + +(defmacro start-call-lexical-closure + (tag data interp temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9) + (check-temporaries (tag data) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9)) + `((memory-read ,data ,temp2 ,temp PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8) + (ADDI ,temp9 ,data 1) + (memory-read ,temp9 ,temp4 ,temp3 PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,temp4 |TypeCompiledFunction| ,interp ,temp5) + (push-frame ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 ,temp2 ,temp) + (GetNextPCandCP) + (li ,temp4 |TypeEvenPC|) + (set-continuation2 ,temp4 ,temp3) + (ContinueToNextInstruction-NoStall))) + +(defmacro start-call-escape (tag data notpc temp temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (check-temporaries (tag data) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + `((LD ,temp2 PROCESSORSTATE_TRAPVECBASE (ivory)) + (ADDI ,temp ,temp2 #.sys:%interpreter-function-vector) + (TagType ,tag ,tag) + (ADD ,temp ,tag ,temp) + (memory-read ,temp ,temp4 ,temp3 PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckAdjacentDataTypes ,temp4 |TypeEvenPC| 2 ,notpc ,temp5) + (push-frame ,temp5 ,temp6 ,temp7 ,temp8 ,temp ,tag ,data) + (GetNextPCandCP) + (set-continuation2 ,temp4 ,temp3) + (ContinueToNextInstruction-NoStall))) + +;;; Support for finish-call + +;;; nargs is the number of args (args+apply+1)*8! +;;; disp is a register containing the two bit disposition. +;;; applyp really has this instruction's opcode, from which we extract the apply bit +(defmacro finish-call-guts (nargs disp applyp cr nfp temp temp2 temp3 temp4 temp5) + (check-temporaries (nargs disp applyp cr nfp 'arg2) (temp temp2 temp3 temp4 temp5)) + (let () + `((srdi ,applyp ,applyp #.(- 10 3)) + (stack-cache-overflow-check ,temp ,temp2 ,temp3 ,temp4 ,temp5) + (ANDI-DOT ,applyp ,applyp 8 "0 if not apply, 8 if apply") + (get-control-register ,cr "Get the control register") + (comment "Compute the new LP") + (ADDI iLP iSP 8 "Assume not Apply case.") + (SUBF iLP ,applyp iLP "For apply, iLP==iSP") + (comment "Compute the new FP") + (srdi ,temp ,cr 5 "extra arg bit<<3") + (SUBF ,nfp ,nargs iSP) + (ANDI-DOT ,temp ,temp 8 "8 if extra arg, 0 otherwise.") + (SUBF ,nfp ,temp ,nfp "This! is the new frame pointer!") + (comment "compute arg size") + (SUBF ,temp2 ,nfp iLP) + (srdi ,temp2 ,temp2 3 "arg size in words.") + (comment "compute caller frame size.") + (SUBF ,temp3 iFP ,nfp) + (srdi ,temp3 ,temp3 3 "caller frame size in words.") + (comment "Now hack the control register!") + (sldi ,temp5 ,disp 18 "Get value disposition into place") + (LD ,temp4 PROCESSORSTATE_FCCRMASK (ivory) "cr.caller-frame-size") + (sldi ,temp3 ,temp3 9 "Shift caller frame size into place") + (OR ,temp5 ,temp5 ,temp2 "Add arg size to new bits.") + (sldi ,temp2 ,applyp 14 "Apply bit in place") + (OR ,temp5 ,temp3 ,temp5 "Add frame size to new bits") + (OR ,temp5 ,temp2 ,temp5 "All new bits assembled!") + (comment "Set the return continuation.") + (LD ,temp3 CACHELINE_NEXTPCDATA (iCP) "Next instruction hw format") + (AND ,cr ,cr ,temp4 "Mask off unwanted bits") + ;; inline (get-continuation2 temp temp2 "Get the new PC tag/data") + (LWA ,temp2 PROCESSORSTATE_CONTINUATION+4 (Ivory) "Get the new PC tag/data") + (OR ,cr ,cr ,temp5 "Add argsize, apply, disposition, caller FS") + (LWA ,temp PROCESSORSTATE_CONTINUATION (Ivory)) + (comment "Update the PC") + (convert-pc-to-continuation ,temp3 ,temp4 ,temp5) + (clrldi ,temp2 ,temp2 32) + (convert-continuation-to-pc ,temp ,temp2 iPC) + (set-continuation2r ,temp4 ,temp5 "Set return address") + (comment "Update CP") + (load-constant ,temp5 #.1_28 "cr.call-trace") + (LD ,temp3 CACHELINE_NEXTCP (iCP)) + (AND ,temp5 ,temp5 ,cr) + (srdi ,temp5 ,temp5 1 "Shift into trace pending place") + (STD ,temp3 PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (OR ,cr ,cr ,temp5 "Set the cr.trace pending if appropriate.") + (set-control-register ,cr "Set the control register") + (mov iFP ,nfp "Install the new frame pointer") + (LD arg2 CACHELINE_ANNOTATION (iCP)) + (stack-overflow-check ,cr nil ,temp ,temp2) ;destroys ,CR + (branch-if-nonzero arg2 InterpretInstructionPredicted) + (comment "Begin execution at the computed address") + (ContinueToInterpretInstruction-ValidateCache)))) + +(defmacro b-apply-argument-supplied (suppt temp temp2 temp3 &optional cr) + (if cr + (check-temporaries (cr) (temp temp2 temp3)) + (check-temporaries () (temp temp2 temp3))) + (let ((apply (gensym)) + (done (gensym))) + ;; If you are going to pull args, you are on the slow path + (push `((label ,apply) + (ANDI-DOT ,temp3 ,temp3 #x3F) + (ADDI ,temp3 ,temp3 #.(- |type$K-NIL|)) + (branch-if-nonzero ,temp3 ,suppt "J. if apply args supplied not nil.") + (ANDI-DOT ,temp2 ,temp2 1 "keep just the apply bit!") + (sldi ,temp2 ,temp2 17 "reposition the apply bit") + (ADDI iSP iSP -8 "Pop off the null applied arg.") + (ANDC ,(lisp:or cr temp) ,(lisp:or cr temp) ,temp2 "Blast the apply arg bit away") + (set-control-register ,(lisp:or cr temp) "Reset the stored cr bit") + (B ,done)) + *function-epilogue*) + `(,@(unless cr + `((get-control-register ,temp "Get the control register"))) + (srdi ,temp2 ,(lisp:or cr temp) 17) + (stack-read-tag iSP ,temp3 "Get the tag of the stack top.") + (force-alignment) + (ANDI-DOT R31 ,temp2 1 "BLBS ,temp2") + (BC 4 2 ,apply "J. if apply args") + (unlikely-label ,done) + ))) + +;;; INDEX is an entry with an entry index in it. +;;; Branches back to the instruction interpreter when done. +(defmacro enter-function (index temp temp2) + (check-temporaries (index) (temp temp2)) + `((comment "Compute entry position and advance PC/CP accordingly.") + (LD iPC CACHELINE_NEXTPCDATA (iCP) "get the next PC") + (sldi ,temp ,index 1 "Adjust index to halfword") + (LD iCP CACHELINE_NEXTCP (iCP)) + (branch-if-zero ,index InterpretInstruction "J. if index zero, no adjustment.") + (ADD iPC iPC ,temp "Compute the new address") + (clrrdi iPC iPC 1 "Make it an DTP-EVEN-PC") + (B InterpretInstructionForJump))) + +;;; Branches back to the instruction interpreter when done. +(defmacro push-apply-args (min max temp temp2 temp3 &optional cr) + (if cr + (check-temporaries (min max cr) (temp temp2 temp3)) + (check-temporaries (min max) (temp temp2 temp3))) + (let ((l1 (gensym)) + (ent (gensym))) + `((stack-set-cdr-code iSP 1 ,temp) ;cdr-nil + (b-apply-argument-supplied ,l1 ,temp ,temp2 ,temp3 ,cr) + (sldi ,temp ,max 3) + (ADD ,temp iFP ,temp) + (SCAtoVMA ,temp ,temp2 ,temp3) + (stack-push-ir |TypeList| ,temp2 ,temp) + (B ,ent) + (label ,l1) + (ADDI ,temp iSP -8) + (stack-set-cdr-code ,temp 2 ,temp3) ;cdr-normal + (sldi ,temp ,max 3) + (ADD ,temp iFP ,temp) + (SCAtoVMA ,temp ,temp2 ,temp3) + (stack-push-ir |TypeList| ,temp2 ,temp) + (ADDI iLP iLP 8) + ,@(unless cr + `((get-control-register ,temp3 "Get the control register"))) + (ADDI ,(lisp:or cr temp3) ,(lisp:or cr temp3) 1) + (set-control-register ,(lisp:or cr temp3)) + (label ,ent) + (SUBF ,temp ,min ,max) + (ADDI ,temp ,temp 1) + (enter-function ,temp ,temp2 ,temp3)))) + +(defmacro note-additional-spread-args (n cr temp &optional turn-off-apply) + (if (numberp n) + (check-temporaries (cr) (temp)) + (check-temporaries (n cr) (temp))) + `((get-control-register ,cr) + (ANDI-DOT ,temp ,cr #xFF "Get current arg size.") + (clrrdi ,cr ,cr 8 "Clear least significnt 8 bits") + ,@(if (numberp n) + `((ADDI ,temp ,temp ,n)) + `((ADD ,temp ,temp ,n))) + (ADD ,cr ,temp ,cr "Update the arg size") + ,@(when turn-off-apply + `((load-constant ,temp #.1_17 "cr.apply") + (ANDC ,cr ,cr ,temp "turn off cr.apply"))) + (set-control-register ,cr))) + +(defmacro pull-apply-args (n tag data done-label + temp temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (check-temporaries (n tag data) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + (let ((done (lisp:or done-label (gensym))) + (notincache (gensym))) + `((stack-top2 ,tag ,data) + (type-dispatch ,tag ,temp ,temp2 + (|TypeList| + (VMAtoSCAMaybe ,data ,temp ,notincache ,temp2 ,temp3) + (pull-apply-args-quickly + ,n ,temp ,done ,temp2 ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8)) + (|TypeNIL| + (get-control-register ,temp3 "Get the control register") + (load-constant ,temp4 #.1_17 "cr.apply") + (ADDI iSP iSP -8 "Discard that silly nil") + (ANDC ,temp3 ,temp3 ,temp4 "Blast away the apply arg bit.") + (set-control-register ,temp3) + ,@(when done-label + `((B ,done-label)))) + (:else + ;; Pull-apply has no illegal operands, always takes exception + (mov arg1 ,n "Pull apply args trap needs nargs in ARG1") + (external-branch |PULLAPPLYARGSTRAP|) + (label ,notincache) + (mov arg1 ,n) + (external-branch |PullApplyArgsSlowly|))) + ;; At this point, PROCESSORSTATE_RESTARTSP does *not* reflect the + ;; real state of iSP. If you have any code that can fault after + ;; calling this, you better store iSP! See VERIFY-GENERIC-ARITY, e.g. + ,@(unless done-label + `((label ,done)))))) + +;; Number of args in NARGS, rest arg is on top of stack +;; The idea is that we pull a single argument, update the state of the world, +;; and then re-execute the same instruction. +(defmacro pull-apply-args-quickly (n rest done-label + temp temp2 temp3 temp4 temp5 temp6 temp7) + "Expects rest-arg has been popped and its SCA is rest" + (check-temporaries (n rest) (temp temp2 temp3 temp4 temp5 temp6 temp7)) + (let ((top (gensym)) + (done (lisp:or done-label (gensym))) + (endloop (gensym)) + (notincache (gensym)) + (ranout (gensym)) + (maybedone (gensym)) + (loopentry (gensym)) + ;; readability + (count temp3) + (argtag temp4) + (argdata temp5) + ;; could share with argxxx + (listtag temp6) + (listdata temp7)) + `((clr ,count) + (stack-cache-overflow-check ,temp ,temp2 ,temp4 ,temp6 ,temp7 iSP ,n) + (ADDI iSP iSP -8 "Pop Stack.") + (B ,loopentry) + (label ,top) + (stack-read2 ,rest ,argtag ,argdata) + ;; Assume we'll push this + (ADDI ,count ,count 1) + (ADDI ,rest ,rest 8) + (cdr-code-dispatch ,argtag ,temp ,temp2 + (|CdrNext| + (stack-push2 ,argtag ,argdata ,temp) + ;; Fast case, test and branch back + (XOR ,temp ,count ,n) + (branch-true ,temp ,top) + (B ,endloop)) + (|CdrNil| + (stack-push2 ,argtag ,argdata ,temp) + (label ,ranout) + ;; Turn off apply + (note-additional-spread-args ,count ,temp ,temp2 t) + ;;; --- KLUDGE: cdr-code-dispatch converts any occurence of the literal 3 to 192! + ;;; --- The following is a manual expansion of: (sldi ,temp2 ,count 3) + (RLDICR ,temp2 ,count |3| 60) + (ADD iLP ,temp2 iLP) + (B ,done)) + (|CdrNormal| + (stack-push2 ,argtag ,argdata ,temp) + (stack-read2 ,rest ,listtag ,listdata) + (type-dispatch ,listtag ,temp ,temp2 + (|TypeList| + (VMAtoSCAmaybe ,listdata ,rest ,notincache ,temp ,temp2) + (B ,loopentry)) + (|TypeNIL| + (B ,ranout)) + (:else + (label ,notincache) + (stack-push2 ,listtag ,listdata ,temp) + (B ,maybedone)))) + (:else + (ADDI ,count ,count -1) ;didn't push + (ADDI ,rest ,rest -8) + (B ,endloop))) + (unlikely-label ,loopentry) + (XOR ,temp ,count ,n) + (branch-true ,temp ,top) + (label ,endloop) + (comment "Here if count=n, or bad cdr") + (SCAtoVMA ,rest ,argdata ,temp) + (stack-push-ir |TypeList| ,argdata ,temp) + (label ,maybedone) + (note-additional-spread-args ,count ,temp ,temp2) + (sldi ,temp2 ,count 3) + (ADD iLP ,temp2 iLP) + (SUBF arg1 ,count ,n) ;exception handler wants ARG1 = args to pull + ;; If we're going to lose, we might as well do it via the slow arg + ;; puller, because we'll either manage to pull an argument more quickly + ;; than we would if we trapped or end up in the debugger, in which case + ;; the slight slowdown is of no consequence. + ,@(if done-label + `((branch-if-less-than-or-equal-to-zero arg1 ,done) + (external-branch |PullApplyArgsSlowly|)) + `((branch-if-greater-than-zero arg1 |PullApplyArgsSlowly|) + (label ,done)))))) + +;; Handle the case where we are pulling a cdr-coded rest arg entirely from +;; the stack cache. The idea is to pull a single argument, push it onto +;; the stack, replace the new rest arg on the stack, fix up the control +;; register, and then restart the instruction. +(defmacro pull-apply-args-slowly (nargs cr atag adata rtag rdata + temp temp2 temp3 temp4 temp5 temp6) + `((stack-top2 ,atag ,adata "Get the rest arg") + ;; Get the arg to push in atag/adata, and the new rest arg in rtag/rdata. + ;; Any exception doing this forces a pull-apply-args trap + (carcdr-internal ,atag ,adata ,rtag ,rdata + ((mov arg1 ,nargs) ;really need to trap now + (external-branch |PULLAPPLYARGSTRAP|)) + ,temp2 ,temp3 ,temp4 ,temp5 ,temp6) + ;; Push the new spread arg on the stack and update the rest arg. + ;; It's OK if we push null rest arg, because restarting the + ;; instruction will clean it up in a moment) + (stack-write2 iSP ,atag ,adata "Push the pulled argument") + (stack-push2 ,rtag ,rdata ,temp "Push the new rest arg") + ;; Note the single new spread arg and restart the instruction + ;; We don't need to fix up PROCESSORSTATE_RESTARTSP because we are + ;; about to go to InterpretInstruction anyway... + (note-additional-spread-args 1 ,cr ,temp2) + (ADDI iLP iLP 8) + (ContinueToInterpretInstruction))) + +(defmacro cleanup-frame (cr done-label + temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 + temp9 temp10 temp11 temp12) + (check-temporaries (cr) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 + temp9 temp10 temp11 temp12)) + (let ((reallydone (lisp:or done-label (gensym))) + (done (gensym)) + (almostdone (gensym)) + (top (gensym)) + (more (gensym)) + (cfuwp 'HANDLEUNWINDPROTECT) + (cfdbt 'DBUNWINDFRAMETRAP)) + `( + (label ,top) + (load-constant ,temp #.1_26 "cr.cleanup-catch") + (LWA ,temp4 PROCESSORSTATE_CATCHBLOCK+4 (ivory)) + (clrldi ,temp4 ,temp4 32) + (AND ,temp2 ,temp ,cr) + (branch-if-zero ,temp2 ,almostdone "J. if cr.cleanup-catch is 0") + (VMAtoSCA ,temp4 ,temp3 ,temp2) + (stack-read2-disp ,temp3 16 ,temp5 ,temp6) ;temp5=cb-cleanup, temp6=cb-previous + (stack-read2-disp ,temp3 8 ,temp ,temp2) ;temp=tag temp2=binding-stack-level + (ANDI-DOT ,temp12 ,temp #x40) + (long-branch-if-nonzero ,temp12 ,cfuwp "J. if catch block is UWP variety.") + (load-constant ,temp3 #.1_26 "cr.cleanup-catch") + (ANDI-DOT ,temp2 ,temp5 #x40 "Extract the catchcleanup bit") + (sldi ,temp2 ,temp2 ,(- 26 6) "Shift into place for CR") + (ANDC ,temp3 ,cr ,temp3) + (OR ,cr ,temp3 ,temp2) + (set-control-register ,cr) + (TagType ,temp5 ,temp5) + (sldi ,temp5 ,temp5 32) + (OR ,temp6 ,temp6 ,temp5) + (STD ,temp6 PROCESSORSTATE_CATCHBLOCK (ivory)) + (B ,top) + (label ,almostdone) + (load-constant ,temp #.1_25 "cr.cleanup-bindings") + (AND ,temp2 ,temp ,cr) + (LD ,temp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (branch-if-zero ,temp2 ,done "J. if cr.cleanup-bindings is 0.") + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (srdi ,temp4 ,temp 32) + (CheckDataType ,temp4 |TypeLocative| ,cfdbt ,temp3 t) + (passthru "#endif") + (label ,more) + (unbind ,temp ,temp2 ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 ,temp10 ,temp11 ,temp12) + (get-control-register ,cr) + (load-constant ,temp #.1_25 "cr.cleanup-bindings") + (AND ,temp2 ,temp ,cr) + (branch-if-nonzero ,temp2 ,more "J. if cr.cleanup-bindings is 0.") + ;; After we've unbound everything, check for a preempt request + (check-preempt-request nil ,temp2 ,temp3) + (label ,done) + (load-constant ,temp3 #.1_24 "cr.trap-on-exit-bit") + (AND ,temp2 ,temp3 ,cr) + (branch-if-zero ,temp2 ,reallydone) + (clr R31) + (illegal-operand trap-on-exit R31) + +; (label ,cfuwp) +; (external-branch HANDLEUNWINDPROTECT "Tail call to handle UNWIND-PROTECT") +; +; (passthru "#ifdef MINIMA") +; (label ,cfdbt) +; (external-branch DBUNWINDFRAMETRAP "Tail call for deep-bound trap") +; (passthru "#endif") + + ,@(unless done-label + `((label ,reallydone)))))) + +;; This is branched to from cleanup-frame when an unwind-protect is +;; encountered. It does not need to be inlined, since the unwind +;; handler deals with retrying the instruction when it exits +(defmacro do-unwind-protect (cr temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (let ((pushpc (gensym)) + (restorebindings (gensym)) + (dupdbt (gensym))) + `((LWA ,temp4 PROCESSORSTATE_CATCHBLOCK+4 (ivory)) + (clrldi ,temp4 ,temp4 32) + (VMAtoSCA ,temp4 ,temp3 ,temp2) + (stack-read2-disp ,temp3 16 ,temp5 ,temp6) ;temp5=cb-cleanup, temp6=cb-previous + (stack-read2-disp ,temp3 8 ,temp ,temp2) ;temp=tag temp2=binding-stack-level + (LD iSP PROCESSORSTATE_RESTARTSP (ivory) "Restore SP") + ;; Restore binding stack. temp2=bindingstacklevel + (LD ,temp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (passthru "#ifdef MINIMA") + (srdi ,temp4 ,temp 32) + (passthru "#endif") + (subfw ,temp3 ,temp2 ,temp ,temp12) + (branch-if-zero ,temp3 ,pushpc "J. if binding level= binding stack") + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (CheckDataType ,temp4 |TypeLocative| ,dupdbt ,temp3) + (passthru "#endif") + (label ,restorebindings) + (unbind ,temp ,cr ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 ,temp10 ,temp11 ,temp12) + (LD ,temp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (subfw ,temp3 ,temp2 ,temp ,temp12) + (branch-if-nonzero ,temp3 ,restorebindings "J. if binding level/= binding stack") + ;; After we've unbound everything, check for a preempt request + (check-preempt-request ,pushpc ,temp2 ,temp3) + (label ,pushpc "Push PC with cleanup bits in CDR") + (convert-pc-to-continuation iPC ,temp3 ,temp ,temp2) + (get-control-register ,cr) + (srdi ,temp2 ,cr ,(- 23 6)) + (ORI ,temp2 ,temp2 #x80) + (ANDI-DOT ,temp2 ,temp2 #xC0) + (TagType ,temp3 ,temp3) + (OR ,temp3 ,temp3 ,temp2) + (stack-push2-with-cdr ,temp3 ,temp) + (comment "Load catch-block PC") + (LWA ,temp4 PROCESSORSTATE_CATCHBLOCK+4 (ivory)) + (clrldi ,temp4 ,temp4 32) + (VMAtoSCA ,temp4 ,temp3 ,temp2) + (stack-read2 ,temp3 ,temp5 ,temp6) ;catch block PC + (convert-continuation-to-pc ,temp5 ,temp6 iPC ,temp) + ;; set cleanup handling bit + (load-constant ,temp #.1_23 "cr.cleanup-in-progress") + (OR ,cr ,cr ,temp) + (stack-read2-disp ,temp3 16 ,temp5 ,temp10) ;temp5 contains the bits in 38/39 + (ANDI-DOT ,temp6 ,temp5 #x80 "This is the extra-arg bit") + (LWA ,temp8 PROCESSORSTATE_EXTRAANDCATCH+4 (ivory)) + (ANDI-DOT ,temp7 ,temp5 #x40 "This is the cleanup-catch bit") + (sldi ,temp6 ,temp6 ,(- 8 7) "Shift bit into place for cr") + (sldi ,temp7 ,temp7 ,(- 26 6) "Shift extra arg bit into place for cr") + (ANDC ,cr ,cr ,temp8) + (OR ,temp6 ,temp6 ,temp7) + (OR ,cr ,cr ,temp6 "update the bits extra-arg/cleanupcatch") + (set-control-register ,cr) + (tagType ,temp5 ,temp5) + (sldi ,temp5 ,temp5 32) + (OR ,temp5 ,temp5 ,temp10) + (STD ,temp5 PROCESSORSTATE_CATCHBLOCK (ivory)) + (ContinueToInterpretInstruction-ValidateCache "Execute cleanup") + (passthru "#ifdef MINIMA") + (label ,dupdbt) + (external-branch DBUNWINDFRAMETRAP "Tail call for deep-bound trap") + (passthru "#endif") + ))) + + +(defmacro abandon-frame-simple + (restorepctest cr cleanuplabel temp temp2 temp3 temp4 temp5 temp6 next-cp) + "If the pc is restored, you must go to InterpretInstructionForBranch to update the CP" + (check-temporaries (cr) (temp temp2 temp3 temp4 temp5 temp6 next-cp)) + (let ((afexc (gensym)) + (norestore (gensym)) + (saved-control-data temp6)) + (push`(((passthru "#ifdef IVERIFY") + (label ,afexc) + (halt-machine) + (passthru "#endif"))) + *function-epilogue*) + `((Comment "Restore machine state from frame header.") + ,@(let ((saved-continuation-tag temp2) + (saved-continuation-data temp3) + (continuation-tag temp4) + (continuation-data temp5)) + ;; Interleave: + ;; (get-continuation2 ,continuation-tag ,continuation-data) + ;; (stack-read-2 ,saved-continuation-tag ,saved-continuation-data) + ;; and check for cleanup + `((LWA ,saved-continuation-data 4 (iFP)) + (load-constant ,temp #.(* 7 1_24) "cleanup bits") + (LWA ,continuation-data PROCESSORSTATE_CONTINUATION+4 (ivory)) + (AND ,temp ,cr ,temp "Mask") + (LWA ,saved-continuation-tag 0 (iFP)) + (mov ,next-cp iCP) + (branch-if-nonzero ,temp ,cleanuplabel "Need to cleanup frame first") + (clrldi ,saved-continuation-data ,saved-continuation-data 32) + (LWA ,continuation-tag PROCESSORSTATE_CONTINUATION (ivory)) + (clrldi ,continuation-data ,continuation-data 32) + + (passthru "#ifdef IVERIFY") + (comment "check for instruction verification suite end-of-test") + (CMPI 0 0 ,saved-continuation-tag #.|TypeNIL| "check for end of run") + (BC 12 2 ,afexc) + (passthru "#endif") + + (stack-read-data-disp iFP 8 ,saved-control-data "Get saved control register" :signed t) + (TagType ,saved-continuation-tag ,saved-continuation-tag) + (comment "Restore the PC.") + ,@(when restorepctest + `(,@(cond ((atom restorepctest) `()) + ((eq (first restorepctest) 'not) + `((branch-false ,(second restorepctest) ,norestore))) + (t + `((branch-true ,(first restorepctest) ,norestore)))) + ;; inline (convert-continuation-to-pc continuation-tag + ;; continuation-data iPC temp) with load of continuationcp + (sldi iPC ,continuation-data 1 "Assume even PC") + (ANDI-DOT ,temp ,continuation-tag 1) + (LD ,next-cp PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (ADD iPC iPC ,temp))) + (label ,norestore) + ;; (set-continuation2 ,saved-continuation-tag ,saved-continuation-data) + (comment "Restore the saved continuation") + (STW ,saved-continuation-tag PROCESSORSTATE_CONTINUATION (ivory)) + (srdi ,temp ,cr 9 "Get the caller frame size into place") ;+++ magic# + (STW ,saved-continuation-data PROCESSORSTATE_CONTINUATION+4 (ivory)) + )) + (ADDI iSP iFP -8 "Restore the stack pointer.") + (stzd PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (ANDI-DOT ,temp ,temp #xFF "Mask just the caller frame size.") + (sldi ,temp ,temp 3 "*8") + + (load-constant ,temp2 #.1_27 "cr.trace-pending") + (AND ,temp2 ,temp2 ,cr) + (LWA ,temp3 PROCESSORSTATE_INTERRUPTREG (ivory) "Get the preempt-pending bit") + (OR ,saved-control-data ,temp2 ,saved-control-data "Sticky trace pending bit.") + (LD ,temp4 PROCESSORSTATE_PLEASE_STOP (ivory) "Get the trap/suspend bits") + (SUBF iFP ,temp iFP "Restore the frame pointer.") + (set-control-register ,saved-control-data "Restore the control register") + (ANDI-DOT ,temp ,saved-control-data #xFF "extract the argument size") + ;; Store OR of suspend, trap, and preempt-pending + (ANDI-DOT ,temp3 ,temp3 1) + (OR ,temp3 ,temp4 ,temp3) + (STD ,temp3 PROCESSORSTATE_STOP_INTERPRETER (ivory)) + (sldi iLP ,temp 3) + (ADD iLP iFP iLP "Restore the local pointer.") + ))) + + diff --git a/g5-emulator/idispat.ppcs b/g5-emulator/idispat.ppcs new file mode 100644 index 0000000..fc388aa --- /dev/null +++ b/g5-emulator/idispat.ppcs @@ -0,0 +1,363 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(comment "This file implements the main instruction dispatch loop.") + +(include-header "kludges.s") ;+++ this will be unnecessary at some time + +(define-procedure |DummyDoNothingSubroutine| () + (B continuecurrentinstruction)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Start of protected first page of cache. First class for frequent fliers ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(passthru ".globl NEXTINSTRUCTION") +(passthru ".globl INTERPRETINSTRUCTION") +(passthru ".globl ICACHEMISS") + + +;; Common memory subroutines --- here for lack of a better place. Only +;; the tails of these routines are used, and pretty rarely + +(define-memory-subroutine |MemoryReadData| + (arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-memory-subroutine |MemoryReadGeneral| + (arg2 arg5 arg6 arg3 t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-memory-subroutine |MemoryReadHeader| + (arg2 arg5 arg6 PROCESSORSTATE_HEADER t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-memory-subroutine |MemoryReadCdr| + (arg2 arg5 arg6 PROCESSORSTATE_CDR t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(align4k) ;starting at an arbitrary 4k boundary. + +;; Nota Bene: CACHELINE_INSTRUCTION/CACHELINE_OPERAND have a much more +;; complicated organization than you might think. For Full-word +;; instructions, CACHELINE_INSTRUCTION holds the instruction with the +;; cdr stripped (as a Quadword), for use by push-constant. For packed +;; instructions, CACHELINE_INSTRUCTION holds the instruction for +;; dispatching within instructions on opcode; and CACHELINE_OPERAND +;; holds the unsigned 10-bit operand in it's low word and a +;; sign-extended version in its high word. This whole mish-mash is +;; loaded into ARG3 by nextInstruction, with appropriate bits loaded out +;; by the various instruction entries. + +;; NB: The PowerPC is big-endian which means that when you do a 32-bit +;; operation on CACHELINE_OPERAND, you need to use CACHELINE_OPERAND-4 +;; as the offset or the processor will overwrite CACHELINE_INSTRUCTION +;; instead. It's not possible to reverse CACHELINE_INSTRUCTION and +;; CACHELINE_OPERAND in aistat.sid as that would cause 64-bit +;; operations on CACHELINE_INSTRUCTION to be unaligned. (Sigh) + +;; NB: T1 through T9, ARG5, and ARG6 are aliased to other register names +;; here, so don't use them for anything! +(define-procedure |DoICacheFill| () + ;; Here from an escape, hence we must recompute iCP according to the + ;; real PC. Also, sometimes cache-miss is because we tried to + ;; execute escape, so... + #+iCacheMiss-after-iInterpret (label TakeICacheMiss) + (label ICacheMiss) + (comment "Here when instruction cache miss detected. Fill the cache from") + (comment "PC and then resume interpreter loop") + (comment "First round the PC down to an even halfword address") + ;; Inlined call to (PC-TO-ICACHEENT epc ecp arg3 arg4) follows... + (LD arg2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (clrrdi epc iPC 1 "the even PC") + #-old-cache-hash (srdi ecp epc #.|CacheLineRShift|) + (load-constant arg1 #.|CacheLineMask|) + #-old-cache-hash (sldi ecp ecp #.|CacheLineLShift|) + (srdi instn iPC 1 "instn is instruction address here") + #-old-cache-hash (ADD ecp epc ecp) + #-old-cache-hash (AND ecp ecp arg1) + #+old-cache-hash (AND ecp epc arg1) + (sldi arg3 ecp 5 "temp=cpos*32") + (sldi ecp ecp 4 "cpos=cpos*16") + (ADD arg4 arg2 arg3 "temp2=base+cpos*32") + (ADD ecp arg4 ecp "cpos=base+cpos*48") + (ORI opc epc 1 "the odd PC") + (mov iCP ecp "Assume iPC is the even PC") + (XOR arg1 opc iPC "See if iPC is the odd PC arg1=0 if opc==iPC") + ;; The odd PC's cache pointer immediately follows + (ADDI ocp ecp #.CACHELINESIZE) + (CMPI 0 1 arg1 0) + (BC 4 2 skip1 "B.NE ie: iPC!=opc") + (mov iCP ocp "Stash the odd cache pointer if iPC is the odd PC") + (unlikely-label skip1) + (LD hwdispatch PROCESSORSTATE_HALFWORDDISPATCH (ivory)) + (load-constant hwopmask #x3FF "Halfword operand mask") + (LD fwdispatch PROCESSORSTATE_FULLWORDDISPATCH (ivory)) + (load-constant count #.|CacheLineFillAmount|) + (VM-Read instn arg4 iword t10 t11 t) + (B FillICachePrefetched) + + ;; These come before FillICache to get branch prediction right... + (label PCbackOne) + (comment "Wire in continuation for even half") + (STD epc CACHELINE_NEXTPCDATA (ocp)) + (ADDI t10 ecp #.(- CACHELINESIZE) "Backup in cache too") + (STD ecp CACHELINE_NEXTCP (ocp)) + (ADDI arg1 epc -1 "Backup PC one halfword") + (STD t10 CACHELINE_NEXTCP (ecp)) + (TagType arg4 arg4 "arg4=tag-cdr code") + (STD arg1 CACHELINE_NEXTPCDATA (ecp)) + (comment "Wire in continuation for odd half") + (B MaybeUnpack) + + (label PCadvOne) + (STD opc CACHELINE_NEXTPCDATA (ecp) "Simple advance of PC one halfword.") + (ADDI arg1 opc 1) + (STD ocp CACHELINE_NEXTCP (ecp)) + (ADDI t10 ocp #.cacheline$k-size) + (STD arg1 CACHELINE_NEXTPCDATA (ocp)) + (TagType arg4 arg4 "arg4=tag-cdr code") + (STD t10 CACHELINE_NEXTCP (ocp)) + (B MaybeUnpack) + + (comment "This is the cache fill loop.") + (label FillICache) + (VM-Read instn arg4 iword t10 t11) + (label FillICachePrefetched) + (passthru "#ifdef CACHEMETERING") + (comment "Increment the fill count for both cache entries") + (LWA t10 CACHELINE_ANNOTATION+4 (ecp)) ;+++ use lwz and save rldicl below + (LWA t11 CACHELINE_ANNOTATION+4 (ocp)) ;+++ use lwz and save rldicl below + (clrldi t10 t10 32) + (clrldi t11 t11 32) + (ADDI t10 t10 1) + (STW t10 CACHELINE_ANNOTATION+4 (ecp)) + (ADDI t11 t11 1) + (STW t11 CACHELINE_ANNOTATION+4 (ocp)) + (passthru "#endif") + (STD epc CACHELINE_PCDATA (ecp) "Set address of even cache posn.") + (ANDI-DOT arg1 arg4 #xC0 "CDR code << 6") + (TagType arg4 arg4 "Strip cdr") + (STD opc CACHELINE_PCDATA (ocp) "Set address of odd cache posn.") + (clrldi iword iword 32 "Strip nasty bits out.") + (force-alignment) + (sldi arg2 arg4 32 "ready to remerge") + (branch-if-zero arg1 PCadvOne "Zerotag means advance one HW") + (ADDI arg1 arg1 #.(- #x80) "2<<6") + (branch-if-zero arg1 PCbackOne "Tag=2 means backup one HW") + (branch-if-less-than-zero arg1 PCendCF "Tag=1 means end of compiled function") + + (label PCadvTwo) + (comment "Tag=3 means advance over one full word") + (Comment "Wire in continuation for even half") + (ADDI arg1 epc 2 "Next word") + (NOP) + (ADDI t10 ecp #.(* 2 cacheline$k-size) "corresponding CP entry") + (STD arg1 CACHELINE_NEXTPCDATA (ecp) "Next PC even of next word") + (ADDI arg1 epc 4 "Skip one fullword") + (STD t10 CACHELINE_NEXTCP (ecp) "Next CP") + (comment "Wire in continuation for odd half") + (ADDI t10 ecp #.(* 4 cacheline$k-size) "corresponding CP entry") + (STD arg1 CACHELINE_NEXTPCDATA (ocp)) + (TagType arg4 arg4 "arg4=tag-cdr code") + (STD t10 CACHELINE_NEXTCP (ocp)) + (B MaybeUnpack) + + ;; The feature FILL-PAST-CALL controls whether icache filling keeps + ;; going when it sees a FINISH-CALL instruction. + (label DecodePackedWord) + (comment "Here to decode a packed word") + (passthru "#ifdef CACHEMETERING") + (maybe-meter-miss t10 arg4 t12 t11 arg2 arg1) ; count the odd instruction. + (passthru "#endif") + (srdi arg4 iword 18 "arg4 contains the odd packedword") + (srdi t10 iword 8 "even opcode+2bits") + (STD arg4 CACHELINE_INSTRUCTION (ocp) "Save the odd instruction") + (sldi t11 iword #.(- 64 10) "First phase of even operand sign extension.") + (AND t12 iword hwopmask "even operand+2bits") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + ;; Clear the annotation field (used for branch-taken cache) + (stzd CACHELINE_ANNOTATION (ocp)) + (passthru "#endif") + (AND t10 t10 hwopmask "even opcode") + (SRADI t11 t11 #.(- 64 10 16) "Second phase of even operand sign extension.") + #-fill-past-call (ADDI arg2 t10 #.(- I-LISP-COMPILER:*FINISH-CALL-N-OPCODE*)) + (sldi t10 t10 3) + (ADD t10 hwdispatch t10) + (OR t12 t11 t12 "Merge signed/unsigned even operand") + #-fill-past-call (clrrdi arg2 arg2 2) + (STW t12 CACHELINE_OPERAND-4 (ecp)) + #-fill-past-call (CMPI 0 1 arg2 0) + #-fill-past-call (BC 4 2 skip2 "B.NE") + #-fill-past-call (mov count arg2 "clear count if finish-call seen") + #-fill-past-call (unlikely-label skip2) + (srdi arg2 arg4 8 "odd opcode+2bits") + (sldi t11 arg4 #.(- 64 10) "First phase of odd operand sign extension.") + (AND arg1 arg4 hwopmask "odd operand+2bits") + (LD t10 0 (t10)) + (AND arg2 arg2 hwopmask "odd opcode") + (SRADI t11 t11 #.(- 64 10 16) "Second phase of odd operand sign extension.") + (STD t10 CACHELINE_CODE (ecp)) + #-fill-past-call (ADDI t12 arg2 #.(- I-LISP-COMPILER:*FINISH-CALL-N-OPCODE*)) + (sldi arg2 arg2 3) + (ADD arg2 hwdispatch arg2) + (OR arg1 t11 arg1 "Merge signed/unsigned odd operand") + (STW arg1 CACHELINE_OPERAND-4 (ocp)) + #-fill-past-call (clrrdi t12 t12 2) + (LD arg2 0 (arg2)) + #-fill-past-call (CMPI 0 1 t12 0) + #-fill-past-call (BC 4 2 skip3 "B.NE") + #-fill-past-call (mov count t12 "clear count if finish-call seen") + #-fill-past-call (unlikely-label skip3) + (STD arg2 CACHELINE_CODE (ocp)) + (B EndDecode) + + (label MaybeUnpack) + ;; C.f., aistat.sid. We store the instruction as a Q, clobbering + ;; the overlapping operand field for full-word instructions. If + ;; this turns out to be packed instead, the operand field will get + ;; updated appropriately when we decode + (OR iword arg2 iword "reassemble tag and word.") + (STD iword CACHELINE_INSTRUCTION (ecp) "save the even instruction") + (ADDI t10 arg4 #.(- #o60) "t10>=0 if packed") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + ;; Clear the annotation field (used for branch-taken cache) + (stzd CACHELINE_ANNOTATION (ecp)) + (passthru "#endif") + (passthru "#ifdef CACHEMETERING") + (maybe-meter-miss t11 t12 t10 arg1 arg2 epc) ; count the even instruction. + (passthru "#endif") + (branch-if-greater-than-or-equal-to-zero t10 DecodePackedWord "B. if a packed instruction") + (sldi t11 arg4 3) + (ADD t11 fwdispatch t11 "t11 is the fwdispatch index") + (LD t12 PROCESSORSTATE_I_STAGE_ERROR_HOOK (ivory)) + #-fill-past-native (ADDI arg1 arg4 #.(- |type$K-nativeinstruction|)) + (LD t11 0 (t11) "Extract the opcode handler") + (STD t12 CACHELINE_CODE (ocp) "Store I-STATE-ERROR at odd pc") + #-fill-past-call (CMPI 0 1 arg1 0) + #-fill-past-call (BC 4 2 skip4 "B.NE") + #-fill-past-call (mov count arg1 "clear count if native instn seen") + #-fill-past-call (unlikely-label skip4) + (STD t11 CACHELINE_CODE (ecp)) + ;(B EndDecode) + + (label EndDecode) + (comment "Here we decide if to stop filling the cache and return to the") + (comment "instruction interpretation stream, or whether to fill further") + (ADDI instn instn 1) + (branch-if-less-than-or-equal-to-zero count cacheValid "If count is zero, resume") + (sldi epc instn 1) + (ADDI count count -1 "decrement count") + (ORI opc epc 1) + (LD t10 PROCESSORSTATE_ENDICACHE (ivory) "pointer to the end of icache") + (ADDI ocp ocp #.(* 2 cacheline$k-size)) + (ADDI ecp ecp #.(* 2 cacheline$k-size)) + (SUBF t10 t10 ocp) + (branch-if-less-than-or-equal-to-zero t10 FillICache "Still room for more") + (B cacheValid) + + (label PCendCF) + (LD t11 PROCESSORSTATE_I_STAGE_ERROR_HOOK (ivory)) + (clr count "We reached the end of the fcn.") + (STD t11 CACHELINE_CODE (ecp) "Store I-STATE-ERROR dispatch at even and odd pc") + (STD t11 CACHELINE_CODE (ocp)) + (B EndDecode) +) + + +(comment "These are the instruction reentry points. Instructions end by returning") +(comment "control to one of these tags. Most normal instructions reenter by jumping") +(comment "to NEXTINSTRUCTION, which advances the PC and continues normally. ") +(comment "Instructions that change the PC usually go directly to INTERPRETINSTRUCTION.") +(comment "Instructions that fail/trap/exception etc, go to one of the other places.") + +(define-external-procedure |iInterpret| (arg1) + (STD SP PROCESSORSTATE_IINTERPRET_SP (arg1) "Save stack frame for iOutOfLine") + (mov ivory arg1 "Setup our processor object handle") + (comment "Upon entry, load cached state.") + (cache-ivory-state) + + (branch-if-nonzero iCP interpretinstruction "First time in iCP will be zero.") + + (B ICacheMiss "If this is the first time in cache is empty!") + + #+jump-prediction (label interpretInstructionForJump) + #+jump-prediction (LD arg2 CACHELINE_ANNOTATION (iCP)) + #+jump-prediction (branch-if-zero arg2 interpretInstructionForBranch) + ;; Fall through to interpretInstructionPredicted... + + ;; This duplicates most of interpretInstruction, because it needs to + ;; verify the prediction and do things the hard way if the prediction + ;; is wrong, before smashing iCP (so the prediction can be fixed up) + (label interpretInstructionPredicted) + (LD t2 CACHELINE_PCDATA (arg2) "Get the PC to check cache hit.") + + ;; Don't bother resetting r30, we can't get here from a restart + (mov arg1 iFP "Assume FP mode") + (LD R0 PROCESSORSTATE_STOP_INTERPRETER (ivory) "Have we been asked to stop?") + (ADDI arg4 iSP -8 "SP-pop mode constant") + (LD arg3 CACHELINE_INSTRUCTION (arg2) "Grab the instruction/operand while stalled") + (SUBF t1 t2 iPC) + ;; On no match, recompute iCP before resorting to refilling cache + ;; (the assumption is that you have a mis-prediction in this case + (branch-if-nonzero t1 interpretInstructionForBranch) + (mov iCP arg2) + ;; Nota Bene: traporsuspendmachine must not smash any of the + ;; registers set up above: arg1, arg3, arg4, or t2, if it comes back + ;; to continuecurrentinstruction + (long-branch-if-nonzero R0 traporsuspendmachine "Stop the world! someone wants out.") + (B continuecurrentinstruction) + + #-jump-prediction (label interpretInstructionForJump) + + (label interpretInstructionForBranch) + ;; In effect, an inlined call to (PC-TO-iCACHEENT iPC iCP t4 t5) + (LD t5 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (load-constant t4 #.|CacheLineMask|) + #-old-cache-hash (srdi arg2 iPC #.|CacheLineRShift|) + #-old-cache-hash (sldi arg2 arg2 #.|CacheLineLShift|) + #-old-cache-hash (ADD arg2 iPC arg2) + #-old-cache-hash (AND arg2 arg2 t4) + #+old-cache-hash (AND arg2 iPC t4) + (sldi t4 arg2 5 "temp=cpos*32") + (sldi arg2 arg2 4 "cpos=cpos*16") + (ADD t5 t5 t4 "temp2=base+cpos*32") + (force-alignment) + (ADD arg2 t5 arg2 "cpos=base+cpos*48") + ;; We come here if the branch has previously cached the hash, with + ;; the arg2 in arg2 + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + ;; Save the computed branch-taken CP in ANNOTATION + (STD arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + ;; See above (label interpretInstructionPredicted) + (mov iCP arg2) + + (label interpretInstruction) + ;; If we come here from a restart, we flush any in-progress + ;; subroutine calls (pop the stack back) + ;(LD r30 PROCESSORSTATE_ASRR30 (ivory)) + (LD R0 PROCESSORSTATE_STOP_INTERPRETER (ivory) "Have we been asked to stop?") + (mov arg1 iFP "Assume FP mode") + (LD arg3 CACHELINE_INSTRUCTION (iCP) "Grab the instruction/operand while stalled") + (ADDI arg4 iSP -8 "SP-pop mode constant") + (LD t2 CACHELINE_PCDATA (iCP) "Get the PC to check cache hit.") + ;; Nota Bene: traporsuspendmachine must not smash any of the + ;; registers set up above: arg1, arg3, arg4, or t2, if it comes back + ;; to continuecurrentinstruction + (long-branch-if-nonzero R0 traporsuspendmachine "Stop the world! someone wants out.") + (B continuecurrentinstruction) + + ) + +;;; nextInstruction moved to ifuncom1 to concatenate with DoPush, the +;;; most popular instruction + +;;; End of idispat + diff --git a/g5-emulator/idouble.ppcs b/g5-emulator/idouble.ppcs new file mode 100644 index 0000000..b17b7f5 --- /dev/null +++ b/g5-emulator/idouble.ppcs @@ -0,0 +1,73 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Support for double precision floating point.") + +(define-subroutine |FetchDoubleFloat| + (arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (fetch-double-float-internal arg2 arg5 arg6 t5 t6 t7 t8) + )) + +(define-subroutine |ConsDoubleFloat| + (arg2 arg5 arg6 t5 t6 t7 t8 t9 t10) + (r0) + (clr R31) + (cons-double-float-internal arg5 arg6 R31 arg2 t5 t6 t7 t8 t9 t10)) + +(define-instruction |DoDoubleFloatOp| :operand-from-stack-immediate () + ;; The top four things are the stack are fixnums that represent the + ;; two double-float quantities. We don't bother to type-check them. + (LWA arg3 -20 (iSP) "X high") + (LWA arg4 -12 (iSP) "X low") + (LWA arg5 -4 (iSP) "Y high") + (LWA arg6 4 (iSP) "Y low") + (sldi arg3 arg3 32 "Get high part up top") + (clrldi arg4 arg4 32) + (sldi arg5 arg5 32 "Get high part up top") + (clrldi arg6 arg6 32) + (OR arg3 arg3 arg4 "ARG3 is now X") + (OR arg5 arg5 arg6 "ARG5 is now Y") + (STD arg3 PROCESSORSTATE_FP0 (ivory)) + (STD arg5 PROCESSORSTATE_FP1 (ivory)) + (srdi t2 arg1 32 "Immediate tag") + (clrldi t1 arg1 32 "Immediate data") + (CheckDataType t2 |TypeFixnum| doublefloatiop t3) + (LFD f1 PROCESSORSTATE_FP0 (ivory)) + (LFD f2 PROCESSORSTATE_FP1 (ivory)) + (floating-exception-checking-prelude) + (register-dispatch t1 t2 t3 + (|DoubleFloatOpAdd| + (FADD f1 f2 f1)) + (|DoubleFloatOpSub| + (FSUB f1 f2 f1)) + (|DoubleFloatOpMultiply| + (FMUL f1 f2 f1)) + (|DoubleFloatOpDivide| + (FDIV f1 f2 f1))) + (floating-exception-checking-postlude doublefloatexc t1) + (get-nil t3 "There was no FP exception") + (unlikely-label doublefloatmerge) + (STFD f1 PROCESSORSTATE_FP0 (ivory)) + (LWA t1 PROCESSORSTATE_FP0+4 (ivory)) + (LWA t2 PROCESSORSTATE_FP0 (ivory)) + ;;+++ The next four lines should be made more efficient + (ADDI iSP iSP -32 "Pop all the operands") + (stack-push-fixnum t2 t4 "Push high result") + (stack-push-fixnum t1 t4 "Push low result") + (stack-push t3 t4 "Push the exception predicate") + (ContinueToNextInstruction) + (label doublefloatexc) + ;; We don't signal a real exception because this gets used in Genera's + ;; floating point exception handlers, and we don't want recursive lossage. + (get-t t3 "Indicate an FP exception occurred") + (B doublefloatmerge) + (label doublefloatiop) + (illegal-operand unknown-double-float-op)) + + +(comment "Fin.") diff --git a/g5-emulator/ifunarra.ppcs b/g5-emulator/ifunarra.ppcs new file mode 100644 index 0000000..db17dd9 --- /dev/null +++ b/g5-emulator/ifunarra.ppcs @@ -0,0 +1,373 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Array operations.") + + +;; |DoAref1| and |DoAset1| are in IFUNCOM2.PPCS +;; The following is all of their out-of-line code + +(define-procedure |Aref1Regset| () + (mov t12 arg4) + (memory-read arg4 arg5 arg6 PROCESSORSTATE_HEADER t1 t2 t3 t4 nil nil) + (check-array-header-and-prefix arg5 arg6 Aref1Illegal |Aref1Exception| t1 t2) + ;; What we are about to do is strictly wrong -- but it works. If the + ;; memory read moved the array, we put the array into the WRONG register, + ;; and then use it. next time through, it will miss (because we put it + ;; in the wrong place), and the miss code will fix it up. It's better + ;; than slowing down the common case with a check. + (STW t12 ARRAYCACHE_ARRAY+4 (t7) "store the array") + (li t2 |ArrayLengthMask|) + (AND t1 arg6 t2) ;get array length into t1 + ;; (check-array-bounds arg2 t1 Aref1Bounds t2) + (CMPL 0 1 arg2 t1) + (BC 4 0 Aref1Bounds "B. if not arg2 Deep-bound") + (CheckDataType t2 |TypeLocative| bindloctovaldeep t1) + (passthru "#endif") + (get-control-register t9) + (mov t8 arg6) + (memory-read t8 t2 t1 PROCESSORSTATE_BINDREAD t4 t5 t6 t7 nil t) + ;; set the ls cdcode bit for ltag ifcleanupbindings + (srdi t10 t9 #.(- 25 6)) + (TagType arg5 t8) + (ANDI-DOT t10 t10 #x40 "Extract the CR.cleanup-bindings bit") + (OR t11 t10 t8) + (memory-write t3 t11 arg6 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (ADDI t3 arg3 2) + (memory-write t3 t2 t1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (load-constant t1 #.1_25 "cr.cleanup-bindings") + (store-contents arg6 arg2 arg1 PROCESSORSTATE_BINDWRITE t4 t5 t6 t7 t8 t10) + (OR t9 t1 t9 "Set cr.cleanup-bindings bit") + (set-control-register t9) + (STW t3 PROCESSORSTATE_BINDINGSTACKPOINTER+4 (ivory) "vma only") + (ContinueToNextInstruction) + (label bindloctovalov) + (illegal-operand binding-stack-overflow) + (label bindloctovaliop) ;+++ exception if spare pointer type + (illegal-operand bind-locative-type-error) + (label bindloctovaldeep) + (LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand shallow-binding-operation-in-deep-binding-mode t2)) + +;;+++ Figure out if we can use WITH-MULTIPLE-MEMORY-READS +(define-instruction |DoBindLocative| :operand-from-stack () + (LD arg1 0 (arg1) "Get the operand") + (LD arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (srdi arg5 arg1 32 "tag") + (LD arg4 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory)) + (clrldi arg6 arg1 32 "data") + (CheckDataType arg5 |TypeLocative| bindlociop t1) + (passthru "#ifdef MINIMA") + (srdi t2 arg3 32) + (passthru "#endif") + (clrldi arg3 arg3 32) + (clrldi arg4 arg4 32) + (SUBF t1 arg4 arg3) + (branch-if-greater-than-or-equal-to-zero t1 bindlocov "J. if binding stack overflow") + (ADDI t3 arg3 1) + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (CheckDataType t2 |TypeLocative| bindlocdeep t1) + (passthru "#endif") + (get-control-register t9) + (mov t8 arg6) + (memory-read t8 t2 t1 PROCESSORSTATE_BINDREAD t4 t5 t6 t7 nil t) + ;; set the ls cdcode bit for ltag ifcleanupbindings + (srdi t10 t9 #.(- 25 6)) + (TagType arg5 t8) + (ANDI-DOT t10 t10 #x40 "Extract the CR.cleanup-bindings bit") + (OR t11 t10 t8) + (memory-write t3 t11 arg6 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (ADDI t3 arg3 2) + (memory-write t3 t2 t1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8) + (load-constant t1 #.1_25 "cr.cleanup-bindings") + (OR t9 t1 t9 "Set cr.cleanup-bindings bit") + (set-control-register t9) + (STW t3 PROCESSORSTATE_BINDINGSTACKPOINTER+4 (ivory) "vma only") + (ContinueToNextInstruction) + (label bindlocov) + (illegal-operand binding-stack-overflow) + (label bindlociop) + (illegal-operand bind-locative-type-error) + (label bindlocdeep) + (LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand shallow-binding-operation-in-deep-binding-mode t2)) + + +;(align16k) + +(define-instruction |DoUnbindN| :operand-from-stack-immediate () + (passthru "#ifdef MINIMA") + (LD arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (passthru "#endif") + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (CheckDataType arg2 |TypeFixnum| unbindniop t1) + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (srdi t2 arg3 32) + (CheckDataType t2 |TypeLocative| unbindndeep t1) + (passthru "#endif") + (with-multiple-memory-reads (t9 t10 t11 t12) + (B unbindnendloop) + (label unbindntoploop) + (ADDI arg1 arg1 -1) + (unbind t1 t2 t3 t4 t5 t6 t7 t8 arg3 arg4 arg5 arg6) + (label unbindnendloop) + (branch-if-greater-than-zero arg1 unbindntoploop) + ;; After we've unbound everything, check for a preempt request + (check-preempt-request NextInstruction t3 t4 t) + (ContinueToNextInstruction)) + (label unbindniop) + (illegal-operand one-operand-fixnum-type-error) + (passthru "#ifdef MINIMA") + (label unbindndeep) + (LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand shallow-binding-operation-in-deep-binding-mode t2) + (passthru "#endif")) + + +(define-instruction |DoRestoreBindingStack| :operand-from-stack-immediate () + (passthru "#ifdef MINIMA") + (LD arg3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (passthru "#endif") + (srdi arg2 arg1 32 "arg2=tag") + (clrldi arg1 arg1 32 "arg1=data") + (CheckDataType arg2 |TypeLocative| restorebsiop t1) + (passthru "#ifdef MINIMA") + (comment "BSP not a locative -> Deep-bound") + (srdi t2 arg3 32) + (CheckDataType t2 |TypeLocative| restorebsdeep t1) + (passthru "#endif") + (LD t1 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (B restorebsendloop) + (label restorebstoploop) + ;; Leaves T1 as the new binding stack pointer + (unbind t1 t2 t3 t4 t5 t6 t7 t8 arg3 arg4 arg5 arg6) + (label restorebsendloop) + (CMPL 0 0 t1 arg1 "32-bit unsigned compare") + (BC 12 1 restorebstoploop "B. if greater than zero") + ;; After we've unbound everything, check for a preempt request + (check-preempt-request NextInstruction t3 t4 t) + (ContinueToNextInstruction)) + (label restorebsiop) + (illegal-operand operand-locative-type-error) + (passthru "#ifdef MINIMA") + (label restorebsdeep) + (LD t1 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (SCAtoVMA t1 t2 t3) + (illegal-operand operand-locative-type-error t2) + (passthru "#endif")) + + +(comment "Fin.") diff --git a/g5-emulator/ifunbits.ppcs b/g5-emulator/ifunbits.ppcs new file mode 100644 index 0000000..7fd67b5 --- /dev/null +++ b/g5-emulator/ifunbits.ppcs @@ -0,0 +1,105 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Bits.") + +(define-instruction |DoLogand| :operand-from-stack-immediate (:own-immediate t) + (ilogical logand AND) + (immediate-handler |DoLogand|) + (ilogical-immediate logand AND)) + +(define-instruction |DoLogior| :operand-from-stack-immediate (:own-immediate t) + (ilogical logior OR) + (immediate-handler |DoLogior|) + (ilogical-immediate logior OR)) + + +(define-instruction |DoLogxor| :operand-from-stack-immediate (:own-immediate t) + (ilogical logxor XOR) + (immediate-handler |DoLogxor|) + (ilogical-immediate logxor XOR)) + + +;;; arg1 on stack = number to shift +;;; arg2 operand = shift count +(define-instruction |DoAsh| :operand-from-stack-signed-immediate () + (stack-read2 iSP arg3 arg4 "Get ARG1.") + (srdi arg2 arg1 32 "Get ARG2's tag.") + (exts arg1 arg1 32 "Sign extended the rotation amount.") + (binary-type-dispatch (arg2 arg3 t1 t2 t3 t4) + ((|TypeFixnum| |TypeFixnum|) + (branch-if-zero arg4 zerash "B. if ash of zero -- trivial case") + (branch-if-less-than-or-equal-to-zero arg1 negash "B. if negative ash.") + (exts arg4 arg4 32 "Sign extend ARG1 before shifting.") + (ADDI arg5 arg1 -32) + (branch-if-greater-than-zero arg5 ashovexc) + (SLD arg5 arg4 arg1 "Shift Left") + (XOR arg6 arg4 arg5) + (srdi arg6 arg6 31 "arg6<0>=1 if overflow, 0 otherwise") + (TagType arg2 arg2) ;strip cdr code from DTP-FIXNUM + (branch-if-nonzero arg6 ashovexc "J. if overflow") + (stack-write2 iSP arg2 arg5) ;simulate push. + (ContinueToNextInstruction) + (label negash) + (NEG arg1 arg1) + (exts arg4 arg4 32 "Sign extend ARG1 before shifting.") + (SRAD arg5 arg4 arg1 "Shift Right") + (TagType arg2 arg2) ;strip cdr code from DTP-FIXNUM + (stack-write2 iSP arg2 arg5) ;simulate push. + (ContinueToNextInstruction) + (label zerash) + (stack-write-ir |TypeFixnum| arg4 arg5) + (continueToNextInstruction)) + (:else1 + (clrldi arg1 arg1 32) + (SetTag arg2 arg1 t2) + (NumericTypeException arg2 ash t2)) + (:else2 + (clrldi arg1 arg1 32) + (SetTag arg2 arg1 t2) + (NumericTypeException arg3 ash t2))) + (label ashovexc) + (clrldi arg1 arg1 32) + (SetTag arg2 arg1 t1) + (prepare-exception ash 0 t1 arg2) + (instruction-exception)) + +;;; Really signed-immediate but taking low five bits eliminates the need to be careful +(define-instruction |DoRot| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |DoRot|) + (ANDI-DOT t2 t2 #x1F "Get low 5 bits of the rotation") + (SLD t3 t1 t2 "Shift left to get new high bits") + (srdi t6 t3 32 "Get new low bits") + (OR t3 t3 t6 "Glue two parts of shifted operand together"))) + +(define-instruction |DoLsh| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |DoLsh| nil t) + (branch-if-less-than-zero t2 neglsh "B. if negative lsh.") + ;;compare to 32, if greater, result is zero + (ADDI t3 t2 -32) + (branch-if-greater-than-or-equal-to-zero t3 returnzero) + (SLD t3 t1 t2 "Shift Left") + (B lshdone) + (label neglsh) + (NEG t2 t2) + (ADDI t3 t2 -32) + (branch-if-greater-than-or-equal-to-zero T3 returnzero) + (SRD t3 t1 t2 "Shift Right") + (B lshdone) + (label returnzero) + (clr t3) ;answer is zero if (abs ) >= 32 + (label lshdone))) + + +(define-instruction |Do32BitPlus| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |Do32BitPlus|) + (ADD t3 t1 t2 "Perform the 32 bit Add."))) + +(define-instruction |Do32BitDifference| :operand-from-stack (:own-immediate t :needs-tos t) + (with-simple-binary-fixnum-operation (t1 t2 t3 t4 t5 t7 t8 |Do32BitDifference|) + (SUBF t3 t2 t1 "Perform the 32 bit Difference."))) + +(comment "Fin.") diff --git a/g5-emulator/ifunblok.ppcs b/g5-emulator/ifunblok.ppcs new file mode 100644 index 0000000..ac8af07 --- /dev/null +++ b/g5-emulator/ifunblok.ppcs @@ -0,0 +1,85 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Block Instructions.") + +(define-instruction |DoBlock0Read| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR0) + (B |BlockRead|)) + +;; |DoBlock3Read|, |DoBlock2Read|, and |DoBlock1Read| are in IFUNCOM1.PPCS + + +(define-instruction |DoBlock0Write| :operand-from-stack-signed-immediate () + (LWA arg3 PROCESSORSTATE_BAR0+4 (ivory)) + (ADDI arg2 ivory PROCESSORSTATE_BAR0) + (B |BlockWrite|)) + +;; |DoBlock3Write|, |DoBlock2Write|, and |DoBlock1Write| are in IFUNCOM1.PPCS + + +(define-instruction |DoBlock0ReadShift| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR0) + (B |BlockReadShift|)) + +(define-instruction |DoBlock3ReadShift| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR3) + (B |BlockReadShift|)) + +(define-instruction |DoBlock2ReadShift| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR2) + (B |BlockReadShift|)) + +;; ARG1 has the cycle type and flags, put the proper BAR into ARG2 +(define-instruction |DoBlock1ReadShift| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR1) + (label |BlockReadShift|) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (i%block-n-read-shift arg2 arg1 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12))) + + +(define-instruction |DoBlock0ReadAlu| :operand-from-stack () + (ADDI arg2 ivory PROCESSORSTATE_BAR0) + (B |BlockReadAlu|)) + +(define-instruction |DoBlock3ReadAlu| :operand-from-stack () + (ADDI arg2 ivory PROCESSORSTATE_BAR3) + (B |BlockReadAlu|)) + +(define-instruction |DoBlock2ReadAlu| :operand-from-stack () + (ADDI arg2 ivory PROCESSORSTATE_BAR2) + (B |BlockReadAlu|)) + +(align4kskip4k) + +;; ARG1 has address of boolean op, put the proper BAR into ARG2 +(define-instruction |DoBlock1ReadAlu| :operand-from-stack () + (ADDI arg2 ivory PROCESSORSTATE_BAR1) + (label |BlockReadAlu|) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (i%block-n-read-alu arg2 arg1 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12))) + + +(define-instruction |DoBlock0ReadTest| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR0) + (B |BlockReadTest|)) + +(define-instruction |DoBlock3ReadTest| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR3) + (B |BlockReadTest|)) + +(define-instruction |DoBlock2ReadTest| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR2) + (B |BlockReadTest|)) + +;; ARG1 has the cycle type and flags, put the proper BAR into ARG2 +(define-instruction |DoBlock1ReadTest| :10-bit-immediate () + (ADDI arg2 ivory PROCESSORSTATE_BAR1) + (label |BlockReadTest|) + (i%block-n-read-test arg2 arg1 arg3 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12)) + + +(comment "Fin.") diff --git a/g5-emulator/ifunbnum.ppcs b/g5-emulator/ifunbnum.ppcs new file mode 100644 index 0000000..1de1919 --- /dev/null +++ b/g5-emulator/ifunbnum.ppcs @@ -0,0 +1,130 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Bignums.") + +;;; no stack level change +(define-instruction |DoAddBignumStep| :operand-from-stack-immediate () + (LWA arg2 4 (isp) "Get arg2") + (LWA t2 0 (isp) "and its tag") + (srdi t3 arg1 32) + (clrldi arg1 arg1 32 "Strip type from arg3") + (CheckDataType t3 |TypeFixnum| addbignumsteplose t4) + (LWA arg3 -4 (isp) "Get arg1") + (LWA t1 -8 (isp) "and its tag") + (clrldi arg2 arg2 32 "Clear sign extension from arg2") + (CheckDataType t2 |TypeFixnum| addbignumsteplose t4) + (clrldi arg3 arg3 32 "Clear sign extension") + (CheckDataType t1 |TypeFixnum| addbignumsteplose t4) + (ADD arg4 arg1 arg2) + (ADD arg5 arg3 arg4) + (srdi arg6 arg5 32 "Shift the carry into arg6") + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2-disp iSP -8 t1 arg5 "Store fixnum result") + (stack-write2 iSP t1 arg6 "Store the carry if any") + (ContinueToNextInstruction-NoStall) + (label addbignumsteplose) + (illegal-operand three-operand-fixnum-type-error)) + +;;; no stack level change +(define-instruction |DoSubBignumStep| :operand-from-stack-immediate () + (LWA arg2 4 (isp) "Get arg2") + (LWA t2 0 (isp) "and its tag") + (srdi t3 arg1 32) + (clrldi arg1 arg1 32 "Strip type from arg3") + (CheckDataType t3 |TypeFixnum| subbignumsteplose t4) + (LWA arg3 -4 (isp) "Get arg1") + (LWA t1 -8 (isp) "and its tag") + (clrldi arg2 arg2 32 "Clear sign extension from arg2") + (CheckDataType t2 |TypeFixnum| subbignumsteplose t4) + (clrldi arg3 arg3 32 "Clear sign extension") + (CheckDataType t1 |TypeFixnum| subbignumsteplose t4) + (SUBF arg4 arg2 arg3 "arg1-arg2") + (srdi arg6 arg4 63 "arg6=1 if we borrowed in 1st step") + (clrldi arg4 arg4 32 "Truncate 1st step to 32-bits") + (SUBF arg5 arg1 arg4 "(arg1-arg2)-arg3") + (srdi t6 arg5 63 "t6=1 if we borrowed in 2nd step") + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2-disp iSP -8 t1 arg5 "Store fixnum result") + (ADD arg6 arg6 t6 "Compute borrow") + (stack-write2 iSP t1 arg6 "Store the borrow if any") + (ContinueToNextInstruction-NoStall) + (label subbignumsteplose) + (illegal-operand three-operand-fixnum-type-error)) + +(define-instruction |DoMultiplyBignumStep| :operand-from-stack-immediate () + (LWA arg2 4 (isp) "Get arg1") + (LWA t1 0 (isp)) + (srdi t2 arg1 32) + (clrldi arg1 arg1 32 "Strip type from arg2") + (CheckDataType t2 |TypeFixnum| multbignumsteplose t4) + (clrldi arg2 arg2 32) + (CheckDataType t1 |TypeFixnum| multbignumsteplose t4) + (MULLD arg3 arg2 arg1 "arg1*arg2") + (srdi arg6 arg3 32 "arg6=high order word") ;+++ + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2 iSP t1 arg3 "Store fixnum result ls word") + (stack-push2-with-cdr t1 arg6 "Store ms word") + (ContinueToNextInstruction-NoStall) + (label multbignumsteplose) + (illegal-operand two-operand-fixnum-type-error)) + +;;+++ Needs to signal DIVIDE-OVERFLOW if final carry is non-zero +(define-instruction |DoDivideBignumStep| :operand-from-stack-immediate () + (LWA arg2 4 (isp) "Get arg2") + (LWA t1 0 (isp)) + (srdi t2 arg1 32) + (clrldi arg1 arg1 32) ;this is an unsigned divide + (CheckDataType t2 |TypeFixnum| divbignumsteplose1 t4) + (branch-if-zero arg1 divbignumsteplose2 "J. if division by zero") + (clrldi arg2 arg2 32) + (LWA arg3 -4 (isp) "Get arg1") + (LWA t3 -8 (isp)) + (CheckDataType t1 |TypeFixnum| divbignumsteplose1 t4) + (sldi arg2 arg2 32 "arg2=(ash arg2 32)") + (clrldi arg3 arg3 32) + (CheckDataType t3 |TypeFixnum| divbignumsteplose1 t4) + (OR arg4 arg3 arg2 "arg1+(ash arg2 32)") + (DIVDU t1 arg4 arg1 "t1 is now the quotient") + (MULLD t2 t1 arg1) + (SUBF t2 t2 arg4 "t2 is now the remainder") + (STW t1 -4 (iSP) "store quotient (already fixnum)") + (STW t2 4 (iSP) "store remainder (already fixnum)") + (ContinueToNextInstruction) + (label divbignumsteplose1) + (illegal-operand three-operand-fixnum-type-error) + (label divbignumsteplose2) + (illegal-operand %divide-bignum-step-not-fixnum-or-zero)) + +(define-instruction |DoLshcBignumStep| :operand-from-stack-signed-immediate () + (LWA arg2 4 (isp) "Get arg2") + (LWA t2 0 (isp)) + (ADDI isp isp -8 "Pop Stack") + (srdi t3 arg1 32) + (clrldi arg1 arg1 32 "Strip type from arg3") + (CheckDataType t3 |TypeFixnum| lshcbignumsteplose t4) + (clrldi arg2 arg2 32) + (LWA arg3 4 (isp) "Get arg1") + (LWA t1 0 (isp)) + (CheckDataType t2 |TypeFixnum| lshcbignumsteplose t4) + (sldi arg2 arg2 32 "arg2=(ash arg2 32)") + (clrldi arg3 arg3 32) + (CheckDataType t1 |TypeFixnum| lshcbignumsteplose t4) + (OR arg4 arg3 arg2 "arg1+(ash arg2 32)") + (SLD arg5 arg4 arg1) + (SRADI arg6 arg5 32 "Extract the result") + ;; T1 has |TypeFixnum| in it here + (GetNextPCandCP) + (stack-write2 iSP t1 arg6 "Store the result as a fixnum") + (ContinueToNextInstruction-NoStall) + (label lshcbignumsteplose) + (illegal-operand three-operand-fixnum-type-error)) + + +(comment "Fin.") diff --git a/g5-emulator/ifuncom1.ppcs b/g5-emulator/ifuncom1.ppcs new file mode 100644 index 0000000..acac473 --- /dev/null +++ b/g5-emulator/ifuncom1.ppcs @@ -0,0 +1,719 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "The most commonly used instructions, part 1. ") + +;;; The functions in this file are pretty much in order of usage count for +;;; a set of representative "benchmarks" (compiler, window system, UI). +;;; The exception to the ordering is that sometimes short procedures are +;;; placed just before another longer one that will be tail-called, in +;;; order to get better instruction fetching behavior. + + +;;; From IFUNMOVE.PPCS + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline. Not only that, but we +;; even do the NextInstruction here, which saves us three cycles over +;; branching to NextInstruction. Since PushFP accounts for nearly 1/10 +;; of all instructions executed, this is nothing to sneeze at. +(define-instruction |DoPush| :operand-from-stack (:own-immediate t) + (GetNextPC) + (ADDI iSP iSP 8 "Push the new value") + (GetNextCP) + (stack-read2 arg1 t1 t2 "Get the tag/data" :signed t) + (stack-write-data iSP t2 "Store the data word") + (force-alignment) + (TagType t1 t1 "make it CDR NEXT") + (stack-write-tag iSP t1 "Store the TAG - this *DOES* dual issue!") + ;; Falls through to cacheValid +) + +;; From idispat, this is here so DoPush can fall into it, saving a +;; branch and cycle +(define-procedure |nextInstruction| () + (label cacheValid) + (LD arg3 CACHELINE_INSTRUCTION (iCP) "Grab the instruction/operand while stalled") + (ADDI arg1 iFP 0 "Assume FP mode") + (LD t2 CACHELINE_PCDATA (iCP) "Get the PC to check cache hit.") + (ADDI arg4 iSP -8 "SP-pop mode constant") + (label continuecurrentinstruction) + (LD t3 CACHELINE_CODE (iCP) "Instruction handler") + (MTSPR 9 t3 "Put into CTR register for later dispatch") + (ADDI arg5 iSP #.(* -255 8) "SP mode constant") + (STD iSP PROCESSORSTATE_RESTARTSP (ivory) "Need this in case we take a trap") + (extrdi t4 arg3 8 16 "Get the mode bits") + (SUBF t2 iPC t2 "check for HIT.") + (LD arg6 0 (iSP) "Load TOS in free di slot") + (extrdi arg2 arg3 8 24 "Extract (8-bit, unsigned) operand") + (branch-if-nonzero t2 TakeICacheMiss "PC didn't match, take a cache miss") + (ANDI-DOT R31 t4 1) + (BC 12 2 skip23 "B.EQ") + (mov arg1 iLP "LP or Immediate mode") + (unlikely-label skip23) + (passthru "#ifdef DEBUGGING") + (branch-if-zero t3 haltmachine "Just in case...") + (passthru "#endif") + (passthru "#ifdef TRACING") + (maybe-icount t2) + (maybe-trace t2 t3 t4 t5 t6 t7) + (passthru "#endif") + (passthru "#ifdef STATISTICS") + (maybe-statistics t2 t3 t4 t5 t6 t7) + (passthru "#endif") + (passthru "#ifdef CACHEMETERING") + (maybe-meter-hit t2 t3 t4 t5 t6 t7) + (passthru "#endif") + (passthru "#ifdef DEBUGGING") + (passthru "#if DEBUGGING == 1") + (clr t1) (clr t2) (clr t3) (clr t4) + (clr t5) (clr t6) (clr t7) (clr t8) + (clr t9) (clr t10) (clr t11) (clr t12) + (clr r0) (clr r31) + (passthru "#else") + (li t1 DEBUGGING) (li t2 DEBUGGING) (li t3 DEBUGGING) (li t4 DEBUGGING) + (li t5 DEBUGGING) (li t6 DEBUGGING) (li t7 DEBUGGING) (li t8 DEBUGGING) + (li t9 DEBUGGING) (li t10 DEBUGGING) (li t11 DEBUGGING) (li t12 DEBUGGING) + (li r0 DEBUGGING) (li r31 DEBUGGING) + (passthru "#endif") + (passthru "#endif") + + (BCCTR 20 0 "Jump to the handler") ; t3 + + (comment "Here to advance the PC and begin a new instruction. Most") + (comment "instructions come here when they have finished. Instructions") + (comment "that explicitly update the PC (and CP) go to interpretInstruction.") + (label nextInstruction) + (LD iPC CACHELINE_NEXTPCDATA (iCP) "Load the next PC from the cache") + (LD iCP CACHELINE_NEXTCP (iCP) "Advance cache position") + (B cacheValid) + + ;; When ICacheFill precedes iInterpret, we put this label here in + ;; order to get conditional branch prediction right + #-iCacheMiss-after-iInterpret (label TakeICacheMiss) + #-iCacheMiss-after-iInterpret (external-branch ICacheMiss) +) + +(define-procedure |DoPushImmediateHandler| () + (immediate-handler |DoPush|) + (GetNextPCandCP) + (stack-push-ir |TypeFixnum| arg2 t4 "Push it with CDR-NEXT onto the stack") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNLOOP.PPCS + +(define-instruction |DoBranchTrue| :10-bit-signed-immediate (:own-immediate t :needs-tos t) + (ibranchcond nil t t nil |BranchException|)) ;and-pop else-pop + +(define-instruction |DoBranchFalse| :10-bit-signed-immediate (:own-immediate t :needs-tos t) + (ibranchcond t t t nil |BranchException|)) ;invert and-pop else-pop + + +;;; From IFUNFCAL.PPCS + +;; Register conventions for return instruction: +;; arg1 is 10-bit immediate (unused) +;; arg2 is 8-bits of that +;; arg3 is the return value (with cdr already cleared) +;; arg4 is the disposition dispatch +;; arg5 is the control register +;; arg6 is stack-cache-data (for underflow check) + +;; Return completes by branching to StackCacheUnderflowCheck, which goes +;; to NextInstruction after dealing with underflow. In the for-return +;; case, this re-executes the instruction one frame up. We only need +;; the low bit of the immediate argument, which is already available in +;; arg2, so we use :own-immediate. +(define-instruction |DoReturnSingle| :10-bit-immediate (:own-immediate t :needs-tos t) + (comment "Fetch value based on immediate, interleaved with compute disposition dispatch") + (get-control-register arg5) + ;; inline (stack-top arg3 :tos-valid t) + (clrldi arg3 arg6 #.(- 64 38) "Clear cdr") + (load-constant t3 #.(* 3 1_18) "value disposition mask") + (get-nil t1) + (get-t t2) + (AND t3 t3 arg5 "mask disposition bits") + (srdi t3 t3 18 "shift disposition bits into place") + (LD arg6 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (comment "arg2 is 8 bits of \"kludge operand\" 0=TOS 40=NIL 41=T") + (CMPI 0 1 arg2 0) + (BC 4 1 skip17 "B.LE") + (mov arg3 t1) + (unlikely-label skip17) + (ADDI arg4 t3 -2 "arg4 -2=effect -1=value 0=return 1=multiple") + (ANDI-DOT R31 arg2 1) + (BC 12 2 skip24 "B.EQ") + (mov arg3 t2) + (unlikely-label skip24) + ;; Return-multiple comes here for effect and value cases after + ;; loading arg3, arg4, arg5, and arg6 appropriately + (label returncommontail) + ;; Load's pc if arg4 /= 0 + (abandon-frame-simple (not arg4) arg5 returnsinglecleanup t1 t2 t3 t4 t5 t6 t7) + (force-alignment) + (comment "arg4 -2=effect -1=value 0=return 1=multiple") + (branch-if-zero arg4 returnsinglereturn) + (ANDI-DOT R31 arg4 1 "BLBC") + (BC 12 2 returnsingleeffect) + ;; Cdr already cleared, so we can use raw push here + (stack-push-with-cdr arg3) + (branch-if-greater-than-zero arg4 returnsinglemultiple) + (label returnsingleeffect) + (label returnsingledone) + (CMPL 0 1 iFP arg6 "ARG6 = stack-cache underflow") + (BC 12 0 returnsingleunderflow) +;; Unneeded +;; (branch-if-zero arg4 returnsingleretry "For return, simply retry") + (branch-if-zero t7 interpretInstructionForBranch "No prediction, validate cache") + ;; Duplicate code from (label interpretInstructionPredicted) + (mov iCP t7) + (ContinueToInterpretInstruction) + (label returnsinglemultiple) + (stack-push-fixnumb 1 t8 "Multiple-value group") + (B returnsingledone) + (label returnsinglereturn) + ;; repush arg only if TOS arg, + (branch-if-nonzero arg2 returnsingledone) + (stack-push-with-cdr arg3) + (B returnsingledone) + (label returnsinglecleanup) + (external-branch handleframecleanup) + (label returnsingleunderflow) + (external-branch |StackCacheUnderflowCheck|)) + + +;;; From IFUNFULL.PPCS + +(passthru ".globl callindirectprefetch") +#|| +(define-instruction |callindirect| :full-word-instruction () + (label |callindirectprefetch|) ;the same as |callindirect| + (clrldi arg2 arg3 32 "Get operand") + (ANDC arg3 arg3 arg3 "No extra arg") + (with-multiple-memory-reads (t9 t10 t11 t12) + (B startcallindirect) + )) +||# + +(passthru ".globl startcallagain") +(define-instruction |callindirect| :full-word-instruction () + (label |callindirectprefetch|) ;the same as |callindirect| + (clrldi arg2 arg3 32 "Get operand") + (with-multiple-memory-reads (t9 t10 t11 t12) + (clr arg3 "No extra arg") + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t) + (CheckDataType arg5 |TypeCompiledFunction| startcallagain t5) + (li arg5 |TypeEvenPC|) + (push-frame t3 t7 t8 t5 t6) + (GetNextPCandCP) + (set-continuation2r arg5 arg6) + (stzd PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (branch-if-nonzero arg3 |callindirectextra|) + (ContinueToNextInstruction-NoStall) + (label |callindirectextra|) + (LWA t1 PROCESSORSTATE_CONTROL+4 (ivory)) + (load-constant t2 #.1_8 "cr.extra-argument") + (stack-push2 arg3 arg4 t3 "Push the extra arg.") + (OR t1 t1 t2 "Set the extra arg bit") + (STW t1 PROCESSORSTATE_CONTROL+4 (Ivory) "Save control with new state") + (ContinueToNextInstruction-NoStall))) + +;;; From IFUNFCAL.PPCS + +;; This handles both the apply and the non-apply cases +(define-instruction |DoFinishCallN| :10-bit-immediate (:own-immediate t) + (comment "arg2 contains the 8 bit N+1") + (extrdi arg1 arg3 8 16 "arg1 contains the disposition (two bits)") + (sldi arg2 arg2 3 "convert N to words (stacked words that is)") + (label finishcallmerge) + ;; ARG3 contains opcode, from which we compute apply-p + (finish-call-guts arg2 arg1 arg3 t1 t2 t3 t4 t5 t6 t7)) + +(define-instruction |DoEntryRestNotAccepted| :entry-instruction () + (srdi t2 arg5 27 "Get the cr.trace-pending bit") + (ANDI-DOT t1 arg5 #xFF "The supplied args") + (ANDI-DOT R31 t2 1 "BLBS") + (BC 4 2 TraceTrap) + (b-apply-argument-supplied applysupprna t2 t3 t4 arg5) + (SUBF t2 arg2 t1 "t2=supplied-minimum") + (branch-if-less-than-zero t2 retryernatoofew "B. if too few args.") + (SUBF arg1 t1 arg4 "maximum-supplied") + (branch-if-less-than-zero arg1 retryernatoomany "B. if too many args.") + (enter-function t2 t3 t4) ;doesn't return + (label applysupprna) + (SUBF arg1 t1 arg4) + ;; Not LT, since the apply arg is at least one argument! If you + ;; need to pull 0, you have too many args + (branch-if-less-than-or-equal-to-zero arg1 retryernatoomany "B. if too many args.") + ;; Pulls arg1 args and retries the instruction + (B |PullApplyArgs|) + (label retryernatoomany) + (illegal-operand too-many-arguments) + (label retryernatoofew) + (illegal-operand too-few-arguments)) + + +;;; This small trampoline is near it's popular callee so you gan get to +;;; the PullApplyArgs tail from xxx-dispatch without a cache miss +(define-procedure |VerifyGenericArity| () + (verify-generic-arity arg2 arg5 t11)) + +;; Not clear where this really belongs. Kept it here with it's most +;; popular caller + +(define-procedure |PullApplyArgs| (arg1) + ;; W-M-M-R for VMAinStackCache, which is used several times + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (pull-apply-args arg1 t1 t2 InterpretInstruction t4 t5 t6 t7 t8 t9 t10 t11))) + + +;;; From IFUNFULL.PPCS + +(define-instruction |valuecell| :full-word-instruction () + (clrldi arg2 arg3 32 "Get address") + (with-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)) + (GetNextPCandCP) + (stack-push2 arg5 arg6 t3 "Push the result") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |pushconstantvalue| :full-word-instruction () + (GetNextPCandCP) + (stack-push-with-cdr arg3) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNPRED.PPCS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoZerop| :operand-from-stack (:own-immediate t) + (simple-unary-arithmetic-predicate zerop 4 2 12 2) ; CMOVEQ test is EQ + ;; This is a VERY common idiom used to push NIL or T using a halfword + ;; instruction. + (immediate-handler |DoZerop|) + (Get-T t2) + (ADDI iSP iSP 8) + (Get-NIL t1) + (GetNextPCandCP) + (CMPI 0 1 arg2 0) + (BC 4 2 skip5 "B.NE") + (mov t1 t2) + (unlikely-label skip5) + (stack-write iSP t1 "yes Virginia, we dual issue with above yahoo") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoSetSpToAddress| :operand-from-stack () + (GetNextPCandCP) + (mov iSP arg1 "Set iSP=address of operand") + (ContinueToNextInstruction-NoStall)) + +;;; From IFUNPRED.PPCS + +;; DoEqNoPop is handled here, too... +;; Note the |DoEqIM| is in IFUNCOM2.PPCS (yeah, it's wierd) +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoEq| :operand-from-stack (:own-immediate t :needs-tos t) + (Get-NIL t11) + (srdi arg3 arg3 #.(+ 10 2)) + (Get-T t12) + (stack-read arg1 arg1 "load op2") + (GetNextPC) + (ANDI-DOT arg3 arg3 1 "1 if no-pop, 0 if pop") + (GetNextCP) + ;; inline (stack-top t3 "Load op1 into t3" :tos-valid t) + (XOR t3 arg6 arg1 "compare tag and data") + (sldi t3 t3 #.(- 32 6) "shift off the cdr code") + (sldi t4 arg3 3) + (ADD iSP t4 iSP "Either a stack-push or a stack-write") + (CMPI 0 1 t3 0) + (BC 4 2 skip6 "B.NE") + (mov t11 t12 "pick up T or NIL") + (unlikely-label skip6) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoAref1| :operand-from-stack-immediate (:own-immediate t :needs-tos t) + (stack-top2 arg3 arg4 "Get the array tag/data" :tos-valid t) + (exts arg2 arg1 32 "arg2=signextend(arg1)") + (li t8 |AutoArrayRegMask|) + (AND t8 arg4 t8) + ;(sldi t8 t8 #.|AutoArrayRegShift|) ; mask is in place, so shift is zero. + (srdi arg1 arg1 32 "Index Tag") + (ADDI t7 ivory PROCESSORSTATE_AC0ARRAY) + (ADD t7 t7 t8 "This is the address if the array register block.") + (CheckDataType arg1 |TypeFixnum| Aref1Illegal t1 t) + (label aref1merge) + (branch-if-zero arg4 |Aref1Regset|) ;+++ + (LD t8 ARRAYCACHE_ARRAY (t7) "Cached array object.") + ;; Array or String + (CheckAdjacentDataTypes arg3 |TypeArray| 2 ReallyAref1Exc t1 t) + (XOR t8 arg4 t8 "t8==0 iff cached array is ours.") + (branch-true t8 |Aref1Regset| "Go and setup the array register.") + (passthru "#ifdef SLOWARRAYS") + (B |Aref1Regset|) + (passthru "#endif") + ;; Get control register, base, and length. Don't need any data types + ;; since we checked all that when we set up the array register. + (LD arg6 ARRAYCACHE_ARWORD (t7)) + (LD t9 ARRAYCACHE_LOCAT (t7) "high order bits all zero") + (LD t3 ARRAYCACHE_LENGTH (t7) "high order bits all zero") + (clrldi t5 arg6 #.(- 64 |ArrayRegisterEventCountSize|)) + (LD t4 PROCESSORSTATE_AREVENTCOUNT (ivory)) + ;; (check-array-bounds arg2 t3 Aref1Bounds t2) + (SUBF t6 t5 t4) + (branch-if-nonzero t6 |Aref1Regset| "J. if event count ticked.") + (CMPL 0 1 arg2 t3) + (bclong 4 0 Aref1Bounds) + (srdi arg5 arg6 #.|ArrayRegisterBytePackingPos|) + (srdi arg4 arg6 #.|ArrayRegisterByteOffsetPos|) + (srdi t8 arg6 #.|ArrayRegisterElementTypePos|) + (ANDI-DOT arg4 arg4 |ArrayRegisterByteOffsetMask|) + (ANDI-DOT arg5 arg5 |ArrayRegisterBytePackingMask|) + (ANDI-DOT arg6 t8 |ArrayRegisterElementTypeMask|) + (label Aref1Restart) + (new-aref-1-internal arg3 t9 arg5 arg4 arg6 arg2 t1 t2 t3 t5 t6) + (immediate-handler |DoAref1|) + (li t8 |AutoArrayRegMask|) + (stack-top2 arg3 arg4 "Get the array tag/data") + (ADDI t7 ivory PROCESSORSTATE_AC0ARRAY) + (AND t8 arg4 t8) + ;(sldi t8 t8 #.|AutoArrayRegShift| 0) + (ADD t7 t7 t8 "This is the address of the array register block.") + (B aref1merge)) + +(define-instruction |DoTypeMember| :10-bit-immediate (:own-immediate t) + (itypemember)) + +;;; From IFUNSUBP.PPCS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoPointerPlus| :operand-from-stack (:own-immediate t :needs-tos t) + (GetNextPCandCP) + (stack-read-data arg1 t2 "Get the data of op2" :signed t :tos-valid t) + ;; inline (stack-read-data iSP t1 "Get the data of op1" :signed t :tos-valid t) + (exts t3 arg6 32) + (exts t2 t2 32) + (ADD t3 t3 t2 "(%32-bit-plus (data arg1) (data arg2))") + (stack-write-data iSP t3 "Put result back on the stack") + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoPointerPlus|) + (exts t2 arg2 8) + (GetNextPCandCP) + (force-alignment) + ;; inline (stack-read-data iSP t1 "Get the data of op1" :signed t :tos-valid t) + (exts t3 arg6 32) + (ADD t3 t3 t2 "(%32-bit-plus (data arg1) (data arg2))") + (stack-write-data iSP t3 "Put result back on the stack") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNFEXT.PPCS + +;; Must implement this as if it were a ROT followed by a LOGAND as the +;; compiler will generate a LDB instruction instead of a ROT instruction +;; for constant rotations. +(define-instruction |DoLdb| :field-extraction (:needs-tos t) + (stack-read2 iSP arg3 arg4 "get ARG1 tag/data" :tos-valid t) + ;; inline (CheckDataType arg3 |TypeFixnum| LdbException t8) + (TagType arg3 t8) + (ADDI t9 t8 #.(- |type$K-fixnum|)) + (SLD t3 arg4 arg2 "Shift ARG1 left to get new high bits") + (long-branch-if-nonzero t9 LdbException "Not a fixnum") ;in |OutOfLineExceptions| + (load-constant t7 -2) + (GetNextPC) + (srdi t6 t3 32 "Get new low bits") + (GetNextCP) + (SLD t7 t7 arg1 "Unmask") + (OR t3 t3 t6 "Glue two parts of shifted operand together") + (stack-write-tag iSP t8 "T8 is TypeFixnum from above") + (ANDC t3 t3 t7 "T3= masked value.") + (stack-write-data iSP t3) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMOVE.PPCS + +#+experiment +;; Also handles DoSetSpToAddressSaveTos +(define-instruction |DoSetSpToAddress| :operand-from-stack () + (GetNextPC) + (srdi arg3 arg3 10 "LBC iff save tos") + (GetNextCP) + (mov iSP arg1 "Set iSP=address of operand") + (ANDI-DOT R31 arg3 1 "BLBS") + (BC 4 2 cachevalid) + ;; inline (stack-read iSP t1 "Read current stack top." :tos-valid t) + (stack-write arg1 arg6 "Restore the TOS.") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoSetSpToAddressSaveTos| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + (mov iSP arg1 "Set the stack top as specified.") + ;; inline (stack-read iSP t1 "Read current stack top." :tos-valid t) + (stack-write arg1 arg6 "Restore the TOS.") + (ContinueToNextInstruction-NoStall)) + +;; --- sp-pop mode can't be valid for this op? +(define-instruction |DoPop| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + ;; inline (stack-pop t3 "Pop the operand" :tos-valid t) + (ADDI iSP iSP -8 "Pop Stack.") + (stack-write arg1 arg6 "Store all 40 bits on stack") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoMovem| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + ;; inline (stack-read iSP t3 "Get TOS" :tos-valid t) + (stack-write arg1 arg6 "Store all 40 bits of TOS on stack") + (ContinueToNextInstruction-NoStall)) + +#+experiment +;; Also handles DoPop +(define-instruction |DoMovem| :operand-from-stack (:needs-tos t) + (GetNextPC) + (srdi arg3 arg3 10 "LBC iff pop") + (GetNextCP) + (ADDI t1 iSP -8 "Maybe pop Stack.") + ;; inline (stack-read iSP t3 "Get TOS" :tos-valid t) + (stack-write arg1 arg6 "Store all 40 bits of TOS on stack") + (ANDI-DOT R31 arg3 1) + (BC 4 2 skip27 "B.NE") + (mov iSP t1 "Maybe pop Stack.") + (unlikely-label skip27) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMOVE.PPCS + +(define-instruction |DoPushAddress| :operand-from-stack () + (SCAtoVMA arg1 t1 t2) + (GetNextPCandCP) + (stack-push-ir |TypeLocative| t1 t3) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNSUBP.PPCS + +;; DoMemoryReadAddress is handled here, too... +(define-instruction |DoMemoryRead| :10-bit-immediate (:needs-tos t) + (srdi t1 arg3 10 "Low bit clear if memory-read, set if memory-read-address") + (ANDI-DOT t2 arg1 #x20 "T2 = fixnum check") + (ANDI-DOT t3 arg1 #x10 "T3 = reset CDR code") + (srdi arg3 arg1 6 "arg3 = cycle type") + (stack-read2 iSP arg1 arg2 "Get tag/data" :tos-valid t) + (with-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg2 arg5 arg6 arg3 t5 t6 t7 t8 nil t)) + (branch-if-zero t2 mrdataok "J. if no check for fixnum.") + ;; --- Should make memory-read do the fixnum check by getting funny + ;; trap tables + (CheckDataType arg5 |TypeFixnum| mrnotfixnum t5) + (label mrdataok) + (GetNextPC) + (ANDI-DOT R31 t1 1) + (BC 12 2 skip25 "B.EQ") + (mov arg5 arg1 "Get original tag if memory-read-address") + (unlikely-label skip25) + (branch-if-zero t3 mrcdrunch "J. if no reset CDR code") + (TagType arg5 arg5) + (label mrcdrunch) + (GetNextCP) + (ANDI-DOT R31 t1 1) + (BC 12 2 skip26 "B.EQ") + (mov arg6 arg2 "Get forwarded address if memory-read-address") + (unlikely-label skip26) + (stack-write2 iSP arg5 arg6) + (ContinueToNextInstruction-NoStall) + (label mrnotfixnum) + (illegal-operand %memory-read-transport-and-fixnum-type-check)) + +;;; From IFUNLOOP.PPCS + +(define-instruction |DoBranch| :10-bit-signed-immediate () + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LD arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (ADD iPC iPC arg1 "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (branch-if-nonzero arg2 interpretInstructionPredicted) + (passthru "#endif") + (B interpretInstructionForBranch)) + + +;;; From IFUNGENE.PPCS + +(define-instruction |DoGenericDispatch| :operand-from-stack () + (generic-dispatch arg1 t1 arg3 arg4 t4 t9 t6 t7 arg2 arg5 t3 t2)) + +;; Takes generic function tag/data in ARG1/t1 and instance tag/data in ARG3/ARG4. +;; Returns mask data in t2, table data in t3, parameter tag/data in T6/T7, +;; and method tag/data in T4/arg3. Clobbers T1 through T5, and T10. +;; Linkage register is R0 +(define-subroutine |LookupHandler| () (r0) + ;; Note well! Don't change these memo registers without also fixing + ;; the call to USING-MULTIPLE-MEMORY-READS in |LookupHandlerMemoryRead| + (with-multiple-memory-reads (t9 t10 t11 t12) + (instance-descriptor-info + arg3 arg4 t2 t3 arg2 arg5 arg6 t5 t6 t7 t8) + ;; Watch it! We're clobbering ARG3/ARG4 to save some cycles! + (lookup-handler + ;; looks bad, but we know t6/t7 are set last thing when they are + ;; no longer needed for temps + arg1 t1 t3 t2 t6 t7 t4 arg3 arg4 arg2 arg5 arg6 t5 t6 t7 t8)) + (mov t9 arg3) ;sigh + ) + +;;; From IFUNSUBP.PPCS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoSetTag| :operand-from-stack (:own-immediate t) + (stack-read2 arg1 t1 arg2 "Get tag/data of op2" :signed t) + (CheckDataType t1 |TypeFixnum| settagexc t3) + ;; Sneaky immediate handler + (immediate-handler |DoSetTag|) + (GetNextPCandCP) + (stack-write-tag iSP arg2 "Set TAG of op1") + (ContinueToNextInstruction-NoStall) + (label settagexc) + (illegal-operand one-operand-fixnum-type-error)) + +;;; From IFUNLIST.PPCS + +(define-instruction |DoCar| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (icar arg1 arg5 arg6 arg2 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + #+list-inline (car-internal arg5 arg6 car arg2 t5 t6 t7 t8 t) + #-list-inline (call-subroutine |CarInternal|) + (stack-push2 arg5 arg6 t5) + (ContinueToNextInstruction))) + +#-list-inline +;; --- All the temps aren't really arguments, but they are smashed +(define-subroutine |CarInternal| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (car-internal arg5 arg6 car arg2 t5 t6 t7 t8))) + +(define-instruction |DoCdr| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (icdr arg1 arg5 arg6 arg2 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + #+list-inline (cdr-internal arg5 arg6 cdr arg2 t5 t6 t7 t8 t) + #-list-inline (call-subroutine |CdrInternal|) + (stack-push2 arg5 arg6 t5) + (ContinueToNextInstruction))) + +#-list-inline +;; --- All the temps aren't really arguments, but they are smashed +(define-subroutine |CdrInternal| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (cdr-internal arg5 arg6 cdr arg2 t5 t6 t7 t8))) + + +;;; From IFUNSUBP.PPCS + +(define-instruction |DoReadInternalRegister| :10-bit-immediate () + (internal-register-dispatch arg1 nil |ReadRegisterError| t1 t2 t3)) + +(define-instruction |DoWriteInternalRegister| :10-bit-immediate (:needs-tos t) + (stack-pop2 arg2 arg3 "Arg2=tag arg3=data" :tos-valid t) + (internal-register-dispatch arg1 t |WriteRegisterError| t1 t2 t3)) + +(define-procedure |WriteRegisterBARx| () + (srdi t2 arg1 7 "BAR number into T2") + (GetNextPC) + (sldi t3 arg2 32 "Make a quadword from tag and data") + (GetNextCP) + (ADDI t1 ivory PROCESSORSTATE_BAR0) + (sldi t4 t2 3) + (ADD t1 t4 t1 "Now T1 points to the BAR") + (OR t3 t3 arg3 "Construct the combined word") + (STD t3 0 (t1)) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNBLOK.PPCS + +(define-instruction |DoBlock3Read| :10-bit-immediate () + (ADDI arg4 ivory PROCESSORSTATE_BAR3) + (B |BlockRead|)) + +(define-instruction |DoBlock2Read| :10-bit-immediate () + (ADDI arg4 ivory PROCESSORSTATE_BAR2) + (B |BlockRead|)) + +(define-instruction |DoBlock1Read| :10-bit-immediate () + (ADDI arg4 ivory PROCESSORSTATE_BAR1) + (label |BlockRead|) + (with-multiple-memory-reads (t9 t10 t11 t12) + (i%block-n-read arg4 arg1 arg2 arg5 arg6 arg3 t1 t2 t3 t4 t5 t6 t7 t8))) + +(define-instruction |DoBlock2Write| :operand-from-stack-signed-immediate () + (LWA arg3 PROCESSORSTATE_BAR2+4 (ivory)) + (ADDI arg2 ivory PROCESSORSTATE_BAR2) + (B |BlockWrite|)) + +;; ARG1 has the data to write, put the proper BAR into ARG2 +(define-instruction |DoBlock1Write| :operand-from-stack-signed-immediate () + (LWA arg3 PROCESSORSTATE_BAR1+4 (ivory)) + (ADDI arg2 ivory PROCESSORSTATE_BAR1) + (label |BlockWrite|) + ;; This is a trick, mostly to separate the clrldi from the LWA + ;; (above). Note that with-multiple-memory-reads really should be + ;; called with-multiple-memory-operations + (with-multiple-memory-reads (t9 t10 t11 t12) + (clrldi arg3 arg3 32 "Unsigned vma") + (i%block-n-write arg2 arg3 arg1 t1 t2 t3 t4 t5 t6 t7 t8))) + + + +;;; From IFUNLOOP.PPCS + +(define-instruction |DoBranchTrueNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil nil nil |BranchException|)) ; + +(define-instruction |DoBranchFalseNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil nil nil |BranchException|)) ;invert + +;; The next two are here, not because they are frequent, but they are +;; miniscule and drop right into the start-call code +(passthru ".globl callgenericprefetch") +(define-instruction |callgeneric| :full-word-instruction () + (label |callgenericprefetch|) ;the same as |callgeneric| + (LD t3 PROCESSORSTATE_TRAPVECBASE (ivory)) + (mov arg4 arg3 "Get operand") + (li arg3 |TypeGenericFunction|) + ;; Build the constant PC for generic dispatch + (li arg5 |TypeEvenPC|) + (ADDI arg6 t3 #.sys:%generic-dispatch-trap-vector) + (B startcallcompiledmerge)) + +(passthru ".globl callcompiledevenprefetch") +(define-instruction |callcompiledeven| :full-word-instruction () + (label |callcompiledevenprefetch|) ;the same as |callcompiledeven| + (mov arg6 arg3 "Get operand") + (li arg5 |TypeEvenPC|) + (clr arg3 "No extra arg") + (B startcallcompiledmerge)) ;push new frame and exit + +;; Strictly speaking, |DoStartCall| doesn't belong here, but we put it +;; here so that it gets fetched along with |callindirect| +(define-instruction |DoStartCall| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + (stack-read2 arg1 arg5 arg6 :signed t) + (label startcallagain) + (start-call-dispatch arg5 arg6 arg3 arg4 arg2 t1 t2 t3 t5 t6 t7 t8 + startcallcompiledmerge startcallindirect))) + +(comment "Fin.") diff --git a/g5-emulator/ifuncom2.ppcs b/g5-emulator/ifuncom2.ppcs new file mode 100644 index 0000000..8b556dd --- /dev/null +++ b/g5-emulator/ifuncom2.ppcs @@ -0,0 +1,410 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "The most commonly used instructions, part 2.") + +;;; The functions in this file are pretty much in order of usage count for +;;; a set of representative "benchmarks" (compiler, window system, UI). +;;; The exception to the ordering is that sometimes short procedures are +;;; placed just before another longer one that will be tail-called, in +;;; order to get better instruction fetching behavior. + +;;; From IFUNINST.PPCS + +;; This really only takes an 8-bit immediate +(define-instruction |DoPushInstanceVariable| :10-bit-immediate (:own-immediate t) + (mov arg1 arg2) ;need arg2 in arg1 since arg2 is "vma" + (with-multiple-memory-reads (t9 t10 t11 t12) + (locate-instance-variable-mapped arg1 arg2 IVBadMap IVBadInst IVBadIndex PushIVException + arg5 arg6 t1 t2 t3 t4 t5 t6 t7 t8 t) + + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)) + (GetNextPCandCP) + (stack-push2 arg5 arg6 t7) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMATH.PPCS + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline +(define-instruction |DoAdd| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-operation add ADD FADDS DoAddOvfl) + (immediate-handler |DoAdd|) + (simple-binary-immediate-arithmetic-operation |DoAdd| ADD nil DoAddOvfl)) + + +;;; From IFUNBLOK.PPCS + +(define-instruction |DoBlock3Write| :operand-from-stack-signed-immediate () + (LWA arg3 PROCESSORSTATE_BAR3+4 (ivory)) + (ADDI arg2 ivory PROCESSORSTATE_BAR3) + (B |BlockWrite|)) + + +;;; From IFUNARRA.PPCS + +;;; arg1, on stack=array +;;; arg2, operand =index + +(define-instruction |DoAset1| :operand-from-stack-immediate (:own-immediate t) + (stack-pop2 arg3 arg4 "Get the array tag/data") + (stack-pop2 t5 t6 "Get the new value tag/data") + (exts arg2 arg1 32 "arg2=signextend(arg1)") + (li t8 |AutoArrayRegMask|) + (AND t8 arg4 t8) + ;(sldi t8 t8 #.|AutoArrayRegShift|) ; mask is in place, so shift is zero. + (srdi arg1 arg1 32 "Index Tag") + (ADDI t7 ivory PROCESSORSTATE_AC0ARRAY) + (ADD t7 t7 t8 "This is the address if the array register block.") + (CheckDataType arg1 |TypeFixnum| Aset1Illegal t1 t) + (label aset1merge) + (branch-if-zero arg4 |Aset1Regset|) ;+++ + (LD t8 ARRAYCACHE_ARRAY (t7) "Cached array object.") + ;; Array or String + (CheckAdjacentDataTypes arg3 |TypeArray| 2 ReallyAset1Exc t1 t) + (XOR t8 arg4 t8 "t8==0 iff cached array is ours.") + (branch-true t8 |Aset1Regset| "Go and setup the array register.") + (passthru "#ifdef SLOWARRAYS") + (B |Aset1Regset|) + (passthru "#endif") + ;; Get control register, base, and length. Don't need any data types + ;; since we checked all that when we set up the array register. + (LD arg6 ARRAYCACHE_ARWORD (t7)) + (LD t9 ARRAYCACHE_LOCAT (t7) "high order bits all zero") + (LD t3 ARRAYCACHE_LENGTH (t7) "high order bits all zero") + (clrldi t11 arg6 #.(- 64 |ArrayRegisterEventCountSize|)) + (LD t4 PROCESSORSTATE_AREVENTCOUNT (ivory)) + ;; (check-array-bounds arg2 t3 Aref1Bounds t2) + (SUBF t12 t11 t4) + (branch-if-nonzero t12 |Aset1Regset| "J. if event count ticked.") + (CMPL 0 1 arg2 t3) + (bclong 4 0 aset1bounds) + (srdi arg5 arg6 #.|ArrayRegisterBytePackingPos|) + (srdi t8 arg6 #.|ArrayRegisterElementTypePos|) + (srdi arg4 arg6 #.|ArrayRegisterByteOffsetPos|) + (ANDI-DOT arg5 arg5 |ArrayRegisterBytePackingMask|) + (ANDI-DOT arg4 arg4 |ArrayRegisterByteOffsetMask|) + (ANDI-DOT arg6 t8 |ArrayRegisterElementTypeMask|) + (label Aset1Restart) + (aset-1-internal arg3 t9 arg5 arg4 arg6 arg2 t5 t6 t1 t2 t3 t4 t7 t8 arg1) + (immediate-handler |DoAset1|) + (li t8 |AutoArrayRegMask|) + (stack-pop2 arg3 arg4 "Get the array tag/data") + (ADDI t7 ivory PROCESSORSTATE_AC0ARRAY) + (AND t8 arg4 t8) + ;(sldi t8 t8 #.|AutoArrayRegShift|) + (ADD t7 t7 t8 "This is the address of the array register block.") + (stack-pop2 t5 t6 "Get the new value tag/data") + (B aset1merge)) + +(define-instruction |DoFastAref1| :operand-from-stack (:needs-tos t) + (stack-read2 iSP arg3 arg4 :tos-valid t :signed t) + (CheckDataType arg3 |TypeFixnum| fastaref1iop t1) + (label FastAref1Retry) + ;; Get control register, base, and length. Don't need any data types + ;; since we checked all that when we set up the array register. + (LWA arg6 4 (arg1)) + (LWA t9 12 (arg1)) + (LWA t3 20 (arg1)) + (clrldi arg6 arg6 32) + (clrldi t9 t9 32) + (clrldi t5 arg6 #.(- 64 |ArrayRegisterEventCountSize|)) + (clrldi t3 t3 32) + (LD t4 PROCESSORSTATE_AREVENTCOUNT (ivory)) + ;; (check-array-bounds arg4 t3 fastaref1bounds t2) + (CMPL 0 1 arg4 t3) + (BC 4 0 fastaref1bounds) + (SUBF t6 t5 t4) + (branch-if-nonzero t6 |Aref1RecomputeArrayRegister|) ;branches back to FastAref1Retry + (srdi t6 arg6 #.|ArrayRegisterBytePackingPos|) + (srdi t7 arg6 #.|ArrayRegisterByteOffsetPos|) + (srdi t8 arg6 #.|ArrayRegisterElementTypePos|) + (ANDI-DOT t6 t6 |ArrayRegisterBytePackingMask|) + (ANDI-DOT t7 t7 |ArrayRegisterByteOffsetMask|) + (ANDI-DOT t8 t8 |ArrayRegisterElementTypeMask|) + (new-aref-1-internal arg5 t9 t6 t7 t8 arg4 t1 t2 t3 t4 t5) + (label fastaref1iop) + (illegal-operand fast-array-access-type-check) + (label fastaref1bounds) + (illegal-operand array-register-format-error-or-subscript-bounds-error)) + + +;;; From IFUNLIST.PPCS + +(define-instruction |DoRplaca| :operand-from-stack-signed-immediate (:needs-tos t) + (with-multiple-memory-reads (t9 t10 t11 t12) ;must be the same as in |DoRplacd| + (stack-pop2 t1 arg2 "Read ARG1, the list" :tos-valid t) + (TagType t1 t3) + (ADDI t4 t3 #.(- |type$K-list|)) ;t4=0 if list, t4=4 if locative + (rotrdi t4 t4 2) ;t4=0 if list, t4=1 if locative + (clrrdi t4 t4 1) ;t4=0 iff list or locative + (long-branch-if-nonzero t4 RplacaException) ;in |OutOfLineExceptions| + (label |RplacStore|) + (srdi t2 arg1 32 "Tag for t2") + (clrldi arg1 arg1 32 "data for t2") + (store-contents arg2 t2 arg1 PROCESSORSTATE_DATAWRITE arg5 arg6 t5 t6 t7 t8 + NextInstruction) + (ContinueToNextInstruction))) + +(define-memory-subroutine |MemoryReadWrite| + (arg2 arg5 arg6 PROCESSORSTATE_DATAWRITE t5 t6 t7 t8) + (t9 t10 t11 t12) + (r0)) + +(define-instruction |DoRplacd| :operand-from-stack-signed-immediate (:needs-tos t) + (with-multiple-memory-reads (t9 t10 t11 t12) ;must be the same as in |DoRplaca| + (stack-pop2 t1 arg2 "Read ARG1, the list" :tos-valid t) + (TagType t1 t3) + (ADDI t4 t3 #.(- |type$K-locative|)) + (branch-if-zero t4 |RplacStore|) + (ADDI t4 t3 #.(- |type$K-list|)) + (long-branch-if-nonzero t4 RplacdException) ;in |OutOfLineExceptions| + (memory-read arg2 arg5 arg6 PROCESSORSTATE_CDR t5 t6 t7 t8 nil t) + (TagCdr arg5 arg5) + (ADDI arg5 arg5 #.(- |cdr$K-normal|)) + (long-branch-if-nonzero arg5 RplacdException "J. if CDR coded") + (ADDI arg2 arg2 1 "address of CDR") + (B |RplacStore|))) + +;;; From IFUNLOOP.PPCS + +(define-instruction |DoBranchTrueAndExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil t nil t |BranchException|)) ;and-pop extra-pop + +(define-instruction |DoBranchFalseAndExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t t nil t |BranchException|)) ;invert and-pop extra-pop + +(define-instruction |DoBranchTrueAndNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil t nil |BranchException|)) ;else-pop + +(define-instruction |DoBranchFalseAndNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil t nil |BranchException|)) ;invert else-pop + +(define-instruction |DoBranchFalseElseNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t t nil nil |BranchException|)) ;invert and-pop + + +;;; From IFUNPRED.PPCS + +;; Handles DoEqualNumberNoPop as well +(define-instruction |DoEqualNumber| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + equal-number SUBF 4 2 t 1 12 t |EqualNumberMMExc|) ;FCMP yields CR.EQ + (immediate-handler |DoEqualNumber|) + (simple-binary-immediate-arithmetic-predicate + equal-number SUBF 4 2 t)) + + +;;; From IFUNLIST.PPCS + +(define-instruction |DoSetToCdrPushCar| :operand-from-stack () + ;; (isettocdrpushcar arg1 t1 t2 arg5 arg6 arg2 t4 t3 arg3 arg4 t5 t6 t7 t8) + (with-multiple-memory-reads (t9 t10 t11 t12) + (stack-read2 arg1 t1 t2 "Get the operand from the stack.") + (ANDI-DOT t3 t1 192 "Save the old CDR code") + (ADDI t5 t1 #.(- |type$K-locative|)) + (ANDI-DOT t5 t5 63 "Strip CDR code") + (branch-if-zero t5 settocdrpushcarlocative) + #+list-inline (carcdr-internal t1 t2 arg5 arg6 set-to-cdr-push-car arg2 t5 t6 t7 t8 t) + #-list-inline (call-subroutine |CarCdrInternal|) + (TagType arg5 arg5) + (OR arg5 arg5 t3 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (stack-push2 t1 t2 t5) + (ContinueToNextInstruction) + )) + +;;; From IFUNMATH.PPCS + +;; Same deal as |DoAdd|... +(define-instruction |DoSub| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-operation sub SUBF FSUBS DoSubOvfl) + (immediate-handler |DoSub|) + (simple-binary-immediate-arithmetic-operation |DoSub| SUBF nil DoSubOvfl)) + + +;;; From IFUNSUBP.PPCS + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline +(define-instruction |DoTag| :operand-from-stack (:provide-immediate t) + (GetNextPC) + (stack-read-tag arg1 arg1 "Get the tag of the operand") + (GetNextCP) + (stack-push-ir-reverse |TypeFixnum| arg1 t3) + (ContinueToNextInstruction-NoStall) +) + + +;;; From IFUNPRED.PPCS + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoEndp| :operand-from-stack (:own-immediate t) + (Get-NIL t1) + (stack-read-tag arg1 arg2 "Get tag.") + (Get-T t2) + (TagType arg2 arg2) + (ADDI t6 arg2 #.(- |type$K-NIL|) "Compare") + (branch-if-nonzero t6 endpnotnil) + ;(label endpt) + (GetNextPCandCP) + (stack-push-with-cdr t2) + (ContinueToNextInstruction-NoStall) + (label endpnil) + (GetNextPCandCP) + (stack-push-with-cdr t1) + (ContinueToNextInstruction-NoStall) + (label endpnotnil) + (ADDI t6 t6 -1 "Now check for list") ;DTP-LIST = DTP-NIL + 1 (yow!) + (branch-if-zero t6 endpnil) + (ADDI t6 arg2 #.(- |type$K-listinstance|)) + (branch-if-zero t6 endpnil) + (immediate-handler |DoEndp|) ;silly really + (illegal-operand one-operand-list-type-error)) + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoMinusp| :operand-from-stack (:own-immediate t) + (simple-unary-arithmetic-predicate minusp 4 0 12 0) ; CMOVLT test is LT + (immediate-handler |DoMinusp|) + (Get-NIL t1) + (exts arg2 arg2 8 "Turned into a signed number") ; Uses EXTSB + (Get-T t2) + (ADDI iSP iSP 8) + (GetNextPCandCP) + (CMPI 0 1 arg2 0) + (BC 4 0 skip21 "B.GE") + (mov t1 t2) + (unlikely-label skip21) + (stack-write iSP t1) + (ContinueToNextInstruction-NoStall)) + +;; Really operand-from-stack-immediate, but save cycles loading own operand +(define-instruction |DoPlusp| :operand-from-stack (:own-immediate t) + (simple-unary-arithmetic-predicate plusp 4 1 12 1) ; CMOVGT test is GT + (immediate-handler |DoPlusp|) + (Get-NIL t1) + (exts arg2 arg2 8 "Turned into a signed number") ; Uses EXTSB + (Get-T t2) + (ADDI iSP iSP 8) + (GetNextPCandCP) + (CMPI 0 1 arg2 0) + (BC 4 1 skip18 "B.LE") + (mov t1 t2) + (unlikely-label skip18) + (stack-write iSP t1) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNPRED.PPCS + +;; Handles DoLesspNoPop as well +(define-instruction |DoLessp| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + lessp SUBF 4 0 t 4 12 t |LesspMMExc|) ;FCMP yields CR.LT + (immediate-handler |DoLessp|) + (simple-binary-immediate-arithmetic-predicate + lessp SUBF 4 0 t)) + + +;;; From IFUNMATH.PPCS + +(define-instruction |DoDecrement| :operand-from-stack () + (stack-read2 arg1 arg2 arg3 "read tag/data of arg1") + (type-dispatch arg2 t1 t2 + (|TypeFixnum| + (LD t2 PROCESSORSTATE_MOSTNEGATIVEFIXNUM (ivory)) + (ADDI t3 arg3 -1) + (XOR t2 arg3 t2) ;overflow if most-negative-fixnum + (long-branch-false t2 DecrementException) ;in |OutOfLineExceptions| + (GetNextPCandCP) + (stack-write2 arg1 arg2 t3) + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (with-floating-exception-checking (DecrementException t2) + ;(CheckFloatingOverflow arg3 DecrementException t2) + (LFS f1 4 (arg1) "Get the floating data") + (LFS f2 PROCESSORSTATE_SFP1 (ivory) "constant 1.0") + (FSUBS f0 f1 f2)) + (GetNextPCandCP) + (STFS f0 4 (arg1) "Put the floating result") + (ContinueToNextInstruction-NoStall)) + (:else + (B DecrementException)))) + + +;;; From IFUNSUBP.PPCS + +(define-instruction |DoMergeCdrNoPop| :operand-from-stack (:needs-tos t) + (GetNextPCandCP) + (stack-read-tag arg1 t1 "Get the CDR CODE/TAG of arg2") + (stack-read-tag iSP t2 "Get the CDR CODE/TAG of arg1" :tos-valid t) + (force-alignment) + (ANDI-DOT t2 t2 #xC0 "Get Just the CDR code in position") + (ANDI-DOT t1 t1 #x3F "Get the TAG of arg1") + (OR t3 t1 t2 "Merge the tag of arg2 with the cdr code of arg1") + (STW t3 0 (arg1) "Replace tag/cdr code no pop") + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNPRED.PPCS, by way of IFUNCOM1.PPCS + +(define-procedure |DoEqImmediateHandler| () + (immediate-handler |DoEq|) + (exts arg2 arg2 8) + (stack-read2 iSP t4 t3 "t4=tag t3=data" :signed t) + (srdi arg3 arg3 #.(+ 10 2)) + (Get-NIL t11) + (TagType t4 t4) + (Get-T t12) + (ANDI-DOT arg3 arg3 1 "1 if no-pop, 0 if pop") + (SUBF arg2 arg2 t3) + (XORI t4 t4 |TypeFixnum|) + (sldi t5 arg3 3) + (ADD iSP t5 iSP "Either a stack-push or a stack-write") + (GetNextPC) + (OR t4 arg2 t4) + (GetNextCP) + (CMPI 0 1 t4 0) + (BC 4 2 skip7 "B.NE") + (mov t11 t12) + (unlikely-label skip7) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + + +;;; From IFUNMATH.PPCS + +(define-instruction |DoIncrement| :operand-from-stack () + (stack-read2 arg1 arg2 arg3 "read tag/data of arg1") + (type-dispatch arg2 t1 t2 + (|TypeFixnum| + (LD t2 PROCESSORSTATE_MOSTPOSITIVEFIXNUM (ivory)) + (ADDI t3 arg3 1) + (XOR t2 arg3 t2) ;overflow if most-positive-fixnum + (long-branch-false t2 IncrementException) ;in |OutOfLineExceptions| + (GetNextPCandCP) + (stack-write2 arg1 arg2 t3) + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (with-floating-exception-checking (IncrementException t2) + ;(CheckFloatingOverflow arg3 IncrementException t2) + (LFS f1 4 (arg1) "Get the floating data") + (LFS f2 PROCESSORSTATE_SFP1 (ivory) "constant 1.0") + (FADDS f0 f1 f2)) + (GetNextPCandCP) + (STFS f0 4 (arg1) "Put the floating result") + (ContinueToNextInstruction-NoStall)) + (:else + (B IncrementException)))) + + +(comment "Fin.") diff --git a/g5-emulator/ifunfcal.ppcs b/g5-emulator/ifunfcal.ppcs new file mode 100644 index 0000000..0ce1df0 --- /dev/null +++ b/g5-emulator/ifunfcal.ppcs @@ -0,0 +1,333 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Function calling.") + +(comment "Start call.") + +;; |DoStartCall| is in IFUNCOM1.PPCS + + +(comment "Finish call.") + +;; |DoFinishCallN| (and hence |DoFinishCallNApply|) are in IFUNCOM1.PPCS + +;; This handles both the apply and the non-apply cases (opcode in ARG3) +(define-instruction |DoFinishCallTos| :10-bit-immediate (:own-immediate t) + (extrdi arg1 arg3 8 16 "arg1 contains the disposition (two bits)") + (LWA arg2 4 (isp) "Get the number of args") + (ADDI isp isp -8 "Pop stack") + ;(clrldi arg2 arg2 32) ;no need, the number is positive + (sldi arg2 arg2 3) + (ADDI arg2 arg2 8 "Add 1 and convert to stacked word address") + (B finishcallmerge)) + + +(comment "Function entry.") + +;; |DoEntryRestNotAccepted| is in IFUNCOM1.PPCS + +(define-instruction |DoEntryRestAccepted| :entry-instruction () + (srdi t2 arg5 27 "Get the cr.trace-pending bit") + (ANDI-DOT t1 arg5 #xFF "The supplied args") + (ANDI-DOT R31 t2 1 "BLBS") + (BC 4 2 TraceTrap) + (b-apply-argument-supplied applysuppra t2 t3 t4 arg5) + (SUBF t2 arg2 t1 "t2=supplied-minimum") + (branch-if-less-than-zero t2 retryeratoofew "B. if too few args.") + (SUBF arg1 t1 arg4 "maximum-supplied") + (branch-if-less-than-zero arg1 retryerarest "B. rest args.") + (enter-function t2 t3 t4) ;doesn't return + (label applysuppra) + (SUBF arg1 t1 arg4 "maximum-supplied") + (branch-if-less-than-zero arg1 retryerarest "B. rest args.") + (branch-if-greater-than-zero arg1 |PullApplyArgs| "try pulling from applied args.") + (stack-set-cdr-code iSP 1 t6) ;CDR-NIL + (SUBF t2 arg2 t1 "t2=supplied-minimum") + (ADDI t2 t2 1) + (enter-function t2 t3 t4) ;doesn't return + (label retryeratoofew) + (illegal-operand too-few-arguments) + (label retryerarest) + (push-apply-args arg2 arg4 t1 t2 t3 arg5)) ;calls ENTER-FUNCTION and doesn't return + +#-list-inline +;; --- All the temps aren't really arguments, but they are smashed +(define-subroutine |CarCdrInternal| + (t1 t2 arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + (using-multiple-memory-reads (t9 t10 t11 t12) + (carcdr-internal t1 t2 arg5 arg6 set-to-cdr-push-car arg2 t5 t6 t7 t8))) + +(align4kskip4k) + +;; It might be slow, but not as slow as trapping out to Lisp! +;; ARG1 contains the number of args to pull +;; Rest argument is on the top of the stack +(define-procedure |PullApplyArgsSlowly| () + (with-multiple-memory-reads (t9 t10 t11 t12) + (pull-apply-args-slowly arg1 arg2 arg3 arg4 arg5 arg6 t1 t2 t3 t4 t5 t6))) + +(define-instruction |DoLocateLocals| :operand-from-stack () + (get-control-register t1 "The control register") + (mov iLP iSP) + (SUBF t3 iFP iLP "arg size including the fudge 2") + (srdi t3 t3 3 "adjust arg size to words") + (ANDI-DOT t2 t1 #xFF "argument size") + (ADDI t2 t2 -2 "corrected arg size") + (clrrdi t1 t1 8 "Clear low order 8 bits") + (OR t1 t1 t3 "replace the arg size") + (stack-push-fixnum t2 t4) + (set-control-register t1) + (ContinueToNextInstruction)) + +(comment "Returning.") + +;; |DoReturnSingle| is in IFUNCOM1.PPCS + +;; Register conventions for return-multiple instruction: +;; arg1 is number of values +;; arg2 is the pop(0)/immediate(1) flag +;; These are shared with return conventions for effect and value cases +;; arg3 is the return value (with cdr already cleared) +;; arg4 is the disposition dispatch +;; arg5 is the control register +;; arg6 is stack-cache-data (for underflow check) + +;; Return completes by branching to StackCacheUnderflowCheck which goes +;; to NextInstruction after dealing with underflow. In the for-return +;; case, this re-executes the instruction one frame up. --- +;; Return-multiple is only ever called in immediate or sp-pop mode, make +;; a custom entry that takes advantage of that +(define-instruction |DoReturnMultiple| :operand-from-stack (:own-immediate t) + ;; Here we know we were called with sp|pop + (LWA t1 0 (arg1) "Fetch the tag for type-check") + (LWA arg1 4 (arg1) "Fetch the data") + (CheckDataType t1 |TypeFixnum| returnmultipleio t2) + (clrldi arg1 arg1 32 "Discard dtp-fixnum tag word") + (label returnmultipletop) + (get-control-register arg5) + (load-constant t3 #.(* 3 1_18) "value disposition mask") + (ADDI t2 iSP 8) + (sldi t1 arg1 3 "Value bytes") + (AND t3 t3 arg5 "Mask") + (srdi t3 t3 18 "Shift disposition bits into place.") + (SUBF arg3 t1 t2 "Compute position of value(s)") + (LD arg6 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (ADDI arg4 t3 -2 "arg4 -2=effect -1=value 0=return 1=multiple") + (branch-if-less-than-zero arg4 returnmultiplesingle) + (abandon-frame-simple (not arg4) arg5 HandleFrameCleanup t1 t2 t3 t4 t5 t6 t7) + ;;+++ check for frame overflow here before copying in values + (ADDI t4 iSP 8 "Compute destination of copy") + (mov t3 arg1 "Values") + (stack-block-copy arg3 t4 t3 t nil t1 t2) + (sldi t2 arg1 3) + (ADD iSP t2 iSP "Adjust iSP over returned values") + (comment "arg4 -2=effect -1=value 0=return 1=multiple") + (branch-if-zero arg4 returnmultiplereturn) + (label returnmultiplemultiple) + (stack-push-fixnum arg1 t1 "push the MV return count") + (label returnmultipledone) + (CMPL 0 1 iFP arg6 "stack-cache underflow") + (BC 12 0 returnmultipleunderflow) + (mov arg2 t7) + (branch-if-nonzero t7 InterpretInstructionPredicted) + ;; PC was loaded if arg4 /= 0 + (branch-if-nonzero arg4 interpretInstructionForBranch) + (ContinueToInterpretInstruction "Return-multiple done") + (label returnmultipleunderflow) + (external-branch |StackCacheUnderflowCheck|) + + ;; Here for the cases that do not preserve multiple values (effect, value) + ;; fetch the first value (or NIL if there are no values) + (label returnmultiplesingle) + (stack-read arg3 arg3) + (get-nil t1) + (clrldi arg3 arg3 #.(- 64 38) "Clear cdr") + (CMPI 0 1 arg1 0) + (BC 4 2 skip8 "B.NE") + (mov arg3 t1) + (unlikely-label skip8) + (B returncommontail) + + (label returnmultiplereturn) + ;; If this was SP|POP, must push that back before retry + (branch-true arg2 returnmultipledone) + (stack-push-ir |TypeFixnum| arg1 t1) + (B returnmultipledone) + + (immediate-handler |DoReturnMultiple|) + (mov arg1 arg2) + ;; Not SP|POP + (load-constant arg2 1 "arg2 = (not sp|pop)") + (B returnmultipletop) + + (label returnmultipleio) + (illegal-operand one-operand-fixnum-type-error)) + +(define-procedure handleframecleanup () + (LD iSP PROCESSORSTATE_RESTARTSP (ivory) "Restore SP to instruction start") + (get-control-register arg5 "Get control register") + (cleanup-frame arg5 InterpretInstruction t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12) + (ContinueToInterpretInstruction "Retry the instruction")) + +(define-procedure |StackCacheUnderflowCheck| () + ;; iCP may not be valid yet, so we continue through + ;; InterpretInstructionForBranch, which will validate it + (stack-cache-underflow-check iFP InterpretInstructionForBranch |StackCacheUnderflow| t1 t2 t3 t4)) + +;; FROM, TO, and COUNT must be in T1, T2, and T3 +(define-fast-subroutine |StackCacheUnderflow| () (r0) + (stack-cache-underflow-body t1 t2 t3 t4 t5 t6 t7)) + +(define-procedure |StackCacheOverflowHandler| (iSP arg2) + ;; arg2 is nwords beyond iSP needed + (stack-cache-overflow-handler t1 t2 t3 t4 t5)) + +(define-instruction |DoReturnKludge| :operand-from-stack (:own-immediate t) + (stack-read2 arg1 t1 arg2 :signed t) + (CheckDataType t1 |TypeFixnum| returnkludgeio t2) + (clrldi arg2 arg2 32) + (immediate-handler |DoReturnKludge|) + (LD arg6 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (sldi t1 arg2 3) + (ADDI t1 t1 -8 "t1:=arg2*8-8") + (get-control-register t2) + (SUBF t1 t1 iSP "t1 is the values block") + (abandon-frame-simple t t2 returnkludgecleanup t3 t4 t5 t6 t7 t8 t9) + (branch-if-zero arg2 rkloopdone) + (label rklooptop) + (stack-read t1 t4 "Read a 40 bit word from the values block") + (ADDI arg2 arg2 -1) + (stack-write-disp iSP 8 t4 "Push value onto stack cdr codes and all") + (ADDI t1 t1 8) + (ADDI iSP iSP 8) + (branch-if-greater-than-zero arg2 rklooptop) + (label rkloopdone) + (CMPL 0 1 iFP arg6 "stack-cache underflow") + (BC 12 0 returnkludgeunderflow) + (branch-if-zero t9 interpretInstructionForBranch "No prediction, validate cache") + ;; Duplicate code from (label interpretInstructionPredicted) + (mov iCP t9) + (ContinueToInterpretInstruction) + + (label returnkludgeio) + (illegal-operand one-operand-fixnum-type-error) + (label returnkludgecleanup) + (external-branch handleframecleanup) + (label returnkludgeunderflow) + (external-branch |StackCacheUnderflowCheck|)) + +;;+++ Should signal TAKE-VALUES-TYPE-ERROR if args are not fixnums +(define-instruction |DoTakeValues| :operand-from-stack-immediate () + (Get-NIL arg6) + (clrldi arg1 arg1 32 "Number of values expected") + (stack-pop2 arg3 arg4 "Number of values provided") ;+++ only arg4 needed + (SUBF arg2 arg4 arg1) + (branch-if-less-than-zero arg2 takevalueslose "J. if too many args supplied") + (branch-if-greater-than-zero arg2 takevaluespad "J. if too few values supplied") + (ContinueToNextInstruction) + (label takevalueslose) + (sldi t4 arg2 3) + (ADD iSP t4 iSP "Remove the unwanted values") ;arg2 is -ve + (ContinueToNextInstruction) + (label takevaluespad) + (stack-cache-overflow-check t1 t2 t3 t4 t5 iSP arg2) + (label takevaluespadloop) + (stack-push-with-cdr arg6 "Push NIL") + (ADDI arg2 arg2 -1) + (branch-if-greater-than-zero arg2 takevaluespadloop) + (ContinueToNextInstruction)) + + +(comment "Catch Instructions") + +(define-instruction |DoCatchOpen| :10-bit-immediate () + (ANDI-DOT t10 arg1 1 "t10=1 if unwind-protect, t10=0 if catch") + (LWA t3 PROCESSORSTATE_CATCHBLOCK (ivory) "tag") + (sldi t10 t10 #.(+ 6 32)) + (LWA t4 PROCESSORSTATE_CATCHBLOCK+4 (ivory) "data") + (LD t2 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (SCAtoVMA iSP t9 t1) + (OR t1 t10 t2) + (stack-push-with-cdr t1) + (get-control-register t11) + (srdi t2 t11 #.(- 26 6) "Get old cleanup catch bit") + (ANDI-DOT t2 t2 #x40) + (srdi t1 t11 #.(- 8 7) "Get old extra arg bit") + (ANDI-DOT t1 t1 #x80) + (OR t1 t1 t2) + (TagType t3 t2) ;+++ will never be a cdr code? + (OR t1 t1 t2 "T1 now has new tag") + (stack-push2-with-cdr t1 t4) + (branch-if-nonzero t10 catchopen2) + (get-continuation2 t1 t2) + (TagType t1 t1) + (ANDI-DOT t3 arg1 #xC0 "T3 has the disposition bits in place") + (OR t1 t1 t3) + (stack-push2-with-cdr t1 t2) + (label catchopen2) + (li t1 |TypeLocative|) + (STW t1 PROCESSORSTATE_CATCHBLOCK (ivory) "tag") + (STW t9 PROCESSORSTATE_CATCHBLOCK+4 (ivory) "data") + (load-constant t1 #.1_26 "cr.cleanup-catch") + (OR t1 t1 t11 "set it") + (set-control-register t1) + (ContinueToNextInstruction)) + +(define-instruction |DoCatchClose| :operand-from-stack () + (LWA t1 PROCESSORSTATE_CATCHBLOCK+4 (ivory) "data") + (clrldi t1 t1 32) + (VMAtoSCA t1 t10 t3) ;t10 is now an SCA + (stack-read2-disp t10 8 arg3 arg4 "bstag bsdata") + (LD t4 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-read2-disp t10 16 arg5 arg6 "prtag prdata") + (srdi t3 t4 32) + (CMPL 0 0 t4 arg4 "32-bit compare (signed/unsigned irrelevant)") + (BC 12 2 catchcloseld) + (CheckDataType t3 |TypeLocative| catchclosedbt t1) + (label catchcloselt) + (unbind t1 t2 t3 t4 t5 t6 t7 t8 t9 arg1 arg2 t11) ;t1 gets new BSP + (CMPL 0 0 t1 arg4 "32-bit compare (signed/unsigned irrelevant)") + (BC 4 2 catchcloselt) + ;; After we've unbound everything, check for a preempt request + (check-preempt-request nil t3 t4) + (label catchcloseld) + (TagType arg5 t1) + (STW t1 PROCESSORSTATE_CATCHBLOCK (ivory) "tag") + (ANDI-DOT t2 arg5 #x80 "extra argument bit") + (LD t6 PROCESSORSTATE_EXTRAANDCATCH (ivory) "mask for two bits") + (sldi t2 t2 1 "position in place for control register.") + (STW arg6 PROCESSORSTATE_CATCHBLOCK+4 (ivory) "data") + (ANDI-DOT t3 arg5 #x40 "cleanup catch bit") + (sldi t3 t3 #.(- 26 6) "position in place for cr") + (get-control-register t4) + (OR t5 t2 t3 "coalesce the two bits") + (ANDC t4 t4 t6 "Turn off extra-arg and cleanup-catch") + (OR t4 t4 t5 "Maybe turn them back on") + (set-control-register t4) + (ANDI-DOT t6 arg3 #x40 "uwp bit") + (branch-if-zero t6 NextInstruction) + (comment "Handle unwind-protect cleanup here") + (stack-read2 t10 arg1 arg2 "pctag pcdata") + (srdi t8 t4 #.(- 23 6) "Cleanup in progress bit into cdr code pos") + ;; Get the next PC + (ADDI t7 iPC 1 "Next PC") + (convert-pc-to-continuation t7 t8 t10 t1) + (TagType t8 t7) + (ANDI-DOT t8 t8 #x40) + (load-constant t9 #.1_23 "cr.cleanup-in-progress") + (ORI t8 t8 #x80) + (OR t7 t7 t8) + (stack-push2-with-cdr t7 t10) + (OR t4 t4 t9 "set cr.cleanup-in-progress") + (set-control-register t4) + (convert-continuation-to-pc arg1 arg2 iPC t1) + (B InterpretInstructionForJump) + (label catchclosedbt) + (external-branch DBUNWINDCATCHTRAP)) + +(comment "Fin.") diff --git a/g5-emulator/ifunfext.ppcs b/g5-emulator/ifunfext.ppcs new file mode 100644 index 0000000..e588c8f --- /dev/null +++ b/g5-emulator/ifunfext.ppcs @@ -0,0 +1,183 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Field extraction instruction.") + + +;; |DoLdb| is is IFUNCOM1.PPCS + +(define-instruction |DoCharLdb| :field-extraction () + (li t7 -1) + (stack-read2-signed iSP arg3 arg4 "get ARG1 tag/data") + (ADDI arg1 arg1 1 "Size of field") + (SLD t7 t7 arg1 "Unmask") + (TagType arg3 t8) + (ADDI t9 t8 #.(- |type$K-character|)) + (clrldi arg4 arg4 32 "Clear sign extension now") + (branch-if-nonzero t9 charldbexc "Not a character") + (SLD t4 arg4 arg2 "T4= shifted value if PP==0") + (GetNextPC) + (srdi t5 t4 32 "T5= shifted value if PP<>0") + (GetNextCP) + (CMPI 0 1 arg2 0) + (BC 4 2 skip8a "B.NE") + (mov t5 t4 "T5= shifted value") + (unlikely-label skip8a) + (ANDC t3 t5 t7 "T3= masked value.") + (stack-write-ir |TypeFixnum| t3 t4) + (ContinueToNextInstruction-NoStall) + (label charldbexc) + (illegal-operand char-ldb-type-error)) + +(define-instruction |DoPLdb| :field-extraction () + (stack-read2 iSP t1 t2 "get arg1 tag/data") + (ADDI t3 t1 #.(- |type$K-physicaladdress|)) + (ANDI-DOT t3 t3 #x3F) + (branch-if-zero t3 pldbillop) + ;; We don't use the tag here, but MEMORY-READ needs it + (memory-read t2 arg3 arg4 PROCESSORSTATE_RAW t3 t4 t5 t6) + (li t7 -1) + (ADDI arg1 arg1 1 "Size of field") + (SLD t4 arg4 arg2 "T4= shifted value if PP==0") + (srdi t5 t4 32 "T5= shifted value if PP<>0") + (SLD t7 t7 arg1 "Unmask") + (CMPI 0 1 arg2 0) + (BC 4 2 skip10 "B.NE") + (mov t5 t4 "T5= shifted value") + (unlikely-label skip10) + (ANDC t3 t5 t7 "T3= masked value.") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4) + (ContinueToNextInstruction-NoStall) + (label pldbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + +(define-instruction |DoPTagLdb| :field-extraction () + (stack-read2 iSP t1 t2 "get arg1 tag/data") + (ADDI t3 t1 #.(- |type$K-physicaladdress|)) + (ANDI-DOT t3 t3 #x3F) + (branch-if-zero t3 ptagldbillop) + ;; We don't use the data here, but MEMORY-READ needs it + (memory-read t2 arg3 arg4 PROCESSORSTATE_RAW t3 t4 t5 t6 nil t) + (li t7 -1) + (ADDI arg1 arg1 1 "Size of field") + (SLD t4 arg3 arg2 "T4= shifted value if PP==0") + (srdi t5 t4 32 "T5= shifted value if PP<>0") + (SLD t7 t7 arg1 "Unmask") + (CMPI 0 1 arg2 0) + (BC 4 2 skip9 "B.NE") + (mov t5 t4 "T5= shifted value") + (unlikely-label skip9) + (ANDC t3 t5 t7 "T3= masked value.") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4) + (ContinueToNextInstruction-NoStall) + (label ptagldbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + + +;;; arg1 new-value iSP-8 +;;; arg2 integer iSP +;;; arg3 bytespec instn operand +(define-instruction |DoDpb| :field-extraction () + (stack-pop2 t5 t6 "Get arg2 tag/data") + (stack-read2 iSP arg3 arg4 "get arg1 tag/data") + (binary-type-dispatch (t5 arg3 t1 t2 arg6 arg5) + ((|TypeFixnum| |TypeFixnum|) + (li t7 -2) ;11111111111111111110 + (SLD t7 t7 arg1 "Unmask") ;11111111111111110000 + (NAND t5 t7 t7 "reuse t5 as mask") ;00000000000000001111 + (ANDC t3 arg4 t7 "T3= masked new value.") ;unshifted new bits t3 + (SLD t5 t5 arg2 "t5 is the inplace mask") ;00000001111000000 t5 + (SLD t4 t3 arg2 "t4 is the shifted field") ;0000000bbbb000000 t4 + (ANDC t6 t6 t5 "Clear out existing bits in arg2 field") + (OR t6 t4 t6 "Put the new bits in") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t6 t4) + (ContinueToNextInstruction-NoStall)) + (:else1 + (NumericTypeException t5 dpb)) + (:else2 + (NumericTypeException arg3 dpb)))) + +(define-instruction |DoCharDpb| :field-extraction () + (stack-pop2 t5 t6 "Get arg2 tag/data") + (stack-read2 iSP arg3 arg4 "get arg1 tag/data") + (binary-type-dispatch (t5 arg3 t1 t2 arg6 arg5) + ((|TypeCharacter| |TypeFixnum|) + (li t7 -2) ;11111111111111111110 + (SLD t7 t7 arg1 "Unmask") ;11111111111111110000 + (NAND t5 t7 t7 "reuse t5 as mask") ;00000000000000001111 + (ANDC t3 arg4 t7 "T3= masked new value.") ;unshifted new bits t3 + (SLD t5 t5 arg2 "t5 is the inplace mask") ;00000001111000000 t5 + (SLD t4 t3 arg2 "t4 is the shifted field") ;0000000bbbb000000 t4 + (ANDC t6 t6 t5 "Clear out existing bits in arg2 field") + (OR t6 t4 t6 "Put the new bits in") + (GetNextPCandCP) + (stack-write-ir |TypeCharacter| t6 t4) + (ContinueToNextInstruction-NoStall)) + (:else1 + (SpareTypeException t5 char-dpb nil char-dpb-type-error)) + (:else2 + (illegal-operand char-dpb-type-error)))) + +(define-instruction |DoPDpb| :field-extraction () + (stack-pop2 t1 t2 "Get arg2 tag/data") + (ADDI t3 t1 #.(- |type$K-physicaladdress|)) + (ANDI-DOT t3 t3 #x3F) + (branch-if-zero t3 pdpbillop) + (stack-pop2 arg3 arg4 "get arg1 tag/data") + (memory-read t2 t8 t6 PROCESSORSTATE_RAW t3 t4 t1 t5) + (clrldi t6 t6 32) + (type-dispatch arg3 t1 t10 + (|TypeFixnum| + (li t7 -2) ;11111111111111111110 + (SLD t7 t7 arg1 "Unmask") ;11111111111111110000 + (NAND t5 t7 t7 "reuse t5 as mask") ;00000000000000001111 + (ANDC t3 arg4 t7 "T3= masked new value.") ;unshifted new bits t3 + (SLD t5 t5 arg2 "t5 is the inplace mask") ;00000001111000000 t5 + (SLD t4 t3 arg2 "t4 is the shifted field") ;0000000bbbb000000 t4 + (ANDC t6 t6 t5 "Clear out existing bits in arg2 field") + (OR t6 t4 t6 "Put the new bits in") + (memory-write t2 t8 t6 PROCESSORSTATE_RAW t3 t4 t1 t5 t10 + NextInstruction) + (ContinueToNextInstruction)) + (:else + (illegal-operand %p-dpb-type-error))) + (label pdpbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + +(define-instruction |DoPTagDpb| :field-extraction () + (stack-pop2 t1 t2 "Get arg2 tag/data") + (ADDI t3 t1 #.(- |type$K-physicaladdress|)) + (ANDI-DOT t3 t3 #x3F) + (branch-if-zero t3 ptagdpbillop) + (stack-pop2 arg3 arg4 "get arg1 tag/data") + (memory-read t2 t6 t8 PROCESSORSTATE_RAW t3 t4 t1 t5 nil t) + (type-dispatch arg3 t1 t10 + (|TypeFixnum| + (li t7 -2) ;11111111111111111110 + (SLD t7 t7 arg1 "Unmask") ;11111111111111110000 + (NAND t5 t7 t7 "reuse t5 as mask") ;00000000000000001111 + (ANDC t3 arg4 t7 "T3= masked new value.") ;unshifted new bits t3 + (SLD t5 t5 arg2 "t5 is the inplace mask") ;00000001111000000 t5 + (SLD t4 t3 arg2 "t4 is the shifted field") ;0000000bbbb000000 t4 + (ANDC t6 t6 t5 "Clear out existing bits in arg2 field") + (OR t6 t4 t6 "Put the new bits in") + (memory-write t2 t6 t8 PROCESSORSTATE_RAW t3 t4 t1 t5 t10 + NextInstruction) + (ContinueToNextInstruction)) + (:else + (illegal-operand %p-dpb-type-error))) + (label ptagdpbillop) + (SCAtoVMA iSP t1 t2) + (illegal-operand (memory-data-error data-read) t2 "Physical not supported")) + + +(comment "Fin.") diff --git a/g5-emulator/ifunfull.ppcs b/g5-emulator/ifunfull.ppcs new file mode 100644 index 0000000..8457a08 --- /dev/null +++ b/g5-emulator/ifunfull.ppcs @@ -0,0 +1,95 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "The full word instructions") + +(define-instruction |DoIStageError| :full-word-instruction () + (illegal-operand i-stage-error)) + +(define-instruction |nullfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-null))) + +(define-instruction |monitorforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-monitor-forward))) + +(define-instruction |headerpfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-header-p))) + +(define-instruction |headerifw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-header-i))) + +(define-instruction |oneqforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-one-q-forward))) + +(define-instruction |headerforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-header-forward))) + +(define-instruction |elementforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-element-forward))) + +(define-instruction |gcforwardfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-gc-forward))) + +(define-instruction |boundlocationfw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-bound-location))) + +(define-instruction |logicvariablefw| :full-word-instruction () + (illegal-operand (illegal-full-word-instruction dtp-logic-variable))) + +;; |valuecell| is in IFUNCOM1.PPCS + +;; |pushconstantvalue| is in IFUNCOM1.PPCS + +(define-instruction |pushsparepointer3| :full-word-instruction () + (LD arg1 CACHELINE_INSTRUCTION (iCP) "Get operand") + (UnimplementedInstruction)) + +(define-instruction |pushsparepointer4| :full-word-instruction () + (LD arg1 CACHELINE_INSTRUCTION (iCP) "Get operand") + (UnimplementedInstruction)) + +(passthru ".globl callcompiledoddprefetch") +(define-instruction |callcompiledodd| :full-word-instruction () + (label |callcompiledoddprefetch|) ;the same as |callcompiledodd| + (mov arg6 arg3 "Get operand") + (li arg5 |TypeOddPC|) + (clr arg3 "No extra arg") + (B startcallcompiledmerge)) ;push new frame and exit + +;; |callindirect|, |callindirectprefetch|, |callcompiledeven|, and +;; |callgeneric| are in IFUNCOM1.PPCS + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Native Instruction Support ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-instruction |nativeinstruction| :full-word-instruction () + ;; RESTARTSP already set when we get here + (clrrdi arg1 iPC 1 "arg1 is instruction address*2 here") + (ADD arg1 arg1 arg1 "Select the DATA address") + (sldi arg2 Ivory 2 "arg2:=Ivory*4") + (ADD arg1 arg1 arg2 "Add in the memory base") + (MTSPR 8 arg1) + (BCLRL 20 0 "Jump into the Ivory code") ;R0 + ;; On return, fall-through to resumeemulated + ) + +;; Native mode returns to here with the return address in arg1 (why not r0)? +(define-procedure |resumeemulated| () + ;; RESTARTSP will be set by nextInstruction + (LD arg2 CACHELINE_ANNOTATION (iCP)) + (sldi iPC Ivory 2) + (SUBF iPC arg1 iPC "iPC:=4*Ivory-arg1") + (NEG iPC iPC) + (srdi iPC iPC 1) + ;; --- Don't need to check sequence-break on this path, now that + ;; branch translations do it directly + (long-branch-if-nonzero arg2 interpretInstructionPredicted) + (B interpretInstructionforBranch) + ) + + +(comment "Fin.") diff --git a/g5-emulator/ifungene.ppcs b/g5-emulator/ifungene.ppcs new file mode 100644 index 0000000..c45a4ce --- /dev/null +++ b/g5-emulator/ifungene.ppcs @@ -0,0 +1,27 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Generic dispatching an method lookup") + +;; |DoGenericDispatch| and |LookupHandler| are in IFUNCOM1.PPCS + +(define-instruction |DoMessageDispatch| :operand-from-stack () + (message-dispatch arg1 t1 arg3 arg4 t4 t9 t6 t7 arg2 arg5 t3 t2)) + + +#+obsolete +;; Branched to from |LookupHandler| if the object is not an instance. +;; Branches back to |LookupHandlerInstance| when done. +(define-procedure |LookupHandlerNonInstance| () + ;; Note well! Don't change these memo registers without also fixing + ;; the call to WITH-MULTIPLE-MEMORY-READS in |LookupHandlerInstance|. + (using-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (non-instance-descriptor-info + arg3 arg4 arg5 arg6 t1 t2 t3 t4 t5 t6 t7 + |LookupHandlerInstance| |LookupHandlerNonInstance|))) + + +(comment "Fin.") diff --git a/g5-emulator/ifunhead.ppcs b/g5-emulator/ifunhead.ppcs new file mode 100644 index 0000000..5ad511d --- /dev/null +++ b/g5-emulator/ifunhead.ppcs @@ -0,0 +1,13 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(comment "Entry points into the interpretation loop.") + +(external "HALTMACHINE") +(external "ILLEGALINSTRUCTION") +(external "ILLEGALOPERAND") +(external "SUSPENDMACHINE") +(external "ICACHEMISS") +(external "INTERPRETINSTRUCTION") +(external "NEXTINSTRUCTION") + +(comment "Fin.") diff --git a/g5-emulator/ifuninst.ppcs b/g5-emulator/ifuninst.ppcs new file mode 100644 index 0000000..137e186 --- /dev/null +++ b/g5-emulator/ifuninst.ppcs @@ -0,0 +1,142 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Instance variable accessors..") + +;; |DoPushInstanceVariable| is in IFUNCOM1.PPCS + +(define-instruction |DoPopInstanceVariable| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6 :cant-be-in-cache-p t) + (locate-instance-variable-mapped arg2 arg1 IVBadMap IVBadInst IVBadIndex popiviex + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + (stack-pop2 t2 t1) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label popiviex) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception pop-instance-variable 1 t1 t2) + (instruction-exception)) + +(define-instruction |DoMovemInstanceVariable| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6 :cant-be-in-cache-p t) + (locate-instance-variable-mapped arg2 arg1 IVBadMap IVBadInst IVBadIndex movemiviex + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + (stack-read2 iSP t2 t1) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label movemiviex) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception movem-instance-variable 0 t1 t2) + (instruction-exception)) + +;(align16k) + +(define-instruction |DoPushAddressInstanceVariable| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6 :cant-be-in-cache-p t) + (locate-instance-variable-mapped arg2 arg1 IVBadMap IVBadInst IVBadIndex pushadiviex + t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + (stack-push-ir |TypeLocative| arg1 t7) + (ContinueToNextInstruction) + (label pushadiviex) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception push-address-instance-variable 0 t1 t2) + (instruction-exception)) + + +(define-instruction |DoPushInstanceVariableOrdered| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (memory-read arg1 t2 t1 PROCESSORSTATE_DATAREAD t4 t5 t6 t7 nil t)) + (GetNextPCandCP) + (stack-push2 t2 t1 t7) + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoPopInstanceVariableOrdered| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (stack-pop2 t2 t1) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction)) + +(define-instruction |DoMovemInstanceVariableOrdered| :10-bit-immediate () + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (stack-read2 iSP t2 t1) + (store-contents arg1 t2 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction)) + + +(define-instruction |DoPushAddressInstanceVariableOrdered| :10-bit-immediate () + (locate-instance-variable-unmapped arg2 arg1 IVBadInst t1 t2 t3) + (stack-push-ir |TypeLocative| arg1 t7) + (ContinueToNextInstruction) + (label IVBadMap) + (illegal-operand self-mapping-table-type-error) + (label IVBadIndex) + (illegal-operand mapping-table-index-out-of-bounds) + (label IVBadInst) + (illegal-operand self-type-error)) + + +(define-instruction |DoInstanceRef| :operand-from-stack-immediate () + (stack-read2 iSP arg3 arg4) + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (with-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (locate-arbitrary-instance-variable arg3 arg4 arg2 arg1 arg5 + IVRefBadInst IVRefBadOffset + t1 t2 t3 t4 t5 t6 t7 t8)) + (memory-read arg5 t2 t1 PROCESSORSTATE_DATAREAD t4 t5 t6 t7 nil t) + (ANDI-DOT t2 t2 #x3F "set CDR-NEXT") + (GetNextPCandCP) + (stack-write2 iSP t2 t1) + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoInstanceSet| :operand-from-stack-immediate () + (stack-pop2 arg3 arg4) + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (with-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (locate-arbitrary-instance-variable arg3 arg4 arg2 arg1 arg5 + IVRefBadInst3 IVRefBadOffset + t1 t2 t3 t4 t5 t6 t7 t8)) + (stack-pop2 t2 t1) + (with-multiple-memory-reads (t9 t10 t11 t12) + (store-contents arg5 t2 t1 PROCESSORSTATE_DATAWRITE t3 t4 t5 t6 t7 t8 + NextInstruction)) + (ContinueToNextInstruction) + (label IVRefBadInst3) + (illegal-operand (%instance-reference-type-error :three-argument))) + +(define-instruction |DoInstanceLoc| :operand-from-stack-immediate () + (stack-read2 iSP arg3 arg4) + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (with-multiple-memory-reads (t9 t10 t11 t12 :cant-be-in-cache-p t) + (locate-arbitrary-instance-variable arg3 arg4 arg2 arg1 arg5 + IVRefBadInst IVRefBadOffset + t1 t2 t3 t4 t5 t6 t7 t8)) + (stack-write-ir |TypeLocative| arg5 t7) + (ContinueToNextInstruction) + (label IVRefBadInst) + (illegal-operand (%instance-reference-type-error :binary)) + (label IVRefBadOffset) + (illegal-operand illegal-instance-variable-index-from-memory)) + + +(comment "Fin.") diff --git a/g5-emulator/ifunjosh.ppcs b/g5-emulator/ifunjosh.ppcs new file mode 100644 index 0000000..f018582 --- /dev/null +++ b/g5-emulator/ifunjosh.ppcs @@ -0,0 +1,70 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "'AI' instructions.") + +(define-instruction |DoDereference| :operand-from-stack-signed-immediate () + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (type-dispatch arg2 t1 t2 + ((|TypeOneQForward| |TypeElementForward| |TypeHeaderForward| + |TypeExternalValueCellPointer|) + (memory-read arg1 t4 t3 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t) + (stack-push2 t4 t3 t5) + (ContinueToNextInstruction)) + (|TypeLogicVariable| + (stack-push-ir |TypeExternalValueCellPointer| arg1 t5) + (ContinueToNextInstruction)) + (:else + (stack-push2 arg2 arg1 t5) + (ContinueToNextInstruction)))) + +(define-instruction |DoUnify| :operand-from-stack-signed-immediate () + (UnimplementedInstruction) ;let's do this one when my brain is in! + (ContinueToNextInstruction)) + +(define-instruction |DoPushLocalLogicVariables| :operand-from-stack-immediate () + (li arg6 |TypeLogicVariable|) + (srdi t1 arg1 32) + (clrldi arg2 arg1 32) + (CheckDataType t1 |TypeFixnum| pllvillop t2) + (stack-cache-overflow-check t1 t2 t3 t4 t5 iSP arg2) + (B pllvloopend) + (label pllvlooptop) + (stack-push2-with-cdr arg6 iSP) ;+++ wrongo + (label pllvloopend) + (ADDI arg2 arg2 -1) + (branch-if-greater-than-or-equal-to-zero arg2 pllvlooptop "J. If iterations to go.") + (ContinueToNextInstruction) + (label pllvillop) + (illegal-operand one-operand-fixnum-type-error)) ;+++ microcode doesn't do this + +(define-instruction |DoPushGlobalLogicVariable| :operand-from-stack-signed-immediate () + (LWA t1 PROCESSORSTATE_BAR2+4 (ivory) "Get the structure stack pointer") + (li t3 |TypeExternalValueCellPointer|) + (stack-push2-with-cdr t3 t1) + (store-contents t1 t3 t1 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9) + (ADDI t2 t1 1 "Increment the structure-stack-pointer") + (STW t2 PROCESSORSTATE_BAR2+4 (ivory) "Set the structure stack pointer") + (ContinueToNextInstruction)) + +(define-instruction |DoLogicTailTest| :operand-from-stack-signed-immediate () + (srdi arg2 arg1 32) + (type-dispatch arg2 t1 t2 + (|TypeList| + (stack-push-nil t3 t4) + (ContinueToNextInstruction)) + (|TypeExternalValueCellPointer| + (stack-push-t t3 t4) + (ContinueToNextInstruction)) + (|TypeListInstance| + (stack-push-nil t3 t4) + (ContinueToNextInstruction)) + (:else + (prepare-exception logic-tail-test 0 arg1 t2) + (instruction-exception)))) + +(comment "Fin.") diff --git a/g5-emulator/ifunlexi.ppcs b/g5-emulator/ifunlexi.ppcs new file mode 100644 index 0000000..f19e543 --- /dev/null +++ b/g5-emulator/ifunlexi.ppcs @@ -0,0 +1,75 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Lexical variable accessors.") + +;(align16k) + +(define-instruction |DoPushLexicalVarN| :operand-from-stack () + (srdi t4 arg3 10 "Position the opcode") + ;; in-line (stack-read2 arg1 t2 t1) + (LWA t1 4 (arg1)) + (LWA t2 0 (arg1)) + (ANDI-DOT t4 t4 7 "Get the lexical var number") + (clrldi t1 t1 32) + (TagType t2 t3) + (ADDI t3 t3 #.(- |type$K-list|)) + (rotrdi t3 t3 2) ;(BIC t3 4 t3) + (clrrdi t3 t3 1) + (ADD t1 t1 t4 "Compute the address of the lexical variable.") + (branch-if-nonzero t3 pushlexvariop) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (memory-read t1 t2 t3 PROCESSORSTATE_DATAREAD t4 t5 t6 t7 nil t)) + (GetNextPCandCP) + (stack-push2 t2 t3 t4) + (ContinueToNextInstruction-NoStall) + (label pushlexvariop) + (illegal-operand unary-lexical-environment-type-error nil "Not a list or locative")) + +(define-instruction |DoPopLexicalVarN| :operand-from-stack () + (srdi t4 arg3 10 "Position the opcode") + ;; in-line (stack-read2 arg1 t2 t1) + (LWA t1 4 (arg1)) + (LWA t2 0 (arg1)) + (ANDI-DOT t4 t4 7 "Get the lexical var number") + (clrldi t1 t1 32) + (TagType t2 t3) + (ADDI t3 t3 #.(- |type$K-list|)) + (rotrdi t3 t3 2) ;(BIC t3 4 t3) + (clrrdi t3 t3 1) + (ADD t1 t1 t4 "Compute the address of the lexical variable.") + (branch-if-nonzero t3 poplexvariop) + (stack-pop2 t2 t3) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents t1 t2 t3 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label poplexvariop) + (illegal-operand binary-lexical-environment-type-error nil "Not a list or locative")) + +(define-instruction |DoMovemLexicalVarN| :operand-from-stack () + (srdi t4 arg3 10 "Position the opcode") + ;; in-line (stack-read2 arg1 t2 t1) + (LWA t1 4 (arg1)) + (LWA t2 0 (arg1)) + (ANDI-DOT t4 t4 7 "Get the lexical var number") + (clrldi t1 t1 32) + (TagType t2 t3) + (ADDI t3 t3 #.(- |type$K-list|)) + (rotrdi t3 t3 2) ;(BIC t3 4 t3) + (clrrdi t3 t3 1) + (ADD t1 t1 t4 "Compute the address of the lexical variable.") + (branch-if-nonzero t3 movemlexvariop) + (stack-read2 iSP t2 t3) + (with-multiple-memory-reads (arg3 arg4 arg5 arg6) + (store-contents t1 t2 t3 PROCESSORSTATE_DATAWRITE t4 t5 t6 t7 t8 t9 + NextInstruction)) + (ContinueToNextInstruction) + (label movemlexvariop) + (illegal-operand binary-lexical-environment-type-error nil "Not a list or locative")) + + +(comment "Fin.") diff --git a/g5-emulator/ifunlist.ppcs b/g5-emulator/ifunlist.ppcs new file mode 100644 index 0000000..f6f5991 --- /dev/null +++ b/g5-emulator/ifunlist.ppcs @@ -0,0 +1,137 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "List Operations.") + +;; |DoCar| and |DoCdr| are in IFUNCOM1.PPCS + + +(define-instruction |DoSetToCar| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (isettocar arg1 arg5 arg6 arg2 t1 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + (ANDI-DOT t2 arg5 192 "Save the old CDR code") + #+list-inline (car-internal arg5 arg6 set-to-car arg2 t5 t6 t7 t8 t) + #-list-inline (call-subroutine |CarInternal|) + (TagType arg5 arg5) + (OR arg5 arg5 t2 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (ContinueToNextInstruction))) + +(define-instruction |DoSetToCdr| :operand-from-stack () + (with-multiple-memory-reads (t9 t10 t11 t12) + ;; (isettocdr arg1 arg5 arg6 arg2 t1 t2 t3 t4 t5 t6 t7 t8) + (stack-read2 arg1 arg5 arg6 "Get the operand from the stack." :signed t) + (ANDI-DOT t2 arg5 192 "Save the old CDR code") + #+list-inline (cdr-internal arg5 arg6 set-to-cdr arg2 t5 t6 t7 t8 t) + #-list-inline (call-subroutine |CdrInternal|) + (TagType arg5 arg5) + (OR arg5 arg5 t2 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (ContinueToNextInstruction))) + + +;; |DoSetToCdrPushCar| is in IFUNCOM1.PPCS + +(define-procedure |SetToCdrPushCarLocative| () + (label settocdrpushcarlocative) + (mov arg2 t2) + (using-multiple-memory-reads (t9 t10 t11 t12) + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t)) + (TagType t1 t1) + (stack-push2-with-cdr arg5 arg6) + (OR t1 t1 t3 "Put back the original CDR codes") + (stack-write2 arg1 arg5 arg6) + (ContinueToNextInstruction)) + +;; |DoRplaca| and |DoRplacd| are in IFUNCOM2.PPCS + +(define-instruction |DoAssoc| :operand-from-stack (:needs-tos t) + (carcdrloop (assoc arg3 arg4 t1 t2 arg5 arg6 arg2 assoccdr assocexc + t4 t5 t6 t7 t8 t9 t10 t11 t12) + (;; Loop top: nothing + ) + (;; Loop body: look for alist element + (type-dispatch t1 t7 t8 + (|TypeList| + (mov arg2 t2) ;MEM-READ can clobber its VMA arg + ;; save/restore arg5/arg6 (the cdr) around memory-read + (mov t3 arg5) + (mov arg1 arg6) + (memory-read arg2 arg5 arg6 PROCESSORSTATE_DATAREAD t5 t6 t7 t8 nil t) + (TagType arg5 t5) + (mov arg5 t3) + (CMP 0 0 arg6 arg4) + (mov arg6 arg1) + (BC 4 2 assoccdr "Jump if data different") + (CMP 0 1 t5 arg3) + (BC 4 2 assoccdr "Jump if tags different") + (comment "we found a match!") + (TagType t1 t1) + (stack-write2 iSP t1 t2) + (ContinueToNextInstruction)) ;loop exit succeed + (|TypeNIL| ;skip this element + (B assoccdr)) + (:else ;+++ should do spare list exception + (SetTag arg4 arg5 t1) + (illegal-operand assoc-list-element-not-list t1)))) + (;; Loop step: nothing, macro automatically cdrs + ) + (;; Loop end: return nil + (stack-write-nil iSP t1 t2 "Return NIL") + (ContinueToNextInstruction)))) + +(define-instruction |DoMember| :operand-from-stack (:needs-tos t) + (carcdrloop (member arg3 arg4 t1 t2 arg5 arg6 arg2 membercdr memberexc + t4 t5 t6 t7 t8 t9 t10 t11 t12) + (;; Loop top: remember list in t3/arg1 + (TagType t1 t3) + (mov arg1 t2)) + (;; Loop body: compare car + (TagType t1 t5) + (SUBF t7 t2 arg4 "t7=0 if data same") + (branch-if-nonzero t7 membercdr "J. if different") + (SUBF t6 t5 arg3 "t6 zero if same tag") + (branch-if-nonzero t6 membercdr "J. if tags different") + (comment "we found a match!") + (stack-write2 iSP t3 arg1) + (ContinueToNextInstruction)) + (;; Loop step: nothing, macro automatically cdrs + ) + (;; Loop end: return nil + (stack-write-nil iSP t1 t2 "Return NIL") + (ContinueToNextInstruction)))) + +(define-instruction |DoRgetf| :operand-from-stack (:needs-tos t) + (carcdrloop (rgetf arg3 arg4 t1 t2 arg5 arg6 arg2 rgetfcdr rgetfexc + t4 t5 t6 t7 t8 t9 t10 t11 t12) + (;; Loop top: nothing + ) + (;; Loop body: compare car + (TagType t1 t5) + (SUBF t7 t2 arg4 "t7=0 if data same") + (branch-if-nonzero t7 rgetfcdr "J. if different") + (SUBF t6 t5 arg3 "t6 zero if same tag") + (branch-if-nonzero t6 rgetfcdr "J. if tags different") + (comment "we found a match!") + (TagType arg5 t1 "Strip CDR code") + (ADDI t5 t1 #.(- |type$K-NIL|) "t5=0 if end of list") + (branch-if-zero t5 rgetfexc "after all this effort we lose!") + (mov t2 arg6) + #+list-inline (car-internal arg5 arg6 rgetf arg2 t5 t6 t7 t8 t) + #-list-inline (call-subroutine |CarInternal|) ;cadr of init + (TagType arg5 arg5 "Strip the CDR code") + (stack-write2 iSP arg5 arg6) ;return value 1 + (stack-push2 t1 t2 arg2 "Push the second result") ;cdr of init + (ContinueToNextInstruction)) + (;; Loop step: cdr over value + CDR + ) + (;; Loop end: return (values nil nil) + (stack-write-nil-and-push-nil iSP arg2 "Return NIL") ;fail exit + (ContinueToNextInstruction)))) + +(comment "Fin.") diff --git a/g5-emulator/ifunloop.ppcs b/g5-emulator/ifunloop.ppcs new file mode 100644 index 0000000..4224877 --- /dev/null +++ b/g5-emulator/ifunloop.ppcs @@ -0,0 +1,78 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Branch and loop instructions.") + +;;; First the most commonly used branches + +;; |DoBranch| is in IFUNCOM1.PPCS + + +;; |DoBranchTrue| and |DoBranchFalse| are in IFUNCOM1.PPCS + + +;; |DoBranchTrueNoPop| and |DoBranchFalseNoPop| is is IFUNCOM1.PPCS + + +;; |DoBranchTrueAndExtraPop| and |DoBranchFalseAndExtraPop| are in IFUNCOM2.PPCS + + +;; |DoBranchTrueAndNoPop| and |DoBranchFalseAndNoPop| are in IFUNCOM2.PPCS + + +(define-instruction |DoBranchTrueElseNoPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil t nil nil |BranchException|)) ;and-pop + +;; |DoBranchFalseElseNoPop| is in IFUNCOM2.PPCS + + +(define-instruction |DoBranchTrueElseExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil t t |BranchException|)) ;else-pop extra-pop + +(define-instruction |DoBranchFalseElseExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil t t |BranchException|)) ;invert else-pop extra-pop + + +;; |DoBranchTrueExtraPop| is less commonly used, so it's down below +(define-instruction |DoBranchFalseExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t t t t |BranchException|)) ;invert and-pop else-pop extra-pop + + +;;; Then the loop instructions + +(define-instruction |DoLoopDecrementTos| :10-bit-signed-immediate (:needs-tos t) + (iloop-decrement-tos)) + +(define-instruction |DoLoopIncrementTosLessThan| :10-bit-signed-immediate (:needs-tos t) + (iloop-increment-tos-less-than)) + + +;;; Finally the less commonly used branches + +(define-instruction |DoBranchTrueExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil t t t |BranchException|)) ;and-pop else-pop extra-pop + +(define-instruction |DoBranchTrueAndNoPopElseNoPopExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond nil nil nil t |BranchException|)) ;extra-pop + +(define-instruction |DoBranchFalseAndNoPopElseNoPopExtraPop| :10-bit-signed-immediate + (:own-immediate t :needs-tos t) + (ibranchcond t nil nil t |BranchException|)) ;invert extra-pop + + +;; All conditional branch exceptions end up here +(define-procedure |BranchException| () + (illegal-operand branch-dot-error)) + + +(comment "Fin.") + diff --git a/g5-emulator/ifunmath.ppcs b/g5-emulator/ifunmath.ppcs new file mode 100644 index 0000000..e219dc5 --- /dev/null +++ b/g5-emulator/ifunmath.ppcs @@ -0,0 +1,130 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Arithmetic.") + + +;; |DoAdd| and |DoSub| is in IFUNCOM2.PPCS + + +;; Same deal as |DoAdd| and |DoSub|... +(define-instruction |DoUnaryMinus| :operand-from-stack (:own-immediate t) + (PrefetchNextPC t6) + (PrefetchNextCP t7) + (stack-read-tag arg1 arg5 "tag of ARG2") + (stack-read-data arg1 arg6 :signed t) + (LD t2 PROCESSORSTATE_MOSTNEGATIVEFIXNUM (ivory)) + (stack-read-data arg1 f1 :floating t) + (type-dispatch arg5 t5 t4 + (|TypeFixnum| + (CMPL 0 0 arg6 t2 "32-bit compare (signed/unsigned irrelevant)") + (NEG arg2 arg6) + (BC 12 2 unaryminusexc "Overflow if most-negative-fixnum") + (SetNextPC t6) + (stack-write-tag-disp iSP 8 t5 "Semi-cheat, we know t5 has CDRNext/TypeFixnum") + (SetNextCP t7) + (stack-push-data arg2 "Push the data") + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (with-floating-exception-checking (unaryminusexc t2) + ;(CheckFloatingOverflow arg6 unaryminusexc t2) + (FNEG f0 f1)) + ;; (fp-stack-push-ir |TypeSingleFloat| f0 t7) + (SetNextPC t6) + (stack-write-tag-disp iSP 8 t5 "Semi-cheat, we know t5 has CDRNext/TypeSingleFloat") + (SetNextCP t7) + (stack-push-data f0 "Push the data" :floating t) + (ContinueToNextInstruction-NoStall)) + (:else + (label unaryminusexc) + (UnaryNumericTypeException arg5 unary-minus))) + (immediate-handler |DoUnaryMinus|) + (NEG arg2 arg2 "Negate the 8 bit immediate operand") + (GetNextPCandCP) + (stack-push-ir |TypeFixnum| arg2 t7) + (ContinueToNextInstruction-NoStall)) + +;; Same deal |DoAdd| and |DoSub|... +(define-instruction |DoMultiply| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-operation multiply MULLW FMULS DoMulOvfl) + (immediate-handler |DoMultiply|) + (simple-binary-immediate-arithmetic-operation |DoMultiply| MULLW t DoMulOvfl)) + + +;; |DoIncrement| and |DoDecrement| are in IFUNCOM2.PPCS + + +(align4kskip4k) + +(define-subroutine |BinaryArithmeticDivisionPrelude| + ;; --- Arguments need to be regularized + () + (r0) + ;; --- Instruction is irrelevant + (binary-arithmetic-division-prelude quotient)) + +(define-instruction |DoQuotient| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (call-subroutine |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-one-value-division-operation :truncate)) + +;; Same thing, but inexact fixnum results trap out to become ratios. +;; Maybe cons them here some day? +(define-instruction |DoRationalQuotient| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (call-subroutine |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-one-value-division-operation :rational)) + +(define-instruction |DoFloor| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (call-subroutine |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :down)) + +(define-instruction |DoCeiling| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (call-subroutine |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :up)) + +(define-instruction |DoTruncate| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (call-subroutine |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :truncate)) + +(define-instruction |DoRound| :operand-from-stack (:needs-tos t :provide-immediate t :signed-immediate t) + (call-subroutine |BinaryArithmeticDivisionPrelude|) + (binary-arithmetic-two-value-division-operation :round)) + +(comment "Other arithmetic.") + +;; Really this is :operand-from-stack-immediate, but we can save some +;; crucial cycles by doing the loads here inline +(define-instruction |DoMax| :operand-from-stack + (:provide-immediate t :signed-immediate t :needs-tos t) + (simple-binary-minmax max)) + +;; Same deal as |DoMax|... +(define-instruction |DoMin| :operand-from-stack + (:provide-immediate t :signed-immediate t :needs-tos t) + (simple-binary-minmax min)) + + +(define-instruction |DoMultiplyDouble| :operand-from-stack-signed-immediate () + (srdi t2 arg1 32 "ARG2 tag") + ;; We don't use STACK-READ2, because it clears the sign extension + (LWA t3 4 (iSP) "ARG1 data, sign extended") + (exts t4 arg1 32 "t4=signextend(arg1)") + (LWA t1 0 (iSP) "ARG1 tag") + (TagType t1 t1 "Strip CDR code if any.") + (ADDI t1 t1 #.(- |type$K-fixnum|)) + (TagType t2 t2 "Strip CDR code if any.") + (MULLD t5 t3 t4 "Perform the 64-bit multiply.") + (ADDI t2 t2 #.(- |type$K-fixnum|)) + (branch-if-nonzero t1 muldexc) + (branch-if-nonzero t2 muldexc) + (clrldi t6 t5 32 "Get the low 32 bit half.") + (srdi t5 t5 32 "Get the high 32 bit half.") ; +++ + (STW t6 4 (iSP) "Put the result back on the stack") + (stack-push-ir |TypeFixnum| t5 t1 "Push high order half") + (ContinueToNextInstruction) + (label muldexc) + (illegal-operand two-operand-fixnum-type-error)) + +(comment "Fin.") diff --git a/g5-emulator/ifunmove.ppcs b/g5-emulator/ifunmove.ppcs new file mode 100644 index 0000000..408fabc --- /dev/null +++ b/g5-emulator/ifunmove.ppcs @@ -0,0 +1,115 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Data movement.") + +;; |DoPush|, |DoPop|, and |DoMovem| are in IFUNCOM1.PPCS + + +(define-instruction |DoPushNNils| :operand-from-stack-immediate (:own-immediate t) + (clrldi arg2 arg1 32 "Get the data") + (srdi t1 arg1 32 "and the tag") + (CheckDataType t1 |TypeFixnum| pushnnbadop t5) + (immediate-handler |DoPushNNils|) + (stack-cache-overflow-check t1 t2 t3 t4 t5 iSP arg2) + (Get-NIL arg6) + (B pushnnilsl2) + (label pushnnilsl1) + (stack-push-with-cdr arg6 "Push NIL") + (ADDI arg2 arg2 -1) + (unlikely-label pushnnilsl2) + (branch-if-greater-than-zero arg2 pushnnilsl1) + (ContinueToNextInstruction) + (label pushnnbadop) + (illegal-operand one-operand-fixnum-type-error)) ;+++ hmm + + +;; |DoPushAddress| is in IFUNCOM1.PPCS + + +;; |DoSetSpToAddress| and |DoSetSpToAddressSaveTos| are in IFUNCOM1.PPCS + + +(define-instruction |DoPushAddressSpRelative| :operand-from-stack-immediate () + (LD t4 PROCESSORSTATE_RESTARTSP (ivory) "SP before any popping") + (srdi t1 arg1 32) + (clrldi arg1 arg1 32) + (LD t6 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LD t7 PROCESSORSTATE_STACKCACHEDATA (ivory) "THe stack cache data block") + (type-dispatch t1 t2 t3 + (|TypeFixnum| + (sldi arg1 arg1 3) + (ADDI arg1 arg1 8) + (SUBF t5 arg1 t4 "Compute stack relative pointer") + ;; +++ SCAtoVMA ? + (SUBF t5 t7 t5 "Index into stack data") + (srdi t5 t5 3 "Convert to word index") + (ADD t5 t6 t5 "Convert to an ivory word address") + (GetNextPCandCP) + (stack-push-ir |TypeLocative| t5 t6) + (ContinueToNextInstruction-NoStall)) + (:else + (illegal-operand one-operand-fixnum-type-error)))) + +;;+++ Should signal STACK-BLT-TYPE-ERROR if arguments are not locatives +(define-instruction |DoStackBlt| :operand-from-stack-immediate () + (stack-pop2 t2 t3 "Destination locative") + (clrldi t1 arg1 32) + (VMAtoSCA t1 arg1 t4) + (LD t4 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LD t5 PROCESSORSTATE_STACKCACHETOPVMA (ivory) "End ofthe stack cache") + (LD t1 PROCESSORSTATE_STACKCACHEDATA (ivory) "THe stack cache data block") + (SUBF t6 t4 t3 "BAse of Stack Cache.") + (SUBF t7 t5 t3 "Top of Stack Cache.") + (branch-if-less-than-zero t6 stkbltexc "J. if vma below stack cache") + (branch-if-greater-than-or-equal-to-zero t7 stkbltexc "J. if vma above stack cache") + (sldi t6 t6 3) + (ADD t6 t1 t6 "Compute the stackcache address") + (B stkbltloopend) + (label stkbltloop) + (ADDI arg1 arg1 8 "Advance Source") + (ADDI t6 t6 8 "Advance destination") + (unlikely-label stkbltloopend) + (stack-read arg1 t1 "Read a word from the source") + (SUBF t4 iSP arg1) + (stack-write t6 t1 "copy the word") + (branch-if-nonzero t4 stkbltloop "J. if sourse not stack top") + (mov iSP t6 "Update the SP to point at the last written location") + (ContinueToNextInstruction) + (label stkbltexc) + (illegal-operand stack-blt-type-error)) + +;;; arg1 = ARG2 = FROM address +;;; tos = ARG1 = TO +(define-instruction |DoStackBltAddress| :operand-from-stack () + (stack-pop2 t2 t3 "Destination locative") + (LD t4 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LD t5 PROCESSORSTATE_STACKCACHETOPVMA (ivory) "End ofthe stack cache") + (LD t1 PROCESSORSTATE_STACKCACHEDATA (ivory) "THe stack cache data block") + (SUBF t6 t4 t3 "Base of Stack Cache.") + (SUBF t7 t5 t3 "Top of Stack Cache.") + (branch-if-less-than-zero t6 stkbltadrexc "J. if vma below stack cache") + (branch-if-greater-than-or-equal-to-zero t7 stkbltadrexc "J. if vma above stack cache") + (sldi t6 t6 3) + (ADD t6 t1 t6 "Compute the stackcache address") + (B stkbltaddloopend) + (label stkbltaddloop) + (ADDI arg1 arg1 8 "Advance Source") + (ADDI t6 t6 8 "Advance destination") + (unlikely-label stkbltaddloopend) + (stack-read arg1 t1 "Read a word from the source") + (SUBF t4 iSP arg1) + (stack-write t6 t1 "copy the word") + (branch-if-nonzero t4 stkbltaddloop "J. if sourse not stack top") + (mov iSP t6 "Update the SP to point at the last written location") + (ContinueToNextInstruction) + (label stkbltadrexc) + (illegal-operand stack-blt-type-error)) + + +(comment "Fin.") + + diff --git a/g5-emulator/ifunpred.ppcs b/g5-emulator/ifunpred.ppcs new file mode 100644 index 0000000..64d210a --- /dev/null +++ b/g5-emulator/ifunpred.ppcs @@ -0,0 +1,115 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Predicates.") + + +;; |DoEq| and |DoEqNoPop| are in IFUNCOM2.PPCS + + +;; DoEqNoPop is handled here, too... +(define-instruction |DoEql| :operand-from-stack-immediate (:own-immediate t) + (srdi arg6 arg3 #.(+ 10 2)) + ;; #xF800 is the magic mask for EQ-NOT-EQL + (stack-top t3 "Load arg1 into t3") + (load-constant t4 #xF800 "EQ-NOT-EQL mask") + (Get-NIL t11) + (Get-T t12 "Assume result will be T") + (XOR t5 arg1 t3) + (sldi t5 t5 #.(- 32 6) "Shift left to lose CDRCODE.") + (ANDI-DOT arg6 arg6 1 "1 if no-pop, 0 if pop") + (branch-if-zero t5 eqldone) + (comment "They are not EQ, if types different or not numeric return nil") + (srdi t5 t5 #.(+ 32 (- 32 6)) "Get the tag alone") + (mov t12 t11 "Now assume result will be NIL") + (branch-if-nonzero t5 eqldone "Return NIL if tags different") + (srdi t3 t3 32 "Get tag, check for numeric") + (TagType t3 t3) + (SRD t4 t4 t3 "Type is now a bit mask") + (ANDI-DOT R31 t4 1 "BLBS") + (BC 4 2 eqlexc "If funny numeric type, exception") + (label eqldone) + (sldi t4 arg6 3) + (ADD iSP t4 iSP "Either a stack-push or a stack-write") + (GetNextPCandCP) + (stack-write iSP t12) + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoEql|) + (exts arg2 arg2 8 "Sign extend arg2") + (stack-read2-disp-signed iSP 0 t4 t3 "t4=tag t3=data") + (srdi arg6 arg3 #.(+ 10 2)) + (clrldi t3 t3 32) + (Get-NIL t11) + (TagType t4 t4) + (Get-T t12) + (SUBF arg2 arg2 t3) + (XORI t4 t4 |TypeFixnum|) + (ANDI-DOT arg6 arg6 1 "1 if no-pop, 0 if pop") + (OR t4 arg2 t4) + (sldi t5 arg6 3) + (ADD iSP t5 iSP "Either a stack-push or a stack-write") + (GetNextPCandCP) + (CMPI 0 1 t4 0) + (BC 4 2 skip11 "B.NE") + (mov t11 t12) + (unlikely-label skip11) + (stack-write iSP t11 "Yes Virginia, this does dual issue with above") + (ContinueToNextInstruction-NoStall) + (label eqlexc) + (prepare-exception eql 0 arg1) + (arithmetic-exception)) + + +;; |DoEndp| is in IFUNCOM2.PPCS + + +;; |DoEqualNumber| and |DoEqualNumberNoPop| are in IFUNCOM2.PPCS + +;; |DoLessp| and |DoLesspNoPop| are in IFUNCOM2.PPCS + +;; Handles DoGreaterpNoPop as well +(define-instruction |DoGreaterp| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + greaterp SUBF 4 1 t 2 12 t |GreaterpMMExc| t) ;FCMP yields CR.GT + (immediate-handler |DoGreaterp|) + (simple-binary-immediate-arithmetic-predicate + greaterp SUBF 4 1 t)) + +;; Handles DoLogtestNoPop as well +(define-instruction |DoLogtest| :operand-from-stack (:own-immediate t :needs-tos t) + (simple-binary-arithmetic-predicate + logtest AND 12 2 nil nil nil) + (immediate-handler |DoLogtest|) + (simple-binary-immediate-arithmetic-predicate + logtest AND 12 2 t)) + + +;;; Here are exception handlers for predicates. We have moved them out of +;;; line because they are rarely used, and we get better code packing by +;;; taking these cases out of line. Since they either trap, or avoid what +;;; would otherwise have been a trap, the cost of jumping out of line is +;;; negligible, while the benefits of code packing help the normal cases. + +;; --- These should all be a single routine now --- + +;; Exception case for EqualNumber and EqualNumberNoPop +(simple-binary-arithmetic-exceptions equal-number |EqualNumberMMExc| :else1 t) +;; Exception case for Lessp and LesspNoPop +(simple-binary-arithmetic-exceptions lessp |LesspMMExc| :else1 t) +;; Exception case for Greaterp and Greaterp +(simple-binary-arithmetic-exceptions greaterp |GreaterpMMExc| :else1 t) + + +;; |DoZerop| is in IFUNCOM1.PPCS + +;; |DoMinusp| and |DoPlusp| are in IFUNCOM2.PPCS + +;; |DoTypeMember| is in IFUNCOM1.PPCS + + + +(comment "Fin.") + diff --git a/g5-emulator/ifunsubp.ppcs b/g5-emulator/ifunsubp.ppcs new file mode 100644 index 0000000..b7fbfc3 --- /dev/null +++ b/g5-emulator/ifunsubp.ppcs @@ -0,0 +1,835 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +;(include-header "ifunhead.s") + +(comment "Subprimitives.") + +(define-instruction |DoEphemeralp| :operand-from-stack-signed-immediate () + (LD t1 PROCESSORSTATE_PTRTYPE (ivory) "ptr type array") + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (TagType arg2 arg2) + (sldi t2 arg2 2 "t2:=4*arg2") + (ADD t2 t2 t1) + (srdi arg1 arg1 27) + (LWA t3 0 (t2) "=0 if not a pointer") + (GetNextPCandCP) + (branch-if-nonzero arg1 nonephem "J. if zone not ephemeral") + (branch-if-zero t3 nonephem "J. if not a pointer") + (stack-push-t t6 t7) + (ContinueToNextInstruction-NoStall) + (label nonephem) + (stack-push-nil t6 t7) + (ContinueToNextInstruction-NoStall)) + +(align4kskip4k) + +;; Handles DoUnsignedLesspNoPop as well... +(define-instruction |DoUnsignedLessp| :operand-from-stack-immediate (:own-immediate t) + (LWA t2 4 (iSP) "Get data from arg1") + (srdi arg3 arg3 #.(+ 10 2)) + (Get-NIL t11) + (clrldi t4 arg1 32 "Get unsigned data from arg2") + (Get-T t12) + (ANDI-DOT arg3 arg3 1 "1 if no-pop, 0 if pop") + (clrldi t2 t2 32 "Unsigned arg1") + (sldi t6 arg3 3) + (ADD iSP t6 iSP "Either a stack-push or a stack-write") + (SUBF t6 t2 t4 "t6:=arg2-arg1 unsigned") + (CMPI 0 1 t6 0) + (BC 4 1 skip19 "B.LE") + (mov t11 t12) + (unlikely-label skip19) + (GetNextPCandCP) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoUnsignedLessp|) + (LWA t2 4 (iSP) "Get data from arg1") + (srdi arg3 arg3 #.(+ 10 2)) + (Get-NIL t11) + (clrldi t2 t2 32 "...") + (Get-T t12) + (ANDI-DOT arg3 arg3 1 "1 if no-pop, 0 if pop") + (SUBF t6 t2 arg2 "t6:=arg2-arg1 unsigned") + (sldi t2 arg3 3) + (ADD iSP t2 iSP "Either a stack-push or a stack-write") + (CMPI 0 1 t6 0) + (BC 4 1 skip20 "B.LE") + (mov t11 t12) + (unlikely-label skip20) + (GetNextPCandCP) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + + +(define-instruction |DoAllocateListBlock| :operand-from-stack-immediate () + (i%allocate-block t t)) + +(define-instruction |DoAllocateStructureBlock| :operand-from-stack-immediate () + (i%allocate-block nil t)) + + +;; |DoPointerPlus| is in IFUNCOM1.PPCS + +(define-instruction |DoPointerDifference| :operand-from-stack-immediate (:own-immediate t) + (LWA t1 4 (iSP) "Get the data of ARG1") + (exts t2 arg1 32 "Get the data of ARG2") + ;(clrldi t1 t1 0 32) + (SUBF t3 t2 t1 "(%32-bit-difference (data arg1) (data arg2))") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4 "Save result and coerce to a FIXNUM") + (ContinueToNextInstruction-NoStall) + (immediate-handler |DoPointerDifference|) + (exts t2 arg2 8) + (LWA t1 4 (iSP) "Get the data of arg1") + ;(clrldi t1 t1 32) + (SUBF t3 t2 t1 "(%32-bit-difference (data arg1) (data arg2))") + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| t3 t4 "Save result and coerce to a FIXNUM") + (ContinueToNextInstruction-NoStall)) + +(define-instruction |DoPointerIncrement| :operand-from-stack () + (LWA t2 4 (arg1) "Get the data of arg2") + (exts t3 t2 32) + (ADDI t3 t3 1 "(%32-bit-plus (data arg1) 1)") ;t3=signextend(t2)+1 + (GetNextPCandCP) + (STW t3 4 (arg1) "Put result back") + (ContinueToNextInstruction-NoStall)) + + +;; |DoMemoryRead| and |DoMemoryReadAddress| are in IFUNCOM1.PPCS + + +;; |DoTag| is in IFUNCOM2.PPCS + +;; |DoSetTag| is in IFUNCOM1.PPCS + + +(define-instruction |DoStoreConditional| :operand-from-stack-signed-immediate () + (srdi arg2 arg1 32) + (stack-pop2 arg3 arg4 "old tag and data") + (clrldi arg1 arg1 32) + (stack-pop2 arg5 arg6 "address tag and data") + (TagType arg5 t1) + (CheckDataType t1 |TypeLocative| storecondiop t2) + (store-conditional-internal arg6 arg3 arg4 arg2 arg1 storecondnil t1 t2 t3 t4 t5 t6) + (GetNextPCandCP) + (stack-push-t t6 t7) + (ContinueToNextInstruction-NoStall) + (label storecondnil) + (GetNextPCandCP) + (stack-push-nil t6 t7) + (ContinueToNextInstruction-NoStall) + (label storecondiop) + (illegal-operand (operand-1-type-error (dtp-locative)))) + +(define-instruction |DoMemoryWrite| :operand-from-stack-signed-immediate () + (stack-pop2 arg3 arg4) ;+++ actually only need the vma + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + ;; Perform a RAW write + (memory-write arg4 arg2 arg1 PROCESSORSTATE_RAW t1 t2 t3 t4 t5 + NextInstruction) + (ContinueToNextInstruction)) + +(define-instruction |DoPStoreContents| :operand-from-stack-signed-immediate () + (stack-pop2 arg3 arg4 "address tag and data") + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (store-contents arg4 arg2 arg1 PROCESSORSTATE_RAW t4 t5 t6 t7 t8 t9 + NextInstruction) + (ContinueToNextInstruction)) + + +(define-instruction |DoSetCdrCode1| :operand-from-stack () + (i%set-cdr-code-n arg1 1 t1)) + +(define-instruction |DoSetCdrCode2| :operand-from-stack () + (i%set-cdr-code-n arg1 2 t1)) + +;; |DoMergeCdrNoPop| is in IFUNCOM2.PPCS + +(define-instruction |DoJump| :operand-from-stack () + (stack-read2 arg1 t3 t4 "Read address and even/odd PC tag.") + (CheckAdjacentDataTypes t3 |TypeEvenPC| 2 jexc t5) + (sldi t4 t4 1) + (ANDI-DOT iPC t3 1) + (ADD iPC iPC t4) + (ANDI-DOT t5 t3 #x80) + (long-branch-if-zero t5 InterpretInstructionForJump) + (comment "Bit 39=1 indicates we need to update control reg") + (ANDI-DOT t6 t3 #x40 "Get the cleanup bit") + (LD t5 PROCESSORSTATE_CONTROL (ivory) "Processor control register.") + (sldi t6 t6 #.(- 23 6) "shift into cleanup-in-progress place") + (load-constant t7 #.1_23 "cr.cleanup-in-progress") + (ANDC t5 t5 t7 "Mask") + (OR t5 t5 t6 "Set") + (STD t5 PROCESSORSTATE_CONTROL (ivory)) + (B InterpretInstructionForJump) + (label jexc) + (prepare-exception %jump 0) + (instruction-exception)) + +;;+++ Do we need to check for trap? +(define-instruction |DoCheckPreemptRequest| :10-bit-immediate () + (check-preempt-request NextInstruction t1 t2 t) + (ContinueToNextInstruction)) + + +(define-instruction |DoHalt| :10-bit-immediate () + (get-control-register t1) + (srdi t1 t1 30 "Isolate current trap mode (FEP mode = -1)") + (addwi t1 t1 1 "t1 is zero iff we're in trap mode FEP") ;t1=signextend(t1)+1 + (branch-if-nonzero t1 haltexc) + (halt-machine) + (label haltexc) + (prepare-exception %halt 0) + (instruction-exception)) + + +(define-instruction |DoNoOp| :10-bit-immediate () + (ContinueToNextInstruction)) + + +;;; This implementation is based on the PTW 'C' implementation. +(define-instruction |DoAlu| :operand-from-stack-signed-immediate () + (srdi arg2 arg1 32 "Get tag of ARG2") + (clrldi arg1 arg1 32 "Get data of ARG2") + (stack-read2 iSP arg3 arg4 "Get ARG1") + (CheckDataType arg2 |TypeFixnum| aluexc t1) + (CheckDataType arg3 |TypeFixnum| aluexc t1) + (LD arg5 PROCESSORSTATE_ALUOP (ivory)) + (stzd PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LD arg6 PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (basic-dispatch arg5 t1 + (|ALUFunctionBoolean| + (alu-function-boolean arg6 t10 arg4 arg1 t1) + (STW t10 4 (iSP)) + (ContinueToNextInstruction)) + (|ALUFunctionByte| + (alu-function-byte arg6 arg4 arg1 t10 t1 t2 t3 t4 t5) + (STW t10 4 (iSP)) + (ContinueToNextInstruction)) + (|ALUFunctionAdder| + (alu-function-adder arg6 arg4 arg1 t10 t1 t2 t3 t4) + (STW t10 4 (iSP)) + (ContinueToNextInstruction)) + (|ALUFunctionMultiplyDivide| + (alu-function-multiply-divide arg6 arg4 arg1 t10 t1 t2) + (STW t10 4 (iSP)) + (ContinueToNextInstruction))) + (label aluexc) + (illegal-operand two-operand-fixnum-type-error)) + +;;; This says unimplemented, but that is the correct implementation of it! +(define-instruction |DoSpareOp| :10-bit-immediate () + (LD t1 CACHELINE_INSTRUCTION (iCP) "Get the instruction") + (srdi t1 t1 10 "Position the opcode") + (ANDI-DOT t1 t1 #xFF "Extract it") + ;; PREPARE-EXCEPTION can't be used as the opcode is variable, + ;; so we expand it by hand. + (clr arg1 "arg1 = instruction arity") + (mov arg2 t1 "arg2 = instruction opcode") + (li arg3 1 "arg3 = stackp") + (clr arg4 "arg4 = arithmeticp") + (clr arg5 "when not stackp arg5=the arg") + (clr arg6 "arg6=tag to dispatch on") + (instruction-exception "Unimplemented") + (ContinueToNextInstruction)) + + + +(comment "Reading and writing internal registers") + +;; |DoReadInternalRegister| is in IFUNCOM1.PPCS + +(define-procedure |ReadRegisterFP| () + (SCAtoVMA iFP t4 t5) + (stack-push-ir |TypeLocative| t4 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterLP| () + (SCAtoVMA iLP t4 t5) + (stack-push-ir |TypeLocative| t4 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterSP| () + (SCAtoVMA iSP t4 t5) + (stack-push-ir |TypeLocative| t4 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackCacheLowerBound| () + (LD t3 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (stack-push-ir |TypeLocative| t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterBARx| () + (srdi t2 arg1 7 "BAR number into T2") + (GetNextPC) + (ADDI t1 ivory PROCESSORSTATE_BAR0) + (GetNextCP) + (sldi t3 t2 3) + (ADD t1 t3 t1 "Now T1 points to the BAR") + (LD t3 0 (t1)) + (stack-push-ir |TypeLocative| t3 t4) + (ContinueToNextInstruction-NoStall)) + +(define-procedure |ReadRegisterContinuation| () + (LD t3 PROCESSORSTATE_CONTINUATION (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterAluAndRotateControl| () + (LD t3 PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterControlRegister| () + (get-control-register t3) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterCRArgumentSize| () + (get-control-register t3) + (ANDI-DOT t3 t3 #xFF "Get the argument size field") + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterEphemeralOldspaceRegister| () + (LWA t3 PROCESSORSTATE_EPHEMERALOLDSPACE (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterZoneOldspaceRegister| () + (LWA t3 PROCESSORSTATE_ZONEOLDSPACE (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterChipRevision| () + (li t3 5) ;+++ magic number + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterFPCoprocessorPresent| () + (clr R31) + (stack-push-fixnum R31 t4) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPreemptRegister| () + (LWA t3 PROCESSORSTATE_INTERRUPTREG (ivory)) + (ANDI-DOT t3 t3 3) ;+++ 3 is a bit magic! + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterIcacheControl| () + (clr R31) + (stack-push-fixnum R31 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPrefetcherControl| () + (clr R31) + (stack-push-fixnum R31 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterMapCacheControl| () + (clr R31) + (stack-push-fixnum R31 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterMemoryControl| () + (clr R31) + (stack-push-fixnum R31 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackCacheOverflowLimit| () + (LWA t3 PROCESSORSTATE_SCOVLIMIT (ivory)) + (LD t4 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (ADD t3 t3 t4) + (stack-push-ir |TypeLocative| t3 t4) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterMicrosecondClock| () + (clr R31) + (stack-push-ir |TypeFixnum| R31 t1) + (ContinueToNextInstruction)) ;+++ an approximation for now! + +(define-procedure |ReadRegisterTOS| () + (stack-top t1) + (stack-push t1 t2 "Push CDR-NEXT TOS") + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterEventCount| () + (LD t3 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (stack-push-fixnum t3 t4) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterBindingStackPointer| () + (LD t3 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterCatchBlockList| () + (LD t3 PROCESSORSTATE_CATCHBLOCK (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterControlStackLimit| () + (LWA t3 PROCESSORSTATE_CSLIMIT (ivory)) + (stack-push-ir |TypeLocative| t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterControlStackExtraLimit| () + (LWA t3 PROCESSORSTATE_CSEXTRALIMIT (ivory)) + (stack-push-ir |TypeLocative| t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterBindingStackLimit| () + (LD t3 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPHTBase| () + (clr R31) + (stack-push-ir |TypeLocative| R31 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterPHTMask| () + (clr R31) + (stack-push-fixnum R31 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterCountMapReloads| () + (clr R31) + (stack-push-fixnum R31 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterListCacheArea| () + (LD t3 PROCESSORSTATE_LCAREA (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterListCacheAddress| () + (LD t3 PROCESSORSTATE_LCADDRESS (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterListCacheLength| () + (LWA t3 PROCESSORSTATE_LCLENGTH (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureCacheArea| () + (LD t3 PROCESSORSTATE_SCAREA (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureCacheAddress| () + (LD t3 PROCESSORSTATE_SCADDRESS (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureCacheLength| () + (LWA t3 PROCESSORSTATE_SCLENGTH (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterDynamicBindingCacheBase| () + (LD t3 PROCESSORSTATE_DBCBASE (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterDynamicBindingCacheMask| () + (LD t3 PROCESSORSTATE_DBCMASK (ivory)) + (stack-push t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterChoicePointer| () + (LWA t3 PROCESSORSTATE_CHOICEPTR+4 (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStructureStackChoicePointer| () + (LWA t3 PROCESSORSTATE_SSTKCHOICEPTR+4 (ivory)) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterFEPModeTrapVectorAddress| () + (LD t3 PROCESSORSTATE_FEPMODETRAPVECADDRESS (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackFrameMaximumSize| () + (load-constant t3 #.|stack$K-maxframesize|) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterStackCacheDumpQuantum| () + (load-constant t3 #.|stack$K-cachedumpquantum|) + (stack-push-fixnum t3 t5) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterConstantNIL| () + (stack-push-T t5 t6) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterConstantT| () + (stack-push-NIL t5 t6) + (ContinueToNextInstruction)) + +(define-procedure |ReadRegisterError| () + (illegal-operand unknown-internal-register)) + + +;; |DoWriteInternalRegister| is in IFUNCOM1.PPCS + +(define-procedure |WriteRegisterFP| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (VMAtoSCAmaybe arg3 t1 badregister t2 t3) + (mov iFP t1) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +(define-procedure |WriteRegisterLP| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (VMAtoSCAmaybe arg3 t1 badregister t2 t3) + (mov iLP t1) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +(define-procedure |WriteRegisterSP| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (VMAtoSCAmaybe arg3 t1 badregister t2 t3) + (mov iSP t1) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +(passthru "#ifdef IVERIFY") +(define-procedure BadRegister () + (illegal-operand unknown-internal-register)) +(passthru "#endif") + +(define-procedure |WriteRegisterStackCacheLowerBound| () + ;; Use the StackSwitch coprocessor register, instead. + (passthru "#ifdef IVERIFY") + (STD arg3 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (LD t1 PROCESSORSTATE_STACKCACHESIZE (ivory)) + (ADD t1 arg3 t1) + (STD t1 PROCESSORSTATE_STACKCACHETOPVMA (ivory)) + (ContinueToNextInstruction) + (passthru "#else") + (illegal-operand unknown-internal-register) + (passthru "#endif")) + +;; |WriteRegisterBARx| is in IFUNCOM1.PPCS + +(define-procedure |WriteRegisterContinuation| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_CONTINUATION (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterAluAndRotateControl| () + (read-alu-function-class-bits arg3 t1) + (STD arg3 PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (read-alu-byte-size arg3 t2) + (STD t1 PROCESSORSTATE_ALUOP (ivory)) + (read-alu-byte-rotate arg3 t3) + (STD t2 PROCESSORSTATE_BYTESIZE (ivory)) + (STD t3 PROCESSORSTATE_BYTEROTATE (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterControlRegister| () + (STW arg3 PROCESSORSTATE_CONTROL+4 (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterEphemeralOldspaceRegister| () + ;; Invalidate all automatic array registers upon flip. + (clr t1) + (STD t1 PROCESSORSTATE_AC0ARRAY (ivory)) + (STD t1 PROCESSORSTATE_AC1ARRAY (ivory)) + (STD t1 PROCESSORSTATE_AC2ARRAY (ivory)) + (STD t1 PROCESSORSTATE_AC3ARRAY (ivory)) + (STD t1 PROCESSORSTATE_AC4ARRAY (ivory)) + (STD t1 PROCESSORSTATE_AC5ARRAY (ivory)) + (STD t1 PROCESSORSTATE_AC6ARRAY (ivory)) + (STD t1 PROCESSORSTATE_AC7ARRAY (ivory)) + (STW arg3 PROCESSORSTATE_EPHEMERALOLDSPACE (ivory)) + #+obsolete (refill-oldspace-table) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterZoneOldspaceRegister| () + (STW arg3 PROCESSORSTATE_ZONEOLDSPACE (ivory)) + ;;+++ Minima writes both registers simultaneously -- This is written first. + #+ignore (refill-oldspace-table) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterFPCoprocessorPresent| () ;+++ + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterPreemptRegister| () + (LWA t3 PROCESSORSTATE_INTERRUPTREG (ivory)) + (clrrdi t3 t3 2) + (ANDI-DOT arg3 arg3 3) + (OR t3 t3 arg3) + (STW t3 PROCESSORSTATE_INTERRUPTREG (ivory)) + ;; Only set flag if preempt-pending is set + (ANDI-DOT R31 t3 1) + (bclong 12 2 NextInstruction) + (STD t3 PROCESSORSTATE_STOP_INTERPRETER (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStackCacheOverflowLimit| () + (LD t1 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (clrldi t1 t1 32) + (SUBF t1 t1 arg3) + (STW t1 PROCESSORSTATE_SCOVLIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterTOS| () + ;;+++ What's the right thing to do here? + #+ignore (stack-write2 iSP arg2 arg3) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterEventCount| () + (STD arg3 PROCESSORSTATE_AREVENTCOUNT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterBindingStackPointer| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterCatchBlockList| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_CATCHBLOCK (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterControlStackLimit| () + (STW arg3 PROCESSORSTATE_CSLIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterControlStackExtraLimit| () + (STW arg3 PROCESSORSTATE_CSEXTRALIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterBindingStackLimit| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_BINDINGSTACKLIMIT (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterListCacheArea| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_LCAREA (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterListCacheAddress| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_LCADDRESS (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterListCacheLength| () + (STW arg3 PROCESSORSTATE_LCLENGTH (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureCacheArea| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_SCAREA (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureCacheAddress| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_SCADDRESS (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureCacheLength| () + (STW arg3 PROCESSORSTATE_SCLENGTH (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterDynamicBindingCacheBase| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_DBCBASE (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterDynamicBindingCacheMask| () + (combine-tag-data-word arg2 arg3 arg4) + (STD arg4 PROCESSORSTATE_DBCMASK (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterChoicePointer| () + (STW arg3 PROCESSORSTATE_CHOICEPTR+4 (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterStructureStackChoicePointer| () + (STW arg3 PROCESSORSTATE_SSTKCHOICEPTR+4 (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterFEPModeTrapVectorAddress| () + (STW arg3 PROCESSORSTATE_FEPMODETRAPVECADDRESS+4 (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterMappingTableCache| () + ;;+++ Ignore for now, but this would sure be nice + #+ignore (STD arg3 PROCESSORSTATE_MAPPINGTABLECACHE (ivory)) + (ContinueToNextInstruction)) + +(define-procedure |WriteRegisterError| () + (illegal-operand unknown-internal-register)) + + +(comment "Coprocessor read and write are implemented in C in order to") +(comment "encourage creativity! The hooks are in aicoproc.c") + +(define-instruction |DoCoprocessorRead| :10-bit-immediate () + (CMPI 0 0 arg1 |CoprocessorRegisterMicrosecondClock|) + (BC 4 2 cpreadnormal "Jump if not reading microsecond clock") + (LD t1 PROCESSORSTATE_PREVIOUSTB (Ivory)) + (MFTB t2 268 "Get current timebase") + (LD t3 PROCESSORSTATE_TICKSPERMS (Ivory)) + (SUBF-DOT t4 t1 t2 "Timebase ticks since last clock read") + (BC 12 0 cpclockwrapped "Jump if timebase wrapped around") + (label cpclocknormalized) + (LD t5 PROCESSORSTATE_MSCLOCKCACHE (Ivory)) + (DIVD t4 t4 t3 "Convert to microseconds since last read") + (STD t2 PROCESSORSTATE_PREVIOUSTB (Ivory)) + (ADD t5 t5 t4 "Compute new clock setting") + (STD t5 PROCESSORSTATE_MSCLOCKCACHE (Ivory)) + (stack-push-fixnum t5 t6 "Push the reading") + (ContinueToNextInstruction) + (label cpclockwrapped) + (li t6 -1) + (srdi t6 t6 1 "t6 = 64-bit most-positive-fixnum") + (ADD t4 t4 t6 "Normalize the timebase difference") + (ADDI t4 t4 1) + (B cpclocknormalized) + (label cpreadnormal) + (LD t1 PROCESSORSTATE_COPROCESSORREADHOOK (ivory)) + (call-c-function t1 t8) + (comment "Long -1 is never a valid LISP value") + (load-constant t1 -1) + (XOR t1 arg1 t1) + (branch-false t1 cpreadexc "J. if CoprocessorRead exception return") + (stack-push arg1 t1 "Push the result of coprocessor read!") + (ContinueToNextInstruction) + (label cpreadexc) + (illegal-operand unknown-internal-register)) + +(define-instruction |DoCoprocessorWrite| :10-bit-immediate () + (stack-pop arg2 "The value to be written") + (register-dispatch arg1 t1 t2 + (|CoprocessorRegisterUnwindStackForRestartOrApply| + (stack-top2 t2 t1 "peek at new continuation to look at tag") + (CheckAdjacentDataTypes t2 |TypeEvenPC| 2 unwindillegalcontinuation t3) + (stack-pop t1 "Get new continuation") + (set-continuation t1 "Update continuation register") + (stzd PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (stack-pop2 t2 t1 "Get new FP") + (CheckDataType t2 |TypeLocative| unwindillegalFP t3) + (VMAtoSCA t1 iFP t2) + (stack-pop2 t2 t1 "Get new LP") + (CheckDataType t2 |TypeLocative| unwindillegalLP t3) + (VMAtoSCA t1 iLP t2) + (comment "Update CDR-CODEs to make it a legitimate frame") + (stack-read-tag iFP t1 "Tag of saved continuation register") + (stack-read-tag-disp iFP 8 t2 "Tag of saved control register") + (ORI t1 t1 #xC0 "Set CDR-CODE to 3") + (stack-write-tag iFP t1 "Put it back") + (ORI t2 t2 #xC0 "Set CDR-CODE to 3") + (stack-write-tag-disp iFP 8 t2 "Put it back") + (comment "Copy the current trap-on-exit bit into the saved control register") + (get-control-register t1 "Get control register") + (stack-read-data-disp iFP 8 t2 "Get saved control register") + (load-constant t3 #.1_24 "cr.trap-on-exit-bit") + (ANDC t2 t2 t3 "Remove saved control register's trap-on-exit bit") + (AND t1 t1 t3 "Extract control register's trap-on-exit bit") + (OR t2 t2 t1 "Copy it into saved control register") + (stack-write-data-disp iFP 8 t2 "Update saved control register") + (comment "Restore the new control register with proper trap mode") + (stack-top2 t2 t1 "peek at new control register to look at tag") + (CheckDataType t2 |TypeFixnum| unwindillegalcontrol t3) + (stack-pop-data t1 "Get new control register") + (set-control-register t1)) + (|CoprocessorRegisterFlushIDCaches| + (comment "We're about to flush the instruction cache so we can't rely") + (comment "on ContinueToNextInstruction working. Instead, we must load") + (comment "the next PC now and explicitly fill the cache.") + (LD iPC CACHELINE_NEXTPCDATA (iCP)) + (LD t1 PROCESSORSTATE_FLUSHCACHES_HOOK (ivory)) + (call-c-function t1 t8) + (comment "Compute proper iCP after FlushCaches resets it.") + ;; (PC-TO-iCACHEENT iPC iCP t1 t2) done by ICacheMiss + (external-branch ICacheMiss)) + (|CoprocessorRegisterFlushCachesForVMA| + (clrldi arg2 arg2 32 "Extract the VMA") +; (li arg3 |TypeEvenPC| "Treat it as an even PC") +; (convert-continuation-to-pc arg3 arg2 t1 t2) + (sldi t1 arg2 1 "convert continuation to an even pc") + (PC-to-iCACHEENT t1 t2 t3 t4) + (LD t3 CACHELINE_PCDATA (t2)) + (XOR t3 t1 t3 "Is this VMA in the cache?") + (branch-true t3 dcwnotincache "No.") + (stzd CACHELINE_PCDATA (t2) "Yes, flush it") + (stzd CACHELINE_PCDATA+CACHELINESIZE (t2)) + (label dcwnotincache)) + (|CoprocessorRegisterFlushHiddenArrayRegisters| + (clrldi arg2 arg2 32 "Get the VMA of the new stack array") + (li t8 |AutoArrayRegMask|) + (AND t8 arg2 t8) +; (sldi t8 t8 #.|AutoArrayRegShift|) ; mask is in place, so shift is zero. + (ADDI t7 ivory PROCESSORSTATE_AC0ARRAY) + (ADD t7 t7 t8 "Here is our array register block") + (LD t8 ARRAYCACHE_ARRAY (t7) "And here is the cached array") + (XOR t8 arg2 t8 "t8==0 iff cached array is ours") + (branch-true t8 arraynotincache) + (stzd ARRAYCACHE_ARRAY (t7) "Flush it") + (label arraynotincache)) + (:else + (comment "Standard coprocessor register processing") + (LD t1 PROCESSORSTATE_COPROCESSORWRITEHOOK (ivory)) + (call-c-function t1 t8) ; RA + (branch-if-zero arg1 cpreadexc "J. if CoprocessorWrite exception return"))) + (ContinueToNextInstruction) + (label unwindillegalcontinuation) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label unwindillegalcontrol) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label unwindillegalFP) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label unwindillegalLP) + ;;wrong, but temporary for testing + (illegal-operand unknown-internal-register) + (label cpwriteexc) + (illegal-operand unknown-internal-register)) + + +;;; Microsecond clock support + +;;;---*** TODO: THIS APPEARS TO BE UNUSED! +#|| +(define-fast-subroutine |GetRPCC| (arg1 arg2) (R0) + ;;---*** TODO: WHAT"S THE REPLACEMENT? + ;(RPCC T1) + (sldi arg1 T1 0) + (ADD arg1 T1 arg1) + (srdi T1 arg1 32)) +||# + +(define-fast-external-subroutine |SpinWheels| (arg1) (R0) + (load-constant arg1 #x2000000) + (label spinwheelaxis) + (ADDI arg1 arg1 -1) + (branch-if-greater-than-zero arg1 spinwheelaxis)) + + +(comment "Fin.") diff --git a/g5-emulator/ifuntran.ppcs b/g5-emulator/ifuntran.ppcs new file mode 100644 index 0000000..f537c63 --- /dev/null +++ b/g5-emulator/ifuntran.ppcs @@ -0,0 +1,64 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(define-procedure |NativeException| () + (LD t1 PROCESSORSTATE_LINKAGE (Ivory) "Load linkage to escape block") + (LD r0 PROCESSORSTATE_RESUMEEMA (Ivory) "Re-load resumemulator") + (LD iSP PROCESSORSTATE_RESTARTSP (Ivory) "Restore SP (Just in case?)") + (stzd PROCESSORSTATE_LINKAGE (ivory)) + (BCLR 20 0 "Escape")) + +;;; In Q3, get to top of Q4. + +(align4kSkip4k) ; Q3 + +(define-procedure |PadPastAref1| () + (LD t1 PROCESSORSTATE_LINKAGE (Ivory) "Load linkage to escape block") + (LD r0 PROCESSORSTATE_RESUMEEMA (Ivory) "Re-load resumemulator") + (LD iSP PROCESSORSTATE_RESTARTSP (Ivory) "Restore SP (Just in case?)") + (stzd PROCESSORSTATE_LINKAGE (ivory)) + (LD t1 PROCESSORSTATE_LINKAGE (Ivory) "Load linkage to escape block") + (LD r0 PROCESSORSTATE_RESUMEEMA (Ivory) "Re-load resumemulator") + (LD iSP PROCESSORSTATE_RESTARTSP (Ivory) "Restore SP (Just in case?)") + (stzd PROCESSORSTATE_LINKAGE (ivory)) + (BCLR 20 0 "Escape")) + +(define-subroutine |CarSubroutine| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + ;; --- make part of define-translator-subroutine + (STD r0 PROCESSORSTATE_LINKAGE (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (li r0 4) + (STD iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (call-subroutine |CarInternal|) + ;; --- make part of define-translator-subroutine + (stzd PROCESSORSTATE_LINKAGE (ivory)) + )) + +(define-subroutine |CdrSubroutine| + (arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + ;; --- make part of define-translator-subroutine + (STD r0 PROCESSORSTATE_LINKAGE (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (li r0 4) + (STD iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (call-subroutine |CdrInternal|) + ;; --- make part of define-translator-subroutine + (stzd PROCESSORSTATE_LINKAGE (ivory)) + )) + +(define-subroutine |CarCdrSubroutine| + (t1 t2 arg5 arg6 arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (r0) + ;; --- make part of define-translator-subroutine + (STD r0 PROCESSORSTATE_LINKAGE (ivory)) + (with-multiple-memory-reads (t9 t10 t11 t12) + (li r0 4) + (STD iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (call-subroutine |CarCdrInternal|) + ;; --- make part of define-translator-subroutine + (stzd PROCESSORSTATE_LINKAGE (ivory)) + )) + +;;; Fin diff --git a/g5-emulator/ifuntrap.ppcs b/g5-emulator/ifuntrap.ppcs new file mode 100644 index 0000000..e7b0714 --- /dev/null +++ b/g5-emulator/ifuntrap.ppcs @@ -0,0 +1,208 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +;(include-header "aihead.s") +;(include-header "aistat.s") +(include-header "traps.s") +;(include-header "ifunhead.s") + + +;;; Shared Tail Calls + +(define-procedure DecodeFault () + (comment "We come here when a memory access faults to figure out why") + ;;+++ probably can elide this and just pass VMA in argX + (LD t1 PROCESSORSTATE_VMA (ivory) "retrieve the trapping VMA") + (check-access t1 t2 t3 PageNotResident PageFaultRequestHandler + PageWriteFault TransportTrap) + (external-branch BusError)) + +(define-procedure HANDLEUNWINDPROTECT () + (do-unwind-protect arg1 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 t11 t12)) + +(define-procedure PerformMemoryAction () + (comment "We get here when a memory action that will trap is detected.") + (comment "ARG1 contains the memory action code with the Transport bit removed.") + (comment "ARG2 contains the memory cycle so we can generate the proper microstate.") + (basic-dispatch arg1 t1 + (|MemoryActionTrap| + (LD t1 PROCESSORSTATE_VMA (ivory) "Get the failing VMA") + (basic-dispatch arg2 t2 + (|CycleDataRead| + (illegal-operand (memory-data-error data-read) t1)) + (|CycleDataWrite| + (illegal-operand (memory-data-error data-write) t1)) + ((|CycleBindRead| |CycleBindReadNoMonitor|) + (illegal-operand (memory-data-error bind-read) t1)) + ((|CycleBindWrite| |CycleBindWriteNoMonitor|) + (illegal-operand (memory-data-error bind-write) t1)) + ((|CycleHeader| |CycleStructureOffset|) + (illegal-operand (memory-data-error header-read) t1)) + ((|CycleScavenge| |CycleGCCopy|) + (illegal-operand (memory-data-error scavenge) t1)) + (|CycleCdr| + (illegal-operand (memory-data-error cdr-read) t1)))) + (|MemoryActionMonitor| + (external-branch MonitorTrap)))) + + +;;; Exception Handlers. + +;;; These all come from IFUNCOM1 and IFUNCOM2 +(define-procedure |OutOfLineExceptions| () + (label LdbException) + (NumericTypeException arg3 ldb) + (label RplacaException) + (ListTypeException t1 rplaca arg1) + (label RplacdException) + (ListTypeException t1 rplacd arg1) + (label PushIVException) + ;;+++ The following may still be wrong + (load-constant t1 #.|type$K-fixnum|) + (SetTag t1 arg2 t1) + (prepare-exception push-instance-variable 0 t1 t2) + (instruction-exception) + (label IncrementException) + (UnaryNumericTypeException arg2 increment arg1) + (label DecrementException) + (UnaryNumericTypeException arg2 decrement arg1)) + +;;; Common code for dispatching between exception or illegal operand. +;;; PREPARE-EXCEPTION has set up exception dispatching info, includeing +;;; TAG in arg6 +(define-procedure NumericException () + (CheckAdjacentDataTypes arg6 |TypeFixnum| 8 notnumeric t1) + (instruction-exception "Numeric") + (label notnumeric) + (illegal-operand binary-arithmetic-operand-type-error)) + +(define-procedure UnaryNumericException () + (CheckAdjacentDataTypes arg6 |TypeFixnum| 8 unarynotnumeric t1) + (instruction-exception "Numeric") + (label unarynotnumeric) + (illegal-operand unary-arithmetic-operand-type-error)) + +(define-procedure ListException () + (CheckDataType arg6 |TypeList| notlist1 t1) + (instruction-exception "List") + (label notlist1) + (CheckDataType arg6 |TypeListInstance| notlist2 t1) + (instruction-exception "List Instance") + (label notlist2) + ;; SET-TO-CAR-CDR-LIST-TYPE-ERROR is decoded exactly the same way + (illegal-operand car-cdr-list-type-error)) + +(define-procedure ArrayException () + (CheckAdjacentDataTypes arg6 |TypeArray| 2 notarray1 t1) + (instruction-exception "Array") + (label notarray1) + (CheckAdjacentDataTypes arg6 |TypeArrayInstance| 2 notarray2 t1) + (instruction-exception "Array Instance") + (label notarray2) + (external-branch SpareException)) + +(define-procedure SpareException () + (CheckAdjacentDataTypes arg6 |TypeSparePointer1| 2 notspare1 t1) + (instruction-exception "Spare Pointer") + (label notspare1) +; Spare-immediate-1 usurped for native-mode instructions +; (CheckDataType arg6 |TypeSpareImmediate1| notspare2 t1) +; (instruction-exception "Spare Immediate") + (label notspare2) + (CheckDataType arg6 |TypeSpareNumber| notspare3 t1) + (instruction-exception "Spare Number") + (label notspare3) + ;; If we get here, the prepare-trap should already have been done, + ;; all we have to do is take it! + (external-branch illegaloperand "Must be illegal op after all")) + +(define-procedure Exception () + (branch-if-nonzero arg4 ArithmeticException "J. if arithmetic exception") + (exception-handler nil t11 t12 |HandleException|)) + +(define-procedure ArithmeticException () + (exception-handler :arithmetic t11 t12 |HandleException|)) + +(define-procedure LoopException () + (exception-handler :loop t11 t12 |HandleException|)) + +(define-procedure |HandleException| (t11 arg1 t12) + (exception-handler-common-tail t11 arg1 t12)) + + +;;; Trap handlers + +(define-procedure StackOverflow () + (stack-overflow-handler)) + + +(define-fast-subroutine |StartPreTrap| () (r0) + (start-pre-trap t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + +(define-procedure |FinishPreTrap| () + ;; Exits via InterpretInstruction + (finish-pre-trap t1 t2 t3 t4 t5 t6 t7 t8 t9 t10)) + + +;; Microstate is in ARG2, VMA is in ARG5. C.f., prepare-exception which +;; puts the opcode in ARG2 and vma in arg5 (but computes them in +;; exception-handler, so they are free for us) +(define-procedure IllegalOperand () + (illegal-operand-handler)) + +(define-procedure ResetTrap () + (reset-trap-handler)) + +;; Number of args to pull is in ARG1 +(define-procedure PullApplyArgsTrap () + (pull-apply-args-trap-handler arg1 arg2)) + +(define-procedure TraceTrap () + (trace-trap-handler)) + +(define-procedure PreemptRequestTrap () + (preempt-request-trap-handler)) + +(define-procedure HighPrioritySequenceBreak () + (high-priority-sequence-break-handler)) + +(define-procedure LowPrioritySequenceBreak () + (low-priority-sequence-break-handler)) + +(define-procedure DBUnwindFrameTrap () + (db-unwind-frame-trap-handler)) + +(define-procedure DBUnwindCatchTrap () + (db-unwind-catch-trap-handler)) + + +(define-procedure TransportTrap () + (transport-trap-handler)) + +(define-procedure MonitorTrap () + (monitor-trap-handler)) + +(define-procedure PageNotResident () + (page-not-resident-handler)) + +(define-procedure PageFaultRequestHandler () + (page-fault-request-handler)) + +(define-procedure PageWriteFault () + (page-write-fault-handler)) + +(passthru "#ifdef MINIMA") +(define-procedure DBCacheMissTrap () + (db-cache-miss-trap-handler)) +(passthru "#endif") + +(comment "The following handlers should never be invoked.") + +(align4kskip4k) + +(define-procedure UncorrectableMemoryError () + (uncorrectable-memory-error-handler)) + +(define-procedure BusError () + (bus-error-handler)) + +(comment "Fin.") diff --git a/g5-emulator/ihalt.ppcs b/g5-emulator/ihalt.ppcs new file mode 100644 index 0000000..cbb64f6 --- /dev/null +++ b/g5-emulator/ihalt.ppcs @@ -0,0 +1,100 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(comment "This file implements the out-of-line parts of the instruction dispatch loop.") + +;(include "alphamac") ; load the alpha macros +;(include "intrpmac") ; load the interpreter macros. + +;(include-header "aihead.s") +;(include-header "aistat.s") + +(passthru ".globl SUSPENDMACHINE") +(passthru ".globl ILLEGALINSTRUCTION") +(passthru ".globl HALTMACHINE") + +(define-procedure |iOutOfLine| () + + ;; The following must not clobber T2, or ARG3 if it takes the + ;; branch back to CONTINUECURRENTINSTRUCTION + (label traporsuspendmachine "Here when someone wants the emulator to trap or stop.") + ;; We use a conditional store to clear the suspend/interrupt + ;; register. We don't care if our store fails, that simply means + ;; another thread ran and posted an interrupt; in which case we + ;; won't have clobbered it and will deal with it next cycle. If the + ;; clear succeeds, we also clear stop_interpreter, since we know + ;; that there are no new interrupts and we will handle the current + ;; ones in priority order. There is no sense leaving + ;; stop_interpreter set to penalize every branch or go in the + ;; interrupt handler. It also gets reset if there are other pending + ;; interrupts or preempts on the next function return (which is the + ;; soonest possible time you could deal with them anyways). + (get-control-register t4) + (STD iSP PROCESSORSTATE_RESTARTSP (ivory) "Be sure this is up-to-date") + (li t5 PROCESSORSTATE_PLEASE_STOP) + (LDARX R0 t5 ivory "Has the spy asked us to stop or trap?") + (clr t6) + (STDCX-DOT t6 t5 ivory) + (bc 4 2 collision) +; #+ignore ;;I think this is the culprit in RGETF hang -- Kalman + (stzd PROCESSORSTATE_STOP_INTERPRETER (ivory)) + (unlikely-label collision) + (rotldi R0 R0 32 "Put PLEASE_STOP in lower half, PLEASE_TRAP in upper half") + (CMPLI 0 1 R0 |HaltReasonIllInstn| "EQ if we've been asked to stop") + (BC 12 2 suspendmachine) + + (comment "Here when someone wants the emulator to trap.") + (srdi R0 R0 32 "Extract PROCESSORSTATE_PLEASE_TRAP (ivory)") + (srdi t4 t4 30 "Isolate current trap mode") + (basic-dispatch R0 t3 + (|TrapReasonHighPrioritySequenceBreak| + (CMPLI 0 1 t4 |TrapModeExtraStack| "Only interrupts EXTRA-STACK and EMULATOR") + (bclong 12 1 continuecurrentinstruction) + (external-branch highprioritysequencebreak)) + ;; --- This wouldn't work if we needed it, since high-pri can + ;; clobber low-pri; Luckily, we don't use low-pri! + (|TrapReasonLowPrioritySequenceBreak| + ;; (CMPLI 0 1 t4 |TrapModeEmulator| "Only interrupts EMULATOR") + ;; (bclong 12 1 continuecurrentinstruction) + (long-branch-if-nonzero t4 continuecurrentinstruction "Only interrupts EMULATOR") + (external-branch lowprioritysequencebreak)) + (:else + (comment "Check for preempt-request trap") + (LWA t5 PROCESSORSTATE_INTERRUPTREG (ivory) "Get the preempt-pending bit") + ;; (CMPLI 0 1 t4 |TrapModeEmulator| "Only interrupts EMULATOR") + ;; (BC 4 1 dopreemptrequest) + (long-branch-if-nonzero t4 continuecurrentinstruction "Don't take preempt trap unless in emulator mode") + (ANDI-DOT R31 t5 1 "BLBC") + (bclong 12 2 continuecurrentinstruction "Jump if preempt request not pending") + (external-branch preemptrequesttrap))) + + (label suspendmachine "Here when someone wants to stop the emulator.") + (clrldi t1 R0 32 "Get the reason") + (B stopinterp) + + (label illegalinstruction "Here if we detect an illegal instruction.") + (li t1 |HaltReasonIllInstn|) + (B stopinterp) + + (label haltmachine "Here to halt machine") + (li t1 |HaltReasonHalted|) + (B stopinterp) + + (label fatalstackoverflow "Here if we detected a fatal stack overflow") + (li t1 |HaltReasonFatalStackOverflow|) + (B stopinterp) + + (label illegaltrapvector "Here if we detected a non-PC in a trap vector") + (li t1 |HaltReasonIllegalTrapVector|) + (B stopinterp) + + (label stopinterp) + ;; cleanup and leave! here +++ save interpreter state! + (mov arg1 t1 "Return the halt reason") + (stzw PROCESSORSTATE_PLEASE_STOP (ivory) "Clear the request flag") + (decache-ivory-state) + (STD R31 PROCESSORSTATE_RUNNINGP (ivory) "Stop the (emulated) chip") + (LD SP PROCESSORSTATE_IINTERPRET_SP (ivory) "Pop back to iInterpret's stack frame") + (elf-epilogue) +) + +;;; End of ihalt diff --git a/g5-emulator/imacarra.lisp b/g5-emulator/imacarra.lisp new file mode 100644 index 0000000..c17788b --- /dev/null +++ b/g5-emulator/imacarra.lisp @@ -0,0 +1,833 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; This file contains macros supporting array instructions. +;;; These are mostly in IFUNARRA.PPCS + +(defmacro check-array-header (tag iolab temp) + (check-temporaries (tag) (temp)) + `((TagType ,tag ,temp) + (ADDI ,temp ,temp #.(- |type$K-headeri|)) + (branch-if-nonzero ,temp ,iolab))) + +(defmacro check-array-prefix (header ielab temp) + (check-temporaries (header) (temp)) + (assert (= |array$K-longprefixbitmask| 1)) + `((srdi ,temp ,header ,|ArrayLongPrefixBitPos|) + (ANDI-DOT R31 ,temp 1 "BLBS") + (BC 4 2 ,ielab))) + +(defmacro check-array-header-and-prefix (tag header iolab ielab temp1 temp2) + (check-temporaries (tag) (temp1 temp2)) + `((TagType ,tag ,temp1) + (srdi ,temp2 ,header ,|ArrayLongPrefixBitPos|) + (ADDI ,temp1 ,temp1 #.(- |type$K-headeri|)) + (branch-if-nonzero ,temp1 ,iolab) + (ANDI-DOT R31 ,temp2 1 "BLBS") + (BC 4 2 ,ielab))) + +(defmacro check-array-bounds (data bound ioplab temp) + (check-temporaries (data bound) (temp)) + `((CMPL 0 1 ,data ,bound) + (BC 4 0 ,ioplab))) + +(defmacro byte-packing-size (bp size) + (check-temporaries (bp) (size)) + `((li ,size 32) + (SRD ,size ,size ,bp "Compute size of byte"))) + +(defmacro byte-packing-mask (bp mask temp) + (check-temporaries (bp) (mask temp)) + `((byte-packing-size ,bp ,temp) + (ORC ,mask ,mask ,mask) + (SLD ,mask ,mask ,temp) + (NAND ,mask ,mask ,mask "Compute mask for byte"))) + +(defmacro byte-packing-mask-and-unmask-given-size (bp mask unmask size) + (check-temporaries (bp size) (mask unmask)) + `((ORC ,unmask ,unmask ,unmask) + (SLD ,unmask ,unmask ,size) + (NAND ,mask ,unmask ,unmask "Compute mask for byte"))) + +#|| +(defmacro byte-packing-modulus (bp x res) + (check-temporaries (bp x) (res)) + `((ORC ,res ,res ,res) + (SLD ,res ,res ,bp) + (ANDC ,res ,x ,res "Compute subword index"))) + +(defmacro byte-packing-rotation (bp index rot) + (check-temporaries (bp index) (rot)) + `((NEG ,rot ,bp) + (ADDI ,rot ,rot 5) + (SLD ,rot ,index ,rot "Compute shift to get byte"))) +||# + +(defmacro byte-packing-modulus-and-rotation (bp index modulus rotation) + (check-temporaries (bp index) (modulus rotation)) + `((ORC ,modulus ,modulus ,modulus) + (SLD ,modulus ,modulus ,bp) + (NEG ,rotation ,bp) + (ANDC ,modulus ,index ,modulus "Compute subword index") + (ADDI ,rotation ,rotation 5) + (SLD ,rotation ,modulus ,rotation "Compute shift to get byte"))) + + +(defmacro simple-case ((test-var temp temp2 &optional done-label) &body clauses) + "Only deals with singleton, constant keys. Optimizes dispatch + according to clause order." + (flet ((make-label (base) (gentemp (substitute #\_ #\- (format nil "CASE-~A-" base))))) + (let* ((clauses (copy-list clauses)) + (keys (map 'list #'(lambda (c) (eval (first c))) clauses)) + (sorted-keys (sort (copy-list keys) #'<)) + (labels (map 'list #'make-label keys)) + (others (make-label 'others)) + (done (lisp:or done-label (make-label 'done))) + ) + (if (lisp:and (<= (length clauses) 4) + (loop for (a b) on sorted-keys always (lisp:or (null b) (= (1+ a) b)))) + ;; short, contiguous case: search for a combination of bias + ;; and tests that let you dispatch without comparing + (let* ((bias ) + (tests + (loop repeat (1+ (length keys)) + as try = + (loop for (key . rest) on keys + with candidates = `( + (,#'(lambda (k) (< k 0)) + (branch-if-less-than-zero ,test-var) (branch-if-greater-than-or-equal-to-zero ,test-var)) + (,#'(lambda (k) (= k 0)) + (branch-if-zero ,test-var) (branch-if-nonzero ,test-var)) + (,#'(lambda (k) (> k 0)) + (branch-if-greater-than-zero ,test-var) (branch-if-less-than-or-equal-to-zero ,test-var)) + (,#'(lambda (k) (oddp k)) + (BLBS ,test-var) (BLBC ,test-var)) + (,#'(lambda (k) (evenp k)) + (BLBC ,test-var) (BLBS ,test-var)) + (,#'(lambda (k) + (lisp:and bias (< (- k bias) 0))) + (branch-if-less-than-zero ,temp) (branch-if-greater-than-or-equal-to-zero ,temp)) + (,#'(lambda (k) + (lisp:and bias (= (- k bias) 0))) + (branch-if-zero ,temp) (branch-if-nonzero ,temp)) + (,#'(lambda (k) + (lisp:and bias (> (- k bias) 0))) + (branch-if-greater-than-zero ,temp) (branch-if-less-than-or-equal-to-zero ,temp)) + (,#'(lambda (k) + (lisp:and bias (oddp (- k bias)))) + (BLBS ,temp) (BLBC ,temp)) + (,#'(lambda (k) + (lisp:and bias (evenp (- k bias)))) + (BLBC ,temp) (BLBS ,temp)) + ) + collect + (rest + (find-if + #'(lambda (cand) + (let ((verifier (first cand))) + (lisp:and (funcall verifier key) + (notany verifier rest)))) + candidates))) + ;; do (format t "~&Bias ~D, Try: ~S" bias try) + do (when (notany #'null try) + (return try)) + (if bias + (incf bias) + (setq bias (first sorted-keys))) + finally (error "Can't find test chain") + ))) + `((SUBF ,temp ,bias ,test-var) + (,@(second (pop tests)) ,others) + (label ,(pop labels)) + ,@(rest (pop clauses)) + (B ,done) + ,@(loop for clause in (butlast clauses) + for label in labels + collect `((label ,label) + ,@(rest clause) + (B ,done))) + (label ,others) + ,@(loop for test in (butlast tests) + for label in labels + collect `(,@(first test) ,label)) + (label ,(car (last labels))) + ,@(rest (car (last clauses))) + ,(if done-label + `(B ,done) + `(label ,done)))) + ;; Interleave compares and branches for dual-issue + `((XORI ,temp ,test-var ,(pop keys)) + (branch-true ,temp ,others) + (label ,(pop labels)) + ,@(rest (pop clauses)) + (B ,done) + ,@(loop for clause in (butlast clauses) + for label in labels + collect `((label ,label) + ,@(rest clause) + (B ,done))) + (label ,others) + (NOP) + ,@(loop for previous = nil then this + for this in (append (butlast keys) '(nil)) + for prreg = nil then thisreg + for thisreg in (circular-list temp temp2) + for prlabel in (append '(nil) labels) + collect `(,@(when this + `((XORI ,thisreg ,test-var ,(eval this)))) + ,@(when previous + `((branch-false ,prreg ,prlabel))))) + (label ,(car (last labels))) + ,@(rest (car (last clauses))) + ,(if done-label + `(B ,done) + `(label ,done))))))) + +(defmacro generate-array-element-ldb (bp element data index temp) + "Emits optimal ldb code for known BP" + (let* ( + ;; we don't care about the list bit + (index-mask (lognot (lsh -1 bp))) + (index-shift (- 5 bp)) + (element-mask (lognot (lsh -1 (lsh 32 (- bp))))) + (value element)) + ;; The stack push of the result is interleaved with the + ;; load for dual-issue and stall reduction + `((comment ,(format nil "AREF1-~AB" (lsh 1 (- 5 bp)))) + ,@(case bp + (0 ;; Hack alert! we don't need to move data at all! + (progn (setq value data) nil)) + (1 `((ANDI-DOT ,temp ,index ,index-mask) + (ADD ,temp ,temp ,temp "Bletch, it's a byte ref") + (sldi ,temp ,temp 3) + (SUBFIC ,temp ,temp 64) + (RLDCL ,value ,data ,temp 48))) + (2 `((ANDI-DOT ,temp ,index ,index-mask) + (sldi ,temp ,temp 3) + (SUBFIC ,temp ,temp 64) + (RLDCL ,value ,data ,temp 56 "Get the mode bits"))) + (t `((ANDI-DOT ,temp ,index ,index-mask "byte-index") + ,(if (plusp index-shift) + `(sldi ,temp ,temp ,index-shift "byte-position") + `(NOP)) + (SRD ,value ,data ,temp "byte in position") + (ANDI-DOT ,value ,value ,element-mask "byte masked"))))))) + +;;; extract from 'word' the 'element' given 'bp' and 'index' +(defmacro array-element-ldb (bp index word element temp temp2) + (check-temporaries (bp index word) (element temp temp2)) + `((byte-packing-modulus-and-rotation ,bp ,index ,temp ,element) + (byte-packing-mask ,bp ,temp ,temp2) + (SRD ,element ,word ,element "Shift the byte into place") + (AND ,element ,temp ,element "Mask out unwanted bits."))) + +;; (array-element-ldb t1 t2 t3 t4 t5 t6) +#|| +;; Experimental +;; 13-cycle version of same +;; Total magic: Note that the shift instructions only pay attention to +;; the low 6 bits of shift and that (ldb (byte 6 0) (- 64 x)) == (ldb +;; (byte 6 0) (- x)) +(defmacro array-element-ldb (bp index word element temp temp2) + (check-temporaries (bp index word) (element temp temp2)) + (load-constant ,temp -1) + (SLD ,temp ,temp ,bp "modulus mask") + (load-constant ,temp2 5) + (ANDC ,temp ,index ,temp "byte-index") + (SUBF ,temp2 ,bp ,temp2 "(LOG byte-size 2)") + (SLD ,temp ,temp ,temp2 "byte-position") + (load-constant ,element -32) + (SRAD ,temp2 ,element ,bp "64 - size") + (SUBF ,temp ,temp ,temp2 "64 - (size + pos)") + (SLD ,element ,word ,temp "clear high bits: element = word<<(64 - (size + pos))") + (SRD ,element ,element ,temp2 "shift into place: element >>= 64 - size")) +||# + +;;; shove 'element' into 'word' at position indicated by 'bp' and 'index' +;;; this is fairly expensive, around 27 cycles! unpacked case (bp=0) +;;; should avoid this path! +(defmacro array-element-dpb (element bp index word + temp temp2 temp3 temp4 temp5) + (check-temporaries (element bp index word) (temp temp2 temp3 temp4 temp5)) + (let ((simple (gensym)) + (done (gensym))) + `((byte-packing-modulus-and-rotation ,bp ,index ,temp ,temp2) + (byte-packing-size ,bp ,temp) ;temp is the byte size + (byte-packing-mask-and-unmask-given-size ,bp ,temp4 ,temp3 ,temp) + (branch-if-zero ,temp2 ,simple "inserting into the low byte is easy") + (comment "Inserting the byte into any byte other than the low byte") + (li ,temp5 64) + (SUBF ,temp ,temp2 ,temp5 "= the left shift rotate amount") + (SRD ,temp5 ,word ,temp2 "shift selected byte into low end of word.") + (SLD ,word ,word ,temp "rotate low bits into high end of word.") + (AND ,temp5 ,temp3 ,temp5 "Remove unwanted bits") + (SRD ,word ,word ,temp "rotate low bits back into place.") + (AND ,temp ,element ,temp4 "Strip any extra bits from element") + (OR ,temp5 ,temp ,temp5 "Insert new bits.") + (SLD ,temp5 ,temp5 ,temp2 "reposition bits") + (OR ,word ,word ,temp5 "Replace low order bits") + (B ,done) + (label ,simple) + (comment "Inserting the byte into the low byte") + (AND ,word ,word ,temp3 "Remove the old low byte") + (AND ,temp ,element ,temp4 "Remove unwanted bits from the new byte") + (OR ,word ,word ,temp "Insert the new byte in place of the old byte") + (label ,done)))) + +;; (array-element-dpb t1 t2 t3 t4 t5 t6 t7 t8 t9) + +#|| +;; Experimental +;; 16-cycle version of same +;; Total magic: Note that the shift instructions only pay attention to +;; the low 6 bits of shift and that (ldb (byte 6 0) (- 64 x)) == (ldb +;; (byte 6 0) (- x)) +(defmacro array-element-dpb (element bp index word temp temp2 temp3 temp4 temp5) + (check-temporaries (element bp index word) (temp temp2 temp3 temp4 temp5)) + `((load-constant ,temp4 -1) + (SLD ,temp ,temp4 ,bp "modulus mask") + (load-constant ,temp2 5) + (ANDC ,temp ,index ,temp "byte-index") + (SUBF ,temp2 ,bp ,temp2 "(LOG byte-size 2)") + (SLD ,temp ,temp ,temp2 "byte-position") + (load-constant ,temp5 -32) + (SRAD ,temp5 ,temp5 ,bp "64 - size") + (SLD ,temp3 ,element ,temp "temp3 = element<> ,shift + ;; Next compute the negative shift into ,result + ;; ---*** TODO: Add second temp to this macro instead? + (NEG R31 ,shift) + ,@(if (eq direction :left) + `((SRD ,result ,integer R31)) ; ,result := ,integer >> (- ,shift) + `((SLD ,result ,integer R31))) ; ,result := ,integer << (- ,shift) + (CMPI 0 1 ,shift 0) + (BC 12 0 ,sk "B. if negative shift") + (ORI ,result ,temp 0) ; Move the positive result in to ,result + (unlikely-label ,sk)))) + +(defmacro setup-array-register (name atag adata done-label + temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 + temp9 temp10 temp11 temp12 temp13 temp14 temp15 temp16) + (check-temporaries (atag adata) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 + temp11 temp12 temp13 temp14 temp15 temp16)) + (let ((iop (gensym)) + (iex (gensym)) + (iexmaybenot (gensym)) + (done (lisp:or done-label (gensym)))) + `((mov ,temp9 ,adata) + (CheckAdjacentDataTypes ,atag |TypeArray| 2 ,iex ,temp3) + (memory-read ,adata ,temp4 ,temp3 PROCESSORSTATE_HEADER ,temp5 ,temp6 ,temp7 ,temp8) + ;; Header tag in temp4, header data in temp3 + (check-array-header-and-prefix ,temp4 ,temp3 ,iop ,iexmaybenot ,temp5 ,temp6) + (stack-push2 ,atag ,temp9 ,temp5) + (srdi ,temp8 ,temp3 ,|ArrayRegisterBytePackingPos|) + (li ,temp7 |TypeFixnum|) + (LD ,temp PROCESSORSTATE_AREVENTCOUNT (ivory)) + (sldi ,temp8 ,temp8 ,|ArrayRegisterBytePackingPos|) + (ADDI ,temp5 ,adata 1) + (ADD ,temp8 ,temp8 ,temp "Construct the array register word") + (stack-push2 ,temp7 ,temp8 ,temp6) + (stack-push-ir |TypeLocative| ,temp5 ,temp8) ;pushes with CDR-NEXT + (li ,temp6 |ArrayLengthMask|) + (AND ,temp6 ,temp3 ,temp6) + (stack-push2 ,temp7 ,temp6 ,temp8) + (B ,done) + (label ,iex) + (SetTag ,atag ,temp9 ,temp6) + (ArrayTypeException ,atag ,name ,temp6 setup-array-operand-not-array) + ;; Here to trap on a bad argument. + (label ,iop) + (illegal-operand setup-array-operand-not-array) + (label ,iexmaybenot) + (call-subroutine |Setup1DLongArray|) + (XORI ,temp ,temp2 |ReturnValueNormal|) + ,@(if done-label + `((long-branch-false ,temp ,done)) + `((branch-false ,temp ,done))) + (XORI ,temp ,temp2 |ReturnValueException|) + (branch-false ,temp ,iex) + (XORI ,temp ,temp2 |ReturnValueIllegalOperand|) + (branch-false ,temp ,iop) + ;; Here when done! + ,@(unless done-label + `((label ,done)))))) + +;; FORCE1D should be non-zero if we are using SetupForce1DArray. +;; It gets clobbered on the way out with the return code. +(defmacro setup-long-array-register (atag adata temp force1d temp3 temp4 temp5 temp6 temp7 temp8 + temp9 temp10 temp11 temp12 temp13 temp14 temp15 temp16) + (check-temporaries (atag adata) (temp force1d temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 + temp11 temp12 temp13 temp14 temp15 temp16)) + (let ((temp2 force1d) + (forced (gensym)) + (iex (gensym)) + (leafarray (gensym)) + (chaseloop (gensym)) + (dodisp (gensym)) + (tailindirect (gensym)) + (zerolength (gensym)) + (arrayind (gensym)) + (doarray (gensym)) + (done (gensym)) + (end (gensym)) + (length temp15) + (offset temp16) + (indirect temp5)) + `(;; Here we would normally take an exception because we have either an indirect, + ;; displaced, or multidimensional array (long format). Except for error cases, we + ;; handle these cases locally to save the cost ofthe trap. + ;; temp9 contains the original array unforwarded -- don't clobber it! + ;; atag/adata contains the possibly forwarded array. (initially) + ;; temp4/temp3 contains the header (initially) + ;; temp7 temp8 temp10 and temp11 are temporaries used by memory-read etc. + (comment "Read data from the header: alength offset indirect lengths&mults") + (ADDI ,temp ,adata 1 "length=array+1") + (memory-read ,temp ,temp6 ,length PROCESSORSTATE_DATAREAD ,temp7 ,temp8 ,temp10 ,temp11) + (CheckDataType ,temp6 |TypeFixnum| ,iex ,temp8) + (ADDI ,temp ,temp 1 "Offset is adata+2") + (memory-read ,temp ,temp6 ,offset PROCESSORSTATE_DATAREAD ,temp7 ,temp8 ,temp10 ,temp11) + (CheckDataType ,temp6 |TypeFixnum| ,iex ,temp8) + (ADDI ,temp ,temp 1 "Indirect is adata+3") + ;; Array is atag/adata, header is temp4/temp3 offset=temp16 + (memory-read ,temp ,temp6 ,indirect PROCESSORSTATE_DATAREAD ,temp7 ,temp8 ,temp10 ,temp11) + (type-dispatch ,temp6 ,temp10 ,temp11 + (|TypeLocative| + (label ,dodisp) + ;; Here if indirected to a locative or fixnum. + ;; Construct the array register. + (stack-push2 ,atag ,temp9 ,temp10) ; push the array -- unforwarded. + (srdi ,temp8 ,temp3 ,|ArrayBytePackingPos|) ; extract the byte packing + ;;(ANDI-DOT ,temp8 ,temp8 |ArrayBytePackingMask|) + (li ,temp7 |TypeFixnum|) + (LD ,temp PROCESSORSTATE_AREVENTCOUNT (ivory)) + (sldi ,temp8 ,temp8 ,|ArrayRegisterBytePackingPos|) ; reposition the bytepacking. + (ADD ,temp8 ,temp8 ,temp "Construct the array register word") + (stack-push2 ,temp7 ,temp8 ,temp6) ; push the control word. + (stack-push-ir |TypeLocative| ,indirect ,temp8) ; pushes with CDR-NEXT + (stack-push2 ,temp7 ,length ,temp8) + (B ,done)) + + ;; Fixnum case is the same as the Locative case -- go do it. + (|TypeFixnum| + (B ,dodisp)) + + ;; Array and string case follows. If we are indirected to an array or + ;; a string, it is necessary to chase down the indirection chain + ;; until we hit an array with a simple array header, a locative, or a + ;; fixnum. As we skip down the indirection chain, we accumulate the + ;; offset taking into account possibly different byte packing. + (|TypeArray| + (label ,doarray) + (ANDI-DOT ,temp ,temp3 7) ; non forcep case tests dimensions. + (XORI ,temp ,temp 1) + (branch-true ,force1d ,forced "Force true if FORCE") + (branch-true ,temp ,iex) ; take exception if not matched. + (unlikely-label ,forced) + ;; Skip down the indirection chain until we reach the end. + ,@(let ((bpd adata) + (bp temp12) + (sk (gensym)) + (sk2 (gensym)) + (sk3 (gensym)) + (sk4 (gensym)) + (thislength temp13) + (indexoffset temp14) + (totaloffset temp2)) + `((srdi ,bp ,temp3 ,|ArrayBytePackingPos|) ; byte-packing + (ANDI-DOT ,bp ,bp |ArrayBytePackingMask|) + (mov ,totaloffset ,offset) + + (label ,chaseloop) + ;; Chase array indirections until we bottom out. + (memory-read ,indirect ,temp6 ,temp4 PROCESSORSTATE_HEADER ,temp7 ,temp8 ,temp10 ,temp11) + ;;+++ check header? + (srdi ,temp10 ,temp4 ,|ArrayBytePackingPos|) + (ANDI-DOT ,temp10 ,temp10 |ArrayBytePackingMask|) + (SUBF ,bpd ,temp10 ,bp) ; bpd=byte-packing-difference + (srdi ,temp7 ,temp4 ,|ArrayLongPrefixBitPos|) + (ANDI-DOT R31 ,temp7 1 "BLBS") + (BC 4 2 ,tailindirect) ; J. if we are still chasing indirections. + (ADDI ,indirect ,indirect 1 "increment beyond header") + (load-constant ,temp8 #.|array$K-lengthmask|) + (AND ,temp8 ,temp4 ,temp8) ; temp8=(ldb array-short-length-field hdr) + (logical-shift ,temp8 ,bpd ,temp8 ,temp10) + + ;; compute length + (ADD ,temp10 ,length ,offset) ;t10=l+o + (SUBF ,temp7 ,temp8 ,temp10) ;t2=l+o - sl + (CMPI 0 1 ,temp7 0) + (BC 12 1 ,sk "B.GT") + (mov ,temp8 ,temp10) ;if sl>l+o sl=l+o + (unlikely-label ,sk) + (mov ,length ,temp8) + (label ,leafarray) ; here when leaf array located. + (SUBF ,length ,totaloffset ,length) + (stack-push2 ,atag ,temp9 ,temp10) ; push the array -- unforwarded. + (li ,temp7 |TypeFixnum|) + (srdi ,temp8 ,temp3 ,|ArrayRegisterBytePackingPos|) + (LD ,temp PROCESSORSTATE_AREVENTCOUNT (ivory)) + (sldi ,temp8 ,temp8 ,|ArrayRegisterBytePackingPos|) ; reposition the bytepacking. + (li ,temp11 -1) + (SLD ,temp11 ,temp11 ,bp "(LSH -1 byte-packing)") + (ANDC ,temp11 ,totaloffset ,temp11) + (sldi ,temp11 ,temp11 ,|ArrayRegisterByteOffsetPos|) + (ADD ,temp8 ,temp8 ,temp "Construct the array register word") + (ADD ,temp8 ,temp11 ,temp8 "Add in the byte offset") + (stack-push2 ,temp7 ,temp8 ,temp6) ; push the control word. + (CMPI 0 1 ,length 0) + (BC 12 1 ,sk2 "B.GT") + (clr ,length) + (unlikely-label ,sk2) + (branch-if-zero ,length ,zerolength) + (logical-shift ,totaloffset ,bp ,totaloffset ,temp :direction :right) + (ADD ,indirect ,totaloffset ,indirect) ; displace the array. + (label ,zerolength) + (stack-push-ir |TypeLocative| ,indirect ,temp8) ; pushes with CDR-NEXT + (stack-push2 ,temp7 ,length ,temp8) + (B ,done) + + (label ,tailindirect) + (ADDI ,temp ,indirect 1 "length=array+1") + (memory-read ,temp ,temp4 ,thislength processorstate_dataread ,temp7 ,temp8 ,temp10 ,temp11) + (CheckDataType ,temp4 |TypeFixnum| ,iex ,temp) ; if bad length, give up. + (ADDI ,temp ,indirect 2 "offset=array+2") + (memory-read ,temp ,temp4 ,indexoffset processorstate_dataread ,temp7 ,temp8 ,temp10 ,temp11) + (CheckDataType ,temp4 |TypeFixnum| ,iex ,temp) ; if bad offset, give up. + (ADDI ,temp ,indirect 3 "next=array+3") + (memory-read ,temp ,temp4 ,indirect processorstate_dataread ,temp7 ,temp8 ,temp10 ,temp11) + (logical-shift ,thislength ,bpd ,temp10 ,temp8) + (ADD ,temp8 ,length ,offset) ; compute length + (CMPI 0 1 ,temp10 0) + (BC 12 1 ,sk3 "B.GT") + (mov ,temp10 ,temp8) ; if sl<0 sl=l+o + (unlikely-label ,sk3) + (SUBF ,temp7 ,temp8 ,temp10) ; t7=sl-l+0 + (CMPI 0 1 ,temp7 0) + (BC 12 1 ,sk4 "B.GT") + (mov ,temp8 ,temp10) ; if l+o>sl l+0=sl + (unlikely-label ,sk4) + (mov ,length ,temp8) + + (type-dispatch ,temp4 ,temp8 ,temp10 + (|TypeLocative| + (B ,leafarray)) + (|TypeFixnum| + (B ,leafarray)) + (|TypeArray| + (label ,arrayind) + ;; Here with another array indirection. + (logical-shift ,indexoffset ,bpd ,offset ,temp7) + (ADD ,totaloffset ,totaloffset ,offset) + (B ,chaseloop)) + (|TypeString| + (B ,arrayind)) + (:else (B ,iex)))))) + + ;; The string case is the same as the array case -- so go do it. + (|TypeString| + (B ,doarray)) + (:else (B ,iex))) ; take the exception on error case. + + (label ,iex) + (li ,temp2 |ReturnValueException|) + (B ,end) + (label ,done) + (li ,temp2 |ReturnValueNormal|) + (label ,end)))) + +;;; Fin. + diff --git a/g5-emulator/imacbind.lisp b/g5-emulator/imacbind.lisp new file mode 100644 index 0000000..6220e17 --- /dev/null +++ b/g5-emulator/imacbind.lisp @@ -0,0 +1,33 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; This file contains macros supporting binding instructions. +;;; These are mostly in IFUNBIND.PPCS + +;; Returns BSP as the new binding stack pointer +(defmacro unbind (bsp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (let ((unbind (gensym))) + `((LD ,bsp PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (get-control-register ,temp4) ;temp4 = CR + (clrldi ,bsp ,bsp 32 "vma only") + (load-constant ,temp2 #.1_25 "cr.cleanup-bindings") + (ADDI ,temp5 ,bsp -1) ;temp5 = BSP-1 + (AND ,temp3 ,temp4 ,temp2) ;temp3 = cleanup bit from CR + (ANDC ,temp4 ,temp4 ,temp2 "Turn off the bit") ;temp4 = new CR (cleanup bit off) + (branch-if-nonzero ,temp3 ,unbind) ;lose if the cleanup bit was not set + (LD ,temp4 PROCESSORSTATE_RESTARTSP (ivory) "Get the SP, ->op2") + (illegal-operand binding-stack-underflow) + (label ,unbind) + (memory-read ,bsp ,temp7 ,temp6 PROCESSORSTATE_BINDREAD ,temp8 ,temp9 ,temp10 ,temp11 nil t) + (memory-read ,temp5 ,temp3 ,temp2 PROCESSORSTATE_BINDREAD ,temp8 ,temp9 ,temp10 ,temp11) + (store-contents ,temp2 ,temp7 ,temp6 PROCESSORSTATE_BINDWRITE + ,temp8 ,temp9 ,temp10 ,temp11, temp12) + (ANDI-DOT ,temp3 ,temp3 #x40 "Get the old cleanup-bindings bit") + (sldi ,temp3 ,temp3 ,(- 25 6)) + (ADDI ,bsp ,bsp -2) + (STW ,bsp PROCESSORSTATE_BINDINGSTACKPOINTER+4 (ivory) "vma only") + (OR ,temp4 ,temp4 ,temp3) ;new CR with old cleanup bit + (set-control-register ,temp4)))) + +;;; Fin. diff --git a/g5-emulator/imacbits.lisp b/g5-emulator/imacbits.lisp new file mode 100644 index 0000000..c9415f4 --- /dev/null +++ b/g5-emulator/imacbits.lisp @@ -0,0 +1,46 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of logical instructions. These are mostly in IFUNBITS.PPCS + +(defmacro ilogical (name operator) + (let ((tag1notfix (gensym)) + (tag2notfix (gensym))) + `((LWA t3 0 (iSP) "Get tag from ARG1") + (LWA t4 4 (iSP) "Grab data for ARG1") + (extrdi t1 arg1 8 24 "Get tag from ARG2") ; Extract bits 24:31 and right justify + (CheckDataType t3 |TypeFixnum| ,tag1notfix t6) + (CheckDataType t1 |TypeFixnum| ,tag2notfix t6) + (comment "Here we know that both args are fixnums!") + (,operator t4 arg1 t4 "Do the operation") + (GetNextPCandCP) + ,@(when (not (eq name 'AND)) + `((clrldi t4 t4 32 "Strip high bits"))) + (stack-write-ir |TypeFixnum| t4 t1 "Push result") + (ContinueToNextInstruction-NoStall) + (label ,tag1notfix "Here if ARG1 not fixnum") + (NumericTypeException t3 ,name arg1) + (label ,tag2notfix "Here if ARG2 not fixnum") + (NumericTypeException t1 ,name arg1)))) + +(defmacro ilogical-immediate (name operator) + (let ((tag1notfix (gensym))) + `((LWA t3 0 (iSP) "Get tag from ARG1") + (exts arg2 arg2 8) + (LWA t4 4 (iSP) "Grab data for ARG1") + (CheckDataType t3 |TypeFixnum| ,tag1notfix t6) + (comment "Here we know that both args are fixnums!") + (,operator t4 arg2 t4 "Do the operation") + (GetNextPCandCP) + ,@(when (not (eq name 'AND)) + `((clrldi t4 t4 32 "Strip high bits"))) + (stack-write-ir |TypeFixnum| t4 t1 "Push result") + (ContinueToNextInstruction-NoStall) + (label ,tag1notfix "Here if ARG1 not fixnum") + (li arg1 |TypeFixnum|) + (clrldi arg2 arg2 32) + (SetTag arg1 arg2 t1) + (NumericTypeException t3 ,name t1)))) + +;;; Fin diff --git a/g5-emulator/imacblok.lisp b/g5-emulator/imacblok.lisp new file mode 100644 index 0000000..6e746cc --- /dev/null +++ b/g5-emulator/imacblok.lisp @@ -0,0 +1,219 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of block instructions. These are mostly in IFUNBLOK.PPCS + + +(assert (lisp:and (< (integer-length processorstate$q-bar0) 15) + (< (integer-length processorstate$q-bar1) 15) + (< (integer-length processorstate$q-bar2) 15) + (< (integer-length processorstate$q-bar3) 15)) + () + "The BAR registers have an offset of more than 15 bits") + +;;; Note well! We always store the updated VMA back into the BAR, even +;;; in the no-increment case. This is because the BAR must get the result +;;; of having followed forwarding pointers. + +;;; Note well! We always store the updated VMA back into the BAR, even +;;; in the no-increment case. This is because the BAR must get the result +;;; of having followed forwarding pointers. + +(defmacro i%block-n-read (bar op vma tag data cycle temp3 temp4 temp5 temp6 temp9 temp10 temp11 temp12) + (check-temporaries (bar op) (cycle vma temp3 temp4 temp5 temp6 data tag temp9 temp10 temp11 temp12)) + (let ((fntest (gensym)) + (sk (gensym)) + (sk1 (gensym)) + (nofntest (gensym)) + (ielab (gensym))) + (push + `((label ,fntest) + (CheckDataType ,tag |TypeFixnum| ,ielab ,temp9) + (B ,nofntest)) + *function-epilogue*) + `((LWA ,vma 4 (,bar) "Get the vma") + (srdi ,cycle ,op 6 "cycle type") + (ANDI-DOT ,temp4 ,op 4 "=no-incrementp") + ;;; we don't care about last-word + (ANDI-DOT ,temp5 ,op 16 "=cdr-code-nextp") + (ANDI-DOT ,temp6 ,op 32 "=fixnum onlyp") + (clrldi ,vma ,vma 32) + (comment "Do the read cycle") + (memory-read ,vma ,tag ,data ,cycle ,temp9 ,temp10 ,temp11 ,temp12 nil t) + (branch-if-nonzero ,temp6 ,fntest "J. if we have to test for fixnump.") + (unlikely-label ,nofntest) + (ADDI ,temp6 ,vma 1 "Compute Incremented address") + (force-alignment) + (CMPI 0 1 ,temp4 0) + (BC 4 2 ,sk "B.NE") + (mov ,vma ,temp6 "Conditionally update address") + (unlikely-label ,sk) + (STW ,vma 4 (,bar) "Store updated vma in BAR") + (ANDI-DOT ,temp4 ,tag #x3F "Compute CDR-NEXT") + (GetNextPC) + (CMPI 0 1 ,temp5 0) + (BC 12 2 ,sk1 "B.EQ") + (mov ,tag ,temp4 "Conditionally Set CDR-NEXT") + (unlikely-label ,sk1) + (GetNextCP) + (stack-push2-with-cdr ,tag ,data) + (ContinueToNextInstruction-NoStall) + (label ,ielab) + (illegal-operand block-read-transport-and-fixnum-type-check ,vma "Not a fixnum")))) + +(defmacro i%block-n-write (bar-register bar-vma data temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9) + (check-temporaries (bar-register bar-vma data) (temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + `((srdi ,temp3 ,data 32 "Get tag") + (clrldi ,temp4 ,data 32 "Get data") + (memory-write ,bar-vma ,temp3 ,temp4 PROCESSORSTATE_RAW ,temp9 ,temp5 ,temp6 ,temp7 ,temp8) + (GetNextPCandCP) + (ADDI ,bar-vma ,bar-vma 1 "Increment the address") + ;; Can't side-effect the BAR until after the write in case it would trap. + (STW ,bar-vma 4 (,bar-register) "Store updated vma in BAR") + (ContinueToNextInstruction-NoStall))) + +(defmacro i%block-n-read-shift (bar op temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (check-temporaries (bar op) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12)) + (let ((nofntest (gensym)) + (noincp (gensym)) + (noclrcdr (gensym)) + (ielab (gensym))) + `((LWA ,temp2 4 (,bar) "Get the vma") + (srdi ,temp ,op 6 "cycle type") + (ANDI-DOT ,temp4 ,op 4 "=no-incrementp") + ;;; we don't care about last-word + (ANDI-DOT ,temp5 ,op 16 "=cdr-code-nextp") + (ANDI-DOT ,temp6 ,op 32 "=fixnum onlyp") + (clrldi ,temp2 ,temp2 32) + (memory-read ,temp2 ,temp8 ,temp7 ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (branch-if-zero ,temp6 ,nofntest "J. if we don't have to test for fixnump.") + (CheckDataType ,temp8 |TypeFixnum| ,ielab ,temp9) + (label ,nofntest) + (branch-if-nonzero ,temp4 ,noincp "J. if we don't have to increment the address.") + (ADDI ,temp2 ,temp2 1 "Increment the address") + (label ,noincp) + (STW ,temp2 4 (,bar) "Store updated vma in BAR") + (branch-if-zero ,temp5 ,noclrcdr "J. if we don't have to clear CDR codes.") + (ANDI-DOT ,temp8 ,temp8 #x3F) + (label ,noclrcdr) + (load-constant ,temp #.(sys:%logdpb + (sys:%alu-function-dpb sys:%alu-byte-background-rotate-latch + sys:%alu-byte-set-rotate-latch) + sys:%%alu-function 0) + "Create a fake ALU control register") + (alu-function-byte ,temp ,temp ,temp7 ,temp7 ,temp2 ,temp3 ,temp4 ,temp5 ,temp6) + (GetNextPCandCP) + (stack-push2-with-cdr ,temp8 ,temp7) + (ContinueToNextInstruction-NoStall) + (label ,ielab) + (illegal-operand block-read-transport-and-fixnum-type-check ,temp2 "Not a fixnum")))) + +(defmacro i%block-n-read-alu (bar addr temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (check-temporaries (bar addr) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12)) + (let ((ielab2 (gensym)) + (ielab1 (gensym)) + (op1tag temp2) + (op1data temp3) + (op2tag temp4) + (op2data temp5) + (aluop temp6) + (control temp7) + (result temp8)) + `((LWA ,temp 4 (,bar) "Get the vma") + (stack-read2 ,addr ,op2tag ,op2data) + (CheckDataType ,op2tag |TypeFixnum| ,ielab2 ,temp9) + (clrldi ,temp ,temp 32) + (memory-read ,temp ,op1tag ,op1data PROCESSORSTATE_DATAREAD ,temp9 ,temp10 ,temp11 ,temp12) + (CheckDataType ,op1tag |TypeFixnum| ,ielab1 ,temp9) + (ADDI ,temp ,temp 1 "Increment the address") + (STW ,temp 4 (,bar) "Store updated vma in BAR") + (LD ,aluop PROCESSORSTATE_ALUOP (ivory)) + (stzd PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LD ,control PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (basic-dispatch ,aluop ,temp + (|ALUFunctionBoolean| + (alu-function-boolean ,control ,result ,op1data ,op2data ,temp) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction)) + (|ALUFunctionByte| + (alu-function-byte ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction)) + (|ALUFunctionAdder| + (alu-function-adder ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction)) + (|ALUFunctionMultiplyDivide| + (alu-function-multiply-divide ,control ,op1data ,op2data ,result ,temp ,temp9) + (stack-write-data ,addr ,result) + (ContinueToNextInstruction))) + (label ,ielab2) + (SCAtoVMA ,addr ,temp ,temp9) + (illegal-operand block-read-transport-and-fixnum-type-check ,temp "Not a fixnum") + (label ,ielab1) + (illegal-operand block-read-transport-and-fixnum-type-check ,temp "Not a fixnum")))) + +(defmacro i%block-n-read-test (bar op vma temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (check-temporaries (bar op) (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12)) + (let ((nofntest (gensym)) + (noincp (gensym)) + (noclrcdr (gensym)) + (ielab1 (gensym)) + (ielab2 (gensym)) + (taken (gensym)) + (op1tag temp2 ) + (op1data temp3) + (op2tag temp4) + (op2data temp5) + (aluop temp6) + (control temp7) + (result temp8)) + `((LWA ,vma 4 (,bar) "Get the vma") + (srdi ,temp ,op 6 "cycle type") + (stack-read2 iSP ,op2tag ,op2data) + (clrldi ,vma ,vma 32) + (memory-read ,vma ,op1tag ,op1data ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (ANDI-DOT ,temp ,op 32 "=fixnum onlyp") + (branch-if-zero ,temp ,nofntest "J. if we don't have to test for fixnump.") + (CheckDataType ,op1tag |TypeFixnum| ,ielab1 ,temp9) + (CheckDataType ,op2tag |TypeFixnum| ,ielab2 ,temp9) + (label ,nofntest) + (ANDI-DOT ,temp ,op 16 "=cdr-code-nextp") + (branch-if-zero ,temp ,noclrcdr "J. if we don't have to clear CDR codes.") + (TagType ,op1tag ,op1tag) + (label ,noclrcdr) + (LD ,aluop PROCESSORSTATE_ALUOP (ivory)) + (stzd PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LD ,control PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (basic-dispatch ,aluop ,temp + (|ALUFunctionBoolean| + (alu-function-boolean ,control ,result ,op1data ,op2data ,temp)) + (|ALUFunctionByte| + (alu-function-byte ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11 ,temp12)) + (|ALUFunctionAdder| + (alu-function-adder ,control ,op1data ,op2data ,result ,temp ,temp9 ,temp10 ,temp11)) + (|ALUFunctionMultiplyDivide| + (alu-function-multiply-divide ,control ,op1data ,op2data ,result ,temp ,temp9))) + (alu-compute-condition ,control ,op1tag ,op2tag ,result ,temp ,temp9 ,temp10 ,temp11 ,temp12) + (branch-true ,temp ,taken) + (ANDI-DOT ,temp ,op 4 "=no-incrementp") + (branch-if-nonzero ,temp ,noincp "J. if we don't have to increment the address.") + (ADDI ,vma ,vma 1 "Increment the address") + (label ,noincp) + (STW ,vma 4 (,bar) "Store updated vma in BAR") + (ContinueToNextInstruction) + (label ,taken) + (stack-read2-disp iSP -8 ,temp9 ,temp10) + #+++ignore (CheckAdjacentDataTypes ,temp9 |TypeEvenPC| 2 ,except ,temp10) + (sldi ,temp10 ,temp10 1) + (ANDI-DOT iPC ,temp9 1) + (ADD iPC iPC ,temp10) + (B InterpretInstructionForJump) + (label ,ielab2) + (SCAtoVMA iSP ,vma ,temp9) + (illegal-operand block-read-transport-and-fixnum-type-check ,vma "Not a fixnum") + (label ,ielab1) + (illegal-operand block-read-transport-and-fixnum-type-check ,vma "Not a fixnum")))) + +;;; Fin. diff --git a/g5-emulator/imacfext.lisp b/g5-emulator/imacfext.lisp new file mode 100644 index 0000000..d0960b0 --- /dev/null +++ b/g5-emulator/imacfext.lisp @@ -0,0 +1,12 @@ +;;; -*- Package: POWERPC-INTERNALS; Syntax: Common-Lisp; Mode: LISP -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of field extraction. + +(defmacro ldb-shift (value position result) + (let ((noshift (gensym))) + `((branch-if-zero ,position ,noshift "No shifting needed when byte position is zero") + (SLD ,result ,value ,position) + (srdi ,result ,result 32 "t4 is the shifted field") + (label ,noshift)))) diff --git a/g5-emulator/imacgene.lisp b/g5-emulator/imacgene.lisp new file mode 100644 index 0000000..de7ef11 --- /dev/null +++ b/g5-emulator/imacgene.lisp @@ -0,0 +1,156 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;; This ensures there are two arguments +(defmacro verify-generic-arity (cr nargs temp4) + (let ((recheck (gensym))) + `((load-constant ,temp4 #.1_17 "cr.apply") + (AND ,temp4 ,temp4 ,cr) + (branch-if-zero ,temp4 ,recheck "not applying") + (NEG arg1 ,nargs "4 - argsize") + ;; Pulls arg1 args and retries + (B |PullApplyArgs|) + (label ,recheck) + (illegal-operand too-few-arguments)))) + +;; Reads the instance itag/idata and returns mask data and mapping table data +(defmacro instance-descriptor-info (itag idata mask-data table-data + vma tag data temp temp2 temp3 temp4) + (let ((masknotfix (gensym)) + (notlocative (gensym)) + (instance-tag (gensym)) + (non-instance-tag (gensym))) + (push + `((label ,non-instance-tag) + (comment "not an instance, flavor description comes from magic vector") + (LD ,vma PROCESSORSTATE_TRAPVECBASE (ivory)) + (TagType ,itag ,temp) + (ADDI ,vma ,vma #.sys:%generic-dispatch-vector) + (ADD ,vma ,temp ,vma) + ;; We know the m-m-r is active when we are called + (using-multiple-memory-reads + (,*memoized-vmdata* ,*memoized-vmtags* ,*memoized-base* ,*memoized-limit*) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4 + ,instance-tag)) + (label ,masknotfix) + (illegal-operand (flavor-search-mask-not-fixnum data-read) ,vma) + (label ,notlocative) + (illegal-operand (flavor-search-table-pointer-not-locative data-read) ,vma)) + *function-epilogue*) + `((CheckAdjacentDataTypes ,itag |TypeInstance| 4 ,non-instance-tag ,temp) + (mov ,vma ,idata "Don't clobber instance if it's forwarded") + (memory-read ,vma ,tag ,data PROCESSORSTATE_HEADER ,temp ,temp2 ,temp3 ,temp4) + (label ,instance-tag) + (mov ,vma ,data) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4) + (mov ,mask-data ,data) + (CheckDataType ,tag |TypeFixnum| ,masknotfix ,temp) + (ADDI ,vma ,vma 1) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4) + (mov ,table-data ,data) + (CheckDataType ,tag |TypeLocative| ,notlocative ,temp)))) + +(defmacro non-instance-descriptor-info (itag idata mask-data table-data + temp temp2 temp3 temp4 temp5 temp6 temp7 + instance-tag non-instance-tag) + (declare (ignore idata table-data temp7 non-instance-tag)) + `((comment "not an instance, flavor description comes from magic vector") + (LD ,temp5 PROCESSORSTATE_TRAPVECBASE (ivory)) + (TagType ,itag ,mask-data) + (load-constant ,temp6 #.sys:%generic-dispatch-vector "Damned 8-bit literals!") + (ADD ,mask-data ,mask-data ,temp5) + (ADD ,mask-data ,mask-data ,temp6) + (memory-read ,mask-data ,temp5 ,temp6 PROCESSORSTATE_DATAREAD ,temp ,temp2 ,temp3 ,temp4 + ,instance-tag) + ;; (B ,instance) done by MEMORY-READ + )) + +;; Returns parameter ptag/pdata and method mtag/mdata +(defmacro lookup-handler (gtag gdata table mask ptag pdata mtag mdata + offset vma tag data temp2 temp3 temp4 temp5) + (let ((found (gensym)) + (loop (gensym)) + ) + `((AND ,vma ,mask ,gdata) + (sldi ,temp2 ,vma 1) + (ADD ,offset ,vma ,temp2 "(* (logand mask data) 3)") + (TagType ,gtag ,gtag) + (label ,loop) + (ADD ,vma ,table ,offset) + (ADDI ,offset ,offset 3) + (comment "Read key") + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5 nil t) + (TagType ,tag ,tag) + (XORI ,temp2 ,tag |TypeNIL|) + (branch-false ,temp2 ,found) + (XOR ,temp2 ,gtag ,tag) + (branch-true ,temp2 ,loop) + (CMPL 0 0 ,gdata ,data "32-bit compare (signed/unsigned irrelevant)") + (BC 4 2 ,loop "B. if different") + (label ,found) + (comment "Read method") + (ADDI ,vma ,vma 1) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5) + (mov ,mtag ,tag) + (mov ,mdata ,data) + (comment "Read parameter") + (ADDI ,vma ,vma 1) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp2 ,temp3 ,temp4 ,temp5) + (mov ,ptag ,tag) + (mov ,pdata ,data) + ))) + +(defmacro generic-dispatch (gtag gdata itag idata mtag mdata ptag pdata cr nargs temp2 temp3) + (let ((isnil (gensym)) + (notpc (gensym))) + `((get-control-register ,cr) + (stack-read2-disp-signed iFP ,(* 2 8) ,gtag ,gdata "get generic tag and data") + (ANDI-DOT ,nargs ,cr #xFF "get number of arguments") + (stack-read2-disp-signed iFP ,(* 3 8) ,itag ,idata "get instance tag and data") + (ADDI ,nargs ,nargs -4 "done if 2 or more arguments (plus 2 extra words)") + (branch-if-less-than-zero ,nargs |VerifyGenericArity|) ;CR in ARG6, restarts instruction + (clrldi ,gdata ,gdata 32) + (clrldi ,idata ,idata 32) + (call-subroutine |LookupHandler|) ;clobbers T1-T5, T10 linkage= R0 + (CheckAdjacentDataTypes ,mtag |TypeEvenPC| 2 ,notpc ,temp2) + (ANDI-DOT ,temp2 ,ptag #x3F "Strip CDR code") + (ADDI ,temp2 ,temp2 #.(- |type$K-NIL|)) + (branch-if-zero ,temp2 ,isnil) + (stack-write2-disp iFP ,(* 2 8) ,ptag ,pdata) + (label ,isnil) + (convert-continuation-to-pc ,mtag ,mdata iPC ,temp2) + (B interpretInstructionForJump) + (label ,notpc) + (SCAtoVMA iSP ,temp2 ,temp3) + (illegal-operand (generic-search-table-entry-not-pc data-read) ,temp2)))) + +(defmacro message-dispatch (gtag gdata itag idata mtag mdata ptag pdata cr nargs temp2 temp3) + (let ((isnil (gensym)) + (isntnil (gensym)) + (notpc (gensym))) + `((get-control-register ,cr) + (stack-read2-disp-signed iFP ,(* 3 8) ,gtag ,gdata "get message tag and data") + (ANDI-DOT ,nargs ,cr #xFF "get number of arguments") + (stack-read2-disp-signed iFP ,(* 2 8) ,itag ,idata "get instance tag and data") + (ADDI ,nargs ,nargs -4 "done if 2 or more arguments (plus 2 extra words)") + (branch-if-less-than-zero ,nargs |VerifyGenericArity|) ;CR in ARG6, restarts instruction + (clrldi ,gdata ,gdata 32) + (clrldi ,idata ,idata 32) + (call-subroutine |LookupHandler|) ;clobbers T1-T5, T10 linkage=R0 + (stack-read-disp iFP ,(* 2 8) ,idata "clobbered by |LookupHandler|") + (CheckAdjacentDataTypes ,mtag |TypeEvenPC| 2 ,notpc ,temp2) + (ANDI-DOT ,temp2 ,ptag #x3F "Strip CDR code") + (ADDI ,temp2 ,temp2 #.(- |type$K-NIL|)) + (branch-if-zero ,temp2 ,isnil) + (stack-write2-disp iFP ,(* 2 8) ,ptag ,pdata) + (B ,isntnil) + (label ,isnil) + (stack-write2-disp iFP ,(* 2 8) ,gtag ,gdata "swap message/instance in the frame") + (label ,isntnil) + (stack-write-disp iFP ,(* 3 8) ,idata) + (convert-continuation-to-pc ,mtag ,mdata iPC ,temp2) + (B interpretInstructionForJump) + (label ,notpc) + (SCAtoVMA iSP ,temp2 ,temp3) + (illegal-operand (generic-search-table-entry-not-pc data-read) ,temp2)))) diff --git a/g5-emulator/imacialu.lisp b/g5-emulator/imacialu.lisp new file mode 100644 index 0000000..995e441 --- /dev/null +++ b/g5-emulator/imacialu.lisp @@ -0,0 +1,287 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of the alu instructions. These are mostly in IFUNSUBP.PPCS + +(defmacro read-alu-condition (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 16) + (ANDI-DOT ,r1 ,r1 #x1F "Extract ALU condition"))) + +(defmacro read-alu-condition-sense (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 21) + (ANDI-DOT ,r1 ,r1 1 "Extract the condition sense"))) + +(defmacro read-alu-output-condition (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 22) + (ANDI-DOT ,r1 ,r1 1 "Extract the output condition"))) + +(defmacro read-alu-enable-condition-exception (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 23) + (ANDI-DOT ,r1 ,r1 1 "Extract the enable condition"))) + +(defmacro read-alu-enable-load-con (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 24) + (ANDI-DOT ,r1 ,r1 1 "Extract the enable load cin"))) + +(defmacro read-alu-boolean-function (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 10) + (ANDI-DOT ,r1 ,r1 #xF "Extract the ALU boolean function"))) + +(defmacro read-alu-byte-rotate (a1 r1) + (check-temporaries (a1) (r1)) + `((ANDI-DOT ,r1 ,a1 #x1F "Extract the Byte Rotate"))) + +(defmacro read-alu-byte-size (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 5) + (ANDI-DOT ,r1 ,r1 #x1F "Extract the byte size"))) + +(defmacro read-alu-byte-background (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 10) + (ANDI-DOT ,r1 ,r1 3 "Extract the byte background"))) + +(defmacro read-alu-byte-rotate-latch (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 12) + (ANDI-DOT ,r1 ,r1 1 "Extractthe byte rotate latch"))) + +(defmacro read-alu-byte-function (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 13) + (ANDI-DOT ,r1 ,r1 1))) + +(defmacro read-alu-adder-carry-in (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 10) + (ANDI-DOT ,r1 ,r1 1 "Extract the adder carry in"))) + +(defmacro write-alu-adder-carry-in (a1 r1 temp) + (check-temporaries (a1) (r1 temp)) + `((load-constant ,temp #.1_10) + (ANDC ,a1 ,a1 ,temp) + (ANDI-DOT ,temp ,r1 1) + (sldi ,temp ,temp 10) + (OR ,a1 ,a1 ,temp "Set the adder carry in"))) + +(defmacro read-alu-adder-op2 (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 11) + (ANDI-DOT ,r1 ,r1 3 "Extract the op2"))) + +(defmacro read-alu-function-class-bits (a1 r1) + (check-temporaries (a1) (r1)) + `((srdi ,r1 ,a1 14) + (ANDI-DOT ,r1 ,r1 3 "Extract the function class bits"))) + +(defmacro alu-function-boolean (alu res op1 op2 temp) + `((read-alu-boolean-function ,alu ,res) + (basic-dispatch ,res ,temp ;+++ efficancy hack pf + (|BooleClear| + ;; (ANDC ,res ,res ,res) ;Commented out because res IS zero + ) + (|BooleAnd| + (AND ,res ,op1 ,op2)) + (|BooleAndC1| + (ANDC ,res ,op2 ,op1)) + (|Boole2| + (mov ,res ,op2)) + (|BooleAndC2| + (ANDC ,res ,op1 ,op2)) + (|Boole1| + (mov ,res ,op1)) + (|BooleXor| + (XOR ,res ,op1 ,op2)) + (|BooleIor| + (OR ,res ,op1 ,op2)) + (|BooleNor| + (NOR ,res ,op1 ,op2)) + (|BooleEquiv| + (EQV ,res ,op1 ,op2)) + (|BooleC1| + (NAND ,res ,op1 ,op1)) + (|BooleOrC1| + (ORC ,res ,op2 ,op1)) + (|BooleC2| + (NAND ,res ,op2 ,op2)) + (|BooleOrC2| + (ANDC ,res ,op1 ,op2)) + (|BooleNand| + (AND ,res ,op1 ,op2)) + (|BooleSet| + (ORC ,res ,res ,res))))) + +(defmacro alu-function-byte (alu op1 op2 res bgnd rot siz temp temp2) + (let ((hrl (gensym)) + (mask temp2)) + `((LD ,rot PROCESSORSTATE_BYTEROTATE (ivory) "Get rotate") + (LD ,siz PROCESSORSTATE_BYTESIZE (ivory) "Get bytesize") + (comment "Get background") + (read-alu-byte-background ,alu ,bgnd) + (basic-dispatch ,bgnd ,temp + (|ALUByteBackgroundOp1| + (mov ,bgnd ,op1)) + (|ALUByteBackgroundRotateLatch| + (LD ,bgnd PROCESSORSTATE_ROTATELATCH (ivory))) + (|ALUByteBackgroundZero| + (clr ,bgnd))) + (read-alu-byte-rotate-latch ,alu ,temp2) + (SLD ,res ,op2 ,rot) + (srdi ,temp ,res 32) + (clrldi ,res ,res 32) + (OR ,res ,res ,temp "OP2 rotated") + (branch-if-zero ,temp2 ,hrl "Don't update rotate latch if not requested") + (STD ,res PROCESSORSTATE_ROTATELATCH (ivory)) + (label ,hrl) + (load-constant ,mask -2) + (SLD ,mask ,mask ,siz) + (NAND ,mask ,mask ,mask "Compute mask") + (comment "Get byte function") + (read-alu-byte-function ,alu ,temp) + (basic-dispatch ,temp ,siz + (|ALUByteFunctionDpb| + (SLD ,mask ,mask ,rot "Position mask")) + (|ALUByteFunctionLdb|)) + (AND ,res ,res ,mask "rotated&mask") + (ANDC ,bgnd ,bgnd ,mask "background&~mask") + (OR ,res ,res ,bgnd)))) + +(defmacro alu-function-adder (alu op1 op2 res op2a carryin temp temp2) + (let ((skipcinupdate (gensym))) + `((read-alu-adder-op2 ,alu ,temp) + (read-alu-adder-carry-in ,alu ,carryin) + (basic-dispatch ,temp ,temp2 + (|ALUAdderOp2Op2| + (mov ,op2a ,op2)) + (|ALUAdderOp2Zero| + (clr ,op2a)) + (|ALUAdderOp2Invert| + (exts ,op2a ,op2 32) + (NEG ,op2a ,op2a) + (clrldi ,op2a ,op2a 32)) + (|ALUAdderOp2MinusOne| + (ORC ,op2a ,op2a ,op2a) + (clrldi ,op2a ,op2a 32))) + (ADD ,res ,op1 ,op2a) + (ADD ,res ,res ,carryin) + (srdi ,temp ,res 31 "Sign bit") + (srdi ,temp2 ,res 32 "Next bit") + (XOR ,temp ,temp ,temp2 "Low bit is now overflow indicator") + (srdi ,temp2 ,alu 24 "Get the load-carry-in bit") + (STD ,temp PROCESSORSTATE_ALUOVERFLOW (ivory)) + (ANDI-DOT R31 ,temp2 1 "BLBC") + (BC 12 2 ,skipcinupdate) + (srdi ,temp ,res 32 "Get the carry") + (write-alu-adder-carry-in ,alu ,temp ,temp2) + (STD ,alu PROCESSORSTATE_ALUANDROTATECONTROL (ivory)) + (label ,skipcinupdate) + (SUBF ,temp ,op2a ,op1) ;-ve if ,op1 < ,op2a + (extrdi ,temp ,temp 1 0 "get the sign bit into bit 63") ; 1 if ,op1 < ,op2a + (STD ,temp PROCESSORSTATE_ALUBORROW (ivory)) + (exts ,op1 ,op1 32) + (exts ,op2 ,op2 32) + (SUBF ,temp ,op2a ,op1) ;-ve if ,op1 < ,op2a + (extrdi ,temp ,temp 1 0 "get the sign bit into bit 63") ; 1 if ,op1 < ,op2a + (STD ,temp PROCESSORSTATE_ALULESSTHAN (ivory))))) + +(defmacro alu-function-multiply-divide (alu op1 op2 res temp temp2) + (declare (ignore alu op1 op2 res temp temp2)) + `((UnimplementedInstruction))) + +(defmacro alu-compute-condition (alu op1tag op2tag result condition temp temp2 temp3 temp4) + (let ((labone (gensym)) + (labzero (gensym)) + (done (gensym)) + (ov temp2) + (bo temp3) + (lt temp4) + ) + `((read-alu-condition ,alu ,condition) + (LD ,ov PROCESSORSTATE_ALUOVERFLOW (ivory)) + (LD ,bo PROCESSORSTATE_ALUBORROW (ivory)) + (LD ,lt PROCESSORSTATE_ALULESSTHAN (ivory)) + (basic-dispatch ,condition ,temp + (|ALUConditionSignedLessThanOrEqual| + (branch-if-nonzero ,lt ,labone) + (branch-if-zero ,result ,labone)) + (|ALUConditionSignedLessThan| + (branch-if-nonzero ,lt ,labone)) + (|ALUConditionNegative| + (branch-if-less-than-zero ,result ,labone)) + (|ALUConditionSignedOverflow| + (branch-if-nonzero ,ov ,labone)) + (|ALUConditionUnsignedLessThanOrEqual| + (branch-if-nonzero ,bo ,labone) + (branch-if-zero ,result ,labone)) + (|ALUConditionUnsignedLessThan| + (branch-if-nonzero ,bo ,labone)) + (|ALUConditionZero| + (branch-if-zero ,result ,labone)) + (|ALUConditionHigh25Zero| + (srdi ,condition ,result 7) + (branch-if-zero ,condition ,labone)) + (|ALUConditionEq| + (branch-if-nonzero ,result ,labzero) + (XOR ,temp ,op1tag ,op2tag) + (TagType ,temp ,temp) + (branch-if-zero ,temp ,labone)) + (|ALUConditionOp1Ephemeralp| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionResultTypeNil| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp2Fixnum| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionFalse| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionResultCdrLow| + (TagCdr ,op1tag ,temp) + (ANDI-DOT ,condition ,temp #x01) + (B ,done)) + (|ALUConditionCleanupBitsSet| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionAddressInStackCache| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionExtraStackMode| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionFepMode| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionFpCoprocessorPresent| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp1Oldspacep| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionPendingSequenceBreakEnabled| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp1TypeAcceptable| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOp1TypeCondition| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionStackCacheOverflow| + (UnimplementedInstruction)) ;+++ NYI + (|ALUConditionOrLogicVariable| + (UnimplementedInstruction)) ;+++ NYI + (:else + (UnimplementedInstruction)) ;+++ NYI + ) + (label ,labzero) + ;; Control arrives here iff the condition tested was false. + (clr ,condition) + (B ,done) + (label ,labone) + (li ,condition 1) + (label ,done) + ;; CONDITION is now 1 if the condition tested TRUE and 0 if it tested FALSE. + ;; The condition sense will be 0 if we want to branch on TRUE and 1 to branch on FALSE. + ;; Therefore, we can XOR the CONDITION and condition sense together to produce + ;; a 1 if we should branch and a 0 if we shouldn't. + (read-alu-condition-sense ,alu ,temp) + (XOR ,condition ,condition ,temp) + ))) + +;;; Fin. diff --git a/g5-emulator/imacinst.lisp b/g5-emulator/imacinst.lisp new file mode 100644 index 0000000..9b92e87 --- /dev/null +++ b/g5-emulator/imacinst.lisp @@ -0,0 +1,78 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; This file contains macros supporting instance instructions. +;;; These are mostly in IFUNINST.PPCS + +(defmacro locate-instance-variable-mapped (n vma mapiop selfiop indexiop iex + tag data temp1 temp2 temp3 temp4 temp5 temp6 + temp7 temp8 &optional long-jump?) + (check-temporaries (n vma) (tag data temp1 temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + (let ((done (gensym)) + (doit (gensym)) + (update (gensym))) + (push `((label ,update) + (mov ,temp3 ,vma) + ;; We know the m-m-r is active when we are called + (using-multiple-memory-reads + (,*memoized-vmdata* ,*memoized-vmtags* ,*memoized-base* ,*memoized-limit*) + (memory-read ,vma ,tag ,data PROCESSORSTATE_HEADER ,temp5 ,temp6 ,temp7 ,temp8)) + (SUBF ,temp3 ,vma ,temp3) + (branch-if-nonzero ,temp3 ,doit) + (TagType ,temp4 ,temp4) + (ORI ,temp4 ,temp4 #x40 "Set CDR code to 1") + (stack-write2-disp iFP ,(* 3 8) ,temp4 ,vma "Update self") + (B ,doit)) + *function-epilogue*) + + `((comment "Locate Instance Variable Mapped") + (stack-read2-disp iFP ,(* 2 8) ,tag ,vma "Map") + (CheckDataType ,tag |TypeArray| ,mapiop ,temp2) + (memory-read ,vma ,tag ,data PROCESSORSTATE_HEADER ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (ANDI-DOT ,data ,data |ArrayLengthMask|) + (SUBF ,temp3 ,n ,data) + (branch-if-less-than-or-equal-to-zero ,temp3 ,indexiop "J. if mapping-table-index-out-of-bounds") + (ADD ,vma ,vma ,n) + (ADDI ,vma ,vma 1) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8) + (mov ,temp1 ,data) + (CheckDataType ,tag |TypeFixnum| ,iex ,temp4 ,long-jump?) ;mapping table entry not fixnum + (stack-read2-disp iFP ,(* 3 8) ,temp4 ,vma "Self") + (CheckAdjacentDataTypes ,temp4 |TypeInstance| 4 ,selfiop ,temp3) + (ANDI-DOT ,temp3 ,temp4 #xC0 "Unshifted cdr code") + (ADDI ,temp3 ,temp3 #.(- #x40) "Check for CDR code 1") + (branch-if-nonzero ,temp3 ,update "J. if CDR code is not 1") + (label ,doit) + (ADD ,vma ,vma ,temp1) + (label ,done)))) + +;; ADDR gets the address of the ordered IV +(defmacro locate-instance-variable-unmapped (n addr iop temp temp2 temp3) + (check-temporaries (n addr) (temp temp2 temp3)) + (let () + `((comment "Locate Instance Variable Unmapped") + (stack-read2-disp iFP ,(* 3 8) ,temp ,temp2 "self") + (CheckAdjacentDataTypes ,temp |TypeInstance| 4 ,iop ,temp3) + (ADD ,addr ,temp2 ,n)))) + +(defmacro locate-arbitrary-instance-variable (itag idata otag odata addr instanceiop offsetiop + temp temp2 temp3 temp4 temp5 + temp6 temp7 temp8) + (check-temporaries (itag idata otag odata addr) + (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8)) + (let () + `((comment "Locate Arbitrary Instance Variable") + ;;+++ Needs to check for spare dtp before signalling illegal operand! + (CheckAdjacentDataTypes ,itag |TypeInstance| 4 ,instanceiop ,temp) + (CheckDataType ,otag |TypeFixnum| ,offsetiop ,temp) + (memory-read ,idata ,temp2 ,temp PROCESSORSTATE_HEADER ,temp5 ,temp6 ,temp7 ,temp8) + (ADDI ,temp ,temp -1) + (memory-read ,temp ,temp4 ,temp2 PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,temp4 |TypeFixnum| ,offsetiop ,temp5) + (branch-if-less-than-zero ,odata ,offsetiop "J. if offset <0") ; +++ optimioze this + (SUBF ,temp4 ,temp2 ,odata) + (branch-if-greater-than-or-equal-to-zero ,temp4 ,offsetiop "J. if offset out of bounds") + (ADD ,addr ,odata ,idata)))) + +;;; Fin. diff --git a/g5-emulator/imacjosh.lisp b/g5-emulator/imacjosh.lisp new file mode 100644 index 0000000..c6fe5f3 --- /dev/null +++ b/g5-emulator/imacjosh.lisp @@ -0,0 +1,93 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of AI instructions. These are mostly in IFUNJOSH.PPCS + +(defmacro get-structure-stack-pointer (to) + `((LD ,to PROCESSORSTATE_BAR2 (ivory)))) + +(defmacro set-structure-stack-pointer (to) + `((STD ,to PROCESSORSTATE_BAR2 (ivory)))) + +(defmacro get-structure-stack-pointer-data (to) + `((LD ,to PROCESSORSTATE_BAR2 (ivory)) + (clrldi ,to ,to 32))) + +(defmacro set-structure-stack-pointer-data (to) + `((STW ,to PROCESSORSTATE_BAR2+4 (ivory)))) + +(defmacro get-structure-stack-pointer2 (totag todata) + `((LWA ,todata PROCESSORSTATE_BAR2+4 (ivory)) + (LWA ,totag PROCESSORSTATE_BAR2 (ivory)) + (clrldi ,todata ,todata 32))) + +(defmacro set-structure-stack-pointer2 (totag todata) + `((STW ,totag PROCESSORSTATE_BAR2 (ivory)) + (STW ,todata PROCESSORSTATE_BAR2+4 (ivory)))) + +(defmacro get-trail-pointer (to) + `((LD ,to PROCESSORSTATE_BAR3 (ivory)))) + +(defmacro set-trail-pointer (to) + `((STD ,to PROCESSORSTATE_BAR3 (ivory)))) + +(defmacro get-trail-pointer-data (to) + `((LD ,to PROCESSORSTATE_BAR3 (ivory)) + (clrldi ,to ,to 32))) + +(defmacro set-trail-pointer-data (to) + `((STW ,to PROCESSORSTATE_BAR3+4 (ivory)))) + +(defmacro get-trail-pointer2 (totag todata) + `((LWA ,todata PROCESSORSTATE_BAR3+4 (ivory)) + (LWA ,totag PROCESSORSTATE_BAR3 (ivory)) + (clrldi ,todata ,todata 32))) + +(defmacro set-trail-pointer2 (totag todata) + `((STW ,totag PROCESSORSTATE_BAR3 (ivory)) + (STW ,todata PROCESSORSTATE_BAR3+4 (ivory)))) + +;;; bind-location (location data) +;;; unless choice-pointer < location <= stackpointer +;;; or structure-stack-choice-pointer < location <= structure-stackpointer +;;; read(location %memory-scavenge) => X (the old contents of location) +;;; if (X not DTP-logic-variable) exception +;;; Store X in trail +;;; increment trail +;;; finally store data in location. + +(defmacro bind-location (loctag locdata valtag valdata exclab temp temp2 temp3 + temp4 temp5 temp6 temp7) + (check-temporaries (loctag locdata valtag valdata) + (temp temp2 temp3 temp4 temp5 temp6 temp7)) + (let ((maketrail (gensym)) + (maybestructure (gensym)) + (notrail (gensym))) + `((get-choice-pointer-data ,temp) + (get-structure-choice-pointer-data ,temp2) + (SUBF ,temp4 ,locdata ,temp) + (SUBF ,temp5 iSP ,locdata) + (get-structure-stack-pointer-data ,temp3) + (branch-if-less-than-or-equal-to-zero ,temp4 ,maybestructure "J. if below choice pointer") + (branch-if-less-than-or-equal-to-zero ,temp5 ,notrail "J. if between choice pointer and stack pointer") + (label ,maybestructure) + (SUBF ,temp4 ,locdata ,temp2) + (SUBF ,temp5 ,temp3 ,locdata) + (branch-if-less-than-or-equal-to-zero ,temp4 ,maketrail "J. if below structure-choice-pointer") + (branch-if-less-than-or-equal-to-zero ,temp5 ,notrail "J. if between structure choice and stack pointer") + (label ,maketrail) + (memory-read ,locdata ,temp2 ,temp PROCESSORSTATE_SCAVENGE + ,temp3 ,temp4 ,temp5 ,temp6 nil t) + (TagType ,temp2 ,temp3) + (ADDI ,temp3 ,temp3 #.(- |type$K-logicvariable|)) + (branch-if-nonzero ,temp3 ,exclab "J. to exception if not logic variable") + (get-trail-pointer-data ,temp3) + (memory-write ,temp3 ,temp2 ,temp PROCESSORSTATE_DATAWRITE + ,temp4 ,temp5 ,temp6 ,temp7) + (ADDI ,temp3 ,temp3 1) + (set-trail-pointer-data ,temp3) + (label ,notrail) + (memory-write ,locdata ,valtag ,valdata PROCESSORSTATE_DATAWRITE + ,temp ,temp2 ,temp3 ,temp4)))) +;;; Fin. diff --git a/g5-emulator/imaclexi.lisp b/g5-emulator/imaclexi.lisp new file mode 100644 index 0000000..c051580 --- /dev/null +++ b/g5-emulator/imaclexi.lisp @@ -0,0 +1,22 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of lexical instructions. These are mostly in IFUNLEXI.PPCS +;;; Lexical variable accessors. + +(defmacro compute-lexical-var-address (arg lexical temp temp2 temp3 common-tail) + `( + (stack-read2-signed ,arg ,temp ,lexical) + (srdi ,temp3 arg3 10 "Position the opcode") + (TagType ,temp ,temp2) + (clrldi ,lexical ,lexical 32) + (ADDI ,temp2 ,temp2 #.(- |type$K-list|)) ;temp2=0 if list, temp2=4 if locative + (rotrdi ,temp2 ,temp2 2) ;temp2=0 if list, temp2=1 if locative + (clrrdi ,temp2 ,temp2 1) ;temp2=0 iff list or locative + (ANDI-DOT ,temp3 ,temp3 7 "Get the lexical var number") + (ADD ,lexical ,lexical ,temp3 "Compute the address of the lexical variable.") + (branch-if-zero ,temp2 ,common-tail))) + + +;;; Fin. diff --git a/g5-emulator/imaclist.lisp b/g5-emulator/imaclist.lisp new file mode 100644 index 0000000..93efba7 --- /dev/null +++ b/g5-emulator/imaclist.lisp @@ -0,0 +1,263 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of list instructions. These are mostly in IFUNLIST.PPCS + +;;; Destructively reads car(tag/data) into tag/data +(defmacro car-internal (tag data opcode vma temp3 temp4 temp5 temp6 &optional signedp) + (assert (member signedp '(t nil)) () "Barf") + (check-temporaries (tag data) (vma temp3 temp4 temp5 temp6)) + (let ((loccase (gensym)) + (endcar (gensym))) + `(;; Allows arg-fetch to be signed + (clrldi ,vma ,data 32) + (type-dispatch ,tag ,temp3 ,temp4 + (|TypeList| + (unlikely-label ,loccase) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 + nil ,signedp) + ;; Fall through + ) + (|TypeNIL| + ;; NIL case is trivial, return self! + ) + (|TypeLocative| + ,loccase) + (:else + ,@(if (listp opcode) + `(,opcode) + `((ListTypeException ,tag ,opcode))))) + (label ,endcar)))) + +;;; Destructively reads cdr(tag/data) into tag/data. +(defmacro cdr-internal (tag data opcode vma temp3 temp4 temp5 temp6 &optional signedp) + (assert (member signedp '(t nil)) () "Barf") + (check-temporaries (tag data) (vma temp3 temp4 temp5 temp6)) + (let ((readcdr (gensym)) + (endcdr (gensym))) + `(;; Allows arg-fetch to be signed + (clrldi ,vma ,data 32) + (type-dispatch ,tag ,temp3 ,temp4 + (|TypeList| + (memory-read ,vma ,tag ,data PROCESSORSTATE_CDR ,temp3 ,temp4 ,temp5 ,temp6 nil t) + (cdr-code-dispatch ,tag ,temp3 ,temp4 + (|CdrNext| + (ADDI ,data ,vma 1 "Address of next position is CDR") + (li ,tag |TypeList|) + ;; First clauses fall through + ;; (B ,endcdr) + ) + (|CdrNormal| + (ADDI ,vma ,vma 1) + (label ,readcdr) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 + ,endcdr ,signedp) + ) + (|CdrNil| + (get-nil2 ,tag ,data) + (B ,endcdr)) + (:else + (illegal-operand bad-cdr-code-in-memory ,vma)))) + (|TypeNIL| + ;; NIL case is trivial, return self! + ) + (|TypeLocative| + ,readcdr) + (:else + ,@(if (listp opcode) + `(,opcode) + `((ListTypeException ,tag ,opcode))))) + (label ,endcdr)))) + +;;; Destructively reads car(tag/data) into tag/data, and puts cdr(tag/data) into dtag/ddata. +(defmacro carcdr-internal (tag data dtag ddata opcode vma temp3 temp4 temp5 temp6 + &optional signedp) + "DTAG and DDATA should be the canonical tag/data registers" + (assert (member signedp '(t nil)) () "Barf") + (check-temporaries (tag data dtag ddata) (vma temp3 temp4 temp5 temp6)) + (let ((forwarded (gensym)) + (end-carcdr (gensym)) + (cdr-ed (gensym))) + `(;; Allows arg-fetch to be signed + (clrldi ,vma ,data 32) + (type-dispatch ,tag ,temp3 ,temp4 + (|TypeList| + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 nil ,signedp) + (CMPL 0 0 ,vma ,data "32-bit compare (signed/unsigned irrelevant)") + (BC 4 2 ,forwarded "CAR forwarded, must CDR the hard way") + ;; Save the CAR values + (mov ,tag ,dtag) + (mov ,data ,ddata) + (label ,cdr-ed) + ;; Note: dispatches on the CDR reg tag (may have been + ;; re-fetched if forwarded) + (cdr-code-dispatch ,dtag ,temp3 ,temp4 + (|CdrNext| + (ADDI ,ddata ,vma 1 "Address of next position is CDR") + (li ,dtag |TypeList|) + ;; First clauses fall through + ;;(B ,end-carcdr) + ) + (|CdrNormal| + (ADDI ,vma ,vma 1) + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_DATAREAD ,temp3 ,temp4 ,temp5 ,temp6 + ,end-carcdr ,signedp) + ) + (|CdrNil| + (get-nil2 ,dtag ,ddata) + (B ,end-carcdr)) + (:else + (illegal-operand bad-cdr-code-in-memory ,vma)))) + (|TypeNIL| + (get-nil2 ,dtag ,ddata)) + ;; Locative illegal for car-cdr + (:else + ,@(if (listp opcode) + `(,opcode) + `((ListTypeException ,tag ,opcode ,temp3))) + ;; Clever spot + (label ,forwarded) + ;; Sigh, we have the car, but in the cdr regs, and we need to + ;; re-read the car address (comes in the car-data reg) for + ;; cdr-code. We know if we come here we have a list, so + ;; rather than a full cdr, we just reread the vma and tag and + ;; branch back to the fast code above + (clrldi ,vma ,data 32) + (mov ,tag ,dtag) + (mov ,data ,ddata) + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_CDR ,temp3 ,temp4 ,temp5 ,temp6 nil t) + (B ,cdr-ed))) + (label ,end-carcdr)))) + +(defmacro icar (poperand tag data vma temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack." :signed t) + (car-internal ,tag ,data car ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (stack-push2 ,tag ,data ,temp5) + (ContinueToNextInstruction))) + +(defmacro icdr (poperand tag data vma temp2 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack." :signed t) + (cdr-internal ,tag ,data cdr ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (stack-push2 ,tag ,data ,temp5) + (ContinueToNextInstruction))) + +(defmacro isettocar (poperand tag data vma temp2 temp9 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8 temp9)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack." :signed t) + (ANDI-DOT ,temp9 ,tag #xC0 "Save the old CDR code") + (car-internal ,tag ,data set-to-car ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (TagType ,tag ,tag) + (OR ,tag ,tag ,temp9 "Put back the original CDR codes") + (stack-write2 ,poperand ,tag ,data) + (ContinueToNextInstruction))) + +(defmacro isettocdr (poperand tag data vma temp2 temp9 temp3 temp4 temp5 temp6 temp7 temp8) + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8 temp9)) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack.") + (ANDI-DOT ,temp9 ,tag #xC0 "Save the old CDR code") + (cdr-internal ,tag ,data set-to-cdr ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (TagType ,tag ,tag) + (OR ,tag ,tag ,temp9 "Put back the original CDR codes") + (stack-write2 ,poperand ,tag ,data) + (ContinueToNextInstruction))) + +(defmacro isettocdrpushcar (poperand tag data dtag ddata vma temp2 temp9 temp3 temp4 temp5 temp6 temp7 temp8) + "DTAG and DDATA should be the canonical tag/data registers" + (declare (ignore temp2 temp3 temp4)) + (check-temporaries (poperand tag data) + (vma temp5 temp6 temp7 temp8 temp9)) + (let ((loclab (gensym))) + `((stack-read2 ,poperand ,tag ,data "Get the operand from the stack.") + (ANDI-DOT ,temp9 ,tag #xC0 "Save the old CDR code") + (ADDI ,temp5 ,tag #.(- |type$K-locative|)) + (ANDI-DOT ,temp5 ,temp5 #x3F "Strip CDR code") + (branch-if-zero ,temp5 ,loclab) + (carcdr-internal ,tag ,data ,dtag ,ddata set-to-cdr-push-car ,vma ,temp5 ,temp6 ,temp7 ,temp8 t) + (TagType ,dtag ,dtag) + (OR ,dtag ,dtag ,temp9 "Put back the original CDR codes") + (stack-write2 ,poperand ,dtag ,ddata) + ;; Stack-push clears CDR + (stack-push2 ,tag ,data ,temp5) + (ContinueToNextInstruction) + (label ,loclab) + ;; car/cdr of locative both the same + (mov ,vma ,data) + (memory-read ,vma ,dtag ,ddata PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (TagType ,tag ,tag) + (stack-push2-with-cdr ,dtag ,ddata) + (OR ,tag ,tag ,temp9 "Put back the original CDR codes") + (stack-write2 ,poperand ,dtag ,ddata) + (ContinueToNextInstruction)))) + + +(defmacro carcdrloop ((instruction obj-tag obj-data car-tag car-data cdr-tag cdr-data + vma nextlabel exceptionlabel + temp4 temp5 temp6 temp7 temp8 temp9 temp10 temp11 temp12) + (&body looptop) (&body loopbody) (&optional loopstep) (&body loopend)) + "Uses car/cdr subroutine to implement a general loop for cdr-ing down + a list testing cars. Loads OP1 from TOS into obj-tag/data and OP2 + (the list) from arg1, fetching car and cdr of the list each time + around the loop" + ;; only used by subroutines + (declare (ignore vma temp4 temp7 temp8) + #+Genera (zwei:indentation 0 5 1 2)) + (let ((break (gensym)) + (enter (gensym)) + (end (gensym))) + (push `((label ,break) + ;; If STOP_INTERPRETER is set during a long List instruction, it is + ;; sufficient for us to simply restart the instruction. That will + ;; take the sequence-break and when done the instruction will get + ;; retried. + (LD iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (ContinueToInterpretInstruction)) + *function-epilogue*) + `(with-multiple-memory-reads (,temp9 ,temp10 ,temp11 ,temp12) + (load-constant ,temp5 #xf800 "EQ-NOT-EQL mask") + (stack-read2 iSP ,obj-tag ,obj-data :tos-valid t) + (stack-read2 arg1 ,car-tag ,car-data :signed t) + (TagType ,obj-tag ,obj-tag "Get the object type bits") + (SRD ,temp5 ,temp5 ,obj-tag "Low bit will set iff EQ-NOT-EQL") + (TagType ,car-tag ,car-tag "Strip cdr code") + (clrldi ,car-data ,car-data 32 "Remove sign-extension") + (ANDI-DOT R31 ,temp5 1 "BLBS") + (BC 4 2 ,exceptionlabel) + (clr ,temp6) + (B ,enter) + (label ,nextlabel) + ,@(ecase loopstep + (CDR `(#+list-inline + (cdr-internal ,cdr-tag ,cdr-data ,instruction ,vma ,temp5 ,temp6 ,temp7 ,temp8) ;cddr of init + #-list-inline + (call-subroutine |CdrInternal|))) + ((NIL) ())) + (LD ,temp6 PROCESSORSTATE_STOP_INTERPRETER (ivory) "Have we been asked to stop or trap?") + (comment "Move cdr to car for next carcdr-internal") + (TagType ,cdr-tag ,car-tag) + (mov ,car-data ,cdr-data) + (label ,enter) + ,@looptop + (ADDI ,temp5 ,car-tag #.(- |type$K-NIL|)) + (branch-if-nonzero ,temp6 ,break "Asked to stop, check for sequence break") + (branch-if-zero ,temp5 ,end) + #+list-inline (carcdr-internal ,car-tag ,car-data ,cdr-tag ,cdr-data ,instruction ,vma ,temp5 ,temp6 ,temp7 ,temp8) + #-list-inline (call-subroutine |CarCdrInternal|) + ,@loopbody + (label ,end) + ,@loopend + (label ,exceptionlabel) + (prepare-exception ,instruction 0) + (instruction-exception)))) + +;;; Fin diff --git a/g5-emulator/imacloop.lisp b/g5-emulator/imacloop.lisp new file mode 100644 index 0000000..d20d9ed --- /dev/null +++ b/g5-emulator/imacloop.lisp @@ -0,0 +1,127 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of branch instructions. These are mostly in IFUNLOOP.PPCS +;;; Branch and loop instructions. + +(defmacro ibranchcond (invertp popp elsepopp extrapopp brielab) + "Expects to be called as :10-bit-signed-immediate :own-immediate t" + (let ((dolab (intern (format nil "DoBr~a~a~a~a" + (if invertp "n" "") + (if popp "Pop" "") + (if elsepopp "ElsePop" "") + (if extrapopp "ExtraPop" "")))) + (popbr (+ (if popp 1 0) (if extrapopp 1 0))) ;pops if branch taken + (popnbr (+ (if elsepopp 1 0) (if extrapopp 1 0)))) ;pops if taken NOT! + `(;; branch offset in arg1. + (srdi t1 arg6 32 "Check tag of word in TOS.") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LD arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (SRADI arg1 arg3 48 "Get signed 10-bit immediate arg") + (TagType t1 t1 "strip the cdr code off.") + (ADDI t1 t1 #.(- |type$K-NIL|) "Compare to NIL") + ,@(if (> popnbr 0) + `((,(if invertp 'branch-if-zero 'branch-if-nonzero) t1 ,dolab) + (comment "Here if branch not taken. Pop the argument.") + (GetNextPCandCP) + (ADDI iSP iSP ,(- (* 8 popnbr))) + (ContinueToNextInstruction-NoStall) + (label ,dolab "Here to take the branch")) + `((,(if invertp 'branch-if-nonzero 'branch-if-zero) t1 NextInstruction))) + (branch-if-zero arg1 ,brielab "Can't branch to ourself") + ,@(if (> popbr 0) `((ADDI iSP iSP ,(- (* 8 popbr))))) + (ADD iPC iPC arg1 "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (branch-if-nonzero arg2 interpretInstructionPredicted) + (passthru "#endif") + (B interpretInstructionForBranch)))) + +(defmacro iloop-decrement-tos () + (let ((tag 't1) ;just for readability. + (data 't2) + (exception (gensym)) + (notnumeric (gensym)) + (overflow (gensym))) + `((srdi ,tag arg6 32) + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LD arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (exts ,data arg6 32 "32 bit sign extended data") + (CheckDataType ,tag |TypeFixnum| ,exception t3) + (ADDI t3 ,data -1) + (CMP 0 1 ,data t3) + (BC 12 0 ,overflow "B. if overflow") ; B. if data < t3 + (stack-write-ir |TypeFixnum| t3 t6) + (branch-if-less-than-or-equal-to-zero t3 NextInstruction) + (comment "Here if branch taken.") + (ADD iPC iPC arg1 "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (branch-if-nonzero arg2 interpretInstructionPredicted) + (passthru "#endif") + (B interpretInstructionForBranch) + (label ,exception) + (CheckAdjacentDataTypes ,tag |TypeFixnum| 8 ,notnumeric t3) + (label ,overflow) + ;; Exception handler is uses the branch target as next-pc (to + ;; set in continuation) + (ADD arg5 iPC arg1 "Compute next-pc") + (prepare-exception loop-decrement-tos 0) + (external-branch loopexception) + (label ,notnumeric) + (illegal-operand unary-arithmetic-operand-type-error)))) + + +(defmacro iloop-increment-tos-less-than () + (let ((tag 't1) ;just for readability. + (data 't2) + (tag2 't3) + (data2 't4) + (exception1 (gensym)) + (exception2 (gensym)) + (overflow (gensym)) + (notnumeric (gensym))) + `((srdi ,tag arg6 32) + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (LD arg2 CACHELINE_ANNOTATION (iCP)) + (passthru "#endif") + (clrldi ,data arg6 32) + (CheckDataType ,tag |TypeFixnum| ,exception1 t5) + (stack-read2-disp iSP -8 ,tag2 ,data2 "Get arg1.") + (CheckDataType ,tag2 |TypeFixnum| ,exception2 t5) + (exts t5 ,data 32) + (ADDI t5 t5 1) ;t5=signextend(,data)+1 + (CMP 0 1 ,data t5 "CMPLE") ;LT=0 GT=1 EQ=2 + (BC 12 1 ,overflow) + (stack-write-ir |TypeFixnum| t5 t6) + (CMP 0 1 t5 ,data2 "CMPLE") + (BC 12 1 NextInstruction) + (comment "Here if branch taken.") + (force-alignment) + (ADD iPC iPC arg1 "Update the PC in halfwords") + ;; Cache metering steals ANNOTATION from us + (passthru "#ifndef CACHEMETERING") + (branch-if-nonzero arg2 interpretInstructionPredicted) + (passthru "#endif") + (B interpretInstructionForBranch) + (label ,exception1) + (CheckAdjacentDataTypes ,tag |TypeFixnum| 8 ,notnumeric t5) + (label ,exception2) + (CheckAdjacentDataTypes ,tag2 |TypeFixnum| 8 ,notnumeric t5) + (label ,overflow) + ;; Exception handler is uses the branch target as next-pc (to + ;; set in continuation) + (ADD arg5 iPC arg1 "Compute next-pc") + (prepare-exception loop-increment-tos-less-than 0) + (external-branch loopexception) + (label ,notnumeric) + (illegal-operand binary-arithmetic-operand-type-error)))) + + +;;; Fin. diff --git a/g5-emulator/imacmath.lisp b/g5-emulator/imacmath.lisp new file mode 100644 index 0000000..f19caf3 --- /dev/null +++ b/g5-emulator/imacmath.lisp @@ -0,0 +1,718 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of arithmetic instructions. These are mostly in IFUNMATH.PPCS + +;;; Prepares to check for an exception before execution of some floating point instructions +(defmacro floating-exception-checking-prelude () + #-ignore + `((comment)) + #+ignore + `((FSUB f31 f31 f31) + (MTFSF #xFF f31 "Turn off all floating-point exception flags") + (MTFSFI 6 #xF "Enable all floating-point exceptions except inexact"))) + +;;; Checks for an exception after execution of some floating point instructions +(defmacro floating-exception-checking-postlude (exc temp) + (declare (ignore exc temp)) + #-ignore + `((comment)) + #+ignore + `((MFFS f31 "Force exceptions to occur here") + (MTFSFI 6 0 "Disable all floating-point exceptions"))) + +;;; Checks for a floating point exception by combining the above two macros +(defmacro with-floating-exception-checking ((exc temp) &body body) + `((floating-exception-checking-prelude) + ,@body + (floating-exception-checking-postlude ,exc ,temp))) + +;;; Sets the rounding mode for subsequent floating-point operations +(defmacro set-rounding-mode (mode &optional comment) + (declare (ignore comment)) + (ecase mode + (:exact + `((MTFSB1 28 "Trap on inexact results") + (MTFSB0 30 "Round towards nearest") + (MTFSB0 31))) + (:nearest + `((MTFSB0 28) + (MTFSB0 30 "Round towards nearest") + (MTFSB0 31))) + (:zero + `((MTFSB0 28) + (MTFSB0 30 "Round towards zero") + (MTFSB1 31))) + (:+-infinity + `((MTFSB0 28) + (MTFSB1 30 "Round towards +infinity") + (MTFSB0 31))) + (:--infinity + `((MTFSB0 28) + (MTFSB1 30 "Round towards -infinity") + (MTFSB1 31))))) + +;;; Branches if IEEE + infinity , - infinity, or NAN +(defmacro CheckFloatingOverflow (val exc temp) + `((srdi ,temp ,val 23) + (ANDI-DOT ,temp ,temp #xFF) ;+++ a test from ivorystate needed + (ADDI ,temp ,temp #.(- #xFF)) + (branch-if-zero ,temp ,exc))) + +(defmacro CheckBinaryFloatingOverflow (val1 val2 exc temp1 temp2) + `((srdi ,temp1 ,val1 23) + (srdi ,temp2 ,val2 23) + (ANDI-DOT ,temp1 ,temp1 #xFF) + (XORI ,temp1 ,temp1 #xFF) + (ANDI-DOT ,temp2 ,temp2 #xFF) + (branch-if-zero ,temp1 ,exc) + (XORI ,temp2 ,temp2 #xFF) + (branch-if-zero ,temp2 ,exc))) + +;;; Branches if NAN. +(defmacro CheckNotNan (val exc temp) + `((srdi ,temp ,val 22) + (ADDI ,temp ,temp -511) + (branch-if-zero ,temp ,exc))) + + +;; Implements rounding for division operators that return two values +(defmacro DoDivisionRounding (quotient remainder op2 direction temp temp2) + (let ((resultrounded (gensym))) + `(,@(unless (eql direction :truncate) + `((branch-if-zero ,remainder ,resultrounded "done if no rounding required") + (exts ,temp2 ,op2 32 "Sign extend ARG2") + (SRADI ,temp ,remainder 63 "=0 if rem>=0, -1 otherwise") + (SRADI ,temp2 ,temp2 63 "=0 if ARG2>=0, -1 otherwise") + (XOR ,temp2 ,temp ,temp2))) + ,@(ecase direction + (:up + `((branch-if-nonzero ,temp2 ,resultrounded) + (ADDI ,quotient ,quotient 1 "round towards + infinity") + (subfw ,remainder ,op2 ,remainder ,temp2))) + (:down + `((branch-if-zero ,temp2 ,resultrounded) + (ADDI ,quotient ,quotient -1 "round towards -infinity") + (addw ,remainder ,remainder ,op2 ,temp2) + )) + (:truncate)) + ,@(unless (eql direction :truncate) + `((label ,resultrounded))) + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| ,quotient ,temp) + (stack-push-ir |TypeFixnum| ,remainder ,temp) + (ContinueToNextInstruction-NoStall)))) + +(defmacro DoFloatingDivisionRounding (quotient remainder op2 direction overflow + temp temp2 ftemp) + (let ((resultrounded (gensym))) + `(,@(unless (lisp:or (eql direction :truncate) (eql direction :round)) + `((FSUB f31 f31 f31) + (FCMPO 0 ,remainder f31 "FBEQ") + (BC 12 2 ,resultrounded "done if no rounding required") + (FCMPO 0 f31 ,remainder) + (MFCR ,temp "CR.LT=1 or CR.EQ=1 if rem>=0") + (ANDIS-DOT ,temp ,temp #xE000 "Isolate CR0") + (FCMPO 0 f31 ,op2) + (MFCR ,temp2 "CR.LT=1 or CR.EQ=1 if ARG2>=0") + (ANDIS-DOT ,temp2 ,temp2 #xE000 "Isolate CR0") + (LFS ,ftemp PROCESSORSTATE_SFP1 (ivory) "constant 1.0") + (XOR ,temp2 ,temp ,temp2))) + ,@(ecase direction + (:up + `((branch-if-nonzero ,temp2 ,resultrounded) + (FADDS ,quotient ,ftemp ,quotient "round towards + infinity") + (FSUBS ,remainder ,op2 ,remainder))) + (:down + `((branch-if-zero ,temp2 ,resultrounded) + (FSUBS ,quotient ,ftemp ,quotient "round towards -infinity") + (FADDS ,remainder ,op2 ,remainder))) + (:truncate) + (:round)) + ,@(unless (lisp:or (eql direction :truncate) (eql direction :round)) + `((label ,resultrounded))) + ,(if (eql direction :round) + `(set-rounding-mode :nearest "round normally") + `(set-rounding-mode :zero "chop off to integer")) + (FCTID ,ftemp ,quotient) + (STFD ,ftemp PROCESSORSTATE_FP0 (ivory)) + (LD ,temp2 PROCESSORSTATE_FP0 (ivory)) + (set-rounding-mode :nearest "round normally") + (exts ,temp ,temp2 32) + (SUBF ,temp ,temp2 ,temp "Did we overflow into bignums?") + (branch-if-nonzero ,temp ,overflow) + (GetNextPCandCP) + (stack-write-ir |TypeFixnum| ,temp2 ,temp) + (fp-stack-push-ir |TypeSingleFloat| ,remainder ,temp) + (ContinueToNextInstruction-NoStall)))) + + +(defmacro cons-double-float-internal (hi lo area vma temp1 temp2 temp3 temp4 temp5 temp6) + "Conses the double-float in PROCESSORSTATE_FP0 into DEFAULT-CONS-AREA; + returns cons in VMA" + (check-temporaries (hi lo area vma) (temp1 temp2 temp3 temp4 temp5 temp6)) + (let ((exception (gensym))) + ;; On any problems, trap out and do things the hard way + (push `((label ,exception) + (NumericTypeException |TypeDoubleFloat| ADD)) + *function-epilogue*) + `((LWA ,lo processorstate_fp0+4 (Ivory)) + (LWA ,hi processorstate_fp0 (Ivory)) + (cons-internal |TypeFixnum| ,hi |TypeFixnum| ,lo ,area + ,exception ,vma + ,temp1 ,temp2 ,temp3 ,temp4 ,temp5 ,temp6)))) + +(defmacro fetch-double-float-internal (vma tag data temp5 temp6 temp7 temp8) + "Fetches a double float at ADDRESS into PROCESSORSTATE_FP0; callee can + then load the float into the appropriate float register" + (check-temporaries (vma tag data) (temp5 temp6 temp7 temp8)) + (let ((exception (gensym))) + ;; On any problems, trap out and do things the hard way + (push `((label ,exception) + (NumericTypeException |TypeDoubleFloat| ADD)) + *function-epilogue*) + ;; --- If we had a special double-float area that we knew to always + ;; be aligned, we could optimize more; Even barring that, the + ;; consecutive memory-reads should/could be merged to load a single tag + ;; word (where possible)? Same could apply to car/cdr !?!? + `((memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,tag |TypeFixnum| ,exception ,temp5) + (STW ,data processorstate_fp0 (Ivory)) + (ADDI ,vma ,vma 1) + (memory-read ,vma ,tag ,data PROCESSORSTATE_DATAREAD ,temp5 ,temp6 ,temp7 ,temp8 nil t) + (CheckDataType ,tag |TypeFixnum| ,exception ,temp5) + (STW ,data processorstate_fp0+4 (Ivory)) + ;; (ldt ,float-register processorstate_fp0 (Ivory)) + ))) + +;;; This macro must be used with care because it assumes the arg OK before +;;; checking in order get dual issue on the non fail case. +(defmacro with-simple-binary-fixnum-operation ((data1 data2 ar tag1 tag2 temp1 temp2 + &optional inst arg1-signed arg2-signed) + &body body) + (check-temporaries (data1 data2 ar tag1 tag2) (temp1 temp2)) + (let ((iolab (gensym)) + (doit (gensym))) + `((label ,doit) + (stack-read-tag iSP ,tag1 "Arg1 on the stack" :tos-valid t) + (PrefetchNextPC ,temp1) + (stack-read-data iSP ,data1 "Arg1 on the stack" :tos-valid t :signed ,arg1-signed) + (stack-read-tag arg1 ,tag2 "Arg2 from operand") + (ANDI-DOT ,tag1 ,tag1 #x3F "Strip CDR code if any.") + (stack-read-data arg1 ,data2 "Arg2 from operand" :signed t) + (ADDI ,tag1 ,tag1 #.(- |type$K-fixnum|)) + (PrefetchNextCP ,temp2) + (ANDI-DOT ,tag2 ,tag2 #x3F "Strip CDR code if any.") + (branch-if-nonzero ,tag1 ,iolab) + ,@(unless arg2-signed + `((clrldi ,data2 ,data2 0))) + (ADDI ,tag2 ,tag2 #.(- |type$K-fixnum|)) + (force-alignment) + (branch-if-nonzero ,tag2 ,iolab) + ,@body ;assume args ok to get di. + (force-alignment) + (SetNextPC ,temp1) + ;; --- don't need to rewrite tag, to clear cdr? + (stack-write-data iSP ,ar "Put the result back on the stack") + (SetNextCP ,temp2) + (ContinueToNextInstruction-NoStall) + (immediate-handler ,inst) + ,@(when arg2-signed + `((exts arg2 arg2 8 "Sign extend the byte argument"))) + (STW arg2 PROCESSORSTATE_IMMEDIATE_ARG+4 (Ivory)) + (ADDI arg1 Ivory PROCESSORSTATE_IMMEDIATE_ARG) + (B ,doit) + (label ,iolab) + (illegal-operand two-operand-fixnum-type-error)))) + + +;; Note well: this is counting on being used in the kludge :OPERAND-FROM-STACK +;; mode with :OWN-IMMEDIATE T! +(defmacro simple-binary-arithmetic-operation (inst opfn opflt &optional (ovflow (gensym))) + (let ((opfn (lisp:or (cdr (assoc opfn '((MULLW . MULLWO) (DIVW . DIVWO)))) + opfn)) + (dofloat (gensym)) + (dodouble (gensym)) + (opdouble (lisp:or (cdr (assoc opflt '((FADDS . FADD) (FSUBS . FSUB) + (FMULS . FMUL) (FDIV . FDIVS)))) + opflt)) + (doublesingle (gensym)) + (singledouble (gensym)) + (loaddoubleop2 (gensym)) + (invert? (member opfn '(SUBF))) + (manual-overflow? (member opfn '(ADD SUBF))) + ;; Mnemonics + (op1-tag 't1) + (op1-data 't2) + (op2-tag 't3) + (op2-data 't4) + (result-data 't5) + (next-pc 't6) + (next-cp 't7) + (temp1 't8) + (temp2 't9) + (temp3 't10) + (temp4 't11) + (temp5 't12) + (result-float-data 'f0) + (op1-float-data 'f1) + (op2-float-data 'f2)) + `((stack-read-data iSP ,op1-float-data :floating t :tos-valid t) + (stack-read-tag iSP ,op1-tag "ARG1 tag" :tos-valid t) + (stack-read-tag arg1 ,op2-tag "ARG2 tag") + (stack-read-data iSP ,op1-data "ARG1 data" :signed t :tos-valid t) + (stack-read-data arg1 ,op2-data "ARG2 data" :signed t) + (stack-read-data arg1 ,op2-float-data :floating t :tos-valid t) + (floating-exception-checking-prelude) + (binary-type-dispatch (,op1-tag ,op2-tag ,temp2 ,temp3 ,temp4 ,temp5) + ((|TypeFixnum| |TypeFixnum|) + (PrefetchNextPC ,next-pc) + ,@(if invert? + `((,opfn ,result-data ,op2-data ,op1-data "compute 64-bit result")) + `((,opfn ,result-data ,op1-data ,op2-data "compute 64-bit result"))) + (PrefetchNextCP ,next-cp) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + ,@(if manual-overflow? + `((EXTSW ,temp1 ,result-data "compute 32-bit sign-extended result") + (CMP 0 1 ,result-data ,temp1 "Is it the same as 64-bit result?") + (BC 4 2 ,ovflow "if not, we overflowed")) + `((MFSPR ,temp1 1 "Copy XER") + (ANDIS-DOT ,temp1 ,temp1 #x4000 "Mask off all but XER.OV") + (BC 4 2 ,ovflow "Jump if hardware detected overflow"))) + (stack-write-tag iSP ,temp2 "Semi-cheat, we know temp2 has CDRNext/TypeFixnum") + (SetNextPC ,next-pc) + (stack-write-data iSP ,result-data) + (SetNextCP ,next-cp) + (ContinueToNextInstruction-NoStall)) + ((|TypeSingleFloat| |TypeSingleFloat|) + (label ,dofloat) + (,opflt ,result-float-data ,op1-float-data ,op2-float-data) + (floating-exception-checking-postlude nil ,temp1) + (GetNextPCandCP) + ;; Can't use cheat as above, since may come here from mixed case + (fp-stack-write-ir |TypeSingleFloat| ,result-float-data ,temp1) + (ContinueToNextInstruction-NoStall)) + ((|TypeFixnum| |TypeSingleFloat|) + (EXTSW ,op1-data ,op1-data) + (STD ,op1-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op1-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op1-float-data ,op1-float-data) + (B ,dofloat)) + ((|TypeSingleFloat| |TypeFixnum|) + (EXTSW ,op2-data ,op2-data) + (STD ,op2-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op2-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op2-float-data ,op2-float-data) + (B ,dofloat)) + ((|TypeDoubleFloat| |TypeDoubleFloat|) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (clrldi arg2 ,op1-data 32) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (call-subroutine |FetchDoubleFloat|) + (lfd ,op1-float-data processorstate_fp0 (Ivory)) + (label ,loaddoubleop2) + (clrldi arg2 ,op2-data 32) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (call-subroutine |FetchDoubleFloat|) + (lfd ,op2-float-data processorstate_fp0 (Ivory))) + (label ,dodouble) + (,opdouble ,result-float-data ,op1-float-data ,op2-float-data) + (STFD ,result-float-data processorstate_fp0 (Ivory)) + ;; N.B.! ConsDoubleFloat inserts the TRAPB just before it + ;; actually conses, for fewer stalls + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 (result-data .. temp4) + (call-subroutine |ConsDoubleFloat|) + (GetNextPCandCP) + ;; Can't use cheat as above, since may come here from mixed case + (stack-write-ir |TypeDoubleFloat| arg2 ,temp1) + (ContinueToNextInstruction-NoStall)) + ((|TypeSingleFloat| |TypeDoubleFloat|) + ;; S is converted to T on fetch + (label ,singledouble) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (b ,loaddoubleop2))) + ((|TypeFixnum| |TypeDoubleFloat|) + (EXTSW ,op1-data ,op1-data) + (STD ,op1-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op1-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op1-float-data ,op1-float-data) + (b ,singledouble)) + ((|TypeDoubleFloat| |TypeSingleFloat|) + ;; S is converted to T on fetch + (label ,doublesingle) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (clrldi arg2 ,op1-data 32) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (call-subroutine |FetchDoubleFloat|) + (lfd ,op1-float-data processorstate_fp0 (Ivory)) + (b ,dodouble))) + ((|TypeDoubleFloat| |TypeFixnum|) + (EXTSW ,op2-data ,op2-data) + (STD ,op2-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op2-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op2-float-data ,op2-float-data) + (b ,doublesingle)) + (:else1 + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst)) + (:else2 + (mov ,op1-tag ,op2-tag) + (B ,ovflow)))))) + +(defmacro simple-binary-immediate-arithmetic-operation (name opfn &optional sign-extend-immp (ovflow (gensym))) + (let ((opfn (lisp:or (cdr (assoc opfn '((MULLW . MULLWO) (DIVW . DIVWO)))) + opfn)) + (invert? (member opfn '(SUBF))) + (manual-overflow? (member opfn '(ADD SUBF))) + ;; Mnemonics + (immediate-data 'arg2) + (op1-tag 't1) + (op1-data 't2) + (result-data 't3) + (next-pc 't4) + (next-cp 't5) + (temp1 't10) + (temp2 't11) + (temp3 't12)) + `(,@(if sign-extend-immp `((exts ,immediate-data ,immediate-data 8))) + (stack-read2-signed iSP ,op1-tag ,op1-data "get ARG1 tag/data" :tos-valid t) + (type-dispatch ,op1-tag ,temp2 ,temp3 + (|TypeFixnum| + ;; Handle fixnum-immediate case optimally + ,@(if invert? + `((,opfn ,result-data ,immediate-data ,op1-data "compute 64-bit result")) + `((,opfn ,result-data ,op1-data ,immediate-data "compute 64-bit result"))) + (PrefetchNextPC ,next-pc) + ,@(if manual-overflow? + `((EXTSW ,temp1 ,result-data "compute 32-bit sign-extended result") + (CMP 0 1 ,result-data ,temp1 "Is it the same as 64-bit result?") + (BC 4 2 ,ovflow "if not, we overflowed")) + `((MFSPR ,temp1 1 "Copy XER") + (ANDIS-DOT ,temp1 ,temp1 #x4000 "Mask off all but XER.OV") + (BC 4 2 ,ovflow "Jump if hardware detected overflow"))) + (PrefetchNextCP ,next-cp) + (stack-write-tag iSP ,temp2 "Semi-cheat, we know temp2 has CDRNext/TypeFixnum") + (SetNextPC ,next-pc) + (stack-write-data iSP ,result-data) + (SetNextCP ,next-cp) + (ContinueToNextInstruction-NoStall)) + (:else + ;; Otherwise simulate immediate arg and branch to normal body + (STW ,immediate-data PROCESSORSTATE_IMMEDIATE_ARG+4 (Ivory)) + (ADDI arg1 Ivory PROCESSORSTATE_IMMEDIATE_ARG) + (clr arg2) + (B ,(format nil "begin~a" name))))))) + + +(defmacro binary-arithmetic-division-prelude (inst) + "Loads any mixture of float, single, double into F1 and F2 as T + floats, in preparation for a division operation" + (let ((done (gensym)) + (doublesingle (gensym)) + (singledouble (gensym)) + (loaddoubleop2 (gensym)) + (ovflow (gensym)) + ;; Mnemonics + (op1-tag 't1) + (op1-data 't2) + (op2-tag 't3) + (op2-data 't4) + (temp2 't9) + (temp3 't10) + (temp4 't11) + (temp5 't12) + (op1-float-data 'f1) + (op2-float-data 'f2) + ) + `((stack-read-data iSP ,op1-float-data :floating t :tos-valid t) + (stack-read-data iSP ,op1-data "ARG1 data" :signed t :tos-valid t) + (stack-read-data arg1 ,op2-data "ARG2 data" :signed t) + (stack-read-tag iSP ,op1-tag "ARG1 tag" :tos-valid t) + (stack-read-tag arg1 ,op2-tag "ARG2 tag") + (stack-read-data arg1 ,op2-float-data :floating t :tos-valid t) + ;; Convert both args to T floats + (binary-type-dispatch (,op1-tag ,op2-tag ,temp2 ,temp3 ,temp4 ,temp5) + ((|TypeFixnum| |TypeFixnum|) + (EXTSW ,op1-data ,op1-data) + (EXTSW ,op2-data ,op2-data) + (STD ,op1-data PROCESSORSTATE_FP0 (Ivory)) + (STD ,op2-data PROCESSORSTATE_FP1 (Ivory)) + (LFD ,op1-float-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op2-float-data PROCESSORSTATE_FP1 (Ivory)) + (FCFID ,op1-float-data ,op1-float-data) + (FCFID ,op2-float-data ,op2-float-data) + ;; fall through + ) + ((|TypeSingleFloat| |TypeSingleFloat|) + ;; S is converted to T on fetch + ,done) + ((|TypeFixnum| |TypeSingleFloat|) + (EXTSW ,op1-data ,op1-data) + (STD ,op1-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op1-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op1-float-data ,op1-float-data) + (b ,done)) + ((|TypeSingleFloat| |TypeFixnum|) + (mov ,op2-tag ,op1-tag "contagion") + (EXTSW ,op2-data ,op2-data) + (STD ,op2-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op2-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op2-float-data ,op2-float-data) + (b ,done)) + ((|TypeDoubleFloat| |TypeDoubleFloat|) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (clrldi arg2 ,op1-data 32) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (call-subroutine |FetchDoubleFloat|) + (lfd ,op1-float-data processorstate_fp0 (Ivory)) + (label ,loaddoubleop2) + (clrldi arg2 ,op2-data 32) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (call-subroutine |FetchDoubleFloat|) + (lfd ,op2-float-data processorstate_fp0 (Ivory))) + (b ,done)) + ((|TypeSingleFloat| |TypeDoubleFloat|) + ;; S is converted to T on fetch + (label ,singledouble) + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (b ,loaddoubleop2))) + ((|TypeFixnum| |TypeDoubleFloat|) + (EXTSW ,op1-data ,op1-data) + (STD ,op1-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op1-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op1-float-data ,op1-float-data) + (b ,singledouble)) + ((|TypeDoubleFloat| |TypeSingleFloat|) + ;; S is converted to T on fetch + (label ,doublesingle) + (mov ,op2-tag ,op1-tag "contagion") + (with-multiple-memory-reads (t9 t10 t11 t12) ;temps 2-5 + (clrldi arg2 ,op1-data 32) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 (result-data .. temp1) + (call-subroutine |FetchDoubleFloat|) + (lfd ,op1-float-data processorstate_fp0 (Ivory))) + (b ,done)) + ((|TypeDoubleFloat| |TypeFixnum|) + (EXTSW ,op2-data ,op2-data) + (STD ,op2-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op2-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op2-float-data ,op2-float-data) + (b ,doublesingle)) + (:else1 + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst)) + (:else2 + (mov ,op1-tag ,op2-tag) + (B ,ovflow))) + (label ,done)))) + +(defmacro binary-arithmetic-two-value-division-operation (rounding) + "Expects op1 and op2 as T floats in F1 and F2, op2-tag in T3 directs + the conversion of the remainder" + (let (;; Mnemonics + (op2-tag 't3) + (temp1 't8) + (temp2 't9) + (result-float-data 'f0) + (op1-float-data 'f1) + (op2-float-data 'f2) + (remainder-float-data 'f3)) + `((FDIV ,result-float-data ,op1-float-data ,op2-float-data) + ,@(ecase rounding + (:rational + ;; Any rounding is an exception for :rational mode + `((set-rounding-mode :exact "Set the rounding mode") + (FCTID-DOT ,result-float-data ,result-float-data))) + (:truncate + `((set-rounding-mode :zero "Set the rounding mode") + (FCTID-DOT ,result-float-data ,result-float-data))) + (:up + `((set-rounding-mode :+-infinity "Set the rounding mode") + (FCTID-DOT ,result-float-data ,result-float-data))) + (:down + `((set-rounding-mode :--infinity"Set the rounding mode") + (FCTID-DOT ,result-float-data ,result-float-data))) + (:round + `((set-rounding-mode :nearest "Set the rounding mode") + (FCTID-DOT ,result-float-data ,result-float-data)))) + (set-rounding-mode :nearest "round normally") + (FCFID ,remainder-float-data ,result-float-data) + (FMUL ,remainder-float-data ,op2-float-data ,remainder-float-data) + (FSUB ,remainder-float-data ,op1-float-data ,remainder-float-data) + (FCFID ,result-float-data ,result-float-data) + (FCTIW-DOT ,result-float-data ,result-float-data) + (type-dispatch ,op2-tag ,temp1 ,temp2 + (|TypeFixnum| + (FCTIW ,remainder-float-data ,remainder-float-data) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating :fixed) + (stack-push-ir |TypeFixnum| ,remainder-float-data ,temp1 :floating :fixed)) + (|TypeSingleFloat| + (FRSP ,remainder-float-data ,remainder-float-data) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating :fixed) + (stack-push-ir |TypeSingleFloat| ,remainder-float-data ,temp1 :floating t)) + (|TypeDoubleFloat| + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (STFD ,remainder-float-data processorstate_fp0 (Ivory)) + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 (result-data .. temp4) + (call-subroutine |ConsDoubleFloat|) + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating :fixed) + (stack-push-ir |TypeDoubleFloat| arg2 ,temp1))) + (GetNextPCandCP) + (ContinueToNextInstruction-NoStall)))) + +(defmacro binary-arithmetic-one-value-division-operation (rounding) + "Expects op1 and op2 as T floats in F1 and F2, op2-tag in T3 directs + the conversion of the quotient" + (let (;; Mnemonics + (op2-tag 't3) + (temp1 't8) + (temp2 't9) + (result-float-data 'f0) + (op1-float-data 'f1) + (op2-float-data 'f2) +; (remainder-float-data 'f3) + ) + `((type-dispatch ,op2-tag ,temp1 ,temp2 + (|TypeFixnum| + (FDIV ,result-float-data ,op1-float-data ,op2-float-data) + ,@(ecase rounding + (:rational + ;; Any rounding is an exception for :rational mode + `((set-rounding-mode :exact "Set the rounding mode") + (FCTIW-DOT ,result-float-data ,result-float-data))) + (:truncate + `((set-rounding-mode :zero "Set the rounding mode") + (FCTIW-DOT ,result-float-data ,result-float-data))) + (:up + `((set-rounding-mode :+-infinity "Set the rounding mode") + (FCTIW-DOT ,result-float-data ,result-float-data))) + (:down + `((set-rounding-mode :--infinity "Set the rounding mode") + (FCTIW-DOT ,result-float-data ,result-float-data))) + (:round + `((set-rounding-mode :nearest "Set the rounding mode") + (FCTIW-DOT ,result-float-data ,result-float-data)))) + (set-rounding-mode :nearest "round normally") + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeFixnum| ,result-float-data ,temp1 :floating :fixed) + ) + (|TypeSingleFloat| + (FDIVS ,result-float-data ,op1-float-data ,op2-float-data) + (floating-exception-checking-postlude nil ,temp1) ;Ensure traps complete + (stack-write-ir |TypeSingleFloat| ,result-float-data ,temp1 :floating t)) + (|TypeDoubleFloat| + (FDIV ,result-float-data ,op1-float-data ,op2-float-data) + (STFD ,result-float-data processorstate_fp0 (Ivory)) + ;; Cons does the exception-checking before consing... + ;; Uses arg2 arg5 arg6 t5 t6 t7 t8 t9 t10 (result-data .. temp4) + (call-subroutine |ConsDoubleFloat|) + (stack-write-ir |TypeDoubleFloat| arg2 ,temp1))) + (GetNextPCandCP) + (ContinueToNextInstruction-NoStall)))) + +;; Note well: this is counting on being used in the kludge :OPERAND-FROM-STACK +;; mode with :OWN-IMMEDIATE T! +(defmacro simple-binary-minmax (inst &optional (ovflow (gensym))) + (let ((instn (if (eq inst 'max) 0 1)) ;'CMOVGT 'CMOVLT + (finstn (if (eq inst 'max) 0 1)) ;'FCMOVGT 'FCMOVLT + (dofloat (gensym)) + (sk1 (gensym)) + (sk2 (gensym)) + ;; Mnemonics + (op1-tag 't1) + (op1-data 't2) + (op2-tag 't3) + (op2-data 't4) + (temp1 't8) + (temp2 't9) + (temp3 't10) + (temp4 't11) + (temp5 't12) + (op1-float-data 'f1) + (op2-float-data 'f2)) + `((stack-read-data iSP ,op1-float-data :floating t :tos-valid t) + (stack-read-tag iSP ,op1-tag "ARG1 tag" :tos-valid t) + (stack-read-tag arg1 ,op2-tag "ARG2 tag") + (stack-read-data iSP ,op1-data "ARG1 data" :signed t :tos-valid t) + (stack-read-data arg1 ,op2-data "ARG2 data" :signed t) + (stack-read-data arg1 ,op2-float-data :floating t :tos-valid t) + (binary-type-dispatch (,op1-tag ,op2-tag ,temp2 ,temp3 ,temp4 ,temp5) + ((|TypeFixnum| |TypeFixnum|) + (GetNextPC) + (CMP 0 1 ,op2-data ,op1-data) + (BC 4 ,instn ,sk1) + (mov ,op2-data ,op1-data) + (label ,sk1) + (GetNextCP) + (stack-write2 iSP ,temp2 ,op2-data "We know temp2 has CDRNext/TypeFixnum") + (ContinueToNextInstruction-NoStall)) + ((|TypeSingleFloat| |TypeSingleFloat|) + (label ,dofloat) + (floating-exception-checking-prelude) + (GetNextPC) + (FCMPO 0 ,op2-float-data ,op1-float-data) + (BC 4 ,finstn ,sk2) + (FMR ,op2-float-data ,op1-float-data) + (label ,sk2) + (GetNextCP) + (floating-exception-checking-postlude ,ovflow ,temp1) + ;; Can't use cheat as above, since may come here from mixed case + (fp-stack-write-ir |TypeSingleFloat| ,op2-float-data ,temp1) + (ContinueToNextInstruction-NoStall)) + ((|TypeFixnum| |TypeSingleFloat|) + (EXTSW ,op1-data ,op1-data) + (STD ,op1-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op1-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op1-float-data ,op1-float-data) + (FRSP ,op1-float-data ,op1-float-data) + (B ,dofloat)) + ((|TypeSingleFloat| |TypeFixnum|) + (EXTSW ,op2-data ,op2-data) + (STD ,op2-data PROCESSORSTATE_FP0 (Ivory)) + (LFD ,op2-float-data PROCESSORSTATE_FP0 (Ivory)) + (FCFID ,op2-float-data ,op2-float-data) + (FRSP ,op2-float-data ,op2-float-data) + (B ,dofloat)) + (:else1 + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst)) + (:else2 + (mov ,op1-tag ,op2-tag) + (B ,ovflow)))))) + +(defmacro simple-binary-immediate-minmax (inst + &optional sign-extend-immp (ovflow (gensym) o-p)) + (let ((instn (if (eq inst 'max) 1 0)) ; 'CMOVGT 'CMOVLT + (sk1 (gensym)) + ;; Mnemonics + (immediate-data 'arg2) + (op1-tag 't1) + (op1-data 't2) + (result-data 't3) + (temp2 't11) + (temp3 't12)) + `(,@(if sign-extend-immp `((exts ,immediate-data ,immediate-data 8))) + (stack-read2-signed iSP ,op1-tag ,op1-data "get ARG1 tag/data" :tos-valid t) + (type-dispatch ,op1-tag ,temp2 ,temp3 + (|TypeFixnum| + (SUBF ,result-data ,immediate-data ,op1-data) + (GetNextPC) + (CMP 0 1 ,result-data) + (BC 4 ,instn ,sk1) + (mov ,immediate-data ,op1-data) + (label ,sk1) + (GetNextCP) + (stack-write2 iSP ,temp2 ,immediate-data "We know temp2 has CDRNext/TypeFixnum") + (ContinueToNextInstruction-NoStall)) + ,(if o-p + `(:else-label ,ovflow) + `(:else + (label ,ovflow) + (NumericTypeException ,op1-tag ,inst))))))) + + +;;; Fin. + diff --git a/g5-emulator/imacpred.lisp b/g5-emulator/imacpred.lisp new file mode 100644 index 0000000..b1f4fe0 --- /dev/null +++ b/g5-emulator/imacpred.lisp @@ -0,0 +1,213 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of predicate instructions. These are mostly in IFUNPRED.PPCS + +;; IMOVE is a conditional move instruction, such as CMOVEQ. +;; FBMODE is 12 for branch if true or 4 for branch if false +;; FBRANCH is a floating branch condition, such as 0 (LT) 1 (GT) 2 (EQ). +(defmacro simple-unary-arithmetic-predicate (inst imtst imc fbmode fbranch + &optional long-jump?) + (let ((sk (gensym)) + (tramp (gensym))) + (when long-jump? + (push `((label ,tramp) + (B CacheValid)) + *function-epilogue*)) + `((Get-NIL t11) + (PrefetchNextPC t6) + (stack-read-tag arg1 t1) + (Get-T t12) + (stack-read-data arg1 t2 :signed t) + (stack-read-data arg1 f1 :floating t) + (type-dispatch t1 t4 t5 + (|TypeFixnum| + (SetNextPC t6) + (GetNextCP) + + (CMPI 0 1 t2 0) ; (,imove t2 t12 t11 "T if predicate succeeds") + (BC ,imtst ,imc ,sk) + (mov t11 t12) + (label ,sk) + + (stack-push-with-cdr t11) + (ContinueToNextInstruction-NoStall)) + (|TypeSingleFloat| + (SetNextPC t6) + (stack-push-with-cdr t12) + (GetNextCP) + (FSUB f31 f31 f31) + (FCMPO 0 f1 f31) + ,@(if long-jump? + `((BC ,fbmode ,fbranch ,tramp)) + `((BC ,fbmode ,fbranch cacheValid))) + (stack-write iSP t11 "Didn't branch, answer is NIL") + (ContinueToNextInstruction-NoStall)) + (:else + (UnaryNumericTypeException t1 ,inst)))))) + +;; ITEST is a "combiner", such as SUBF, or AND. +;; IMOVETEST 12 for branch is condition true, 4 for branch is condition false +;; IMOVE is a CR bit to test, 0=LT, 1=GT, 2=EQ +;; FTEST is a floating test function, such as CMPTEQ or CMPTLE. or nil +;; FBV is a CR value 0-7: 4=LT, 2=GT, 1=EQ +;; FBT is 12 for branch if true, 4 for branch if false + +(defmacro simple-binary-arithmetic-predicate + (inst itest imovetest imove ftest fbv fbt &optional sign-extendp excool long-jump?) + (let ((fltcase (intern (format nil "~aFLTFLT" excool))) + (sk (gensym)) + (tramp (gensym))) + (when long-jump? + (push `((label ,tramp) + (B CacheValid)) + *function-epilogue*)) + `((Get-NIL t11) + (srdi t7 arg3 #.(+ 10 2)) + (Get-T t12) + (stack-read-tag iSP arg3 :tos-valid t "Get ARG1 tag") + ,(if sign-extendp + `(stack-read-tag arg1 t1 "t1 is tag of arg2") + ;; Deal with sign-extension below, after stalls + `(stack-read-data arg1 arg2 :signed t)) + (stack-read-data iSP f1 :floating t :tos-valid t) + (ANDI-DOT t7 t7 1) + ;(srdi t1 arg1 32 "t1 is tag of arg2") + ,(if sign-extendp + `(stack-read-data arg1 arg2 :signed t) + `(stack-read-tag arg1 t1 "t1 is tag of arg2")) + (stack-read-data iSP arg4 :signed ,sign-extendp :tos-valid t) + ,@(unless sign-extendp + `((clrldi arg2 arg2 32))) + (stack-read-data arg1 f2 :floating t) + (binary-type-dispatch (arg3 t1 t5 t6 t4 t3) + ((|TypeFixnum| |TypeFixnum|) + (,itest t2 arg2 arg4) + (GetNextPC) + (sldi t5 t7 3) + (ADD iSP t5 iSP "Pop/No-pop") + (GetNextCP) + (CMPI 0 1 t2 0) ;(,imove t2 t12 t11 "T if the test succeeds") + (BC ,imovetest ,imove ,sk) + (mov t11 t12) + (unlikely-label ,sk) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + ,@(when ftest + `(((|TypeSingleFloat| |TypeSingleFloat|) + ;; We're just comparing, no need to check for any of this + ;(floating-exception-checking-prelude) + ;(CheckBinaryFloatingOverflow arg1 arg4 ,exclab1 t2 t5) + ;; Come here to do flt operation when args massaged + ,@(when excool + `((label ,fltcase))) + (FCMPO 0 f1 f2) + (MFCR t3) + (srdi t3 t3 ,(- 32 3) "CR is in low word of register") + (CMPI 0 1 t3 ,fbv) + (floating-exception-checking-postlude nil nil) + (GetNextPC) + (sldi t5 t7 3) + (ADD iSP t5 iSP) + (GetNextCP) + (stack-write iSP t12) + ,@(if long-jump? + `((BC ,fbt 2 ,tramp)) + `((BC ,fbt 2 cacheValid))) + (stack-write iSP t11 "Didn't branch, answer is NIL") + (ContinueToNextInstruction-NoStall)) + )) + ,@(if excool + `((:else + (B ,(format nil "~a" excool)))) + `((:else1 + (NumericTypeException arg3 ,inst)) + (:else2 + (NumericTypeException t1 ,inst)))))))) + +(defmacro simple-binary-arithmetic-exceptions (inst excool version &optional sign-extendp) + (declare (ignore version sign-extendp)) + (let ((fltcase (intern (format nil "~aFLTFLT" excool)))) + `(define-procedure ,(format nil "~a" excool) () + ;; f1 and f2 already loaded, simply convert the fixnum (or + ;; exception) + (binary-type-dispatch (arg3 t1 t5 t6 t4 t3) + ((|TypeFixnum| |TypeSingleFloat|) + (STFD f1 PROCESSORSTATE_FP0 (Ivory)) + (LWA R31 PROCESSORSTATE_FP0+4 (Ivory)) + (STD R31 PROCESSORSTATE_FP0 (Ivory)) + (LFD f1 PROCESSORSTATE_FP0 (Ivory)) + (FCFID f1 f1) + (FRSP f1 f1) + (B ,fltcase)) + ((|TypeSingleFloat| |TypeFixnum|) + (STFD f2 PROCESSORSTATE_FP0 (Ivory)) + (LWA R31 PROCESSORSTATE_FP0+4 (Ivory)) + (STD R31 PROCESSORSTATE_FP0 (Ivory)) + (LFD f2 PROCESSORSTATE_FP0 (Ivory)) + (FCFID f2 f2) + (FRSP f2 f2) + (B ,fltcase)) + (:else1 + (NumericTypeException arg3 ,inst)) + (:else2 + (NumericTypeException t1 ,inst)))))) + +;; ITEST is a "combiner", such as SUBF, or AND. +;; IMOVE is a conditional move instruction, such as CMOVEQ. +(defmacro simple-binary-immediate-arithmetic-predicate + (inst itest imovetest imove &optional sign-extendp) + (let ((sk (gensym))) + `((Get-NIL t11) + (exts arg2 arg2 8 "Sign extend immediate operand") + (Get-T t12) + (srdi t7 arg3 #.(+ 10 2)) + (stack-read2 iSP arg3 arg4 :signed ,sign-extendp :tos-valid t) + (ANDI-DOT t7 t7 1) + (type-dispatch arg3 t3 t4 + (|TypeFixnum| + (,itest t2 arg2 arg4) + (GetNextPC) + (sldi t7 t7 3) + (ADD iSP t7 iSP) + (GetNextCP) + (CMPI 0 1 t2 0) + (BC ,imovetest ,imove ,sk) + (mov t11 t12) + (unlikely-label ,sk) + (stack-write iSP t11) + (ContinueToNextInstruction-NoStall)) + (:else + (NumericTypeException arg3 ,inst)))))) + + +;;; arg2 has 8 bit mask; arg3 is the instruction, the field number is +;;; (byte 4 8) from that, but we want field-number*4; byte (1 12) is popp +(defmacro itypemember () + (let ((sk1 (gensym))) + `((srdi t6 arg3 6 "Position the opcode") + (Get-T t4) + (stack-read-tag iSP arg4 "get op1's tag") + (li t1 1) + (Get-NIL t5) + (srdi t7 arg3 12 "Get pop-bit while stalled") + (ANDI-DOT arg1 t6 #.(dpb -1 (byte 4 2) 0) "Get field-number*4 from the opcode") + (TagType arg4 arg4 "Strip off CDR code.") + (SLD t1 t1 arg4 "T1 is type type code bit position.") + (ANDI-DOT t7 t7 1 "Pop bit") + (SLD t2 arg2 arg1 "t2 is the mask.") + (GetNextPCandCP) + (sldi t7 t7 3) + (ADD iSP t7 iSP) + (AND t3 t2 t1 "t3 is the result.") + (force-alignment) + (CMPI 0 1 t3 0) + (BC 12 2 ,sk1 "B.EQ") + (mov t5 t4) + (unlikely-label ,sk1) + (STD t5 0 (iSP)) + (ContinueToNextInstruction-NoStall)))) + + +;;; Fin. diff --git a/g5-emulator/imacsubp.lisp b/g5-emulator/imacsubp.lisp new file mode 100644 index 0000000..047e0b1 --- /dev/null +++ b/g5-emulator/imacsubp.lisp @@ -0,0 +1,202 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of subprimitive instructions. These are mostly in IFUNSUBP.PPCS + +(defmacro %allocate-internal (type area amount escape address temp temp2 temp3 temp4 + &environment env) + "Internal version of ALLOCATE fo use in math instructions that need to + cons" + (if (constantp amount env) + (check-temporaries (area address) (temp temp2 temp3 temp4)) + (check-temporaries (area amount address) (temp temp2 temp3 temp4))) + (multiple-value-bind (cache-area cache-address cache-length) + (ecase type + (:list + (values + 'PROCESSORSTATE_LCAREA + 'PROCESSORSTATE_LCADDRESS + 'PROCESSORSTATE_LCLENGTH)) + (:structure + (values + 'PROCESSORSTATE_SCAREA + 'PROCESSORSTATE_SCADDRESS + 'PROCESSORSTATE_SCLENGTH))) + + `((LD ,temp ,cache-area (ivory)) + ;; --- Implement default-cons-area and check against that + #-ign (Get-Nil ,temp4) + (LWA ,temp2 ,cache-length (ivory)) + (LD ,address ,cache-address (ivory) "Fetch address") + #+ign (XOR ,temp3 ,area ,temp) + #+ign (branch-true ,temp3 ,escape "Wrong area") + #-ign (XOR ,temp3 ,temp ,temp4) + #-ign (branch-false ,temp3 ,escape "Decached area") + ,@(if (constantp amount env) + (let ((amount2 (- amount))) + `((ADDI ,temp3 ,temp2 ,amount2))) + `((SUBF ,temp3 ,amount ,temp2 "Effectively an unsigned 32-bit compare"))) + (branch-if-less-than-zero ,temp3 ,escape "Insufficient cache") + ;; Ensure any arithmetic exceptions are taken before you commit to consing + (floating-exception-checking-postlude nil ,temp) ;Ensure traps complete + (STW ,temp3 ,cache-length (ivory) "Store remaining length") + ;(stack-write iSP temp "Cache address/tag -> TOS") + ;(STW temp PROCESSORSTATE_BAR1 (ivory) "Cache address -> BAR1") + (clrldi ,temp4 ,address 32) + (ADDI ,temp4 ,temp4 ,amount "Increment address") + (STW ,temp4 ,(intern (concatenate 'string (string cache-address) "+4")) (ivory) + "Store updated address") + ))) + +(defmacro cons-internal (car-type car-data cdr-type cdr-data area escape pointer + temp temp2 temp3 temp4 temp5 temp6) + "Cons and write car/cdr, returning address of cons in POINTER. Branch + to ESCAPE on any irregularity. Type fields assumed to be CDR-NEXT." + (check-temporaries ( car-data cdr-data area pointer) (temp temp2 temp3 temp4)) + `((%allocate-internal :list ,area 2 ,escape ,pointer ,temp ,temp2 ,temp3 ,temp4) + (clrldi ,pointer ,pointer 32) + (li ,temp5 ,car-type) + (ORI ,temp5 ,temp5 ,(lsh |cdr|$k-|normal| 6)) + (VM-Write ,pointer ,temp5 ,car-data ,temp ,temp2 ,temp3 ,temp4) + (ADDI ,temp6 ,pointer 1) + (li ,temp5 ,cdr-type) + (ORI ,temp5 ,temp5 ,(lsh |cdr|$k-|nil| 6)) + (VM-Write ,temp6 ,temp5 ,cdr-data ,temp ,temp2 ,temp3 ,temp4) + )) + +(defmacro i%allocate-block (listp &optional long-jump?) + (let ((len (if listp 'PROCESSORSTATE_LCLENGTH 'PROCESSORSTATE_SCLENGTH)) + (adr (if listp 'PROCESSORSTATE_LCADDRESS 'PROCESSORSTATE_SCADDRESS)) + (area (if listp 'PROCESSORSTATE_LCAREA 'PROCESSORSTATE_SCAREA)) + (illoplab (gensym)) + (ielab (gensym))) + `((LD t1 ,area (ivory)) + (stack-read iSP arg3) + (srdi arg2 arg1 32) + (clrldi arg1 arg1 32) + (CheckDataType arg2 |TypeFixnum| ,illoplab t5) + (LWA t4 ,len (ivory)) + (XOR t2 arg3 t1) + (branch-true t2 ,ielab "Wrong area") + (SUBF t2 arg1 t4 "Effectively an unsigned 32-bit compare") + (branch-if-less-than-zero t2 ,ielab "Insufficient cache") + (LD t1 ,adr (ivory) "Fetch address") + (load-constant t3 #.(sys:%logdpb sys:trap-mode-fep sys:%%cr.trap-mode 0)) + (clrldi t3 t3 32) + (STW t2 ,len (ivory) "Store remaining length") + (stack-write iSP t1 "Cache address/tag -> TOS") + (STW t1 PROCESSORSTATE_BAR1+4 (ivory) "Cache address -> BAR1") + (clrldi t1 t1 32) + (get-control-register t4 "Verify trap mode") + (ADD t1 t1 arg1 "Increment address") + (STW t1 ,(intern (concatenate 'string (string adr) "+4")) (ivory) "Store updated address") + (AND t3 t3 t4) + ,@(if long-jump? + `((long-branch-if-nonzero t3 NextInstruction "Already above emulator mode")) + `((branch-if-nonzero t3 NextInstruction "Already above emulator mode"))) + (load-constant t3 #.1_30) ;+++ magic # + (OR t4 t4 t3) + (set-control-register t4) + (ContinueToNextInstruction) + (label ,illoplab) + (illegal-operand %allocate-type-error) + (label ,ielab) + (SetTag arg2 arg1 t1) + (prepare-exception + ,(if listp 'allocate-list-block 'allocate-structure-block) + 0 + t1) + (instruction-exception)))) + +(defmacro i%set-cdr-code-n (ptr n temp) + `((LWA ,temp 0 (,ptr) "Get CDR CODE/TAG of operand") + (GetNextPCandCP) + (ANDI-DOT ,temp ,temp #x3F "Strip off any existing CDR code bits") + (ORI ,temp ,temp ,(ash n 6) "OR in the CDR") + (STW ,temp 0 (,ptr) "Replace the CDR CODE/TAG") + (ContinueToNextInstruction-NoStall))) + +#+obsolete +(defmacro refill-oldspace-table () + (let ((sk (gensym))) + (flet ((doephemeral (offset) + `((ZAP t3 t2 t4) ;*** how to xlate this? + (STD t4 ,offset (t1)) + (NAND t4 t4 t4) + (STD t4 ,(+ offset 32) (t1)) + (srdi t2 t2 8))) + (dozone () + `((srdi t2 t2 1) + (load-constant t3 -1) + (ANDI-DOT R31 t2 1) + (BC 4 2 ,sk "B.NE") + (clr t3) + (unlikely-label ,sk) + (STD t3 0 (t1)) + (STD t3 8 (t1)) + (STD t3 16 (t1)) + (STD t3 24 (t1)) + (STD t3 32 (t1)) + (STD t3 40 (t1)) + (STD t3 48 (t1)) + (STD t3 56 (t1)) + (ADDI t1 t1 64)))) + `((ADDI t1 ivory PROCESSORSTATE_OLDSPACE) + (load-constant t3 -1) + (LWA t2 PROCESSORSTATE_EPHEMERALOLDSPACE (ivory)) + ,@(doephemeral 0) + ,@(doephemeral 8) + ,@(doephemeral 16) + ,@(doephemeral 24) + (ADDI t1 t1 64) + (LWA t2 PROCESSORSTATE_ZONEOLDSPACE (ivory)) + ,@(loop repeat 31 + append (dozone)))))) + +(defmacro check-preempt-request (done-label temp1 temp2 &optional long-jump?) + (let ((done (lisp:or done-label (gensym)))) + `((LWA ,temp1 PROCESSORSTATE_INTERRUPTREG (ivory)) + (extrdi ,temp2 ,temp1 1 62 "temp2=1 iff (logand temp 2) is non-zero") + (OR ,temp1 ,temp1 ,temp2) + (STW ,temp1 PROCESSORSTATE_INTERRUPTREG (ivory)) + ,@(if long-jump? + `((long-branch-if-zero ,temp1 ,done)) + `((branch-if-zero ,temp1 ,done))) + (STD ,temp1 PROCESSORSTATE_STOP_INTERPRETER (ivory)) + ,@(unless done-label + `((label ,done)))))) + +;; For the first three or four internal registers, this is slower than +;; just using REGISTER-DISPATCH, but after that this wins big. +(defmacro internal-register-dispatch (reg writep error temp1 temp2 temp3) + (let ((low-slot (if writep + 'PROCESSORSTATE_INTERNALREGISTERWRITE1 + 'PROCESSORSTATE_INTERNALREGISTERREAD1)) + (high-slot (if writep + 'PROCESSORSTATE_INTERNALREGISTERWRITE2 + 'PROCESSORSTATE_INTERNALREGISTERREAD2)) + (high-ones (gensym))) + ;;+++ The constants #o1000, #o52, and #o41 are kind of poor... + `((LD ,temp2 ,high-slot (ivory)) + (ADDI ,temp3 ,reg #.(- #o1000)) + (LD ,temp1 ,low-slot (ivory)) + (branch-if-greater-than-or-equal-to-zero ,temp3 ,high-ones "We're in the 1000's") + (ANDI-DOT ,temp3 ,reg #o77 "Keep only six bits") + (CMPI 0 1 ,temp3 #o52 "In range for the low registers?") + (sldi ,temp3 ,temp3 3) + (ADD ,temp3 ,temp1 ,temp3) + (BC 12 1 ,error "B. if CMPI above not LE") + (LD ,temp3 0 (,temp3)) + (MTSPR 9 ,temp3) + (BCCTR 20 0 "Jump to the handler") + (label ,high-ones) + (CMPI 0 1 ,temp3 #o41 "In range for the high registers?") + (sldi ,temp3 ,temp3 3) + (ADD ,temp3 ,temp2 ,temp3) + (BC 12 1 ,error "B. if CMPI above not LE") + (LD ,temp3 0 (,temp3)) + (MTSPR 9 ,temp3) + (BCCTR 20 0 "Jump to the handler")))) + +;;; Fin. diff --git a/g5-emulator/imactrap.lisp b/g5-emulator/imactrap.lisp new file mode 100644 index 0000000..6ef4e29 --- /dev/null +++ b/g5-emulator/imactrap.lisp @@ -0,0 +1,1003 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; Macros in support of traps and exceptions. + +(defmacro prepare-trap (popped condition &optional vma) + (declare (ignore popped)) + (let ((position (position condition *all-conditions* :test #'equal)) + (condition (if (listp condition) (first condition) condition))) + (assert (not (null position)) (condition) + "~S is not a known condition" condition) + (when (member condition *vma-valid-conditions*) + (assert (not (null vma)) () + "You need to supply a VMA for the condition ~S" condition)) + (let ((microstate (1+ position))) ;we don't like zero + (if (null vma) + `((load-constant arg5 0) + ;; This is second in case vma is in arg2! + (load-constant arg2 ,microstate)) + `((mov arg5 ,vma) + ;; This is second in case vma is in arg2! + (load-constant arg2 ,microstate)))))) + +;;; takes index in 'index' and returns entry in 'tag' and 'data' +(defmacro get-trap-vector-entry (index tag data cr temp2 temp3 temp4 temp5 temp6) + (let ((index-is-reg? (find-register index)) + (tventrybad (gensym)) + (sk (gensym))) + (if index-is-reg? + (check-temporaries (index tag data cr) (temp2 temp3 temp4 temp5 temp6)) + (check-temporaries (tag data cr) (temp2 temp3 temp4 temp5 temp6))) + (push + `((label ,tventrybad) + (halt-machine HaltReasonIllegalTrapVector) ;+++ fixup later + ) + *function-epilogue*) + `((get-control-register ,cr) + (LD ,temp6 PROCESSORSTATE_FEPMODETRAPVECADDRESS (ivory)) + (LD ,temp5 PROCESSORSTATE_TRAPVECBASE (ivory)) + (load-constant ,temp2 #.(sys:%logdpb 3 (byte 2 30) 0)) + (srdi ,temp3 ,cr 30) + (OR ,temp2 ,cr ,temp2 "Set trap mode to 3") + (ANDI-DOT ,temp3 ,temp3 3) + (set-control-register ,temp2) + (ADDI ,temp4 ,temp3 -3) + ,@(if index-is-reg? + `((ADD ,temp5 ,temp5 ,index)) + `((ADDI ,temp5 ,temp5 ,index))) + (CMPI 0 1 ,temp4 0) + (BC 4 2 ,sk "B.NE") + (mov ,temp5 ,temp6) + (unlikely-label ,sk) + (STD ,temp5 PROCESSORSTATE_TVI (ivory) "Record TVI for tracing (if enabled)") + (memory-read ,temp5 ,tag ,data PROCESSORSTATE_DATAREAD ,temp6 ,temp4 ,temp3 ,temp2) + (CheckAdjacentDataTypes ,tag |TypeEvenPC| 2 ,tventrybad ,temp2) + (set-control-register ,cr "Restore the cr")))) + + +;;; The post traps + +;;; Note that all of these routines shared registers! + +(defmacro take-post-trap (tvi arity temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10 + &optional next-pc next-cp) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + (let ((tvi-is-reg? (find-register tvi)) + (label (gensym)) + (sk (gensym)) + (tag temp2) + (data temp3) + (cr temp4) + (overflow (gensym))) + `((mov ,temp iFP "save old frame pointer") + (get-trap-vector-entry ,tvi ,tag ,data ,cr ,temp5 ,temp6 ,temp7 ,temp8 ,temp9) + (stack-cache-overflow-check ,temp5 ,temp6 ,temp7 ,temp8 ,temp9 iSP 8) + (sldi iFP ,arity 3) + (SUBF iFP iFP iSP) + (ADDI iFP iFP 8) + ;; Move operands up stack to make foom for fixed args. + ,@(loop for i upfrom 0 below 4 + nconc `((branch-if-zero ,arity ,label) + (stack-read-disp isp ,(* (- i) 8) ,temp5) + (stack-write-disp isp ,(* (- 4 i) 8) ,temp5) + (ADDI ,arity ,arity -1))) + (label ,label) + (ADDI iSP iSP ,(* 8 4)) + ;; Build frame header for trap. + (get-continuation2 ,temp7 ,temp5) + (load-constant ,temp8 #.1_29 "cr.instruction-trace") + (clrldi ,cr ,cr 32) + (ORI ,temp7 ,temp7 #xC0) + ;; Setup FP|0 (continuation register) + (stack-write2 iFP ,temp7 ,temp5) + ;; Setup FP|1 (control register) + (AND ,temp8 ,cr ,temp8) + (srdi ,temp8 ,temp8 2) + (li ,temp6 |TypeFixnum+0xC0|) + (OR ,temp8 ,cr ,temp8) + (stack-write2-disp iFP 8 ,temp6 ,temp8) + ;; Setup iLP + (ADDI iLP iSP 8) + ;; Fill in the two fixed arguments. + (li ,temp6 |TypeFixnum|) + ,@(if tvi-is-reg? + `((mov ,temp8 ,tvi)) + `((li ,temp8 ,tvi))) + (stack-write2-disp iFP ,(* 2 8) ,temp6 ,temp8) + (convert-pc-to-continuation iPC ,temp6 ,temp8 ,temp9) + (stack-write2-disp iFP ,(* 3 8) ,temp6 ,temp8) + ;; Set the control register + (LD ,temp7 PROCESSORSTATE_FCCRTRAPMASK (ivory) "Get CR mask") + (li ,temp5 1) + (sldi ,temp5 ,temp5 18 "ValueDispositionValue*4 = 1<<18!") + (SUBF ,temp6 iFP iLP "Arg size") + (SUBF ,temp8 ,temp iFP "Caller Frame Size") + (srdi ,temp6 ,temp6 3 "Arg size in words") + (sldi ,temp8 ,temp8 ,(- 9 3) "Caller Frame Size in words in place") + (OR ,temp5 ,temp5 ,temp6) + (OR ,temp5 ,temp5 ,temp8) + ;; Compute trap mode + (TagCdr ,tag ,temp9) + (srdi ,temp6 ,cr 30) + (SUBF ,temp8 ,temp6 ,temp9) + (CMPI 0 1 ,temp8 0) + (BC 12 0 ,sk "B.LT") + (mov ,temp6 ,temp9) + (unlikely-label ,sk) + (sldi ,temp6 ,temp6 30) + (AND ,cr ,cr ,temp7 "Mask off unwanted bits") + (OR ,cr ,cr ,temp6 "Add trap mode") + (OR ,cr ,cr ,temp5 "Add argsize, apply, disposition, caller FS") + (set-control-register ,cr) + ;; Set Continuation + ,@(cond ((null next-pc) + `(;; --- Overkill to Ensure iCP is accurate + (PC-TO-iCACHEENT iPC iCP ,temp6 ,temp8) + (LD ,temp9 CACHELINE_NEXTPCDATA (iCP)) + (convert-pc-to-continuation ,temp9 ,temp6 ,temp8 ,temp10) + (LD ,temp9 CACHELINE_NEXTCP (iCP)) + (STD ,temp9 PROCESSORSTATE_CONTINUATIONCP (Ivory)))) + (t + `((convert-pc-to-continuation ,next-pc ,temp6 ,temp8 ,temp9) + ,@(if next-cp + `((STD ,next-cp PROCESSORSTATE_CONTINUATIONCP (Ivory))) + `((stzd PROCESSORSTATE_CONTINUATIONCP (Ivory))))))) + (set-continuation2 ,temp6 ,temp8) + ;; Set PC + (convert-continuation-to-pc ,tag ,data iPC ,temp9) + (srdi ,temp6 ,cr 30 "Save current trap mode") + (stack-overflow-p ,cr nil ,temp8 ,temp9 ,overflow) ;Destroys CR. + ;; Can't use this as it will smash the annotation field to point to + ;; the PC of the trap-handler, punting any useful annotation. + ;; Worse, it will trigger a cache fill even if the correct CP is + ;; already valid!!! + ;; (ContinueToInterpretInstruction-ValidateCache) + (PC-TO-iCACHEENT iPC iCP ,temp8 ,temp9) + (ContinueToNextInstruction-NoStall) + (label ,overflow) + (branch-if-zero ,temp6 STACKOVERFLOW "Take the overflow if in emulator mode") + (halt-machine HaltReasonFatalStackOverflow) + ))) + +(defmacro stack-overflow-handler () + `( + ;; If we come here, we have already advanced the PC and pushed a new + ;; frame on the stack, so we must preserve iSP in the restartSP for + ;; retry to work + (STD iSP PROCESSORSTATE_RESTARTSP (Ivory)) + (clr R31) + (take-post-trap |TrapVectorStackOverflow| R31 t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 iPC))) + + +;;; The pre traps + +;;; Note that all of these routines shared registers! + +(defmacro take-pre-trap-1 (tvi temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + (let ((tvi-is-reg? (find-register tvi))) + `((mov ,temp iFP "save old frame pointer") + ,@(if tvi-is-reg? + `((mov ,temp10 ,tvi "save the trap vector index")) + `((li ,temp10 ,tvi "save the trap vector index"))) + (call-subroutine |StartPreTrap|)))) + +;; TVI has been set into TEMP10, old iFP in TEMP +(defmacro start-pre-trap (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + `((LD ,temp2 PROCESSORSTATE_LINKAGE (Ivory)) + (branch-true ,temp2 |NativeException|) + (get-trap-vector-entry ,temp10 ,temp2 ,temp3 ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 ,temp9) + ;; Restore stack pointer + (LD iSP PROCESSORSTATE_RESTARTSP (ivory)) + (stack-cache-overflow-check ,temp4 ,temp5 ,temp6 ,temp7 ,temp8 iSP 8) + ;; Build frame header for trap handler. + (get-continuation2 ,temp4 ,temp5) + (get-control-register ,temp7) + (clrldi ,temp7 ,temp7 32) + (ORI ,temp4 ,temp4 #xC0) + ;; Setup FP|0 + (stack-push2-with-cdr ,temp4 ,temp5) + ;; Setup FP|1 + (li ,temp6 |TypeFixnum+0xC0|) + (stack-push2-with-cdr ,temp6 ,temp7) + ;; Push the TVI and fault PC + (mov ,temp6 ,temp10) + (stack-push-ir |TypeFixnum| ,temp6 ,temp8) + (convert-pc-to-continuation iPC ,temp6 ,temp8 ,temp9) + (set-continuation2 ,temp6 ,temp8) + (STD iCP PROCESSORSTATE_CONTINUATIONCP (Ivory)) + (stack-push2 ,temp6 ,temp8 ,temp9))) + +(defmacro take-pre-trap-2 (tvi temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (declare (ignore tvi)) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + `((B |FinishPreTrap|))) + +(defmacro finish-pre-trap (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10) + (check-temporaries () (temp temp2 temp3 temp4 temp5 temp6 temp7 temp8 temp9 temp10)) + (let ((sk (gensym))) + `(;; Finish call + ;; Establish new frame pointer. + (LD iFP PROCESSORSTATE_RESTARTSP (ivory)) + (ADDI iFP iFP 8 "iFP now points to the start of our new frame") + ;; Setup iLP + (ADDI iLP iSP 8 "Points beyond the last argument") + ;; Setup the control register. + (LD ,temp4 PROCESSORSTATE_FCCRTRAPMASK (ivory) "Get CR mask") + (li ,temp5 1) + (sldi ,temp5 ,temp5 18 "ValueDispositionValue*4 = 1<<18!") + (SUBF ,temp6 iFP iLP "Arg size") + (SUBF ,temp8 ,temp iFP "Caller Frame Size") + (srdi ,temp6 ,temp6 3 "Arg size in words") + (sldi ,temp8 ,temp8 ,(- 9 3) "Caller Frame Size in words in place") + (OR ,temp5 ,temp5 ,temp6) + (OR ,temp5 ,temp5 ,temp8) + ;; Compute trap mode + (TagCdr ,temp2 ,temp9) + (srdi ,temp6 ,temp7 30) + (SUBF ,temp8 ,temp6 ,temp9) + (CMPI 0 1 ,temp8 0 "(CMOVGE ,temp8 ,temp9 ,temp6)") + (BC 12 0 ,sk "B.LT") + (mov ,temp6 ,temp9) + (unlikely-label ,sk) + (sldi ,temp6 ,temp6 30) + (AND ,temp7 ,temp7 ,temp4 "Mask off unwanted bits") + (OR ,temp7 ,temp7 ,temp6 "Add trap mode") + (OR ,temp7 ,temp7 ,temp5 "Add argsize, apply, disposition, caller FS") + (set-control-register ,temp7) + ;; Set Continuation is handled above + ;; Set the PC + (convert-continuation-to-pc ,temp2 ,temp3 iPC ,temp9) + (stack-overflow-check ,temp7 nil ,temp8 ,temp9) ;Destroys TEMP7 + ;; Can't use this as it will smash the annotation field to point to + ;; the PC of the trap-handler, punting any useful annotation. + ;; Worse, it will trigger a cache fill even if the correct CP is + ;; already valid!!! + ;; (ContinueToInterpretInstruction-ValidateCache) + (PC-TO-iCACHEENT iPC iCP ,temp8 ,temp9) + (ContinueToNextInstruction-NoStall) + ))) + +;; Microstate is in ARG2, VMA is in ARG5. C.f., prepare-exception which +;; puts the opcode in ARG2 and vma in arg5 (but computes them in +;; exception-handler, so they are free for us) +(defmacro illegal-operand-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterError| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorError| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (stack-push-ir |TypeFixnum| arg2 t11) ;the microstate + (stack-push-ir |TypeLocative| arg5 t11) ;the vma + (take-pre-trap-2 |TrapVectorError| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro reset-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorReset| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorReset| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorReset| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro pull-apply-args-trap-handler (argstopull temp13) + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorPullApplyArgs| t1 t2) + (passthru "#endif") + (stack-pop2 t11 t12) + (STD iSP PROCESSORSTATE_RESTARTSP (ivory)) ;yes, we do mean to do this! + (take-pre-trap-1 |TrapVectorPullApplyArgs| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (stack-push-ir |TypeFixnum| ,argstopull ,temp13) + (stack-push2 t11 t12 ,temp13) + (take-pre-trap-2 |TrapVectorPullApplyArgs| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro trace-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorTrace| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorTrace| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorTrace| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro preempt-request-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorPreemptRequest| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorPreemptRequest| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorPreemptRequest| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro high-priority-sequence-break-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorHighPrioritySequenceBreak| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorHighPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorHighPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro low-priority-sequence-break-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorLowPrioritySequenceBreak| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorLowPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (take-pre-trap-2 |TrapVectorLowPrioritySequenceBreak| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro db-unwind-frame-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorDBUnwindFrame| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorDBUnwindFrame| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (LD t11 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-push-ir |TypeLocative| t11 t12) + (take-pre-trap-2 |TrapVectorDBUnwindFrame| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro db-unwind-catch-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorDBUnwindCatch| t1 t2) + (passthru "#endif") + (take-pre-trap-1 |TrapVectorDBUnwindCatch| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (LD t11 PROCESSORSTATE_BINDINGSTACKPOINTER (ivory)) + (stack-push-ir |TypeLocative| t11 t12) + (take-pre-trap-2 |TrapVectorDBUnwindCatch| t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + + +;;; The Memory Traps. + +;;; No physical addresses to worry about! +(defmacro take-memory-trap (tvi) + `((LD t11 PROCESSORSTATE_VMA (ivory) "Preserve VMA against reading trap vector") + (take-pre-trap-1 ,tvi t1 t2 t3 t4 t5 t6 t7 t8 t9 t10) + (stack-push-ir |TypeLocative| t11 t12) + (take-pre-trap-2 ,tvi t1 t2 t3 t4 t5 t6 t7 t8 t9 t10))) + +(defmacro transport-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterTransport| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorTransport|))) + +(defmacro monitor-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterMonitor| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorMonitor|))) + +(defmacro page-not-resident-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterPageNotResident| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorPageNotResident|))) + +(defmacro page-fault-request-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterPageFaultRequest| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorPageFaultRequest|))) + +(defmacro page-write-fault-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterPageWriteFault| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorPageWriteFault|))) + +(defmacro uncorrectable-memory-error-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterUncorrectableMemoryError| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorUncorrectableMemoryError|))) + +(defmacro bus-error-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterMemoryBusError| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorMemoryBusError|))) + +(defmacro db-cache-miss-trap-handler () + `((passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapMeterDBCacheMiss| t1 t2) + (passthru "#endif") + (take-memory-trap |TrapVectorDBCacheMiss|))) + + +;;; Instruction exceptions, which are special cases of post traps. + +;;; The information here is taken verbatim from the iSoft emulator, but the +;;; way that the information is used if different. We define the information +;;; here for the macroexpanders to create customized exception handler calls. + +#|| +*instruction-exception-info* is a per-opcode table of information we need to +take an instruction exception. Each entry is either NIL, meaning an exception +shouldn't happen for that instruction, or a fixnum with the following fields: +(byte 2 0) arity, the number of arguments to be passed to the trap handler. + Note that this isn't always the same as the number of operands + the instruction takes, see ldb for example. +(byte 1 2) format. 0 means the last argument can be retrieved by looking + at bits in the instruction. For reference: +(byte 2 15.) is 00 or 01 for signed, 10 for unsigned, 11 for + address-operand. + 1 means the last argument is on the stack. This is used for + ldb, dpb, and a few other strange ones. +(byte 1 3) 0 if normal, 1 if arithmetic dispatch. +||# + +;; ---*** OpenMCL fills an array with 0 by default??? +(defvar *instruction-exception-info* (make-array 400 :initial-element nil)) +(defvar *ivory-instruction-opcode-table* (make-hash-table)) + +;; Have to fill in table, as many instructions default their exception +;; info, but we still need to look up the opcode +(progn + (setf (gethash 'car *ivory-instruction-opcode-table*) |opcode$K-car|) + (setf (gethash 'cdr *ivory-instruction-opcode-table*) |opcode$K-cdr|) + (setf (gethash 'endp *ivory-instruction-opcode-table*) |opcode$K-endp|) + (setf (gethash 'setup-1d-array *ivory-instruction-opcode-table*) |opcode$K-setup1darray|) + (setf (gethash 'setup-force-1d-array *ivory-instruction-opcode-table*) + |opcode$K-setupforce1darray|) + (setf (gethash 'bind-locative *ivory-instruction-opcode-table*) |opcode$K-bindlocative|) + (setf (gethash '%restore-binding-stack *ivory-instruction-opcode-table*) + |opcode$K-restorebindingstack|) + (setf (gethash '%ephemeralp *ivory-instruction-opcode-table*) |opcode$K-ephemeralp|) + (setf (gethash 'start-call *ivory-instruction-opcode-table*) |opcode$K-startcall|) + (setf (gethash '%jump *ivory-instruction-opcode-table*) |opcode$K-jump|) + (setf (gethash '%tag *ivory-instruction-opcode-table*) |opcode$K-tag|) + (setf (gethash 'dereference *ivory-instruction-opcode-table*) |opcode$K-dereference|) + (setf (gethash 'logic-tail-test *ivory-instruction-opcode-table*) |opcode$K-logictailtest|) + #|| (setf (gethash '%proc-breakpoint *ivory-instruction-opcode-table*) + |opcode$K-%proc-breakpoint|) ||# + (setf (gethash 'double-float-op *ivory-instruction-opcode-table*) |opcode$K-doublefloatop|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash 'push-lexical-var *ivory-instruction-opcode-table*) |opcode$K-pushlexicalvar|) + (setf (gethash '%block-0-write *ivory-instruction-opcode-table*) |opcode$K-block0write|) + (setf (gethash '%block-1-write *ivory-instruction-opcode-table*) |opcode$K-block1write|) + (setf (gethash '%block-2-write *ivory-instruction-opcode-table*) |opcode$K-block2write|) + (setf (gethash '%block-3-write *ivory-instruction-opcode-table*) |opcode$K-block3write|) + (setf (gethash 'zerop *ivory-instruction-opcode-table*) |opcode$K-zerop|) + (setf (gethash 'minusp *ivory-instruction-opcode-table*) |opcode$K-minusp|) + (setf (gethash 'plusp *ivory-instruction-opcode-table*) |opcode$K-plusp|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member *ivory-instruction-opcode-table*) |opcode$K-typemember|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'type-member-no-pop *ivory-instruction-opcode-table*) + |opcode$K-typemembernopop|) + (setf (gethash 'locate-locals *ivory-instruction-opcode-table*) |opcode$K-locatelocals|) + (setf (gethash 'catch-close *ivory-instruction-opcode-table*) |opcode$K-catchclose|) + (setf (gethash '%generic-dispatch *ivory-instruction-opcode-table*) + |opcode$K-genericdispatch|) + (setf (gethash '%message-dispatch *ivory-instruction-opcode-table*) + |opcode$K-messagedispatch|) + (setf (gethash '%check-preempt-request *ivory-instruction-opcode-table*) + |opcode$K-checkpreemptrequest|) + (setf (gethash 'push-global-logic-variable *ivory-instruction-opcode-table*) + |opcode$K-pushgloballogicvariable|) + (setf (gethash 'no-op *ivory-instruction-opcode-table*) |opcode$K-noop|) + (setf (gethash '%halt *ivory-instruction-opcode-table*) |opcode$K-halt|) + (setf (gethash 'branch-true *ivory-instruction-opcode-table*) |opcode$K-branchtrue|) + (setf (gethash 'branch-true-else-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueelseextrapop|) + (setf (gethash 'branch-true-and-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueandextrapop|) + (setf (gethash 'branch-true-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueextrapop|) + (setf (gethash 'branch-true-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtruenopop|) + (setf (gethash 'branch-true-and-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueandnopop|) + (setf (gethash 'branch-true-else-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueelsenopop|) + (setf (gethash 'branch-true-and-no-pop-else-no-pop-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchtrueandnopopelsenopopextrapop|) + (setf (gethash 'branch-false *ivory-instruction-opcode-table*) |opcode$K-branchfalse|) + (setf (gethash 'branch-false-else-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseelseextrapop|) + (setf (gethash 'branch-false-and-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseandextrapop|) + (setf (gethash 'branch-false-extra-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseextrapop|) + (setf (gethash 'branch-false-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalsenopop|) + (setf (gethash 'branch-false-and-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseandnopop|) + (setf (gethash 'branch-false-else-no-pop *ivory-instruction-opcode-table*) + |opcode$K-branchfalseelsenopop|) + (setf (gethash 'branch-false-and-no-pop-else-no-pop-extra-pop + *ivory-instruction-opcode-table*) + |opcode$K-branchfalseandnopopelsenopopextrapop|) + (setf (gethash 'push *ivory-instruction-opcode-table*) |opcode$K-push|) + (setf (gethash 'push-n-nils *ivory-instruction-opcode-table*) |opcode$K-pushnnils|) + (setf (gethash 'push-address-sp-relative *ivory-instruction-opcode-table*) + |opcode$K-pushaddresssprelative|) + (setf (gethash 'push-local-logic-variables *ivory-instruction-opcode-table*) + |opcode$K-pushlocallogicvariables|) + (setf (gethash 'return-multiple *ivory-instruction-opcode-table*) |opcode$K-returnmultiple|) + (setf (gethash 'return-kludge *ivory-instruction-opcode-table*) |opcode$K-returnkludge|) + (setf (gethash 'take-values *ivory-instruction-opcode-table*) |opcode$K-takevalues|) + (setf (gethash 'unbind-n *ivory-instruction-opcode-table*) |opcode$K-unbindn|) + (setf (gethash 'push-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-pushinstancevariable|) + (setf (gethash 'push-address-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-pushaddressinstancevariable|) + (setf (gethash 'push-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-pushinstancevariableordered|) + (setf (gethash 'push-address-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-pushaddressinstancevariableordered|) + (setf (gethash 'unary-minus *ivory-instruction-opcode-table*) |opcode$K-unaryminus|) + (setf (gethash 'return-single *ivory-instruction-opcode-table*) |opcode$K-returnsingle|) + (setf (gethash '%memory-read *ivory-instruction-opcode-table*) |opcode$K-memoryread|) + (setf (gethash '%memory-read-address *ivory-instruction-opcode-table*) + |opcode$K-memoryreadaddress|) + (setf (gethash '%block-0-read *ivory-instruction-opcode-table*) |opcode$K-block0read|) + (setf (gethash '%block-1-read *ivory-instruction-opcode-table*) |opcode$K-block1read|) + (setf (gethash '%block-2-read *ivory-instruction-opcode-table*) |opcode$K-block2read|) + (setf (gethash '%block-3-read *ivory-instruction-opcode-table*) |opcode$K-block3read|) + (setf (gethash '%block-0-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block0readshift|) + (setf (gethash '%block-1-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block1readshift|) + (setf (gethash '%block-2-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block2readshift|) + (setf (gethash '%block-3-read-shift *ivory-instruction-opcode-table*) + |opcode$K-block3readshift|) + (setf (gethash '%block-0-read-test *ivory-instruction-opcode-table*) + |opcode$K-block0readtest|) + (setf (gethash '%block-1-read-test *ivory-instruction-opcode-table*) + |opcode$K-block1readtest|) + (setf (gethash '%block-2-read-test *ivory-instruction-opcode-table*) + |opcode$K-block2readtest|) + (setf (gethash '%block-3-read-test *ivory-instruction-opcode-table*) + |opcode$K-block3readtest|) + (setf (gethash 'finish-call-n *ivory-instruction-opcode-table*) |opcode$K-finishcalln|) + (setf (gethash 'finish-call-n-apply *ivory-instruction-opcode-table*) + |opcode$K-finishcallnapply|) + (setf (gethash 'finish-call-tos *ivory-instruction-opcode-table*) |opcode$K-finishcalltos|) + (setf (gethash 'finish-call-tos-apply *ivory-instruction-opcode-table*) + |opcode$K-finishcalltosapply|) + (setf (gethash 'set-to-car *ivory-instruction-opcode-table*) |opcode$K-settocar|) + (setf (gethash 'set-to-cdr *ivory-instruction-opcode-table*) |opcode$K-settocdr|) + (setf (gethash 'set-to-cdr-push-car *ivory-instruction-opcode-table*) + |opcode$K-settocdrpushcar|) + (setf (gethash 'increment *ivory-instruction-opcode-table*) |opcode$K-increment|) + (setf (gethash 'decrement *ivory-instruction-opcode-table*) |opcode$K-decrement|) + (setf (gethash '%pointer-increment *ivory-instruction-opcode-table*) + |opcode$K-pointerincrement|) + (setf (gethash '%set-cdr-code-1 *ivory-instruction-opcode-table*) |opcode$K-setcdrcode1|) + (setf (gethash '%set-cdr-code-2 *ivory-instruction-opcode-table*) |opcode$K-setcdrcode2|) + (setf (gethash 'push-address *ivory-instruction-opcode-table*) |opcode$K-pushaddress|) + (setf (gethash 'set-sp-to-address *ivory-instruction-opcode-table*) + |opcode$K-setsptoaddress|) + (setf (gethash 'set-sp-to-address-save-tos *ivory-instruction-opcode-table*) + |opcode$K-setsptoaddresssavetos|) + (setf (gethash '%read-internal-register *ivory-instruction-opcode-table*) + |opcode$K-readinternalregister|) + (setf (gethash '%write-internal-register *ivory-instruction-opcode-table*) + |opcode$K-writeinternalregister|) + (setf (gethash '%coprocessor-read *ivory-instruction-opcode-table*) + |opcode$K-coprocessorread|) + (setf (gethash '%coprocessor-write *ivory-instruction-opcode-table*) + |opcode$K-coprocessorwrite|) + (setf (gethash '%block-0-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block0readalu|) + (setf (gethash '%block-1-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block1readalu|) + (setf (gethash '%block-2-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block2readalu|) + (setf (gethash '%block-3-read-alu *ivory-instruction-opcode-table*) + |opcode$K-block3readalu|) + (setf (gethash 'ldb *ivory-instruction-opcode-table*) |opcode$K-ldb|) + (setf (gethash 'char-ldb *ivory-instruction-opcode-table*) |opcode$K-charldb|) + (setf (gethash '%p-ldb *ivory-instruction-opcode-table*) |opcode$K-pldb|) + (setf (gethash '%p-tag-ldb *ivory-instruction-opcode-table*) |opcode$K-ptagldb|) + (setf (gethash 'branch *ivory-instruction-opcode-table*) |opcode$K-branch|) + (setf (gethash 'loop-decrement-tos *ivory-instruction-opcode-table*) + |opcode$K-loopdecrementtos|) + (setf (gethash 'entry-rest-accepted *ivory-instruction-opcode-table*) + |opcode$K-entryrestaccepted|) + (setf (gethash 'entry-rest-not-accepted *ivory-instruction-opcode-table*) + |opcode$K-entryrestnotaccepted|) + (setf (gethash 'rplaca *ivory-instruction-opcode-table*) |opcode$K-rplaca|) + (setf (gethash 'rplacd *ivory-instruction-opcode-table*) |opcode$K-rplacd|) + (setf (gethash 'multiply *ivory-instruction-opcode-table*) |opcode$K-multiply|) + (setf (gethash 'quotient *ivory-instruction-opcode-table*) |opcode$K-quotient|) + (setf (gethash 'ceiling *ivory-instruction-opcode-table*) |opcode$K-ceiling|) + (setf (gethash 'floor *ivory-instruction-opcode-table*) |opcode$K-floor|) + (setf (gethash 'truncate *ivory-instruction-opcode-table*) |opcode$K-truncate|) + (setf (gethash 'round *ivory-instruction-opcode-table*) |opcode$K-round|) + (setf (gethash 'rational-quotient *ivory-instruction-opcode-table*) + |opcode$K-rationalquotient|) + (setf (gethash 'min *ivory-instruction-opcode-table*) |opcode$K-min|) + (setf (gethash 'max *ivory-instruction-opcode-table*) |opcode$K-max|) + (setf (gethash '%alu *ivory-instruction-opcode-table*) |opcode$K-alu|) + (setf (gethash 'logand *ivory-instruction-opcode-table*) |opcode$K-logand|) + (setf (gethash 'logxor *ivory-instruction-opcode-table*) |opcode$K-logxor|) + (setf (gethash 'logior *ivory-instruction-opcode-table*) |opcode$K-logior|) + (setf (gethash 'rot *ivory-instruction-opcode-table*) |opcode$K-rot|) + (setf (gethash 'lsh *ivory-instruction-opcode-table*) |opcode$K-lsh|) + (setf (gethash '%multiply-double *ivory-instruction-opcode-table*) + |opcode$K-multiplydouble|) + (setf (gethash '%lshc-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-lshcbignumstep|) + (setf (gethash 'stack-blt *ivory-instruction-opcode-table*) |opcode$K-stackblt|) + (setf (gethash 'rgetf *ivory-instruction-opcode-table*) |opcode$K-rgetf|) + (setf (gethash 'member *ivory-instruction-opcode-table*) |opcode$K-member|) + (setf (gethash 'assoc *ivory-instruction-opcode-table*) |opcode$K-assoc|) + (setf (gethash '%pointer-plus *ivory-instruction-opcode-table*) |opcode$K-pointerplus|) + (setf (gethash '%pointer-difference *ivory-instruction-opcode-table*) + |opcode$K-pointerdifference|) + (setf (gethash 'ash *ivory-instruction-opcode-table*) |opcode$K-ash|) + (setf (gethash 'store-conditional *ivory-instruction-opcode-table*) + |opcode$K-storeconditional|) + (setf (gethash '%memory-write *ivory-instruction-opcode-table*) |opcode$K-memorywrite|) + (setf (gethash '%p-store-contents *ivory-instruction-opcode-table*) + |opcode$K-pstorecontents|) + (setf (gethash 'bind-locative-to-value *ivory-instruction-opcode-table*) + |opcode$K-bindlocativetovalue|) + (setf (gethash 'unify *ivory-instruction-opcode-table*) |opcode$K-unify|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'pop-lexical-var *ivory-instruction-opcode-table*) |opcode$K-poplexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'movem-lexical-var *ivory-instruction-opcode-table*) + |opcode$K-movemlexicalvar|) + (setf (gethash 'equal-number *ivory-instruction-opcode-table*) |opcode$K-equalnumber|) + (setf (gethash 'lessp *ivory-instruction-opcode-table*) |opcode$K-lessp|) + (setf (gethash 'greaterp *ivory-instruction-opcode-table*) |opcode$K-greaterp|) + (setf (gethash 'eql *ivory-instruction-opcode-table*) |opcode$K-eql|) + (setf (gethash 'equal-number-no-pop *ivory-instruction-opcode-table*) + |opcode$K-equalnumbernopop|) + (setf (gethash 'lessp-no-pop *ivory-instruction-opcode-table*) |opcode$K-lesspnopop|) + (setf (gethash 'greaterp-no-pop *ivory-instruction-opcode-table*) |opcode$K-greaterpnopop|) + (setf (gethash 'eql-no-pop *ivory-instruction-opcode-table*) |opcode$K-eqlnopop|) + (setf (gethash 'eq *ivory-instruction-opcode-table*) |opcode$K-eq|) + (setf (gethash 'logtest *ivory-instruction-opcode-table*) |opcode$K-logtest|) + (setf (gethash 'eq-no-pop *ivory-instruction-opcode-table*) |opcode$K-eqnopop|) + (setf (gethash 'logtest-no-pop *ivory-instruction-opcode-table*) |opcode$K-logtestnopop|) + (setf (gethash 'add *ivory-instruction-opcode-table*) |opcode$K-add|) + (setf (gethash 'sub *ivory-instruction-opcode-table*) |opcode$K-sub|) + (setf (gethash '%32-bit-plus *ivory-instruction-opcode-table*) |opcode$K-32bitplus|) + (setf (gethash '%32-bit-difference *ivory-instruction-opcode-table*) + |opcode$K-32bitdifference|) + (setf (gethash '%add-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-addbignumstep|) + (setf (gethash '%sub-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-subbignumstep|) + (setf (gethash '%multiply-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-multiplybignumstep|) + (setf (gethash '%divide-bignum-step *ivory-instruction-opcode-table*) + |opcode$K-dividebignumstep|) + (setf (gethash 'aset-1 *ivory-instruction-opcode-table*) |opcode$K-aset1|) + (setf (gethash '%allocate-list-block *ivory-instruction-opcode-table*) + |opcode$K-allocatelistblock|) + (setf (gethash 'aref-1 *ivory-instruction-opcode-table*) |opcode$K-aref1|) + (setf (gethash 'aloc-1 *ivory-instruction-opcode-table*) |opcode$K-aloc1|) + (setf (gethash 'store-array-leader *ivory-instruction-opcode-table*) + |opcode$K-storearrayleader|) + (setf (gethash '%allocate-structure-block *ivory-instruction-opcode-table*) + |opcode$K-allocatestructureblock|) + (setf (gethash 'array-leader *ivory-instruction-opcode-table*) |opcode$K-arrayleader|) + (setf (gethash 'aloc-leader *ivory-instruction-opcode-table*) |opcode$K-alocleader|) + (setf (gethash 'pop-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-popinstancevariable|) + (setf (gethash 'movem-instance-variable *ivory-instruction-opcode-table*) + |opcode$K-moveminstancevariable|) + (setf (gethash 'pop-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-popinstancevariableordered|) + (setf (gethash 'movem-instance-variable-ordered *ivory-instruction-opcode-table*) + |opcode$K-moveminstancevariableordered|) + (setf (gethash '%instance-ref *ivory-instruction-opcode-table*) |opcode$K-instanceref|) + (setf (gethash '%instance-set *ivory-instruction-opcode-table*) |opcode$K-instanceset|) + (setf (gethash '%instance-loc *ivory-instruction-opcode-table*) |opcode$K-instanceloc|) + (setf (gethash '%set-tag *ivory-instruction-opcode-table*) |opcode$K-settag|) + (setf (gethash '%unsigned-lessp *ivory-instruction-opcode-table*) |opcode$K-unsignedlessp|) + (setf (gethash '%unsigned-lessp-no-pop *ivory-instruction-opcode-table*) + |opcode$K-unsignedlesspnopop|) + (setf (gethash 'pop *ivory-instruction-opcode-table*) |opcode$K-pop|) + (setf (gethash 'movem *ivory-instruction-opcode-table*) |opcode$K-movem|) + (setf (gethash '%merge-cdr-no-pop *ivory-instruction-opcode-table*) + |opcode$K-mergecdrnopop|) + (setf (gethash 'fast-aref-1 *ivory-instruction-opcode-table*) |opcode$K-fastaref1|) + (setf (gethash 'fast-aset-1 *ivory-instruction-opcode-table*) |opcode$K-fastaset1|) + (setf (gethash 'stack-blt-address *ivory-instruction-opcode-table*) + |opcode$K-stackbltaddress|) + (setf (gethash 'dpb *ivory-instruction-opcode-table*) |opcode$K-dpb|) + (setf (gethash 'char-dpb *ivory-instruction-opcode-table*) |opcode$K-chardpb|) + (setf (gethash '%p-dpb *ivory-instruction-opcode-table*) |opcode$K-pdpb|) + (setf (gethash '%p-tag-dpb *ivory-instruction-opcode-table*) |opcode$K-ptagdpb|) + (setf (gethash 'loop-increment-tos-less-than *ivory-instruction-opcode-table*) + |opcode$K-loopincrementtoslessthan|) + (setf (gethash 'catch-open *ivory-instruction-opcode-table*) |opcode$K-catchopen|) + #|| (setf (gethash '%hack *ivory-instruction-opcode-table*) |opcode$K-hack|) ||# + ) + + + +(defmacro define-instruction-exception (instruction opcode arity &rest options) + `(define-instruction-exception-1 ',instruction ,opcode ,arity ',options)) + +(defun define-instruction-exception-1 (instruction opcode arity options) + (setf (gethash instruction *ivory-instruction-opcode-table*) opcode) + (setf (aref *instruction-exception-info* opcode) + (dpb (if (member :stack options) 1 0) + (byte 1 3) + (dpb (if (member :arithmetic options) 1 0) + (byte 1 4) + arity)))) + +(defun instruction-exception-info (opcode) + #+Genera (declare (values arity stack? arithmetic?)) + (let ((info (aref *instruction-exception-info* opcode))) + (if (not (null info)) + (values (ldb (byte 3 0) info) + (ldb-test (byte 1 3) info) + (ldb-test (byte 1 4) info)) + ;; Undefined instruction exception. + (values 0 t nil)))) + +(define-instruction-exception car |opcode$K-car| 1) +(define-instruction-exception cdr |opcode$K-cdr| 1) +(define-instruction-exception set-to-car |opcode$K-settocar| 1) +(define-instruction-exception set-to-cdr |opcode$K-settocdr| 1) +(define-instruction-exception set-to-cdr-push-car |opcode$K-settocdrpushcar| 1) +(define-instruction-exception rplaca |opcode$K-rplaca| 2) +(define-instruction-exception rplacd |opcode$K-rplacd| 2) +(define-instruction-exception rgetf |opcode$K-rgetf| 2) +(define-instruction-exception member |opcode$K-member| 2) +(define-instruction-exception assoc |opcode$K-assoc| 2) +(define-instruction-exception eql |opcode$K-eql| 2 :arithmetic) +(define-instruction-exception eql-no-pop |opcode$K-eqlnopop| 2 :arithmetic) +(define-instruction-exception equal-number |opcode$K-equalnumber| 2 :arithmetic) +(define-instruction-exception equal-number-no-pop |opcode$K-equalnumbernopop| 2 :arithmetic) +(define-instruction-exception greaterp |opcode$K-greaterp| 2 :arithmetic) +(define-instruction-exception greaterp-no-pop |opcode$K-greaterpnopop| 2 :arithmetic) +(define-instruction-exception lessp |opcode$K-lessp| 2 :arithmetic) +(define-instruction-exception lessp-no-pop |opcode$K-lesspnopop| 2 :arithmetic) +(define-instruction-exception plusp |opcode$K-plusp| 1 :arithmetic) +(define-instruction-exception minusp |opcode$K-minusp| 1 :arithmetic) +(define-instruction-exception zerop |opcode$K-zerop| 1 :arithmetic) +(define-instruction-exception logtest |opcode$K-logtest| 2 :arithmetic) +(define-instruction-exception logtest-no-pop |opcode$K-logtestnopop| 2 :arithmetic) +(define-instruction-exception add |opcode$K-add| 2 :arithmetic) +(define-instruction-exception sub |opcode$K-sub| 2 :arithmetic) +(define-instruction-exception unary-minus |opcode$K-unaryminus| 1 :arithmetic) +(define-instruction-exception increment |opcode$K-increment| 1) +(define-instruction-exception decrement |opcode$K-decrement| 1) +(define-instruction-exception multiply |opcode$K-multiply| 2 :arithmetic) +(define-instruction-exception quotient |opcode$K-quotient| 2 :arithmetic) +(define-instruction-exception ceiling |opcode$K-ceiling| 2 :arithmetic) +(define-instruction-exception floor |opcode$K-floor| 2 :arithmetic) +(define-instruction-exception truncate |opcode$K-truncate| 2 :arithmetic) +(define-instruction-exception round |opcode$K-round| 2 :arithmetic) +;(define-instruction-exception remainder 2 :arithmetic) +(define-instruction-exception rational-quotient |opcode$K-rationalquotient| 2 :arithmetic) +(define-instruction-exception double-float-op |opcode$K-doublefloatop| 5 :arithmetic) +(define-instruction-exception max |opcode$K-max| 2 :arithmetic) +(define-instruction-exception min |opcode$K-min| 2 :arithmetic) +(define-instruction-exception logand |opcode$K-logand| 2 :arithmetic) +(define-instruction-exception logior |opcode$K-logior| 2 :arithmetic) +(define-instruction-exception logxor |opcode$K-logxor| 2 :arithmetic) +(define-instruction-exception ash |opcode$K-ash| 2 :arithmetic) +(define-instruction-exception ldb |opcode$K-ldb| 1 :stack) +(define-instruction-exception dpb |opcode$K-dpb| 2 :stack) +(define-instruction-exception aref-1 |opcode$K-aref1| 2) +(define-instruction-exception aset-1 |opcode$K-aset1| 3) +(define-instruction-exception aloc-1 |opcode$K-aloc1| 2) +(define-instruction-exception setup-1d-array |opcode$K-setup1darray| 1) +(define-instruction-exception setup-force-1d-array |opcode$K-setupforce1darray| 1) +(define-instruction-exception fast-aref-1 |opcode$K-fastaref1| 2) +(define-instruction-exception fast-aset-1 |opcode$K-fastaset1| 3) +(define-instruction-exception array-leader |opcode$K-arrayleader| 2) +(define-instruction-exception store-array-leader |opcode$K-storearrayleader| 3) +(define-instruction-exception aloc-leader |opcode$K-alocleader| 2) +(define-instruction-exception loop-decrement-tos |opcode$K-loopdecrementtos| 1 :stack) +(define-instruction-exception loop-increment-tos-less-than |opcode$K-loopincrementtoslessthan| 2 :stack) +(define-instruction-exception block-0-read-alu |opcode$K-block0readalu| 1) +(define-instruction-exception block-1-read-alu |opcode$K-block1readalu| 1) +(define-instruction-exception block-2-read-alu |opcode$K-block2readalu| 1) +(define-instruction-exception block-3-read-alu |opcode$K-block3readalu| 1) +(define-instruction-exception allocate-list-block |opcode$K-allocatelistblock| 2) +(define-instruction-exception allocate-structure-block |opcode$K-allocatestructureblock| 2) +(define-instruction-exception unify |opcode$K-unify| 2) +(define-instruction-exception logic-tail-test |opcode$K-logictailtest| 1) +(define-instruction-exception push-address-sp-relative |opcode$K-pushaddresssprelative| 1) +(define-instruction-exception stack-blt |opcode$K-stackblt| 2) +(define-instruction-exception stack-blt-address |opcode$K-stackbltaddress| 2) +(define-instruction-exception char-ldb |opcode$K-charldb| 1 :stack) +(define-instruction-exception char-dpb |opcode$K-chardpb| 2 :stack) +(define-instruction-exception bind-locative-to-value |opcode$K-bindlocativetovalue| 2) +(define-instruction-exception bind-locative |opcode$K-bindlocative| 1) +(define-instruction-exception restore-binding-stack |opcode$K-restorebindingstack| 1) +(define-instruction-exception push-lexical-var |opcode$K-pushlexicalvar| 1) +(define-instruction-exception pop-lexical-var |opcode$K-poplexicalvar| 2) +(define-instruction-exception movem-lexical-var |opcode$K-movemlexicalvar| 2) +(define-instruction-exception instance-ref |opcode$K-instanceref| 2) +(define-instruction-exception instance-set |opcode$K-instanceset| 3) +(define-instruction-exception instance-loc |opcode$K-instanceloc| 2) +(define-instruction-exception push-instance-variable |opcode$K-pushinstancevariable| 1) +(define-instruction-exception pop-instance-variable |opcode$K-popinstancevariable| 2) +(define-instruction-exception movem-instance-variable |opcode$K-moveminstancevariable| 2) +(define-instruction-exception push-address-instance-variable |opcode$K-pushaddressinstancevariable| 1) +(define-instruction-exception block-0-read-test |opcode$K-block0readtest| 2 :stack) +(define-instruction-exception block-1-read-test |opcode$K-block1readtest| 2 :stack) +(define-instruction-exception block-2-read-test |opcode$K-block2readtest| 2 :stack) +(define-instruction-exception block-3-read-test |opcode$K-block3readtest| 2 :stack) +(define-instruction-exception alu |opcode$K-alu| 2) + +;;; Macro to get the instruction exception information into args before +;;; jumping to the instruction exception routine. 'instruction' is the +;;; instruction name, popped is a number representing the number of stack +;;; pops that have occured when this exception was started. + +;;; Macro to get the instruction exception information into args before +;;; jumping to the instruction exception routine. 'instruction' is the +;;; instruction name, popped is a number representing the number of stack +;;; pops that have occured when this exception was started. + +(defmacro prepare-exception + (instruction popped + &optional operand tag + (fixed-arity nil arity-p) (fixed-arithmetic? nil arith-p)) + (declare (ignore operand popped)) + (let ((opcode (gethash instruction *ivory-instruction-opcode-table*)) + (tag-is-reg? (lisp:and tag (find-register tag)))) + (assert (not (null opcode)) (instruction) + "~S is not a known instruction" instruction) + (multiple-value-bind (arity stack? arithmetic?) + (instruction-exception-info opcode) + `(,@(cond + (stack? + `(;; operand not needed + ,@(when tag + (if tag-is-reg? + `((mov arg6 ,tag "arg6 = tag to dispatch on")) + `((li arg6 ,tag "arg6 = tag to dispatch on")))) + (li arg3 1 "arg3 = stackp"))) + (t + `(,@(when tag + (if tag-is-reg? + `((mov arg6 ,tag "arg6 = tag to dispatch on")) + `((li arg6 ,tag "arg6 = tag to dispatch on")))) + (clr arg3 "arg3 = stackp") + ;; If this is an address-format opcode, arg5 is the SCA + ;; and will be converted appropriately in the handler + ))) + ,@(if arity-p + (assert (eq arity fixed-arity) () "You lied") + `((li arg1 ,arity "arg1 = instruction arity"))) + ;; The Handler always loads the opcode (correctly) from iCP, so + ;; that multiple opcodes can share the same preparation + ,@(if arith-p + (assert (eq arithmetic? fixed-arithmetic?) () "You lied") + `((li arg4 ,(if arithmetic? 1 0) "arg4 = arithmeticp"))) + )))) + +(defmacro exception-handler (specialp tvi next-pc taillabel &optional fixed-arity) + (check-temporaries (tvi next-pc) ('arg1 'arg2 'arg3 'arg5 't1 't2 't3 't4)) + (let ((l1 (gensym)) + (l2 (gensym)) + (l3 (gensym)) + (l4 (gensym)) + (l5 (gensym)) + (sk (gensym)) + (sk2 (gensym)) + (sk3 (gensym))) + `((LD t2 PROCESSORSTATE_LINKAGE (Ivory)) + (LD iSP PROCESSORSTATE_RESTARTSP (ivory) "fix the stack pointer") + (LD arg2 CACHELINE_INSTRUCTION (iCP) "fetch the real opcode") + (branch-true t2 |NativeException|) + ,@(when fixed-arity + `((load-constant arg1 ,fixed-arity))) + ,@(unless (eq specialp :arithmetic) + ;; all arithmetic exceptions have an unstacked operand + `((branch-if-nonzero arg3 ,l2 "J. if arguments stacked"))) + ;; --- Should be a subroutine + ;; Push unstacked argument + (extrdi t1 arg2 16 16 "Get original operand") + (XORI t3 t1 #o1000 "t3 is non-zero iff SP|POP operand") + (branch-false t3 ,l2 "SP|POP operand recovered by restoring SP") + (ADDI arg5 iFP 0 "Assume FP mode") + (ADDI t3 iSP #.(* -255 8) "SP mode constant") + (extrdi t4 arg2 8 16 "Get the mode bits") + (extrdi t2 arg2 8 24 "Extract (8-bit, unsigned) operand") + (ADDI t4 t4 -2 "t4 = -2 FP, -1 LP, 0 SP, 1 Imm") + (ANDI-DOT R31 t4 1 "(CMOVLBS t4 iLP arg5)") + (BC 12 2 ,sk3 "B.EQ") + (mov arg5 iLP "LP or Immediate mode") + (unlikely-label ,sk3) + (CMPI 0 1 t4 0) + (BC 4 2 ,sk "B.NE") + (mov arg5 t3 "SP mode") + (unlikely-label ,sk) + (sldi t3 t2 3) + (ADD arg5 t3 arg5 "Compute operand address") + (branch-if-less-than-or-equal-to-zero t4 ,l3 "Not immediate mode") + (exts t1 t2 8) + (srdi t3 arg2 #.(+ 6 10)) + (ADDI arg5 Ivory PROCESSORSTATE_IMMEDIATE_ARG "Immediate mode constant") + (ANDI-DOT R31 t3 1 "(CMOVLBC t3 t1 t2)") + (BC 4 2 ,sk2 "B.NE") + (mov t2 t1 "Signed immediate") + (unlikely-label ,sk2) + (STW t2 PROCESSORSTATE_IMMEDIATE_ARG+4 (Ivory)) + (label ,l3) + (load-constant t1 #.(dpb -1 (byte 2 (+ 5 10)) 0)) + (AND t2 arg2 t1) + (XOR t3 t1 t2) + (branch-true t3 ,l4 "J. if not address-format operand") + (SCAtoVMA arg5 t1 t2) + (li t2 |TypeLocative|) + (SetTag t2 t1 arg5) + (B ,l5) + (label ,l4) + (LD arg5 0 (arg5) "Fetch the arg") + (label ,l5) + (stack-push-with-cdr arg5) + (label ,l2) + ,@(if (eq specialp :arithmetic) + `((srdi t4 arg2 17 "Get unary/nary bit of opcode") + (li arg1 1 "Assume unary") + ;(ADDI t4 arg1 -1) + (clr ,tvi) + (mov t2 iSP) + (ANDI-DOT R31 t4 1 "BLBC") + (BC 12 2 ,l1 "J. if not binary arithmetic dispatch") + (li arg1 2 "Nary -> Binary") + (stack-read-tag iSP ,tvi) + (ADDI t2 t2 -8) + (ANDI-DOT ,tvi ,tvi 7 "low three bits has opcode tag for op2") + (label ,l1) + (srdi arg2 arg2 #.(- 10 6) "Shift opcode into position") + (stack-read-tag t2 t2) + (ANDI-DOT arg2 arg2 #.(dpb -1 (byte 5 6) 0) "five bits from the opcode") + (ANDI-DOT t2 t2 7) + (sldi t4 t2 3) + (ADD ,tvi t4 ,tvi) + (OR ,tvi arg2 ,tvi) + (ADDI ,tvi ,tvi |TrapVectorArithmeticInstructionException|) + (passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorArithmeticInstructionException| t1 t2) + (passthru "#endif") + ) + `((srdi arg2 arg2 10 "Shift opcode into position") + (ANDI-DOT arg2 arg2 #.(dpb -1 (byte 8 0) 0) "Just 8-bits of opcode") + (ADDI ,tvi arg2 |TrapVectorInstructionException|) + (passthru "#ifdef TRAPMETERING") + (maybe-meter-trap |TrapVectorInstructionException| t1 t2) + (passthru "#endif") + )) + ,@(if (eq specialp :loop) + `((mov ,next-pc arg5)) + `((LD ,next-pc CACHELINE_NEXTPCDATA (iCP)))) + (B ,taillabel)))) + +(defmacro exception-handler-common-tail (tvi arity next-pc) + (check-temporaries (tvi arity next-pc) ('t1 't2 't3 't4 't5 't6 't7 't8 't9 't10)) + `((take-post-trap ,tvi ,arity t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 ,next-pc))) + +;;; Fin. diff --git a/g5-emulator/intrpmac.lisp b/g5-emulator/intrpmac.lisp new file mode 100644 index 0000000..480c4fa --- /dev/null +++ b/g5-emulator/intrpmac.lisp @@ -0,0 +1,1402 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +(defmacro check-temporaries ((&rest lives) (&rest temps)) + `(check-temporaries-1 (list ,@lives) (list ,@temps))) + +(defvar *memoized-vmdata* nil) +(defvar *memoized-vmtags* nil) +(defvar *memoized-base* nil) +(defvar *memoized-limit* nil) +(defvar *memoized-action* nil) +(defvar *memoized-action-cycle* nil) +(defvar *cant-be-in-cache-p* nil) + +;;+++ Is this ever a kludge or what! +(defvar *inhibit-alignment-in-memory-read* nil) + +(eval-when (compile load eval) +(defun check-temporaries-1 (lives temps) + (let ((shared (intersection lives temps + :test #'(lambda (r1 r2) + (eql (register-asmname (find-register r1)) + (register-asmname (find-register r2))))))) + (when shared + (compiler:warn "The following registers are used as both live ~ + registers and temps in ~A:~%~A" + *function-being-processed* shared))) + (when *memoized-vmdata* + (stack-let ((sc-memos (list *memoized-vmdata* *memoized-vmtags* + *memoized-base* *memoized-limit*)) + (memos (list *memoized-vmdata* *memoized-vmtags*)) + (regs (append lives temps))) + (let ((shared (intersection (if *cant-be-in-cache-p* memos sc-memos) regs + :test #'(lambda (r1 r2) + (eql (register-asmname (find-register r1)) + (register-asmname (find-register r2))))))) + (when shared + (compiler:warn "The following memoized registers are being reused in ~A:~%~A" + *function-being-processed* shared)))))) +) ;eval-when + +(defmacro branch-true (r label &optional comment) + `((branch-if-nonzero ,r ,label ,@(if comment `(,comment))))) + +(defmacro long-branch-true (r label &optional comment) + `((long-branch-if-nonzero ,r ,label ,@(if comment `(,comment))))) + +(defmacro branch-false (r label &optional comment) + `((branch-if-zero ,r ,label ,@(if comment `(,comment))))) + +(defmacro long-branch-false (r label &optional comment) + `((long-branch-if-zero ,r ,label ,@(if comment `(,comment))))) + +(defmacro force-alignment () + `((label ,(gensym)))) + + +;;; This macro assumes that the PC is a halfword address where the lsbit +;;; is 1 for odd, 0 for even. +;;; If you are using this, chances are you want to just jump to either +;;; InterpretInstructionForJump or InterpretInstructionForBranch... +#+old-cache-hash +(defmacro PC-TO-iCACHEENT (address cpos temp temp2) + (check-temporaries (address cpos) (temp temp2)) + `((comment "Convert a halfword address into a CP pointer.") + ;; In the case where the cache line mask is 16 or fewer bits, this + (load-constant ,temp ,(eval |cacheline$K-mask|)) + (LD ,temp2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (AND ,cpos ,address ,temp) + ;; Knowing that cachelinesize is 48 bytes 3<<4 + (sldi ,temp ,cpos 5 "temp=cpos*32") + (sldi ,cpos ,cpos 4 "cpos=cpos*16") + (ADD ,temp2 ,temp2 ,temp "temp2=base+cpos*32") + (ADD ,cpos ,temp2 ,cpos "cpos=base+cpos*48"))) + +;;; New version tries to use some of the higher order bits in order to +;;; get better distribution through the instruction cache +#-old-cache-hash +(defmacro PC-TO-iCACHEENT (address cpos temp temp2) + (check-temporaries (address cpos) (temp temp2)) + `((comment "Convert a halfword address into a CP pointer.") + ;; In the case where the cache line mask is 16 or fewer bits, this + (srdi ,cpos ,address #.|CacheLineRShift| "Get third byte into bottom") + (LD ,temp2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (load-constant ,temp #.|CacheLineMask|) + (sldi ,cpos ,cpos #.|CacheLineLShift| "Now third byte is zero-shifted") + (ADD ,cpos ,address ,cpos) + (AND ,cpos ,cpos ,temp) + ;; Knowing that cachelinesize is 48 bytes 3<<4 + (sldi ,temp ,cpos 5 "temp=cpos*32") + (sldi ,cpos ,cpos 4 "cpos=cpos*16") + (ADD ,temp2 ,temp2 ,temp "temp2=base+cpos*32") + (ADD ,cpos ,temp2 ,cpos "cpos=base+cpos*48"))) + +;;; The next two macros deal with translating between halfword addresses and PC's +(defmacro convert-pc-to-continuation (apc ctag cdata &optional ignore) + (declare (ignore ignore)) + (check-temporaries (apc) (ctag cdata)) + `((comment "Convert PC to a real continuation.") + (ANDI-DOT ,ctag ,apc 1) + (srdi ,cdata ,apc 1 "convert PC to a real word address.") + (ADDI ,ctag ,ctag |TypeEvenPC|))) + +(defmacro convert-continuation-to-pc (ctag cdata apc &optional ignore) + (declare (ignore ignore)) + (check-temporaries (ctag cdata) (apc)) + `((comment "Convert real continuation to PC.") + (ANDI-DOT ,apc ,ctag 1) + (ADD ,apc ,cdata ,apc) + (ADD ,apc ,cdata ,apc))) + + +;;; The next two macros deal with converting between stack cache addresses +;;; and vma's. Both of these macros assume that SCA / VMA are stack cache +;;; addresses +(defmacro SCAtoVMA (SCA VMA temp) + (check-temporaries (SCA) (VMA temp)) + `((comment "Convert stack cache address to VMA") + (LD ,temp PROCESSORSTATE_STACKCACHEDATA (ivory)) + ,@(if *memoized-base* + `() + `( + (LD ,vma PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + )) + (SUBF ,temp ,temp ,sca "stack cache base relative offset") + (srdi ,temp ,temp 3 "convert byte address to word address") + (ADD ,vma ,temp ,(lisp:or *memoized-base* vma) "reconstruct VMA"))) + +(defmacro VMAtoSCA (VMA SCA temp) + (check-temporaries (VMA) (SCA temp)) + `((comment "Convert VMA to stack cache address") + ,@(if *memoized-base* + `() + `( + (LD ,temp PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + )) + (LD ,sca PROCESSORSTATE_STACKCACHEDATA (ivory)) + (SUBF ,temp ,(lisp:or *memoized-base* temp) ,vma "stack cache base relative offset") + (sldi ,temp ,temp 3) + (ADD ,sca ,temp ,sca "reconstruct SCA"))) + + +(defmacro VMAinStackCache (VMA notincache word-offset temp2) + "Branches to NOTINCACHE if out of range, leaves stack-cache word-offset in WORD-OFFSET" + (check-temporaries (VMA) (word-offset temp2)) + (assert (not (eq VMA word-offset)) () "Can't use ~A as ~A" VMA 'word-offset) + `(,@(if (lisp:and *memoized-base* *memoized-limit*) + `() + `( + (LD ,word-offset PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the cache") + (LWA ,temp2 PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)") + )) + (SUBF ,word-offset ,(lisp:or *memoized-base* word-offset) ,VMA "Stack cache offset") + (CMPL 0 1 ,word-offset ,(lisp:or *memoized-limit* temp2) "In range?") + (BC 4 0 ,notincache "J. if not in cache"))) + +(defmacro VMAtoSCAmaybe (VMA SCA notincache temp temp2) + "Either branches to notincache or converts VMA" + (check-temporaries (VMA SCA) (temp temp2)) + `(;; In-line (VMAinStackCache ,VMA ,notincache ,temp ,SCA) for dual-issue + ,@(if (lisp:and *memoized-base* *memoized-limit*) + `() + `( + (LD ,temp PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LWA ,sca PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)") + )) + (SUBF ,temp ,(lisp:or *memoized-base* temp) ,vma "Stack cache offset") + (CMPL 0 1 ,temp ,(lisp:or *memoized-limit* sca) "In range?") + (LD ,sca PROCESSORSTATE_STACKCACHEDATA (ivory)) + (BC 4 0 ,notincache "J. if not in cache") + ;; Depends on VMAinStackCache leaving TEMP in a useful state + (sldi ,temp2 ,temp 3) + (ADD ,sca ,temp2 ,sca "reconstruct SCA"))) + +;;; These pseud instructions extract parts from a packed Ivory word. In such a word, +;;; the most significantthree bytes are zero, the next byte is TAG, the next 32 bits +;;; are data. Within the interpreter Ivory words are passed around like this. + +(defmacro TagTypeFromLispObj (from to &optional comment) + `((comment "TagType from LispObj.") + (srdi ,to ,from 32 ,@(if comment `(,comment))) + (ANDI-DOT ,to ,to 63))) + +(defmacro TagCdrFromLispObj (from to &optional comment) + `((comment "TagCdr from LispObj.") + (srdi ,to ,from ,(+ 32 6) ,@(if comment `(,comment))))) + +(defmacro PackedInstructionP (iword temp &optional comment) + (declare (ignore comment)) + (check-temporaries (iword) (temp)) + `((comment "Identifiy a packed instruction type.") + (extrdi ,temp ,iword 8 24 "Extract the tag byte") + (ANDI-DOT ,temp ,temp #o60 "Select two bits") + (ADDI ,temp ,temp #.(- #o60) "temp==0 if packed"))) + +;;; These pseudo instructions extract parts from unpacked pieces. A register contains +;;; either a tag in the least significant byte, zeros elsewhere, or a datum in the +;;; least significant longword, zeros elsewhere. + +(defmacro TagType (from to &optional comment) + `((comment "TagType.") + (ANDI-DOT ,to ,from 63 ,@(if comment `(,comment))))) + +(defmacro TagCdr (from to &optional comment) + `((comment "TagCdr.") + (srdi ,to ,from 6 ,@(if comment `(,comment))))) + +(defmacro SetTag (tag data word &optional comment) + (assert (not (eq data word)) () "~A would be smashed before used" data) + `((comment "SetTag.") + (sldi ,word ,tag 32) + (OR ,word ,data ,word ,@(if comment `(,comment))))) + +(defmacro CheckDataType (tag type labl temp &optional long-jump?) + (check-temporaries (tag) (temp)) + `((SUBI ,temp ,tag ,type) + (ANDI-DOT ,temp ,temp #x3F "Strip CDR code") + ,@(if long-jump? + `((long-branch-if-nonzero ,temp ,labl)) + `((branch-if-nonzero ,temp ,labl))))) + +(defmacro CheckAdjacentDataTypes (tag base-type ntypes labl temp &optional long-jump?) + (check-temporaries (tag) (temp)) + (assert (zerop (mod ntypes (lsh 1 (1- (integer-length ntypes))))) (ntypes) + "NTYPES (~D) must be a power of two." ntypes) + `((SUBI ,temp ,tag ,base-type) + (ANDI-DOT ,temp ,temp ,(logand #x3F (lognot (1- ntypes))) "Strip CDR code, low bits") + ,@(if long-jump? + `((long-branch-if-nonzero ,temp ,labl)) + `((branch-if-nonzero ,temp ,labl))))) + +(defmacro NumericTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch numericexception))) + +(defmacro UnaryNumericTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch unarynumericexception))) + +(defmacro SpareTypeException (tag instruction op condition) + `((prepare-exception ,instruction 0 ,op ,tag) + (prepare-trap 0 ,condition nil) + (external-branch spareexception))) + +(defmacro ListTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch listexception))) + +;; Idea here is that prepare-trap saves the relevant microstate in case +;; we decide we don't have an exception, but rather just have a plain +;; old illegal operand. +(defmacro ArrayTypeException (tag instruction op condition) + `((prepare-exception ,instruction 0 ,op ,tag) + (prepare-trap 0 ,condition nil) + (external-branch arrayexception))) + +(defmacro maybe-icount (r) + (let ((lb (gensym))) + `((comment "Update the instruction count.") + (LD ,r PROCESSORSTATE_INSTRUCTION_COUNT (ivory)) + (ADDI ,r ,r -1 "Decrement the instruction count.") + (branch-if-nonzero ,r ,lb "J. if not reached stop point.") + (NOP "put a breakpoint here to catch stops") + (label ,lb) + (STD ,r PROCESSORSTATE_INSTRUCTION_COUNT (ivory))))) + +(defmacro maybe-statistics (temp temp2 temp3 temp4 temp5 temp6) + `((LD ,temp CACHELINE_CODE (iCP) "The instruction.") + (LD ,temp2 PROCESSORSTATE_STATISTICS (ivory) "The usage statistics array") + (load-constant ,temp6 #x1FFF) + (srdi ,temp3 ,temp 4) + (AND ,temp3 ,temp3 ,temp6 "Extract the address") + (sldi ,temp4 ,temp3 2) ; temp4:=4*temp3 + (ADD ,temp4 ,temp4 ,temp2 "Compute the index to the usage data for this instn.") + (LWA ,temp5 0 (,temp4) "Get current usage data") + (ADDI ,temp5 ,temp5 1 "Increment") + (STW ,temp5 0 (,temp4) "Set current usage data"))) + +(defmacro maybe-meter-hit (temp temp2 temp3 temp4 temp5 temp6) + (let ((done (gensym)) + (sk1 (gensym))) + `((LWA ,temp2 PROCESSORSTATE_METERCOUNT (ivory) "The number of remaining tokens.") + (LD ,temp PROCESSORSTATE_METERDATABUFF (ivory) "The cache miss meter buffer.") + (LWA ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (ADDI ,temp2 ,temp2 -1 "record a cache hit") + (branch-if-nonzero ,temp2 ,done) + ;; Here is we reached the end of our gathering window. + (LWA ,temp5 PROCESSORSTATE_METERMASK (ivory)) + (sldi ,temp6 ,temp4 2) ; ,temp6:=4* ,temp4 + (ADD ,temp ,temp6 ,temp "position of the current data item") + (LWA ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (ADDI ,temp4 ,temp4 1) + (AND ,temp4 ,temp4 ,temp5) + (LWA ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (SUBF ,temp3 ,temp5 ,temp6) + (CMPI 0 1 ,temp3 0) + (BC 4 1 ,sk1 "B.LE") + (mov ,temp5 ,temp6) + (unlikely-label ,sk1) + (STW ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (STW ,temp6 0 (,temp) "store the datapoint") + (STW ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (stzw PROCESSORSTATE_METERVALUE (ivory)) + (LWA ,temp2 PROCESSORSTATE_METERFREQ (ivory)) + (label ,done) + (STW ,temp2 PROCESSORSTATE_METERCOUNT (ivory))))) + +(defmacro maybe-meter-miss (temp temp2 temp3 temp4 temp5 temp6) + (let ((done (gensym)) + (sk1 (gensym))) + `((LWA ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (LWA ,temp2 PROCESSORSTATE_METERCOUNT (ivory) "The number of remaining tokens.") + (LD ,temp PROCESSORSTATE_METERDATABUFF (ivory) "The cache miss meter buffer.") + ;(ADDI ,temp2 ,temp2 -1 "record a cache miss") + (ADDI ,temp6 ,temp6 1 "count the miss.") + (LWA ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (STW ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (branch-if-nonzero ,temp2 ,done) + ;; Here is we reached the end of our gathering window. + (LWA ,temp5 PROCESSORSTATE_METERMASK (ivory)) + (sldi ,temp2 ,temp4 2) ; ,temp2:=4* ,temp4 + (ADD ,temp ,temp2 ,temp "position of the current data item") + (ADDI ,temp4 ,temp4 1) + (AND ,temp4 ,temp4 ,temp5) + (LWA ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (SUBF ,temp3 ,temp5 ,temp6) + (CMPI 0 1 ,temp3 0) + (BC 4 1 ,sk1 "B.LE") + (mov ,temp5 ,temp6) + (unlikely-label ,sk1) + (STW ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (STW ,temp6 0 (,temp) "store the datapoint") + (STW ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (stzw PROCESSORSTATE_METERVALUE (ivory)) + (LWA ,temp2 PROCESSORSTATE_METERFREQ (ivory)) + (label ,done) + (STW ,temp2 PROCESSORSTATE_METERCOUNT (ivory))))) + +#+Genera +(defun show-icache-histogram (&optional pathname (stream *standard-output*)) + (declare (special sct:*vlm-destination*)) + (when (null pathname) + (setq pathname (merge-pathnames "cachedata.lisp" sct:*vlm-destination*))) + (let ((cache-data (with-open-file (s pathname :direction :input) + (read s))) + (sum 0)) + (destructuring-bind ((size max freq) missdata filldata) cache-data + ;; The idea here is to draw a histogram in chunks that are + ;; about as wide as the viewport. We do this because if we + ;; draw the entire histogram in one chunk, it takes forever to + ;; do horizontal scrolling because the underlying window system + ;; spends forever drawing lines. + (fresh-line stream) + (let ((vw (floor (clim:bounding-rectangle-width (clim:window-viewport stream)) 2)) + (x 0) + (p missdata)) + (clim:with-end-of-line-action (stream :allow) + (clim:with-room-for-graphics (stream) + (loop while p doing + (let ((segments nil)) + (dotimes (i vw) + (when (null p) (return)) + (let* ((raw-y (pop p)) + (y (round raw-y 10))) + (setq segments (nconc segments (list x 0 x y))) + (incf sum raw-y) + (incf x))) + (clim:draw-lines* stream segments))))) + (fresh-line stream) + (let* ((avg (float (/ sum size))) + (std (let ((diffs 0)) + (dolist (y missdata) + (incf diffs (* (- y avg) (- y avg)))) + (sqrt (/ diffs size))))) + (format stream "Average is ~D (deviation ~D) fills per ~D cycles" + avg std freq)))))) + +(defmacro maybe-meter-trap (tvi temp temp2) + `((LD ,temp PROCESSORSTATE_TRAPMETERDATA (ivory) "pointer to trap data vector") + (li ,temp2 ,tvi "get the vector index") + (sldi ,temp2 ,temp2 3) + (ADD ,temp ,temp2 ,temp) + (LD ,temp2 0 (,temp) "get the old value") + (ADDI ,temp2 ,temp2 1 "increment it") + (STD ,temp2 0 (,temp) "and store it back"))) + +(defmacro maybe-trace (temp temp2 temp3 temp4 temp5 temp6) + (let ((dotrace (gensym)) + (finishtrace (gensym)) + (nowrap (gensym)) + (notrace (gensym)) + (sk1 (gensym)) + (sk2 (gensym))) + `((comment "Trace instructions if requested.") + (LD ,temp PROCESSORSTATE_TRACE_HOOK (ivory)) + (branch-if-zero ,temp ,notrace "J. if not tracing.") + (comment "Record an instruction trace entry") + (LWA ,temp2 TRACEDATA_RECORDING_P (,temp)) + (LD ,temp3 TRACEDATA_START_PC (,temp)) + (branch-true ,temp2 ,dotrace "Jump if recording is on") + (CMP 0 1 ,temp3 iPC "Check if at start PC") + (MFCR ,temp3 "Grab the condition register") + (ANDIS-DOT ,temp3 ,temp3 #x2000 "Isolate CR0 EQ bit") + (STW ,temp3 TRACEDATA_RECORDING_P (,temp)) + (branch-false ,temp3 ,notrace "Jump if not at the start PC") + (label ,dotrace) + (LD ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Get address of next trace record ") + (LD ,temp3 PROCESSORSTATE_INSTRUCTION_COUNT (ivory)) + (STD iPC TRACERECORD_EPC (,temp2) "Save current PC") + (STD ,temp3 TRACERECORD_COUNTER (,temp2) "Save instruction count") + (LD ,temp3 0 (iSP)) + (SCAtoVMA iSP ,temp4 ,temp5) + (STD ,temp3 TRACERECORD_TOS (,temp2) "Save current value of TOS") + (STD ,temp4 TRACERECORD_SP (,temp2) "Save current SP") + ;; NOTE: See the comment in idispat.ppcs as to why we use CACHELINE_OPERAND-4 + (LWA ,temp3 CACHELINE_OPERAND-4 (iCP)) + (LD ,temp4 CACHELINE_CODE (iCP)) + (STW ,temp3 TRACERECORD_OPERAND (,temp2) "Save current instruction's operand") + (STD ,temp4 TRACERECORD_INSTRUCTION (,temp2) "Save pointer to current instruction code") + (LD ,temp4 PROCESSORSTATE_CONTROL (ivory)) ;+++TEMPORARY + (LD ,temp5 CACHELINE_INSTRUCTION (iCP)) + (stzw TRACERECORD_CATCH_BLOCK_P (,temp2) "We don't yet record catch blocks") + (STD ,temp4 TRACERECORD_CATCH_BLOCK_0 (,temp2) "Save control register") ;+++TEMPORARY + (LD ,temp3 PROCESSORSTATE_TVI (ivory)) + (STD ,temp5 TRACERECORD_INSTRUCTION_DATA (,temp2) "Save full word instruction operand") + (STW ,temp3 TRACERECORD_TRAP_P (,temp2) "Save trap indiciator") + (branch-if-zero ,temp3 ,finishtrace "Jump if didn't trap") + (stack-read-disp iFP #.(* 8 2) ,temp3) + (stzd PROCESSORSTATE_TVI (ivory) "Zero flag to avoid false trap entries") + (stack-read-disp iFP #.(* 8 3) ,temp4) + (STD ,temp3 TRACERECORD_TRAP_DATA_0 (,temp2) "Save trap vector index") + (stack-read-disp iFP #.(* 8 4) ,temp5) + (STD ,temp4 TRACERECORD_TRAP_DATA_1 (,temp2) "Save fault PC") + (stack-read-disp iFP #.(* 8 5) ,temp6) + (STD ,temp5 TRACERECORD_TRAP_DATA_2 (,temp2) "Save two additional arguments") + (STD ,temp6 TRACERECORD_TRAP_DATA_3 (,temp2)) + (label ,finishtrace) + (ADDI ,temp2 ,temp2 TRACERECORDSIZE "Bump to next trace record") + (LD ,temp3 TRACEDATA_RECORDS_START (,temp) "Get pointer to start of trace records") + (LD ,temp4 TRACEDATA_RECORDS_END (,temp) "Get pointer to end of trace record") + (LD ,temp5 TRACEDATA_PRINTER (,temp) "Function to print trace if non-zero") + (CMP 0 1 ,temp4 ,temp2 "CR.GT iff we're not about to wrap the circular buffer") + (BC 12 1 ,sk1 "B.GT") + (branch-if-zero ,temp5 ,sk2 "Jump if we aren't recording trace to a file") + (STD ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Save next record pointer") + (call-c-function ,temp5 ,temp6 t) + (CMPI 0 1 ,temp4 0 "Force CR0 LT, EQ bits off (i.e., don't claim we wrapped") + (unlikely-label ,sk2) + (mov ,temp2 ,temp3 "Update next record pointer iff we wrapped") + (unlikely-label ,sk1) + (MFCR ,temp4 "Grab the condition register") + (ANDIS-DOT ,temp4 ,temp4 #xA000 "Isolate CR0 LT, EQ bits") + (STD ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Save next record pointer") + (branch-if-zero ,temp4 ,nowrap "Jump if we didn't wrap") + (STW ,temp4 TRACEDATA_WRAP_P (,temp) "Set flag indicating that we wrapped") + (label ,nowrap) + (LD ,temp2 TRACEDATA_STOP_PC (,temp)) + (CMP 0 1 ,temp2 iPC "Check if at stop PC") + (MFCR ,temp2 "Grab the condition register") + (ANDIS-DOT ,temp2 ,temp2 #xC000 "Isolate CR0 LT, GT bits") + (STW ,temp2 TRACEDATA_RECORDING_P (,temp)) + (label ,notrace)))) + +;; This means "iPC and iCP have been set up, so execute that instruction". +;; Note the interpretInstruction also checks to see if we have been +;; requested to stop. +(defmacro ContinueToInterpretInstruction (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((B interpretinstruction ,@(if comment `(,comment))))) + +;; Use this if you have only set up the PC +(defmacro ContinueToInterpretInstruction-ValidateCache (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((B interpretInstructionForBranch ,@(if comment `(,comment))))) + +;; This means "increment the PC by 1 (by picking up iPC and iCP from the +;; current instruction's cache line) and execute that instruction". That +;; is, this is used to continue executing straight-line code, and hence +;; does not check to see if the emulator has been requested to stop. +;; This can often dual issue with previous instruction. +(defmacro ContinueToNextInstruction (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((B nextinstruction ,@(if comment `(,comment))))) + +(defmacro GetNextPC () + `((LD iPC CACHELINE_NEXTPCDATA (iCP)))) + +(defmacro PrefetchNextPC (temp) + `((LD ,temp CACHELINE_NEXTPCDATA (iCP)))) + +(defmacro SetNextPC (temp) + `((mov iPC ,temp))) + +(defmacro GetNextCP () + `((LD iCP CACHELINE_NEXTCP (iCP)))) + +(defmacro PrefetchNextCP (temp) + `((LD ,temp CACHELINE_NEXTCP (iCP)))) + +(defmacro SetNextCP (temp) + `((mov iCP ,temp))) + +(defmacro GetNextPCandCP () + `((LD iPC CACHELINE_NEXTPCDATA (iCP)) + (LD iCP CACHELINE_NEXTCP (iCP)))) + +;; Like ContinueToNextInstruction, except that the new iPC and iCP have been +;; set up, which means that we can avoid some stalls in nextInstruction. +(defmacro ContinueToNextInstruction-NoStall (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((B cacheValid ,@(if comment `(,comment))))) + +(defmacro instruction-exception (&optional comment) + `((external-branch exception ,@(if comment `(,comment))))) + +(defmacro arithmetic-exception (&optional comment) + `((external-branch exception ,@(if comment `(,comment))))) + +;; Condition to microstate computation now handled in prepare-trap +(defmacro illegal-operand (condition &optional vma comment) + `((prepare-trap 0 ,condition ,vma) + (external-branch illegaloperand ,@(if comment `(,comment))))) + +(defmacro illegal-instruction (&optional comment) + `((external-branch illegalinstruction ,@(if comment `(,comment))))) + +(defmacro halt-machine (&optional (reason 'HaltReasonHalted) comment) + (ecase reason + (HaltReasonHalted + `((external-branch haltmachine ,@(if comment `(,comment))))) + (HaltReasonFatalStackOverflow + `((external-branch fatalstackoverflow ,@(if comment `(,comment))))) + (HaltReasonIllegalTrapVector + `((external-branch illegaltrapvector ,@(if comment `(,comment))))))) + + +;;; Macros for predicate support. + +;;; If the body can trap, be sure to supply :CAN-TRAP T, otherwise iPC and +;;; iCP will get clobbered prematurely and the trap handler will lose! +(defmacro with-predicate-store ((ttag niltag fall-into temp temp2 &key can-trap) + &body body) + (let* ((prelude `(,(if fall-into `(get-t ,temp) `(get-nil ,temp2)) + (force-alignment) ; if in same word separate! + ,(if fall-into `(get-nil ,temp2) `(get-t ,temp)) + ,@(unless can-trap `((GetNextPCandCP))))) + (tclause `((label ,ttag "Here to push T") + (STD ,temp 0 (iSP)) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall)))) + (nilclause `((comment "here to push NIL") + (label ,niltag) + (STD ,temp2 0 (iSP)) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall))))) + (if fall-into + (append prelude `(,@body) tclause nilclause) + (append prelude `(,@body) nilclause tclause)))) + +;;; We now increment iSP *before* the body, so if body uses iSP *BEWARE*! +;;; If the body can trap, be sure to supply :CAN-TRAP T, otherwise iPC and +;;; iCP will get clobbered prematurely and the trap handler will lose! +(defmacro with-predicate-push ((ttag niltag fall-into temp temp2 &key can-trap) + &body body) + (let* ((prelude `((force-alignment) + ,(if fall-into `(get-t ,temp) `(get-nil ,temp2)) + (force-alignment) + ,(if fall-into `(get-nil ,temp2) `(get-t ,temp)) + ,@(unless can-trap `((GetNextPCandCP))))) + (tclause `((label ,ttag "Here to push T") + (STD ,temp 8 (iSP)) + (ADDI iSP iSP 8) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall)))) + (nilclause `((comment "here to push NIL") + (label ,niltag) + (STD ,temp2 8 (iSP)) + (ADD iSP iSP 8) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall))))) + (if fall-into + (append prelude `(,@body) tclause nilclause) + (append prelude `(,@body) nilclause tclause)))) + + + +(defmacro align4k () + `((passthru ,(format nil ".align ~D" 12)) #|| 2^ 12 = 4096 ||#)) + +;;; This will get us to the end of the current 4k chunk (which must be the second 4K +;;; chunk of the page. Then two 4k chunks are skipped. + +(defmacro align4Kskip8K () + `((align4k) ; skip to end of current 4k chunk + (nop) + (align4k) ; skip a half page + (nop) + (align4k))) ; skip another half page + +(defmacro align4kskip4k () + `((align4k) ; skip to end of current 4k chunk + (nop) + (align4k))) + +(defmacro define-instruction (name format (&rest options) &body body &environment env) + #+Genera (declare (zwei:indentation . indent-define-procedure)) + (let ((*function-being-processed* name)) + `((start ,name) + ,@(apply #'expand-instruction-procedure-header format name options) + ,@(collecting-function-epilogue body env) + #---ignore ,@(apply #'expand-instruction-procedure-trailer format name options) + #+++ignore (end ,name ,format)))) + +(clos:defgeneric expand-instruction-procedure-header (format name &key &allow-other-keys)) +(clos:defgeneric expand-instruction-procedure-trailer (format name &key &allow-other-keys)) + +;;; A :full-word-instruction has a single entry point defined to be 'name' +;;; No default unpacking is necessary. All information about the instruction +;;; is available via iCP and iPC. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :full-word-instruction)) name &key) + `((comment ,(format nil "Fullword instruction - ~a" name)) + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x80")) + (passthru ,(format nil " .asciz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" name)))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :full-word-instruction)) name &key) + `((end ,name) + (comment ,(format nil "End of Fullword instruction - ~a" name)))) + + +;;; A :operand-from-stack has four entrypoints, FP LP SP and IM, IM is an +;;; error case, the other cases generate operand loading code and then fall +;;; into the body. The operand obtained is left in 'arg1'. +;;; the SP pop mode falls into the body. This mode needs to be +;;; watched carefully since the arg2 is left with a pointer beyond the top +;;; of the stack. The operand value must be read before the stack is pushed +;;; or it will be overwritten. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack)) name + &key own-immediate needs-tos + provide-immediate signed-immediate) + (assert (not (lisp:and own-immediate provide-immediate)) () "Huh?") + (let ((sk1 (gensym)) + (sk2 (gensym)) + (fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (comment "arg2 has the preloaded 8 bit operand.") + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + + ,@(when provide-immediate + `((comment "arg2 has the preloaded 8 bit operand.") + (passthru "#ifdef TRACING") + ,@(if signed-immediate + `((passthru ,(format nil " .byte 0x83"))) + `((passthru ,(format nil " .byte 0x82")))) + (passthru ,(format nil " .asciz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + ,@(if signed-immediate + `((comment "This sequence only sucks a moderate amount") + ;; Careful! We are using arg1 as a temp so we can + ;; clear arg2 in the stall slot + (exts arg1 arg2 8 "Sign extend the byte argument.") + (clr arg2) + (STW arg1 PROCESSORSTATE_IMMEDIATE_ARG+4 (Ivory)) + (ADDI arg1 Ivory PROCESSORSTATE_IMMEDIATE_ARG)) + `((comment "This sequence is lukewarm") + (STW arg2 PROCESSORSTATE_IMMEDIATE_ARG+4 (Ivory)) + (ADDI arg1 Ivory PROCESSORSTATE_IMMEDIATE_ARG) + (clr arg2))) + (B ,bodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (mov arg1 arg5 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((branch-if-nonzero arg2 ,bodyname) + (LD arg6 0 (arg4) "SP-pop, Reload TOS") + (mov arg1 iSP "SP-pop mode") + (mov iSP arg4 "Adjust SP")) + `( + (CMPI 0 1 arg2 0) + (BC 4 2 ,sk1 "B.NE") + (mov arg1 iSP "SP-pop mode") + (unlikely-label ,sk1) + (CMPI 0 1 arg2 0) + (BC 4 2 ,sk2 "B.NE") + (mov iSP arg4 "Adjust SP if SP-pop mode") + (unlikely-label ,sk2) + )) + + (passthru "#ifdef TRACING") + (B ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (B ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (comment "arg1 has the operand address.") + (sldi arg5 arg2 3) ;+++ is arg5 available? + (ADD arg1 arg5 arg1 "Compute operand address") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack)) name &key own-immediate provide-immediate) + (let ((imname (format nil "~aIM" name))) + `(;; put this here for lack of a better spot + ,@(unless (lisp:or own-immediate provide-immediate) + `((passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (external-branch |DoIStageError| ,(format nil "IMMEDIATE mode not legal in ~a." + name)))) + (end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name))))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack-immediate)) name &key own-immediate needs-tos) + (let ((sk1 (gensym)) + (sk2 (gensym)) + (fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "head~a" name)) + (realbodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (comment "arg2 has the preloaded 8 bit operand.") + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + ,@(unless own-immediate + `((passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (comment "This sequence is lukewarm") + (STW arg2 PROCESSORSTATE_IMMEDIATE_ARG+4 (Ivory)) + (LD arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (B ,realbodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (mov arg1 arg5 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((branch-if-nonzero arg2 ,bodyname) + (mov arg1 arg6 "SP-pop mode, TOS->arg1") + (LD arg6 0 (arg4) "Reload TOS") + (mov iSP arg4 "Adjust SP") + (B ,realbodyname)) + `( + (CMPI 0 1 arg2 0) + (BC 4 2 ,sk1 "B.NE") + (mov arg1 iSP "SP-pop mode") + (unlikely-label ,sk1) + (CMPI 0 1 arg2 0) + (BC 4 2 ,sk2 "B.NE") + (mov iSP arg4 "Adjust SP if SP-pop mode") + (unlikely-label ,sk2) + )) + + (passthru "#ifdef TRACING") + (B ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (B ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (sldi arg5 arg2 3) ; +++ is arg5 available? + (ADD arg1 arg5 arg1 "Compute operand address") + (LD arg1 0 (arg1) "Get the operand") + (label ,realbodyname) + (comment "arg1 has the operand, not sign extended if immediate.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +(defmacro immediate-handler (name) + (let ((doit (format nil "~aIM" name))) + `((passthru "#ifdef TRACING") + (B ,doit) + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciz \"~aIM\"" name)) + (passthru "#endif") + (passthru ,(format nil ".align ~D" *function-alignment*)) + (label ,doit "Entry point for IMMEDIATE mode")))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack-signed-immediate)) name &key own-immediate needs-tos) + (let ((sk1 (gensym)) + (sk2 (gensym)) + (fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "head~a" name)) + (realbodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + ,@(unless own-immediate + `((comment "arg2 has the preloaded 8 bit operand.") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x83")) + (passthru ,(format nil " .asciz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (comment "This sequence only sucks a moderate amount") + (exts arg2 arg2 8 "Sign extend the byte argument.") + (force-alignment) + (STW arg2 PROCESSORSTATE_IMMEDIATE_ARG+4 (Ivory)) + (LD arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (B ,realbodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (mov arg1 arg5 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((branch-if-nonzero arg2 ,bodyname) + (mov arg1 arg6 "SP-pop mode, TOS->arg1") + (LD arg6 0 (arg4) "Reload TOS") + (mov iSP arg4 "Adjust SP") + (B ,realbodyname)) + `( + (CMPI 0 1 arg2 0) + (BC 4 2 ,sk1 "B.NE") + (mov arg1 iSP "SP-pop mode") + (unlikely-label ,sk1) + (CMPI 0 1 arg2 0) + (BC 4 2 ,sk2 "B.NE") + (mov iSP arg4 "Adjust SP if SP-pop mode") + (unlikely-label ,sk2) + )) + + (passthru "#ifdef TRACING") + (B ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (B ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (sldi arg5 arg2 3) ; +++ is arg5 available? + (ADD arg1 arg5 arg1 "Compute operand address") + (LD arg1 0 (arg1) "Get the operand") + (label ,realbodyname) + (comment "arg1 has the operand, sign extended if immediate.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack-signed-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :10-bit-immediate)) name &key own-immediate needs-tos) + (declare (ignore needs-tos)) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Halfword 10 bit immediate instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA0")) + (passthru ,(format nil " .asciz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + ,@(unless own-immediate + `((extrdi arg1 arg3 16 16))) + (comment "arg1 has operand preloaded.") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :10-bit-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :10-bit-signed-immediate)) name &key own-immediate needs-tos) + (declare (ignore needs-tos)) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Halfword 10 bit immediate instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA1")) + (passthru ,(format nil " .asciz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + ,@(unless own-immediate + `((SRADI arg1 arg3 48))) + (comment "arg1 has signed operand preloaded.") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :10-bit-signed-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + +;;; 10 bit operand encoded position= ls 5 bits size=ms5 bits. +;;; 10 bit operand is in arg1, truncated 8 bit is in arg2 +;;; shift arg1 right by 5 bits to give 'size-1' +;;; mask arg2 by #x1F to give position. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :field-extraction)) name &key) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Field Extraction instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA0")) + (passthru ,(format nil " .asciz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + (srdi arg1 arg3 #.(+ 32 5) "Shift the 'size-1' bits into place") + (ANDI-DOT arg2 arg2 #x1F "mask out the unwanted bits in arg2") + (ANDI-DOT arg1 arg1 #x1F "mask out the unwanted bits in arg1") + (comment "arg1 has size-1, arg2 has position.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :field-extraction)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +;;; AH! this is a fun one +;;; This instruction type is actually a fullword in disguise! It therefore +;;; is always on an even instruction boundary! +;;; upon entry, arg2 already has the number of required args. +;;; arg1 has the 10 bit immediate, of which two bits are the ptr field. +;;; we'll shift them into place. We must load the instruction from the cache +;;; to get at the rest of the bits. +;;; we lose two cycles to stalling, and we get no dual. We may want to +;;; pull out the last two instructions and hand position them. Especially as +;;; there are very few of these instructions. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :entry-instruction)) name &key) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Entry instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xB0")) + (passthru ,(format nil " .asciz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + (get-control-register arg5 "The control register") + (srdi arg4 arg3 18 "Pull down the number of optionals") + (extrdi arg1 arg3 8 24 "Extract the 'ptr' field while we are waiting") + (ANDI-DOT arg4 arg4 #xFF) + (comment "arg1=ptr field, arg2=required, arg3=instn, arg4=optionals arg5=control-register")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :entry-instruction)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + + +(defmacro UnimplementedInstruction () + `((comment "This instruction has not been written yet.") + (illegal-operand i-stage-error))) + +;;; Section Conditional macros. + +;;; because the dispatch table for all types is large and prohibitive for +;;; repeating over many instructions, we will attempt to dispatch sequentially. +;;; It is imperative that the order be chosen very carefully! +;;; 1 cycle + 3 cycles per clause until match. +;;; so match on the first clause costs 4 cycles + body of clause +;;; match on second clause costs 7 cycles + body of clause etc. + +(defun last-instruction-is-branch-p (body) + (loop named branchp for clause in (reverse body) do + (loop for instruction = clause then (car instruction) do + (when (atom instruction) + (cond ((member instruction '(label unlikely-label comment)) + (return nil)) + ((member instruction '(B external-branch)) + (return-from branchp t)) + (t + (return-from branchp nil))))))) + +;;; deals with tags of up to 8 bits only +(defmacro basic-dispatch (temp temp2 &body clauses &environment env) + (declare (ignore temp2)) + (let* ((expanded ()) + (end-label (gensym)) + (else-label (assoc :else-label clauses)) + (fall-through nil) + ) + (when else-label + (setq clauses (remove else-label clauses) + else-label (second else-label))) + (loop for rest-label = nil then label + as label = (gensym) + for (clause . rest) on clauses do ;dolist (clause clauses) + (when (null rest) + (if else-label + (setq label else-label) + (setq label end-label))) + (destructuring-bind (key &rest body) clause + (let* ((body (if (lisp:and (atom (car body)) (null (cdr body))) + (car body) + (macroexpand-asm-form body env))) + (dont-emit-branch + (cond + ;; An atom for a clause body means the clause's body + ;; is implemented by branching to that atom (as a + ;; label) + ((atom body) t) + ;; On the first clause, we never emit a branch. If + ;; the clause does not end in a branch, we arrange + ;; for it to "fall-through" to the end-label by + ;; moving the other clauses out of line. If it does + ;; end in a branch, we don't move the other clauses + ;; out of line, but we still don't need to emit a + ;; branch + ((null rest-label) + (setq fall-through (not (last-instruction-is-branch-p body))) + t) + ;; On the last clause, we emit a branch if it doesn't + ;; end in one and the first clause is going to fall + ;; through (otherwise the last clause does) + ((null rest) + (lisp:or (null fall-through) + (last-instruction-is-branch-p body))) + ;; Otherwise, we emit a branch if the clause does not supply it's own + (t (last-instruction-is-branch-p body))))) + (cond ((member key '(:else :otherwise 'else 'otherwise)) + (assert (null rest) () "Else clause not last in dispatch") + (push + `(,@(when rest-label + `((label ,rest-label))) + (comment ,(format nil "Here for all other cases")) + ,@body + ,@(unless dont-emit-branch + `((B ,end-label)))) + expanded)) + ((listp key) + (let ((matchlabel (gensym))) + (push + `(,@(when rest-label + `((label ,rest-label))) + ,@(loop for (cl . rest) on key + collect + (if (lisp:and (integerp cl) (zerop cl)) + `(,@(if (null rest) + `((branch-if-nonzero ,temp ,label)) + `((branch-if-zero ,temp ,matchlabel)))) + `((CMPI 0 1 ,temp ,cl) + (force-alignment) + ,@(if (null rest) + `((BC 12 2 ,label)) + `((BC 4 2 ,matchlabel)))))) + (label ,matchlabel) + (comment ,(format nil "Here if argument ~a" key)) + ,@body + ,@(unless dont-emit-branch + `((B ,end-label)))) + expanded))) + (t + (push + `(,@(when rest-label + `((label ,rest-label))) + ,(if (lisp:and (integerp key) (zerop key)) + (cond ((null body) + `(branch-if-zero ,temp ,end-label)) + ((atom body) + `(branch-if-zero ,temp ,body)) + (t + `(branch-if-nonzero ,temp ,label))) + `((CMPI 0 1 ,temp ,key) + (force-alignment) + ,(cond ((null body) + `(BC 12 2 ,end-label)) + ((atom body) + `(BC 12 2 ,body)) + (t + `(BC 4 2 ,label))))) + ,@(if (atom body) + ;; When last dispatch would fall-though on no + ;; match, have to create an else clause + (when (null rest) + `((B ,label))) + `(((comment ,(format nil "Here if argument ~a" key)) + ,@body + ,@(unless dont-emit-branch + `((B ,end-label))))))) + expanded)))))) + (setq expanded (nreverse expanded)) + (if fall-through + (let ((first (pop expanded))) + (when expanded + (push (apply #'nconc expanded) + *function-epilogue*)) + `(,first + (label ,end-label))) + `(,@(apply #'nconc expanded) + (label ,end-label))))) + +;;; deals with tags of up to 16 bits only +(defmacro mondo-dispatch (temp temp2 &body clauses) + (let* ((expanded ()) + (nlabels (let ((n 0)) + (dolist (clause clauses) + (if (listp (car clause)) + (incf n (length (car clause))) + (incf n 1))) + n)) + (end-label (gensym)) + (i 0) + (label (gensym))) + (dolist (clause clauses) + (cond ((member (car clause) '(:else :otherwise 'else 'otherwise)) + (push + `((comment ,(format nil "Here for all other cases")) + ,@(cdr clause) + ,@(unless (= i nlabels) `((B ,end-label))) + (label ,label)) + expanded)) + ((listp (car clause)) ;+++ this generates more code than it should + (dolist (cl (car clause)) + (push + `((li ,temp2 ,cl) + (SUBF ,temp2 ,temp2 ,temp) + (branch-if-nonzero ,temp2 ,label) + (comment ,(format nil "Here if argument ~a" cl)) + ,@(cdr clause) + ,@(unless (= i nlabels) `((B ,end-label))) + (label ,label)) + expanded) + (incf i) + (setq label (gensym)))) + (t + (push + `((li ,temp2 ,(car clause)) + (SUBF ,temp2 ,temp2 ,temp) + (branch-if-nonzero ,temp2 ,label) + (comment ,(format nil "Here if argument ~a" (car clause))) + ,@(cdr clause) + ,@(unless (= i nlabels) `((B ,end-label))) + (label ,label)) + expanded))) + (incf i) + (setq label (gensym))) + `(,@(apply #'nconc (nreverse expanded)) + (label ,end-label)))) + +(defmacro cdr-code-dispatch (tagreg temp temp2 &body clauses) + (check-temporaries (tagreg) (temp temp2)) + `((ANDI-DOT ,temp ,tagreg #b11000000 "Extract CDR code.") + (basic-dispatch ,temp ,temp2 ,@(sublis `((|CdrNext| . ,(lsh |cdr|$k-|next| 6)) + (|CdrNormal| . ,(lsh |cdr|$k-|normal| 6)) + (|CdrNil| . ,(lsh |cdr|$k-|nil| 6)) + (3 . ,(lsh 3 6))) + clauses)))) + +(defmacro register-dispatch (tagreg temp temp2 &body clauses) + (check-temporaries (tagreg) (temp temp2)) + `(mondo-dispatch ,tagreg ,temp2 ,@clauses)) + +(defmacro type-dispatch (tagreg temp temp2 &body clauses) + (check-temporaries (tagreg) (temp temp2)) + `((ANDI-DOT ,temp ,tagreg #x3F "Strip off any CDR code bits.") + (basic-dispatch ,temp ,temp2 ,@clauses))) + + +(defmacro binary-type-dispatch ((tag1 tag2 tag1-stripped temp2 tag2-stripped temp4) + &body clauses) + (check-temporaries (tag1 tag2) (tag1-stripped temp2 tag2-stripped temp4)) + "Clauses are ((type1 type2) . body) or (:else1 . body), (:else2 . + body), or (:else . body)" + (let ((subclause-alist ()) + (inner-dispatches ()) + (elseclause nil) + (else1clause nil) + (else2clause nil) + (eclabel (gensym)) + (ec1label (gensym)) + (ec2label (gensym)) + (done (gensym))) + ;; For each clause, sort into first type, subclauses + ;; Next make a nested type-dispatch + (dolist (cl clauses) + (cond ((eq (car cl) :else1) + (setq else1clause `((label ,ec1label) ,@(cdr cl)))) + ((eq (car cl) :else2) + (setq else2clause `((label ,ec2label) ,@(cdr cl)))) + ((eq (car cl) :else) + (setq elseclause `((label ,eclabel) ,@(cdr cl)))) + (t (let ((scl (assoc (caar cl) subclause-alist))) + (if scl + (setf (cdr scl) (cons `(,(cadar cl) ,@(cdr cl)) (cdr scl))) + (push `(,(caar cl) (,(cadar cl) ,@(cdr cl))) subclause-alist)))))) + (assert (not (lisp:and elseclause (lisp:or else1clause else2clause))) () + "Can't have :else and :else") + (assert (lisp:or elseclause (lisp:and else1clause else2clause)) () + "Must supply both :else1 and :else2") + ;; Add else clauses to the embedded dispatches if required + (cond (else2clause + (dolist (cl subclause-alist) + (push `(:else-label ,ec2label) (cdr cl)))) + (elseclause + (dolist (cl subclause-alist) + (push `(:else-label ,eclabel) (cdr cl))))) + ;; All clauses have been organized, now construct the inner type-dispatches + ;; Clauses are reversed in alist entries. + (dolist (cl subclause-alist) + (push `(,(car cl) + ;; Cdr stripped in top-level + (basic-dispatch ,tag2-stripped ,temp4 ,@(nreverse (cdr cl)))) inner-dispatches)) + + ;; Finally emit the outer dispatch! + `(;; Touch the tags in 1/2 order, as callee might expect + (ANDI-DOT ,tag1-stripped ,tag1 #x3F "Strip off any CDR code bits.") + (ANDI-DOT ,tag2-stripped ,tag2 #x3F "Strip off any CDR code bits.") + (basic-dispatch ,tag1-stripped ,temp2 + ,@inner-dispatches + (:else + ,@elseclause + ,@else1clause + ,@(when else2clause + `((B ,done) + ,@else2clause + (label ,done)))))))) + +;;; State Saving and restoring, register definitions. + +;;; Macros to save and restore the cached state of the machine in the ivory object. + +(defmacro cache-ivory-state () + `((LD iCP PROCESSORSTATE_CP (ivory)) + (LD iPC PROCESSORSTATE_EPC (ivory)) + (LD iSP PROCESSORSTATE_SP (ivory)) + (LD iFP PROCESSORSTATE_FP (ivory)) + (LD iLP PROCESSORSTATE_LP (ivory)))) + +(defmacro decache-ivory-state () + `((STD iCP PROCESSORSTATE_CP (ivory)) + (STD iPC PROCESSORSTATE_EPC (ivory)) + (STD iSP PROCESSORSTATE_SP (ivory)) + (STD iFP PROCESSORSTATE_FP (ivory)) + (STD iLP PROCESSORSTATE_LP (ivory)))) + +;;;---*** TODO: VERIFY THESE ASSIGNMENTS MAKE SENSE! +(eval-when (compile load eval) +;;; Register definitions. +(define-integer-register sp r1) +(define-integer-register toc r2) +(define-integer-register env r11) +(define-integer-register tls r13) ; System thread ID +(define-integer-register arg1 r3) +(define-integer-register arg2 r4) +(define-integer-register arg3 r5) +(define-integer-register arg4 r6) +(define-integer-register arg5 r7) +(define-integer-register arg6 r8) +(define-integer-register ivory r30) ; ivory processor object +(define-integer-register iPC r14) +(define-integer-register iFP r15) +(define-integer-register iLP r16) +(define-integer-register iSP r17) +(define-integer-register iCP r18) +(define-integer-register t1 r19) +(define-integer-register t2 r20) +(define-integer-register t3 r21) +(define-integer-register t4 r22) +(define-integer-register t5 r23) +(define-integer-register t6 r24) +(define-integer-register t7 r25) +(define-integer-register t8 r26) +(define-integer-register t9 r27) +(define-integer-register t10 r28) +(define-integer-register t11 r29) +(define-integer-register t12 r9) ;---*** TODO: IS THIS OK? + +(define-integer-register instn t1) +(define-integer-register iword t2) +(define-integer-register ecp t3) +(define-integer-register ocp t4) +(define-integer-register icsize t5) ; icache size in bytes +(define-integer-register epc t6) +(define-integer-register opc t7) +(define-integer-register count t8) +(define-integer-register hwopmask arg5) ; the halfword operand mask +(define-integer-register fwdispatch arg6) ; the fullword dispatch table +(define-integer-register hwdispatch t9) ; = the halfword dispatch table +) diff --git a/g5-emulator/kludges.s b/g5-emulator/kludges.s new file mode 100644 index 0000000..9d7e41b --- /dev/null +++ b/g5-emulator/kludges.s @@ -0,0 +1,2 @@ +TWOCACHELINESIZE = CACHELINESIZE+CACHELINESIZE +FOURCACHELINESIZE = TWOCACHELINESIZE+TWOCACHELINESIZE diff --git a/g5-emulator/memoryem.lisp b/g5-emulator/memoryem.lisp new file mode 100644 index 0000000..07ffc76 --- /dev/null +++ b/g5-emulator/memoryem.lisp @@ -0,0 +1,794 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- +(in-package "POWERPC-INTERNALS") + +;;; This file implements the memory operations. These are responsible +;;; for ensuring that proper traps are taken, and forwarding pointers +;;; etc, are done. + +;;;; Memory actions, stolen from ISOFT:EMULATOR;DEFS, used to compute +;;;; constant masks and action tables + +(defconstant %memory-action-indirect 1) +(defconstant %memory-action-monitor-trap 2) +(defconstant %memory-action-transport 4) +(defconstant %memory-action-trap 10) +(defconstant %memory-action-transform 20) +(defconstant %memory-action-binding-trap 40) + +;;; Instead of making *memory-actions* a 2d array, we use this indexing scheme. +(defsubst memory-action-index (data-type cycle-type) + (dpb cycle-type (byte 4 6) data-type)) + +(defvar *memory-actions* (make-array 2000 :element-type '(unsigned-byte 8))) + +(defparameter *memory-actions-table* + ;; DATA NULL HEAD HFWD EFWD 1FWD EVCP GC MON PTR BL LV + `((,sys:%memory-data-read + () trap trap ind ind ind ind trap mtrap trans btrap xfrm ) + (,sys:%memory-data-write + () () trap ind ind ind ind trap mtrap () btrap () ) + (,sys:%memory-bind-read + () () trap ind ind ind () trap mtrap trans () () ) + (,sys:%memory-bind-write + () () trap ind ind ind () trap mtrap () () () ) + (,sys:%memory-bind-read-no-monitor + () () trap ind ind ind () trap ind trans () () ) + (,sys:%memory-bind-write-no-monitor + () () trap ind ind ind () trap ind () () () ) + (,sys:%memory-header + trap trap () ind trap trap trap trap trap trans trap trap ) + (,sys:%memory-structure-offset + () () () ind () () () trap () () () () ) + (,sys:%memory-scavenge + () () () () () () () trap () trans () () ) + (,sys:%memory-cdr + () () trap ind ind () () trap () () () () ) + (,sys:%memory-gc-copy + () () () () () () () trap () () () () ) + (,sys:%memory-raw + () () () () () () () () () () () () ) + (,sys:%memory-raw-translate + () () () () () () () () () () () xfrm ))) + +(defun initialize-memory-actions () + (let ((pointer-data-types + (list + sys:dtp-double-float sys:dtp-bignum sys:dtp-big-ratio + sys:dtp-complex sys:dtp-spare-number sys:dtp-instance + sys:dtp-list-instance sys:dtp-array-instance + sys:dtp-string-instance sys:dtp-nil sys:dtp-list + sys:dtp-array sys:dtp-string sys:dtp-symbol + sys:dtp-locative sys:dtp-lexical-closure + sys:dtp-dynamic-closure sys:dtp-compiled-function + sys:dtp-generic-function sys:dtp-spare-pointer-1 + sys:dtp-spare-pointer-2 sys:dtp-bound-location + sys:dtp-logic-variable sys:dtp-even-pc sys:dtp-odd-pc + sys:dtp-call-compiled-even sys:dtp-call-compiled-odd + sys:dtp-call-indirect sys:dtp-call-generic + sys:dtp-call-compiled-even-prefetch + sys:dtp-call-compiled-odd-prefetch + sys:dtp-call-indirect-prefetch + sys:dtp-call-generic-prefetch)) + (immediate-data-types + (list + sys:dtp-fixnum sys:dtp-small-ratio + sys:dtp-single-float sys:dtp-physical-address + sys:dtp-spare-immediate-1 sys:dtp-character + sys:dtp-packed-instruction-60 + sys:dtp-packed-instruction-61 sys:dtp-packed-instruction-62 + sys:dtp-packed-instruction-63 sys:dtp-packed-instruction-64 sys:dtp-packed-instruction-65 + sys:dtp-packed-instruction-66 sys:dtp-packed-instruction-67 sys:dtp-packed-instruction-70 + sys:dtp-packed-instruction-71 sys:dtp-packed-instruction-72 sys:dtp-packed-instruction-73 + sys:dtp-packed-instruction-74 sys:dtp-packed-instruction-75 sys:dtp-packed-instruction-76 + sys:dtp-packed-instruction-77))) + (fill *memory-actions* 0) + (loop for cycle-actions in *memory-actions-table* do + (destructuring-bind (cycle-type data null head hfwd efwd 1fwd evcp gc mon ptr bl lv) + cycle-actions + (labels ((translate-symbolic-action (symbol) + (ecase symbol + ((nil) 0) + (ind (logior %memory-action-indirect %memory-action-transport)) + (trans %memory-action-transport) + (trap %memory-action-trap) + (mtrap (logior %memory-action-monitor-trap %memory-action-transport)) + (xfrm %memory-action-transform) + (btrap (logior %memory-action-binding-trap %memory-action-transport)))) + (initialize-cycle (action &rest type-specs) + (dolist (type-spec type-specs) + (typecase type-spec + (symbol + (let ((index + (memory-action-index (symbol-value type-spec) cycle-type))) + (setf (aref *memory-actions* index) + (logior + (aref *memory-actions* index) + (translate-symbolic-action action))))) + (fixnum + (let ((index (memory-action-index type-spec cycle-type))) + (setf (aref *memory-actions* index) + (logior + (aref *memory-actions* index) + (translate-symbolic-action action))))) + (list + (dolist (type type-spec) + (initialize-cycle action type))))))) + (initialize-cycle data immediate-data-types pointer-data-types) + (initialize-cycle null sys:dtp-null) + (initialize-cycle head sys:dtp-header-i sys:dtp-header-p) + (initialize-cycle hfwd sys:dtp-header-forward) + (initialize-cycle efwd sys:dtp-element-forward) + (initialize-cycle 1fwd sys:dtp-one-q-forward) + (initialize-cycle evcp sys:dtp-external-value-cell-pointer) + (initialize-cycle gc sys:dtp-gc-forward) + (initialize-cycle mon sys:dtp-monitor-forward) + (initialize-cycle ptr + pointer-data-types + sys:dtp-null + sys:dtp-header-p + sys:dtp-header-forward + sys:dtp-element-forward + sys:dtp-one-q-forward + sys:dtp-external-value-cell-pointer + sys:dtp-monitor-forward) + (initialize-cycle bl sys:dtp-bound-location) + (initialize-cycle lv sys:dtp-logic-variable)))))) +(initialize-memory-actions) + +(defsubst memory-action-entry (data-type cycle-type) + (aref *memory-actions* (memory-action-index data-type cycle-type))) + +(defun memory-indirect-mask (cycle-type) + (loop with mask = 0 for data-type below 64 + when (not (zerop + (logand + (memory-action-entry data-type cycle-type) + %memory-action-indirect))) + do (setq mask (logior mask (ash 1 data-type))) + finally (if (logbitp 63 mask) + (return (dpb mask (byte 64 0) -1)) + (return mask)))) + +(defun memory-action-mask (cycle-type) + (loop with mask = 0 for data-type below 64 + when (not (zerop + (logandc2 + (memory-action-entry data-type cycle-type) + %memory-action-transport))) + do (setq mask (logior mask (ash 1 data-type))) + finally (if (logbitp 63 mask) + (return (dpb mask (byte 64 0) -1)) + (return mask)))) + +;; Fault handling +(defmacro decode-fault (vma) + `((STD ,vma PROCESSORSTATE_VMA (ivory) "stash the VMA") + (external-branch |DECODEFAULT| "Go figure"))) + +(defmacro transport-trap () + `((external-branch |TRANSPORTTRAP|))) + +(defmacro miss-fault () + `((external-branch |PAGENOTRESIDENT|))) + +(defmacro access-fault () + `((external-branch |PAGEFAULTREQUESTHANDLER|))) + +(defmacro write-fault () + `((external-branch |PAGEWRITEFAULT|))) + +(defmacro memory-action (mat cycle-number) + `((comment "Perform memory action") + (mov arg1 ,mat) + (li arg2 ,cycle-number) + (external-branch |PERFORMMEMORYACTION|))) + +(defmacro with-multiple-memory-reads ((vmdata vmtags base limit + &key inhibit-alignment cant-be-in-cache-p) + &body body &environment env) + (when *memoized-vmdata* + (error "You are already inside of a call to ~S" 'with-multiple-memory-reads)) + ;; --- need to bind these even in can't-be-in-cache-p for memory + ;; subrs to work + (setq cant-be-in-cache-p nil) + (let ((*memoized-vmdata* vmdata) + (*memoized-vmtags* vmtags) + (*memoized-base* (lisp:and (not cant-be-in-cache-p) base)) + (*memoized-limit* (lisp:and (not cant-be-in-cache-p) limit)) + (*inhibit-alignment-in-memory-read* inhibit-alignment) + (*cant-be-in-cache-p* cant-be-in-cache-p)) + `( + ,@(unless cant-be-in-cache-p + `((LD ,base PROCESSORSTATE_STACKCACHEBASEVMA (ivory)))) + ,@(unless cant-be-in-cache-p + `((LWA ,limit PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)"))) + ,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body)))) + +;; Use the memoized data from some other call +(defmacro using-multiple-memory-reads ((vmdata vmtags base limit + &key cant-be-in-cache-p) + &body body &environment env) + ;; --- need to bind these even in can't-be-in-cache-p for memory + ;; subrs to work + (setq cant-be-in-cache-p nil) + (let ((*memoized-vmdata* vmdata) + (*memoized-vmtags* vmtags) + (*memoized-base* (lisp:and (not cant-be-in-cache-p) base)) + (*memoized-limit* (lisp:and (not cant-be-in-cache-p) limit)) + (*cant-be-in-cache-p* cant-be-in-cache-p)) + `(,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body)))) + +(defmacro inhibit-alignment-in-memory-read (&body body &environment env) + (let ((*inhibit-alignment-in-memory-read* t)) + `(,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body )))) + +;; (VM-read t1 t2 t3 t4 t5) +;; (with-multiple-memory-reads (arg1 arg2 arg3 arg4) (VM-read t1 t2 t3 t4 t5)) + +;; Raw read from emulated memory. +(defmacro VM-read (vma tag data temp temp2 &optional prefetchp) + (check-temporaries (vma) (tag data temp)) + (assert (not (stringp prefetchp)) () "VM-Read does not accept comments") + (let () + `( + (ADD ,temp2 ,vma Ivory "Address of the tab byte") + (sldi ,data ,temp2 2 "Address of the word") + (LBZ ,tag 0 (,temp2) "Load tag") + (LWA ,data 0 (,data) "Load data") + ))) + +;; (with-multiple-memory-reads (arg1 arg2 arg3 arg4) (VM-write t1 t2 t3 t4 t5 t6 t7)) + +;; Raw write to emulated memory +(defmacro VM-write (vma tag data temp temp2 temp3 temp4 &optional prefetchp) + (check-temporaries (vma tag data) (temp temp2 temp3 temp4)) + (assert (not (stringp prefetchp)) () "VM-Write does not accept comments") + (let () + `((ADD ,temp ,vma Ivory) ; compute the address of the tag + (sldi ,temp4 ,temp 2) ; compute the address of the data + (STB ,tag 0 (,temp)) ; store the tag byte. + ;; Must happen last, in case of write-first fault + (STW ,data 0 (,temp4)) ; store data + ))) + +;; Decode fault according to page attributes +(defmacro check-access (vma temp temp2 pagemissing faultrequest &optional writefault transportfault) + (let ((access temp)) + `((LD ,temp2 PROCESSORSTATE_VMATTRIBUTETABLE (ivory) "Per-page attributes table") + (srdi ,access ,vma #.|MemoryPageAddressShift| "Index into the attributes table") + (ADD ,temp2 ,access ,temp2 "Address of the page's attributes") + (LBZ ,access 0 (,temp2) "Get the page's attributes byte") + (STD ,vma PROCESSORSTATE_VMA (ivory) "Stash the VMA") + (long-branch-if-zero ,access ,pagemissing "Non-existent page") + (ANDI-DOT ,temp2 ,access |VMAttributeAccessFault|) + (long-branch-if-nonzero ,temp2 ,faultrequest "Access fault") + ,@(when transportfault + `((ANDI-DOT ,temp2 ,access |VMAttributeTransportFault|) + (long-branch-if-nonzero ,temp2 ,transportfault "Transport fault"))) + ,@(when writefault + `((ANDI-DOT ,temp2 ,access |VMAttributeWriteFault|) + (long-branch-if-nonzero ,temp2 ,writefault "Write fault")))))) + +#|Ideal| + +;; This is the current coed without multiples. Takes 11 cycles with no +;; funny business. + + +;; This assumes everything could be based off the IVORY register: that +;; the procesorstate is accessed using negative offsets and tags are +;; accessed using positive offsets and that the stack-cache is only 1 +;; page. Additionally, we assume IVORY is some nice power of 2 >= 1_32 +;; so that multiplying the tag address by 4 takes you to the data +;; address. 10 cycles, whether you have BASEVMA in a register already +;; or not. + +( + (LD t4 processorstate_stackcachebasevma (ivory)) + (add t1 arg1 ivory "Address of the tag") + (LWA t5 processorstate_scovlimit (ivory)) + (sldi arg3 t1 2 "Address of the data word") + (LBZ arg2 0 (t1) "Load the tag") + (subf t2 t4 arg1) + (LD t3 processorstate_dataread_mask (ivory)) + (LWA arg3 0 (arg3) "Load data word") + (CMPL 0 0 t2 t5) + (BC 12 0 incache) + (SRD t3 t3 arg2) + ;; force-alignment creates di, but to no avail + (clrldi arg3 arg3 32) + (blbs t3 memoryaction) + ) + +;; Here is a scheme for inside multiple-memory-reads: cache the tag and +;; data quadword in the first two mmr registers (now unused), detect +;; reading odd vma's and skip the load and cache checks. Resulting code +;; is still 10 cycles, but 7 in the skip case + +;; Assumes t9, t10 available, base and limit in t11, t12 +( + (LD t3 processorstate_dataread_mask (ivory)) + (add t1 arg1 ivory) + (sldi t4 t1 2) + (BLBS arg1 memory-read-odd) + (LBZ arg2 0 (t1)) + (subf t2 t11 arg1) + (clrrdi t10 t4 3) + (ld t10 0 (t10)) + (CMPL 0 0 t2 t12) + (BC 12 0 incache) + (label memory-read-odd) + (li t1 240) + (SRD t3 t3 arg2) + (SRD t1 t1 arg2) + (extll t10 t4 arg3) ;+++ + (blbs t3 memoryaction) + ) + +;; This assumes that tags can be some small offset above zero, and that +;; data is based at IVORY, again with the processorstate being negative +;; offsets from IVORY and the stack-cache being 1 page. 9 cycles, +;; whether you have BASEVMA in a register or not. There are no stalls +;; in this code. +( + (LBZ arg2 smalloffset (arg1)) + (sldi t3 arg1 2) + (ADD t2 t3 Ivory) + (LD t4 processorstate_stackcachebasevma (ivory)) + (LD t3 processorstate_dataread_mask (ivory)) + (LWA arg3 0 (t2)) + (subf t2 t4 arg1) + (SRD t3 t3 arg2) + (CMPLI t2 #x2000) + (BC 12 0 incache) + (clrldi arg3 arg3 32) + (blbs t3 memoryaction) + ) + + +||# + + + +(defvar *memory-subroutines* nil + "A list of memory subroutines with their parameters for substitution by memory-read") + +(defmacro define-memory-subroutine + (name + (vma tag data cycle temp temp2 temp3 temp4) + (vmdata vmtags base limit) + (linkage)) + "Defines a common memory (fast-) subroutine, noting it on + *memory-subroutines* so that memory-read can replace common code" + (let* ((args (list vma tag data)) + (temps (list temp temp2 temp3 temp4)) + (caches (list vmdata vmtags base limit))) + (let ((datum `((,args ,cycle ,temps ,caches) ,name))) + (setq *memory-subroutines* (remove name *memory-subroutines* + :key #'second :test #'equal)) + (push datum *memory-subroutines*)) + `(define-fast-subroutine ,name () (,linkage) + (using-multiple-memory-reads (,vmdata ,vmtags ,base ,limit) + (memory-read ,vma ,tag ,data ,cycle ,temp ,temp2 ,temp3 ,temp4 nil nil t))))) + +(defmacro find-memory-subroutine + ((vma tag data cycle temp temp2 temp3 temp4) + (vmdata vmtags base limit)) + #+Genera (declare (values subr args)) + `(stack-let ((args (list ,vma ,tag ,data)) + (temps (list ,temp ,temp2 ,temp3 ,temp4)) + (caches (list ,vmdata ,vmtags ,base ,limit))) + (funcall 'find-memory-subr-internal args ,cycle temps caches))) + +(defun find-memory-subr-internal (args cycle temps caches) + #+Genera (declare (values subr args)) + (let () #+ign ((args (map 'list #'real-reg args)) + (temps (map 'list #'real-reg temps)) + (caches (map 'list #'real-reg caches))) + (loop with bname and bargs and bmerit + for ((targs tcycle ttemps tcaches) name) in *memory-subroutines* do + (when (lisp:and (equal cycle tcycle) + (equal temps ttemps) + (equal caches tcaches)) + (if (equal args targs) + (return (values name nil)) + (let ((merit (loop for ta in targs for a in args count (not (eq ta a))))) + (when (lisp:or (null bmerit) (< merit bmerit)) + (setq bname name bargs targs bmerit merit))))) + finally + (when bname + (destructuring-bind (vma tag data) args + (destructuring-bind (bvma btag bdata) bargs + (return + (values bname + `(,(if (equal vma bvma) nil bvma) + ,(if (equal tag btag) nil btag) + ,(if (equal data bdata) nil bdata)))))))))) + + +;; Test-case for macro-expanding: +;;(define-procedure test () +;; (with-multiple-memory-reads (t12 t11 t10 t9 :cant-be-in-cache-p nil) +;; (clrldi arg1 arg1 32) +;; (memory-read arg1 arg2 arg3 PROCESSORSTATE_DATAREAD t1 t2 t3 t4 nil nil))) + +;;; Implements all memory-read operations, optimizing when cycle is known + +;;; --- There are 3 stall slots that you could move instructions into (someday) + +;;; --- Someday make store-contents and store-conditional have another +;;; temp so temp4 is available (currently, the code is poorer without +;;; temp4) +(defun memory-read-internal (vma tag data cycle temp temp2 temp3 + &optional temp4 done-label signedp inlinep &aux subr args) + "Cycle is either a constant cycle type or a register containing the cycle number." + #+memory-inline (setq inlinep t) + (if temp4 + (check-temporaries (vma tag data) (temp temp2 temp3 temp4)) + (check-temporaries (vma tag data) (temp temp2 temp3))) + (unless inlinep + (multiple-value-setq (subr args) + (find-memory-subroutine + (vma tag data cycle temp temp2 temp3 temp4) + (*memoized-vmdata* *memoized-vmtags* *memoized-base* *memoized-limit*)))) + (let* ((cycle-number (case cycle + (processorstate_dataread 0) + (processorstate_datawrite 1) + (processorstate_bindread 2) + (processorstate_bindwrite 3) + (processorstate_bindreadnomonitor 4) + (processorstate_bindwritenomonitor 5) + (processorstate_header 6) + (processorstate_structureoffset 7) + (processorstate_scavenge 8) + (processorstate_cdr 9) + (processorstate_gccopy 10) + (processorstate_raw 11) + (processorstate_rawtranslate 12) + (t + ;; Make sure cycle is a (non-conflicting) register + (check-temporaries (cycle) (vma tag data temp temp2 temp3)) + (shiftf cycle :general)))) + (cycle-mask (unless (eq cycle :general) + (intern (concatenate 'string (string cycle) "_MASK")))) + #+obsolete + (cantransport (member cycle '(:general + processorstate_dataread + processorstate_bindread + processorstate_bindreadnomonitor + processorstate_header + processorstate_scavenge))) + (canindirect (not (member cycle '(processorstate_scavenge + processorstate_gccopy + processorstate_raw + processorstate_rawtranslate)))) + (cycle-indirect-mask (when canindirect + (unless (eq cycle :general) + (memory-indirect-mask cycle-number)))) + (cantransform (member cycle '(:general + processorstate_dataread + processorstate_rawtranslate))) + (canlookup (member cycle '(:general + processorstate_dataread + processorstate_datawrite))) + (top (gensym)) + (wasincache (gensym)) + (incache (gensym)) + (notindirect (gensym)) + (decodeaction (gensym)) + (decodecommontail (if #-memory-inline inlinep #+memory-inline nil + (intern (concatenate 'string (string *function-being-processed*) + "DECODE")) + (gensym))) + (doaction (gensym)) + (checklookup (if canlookup (gensym) doaction)) + (checktransform (if cantransform (gensym) checklookup)) + (checkindirect (if canindirect (gensym) checktransform)) + (dbcachemiss (gensym)) + (done (lisp:or done-label (gensym))) + ;; readability + (temp1 temp) + (action-memoized (lisp:and *memoized-action* (eq *memoized-action-cycle* cycle))) + (action (if action-memoized *memoized-action* (lisp:or temp4 temp)))) + (flet ((main-expansion () + `((comment "Memory Read Internal") + (unlikely-label ,top) + ;; VM-read to validate access, but then check for cached + + ;; The next sequence is equivalent (believe it or not) to: + ;; (VM-read ,vma ,tag ,data ,temp2 ,temp3 "Read the emulated Ivory Word") + ;; (VMAtoSCAmaybe ,vma ,temp ,notincache ,temp2 ,temp3) + ;; (stack-read2 ,temp1 ,tag ,data "Read from stack cache") + ,@(unless (lisp:or *memoized-base* *cant-be-in-cache-p*) + `((LD ,temp1 PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of stack cache"))) + (ADD,temp3 ,vma Ivory ) + ,@(unless (lisp:or *memoized-limit* *cant-be-in-cache-p*) + `((LWA ,temp2 PROCESSORSTATE_SCOVLIMIT (ivory)))) + ,@(if (lisp:and (eq cycle :general) (lisp:or temp4 *cant-be-in-cache-p*)) + `((sldi ,action ,cycle-number 2 "Cycle-number -> table offset")) + `((sldi ,data ,temp3 2))) + (LBZ ,tag 0 (,temp3)) + ,@(if (lisp:and (eq cycle :general) (lisp:or temp4 *cant-be-in-cache-p*)) + `((sldi ,action ,action 2) + (ADD ,action Ivory ,action)) + (unless *cant-be-in-cache-p* + `((SUBF ,temp1 ,(lisp:or *memoized-base* temp1) ,vma "Stack cache offset")))) + ,@(when (lisp:or temp4 *cant-be-in-cache-p*) + (cond ((eq cycle 'processorstate_raw) ()) + ((eq cycle :general) + `(;; Table offset == cycle-number * 16 + (sldi ,data ,temp3 2) + ,@(unless *cant-be-in-cache-p* + `((SUBF ,temp1 ,(lisp:or *memoized-base* temp1) ,vma "Stack cache offset"))) + (LD ,action PROCESSORSTATE_DATAREAD_MASK (,action)))) + (t `((LD ,action ,cycle-mask (ivory)) + )))) + ,@(unless *cant-be-in-cache-p* + `((CMPL 0 1 ,temp1 ,(lisp:or *memoized-limit* temp2) "In range?"))) + (LWA ,data 0 (,data)) + ,@(unless *cant-be-in-cache-p* + `((MFCR ,temp2) + (ANDIS-DOT ,temp2 ,temp2 #x8000 "Isolate CR0 LT bit") + (BC 4 2 ,incache) + )) + (unlikely-label ,wasincache) + ,@(unless (lisp:or temp4 *cant-be-in-cache-p*) + (cond ((eq cycle 'processorstate_raw) ()) + ((eq cycle :general) + `(;; Table offset == cycle-number * 16 + (sldi ,action ,cycle-number 4 "Cycle-number -> table offset") + (ADD ,action Ivory ,action) + (LD ,action PROCESSORSTATE_DATAREAD_MASK (,action)))) + (t `((LD ,action ,cycle-mask (ivory)) + )))) + ,@(if (eq cycle 'processorstate_raw) + `(,@(unless signedp `((clrldi ,data ,data 32)))) + `(,@(when cycle-indirect-mask + `((load-constant ,temp3 ,cycle-indirect-mask))) + (TagType ,tag R31) + (SRD ,action ,action R31) + ,@(when cycle-indirect-mask + `((SRD ,temp3 ,temp3 R31))) + ,@(unless signedp `((clrldi ,data ,data 32))) + (ANDI-DOT R31 ,action 1 "BLBS") + (BC 4 2 ,decodeaction))) + ,@(if done-label + `((B ,done)) + `((unlikely-label ,done)))))) + (unless inlinep + (when subr + (if (null args) + (return-from memory-read-internal + (let ((todecode (intern (concatenate 'string (string subr) "DECODE")))) + #+debug + (format *trace-output* "~&In ~A Used ~A" + *function-being-processed* subr) + (if (eq cycle 'processorstate_raw) + (unless *cant-be-in-cache-p* + (push + `((label ,incache) + (call-subroutine ,todecode) + (B ,done)) + *function-epilogue*)) + (push + `((label ,decodeaction) + ,@(when cycle-indirect-mask + `((ANDI-DOT R31 ,temp3 1 "BLBC") + (BC 12 2 ,notindirect) + (clrldi ,vma ,data 32 "Do the indirect thing") + (B ,top) + (label ,notindirect))) + (label ,incache) + (call-subroutine ,todecode) + (B ,done)) + *function-epilogue*)) + (main-expansion) + )) + #+debug + (format *trace-output* "~&In ~A Couldn't use ~A ~A->~A" + *function-being-processed* subr args `(,vma ,tag ,data))))) + #+debug + (format *trace-output* "~&In ~A VMA=~A TAG=~A DATA=~A CYCLE=~A" + *function-being-processed* vma tag data cycle) + ;; Unlikely expansion + (progn + (unless (eq cycle 'processorstate_raw) + (push + `( + (label ,decodeaction) + ,@(when cycle-indirect-mask + `((ANDI-DOT R31 ,temp3 1 "BLBC") + (BC 12 2 ,notindirect) + (clrldi ,vma ,data 32 "Do the indirect thing") + (B ,top))) + (label ,notindirect) + ,@(if (eq cycle :general) + `(;; Table offset == cycle-number * 16 + (sldi ,action ,cycle-number 4 "Cycle-number -> table offset") + (ADD ,action Ivory ,action) + (LD ,action PROCESSORSTATE_DATAREAD (,action))) + `((LD ,action ,cycle (ivory) "Load the memory action table for cycle"))) + (TagType ,tag ,temp3 "Discard the CDR code") + (STD ,vma PROCESSORSTATE_VMA (ivory) "stash the VMA for the (likely) trap") + (sldi ,temp3 ,temp3 2) ; ,temp3:= 4* ,temp3 + (ADD ,temp3 ,action ,temp3 "Adjust for a longword load") + (LWA ,action 0 (,temp3) "Get the memory action") + ,@(when (lisp:and canindirect (not cycle-indirect-mask)) + `((label ,checkindirect) + (ANDI-DOT ,temp2 ,action |MemoryActionIndirect|) + (branch-if-zero ,temp2 ,checktransform) + (clrldi ,vma ,data 32 "Do the indirect thing") + (B ,top))) + ,@(when cantransform + `((label ,checktransform) + (ANDI-DOT ,temp3 ,action |MemoryActionTransform|) + (branch-if-zero ,temp3 ,checklookup) + (clrrdi ,tag ,tag 6 "Clear LS 6 bits") + (ORI ,tag ,tag |TypeExternalValueCellPointer|) + (B ,done))) + ,@(when canlookup + ;; +++ Caveat emptor: we do not follow the microcode + ;; implementation. In order to implement this at all + ;; reasonably, we require that the binding cache be + ;; safeguarded (hence implying it is scavenged at flip + ;; time). Minima does this. + `( + (passthru "#ifndef MINIMA") + (unlikely-label ,checklookup) + (passthru "#endif") + (passthru "#ifdef MINIMA") + (label ,checklookup) + (ANDI-DOT ,temp3 ,action |MemoryActionBinding|) + (LD ,temp2 PROCESSORSTATE_DBCMASK (ivory)) + (branch-if-zero ,temp3 ,doaction) + (sldi ,temp1 ,vma 1) + (LD ,temp3 PROCESSORSTATE_DBCBASE (ivory)) + (AND ,temp1 ,temp1 ,temp2 "Hash index") + ;; Don't need tag, inline: (VM-Read ,vma ,temp1 ,temp2 ,temp3 ,tag) + (li ,temp2 1) + (sldi ,temp2 ,temp2 #.|IvoryMemoryData|) + ;; --- Why is ADD not sufficient instead of next five? + (exts ,temp1 ,temp1 32) + (exts ,temp3 ,temp3 32) + (ADD ,temp1 ,temp1 ,temp3) ;,temp1=signextend(,temp1)+signextend(,temp3) + (clrldi ,temp1 ,temp1 32 "Clear sign-extension") + (sldi ,temp1 ,temp1 2) ; ,temp1:= 4* ,temp1 + (ADD ,temp2 ,temp1 ,temp2) + (LWA ,temp1 0 (,temp2) "Fetch the key") + ;; Get the vma from next location and indirect + ;; Don't need tag, inline: (VM-Read ,vma ,tag ,data ,temp2 ,temp3) + (LWA ,data 4 (,temp2) "Fetch value") + (CMPL 0 0 ,temp1 ,vma "32-bit compare (signed/unsigned irrelevant)") + (BC 4 2 ,dbcachemiss "Trap on miss") + (clrldi ,vma ,data 32 "Extract the pointer, and indirect") + (B ,top "This is another memory read tailcall.") + (label ,dbcachemiss) + (external-branch DBCACHEMISSTRAP) + (passthru "#endif") + )) + (unlikely-label ,doaction) + (memory-action ,action ,cycle-number)) + *function-epilogue*)) + (unless *cant-be-in-cache-p* + (push + `(;; Memory common tail: disambiguate incache from exception + ,@(when inlinep + `((label ,decodecommontail) + ,@(when *subroutine-in-progress?* + `((elf-prologue ,*subroutine-regs-to-save* ,*subroutine-fast?*))) + ,@(unless (eq cycle 'processorstate_raw) + `((branch-false ,temp2 ,notindirect))))) + (label ,incache) + (LD ,temp2 PROCESSORSTATE_STACKCACHEDATA (ivory)) + (sldi ,temp1 ,temp1 3) + (ADD ,temp1 ,temp2 ,temp1 "reconstruct SCA") + (LWA ,data 4 (,temp1)) + (LWA ,tag 0 (,temp1) "Read from stack cache") + (B ,wasincache)) + *function-epilogue*))) + (main-expansion)))) + + +;;; External interfaces + +(defmacro memory-read (vma tag data cycle temp temp2 temp3 temp4 &optional done-label signedp inlinep) + (check-temporaries (vma) (tag data temp temp temp2 temp3 temp4)) + (assert (lisp:and (not (eql tag 'zero)) (not (eql data 'zero)))) + `(,@(memory-read-internal vma tag data cycle temp temp2 temp3 temp4 done-label signedp inlinep))) + +(defmacro memory-write (vma tag data cycle temp temp2 temp3 temp4 &optional temp5 done-label) + (if temp5 + (check-temporaries (vma tag data) (temp temp2 temp3 temp4 temp5)) + (check-temporaries (vma tag data) (temp temp2 temp3 temp4))) + (assert (lisp:and (not (eql tag 'zero)) (not (eql data 'zero)))) + (assert (eq cycle 'PROCESSORSTATE_RAW) () "You probably meant STORE-CONTENTS") + (let ((done (lisp:or done-label (gensym))) + (incache (gensym))) + (unless *cant-be-in-cache-p* + (push + `((label ,incache) + ,@(if temp5 + `(;; Have to reload this due to insufficient registers + ,@(unless *memoized-base* + `((LD ,temp2 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (force-alignment))) + (LD ,temp PROCESSORSTATE_STACKCACHEDATA (ivory)) + (SUBF ,temp2 ,(lisp:or *memoized-base* temp2) ,vma "Stack cache offset")) + `((LD ,temp PROCESSORSTATE_STACKCACHEDATA (ivory)))) + (sldi ,temp3 ,temp2 3) + (ADD ,temp ,temp3 ,temp "reconstruct SCA") + (stack-write2 ,temp ,tag ,data "Store in stack") + (B ,done)) + *function-epilogue*)) + `( + ;; VM-write to validate access, but then check for cached + ;; Below is in-lined: + ;; (VM-write vma tag data temp temp2 temp3 temp4) + ;; (VMAtoSCAmaybe vma temp done temp2 temp3) + ;; for better dual-issue + ,@(unless (lisp:or *cant-be-in-cache-p* *memoized-base* (null temp5)) + `((LD ,temp2 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)))) + (ADD ,temp ,vma Ivory) ; compute the address of the tag + ,@(unless (lisp:or *cant-be-in-cache-p* *memoized-limit* (null temp5)) + `((LWA ,temp5 PROCESSORSTATE_SCOVLIMIT (ivory)))) + (sldi ,temp4 ,temp 2) ; ,temp4:=4* ,temp = address of the data + ,@(unless (lisp:or *cant-be-in-cache-p* (null temp5)) + `((SUBF ,temp2 ,(lisp:or *memoized-base* temp2) ,vma "Stack cache offset") + (CMPL 0 1 ,temp2 ,(lisp:or *memoized-limit* temp5) "In range?"))) + ,@(unless (lisp:or *cant-be-in-cache-p* *memoized-base* temp5) + `((LD ,temp2 PROCESSORSTATE_STACKCACHEBASEVMA (ivory)))) + (STB ,tag 0 (,temp)) + ,@(unless (lisp:or *cant-be-in-cache-p* temp5) + `((LWA ,temp PROCESSORSTATE_SCOVLIMIT (ivory)) + (SUBF ,temp2 ,(lisp:or *memoized-base* temp2) ,vma "Stack cache offset") + (CMPL 0 1 ,temp2 ,temp "In range?"))) + (STW ,data 0 (,temp4)) + ,@(unless *cant-be-in-cache-p* + `((BC 12 0 ,incache "J. if in cache"))) + ,@(if done-label + `((B ,done)) + `((unlikely-label ,done)))))) + +;; (store-contents arg1 arg2 arg3 processorstate_dataread t1 t2 t3 t4 t5) + +;; Basically, memory-write, but preserve the cdr-code. Of course, that +;; means you have to read the old location to get the cdr-code. You +;; might optimize not bothering to read the old data, but that's needed +;; to get access/transport checks to go off +(defmacro store-contents (vma new-tag new-data cycle tag data temp temp2 temp3 + &optional temp4 done-label) + (if temp4 + (check-temporaries (vma new-tag new-data) (tag data temp temp2 temp3 temp4)) + (check-temporaries (vma new-tag new-data) (tag data temp temp2 temp3))) + (assert (lisp:and (not (eql new-tag 'zero)) (not (eql new-data 'zero)))) + `(,@(memory-read-internal vma tag data cycle temp temp2 temp3 temp4 nil t) + (comment "Merge cdr-code") + (ANDI-DOT ,data ,new-tag #x3F) + (ANDI-DOT ,tag ,tag #xC0) + (OR ,tag ,tag ,data) + (memory-write ,vma ,tag ,new-data PROCESSORSTATE_RAW ,temp ,temp2 ,temp3 ,data ,temp4 + ,done-label))) + +;; Here for optimization purposes (so the memory primitives do not +;; escape). +(defmacro store-conditional-internal (vma oldtag olddata newtag newdata faillab + temp temp2 temp3 temp4 temp5 &optional temp6 done-label) + (let (;; readability + (tag temp4) + (data temp5)) + `((comment "Read the location, checking write access") + ,@(memory-read-internal vma tag data 'PROCESSORSTATE_DATAREAD temp temp2 temp3 nil nil t) + (CMP 0 0 ,data ,olddata "Check for data match (32-bit compare)") + (XOR ,temp2 ,oldtag ,tag "Zero if tags match") + (BC 4 2 ,faillab "Jump if data didn't match") + (TagType ,temp2 ,temp2 "Stip result of comparing CDR-CODEs") + (branch-if-nonzero ,temp2 ,faillab "Jump if tags don't match") + (ANDI-DOT ,temp ,newtag #x3F "Strip CDR-CODE") + (ANDI-DOT ,tag ,tag #xC0 "Retain CDR-CODE") + (OR ,tag ,temp ,tag "Merge new tag with old CDR-CODE") + ;; Update the object + (memory-write ,vma ,tag ,newdata PROCESSORSTATE_RAW ,temp ,temp2 ,temp3 ,temp5 ,temp6 + ,done-label)))) + + + diff --git a/g5-emulator/powermac.lisp b/g5-emulator/powermac.lisp new file mode 100644 index 0000000..fd675fd --- /dev/null +++ b/g5-emulator/powermac.lisp @@ -0,0 +1,448 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; This file contains macros that implement the standard powerpc sequences. +;;; these macros are for general common code sequences and should not +;;; contain any Ivory related macros. Ivory related macros should live +;;; in ivorymacs.lisp. + +#-Genera (defconstant 1_0 #.(ash 1 0)) +#-Genera (defconstant 1_1 #.(ash 1 1)) +#-Genera (defconstant 1_2 #.(ash 1 2)) +#-Genera (defconstant 1_3 #.(ash 1 3)) +#-Genera (defconstant 1_4 #.(ash 1 4)) +#-Genera (defconstant 1_5 #.(ash 1 5)) +#-Genera (defconstant 1_6 #.(ash 1 6)) +#-Genera (defconstant 1_7 #.(ash 1 7)) +#-Genera (defconstant 1_8 #.(ash 1 8)) +#-Genera (defconstant 1_9 #.(ash 1 9)) +#-Genera (defconstant 1_10 #.(ash 1 10)) +#-Genera (defconstant 1_11 #.(ash 1 11)) +#-Genera (defconstant 1_12 #.(ash 1 12)) +#-Genera (defconstant 1_13 #.(ash 1 13)) +#-Genera (defconstant 1_14 #.(ash 1 14)) +#-Genera (defconstant 1_15 #.(ash 1 15)) +#-Genera (defconstant 1_16 #.(ash 1 16)) +#-Genera (defconstant 1_17 #.(ash 1 17)) +#-Genera (defconstant 1_18 #.(ash 1 18)) +#-Genera (defconstant 1_19 #.(ash 1 19)) +#-Genera (defconstant 1_20 #.(ash 1 20)) +#-Genera (defconstant 1_21 #.(ash 1 21)) +#-Genera (defconstant 1_22 #.(ash 1 22)) +#-Genera (defconstant 1_23 #.(ash 1 23)) +#-Genera (defconstant 1_24 #.(ash 1 24)) +#-Genera (defconstant 1_25 #.(ash 1 25)) +#-Genera (defconstant 1_26 #.(ash 1 26)) +#-Genera (defconstant 1_27 #.(ash 1 27)) +#-Genera (defconstant 1_28 #.(ash 1 28)) +#-Genera (defconstant 1_29 #.(ash 1 29)) +#-Genera (defconstant 1_30 #.(ash 1 30)) +#-Genera (defconstant 1_31 #.(ash 1 31)) + +;;; reg is the register to be loaded. +;;; preg is the pointer register. +;;; offset is a value that can be evaluated and is the index into preg. + +;;; Branch Macros + +(defconstant CondFalse 4) +(defconstant CondTrue 12) + +(defconstant CR-LT 0) +(defconstant CR-GT 1) +(defconstant CR-EQ 2) +(defconstant CR-SO 3) + +(defmacro bclong (bo bi target &optional comment) + (let ((trampoline (gensym))) + (push `((label ,trampoline) + (B ,target)) + *function-epilogue*) + `((BC ,bo ,bi ,trampoline ,@(if comment `(,comment)))))) + +(defmacro branch-if-nonzero (reg target &optional comment) + `((CMPI 0 1 ,reg, 0) + (BC 4 2 ,target ,@(if comment `(,comment))))) + +(defmacro long-branch-if-nonzero (reg target &optional comment) + (let ((trampoline (gensym))) + (push `((label ,trampoline) + (B ,target)) + *function-epilogue*) + `((CMPI 0 1 ,reg 0) + (BC 4 2 ,trampoline ,@(if comment `(,comment)))))) + +(defmacro branch-if-zero (reg target &optional comment) + `((CMPI 0 1 ,reg, 0) + (BC 12 2 ,target ,@(if comment `(,comment))))) + +(defmacro long-branch-if-zero (reg target &optional comment) + (let ((trampoline (gensym))) + (push `((label ,trampoline) + (B ,target)) + *function-epilogue*) + `((CMPI 0 1 ,reg, 0) + (BC 12 2 ,trampoline ,@(if comment `(,comment)))))) + +(defmacro branch-if-less-than-zero (reg target &optional comment) + `((CMPI 0 1 ,reg, 0) + (BC 12 0 ,target ,@(if comment `(,comment))))) + +(defmacro branch-if-greater-than-zero (reg target &optional comment) + `((CMPI 0 1 ,reg, 0) + (BC 12 1 ,target ,@(if comment `(,comment))))) + +(defmacro branch-if-less-than-or-equal-to-zero (reg target &optional comment) + `((CMPI 0 1 ,reg, 0) + (BC 4 1 ,target ,@(if comment `(,comment))))) + +(defmacro branch-if-greater-than-or-equal-to-zero (reg target &optional comment) + `((CMPI 0 1 ,reg, 0) + (BC 4 0 ,target ,@(if comment `(,comment))))) + +;;; Extends the PowerPC's EXTSx class of instructions to an arbitrarily sized field. +(defmacro exts (to from bits &optional comment) + (cond ((= bits 32) + `((EXTSW ,to ,from ,@(if comment `(,comment))))) + ((= bits 16) + `((EXTSH ,to ,from ,@(if comment `(,comment))))) + ((= bits 8) + `((EXTSB ,to ,from ,@(if comment `(,comment))))) + (t + `((sldi ,to ,from ,(- 64 bits) ,@(if comment `(,comment))) + (SRADI ,to ,to ,(- 64 bits) "Sign extend"))))) + +;;; Synonym instructions for readability. + +(defmacro nop (&optional comment) + `((ORI R0 R0 0 ,@(if comment `(,comment))))) + +(defmacro mov (r1 r2 &optional comment) + `((OR ,r1 ,r2 ,r2 ,@(if comment `(,comment))))) + +(defmacro li (reg lit &optional comment) + `((ADDI ,reg R0 ,lit ,@(if comment `(,comment))))) + +(defmacro clr (reg &optional comment) + `((ADDI ,reg R0 0 ,@(if comment `(,comment))))) + +(defmacro clrldi (ra rs n &optional comment) + `((RLDICL ,ra ,rs 0 ,n ,@(if comment `(,comment))))) + +(defmacro clrrdi (ra rs n &optional comment) + `((RLDICR ,ra ,rs 0 ,(- 63 n) ,@(if comment `(,comment))))) + +(defmacro extldi (ra rs n b &optional comment) + `((RLDICR ,ra ,rs ,b ,(1- n) ,@(if comment `(,comment))))) + +(defmacro extrdi (ra rs n b &optional comment) + (assert (< (+ n b) 64)) + `((RLDICL ,ra ,rs ,(+ b n) ,(- 64 n) ,@(if comment `(,comment))))) + +(defmacro rotldi (ra rs n &optional comment) + `((RLDICL ,ra ,rs ,n 0 ,@(if comment `(,comment))))) + +(defmacro rotrdi (ra rs n &optional comment) + `((RLDICL ,ra ,rs ,(- 64 n) ,0 ,@(if comment `(,comment))))) + +(defmacro sldi (ra rs n &optional comment) + `((RLDICR ,ra ,rs ,n ,(- 63 n) ,@(if comment `(,comment))))) + +(defmacro srdi (ra rs n &optional comment) + `((RLDICL ,ra ,rs ,(- 64 n) ,n ,@(if comment `(,comment))))) + +(defmacro addw (rd ra rb &optional comment-or-temp comment) + (let ((rdn (register-number rd)) + (ran (register-number ra)) + (rbn (register-number rb))) + (multiple-value-bind (rt rtn comment) + (if (find-register comment-or-temp) + (values comment-or-temp (register-number comment-or-temp) comment) + (values nil 0 comment-or-temp)) + (when (lisp:and rt (member rtn `(,rdn ,ran ,rbn))) + (error "Temporary ~A conflicts with a live register in ~A" rt + `(addw ,rd ,ra ,rb ,comment-or-temp))) + (if (= rdn ran) + `((EXTSW ,rd ,ra) + (EXTSW ,(lisp:or rt rb) ,rb) + (ADD ,rd ,rd ,(lisp:or rt rb) ,@(if comment `(,comment)))) + `((EXTSW ,rd ,rb) + (EXTSW ,(lisp:or rt ra) ,ra) + (ADD ,rd ,(lisp:or rt ra) ,rd ,@(if comment `(,comment)))))))) + +(defmacro addwi (rd ra n &optional comment) + `((EXTSW ,rd ,ra) + (ADDI ,rd ,rd ,n ,@(if comment `(,comment))))) + +(defmacro subfw (rd ra rb &optional comment-or-temp comment) + (let ((rdn (register-number rd)) + (ran (register-number ra)) + (rbn (register-number rb))) + (multiple-value-bind (rt rtn comment) + (if (find-register comment-or-temp) + (values comment-or-temp (register-number comment-or-temp) comment) + (values nil 0 comment-or-temp)) + (when (lisp:and rt (member rtn `(,rdn ,ran ,rbn))) + (error "Temporary ~A conflicts with a live register in ~A" rt + `(subfw ,rd ,ra ,rb ,comment-or-temp))) + (if (= rdn ran) + `((EXTSW ,rd ,ra) + (EXTSW ,(lisp:or rt rb) ,rb) + (SUBF ,rd ,rd ,(lisp:or rt rb) ,@(if comment `(,comment)))) + `((EXTSW ,rd ,rb) + (EXTSW ,(lisp:or rt ra) ,ra) + (SUBF ,rd ,(lisp:or rt ra) ,rd ,@(if comment `(,comment)))))))) + +(defmacro stzw (disp (reg) &optional comment) + `((clr R31) + (stw R31 ,disp (,reg) ,@(if comment `(,comment))))) + +(defmacro stzd (disp (reg) &optional comment) + `((clr R31) + (std R31 ,disp (,reg) ,@(if comment `(,comment))))) + + +;;; Miscellaneous macros of a pseudo OP nature. + +#|| +;;;---*** TODO: FLUSH? +(defmacro ldgp (&optional comment) + `((passthru ,(format nil " ldgp $gp, 0($27)") + ,@(if comment `(,comment))))) + +(defmacro divl (div by res &optional comment) + `((passthru ,(format nil " divl ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) + +(defmacro divq (div by res &optional comment) + `((passthru ,(format nil " divq ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) + +(defmacro divlu (div by res &optional comment) + `((passthru ,(format nil " divlu ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) + +(defmacro divqu (div by res &optional comment) + `((passthru ,(format nil " divqu ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) + +(defmacro reml (div by res &optional comment) + `((passthru ,(format nil " reml ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) + +(defmacro remlu (div by res &optional comment) + `((passthru ,(format nil " remlu ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) + +(defmacro remq (div by res &optional comment) + `((passthru ,(format nil " remq ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) + +(defmacro remqu (div by res &optional comment) + `((passthru ,(format nil " remqu ~a, ~a, ~a" + (coerce-to-register div) + (coerce-to-register-or-literal by) + (coerce-to-register res)) + ,@(if comment `(,comment))))) +||# + +(defmacro external (name) + `((passthru ,(format nil " .extern ~a" name)))) + +(defmacro include-header (name) + `((passthru ,(format nil "#include ~s~%" name)))) + +(defun define-procedure-internal (name args body env external?) + (let ((*function-being-processed* name)) + `((start ,name :external ,external? :nargs ,(length args)) + ,@(if external? + `((elf-prologue)) + `((label ,name))) + ;;---*** TODO: ??? + ;;(MFSPR R0 8 "Get LR") + ,@(collecting-function-epilogue body env) + (end ,name)))) + +(defmacro define-procedure (name (&rest args) &body body &environment env) + #+Genera (declare (zwei:indentation . indent-define-procedure)) + (define-procedure-internal name args body env nil)) + +(defmacro define-external-procedure (name (&rest args) &body body &environment env) + #+Genera (declare (zwei:indentation . indent-define-procedure)) + (define-procedure-internal name args body env t)) + +#+Genera +(defun indent-define-procedure (def bp last-paren &rest stuff) + (declare (ignore def last-paren stuff)) + (let* ((line (zwei:bp-line bp)) + (type (zwei:line-type line))) + (if (eq type :normal) + (let* ((sbp (zwei:forward-list (zwei:create-bp line 0) 1 nil -1 t)) + (ebp (zwei:forward-atom sbp 1 nil)) + (op (with-input-from-string (s line :start (zwei:bp-index sbp) + :end (zwei:bp-index ebp)) + (read s)))) + (if (member op '(label unlikely-label immediate-handler)) + (values bp nil 2) + (values bp nil 4))) + (values bp nil 4)))) + +(defvar *subroutine-in-progress?* nil) +(defvar *subroutine-regs-to-save* nil) +(defvar *subroutine-fast?* nil) + +(defun define-subroutine-internal (name args linkage regs-to-save body env fast? external?) + (assert (= (register-number linkage) (register-number 'R0))) + (let ((*function-being-processed* name) + (*subroutine-in-progress?* t) + (*subroutine-regs-to-save* regs-to-save) + (*subroutine-fast?* fast?)) + `((start ,name :external ,external? :nargs ,(length args) :fast ,fast?) + ,@(unless external? + `((label ,name))) + (elf-prologue ,regs-to-save ,fast?) + ,@(collecting-function-epilogue + `(,@body + (elf-epilogue ,regs-to-save ,fast?)) + env) + (end ,name)))) + +(defmacro define-subroutine (name (&rest args) (linkage &rest regs-to-save) + &body body &environment env) + "A subroutine that can call other subroutines" + (define-subroutine-internal name args linkage regs-to-save body env nil nil)) + +(defmacro define-external-subroutine (name (&rest args) (linkage &rest regs-to-save) + &body body &environment env) + "An subroutine that can call other subroutines" + (define-subroutine-internal name args linkage regs-to-save body env nil t)) + +(defmacro define-fast-subroutine (name (&rest args) (linkage &rest regs-to-save) + &body body &environment env) + "A subroutine that cannot call other subroutines" + (define-subroutine-internal name args linkage regs-to-save body env t nil)) + +(defmacro define-fast-external-subroutine (name (&rest args) (linkage &rest regs-to-save) + &body body &environment env) + "An external subroutine that cannot call other subroutines" + (define-subroutine-internal name args linkage regs-to-save body env t t)) + +(defmacro elf-prologue (&optional (regs-to-save ':all) fast?) + (let* ((registers (if (eq regs-to-save ':all) + `(R30 R29 R28 R27 R26 R25 R24 R23 R22 R21 R20 R19 R18 R17 R16 R15 R14) + regs-to-save)) + ;; Stack frame header size is 48 bytes. + ;; Parameter save area is 64 bytes (8 doublewords). + ;; General register save area includes R31 plus whatever + ;; registers are indicated above. + ;; Finally, we allocate room to save ARG1 through ARG6 + ;; as well as the CTR register when calling the trace + ;; printer. + (frame-size (+ 48 64 (* 8 (1+ (length registers))) 64))) + `((MFSPR R0 8 "Get the linkage register") + (STD R31 -8 (SP)) + ,@(loop for register in registers + for offset from 16 by 8 + collect + `(STD ,register ,(- offset) (SP))) + (STD R0 16 (SP)) + ,@(unless fast? + `((STDU SP ,(- frame-size) SP "Push the stack frame pointer")))))) + +(defmacro elf-epilogue (&optional (regs-to-restore ':all) fast?) + (let* ((registers (if (eq regs-to-restore ':all) + `(R30 R29 R28 R27 R26 R25 R24 R23 R22 R21 R20 R19 R18 R17 R16 R15 R14) + regs-to-restore))) + `(,@(unless fast? + `((LD SP 0 (SP) "Pop the stack frame"))) + (LD R0 16 (SP)) + (MTSPR 8 R0 "Restore the linkage register") + (LD R31 -8 (SP)) + ,@(loop for register in registers + for offset from 16 by 8 + collect + `(LD ,register ,(- offset) (SP))) + (BCLR 20 0 "Return to caller")))) + +;;; On the PowerPC, the callee is reposnsible for saving the caller's non-volatile +;;; general registers (i.e., R14 through R31). We'll give the callee a chance to +;;; change the interpreter's state (e.g., the PC) by saving the live state to +;;; the PROCESSORSTATE structure and reloading it on return. +(defmacro call-c-function (function temp &optional save-regs?) + `((decache-ivory-state) ; Allow callee to change interpreter state + ,@(when save-regs? + `((STD arg1 ,(+ 48 64 0) (SP)) + (STD arg2 ,(+ 48 64 8) (SP)) + (STD arg3 ,(+ 48 64 16) (SP)) + (STD arg4 ,(+ 48 64 24) (SP)) + (STD arg5 ,(+ 48 64 32) (SP)) + (STD arg6 ,(+ 48 64 40) (SP)) + (MFSPR ,temp 9 "Save CTR register") + (STD ,temp ,(+ 48 64 48) (SP)))) + (LD ,temp 0 (,function) "Get the function's actual address") + (MTSPR 9 ,temp) + (STD TOC 40 (SP) "Save our TOC") + (LD TOC 8 (,function) "Get callee's TOC") + (LD ENV 16 (,function) "Get callee's environment pointer") + (BCCTRL 20 0) + (LD TOC 40 (SP) "Restore our TOC") + ,@(when save-regs? + `((LD ,temp ,(+ 48 64 48) (SP)) + (MTSPR 9 ,temp "Restore CTR register") + (LD arg6 ,(+ 48 64 40) (SP)) + (LD arg5 ,(+ 48 64 32) (SP)) + (LD arg4 ,(+ 48 64 24) (SP)) + (LD arg3 ,(+ 48 64 16) (SP)) + (LD arg2 ,(+ 48 64 8) (SP)) + (LD arg1 ,(+ 48 64 0) (SP)))) + (cache-ivory-state) ; Restore possibly munged interpreter state + )) + +(defmacro load-constant (reg constant &optional comment) + (declare (ignore comment)) + #+Genera (check-type constant fixnum) + #-Genera (check-type constant (integer #.(- (expt 2 31)) #.(1- (expt 2 31)))) + (let* ((low (dpb constant (byte 16 0) (- (ldb (byte 1 15) constant)))) + (high (sys:%32-bit-difference constant low))) + (assert (zerop (ldb (byte 16 0) high)) () + "Don't know how to load ~D" constant) + `(,@(cond + ((zerop constant) + `((clr ,reg))) + ((zerop high) + `((li ,reg ,low))) + ((zerop low) + `((li ,reg ,(ash high -16)) + (sldi ,reg ,reg 16))) + (t + `((li ,reg ,(ash high -16)) + (sldi ,reg ,reg 16) + (ADDI ,reg ,reg ,low) + ))) + ,@(unless (= constant (+ high low)) + `((clrldi ,reg ,reg 32)))) + )) + +;;; fin. diff --git a/g5-emulator/stacklis.lisp b/g5-emulator/stacklis.lisp new file mode 100644 index 0000000..1de3b96 --- /dev/null +++ b/g5-emulator/stacklis.lisp @@ -0,0 +1,679 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: POWERPC-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "POWERPC-INTERNALS") + +;;; This file is intended to provide a clean interface to the stack. +;;; this way, it is hoped that we can experiment with the stack implementation. +;;; With these primitives, VMA is always a pointer within the stackcache, +;;; and read/write is always to the stackcache and NOT to main memory. + +;; For backwards compatibility, we let all the stack ops take an +;; optional comment plus keyword options +(defun process-stack-options (options) + (if (lisp:or (null options) (stringp (first options)) (null (first options))) + options + (let ((comment (find-if #'stringp options))) + (cond (comment + (list* comment (remove comment options))) + (t (list* nil options)))))) + +(defmacro with-stack-options ((comment &rest keys) options &body body) + `(destructuring-bind (&optional ,comment ,@keys) + (process-stack-options ,options) + ,@(when (member 'tos-valid keys) + `((setq tos-valid (case tos-valid + (:invalid nil) + (t tos-valid))))) + (progn ,@body))) + +;;; Read the stack location addressed by vma and put result in dest +;;; 1 cycle, good dual opportunities, but 2 cycle data ready delay. +(defmacro stack-read-disp (vma disp dest &rest options) + (with-stack-options (comment &key tos-valid) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) (member tos-valid `(:arg6 t))) + `(,@(unless (eq dest 'arg6) + `((mov ,dest arg6 ,@(if comment `(,comment)))))) + `((LD ,dest ,disp (,vma) ,@(if comment `(,comment))))))) + +(defmacro stack-read (vma dest &rest options) + `(stack-read-disp ,vma 0 ,dest ,@options)) + +(defmacro stack-read-data-disp (vma disp dest &rest options) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) tos-valid (not floating)) + (if signed + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq dest 'arg6) + `((mov ,dest arg6 ,@(if comment `(,comment)))))) + ((:arg6 t) + `((exts ,dest arg6 32 ,@(if comment `(,comment))))))) + `((clrldi ,dest arg6 32 ,@(if comment `(,comment))))) + (cond (signed + `((LWA ,dest ,(+ disp 4) (,vma) ,@(if comment `(,comment))))) + (floating + `((LFS ,dest ,(+ disp 4) (,vma) ,@(if comment `(,comment))))) + (t + `((LWA ,dest ,(+ disp 4) (,vma) ,@(if comment `(,comment))) + (clrldi ,dest ,dest 32))))))) + +(defmacro stack-read-data (vma dest &rest options) + `(stack-read-data-disp ,vma 0 ,dest ,@options)) + +(defmacro stack-read-tag-disp (vma disp dest &rest options) + (with-stack-options (comment &key tos-valid) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) tos-valid) + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq dest 'arg5) + `((mov ,dest arg5 ,@(if comment `(,comment)))))) + ((:arg6 t) + `((srdi ,dest arg6 32 ,@(if comment `(,comment))))))) + `((LWA ,dest ,disp (,vma) ,@(if comment `(,comment))))))) + +(defmacro stack-read-tag (vma dest &rest options) + `(stack-read-tag-disp ,vma 0 ,dest ,@options)) + +(defmacro stack-read2-disp (vma disp tag data &rest options) + (check-temporaries (vma) (tag data)) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and (eq vma 'iSP) (eql disp 0) tos-valid (not floating)) + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq tag 'arg5) + `((mov ,tag arg5)))) + ((:arg6 t) + `((srdi ,tag arg6 32)))) + ,@(if signed + (ecase tos-valid + (:arg5arg6 + (unless (eq data 'arg6) + `((mov ,data arg6 ,@(if comment `(,comment)))))) + ((:arg6 t) + `((exts ,data arg6 32 ,@(if comment `(,comment)))))) + `((clrldi ,data arg6 32 ,@(if comment `(,comment)))))) + (cond (signed + `((LWA ,tag ,disp (,vma) ,@(if comment `(,comment))) + (LWA ,data ,(+ disp 4) (,vma)))) + (floating + `((LFS ,data ,(+ disp 4) (,vma) ,@(if comment `(,comment))) + (LWA ,tag ,disp (,vma)))) + (t + `((LWA ,data ,(+ disp 4) (,vma) ,@(if comment `(,comment))) + (LWA ,tag ,disp (,vma)) + (clrldi ,data ,data 32))))))) + +(defmacro stack-read2-disp-signed (vma disp tag data &rest options) + (check-temporaries (vma) (tag data)) + (with-stack-options (comment &rest options) options + `(stack-read2-disp ,vma ,disp ,tag ,data ,comment :signed t ,@options))) + +(defmacro stack-read2 (vma tag data &rest options) + (check-temporaries (vma) (tag data)) + `(stack-read2-disp ,vma 0 ,tag ,data ,@options)) + +;;; Used for reading things that are probably fixnums. Reads the +;;; tag first, since that's what we generally need to test first. +;;; data comes sign extended for free. +(defmacro stack-read2-signed (vma tag data &rest options) + (check-temporaries (vma) (tag data)) + (with-stack-options (comment &rest options) options + `(stack-read2 ,vma ,tag ,data ,comment :signed t ,@options))) + +;;; stack pop + +(defmacro stack-top (dest &rest options) + `(stack-read iSP ,dest ,@options)) + +(defmacro stack-top2 (tag data &rest options) + `(stack-read2 iSP ,tag ,data ,@options)) + +(defmacro stack-pop (dest &rest options) + `((stack-top ,dest ,@options) + (ADDI iSP iSP -8 "Pop Stack."))) + +(defmacro stack-pop-discard (dest &optional comment) + (declare (ignore dest)) + `((ADDI iSP iSP -8 ,(lisp:or comment "Pop Stack.")))) + +(defmacro stack-pop-data (dest &rest options) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and tos-valid (not floating)) + `(,@(if signed + (ecase tos-valid + (:arg5arg6 + (unless (eq dest 'arg6) + `((mov ,dest arg6 ,@(if comment `(,comment)))))) + ((:arg6 t) + `((exts ,dest arg6 32 ,@(if comment `(,comment)))))) + `((clrldi ,dest arg6 32))) + (ADDI iSP iSP -8 "Pop Stack.")) + (cond (signed + `((LWA ,dest 4 (iSP) ,@(if comment `(,comment))) + (ADDI iSP iSP -8 "Pop Stack."))) + (floating + `((LFS ,dest 4 (iSP) ,@(if comment `(,comment))) + (ADDI iSP iSP -8 "Pop Stack."))) + (t + `((LWA ,dest 4 (iSP) ,@(if comment `(,comment))) + (ADDI iSP iSP -8 "Pop Stack.") + (clrldi ,dest ,dest 32))))))) + +(defmacro stack-pop-tag (dest &rest options) + `((stack-read-tag iSP ,dest ,@options) + (ADDI iSP iSP -8 "Pop Stack."))) + +(defmacro stack-pop2 (tag data &rest options) + (with-stack-options (comment &key tos-valid signed floating) options + (if (lisp:and tos-valid (not floating)) + `(,@(ecase tos-valid + (:arg5arg6 + (unless (eq tag 'arg5) + `((mov ,tag arg5)))) + ((:arg6 t) + `((srdi ,tag arg6 32)))) + ,@(if signed + (ecase tos-valid + (:arg5arg6 + (unless (eq data 'arg6) + `((mov ,data arg6 ,@(if comment `(,comment)))))) + ((:arg6 t) + `((exts ,data arg6 32 ,@(if comment `(,comment)))))) + `((clrldi ,data arg6 32 ,@(if comment `(,comment))))) + (ADDI iSP iSP -8 "Pop Stack.")) + (cond (signed + `((LWA ,tag 0 (iSP) ,@(if comment `(,comment))) + (LWA ,data 4 (iSP) ,@(if comment `(,comment))) + (ADDI iSP iSP -8 "Pop Stack."))) + (floating + `((LFS ,data 4 (iSP) ,@(if comment `(,comment))) + (LWA ,tag 0 (iSP) ,@(if comment `(,comment))) + (ADDI iSP iSP -8 "Pop Stack."))) + (t + `((LWA ,data 4 (iSP) ,@(if comment `(,comment))) + (LWA ,tag 0 (iSP) ,@(if comment `(,comment))) + (ADDI iSP iSP -8 "Pop Stack.") + (clrldi ,data ,data 32))))))) + + + +;;; Stores an immediate TAG and register data in two cycles. +(defmacro stack-write-ir (imtag data temp &rest options) + `((li ,temp ,imtag) + (stack-write2 iSP ,temp ,data ,@options))) + +;;; --- WARNING: If any caller of this macro uses a tag other than |TypeSingleFloat|, +;;; --- this macro will need to be enhanced to pass :floating :fixed to stack-write-ir! +(defmacro fp-stack-write-ir (imtag data temp &rest options) + (with-stack-options (comment &rest options) options + `((stack-write-ir ,imtag ,data ,temp ,comment :floating t ,@options)))) + +;;; Write specified tag and dataword. two cycles but good dual chances. +(defmacro stack-write2 (vma tag data &rest options) + `(stack-write2-disp ,vma 0 ,tag ,data ,@options)) + +;;; Write specified tag and dataword. +(defmacro stack-write2-disp (vma disp tag data &rest options) + ;; Floating stores dual-issue better if tag-first + (with-stack-options (comment &key floating set-cdr-next (tag-first (not floating))) options + ;; Allow set-cdr-next to be tag, for the translator case of keeping TOS valid + (when set-cdr-next (check-temporaries (data) (set-cdr-next))) + (assert (lisp:or (not floating) (lisp:and floating (not tag-first)))) + `(,@(when set-cdr-next + `((ANDI-DOT ,set-cdr-next ,tag #x3F "set CDR-NEXT"))) + ,@(when tag-first + `((STW ,(lisp:or set-cdr-next tag) ,disp (,vma) "write the stack cache"))) + ,@(cond ((eq floating :fixed) + `((STFD ,data ,disp (,vma) ,@(if comment `(,comment))))) + (floating + `((STFS ,data ,(+ disp 4) (,vma) ,@(if comment `(,comment))))) + (t + `((STW ,data ,(+ disp 4) (,vma) ,@(if comment `(,comment)))))) + ,@(unless tag-first + `((STW ,(lisp:or set-cdr-next tag) ,disp (,vma) "write the stack cache")))))) + +(defmacro stack-write-tag (vma tag &rest options) + `(stack-write-tag-disp ,vma 0 ,tag ,@options)) + +(defmacro stack-write-data (vma data &rest options) + `(stack-write-data-disp ,vma 0 ,data ,@options)) + +(defmacro stack-write-tag-disp (vma disp tag &rest options) + (with-stack-options (comment &key set-cdr-next) options + (when set-cdr-next (check-temporaries (tag) (set-cdr-next))) + `(,@(when set-cdr-next + `((ANDI-DOT ,set-cdr-next ,tag #x3F "set CDR-NEXT"))) + (STW ,(lisp:or set-cdr-next tag) ,disp (,vma) ,@(if comment `(,comment)))))) + +(defmacro stack-write-data-disp (vma disp data &rest options) + (with-stack-options (comment &key floating) options + `((,(if floating 'STFS 'STW) ,data ,(+ disp 4) (,vma) ,@(if comment `(,comment)))))) + +;;; word can be tag, but not word. +(defmacro combine-tag-data-word (tag data word &optional comment) + (check-temporaries (tag data) (word)) + `((sldi ,word ,tag 32 ,@(if comment `(,comment))) + (OR ,word ,word ,data "construct the combined word"))) + +;;; This generates the combined word in 'word' as well as writing the stack. +;;; the BIS is duel issued with the STD, three cycles are taken (one stall +;;; between the SLL and BIS. + +(defmacro stack-write2c (vma tag data word &optional comment) + (check-temporaries (vma tag data) (word)) + `((combine-tag-data-word ,tag ,data ,word ,comment) + (stack-write ,vma ,word))) + +;;; As above except that the word is tag and data combined. +;;; This takes less cycles, so is preferred. +(defmacro stack-write (vma word &optional comment) + `(stack-write-disp ,vma 0 ,word ,comment)) + +(defmacro stack-write-disp (vma disp word &optional comment) + `((STD ,word ,disp (,vma) ,@(if comment `(,comment))))) + +;;; Push and push2 are like write and write2 except the stack is pushed. + +;;; ADD doesn't stall, takes five cycles, one stall for the SLL. +(defmacro stack-push2c (tag data word &optional comment) + (check-temporaries (tag data) (word)) + `((ADDI iSP iSP 8 ,@(if comment `(,comment))) + (ANDI-DOT ,word ,tag #x3F "Set CDR-NEXT") + (stack-write2c iSP ,word ,data ,word))) + +;;; two cycles, but ADD will stall if iSP used in next instn. +(defmacro stack-push2 (tag data temp &rest options) + (with-stack-options (comment &rest options) options + `((stack-write2-disp iSP 8 ,tag ,data ,comment ,@options :set-cdr-next ,temp) + (ADDI iSP iSP 8)))) + +(defmacro stack-push (word temp &rest options) + (when temp (check-temporaries (word) (temp))) + (with-stack-options (comment &key (set-cdr-next t)) options + (if set-cdr-next + `((ADDI iSP iSP 8) ;here, in case word just fetched + (clrldi ,temp ,word ,(- 64 (+ 32 6)) "Remove everything to left of the tag") + (stack-write-disp iSP 0 ,temp ,comment)) + `((stack-write-disp iSP 8 ,word ,comment) + (ADDI iSP iSP 8))))) + +;;; These are like above, but don't force CDR-NEXT + +(defmacro stack-push2c-with-cdr (tag data temp &optional comment) + (check-temporaries (tag data) (temp)) + `((ADDI iSP iSP 8 ,@(if comment `(,comment))) + (stack-write2c iSP ,tag ,data ,temp))) + +(defmacro stack-push2-with-cdr (tag data &rest options) + (with-stack-options (comment &rest options) options + `(stack-push2 ,tag ,data nil ,comment :set-cdr-next nil ,@options))) + +(defmacro stack-push-tag (tag temp &rest options) + (with-stack-options (comment &rest options) options + `((stack-write-tag-disp iSP 8 ,tag ,comment ,@options :set-cdr-next ,temp) + (ADDI iSP iSP 8)))) + +(defmacro stack-push-tag-with-cdr (tag &rest options) + (with-stack-options (comment &rest options) options + `(stack-push-tag ,tag nil ,comment :set-cdr-next nil ,@options))) + +(defmacro stack-push-data (data &rest options) + `((stack-write-data-disp iSP 8 ,data ,@options) + (ADDI iSP iSP 8))) + +(defmacro stack-push-with-cdr (word &rest options) + (with-stack-options (comment &rest options) options + `(stack-push ,word nil ,comment :set-cdr-next nil ,@options))) + +;;; Stores an immediate TAG and register data in two cycles. +(defmacro stack-push-ir (imtag data temp &rest options) + (check-temporaries (data) (temp)) + `((li ,temp ,imtag) + (stack-push2-with-cdr ,temp ,data ,@options))) + +;;; --- WARNING: If any caller of this macro uses a tag other than |TypeSingleFloat|, +;;; --- this macro will need to be enhanced to pass :floating :fixed to stack-push-ir! +(defmacro fp-stack-push-ir (imtag data temp &rest options) + (with-stack-options (comment &rest options) options + `(stack-push-ir ,imtag ,data ,temp ,comment :floating t ,@options))) + +;; If storing the data first would stall, this can do better... +(defmacro stack-push-ir-reverse (imtag data temp &rest options) + (with-stack-options (comment &rest options) options + `(stack-push-ir ,imtag ,data ,temp ,comment :tag-first t ,@options))) + +;;; Makes a Fixnum from 32 bit data and pushes it. Leaves fixnum in temp. 4 +(defmacro stack-push-fixnumb (data temp &optional comment) + (check-temporaries () (temp)) + `((li ,temp |TypeFixnum| ,@(if comment `(,comment))) + (sldi ,temp ,temp 32) + (ADDI iSP iSP 8) + (ORI ,temp ,temp ,data) + (STD ,temp 0 (iSP) "Push Fixnum"))) + +;;; Pushes a constructed fixnum from 32 bit data in 2 cycles! +(defmacro stack-push-fixnum (data temp &optional comment) + (check-temporaries (data) (temp)) + `((stack-push-ir |TypeFixnum| ,data ,temp ,comment))) + +;;; Pushed NIL in 2 cycles. +(defmacro stack-push-nil (temp temp2 &optional comment) + (check-temporaries () (temp temp2)) + `((Get-NIL ,temp ,comment) + (STD ,temp 8 (iSP)) + (ADDI iSP iSP 8))) + +(defmacro stack-write-nil (vma temp temp2 &optional comment) + (check-temporaries (vma) (temp temp2)) + `((Get-NIL ,temp ,comment) + (STD ,temp 0 (,vma)))) + +(defmacro stack-push-t (temp temp2 &optional comment) + (check-temporaries () (temp temp2)) + `((Get-T ,temp ,comment) + (STD ,temp 8 (iSP)) + (ADDI iSP iSP 8))) + +(defmacro stack-write-t (vma temp temp2 &optional comment) + (check-temporaries () (temp temp2)) + `((Get-T ,temp ,comment) + (STD ,temp 0 (,vma)))) + +(defmacro stack-write-nil-and-push-nil (vma temp &optional comment) + (check-temporaries (vma) (temp)) + `((Get-NIL ,temp ,comment) + (STD ,temp 0 (iSP)) + (STD ,temp 8 (iSP)) + (ADDI iSP iSP 8))) + +(defmacro stack-set-cdr-code (asp code temp) + (check-temporaries (asp) (temp)) + `((LWA ,temp 0 (,asp) "get tag") + (ANDI-DOT ,temp ,temp #x3F) + (ORI ,temp ,temp ,(* 64 code)) + (STW ,temp 0 (,asp) "set tag"))) + +(defmacro get-nil (dest &optional comment) + `((LD ,dest PROCESSORSTATE_NILADDRESS (ivory) ,@(if comment `(,comment))))) + +(defmacro get-nil2 (tag data &optional comment) + `((LWA ,data PROCESSORSTATE_NILADDRESS+4 (ivory)) + (LWA ,tag PROCESSORSTATE_NILADDRESS (ivory) ,@(if comment `(,comment))) + (clrldi ,data ,data 32))) + +(defmacro get-t (dest &optional comment) + `((LD ,dest PROCESSORSTATE_TADDRESS (ivory) ,@(if comment `(,comment))))) + +(defmacro get-t2 (tag data &optional comment) + `((LWA ,data PROCESSORSTATE_TADDRESS+4 (ivory)) + (LWA ,tag PROCESSORSTATE_TADDRESS (ivory) ,@(if comment `(,comment))) + (clrldi ,data ,data 32))) + +;;; One of our callers (TAKE-POST-TRAP) needs to check for recursive stack overflows. +;;; Destroys the value in CR ... +(defmacro stack-overflow-p (cr no-overflow temp temp2 &optional overflow) + (let ((limit temp) + (sp cr) + (sk1 (gensym))) + `((srdi ,cr ,cr 30 "Isolate trap mode") + (LWA ,limit PROCESSORSTATE_CSLIMIT (ivory) "Limit for emulator mode") + (LWA ,temp2 PROCESSORSTATE_CSEXTRALIMIT (ivory) "Limit for extra stack and higher modes") + (CMPI 0 1 ,cr 0) + (BC 12 2 ,sk1 "B.EQ") + (mov ,limit ,temp2 "Get the right limit for the current trap mode") + (unlikely-label ,sk1) + (clrldi ,limit ,limit 32 "Might have been sign extended") + (SCAtoVMA iSP ,sp ,temp2) + (CMP 0 1 ,sp ,limit "Check for overflow") ; Set CR.0 if ,sp < ,limit + ,@(if no-overflow + `((BC 12 0 ,no-overflow "Jump if no overflow")) + `((BC 4 0 ,overflow "Jump if overflow")))))) + +(defmacro stack-overflow-check (cr done-label temp temp2) + `((comment "Check for stack overflow") + (stack-overflow-p ,cr ,done-label ,temp ,temp2 STACKOVERFLOW) + ,@(when done-label + `((external-branch STACKOVERFLOW "Take the trap"))))) + +(defmacro stack-fill (VMA SCA count temp temp2 temp3 temp4) + (check-temporaries (VMA SCA count) (temp temp2)) + (let ((l1 (gensym)) + (l2 (gensym))) + `((VM-Read ,vma ,temp ,temp2 ,temp3 ,temp4 t) ; read and prefetch + (B ,l1) + (label ,l2) + (VM-Read ,vma ,temp ,temp2 ,temp3 ,temp4) + (ADDI ,count ,count -1) + (ADDI ,vma ,vma 1 "advance vma position") + (stack-write2 ,sca ,temp ,temp2) + (ADDI ,sca ,sca 8 "advance sca position") + (unlikely-label ,l1) + (branch-if-greater-than-zero ,count ,l2)))) + +;; ARG indicates which stack pointer to look at -- generally iFP +(defmacro stack-cache-underflow-check (arg done-label underflow-routine + from to count stack-pointer + &rest regs-to-adjust) + (declare (ignore to regs-to-adjust)) + (let ((done (lisp:or done-label (gensym)))) + `((LD ,from PROCESSORSTATE_STACKCACHEDATA (ivory)) + (LD ,stack-pointer PROCESSORSTATE_RESTARTSP (ivory) "Preserve through instruction's original SP") + (SUBF ,count ,arg ,from "Number of words*8 to fill iff positive") + (branch-if-less-than-or-equal-to-zero ,count ,done) + (SRADI ,count ,count 3 "Convert to a word count") + (ADDI ,stack-pointer ,stack-pointer 8 "Account for the inclusive limit") + (branch-if-less-than-or-equal-to-zero ,count ,done "in case only low three bits nonzero") + (call-subroutine ,underflow-routine) + ,(if done-label + `(B ,done) + `(label ,done))))) + +(defmacro stack-cache-underflow-body (from to count stack-pointer + temp2 temp6 temp7 &rest regs-to-adjust) + (let ((temp stack-pointer) + (temp3 from) + (temp4 to) + (temp5 count)) + `((sldi ,to ,count 3) + (ADD ,to ,from ,to "Compute target address for shift") + (SUBF ,temp2 ,from ,stack-pointer "Compute number of elements to preserve") + (SRADI ,temp2 ,temp2 3 "Convert to word count") + (comment "Shove everything up") + (stack-block-copy ,from ,to ,temp2 nil t ,temp6 ,temp7) + (comment "Adjust stack cache relative registers") + (sldi ,temp7 ,count 3) ; temp7 ok? +++ + (ADD iFP ,temp7 iFP) + (LD ,temp PROCESSORSTATE_RESTARTSP (ivory)) + (ADD iSP ,temp7 iSP) + (ADD iLP ,temp7 iLP) + (ADD ,temp ,temp7 ,temp) + (sldi ,from ,count 3) + ,@(loop for reg in regs-to-adjust + collect `(ADD ,reg ,from ,reg)) + (comment "Fill freshly opened slots of stack cache from memory") + (LD ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (LD ,to PROCESSORSTATE_STACKCACHEDATA (ivory)) + (STD ,temp PROCESSORSTATE_RESTARTSP (ivory)) + (SUBF ,from ,count ,from "Compute new base address of stack cache") + (LD ,temp PROCESSORSTATE_STACKCACHETOPVMA (ivory) "Top of cache") + (STD ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + (SUBF ,temp ,count ,temp "Adjust top of cache") + (STD ,temp PROCESSORSTATE_STACKCACHETOPVMA (ivory)) + (stack-fill ,from ,to ,count ,temp ,temp2 ,temp6 ,temp7) + (passthru "#ifdef TRACING") + (maybe-trace ,temp ,temp2 ,temp3 ,temp4 ,temp5 ,temp6) + (passthru "#endif")))) + +;;; Hand coded versions of stack-read2 and VM-Write to use fewer registers. +;;; We don't have to worry about the data cache as we're dumping from the +;;; stack cache which was never in the data cache in the first place. +;;; --- s/b in memoryem, so all memory code is in one place! +(defmacro stack-dump (VMA SCA count temp temp2) + (check-temporaries (VMA SCA count) (temp temp2)) + (let ((datal1 (gensym)) + (datal2 (gensym)) + (tagl1 (gensym)) + (tagl2 (gensym))) + `((STW ,count PROCESSORSTATE_SCOVDUMPCOUNT (ivory) "Will be destructively modified") + (ADD ,temp2 ,vma Ivory "Starting address of tags") + (sldi ,vma ,temp2 2 "Starting address of data") + (comment "Dump the data") + (B ,datal1) + (label ,datal2) + (LWA ,temp 4 (,sca) "Get data word") + (ADDI ,count ,count -1) + (ADDI ,sca ,sca 8 "Advance SCA position") + (STW ,temp 0 (,vma) "Save data word") + (ADDI ,vma ,vma 4 "Advance VMA position") + (unlikely-label ,datal1) + (branch-if-greater-than-zero ,count ,datal2) + (comment "Dump the tags") + (LWA ,count PROCESSORSTATE_SCOVDUMPCOUNT (ivory) "Restore the count") + (mov ,vma ,temp2 "Restore tag VMA") + (sldi ,temp ,count 3) + (SUBF ,sca ,temp ,sca "Restore orginal SCA") + (B ,tagl1) + (label ,tagl2) + (ADDI ,count ,count -1) + (LWA ,temp 0 (,sca) "Get tag word") + (ADDI ,sca ,sca 8 "Advance SCA position") + (STB ,temp 0 (,vma) "Save packed tags word") + (ADDI ,vma ,vma 1 "Advance VMA position") + (unlikely-label ,tagl1) + (branch-if-greater-than-zero ,count ,tagl2) + ))) + +(defmacro stack-cache-overflow-check (temp temp2 temp3 temp4 temp5 + &optional + (sp 'iSP) + (nwords 0) + &aux + (handler '|StackCacheOverflowHandler|) + (handler-arg 'arg2)) + ;; don't need temp3, temp5 + (assert (eq sp 'iSP) () "That won't work") + (check-temporaries (sp handler-arg) (temp temp2 temp3 temp4 temp5)) + (let ((newSCA temp) + (oldSCA temp2) + (not-done (gensym)) + (nwords-is-reg? (find-register nwords))) + (unless (eq nwords handler-arg) + (push + `((label ,not-done) + ,@(if nwords-is-reg? + `((mov ,handler-arg ,nwords)) + `((li ,handler-arg ,nwords))) + (B ,handler)) + *function-epilogue*)) + `(,@(unless *memoized-limit* + `((LWA ,temp4 PROCESSORSTATE_SCOVLIMIT (ivory) "Current stack cache limit (words)"))) + (load-constant ,newSCA #.|StackCacheMargin| "Must always have this much room") + (LD ,oldSCA PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + ,@(unless (eql nwords 0) + (if nwords-is-reg? + `((ADD ,newSCA ,newSCA ,nwords "Account for what we're about to push")) + `((ADDI ,newSCA ,newSCA ,nwords "Account for what we're about to push")))) + (sldi ,newSCA ,newSCA 3) + (ADD ,newSCA ,sp ,newSCA "SCA of desired end of cache") + (sldi ,temp5 ,(lisp:or *memoized-limit* temp4) 3) + (ADD ,oldSCA ,temp5 ,oldSCA "SCA of current end of cache") + (CMP 0 1 ,newSCA ,oldSCA) + ,@(if (eq nwords handler-arg) + `((bclong 12 1 ,handler "We're done if new SCA is within bounds")) + `((BC 12 1 ,not-done "We're done if new SCA is within bounds"))) + ))) + +(defmacro stack-cache-overflow-handler (temp temp2 temp3 temp4 temp5 + &aux (sp 'iSP) (nwords 'arg2)) + (check-temporaries (sp nwords) (temp temp2 temp3 temp4 temp5)) + (let ((pagemissing 'PAGENOTRESIDENT) + (faultrequest 'PAGEFAULTREQUESTHANDLER) + (writefault 'PAGEWRITEFAULT) + ;; retry the instruction + (done 'INTERPRETINSTRUCTION) + (newsca temp) + (count temp) + (from temp2) + (to temp3)) + `((comment "Stack cache overflow detected") + ;; We add another margin (effectively scrolling) to avoid + ;; immediately overflowing again + (load-constant ,newSCA ,(* |StackCacheMargin| 2)) + (ADD ,newSCA ,newSCA ,nwords "Account for what we're about to push") + (sldi ,newSCA ,newSCA 3) + (ADD ,newSCA iSP ,newSCA "SCA of desired end of cache") + ;; Restore the SP for retry + (LD iSP PROCESSORSTATE_RESTARTSP (ivory)) + (LD ,temp4 PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + (SUBF ,temp4 ,temp4 ,newSCA "New limit*8") + (srdi ,temp4 ,temp4 3) + (STW ,temp4 PROCESSORSTATE_SCOVLIMIT (ivory) "Update stack cache limit") + (comment "Check that the page underlying the end of the stack cache is accessible") + (SCAtoVMA ,newSCA ,to ,temp4) + (check-access ,to ,temp4 ,temp5 ,pagemissing ,faultrequest ,writefault) + (comment "Check if we must dump the cache") + (LWA ,temp4 PROCESSORSTATE_SCOVLIMIT (ivory) "New stack cache limit (words)") + (LD ,temp5 PROCESSORSTATE_STACKCACHESIZE (ivory) "Absolute size of the cache (words)") + (CMP 0 1 ,temp4 ,temp5) + (BC 4 1 ,done "We're done if new limit is less than absolute limit") + (comment "Dump the stack cache to make room") + (load-constant ,count #.|StackCacheDumpQuantum| "Always dump this amount") + (LD ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Stack cache base VMA") + (LD ,to PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + (stack-dump ,from ,to ,count ,temp4 ,temp5) + (load-constant ,count #.|StackCacheDumpQuantum| "Always dump this amount") + (LD ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Stack cache base VMA") + (LD ,temp4 PROCESSORSTATE_STACKCACHETOPVMA (ivory) "Top of cache") + (LWA ,temp5 PROCESSORSTATE_SCOVLIMIT (ivory) "Cache limit in words") + (ADD ,from ,from ,count "Adjust cache base VMA") + (ADD ,temp4 ,temp4 ,count "Adjust top of cache") + (SUBF ,temp5 ,count ,temp5 "Adjust limit") + (STD ,from PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Save update") + (STD ,temp4 PROCESSORSTATE_STACKCACHETOPVMA (ivory)) + (STW ,temp5 PROCESSORSTATE_SCOVLIMIT (ivory)) + (comment "Move the cache down") + (LD ,to PROCESSORSTATE_STACKCACHEDATA (ivory) "Alpha base of stack cache") + (sldi ,from ,count 3) + (ADD ,from ,to ,from "SCA of first word of new base") + (stack-block-copy ,from ,to ,count nil nil ,temp4 ,temp5) + (comment "Adjust stack cache relative registers") + (load-constant ,count #.|StackCacheDumpQuantum| "Always dump this amount") + (sldi ,count ,count 3 "Convert to SCA adjustment") + (SUBF iSP ,count iSP) + (SUBF iFP ,count iFP) + (SUBF iLP ,count iLP) + ;; Store adjusted (restored) SP + (STD iSP PROCESSORSTATE_RESTARTSP (ivory)) + (ContinueToInterpretInstruction)))) + +;;; This macro destructively advances count, from and to registers. +(defmacro stack-block-copy (from to count ccp upp temp temp2) + (check-temporaries (from to count) (temp temp2)) + (let ((l1 (gensym)) + (l2 (gensym))) + `(,@(when ccp + `((LD ,temp PROCESSORSTATE_CDRCODEMASK (ivory) "mask for CDR codes"))) + ,@(when upp + `((sldi ,temp2 ,count 3) + (ADD ,from ,temp2 ,from "Adjust to end of source block") + (ADD ,to ,temp2 ,to "Adjust to end of target block"))) + (B ,l1) + (label ,l2) + ,@(when upp + `((ADDI ,from ,from -8 "advance from position"))) + (ADDI ,count ,count -1) + (stack-read ,from ,temp2 "Get a word from source") + ,@(when (not upp) + `((ADDI ,from ,from 8 "advance from position"))) + ,@(when upp + `((ADDI ,to ,to -8 "advance to position"))) + ,@(when ccp + `((ANDC ,temp2 ,temp2 ,temp "Strip off CDR code"))) + (stack-write ,to ,temp2 "Put word in destination") + ,@(when (not upp) + `((ADDI ,to ,to 8 "advance to position"))) + (unlikely-label ,l1) + (branch-if-greater-than-zero ,count ,l2)))) + +;;; Fin. + diff --git a/include/VLM_configuration.h b/include/VLM_configuration.h new file mode 100644 index 0000000..c0577d0 --- /dev/null +++ b/include/VLM_configuration.h @@ -0,0 +1,130 @@ +/* Configuration parameters for the VLM: + Defaults can be overridden by either the user's .VLM file or command line arguments */ + +#ifndef _VLM_CONFIG_ +#define _VLM_CONFIG_ + +#include +#include +#include +#include "pfilt_wrapper.h" + +#include "life_types.h" + + +/* X window configuration parameters */ + +typedef struct + { + char *xpHostName; /* Name of host where screen will appear; NULL for local */ + long xpHostAddress; /* Protocol address of the above */ + int xpDisplay; /* Display number on the host; -1 for default */ + int xpScreen; /* Screen number on the host; -1 for default */ + int xpInitialState; /* Window's initial state (a WindowInitialState) */ + char *xpGeometry; /* X geometry specification for window */ + char *xpForegroundColor; /* Name of foreground color */ + char *xpBackgroundColor; /* Name of background color */ + char *xpBorderColor; /* Name of border color */ + int xpBorderWidth; /* Width of border in pixels */ + } XParams; + + +/* Configuration data for a single network interface */ + +typedef struct NetworkInterface + { + boolean present; /* TRUE => this interface is available */ + char device[_POSIX_PATH_MAX+1]; /* Optional interface or packet filter name */ + unsigned short myProtocol; /* Primary Ethernet protocol */ + struct in_addr myAddress; /* Primary protocol address */ + struct in_addr myHostAddress; /* Hosts primary address */ + boolean haveMac; /* true, if MAC set */ + struct mac_addr { + unsigned char bytes[6]; + } myMac; /* MAC address, if given */ +#ifdef GENERA + char myOptions[_POSIX_PATH_MAX+1]; /* Primary network options */ + struct NetworkInterface* anotherAddress; /* Secondary address for this interface */ +#endif + } NetworkInterface; + +#define MaxNetworkInterfaces 8 +#define ETHERTYPE_CHAOS 0x0804 + + +/* We'll place the communications area immediately after the BootComm and BootData areas + in "VMA=PMA" space. Those two area occupy 128 (#x80) words starting at #xFFFE0000. + Thus, the communications area will begin at location #xFFFE0080 and can be no more + than #x1FF80 (130944) words. */ +#define EmbCommAreaAddress 0xFFFE0080L +#define DefaultEmbCommAreaSize 0x1FF80 +#define DefaultHostBufferSpace 15000 +#define DefaultGuestBufferSpace 100000 + +#define DefaultVLMConfigFilePathname "/var/lib/symbolics/.VLM" + +#define DefaultVLMDebuggerPathname "/var/lib/symbolics/VLM_debugger" + +#define DefaultGeneraWorldPathname "/var/lib/symbolics/Genera-8-5.vlod" +#define DefaultMinimaWorldPathname "/var/lib/symbolics/Minima.mlod" +#define DefaultWorldSearchPath "/var/lib/symbolics:/usr/lib/symbolics" + +#define DefaultVirtualMemory "200" +#define MinimumVirtualMemory 125 + + +/* Channel Queue sizes -- Eventually, these could be parameters in the configuration file */ + +#define DiskQueueSize 32 +#define ConsoleInputQueueSize 50 +#define ConsoleOutputQueueSize 50 +#define NetworkReceiverQueueSize 100 /* was 20, prevents losing so many packets */ +#define NetworkTransmitterQueueSize 60 /* was 20 */ +#define RPCHostToGuestQueueSize 15 +#define RPCGuestToHostQueueSize 30 +#define SCSIQueueSize 10 +#define ColdLoadInputQueueSize 50 /* was 100: jj? */ +#define ColdLoadOutputQueueSize 50 /* was 50: jj? */ +#define HostFileCommandQueueSize 5 +#define HostFileReplyQueueSize 5 +#define CommandQueueSize 5 + + +/* Instruction tracing configuration data */ + +typedef struct + { + boolean traceP; /* TRUE => Enable instruction tracing */ + boolean tracePOST; /* TRUE => Trace the POST test */ + int bufferSize; /* Size of circular trace buffer */ + unsigned int startPC; /* PC where tracing will start if non-zero */ + unsigned int stopPC; /* PC where tracing will stop if non-zero */ + char *outputFile; /* Name of file to record full trace */ +} TraceConfig; + + +/* Main configuration data structure */ + +typedef struct + { + boolean enableSpy; /* TRUE => Enable remote memory spy */ + TraceConfig tracing; /* Controls instruction tracing */ + size_t commAreaSize; /* Size of communications area in words */ + size_t hostBufferSpace; /* Words reserved for host buffers */ + size_t guestBufferSpace; /* Words reserved for guest buffers */ + char vlmDebuggerPath[_POSIX_PATH_MAX+1]; /* Pathname of VLM debugger to be loaded */ + char worldPath[_POSIX_PATH_MAX+1]; /* Pathname of world load to be loaded */ +#ifdef GENERA + char* worldSearchPath; /* -> Directories to search for worlds */ + boolean enableIDS; /* TRUE => allow incremental disk saves */ + size_t virtualMemory; /* Size of emulated virtual memory */ +#endif + XParams coldLoadXParams; /* X parameters for cold load window */ + XParams generaXParams; /* X Parameters for the main screen */ + struct in_addr diagnosticIPAddress; /* IP address of our diagnostic server */ + NetworkInterface interfaces[MaxNetworkInterfaces]; /* Network interfaces [8] */ + boolean testFunction; /* TRUE => run TESTFCN instead of FIB for POST */ + /* Other parameters? */ + } VLMConfig; + +#endif diff --git a/include/spy.h b/include/spy.h new file mode 100644 index 0000000..492bf45 --- /dev/null +++ b/include/spy.h @@ -0,0 +1,20 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Function prototypes for the external interface to the Remote Debugger spy */ + +#ifndef _SPY_ +#define _SPY_ + +#include "life_types.h" +#include "embed.h" + +extern EmbMBINChannel *activeMBINChannel; + +void InitializeSpy (boolean sendTrapP, unsigned long diagnosticAddress); +void ReleaseSpyLock (void); +void SendMBINBuffers (EmbMBINChannel* mbinChannel); +void TerminateSpy (void); + +void RemoteMemorySpyLoop (void); + +#endif diff --git a/include/std.h b/include/std.h new file mode 100644 index 0000000..a9076f3 --- /dev/null +++ b/include/std.h @@ -0,0 +1,133 @@ +/* Include the standard system header files */ + +#ifndef _STD_H_ +#define _STD_H_ + +#define _GNU_SOURCE +#define _THREAD_SAFE +#ifdef _FORTIFY_SOURCE +#undef _FORTIFY_SOURCE +#endif +#define _FORTIFY_SOURCE 1 +#include "config.h" +/* check for ucontext_t */ +#ifndef HAVE_UCONTEXT_T +#include +typedef struct ucontext ucontext_t; +#endif + +#if defined(__OSF__) || defined(__osf__) +#define OS_OSF +#elif defined(linux) +#define OS_LINUX +#elif defined(__APPLE__) +#define OS_DARWIN +#elif defined(__FreeBSD__) +#define OS_FREEBSD +#else +#error "Unsupported OS" +#endif + +#if defined(__alpha) || defined(__alpha__) +#define ARCH_ALPHA +#elif defined(__powerpc64__) || defined(__ppc64__) +#define ARCH_PPC64 +#elif defined(__x86_64__) +#define ARCH_X86_64 +#else +#error "Unsupported processor architecture" +#endif + +#include +#include +#include +#include + +#ifdef OS_LINUX +#include +#else +#include +#endif + +#include "swapbytes.h" + +#include + +typedef void* pthread_addr_t; +typedef void (*pthread_cleanuproutine_t) (void*); +typedef void* (*pthread_startroutine_t) (void*); + +#ifndef OS_OSF +#define pthread_yield sched_yield +int pthread_get_expiration_np (const struct timespec *delta, struct timespec *abstime); +int pthread_delay_np (const struct timespec *interval); +#endif + +#ifdef OS_OSF +/* These are the types defined in which is newer than OSF */ +typedef signed char int8_t; +typedef short int int16_t; +typedef int int32_t; +typedef long int int64_t; +typedef unsigned char uint8_t; +typedef unsigned short int uint16_t; +typedef unsigned int uint32_t; +typedef unsigned long int uint64_t; +typedef signed char int_least8_t; +typedef short int int_least16_t; +typedef int int_least32_t; +typedef long int int_least64_t; +typedef unsigned char uint_least8_t; +typedef unsigned short int uint_least16_t; +typedef unsigned int uint_least32_t; +typedef unsigned long int uint_least64_t; +typedef signed char int_fast8_t; +typedef long int int_fast16_t; +typedef long int int_fast32_t; +typedef long int int_fast64_t; +typedef unsigned char uint_fast8_t; +typedef unsigned long int uint_fast16_t; +typedef unsigned long int uint_fast32_t; +typedef unsigned long int uint_fast64_t; +typedef long int intptr_t; +typedef unsigned long int uintptr_t; +typedef long int intmax_t; +typedef unsigned long int uintmax_t; + +#else +#include +#ifdef OS_LINUX +#include +#endif +#define TRUE 1 +#define FALSE 0 +#define ESUCCESS 0 +#endif + +#include +/* ---*** TODO: Kludge 'till I figure out how I messed up the toolchain ... */ +#ifndef _POSIX_PATH_MAX +#define _POSIX_PATH_MAX 256 +#endif +#ifndef _POSIX_ARG_MAX +#define _POSIX_ARG_MAX 4096 +#endif + +#include +#if defined(OS_DARWIN) || defined(__FreeBSD__) +#include +#endif + +typedef void (*sa_handler_t) (int); +typedef void (*sa_sigaction_t) (int, siginfo_t*, void*); + +#include +#include + +#include +#include +#include +#include +#include + +#endif diff --git a/include/swapbytes.h b/include/swapbytes.h new file mode 100644 index 0000000..3dc6af0 --- /dev/null +++ b/include/swapbytes.h @@ -0,0 +1,78 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +#ifndef _SWAPBYTES_ +#define _SWAPBYTES_ + +#ifdef __powerpc64__ + +#define bswap_32(w) \ + ({ uint32_t __value = (w); \ + asm (" la 14,%0\n lwbrx 0,0,14\n stw 0,%0" \ + : "=g"(__value) : "0"(__value) : "r0", "r14"); \ + __value; }) + +#define bswap_16(w) \ + ({ uint16_t __value = (w); \ + asm (" la 14,%0\n lhbrx 0,0,14\n sth 0,%0" \ + : "=g"(__value) : "0"(__value) : "r0", "r14"); \ + __value; }) + +#define bswap32_block(p,n) \ +{ uint32_t *wordP = (uint32_t*)p; \ + size_t nWords = (n + 3) / 4; \ + asm ( \ +" ld 0,%0\n" \ +" ld 14,%1\n" \ +" lwbrx 15,0,14\n" \ +" stw 15,0(14)\n" \ +" addi 14,14,4\n" \ +" addic. 0,0,-1\n" \ +" bgt -16" \ + : : "g"(nWords), "g"(wordP) : "r0", "r14", "r15"); \ +} + +#define bswap16_block(p,n) \ +{ uint16_t *wordP = (uint16_t*)p; \ + size_t nWords = (n + 1) / 2; \ + asm ( \ +" ld 0,%0\n" \ +" ld 14,%1\n" \ +" lhbrx 15,0,14\n" \ +" sth 15,0(14)\n" \ +" addi 14,14,2\n" \ +" addic. 0,0,-1\n" \ +" bgt -16" \ + : : "g"(nWords), "g"(wordP) : "r0", "r14", "r15"); \ +} + +#else + +#if defined(OS_OSF) || defined(OS_FREEBSD) +static __inline unsigned int bswap_32 (unsigned int __bsx) { + return ((((__bsx) & 0xff000000) >> 24) | (((__bsx) & 0x00ff0000) >> 8) | + (((__bsx) & 0x0000ff00) << 8) | (((__bsx) & 0x000000ff) << 24)); +} +static __inline unsigned short int bswap_16 (unsigned short int __bsx) { + return ((((__bsx) >> 8) & 0x00ff) | (((__bsx) & 0x00ff) << 8)); +} +#else +#include +#endif + +#define bswap32_block(p,n) \ +{ size_t nWords = (n + 3) / 4, i; \ + uint32_t *wordP = (uint32_t*)p; \ + for (i = 0; i < nWords; i++, wordP++) \ + *wordP = bswap_32 (*wordP); \ +} + +#define bswap16_block(p,n) \ +{ size_t nWords = (n + 1) / 2, i; \ + uint16_t *wordP = (uint16_t*)p; \ + for (i = 0; i < nWords; i++, wordP++) \ + *wordP = bswap_16 (*wordP); \ +} + +#endif + +#endif diff --git a/include/utilities.h b/include/utilities.h new file mode 100644 index 0000000..68bd839 --- /dev/null +++ b/include/utilities.h @@ -0,0 +1,20 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Prototypes of all functions in utilities.c */ + +#ifndef _UTILITIES_ +#define _UTILITIES_ + +#include "VLM_configuration.h" + +void verror (char* section, char* format, ...); +void vpunt (char* section, char* format, ...); +void vwarn (char* section, char* format, ...); + +void BuildConfiguration (VLMConfig* config, int argc, char** argv); +void SetCommandName (char* newCommandName); +void BuildXDisplayName (char* displayName, char* hostName, int display, int screen); + +/* Internal function prototypes are in utilities.c itself */ + +#endif diff --git a/include/world_tools.h b/include/world_tools.h new file mode 100644 index 0000000..6eb611d --- /dev/null +++ b/include/world_tools.h @@ -0,0 +1,209 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Ivory and VLM World File Format */ + +#ifndef _WORLD_TOOLS_ +#define _WORLD_TOOLS_ + +#include +#include + +#include "life_types.h" +#include "VLM_configuration.h" +#include "ivoryrep.h" +#include "memory.h" + + +/* A single load map entry -- See SYS:NETBOOT;WORLD-SUBSTRATE.LISP for details */ + +typedef struct + { + Integer address; /* VMA to be filled in by this load map entry */ + struct + { +#if BYTE_ORDER == LITTLE_ENDIAN + Integer count:24; /* Number of words to be filled in by this entry */ + Integer opcode:8; /* An LoadMapEntryOpcode specifying how to do so */ +#else + Integer opcode:8; /* An LoadMapEntryOpcode specifying how to do so */ + Integer count:24; /* Number of words to be filled in by this entry */ +#endif + } op; + LispObj data; /* Interpretation is based on the opcode */ + PtrV world; /* -> World from which this entry was obtained */ + } LoadMapEntry; + +/* Load map operation codes */ + +enum LoadMapEntryOpcode + { + LoadMapDataPages, /* Load data pages from the file */ + LoadMapConstant, /* Store a constant into memory */ + LoadMapConstantIncremented, /* Store an auto-incrementing constant into memory */ + LoadMapCopy /* Copy an existing piece of memory */ + }; + + +/* Description of an open world file */ + +typedef struct World + { + char* pathname; /* -> Pathname of the world file */ + int fd; /* Unix filedes # if the world file is open */ + int format; /* A LoadFileFormat indicating the type of file */ + int byteSwapped; /* World is byte swapped on this machine (VLM only) */ + int vlmDataPageBase; /* Block number of first page of data (VLM only) */ + int vlmTagsPageBase; /* Block number of first page of tags (VLM only) */ + byte* vlmDataPage; /* -> The data of the current VLM format page */ + byte* vlmTagsPage; /* -> The tags of the current VLM format page */ + byte* ivoryDataPage; /* -> The data of the current Ivory format page */ + int currentPageNumber; /* Page number of the page in the buffer, if any */ + int currentQNumber; /* Q number within the page to be read */ + struct World* parentWorld; /* -> Parent of this world if it's an IDS */ + Integer sysoutGeneration; /* Generation number of this world (> 0 if IDS) */ + Integer sysoutTimestamp1; /* Unique ID of this world, part 1 ... */ + Integer sysoutTimestamp2; /* ... part 2 */ + Integer sysoutParentTimestamp1; /* Unique ID of this world's parent, part 1 ... */ + Integer sysoutParentTimestamp2; /* ... part 2 */ + int nWiredMapEntries; /* Number of wired load map entries */ + LoadMapEntry* wiredMapEntries; /* -> The wired load map entries */ + int nMergedWiredMapEntries; /* As above but after merging with parent worlds */ + LoadMapEntry* mergedWiredMapEntries; /* .. */ + int nUnwiredMapEntries; /* Number of unwired load map entries (Ivory only) */ + LoadMapEntry* unwiredMapEntries; /* -> The unwired load map entries (Ivory only) */ + int nMergedUnwiredMapEntries; /* As above but after merging with parent worlds */ + LoadMapEntry* mergedUnwiredMapEntries; /* .. */ + } World; + + +/* Possible world file formats */ + +enum LoadFileFormat + { + VLMWorldFormat, /* VLM world file (.VLOD) */ + IvoryWorldFormat /* Ivory world file (.ILOD) */ + }; + +/* Common world format format definitions */ + +#define VersionAndArchitectureQ 0 + + +/* VLM world file format definitions */ + +#define VLMWorldSuffix ".vlod" + +#define VLMWorldFileCookie 024342504610L +#define VLMWorldFileCookieSwapped 021042305243L +#define VLMPageSizeQs 8192 +#define VLMBlockSize 8192 +#define VLMBlocksPerDataPage 4 +#define VLMBlocksPerTagsPage 1 +#define VLMMaximumHeaderBlocks 14 +#define VLMDataPageSizeBytes 4 * VLMPageSizeQs +#define VLMTagsPageSizeBytes VLMPageSizeQs + +#define VLMVersion1AndArchitecture 040000200 +#define VLMWorldFileV1WiredCountQ 1 +#define VLMWorldFileV1UnwiredCountQ 0 +#define VLMWorldFileV1PageBasesQ 3 +#define VLMWorldFileV1FirstSysoutQ 0 +#define VLMWorldFileV1FirstMapQ 8 + +#define VLMVersion2AndArchitecture 040000201 +#define VLMWorldFileV2WiredCountQ 1 +#define VLMWorldFileV2UnwiredCountQ 0 +#define VLMWorldFileV2PageBasesQ 2 +#define VLMWorldFileV2FirstSysoutQ 3 +#define VLMWorldFileV2FirstMapQ 8 + +/* Block numbers of the first page of data and tags for a VLM world as stored in its header */ + +typedef struct + { +#if BYTE_ORDER == LITTLE_ENDIAN + Integer dataPageBase: 28; + Integer tagsPageBase: 4; /* Limits header and load maps to 112K bytes */ +#else + Integer tagsPageBase: 4; /* Limits header and load maps to 112K bytes */ + Integer dataPageBase: 28; +#endif + } VLMPageBases; + + +/* Ivory world file format definitions */ + +#define IvoryWorldSuffix ".ilod" + +#if BYTE_ORDER == LITTLE_ENDIAN +#define IvoryWorldFileCookie 014322444510L +#else +#define IvoryWorldFileCookie 011022245143L +#endif +#define IvoryPageSizeQs 256 +#define IvoryPageSizeBytes 1280 +#define IvoryWorldFileWiredCountQ 1 +#define IvoryWorldFileUnwiredCountQ 2 +#define IvoryWorldFileFirstSysoutQ 0 +#define IvoryWorldFileFirstMapQ 8 + + +/* Data structures passed by Lisp via the SaveWorld coprocessor register */ + +typedef struct + { + Integer address; /* VMA of data (usually a region) to be saved */ + Integer extent; /* Number of words starting at this address to save */ + } SaveWorldEntry; + +typedef struct + { + Integer pathname; /* Pathname of the world file (a DTP-STRING) */ + Integer entryCount; /* Number of address/extent pairs to follow */ + SaveWorldEntry entries[1]; + } SaveWorldData; + + +/* Prototypes of all functions in worlds_tools.c */ + +void LoadVLMDebugger (VLMConfig* config); +Integer LoadWorld (VLMConfig* config); +void SaveWorld (Integer saveWorldDataVMA); +void ByteSwapWorld (char* worldPathname, char* searchPath); + +void ByteSwapOneWorld (World* world); +void CanonicalizeVLMLoadMapEntries (World* world); +void CloseExtraWorlds (); +void CloseWorldFile (World* world, boolean closeParents); +void CreateWorldFile (World* world); +void FindParentWorlds (World* world, char* worldSearchPath); +Integer IvoryLoadMapData (World* world, LoadMapEntry* mapEntry); +Integer LoadMapData (World* world, LoadMapEntry* mapEntry); +void MergeAMap (int nForeground, LoadMapEntry* foreground, + int nBackground, LoadMapEntry* background, + int* nMerged, LoadMapEntry** merged); +void MergeLoadMaps (World* world, char* worldSearchPath); +void MergeParentLoadMap (World* world); +boolean OpenWorldFile (World* world, boolean puntOnErrors); +void PrepareToWriteIvoryWorldFilePage (World* world, int pageNumber); +void ReadIvoryWorldFileNextQ (World* world, LispObj* q); +void ReadIvoryWorldFilePage (World* world, int pageNumber); +void ReadIvoryWorldFileQ (World* world, int qNumber, LispObj* q); +void ReadLoadMap (World* world, int nMapEntries, LoadMapEntry* mapEntries); +void ReadSwappedVLMWorldFileNextQ (World* world, LispObj *q); +void ReadSwappedVLMWorldFilePage (World* world, int pageNumber); +void ReadSwappedVLMWorldFileQ (World* world, int qNumber, LispObj *q); +void ScanOneDirectory (World* world); +Integer VLMLoadMapData (World* world, LoadMapEntry* mapEntry); +#ifdef OS_LINUX +int WorldP (const struct dirent* candidateWorld); +#else +int WorldP (struct dirent* candidateWorld); +#endif +void WriteIvoryWorldFileNextQ (World* world, LispObj q); +void WriteIvoryWorldFilePage (World* world); +void WriteVLMWorldFileHeader (World* world); +void WriteVLMWorldFilePages (World* world); + + +#endif diff --git a/install-sh b/install-sh new file mode 100755 index 0000000..377bb86 --- /dev/null +++ b/install-sh @@ -0,0 +1,527 @@ +#!/bin/sh +# install - install a program, script, or datafile + +scriptversion=2011-11-20.07; # UTC + +# This originates from X11R5 (mit/util/scripts/install.sh), which was +# later released in X11R6 (xc/config/util/install.sh) with the +# following copyright and license. +# +# Copyright (C) 1994 X Consortium +# +# Permission is hereby granted, free of charge, to any person obtaining a copy +# of this software and associated documentation files (the "Software"), to +# deal in the Software without restriction, including without limitation the +# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +# sell copies of the Software, and to permit persons to whom the Software is +# furnished to do so, subject to the following conditions: +# +# The above copyright notice and this permission notice shall be included in +# all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +# X CONSORTIUM BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN +# AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNEC- +# TION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the name of the X Consortium shall not +# be used in advertising or otherwise to promote the sale, use or other deal- +# ings in this Software without prior written authorization from the X Consor- +# tium. +# +# +# FSF changes to this file are in the public domain. +# +# Calling this script install-sh is preferred over install.sh, to prevent +# 'make' implicit rules from creating a file called install from it +# when there is no Makefile. +# +# This script is compatible with the BSD install script, but was written +# from scratch. + +nl=' +' +IFS=" "" $nl" + +# set DOITPROG to echo to test this script + +# Don't use :- since 4.3BSD and earlier shells don't like it. +doit=${DOITPROG-} +if test -z "$doit"; then + doit_exec=exec +else + doit_exec=$doit +fi + +# Put in absolute file names if you don't have them in your path; +# or use environment vars. + +chgrpprog=${CHGRPPROG-chgrp} +chmodprog=${CHMODPROG-chmod} +chownprog=${CHOWNPROG-chown} +cmpprog=${CMPPROG-cmp} +cpprog=${CPPROG-cp} +mkdirprog=${MKDIRPROG-mkdir} +mvprog=${MVPROG-mv} +rmprog=${RMPROG-rm} +stripprog=${STRIPPROG-strip} + +posix_glob='?' +initialize_posix_glob=' + test "$posix_glob" != "?" || { + if (set -f) 2>/dev/null; then + posix_glob= + else + posix_glob=: + fi + } +' + +posix_mkdir= + +# Desired mode of installed file. +mode=0755 + +chgrpcmd= +chmodcmd=$chmodprog +chowncmd= +mvcmd=$mvprog +rmcmd="$rmprog -f" +stripcmd= + +src= +dst= +dir_arg= +dst_arg= + +copy_on_change=false +no_target_directory= + +usage="\ +Usage: $0 [OPTION]... [-T] SRCFILE DSTFILE + or: $0 [OPTION]... SRCFILES... DIRECTORY + or: $0 [OPTION]... -t DIRECTORY SRCFILES... + or: $0 [OPTION]... -d DIRECTORIES... + +In the 1st form, copy SRCFILE to DSTFILE. +In the 2nd and 3rd, copy all SRCFILES to DIRECTORY. +In the 4th, create DIRECTORIES. + +Options: + --help display this help and exit. + --version display version info and exit. + + -c (ignored) + -C install only if different (preserve the last data modification time) + -d create directories instead of installing files. + -g GROUP $chgrpprog installed files to GROUP. + -m MODE $chmodprog installed files to MODE. + -o USER $chownprog installed files to USER. + -s $stripprog installed files. + -t DIRECTORY install into DIRECTORY. + -T report an error if DSTFILE is a directory. + +Environment variables override the default commands: + CHGRPPROG CHMODPROG CHOWNPROG CMPPROG CPPROG MKDIRPROG MVPROG + RMPROG STRIPPROG +" + +while test $# -ne 0; do + case $1 in + -c) ;; + + -C) copy_on_change=true;; + + -d) dir_arg=true;; + + -g) chgrpcmd="$chgrpprog $2" + shift;; + + --help) echo "$usage"; exit $?;; + + -m) mode=$2 + case $mode in + *' '* | *' '* | *' +'* | *'*'* | *'?'* | *'['*) + echo "$0: invalid mode: $mode" >&2 + exit 1;; + esac + shift;; + + -o) chowncmd="$chownprog $2" + shift;; + + -s) stripcmd=$stripprog;; + + -t) dst_arg=$2 + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac + shift;; + + -T) no_target_directory=true;; + + --version) echo "$0 $scriptversion"; exit $?;; + + --) shift + break;; + + -*) echo "$0: invalid option: $1" >&2 + exit 1;; + + *) break;; + esac + shift +done + +if test $# -ne 0 && test -z "$dir_arg$dst_arg"; then + # When -d is used, all remaining arguments are directories to create. + # When -t is used, the destination is already specified. + # Otherwise, the last argument is the destination. Remove it from $@. + for arg + do + if test -n "$dst_arg"; then + # $@ is not empty: it contains at least $arg. + set fnord "$@" "$dst_arg" + shift # fnord + fi + shift # arg + dst_arg=$arg + # Protect names problematic for 'test' and other utilities. + case $dst_arg in + -* | [=\(\)!]) dst_arg=./$dst_arg;; + esac + done +fi + +if test $# -eq 0; then + if test -z "$dir_arg"; then + echo "$0: no input file specified." >&2 + exit 1 + fi + # It's OK to call 'install-sh -d' without argument. + # This can happen when creating conditional directories. + exit 0 +fi + +if test -z "$dir_arg"; then + do_exit='(exit $ret); exit $ret' + trap "ret=129; $do_exit" 1 + trap "ret=130; $do_exit" 2 + trap "ret=141; $do_exit" 13 + trap "ret=143; $do_exit" 15 + + # Set umask so as not to create temps with too-generous modes. + # However, 'strip' requires both read and write access to temps. + case $mode in + # Optimize common cases. + *644) cp_umask=133;; + *755) cp_umask=22;; + + *[0-7]) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw='% 200' + fi + cp_umask=`expr '(' 777 - $mode % 1000 ')' $u_plus_rw`;; + *) + if test -z "$stripcmd"; then + u_plus_rw= + else + u_plus_rw=,u+rw + fi + cp_umask=$mode$u_plus_rw;; + esac +fi + +for src +do + # Protect names problematic for 'test' and other utilities. + case $src in + -* | [=\(\)!]) src=./$src;; + esac + + if test -n "$dir_arg"; then + dst=$src + dstdir=$dst + test -d "$dstdir" + dstdir_status=$? + else + + # Waiting for this to be detected by the "$cpprog $src $dsttmp" command + # might cause directories to be created, which would be especially bad + # if $src (and thus $dsttmp) contains '*'. + if test ! -f "$src" && test ! -d "$src"; then + echo "$0: $src does not exist." >&2 + exit 1 + fi + + if test -z "$dst_arg"; then + echo "$0: no destination specified." >&2 + exit 1 + fi + dst=$dst_arg + + # If destination is a directory, append the input filename; won't work + # if double slashes aren't ignored. + if test -d "$dst"; then + if test -n "$no_target_directory"; then + echo "$0: $dst_arg: Is a directory" >&2 + exit 1 + fi + dstdir=$dst + dst=$dstdir/`basename "$src"` + dstdir_status=0 + else + # Prefer dirname, but fall back on a substitute if dirname fails. + dstdir=` + (dirname "$dst") 2>/dev/null || + expr X"$dst" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ + X"$dst" : 'X\(//\)[^/]' \| \ + X"$dst" : 'X\(//\)$' \| \ + X"$dst" : 'X\(/\)' \| . 2>/dev/null || + echo X"$dst" | + sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ + s//\1/ + q + } + /^X\(\/\/\)[^/].*/{ + s//\1/ + q + } + /^X\(\/\/\)$/{ + s//\1/ + q + } + /^X\(\/\).*/{ + s//\1/ + q + } + s/.*/./; q' + ` + + test -d "$dstdir" + dstdir_status=$? + fi + fi + + obsolete_mkdir_used=false + + if test $dstdir_status != 0; then + case $posix_mkdir in + '') + # Create intermediate dirs using mode 755 as modified by the umask. + # This is like FreeBSD 'install' as of 1997-10-28. + umask=`umask` + case $stripcmd.$umask in + # Optimize common cases. + *[2367][2367]) mkdir_umask=$umask;; + .*0[02][02] | .[02][02] | .[02]) mkdir_umask=22;; + + *[0-7]) + mkdir_umask=`expr $umask + 22 \ + - $umask % 100 % 40 + $umask % 20 \ + - $umask % 10 % 4 + $umask % 2 + `;; + *) mkdir_umask=$umask,go-w;; + esac + + # With -d, create the new directory with the user-specified mode. + # Otherwise, rely on $mkdir_umask. + if test -n "$dir_arg"; then + mkdir_mode=-m$mode + else + mkdir_mode= + fi + + posix_mkdir=false + case $umask in + *[123567][0-7][0-7]) + # POSIX mkdir -p sets u+wx bits regardless of umask, which + # is incompatible with FreeBSD 'install' when (umask & 300) != 0. + ;; + *) + tmpdir=${TMPDIR-/tmp}/ins$RANDOM-$$ + trap 'ret=$?; rmdir "$tmpdir/d" "$tmpdir" 2>/dev/null; exit $ret' 0 + + if (umask $mkdir_umask && + exec $mkdirprog $mkdir_mode -p -- "$tmpdir/d") >/dev/null 2>&1 + then + if test -z "$dir_arg" || { + # Check for POSIX incompatibilities with -m. + # HP-UX 11.23 and IRIX 6.5 mkdir -m -p sets group- or + # other-writable bit of parent directory when it shouldn't. + # FreeBSD 6.1 mkdir -m -p sets mode of existing directory. + ls_ld_tmpdir=`ls -ld "$tmpdir"` + case $ls_ld_tmpdir in + d????-?r-*) different_mode=700;; + d????-?--*) different_mode=755;; + *) false;; + esac && + $mkdirprog -m$different_mode -p -- "$tmpdir" && { + ls_ld_tmpdir_1=`ls -ld "$tmpdir"` + test "$ls_ld_tmpdir" = "$ls_ld_tmpdir_1" + } + } + then posix_mkdir=: + fi + rmdir "$tmpdir/d" "$tmpdir" + else + # Remove any dirs left behind by ancient mkdir implementations. + rmdir ./$mkdir_mode ./-p ./-- 2>/dev/null + fi + trap '' 0;; + esac;; + esac + + if + $posix_mkdir && ( + umask $mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir" + ) + then : + else + + # The umask is ridiculous, or mkdir does not conform to POSIX, + # or it failed possibly due to a race condition. Create the + # directory the slow way, step by step, checking for races as we go. + + case $dstdir in + /*) prefix='/';; + [-=\(\)!]*) prefix='./';; + *) prefix='';; + esac + + eval "$initialize_posix_glob" + + oIFS=$IFS + IFS=/ + $posix_glob set -f + set fnord $dstdir + shift + $posix_glob set +f + IFS=$oIFS + + prefixes= + + for d + do + test X"$d" = X && continue + + prefix=$prefix$d + if test -d "$prefix"; then + prefixes= + else + if $posix_mkdir; then + (umask=$mkdir_umask && + $doit_exec $mkdirprog $mkdir_mode -p -- "$dstdir") && break + # Don't fail if two instances are running concurrently. + test -d "$prefix" || exit 1 + else + case $prefix in + *\'*) qprefix=`echo "$prefix" | sed "s/'/'\\\\\\\\''/g"`;; + *) qprefix=$prefix;; + esac + prefixes="$prefixes '$qprefix'" + fi + fi + prefix=$prefix/ + done + + if test -n "$prefixes"; then + # Don't fail if two instances are running concurrently. + (umask $mkdir_umask && + eval "\$doit_exec \$mkdirprog $prefixes") || + test -d "$dstdir" || exit 1 + obsolete_mkdir_used=true + fi + fi + fi + + if test -n "$dir_arg"; then + { test -z "$chowncmd" || $doit $chowncmd "$dst"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dst"; } && + { test "$obsolete_mkdir_used$chowncmd$chgrpcmd" = false || + test -z "$chmodcmd" || $doit $chmodcmd $mode "$dst"; } || exit 1 + else + + # Make a couple of temp file names in the proper directory. + dsttmp=$dstdir/_inst.$$_ + rmtmp=$dstdir/_rm.$$_ + + # Trap to clean up those temp files at exit. + trap 'ret=$?; rm -f "$dsttmp" "$rmtmp" && exit $ret' 0 + + # Copy the file name to the temp name. + (umask $cp_umask && $doit_exec $cpprog "$src" "$dsttmp") && + + # and set any options; do chmod last to preserve setuid bits. + # + # If any of these fail, we abort the whole thing. If we want to + # ignore errors from any of these, just make sure not to ignore + # errors from the above "$doit $cpprog $src $dsttmp" command. + # + { test -z "$chowncmd" || $doit $chowncmd "$dsttmp"; } && + { test -z "$chgrpcmd" || $doit $chgrpcmd "$dsttmp"; } && + { test -z "$stripcmd" || $doit $stripcmd "$dsttmp"; } && + { test -z "$chmodcmd" || $doit $chmodcmd $mode "$dsttmp"; } && + + # If -C, don't bother to copy if it wouldn't change the file. + if $copy_on_change && + old=`LC_ALL=C ls -dlL "$dst" 2>/dev/null` && + new=`LC_ALL=C ls -dlL "$dsttmp" 2>/dev/null` && + + eval "$initialize_posix_glob" && + $posix_glob set -f && + set X $old && old=:$2:$4:$5:$6 && + set X $new && new=:$2:$4:$5:$6 && + $posix_glob set +f && + + test "$old" = "$new" && + $cmpprog "$dst" "$dsttmp" >/dev/null 2>&1 + then + rm -f "$dsttmp" + else + # Rename the file to the real destination. + $doit $mvcmd -f "$dsttmp" "$dst" 2>/dev/null || + + # The rename failed, perhaps because mv can't rename something else + # to itself, or perhaps because mv is so ancient that it does not + # support -f. + { + # Now remove or move aside any old file at destination location. + # We try this two ways since rm can't unlink itself on some + # systems and the destination file might be busy for other + # reasons. In this case, the final cleanup might fail but the new + # file should still install successfully. + { + test ! -f "$dst" || + $doit $rmcmd -f "$dst" 2>/dev/null || + { $doit $mvcmd -f "$dst" "$rmtmp" 2>/dev/null && + { $doit $rmcmd -f "$rmtmp" 2>/dev/null; :; } + } || + { echo "$0: cannot unlink or rename $dst" >&2 + (exit 1); exit 1 + } + } && + + # Now rename the file to the real destination. + $doit $mvcmd "$dsttmp" "$dst" + } + fi || exit 1 + + trap '' 0 + fi +done + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff --git a/life-support/FEPComm.h b/life-support/FEPComm.h new file mode 100644 index 0000000..c12f229 --- /dev/null +++ b/life-support/FEPComm.h @@ -0,0 +1,164 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* The FEP Communications area -- See SYS:I-SYS;SYSDF1 for details */ + +#ifndef _FEPCOM_ +#define _FEPCOM_ + +#include +#include "life_types.h" + +#define FEPCommAreaAddress 0xF8041000L +#define FEPCommAreaSize 256 + +/* Returns the address of a slot in the FEPComm area */ +#define FEPCommSlotAddress(slot) \ + ((ptrdiff_t)FEPCommAreaAddress + offsetof(FEPCommArea,slot)/sizeof(EmbWord)) + +/* Reads a slot of the FEPComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define ReadFEPCommSlot(slot,object) \ + VirtualMemoryRead (FEPCommSlotAddress (slot), &object) +#else +#define ReadFEPCommSlot(slot) \ + VirtualMemoryRead (FEPCommSlotAddress (slot)) +#endif + +/* Writes a slot of the FEPComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define WriteFEPCommSlot(slot,datum,tag) \ + { \ + LispObj lispDatum; \ + lispDatum.DATA.u = (Integer)datum; \ + lispDatum.TAG = (Tag)tag; \ + VirtualMemoryWrite (FEPCommSlotAddress (slot), &lispDatum); \ + } +#else +#define WriteFEPCommSlot(slot,datum,tag) \ + VirtualMemoryWrite (FEPCommSlotAddress (slot), MakeLispObj ((Tag)tag, (Integer)datum)) +#endif + + +#ifndef MINIMA + +/* Genera version of FEP Communications area */ + +typedef struct + { + EmbWord fepVersionNumber; + EmbWord systemType; + EmbWord fepStartup; + EmbWord spyCommand; /* Obsolete */ + EmbWord spyStatus; /* Obsolete */ + EmbWord spyPC; /* Obsolete */ + EmbWord loadMapSize; + EmbWord loadMapVMAAddress; + EmbWord loadMapOpcodeAddress; + EmbWord loadMapOperandAddress; + EmbWord swapMapSize; + EmbWord swapMapAddress; + EmbWord swapMapDPNAddress; + EmbWord mainMemoryMapSize; + EmbWord mainMemoryMapAddress; + EmbWord badMemoryPagesSize; + EmbWord badMemoryPagesAddress; + EmbWord fepPhysicalAddressHigh; + EmbWord unwiredVirtualAddressLow; + EmbWord unwiredVirtualAddressHigh; + EmbWord unwiredPhysicalAddressLow; + EmbWord unwiredPhysicalAddressHigh; + EmbWord requestingLispToStop; + EmbWord currentFEPOverlays; + EmbWord embCommunicationArea; + EmbWord loadedBandName; + EmbWord netbootControlString; + EmbWord softwareConfiguration; + EmbWord netAddress1; + EmbWord netAddress2; + EmbWord primaryNetworkAddress; + EmbWord fepCommandString; + EmbWord fepCrashDataRequest; + EmbWord coldLoadStreamReadCharacter; + EmbWord coldLoadStreamListen; + EmbWord coldLoadStreamReadHardwareCharacter; + EmbWord coldLoadStreamDrawCharacter; + EmbWord coldLoadStreamDisplayLozengedString; + EmbWord coldLoadStreamSelect; + EmbWord coldLoadStreamBeep; + EmbWord coldLoadStreamFinish; + EmbWord coldLoadStreamInsideSize; + EmbWord coldLoadStreamSetCursorpos; + EmbWord coldLoadStreamReadCursorpos; + EmbWord coldLoadStreamComputeMotion; + EmbWord coldLoadStreamClearBetweenCursorposes; + EmbWord coldLoadStreamSetEdges; + EmbWord mainScreenParameters; + EmbWord wiredFormat; + EmbWord fepSequenceBreak; /* Obsolete */ + EmbWord lispStoppedCleanly; + EmbWord loadPagesToSwapAreaP; + EmbWord remoteDebugLoop; + EmbWord timezoneOffsetMinutes; + EmbWord timezoneName; + EmbWord namespaceDescriptorFile; + EmbWord siteName; + EmbWord savedLispRegisters; + EmbWord lispStateSaved; + EmbWord enableFPAp; + EmbWord diskUnitTable; + EmbWord hardwareConfiguration; + EmbWord slaveBufferBaseAddress; + EmbWord kernelCompressedStringArray; + EmbWord domino8032State; + } FEPCommArea; + +#else + +/* Minima version of FEP Communications Area */ + +typedef struct + { + EmbWord fepVersionNumber; + EmbWord systemType; + EmbWord fepStartup; + EmbWord embCommunicationArea; + EmbWord memorySegmentFreeList; + EmbWord unallocatedPhysicalMemory; + EmbWord phtSize; + EmbWord phtCollisionCountsBase; + EmbWord phtCollisionCount; + EmbWord phtRehashes; + EmbWord unmappedMemoryBase; + EmbWord allocatePhyiscalMemoryAtAddress; + EmbWord allocatePhysicalMemory; + EmbWord deallocatePhysicalMemory; + EmbWord romPHTLookup; + EmbWord romPHTPut; + EmbWord romPHTRemove; + EmbWord romPHTRehash; + EmbWord romError; + EmbWord clearMapCache; + EmbWord localIPAddress0; + EmbWord diagnosticIPAddress; + EmbWord romMBINGetReceiveBuffer; + EmbWord romMBINReturnReceiveBuffer; + EmbWord romMBINGetTransmitBuffer; + EmbWord romMBINSendTransmitBuffer; + EmbWord initializeInteractor; + EmbWord localIPAddress1; + EmbWord localIPSubnetMask0; + EmbWord localIPSubnetMask1; + EmbWord gatewayIPAddress0; + EmbWord gatewayIPAddress1; + EmbWord loadServerIPAddress; + EmbWord hardwareECORegisters; + EmbWord ethernetDriver0; + EmbWord ethernetDriver1; + EmbWord romUpdateRendezvousParameters; + } FEPCommArea; + +#endif + +extern FEPCommArea* FEPCommAreaPtr; + +#endif diff --git a/life-support/Makefile b/life-support/Makefile new file mode 100644 index 0000000..32475e4 --- /dev/null +++ b/life-support/Makefile @@ -0,0 +1,552 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# life-support/Makefile. Generated from Makefile.in by configure. + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + + + + +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/vlm +pkgincludedir = $(includedir)/vlm +pkglibdir = $(libdir)/vlm +pkglibexecdir = $(libexecdir)/vlm +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = x86_64-suse-linux-gnu +host_triplet = x86_64-suse-linux-gnu +subdir = life-support +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +AR = ar +ARFLAGS = cru +AM_V_AR = $(am__v_AR_$(V)) +am__v_AR_ = $(am__v_AR_$(AM_DEFAULT_VERBOSITY)) +am__v_AR_0 = @echo " AR " $@; +am__v_AR_1 = +libls_a_AR = $(AR) $(ARFLAGS) +libls_a_LIBADD = +am_libls_a_OBJECTS = cold_load.$(OBJEXT) console.$(OBJEXT) \ + disks.$(OBJEXT) initialization.$(OBJEXT) network.$(OBJEXT) \ + message_channels.$(OBJEXT) polling.$(OBJEXT) queues.$(OBJEXT) \ + signals.$(OBJEXT) unixcrypt.$(OBJEXT) +libls_a_OBJECTS = $(am_libls_a_OBJECTS) +AM_V_P = $(am__v_P_$(V)) +am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY)) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_$(V)) +am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY)) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_$(V)) +am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY)) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I. -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_$(V)) +am__v_CC_ = $(am__v_CC_$(AM_DEFAULT_VERBOSITY)) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_$(V)) +am__v_CCLD_ = $(am__v_CCLD_$(AM_DEFAULT_VERBOSITY)) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libls_a_SOURCES) +DIST_SOURCES = $(libls_a_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = ${SHELL} /home/lispm/snap5/jj-vlm/missing aclocal-1.13 +AMTAR = $${TAR-tar} +AM_DEFAULT_VERBOSITY = 0 +AUTOCONF = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoconf +AUTOHEADER = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoheader +AUTOMAKE = ${SHELL} /home/lispm/snap5/jj-vlm/missing automake-1.13 +AWK = gawk +CC = gcc -std=gnu99 +CCDEPMODE = depmode=gcc3 +CFLAGS = -g -O2 -g0 -Ofast -rdynamic -fno-strict-aliasing -march=native -Wall +CLISP = /usr/bin/clisp +CPP = gcc -std=gnu99 -E +CPPFLAGS = -DGENERA -DAUTOSTART -DUSE_TAP +CYGPATH_W = echo +DEFS = -DHAVE_CONFIG_H +DEPDIR = .deps +ECHO_C = +ECHO_N = -n +ECHO_T = +EGREP = /usr/bin/grep -E +EXEEXT = +GREP = /usr/bin/grep +INSTALL = /usr/bin/install -c +INSTALL_DATA = ${INSTALL} -m 644 +INSTALL_PROGRAM = ${INSTALL} +INSTALL_SCRIPT = ${INSTALL} +INSTALL_STRIP_PROGRAM = $(install_sh) -c -s +LDFLAGS = +LIBOBJS = +LIBS = -lpthread -lm -ldl -lcrypt -lc -lX11 +LTLIBOBJS = +MAKEINFO = ${SHELL} /home/lispm/snap5/jj-vlm/missing makeinfo +MKDIR_P = /usr/bin/mkdir -p +OBJEXT = o +PACKAGE = vlm +PACKAGE_BUGREPORT = joachimq@achemich.de +PACKAGE_NAME = vlm +PACKAGE_STRING = vlm 0.99-1 +PACKAGE_TARNAME = vlm +PACKAGE_URL = +PACKAGE_VERSION = 0.99-1 +PATH_SEPARATOR = : +PTHREAD_CC = gcc -std=gnu99 +PTHREAD_CFLAGS = -pthread +PTHREAD_LIBS = +RANLIB = ranlib +SET_MAKE = +SHELL = /bin/sh +STRIP = +VERSION = 0.99-1 +XMKMF = +abs_builddir = /home/lispm/snap5/jj-vlm/life-support +abs_srcdir = /home/lispm/snap5/jj-vlm/life-support +abs_top_builddir = /home/lispm/snap5/jj-vlm +abs_top_srcdir = /home/lispm/snap5/jj-vlm +ac_ct_CC = gcc +acx_pthread_config = +am__include = include +am__leading_dot = . +am__quote = +am__tar = $${TAR-tar} chof - "$$tardir" +am__untar = $${TAR-tar} xf - +bindir = ${exec_prefix}/bin +build = x86_64-suse-linux-gnu +build_alias = +build_cpu = x86_64 +build_os = linux-gnu +build_vendor = suse +builddir = . +datadir = ${datarootdir} +datarootdir = ${prefix}/share +docdir = ${datarootdir}/doc/${PACKAGE_TARNAME} +dvidir = ${docdir} +exec_prefix = ${prefix} +host = x86_64-suse-linux-gnu +host_alias = +host_cpu = x86_64 +host_os = linux-gnu +host_vendor = suse +htmldir = ${docdir} +includedir = ${prefix}/include +infodir = ${datarootdir}/info +install_sh = ${SHELL} /home/lispm/snap5/jj-vlm/install-sh +libdir = ${exec_prefix}/lib64 +libexecdir = ${exec_prefix}/lib +localedir = ${datarootdir}/locale +localstatedir = ${prefix}/var +mandir = ${datarootdir}/man +mkdir_p = $(MKDIR_P) +oldincludedir = /usr/include +pdfdir = ${docdir} +prefix = /usr/local +program_transform_name = s,x,x, +psdir = ${docdir} +sbindir = ${exec_prefix}/sbin +sharedstatedir = ${prefix}/com +srcdir = . +sysconfdir = ${prefix}/etc +target_alias = +top_build_prefix = ../ +top_builddir = .. +top_srcdir = .. + +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I/home/lispm/snap5/jj-vlm/include -I/home/lispm/snap5/jj-vlm/life-support -I/home/lispm/snap5/jj-vlm/emulator -I/home/lispm/snap5/jj-vlm/x86_64-emulator +noinst_LIBRARIES = libls.a +libls_a_SOURCES = cold_load.c console.c disks.c initialization.c network.c message_channels.c polling.c queues.c signals.c unixcrypt.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu life-support/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu life-support/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) + +libls.a: $(libls_a_OBJECTS) $(libls_a_DEPENDENCIES) $(EXTRA_libls_a_DEPENDENCIES) + $(AM_V_at)-rm -f libls.a + $(AM_V_AR)$(libls_a_AR) libls.a $(libls_a_OBJECTS) $(libls_a_LIBADD) + $(AM_V_at)$(RANLIB) libls.a + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +include ./$(DEPDIR)/cold_load.Po +include ./$(DEPDIR)/console.Po +include ./$(DEPDIR)/disks.Po +include ./$(DEPDIR)/initialization.Po +include ./$(DEPDIR)/message_channels.Po +include ./$(DEPDIR)/network.Po +include ./$(DEPDIR)/polling.Po +include ./$(DEPDIR)/queues.Po +include ./$(DEPDIR)/signals.Po +include ./$(DEPDIR)/unixcrypt.Po + +.c.o: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c $< + +.c.obj: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-local clean-noinstLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ + clean-local clean-noinstLIBRARIES cscopelist-am ctags ctags-am \ + distclean distclean-compile distclean-generic distclean-tags \ + distdir dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am + + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/life-support/Makefile.am b/life-support/Makefile.am new file mode 100644 index 0000000..7f5e409 --- /dev/null +++ b/life-support/Makefile.am @@ -0,0 +1,11 @@ +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS=-I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator + +noinst_LIBRARIES = libls.a + +libls_a_SOURCES = cold_load.c console.c disks.c initialization.c network.c message_channels.c polling.c queues.c signals.c unixcrypt.c + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ diff --git a/life-support/Makefile.in b/life-support/Makefile.in new file mode 100644 index 0000000..2629436 --- /dev/null +++ b/life-support/Makefile.in @@ -0,0 +1,552 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = life-support +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +AR = ar +ARFLAGS = cru +AM_V_AR = $(am__v_AR_@AM_V@) +am__v_AR_ = $(am__v_AR_@AM_DEFAULT_V@) +am__v_AR_0 = @echo " AR " $@; +am__v_AR_1 = +libls_a_AR = $(AR) $(ARFLAGS) +libls_a_LIBADD = +am_libls_a_OBJECTS = cold_load.$(OBJEXT) console.$(OBJEXT) \ + disks.$(OBJEXT) initialization.$(OBJEXT) network.$(OBJEXT) \ + message_channels.$(OBJEXT) polling.$(OBJEXT) queues.$(OBJEXT) \ + signals.$(OBJEXT) unixcrypt.$(OBJEXT) +libls_a_OBJECTS = $(am_libls_a_OBJECTS) +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libls_a_SOURCES) +DIST_SOURCES = $(libls_a_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CLISP = @CLISP@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +OBJEXT = @OBJEXT@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +RANLIB = @RANLIB@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +XMKMF = @XMKMF@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +acx_pthread_config = @acx_pthread_config@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ + +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator +noinst_LIBRARIES = libls.a +libls_a_SOURCES = cold_load.c console.c disks.c initialization.c network.c message_channels.c polling.c queues.c signals.c unixcrypt.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu life-support/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu life-support/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) + +libls.a: $(libls_a_OBJECTS) $(libls_a_DEPENDENCIES) $(EXTRA_libls_a_DEPENDENCIES) + $(AM_V_at)-rm -f libls.a + $(AM_V_AR)$(libls_a_AR) libls.a $(libls_a_OBJECTS) $(libls_a_LIBADD) + $(AM_V_at)$(RANLIB) libls.a + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/cold_load.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/console.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/disks.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/initialization.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/message_channels.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/network.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/polling.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/queues.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/signals.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/unixcrypt.Po@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-local clean-noinstLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ + clean-local clean-noinstLIBRARIES cscopelist-am ctags ctags-am \ + distclean distclean-compile distclean-generic distclean-tags \ + distdir dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am + + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/life-support/SystemComm.h b/life-support/SystemComm.h new file mode 100644 index 0000000..2e10f0b --- /dev/null +++ b/life-support/SystemComm.h @@ -0,0 +1,127 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* The System Communications area -- See SYS:I-SYS;SYSDF1 for details */ + +#ifndef _SYSTEMCOM_ +#define _SYSTEMCOM_ + +#include +#include "life_types.h" + +#define SystemCommAreaAddress 0xF8041100L +#define SystemCommAreaSize 256 + +/* Returns the address of a slot in the SystemComm area */ +#define SystemCommSlotAddress(slot) \ + ((ptrdiff_t)SystemCommAreaAddress + offsetof(SystemCommArea,slot)/sizeof(EmbWord)) + +/* Reads a slot of the SystemComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define ReadSystemCommSlot(slot,object) \ + VirtualMemoryRead (SystemCommSlotAddress (slot), &object) +#else +#define ReadSystemCommSlot(slot) \ + VirtualMemoryRead (SystemCommSlotAddress (slot)) +#endif + +/* Writes a slot of the SystemComm area using the emulator's VM implementation */ +#ifdef _C_EMULATOR_ +#define WriteSystemCommSlot(slot,datum,tag) \ + { \ + LispObj lispDatum; \ + lispDatum.DATA.u = (Integer)datum; \ + lispDatum.TAG = (Tag)tag; \ + VirtualMemoryWrite (SystemCommSlotAddress (slot), &lispDatum); \ + } +#else +#define WriteSystemCommSlot(slot,datum,tag) \ + VirtualMemoryWrite (SystemCommSlotAddress (slot), MakeLispObj ((Tag)tag, (Integer)datum)) +#endif + + +#ifndef MINIMA + +/* Genera version of System Communications area */ + +typedef struct + { + EmbWord syscomMajorVersionNumber; + EmbWord syscomMinorVersionNumber; + EmbWord systemStartup; + EmbWord addressSpaceMapAddress; + EmbWord oblastFreeSize; + EmbWord areaName; + EmbWord areaMaximumQuantumSize; + EmbWord areaRegionQuantumSize; + EmbWord areaRegionList; + EmbWord areaRegionBits; + EmbWord regionQuantumOrigin; + EmbWord regionQuantumLength; + EmbWord regionFreePointer; + EmbWord regionGCPointer; + EmbWord regionBits; + EmbWord regionListThread; + EmbWord regionArea; + EmbWord regionCreatedPages; + EmbWord regionFreePointerBeforeFlip; + EmbWord regionConsAlarm; + EmbWord pageConsAlarm; + EmbWord structureCacheRegion; + EmbWord listCacheRegion; + EmbWord defaultConsArea; + EmbWord pht; + EmbWord mmptY; + EmbWord mmpt; + EmbWord smpt; + EmbWord loadBitmaps; + EmbWord loadMap; /* Red herring */ + EmbWord loadMapDPN; /* Red herring */ + EmbWord swapMap; /* Red herring */ + EmbWord swapMapDPN; /* Red herring */ + EmbWord sysoutBitmaps; + EmbWord phtCollisionCounts; + EmbWord mmpt1; + EmbWord storageColdBoot; + EmbWord flushableQueueHead; + EmbWord flushableQueueTail; + EmbWord flushableQueueModified; + EmbWord wiredPhysicalAddressHigh; + EmbWord wiredVirtualAddressHigh; + EmbWord enableSysoutAtColdBoot; + EmbWord sysoutGenerationNumber; + EmbWord sysoutTimestamp1; + EmbWord sysoutTimestamp2; + EmbWord sysoutParentTimestamp1; + EmbWord sysoutParentTimestamp2; + EmbWord initialStackGroup; + EmbWord currentStackGroup; + EmbWord stackGroupLock; + EmbWord currentStackGroupStatusBits; + EmbWord inhibitSchedulingFlag; + EmbWord controlStackLow; + EmbWord bindingStackLow; + EmbWord floatOperatingMode; + EmbWord floatOperationStatus; + EmbWord packageNameTable; + EmbWord lispReleaseString; + EmbWord busMode; + } SystemCommArea; + +#else + +/* Minima version of System Communications Area */ + +typedef struct + { + EmbWord systemStartup; + EmbWord allAreas; + EmbWord allPackages; + EmbWord saveWorldHeader; + EmbWord kernelUseROMEthernet; + } SystemCommArea; + +#endif + +extern SystemCommArea* SystemCommAreaPtr; + +#endif diff --git a/life-support/chaos.h b/life-support/chaos.h new file mode 100644 index 0000000..39ea387 --- /dev/null +++ b/life-support/chaos.h @@ -0,0 +1,133 @@ +#ifndef __chaos_h__ +#define __chaos_h__ +// +#include +#include +#include +#include +#include +#include +// +// globals +// +#define ETH_P_CHAOS 0x0804 +#define ETH_P_ARP 0x0806 +#define MIN_CHAOS_PACKET_SIZE 34 +#define MIN_ARP_CHAOS_PACKET_SIZE 38 +#define MAX_CHAOS_DATA_BYTES 488 +#define MAX_CHAOS_DATA_SHORTS 244 +#define MAX_CHAOS_DATA_WORDS 122 +#define CHAOS_MIN_HOST_NUM 1 +#define CHAOS_MAX_HOST_NUM 255 +#define CHAOS_MIN_SUBNET_NUM CHAOS_MIN_HOST_NUM +#define CHAOS_MAX_SUBNET_NUM CHAOS_MAX_HOST_NUM +// +// CHAOS opcodes +// +#define CHAOS_OP_RFC 0x01 +#define CHAOS_OP_OPN 0x02 +#define CHAOS_OP_CLS 0x03 +#define CHAOS_OP_FWD 0x04 +#define CHAOS_OP_ANS 0x05 +#define CHAOS_OP_SNS 0x06 +#define CHAOS_OP_STS 0x07 +#define CHAOS_OP_RUT 0x08 +#define CHAOS_OP_LOS 0x09 +#define CHAOS_OP_LSN 0x0A +#define CHAOS_OP_MNT 0x0B +#define CHAOS_OP_EOF 0x0C +#define CHAOS_OP_UNC 0x0D +#define CHAOS_OP_BRD 0x0E +#define CHAOS_OP_DAT 0x80 +// +// CHAOS packet struct +// +typedef uint8_t mac_address[ETH_ALEN] ; +typedef uint8_t *mac_address_p ; + +#pragma pack(push,1) + +struct eth_header { + mac_address eth_dst ; + mac_address eth_src ; + uint16_t eth_prot ; +} ; + +struct arp_chaos_packet { + struct eth_header eth ; // 14 bytes + struct arphdr arp ; // 8 bytes + mac_address src_mac ; // 6 bytes + uint16_t src_chaos ; // 2 bytes + mac_address dst_mac ; // 6 bytes + uint16_t dst_chaos ; // 2 bytes + // ttl. 38 bytes + uint8_t padding[26]; // pad to 64 byte length +} ; + +struct arp_ip_packet { + struct eth_header eth ; // 14 bytes + struct arphdr arp ; // 8 bytes + mac_address src_mac ; // 6 bytes + struct in_addr src_ip ; // 4 bytes + mac_address dst_mac ; // 6 bytes + struct in_addr dst_ip ; // 4 bytes + // ttl. 42 bytes + uint8_t padding[22]; // pad to 64 byte length +} ; + +struct chaos_header { +#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ + uint8_t prot ; + uint8_t opcode ; +#else + uint8_t opcode ; + uint8_t prot ; +#endif + union { unsigned short lfcwhole; + struct { + unsigned short nbytes:12; /* Length of packet */ + unsigned short fwd_count:4; /* Forwarding count */ + } ; + } ; +#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ + uint8_t dest_host ; + uint8_t dest_subnet ; +#else + uint8_t dest_subnet ; + uint8_t dest_host ; +#endif + uint16_t dest_index_num ; +#if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__ + uint8_t source_host ; + uint8_t source_subnet ; +#else + uint8_t source_subnet ; + uint8_t source_host ; +#endif + uint16_t source_index_num ; + uint16_t num ; + uint16_t ack_num ; +} ; + +struct chaos_packet { + struct chaos_header hd; + union { + uint8_t data8[MAX_CHAOS_DATA_BYTES] ; + uint16_t data16[MAX_CHAOS_DATA_SHORTS] ; + uint32_t data32[MAX_CHAOS_DATA_WORDS] ; + } ; +} ; + +struct eth_chaos_packet { + struct eth_header eth ; + struct chaos_packet chaos ; +} ; + +struct eth_ip_packet { + struct eth_header eth ; + struct ip ip ; +} ; + +#pragma pack(pop) + +#endif // __chaos_h__ diff --git a/life-support/cold_load.c b/life-support/cold_load.c new file mode 100644 index 0000000..fa19289 --- /dev/null +++ b/life-support/cold_load.c @@ -0,0 +1,2027 @@ +/* -*- Mode: C; -*- */ + +/* VLM's Cold Load Window implementation */ +// jj +#define _GNU_SOURCE +// jj +#include "config.h" +#include "std.h" + +#include +#include +#include +// jj +#include +#if HAVE_X11_XLIB_XCB_H +#include +#endif +#if HAVE_DLFCN_H +#include +#else +#error need dlfcn.h to compile +#endif +// jj + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "symbolics_characters.h" +#include "genera-icon-32.xbm" +#include "genera-cptfont.xbm" + +int manage_run_lights = 0; +int run_lights_state; + + +#include +#include +#include "cold_load_keymappings.h" + +#define RUN_LIGHT_Y_SPACE 3 /* Pixels to leave for run bars in cold-load window */ +#define RUN_LIGHT_Y_OFFSET (RUN_LIGHT_Y_SPACE-1) + +/* These are closely related to pixels_per_run_light as computed in alloc_screen_array, + but any values smaller than the below (as tend to be computed) look crappy. */ +#define RUN_LIGHT_WIDTH 32 +#define RUN_LIGHT_SPACING 40 + +#define DISK_RUN_LIGHT 2 +#define PROCESS_RUN_LIGHT 3 +#define NETWORK_RUN_LIGHT 5 +#define NETBOOT_PROGRESS_BAR 7 + +static EmbColdLoadChannel *cold_channel = NULL; +static EmbQueue *keyboard_queue = NULL, *display_queue = NULL; + +static Display *display = NULL; +static KeySym *orig_meta, *orig_hyper ; +static int ks_p_kc_meta, ks_p_kc_hyper ; +static Screen *screen; +static Visual *visual; +static Window window, icon_window, root; +static Colormap colormap; +static GC gc, icon_gc, icon_gc_s, icon_gc_c, icon_gc_t; +static Pixmap icon_bitmap = 0, cptfont_bitmap = 0; +static XModifierKeymap *originalModmap = NULL; +static int icon_width = 32, icon_height = 36; +static int char_width, char_height, width = 0, height = 0; +static int loff, toff, roff, boff; +static int lmarg = 3, tmarg = 22, rmarg = 3, bmarg = 3; +static int current_x = 0, current_y = 0; +static int cursor_visible = 0, cursor_frozen = 0, cursor_state = 0, light_state = 0; +static int visibility = 0, icon_visibility = 0; +static int run_light_y, run_light_first_x, run_label_y; +static int progress_bar_first_x, progress_bar_width, run_label_width, run_label_height; +static int progress_bar_numerator_state = 0, progress_bar_denominator_state = 0; +static int progress_bar_length_state = 0, progress_label_length; +static char *progress_label = NULL; +static int meta_mask = 0, super_mask = 0, hyper_mask = 0, isol3_mask = 0, isol3_code = 0; +/* static jmp_buf x_io_error; */ +static int did_show = 0; + +typedef struct { + int length; + char *chars; +} line; + +static line *screen_array = NULL; +static enum KeyboardType keyboardType = Unknown; +static coldmapentry *skMap = NULL; +static short *fkMap = NULL; +static int removeNumLockModifier = 0; +// jj +enum xcbvals { XcbUnknown, XcbLoaded, XcbNotLoaded } haveXcb = XcbUnknown; + +/* Internal function prototypes -- Here to avoid including X headers everywhere */ + +static void alloc_screen_array (int new_width_pixels, int new_height_pixels); +static void ColdLoadInput (pthread_addr_t argument); +static void ColdLoadOutput (void* ignored); +/* static int ColdXErrorHandler (Display *display, XErrorEvent *error); */ +static void close_display (void); +/* static void close_display_child_hook (void); */ +/* static void close_run_lights_display (void); */ +static int do_modifier (XModifierKeymap **modmapp, int *changedp, + KeyCode code1, KeyCode code2, KeyCode code3); +static int find_modifier (XModifierKeymap *modmap, KeyCode code); +static int find_unused_modifier (XModifierKeymap **modmapp); +static void get_keyboard_modifier_codes (int for_real_p, + KeyCode *control_l_code, KeyCode *control_r_code, + KeyCode *meta_l_code, KeyCode *meta_r_code, + KeyCode *alt_l_code, KeyCode *super_code, + KeyCode *hyper_code); +static void handle_input (void); +/* static void handle_output (void); */ +static void handle_output_command (uEmbWord command); +static void hide_cursor (void); +/* static int initialize_cold (XParams *cl_params, boolean noWaiting); */ +static void manage_cold_load_output (void); +static int manage_x_input (XParams *params); +static int mask_to_modifier (int mask); +static int open_cold_load_display (XParams *params, boolean noWaiting); +/* static void open_run_lights_display (XParams *params, Window window_id, int nlights, */ +/* unsigned int width, unsigned int height, */ +/* unsigned int x, unsigned int y, */ +/* unsigned int dx, unsigned int dy, */ +/* unsigned int foreground, unsigned int background, */ +/* unsigned int plane_mask); */ +static int open_display (XParams *params, boolean noWaiting); +static void redisplay_line (int y, int x, int xlim); +static void redisplay_screen_array (int minx, int miny, int maxx, int maxy); +static void replay_command_history (void); +static void reset_light_state (int screen_cleared_p); +static void SetColdLoadNames (void); +/* static void SetColdXErrorHandler (void); */ +static void SetupColdLoadNameStrings (VLMConfig* config); +static int setup_modifier_mapping (void); +static int setup_x_io_error_handler (void); +static void show_cursor_internal (int new_state); +static void show_icon (void); +static void show_lights (int force); +static void stop_cold_x (void); +/* static void update_cold_load_blinkers (void); */ +/* static void update_cold_load_run_lights (void); */ +static void make_map (int for_real_p); + +#define show_cursor() show_cursor_internal (EmbCommAreaPtr->fep.cursor) + + +static XModifierKeymap *remove_modifier ( Display *display, KeySym keysym, XModifierKeymap *map ) { + XModifierKeymap *newmap ; + int code = XKeysymToKeycode (display, keysym ); + int i,k=0, found=0, mpm = map->max_keypermod ; + for (i=0;i<8;i++) { + for(k=0;kmodifiermap[i*mpm+k] == code) { found = 1; break; } + if (found) break ; + } + if (found) { + newmap = XDeleteModifiermapEntry ( map, code, i ); + if (XSetModifierMapping ( display, newmap ) != MappingSuccess) + vwarn ("cold load","Unable to install X modifier keymap"); + return newmap ; + } + return NULL ; +} + +static void make_map (int for_real_p) +{ + KeySym meta_keysym[] = { XK_Meta_L, XK_Alt_L }; + KeySym hyper_keysym[] = { XK_Hyper_R, XK_Menu } ; + XModifierKeymap *newmap=NULL; + KeyCode control_l_code, control_r_code, meta_l_code, meta_r_code, + alt_l_code, super_code, hyper_code; + + get_keyboard_modifier_codes(for_real_p, + &control_l_code, + &control_r_code, + &meta_l_code, + &meta_r_code, + &alt_l_code, + &super_code, + &hyper_code); + + // always put Meta on Alt (if we have an alt key) + if (XKeysymToKeycode(display,XK_Alt_L)) { + orig_meta = XGetKeyboardMapping ( display, + XKeysymToKeycode(display, + XK_Alt_L), + 1, + &ks_p_kc_meta ); + } + // if no Hyper key available, put it on Menu (if there is one) + if (XKeysymToKeycode(display,XK_Menu)) { + orig_hyper = XGetKeyboardMapping ( display, + XKeysymToKeycode(display, + XK_Menu), + 1, + &ks_p_kc_hyper ); + XChangeKeyboardMapping(display, + XKeysymToKeycode(display,XK_Menu), + sizeof(hyper_keysym)/sizeof(KeySym), + hyper_keysym, + 1); + if (for_real_p) vwarn("cold load", + "Your Hyper(_R) key now is on (right) Menu"); + } + // always put Meta on Alt + if (XKeysymToKeycode(display,XK_Alt_L)) { + XChangeKeyboardMapping(display, + XKeysymToKeycode(display,XK_Alt_L), + sizeof(meta_keysym)/sizeof(KeySym), + meta_keysym, + 1); + if (for_real_p) vwarn("cold load", + "Your Meta key now is on ALT"); + } + // remove non-functional Hyper_L key + newmap = remove_modifier ( display, XK_Hyper_L, + newmap ? + newmap : + XGetModifierMapping(display) ); + if (for_real_p) + vwarn("cold load", + "NumLock will not be functional in genera"); +} + +static int open_cold_load_display (XParams *params, boolean noWaiting) +{ + open_display(params, noWaiting); + if (display != NULL) { + replay_command_history(); + return(XConnectionNumber(display)); + } else + return(-1); +} + + +static int manage_x_input (XParams *params) +{ + while (display != NULL && XPending(display)) { + handle_input(); + } + return(display == NULL ? -1 : XConnectionNumber(display)); +} + + +static void manage_cold_load_output () +{ + uEmbWord command; + + begin_MUTEX_LOCKED (XLock); + hide_cursor(); + end_MUTEX_LOCKED (XLock); + +/* again: */ + while (EmbQueueFilled(display_queue)) { + command = (uEmbWord)EmbQueueTakeWord(display_queue); + cold_channel->command_history[cold_channel->command_history_top++] = command; + if (cold_channel->command_history_top == ColdLoadCommandHistorySize) { + cold_channel->command_history_top = 0; + cold_channel->command_history_wrapped = TRUE; + } + begin_MUTEX_LOCKED (XLock); + handle_output_command(command); + end_MUTEX_LOCKED (XLock); + } + /* pthread_yield(); */ + /* pthread_testcancel(); */ + /* goto again; */ + + begin_MUTEX_LOCKED (XLock); + show_cursor (); + end_MUTEX_LOCKED (XLock); + + return ; +} + +/* static void update_cold_load_blinkers () */ +/* { */ +/* show_cursor(); */ +/* XFlush(display); */ +/* } */ + +/* static void update_cold_load_run_lights () */ +/* { */ +/* show_lights(0); */ +/* XFlush(display); */ +/* } */ + +static int setup_x_io_error_handler () +{ + /* // return(_setjmp(x_io_error)); */ + return 0 ; +} + + +static void stop_cold_x () +{ + begin_MUTEX_LOCKED (XLock); + + // fprintf ( stderr, "stop_cold_x ... " ); + if (display) XFlush(display); + end_MUTEX_LOCKED (XLock); + // fprintf ( stderr, "closing dpy ... " ); + close_display(); + // fprintf ( stderr, "closed\n" ); + +} + +static char *in_addr_to_string(struct in_addr *addr) +{ + struct in_addr swap_addr; + swap_addr.s_addr = ntohl(addr->s_addr); + return inet_ntoa(swap_addr); +} + +int check_display(XParams *params, + NetworkInterface *nwi) +{ + char display_name[BUFSIZ]; + int i ; + + BuildXDisplayName(display_name, + params->xpHostName, + params->xpDisplay, + params->xpScreen); + + if (!(display = XOpenDisplay(display_name))) + { + if (errno == EAGAIN) { + vwarn("cold load init", + "unable to open display %d on %s", + params->xpDisplay, + params->xpHostName ? : "localhost"); + for (i=0;ixpHostName ? : "localhost"); + } else + vwarn("cold load init", + "Unable to open display %s - %m", + XDisplayName(display_name)); + return -1; + } + else XCloseDisplay(display); + return 0; +} + +int check_keyboard (XParams *params, + boolean noWaiting) +{ + char display_name[BUFSIZ]; + struct timespec openSleep; + + BuildXDisplayName(display_name, + params->xpHostName, + params->xpDisplay, + params->xpScreen); + + if (!(display = XOpenDisplay(display_name))) + { + if (noWaiting) return -1; + else { + verror ("cold load init", NULL); + vwarn ("cold load init", "Waiting for X server (%m)... "); + while (display == NULL) { + openSleep.tv_sec = 5; + openSleep.tv_nsec = 0; + if (pthread_delay_np(&openSleep)) + vpunt (NULL, + "Unable to sleep in thread %lx", + pthread_self()); + display = XOpenDisplay(display_name); + } + fprintf (stderr, "Done.\n"); + } + } + screen = XDefaultScreenOfDisplay(display); + visual = XDefaultVisualOfScreen(screen); + root = XRootWindowOfScreen(screen); + colormap = XDefaultColormapOfScreen(screen); + + originalModmap = XGetModifierMapping(display); + make_map(0); + if (setup_modifier_mapping() < 0) { + close_display (); + return -1 ; + } + close_display(); + return 0; + +} + +static int open_display (XParams *params, boolean noWaiting) +{ + XWMHints wmhints; + XSizeHints sizehints; + XColor color; + XSetWindowAttributes attributes; + XGCValues gcv; + XFontStruct *fontinfo; + char display_name[BUFSIZ]; + int screen_no, border_width, w_x, w_y, w_w, w_h, g_flags; + struct timespec openSleep; + + BuildXDisplayName(display_name, + params->xpHostName, + params->xpDisplay, + params->xpScreen); + + display=XOpenDisplay(display_name); + if (display == NULL) { + if (noWaiting) return -1; + else { + verror ("cold load init", NULL); + vwarn ("cold load init", "Waiting for X server... "); + while (display == NULL) { + openSleep.tv_sec = 5; + openSleep.tv_nsec = 0; + if (pthread_delay_np(&openSleep)) + vpunt (NULL, + "Unable to sleep in thread %lx", + pthread_self()); + display = XOpenDisplay(display_name); + } + fprintf (stderr, "Done.\n"); + } + } + screen_no = XDefaultScreen(display); + screen = XDefaultScreenOfDisplay(display); + visual = XDefaultVisualOfScreen(screen); + root = XRootWindowOfScreen(screen); + colormap = XDefaultColormapOfScreen(screen); + + originalModmap = XGetModifierMapping(display); + make_map (1); + setup_modifier_mapping(); + + fontinfo = XLoadQueryFont(display, "genera-cptfont"); + if (fontinfo) + { + gcv.font = fontinfo->fid; + XFreeFontInfo(NULL, fontinfo, 0); + } + else + gcv.font = 0; + char_width = 8; + char_height = 12; + roff = rmarg - 0; + toff = tmarg + 10; + loff = lmarg + 0; + boff = bmarg + 2; + + border_width = params->xpBorderWidth<0 ? 2 : params->xpBorderWidth; +#ifdef REALARGUMENTPARSING + if (params->xpGeometry) + g_flags = XGeometry(display, + screen_no, + params->xpGeometry, + "800x400+0+0", + border_width, + char_width, + char_height, + roff+loff, + toff+boff, + &w_x, + &w_y, + &w_w, + &w_h); + else + { + g_flags = 0; + w_x = 0; + w_y = 0; + w_w = 800; + w_h = 400; } +#else + if (params->xpGeometry) + g_flags = XGeometry(display, + screen_no, + params->xpGeometry, + "800x800+100+100", + border_width, + char_width, + char_height, + roff+loff, + toff+boff, + &w_x, + &w_y, + &w_w, + &w_h); + else + { + g_flags = 0; + w_x = 100; + w_y = 100; + w_w = 800; + w_h = 800; + } +#endif + + if ((params->xpForegroundColor != NULL) && + XAllocNamedColor(display, + colormap, + params->xpForegroundColor, + &color, + &color)) + gcv.foreground = color.pixel; + else + gcv.foreground = XBlackPixelOfScreen(screen); + + if ((params->xpBackgroundColor != NULL) && + XAllocNamedColor(display, + colormap, + params->xpBackgroundColor, + &color, + &color)) + gcv.background = color.pixel; + else + gcv.background = XWhitePixelOfScreen(screen); + + if ((params->xpBorderColor != NULL) && + XAllocNamedColor(display, + colormap, + params->xpBorderColor, + &color, + &color)) + attributes.border_pixel = color.pixel; + else + attributes.border_pixel = XBlackPixelOfScreen(screen); + + attributes.background_pixel = gcv.background; + attributes.event_mask = KeyPressMask|ExposureMask|StructureNotifyMask| + FocusChangeMask|VisibilityChangeMask; + attributes.colormap = colormap; + window = XCreateWindow(display, + root, + w_x, + w_y, + w_w, + w_h, + border_width, + CopyFromParent, + InputOutput, + visual, + CWBackPixel|CWBorderPixel|CWEventMask|CWColormap, + &attributes); + icon_window = XCreateWindow(display, + root, + w_x, + w_y, + icon_width, + icon_height, + 0, + CopyFromParent, + InputOutput, + visual, + CWBackPixel|CWEventMask|CWColormap, + &attributes); + + gc = XCreateGC(display, + window, + GCForeground|GCBackground|(gcv.font ? GCFont : 0), + &gcv); + icon_gc = XCreateGC(display, + icon_window, + GCForeground|GCBackground, + &gcv); + + if (!gcv.font) + cptfont_bitmap = XCreateBitmapFromData(display, + root, + GENERA_CPTFONT_bits, + GENERA_CPTFONT_width, + GENERA_CPTFONT_height); + + if (XCellsOfScreen(screen) < 16) { + icon_bitmap = XCreateBitmapFromData(display, + icon_window, + GeneraIcon32_bits, + GeneraIcon32_width, + GeneraIcon32_height); + icon_gc_s = icon_gc_c = icon_gc_t = NULL; + } else { + icon_bitmap = 0; + color.red = 0; + color.green = 65535; + color.blue = 0; + if (XAllocColor(display, colormap, &color)) { + gcv.foreground = color.pixel; + icon_gc_s = XCreateGC(display, + icon_window, + GCForeground, + &gcv); + } else + icon_gc_s = icon_gc; + color.red = 65535; + color.green = 0; + color.blue = 0; + if (XAllocColor(display, colormap, &color)) { + gcv.foreground = color.pixel; + icon_gc_c = XCreateGC(display, + icon_window, + GCForeground, + &gcv); + } else + icon_gc_c = icon_gc; + color.red = 65535; + color.green = 0; + color.blue = 65535; + if (XAllocColor(display, colormap, &color)) { + gcv.foreground = color.pixel; + icon_gc_t = XCreateGC(display, + icon_window, + GCForeground, + &gcv); + } else + icon_gc_t = icon_gc; + } + + SetColdLoadNames (); + wmhints.flags = InputHint|StateHint|IconWindowHint; + wmhints.input = True; + wmhints.initial_state = (params->xpInitialState == Iconic) ? + IconicState : + NormalState; + wmhints.icon_window = icon_window; + XSetWMHints(display, window, &wmhints); + sizehints.flags = ((g_flags & XValue) ? USPosition : PPosition) + | ((g_flags & WidthValue) ? + USSize : + PSize); + sizehints.x = w_x; /* These are for pre-ICCCM window managers */ + sizehints.y = w_y; + sizehints.width = w_w; + sizehints.height = w_h; + XSetNormalHints(display, window, &sizehints); + XMapWindow(display, window); + XFlush(display); + + alloc_screen_array(w_w, w_h); + return 0; +} + + +static void close_display () +{ + begin_MUTEX_LOCKED (XLock); + if (display != NULL) + { + if (originalModmap != NULL) { + if (XSetModifierMapping(display, + originalModmap) != + MappingSuccess) + vwarn("cold load", + "Unable to restore original X modifier keymap"); + XFreeModifiermap(originalModmap); + if (orig_meta) { + XChangeKeyboardMapping(display, + XKeysymToKeycode(display, + XK_Alt_L), + ks_p_kc_meta, + orig_meta, + 1); + XFree (orig_meta); + } + if (orig_hyper) { + XChangeKeyboardMapping(display, + XKeysymToKeycode(display, + XK_Menu), + ks_p_kc_hyper, + orig_hyper, + 1); + XFree (orig_hyper); + } + originalModmap = NULL; + } + XCloseDisplay(display); + display = NULL; + } + end_MUTEX_LOCKED (XLock); +} + + +/* static void close_display_child_hook () */ +/* { */ +/* if (display != NULL) */ +/* close(XConnectionNumber(display)); */ +/* } */ + + +static void handle_input () +{ + XEvent event; + KeySym keysym; + int key = -1, bits = 0; + coldmapentry *mapp; + static int first_keypress = 1 ; + static char buffer[3] ; + static int last_w = 0, last_h = 0; + + XNextEvent(display, &event); + +// +// jj +// + XFlush(display); +// +// +// + begin_MUTEX_LOCKED (XLock); + + switch (event.type) + { + + case ConfigureNotify: + // printf ("ConfN %d x %d\n",event.xconfigure.width, event.xconfigure.height); + if (event.xconfigure.window == window) { + if ((last_w != event.xconfigure.width) || + (last_h != event.xconfigure.height)) { + alloc_screen_array(event.xconfigure.width, + event.xconfigure.height); + last_w = event.xconfigure.width ; + last_h = event.xconfigure.height ; + } + else if (event.xconfigure.window == icon_window) + { + icon_width = event.xconfigure.width; + icon_height = event.xconfigure.height; + } + } + break; + + case Expose: + // printf ("Expose\n"); + if (event.xexpose.window == window && + event.xexpose.count == 0) + { + if (event.xexpose.y < tmarg) show_lights(1); + hide_cursor(); + redisplay_screen_array((event.xexpose.x-lmarg)/char_width, + (event.xexpose.y-tmarg)/char_height, + (event.xexpose.x-lmarg+event.xexpose.width-1)/char_width+1, + (event.xexpose.y-tmarg+event.xexpose.height-1)/char_height+1); + reset_light_state(True); + show_lights(1); + show_cursor(); + } + else if (event.xexpose.window == icon_window) + show_icon(); + break; + + case KeyPress: + // printf ("XKp\n"); + if (first_keypress) + { + /* Disable FEP timer */ + first_keypress = 0; + alarm(0); + } + keysym = XLookupKeysym(&event.xkey, 0); + if (IsModifierKey(keysym) || + (XK_Multi_key == keysym) || + (XK_KP_F4 == keysym)) + break; + if (event.xkey.state & ControlMask) bits |= 1; + if (event.xkey.state & meta_mask) bits |= 2; + if (event.xkey.state & super_mask) bits |= 4; + if (event.xkey.state & hyper_mask) bits |= 8; + if (event.xkey.state & isol3_mask) bits |= 16; + // + if ((XK_F1 <= keysym) && (keysym <= XK_F23)) + key = fkMap[2*(keysym-XK_F1) + + ((event.xkey.state & ShiftMask) ? 1 : 0)]; + // + // if ISO_Level3_Shift char: use X translation + // + else if ((event.xkey.state & isol3_mask) && + (XK_space <= keysym) && (keysym <= XK_ssharp)) { + XLookupString ( &event.xkey, + buffer, + sizeof(buffer), + &keysym, + NULL ); + key = buffer[0] ; + } + // + // handle shift & lock + // + else if ((XK_a <= keysym) && (keysym <= XK_z)) + { + key = (keysym - XK_a) + 65; + if ((bits == 0) + ? ((event.xkey.state + & (ShiftMask | LockMask)) == 0) + : (event.xkey.state & ShiftMask)) + key = key + 32; + + } + // + // special cases + // + else + { + if (event.xkey.state & ShiftMask) { + if (XK_KP_Enter == keysym) + /* Special case Shift-Keypad-Enter: Generate Return instead of End */ + key = SK_Return; + else + keysym = XLookupKeysym(&event.xkey, 1); + } + if ((XK_space <= keysym) && (keysym <= XK_asciitilde)) + key = keysym; + else if (key == -1) + { + for (mapp = skMap; mapp->code != -1; mapp++) + { + if (keysym == mapp->keysym) + { + key = mapp->code; + break; + } + } + } + } + if (key == -1) + XBell(display, 0); + else { + EmbQueuePutWord (keyboard_queue, (clsoInputChar<<24) | + ((uEmbWord)bits<<12) | (uEmbWord)key); + if ((key == SK_Function) && (bits & 9) == 9) + EmbCommAreaPtr->stop_request = TRUE; + } + // printf("keysym = %d, key = %d, bits = %d\n", keysym, key, bits); + break; + + case MappingNotify: +// printf ("MapN\n"); + XRefreshKeyboardMapping(&event.xmapping); + if (event.xmapping.request == MappingModifier) + if (setup_modifier_mapping() < 0) { +// vwarn ("cold load init", "in MappingNotify"); + exit (-1) ; + } + break; + + case VisibilityNotify: + // printf ("VisN\n"); + if (event.xvisibility.window == window) + visibility = (event.xvisibility.state != + VisibilityFullyObscured); + else if (event.xvisibility.window == icon_window) + icon_visibility = (event.xvisibility.state != + VisibilityFullyObscured); + break; + + case FocusIn: + // printf ("XFI "); + // printf ("mode = %d, detail =%d\n", event.xfocus.mode, event.xfocus.detail); + /* if (event.xfocus.mode == NotifyNormal && event.xfocus.detail == NotifyPointer) */ + /* break ; */ + cursor_frozen = 0; + show_cursor(); + break; + + case FocusOut: + // printf ("XFO\n"); + show_cursor_internal(1); + cursor_frozen = 1; + break; + } + end_MUTEX_LOCKED (XLock); +} + +static void alloc_screen_array (int new_width_pixels, int new_height_pixels) +{ + line *old_screen_array = screen_array; + int old_width = width; + int old_height = height; + int y = 0; + int new_width, new_height; /* in lines */ + int pixels_per_run_light; + + new_width = (new_width_pixels - (roff+loff))/char_width; + new_height = (new_height_pixels - + (toff+char_height+RUN_LIGHT_Y_SPACE+boff))/char_height; + + if ((new_width == old_width) && (new_height == old_height)) return; + + screen_array = (line *)malloc(new_height * sizeof(line)); + while (y < new_height) + { + screen_array[y].length = 0; + screen_array[y].chars = (char *)malloc(new_width); + memset(screen_array[y].chars, ' ', new_width); + if (y < old_height) + { + screen_array[y].length = old_screen_array[y].length < + new_width + ? old_screen_array[y].length : new_width; + memcpy(screen_array[y].chars, + old_screen_array[y].chars, + screen_array[y].length); + } + y++; + } + if (old_screen_array != NULL) + { + for (y=0; ycharacter_width = 1; + cold_channel->line_height = 1; + cold_channel->display_width = new_width; + cold_channel->display_height = new_height; + run_light_y = new_height_pixels - RUN_LIGHT_Y_OFFSET; + run_label_y = new_height_pixels - RUN_LIGHT_Y_SPACE; + run_label_height = char_height; + pixels_per_run_light = (new_width_pixels - (roff+loff)) / 32; + run_light_first_x = (pixels_per_run_light * 8) + loff; + run_label_width = new_width_pixels - run_light_first_x - roff; + progress_bar_first_x = (pixels_per_run_light * 22) + loff; + progress_bar_width = new_width_pixels - loff - progress_bar_first_x - roff; + reset_light_state(True); + EmbQueuePutWord(keyboard_queue, clsoSetSize<<24); + width = new_width; + height = new_height; +} + + +static void redisplay_line (int y, int x, int xlim) +{ + if (!cptfont_bitmap) { + XDrawImageString(display, window, gc, + x*char_width+loff, y*char_height+toff, + &screen_array[y].chars[x], xlim-x); + } + else + { + int cx, wx, wy = y*char_height+tmarg; + + for (cx = x, wx = x*char_width+lmarg; + cxfep.cursor; + if (cursor_state) + XFillRectangle(display, + window, + gc, + current_x*char_width+lmarg, + current_y*char_height+tmarg, + char_width-1, + char_height-1); + XDrawRectangle(display, + window, + gc, + current_x*char_width+lmarg, + current_y*char_height+tmarg, + char_width-1, + char_height-1); + cursor_visible = 1; + } + } +} + + +static void hide_cursor () +{ + if (cursor_visible) + { + XClearArea(display, + window, + current_x*char_width+lmarg, + current_y*char_height+tmarg, + char_width, + char_height, + False); + redisplay_screen_array(current_x, + current_y, + current_x+1, + current_y+1); + cursor_visible = 0; + } +} + + +static void show_icon () +{ + XPoint tri[3]; + int xoff = icon_width > 32 ? (icon_width-32)/2 : 0; + + if (icon_bitmap) + XCopyPlane(display, + icon_bitmap, + icon_window, + icon_gc, + 0, + 0, + 32, + 32, + xoff, + 0, + 1); + else { + XFillRectangle(display, + icon_window, + icon_gc_s, + xoff+10, + 3, + 9, + 9); + XFillArc(display, + icon_window, + icon_gc_c, + xoff+15, + 9, + 14, + 14, + 0, + 360*64); + tri[0].x = xoff+3; tri[0].y = 29; + tri[1].x = xoff+10; tri[1].y = 15; + tri[2].x = xoff+17; tri[2].y = 29; + XFillPolygon(display, + icon_window, + icon_gc_t, + tri, + 3, + Convex, + CoordModeOrigin); + } +} + +static void show_lights (int force) +{ + int i, bit; + int changed = light_state ^ EmbCommAreaPtr->run_lights; + EmbColdLoadChannel *cls; + int pb_length, pb_length_change; + + // if (! display) return ; + light_state = EmbCommAreaPtr->run_lights; + if (visibility) { + /* Update run bars in cold-load window */ + if (force || changed) + for (i = run_light_first_x, bit = 1; + bit < 32; + i += RUN_LIGHT_SPACING, bit = bit << 1) + if (force || (changed & bit)) { + if (light_state & bit) + XFillRectangle(display, + window, + gc, + i, + run_light_y, + RUN_LIGHT_WIDTH, + 1); + else + XClearArea(display, + window, + i, + run_light_y, + RUN_LIGHT_WIDTH, + 1, + False); + } + /* Update progress bar */ + cls = HostPointer(EmbCommAreaPtr->cold_load_channel); + if (cls != NULL) { + if (cls->progress_note.string_length == 0) { + if (progress_label != NULL) { + /* Clear progress label */ + XClearArea( display, + window, + run_light_first_x, + run_label_y - + run_label_height + 1, + run_label_width, + run_label_height, + False ); + free(progress_label); + progress_label = NULL; + } + if (progress_bar_length_state != 0) { + /* Clear progress bar */ + XClearArea(display, + window, + progress_bar_first_x, + run_light_y, + progress_bar_width, + 1, + False); + progress_bar_numerator_state = + progress_bar_denominator_state = + progress_bar_length_state = 0; + } + } else { + /* Update progress label */ + if (progress_label == NULL) { + /* Draw run bar labels */ + XDrawString(display, + window, + gc, + run_light_first_x + + (PROCESS_RUN_LIGHT * + RUN_LIGHT_SPACING), + run_label_y, + "Run", + 3); + XDrawString(display, + window, + gc, + run_light_first_x + + (DISK_RUN_LIGHT * + RUN_LIGHT_SPACING), + run_label_y, + "Disk", + 4); + XDrawString(display, + window, + gc, + run_light_first_x + + (NETWORK_RUN_LIGHT * + RUN_LIGHT_SPACING), + run_label_y, + "Net", + 3); + /* Allocate memory for progress label cache */ + progress_label = + (char *)calloc(cls->progress_note.string_total_size, + sizeof(char)); + progress_label_length = 0; + } + if (progress_label_length != + cls->progress_note.string_length || + strcmp(progress_label, + cls->progress_note.string)) { + /* Recache progress label */ + progress_label_length = + cls->progress_note.string_length; + strncpy(progress_label, + cls->progress_note.string, + progress_label_length); + /* Draw new label + * Erase old label first so no overwrite */ + XClearArea( display, + window, + progress_bar_first_x, + run_label_y - + run_label_height + 1, + progress_bar_width, + run_label_height, + False ); + XDrawString(display, + window, + gc, + progress_bar_first_x, + run_label_y, + progress_label, + progress_label_length); + } + if (cls->progress_note.denominator > 0) { + /* Update progress bar */ + if (progress_bar_numerator_state != + cls->progress_note.numerator || + progress_bar_denominator_state != + cls->progress_note.denominator) { + progress_bar_numerator_state = + cls->progress_note.numerator; + progress_bar_denominator_state = + cls->progress_note.denominator; + pb_length = + (progress_bar_numerator_state * + progress_bar_width) / + progress_bar_denominator_state; + pb_length_change = + pb_length - + progress_bar_length_state; + if (pb_length_change < 0) { + /* Shorten the progress bar */ + XClearArea(display, + window, + progress_bar_first_x + pb_length, + run_light_y - pb_length_change, + 1, + 1, + False); + progress_bar_length_state = + pb_length; + } else if (pb_length_change > 0) { + /* Lengthen the progress bar */ + XFillRectangle(display, + window, + gc, + progress_bar_first_x + + progress_bar_length_state, + run_light_y, + pb_length_change, + 1); + progress_bar_length_state = pb_length; + } + } + } + } + } + } + /* if (icon_visibility) { */ + /* /\* Update run bars in icon *\/ */ + /* if (force || changed) */ + /* for (i = 2, bit = 1; bit < 32; i += 6, bit = bit << 1) */ + /* if (force || (changed & bit)) */ + /* if (light_state & bit) */ + /* XFillRectangle(display, icon_window, icon_gc, i, 32, 4, 4); */ + /* else */ + /* XClearArea(display, icon_window, i, 32, 4, 4, False); */ + /* } */ +} + + +static void reset_light_state (int screen_cleared_p) +{ + if (screen_cleared_p == True) { + progress_bar_numerator_state = + progress_bar_denominator_state = + progress_bar_length_state = 0; + light_state = 0; + } + if (progress_label != NULL) { + free(progress_label); + progress_label = NULL; + } +} + + +static void replay_command_history () +{ + int i, have_pos = FALSE; + + if (cold_channel->command_history_wrapped) + i = cold_channel->command_history_top+1; + else + i = 0; + for (; i != cold_channel->command_history_top; i++) { + /* Watch for history wraparound */ + if (i == ColdLoadCommandHistorySize) + i = 0; + + /* Don't do any output until we know where to put it */ + if (!have_pos && + ((cold_channel->command_history[i]>>24) & 0xff) == + clsoSetCursorpos) + have_pos = TRUE; + + /* Do output */ + if (have_pos) + handle_output_command(cold_channel->command_history[i]); + } + + reset_light_state(False); + show_lights(1); +} + +static void handle_output_command (uEmbWord command) +{ + int operator; + int x, y; + char c; + XWMHints wmhints; + + operator = (command>>24) & 0xff; + switch (operator) { + case clsoDrawChar: + case clsoLozengedChar: + if ((current_y < height) && (current_x < width)) { + if (screen_array[current_y].length <= current_x) { + for (x = screen_array[current_y].length; + x < current_x; + x++) + screen_array[current_y].chars[x] = ' '; + screen_array[current_y].length = current_x + 1; + } + c = (char)(command & 0xff); + screen_array[current_y].chars[current_x] = c; + redisplay_line(current_y, current_x, current_x+1); + } + current_x++; + break; + case clsoSetCursorpos: + current_x = command & 0xfff; + current_y = (command>>12) & 0xfff; + break; + case clsoClearRestOfWindow: + for (y = current_y+1; ycommand_history_top = 0; + cold_channel->command_history_wrapped = FALSE; +#endif + + /* Expose display, ring bell */ + XWithdrawWindow ( display, window, XDefaultScreen(display) ); + wmhints.flags = InputHint|StateHint|IconWindowHint; + wmhints.input = True; + wmhints.initial_state = NormalState; + wmhints.icon_window = icon_window; + XSetWMHints(display, window, &wmhints); + XMapRaised( display, window ); + XBell(display, 0); + XFlush (display); + break; + case clsoDeselect: + XIconifyWindow ( display,window, XDefaultScreen(display) ); + break; + } +} + + +static void get_keyboard_modifier_codes (int for_real_p, + KeyCode *control_l_code, + KeyCode *control_r_code, + KeyCode *meta_l_code, + KeyCode *meta_r_code, + KeyCode *alt_l_code, + KeyCode *super_code, + KeyCode *hyper_code) +{ + KeyCode keycode1, keycode2; + + *control_l_code = XKeysymToKeycode(display, XK_Control_L); + *control_r_code = XKeysymToKeycode(display, XK_Control_R); + *meta_l_code = XKeysymToKeycode(display, XK_Meta_L); + *meta_r_code = XKeysymToKeycode(display, XK_Meta_R); + *alt_l_code = XKeysymToKeycode(display, XK_Alt_L); + + keycode1 = XKeysymToKeycode(display, XK_ISO_Left_Tab); /* Linux X server */ + keycode2 = XKeysymToKeycode(display, XK_adiaeresis); /* ä */ + + // printf("keycode1 %d, keycode2 %d\n", keycode1, keycode2); + + if (keycode1 != 0 && keycode2 != 0) { + if (for_real_p) { + if (! did_show ) vwarn("cold load", + "presuming a German keyboard"); + did_show = 1; + } ; +// printf("German Keyboard\n"); + keyboardType = German; + isol3_code = XKeysymToKeycode(display,XK_ISO_Level3_Shift); + skMap = (coldmapentry*)&coldmapGerman; + fkMap = (short*)&fkmapGerman; + if (keycode1 != 0) { + skMap->keysym = XK_Num_Lock; /* Linux X server */ + /* Linux assigns a modifier mapping to the Num_Lock keysym but, on the + Apple Pro keyboard, that keysym maps to the key labelled "clear" so + it's safe to remove the modifier mapping to make room for Super/Hyper */ + removeNumLockModifier = TRUE; + } else + /* ---*** TODO: Find out what KeySym is labelled CLEAR */ + skMap->keysym = 0; /* Apple X11 */ + *super_code = XKeysymToKeycode(display, XK_Super_L); + *hyper_code = XKeysymToKeycode(display, XK_Hyper_R); + return ; + } + + if (keycode1 != 0 && keycode2 == 0) { + if (for_real_p) { + if (!did_show) vwarn("cold load", + "presuming a US keyboard"); + did_show = 1; + } +// printf("US Keyboard\n"); + keyboardType = Us; + isol3_code = XKeysymToKeycode(display,XK_ISO_Level3_Shift); + skMap = (coldmapentry*)&coldmapUs ; + fkMap = (short*)&fkmapUs; + if (keycode1 != 0) { + skMap->keysym = XK_Num_Lock; /* Linux X server */ + /* Linux assigns a modifier mapping to the Num_Lock keysym but, on the + Apple Pro keyboard, that keysym maps to the key labelled "clear" so + it's safe to remove the modifier mapping to make room for Super/Hyper */ + removeNumLockModifier = TRUE; + } else + /* ---*** TODO: Find out what KeySym is labelled CLEAR */ + skMap->keysym = 0; /* Apple X11 */ + *super_code = XKeysymToKeycode(display, XK_Super_L); + *hyper_code = XKeysymToKeycode(display, XK_Hyper_R); + return ; + } + + keycode2 = XKeysymToKeycode(display, XK_Aring); /* Apple X11 */ + + if (keycode1 != 0 || keycode2 != 0) { + if (!did_show) { + vwarn("cold load", + "presuming an Apple Pro keyboard"); + did_show = 1; + }; + keyboardType = Apple_Pro; + skMap = (coldmapentry*)&coldmapApple; + fkMap = (short*)&fkmapApple; + if (keycode1 != 0) { + skMap->keysym = XK_Num_Lock; /* Linux X server */ + /* Linux assigns a modifier mapping to the Num_Lock keysym but, on the + Apple Pro keyboard, that keysym maps to the key labelled "clear" so + it's safe to remove the modifier mapping to make room for Super/Hyper */ + removeNumLockModifier = TRUE; + } else + /* ---*** TODO: Find out what KeySym is labelled CLEAR */ + skMap->keysym = 0; /* Apple X11 */ + *super_code = XKeysymToKeycode(display, XK_Down); + *hyper_code = XKeysymToKeycode(display, XK_Left); + } + + else { + /* Assume it's a DEC keyboard */ + + /* Special knowledge -- DEC's LK401-AA has two Multi-Key keys labelled Compose Character. + The call to XKeysymToKeycode returns the code for the righthand Compose Character. + The lefthand Compose Character's key code is four greater than the righthand key. */ + + keycode1 = XKeysymToKeycode(display, XK_Multi_key); + keycode2 = XKeysymToKeycode(display, XK_space); + *super_code = keycode1 + 4; + *hyper_code = keycode1; + + /* OSF 4.0 with CDE makes shift+Space be the Multi-Key code, don't get confused */ + +//printf("dec keyboard\n"); +//printf("keycode1 %d, keycode2 %d\n", keycode1, keycode2); + + if (keycode1 == keycode2) + *hyper_code = 0; + + /* If XK_Multi_key's code is 0, then we must have the PC-style DEC keyboard. */ + + if (*hyper_code == 0) { + if (!did_show) vwarn("cold load", + "presuming a DEC PC keyboard"); + did_show = 1; + keyboardType = DEC_PC; + skMap = (coldmapentry*)&coldmapDECPC; + fkMap = (short*)&fkmapDECPC; + *super_code = XKeysymToKeycode(display, XK_Down); + *hyper_code = XKeysymToKeycode(display, XK_Left); + } + + else { + if (!did_show) vwarn("cold load", + "presuming a DEC LK401 keyboard"); + did_show = 1; + keyboardType = DEC_LK401; + skMap = (coldmapentry*)&coldmapDECLK; + fkMap = (short*)&fkmapDECLK; + } + } + + if ((*meta_l_code == 0) && + (*meta_r_code == 0) && + *alt_l_code) + *meta_l_code = *alt_l_code; + +// hack + *control_r_code = *control_l_code; + *super_code = XKeysymToKeycode(display, XK_Control_R); + + return; +} + + +static int find_modifier (XModifierKeymap *modmap, KeyCode code) +{ + int modifier, i; + + if (code == 0) return -1; + for (modifier = 0; modifier < 8; modifier++) + for (i = 0; i < modmap->max_keypermod; i++) + if (modmap->modifiermap[i+modifier*modmap->max_keypermod] == code) + return modifier; + return -1; +} + + +static int find_unused_modifier (XModifierKeymap **modmapp) +{ + int modifier, i; + KeyCode num_lock_code; + + for (modifier = 0; modifier < 8; modifier++) + { + for (i = 0; i < (*modmapp)->max_keypermod; i++) + if ((*modmapp)->modifiermap[i+modifier*(*modmapp)->max_keypermod] != 0) + goto next_modifier; + return modifier; + next_modifier: + continue; + } + + if (removeNumLockModifier) { + num_lock_code = XKeysymToKeycode(display, XK_Num_Lock); + for (modifier = 0; modifier < 8; modifier++) { + for (i = 0; i < (*modmapp)->max_keypermod; i++) { + if ((*modmapp)->modifiermap[i+modifier*(*modmapp)->max_keypermod] == num_lock_code) { + *modmapp = + XDeleteModifiermapEntry(*modmapp, + num_lock_code, + modifier); + vwarn("cold load", + "NumLock modifier removed"); + return modifier; + } + } + } + } + + return -1; +} + + +static int do_modifier (XModifierKeymap **modmapp, int *changedp, + KeyCode code1, KeyCode code2, KeyCode code3) +{ + int mod = -1; + + mod = find_modifier(*modmapp, code1); + if (mod == -1) + mod = find_modifier(*modmapp, code2); + if (mod == -1) + mod = find_modifier(*modmapp, code3); + // fprintf(stderr,"found %02x %02x %02x -> %d %02x\n", code1,code2,code3,mod,1<>= 1; + } + return i; +} + + +static int setup_modifier_mapping () +{ + XModifierKeymap *modmap; + KeyCode control_l_code, control_r_code, meta_l_code, meta_r_code, + alt_l_code, super_code, hyper_code; + int changed = 0; + + get_keyboard_modifier_codes(1, + &control_l_code, + &control_r_code, + &meta_l_code, + &meta_r_code, + &alt_l_code, + &super_code, + &hyper_code); + +//#if 0 + XGrabServer(display); + modmap = XGetModifierMapping(display); + do_modifier(&modmap, &changed, control_l_code, control_r_code, 0); + meta_mask = do_modifier(&modmap, &changed, meta_l_code, meta_r_code, 0); + if (meta_mask == 0) + vwarn ("cold load init", + "Unable to allocate a modifier for the Meta key."); + super_mask = do_modifier(&modmap, &changed, super_code, 0, 0); + if (super_mask == 0) + vwarn ("cold load init", + "Unable to allocate a modifier for the Super key."); + hyper_mask = do_modifier(&modmap, &changed, hyper_code, 0, 0); + if (hyper_mask == 0) + vwarn ("cold load init", + "Unable to allocate a modifier for the Hyper key."); + else if (hyper_mask == super_mask) { + modmap = XDeleteModifiermapEntry(modmap, + hyper_code, + mask_to_modifier(super_mask)); + hyper_mask = do_modifier(&modmap, &changed, super_code, 0, 0); + if (hyper_mask == 0) + vwarn ("cold load init", + "Unable to allocate a modifier for the Hyper key."); + else + modmap = XDeleteModifiermapEntry(modmap, + super_code, + mask_to_modifier(hyper_mask)); + changed = TRUE; + } + if (keyboardType == German) { + isol3_mask = do_modifier(&modmap, &changed, isol3_code, 0, 0); + if (isol3_mask == 0) + vwarn ("cold load init", + "Unable to allocate a modifier for the ISO_Level3_Shift key. Use xmodmap"); + } + + if (changed) + if (XSetModifierMapping(display, modmap) != MappingSuccess) + vwarn("Cold load", "Unable to set X modifier keymap"); + XUngrabServer(display); + XFreeModifiermap(modmap); + return 0; +//#endif +} + + + +/* Error Handler */ + +/* static XErrorHandler XErrorDefaultHandler = NULL; */ + +/* static void SetColdXErrorHandler () */ +/* { */ +/* /\* Set error handler *\/ */ +/* if (XErrorDefaultHandler == NULL) */ +/* XErrorDefaultHandler = */ +/* XSetErrorHandler ((XErrorHandler)&ColdXErrorHandler); */ +/* } */ + + +/* static int ColdXErrorHandler (Display *display, XErrorEvent *error) */ +/* { */ +/* fprintf ( stderr, "Xerror : %d\n", error->request_code); */ +/* if (error->request_code != X_KillClient) */ +/* return ((*XErrorDefaultHandler)(display, error)); */ +/* } */ + + + +/* static int initialize_cold (XParams *cl_params, boolean noWaiting) */ +/* { */ +/* int x_fd; */ + +/* begin_MUTEX_LOCKED (XLock); */ + +/* x_fd = open_cold_load_display (cl_params, noWaiting); */ + +/* end_MUTEX_LOCKED (XLock); */ + +/* return (x_fd); */ +/* } */ + + +/* The output driver for the Cold Load window */ + +static void ColdLoadOutput (void* ignored) +{ + if (cold_channel->fd > 0) manage_cold_load_output (); +} + + +/* The input driver for the Cold Load window */ + +#define POLLWAIT_IN_MS 40 + +static void ColdLoadInput (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + VLMConfig *config = (VLMConfig*) argument; + struct pollfd xpoll; + + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, + (void*)self); + + WaitUntilInitializationComplete (); + + if (-1 == cold_channel->fd) { + begin_MUTEX_LOCKED (XLock); + cold_channel->fd = open_cold_load_display (&config->coldLoadXParams, + FALSE); + end_MUTEX_LOCKED (XLock); + setup_x_io_error_handler (); + } + + while (TRUE) { + + pthread_testcancel (); + xpoll.fd = cold_channel->fd; + xpoll.events = POLLIN; + + /* Handle pending X input and errors */ + poll (&xpoll, 1, POLLWAIT_IN_MS); + + if (xpoll.revents) { + /* If can read from x_fd, there're events pending */ + cold_channel->fd = + manage_x_input (&config->coldLoadXParams); + } + begin_MUTEX_LOCKED (XLock); + if (cold_channel->fd) XFlush (display); + // if (cold_channel->fd) update_cold_load_run_lights (); + end_MUTEX_LOCKED (XLock); + } + pthread_cleanup_pop (TRUE); +} + + + +static char *ColdLoadWindowName = NULL, + *ColdLoadIconName = NULL, + *DebuggerWindowName = NULL, + *DebuggerIconName = NULL; + +static enum GuestStatus lastGuestStatus = NonexistentGuestStatus; + +static char *concatenate_string(char *string1, char *string2) +{ + int total_size = strlen(string1) + strlen(string2) + 1; + char *new_string = malloc(total_size); + if (0 == new_string) + vpunt (NULL, "No room for concatenated string."); + strcpy(new_string, string1); + return(strcat(new_string, string2)); +} + + +static void SetupColdLoadNameStrings (VLMConfig* config) +{ + NetworkInterface *interface; + struct hostent *theHost; + struct in_addr theAddress; + char *longHostName, *shortHostName, buffer[128], *pp, *aName; + + interface = &config->interfaces[0]; + while (!interface->present) interface++; + + switch (interface->myProtocol) { + + case ETHERTYPE_IP: + theAddress.s_addr = htonl (interface->myAddress.s_addr); + if (NULL == + (theHost = gethostbyaddr ((char*)&theAddress.s_addr, + sizeof (struct in_addr), + AF_INET))) { + sprintf (buffer, "INTERNET|%s", inet_ntoa(theAddress)); + longHostName = shortHostName = strdup (buffer); + } + else { + longHostName = strdup (theHost->h_name); + pp = strchr (longHostName, '.'); + if (pp) *pp = 0; + shortHostName = longHostName; + while (*theHost->h_aliases) { + aName = strdup (*theHost->h_aliases); + pp = strchr (aName, '.'); + if (pp) *pp = 0; + if (strlen (aName) < strlen (shortHostName)) + shortHostName = aName; + theHost->h_aliases++; + } + } + break; + + case ETHERTYPE_CHAOS: + sprintf (buffer, + "CHAOS|%o", + htonl (interface->myAddress.s_addr)); + longHostName = shortHostName = strdup (buffer); + break; + + default: + longHostName = shortHostName = ""; + break; + } + + ColdLoadIconName = concatenate_string (shortHostName, + " Cold Load"); + ColdLoadWindowName = concatenate_string (longHostName, + " Cold Load Stream"); + DebuggerWindowName = concatenate_string (longHostName, + " VLM Debugger"); + DebuggerIconName = concatenate_string (shortHostName, + " Debugger"); +} + +static void SetColdLoadNames () +{ + if (display != NULL && window != 0) { + if (RunningGuestStatus == EmbCommAreaPtr->guestStatus) { + XStoreName (display, window, ColdLoadWindowName); + XSetIconName (display, window, ColdLoadIconName); + } + else { + XStoreName (display, window, DebuggerWindowName); + XSetIconName (display, window, DebuggerIconName); + } + } +} + +void UpdateColdLoadNames () +{ + if (EmbCommAreaPtr->guestStatus != lastGuestStatus) { + begin_MUTEX_LOCKED (XLock); + SetColdLoadNames (); + end_MUTEX_LOCKED (XLock); + lastGuestStatus = EmbCommAreaPtr->guestStatus; + } +} + +static pthread_t plightsThread ; + +static void* lightsThread ( void *ignore) { + // update the cold_load run lights periodically + // 1 s in ns = 1 000 000 000 + // 40 ms in ns = 0 000 040 000 + // 1000 ms in ns = 0 000 100 000 + //#define LIGHT_SLEEP 40000 /* 25 times a second */ +#define LIGHT_SLEEP 100000 /* 10 times a second */ + + struct timespec lightSleep = { 0, LIGHT_SLEEP } ; + + WaitUntilInitializationComplete (); + + while (display) + { + pthread_delay_np ( &lightSleep ); + pthread_testcancel (); + if (display && visibility) { + begin_MUTEX_LOCKED (XLock); + show_lights ( 0 ); + end_MUTEX_LOCKED (XLock); + } + } + // pthread_cleanup_pop (TRUE); + return NULL; +} + + + +/* Create the Cold Load Stream's channel */ + +int InitializeColdLoadChannel (VLMConfig* config) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbColdLoadChannel)); + register EmbColdLoadChannel *p = (EmbColdLoadChannel*) HostPointer (cp); + + p->type = EmbColdLoadChannelType; + p->unit = 0; + p->next = EmbCommAreaPtr->channel_table; /* Thread into list of all channels */ + EmbCommAreaPtr->channel_table = cp; + EmbCommAreaPtr->cold_load_channel = cp; /* Make it easy to find */ + cold_channel = p; + + p->keyboard_input_queue = CreateQueue (ColdLoadInputQueueSize, sizeof (EmbPtr)); + keyboard_queue = (EmbQueue*) HostPointer (p->keyboard_input_queue); + + p->display_output_queue = CreateQueue (ColdLoadOutputQueueSize, sizeof (EmbPtr)); + display_queue = (EmbQueue*) HostPointer (p->display_output_queue); + display_queue->signal = InstallSignalHandler ((ProcPtrV)&ColdLoadOutput, NULL, FALSE); + + p->progress_note.string_total_size = ColdLoadProgressStringSize; + p->progress_note.string_length = 0; + + SetupColdLoadNameStrings (config); + + begin_MUTEX_LOCKED (XLock); + + p->fd = open_cold_load_display (&config->coldLoadXParams, TRUE); + + end_MUTEX_LOCKED (XLock); + + if (-1 == p->fd) { + verror ("cold load init", NULL); + vwarn ("cold load init", "Will wait for X server but cold load may not function properly."); + } + setup_x_io_error_handler (); + + if (pthread_create (&p->coldLoadInput, &EmbCommAreaPtr->inputThreadAttrs, + (pthread_startroutine_t) &ColdLoadInput, (pthread_addr_t) config)) + vpunt (NULL, "Unable to create the cold load window's input thread"); + if (pthread_create (&plightsThread, NULL, + (pthread_startroutine_t) &lightsThread, NULL)) + vpunt (NULL, "Unable to create the cold load window's runlight thread"); + p->coldLoadInputSetup = TRUE; + return 0 ; +} + + +/* Reset the Cold Load Stream's channel */ + +void ResetColdLoadChannel (EmbChannel* channel) +{ + register EmbColdLoadChannel* coldLoadChannel = (EmbColdLoadChannel*) channel; + + ResetIncomingQueue ((EmbQueue*) HostPointer (coldLoadChannel->display_output_queue)); + ResetOutgoingQueue ((EmbQueue*) HostPointer (coldLoadChannel->keyboard_input_queue)); + coldLoadChannel->progress_note.string_length = 0; /* Flush any progress note */ + coldLoadChannel->is_selected = FALSE; + coldLoadChannel->command_history_top = 0; /* Flush the cold load's history */ + coldLoadChannel->command_history_wrapped = FALSE; +} + + +/* Cleanup the Cold Load Stream's channel */ + +void TerminateColdLoadChannel () { + // void *exit_value; + + visibility = 0 ; // to stop output for run_lights et al + + if (cold_channel && cold_channel->coldLoadInputSetup) { + pthread_cancel (cold_channel->coldLoadInput); + pthread_cancel (plightsThread); + pthread_join (cold_channel->coldLoadInput, NULL); + cold_channel->coldLoadInputSetup = FALSE; +// fprintf ( stderr, "after join input\n"); + pthread_join (plightsThread, NULL); + } + stop_cold_x (); +} + +void __attribute__ ((constructor)) cold_load_init(void); +void cold_load_init( void ) { + + XInitThreads() ; + + if (haveXcb == XcbUnknown) { + if (dlsym(RTLD_NEXT,"xcb_disconnect")) { + haveXcb = XcbLoaded ; + vwarn("cold load init","using Xlib with xcb"); + } else { + haveXcb = XcbNotLoaded ; + vwarn("cold load init","using Xlib without xcb"); + } + } +} +// jj diff --git a/life-support/cold_load_keymappings.h b/life-support/cold_load_keymappings.h new file mode 100644 index 0000000..3e4148d --- /dev/null +++ b/life-support/cold_load_keymappings.h @@ -0,0 +1,289 @@ +#ifndef _COLD_LOAD_KEYMAPPINGS_ +#define COLD_LOAD_KEYMAPPINGS_ + +#define XK_MISCELLANY +#define XK_XKB_KEYS +#define XK_LATIN1 +#include +#include + +/* Keyboard mappings for the Cold Load window for various keyboard types */ + +enum KeyboardType { + Unknown, + DEC_LK401, + DEC_PC, + Apple_Pro, + German, + Us + }; + +typedef struct { + short code; + KeySym keysym; +} coldmapentry; + +typedef struct { + KeySym code; + KeySym keysym; +} isol3mapentry; + + +/* DEC LK401 keyboard */ + +static coldmapentry coldmapDECLK[] = { + { SK_Rubout, XK_Delete }, + { SK_Help, XK_Help }, + { SK_Backspace, XK_BackSpace }, + { SK_Backspace, DXK_Remove }, + { SK_Tab, XK_Tab }, + { SK_Line, XK_Linefeed }, + { SK_Return, XK_Return }, + { SK_Escape, XK_Escape }, + { SK_Complete, XK_Find }, + { SK_Line, XK_Insert }, + { SK_Select, XK_Select }, + { SK_Scroll, XK_Next }, + { SK_End, XK_Menu }, + { SK_End, XK_KP_Enter }, + { SK_Refresh, XK_KP_F1 }, + { SK_Page, XK_KP_F2 }, + { -1, -1} }; + +static short fkmapDECLK[] = { + SK_Function, SK_Function, /* F1 */ + SK_Escape, SK_Escape, /* F2 */ + /* F3-F5 are intercepted by DEC's window manager and, therefore, aren't usable in Genera */ + -1, -1, /* F3 */ + -1, -1, /* F4 */ + -1, -1, /* F5 */ + SK_Network, SK_Network, /* F6 */ + /* F7-F11 are intercepted by DEC's window manager and, therefore, aren't usable in Genera */ + -1, -1, /* F7 */ + -1, -1, /* F8 */ + -1, -1, /* F9 */ + -1, -1, /* F10 */ + -1, -1, /* F11 */ + SK_Square, SK_Square, /* F12 */ + SK_Circle, SK_Circle, /* F13 */ + SK_Triangle, SK_Triangle, /* F14 */ + SK_Help, SK_Help, /* F15 (Help) */ + SK_End, SK_End, /* F16 (Menu or Do) */ + SK_Clear_Input, SK_Clear_Input, /* F17 */ + SK_Suspend, SK_Suspend, /* F18 */ + SK_Resume, SK_Resume, /* F19 */ + SK_Abort, SK_Abort, /* F20 */ + /* F21-F23 do not exist on DEC keyboards */ + -1, -1, /* F21 */ + -1, -1, /* F22 */ + -1, -1, /* F23 */ + }; + + +/* DEC PC-style keyboard */ + +static coldmapentry coldmapDECPC[] = { + { SK_Rubout, XK_Delete }, + { SK_Help, XK_Insert }, + { SK_Backspace, XK_BackSpace }, + { SK_Backspace, DXK_Remove }, + { SK_Tab, XK_Tab }, + { SK_Line, XK_Linefeed }, + { SK_Line, XK_Right }, + { SK_Return, XK_Return }, + { SK_Escape, XK_Escape }, + { SK_Complete, XK_Find }, + { SK_Complete, XK_Home }, + { SK_Line, XK_Right }, + { SK_Select, XK_Select }, + { SK_Scroll, XK_Next }, + { SK_End, XK_Menu }, + { SK_End, XK_KP_Enter }, + { SK_Refresh, XK_KP_F1 }, + { SK_Page, XK_KP_F2 }, + { SK_Page, XK_Page_Up }, + { SK_Suspend, XK_KP_Divide }, + { SK_Resume, XK_KP_Multiply }, + { SK_Abort, XK_KP_Subtract }, + { -1, -1} }; + +static short fkmapDECPC[] = { + SK_Select, SK_Select, /* F1 */ + SK_Function, SK_Function, /* F2 */ + SK_Network, SK_Network, /* F3 */ + SK_Escape, SK_Escape, /* F4 */ + SK_Refresh, SK_Refresh, /* F5 */ + SK_Square, SK_Square, /* F6 */ + SK_Circle, SK_Circle, /* F7 */ + SK_Triangle, SK_Triangle, /* F8 */ + SK_Clear_Input, SK_Clear_Input, /* F9 */ + -1, -1, /* F10 */ + SK_Help, SK_Help, /* F11 */ + SK_Backspace, SK_Backspace, /* F12 */ + -1, -1, /* F13 */ + -1, -1, /* F14 */ + SK_Help, SK_Help, /* F15 */ + SK_End, SK_End, /* F16 */ + SK_Clear_Input, SK_Clear_Input, /* F17 */ + SK_Suspend, SK_Suspend, /* F18 */ + SK_Resume, SK_Resume, /* F19 */ + SK_Abort, SK_Abort, /* F20 */ + -1, -1, /* F21 */ + -1, -1, /* F22 */ + -1, -1, /* F23 */ + }; + + +/* Apple Keyboard */ + +/* No mappings for -- SK_Square, SK_Circle, SK_Triangle, SK_Clear_Input */ +static coldmapentry coldmapApple[] = { + { SK_Clear_Input, 0 }, + { SK_Rubout, XK_Delete }, + { SK_Help, XK_Insert }, + { SK_Backspace, XK_BackSpace }, + { SK_Tab, XK_Tab }, + { SK_Line, XK_Right }, + { SK_Return, XK_Return }, + { SK_Escape, XK_Escape }, + { SK_Complete, XK_Home }, + { SK_End, XK_End }, + { SK_Scroll, XK_KP_Enter }, + { SK_Page, XK_Prior }, + { SK_Suspend, XK_KP_Equal }, + { SK_Resume, XK_KP_Divide }, + { SK_Abort, XK_KP_Multiply }, + { -1, -1} }; + +static short fkmapApple[] = { + SK_Select, SK_Select, /* F1 */ + SK_Function, SK_Function, /* F2 */ + SK_Network, SK_Network, /* F3 */ + SK_Refresh, SK_Refresh, /* F4 */ + -1, -1, /* F5 */ + -1, -1, /* F6 */ + -1, -1, /* F7 */ + -1, -1, /* F8 */ + -1, -1, /* F9 */ + -1, -1, /* F10 */ + -1, -1, /* F11 */ + -1, -1, /* F12 */ + -1, -1, /* F13 */ + -1, -1, /* F14 */ + -1, -1, /* F15 */ + -1, -1, /* F16 */ + -1, -1, /* F17 */ + -1, -1, /* F18 */ + -1, -1, /* F19 */ + -1, -1, /* F20 */ + -1, -1, /* F21 */ + -1, -1, /* F22 */ + -1, -1, /* F23 */ + }; + +/* German Keyboard */ + +static coldmapentry coldmapGerman[] = { + { XK_KP_Begin, XK_ISO_Level3_Shift }, + // SK_Clear_Input, XK_F10, /* Depends on X server */ + { SK_Rubout, XK_Delete }, + // SK_Help, XK_Insert, + { SK_Backspace, XK_BackSpace }, + { SK_Tab, XK_Tab }, + // SK_Line, XK_Right, + { SK_Return, XK_Return }, + { SK_Escape, XK_Escape }, + // SK_Complete, XK_Home, + { SK_End, XK_End }, + // SK_Scroll, XK_KP_Enter, + { SK_Page, XK_Prior }, + // SK_Suspend, XK_KP_Equal, + // SK_Resume, XK_KP_Divide, + // SK_Abort, XK_KP_Multiply, + { -1, -1} }; + +static short fkmapGerman[] = { + SK_Select, SK_Square, /* F1 */ + SK_Network, SK_Circle, /* F2 */ + SK_Function, SK_Triangle, /* F3 */ + SK_Suspend, SK_Suspend, /* F4 */ + SK_Resume, SK_Resume, /* F5 */ + SK_Abort, SK_Abort, /* F6 */ + SK_Help, SK_Help, /* F7 */ + SK_Refresh, SK_Refresh, /* F8 */ + SK_Scroll, SK_Page, /* F9 */ + SK_Clear_Input, SK_Clear_Input, /* F10 */ + SK_Complete, SK_End, /* F11 */ + SK_Help, SK_Help, /* F12 */ + -1, -1, /* F13 */ + -1, -1, /* F14 */ + -1, -1, /* F15 */ + -1, -1, /* F16 */ + -1, -1, /* F17 */ + -1, -1, /* F18 */ + -1, -1, /* F19 */ + -1, -1, /* F20 */ + -1, -1, /* F21 */ + -1, -1, /* F22 */ + -1, -1, /* F23 */ + }; + +/* US Keyboard */ + +static coldmapentry coldmapUs[] = { + { XK_KP_Begin, XK_ISO_Level3_Shift }, + // SK_Clear_Input, XK_F10, /* Depends on X server */ + { SK_Rubout, XK_Delete }, + // SK_Help, XK_Insert, + { SK_Backspace, XK_BackSpace }, + { SK_Tab, XK_Tab }, + // SK_Line, XK_Right, + { SK_Return, XK_Return }, + { SK_Escape, XK_Escape }, + // SK_Complete, XK_Home, + { SK_End, XK_End }, + // SK_Scroll, XK_KP_Enter, + { SK_Page, XK_Prior }, + // SK_Suspend, XK_KP_Equal, + // SK_Resume, XK_KP_Divide, + // SK_Abort, XK_KP_Multiply, + { -1, -1} }; + +static short fkmapUs[] = { + SK_Select, SK_Square, /* F1 */ + SK_Network, SK_Circle, /* F2 */ + SK_Function, SK_Triangle, /* F3 */ + SK_Suspend, SK_Suspend, /* F4 */ + SK_Resume, SK_Resume, /* F5 */ + SK_Abort, SK_Abort, /* F6 */ + SK_Help, SK_Help, /* F7 */ + SK_Refresh, SK_Refresh, /* F8 */ + SK_Scroll, SK_Page, /* F9 */ + SK_Clear_Input, SK_Clear_Input, /* F10 */ + SK_Complete, SK_End, /* F11 */ + SK_Help, SK_Help, /* F12 */ + -1, -1, /* F13 */ + -1, -1, /* F14 */ + -1, -1, /* F15 */ + -1, -1, /* F16 */ + -1, -1, /* F17 */ + -1, -1, /* F18 */ + -1, -1, /* F19 */ + -1, -1, /* F20 */ + -1, -1, /* F21 */ + -1, -1, /* F22 */ + -1, -1, /* F23 */ + }; + +/* static isol3mapentry isol3Map[] = { */ +/* { XK_at , XK_q }, /\* @ : q *\/ */ +/* { XK_bracketleft , XK_8 }, /\* [ : 8 *\/ */ +/* { XK_bracketright , XK_9 }, /\* ] : 9 *\/ */ +/* { XK_braceleft, XK_7 }, /\* { : 7 *\/ */ +/* { XK_braceright, XK_0 }, /\* } : 0 *\/ */ +/* { XK_backslash, XK_ssharp }, /\* \ : ß *\/ */ +/* { XK_asciitilde, XK_plus }, /\* ~ : + *\/ */ +/* { XK_bar, XK_less }, /\* | : < *\/ */ +/* { -1, -1 } */ +/* }; */ +#endif diff --git a/life-support/console.c b/life-support/console.c new file mode 100644 index 0000000..87e89a8 --- /dev/null +++ b/life-support/console.c @@ -0,0 +1,831 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Console Life Support -- EXPLANATION */ +#define _GNU_SOURCE + +#include "config.h" +#include "std.h" + +#include +#include +#include +// jj +#if HAVE_X11_XLIB_XCB_H +#include +#else +#error need Xlib-xcb.h to compile +#endif +#if HAVE_DLFCN_H +#include +#else +#error need dlfcn.h to compile +#endif +// jj +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "memory.h" +#include "utilities.h" + + +/* Create the console channel */ + +void InitializeConsoleChannel (VLMConfig* config) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbConsoleChannel)); + register EmbConsoleChannel *p = (EmbConsoleChannel*) HostPointer (cp); + + p->type = EmbConsoleChannelType; + p->unit = 0; + p->next = EmbCommAreaPtr->channel_table; /* Thread into list of all channels */ + EmbCommAreaPtr->channel_table = cp; + EmbCommAreaPtr->consoleChannel = cp; /* Make it easy to find */ + + p->outputRequestQueue = CreateQueue (ConsoleOutputQueueSize, sizeof (EmbPtr)); + p->outputRequestQ = (EmbQueue*) HostPointer (p->outputRequestQueue); + p->outputRequestQ->signal = InstallSignalHandler((ProcPtrV)&ConsoleOutput, (PtrV)p, FALSE); + p->outputReplyQueue = CreateQueue (ConsoleOutputQueueSize, sizeof (EmbPtr)); + p->outputReplyQ = (EmbQueue*) HostPointer (p->outputReplyQueue); + + p->inputRequestQueue = CreateQueue (ConsoleInputQueueSize, sizeof (EmbPtr)); + p->inputRequestQ = (EmbQueue*) HostPointer (p->inputRequestQueue); + p->inputRequestQ->signal = InstallSignalHandler ((ProcPtrV) &ConsoleInput, (PtrV) p, TRUE); + p->inputReplyQueue = CreateQueue (ConsoleInputQueueSize, sizeof (EmbPtr)); + p->inputReplyQ = (EmbQueue*) HostPointer (p->inputReplyQueue); + + p->hostName = config->generaXParams.xpHostName; + p->hostAddress = htonl (config->generaXParams.xpHostAddress); + p->displayNumber = config->generaXParams.xpDisplay; + p->screenNumber = config->generaXParams.xpScreen; + p->initialState = config->generaXParams.xpInitialState; + p->geometry = MakeEmbString (config->generaXParams.xpGeometry); + p->foregroundColor = MakeEmbString (config->generaXParams.xpForegroundColor); + p->backgroundColor = MakeEmbString (config->generaXParams.xpBackgroundColor); + p->borderColor = MakeEmbString (config->generaXParams.xpBorderColor); + p->borderWidth = config->generaXParams.xpBorderWidth; + + p->display = NULL; + p->openingState = OpeningStateNone; + p->rlDisplay = NULL; + + if (pthread_create (&p->drawRunLights, &EmbCommAreaPtr->pollThreadAttrs, + (pthread_startroutine_t) &DrawRunLights, p)) + vpunt (NULL, "Unable to create the console channel polling thread"); + p->drawRunLightsSetup = TRUE; +} + + +/* Do console I/O -- Available as a coprocessor call */ + +void DoConsoleIO (EmbConsoleChannel* consoleChannel, EmbConsoleBuffer* pCommand) +{ + register EmbConsoleBuffer* command = pCommand; + + switch (command->opcode) + { + case EmbConsoleCommandOpenDisplay: + command->result = OpenDisplay (consoleChannel, command); + break; + + case EmbConsoleCommandCloseDisplay: + CloseDisplay (consoleChannel); + command->result = ESUCCESS; + break; + + case EmbConsoleCommandNoOp: + command->result = ESUCCESS; + break; + + case EmbConsoleCommandWrite: + if (OpeningStatePrefix == consoleChannel->openingState) + command->result = ESUCCESS; + else + command->result = ConsoleWrite (consoleChannel, command); + break; + + case EmbConsoleCommandRead: + if (consoleChannel->openingState != OpeningStateNone) + command->result = ProcessConnectionRequest (consoleChannel, command); + else + command->result = ConsoleRead (consoleChannel, command); + break; + + case EmbConsoleCommandInputWait: + if (consoleChannel->openingState != OpeningStateNone) + { + ((EmbConsoleInputWait*)&command->data[0])->availableP = TRUE; + command->result = ESUCCESS; + } + else + command->result = ConsoleInputWait (consoleChannel, command); + break; + + case EmbConsoleCommandEnableRunLights: + EnableRunLights (consoleChannel, command); + command->result = ESUCCESS; + break; + + case EmbConsoleCommandDisableRunLights: + DisableRunLights (consoleChannel); + command->result = ESUCCESS; + break; + } +} + + +/* Process requests from the VLM */ + +void ConsoleDriver (EmbConsoleChannel* consoleChannel, + EmbQueue* pRequestQueue, EmbQueue* pReplyQueue) +{ + register EmbQueue* requestQueue = pRequestQueue; + register EmbQueue* replyQueue = pReplyQueue; + register EmbConsoleBuffer* command; + EmbPtr commandPtr; + + while (EmbQueueFilled (requestQueue)) + { + if (0 == EmbQueueSpace (replyQueue)) + { + /* Can't do I/O now -- Ask to be invoked again on the next "clock tick" */ + SignalLater (requestQueue->signal); + return; + } + + commandPtr = EmbQueueTakeWord (requestQueue); + if (commandPtr) + { + command = (EmbConsoleBuffer*) HostPointer (commandPtr); + DoConsoleIO (consoleChannel, command); + EmbQueuePutWord (replyQueue, commandPtr); + } + } +} + + +/* Actual signal handlers for the output and input request queues */ + +void ConsoleOutput (EmbConsoleChannel* consoleChannel) +{ + ConsoleDriver (consoleChannel, + consoleChannel->outputRequestQ, consoleChannel->outputReplyQ); +} + +void ConsoleInput (EmbConsoleChannel* consoleChannel) +{ + ConsoleDriver (consoleChannel, consoleChannel->inputRequestQ, consoleChannel->inputReplyQ); +} + + +/* Open the display */ + +int OpenDisplay (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand) +{ + register EmbConsoleChannel* consoleChannel = pConsoleChannel; + register EmbConsoleBuffer* command = pCommand; + register EmbConsoleOpenDisplay* openDisplay = (EmbConsoleOpenDisplay*) &command->data[0]; + char displayName[BUFSIZ]; + int result; + + if (consoleChannel->display != NULL) + return (EBUSY); + + BuildXDisplayName (displayName, + consoleChannel->hostName, + consoleChannel->displayNumber, + consoleChannel->screenNumber); + + begin_MUTEX_LOCKED (XLock); + + consoleChannel->display = XOpenDisplay (displayName); + + if (consoleChannel->display) + { + consoleChannel->fd = XConnectionNumber ((Display*) consoleChannel->display); + consoleChannel->openingState = OpeningStatePrefix; + openDisplay->lastRequestNumber = ((struct _XDisplay*)consoleChannel->display)->request; + result = ESUCCESS; + } + + else + { + result = errno; + switch (result) + { + case ESUCCESS: + result = ECONNREFUSED; + break; + case EWOULDBLOCK: + result = ENXIO; + break; + } + } + + end_MUTEX_LOCKED (XLock); + + return (result); +} + + +/* Process the individual parts of a connection request -- When opening a display, Lisp + will send a connection setup request. Because X doesn't permit said request to be + issued twice, we intercept it and return the data that it would have returned as derived + from internal data structures. A finite-state machine is used to determine what + piece of data will be returned next */ + +int ProcessConnectionRequest (EmbConsoleChannel* pConsoleChannel, + EmbConsoleBuffer* pCommand) +{ + register EmbConsoleChannel* consoleChannel = pConsoleChannel; + register EmbConsoleBuffer* command = pCommand; + EmbConsoleDataTransfer* dataTransfer = (EmbConsoleDataTransfer*) &command->data[0]; + register struct _XDisplay* display = (struct _XDisplay*) consoleChannel->display; + char* data; + xConnSetupPrefix setupPrefix; + xConnSetup setup; + xPixmapFormat pixmapFormat; + ScreenFormat* screenFormat; + xWindowRoot windowRoot; + Screen* screen; + xDepth pDepth; + Depth* depth; + xVisualType visualType; + Visual* visual; + + data = (char*) MapVirtualAddressData (dataTransfer->address); + data += dataTransfer->offset; + + switch (consoleChannel->openingState) + { + case OpeningStatePrefix: + setupPrefix.success = TRUE; + setupPrefix.lengthReason = 0; + setupPrefix.majorVersion = display->proto_major_version; + setupPrefix.minorVersion = display->proto_minor_version; + setupPrefix.length = 0; /* Genera ignores it */ + memcpy (data, &setupPrefix, sizeof (xConnSetupPrefix)); + AdvanceOpeningState (consoleChannel); + break; + + case OpeningStateHeader: + setup.release = display->release; + setup.ridBase = display->resource_base; + setup.ridMask = display->resource_mask; + setup.motionBufferSize = display->motion_buffer; + setup.nbytesVendor = strlen (display->vendor); + setup.maxRequestSize = display->max_request_size; + setup.numRoots = display->nscreens; + setup.numFormats = display->nformats; + setup.imageByteOrder = display->byte_order; + setup.bitmapBitOrder = display->bitmap_bit_order; + setup.bitmapScanlineUnit = display->bitmap_unit; + setup.bitmapScanlinePad = display->bitmap_pad; + setup.minKeyCode = display->min_keycode; + setup.maxKeyCode = display->max_keycode; + memcpy (data, &setup, sizeof (xConnSetup)); + AdvanceOpeningState (consoleChannel); + break; + + case OpeningStateVendor: + memcpy (data, display->vendor, strlen (display->vendor)); + AdvanceOpeningState (consoleChannel); + break; + + case OpeningStatePixmapFormat: + screenFormat = &display->pixmap_format[consoleChannel->nextPixmapFormat]; + pixmapFormat.depth = screenFormat->depth; + pixmapFormat.bitsPerPixel = screenFormat->bits_per_pixel; + pixmapFormat.scanLinePad = screenFormat->scanline_pad; + memcpy (data, &pixmapFormat, sizeof (xPixmapFormat)); + AdvanceOpeningState (consoleChannel); + break; + + case OpeningStateRoot: + screen = &display->screens[consoleChannel->nextRoot]; + windowRoot.windowId = screen->root; + windowRoot.defaultColormap = screen->cmap; + windowRoot.whitePixel = screen->white_pixel; + windowRoot.blackPixel = screen->black_pixel; + windowRoot.currentInputMask = screen->root_input_mask; + windowRoot.pixWidth = screen->width; + windowRoot.pixHeight = screen->height; + windowRoot.mmWidth = screen->mwidth; + windowRoot.mmHeight = screen->mheight; + windowRoot.minInstalledMaps = screen->min_maps; + windowRoot.maxInstalledMaps = screen->max_maps; + windowRoot.rootVisualID = screen->root_visual->visualid; + windowRoot.backingStore = screen->backing_store; + windowRoot.saveUnders = screen->save_unders; + windowRoot.rootDepth = screen->root_depth; + windowRoot.nDepths = screen->ndepths; + memcpy (data, &windowRoot, sizeof (xWindowRoot)); + AdvanceOpeningState (consoleChannel); + break; + + case OpeningStateRootDepth: + screen = &display->screens[consoleChannel->nextRoot]; + depth = &screen->depths[consoleChannel->nextRootDepth]; + pDepth.depth = depth->depth; + pDepth.nVisuals = depth->nvisuals; + memcpy (data, &pDepth, sizeof (xDepth)); + AdvanceOpeningState (consoleChannel); + break; + + case OpeningStateRootDepthVisual: + screen = &display->screens[consoleChannel->nextRoot]; + depth = &screen->depths[consoleChannel->nextRootDepth]; + visual = &depth->visuals[consoleChannel->nextRootDepthVisual]; + visualType.visualID = visual->visualid; + visualType.class = visual->class; + visualType.bitsPerRGB = visual->bits_per_rgb; + visualType.colormapEntries = visual->map_entries; + visualType.redMask = visual->red_mask; + visualType.greenMask = visual->green_mask; + visualType.blueMask = visual->blue_mask; + memcpy (data, &visualType, sizeof (xVisualType)); + AdvanceOpeningState (consoleChannel); + break; + } + + return (ESUCCESS); +} + + +/* Advance to the next appropriate state of connection request processing */ + +void AdvanceOpeningState (EmbConsoleChannel* pConsoleChannel) +{ + register EmbConsoleChannel* consoleChannel = pConsoleChannel; + register struct _XDisplay* display = (struct _XDisplay*) consoleChannel->display; + Screen* screen; + Depth* depth; + + switch (consoleChannel->openingState) + { + case OpeningStatePrefix: + consoleChannel->openingState = OpeningStateHeader; + break; + + case OpeningStateHeader: + consoleChannel->openingState = OpeningStateVendor; + break; + + case OpeningStateVendor: + if (display->nformats > 0) + { + consoleChannel->openingState = OpeningStatePixmapFormat; + consoleChannel->nextPixmapFormat = 0; + } + else if (display->nscreens > 0) + { + consoleChannel->openingState = OpeningStateRoot; + consoleChannel->nextRoot = 0; + } + else + consoleChannel->openingState = OpeningStateNone; + break; + + case OpeningStatePixmapFormat: + consoleChannel->nextPixmapFormat++; + if (consoleChannel->nextPixmapFormat >= display->nformats) { + if (display->nscreens > 0) + { + consoleChannel->openingState = OpeningStateRoot; + consoleChannel->nextRoot = 0; + } + else + consoleChannel->openingState = OpeningStateNone; + } + break; + + case OpeningStateRoot: + screen = &display->screens[consoleChannel->nextRoot]; + if (screen->ndepths > 0) + { + consoleChannel->openingState = OpeningStateRootDepth; + consoleChannel->nextRootDepth = 0; + } + else + { + consoleChannel->nextRoot++; + if (consoleChannel->nextRoot >= display->nscreens) + consoleChannel->openingState = OpeningStateNone; + } + break; + + case OpeningStateRootDepth: + screen = &display->screens[consoleChannel->nextRoot]; + depth = &screen->depths[consoleChannel->nextRootDepth]; + if (depth->nvisuals > 0) + { + consoleChannel->openingState = OpeningStateRootDepthVisual; + consoleChannel->nextRootDepthVisual = 0; + } + else + { + consoleChannel->nextRootDepth++; + if (consoleChannel->nextRootDepth >= screen->ndepths) + { + consoleChannel->nextRoot++; + if (consoleChannel->nextRoot >= display->nscreens) + consoleChannel->openingState = OpeningStateNone; + } + } + break; + + case OpeningStateRootDepthVisual: + screen = &display->screens[consoleChannel->nextRoot]; + depth = &screen->depths[consoleChannel->nextRootDepth]; + consoleChannel->nextRootDepthVisual++; + if (consoleChannel->nextRootDepthVisual >= depth->nvisuals) + { + consoleChannel->nextRootDepth++; + if (consoleChannel->nextRootDepth >= screen->ndepths) + { + consoleChannel->nextRoot++; + if (consoleChannel->nextRoot >= display->nscreens) + consoleChannel->openingState = OpeningStateNone; + else + consoleChannel->openingState = OpeningStateRoot; + } + else + { + consoleChannel->openingState = OpeningStateRootDepth; + } + } + break; + } +} + + +/* Write data to the server */ + +int ConsoleWrite (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand) +{ + register EmbConsoleChannel* consoleChannel = pConsoleChannel; + register EmbConsoleBuffer* command = pCommand; + register EmbConsoleDataTransfer* dataTransfer = (EmbConsoleDataTransfer*) &command->data[0]; + struct pollfd pollDisplay; + char* data; + ssize_t nBytes, actualBytes; + int result; + + data = (char*) MapVirtualAddressData (dataTransfer->address); + data += dataTransfer->offset; + nBytes = dataTransfer->nBytes; + + result = EWOULDBLOCK; + pollDisplay.fd = consoleChannel->fd; + pollDisplay.events = POLLOUT; + + while (EWOULDBLOCK == result) + { + pthread_testcancel (); + + pollDisplay.revents = 0; + poll (&pollDisplay, 1, 1000); + + if (pollDisplay.revents & POLLOUT) + { + actualBytes = write (consoleChannel->fd, data, nBytes); + if (actualBytes == nBytes) + result = ESUCCESS; + else + { + /* Might be a partial write */ + result = (actualBytes < 0) ? errno : EWOULDBLOCK; + nBytes -= (actualBytes < 0) ? 0 : actualBytes; + data += (actualBytes < 0) ? 0 : actualBytes; + } + } + + else if (pollDisplay.revents & POLLNVAL) + result = EBADF; + + else if (pollDisplay.revents & POLLHUP) + result = ENXIO; + + else if (pollDisplay.revents & POLLERR) + result = EIO; + } + + return (result); +} + + +/* Read data from the server */ + +int ConsoleRead (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand) +{ + register EmbConsoleChannel* consoleChannel = pConsoleChannel; + register EmbConsoleBuffer* command = pCommand; + register EmbConsoleDataTransfer* dataTransfer = (EmbConsoleDataTransfer*) &command->data[0]; + struct pollfd pollDisplay; + char* data; + ssize_t nBytes, actualBytes; + int result; + + data = (char*) MapVirtualAddressData (dataTransfer->address); + data += dataTransfer->offset; + nBytes = dataTransfer->nBytes; + + result = EWOULDBLOCK; + pollDisplay.fd = consoleChannel->fd; + pollDisplay.events = POLLIN; + + while (EWOULDBLOCK == result) + { + pthread_testcancel (); + + pollDisplay.revents = 0; + poll (&pollDisplay, 1, 1000); + + if (pollDisplay.revents & POLLIN) + { + actualBytes = read (consoleChannel->fd, data, nBytes); + if (actualBytes == nBytes) + result = ESUCCESS; + else if ((0 == actualBytes) && (EWOULDBLOCK != errno)) + result = ENOSPC; /* End-of-File */ + else + { + /* Might be a partial read */ + result = (actualBytes < 0) ? errno : EWOULDBLOCK; + nBytes -= (actualBytes < 0) ? 0 : actualBytes; + data += (actualBytes < 0) ? 0 : actualBytes; + } + } + + else if (pollDisplay.revents & POLLNVAL) + result = EBADF; + + else if (pollDisplay.revents & POLLHUP) + result = ENXIO; + + else if (pollDisplay.revents & POLLERR) + result = EIO; + } + + return (result); +} + + +/* Check if input is available in response to a CoprocessorRead by the VLM */ + +boolean ConsoleInputAvailableP () +{ + EmbConsoleChannel* consoleChannel = (EmbConsoleChannel*) HostPointer (EmbCommAreaPtr->consoleChannel); + struct pollfd pollDisplay; + + if (NULL == consoleChannel->display) + return (FALSE); + + else if (consoleChannel->openingState != OpeningStateNone) + return (TRUE); + + pollDisplay.fd = consoleChannel->fd; + pollDisplay.events = POLLIN; + pollDisplay.revents = 0; + poll (&pollDisplay, 1, 0); + return ((pollDisplay.revents & POLLIN) != 0); +} + + +/* Wait until data is available from the server */ + +int ConsoleInputWait (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand) +{ + register EmbConsoleChannel* consoleChannel = pConsoleChannel; + register EmbConsoleBuffer* command = pCommand; + register EmbConsoleInputWait* inputWait = (EmbConsoleInputWait*) &command->data[0]; + struct pollfd pollDisplay; + int result; + + pollDisplay.fd = consoleChannel->fd; + pollDisplay.events = POLLIN; + pollDisplay.revents = 0; + + result = poll (&pollDisplay, 1, inputWait->timeout); + + if (0 == result) + { + result = ESUCCESS; + inputWait->availableP = FALSE; + } + + else if (pollDisplay.revents & POLLIN) + { + result = ESUCCESS; + inputWait->availableP = TRUE; + } + + else if (pollDisplay.revents & POLLNVAL) + result = EBADF; + + else if (pollDisplay.revents & POLLHUP) + result = ENXIO; + + else if (pollDisplay.revents & POLLERR) + result = EIO; + + return (result); +} + + +/* Close the display if open */ +// jj +extern enum xcbvals { XcbUnknown, XcbLoaded, XcbNotLoaded } haveXcb ; +// jj +void CloseDisplay (EmbConsoleChannel* consoleChannel) +{ + static void *handle ; + static void (*xcbflush)(xcb_connection_t *conn) ; + static void (*xcbdisconnect)(xcb_connection_t *conn); + static xcb_connection_t* (*xgetxcbconnection)(Display *dpy); + + DisableRunLights (consoleChannel); + + if (consoleChannel->display != NULL) + { + begin_MUTEX_LOCKED (XLock); + // jj + handle = dlopen("libX11-xcb.so.1", RTLD_LAZY ); +// fprintf(stderr,"handle =%p\n", handle); + if (haveXcb == XcbLoaded) { + xcb_connection_t *c ; + + if (xgetxcbconnection == NULL) + xgetxcbconnection = dlsym( handle, "XGetXCBConnection"); + if (xcbflush == NULL) xcbflush = dlsym( RTLD_NEXT, "xcb_flush"); + if (xcbdisconnect == NULL) + xcbdisconnect = dlsym( RTLD_NEXT, "xcb_disconnect"); + +// fprintf(stderr,"xgetxcbconnection = %p\n",xgetxcbconnection); + c = xgetxcbconnection(consoleChannel->display); + xcbflush(c); + xcbdisconnect(c); + } else XCloseDisplay ((Display*) consoleChannel->display); + // jj + consoleChannel->display = NULL; + end_MUTEX_LOCKED (XLock); + } +} + + +/* Enable drawing of run lights */ + +void EnableRunLights (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand) +{ + register EmbConsoleChannel* consoleChannel = pConsoleChannel; + register EmbConsoleBuffer* command = pCommand; + EmbConsoleRunLights* runLights = (EmbConsoleRunLights*) &command->data[0]; + char displayName[BUFSIZ]; + XGCValues gcValues; + + BuildXDisplayName (displayName, consoleChannel->hostName, consoleChannel->displayNumber, + consoleChannel->screenNumber); + + begin_MUTEX_LOCKED (XLock); + + consoleChannel->rlDisplay = XOpenDisplay (displayName); + + if (NULL != consoleChannel->rlDisplay) + { + consoleChannel->rlGC = malloc (sizeof (GC)); + + if (NULL != consoleChannel->rlGC) + { + memcpy (&consoleChannel->runLights, runLights, sizeof (EmbConsoleRunLights)); + + gcValues.foreground = consoleChannel->runLights.lightForeground; + gcValues.background = consoleChannel->runLights.lightBackground; + gcValues.plane_mask = consoleChannel->runLights.lightPlaneMask; + *(GC*) consoleChannel->rlGC = XCreateGC (consoleChannel->rlDisplay, + consoleChannel->runLights.windowID, + (GCForeground | GCBackground | GCPlaneMask), + &gcValues); + } + } + + end_MUTEX_LOCKED (XLock); + + consoleChannel->lastRunLights = 0; +} + + +/* Periodically update the run lights, if enabled */ + +#define OneOneHundrethSecond 10000000L + +void DrawRunLights (pthread_addr_t argument) +{ + register EmbConsoleChannel* consoleChannel = (EmbConsoleChannel*) argument; + pthread_t self = pthread_self (); + struct timespec drlSleep; + int changed, i, bit, x; + + // pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + + WaitUntilInitializationComplete (); + + drlSleep.tv_sec = 0; + drlSleep.tv_nsec = 10 * OneOneHundrethSecond; /* 10 Hz */ + + while (TRUE) + { + begin_MUTEX_LOCKED (XLock); + if (consoleChannel->rlDisplay != NULL) + { + changed = consoleChannel->lastRunLights ^ EmbCommAreaPtr->run_lights; + consoleChannel->lastRunLights = EmbCommAreaPtr->run_lights; + x = consoleChannel->runLights.firstLightX; + + for (i = 0, bit = 1, x = consoleChannel->runLights.firstLightX; + i < consoleChannel->runLights.nLights; + i++, bit = bit << 1, x += consoleChannel->runLights.lightXSpacing) + if (changed & bit) { + if (consoleChannel->lastRunLights & bit) + XFillRectangle (consoleChannel->rlDisplay, + consoleChannel->runLights.windowID, + *(GC*) consoleChannel->rlGC, x, + consoleChannel->runLights.firstLightY, + consoleChannel->runLights.lightWidth, + consoleChannel->runLights.lightHeight); + else + XClearArea (consoleChannel->rlDisplay, + consoleChannel->runLights.windowID, x, + consoleChannel->runLights.firstLightY, + consoleChannel->runLights.lightWidth, + consoleChannel->runLights.lightHeight, FALSE); + } + XFlush (consoleChannel->rlDisplay); + + } + end_MUTEX_LOCKED (XLock); + + if (pthread_delay_np (&drlSleep)) + vpunt (NULL, "Unable to sleep in thread %lx", self); + } + + // pthread_cleanup_pop (TRUE); +} + + +/* Disable drawing of run lights */ + +void DisableRunLights (EmbConsoleChannel* consoleChannel) +{ + begin_MUTEX_LOCKED (XLock); + + if (consoleChannel->rlGC != NULL) + { + free (consoleChannel->rlGC); + consoleChannel->rlGC = NULL; + } + + if (consoleChannel->rlDisplay != NULL) + { + XCloseDisplay ((Display*) consoleChannel->rlDisplay); + consoleChannel->rlDisplay = NULL; + } + + end_MUTEX_LOCKED (XLock); +} + + +/* Reset the console channel */ + +void ResetConsoleChannel (EmbChannel* channel) +{ + register EmbConsoleChannel* consoleChannel = (EmbConsoleChannel*) channel; + + ResetIncomingQueue (consoleChannel->outputRequestQ); + ResetOutgoingQueue (consoleChannel->outputReplyQ); + ResetIncomingQueue (consoleChannel->inputRequestQ); + ResetOutgoingQueue (consoleChannel->inputReplyQ); + CloseDisplay (consoleChannel); +} + + +/* Cleanup the console channel */ + +void TerminateConsoleChannel (void) +{ + void *exit_value; + register EmbConsoleChannel* consoleChannel; + + if (NullEmbPtr == EmbCommAreaPtr->consoleChannel) + return; + else + consoleChannel = (EmbConsoleChannel*) HostPointer (EmbCommAreaPtr->consoleChannel); + + if (consoleChannel->drawRunLightsSetup) + { + pthread_cancel (consoleChannel->drawRunLights); + pthread_join (consoleChannel->drawRunLights, &exit_value); + consoleChannel->drawRunLightsSetup = FALSE; + } + + CloseDisplay (consoleChannel); +} diff --git a/life-support/disks.c b/life-support/disks.c new file mode 100644 index 0000000..914b03a --- /dev/null +++ b/life-support/disks.c @@ -0,0 +1,477 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Disk Life Support */ + +#include "std.h" + +#include +#include +#ifdef OS_OSF +#include +#endif +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "ivoryrep.h" +#include "memory.h" + +#ifndef S_DEFFILEMODE +#define S_DEFFILEMODE (S_IRUSR|S_IWUSR|S_IRGRP|S_IWGRP|S_IROTH|S_IWOTH) +#endif + +#define DiskPageSize 8192 + + +#define SetHostState(dc,p) \ + { \ + dc->hostState0 = (((uint64_t) p) >> 32) & 0xFFFFFFFFL; \ + dc->hostState1 = ((uint64_t) p) & 0xFFFFFFFFL; \ + } + +#define HostState(dc) \ + (DiskChannelState*)(((uint64_t)dc->hostState0 << 32) | dc->hostState1) + + +/* Attach a disk partition (nee, file) to the disk channel supplied by Lisp and add said + channel to the list of active embedded channels. Lisp will have already setup the + disk channel's unit number, read-only flag, and FIFO queues */ + +void AttachDiskChannel (AttachDiskChannelRequest* pRequest) +{ + register AttachDiskChannelRequest *request = pRequest; + register EmbDiskChannel *diskChannel = (EmbDiskChannel*) HostPointer (request->diskChannel); + register DiskChannelState *diskState; + struct stat fileStatus; + LispObj filenameHeader; + size_t filenameSize; + char *filename; + int openFlags; + int lblocksize = 2048 ; + + request->result = ESUCCESS; /* Presume success */ + request->errorMsg = NullEmbPtr; /* Can't return error messages (yet) */ + + diskState = (DiskChannelState*) malloc (sizeof (DiskChannelState)); + if (NULL == diskState) + { + verror ("AttachDiskChannel", "Couldn't allocate disk channel status structure"); + request->result = ENOMEM; + return; + } + SetHostState (diskChannel, diskState); + + diskState->fd = -1; /* Needed before linking into channel list */ + diskState->command_queue_ptr = (EmbQueue*) HostPointer (diskChannel->command_queue); + diskState->status_queue_ptr = (EmbQueue*) HostPointer (diskChannel->status_queue); + diskState->error_pending = FALSE; + if ((request->blockSize == 0) || + (request->blockSize > 4096) || + (request->blockSize < 0)) + diskChannel->blocksize = lblocksize * 4 ; + else + diskChannel->blocksize = request->blockSize * 4 ; + diskState->blocksize = diskChannel->blocksize ; + + if (Type_String != *MapVirtualAddressTag ((Integer) + ((Integer*)&request->filename - MapVirtualAddressData (0)))) + { + verror ("AttachDiskChannel", "Disk partition filename is not a simple string"); + request->result = EINVAL; + return; + } + + filenameHeader = VirtualMemoryRead (request->filename); + if (Type_HeaderI != (LispObjTag (filenameHeader) & 0x3F)) + { + verror ("AttachDiskChannel", "Disk partition filename is not a simple string"); + request->result = EINVAL; + return; + } + + + if ((LispObjData (filenameHeader) & ~Array_LengthMask) != 0x50000000L) + { + verror ("AttachDiskChannel", "Disk partition filename is not a simple string"); + request->result = EINVAL; + return; + } + + filenameSize = LispObjData (filenameHeader) & Array_LengthMask; + filename = (char*) malloc (filenameSize + 1); + if (NULL == filename) + { + verror ("AttachDiskChannel", + "Couldn't allocate space for local copy of disk partition filename"); + request->result = ENOMEM; + return; + } + + memcpy (filename, MapVirtualAddressData (request->filename + 1), filenameSize); + filename[filenameSize] = 0; + diskState->filename = filename ; + + if (diskChannel->flags.read_only) + openFlags = O_RDONLY; + else + openFlags = O_RDWR; + + if (CreateIfNotFound == request->ifNotFoundAction) + openFlags |= O_CREAT; + + printf("AttachDiskChannel open '%s' with blocks of %u bytes (%d words)\n", + filename, + diskChannel->blocksize, + diskChannel->blocksize / 4 ); + diskState->fd = open (filename, openFlags, S_DEFFILEMODE); + if (-1 == diskState->fd) + { + verror ("AttachDiskChannel", "Unable to open disk partition %s", filename); + request->result = errno; + return; + } + + if (fstat (diskState->fd, &fileStatus)) + { + verror ("AttachDiskChannel", "Unable to determine size of disk partition %s", + filename); + request->result = errno; + close (diskState->fd); + return; + } + + if (request->minimumLength > 0) + if (request->minimumLength > fileStatus.st_size) + { + if (ftruncate (diskState->fd, (off_t) request->minimumLength)) + { + verror ("AttachDiskChannel", + "Unable to set size of disk partition %s to %d bytes", + filename, request->minimumLength); + request->result = errno; + close (diskState->fd); + return; + } + fileStatus.st_size = request->minimumLength; + } + + diskChannel->number_of_pages = fileStatus.st_size / diskChannel->blocksize ; + + diskChannel->next = EmbCommAreaPtr->channel_table; /* Link into the channel list */ + EmbCommAreaPtr->channel_table = GuestPointer (diskChannel); + + diskState->command_queue_ptr->signal = InstallSignalHandler ((ProcPtrV) &DiskLife, + (PtrV) diskChannel, FALSE); + + return; +} + + +/* Grow the file (nee, disk partition) attached to the given disk channel so that it's, + at least the requested number of bytes in length */ + +void GrowDiskPartition (GrowDiskPartitionRequest* pRequest) +{ + register GrowDiskPartitionRequest *request = pRequest; + register EmbDiskChannel *diskChannel = (EmbDiskChannel*) HostPointer (request->diskChannel); + register DiskChannelState *diskState = HostState (diskChannel); + struct stat fileStatus; + + request->result = ESUCCESS; /* Presume success */ + request->errorMsg = NullEmbPtr; /* Can't return error messages (yet) */ + + if (-1 == diskState->fd) + { + verror ("GrowDiskPartition", "There is no disk partition attached to channel #%d", + diskChannel->unit); + request->result = EINVAL; + return; + + } + if (fstat (diskState->fd, &fileStatus)) + { + verror ("GrowDiskPartition", + "Unable to determine size of disk partition attached to channel #%d", + diskChannel->unit); + request->result = errno; + return; + } + + if (request->newLength > fileStatus.st_size) + { + if (ftruncate (diskState->fd, (off_t) request->newLength)) + { + verror ("GrowDiskPartition", + "Unable to set size of disk partition attached to channel #%d to %d bytes", + diskChannel->unit, request->newLength); + request->result = errno; + return; + } + fileStatus.st_size = request->newLength; + } + + diskChannel->number_of_pages = fileStatus.st_size / diskChannel->blocksize ; + + return; +} + + +/* Detach the given disk channel from its disk partition (nee, file) and remove it from + the linked list of active embedded channels */ + +void DetachDiskChannel (EmbPtr diskChannelPtr) +{ + register EmbDiskChannel *diskChannel = (EmbDiskChannel*) HostPointer (diskChannelPtr); + register DiskChannelState *diskState = HostState (diskChannel); + register EmbPtr channelPtr; + register EmbPtr prevChannelPtr; + + + RemoveSignalHandler (diskState->command_queue_ptr->signal); + diskState->command_queue_ptr->signal = -1; + + if (diskState->fd != -1) + { + printf("DetachDiskChannel close '%s' (%d)\n", diskState->filename, diskChannel->unit); + close (diskState->fd); + diskState->fd = -1; + } + + free(diskState->filename); + prevChannelPtr = NullEmbPtr; + channelPtr = EmbCommAreaPtr->channel_table; + + while (channelPtr != NullEmbPtr) + { + if (diskChannelPtr == channelPtr) + { + if (NullEmbPtr == prevChannelPtr) + EmbCommAreaPtr->channel_table = diskChannel->next; + else + ((EmbChannel*)HostPointer(prevChannelPtr))->next = diskChannel->next; + break; + } + prevChannelPtr = channelPtr; + channelPtr = ((EmbChannel*)HostPointer(channelPtr))->next; + } +} + + +/* The actual guts of disk life support -- Process the individual read/write requests */ + +void DiskLife (EmbDiskChannel* diskChannel) +{ + DiskChannelState* diskState = HostState (diskChannel); + register EmbQueue* commandQueue = diskState->command_queue_ptr; + register EmbQueue* statusQueue = diskState->status_queue_ptr; + EmbDiskQueueElement* command; + EmbWord commandPtr; + + while (EmbQueueFilled (commandQueue)) + { + if (EmbCommAreaPtr->inhibitDisk || (0 == EmbQueueSpace (statusQueue))) + { + /* Can't do I/O now -- Ask to be invoked again on the next "clock tick" */ + SignalLater (commandQueue->signal); + return; + } + + commandPtr = EmbQueueTakeWord (commandQueue); + if (commandPtr) + { + command = (EmbDiskQueueElement*) HostPointer (commandPtr); + + switch (command->op.cmd) + { + case WriteCmd: + /* Write one or more pages to disk */ + if (diskChannel->flags.read_only) + { + command->status = LostStatus; + command->error_code = EROFS; + break; + } + /* Fall through to the ReadCmd case */ + + case ReadCmd: + /* Read one or more pages from disk -- The WriteCmd case shares this code */ + if (diskState->error_pending) + command->status = AbortStatus; + else if (-1 == diskState->fd) + { + command->status = LostStatus; + command->error_code = ENXIO; + } + else + { + command->error_code = DoDiskIO (diskChannel, diskState, command); + if (command->error_code) + { + command->status = LostStatus; + diskState->error_pending = TRUE; /* Flush until reset */ + } + else + command->status = WonStatus; + } + break; + + case ResetCmd: + /* Reset the channel after an error */ + diskState->error_pending = FALSE; + command->status = WonStatus; + break; + + case InitializeCmd: + /* Initialize the channel -- Would reset meters if we had any */ + diskState->error_pending = FALSE; + command->status = WonStatus; + break; + + default: + command->status = LostStatus; + command->error_code = ENXIO; + } + + EmbQueuePutWord (statusQueue, commandPtr); + } + } +} + + +/* Perform a single I/O operation -- Splits the command into ... */ + +int DoDiskIO (EmbDiskChannel* diskChannel, DiskChannelState* diskState, + EmbDiskQueueElement* command) +{ + EmbAddressPair *addressPair; + ssize_t nBytes, actualBytes; + off_t startingOffset; + int nAddresses, nVectors, i; + ssize_t btoread, obtoread ; + + if ((command->page < 0) || (command->page + command->count > diskChannel->number_of_pages)) + return (EINVAL); + + startingOffset = (off_t) command->page * diskChannel->blocksize; + if (-1 == lseek (diskState->fd, startingOffset, SEEK_SET)) + return (errno); + + nAddresses = command->n_addresses; + addressPair = &command->addresses[0]; + obtoread = 0; + + while (nAddresses > 0) + { + nVectors = (nAddresses > NIOVectors) ? NIOVectors : nAddresses; + nBytes = 0; + + for (i = 0; i < nVectors; i++, addressPair++, nAddresses--) + { + diskState->iovs[i].iov_base = (caddr_t) HostPointer (addressPair->address); + btoread = addressPair->n_words * sizeof (EmbWord); + obtoread = obtoread + btoread ; +// btoread = (btoread * diskChannel->blocksize) / 8192 ; + diskState->iovs[i].iov_len = btoread ; + nBytes += diskState->iovs[i].iov_len; + } + + switch (command->op.cmd) + { + case ReadCmd: + actualBytes = readv (diskState->fd, diskState->iovs, nVectors); +#ifdef DEBUG_DISK + printf ( "disk%d: read (%zu) %zu bytes (%zu blocks) at offset %zu to (%p)\n", + diskChannel->unit, + obtoread, + actualBytes, + (actualBytes / diskState->blocksize), + startingOffset, + diskState->iovs[0].iov_base ); +#endif + break; + + case WriteCmd: + actualBytes = writev (diskState->fd, diskState->iovs, nVectors); +#ifdef DEBUG_DISK + printf ( "disk%d: written (%zu) %zu bytes (%zu blocks) at offset %zu\n", + diskChannel->unit, + nBytes, + actualBytes, + (actualBytes / diskState->blocksize), + startingOffset ); +#endif + break; + + default: /* Shouldn't get here ... */ + return (EINVAL); + } + + if (-1 == actualBytes) + return (errno); + + else if (actualBytes != nBytes) + return (EINTR); + } + + return (0); +} + + +/* Reset a disk channel */ + +void ResetDiskChannel (EmbChannel* channel) +{ + register EmbDiskChannel* diskChannel = (EmbDiskChannel*) channel; + register DiskChannelState* diskState = HostState (diskChannel); + + ResetIncomingQueue (diskState->command_queue_ptr); + ResetOutgoingQueue (diskState->status_queue_ptr); + diskState->error_pending = FALSE; + + if (GuestPointer (diskChannel) > EmbCommAreaPtr->host_buffer_start + + EmbCommAreaPtr->host_buffer_size) + { + /* If Lisp created the disk channel, we must close the attached file now before + Lisp discards the disk channel as Lisp won't first ask to detach it */ + if (diskState->fd != -1) + { + close (diskState->fd); + diskState->fd = -1; + } + } +} + + +/* Cleanup a single disk channel -- + The thread which runs this channel has already been killed by RemoveAllSignalHandlers */ + +void TerminateDiskChannel (EmbDiskChannel* diskChannel) +{ + register DiskChannelState* diskState = HostState (diskChannel); + + if (diskState->fd != -1) + { + close (diskState->fd); + diskState->fd = -1; + } +} + + +/* Cleanup the disk channels */ + +void TerminateDiskChannels () +{ + EmbDiskChannel* diskChannel; + EmbPtr channel; + + for (channel = EmbCommAreaPtr->channel_table; channel != NullEmbPtr; + channel = diskChannel->next) + { + diskChannel = (EmbDiskChannel*) HostPointer (channel); + if (EmbDiskChannelType == diskChannel->type) + TerminateDiskChannel (diskChannel); + } +} diff --git a/life-support/embed.h b/life-support/embed.h new file mode 100644 index 0000000..b298f42 --- /dev/null +++ b/life-support/embed.h @@ -0,0 +1,854 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* This file defines the various common data structures, including the + communication area, the channels, and the configuration file. + For convenience, the private parts of these structures are in this + file too, but they shouldn't be accessed outside of Ivory life support + and they especially should not be depended upon by the guest. + */ + +#ifndef _EMBED_ +#define _EMBED_ + +#include +#include +#include +#include "pfilt_wrapper.h" + +#include "life_types.h" + + +/*** Signal Handlers ***/ + +#define NSignals 32 + +typedef struct + { + pthread_t handlerThread; /* Thread which runs this signal handler */ + bool handlerThreadSetup; /* TRUE => the above thread has been created */ + SignalMask signal; /* Identifies the signal under its care */ + ProcPtrV handlerFunction; /* The function which actually handles the signal ... */ + PtrV handlerArgument; /* ... and its argument */ + } SignalHandler; + +void EmbSendSignal (SignalNumber signal); +SignalNumber InstallSignalHandler(ProcPtrV singalHandler, PtrV signalArgument, bool inputP); +void RemoveSignalHandler (SignalNumber signal); +void SignalLater (SignalNumber signal); + + +/*** Communication Area ***/ + +typedef struct + { + /* Overall Information */ + EmbWord identifier; /* char[4] 'EMBD' verifies this is the communication area */ + EmbWord version; /* 1 identifies the communication architecture version */ + EmbWord system_type; /* SystemTypeXXX identifies the host & guest systems jointly */ + + EmbWord number_of_slots; /* Number of guest-visible 32-bit words in this structure */ + EmbWord comm_memory_size; /* Total number of 32-bit words in communication memory */ + + /* Version Numbers of various software entities, in case anyone cares */ + struct + { /* Version number of this program ... */ +#if BYTE_ORDER == LITTLE_ENDIAN + EmbWord minor :16; + EmbWord major :16; +#else + EmbWord major :16; + EmbWord minor :16; +#endif + } generaVersion; + struct + { /* Version number of the OSF/1 operating system ... */ +#if BYTE_ORDER == LITTLE_ENDIAN + EmbWord minorRevision :8; + EmbWord majorRevision :8; + EmbWord minorRelease :8; + EmbWord majorRelease :7; + EmbWord testReleaseP :1; +#else + EmbWord testReleaseP :1; + EmbWord majorRelease :7; + EmbWord minorRelease :8; + EmbWord majorRevision :8; + EmbWord minorRevision :8; +#endif + } osfVersion; + EmbWord guest_major_version; + EmbWord guest_minor_version; + EmbWord fep_major_version; + EmbWord fep_minor_version; + + /* Memory Allocation */ + EmbPtr guest_buffer_start; /* Portion of communication memory allocated by guest */ + EmbWord guest_buffer_size; /* Number of 32-bit words in that */ + EmbPtr host_buffer_start; /* Portion of communication memory allocated by host */ + EmbWord host_buffer_size; /* Number of 32-bit words in that */ + EmbPtr fep_buffer_start; /* Portion of communication memory used by IFEP */ + EmbWord fep_buffer_size; /* Number of 32-bit words in that */ + + /* Signals */ + SignalMask guest_to_host_signals; /* 1 if signal bit wants attention */ + SignalMask live_guest_to_host_signals; /* 1 if signal bit is in use */ + SignalMask host_to_guest_signals; /* 1 if signal bit wants attention */ + SignalMask live_host_to_guest_signals; /* 1 if signal bit is in use */ + + /* Channels */ + EmbPtr channel_table; /* Head of threaded list of all channels */ + EmbPtr consoleChannel; /* Main console (X window) channel */ + EmbPtr cold_load_channel; /* Cold load stream channel */ + EmbPtr command_channel; /* Command message channel */ + + /* Memory Configuration */ + EmbWord virtualMemorySize; /* Size of emulator virtual memory in words */ + EmbWord worldImageSize; /* Size of world load in words */ + EmbPtr bad_memory_map; /* MacIvory: Pointer to map of holes in Ivory memory */ + EmbWord bad_memory_map_size; /* MacIvory: Number of 64-bit entries in that map */ + + /* The remaining guest visible slots aren't in their proper logical position in + this structure as they were added after the initial release */ + + SignalNumber clock_signal; /* Send this signal to simulate a clock interrupt */ + EmbWord clock_interval; /* Approximate clock interrupt interval in microseconds */ + EmbWord run_lights; /* Right-justified bit mask of run lights */ + EmbWord reset_request; /* Set by guest to request reset, cleared by host */ + EmbWord board_serial_number; /* Guest board serial number */ + EmbWord board_major_version; /* Guest board major revision level */ + EmbWord board_minor_version; /* Guest board minor revision level */ + EmbWord spy_command; /* Debugging */ + EmbWord spy_status; /* Debugging */ + EmbWord stop_request; /* Set to force guest to halt */ + struct + { +#if BYTE_ORDER == LITTLE_ENDIAN + uEmbWord status:8; /* Guest status as determined by its FEP (see below) */ + uEmbWord cursor:1; /* FEP twiddles this bit to blink its cursor */ + uEmbWord busy:1; /* 1 => FEP is executing a command */ + uEmbWord error:1; /* 1 => last FEP command ended in an error */ + uEmbWord lisp_is_loaded:1; /* 1 => the FEP has determined that Lisp is loaded */ + uEmbWord :20; +#else + uEmbWord :20; + uEmbWord lisp_is_loaded:1; /* 1 => the FEP has determined that Lisp is loaded */ + uEmbWord error:1; /* 1 => last FEP command ended in an error */ + uEmbWord busy:1; /* 1 => FEP is executing a command */ + uEmbWord cursor:1; /* FEP twiddles this bit to blink its cursor */ + uEmbWord status:8; /* Guest status as determined by its FEP (see below) */ +#endif + } fep; + EmbWord restart_applications; /* Set by guest to request host restart its applications */ + EmbWord signal_interrupt_vector; /* (Unused) Tells guest more precisely how to interrupt host */ + EmbWord base_register; /* MacIvory base register value */ + EmbWord hostVersion2; /* Unused */ + EmbWord hostVersion3; /* Unused */ + struct + { +#if BYTE_ORDER == LITTLE_ENDIAN + EmbWord data:16; /* Contents of NVRAM maintained by host for MacIvory */ + EmbWord :16; +#else + EmbWord :16; + EmbWord data:16; /* Contents of NVRAM maintained by host for MacIvory */ +#endif + } MacIvory_NVRAM_settings; + EmbPtr worldPathname; /* Pathname of the world loaded by the VLM command */ + EmbPtr unixLoginName; /* Login name of user running the emulator ... */ + uEmbWord unixUID; /* ... User ID ... */ + uEmbWord unixGID; /* ... Group ID */ + EmbPtr unixCwd; /* current working directory */ + EmbPtr UnixHomeDir; /* User's home directory */ + + /* Remainder of structure is Life Support globals, not known to the Ivory */ + + /* Padding to allow for convenient expansion of shared portion later */ + EmbWord pad0, /* Special padding slot used by INIT code */ + pad1[13]; + + /* To add slots to the shared portion of the communications area, add the slots before + the pad0 field and decrease the size of the pad1 field by the number of slots added. + As long as spare slots remain, you won't have to recompile all of the host software; + just those files which you modify to use the new slots. + + However, if you do use up all the remaining pad slots, instead of leaving no padding, + leave a minimum of 16 pad slots (one in pad0, 15 in pad1). You must also recompile + all of the host software. + + Be sure that any changes you make to the shared portion of the communications area + are reflected in the sources of all host systems (MacIvory, Solstice, VLM) as well + as by appropriate patches in Lisp. + */ + + EmbWord guestStatus; /* A GuestStatus code */ + + pthread_attr_t pollThreadAttrs; /* Attributes used to create polling threads */ + bool pollThreadAttrsSetup; /* TRUE => Above attributes have been created */ + + pthread_attr_t outputThreadAttrs; /* Attributes used to create output threads */ + bool outputThreadAttrsSetup; /* TRUE => Above attributes have been created */ + + pthread_attr_t inputThreadAttrs; /* Attributes used to create input threads */ + bool inputThreadAttrsSetup; /* TRUE => Above attributes have been created */ + + bool useSignalLocks; /* TRUE => Manipulate signals under the lock */ + SignalHandler signalHandler[NSignals]; /* The guest-to-host signal handlers */ + SignalMask reawaken; /* Signals to try again on next clock tick */ + pthread_mutex_t signalLock; /* Used to control access to signals */ + bool signalLockSetup; /* TRUE => the above mutex has been created */ + pthread_cond_t signalSignal; /* Used to wakeup signal handlers */ + bool signalSignalSetup; /* TRUE => the above has been created */ + + pthread_t pollingThread; /* Life Support polling loop runs in this thread */ + bool pollingThreadSetup; /* TRUE => Life Support polling thread was created */ + long pollTime; /* Nanoseconds since we last polled all signals */ + long pollClockTime; /* Nanoseconds until next periodic clock interrupt */ + + pthread_mutex_t clockLock; /* Used to implement an interval timer */ + bool clockLockSetup; /* TRUE => the above mutex has been created */ + pthread_cond_t clockSignal; /* Used to implement an interval timer */ + bool clockSignalSetup; /* TRUE => the above has been created */ + pthread_t clockThread; /* The thread which actually implements the timer */ + bool clockThreadSetup; /* TRUE => Above thread has been created */ + long clockTime; /* Microseconds until next interval timer interrupt */ + + EmbWord resetRequestCount; /* # of times that Lisp (not IFEP) requested a reset */ + EmbWord restartApplicationsCount; /* # of times we've been requested to restart */ + + bool inhibitDisk; /* TRUE => don't process any disk I/O requests */ + EmbWord debugLevel; /* Controls level of debugging output */ + + caddr_t slaveTrigger; /* Address of location monitored by VLM to simulate + a high-priority sequence break */ + + pthread_mutex_t XLock; /* Used to control access to the X library */ + bool XLockSetup; /* TRUE => the above mutex has been created */ + + pthread_mutex_t wakeupLock; /* Used by the VLM to wait for activity */ + bool wakeupLockSetup; /* TRUE => the above mutex has been created */ + pthread_cond_t wakeupSignal; /* Used by the VLM to wait for activity */ + bool wakeupSignalSetup; /* TRUE => the above has been created */ + + /* Add new slots at the end of this structure as multiple programs use this data */ + } EmbCommArea; + +/*** Static variable containing the address of the communication area ***/ +extern EmbCommArea *EmbCommAreaPtr; + + +/* Values for EmbCommArea.system_type */ +enum system_type + { + SystemTypeUX400G = 01003, /* SGI box with Merlin board in it */ + SystemTypeXL400 = 01004, /* Standalone Merlin-I system */ + SystemTypeMacIvory1 = 01006, /* 2-card NuBus Ivory Macintosh coprocessor (240ns) */ + SystemTypeMacIvory2 = 01006, /* 2-card NuBus Ivory Macintosh coprocessor (140ns) */ + SystemTypeUX400S = 01007, /* Sun-3/Sun-4 running SunOS with Merlin board in it */ + SystemTypeXL1200 = 01011, /* Standalone Merlin-II system */ + SystemTypeUX1200S = 01012, /* Sun-3/Sun-4 running SunOS with Merlin-II board in it */ + SystemTypeUX1200G = 01013, /* SGI box with Merlin-II board in it */ + SystemTypeMacIvory3 = 01014, /* 1-card NuBus Ivory Macintosh coprocessor (65ns) */ + SystemTypeNXP1000 = 01015, /* Standalone system based on the Domino board design */ + SystemTypeVLM = 01016 /* Virtual Lisp Machine */ + }; + +/* Values for EmbCommArea.reset_request */ +enum ResetRequest + { + ReadNVRAMResetRequest = -6, /* Read NVRAM maintained by host */ + WriteNVRAMResetRequest, /* Write NVRAM maintained by host */ + AreYouThereResetRequest, /* Ivory just wants to know if we're alive */ + BootResetRequest, /* Boot ROM is starting -- Prepare to load Device PROM */ + DevicePROMResetRequest, /* Load the next available chunk of the Device PROM */ + FEPResetRequest, /* Reset request issued by IFEP doesn't clear everything */ + NoResetRequest, /* Normal state */ + LispResetRequest /* Reset request issued by Lisp proper clears everything */ + }; + +/* Values for EmbCommArea.guest_status */ +enum GuestStatus + { + NonexistentGuestStatus = -2, /* No guest hardware present */ + BrokenGuestStatus = -1, /* Host or guest initialization failed */ + UninitializedGuestStatus = 0, /* Communication area okay; guest not initialized yet */ + InitializingGuestStatus, /* Guest being initialized; running BootROM/DevicePROM */ + InitializedGuestStatus, /* IFEP running; Hello command not yet issued */ + StartedGuestStatus, /* IFEP running; Hello command issued; Lisp hasn't run */ + CrashedGuestStatus, /* IFEP running; Lisp had been running */ + RunningGuestStatus /* Lisp running */ + }; + +/* Values for EmbCommArea.fep.status */ +enum FEPStatus + { + HaltedFEPStatus = 0xFF, /* FEP has stopped: 0xFF == -1 as unsigned 8-bit value */ + RunningFEPStatus = 0, /* FEP is running */ + IdleFEPStatus = 1 /* FEP is idle (i.e., Lisp is running) */ + }; + + +/*** Pointers ***/ + +/* Null pointer of EmbPtr type */ +#define NullEmbPtr (EmbPtr)(-1) + +/* Convert a guest pointer (EmbPtr) to a host pointer */ +/* Assumes EmbCommAreaPtr is an accessible variable */ +#define HostPointer(p) (PtrV)(&((EmbWord*)EmbCommAreaPtr)[p]) + +/* Convert a host pointer to a guest pointer (EmbPtr) */ +/* Assumes EmbCommAreaPtr is an accessible variable */ +#define GuestPointer(p) (EmbPtr)((EmbWord*)p - (EmbWord*)EmbCommAreaPtr) + + +/*** Strings ***/ + +typedef struct + { + EmbWord length; /* Number of characters in the string */ + EmbWord string; /* The string starts here and is stored in host order */ + } EmbString; + + +/*** Queues ***/ + +typedef struct + { + EmbWord element_size; /* Number of bytes per queue element */ + EmbWord queue_size; /* Number of elements in the queue */ + EmbWord put_index; /* Index of next element to be written */ + EmbWord take_index; /* Index of next element to be read */ + SignalNumber signal; /* Send this signal on empty => non-empty transition; + -1 if no signal used */ + EmbWord first_element[1]; /* Array of elements starts here */ + } EmbQueue; + +void EmbQueuePut (EmbQueue* q, PtrV element); /* Put element into queue */ +bool EmbQueueTake (EmbQueue* q, PtrV element); /* Take element from queue */ +int EmbQueueSpace (EmbQueue* q); /* Number of free elements */ +int EmbQueueFilled (EmbQueue* q); /* Number of non-free elements */ +void EmbQueuePutWord (EmbQueue* q, EmbWord element); /* Put element into word queue */ +EmbWord EmbQueueTakeWord (EmbQueue* q); /* Take element from word queue */ +void EmbQueuePutByte (EmbQueue* q, byte element); /* Put element into byte queue */ +byte EmbQueueTakeByte (EmbQueue* q); /* Take element from byte queue */ +int EmbQueuePutWords (EmbQueue* q, EmbWord* elements, int count); /* Multi-word */ +int EmbQueueTakeWords (EmbQueue* q, EmbWord* elements, int count); +int EmbQueuePutBytes (EmbQueue* q, byte* elements, int count); /* Multi-byte */ +int EmbQueueTakeBytes (EmbQueue* q, byte* elements, int count); + + +/*** Channels ***/ + +typedef struct + { + EmbWord type; /* Code number of type of channel */ + EmbWord unit; /* Distinguishes multiple channels of same type */ + EmbPtr next; /* Next channel in list of all channels */ + /* Remainder of structure depends on the channel type */ + } EmbChannel; + +/* Values for EmbChannel.type */ +enum EmbChannelType + { + EmbDiskChannelType = 1, /* Disk drive/partition */ + EmbConsoleChannelType, /* Display, keyboard, and mouse */ + EmbNetworkChannelType, /* Packet Network */ + EmbRPCChannelType, /* Remote Procedure Call */ + EmbSCSIChannelType, /* IFEP SCSI I/O */ + EmbColdLoadChannelType, /* Cold load stream */ + EmbHostFileChannelType, /* IFEP access to host file system */ + EmbMessageChannelType /* High bandwidth message channel for I/O */ + }; + + +/*** Disk Channels ***/ + +#define NIOVectors 32 + +typedef struct + { + EmbWord type; /* EmbDiskChannelType */ + EmbWord unit; /* FEP unit number */ + EmbPtr next; /* Link to next channel */ + EmbWord number_of_pages; /* Size of disk in Ivory pages */ + /* -- More disk characteristics fields may be added later */ + EmbPtr command_queue; /* Commands from the guest */ + EmbPtr status_queue; /* Results from the host using guest's command buffers */ + + struct /* A word of flags ... */ + { +#if BYTE_ORDER == LITTLE_ENDIAN + uEmbWord host_byte_order:1; /* TRUE => byte swap data for this unit if needed */ + uEmbWord read_only:1; /* TRUE => this unit is read only */ + uEmbWord :30; +#else + uEmbWord :30; + uEmbWord read_only:1; /* TRUE => this unit is read only */ + uEmbWord host_byte_order:1; /* TRUE => byte swap data for this unit if needed */ +#endif + } flags; + EmbWord hostState0; /* Pointer to host specific disk channel data ... */ + EmbWord hostState1; /* ... split into two words to avoid unaligned accesses */ + EmbWord blocksize ; /* block size in bytes */ +} EmbDiskChannel; + +/* Internal data describing the disk channel */ + +typedef struct + { + EmbQueue *command_queue_ptr; /* For faster access to the queues ... */ + EmbQueue *status_queue_ptr; /* ... */ + bool error_pending; /* TRUE => channel is in error and needs to be reset */ + int fd; /* File descriptor of the partition or -1 if not open */ + int blocksize ; /* size of the blocks to read/write (in Bytes) */ + char* filename ; /* the filename */ + struct iovec iovs[NIOVectors]; /* Describes buffers for current transaction */ + } DiskChannelState; + +/* Data structure passed by Lisp via the AttachDiskChannel coprocessor register */ + +typedef struct + { + EmbPtr diskChannel; /* Embedded pointer to disk channel setup by Lisp */ + EmbWord filename; /* Name of file to attach to channel (a DTP-STRING) */ + EmbWord ifNotFoundAction; /* What to do if the file doesn't exist */ + EmbWord minimumLength; /* File must be at least this many bytes */ + EmbWord result; /* Set to zero if attached, non-zero if an error occured */ + EmbPtr errorMsg; /* Set to embedded pointer of an error message, if any */ + EmbWord blockSize ; /* size of the blocks to be used (in words) */ + } AttachDiskChannelRequest; + +enum IfNotFoundActions + { + CreateIfNotFound, + ErrorIfNotFound + }; + +/* Data structure passed by Lisp via the GrowDiskPartition coprocessor register */ + +typedef struct + { + EmbPtr diskChannel; /* Embedded pointer to disk channel */ + EmbWord newLength; /* File must be grown to, at least, this many bytes */ + EmbWord result; /* Set to zero if attached, non-zero if an error occured */ + EmbPtr errorMsg; /* Set to embedded pointer of an error message, if any */ + } GrowDiskPartitionRequest; + +/* The queues contains pointers to EmbDiskQueueElement structures which describe a + single disk I/O transaction */ + +enum EmbDiskCmd + { + ReadCmd = 1, /* Read pages from disk */ + WriteCmd, /* Write pages onto the disk */ + ResetCmd, /* Reset the channel, including any pending aborts */ + InitializeCmd /* Initiailze the channel, including resetting meters */ + }; + +enum EmbDiskStatus + { + WonStatus = 1, /* This operation completed successfully */ + LostStatus, /* This operation failed */ + AbortStatus /* This operation wasn't tried due to a pending abort */ + }; + +/* Data structure passed by Lisp via the UnixCrypt coprocessor register */ + +typedef struct +{ + EmbWord cryptPassword ; /* the password to crypt (a DTP-STRING) */ + EmbWord cryptSalt ; /* the salt string (DTP-STRING) */ + EmbWord cryptResult ; /* set to zero, if no errors, errno else */ + EmbPtr cryptString ; /* resulting string when no errors (embedded string) */ +} UnixCryptRequest ; + +typedef struct + { +#if BYTE_ORDER == LITTLE_ENDIAN + uEmbWord cmd:3; /* An EmbDiskCmd code */ + uEmbWord tagged:1; /* 0 => 32-bit data, 1 => 40-bit data (NYI) */ + uEmbWord buffered:1; /* 0 => to main memory (NYI), 1 => to guest buffer */ + uEmbWord :3; + uEmbWord suppress_error_recovery:1; /* Don't attempt any error recovery (NYI) */ + uEmbWord :7; + uEmbWord :16; +#else + uEmbWord :16; + uEmbWord :7; + uEmbWord suppress_error_recovery:1; /* Don't attempt any error recovery (NYI) */ + uEmbWord :3; + uEmbWord buffered:1; /* 0 => to main memory (NYI), 1 => to guest buffer */ + uEmbWord tagged:1; /* 0 => 32-bit data, 1 => 40-bit data (NYI) */ + uEmbWord cmd:3; /* An EmbDiskCmd code */ +#endif + } EmbDiskOperation; + +typedef struct + { + EmbPtr address; /* Address of buffer */ + EmbWord n_words; /* Number of words at that address */ + } EmbAddressPair; + +typedef struct + { + EmbWord id; /* Meaningful only to guest */ + EmbWord sync; /* Execute commands with EQ sync values in order given */ + EmbDiskOperation op; /* The command */ + EmbWord page; /* Starting disk address in pages */ + EmbWord count; /* Length of transfer in pages */ + EmbWord n_addresses; /* Number of memory address pairs */ + EmbWord status; /* An EmbDiskStatus code */ + EmbWord error_code; /* If status == LostStatus, this is an OSErr */ + EmbAddressPair addresses[1]; /* Describes the guest buffers for this transaction */ + } EmbDiskQueueElement; + + +/*** Console Channel ***/ + +/* The data portion of an EmbConsoleCommandEnableRunLights buffer is described by this + structure which is also included in the channel itself */ + +typedef struct { + EmbWord windowID; /* Identifiers window where the run lights will appear */ + EmbWord nLights; /* Number of run lights to be drawn */ + EmbWord lightWidth; /* Width in pixels of an individual run light */ + EmbWord lightHeight; /* Height in pixels ... */ + EmbWord firstLightX; /* Horizontal position of first run light in the window */ + EmbWord firstLightY; /* Verital position ... */ + EmbWord lightXSpacing; /* Horizontal spacing between run lights in pixels */ + EmbWord lightYSpacing; /* Vertical spacing ... */ + EmbWord lightForeground; /* Foreground color used to draw the run lights */ + EmbWord lightBackground; /* Background color ...*/ + EmbWord lightPlaneMask; /* Plane mask ...*/ + } EmbConsoleRunLights; + +/* The actual channel */ + +typedef struct { + EmbWord type; /* EmbConsoleChannelType */ + EmbWord unit; /* 0 (not used) */ + EmbPtr next; /* Link to next channel */ + EmbPtr outputRequestQueue; /* Commands and data to send appear in this queue */ + EmbPtr outputReplyQueue; /* Our response to the commands are placed in this queue */ + EmbPtr inputRequestQueue; /* Requests to read data appear in this queue */ + EmbPtr inputReplyQueue; /* The data is placed in this queue */ + EmbWord hostAddress; /* IP address of host where the console will appear */ + EmbWord displayNumber; /* Display number on the host; -1 for the default */ + EmbWord screenNumber; /* Screen number on the host; -1 for the default */ + EmbWord initialState; /* Console's initial state (a WindowInitialState) */ + EmbPtr geometry; /* String specifying the console's geometry if non-NULL */ + EmbPtr foregroundColor; /* String naming the foregound color if non-NULL */ + EmbPtr backgroundColor; /* String naming the background color if non-NULL */ + EmbPtr borderColor; /* String naming the border color if non-NULL */ + EmbPtr borderWidth; /* Width of border in pixels if greater than zero */ + EmbWord inputAvailableP; /* Non-zero if input is available without blocking */ + /* The remaining fields are not visible to Ivory */ + EmbQueue *outputRequestQ; /* For faster access to the queues ... */ + EmbQueue *outputReplyQ; /* ... */ + EmbQueue *inputRequestQ; /* ... */ + EmbQueue *inputReplyQ; /* ... */ + pthread_t drawRunLights; /* Thread used to draw the run lights */ + bool drawRunLightsSetup; /* TRUE => The above thread exists */ + char *hostName; /* Name of the host where the console will appear */ + void *display; /* X display object of the console */ + int fd; /* File descriptor from display object for I/O */ + int openingState; /* Open display substate (an OpeningState) */ + int nextPixmapFormat; /* Index of next pixmap format to return to Lisp */ + int nextRoot; /* Index of next root screen ... */ + int nextRootDepth; /* Index of said root's next depth ... */ + int nextRootDepthVisual; /* Index of said root's depth's next visual ...*/ + void *rlDisplay; /* Display used to draw the run lights */ + EmbConsoleRunLights runLights; /* Describes where and how the run lights are drawn */ + void *rlGC; /* Graphic context for the run lights */ + EmbWord lastRunLights; /* Value of run lights when we last drew them */ + } EmbConsoleChannel; + +/* State of the opening display finite-state machine -- See console.c for more information */ + +enum OpeningState + { + OpeningStateNone, /* Opening dialogue is complete */ + OpeningStatePrefix, /* Return the connection setup prefix */ + OpeningStateHeader, /* Return the connection setup header */ + OpeningStateVendor, /* Return the vendor's identification string */ + OpeningStatePixmapFormat, /* Return the next available pixmap format */ + OpeningStateRoot, /* Return the next available root window's header */ + OpeningStateRootDepth, /* Return the next available depth of a root window */ + OpeningStateRootDepthVisual /* Return the next available visual of a depth */ + }; + +/* Each command and reply is described by this structure */ + +typedef struct { + EmbWord opcode; /* An EmbConsoleCommand */ + EmbWord id; /* Unique identifier of this command */ + EmbWord result; /* Standard Unix error code indicating success/failure */ + EmbWord data[1]; /* First byte of data (if any) appears here */ + } EmbConsoleBuffer; + +enum EmbConsoleCommand + { + EmbConsoleCommandOpenDisplay = 1, /* Open the display */ + EmbConsoleCommandCloseDisplay, /* Close the display */ + EmbConsoleCommandNoOp, /* Do nothing: Used for output synchronization */ + EmbConsoleCommandWrite, /* Write data to the server */ + EmbConsoleCommandRead, /* Read a specific number of bytes from the server */ + EmbConsoleCommandInputWait, /* Wait until there's input available */ + EmbConsoleCommandEnableRunLights, /* Enable drawing run lights */ + EmbConsoleCommandDisableRunLights /* Disable drawing run lights */ + }; + +/* The data portion of an EmbConsoleCommandOpenDisplay buffer is described by this structure */ + +typedef struct { + EmbWord lastRequestNumber; /* Sequence number of last request used during open */ + } EmbConsoleOpenDisplay; + +/* The data portion of EmbConsoleCommandWrite and EmbConsoleCommandRead buffers are described + by this structure */ + +typedef struct { + EmbWord address; /* Ivory address of the buffer */ + EmbWord offset; /* Offset within buffer of first byte to transfer */ + EmbWord nBytes; /* Number of bytes to transfer */ + } EmbConsoleDataTransfer; + +/* The data portion of an EmbConsoleCommandInputWait buffer is described by this structure */ + +typedef struct { + EmbWord timeout; /* Milliseconds to wait for input to be available */ + EmbWord availableP; /* Set non-zero if input is available; zero if timeout */ + } EmbConsoleInputWait; + + +/*** Cold Load Stream Channel ***/ + +#define ColdLoadCommandHistorySize 1024 +//#define ColdLoadCommandHistorySize 4096 +#define ColdLoadProgressStringSize 256 +//#define ColdLoadProgressStringSize 512 + +typedef struct { + EmbWord type; /* EmbColdLoadChannelType */ + EmbWord unit; /* 0 (not used) */ + EmbPtr next; /* link to next channel */ + EmbPtr keyboard_input_queue; /* words containing keystrokes */ + EmbPtr display_output_queue; /* words containing display commands */ + EmbWord display_width; /* width in pixels of window */ + EmbWord display_height; /* height in pixels of window */ + EmbWord character_width; /* width in pixels of a character */ + EmbWord line_height; /* height in pixels of a line */ + struct + { /* FEP/Lisp progress note ... */ + EmbWord numerator; /* ... same meaning as for a real note */ + EmbWord denominator; /* ... " */ + EmbWord string_total_size; /* ... maximum size allowed for note's text */ + EmbWord string_length; /* ... non-zero => there's a note to display */ + char string[ColdLoadProgressStringSize]; /* ... the actual text is put here */ + } progress_note; + /* The remaining fields are not visible to Ivory */ + pthread_t coldLoadInput; /* The thread that processes cold load input */ + bool coldLoadInputSetup; /* The thread has been created */ + int fd; /* File descriptor of the display if not -1 */ + bool is_selected; /* non-zero when cold load is selected */ + EmbWord command_history_top; /* last used element of command history */ + EmbWord command_history_wrapped;/* whether/not history has wrapped around */ + EmbWord command_history[ColdLoadCommandHistorySize]; /* the history */ +} EmbColdLoadChannel; + + +/*** Network Channels ***/ + +#define MaxEmbNetPacketSize 1516 + +#ifdef OS_LINUX +/* ARP table entry a VLM IP address -- + Added to the host's ARP by InitializeLifeSupport and removed by TerminateLifeSupport */ +typedef struct EmbNetARPReq + { + struct EmbNetARPReq *next; + struct arpreq arp; + } EmbNetARPReq; +#endif + +typedef struct + { + EmbWord type; /* EmbNetworkChannelType */ + EmbWord unit; /* Network interface number */ + EmbPtr next; /* Next channel in list of all channels */ + EmbWord status; /* Status bits (see below) */ + EmbPtr guestToHostQueue; /* Guest to host outgoing packet queue */ + EmbPtr guestToHostReturnQueue; /* Host to guest freed outgoing packets queue */ + EmbPtr hostToGuestSupplyQueue; /* Guest to host incoming free packets queue */ + EmbPtr hostToGuestQueue; /* Host to guest incoming packets queue */ + EmbWord name0; /* Network interface name -- 1st 4 characters */ + EmbWord name1; /* Network interface name -- 2nd 4 characters */ + EmbWord hardwareAddressHigh; /* Interface hardware address -- high order 32 bits */ + EmbWord hardwareAddressLow; /* Interface hardware address -- low order 16 bits */ + EmbWord hostPrimaryProtocol; /* Host's primary network protocol's Ethernet type */ + EmbWord hostPrimaryAddress; /* Host's network address on this interface */ + EmbWord guestPrimaryProtocol; /* Guest's primary network protocol's Ethernet type */ + EmbWord guestPrimaryAddress; /* Guest's network address on this interface */ + /* Meters */ + EmbWord nTransmitFailures; /* Counter of unsuccessful packet transmissions */ + EmbWord nReceiveFailures; /* Counter of unsuccessful reads of incoming packets */ + EmbWord nFalseReceiverWakeups; /* Counter of read timeouts */ + EmbWord nReceivedPacketsLost; /* Counter of packets received but guest wouldn't take */ + EmbWord unusedMeters[4]; + EmbPtr addressString; /* String describing this interface's network address */ + /* The remaining fields are not visible to Ivory */ + EmbQueue *guestToHostQ; /* For faster access to the queues ... */ + EmbQueue *guestToHostReturnQ; /* ... */ + EmbQueue *hostToGuestSupplyQ; /* ... */ + EmbQueue *hostToGuestQ; /* ... */ +#ifdef USE_LIBPCAP + pcap_t* pcap; +#else +#ifdef OS_LINUX + int fd; /* File descriptor of our filter or -1 if not open */ + unsigned int net_broken ; /* non-zero if machine don't handle mac's correctly */ + struct sockaddr_ll sll; /* Contains information needed to write packets */ + EmbNetARPReq *arpReq; /* List of ARP entries associated with this channel */ +#endif +#endif + EmbNetFilter filter; /* Our packet filter psuedo-code */ + pthread_t receiverThread; /* Packet receiver runs in this thread */ + boolean receiverThreadSetup; /* TRUE => Above thread has been created */ + int alignmentPad; /* Ensure that the buffer is 32-bit word-aligned */ + byte receiveBuffer[MaxEmbNetPacketSize]; /* Buffer for incoming packets */ + } EmbNetChannel; + +/* Flags defined in the channel's status slot */ + +#define EmbNetStatusHostReady 1 /* Alpha side of Ethernet channel is ready */ +#define EmbNetStatusGuestReady 2 /* VLM side of Ethernet channel is ready */ + +/* Queues contain pointers to the buffers with the following structure */ + +typedef struct + { + EmbWord nBytes; /* Number of bytes in packet */ + EmbWord data[1]; /* The data */ + } EmbNetPacket; + + +/*** High Bandwidth Message Channel for I/O ***/ + +typedef struct + { + EmbWord type; /* EmbMessageChannelType */ + EmbWord unit; /* Guest's unique ID for this channel (if any) */ + EmbPtr next; /* Next channel in list of all channels */ + EmbWord subtype; /* Specific type of I/O (serial, X window, etc.) */ + EmbPtr guestToHostQueue; /* Guest to host outgoing commands/data */ + EmbPtr guestToHostReturnQueue; /* ... return queue for the above buffers */ + EmbWord guestToHostImpulse; /* Non-zero => Guest is requesting immediate action */ + EmbPtr hostToGuestQueue; /* Host to guest incoming status/data */ + EmbPtr hostToGuestSupplyQueue; /* ... supply queue for the above buffers */ + EmbWord hostToGuestImpulse; /* Non-zero => Host is requesting immediate action */ + uEmbWord subtypeData0; /* Pointer to subtype specific data structure ... */ + uEmbWord subtypeData1; /* ... split into two words to avoid unaligned accesses */ + } EmbMessageChannel; + +enum EmbMessageChannelSubtype + { + EmbMessageChannelSerialSubtype = 1, /* Asynchronous serial I/O */ + EmbMessageChannelCommandSubtype, /* General operations (substitute for RPC) */ + EmbMessageChannelMBINSubtype /* Minima ROM MBIN protocol */ + }; + +enum EmbMessageImpulse + { + EmbMessageImpulseNone = 0 + }; + +/* All subchannel data structures must include the following information */ + +#define EmbMessageSubtypeDataHeader \ + struct \ + { \ + EmbMessageChannel* nextActiveChannel; /* Pointer to next active message channel */ \ + EmbCommArea* commArea; /* Backpointers for use by the signal handler */ \ + EmbMessageChannel* messageChannel; /* ... */ \ + } header + +typedef struct + { + EmbMessageSubtypeDataHeader; + } EmbMessageSubtypeData; + +/* Queues contain pointers to the following command/data/status blocks */ + +#if BYTE_ORDER == LITTLE_ENDIAN +#define EmbMessageBufferHeader \ + struct \ + { \ + EmbWord length:24; /* Amount of data in buffer in bytes */ \ + EmbWord opcode:8; /* Subtype specific opcode */ \ + } header +#else +#define EmbMessageBufferHeader \ + struct \ + { \ + EmbWord opcode:8; /* Subtype specific opcode */ \ + EmbWord length:24; /* Amount of data in buffer in bytes */ \ + } header +#endif + +typedef struct + { + EmbMessageBufferHeader; + EmbWord data[1]; /* Data bytes in host order */ + } EmbMessageBuffer; + + +/* General Operations (Command) */ + +typedef struct + { + EmbMessageSubtypeDataHeader; + EmbQueue* guestToHostQueue; /* More convenient form of queue pointers */ + EmbQueue* guestToHostReturnQueue; /* ... */ + } EmbCommandChannel; + +enum EmbCommandBufferOpcode + { + EmbCommandBufferStartMBIN = 1 /* Activate an MBIN message channel */ + }; + +#define EmbCommandBufferHeader \ + EmbMessageBufferHeader; \ + EmbWord resultCode /* Non-zero if the command wasn't executed successfully */ + +typedef struct + { + EmbCommandBufferHeader; + EmbWord operands[1]; /* Operands for the command as supplied by the guest */ + } EmbCommandBuffer; + +typedef struct + { + EmbCommandBufferHeader; + EmbPtr mbinChannel; /* Pointer to MBIN message channel to be made active */ + } EmbCommandStartMBINBuffer; + + +/* Minima ROM MBIN protocol -- Unlike other message channels, the buffers in this channel + conform to the remote memory protocol defined by the Remote Debugger (aka Minima Debugger), + spy.c, and the various Minima ROMs */ + +typedef struct + { + EmbMessageSubtypeDataHeader; + EmbQueue* guestToHostQueue; /* More convenient form of queue pointers */ + EmbQueue* guestToHostReturnQueue; /* ... */ + EmbQueue* hostToGuestQueue; /* ... */ + EmbQueue* hostToGuestSupplyQueue; /* ... */ + } EmbMBINChannel; + +enum EmbMBINImpulse + { + EmbMBINImpulseShutdown = 1 + }; + +#endif diff --git a/life-support/genera-cptfont.xbm b/life-support/genera-cptfont.xbm new file mode 100644 index 0000000..7ab3660 --- /dev/null +++ b/life-support/genera-cptfont.xbm @@ -0,0 +1,190 @@ +/*> + *> ***************************************************************************************** + *> ** (c) Copyright 1990-1989 Symbolics, Inc. All rights reserved. + *> ** Portions of font library Copyright (c) 1984 Bitstream, Inc. All Rights Reserved. + *> + *> The software, data, and information contained herein are proprietary + *> to, and comprise valuable trade secrets of, Symbolics, Inc., which intends + *> to keep such software, data, and information confidential and to preserve + *> them as trade secrets. They are given in confidence by Symbolics pursuant + *> to a written license agreement, and may be used, copied, transmitted, and + *> stored only in accordance with the terms of such license. + *> + *> Symbolics, Symbolics 3600, Symbolics 3670 (R), Symbolics 3675 (R), Symbolics 3630, + *> Symbolics 3640, Symbolics 3645 (R), Symbolics 3650 (R), Symbolics 3653, Symbolics + *> 3620 (R), Symbolics 3610 (R), Symbolics Common Lisp (R), Symbolics-Lisp (R), + *> Zetalisp (R), Genera (R), Wheels (R), Dynamic Windows (R), Showcase, SmartStore (R), + *> Semanticue (R), Frame-Up (R), Firewall (R), MACSYMA (R), COMMON LISP MACSYMA (R), + *> CL-MACSYMA (R), LISP MACHINE MACSYMA (R), MACSYMA Newsletter (R), PC-MACSYMA, Document + *> Examiner (R), Delivery Document Examiner, S-DYNAMICS (R), S-GEOMETRY (R), S-PAINT (R), + *> S-RECORD, S-RENDER (R), "Your Next Step in Computing" (R), Ivory, MacIvory, MacIvory + *> model 2, XL400, Symbolics UX400S, Symbolics C, Symbolics Pascal (R), Symbolics Prolog, + *> Symbolics Fortran (R), CLOE (R), CLOE Application Generator, CLOE Developer, CLOE Runtime, + *> Symbolics Common Lisp Developer, Symbolics Concordia, Joshua, and Statice (R) are + *> trademarks of Symbolics, Inc. + *> + *> RESTRICTED RIGHTS LEGEND + *> Use, duplication, and disclosure by the Government are subject to restrictions + *> as set forth in subdivision (c)(1)(ii) of the Rights in Technical Data and Computer + *> Software Clause at DFAR 52.227-7013. + *> + *> Symbolics, Inc. + *> 8 New England Executive Park, East + *> Burlington, Massachusetts 01803 + *> United States of America + *> 617-221-1000 + *> ***************************************************************************************** + *> + */ + +#define GENERA_CPTFONT_width 1472 +#define GENERA_CPTFONT_height 12 +static char GENERA_CPTFONT_bits[] = { +0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x05, + 0x80, 0x00, 0x00, 0x00, 0x10, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x0F, 0xF0, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x86, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x03, 0x18, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, + 0x84, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0E, 0x00, 0x00, + 0x00, 0x18, 0x00, 0x00, 0x00, 0x20, 0xF4, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x22, 0x00, + 0x00, 0x00, 0x04, 0x85, 0xC4, 0xE1, 0x33, 0x30, 0x08, 0x04, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x3C, 0x04, 0x8F, 0x07, 0xF2, 0xE3, 0xFC, 0x3C, 0x1E, 0x00, 0x00, 0x00, 0x00, 0x78, 0x00, + 0x9E, 0x8F, 0xE7, 0xF3, 0xFB, 0x79, 0x42, 0x1F, 0x50, 0x28, 0x10, 0x0A, 0x79, 0x3E, 0x9E, + 0x8F, 0xE7, 0x13, 0x0A, 0x85, 0x42, 0x91, 0x1F, 0x01, 0x80, 0x90, 0x00, 0x18, 0x80, 0x00, + 0x00, 0x04, 0xE0, 0x00, 0x02, 0x08, 0x48, 0xC0, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x81, 0x80, 0x30, 0x41, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x8C, 0xC4, 0x04, 0x08, 0x31, 0x24, 0x00, + 0x09, 0x00, 0x40, 0x02, 0x48, 0x00, 0x00, 0x00, 0x04, 0x80, 0x07, 0x00, 0x00, 0x00, 0x02, + 0x11, 0x01, 0x01, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x20, 0x04, 0x02, 0x20, 0x00, 0x00, + 0x10, 0x01, 0x41, 0x00, 0x00, 0x00, 0x04, 0x85, 0xA4, 0x32, 0x4A, 0x30, 0x08, 0x04, 0x02, + 0x00, 0x00, 0x00, 0x80, 0x42, 0x87, 0x50, 0x08, 0x13, 0x10, 0x80, 0x42, 0x21, 0x00, 0x00, + 0x02, 0x10, 0x84, 0x3C, 0xA1, 0x50, 0x48, 0x14, 0x08, 0x84, 0x42, 0x04, 0x50, 0x24, 0x30, + 0x1B, 0x85, 0x42, 0xA1, 0x50, 0x88, 0x10, 0x0A, 0x85, 0x42, 0x11, 0x10, 0x21, 0x80, 0x08, + 0x01, 0x18, 0x80, 0x00, 0x00, 0x04, 0x10, 0x01, 0x02, 0x08, 0x48, 0x00, 0x01, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x81, 0x80, 0xC8, 0xA0, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0C, 0x46, 0x28, 0xF3, + 0xF3, 0x30, 0x24, 0x00, 0x09, 0x00, 0x20, 0x01, 0x30, 0x00, 0x00, 0x00, 0x04, 0x40, 0x08, + 0x00, 0x00, 0x00, 0x02, 0x0A, 0x81, 0x83, 0xE0, 0x00, 0x40, 0x7C, 0x1F, 0x47, 0x24, 0x04, + 0x72, 0x40, 0x08, 0x08, 0x08, 0x81, 0x80, 0xF8, 0x01, 0x00, 0x04, 0xC5, 0xAF, 0x30, 0x4A, + 0x20, 0x04, 0x88, 0x0A, 0x01, 0x00, 0x00, 0xC0, 0x42, 0x84, 0x50, 0x88, 0x12, 0x08, 0xC0, + 0x42, 0x21, 0x00, 0x00, 0x01, 0x20, 0x84, 0x42, 0xA1, 0x50, 0x48, 0x14, 0x08, 0x84, 0x42, + 0x04, 0x50, 0x22, 0xD0, 0x2A, 0x85, 0x42, 0xA1, 0x50, 0x80, 0x10, 0x0A, 0x85, 0x42, 0x11, + 0x08, 0x61, 0x80, 0x00, 0x00, 0x08, 0x80, 0x00, 0x00, 0x04, 0x10, 0x00, 0x02, 0x00, 0x40, + 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x81, + 0x80, 0x00, 0xA0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x90, 0x00, 0x00, 0x00, 0x00, + 0x1C, 0x04, 0x57, 0x88, 0x01, 0xF0, 0xFC, 0x04, 0x04, 0x42, 0x85, 0x50, 0xD9, 0x40, 0x02, + 0xA0, 0x48, 0x24, 0x04, 0x8A, 0xFC, 0x04, 0x90, 0x9F, 0x42, 0x00, 0x01, 0x84, 0x00, 0x04, + 0x80, 0xA4, 0x00, 0x31, 0x10, 0x04, 0x08, 0x07, 0x01, 0x00, 0x00, 0x60, 0x62, 0x04, 0x10, + 0x48, 0xF2, 0x09, 0x70, 0x42, 0x21, 0x86, 0x81, 0xF0, 0x43, 0x40, 0x7A, 0xA1, 0x50, 0x40, + 0x14, 0x08, 0x04, 0x42, 0x04, 0x50, 0x21, 0xD0, 0x4A, 0x85, 0x42, 0xA1, 0x50, 0x80, 0x10, + 0x0A, 0x85, 0x24, 0x0A, 0x04, 0xC1, 0x80, 0x00, 0x00, 0x10, 0x9E, 0x8F, 0xC7, 0xE7, 0x79, + 0x78, 0x3E, 0x0E, 0x4C, 0x0C, 0xB1, 0xE9, 0x78, 0x3E, 0xBE, 0x8E, 0xEF, 0x13, 0x0A, 0x85, + 0x42, 0xA1, 0x1F, 0x81, 0x80, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x1C, 0x84, 0xC8, 0x47, 0xF2, 0x0B, 0x48, 0x08, 0x0A, 0x06, 0xE1, + 0x4B, 0x26, 0x79, 0x02, 0xA0, 0x48, 0xE4, 0xE7, 0x57, 0x41, 0x7E, 0x3F, 0x44, 0x84, 0x80, + 0xF8, 0x49, 0x00, 0x04, 0x80, 0xC4, 0x81, 0x30, 0x00, 0x04, 0x08, 0xC2, 0x07, 0xF0, 0x03, + 0x30, 0x52, 0x04, 0x08, 0x27, 0x02, 0xFA, 0x70, 0x3C, 0x3E, 0x86, 0x41, 0x00, 0x80, 0x20, + 0x4A, 0xBF, 0x4F, 0x40, 0xF4, 0xF9, 0x04, 0x7E, 0x04, 0xD0, 0x20, 0x10, 0x8A, 0x85, 0x3E, + 0xA1, 0x8F, 0x87, 0x10, 0x0A, 0x85, 0x18, 0x04, 0x0F, 0x81, 0x81, 0x00, 0x00, 0x00, 0xA0, + 0x50, 0x28, 0x14, 0x12, 0x84, 0x42, 0x08, 0x48, 0x02, 0xD1, 0x1A, 0x85, 0x42, 0xA1, 0x51, + 0x40, 0x10, 0x0A, 0x85, 0x24, 0x21, 0x88, 0x80, 0x00, 0x01, 0x20, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1C, 0x84, 0x48, 0x28, 0x04, 0x3A, 0x48, + 0x18, 0x11, 0x09, 0x81, 0xF8, 0x27, 0x45, 0x02, 0xA0, 0x48, 0x24, 0x04, 0x26, 0x21, 0x04, + 0x10, 0x82, 0x02, 0x41, 0x00, 0x30, 0x00, 0x04, 0x80, 0x84, 0x42, 0x48, 0x01, 0x04, 0x08, + 0x07, 0x01, 0x00, 0x00, 0x18, 0x4A, 0x04, 0x06, 0xE8, 0x07, 0x0A, 0x11, 0x42, 0x20, 0x00, + 0x80, 0x00, 0x40, 0x10, 0x4A, 0xA1, 0x50, 0x40, 0x14, 0x08, 0xE4, 0x42, 0x04, 0x50, 0x21, + 0x10, 0x0A, 0x85, 0x02, 0xA1, 0x02, 0x88, 0x10, 0x92, 0xB4, 0x24, 0x04, 0x02, 0x01, 0x83, + 0x00, 0x00, 0x00, 0xBE, 0x50, 0x20, 0xF4, 0x13, 0x84, 0x42, 0x08, 0xC8, 0x01, 0x51, 0x0A, + 0x85, 0x42, 0xA1, 0x80, 0x47, 0x10, 0x0A, 0x85, 0x18, 0x21, 0x0F, 0x81, 0x80, 0x00, 0x20, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x95, 0x48, + 0x08, 0x00, 0x0A, 0x48, 0x24, 0x91, 0x10, 0x81, 0x48, 0x26, 0x45, 0x7C, 0x9F, 0x48, 0x44, + 0x02, 0x56, 0x11, 0x08, 0x88, 0x1F, 0x01, 0x22, 0xF8, 0x01, 0x00, 0x04, 0xC0, 0x8F, 0x22, + 0x88, 0x00, 0x04, 0x88, 0x0A, 0x01, 0x00, 0x00, 0x0C, 0x46, 0x04, 0x41, 0x08, 0x02, 0x0A, + 0x19, 0x42, 0x20, 0x00, 0x00, 0xF1, 0x23, 0x10, 0x7A, 0xA1, 0x50, 0x48, 0x14, 0x08, 0x84, + 0x42, 0x84, 0x50, 0x22, 0x10, 0x0A, 0x85, 0x02, 0xA9, 0x44, 0x88, 0x10, 0x92, 0xB4, 0x42, + 0x04, 0x01, 0x01, 0x86, 0x00, 0x00, 0x00, 0xA1, 0x50, 0x20, 0x14, 0x10, 0x84, 0x42, 0x08, + 0x48, 0x02, 0x11, 0x0A, 0x85, 0x42, 0xA1, 0x00, 0x48, 0x10, 0x92, 0x94, 0x24, 0x12, 0x02, + 0x81, 0x80, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x8E, 0x48, 0x08, 0x00, 0x08, 0x48, 0x42, 0x91, 0x10, 0xE1, 0x53, 0xD9, 0x44, + 0x00, 0x80, 0x88, 0x43, 0x02, 0x8A, 0x08, 0x00, 0x00, 0x01, 0x01, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x80, 0xA4, 0x12, 0x8B, 0x00, 0x08, 0x04, 0x02, 0xC0, 0x00, 0x60, 0x04, 0x42, 0x84, + 0x40, 0x08, 0x12, 0x0A, 0x09, 0x42, 0x10, 0x86, 0x01, 0x02, 0x10, 0x00, 0x02, 0xA1, 0x50, + 0x48, 0x14, 0x08, 0x84, 0x42, 0x84, 0x50, 0x24, 0x10, 0x0A, 0x85, 0x02, 0x91, 0x48, 0x88, + 0x10, 0x92, 0xCC, 0x42, 0x84, 0x00, 0x01, 0x84, 0x00, 0x00, 0x00, 0xA1, 0x50, 0x28, 0x14, + 0x10, 0xF8, 0x42, 0x08, 0x48, 0x04, 0x11, 0x0A, 0x85, 0x42, 0xA1, 0x40, 0x48, 0x14, 0x92, + 0xB4, 0x42, 0x0C, 0x01, 0x81, 0x80, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0xD7, 0x07, 0x00, 0xF0, 0x48, 0x42, 0x0E, 0x0F, + 0x01, 0xE0, 0x00, 0x38, 0x00, 0x00, 0x00, 0x80, 0xF1, 0x73, 0xFC, 0x00, 0x80, 0x00, 0xC0, + 0xE3, 0x01, 0x00, 0x00, 0x04, 0x80, 0xC4, 0x11, 0x73, 0x01, 0x08, 0x04, 0x00, 0xC0, 0x00, + 0x60, 0x00, 0x3C, 0x9F, 0x9F, 0x07, 0xE2, 0xF1, 0x08, 0x3C, 0x0E, 0x86, 0x01, 0x00, 0x00, + 0x10, 0x3C, 0xA1, 0x8F, 0xE7, 0xF3, 0x0B, 0x78, 0x42, 0x1F, 0x4F, 0xE8, 0x17, 0x0A, 0x79, + 0x02, 0xAE, 0x90, 0x87, 0xE0, 0x61, 0x84, 0x42, 0x84, 0x1F, 0x01, 0x80, 0x00, 0x00, 0x00, + 0xBE, 0x8F, 0xC7, 0xE7, 0x13, 0x80, 0x42, 0x08, 0x48, 0x08, 0x11, 0x0A, 0x79, 0x3E, 0xBE, + 0x80, 0x87, 0xE3, 0x61, 0x48, 0x42, 0x84, 0x1F, 0x81, 0x80, 0x00, 0x28, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x40, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x10, + 0x02, 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0F, + 0xF0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x84, 0x00, 0x80, 0x08, 0x00, 0x00, + 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x86, 0x60, 0x00, + 0x28, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0xC0, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xFC, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x78, 0x00, + 0x00, 0x07, 0x00, 0x00, 0x00, 0x00, 0x02, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x01, + 0x00, 0x80, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xE7, 0x07, 0x38, 0x00, + 0x00, 0x00}; diff --git a/life-support/genera-icon-32.xbm b/life-support/genera-icon-32.xbm new file mode 100644 index 0000000..d0b6b8f --- /dev/null +++ b/life-support/genera-icon-32.xbm @@ -0,0 +1,51 @@ +/*> + *> ***************************************************************************************** + *> ** (c) Copyright 1990-1989 Symbolics, Inc. All rights reserved. + *> ** Portions of font library Copyright (c) 1984 Bitstream, Inc. All Rights Reserved. + *> + *> The software, data, and information contained herein are proprietary + *> to, and comprise valuable trade secrets of, Symbolics, Inc., which intends + *> to keep such software, data, and information confidential and to preserve + *> them as trade secrets. They are given in confidence by Symbolics pursuant + *> to a written license agreement, and may be used, copied, transmitted, and + *> stored only in accordance with the terms of such license. + *> + *> Symbolics, Symbolics 3600, Symbolics 3670 (R), Symbolics 3675 (R), Symbolics 3630, + *> Symbolics 3640, Symbolics 3645 (R), Symbolics 3650 (R), Symbolics 3653, Symbolics + *> 3620 (R), Symbolics 3610 (R), Symbolics Common Lisp (R), Symbolics-Lisp (R), + *> Zetalisp (R), Genera (R), Wheels (R), Dynamic Windows (R), Showcase, SmartStore (R), + *> Semanticue (R), Frame-Up (R), Firewall (R), MACSYMA (R), COMMON LISP MACSYMA (R), + *> CL-MACSYMA (R), LISP MACHINE MACSYMA (R), MACSYMA Newsletter (R), PC-MACSYMA, Document + *> Examiner (R), Delivery Document Examiner, S-DYNAMICS (R), S-GEOMETRY (R), S-PAINT (R), + *> S-RECORD, S-RENDER (R), "Your Next Step in Computing" (R), Ivory, MacIvory, MacIvory + *> model 2, XL400, Symbolics UX400S, Symbolics C, Symbolics Pascal (R), Symbolics Prolog, + *> Symbolics Fortran (R), CLOE (R), CLOE Application Generator, CLOE Developer, CLOE Runtime, + *> Symbolics Common Lisp Developer, Symbolics Concordia, Joshua, and Statice (R) are + *> trademarks of Symbolics, Inc. + *> + *> RESTRICTED RIGHTS LEGEND + *> Use, duplication, and disclosure by the Government are subject to restrictions + *> as set forth in subdivision (c)(1)(ii) of the Rights in Technical Data and Computer + *> Software Clause at DFAR 52.227-7013. + *> + *> Symbolics, Inc. + *> 8 New England Executive Park, East + *> Burlington, Massachusetts 01803 + *> United States of America + *> 617-221-1000 + *> ***************************************************************************************** + *> + */ + +#define GeneraIcon32_width 32 +#define GeneraIcon32_height 32 +static char GeneraIcon32_bits[] = { +0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xFC, 0x0F, 0x00, + 0x00, 0xAC, 0x0A, 0x00, 0x00, 0x54, 0x0D, 0x00, 0x00, 0xAC, 0x0A, 0x00, 0x00, 0x54, 0x0D, + 0x00, 0x00, 0xAC, 0x0A, 0x00, 0x00, 0x54, 0xFD, 0x01, 0x00, 0xAC, 0x9E, 0x06, 0x00, 0x54, + 0x4B, 0x0A, 0x00, 0xFC, 0x25, 0x19, 0x00, 0x00, 0x49, 0x12, 0x00, 0x80, 0x92, 0x24, 0x00, + 0x84, 0x49, 0x32, 0x00, 0x86, 0x24, 0x29, 0x00, 0x8E, 0x49, 0x32, 0x00, 0x8D, 0x92, 0x24, + 0x00, 0x1B, 0x49, 0x12, 0x80, 0x1A, 0x25, 0x11, 0x80, 0x35, 0x4A, 0x0A, 0x40, 0x35, 0x9C, + 0x06, 0xC0, 0x6A, 0xF0, 0x01, 0xA0, 0x6A, 0x00, 0x00, 0x60, 0xD5, 0x00, 0x00, 0x50, 0xD5, + 0x00, 0x00, 0xB0, 0xAA, 0x01, 0x00, 0xA8, 0xAA, 0x01, 0x00, 0xF8, 0xFF, 0x03, 0x00, 0x00, + 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; diff --git a/life-support/initialization.c b/life-support/initialization.c new file mode 100644 index 0000000..4e2731a --- /dev/null +++ b/life-support/initialization.c @@ -0,0 +1,579 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Life Support initialization */ + +#include "std.h" +#include +#include +#include +#include +#include +#include + +#include "life_types.h" +#include "embed.h" +#include "BootComm.h" +#include "FEPComm.h" +#include "SystemComm.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" + +#include "aihead.h" +#include "aistat.h" +#include "ivoryrep.h" +#include "memory.h" + + +/* Version of the VLM (nee, genera program): Eventually, this information will be in + a header file that's automatically generated by :Assemble Emulator */ + +/* 7.7 fixes to array reference trap code, array register recomputation */ +/* 7.8 fixes EGC bug where emulator bit wasn't on for copyspace sometimes */ +/* 7.9 fixes false-oldspace looping bug */ +/* 8.0 fixes a hang because of disagreement between two stop-request flags */ +/* 8.1 fixes xmodmap problems */ +/* 8.2 fixes defaulting to Genera-8-4.vlod as default world */ +/* 8.3 another try at RGETF hang fix */ +/* 8.4 make cold load characters match overlay */ +/* 8.5 make window background white by default */ +/* 8.6 fixes deep window playback of X initialization */ +/* 8.7 incorporates other changes */ +/* 8.8 another try at RGET hang */ +/* 8.9 floating point bug (macro only change) */ +/* 8.10 (rescinded) only do setup_modifier_mapping once per display */ +/* 8.11 fix bug with long host names */ +/* 8.12 kludge fix for thread hang (wait with timeout) */ +/* 8.13 floor/round/truncate/ceiling double-float cons trap bug */ +/* 8.14 keep mprotect error code around */ +/* 8.15 put in a couple of pthread_joins after pthread_cancels */ +/* 8.16 initialize the tracep flag to 0 if TRACING not defined */ +/* 8.17 fix LSH of > 32 bits, add tag checking for %unwind-to-frame-and-restart-or-apply */ +/* 8.18 fix bugs in 8.17 */ +/* 9.0 MacIvory G5 */ + +#define GeneraMajorVersion 9 +#define GeneraMinorVersion 1 + +/*** Global Data ***/ + +BootCommArea *BootCommAreaPtr = NULL; +BootDataArea *BootDataAreaPtr = NULL; +FEPCommArea *FEPCommAreaPtr = NULL; +SystemCommArea *SystemCommAreaPtr = NULL; +EmbCommArea *EmbCommAreaPtr = NULL; + +EmbPtr EmbCommAreaAllocPtr = NullEmbPtr; +size_t EmbCommAreaAllocSize = 0; + +caddr_t dataAddress = NULL; +caddr_t tagsAddress = NULL; +size_t areasSize = 0; + +static pthread_key_t mainThread; + + +/* Allocate a piece of the embedded communications area */ + +EmbPtr EmbCommAreaAlloc (size_t nBytes) +{ + size_t nWords = (nBytes + sizeof (EmbWord) - 1) / sizeof (EmbWord); + EmbPtr thePtr = EmbCommAreaAllocPtr; + +#if LONG_BIT == 64 + if (nWords & 1) nWords++; /* Must ensure quadword alignment */ +#endif + + if ((nWords > EmbCommAreaAllocSize) || (nBytes <= 0)) + vpunt (NULL, "Couldn't allocate %d words in the embedded communications area", nWords); + + EmbCommAreaAllocSize -= nWords; + EmbCommAreaAllocPtr += nWords; + + return (thePtr); +} + + +/* Store a string in the embedded communications area */ + +EmbPtr MakeEmbString (char* aString) +{ + EmbPtr theStringPtr; + register EmbString* theString; + register size_t nBytes = (NULL == aString) ? 0 : strlen (aString); + + if (0 == nBytes) return (NullEmbPtr); + + theStringPtr = EmbCommAreaAlloc (sizeof (EmbString) + nBytes); + theString = (EmbString*) HostPointer (theStringPtr); + theString->length = nBytes; + memcpy ((char*)&theString->string, aString, nBytes); + +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&theString->string, nBytes); +#endif + + return (theStringPtr); +} + + +/* Parses a version number into major and minor version numbers */ + +void ParseVersionNumber (char* versionString, int* majorVersion, int* minorVersion, int *majorRevision, int *minorRevision) +{ + char *start, *end; + int major=-1, minor=-1, revmajor=-1, revminor = -1; + + *majorVersion = *minorVersion = -1; + + start = versionString; + major = strtoul (start, &end, 10); + if (start == end) + return; + + *majorVersion = major; + + if (*end) { + if (*end == '.') + { + start = end + 1; + minor = strtoul (start, &end, 0); +// if ((start == end) || *end) + if (start == end) + return; + } + else + return; + } + *minorVersion = minor; + + if (*end) { + if (*end == '.') + { + start = end + 1; + revmajor = strtoul (start, &end, 0); +// if ((start == end) || *end) + if (start == end) + return; + } + else + return; + } + *majorRevision = revmajor; + + if (*end) { + if (*end == '-') + { + start = end + 1; + revminor = strtoul (start, &end, 0); +// if ((start == end) || *end) + if (start == end) + return; + } + else + return; + } + *minorRevision = revminor; +} + + +/* Guts of Life Support initialization */ + +int InitializeLifeSupport (VLMConfig* config) +{ + struct utsname osfName; + char worldPathname[_POSIX_PATH_MAX+5+1], *loginName, *identifier, *cwd, *home; + int major, minor, revmajor, revminor ; + + /* Ask the emulator to establish the BootComm/BootData/CommArea mapping */ + + EnsureVirtualAddressRange (BootCommAreaAddress, + (BootCommAreaSize + BootDataAreaSize + config->commAreaSize), + FALSE); + BootCommAreaPtr = (BootCommArea*) MapVirtualAddressData (BootCommAreaAddress); + BootDataAreaPtr = (BootDataArea*) MapVirtualAddressData (BootDataAreaAddress); + EmbCommAreaPtr = (EmbCommArea*) MapVirtualAddressData (EmbCommAreaAddress); + + + /* Initialize the BootComm and BootData */ + + VirtualMemoryWriteBlockConstant (BootCommAreaAddress, + MakeLispObj (Type_Null, BootCommAreaAddress), + (BootCommAreaSize + BootDataAreaSize), 1); + + WriteBootCommSlot (embCommArea, EmbCommAreaAddress, Type_Locative); + WriteBootCommSlot (systemType, SystemTypeVLM, Type_Fixnum); + WriteBootCommSlot (stackBase, BootStackBase, Type_Locative); + WriteBootCommSlot (stackSize, BootStackSize, Type_Fixnum); + WriteBootCommSlot (spyBlockAddress, BootDataAreaAddress, Type_Locative); + WriteBootCommSlot (spyCommandAddress, BootDataSlotAddress (bootSpyCommand), Type_Locative); + WriteBootCommSlot (spyStatusAddress, BootDataSlotAddress (bootSpyStatus), Type_Locative); + + + /* Ask the emulator to establish the FEPComm area mapping and initialize the area */ + + EnsureVirtualAddressRange (FEPCommAreaAddress, FEPCommAreaSize, FALSE); + VirtualMemoryWriteBlockConstant (FEPCommAreaAddress, + MakeLispObj (Type_Null, FEPCommAreaAddress), + FEPCommAreaSize, 1); + FEPCommAreaPtr = (FEPCommArea*) MapVirtualAddressData (FEPCommAreaAddress); + + + /* Ask the emulator to establish the SystemComm area mapping and initialize the area */ + + EnsureVirtualAddressRange (SystemCommAreaAddress, SystemCommAreaSize, FALSE); + VirtualMemoryWriteBlockConstant (SystemCommAreaAddress, + MakeLispObj (Type_Null, SystemCommAreaAddress), + SystemCommAreaSize, 1); + SystemCommAreaPtr = (SystemCommArea*) MapVirtualAddressData (SystemCommAreaAddress); + + + /* Initialize the communications area */ + + VirtualMemoryWriteBlockConstant (EmbCommAreaAddress, MakeLispObj (Type_Fixnum, 0), + config->commAreaSize, 0); + +#if BYTE_ORDER == LITTLE_ENDIAN + identifier = "EMBD"; +#else + identifier = "DBME"; +#endif + EmbCommAreaPtr->identifier = *(EmbWord*)identifier; + + EmbCommAreaPtr->version = 1; + EmbCommAreaPtr->system_type = SystemTypeVLM; + + EmbCommAreaPtr->number_of_slots = ((ptrdiff_t)&EmbCommAreaPtr->pad0 - (ptrdiff_t)EmbCommAreaPtr) / sizeof (EmbWord); + EmbCommAreaPtr->comm_memory_size = config->commAreaSize; + + EmbCommAreaPtr->generaVersion.major = GeneraMajorVersion; + EmbCommAreaPtr->generaVersion.minor = GeneraMinorVersion; + + if (uname (&osfName) < 0) + EmbCommAreaPtr->osfVersion.majorRelease = 0; /* Couldn't determine the version */ + else + { + EmbCommAreaPtr->osfVersion.testReleaseP = 0; + if (isdigit (osfName.release[0])) { + ParseVersionNumber (osfName.release, &major, &minor, &revmajor, &revminor); + } + else + { + EmbCommAreaPtr->osfVersion.testReleaseP = (osfName.release[0] != 'V'); + ParseVersionNumber (&osfName.release[1], &major, &minor, &revmajor, &revminor); + } + EmbCommAreaPtr->osfVersion.majorRelease = major; + EmbCommAreaPtr->osfVersion.minorRelease = minor; +// ParseVersionNumber (osfName.version, &major, &minor); + EmbCommAreaPtr->osfVersion.majorRevision = revmajor; + EmbCommAreaPtr->osfVersion.minorRevision = revminor; + } + + EmbCommAreaPtr->channel_table = NullEmbPtr; + EmbCommAreaPtr->consoleChannel = NullEmbPtr; + EmbCommAreaPtr->cold_load_channel = NullEmbPtr; + EmbCommAreaPtr->command_channel = NullEmbPtr; + + EmbCommAreaPtr->clock_signal = -1; /* No signal allocated until guest needs it */ + + EmbCommAreaPtr->slaveTrigger = NULL; /* Will be the address of a global ... */ + + + if (check_display(&config->coldLoadXParams, + config->interfaces) < 0) + return -1 ; + + if (check_display(&config->generaXParams, + config->interfaces) < 0) + return -1 ; + + if (check_keyboard (&config->coldLoadXParams, + TRUE) < 0) + return -1 ; + + + InitializeSignalHandlers (); + + if (pthread_key_create (&mainThread, NULL)) + vpunt (NULL, "Unable to establish per-thread data."); + + pthread_setspecific (mainThread, (void*) TRUE); + + if (atexit (&TerminateLifeSupport)) + vpunt (NULL, "Unable to establish cleanup handler for Life Support"); + + + /* Life Support uses threads to implement handlers for signals from the VLM -- + Each handler will run in its on thread and, effectively, is responsible for + a single unidirectional channel (e.g., a disk channel) or one half of a + bidirectional channel (e.g., network transmitter, network receiver). + Another thread is created to periodically invoke all signal handlers to avoid + lost "interrupts". A single mutex (lock) and conditional variable (signal) is + used to synchronize these threads. (The mutex is locked until initialization + is completed to prevent the threads from running prematurely.) */ + + SetupThreadAttrs ("polling", 0, &EmbCommAreaPtr->pollThreadAttrs, + &EmbCommAreaPtr->pollThreadAttrsSetup); + + SetupThreadAttrs ("output", 2, &EmbCommAreaPtr->outputThreadAttrs, + &EmbCommAreaPtr->outputThreadAttrsSetup); + + SetupThreadAttrs ("input", 3, &EmbCommAreaPtr->inputThreadAttrs, + &EmbCommAreaPtr->inputThreadAttrsSetup); + + if (pthread_mutex_init (&EmbCommAreaPtr->signalLock, NULL)) + vpunt (NULL, "Unable to create the Life Support signal lock"); + EmbCommAreaPtr->signalLockSetup = TRUE; + + if (pthread_cond_init (&EmbCommAreaPtr->signalSignal, NULL)) + vpunt (NULL, "Unable to create the Life Support signal signal"); + EmbCommAreaPtr->signalSignalSetup = TRUE; + + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", + pthread_self ()); + + if (pthread_create (&EmbCommAreaPtr->pollingThread, &EmbCommAreaPtr->pollThreadAttrs, + (pthread_startroutine_t)&IvoryLifePolling, NULL)) + vpunt (NULL, "Unable to create the Life Support polling thread"); + EmbCommAreaPtr->pollingThreadSetup = TRUE; + + if (pthread_mutex_init (&EmbCommAreaPtr->clockLock, NULL)) + vpunt (NULL, "Unable to create the Life Support clock lock"); + EmbCommAreaPtr->clockLockSetup = TRUE; + + if (pthread_cond_init (&EmbCommAreaPtr->clockSignal, NULL)) + vpunt (NULL, "Unable to create the Life Support clock signal"); + EmbCommAreaPtr->clockSignalSetup = TRUE; + + if (pthread_create (&EmbCommAreaPtr->clockThread, &EmbCommAreaPtr->pollThreadAttrs, + (pthread_startroutine_t)&IntervalTimerDriver, NULL)) + vpunt (NULL, "Unable to create the Life Support interval timer thread"); + EmbCommAreaPtr->clockThreadSetup = TRUE; + + if (pthread_mutex_init (&EmbCommAreaPtr->XLock, NULL)) + vpunt (NULL, "Unable to create the Life Support X library lock"); + EmbCommAreaPtr->XLockSetup = TRUE; + + if (pthread_mutex_init (&EmbCommAreaPtr->wakeupLock, NULL)) + vpunt (NULL, "Unable to create the VLM wakeup lock"); + EmbCommAreaPtr->wakeupLockSetup = TRUE; + + if (pthread_cond_init (&EmbCommAreaPtr->wakeupSignal, NULL)) + vpunt (NULL, "Unable to create the VLM wakeup signal"); + EmbCommAreaPtr->wakeupSignalSetup = TRUE; + + + /* Create the channels, their data structures, and threads */ + + EmbCommAreaAllocPtr = sizeof (EmbCommArea) / sizeof (EmbWord); + EmbCommAreaAllocSize = EmbCommAreaPtr->comm_memory_size - EmbCommAreaAllocPtr; + + if (config->worldPath[0]) + sprintf (worldPathname, "HOST:%s", config->worldPath); + else + worldPathname[0] = 0; + EmbCommAreaPtr->worldPathname = MakeEmbString (worldPathname); + + loginName = getlogin (); + if (loginName != NULL) + EmbCommAreaPtr->unixLoginName = MakeEmbString (loginName); + else + EmbCommAreaPtr->unixLoginName = NullEmbPtr; + EmbCommAreaPtr->unixUID = getuid (); + EmbCommAreaPtr->unixGID = getgid (); + cwd = get_current_dir_name (); + if (cwd != NULL) + EmbCommAreaPtr->unixCwd = MakeEmbString (cwd); + else + EmbCommAreaPtr->unixCwd = NullEmbPtr ; + if ((home = getenv("HOME")) == NULL) + home = getpwuid(getuid())->pw_dir ; + if (home != NULL) + EmbCommAreaPtr->UnixHomeDir = MakeEmbString (home); + else + EmbCommAreaPtr->UnixHomeDir = NullEmbPtr ; + +#ifndef MINIMA +#ifndef IVERIFY + + if (InitializeColdLoadChannel (config) < 0) { + TerminateLifeSupport(); + exit (-1); + } + InitializeConsoleChannel (config); +#endif +#endif + InitializeMessageChannels (config); + InitializeNetworkChannels (config); + + /* Host File channel */ + /* RPC channel? */ + + + /* Setup host, FEP, and guest buffers */ + + EmbCommAreaPtr->host_buffer_start = EmbCommAreaAllocPtr; + EmbCommAreaPtr->host_buffer_size = config->hostBufferSpace; + /* Initialize the host buffers -- HOW? */ + + EmbCommAreaPtr->fep_buffer_start = EmbCommAreaAllocPtr + EmbCommAreaPtr->host_buffer_size; + EmbCommAreaPtr->fep_buffer_size = 512; /* Enough for a single buffer plus overhead */ + + EmbCommAreaPtr->guest_buffer_start = EmbCommAreaAllocPtr + EmbCommAreaPtr->host_buffer_size + + EmbCommAreaPtr->fep_buffer_size; + EmbCommAreaPtr->guest_buffer_size = EmbCommAreaAllocSize - EmbCommAreaPtr->host_buffer_size + - EmbCommAreaPtr->fep_buffer_size; + if (EmbCommAreaPtr->guest_buffer_size < config->guestBufferSpace) + vpunt (NULL, + "Couldn't allocate %d words for guest buffers in the communcations area; only %d words are available.", + config->guestBufferSpace, EmbCommAreaPtr->guest_buffer_size); + + + /* Release the signal lock to let Life Support threads run */ + + EmbCommAreaPtr->useSignalLocks = TRUE; + + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", + pthread_self ()); + return 0; +} + + +/* Cleanup Life Support on exit -- Kill existing threads, close disk channels, etc. */ + +void TerminateLifeSupport () +{ + struct timespec killSleep; + void* exit_code; + + if (NULL == pthread_getspecific (mainThread)) + return; + /* + * JJ: terminate network first + */ + TerminateNetworkChannels (); + TerminateSignalHandlers (); + +#ifndef MINIMA +#ifndef IVERIFY + TerminateColdLoadChannel (); + TerminateConsoleChannel (); +#endif +#endif + TerminateDiskChannels (); + TerminateMessageChannels (); + /* + * JJ: network already done + */ + /* TerminateNetworkChannels (); */ + + killSleep.tv_sec = 1; + killSleep.tv_nsec = 250000000; + pthread_delay_np (&killSleep); + + if (EmbCommAreaPtr->wakeupSignalSetup) + { + pthread_cond_destroy (&EmbCommAreaPtr->wakeupSignal); + EmbCommAreaPtr->wakeupSignalSetup = FALSE; + } + + if (EmbCommAreaPtr->wakeupLockSetup) + { + pthread_mutex_destroy (&EmbCommAreaPtr->wakeupLock); + EmbCommAreaPtr->wakeupLockSetup = FALSE; + } + + if (EmbCommAreaPtr->XLockSetup) + { + pthread_mutex_destroy (&EmbCommAreaPtr->XLock); + EmbCommAreaPtr->XLockSetup = FALSE; + } + + if (EmbCommAreaPtr->clockThreadSetup) + { + pthread_cancel (EmbCommAreaPtr->clockThread); + pthread_join (EmbCommAreaPtr->clockThread, &exit_code); + EmbCommAreaPtr->clockThreadSetup = FALSE; + } + + if (EmbCommAreaPtr->clockSignalSetup) + { + pthread_cond_destroy (&EmbCommAreaPtr->clockSignal); + EmbCommAreaPtr->clockSignalSetup = FALSE; + } + + if (EmbCommAreaPtr->clockLockSetup) + { + pthread_mutex_destroy (&EmbCommAreaPtr->clockLock); + EmbCommAreaPtr->clockLockSetup = FALSE; + } + + if (EmbCommAreaPtr->pollingThreadSetup) + { + pthread_cancel (EmbCommAreaPtr->pollingThread); + pthread_join (EmbCommAreaPtr->pollingThread, &exit_code); + EmbCommAreaPtr->pollingThreadSetup = FALSE; + } + + if (EmbCommAreaPtr->signalSignalSetup) + { + pthread_cond_destroy (&EmbCommAreaPtr->signalSignal); + EmbCommAreaPtr->signalSignalSetup = FALSE; + } + + if (EmbCommAreaPtr->signalLockSetup) + { + pthread_mutex_destroy (&EmbCommAreaPtr->signalLock); + EmbCommAreaPtr->signalLockSetup = FALSE; + } + + if (EmbCommAreaPtr->inputThreadAttrsSetup) + { + pthread_attr_destroy (&EmbCommAreaPtr->inputThreadAttrs); + EmbCommAreaPtr->inputThreadAttrsSetup = FALSE; + } + + if (EmbCommAreaPtr->outputThreadAttrsSetup) + { + pthread_attr_destroy (&EmbCommAreaPtr->outputThreadAttrs); + EmbCommAreaPtr->outputThreadAttrsSetup = FALSE; + } + + if (EmbCommAreaPtr->pollThreadAttrsSetup) + { + pthread_attr_destroy (&EmbCommAreaPtr->pollThreadAttrs); + EmbCommAreaPtr->pollThreadAttrsSetup = FALSE; + } +} + + +/* Setup the attributes for a class of threads */ + +void SetupThreadAttrs (char* class, int priorityBoost, pthread_attr_t* threadAttrs, + bool* threadAttrsSetup) +{ + size_t stackSize; + + if (pthread_attr_init (threadAttrs)) + vpunt (NULL, "Unable to create attributes for Life Support %s threads", class); + *threadAttrsSetup = TRUE; + + pthread_attr_getstacksize (threadAttrs, &stackSize); + if (pthread_attr_setstacksize (threadAttrs, (4 * stackSize))) + vpunt (NULL, + "Unable to set stack size attribute for Life Support %s threads to %d bytes", + class, (4 * stackSize)); + + /* Can't change the priority of a regular thread in Linux and Mac OS X */ + +#if 0 +#ifdef OS_OSF + priority = pthread_attr_getprio (*threadAttrs); + if (pthread_attr_setprio (threadAttrs, (priority + priorityBoost))) + vpunt (NULL, "Unable to set priority attribute for Life Support %s threads to %d", + class, (priority + priorityBoost)); +#endif +#endif +} diff --git a/life-support/life_prototypes.h b/life-support/life_prototypes.h new file mode 100644 index 0000000..3d78736 --- /dev/null +++ b/life-support/life_prototypes.h @@ -0,0 +1,184 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Function prototypes for all entrypoints in VLM Life Support */ + +#include +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "world_tools.h" + + +/* When executing code which may call a function that is a thread cancellation point + (e.g., nanosleep, read, write) while under the protection of a mutex (i.e., lock), + we must establish a cleanup handler that unlocks the mutex to prevent the possibility + of a deadlock during application shutdown. */ + +#define begin_MUTEX_LOCKED(lock) \ + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_mutex_unlock, \ + (void*)&EmbCommAreaPtr->lock); \ + if (pthread_mutex_lock (&EmbCommAreaPtr->lock)) \ + vpunt (NULL, "Unable to lock the Life Support " #lock " in thread %lx", \ + pthread_self ()); + +#define end_MUTEX_LOCKED(lock) \ + if (pthread_mutex_unlock (&EmbCommAreaPtr->lock)) \ + vpunt (NULL, "Unable to unlock the Life Support " #lock " in thread %lx", \ + pthread_self ()); \ + pthread_cleanup_pop (FALSE); + +/* Life Support initialization holds onto the signal lock (mutex) until it's safe for the + various threads which comprise Life Support to run free. Consequently, each thread + first locks and unlocks the signal lock to synchronize with Life Support initialization. */ + +#define WaitUntilInitializationComplete() \ + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) \ + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", \ + pthread_self ()); \ + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) \ + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", \ + pthread_self ()); + + +/*** initialization.c ***/ + +EmbPtr EmbCommAreaAlloc (size_t nBytes); +int InitializeLifeSupport (VLMConfig* config); +EmbPtr MakeEmbString (char* aString); +void TerminateLifeSupport (void); + +void ParseVersionNumber (char* versionString, int* majorVersion, int* minorVersion, int* majorRevision, int* minorRevision); +void SetupThreadAttrs (char* class, int priorityBoost, pthread_attr_t* threadAttrs, + bool* threadAttrsSetup); + + +/*** cold_load.c ***/ + +int InitializeColdLoadChannel (VLMConfig* config); +void ResetColdLoadChannel (EmbChannel* channel); +void TerminateColdLoadChannel (void); +void UpdateColdLoadNames (void); +int check_display(XParams *params, + NetworkInterface *nwi) ; +int check_keyboard(XParams *params, + boolean noWaiting); + + +/* Internal functions are prototyped in the source file */ + + +/*** console.h ***/ + +boolean ConsoleInputAvailableP (void); +void DoConsoleIO (EmbConsoleChannel* consoleChannel, EmbConsoleBuffer* command); +void InitializeConsoleChannel (VLMConfig* config); +void ResetConsoleChannel (EmbChannel* channel); +void TerminateConsoleChannel (void); + +void AdvanceOpeningState (EmbConsoleChannel* pConsoleChannel); +void CloseDisplay (EmbConsoleChannel* chanel); +void ConsoleDriver (EmbConsoleChannel* consoleChannel, EmbQueue* pRequestQueue, + EmbQueue* pReplyQueue); +void ConsoleInput (EmbConsoleChannel* consoleChannel); +int ConsoleInputWait (EmbConsoleChannel* pConsoleChannel, + EmbConsoleBuffer* pCommand); +void ConsoleOutput (EmbConsoleChannel* consoleChannel); +int ConsoleRead (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand); +int ConsoleWrite (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand); +void DisableRunLights (EmbConsoleChannel* consoleChannel); +void DrawRunLights (pthread_addr_t argument); +void EnableRunLights (EmbConsoleChannel* pConsoleChannel, + EmbConsoleBuffer* pCommand); +int OpenDisplay (EmbConsoleChannel* pConsoleChannel, EmbConsoleBuffer* pCommand); +int ProcessConnectionRequest (EmbConsoleChannel* pConsoleChannel, + EmbConsoleBuffer* pCommand); + + +/*** disks.c ***/ + +void AttachDiskChannel (AttachDiskChannelRequest* pRequest); +void GrowDiskPartition (GrowDiskPartitionRequest* pRequest); +void DetachDiskChannel (EmbPtr diskChannelPtr); +void ResetDiskChannel (EmbChannel* channel); +void TerminateDiskChannels (void); + +int DoDiskIO (EmbDiskChannel* diskChannel, DiskChannelState* diskState, + EmbDiskQueueElement* command); +void DiskLife (EmbDiskChannel* diskChannel); +void TerminateDiskChannel (EmbDiskChannel* diskChannel); + +/*** unixcrypt.c ***/ + +void UnixCrypt (UnixCryptRequest *pRequest); + +/*** message_channels.c ***/ + +void InitializeMessageChannels (VLMConfig* config); +void PollMessageChannels (void); +void ResetMessageChannel (EmbChannel* channel); +void TerminateMessageChannels (void); +void UnthreadMessageChannel (EmbMessageChannel* theChannel); + +void ExecuteGuestCommands (EmbCommandChannel* commandChannel); +void ThreadActiveMessageChannel (EmbMessageChannel* theChannel); + + +/*** network.c ***/ + +void InitializeNetworkChannels (VLMConfig* config); +void ResetNetworkChannel (EmbChannel* channel); +void TerminateNetworkChannels (void); + +void InitializeNetChannel (NetworkInterface* interface, int netUnit +#ifdef OS_OSF + , struct in_addr* localHostAddress +#else +#ifndef USE_LIBPCAP + , int ipSocket, struct ifconf* ifc +#endif +#endif + ); +void NetworkChannel (pthread_addr_t argument); +void NetworkChannelTransmitter (EmbNetChannel* pNetChannel); +#ifdef OS_OSF +void TerminateNetChannel (EmbNetChannel* netChannel); +#else +void TerminateNetChannel (EmbNetChannel* netChannel, int ipSocket); +#endif + + +/*** polling.c ***/ + +void IntervalTimerDriver (pthread_addr_t argument); +void IvoryLifePolling (pthread_addr_t argument); +void SetIntervalTimer (Integer relativeTimeout); + +void ProcessResetRequest (void); +void UpdateVLMStatus (void); +boolean VLMIsRunning (EmbCommArea* ep); +boolean VLMIsRunningLisp (EmbCommArea* ep); + + +/*** queues.c ***/ + +/* All other entrypoints are defined in embed.h */ + +EmbPtr CreateQueue (int nElements, int elementSize); +void ResetIncomingQueue (EmbQueue* q); +void ResetOutgoingQueue (EmbQueue* q); + + +/*** signals.c ***/ + +/* InstallSignalHandler, EmbSendSignal, SignalLater, and RemoveSignalHandler + are defined in embed.h */ + +void InitializeSignalHandlers (void); +void TerminateSignalHandlers (void); + +void NullSignalHandler (PtrV ignore); +void SignalHandlerTopLevel (pthread_addr_t argument); + +/* The prototypes for SendInterruptToLifeSupport and WaitForLifeSupport are in ivoryrep.h */ diff --git a/life-support/life_types.h b/life-support/life_types.h new file mode 100644 index 0000000..96fe8a3 --- /dev/null +++ b/life-support/life_types.h @@ -0,0 +1,30 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Common types used throughout Life Support */ + +#ifndef _LIFE_TYPES_ +#define _LIFE_TYPES_ + +#include + +typedef int32_t EmbWord; /* A word in the communications area */ +typedef uint32_t uEmbWord; /* A word in the communications area */ + +typedef EmbWord EmbPtr; /* "Pointer" to communication area = word offset */ +typedef uEmbWord SignalMask; /* 32-bit bit mask of signals */ +typedef EmbWord SignalNumber; /* Index into that bit mask */ +typedef EmbWord bool; /* Boolean value for use in embedded data structure */ +typedef unsigned char boolean; /* Boolean value for day-to-day use */ +typedef unsigned char byte; /* byte = unsigned 8-bit byte */ +typedef void* PtrV; /* PtrV is like Ptr but with better error checking */ +typedef void (*ProcPtrV)(PtrV); /* ProcPtrV is like ProcPtr but returns nothing */ + +/* Possible initial states of an X window */ +enum WindowInitialState + { + Iconic = -1, + Unspecified, + Normal + }; + +#endif diff --git a/life-support/message_channels.c b/life-support/message_channels.c new file mode 100644 index 0000000..01a6bce --- /dev/null +++ b/life-support/message_channels.c @@ -0,0 +1,247 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Message Channel Support */ + +#include "std.h" + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "spy.h" + + +#define SetSubtypeData(mc,p) \ + { \ + mc->subtypeData0 = (((uint64_t) p) >> 32) & 0xFFFFFFFFL; \ + mc->subtypeData1 = ((uint64_t) p) & 0xFFFFFFFFL; \ + } + +#define SubtypeData(mc) \ + (PtrV)(((uint64_t)mc->subtypeData0 << 32) | mc->subtypeData1) + + +/* Initialize the command message channel and all other message channel structures */ + +void InitializeMessageChannels (VLMConfig* config) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbMessageChannel)); + register EmbMessageChannel *p = (EmbMessageChannel*) HostPointer (cp); + register EmbCommandChannel *cc; + + p->type = EmbMessageChannelType; + p->unit = 0; + EmbCommAreaPtr->command_channel = cp; + p->next = EmbCommAreaPtr->channel_table; /* Link into the channel list */ + EmbCommAreaPtr->channel_table = cp; + + p->subtype = EmbMessageChannelCommandSubtype; + p->hostToGuestQueue = NullEmbPtr; /* Should never be used ... */ + p->hostToGuestSupplyQueue = NullEmbPtr; /* ... */ + + cc = malloc (sizeof (EmbCommandChannel)); + if (NULL == cc) vpunt (NULL, "Couldn't allocate master command message channel"); + SetSubtypeData (p, cc); + + cc->header.nextActiveChannel = NULL; + cc->header.commArea = EmbCommAreaPtr; + cc->header.messageChannel = p; + + p->guestToHostQueue = CreateQueue (CommandQueueSize, sizeof (EmbPtr)); + cc->guestToHostQueue = (EmbQueue*) HostPointer (p->guestToHostQueue); + cc->guestToHostQueue->signal = InstallSignalHandler ((ProcPtrV) &ExecuteGuestCommands, + (PtrV) cc, FALSE); + + p->guestToHostReturnQueue = CreateQueue (CommandQueueSize, sizeof (EmbPtr)); + cc->guestToHostReturnQueue = (EmbQueue*) HostPointer (p->guestToHostReturnQueue); +} + + +/* Poll all active message channels -- Our caller is holding Life Support's signal lock */ + +void PollMessageChannels () +{ + register EmbMessageChannel* messageChannel; + register EmbMessageSubtypeData* subtypeData; + register EmbQueue* guestToHostQueue; + + if (NullEmbPtr == EmbCommAreaPtr->command_channel) + return; + + for (messageChannel = (EmbMessageChannel*) HostPointer (EmbCommAreaPtr->command_channel); + messageChannel != NULL; + messageChannel = subtypeData->header.nextActiveChannel) + { + subtypeData = (EmbMessageSubtypeData*) SubtypeData (messageChannel); + guestToHostQueue = (EmbQueue*) HostPointer (messageChannel->guestToHostQueue); + if (messageChannel->guestToHostImpulse && (guestToHostQueue->signal != -1)) + EmbCommAreaPtr->guest_to_host_signals |= 1 << guestToHostQueue->signal; + } +} + + +/* Threads a newly activated message channel into the list of active channels */ + +void ThreadActiveMessageChannel (EmbMessageChannel* theChannel) +{ + register EmbMessageChannel* messageChannel; + register EmbMessageSubtypeData* subtypeData; + + ((EmbMessageSubtypeData*) SubtypeData (theChannel))->header.nextActiveChannel = NULL; + + for (messageChannel = (EmbMessageChannel*) HostPointer (EmbCommAreaPtr->command_channel); + messageChannel != NULL; + messageChannel = subtypeData->header.nextActiveChannel) + { + subtypeData = (EmbMessageSubtypeData*) SubtypeData (messageChannel); + if (NULL == subtypeData->header.nextActiveChannel) + { + subtypeData->header.nextActiveChannel = theChannel; + return; + } + } +} + + +/* Remove an existing message channel from the list of active channels */ + +void UnthreadMessageChannel (EmbMessageChannel* theChannel) +{ + register EmbMessageChannel* messageChannel; + register EmbMessageSubtypeData* subtypeData; + EmbMessageSubtypeData* theSubtypeData; + + for (messageChannel = (EmbMessageChannel*) HostPointer (EmbCommAreaPtr->command_channel); + messageChannel != NULL; + messageChannel = subtypeData->header.nextActiveChannel) + { + subtypeData = (EmbMessageSubtypeData*) SubtypeData (messageChannel); + if (theChannel == subtypeData->header.nextActiveChannel) + { + theSubtypeData = (EmbMessageSubtypeData*) SubtypeData (theChannel); + subtypeData->header.nextActiveChannel = theSubtypeData->header.nextActiveChannel; + theSubtypeData->header.nextActiveChannel = NULL; + return; + } + } +} + + +/* Execute incoming commands from the VLM */ + +void ExecuteGuestCommands (EmbCommandChannel *commandChannel) +{ + register EmbQueue *commandQueue = commandChannel->guestToHostQueue; + register EmbQueue *resultsQueue = commandChannel->guestToHostReturnQueue; + EmbPtr commandPtr; + register EmbCommandBuffer *command; + EmbCommandStartMBINBuffer *startMBINCommand; + EmbMessageChannel *mbinChannel; + EmbMBINChannel *mbinSubChannel; + + while (EmbQueueFilled (commandQueue)) + { + if (0 == EmbQueueSpace (resultsQueue)) + { + SignalLater (commandQueue->signal); + return; + } + + commandPtr = EmbQueueTakeWord (commandQueue); + if (commandPtr) + { + command = (EmbCommandBuffer*) HostPointer (commandPtr); + + switch (command->header.opcode) + { + case EmbCommandBufferStartMBIN: + /* Activate an MBIN channel that was created by the VLM */ + startMBINCommand = (EmbCommandStartMBINBuffer*) command; + mbinChannel = (EmbMessageChannel*) HostPointer (startMBINCommand->mbinChannel); + mbinSubChannel = malloc (sizeof (EmbMBINChannel)); + if (NULL == mbinSubChannel) + command->resultCode = ENOMEM; + else + { + mbinSubChannel->header.commArea = EmbCommAreaPtr; + mbinSubChannel->header.messageChannel = mbinChannel; + mbinSubChannel->guestToHostQueue + = (EmbQueue*) HostPointer (mbinChannel->guestToHostQueue); + mbinSubChannel->guestToHostReturnQueue + = (EmbQueue*) HostPointer (mbinChannel->guestToHostReturnQueue); + mbinSubChannel->hostToGuestQueue + = (EmbQueue*) HostPointer (mbinChannel->hostToGuestQueue); + mbinSubChannel->hostToGuestSupplyQueue + = (EmbQueue*) HostPointer (mbinChannel->hostToGuestSupplyQueue); + SetSubtypeData (mbinChannel, mbinSubChannel); + ThreadActiveMessageChannel ((EmbMessageChannel*) mbinChannel); + activeMBINChannel = mbinSubChannel; + mbinSubChannel->guestToHostQueue->signal + = InstallSignalHandler((ProcPtrV)&SendMBINBuffers, (PtrV)mbinSubChannel, + FALSE); + command->resultCode = ESUCCESS; + } + break; + + default: + /* Unrecognized opcode */ + command->resultCode = EINVAL; + } + + EmbQueuePutWord (resultsQueue, commandPtr); + } + } +} + + +/* Reset a message channel */ + +void ResetMessageChannel (EmbChannel* channel) +{ + register EmbMessageChannel* messageChannel = (EmbMessageChannel*) channel; + register EmbMessageSubtypeData* subtypeData; + boolean allocatedByVLM; + + allocatedByVLM = GuestPointer (channel) > EmbCommAreaPtr->host_buffer_start + EmbCommAreaPtr->host_buffer_size; + + messageChannel->guestToHostImpulse = EmbMessageImpulseNone; + messageChannel->hostToGuestImpulse = EmbMessageImpulseNone; + subtypeData = (EmbMessageSubtypeData*) SubtypeData (messageChannel); + subtypeData->header.nextActiveChannel = NULL; + + switch (messageChannel->subtype) + { + case EmbMessageChannelCommandSubtype: + ResetIncomingQueue ((EmbQueue*) HostPointer (messageChannel->guestToHostQueue)); + ResetOutgoingQueue ((EmbQueue*) HostPointer (messageChannel->guestToHostReturnQueue)); + break; + + case EmbMessageChannelMBINSubtype: + ResetIncomingQueue ((EmbQueue*) HostPointer (messageChannel->guestToHostQueue)); + ResetOutgoingQueue ((EmbQueue*) HostPointer (messageChannel->guestToHostReturnQueue)); + ResetIncomingQueue ((EmbQueue*) HostPointer (messageChannel->hostToGuestSupplyQueue)); + ResetOutgoingQueue ((EmbQueue*) HostPointer (messageChannel->hostToGuestQueue)); + if (allocatedByVLM && (activeMBINChannel == (EmbMBINChannel*) subtypeData)) + activeMBINChannel = NULL; + break; + + default: + break; + } + + if (allocatedByVLM && subtypeData) + { + free (subtypeData); + SetSubtypeData (messageChannel, NULL); + } +} + + +/* Cleanup the message channels */ + +void TerminateMessageChannels () +{ + /* Command and MBIN message channels don't have any state subject to clean up other than + their signal handlers which have already been addressed by TerminateSignalHandlers */ +} diff --git a/life-support/network-darwin.c b/life-support/network-darwin.c new file mode 100644 index 0000000..a7c6dce --- /dev/null +++ b/life-support/network-darwin.c @@ -0,0 +1,31 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Network Life Support for Mac OS X (Darwin) */ + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "FEPComm.h" + + +/* Create the network channels */ + +void InitializeNetworkChannels (VLMConfig* config) +{ +} + + +/* Reset a network channel */ + +void ResetNetworkChannel (EmbChannel* channel) +{ +} + + +/* Cleanup the network channels */ + +void TerminateNetworkChannels () +{ +} diff --git a/life-support/network-libpcap.c b/life-support/network-libpcap.c new file mode 100644 index 0000000..e513477 --- /dev/null +++ b/life-support/network-libpcap.c @@ -0,0 +1,477 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Network Life Support for libpcap */ + +#include +#include +#include +#include +#include +#include +#include +#include "pfilt_wrapper.h" + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "FEPComm.h" + +static EmbNetChannel* pInputChannel; + +/* Create the network channels */ + +void InitializeNetworkChannels (VLMConfig* config) +{ + int ipSocket, savedLen, i; + bool tryAgain; + + printf("InitializeNetworkChannels()\n"); + + for (i = 0; i < MaxNetworkInterfaces; i++) { + if (config->interfaces[i].present) { + InitializeNetChannel (&config->interfaces[i], i); + } + } + +#ifdef MINIMA + WriteFEPCommSlot (localIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (diagnosticIPAddress, htonl (config->diagnosticIPAddress.s_addr), Type_Fixnum); + WriteFEPCommSlot (localIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask0, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask1, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (loadServerIPAddress, 0, Type_Fixnum); +#endif +} + + +/* Create a single network channel */ + +static void InitializeNetChannel (NetworkInterface* interface, int unitNumber) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbNetChannel)); + register EmbNetChannel* p = (EmbNetChannel*) HostPointer (cp); + + NetworkInterface* pInterface; + +#ifdef GENERA + struct in_addr guestAddress; + char addressAsString[_POSIX_ARG_MAX]; + boolean firstInterface; +#endif + + pInputChannel = p; + + p->type = EmbNetworkChannelType; + p->unit = unitNumber; + p->pcap = 0; + p->receiverThreadSetup = FALSE; /* .. */ + p->next = EmbCommAreaPtr->channel_table; /* Link into the channel list */ + EmbCommAreaPtr->channel_table = cp; + + if (!interface->device[0]) { + vpunt (NULL, "Missing ethernet interface name for network interface #%d", unitNumber); + } + + /* Open a packet socket and bind it to the interface */ + + { + char errbuf[1024]; /* the libpcap manual page does not specify how large this should be */ + p->pcap = pcap_open_live (interface->device, 1560, 1, 0, errbuf); + if (!p->pcap) { + vpunt (NULL, "Cannot open packet capturing device for network interface #%d: %s", unitNumber, errbuf); + } + } + + /* Create and attach the filter program */ + + if (pcap_compile (p->pcap, + &(p->filter), + "ether host 23:42:23:42:00:00", + 1, + htonl(0xFFFFFF00)) == -1) { + vpunt (NULL, "Error creating filter for network interface #%d: %s", unitNumber, pcap_geterr (p->pcap)); + } + + /* Finish initialization */ + + p->status = 0; + + p->nTransmitFailures = p->nReceiveFailures = 0; + + p->guestToHostQueue = CreateQueue (NetworkTransmitterQueueSize, sizeof (EmbPtr)); + p->guestToHostQ = (EmbQueue*) HostPointer (p->guestToHostQueue); + p->guestToHostQ->signal = InstallSignalHandler ((ProcPtrV) &NetworkChannelTransmitter, + (PtrV) p, FALSE); + + p->guestToHostReturnQueue = CreateQueue (NetworkTransmitterQueueSize, sizeof (EmbPtr)); + p->guestToHostReturnQ = (EmbQueue*) HostPointer (p->guestToHostReturnQueue); + + p->hostToGuestSupplyQueue = CreateQueue (NetworkReceiverQueueSize, sizeof (EmbPtr)); + p->hostToGuestSupplyQ = (EmbQueue*) HostPointer (p->hostToGuestSupplyQueue); + + p->hostToGuestQueue = CreateQueue (NetworkReceiverQueueSize, sizeof (EmbPtr)); + p->hostToGuestQ = (EmbQueue*) HostPointer (p->hostToGuestQueue); + +#ifdef GENERA + for (pInterface = interface, firstInterface = TRUE; pInterface != NULL; + pInterface = pInterface->anotherAddress, firstInterface = FALSE) { + if (firstInterface) + addressAsString[0] = 0; + else + sprintf (addressAsString, "%s,", addressAsString); + if (pInterface->device[0]) + sprintf (addressAsString, "%s%s:", addressAsString, pInterface->device); + switch (pInterface->myProtocol) { + case ETHERTYPE_IP: + guestAddress.s_addr = htonl (pInterface->myAddress.s_addr); + sprintf (addressAsString, "%sINTERNET|%s", addressAsString, + inet_ntoa (guestAddress)); + break; + case ETHERTYPE_CHAOS: + sprintf (addressAsString, "%sCHAOS|%o", addressAsString, + htonl (pInterface->myAddress.s_addr)); + break; + } + if (pInterface->myOptions[0]) + sprintf (addressAsString, "%s;%s", addressAsString, pInterface->myOptions); + } + printf("Initialize network interface #%d as \"%s\"\n", unitNumber, addressAsString); + p->addressString = MakeEmbString (addressAsString); +#endif + + if (pthread_create (&p->receiverThread, &EmbCommAreaPtr->inputThreadAttrs, + (pthread_startroutine_t) &NetworkChannelReceiver, (pthread_addr_t) p)) + vpunt (NULL, + "Unable to create thread to receive packets for VLM network interface #%d", + unitNumber); + p->receiverThreadSetup = TRUE; + + p->status |= EmbNetStatusHostReady; +} + +/* Reset a network channel */ + +void ResetNetworkChannel (EmbChannel* channel) +{ + register EmbNetChannel* netChannel = (EmbNetChannel*) channel; + +#ifdef OS_OSF + ioctl (netChannel->fd, EIOCFLUSH, 0); /* Flush incoming packets */ +#endif + + ResetIncomingQueue (netChannel->guestToHostQ); + ResetOutgoingQueue (netChannel->guestToHostReturnQ); + + ResetIncomingQueue (netChannel->hostToGuestSupplyQ); + ResetOutgoingQueue (netChannel->hostToGuestQ); +} + + +static char last_packet[1560]; + +static int +new_packet(char *packet, int size) +{ + if (memcmp(last_packet, packet, size) == 0) + return 0; + + memcpy(last_packet, packet, size); + + return 1; +} + +static void +recv_packet(char *packet, int size) +{ + register EmbNetChannel* netChannel = pInputChannel; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + + netPacketPtr = EmbQueueTakeWord (supplyQueue); + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord)size; + memcpy (&netPacket->data[0], packet, size); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, size); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); +} + +void +answer_arp(char *pkt, int size) +{ + char tmp[10]; + int i; + + pkt[21] = 2; + memcpy(tmp, &pkt[22], 10); + memcpy(&pkt[22], &pkt[32], 10); + + for (i = 0; i < 6; i++) + tmp[i] = i; + + memcpy(&pkt[32], tmp, 10); + + printf("answering arp\n"); + + recv_packet(pkt, size); +} + +void +dump_packet(char *who, unsigned char *pkt, int size) +{ + int i, offset = 0; + unsigned char *p, *pp; + unsigned short ptype; + int op, prot; + +#if 0 + p = pkt; + for (i = 0; i < 8; i++) { + printf("%04x: %02x %02x %02x %02x %02x %02x %02x %02x\n", + offset, p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); + offset += 8; + p += 8; + } +#endif + p = pkt; + ptype = (p[12]<<8)|p[13]; + + switch (ptype) { + case 0x0806: +#if 0 + printf("arp\n"); + op = (p[20]<<8)|p[21]; + if (op == 1) printf("request "); + if (op == 2) printf("response "); + printf("\n"); + p += 22; + printf("arp: sender %02x:%02x:%02x:%02x:%02x:%02x %u.%u.%u.%u\n", + p[0], p[1], p[2], p[3], p[4], p[5], + p[6], p[7], p[8], p[9]); + p += 10; + printf(" target %02x:%02x:%02x:%02x:%02x:%02x %u.%u.%u.%u", + p[0], p[1], p[2], p[3], p[4], p[5], + p[6], p[7], p[8], p[9]); + printf("\n"); + // answer_arp((char *)pkt, size); +#endif + break; + case 0x0800: + printf("%s ip: ", who); + p += 14; + prot = p[9]; + printf("%u.%u.%u.%u ", p[12], p[13], p[14], p[15]); + printf("%u.%u.%u.%u ", p[16], p[17], p[18], p[19]); + p += 20; + switch (prot) { + case 17: + printf("udp; %u %u", (p[0]<<8)|p[1], (p[2]<<8)|p[3]); + } + printf("\n"); + break; + default: + printf("%s ", who); + for (i = 0; i < 8; i++) { + printf("%04x: %02x %02x %02x %02x %02x %02x %02x %02x\n", + offset, + p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); + offset += 8; + p += 8; + } + break; + } +} + +/* Network Channel transmitter */ + +static void +NetworkChannelTransmitter(EmbNetChannel* pNetChannel) +{ +#if 0 + register EmbNetChannel* netChannel = pNetChannel; + register EmbQueue* transmitQueue = netChannel->guestToHostQ; + register EmbQueue* returnQueue = netChannel->guestToHostReturnQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t nBytes, actualBytes; + + while (EmbQueueFilled (transmitQueue)) { + if (0 == EmbQueueSpace (returnQueue)) { + /* Can't do I/O now because we can't return the buffer -- Try again later */ + SignalLater (transmitQueue->signal); + return; + } + + netPacketPtr = EmbQueueTakeWord (transmitQueue); + if (NULL == (void*)(uint64_t)netPacketPtr) netPacketPtr = NullEmbPtr; + + if (netPacketPtr != NullEmbPtr) { + if (/*netChannel->status & EmbNetStatusHostReady*/1) { + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + nBytes = (ssize_t) netPacket->nBytes; +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, nBytes); +#endif + + memcpy (netChannel->sll.sll_addr, ((struct ethhdr*)netPacket->data)->h_dest, + ETH_ALEN); +#if 0 + actualBytes = sendto (netChannel->fd, &netPacket->data[0], + nBytes, /*MSG_CONFIRM*/0, + (struct sockaddr*)&netChannel->sll, + sizeof (netChannel->sll)); +#else + actualBytes = sendto (netChannel->fd, &netPacket->data[0], + nBytes, /*MSG_CONFIRM*/0, + NULL, + sizeof (netChannel->sll)); +#endif + if (actualBytes != nBytes) { + printf("tx error\n"); + netChannel->nTransmitFailures++; + } +#if 1 + if (new_packet((char *)new_packet, nBytes) || 1) { + if (0) printf("NetworkChannelTransmitter() %p %d\n", netPacket, nBytes); + if (0) printf("%02x:%02x:%02x:%02x:%02x:%02x ", + netChannel->sll.sll_addr[0], netChannel->sll.sll_addr[1], + netChannel->sll.sll_addr[2], netChannel->sll.sll_addr[3], + netChannel->sll.sll_addr[4], netChannel->sll.sll_addr[5]); + dump_packet("tx", (unsigned char *)&netPacket->data[0], nBytes); + } +#endif + } + + EmbQueuePutWord (returnQueue, netPacketPtr); + } + } +#endif +} + +/* Network Channel receiver thread -- Can it be written to not copy??? */ + +#define OneMillisecond 1000000L + +static void NetworkChannelReceiver (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + register EmbNetChannel* netChannel = (EmbNetChannel*) argument; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + struct pollfd pollReceiver; + struct timespec receiverPause; + struct sockaddr sll; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t actualBytes; + socklen_t sllLen; + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + + WaitUntilInitializationComplete (); + + pollReceiver.fd = netChannel->fd; + pollReceiver.events = POLLIN; + + while (TRUE) { + pthread_testcancel (); + + pollReceiver.revents = 0; + poll (&pollReceiver, 1, 1000); + + if (0 == (pollReceiver.revents & POLLIN)) + continue; + + sllLen = sizeof (sll); + actualBytes = recvfrom (netChannel->fd, &netChannel->receiveBuffer, + MaxEmbNetPacketSize, MSG_TRUNC, + &sll, &sllLen); + dump_packet("rx", (unsigned char*)&netChannel->receiveBuffer, actualBytes); + + if (actualBytes < 0) + netChannel->nReceiveFailures++; + + else if (0 == actualBytes) + netChannel->nFalseReceiverWakeups++; + + // else if (!(netChannel->status & EmbNetStatusGuestReady)) + // ; + + else if ((0 == EmbQueueSpace (supplyQueue)) || (0 == EmbQueueSpace (receiveQueue))) + netChannel->nReceivedPacketsLost++; + + else { + while (0 == (netPacketPtr = EmbQueueTakeWord (supplyQueue))) { + receiverPause.tv_sec = 0; + receiverPause.tv_nsec = OneMillisecond; + if (pthread_delay_np (&receiverPause)) + vpunt (NULL, "Unable to sleep in thread %lx", self); + } + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord) actualBytes; + memcpy (&netPacket->data[0], &netChannel->receiveBuffer[0], actualBytes); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, actualBytes); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); + } + } + + pthread_cleanup_pop (TRUE); +} + + +/* Cleanup a single network channel */ + +static void TerminateNetChannel (EmbNetChannel* netChannel, int ipSocket) +{ +#if 0 + EmbNetARPReq *embARPReq; + void *exit_value; + + if (netChannel->receiverThreadSetup) { + pthread_cancel (netChannel->receiverThread); + pthread_join (netChannel->receiverThread, &exit_value); + netChannel->receiverThreadSetup = FALSE; + } + +#ifndef NOROOT + for (embARPReq = netChannel->arpReq; embARPReq != NULL; embARPReq->next) + ioctl (ipSocket, SIOCDARP, &embARPReq->arp); +#endif + + if (netChannel->fd != -1) { + close (netChannel->fd); + netChannel->fd = -1; + } +#endif +} + +/* Cleanup the network channels */ + +void TerminateNetworkChannels () +{ + EmbNetChannel* netChannel; + EmbPtr channel; + int ipSocket; + + ipSocket = socket (PF_INET, SOCK_STREAM, 0); + + for (channel = EmbCommAreaPtr->channel_table; + channel != NullEmbPtr; + channel = netChannel->next) { + netChannel = (EmbNetChannel*) HostPointer (channel); + if (EmbNetworkChannelType == netChannel->type) + TerminateNetChannel (netChannel, ipSocket); + } + + if (ipSocket > -1) + close (ipSocket); +} diff --git a/life-support/network-linux.c b/life-support/network-linux.c new file mode 100644 index 0000000..8575bc7 --- /dev/null +++ b/life-support/network-linux.c @@ -0,0 +1,773 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Network Life Support for Linux */ + +#if defined USE_TAP || defined USE_TUN +#else + +#include +#include +#include "pfilt_wrapper.h" +#include +#include +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "FEPComm.h" + +static EmbNetChannel* pInputChannel; +static void InitializeNetChannel (NetworkInterface* interface, int unitNumber, + int ipSocket, struct ifconf* ifc) ; + +/* Create the network channels */ + +void InitializeNetworkChannels (VLMConfig* config) +{ + struct ifconf ifc; + int ipSocket, savedLen, i; + bool tryAgain; + + printf("InitializeNetworkChannels()\n"); + + ipSocket = socket (PF_INET, SOCK_STREAM, 0); + if (ipSocket == -1) + vpunt (NULL, + "Unable to open IP socket to gather network interface information"); + + ifc.ifc_len = 32 * sizeof (struct ifreq); + ifc.ifc_buf = NULL; + tryAgain = TRUE; + + while (tryAgain) + { + ifc.ifc_buf = realloc (ifc.ifc_buf, ifc.ifc_len); + if (ifc.ifc_buf == NULL) + vpunt (NULL, + "Unable to obtain space to read IP addresses of network interfaces"); + savedLen = ifc.ifc_len; + if (ioctl (ipSocket, SIOCGIFCONF, &ifc) < 0) + vpunt (NULL, + "Unable to obtain IP addresses assigned to network interfaces"); + if (ifc.ifc_len == savedLen) + ifc.ifc_len = 2 * ifc.ifc_len; + else + tryAgain = FALSE; + } + + ifc.ifc_len = ifc.ifc_len / sizeof (struct ifreq); + + printf("MaxNetworkInterfaces %d\n", MaxNetworkInterfaces); + +printf("0 myAddress %08x\n", config->interfaces[0].myAddress.s_addr); + + for (i = 0; i < MaxNetworkInterfaces; i++) { + if (config->interfaces[i].present) { + InitializeNetChannel (&config->interfaces[i], i, ipSocket, &ifc); + } + } + + close (ipSocket); + +#ifdef MINIMA + WriteFEPCommSlot (localIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (diagnosticIPAddress, htonl (config->diagnosticIPAddress.s_addr), Type_Fixnum); + WriteFEPCommSlot (localIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask0, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask1, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (loadServerIPAddress, 0, Type_Fixnum); +#endif +} + + +/* Create a single network channel */ + +static void InitializeNetChannel (NetworkInterface* interface, int unitNumber, + int ipSocket, struct ifconf* ifc) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbNetChannel)); + register EmbNetChannel* p = (EmbNetChannel*) HostPointer (cp); + struct ifreq ifr; + struct if_nameindex *saved_ifs, *ifs; + /* A packet filter which will reject IP packets destined for the host */ +#if 0 + struct sock_filter localFilters[N_FILTERS] = + {BPF_STMT(BPF_LD+BPF_H+BPF_ABS, 0), + BPF_JUMP(BPF_JMP+BPF_JEQ+BPF_K, ETHERTYPE_IP, 0, 3), + BPF_STMT(BPF_LD+BPF_W+BPF_ABS, 0), + BPF_JUMP(BPF_JMP+BPF_JEQ+BPF_K, 0, 0, 1), + BPF_STMT(BPF_RET+BPF_K, 0), + BPF_STMT(BPF_RET+BPF_K, (u_int)-1), + }; +#else +#undef N_FILTERS +#define N_FILTERS 7 + struct sock_filter localFilters[N_FILTERS] = + {BPF_STMT(BPF_LD+BPF_H+BPF_ABS, 12), + BPF_JUMP(BPF_JMP+BPF_JEQ+BPF_K, ETHERTYPE_ARP, 3, 0), + BPF_JUMP(BPF_JMP+BPF_JEQ+BPF_K, ETHERTYPE_IP, 0, 3), + BPF_STMT(BPF_LD+BPF_W+BPF_ABS, 30), + BPF_JUMP(BPF_JMP+BPF_JEQ+BPF_K, 0, 0, 1), + BPF_STMT(BPF_RET+BPF_K, (u_int)-1), + BPF_STMT(BPF_RET+BPF_K, 0), + }; +#endif + /* u_short etherTypeOffset = offsetof (struct ether_header, ether_type) / sizeof (u_short); */ + /* u_short ipAddressOffset */ + /* = (offsetof (struct ip, ip_dst) + sizeof (struct ether_header)) / sizeof (u_short); */ + int interfaceIndex, i; + NetworkInterface* pInterface; +#ifdef GENERA + struct in_addr guestAddress; + char addressAsString[_POSIX_ARG_MAX]; + boolean firstInterface; +#endif + + pInputChannel = p; + + p->type = EmbNetworkChannelType; + p->unit = unitNumber; + p->fd = -1; /* Needed before linking into channel list */ + p->receiverThreadSetup = FALSE; /* .. */ + p->next = EmbCommAreaPtr->channel_table; /* Link into the channel list */ + EmbCommAreaPtr->channel_table = cp; + + if (interface->device[0]) + { + /* Verify that the requested device is running and is an Ethernet interface */ + + p->name0 = p->name1 = 0; + memcpy ((char*)&p->name0, interface->device, 2 * sizeof (EmbWord)); + +printf("device %s\n", interface->device); + + strncpy (ifr.ifr_name, interface->device, IFNAMSIZ); + + if (ioctl (ipSocket, SIOCGIFINDEX, &ifr) < 0) + vpunt (NULL, "Unable to determine interface index of network device %s", + interface->device); + interfaceIndex = ifr.ifr_ifindex; + + if (ioctl (ipSocket, SIOCGIFFLAGS, &ifr) < 0) + vpunt (NULL, "Unable to determine attributes of network device %s", + interface->device); + if (ifr.ifr_flags & IFF_LOOPBACK) + vpunt (NULL, "Unable to attach VLM network interface #%d to device %s" + " as it is a loopback device", + unitNumber, interface->device); + if ((ifr.ifr_flags & (IFF_UP | IFF_RUNNING)) != (IFF_UP | IFF_RUNNING)) + vpunt (NULL, "Unable to attach VLM network interface #%d to device %s" + " as it is not up and running", + unitNumber, interface->device); + + if (ioctl (ipSocket, SIOCGIFHWADDR, &ifr) < 0) + vpunt (NULL, + "Unable to determine hardware interface address for network device %s", + interface->device); + if (ifr.ifr_hwaddr.sa_family != ARPHRD_ETHER) + vpunt (NULL, "Unable to attach VLM network interface #%d to device %s" + " as it does not use Ethernet packet formats", + unitNumber, interface->device); + p->hardwareAddressHigh = p->hardwareAddressLow = 0; + memcpy ((char*)&p->hardwareAddressHigh, ifr.ifr_hwaddr.sa_data, 2 * sizeof (EmbWord)); + printf("hw address %#x %#x\n", + p->hardwareAddressHigh, + p->hardwareAddressLow); + + } + + else + { + /* No interface specified: Use the first available Ethernet interface */ + interfaceIndex = -1; + ifs = saved_ifs = if_nameindex(); + + while (ifs->if_index != 0 && ifs->if_name != NULL) + { + strncpy(ifr.ifr_name, ifs->if_name, IFNAMSIZ); + if (ioctl (ipSocket, SIOCGIFFLAGS, &ifr) < 0) + vpunt (NULL, "Unable to determine attributes of network device %s", + ifr.ifr_name); + if ((ifr.ifr_flags & (IFF_UP | IFF_RUNNING | IFF_LOOPBACK)) + == (IFF_UP | IFF_RUNNING)) + { + if (ioctl (ipSocket, SIOCGIFHWADDR, &ifr) < 0) + vpunt (NULL, "Unable to determine hardware address for network device %s", + ifr.ifr_name); + if (ifr.ifr_hwaddr.sa_family == ARPHRD_ETHER) + { + interfaceIndex = ifs->if_index; + strncpy (interface->device, ifs->if_name, IFNAMSIZ); + p->name0 = p->name1 = 0; + memcpy ((char*)&p->name0, ifs->if_name, 2 * sizeof (EmbWord)); + p->hardwareAddressHigh = p->hardwareAddressLow = 0; + memcpy ((char*)&p->hardwareAddressHigh, ifr.ifr_hwaddr.sa_data, + 2 * sizeof (EmbWord)); + break; + + } + } + ifs++; + } + + if_freenameindex (saved_ifs); + + if (interfaceIndex < 0) + vpunt (NULL, "Unable to find an Ethernet interface to attach" + " to VLM network interface #%d", + unitNumber); + } + + + /* Get IP address of interface */ + + p->hostPrimaryProtocol = -1; + + for (i = 0; i < ifc->ifc_len; i++) + { + if (strncmp (interface->device, ifc->ifc_req[i].ifr_name, IFNAMSIZ) == 0) + { + p->hostPrimaryProtocol = ETHERTYPE_IP; +#ifdef ARCH_X86_64 + p->hostPrimaryAddress + = ntohl(((struct sockaddr_in *)&ifc->ifc_req[i].ifr_addr)->sin_addr.s_addr); +#else + p->hostPrimaryAddress + = ((struct sockaddr_in *)&ifc->ifc_req[i].ifr_addr)->sin_addr.s_addr; +#endif + break; + } + } + + if (p->hostPrimaryProtocol == -1) + vpunt (NULL, "Unable to determine IP address assigned to network device %s", + interface->device); + + + /* Open a packet socket and bind it to the interface */ + +#ifndef NOROOT + +printf("hostPrimaryAddress %#x\n", p->hostPrimaryAddress); +printf("guestPrimaryAddress %#x\n", p->guestPrimaryAddress); + + p->fd = socket (PF_PACKET, SOCK_RAW, htons (ETH_P_ALL)); + if (p->fd < 0) + vpunt (NULL, "Unable to open packet socket for VLM network interface #%d", + unitNumber); +#endif + + memset (&p->sll, 0, sizeof (p->sll)); + p->sll.sll_family = AF_PACKET; + p->sll.sll_ifindex = interfaceIndex; + p->sll.sll_protocol = htons (ETH_P_ALL); + +#ifndef NOROOT + if (bind (p->fd, (struct sockaddr *)&p->sll, sizeof (p->sll)) < 0) + vpunt (NULL, "Unable to attach VLM network interface #%d to device %s", + unitNumber, interface->device); +#endif + + p->sll.sll_protocol = 0; /* Transmission requires this value be zero... */ + p->sll.sll_halen = ETH_ALEN; + + + /* Set attributes (e.g., copyall, not promiscuous */ + +#ifdef OS_OSF + ioctlBits = ENHOLDSIG | ENNONEXCL | ENCOPYALL; + if (-1 == ioctl (p->fd, EIOCMBIS, &ioctlBits)) + vpunt (NULL, "Unable to set attributes for VLM network interface #%d", unitNumber); + + ioctlBits = ENBATCH | ENTSTAMP | ENPROMISC | ENBPFHDR; + if (-1 == ioctl (p->fd, EIOCMBIC, &ioctlBits)) + vpunt (NULL, "Unable to clear attributes for VLM network interface #%d", unitNumber); + + timeout.tv_sec = timeout.tv_usec = 0; /* Wait indefinitely for packets */ + if (-1 == ioctl (p->fd, EIOCSRTIMEOUT, &timeout)) + vpunt (NULL, "Unable to set packet timeout for VLM network interface #%d", unitNumber); + + x = deviceParms.end_MTU; /* TEMPORARY workaround to DEC bug */ + x = (x < MaxEmbNetPacketSize) ? x : MaxEmbNetPacketSize; + if (-1 == ioctl (p->fd, EIOCTRUNCATE, &x)) + vpunt (NULL, "Unable to set maximum packet size for VLM network interface #%d", + unitNumber); + + x = -1; /* -1 => Get maximum allowable queue size */ + if (-1 == ioctl (p->fd, EIOCMAXBACKLOG, &x)) + vpunt (NULL, "Unable to determine maximum queue size for VLM network interface #%d", + unitNumber); + if (-1 == ioctl (p->fd, EIOCSETW, &x)) + vpunt (NULL, "Unable to set queue size for VLM network interface #%d", unitNumber); +#endif + + + /* Create and attach the filter program */ + +//localFilters[4].k = htonl(0x4c04f5c0); +//localFilters[4].k = htonl(0x1704f5c0); +//localFilters[4].k = 0xc0f50417; + +printf("filter myAddress %08x\n", interface->myAddress.s_addr); + localFilters[4].k = interface->myAddress.s_addr; + + memcpy (p->filter.filters, localFilters, sizeof (localFilters)); + p->filter.fprog.len = N_FILTERS; + p->filter.fprog.filter = (struct sock_filter*)&p->filter.filters; + +#ifndef NOROOT +printf("attach filter\n"); + if (setsockopt (p->fd, SOL_SOCKET, SO_ATTACH_FILTER, + &p->filter.fprog, sizeof (struct sock_fprog))) + vpunt (NULL, "Unable to set packet filter program for VLM network interface #%d", + unitNumber); +#endif + + + /* Create entries in the host's ARP table for each IP address assigned to this channel */ + + p->arpReq = NULL; + +#ifdef GENERA + for (pInterface = interface; pInterface != NULL; pInterface = pInterface->anotherAddress) +#else + pInterface = interface; +#endif + { + if (pInterface->myProtocol == ETHERTYPE_IP) + { + EmbPtr arpReqPtr = EmbCommAreaAlloc (sizeof (EmbNetARPReq)); + register EmbNetARPReq* pARP = (EmbNetARPReq*) HostPointer (arpReqPtr); + pARP->next = p->arpReq; + p->arpReq = pARP; + + pARP->arp.arp_pa.sa_family = AF_INET; + ((struct sockaddr_in *)&pARP->arp.arp_pa)->sin_addr.s_addr + = htonl (pInterface->myAddress.s_addr); + + pARP->arp.arp_ha.sa_family = ARPHRD_ETHER; /* Only supported interface type */ + memcpy (pARP->arp.arp_ha.sa_data, &p->hardwareAddressHigh, 2 * sizeof (EmbWord)); + + pARP->arp.arp_flags = ATF_COM | ATF_PERM /* | ATF_PUBL */ ; + memcpy (pARP->arp.arp_dev, interface->device, sizeof (pARP->arp.arp_dev)); + /* Only first interface structure has the device */ + +#ifndef NOROOT + if (ioctl (ipSocket, SIOCSARP, &pARP->arp) < 0) + vpunt (NULL, "Unable to establish ARP mappings for VLM network interface #%d", + unitNumber); +#endif + } + } + + + /* Finish initialization */ + + p->status = 0; + p->guestPrimaryProtocol = interface->myProtocol; +#ifdef ARCH_X86_64 + p->guestPrimaryAddress = interface->myAddress.s_addr; +#else + p->guestPrimaryAddress = htonl (interface->myAddress.s_addr); +#endif + +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&p->hardwareAddressHigh, 2 * sizeof (EmbWord)); +#endif + + p->nTransmitFailures = p->nReceiveFailures = 0; + + p->guestToHostQueue = CreateQueue (NetworkTransmitterQueueSize, sizeof (EmbPtr)); + p->guestToHostQ = (EmbQueue*) HostPointer (p->guestToHostQueue); + p->guestToHostQ->signal = InstallSignalHandler ((ProcPtrV) &NetworkChannelTransmitter, + (PtrV) p, FALSE); + + p->guestToHostReturnQueue = CreateQueue (NetworkTransmitterQueueSize, sizeof (EmbPtr)); + p->guestToHostReturnQ = (EmbQueue*) HostPointer (p->guestToHostReturnQueue); + + p->hostToGuestSupplyQueue = CreateQueue (NetworkReceiverQueueSize, sizeof (EmbPtr)); + p->hostToGuestSupplyQ = (EmbQueue*) HostPointer (p->hostToGuestSupplyQueue); + + p->hostToGuestQueue = CreateQueue (NetworkReceiverQueueSize, sizeof (EmbPtr)); + p->hostToGuestQ = (EmbQueue*) HostPointer (p->hostToGuestQueue); + +#ifdef GENERA + for (pInterface = interface, firstInterface = TRUE; pInterface != NULL; + pInterface = pInterface->anotherAddress, firstInterface = FALSE) + { + if (firstInterface) + addressAsString[0] = 0; + else + sprintf (addressAsString, "%s,", addressAsString); + if (pInterface->device[0]) + sprintf (addressAsString, "%s%s:", addressAsString, pInterface->device); + switch (pInterface->myProtocol) + { + case ETHERTYPE_IP: + guestAddress.s_addr = htonl (pInterface->myAddress.s_addr); + sprintf (addressAsString, "%sINTERNET|%s", addressAsString, + inet_ntoa (guestAddress)); + break; + case ETHERTYPE_CHAOS: + sprintf (addressAsString, "%sCHAOS|%o", addressAsString, + htonl (pInterface->myAddress.s_addr)); + break; + } + if (pInterface->myOptions[0]) + sprintf (addressAsString, "%s;%s", addressAsString, pInterface->myOptions); + } + p->addressString = MakeEmbString (addressAsString); +#endif + + if (pthread_create (&p->receiverThread, &EmbCommAreaPtr->inputThreadAttrs, + (pthread_startroutine_t) &NetworkChannelReceiver, (pthread_addr_t) p)) + vpunt (NULL, + "Unable to create thread to receive packets for VLM network interface #%d", + unitNumber); + p->receiverThreadSetup = TRUE; + + p->status |= EmbNetStatusHostReady; +} + + +/* Reset a network channel */ + +void ResetNetworkChannel (EmbChannel* channel) +{ + register EmbNetChannel* netChannel = (EmbNetChannel*) channel; + +#ifdef OS_OSF + ioctl (netChannel->fd, EIOCFLUSH, 0); /* Flush incoming packets */ +#endif + + ResetIncomingQueue (netChannel->guestToHostQ); + ResetOutgoingQueue (netChannel->guestToHostReturnQ); + + ResetIncomingQueue (netChannel->hostToGuestSupplyQ); + ResetOutgoingQueue (netChannel->hostToGuestQ); +} + + +static char last_packet[1560]; + +static int +new_packet(char *packet, int size) +{ + if (memcmp(last_packet, packet, size) == 0) + return 0; + + memcpy(last_packet, packet, size); + + return 1; +} + +static void +recv_packet(char *packet, int size) +{ + register EmbNetChannel* netChannel = pInputChannel; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + + netPacketPtr = EmbQueueTakeWord (supplyQueue); + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord)size; + memcpy (&netPacket->data[0], packet, size); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, size); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); +} + +void +answer_arp(char *pkt, int size) +{ + char tmp[10]; + int i; + + pkt[21] = 2; + memcpy(tmp, &pkt[22], 10); + memcpy(&pkt[22], &pkt[32], 10); + + for (i = 0; i < 6; i++) + tmp[i] = i; + + memcpy(&pkt[32], tmp, 10); + + printf("answering arp\n"); + + recv_packet(pkt, size); +} + +void +dump_packet(char *who, unsigned char *pkt, int size) +{ + int i, offset = 0; + unsigned char *p; + unsigned short ptype; + int prot; + +#if 0 + p = pkt; + for (i = 0; i < 8; i++) { + printf("%04x: %02x %02x %02x %02x %02x %02x %02x %02x\n", + offset, p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); + offset += 8; + p += 8; + } +#endif + p = pkt; + ptype = (p[12]<<8)|p[13]; + + switch (ptype) { + case 0x0806: +#if 0 + printf("arp\n"); + op = (p[20]<<8)|p[21]; + if (op == 1) printf("request "); + if (op == 2) printf("response "); + printf("\n"); + p += 22; + printf("arp: sender %02x:%02x:%02x:%02x:%02x:%02x %u.%u.%u.%u\n", + p[0], p[1], p[2], p[3], p[4], p[5], + p[6], p[7], p[8], p[9]); + p += 10; + printf(" target %02x:%02x:%02x:%02x:%02x:%02x %u.%u.%u.%u", + p[0], p[1], p[2], p[3], p[4], p[5], + p[6], p[7], p[8], p[9]); + printf("\n"); +// answer_arp((char *)pkt, size); +#endif + break; + case 0x0800: + printf("%s ip: ", who); + p += 14; + prot = p[9]; + printf("%u.%u.%u.%u ", p[12], p[13], p[14], p[15]); + printf("%u.%u.%u.%u ", p[16], p[17], p[18], p[19]); + p += 20; + switch (prot) { + case 17: + printf("udp; %u %u", (p[0]<<8)|p[1], (p[2]<<8)|p[3]); + } + printf("\n"); + break; + default: + printf("%s ", who); + for (i = 0; i < 8; i++) { + printf("%04x: %02x %02x %02x %02x %02x %02x %02x %02x\n", + offset, + p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); + offset += 8; + p += 8; + } + break; + } +} + +/* Network Channel transmitter */ + +void NetworkChannelTransmitter (EmbNetChannel* pNetChannel) +{ + register EmbNetChannel* netChannel = pNetChannel; + register EmbQueue* transmitQueue = netChannel->guestToHostQ; + register EmbQueue* returnQueue = netChannel->guestToHostReturnQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t nBytes, actualBytes; + + + while (EmbQueueFilled (transmitQueue)) + { + if (0 == EmbQueueSpace (returnQueue)) + { + /* Can't do I/O now because we can't return the buffer -- Try again later */ + SignalLater (transmitQueue->signal); + return; + } + + netPacketPtr = EmbQueueTakeWord (transmitQueue); + if (NULL == (void*)(uint64_t)netPacketPtr) netPacketPtr = NullEmbPtr; + + if (netPacketPtr != NullEmbPtr) + { + if (/*netChannel->status & EmbNetStatusHostReady*/1) + { + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + nBytes = (ssize_t) netPacket->nBytes; +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, nBytes); +#endif + + memcpy (netChannel->sll.sll_addr, ((struct ethhdr*)netPacket->data)->h_dest, + ETH_ALEN); +#if 0 + actualBytes = sendto (netChannel->fd, &netPacket->data[0], + nBytes, /*MSG_CONFIRM*/0, + (struct sockaddr*)&netChannel->sll, + sizeof (netChannel->sll)); +#else + actualBytes = sendto (netChannel->fd, &netPacket->data[0], + nBytes, /*MSG_CONFIRM*/0, + NULL, + sizeof (netChannel->sll)); +#endif + if (actualBytes != nBytes) + { +printf("tx error\n"); + netChannel->nTransmitFailures++; + } +#if 1 + if (new_packet((char *)new_packet, nBytes) || 1) { + if (0) printf("NetworkChannelTransmitter() %p %zd\n", netPacket, nBytes); + if (0) printf("%02x:%02x:%02x:%02x:%02x:%02x ", + netChannel->sll.sll_addr[0], netChannel->sll.sll_addr[1], + netChannel->sll.sll_addr[2], netChannel->sll.sll_addr[3], + netChannel->sll.sll_addr[4], netChannel->sll.sll_addr[5]); + dump_packet("tx", (unsigned char *)&netPacket->data[0], nBytes); + } +#endif + } + + EmbQueuePutWord (returnQueue, netPacketPtr); + } + } +} + + +/* Network Channel receiver thread -- Can it be written to not copy??? */ + +#define OneMillisecond 1000000L + +void NetworkChannelReceiver (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + register EmbNetChannel* netChannel = (EmbNetChannel*) argument; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + struct pollfd pollReceiver; + struct timespec receiverPause; + struct sockaddr_ll sll; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t actualBytes; + socklen_t sllLen; + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + + WaitUntilInitializationComplete (); + + pollReceiver.fd = netChannel->fd; + pollReceiver.events = POLLIN; + + while (TRUE) + { + pthread_testcancel (); + + pollReceiver.revents = 0; + poll (&pollReceiver, 1, 1000); + + if (0 == (pollReceiver.revents & POLLIN)) + continue; + + sllLen = sizeof (sll); + actualBytes = recvfrom (netChannel->fd, &netChannel->receiveBuffer, + MaxEmbNetPacketSize, MSG_TRUNC, + (struct sockaddr*)&sll, &sllLen); + dump_packet("rx", + (unsigned char *)&netChannel->receiveBuffer, + actualBytes); + + if (actualBytes < 0) + netChannel->nReceiveFailures++; + + else if (0 == actualBytes) + netChannel->nFalseReceiverWakeups++; + +// else if (!(netChannel->status & EmbNetStatusGuestReady)) +// ; + + else if ((0 == EmbQueueSpace (supplyQueue)) || (0 == EmbQueueSpace (receiveQueue))) + netChannel->nReceivedPacketsLost++; + + else + { + while (0 == (netPacketPtr = EmbQueueTakeWord (supplyQueue))) + { + receiverPause.tv_sec = 0; + receiverPause.tv_nsec = OneMillisecond; + if (pthread_delay_np (&receiverPause)) + vpunt (NULL, "Unable to sleep in thread %lx", self); + } + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord) actualBytes; + memcpy (&netPacket->data[0], &netChannel->receiveBuffer[0], actualBytes); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, actualBytes); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); + } + } + + pthread_cleanup_pop (TRUE); +} + + +/* Cleanup a single network channel */ + +static void TerminateNetChannel (EmbNetChannel* netChannel, int ipSocket) +{ + /* EmbNetARPReq *embARPReq; */ + void *exit_value; + + if (netChannel->receiverThreadSetup) + { + pthread_cancel (netChannel->receiverThread); + pthread_join (netChannel->receiverThread, &exit_value); + netChannel->receiverThreadSetup = FALSE; + } + +#ifndef NOROOT + /* for (embARPReq = netChannel->arpReq; */ + /* embARPReq != NULL; */ + /* embARPReq->next) */ + /* ioctl (ipSocket, SIOCDARP, &embARPReq->arp); */ +#endif + + if (netChannel->fd != -1) + { + close (netChannel->fd); + netChannel->fd = -1; + } +} + + +/* Cleanup the network channels */ + +void TerminateNetworkChannels () +{ + EmbNetChannel* netChannel; + EmbPtr channel; + int ipSocket; + + ipSocket = socket (PF_INET, SOCK_STREAM, 0); + + for (channel = EmbCommAreaPtr->channel_table; channel != NullEmbPtr; + channel = netChannel->next) + { + netChannel = (EmbNetChannel*) HostPointer (channel); + if (EmbNetworkChannelType == netChannel->type) + TerminateNetChannel (netChannel, ipSocket); + } + + if (ipSocket > -1) + close (ipSocket); +} + +#endif /* USE_TAP */ diff --git a/life-support/network-osf.c b/life-support/network-osf.c new file mode 100644 index 0000000..1cd87b7 --- /dev/null +++ b/life-support/network-osf.c @@ -0,0 +1,492 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Network Life Support for OSF (Tru64 UNIX) */ + +#include +#include +#include +#include + +#include +#include +#include "pfilt_wrapper.h" +#include +#define _NO_BITFIELDS +#include +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "FEPComm.h" + + +/* Create the network channels */ + +void InitializeNetworkChannels (VLMConfig* config) +{ + struct hostent* localHostEntry; + struct in_addr localHostAddress; + char localHost[MAXHOSTNAMELEN]; + int i; + + if (gethostname (localHost, sizeof (localHost))) + vpunt (NULL, "Unable to determine local host name"); + + if (NULL == (localHostEntry = gethostbyname (localHost))) + vpunt (NULL, "Unable to determine local host network address"); + + memcpy ((char*)&localHostAddress.s_addr, localHostEntry->h_addr, + sizeof (localHostAddress.s_addr)); + + for (i = 0; i < MaxNetworkInterfaces; i++) + if (config->interfaces[i].present) + InitializeNetChannel (&config->interfaces[i], i, &localHostAddress); + +#ifdef MINIMA + WriteFEPCommSlot (localIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (diagnosticIPAddress, htonl (config->diagnosticIPAddress.s_addr), Type_Fixnum); + WriteFEPCommSlot (localIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask0, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask1, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (loadServerIPAddress, 0, Type_Fixnum); +#endif +} + + +/* Create a single network channel */ + +static void InitializeNetChannel (NetworkInterface* interface, int unitNumber, + struct in_addr* localHostAddress) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbNetChannel)); + register EmbNetChannel* p = (EmbNetChannel*) HostPointer (cp); + struct ifreq hardwareInterface; + struct endevp deviceParms; + struct timeval timeout; + u_short ioctlBits, *fp; + int x; + u_short etherTypeOffset = offsetof (struct ether_header, ether_type) / sizeof (u_short); + u_short ipAddressOffset = (offsetof (struct ip, ip_dst) + sizeof (struct ether_header)) / sizeof (u_short); +#ifdef GENERA + struct in_addr guestAddress; + char addressAsString[_POSIX_ARG_MAX]; + boolean firstInterface; +#endif + + p->type = EmbNetworkChannelType; + p->unit = unitNumber; + p->fd = -1; /* Needed before linking into channel list */ + p->receiverThreadSetup = FALSE; /* .. */ + p->next = EmbCommAreaPtr->channel_table; /* Link into the channel list */ + EmbCommAreaPtr->channel_table = cp; + +/*#define NOROOT*/ +#ifndef NOROOT + p->fd = pfopen ((0 == interface->device[0]) ? NULL : interface->device, O_RDWR); + if (-1 == p->fd) + vpunt (NULL, "Unable to open VLM network interface #%d using %s", unitNumber, + (0 == interface->device[0]) ? "the default channel" : interface->device); + + if (-1 == ioctl (p->fd, EIOCIFNAME, &hardwareInterface)) + vpunt (NULL, + "Unable to determine hardware interface name for VLM network interface #%d", + unitNumber); +#endif + p->name0 = p->name1 = 0; + memcpy ((char*)&p->name0, hardwareInterface.ifr_name, 2* sizeof (EmbWord)); + + p->status = 0; + p->hostPrimaryProtocol = ETHERTYPE_IP; + p->hostPrimaryAddress = ntohl (localHostAddress->s_addr); + p->guestPrimaryAddress = ntohl (interface->myAddress.s_addr); + p->guestPrimaryAddress = interface->myAddress.s_addr; + +#ifndef NOROOT + if (-1 == ioctl (p->fd, EIOCDEVP, &deviceParms)) + vpunt (NULL, + "Unable to determine hardware interface address for VLM network interface #%d", + unitNumber); +#endif + p->hardwareAddressHigh = p->hardwareAddressLow = 0; + memcpy ((char*)&p->hardwareAddressHigh, deviceParms.end_addr, deviceParms.end_addr_len); + +#ifndef NOROOT + x = 1; + if (-1 == ioctl (p->fd, EIOCALLOWPROMISC, &x)) + vpunt (NULL, "Unable to set ALLOWPROMISC for VLM network interface #%d", unitNumber); + + x = 1; + if (-1 == ioctl (p->fd, EIOCALLOWCOPYALL, &x)) + vpunt (NULL, "Unable to set ALLOWCOPYALL for VLM network interface #%d", unitNumber); + + ioctlBits = ENHOLDSIG | ENNONEXCL | ENCOPYALL; + if (-1 == ioctl (p->fd, EIOCMBIS, &ioctlBits)) + vpunt (NULL, "Unable to set attributes for VLM network interface #%d", unitNumber); + + ioctlBits = ENBATCH | ENTSTAMP | ENPROMISC | ENBPFHDR; + if (-1 == ioctl (p->fd, EIOCMBIC, &ioctlBits)) + vpunt (NULL, "Unable to clear attributes for VLM network interface #%d", unitNumber); + + timeout.tv_sec = timeout.tv_usec = 0; /* Wait indefinitely for packets */ + if (-1 == ioctl (p->fd, EIOCSRTIMEOUT, &timeout)) + vpunt (NULL, "Unable to set packet timeout for VLM network interface #%d", unitNumber); + +#if 0 + x = deviceParms.end_MTU; /* TEMPORARY workaround to DEC bug */ + x = (x < MaxEmbNetPacketSize) ? x : MaxEmbNetPacketSize; + if (-1 == ioctl (p->fd, EIOCTRUNCATE, &x)) + vpunt (NULL, "Unable to set maximum packet size for VLM network interface #%d", + unitNumber); +#endif + + x = -1; /* -1 => Get maximum allowable queue size */ + if (-1 == ioctl (p->fd, EIOCMAXBACKLOG, &x)) + vpunt (NULL, "Unable to determine maximum queue size for VLM network interface #%d", + unitNumber); + if (-1 == ioctl (p->fd, EIOCSETW, &x)) + vpunt (NULL, "Unable to set queue size for VLM network interface #%d", unitNumber); +#endif + + p->filter.enf_Priority = 255; /* Maximum priority */ +p->filter.enf_Priority = 10; + + /* A packet filter which will reject IP packets destined for the host */ + fp = &p->filter.enf_Filter[0]; +#if 0 + *fp++ = ENF_PUSHWORD + etherTypeOffset; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (ETHERTYPE_IP); + *fp++ = ENF_NEQ; /* TRUE if not an IP packet */ + *fp++ = ENF_PUSHWORD + ipAddressOffset; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->hostPrimaryAddress >> 16); + *fp++ = ENF_NEQ; /* TRUE if top of addresses don't match */ + *fp++ = ENF_PUSHWORD + ipAddressOffset + 1; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->hostPrimaryAddress); + *fp++ = ENF_NEQ; /* TRUE if bottom of addresses don't match */ + *fp++ = ENF_OR; /* TRUE if addresses don't match */ + *fp++ = ENF_OR; /* TRUE if not IP or addresses don't match */ +#else + + /* not ip-packet or (( not to-host and not from-host ) | to-us) */ + + /* not IP packet */ + *fp++ = ENF_PUSHWORD + etherTypeOffset; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (ETHERTYPE_IP); + *fp++ = ENF_NEQ; /* TRUE if not an IP packet */ + + /* not to host */ + *fp++ = ENF_PUSHWORD + ipAddressOffset; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->hostPrimaryAddress >> 16); + *fp++ = ENF_NEQ; /* TRUE if top of addresses don't match */ + *fp++ = ENF_PUSHWORD + ipAddressOffset + 1; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->hostPrimaryAddress); + *fp++ = ENF_NEQ; /* TRUE if bottom of addresses don't match */ + *fp++ = ENF_OR; /* TRUE if addresses don't match */ + + /* not from host */ + *fp++ = ENF_PUSHWORD + ipAddressOffset - 2; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->hostPrimaryAddress >> 16); + *fp++ = ENF_NEQ; + *fp++ = ENF_PUSHWORD + ipAddressOffset - 2 + 1; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->hostPrimaryAddress); + *fp++ = ENF_NEQ; + *fp++ = ENF_OR; + + *fp++ = ENF_AND; + + /* to us */ + *fp++ = ENF_PUSHWORD + ipAddressOffset; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->guestPrimaryAddress >> 16); + *fp++ = ENF_EQ; + *fp++ = ENF_PUSHWORD + ipAddressOffset + 1; + *fp++ = ENF_PUSHLIT; + *fp++ = htons (p->guestPrimaryAddress); + *fp++ = ENF_EQ; + *fp++ = ENF_AND; + + *fp++ = ENF_OR; + + *fp++ = ENF_OR; +#endif + + p->filter.enf_FilterLen = fp - &p->filter.enf_Filter[0]; + + { + struct in_addr a; + a.s_addr = htonl(p->hostPrimaryAddress); + printf("p->hostPrimaryAddress %08x\n", p->hostPrimaryAddress); + printf("hostPrimaryAddress %s\n", inet_ntoa(a)); + } + +#ifndef NOROOT + if (-1 == ioctl (p->fd, EIOCSETF, &p->filter)) + vpunt (NULL, "Unable to set packet filter program for VLM network interface #%d", + unitNumber); +#endif + + p->nTransmitFailures = p->nReceiveFailures = 0; + + p->guestToHostQueue = CreateQueue (NetworkTransmitterQueueSize, sizeof (EmbPtr)); + p->guestToHostQ = (EmbQueue*) HostPointer (p->guestToHostQueue); + p->guestToHostQ->signal = InstallSignalHandler ((ProcPtrV) &NetworkChannelTransmitter, + (PtrV) p, FALSE); + + p->guestToHostReturnQueue = CreateQueue (NetworkTransmitterQueueSize, sizeof (EmbPtr)); + p->guestToHostReturnQ = (EmbQueue*) HostPointer (p->guestToHostReturnQueue); + + p->hostToGuestSupplyQueue = CreateQueue (NetworkReceiverQueueSize, sizeof (EmbPtr)); + p->hostToGuestSupplyQ = (EmbQueue*) HostPointer (p->hostToGuestSupplyQueue); + + p->hostToGuestQueue = CreateQueue (NetworkReceiverQueueSize, sizeof (EmbPtr)); + p->hostToGuestQ = (EmbQueue*) HostPointer (p->hostToGuestQueue); + +#ifdef GENERA + for (interface = interface, firstInterface = TRUE; interface != NULL; + interface = interface->anotherAddress, firstInterface = FALSE) + { + if (firstInterface) + addressAsString[0] = 0; + else + sprintf (addressAsString, "%s,", addressAsString); + if (interface->device[0]) + sprintf (addressAsString, "%s%s:", addressAsString, interface->device); + switch (interface->myProtocol) + { + case ETHERTYPE_IP: + guestAddress.s_addr = htonl (interface->myAddress.s_addr); + sprintf (addressAsString, "%sINTERNET|%s", addressAsString, + inet_ntoa (guestAddress)); + break; + case ETHERTYPE_CHAOS: + sprintf (addressAsString, "%sCHAOS|%o", addressAsString, + htonl (interface->myAddress.s_addr)); + break; + } + if (interface->myOptions[0]) + sprintf (addressAsString, "%s;%s", addressAsString, interface->myOptions); + } + p->addressString = MakeEmbString (addressAsString); +printf("%s\n", addressAsString); +#endif + + if (pthread_create (&p->receiverThread, &EmbCommAreaPtr->inputThreadAttrs, + (pthread_startroutine_t) &NetworkChannelReceiver, (pthread_addr_t) p)) + vpunt (NULL, + "Unable to create thread to receive packets for VLM network interface #%d", + unitNumber); + p->receiverThreadSetup = TRUE; + + p->status |= EmbNetStatusHostReady; +} + + +/* Reset a network channel */ + +void ResetNetworkChannel (EmbChannel* channel) +{ + register EmbNetChannel* netChannel = (EmbNetChannel*) channel; + + ioctl (netChannel->fd, EIOCFLUSH, 0); + + ResetIncomingQueue (netChannel->guestToHostQ); + ResetOutgoingQueue (netChannel->guestToHostReturnQ); + + ResetIncomingQueue (netChannel->hostToGuestSupplyQ); + ResetOutgoingQueue (netChannel->hostToGuestQ); +} + +#if 1 +static void show_packet(char *who, unsigned char *pkt) +{ + unsigned char *p; + char *prot; + unsigned short sp, dp; + p = pkt; + if (p[12] == 0x08 && p[13] == 0) { + switch (p[14+9/*20-11*/]) { + case 1: prot = "icmp"; break; + case 6: prot = "tcp"; break; + case 17: prot = "udp"; break; + default: prot = "?"; + } + sp = (p[14+20+0] << 8) | p[14+20+1]; + dp = (p[14+20+2] << 8) | p[14+20+3]; + printf("%s %u.%u.%u.%u:%u -> %u.%u.%u.%u:%u %s\n", + who, + p[14+20-8], p[14+20-7], p[14+20-6], p[14+20-5], sp, + p[14+20-4], p[14+20-3], p[14+20-2], p[14+20-1], dp, + prot); + } + if (p[12] == 0x08 && p[13] == 6) { + printf("."); + fflush(stdout); + } +} +#endif + +/* Network Channel transmitter */ + +static void NetworkChannelTransmitter (EmbNetChannel* pNetChannel) +{ + register EmbNetChannel* netChannel = pNetChannel; + register EmbQueue* transmitQueue = netChannel->guestToHostQ; + register EmbQueue* returnQueue = netChannel->guestToHostReturnQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t nBytes, actualBytes; + +if (0) printf("NetworkChannelTransmitter()\n"); + while (EmbQueueFilled (transmitQueue)) + { + if (0 == EmbQueueSpace (returnQueue)) + { + /* Can't do I/O now because we can't return the buffer -- Try again later */ + SignalLater (transmitQueue->signal); + return; + } + + netPacketPtr = EmbQueueTakeWord (transmitQueue); + if (NULL == netPacketPtr) netPacketPtr = NullEmbPtr; + + if (netPacketPtr != NullEmbPtr) + { + if (netChannel->status & EmbNetStatusHostReady) + { + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + nBytes = (ssize_t) netPacket->nBytes; +#ifndef NOROOT +show_packet("tx", (unsigned char *)&netPacket->data[0]); + actualBytes = write (netChannel->fd, &netPacket->data[0], nBytes); +#else + actualBytes = 0; +#endif + if (actualBytes != nBytes) + { + netChannel->nTransmitFailures++; + } + } + + EmbQueuePutWord (returnQueue, netPacketPtr); + } + } +} + + +/* Network Channel receiver thread -- Can it be written to not copy??? */ + +#define OneMillisecond 1000000L + +static void NetworkChannelReceiver (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + register EmbNetChannel* netChannel = (EmbNetChannel*) argument; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + struct pollfd pollReceiver; + struct timespec receiverPause; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t actualBytes; + + pthread_cleanup_push (pthread_detach, &self); + + WaitUntilInitializationComplete (); + + pollReceiver.fd = netChannel->fd; + pollReceiver.events = POLLNORM; + + while (TRUE) + { + pthread_testcancel (); + + pollReceiver.revents = 0; + poll (&pollReceiver, 1, 1000); + + if (0 == (pollReceiver.revents & POLLNORM)) + continue; + + actualBytes = read (netChannel->fd, &netChannel->receiveBuffer, MaxEmbNetPacketSize); + + if (actualBytes < 0) + netChannel->nReceiveFailures++; + + else if (0 == actualBytes) + netChannel->nFalseReceiverWakeups++; + + else if (!(netChannel->status & EmbNetStatusGuestReady)) + ; + + else if ((0 == EmbQueueSpace (supplyQueue)) || (0 == EmbQueueSpace (receiveQueue))) + netChannel->nReceivedPacketsLost++; + + else + { +show_packet("rx", (unsigned char *)&netChannel->receiveBuffer); + + while (0 == (netPacketPtr = EmbQueueTakeWord (supplyQueue))) + { + receiverPause.tv_sec = 0; + receiverPause.tv_nsec = OneMillisecond; + if (pthread_delay_np (&receiverPause)) + vpunt (NULL, "Unable to sleep in thread %lx", self); + } + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord) actualBytes; + memcpy (&netPacket->data[0], &netChannel->receiveBuffer[0], actualBytes); + EmbQueuePutWord (receiveQueue, netPacketPtr); + } + } + + pthread_cleanup_pop (TRUE); +} + + +/* Cleanup a single network channel */ + +static void TerminateNetChannel (EmbNetChannel* netChannel) +{ + void *exit_value; + + if (netChannel->receiverThreadSetup) + { + pthread_cancel (netChannel->receiverThread); + pthread_join (netChannel->receiverThread, &exit_value); + netChannel->receiverThreadSetup = FALSE; + } + + if (netChannel->fd != -1) + { + close (netChannel->fd); + netChannel->fd = -1; + } +} + + +/* Cleanup the network channels */ + +void TerminateNetworkChannels () +{ + EmbNetChannel* netChannel; + EmbPtr channel; + + for (channel = EmbCommAreaPtr->channel_table; channel != NullEmbPtr; + channel = netChannel->next) + { + netChannel = (EmbNetChannel*) HostPointer (channel); + if (EmbNetworkChannelType == netChannel->type) + TerminateNetChannel (netChannel); + } +} diff --git a/life-support/network-tap-linux.c b/life-support/network-tap-linux.c new file mode 100644 index 0000000..0b3631a --- /dev/null +++ b/life-support/network-tap-linux.c @@ -0,0 +1,1092 @@ +///* -*- Mode: C -*- */ + +/* VLM Network Life Support for Linux - /dev/tap */ + +#ifdef USE_TAP + +#include +#include + +#include +#include +#include +#include + +#include +#include "pfilt_wrapper.h" +#include + +#include +#include +#include + +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "FEPComm.h" +#include "chaos.h" + +#define ENV_VLM_TAP "VLM_TAP" +#define DEFAULT_INTERFACE "tap0" +#define FAKE_CHAOS_HOST_ADDRESS 255 +#define FAKE_INET_HOST_ADDRESS 1 +/* #define DEBUG_NETWORK 1 */ +/* #define DEBUG_CHAOS 0 */ +/* #define DEBUG_IP 0 */ +/* #define DEBUG_ICMP 0 */ +/* #define DEBUG_ARP 1 */ + +static EmbNetChannel* pInputChannel; +void NetworkChannelReceiver (pthread_addr_t argument); + +/* Create the network channels */ + +/* static void get_mac_for ( char *ifname, uint8_t *mac ) { */ +/* int sockfd ; */ +/* struct ifreq ifr ; */ + +/* if ((sockfd = socket (AF_INET,SOCK_DGRAM,0)) < 0) { */ +/* perror("sock for get_mac_for"); */ +/* exit(-1); */ +/* } */ + +/* memset ( &ifr, 0, sizeof(ifr)) ; */ +/* strcpy(ifr.ifr_name,ifname); */ +/* if (ioctl(sockfd,SIOCGIFHWADDR,&ifr) < 0) { */ +/* perror("SIOCGIFHWADDR for get_mac_for"); */ +/* exit (-1) ; */ +/* } ; */ + +/* memcpy(mac,ifr.ifr_hwaddr.sa_data,ETH_ALEN); */ + +/* close(sockfd); */ +/* } */ + +static void gen_random_mac ( uint8_t *mac ) { + static int initialized = 0 ; + int i ; + + if (! initialized) { + srandom(time(0)); + initialized = 1; + } + for ( i=0 ; i < ETH_ALEN ; i++) { + do + mac[i] = random() ; + while ((mac[i] == 0) || (mac[i] == 0xff)) ; + } + /* + * make it a locally administerd address + */ + mac[0] &= 0xFC ; + mac[0] |= 0x02 ; +} + +static char *makeAddressString ( VLMConfig *cfg ) { + int i, needcomma = 0 ; + NetworkInterface *nip ; + struct in_addr ina ; + static char result[_POSIX_ARG_MAX] ; + char interim[10], *p = result ; + + *p = 0 ; + for ( i = 0; i < 7; i++ ) { + nip = &(cfg->interfaces[i]) ; + while ( nip != NULL ) { + if ( nip->present ) { + if (needcomma) p = stpcpy( p, "," ) ; + if ( ! strcmp (nip->device,"")) + p = stpcpy ( p, DEFAULT_INTERFACE ) ; + else + p = stpcpy( p, nip->device ); + p = stpcpy( p , ":" ); + if (nip->haveMac) { + char macstring[18]; + + p = stpcpy(p, "MAC|"); + sprintf(macstring, "%02x:%02x:%02x:%02x:%02x:%02x", + nip->myMac.bytes[0], + nip->myMac.bytes[1], + nip->myMac.bytes[2], + nip->myMac.bytes[3], + nip->myMac.bytes[4], + nip->myMac.bytes[5]); + p = stpcpy(p,macstring); + p = stpcpy(p, ","); + if ( ! strcmp (nip->device,"")) + p = stpcpy ( p, DEFAULT_INTERFACE ) ; + else + p = stpcpy( p, nip->device ); + p = stpcpy( p , ":" ); + } + if (nip->myProtocol == ETH_P_IP) { + p = stpcpy( p, "INTERNET|" ); + ina.s_addr = ntohl(nip->myAddress.s_addr); + p = stpcpy( p, inet_ntoa(ina) ); + } else if (nip->myProtocol == ETHERTYPE_CHAOS) { + p = stpcpy( p, "CHAOS|"); + sprintf( interim,"%o", ntohl( nip->myAddress.s_addr )); + p = stpcpy( p, interim ); + } + if ( nip->myOptions ) { + if ( strcmp( nip->myOptions, "") ) { + p = stpcpy( p, ";" ); + p = stpcpy( p, nip->myOptions ); + } + } + needcomma = 1; + nip = nip->anotherAddress ; + } else nip = NULL ; + } + } + return result ; +} + +static void send_ip_arp_req ( int to_fd, + uint8_t *my_mac, + uint32_t my_ip, + uint32_t remote_ip) { + + struct arp_ip_packet ap; + uint32_t mip = ntohl(my_ip), rip = ntohl(remote_ip); + +#if 0 + char buf1[16],buf2[16]; + + vwarn("send ip arp","who has %s, tell %s", + inet_ntop(AF_INET, &rip, buf1, sizeof(buf1)), + inet_ntop(AF_INET, &mip, buf2, sizeof(buf2))); +#endif + + memset((void *)&ap,0,sizeof(ap)); + memset(ap.eth.eth_dst,0xff,ETH_ALEN); + memcpy(ap.eth.eth_src,my_mac,ETH_ALEN); + ap.eth.eth_prot = htons(ETH_P_ARP); + ap.arp.ar_hrd = htons(ARPHRD_ETHER); + ap.arp.ar_pro = htons(ETH_P_IP); + ap.arp.ar_hln = ETH_ALEN ; + ap.arp.ar_pln = 4 ; + ap.arp.ar_op = htons(ARPOP_REQUEST); + memcpy ( ap.src_mac, my_mac, ETH_ALEN ) ; + memset ( ap.dst_mac, 0, ETH_ALEN ); + ap.src_ip.s_addr = mip ; + ap.dst_ip.s_addr = rip ; + + if ( write(to_fd, + (char *)&ap, + sizeof(struct arp_ip_packet)) != + sizeof(struct arp_ip_packet) ) { + perror("sending ip arp request"); + exit ( -1 ); + } +} + +static void send_chaos_arp_req ( int to_fd, + uint8_t *my_mac, + uint16_t my_chaos, + uint16_t remote_chaos) { + + /* + * send gratuitous arp packet to check mac and chaos addresses + */ + struct arp_chaos_packet ap; + + memset((void *)&ap,0,sizeof(ap)); + memset(ap.eth.eth_dst,0xff,ETH_ALEN); + memcpy(ap.eth.eth_src,my_mac,ETH_ALEN); + ap.eth.eth_prot = htons(ETH_P_ARP); + ap.arp.ar_hrd = htons(ARPHRD_ETHER); + ap.arp.ar_pro = htons(ETH_P_CHAOS); + ap.arp.ar_hln = ETH_ALEN ; + ap.arp.ar_pln = 2 ; + ap.arp.ar_op = htons(ARPOP_REQUEST); + memcpy ( ap.src_mac, my_mac, ETH_ALEN ) ; + memset ( ap.dst_mac, 0xff, ETH_ALEN ); + ap.src_chaos = my_chaos ; + ap.dst_chaos = my_chaos ; + + if (write(to_fd, + (char *)&ap, + sizeof(struct arp_chaos_packet) ) != + sizeof(struct arp_chaos_packet)) { + perror("sending chaos arp request"); + exit ( -1 ); + } + memset((void *)&ap,0,sizeof(ap)); + memset(ap.eth.eth_dst,0xff,ETH_ALEN); + memcpy(ap.eth.eth_src,my_mac,ETH_ALEN); + ap.eth.eth_prot = htons(ETH_P_ARP); + ap.arp.ar_hrd = htons(ARPHRD_ETHER); + ap.arp.ar_pro = htons(ETH_P_CHAOS); + ap.arp.ar_hln = ETH_ALEN ; + ap.arp.ar_pln = 2 ; + ap.arp.ar_op = htons(ARPOP_REPLY); + memcpy ( ap.src_mac, my_mac, ETH_ALEN ) ; + memset ( ap.dst_mac, 0xff, ETH_ALEN ); + ap.src_chaos = my_chaos ; + ap.dst_chaos = my_chaos ; + if (write(to_fd, + (char *)&ap, + sizeof(struct arp_chaos_packet) ) != + sizeof(struct arp_chaos_packet)) { + perror("sending chaos arp reply"); + exit ( -1 ); + } + +} + +void InitializeNetworkChannels ( VLMConfig* config ) { + EmbPtr cp ; + register EmbNetChannel* p ; + int chan_no ; + uint32_t iaddr ; + EmbPtr addressString = MakeEmbString ( makeAddressString ( config )) ; + struct ifreq ifr; + uint8_t real_mac[ETH_ALEN] ; + char ifn[8][16] ; + char xhost_cmd[7+INET_ADDRSTRLEN] ; + char buf[INET_ADDRSTRLEN] ; + + // dump_vlm_config ( config ); + // + // construct list of EmbNetChannels first + // + for (chan_no = 0; chan_no < 8; chan_no++ ) { + struct NetworkInterface *cip = &config->interfaces[chan_no]; + + if ( !cip->present ) break ; + // allocate an embNetChannel + cp = EmbCommAreaAlloc ( sizeof(EmbNetChannel) ); + p = (EmbNetChannel *) HostPointer(cp); + p->type = EmbNetworkChannelType; + p->unit = chan_no ; + p->fd = -1 ; + p->receiverThreadSetup = 0; + p->next = EmbCommAreaPtr->channel_table ; + EmbCommAreaPtr->channel_table = cp ; + p->hostPrimaryProtocol = cip->myProtocol ; + p->guestPrimaryProtocol = cip->myProtocol ; + switch (p->hostPrimaryProtocol) { + + case ETH_P_CHAOS: + p->guestPrimaryAddress = cip->myAddress.s_addr >> 16; + if (cip->myHostAddress.s_addr) + p->hostPrimaryAddress = + cip->myHostAddress.s_addr; + else + p->hostPrimaryAddress = + ((p->guestPrimaryAddress << 8 & 0xFF00) | + FAKE_CHAOS_HOST_ADDRESS ) &0xFFFF ; + break ; + + case ETH_P_IP: + p->guestPrimaryAddress = cip->myAddress.s_addr ; + if (cip->myHostAddress.s_addr) + p->hostPrimaryAddress = + cip->myHostAddress.s_addr; + else + p->hostPrimaryAddress = + (cip->myAddress.s_addr & + 0xffffff00) | + FAKE_INET_HOST_ADDRESS ; + break ; + } + } + // + // now fill channels in list order, so VLM uses the same channel numbering + // + cp = EmbCommAreaPtr->channel_table ; + p = (EmbNetChannel *) HostPointer(cp); +#if DEBUG_NETWORK + fprintf(stderr,"net config address string = %s\n", makeAddressString(config)); +#endif + + for (chan_no = 0; + p->type == EmbNetworkChannelType; + chan_no++) { + struct NetworkInterface *cip = &config->interfaces[chan_no]; + + if ( !cip->present ) break ; + strncpy(ifn[p->unit], + cip->device, + sizeof(ifn[p->unit])); + if (!strcmp(ifn[p->unit],"")) { + vwarn ("network", + "You did not specify a tun/tap interface for network channel %d:", + p->unit); + vwarn ("network", + "You should either give a network spec on the command line, like" ); + vwarn ("network", + "\tgenera ... -network \"tap3:INTERNET|a.b.c.d;gateway=e.f.g.h\"" ); + vwarn ("network", + "\tor else you could set VLM_TAP=\"tap6\" in the environment." ); + if (getenv(ENV_VLM_TAP)) { + vwarn ("network", "\tUsing the value of VLM_TAP=\"%s\" for channel %d.", + getenv(ENV_VLM_TAP), p->unit ); + strncpy(ifn[p->unit], + getenv(ENV_VLM_TAP), + sizeof(ifn[p->unit])); + } + else { + vwarn ("network", + "\tUsing built-in default \"%s\" for channel %d.", + DEFAULT_INTERFACE, + p->unit ); + strncpy(ifn[p->unit], + DEFAULT_INTERFACE, + sizeof(ifn[p->unit])); + } + } + strncpy((char *)&(p->name0),ifn[p->unit], + MIN(sizeof(ifn[p->unit]), sizeof(p->name0))); + if (cip->haveMac) { + int i; + + for(i=0; imyMac.bytes[i] ; + if ((real_mac[0] & 0x02) == 0) { + real_mac[0] |= 0x02; /* make it a LAA mac */ + vwarn("net_init", + "setting LAA bit in mac address for %s results\ + in %02x:%02x:%02x:%02x:%02x:%02x", + ifn[p->unit], + real_mac[0], + real_mac[1], + real_mac[2], + real_mac[3], + real_mac[4], + real_mac[5]); + } + } else + gen_random_mac ( real_mac ); + p->hardwareAddressLow = p->hardwareAddressHigh = 0 ; + memcpy(&(p->hardwareAddressHigh),real_mac,ETH_ALEN); + + // open tapx: device + if ((p->fd = open("/dev/net/tun", O_RDWR )) < 0) { + perror("open /dev/net/tun"); + exit ( -1 ) ; + } + + memset ( &ifr, 0, sizeof(ifr) ); + ifr.ifr_flags = IFF_TAP | IFF_NO_PI ; + strcpy(ifr.ifr_name, (char *)(&(p->name0))) ; + if ( ioctl ( p->fd, TUNSETIFF, &ifr ) < 0 ) { + perror("TUNSETIFF"); + exit(-1); + } + + p->arpReq = NULL ; + p->status = 0; + + switch (p->hostPrimaryProtocol) { + + case ETH_P_IP: { + Display *dpy; + + iaddr = htonl(config->interfaces[p->unit].myAddress.s_addr); + sprintf(xhost_cmd, + "xhost +%s", + inet_ntop(AF_INET, + &iaddr, + buf, + sizeof(buf))); + if (((dpy=XOpenDisplay(NULL)) == NULL) && + (errno == EAGAIN)) { + vwarn("net init", + "if you don't get a display or you're getting the ominous"); + vwarn("net init", + "'No protocol specified' error" + ", you may want to execute"); + vwarn("net init","%s",xhost_cmd); + vwarn("net init", + "on your X server to allow X11 access for genera"); + } + if (dpy) XCloseDisplay(dpy); +#if DEBUG_NETWORK + iaddr = ntohl(p->hostPrimaryAddress); + fprintf(stderr,"ch%d %s: hostPrimaryAddress = IP %s", + chan_no, + ifn[p->unit], + inet_ntop(AF_INET, &iaddr, buf, sizeof(buf))); + if (!config->interfaces[p->unit].myHostAddress.s_addr) + fprintf(stderr,", (host 1 on guest subnet)\n"); + else + fprintf(stderr, " (given)\n"); + iaddr = ntohl(config->interfaces[p->unit].myAddress.s_addr); + fprintf(stderr,"ch%d %s: guestPrimaryAddress = IP %s\n", + chan_no, + ifn[p->unit], + inet_ntop(AF_INET, &iaddr, buf, sizeof(buf))); +#endif // DEBUG_NETWORK + + break ; + } + + case ETH_P_CHAOS: +#if DEBUG_NETWORK + fprintf(stderr,"ch%d %s: hostPrimaryAddress = CHAOS #o%o", + chan_no, + ifn[p->unit], + p->hostPrimaryAddress); + if (!config->interfaces[p->unit].myHostAddress.s_addr) + fprintf(stderr,", (#o377 on guest subnet)\n"); + else + fprintf(stderr, " (given)\n"); + fprintf(stderr,"ch%d %s: guestPrimaryAddress = CHAOS #o%o\n", + chan_no, + ifn[p->unit], + htons(p->guestPrimaryAddress)); +#endif // DEBUG_NETWORK + break; + + } +#if DEBUG_NETWORK + fprintf(stderr,"ch%d %s: guestMac = %02x:%02x:%02x:%02x:%02x:%02x\n", + chan_no, + ifn[p->unit], + real_mac[0], real_mac[1], real_mac[2], + real_mac[3], real_mac[4], real_mac[5] ); +#endif // DEBUG_NETWORK + + p->unit = chan_no ; + p->nReceiveFailures = 0 ; + p->nTransmitFailures = 0 ; + p->addressString = addressString ; + p->net_broken = 0 ; + // Queues + p->guestToHostQueue = + CreateQueue(NetworkTransmitterQueueSize, sizeof(EmbPtr)); + p->guestToHostQ = (EmbQueue*) HostPointer (p->guestToHostQueue); + p->guestToHostQ->signal = + InstallSignalHandler((ProcPtrV)&NetworkChannelTransmitter, + (PtrV) p, FALSE); + + p->guestToHostReturnQueue = + CreateQueue(NetworkTransmitterQueueSize, sizeof(EmbPtr)); + p->guestToHostReturnQ = + (EmbQueue*) HostPointer(p->guestToHostReturnQueue); + + p->hostToGuestSupplyQueue = + CreateQueue(NetworkReceiverQueueSize, sizeof(EmbPtr)); + p->hostToGuestSupplyQ = + (EmbQueue*) HostPointer(p->hostToGuestSupplyQueue); + + p->hostToGuestQueue = + CreateQueue(NetworkReceiverQueueSize, sizeof(EmbPtr)); + p->hostToGuestQ = + (EmbQueue*) HostPointer(p->hostToGuestQueue); + // receiver Thread + if (pthread_create (&p->receiverThread, + &EmbCommAreaPtr->inputThreadAttrs, + (pthread_startroutine_t) &NetworkChannelReceiver, + (pthread_addr_t) p)) { + perror ( "create receiver thread" ); + exit (-1); + } + p->receiverThreadSetup = TRUE; + p->status |= EmbNetStatusHostReady; + + switch (p->hostPrimaryProtocol) { + + case ETH_P_IP: + send_ip_arp_req ( p->fd, + (uint8_t *)&p->hardwareAddressHigh, + p->guestPrimaryAddress, + p->hostPrimaryAddress); + break ; + + case ETH_P_CHAOS: + send_chaos_arp_req ( p->fd, + (uint8_t *)&p->hardwareAddressHigh, + htons(p->guestPrimaryAddress), + htons(p->hostPrimaryAddress)); + break ; + } + + if ((cp = p->next) == -1) break ; + p = (EmbNetChannel *) HostPointer(cp); + } +} + +/* Reset a network channel */ + +void ResetNetworkChannel (EmbChannel* channel) +{ + register EmbNetChannel* netChannel = (EmbNetChannel*) channel; + + ResetIncomingQueue (netChannel->guestToHostQ); + ResetOutgoingQueue (netChannel->guestToHostReturnQ); + + ResetIncomingQueue (netChannel->hostToGuestSupplyQ); + ResetOutgoingQueue (netChannel->hostToGuestQ); + + switch (netChannel->hostPrimaryProtocol) { + + case ETH_P_IP: + send_ip_arp_req ( netChannel->fd, + (uint8_t *)&netChannel->hardwareAddressHigh, + netChannel->guestPrimaryAddress, + netChannel->hostPrimaryAddress); + break ; + + case ETH_P_CHAOS: + send_chaos_arp_req ( netChannel->fd, + (uint8_t *)&netChannel->hardwareAddressHigh, + htons(netChannel->guestPrimaryAddress), + htons(netChannel->hostPrimaryAddress)); + break ; + } + netChannel->net_broken = 0 ; +} + + +static void +recv_packet(char *packet, int size) +{ + register EmbNetChannel* netChannel = pInputChannel; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + + netPacketPtr = EmbQueueTakeWord (supplyQueue); + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord)size; + memcpy (&netPacket->data[0], packet, size); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, size); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); +} + +void +answer_arp(char *pkt, int size) +{ + char tmp[10]; + int i; + + pkt[21] = 2; + memcpy(tmp, &pkt[22], 10); + memcpy(&pkt[22], &pkt[32], 10); + + for (i = 0; i < ETH_ALEN; i++) + tmp[i] = i; + + memcpy(&pkt[32], tmp, 10); + + printf("answering arp\n"); + + recv_packet(pkt, size); +} + +#if DEBUG_NETWORK +#if DEBUG_CHAOS +static char *chaos_opcode ( uint16_t opc ) { + static char other[20] ; + switch(opc) { + case CHAOS_OP_RFC: return "RFC"; + case CHAOS_OP_OPN: return "OPN"; + case CHAOS_OP_CLS: return "CLS"; + case CHAOS_OP_FWD: return "FWD"; + case CHAOS_OP_ANS: return "ANS"; + case CHAOS_OP_SNS: return "SNS"; + case CHAOS_OP_STS: return "STS"; + case CHAOS_OP_RUT: return "RUT"; + case CHAOS_OP_LOS: return "LOS"; + case CHAOS_OP_LSN: return "LSN"; + case CHAOS_OP_MNT: return "MNT"; + case CHAOS_OP_EOF: return "EOF"; + case CHAOS_OP_UNC: return "UNC"; + case CHAOS_OP_BRD: return "BRD"; + case CHAOS_OP_DAT: return "DAT"; + default: + sprintf( other, "OP 0x%02x ?", opc ); + return other ; + } + return "???"; +} +#endif // DEBUG_CHAOS +#endif // DEBUG_NETWORK + +#if DEBUG_NETWORK +static void dump_packet (char *who, unsigned char *pkt, int size) { + struct eth_header *peth = (struct eth_header *)pkt ; +#if DEBUG_CHAOS + struct eth_chaos_packet *pchaos = (struct eth_chaos_packet *)pkt ; +#endif +#if DEBUG_ARP + struct arp_chaos_packet *parp =(struct arp_chaos_packet *)pkt ; + struct arp_ip_packet *parpi = (struct arp_ip_packet *)pkt ; +#endif +#if DEBUG_IP + struct eth_ip_packet *pip = (struct eth_ip_packet *)pkt ; +#endif + char proto[20], subproto[20], src[20], dst[20] ; + + sprintf(proto,"0x%04x",ntohs(peth->eth_prot)); + strcpy(subproto,""); + strcpy(src,""); + strcpy(dst,""); + + switch (ntohs(peth->eth_prot)) { + + case ETH_P_ARP: +#if DEBUG_ARP + switch (ntohs(parp->arp.ar_op)) { + case ARPOP_REQUEST: strcpy(proto,"arp req"); break; + case ARPOP_REPLY: strcpy(proto,"arp rpl"); break; + default: sprintf(proto,"arp %d",ntohs(parp->arp.ar_op)); + } + switch (ntohs(parp->arp.ar_pro)) { + case ETH_P_IP: + strcpy(subproto,"ip"); + strcpy(src,inet_ntoa(parpi->src_ip)); + strcpy(dst,inet_ntoa(parpi->dst_ip)); + break ; + case ETH_P_CHAOS: + strcpy(subproto,"chaos"); + sprintf(src,"#o%o", parp->src_chaos); + sprintf(dst,"#o%o", parp->dst_chaos); + break ; + } +#else + return ; +#endif // DEBUG_ARP + break; + + case ETH_P_IP: +#if DEBUG_IP + sprintf(proto,"ip"); + switch (pip->ip.ip_p) { + + case IPPROTO_ICMP: +#if DEBUG_ICMP + strcpy(subproto,"icmp"); break ; +#else + return ; +#endif // DEBUG_ICMP + case IPPROTO_IGMP: strcpy(subproto,"igmp"); break; + case IPPROTO_UDP: strcpy(subproto,"udp"); break; + case IPPROTO_TCP: strcpy(subproto,"tcp"); break; + default: sprintf(subproto,"0x%04x",pip->ip.ip_p); break; + } + strcpy(src, inet_ntoa(pip->ip.ip_src)); + strcpy(dst, inet_ntoa(pip->ip.ip_dst)); +#else // no DEBUG_IP + return ; +#endif // DEBUG IP + break; + + case ETH_P_CHAOS: +#if DEBUG_CHAOS + sprintf(proto,"chaos"); + strcpy(subproto,chaos_opcode(pchaos->chaos.hd.opcode )); + sprintf(src,"#o%o", + (pchaos->chaos.hd.source_subnet << 8) | + pchaos->chaos.hd.source_host ); + sprintf(dst,"#o%o", + (pchaos->chaos.hd.dest_subnet << 8) | + pchaos->chaos.hd.dest_host ); +#else + return; +#endif // DEBUG_CHAOS + break; + + case ETH_P_IPV6: + strcpy(proto,"IPV6:VLM does"); + strcpy(subproto,"not"); + strcpy(src,"speak"); + strcpy(dst,"IPV6 (yet)"); + break ; + + default: + sprintf(proto,"0x%04x",ntohs(peth->eth_prot)); + strcpy(subproto,""); + strcpy(src,""); + strcpy(dst,""); + + } + printf("%s %d %s (%s) %s -> %s\n", who, size, proto, subproto, src, dst); +} +#endif // DEBUG_NETWORK + +/* Network Channel transmitter */ + +void NetworkChannelTransmitter (EmbNetChannel* pNetChannel) +{ + register EmbNetChannel* netChannel = pNetChannel; + register EmbQueue* transmitQueue = netChannel->guestToHostQ; + register EmbQueue* returnQueue = netChannel->guestToHostReturnQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t nBytes, actualBytes; + unsigned char altbuf[ETH_ZLEN]; + +#if DEBUG_NETWORK + char tx[22] ; + + + sprintf(tx,"tx%d:%s",pNetChannel->unit,(char *)&(pNetChannel->name0)); +#endif // DEBUG_NETWORK + + while (EmbQueueFilled (transmitQueue)) + { + if (0 == EmbQueueSpace (returnQueue)) + { + /* + * Can't do I/O now because we can't return the buffer -- + * Try again later + */ + SignalLater (transmitQueue->signal); + return; + } + netPacketPtr = EmbQueueTakeWord (transmitQueue); + if (NULL == (void*)(uint64_t)netPacketPtr) netPacketPtr = NullEmbPtr; + + if (netPacketPtr != NullEmbPtr) + { + if (/*netChannel->status & EmbNetStatusHostReady*/1) + { + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + nBytes = (ssize_t) netPacket->nBytes; +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block(&netPacket->data, nBytes); +#endif + // + // JJ : force eth src to be our address + // + if (memcmp((char *)netPacket->data + ETH_ALEN, + (char *)&pNetChannel->hardwareAddressHigh, + ETH_ALEN)) { + if (! pNetChannel->net_broken) { + vwarn("net tx", + "ch%d: trying to send from wrong mac address. fixing it for now." + ,pNetChannel->unit); + vwarn("net tx", + "for a longer term solution, you should patch your Genera system."); + pNetChannel->net_broken = 1 ; + } + memcpy((char *)netPacket->data + ETH_ALEN, + (char *)&pNetChannel->hardwareAddressHigh + ,ETH_ALEN); + } + /* + * if this is an arp request, swap bytes in src chaos addr + */ + /* struct arp_chaos_packet *arpp = (struct arp_chaos_packet *)netPacket->data ; */ + /* if (ntohs(arpp->eth.eth_prot) == ETH_P_ARP) { */ + /* if (ntohs(arpp->arp.ar_op) == ARPOP_REQUEST) */ + /* arpp->src_chaos = (arpp->src_chaos >> 8) | */ + /* (arpp->src_chaos << 8); */ + /* if (ntohs(arpp->arp.ar_op) == ARPOP_REPLY) */ + /* arpp->src_chaos = (arpp->src_chaos >> 8) | */ + /* (arpp->src_chaos << 8); */ + /* } */ + if (pNetChannel->net_broken) { + // + // if this is an arp reply, put our address there too + // + struct arp_chaos_packet *arpp = (struct arp_chaos_packet *)netPacket->data ; + if (ntohs(arpp->eth.eth_prot) == ETH_P_ARP) { + vwarn("net tx", + "ch%d : fixing arp.", + pNetChannel->unit); + memcpy(arpp->src_mac, + (char *)&(pNetChannel->hardwareAddressHigh), + ETH_ALEN); + } + + } + // + // if dst == src, set dst to host hw + // + if (!memcmp((char *)netPacket->data, + (char *)netPacket->data + ETH_ALEN, + ETH_ALEN)) { + vwarn("net tx", + "ch%d: send to my own mac - making it a broadcast", + pNetChannel->unit); + memset((char *)netPacket->data,0xff,ETH_ALEN); + pNetChannel->net_broken = 1 ; + } + // + // JJ + // + // if packet size < ETH_ZLEN bytes, pad it + // + if(nBytes < ETH_ZLEN) { + memset((void *)&altbuf,0,sizeof(altbuf)); + memcpy((void *)&altbuf,(void *)netPacket->data,nBytes); + nBytes = ETH_ZLEN ; + actualBytes = write(netChannel->fd, altbuf, nBytes); + } else + actualBytes = write(netChannel->fd, (char *)netPacket->data, + nBytes); + if (actualBytes != nBytes) + { + printf("tx error\n"); + netChannel->nTransmitFailures++; + } +#if DEBUG_NETWORK + dump_packet(tx, (unsigned char *)&netPacket->data[0], nBytes); +#endif // DEBUG_NETWORK + } + + EmbQueuePutWord (returnQueue, netPacketPtr); + } + } +} + +/* static void NetworkChannelTransmitter (EmbNetChannel* pNetChannel) */ +/* { */ +/* register EmbNetChannel* netChannel = pNetChannel; */ +/* register EmbQueue* transmitQueue = netChannel->guestToHostQ; */ +/* register EmbQueue* returnQueue = netChannel->guestToHostReturnQ; */ +/* EmbPtr netPacketPtr; */ +/* EmbNetPacket* netPacket; */ +/* ssize_t nBytes, actualBytes; */ + + +/* while (EmbQueueFilled (transmitQueue)) */ +/* { */ +/* if (0 == EmbQueueSpace (returnQueue)) */ +/* { */ +/* /\* */ +/* * Can't do I/O now because we can't return the buffer -- */ +/* * Try again later */ +/* *\/ */ +/* SignalLater (transmitQueue->signal); */ +/* return; */ +/* } */ + +/* netPacketPtr = EmbQueueTakeWord (transmitQueue); */ +/* if (NULL == (void*)(uint64_t)netPacketPtr) netPacketPtr = NullEmbPtr; */ + +/* if (netPacketPtr != NullEmbPtr) */ +/* { */ +/* if (/\*netChannel->status & EmbNetStatusHostReady*\/1) */ +/* { */ +/* u_char *pptr; */ +/* u_short proto; */ +/* netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); */ +/* nBytes = (ssize_t) netPacket->nBytes; */ +/* #if BYTE_ORDER == BIG_ENDIAN */ +/* bswap32_block(&netPacket->data, nBytes); */ +/* #endif */ + +/* memcpy(netChannel->sll.sll_addr, */ +/* ((struct ethhdr*)netPacket->data)->h_dest, */ +/* ETH_ALEN); */ + +/* #if 0 */ +/* /\* *\/ */ +/* pptr = (char *)netPacket->data; */ +/* proto = (pptr[12] << 8) | pptr[13]; */ + +/* nBytes -= 14; */ + +/* if (proto == 0x800) */ +/* actualBytes = write(netChannel->fd, pptr + 14, nBytes); */ +/* else */ +/* actualBytes = nBytes; */ +/* #else */ +/* actualBytes = write(netChannel->fd, (char *)netPacket->data, */ +/* nBytes); */ +/* #endif */ + +/* if (actualBytes != nBytes) */ +/* { */ +/* printf("tx error\n"); */ +/* netChannel->nTransmitFailures++; */ +/* } */ +/* #if 1 */ +/* if (new_packet((char *)new_packet, nBytes) || 1) { */ +/* dump_packet("tx", (unsigned char *)&netPacket->data[0], nBytes); */ +/* } */ +/* #endif */ +/* } */ + +/* EmbQueuePutWord (returnQueue, netPacketPtr); */ +/* } */ +/* } */ +/* } */ + + +/* Network Channel receiver thread -- Can it be written to not copy??? */ + +// orig 1000000 = 1ms, now 100000 = 100 us +#define OneMillisecond 100000L +#define PollTimeoutInMillis 500 + +void NetworkChannelReceiver (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + register EmbNetChannel* netChannel = (EmbNetChannel*) argument; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + struct pollfd pollReceiver; + struct timespec receiverPause; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t actualBytes; + uint8_t broadcast[ETH_ALEN] ; + + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + memset(broadcast,0xff,ETH_ALEN); + + WaitUntilInitializationComplete (); + + pollReceiver.fd = netChannel->fd; + pollReceiver.events = POLLIN; + + while (TRUE) + { + pthread_testcancel (); + + pollReceiver.revents = 0; + poll (&pollReceiver, 1, PollTimeoutInMillis ); + + if (0 == (pollReceiver.revents & POLLIN)) + continue; + +#if 0 + actualBytes = read(netChannel->fd, + ((char *)netChannel->receiveBuffer) + 14, + MaxEmbNetPacketSize); + + dump_packet("rx", (u_char *)&netChannel->receiveBuffer, actualBytes+14); +#else + actualBytes = read(netChannel->fd, netChannel->receiveBuffer, + MaxEmbNetPacketSize); + + { + u_char *pptr = (u_char *)netChannel->receiveBuffer; + u_short proto = (pptr[12] << 8) | pptr[13]; + + // + // if network is broken, don't do any checks + // + if (! netChannel->net_broken ) + // + // check if eth packet is either for us or a broadcast + // + if (memcmp(pptr, + (char *)&netChannel->hardwareAddressHigh, + ETH_ALEN) && + memcmp(pptr, broadcast, ETH_ALEN)) + continue ; + + // + // only accept IP, ARP, and CHAOS packets + // + switch (proto) { + case ETHERTYPE_IP: + case ETHERTYPE_CHAOS: + case ETHERTYPE_ARP: + break; + default: + continue; + } + } + +#if DEBUG_NETWORK + dump_packet("rx", (u_char *)&netChannel->receiveBuffer, actualBytes); +#endif // DEBUG_NETWORK +#endif + + if (actualBytes < 0) + netChannel->nReceiveFailures++; + + else if (0 == actualBytes) + netChannel->nFalseReceiverWakeups++; + +#if 0 + else if (!(netChannel->status & EmbNetStatusGuestReady)) + ; +#endif + + else if ((0 == EmbQueueSpace (supplyQueue)) || (0 == EmbQueueSpace (receiveQueue))) + netChannel->nReceivedPacketsLost++; + + else + { +#if 0 + actualBytes += 14; +#endif + while (0 == (netPacketPtr = EmbQueueTakeWord (supplyQueue))) + { + receiverPause.tv_sec = 0; + receiverPause.tv_nsec = OneMillisecond; + if (pthread_delay_np (&receiverPause)) + vpunt (NULL, "Unable to sleep in thread %lx", self); + } + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord) actualBytes; + memcpy (&netPacket->data[0], &netChannel->receiveBuffer[0], actualBytes); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, actualBytes); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); + } + } + + pthread_cleanup_pop (TRUE); +} + + +/* Cleanup a single network channel */ + +void TerminateNetChannel (EmbNetChannel* netChannel, int ipSocket) +{ + void *exit_value; + + if (netChannel->receiverThreadSetup) + { + pthread_cancel (netChannel->receiverThread); + pthread_join (netChannel->receiverThread, &exit_value); + netChannel->receiverThreadSetup = FALSE; + } + +#ifndef NOROOT + /* for (embARPReq = netChannel->arpReq; embARPReq != NULL; embARPReq->next) */ + /* ioctl (ipSocket, SIOCDARP, &embARPReq->arp); */ +#endif + + if (netChannel->fd != -1) + { + close (netChannel->fd); + netChannel->fd = -1; + } +} + + +/* Cleanup the network channels */ + +void TerminateNetworkChannels () +{ + EmbNetChannel* netChannel; + EmbPtr channel; + int ipSocket; + + ipSocket = socket (PF_INET, SOCK_STREAM, 0); + + for (channel = EmbCommAreaPtr->channel_table; channel != NullEmbPtr; + channel = netChannel->next) + { + netChannel = (EmbNetChannel*) HostPointer (channel); + if (EmbNetworkChannelType == netChannel->type) + TerminateNetChannel (netChannel, ipSocket); + } + + if (ipSocket > -1) + close (ipSocket); +} + +#endif /* USE_TAP */ diff --git a/life-support/network-tun-linux.c b/life-support/network-tun-linux.c new file mode 100644 index 0000000..d031729 --- /dev/null +++ b/life-support/network-tun-linux.c @@ -0,0 +1,720 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Network Life Support for Linux - /dev/tun */ + +#ifdef USE_TUN + +#include +#include + +#include +#include +#include + +#include +#include "pfilt_wrapper.h" +//#include +#include + +#include +#include +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "FEPComm.h" + +static EmbNetChannel* pInputChannel; +void InitializeNetChannel (NetworkInterface* interface, int unitNumber, + int ipSocket, struct ifconf* ifc); + +/* Create the network channels */ + +void InitializeNetworkChannels (VLMConfig* config) +{ + struct ifconf ifc; + int ipSocket, savedLen, i; + bool tryAgain; + + printf("InitializeNetworkChannels()\n"); + + ipSocket = socket (PF_INET, SOCK_STREAM, 0); + if (ipSocket == -1) + vpunt (NULL, "Unable to open IP socket to gather network interface information"); + + ifc.ifc_len = 32 * sizeof (struct ifreq); + ifc.ifc_buf = NULL; + tryAgain = TRUE; + + while (tryAgain) + { + ifc.ifc_buf = realloc (ifc.ifc_buf, ifc.ifc_len); + if (ifc.ifc_buf == NULL) + vpunt (NULL, "Unable to obtain space to read IP addresses of network interfaces"); + savedLen = ifc.ifc_len; + if (ioctl (ipSocket, SIOCGIFCONF, &ifc) < 0) + vpunt (NULL, "Unable to obtain IP addresses assigned to network interfaces"); + if (ifc.ifc_len == savedLen) + ifc.ifc_len = 2 * ifc.ifc_len; + else + tryAgain = FALSE; + } + + ifc.ifc_len = ifc.ifc_len / sizeof (struct ifreq); + + printf("MaxNetworkInterfaces %d\n", MaxNetworkInterfaces); + + printf("0 myAddress %08x\n", config->interfaces[0].myAddress.s_addr); + + for (i = 0; i < MaxNetworkInterfaces; i++) { + if (config->interfaces[i].present) { + printf("init %d\n", i); + printf("config %p\n", config); + printf("interface %p\n", &config->interfaces[i]); + InitializeNetChannel(&config->interfaces[i], i, ipSocket, &ifc); + } + } + + close (ipSocket); + +#ifdef MINIMA + WriteFEPCommSlot (localIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (diagnosticIPAddress, htonl (config->diagnosticIPAddress.s_addr), Type_Fixnum); + WriteFEPCommSlot (localIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask0, 0, Type_Fixnum); + WriteFEPCommSlot (localIPSubnetMask1, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress0, 0, Type_Fixnum); + WriteFEPCommSlot (gatewayIPAddress1, 0, Type_Fixnum); + WriteFEPCommSlot (loadServerIPAddress, 0, Type_Fixnum); +#endif +} +void NetworkChannelReceiver (pthread_addr_t argument); + +/* Create a single network channel */ + +void InitializeNetChannel (NetworkInterface* interface, int unitNumber, + int ipSocket, struct ifconf* ifc) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbNetChannel)); + register EmbNetChannel* p = (EmbNetChannel*) HostPointer (cp); + struct ifreq ifr; + struct if_nameindex *saved_ifs, *ifs; + int interfaceIndex, i, err; + NetworkInterface* pInterface; +#ifdef GENERA + struct in_addr guestAddress; + char addressAsString[_POSIX_ARG_MAX]; + boolean firstInterface; +#endif + + pInputChannel = p; + + p->type = EmbNetworkChannelType; + p->unit = unitNumber; + p->fd = -1; /* Needed before linking into channel list */ + p->receiverThreadSetup = FALSE; /* .. */ + p->next = EmbCommAreaPtr->channel_table; /* Link into the channel list */ + EmbCommAreaPtr->channel_table = cp; + + if (interface->device[0]) + { + /* + * Verify that the requested device is running and + * is an Ethernet interface + */ + p->name0 = p->name1 = 0; + memcpy ((char*)&p->name0, interface->device, 2 * sizeof (EmbWord)); + + printf("device %s\n", interface->device); + + strncpy (ifr.ifr_name, interface->device, IFNAMSIZ); + + p->hardwareAddressHigh = p->hardwareAddressLow = 0; + memcpy ((char*)&p->hardwareAddressHigh, ifr.ifr_hwaddr.sa_data, + 2 * sizeof (EmbWord)); + + printf("hw address %#x %#x\n", + p->hardwareAddressHigh, + p->hardwareAddressLow); + } + else + { + /* No interface specified: Use the first available Ethernet interface */ + interfaceIndex = -1; + ifs = saved_ifs = if_nameindex(); + + while (ifs->if_index != 0 && ifs->if_name != NULL) + { + strncpy(ifr.ifr_name, ifs->if_name, IFNAMSIZ); + if (ioctl (ipSocket, SIOCGIFFLAGS, &ifr) < 0) + vpunt (NULL, "Unable to determine attributes of network device %s", + ifr.ifr_name); + if ((ifr.ifr_flags & (IFF_UP | IFF_RUNNING | IFF_LOOPBACK)) + == (IFF_UP | IFF_RUNNING)) + { + if (ioctl (ipSocket, SIOCGIFHWADDR, &ifr) < 0) + vpunt (NULL, "Unable to determine hardware address for network device %s", + ifr.ifr_name); + if (ifr.ifr_hwaddr.sa_family == ARPHRD_ETHER) + { + interfaceIndex = ifs->if_index; + strncpy (interface->device, ifs->if_name, IFNAMSIZ); + p->name0 = p->name1 = 0; + memcpy ((char*)&p->name0, ifs->if_name, 2 * sizeof (EmbWord)); + p->hardwareAddressHigh = p->hardwareAddressLow = 0; + memcpy ((char*)&p->hardwareAddressHigh, ifr.ifr_hwaddr.sa_data, + 2 * sizeof (EmbWord)); + break; + + } + } + ifs++; + } + + if_freenameindex (saved_ifs); + + if (interfaceIndex < 0) + vpunt (NULL, "Unable to find an Ethernet interface to attach" + " to VLM network interface #%d", + unitNumber); + } + + + /* Get IP address of interface */ + + p->hostPrimaryProtocol = -1; + + for (i = 0; i < ifc->ifc_len; i++) + { + if (strncmp (interface->device, ifc->ifc_req[i].ifr_name, IFNAMSIZ) == 0) + { + p->hostPrimaryProtocol = ETHERTYPE_IP; +#ifdef ARCH_X86_64 + p->hostPrimaryAddress + = ntohl(((struct sockaddr_in *)&ifc->ifc_req[i].ifr_addr)->sin_addr.s_addr); +#else + p->hostPrimaryAddress + = ((struct sockaddr_in *)&ifc->ifc_req[i].ifr_addr)->sin_addr.s_addr; +#endif + break; + } + } + + if (p->hostPrimaryProtocol == -1) + vpunt (NULL, "Unable to determine IP address assigned to network device %s", + interface->device); + + + /* Open tunnel interface*/ + + printf("hostPrimaryAddress %#x\n", p->hostPrimaryAddress); + printf("guestPrimaryAddress %#x\n", p->guestPrimaryAddress); + + p->fd = open("/dev/net/tun", O_RDWR); + if (p->fd < 0) + vpunt (NULL, "Unable to /dev/net/tun for VLM network interface #%d", + unitNumber); + + //----- + memset(&ifr, 0, sizeof(ifr)); + + /* Flags: IFF_TUN - TUN device (no Ethernet headers) + * IFF_TAP - TAP device + * + * IFF_NO_PI - Do not provide packet information + */ + // ifr.ifr_flags = IFF_TUN | IFF_NO_PI; + ifr.ifr_flags = IFF_TAP | IFF_NO_PI; + + strcpy(ifr.ifr_name, "tun0"); + + err = ioctl(p->fd, TUNSETIFF, (void *) &ifr); + if (err < 0) { + vpunt (NULL, "Can't TUNSETIFF for VLM network interface #%d", + unitNumber); + } + + // strcpy(tun_name, ifr.ifr_name); + if (system("/sbin/ifconfig tun0 10.0.0.1 dstaddr 10.0.0.2 netmask 255.255.255.0") < 0) + vpunt(NULL,"Can't ifconfig tun0"); + + /* + * Create entries in the host's ARP table for each IP address assigned + * to this channel + */ + + p->arpReq = NULL; + +#ifdef GENERA + for (pInterface = interface; + pInterface != NULL; + pInterface = pInterface->anotherAddress) +#else + pInterface = interface; +#endif + { + if (pInterface->myProtocol == ETHERTYPE_IP) + { + EmbPtr arpReqPtr = EmbCommAreaAlloc (sizeof (EmbNetARPReq)); + register EmbNetARPReq* pARP = (EmbNetARPReq*) HostPointer (arpReqPtr); + pARP->next = p->arpReq; + p->arpReq = pARP; + + pARP->arp.arp_pa.sa_family = AF_INET; + ((struct sockaddr_in *)&pARP->arp.arp_pa)->sin_addr.s_addr + = htonl (pInterface->myAddress.s_addr); + + /* Only supported interface type */ + pARP->arp.arp_ha.sa_family = ARPHRD_ETHER; + memcpy (pARP->arp.arp_ha.sa_data, &p->hardwareAddressHigh, + 2 * sizeof (EmbWord)); + + pARP->arp.arp_flags = ATF_COM | ATF_PERM /* | ATF_PUBL */ ; + memcpy (pARP->arp.arp_dev, interface->device, + sizeof (pARP->arp.arp_dev)); + + /* Only first interface structure has the device */ +#ifndef NOROOT + if (ioctl (ipSocket, SIOCSARP, &pARP->arp) < 0) + vpunt (NULL, "Unable to establish ARP mappings for VLM network interface #%d", + unitNumber); +#endif + } + } + + + /* Finish initialization */ + + p->status = 0; + p->guestPrimaryProtocol = interface->myProtocol; +#ifdef ARCH_X86_64 + p->guestPrimaryAddress = interface->myAddress.s_addr; +#else + p->guestPrimaryAddress = htonl (interface->myAddress.s_addr); +#endif + +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&p->hardwareAddressHigh, 2 * sizeof (EmbWord)); +#endif + + p->nTransmitFailures = p->nReceiveFailures = 0; + + p->guestToHostQueue = CreateQueue(NetworkTransmitterQueueSize, sizeof(EmbPtr)); + p->guestToHostQ = (EmbQueue*) HostPointer (p->guestToHostQueue); + p->guestToHostQ->signal = + InstallSignalHandler((ProcPtrV)&NetworkChannelTransmitter, + (PtrV) p, FALSE); + + p->guestToHostReturnQueue = + CreateQueue(NetworkTransmitterQueueSize, sizeof(EmbPtr)); + p->guestToHostReturnQ = (EmbQueue*) HostPointer(p->guestToHostReturnQueue); + + p->hostToGuestSupplyQueue = + CreateQueue(NetworkReceiverQueueSize, sizeof(EmbPtr)); + p->hostToGuestSupplyQ = (EmbQueue*) HostPointer(p->hostToGuestSupplyQueue); + + p->hostToGuestQueue = CreateQueue(NetworkReceiverQueueSize, sizeof(EmbPtr)); + p->hostToGuestQ = (EmbQueue*) HostPointer(p->hostToGuestQueue); + +#ifdef GENERA + for (pInterface = interface, firstInterface = TRUE; pInterface != NULL; + pInterface = pInterface->anotherAddress, firstInterface = FALSE) + { + if (firstInterface) + addressAsString[0] = 0; + else + sprintf (addressAsString, "%s,", addressAsString); + + if (pInterface->device[0]) + sprintf (addressAsString, "%s%s:", addressAsString, pInterface->device); + + switch (pInterface->myProtocol) + { + case ETHERTYPE_IP: + guestAddress.s_addr = htonl (pInterface->myAddress.s_addr); + sprintf (addressAsString, "%sINTERNET|%s", addressAsString, + inet_ntoa (guestAddress)); + break; + case ETHERTYPE_CHAOS: + sprintf (addressAsString, "%sCHAOS|%o", addressAsString, + htonl (pInterface->myAddress.s_addr)); + break; + } + + if (pInterface->myOptions[0]) + sprintf (addressAsString, "%s;%s", + addressAsString, pInterface->myOptions); + } + +//printf("addressAsString %s\n", addressAsString); + + p->addressString = MakeEmbString (addressAsString); +#endif + + if (pthread_create (&p->receiverThread, &EmbCommAreaPtr->inputThreadAttrs, + (pthread_startroutine_t) &NetworkChannelReceiver, + (pthread_addr_t) p)) + vpunt (NULL, + "Unable to create thread to receive packets for VLM network interface #%d", + unitNumber); + p->receiverThreadSetup = TRUE; + + p->status |= EmbNetStatusHostReady; +} + + +/* Reset a network channel */ + +void ResetNetworkChannel (EmbChannel* channel) +{ + register EmbNetChannel* netChannel = (EmbNetChannel*) channel; + + ResetIncomingQueue (netChannel->guestToHostQ); + ResetOutgoingQueue (netChannel->guestToHostReturnQ); + + ResetIncomingQueue (netChannel->hostToGuestSupplyQ); + ResetOutgoingQueue (netChannel->hostToGuestQ); +} + + +static char last_packet[1560]; + +static int +new_packet(char *packet, int size) +{ + if (memcmp(last_packet, packet, size) == 0) + return 0; + + memcpy(last_packet, packet, size); + + return 1; +} + +static void +recv_packet(char *packet, int size) +{ + register EmbNetChannel* netChannel = pInputChannel; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + + netPacketPtr = EmbQueueTakeWord (supplyQueue); + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord)size; + memcpy (&netPacket->data[0], packet, size); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, size); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); +} + +void +answer_arp(char *pkt, int size) +{ + char tmp[10]; + int i; + + pkt[21] = 2; + memcpy(tmp, &pkt[22], 10); + memcpy(&pkt[22], &pkt[32], 10); + + for (i = 0; i < 6; i++) + tmp[i] = i; + + memcpy(&pkt[32], tmp, 10); + + printf("answering arp\n"); + + recv_packet(pkt, size); +} + +void +dump_packet(char *who, unsigned char *pkt, int size) +{ + int i, offset = 0; + unsigned char *p; + unsigned short ptype; + int prot; + +#if 0 + p = pkt; + for (i = 0; i < 8; i++) { + printf("%04x: %02x %02x %02x %02x %02x %02x %02x %02x\n", + offset, p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); + offset += 8; + p += 8; + } +#endif + p = pkt; + ptype = (p[12]<<8)|p[13]; + + switch (ptype) { + case 0x0806: +#if 0 + printf("arp\n"); + op = (p[20]<<8)|p[21]; + if (op == 1) printf("request "); + if (op == 2) printf("response "); + printf("\n"); + p += 22; + printf("arp: sender %02x:%02x:%02x:%02x:%02x:%02x %u.%u.%u.%u\n", + p[0], p[1], p[2], p[3], p[4], p[5], + p[6], p[7], p[8], p[9]); + p += 10; + printf(" target %02x:%02x:%02x:%02x:%02x:%02x %u.%u.%u.%u", + p[0], p[1], p[2], p[3], p[4], p[5], + p[6], p[7], p[8], p[9]); + printf("\n"); + // answer_arp((char *)pkt, size); +#endif + break; + case 0x0800: + printf("%s ip: ", who); + p += 14; + prot = p[9]; + printf("%u.%u.%u.%u ", p[12], p[13], p[14], p[15]); + printf("%u.%u.%u.%u ", p[16], p[17], p[18], p[19]); + p += 20; + switch (prot) { + case 17: + printf("udp; %u %u", (p[0]<<8)|p[1], (p[2]<<8)|p[3]); + } + printf("\n"); + break; + default: + printf("%s ", who); + for (i = 0; i < 8; i++) { + printf("%04x: %02x %02x %02x %02x %02x %02x %02x %02x\n", + offset, + p[0], p[1], p[2], p[3], p[4], p[5], p[6], p[7]); + offset += 8; + p += 8; + } + break; + } +} + +/* Network Channel transmitter */ + +void NetworkChannelTransmitter (EmbNetChannel* pNetChannel) +{ + register EmbNetChannel* netChannel = pNetChannel; + register EmbQueue* transmitQueue = netChannel->guestToHostQ; + register EmbQueue* returnQueue = netChannel->guestToHostReturnQ; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t nBytes, actualBytes; + + + while (EmbQueueFilled (transmitQueue)) + { + if (0 == EmbQueueSpace (returnQueue)) + { + /* + * Can't do I/O now because we can't return the buffer -- + * Try again later + */ + SignalLater (transmitQueue->signal); + return; + } + + netPacketPtr = EmbQueueTakeWord (transmitQueue); + if (NULL == (void*)(uint64_t)netPacketPtr) netPacketPtr = NullEmbPtr; + + if (netPacketPtr != NullEmbPtr) + { + if (/*netChannel->status & EmbNetStatusHostReady*/1) + { + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + nBytes = (ssize_t) netPacket->nBytes; +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block(&netPacket->data, nBytes); +#endif + + memcpy(netChannel->sll.sll_addr, + ((struct ethhdr*)netPacket->data)->h_dest, + ETH_ALEN); + +#if 0 + /* */ + pptr = (char *)netPacket->data; + proto = (pptr[12] << 8) | pptr[13]; + + nBytes -= 14; + + if (proto == 0x800) + actualBytes = write(netChannel->fd, pptr + 14, nBytes); + else + actualBytes = nBytes; +#else + actualBytes = write(netChannel->fd, (char *)netPacket->data, + nBytes); +#endif + + if (actualBytes != nBytes) + { + printf("tx error\n"); + netChannel->nTransmitFailures++; + } +#if 1 + if (new_packet((char *)new_packet, nBytes) || 1) { + dump_packet("tx", (unsigned char *)&netPacket->data[0], nBytes); + } +#endif + } + + EmbQueuePutWord (returnQueue, netPacketPtr); + } + } +} + + +/* Network Channel receiver thread -- Can it be written to not copy??? */ + +#define OneMillisecond 1000000L + +void NetworkChannelReceiver (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + register EmbNetChannel* netChannel = (EmbNetChannel*) argument; + register EmbQueue* supplyQueue = netChannel->hostToGuestSupplyQ; + register EmbQueue* receiveQueue = netChannel->hostToGuestQ; + struct pollfd pollReceiver; + struct timespec receiverPause; + EmbPtr netPacketPtr; + EmbNetPacket* netPacket; + ssize_t actualBytes; + + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + + WaitUntilInitializationComplete (); + + pollReceiver.fd = netChannel->fd; + pollReceiver.events = POLLIN; + + while (TRUE) + { + pthread_testcancel (); + + pollReceiver.revents = 0; + poll (&pollReceiver, 1, 1000); + + if (0 == (pollReceiver.revents & POLLIN)) + continue; + +#if 0 + actualBytes = read(netChannel->fd, + ((char *)netChannel->receiveBuffer) + 14, + MaxEmbNetPacketSize); + + dump_packet("rx", (u_char *)&netChannel->receiveBuffer, actualBytes+14); +#else + actualBytes = read(netChannel->fd, netChannel->receiveBuffer, + MaxEmbNetPacketSize); + + { + u_char *pptr = (unsigned char *)netChannel->receiveBuffer; + u_short proto = (pptr[12] << 8) | pptr[13]; + + if (proto != 0x800 && proto != 0x806) + continue; + } + + dump_packet("rx", (u_char *)&netChannel->receiveBuffer, actualBytes); +#endif + + if (actualBytes < 0) + netChannel->nReceiveFailures++; + + else if (0 == actualBytes) + netChannel->nFalseReceiverWakeups++; + +#if 0 + else if (!(netChannel->status & EmbNetStatusGuestReady)) + ; +#endif + + else if ((0 == EmbQueueSpace (supplyQueue)) || (0 == EmbQueueSpace (receiveQueue))) + netChannel->nReceivedPacketsLost++; + + else + { +#if 0 + actualBytes += 14; +#endif + while (0 == (netPacketPtr = EmbQueueTakeWord (supplyQueue))) + { + receiverPause.tv_sec = 0; + receiverPause.tv_nsec = OneMillisecond; + if (pthread_delay_np (&receiverPause)) + vpunt (NULL, "Unable to sleep in thread %lx", self); + } + netPacket = (EmbNetPacket*) HostPointer (netPacketPtr); + netPacket->nBytes = (EmbWord) actualBytes; + memcpy (&netPacket->data[0], &netChannel->receiveBuffer[0], actualBytes); +#if BYTE_ORDER == BIG_ENDIAN + bswap32_block (&netPacket->data, actualBytes); +#endif + EmbQueuePutWord (receiveQueue, netPacketPtr); + } + } + + pthread_cleanup_pop (TRUE); +} + + +/* Cleanup a single network channel */ + +void TerminateNetChannel (EmbNetChannel* netChannel, int ipSocket) +{ + /* EmbNetARPReq *embARPReq; */ + void *exit_value; + + if (netChannel->receiverThreadSetup) + { + pthread_cancel (netChannel->receiverThread); + pthread_join (netChannel->receiverThread, &exit_value); + netChannel->receiverThreadSetup = FALSE; + } + +#ifndef NOROOT + /* for (embARPReq = netChannel->arpReq; embARPReq != NULL; embARPReq->next) */ + /* ioctl (ipSocket, SIOCDARP, &embARPReq->arp); */ +#endif + + if (netChannel->fd != -1) + { + close (netChannel->fd); + netChannel->fd = -1; + } +} + + +/* Cleanup the network channels */ + +void TerminateNetworkChannels () +{ + EmbNetChannel* netChannel; + EmbPtr channel; + int ipSocket; + + ipSocket = socket (PF_INET, SOCK_STREAM, 0); + + for (channel = EmbCommAreaPtr->channel_table; channel != NullEmbPtr; + channel = netChannel->next) + { + netChannel = (EmbNetChannel*) HostPointer (channel); + if (EmbNetworkChannelType == netChannel->type) + TerminateNetChannel (netChannel, ipSocket); + } + + if (ipSocket > -1) + close (ipSocket); +} + +#endif /* USE_TUN */ diff --git a/life-support/network.c b/life-support/network.c new file mode 100644 index 0000000..8cc9bd3 --- /dev/null +++ b/life-support/network.c @@ -0,0 +1,24 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Network Life Support */ + +#include "std.h" + +#if defined(OS_OSF) +#include "network-osf.c" + +#elif defined(OS_LINUX) +#include "network-linux.c" +#ifdef USE_TAP +#include "network-tap-linux.c" +#endif +#ifdef USE_TUN +#include "network-tun-linux.c" +#endif + +#elif defined(OS_DARWIN) +#include "network-darwin.c" + +#elif defined(__FreeBSD__) +#include "network-libpcap.c" +#endif diff --git a/life-support/polling.c b/life-support/polling.c new file mode 100644 index 0000000..ebda9a7 --- /dev/null +++ b/life-support/polling.c @@ -0,0 +1,322 @@ +/* -*- Mode: C -*- */ + +/* Life Support periodic activities */ + +#include "std.h" + +#include "life_types.h" +#include "embed.h" +#include "life_prototypes.h" +#include "utilities.h" + +#define OneSecond 1000000000L +#define OneQuarterSecond 250000000L +#define OneEighthSecond 125000000L +//#define OneSixteenthSecond 62500000L +#define OneSixteenthSecond 7500000L +#define OneSixteethSecond 16666667L +//#define OneSixteethSecond 8333333L + + +/* Returns TRUE if the VLM is running either in the IFEP or Lisp */ +boolean VLMIsRunning (EmbCommArea* ep) +{ + return ((ep->spy_status == 0) && (ep->fep.status != HaltedFEPStatus)); +} + +/* Returns TRUE if the VLM is running Lisp */ +boolean VLMIsRunningLisp (EmbCommArea* ep) +{ + return (VLMIsRunning (ep) && (ep->fep.status == IdleFEPStatus)); +} + +/* Updates the VLM guest status to reflect its current true status */ +void UpdateVLMStatus () +{ + register EmbCommArea *ep = EmbCommAreaPtr; + + switch (ep->guestStatus) + { + case NonexistentGuestStatus: + case BrokenGuestStatus: + /* VLM stays missing or broken until someone fixes it */ + break; + + case UninitializedGuestStatus: + case InitializingGuestStatus: + ep->guestStatus = VLMIsRunningLisp (ep) ? RunningGuestStatus + : VLMIsRunning (ep) ? InitializedGuestStatus + : ep->guestStatus; + break; + + case InitializedGuestStatus: + case StartedGuestStatus: + /* If VLM's no longer running the IFEP, assume it's in the BootROM or DevicePROM */ + ep->guestStatus = VLMIsRunningLisp (ep) ? RunningGuestStatus + : VLMIsRunning(ep) ? ep->guestStatus + : InitializingGuestStatus; + break; + + case CrashedGuestStatus: + case RunningGuestStatus: + ep->guestStatus = VLMIsRunningLisp (ep) ? RunningGuestStatus + : VLMIsRunning(ep) ? CrashedGuestStatus + : InitializingGuestStatus; + break; + } + + UpdateColdLoadNames (); +} + + +/* Reset the communications area */ + +static void ResetCommArea (boolean fullReset) +{ + register EmbChannel* channel; + register EmbPtr channelP; + + for (channelP = EmbCommAreaPtr->channel_table; channelP != NullEmbPtr; + channelP = channel->next) + { + channel = HostPointer (channelP); + switch (channel->type) + { + case EmbDiskChannelType: + if (fullReset) + ResetDiskChannel (channel); + break; + case EmbConsoleChannelType: + if (fullReset) + ResetConsoleChannel (channel); + break; + case EmbNetworkChannelType: + if (fullReset) + ResetNetworkChannel (channel); + break; +#ifdef UNIMPLEMENTED + case EmbRPCChannelType: + if (fullReset) + ResetRPCChannel (channel); + break; +#endif +#ifdef UNIMPLEMENTED + case EmbSCSIChannelType: + ResetSCSIChannel (channel); + break; +#endif + case EmbColdLoadChannelType: + ResetColdLoadChannel (channel); + break; +#ifdef UNIMPLEMENTED + case EmbHostFileChannelType: + ResetHostFileChannel (channel); + break; +#endif + case EmbMessageChannelType: + if (fullReset) + ResetMessageChannel (channel); + break; + } + } + + if (fullReset) + { + /* Reset host buffer memory when requested by Lisp */ + } +} + + +/* Process a reset request from the VLM */ + +void ProcessResetRequest () +{ + switch (EmbCommAreaPtr->reset_request) + { + case ReadNVRAMResetRequest: + /* Read permanent settings maintained by the host for the VLM -- NYI */ + break; + + case WriteNVRAMResetRequest: + /* Write permanent settings maintained by the host for the VLM -- NYI */ + break; + + case AreYouThereResetRequest: + /* Ivory simply wants to know if it's embedded */ + break; + + case FEPResetRequest: + /* The IFEP has started running and needs a partial reset of the communications area */ + ResetCommArea (FALSE); + break; + + case LispResetRequest: + /* Lisp has started running and needs a complete reset of the communications area */ + ResetCommArea (TRUE); + EmbCommAreaPtr->resetRequestCount++; /* A true reset */ + EmbCommAreaPtr->restart_applications = 1; /* Restart applications on full reset */ + break; + + default: + /* Silently ignore any requests which are either not supported or not recognized */ + break; + } + + EmbCommAreaPtr->reset_request = NoResetRequest; +} + + +/* Top level function of the polling thread -- Does all its work under protection of Life + Support's global signal lock as the main thrust of polling is to periodically wakeup + all signal handlers in case a "hardware interrupt" from the VLM was lost. */ + +void IvoryLifePolling (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + struct timespec pollingSleep; + + pollingSleep.tv_sec = 0; + pollingSleep.tv_nsec = 0; + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + + while (TRUE) + { + begin_MUTEX_LOCKED (signalLock); + + EmbCommAreaPtr->pollTime += pollingSleep.tv_nsec; + + PollMessageChannels (); + + if (EmbCommAreaPtr->reset_request != NoResetRequest) + ProcessResetRequest (); + + else if (EmbCommAreaPtr->pollTime > OneQuarterSecond) + // if (EmbCommAreaPtr->pollTime > OneEighthSecond); // OneQuarterSecond) + { + EmbCommAreaPtr->pollTime = 0; + EmbCommAreaPtr->guest_to_host_signals |= EmbCommAreaPtr->live_guest_to_host_signals; + if (pthread_cond_broadcast (&EmbCommAreaPtr->signalSignal)) + vpunt (NULL, "Unable to send Life Support signal signal in thread %lx", self); + } + + else if (EmbCommAreaPtr->reawaken) + // if (EmbCommAreaPtr->reawaken) + { + EmbCommAreaPtr->guest_to_host_signals |= EmbCommAreaPtr->reawaken; + EmbCommAreaPtr->reawaken = 0; + if (pthread_cond_broadcast (&EmbCommAreaPtr->signalSignal)) + vpunt (NULL, "Unable to send Life Support signal signal in thread %lx", self); + } + + end_MUTEX_LOCKED (signalLock); + + if (EmbCommAreaPtr->clock_interval > 0) + { + EmbCommAreaPtr->pollClockTime -= pollingSleep.tv_nsec; + if (EmbCommAreaPtr->pollClockTime <= 0) + { + EmbSendSignal (EmbCommAreaPtr->clock_signal); + EmbCommAreaPtr->pollClockTime = 1000 * EmbCommAreaPtr->clock_interval; + } + if (EmbCommAreaPtr->pollClockTime > OneQuarterSecond) + pollingSleep.tv_nsec = OneQuarterSecond; + else + pollingSleep.tv_nsec = EmbCommAreaPtr->pollClockTime; + } + + else + pollingSleep.tv_nsec = OneSixteenthSecond; + + UpdateVLMStatus (); + + if (0) { + printf("sleep; interval %d, time %ld, %ld\n", + EmbCommAreaPtr->clock_interval, + pollingSleep.tv_sec, pollingSleep.tv_nsec); + } + + pollingSleep.tv_sec = 0; + pollingSleep.tv_nsec = OneEighthSecond; + + if (pthread_delay_np (&pollingSleep)) + vpunt (NULL, "Unable to sleep in thread %lx", self); + } + + pthread_cleanup_pop (TRUE); +} + + +/* Top level function of the interval timer thread -- Sleeps for the interval requested + by the emulator thread and then sends a clock interrupt. As the emulator (nee, Lisp) + will frequently need to reprogram the timer while we're waiting, we actually wait for + a signal with a timeout. The emulator raises the signal to indicate that it's + reprogramming the interval timer. Should the wait timeout, we send the clock interrupt. */ + +void IntervalTimerDriver (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + struct timespec expirationTime, expirationInterval /*, newExpirationTime */ ; + // struct timeval tmv ; struct timezone tz ; + int result; + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + + WaitUntilInitializationComplete (); + + EmbCommAreaPtr->clockTime = -1; + + begin_MUTEX_LOCKED (clockLock); + + while (TRUE) + { + if (EmbCommAreaPtr->clockTime >= 0) + { + expirationInterval.tv_sec = 0; + expirationInterval.tv_nsec = 1000 * EmbCommAreaPtr->clockTime; + while (expirationInterval.tv_nsec >= OneSecond) + { + expirationInterval.tv_sec++; + expirationInterval.tv_nsec -= OneSecond; + } + if (pthread_get_expiration_np (&expirationInterval, &expirationTime) < 0) + vpunt (NULL, "Unable to compute interval timer expiration time"); + result = pthread_cond_timedwait (&EmbCommAreaPtr->clockSignal, + &EmbCommAreaPtr->clockLock, + &expirationTime); + } + + else + /* Wait indefinitely for someone to program the interval timer */ + result = pthread_cond_wait (&EmbCommAreaPtr->clockSignal, + &EmbCommAreaPtr->clockLock); + + if (result == ETIMEDOUT) + { + EmbSendSignal (EmbCommAreaPtr->clock_signal); + EmbCommAreaPtr->clockTime = -1; + } + } + + end_MUTEX_LOCKED (clockLock); + + pthread_cleanup_pop (TRUE); +} + +/* Reprogram the interval timer -- Called from the emulator thread in response to writing a + value to the WaitForNextEvent coprocessor register. We simply set the relative time for + the next interrupt and signal the interval timer thread. The interval timer thread will + wakeup, note that there's a new timeout, and go back to sleep with the new timeout. */ + +void SetIntervalTimer (Integer relativeTimeout) +{ + begin_MUTEX_LOCKED (clockLock); + + EmbCommAreaPtr->clockTime = relativeTimeout; + if (pthread_cond_broadcast (&EmbCommAreaPtr->clockSignal) < 0) + vpunt (NULL, "Unable to send Life Support clock signal in thread %lx", pthread_self ()); + + end_MUTEX_LOCKED (clockLock); + + pthread_yield (); +} diff --git a/life-support/queues.c b/life-support/queues.c new file mode 100644 index 0000000..6a88990 --- /dev/null +++ b/life-support/queues.c @@ -0,0 +1,411 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Queue manipulation routines */ + +#include "std.h" + +#include "life_types.h" +#include "embed.h" +#include "life_prototypes.h" + + +/* Create a queue */ + +EmbPtr CreateQueue (int nElements, int elementSize) +{ + EmbPtr cp = EmbCommAreaAlloc (sizeof (EmbQueue) + (nElements * elementSize)); + register EmbQueue* q = (EmbQueue*) HostPointer (cp); + + q->element_size = elementSize; + q->queue_size = nElements; + q->put_index = 0; + q->take_index = 0; + q->signal = -1; + + return (cp); +} + + +/* Number of free elements */ + +int EmbQueueSpace (EmbQueue* qp) +{ + register EmbWord put = qp->put_index; + register EmbWord take = qp->take_index; + + if (take > put) + return (take - put - 1); + else + return (take - put - 1 + qp->queue_size); +} + + +/* Number of non-free elements */ + +int EmbQueueFilled (EmbQueue* qp) +{ + register EmbWord put = qp->put_index; + register EmbWord take = qp->take_index; + + if (put >= take) + return (put - take); + else + return (put - take + qp->queue_size); +} + + +/* Put element into queue */ + +void EmbQueuePut (EmbQueue* qp_arg, PtrV ep) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + EmbWord original_put = put; + byte* element_array = (byte*)(&qp->first_element); + + /* Fill in the element at the put index */ + memcpy (&element_array[put * qp->element_size], ep, (size_t) qp->element_size); + + /* Compute the incremented put index */ + put++; + if (put >= qp->queue_size) + put = 0; + + /* Wait if queue is full -- Queue sizes will be chosen so that this is rare */ + while (put == qp->take_index); + + /* Store the incremented put index into the queue header */ + qp->put_index = put; + + /* If the queue had been empty, send a signal to the taker */ + if (original_put == qp->take_index) + EmbSendSignal (qp->signal); +} + + +/* Put element into word queue */ + +void EmbQueuePutWord (EmbQueue* qp_arg, EmbWord elt) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + EmbWord original_put = put; + register EmbWord* element_array = (EmbWord*)(&qp->first_element); + + /* Fill in the element at the put index */ + element_array[put] = elt; + + /* Compute the incremented put index */ + put++; + if (put >= qp->queue_size) + put = 0; + + /* Wait if queue is full -- Queue sizes will be chosen so that this is rare */ + while (put == qp->take_index); + + /* Store the incremented put index into the queue header */ + qp->put_index = put; + + /* If the queue had been empty, send a signal to the taker */ + if (original_put == qp->take_index) + EmbSendSignal (qp->signal); +} + + +/* Put element into byte queue */ + +void EmbQueuePutByte (EmbQueue* qp_arg, byte elt) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + EmbWord original_put = put; + register byte* element_array = (byte*)(&qp->first_element); + + /* Fill in the element at the put index */ + element_array[put] = elt; + + /* Compute the incremented put index */ + put++; + if (put >= qp->queue_size) + put = 0; + + /* Wait if queue is full -- Queue sizes will be chosen so that this is rare */ + while (put == qp->take_index); + + /* Store the incremented put index into the queue header */ + qp->put_index = put; + + /* If the queue had been empty, send a signal to the taker */ + if (original_put == qp->take_index) + EmbSendSignal (qp->signal); +} + + +/* Take element from queue */ + +bool EmbQueueTake (EmbQueue* qp_arg, PtrV ep) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + register EmbWord take = qp->take_index; + register byte* element_array = (byte*)(&qp->first_element); + + /* Check for empty queue */ + if (put == take) + return (FALSE); + + /* Copy the element at the take index */ + memcpy (ep, &element_array[take * qp->element_size], (size_t) qp->element_size); + + /* Increment the take index and store it back */ + take++; + if (take >= qp->queue_size) + take = 0; + qp->take_index = take; + + return (TRUE); +} + + +/* Take element from word queue */ + +EmbWord EmbQueueTakeWord (EmbQueue* qp_arg) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + register EmbWord take = qp->take_index; + register EmbWord* element_array = (EmbWord*)(&qp->first_element); + register EmbWord elt; + + /* Check for empty queue--should not happen */ + if (put == take) + return (FALSE); + + /* Copy the element at the take index */ + elt = element_array[take]; + + /* Increment the take index and store it back */ + take++; + if (take >= qp->queue_size) + take = 0; + qp->take_index = take; + + return (elt); +} + + +/* Take element from byte queue */ + +byte EmbQueueTakeByte (EmbQueue* qp_arg) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + register EmbWord take = qp->take_index; + register byte* element_array = (byte*)(&qp->first_element); + register byte elt; + + /* Check for empty queue--should not happen */ + if (put == take) + return (FALSE); + + /* Copy the element at the take index */ + elt = element_array[take]; + + /* Increment the take index and store it back */ + take++; + if (take >= qp->queue_size) + take = 0; + qp->take_index = take; + + return (elt); +} + + +/*** Transferring multiple queue elements at a time ***/ + +/* Each of these routines returns the number of elements actually transferred */ +/* None of these routines ever waits */ + +/* Put multiple bytes */ + +int EmbQueuePutBytes (EmbQueue* qp_arg, byte* buffer, int length) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + EmbWord original_put = put; + register EmbWord take; + register byte* element_array = (byte*)(&qp->first_element); + int actual_length = 0; + register EmbWord count; + + /* Loop transferring contiguous blocks of elements */ + while (length > 0) + { + /* Fill in as many elements as we can */ + take = qp->take_index; + if (take > put) + count = take - put - 1; + else if (take == 0) + count = qp->queue_size - put - 1; + else + count = qp->queue_size - put; + if (count > length) + count = length; + memcpy (&element_array[put], buffer, (size_t) count); + buffer += count; + length -= count; + actual_length += count; + put += count; + if (put == qp->queue_size) + put = 0; + qp->put_index = put; + } + + /* If the queue had been empty, send a signal to the taker */ + if (original_put == qp->take_index) + EmbSendSignal (qp->signal); + + return (actual_length); +} + + +/* Put multiple words */ + +int EmbQueuePutWords (EmbQueue* qp_arg, EmbWord* buffer, int length) +{ + register EmbQueue* qp = qp_arg; + register EmbWord put = qp->put_index; + EmbWord original_put = put; + register EmbWord take; + register EmbWord* element_array = (EmbWord*)(&qp->first_element); + int actual_length = 0; + register EmbWord count; + + /* Loop transferring contiguous blocks of elements */ + while (length > 0) + { + /* Fill in as many elements as we can */ + take = qp->take_index; + if (take > put) + count = take - put - 1; + else if (take == 0) + count = qp->queue_size - put - 1; + else + count = qp->queue_size - put; + if (count > length) + count = length; + memcpy (&element_array[put], buffer, (size_t) count * sizeof (EmbWord)); + buffer += count; + length -= count; + actual_length += count; + put += count; + if (put == qp->queue_size) + put = 0; + qp->put_index = put; + } + + /* If the queue had been empty, send a signal to the taker */ + if (original_put == qp->take_index) + EmbSendSignal (qp->signal); + + return (actual_length); +} + + +/* Take multiple bytes */ + +int EmbQueueTakeBytes (EmbQueue* qp_arg, byte* buffer, int length) +{ + register EmbQueue* qp = qp_arg; + register EmbWord take = qp->take_index; + register EmbWord put; + register byte* element_array = (byte*)(&qp->first_element); + int actual_length = 0; + register EmbWord count; + + /* Loop transferring contiguous blocks of elements */ + while (length > 0) + { + /* Fill in as many elements as we can */ + put = qp->put_index; + if (put >= take) + count = put - take; + else + count = qp->queue_size - take; + if (count > length) + count = length; + memcpy (buffer, &element_array[take], (size_t) count); + buffer += count; + length -= count; + actual_length += count; + take += count; + if (take == qp->queue_size) + take = 0; + qp->take_index = take; + } + + return (actual_length); +} + + +/* Take multiple words */ + +int EmbQueueTakeWords (EmbQueue* qp_arg, EmbWord* buffer, int length) +{ + register EmbQueue* qp = qp_arg; + register EmbWord take = qp->take_index; + register EmbWord put; + register EmbWord* element_array = (EmbWord*)(&qp->first_element); + int actual_length = 0; + register EmbWord count; + + /* Loop transferring contiguous blocks of elements */ + while (length > 0) + { + /* Fill in as many elements as we can */ + put = qp->put_index; + if (put >= take) + count = put - take; + else + count = qp->queue_size - take; + if (count > length) + count = length; + memcpy (buffer, &element_array[take], (size_t) count * sizeof (EmbWord)); + buffer += count; + length -= count; + actual_length += count; + take += count; + if (take == qp->queue_size) + take = 0; + qp->take_index = take; + } + + return (actual_length); +} + + +/* Reset an incoming (guest->host) queue -- + If the queue was created by the FEP or the guest, remove its signal handler */ + +void ResetIncomingQueue (EmbQueue* q) +{ + q->put_index = 0; + q->take_index = 0; + if (GuestPointer (q) > EmbCommAreaPtr->host_buffer_start + EmbCommAreaPtr->host_buffer_size) + { + RemoveSignalHandler (q->signal); + q->signal = -1; + } + +} + + +/* Reset an outgoing (host->guest) queue -- + Note that the guest is no longer listening for signals from this queue */ + +void ResetOutgoingQueue (EmbQueue* q) +{ + q->put_index = 0; + q->take_index = 0; + q->signal = -1; +} diff --git a/life-support/signals-ptw.c b/life-support/signals-ptw.c new file mode 100644 index 0000000..3bbfe5a --- /dev/null +++ b/life-support/signals-ptw.c @@ -0,0 +1,284 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Functions which handle signals between the VLM and host system */ + +#include +#include + +#include "life_types.h" +#include "embed.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "ivoryrep.h" + + +/* Initialize the data structures used for signal handling */ + +void InitializeSignalHandlers () +{ + int i; + + EmbCommAreaPtr->guest_to_host_signals = 0; + EmbCommAreaPtr->live_guest_to_host_signals = 0; + EmbCommAreaPtr->host_to_guest_signals = 0; + EmbCommAreaPtr->live_host_to_guest_signals = 0; + EmbCommAreaPtr->reawaken = 0; + EmbCommAreaPtr->useSignalLocks = FALSE; + + for (i = 0; i < NSignals; i++) + { + EmbCommAreaPtr->signalHandler[i].handlerThreadSetup = FALSE; + EmbCommAreaPtr->signalHandler[i].signal = 0; + EmbCommAreaPtr->signalHandler[i].handlerFunction = NULL; + EmbCommAreaPtr->signalHandler[i].handlerArgument = NULL; + } +} + + +/* Install a signal handler -- Handlers are implemented as threads */ + +SignalNumber InstallSignalHandler (ProcPtrV signalHandler, PtrV signalArgument, bool inputP) +{ + int policy, priority, i; + SignalMask signal; + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", + pthread_self ()); + + for (i = 0; i < NSignals; i++) + { + signal = 1 << i; + if ((EmbCommAreaPtr->live_guest_to_host_signals & signal) == 0) + { + EmbCommAreaPtr->live_guest_to_host_signals |= signal; + EmbCommAreaPtr->signalHandler[i].signal = signal; + EmbCommAreaPtr->signalHandler[i].handlerFunction = signalHandler; + EmbCommAreaPtr->signalHandler[i].handlerArgument = signalArgument; + if (EmbCommAreaPtr->signalHandler[i].handlerThreadSetup) + { +#ifdef USING_REALTIME_KERNEL + policy = pthread_attr_getsched ((inputP) ? EmbCommAreaPtr->inputThreadAttrs + : EmbCommAreaPtr->outputThreadAttrs); + priority = pthread_attr_getprio ((inputP) ? EmbCommAreaPtr->inputThreadAttrs + : EmbCommAreaPtr->outputThreadAttrs); + if (pthread_setscheduler (EmbCommAreaPtr->signalHandler[i].handlerThread, + policy, priority)) + vpunt (NULL, + "Unable to set scheduler policy/priority of thread %lx to %d/%d", + EmbCommAreaPtr->signalHandler[i].handlerThread, policy, priority); +#endif + } + else + { + if (pthread_create (&EmbCommAreaPtr->signalHandler[i].handlerThread, + (inputP) ? EmbCommAreaPtr->inputThreadAttrs + : EmbCommAreaPtr->outputThreadAttrs, + (pthread_startroutine_t)&SignalHandlerTopLevel, + &EmbCommAreaPtr->signalHandler[i])) + vpunt (NULL, "Unable to create thread to handle signal %d for %lx (%lx)", + i, signalHandler, signalArgument); + EmbCommAreaPtr->signalHandler[i].handlerThreadSetup = TRUE; + } + break; + } + } + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", + pthread_self ()); + + if (i < NSignals) + return (i); + else + vpunt (NULL, "Signal table overflow"); +} + + +/* Called by the emulator to inform us that the VLM has sent us an interrupt */ + +void SendInterruptToLifeSupport () +{ + if (pthread_cond_broadcast (&EmbCommAreaPtr->signalSignal)) + vpunt (NULL, "Unable to send Life Support an interrupt from the VLM"); +} + + +/* Called by the emulator to wait until life support detects an event which requires + a response by the emulator. This mechanism is used in Genera's idle process to + reduce the amount of host CPU time consumed by the VLM */ + +void WaitForLifeSupport () +{ + /* The emulator recognizes interrupts from Life Support only after branch and jump + instructions (i.e., instructions which change the PC). If we allowed the emulator + to wait for Life Support while there are pending signals, we could hang. + EXPLAIN FEP MODE ... + (Consider the case of the interval timer firing before the Idle process actually + waits for it. The clock signal would be pending but might not actually interrupt + the emulator if we're in the straight-line code in the Idle process before it + waits for Life Support.) */ + + if (pthread_mutex_lock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to lock the VLM wakeup lock in thread %lx", pthread_self ()); + + if (EmbCommAreaPtr->host_to_guest_signals && ((processor->control >> 30) & TrapMode_FEP) != + TrapMode_FEP) + SendInterruptToEmulator (); + + else + { + if (pthread_cond_wait (&EmbCommAreaPtr->wakeupSignal, &EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to wait for a VLM wakeup signal in thread %lx", + pthread_self ()); + + processor->previousrcpp = 0; /* Force microsecond clock to be reset */ + } + if (pthread_mutex_unlock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to unlock the VLM wakeup lock in thread %lx", + pthread_self ()); + +} + + +/* Send a signal to the VLM -- The emulator provides us with a function to send it an + interrupt just as we provide it a function to send us an interrupt. The emulator's + function ensures that the interrupt is delivered to the VLM at an appropriate time */ + +void EmbSendSignal (SignalNumber signal) +{ + if (pthread_mutex_lock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to lock the VLM wakeup lock in thread %lx", pthread_self ()); + + if ((signal > -1) && (signal < NSignals)) + { + EmbCommAreaPtr->host_to_guest_signals |= (1 << signal); + SendInterruptToEmulator (); + } + + if (pthread_cond_broadcast (&EmbCommAreaPtr->wakeupSignal)) + vpunt (NULL, "Unable to wakeup the VLM from Life Support"); + + if (pthread_mutex_unlock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to unlock the VLM wakeup lock in thread %lx", + pthread_self ()); + +} + + +/* Called by a signal handler when it can't handle the signal now and wishes to try later -- + The polling thread checks for said handlers each "clock tick" */ + +void SignalLater (SignalNumber signal) +{ + pthread_t self = pthread_self (); + + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", self); + + EmbCommAreaPtr->reawaken |= (SignalMask)(1 << signal); + + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", self); +} + + +/* Installed when removing a signal handler to render its thread benign */ + +static void NullSignalHandler (PtrV ignore) +{ +} + + +/* Remove a signal handler, including its thread */ + +void RemoveSignalHandler (SignalNumber signal) +{ + SignalMask mask = 1 << signal; + + if ((signal < 0) || (signal >= NSignals)) + return; + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", + pthread_self ()); + + EmbCommAreaPtr->live_guest_to_host_signals &= ~mask; + EmbCommAreaPtr->reawaken &= ~mask; + + /* Leave a last interrupt pending so that the signal handler thread can notice + that it's been cancelled and clean up gracefully */ + EmbCommAreaPtr->guest_to_host_signals |= mask; + + if (EmbCommAreaPtr->signalHandler[signal].handlerThreadSetup) + { + EmbCommAreaPtr->signalHandler[signal].handlerFunction = &NullSignalHandler; + EmbCommAreaPtr->signalHandler[signal].handlerArgument = NULL; + } + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", + pthread_self ()); +} + + +/* Remove all signal handlers, including their threads, on exit */ + +void TerminateSignalHandler (pthread_t argument) +{ + pthread_cancel(argument); +} + + +void TerminateSignalHandlers () +{ + int i; + + for (i = 0; i < NSignals; i++) + if (EmbCommAreaPtr->signalHandler[i].handlerThreadSetup) + { + TerminateSignalHandler(EmbCommAreaPtr->signalHandler[i].handlerThread); + EmbCommAreaPtr->signalHandler[i].handlerThreadSetup = FALSE; + } +} + + +/* Top level function for a signal handler thread -- We wait for our signal to be present + and call the real handler function */ + +static void SignalHandlerTopLevel (pthread_addr_t argument) +{ + SignalHandler *signalHandler = (SignalHandler*) argument; + pthread_t self = signalHandler->handlerThread; + + pthread_cleanup_push (pthread_detach, &self); + + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", self); + + while (TRUE) + { + if (EmbCommAreaPtr->guest_to_host_signals & signalHandler->signal) + { + EmbCommAreaPtr->guest_to_host_signals &= ~signalHandler->signal; + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", + self); + pthread_testcancel (); + (*(signalHandler->handlerFunction)) (signalHandler->handlerArgument); + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", + self); + } + + else if (pthread_cond_wait (&EmbCommAreaPtr->signalSignal, &EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to wait for the Life Support signal signal in thread %lx", + self); + } + + pthread_cleanup_pop (TRUE); +} diff --git a/life-support/signals.c b/life-support/signals.c new file mode 100644 index 0000000..545df96 --- /dev/null +++ b/life-support/signals.c @@ -0,0 +1,308 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* Functions which handle signals between the VLM and host system */ + +#include "std.h" + +#include "life_types.h" +#include "embed.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "ivoryrep.h" + + +/* Initialize the data structures used for signal handling */ + +void InitializeSignalHandlers () +{ + int i; + + EmbCommAreaPtr->guest_to_host_signals = 0; + EmbCommAreaPtr->live_guest_to_host_signals = 0; + EmbCommAreaPtr->host_to_guest_signals = 0; + EmbCommAreaPtr->live_host_to_guest_signals = 0; + EmbCommAreaPtr->reawaken = 0; + EmbCommAreaPtr->useSignalLocks = FALSE; + + for (i = 0; i < NSignals; i++) + { + EmbCommAreaPtr->signalHandler[i].handlerThreadSetup = FALSE; + EmbCommAreaPtr->signalHandler[i].signal = 0; + EmbCommAreaPtr->signalHandler[i].handlerFunction = NULL; + EmbCommAreaPtr->signalHandler[i].handlerArgument = NULL; + } +} + + +/* Install a signal handler -- Handlers are implemented as threads */ + +SignalNumber InstallSignalHandler (ProcPtrV signalHandler, PtrV signalArgument, bool inputP) +{ + int i; + SignalMask signal; + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", + pthread_self ()); + + for (i = 0; i < NSignals; i++) + { + signal = 1 << i; + if ((EmbCommAreaPtr->live_guest_to_host_signals & signal) == 0) + { + EmbCommAreaPtr->live_guest_to_host_signals |= signal; + EmbCommAreaPtr->signalHandler[i].signal = signal; + EmbCommAreaPtr->signalHandler[i].handlerFunction = signalHandler; + EmbCommAreaPtr->signalHandler[i].handlerArgument = signalArgument; + if (EmbCommAreaPtr->signalHandler[i].handlerThreadSetup) + { +#ifdef USING_REALTIME_KERNEL + int policy, priority; + + policy = pthread_attr_getsched ((inputP) ? EmbCommAreaPtr->inputThreadAttrs + : EmbCommAreaPtr->outputThreadAttrs); + priority = pthread_attr_getprio ((inputP) ? EmbCommAreaPtr->inputThreadAttrs + : EmbCommAreaPtr->outputThreadAttrs); + if (pthread_setscheduler (EmbCommAreaPtr->signalHandler[i].handlerThread, + policy, priority)) + vpunt (NULL, + "Unable to set scheduler policy/priority of thread %lx to %d/%d", + EmbCommAreaPtr->signalHandler[i].handlerThread, policy, priority); +#endif + } + else + { + if (pthread_create (&EmbCommAreaPtr->signalHandler[i].handlerThread, + (inputP) ? &EmbCommAreaPtr->inputThreadAttrs + : &EmbCommAreaPtr->outputThreadAttrs, + (pthread_startroutine_t)&SignalHandlerTopLevel, + &EmbCommAreaPtr->signalHandler[i])) + vpunt (NULL, "Unable to create thread to handle signal %d for %lx (%lx)", + i, signalHandler, signalArgument); + EmbCommAreaPtr->signalHandler[i].handlerThreadSetup = TRUE; + } + break; + } + } + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", + pthread_self ()); + + if (i < NSignals) + return (i); + else + vpunt (NULL, "Signal table overflow"); + return 0 ; +} + + +/* Called by the emulator to inform us that the VLM has sent us an interrupt */ + +void SendInterruptToLifeSupport () +{ + if (pthread_cond_broadcast (&EmbCommAreaPtr->signalSignal)) + vpunt (NULL, "Unable to send Life Support an interrupt from the VLM"); +} + + +/* Called by the emulator to wait until life support detects an event which requires + a response by the emulator. This mechanism is used in Genera's idle process to + reduce the amount of host CPU time consumed by the VLM */ + +void WaitForLifeSupport () +{ + struct timespec delta, abstime; + int result; + + delta.tv_sec = 1; + delta.tv_nsec = 0; + + /* The emulator recognizes interrupts from Life Support only after branch and jump + instructions (i.e., instructions which change the PC). If we allowed the emulator + to wait for Life Support while there are pending signals, we could hang. + EXPLAIN FEP MODE ... + (Consider the case of the interval timer firing before the Idle process actually + waits for it. The clock signal would be pending but might not actually interrupt + the emulator if we're in the straight-line code in the Idle process before it + waits for Life Support.) */ + + if (EmbCommAreaPtr->host_to_guest_signals + && ((processor->control >> 30) & TrapMode_FEP) != TrapMode_FEP) + SendInterruptToEmulator (); + + else + { + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_mutex_unlock, + (void*)&EmbCommAreaPtr->wakeupLock); + if (pthread_mutex_lock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to lock the VLM wakeup lock in thread %lx", pthread_self ()); + + if (pthread_get_expiration_np(&delta, &abstime)) + vpunt (NULL, "Unable to get absolute time"); + + /* 8.12 changed cond_wait to cond_timedwait because sometimes got here with signals */ + if ((result = pthread_cond_timedwait (&EmbCommAreaPtr->wakeupSignal, + &EmbCommAreaPtr->wakeupLock, &abstime))) + if (!(result == ETIMEDOUT || result == EINTR)) + vpunt (NULL, "Unable to wait for a VLM wakeup signal in thread %lx", + pthread_self ()); + + if (pthread_mutex_unlock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to unlock the VLM wakeup lock in thread %lx", + pthread_self ()); + pthread_cleanup_pop (FALSE); + +#if defined(ARCH_ALPHA) + processor->previousrcpp = 0; /* Force microsecond clock to be reset */ +#endif + } +} + + +/* Send a signal to the VLM -- The emulator provides us with a function to send it an + interrupt just as we provide it a function to send us an interrupt. The emulator's + function ensures that the interrupt is delivered to the VLM at an appropriate time */ + +void EmbSendSignal (SignalNumber signal) +{ + //hack + if (signal == 0) { + //printf("EmbSendSignal(0)\n"); + // while (1); + // if (EmbCommAreaPtr->clock_interval > 0) return; + //return; + } + + if (pthread_mutex_lock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to lock the VLM wakeup lock in thread %lx", pthread_self ()); + + if ((signal > -1) && (signal < NSignals)) + { + EmbCommAreaPtr->host_to_guest_signals |= (1 << signal); + SendInterruptToEmulator (); + } + + if (pthread_cond_broadcast (&EmbCommAreaPtr->wakeupSignal)) + vpunt (NULL, "Unable to wakeup the VLM from Life Support"); + + if (pthread_mutex_unlock (&EmbCommAreaPtr->wakeupLock)) + vpunt (NULL, "Unable to unlock the VLM wakeup lock in thread %lx", + pthread_self ()); +} + + +/* Called by a signal handler when it can't handle the signal now and wishes to try later -- + The polling thread checks for said handlers each "clock tick" */ + +void SignalLater (SignalNumber signal) +{ + pthread_t self = pthread_self (); + + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", self); + + EmbCommAreaPtr->reawaken |= (SignalMask)(1 << signal); + + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", self); +} + + +/* Installed when removing a signal handler to render its thread benign */ + +void NullSignalHandler (PtrV ignore) +{ +} + + +/* Remove a signal handler, including its thread */ + +void RemoveSignalHandler (SignalNumber signal) +{ + SignalMask mask = 1 << signal; + + if ((signal < 0) || (signal >= NSignals)) + return; + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", + pthread_self ()); + + EmbCommAreaPtr->live_guest_to_host_signals &= ~mask; + EmbCommAreaPtr->reawaken &= ~mask; + + /* Leave a last interrupt pending so that the signal handler thread can notice + that it's been cancelled and clean up gracefully */ + EmbCommAreaPtr->guest_to_host_signals |= mask; + + if (EmbCommAreaPtr->signalHandler[signal].handlerThreadSetup) + { + EmbCommAreaPtr->signalHandler[signal].handlerFunction = &NullSignalHandler; + EmbCommAreaPtr->signalHandler[signal].handlerArgument = NULL; + } + + if (EmbCommAreaPtr->useSignalLocks) + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", + pthread_self ()); +} + + +/* Remove all signal handlers, including their threads, on exit */ + +void TerminateSignalHandlers () +{ + int i; + void* exit_value; + + for (i = 0; i < NSignals; i++) + if (EmbCommAreaPtr->signalHandler[i].handlerThreadSetup) + { + pthread_cancel (EmbCommAreaPtr->signalHandler[i].handlerThread); + pthread_join (EmbCommAreaPtr->signalHandler[i].handlerThread, &exit_value); + EmbCommAreaPtr->signalHandler[i].handlerThreadSetup = FALSE; + } +} + + +/* Top level function for a signal handler thread -- We wait for our signal to be present + and call the real handler function */ + +void SignalHandlerTopLevel (pthread_addr_t argument) +{ + SignalHandler *signalHandler = (SignalHandler*) argument; + pthread_t self = signalHandler->handlerThread; + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + + begin_MUTEX_LOCKED (signalLock); + + while (TRUE) + { + if (EmbCommAreaPtr->guest_to_host_signals & signalHandler->signal) + { + EmbCommAreaPtr->guest_to_host_signals &= ~signalHandler->signal; + pthread_testcancel (); + if (pthread_mutex_unlock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to unlock the Life Support signal lock in thread %lx", + self); + (*(signalHandler->handlerFunction)) (signalHandler->handlerArgument); + if (pthread_mutex_lock (&EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to lock the Life Support signal lock in thread %lx", + self); + } + + else if (pthread_cond_wait (&EmbCommAreaPtr->signalSignal, + &EmbCommAreaPtr->signalLock)) + vpunt (NULL, "Unable to wait for the Life Support signal signal in thread %lx", + self); + } + + end_MUTEX_LOCKED (signalLock); + + pthread_cleanup_pop (TRUE); +} diff --git a/life-support/symbolics_characters.h b/life-support/symbolics_characters.h new file mode 100644 index 0000000..5a738a7 --- /dev/null +++ b/life-support/symbolics_characters.h @@ -0,0 +1,123 @@ +/* -*- Mode: C -*- */ +/*> + *> ***************************************************************************************** + *> ** (c) Copyright 1991-1989 Symbolics, Inc. All rights reserved. + *> ** Portions of font library Copyright (c) 1984 Bitstream, Inc. All Rights Reserved. + *> + *> The software, data, and information contained herein are proprietary + *> to, and comprise valuable trade secrets of, Symbolics, Inc., which intends + *> to keep such software, data, and information confidential and to preserve + *> them as trade secrets. They are given in confidence by Symbolics pursuant + *> to a written license agreement, and may be used, copied, transmitted, and + *> stored only in accordance with the terms of such license. + *> + *> Symbolics, Symbolics 3600, Symbolics 3670 (R), Symbolics 3675 (R), Symbolics 3630, + *> Symbolics 3640, Symbolics 3645 (R), Symbolics 3650 (R), Symbolics 3653, Symbolics + *> 3620 (R), Symbolics 3610 (R), Symbolics Common Lisp (R), Symbolics-Lisp (R), + *> Zetalisp (R), Genera (R), Wheels (R), Dynamic Windows (R), Showcase, SmartStore (R), + *> Semanticue (R), Frame-Up (R), Firewall (R), MACSYMA (R), COMMON LISP MACSYMA (R), + *> CL-MACSYMA (R), LISP MACHINE MACSYMA (R), MACSYMA Newsletter (R), PC-MACSYMA, Document + *> Examiner (R), Delivery Document Examiner, S-DYNAMICS (R), S-GEOMETRY (R), S-PAINT (R), + *> S-RECORD, S-RENDER (R), Displacement Animation, FrameThrower, PaintAmation, "Your Next + *> Step in Computing" (R), Ivory, MacIvory, MacIvory model 1, MacIvory model 2, MacIvory + *> model 3, XL400, XL1200, Symbolics UX400S, Symbolics UX1200S, Symbolics C, Symbolics + *> Pascal (R), Symbolics Prolog, Symbolics Fortran (R), CLOE (R), CLOE Application Generator, + *> CLOE Developer, CLOE Runtime, Common Lisp Developer, Symbolics Concordia, Joshua, and + *> Statice (R) are trademarks of Symbolics, Inc. + *> + *> RESTRICTED RIGHTS LEGEND + *> Use, duplication, and disclosure by the Government are subject to restrictions + *> as set forth in subdivision (c)(1)(ii) of the Rights in Technical Data and Computer + *> Software Clause at DFAR 52.227-7013. + *> + *> Symbolics, Inc. + *> 8 New England Executive Park, East + *> Burlington, Massachusetts 01803 + *> United States of America + *> 617-221-1000 + *> ***************************************************************************************** + *> + */ + +/* Symbolics Character Set + * + * $Log: symbolics_characters.h,v $ + * Revision 1.2 2003/12/03 17:19:23 palter + * First round of changes to compile on other platforms + * + * Revision 2.4.4.1 92/01/26 11:01:52 kaufman + * Baseline for Genera 8.1.1 Embedded Life Support Update + * + * Revision 2.4.3.1 91/08/13 11:28:16 kaufman + * Baseline for Genera 8.1 ECO#1 + * + * Revision 2.4.1.2 91/04/12 17:06:17 kaufman + * Update copyright notice for Genera 8.1 + * + * Revision 2.4.1.1 91/03/27 09:46:50 kaufman + * Baseline for distributed software + * + * Revision 2.4 91/03/27 09:41:22 kaufman + * Baseline for Genera 8.1 + * + * + */ + +#if !defined(lint) && defined(INCLUDE_FILE_HEADERS) +static char *s_char_rcsid = "@(#)$Header: /cvs/VLM/VLM/life-support/symbolics_characters.h,v 1.2 2003/12/03 17:19:23 palter Exp $"; +#endif + +/* Control Characters */ + +#define SK_Null 0200 +#define SK_Suspend 0201 +#define SK_Clear_Input 0202 +#define SK_Function 0204 +#define SK_Help 0206 +#define SK_Rubout 0207 +#define SK_Backspace 0210 +#define SK_Tab 0211 +#define SK_Line 0212 +#define SK_Refresh 0213 +#define SK_Page 0214 +#define SK_Return 0215 +#define SK_Abort 0221 +#define SK_Resume 0222 +#define SK_End 0224 +#define SK_Square 0225 +#define SK_Circle 0226 +#define SK_Triangle 0227 +#define SK_Scroll 0232 +#define SK_Select 0235 +#define SK_Network 0236 +#define SK_Escape 0237 +#define SK_Complete 0240 +#define SK_Symbol_help 0241 + +/* Cold Load Stream Operations */ + +#define clsoDrawChar 0000L +#define clsoSetCursorpos 0001L +#define clsoClearRestOfLine 0002L +#define clsoClearRestOfWindow 0003L +#define clsoDisplayLozengedString 0004L +#define clsoLozengedChar 0005L +#define clsoBeep 0012L +#define clsoSelect 0013L +#define clsoDeselect 0014L +#define clsoInputChar 0200L +#define clsoSetSize 0201L + +#define clOpCode(op) ((op)>>24 & 0xff) +#define clOpBits(op) ((op)>>12 & 0xfff) +#define clOpChar(op) ((op) & 0xff) +#define clMakeOp(code,bits,char) (((code)<<24) | ((unsigned long)bits<<12) | (unsigned long)char & 0xff) + +/* Unix ASCII to LispM character set translations */ + +#define ASCIItoLispMTranslations { 0010, 0210, \ + 0011, 0211, \ + 0012, 0215, \ + 0014, 0214, \ + 0015, 0212, \ + 0177, 0207 } diff --git a/life-support/unixcrypt.c b/life-support/unixcrypt.c new file mode 100644 index 0000000..be20c87 --- /dev/null +++ b/life-support/unixcrypt.c @@ -0,0 +1,131 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM Unix crypt Support */ + +#include "std.h" +#include + +#include "life_types.h" +#include "embed.h" +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "ivoryrep.h" +#include "memory.h" + +/* the maximum size of the returned crypt result string */ +/* is 123 chractars (acc. to Drepper) excluding */ +/* the terminating 0 byte for the string */ +#define MAX_CRYPT_RESULT_SIZE 124 + +static EmbPtr EmbCryptResult = NullEmbPtr ; +static char cryptResult[MAX_CRYPT_RESULT_SIZE]; + +static void allocateResult ( void ) { + if (EmbCryptResult == NullEmbPtr) { + memset ( cryptResult, (char) 1, MAX_CRYPT_RESULT_SIZE - 1); + cryptResult[MAX_CRYPT_RESULT_SIZE -1] = (char) 0 ; + EmbCryptResult = MakeEmbString ( cryptResult ); + } +} + +static char *getLispSimpleString (EmbWord *LispString, char *name) +{ + LispObj Lstring ; + char *string ; + size_t stringsize ; + + if (Type_String != + *MapVirtualAddressTag ((Integer)((Integer *)LispString - + MapVirtualAddressData (0)))) + { + verror ("UnixCrypt", "%s is not a simple string", name); + return NULL ; + } + + Lstring = VirtualMemoryRead (*LispString); + if (Type_HeaderI != (LispObjTag (Lstring) & 0x3F)) + { + verror ("UnixCrypt", "%s is not a simple string", name); + return NULL ; + } + + if ((LispObjData (Lstring) & ~Array_LengthMask) != 0x50000000L) + { + verror ("UnixCrypt", "%s is not a simple string", name); + return NULL; + } + + stringsize = LispObjData (Lstring) & Array_LengthMask; + string = (char*) malloc ((size_t)stringsize + 1); + if (NULL == string) + { + verror ("UnixCrypt", + "Couldn't allocate space for local copy of %s", name); + return NULL ; + } + + memcpy (string, + MapVirtualAddressData (*LispString + 1), + (size_t)stringsize); + string[stringsize] = 0; + return string ; +} + +/* crypt a password using a given a salt string */ +void UnixCrypt (UnixCryptRequest *pRequest) +{ + UnixCryptRequest *request = pRequest ; + EmbString *embString; + char *password, *salt, *result ; + int stringsize = MAX_CRYPT_RESULT_SIZE - 1 ; + + allocateResult (); + embString = (EmbString*) HostPointer (EmbCryptResult); + strcpy ( (char *)&embString->string, "*1" ); + embString->length = strlen("*1"); + request->cryptString = EmbCryptResult ; + request->cryptResult = ESUCCESS ; + password = getLispSimpleString ( &request->cryptPassword, "password" ); + if (password == NULL) { + request->cryptResult = EINVAL; + return; + } + salt = getLispSimpleString ( &request->cryptSalt, "salt" ); + if (salt == NULL) { + free ( password ); + request->cryptResult = EINVAL; + return; + } + errno = 0; + result = crypt( password, salt ); + if (errno == 2 || salt[0] != '$') { + vwarn("UnixCrypt", + "*WARNING* DES encryption requested. Computing it anyway"); + errno = 0; + result = crypt( password, salt ); + } + if (errno) { + verror("UnixCrypt", "crypt error"); + request->cryptResult = errno; + free(password); + free(salt); + return; + } + if (strlen(result) > stringsize) { + verror("UnixCrypt", + "result string too short (%d) for crypt result (%d)", + stringsize, + strlen(result)); + request->cryptResult = ENOMEM ; + free(password); + free(salt); + return; + } + strcpy ( (char *)&embString->string, result ); + embString->length = strlen (result ); + request->cryptString = EmbCryptResult ; + free(password); + free(salt); + return ; +} diff --git a/missing b/missing new file mode 100755 index 0000000..cdea514 --- /dev/null +++ b/missing @@ -0,0 +1,215 @@ +#! /bin/sh +# Common wrapper for a few potentially missing GNU programs. + +scriptversion=2012-06-26.16; # UTC + +# Copyright (C) 1996-2013 Free Software Foundation, Inc. +# Originally written by Fran,cois Pinard , 1996. + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2, or (at your option) +# any later version. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. + +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that program. + +if test $# -eq 0; then + echo 1>&2 "Try '$0 --help' for more information" + exit 1 +fi + +case $1 in + + --is-lightweight) + # Used by our autoconf macros to check whether the available missing + # script is modern enough. + exit 0 + ;; + + --run) + # Back-compat with the calling convention used by older automake. + shift + ;; + + -h|--h|--he|--hel|--help) + echo "\ +$0 [OPTION]... PROGRAM [ARGUMENT]... + +Run 'PROGRAM [ARGUMENT]...', returning a proper advice when this fails due +to PROGRAM being missing or too old. + +Options: + -h, --help display this help and exit + -v, --version output version information and exit + +Supported PROGRAM values: + aclocal autoconf autoheader autom4te automake makeinfo + bison yacc flex lex help2man + +Version suffixes to PROGRAM as well as the prefixes 'gnu-', 'gnu', and +'g' are ignored when checking the name. + +Send bug reports to ." + exit $? + ;; + + -v|--v|--ve|--ver|--vers|--versi|--versio|--version) + echo "missing $scriptversion (GNU Automake)" + exit $? + ;; + + -*) + echo 1>&2 "$0: unknown '$1' option" + echo 1>&2 "Try '$0 --help' for more information" + exit 1 + ;; + +esac + +# Run the given program, remember its exit status. +"$@"; st=$? + +# If it succeeded, we are done. +test $st -eq 0 && exit 0 + +# Also exit now if we it failed (or wasn't found), and '--version' was +# passed; such an option is passed most likely to detect whether the +# program is present and works. +case $2 in --version|--help) exit $st;; esac + +# Exit code 63 means version mismatch. This often happens when the user +# tries to use an ancient version of a tool on a file that requires a +# minimum version. +if test $st -eq 63; then + msg="probably too old" +elif test $st -eq 127; then + # Program was missing. + msg="missing on your system" +else + # Program was found and executed, but failed. Give up. + exit $st +fi + +perl_URL=http://www.perl.org/ +flex_URL=http://flex.sourceforge.net/ +gnu_software_URL=http://www.gnu.org/software + +program_details () +{ + case $1 in + aclocal|automake) + echo "The '$1' program is part of the GNU Automake package:" + echo "<$gnu_software_URL/automake>" + echo "It also requires GNU Autoconf, GNU m4 and Perl in order to run:" + echo "<$gnu_software_URL/autoconf>" + echo "<$gnu_software_URL/m4/>" + echo "<$perl_URL>" + ;; + autoconf|autom4te|autoheader) + echo "The '$1' program is part of the GNU Autoconf package:" + echo "<$gnu_software_URL/autoconf/>" + echo "It also requires GNU m4 and Perl in order to run:" + echo "<$gnu_software_URL/m4/>" + echo "<$perl_URL>" + ;; + esac +} + +give_advice () +{ + # Normalize program name to check for. + normalized_program=`echo "$1" | sed ' + s/^gnu-//; t + s/^gnu//; t + s/^g//; t'` + + printf '%s\n' "'$1' is $msg." + + configure_deps="'configure.ac' or m4 files included by 'configure.ac'" + case $normalized_program in + autoconf*) + echo "You should only need it if you modified 'configure.ac'," + echo "or m4 files included by it." + program_details 'autoconf' + ;; + autoheader*) + echo "You should only need it if you modified 'acconfig.h' or" + echo "$configure_deps." + program_details 'autoheader' + ;; + automake*) + echo "You should only need it if you modified 'Makefile.am' or" + echo "$configure_deps." + program_details 'automake' + ;; + aclocal*) + echo "You should only need it if you modified 'acinclude.m4' or" + echo "$configure_deps." + program_details 'aclocal' + ;; + autom4te*) + echo "You might have modified some maintainer files that require" + echo "the 'automa4te' program to be rebuilt." + program_details 'autom4te' + ;; + bison*|yacc*) + echo "You should only need it if you modified a '.y' file." + echo "You may want to install the GNU Bison package:" + echo "<$gnu_software_URL/bison/>" + ;; + lex*|flex*) + echo "You should only need it if you modified a '.l' file." + echo "You may want to install the Fast Lexical Analyzer package:" + echo "<$flex_URL>" + ;; + help2man*) + echo "You should only need it if you modified a dependency" \ + "of a man page." + echo "You may want to install the GNU Help2man package:" + echo "<$gnu_software_URL/help2man/>" + ;; + makeinfo*) + echo "You should only need it if you modified a '.texi' file, or" + echo "any other file indirectly affecting the aspect of the manual." + echo "You might want to install the Texinfo package:" + echo "<$gnu_software_URL/texinfo/>" + echo "The spurious makeinfo call might also be the consequence of" + echo "using a buggy 'make' (AIX, DU, IRIX), in which case you might" + echo "want to install GNU make:" + echo "<$gnu_software_URL/make/>" + ;; + *) + echo "You might have modified some files without having the proper" + echo "tools for further handling them. Check the 'README' file, it" + echo "often tells you about the needed prerequisites for installing" + echo "this package. You may also peek at any GNU archive site, in" + echo "case some other package contains this missing '$1' program." + ;; + esac +} + +give_advice "$1" | sed -e '1s/^/WARNING: /' \ + -e '2,$s/^/ /' >&2 + +# Propagate the correct exit status (expected to be 127 for a program +# not found, 63 for a program that failed due to version mismatch). +exit $st + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "scriptversion=" +# time-stamp-format: "%:y-%02m-%02d.%02H" +# time-stamp-time-zone: "UTC" +# time-stamp-end: "; # UTC" +# End: diff --git a/other/pfopen.c b/other/pfopen.c new file mode 100644 index 0000000..0f247d2 --- /dev/null +++ b/other/pfopen.c @@ -0,0 +1,100 @@ +/* + * ***************************************************************** + * * * + * * Copyright (c) Digital Equipment Corporation, 1991, 1993 * + * * * + * * All Rights Reserved. Unpublished rights reserved under * + * * the copyright laws of the United States. * + * * * + * * The software contained on this media is proprietary to * + * * and embodies the confidential technology of Digital * + * * Equipment Corporation. Possession, use, duplication or * + * * dissemination of the software and media is authorized only * + * * pursuant to a valid written license from Digital Equipment * + * * Corporation. * + * * * + * * RESTRICTED RIGHTS LEGEND Use, duplication, or disclosure * + * * by the U.S. Government is subject to restrictions as set * + * * forth in Subparagraph (c)(1)(ii) of DFARS 252.227-7013, * + * * or in FAR 52.227-19, as applicable. * + * * * + * ***************************************************************** + */ +/* + * HISTORY + */ +#ifndef lint +static char *rcsid = "@(#)$RCSfile: pfopen.c,v $ $Revision: 1.1.1.1 $ (DEC) $Date: 2003/12/03 16:57:16 $"; +#endif + +#include +#include /* for timeval struct in pfilt.h */ +#include +#include +#include +#include +#include + +#define PFPREFIX "/dev/pf/pfilt" /* prefix for device names */ +#define PFMAXMINORS 256 /* 8-bit minor device field */ +extern int errno; + +/* + * pfopen(ifname, flags): to support access to the Ethernet Packet Filter. + * (using kernel options PACKETFILTER, pseudo-device packetfilter) + * + * ifname is a ptr to the Ethernet device name ("ln0", "xna1", "pf0", etc.) + * or NULL for default + * flags are passed to the open() system call. + * + * return value: + * special device file descriptor on success + * -1 on failure with errno set to indicate the error + * + */ +pfopen(ifname, flags) +char *ifname; /* "ln0", "pf0", etc. or NULL */ +int flags; +{ + int i; /* loop counter */ + int fd; /* file descriptor */ + char tryname[128]; /* device name: "/dev/pf/pfiltnn" */ + static int setif(); + + if (ifname && (ifname[0] == 0)) + ifname = NULL; /* change empty string to NULL string */ + + /* find next available device under the /dev/pf directory */ + for (i = 0; i < PFMAXMINORS; i++) { + sprintf(tryname, "%s%d", PFPREFIX, i); + fd = open(tryname, flags, 0); + if (fd < 0) { + switch (errno) { + case EBUSY: /* device in use */ + continue; /* try the next entry */ + case ENOENT: /* ran out of filenames */ + case ENXIO: /* no more configured in kernel */ + default: /* something else went wrong */ + return(-1); + } + } + /* open succeeded, set the interface name */ + return(setif(fd, ifname)); + } + return(-1); /* didn't find an openable device */ +} + +static int setif(fd, ifname) +int fd; +char *ifname; +{ + if (ifname == NULL) /* use default */ + return(fd); + + if (ioctl(fd, EIOCSETIF, ifname) < 0) { + close(fd); + return(-1); + } + /* return the file descriptor */ + return(fd); +} diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..f45f27e --- /dev/null +++ b/src/Makefile @@ -0,0 +1,593 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# src/Makefile. Generated from Makefile.in by configure. + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + + + + +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/vlm +pkgincludedir = $(includedir)/vlm +pkglibdir = $(libdir)/vlm +pkglibexecdir = $(libexecdir)/vlm +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = x86_64-suse-linux-gnu +host_triplet = x86_64-suse-linux-gnu +bin_PROGRAMS = genera$(EXEEXT) byteswap_world$(EXEEXT) +subdir = src +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__installdirs = "$(DESTDIR)$(bindir)" +PROGRAMS = $(bin_PROGRAMS) +am_byteswap_world_OBJECTS = byteswap_world.$(OBJEXT) \ + world_tools.$(OBJEXT) utilities.$(OBJEXT) spy.$(OBJEXT) +byteswap_world_OBJECTS = $(am_byteswap_world_OBJECTS) +byteswap_world_DEPENDENCIES = ../emulator/libem.a \ + ../life-support/libls.a ../stub/libstub.a +am_genera_OBJECTS = main.$(OBJEXT) world_tools.$(OBJEXT) \ + utilities.$(OBJEXT) spy.$(OBJEXT) +genera_OBJECTS = $(am_genera_OBJECTS) +genera_DEPENDENCIES = ../emulator/libem.a ../life-support/libls.a \ + ../stub/libstub.a +AM_V_P = $(am__v_P_$(V)) +am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY)) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_$(V)) +am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY)) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_$(V)) +am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY)) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I. -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_$(V)) +am__v_CC_ = $(am__v_CC_$(AM_DEFAULT_VERBOSITY)) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_$(V)) +am__v_CCLD_ = $(am__v_CCLD_$(AM_DEFAULT_VERBOSITY)) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(byteswap_world_SOURCES) $(genera_SOURCES) +DIST_SOURCES = $(byteswap_world_SOURCES) $(genera_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = ${SHELL} /home/lispm/snap5/jj-vlm/missing aclocal-1.13 +AMTAR = $${TAR-tar} +AM_DEFAULT_VERBOSITY = 0 +AUTOCONF = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoconf +AUTOHEADER = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoheader +AUTOMAKE = ${SHELL} /home/lispm/snap5/jj-vlm/missing automake-1.13 +AWK = gawk +CC = gcc -std=gnu99 +CCDEPMODE = depmode=gcc3 +CFLAGS = -g -O2 -g0 -Ofast -rdynamic -fno-strict-aliasing -march=native -Wall +CLISP = /usr/bin/clisp +CPP = gcc -std=gnu99 -E +CPPFLAGS = -DGENERA -DAUTOSTART -DUSE_TAP +CYGPATH_W = echo +DEFS = -DHAVE_CONFIG_H +DEPDIR = .deps +ECHO_C = +ECHO_N = -n +ECHO_T = +EGREP = /usr/bin/grep -E +EXEEXT = +GREP = /usr/bin/grep +INSTALL = /usr/bin/install -c +INSTALL_DATA = ${INSTALL} -m 644 +INSTALL_PROGRAM = ${INSTALL} +INSTALL_SCRIPT = ${INSTALL} +INSTALL_STRIP_PROGRAM = $(install_sh) -c -s +LDFLAGS = +LIBOBJS = +LIBS = -lpthread -lm -ldl -lcrypt -lc -lX11 +LTLIBOBJS = +MAKEINFO = ${SHELL} /home/lispm/snap5/jj-vlm/missing makeinfo +MKDIR_P = /usr/bin/mkdir -p +OBJEXT = o +PACKAGE = vlm +PACKAGE_BUGREPORT = joachimq@achemich.de +PACKAGE_NAME = vlm +PACKAGE_STRING = vlm 0.99-1 +PACKAGE_TARNAME = vlm +PACKAGE_URL = +PACKAGE_VERSION = 0.99-1 +PATH_SEPARATOR = : +PTHREAD_CC = gcc -std=gnu99 +PTHREAD_CFLAGS = -pthread +PTHREAD_LIBS = +RANLIB = ranlib +SET_MAKE = +SHELL = /bin/sh +STRIP = +VERSION = 0.99-1 +XMKMF = +abs_builddir = /home/lispm/snap5/jj-vlm/src +abs_srcdir = /home/lispm/snap5/jj-vlm/src +abs_top_builddir = /home/lispm/snap5/jj-vlm +abs_top_srcdir = /home/lispm/snap5/jj-vlm +ac_ct_CC = gcc +acx_pthread_config = +am__include = include +am__leading_dot = . +am__quote = +am__tar = $${TAR-tar} chof - "$$tardir" +am__untar = $${TAR-tar} xf - +bindir = ${exec_prefix}/bin +build = x86_64-suse-linux-gnu +build_alias = +build_cpu = x86_64 +build_os = linux-gnu +build_vendor = suse +builddir = . +datadir = ${datarootdir} +datarootdir = ${prefix}/share +docdir = ${datarootdir}/doc/${PACKAGE_TARNAME} +dvidir = ${docdir} +exec_prefix = ${prefix} +host = x86_64-suse-linux-gnu +host_alias = +host_cpu = x86_64 +host_os = linux-gnu +host_vendor = suse +htmldir = ${docdir} +includedir = ${prefix}/include +infodir = ${datarootdir}/info +install_sh = ${SHELL} /home/lispm/snap5/jj-vlm/install-sh +libdir = ${exec_prefix}/lib64 +libexecdir = ${exec_prefix}/lib +localedir = ${datarootdir}/locale +localstatedir = ${prefix}/var +mandir = ${datarootdir}/man +mkdir_p = $(MKDIR_P) +oldincludedir = /usr/include +pdfdir = ${docdir} +prefix = /usr/local +program_transform_name = s,x,x, +psdir = ${docdir} +sbindir = ${exec_prefix}/sbin +sharedstatedir = ${prefix}/com +srcdir = . +sysconfdir = ${prefix}/etc +target_alias = +top_build_prefix = ../ +top_builddir = .. +top_srcdir = .. + +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I/home/lispm/snap5/jj-vlm/include -I/home/lispm/snap5/jj-vlm/life-support -I/home/lispm/snap5/jj-vlm/emulator -I/home/lispm/snap5/jj-vlm/x86_64-emulator +genera_SOURCES = main.c world_tools.c utilities.c spy.c +genera_LDADD = ../emulator/libem.a ../life-support/libls.a ../stub/libstub.a +byteswap_world_SOURCES = byteswap_world.c world_tools.c utilities.c spy.c +byteswap_world_LDADD = ../emulator/libem.a ../life-support/libls.a ../stub/libstub.a +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu src/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): +install-binPROGRAMS: $(bin_PROGRAMS) + @$(NORMAL_INSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ + fi; \ + for p in $$list; do echo "$$p $$p"; done | \ + sed 's/$(EXEEXT)$$//' | \ + while read p p1; do if test -f $$p \ + ; then echo "$$p"; echo "$$p"; else :; fi; \ + done | \ + sed -e 'p;s,.*/,,;n;h' \ + -e 's|.*|.|' \ + -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ + sed 'N;N;N;s,\n, ,g' | \ + $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ + { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ + if ($$2 == $$4) files[d] = files[d] " " $$1; \ + else { print "f", $$3 "/" $$4, $$1; } } \ + END { for (d in files) print "f", d, files[d] }' | \ + while read type dir files; do \ + if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ + test -z "$$files" || { \ + echo " $(INSTALL_PROGRAM_ENV) $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \ + $(INSTALL_PROGRAM_ENV) $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ + } \ + ; done + +uninstall-binPROGRAMS: + @$(NORMAL_UNINSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + files=`for p in $$list; do echo "$$p"; done | \ + sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ + -e 's/$$/$(EXEEXT)/' \ + `; \ + test -n "$$list" || exit 0; \ + echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(bindir)" && rm -f $$files + +clean-binPROGRAMS: + -test -z "$(bin_PROGRAMS)" || rm -f $(bin_PROGRAMS) + +byteswap_world$(EXEEXT): $(byteswap_world_OBJECTS) $(byteswap_world_DEPENDENCIES) $(EXTRA_byteswap_world_DEPENDENCIES) + @rm -f byteswap_world$(EXEEXT) + $(AM_V_CCLD)$(LINK) $(byteswap_world_OBJECTS) $(byteswap_world_LDADD) $(LIBS) + +genera$(EXEEXT): $(genera_OBJECTS) $(genera_DEPENDENCIES) $(EXTRA_genera_DEPENDENCIES) + @rm -f genera$(EXEEXT) + $(AM_V_CCLD)$(LINK) $(genera_OBJECTS) $(genera_LDADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +include ./$(DEPDIR)/byteswap_world.Po +include ./$(DEPDIR)/main.Po +include ./$(DEPDIR)/spy.Po +include ./$(DEPDIR)/utilities.Po +include ./$(DEPDIR)/world_tools.Po + +.c.o: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c $< + +.c.obj: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(PROGRAMS) +installdirs: + for dir in "$(DESTDIR)$(bindir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-binPROGRAMS clean-generic clean-local mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-binPROGRAMS + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-binPROGRAMS + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean \ + clean-binPROGRAMS clean-generic clean-local cscopelist-am \ + ctags ctags-am distclean distclean-compile distclean-generic \ + distclean-tags distdir dvi dvi-am html html-am info info-am \ + install install-am install-binPROGRAMS install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-man install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-compile \ + mostlyclean-generic pdf pdf-am ps ps-am tags tags-am uninstall \ + uninstall-am uninstall-binPROGRAMS + + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/src/Makefile.am b/src/Makefile.am new file mode 100644 index 0000000..13f8ef6 --- /dev/null +++ b/src/Makefile.am @@ -0,0 +1,13 @@ +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS=-I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator + +bin_PROGRAMS=genera byteswap_world +genera_SOURCES=main.c world_tools.c utilities.c spy.c +genera_LDADD = ../emulator/libem.a ../life-support/libls.a ../stub/libstub.a +byteswap_world_SOURCES=byteswap_world.c world_tools.c utilities.c spy.c +byteswap_world_LDADD = ../emulator/libem.a ../life-support/libls.a ../stub/libstub.a + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ diff --git a/src/Makefile.in b/src/Makefile.in new file mode 100644 index 0000000..f799224 --- /dev/null +++ b/src/Makefile.in @@ -0,0 +1,593 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +bin_PROGRAMS = genera$(EXEEXT) byteswap_world$(EXEEXT) +subdir = src +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +am__installdirs = "$(DESTDIR)$(bindir)" +PROGRAMS = $(bin_PROGRAMS) +am_byteswap_world_OBJECTS = byteswap_world.$(OBJEXT) \ + world_tools.$(OBJEXT) utilities.$(OBJEXT) spy.$(OBJEXT) +byteswap_world_OBJECTS = $(am_byteswap_world_OBJECTS) +byteswap_world_DEPENDENCIES = ../emulator/libem.a \ + ../life-support/libls.a ../stub/libstub.a +am_genera_OBJECTS = main.$(OBJEXT) world_tools.$(OBJEXT) \ + utilities.$(OBJEXT) spy.$(OBJEXT) +genera_OBJECTS = $(am_genera_OBJECTS) +genera_DEPENDENCIES = ../emulator/libem.a ../life-support/libls.a \ + ../stub/libstub.a +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(byteswap_world_SOURCES) $(genera_SOURCES) +DIST_SOURCES = $(byteswap_world_SOURCES) $(genera_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CLISP = @CLISP@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +OBJEXT = @OBJEXT@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +RANLIB = @RANLIB@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +XMKMF = @XMKMF@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +acx_pthread_config = @acx_pthread_config@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ + +#AM_CFLAGS=-Ofast -fno-strict-aliasing -std=gnu99 +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator +genera_SOURCES = main.c world_tools.c utilities.c spy.c +genera_LDADD = ../emulator/libem.a ../life-support/libls.a ../stub/libstub.a +byteswap_world_SOURCES = byteswap_world.c world_tools.c utilities.c spy.c +byteswap_world_LDADD = ../emulator/libem.a ../life-support/libls.a ../stub/libstub.a +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu src/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu src/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): +install-binPROGRAMS: $(bin_PROGRAMS) + @$(NORMAL_INSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + if test -n "$$list"; then \ + echo " $(MKDIR_P) '$(DESTDIR)$(bindir)'"; \ + $(MKDIR_P) "$(DESTDIR)$(bindir)" || exit 1; \ + fi; \ + for p in $$list; do echo "$$p $$p"; done | \ + sed 's/$(EXEEXT)$$//' | \ + while read p p1; do if test -f $$p \ + ; then echo "$$p"; echo "$$p"; else :; fi; \ + done | \ + sed -e 'p;s,.*/,,;n;h' \ + -e 's|.*|.|' \ + -e 'p;x;s,.*/,,;s/$(EXEEXT)$$//;$(transform);s/$$/$(EXEEXT)/' | \ + sed 'N;N;N;s,\n, ,g' | \ + $(AWK) 'BEGIN { files["."] = ""; dirs["."] = 1 } \ + { d=$$3; if (dirs[d] != 1) { print "d", d; dirs[d] = 1 } \ + if ($$2 == $$4) files[d] = files[d] " " $$1; \ + else { print "f", $$3 "/" $$4, $$1; } } \ + END { for (d in files) print "f", d, files[d] }' | \ + while read type dir files; do \ + if test "$$dir" = .; then dir=; else dir=/$$dir; fi; \ + test -z "$$files" || { \ + echo " $(INSTALL_PROGRAM_ENV) $(INSTALL_PROGRAM) $$files '$(DESTDIR)$(bindir)$$dir'"; \ + $(INSTALL_PROGRAM_ENV) $(INSTALL_PROGRAM) $$files "$(DESTDIR)$(bindir)$$dir" || exit $$?; \ + } \ + ; done + +uninstall-binPROGRAMS: + @$(NORMAL_UNINSTALL) + @list='$(bin_PROGRAMS)'; test -n "$(bindir)" || list=; \ + files=`for p in $$list; do echo "$$p"; done | \ + sed -e 'h;s,^.*/,,;s/$(EXEEXT)$$//;$(transform)' \ + -e 's/$$/$(EXEEXT)/' \ + `; \ + test -n "$$list" || exit 0; \ + echo " ( cd '$(DESTDIR)$(bindir)' && rm -f" $$files ")"; \ + cd "$(DESTDIR)$(bindir)" && rm -f $$files + +clean-binPROGRAMS: + -test -z "$(bin_PROGRAMS)" || rm -f $(bin_PROGRAMS) + +byteswap_world$(EXEEXT): $(byteswap_world_OBJECTS) $(byteswap_world_DEPENDENCIES) $(EXTRA_byteswap_world_DEPENDENCIES) + @rm -f byteswap_world$(EXEEXT) + $(AM_V_CCLD)$(LINK) $(byteswap_world_OBJECTS) $(byteswap_world_LDADD) $(LIBS) + +genera$(EXEEXT): $(genera_OBJECTS) $(genera_DEPENDENCIES) $(EXTRA_genera_DEPENDENCIES) + @rm -f genera$(EXEEXT) + $(AM_V_CCLD)$(LINK) $(genera_OBJECTS) $(genera_LDADD) $(LIBS) + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/byteswap_world.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/main.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/spy.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/utilities.Po@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/world_tools.Po@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(PROGRAMS) +installdirs: + for dir in "$(DESTDIR)$(bindir)"; do \ + test -z "$$dir" || $(MKDIR_P) "$$dir"; \ + done +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-binPROGRAMS clean-generic clean-local mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: install-binPROGRAMS + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: uninstall-binPROGRAMS + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean \ + clean-binPROGRAMS clean-generic clean-local cscopelist-am \ + ctags ctags-am distclean distclean-compile distclean-generic \ + distclean-tags distdir dvi dvi-am html html-am info info-am \ + install install-am install-binPROGRAMS install-data \ + install-data-am install-dvi install-dvi-am install-exec \ + install-exec-am install-html install-html-am install-info \ + install-info-am install-man install-pdf install-pdf-am \ + install-ps install-ps-am install-strip installcheck \ + installcheck-am installdirs maintainer-clean \ + maintainer-clean-generic mostlyclean mostlyclean-compile \ + mostlyclean-generic pdf pdf-am ps ps-am tags tags-am uninstall \ + uninstall-am uninstall-binPROGRAMS + + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/src/byteswap_world.c b/src/byteswap_world.c new file mode 100644 index 0000000..4cafab9 --- /dev/null +++ b/src/byteswap_world.c @@ -0,0 +1,58 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +/* VLM World File Tools */ + +#include "std.h" + +#include "world_tools.h" +#include "utilities.h" + +#define CommandName "byteswap_world" + +Boolean Trace = FALSE; +Boolean EnableIDS = FALSE; +Boolean TestFunction = FALSE; + +int main (int argc, char** argv) +{ + char *searchPath = strdup (DefaultWorldSearchPath); + char *worldPath; + size_t argLength; + int i; + boolean sawWorld = FALSE; + + SetCommandName (CommandName); + + for (i = 1; i < argc; i++) + { + argLength = strlen (argv[i]); + if (0 == strncmp (argv[i], "-searchpath", (argLength < 7) ? 7 : argLength)) { + if (i < argc - 1) + searchPath = argv[++i]; + else + vpunt (NULL, "A search path must follow %s", argv[i]); + } + } + + for (i = 1; i < argc; i++) + { + argLength = strlen (argv[i]); + if (0 == strncmp (argv[i], "-searchpath", (argLength < 7) ? 7 : argLength)) + i++; + else if (0 == strncmp (argv[i], "-", 1)) + vpunt (NULL, "Unrecognized option: %s", argv[i]); + else + { + sawWorld = TRUE; + worldPath = argv[i]; + if (NULL == strchr (worldPath, '/')) + worldPath = strncat (strdup ("./"), argv[i], argLength); + ByteSwapWorld (worldPath, searchPath); + } + } + + if (!sawWorld) + vpunt (NULL, "Usage: %s worlds {-searchpath PATH}", CommandName); + + exit (EXIT_SUCCESS); +} diff --git a/src/main.c b/src/main.c new file mode 100644 index 0000000..1bd76e2 --- /dev/null +++ b/src/main.c @@ -0,0 +1,224 @@ +/* -*- Mode: C; Tab-Width: 4 -*- */ + +#include "std.h" + +#include "VLM_configuration.h" +#include "life_prototypes.h" +#include "world_tools.h" +#include "utilities.h" +#include "SystemComm.h" + +#ifdef _C_EMULATOR_ +#include "emulator.h" +#include "memory.h" +#else +#include "ivoryrep.h" +#endif +#include "spy.h" + +#ifdef OS_OSF +#include +#else +#include +#endif + +#define MBToWords(MB) ((MB * 1024 * 1024) + 4)/5 +#define WordsToMB(words) ((5 * words) + (1024 * 1024) - 1)/(1024 * 1024) + +Boolean Trace = FALSE; +Boolean EnableIDS = FALSE; +Boolean TestFunction = FALSE; +static pthread_key_t mainThread; + +static void MaybeTerminateVLM (int signal) +{ +#ifdef OS_LINUX + char *answer = NULL; + size_t answerSize = 0, *answerSize_p = &answerSize; + ssize_t nRead; +#else + char answer[BUFSIZ]; +#endif + + if (NULL == pthread_getspecific (mainThread)) + return; + + if (EmbCommAreaPtr->guestStatus > StartedGuestStatus) + { + if (RunningGuestStatus == EmbCommAreaPtr->guestStatus) + fprintf (stderr, "\nLisp is running!\n\n"); + else + fprintf (stderr, "\nLisp was running!\n\n"); + + fprintf (stderr, "If you exit, the current state of Lisp will be lost.\n"); + fprintf (stderr, "All information in its memory image (e.g., any modified editor\n"); + fprintf (stderr, "buffers) will be irretrievably lost. Further, Lisp will abandon\n"); + fprintf (stderr, "any tasks it is performing for its clients.\n\n"); + + fprintf (stderr, "Do you still wish to exit? (yes or no) "); + fflush (stderr); + + while (TRUE) + { +#ifdef OS_LINUX + nRead = getline (&answer, answerSize_p, stdin); + if (nRead < 0) + vpunt (NULL, "Unexpected EOF on standard input"); + answer[nRead - 1] = '\0'; +#else + if (NULL == gets (answer)) + vpunt (NULL, "Unexpected EOF on standard input"); +#endif + if (0 == strcmp (answer, "yes")) + break; + else if (0 == strcmp (answer, "no")) + return; + else + { + fprintf (stderr, "Please answer 'yes' or 'no'. "); + fflush (stderr); + } + } + } + + TerminateTracing (); + TerminateSpy (); + TerminateLifeSupport (); + + _exit (EXIT_SUCCESS); +} + + +int main (int argc, char** argv) +{ + VLMConfig config; + struct sigaction sigAction; + Integer worldImageSize, worldImageMB; + char* message; + int reason; + + BuildConfiguration (&config, argc, argv); +#ifdef GENERA + EnableIDS = config.enableIDS; +#endif + + TestFunction = config.testFunction; + Trace = config.tracing.tracePOST; + InitializeIvoryProcessor (MapVirtualAddressData (0), MapVirtualAddressTag (0)); + + Trace = config.tracing.traceP; + if (Trace) InitializeTracing (config.tracing.bufferSize, config.tracing.startPC, + config.tracing.stopPC, config.tracing.outputFile); + + if (InitializeLifeSupport (&config) < 0) exit (-1); + +#if defined(OS_OSF) + ieee_set_fp_control(IEEE_TRAP_ENABLE_INV + + IEEE_TRAP_ENABLE_DZE + + IEEE_TRAP_ENABLE_OVF + + IEEE_TRAP_ENABLE_UNF + + IEEE_TRAP_ENABLE_INE); + +#elif defined(OS_LINUX) +#ifdef FE_NOMASK_ENV + fesetenv (FE_NOMASK_ENV); +#else + feenableexcept (FE_INEXACT | FE_DIVBYZERO | FE_UNDERFLOW | FE_OVERFLOW | FE_INVALID); +#endif + +#elif defined(OS_DARWIN) + /* TBD: -- Need an equivalent to: fesetenv (FE_NOMASK_ENV) */ +#endif + + if (pthread_key_create (&mainThread, NULL)) + vpunt (NULL, "Unable to establish per-thread data."); + + pthread_setspecific (mainThread, (void*) TRUE); + + sigAction.sa_handler = (sa_handler_t)MaybeTerminateVLM; + sigemptyset (&sigAction.sa_mask); + sigAction.sa_flags = 0; + if (sigaction (SIGINT, &sigAction, NULL)) + vpunt (NULL, "Unable to establish SIGINT handler."); + if (sigaction (SIGTERM, &sigAction, NULL)) + vpunt (NULL, "Unable to establish SIGTERM handler."); + if (sigaction (SIGHUP, &sigAction, NULL)) + vpunt (NULL, "Unable to establish SIGHUP handler."); + if (sigaction (SIGQUIT, &sigAction, NULL)) + vpunt (NULL, "Unable to establish SIGQUIT handler."); + +#ifdef IVERIFY + EnsureVirtualAddressRange (0xF8000000L, 0x00100000L, FALSE); +#else + worldImageSize = LoadWorld (&config); + +#ifdef GENERA + LoadVLMDebugger (&config); + + worldImageMB = WordsToMB (worldImageSize); + if (worldImageMB > config.virtualMemory) + vpunt (NULL, "World file %s won't fit within the requested virtual memory (%dMB)", + config.worldPath, config.virtualMemory); + if ((2 * worldImageMB) > config.virtualMemory) + vwarn (NULL, "Only %dMB of virtual memory unused after loading world file %s\n", + (config.virtualMemory - worldImageMB), config.worldPath); + + VirtualMemoryWrite (SystemCommSlotAddress (enableSysoutAtColdBoot), + EnableIDS ? processor->taddress : processor->niladdress); + + EmbCommAreaPtr->virtualMemorySize = MBToWords (config.virtualMemory); + EmbCommAreaPtr->worldImageSize = worldImageSize; +#endif +#endif + + if (config.enableSpy) InitializeSpy (TRUE, config.diagnosticIPAddress.s_addr); + +#ifdef AUTOSTART + if (!IvoryProcessorSystemStartup (TRUE)) + vpunt (NULL, "Unable to start the VLM."); +#endif + + if (config.enableSpy) ReleaseSpyLock (); + + while (config.enableSpy ? TRUE : Runningp()) + { + reason = InstructionSequencer (); + if (reason) + { + switch (reason) + { + case HaltReason_IllInstn: + message = "Unimplemented instruction"; + break; + + case HaltReason_Halted: + message = NULL; + break; + + case HaltReason_SpyCalled: + message = NULL; + break; + + case HaltReason_FatalStackOverflow: + message = "Stack overflow while not in emulator mode"; + break; + + case HaltReason_IllegalTrapVector: + message = "Illegal trap vector contents"; + break; + + default: + message = "Halted for unknown reason"; + } + if (message != NULL) + vwarn (NULL, "%s at PC %08x (%s)", message, processor->epc >> 1, + (processor->epc & 1) ? "Odd" : "Even"); + } +#ifndef IVERIFY + if (HaltReason_Halted == reason) + break; +#endif + } + + exit (EXIT_SUCCESS); +} diff --git a/src/spy.c b/src/spy.c new file mode 100644 index 0000000..f03aad2 --- /dev/null +++ b/src/spy.c @@ -0,0 +1,590 @@ +/* -*- Mode:C -*- */ + +#include "std.h" +#include +#include +#include +#include +#include +#include +#include +#include + +#ifdef _C_EMULATOR_ +#include "emulator.h" +#include "ivory.h" +#else +#include "aistat.h" +#include "aihead.h" +#include "ivoryrep.h" +#endif +#include "memory.h" +#include "spy.h" + +#include "life_types.h" +#include "embed.h" +#include "life_prototypes.h" +#include "utilities.h" + +/* BEGIN KLUDGE! */ +#define MemoryPageNumber(vma) ((vma) >> MemoryPage_AddressShift) +#define CreatedP(vma) VMExists(VMAttributeTable[MemoryPageNumber(vma)]) +/* END KLUDGE! */ + +#define PageSize 0x100 + +#define REMOTE_MEMORY_PACKET_DATA 1284 +#define MEGABYTES 256 + +typedef enum { + rm_discard, + rm_noop, + rm_ack, + rm_write, + rm_read, + rm_system_startup, + rm_trap, + rm_boot, + rm_create_pages, + rm_mbin, + rm_stop + } remote_memory_opcode; + +typedef enum { + rm_physical, + rm_virtual, + rm_register, + rm_coprocessor + } remote_memory_type; + +struct rm_pkt { + unsigned char rm_pad[2]; + unsigned char rm_id[4]; + unsigned char rm_operand[3]; + int rm_opcode:8; + unsigned char data[REMOTE_MEMORY_PACKET_DATA]; +}; + +#define REMOTE_MEMORY_PACKET_HEADER 10 + +struct rm_aligned_pkt { + unsigned char rm_id[4]; + unsigned char rm_operand[3]; + int rm_opcode:8; + unsigned char data[REMOTE_MEMORY_PACKET_DATA]; +}; + +#define REMOTE_MEMORY_ALIGNED_PACKET_HEADER 8 + +static int spy = -1; +static int send_trap = 0; +static pthread_key_t mainThread; + +static pthread_mutex_t spyLock; +static boolean spyLockSetup = FALSE; +static pthread_t spyThread; +static boolean spyThreadSetup = FALSE; +EmbMBINChannel *activeMBINChannel = NULL; +static struct {unsigned int id; boolean acked;} MBINHistory[16]; + +/* Divine a port number to use. Try to use 2900 + xxx where xxx is 128.81.41.xxx, + if we're coming in from SLIP or something we're on a different subnet, so we fudge. */ + +static int divine_port_number(unsigned long diagnosticAddress) +{ + unsigned long port; + + port = htonl (diagnosticAddress) - 0x80512900; /* 128.81.41.00 */ + if (port < 0) port = -port; + if (port > 256) port = port % 256 + 256; else port = port % 256; + port += 2900; + return port; +} + +static void bind_a_port(int spy,struct sockaddr_in * sin,int len) +{ + if (bind(spy, (struct sockaddr*)sin, len)) { + verror ("spy", NULL); + sin->sin_port = htons(ntohs(sin->sin_port) + 1); + bind_a_port(spy,sin,len); + } + else vwarn (NULL, "Spy started on port %d.", ntohs(sin->sin_port)); +} + +/* static void signal_handler (int x) */ +/* { */ +/* HaltMachine(); */ +/* } */ + +static int spy_transmit (struct rm_pkt *pkt, int rm_length, struct sockaddr_in *sin) +{ + int result = 0; + pthread_cleanup_push((pthread_cleanuproutine_t)pthread_mutex_unlock, (void*)&spyLock); + if (pthread_mutex_lock (&spyLock)) + vpunt ("spy", "Unable to lock the spy lock in thread %x", pthread_self ()); + if (sendto(spy, &pkt->rm_pad[0], rm_length, 0, (struct sockaddr*)sin, sizeof(struct sockaddr_in)) < 0) + { + verror ("spy", NULL); + result = 1; + } + if (pthread_mutex_unlock (&spyLock)) + vpunt ("spy", "Unable to unlock the spy lock in thread %x", pthread_self ()); + pthread_cleanup_pop(FALSE); + return(result); +} + +static unsigned int read_long (unsigned char *bytes) +{ + return (bytes[0] | (bytes[1]<<8) | (bytes[2]<<16) | (bytes[3]<<24)); +} + +static void write_long (unsigned char *bytes, unsigned int data) +{ + bytes[0] = data; + bytes[1] = data>>8; + bytes[2] = data>>16; + bytes[3] = data>>24; +} + +static struct sockaddr_in trap_sin; +static boolean trap_sinValid = FALSE; +static struct sockaddr_in mbin_sin; +static boolean mbin_sinValid = FALSE; +static jmp_buf trap_environment; + +/* Catch SEGV's when poking at memory */ +static void segv_handler (int number) +{ + _longjmp(trap_environment, -1); +} + +static void SpyTopLevel (pthread_addr_t argument) +{ + pthread_t self = pthread_self (); + + pthread_cleanup_push ((pthread_cleanuproutine_t)pthread_detach, (void*)self); + if (pthread_mutex_lock (&spyLock)) + vpunt ("spy", "Unable to lock the spy lock in thread %x", self); + if (pthread_mutex_unlock (&spyLock)) + vpunt ("spy", "Unable to unlock the spy lock in thread %x", self); + + RemoteMemorySpyLoop (); /* Returns iff the spy port has closed */ + + pthread_cleanup_pop (TRUE); +} + +#define SuspendVLM() if(Runningp()){forciblyHalted = TRUE; HaltMachine(); while (Runningp());} +#define ResumeVLM(resumeP) if(forciblyHalted){forciblyHalted = FALSE; StartMachine(resumeP);} + +void RemoteMemorySpyLoop () +{ + struct rm_pkt pkt, reply; + LispObj buffer[PageSize]; + LispObj *bufferp; + unsigned char *p; + unsigned int vma, operand; + int nwords, nchunks, i, pkt_length, reply_length, sinlen; + int booted = 0; + struct sockaddr_in pkt_source; + struct pollfd pollSpy; + boolean forciblyHalted = FALSE; + + pollSpy.fd = spy; + pollSpy.events = POLLIN; + + while (1) + { + pthread_testcancel(); + + if (!Runningp()) { + if (send_trap) { + PushOneFakeFrame(); + PushOneFakeFrame(); + /* this does "remote system halted" */ + if (trap_sinValid) { + reply.rm_opcode = rm_trap; + spy_transmit(&reply, REMOTE_MEMORY_PACKET_HEADER, &trap_sin); + } + send_trap = 0; + } + } + + if (0 == (i = poll(&pollSpy, 1, 1000))) + continue; + else if (i < 0) + vpunt ("spy", "Waiting for a packet from the remote debugger"); + else if (pollSpy.revents & (POLLHUP | POLLNVAL)) + /* Spy port has vanished -- Assume that the emulator is shutting down ... */ + break; + + sinlen = sizeof(struct sockaddr_in); + if ((pkt_length = recvfrom(spy, &pkt.rm_pad[0], REMOTE_MEMORY_PACKET_HEADER + REMOTE_MEMORY_PACKET_DATA, 0, (struct sockaddr*)&pkt_source, (socklen_t *)&sinlen)) < 0) + vpunt ("spy", "Reading packet from remote debugger"); + + reply.rm_operand[0] = 0; + reply.rm_operand[1] = 0; + reply.rm_operand[2] = 0; + reply_length = REMOTE_MEMORY_PACKET_HEADER; + reply.rm_opcode = rm_ack; + memcpy(&reply.rm_id[0], &pkt.rm_id[0], 4); + + operand = read_long(&pkt.rm_operand[0]) & 0xffffff; + + switch (pkt.rm_opcode) + { + case rm_boot: + SuspendVLM (); + spy_transmit(&reply, reply_length, &pkt_source); + InitializeIvoryProcessor(MapVirtualAddressData (0), MapVirtualAddressTag (0)); + booted = 1; + ResumeVLM (TRUE); + break; + + case rm_create_pages: + SuspendVLM (); + vma = read_long(&pkt.data[0]); + nwords = read_long(&pkt.data[4]); + EnsureVirtualAddressRange(vma, nwords, FALSE); + spy_transmit(&reply, reply_length, &pkt_source); + ResumeVLM (TRUE); + break; + + case rm_noop: + spy_transmit(&reply, reply_length, &pkt_source); + break; + + case rm_read: + SuspendVLM (); + vma = read_long(&pkt.data[0]); + nwords = operand & 0x3ff; + nchunks = (nwords+3)/4; + switch ((operand>>10) & 3) + { + case rm_physical: +#ifdef _C_EMULATOR_ + goto READ_WRITE_MEMORY_ERROR; +#else + /* Use physical addresses to read uncached data */ + { + void (*old_segv_handler) () = signal(SIGSEGV, segv_handler); + if (_setjmp(trap_environment)) { + signal(SIGSEGV, old_segv_handler); + goto READ_WRITE_MEMORY_ERROR; + } + for (i = 0; i < nwords; i++) { + if (!CreatedP(vma+i)) goto READ_WRITE_MEMORY_ERROR; /* KLUDGE! */ + buffer[i] = (VirtualMemoryReadUncached(vma + i)); + } + signal(SIGSEGV, old_segv_handler); + } + break; +#endif + + case rm_virtual: + { + void (*old_segv_handler) () = signal(SIGSEGV, segv_handler); + if (_setjmp(trap_environment)) { + signal(SIGSEGV, old_segv_handler); + goto READ_WRITE_MEMORY_ERROR; + } + for (i = 0; i < nwords; i++) { +#ifdef _C_EMULATOR_ + if (ReadVirtualMemory (vma+i, &buffer[i])) goto read_error; +#else + if (!CreatedP(vma+i)) goto READ_WRITE_MEMORY_ERROR; /* KLUDGE! */ + buffer[i] = (VirtualMemoryRead(vma + i)); +#endif + } + signal(SIGSEGV, old_segv_handler); + } + break; + + case rm_register: + for (i = 0; i < nwords; i++) { +#ifdef _C_EMULATOR_ + ReadInternalRegister (vma+i, &buffer[i]); +#else + buffer[i] = ReadInternalRegister(vma + i); +#endif + } + break; + + case rm_coprocessor: + for (i = 0; i < nwords; i++) { +#ifdef _C_EMULATOR_ + vwarn ("spy", "Read of coprocessor register %d failed.", (vma + i)); +#else + buffer[i] = CoprocessorRead(vma + i); +#endif + } + break; + } + for (i = 0, bufferp = &buffer[0], p = &reply.data[0]; + i < nchunks; + i++, bufferp += 4, p += 20) + { + p[0] = LispObjTag(bufferp[0]); + p[1] = LispObjTag(bufferp[1]); + p[2] = LispObjTag(bufferp[2]); + p[3] = LispObjTag(bufferp[3]); + write_long(&p[4], LispObjData(bufferp[0])); + write_long(&p[8], LispObjData(bufferp[1])); + write_long(&p[12], LispObjData(bufferp[2])); + write_long(&p[16], LispObjData(bufferp[3])); + } + reply_length += nchunks*20; + spy_transmit(&reply, reply_length, &pkt_source); + ResumeVLM (TRUE); + break; + +READ_WRITE_MEMORY_ERROR: + reply.rm_operand[0] = 1; + spy_transmit(&reply, reply_length, &pkt_source); + ResumeVLM (rm_read == pkt.rm_opcode); + break; + + case rm_stop: + forciblyHalted = FALSE; + HaltMachine(); + spy_transmit(&reply, reply_length, &pkt_source); + break; + + case rm_system_startup: + spy_transmit(&reply, reply_length, &pkt_source); + memcpy(&trap_sin, &pkt_source, sizeof(struct sockaddr_in)); + trap_sinValid = TRUE; + memcpy (&mbin_sin, &pkt_source, sizeof(struct sockaddr_in)); + mbin_sinValid = TRUE; + if (!IvoryProcessorSystemStartup (booted)) + vwarn ("spy", "Bad start routine."); + send_trap = 1; + break; + + case rm_write: + SuspendVLM (); + vma = read_long(&pkt.data[0]); + nwords = operand & 0x3ff; + nchunks = (nwords+3)/4; + for (i = 0, bufferp = &buffer[0], p = &pkt.data[4]; + i < nchunks; + i++, bufferp += 4, p += 20) + { + LispObjTag(bufferp[0]) = p[0]; + LispObjTag(bufferp[1]) = p[1]; + LispObjTag(bufferp[2]) = p[2]; + LispObjTag(bufferp[3]) = p[3]; + LispObjData(bufferp[0]) = read_long(&p[4]); + LispObjData(bufferp[1]) = read_long(&p[8]); + LispObjData(bufferp[2]) = read_long(&p[12]); + LispObjData(bufferp[3]) = read_long(&p[16]); + } + switch ((operand>>10) & 3) + { + case rm_physical: + goto READ_WRITE_MEMORY_ERROR; + + case rm_virtual: + { + void (*old_segv_handler) () = signal(SIGSEGV, segv_handler); + if (_setjmp(trap_environment)) { + signal(SIGSEGV, old_segv_handler); + goto READ_WRITE_MEMORY_ERROR; + } + for (i = 0; i < nwords; i++) { +#ifdef _C_EMULATOR_ + if (WriteVirtualMemory (vma+i, &buffer[i])) goto read_error; +#else + if (!CreatedP(vma+i)) goto READ_WRITE_MEMORY_ERROR; /* KLUDGE! */ + VirtualMemoryWrite(vma + i, buffer[i]); +#endif + } + signal(SIGSEGV, old_segv_handler); + } + break; + + case rm_register: + for (i = 0; i < nwords; i++) { +#ifdef _C_EMULATOR_ + if (!WriteInternalRegister(vma + i,&buffer[i])) + vwarn ("spy", "Write of internal register %d failed", vma + i); +#else + if (WriteInternalRegister(vma + i,buffer[i])==-1) + vwarn ("spy", "Write of internal register %d failed", vma + i); +#endif + } + break; + + case rm_coprocessor: + for (i = 0; i < nwords; i++) { +#ifdef _C_EMULATOR_ + vwarn ("spy", "Write of coprocessor register %d failed.", (vma + i)); +#else + if (!CoprocessorWrite(vma + i, buffer[i])) + vwarn ("spy", "Write of coprocessor register %d failed.", (vma + i)); +#endif + } + break; + }; + spy_transmit(&reply, reply_length, &pkt_source); + ResumeVLM (FALSE); + break; + + case rm_mbin: + { + EmbPtr bufferEmbPtr; + struct rm_aligned_pkt *buffer; + unsigned int id; + int historyID; + memcpy (&mbin_sin, &pkt_source, sizeof(struct sockaddr_in)); + mbin_sinValid = TRUE; + if (activeMBINChannel) { + id = read_long(&pkt.rm_id[0]); + historyID = id & 0xF; + if (MBINHistory[historyID].id == id) { + /* ... */ + if (MBINHistory[historyID].acked) + spy_transmit(&reply, reply_length, &pkt_source); + } + else if (EmbQueueFilled (activeMBINChannel->hostToGuestSupplyQueue) + && EmbQueueSpace (activeMBINChannel->hostToGuestQueue)) { + /* ... */ + bufferEmbPtr = EmbQueueTakeWord (activeMBINChannel->hostToGuestSupplyQueue); + if (bufferEmbPtr && (bufferEmbPtr != NullEmbPtr)) { + buffer = (struct rm_aligned_pkt*) HostPointer (bufferEmbPtr); + memcpy (&buffer->rm_id[0],&pkt.rm_id[0],REMOTE_MEMORY_ALIGNED_PACKET_HEADER); + memcpy (&buffer->data[0], &pkt.data[0], operand); + EmbQueuePutWord (activeMBINChannel->hostToGuestQueue, bufferEmbPtr); + MBINHistory[historyID].id = id; + MBINHistory[historyID].acked = FALSE; + } + } + } + } + break; + + case rm_discard: + break; + } + } +} + + +/* External Interfaces */ + +void InitializeSpy (boolean sendTrapP, unsigned long diagnosticAddress) +{ + struct sockaddr_in sin; + int ipport_remote_memory; + + if (pthread_key_create (&mainThread, NULL)) + vpunt (NULL, "Unable to establish per-thread data."); + pthread_setspecific (mainThread, (void*) TRUE); + + atexit (&TerminateSpy); + + ipport_remote_memory = divine_port_number(diagnosticAddress); + + if ((spy = socket(AF_INET, SOCK_DGRAM, 0)) < 0) + vpunt ("spy", "Unable to create spy socket"); + sin.sin_family = AF_INET; + sin.sin_addr.s_addr = INADDR_ANY; + sin.sin_port = htons(ipport_remote_memory); + bind_a_port(spy,&sin,sizeof(sin)); + send_trap = sendTrapP; + + memset ((char*)&MBINHistory[0], 0, sizeof (MBINHistory)); + + if (pthread_mutex_init (&spyLock, NULL)) + vpunt ("spy", "Unable to create the spy lock"); + spyLockSetup = TRUE; + + if (pthread_create (&spyThread, + &EmbCommAreaPtr->pollThreadAttrs, (pthread_startroutine_t)&SpyTopLevel, + NULL)) + vpunt ("spy", "Unable to create the spy thread"); + spyThreadSetup = TRUE; + + return; +} + +void ReleaseSpyLock () +{ + if (pthread_mutex_unlock (&spyLock)) + vpunt ("spy", "Unable to unlock the spy lock in thread %x", pthread_self ()); +} + +void SendMBINBuffers (EmbMBINChannel* mbinChannel) +{ + register EmbQueue *gthQ = mbinChannel->guestToHostQueue; + register EmbQueue *gthrQ = mbinChannel->guestToHostReturnQueue; + EmbPtr bufferPtr; + struct rm_aligned_pkt *buffer; + struct rm_pkt pkt; + unsigned int nBytes, id; + int historyID; + + if (mbinChannel->header.messageChannel->guestToHostImpulse) + switch (mbinChannel->header.messageChannel->guestToHostImpulse) + { + case EmbMBINImpulseShutdown: + activeMBINChannel = NULL; + ResetIncomingQueue (gthQ); + ResetOutgoingQueue (gthrQ); + ResetIncomingQueue (mbinChannel->hostToGuestSupplyQueue); + ResetOutgoingQueue (mbinChannel->hostToGuestQueue); + mbinChannel->header.messageChannel->guestToHostImpulse = EmbMessageImpulseNone; + UnthreadMessageChannel (mbinChannel->header.messageChannel); + free (mbinChannel); + return; + default: + mbinChannel->header.messageChannel->guestToHostImpulse = EmbMessageImpulseNone; + break; + } + + while (EmbQueueFilled (gthQ)) { + if (0 == EmbQueueSpace (gthrQ)) { + SignalLater (gthQ->signal); + return; + } + bufferPtr = EmbQueueTakeWord (gthQ); + if (bufferPtr && (bufferPtr != NullEmbPtr) && mbin_sinValid) { + buffer = (struct rm_aligned_pkt*) HostPointer (bufferPtr); + nBytes = read_long(&buffer->rm_operand[0]) & 0xFFFFFF; + memcpy (&pkt.rm_id[0], &buffer->rm_id[0], REMOTE_MEMORY_ALIGNED_PACKET_HEADER); + memcpy (&pkt.data[0], &buffer->data[0], nBytes); + if (rm_ack == buffer->rm_opcode) { + id = read_long(&buffer->rm_id[0]); + historyID = id & 0xF; + MBINHistory[historyID].id = id; + MBINHistory[historyID].acked = TRUE; + } + spy_transmit(&pkt, REMOTE_MEMORY_PACKET_HEADER + nBytes, &mbin_sin); + } + EmbQueuePutWord (gthrQ, bufferPtr); + } +} + +void TerminateSpy () +{ + struct timespec killSleep; + void *exit_code; + + if (NULL == pthread_getspecific (mainThread)) return; + + if (spyThreadSetup) { + pthread_cancel (spyThread); + killSleep.tv_sec = 1; + killSleep.tv_nsec = 250000000; + pthread_delay_np (&killSleep); + pthread_join (spyThread, &exit_code); + spyThreadSetup = FALSE; + } + if (spyLockSetup) { + pthread_mutex_destroy (&spyLock); + spyLockSetup = FALSE; + } + if (spy != -1) { + close(spy); + spy = -1; + } +} diff --git a/src/utilities.c b/src/utilities.c new file mode 100644 index 0000000..690be53 --- /dev/null +++ b/src/utilities.c @@ -0,0 +1,1064 @@ +/* Miscellaneous utility routines */ + +#include "std.h" + +#include +#include +#include +#include +#include +#include +#include + +#include +#include + +#include "VLM_configuration.h" +#include "life_types.h" +#include "ivoryrep.h" +#include "chaos.h" + +#if defined(GENERA) +static char* CommandName = "genera"; +#define CommandClass "Genera" + +#elif defined(MINIMA) +static char* CommandName = "minima"; +#define CommandClass "Minima" + +#elif defined(IVERIFY) +static char* CommandName = "iverify"; +#define CommandClass "IVerify" +#endif + + +/* Internal function prototypes */ + +static boolean GetOption (XrmDatabase options, char* name, char* class, char* value); +static boolean GetXOption (XrmDatabase options, char* windowName, char* windowClass, + char* name, char* class, char* value); +static void GetDefaultConfiguration (VLMConfig* config, XrmDatabase* options); +static void InterpretNetworkOptions (VLMConfig* config, XrmDatabase options); +static void InterpretOptions (VLMConfig* config, XrmDatabase options); +static void InterpretXOptions (XrmDatabase options, XParams* xParams, + char* windowEnglishName, char* windowName, + char* windowClass); +static void MaybeReadConfigurationFile (VLMConfig* config, XrmDatabase* options, + char* pathname); +static char* MergeSearchPaths (char* newSearchPath, char* oldSearchPath); +static int PrintMessage (char* section, char* format, va_list arguments); +static void ProcessCommandArguments (VLMConfig* config, XrmDatabase* options, + int argc, char** argv); +static boolean VerifyHostName (char* name, char** hostName, unsigned long* hostAddress, + boolean rejectLocalHost); + + +/* Guts of the following message printing functions */ + +static int PrintMessage (char* section, char* format, va_list arguments) +{ + char name[128]; + + if (NULL == section) + sprintf (name, "%s: ", CommandName); + else + sprintf (name, "%s (%s): ", CommandName, section); + + fprintf (stderr, "%s", name); + + if (format != NULL) + { + vfprintf (stderr, format, arguments); + fprintf (stderr, "\n"); + } + + return (strlen (name)); +} + + +/* Print an error message and terminate the VLM */ + +void vpunt (char* section, char* format, ...) +{ + va_list ap; + char *errmsg; + int prefixLength; + + va_start (ap, format); + + prefixLength = PrintMessage (section, format, ap); + + if (errno) + { + errmsg = strerror (errno); + if (NULL == format) + fprintf (stderr, "%s\n", errmsg); + else + fprintf (stderr, "%*s%s\n", prefixLength, "", errmsg); + } + + va_end (ap); + +// MaybePrintTrace (); + +//while (1); + exit (EXIT_FAILURE); +} + + +/* Print an error message */ + +void verror (char* section, char* format, ...) +{ + va_list ap; + char *errmsg; + int prefixLength; + + va_start (ap, format); + + prefixLength = PrintMessage (section, format, ap); + + if (errno) + { + errmsg = strerror (errno); + if (NULL == format) + fprintf (stderr, "%s\n", errmsg); + else + fprintf (stderr, "%*s%s\n", prefixLength, "", errmsg); + } + + va_end (ap); +} + + +/* Print a warning */ + +void vwarn (char* section, char* format, ...) +{ + va_list ap; + + va_start (ap, format); + + PrintMessage (section, format, ap); + + va_end (ap); +} + + +/* Change the command name used by vpunt and vwarn */ + +void SetCommandName (char* newCommandName) +{ +#if defined(OS_OSF) || defined(__FreeBSD__) + CommandName = strdup (newCommandName); +#else + CommandName = strndup (newCommandName, 32); +#endif +} + + +/* Creates an X display name string in the supplied buffer */ + +void BuildXDisplayName (char* displayName, char* hostName, int display, int screen) +{ + sprintf (displayName, "%s", hostName == NULL ? "" : hostName); + + if (display != -1 || screen != -1) + { + sprintf (displayName, "%s:", displayName); + if (display != -1) + sprintf (displayName, "%s%d", displayName, display); + if (screen != -1) + sprintf (displayName, "%s.%d", displayName, screen); + } +} + + + +/* Determine the VLM configuration */ + +void BuildConfiguration (VLMConfig* config, int argc, char** argv) +{ + XrmDatabase options = NULL; + char *homeDir, workingDir[_POSIX_PATH_MAX+1], configFile[_POSIX_PATH_MAX+1]; + + XrmInitialize (); + + GetDefaultConfiguration (config, &options); + + MaybeReadConfigurationFile (config, &options, DefaultVLMConfigFilePathname); + + if ((homeDir = getenv ("HOME")) != NULL) + { + sprintf (configFile, "%s/.VLM", homeDir); + MaybeReadConfigurationFile (config, &options, configFile); + } + + if (getcwd (workingDir, sizeof (workingDir))) + { + sprintf (configFile, "%s/.VLM", workingDir); + MaybeReadConfigurationFile (config, &options, configFile); + } + + ProcessCommandArguments (config, &options, argc, argv); + + InterpretOptions (config, options); +} + + +/* Fill in the default options for the VLM */ + +static void GetDefaultConfiguration (VLMConfig* config, XrmDatabase* options) +{ + char *display, *worldSearchPath; + int i; + + XrmPutStringResource (options, "*spy", "no"); + + XrmPutStringResource (options, "*trace", "no"); + XrmPutStringResource (options, "*tracePOST", "no"); + + XrmPutStringResource (options, "*testfunction", "no"); + + config->commAreaSize = DefaultEmbCommAreaSize; + config->hostBufferSpace = DefaultHostBufferSpace; + config->guestBufferSpace = DefaultGuestBufferSpace; + + XrmPutStringResource (options, "*debugger", DefaultVLMDebuggerPathname); + + for (i = 0; i < MaxNetworkInterfaces; i++) + { + config->interfaces[i].present = FALSE; + } + + XrmPutStringResource (options, "genera.world", DefaultGeneraWorldPathname); + XrmPutStringResource (options, "minima.world", DefaultMinimaWorldPathname); + + if ((worldSearchPath = getenv ("WORLDPATH")) != NULL) + XrmPutStringResource (options, "genera.worldSearchPath", + MergeSearchPaths (worldSearchPath, DefaultWorldSearchPath)); + else + XrmPutStringResource (options, "genera.worldSearchPath", DefaultWorldSearchPath); + + XrmPutStringResource (options, "genera.enableIDS", "no"); + XrmPutStringResource (options, "genera.virtualMemory", DefaultVirtualMemory); + + if ((display = getenv ("DISPLAY")) != NULL) + XrmPutStringResource (options, "*display", display); + else + XrmPutStringResource (options, "*display", ":0.0"); + + XrmPutStringResource (options, "*coldLoad.iconic", "yes"); + +} + + +/* Read a .VLM file in the specified directory if it exists */ + +static void MaybeReadConfigurationFile (VLMConfig* config, XrmDatabase* options, + char* pathname) +{ + XrmDatabase fileOptions; + char newSearchPath[_POSIX_ARG_MAX], oldSearchPath[_POSIX_ARG_MAX], *mergedSearchPath, + searchPathOption[128]; + int fd; + + fd = open (pathname, O_RDONLY); + if (-1 == fd) { + if (ENOENT == errno) + { + errno = ESUCCESS; + return; + } + else + vpunt (NULL, "Unable to verify existence of configuration file %s", pathname); + } + close (fd); + + fileOptions = XrmGetFileDatabase (pathname); + if (NULL == fileOptions) + vpunt (NULL, "Unable to parse configuration file %s", pathname); + +#ifdef GENERA + if (GetOption (fileOptions, "worldSearchPath", "WorldSearchPath", newSearchPath)) + { + GetOption (*options, "worldSearchPath", "WorldSearchPath", oldSearchPath); + mergedSearchPath = MergeSearchPaths (newSearchPath, oldSearchPath); + sprintf (searchPathOption, "%s.worldSearchPath", CommandName); + XrmPutStringResource (&fileOptions, searchPathOption, mergedSearchPath); + } +#endif + + XrmMergeDatabases (fileOptions, options); +} + + +/* The command line arguments to a VLM command */ + +#if defined(GENERA) +#define BaseOptions 33 + +#elif defined(MINIMA) +#define BaseOptions 5 + +#elif defined(IVERIFY) +#define BaseOptions 3 +#endif + +#ifdef TRACING +#define TracingOptions 2 +#else +#define TracingOptions 0 +#endif + +#define OptionsTableSize BaseOptions+TracingOptions + +static XrmOptionDescRec OptionsTable[OptionsTableSize] = { + {"-spy", ".spy", XrmoptionSepArg, NULL}, + {"-diagnostic", ".diagnosticHost", XrmoptionSepArg, NULL}, + {"-testfunction", ".testfunction", XrmoptionSepArg, NULL}, +#ifndef IVERIFY + {"-world", ".world", XrmoptionSepArg, NULL}, + {"-network", ".network", XrmoptionSepArg, NULL}, +#endif +#ifdef GENERA + {"-debugger", ".debugger", XrmoptionSepArg, NULL}, + {"-ids", ".enableIDS", XrmoptionSepArg, NULL}, + {"-vm", ".virtualMemory", XrmoptionSepArg, NULL}, + {"-display", ".main.display", XrmoptionSepArg, NULL}, + {"-geometry", ".main.geometry", XrmoptionSepArg, NULL}, + {"-iconic", ".main.iconic", XrmoptionSepArg, NULL}, + {"-foreground", ".main.foreground", XrmoptionSepArg, NULL}, + {"-fg", ".main.foreground", XrmoptionSepArg, NULL}, + {"-background", ".main.background", XrmoptionSepArg, NULL}, + {"-bg", ".main.background", XrmoptionSepArg, NULL}, + {"-bordercolor", ".main.borderColor", XrmoptionSepArg, NULL}, + {"-bd", ".main.borderColor", XrmoptionSepArg, NULL}, + {"-borderwidth", ".main.borderWidth", XrmoptionSepArg, NULL}, + {"-bw", ".main.borderWidth", XrmoptionSepArg, NULL}, + {"-coldloaddisplay", ".coldLoad.display", XrmoptionSepArg, NULL}, + {"-cld", ".coldLoad.display", XrmoptionSepArg, NULL}, + {"-coldloadgeometry", ".coldLoad.geometry", XrmoptionSepArg, NULL}, + {"-clg", ".coldLoad.geometry", XrmoptionSepArg, NULL}, + {"-coldloadiconic", ".coldLoad.iconic", XrmoptionSepArg, NULL}, + {"-cli", ".coldLoad.iconic", XrmoptionSepArg, NULL}, + {"-coldloadforeground", ".coldLoad.foreground", XrmoptionSepArg, NULL}, + {"-clfg", ".coldLoad.foreground", XrmoptionSepArg, NULL}, + {"-coldloadbackground", ".coldLoad.background", XrmoptionSepArg, NULL}, + {"-clbg", ".coldLoad.background", XrmoptionSepArg, NULL}, + {"-coldloadbordercolor", ".coldLoad.borderColor", XrmoptionSepArg, NULL}, + {"-clbd", ".coldLoad.borderColor", XrmoptionSepArg, NULL}, + {"-coldloadborderwidth", ".coldLoad.borderWidth", XrmoptionSepArg, NULL}, + {"-clbw", ".coldLoad.borderWidth", XrmoptionSepArg, NULL}, +#endif +#ifdef TRACING + {"-trace", ".trace", XrmoptionSepArg, NULL}, + {"-tracePOST", ".tracePOST", XrmoptionSepArg, NULL}, +#endif +}; + + +/* Parse the command line arguments */ + +static void ProcessCommandArguments (VLMConfig* config, XrmDatabase* options, + int argc, char** argv) +{ + char oldSearchPath[_POSIX_ARG_MAX], *mergedSearchPath, searchPathOption[128]; + int argLength; + + XrmParseCommand (options, OptionsTable, OptionsTableSize, CommandName, &argc, argv); + + /* Any leftover arguments must be "-searchpath PATH" */ + + while (argc > 1) + { + argv++; + argc--; + +#ifdef GENERA + argLength = strlen (*argv); + if (0 == strncmp (*argv, "-searchpath", (argLength < 7) ? 7 : argLength)) + { + if (argc > 1) + { + argv++; + argc--; + GetOption (*options, "worldSearchPath", "WorldSearchPath", oldSearchPath); + mergedSearchPath = MergeSearchPaths (*argv, oldSearchPath); + sprintf (searchPathOption, "%s.worldSearchPath", CommandName); + XrmPutStringResource (options, searchPathOption, mergedSearchPath); + } + else + vpunt (NULL, "A list of directory pathnames must follow -searchpath"); + } + + else +#endif + vpunt (NULL, "Unrecognized option %s", *argv); + } +} + + +/* Convert the options found above from strings into our internal representations */ + +static void InterpretOptions (VLMConfig* config, XrmDatabase options) +{ + NetworkInterface *interface; + char value[_POSIX_ARG_MAX], *hostName, *end; + unsigned long hostAddress, datum; + int i; + + GetOption (options, "spy", "Spy", value); + if (0 == strcmp (value, "yes")) + config->enableSpy = TRUE; + else if (0 == strcmp (value, "no")) + config->enableSpy = FALSE; + else + vpunt (NULL, "Value of spy parameter, %s, is invalid", value); + + GetOption (options, "testfunction", "TestFunction", value); + if (0 == strcmp (value, "yes")) + config->testFunction = TRUE; + else if (0 == strcmp (value, "no")) + config->testFunction = FALSE; + else + vpunt (NULL, "Value of testfunction parameter, %s, is invalid", value); + +#ifndef TRACING + config->tracing.traceP = FALSE; + config->tracing.tracePOST = FALSE; +#endif + +#ifdef TRACING + config->tracing.bufferSize = 25000; + config->tracing.startPC = 0; + config->tracing.stopPC = 0; + config->tracing.outputFile = NULL; + + GetOption (options, "trace", "Trace", value); + + if (0 == strcmp (value, "yes")) + config->tracing.traceP = TRUE; + + else if (0 == strcmp (value, "no")) + config->tracing.traceP = FALSE; + + else + { + config->tracing.traceP = TRUE; + start = value; + datum = strtoul (start, &end, 10); + if (start != end) + config->tracing.bufferSize = datum; + else + { + if (*end == '[') + { + end2 = strrchr (start, ']'); + if (end2) + { + *end2 = '\0'; +#if defined(OS_OSF) || defined(__FreeBSD__) + config->tracing.outputFile = strdup (start + 1); +#else + config->tracing.outputFile = strndup (start + 1, _POSIX_PATH_MAX + 1); +#endif + *end2 = ']'; + end = end2 + 1; + } + else + vpunt (NULL, "Value of trace parameter, %s, is invalid", value); + } + } + if (*end) + { + if (*end == ',') + { + start = end + 1; + datum = strtoul (start, &end, 0); + if (start != end) + config->tracing.startPC = datum; + if (*end) + { + if (*end == ',') + { + start = end + 1; + datum = strtoul (start, &end, 0); + if (start != end) + config->tracing.stopPC = datum; + if (*end) + vpunt (NULL, "Value of trace parameter, %s, is invalid", value); + } + else + vpunt (NULL, "Value of trace parameter, %s, is invalid", value); + } + } + else + vpunt (NULL, "Value of trace parameter, %s, is invalid", value); + } + } + + GetOption (options, "tracePOST", "TracePOST", value); + + if (0 == strcmp (value, "yes")) + config->tracing.tracePOST = TRUE; + + else if (0 == strcmp (value, "no")) + config->tracing.tracePOST = FALSE; + + else + vpunt (NULL, "Value of tracePOST parameter, %s, is invalid", value); +#endif + +#ifndef IVERIFY + GetOption (options, "world", "World", value); + strcpy (config->worldPath, value); + + InterpretNetworkOptions (config, options); + +#ifdef GENERA + GetOption (options, "debugger", "Debugger", value); + strcpy (config->vlmDebuggerPath, value); + + GetOption (options, "enableIDS", "EnableIDS", value); + if (0 == strcmp (value, "yes")) + config->enableIDS = TRUE; + else if (0 == strcmp (value, "no")) + config->enableIDS = FALSE; + else + vpunt (NULL, "Value of enable IDS parameter, %s, is invalid", value); + + GetOption (options, "virtualMemory", "VirtualMemory", value); + datum = strtoul (value, &end, 10); + if (*end) + vpunt (NULL, "Value of virtual memory size parameter, %s, is invalid", value); + if (datum < MinimumVirtualMemory) + vpunt (NULL, "Minimum virtual memory size is %d megabytes", MinimumVirtualMemory); + config->virtualMemory = datum; + + GetOption (options, "worldSearchPath", "WorldSearchPath", value); + config->worldSearchPath = strdup (value); + + InterpretXOptions (options, &config->generaXParams, "main X console", "main", "Main"); + InterpretXOptions (options, &config->coldLoadXParams, "cold load", "coldLoad", "ColdLoad"); +#endif +#endif + +#ifndef MINIMA + if (config->enableSpy) +#endif + { + if (GetOption (options, "diagnosticHost", "DiagnosticHost", value)) + { + if (VerifyHostName (value, &hostName, &hostAddress, FALSE)) + memcpy ((char*)&config->diagnosticIPAddress.s_addr, (char*)&hostAddress, + sizeof (config->diagnosticIPAddress.s_addr)); + else + vpunt (NULL, "Unknown diagnostic host %s", value); + } + else +#ifdef MINIMA + vpunt (NULL, "You must specify a diagnostic host."); +#else + { + config->diagnosticIPAddress.s_addr = 0; + for (i = 0; + (i < MaxNetworkInterfaces) && (0 == config->diagnosticIPAddress.s_addr); + i++) + { + interface = &config->interfaces[i]; + while ((interface != NULL) && interface->present) + { + if (ETHERTYPE_IP == interface->myProtocol) + { + config->diagnosticIPAddress.s_addr = htonl (interface->myAddress.s_addr); + break; + } +#ifdef GENERA + interface = interface->anotherAddress; +#else + interface = NULL; +#endif + } + } + + if (0 == config->diagnosticIPAddress.s_addr) + vpunt (NULL, "You must specify a diagnostic host to use the spy."); + } +#endif + } +} + + +/* Convert the network interfaces specification into one or more interface definitions */ + +static void InterpretNetworkOptions (VLMConfig* config, XrmDatabase options) +{ + NetworkInterface *mainInterface, *interface, *ointerface = NULL; + char buffer[_POSIX_ARG_MAX], *value, *deviceName, *hostName, + *commaPosition, *colonPosition, *semicolonPosition, *end; + unsigned long hostAddress; + int i; + + if (!GetOption (options, "network", "Network", buffer)) + vpunt (NULL, "At least one network interface must be defined"); + + value = &buffer[0]; + + while ((value != NULL) && *value) + { + commaPosition = strchr (value, ','); + if (commaPosition != NULL) + *commaPosition = 0; + + colonPosition = strchr (value, ':'); + semicolonPosition = strchr (value, ';'); + + if ((colonPosition != NULL) && (semicolonPosition != NULL) && + (semicolonPosition < colonPosition)) + vpunt (NULL, "Invalid syntax in specification of network interface: %s", value); + + if (colonPosition != NULL) + { + *colonPosition = 0; + deviceName = strdup (value); + value = colonPosition + 1; + } + else + deviceName = ""; + + interface = NULL; + for (i = 0; i < MaxNetworkInterfaces; i++) + if (config->interfaces[i].present) + if (0 == strcmp (deviceName, config->interfaces[i].device)) + { + mainInterface = &config->interfaces[i]; + interface = mainInterface; +#ifndef GENERA + vpunt (NULL, "Only one network address per interface is supported"); +#else + if (!interface->haveMac) { + while (interface->anotherAddress != NULL) + interface = interface->anotherAddress; + ointerface = interface; + interface->anotherAddress = malloc (sizeof (NetworkInterface)); + if (NULL == interface->anotherAddress) + vpunt (NULL, + "Unable to allocate space for an additional network address"); + memset(interface->anotherAddress, + 0, + sizeof(NetworkInterface)); + interface = interface->anotherAddress; + } +#endif + break; + } + else; + else + { + interface = mainInterface = &config->interfaces[i]; + break; + } + + if (NULL == interface) + { + if (commaPosition != NULL) *commaPosition = ','; + if (colonPosition != NULL) *colonPosition = ':'; + if (semicolonPosition != NULL) *semicolonPosition = ';'; + vpunt (NULL, "Too many distinct network interfaces in %s", buffer); + } + + strcpy (interface->device, deviceName); + + if (semicolonPosition != NULL) + *semicolonPosition = 0; + + if ((0 == strncasecmp (value, "MAC|", strlen ("MAC|")))) + { + struct mac_addr mac; + char c; + + value += strlen ("MAC|"); + if (6 != sscanf(value, + "%hhx:%hhx:%hhx:%hhx:%hhx:%hhx%c", + &mac.bytes[0], + &mac.bytes[1], + &mac.bytes[2], + &mac.bytes[3], + &mac.bytes[4], + &mac.bytes[5], + &c)) + vpunt(NULL, + "failed to parse MAC address %s", + value); + if (ointerface) { + free(interface); + interface = ointerface; + } + interface->haveMac = TRUE; + interface->myMac = mac; + } + else if ((0 == strncmp (value, "CHAOS|", strlen ("CHAOS|"))) || + (0 == strncmp (value, "chaos|", strlen ("chaos|")))) + { + value += strlen ("CHAOS|"); + interface->myProtocol = ETH_P_CHAOS; + hostAddress = strtoul (value, &end, 8); + if (*end) + { + if (colonPosition != NULL) *colonPosition = ':'; + if (semicolonPosition != NULL) *semicolonPosition = ';'; + vpunt (NULL, "Invalid chaos address in specification of network interface: %s", + value); + } + else + interface->myAddress.s_addr = ntohl (hostAddress); + } + + else if ((0 == strncmp (value, "INTERNET|", strlen ("INTERNET|"))) || + (0 == strncmp (value, "internet|", strlen ("internet|")))) + { + value += strlen ("INTERNET|"); + interface->myProtocol = ETHERTYPE_IP; + hostAddress = ntohl (inet_addr (value)); + if (hostAddress == ntohl (-1)) + { + if (colonPosition != NULL) *colonPosition = ':'; + if (semicolonPosition != NULL) *semicolonPosition = ';'; + vpunt (NULL, + "Invalid Internet address in specification of network interface: %s", + value); + } + else + interface->myAddress.s_addr = hostAddress; + } + + else + { + interface->myProtocol = ETHERTYPE_IP; + if (VerifyHostName (value, &hostName, &hostAddress, TRUE)) + { + memcpy ((char*)&interface->myAddress.s_addr, (char*)&hostAddress, + sizeof (interface->myAddress.s_addr)); + interface->myAddress.s_addr = ntohl (interface->myAddress.s_addr); + } + else + { + if (colonPosition != NULL) *colonPosition = ':'; + if (semicolonPosition != NULL) *semicolonPosition = ';'; + vpunt (NULL, "Unknown host in specification of network interface: %s", value); + } + } + +#ifdef GENERA + interface->myHostAddress.s_addr = 0; + if (semicolonPosition != NULL) { + char *hp = NULL; + strcpy (interface->myOptions, semicolonPosition + 1); + if ((hp = strcasestr(interface->myOptions,"host="))) { + hp += strlen("host="); + switch(interface->myProtocol) { + case ETH_P_CHAOS: + hostAddress = strtoul(hp, &end, 8); + if (hostAddress) + interface->myHostAddress.s_addr = hostAddress; + else + vpunt("network options", + "%s: could not parse host address \"%s\"", + interface->device, + hp); + break; + case ETH_P_IP: + hostAddress = ntohl (inet_addr (hp)); + if (hostAddress != ntohl (-1)) + interface->myHostAddress.s_addr = hostAddress; + else + vpunt("network options", + "%s: could not parse host address \"%s\"", + interface->device, + hp); + + break; + } + } + } + else + interface->myOptions[0] = 0; + interface->anotherAddress = FALSE; +#endif + + interface->present = TRUE; + + value = (commaPosition != NULL) ? commaPosition + 1 : NULL; + } +} + + +/* Convert the options for an X window into our internal representation */ + +static void InterpretXOptions (XrmDatabase options, XParams* xParams, char* windowEnglishName, + char* windowName, char* windowClass) +{ + char value[_POSIX_ARG_MAX], *hostName, *colonPosition, *start, *end; + unsigned long hostAddress, datum; + + GetXOption (options, windowName, windowClass, "display", "Display", value); + + colonPosition = strchr (value, ':'); + + if (colonPosition != NULL) + { + *colonPosition = 0; + if (VerifyHostName (value, &hostName, &hostAddress, FALSE)) + { + xParams->xpHostName = hostName; + xParams->xpHostAddress = hostAddress; + } + else + vpunt (NULL, + "Unknown host %s specified for display of %s", + value, + windowEnglishName); + *colonPosition = ':'; + start = colonPosition + 1; + datum = strtoul (start, &end, 10); + if (start != end) + xParams->xpDisplay = datum; + if (*end) + { + if (*end == '.') + { + start = end + 1; + datum = strtoul (start, &end, 0); + if (start != end) + xParams->xpScreen = datum; + if (*end) + vpunt (NULL, + "Invalid display specification %s for %s", + value, + windowEnglishName); + } + else + vpunt (NULL, + "Invalid display specification %s for %s", + value, + windowEnglishName); + } + else + xParams->xpScreen = -1; + } + + else + { + if (VerifyHostName (value, &hostName, &hostAddress, FALSE)) + { + xParams->xpHostName = hostName; + xParams->xpHostAddress = hostAddress; + } + else + vpunt (NULL, + "Unknown host %s specified for display of %s", + value, + windowEnglishName); + xParams->xpDisplay = -1; + xParams->xpScreen = -1; + } + + if (GetXOption (options, windowName, windowClass, "iconic", "Iconic", value)) + { + if (0 == strcmp (value, "yes")) + xParams->xpInitialState = Iconic; + else if (0 == strcmp (value, "no")) + xParams->xpInitialState = Normal; + else + vpunt (NULL, "Invalid value, %s, for iconic state of %s", value, + windowEnglishName); + } + else + xParams->xpInitialState = Unspecified; + + if (GetXOption (options, windowName, windowClass, "geometry", "Geometry", value)) + xParams->xpGeometry = strdup (value); + else + xParams->xpGeometry = NULL; + + if (GetXOption (options, windowName, windowClass, "foreground", "Foreground", value)) + xParams->xpForegroundColor = strdup (value); + else + xParams->xpForegroundColor = NULL; + + if (GetXOption (options, windowName, windowClass, "background", "Background", value)) + xParams->xpBackgroundColor = strdup (value); + else + xParams->xpBackgroundColor = "white"; + + if (GetXOption (options, windowName, windowClass, "borderColor", "BorderColor", value)) + xParams->xpBorderColor = strdup (value); + else + xParams->xpBorderColor = NULL; + + if (GetXOption (options, windowName, windowClass, "borderWidth", "BorderWidth", value)) + { + datum = strtoul (value, &end, 10); + if (*end) + vpunt (NULL, "Invalid value, %s, for border width of %s", value, + windowEnglishName); + else + xParams->xpBorderWidth = datum; + } + else + xParams->xpBorderWidth = -1; +} + + +/* Merge two world search paths */ + +static char* MergeSearchPaths (char* newSearchPath, char* oldSearchPath) +{ + newSearchPath = strdup (newSearchPath); + + if (0 == strncmp (newSearchPath, "+:", 2)) + newSearchPath = strcat (strdup (&newSearchPath[1]), oldSearchPath); + + if (0 == strncmp (newSearchPath + strlen (newSearchPath) - 2, ":+", 2)) + { + newSearchPath[strlen(newSearchPath)-1] = 0; + newSearchPath = strcat (newSearchPath, oldSearchPath); + } + + return (newSearchPath); +} + + +/* Get the value of an option from the database */ + +static boolean GetOption (XrmDatabase options, char* name, char* class, char* value) +{ + char optionName[128], optionClass[128], *valueClass; + XrmValue dbValue; + + sprintf (optionName, "%s.%s", CommandName, name); + sprintf (optionClass, "%s.%s", CommandClass, class); + + if (XrmGetResource (options, optionName, optionClass, &valueClass, &dbValue)) + { + strncpy (value, dbValue.addr, dbValue.size); + return (TRUE); + } + + else + return (FALSE); +} + + +/* Get the value of an option for an X window from the database */ + +static boolean GetXOption (XrmDatabase options, char* windowName, char* windowClass, + char* name, char* class, char* value) +{ + char optionName[128], optionClass[128]; + + sprintf (optionName, "%s.%s", windowName, name); + sprintf (optionClass, "%s.%s", windowClass, class); + + return (GetOption (options, optionName, optionClass, value)); +} + + +/* Convert a putative host name into an official name and address */ + +static boolean VerifyHostName (char* name, char** hostName, unsigned long* hostAddress, + boolean rejectLocalHost) +{ + struct hostent *hp; + + if (*name == '\0' || !strcmp (name, "unix") || !strcmp (name, "localhost")) + { + if (rejectLocalHost) + return (FALSE); + if (NULL == (hp = gethostbyname ("localhost"))) + vpunt (NULL, "Unable to determine local host network address"); + *hostAddress = *(unsigned long*) hp->h_addr; + *hostName = (*name == '\0') ? NULL : strdup ("localhost"); + } + + else if ((hp = gethostbyname (name)) != NULL) + { + *hostAddress = *(unsigned long*) hp->h_addr; + *hostName = strdup (hp->h_name); + } + + else if ((*hostAddress = ntohl (inet_addr (name))) == ntohl (-1)) + { + if (EWOULDBLOCK == errno) errno = ESUCCESS; + return (FALSE); + } + + else + /* Here iff name is a valid Internet address */ + *hostName = strdup (name); + + return (TRUE); +} + + +#ifndef OS_OSF + +/* Time-related thread "primitives" that were part of OSF and used througout the emulator */ + +/* Convert an interval to an absolute time */ + +#define NSECS_IN_USEC 1000 +#define NSECS_IN_SEC (1000 * 1000 * 1000) + +int pthread_get_expiration_np (const struct timespec *delta, struct timespec *abstime) +{ + int status; + // struct timeval now; + // struct timezone obsolete; + + struct timespec now ; + + // status = gettimeofday (&now, &obsolete); + status = clock_gettime ( CLOCK_REALTIME, &now ); + + if (status == 0) + { + abstime->tv_sec = now.tv_sec + delta->tv_sec; + // abstime->tv_nsec = (NSECS_IN_USEC * now.tv_usec) + delta->tv_nsec; + abstime->tv_nsec = now.tv_nsec + delta->tv_nsec; + while (abstime->tv_nsec > NSECS_IN_SEC) + { + abstime->tv_sec += 1; + abstime->tv_nsec -= NSECS_IN_SEC; + } + } + + return (status); +} + + +/* Put the current thread to sleep for the specified interval */ + +int pthread_delay_np (const struct timespec *ointerval) +{ + int status; + struct timespec interval, rinterval; + + interval.tv_sec = ointerval->tv_sec; + interval.tv_nsec = ointerval->tv_nsec; + + pthread_testcancel (); + + while ((status = nanosleep (&interval, &rinterval))) + { + if (errno != EINTR) break; + interval.tv_sec = rinterval.tv_sec; + interval.tv_nsec = rinterval.tv_nsec; + pthread_testcancel (); + } + + return (status); +} + +#endif diff --git a/src/world_tools.c b/src/world_tools.c new file mode 100644 index 0000000..e208cc4 --- /dev/null +++ b/src/world_tools.c @@ -0,0 +1,1659 @@ + +/* VLM World File Tools */ + +#include "std.h" + +#include +#include +#if !defined(OS_DARWIN) && !defined(__FreeBSD__) +#include +#endif +#include +#include + +#include "life_types.h" +#include "aihead.h" +#include "ivoryrep.h" +#include "memory.h" +#include "world_tools.h" +#include "life_prototypes.h" +#include "utilities.h" +#include "SystemComm.h" + + +#define PuntWorld(world,msg,arg) \ + { \ + CloseWorldFile (world, TRUE); \ + vpunt (NULL, msg, arg); \ + } + +#define PuntWorld2(world,msg,arg1, arg2) \ + { \ + CloseWorldFile (world, TRUE); \ + vpunt (NULL, msg, arg1, arg2); \ + } + +#define PuntWorld3(world,msg,arg1, arg2, arg3) \ + { \ + CloseWorldFile (world, TRUE); \ + vpunt (NULL, msg, arg1, arg2, arg3); \ + } + + +/* Load the VLM debugger into the VLM's memory */ + +void LoadVLMDebugger (VLMConfig* config) +{ + World world; + int i; + + world.pathname = config->vlmDebuggerPath; + OpenWorldFile (&world, TRUE); + + if (world.nUnwiredMapEntries > 0) + PuntWorld (&world, "World file %s contains unwired pages; it can't be a VLM debugger", + world.pathname); + + for (i = 0; i < world.nWiredMapEntries; i++) + LoadMapData (&world, &world.wiredMapEntries[i]); + + CloseWorldFile (&world, TRUE); +} + + +/* Load a world into the VLM's memory */ + +Integer LoadWorld (VLMConfig* config) +{ + World world; + Integer worldImageSize; + int i; + + world.pathname = config->worldPath; + OpenWorldFile (&world, TRUE); +#ifdef GENERA + MergeLoadMaps (&world, config->worldSearchPath); +#else + MergeLoadMaps (&world, ""); +#endif + + worldImageSize = 0; + + for (i = 0; i < world.nMergedWiredMapEntries; i++) + worldImageSize += LoadMapData (&world, &world.mergedWiredMapEntries[i]); + + for (i = 0; i < world.nMergedUnwiredMapEntries; i++) + worldImageSize += LoadMapData (&world, &world.mergedUnwiredMapEntries[i]); + + CloseWorldFile (&world, TRUE); + + errno = 0; /* Flush any bogus error code set during parent search */ + + return (worldImageSize); +} + + +/* Save a world from the VLM's memory using information supplied by Lisp itself */ + +void SaveWorld (Integer saveWorldDataVMA) +{ + World world; + struct sigaction action, oldAction; + SaveWorldData* saveWorldData; + SaveWorldEntry* saveWorldEntry; + LoadMapEntry* loadMapEntry; + LispObj pathnameHeader; + size_t pathnameSize; + int i; + + action.sa_handler = SIG_DFL; + sigemptyset(&action.sa_mask); + action.sa_flags = 0; + if (-1 == sigaction (SIGSEGV, &action, &oldAction)) + vpunt (NULL, "Unable to revert to default memory fault handler."); + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "Data for save world is at VMA %x\n", saveWorldDataVMA); + fflush (stderr); +#endif + + saveWorldData = (SaveWorldData*) MapVirtualAddressData (saveWorldDataVMA); + + world.format = VLMWorldFormat; + + if (Type_String != *MapVirtualAddressTag ((Integer) ((Integer*)&saveWorldData->pathname - + MapVirtualAddressData (0)))) + vpunt (NULL, "Destination pathname for SaveWorld is not a simple string"); + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "Pathname for disk save is at VMA %x\n", saveWorldData->pathname); + fflush (stderr); +#endif + + pathnameHeader = VirtualMemoryRead (saveWorldData->pathname); + if (Type_HeaderI != (LispObjTag (pathnameHeader) & 0x3F)) + vpunt (NULL, "Destination pathname for SaveWord is not a simple string"); + + if ((LispObjData (pathnameHeader) & ~Array_LengthMask) != 0x50000000L) + vpunt (NULL, "Destination pathname for SaveWorld is not a simple string"); + + pathnameSize = LispObjData (pathnameHeader) & Array_LengthMask; + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "Pathname for disk save is %d characters\n", pathnameSize); + fflush (stderr); +#endif + + world.pathname = malloc (pathnameSize + 1); + if (NULL == world.pathname) + vpunt (NULL, "Unable to allocate space for local copy of destination pathname"); + + memcpy (world.pathname, MapVirtualAddressData (saveWorldData->pathname + 1), pathnameSize); + world.pathname[pathnameSize] = 0; + + for (i = 0; i < pathnameSize; i++) + if ('>' == world.pathname[i]) world.pathname[i] = '/'; + + world.nWiredMapEntries = saveWorldData->entryCount; + world.nUnwiredMapEntries = 0; + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "World file will have %d load map entries\n", world.nWiredMapEntries); + fflush (stderr); +#endif + + CreateWorldFile (&world); + + saveWorldEntry = &saveWorldData->entries[0]; + loadMapEntry = world.wiredMapEntries; + + for (i = 0; i < world.nWiredMapEntries; i++, saveWorldEntry++, loadMapEntry++) + { + loadMapEntry->address = saveWorldEntry->address; + loadMapEntry->op.opcode = LoadMapDataPages; + loadMapEntry->op.count = saveWorldEntry->extent; + } + + CanonicalizeVLMLoadMapEntries (&world); + WriteVLMWorldFileHeader (&world); + WriteVLMWorldFilePages (&world); + + CloseWorldFile (&world, TRUE); + + if (-1 == sigaction (SIGSEGV, &oldAction, NULL)) + vpunt (NULL, "Unable to reestablish memory fault handler."); +} + + + +/* Open a world file, determine its format, and read its load maps */ + +boolean OpenWorldFile (World* world, boolean puntOnErrors) +{ + LispObj q; + unsigned int cookie, pageBases; + int wiredCountQ, unwiredCountQ, pagesBaseQ=0, firstSysoutQ, firstMapQ; + + world->vlmDataPage = world->vlmTagsPage = NULL; + world->ivoryDataPage = NULL; + world->wiredMapEntries = world->unwiredMapEntries = NULL; + world->mergedWiredMapEntries = world->mergedUnwiredMapEntries = NULL; + world->parentWorld = NULL; + + if ((world->fd = open (world->pathname, O_RDONLY)) < 0) { + if (puntOnErrors) + vpunt (NULL, "Unable to open world file %s", world->pathname); + else + return (FALSE); + } + if (read (world->fd, (char*)&cookie, sizeof (int)) != sizeof (int)) { + if (puntOnErrors) + { + PuntWorld (world, "Reading world file %s cookie", world->pathname); + } + else + return (FALSE); + } + if (VLMWorldFileCookie == cookie) + { + world->format = VLMWorldFormat; + world->byteSwapped = FALSE; + } + + else if (VLMWorldFileCookieSwapped == cookie) + { + world->format = VLMWorldFormat; + world->byteSwapped = TRUE; + } + + else if (IvoryWorldFileCookie == cookie) + { + world->format = IvoryWorldFormat; + wiredCountQ = IvoryWorldFileWiredCountQ; + unwiredCountQ = IvoryWorldFileUnwiredCountQ; + firstSysoutQ = IvoryWorldFileFirstSysoutQ; + firstMapQ = IvoryWorldFileFirstMapQ; + } + + else if (puntOnErrors) + { + PuntWorld (world, "Format of world file %s is unrecognized", world->pathname); + } + + else + return (FALSE); + + world->ivoryDataPage = malloc (IvoryPageSizeBytes); + if (NULL == world->ivoryDataPage) { + if (puntOnErrors) + { + PuntWorld (world, "Unable to allocate space for data buffer for world file %s", + world->pathname); + } + else + return (FALSE); + } + world->currentPageNumber = -1; + + /* The header and load maps for both VLM and Ivory world files are stored using + Ivory file format settings (i.e., 256 Qs per 1280 byte page) */ + + ReadIvoryWorldFilePage (world, 0); + + if (VLMWorldFormat == world->format) + { + ReadIvoryWorldFileQ (world, VersionAndArchitectureQ, &q); + if (VLMVersion1AndArchitecture == LispObjData (q)) + { + wiredCountQ = VLMWorldFileV1WiredCountQ; + unwiredCountQ = VLMWorldFileV1UnwiredCountQ; + pagesBaseQ = VLMWorldFileV1PageBasesQ; + firstSysoutQ = VLMWorldFileV1FirstSysoutQ; + firstMapQ = VLMWorldFileV1FirstMapQ; + } + else if (VLMVersion2AndArchitecture == LispObjData (q)) + { + wiredCountQ = VLMWorldFileV2WiredCountQ; + unwiredCountQ = VLMWorldFileV2UnwiredCountQ; + pagesBaseQ = VLMWorldFileV2PageBasesQ; + firstSysoutQ = VLMWorldFileV2FirstSysoutQ; + firstMapQ = VLMWorldFileV2FirstMapQ; + } + } + + ReadIvoryWorldFileQ (world, wiredCountQ, &q); + world->nWiredMapEntries = LispObjData (q); + if (world->nWiredMapEntries) + { + world->wiredMapEntries = malloc (world->nWiredMapEntries * sizeof (LoadMapEntry)); + if (NULL == world->wiredMapEntries) { + if (puntOnErrors) + { + PuntWorld (world, + "Unable to allocate space for wired load map for world file %s", + world->pathname); + } + else + return (FALSE); + } + } + if (unwiredCountQ) + { + ReadIvoryWorldFileQ (world, unwiredCountQ, &q); + world->nUnwiredMapEntries = LispObjData (q); + } + else + world->nUnwiredMapEntries = 0; + + if (world->nUnwiredMapEntries) + { + world->unwiredMapEntries = malloc (world->nUnwiredMapEntries * sizeof (LoadMapEntry)); + if (NULL == world->unwiredMapEntries) { + if (puntOnErrors) + { + PuntWorld (world, + "Unable to allocate space for unwired load map for world file %s", + world->pathname); + } + else + return (FALSE); + } + } + if (VLMWorldFormat == world->format) + { + ReadIvoryWorldFileQ (world, pagesBaseQ, &q); + pageBases = LispObjData (q); + world->vlmDataPageBase = ((VLMPageBases*)&pageBases)->dataPageBase; + world->vlmTagsPageBase = ((VLMPageBases*)&pageBases)->tagsPageBase; + } + + if (firstSysoutQ) + { + world->currentQNumber = firstSysoutQ; + ReadIvoryWorldFileNextQ (world, &q); + world->sysoutGeneration = LispObjData (q); + ReadIvoryWorldFileNextQ (world, &q); + world->sysoutTimestamp1 = LispObjData (q); + ReadIvoryWorldFileNextQ (world, &q); + world->sysoutTimestamp2 = LispObjData (q); + ReadIvoryWorldFileNextQ (world, &q); + world->sysoutParentTimestamp1 = LispObjData (q); + ReadIvoryWorldFileNextQ (world, &q); + world->sysoutParentTimestamp2 = LispObjData (q); + } + else + { + world->sysoutGeneration = 0; + world->sysoutTimestamp1 = world->sysoutTimestamp2 = 0; + world->sysoutParentTimestamp1 = world->sysoutParentTimestamp2 = 0; + } + + world->currentQNumber = firstMapQ; + ReadLoadMap (world, world->nWiredMapEntries, world->wiredMapEntries); + ReadLoadMap (world, world->nUnwiredMapEntries, world->unwiredMapEntries); + + return (TRUE); +} + + +/* Create a world file and initialize its data structures */ + +void CreateWorldFile (World* world) +{ +#ifdef DEBUGDISKSAVE + fprintf (stderr, "Creating world file ... "); + fflush (stderr); +#endif + + world->vlmDataPage = world->vlmTagsPage = NULL; + world->ivoryDataPage = NULL; + world->wiredMapEntries = world->unwiredMapEntries = NULL; + world->mergedWiredMapEntries = world->mergedUnwiredMapEntries = NULL; + world->parentWorld = NULL; + + if (VLMWorldFormat != world->format) + vpunt (NULL, "Cannot create world files in other than VLM format"); + + if ((world->fd = open (world->pathname, O_WRONLY | O_CREAT | O_TRUNC, + S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH)) < 0) + vpunt (NULL, "Unable to create world file %s", world->pathname); + + world->ivoryDataPage = malloc (IvoryPageSizeBytes); + if (NULL == world->ivoryDataPage) + PuntWorld (world, "Unable to allocate space for data buffer for world file %s", + world->pathname); + world->currentPageNumber = -1; + + if (world->nWiredMapEntries) + { + world->wiredMapEntries = malloc (world->nWiredMapEntries * sizeof (LoadMapEntry)); + if (NULL == world->wiredMapEntries) + PuntWorld (world, "Unable to allocate space for wired load map for world file %s", + world->pathname); + } + + if (world->nUnwiredMapEntries) + { + world->unwiredMapEntries = malloc (world->nUnwiredMapEntries * sizeof (LoadMapEntry)); + if (NULL == world->unwiredMapEntries) + PuntWorld (world, + "Unable to allocate space for unwired load map for world file %s", + world->pathname); + } + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "done.\n"); + fflush (stderr); +#endif +} + + +/* Close a world file */ + +void CloseWorldFile (World* world, boolean closeParents) +{ + if (world->fd > 0) + { + close (world->fd); + world->fd = -1; + } + + if (world->vlmDataPage) + { + free (world->vlmDataPage); + world->vlmDataPage = NULL; + } + + if (world->vlmTagsPage) + { + free (world->vlmTagsPage); + world->vlmTagsPage = NULL; + } + + if (world->ivoryDataPage) + { + free (world->ivoryDataPage); + world->ivoryDataPage = NULL; + } + + if (world->mergedWiredMapEntries && + (world->mergedWiredMapEntries != world->wiredMapEntries)) + { + free (world->mergedWiredMapEntries); + world->mergedWiredMapEntries = NULL; + } + + if (world->wiredMapEntries) + { + free (world->wiredMapEntries); + world->wiredMapEntries = NULL; + } + + if (world->mergedUnwiredMapEntries && + (world->mergedUnwiredMapEntries != world->unwiredMapEntries)) + { + free (world->mergedUnwiredMapEntries); + world->mergedUnwiredMapEntries = NULL; + } + + if (world->unwiredMapEntries) + { + free (world->unwiredMapEntries); + world->unwiredMapEntries = NULL; + } + + if (closeParents) + if (world->parentWorld) + { + CloseWorldFile (world->parentWorld, TRUE); + free (world->parentWorld); + world->parentWorld = NULL; + } +} + + + +/* Read a load map from the world load file */ + +void ReadLoadMap (World* world, int nMapEntries, LoadMapEntry* mapEntries) +{ + LispObj q; + int i; + + for (i = 0; i < nMapEntries; i++, mapEntries++) + { + ReadIvoryWorldFileNextQ (world, &q); + mapEntries->address = LispObjData (q); + ReadIvoryWorldFileNextQ (world, &q); + *(Integer*)(&mapEntries->op) = LispObjData (q); + ReadIvoryWorldFileNextQ (world, &q); + mapEntries->data = q; + mapEntries->world = world; + } +} + + +/* Load the data from a world load file corresponding to the given load map entry */ + +Integer LoadMapData (World* world, LoadMapEntry* mapEntry) +{ + switch (world->format) + { + case VLMWorldFormat: + return (VLMLoadMapData (world, mapEntry)); + + case IvoryWorldFormat: + return (IvoryLoadMapData (world, mapEntry)); + + default: + PuntWorld (world, "Format of world file %s is unrecognized", world->pathname); + return -1 ; + } +} + + +Integer VLMLoadMapData (World* world, LoadMapEntry* mapEntry) +{ + LispObj q; + World* mapWorld; + Integer pageNumber, theAddress=0, theSourceAddress; + off_t dataOffset, tagOffset; + int increment = 0, i; + + switch (mapEntry->op.opcode) + { + case LoadMapDataPages: + mapWorld = (World*)mapEntry->world; + pageNumber = LispObjData (mapEntry->data); + if (mapWorld->byteSwapped) + { + EnsureVirtualAddressRange (mapEntry->address, (int)mapEntry->op.count, FALSE); + ReadSwappedVLMWorldFilePage (mapWorld, pageNumber); + mapWorld->currentQNumber = 0; +//--- + printf("LoadMapDataPages @ %x, count %d\n", theAddress, mapEntry->op.count); +//--- + theAddress = mapEntry->address; + for (i = 0; i < (int)mapEntry->op.count; i++, theAddress++) + { + ReadSwappedVLMWorldFileNextQ (mapWorld, &q); + VirtualMemoryWrite (theAddress, q); + } + } + else + { + dataOffset = VLMBlockSize * (mapWorld->vlmDataPageBase + + pageNumber * VLMBlocksPerDataPage); + tagOffset = VLMBlockSize * (mapWorld->vlmTagsPageBase + + pageNumber * VLMBlocksPerTagsPage); + MapWorldLoad (mapEntry->address, (int)mapEntry->op.count, + mapWorld->fd, dataOffset, tagOffset); + } + break; + + case LoadMapConstantIncremented: + increment = 1; + /* Fall through to the LoadMapConstant case */ + + case LoadMapConstant: + EnsureVirtualAddressRange (mapEntry->address, (int)mapEntry->op.count, FALSE); + VirtualMemoryWriteBlockConstant (mapEntry->address, mapEntry->data, + (int)mapEntry->op.count, increment); + break; + + case LoadMapCopy: + EnsureVirtualAddressRange (mapEntry->address, (int)mapEntry->op.count, FALSE); + theAddress = mapEntry->address; + theSourceAddress = LispObjData (mapEntry->data); + for (i = 0; i < (int)mapEntry->op.count; i++, theAddress++, theSourceAddress++) + VirtualMemoryWrite (theAddress, VirtualMemoryRead (theSourceAddress)); + break; + + default: + PuntWorld2 (world, "Unknown load map opcode %d in world file %s", mapEntry->op.opcode, + ((World*)mapEntry->world)->pathname); + } + + return ((Integer)mapEntry->op.count); +} + + +Integer IvoryLoadMapData (World* world, LoadMapEntry* mapEntry) +{ + LispObj q; + Integer theAddress, theSourceAddress; + int increment = 0, i; + + EnsureVirtualAddressRange (mapEntry->address, (int)mapEntry->op.count, FALSE); + + switch (mapEntry->op.opcode) + { + case LoadMapDataPages: + ReadIvoryWorldFilePage (world, LispObjData (mapEntry->data)); + world->currentQNumber = 0; + theAddress = mapEntry->address; + for (i = 0; i < (int)mapEntry->op.count; i++, theAddress++) + { + ReadIvoryWorldFileNextQ (world, &q); + VirtualMemoryWrite (theAddress, q); + } + break; + + case LoadMapConstantIncremented: + increment = 1; + /* Fall through to the LoadMapConstant case */ + + case LoadMapConstant: + VirtualMemoryWriteBlockConstant (mapEntry->address, mapEntry->data, + (int)mapEntry->op.count, increment); + break; + + case LoadMapCopy: + theAddress = mapEntry->address; + theSourceAddress = LispObjData (mapEntry->data); + for (i = 0; i < (int)mapEntry->op.count; i++, theAddress++, theSourceAddress++) + VirtualMemoryWrite (theAddress, VirtualMemoryRead (theSourceAddress)); + break; + + default: + PuntWorld2 (world, "Unknown load map opcode %d in world file %s", mapEntry->op.opcode, + world->pathname); + } + + return ((Integer)mapEntry->op.count); +} + + +/* Produce merged wired and unwired load maps that describe all pages which form the world */ + +static World* originalWorld = NULL; + +void MergeLoadMaps (World* world, char* worldSearchPath) +{ + if (world->sysoutGeneration > 0) + { + originalWorld = world; + FindParentWorlds (world, worldSearchPath); + MergeParentLoadMap (world); + } + + else + { + world->nMergedWiredMapEntries = world->nWiredMapEntries; + world->mergedWiredMapEntries = world->wiredMapEntries; + world->nMergedUnwiredMapEntries = world->nUnwiredMapEntries; + world->mergedUnwiredMapEntries = world->unwiredMapEntries; + } +} + + + + +/* Find the ancestors of the user's world: Searches the directory containing said world and + then the world file search path for the ancestors. If successful, the world.parentWorld + slot will form a chain from the user's world to the base world */ + +static World** worlds = NULL; +static int totalWorlds = 0; +static int nWorlds = 0; + +static char* scanningDir = NULL; + +void FindParentWorlds (World* world, char* worldSearchPath) +{ + World *childWorld; + char *failingWorldPathname, *slashPosition, *colonPosition; + int i; + + nWorlds = 0; + totalWorlds = 0; + worlds = NULL; + + scanningDir = strdup (world->pathname); + slashPosition = strrchr (scanningDir, '/'); + if (slashPosition != NULL) + *slashPosition = 0; + else + PuntWorld (world, + "Unable to determine pathname of directory containing world file %s", + world->pathname); + + ScanOneDirectory (world); + + colonPosition = strchr (worldSearchPath, ':'); + while (colonPosition != NULL) + { + *colonPosition = 0; + scanningDir = strdup (worldSearchPath); + ScanOneDirectory (world); + worldSearchPath = colonPosition + 1; + colonPosition = strchr (worldSearchPath, ':'); + } + + if (strlen (worldSearchPath)) + { + scanningDir = strdup (worldSearchPath); + ScanOneDirectory (world); + } + + childWorld = world; + + while (childWorld->sysoutGeneration) + { + for (i = 0; i < nWorlds; i++) + { + if (worlds[i] && + (worlds[i]->sysoutGeneration == (childWorld->sysoutGeneration - 1)) && + (worlds[i]->sysoutTimestamp1 == childWorld->sysoutParentTimestamp1) && + (worlds[i]->sysoutTimestamp2 == childWorld->sysoutParentTimestamp2)) + { + childWorld->parentWorld = worlds[i]; + worlds[i] = NULL; + break; + } + } + + if (NULL == childWorld->parentWorld) + { + failingWorldPathname = strdup (childWorld->pathname); + CloseExtraWorlds (); + PuntWorld (world, "Unable to find parent of world file %s", failingWorldPathname); + } + + childWorld = childWorld->parentWorld; + } + + CloseExtraWorlds (); +} + + +/* Scan a directory looking for world files: Adds all acceptable world files that are found + to the worlds array defined above */ + +void ScanOneDirectory (World* world) +{ + struct dirent **entries; + int nEntries, i; + + if ((nEntries = scandir (scanningDir, &entries, WorldP, alphasort)) < 0) { + if (ENOENT == errno) + entries = NULL; + else + { + CloseExtraWorlds (); + PuntWorld2 (world, + "Unable to search directory %s to find parents of world file %s", + scanningDir, world->pathname); + } + } + if (entries != NULL) + { + for (i = 0; i < nEntries; i++) + free (entries[i]); + free (entries); + } +} + + +/* Called by scandir to decide if we're interested in a given directory entry: + We're only interested in legitimate world files of the same format as the user's world */ + +#ifdef OS_LINUX +int WorldP (const struct dirent* candidateWorld) +#else +int WorldP (struct dirent* candidateWorld) +#endif +{ + World aWorld, **newWorlds; + char candidatePathname[_POSIX_PATH_MAX+1]; + size_t nameLen; + int newTotalWorlds, i; + +#ifdef OS_LINUX + nameLen = _D_EXACT_NAMLEN(candidateWorld); +#else + nameLen = candidateWorld->d_namlen; +#endif + + if ((nameLen > strlen (VLMWorldSuffix) && + (0 == strncmp (candidateWorld->d_name + nameLen - strlen (VLMWorldSuffix), + (VLMWorldFormat == originalWorld->format) ? VLMWorldSuffix + : IvoryWorldSuffix, + strlen (VLMWorldSuffix))))) + { + sprintf (candidatePathname, "%s/%s", scanningDir, candidateWorld->d_name); +#if defined(OS_OSF) || defined(__FreeBSD__) + aWorld.pathname = strdup (candidatePathname); +#else + aWorld.pathname = strndup (candidatePathname, _POSIX_PATH_MAX+1); +#endif + + if (OpenWorldFile (&aWorld, FALSE)) + { + if (nWorlds == totalWorlds) + { + newTotalWorlds = totalWorlds + 32; + newWorlds = malloc (sizeof (World*) * newTotalWorlds); + if (NULL == newWorlds) + { + CloseExtraWorlds (); + CloseWorldFile (&aWorld, TRUE); + PuntWorld (originalWorld, + "Unable to allocate space to search for parents of world file %s", + originalWorld->pathname); + } + memcpy (newWorlds, worlds, (totalWorlds * sizeof (World*))); + free (worlds); + worlds = newWorlds; + totalWorlds = newTotalWorlds; + } + worlds[nWorlds] = malloc (sizeof (World)); + if (NULL == worlds[nWorlds]) + { + CloseExtraWorlds (); + CloseWorldFile (&aWorld, TRUE); + PuntWorld (originalWorld, + "Unable to allocate space to search for parents of world file %s", + originalWorld->pathname); + } + memcpy (worlds[nWorlds], &aWorld, sizeof (World)); + for (i = 0; i < worlds[nWorlds]->nWiredMapEntries; i++) + worlds[nWorlds]->wiredMapEntries[i].world = worlds[nWorlds]; + for (i = 0; i < worlds[nWorlds]->nUnwiredMapEntries; i++) + worlds[nWorlds]->unwiredMapEntries[i].world = worlds[nWorlds]; + nWorlds++; + return (TRUE); + } + + else + return (FALSE); + } + + else + return (FALSE); +} + + +/* Close any worlds that were opened while searching for the user's world's parents that + are not ancestors of said world */ + +void CloseExtraWorlds () +{ + int i; + + if (NULL == worlds) + return; + + for (i = 0; i < nWorlds; i++) + { + if (worlds[i] != NULL) + { + CloseWorldFile (worlds[i], TRUE); + free (worlds[i]); + } + } + + free (worlds); + + worlds = NULL; + totalWorlds = 0; +} + + + +/* Merge the wired and unwired load maps of a world with its parent's load maps */ + +void MergeParentLoadMap (World* world) +{ + if (world->sysoutGeneration == 0) + { + /* If this is a base world, there's nothing to merge against ... */ + world->nMergedWiredMapEntries = world->nWiredMapEntries; + world->mergedWiredMapEntries = world->wiredMapEntries; + world->nMergedUnwiredMapEntries = world->nUnwiredMapEntries; + world->mergedUnwiredMapEntries = world->unwiredMapEntries; + return; + } + + /* Ensure that the parent's load maps have been merged against its ancestors' ... */ + MergeParentLoadMap (world->parentWorld); + + MergeAMap (world->nWiredMapEntries, + world->wiredMapEntries, + world->parentWorld->nMergedWiredMapEntries, + world->parentWorld->mergedWiredMapEntries, + &world->nMergedWiredMapEntries, + &world->mergedWiredMapEntries); + + MergeAMap (world->nUnwiredMapEntries, + world->unwiredMapEntries, + world->parentWorld->nMergedUnwiredMapEntries, + world->parentWorld->mergedUnwiredMapEntries, + &world->nMergedUnwiredMapEntries, + &world->mergedUnwiredMapEntries); +} + + +#ifdef DEBUGMERGELOADMAPS +static void DumpMap (LoadMapEntry* map, int count, char* type) +{ + int i; + printf ("%s Map: %d entries\n", type, count); + for (i = 0; i < count; i++) + printf ("%d: opcode %d, address %08x, count %d, data %09lx, world %p\n", + i, map[i].op.opcode, map[i].address, map[i].op.count, map[i].data, map[i].world); + printf ("\n"); +} +#endif + + +/* Merges a foreground load map and a background load map together into a single load map */ + +void MergeAMap (int nForeground, LoadMapEntry* foreground, + int nBackground, LoadMapEntry* background, + int* nMerged, LoadMapEntry** merged) +{ + LoadMapEntry *new; + Integer pageSizeQs = (VLMWorldFormat == originalWorld->format) ? VLMPageSizeQs + : IvoryPageSizeQs, + oldAddress, slop; + int max, actual, fIndex, bIndex; + boolean copiedForeground; + + /* See SYS:IFEP;WORLD-SUBSTRATE.LISP for an explanation of the maximum number of entries */ + + max = nBackground + nForeground + nForeground; + actual = 0; + + if (0 == max) + { + *nMerged = 0; + *merged = NULL; + return; + } + +#ifdef DEBUGMERGELOADMAPS + DumpMap (foreground, nForeground, "Foreground"); + DumpMap (background, nBackground, "Background"); +#endif + + new = malloc (max * sizeof (LoadMapEntry)); + if (NULL == new) + { + CloseExtraWorlds (); + PuntWorld (originalWorld, + "Unable to allocate space to compute merged load map for world file %s", + originalWorld->pathname); + } + + fIndex = 0; + bIndex = 0; + copiedForeground = FALSE; + + while (fIndex < nForeground) + { + while ((bIndex < nBackground) && + ((background[bIndex].op.opcode != LoadMapDataPages) || + ((background[bIndex].address < foreground[fIndex].address) && + (background[bIndex].address + background[bIndex].op.count < + foreground[fIndex].address)))) + { + /* Here iff the current background entry is either a special operation + or falls entirely below the current foreground entry */ + memcpy (&new[actual], &background[bIndex], sizeof (LoadMapEntry)); + bIndex++; + actual++; + } + + /* Here iff there are no more background entries or the current background + entry either overlaps the current foreground entry or lies entirely above it */ + + if ((foreground[fIndex].op.opcode != LoadMapDataPages) && !copiedForeground) + { + /* If the foreground entry is special, copy it now */ + memcpy (&new[actual], &foreground[fIndex], sizeof (LoadMapEntry)); + actual++; + copiedForeground = TRUE; + } + + else + { + if (background[bIndex].address < foreground[fIndex].address) + { + /* Here iff the current background entry overlaps the current foreground + entry and part of it lies below the current foreground entry. Create + an entry in the merged map for the portion of the background entry that + falls below the foreground entry. We don't have to check the extent of + the background entry as the earlier loop above guaranteed that this + entry must overlap the foreground entry */ + memcpy (&new[actual], &background[bIndex], sizeof (LoadMapEntry)); + new[actual].op.count = foreground[fIndex].address - background[bIndex].address; + actual++; + } + + if (!copiedForeground) + { + memcpy (&new[actual], &foreground[fIndex], sizeof (LoadMapEntry)); + actual++; + copiedForeground = TRUE; + } + + if (background[bIndex].address < + (foreground[fIndex].address + foreground[fIndex].op.count)) + { + if ((background[bIndex].address + background[bIndex].op.count) > + (foreground[fIndex].address + foreground[fIndex].op.count)) + { + /* Here iff the current background entry overlaps the current foreground + entry but also extends past the end of the foreground entry. Adjust + the background entry to cover just the region above the end of the + current foreground entry */ + oldAddress = background[bIndex].address; + background[bIndex].address = foreground[fIndex].address + + foreground[fIndex].op.count; + background[bIndex].op.count -= foreground[fIndex].address + + foreground[fIndex].op.count - + oldAddress; + if ((slop = background[bIndex].address & (pageSizeQs - 1)) != 0) + { + /* Adjust the new background entry to start on a page boundary. + If the resulting entry is empty or zero length, both the + background and foreground end on the same page but the background + includes more of that page which shouldn't happen */ + background[bIndex].address += pageSizeQs - slop; + background[bIndex].op.count -= slop; + if (background[bIndex].op.count <= 0) + { + CloseExtraWorlds (); + PuntWorld (originalWorld, + "A merged load map entry wouldn't start on a page boundary for world file %s", + originalWorld->pathname); + } + } + LispObjData (background[bIndex].data) += (background[bIndex].address - + oldAddress) / + pageSizeQs; + } + else + /* Here iff the current background entry overlaps the current foreground + entry but doesn't extend past the end of the foreground entry. We're + done with this background entry */ + bIndex++; + } + } + + if ((bIndex >= nBackground) || + (background[bIndex].address >= (foreground[fIndex].address + + foreground[fIndex].op.count))) + { + /* Here iff there are no more background entries or the next background entry + does not overlap the current foreground entry. We're done with this + foreground entry */ + fIndex++; + copiedForeground = FALSE; + } + } + + /* Copy an background entries that lie entirely above the last foreground entry */ + + while (bIndex < nBackground) + { + memcpy (&new[actual], &background[bIndex], sizeof (LoadMapEntry)); + bIndex++; + actual++; + } + +#ifdef DEBUGMERGELOADMAPS + DumpMap (new, actual, "Merged"); +#endif + + *nMerged = actual; + *merged = new; +} + + + +/* Canonicalize the load map entries for a VLM world: Look for load map entries that don't + start on a page boundary and convert them into a series of LoadMapConstant entries to load + the data. Thus, all data in the world file will be page-aligned to allow for direct + mapping of the world load file into memory. (Eventually, we may also merge adjacent load + map entries.) */ + +void CanonicalizeVLMLoadMapEntries (World* world) +{ + LoadMapEntry *mapEntry, *newWiredMapEntries, *newMapEntry; + Integer pageNumber, pageCount, blockCount, nQs; + int newNWiredMapEntries, i, j; + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "Canonicalizing load map entries ... "); + fflush (stderr); +#endif + + pageNumber = 0; + i = 0; + + while (i < world->nWiredMapEntries) + { + mapEntry = &world->wiredMapEntries[i]; + if (0 == (mapEntry->address & (VLMPageSizeQs - 1))) + { + /* Page Aligned: Assign the page number within the file */ + pageCount = (mapEntry->op.count + VLMPageSizeQs - 1) / VLMPageSizeQs; + mapEntry->data = MakeLispObj (Type_Fixnum, pageNumber); + pageNumber += pageCount; + i++; + } + else + { + /* Not Page Aligned: Convert into a series of LoadMapConstant entries */ + newNWiredMapEntries = world->nWiredMapEntries + mapEntry->op.count - 1; + newWiredMapEntries = malloc (newNWiredMapEntries * sizeof (LoadMapEntry)); + if (NULL == newWiredMapEntries) + PuntWorld (world, + "Unable to allocate space for wired load map for world file %s", + world->pathname); + memcpy (newWiredMapEntries, world->wiredMapEntries, i * sizeof (LoadMapEntry)); + memcpy (&newWiredMapEntries[i+mapEntry->op.count], &world->wiredMapEntries[i+1], + (world->nWiredMapEntries - i) * sizeof (LoadMapEntry)); + for (j = 0; j < mapEntry->op.count; j++) + { + newMapEntry = &newWiredMapEntries[i+j]; + newMapEntry->address = mapEntry->address + j; + newMapEntry->op.opcode = LoadMapConstant; + newMapEntry->op.count = 1; + newMapEntry->data = VirtualMemoryRead (newMapEntry->address); + } + i += mapEntry->op.count; + free (world->wiredMapEntries); + world->nWiredMapEntries = newNWiredMapEntries; + world->wiredMapEntries = newWiredMapEntries; + } + } + + /* Compute size of header in VLM blocks to determine where the tags and data pages + will start within the world file */ + + nQs = VLMWorldFileV2FirstMapQ + (3 * world->nWiredMapEntries); + pageCount = (nQs + IvoryPageSizeQs - 1) / IvoryPageSizeQs; + blockCount = ((pageCount * IvoryPageSizeBytes) + VLMBlockSize - 1) / VLMBlockSize; + if (blockCount > VLMMaximumHeaderBlocks) + PuntWorld (world, + "Unable to store data map in space reserved for same in world file %s", + world->pathname); + + world->vlmTagsPageBase = blockCount; + world->vlmDataPageBase = world->vlmTagsPageBase + (VLMBlocksPerTagsPage * pageNumber); + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "done.\n"); + fflush (stderr); +#endif +} + + +/* Write the world file header and load maps for a VLM world file */ + +void WriteVLMWorldFileHeader (World* world) +{ + LoadMapEntry* mapEntry; + LispObj generationQ; + Integer pageBases; + off_t nBlocks; + int i; + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "Writing world file header ... "); + fflush (stderr); +#endif + + /* Compute the size of the world load and preallocate disk space for it */ + + for (i = world->nWiredMapEntries; i > 0; i--) + { + mapEntry = &world->wiredMapEntries[i-1]; + if (LoadMapDataPages == mapEntry->op.opcode) + { + nBlocks = world->vlmDataPageBase + + (LispObjData (mapEntry->data) + (mapEntry->op.count / VLMPageSizeQs) + 1) + * VLMBlocksPerDataPage; + if (ftruncate (world->fd, nBlocks * VLMBlockSize) < 0) + PuntWorld2 (world, "Unable to grow world file %s to %d bytes", + world->pathname, nBlocks * VLMBlockSize); + break; + } + } + + PrepareToWriteIvoryWorldFilePage (world, 0); + + /* Write the header: The first Q is the format/architecture, the second is the count + of wired load map entries, and the third is the data/tags pages base block numbers. */ + + ((VLMPageBases*)&pageBases)->dataPageBase = world->vlmDataPageBase; + ((VLMPageBases*)&pageBases)->tagsPageBase = world->vlmTagsPageBase; + + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_Fixnum, + VLMVersion2AndArchitecture)); + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_SmallRatio, + world->nWiredMapEntries)); + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_SingleFloat, + pageBases)); + + /* Copy the data from SystemComm used to find a world's parents when loading an IDS: + The first word is written with the wrong tag as it's tag is part of the magic cookie. */ +#ifndef MINIMA + generationQ = ReadSystemCommSlot (sysoutGenerationNumber); + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_Character, + LispObjData (generationQ))); + + WriteIvoryWorldFileNextQ (world, ReadSystemCommSlot (sysoutTimestamp1)); + WriteIvoryWorldFileNextQ (world, ReadSystemCommSlot (sysoutTimestamp2)); + WriteIvoryWorldFileNextQ (world, ReadSystemCommSlot (sysoutParentTimestamp1)); + WriteIvoryWorldFileNextQ (world, ReadSystemCommSlot (sysoutParentTimestamp2)); +#else + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_Character, 0)); + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_Character, 0)); + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_Character, 0)); + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_Character, 0)); + WriteIvoryWorldFileNextQ (world, MakeLispObj ((Cdr_Normal << 6) + Type_Character, 0)); +#endif + + /* Write the wired load map which is the only load map in a VLM world file */ + + for (i = 0; i < world->nWiredMapEntries; i++) + { + mapEntry = &world->wiredMapEntries[i]; + WriteIvoryWorldFileNextQ (world, MakeLispObj (Type_Locative, mapEntry->address)); + WriteIvoryWorldFileNextQ (world, MakeLispObj (Type_Fixnum, *(Integer*)&mapEntry->op)); + WriteIvoryWorldFileNextQ (world, mapEntry->data); + } + + /* Flush the last page to disk */ + + WriteIvoryWorldFilePage (world); + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "done.\n"); + fflush (stderr); +#endif +} + + +/* Write the data/tags pages for a VLM world file */ + +void WriteVLMWorldFilePages (World* world) +{ + LoadMapEntry* mapEntry; + Integer pageNumber; +#ifdef DEBUGDISKSAVE + Integer vma, finalVMA; + VMAttribute attr; +#endif + size_t wordCount, byteCount; + off_t offset; + int i; + + for (i = 0; i < world->nWiredMapEntries; i++) + { + mapEntry = &world->wiredMapEntries[i]; + + if (LoadMapDataPages != mapEntry->op.opcode) + continue; + + pageNumber = LispObjData (mapEntry->data); + wordCount = (size_t) mapEntry->op.count; + +#ifdef DEBUGDISKSAVE + vma = mapEntry->address; + finalVMA = vma + wordCount; + + while (vma < finalVMA) + { + attr = VMAttributeTable[(vma >> MemoryPage_AddressShift)]; + if (VMAccessFault (attr) || VMWriteFault (attr) || + (VMTransportFault (attr) && !VMTransportDisable (attr))) + PuntWorld3 (world, "VMA %x is protected (attributes %x) in world file %s", + vma, attr, world->pathname); + vma += VLMPageSizeQs; + } + + fprintf (stderr, "Writing %d words from VMA %x ... words ... ", + wordCount, mapEntry->address); + fflush (stderr); +#endif + + /* First, write the data ... */ + offset = VLMBlockSize * (world->vlmDataPageBase + pageNumber * VLMBlocksPerDataPage); + byteCount = wordCount * sizeof (Integer); + if (offset != lseek (world->fd, offset, SEEK_SET)) + PuntWorld2 (world, "Unable to seek to offset %d in world file %s", offset, + world->pathname); + if (byteCount != write(world->fd, MapVirtualAddressData(mapEntry->address), byteCount)) + PuntWorld2 (world, "Unable to write data page %d into world file %s", pageNumber, + world->pathname); + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "tags ... "); + fflush (stderr); +#endif + + /* ... then, write the tags */ + offset = VLMBlockSize * (world->vlmTagsPageBase + pageNumber * VLMBlocksPerTagsPage); + byteCount = wordCount * sizeof (Tag); + if (offset != lseek (world->fd, offset, SEEK_SET)) + PuntWorld2 (world, "Unable to seek to offset %d in world file %s", offset, + world->pathname); + if (byteCount != write (world->fd, MapVirtualAddressTag(mapEntry->address), byteCount)) + PuntWorld2 (world, "Unable to write tags page %d into world file %s", pageNumber, + world->pathname); + +#ifdef DEBUGDISKSAVE + fprintf (stderr, "done.\n"); + fflush (stderr); +#endif + } +} + + + +/* Read the specified page from the world file using Ivory file format settings */ + +void ReadIvoryWorldFilePage (World* world, int pageNumber) +{ + off_t offset; + + if (world->currentPageNumber == pageNumber) + return; + + offset = pageNumber * IvoryPageSizeBytes; + + if (offset != lseek (world->fd, offset, SEEK_SET)) + PuntWorld2 (world, "Unable to seek to offset %d in world file %s", offset, + world->pathname); + + if (IvoryPageSizeBytes != read (world->fd, world->ivoryDataPage, IvoryPageSizeBytes)) + PuntWorld2 (world, "Unable to read page %d from world file %s", pageNumber, + world->pathname); + + world->currentPageNumber = pageNumber; +} + + +/* Return a specific Q (pointer and tag) from within the current page, + using Ivory file format settings*/ + +void ReadIvoryWorldFileQ (World* world, int qNumber, LispObj *q) +{ + int pointerOffset, tagOffset; +// Integer datum; + + if ((qNumber < 0) || (qNumber >= IvoryPageSizeQs)) + PuntWorld2 (world, "Invalid word number %d for world file %s", qNumber, + world->pathname); + + pointerOffset = 5 * (qNumber >> 2) + (qNumber & 3) + 1; + tagOffset = 4 * 5 * (qNumber >> 2) + (qNumber & 3); + +/* ---*** NOTE: The following code that byte reverses the tags isn't needed. +* ---*** I've left it here in case I discover later that I'm wrong +* ---*** so I don't have to derive the correct code again. +* ---*** #if BYTE_ORDER == LITTLE_ENDIAN +* ---*** tagOffset = 4 * 5 * (qNumber >> 2) + (qNumber & 3); +* ---*** #else +* ---*** tagOffset = 4 * 5 * (qNumber >> 2) + 3 - (qNumber & 3); +* ---*** #endif +* ---*** */ + +#if BYTE_ORDER == LITTLE_ENDIAN + *q = MakeLispObj (world->ivoryDataPage[tagOffset], + *((Integer*)(world->ivoryDataPage) + pointerOffset)); +#else + datum = bswap_32 (*((Integer*)(world->ivoryDataPage) + pointerOffset)); + *q = MakeLispObj (world->ivoryDataPage[tagOffset], datum); +#endif +} + + +/* Read the next Q from within the world file, advancing to the next page if needed, + using Ivory file format settings */ + +void ReadIvoryWorldFileNextQ (World* world, LispObj *q) +{ + while (world->currentQNumber >= IvoryPageSizeQs) + { + ReadIvoryWorldFilePage (world, world->currentPageNumber + 1); + world->currentQNumber -= IvoryPageSizeQs; + } + + ReadIvoryWorldFileQ (world, world->currentQNumber, q); + + world->currentQNumber++; +} + + + +/* Prepare to write a specific page into the world file, using Ivory file format settings */ + +void PrepareToWriteIvoryWorldFilePage (World* world, int pageNumber) +{ + world->currentPageNumber = pageNumber; + world->currentQNumber = 0; + memset (world->ivoryDataPage, 0, IvoryPageSizeBytes); +} + + +/* Write the current page into the world file, using Ivory file format settings */ + +void WriteIvoryWorldFilePage (World* world) +{ + off_t offset; + + if (0 == world->currentQNumber) + return; + + offset = world->currentPageNumber * IvoryPageSizeBytes; + + if (offset != lseek (world->fd, offset, SEEK_SET)) + PuntWorld2 (world, "Unable to seek to offset %d in world file %s", offset, + world->pathname); + + if (IvoryPageSizeBytes != write (world->fd, world->ivoryDataPage, IvoryPageSizeBytes)) + PuntWorld2 (world, "Unable to write page %d into world file %s", + world->currentPageNumber, world->pathname); + + world->currentPageNumber++; + PrepareToWriteIvoryWorldFilePage (world, world->currentPageNumber); +} + + +/* Write the next Q into the world file, writing the current page and advancing to + the next if needed, using Ivory file format settings */ + +void WriteIvoryWorldFileNextQ (World* world, LispObj q) +{ + int pointerOffset, tagOffset; +// Integer datum; + + if (world->currentQNumber >= IvoryPageSizeQs) + WriteIvoryWorldFilePage (world); + + pointerOffset = 5 * (world->currentQNumber >> 2) + (world->currentQNumber & 3) + 1; + tagOffset = 4 * 5 * (world->currentQNumber >> 2) + (world->currentQNumber & 3); + +/* ---*** NOTE: The following code that byte reverses the tags isn't needed. + ---*** I've left it here in case I discover later that I'm wrong + ---*** so I don't have to derive the correct code again. + ---*** #if BYTE_ORDER == LITTLE_ENDIAN + ---*** tagOffset = 4 * 5 * (world->currentQNumber >> 2) + (world->currentQNumber & 3); + ---*** #else + ---*** tagOffset = 4 * 5 * (world->currentQNumber >> 2) + 3 - (world->currentQNumber & 3); + ---*** #endif + ---*** */ + +#if BYTE_ORDER == LITTLE_ENDIAN + world->ivoryDataPage[tagOffset] = LispObjTag (q); + *((Integer*)(world->ivoryDataPage) + pointerOffset) = LispObjData (q); +#else + world->ivoryDataPage[tagOffset] = LispObjTag (q); + datum = bswap_32 (LispObjData (q)); + *((Integer*)(world->ivoryDataPage) + pointerOffset) = datum; +#endif + + world->currentQNumber++; +} + + + +/* Read the specified page from a byte swapped world file using VLM file format settings */ + +void ReadSwappedVLMWorldFilePage (World* world, int pageNumber) +{ + off_t dataOffset, tagsOffset; + + if (world->vlmDataPage == NULL) + { + world->vlmDataPage = malloc (VLMDataPageSizeBytes); + if (NULL == world->vlmDataPage) + PuntWorld (world, "Unable to allocate space for data buffer for world file %s", + world->pathname); + world->vlmTagsPage = malloc (VLMTagsPageSizeBytes); + if (NULL == world->vlmTagsPage) + PuntWorld (world, "Unable to allocate space for data buffer for world file %s", + world->pathname); + world->currentPageNumber = -1; + } + + if (world->currentPageNumber == pageNumber) + return; + + dataOffset = VLMBlockSize * (world->vlmDataPageBase + pageNumber * VLMBlocksPerDataPage); + tagsOffset = VLMBlockSize * (world->vlmTagsPageBase + pageNumber * VLMBlocksPerTagsPage); + + if (dataOffset != lseek (world->fd, dataOffset, SEEK_SET)) + PuntWorld2 (world, "Unable to seek to offset %d in world file %s", dataOffset, + world->pathname); + + if (VLMDataPageSizeBytes != read (world->fd, world->vlmDataPage, VLMDataPageSizeBytes)) + PuntWorld2 (world, "Unable to read page %d from world file %s", pageNumber, + world->pathname); + + if (tagsOffset != lseek (world->fd, tagsOffset, SEEK_SET)) + PuntWorld2 (world, "Unable to seek to offset %d in world file %s", tagsOffset, + world->pathname); + + if (VLMTagsPageSizeBytes != read (world->fd, world->vlmTagsPage, VLMTagsPageSizeBytes)) + PuntWorld2 (world, "Unable to read page %d from world file %s", pageNumber, + world->pathname); + + world->currentPageNumber = pageNumber; +} + + +/* Return a specific Q (pointer and tag) from within the current page, + using VLM file format settings*/ + +void ReadSwappedVLMWorldFileQ (World* world, int qNumber, LispObj *q) +{ + Integer datum; + + if ((qNumber < 0) || (qNumber >= VLMPageSizeQs)) + PuntWorld2 (world, "Invalid word number %d for world file %s", qNumber, + world->pathname); + + datum = bswap_32 (*((Integer*)(world->vlmDataPage) + qNumber)); + *q = MakeLispObj (world->vlmTagsPage[qNumber], datum); + +/* ---*** NOTE: The following code that byte reverses the tags isn't needed. + ---*** I've left it here in case I discover later that I'm wrong + ---*** so I don't have to derive the correct code again. + ---*** *q = MakeLispObj (world->vlmTagsPage[4 * (qNumber >> 2) + 3 - (qNumber & 3)], datum); + ---*** */ +} + + +/* Read the next Q from within the world file, advancing to the next page if needed, + using VLM file format settings */ + +void ReadSwappedVLMWorldFileNextQ (World* world, LispObj *q) +{ + while (world->currentQNumber >= VLMPageSizeQs) + { + ReadSwappedVLMWorldFilePage (world, world->currentPageNumber + 1); + world->currentQNumber -= VLMPageSizeQs; + } + + ReadSwappedVLMWorldFileQ (world, world->currentQNumber, q); + + world->currentQNumber++; +} + + + +/* Swap bytes in the specified world and its parents as necessary */ + +void ByteSwapWorld (char* worldPathname, char* searchPath) +{ + World world, *aWorld; + + world.pathname = worldPathname; + OpenWorldFile (&world, TRUE); + originalWorld = &world; + FindParentWorlds (&world, searchPath); + + for (aWorld = &world; aWorld != NULL; aWorld = aWorld->parentWorld) + if ((VLMWorldFormat == aWorld->format) && aWorld->byteSwapped) + ByteSwapOneWorld (aWorld); + else + CloseWorldFile (aWorld, FALSE); + + errno = 0; /* Flush any bogus error code set during parent search */ +} + + +void ByteSwapOneWorld (World* world) +{ + char *newPathname, *bakPathname, block[VLMBlockSize]; + struct stat worldStat; + size_t dataStart, dataEnd, offset; + uint32_t *wordBlockStart; + int newFD; + +#if defined(OS_OSF) || defined(__FreeBSD__) + newPathname = strdup (world->pathname); +#else + newPathname = strndup (world->pathname, _POSIX_PATH_MAX + 1); +#endif + newPathname = strncat (newPathname, ".swap", _POSIX_PATH_MAX + 1); + + printf ("Swapping bytes in %s ... ", world->pathname); + fflush (stdout); + + if (fstat (world->fd, &worldStat) < 0) + PuntWorld (world, "Unable to determine attributes of world file %s", + world->pathname); + + if ((newFD = open (newPathname, O_WRONLY | O_CREAT | O_TRUNC, + S_IRUSR | S_IWUSR | S_IRGRP | S_IROTH)) < 0) + PuntWorld (world, "Unable to create world file %s", newPathname); + + offset = 0; + +/* ---*** NOTE: It's not clear whether or not we need to swap the VLM tags pages +* ---*** as well as the data pages. We won't know until the emulator +* ---*** actually tries to run Genera code. If we do need to swap, we'll +* ---*** have to figure out whether or not to always swap or to only swap +* ---*** in one direction (i.e., from Alpha to G5) +* ---*** */ +#ifndef BYTESWAP_TAGS + dataStart = VLMBlockSize * world->vlmDataPageBase; + dataEnd = (world->vlmDataPageBase > world->vlmTagsPageBase) + ? worldStat.st_size + : VLMBlockSize * world->vlmTagsPageBase; +#else + dataStart = (world->vlmDataPageBase < world->vlmTagsPageBase) + ? VLMBlockSize * world->vlmDataPageBase + : VLMBlockSize * world->vlmTagsPageBase; + dataEnd = worldStat.st_size; +#endif + + wordBlockStart = (uint32_t*) █ + + if (0 != lseek (world->fd, 0, SEEK_SET)) + PuntWorld (world, "Unable to seek to start of world file %s", world->pathname); + + while (offset < worldStat.st_size) + { + if (VLMBlockSize != read (world->fd, block, VLMBlockSize)) + PuntWorld (world, "Unable to read data from world file %s", world->pathname); + + if (0 == offset) + *wordBlockStart = VLMWorldFileCookie; + + if (offset >= dataStart && (offset + VLMBlockSize) <= dataEnd) + bswap32_block (wordBlockStart, VLMBlockSize); + + if (VLMBlockSize != write (newFD, block, VLMBlockSize)) + PuntWorld (world, "Unable to write data to world file %s", newPathname); + + offset += VLMBlockSize; + } + + + CloseWorldFile (world, FALSE); + close (newFD); + +#if defined(OS_OSF) || defined(__FreeBSD__) + bakPathname = strdup (world->pathname); +#else + bakPathname = strndup (world->pathname, _POSIX_PATH_MAX + 1); +#endif + bakPathname = strncat (bakPathname, ".bak", _POSIX_PATH_MAX + 1); + + if (rename (world->pathname, bakPathname) < 0) + PuntWorld2 (world, "Unable to rename world file %s to %s", world->pathname, bakPathname); + + if (rename (newPathname, world->pathname) < 0) + PuntWorld2 (world, "Unable to rename world file %s to %s", newPathname, world->pathname); + + printf ("done.\n"); +} diff --git a/stub/Makefile b/stub/Makefile new file mode 100644 index 0000000..f8980ce --- /dev/null +++ b/stub/Makefile @@ -0,0 +1,552 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# stub/Makefile. Generated from Makefile.in by configure. + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + + + + +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/vlm +pkgincludedir = $(includedir)/vlm +pkglibdir = $(libdir)/vlm +pkglibexecdir = $(libexecdir)/vlm +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = x86_64-suse-linux-gnu +host_triplet = x86_64-suse-linux-gnu +subdir = stub +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp README +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +AR = ar +ARFLAGS = cru +AM_V_AR = $(am__v_AR_$(V)) +am__v_AR_ = $(am__v_AR_$(AM_DEFAULT_VERBOSITY)) +am__v_AR_0 = @echo " AR " $@; +am__v_AR_1 = +libstub_a_AR = $(AR) $(ARFLAGS) +libstub_a_LIBADD = +am_libstub_a_OBJECTS = stub.$(OBJEXT) +libstub_a_OBJECTS = $(am_libstub_a_OBJECTS) +AM_V_P = $(am__v_P_$(V)) +am__v_P_ = $(am__v_P_$(AM_DEFAULT_VERBOSITY)) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_$(V)) +am__v_GEN_ = $(am__v_GEN_$(AM_DEFAULT_VERBOSITY)) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_$(V)) +am__v_at_ = $(am__v_at_$(AM_DEFAULT_VERBOSITY)) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I. -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_$(V)) +am__v_CC_ = $(am__v_CC_$(AM_DEFAULT_VERBOSITY)) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_$(V)) +am__v_CCLD_ = $(am__v_CCLD_$(AM_DEFAULT_VERBOSITY)) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libstub_a_SOURCES) +DIST_SOURCES = $(libstub_a_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = ${SHELL} /home/lispm/snap5/jj-vlm/missing aclocal-1.13 +AMTAR = $${TAR-tar} +AM_DEFAULT_VERBOSITY = 0 +AUTOCONF = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoconf +AUTOHEADER = ${SHELL} /home/lispm/snap5/jj-vlm/missing autoheader +AUTOMAKE = ${SHELL} /home/lispm/snap5/jj-vlm/missing automake-1.13 +AWK = gawk +CC = gcc -std=gnu99 +CCDEPMODE = depmode=gcc3 +CFLAGS = -g -O2 -g0 -Ofast -rdynamic -fno-strict-aliasing -march=native -Wall +CLISP = /usr/bin/clisp +CPP = gcc -std=gnu99 -E +CPPFLAGS = -DGENERA -DAUTOSTART -DUSE_TAP +CYGPATH_W = echo +DEFS = -DHAVE_CONFIG_H +DEPDIR = .deps +ECHO_C = +ECHO_N = -n +ECHO_T = +EGREP = /usr/bin/grep -E +EXEEXT = +GREP = /usr/bin/grep +INSTALL = /usr/bin/install -c +INSTALL_DATA = ${INSTALL} -m 644 +INSTALL_PROGRAM = ${INSTALL} +INSTALL_SCRIPT = ${INSTALL} +INSTALL_STRIP_PROGRAM = $(install_sh) -c -s +LDFLAGS = +LIBOBJS = +LIBS = -lpthread -lm -ldl -lcrypt -lc -lX11 +LTLIBOBJS = +MAKEINFO = ${SHELL} /home/lispm/snap5/jj-vlm/missing makeinfo +MKDIR_P = /usr/bin/mkdir -p +OBJEXT = o +PACKAGE = vlm +PACKAGE_BUGREPORT = joachimq@achemich.de +PACKAGE_NAME = vlm +PACKAGE_STRING = vlm 0.99-1 +PACKAGE_TARNAME = vlm +PACKAGE_URL = +PACKAGE_VERSION = 0.99-1 +PATH_SEPARATOR = : +PTHREAD_CC = gcc -std=gnu99 +PTHREAD_CFLAGS = -pthread +PTHREAD_LIBS = +RANLIB = ranlib +SET_MAKE = +SHELL = /bin/sh +STRIP = +VERSION = 0.99-1 +XMKMF = +abs_builddir = /home/lispm/snap5/jj-vlm/stub +abs_srcdir = /home/lispm/snap5/jj-vlm/stub +abs_top_builddir = /home/lispm/snap5/jj-vlm +abs_top_srcdir = /home/lispm/snap5/jj-vlm +ac_ct_CC = gcc +acx_pthread_config = +am__include = include +am__leading_dot = . +am__quote = +am__tar = $${TAR-tar} chof - "$$tardir" +am__untar = $${TAR-tar} xf - +bindir = ${exec_prefix}/bin +build = x86_64-suse-linux-gnu +build_alias = +build_cpu = x86_64 +build_os = linux-gnu +build_vendor = suse +builddir = . +datadir = ${datarootdir} +datarootdir = ${prefix}/share +docdir = ${datarootdir}/doc/${PACKAGE_TARNAME} +dvidir = ${docdir} +exec_prefix = ${prefix} +host = x86_64-suse-linux-gnu +host_alias = +host_cpu = x86_64 +host_os = linux-gnu +host_vendor = suse +htmldir = ${docdir} +includedir = ${prefix}/include +infodir = ${datarootdir}/info +install_sh = ${SHELL} /home/lispm/snap5/jj-vlm/install-sh +libdir = ${exec_prefix}/lib64 +libexecdir = ${exec_prefix}/lib +localedir = ${datarootdir}/locale +localstatedir = ${prefix}/var +mandir = ${datarootdir}/man +mkdir_p = $(MKDIR_P) +oldincludedir = /usr/include +pdfdir = ${docdir} +prefix = /usr/local +program_transform_name = s,x,x, +psdir = ${docdir} +sbindir = ${exec_prefix}/sbin +sharedstatedir = ${prefix}/com +srcdir = . +sysconfdir = ${prefix}/etc +target_alias = +top_build_prefix = ../ +top_builddir = .. +top_srcdir = .. +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I/home/lispm/snap5/jj-vlm/include -I/home/lispm/snap5/jj-vlm/life-support -I/home/lispm/snap5/jj-vlm/emulator -I/home/lispm/snap5/jj-vlm/x86_64-emulator + +# +# no warnings for labels in stub.c i*.c, pls +# +AM_CFLAGS = -Wall -Wno-unused-label -Wno-unused-function +noinst_LIBRARIES = libstub.a +libstub_a_SOURCES = stub.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu stub/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu stub/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) + +libstub.a: $(libstub_a_OBJECTS) $(libstub_a_DEPENDENCIES) $(EXTRA_libstub_a_DEPENDENCIES) + $(AM_V_at)-rm -f libstub.a + $(AM_V_AR)$(libstub_a_AR) libstub.a $(libstub_a_OBJECTS) $(libstub_a_LIBADD) + $(AM_V_at)$(RANLIB) libstub.a + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +include ./$(DEPDIR)/stub.Po + +.c.o: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c $< + +.c.obj: + $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` + $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +# $(AM_V_CC)source='$<' object='$@' libtool=no \ +# DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) \ +# $(AM_V_CC_no)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-local clean-noinstLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ + clean-local clean-noinstLIBRARIES cscopelist-am ctags ctags-am \ + distclean distclean-compile distclean-generic distclean-tags \ + distdir dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am + + +stub.o: blanks.c /home/lispm/snap5/jj-vlm/stub/i*.c float2 dispatch stub.c clisp-support.lisp process.lisp + +/home/lispm/snap5/jj-vlm/stub/i*.c: /home/lispm/snap5/jj-vlm/alpha-emulator/*.as /home/lispm/snap5/jj-vlm/alpha-emulator/*.lisp /home/lispm/snap5/jj-vlm/alpha-emulator/*.c /home/lispm/snap5/jj-vlm/alpha-emulator/*.h /home/lispm/snap5/jj-vlm/emulator/aihead* /home/lispm/snap5/jj-vlm/stub/*.lisp /home/lispm/snap5/jj-vlm/assembler/*.lisp + $(CLISP) process.lisp +# @echo +# @echo "you don't seem to have clisp installed. Unable to compile $< to $@" +# @echo +# @exit -1 + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/stub/Makefile.am b/stub/Makefile.am new file mode 100644 index 0000000..53bed0b --- /dev/null +++ b/stub/Makefile.am @@ -0,0 +1,27 @@ +AM_CPPFLAGS=-I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator + +# +# no warnings for labels in stub.c i*.c, pls +# +AM_CFLAGS= -Wall -Wno-unused-label -Wno-unused-function + +noinst_LIBRARIES = libstub.a +libstub_a_SOURCES = stub.c + +stub.o: blanks.c @abs_top_srcdir@/stub/i*.c float2 dispatch stub.c clisp-support.lisp process.lisp + +@abs_top_srcdir@/stub/i*.c: @abs_top_srcdir@/alpha-emulator/*.as @abs_top_srcdir@/alpha-emulator/*.lisp @abs_top_srcdir@/alpha-emulator/*.c @abs_top_srcdir@/alpha-emulator/*.h @abs_top_srcdir@/emulator/aihead* @abs_top_srcdir@/stub/*.lisp @abs_top_srcdir@/assembler/*.lisp +if HCLISP + $(CLISP) process.lisp +else + @echo + @echo "you don't seem to have clisp installed. Unable to compile $< to $@" + @echo + @exit -1 +endif + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + diff --git a/stub/Makefile.in b/stub/Makefile.in new file mode 100644 index 0000000..10567bf --- /dev/null +++ b/stub/Makefile.in @@ -0,0 +1,552 @@ +# Makefile.in generated by automake 1.13.4 from Makefile.am. +# @configure_input@ + +# Copyright (C) 1994-2013 Free Software Foundation, Inc. + +# This Makefile.in is free software; the Free Software Foundation +# gives unlimited permission to copy and/or distribute it, +# with or without modifications, as long as this notice is preserved. + +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY, to the extent permitted by law; without +# even the implied warranty of MERCHANTABILITY or FITNESS FOR A +# PARTICULAR PURPOSE. + +@SET_MAKE@ + +VPATH = @srcdir@ +am__is_gnu_make = test -n '$(MAKEFILE_LIST)' && test -n '$(MAKELEVEL)' +am__make_running_with_option = \ + case $${target_option-} in \ + ?) ;; \ + *) echo "am__make_running_with_option: internal error: invalid" \ + "target option '$${target_option-}' specified" >&2; \ + exit 1;; \ + esac; \ + has_opt=no; \ + sane_makeflags=$$MAKEFLAGS; \ + if $(am__is_gnu_make); then \ + sane_makeflags=$$MFLAGS; \ + else \ + case $$MAKEFLAGS in \ + *\\[\ \ ]*) \ + bs=\\; \ + sane_makeflags=`printf '%s\n' "$$MAKEFLAGS" \ + | sed "s/$$bs$$bs[$$bs $$bs ]*//g"`;; \ + esac; \ + fi; \ + skip_next=no; \ + strip_trailopt () \ + { \ + flg=`printf '%s\n' "$$flg" | sed "s/$$1.*$$//"`; \ + }; \ + for flg in $$sane_makeflags; do \ + test $$skip_next = yes && { skip_next=no; continue; }; \ + case $$flg in \ + *=*|--*) continue;; \ + -*I) strip_trailopt 'I'; skip_next=yes;; \ + -*I?*) strip_trailopt 'I';; \ + -*O) strip_trailopt 'O'; skip_next=yes;; \ + -*O?*) strip_trailopt 'O';; \ + -*l) strip_trailopt 'l'; skip_next=yes;; \ + -*l?*) strip_trailopt 'l';; \ + -[dEDm]) skip_next=yes;; \ + -[JT]) skip_next=yes;; \ + esac; \ + case $$flg in \ + *$$target_option*) has_opt=yes; break;; \ + esac; \ + done; \ + test $$has_opt = yes +am__make_dryrun = (target_option=n; $(am__make_running_with_option)) +am__make_keepgoing = (target_option=k; $(am__make_running_with_option)) +pkgdatadir = $(datadir)/@PACKAGE@ +pkgincludedir = $(includedir)/@PACKAGE@ +pkglibdir = $(libdir)/@PACKAGE@ +pkglibexecdir = $(libexecdir)/@PACKAGE@ +am__cd = CDPATH="$${ZSH_VERSION+.}$(PATH_SEPARATOR)" && cd +install_sh_DATA = $(install_sh) -c -m 644 +install_sh_PROGRAM = $(install_sh) -c +install_sh_SCRIPT = $(install_sh) -c +INSTALL_HEADER = $(INSTALL_DATA) +transform = $(program_transform_name) +NORMAL_INSTALL = : +PRE_INSTALL = : +POST_INSTALL = : +NORMAL_UNINSTALL = : +PRE_UNINSTALL = : +POST_UNINSTALL = : +build_triplet = @build@ +host_triplet = @host@ +subdir = stub +DIST_COMMON = $(srcdir)/Makefile.in $(srcdir)/Makefile.am \ + $(top_srcdir)/depcomp README +ACLOCAL_M4 = $(top_srcdir)/aclocal.m4 +am__aclocal_m4_deps = $(top_srcdir)/acinclude.m4 \ + $(top_srcdir)/configure.ac +am__configure_deps = $(am__aclocal_m4_deps) $(CONFIGURE_DEPENDENCIES) \ + $(ACLOCAL_M4) +mkinstalldirs = $(install_sh) -d +CONFIG_HEADER = $(top_builddir)/config.h +CONFIG_CLEAN_FILES = +CONFIG_CLEAN_VPATH_FILES = +LIBRARIES = $(noinst_LIBRARIES) +AR = ar +ARFLAGS = cru +AM_V_AR = $(am__v_AR_@AM_V@) +am__v_AR_ = $(am__v_AR_@AM_DEFAULT_V@) +am__v_AR_0 = @echo " AR " $@; +am__v_AR_1 = +libstub_a_AR = $(AR) $(ARFLAGS) +libstub_a_LIBADD = +am_libstub_a_OBJECTS = stub.$(OBJEXT) +libstub_a_OBJECTS = $(am_libstub_a_OBJECTS) +AM_V_P = $(am__v_P_@AM_V@) +am__v_P_ = $(am__v_P_@AM_DEFAULT_V@) +am__v_P_0 = false +am__v_P_1 = : +AM_V_GEN = $(am__v_GEN_@AM_V@) +am__v_GEN_ = $(am__v_GEN_@AM_DEFAULT_V@) +am__v_GEN_0 = @echo " GEN " $@; +am__v_GEN_1 = +AM_V_at = $(am__v_at_@AM_V@) +am__v_at_ = $(am__v_at_@AM_DEFAULT_V@) +am__v_at_0 = @ +am__v_at_1 = +DEFAULT_INCLUDES = -I.@am__isrc@ -I$(top_builddir) +depcomp = $(SHELL) $(top_srcdir)/depcomp +am__depfiles_maybe = depfiles +am__mv = mv -f +COMPILE = $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) \ + $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) +AM_V_CC = $(am__v_CC_@AM_V@) +am__v_CC_ = $(am__v_CC_@AM_DEFAULT_V@) +am__v_CC_0 = @echo " CC " $@; +am__v_CC_1 = +CCLD = $(CC) +LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(AM_LDFLAGS) $(LDFLAGS) -o $@ +AM_V_CCLD = $(am__v_CCLD_@AM_V@) +am__v_CCLD_ = $(am__v_CCLD_@AM_DEFAULT_V@) +am__v_CCLD_0 = @echo " CCLD " $@; +am__v_CCLD_1 = +SOURCES = $(libstub_a_SOURCES) +DIST_SOURCES = $(libstub_a_SOURCES) +am__can_run_installinfo = \ + case $$AM_UPDATE_INFO_DIR in \ + n|no|NO) false;; \ + *) (install-info --version) >/dev/null 2>&1;; \ + esac +am__tagged_files = $(HEADERS) $(SOURCES) $(TAGS_FILES) $(LISP) +# Read a list of newline-separated strings from the standard input, +# and print each of them once, without duplicates. Input order is +# *not* preserved. +am__uniquify_input = $(AWK) '\ + BEGIN { nonempty = 0; } \ + { items[$$0] = 1; nonempty = 1; } \ + END { if (nonempty) { for (i in items) print i; }; } \ +' +# Make sure the list of sources is unique. This is necessary because, +# e.g., the same source file might be shared among _SOURCES variables +# for different programs/libraries. +am__define_uniq_tagged_files = \ + list='$(am__tagged_files)'; \ + unique=`for i in $$list; do \ + if test -f "$$i"; then echo $$i; else echo $(srcdir)/$$i; fi; \ + done | $(am__uniquify_input)` +ETAGS = etags +CTAGS = ctags +DISTFILES = $(DIST_COMMON) $(DIST_SOURCES) $(TEXINFOS) $(EXTRA_DIST) +ACLOCAL = @ACLOCAL@ +AMTAR = @AMTAR@ +AM_DEFAULT_VERBOSITY = @AM_DEFAULT_VERBOSITY@ +AUTOCONF = @AUTOCONF@ +AUTOHEADER = @AUTOHEADER@ +AUTOMAKE = @AUTOMAKE@ +AWK = @AWK@ +CC = @CC@ +CCDEPMODE = @CCDEPMODE@ +CFLAGS = @CFLAGS@ +CLISP = @CLISP@ +CPP = @CPP@ +CPPFLAGS = @CPPFLAGS@ +CYGPATH_W = @CYGPATH_W@ +DEFS = @DEFS@ +DEPDIR = @DEPDIR@ +ECHO_C = @ECHO_C@ +ECHO_N = @ECHO_N@ +ECHO_T = @ECHO_T@ +EGREP = @EGREP@ +EXEEXT = @EXEEXT@ +GREP = @GREP@ +INSTALL = @INSTALL@ +INSTALL_DATA = @INSTALL_DATA@ +INSTALL_PROGRAM = @INSTALL_PROGRAM@ +INSTALL_SCRIPT = @INSTALL_SCRIPT@ +INSTALL_STRIP_PROGRAM = @INSTALL_STRIP_PROGRAM@ +LDFLAGS = @LDFLAGS@ +LIBOBJS = @LIBOBJS@ +LIBS = @LIBS@ +LTLIBOBJS = @LTLIBOBJS@ +MAKEINFO = @MAKEINFO@ +MKDIR_P = @MKDIR_P@ +OBJEXT = @OBJEXT@ +PACKAGE = @PACKAGE@ +PACKAGE_BUGREPORT = @PACKAGE_BUGREPORT@ +PACKAGE_NAME = @PACKAGE_NAME@ +PACKAGE_STRING = @PACKAGE_STRING@ +PACKAGE_TARNAME = @PACKAGE_TARNAME@ +PACKAGE_URL = @PACKAGE_URL@ +PACKAGE_VERSION = @PACKAGE_VERSION@ +PATH_SEPARATOR = @PATH_SEPARATOR@ +PTHREAD_CC = @PTHREAD_CC@ +PTHREAD_CFLAGS = @PTHREAD_CFLAGS@ +PTHREAD_LIBS = @PTHREAD_LIBS@ +RANLIB = @RANLIB@ +SET_MAKE = @SET_MAKE@ +SHELL = @SHELL@ +STRIP = @STRIP@ +VERSION = @VERSION@ +XMKMF = @XMKMF@ +abs_builddir = @abs_builddir@ +abs_srcdir = @abs_srcdir@ +abs_top_builddir = @abs_top_builddir@ +abs_top_srcdir = @abs_top_srcdir@ +ac_ct_CC = @ac_ct_CC@ +acx_pthread_config = @acx_pthread_config@ +am__include = @am__include@ +am__leading_dot = @am__leading_dot@ +am__quote = @am__quote@ +am__tar = @am__tar@ +am__untar = @am__untar@ +bindir = @bindir@ +build = @build@ +build_alias = @build_alias@ +build_cpu = @build_cpu@ +build_os = @build_os@ +build_vendor = @build_vendor@ +builddir = @builddir@ +datadir = @datadir@ +datarootdir = @datarootdir@ +docdir = @docdir@ +dvidir = @dvidir@ +exec_prefix = @exec_prefix@ +host = @host@ +host_alias = @host_alias@ +host_cpu = @host_cpu@ +host_os = @host_os@ +host_vendor = @host_vendor@ +htmldir = @htmldir@ +includedir = @includedir@ +infodir = @infodir@ +install_sh = @install_sh@ +libdir = @libdir@ +libexecdir = @libexecdir@ +localedir = @localedir@ +localstatedir = @localstatedir@ +mandir = @mandir@ +mkdir_p = @mkdir_p@ +oldincludedir = @oldincludedir@ +pdfdir = @pdfdir@ +prefix = @prefix@ +program_transform_name = @program_transform_name@ +psdir = @psdir@ +sbindir = @sbindir@ +sharedstatedir = @sharedstatedir@ +srcdir = @srcdir@ +sysconfdir = @sysconfdir@ +target_alias = @target_alias@ +top_build_prefix = @top_build_prefix@ +top_builddir = @top_builddir@ +top_srcdir = @top_srcdir@ +AM_CPPFLAGS = -I/usr/X11R6/include -I. -I@abs_top_srcdir@/include -I@abs_top_srcdir@/life-support -I@abs_top_srcdir@/emulator -I@abs_top_srcdir@/x86_64-emulator + +# +# no warnings for labels in stub.c i*.c, pls +# +AM_CFLAGS = -Wall -Wno-unused-label -Wno-unused-function +noinst_LIBRARIES = libstub.a +libstub_a_SOURCES = stub.c +all: all-am + +.SUFFIXES: +.SUFFIXES: .c .o .obj +$(srcdir)/Makefile.in: $(srcdir)/Makefile.am $(am__configure_deps) + @for dep in $?; do \ + case '$(am__configure_deps)' in \ + *$$dep*) \ + ( cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh ) \ + && { if test -f $@; then exit 0; else break; fi; }; \ + exit 1;; \ + esac; \ + done; \ + echo ' cd $(top_srcdir) && $(AUTOMAKE) --gnu stub/Makefile'; \ + $(am__cd) $(top_srcdir) && \ + $(AUTOMAKE) --gnu stub/Makefile +.PRECIOUS: Makefile +Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status + @case '$?' in \ + *config.status*) \ + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh;; \ + *) \ + echo ' cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe)'; \ + cd $(top_builddir) && $(SHELL) ./config.status $(subdir)/$@ $(am__depfiles_maybe);; \ + esac; + +$(top_builddir)/config.status: $(top_srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh + +$(top_srcdir)/configure: $(am__configure_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(ACLOCAL_M4): $(am__aclocal_m4_deps) + cd $(top_builddir) && $(MAKE) $(AM_MAKEFLAGS) am--refresh +$(am__aclocal_m4_deps): + +clean-noinstLIBRARIES: + -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES) + +libstub.a: $(libstub_a_OBJECTS) $(libstub_a_DEPENDENCIES) $(EXTRA_libstub_a_DEPENDENCIES) + $(AM_V_at)-rm -f libstub.a + $(AM_V_AR)$(libstub_a_AR) libstub.a $(libstub_a_OBJECTS) $(libstub_a_LIBADD) + $(AM_V_at)$(RANLIB) libstub.a + +mostlyclean-compile: + -rm -f *.$(OBJEXT) + +distclean-compile: + -rm -f *.tab.c + +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/stub.Po@am__quote@ + +.c.o: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ $< +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c $< + +.c.obj: +@am__fastdepCC_TRUE@ $(AM_V_CC)$(COMPILE) -MT $@ -MD -MP -MF $(DEPDIR)/$*.Tpo -c -o $@ `$(CYGPATH_W) '$<'` +@am__fastdepCC_TRUE@ $(AM_V_at)$(am__mv) $(DEPDIR)/$*.Tpo $(DEPDIR)/$*.Po +@AMDEP_TRUE@@am__fastdepCC_FALSE@ $(AM_V_CC)source='$<' object='$@' libtool=no @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(AM_V_CC@am__nodep@)$(COMPILE) -c `$(CYGPATH_W) '$<'` + +ID: $(am__tagged_files) + $(am__define_uniq_tagged_files); mkid -fID $$unique +tags: tags-am +TAGS: tags + +tags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + set x; \ + here=`pwd`; \ + $(am__define_uniq_tagged_files); \ + shift; \ + if test -z "$(ETAGS_ARGS)$$*$$unique"; then :; else \ + test -n "$$unique" || unique=$$empty_fix; \ + if test $$# -gt 0; then \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + "$$@" $$unique; \ + else \ + $(ETAGS) $(ETAGSFLAGS) $(AM_ETAGSFLAGS) $(ETAGS_ARGS) \ + $$unique; \ + fi; \ + fi +ctags: ctags-am + +CTAGS: ctags +ctags-am: $(TAGS_DEPENDENCIES) $(am__tagged_files) + $(am__define_uniq_tagged_files); \ + test -z "$(CTAGS_ARGS)$$unique" \ + || $(CTAGS) $(CTAGSFLAGS) $(AM_CTAGSFLAGS) $(CTAGS_ARGS) \ + $$unique + +GTAGS: + here=`$(am__cd) $(top_builddir) && pwd` \ + && $(am__cd) $(top_srcdir) \ + && gtags -i $(GTAGS_ARGS) "$$here" +cscopelist: cscopelist-am + +cscopelist-am: $(am__tagged_files) + list='$(am__tagged_files)'; \ + case "$(srcdir)" in \ + [\\/]* | ?:[\\/]*) sdir="$(srcdir)" ;; \ + *) sdir=$(subdir)/$(srcdir) ;; \ + esac; \ + for i in $$list; do \ + if test -f "$$i"; then \ + echo "$(subdir)/$$i"; \ + else \ + echo "$$sdir/$$i"; \ + fi; \ + done >> $(top_builddir)/cscope.files + +distclean-tags: + -rm -f TAGS ID GTAGS GRTAGS GSYMS GPATH tags + +distdir: $(DISTFILES) + @srcdirstrip=`echo "$(srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + topsrcdirstrip=`echo "$(top_srcdir)" | sed 's/[].[^$$\\*]/\\\\&/g'`; \ + list='$(DISTFILES)'; \ + dist_files=`for file in $$list; do echo $$file; done | \ + sed -e "s|^$$srcdirstrip/||;t" \ + -e "s|^$$topsrcdirstrip/|$(top_builddir)/|;t"`; \ + case $$dist_files in \ + */*) $(MKDIR_P) `echo "$$dist_files" | \ + sed '/\//!d;s|^|$(distdir)/|;s,/[^/]*$$,,' | \ + sort -u` ;; \ + esac; \ + for file in $$dist_files; do \ + if test -f $$file || test -d $$file; then d=.; else d=$(srcdir); fi; \ + if test -d $$d/$$file; then \ + dir=`echo "/$$file" | sed -e 's,/[^/]*$$,,'`; \ + if test -d "$(distdir)/$$file"; then \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + if test -d $(srcdir)/$$file && test $$d != $(srcdir); then \ + cp -fpR $(srcdir)/$$file "$(distdir)$$dir" || exit 1; \ + find "$(distdir)/$$file" -type d ! -perm -700 -exec chmod u+rwx {} \;; \ + fi; \ + cp -fpR $$d/$$file "$(distdir)$$dir" || exit 1; \ + else \ + test -f "$(distdir)/$$file" \ + || cp -p $$d/$$file "$(distdir)/$$file" \ + || exit 1; \ + fi; \ + done +check-am: all-am +check: check-am +all-am: Makefile $(LIBRARIES) +installdirs: +install: install-am +install-exec: install-exec-am +install-data: install-data-am +uninstall: uninstall-am + +install-am: all-am + @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am + +installcheck: installcheck-am +install-strip: + if test -z '$(STRIP)'; then \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + install; \ + else \ + $(MAKE) $(AM_MAKEFLAGS) INSTALL_PROGRAM="$(INSTALL_STRIP_PROGRAM)" \ + install_sh_PROGRAM="$(INSTALL_STRIP_PROGRAM)" INSTALL_STRIP_FLAG=-s \ + "INSTALL_PROGRAM_ENV=STRIPPROG='$(STRIP)'" install; \ + fi +mostlyclean-generic: + +clean-generic: + +distclean-generic: + -test -z "$(CONFIG_CLEAN_FILES)" || rm -f $(CONFIG_CLEAN_FILES) + -test . = "$(srcdir)" || test -z "$(CONFIG_CLEAN_VPATH_FILES)" || rm -f $(CONFIG_CLEAN_VPATH_FILES) + +maintainer-clean-generic: + @echo "This command is intended for maintainers to use" + @echo "it deletes files that may require special tools to rebuild." +clean: clean-am + +clean-am: clean-generic clean-local clean-noinstLIBRARIES \ + mostlyclean-am + +distclean: distclean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +distclean-am: clean-am distclean-compile distclean-generic \ + distclean-tags + +dvi: dvi-am + +dvi-am: + +html: html-am + +html-am: + +info: info-am + +info-am: + +install-data-am: + +install-dvi: install-dvi-am + +install-dvi-am: + +install-exec-am: + +install-html: install-html-am + +install-html-am: + +install-info: install-info-am + +install-info-am: + +install-man: + +install-pdf: install-pdf-am + +install-pdf-am: + +install-ps: install-ps-am + +install-ps-am: + +installcheck-am: + +maintainer-clean: maintainer-clean-am + -rm -rf ./$(DEPDIR) + -rm -f Makefile +maintainer-clean-am: distclean-am maintainer-clean-generic + +mostlyclean: mostlyclean-am + +mostlyclean-am: mostlyclean-compile mostlyclean-generic + +pdf: pdf-am + +pdf-am: + +ps: ps-am + +ps-am: + +uninstall-am: + +.MAKE: install-am install-strip + +.PHONY: CTAGS GTAGS TAGS all all-am check check-am clean clean-generic \ + clean-local clean-noinstLIBRARIES cscopelist-am ctags ctags-am \ + distclean distclean-compile distclean-generic distclean-tags \ + distdir dvi dvi-am html html-am info info-am install \ + install-am install-data install-data-am install-dvi \ + install-dvi-am install-exec install-exec-am install-html \ + install-html-am install-info install-info-am install-man \ + install-pdf install-pdf-am install-ps install-ps-am \ + install-strip installcheck installcheck-am installdirs \ + maintainer-clean maintainer-clean-generic mostlyclean \ + mostlyclean-compile mostlyclean-generic pdf pdf-am ps ps-am \ + tags tags-am uninstall uninstall-am + + +stub.o: blanks.c @abs_top_srcdir@/stub/i*.c float2 dispatch stub.c clisp-support.lisp process.lisp + +@abs_top_srcdir@/stub/i*.c: @abs_top_srcdir@/alpha-emulator/*.as @abs_top_srcdir@/alpha-emulator/*.lisp @abs_top_srcdir@/alpha-emulator/*.c @abs_top_srcdir@/alpha-emulator/*.h @abs_top_srcdir@/emulator/aihead* @abs_top_srcdir@/stub/*.lisp @abs_top_srcdir@/assembler/*.lisp +@HCLISP_TRUE@ $(CLISP) process.lisp +@HCLISP_FALSE@ @echo +@HCLISP_FALSE@ @echo "you don't seem to have clisp installed. Unable to compile $< to $@" +@HCLISP_FALSE@ @echo +@HCLISP_FALSE@ @exit -1 + +clean-local: clean-local-check +.PHONY: clean-local-check +clean-local-check: + rm -f *~ .*~ + +# Tell versions [3.59,3.63) of GNU make to not export all variables. +# Otherwise a system limit (for SysV at least) may be exceeded. +.NOEXPORT: diff --git a/stub/README b/stub/README new file mode 100644 index 0000000..50e917f --- /dev/null +++ b/stub/README @@ -0,0 +1,4 @@ + +clisp process.lisp + +generates "xoutput" files; compare with makediff.sh diff --git a/stub/blanks.c b/stub/blanks.c new file mode 100644 index 0000000..48f0a86 --- /dev/null +++ b/stub/blanks.c @@ -0,0 +1,837 @@ + +void fake_decodefault() { printf("DECODEFAULT!\n"); while (1); } +void *DECODEFAULT = &fake_decodefault; +void fake_icachemiss() { printf("ICACHEMISS\n"); while (1); } +void *ICACHEMISS = &fake_icachemiss; + + +void ARITHMETICEXCEPTION () { printf("ARITHMETICEXCEPTION!\n"); while(1); } +//void DECODEFAULT () { printf("DECODEFAULT!\n"); while (1); } + +void resumeemulated () { printf("resumeemulated\n"); } +void CarCdrSubroutine () { printf("CarCdrSubroutine\n"); } +void CarSubroutine () { printf("CarSubroutine\n"); } +void CdrSubroutine () { printf("CdrSubroutine\n"); } + +void boundlocationfw () { } +void callcompiledeven () { } +void callcompiledevenprefetch () { } +void callcompiledodd () { } +void callcompiledoddprefetch () { } +void callgeneric () { } +void callgenericprefetch () { } +void callindirect () { } +void callindirectprefetch () { } +void elementforwardfw () { } +void gcforwardfw () { } +void headerforwardfw () { } +void headerifw () { } +void headerpfw () { } +void logicvariablefw () { } +void monitorforwardfw () { } +void nativeinstruction () { } +void nullfw () { } +void oneqforwardfw () { } +void pushconstantvalue () { } +void valuecell () { } + +void Do32BitDifferenceFP () { } +void Do32BitDifferenceIM () { } +void Do32BitDifferenceLP () { } +void Do32BitDifferenceSP () { } +void Do32BitPlusFP () { } +void Do32BitPlusIM () { } +void Do32BitPlusLP () { } +void Do32BitPlusSP () { } +void DoAddBignumStepFP () { } +void DoAddBignumStepIM () { } +void DoAddBignumStepLP () { } +void DoAddBignumStepSP () { } +void DoAddFP () { } +void DoAddIM () { } +void DoAddLP () { } +void DoAddSP () { } +void DoAllocateListBlockFP () { } +void DoAllocateListBlockIM () { } +void DoAllocateListBlockLP () { } +void DoAllocateListBlockSP () { } +void DoAllocateStructureBlockFP () { } +void DoAllocateStructureBlockIM () { } +void DoAllocateStructureBlockLP () { } +void DoAllocateStructureBlockSP () { } +void DoAloc1FP () { } +void DoAloc1IM () { } +void DoAloc1LP () { } +void DoAloc1SP () { } +void DoAlocLeaderFP () { } +void DoAlocLeaderIM () { } +void DoAlocLeaderLP () { } +void DoAlocLeaderSP () { } +void DoAluFP () { } +void DoAluIM () { } +void DoAluLP () { } +void DoAluSP () { } +void DoAref1FP () { } +void DoAref1IM () { } +void DoAref1LP () { } +void DoAref1SP () { } +void DoArrayLeaderFP () { } +void DoArrayLeaderIM () { } +void DoArrayLeaderLP () { } +void DoArrayLeaderSP () { } +void DoAset1FP () { } +void DoAset1IM () { } +void DoAset1LP () { } +void DoAset1SP () { } +void DoAshFP () { } +void DoAshIM () { } +void DoAshLP () { } +void DoAshSP () { } +void DoAssocFP () { } +void DoAssocIM () { } +void DoAssocLP () { } +void DoAssocSP () { } +void DoBindLocativeFP () { } +void DoBindLocativeIM () { } +void DoBindLocativeLP () { } +void DoBindLocativeSP () { } +void DoBindLocativeToValueFP () { } +void DoBindLocativeToValueIM () { } +void DoBindLocativeToValueLP () { } +void DoBindLocativeToValueSP () { } +void DoBlock0ReadAluFP () { } +void DoBlock0ReadAluIM () { } +void DoBlock0ReadAluLP () { } +void DoBlock0ReadAluSP () { } +void DoBlock0ReadFP () { } +void DoBlock0ReadIM () { } +void DoBlock0ReadLP () { } +void DoBlock0ReadSP () { } +void DoBlock0ReadShiftFP () { } +void DoBlock0ReadShiftIM () { } +void DoBlock0ReadShiftLP () { } +void DoBlock0ReadShiftSP () { } +void DoBlock0ReadTestFP () { } +void DoBlock0ReadTestIM () { } +void DoBlock0ReadTestLP () { } +void DoBlock0ReadTestSP () { } +void DoBlock0WriteFP () { } +void DoBlock0WriteIM () { } +void DoBlock0WriteLP () { } +void DoBlock0WriteSP () { } +void DoBlock1ReadAluFP () { } +void DoBlock1ReadAluIM () { } +void DoBlock1ReadAluLP () { } +void DoBlock1ReadAluSP () { } +void DoBlock1ReadFP () { } +void DoBlock1ReadIM () { } +void DoBlock1ReadLP () { } +void DoBlock1ReadSP () { } +void DoBlock1ReadShiftFP () { } +void DoBlock1ReadShiftIM () { } +void DoBlock1ReadShiftLP () { } +void DoBlock1ReadShiftSP () { } +void DoBlock1ReadTestFP () { } +void DoBlock1ReadTestIM () { } +void DoBlock1ReadTestLP () { } +void DoBlock1ReadTestSP () { } +void DoBlock1WriteFP () { } +void DoBlock1WriteIM () { } +void DoBlock1WriteLP () { } +void DoBlock1WriteSP () { } +void DoBlock2ReadAluFP () { } +void DoBlock2ReadAluIM () { } +void DoBlock2ReadAluLP () { } +void DoBlock2ReadAluSP () { } +void DoBlock2ReadFP () { } +void DoBlock2ReadIM () { } +void DoBlock2ReadLP () { } +void DoBlock2ReadSP () { } +void DoBlock2ReadShiftFP () { } +void DoBlock2ReadShiftIM () { } +void DoBlock2ReadShiftLP () { } +void DoBlock2ReadShiftSP () { } +void DoBlock2ReadTestFP () { } +void DoBlock2ReadTestIM () { } +void DoBlock2ReadTestLP () { } +void DoBlock2ReadTestSP () { } +void DoBlock2WriteFP () { } +void DoBlock2WriteIM () { } +void DoBlock2WriteLP () { } +void DoBlock2WriteSP () { } +void DoBlock3ReadAluFP () { } +void DoBlock3ReadAluIM () { } +void DoBlock3ReadAluLP () { } +void DoBlock3ReadAluSP () { } +void DoBlock3ReadFP () { } +void DoBlock3ReadIM () { } +void DoBlock3ReadLP () { } +void DoBlock3ReadSP () { } +void DoBlock3ReadShiftFP () { } +void DoBlock3ReadShiftIM () { } +void DoBlock3ReadShiftLP () { } +void DoBlock3ReadShiftSP () { } +void DoBlock3ReadTestFP () { } +void DoBlock3ReadTestIM () { } +void DoBlock3ReadTestLP () { } +void DoBlock3ReadTestSP () { } +void DoBlock3WriteFP () { } +void DoBlock3WriteIM () { } +void DoBlock3WriteLP () { } +void DoBlock3WriteSP () { } +void DoBranchFP () { } +void DoBranchFalseAndExtraPopFP () { } +void DoBranchFalseAndExtraPopIM () { } +void DoBranchFalseAndExtraPopLP () { } +void DoBranchFalseAndExtraPopSP () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopFP () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopIM () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopLP () { } +void DoBranchFalseAndNoPopElseNoPopExtraPopSP () { } +void DoBranchFalseAndNoPopFP () { } +void DoBranchFalseAndNoPopIM () { } +void DoBranchFalseAndNoPopLP () { } +void DoBranchFalseAndNoPopSP () { } +void DoBranchFalseElseExtraPopFP () { } +void DoBranchFalseElseExtraPopIM () { } +void DoBranchFalseElseExtraPopLP () { } +void DoBranchFalseElseExtraPopSP () { } +void DoBranchFalseElseNoPopFP () { } +void DoBranchFalseElseNoPopIM () { } +void DoBranchFalseElseNoPopLP () { } +void DoBranchFalseElseNoPopSP () { } +void DoBranchFalseExtraPopFP () { } +void DoBranchFalseExtraPopIM () { } +void DoBranchFalseExtraPopLP () { } +void DoBranchFalseExtraPopSP () { } +void DoBranchFalseFP () { } +void DoBranchFalseIM () { } +void DoBranchFalseLP () { } +void DoBranchFalseNoPopFP () { } +void DoBranchFalseNoPopIM () { } +void DoBranchFalseNoPopLP () { } +void DoBranchFalseNoPopSP () { } +void DoBranchFalseSP () { } +void DoBranchIM () { } +void DoBranchLP () { } +void DoBranchSP () { } +void DoBranchTrueAndExtraPopFP () { } +void DoBranchTrueAndExtraPopIM () { } +void DoBranchTrueAndExtraPopLP () { } +void DoBranchTrueAndExtraPopSP () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopFP () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopIM () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopLP () { } +void DoBranchTrueAndNoPopElseNoPopExtraPopSP () { } +void DoBranchTrueAndNoPopFP () { } +void DoBranchTrueAndNoPopIM () { } +void DoBranchTrueAndNoPopLP () { } +void DoBranchTrueAndNoPopSP () { } +void DoBranchTrueElseExtraPopFP () { } +void DoBranchTrueElseExtraPopIM () { } +void DoBranchTrueElseExtraPopLP () { } +void DoBranchTrueElseExtraPopSP () { } +void DoBranchTrueElseNoPopFP () { } +void DoBranchTrueElseNoPopIM () { } +void DoBranchTrueElseNoPopLP () { } +void DoBranchTrueElseNoPopSP () { } +void DoBranchTrueExtraPopFP () { } +void DoBranchTrueExtraPopIM () { } +void DoBranchTrueExtraPopLP () { } +void DoBranchTrueExtraPopSP () { } +void DoBranchTrueFP () { } +void DoBranchTrueIM () { } +void DoBranchTrueLP () { } +void DoBranchTrueNoPopFP () { } +void DoBranchTrueNoPopIM () { } +void DoBranchTrueNoPopLP () { } +void DoBranchTrueNoPopSP () { } +void DoBranchTrueSP () { } +void DoCarFP () { } +void DoCarIM () { } +void DoCarLP () { } +void DoCarSP () { } +void DoCatchCloseFP () { } +void DoCatchCloseIM () { } +void DoCatchCloseLP () { } +void DoCatchCloseSP () { } +void DoCatchOpenFP () { } +void DoCatchOpenIM () { } +void DoCatchOpenLP () { } +void DoCatchOpenSP () { } +void DoCdrFP () { } +void DoCdrIM () { } +void DoCdrLP () { } +void DoCdrSP () { } +void DoCeilingFP () { } +void DoCeilingIM () { } +void DoCeilingLP () { } +void DoCeilingSP () { } +void DoCharDpbFP () { } +void DoCharDpbIM () { } +void DoCharDpbLP () { } +void DoCharDpbSP () { } +void DoCharLdbFP () { } +void DoCharLdbIM () { } +void DoCharLdbLP () { } +void DoCharLdbSP () { } +void DoCheckPreemptRequestFP () { } +void DoCheckPreemptRequestIM () { } +void DoCheckPreemptRequestLP () { } +void DoCheckPreemptRequestSP () { } +void DoCoprocessorReadFP () { } +void DoCoprocessorReadIM () { } +void DoCoprocessorReadLP () { } +void DoCoprocessorReadSP () { } +void DoCoprocessorWriteFP () { } +void DoCoprocessorWriteIM () { } +void DoCoprocessorWriteLP () { } +void DoCoprocessorWriteSP () { } +void DoDecrementFP () { } +void DoDecrementIM () { } +void DoDecrementLP () { } +void DoDecrementSP () { } +void DoDereferenceFP () { } +void DoDereferenceIM () { } +void DoDereferenceLP () { } +void DoDereferenceSP () { } +void DoDivideBignumStepFP () { } +void DoDivideBignumStepIM () { } +void DoDivideBignumStepLP () { } +void DoDivideBignumStepSP () { } +void DoDoubleFloatOpFP () { } +void DoDoubleFloatOpIM () { } +void DoDoubleFloatOpLP () { } +void DoDoubleFloatOpSP () { } +void DoDpbFP () { } +void DoDpbIM () { } +void DoDpbLP () { } +void DoDpbSP () { } +void DoEndpFP () { } +void DoEndpIM () { } +void DoEndpLP () { } +void DoEndpSP () { } +void DoEntryRestAcceptedFP () { } +void DoEntryRestAcceptedIM () { } +void DoEntryRestAcceptedLP () { } +void DoEntryRestAcceptedSP () { } +void DoEntryRestNotAcceptedFP () { } +void DoEntryRestNotAcceptedIM () { } +void DoEntryRestNotAcceptedLP () { } +void DoEntryRestNotAcceptedSP () { } +void DoEphemeralpFP () { } +void DoEphemeralpIM () { } +void DoEphemeralpLP () { } +void DoEphemeralpSP () { } +void DoEqFP () { } +void DoEqIM () { } +void DoEqLP () { } +void DoEqSP () { } +void DoEqlFP () { } +void DoEqlIM () { } +void DoEqlLP () { } +void DoEqlSP () { } +void DoEqualNumberFP () { } +void DoEqualNumberIM () { } +void DoEqualNumberLP () { } +void DoEqualNumberSP () { } +void DoFastAref1FP () { } +void DoFastAref1IM () { } +void DoFastAref1LP () { } +void DoFastAref1SP () { } +void DoFastAset1FP () { } +void DoFastAset1IM () { } +void DoFastAset1LP () { } +void DoFastAset1SP () { } +void DoFinishCallNFP () { } +void DoFinishCallNIM () { } +void DoFinishCallNLP () { } +void DoFinishCallNSP () { } +void DoFinishCallTosFP () { } +void DoFinishCallTosIM () { } +void DoFinishCallTosLP () { } +void DoFinishCallTosSP () { } +void DoFloorFP () { } +void DoFloorIM () { } +void DoFloorLP () { } +void DoFloorSP () { } +void DoGenericDispatchFP () { } +void DoGenericDispatchIM () { } +void DoGenericDispatchLP () { } +void DoGenericDispatchSP () { } +void DoGreaterpFP () { } +void DoGreaterpIM () { } +void DoGreaterpLP () { } +void DoGreaterpSP () { } +void DoHaltFP () { } +void DoHaltIM () { } +void DoHaltLP () { } +void DoHaltSP () { } +void DoIStageError () { } +void DoIncrementFP () { } +void DoIncrementIM () { } +void DoIncrementLP () { } +void DoIncrementSP () { } +void DoInstanceLocFP () { } +void DoInstanceLocIM () { } +void DoInstanceLocLP () { } +void DoInstanceLocSP () { } +void DoInstanceRefFP () { } +void DoInstanceRefIM () { } +void DoInstanceRefLP () { } +void DoInstanceRefSP () { } +void DoInstanceSetFP () { } +void DoInstanceSetIM () { } +void DoInstanceSetLP () { } +void DoInstanceSetSP () { } +void DoJumpFP () { } +void DoJumpIM () { } +void DoJumpLP () { } +void DoJumpSP () { } +void DoLdbFP () { } +void DoLdbIM () { } +void DoLdbLP () { } +void DoLdbSP () { } +void DoLesspFP () { } +void DoLesspIM () { } +void DoLesspLP () { } +void DoLesspSP () { } +void DoLocateLocalsFP () { } +void DoLocateLocalsIM () { } +void DoLocateLocalsLP () { } +void DoLocateLocalsSP () { } +void DoLogandFP () { } +void DoLogandIM () { } +void DoLogandLP () { } +void DoLogandSP () { } +void DoLogicTailTestFP () { } +void DoLogicTailTestIM () { } +void DoLogicTailTestLP () { } +void DoLogicTailTestSP () { } +void DoLogiorFP () { } +void DoLogiorIM () { } +void DoLogiorLP () { } +void DoLogiorSP () { } +void DoLogtestFP () { } +void DoLogtestIM () { } +void DoLogtestLP () { } +void DoLogtestSP () { } +void DoLogxorFP () { } +void DoLogxorIM () { } +void DoLogxorLP () { } +void DoLogxorSP () { } +void DoLoopDecrementTosFP () { } +void DoLoopDecrementTosIM () { } +void DoLoopDecrementTosLP () { } +void DoLoopDecrementTosSP () { } +void DoLoopIncrementTosLessThanFP () { } +void DoLoopIncrementTosLessThanIM () { } +void DoLoopIncrementTosLessThanLP () { } +void DoLoopIncrementTosLessThanSP () { } +void DoLshFP () { } +void DoLshIM () { } +void DoLshLP () { } +void DoLshSP () { } +void DoLshcBignumStepFP () { } +void DoLshcBignumStepIM () { } +void DoLshcBignumStepLP () { } +void DoLshcBignumStepSP () { } +void DoMaxFP () { } +void DoMaxIM () { } +void DoMaxLP () { } +void DoMaxSP () { } +void DoMemberFP () { } +void DoMemberIM () { } +void DoMemberLP () { } +void DoMemberSP () { } +void DoMemoryReadFP () { } +void DoMemoryReadIM () { } +void DoMemoryReadLP () { } +void DoMemoryReadSP () { } +void DoMemoryWriteFP () { } +void DoMemoryWriteIM () { } +void DoMemoryWriteLP () { } +void DoMemoryWriteSP () { } +void DoMergeCdrNoPopFP () { } +void DoMergeCdrNoPopIM () { } +void DoMergeCdrNoPopLP () { } +void DoMergeCdrNoPopSP () { } +void DoMessageDispatchFP () { } +void DoMessageDispatchIM () { } +void DoMessageDispatchLP () { } +void DoMessageDispatchSP () { } +void DoMinFP () { } +void DoMinIM () { } +void DoMinLP () { } +void DoMinSP () { } +void DoMinuspFP () { } +void DoMinuspIM () { } +void DoMinuspLP () { } +void DoMinuspSP () { } +void DoMovemFP () { } +void DoMovemIM () { } +void DoMovemInstanceVariableFP () { } +void DoMovemInstanceVariableIM () { } +void DoMovemInstanceVariableLP () { } +void DoMovemInstanceVariableOrderedFP () { } +void DoMovemInstanceVariableOrderedIM () { } +void DoMovemInstanceVariableOrderedLP () { } +void DoMovemInstanceVariableOrderedSP () { } +void DoMovemInstanceVariableSP () { } +void DoMovemLP () { } +void DoMovemLexicalVarNFP () { } +void DoMovemLexicalVarNIM () { } +void DoMovemLexicalVarNLP () { } +void DoMovemLexicalVarNSP () { } +void DoMovemSP () { } +void DoMultiplyBignumStepFP () { } +void DoMultiplyBignumStepIM () { } +void DoMultiplyBignumStepLP () { } +void DoMultiplyBignumStepSP () { } +void DoMultiplyDoubleFP () { } +void DoMultiplyDoubleIM () { } +void DoMultiplyDoubleLP () { } +void DoMultiplyDoubleSP () { } +void DoMultiplyFP () { } +void DoMultiplyIM () { } +void DoMultiplyLP () { } +void DoMultiplySP () { } +void DoNoOpFP () { } +void DoNoOpIM () { } +void DoNoOpLP () { } +void DoNoOpSP () { } +void DoPDpbFP () { } +void DoPDpbIM () { } +void DoPDpbLP () { } +void DoPDpbSP () { } +void DoPLdbFP () { } +void DoPLdbIM () { } +void DoPLdbLP () { } +void DoPLdbSP () { } +void DoPStoreContentsFP () { } +void DoPStoreContentsIM () { } +void DoPStoreContentsLP () { } +void DoPStoreContentsSP () { } +void DoPTagDpbFP () { } +void DoPTagDpbIM () { } +void DoPTagDpbLP () { } +void DoPTagDpbSP () { } +void DoPTagLdbFP () { } +void DoPTagLdbIM () { } +void DoPTagLdbLP () { } +void DoPTagLdbSP () { } +void DoPluspFP () { } +void DoPluspIM () { } +void DoPluspLP () { } +void DoPluspSP () { } +void DoPointerDifferenceFP () { } +void DoPointerDifferenceIM () { } +void DoPointerDifferenceLP () { } +void DoPointerDifferenceSP () { } +void DoPointerIncrementFP () { } +void DoPointerIncrementIM () { } +void DoPointerIncrementLP () { } +void DoPointerIncrementSP () { } +void DoPointerPlusFP () { } +void DoPointerPlusIM () { } +void DoPointerPlusLP () { } +void DoPointerPlusSP () { } +void DoPopFP () { } +void DoPopIM () { } +void DoPopInstanceVariableFP () { } +void DoPopInstanceVariableIM () { } +void DoPopInstanceVariableLP () { } +void DoPopInstanceVariableOrderedFP () { } +void DoPopInstanceVariableOrderedIM () { } +void DoPopInstanceVariableOrderedLP () { } +void DoPopInstanceVariableOrderedSP () { } +void DoPopInstanceVariableSP () { } +void DoPopLP () { } +void DoPopLexicalVarNFP () { } +void DoPopLexicalVarNIM () { } +void DoPopLexicalVarNLP () { } +void DoPopLexicalVarNSP () { } +void DoPopSP () { } +void DoPushAddressFP () { } +void DoPushAddressIM () { } +void DoPushAddressInstanceVariableFP () { } +void DoPushAddressInstanceVariableIM () { } +void DoPushAddressInstanceVariableLP () { } +void DoPushAddressInstanceVariableOrderedFP () { } +void DoPushAddressInstanceVariableOrderedIM () { } +void DoPushAddressInstanceVariableOrderedLP () { } +void DoPushAddressInstanceVariableOrderedSP () { } +void DoPushAddressInstanceVariableSP () { } +void DoPushAddressLP () { } +void DoPushAddressSP () { } +void DoPushAddressSpRelativeFP () { } +void DoPushAddressSpRelativeIM () { } +void DoPushAddressSpRelativeLP () { } +void DoPushAddressSpRelativeSP () { } +void DoPushFP () { } +void DoPushGlobalLogicVariableFP () { } +void DoPushGlobalLogicVariableIM () { } +void DoPushGlobalLogicVariableLP () { } +void DoPushGlobalLogicVariableSP () { } +void DoPushIM () { } +void DoPushInstanceVariableFP () { } +void DoPushInstanceVariableIM () { } +void DoPushInstanceVariableLP () { } +void DoPushInstanceVariableOrderedFP () { } +void DoPushInstanceVariableOrderedIM () { } +void DoPushInstanceVariableOrderedLP () { } +void DoPushInstanceVariableOrderedSP () { } +void DoPushInstanceVariableSP () { } +void DoPushLP () { } +void DoPushLexicalVarNFP () { } +void DoPushLexicalVarNIM () { } +void DoPushLexicalVarNLP () { } +void DoPushLexicalVarNSP () { } +void DoPushLocalLogicVariablesFP () { } +void DoPushLocalLogicVariablesIM () { } +void DoPushLocalLogicVariablesLP () { } +void DoPushLocalLogicVariablesSP () { } +void DoPushNNilsFP () { } +void DoPushNNilsIM () { } +void DoPushNNilsLP () { } +void DoPushNNilsSP () { } +void DoPushSP () { } +void DoQuotientFP () { } +void DoQuotientIM () { } +void DoQuotientLP () { } +void DoQuotientSP () { } +void DoRationalQuotientFP () { } +void DoRationalQuotientIM () { } +void DoRationalQuotientLP () { } +void DoRationalQuotientSP () { } +void DoReadInternalRegisterFP () { } +void DoReadInternalRegisterIM () { } +void DoReadInternalRegisterLP () { } +void DoReadInternalRegisterSP () { } +void DoRestoreBindingStackFP () { } +void DoRestoreBindingStackIM () { } +void DoRestoreBindingStackLP () { } +void DoRestoreBindingStackSP () { } +void DoReturnKludgeFP () { } +void DoReturnKludgeIM () { } +void DoReturnKludgeLP () { } +void DoReturnKludgeSP () { } +void DoReturnMultipleFP () { } +void DoReturnMultipleIM () { } +void DoReturnMultipleLP () { } +void DoReturnMultipleSP () { } +void DoReturnSingleFP () { } +void DoReturnSingleIM () { } +void DoReturnSingleLP () { } +void DoReturnSingleSP () { } +void DoRgetfFP () { } +void DoRgetfIM () { } +void DoRgetfLP () { } +void DoRgetfSP () { } +void DoRotFP () { } +void DoRotIM () { } +void DoRotLP () { } +void DoRotSP () { } +void DoRoundFP () { } +void DoRoundIM () { } +void DoRoundLP () { } +void DoRoundSP () { } +void DoRplacaFP () { } +void DoRplacaIM () { } +void DoRplacaLP () { } +void DoRplacaSP () { } +void DoRplacdFP () { } +void DoRplacdIM () { } +void DoRplacdLP () { } +void DoRplacdSP () { } +void DoSetCdrCode1FP () { } +void DoSetCdrCode1IM () { } +void DoSetCdrCode1LP () { } +void DoSetCdrCode1SP () { } +void DoSetCdrCode2FP () { } +void DoSetCdrCode2IM () { } +void DoSetCdrCode2LP () { } +void DoSetCdrCode2SP () { } +void DoSetSpToAddressFP () { } +void DoSetSpToAddressIM () { } +void DoSetSpToAddressLP () { } +void DoSetSpToAddressSP () { } +void DoSetSpToAddressSaveTosFP () { } +void DoSetSpToAddressSaveTosIM () { } +void DoSetSpToAddressSaveTosLP () { } +void DoSetSpToAddressSaveTosSP () { } +void DoSetTagFP () { } +void DoSetTagIM () { } +void DoSetTagLP () { } +void DoSetTagSP () { } +void DoSetToCarFP () { } +void DoSetToCarIM () { } +void DoSetToCarLP () { } +void DoSetToCarSP () { } +void DoSetToCdrFP () { } +void DoSetToCdrIM () { } +void DoSetToCdrLP () { } +void DoSetToCdrPushCarFP () { } +void DoSetToCdrPushCarIM () { } +void DoSetToCdrPushCarLP () { } +void DoSetToCdrPushCarSP () { } +void DoSetToCdrSP () { } +void DoSetup1DArrayFP () { } +void DoSetup1DArrayIM () { } +void DoSetup1DArrayLP () { } +void DoSetup1DArraySP () { } +void DoSetupForce1DArrayFP () { } +void DoSetupForce1DArrayIM () { } +void DoSetupForce1DArrayLP () { } +void DoSetupForce1DArraySP () { } +void DoSpareOpFP () { } +void DoSpareOpIM () { } +void DoSpareOpLP () { } +void DoSpareOpSP () { } +void DoStackBltAddressFP () { } +void DoStackBltAddressIM () { } +void DoStackBltAddressLP () { } +void DoStackBltAddressSP () { } +void DoStackBltFP () { } +void DoStackBltIM () { } +void DoStackBltLP () { } +void DoStackBltSP () { } +void DoStartCallFP () { } +void DoStartCallIM () { } +void DoStartCallLP () { } +void DoStartCallSP () { } +void DoStoreArrayLeaderFP () { } +void DoStoreArrayLeaderIM () { } +void DoStoreArrayLeaderLP () { } +void DoStoreArrayLeaderSP () { } +void DoStoreConditionalFP () { } +void DoStoreConditionalIM () { } +void DoStoreConditionalLP () { } +void DoStoreConditionalSP () { } +void DoSubBignumStepFP () { } +void DoSubBignumStepIM () { } +void DoSubBignumStepLP () { } +void DoSubBignumStepSP () { } +void DoSubFP () { } +void DoSubIM () { } +void DoSubLP () { } +void DoSubSP () { } +void DoTagFP () { } +void DoTagIM () { } +void DoTagLP () { } +void DoTagSP () { } +void DoTakeValuesFP () { } +void DoTakeValuesIM () { } +void DoTakeValuesLP () { } +void DoTakeValuesSP () { } +void DoTruncateFP () { } +void DoTruncateIM () { } +void DoTruncateLP () { } +void DoTruncateSP () { } +void DoTypeMemberFP () { } +void DoTypeMemberIM () { } +void DoTypeMemberLP () { } +void DoTypeMemberSP () { } +void DoUnaryMinusFP () { } +void DoUnaryMinusIM () { } +void DoUnaryMinusLP () { } +void DoUnaryMinusSP () { } +void DoUnbindNFP () { } +void DoUnbindNIM () { } +void DoUnbindNLP () { } +void DoUnbindNSP () { } +void DoUnifyFP () { } +void DoUnifyIM () { } +void DoUnifyLP () { } +void DoUnifySP () { } +void DoUnsignedLesspFP () { } +void DoUnsignedLesspIM () { } +void DoUnsignedLesspLP () { } +void DoUnsignedLesspSP () { } +void DoWriteInternalRegisterFP () { } +void DoWriteInternalRegisterIM () { } +void DoWriteInternalRegisterLP () { } +void DoWriteInternalRegisterSP () { } +void DoZeropFP () { } +void DoZeropIM () { } +void DoZeropLP () { } +void DoZeropSP () { } +void ReadRegisterAluAndRotateControl () { } +void ReadRegisterBARx () { } +void ReadRegisterBindingStackLimit () { } +void ReadRegisterBindingStackPointer () { } +void ReadRegisterCRArgumentSize () { } +void ReadRegisterCatchBlockList () { } +void ReadRegisterChipRevision () { } +void ReadRegisterChoicePointer () { } +void ReadRegisterConstantNIL () { } +void ReadRegisterConstantT () { } +void ReadRegisterContinuation () { } +void ReadRegisterControlRegister () { } +void ReadRegisterControlStackExtraLimit () { } +void ReadRegisterControlStackLimit () { } +void ReadRegisterCountMapReloads () { } +void ReadRegisterDynamicBindingCacheBase () { } +void ReadRegisterDynamicBindingCacheMask () { } +void ReadRegisterEphemeralOldspaceRegister () { } +void ReadRegisterError () { } +void ReadRegisterEventCount () { } +void ReadRegisterFEPModeTrapVectorAddress () { } +void ReadRegisterFP () { } +void ReadRegisterFPCoprocessorPresent () { } +void ReadRegisterIcacheControl () { } +void ReadRegisterLP () { } +void ReadRegisterListCacheAddress () { } +void ReadRegisterListCacheArea () { } +void ReadRegisterListCacheLength () { } +void ReadRegisterMapCacheControl () { } +void ReadRegisterMemoryControl () { } +void ReadRegisterMicrosecondClock () { } +void ReadRegisterPHTBase () { } +void ReadRegisterPHTMask () { } +void ReadRegisterPreemptRegister () { } +void ReadRegisterPrefetcherControl () { } +void ReadRegisterSP () { } +void ReadRegisterStackCacheDumpQuantum () { } +void ReadRegisterStackCacheLowerBound () { } +void ReadRegisterStackCacheOverflowLimit () { } +void ReadRegisterStackFrameMaximumSize () { } +void ReadRegisterStructureCacheAddress () { } +void ReadRegisterStructureCacheArea () { } +void ReadRegisterStructureCacheLength () { } +void ReadRegisterStructureStackChoicePointer () { } +void ReadRegisterTOS () { } +void ReadRegisterZoneOldspaceRegister () { } +void WriteRegisterAluAndRotateControl () { } +void WriteRegisterBARx () { } +void WriteRegisterBindingStackLimit () { } +void WriteRegisterBindingStackPointer () { } +void WriteRegisterCatchBlockList () { } +void WriteRegisterChoicePointer () { } +void WriteRegisterContinuation () { } +void WriteRegisterControlRegister () { } +void WriteRegisterControlStackExtraLimit () { } +void WriteRegisterControlStackLimit () { } +void WriteRegisterDynamicBindingCacheBase () { } +void WriteRegisterDynamicBindingCacheMask () { } +void WriteRegisterEphemeralOldspaceRegister () { } +void WriteRegisterError () { } +void WriteRegisterEventCount () { } +void WriteRegisterFEPModeTrapVectorAddress () { } +void WriteRegisterFP () { } +void WriteRegisterFPCoprocessorPresent () { } +void WriteRegisterLP () { } +void WriteRegisterListCacheAddress () { } +void WriteRegisterListCacheArea () { } +void WriteRegisterListCacheLength () { } +void WriteRegisterMappingTableCache () { } +void WriteRegisterPreemptRegister () { } +void WriteRegisterSP () { } +void WriteRegisterStackCacheLowerBound () { } +void WriteRegisterStackCacheOverflowLimit () { } +void WriteRegisterStructureCacheAddress () { } +void WriteRegisterStructureCacheArea () { } +void WriteRegisterStructureCacheLength () { } +void WriteRegisterStructureStackChoicePointer () { } +void WriteRegisterTOS () { } +void WriteRegisterZoneOldspaceRegister () { } diff --git a/stub/clisp-support.lisp b/stub/clisp-support.lisp new file mode 100644 index 0000000..316af99 --- /dev/null +++ b/stub/clisp-support.lisp @@ -0,0 +1,331 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SYSTEM; Base: 10; Lowercase: Yes -*- + +;;; + +;;; + +(in-package "SYSTEM") + +;;(defsubst %32-bit-difference (x y) +;; (- x y)) + +(defun %32-bit-difference (x y) + (- x y)) + +(export '(%logldb %logdpb %32-bit-difference)) + +;(ccl::defsubst %logldb (bytespec integer) +; (ldb bytespec integer)) + +;; (ccl::defsubst %logdpb (value bytespec integer) +;; (let ((result (dpb value bytespec integer))) +;; (if (zerop (ldb (byte 1 31) result)) +;; result +;; (- (ldb (byte 31 0) (1+ (lognot result))))))) + +;;(ccl::defsubst %32-bit-difference (x y) +;; (- x y)) + +;;; + +(defmacro defsysconstant (name value) + `(progn + (defconstant ,name ,value) + (export ',name))) + +(defmacro defenumerated (list-name code-list &optional (start 0) (increment 1) end) + (when (and end (not (= (length code-list) (/ (- end start) increment)))) + (error "~s has ~s codes where ~s are required" + list-name (length code-list) (/ (- end start) increment))) + `(progn + (defsysconstant ,list-name ',code-list) + ,@(loop for code in code-list and prev = 0 then code + as value from start by increment + unless (eq code prev) ;kludge for data-types + collect `(defsysconstant ,code ,value)))) + +(defmacro defsysbyte (name size position) + `(defsysconstant ,name (byte ,size ,position))) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDEF.LISP ... +;;; + +;; --- most of the below is L-specific +;; To add a new data type, update the following (at least): +;; *DATA-TYPES* and *POINTER-DATA-TYPES* in this file +;; Patch *DATA-TYPE-NAME*, set up by from *DATA-TYPES* by the cold-load generator +;; type-map-for-transport, transporter-type-map-alist in sys: l-ucode; uu.lisp +;; *storing-type-map* in sys: l-ucode; uux.lisp and reload that whole file +;; It is important that the form near the end of that file that sets up the +;; no-trap type-map be executed before any other type maps are assigned. +;; simulate-transporter in sys: l-ucode; simx.lisp +;; and recompile the whole microcode to get the type-maps updated +;; typep-alist and related stuff in sys: sys; lcons.lisp +;; dbg:*good-data-types* if it is indeed a good data type +;; Send a message to the maintainer of the FEP-resident debugger. + +(DEFENUMERATED *DATA-TYPES* ( + ;; Headers, special markers, and forwarding pointers. + DTP-NULL ;00 Unbound variable/function, uninitialized storage + DTP-MONITOR-FORWARD ;01 This cell being monitored + DTP-HEADER-P ;02 Structure header, with pointer field + DTP-HEADER-I ;03 Structure header, with immediate bits + DTP-EXTERNAL-VALUE-CELL-POINTER ;04 Invisible except for binding + DTP-ONE-Q-FORWARD ;05 Invisible pointer (forwards one cell) + DTP-HEADER-FORWARD ;06 Invisible pointer (forwards whole structure) + DTP-ELEMENT-FORWARD ;07 Invisible pointer in element of structure + ;; Numeric data types. + DTP-FIXNUM ;10 Small integer + DTP-SMALL-RATIO ;11 Ratio with small numerator and denominator + DTP-SINGLE-FLOAT ;12 Single-precision floating point + DTP-DOUBLE-FLOAT ;13 Double-precision floating point + DTP-BIGNUM ;14 Big integer + DTP-BIG-RATIO ;15 Ratio with big numerator or denominator + DTP-COMPLEX ;16 Complex number + DTP-SPARE-NUMBER ;17 A number to the hardware trap mechanism + ;; Instance data types. + DTP-INSTANCE ;20 Ordinary instance + DTP-LIST-INSTANCE ;21 Instance that masquerades as a cons + DTP-ARRAY-INSTANCE ;22 Instance that masquerades as an array + DTP-STRING-INSTANCE ;23 Instance that masquerades as a string + ;; Primitive data types. + DTP-NIL ;24 The symbol NIL + DTP-LIST ;25 A cons + DTP-ARRAY ;26 An array that is not a string + DTP-STRING ;27 A string + DTP-SYMBOL ;30 A symbol other than NIL + DTP-LOCATIVE ;31 Locative pointer + DTP-LEXICAL-CLOSURE ;32 Lexical closure of a function + DTP-DYNAMIC-CLOSURE ;33 Dynamic closure of a function + DTP-COMPILED-FUNCTION ;34 Compiled code + DTP-GENERIC-FUNCTION ;35 Generic function (see later section) + DTP-SPARE-POINTER-1 ;36 Spare + DTP-SPARE-POINTER-2 ;37 Spare + DTP-PHYSICAL-ADDRESS ;40 Physical address + DTP-SPARE-IMMEDIATE-1 ;41 Spare + DTP-BOUND-LOCATION ;42 Deep bound marker + DTP-CHARACTER ;43 Common Lisp character object + DTP-LOGIC-VARIABLE ;44 Unbound logic variable marker + DTP-GC-FORWARD ;45 Object-moved flag for garbage collector + DTP-EVEN-PC ;46 PC at first instruction in word + DTP-ODD-PC ;47 PC at second instruction in word + ;; Full-word instructions. + DTP-CALL-COMPILED-EVEN ;50 Start call, address is compiled function + DTP-CALL-COMPILED-ODD ;51 Start call, address is compiled function + DTP-CALL-INDIRECT ;52 Start call, address is function cell + DTP-CALL-GENERIC ;53 Start call, address is generic function + DTP-CALL-COMPILED-EVEN-PREFETCH ;54 Like above, but prefetching is desireable + DTP-CALL-COMPILED-ODD-PREFETCH ;55 Like above, but prefetching is desireable + DTP-CALL-INDIRECT-PREFETCH ;56 Like above, but prefetching is desireable + DTP-CALL-GENERIC-PREFETCH ;57 Like above, but prefetching is desireable + ;; Half-word (packed) instructions consume 4 bits of data type field (opcodes 60..77). + DTP-PACKED-INSTRUCTION-60 DTP-PACKED-INSTRUCTION-61 DTP-PACKED-INSTRUCTION-62 + DTP-PACKED-INSTRUCTION-63 DTP-PACKED-INSTRUCTION-64 DTP-PACKED-INSTRUCTION-65 + DTP-PACKED-INSTRUCTION-66 DTP-PACKED-INSTRUCTION-67 DTP-PACKED-INSTRUCTION-70 + DTP-PACKED-INSTRUCTION-71 DTP-PACKED-INSTRUCTION-72 DTP-PACKED-INSTRUCTION-73 + DTP-PACKED-INSTRUCTION-74 DTP-PACKED-INSTRUCTION-75 DTP-PACKED-INSTRUCTION-76 + DTP-PACKED-INSTRUCTION-77 + ) + 0 1 #o100) + +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* ( + ARRAY-ELEMENT-TYPE-FIXNUM + ARRAY-ELEMENT-TYPE-CHARACTER + ARRAY-ELEMENT-TYPE-BOOLEAN + ARRAY-ELEMENT-TYPE-OBJECT + )) + +;;; Control register. + +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 8. 0) ;Number of spread arguments supplied by caller +(DEFSYSBYTE %%CR.APPLY 1 17.) ;1 If caller used APPLY, 0 otherwise +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 2 18.) ;The value of this function +(DEFSYSBYTE %%CR.CLEANUP-BITS 3 24.) ;All the cleanup bits +(DEFSYSBYTE %%CR.CLEANUP-CATCH 1 26.) ;There are active catch blocks in the current frame +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 1 25.) ;There are active bindings in the current frame +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 1 24.) ;Software trap before exiting this frame +(DEFSYSBYTE %%CR.TRAP-MODE 2 30.) ;1 If we are executing on the "extra stack" + ;Extra stack inhibits sequence breaks and preemption + ;It also allows the "overflow" part of the stack to + ;be used without traps. +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 1 8.) ;The call instruction supplied an "extra" argument +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 8 9.) ;The frame size of the Caller +(DEFSYSBYTE %%CR.CALL-STARTED 1 22.) ;Between start-call and finish-call. +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 1 23.) +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 1 29.) +(DEFSYSBYTE %%CR.CALL-TRACE 1 28.) +(DEFSYSBYTE %%CR.TRACE-PENDING 1 27.) +(DEFSYSBYTE %%CR.TRACE-BITS 3 27.) + +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 6 24.) + +(DEFENUMERATED *VALUE-DISPOSITIONS* ( + VALUE-DISPOSITION-EFFECT ;The callers wants no return values + VALUE-DISPOSITION-VALUE ;The caller wants a single return value + VALUE-DISPOSITION-RETURN ;The caller wants to return whatever values are + ;returned by this function + VALUE-DISPOSITION-MULTIPLE ;The callers wants multiple values + )) + +(DEFENUMERATED *TRAP-MODES* ( + TRAP-MODE-EMULATOR + TRAP-MODE-EXTRA-STACK + TRAP-MODE-IO + TRAP-MODE-FEP)) + +(DEFENUMERATED *MEMORY-CYCLE-TYPES* ( + %MEMORY-DATA-READ + %MEMORY-DATA-WRITE + %MEMORY-BIND-READ + %MEMORY-BIND-WRITE + %MEMORY-BIND-READ-NO-MONITOR + %MEMORY-BIND-WRITE-NO-MONITOR + %MEMORY-HEADER + %MEMORY-STRUCTURE-OFFSET + %MEMORY-SCAVENGE + %MEMORY-CDR + %MEMORY-GC-COPY + %MEMORY-RAW + %MEMORY-RAW-TRANSLATE + )) + +;;; Internal register definitions + +;;; %REGISTER-ALU-AND-ROTATE-CONTROL fields (DP-OP in hardware spec) + +(DEFSYSBYTE %%ALU-BYTE-R 5 0.) +(DEFSYSBYTE %%ALU-BYTE-S 5 5.) +(DEFSYSBYTE %%ALU-FUNCTION 6 10.) +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 2 14.) +(DEFSYSBYTE %%ALU-FUNCTION-BITS 4 10.) +(DEFSYSBYTE %%ALU-CONDITION 5 16.) +(DEFSYSBYTE %%ALU-CONDITION-SENSE 1 21.) + +;; The following are implemented in Rev3 only. +;; Software forces them to the proper value for compatible operation in Rev1 and Rev2. +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 1 22.) +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 1 23.) +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 1 24.) + +(DEFENUMERATED *ALU-CONDITION-SENSES* + (%ALU-CONDITION-SENSE-TRUE + %ALU-CONDITION-SENSE-FALSE)) + +(DEFENUMERATED *ALU-CONDITIONS* + (%ALU-CONDITION-SIGNED-LESS-THAN-OR-EQUAL ;00 + %ALU-CONDITION-SIGNED-LESS-THAN ;01 + %ALU-CONDITION-NEGATIVE ;02 + %ALU-CONDITION-SIGNED-OVERFLOW ;03 + %ALU-CONDITION-UNSIGNED-LESS-THAN-OR-EQUAL ;04 + %ALU-CONDITION-UNSIGNED-LESS-THAN ;05 + %ALU-CONDITION-ZERO ;06 + %ALU-CONDITION-HIGH-25-ZERO ;07 + %ALU-CONDITION-EQ ;10 + %ALU-CONDITION-OP1-EPHEMERALP ;11 + %ALU-CONDITION-OP1-TYPE-ACCEPTABLE ;12 + %ALU-CONDITION-OP1-TYPE-CONDITION ;13 + %ALU-CONDITION-RESULT-TYPE-NIL ;14 + %ALU-CONDITION-OP2-FIXNUM ;15 + %ALU-CONDITION-FALSE ;16 + %ALU-CONDITION-RESULT-CDR-LOW ;17 + %ALU-CONDITION-CLEANUP-BITS-SET ;20 + %ALU-CONDITION-ADDRESS-IN-STACK-CACHE ;21 + %ALU-CONDITION-PENDING-SEQUENCE-BREAK-ENABLED ;22 + %ALU-CONDITION-EXTRA-STACK-MODE ;23 + %ALU-CONDITION-FEP-MODE ;24 + %ALU-CONDITION-FP-COPROCESSOR-PRESENT ;25 + %ALU-CONDITION-OP1-OLDSPACEP ;26 + %ALU-CONDITION-STACK-CACHE-OVERFLOW ;27 + %ALU-CONDITION-OR-LOGIC-VARIABLE ;30 + )) + +(DEFENUMERATED *ALU-FUNCTION-CLASSES* + (%ALU-FUNCTION-CLASS-BOOLEAN + %ALU-FUNCTION-CLASS-BYTE + %ALU-FUNCTION-CLASS-ADDER + %ALU-FUNCTION-CLASS-MULTIPLY-DIVIDE)) + +(DEFENUMERATED *ALU-FUNCTIONS* + (%ALU-FUNCTION-OP-BOOLEAN-0 + %ALU-FUNCTION-OP-BOOLEAN-1 + %ALU-FUNCTION-OP-DPB + %ALU-FUNCTION-OP-LDB + %ALU-FUNCTION-OP-ADD + %ALU-FUNCTION-OP-RESERVED + %ALU-FUNCTION-OP-MULTIPLY-STEP + %ALU-FUNCTION-OP-MULTIPLY-INVERT-STEP + %ALU-FUNCTION-OP-DIVIDE-STEP + %ALU-FUNCTION-OP-DIVIDE-INVERT-STEP)) + +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS* + (%ALU-BYTE-BACKGROUND-OP1 + %ALU-BYTE-BACKGROUND-ROTATE-LATCH + %ALU-BYTE-BACKGROUND-ZERO)) + +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH* + (%ALU-BYTE-HOLD-ROTATE-LATCH + %ALU-BYTE-SET-ROTATE-LATCH)) + +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS* + (%ALU-ADD-OP2-PASS + %ALU-ADD-OP2-INVERT)) + +(DEFENUMERATED *ALU-ADDER-OPS* + (%ALU-ADD-OP2 + %ALU-ADD-ZERO)) + +(defmacro %alu-function-dpb (background rotate-latch) + `(%logdpb %alu-function-op-dpb (byte 3 3) + (%logdpb ,rotate-latch (byte 1 2) + (%logdpb ,background (byte 2 0) + 0)))) +(export '%alu-function-dpb) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDF1.LISP ... +;;; + +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR #o0) +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR #o4000) +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR #o4400) +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR #o5000) + +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR #o5100) +(DEFSYSCONSTANT %RESET-TRAP-VECTOR #o5101) +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR #o5102) +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR #o5103) +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR #o5104) +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR #o5105) +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR #o5106) +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR #o5107) + +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5110) +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5111) +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR #o5112) +;;; 5113 reserved for future use +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR #o5114) +;;; 5115 reserved for a fence word +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR #o5116) +;;; 5117 reserved for a fence word + +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR #o5120) +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR #o5121) +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR #o5122) +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR #o5123) +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR #o5124) +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR #o5125) +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR #o5126) +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 5127) +;;; 5130 through 5177 reserved for future use + + +;;; +;;; The following definitions are from SYS:I-SYS;OPSDEF.LISP ... +;;; + +(in-package "I-LISP-COMPILER") + +(DEFCONSTANT *FINISH-CALL-N-OPCODE* #o134) diff --git a/stub/dispatch b/stub/dispatch new file mode 100644 index 0000000..e76e2d6 --- /dev/null +++ b/stub/dispatch @@ -0,0 +1,482 @@ +void *_halfworddispatch[] + = { + &&DoCarFP, &&DoCarLP, &&DoCarSP, &&DoCarIM, /* #o00 */ + &&DoCdrFP, &&DoCdrLP, &&DoCdrSP, &&DoCdrIM, /* #o01 */ + &&DoEndpFP, &&DoEndpLP, &&DoEndpSP, &&DoEndpIM, /* #o02 */ + &&DoSetup1DArrayFP, &&DoSetup1DArrayLP, &&DoSetup1DArraySP, &&DoSetup1DArrayIM, /* #o03 */ + &&DoSetupForce1DArrayFP, &&DoSetupForce1DArrayLP, &&DoSetupForce1DArraySP, &&DoSetupForce1DArrayIM, /* #o04 */ + &&DoBindLocativeFP, &&DoBindLocativeLP, &&DoBindLocativeSP, &&DoBindLocativeIM, /* #o05 */ + &&DoRestoreBindingStackFP, &&DoRestoreBindingStackLP, &&DoRestoreBindingStackSP, &&DoRestoreBindingStackIM, /* #o06 */ + &&DoEphemeralpFP, &&DoEphemeralpLP, &&DoEphemeralpSP, &&DoEphemeralpIM, /* #o07 */ + &&DoStartCallFP, &&DoStartCallLP, &&DoStartCallSP, &&DoStartCallIM, /* #o010 */ + &&DoJumpFP, &&DoJumpLP, &&DoJumpSP, &&DoJumpIM, /* #o011 */ + &&DoTagFP, &&DoTagLP, &&DoTagSP, &&DoTagIM, /* #o012 */ + &&DoDereferenceFP, &&DoDereferenceLP, &&DoDereferenceSP, &&DoDereferenceIM, /* #o013 */ + &&DoLogicTailTestFP, &&DoLogicTailTestLP, &&DoLogicTailTestSP, &&DoLogicTailTestIM, /* #o014 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /* #o015 +++ Used for breakpoints!!! */ + &&DoDoubleFloatOpFP, &&DoDoubleFloatOpLP, &&DoDoubleFloatOpSP, &&DoDoubleFloatOpIM, /* #o016 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /* #o017 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o020 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o021 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o022 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o023 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o024 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o025 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o026 */ + &&DoPushLexicalVarNFP, &&DoPushLexicalVarNLP, &&DoPushLexicalVarNSP, &&DoPushLexicalVarNIM, /* #o027 */ + &&DoBlock0WriteFP, &&DoBlock0WriteLP, &&DoBlock0WriteSP, &&DoBlock0WriteIM, /* #o030 */ + &&DoBlock1WriteFP, &&DoBlock1WriteLP, &&DoBlock1WriteSP, &&DoBlock1WriteIM, /* #o031 */ + &&DoBlock2WriteFP, &&DoBlock2WriteLP, &&DoBlock2WriteSP, &&DoBlock2WriteIM, /* #o032 */ + &&DoBlock3WriteFP, &&DoBlock3WriteLP, &&DoBlock3WriteSP, &&DoBlock3WriteIM, /* #o033 */ + &&DoZeropFP, &&DoZeropLP, &&DoZeropSP, &&DoZeropIM, /* #o034 */ + &&DoMinuspFP, &&DoMinuspLP, &&DoMinuspSP, &&DoMinuspIM, /* #o035 */ + &&DoPluspFP, &&DoPluspLP, &&DoPluspSP, &&DoPluspIM, /* #o036 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o037 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o040 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o041 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o042 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o043 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o044 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o045 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o046 */ + &&DoTypeMemberFP, &&DoTypeMemberLP, &&DoTypeMemberSP, &&DoTypeMemberIM, /* #o047 */ + &&DoLocateLocalsFP, &&DoLocateLocalsLP, &&DoLocateLocalsSP, &&DoLocateLocalsIM, /* #o050 */ + &&DoCatchCloseFP, &&DoCatchCloseLP, &&DoCatchCloseSP, &&DoCatchCloseIM, /* #o051 */ + &&DoGenericDispatchFP, &&DoGenericDispatchLP, &&DoGenericDispatchSP, &&DoGenericDispatchIM, /* #o052 */ + &&DoMessageDispatchFP, &&DoMessageDispatchLP, &&DoMessageDispatchSP, &&DoMessageDispatchIM, /* #o053 */ + &&DoCheckPreemptRequestFP, &&DoCheckPreemptRequestLP, &&DoCheckPreemptRequestSP, &&DoCheckPreemptRequestIM, /* #o054 */ + &&DoPushGlobalLogicVariableFP, &&DoPushGlobalLogicVariableLP, &&DoPushGlobalLogicVariableSP, &&DoPushGlobalLogicVariableIM, /* #o055 */ + &&DoNoOpFP, &&DoNoOpLP, &&DoNoOpSP, &&DoNoOpIM, /* #o056 */ + &&DoHaltFP, &&DoHaltLP, &&DoHaltSP, &&DoHaltIM, /* #o057 */ + &&DoBranchTrueFP, &&DoBranchTrueLP, &&DoBranchTrueSP, &&DoBranchTrueIM, /* #o060 */ + &&DoBranchTrueElseExtraPopFP, &&DoBranchTrueElseExtraPopLP, &&DoBranchTrueElseExtraPopSP, &&DoBranchTrueElseExtraPopIM, /* #o061 */ + &&DoBranchTrueAndExtraPopFP, &&DoBranchTrueAndExtraPopLP, &&DoBranchTrueAndExtraPopSP, &&DoBranchTrueAndExtraPopIM, /* #o062 */ + &&DoBranchTrueExtraPopFP, &&DoBranchTrueExtraPopLP, &&DoBranchTrueExtraPopSP, &&DoBranchTrueExtraPopIM, /* #o063 */ + &&DoBranchTrueNoPopFP, &&DoBranchTrueNoPopLP, &&DoBranchTrueNoPopSP, &&DoBranchTrueNoPopIM, /* #o064 */ + &&DoBranchTrueAndNoPopFP, &&DoBranchTrueAndNoPopLP, &&DoBranchTrueAndNoPopSP, &&DoBranchTrueAndNoPopIM, /* #o065 */ + &&DoBranchTrueElseNoPopFP, &&DoBranchTrueElseNoPopLP, &&DoBranchTrueElseNoPopSP, &&DoBranchTrueElseNoPopIM, /* #o066 */ + &&DoBranchTrueAndNoPopElseNoPopExtraPopFP, &&DoBranchTrueAndNoPopElseNoPopExtraPopLP, &&DoBranchTrueAndNoPopElseNoPopExtraPopSP, &&DoBranchTrueAndNoPopElseNoPopExtraPopIM, /* #o067 */ + &&DoBranchFalseFP, &&DoBranchFalseLP, &&DoBranchFalseSP, &&DoBranchFalseIM, /* #o070 */ + &&DoBranchFalseElseExtraPopFP, &&DoBranchFalseElseExtraPopLP, &&DoBranchFalseElseExtraPopSP, &&DoBranchFalseElseExtraPopIM, /* #o071 */ + &&DoBranchFalseAndExtraPopFP, &&DoBranchFalseAndExtraPopLP, &&DoBranchFalseAndExtraPopSP, &&DoBranchFalseAndExtraPopIM, /* #o072 */ + &&DoBranchFalseExtraPopFP, &&DoBranchFalseExtraPopLP, &&DoBranchFalseExtraPopSP, &&DoBranchFalseExtraPopIM, /* #o073 */ + &&DoBranchFalseNoPopFP, &&DoBranchFalseNoPopLP, &&DoBranchFalseNoPopSP, &&DoBranchFalseNoPopIM, /* #o074 */ + &&DoBranchFalseAndNoPopFP, &&DoBranchFalseAndNoPopLP, &&DoBranchFalseAndNoPopSP, &&DoBranchFalseAndNoPopIM, /* #o075 */ + &&DoBranchFalseElseNoPopFP, &&DoBranchFalseElseNoPopLP, &&DoBranchFalseElseNoPopSP, &&DoBranchFalseElseNoPopIM, /* #o076 */ + &&DoBranchFalseAndNoPopElseNoPopExtraPopFP, &&DoBranchFalseAndNoPopElseNoPopExtraPopLP, &&DoBranchFalseAndNoPopElseNoPopExtraPopSP, &&DoBranchFalseAndNoPopElseNoPopExtraPopIM, /* #o077 */ + &&DoPushFP, &&DoPushLP, &&DoPushSP, &&DoPushIM, /* #o0100 */ + &&DoPushNNilsFP, &&DoPushNNilsLP, &&DoPushNNilsSP, &&DoPushNNilsIM, /* #o0101 */ + &&DoPushAddressSpRelativeFP, &&DoPushAddressSpRelativeLP, &&DoPushAddressSpRelativeSP, &&DoPushAddressSpRelativeIM, /* #o0102 */ + &&DoPushLocalLogicVariablesFP, &&DoPushLocalLogicVariablesLP, &&DoPushLocalLogicVariablesSP, &&DoPushLocalLogicVariablesIM, /* #o0103 */ + &&DoReturnMultipleFP, &&DoReturnMultipleLP, &&DoReturnMultipleSP, &&DoReturnMultipleIM, /* #o0104 */ + &&DoReturnKludgeFP, &&DoReturnKludgeLP, &&DoReturnKludgeSP, &&DoReturnKludgeIM, /* #o0105 */ + &&DoTakeValuesFP, &&DoTakeValuesLP, &&DoTakeValuesSP, &&DoTakeValuesIM, /* #o0106 */ + &&DoUnbindNFP, &&DoUnbindNLP, &&DoUnbindNSP, &&DoUnbindNIM, /* #o0107 */ + &&DoPushInstanceVariableFP, &&DoPushInstanceVariableLP, &&DoPushInstanceVariableSP, &&DoPushInstanceVariableIM, /* #o0110 */ + &&DoPushAddressInstanceVariableFP, &&DoPushAddressInstanceVariableLP, &&DoPushAddressInstanceVariableSP, &&DoPushAddressInstanceVariableIM, /* #o0111 */ + &&DoPushInstanceVariableOrderedFP, &&DoPushInstanceVariableOrderedLP, &&DoPushInstanceVariableOrderedSP, &&DoPushInstanceVariableOrderedIM, /* #o0112 */ + &&DoPushAddressInstanceVariableOrderedFP, &&DoPushAddressInstanceVariableOrderedLP, &&DoPushAddressInstanceVariableOrderedSP, &&DoPushAddressInstanceVariableOrderedIM, /* #o0113 */ + &&DoUnaryMinusFP, &&DoUnaryMinusLP, &&DoUnaryMinusSP, &&DoUnaryMinusIM, /* #o0114 */ + &&DoReturnSingleFP, &&DoReturnSingleLP, &&DoReturnSingleSP, &&DoReturnSingleIM, /* #o0115 */ + &&DoMemoryReadFP, &&DoMemoryReadLP, &&DoMemoryReadSP, &&DoMemoryReadIM, /* #o0116 */ + &&DoMemoryReadFP, &&DoMemoryReadLP, &&DoMemoryReadSP, &&DoMemoryReadIM, /* #o0117 */ + &&DoBlock0ReadFP, &&DoBlock0ReadLP, &&DoBlock0ReadSP, &&DoBlock0ReadIM, /* #o0120 */ + &&DoBlock1ReadFP, &&DoBlock1ReadLP, &&DoBlock1ReadSP, &&DoBlock1ReadIM, /* #o0121 */ + &&DoBlock2ReadFP, &&DoBlock2ReadLP, &&DoBlock2ReadSP, &&DoBlock2ReadIM, /* #o0122 */ + &&DoBlock3ReadFP, &&DoBlock3ReadLP, &&DoBlock3ReadSP, &&DoBlock3ReadIM, /* #o0123 */ + &&DoBlock0ReadShiftFP, &&DoBlock0ReadShiftLP, &&DoBlock0ReadShiftSP, &&DoBlock0ReadShiftIM, /* #o0124 */ + &&DoBlock1ReadShiftFP, &&DoBlock1ReadShiftLP, &&DoBlock1ReadShiftSP, &&DoBlock1ReadShiftIM, /* #o0125 */ + &&DoBlock2ReadShiftFP, &&DoBlock2ReadShiftLP, &&DoBlock2ReadShiftSP, &&DoBlock2ReadShiftIM, /* #o0126 */ + &&DoBlock3ReadShiftFP, &&DoBlock3ReadShiftLP, &&DoBlock3ReadShiftSP, &&DoBlock3ReadShiftIM, /* #o0127 */ + &&DoBlock0ReadTestFP, &&DoBlock0ReadTestLP, &&DoBlock0ReadTestSP, &&DoBlock0ReadTestIM, /* #o0130 */ + &&DoBlock1ReadTestFP, &&DoBlock1ReadTestLP, &&DoBlock1ReadTestSP, &&DoBlock1ReadTestIM, /* #o0131 */ + &&DoBlock2ReadTestFP, &&DoBlock2ReadTestLP, &&DoBlock2ReadTestSP, &&DoBlock2ReadTestIM, /* #o0132 */ + &&DoBlock3ReadTestFP, &&DoBlock3ReadTestLP, &&DoBlock3ReadTestSP, &&DoBlock3ReadTestIM, /* #o0133 */ + &&DoFinishCallNFP, &&DoFinishCallNLP, &&DoFinishCallNSP, &&DoFinishCallNIM, /* #o0134 */ + &&DoFinishCallNFP, &&DoFinishCallNLP, &&DoFinishCallNSP, &&DoFinishCallNIM, /* #o0135 */ + &&DoFinishCallTosFP, &&DoFinishCallTosLP, &&DoFinishCallTosSP, &&DoFinishCallTosIM, /* #o0136 */ + &&DoFinishCallTosFP, &&DoFinishCallTosLP, &&DoFinishCallTosSP, &&DoFinishCallTosIM, /* #o0137 */ + &&DoSetToCarFP, &&DoSetToCarLP, &&DoSetToCarSP, &&DoSetToCarIM, /* #o0140 */ + &&DoSetToCdrFP, &&DoSetToCdrLP, &&DoSetToCdrSP, &&DoSetToCdrIM, /* #o0141 */ + &&DoSetToCdrPushCarFP, &&DoSetToCdrPushCarLP, &&DoSetToCdrPushCarSP, &&DoSetToCdrPushCarIM, /* #o0142 */ + &&DoIncrementFP, &&DoIncrementLP, &&DoIncrementSP, &&DoIncrementIM, /* #o0143 */ + &&DoDecrementFP, &&DoDecrementLP, &&DoDecrementSP, &&DoDecrementIM, /* #o0144 */ + &&DoPointerIncrementFP, &&DoPointerIncrementLP, &&DoPointerIncrementSP, &&DoPointerIncrementIM, /* #o0145 */ + &&DoSetCdrCode1FP, &&DoSetCdrCode1LP, &&DoSetCdrCode1SP, &&DoSetCdrCode1IM, /* #o0146 */ + &&DoSetCdrCode2FP, &&DoSetCdrCode2LP, &&DoSetCdrCode2SP, &&DoSetCdrCode2IM, /* #o0147 */ + &&DoPushAddressFP, &&DoPushAddressLP, &&DoPushAddressSP, &&DoPushAddressIM, /* #o0150 */ + &&DoSetSpToAddressFP, &&DoSetSpToAddressLP, &&DoSetSpToAddressSP, &&DoSetSpToAddressIM, /* #o0151 */ + &&DoSetSpToAddressSaveTosFP, &&DoSetSpToAddressSaveTosLP, &&DoSetSpToAddressSaveTosSP, &&DoSetSpToAddressSaveTosIM, /* #o0152 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0153 */ + &&DoReadInternalRegisterFP, &&DoReadInternalRegisterLP, &&DoReadInternalRegisterSP, &&DoReadInternalRegisterIM, /* #o0154 */ + &&DoWriteInternalRegisterFP, &&DoWriteInternalRegisterLP, &&DoWriteInternalRegisterSP, &&DoWriteInternalRegisterIM, /* #o0155 */ + &&DoCoprocessorReadFP, &&DoCoprocessorReadLP, &&DoCoprocessorReadSP, &&DoCoprocessorReadIM, /* #o0156 */ + &&DoCoprocessorWriteFP, &&DoCoprocessorWriteLP, &&DoCoprocessorWriteSP, &&DoCoprocessorWriteIM, /* #o0157 */ + &&DoBlock0ReadAluFP, &&DoBlock0ReadAluLP, &&DoBlock0ReadAluSP, &&DoBlock0ReadAluIM, /* #o0160 */ + &&DoBlock1ReadAluFP, &&DoBlock1ReadAluLP, &&DoBlock1ReadAluSP, &&DoBlock1ReadAluIM, /* #o0161 */ + &&DoBlock2ReadAluFP, &&DoBlock2ReadAluLP, &&DoBlock2ReadAluSP, &&DoBlock2ReadAluIM, /* #o0162 */ + &&DoBlock3ReadAluFP, &&DoBlock3ReadAluLP, &&DoBlock3ReadAluSP, &&DoBlock3ReadAluIM, /* #o0163 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0164 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0165 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0166 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0167 */ + &&DoLdbFP, &&DoLdbLP, &&DoLdbSP, &&DoLdbIM, /* #o0170 */ + &&DoCharLdbFP, &&DoCharLdbLP, &&DoCharLdbSP, &&DoCharLdbIM, /* #o0171 */ + &&DoPLdbFP, &&DoPLdbLP, &&DoPLdbSP, &&DoPLdbIM, /* #o0172 */ + &&DoPTagLdbFP, &&DoPTagLdbLP, &&DoPTagLdbSP, &&DoPTagLdbIM, /* #o0173 */ + &&DoBranchFP, &&DoBranchLP, &&DoBranchSP, &&DoBranchIM, /* #o0174 */ + &&DoLoopDecrementTosFP, &&DoLoopDecrementTosLP, &&DoLoopDecrementTosSP, &&DoLoopDecrementTosIM, /* #o0175 */ + &&DoEntryRestAcceptedFP, &&DoEntryRestAcceptedLP, &&DoEntryRestAcceptedSP, &&DoEntryRestAcceptedIM, /* #o0176 */ + &&DoEntryRestNotAcceptedFP, &&DoEntryRestNotAcceptedLP, &&DoEntryRestNotAcceptedSP, &&DoEntryRestNotAcceptedIM, /* #o0177 */ + &&DoRplacaFP, &&DoRplacaLP, &&DoRplacaSP, &&DoRplacaIM, /* #o0200 */ + &&DoRplacdFP, &&DoRplacdLP, &&DoRplacdSP, &&DoRplacdIM, /* #o0201 */ + &&DoMultiplyFP, &&DoMultiplyLP, &&DoMultiplySP, &&DoMultiplyIM, /* #o0202 */ + &&DoQuotientFP, &&DoQuotientLP, &&DoQuotientSP, &&DoQuotientIM, /* #o0203 */ + &&DoCeilingFP, &&DoCeilingLP, &&DoCeilingSP, &&DoCeilingIM, /* #o0204 */ + &&DoFloorFP, &&DoFloorLP, &&DoFloorSP, &&DoFloorIM, /* #o0205 */ + &&DoTruncateFP, &&DoTruncateLP, &&DoTruncateSP, &&DoTruncateIM, /* #o0206 */ + &&DoRoundFP, &&DoRoundLP, &&DoRoundSP, &&DoRoundIM, /* #o0207 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /* #o0210 +++ Use for DoRemainder */ + &&DoRationalQuotientFP, &&DoRationalQuotientLP, &&DoRationalQuotientSP, &&DoRationalQuotientIM, /* #o0211 */ + &&DoMinFP, &&DoMinLP, &&DoMinSP, &&DoMinIM, /* #o0212 */ + &&DoMaxFP, &&DoMaxLP, &&DoMaxSP, &&DoMaxIM, /* #o0213 */ + &&DoAluFP, &&DoAluLP, &&DoAluSP, &&DoAluIM, /* #o0214 */ + &&DoLogandFP, &&DoLogandLP, &&DoLogandSP, &&DoLogandIM, /* #o0215 */ + &&DoLogxorFP, &&DoLogxorLP, &&DoLogxorSP, &&DoLogxorIM, /* #o0216 */ + &&DoLogiorFP, &&DoLogiorLP, &&DoLogiorSP, &&DoLogiorIM, /* #o0217 */ + &&DoRotFP, &&DoRotLP, &&DoRotSP, &&DoRotIM, /* #o0220 */ + &&DoLshFP, &&DoLshLP, &&DoLshSP, &&DoLshIM, /* #o0221 */ + &&DoMultiplyDoubleFP, &&DoMultiplyDoubleLP, &&DoMultiplyDoubleSP, &&DoMultiplyDoubleIM, /* #o0222 */ + &&DoLshcBignumStepFP, &&DoLshcBignumStepLP, &&DoLshcBignumStepSP, &&DoLshcBignumStepIM, /* #o0223 */ + &&DoStackBltFP, &&DoStackBltLP, &&DoStackBltSP, &&DoStackBltIM, /* #o0224 */ + &&DoRgetfFP, &&DoRgetfLP, &&DoRgetfSP, &&DoRgetfIM, /* #o0225 */ + &&DoMemberFP, &&DoMemberLP, &&DoMemberSP, &&DoMemberIM, /* #o0226 */ + &&DoAssocFP, &&DoAssocLP, &&DoAssocSP, &&DoAssocIM, /* #o0227 */ + &&DoPointerPlusFP, &&DoPointerPlusLP, &&DoPointerPlusSP, &&DoPointerPlusIM, /* #o0230 */ + &&DoPointerDifferenceFP, &&DoPointerDifferenceLP, &&DoPointerDifferenceSP, &&DoPointerDifferenceIM, /* #o0231 */ + &&DoAshFP, &&DoAshLP, &&DoAshSP, &&DoAshIM, /* #o0232 */ + &&DoStoreConditionalFP, &&DoStoreConditionalLP, &&DoStoreConditionalSP, &&DoStoreConditionalIM, /* #o0233 */ + &&DoMemoryWriteFP, &&DoMemoryWriteLP, &&DoMemoryWriteSP, &&DoMemoryWriteIM, /* #o0234 */ + &&DoPStoreContentsFP, &&DoPStoreContentsLP, &&DoPStoreContentsSP, &&DoPStoreContentsIM, /* #o0235 */ + &&DoBindLocativeToValueFP, &&DoBindLocativeToValueLP, &&DoBindLocativeToValueSP, &&DoBindLocativeToValueIM, /* #o0236 */ + &&DoUnifyFP, &&DoUnifyLP, &&DoUnifySP, &&DoUnifyIM, /* #o0237 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0240 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0241 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0242 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0243 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0244 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0245 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0246 */ + &&DoPopLexicalVarNFP, &&DoPopLexicalVarNLP, &&DoPopLexicalVarNSP, &&DoPopLexicalVarNIM, /* #o0247 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0250 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0251 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0252 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0253 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0254 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0255 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0256 */ + &&DoMovemLexicalVarNFP, &&DoMovemLexicalVarNLP, &&DoMovemLexicalVarNSP, &&DoMovemLexicalVarNIM, /* #o0257 */ + &&DoEqualNumberFP, &&DoEqualNumberLP, &&DoEqualNumberSP, &&DoEqualNumberIM, /* #o0260 */ + &&DoLesspFP, &&DoLesspLP, &&DoLesspSP, &&DoLesspIM, /* #o0261 */ + &&DoGreaterpFP, &&DoGreaterpLP, &&DoGreaterpSP, &&DoGreaterpIM, /* #o0262 */ + &&DoEqlFP, &&DoEqlLP, &&DoEqlSP, &&DoEqlIM, /* #o0263 */ + &&DoEqualNumberFP, &&DoEqualNumberLP, &&DoEqualNumberSP, &&DoEqualNumberIM, /* #o0264 */ + &&DoLesspFP, &&DoLesspLP, &&DoLesspSP, &&DoLesspIM, /* #o0265 */ + &&DoGreaterpFP, &&DoGreaterpLP, &&DoGreaterpSP, &&DoGreaterpIM, /* #o0266 */ + &&DoEqlFP, &&DoEqlLP, &&DoEqlSP, &&DoEqlIM, /* #o0267 */ + &&DoEqFP, &&DoEqLP, &&DoEqSP, &&DoEqIM, /* #o0270 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /* #o0271 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /* #o0272 */ + &&DoLogtestFP, &&DoLogtestLP, &&DoLogtestSP, &&DoLogtestIM, /* #o0273 */ + &&DoEqFP, &&DoEqLP, &&DoEqSP, &&DoEqIM, /* #o0274 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /* #o0275 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /* #o0276 */ + &&DoLogtestFP, &&DoLogtestLP, &&DoLogtestSP, &&DoLogtestIM, /* #o0277 */ + &&DoAddFP, &&DoAddLP, &&DoAddSP, &&DoAddIM, /* #o0300 */ + &&DoSubFP, &&DoSubLP, &&DoSubSP, &&DoSubIM, /* #o0301 */ + &&Do32BitPlusFP, &&Do32BitPlusLP, &&Do32BitPlusSP, &&Do32BitPlusIM, /* #o0302 */ + &&Do32BitDifferenceFP, &&Do32BitDifferenceLP, &&Do32BitDifferenceSP, &&Do32BitDifferenceIM, /* #o0303 */ + &&DoAddBignumStepFP, &&DoAddBignumStepLP, &&DoAddBignumStepSP, &&DoAddBignumStepIM, /* #o0304 */ + &&DoSubBignumStepFP, &&DoSubBignumStepLP, &&DoSubBignumStepSP, &&DoSubBignumStepIM, /* #o0305 */ + &&DoMultiplyBignumStepFP, &&DoMultiplyBignumStepLP, &&DoMultiplyBignumStepSP, &&DoMultiplyBignumStepIM, /* #o0306 */ + &&DoDivideBignumStepFP, &&DoDivideBignumStepLP, &&DoDivideBignumStepSP, &&DoDivideBignumStepIM, /* #o0307 */ + &&DoAset1FP, &&DoAset1LP, &&DoAset1SP, &&DoAset1IM, /* #o0310 */ + &&DoAllocateListBlockFP, &&DoAllocateListBlockLP, &&DoAllocateListBlockSP, &&DoAllocateListBlockIM, /* #o0311 */ + &&DoAref1FP, &&DoAref1LP, &&DoAref1SP, &&DoAref1IM, /* #o0312 */ + &&DoAloc1FP, &&DoAloc1LP, &&DoAloc1SP, &&DoAloc1IM, /* #o0313 */ + &&DoStoreArrayLeaderFP, &&DoStoreArrayLeaderLP, &&DoStoreArrayLeaderSP, &&DoStoreArrayLeaderIM, /* #o0314 */ + &&DoAllocateStructureBlockFP, &&DoAllocateStructureBlockLP, &&DoAllocateStructureBlockSP, &&DoAllocateStructureBlockIM, /* #o0315 */ + &&DoArrayLeaderFP, &&DoArrayLeaderLP, &&DoArrayLeaderSP, &&DoArrayLeaderIM, /* #o0316 */ + &&DoAlocLeaderFP, &&DoAlocLeaderLP, &&DoAlocLeaderSP, &&DoAlocLeaderIM, /* #o0317 */ + &&DoPopInstanceVariableFP, &&DoPopInstanceVariableLP, &&DoPopInstanceVariableSP, &&DoPopInstanceVariableIM, /* #o0320 */ + &&DoMovemInstanceVariableFP, &&DoMovemInstanceVariableLP, &&DoMovemInstanceVariableSP, &&DoMovemInstanceVariableIM, /* #o0321 */ + &&DoPopInstanceVariableOrderedFP, &&DoPopInstanceVariableOrderedLP, &&DoPopInstanceVariableOrderedSP, &&DoPopInstanceVariableOrderedIM, /* #o0322 */ + &&DoMovemInstanceVariableOrderedFP, &&DoMovemInstanceVariableOrderedLP, &&DoMovemInstanceVariableOrderedSP, &&DoMovemInstanceVariableOrderedIM, /* #o0323 */ + &&DoInstanceRefFP, &&DoInstanceRefLP, &&DoInstanceRefSP, &&DoInstanceRefIM, /* #o0324 */ + &&DoInstanceSetFP, &&DoInstanceSetLP, &&DoInstanceSetSP, &&DoInstanceSetIM, /* #o0325 */ + &&DoInstanceLocFP, &&DoInstanceLocLP, &&DoInstanceLocSP, &&DoInstanceLocIM, /* #o0326 */ + &&DoSetTagFP, &&DoSetTagLP, &&DoSetTagSP, &&DoSetTagIM, /* #o0327 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0330 */ + &&DoUnsignedLesspFP, &&DoUnsignedLesspLP, &&DoUnsignedLesspSP, &&DoUnsignedLesspIM, /* #o0331 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0332 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0333 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0334 */ + &&DoUnsignedLesspFP, &&DoUnsignedLesspLP, &&DoUnsignedLesspSP, &&DoUnsignedLesspIM, /* #o0335 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0336 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0337 */ + &&DoPopFP, &&DoPopLP, &&DoPopSP, &&DoPopIM, /* #o0340 */ + &&DoMovemFP, &&DoMovemLP, &&DoMovemSP, &&DoMovemIM, /* #o0341 */ + &&DoMergeCdrNoPopFP, &&DoMergeCdrNoPopLP, &&DoMergeCdrNoPopSP, &&DoMergeCdrNoPopIM, /* #o0342 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0343 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0344 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0345 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0346 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0347 */ + &&DoFastAref1FP, &&DoFastAref1LP, &&DoFastAref1SP, &&DoFastAref1IM, /* #o0350 */ + &&DoFastAset1FP, &&DoFastAset1LP, &&DoFastAset1SP, &&DoFastAset1IM, /* #o0351 */ + &&DoStackBltAddressFP, &&DoStackBltAddressLP, &&DoStackBltAddressSP, &&DoStackBltAddressIM, /* #o0352 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0353 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0354 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0355 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0356 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0357 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0360 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0361 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0362 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0363 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0364 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0365 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0366 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0367 */ + &&DoDpbFP, &&DoDpbLP, &&DoDpbSP, &&DoDpbIM, /* #o0370 */ + &&DoCharDpbFP, &&DoCharDpbLP, &&DoCharDpbSP, &&DoCharDpbIM, /* #o0371 */ + &&DoPDpbFP, &&DoPDpbLP, &&DoPDpbSP, &&DoPDpbIM, /* #o0372 */ + &&DoPTagDpbFP, &&DoPTagDpbLP, &&DoPTagDpbSP, &&DoPTagDpbIM, /* #o0373 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0374 */ + &&DoLoopIncrementTosLessThanFP, &&DoLoopIncrementTosLessThanLP, &&DoLoopIncrementTosLessThanSP, &&DoLoopIncrementTosLessThanIM, /* #o0375 */ + &&DoCatchOpenFP, &&DoCatchOpenLP, &&DoCatchOpenSP, &&DoCatchOpenIM, /* #o0376 */ + &&DoSpareOpFP, &&DoSpareOpLP, &&DoSpareOpSP, &&DoSpareOpIM, /*#o0377 */ +}; + +void *_fullworddispatch[] + = { + &&nullfw, /* #o00 = DTP-NULL */ + &&monitorforwardfw, /* #o01 = DTP-MONITOR-FORWARD */ + &&headerpfw, /* #o02 = DTP-HEADER-P */ + &&headerifw, /* #o03 = DTP-HEADER-I */ + &&valuecell, /* #o04 = DTP-EXTERNAL-VALUE-CELL-POINTER */ + &&oneqforwardfw, /* #o05 = DTP-ONE-Q-FORWARD */ + &&headerforwardfw, /* #o06 = DTP-HEADER-FORWARD */ + &&elementforwardfw, /* #o07 = DTP-ELEMENT-FORWARD */ + &&pushconstantvalue, /* #o10 = DTP-FIXNUM */ + &&pushconstantvalue, /* #o11 = DTP-SMALL-RATIO */ + &&pushconstantvalue, /* #o12 = DTP-SINGLE-FLOAT */ + &&pushconstantvalue, /* #o13 = DTP-DOUBLE-FLOAT */ + &&pushconstantvalue, /* #o14 = DTP-BIGNUM */ + &&pushconstantvalue, /* #o15 = DTP-BIG-RATIO */ + &&pushconstantvalue, /* #o16 = DTP-COMPLEX */ + &&pushconstantvalue, /* #o17 = DTP-SPARE-NUMBER */ + &&pushconstantvalue, /* #o20 = DTP-INSTANCE */ + &&pushconstantvalue, /* #o21 = DTP-LIST-INSTANCE */ + &&pushconstantvalue, /* #o22 = DTP-ARRAY-INSTANCE */ + &&pushconstantvalue, /* #o23 = DTP-STRING-INSTANCE */ + &&pushconstantvalue, /* #o24 = DTP-NIL */ + &&pushconstantvalue, /* #o25 = DTP-LIST */ + &&pushconstantvalue, /* #o26 = DTP-ARRAY */ + &&pushconstantvalue, /* #o27 = DTP-STRING */ + &&pushconstantvalue, /* #o30 = DTP-SYMBOL */ + &&pushconstantvalue, /* #o31 = DTP-LOCATIVE */ + &&pushconstantvalue, /* #o32 = DTP-LEXICAL-CLOSURE */ + &&pushconstantvalue, /* #o33 = DTP-DYNAMIC-CLOSURE */ + &&pushconstantvalue, /* #o34 = DTP-COMPILED-FUNCTION */ + &&pushconstantvalue, /* #o35 = DTP-GENERIC-FUNCTION */ + &&pushconstantvalue, /* #o36 = DTP-SPARE-POINTER-1 */ + &&pushconstantvalue, /* #o37 = DTP-SPARE-POINTER-2 */ + &&pushconstantvalue, /* #o40 = DTP-PHYSICAL-ADDRESS */ + &&nativeinstruction, /* #o41 = DTP-SPARE-IMMEDIATE-1 *Hijacked for nativeinstruction **/ + &&boundlocationfw, /* #o42 = DTP-BOUND-LOCATION */ + &&pushconstantvalue, /* #o43 = DTP-CHARACTER */ + &&logicvariablefw, /* #o44 = DTP-LOGIC-VARIABLE */ + &&gcforwardfw, /* #o45 = DTP-GC-FORWARD */ + &&pushconstantvalue, /* #o46 = DTP-EVEN-PC */ + &&pushconstantvalue, /* #o47 = DTP-ODD-PC */ + &&callcompiledeven, /* #o50 = DTP-CALL-COMPILED-EVEN */ + &&callcompiledodd, /* #o51 = DTP-CALL-COMPILED-ODD */ + &&callindirect, /* #o52 = DTP-CALL-INDIRECT */ + &&callgeneric, /* #o53 = DTP-CALL-GENERIC */ + &&callcompiledevenprefetch, /* #o54 = DTP-CALL-COMPILED-EVEN-PREFETCH */ + &&callcompiledoddprefetch, /* #o55 = DTP-CALL-COMPILED-ODD-PREFETCH */ + &&callindirectprefetch, /* #o56 = DTP-CALL-INDIRECT-PREFETCH */ + &&callgenericprefetch /* #o57 = DTP-CALL-GENERIC-PREFETCH */ +}; + +void *_internalregisterread1[] + = { + &&ReadRegisterError, /* ReadRegisterEA */ + &&ReadRegisterFP, + &&ReadRegisterLP, + &&ReadRegisterSP, + &&ReadRegisterError, /* ReadRegisterMacroSP */ + &&ReadRegisterStackCacheLowerBound, + &&ReadRegisterBARx, + &&ReadRegisterError, /* ReadRegisterPHTHashx */ + &&ReadRegisterError, /* ReadRegisterEPC */ + &&ReadRegisterError, /* ReadRegisterDPC */ + &&ReadRegisterContinuation, + &&ReadRegisterAluAndRotateControl, + &&ReadRegisterControlRegister, + &&ReadRegisterCRArgumentSize, + &&ReadRegisterEphemeralOldspaceRegister, + &&ReadRegisterZoneOldspaceRegister, + &&ReadRegisterChipRevision, + &&ReadRegisterFPCoprocessorPresent, + &&ReadRegisterError, + &&ReadRegisterPreemptRegister, + &&ReadRegisterIcacheControl, + &&ReadRegisterPrefetcherControl, + &&ReadRegisterMapCacheControl, + &&ReadRegisterMemoryControl, + &&ReadRegisterError, /* ReadRegisterECCLog */ + &&ReadRegisterError, /* ReadRegisterECCLogAddress */ + &&ReadRegisterError, /* ReadRegisterInvalidateMapx */ + &&ReadRegisterError, /* ReadRegisterLoadMapx */ + &&ReadRegisterStackCacheOverflowLimit, + &&ReadRegisterError, /* ReadRegisterUcodeROMContents */ + &&ReadRegisterError, + &&ReadRegisterError, /* ReadRegisterAddressMask */ + &&ReadRegisterError, /* ReadRegisterEntryMaximumArguments */ + &&ReadRegisterError, /* ReadRegisterLexicalVariable */ + &&ReadRegisterError, /* ReadRegisterInstruction */ + &&ReadRegisterError, + &&ReadRegisterError, /* ReadRegisterMemoryData */ + &&ReadRegisterError, /* ReadRegisterDataPins */ + &&ReadRegisterError, /* ReadRegisterExtensionRegister */ + &&ReadRegisterMicrosecondClock, + &&ReadRegisterError, /* ReadRegisterArrayHeaderLength */ + &&ReadRegisterError, + &&ReadRegisterError /* ReadRegisterLoadBAR */ +}; + +void *_internalregisterread2[] + = { + &&ReadRegisterTOS, + &&ReadRegisterEventCount, + &&ReadRegisterBindingStackPointer, + &&ReadRegisterCatchBlockList, + &&ReadRegisterControlStackLimit, + &&ReadRegisterControlStackExtraLimit, + &&ReadRegisterBindingStackLimit, + &&ReadRegisterPHTBase, + &&ReadRegisterPHTMask, + &&ReadRegisterCountMapReloads, + &&ReadRegisterListCacheArea, + &&ReadRegisterListCacheAddress, + &&ReadRegisterListCacheLength, + &&ReadRegisterStructureCacheArea, + &&ReadRegisterStructureCacheAddress, + &&ReadRegisterStructureCacheLength, + &&ReadRegisterDynamicBindingCacheBase, + &&ReadRegisterDynamicBindingCacheMask, + &&ReadRegisterChoicePointer, + &&ReadRegisterStructureStackChoicePointer, + &&ReadRegisterFEPModeTrapVectorAddress, + &&ReadRegisterError, + &&ReadRegisterError, /* ReadRegisterMappingTableCache */ + &&ReadRegisterError, /* ReadRegisterMappingTableLength */ + &&ReadRegisterStackFrameMaximumSize, + &&ReadRegisterStackCacheDumpQuantum, + &&ReadRegisterError, + &&ReadRegisterError, + &&ReadRegisterError, + &&ReadRegisterError, + &&ReadRegisterError, + &&ReadRegisterError, + &&ReadRegisterConstantNIL, + &&ReadRegisterConstantT +}; + +void *_internalregisterwrite1[] + = { + &&WriteRegisterError, /* WriteRegisterEA */ + &&WriteRegisterFP, + &&WriteRegisterLP, + &&WriteRegisterSP, + &&WriteRegisterError, /* WriteRegisterMacroSP */ + &&WriteRegisterStackCacheLowerBound, + &&WriteRegisterBARx, + &&WriteRegisterError, /* WriteRegisterPHTHashx */ + &&WriteRegisterError, /* WriteRegisterEPC */ + &&WriteRegisterError, /* WriteRegisterDPC */ + &&WriteRegisterContinuation, + &&WriteRegisterAluAndRotateControl, + &&WriteRegisterControlRegister, + &&WriteRegisterError, /* WriteRegisterCRArgumentSize */ + &&WriteRegisterEphemeralOldspaceRegister, + &&WriteRegisterZoneOldspaceRegister, + &&WriteRegisterError, /* WriteRegisterChipRevision */ + &&WriteRegisterFPCoprocessorPresent, + &&WriteRegisterError, + &&WriteRegisterPreemptRegister, + &&WriteRegisterError, /* WriteRegisterIcacheControl */ + &&WriteRegisterError, /* WriteRegisterPrefetcherControl */ + &&WriteRegisterError, /* WriteRegisterMapCacheControl */ + &&WriteRegisterError, /* WriteRegisterMemoryControl */ + &&WriteRegisterError, /* WriteRegisterECCLog */ + &&WriteRegisterError, /* WriteRegisterECCLogAddress */ + &&WriteRegisterError, /* WriteRegisterInvalidateMapx */ + &&WriteRegisterError, /* WriteRegisterLoadMapx */ + &&WriteRegisterStackCacheOverflowLimit, + &&WriteRegisterError, /* WriteRegisterUcodeROMContents */ + &&WriteRegisterError, + &&WriteRegisterError, /* WriteRegisterAddressMask */ + &&WriteRegisterError, /* WriteRegisterEntryMaximumArguments */ + &&WriteRegisterError, /* WriteRegisterLexicalVariable */ + &&WriteRegisterError, /* WriteRegisterInstruction */ + &&WriteRegisterError, + &&WriteRegisterError, /* WriteRegisterMemoryData */ + &&WriteRegisterError, /* WriteRegisterDataPins */ + &&WriteRegisterError, /* WriteRegisterExtensionRegister */ + &&WriteRegisterError, /* WriteRegisterMicrosecondClock */ + &&WriteRegisterError, /* WriteRegisterArrayHeaderLength */ + &&WriteRegisterError, + &&WriteRegisterError /* WriteRegisterLoadBAR */ +}; + +void *_internalregisterwrite2[] + = { + &&WriteRegisterTOS, + &&WriteRegisterEventCount, + &&WriteRegisterBindingStackPointer, + &&WriteRegisterCatchBlockList, + &&WriteRegisterControlStackLimit, + &&WriteRegisterControlStackExtraLimit, + &&WriteRegisterBindingStackLimit, + &&WriteRegisterError, /* WriteRegisterPHTBase */ + &&WriteRegisterError, /* WriteRegisterPHTMask */ + &&WriteRegisterError, /* WriteRegisterCountMapReloads */ + &&WriteRegisterListCacheArea, + &&WriteRegisterListCacheAddress, + &&WriteRegisterListCacheLength, + &&WriteRegisterStructureCacheArea, + &&WriteRegisterStructureCacheAddress, + &&WriteRegisterStructureCacheLength, + &&WriteRegisterDynamicBindingCacheBase, + &&WriteRegisterDynamicBindingCacheMask, + &&WriteRegisterChoicePointer, + &&WriteRegisterStructureStackChoicePointer, + &&WriteRegisterFEPModeTrapVectorAddress, + &&WriteRegisterError, + &&WriteRegisterMappingTableCache, + &&WriteRegisterError, /* WriteRegisterMappingTableLength */ + &&WriteRegisterError, /* WriteRegisterStackFrameMaximumSize */ + &&WriteRegisterError, /* WriteRegisterStackCacheDumpQuantum */ + &&WriteRegisterError, + &&WriteRegisterError, + &&WriteRegisterError, + &&WriteRegisterError, + &&WriteRegisterError, + &&WriteRegisterError, + &&WriteRegisterError, /* WriteRegisterConstantNIL */ + &&WriteRegisterError /* WriteRegisterConstant */ +}; + diff --git a/stub/fib/fib.lisp b/stub/fib/fib.lisp new file mode 100644 index 0000000..3dfc637 --- /dev/null +++ b/stub/fib/fib.lisp @@ -0,0 +1,4 @@ +(defun fibonacci (x) + (if (<= x 2) + 1 + (+ (fibonacci (- x 2))(fibonacci (1- x))))) diff --git a/stub/float1 b/stub/float1 new file mode 100644 index 0000000..3542bf6 --- /dev/null +++ b/stub/float1 @@ -0,0 +1,347 @@ +/* --- float1 --- */ + +#define LDS(rn, r, s) r = s +#define LDT(rn, r, s) r = s +#define STS(d, rn, r) *d = r +#define STT(d, rn, r) *d = r + + +#define CVTLQ(dr, d, s1, sr2, s2) d = _CVTLQ(s1, s2) +#define CVTQL(dr, d, s1, sr2, s2) d = _CVTQL(s1, s2) +#define CVTQLV(dr, d, s1, sr2, s2) d = _CVTQL(s1, s2) +#define CVTQS(dr, d, s1, sr2, s2) d = _CVTQS(s1, s2) +#define CVTQT(dr, d, s1, sr2, s2) d = _CVTQT(s1, s2) +#define CVTTQ(dr, d, s1, sr2, s2) d = _CVTTQ(s1, s2) +#define CVTTQV(dr, d, s1, sr2, s2) d = _CVTTQ(s1, s2) +#define CVTTQVC(dr, d, s1, sr2, s2) d = _CVTTQ(s1, s2) +#define CVTTQVM(dr, d, s1, sr2, s2) d = _CVTTQVM(s1, s2) +#define CVTTQSVI(dr, d, s1, sr2, s2) d = _CVTTQ(s1, s2) +#define CVTTS(dr, d, s1, sr2, s2) d = _CVTTS(s1, s2) + +#define CPYSN(dr, d, sr1, s1, sr2, s2) d = _CPYSN(s1, s2) + +inline u64 _CVTLQ(u64 v1, u64 v2) +{ +// return (s32)(v2 & 0xffffffffL); + return (int)v2; +} + +inline u64 _CVTQLV(u64 v1, u64 v2) +{ + u64 l; + l = (int)v2; + return l; +} + +inline u64 _CVTQS(u64 v1, u64 v2) +{ + union { + float f; + long l; + } u; + u.f = (s64)v2; + return u.l; +} + +inline u64 _CVTQT(u64 v1, u64 v2) +{ + union { + double d; + u64 l; + } u; + u.d = (s64)v2; + return u.l; +} + +inline u64 _CVTQL(u64 v1, u64 v2) +{ + u64 l; + l = (int)v2; + return l; +} + +inline u64 _CVTTQVC(u64 v1, u64 v2) +{ + union { + double d; + u64 l; + } u; + u.l = v2; + return (u64)u.d; +} + +inline u64 _CVTTQVM(u64 v1, u64 v2) +{ + union { + double d; + u64 l; + } u; + u.l = v2; + // printf("CVTTQVM: %g %d\n", u.d, (int)trunc(u.d)); + // return (int)trunc(u.d); +if (u.d < 0.0) u.d -= 0.5; +//if (u.d > 0.0) u.d += 0.5; + printf("CVTTQVM: %g %d\n", u.d, (int)u.d); + return (int)u.d; +} + +inline u64 _CVTTQSVI(u64 v1, u64 v2) +{ + union { + double d; + long l; + } u; + u.l = v2; + return (u64)u.d; +} + +inline u64 _CVTTQ(u64 v1, u64 v2) +{ + union { + double d; + long l; + } u; + u.l = v2; + return (u64)u.d; +} + +inline u64 _CVTTQV(u64 v1, u64 v2) +{ + union { + double d; + long l; + } u; + u.l = v2; + return (u64)u.d; +} + +inline u64 _CVTTS(u64 v1, u64 v2) +{ + union { + double d; + long l; + } u; + union { + float f; + int i; + } u2; + + u.l = v2; + u2.f = u.d; + + return (u64)u2.i; +} + +inline u64 _CPYSN(u64 a, u64 b) +{ + union { + double d; + long l; + } u1, u2; + double signbit = -1.0; + u1.l = a; + u2.l = b; + printf("CPYSN: %g %g ", u1.d, u2.d); + if (u1.d <= 0.0) + signbit = 1.0; + if (u2.d < 0.0) + u2.d = -u2.d; + u2.d *= signbit; + printf(" -> %g\n", u2.d); + return u2.l; +} + +inline u64 fixsfloat(u64 v) +{ + union { + double d; + long l; + } u; + union { + float f; + int i; + long l; + } u2; + + if ((v >> 32) == 0) + return v; + + u.l = v; + u2.l = 0; + u2.f = u.d; + + return (u64)u2.l; +} + +inline u64 fixtfloat(u64 v) +{ + union { + double d; + long l; + } u; + union { + float f; + int i; + long l; + } u2; + + if ((v >> 32) != 0) + return v; + + u2.l = v; + u.d = u2.f; + + return (u64)u.l; +} + +#define ADDS(dr, d, sr1, s1, sr2, s2) d = _ADDS(s1, s2) +#define ADDT(dr, d, sr1, s1, sr2, s2) d = _ADDT(s1, s2) +#define SUBS(dr, d, sr1, s1, sr2, s2) d = _SUBS(s1, s2) +#define SUBT(dr, d, sr1, s1, sr2, s2) d = _SUBT(s1, s2) +#define MULS(dr, d, sr1, s1, sr2, s2) d = _MULS(s1, s2) +#define MULT(dr, d, sr1, s1, sr2, s2) d = _MULT(s1, s2) +#define DIVS(dr, d, sr1, s1, sr2, s2) d = _DIVS(s1, s2) +#define DIVT(dr, d, sr1, s1, sr2, s2) d = _DIVT(s1, s2) + + +inline u64 _ADDS(u64 a, u64 b) +{ + union { + float f; + u64 l; + } u1, u2; + u1.l = fixsfloat(a); + u2.l = fixsfloat(b); + printf("ADDS: %p %p\n", a, b); + printf("ADDS: %g %g %g\n", u1.f, u2.f, u1.f + u2.f); + u1.f = u1.f + u2.f; + return u1.l; +} + +inline u64 _ADDT(u64 a, u64 b) +{ + union { + double d; + u64 l; + } u1, u2; + u1.l = a; + u2.l = b; + printf("ADDT: %p %p\n", a, b); + printf("ADDT: %g %g %g\n", u1.d, u2.d, u1.d + u2.d); + u1.d = u1.d + u2.d; + return u1.l; +} + +inline u64 _SUBS(u64 a, u64 b) +{ + union { + float f; + u64 l; + } u1, u2; + + u1.l = fixsfloat(a); + u2.l = fixsfloat(b); + + // printf("SUBS: %p %p\n", a, b); + // printf("SUBS: %g %g %g\n", u1.f, u2.f, u1.f - u2.f); + u1.f = u1.f - u2.f; + return u1.l; +} + +inline u64 _SUBT(u64 a, u64 b) +{ + union { + double d; + u64 l; + } u1, u2; + u1.l = a; + u2.l = b; + u1.d = u1.d - u2.d; + return u1.l; +} + +inline u64 _MULS(u64 a, u64 b) +{ + union { + float f; + u64 l; + } u1, u2; + u1.l = fixsfloat(a); + u2.l = fixsfloat(b); + // printf("MULS: %p %p -> %p %p\n", a, b, u1.l, u2.l); + // printf("MULS: %g %g %g\n", u1.f, u2.f, u1.f * u2.f); + u1.f = u1.f * u2.f; + return u1.l; +} + +inline u64 _MULT(u64 a, u64 b) +{ + union { + double d; + u64 l; + } u1, u2; + u1.l = a; + u2.l = b; + u1.d = u1.d * u2.d; + return u1.l; +} + +inline u64 _DIVS(u64 a, u64 b) +{ + union { + float f; + u64 l; + } u1, u2; + u1.l = fixsfloat(a); + u2.l = fixsfloat(b); + printf("DIVS: %p %p\n", a, b); + printf("DIVS: %g %g %g\n", u1.f, u2.f, u1.f / u2.f); + u1.f = u1.f / u2.f; + return u1.l; +} + +inline u64 _DIVT(u64 a, u64 b) +{ + union { + double d; + u64 l; + } u1, u2; + u1.l = a; + u2.l = b; + u1.d = u1.d / u2.d; + return u1.l; +} + +#define FLTU64(rv, v) _FLTU64(v) + +inline double _FLTU64(u64 v) +{ + union { + double d; + u64 l; + } u; + u.l = fixtfloat(v); + // u.l = v; + return u.d; +} + +inline u64 U64FLTT(double v) +{ + union { + double d; + u64 l; + } u; + u.d = v; + return u.l; +} + +inline u64 U64FLTS(float v) +{ + union { + float f; + u64 l; + } u; + u.l = 0; + u.f = v; + return u.l; +} diff --git a/stub/float2 b/stub/float2 new file mode 100644 index 0000000..c5e2312 --- /dev/null +++ b/stub/float2 @@ -0,0 +1,476 @@ +/* --- float2 --- */ + +//#define LOUD + +int fregstate[32]; +int subtrace; + +enum { + FPS_LOADT = 1, + FPS_T, // 8 byte T_float + FPS_Q, // 8 byte int + FPS_LOADS, + FPS_S, // 4 byte S_float + FPS_L, // 4 byte int +}; + +#define SETFLTT(rn, r, s) \ + do { r = U64FLTT(s); fregstate[rn] = FPS_T; } while(0) + +#define LDS(rn, r, s) r = _LDS(rn, s); +#define LDT(rn, r, s) r = _LDT(rn, s); +#define STS(d, rn, r) *d = _STS(rn, r); +#define STT(d, rn, r) *d = _STT(rn, r); + +inline u64 +_LDS(int regnum, u64/*u32*/ v) +{ + fregstate[regnum] = FPS_LOADS; + //printf("_LDS: %d %p\n", regnum, v); + return v; +} + +inline u64 +_LDT(int regnum, u64 v) +{ + fregstate[regnum] = FPS_LOADT; + return v; +} + +inline u64/*u32*/ +_STS(int regnum, u64 v) +{ + if (fregstate[regnum] != FPS_L && + fregstate[regnum] != FPS_S && + fregstate[regnum] != FPS_LOADS) + { + printf("_STS: %p(%d)\n", (void *)v, fregstate[regnum]); + } + return v; +} + +inline u64 +_STT(int regnum, u64 v) +{ + if (fregstate[regnum] > FPS_T) { + printf("_STT: %p(%d)\n", (void *)v, fregstate[regnum]); + } + return v; +} + +inline float fixsfloat(int r, u64 v) +{ +#if 1 + union { + double d; + u64 l; + } u; + union { + float f; + u64 l; + } u2; + + //printf("fixsfloat: %d %p(%d)\n", r, (void *)v, fregstate[r]); + switch (fregstate[r]) { + case FPS_LOADT: + case FPS_T: + u.l = v; + return (float)u.d; + + case FPS_LOADS: + case FPS_S: + u2.l = v; + return u2.f; + } + + if (v != 0) + printf("fixsfloat: f%d is Q/L! %p\n", r, (void *)v); + return 0.0; +#else + union { + double d; + long l; + } u; + union { + float f; + int i; + long l; + } u2; + + if ((v >> 32) == 0) { +if (fregstate[r] != FPS_S && fregstate[r] != FPS_LOADS && v != 0) +printf("fixsfloat: assuming S f%d %p(%d)\n", r, (void *)v, fregstate[r]); + u2.l = v; + return u2.f; + } + +if (fregstate[r] != FPS_T) +printf("fixsfloat: assuming T f%d %p(%d)\n", r, (void *)v, fregstate[r]); + u.l = v; + u2.l = 0; + u2.f = u.d; + + return u2.f; +#endif +} + +inline double fixtfloat(int r, u64 v) +{ +#if 1 + union { + double d; + u64 l; + } u; + union { + float f; + u64 l; + } u2; + + //printf("fixtfloat: %d %p(%d)\n", r, v, fregstate[r]); + switch (fregstate[r]) { + case FPS_LOADT: + case FPS_T: + u.l = v; + return u.d; + + case FPS_LOADS: + case FPS_S: + u2.l = v; + return (double)u2.f; + } + + printf("fixtfloat: f%d is Q/L! %p(%d)\n", r, (void *)v, fregstate[r]); + return 0.0; +#else + union { + double d; + long l; + } u; + union { + float f; + int i; + long l; + } u2; + + if ((v >> 32) != 0 || v == 0) { +if (fregstate[r] != FPS_T && v != 0) +printf("fixtfloat: assuming T f%d %p(%d)\n", r, (void *)v, fregstate[r]); + u.l = v; + return u.d; + } + +if (fregstate[r] != FPS_S && fregstate[r] != FPS_LOADS) { +printf("fixtfloat: assuming S f%d %p(%d)\n", r, (void *)v, fregstate[r]); +while (1); +} + u2.l = v; + u.d = u2.f; + + return u.d; +#endif +} + +#define CPYSN(dr, d, sr1, s1, sr2, s2) d = _CPYSN(dr, sr1, s1, sr2, s2) + +inline u64 _CPYSN(int rd, int ra, u64 a, int rb, u64 b) +{ + union { + double d; + u64 l; + } u1, u2; + double signbit = -1.0; + u1.l = a; + u2.l = b; + + if (fregstate[ra] != FPS_T || fregstate[rb] != FPS_T) { + printf("CPYSN: %p %p\n", (void *)a, (void *)b); + printf("CPYSN: %g(%d) %g(%d) ", u1.d, fregstate[ra], u2.d, fregstate[rb]); + } + + if (u1.d <= 0.0) + signbit = 1.0; + if (u2.d < 0.0) + u2.d = -u2.d; + u2.d *= signbit; + // printf(" -> %g\n", u2.d); + fregstate[rd] = FPS_T; + return u2.l; +} + + +#define CVTLQ(dr, d, s1, sr2, s2) d = _CVTLQ(dr, sr2, s2) +#define CVTQL(dr, d, s1, sr2, s2) d = _CVTQL(dr, sr2, s2) +#define CVTQLV(dr, d, s1, sr2, s2) d = _CVTQL(dr, sr2, s2) +#define CVTQS(dr, d, s1, sr2, s2) d = _CVTQS(dr, sr2, s2) +#define CVTQT(dr, d, s1, sr2, s2) d = _CVTQT(dr, sr2, s2) +#define CVTTQ(dr, d, s1, sr2, s2) d = _CVTTQ(dr, sr2, s2) +#define CVTTQV(dr, d, s1, sr2, s2) d = _CVTTQ(dr, sr2, s2) +#define CVTTQVC(dr, d, s1, sr2, s2) d = _CVTTQ(dr, sr2, s2) +#define CVTTQVM(dr, d, s1, sr2, s2) d = _CVTTQVM(dr, sr2, s2) +#define CVTTQSVI(dr, d, s1, sr2, s2) d = _CVTTQ(dr, sr2, s2) +#define CVTTS(dr, d, s1, sr2, s2) d = _CVTTS(dr, sr2, s2) + +//#define LOUD + +inline u64 _CVTLQ(int dr, int rv2, u64 v2) +{ + if (fregstate[rv2] != FPS_L && fregstate[rv2] != FPS_LOADS) { + printf("_CVTLQ: %p(%d)\n", (void *)v2, fregstate[rv2]); + } +#ifdef LOUD + if (subtrace) printf("_CVTLQ: %p\n", (void *)v2); +#endif + fregstate[dr] = FPS_Q; + return (int)v2; +} + +inline u64 _CVTQL(int dr, int rv2, u64 v2) +{ + u64 l; + l = (int)v2; + fregstate[dr] = FPS_L; + return l; +} + +inline u64 _CVTQS(int dr, int rv2, u64 v2) +{ + union { + float f; + u64 l; + } u; + fregstate[dr] = FPS_S; + u.f = (s64)v2; +#ifdef LOUD + if (subtrace) printf("_CVTQS: %p %g -> %p\n", (void *)v2, u.f, (void *)u.l); +#endif + return u.l; +} + +inline u64 _CVTQT(int dr, int rv2, u64 v2) +{ + union { + double d; + u64 l; + } u; + if (fregstate[rv2] != FPS_Q) { + printf("_CVTQT: %p(%d)\n", (void *)v2, fregstate[rv2]); + } + fregstate[dr] = FPS_T; + u.d = (s64)v2; +#ifdef LOUD +// printf("_CVTQT(d=r%d) %llx %g -> %p\n", dr, v2, u.d, (void *)u.l); +// printf("_CVTQT(d=r%d) %p %g -> %p\n", dr, (void *)v2, u.d, (void *)u.l); + if (subtrace) printf("_CVTQT(d=r%d) %p %g -> %p\n", dr, (void *)v2, 0.0/*u.d*/, (void *)u.l); +#endif + return u.l; +} + +inline u64 _CVTTQ(int dr, int rv2, u64 v2) +{ + union { + double d; + u64 l; + } u; + if (fregstate[rv2] > FPS_T) { + printf("_CVTTQ: %p(%d)\n", (void *)v2, fregstate[rv2]); + } + fregstate[dr] = FPS_Q; + u.l = v2; +#ifdef LOUD + if (subtrace) printf("_CVTTQ %p %g %p -> %p\n", (void *)v2, u.d, (void *)u.l, (void *)(u64)u.d); +#endif + return (u64)(u.d); +} + +inline inline u64 _CVTTQVM(int dr, int rv2, u64 v2) +{ + union { + double d; + u64 l; + } u; + u.l = v2; + // printf("CVTTQVM: %g %d\n", u.d, (int)trunc(u.d)); + // return (int)trunc(u.d); +if (u.d < 0.0) u.d -= 0.5; +//if (u.d > 0.0) u.d += 0.5; +// printf("CVTTQVM: %g %d\n", u.d, (int)u.d); + fregstate[dr] = FPS_Q; +#ifdef LOUD + if (subtrace) printf("_CVTTQVM %p -> %p\n", (void *)v2, (void *)(long)u.d); +#endif + return (long)u.d; +} + +inline u64 _CVTTS(int dr, int rv2, u64 v2) +{ + union { + double d; + long l; + } u; + union { + float f; + u32 i; + long l; + } u2; + + u.l = v2; + u2.l = 0; + u2.f = u.d; + +#ifdef LOUD + if (subtrace) printf("_CVTTS %p -> %p\n", (void *)v2, (void *)(u64)u2.i); +#endif + + if (fregstate[rv2] != FPS_T && fregstate[rv2] != FPS_LOADT) { + printf("_CVTTS: f%d %p <- %p(%d)\n", + dr, (void *)(u64)u2.i, (void *)v2, fregstate[rv2]); + } + + fregstate[dr] = FPS_S; + return (u64)u2.i; +} + +inline double FLTU64(int rv, u64 v) +{ + return fixtfloat(rv, v); +} + +inline u64 U64FLTT(double v) +{ + union { + double d; + u64 l; + } u; + u.d = v; + return u.l; +} + +inline u64 U64FLTS(float v) +{ + union { + float f; + u64 l; + } u; +// u.l = 0; + u.f = v; + return u.l; +} + +#define ADDS(dr, d, sr1, s1, sr2, s2) d = _ADDS(dr, sr1, s1, sr2, s2) +#define SUBS(dr, d, sr1, s1, sr2, s2) d = _SUBS(dr, sr1, s1, sr2, s2) +#define MULS(dr, d, sr1, s1, sr2, s2) d = _MULS(dr, sr1, s1, sr2, s2) +#define DIVS(dr, d, sr1, s1, sr2, s2) d = _DIVS(dr, sr1, s1, sr2, s2) + +#define ADDT(dr, d, sr1, s1, sr2, s2) d = _ADDT(dr, sr1, s1, sr2, s2) +#define SUBT(dr, d, sr1, s1, sr2, s2) d = _SUBT(dr, sr1, s1, sr2, s2) +#define MULT(dr, d, sr1, s1, sr2, s2) d = _MULT(dr, sr1, s1, sr2, s2) +#define DIVT(dr, d, sr1, s1, sr2, s2) d = _DIVT(dr, sr1, s1, sr2, s2) + +inline u64 _ADDS(int rd, int ra, u64 a, int rb, u64 b) +{ + float fa, fb; + fa = fixsfloat(ra, a); + fb = fixsfloat(rb, b); +#ifdef LOUD + printf("ADDS: %p %p\n", (void *)a, (void *)b); + printf("ADDS: %g %g %g\n", fa, fb, fa + fb); +#endif + fregstate[rd] = FPS_S; + return U64FLTS(fa + fb); +} + +inline u64 _ADDT(int rd, int ra, u64 a, int rb, u64 b) +{ + double fa, fb; + fa = fixtfloat(ra, a); + fb = fixtfloat(rb, b); +#ifdef LOUD + printf("ADDT: %p %p\n", (void *)a, (void *)b); + printf("ADDT: %g %g %g\n", fa, fb, fa + fb); +#endif + fregstate[rd] = FPS_T; + return U64FLTT(fa + fb); +} + +inline u64 _SUBS(int rd, int ra, u64 a, int rb, u64 b) +{ + float fa, fb; + fa = fixsfloat(ra, a); + fb = fixsfloat(rb, b); +#ifdef LOUD + printf("SUBS: %p %p\n", (void *)a, (void *)b); + printf("SUBS: %g %g %g\n", fa, fb, fa - fb); +#endif + fregstate[rd] = FPS_S; + return U64FLTS(fa - fb); +} + +inline u64 _SUBT(int rd, int ra, u64 a, int rb, u64 b) +{ + double fa, fb; + fa = fixtfloat(ra, a); + fb = fixtfloat(rb, b); +#ifdef LOUD + printf("SUBT: %p %p\n", (void *)a, (void *)b); + printf("SUBT: %g %g %g\n", fa, fb, fa - fb); +#endif + fregstate[rd] = FPS_T; + return U64FLTT(fa - fb); +} + +inline u64 _MULS(int rd, int ra, u64 a, int rb, u64 b) +{ + float fa, fb; + fa = fixsfloat(ra, a); + fb = fixsfloat(rb, b); +#ifdef LOUD + printf("MULS: %p %p\n", (void *)a, (void *)b); + printf("MULS: %g %g %g\n", fa, fb, fa * fb); +#endif + fregstate[rd] = FPS_S; + return U64FLTS(fa * fb); +} + +inline u64 _MULT(int rd, int ra, u64 a, int rb, u64 b) +{ + double fa, fb; + fa = fixtfloat(ra, a); + fb = fixtfloat(rb, b); +#ifdef LOUD + printf("MULT: %p %p\n", (void *)a, (void *)b); + printf("MULT: %g %g %g\n", fa, fb, fa * fb); +#endif + fregstate[rd] = FPS_T; + return U64FLTT(fa * fb); +} + +inline u64 _DIVS(int rd, int ra, u64 a, int rb, u64 b) +{ + float fa, fb; + fa = fixsfloat(ra, a); + fb = fixsfloat(rb, b); +#ifdef LOUD + printf("DIVS: %p %p\n", (void *)a, (void *)b); + printf("DIVS: %g %g %g\n", fa, fb, fa / fb); +#endif + fregstate[rd] = FPS_S; + return U64FLTS(fa / fb); +} + +inline u64 _DIVT(int rd, int ra, u64 a, int rb, u64 b) +{ + double fa, fb; + fa = fixtfloat(ra, a); + fb = fixtfloat(rb, b); +#ifdef LOUD + printf("DIVT: %d:%p %d:%p -> %p %p\n", + fregstate[ra], (void *)a, fregstate[rb], (void *)b, (void *)*(long *)&fa, (void *)*(long *)&fb); + printf("DIVT: %g %g %g %p\n", fa, fb, fa / fb, (void *)U64FLTT(fa / fb)); +#endif + fregstate[rd] = FPS_T; + return U64FLTT(fa / fb); +} + +#undef LOUD + +/* --- end float --- */ diff --git a/stub/idispat.c b/stub/idispat.c new file mode 100644 index 0000000..06af7fb --- /dev/null +++ b/stub/idispat.c @@ -0,0 +1,869 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/idispat.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* This file implements the main instruction dispatch loop. */ +/* start DummyDoNothingSubroutine */ + + +dummydonothingsubroutine: + if (_trace) printf("dummydonothingsubroutine:\n"); + goto continuecurrentinstruction; + +/* end DummyDoNothingSubroutine */ +/* start MemoryReadData */ + + +memoryreaddata: + if (_trace) printf("memoryreaddata:\n"); + /* Memory Read Internal */ + +g6045: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6047; + +g6046: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6049; + +g6055: + goto *r0; /* ret */ + +memoryreaddatadecode: + if (_trace) printf("memoryreaddatadecode:\n"); + if (t6 == 0) + goto g6048; + +g6047: + if (_trace) printf("g6047:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + arg6 = *(s32 *)t5; + /* Read from stack cache */ + arg5 = *(s32 *)(t5 + 4); + goto g6046; + +g6049: + if (_trace) printf("g6049:\n"); + if ((t7 & 1) == 0) + goto g6048; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6045; + +g6048: + if (_trace) printf("g6048:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t7 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g6052: + if (_trace) printf("g6052:\n"); + t7 = t8 & MemoryActionTransform; + if (t7 == 0) + goto g6051; + arg5 = arg5 & ~63L; + arg5 = arg5 | Type_ExternalValueCellPointer; + goto g6055; +#ifndef MINIMA + +g6051: +#endif +#ifdef MINIMA + +g6051: + if (_trace) printf("g6051:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g6050; + t5 = arg2 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + arg6 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)arg2 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g6054; + /* Extract the pointer, and indirect */ + arg2 = (u32)arg6; + goto g6045; + +g6054: + if (_trace) printf("g6054:\n"); + goto dbcachemisstrap; +#endif + +g6050: + /* Perform memory action */ + arg1 = t8; + arg2 = 0; + goto performmemoryaction; + +/* end MemoryReadData */ +/* start MemoryReadGeneral */ + + +memoryreadgeneral: + if (_trace) printf("memoryreadgeneral:\n"); + /* Memory Read Internal */ + +g6056: + t7 = arg2 + ivory; + /* Cycle-number -> table offset */ + t8 = (arg3 * 4); + arg5 = LDQ_U(t7); + t8 = (t8 * 4) + ivory; + arg6 = (t7 * 4); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)(t8 + PROCESSORSTATE_DATAREAD_MASK); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6058; + +g6057: + t8 = t8 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6060; + +g6066: + goto *r0; /* ret */ + +memoryreadgeneraldecode: + if (_trace) printf("memoryreadgeneraldecode:\n"); + if (t6 == 0) + goto g6059; + +g6058: + if (_trace) printf("g6058:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + arg6 = *(s32 *)t5; + /* Read from stack cache */ + arg5 = *(s32 *)(t5 + 4); + goto g6057; + +g6060: + if (_trace) printf("g6060:\n"); + +g6059: + if (_trace) printf("g6059:\n"); + /* Cycle-number -> table offset */ + t8 = (arg3 * 4); + t8 = (t8 * 4) + ivory; + t8 = *(u64 *)(t8 + PROCESSORSTATE_DATAREAD); + /* TagType. */ + /* Discard the CDR code */ + t7 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g6064: + if (_trace) printf("g6064:\n"); + t6 = t8 & MemoryActionIndirect; + if (t6 == 0) + goto g6063; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6056; + +g6063: + if (_trace) printf("g6063:\n"); + t7 = t8 & MemoryActionTransform; + if (t7 == 0) + goto g6062; + arg5 = arg5 & ~63L; + arg5 = arg5 | Type_ExternalValueCellPointer; + goto g6066; +#ifndef MINIMA + +g6062: +#endif +#ifdef MINIMA + +g6062: + if (_trace) printf("g6062:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g6061; + t5 = arg2 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + arg6 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)arg2 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g6065; + /* Extract the pointer, and indirect */ + arg2 = (u32)arg6; + goto g6056; + +g6065: + if (_trace) printf("g6065:\n"); + goto dbcachemisstrap; +#endif + +g6061: + /* Perform memory action */ + arg1 = t8; + arg2 = arg3; + goto performmemoryaction; + +/* end MemoryReadGeneral */ +/* start MemoryReadHeader */ + + +memoryreadheader: + if (_trace) printf("memoryreadheader:\n"); + /* Memory Read Internal */ + +g6067: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6069; + +g6068: + t7 = zero + 64; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6071; + +g6075: + goto *r0; /* ret */ + +memoryreadheaderdecode: + if (_trace) printf("memoryreadheaderdecode:\n"); + if (t6 == 0) + goto g6070; + +g6069: + if (_trace) printf("g6069:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + arg6 = *(s32 *)t5; + /* Read from stack cache */ + arg5 = *(s32 *)(t5 + 4); + goto g6068; + +g6071: + if (_trace) printf("g6071:\n"); + if ((t7 & 1) == 0) + goto g6070; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6067; + +g6070: + if (_trace) printf("g6070:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t7 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g6072: + /* Perform memory action */ + arg1 = t8; + arg2 = 6; + goto performmemoryaction; + +/* end MemoryReadHeader */ +/* start MemoryReadCdr */ + + +memoryreadcdr: + if (_trace) printf("memoryreadcdr:\n"); + /* Memory Read Internal */ + +g6076: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->cdr_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6078; + +g6077: + t7 = zero + 192; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6080; + +g6084: + goto *r0; /* ret */ + +memoryreadcdrdecode: + if (_trace) printf("memoryreadcdrdecode:\n"); + if (t6 == 0) + goto g6079; + +g6078: + if (_trace) printf("g6078:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + arg6 = *(s32 *)t5; + /* Read from stack cache */ + arg5 = *(s32 *)(t5 + 4); + goto g6077; + +g6080: + if (_trace) printf("g6080:\n"); + if ((t7 & 1) == 0) + goto g6079; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6076; + +g6079: + if (_trace) printf("g6079:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->cdr); + /* TagType. */ + /* Discard the CDR code */ + t7 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g6081: + /* Perform memory action */ + arg1 = t8; + arg2 = 9; + goto performmemoryaction; + +/* end MemoryReadCdr */ +/* start DoICacheFill */ + + +doicachefill: + if (_trace) printf("doicachefill:\n"); + +ICACHEMISS: + if (_trace) printf("ICACHEMISS:\n"); + /* Here when instruction cache miss detected. Fill the cache from */ + /* PC and then resume interpreter loop */ + /* First round the PC down to an even halfword address */ + /* get the base of the icache */ + arg2 = *(u64 *)&(processor->icachebase); + /* the even PC */ + epc = iPC & ~1L; + ecp = epc >> (CacheLine_RShift & 63); + arg1 = zero + -1; + arg1 = arg1 + ((4) << 16); + ecp = ecp << (CacheLine_LShift & 63); + /* instn is instruction address here */ + instn = iPC >> 1; + ecp = epc + ecp; + ecp = ecp & arg1; + /* temp=cpos*32 */ + arg3 = ecp << 5; + /* cpos=cpos*16 */ + ecp = ecp << 4; + /* temp2=base+cpos*32 */ + arg4 = arg2 + arg3; + /* cpos=base+cpos*48 */ + ecp = arg4 + ecp; + /* the odd PC */ + opc = epc | 1; + /* Assume iPC is the even PC */ + iCP = ecp; + /* See if iPC is the odd PC */ + arg1 = (iPC == opc) ? 1 : 0; + ocp = ecp + CACHELINE_SIZE; + /* Stash the odd cache pointer if iPC is the odd PC */ + if (arg1) + iCP = ocp; + hwdispatch = *(u64 *)&(processor->halfworddispatch); + hwopmask = zero + 1023; + fwdispatch = *(u64 *)&(processor->fullworddispatch); + count = zero + 20; + t11 = instn + ivory; + iword = (t11 * 4); + arg4 = LDQ_U(t11); + iword = *(s32 *)iword; + arg4 = (u8)(arg4 >> ((t11&7)*8)); + goto fillicacheprefetched; + +pcbackone: + if (_trace) printf("pcbackone:\n"); + /* Wire in continuation for even half */ + *(u64 *)&((CACHELINEP)ocp)->nextpcdata = epc; + /* Backup in cache too */ + t10 = ecp - CACHELINE_SIZE; + *(u64 *)&((CACHELINEP)ocp)->nextcp = ecp; + /* Backup PC one halfword */ + arg1 = epc - 1; + *(u64 *)&((CACHELINEP)ecp)->nextcp = t10; + /* TagType. */ + /* arg4=tag-cdr code */ + arg4 = arg4 & 63; + *(u64 *)&((CACHELINEP)ecp)->nextpcdata = arg1; + /* Wire in continuation for odd half */ + goto maybeunpack; + +pcadvone: + if (_trace) printf("pcadvone:\n"); + /* Simple advance of PC one halfword. */ + *(u64 *)&((CACHELINEP)ecp)->nextpcdata = opc; + arg1 = opc + 1; + *(u64 *)&((CACHELINEP)ecp)->nextcp = ocp; + t10 = ocp + CACHELINE_SIZE; + *(u64 *)&((CACHELINEP)ocp)->nextpcdata = arg1; + /* TagType. */ + /* arg4=tag-cdr code */ + arg4 = arg4 & 63; + *(u64 *)&((CACHELINEP)ocp)->nextcp = t10; + goto maybeunpack; + /* This is the cache fill loop. */ + +fillicache: + if (_trace) printf("fillicache:\n"); + t11 = instn + ivory; + iword = (t11 * 4); + arg4 = LDQ_U(t11); + iword = *(s32 *)iword; + arg4 = (u8)(arg4 >> ((t11&7)*8)); + +fillicacheprefetched: + if (_trace) printf("fillicacheprefetched:\n"); +#ifdef CACHEMETERING + /* Increment the fill count for both cache entries */ + t10 = *(s32 *)&((CACHELINEP)ecp)->annotation; + t11 = *(s32 *)&((CACHELINEP)ocp)->annotation; + t10 = (u32)t10; + t11 = (u32)t11; + t10 = t10 + 1; + *(u32 *)&((CACHELINEP)ecp)->annotation = t10; + t11 = t11 + 1; + *(u32 *)&((CACHELINEP)ocp)->annotation = t11; +#endif + /* Set address of even cache posn. */ + *(u64 *)&((CACHELINEP)ecp)->pcdata = epc; + /* CDR code << 6 */ + arg1 = arg4 & 192; + /* TagType. */ + /* Strip cdr */ + arg4 = arg4 & 63; + /* Set address of odd cache posn. */ + *(u64 *)&((CACHELINEP)ocp)->pcdata = opc; + /* Strip nasty bits out. */ + iword = (u32)iword; + +g6085: + if (_trace) printf("g6085:\n"); + /* ready to remerge */ + arg2 = arg4 << 32; + /* Zerotag means advance one HW */ + if (arg1 == 0) + goto pcadvone; + /* 2<<6 */ + arg1 = arg1 - 128; + /* Tag=2 means backup one HW */ + if (arg1 == 0) + goto pcbackone; + /* Tag=1 means end of compiled function */ + if ((s64)arg1 < 0) + goto pcendcf; + +pcadvtwo: + if (_trace) printf("pcadvtwo:\n"); + /* Tag=3 means advance over one full word */ + /* Wire in continuation for even half */ + /* Next word */ + arg1 = epc + 2; + r31 = r31 | r31; + /* corresponding CP entry */ + t10 = ecp + TWOCACHELINESIZE; + /* Next PC even of next word */ + *(u64 *)&((CACHELINEP)ecp)->nextpcdata = arg1; + /* Skip one fullword */ + arg1 = epc + 4; + /* Next CP */ + *(u64 *)&((CACHELINEP)ecp)->nextcp = t10; + /* Wire in continuation for odd half */ + /* corresponding CP entry */ + t10 = ecp + FOURCACHELINESIZE; + *(u64 *)&((CACHELINEP)ocp)->nextpcdata = arg1; + /* TagType. */ + /* arg4=tag-cdr code */ + arg4 = arg4 & 63; + *(u64 *)&((CACHELINEP)ocp)->nextcp = t10; + goto maybeunpack; + +decodepackedword: + if (_trace) printf("decodepackedword:\n"); + /* Here to decode a packed word */ +#ifdef CACHEMETERING + arg1 = *(s32 *)&processor->metervalue; + /* The number of remaining tokens. */ + arg4 = *(s32 *)&processor->metercount; + /* The cache miss meter buffer. */ + t10 = *(u64 *)&(processor->meterdatabuff); + /* count the miss. */ + arg1 = arg1 + 1; + /* Position for new data. */ + t11 = *(s32 *)&processor->meterpos; + *(u32 *)&processor->metervalue = arg1; + if (arg4 != 0) + goto g6086; + arg2 = *(s32 *)&processor->metermask; + /* position of the current data item */ + t10 = (t11 * 4) + t10; + t11 = t11 + 1; + t11 = t11 & arg2; + arg2 = *(s32 *)&processor->metermax; + t12 = arg1 - arg2; + if ((s64)t12 > 0) + arg2 = arg1; + *(u32 *)&processor->metermax = arg2; + /* store the datapoint */ + *(u32 *)t10 = arg1; + /* Position for new data. */ + *(u32 *)&processor->meterpos = t11; + *(u32 *)&processor->metervalue = zero; + arg4 = *(s32 *)&processor->meterfreq; + +g6086: + if (_trace) printf("g6086:\n"); + *(u32 *)&processor->metercount = arg4; +#endif + /* arg4 contains the odd packedword */ + arg4 = iword >> 18; + /* even opcode+2bits */ + t10 = iword >> 8; + /* Save the odd instruction */ + *(u64 *)&((CACHELINEP)ocp)->instruction = arg4; + /* First phase of even operand sign extension. */ + t11 = iword << 54; + /* even operand+2bits */ + t12 = iword & hwopmask; +#ifndef CACHEMETERING + *(u64 *)&((CACHELINEP)ocp)->annotation = zero; +#endif + /* even opcode */ + t10 = t10 & hwopmask; + /* Second phase of even operand sign extension. */ + t11 = (s64)t11 >> 38; + arg2 = t10 - 92; + t10 = (t10 * 8) + hwdispatch; + /* Merge signed/unsigned even operand */ + t12 = t11 | t12; + arg2 = arg2 & ~3L; + *(u32 *)&((CACHELINEP)ecp)->operand = t12; + /* clear count if finish-call seen */ + if (arg2 == 0) + count = arg2; + /* odd opcode+2bits */ + arg2 = arg4 >> 8; + /* First phase of odd operand sign extension. */ + t11 = arg4 << 54; + /* odd operand+2bits */ + arg1 = arg4 & hwopmask; + t10 = *(u64 *)t10; + /* odd opcode */ + arg2 = arg2 & hwopmask; + /* Second phase of odd operand sign extension. */ + t11 = (s64)t11 >> 38; + *(u64 *)&((CACHELINEP)ecp)->code = t10; + t12 = arg2 - 92; + arg2 = (arg2 * 8) + hwdispatch; + /* Merge signed/unsigned odd operand */ + arg1 = t11 | arg1; + *(u32 *)&((CACHELINEP)ocp)->operand = arg1; + t12 = t12 & ~3L; + arg2 = *(u64 *)arg2; + /* clear count if finish-call seen */ + if (t12 == 0) + count = t12; + *(u64 *)&((CACHELINEP)ocp)->code = arg2; + goto enddecode; + +maybeunpack: + if (_trace) printf("maybeunpack:\n"); + /* reassemble tag and word. */ + iword = arg2 | iword; + /* save the even instruction */ + *(u64 *)&((CACHELINEP)ecp)->instruction = iword; + /* t10>=0 if packed */ + t10 = arg4 - 48; +#ifndef CACHEMETERING + *(u64 *)&((CACHELINEP)ecp)->annotation = zero; +#endif +#ifdef CACHEMETERING + epc = *(s32 *)&processor->metervalue; + /* The number of remaining tokens. */ + t12 = *(s32 *)&processor->metercount; + /* The cache miss meter buffer. */ + t11 = *(u64 *)&(processor->meterdatabuff); + /* count the miss. */ + epc = epc + 1; + /* Position for new data. */ + arg1 = *(s32 *)&processor->meterpos; + *(u32 *)&processor->metervalue = epc; + if (t12 != 0) + goto g6087; + arg2 = *(s32 *)&processor->metermask; + /* position of the current data item */ + t11 = (arg1 * 4) + t11; + arg1 = arg1 + 1; + arg1 = arg1 & arg2; + arg2 = *(s32 *)&processor->metermax; + t10 = epc - arg2; + if ((s64)t10 > 0) + arg2 = epc; + *(u32 *)&processor->metermax = arg2; + /* store the datapoint */ + *(u32 *)t11 = epc; + /* Position for new data. */ + *(u32 *)&processor->meterpos = arg1; + *(u32 *)&processor->metervalue = zero; + t12 = *(s32 *)&processor->meterfreq; + +g6087: + if (_trace) printf("g6087:\n"); + *(u32 *)&processor->metercount = t12; +#endif + /* B. if a packed instruction */ + if ((s64)t10 >= 0) + goto decodepackedword; + /* t11 is the fwdispatch index */ + t11 = (arg4 * 8) + fwdispatch; + t12 = *(u64 *)&(processor->i_stage_error_hook); + arg1 = arg4 - 33; + /* Extract the opcode handler */ + t11 = *(u64 *)t11; + /* Store I-STATE-ERROR at odd pc */ + *(u64 *)&((CACHELINEP)ocp)->code = t12; + /* clear count if native instn seen */ + if (arg1 == 0) + count = arg1; + *(u64 *)&((CACHELINEP)ecp)->code = t11; + +enddecode: + if (_trace) printf("enddecode:\n"); + /* Here we decide if to stop filling the cache and return to the */ + /* instruction interpretation stream, or whether to fill further */ + instn = instn + 1; + /* If count is zero, resume */ + if ((s64)count <= 0) + goto cachevalid; + epc = instn << 1; + /* decrement count */ + count = count - 1; + opc = epc | 1; + /* pointer to the end of icache */ + t10 = *(u64 *)&(processor->endicache); + ocp = ocp + TWOCACHELINESIZE; + ecp = ecp + TWOCACHELINESIZE; + t10 = ocp - t10; + /* Still room for more */ + if ((s64)t10 <= 0) + goto fillicache; + goto cachevalid; + +pcendcf: + if (_trace) printf("pcendcf:\n"); + t11 = *(u64 *)&(processor->i_stage_error_hook); + /* We reached the end of the fcn. */ + count = r31 | r31; + /* Store I-STATE-ERROR dispatch at even and odd pc */ + *(u64 *)&((CACHELINEP)ecp)->code = t11; + *(u64 *)&((CACHELINEP)ocp)->code = t11; + goto enddecode; + +/* end DoICacheFill */ + /* These are the instruction reentry points. Instructions end by returning */ + /* control to one of these tags. Most normal instructions reenter by jumping */ + /* to NEXTINSTRUCTION, which advances the PC and continues normally. */ + /* Instructions that change the PC usually go directly to INTERPRETINSTRUCTION. */ + /* Instructions that fail/trap/exception etc, go to one of the other places. */ +/* start iInterpret */ + + +iinterpret: + if (_trace) printf("iinterpret:\n"); + *(u64 *)&processor->asrr9 = r9; + *(u64 *)&processor->asrr10 = r10; + *(u64 *)&processor->asrr11 = r11; + *(u64 *)&processor->asrr12 = r12; + *(u64 *)&processor->asrr13 = r13; + *(u64 *)&processor->asrr15 = r15; + *(u64 *)&processor->asrr26 = r26; + *(u64 *)&processor->asrr27 = r27; + *(u64 *)&processor->asrr29 = r29; + *(u64 *)&processor->asrr30 = r30; + *(u64 *)&processor->asrr14 = r14; + /* Setup our processor object handle */ + ivory = arg1; + /* Upon entry, load cached state. */ + iCP = *(u64 *)&(processor->cp); + iPC = *(u64 *)&(processor->epc); + iSP = *(u64 *)&(processor->sp); + iFP = *(u64 *)&(processor->fp); + iLP = *(u64 *)&(processor->lp); + /* First time in iCP will be zero. */ + if (iCP != 0) + goto INTERPRETINSTRUCTION; + goto ICACHEMISS; + +interpretinstructionpredicted: + if (_trace) printf("interpretinstructionpredicted:\n"); + /* Get the PC to check cache hit. */ + t2 = *(u64 *)&(((CACHELINEP)arg2)->pcdata); + /* Assume FP mode */ + arg1 = iFP; + /* Have we been asked to stop? */ + r0 = *(u64 *)&(processor->stop_interpreter); + /* SP-pop mode constant */ + arg4 = iSP + -8; + /* Grab the instruction/operand while stalled */ + arg3 = *(u64 *)&(((CACHELINEP)arg2)->instruction); + t1 = iPC - t2; + if (t1 != 0) + goto interpretinstructionforbranch; + iCP = arg2; + /* Stop the world! someone wants out. */ + if (r0 != 0) + goto traporsuspendmachine; + goto continuecurrentinstruction; + +interpretinstructionforjump: + if (_trace) printf("interpretinstructionforjump:\n"); + +interpretinstructionforbranch: + if (_trace) printf("interpretinstructionforbranch:\n"); + /* get the base of the icache */ + t5 = *(u64 *)&(processor->icachebase); + t4 = zero + -1; + t4 = t4 + ((4) << 16); + arg2 = iPC >> 10; + t3 = zero + -64; + arg2 = arg2 & t3; + arg2 = iPC + arg2; + arg2 = arg2 & t4; + /* temp=cpos*32 */ + t4 = arg2 << 5; + /* cpos=cpos*16 */ + arg2 = arg2 << 4; + /* temp2=base+cpos*32 */ + t5 = t5 + t4; + +g6088: + if (_trace) printf("g6088:\n"); + /* cpos=base+cpos*48 */ + arg2 = t5 + arg2; +#ifndef CACHEMETERING + *(u64 *)&((CACHELINEP)iCP)->annotation = arg2; +#endif + iCP = arg2; + +INTERPRETINSTRUCTION: + if (_trace) printf("INTERPRETINSTRUCTION:\n"); + r30 = *(u64 *)&(processor->asrr30); + /* Have we been asked to stop? */ + r0 = *(u64 *)&(processor->stop_interpreter); + /* Assume FP mode */ + arg1 = iFP; + /* Grab the instruction/operand while stalled */ + arg3 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* SP-pop mode constant */ + arg4 = iSP + -8; + /* Get the PC to check cache hit. */ + t2 = *(u64 *)&(((CACHELINEP)iCP)->pcdata); + /* Stop the world! someone wants out. */ + if (r0 != 0) + goto traporsuspendmachine; + goto continuecurrentinstruction; + +/* end iInterpret */ + + + +/* End of file automatically generated from ../alpha-emulator/idispat.as */ diff --git a/stub/idouble.c b/stub/idouble.c new file mode 100644 index 0000000..78ab305 --- /dev/null +++ b/stub/idouble.c @@ -0,0 +1,380 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/idouble.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Support for double precision floating point. */ +/* start FetchDoubleFloat */ + + +fetchdoublefloat: + if (_trace) printf("fetchdoublefloat:\n"); + sp = sp + -8; + /* Memory Read Internal */ + +g8874: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g8876; + +g8875: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g8878; + +g8885: + t5 = arg5 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g8873; + *((u32 *)(&processor->fp0)+1) = arg6; + arg2 = arg2 + 1; + /* Memory Read Internal */ + +g8886: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g8888; + +g8887: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g8890; + +g8897: + t5 = arg5 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g8873; + *(u32 *)&processor->fp0 = arg6; + sp = sp + 8; + goto *r0; /* ret */ + +g8890: + if (_trace) printf("g8890:\n"); + if ((t7 & 1) == 0) + goto g8889; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g8886; + +g8889: + if (_trace) printf("g8889:\n"); + +g8888: + if (_trace) printf("g8888:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0091; + goto memoryreaddatadecode; +return0091: + r0 = *(u64 *)sp; + goto g8897; + +g8878: + if (_trace) printf("g8878:\n"); + if ((t7 & 1) == 0) + goto g8877; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g8874; + +g8877: + if (_trace) printf("g8877:\n"); + +g8876: + if (_trace) printf("g8876:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0092; + goto memoryreaddatadecode; +return0092: + r0 = *(u64 *)sp; + goto g8885; + +g8873: + if (_trace) printf("g8873:\n"); + /* arg6 = tag to dispatch on */ + arg6 = Type_DoubleFloat; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +/* end FetchDoubleFloat */ +/* start ConsDoubleFloat */ + + +consdoublefloat: + if (_trace) printf("consdoublefloat:\n"); + sp = sp + -8; + arg6 = *(s32 *)&processor->fp0; + arg5 = *((s32 *)(&processor->fp0)+1); + t5 = *(u64 *)&(processor->lcarea); + t8 = *(u64 *)&(processor->niladdress); + t6 = *(s32 *)&processor->lclength; + /* Fetch address */ + arg2 = *(u64 *)&(processor->lcaddress); + t7 = (t5 == t8) ? 1 : 0; + /* Decached area */ + if (t7 != 0) + goto g8898; + /* Effectively an unsigned 32-bit compare */ + t7 = t6 - 2; + /* Insufficient cache */ + if ((s64)t7 < 0) + goto g8898; + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + /* Store remaining length */ + *(u32 *)&processor->lclength = t7; + t8 = (u32)arg2; + /* Increment address */ + t8 = t8 + 2; + /* Store updated address */ + *(u32 *)&processor->lcaddress = t8; + arg2 = (u32)arg2; + t9 = Type_Fixnum; + t9 = t9 | 128; + t5 = arg2 + ivory; + t8 = (t5 * 4); + t7 = LDQ_U(t5); + t6 = (t9 & 0xff) << ((t5&7)*8); + t7 = t7 & ~(0xffL << (t5&7)*8); + +g8899: + if (_trace) printf("g8899:\n"); + t7 = t7 | t6; + STQ_U(t5, t7); + *(u32 *)t8 = arg5; + t10 = arg2 + 1; + t9 = Type_Fixnum; + t9 = t9 | 64; + t5 = t10 + ivory; + t8 = (t5 * 4); + t7 = LDQ_U(t5); + t6 = (t9 & 0xff) << ((t5&7)*8); + t7 = t7 & ~(0xffL << (t5&7)*8); + +g8900: + if (_trace) printf("g8900:\n"); + t7 = t7 | t6; + STQ_U(t5, t7); + *(u32 *)t8 = arg6; + sp = sp + 8; + goto *r0; /* ret */ + +g8898: + if (_trace) printf("g8898:\n"); + /* arg6 = tag to dispatch on */ + arg6 = Type_DoubleFloat; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +/* end ConsDoubleFloat */ +/* start DoDoubleFloatOp */ + + /* Halfword operand from stack instruction - DoDoubleFloatOp */ + /* arg2 has the preloaded 8 bit operand. */ + +dodoublefloatop: + if (_trace) printf("dodoublefloatop:\n"); +#ifdef TRACING +#endif + +DoDoubleFloatOpIM: + if (_trace) printf("DoDoubleFloatOpIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindodoublefloatop; +#ifdef TRACING +#endif + +DoDoubleFloatOpSP: + if (_trace) printf("DoDoubleFloatOpSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdodoublefloatop; +#endif + +DoDoubleFloatOpLP: + if (_trace) printf("DoDoubleFloatOpLP:\n"); +#ifdef TRACING + goto headdodoublefloatop; +#endif + +DoDoubleFloatOpFP: + if (_trace) printf("DoDoubleFloatOpFP:\n"); + +headdodoublefloatop: + if (_trace) printf("headdodoublefloatop:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindodoublefloatop: + if (_trace) printf("begindodoublefloatop:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* X high */ + arg3 = *(s32 *)(iSP + -24); + /* X low */ + arg4 = *(s32 *)(iSP + -16); + /* Y high */ + arg5 = *(s32 *)(iSP + -8); + /* Y low */ + arg6 = *(s32 *)iSP; + /* Get high part up top */ + arg3 = arg3 << 32; + arg4 = (u32)arg4; + /* Get high part up top */ + arg5 = arg5 << 32; + arg6 = (u32)arg6; + /* ARG3 is now X */ + arg3 = arg3 | arg4; + /* ARG5 is now Y */ + arg5 = arg5 | arg6; + *(u64 *)&processor->fp0 = arg3; + *(u64 *)&processor->fp1 = arg5; + /* Immediate tag */ + t2 = arg1 >> 32; + /* Immediate data */ + t1 = (u32)arg1; + t3 = t2 - Type_Fixnum; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto doublefloatiop; + LDT(1, f1, processor->fp0); + LDT(2, f2, processor->fp1); + /* NIL */ + t3 = zero + DoubleFloatOp_Add; + t3 = t1 - t3; + if (t3 != 0) + goto g8902; + /* Here if argument DoubleFloatOpAdd */ + ADDT(1, f1, 1, f1, 2, f2); /* addt */ + goto g8901; + +g8902: + if (_trace) printf("g8902:\n"); + t3 = zero + DoubleFloatOp_Sub; + t3 = t1 - t3; + if (t3 != 0) + goto g8903; + /* Here if argument DoubleFloatOpSub */ + SUBT(1, f1, 1, f1, 2, f2); + goto g8901; + +g8903: + if (_trace) printf("g8903:\n"); + t3 = zero + DoubleFloatOp_Multiply; + t3 = t1 - t3; + if (t3 != 0) + goto g8904; + /* Here if argument DoubleFloatOpMultiply */ + MULT(1, f1, 1, f1, 2, f2); + goto g8901; + +g8904: + if (_trace) printf("g8904:\n"); + t3 = zero + DoubleFloatOp_Divide; + t3 = t1 - t3; + if (t3 != 0) + goto g8905; + /* Here if argument DoubleFloatOpDivide */ + DIVT(1, f1, 1, f1, 2, f2); + goto g8901; + +g8905: + if (_trace) printf("g8905:\n"); + +g8901: + if (_trace) printf("g8901:\n"); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + /* There was no FP exception */ + t3 = *(u64 *)&(processor->niladdress); + +doublefloatmerge: + STT( (u64 *)&processor->fp0, 1, f1 ); + t1 = *(s32 *)&processor->fp0; + t2 = *((s32 *)(&processor->fp0)+1); + /* Pop all the operands */ + iSP = iSP - 32; + t4 = Type_Fixnum; + /* Push high result */ + *(u32 *)(iSP + 8) = t2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + t4 = Type_Fixnum; + /* Push low result */ + *(u32 *)(iSP + 8) = t1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + iSP = iSP + 8; + t4 = t3 << 26; + t4 = t4 >> 26; + /* Push the exception predicate */ + *(u64 *)iSP = t4; + goto NEXTINSTRUCTION; + +doublefloatexc: + if (_trace) printf("doublefloatexc:\n"); + /* Indicate an FP exception occurred */ + t3 = *(u64 *)&(processor->taddress); + goto doublefloatmerge; + +doublefloatiop: + if (_trace) printf("doublefloatiop:\n"); + arg5 = 0; + arg2 = 85; + goto illegaloperand; + +/* end DoDoubleFloatOp */ + /* End of Halfword operand from stack instruction - DoDoubleFloatOp */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/idouble.as */ diff --git a/stub/ifunarra.c b/stub/ifunarra.c new file mode 100644 index 0000000..f0917c9 --- /dev/null +++ b/stub/ifunarra.c @@ -0,0 +1,3919 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunarra.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Array operations. */ +/* start Aref1Regset */ + + +aref1regset: + if (_trace) printf("aref1regset:\n"); + t12 = arg4; + /* Memory Read Internal */ + +g7682: + /* Base of stack cache */ + t1 = *(u64 *)&(processor->stackcachebasevma); + t3 = arg4 + ivory; + t2 = *(s32 *)&processor->scovlimit; + arg6 = (t3 * 4); + arg5 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg4 - t1; + t4 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t1 < (u64)t2) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t3&7)*8)); + if (t2 != 0) + goto g7684; + +g7683: + t3 = zero + 64; + t4 = t4 >> (arg5 & 63); + t3 = t3 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t4 & 1) + goto g7686; + +g7691: + /* TagType. */ + t1 = arg5 & 63; + t2 = arg6 >> (Array_LongPrefixBitPos & 63); + t1 = t1 - Type_HeaderI; + if (t1 != 0) + goto aref1illegal; + if (t2 & 1) + goto aref1exception; + /* store the array */ + *(u32 *)&((ARRAYCACHEP)t7)->array = t12; + t2 = zero + Array_LengthMask; + t1 = arg6 & t2; + t2 = ((u64)arg2 < (u64)t1) ? 1 : 0; + if (t2 == 0) + goto aref1bounds; + /* store the array length [implicit fixnum] */ + *(u64 *)&((ARRAYCACHEP)t7)->length = t1; + t10 = arg6 >> (Array_RegisterBytePackingPos & 63); + t8 = *(u64 *)&(processor->areventcount); + t10 = t10 << (Array_RegisterBytePackingPos & 63); + t9 = arg4 + 1; + /* Construct the array register word */ + t10 = t10 + t8; + /* store the array register word [implicit fixnum] */ + *(u32 *)&((ARRAYCACHEP)t7)->arword = t10; + /* store the storage [implicit locative] */ + *(u64 *)&((ARRAYCACHEP)t7)->locat = t9; + /* get BP into arg5 */ + arg5 = arg6 >> (Array_BytePackingPos & 63); + /* get element type into arg6 */ + arg6 = arg6 >> (Array_ElementTypePos & 63); + arg5 = arg5 & Array_BytePackingMask; + arg4 = zero; + arg6 = arg6 & Array_ElementTypeMask; + goto aref1restart; + +g7684: + if (_trace) printf("g7684:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + arg6 = *(s32 *)t1; + /* Read from stack cache */ + arg5 = *(s32 *)(t1 + 4); + goto g7683; + +g7686: + if (_trace) printf("g7686:\n"); + if ((t3 & 1) == 0) + goto g7685; + /* Do the indirect thing */ + arg4 = (u32)arg6; + goto g7682; + +g7685: + if (_trace) printf("g7685:\n"); + /* Load the memory action table for cycle */ + t4 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t4; + /* Get the memory action */ + t4 = *(s32 *)t3; + +g7688: + /* Perform memory action */ + arg1 = t4; + arg2 = 6; + goto performmemoryaction; + +/* end Aref1Regset */ +/* start Aref1RecomputeArrayRegister */ + + +aref1recomputearrayregister: + if (_trace) printf("aref1recomputearrayregister:\n"); + t5 = *(s32 *)(arg1 + -8); + t4 = *(s32 *)(arg1 + -4); + t5 = (u32)t5; + t6 = t4 - Type_Array; + /* Strip CDR code, low bits */ + t6 = t6 & 62; + if (t6 != 0) + goto g7693; + /* Memory Read Internal */ + +g7695: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + t3 = t5 + ivory; + t2 = *(s32 *)&processor->scovlimit; + t6 = (t3 * 4); + t7 = LDQ_U(t3); + /* Stack cache offset */ + t8 = t5 - t8; + t1 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t8 < (u64)t2) ? 1 : 0; + t6 = *(s32 *)t6; + t7 = (u8)(t7 >> ((t3&7)*8)); + if (t2 != 0) + goto g7697; + +g7696: + t3 = zero + 64; + t1 = t1 >> (t7 & 63); + t3 = t3 >> (t7 & 63); + t6 = (u32)t6; + if (t1 & 1) + goto g7699; + +g7704: + /* TagType. */ + t8 = t7 & 63; + t2 = t6 >> (Array_LongPrefixBitPos & 63); + t8 = t8 - Type_HeaderI; + if (t8 != 0) + goto g7692; + if (t2 & 1) + goto g7694; + t1 = t6 >> (Array_BytePackingPos & 63); + t4 = *(u64 *)&(processor->areventcount); + t1 = t1 << (Array_RegisterBytePackingPos & 63); + t2 = t5 + 1; + /* Construct the array register word */ + t1 = t1 + t4; + *(u32 *)(arg1 + 8) = t2; + t3 = zero + Array_LengthMask; + t3 = t6 & t3; + *(u32 *)arg1 = t1; + *(u32 *)(arg1 + 16) = t3; + goto fastaref1retry; + +g7694: + if (_trace) printf("g7694:\n"); + /* Just a place to save these values */ + *(u64 *)&processor->asrf5 = arg1; + /* Just a place to save these values */ + *(u64 *)&processor->asrf4 = t10; + /* Just a place to save these values */ + *(u64 *)&processor->asrf3 = t11; + /* Just a place to save these values */ + *(u64 *)&processor->asrf6 = arg1; + /* Just a place to save these values */ + *(u64 *)&processor->asrf7 = arg2; + /* Just a place to save these values */ + *(u64 *)&processor->asrf8 = arg3; + /* Just a place to save these values */ + *(u64 *)&processor->asrf9 = arg4; + t9 = *(s32 *)(arg1 + -8); + arg2 = *(s32 *)(arg1 + -4); + t9 = (u32)t9; + arg1 = t5; + t4 = t7; + t3 = t6; + t2 = 1; + iSP = iSP + 24; + r0 = (u64)&&return0068; + goto setup1dlongarray; +return0068: + t4 = (t2 == ReturnValue_Exception) ? 1 : 0; + if (t4 != 0) + goto g7693; + /* Just a place to save these values */ + arg1 = *(u64 *)&(processor->asrf5); + /* Just a place to save these values */ + t10 = *(u64 *)&(processor->asrf4); + /* Just a place to save these values */ + t11 = *(u64 *)&(processor->asrf3); + /* Just a place to save these values */ + arg1 = *(u64 *)&(processor->asrf6); + /* Just a place to save these values */ + arg2 = *(u64 *)&(processor->asrf7); + /* Just a place to save these values */ + arg3 = *(u64 *)&(processor->asrf8); + /* Just a place to save these values */ + arg4 = *(u64 *)&(processor->asrf9); + t3 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t2 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t1 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t4 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + iSP = iSP - 24; + *(u32 *)arg1 = t1; + *(u32 *)(arg1 + 8) = t2; + *(u32 *)(arg1 + 16) = t3; + goto fastaref1retry; + +g7693: + if (_trace) printf("g7693:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t4; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 12; + goto arrayexception; + +g7692: + if (_trace) printf("g7692:\n"); + arg5 = 0; + arg2 = 12; + goto illegaloperand; + +g7697: + if (_trace) printf("g7697:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t2; + t6 = *(s32 *)t8; + /* Read from stack cache */ + t7 = *(s32 *)(t8 + 4); + goto g7696; + +g7699: + if (_trace) printf("g7699:\n"); + if ((t3 & 1) == 0) + goto g7698; + /* Do the indirect thing */ + t5 = (u32)t6; + goto g7695; + +g7698: + if (_trace) printf("g7698:\n"); + /* Load the memory action table for cycle */ + t1 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = t7 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t1; + /* Get the memory action */ + t1 = *(s32 *)t3; + +g7701: + /* Perform memory action */ + arg1 = t1; + arg2 = 6; + goto performmemoryaction; + +/* end Aref1RecomputeArrayRegister */ +/* start Aref1Exception */ + + +aref1exception: + if (_trace) printf("aref1exception:\n"); + /* Just a place to save these values */ + *(u64 *)&processor->asrf4 = arg2; + /* Just a place to save these values */ + *(u64 *)&processor->asrf5 = t7; + t9 = t12; + arg2 = arg3; + arg1 = arg4; + t4 = arg5; + t3 = arg6; + t2 = zero; + iSP = iSP + 24; + r0 = (u64)&&return0069; + goto setup1dlongarray; +return0069: + /* Just a place to save these values */ + arg2 = *(s32 *)&processor->asrf4; + /* Just a place to save these values */ + t7 = *(u64 *)&(processor->asrf5); + /* Length */ + t1 = *(s32 *)iSP; + /* Length */ + t5 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + /* base */ + t5 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + /* control */ + t3 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + /* The original array */ + t9 = *(s32 *)iSP; + /* The original array */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t9 = (u32)t9; + iSP = iSP - 24; + *(u64 *)&((ARRAYCACHEP)t7)->length = t1; + *(u32 *)&((ARRAYCACHEP)t7)->arword = t3; + *(u32 *)&((ARRAYCACHEP)t7)->locat = t5; + /* store the array */ + *(u32 *)&((ARRAYCACHEP)t7)->array = t9; + t9 = (u32)t5; + t2 = (t2 == ReturnValue_Exception) ? 1 : 0; + if (t2 != 0) + goto reallyaref1exc; + t5 = ((u64)arg2 < (u64)t1) ? 1 : 0; + if (t5 == 0) + goto aref1bounds; + /* get BP into arg5 */ + arg5 = t3 >> (Array_BytePackingPos & 63); + /* get element type into arg6 */ + arg6 = t3 >> (Array_ElementTypePos & 63); + arg4 = t3 >> (Array_RegisterByteOffsetPos & 63); + arg5 = arg5 & Array_BytePackingMask; + arg4 = arg4 & Array_RegisterByteOffsetMask; + arg6 = arg6 & Array_ElementTypeMask; + goto aref1restart; + +reallyaref1exc: + if (_trace) printf("reallyaref1exc:\n"); + arg1 = Type_Fixnum; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 8; + goto arrayexception; + +aref1illegal: + if (_trace) printf("aref1illegal:\n"); + arg5 = 0; + arg2 = 8; + goto illegaloperand; + +aref1bounds: + if (_trace) printf("aref1bounds:\n"); + *(u64 *)&((ARRAYCACHEP)t7)->array = zero; + arg5 = 0; + arg2 = 74; + goto illegaloperand; + +/* end Aref1Exception */ +/* start Aset1Regset */ + + +aset1regset: + if (_trace) printf("aset1regset:\n"); + t12 = arg4; + /* Memory Read Internal */ + +g7705: + /* Base of stack cache */ + t1 = *(u64 *)&(processor->stackcachebasevma); + t3 = arg4 + ivory; + t2 = *(s32 *)&processor->scovlimit; + arg6 = (t3 * 4); + arg5 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg4 - t1; + t4 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t1 < (u64)t2) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t3&7)*8)); + if (t2 != 0) + goto g7707; + +g7706: + t3 = zero + 64; + t4 = t4 >> (arg5 & 63); + t3 = t3 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t4 & 1) + goto g7709; + +g7714: + /* TagType. */ + t1 = arg5 & 63; + t2 = arg6 >> (Array_LongPrefixBitPos & 63); + t1 = t1 - Type_HeaderI; + if (t1 != 0) + goto aset1illegal; + if (t2 & 1) + goto aset1exception; + /* store the array */ + *(u32 *)&((ARRAYCACHEP)t7)->array = t12; + t2 = zero + Array_LengthMask; + t1 = arg6 & t2; + t2 = ((u64)arg2 < (u64)t1) ? 1 : 0; + if (t2 == 0) + goto aset1bounds; + /* store the array length [implicit fixnum] */ + *(u64 *)&((ARRAYCACHEP)t7)->length = t1; + t10 = arg6 >> (Array_RegisterBytePackingPos & 63); + t8 = *(u64 *)&(processor->areventcount); + t10 = t10 << (Array_RegisterBytePackingPos & 63); + t9 = arg4 + 1; + /* Construct the array register word */ + t10 = t10 + t8; + /* store the array register word [implicit fixnum] */ + *(u32 *)&((ARRAYCACHEP)t7)->arword = t10; + /* store the storage [implicit locative] */ + *(u64 *)&((ARRAYCACHEP)t7)->locat = t9; + /* get BP into arg5 */ + arg5 = arg6 >> (Array_BytePackingPos & 63); + /* get element type into arg6 */ + arg6 = arg6 >> (Array_ElementTypePos & 63); + arg5 = arg5 & Array_BytePackingMask; + arg4 = zero; + arg6 = arg6 & Array_ElementTypeMask; + goto aset1restart; + +g7707: + if (_trace) printf("g7707:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + arg6 = *(s32 *)t1; + /* Read from stack cache */ + arg5 = *(s32 *)(t1 + 4); + goto g7706; + +g7709: + if (_trace) printf("g7709:\n"); + if ((t3 & 1) == 0) + goto g7708; + /* Do the indirect thing */ + arg4 = (u32)arg6; + goto g7705; + +g7708: + if (_trace) printf("g7708:\n"); + /* Load the memory action table for cycle */ + t4 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t4; + /* Get the memory action */ + t4 = *(s32 *)t3; + +g7711: + /* Perform memory action */ + arg1 = t4; + arg2 = 6; + goto performmemoryaction; + +/* end Aset1Regset */ +/* start Aset1RecomputeArrayRegister */ + + +aset1recomputearrayregister: + if (_trace) printf("aset1recomputearrayregister:\n"); + t5 = *(s32 *)(arg1 + -8); + t4 = *(s32 *)(arg1 + -4); + t5 = (u32)t5; + t6 = t4 - Type_Array; + /* Strip CDR code, low bits */ + t6 = t6 & 62; + if (t6 != 0) + goto g7716; + /* Memory Read Internal */ + +g7718: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + t3 = t5 + ivory; + t2 = *(s32 *)&processor->scovlimit; + t6 = (t3 * 4); + t7 = LDQ_U(t3); + /* Stack cache offset */ + t8 = t5 - t8; + t1 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t8 < (u64)t2) ? 1 : 0; + t6 = *(s32 *)t6; + t7 = (u8)(t7 >> ((t3&7)*8)); + if (t2 != 0) + goto g7720; + +g7719: + t3 = zero + 64; + t1 = t1 >> (t7 & 63); + t3 = t3 >> (t7 & 63); + t6 = (u32)t6; + if (t1 & 1) + goto g7722; + +g7727: + /* TagType. */ + t8 = t7 & 63; + t2 = t6 >> (Array_LongPrefixBitPos & 63); + t8 = t8 - Type_HeaderI; + if (t8 != 0) + goto g7715; + if (t2 & 1) + goto g7717; + t1 = t6 >> (Array_BytePackingPos & 63); + t4 = *(u64 *)&(processor->areventcount); + t1 = t1 << (Array_RegisterBytePackingPos & 63); + t2 = t5 + 1; + /* Construct the array register word */ + t1 = t1 + t4; + *(u32 *)(arg1 + 8) = t2; + t3 = zero + Array_LengthMask; + t3 = t6 & t3; + *(u32 *)arg1 = t1; + *(u32 *)(arg1 + 16) = t3; + goto fastaset1retry; + +g7717: + if (_trace) printf("g7717:\n"); + /* Just a place to save these values */ + *(u64 *)&processor->asrf5 = arg1; + /* Just a place to save these values */ + *(u64 *)&processor->asrf4 = t10; + /* Just a place to save these values */ + *(u64 *)&processor->asrf3 = t11; + /* Just a place to save these values */ + *(u64 *)&processor->asrf6 = arg1; + /* Just a place to save these values */ + *(u64 *)&processor->asrf7 = arg2; + /* Just a place to save these values */ + *(u64 *)&processor->asrf8 = arg3; + /* Just a place to save these values */ + *(u64 *)&processor->asrf9 = arg4; + t9 = *(s32 *)(arg1 + -8); + arg2 = *(s32 *)(arg1 + -4); + t9 = (u32)t9; + arg1 = t5; + t4 = t7; + t3 = t6; + t2 = 1; + iSP = iSP + 24; + r0 = (u64)&&return0070; + goto setup1dlongarray; +return0070: + t4 = (t2 == ReturnValue_Exception) ? 1 : 0; + if (t4 != 0) + goto g7716; + /* Just a place to save these values */ + arg1 = *(u64 *)&(processor->asrf5); + /* Just a place to save these values */ + t10 = *(u64 *)&(processor->asrf4); + /* Just a place to save these values */ + t11 = *(u64 *)&(processor->asrf3); + /* Just a place to save these values */ + arg1 = *(u64 *)&(processor->asrf6); + /* Just a place to save these values */ + arg2 = *(u64 *)&(processor->asrf7); + /* Just a place to save these values */ + arg3 = *(u64 *)&(processor->asrf8); + /* Just a place to save these values */ + arg4 = *(u64 *)&(processor->asrf9); + t3 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t2 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t1 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t4 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + iSP = iSP - 24; + *(u32 *)arg1 = t1; + *(u32 *)(arg1 + 8) = t2; + *(u32 *)(arg1 + 16) = t3; + goto fastaset1retry; + +g7716: + if (_trace) printf("g7716:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t4; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 3; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 12; + goto arrayexception; + +g7715: + if (_trace) printf("g7715:\n"); + arg5 = 0; + arg2 = 12; + goto illegaloperand; + +g7720: + if (_trace) printf("g7720:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t2; + t6 = *(s32 *)t8; + /* Read from stack cache */ + t7 = *(s32 *)(t8 + 4); + goto g7719; + +g7722: + if (_trace) printf("g7722:\n"); + if ((t3 & 1) == 0) + goto g7721; + /* Do the indirect thing */ + t5 = (u32)t6; + goto g7718; + +g7721: + if (_trace) printf("g7721:\n"); + /* Load the memory action table for cycle */ + t1 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = t7 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t1; + /* Get the memory action */ + t1 = *(s32 *)t3; + +g7724: + /* Perform memory action */ + arg1 = t1; + arg2 = 6; + goto performmemoryaction; + +/* end Aset1RecomputeArrayRegister */ +/* start Aset1Exception */ + + +aset1exception: + if (_trace) printf("aset1exception:\n"); + /* Just a place to save these values */ + *(u64 *)&processor->asrf4 = arg2; + /* Just a place to save these values */ + *(u64 *)&processor->asrf3 = t5; + /* Just a place to save these values */ + *(u64 *)&processor->asrf6 = t6; + /* Just a place to save these values */ + *(u64 *)&processor->asrf5 = t7; + t9 = t12; + arg2 = arg3; + arg1 = arg4; + t4 = arg5; + t3 = arg6; + t2 = zero; + iSP = iSP + 24; + r0 = (u64)&&return0071; + goto setup1dlongarray; +return0071: + t1 = (t2 == ReturnValue_Exception) ? 1 : 0; + if (t1 != 0) + goto reallyaset1exc; + /* Just a place to save these values */ + arg2 = *(s32 *)&processor->asrf4; + /* Just a place to save these values */ + t5 = *(u64 *)&(processor->asrf3); + /* Just a place to save these values */ + t6 = *(u64 *)&(processor->asrf6); + /* Just a place to save these values */ + t7 = *(u64 *)&(processor->asrf5); + /* Length */ + t1 = *(s32 *)iSP; + /* Length */ + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + /* base */ + t2 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + /* control */ + t3 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + /* The original array */ + t9 = *(s32 *)iSP; + /* The original array */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t9 = (u32)t9; + iSP = iSP - 24; + *(u64 *)&((ARRAYCACHEP)t7)->length = t1; + *(u32 *)&((ARRAYCACHEP)t7)->arword = t3; + *(u32 *)&((ARRAYCACHEP)t7)->locat = t2; + /* store the array */ + *(u32 *)&((ARRAYCACHEP)t7)->array = t9; + t9 = (u32)t2; + t2 = ((u64)arg2 < (u64)t1) ? 1 : 0; + if (t2 == 0) + goto aset1bounds; + /* get BP into arg5 */ + arg5 = t3 >> (Array_BytePackingPos & 63); + /* get element type into arg6 */ + arg6 = t3 >> (Array_ElementTypePos & 63); + arg4 = t3 >> (Array_RegisterByteOffsetPos & 63); + arg5 = arg5 & Array_BytePackingMask; + arg4 = arg4 & Array_RegisterByteOffsetMask; + arg6 = arg6 & Array_ElementTypeMask; + goto aset1restart; + +reallyaset1exc: + if (_trace) printf("reallyaset1exc:\n"); + arg1 = Type_Fixnum; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 3; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 9; + goto arrayexception; + +aset1illegal: + if (_trace) printf("aset1illegal:\n"); + arg5 = 0; + arg2 = 9; + goto illegaloperand; + +aset1bounds: + if (_trace) printf("aset1bounds:\n"); + *(u64 *)&((ARRAYCACHEP)t7)->array = zero; + arg5 = 0; + arg2 = 74; + goto illegaloperand; + +/* end Aset1Exception */ +/* start DoAloc1 */ + + /* Halfword operand from stack instruction - DoAloc1 */ + /* arg2 has the preloaded 8 bit operand. */ + +doaloc1: + if (_trace) printf("doaloc1:\n"); +#ifdef TRACING +#endif + +DoAloc1SP: + if (_trace) printf("DoAloc1SP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoaloc1; +#endif + +DoAloc1LP: + if (_trace) printf("DoAloc1LP:\n"); +#ifdef TRACING + goto headdoaloc1; +#endif + +DoAloc1FP: + if (_trace) printf("DoAloc1FP:\n"); + +headdoaloc1: + if (_trace) printf("headdoaloc1:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoaloc1: + if (_trace) printf("begindoaloc1:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get the array tag/data */ + arg4 = *(s32 *)iSP; + /* Get the array tag/data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* Index Data */ + arg2 = (u32)arg1; + /* Index Tag */ + arg1 = arg1 >> 32; + t1 = arg1 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto aloc1illegal; + +aloc1merge: + if (_trace) printf("aloc1merge:\n"); + t1 = arg3 - Type_Array; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto aloc1exception; + /* Memory Read Internal */ + +g7728: + /* Base of stack cache */ + t1 = *(u64 *)&(processor->stackcachebasevma); + t3 = arg4 + ivory; + t2 = *(s32 *)&processor->scovlimit; + arg6 = (t3 * 4); + arg5 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg4 - t1; + t4 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t1 < (u64)t2) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t3&7)*8)); + if (t2 != 0) + goto g7730; + +g7729: + t3 = zero + 64; + t4 = t4 >> (arg5 & 63); + t3 = t3 >> (arg5 & 63); + if (t4 & 1) + goto g7732; + +g7737: + /* TagType. */ + t1 = arg5 & 63; + t2 = arg6 >> (Array_LongPrefixBitPos & 63); + t1 = t1 - Type_HeaderI; + if (t1 != 0) + goto aloc1illegal; + if (t2 & 1) + goto aloc1exception; + t2 = zero + Array_LengthMask; + t1 = arg6 & t2; + t3 = ((u64)arg2 < (u64)t1) ? 1 : 0; + if (t3 == 0) + goto aloc1illegal; + /* get element type into arg6 */ + arg6 = arg6 >> (Array_ElementTypePos & 63); + arg4 = arg4 + 1; + arg4 = arg4 + arg2; + arg6 = arg6 & Array_ElementTypeMask; + arg6 = arg6 - Array_ElementTypeObject; + if (arg6 != 0) + goto aloc1notobject; + t1 = Type_Locative; + *(u32 *)(iSP + 8) = arg4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +aloc1exception: + if (_trace) printf("aloc1exception:\n"); + arg1 = Type_Fixnum; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 8; + goto arrayexception; + +aloc1illegal: + if (_trace) printf("aloc1illegal:\n"); + arg5 = 0; + arg2 = 8; + goto illegaloperand; + +aloc1bounds: + if (_trace) printf("aloc1bounds:\n"); + arg5 = 0; + arg2 = 74; + goto illegaloperand; + +aloc1notobject: + if (_trace) printf("aloc1notobject:\n"); + arg5 = 0; + arg2 = 7; + goto illegaloperand; +#ifdef TRACING + goto DoAloc1IM; +#endif + +DoAloc1IM: + if (_trace) printf("DoAloc1IM:\n"); + /* Get the array tag/data */ + arg4 = *(s32 *)iSP; + /* Get the array tag/data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + goto aloc1merge; + +g7730: + if (_trace) printf("g7730:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + arg6 = *(s32 *)t1; + /* Read from stack cache */ + arg5 = *(s32 *)(t1 + 4); + goto g7729; + +g7732: + if (_trace) printf("g7732:\n"); + if ((t3 & 1) == 0) + goto g7731; + /* Do the indirect thing */ + arg4 = (u32)arg6; + goto g7728; + +g7731: + if (_trace) printf("g7731:\n"); + /* Load the memory action table for cycle */ + t4 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t4; + /* Get the memory action */ + t4 = *(s32 *)t3; + +g7734: + /* Perform memory action */ + arg1 = t4; + arg2 = 6; + goto performmemoryaction; + +/* end DoAloc1 */ + /* End of Halfword operand from stack instruction - DoAloc1 */ + /* Array register operations. */ +/* start DoSetup1DArray */ + + /* Halfword operand from stack instruction - DoSetup1DArray */ + +dosetup1darray: + if (_trace) printf("dosetup1darray:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoSetup1DArrayIM: + if (_trace) printf("DoSetup1DArrayIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g7751: + if (_trace) printf("g7751:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindosetup1darray; +#ifdef TRACING +#endif + +DoSetup1DArraySP: + if (_trace) printf("DoSetup1DArraySP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdosetup1darray; +#endif + +DoSetup1DArrayLP: + if (_trace) printf("DoSetup1DArrayLP:\n"); +#ifdef TRACING + goto headdosetup1darray; +#endif + +DoSetup1DArrayFP: + if (_trace) printf("DoSetup1DArrayFP:\n"); + +headdosetup1darray: + if (_trace) printf("headdosetup1darray:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindosetup1darray: + if (_trace) printf("begindosetup1darray:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* Get the tag */ + arg2 = arg1 >> 32; + /* and the data */ + arg1 = (u32)arg1; + /* Indicate not forcing 1d */ + t2 = 0; + t9 = arg1; + t3 = arg2 - Type_Array; + /* Strip CDR code, low bits */ + t3 = t3 & 62; + if (t3 != 0) + goto g7739; + /* Memory Read Internal */ + +g7741: + /* Base of stack cache */ + t5 = *(u64 *)&(processor->stackcachebasevma); + t7 = arg1 + ivory; + t6 = *(s32 *)&processor->scovlimit; + t3 = (t7 * 4); + t4 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg1 - t5; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t6) ? 1 : 0; + t3 = *(s32 *)t3; + t4 = (u8)(t4 >> ((t7&7)*8)); + if (t6 != 0) + goto g7743; + +g7742: + t7 = zero + 64; + t8 = t8 >> (t4 & 63); + t7 = t7 >> (t4 & 63); + t3 = (u32)t3; + if (t8 & 1) + goto g7745; + +g7750: + /* TagType. */ + t5 = t4 & 63; + t6 = t3 >> (Array_LongPrefixBitPos & 63); + t5 = t5 - Type_HeaderI; + if (t5 != 0) + goto g7738; + if (t6 & 1) + goto g7740; + /* set CDR-NEXT */ + t5 = arg2 & 63; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + t8 = t3 >> (Array_RegisterBytePackingPos & 63); + t7 = Type_Fixnum; + t1 = *(u64 *)&(processor->areventcount); + t8 = t8 << (Array_RegisterBytePackingPos & 63); + t5 = arg1 + 1; + /* Construct the array register word */ + t8 = t8 + t1; + /* set CDR-NEXT */ + t6 = t7 & 63; + *(u32 *)(iSP + 8) = t8; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t6; + iSP = iSP + 8; + t8 = Type_Locative; + *(u32 *)(iSP + 8) = t5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + t6 = zero + Array_LengthMask; + t6 = t3 & t6; + /* set CDR-NEXT */ + t8 = t7 & 63; + *(u32 *)(iSP + 8) = t6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g7739: + if (_trace) printf("g7739:\n"); + /* SetTag. */ + t6 = arg2 << 32; + t6 = t9 | t6; + /* arg6 = tag to dispatch on */ + arg6 = arg2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 71; + goto arrayexception; + +g7738: + if (_trace) printf("g7738:\n"); + arg5 = 0; + arg2 = 71; + goto illegaloperand; + +g7740: + if (_trace) printf("g7740:\n"); + r0 = (u64)&&return0072; + goto setup1dlongarray; +return0072: + t1 = (t2 == ReturnValue_Normal) ? 1 : 0; + if (t1 != 0) + goto NEXTINSTRUCTION; + t1 = (t2 == ReturnValue_Exception) ? 1 : 0; + if (t1 != 0) + goto g7739; + t1 = (t2 == ReturnValue_IllegalOperand) ? 1 : 0; + if (t1 != 0) + goto g7738; + goto NEXTINSTRUCTION; + +g7743: + if (_trace) printf("g7743:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t3 = *(s32 *)t5; + /* Read from stack cache */ + t4 = *(s32 *)(t5 + 4); + goto g7742; + +g7745: + if (_trace) printf("g7745:\n"); + if ((t7 & 1) == 0) + goto g7744; + /* Do the indirect thing */ + arg1 = (u32)t3; + goto g7741; + +g7744: + if (_trace) printf("g7744:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t7 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7747: + /* Perform memory action */ + arg1 = t8; + arg2 = 6; + goto performmemoryaction; + +/* end DoSetup1DArray */ + /* End of Halfword operand from stack instruction - DoSetup1DArray */ +/* start DoSetupForce1DArray */ + + /* Halfword operand from stack instruction - DoSetupForce1DArray */ + +dosetupforce1darray: + if (_trace) printf("dosetupforce1darray:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoSetupForce1DArrayIM: + if (_trace) printf("DoSetupForce1DArrayIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g7765: + if (_trace) printf("g7765:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindosetupforce1darray; +#ifdef TRACING +#endif + +DoSetupForce1DArraySP: + if (_trace) printf("DoSetupForce1DArraySP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdosetupforce1darray; +#endif + +DoSetupForce1DArrayLP: + if (_trace) printf("DoSetupForce1DArrayLP:\n"); +#ifdef TRACING + goto headdosetupforce1darray; +#endif + +DoSetupForce1DArrayFP: + if (_trace) printf("DoSetupForce1DArrayFP:\n"); + +headdosetupforce1darray: + if (_trace) printf("headdosetupforce1darray:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindosetupforce1darray: + if (_trace) printf("begindosetupforce1darray:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* Get the tag */ + arg2 = arg1 >> 32; + /* and the data */ + arg1 = (u32)arg1; + /* Indicate forcing 1d */ + t2 = 1; + t9 = arg1; + t3 = arg2 - Type_Array; + /* Strip CDR code, low bits */ + t3 = t3 & 62; + if (t3 != 0) + goto g7753; + /* Memory Read Internal */ + +g7755: + /* Base of stack cache */ + t5 = *(u64 *)&(processor->stackcachebasevma); + t7 = arg1 + ivory; + t6 = *(s32 *)&processor->scovlimit; + t3 = (t7 * 4); + t4 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg1 - t5; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t6) ? 1 : 0; + t3 = *(s32 *)t3; + t4 = (u8)(t4 >> ((t7&7)*8)); + if (t6 != 0) + goto g7757; + +g7756: + t7 = zero + 64; + t8 = t8 >> (t4 & 63); + t7 = t7 >> (t4 & 63); + t3 = (u32)t3; + if (t8 & 1) + goto g7759; + +g7764: + /* TagType. */ + t5 = t4 & 63; + t6 = t3 >> (Array_LongPrefixBitPos & 63); + t5 = t5 - Type_HeaderI; + if (t5 != 0) + goto g7752; + if (t6 & 1) + goto g7754; + /* set CDR-NEXT */ + t5 = arg2 & 63; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + t8 = t3 >> (Array_RegisterBytePackingPos & 63); + t7 = Type_Fixnum; + t1 = *(u64 *)&(processor->areventcount); + t8 = t8 << (Array_RegisterBytePackingPos & 63); + t5 = arg1 + 1; + /* Construct the array register word */ + t8 = t8 + t1; + /* set CDR-NEXT */ + t6 = t7 & 63; + *(u32 *)(iSP + 8) = t8; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t6; + iSP = iSP + 8; + t8 = Type_Locative; + *(u32 *)(iSP + 8) = t5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + t6 = zero + Array_LengthMask; + t6 = t3 & t6; + /* set CDR-NEXT */ + t8 = t7 & 63; + *(u32 *)(iSP + 8) = t6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g7753: + if (_trace) printf("g7753:\n"); + /* SetTag. */ + t6 = arg2 << 32; + t6 = t9 | t6; + /* arg6 = tag to dispatch on */ + arg6 = arg2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 71; + goto arrayexception; + +g7752: + if (_trace) printf("g7752:\n"); + arg5 = 0; + arg2 = 71; + goto illegaloperand; + +g7754: + if (_trace) printf("g7754:\n"); + r0 = (u64)&&return0073; + goto setup1dlongarray; +return0073: + t1 = (t2 == ReturnValue_Normal) ? 1 : 0; + if (t1 != 0) + goto NEXTINSTRUCTION; + t1 = (t2 == ReturnValue_Exception) ? 1 : 0; + if (t1 != 0) + goto g7753; + t1 = (t2 == ReturnValue_IllegalOperand) ? 1 : 0; + if (t1 != 0) + goto g7752; + goto NEXTINSTRUCTION; + +g7757: + if (_trace) printf("g7757:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t3 = *(s32 *)t5; + /* Read from stack cache */ + t4 = *(s32 *)(t5 + 4); + goto g7756; + +g7759: + if (_trace) printf("g7759:\n"); + if ((t7 & 1) == 0) + goto g7758; + /* Do the indirect thing */ + arg1 = (u32)t3; + goto g7755; + +g7758: + if (_trace) printf("g7758:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t7 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7761: + /* Perform memory action */ + arg1 = t8; + arg2 = 6; + goto performmemoryaction; + +/* end DoSetupForce1DArray */ + /* End of Halfword operand from stack instruction - DoSetupForce1DArray */ +/* start Setup1DLongArray */ + + +setup1dlongarray: + if (_trace) printf("setup1dlongarray:\n"); + /* Read data from the header: alength offset indirect lengths&mults */ + /* length=array+1 */ + t1 = arg1 + 1; + /* Memory Read Internal */ + +g7775: + /* Base of stack cache */ + t7 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t8 = *(s32 *)&processor->scovlimit; + arg4 = (t10 * 4); + t6 = LDQ_U(t10); + /* Stack cache offset */ + t7 = t1 - t7; + t11 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)t8) ? 1 : 0; + arg4 = *(s32 *)arg4; + t6 = (u8)(t6 >> ((t10&7)*8)); + if (t8 != 0) + goto g7777; + +g7776: + t10 = zero + 240; + t11 = t11 >> (t6 & 63); + t10 = t10 >> (t6 & 63); + arg4 = (u32)arg4; + if (t11 & 1) + goto g7779; + +g7786: + t8 = t6 - Type_Fixnum; + /* Strip CDR code */ + t8 = t8 & 63; + if (t8 != 0) + goto g7766; + /* Offset is adata+2 */ + t1 = t1 + 1; + /* Memory Read Internal */ + +g7787: + /* Base of stack cache */ + t7 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t8 = *(s32 *)&processor->scovlimit; + arg3 = (t10 * 4); + t6 = LDQ_U(t10); + /* Stack cache offset */ + t7 = t1 - t7; + t11 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)t8) ? 1 : 0; + arg3 = *(s32 *)arg3; + t6 = (u8)(t6 >> ((t10&7)*8)); + if (t8 != 0) + goto g7789; + +g7788: + t10 = zero + 240; + t11 = t11 >> (t6 & 63); + t10 = t10 >> (t6 & 63); + arg3 = (u32)arg3; + if (t11 & 1) + goto g7791; + +g7798: + t8 = t6 - Type_Fixnum; + /* Strip CDR code */ + t8 = t8 & 63; + if (t8 != 0) + goto g7766; + /* Indirect is adata+3 */ + t1 = t1 + 1; + /* Memory Read Internal */ + +g7799: + /* Base of stack cache */ + t7 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t5 = (t10 * 4); + t6 = LDQ_U(t10); + /* Stack cache offset */ + t7 = t1 - t7; + t11 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)t8) ? 1 : 0; + t5 = *(s32 *)t5; + t6 = (u8)(t6 >> ((t10&7)*8)); + if (t8 != 0) + goto g7801; + +g7800: + t10 = zero + 240; + t11 = t11 >> (t6 & 63); + t10 = t10 >> (t6 & 63); + t5 = (u32)t5; + if (t11 & 1) + goto g7803; + +g7810: + /* Strip off any CDR code bits. */ + t10 = t6 & 63; + t11 = (t10 == Type_Locative) ? 1 : 0; + +g7875: + if (_trace) printf("g7875:\n"); + if (t11 == 0) + goto g7812; + /* Here if argument TypeLocative */ + +g7769: + if (_trace) printf("g7769:\n"); + /* set CDR-NEXT */ + t10 = arg2 & 63; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t10; + iSP = iSP + 8; + t8 = t3 >> (Array_BytePackingPos & 63); + t7 = Type_Fixnum; + t1 = *(u64 *)&(processor->areventcount); + t8 = t8 << (Array_RegisterBytePackingPos & 63); + /* Construct the array register word */ + t8 = t8 + t1; + /* set CDR-NEXT */ + t6 = t7 & 63; + *(u32 *)(iSP + 8) = t8; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t6; + iSP = iSP + 8; + t8 = Type_Locative; + *(u32 *)(iSP + 8) = t5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + /* set CDR-NEXT */ + t8 = t7 & 63; + *(u32 *)(iSP + 8) = arg4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto g7774; + +g7812: + if (_trace) printf("g7812:\n"); + t11 = (t10 == Type_Fixnum) ? 1 : 0; + +g7876: + if (_trace) printf("g7876:\n"); + if (t11 == 0) + goto g7813; + /* Here if argument TypeFixnum */ + goto g7769; + +g7813: + if (_trace) printf("g7813:\n"); + t11 = (t10 == Type_Array) ? 1 : 0; + +g7877: + if (_trace) printf("g7877:\n"); + if (t11 == 0) + goto g7814; + /* Here if argument TypeArray */ + +g7773: + if (_trace) printf("g7773:\n"); + t1 = t3 & 7; + t1 = (t1 == 1) ? 1 : 0; + /* Force true if FORCE */ + t1 = t1 | t2; + if (t1 == 0) + goto g7766; + t12 = t3 >> (Array_BytePackingPos & 63); + t12 = t12 & Array_BytePackingMask; + t2 = arg3; + +g7768: + if (_trace) printf("g7768:\n"); + /* Memory Read Internal */ + +g7815: + /* Base of stack cache */ + t7 = *(u64 *)&(processor->stackcachebasevma); + t10 = t5 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t4 = (t10 * 4); + t6 = LDQ_U(t10); + /* Stack cache offset */ + t7 = t5 - t7; + t11 = *(u64 *)&(processor->header_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)t8) ? 1 : 0; + t4 = *(s32 *)t4; + t6 = (u8)(t6 >> ((t10&7)*8)); + if (t8 != 0) + goto g7817; + +g7816: + t10 = zero + 64; + t11 = t11 >> (t6 & 63); + t10 = t10 >> (t6 & 63); + t4 = (u32)t4; + if (t11 & 1) + goto g7819; + +g7824: + t10 = t4 >> (Array_BytePackingPos & 63); + t10 = t10 & Array_BytePackingMask; + arg1 = t12 - t10; + t7 = t4 >> (Array_LongPrefixBitPos & 63); + if (t7 & 1) + goto g7770; + /* increment beyond header */ + t5 = t5 + 1; + t8 = zero + 32767; + t8 = t4 & t8; + t10 = zero - arg1; + t10 = t8 >> (t10 & 63); + t8 = t8 << (arg1 & 63); + if ((s64)arg1 <= 0) + t8 = t10; + t10 = arg4 + arg3; + t7 = t10 - t8; + if ((s64)t7 <= 0) + t8 = t10; + arg4 = t8; + +g7767: + if (_trace) printf("g7767:\n"); + arg4 = arg4 - t2; + /* set CDR-NEXT */ + t10 = arg2 & 63; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t10; + iSP = iSP + 8; + t7 = Type_Fixnum; + t8 = t3 >> (Array_RegisterBytePackingPos & 63); + t1 = *(u64 *)&(processor->areventcount); + t8 = t8 << (Array_RegisterBytePackingPos & 63); + /* -1 */ + t11 = zero - 1; + /* (LSH -1 byte-packing) */ + t11 = t11 << (t12 & 63); + t11 = t2 & ~t11; + t11 = t11 << (Array_RegisterByteOffsetPos & 63); + /* Construct the array register word */ + t8 = t8 + t1; + /* Add in the byte offset */ + t8 = t11 + t8; + /* set CDR-NEXT */ + t6 = t7 & 63; + *(u32 *)(iSP + 8) = t8; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t6; + iSP = iSP + 8; + if ((s64)arg4 <= 0) + arg4 = zero; + if (arg4 == 0) + goto g7771; + t1 = zero - t12; + t1 = t2 << (t1 & 63); + t2 = t2 >> (t12 & 63); + if ((s64)t12 <= 0) + t2 = t1; + t5 = t2 + t5; + +g7771: + if (_trace) printf("g7771:\n"); + t8 = Type_Locative; + *(u32 *)(iSP + 8) = t5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + /* set CDR-NEXT */ + t8 = t7 & 63; + *(u32 *)(iSP + 8) = arg4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto g7774; + +g7770: + if (_trace) printf("g7770:\n"); + /* length=array+1 */ + t1 = t5 + 1; + /* Memory Read Internal */ + +g7825: + /* Base of stack cache */ + t7 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t8 = *(s32 *)&processor->scovlimit; + arg6 = (t10 * 4); + t4 = LDQ_U(t10); + /* Stack cache offset */ + t7 = t1 - t7; + t11 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)t8) ? 1 : 0; + arg6 = *(s32 *)arg6; + t4 = (u8)(t4 >> ((t10&7)*8)); + if (t8 != 0) + goto g7827; + +g7826: + t10 = zero + 240; + t11 = t11 >> (t4 & 63); + t10 = t10 >> (t4 & 63); + arg6 = (u32)arg6; + if (t11 & 1) + goto g7829; + +g7836: + t1 = t4 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto g7766; + /* offset=array+2 */ + t1 = t5 + 2; + /* Memory Read Internal */ + +g7837: + /* Base of stack cache */ + t7 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t8 = *(s32 *)&processor->scovlimit; + arg5 = (t10 * 4); + t4 = LDQ_U(t10); + /* Stack cache offset */ + t7 = t1 - t7; + t11 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)t8) ? 1 : 0; + arg5 = *(s32 *)arg5; + t4 = (u8)(t4 >> ((t10&7)*8)); + if (t8 != 0) + goto g7839; + +g7838: + t10 = zero + 240; + t11 = t11 >> (t4 & 63); + t10 = t10 >> (t4 & 63); + arg5 = (u32)arg5; + if (t11 & 1) + goto g7841; + +g7848: + t1 = t4 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto g7766; + /* next=array+3 */ + t1 = t5 + 3; + /* Memory Read Internal */ + +g7849: + /* Base of stack cache */ + t7 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t5 = (t10 * 4); + t4 = LDQ_U(t10); + /* Stack cache offset */ + t7 = t1 - t7; + t11 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)t8) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t10&7)*8)); + if (t8 != 0) + goto g7851; + +g7850: + t10 = zero + 240; + t11 = t11 >> (t4 & 63); + t10 = t10 >> (t4 & 63); + t5 = (u32)t5; + if (t11 & 1) + goto g7853; + +g7860: + t8 = zero - arg1; + t8 = arg6 >> (t8 & 63); + t10 = arg6 << (arg1 & 63); + if ((s64)arg1 <= 0) + t10 = t8; + t8 = arg4 + arg3; + if ((s64)t10 <= 0) + t10 = t8; + t7 = t10 - t8; + if ((s64)t7 <= 0) + t8 = t10; + arg4 = t8; + /* Strip off any CDR code bits. */ + t8 = t4 & 63; + t10 = (t8 == Type_Locative) ? 1 : 0; + +g7868: + if (_trace) printf("g7868:\n"); + if (t10 == 0) + goto g7862; + /* Here if argument TypeLocative */ + goto g7767; + +g7862: + if (_trace) printf("g7862:\n"); + t10 = (t8 == Type_Fixnum) ? 1 : 0; + +g7869: + if (_trace) printf("g7869:\n"); + if (t10 == 0) + goto g7863; + /* Here if argument TypeFixnum */ + goto g7767; + +g7863: + if (_trace) printf("g7863:\n"); + t10 = (t8 == Type_Array) ? 1 : 0; + +g7870: + if (_trace) printf("g7870:\n"); + if (t10 == 0) + goto g7864; + /* Here if argument TypeArray */ + +g7772: + if (_trace) printf("g7772:\n"); + t7 = zero - arg1; + t7 = arg5 >> (t7 & 63); + arg3 = arg5 << (arg1 & 63); + if ((s64)arg1 <= 0) + arg3 = t7; + t2 = t2 + arg3; + goto g7768; + +g7864: + if (_trace) printf("g7864:\n"); + t10 = (t8 == Type_String) ? 1 : 0; + +g7871: + if (_trace) printf("g7871:\n"); + if (t10 == 0) + goto g7865; + /* Here if argument TypeString */ + goto g7772; + +g7865: + if (_trace) printf("g7865:\n"); + /* Here for all other cases */ + goto g7766; + +g7861: + if (_trace) printf("g7861:\n"); + +g7814: + if (_trace) printf("g7814:\n"); + t11 = (t10 == Type_String) ? 1 : 0; + +g7878: + if (_trace) printf("g7878:\n"); + if (t11 == 0) + goto g7872; + /* Here if argument TypeString */ + goto g7773; + +g7872: + if (_trace) printf("g7872:\n"); + /* Here for all other cases */ + goto g7766; + +g7811: + if (_trace) printf("g7811:\n"); + +g7766: + if (_trace) printf("g7766:\n"); + t2 = ReturnValue_Exception; + goto *r0; /* ret */ + +g7774: + if (_trace) printf("g7774:\n"); + t2 = ReturnValue_Normal; + goto *r0; /* ret */ + +g7851: + if (_trace) printf("g7851:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t5 = *(s32 *)t7; + /* Read from stack cache */ + t4 = *(s32 *)(t7 + 4); + goto g7850; + +g7853: + if (_trace) printf("g7853:\n"); + if ((t10 & 1) == 0) + goto g7852; + /* Do the indirect thing */ + t1 = (u32)t5; + goto g7849; + +g7852: + if (_trace) printf("g7852:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7857: + if (_trace) printf("g7857:\n"); + t10 = t11 & MemoryActionTransform; + if (t10 == 0) + goto g7856; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g7860; +#ifndef MINIMA + +g7856: +#endif +#ifdef MINIMA + +g7856: + if (_trace) printf("g7856:\n"); + t10 = t11 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t10 == 0) + goto g7855; + t7 = t1 << 1; + t10 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t10; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + t5 = *(s32 *)(t8 + 4); + /* Compare */ + t10 = (s32)t1 - (s32)t7; + /* Trap on miss */ + if (t10 != 0) + goto g7859; + /* Extract the pointer, and indirect */ + t1 = (u32)t5; + goto g7849; + +g7859: + if (_trace) printf("g7859:\n"); + goto dbcachemisstrap; +#endif + +g7855: + /* Perform memory action */ + arg1 = t11; + arg2 = 0; + goto performmemoryaction; + +g7839: + if (_trace) printf("g7839:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + arg5 = *(s32 *)t7; + /* Read from stack cache */ + t4 = *(s32 *)(t7 + 4); + goto g7838; + +g7841: + if (_trace) printf("g7841:\n"); + if ((t10 & 1) == 0) + goto g7840; + /* Do the indirect thing */ + t1 = (u32)arg5; + goto g7837; + +g7840: + if (_trace) printf("g7840:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7845: + if (_trace) printf("g7845:\n"); + t10 = t11 & MemoryActionTransform; + if (t10 == 0) + goto g7844; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g7848; +#ifndef MINIMA + +g7844: +#endif +#ifdef MINIMA + +g7844: + if (_trace) printf("g7844:\n"); + t10 = t11 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t10 == 0) + goto g7843; + t7 = t1 << 1; + t10 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t10; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + arg5 = *(s32 *)(t8 + 4); + /* Compare */ + t10 = (s32)t1 - (s32)t7; + /* Trap on miss */ + if (t10 != 0) + goto g7847; + /* Extract the pointer, and indirect */ + t1 = (u32)arg5; + goto g7837; + +g7847: + if (_trace) printf("g7847:\n"); + goto dbcachemisstrap; +#endif + +g7843: + /* Perform memory action */ + arg1 = t11; + arg2 = 0; + goto performmemoryaction; + +g7827: + if (_trace) printf("g7827:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + arg6 = *(s32 *)t7; + /* Read from stack cache */ + t4 = *(s32 *)(t7 + 4); + goto g7826; + +g7829: + if (_trace) printf("g7829:\n"); + if ((t10 & 1) == 0) + goto g7828; + /* Do the indirect thing */ + t1 = (u32)arg6; + goto g7825; + +g7828: + if (_trace) printf("g7828:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7833: + if (_trace) printf("g7833:\n"); + t10 = t11 & MemoryActionTransform; + if (t10 == 0) + goto g7832; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g7836; +#ifndef MINIMA + +g7832: +#endif +#ifdef MINIMA + +g7832: + if (_trace) printf("g7832:\n"); + t10 = t11 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t10 == 0) + goto g7831; + t7 = t1 << 1; + t10 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t10; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + arg6 = *(s32 *)(t8 + 4); + /* Compare */ + t10 = (s32)t1 - (s32)t7; + /* Trap on miss */ + if (t10 != 0) + goto g7835; + /* Extract the pointer, and indirect */ + t1 = (u32)arg6; + goto g7825; + +g7835: + if (_trace) printf("g7835:\n"); + goto dbcachemisstrap; +#endif + +g7831: + /* Perform memory action */ + arg1 = t11; + arg2 = 0; + goto performmemoryaction; + +g7817: + if (_trace) printf("g7817:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t4 = *(s32 *)t7; + /* Read from stack cache */ + t6 = *(s32 *)(t7 + 4); + goto g7816; + +g7819: + if (_trace) printf("g7819:\n"); + if ((t10 & 1) == 0) + goto g7818; + /* Do the indirect thing */ + t5 = (u32)t4; + goto g7815; + +g7818: + if (_trace) printf("g7818:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t10 = t6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7821: + /* Perform memory action */ + arg1 = t11; + arg2 = 6; + goto performmemoryaction; + +g7801: + if (_trace) printf("g7801:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t5 = *(s32 *)t7; + /* Read from stack cache */ + t6 = *(s32 *)(t7 + 4); + goto g7800; + +g7803: + if (_trace) printf("g7803:\n"); + if ((t10 & 1) == 0) + goto g7802; + /* Do the indirect thing */ + t1 = (u32)t5; + goto g7799; + +g7802: + if (_trace) printf("g7802:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7807: + if (_trace) printf("g7807:\n"); + t10 = t11 & MemoryActionTransform; + if (t10 == 0) + goto g7806; + t6 = t6 & ~63L; + t6 = t6 | Type_ExternalValueCellPointer; + goto g7810; +#ifndef MINIMA + +g7806: +#endif +#ifdef MINIMA + +g7806: + if (_trace) printf("g7806:\n"); + t10 = t11 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t10 == 0) + goto g7805; + t7 = t1 << 1; + t10 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t10; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + t5 = *(s32 *)(t8 + 4); + /* Compare */ + t10 = (s32)t1 - (s32)t7; + /* Trap on miss */ + if (t10 != 0) + goto g7809; + /* Extract the pointer, and indirect */ + t1 = (u32)t5; + goto g7799; + +g7809: + if (_trace) printf("g7809:\n"); + goto dbcachemisstrap; +#endif + +g7805: + /* Perform memory action */ + arg1 = t11; + arg2 = 0; + goto performmemoryaction; + +g7789: + if (_trace) printf("g7789:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + arg3 = *(s32 *)t7; + /* Read from stack cache */ + t6 = *(s32 *)(t7 + 4); + goto g7788; + +g7791: + if (_trace) printf("g7791:\n"); + if ((t10 & 1) == 0) + goto g7790; + /* Do the indirect thing */ + t1 = (u32)arg3; + goto g7787; + +g7790: + if (_trace) printf("g7790:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7795: + if (_trace) printf("g7795:\n"); + t10 = t11 & MemoryActionTransform; + if (t10 == 0) + goto g7794; + t6 = t6 & ~63L; + t6 = t6 | Type_ExternalValueCellPointer; + goto g7798; +#ifndef MINIMA + +g7794: +#endif +#ifdef MINIMA + +g7794: + if (_trace) printf("g7794:\n"); + t10 = t11 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t10 == 0) + goto g7793; + t7 = t1 << 1; + t10 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t10; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + arg3 = *(s32 *)(t8 + 4); + /* Compare */ + t10 = (s32)t1 - (s32)t7; + /* Trap on miss */ + if (t10 != 0) + goto g7797; + /* Extract the pointer, and indirect */ + t1 = (u32)arg3; + goto g7787; + +g7797: + if (_trace) printf("g7797:\n"); + goto dbcachemisstrap; +#endif + +g7793: + /* Perform memory action */ + arg1 = t11; + arg2 = 0; + goto performmemoryaction; + +g7777: + if (_trace) printf("g7777:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + arg4 = *(s32 *)t7; + /* Read from stack cache */ + t6 = *(s32 *)(t7 + 4); + goto g7776; + +g7779: + if (_trace) printf("g7779:\n"); + if ((t10 & 1) == 0) + goto g7778; + /* Do the indirect thing */ + t1 = (u32)arg4; + goto g7775; + +g7778: + if (_trace) printf("g7778:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7783: + if (_trace) printf("g7783:\n"); + t10 = t11 & MemoryActionTransform; + if (t10 == 0) + goto g7782; + t6 = t6 & ~63L; + t6 = t6 | Type_ExternalValueCellPointer; + goto g7786; +#ifndef MINIMA + +g7782: +#endif +#ifdef MINIMA + +g7782: + if (_trace) printf("g7782:\n"); + t10 = t11 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t10 == 0) + goto g7781; + t7 = t1 << 1; + t10 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t10; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + arg4 = *(s32 *)(t8 + 4); + /* Compare */ + t10 = (s32)t1 - (s32)t7; + /* Trap on miss */ + if (t10 != 0) + goto g7785; + /* Extract the pointer, and indirect */ + t1 = (u32)arg4; + goto g7775; + +g7785: + if (_trace) printf("g7785:\n"); + goto dbcachemisstrap; +#endif + +g7781: + /* Perform memory action */ + arg1 = t11; + arg2 = 0; + goto performmemoryaction; + +/* end Setup1DLongArray */ +/* start DoFastAset1 */ + + /* Halfword operand from stack instruction - DoFastAset1 */ + /* arg2 has the preloaded 8 bit operand. */ + +dofastaset1: + if (_trace) printf("dofastaset1:\n"); +#ifdef TRACING +#endif + +DoFastAset1SP: + if (_trace) printf("DoFastAset1SP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindofastaset1; +#endif + +DoFastAset1LP: + if (_trace) printf("DoFastAset1LP:\n"); +#ifdef TRACING + goto begindofastaset1; +#endif + +DoFastAset1FP: + if (_trace) printf("DoFastAset1FP:\n"); + +begindofastaset1: + if (_trace) printf("begindofastaset1:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Index */ + arg4 = *(s32 *)iSP; + /* Index */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* value */ + t11 = *(s32 *)iSP; + /* value */ + t10 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t11 = (u32)t11; + t1 = arg3 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto fastaset1iop; + +fastaset1retry: + if (_trace) printf("fastaset1retry:\n"); + arg6 = *(s32 *)arg1; + t9 = *(s32 *)(arg1 + 8); + t3 = *(s32 *)(arg1 + 16); + arg6 = (u32)arg6; + t9 = (u32)t9; + t5 = arg6 << 42; + t3 = (u32)t3; + t4 = *(u64 *)&(processor->areventcount); + t5 = t5 >> 42; + t2 = ((u64)arg4 < (u64)t3) ? 1 : 0; + if (t2 == 0) + goto fastaset1bounds; + t6 = t4 - t5; + if (t6 != 0) + goto aset1recomputearrayregister; + t6 = arg6 >> (Array_RegisterBytePackingPos & 63); + t7 = arg6 >> (Array_RegisterByteOffsetPos & 63); + t8 = arg6 >> (Array_RegisterElementTypePos & 63); + t6 = t6 & Array_RegisterBytePackingMask; + t7 = t7 & Array_RegisterByteOffsetMask; + t8 = t8 & Array_RegisterElementTypeMask; + /* Element checking and foreplay. */ + /* TagType. */ + t1 = t10 & 63; + t12 = (t8 == Array_ElementTypeCharacter) ? 1 : 0; + +g7889: + if (_trace) printf("g7889:\n"); + if (t12 == 0) + goto g7885; + /* Here if argument ArrayElementTypeCharacter */ + t2 = t1 - Type_Character; + if (t2 == 0) + goto g7880; + arg5 = 0; + arg2 = 29; + goto illegaloperand; + +g7880: + if (_trace) printf("g7880:\n"); + /* Certainly will fit if not packed! */ + if (t6 == 0) + goto g7879; + t2 = 32; + /* Compute size of byte */ + t2 = t2 >> (t6 & 63); + t1 = ~zero; + t1 = t1 << (t2 & 63); + /* Compute mask for byte */ + t1 = ~t1; + t1 = t11 & t1; + t1 = t11 - t1; + /* J. if character fits. */ + if (t1 == 0) + goto g7879; + arg5 = 0; + arg2 = 62; + goto illegaloperand; + +g7885: + if (_trace) printf("g7885:\n"); + t12 = (t8 == Array_ElementTypeFixnum) ? 1 : 0; + +g7890: + if (_trace) printf("g7890:\n"); + if (t12 == 0) + goto g7886; + /* Here if argument ArrayElementTypeFixnum */ + t2 = t1 - Type_Fixnum; + if (t2 == 0) + goto g7879; + arg5 = 0; + arg2 = 33; + goto illegaloperand; + +g7886: + if (_trace) printf("g7886:\n"); + t12 = (t8 == Array_ElementTypeBoolean) ? 1 : 0; + +g7891: + if (_trace) printf("g7891:\n"); + if (t12 == 0) + goto g7884; + /* Here if argument ArrayElementTypeBoolean */ + t11 = 1; + t1 = t1 - Type_NIL; + /* J. if True */ + if (t1 != 0) + goto g7879; + t11 = zero; + goto g7879; + +g7884: + if (_trace) printf("g7884:\n"); + /* Shove it in. */ + +g7879: + if (_trace) printf("g7879:\n"); + /* J. if packed */ + if (t6 != 0) + goto g7881; + t1 = t8 - Array_ElementTypeObject; + if (t1 != 0) + goto g7881; + /* Here for the simple non packed case */ + t1 = t9 + arg4; + /* Memory Read Internal */ + +g7892: + /* Base of stack cache */ + t4 = *(u64 *)&(processor->stackcachebasevma); + t12 = t1 + ivory; + t5 = *(s32 *)&processor->scovlimit; + t3 = (t12 * 4); + t2 = LDQ_U(t12); + /* Stack cache offset */ + t4 = t1 - t4; + arg3 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t5 = ((u64)t4 < (u64)t5) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t12&7)*8)); + if (t5 != 0) + goto g7894; + +g7893: + t12 = zero + 240; + arg3 = arg3 >> (t2 & 63); + t12 = t12 >> (t2 & 63); + if (arg3 & 1) + goto g7896; + +g7902: + /* Merge cdr-code */ + t3 = t10 & 63; + t2 = t2 & 192; + t2 = t2 | t3; + t5 = *(u64 *)&(processor->stackcachebasevma); + t4 = t1 + ivory; + arg3 = *(s32 *)&processor->scovlimit; + t3 = (t4 * 4); + t12 = LDQ_U(t4); + /* Stack cache offset */ + t5 = t1 - t5; + /* In range? */ + arg3 = ((u64)t5 < (u64)arg3) ? 1 : 0; + t5 = (t2 & 0xff) << ((t4&7)*8); + t12 = t12 & ~(0xffL << (t4&7)*8); + +g7904: + if (_trace) printf("g7904:\n"); + t12 = t12 | t5; + STQ_U(t4, t12); + *(u32 *)t3 = t11; + /* J. if in cache */ + if (arg3 != 0) + goto g7903; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + /* Here for the slow packed version */ + +g7881: + if (_trace) printf("g7881:\n"); + arg4 = t7 + arg4; + /* Convert byte index to word index */ + t1 = arg4 >> (t6 & 63); + /* Address of word containing byte */ + t1 = t1 + t9; + /* Memory Read Internal */ + +g7905: + /* Base of stack cache */ + t2 = *(u64 *)&(processor->stackcachebasevma); + t4 = t1 + ivory; + t3 = *(s32 *)&processor->scovlimit; + t9 = (t4 * 4); + arg5 = LDQ_U(t4); + /* Stack cache offset */ + t2 = t1 - t2; + t5 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t3 = ((u64)t2 < (u64)t3) ? 1 : 0; + t9 = *(s32 *)t9; + arg5 = (u8)(arg5 >> ((t4&7)*8)); + if (t3 != 0) + goto g7907; + +g7906: + t4 = zero + 240; + t5 = t5 >> (arg5 & 63); + t4 = t4 >> (arg5 & 63); + t9 = (u32)t9; + if (t5 & 1) + goto g7909; + +g7916: + /* Check fixnum element type */ + /* TagType. */ + t2 = arg5 & 63; + t2 = t2 - Type_Fixnum; + /* J. if element type not fixnum. */ + if (t2 != 0) + goto g7882; + /* J. if unpacked fixnum element type. */ + if (t6 == 0) + goto g7883; + t12 = ~zero; + t12 = t12 << (t6 & 63); + t2 = zero - t6; + /* Compute subword index */ + t12 = arg4 & ~t12; + t2 = t2 + 5; + /* Compute shift to get byte */ + t2 = t12 << (t2 & 63); + t12 = 32; + /* Compute size of byte */ + t12 = t12 >> (t6 & 63); + t3 = ~zero; + t3 = t3 << (t12 & 63); + /* Compute mask for byte */ + t4 = ~t3; + /* inserting into the low byte is easy */ + if (t2 == 0) + goto g7917; + /* Inserting the byte into any byte other than the low byte */ + t5 = 64; + /* = the left shift rotate amount */ + t12 = t5 - t2; + /* shift selected byte into low end of word. */ + t5 = t9 >> (t2 & 63); + /* rotate low bits into high end of word. */ + t9 = t9 << (t12 & 63); + /* Remove unwanted bits */ + t5 = t3 & t5; + /* rotate low bits back into place. */ + t9 = t9 >> (t12 & 63); + /* Strip any extra bits from element */ + t12 = t11 & t4; + /* Insert new bits. */ + t5 = t12 | t5; + /* reposition bits */ + t5 = t5 << (t2 & 63); + /* Replace low order bits */ + t9 = t9 | t5; + goto g7918; + +g7917: + if (_trace) printf("g7917:\n"); + /* Inserting the byte into the low byte */ + /* Remove the old low byte */ + t9 = t9 & t3; + /* Remove unwanted bits from the new byte */ + t12 = t11 & t4; + /* Insert the new byte in place of the old byte */ + t9 = t9 | t12; + +g7918: + if (_trace) printf("g7918:\n"); + t11 = t9; + +g7883: + if (_trace) printf("g7883:\n"); + t3 = *(u64 *)&(processor->stackcachebasevma); + t2 = t1 + ivory; + t12 = *(s32 *)&processor->scovlimit; + t5 = (t2 * 4); + t4 = LDQ_U(t2); + /* Stack cache offset */ + t3 = t1 - t3; + /* In range? */ + t12 = ((u64)t3 < (u64)t12) ? 1 : 0; + t3 = (arg5 & 0xff) << ((t2&7)*8); + t4 = t4 & ~(0xffL << (t2&7)*8); + +g7920: + if (_trace) printf("g7920:\n"); + t4 = t4 | t3; + STQ_U(t2, t4); + *(u32 *)t5 = t11; + /* J. if in cache */ + if (t12 != 0) + goto g7919; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g7882: + if (_trace) printf("g7882:\n"); + arg5 = t1; + arg2 = 25; + goto illegaloperand; + +fastaset1iop: + if (_trace) printf("fastaset1iop:\n"); + arg5 = 0; + arg2 = 32; + goto illegaloperand; + +fastaset1bounds: + if (_trace) printf("fastaset1bounds:\n"); + arg5 = 0; + arg2 = 13; + goto illegaloperand; + +g7919: + if (_trace) printf("g7919:\n"); + t3 = *(u64 *)&(processor->stackcachebasevma); + +g7921: + if (_trace) printf("g7921:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t3 = t1 - t3; + /* reconstruct SCA */ + t2 = (t3 * 8) + t2; + /* Store in stack */ + *(u32 *)t2 = t11; + /* write the stack cache */ + *(u32 *)(t2 + 4) = arg5; + goto NEXTINSTRUCTION; + +g7907: + if (_trace) printf("g7907:\n"); + t3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t2 = (t2 * 8) + t3; + t9 = *(s32 *)t2; + /* Read from stack cache */ + arg5 = *(s32 *)(t2 + 4); + goto g7906; + +g7909: + if (_trace) printf("g7909:\n"); + if ((t4 & 1) == 0) + goto g7908; + /* Do the indirect thing */ + t1 = (u32)t9; + goto g7905; + +g7908: + if (_trace) printf("g7908:\n"); + /* Load the memory action table for cycle */ + t5 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t4 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t4 = (t4 * 4) + t5; + /* Get the memory action */ + t5 = *(s32 *)t4; + +g7913: + if (_trace) printf("g7913:\n"); + t4 = t5 & MemoryActionTransform; + if (t4 == 0) + goto g7912; + arg5 = arg5 & ~63L; + arg5 = arg5 | Type_ExternalValueCellPointer; + goto g7916; +#ifndef MINIMA + +g7912: +#endif +#ifdef MINIMA + +g7912: + if (_trace) printf("g7912:\n"); + t4 = t5 & MemoryActionBinding; + t3 = *(u64 *)&(processor->dbcmask); + if (t4 == 0) + goto g7911; + t2 = t1 << 1; + t4 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t2 = t2 & t3; + t3 = 1; + t3 = t3 << (ivorymemorydata & 63); + t2 = (s32)t2 + (s32)t4; + /* Clear sign-extension */ + t2 = (u32)t2; + t3 = (t2 * 4) + t3; + /* Fetch the key */ + t2 = *(s32 *)t3; + /* Fetch value */ + t9 = *(s32 *)(t3 + 4); + /* Compare */ + t4 = (s32)t1 - (s32)t2; + /* Trap on miss */ + if (t4 != 0) + goto g7915; + /* Extract the pointer, and indirect */ + t1 = (u32)t9; + goto g7905; + +g7915: + if (_trace) printf("g7915:\n"); + goto dbcachemisstrap; +#endif + +g7911: + /* Perform memory action */ + arg1 = t5; + arg2 = 0; + goto performmemoryaction; + +g7903: + if (_trace) printf("g7903:\n"); + t5 = *(u64 *)&(processor->stackcachebasevma); + +g7922: + if (_trace) printf("g7922:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t5 = t1 - t5; + /* reconstruct SCA */ + t4 = (t5 * 8) + t4; + /* Store in stack */ + *(u32 *)t4 = t11; + /* write the stack cache */ + *(u32 *)(t4 + 4) = t2; + goto NEXTINSTRUCTION; + +g7894: + if (_trace) printf("g7894:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t4 = (t4 * 8) + t5; + t3 = *(s32 *)t4; + /* Read from stack cache */ + t2 = *(s32 *)(t4 + 4); + goto g7893; + +g7896: + if (_trace) printf("g7896:\n"); + if ((t12 & 1) == 0) + goto g7895; + /* Do the indirect thing */ + t1 = (u32)t3; + goto g7892; + +g7895: + if (_trace) printf("g7895:\n"); + /* Load the memory action table for cycle */ + arg3 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t12 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t12 = (t12 * 4) + arg3; + /* Get the memory action */ + arg3 = *(s32 *)t12; +#ifndef MINIMA + +g7899: +#endif +#ifdef MINIMA + +g7899: + if (_trace) printf("g7899:\n"); + t12 = arg3 & MemoryActionBinding; + t5 = *(u64 *)&(processor->dbcmask); + if (t12 == 0) + goto g7898; + t4 = t1 << 1; + t12 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t4 = t4 & t5; + t5 = 1; + t5 = t5 << (ivorymemorydata & 63); + t4 = (s32)t4 + (s32)t12; + /* Clear sign-extension */ + t4 = (u32)t4; + t5 = (t4 * 4) + t5; + /* Fetch the key */ + t4 = *(s32 *)t5; + /* Fetch value */ + t3 = *(s32 *)(t5 + 4); + /* Compare */ + t12 = (s32)t1 - (s32)t4; + /* Trap on miss */ + if (t12 != 0) + goto g7901; + /* Extract the pointer, and indirect */ + t1 = (u32)t3; + goto g7892; + +g7901: + if (_trace) printf("g7901:\n"); + goto dbcachemisstrap; +#endif + +g7898: + /* Perform memory action */ + arg1 = arg3; + arg2 = 1; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoFastAset1IM: + goto doistageerror; + +/* end DoFastAset1 */ + /* End of Halfword operand from stack instruction - DoFastAset1 */ + /* Array leaders. */ +/* start DoArrayLeader */ + + /* Halfword operand from stack instruction - DoArrayLeader */ + /* arg2 has the preloaded 8 bit operand. */ + +doarrayleader: + if (_trace) printf("doarrayleader:\n"); +#ifdef TRACING +#endif + +DoArrayLeaderSP: + if (_trace) printf("DoArrayLeaderSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoarrayleader; +#endif + +DoArrayLeaderLP: + if (_trace) printf("DoArrayLeaderLP:\n"); +#ifdef TRACING + goto headdoarrayleader; +#endif + +DoArrayLeaderFP: + if (_trace) printf("DoArrayLeaderFP:\n"); + +headdoarrayleader: + if (_trace) printf("headdoarrayleader:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoarrayleader: + if (_trace) printf("begindoarrayleader:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* arg3=arraytag, arg4=arraydata */ + arg4 = *(s32 *)iSP; + /* arg3=arraytag, arg4=arraydata */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* index data */ + arg2 = (u32)arg1; + /* index tag */ + arg1 = arg1 >> 32; + t1 = arg1 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto arrayleaderiop; + +arrayleadermerge: + if (_trace) printf("arrayleadermerge:\n"); + t1 = arg3 - Type_Array; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto arrayleaderexception; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g7923: + t3 = arg4 + ivory; + arg5 = (t3 * 4); + arg6 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg4 - t11; + t4 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t1 < (u64)t12) ? 1 : 0; + arg5 = *(s32 *)arg5; + arg6 = (u8)(arg6 >> ((t3&7)*8)); + if (t2 != 0) + goto g7925; + +g7924: + t3 = zero + 64; + t4 = t4 >> (arg6 & 63); + t3 = t3 >> (arg6 & 63); + if (t4 & 1) + goto g7927; + +g7932: + /* TagType. */ + t1 = arg6 & 63; + t1 = t1 - Type_HeaderI; + if (t1 != 0) + goto arrayleaderiop; + t8 = arg5 >> (Array_LeaderLengthFieldPos & 63); + t8 = t8 & Array_LeaderLengthFieldMask; + t1 = ((u64)arg2 < (u64)t8) ? 1 : 0; + if (t1 == 0) + goto arrayleaderbounds; + arg2 = arg4 - arg2; + arg2 = arg2 - 1; + /* Memory Read Internal */ + +g7933: + t3 = arg2 + ivory; + arg5 = (t3 * 4); + arg6 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg2 - t11; + t4 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t2 = ((u64)t1 < (u64)t12) ? 1 : 0; + arg5 = *(s32 *)arg5; + arg6 = (u8)(arg6 >> ((t3&7)*8)); + if (t2 != 0) + goto g7935; + +g7934: + t3 = zero + 240; + t4 = t4 >> (arg6 & 63); + t3 = t3 >> (arg6 & 63); + if (t4 & 1) + goto g7937; + +g7944: + /* set CDR-NEXT */ + t1 = arg6 & 63; + *(u32 *)(iSP + 8) = arg5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +arrayleaderexception: + if (_trace) printf("arrayleaderexception:\n"); + arg1 = Type_Fixnum; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 10; + goto arrayexception; + +arrayleaderiop: + if (_trace) printf("arrayleaderiop:\n"); + arg5 = 0; + arg2 = 10; + goto illegaloperand; + +arrayleaderbounds: + if (_trace) printf("arrayleaderbounds:\n"); + arg5 = 0; + arg2 = 74; + goto illegaloperand; +#ifdef TRACING + goto DoArrayLeaderIM; +#endif + +DoArrayLeaderIM: + if (_trace) printf("DoArrayLeaderIM:\n"); + /* arg3=arraytag, arg4=arraydata */ + arg4 = *(s32 *)iSP; + /* arg3=arraytag, arg4=arraydata */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + goto arrayleadermerge; + +g7935: + if (_trace) printf("g7935:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + arg5 = *(s32 *)t1; + /* Read from stack cache */ + arg6 = *(s32 *)(t1 + 4); + goto g7934; + +g7937: + if (_trace) printf("g7937:\n"); + if ((t3 & 1) == 0) + goto g7936; + /* Do the indirect thing */ + arg2 = (u32)arg5; + goto g7933; + +g7936: + if (_trace) printf("g7936:\n"); + /* Load the memory action table for cycle */ + t4 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t3 = arg6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t4; + /* Get the memory action */ + t4 = *(s32 *)t3; + +g7941: + if (_trace) printf("g7941:\n"); + t3 = t4 & MemoryActionTransform; + if (t3 == 0) + goto g7940; + arg6 = arg6 & ~63L; + arg6 = arg6 | Type_ExternalValueCellPointer; + goto g7944; +#ifndef MINIMA + +g7940: +#endif +#ifdef MINIMA + +g7940: + if (_trace) printf("g7940:\n"); + t3 = t4 & MemoryActionBinding; + t2 = *(u64 *)&(processor->dbcmask); + if (t3 == 0) + goto g7939; + t1 = arg2 << 1; + t3 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t1 = t1 & t2; + t2 = 1; + t2 = t2 << (ivorymemorydata & 63); + t1 = (s32)t1 + (s32)t3; + /* Clear sign-extension */ + t1 = (u32)t1; + t2 = (t1 * 4) + t2; + /* Fetch the key */ + t1 = *(s32 *)t2; + /* Fetch value */ + arg5 = *(s32 *)(t2 + 4); + /* Compare */ + t3 = (s32)arg2 - (s32)t1; + /* Trap on miss */ + if (t3 != 0) + goto g7943; + /* Extract the pointer, and indirect */ + arg2 = (u32)arg5; + goto g7933; + +g7943: + if (_trace) printf("g7943:\n"); + goto dbcachemisstrap; +#endif + +g7939: + /* Perform memory action */ + arg1 = t4; + arg2 = 0; + goto performmemoryaction; + +g7925: + if (_trace) printf("g7925:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + arg5 = *(s32 *)t1; + /* Read from stack cache */ + arg6 = *(s32 *)(t1 + 4); + goto g7924; + +g7927: + if (_trace) printf("g7927:\n"); + if ((t3 & 1) == 0) + goto g7926; + /* Do the indirect thing */ + arg4 = (u32)arg5; + goto g7923; + +g7926: + if (_trace) printf("g7926:\n"); + /* Load the memory action table for cycle */ + t4 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = arg6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t4; + /* Get the memory action */ + t4 = *(s32 *)t3; + +g7929: + /* Perform memory action */ + arg1 = t4; + arg2 = 6; + goto performmemoryaction; + +/* end DoArrayLeader */ + /* End of Halfword operand from stack instruction - DoArrayLeader */ +/* start DoStoreArrayLeader */ + + /* Halfword operand from stack instruction - DoStoreArrayLeader */ + /* arg2 has the preloaded 8 bit operand. */ + +dostorearrayleader: + if (_trace) printf("dostorearrayleader:\n"); +#ifdef TRACING +#endif + +DoStoreArrayLeaderSP: + if (_trace) printf("DoStoreArrayLeaderSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdostorearrayleader; +#endif + +DoStoreArrayLeaderLP: + if (_trace) printf("DoStoreArrayLeaderLP:\n"); +#ifdef TRACING + goto headdostorearrayleader; +#endif + +DoStoreArrayLeaderFP: + if (_trace) printf("DoStoreArrayLeaderFP:\n"); + +headdostorearrayleader: + if (_trace) printf("headdostorearrayleader:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindostorearrayleader: + if (_trace) printf("begindostorearrayleader:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* arg3=arraytag, arg4=arraydata */ + arg4 = *(s32 *)iSP; + /* arg3=arraytag, arg4=arraydata */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* t6=valuetag, t7=valuedata */ + t7 = *(s32 *)iSP; + /* t6=valuetag, t7=valuedata */ + t6 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t7 = (u32)t7; + /* index data */ + arg2 = (u32)arg1; + /* index tag */ + arg1 = arg1 >> 32; + t1 = arg1 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto storearrayleaderiop; + +storearrayleadermerge: + if (_trace) printf("storearrayleadermerge:\n"); + t1 = arg3 - Type_Array; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto storearrayleaderexception; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g7945: + t3 = arg4 + ivory; + arg5 = (t3 * 4); + arg6 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg4 - t11; + t4 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t1 < (u64)t12) ? 1 : 0; + arg5 = *(s32 *)arg5; + arg6 = (u8)(arg6 >> ((t3&7)*8)); + if (t2 != 0) + goto g7947; + +g7946: + t3 = zero + 64; + t4 = t4 >> (arg6 & 63); + t3 = t3 >> (arg6 & 63); + if (t4 & 1) + goto g7949; + +g7954: + /* TagType. */ + t1 = arg6 & 63; + t1 = t1 - Type_HeaderI; + if (t1 != 0) + goto storearrayleaderiop; + t2 = arg5 >> (Array_LeaderLengthFieldPos & 63); + t2 = t2 & Array_LeaderLengthFieldMask; + t1 = ((u64)arg2 < (u64)t2) ? 1 : 0; + if (t1 == 0) + goto storearrayleaderbounds; + arg2 = arg4 - arg2; + arg2 = arg2 - 1; + /* Memory Read Internal */ + +g7955: + t5 = arg2 + ivory; + t2 = (t5 * 4); + t1 = LDQ_U(t5); + /* Stack cache offset */ + t3 = arg2 - t11; + t8 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t4 = ((u64)t3 < (u64)t12) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t5&7)*8)); + if (t4 != 0) + goto g7957; + +g7956: + t5 = zero + 240; + t8 = t8 >> (t1 & 63); + t5 = t5 >> (t1 & 63); + if (t8 & 1) + goto g7959; + +g7965: + /* Merge cdr-code */ + t2 = t6 & 63; + t1 = t1 & 192; + t1 = t1 | t2; + t3 = arg2 + ivory; + t2 = (t3 * 4); + t5 = LDQ_U(t3); + /* Stack cache offset */ + t4 = arg2 - t11; + /* In range? */ + t8 = ((u64)t4 < (u64)t12) ? 1 : 0; + t4 = (t1 & 0xff) << ((t3&7)*8); + t5 = t5 & ~(0xffL << (t3&7)*8); + +g7967: + if (_trace) printf("g7967:\n"); + t5 = t5 | t4; + STQ_U(t3, t5); + *(u32 *)t2 = t7; + /* J. if in cache */ + if (t8 != 0) + goto g7966; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +storearrayleaderexception: + if (_trace) printf("storearrayleaderexception:\n"); + arg1 = Type_Fixnum; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 3; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 11; + goto arrayexception; + +storearrayleaderiop: + if (_trace) printf("storearrayleaderiop:\n"); + arg5 = 0; + arg2 = 11; + goto illegaloperand; + +storearrayleaderbounds: + if (_trace) printf("storearrayleaderbounds:\n"); + arg5 = 0; + arg2 = 74; + goto illegaloperand; +#ifdef TRACING + goto DoStoreArrayLeaderIM; +#endif + +DoStoreArrayLeaderIM: + if (_trace) printf("DoStoreArrayLeaderIM:\n"); + /* arg3=arraytag, arg4=arraydata */ + arg4 = *(s32 *)iSP; + /* arg3=arraytag, arg4=arraydata */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* t6=valuetag, t7=valuedata */ + t7 = *(s32 *)iSP; + /* t6=valuetag, t7=valuedata */ + t6 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t7 = (u32)t7; + goto storearrayleadermerge; + +g7966: + if (_trace) printf("g7966:\n"); + t3 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t4 = arg2 - t11; + /* reconstruct SCA */ + t3 = (t4 * 8) + t3; + /* Store in stack */ + *(u32 *)t3 = t7; + /* write the stack cache */ + *(u32 *)(t3 + 4) = t1; + goto NEXTINSTRUCTION; + +g7957: + if (_trace) printf("g7957:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + t2 = *(s32 *)t3; + /* Read from stack cache */ + t1 = *(s32 *)(t3 + 4); + goto g7956; + +g7959: + if (_trace) printf("g7959:\n"); + if ((t5 & 1) == 0) + goto g7958; + /* Do the indirect thing */ + arg2 = (u32)t2; + goto g7955; + +g7958: + if (_trace) printf("g7958:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t5 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t5 = (t5 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t5; +#ifndef MINIMA + +g7962: +#endif +#ifdef MINIMA + +g7962: + if (_trace) printf("g7962:\n"); + t5 = t8 & MemoryActionBinding; + t4 = *(u64 *)&(processor->dbcmask); + if (t5 == 0) + goto g7961; + t3 = arg2 << 1; + t5 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t3 = t3 & t4; + t4 = 1; + t4 = t4 << (ivorymemorydata & 63); + t3 = (s32)t3 + (s32)t5; + /* Clear sign-extension */ + t3 = (u32)t3; + t4 = (t3 * 4) + t4; + /* Fetch the key */ + t3 = *(s32 *)t4; + /* Fetch value */ + t2 = *(s32 *)(t4 + 4); + /* Compare */ + t5 = (s32)arg2 - (s32)t3; + /* Trap on miss */ + if (t5 != 0) + goto g7964; + /* Extract the pointer, and indirect */ + arg2 = (u32)t2; + goto g7955; + +g7964: + if (_trace) printf("g7964:\n"); + goto dbcachemisstrap; +#endif + +g7961: + /* Perform memory action */ + arg1 = t8; + arg2 = 1; + goto performmemoryaction; + +g7947: + if (_trace) printf("g7947:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + arg5 = *(s32 *)t1; + /* Read from stack cache */ + arg6 = *(s32 *)(t1 + 4); + goto g7946; + +g7949: + if (_trace) printf("g7949:\n"); + if ((t3 & 1) == 0) + goto g7948; + /* Do the indirect thing */ + arg4 = (u32)arg5; + goto g7945; + +g7948: + if (_trace) printf("g7948:\n"); + /* Load the memory action table for cycle */ + t4 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = arg6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t4; + /* Get the memory action */ + t4 = *(s32 *)t3; + +g7951: + /* Perform memory action */ + arg1 = t4; + arg2 = 6; + goto performmemoryaction; + +/* end DoStoreArrayLeader */ + /* End of Halfword operand from stack instruction - DoStoreArrayLeader */ +/* start DoAlocLeader */ + + /* Halfword operand from stack instruction - DoAlocLeader */ + /* arg2 has the preloaded 8 bit operand. */ + +doalocleader: + if (_trace) printf("doalocleader:\n"); +#ifdef TRACING +#endif + +DoAlocLeaderSP: + if (_trace) printf("DoAlocLeaderSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoalocleader; +#endif + +DoAlocLeaderLP: + if (_trace) printf("DoAlocLeaderLP:\n"); +#ifdef TRACING + goto headdoalocleader; +#endif + +DoAlocLeaderFP: + if (_trace) printf("DoAlocLeaderFP:\n"); + +headdoalocleader: + if (_trace) printf("headdoalocleader:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoalocleader: + if (_trace) printf("begindoalocleader:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* arg3=arraytag, arg4=arraydata */ + arg4 = *(s32 *)iSP; + /* arg3=arraytag, arg4=arraydata */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* index data */ + arg2 = (u32)arg1; + /* index tag */ + arg1 = arg1 >> 32; + t1 = arg1 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto alocleaderiop; + +alocleadermerge: + if (_trace) printf("alocleadermerge:\n"); + t1 = arg3 - Type_Array; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto alocleaderexception; + /* Memory Read Internal */ + +g7968: + /* Base of stack cache */ + t1 = *(u64 *)&(processor->stackcachebasevma); + t3 = arg4 + ivory; + t2 = *(s32 *)&processor->scovlimit; + arg5 = (t3 * 4); + arg6 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg4 - t1; + t4 = *(u64 *)&(processor->header_mask); + /* In range? */ + t2 = ((u64)t1 < (u64)t2) ? 1 : 0; + arg5 = *(s32 *)arg5; + arg6 = (u8)(arg6 >> ((t3&7)*8)); + if (t2 != 0) + goto g7970; + +g7969: + t3 = zero + 64; + t4 = t4 >> (arg6 & 63); + t3 = t3 >> (arg6 & 63); + if (t4 & 1) + goto g7972; + +g7977: + /* TagType. */ + t1 = arg6 & 63; + t1 = t1 - Type_HeaderI; + if (t1 != 0) + goto alocleaderiop; + t9 = arg5 >> (Array_LeaderLengthFieldPos & 63); + t9 = t9 & Array_LeaderLengthFieldMask; + t1 = ((u64)arg2 < (u64)t9) ? 1 : 0; + if (t1 == 0) + goto alocleaderbounds; + arg2 = arg4 - arg2; + arg2 = arg2 - 1; + t1 = Type_Locative; + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +alocleaderexception: + if (_trace) printf("alocleaderexception:\n"); + arg1 = Type_Fixnum; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 10; + goto arrayexception; + +alocleaderiop: + if (_trace) printf("alocleaderiop:\n"); + arg5 = 0; + arg2 = 10; + goto illegaloperand; + +alocleaderbounds: + if (_trace) printf("alocleaderbounds:\n"); + arg5 = 0; + arg2 = 74; + goto illegaloperand; +#ifdef TRACING + goto DoAlocLeaderIM; +#endif + +DoAlocLeaderIM: + if (_trace) printf("DoAlocLeaderIM:\n"); + /* arg3=arraytag, arg4=arraydata */ + arg4 = *(s32 *)iSP; + /* arg3=arraytag, arg4=arraydata */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + goto alocleadermerge; + +g7970: + if (_trace) printf("g7970:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + arg5 = *(s32 *)t1; + /* Read from stack cache */ + arg6 = *(s32 *)(t1 + 4); + goto g7969; + +g7972: + if (_trace) printf("g7972:\n"); + if ((t3 & 1) == 0) + goto g7971; + /* Do the indirect thing */ + arg4 = (u32)arg5; + goto g7968; + +g7971: + if (_trace) printf("g7971:\n"); + /* Load the memory action table for cycle */ + t4 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t3 = arg6 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t4; + /* Get the memory action */ + t4 = *(s32 *)t3; + +g7974: + /* Perform memory action */ + arg1 = t4; + arg2 = 6; + goto performmemoryaction; + +/* end DoAlocLeader */ + /* End of Halfword operand from stack instruction - DoAlocLeader */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunarra.as */ diff --git a/stub/ifunbind.c b/stub/ifunbind.c new file mode 100644 index 0000000..f715c9d --- /dev/null +++ b/stub/ifunbind.c @@ -0,0 +1,1413 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunbind.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Binding Instructions. */ +/* start DoBindLocativeToValue */ + + /* Halfword operand from stack instruction - DoBindLocativeToValue */ + +dobindlocativetovalue: + if (_trace) printf("dobindlocativetovalue:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoBindLocativeToValueIM: + if (_trace) printf("DoBindLocativeToValueIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8648: + if (_trace) printf("g8648:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindobindlocativetovalue; +#ifdef TRACING +#endif + +DoBindLocativeToValueSP: + if (_trace) printf("DoBindLocativeToValueSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdobindlocativetovalue; +#endif + +DoBindLocativeToValueLP: + if (_trace) printf("DoBindLocativeToValueLP:\n"); +#ifdef TRACING + goto headdobindlocativetovalue; +#endif + +DoBindLocativeToValueFP: + if (_trace) printf("DoBindLocativeToValueFP:\n"); + +headdobindlocativetovalue: + if (_trace) printf("headdobindlocativetovalue:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindobindlocativetovalue: + if (_trace) printf("begindobindlocativetovalue:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* ltag/ldata */ + arg6 = *(s32 *)iSP; + /* ltag/ldata */ + arg5 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg6 = (u32)arg6; + arg3 = *(u64 *)&(processor->bindingstackpointer); + /* new tag */ + arg2 = arg1 >> 32; + arg4 = *(u64 *)&(processor->bindingstacklimit); + /* new data */ + arg1 = (u32)arg1; + t1 = arg5 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto bindloctovaliop; +#ifdef MINIMA + t2 = arg3 >> 32; +#endif + arg3 = (u32)arg3; + arg4 = (u32)arg4; + t1 = arg3 - arg4; + /* J. if binding stack overflow */ + if ((s64)t1 >= 0) + goto bindloctovalov; + t3 = arg3 + 1; +#ifdef MINIMA + /* BSP not a locative -> Deep-bound */ + t1 = t2 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto bindloctovaldeep; +#endif + t9 = *(s32 *)&processor->control; + t8 = arg6; + /* Memory Read Internal */ + +g8616: + /* Base of stack cache */ + t4 = *(u64 *)&(processor->stackcachebasevma); + t6 = t8 + ivory; + t5 = *(s32 *)&processor->scovlimit; + t1 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t4 = t8 - t4; + t7 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t5 = ((u64)t4 < (u64)t5) ? 1 : 0; + t1 = *(s32 *)t1; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t5 != 0) + goto g8618; + +g8617: + t6 = zero + 224; + t7 = t7 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + if (t7 & 1) + goto g8620; + +g8625: + t10 = t9 >> 19; + /* TagType. */ + t8 = arg5 & 63; + /* Extract the CR.cleanup-bindings bit */ + t10 = t10 & 64; + t11 = t10 | t8; + t5 = *(u64 *)&(processor->stackcachebasevma); + t4 = t3 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t7 = (t4 * 4); + t6 = LDQ_U(t4); + /* Stack cache offset */ + t5 = t3 - t5; + /* In range? */ + t8 = ((u64)t5 < (u64)t8) ? 1 : 0; + t5 = (t11 & 0xff) << ((t4&7)*8); + t6 = t6 & ~(0xffL << (t4&7)*8); + +g8628: + if (_trace) printf("g8628:\n"); + t6 = t6 | t5; + STQ_U(t4, t6); + *(u32 *)t7 = arg6; + /* J. if in cache */ + if (t8 != 0) + goto g8627; + +g8626: + t3 = arg3 + 2; + t5 = *(u64 *)&(processor->stackcachebasevma); + t4 = t3 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t7 = (t4 * 4); + t6 = LDQ_U(t4); + /* Stack cache offset */ + t5 = t3 - t5; + /* In range? */ + t8 = ((u64)t5 < (u64)t8) ? 1 : 0; + t5 = (t2 & 0xff) << ((t4&7)*8); + t6 = t6 & ~(0xffL << (t4&7)*8); + +g8631: + if (_trace) printf("g8631:\n"); + t6 = t6 | t5; + STQ_U(t4, t6); + *(u32 *)t7 = t1; + /* J. if in cache */ + if (t8 != 0) + goto g8630; + +g8629: + t1 = (512) << 16; + /* Memory Read Internal */ + +g8632: + /* Base of stack cache */ + t6 = *(u64 *)&(processor->stackcachebasevma); + t8 = arg6 + ivory; + t7 = *(s32 *)&processor->scovlimit; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = arg6 - t6; + t10 = *(u64 *)&(processor->bindwrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)t7) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g8634; + +g8633: + t8 = zero + 224; + t10 = t10 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t10 & 1) + goto g8636; + +g8641: + /* Merge cdr-code */ + t5 = arg2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t7 = *(u64 *)&(processor->stackcachebasevma); + t6 = arg6 + ivory; + t10 = *(s32 *)&processor->scovlimit; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = arg6 - t7; + /* In range? */ + t10 = ((u64)t7 < (u64)t10) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g8644: + if (_trace) printf("g8644:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = arg1; + /* J. if in cache */ + if (t10 != 0) + goto g8643; + +g8642: + /* Set cr.cleanup-bindings bit */ + t9 = t1 | t9; + *(u32 *)&processor->control = t9; + /* vma only */ + *(u32 *)&processor->bindingstackpointer = t3; + goto NEXTINSTRUCTION; + +bindloctovalov: + if (_trace) printf("bindloctovalov:\n"); + arg5 = 0; + arg2 = 19; + goto illegaloperand; + +bindloctovaliop: + if (_trace) printf("bindloctovaliop:\n"); + arg5 = 0; + arg2 = 18; + goto illegaloperand; + +bindloctovaldeep: + if (_trace) printf("bindloctovaldeep:\n"); + /* Get the SP, ->op2 */ + t1 = *(u64 *)&(processor->restartsp); + /* Convert stack cache address to VMA */ + t3 = *(u64 *)&(processor->stackcachedata); + t2 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t3 = t1 - t3; + /* convert byte address to word address */ + t3 = t3 >> 3; + /* reconstruct VMA */ + t2 = t3 + t2; + arg5 = t2; + arg2 = 72; + goto illegaloperand; + +g8643: + if (_trace) printf("g8643:\n"); + t7 = *(u64 *)&(processor->stackcachebasevma); + +g8645: + if (_trace) printf("g8645:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = arg6 - t7; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = arg1; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto g8642; + +g8634: + if (_trace) printf("g8634:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g8633; + +g8636: + if (_trace) printf("g8636:\n"); + if ((t8 & 1) == 0) + goto g8635; + /* Do the indirect thing */ + arg6 = (u32)t5; + goto g8632; + +g8635: + if (_trace) printf("g8635:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->bindwrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg6; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t8; + +g8638: + /* Perform memory action */ + arg1 = t10; + arg2 = 3; + goto performmemoryaction; + +g8630: + if (_trace) printf("g8630:\n"); + t5 = *(u64 *)&(processor->stackcachebasevma); + +g8646: + if (_trace) printf("g8646:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t5 = t3 - t5; + /* reconstruct SCA */ + t4 = (t5 * 8) + t4; + /* Store in stack */ + *(u32 *)t4 = t1; + /* write the stack cache */ + *(u32 *)(t4 + 4) = t2; + goto g8629; + +g8627: + if (_trace) printf("g8627:\n"); + t5 = *(u64 *)&(processor->stackcachebasevma); + +g8647: + if (_trace) printf("g8647:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t5 = t3 - t5; + /* reconstruct SCA */ + t4 = (t5 * 8) + t4; + /* Store in stack */ + *(u32 *)t4 = arg6; + /* write the stack cache */ + *(u32 *)(t4 + 4) = t11; + goto g8626; + +g8618: + if (_trace) printf("g8618:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t4 = (t4 * 8) + t5; + t1 = *(s32 *)t4; + /* Read from stack cache */ + t2 = *(s32 *)(t4 + 4); + goto g8617; + +g8620: + if (_trace) printf("g8620:\n"); + if ((t6 & 1) == 0) + goto g8619; + /* Do the indirect thing */ + t8 = (u32)t1; + goto g8616; + +g8619: + if (_trace) printf("g8619:\n"); + /* Load the memory action table for cycle */ + t7 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t8; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t7; + /* Get the memory action */ + t7 = *(s32 *)t6; + +g8622: + /* Perform memory action */ + arg1 = t7; + arg2 = 2; + goto performmemoryaction; + +/* end DoBindLocativeToValue */ + /* End of Halfword operand from stack instruction - DoBindLocativeToValue */ +/* start DoBindLocative */ + + /* Halfword operand from stack instruction - DoBindLocative */ + /* arg2 has the preloaded 8 bit operand. */ + +dobindlocative: + if (_trace) printf("dobindlocative:\n"); +#ifdef TRACING +#endif + +DoBindLocativeSP: + if (_trace) printf("DoBindLocativeSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindobindlocative; +#endif + +DoBindLocativeLP: + if (_trace) printf("DoBindLocativeLP:\n"); +#ifdef TRACING + goto begindobindlocative; +#endif + +DoBindLocativeFP: + if (_trace) printf("DoBindLocativeFP:\n"); + +begindobindlocative: + if (_trace) printf("begindobindlocative:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + arg3 = *(u64 *)&(processor->bindingstackpointer); + /* tag */ + arg5 = arg1 >> 32; + arg4 = *(u64 *)&(processor->bindingstacklimit); + /* data */ + arg6 = (u32)arg1; + t1 = arg5 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto bindlociop; +#ifdef MINIMA + t2 = arg3 >> 32; +#endif + arg3 = (u32)arg3; + arg4 = (u32)arg4; + t1 = arg3 - arg4; + /* J. if binding stack overflow */ + if ((s64)t1 >= 0) + goto bindlocov; + t3 = arg3 + 1; +#ifdef MINIMA + /* BSP not a locative -> Deep-bound */ + t1 = t2 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto bindlocdeep; +#endif + t9 = *(s32 *)&processor->control; + t8 = arg6; + /* Memory Read Internal */ + +g8649: + /* Base of stack cache */ + t4 = *(u64 *)&(processor->stackcachebasevma); + t6 = t8 + ivory; + t5 = *(s32 *)&processor->scovlimit; + t1 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t4 = t8 - t4; + t7 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t5 = ((u64)t4 < (u64)t5) ? 1 : 0; + t1 = *(s32 *)t1; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t5 != 0) + goto g8651; + +g8650: + t6 = zero + 224; + t7 = t7 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + if (t7 & 1) + goto g8653; + +g8658: + t10 = t9 >> 19; + /* TagType. */ + t8 = arg5 & 63; + /* Extract the CR.cleanup-bindings bit */ + t10 = t10 & 64; + t11 = t10 | t8; + t5 = *(u64 *)&(processor->stackcachebasevma); + t4 = t3 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t7 = (t4 * 4); + t6 = LDQ_U(t4); + /* Stack cache offset */ + t5 = t3 - t5; + /* In range? */ + t8 = ((u64)t5 < (u64)t8) ? 1 : 0; + t5 = (t11 & 0xff) << ((t4&7)*8); + t6 = t6 & ~(0xffL << (t4&7)*8); + +g8661: + if (_trace) printf("g8661:\n"); + t6 = t6 | t5; + STQ_U(t4, t6); + *(u32 *)t7 = arg6; + /* J. if in cache */ + if (t8 != 0) + goto g8660; + +g8659: + t3 = arg3 + 2; + t5 = *(u64 *)&(processor->stackcachebasevma); + t4 = t3 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t7 = (t4 * 4); + t6 = LDQ_U(t4); + /* Stack cache offset */ + t5 = t3 - t5; + /* In range? */ + t8 = ((u64)t5 < (u64)t8) ? 1 : 0; + t5 = (t2 & 0xff) << ((t4&7)*8); + t6 = t6 & ~(0xffL << (t4&7)*8); + +g8664: + if (_trace) printf("g8664:\n"); + t6 = t6 | t5; + STQ_U(t4, t6); + *(u32 *)t7 = t1; + /* J. if in cache */ + if (t8 != 0) + goto g8663; + +g8662: + t1 = (512) << 16; + /* Set cr.cleanup-bindings bit */ + t9 = t1 | t9; + *(u32 *)&processor->control = t9; + /* vma only */ + *(u32 *)&processor->bindingstackpointer = t3; + goto NEXTINSTRUCTION; + +bindlocov: + if (_trace) printf("bindlocov:\n"); + arg5 = 0; + arg2 = 19; + goto illegaloperand; + +bindlociop: + if (_trace) printf("bindlociop:\n"); + arg5 = 0; + arg2 = 18; + goto illegaloperand; + +bindlocdeep: + if (_trace) printf("bindlocdeep:\n"); + /* Get the SP, ->op2 */ + t1 = *(u64 *)&(processor->restartsp); + /* Convert stack cache address to VMA */ + t3 = *(u64 *)&(processor->stackcachedata); + t2 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t3 = t1 - t3; + /* convert byte address to word address */ + t3 = t3 >> 3; + /* reconstruct VMA */ + t2 = t3 + t2; + arg5 = t2; + arg2 = 72; + goto illegaloperand; + +g8663: + if (_trace) printf("g8663:\n"); + t5 = *(u64 *)&(processor->stackcachebasevma); + +g8665: + if (_trace) printf("g8665:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t5 = t3 - t5; + /* reconstruct SCA */ + t4 = (t5 * 8) + t4; + /* Store in stack */ + *(u32 *)t4 = t1; + /* write the stack cache */ + *(u32 *)(t4 + 4) = t2; + goto g8662; + +g8660: + if (_trace) printf("g8660:\n"); + t5 = *(u64 *)&(processor->stackcachebasevma); + +g8666: + if (_trace) printf("g8666:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t5 = t3 - t5; + /* reconstruct SCA */ + t4 = (t5 * 8) + t4; + /* Store in stack */ + *(u32 *)t4 = arg6; + /* write the stack cache */ + *(u32 *)(t4 + 4) = t11; + goto g8659; + +g8651: + if (_trace) printf("g8651:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t4 = (t4 * 8) + t5; + t1 = *(s32 *)t4; + /* Read from stack cache */ + t2 = *(s32 *)(t4 + 4); + goto g8650; + +g8653: + if (_trace) printf("g8653:\n"); + if ((t6 & 1) == 0) + goto g8652; + /* Do the indirect thing */ + t8 = (u32)t1; + goto g8649; + +g8652: + if (_trace) printf("g8652:\n"); + /* Load the memory action table for cycle */ + t7 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t8; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t7; + /* Get the memory action */ + t7 = *(s32 *)t6; + +g8655: + /* Perform memory action */ + arg1 = t7; + arg2 = 2; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoBindLocativeIM: + goto doistageerror; + +/* end DoBindLocative */ + /* End of Halfword operand from stack instruction - DoBindLocative */ +/* start DoUnbindN */ + + /* Halfword operand from stack instruction - DoUnbindN */ + /* arg2 has the preloaded 8 bit operand. */ + +dounbindn: + if (_trace) printf("dounbindn:\n"); +#ifdef TRACING +#endif + +DoUnbindNIM: + if (_trace) printf("DoUnbindNIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindounbindn; +#ifdef TRACING +#endif + +DoUnbindNSP: + if (_trace) printf("DoUnbindNSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdounbindn; +#endif + +DoUnbindNLP: + if (_trace) printf("DoUnbindNLP:\n"); +#ifdef TRACING + goto headdounbindn; +#endif + +DoUnbindNFP: + if (_trace) printf("DoUnbindNFP:\n"); + +headdounbindn: + if (_trace) printf("headdounbindn:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindounbindn: + if (_trace) printf("begindounbindn:\n"); + /* arg1 has the operand, not sign extended if immediate. */ +#ifdef MINIMA + arg3 = *(u64 *)&(processor->bindingstackpointer); +#endif + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t1 = arg2 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto unbindniop; +#ifdef MINIMA + /* BSP not a locative -> Deep-bound */ + t2 = arg3 >> 32; + t1 = t2 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto unbindndeep; +#endif + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + goto unbindnendloop; + +unbindntoploop: + if (_trace) printf("unbindntoploop:\n"); + arg1 = arg1 - 1; + t1 = *(u64 *)&(processor->bindingstackpointer); + t4 = *(s32 *)&processor->control; + /* vma only */ + t1 = (u32)t1; + t2 = (512) << 16; + t5 = t1 - 1; + t3 = t4 & t2; + /* Turn off the bit */ + t4 = t4 & ~t2; + if (t3 != 0) + goto g8667; + /* Get the SP, ->op2 */ + t4 = *(u64 *)&(processor->restartsp); + arg5 = 0; + arg2 = 20; + goto illegaloperand; + +g8667: + if (_trace) printf("g8667:\n"); + /* Memory Read Internal */ + +g8668: + arg4 = t1 + ivory; + t6 = (arg4 * 4); + t7 = LDQ_U(arg4); + /* Stack cache offset */ + t8 = t1 - t11; + arg5 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + arg3 = ((u64)t8 < (u64)t12) ? 1 : 0; + t6 = *(s32 *)t6; + t7 = (u8)(t7 >> ((arg4&7)*8)); + if (arg3 != 0) + goto g8670; + +g8669: + arg4 = zero + 224; + arg5 = arg5 >> (t7 & 63); + arg4 = arg4 >> (t7 & 63); + if (arg5 & 1) + goto g8672; + +g8677: + /* Memory Read Internal */ + +g8678: + arg4 = t5 + ivory; + t2 = (arg4 * 4); + t3 = LDQ_U(arg4); + /* Stack cache offset */ + t8 = t5 - t11; + arg5 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + arg3 = ((u64)t8 < (u64)t12) ? 1 : 0; + t2 = *(s32 *)t2; + t3 = (u8)(t3 >> ((arg4&7)*8)); + if (arg3 != 0) + goto g8680; + +g8679: + arg4 = zero + 224; + arg5 = arg5 >> (t3 & 63); + arg4 = arg4 >> (t3 & 63); + t2 = (u32)t2; + if (arg5 & 1) + goto g8682; + +g8687: + /* Memory Read Internal */ + +g8688: + arg6 = t2 + ivory; + arg3 = (arg6 * 4); + t8 = LDQ_U(arg6); + /* Stack cache offset */ + arg4 = t2 - t11; + /* In range? */ + arg5 = ((u64)arg4 < (u64)t12) ? 1 : 0; + arg3 = *(s32 *)arg3; + t8 = (u8)(t8 >> ((arg6&7)*8)); + if (arg5 != 0) + goto g8690; + +g8689: + arg4 = *(u64 *)&(processor->bindwrite_mask); + arg6 = zero + 224; + arg4 = arg4 >> (t8 & 63); + arg6 = arg6 >> (t8 & 63); + if (arg4 & 1) + goto g8692; + +g8697: + /* Merge cdr-code */ + arg3 = t7 & 63; + t8 = t8 & 192; + t8 = t8 | arg3; + arg4 = t2 + ivory; + arg3 = (arg4 * 4); + arg6 = LDQ_U(arg4); + arg5 = (t8 & 0xff) << ((arg4&7)*8); + arg6 = arg6 & ~(0xffL << (arg4&7)*8); + +g8700: + if (_trace) printf("g8700:\n"); + arg6 = arg6 | arg5; + STQ_U(arg4, arg6); + arg4 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + arg5 = t2 - t11; + /* In range? */ + arg4 = ((u64)arg5 < (u64)arg4) ? 1 : 0; + *(u32 *)arg3 = t6; + /* J. if in cache */ + if (arg4 != 0) + goto g8699; + +g8698: + /* Get the old cleanup-bindings bit */ + t3 = t3 & 64; + t3 = t3 << 19; + t1 = t1 - 2; + /* vma only */ + *(u32 *)&processor->bindingstackpointer = t1; + t4 = t4 | t3; + *(u32 *)&processor->control = t4; + +unbindnendloop: + if (_trace) printf("unbindnendloop:\n"); + if ((s64)arg1 > 0) + goto unbindntoploop; + t3 = *(s32 *)&processor->interruptreg; + t4 = t3 & 2; + t4 = (t4 == 2) ? 1 : 0; + t3 = t3 | t4; + *(u32 *)&processor->interruptreg = t3; + if (t3 == 0) + goto NEXTINSTRUCTION; + *(u64 *)&processor->stop_interpreter = t3; + goto NEXTINSTRUCTION; + +unbindniop: + if (_trace) printf("unbindniop:\n"); + arg5 = 0; + arg2 = 63; + goto illegaloperand; +#ifdef MINIMA + +unbindndeep: + if (_trace) printf("unbindndeep:\n"); + /* Get the SP, ->op2 */ + t1 = *(u64 *)&(processor->restartsp); + /* Convert stack cache address to VMA */ + t3 = *(u64 *)&(processor->stackcachedata); + t2 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t3 = t1 - t3; + /* convert byte address to word address */ + t3 = t3 >> 3; + /* reconstruct VMA */ + t2 = t3 + t2; + arg5 = t2; + arg2 = 72; + goto illegaloperand; +#endif + +g8699: + if (_trace) printf("g8699:\n"); + arg4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + arg4 = (arg5 * 8) + arg4; + /* Store in stack */ + *(u32 *)arg4 = t6; + /* write the stack cache */ + *(u32 *)(arg4 + 4) = t8; + goto g8698; + +g8690: + if (_trace) printf("g8690:\n"); + arg5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + arg4 = (arg4 * 8) + arg5; + arg3 = *(s32 *)arg4; + /* Read from stack cache */ + t8 = *(s32 *)(arg4 + 4); + goto g8689; + +g8692: + if (_trace) printf("g8692:\n"); + if ((arg6 & 1) == 0) + goto g8691; + /* Do the indirect thing */ + t2 = (u32)arg3; + goto g8688; + +g8691: + if (_trace) printf("g8691:\n"); + /* Load the memory action table for cycle */ + arg4 = *(u64 *)&(processor->bindwrite); + /* TagType. */ + /* Discard the CDR code */ + arg6 = t8 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + arg6 = (arg6 * 4) + arg4; + /* Get the memory action */ + arg4 = *(s32 *)arg6; + +g8694: + /* Perform memory action */ + arg1 = arg4; + arg2 = 3; + goto performmemoryaction; + +g8680: + if (_trace) printf("g8680:\n"); + arg3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + arg3; + t2 = *(s32 *)t8; + /* Read from stack cache */ + t3 = *(s32 *)(t8 + 4); + goto g8679; + +g8682: + if (_trace) printf("g8682:\n"); + if ((arg4 & 1) == 0) + goto g8681; + /* Do the indirect thing */ + t5 = (u32)t2; + goto g8678; + +g8681: + if (_trace) printf("g8681:\n"); + /* Load the memory action table for cycle */ + arg5 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + arg4 = t3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + arg4 = (arg4 * 4) + arg5; + /* Get the memory action */ + arg5 = *(s32 *)arg4; + +g8684: + /* Perform memory action */ + arg1 = arg5; + arg2 = 2; + goto performmemoryaction; + +g8670: + if (_trace) printf("g8670:\n"); + arg3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + arg3; + t6 = *(s32 *)t8; + /* Read from stack cache */ + t7 = *(s32 *)(t8 + 4); + goto g8669; + +g8672: + if (_trace) printf("g8672:\n"); + if ((arg4 & 1) == 0) + goto g8671; + /* Do the indirect thing */ + t1 = (u32)t6; + goto g8668; + +g8671: + if (_trace) printf("g8671:\n"); + /* Load the memory action table for cycle */ + arg5 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + arg4 = t7 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + arg4 = (arg4 * 4) + arg5; + /* Get the memory action */ + arg5 = *(s32 *)arg4; + +g8674: + /* Perform memory action */ + arg1 = arg5; + arg2 = 2; + goto performmemoryaction; + +/* end DoUnbindN */ + /* End of Halfword operand from stack instruction - DoUnbindN */ +/* start DoRestoreBindingStack */ + + /* Halfword operand from stack instruction - DoRestoreBindingStack */ + /* arg2 has the preloaded 8 bit operand. */ + +dorestorebindingstack: + if (_trace) printf("dorestorebindingstack:\n"); +#ifdef TRACING +#endif + +DoRestoreBindingStackIM: + if (_trace) printf("DoRestoreBindingStackIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindorestorebindingstack; +#ifdef TRACING +#endif + +DoRestoreBindingStackSP: + if (_trace) printf("DoRestoreBindingStackSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdorestorebindingstack; +#endif + +DoRestoreBindingStackLP: + if (_trace) printf("DoRestoreBindingStackLP:\n"); +#ifdef TRACING + goto headdorestorebindingstack; +#endif + +DoRestoreBindingStackFP: + if (_trace) printf("DoRestoreBindingStackFP:\n"); + +headdorestorebindingstack: + if (_trace) printf("headdorestorebindingstack:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindorestorebindingstack: + if (_trace) printf("begindorestorebindingstack:\n"); + /* arg1 has the operand, not sign extended if immediate. */ +#ifdef MINIMA + arg3 = *(u64 *)&(processor->bindingstackpointer); +#endif + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t1 = arg2 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto restorebsiop; +#ifdef MINIMA + /* BSP not a locative -> Deep-bound */ + t2 = arg3 >> 32; + t1 = t2 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto restorebsdeep; +#endif + t1 = *(u64 *)&(processor->bindingstackpointer); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + goto restorebsendloop; + +restorebstoploop: + if (_trace) printf("restorebstoploop:\n"); + t1 = *(u64 *)&(processor->bindingstackpointer); + t4 = *(s32 *)&processor->control; + /* vma only */ + t1 = (u32)t1; + t2 = (512) << 16; + t5 = t1 - 1; + t3 = t4 & t2; + /* Turn off the bit */ + t4 = t4 & ~t2; + if (t3 != 0) + goto g8701; + /* Get the SP, ->op2 */ + t4 = *(u64 *)&(processor->restartsp); + arg5 = 0; + arg2 = 20; + goto illegaloperand; + +g8701: + if (_trace) printf("g8701:\n"); + /* Memory Read Internal */ + +g8702: + arg4 = t1 + ivory; + t6 = (arg4 * 4); + t7 = LDQ_U(arg4); + /* Stack cache offset */ + t8 = t1 - t11; + arg5 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + arg3 = ((u64)t8 < (u64)t12) ? 1 : 0; + t6 = *(s32 *)t6; + t7 = (u8)(t7 >> ((arg4&7)*8)); + if (arg3 != 0) + goto g8704; + +g8703: + arg4 = zero + 224; + arg5 = arg5 >> (t7 & 63); + arg4 = arg4 >> (t7 & 63); + if (arg5 & 1) + goto g8706; + +g8711: + /* Memory Read Internal */ + +g8712: + arg4 = t5 + ivory; + t2 = (arg4 * 4); + t3 = LDQ_U(arg4); + /* Stack cache offset */ + t8 = t5 - t11; + arg5 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + arg3 = ((u64)t8 < (u64)t12) ? 1 : 0; + t2 = *(s32 *)t2; + t3 = (u8)(t3 >> ((arg4&7)*8)); + if (arg3 != 0) + goto g8714; + +g8713: + arg4 = zero + 224; + arg5 = arg5 >> (t3 & 63); + arg4 = arg4 >> (t3 & 63); + t2 = (u32)t2; + if (arg5 & 1) + goto g8716; + +g8721: + /* Memory Read Internal */ + +g8722: + arg6 = t2 + ivory; + arg3 = (arg6 * 4); + t8 = LDQ_U(arg6); + /* Stack cache offset */ + arg4 = t2 - t11; + /* In range? */ + arg5 = ((u64)arg4 < (u64)t12) ? 1 : 0; + arg3 = *(s32 *)arg3; + t8 = (u8)(t8 >> ((arg6&7)*8)); + if (arg5 != 0) + goto g8724; + +g8723: + arg4 = *(u64 *)&(processor->bindwrite_mask); + arg6 = zero + 224; + arg4 = arg4 >> (t8 & 63); + arg6 = arg6 >> (t8 & 63); + if (arg4 & 1) + goto g8726; + +g8731: + /* Merge cdr-code */ + arg3 = t7 & 63; + t8 = t8 & 192; + t8 = t8 | arg3; + arg4 = t2 + ivory; + arg3 = (arg4 * 4); + arg6 = LDQ_U(arg4); + arg5 = (t8 & 0xff) << ((arg4&7)*8); + arg6 = arg6 & ~(0xffL << (arg4&7)*8); + +g8734: + if (_trace) printf("g8734:\n"); + arg6 = arg6 | arg5; + STQ_U(arg4, arg6); + arg4 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + arg5 = t2 - t11; + /* In range? */ + arg4 = ((u64)arg5 < (u64)arg4) ? 1 : 0; + *(u32 *)arg3 = t6; + /* J. if in cache */ + if (arg4 != 0) + goto g8733; + +g8732: + /* Get the old cleanup-bindings bit */ + t3 = t3 & 64; + t3 = t3 << 19; + t1 = t1 - 2; + /* vma only */ + *(u32 *)&processor->bindingstackpointer = t1; + t4 = t4 | t3; + *(u32 *)&processor->control = t4; + +restorebsendloop: + if (_trace) printf("restorebsendloop:\n"); + arg4 = (s32)t1 - (s32)arg1; + if ((s64)arg4 > 0) + goto restorebstoploop; + t3 = *(s32 *)&processor->interruptreg; + t4 = t3 & 2; + t4 = (t4 == 2) ? 1 : 0; + t3 = t3 | t4; + *(u32 *)&processor->interruptreg = t3; + if (t3 == 0) + goto NEXTINSTRUCTION; + *(u64 *)&processor->stop_interpreter = t3; + goto NEXTINSTRUCTION; + +restorebsiop: + if (_trace) printf("restorebsiop:\n"); + arg5 = 0; + arg2 = 66; + goto illegaloperand; +#ifdef MINIMA + +restorebsdeep: + if (_trace) printf("restorebsdeep:\n"); + /* Get the SP, ->op2 */ + t1 = *(u64 *)&(processor->restartsp); + /* Convert stack cache address to VMA */ + t3 = *(u64 *)&(processor->stackcachedata); + t2 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t3 = t1 - t3; + /* convert byte address to word address */ + t3 = t3 >> 3; + /* reconstruct VMA */ + t2 = t3 + t2; + arg5 = t2; + arg2 = 66; + goto illegaloperand; +#endif + +g8733: + if (_trace) printf("g8733:\n"); + arg4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + arg4 = (arg5 * 8) + arg4; + /* Store in stack */ + *(u32 *)arg4 = t6; + /* write the stack cache */ + *(u32 *)(arg4 + 4) = t8; + goto g8732; + +g8724: + if (_trace) printf("g8724:\n"); + arg5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + arg4 = (arg4 * 8) + arg5; + arg3 = *(s32 *)arg4; + /* Read from stack cache */ + t8 = *(s32 *)(arg4 + 4); + goto g8723; + +g8726: + if (_trace) printf("g8726:\n"); + if ((arg6 & 1) == 0) + goto g8725; + /* Do the indirect thing */ + t2 = (u32)arg3; + goto g8722; + +g8725: + if (_trace) printf("g8725:\n"); + /* Load the memory action table for cycle */ + arg4 = *(u64 *)&(processor->bindwrite); + /* TagType. */ + /* Discard the CDR code */ + arg6 = t8 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + arg6 = (arg6 * 4) + arg4; + /* Get the memory action */ + arg4 = *(s32 *)arg6; + +g8728: + /* Perform memory action */ + arg1 = arg4; + arg2 = 3; + goto performmemoryaction; + +g8714: + if (_trace) printf("g8714:\n"); + arg3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + arg3; + t2 = *(s32 *)t8; + /* Read from stack cache */ + t3 = *(s32 *)(t8 + 4); + goto g8713; + +g8716: + if (_trace) printf("g8716:\n"); + if ((arg4 & 1) == 0) + goto g8715; + /* Do the indirect thing */ + t5 = (u32)t2; + goto g8712; + +g8715: + if (_trace) printf("g8715:\n"); + /* Load the memory action table for cycle */ + arg5 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + arg4 = t3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + arg4 = (arg4 * 4) + arg5; + /* Get the memory action */ + arg5 = *(s32 *)arg4; + +g8718: + /* Perform memory action */ + arg1 = arg5; + arg2 = 2; + goto performmemoryaction; + +g8704: + if (_trace) printf("g8704:\n"); + arg3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + arg3; + t6 = *(s32 *)t8; + /* Read from stack cache */ + t7 = *(s32 *)(t8 + 4); + goto g8703; + +g8706: + if (_trace) printf("g8706:\n"); + if ((arg4 & 1) == 0) + goto g8705; + /* Do the indirect thing */ + t1 = (u32)t6; + goto g8702; + +g8705: + if (_trace) printf("g8705:\n"); + /* Load the memory action table for cycle */ + arg5 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + arg4 = t7 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + arg4 = (arg4 * 4) + arg5; + /* Get the memory action */ + arg5 = *(s32 *)arg4; + +g8708: + /* Perform memory action */ + arg1 = arg5; + arg2 = 2; + goto performmemoryaction; + +/* end DoRestoreBindingStack */ + /* End of Halfword operand from stack instruction - DoRestoreBindingStack */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunbind.as */ diff --git a/stub/ifunbits.c b/stub/ifunbits.c new file mode 100644 index 0000000..4f430e1 --- /dev/null +++ b/stub/ifunbits.c @@ -0,0 +1,1068 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunbits.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Bits. */ +/* start DoLogand */ + + /* Halfword operand from stack instruction - DoLogand */ + /* arg2 has the preloaded 8 bit operand. */ + +dologand: + if (_trace) printf("dologand:\n"); +#ifdef TRACING +#endif + +DoLogandSP: + if (_trace) printf("DoLogandSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdologand; +#endif + +DoLogandLP: + if (_trace) printf("DoLogandLP:\n"); +#ifdef TRACING + goto headdologand; +#endif + +DoLogandFP: + if (_trace) printf("DoLogandFP:\n"); + +headdologand: + if (_trace) printf("headdologand:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindologand: + if (_trace) printf("begindologand:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get tag from ARG1 */ + t3 = *(s32 *)(iSP + 4); + /* Grab data for ARG1 */ + t4 = *(s32 *)iSP; + /* Get tag from ARG2 */ + t1 = (u8)(arg1 >> ((4&7)*8)); + t6 = t3 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8316; + t6 = t1 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8317; + /* Here we know that both args are fixnums! */ + /* Do the operation */ + t4 = t4 & arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + r31 = r31 | r31; + /* Strip high bits */ + t4 = (u32)t4; + t1 = Type_Fixnum; + /* Push result */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +g8316: + if (_trace) printf("g8316:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8317: + if (_trace) printf("g8317:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; +#ifdef TRACING + goto DoLogandIM; +#endif + +DoLogandIM: + if (_trace) printf("DoLogandIM:\n"); + /* Get tag from ARG1 */ + t3 = *(s32 *)(iSP + 4); + arg2 = arg2 << 56; + /* Grab data for ARG1 */ + t4 = *(s32 *)iSP; + arg2 = (s64)arg2 >> 56; + t6 = t3 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8318; + /* Here we know that both args are fixnums! */ + /* Do the operation */ + t4 = t4 & arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + r31 = r31 | r31; + /* Strip high bits */ + t4 = (u32)t4; + t1 = Type_Fixnum; + /* Push result */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +g8318: + if (_trace) printf("g8318:\n"); + arg1 = Type_Fixnum; + arg2 = (u32)arg2; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = t3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +/* end DoLogand */ + /* End of Halfword operand from stack instruction - DoLogand */ +/* start DoLogior */ + + /* Halfword operand from stack instruction - DoLogior */ + /* arg2 has the preloaded 8 bit operand. */ + +dologior: + if (_trace) printf("dologior:\n"); +#ifdef TRACING +#endif + +DoLogiorSP: + if (_trace) printf("DoLogiorSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdologior; +#endif + +DoLogiorLP: + if (_trace) printf("DoLogiorLP:\n"); +#ifdef TRACING + goto headdologior; +#endif + +DoLogiorFP: + if (_trace) printf("DoLogiorFP:\n"); + +headdologior: + if (_trace) printf("headdologior:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindologior: + if (_trace) printf("begindologior:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get tag from ARG1 */ + t3 = *(s32 *)(iSP + 4); + /* Grab data for ARG1 */ + t4 = *(s32 *)iSP; + /* Get tag from ARG2 */ + t1 = (u8)(arg1 >> ((4&7)*8)); + t6 = t3 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8319; + t6 = t1 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8320; + /* Here we know that both args are fixnums! */ + /* Do the operation */ + t4 = t4 | arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + r31 = r31 | r31; + /* Strip high bits */ + t4 = (u32)t4; + t1 = Type_Fixnum; + /* Push result */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +g8319: + if (_trace) printf("g8319:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8320: + if (_trace) printf("g8320:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; +#ifdef TRACING + goto DoLogiorIM; +#endif + +DoLogiorIM: + if (_trace) printf("DoLogiorIM:\n"); + /* Get tag from ARG1 */ + t3 = *(s32 *)(iSP + 4); + arg2 = arg2 << 56; + /* Grab data for ARG1 */ + t4 = *(s32 *)iSP; + arg2 = (s64)arg2 >> 56; + t6 = t3 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8321; + /* Here we know that both args are fixnums! */ + /* Do the operation */ + t4 = t4 | arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + r31 = r31 | r31; + /* Strip high bits */ + t4 = (u32)t4; + t1 = Type_Fixnum; + /* Push result */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +g8321: + if (_trace) printf("g8321:\n"); + arg1 = Type_Fixnum; + arg2 = (u32)arg2; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = t3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +/* end DoLogior */ + /* End of Halfword operand from stack instruction - DoLogior */ +/* start DoLogxor */ + + /* Halfword operand from stack instruction - DoLogxor */ + /* arg2 has the preloaded 8 bit operand. */ + +dologxor: + if (_trace) printf("dologxor:\n"); +#ifdef TRACING +#endif + +DoLogxorSP: + if (_trace) printf("DoLogxorSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdologxor; +#endif + +DoLogxorLP: + if (_trace) printf("DoLogxorLP:\n"); +#ifdef TRACING + goto headdologxor; +#endif + +DoLogxorFP: + if (_trace) printf("DoLogxorFP:\n"); + +headdologxor: + if (_trace) printf("headdologxor:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindologxor: + if (_trace) printf("begindologxor:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get tag from ARG1 */ + t3 = *(s32 *)(iSP + 4); + /* Grab data for ARG1 */ + t4 = *(s32 *)iSP; + /* Get tag from ARG2 */ + t1 = (u8)(arg1 >> ((4&7)*8)); + t6 = t3 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8322; + t6 = t1 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8323; + /* Here we know that both args are fixnums! */ + /* Do the operation */ + t4 = t4 ^ arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + r31 = r31 | r31; + /* Strip high bits */ + t4 = (u32)t4; + t1 = Type_Fixnum; + /* Push result */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +g8322: + if (_trace) printf("g8322:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8323: + if (_trace) printf("g8323:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; +#ifdef TRACING + goto DoLogxorIM; +#endif + +DoLogxorIM: + if (_trace) printf("DoLogxorIM:\n"); + /* Get tag from ARG1 */ + t3 = *(s32 *)(iSP + 4); + arg2 = arg2 << 56; + /* Grab data for ARG1 */ + t4 = *(s32 *)iSP; + arg2 = (s64)arg2 >> 56; + t6 = t3 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto g8324; + /* Here we know that both args are fixnums! */ + /* Do the operation */ + t4 = t4 ^ arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + r31 = r31 | r31; + /* Strip high bits */ + t4 = (u32)t4; + t1 = Type_Fixnum; + /* Push result */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +g8324: + if (_trace) printf("g8324:\n"); + arg1 = Type_Fixnum; + arg2 = (u32)arg2; + /* SetTag. */ + t1 = arg1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = t3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +/* end DoLogxor */ + /* End of Halfword operand from stack instruction - DoLogxor */ +/* start DoAsh */ + + /* Halfword operand from stack instruction - DoAsh */ + +doash: + if (_trace) printf("doash:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoAshIM: + if (_trace) printf("DoAshIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8338: + if (_trace) printf("g8338:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoash; +#ifdef TRACING +#endif + +DoAshSP: + if (_trace) printf("DoAshSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoash; +#endif + +DoAshLP: + if (_trace) printf("DoAshLP:\n"); +#ifdef TRACING + goto headdoash; +#endif + +DoAshFP: + if (_trace) printf("DoAshFP:\n"); + +headdoash: + if (_trace) printf("headdoash:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoash: + if (_trace) printf("begindoash:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* Get ARG1. */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + /* Get ARG2's tag. */ + arg2 = arg1 >> 32; + /* Sign extended the rotation amount. */ + arg1 = (s32)arg1; + /* Strip off any CDR code bits. */ + t1 = arg2 & 63; + /* Strip off any CDR code bits. */ + t3 = arg3 & 63; + t2 = (t1 == Type_Fixnum) ? 1 : 0; + +g8337: + if (_trace) printf("g8337:\n"); + if (t2 == 0) + goto g8330; + /* Here if argument TypeFixnum */ + t4 = (t3 == Type_Fixnum) ? 1 : 0; + +g8334: + if (_trace) printf("g8334:\n"); + if (t4 == 0) + goto g8327; + /* Here if argument TypeFixnum */ + /* B. if ash of zero -- trivial case */ + if (arg4 == 0) + goto zerash; + /* B. if negative ash. */ + if ((s64)arg1 <= 0) + goto negash; + /* Sign extend ARG1 before shifting. */ + arg4 = (s32)arg4; + arg5 = arg1 - 32; + if ((s64)arg5 > 0) + goto ashovexc; + /* Shift Left */ + arg5 = arg4 << (arg1 & 63); + arg6 = arg4 ^ arg5; + /* arg6<0>=1 if overflow, 0 otherwise */ + arg6 = arg6 >> 31; + /* TagType. */ + arg2 = arg2 & 63; + /* J. if overflow */ + if (arg6 != 0) + goto ashovexc; + *(u32 *)iSP = arg5; + /* write the stack cache */ + *(u32 *)(iSP + 4) = arg2; + goto NEXTINSTRUCTION; + +negash: + if (_trace) printf("negash:\n"); + arg1 = zero - arg1; + /* Sign extend ARG1 before shifting. */ + arg4 = (s32)arg4; + /* Shift Right */ + arg5 = (s64)arg4 >> (arg1 & 63); + /* TagType. */ + arg2 = arg2 & 63; + *(u32 *)iSP = arg5; + /* write the stack cache */ + *(u32 *)(iSP + 4) = arg2; + goto NEXTINSTRUCTION; + +zerash: + if (_trace) printf("zerash:\n"); + arg5 = Type_Fixnum; + *(u32 *)iSP = arg4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = arg5; + goto NEXTINSTRUCTION; + +g8331: + if (_trace) printf("g8331:\n"); + +g8330: + if (_trace) printf("g8330:\n"); + /* Here for all other cases */ + +g8326: + if (_trace) printf("g8326:\n"); + arg1 = (u32)arg1; + /* SetTag. */ + t2 = arg2 << 32; + t2 = arg1 | t2; + /* arg6 = tag to dispatch on */ + arg6 = arg2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g8328; + +g8327: + if (_trace) printf("g8327:\n"); + arg1 = (u32)arg1; + /* SetTag. */ + t2 = arg2 << 32; + t2 = arg1 | t2; + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8328: + if (_trace) printf("g8328:\n"); + +g8329: + if (_trace) printf("g8329:\n"); + +ashovexc: + if (_trace) printf("ashovexc:\n"); + arg1 = (u32)arg1; + /* SetTag. */ + t1 = arg2 << 32; + t1 = arg1 | t1; + /* arg6 = tag to dispatch on */ + arg6 = arg2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto exception; + +/* end DoAsh */ + /* End of Halfword operand from stack instruction - DoAsh */ +/* start DoRot */ + + /* Halfword operand from stack instruction - DoRot */ + /* arg2 has the preloaded 8 bit operand. */ + +dorot: + if (_trace) printf("dorot:\n"); +#ifdef TRACING +#endif + +DoRotSP: + if (_trace) printf("DoRotSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindorot; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindorot; +#endif + +DoRotLP: + if (_trace) printf("DoRotLP:\n"); +#ifdef TRACING + goto begindorot; +#endif + +DoRotFP: + if (_trace) printf("DoRotFP:\n"); + +begindorot: + if (_trace) printf("begindorot:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + +g8340: + if (_trace) printf("g8340:\n"); + /* Arg1 on the stack */ + t4 = (u32)(arg6 >> ((4&7)*8)); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Arg1 on the stack */ + t1 = (u32)arg6; + /* Arg2 from operand */ + t5 = *(s32 *)(arg1 + 4); + /* Strip CDR code if any. */ + t4 = t4 & 63; + /* Arg2 from operand */ + t2 = *(s32 *)arg1; + t4 = t4 - Type_Fixnum; + t8 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Strip CDR code if any. */ + t5 = t5 & 63; + if (t4 != 0) + goto g8339; + t2 = (u32)t2; + t5 = t5 - Type_Fixnum; + +g8341: + if (_trace) printf("g8341:\n"); + if (t5 != 0) + goto g8339; + /* Get low 5 bits of the rotation */ + t2 = t2 & 31; + /* Shift left to get new high bits */ + t3 = t1 << (t2 & 63); + /* Get new low bits */ + t6 = (u32)(t3 >> ((4&7)*8)); + /* Glue two parts of shifted operand together */ + t3 = t3 | t6; + +g8342: + if (_trace) printf("g8342:\n"); + iPC = t7; + /* Put the result back on the stack */ + *(u32 *)iSP = t3; + iCP = t8; + goto cachevalid; +#ifdef TRACING + goto DoRotIM; +#endif + +DoRotIM: + if (_trace) printf("DoRotIM:\n"); + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + goto g8340; + +g8339: + if (_trace) printf("g8339:\n"); + arg5 = 0; + arg2 = 80; + goto illegaloperand; + +/* end DoRot */ + /* End of Halfword operand from stack instruction - DoRot */ +/* start DoLsh */ + + /* Halfword operand from stack instruction - DoLsh */ + /* arg2 has the preloaded 8 bit operand. */ + +dolsh: + if (_trace) printf("dolsh:\n"); +#ifdef TRACING +#endif + +DoLshSP: + if (_trace) printf("DoLshSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindolsh; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindolsh; +#endif + +DoLshLP: + if (_trace) printf("DoLshLP:\n"); +#ifdef TRACING + goto begindolsh; +#endif + +DoLshFP: + if (_trace) printf("DoLshFP:\n"); + +begindolsh: + if (_trace) printf("begindolsh:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + +g8344: + if (_trace) printf("g8344:\n"); + /* Arg1 on the stack */ + t4 = (u32)(arg6 >> ((4&7)*8)); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Arg1 on the stack */ + t1 = (u32)arg6; + /* Arg2 from operand */ + t5 = *(s32 *)(arg1 + 4); + /* Strip CDR code if any. */ + t4 = t4 & 63; + /* Arg2 from operand */ + t2 = *(s32 *)arg1; + t4 = t4 - Type_Fixnum; + t8 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Strip CDR code if any. */ + t5 = t5 & 63; + if (t4 != 0) + goto g8343; + t5 = t5 - Type_Fixnum; + +g8345: + if (_trace) printf("g8345:\n"); + if (t5 != 0) + goto g8343; + /* B. if negative lsh. */ + if ((s64)t2 < 0) + goto neglsh; + t3 = t2 - 32; + if ((s64)t3 >= 0) + goto returnzero; + /* Shift Left */ + t3 = t1 << (t2 & 63); + goto lshdone; + +neglsh: + if (_trace) printf("neglsh:\n"); + t2 = zero - t2; + t3 = t2 - 32; + if ((s64)t3 >= 0) + goto returnzero; + /* Shift Right */ + t3 = t1 >> (t2 & 63); + goto lshdone; + +returnzero: + if (_trace) printf("returnzero:\n"); + t3 = t3 & ~t3; + +lshdone: + if (_trace) printf("lshdone:\n"); + +g8346: + if (_trace) printf("g8346:\n"); + iPC = t7; + /* Put the result back on the stack */ + *(u32 *)iSP = t3; + iCP = t8; + goto cachevalid; +#ifdef TRACING + goto DoLshIM; +#endif + +DoLshIM: + if (_trace) printf("DoLshIM:\n"); + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8347: + if (_trace) printf("g8347:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + goto g8344; + +g8343: + if (_trace) printf("g8343:\n"); + arg5 = 0; + arg2 = 80; + goto illegaloperand; + +/* end DoLsh */ + /* End of Halfword operand from stack instruction - DoLsh */ +/* start Do32BitPlus */ + + /* Halfword operand from stack instruction - Do32BitPlus */ + /* arg2 has the preloaded 8 bit operand. */ + +do32bitplus: + if (_trace) printf("do32bitplus:\n"); +#ifdef TRACING +#endif + +Do32BitPlusSP: + if (_trace) printf("Do32BitPlusSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindo32bitplus; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindo32bitplus; +#endif + +Do32BitPlusLP: + if (_trace) printf("Do32BitPlusLP:\n"); +#ifdef TRACING + goto begindo32bitplus; +#endif + +Do32BitPlusFP: + if (_trace) printf("Do32BitPlusFP:\n"); + +begindo32bitplus: + if (_trace) printf("begindo32bitplus:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + +g8349: + if (_trace) printf("g8349:\n"); + /* Arg1 on the stack */ + t4 = (u32)(arg6 >> ((4&7)*8)); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Arg1 on the stack */ + t1 = (u32)arg6; + /* Arg2 from operand */ + t5 = *(s32 *)(arg1 + 4); + /* Strip CDR code if any. */ + t4 = t4 & 63; + /* Arg2 from operand */ + t2 = *(s32 *)arg1; + t4 = t4 - Type_Fixnum; + t8 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Strip CDR code if any. */ + t5 = t5 & 63; + if (t4 != 0) + goto g8348; + t2 = (u32)t2; + t5 = t5 - Type_Fixnum; + +g8350: + if (_trace) printf("g8350:\n"); + if (t5 != 0) + goto g8348; + /* Perform the 32 bit Add. */ + t3 = t1 + t2; + +g8351: + if (_trace) printf("g8351:\n"); + iPC = t7; + /* Put the result back on the stack */ + *(u32 *)iSP = t3; + iCP = t8; + goto cachevalid; +#ifdef TRACING + goto Do32BitPlusIM; +#endif + +Do32BitPlusIM: + if (_trace) printf("Do32BitPlusIM:\n"); + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + goto g8349; + +g8348: + if (_trace) printf("g8348:\n"); + arg5 = 0; + arg2 = 80; + goto illegaloperand; + +/* end Do32BitPlus */ + /* End of Halfword operand from stack instruction - Do32BitPlus */ +/* start Do32BitDifference */ + + /* Halfword operand from stack instruction - Do32BitDifference */ + /* arg2 has the preloaded 8 bit operand. */ + +do32bitdifference: + if (_trace) printf("do32bitdifference:\n"); +#ifdef TRACING +#endif + +Do32BitDifferenceSP: + if (_trace) printf("Do32BitDifferenceSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindo32bitdifference; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindo32bitdifference; +#endif + +Do32BitDifferenceLP: + if (_trace) printf("Do32BitDifferenceLP:\n"); +#ifdef TRACING + goto begindo32bitdifference; +#endif + +Do32BitDifferenceFP: + if (_trace) printf("Do32BitDifferenceFP:\n"); + +begindo32bitdifference: + if (_trace) printf("begindo32bitdifference:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + +g8353: + if (_trace) printf("g8353:\n"); + /* Arg1 on the stack */ + t4 = (u32)(arg6 >> ((4&7)*8)); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Arg1 on the stack */ + t1 = (u32)arg6; + /* Arg2 from operand */ + t5 = *(s32 *)(arg1 + 4); + /* Strip CDR code if any. */ + t4 = t4 & 63; + /* Arg2 from operand */ + t2 = *(s32 *)arg1; + t4 = t4 - Type_Fixnum; + t8 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Strip CDR code if any. */ + t5 = t5 & 63; + if (t4 != 0) + goto g8352; + t2 = (u32)t2; + t5 = t5 - Type_Fixnum; + +g8354: + if (_trace) printf("g8354:\n"); + if (t5 != 0) + goto g8352; + /* Perform the 32 bit Difference. */ + t3 = t1 - t2; + +g8355: + if (_trace) printf("g8355:\n"); + iPC = t7; + /* Put the result back on the stack */ + *(u32 *)iSP = t3; + iCP = t8; + goto cachevalid; +#ifdef TRACING + goto Do32BitDifferenceIM; +#endif + +Do32BitDifferenceIM: + if (_trace) printf("Do32BitDifferenceIM:\n"); + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + goto g8353; + +g8352: + if (_trace) printf("g8352:\n"); + arg5 = 0; + arg2 = 80; + goto illegaloperand; + +/* end Do32BitDifference */ + /* End of Halfword operand from stack instruction - Do32BitDifference */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunbits.as */ diff --git a/stub/ifunblok.c b/stub/ifunblok.c new file mode 100644 index 0000000..e5eef64 --- /dev/null +++ b/stub/ifunblok.c @@ -0,0 +1,2377 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunblok.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Block Instructions. */ +/* start DoBlock0Read */ + + /* Halfword 10 bit immediate instruction - DoBlock0Read */ + +doblock0read: + if (_trace) printf("doblock0read:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock0ReadIM: + if (_trace) printf("DoBlock0ReadIM:\n"); + +DoBlock0ReadSP: + if (_trace) printf("DoBlock0ReadSP:\n"); + +DoBlock0ReadLP: + if (_trace) printf("DoBlock0ReadLP:\n"); + +DoBlock0ReadFP: + if (_trace) printf("DoBlock0ReadFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar0; + goto blockread; + +/* end DoBlock0Read */ + /* End of Halfword operand from stack instruction - DoBlock0Read */ +/* start DoBlock0Write */ + + /* Halfword operand from stack instruction - DoBlock0Write */ + +doblock0write: + if (_trace) printf("doblock0write:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoBlock0WriteIM: + if (_trace) printf("DoBlock0WriteIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8356: + if (_trace) printf("g8356:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoblock0write; +#ifdef TRACING +#endif + +DoBlock0WriteSP: + if (_trace) printf("DoBlock0WriteSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoblock0write; +#endif + +DoBlock0WriteLP: + if (_trace) printf("DoBlock0WriteLP:\n"); +#ifdef TRACING + goto headdoblock0write; +#endif + +DoBlock0WriteFP: + if (_trace) printf("DoBlock0WriteFP:\n"); + +headdoblock0write: + if (_trace) printf("headdoblock0write:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoblock0write: + if (_trace) printf("begindoblock0write:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg3 = *(s32 *)&processor->bar0; + arg2 = (u64)&processor->bar0; + goto blockwrite; + +/* end DoBlock0Write */ + /* End of Halfword operand from stack instruction - DoBlock0Write */ +/* start DoBlock0ReadShift */ + + /* Halfword 10 bit immediate instruction - DoBlock0ReadShift */ + +doblock0readshift: + if (_trace) printf("doblock0readshift:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock0ReadShiftIM: + if (_trace) printf("DoBlock0ReadShiftIM:\n"); + +DoBlock0ReadShiftSP: + if (_trace) printf("DoBlock0ReadShiftSP:\n"); + +DoBlock0ReadShiftLP: + if (_trace) printf("DoBlock0ReadShiftLP:\n"); + +DoBlock0ReadShiftFP: + if (_trace) printf("DoBlock0ReadShiftFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar0; + goto blockreadshift; + +/* end DoBlock0ReadShift */ + /* End of Halfword operand from stack instruction - DoBlock0ReadShift */ +/* start DoBlock3ReadShift */ + + /* Halfword 10 bit immediate instruction - DoBlock3ReadShift */ + +doblock3readshift: + if (_trace) printf("doblock3readshift:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock3ReadShiftIM: + if (_trace) printf("DoBlock3ReadShiftIM:\n"); + +DoBlock3ReadShiftSP: + if (_trace) printf("DoBlock3ReadShiftSP:\n"); + +DoBlock3ReadShiftLP: + if (_trace) printf("DoBlock3ReadShiftLP:\n"); + +DoBlock3ReadShiftFP: + if (_trace) printf("DoBlock3ReadShiftFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar3; + goto blockreadshift; + +/* end DoBlock3ReadShift */ + /* End of Halfword operand from stack instruction - DoBlock3ReadShift */ +/* start DoBlock2ReadShift */ + + /* Halfword 10 bit immediate instruction - DoBlock2ReadShift */ + +doblock2readshift: + if (_trace) printf("doblock2readshift:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock2ReadShiftIM: + if (_trace) printf("DoBlock2ReadShiftIM:\n"); + +DoBlock2ReadShiftSP: + if (_trace) printf("DoBlock2ReadShiftSP:\n"); + +DoBlock2ReadShiftLP: + if (_trace) printf("DoBlock2ReadShiftLP:\n"); + +DoBlock2ReadShiftFP: + if (_trace) printf("DoBlock2ReadShiftFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar2; + goto blockreadshift; + +/* end DoBlock2ReadShift */ + /* End of Halfword operand from stack instruction - DoBlock2ReadShift */ +/* start DoBlock1ReadShift */ + + /* Halfword 10 bit immediate instruction - DoBlock1ReadShift */ + +doblock1readshift: + if (_trace) printf("doblock1readshift:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock1ReadShiftIM: + if (_trace) printf("DoBlock1ReadShiftIM:\n"); + +DoBlock1ReadShiftSP: + if (_trace) printf("DoBlock1ReadShiftSP:\n"); + +DoBlock1ReadShiftLP: + if (_trace) printf("DoBlock1ReadShiftLP:\n"); + +DoBlock1ReadShiftFP: + if (_trace) printf("DoBlock1ReadShiftFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar1; + +blockreadshift: + if (_trace) printf("blockreadshift:\n"); + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Get the vma */ + t2 = *(s32 *)arg2; + /* cycle type */ + t1 = arg1 >> 6; + /* =no-incrementp */ + t4 = arg1 & 4; + /* =cdr-code-nextp */ + t5 = arg1 & 16; + /* =fixnum onlyp */ + t6 = arg1 & 32; + t2 = (u32)t2; + /* Memory Read Internal */ + +g8361: + t11 = t2 + ivory; + /* Cycle-number -> table offset */ + t12 = (t1 * 4); + t8 = LDQ_U(t11); + t12 = (t12 * 4) + ivory; + t7 = (t11 * 4); + /* Stack cache offset */ + t9 = t2 - arg5; + t12 = *(u64 *)(t12 + PROCESSORSTATE_DATAREAD_MASK); + /* In range? */ + t10 = ((u64)t9 < (u64)arg6) ? 1 : 0; + t7 = *(s32 *)t7; + t8 = (u8)(t8 >> ((t11&7)*8)); + if (t10 != 0) + goto g8363; + +g8362: + t12 = t12 >> (t8 & 63); + t7 = (u32)t7; + if (t12 & 1) + goto g8365; + +g8372: + /* J. if we don't have to test for fixnump. */ + if (t6 == 0) + goto g8357; + t9 = t8 - Type_Fixnum; + /* Strip CDR code */ + t9 = t9 & 63; + if (t9 != 0) + goto g8360; + +g8357: + if (_trace) printf("g8357:\n"); + /* J. if we don't have to increment the address. */ + if (t4 != 0) + goto g8358; + /* Increment the address */ + t2 = t2 + 1; + +g8358: + if (_trace) printf("g8358:\n"); + /* Store updated vma in BAR */ + *(u32 *)arg2 = t2; + /* J. if we don't have to clear CDR codes. */ + if (t5 == 0) + goto g8359; + t8 = t8 & 63; + +g8359: + if (_trace) printf("g8359:\n"); + t1 = zero + 21504; + /* Get rotate */ + t3 = *(u64 *)&(processor->byterotate); + /* Get bytesize */ + t4 = *(u64 *)&(processor->bytesize); + /* Get background */ + t2 = t1 >> 10; + /* Extract the byte background */ + t2 = t2 & 3; + t5 = (t2 == ALUByteBackground_Op1) ? 1 : 0; + +g8379: + if (_trace) printf("g8379:\n"); + if (t5 == 0) + goto g8375; + /* Here if argument ALUByteBackgroundOp1 */ + t2 = t1; + +g8374: + if (_trace) printf("g8374:\n"); + t6 = t1 >> 12; + /* Extractthe byte rotate latch */ + t6 = t6 & 1; + t7 = t7 << (t3 & 63); + t5 = (u32)(t7 >> ((4&7)*8)); + t7 = (u32)t7; + /* OP2 rotated */ + t7 = t7 | t5; + /* Don't update rotate latch if not requested */ + if (t6 == 0) + goto g8373; + *(u64 *)&processor->rotatelatch = t7; + +g8373: + if (_trace) printf("g8373:\n"); + t6 = zero + -2; + t6 = t6 << (t4 & 63); + /* Compute mask */ + t6 = ~t6; + /* Get byte function */ + t5 = t1 >> 13; + t5 = t5 & 1; + t4 = (t5 == ALUByteFunction_Dpb) ? 1 : 0; + +g8384: + if (_trace) printf("g8384:\n"); + if (t4 == 0) + goto g8381; + /* Here if argument ALUByteFunctionDpb */ + /* Position mask */ + t6 = t6 << (t3 & 63); + +g8380: + if (_trace) printf("g8380:\n"); + /* rotated&mask */ + t7 = t7 & t6; + /* background&~mask */ + t2 = t2 & ~t6; + t7 = t7 | t2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u32 *)(iSP + 8) = t7; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto cachevalid; + +g8360: + if (_trace) printf("g8360:\n"); + arg5 = t2; + arg2 = 23; + goto illegaloperand; + +g8381: + if (_trace) printf("g8381:\n"); + t4 = (t5 == ALUByteFunction_Ldb) ? 1 : 0; + +g8385: + if (_trace) printf("g8385:\n"); + if (t4 != 0) + goto g8380; + goto g8380; + +g8375: + if (_trace) printf("g8375:\n"); + t5 = (t2 == ALUByteBackground_RotateLatch) ? 1 : 0; + +g8386: + if (_trace) printf("g8386:\n"); + if (t5 == 0) + goto g8376; + /* Here if argument ALUByteBackgroundRotateLatch */ + t2 = *(u64 *)&(processor->rotatelatch); + goto g8374; + +g8376: + if (_trace) printf("g8376:\n"); + t5 = (t2 == ALUByteBackground_Zero) ? 1 : 0; + +g8387: + if (_trace) printf("g8387:\n"); + if (t5 == 0) + goto g8374; + /* Here if argument ALUByteBackgroundZero */ + t2 = zero; + goto g8374; + +g8363: + if (_trace) printf("g8363:\n"); + t10 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t9 = (t9 * 8) + t10; + t7 = *(s32 *)t9; + /* Read from stack cache */ + t8 = *(s32 *)(t9 + 4); + goto g8362; + +g8365: + if (_trace) printf("g8365:\n"); + +g8364: + if (_trace) printf("g8364:\n"); + /* Cycle-number -> table offset */ + t12 = (t1 * 4); + t12 = (t12 * 4) + ivory; + t12 = *(u64 *)(t12 + PROCESSORSTATE_DATAREAD); + /* TagType. */ + /* Discard the CDR code */ + t11 = t8 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + t11 = (t11 * 4) + t12; + /* Get the memory action */ + t12 = *(s32 *)t11; + +g8370: + if (_trace) printf("g8370:\n"); + t10 = t12 & MemoryActionIndirect; + if (t10 == 0) + goto g8369; + /* Do the indirect thing */ + t2 = (u32)t7; + goto g8361; + +g8369: + if (_trace) printf("g8369:\n"); + t11 = t12 & MemoryActionTransform; + if (t11 == 0) + goto g8368; + t8 = t8 & ~63L; + t8 = t8 | Type_ExternalValueCellPointer; + goto g8372; +#ifndef MINIMA + +g8368: +#endif +#ifdef MINIMA + +g8368: + if (_trace) printf("g8368:\n"); + t11 = t12 & MemoryActionBinding; + t10 = *(u64 *)&(processor->dbcmask); + if (t11 == 0) + goto g8367; + t9 = t2 << 1; + t11 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t9 = t9 & t10; + t10 = 1; + t10 = t10 << (ivorymemorydata & 63); + t9 = (s32)t9 + (s32)t11; + /* Clear sign-extension */ + t9 = (u32)t9; + t10 = (t9 * 4) + t10; + /* Fetch the key */ + t9 = *(s32 *)t10; + /* Fetch value */ + t7 = *(s32 *)(t10 + 4); + /* Compare */ + t11 = (s32)t2 - (s32)t9; + /* Trap on miss */ + if (t11 != 0) + goto g8371; + /* Extract the pointer, and indirect */ + t2 = (u32)t7; + goto g8361; + +g8371: + if (_trace) printf("g8371:\n"); + goto dbcachemisstrap; +#endif + +g8367: + /* Perform memory action */ + arg1 = t12; + arg2 = t1; + goto performmemoryaction; + +/* end DoBlock1ReadShift */ + /* End of Halfword operand from stack instruction - DoBlock1ReadShift */ +/* start DoBlock0ReadAlu */ + + /* Halfword operand from stack instruction - DoBlock0ReadAlu */ + /* arg2 has the preloaded 8 bit operand. */ + +doblock0readalu: + if (_trace) printf("doblock0readalu:\n"); +#ifdef TRACING +#endif + +DoBlock0ReadAluSP: + if (_trace) printf("DoBlock0ReadAluSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoblock0readalu; +#endif + +DoBlock0ReadAluLP: + if (_trace) printf("DoBlock0ReadAluLP:\n"); +#ifdef TRACING + goto begindoblock0readalu; +#endif + +DoBlock0ReadAluFP: + if (_trace) printf("DoBlock0ReadAluFP:\n"); + +begindoblock0readalu: + if (_trace) printf("begindoblock0readalu:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + arg2 = (u64)&processor->bar0; + goto blockreadalu; +#ifdef TRACING +#endif + +DoBlock0ReadAluIM: + goto doistageerror; + +/* end DoBlock0ReadAlu */ + /* End of Halfword operand from stack instruction - DoBlock0ReadAlu */ +/* start DoBlock3ReadAlu */ + + /* Halfword operand from stack instruction - DoBlock3ReadAlu */ + /* arg2 has the preloaded 8 bit operand. */ + +doblock3readalu: + if (_trace) printf("doblock3readalu:\n"); +#ifdef TRACING +#endif + +DoBlock3ReadAluSP: + if (_trace) printf("DoBlock3ReadAluSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoblock3readalu; +#endif + +DoBlock3ReadAluLP: + if (_trace) printf("DoBlock3ReadAluLP:\n"); +#ifdef TRACING + goto begindoblock3readalu; +#endif + +DoBlock3ReadAluFP: + if (_trace) printf("DoBlock3ReadAluFP:\n"); + +begindoblock3readalu: + if (_trace) printf("begindoblock3readalu:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + arg2 = (u64)&processor->bar3; + goto blockreadalu; +#ifdef TRACING +#endif + +DoBlock3ReadAluIM: + goto doistageerror; + +/* end DoBlock3ReadAlu */ + /* End of Halfword operand from stack instruction - DoBlock3ReadAlu */ +/* start DoBlock2ReadAlu */ + + /* Halfword operand from stack instruction - DoBlock2ReadAlu */ + /* arg2 has the preloaded 8 bit operand. */ + +doblock2readalu: + if (_trace) printf("doblock2readalu:\n"); +#ifdef TRACING +#endif + +DoBlock2ReadAluSP: + if (_trace) printf("DoBlock2ReadAluSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoblock2readalu; +#endif + +DoBlock2ReadAluLP: + if (_trace) printf("DoBlock2ReadAluLP:\n"); +#ifdef TRACING + goto begindoblock2readalu; +#endif + +DoBlock2ReadAluFP: + if (_trace) printf("DoBlock2ReadAluFP:\n"); + +begindoblock2readalu: + if (_trace) printf("begindoblock2readalu:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + arg2 = (u64)&processor->bar2; + goto blockreadalu; +#ifdef TRACING +#endif + +DoBlock2ReadAluIM: + goto doistageerror; + +/* end DoBlock2ReadAlu */ + /* End of Halfword operand from stack instruction - DoBlock2ReadAlu */ +/* start DoBlock1ReadAlu */ + + /* Halfword operand from stack instruction - DoBlock1ReadAlu */ + /* arg2 has the preloaded 8 bit operand. */ + +doblock1readalu: + if (_trace) printf("doblock1readalu:\n"); +#ifdef TRACING +#endif + +DoBlock1ReadAluSP: + if (_trace) printf("DoBlock1ReadAluSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoblock1readalu; +#endif + +DoBlock1ReadAluLP: + if (_trace) printf("DoBlock1ReadAluLP:\n"); +#ifdef TRACING + goto begindoblock1readalu; +#endif + +DoBlock1ReadAluFP: + if (_trace) printf("DoBlock1ReadAluFP:\n"); + +begindoblock1readalu: + if (_trace) printf("begindoblock1readalu:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + arg2 = (u64)&processor->bar1; + +blockreadalu: + if (_trace) printf("blockreadalu:\n"); + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Get the vma */ + t1 = *(s32 *)arg2; + t5 = *(s32 *)arg1; + t4 = *(s32 *)(arg1 + 4); + t5 = (u32)t5; + t9 = t4 - Type_Fixnum; + /* Strip CDR code */ + t9 = t9 & 63; + if (t9 != 0) + goto g8388; + t1 = (u32)t1; + /* Memory Read Internal */ + +g8390: + t11 = t1 + ivory; + t3 = (t11 * 4); + t2 = LDQ_U(t11); + /* Stack cache offset */ + t9 = t1 - arg5; + t12 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t10 = ((u64)t9 < (u64)arg6) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t11&7)*8)); + if (t10 != 0) + goto g8392; + +g8391: + t11 = zero + 240; + t12 = t12 >> (t2 & 63); + t11 = t11 >> (t2 & 63); + t3 = (u32)t3; + if (t12 & 1) + goto g8394; + +g8401: + t9 = t2 - Type_Fixnum; + /* Strip CDR code */ + t9 = t9 & 63; + if (t9 != 0) + goto g8389; + /* Increment the address */ + t1 = t1 + 1; + /* Store updated vma in BAR */ + *(u32 *)arg2 = t1; + t6 = *(u64 *)&(processor->aluop); + *(u64 *)&processor->aluoverflow = zero; + t7 = *(u64 *)&(processor->aluandrotatecontrol); + t1 = (t6 == ALUFunction_Boolean) ? 1 : 0; + +g8462: + if (_trace) printf("g8462:\n"); + if (t1 == 0) + goto g8403; + /* Here if argument ALUFunctionBoolean */ + t8 = t7 >> 10; + /* Extract the ALU boolean function */ + t8 = t8 & 15; + t1 = (t8 == Boole_Clear) ? 1 : 0; + +g8422: + if (_trace) printf("g8422:\n"); + if (t1 != 0) + goto g8404; + +g8405: + if (_trace) printf("g8405:\n"); + t1 = (t8 == Boole_And) ? 1 : 0; + +g8423: + if (_trace) printf("g8423:\n"); + if (t1 == 0) + goto g8406; + /* Here if argument BooleAnd */ + t8 = t3 & t5; + goto g8404; + +g8406: + if (_trace) printf("g8406:\n"); + t1 = (t8 == Boole_AndC1) ? 1 : 0; + +g8424: + if (_trace) printf("g8424:\n"); + if (t1 == 0) + goto g8407; + /* Here if argument BooleAndC1 */ + t8 = t5 & ~t3; + goto g8404; + +g8407: + if (_trace) printf("g8407:\n"); + t1 = (t8 == Boole_2) ? 1 : 0; + +g8425: + if (_trace) printf("g8425:\n"); + if (t1 == 0) + goto g8408; + /* Here if argument Boole2 */ + t8 = t5; + goto g8404; + +g8408: + if (_trace) printf("g8408:\n"); + t1 = (t8 == Boole_AndC2) ? 1 : 0; + +g8426: + if (_trace) printf("g8426:\n"); + if (t1 == 0) + goto g8409; + /* Here if argument BooleAndC2 */ + t8 = t3 & ~t5; + goto g8404; + +g8409: + if (_trace) printf("g8409:\n"); + t1 = (t8 == Boole_1) ? 1 : 0; + +g8427: + if (_trace) printf("g8427:\n"); + if (t1 == 0) + goto g8410; + /* Here if argument Boole1 */ + t8 = t3; + goto g8404; + +g8410: + if (_trace) printf("g8410:\n"); + t1 = (t8 == Boole_Xor) ? 1 : 0; + +g8428: + if (_trace) printf("g8428:\n"); + if (t1 == 0) + goto g8411; + /* Here if argument BooleXor */ + t8 = t3 ^ t5; + goto g8404; + +g8411: + if (_trace) printf("g8411:\n"); + t1 = (t8 == Boole_Ior) ? 1 : 0; + +g8429: + if (_trace) printf("g8429:\n"); + if (t1 == 0) + goto g8412; + /* Here if argument BooleIor */ + t8 = t3 | t5; + goto g8404; + +g8412: + if (_trace) printf("g8412:\n"); + t1 = (t8 == Boole_Nor) ? 1 : 0; + +g8430: + if (_trace) printf("g8430:\n"); + if (t1 == 0) + goto g8413; + /* Here if argument BooleNor */ + t8 = t3 | t5; + t8 = ~t8; + goto g8404; + +g8413: + if (_trace) printf("g8413:\n"); + t1 = (t8 == Boole_Equiv) ? 1 : 0; + +g8431: + if (_trace) printf("g8431:\n"); + if (t1 == 0) + goto g8414; + /* Here if argument BooleEquiv */ + t8 = t3 ^ t5; + t8 = ~t8; + goto g8404; + +g8414: + if (_trace) printf("g8414:\n"); + t1 = (t8 == Boole_C1) ? 1 : 0; + +g8432: + if (_trace) printf("g8432:\n"); + if (t1 == 0) + goto g8415; + /* Here if argument BooleC1 */ + t8 = ~t3; + goto g8404; + +g8415: + if (_trace) printf("g8415:\n"); + t1 = (t8 == Boole_OrC1) ? 1 : 0; + +g8433: + if (_trace) printf("g8433:\n"); + if (t1 == 0) + goto g8416; + /* Here if argument BooleOrC1 */ + t8 = t5 | ~(t3); + goto g8404; + +g8416: + if (_trace) printf("g8416:\n"); + t1 = (t8 == Boole_C2) ? 1 : 0; + +g8434: + if (_trace) printf("g8434:\n"); + if (t1 == 0) + goto g8417; + /* Here if argument BooleC2 */ + t8 = ~t5; + goto g8404; + +g8417: + if (_trace) printf("g8417:\n"); + t1 = (t8 == Boole_OrC2) ? 1 : 0; + +g8435: + if (_trace) printf("g8435:\n"); + if (t1 == 0) + goto g8418; + /* Here if argument BooleOrC2 */ + t8 = t3 & ~t5; + goto g8404; + +g8418: + if (_trace) printf("g8418:\n"); + t1 = (t8 == Boole_Nand) ? 1 : 0; + +g8436: + if (_trace) printf("g8436:\n"); + if (t1 == 0) + goto g8419; + /* Here if argument BooleNand */ + t8 = t3 & t5; + goto g8404; + +g8419: + if (_trace) printf("g8419:\n"); + t1 = (t8 == Boole_Set) ? 1 : 0; + +g8437: + if (_trace) printf("g8437:\n"); + if (t1 == 0) + goto g8404; + /* Here if argument BooleSet */ + t8 = ~zero; + +g8404: + if (_trace) printf("g8404:\n"); + *(u32 *)arg1 = t8; + goto NEXTINSTRUCTION; + +g8403: + if (_trace) printf("g8403:\n"); + t1 = (t6 == ALUFunction_Byte) ? 1 : 0; + +g8463: + if (_trace) printf("g8463:\n"); + if (t1 == 0) + goto g8438; + /* Here if argument ALUFunctionByte */ + /* Get rotate */ + t9 = *(u64 *)&(processor->byterotate); + /* Get bytesize */ + t10 = *(u64 *)&(processor->bytesize); + /* Get background */ + t1 = t7 >> 10; + /* Extract the byte background */ + t1 = t1 & 3; + t11 = (t1 == ALUByteBackground_Op1) ? 1 : 0; + +g8445: + if (_trace) printf("g8445:\n"); + if (t11 == 0) + goto g8441; + /* Here if argument ALUByteBackgroundOp1 */ + t1 = t3; + +g8440: + if (_trace) printf("g8440:\n"); + t12 = t7 >> 12; + /* Extractthe byte rotate latch */ + t12 = t12 & 1; + t8 = t5 << (t9 & 63); + t11 = (u32)(t8 >> ((4&7)*8)); + t8 = (u32)t8; + /* OP2 rotated */ + t8 = t8 | t11; + /* Don't update rotate latch if not requested */ + if (t12 == 0) + goto g8439; + *(u64 *)&processor->rotatelatch = t8; + +g8439: + if (_trace) printf("g8439:\n"); + t12 = zero + -2; + t12 = t12 << (t10 & 63); + /* Compute mask */ + t12 = ~t12; + /* Get byte function */ + t11 = t7 >> 13; + t11 = t11 & 1; + t10 = (t11 == ALUByteFunction_Dpb) ? 1 : 0; + +g8450: + if (_trace) printf("g8450:\n"); + if (t10 == 0) + goto g8447; + /* Here if argument ALUByteFunctionDpb */ + /* Position mask */ + t12 = t12 << (t9 & 63); + +g8446: + if (_trace) printf("g8446:\n"); + /* rotated&mask */ + t8 = t8 & t12; + /* background&~mask */ + t1 = t1 & ~t12; + t8 = t8 | t1; + *(u32 *)arg1 = t8; + goto NEXTINSTRUCTION; + +g8438: + if (_trace) printf("g8438:\n"); + t1 = (t6 == ALUFunction_Adder) ? 1 : 0; + +g8464: + if (_trace) printf("g8464:\n"); + if (t1 == 0) + goto g8451; + /* Here if argument ALUFunctionAdder */ + t10 = t7 >> 11; + /* Extract the op2 */ + t10 = t10 & 3; + t9 = t7 >> 10; + /* Extract the adder carry in */ + t9 = t9 & 1; + t11 = (t10 == ALUAdderOp2_Op2) ? 1 : 0; + +g8459: + if (_trace) printf("g8459:\n"); + if (t11 == 0) + goto g8454; + /* Here if argument ALUAdderOp2Op2 */ + t1 = t5; + +g8453: + if (_trace) printf("g8453:\n"); + t8 = t3 + t1; + t8 = t8 + t9; + /* Sign bit */ + t10 = t8 >> 31; + /* Next bit */ + t11 = t8 >> 32; + /* Low bit is now overflow indicator */ + t10 = t10 ^ t11; + /* Get the load-carry-in bit */ + t11 = t7 >> 24; + *(u64 *)&processor->aluoverflow = t10; + if ((t11 & 1) == 0) + goto g8452; + /* Get the carry */ + t10 = (u32)(t8 >> ((4&7)*8)); + t11 = zero + 1024; + t7 = t7 & ~t11; + t11 = t10 & 1; + t11 = t11 << 10; + /* Set the adder carry in */ + t7 = t7 | t11; + *(u64 *)&processor->aluandrotatecontrol = t7; + +g8452: + if (_trace) printf("g8452:\n"); + t10 = ((s64)t3 < (s64)t1) ? 1 : 0; + *(u64 *)&processor->aluborrow = t10; + t3 = (s32)t3; + t5 = (s32)t5; + t10 = ((s64)t3 < (s64)t1) ? 1 : 0; + *(u64 *)&processor->alulessthan = t10; + *(u32 *)arg1 = t8; + goto NEXTINSTRUCTION; + +g8451: + if (_trace) printf("g8451:\n"); + t1 = (t6 == ALUFunction_MultiplyDivide) ? 1 : 0; + +g8465: + if (_trace) printf("g8465:\n"); + if (t1 == 0) + goto g8402; + /* Here if argument ALUFunctionMultiplyDivide */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + *(u32 *)arg1 = t8; + goto NEXTINSTRUCTION; + +g8402: + if (_trace) printf("g8402:\n"); + +g8388: + if (_trace) printf("g8388:\n"); + /* Convert stack cache address to VMA */ + t9 = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t9 = arg1 - t9; + /* convert byte address to word address */ + t9 = t9 >> 3; + /* reconstruct VMA */ + t1 = t9 + arg5; + arg5 = t1; + arg2 = 23; + goto illegaloperand; + +g8389: + if (_trace) printf("g8389:\n"); + arg5 = t1; + arg2 = 23; + goto illegaloperand; + +g8454: + if (_trace) printf("g8454:\n"); + t11 = (t10 == ALUAdderOp2_Zero) ? 1 : 0; + +g8466: + if (_trace) printf("g8466:\n"); + if (t11 == 0) + goto g8455; + /* Here if argument ALUAdderOp2Zero */ + t1 = zero; + goto g8453; + +g8455: + if (_trace) printf("g8455:\n"); + t11 = (t10 == ALUAdderOp2_Invert) ? 1 : 0; + +g8467: + if (_trace) printf("g8467:\n"); + if (t11 == 0) + goto g8456; + /* Here if argument ALUAdderOp2Invert */ + t1 = (s32)t5; + t1 = zero - t1; + t1 = (u32)t1; + goto g8453; + +g8456: + if (_trace) printf("g8456:\n"); + t11 = (t10 == ALUAdderOp2_MinusOne) ? 1 : 0; + +g8468: + if (_trace) printf("g8468:\n"); + if (t11 == 0) + goto g8453; + /* Here if argument ALUAdderOp2MinusOne */ + t1 = ~zero; + t1 = (u32)t1; + goto g8453; + +g8447: + if (_trace) printf("g8447:\n"); + t10 = (t11 == ALUByteFunction_Ldb) ? 1 : 0; + +g8469: + if (_trace) printf("g8469:\n"); + if (t10 != 0) + goto g8446; + goto g8446; + +g8441: + if (_trace) printf("g8441:\n"); + t11 = (t1 == ALUByteBackground_RotateLatch) ? 1 : 0; + +g8470: + if (_trace) printf("g8470:\n"); + if (t11 == 0) + goto g8442; + /* Here if argument ALUByteBackgroundRotateLatch */ + t1 = *(u64 *)&(processor->rotatelatch); + goto g8440; + +g8442: + if (_trace) printf("g8442:\n"); + t11 = (t1 == ALUByteBackground_Zero) ? 1 : 0; + +g8471: + if (_trace) printf("g8471:\n"); + if (t11 == 0) + goto g8440; + /* Here if argument ALUByteBackgroundZero */ + t1 = zero; + goto g8440; + +g8392: + if (_trace) printf("g8392:\n"); + t10 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t9 = (t9 * 8) + t10; + t3 = *(s32 *)t9; + /* Read from stack cache */ + t2 = *(s32 *)(t9 + 4); + goto g8391; + +g8394: + if (_trace) printf("g8394:\n"); + if ((t11 & 1) == 0) + goto g8393; + /* Do the indirect thing */ + t1 = (u32)t3; + goto g8390; + +g8393: + if (_trace) printf("g8393:\n"); + /* Load the memory action table for cycle */ + t12 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t11 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t11 = (t11 * 4) + t12; + /* Get the memory action */ + t12 = *(s32 *)t11; + +g8398: + if (_trace) printf("g8398:\n"); + t11 = t12 & MemoryActionTransform; + if (t11 == 0) + goto g8397; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g8401; +#ifndef MINIMA + +g8397: +#endif +#ifdef MINIMA + +g8397: + if (_trace) printf("g8397:\n"); + t11 = t12 & MemoryActionBinding; + t10 = *(u64 *)&(processor->dbcmask); + if (t11 == 0) + goto g8396; + t9 = t1 << 1; + t11 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t9 = t9 & t10; + t10 = 1; + t10 = t10 << (ivorymemorydata & 63); + t9 = (s32)t9 + (s32)t11; + /* Clear sign-extension */ + t9 = (u32)t9; + t10 = (t9 * 4) + t10; + /* Fetch the key */ + t9 = *(s32 *)t10; + /* Fetch value */ + t3 = *(s32 *)(t10 + 4); + /* Compare */ + t11 = (s32)t1 - (s32)t9; + /* Trap on miss */ + if (t11 != 0) + goto g8400; + /* Extract the pointer, and indirect */ + t1 = (u32)t3; + goto g8390; + +g8400: + if (_trace) printf("g8400:\n"); + goto dbcachemisstrap; +#endif + +g8396: + /* Perform memory action */ + arg1 = t12; + arg2 = 0; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoBlock1ReadAluIM: + goto doistageerror; + +/* end DoBlock1ReadAlu */ + /* End of Halfword operand from stack instruction - DoBlock1ReadAlu */ +/* start DoBlock0ReadTest */ + + /* Halfword 10 bit immediate instruction - DoBlock0ReadTest */ + +doblock0readtest: + if (_trace) printf("doblock0readtest:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock0ReadTestIM: + if (_trace) printf("DoBlock0ReadTestIM:\n"); + +DoBlock0ReadTestSP: + if (_trace) printf("DoBlock0ReadTestSP:\n"); + +DoBlock0ReadTestLP: + if (_trace) printf("DoBlock0ReadTestLP:\n"); + +DoBlock0ReadTestFP: + if (_trace) printf("DoBlock0ReadTestFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar0; + goto blockreadtest; + +/* end DoBlock0ReadTest */ + /* End of Halfword operand from stack instruction - DoBlock0ReadTest */ +/* start DoBlock3ReadTest */ + + /* Halfword 10 bit immediate instruction - DoBlock3ReadTest */ + +doblock3readtest: + if (_trace) printf("doblock3readtest:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock3ReadTestIM: + if (_trace) printf("DoBlock3ReadTestIM:\n"); + +DoBlock3ReadTestSP: + if (_trace) printf("DoBlock3ReadTestSP:\n"); + +DoBlock3ReadTestLP: + if (_trace) printf("DoBlock3ReadTestLP:\n"); + +DoBlock3ReadTestFP: + if (_trace) printf("DoBlock3ReadTestFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar3; + goto blockreadtest; + +/* end DoBlock3ReadTest */ + /* End of Halfword operand from stack instruction - DoBlock3ReadTest */ +/* start DoBlock2ReadTest */ + + /* Halfword 10 bit immediate instruction - DoBlock2ReadTest */ + +doblock2readtest: + if (_trace) printf("doblock2readtest:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock2ReadTestIM: + if (_trace) printf("DoBlock2ReadTestIM:\n"); + +DoBlock2ReadTestSP: + if (_trace) printf("DoBlock2ReadTestSP:\n"); + +DoBlock2ReadTestLP: + if (_trace) printf("DoBlock2ReadTestLP:\n"); + +DoBlock2ReadTestFP: + if (_trace) printf("DoBlock2ReadTestFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar2; + goto blockreadtest; + +/* end DoBlock2ReadTest */ + /* End of Halfword operand from stack instruction - DoBlock2ReadTest */ +/* start DoBlock1ReadTest */ + + /* Halfword 10 bit immediate instruction - DoBlock1ReadTest */ + +doblock1readtest: + if (_trace) printf("doblock1readtest:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock1ReadTestIM: + if (_trace) printf("DoBlock1ReadTestIM:\n"); + +DoBlock1ReadTestSP: + if (_trace) printf("DoBlock1ReadTestSP:\n"); + +DoBlock1ReadTestLP: + if (_trace) printf("DoBlock1ReadTestLP:\n"); + +DoBlock1ReadTestFP: + if (_trace) printf("DoBlock1ReadTestFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u64)&processor->bar1; + +blockreadtest: + if (_trace) printf("blockreadtest:\n"); + /* Get the vma */ + arg3 = *(s32 *)arg2; + /* cycle type */ + t1 = arg1 >> 6; + t5 = *(s32 *)iSP; + t4 = *(s32 *)(iSP + 4); + t5 = (u32)t5; + arg3 = (u32)arg3; + /* Memory Read Internal */ + +g8478: + /* Base of stack cache */ + t9 = *(u64 *)&(processor->stackcachebasevma); + t11 = arg3 + ivory; + t10 = *(s32 *)&processor->scovlimit; + /* Cycle-number -> table offset */ + t12 = (t1 * 4); + t2 = LDQ_U(t11); + t12 = (t12 * 4) + ivory; + t3 = (t11 * 4); + /* Stack cache offset */ + t9 = arg3 - t9; + t12 = *(u64 *)(t12 + PROCESSORSTATE_DATAREAD_MASK); + /* In range? */ + t10 = ((u64)t9 < (u64)t10) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t11&7)*8)); + if (t10 != 0) + goto g8480; + +g8479: + t12 = t12 >> (t2 & 63); + t3 = (u32)t3; + if (t12 & 1) + goto g8482; + +g8489: + /* =fixnum onlyp */ + t1 = arg1 & 32; + /* J. if we don't have to test for fixnump. */ + if (t1 == 0) + goto g8472; + t9 = t2 - Type_Fixnum; + /* Strip CDR code */ + t9 = t9 & 63; + if (t9 != 0) + goto g8475; + t9 = t4 - Type_Fixnum; + /* Strip CDR code */ + t9 = t9 & 63; + if (t9 != 0) + goto g8476; + +g8472: + if (_trace) printf("g8472:\n"); + /* =cdr-code-nextp */ + t1 = arg1 & 16; + /* J. if we don't have to clear CDR codes. */ + if (t1 == 0) + goto g8474; + /* TagType. */ + t2 = t2 & 63; + +g8474: + if (_trace) printf("g8474:\n"); + t6 = *(u64 *)&(processor->aluop); + *(u64 *)&processor->aluoverflow = zero; + t7 = *(u64 *)&(processor->aluandrotatecontrol); + t1 = (t6 == ALUFunction_Boolean) ? 1 : 0; + +g8550: + if (_trace) printf("g8550:\n"); + if (t1 == 0) + goto g8491; + /* Here if argument ALUFunctionBoolean */ + t8 = t7 >> 10; + /* Extract the ALU boolean function */ + t8 = t8 & 15; + t1 = (t8 == Boole_Clear) ? 1 : 0; + +g8510: + if (_trace) printf("g8510:\n"); + if (t1 != 0) + goto g8492; + +g8493: + if (_trace) printf("g8493:\n"); + t1 = (t8 == Boole_And) ? 1 : 0; + +g8511: + if (_trace) printf("g8511:\n"); + if (t1 == 0) + goto g8494; + /* Here if argument BooleAnd */ + t8 = t3 & t5; + goto g8492; + +g8494: + if (_trace) printf("g8494:\n"); + t1 = (t8 == Boole_AndC1) ? 1 : 0; + +g8512: + if (_trace) printf("g8512:\n"); + if (t1 == 0) + goto g8495; + /* Here if argument BooleAndC1 */ + t8 = t5 & ~t3; + goto g8492; + +g8495: + if (_trace) printf("g8495:\n"); + t1 = (t8 == Boole_2) ? 1 : 0; + +g8513: + if (_trace) printf("g8513:\n"); + if (t1 == 0) + goto g8496; + /* Here if argument Boole2 */ + t8 = t5; + goto g8492; + +g8496: + if (_trace) printf("g8496:\n"); + t1 = (t8 == Boole_AndC2) ? 1 : 0; + +g8514: + if (_trace) printf("g8514:\n"); + if (t1 == 0) + goto g8497; + /* Here if argument BooleAndC2 */ + t8 = t3 & ~t5; + goto g8492; + +g8497: + if (_trace) printf("g8497:\n"); + t1 = (t8 == Boole_1) ? 1 : 0; + +g8515: + if (_trace) printf("g8515:\n"); + if (t1 == 0) + goto g8498; + /* Here if argument Boole1 */ + t8 = t3; + goto g8492; + +g8498: + if (_trace) printf("g8498:\n"); + t1 = (t8 == Boole_Xor) ? 1 : 0; + +g8516: + if (_trace) printf("g8516:\n"); + if (t1 == 0) + goto g8499; + /* Here if argument BooleXor */ + t8 = t3 ^ t5; + goto g8492; + +g8499: + if (_trace) printf("g8499:\n"); + t1 = (t8 == Boole_Ior) ? 1 : 0; + +g8517: + if (_trace) printf("g8517:\n"); + if (t1 == 0) + goto g8500; + /* Here if argument BooleIor */ + t8 = t3 | t5; + goto g8492; + +g8500: + if (_trace) printf("g8500:\n"); + t1 = (t8 == Boole_Nor) ? 1 : 0; + +g8518: + if (_trace) printf("g8518:\n"); + if (t1 == 0) + goto g8501; + /* Here if argument BooleNor */ + t8 = t3 | t5; + t8 = ~t8; + goto g8492; + +g8501: + if (_trace) printf("g8501:\n"); + t1 = (t8 == Boole_Equiv) ? 1 : 0; + +g8519: + if (_trace) printf("g8519:\n"); + if (t1 == 0) + goto g8502; + /* Here if argument BooleEquiv */ + t8 = t3 ^ t5; + t8 = ~t8; + goto g8492; + +g8502: + if (_trace) printf("g8502:\n"); + t1 = (t8 == Boole_C1) ? 1 : 0; + +g8520: + if (_trace) printf("g8520:\n"); + if (t1 == 0) + goto g8503; + /* Here if argument BooleC1 */ + t8 = ~t3; + goto g8492; + +g8503: + if (_trace) printf("g8503:\n"); + t1 = (t8 == Boole_OrC1) ? 1 : 0; + +g8521: + if (_trace) printf("g8521:\n"); + if (t1 == 0) + goto g8504; + /* Here if argument BooleOrC1 */ + t8 = t5 | ~(t3); + goto g8492; + +g8504: + if (_trace) printf("g8504:\n"); + t1 = (t8 == Boole_C2) ? 1 : 0; + +g8522: + if (_trace) printf("g8522:\n"); + if (t1 == 0) + goto g8505; + /* Here if argument BooleC2 */ + t8 = ~t5; + goto g8492; + +g8505: + if (_trace) printf("g8505:\n"); + t1 = (t8 == Boole_OrC2) ? 1 : 0; + +g8523: + if (_trace) printf("g8523:\n"); + if (t1 == 0) + goto g8506; + /* Here if argument BooleOrC2 */ + t8 = t3 & ~t5; + goto g8492; + +g8506: + if (_trace) printf("g8506:\n"); + t1 = (t8 == Boole_Nand) ? 1 : 0; + +g8524: + if (_trace) printf("g8524:\n"); + if (t1 == 0) + goto g8507; + /* Here if argument BooleNand */ + t8 = t3 & t5; + goto g8492; + +g8507: + if (_trace) printf("g8507:\n"); + t1 = (t8 == Boole_Set) ? 1 : 0; + +g8525: + if (_trace) printf("g8525:\n"); + if (t1 == 0) + goto g8492; + /* Here if argument BooleSet */ + t8 = ~zero; + +g8492: + if (_trace) printf("g8492:\n"); + +g8490: + if (_trace) printf("g8490:\n"); + t1 = t7 >> 16; + /* Extract ALU condition */ + t1 = t1 & 31; + t10 = *(u64 *)&(processor->aluoverflow); + t11 = *(u64 *)&(processor->aluborrow); + t12 = *(u64 *)&(processor->alulessthan); + t9 = (t1 == ALUCondition_SignedLessThanOrEqual) ? 1 : 0; + +g8582: + if (_trace) printf("g8582:\n"); + if (t9 == 0) + goto g8555; + /* Here if argument ALUConditionSignedLessThanOrEqual */ + if (t12 != 0) + goto g8551; + if (t8 == 0) + goto g8551; + +g8554: + if (_trace) printf("g8554:\n"); + +g8552: + if (_trace) printf("g8552:\n"); + t1 = zero; + goto g8553; + +g8551: + if (_trace) printf("g8551:\n"); + t1 = 1; + +g8553: + if (_trace) printf("g8553:\n"); + t9 = t7 >> 21; + /* Extract the condition sense */ + t9 = t9 & 1; + t1 = t1 ^ t9; + if (t1 != 0) + goto g8477; + /* =no-incrementp */ + t1 = arg1 & 4; + /* J. if we don't have to increment the address. */ + if (t1 != 0) + goto g8473; + /* Increment the address */ + arg3 = arg3 + 1; + +g8473: + if (_trace) printf("g8473:\n"); + /* Store updated vma in BAR */ + *(u32 *)arg2 = arg3; + goto NEXTINSTRUCTION; + +g8477: + if (_trace) printf("g8477:\n"); + t10 = *(s32 *)(iSP + -8); + t9 = *(s32 *)(iSP + -4); + t10 = (u32)t10; + t10 = t10 << 1; + iPC = t9 & 1; + iPC = iPC + t10; + goto interpretinstructionforjump; + +g8476: + if (_trace) printf("g8476:\n"); + /* Convert stack cache address to VMA */ + t9 = *(u64 *)&(processor->stackcachedata); + arg3 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t9 = iSP - t9; + /* convert byte address to word address */ + t9 = t9 >> 3; + /* reconstruct VMA */ + arg3 = t9 + arg3; + arg5 = arg3; + arg2 = 23; + goto illegaloperand; + +g8475: + if (_trace) printf("g8475:\n"); + arg5 = arg3; + arg2 = 23; + goto illegaloperand; + +g8555: + if (_trace) printf("g8555:\n"); + t9 = (t1 == ALUCondition_SignedLessThan) ? 1 : 0; + +g8583: + if (_trace) printf("g8583:\n"); + if (t9 == 0) + goto g8556; + /* Here if argument ALUConditionSignedLessThan */ + if (t12 != 0) + goto g8551; + goto g8554; + +g8556: + if (_trace) printf("g8556:\n"); + t9 = (t1 == ALUCondition_Negative) ? 1 : 0; + +g8584: + if (_trace) printf("g8584:\n"); + if (t9 == 0) + goto g8557; + /* Here if argument ALUConditionNegative */ + if ((s64)t8 < 0) + goto g8551; + goto g8554; + +g8557: + if (_trace) printf("g8557:\n"); + t9 = (t1 == ALUCondition_SignedOverflow) ? 1 : 0; + +g8585: + if (_trace) printf("g8585:\n"); + if (t9 == 0) + goto g8558; + /* Here if argument ALUConditionSignedOverflow */ + if (t10 != 0) + goto g8551; + goto g8554; + +g8558: + if (_trace) printf("g8558:\n"); + t9 = (t1 == ALUCondition_UnsignedLessThanOrEqual) ? 1 : 0; + +g8586: + if (_trace) printf("g8586:\n"); + if (t9 == 0) + goto g8559; + /* Here if argument ALUConditionUnsignedLessThanOrEqual */ + if (t11 != 0) + goto g8551; + if (t8 == 0) + goto g8551; + goto g8554; + +g8559: + if (_trace) printf("g8559:\n"); + t9 = (t1 == ALUCondition_UnsignedLessThan) ? 1 : 0; + +g8587: + if (_trace) printf("g8587:\n"); + if (t9 == 0) + goto g8560; + /* Here if argument ALUConditionUnsignedLessThan */ + if (t11 != 0) + goto g8551; + goto g8554; + +g8560: + if (_trace) printf("g8560:\n"); + t9 = (t1 == ALUCondition_Zero) ? 1 : 0; + +g8588: + if (_trace) printf("g8588:\n"); + if (t9 == 0) + goto g8561; + /* Here if argument ALUConditionZero */ + if (t8 == 0) + goto g8551; + goto g8554; + +g8561: + if (_trace) printf("g8561:\n"); + t9 = (t1 == ALUCondition_High25Zero) ? 1 : 0; + +g8589: + if (_trace) printf("g8589:\n"); + if (t9 == 0) + goto g8562; + /* Here if argument ALUConditionHigh25Zero */ + t1 = t8 >> 7; + if (t1 == 0) + goto g8551; + goto g8554; + +g8562: + if (_trace) printf("g8562:\n"); + t9 = (t1 == ALUCondition_Eq) ? 1 : 0; + +g8590: + if (_trace) printf("g8590:\n"); + if (t9 == 0) + goto g8563; + /* Here if argument ALUConditionEq */ + if (t8 != 0) + goto g8552; + t9 = t2 ^ t4; + /* TagType. */ + t9 = t9 & 63; + if (t9 == 0) + goto g8551; + goto g8554; + +g8563: + if (_trace) printf("g8563:\n"); + t9 = (t1 == ALUCondition_Op1Ephemeralp) ? 1 : 0; + +g8591: + if (_trace) printf("g8591:\n"); + if (t9 == 0) + goto g8564; + /* Here if argument ALUConditionOp1Ephemeralp */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8564: + if (_trace) printf("g8564:\n"); + t9 = (t1 == ALUCondition_ResultTypeNil) ? 1 : 0; + +g8592: + if (_trace) printf("g8592:\n"); + if (t9 == 0) + goto g8565; + /* Here if argument ALUConditionResultTypeNil */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8565: + if (_trace) printf("g8565:\n"); + t9 = (t1 == ALUCondition_Op2Fixnum) ? 1 : 0; + +g8593: + if (_trace) printf("g8593:\n"); + if (t9 == 0) + goto g8566; + /* Here if argument ALUConditionOp2Fixnum */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8566: + if (_trace) printf("g8566:\n"); + t9 = (t1 == ALUCondition_False) ? 1 : 0; + +g8594: + if (_trace) printf("g8594:\n"); + if (t9 == 0) + goto g8567; + /* Here if argument ALUConditionFalse */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8567: + if (_trace) printf("g8567:\n"); + t9 = (t1 == ALUCondition_ResultCdrLow) ? 1 : 0; + +g8595: + if (_trace) printf("g8595:\n"); + if (t9 == 0) + goto g8568; + /* Here if argument ALUConditionResultCdrLow */ + /* TagCdr. */ + t9 = t2 >> 6; + t1 = t9 & 1; + goto g8553; + +g8568: + if (_trace) printf("g8568:\n"); + t9 = (t1 == ALUCondition_CleanupBitsSet) ? 1 : 0; + +g8596: + if (_trace) printf("g8596:\n"); + if (t9 == 0) + goto g8569; + /* Here if argument ALUConditionCleanupBitsSet */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8569: + if (_trace) printf("g8569:\n"); + t9 = (t1 == ALUCondition_AddressInStackCache) ? 1 : 0; + +g8597: + if (_trace) printf("g8597:\n"); + if (t9 == 0) + goto g8570; + /* Here if argument ALUConditionAddressInStackCache */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8570: + if (_trace) printf("g8570:\n"); + t9 = (t1 == ALUCondition_ExtraStackMode) ? 1 : 0; + +g8598: + if (_trace) printf("g8598:\n"); + if (t9 == 0) + goto g8571; + /* Here if argument ALUConditionExtraStackMode */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8571: + if (_trace) printf("g8571:\n"); + t9 = (t1 == ALUCondition_FepMode) ? 1 : 0; + +g8599: + if (_trace) printf("g8599:\n"); + if (t9 == 0) + goto g8572; + /* Here if argument ALUConditionFepMode */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8572: + if (_trace) printf("g8572:\n"); + t9 = (t1 == ALUCondition_FpCoprocessorPresent) ? 1 : 0; + +g8600: + if (_trace) printf("g8600:\n"); + if (t9 == 0) + goto g8573; + /* Here if argument ALUConditionFpCoprocessorPresent */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8573: + if (_trace) printf("g8573:\n"); + t9 = (t1 == ALUCondition_Op1Oldspacep) ? 1 : 0; + +g8601: + if (_trace) printf("g8601:\n"); + if (t9 == 0) + goto g8574; + /* Here if argument ALUConditionOp1Oldspacep */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8574: + if (_trace) printf("g8574:\n"); + t9 = (t1 == ALUCondition_PendingSequenceBreakEnabled) ? 1 : 0; + +g8602: + if (_trace) printf("g8602:\n"); + if (t9 == 0) + goto g8575; + /* Here if argument ALUConditionPendingSequenceBreakEnabled */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8575: + if (_trace) printf("g8575:\n"); + t9 = (t1 == ALUCondition_Op1TypeAcceptable) ? 1 : 0; + +g8603: + if (_trace) printf("g8603:\n"); + if (t9 == 0) + goto g8576; + /* Here if argument ALUConditionOp1TypeAcceptable */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8576: + if (_trace) printf("g8576:\n"); + t9 = (t1 == ALUCondition_Op1TypeCondition) ? 1 : 0; + +g8604: + if (_trace) printf("g8604:\n"); + if (t9 == 0) + goto g8577; + /* Here if argument ALUConditionOp1TypeCondition */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8577: + if (_trace) printf("g8577:\n"); + t9 = (t1 == ALUCondition_StackCacheOverflow) ? 1 : 0; + +g8605: + if (_trace) printf("g8605:\n"); + if (t9 == 0) + goto g8578; + /* Here if argument ALUConditionStackCacheOverflow */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8578: + if (_trace) printf("g8578:\n"); + t9 = (t1 == ALUCondition_OrLogicVariable) ? 1 : 0; + +g8606: + if (_trace) printf("g8606:\n"); + if (t9 == 0) + goto g8579; + /* Here if argument ALUConditionOrLogicVariable */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8579: + if (_trace) printf("g8579:\n"); + /* Here for all other cases */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8491: + if (_trace) printf("g8491:\n"); + t1 = (t6 == ALUFunction_Byte) ? 1 : 0; + +g8607: + if (_trace) printf("g8607:\n"); + if (t1 == 0) + goto g8526; + /* Here if argument ALUFunctionByte */ + /* Get rotate */ + t9 = *(u64 *)&(processor->byterotate); + /* Get bytesize */ + t10 = *(u64 *)&(processor->bytesize); + /* Get background */ + t1 = t7 >> 10; + /* Extract the byte background */ + t1 = t1 & 3; + t11 = (t1 == ALUByteBackground_Op1) ? 1 : 0; + +g8533: + if (_trace) printf("g8533:\n"); + if (t11 == 0) + goto g8529; + /* Here if argument ALUByteBackgroundOp1 */ + t1 = t3; + +g8528: + if (_trace) printf("g8528:\n"); + t12 = t7 >> 12; + /* Extractthe byte rotate latch */ + t12 = t12 & 1; + t8 = t5 << (t9 & 63); + t11 = (u32)(t8 >> ((4&7)*8)); + t8 = (u32)t8; + /* OP2 rotated */ + t8 = t8 | t11; + /* Don't update rotate latch if not requested */ + if (t12 == 0) + goto g8527; + *(u64 *)&processor->rotatelatch = t8; + +g8527: + if (_trace) printf("g8527:\n"); + t12 = zero + -2; + t12 = t12 << (t10 & 63); + /* Compute mask */ + t12 = ~t12; + /* Get byte function */ + t11 = t7 >> 13; + t11 = t11 & 1; + t10 = (t11 == ALUByteFunction_Dpb) ? 1 : 0; + +g8538: + if (_trace) printf("g8538:\n"); + if (t10 == 0) + goto g8535; + /* Here if argument ALUByteFunctionDpb */ + /* Position mask */ + t12 = t12 << (t9 & 63); + +g8534: + if (_trace) printf("g8534:\n"); + /* rotated&mask */ + t8 = t8 & t12; + /* background&~mask */ + t1 = t1 & ~t12; + t8 = t8 | t1; + goto g8490; + +g8526: + if (_trace) printf("g8526:\n"); + t1 = (t6 == ALUFunction_Adder) ? 1 : 0; + +g8608: + if (_trace) printf("g8608:\n"); + if (t1 == 0) + goto g8539; + /* Here if argument ALUFunctionAdder */ + t10 = t7 >> 11; + /* Extract the op2 */ + t10 = t10 & 3; + t9 = t7 >> 10; + /* Extract the adder carry in */ + t9 = t9 & 1; + t11 = (t10 == ALUAdderOp2_Op2) ? 1 : 0; + +g8547: + if (_trace) printf("g8547:\n"); + if (t11 == 0) + goto g8542; + /* Here if argument ALUAdderOp2Op2 */ + t1 = t5; + +g8541: + if (_trace) printf("g8541:\n"); + t8 = t3 + t1; + t8 = t8 + t9; + /* Sign bit */ + t10 = t8 >> 31; + /* Next bit */ + t11 = t8 >> 32; + /* Low bit is now overflow indicator */ + t10 = t10 ^ t11; + /* Get the load-carry-in bit */ + t11 = t7 >> 24; + *(u64 *)&processor->aluoverflow = t10; + if ((t11 & 1) == 0) + goto g8540; + /* Get the carry */ + t10 = (u32)(t8 >> ((4&7)*8)); + t11 = zero + 1024; + t7 = t7 & ~t11; + t11 = t10 & 1; + t11 = t11 << 10; + /* Set the adder carry in */ + t7 = t7 | t11; + *(u64 *)&processor->aluandrotatecontrol = t7; + +g8540: + if (_trace) printf("g8540:\n"); + t10 = ((s64)t3 < (s64)t1) ? 1 : 0; + *(u64 *)&processor->aluborrow = t10; + t3 = (s32)t3; + t5 = (s32)t5; + t10 = ((s64)t3 < (s64)t1) ? 1 : 0; + *(u64 *)&processor->alulessthan = t10; + goto g8490; + +g8539: + if (_trace) printf("g8539:\n"); + t1 = (t6 == ALUFunction_MultiplyDivide) ? 1 : 0; + +g8609: + if (_trace) printf("g8609:\n"); + if (t1 == 0) + goto g8490; + /* Here if argument ALUFunctionMultiplyDivide */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +g8542: + if (_trace) printf("g8542:\n"); + t11 = (t10 == ALUAdderOp2_Zero) ? 1 : 0; + +g8610: + if (_trace) printf("g8610:\n"); + if (t11 == 0) + goto g8543; + /* Here if argument ALUAdderOp2Zero */ + t1 = zero; + goto g8541; + +g8543: + if (_trace) printf("g8543:\n"); + t11 = (t10 == ALUAdderOp2_Invert) ? 1 : 0; + +g8611: + if (_trace) printf("g8611:\n"); + if (t11 == 0) + goto g8544; + /* Here if argument ALUAdderOp2Invert */ + t1 = (s32)t5; + t1 = zero - t1; + t1 = (u32)t1; + goto g8541; + +g8544: + if (_trace) printf("g8544:\n"); + t11 = (t10 == ALUAdderOp2_MinusOne) ? 1 : 0; + +g8612: + if (_trace) printf("g8612:\n"); + if (t11 == 0) + goto g8541; + /* Here if argument ALUAdderOp2MinusOne */ + t1 = ~zero; + t1 = (u32)t1; + goto g8541; + +g8535: + if (_trace) printf("g8535:\n"); + t10 = (t11 == ALUByteFunction_Ldb) ? 1 : 0; + +g8613: + if (_trace) printf("g8613:\n"); + if (t10 != 0) + goto g8534; + goto g8534; + +g8529: + if (_trace) printf("g8529:\n"); + t11 = (t1 == ALUByteBackground_RotateLatch) ? 1 : 0; + +g8614: + if (_trace) printf("g8614:\n"); + if (t11 == 0) + goto g8530; + /* Here if argument ALUByteBackgroundRotateLatch */ + t1 = *(u64 *)&(processor->rotatelatch); + goto g8528; + +g8530: + if (_trace) printf("g8530:\n"); + t11 = (t1 == ALUByteBackground_Zero) ? 1 : 0; + +g8615: + if (_trace) printf("g8615:\n"); + if (t11 == 0) + goto g8528; + /* Here if argument ALUByteBackgroundZero */ + t1 = zero; + goto g8528; + +g8480: + if (_trace) printf("g8480:\n"); + t10 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t9 = (t9 * 8) + t10; + t3 = *(s32 *)t9; + /* Read from stack cache */ + t2 = *(s32 *)(t9 + 4); + goto g8479; + +g8482: + if (_trace) printf("g8482:\n"); + +g8481: + if (_trace) printf("g8481:\n"); + /* Cycle-number -> table offset */ + t12 = (t1 * 4); + t12 = (t12 * 4) + ivory; + t12 = *(u64 *)(t12 + PROCESSORSTATE_DATAREAD); + /* TagType. */ + /* Discard the CDR code */ + t11 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg3; + /* Adjust for a longword load */ + t11 = (t11 * 4) + t12; + /* Get the memory action */ + t12 = *(s32 *)t11; + +g8487: + if (_trace) printf("g8487:\n"); + t10 = t12 & MemoryActionIndirect; + if (t10 == 0) + goto g8486; + /* Do the indirect thing */ + arg3 = (u32)t3; + goto g8478; + +g8486: + if (_trace) printf("g8486:\n"); + t11 = t12 & MemoryActionTransform; + if (t11 == 0) + goto g8485; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g8489; +#ifndef MINIMA + +g8485: +#endif +#ifdef MINIMA + +g8485: + if (_trace) printf("g8485:\n"); + t11 = t12 & MemoryActionBinding; + t10 = *(u64 *)&(processor->dbcmask); + if (t11 == 0) + goto g8484; + t9 = arg3 << 1; + t11 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t9 = t9 & t10; + t10 = 1; + t10 = t10 << (ivorymemorydata & 63); + t9 = (s32)t9 + (s32)t11; + /* Clear sign-extension */ + t9 = (u32)t9; + t10 = (t9 * 4) + t10; + /* Fetch the key */ + t9 = *(s32 *)t10; + /* Fetch value */ + t3 = *(s32 *)(t10 + 4); + /* Compare */ + t11 = (s32)arg3 - (s32)t9; + /* Trap on miss */ + if (t11 != 0) + goto g8488; + /* Extract the pointer, and indirect */ + arg3 = (u32)t3; + goto g8478; + +g8488: + if (_trace) printf("g8488:\n"); + goto dbcachemisstrap; +#endif + +g8484: + /* Perform memory action */ + arg1 = t12; + arg2 = t1; + goto performmemoryaction; + +/* end DoBlock1ReadTest */ + /* End of Halfword operand from stack instruction - DoBlock1ReadTest */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunblok.as */ diff --git a/stub/ifunbnum.c b/stub/ifunbnum.c new file mode 100644 index 0000000..8b0fc66 --- /dev/null +++ b/stub/ifunbnum.c @@ -0,0 +1,544 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunbnum.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Bignums. */ +/* start DoAddBignumStep */ + + /* Halfword operand from stack instruction - DoAddBignumStep */ + /* arg2 has the preloaded 8 bit operand. */ + +doaddbignumstep: + if (_trace) printf("doaddbignumstep:\n"); +#ifdef TRACING +#endif + +DoAddBignumStepIM: + if (_trace) printf("DoAddBignumStepIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoaddbignumstep; +#ifdef TRACING +#endif + +DoAddBignumStepSP: + if (_trace) printf("DoAddBignumStepSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoaddbignumstep; +#endif + +DoAddBignumStepLP: + if (_trace) printf("DoAddBignumStepLP:\n"); +#ifdef TRACING + goto headdoaddbignumstep; +#endif + +DoAddBignumStepFP: + if (_trace) printf("DoAddBignumStepFP:\n"); + +headdoaddbignumstep: + if (_trace) printf("headdoaddbignumstep:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoaddbignumstep: + if (_trace) printf("begindoaddbignumstep:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get arg2 */ + arg2 = *(s32 *)iSP; + /* and its tag */ + t2 = *(s32 *)(iSP + 4); + t3 = arg1 >> 32; + /* Strip type from arg3 */ + arg1 = (u32)arg1; + t4 = t3 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto addbignumsteplose; + /* Get arg1 */ + arg3 = *(s32 *)(iSP + -8); + /* and its tag */ + t1 = *(s32 *)(iSP + -4); + /* Clear sign extension from arg2 */ + arg2 = (u32)arg2; + t4 = t2 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto addbignumsteplose; + /* Clear sign extension */ + arg3 = (u32)arg3; + t4 = t1 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto addbignumsteplose; + arg4 = arg1 + arg2; + arg5 = arg3 + arg4; + /* Shift the carry into arg6 */ + arg6 = arg5 >> 32; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Store fixnum result */ + *(u32 *)(iSP + -8) = arg5; + /* write the stack cache */ + *(u32 *)(iSP + -4) = t1; + /* Store the carry if any */ + *(u32 *)iSP = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +addbignumsteplose: + if (_trace) printf("addbignumsteplose:\n"); + arg5 = 0; + arg2 = 76; + goto illegaloperand; + +/* end DoAddBignumStep */ + /* End of Halfword operand from stack instruction - DoAddBignumStep */ +/* start DoSubBignumStep */ + + /* Halfword operand from stack instruction - DoSubBignumStep */ + /* arg2 has the preloaded 8 bit operand. */ + +dosubbignumstep: + if (_trace) printf("dosubbignumstep:\n"); +#ifdef TRACING +#endif + +DoSubBignumStepIM: + if (_trace) printf("DoSubBignumStepIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindosubbignumstep; +#ifdef TRACING +#endif + +DoSubBignumStepSP: + if (_trace) printf("DoSubBignumStepSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdosubbignumstep; +#endif + +DoSubBignumStepLP: + if (_trace) printf("DoSubBignumStepLP:\n"); +#ifdef TRACING + goto headdosubbignumstep; +#endif + +DoSubBignumStepFP: + if (_trace) printf("DoSubBignumStepFP:\n"); + +headdosubbignumstep: + if (_trace) printf("headdosubbignumstep:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindosubbignumstep: + if (_trace) printf("begindosubbignumstep:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get arg2 */ + arg2 = *(s32 *)iSP; + /* and its tag */ + t2 = *(s32 *)(iSP + 4); + t3 = arg1 >> 32; + /* Strip type from arg3 */ + arg1 = (u32)arg1; + t4 = t3 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto subbignumsteplose; + /* Get arg1 */ + arg3 = *(s32 *)(iSP + -8); + /* and its tag */ + t1 = *(s32 *)(iSP + -4); + /* Clear sign extension from arg2 */ + arg2 = (u32)arg2; + t4 = t2 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto subbignumsteplose; + /* Clear sign extension */ + arg3 = (u32)arg3; + t4 = t1 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto subbignumsteplose; + /* arg1-arg2 */ + arg4 = arg3 - arg2; + /* arg6=1 if we borrowed in 1st step */ + arg6 = ((s64)arg4 < (s64)zero) ? 1 : 0; + /* Truncate 1st step to 32-bits */ + arg4 = (u32)arg4; + /* (arg1-arg2)-arg3 */ + arg5 = arg4 - arg1; + /* t6=1 if we borrowed in 2nd step */ + t6 = ((s64)arg5 < (s64)zero) ? 1 : 0; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Store fixnum result */ + *(u32 *)(iSP + -8) = arg5; + /* write the stack cache */ + *(u32 *)(iSP + -4) = t1; + /* Compute borrow */ + arg6 = arg6 + t6; + /* Store the borrow if any */ + *(u32 *)iSP = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +subbignumsteplose: + if (_trace) printf("subbignumsteplose:\n"); + arg5 = 0; + arg2 = 76; + goto illegaloperand; + +/* end DoSubBignumStep */ + /* End of Halfword operand from stack instruction - DoSubBignumStep */ +/* start DoMultiplyBignumStep */ + + /* Halfword operand from stack instruction - DoMultiplyBignumStep */ + /* arg2 has the preloaded 8 bit operand. */ + +domultiplybignumstep: + if (_trace) printf("domultiplybignumstep:\n"); +#ifdef TRACING +#endif + +DoMultiplyBignumStepIM: + if (_trace) printf("DoMultiplyBignumStepIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindomultiplybignumstep; +#ifdef TRACING +#endif + +DoMultiplyBignumStepSP: + if (_trace) printf("DoMultiplyBignumStepSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdomultiplybignumstep; +#endif + +DoMultiplyBignumStepLP: + if (_trace) printf("DoMultiplyBignumStepLP:\n"); +#ifdef TRACING + goto headdomultiplybignumstep; +#endif + +DoMultiplyBignumStepFP: + if (_trace) printf("DoMultiplyBignumStepFP:\n"); + +headdomultiplybignumstep: + if (_trace) printf("headdomultiplybignumstep:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindomultiplybignumstep: + if (_trace) printf("begindomultiplybignumstep:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get arg1 */ + arg2 = *(s32 *)iSP; + t1 = *(s32 *)(iSP + 4); + t2 = arg1 >> 32; + /* Strip type from arg2 */ + arg1 = (u32)arg1; + t4 = t2 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto multbignumsteplose; + arg2 = (u32)arg2; + t4 = t1 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto multbignumsteplose; + /* arg1*arg2 */ + arg3 = arg2 * arg1; + /* arg6=high order word */ + arg6 = (u32)(arg3 >> ((4&7)*8)); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Store fixnum result ls word */ + *(u32 *)iSP = arg3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + /* Store ms word */ + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto cachevalid; + +multbignumsteplose: + if (_trace) printf("multbignumsteplose:\n"); + arg5 = 0; + arg2 = 80; + goto illegaloperand; + +/* end DoMultiplyBignumStep */ + /* End of Halfword operand from stack instruction - DoMultiplyBignumStep */ +/* start DoDivideBignumStep */ + + /* Halfword operand from stack instruction - DoDivideBignumStep */ + /* arg2 has the preloaded 8 bit operand. */ + +dodividebignumstep: + if (_trace) printf("dodividebignumstep:\n"); +#ifdef TRACING +#endif + +DoDivideBignumStepIM: + if (_trace) printf("DoDivideBignumStepIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindodividebignumstep; +#ifdef TRACING +#endif + +DoDivideBignumStepSP: + if (_trace) printf("DoDivideBignumStepSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdodividebignumstep; +#endif + +DoDivideBignumStepLP: + if (_trace) printf("DoDivideBignumStepLP:\n"); +#ifdef TRACING + goto headdodividebignumstep; +#endif + +DoDivideBignumStepFP: + if (_trace) printf("DoDivideBignumStepFP:\n"); + +headdodividebignumstep: + if (_trace) printf("headdodividebignumstep:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindodividebignumstep: + if (_trace) printf("begindodividebignumstep:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get arg2 */ + arg2 = *(s32 *)iSP; + t1 = *(s32 *)(iSP + 4); + t2 = arg1 >> 32; + arg1 = (u32)arg1; + t4 = t2 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto divbignumsteplose1; + /* J. if division by zero */ + if (arg1 == 0) + goto divbignumsteplose2; + arg2 = (u32)arg2; + /* Get arg1 */ + arg3 = *(s32 *)(iSP + -8); + t3 = *(s32 *)(iSP + -4); + t4 = t1 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto divbignumsteplose1; + /* arg2=(ash arg2 32) */ + arg2 = arg2 << 32; + arg3 = (u32)arg3; + t4 = t3 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto divbignumsteplose1; + /* arg1+(ash arg2 32) */ + arg4 = arg3 | arg2; + /* t1 is now the quotient */ + t1 = arg4 / arg1; + t2 = t1 * arg1; + /* t2 is now the remainder */ + t2 = arg4 - t2; + /* store quotient (already fixnum) */ + *(u32 *)(iSP + -8) = t1; + /* store remainder (already fixnum) */ + *(u32 *)iSP = t2; + goto NEXTINSTRUCTION; + +divbignumsteplose1: + if (_trace) printf("divbignumsteplose1:\n"); + arg5 = 0; + arg2 = 76; + goto illegaloperand; + +divbignumsteplose2: + if (_trace) printf("divbignumsteplose2:\n"); + arg5 = 0; + arg2 = 2; + goto illegaloperand; + +/* end DoDivideBignumStep */ + /* End of Halfword operand from stack instruction - DoDivideBignumStep */ +/* start DoLshcBignumStep */ + + /* Halfword operand from stack instruction - DoLshcBignumStep */ + +dolshcbignumstep: + if (_trace) printf("dolshcbignumstep:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoLshcBignumStepIM: + if (_trace) printf("DoLshcBignumStepIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8735: + if (_trace) printf("g8735:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindolshcbignumstep; +#ifdef TRACING +#endif + +DoLshcBignumStepSP: + if (_trace) printf("DoLshcBignumStepSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdolshcbignumstep; +#endif + +DoLshcBignumStepLP: + if (_trace) printf("DoLshcBignumStepLP:\n"); +#ifdef TRACING + goto headdolshcbignumstep; +#endif + +DoLshcBignumStepFP: + if (_trace) printf("DoLshcBignumStepFP:\n"); + +headdolshcbignumstep: + if (_trace) printf("headdolshcbignumstep:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindolshcbignumstep: + if (_trace) printf("begindolshcbignumstep:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* Get arg2 */ + arg2 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + /* Pop Stack */ + iSP = iSP - 8; + t3 = arg1 >> 32; + /* Strip type from arg3 */ + arg1 = (u32)arg1; + t4 = t3 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto lshcbignumsteplose; + arg2 = (u32)arg2; + /* Get arg1 */ + arg3 = *(s32 *)iSP; + t1 = *(s32 *)(iSP + 4); + t4 = t2 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto lshcbignumsteplose; + /* arg2=(ash arg2 32) */ + arg2 = arg2 << 32; + arg3 = (u32)arg3; + t4 = t1 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto lshcbignumsteplose; + /* arg1+(ash arg2 32) */ + arg4 = arg3 | arg2; + arg5 = arg4 << (arg1 & 63); + /* Extract the result */ + arg6 = (s64)arg5 >> 32; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Store the result as a fixnum */ + *(u32 *)iSP = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto cachevalid; + +lshcbignumsteplose: + if (_trace) printf("lshcbignumsteplose:\n"); + arg5 = 0; + arg2 = 76; + goto illegaloperand; + +/* end DoLshcBignumStep */ + /* End of Halfword operand from stack instruction - DoLshcBignumStep */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunbnum.as */ diff --git a/stub/ifuncom1.c b/stub/ifuncom1.c new file mode 100644 index 0000000..d1e4821 --- /dev/null +++ b/stub/ifuncom1.c @@ -0,0 +1,4601 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuncom1.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* The most commonly used instructions, part 1. */ +/* start DoPush */ + + /* Halfword operand from stack instruction - DoPush */ + /* arg2 has the preloaded 8 bit operand. */ + +dopush: + if (_trace) printf("dopush:\n"); +#ifdef TRACING +#endif + +DoPushSP: + if (_trace) printf("DoPushSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindopush; +#endif + +DoPushLP: + if (_trace) printf("DoPushLP:\n"); +#ifdef TRACING + goto begindopush; +#endif + +DoPushFP: + if (_trace) printf("DoPushFP:\n"); + +begindopush: + if (_trace) printf("begindopush:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Push the new value */ + iSP = iSP + 8; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Get the tag/data */ + t1 = *(s32 *)(arg1 + 4); + t2 = *(s32 *)arg1; + /* Store the data word */ + *(u32 *)iSP = t2; + +g6142: + if (_trace) printf("g6142:\n"); + /* TagType. */ + /* make it CDR NEXT */ + t1 = t1 & 63; + /* Store the TAG - this *DOES* dual issue! */ + *(u32 *)(iSP + 4) = t1; + +/* end DoPush */ + /* End of Halfword operand from stack instruction - DoPush */ +/* start nextInstruction */ + + +nextinstruction: + if (_trace) printf("nextinstruction:\n"); + +cachevalid: + if (_trace) printf("cachevalid:\n"); + /* Grab the instruction/operand while stalled */ + arg3 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* Assume FP mode */ + arg1 = iFP; + /* Get the PC to check cache hit. */ + t2 = *(u64 *)&(((CACHELINEP)iCP)->pcdata); + /* SP-pop mode constant */ + arg4 = iSP + -8; + +continuecurrentinstruction: + if (_trace) printf("continuecurrentinstruction:\n"); + if (_show) show_loc(); + /* Instruction handler */ + t3 = *(u64 *)&(((CACHELINEP)iCP)->code); + /* SP mode constant */ + arg5 = iSP + -2040; + /* Need this in case we take a trap */ + *(u64 *)&processor->restartsp = iSP; + /* Get the mode bits */ + t4 = (u8)(arg3 >> ((5&7)*8)); + /* check for HIT. */ + t2 = t2 - iPC; + /* Load TOS in free di slot */ + arg6 = *(u64 *)iSP; + /* Extract (8-bit, unsigned) operand */ + arg2 = (u8)(arg3 >> ((4&7)*8)); + /* PC didn't match, take a cache miss */ + if (t2 != 0) + goto takeicachemiss; + /* LP or Immediate mode */ + if (t4 & 1) + arg1 = iLP; +#ifdef TRACING + /* Update the instruction count. */ + t4 = *(u64 *)&(processor->instruction_count); + /* Decrement the instruction count. */ + t4 = t4 - 1; + /* J. if not reached stop point. */ + if (t4 != 0) + goto g6196; + /* put a breakpoint here to catch stops */ + zero = zero; + +g6196: + if (_trace) printf("g6196:\n"); + *(u64 *)&processor->instruction_count = t4; + /* Trace instructions if requested. */ + t4 = *(u64 *)&(processor->trace_hook); + /* J. if not tracing. */ + if (t4 == 0) + goto g6201; + /* Record an instruction trace entry */ + t5 = *(s32 *)&t4->tracedata_recording_p; + t6 = *(u64 *)&(t4->tracedata_start_pc); + /* Jump if recording is on */ + if (t5 != 0) + goto g6197; + /* Turn recording on if at the start PC */ + t6 = (t6 == iPC) ? 1 : 0; + *(u32 *)&t4->tracedata_recording_p = t6; + /* Jump if not at the start PC */ + if (t6 == 0) + goto g6201; + +g6197: + if (_trace) printf("g6197:\n"); + /* Get address of next trace record */ + t5 = *(u64 *)&(t4->tracedata_current_entry); + t6 = *(u64 *)&(processor->instruction_count); + /* Save current PC */ + *(u64 *)&t5->tracerecord_epc = iPC; + /* Save instruction count */ + *(u64 *)&t5->tracerecord_counter = t6; + t6 = *(u64 *)iSP; + /* Convert stack cache address to VMA */ + t8 = *(u64 *)&(processor->stackcachedata); + t7 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t8 = iSP - t8; + /* convert byte address to word address */ + t8 = t8 >> 3; + /* reconstruct VMA */ + t7 = t8 + t7; + /* Save current value of TOS */ + *(u64 *)&t5->tracerecord_tos = t6; + /* Save current SP */ + *(u64 *)&t5->tracerecord_sp = t7; + t6 = *(s32 *)&((CACHELINEP)iCP)->operand; + t7 = *(u64 *)&(((CACHELINEP)iCP)->code); + /* Save current instruction's operand */ + *(u32 *)&t5->tracerecord_operand = t6; + /* Save pointer to current instruction code */ + *(u64 *)&t5->tracerecord_instruction = t7; + t7 = *(u64 *)&(processor->control); + t8 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* We don't yet record catch blocks */ + *(u32 *)&t5->tracerecord_catch_block_p = zero; + /* Save control register */ + *(u64 *)&t5->tracerecord_catch_block_0 = t7; + t6 = *(u64 *)&(processor->tvi); + /* Save full word instruction operand */ + *(u64 *)&t5->tracerecord_instruction_data = t8; + /* Save trap indiciator */ + *(u32 *)&t5->tracerecord_trap_p = t6; + /* Jump if didn't trap */ + if (t6 == 0) + goto g6198; + t6 = *(u64 *)(iFP + 16); + /* Zero flag to avoid false trap entries */ + *(u64 *)&processor->tvi = zero; + t7 = *(u64 *)(iFP + 24); + /* Save trap vector index */ + *(u64 *)&t5->tracerecord_trap_data_0 = t6; + t8 = *(u64 *)(iFP + 32); + /* Save fault PC */ + *(u64 *)&t5->tracerecord_trap_data_1 = t7; + t9 = *(u64 *)(iFP + 40); + /* Save two additional arguments */ + *(u64 *)&t5->tracerecord_trap_data_2 = t8; + *(u64 *)&t5->tracerecord_trap_data_3 = t9; + +g6198: + if (_trace) printf("g6198:\n"); + /* Bump to next trace record */ + t5 = t5 + tracerecordsize; + /* Get pointer to start of trace records */ + t6 = *(u64 *)&(t4->tracedata_records_start); + /* Set record pointer to keep printer happy */ + *(u64 *)&t4->tracedata_current_entry = t5; + /* Get pointer to end of trace record */ + t7 = *(u64 *)&(t4->tracedata_records_end); + /* Function to print trace if non-zero */ + t8 = *(u64 *)&(t4->tracedata_printer); + /* Non-zero iff we're about to wrap the circular buffer */ + t7 = ((s64)t7 <= (s64)t5) ? 1 : 0; + /* Update next record pointer iff we wrapped */ + if (t7) + t5 = t6; + /* Don't print if we didn't wrap */ + if (t7 == 0) + t8 = zero; + /* Jump if we don't need to print */ + if (t8 == 0) + goto g6199; + *(u64 *)&processor->cp = iCP; + *(u64 *)&processor->epc = iPC; + *(u64 *)&processor->sp = iSP; + *(u64 *)&processor->fp = iFP; + *(u64 *)&processor->lp = iLP; + *(u64 *)&processor->asrf2 = arg1; + *(u64 *)&processor->asrf3 = arg2; + *(u64 *)&processor->asrf4 = arg3; + *(u64 *)&processor->asrf5 = arg4; + *(u64 *)&processor->asrf6 = arg5; + *(u64 *)&processor->asrf7 = arg6; + *(u64 *)&processor->asrf8 = t4; + *(u64 *)&processor->asrf9 = t5; + *(u64 *)&processor->long_pad1 = t3; + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + pv = t8; + r0 = (*( u64 (*)(u64, u64) )t8)(arg1, arg2); /* jsr */ + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + arg1 = *(u64 *)&(processor->asrf2); + arg2 = *(u64 *)&(processor->asrf3); + arg3 = *(u64 *)&(processor->asrf4); + arg4 = *(u64 *)&(processor->asrf5); + arg5 = *(u64 *)&(processor->asrf6); + arg6 = *(u64 *)&(processor->asrf7); + t4 = *(u64 *)&(processor->asrf8); + t5 = *(u64 *)&(processor->asrf9); + t3 = *(u64 *)&(processor->long_pad1); + iCP = *(u64 *)&(processor->cp); + iPC = *(u64 *)&(processor->epc); + iSP = *(u64 *)&(processor->sp); + iFP = *(u64 *)&(processor->fp); + iLP = *(u64 *)&(processor->lp); + /* Claim we didn't wrap */ + t7 = zero; + +g6199: + if (_trace) printf("g6199:\n"); + /* Save next record pointer */ + *(u64 *)&t4->tracedata_current_entry = t5; + /* Jump if we didn't wrap */ + if (t7 == 0) + goto g6200; + /* Set flag indicating that we wrapped */ + *(u32 *)&t4->tracedata_wrap_p = t7; + +g6200: + if (_trace) printf("g6200:\n"); + t5 = *(u64 *)&(t4->tracedata_stop_pc); + /* Non-zero if at PC where we should stop tracing */ + t5 = (t5 == iPC) ? 1 : 0; + /* Non-zero if not at the PC */ + t5 = (t5 == 0) ? 1 : 0; + /* Update recording flag */ + *(u32 *)&t4->tracedata_recording_p = t5; + +g6201: + if (_trace) printf("g6201:\n"); +#endif +#ifdef STATISTICS + /* The instruction. */ + t4 = *(u64 *)&(((CACHELINEP)iCP)->code); + /* The usage statistics array */ + t5 = *(u64 *)&(processor->statistics); + t9 = zero + 8191; + t6 = t4 >> 4; + /* Extract the address */ + t6 = t6 & t9; + /* Compute the index to the usage data for this instn. */ + t7 = (t6 * 8) + t5; + /* Get current usage data */ + t8 = *(u64 *)t7; + /* Increment */ + t8 = t8 + 1; + /* Set current usage data */ + *(u64 *)t7 = t8; +#ifdef EXECTIMES + getrusage(RUSAGE_SELF,&_rusage); + if (_lastcode != 0xFFFF) { + _exectimes[_lastcode] += (_rusage.ru_utime.tv_usec + + _rusage.ru_utime.tv_sec * 1000000) - _lastinststart; + } + _lastcode = t6 ; + _lastinststart = (_rusage.ru_utime.tv_usec + + _rusage.ru_utime.tv_sec * 1000000); +#endif // EXECTIMES +#endif +#ifdef CACHEMETERING + /* The number of remaining tokens. */ + t5 = *(s32 *)&processor->metercount; + /* The cache miss meter buffer. */ + t4 = *(u64 *)&(processor->meterdatabuff); + /* Position for new data. */ + t7 = *(s32 *)&processor->meterpos; + /* record a cache hit */ + t5 = t5 - 1; + if (t5 != 0) + goto g6202; + t8 = *(s32 *)&processor->metermask; + /* position of the current data item */ + t4 = (t7 * 4) + t4; + t9 = *(s32 *)&processor->metervalue; + t7 = t7 + 1; + t7 = t7 & t8; + t8 = *(s32 *)&processor->metermax; + t6 = t9 - t8; + if ((s64)t6 > 0) + t8 = t9; + *(u32 *)&processor->metermax = t8; + /* store the datapoint */ + *(u32 *)t4 = t9; + /* Position for new data. */ + *(u32 *)&processor->meterpos = t7; + *(u32 *)&processor->metervalue = zero; + t5 = *(s32 *)&processor->meterfreq; + +g6202: + if (_trace) printf("g6202:\n"); + *(u32 *)&processor->metercount = t5; +#endif +#ifdef DEBUGGING + /* Just in case... */ + if (t3 == 0) + goto haltmachine; +#endif + /* Jump to the handler */ + goto *t3; /* jmp */ + /* Here to advance the PC and begin a new instruction. Most */ + /* instructions come here when they have finished. Instructions */ + /* that explicitly update the PC (and CP) go to interpretInstruction. */ + +NEXTINSTRUCTION: + if (_trace) printf("NEXTINSTRUCTION:\n"); + /* Load the next PC from the cache */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Advance cache position */ + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + goto cachevalid; + +takeicachemiss: + if (_trace) printf("takeicachemiss:\n"); + goto ICACHEMISS; + +/* end nextInstruction */ +/* start DoPushImmediateHandler */ + + +dopushimmediatehandler: + if (_trace) printf("dopushimmediatehandler:\n"); +#ifdef TRACING + goto DoPushIM; +#endif + +DoPushIM: + if (_trace) printf("DoPushIM:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t4 = Type_Fixnum; + /* Push it with CDR-NEXT onto the stack */ + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + goto cachevalid; + +/* end DoPushImmediateHandler */ +/* start DoBranchTrue */ + + /* Halfword 10 bit immediate instruction - DoBranchTrue */ + +dobranchtrue: + if (_trace) printf("dobranchtrue:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueIM: + if (_trace) printf("DoBranchTrueIM:\n"); + +DoBranchTrueSP: + if (_trace) printf("DoBranchTrueSP:\n"); + +DoBranchTrueLP: + if (_trace) printf("DoBranchTrueLP:\n"); + +DoBranchTrueFP: + if (_trace) printf("DoBranchTrueFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto dobrpopelsepop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrpopelsepop: + if (_trace) printf("dobrpopelsepop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrue */ + /* End of Halfword operand from stack instruction - DoBranchTrue */ +/* start DoBranchFalse */ + + /* Halfword 10 bit immediate instruction - DoBranchFalse */ + +dobranchfalse: + if (_trace) printf("dobranchfalse:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseIM: + if (_trace) printf("DoBranchFalseIM:\n"); + +DoBranchFalseSP: + if (_trace) printf("DoBranchFalseSP:\n"); + +DoBranchFalseLP: + if (_trace) printf("DoBranchFalseLP:\n"); + +DoBranchFalseFP: + if (_trace) printf("DoBranchFalseFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto dobrnpopelsepop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrnpopelsepop: + if (_trace) printf("dobrnpopelsepop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalse */ + /* End of Halfword operand from stack instruction - DoBranchFalse */ +/* start DoReturnSingle */ + + /* Halfword 10 bit immediate instruction - DoReturnSingle */ + +doreturnsingle: + if (_trace) printf("doreturnsingle:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoReturnSingleIM: + if (_trace) printf("DoReturnSingleIM:\n"); + +DoReturnSingleSP: + if (_trace) printf("DoReturnSingleSP:\n"); + +DoReturnSingleLP: + if (_trace) printf("DoReturnSingleLP:\n"); + +DoReturnSingleFP: + if (_trace) printf("DoReturnSingleFP:\n"); + /* arg1 has operand preloaded. */ + /* Fetch value based on immediate, interleaved with compute disposition dispatch */ + arg5 = *(s32 *)&processor->control; + /* Clear cdr */ + arg3 = arg6 << 26; + t3 = (12) << 16; + t1 = *(u64 *)&(processor->niladdress); + /* Clear cdr */ + arg3 = arg3 >> 26; + t2 = *(u64 *)&(processor->taddress); + /* mask disposition bits */ + t3 = t3 & arg5; + /* shift disposition bits into place */ + t3 = t3 >> 18; + arg6 = *(u64 *)&(processor->stackcachedata); + /* arg2 is 8 bits of "kludge operand" 0=TOS 40=NIL 41=T */ + if ((s64)arg2 > 0) + arg3 = t1; + /* arg4 -2=effect -1=value 0=return 1=multiple */ + arg4 = t3 - 2; + if (arg2 & 1) + arg3 = t2; + +returncommontail: + if (_trace) printf("returncommontail:\n"); + /* Restore machine state from frame header. */ + t3 = *(s32 *)iFP; + t1 = (1792) << 16; + t5 = *(s32 *)&processor->continuation; + /* Mask */ + t1 = arg5 & t1; + t2 = *(s32 *)(iFP + 4); + t7 = iCP; + /* Need to cleanup frame first */ + if (t1 != 0) + goto returnsinglecleanup; + t3 = (u32)t3; + t4 = *((s32 *)(&processor->continuation)+1); + t5 = (u32)t5; +#ifdef IVERIFY + /* check for instruction verification suite end-of-test */ + /* check for end of run */ + t6 = (s32)t2 - (s32)Type_NIL; + if (t6 == 0) + goto g6227; +#endif + /* Get saved control register */ + t6 = *(s32 *)(iFP + 8); + /* TagType. */ + t2 = t2 & 63; + /* Restore the PC. */ + if (arg4 == 0) + goto g6229; + /* Assume even PC */ + iPC = t5 << 1; + t1 = t4 & 1; + t7 = *(u64 *)&(processor->continuationcp); + iPC = iPC + t1; + +g6229: + if (_trace) printf("g6229:\n"); + /* Restore the saved continuation */ + *((u32 *)(&processor->continuation)+1) = t2; + /* Get the caller frame size into place */ + t1 = arg5 >> 9; + *(u32 *)&processor->continuation = t3; + /* Restore the stack pointer. */ + iSP = iFP - 8; + *(u64 *)&processor->continuationcp = zero; + /* Mask just the caller frame size. */ + t1 = t1 & 255; + /* *8 */ + t1 = (t1 * 8) + 0; + t2 = (2048) << 16; + t2 = t2 & arg5; + /* Get the preempt-pending bit */ + t3 = *(s32 *)&processor->interruptreg; + /* Sticky trace pending bit. */ + t6 = t2 | t6; + /* Get the trap/suspend bits */ + t4 = *(u64 *)&(processor->please_stop); + /* Restore the frame pointer. */ + iFP = iFP - t1; + /* Restore the control register */ + *(u32 *)&processor->control = t6; + /* extract the argument size */ + t1 = t6 & 255; + t3 = t3 & 1; + t3 = t4 | t3; + *(u64 *)&processor->stop_interpreter = t3; + /* Restore the local pointer. */ + iLP = (t1 * 8) + iFP; + +g6230: + if (_trace) printf("g6230:\n"); + /* ARG6 = stack-cache underflow */ + arg6 = ((u64)iFP < (u64)arg6) ? 1 : 0; + /* arg4 -2=effect -1=value 0=return 1=multiple */ + if (arg4 == 0) + goto returnsinglereturn; + if ((arg4 & 1) == 0) + goto returnsingleeffect; + *(u64 *)(iSP + 8) = arg3; + iSP = iSP + 8; + if ((s64)arg4 > 0) + goto returnsinglemultiple; + +returnsingleeffect: + if (_trace) printf("returnsingleeffect:\n"); + +returnsingledone: + if (_trace) printf("returnsingledone:\n"); + if (arg6 != 0) + goto returnsingleunderflow; + /* No prediction, validate cache */ + if (t7 == 0) + goto interpretinstructionforbranch; + iCP = t7; + goto INTERPRETINSTRUCTION; + +returnsinglemultiple: + if (_trace) printf("returnsinglemultiple:\n"); + /* Multiple-value group */ + t8 = Type_Fixnum; + t8 = t8 << 32; + iSP = iSP + 8; + t8 = t8 | 1; + /* Push Fixnum */ + *(u64 *)iSP = t8; + goto returnsingledone; + +returnsinglereturn: + if (_trace) printf("returnsinglereturn:\n"); + if (arg2 != 0) + goto returnsingledone; + *(u64 *)(iSP + 8) = arg3; + iSP = iSP + 8; + goto returnsingledone; + +returnsinglecleanup: + if (_trace) printf("returnsinglecleanup:\n"); + goto handleframecleanup; + +returnsingleunderflow: + if (_trace) printf("returnsingleunderflow:\n"); + goto stackcacheunderflowcheck; + +/* end DoReturnSingle */ + /* End of Halfword operand from stack instruction - DoReturnSingle */ +/* start callindirect */ + + /* Fullword instruction - callindirect */ +#ifdef TRACING +#endif + +callindirect: + if (_trace) printf("callindirect:\n"); + +callindirectprefetch: + if (_trace) printf("callindirectprefetch:\n"); + /* Get operand */ + arg2 = (u32)arg3; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* No extra arg */ + arg3 = zero; + /* Memory Read Internal */ + +g6247: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6249; + +g6248: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6251; + +g6258: + t5 = arg5 - Type_CompiledFunction; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto startcallagain; + arg5 = Type_EvenPC; + t7 = *((s32 *)(&processor->continuation)+1); + /* prepare to push continuation/control register */ + iSP = iSP + 16; + t3 = *(s32 *)&processor->control; + t6 = Type_Fixnum+0xC0; + t8 = *(s32 *)&processor->continuation; + t5 = (64) << 16; + /* Set CDR code 3 */ + t7 = t7 | 192; + /* push continuation */ + *(u32 *)(iSP + -8) = t8; + /* write the stack cache */ + *(u32 *)(iSP + -4) = t7; + /* Set call started bit in CR */ + t8 = t3 | t5; + t5 = zero + 256; + /* Push control register */ + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t6; + /* Clear the extra arg bit */ + t8 = t8 & ~t5; + /* Save control with new state */ + *(u32 *)&processor->control = t8; + /* End of push-frame */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u32 *)&processor->continuation = arg6; + *((u32 *)(&processor->continuation)+1) = arg5; + *(u64 *)&processor->continuationcp = zero; + if (arg3 != 0) + goto callindirectextra; + goto cachevalid; + +callindirectextra: + if (_trace) printf("callindirectextra:\n"); + t1 = *(s32 *)&processor->control; + t2 = zero + 256; + /* set CDR-NEXT */ + t3 = arg3 & 63; + /* Push the extra arg. */ + *(u32 *)(iSP + 8) = arg4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t3; + iSP = iSP + 8; + /* Set the extra arg bit */ + t1 = t1 | t2; + /* Save control with new state */ + *(u32 *)&processor->control = t1; + goto cachevalid; + +g6251: + if (_trace) printf("g6251:\n"); + if ((t7 & 1) == 0) + goto g6250; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6247; + +g6250: + if (_trace) printf("g6250:\n"); + +g6249: + if (_trace) printf("g6249:\n"); + r0 = (u64)&&return0001; + goto memoryreaddatadecode; +return0001: + goto g6258; + +/* end callindirect */ + /* End of Fullword instruction - callindirect */ +/* start DoFinishCallN */ + + /* Halfword 10 bit immediate instruction - DoFinishCallN */ + +dofinishcalln: + if (_trace) printf("dofinishcalln:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoFinishCallNIM: + if (_trace) printf("DoFinishCallNIM:\n"); + +DoFinishCallNSP: + if (_trace) printf("DoFinishCallNSP:\n"); + +DoFinishCallNLP: + if (_trace) printf("DoFinishCallNLP:\n"); + +DoFinishCallNFP: + if (_trace) printf("DoFinishCallNFP:\n"); + /* arg1 has operand preloaded. */ + /* arg2 contains the 8 bit N+1 */ + /* arg1 contains the disposition (two bits) */ + arg1 = (u8)(arg3 >> ((5&7)*8)); + /* convert N to words (stacked words that is) */ + arg2 = (arg2 * 8) + zero; + +finishcallmerge: + if (_trace) printf("finishcallmerge:\n"); + arg3 = arg3 >> 7; + /* Current stack cache limit (words) */ + t6 = *(s32 *)&processor->scovlimit; + t3 = zero + 128; + /* Alpha base of stack cache */ + t4 = *(u64 *)&(processor->stackcachedata); + /* SCA of desired end of cache */ + t3 = (t3 * 8) + iSP; + /* SCA of current end of cache */ + t4 = (t6 * 8) + t4; + t6 = ((s64)t3 <= (s64)t4) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t6 == 0) + goto g6267; + /* 0 if not apply, 8 if apply */ + arg3 = arg3 & 8; + /* Get the control register */ + t1 = *(s32 *)&processor->control; + /* Compute the new LP */ + /* Assume not Apply case. */ + iLP = iSP + 8; + /* For apply, iLP==iSP */ + iLP = iLP - arg3; + /* Compute the new FP */ + /* extra arg bit<<3 */ + t3 = t1 >> 5; + t2 = iSP - arg2; + /* 8 if extra arg, 0 otherwise. */ + t3 = t3 & 8; + /* This! is the new frame pointer! */ + t2 = t2 - t3; + /* compute arg size */ + t4 = iLP - t2; + /* arg size in words. */ + t4 = t4 >> 3; + /* compute caller frame size. */ + t5 = t2 - iFP; + /* caller frame size in words. */ + t5 = t5 >> 3; + /* Now hack the control register! */ + /* Get value disposition into place */ + t7 = arg1 << 18; + /* cr.caller-frame-size */ + t6 = *(u64 *)&(processor->fccrmask); + /* Shift caller frame size into place */ + t5 = t5 << 9; + /* Add arg size to new bits. */ + t7 = t7 | t4; + /* Apply bit in place */ + t4 = arg3 << 14; + /* Add frame size to new bits */ + t7 = t5 | t7; + /* All new bits assembled! */ + t7 = t4 | t7; + /* Set the return continuation. */ + /* Next instruction hw format */ + t5 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Mask off unwanted bits */ + t1 = t1 & t6; + /* Get the new PC tag/data */ + t4 = *(s32 *)&processor->continuation; + /* Add argsize, apply, disposition, caller FS */ + t1 = t1 | t7; + t3 = *((s32 *)(&processor->continuation)+1); + /* Update the PC */ + /* Convert PC to a real continuation. */ + t6 = t5 & 1; + /* convert PC to a real word address. */ + t7 = t5 >> 1; + t6 = t6 + Type_EvenPC; + t4 = (u32)t4; + /* Convert real continuation to PC. */ + iPC = t3 & 1; + iPC = t4 + iPC; + iPC = t4 + iPC; + *(u32 *)&processor->continuation = t7; + /* Set return address */ + *((u32 *)(&processor->continuation)+1) = t6; + /* Update CP */ + t7 = (4096) << 16; + t5 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t7 = t7 & t1; + /* Shift into trace pending place */ + t7 = t7 >> 1; + *(u64 *)&processor->continuationcp = t5; + /* Set the cr.trace pending if appropriate. */ + t1 = t1 | t7; + /* Set the control register */ + *(u32 *)&processor->control = t1; + /* Install the new frame pointer */ + iFP = t2; + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); + /* Check for stack overflow */ + /* Isolate trap mode */ + t1 = t1 >> 30; + /* Limit for emulator mode */ + t3 = *(s32 *)&processor->cslimit; + /* Limit for extra stack and higher modes */ + t4 = *(s32 *)&processor->csextralimit; + /* Get the right limit for the current trap mode */ + if (t1) + t3 = t4; + /* Might have been sign extended */ + t3 = (u32)t3; + /* Convert stack cache address to VMA */ + t4 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t4 = iSP - t4; + /* convert byte address to word address */ + t4 = t4 >> 3; + /* reconstruct VMA */ + t1 = t4 + t1; + /* Check for overflow */ + t4 = ((s64)t1 < (s64)t3) ? 1 : 0; + /* Jump if overflow */ + if (t4 == 0) + goto stackoverflow; + if (arg2 != 0) + goto interpretinstructionpredicted; + /* Begin execution at the computed address */ + goto interpretinstructionforbranch; + +g6267: + if (_trace) printf("g6267:\n"); + arg2 = 0; + goto stackcacheoverflowhandler; + +/* end DoFinishCallN */ + /* End of Halfword operand from stack instruction - DoFinishCallN */ +/* start DoEntryRestNotAccepted */ + + /* Field Extraction instruction - DoEntryRestNotAccepted */ + +doentryrestnotaccepted: + if (_trace) printf("doentryrestnotaccepted:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoEntryRestNotAcceptedIM: + if (_trace) printf("DoEntryRestNotAcceptedIM:\n"); + +DoEntryRestNotAcceptedSP: + if (_trace) printf("DoEntryRestNotAcceptedSP:\n"); + +DoEntryRestNotAcceptedLP: + if (_trace) printf("DoEntryRestNotAcceptedLP:\n"); + +DoEntryRestNotAcceptedFP: + if (_trace) printf("DoEntryRestNotAcceptedFP:\n"); + /* The control register */ + arg5 = *(s32 *)&processor->control; + /* Pull down the number of optionals */ + arg4 = arg3 >> 18; + /* Extract the 'ptr' field while we are waiting */ + arg1 = (u8)(arg3 >> ((5&7)*8)); + arg4 = arg4 & 255; + /* arg1=ptr field, arg2=required, arg3=instn, arg4=optionals arg5=control-register */ + /* Get the cr.trace-pending bit */ + t2 = arg5 >> 27; + /* The supplied args */ + t1 = arg5 & 255; + if (t2 & 1) + goto tracetrap; + t3 = arg5 >> 17; + /* Get the tag of the stack top. */ + t4 = *(s32 *)(iSP + 4); + +g6278: + if (_trace) printf("g6278:\n"); + /* J. if apply args */ + if (t3 & 1) + goto g6276; + +g6277: + /* t2=supplied-minimum */ + t2 = t1 - arg2; + /* B. if too few args. */ + if ((s64)t2 < 0) + goto retryernatoofew; + /* maximum-supplied */ + arg1 = arg4 - t1; + /* B. if too many args. */ + if ((s64)arg1 < 0) + goto retryernatoomany; + /* Compute entry position and advance PC/CP accordingly. */ + /* get the next PC */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Adjust index to halfword */ + t3 = t2 << 1; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* J. if index zero, no adjustment. */ + if (t2 == 0) + goto INTERPRETINSTRUCTION; + /* Compute the new address */ + iPC = iPC + t3; + /* Make it an DTP-EVEN-PC */ + iPC = iPC & ~1L; + goto interpretinstructionforjump; + +applysupprna: + if (_trace) printf("applysupprna:\n"); + arg1 = arg4 - t1; + /* B. if too many args. */ + if ((s64)arg1 <= 0) + goto retryernatoomany; + goto pullapplyargs; + +retryernatoomany: + if (_trace) printf("retryernatoomany:\n"); + arg5 = 0; + arg2 = 78; + goto illegaloperand; + +retryernatoofew: + if (_trace) printf("retryernatoofew:\n"); + arg5 = 0; + arg2 = 77; + goto illegaloperand; + +g6276: + if (_trace) printf("g6276:\n"); + t4 = t4 & 63; + t4 = t4 - Type_NIL; + /* J. if apply args supplied not nil. */ + if (t4 != 0) + goto applysupprna; + /* keep just the apply bit! */ + t3 = t3 & 1; + /* reposition the apply bit */ + t3 = t3 << 17; + /* Pop off the null applied arg. */ + iSP = iSP - 8; + /* Blast the apply arg bit away */ + arg5 = arg5 & ~t3; + /* Reset the stored cr bit */ + *(u32 *)&processor->control = arg5; + goto g6277; + +/* end DoEntryRestNotAccepted */ + /* End of Halfword operand from stack instruction - DoEntryRestNotAccepted */ +/* start VerifyGenericArity */ + + +verifygenericarity: + if (_trace) printf("verifygenericarity:\n"); + t11 = (2) << 16; + t11 = t11 & arg2; + /* not applying */ + if (t11 == 0) + goto g6287; + /* 4 - argsize */ + arg1 = zero - arg5; + goto pullapplyargs; + +g6287: + if (_trace) printf("g6287:\n"); + arg5 = 0; + arg2 = 77; + goto illegaloperand; + +/* end VerifyGenericArity */ +/* start PullApplyArgs */ + + +pullapplyargs: + if (_trace) printf("pullapplyargs:\n"); + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + t2 = *(s32 *)iSP; + t1 = *(s32 *)(iSP + 4); + t2 = (u32)t2; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t5 = (t4 == Type_List) ? 1 : 0; + +g6316: + if (_trace) printf("g6316:\n"); + if (t5 == 0) + goto g6290; + /* Here if argument TypeList */ + /* Stack cache offset */ + t5 = t2 - arg5; + /* In range? */ + t6 = ((u64)t5 < (u64)arg6) ? 1 : 0; + t4 = *(u64 *)&(processor->stackcachedata); + /* J. if not in cache */ + if (t6 == 0) + goto g6288; + /* reconstruct SCA */ + t4 = (t5 * 8) + t4; + t7 = zero; + t5 = zero + 128; + /* Alpha base of stack cache */ + t6 = *(u64 *)&(processor->stackcachedata); + /* Account for what we're about to push */ + t5 = t5 + arg1; + /* SCA of desired end of cache */ + t5 = (t5 * 8) + iSP; + /* SCA of current end of cache */ + t6 = (arg6 * 8) + t6; + t10 = ((s64)t5 <= (s64)t6) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t10 == 0) + goto g6297; + /* Pop Stack. */ + iSP = iSP - 8; + goto g6296; + +g6291: + if (_trace) printf("g6291:\n"); + t9 = *(s32 *)t4; + t8 = *(s32 *)(t4 + 4); + t9 = (u32)t9; + t7 = t7 + 1; + t4 = t4 + 8; + /* Extract CDR code. */ + t5 = t8 & 192; + if (t5 != 0) + goto g6299; + /* Here if argument 0 */ + /* set CDR-NEXT */ + t5 = t8 & 63; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + t5 = (t7 == arg1) ? 1 : 0; + if (t5 == 0) + goto g6291; + goto g6292; + +g6299: + if (_trace) printf("g6299:\n"); + t6 = (t5 == 64) ? 1 : 0; + +g6311: + if (_trace) printf("g6311:\n"); + if (t6 == 0) + goto g6300; + /* Here if argument 64 */ + /* set CDR-NEXT */ + t5 = t8 & 63; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + +g6294: + if (_trace) printf("g6294:\n"); + t5 = *(s32 *)&processor->control; + /* Get current arg size. */ + t6 = t5 & 255; + t5 = t5 & ~255L; + t6 = t6 + t7; + /* Update the arg size */ + t5 = t6 + t5; + t6 = (2) << 16; + /* turn off cr.apply */ + t5 = t5 & ~t6; + *(u32 *)&processor->control = t5; + iLP = (t7 * 8) + iLP; + goto INTERPRETINSTRUCTION; + +g6300: + if (_trace) printf("g6300:\n"); + t6 = (t5 == 128) ? 1 : 0; + +g6312: + if (_trace) printf("g6312:\n"); + if (t6 == 0) + goto g6301; + /* Here if argument 128 */ + /* set CDR-NEXT */ + t5 = t8 & 63; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + t11 = *(s32 *)t4; + t10 = *(s32 *)(t4 + 4); + t11 = (u32)t11; + /* Strip off any CDR code bits. */ + t5 = t10 & 63; + t6 = (t5 == Type_List) ? 1 : 0; + +g6307: + if (_trace) printf("g6307:\n"); + if (t6 == 0) + goto g6303; + /* Here if argument TypeList */ + /* Stack cache offset */ + t5 = t11 - arg5; + /* In range? */ + t6 = ((u64)t5 < (u64)arg6) ? 1 : 0; + t4 = *(u64 *)&(processor->stackcachedata); + /* J. if not in cache */ + if (t6 == 0) + goto g6293; + /* reconstruct SCA */ + t4 = (t5 * 8) + t4; + goto g6296; + +g6303: + if (_trace) printf("g6303:\n"); + t6 = (t5 == Type_NIL) ? 1 : 0; + +g6308: + if (_trace) printf("g6308:\n"); + if (t6 == 0) + goto g6304; + /* Here if argument TypeNIL */ + goto g6294; + +g6304: + if (_trace) printf("g6304:\n"); + /* Here for all other cases */ + +g6293: + if (_trace) printf("g6293:\n"); + /* set CDR-NEXT */ + t5 = t10 & 63; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto g6295; + +g6302: + if (_trace) printf("g6302:\n"); + +g6301: + if (_trace) printf("g6301:\n"); + /* Here for all other cases */ + t7 = t7 - 1; + t4 = t4 - 8; + goto g6292; + +g6298: + if (_trace) printf("g6298:\n"); + +g6296: + t5 = (t7 == arg1) ? 1 : 0; + if (t5 == 0) + goto g6291; + +g6292: + if (_trace) printf("g6292:\n"); + /* Here if count=n, or bad cdr */ + /* Convert stack cache address to VMA */ + t5 = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t5 = t4 - t5; + /* convert byte address to word address */ + t5 = t5 >> 3; + /* reconstruct VMA */ + t9 = t5 + arg5; + t5 = Type_List; + *(u32 *)(iSP + 8) = t9; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + +g6295: + if (_trace) printf("g6295:\n"); + t5 = *(s32 *)&processor->control; + /* Get current arg size. */ + t6 = t5 & 255; + t5 = t5 & ~255L; + t6 = t6 + t7; + /* Update the arg size */ + t5 = t6 + t5; + *(u32 *)&processor->control = t5; + iLP = (t7 * 8) + iLP; + arg1 = arg1 - t7; + if ((s64)arg1 <= 0) + goto INTERPRETINSTRUCTION; + goto pullapplyargsslowly; + +g6290: + if (_trace) printf("g6290:\n"); + t5 = (t4 == Type_NIL) ? 1 : 0; + +g6317: + if (_trace) printf("g6317:\n"); + if (t5 == 0) + goto g6313; + /* Here if argument TypeNIL */ + /* Get the control register */ + t6 = *(s32 *)&processor->control; + t7 = (2) << 16; + /* Discard that silly nil */ + iSP = iSP - 8; + /* Blast away the apply arg bit. */ + t6 = t6 & ~t7; + *(u32 *)&processor->control = t6; + goto INTERPRETINSTRUCTION; + +g6313: + if (_trace) printf("g6313:\n"); + /* Here for all other cases */ + /* Pull apply args trap needs nargs in ARG1 */ + arg1 = arg1; + goto pullapplyargstrap; + +g6288: + if (_trace) printf("g6288:\n"); + arg1 = arg1; + goto pullapplyargsslowly; + +g6289: + if (_trace) printf("g6289:\n"); + +g6297: + if (_trace) printf("g6297:\n"); + arg2 = arg1; + goto stackcacheoverflowhandler; + +/* end PullApplyArgs */ +/* start valuecell */ + + /* Fullword instruction - valuecell */ +#ifdef TRACING +#endif + +valuecell: + if (_trace) printf("valuecell:\n"); + /* Get address */ + arg2 = (u32)arg3; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g6318: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6320; + +g6319: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6322; + +g6329: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* set CDR-NEXT */ + t3 = arg5 & 63; + /* Push the result */ + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t3; + iSP = iSP + 8; + goto cachevalid; + +g6322: + if (_trace) printf("g6322:\n"); + if ((t7 & 1) == 0) + goto g6321; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6318; + +g6321: + if (_trace) printf("g6321:\n"); + +g6320: + if (_trace) printf("g6320:\n"); + r0 = (u64)&&return0002; + goto memoryreaddatadecode; +return0002: + goto g6329; + +/* end valuecell */ + /* End of Fullword instruction - valuecell */ +/* start pushconstantvalue */ + + /* Fullword instruction - pushconstantvalue */ +#ifdef TRACING +#endif + +pushconstantvalue: + if (_trace) printf("pushconstantvalue:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)(iSP + 8) = arg3; + iSP = iSP + 8; + goto cachevalid; + +/* end pushconstantvalue */ + /* End of Fullword instruction - pushconstantvalue */ +/* start DoZerop */ + + /* Halfword operand from stack instruction - DoZerop */ + /* arg2 has the preloaded 8 bit operand. */ + +dozerop: + if (_trace) printf("dozerop:\n"); +#ifdef TRACING +#endif + +DoZeropSP: + if (_trace) printf("DoZeropSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindozerop; +#endif + +DoZeropLP: + if (_trace) printf("DoZeropLP:\n"); +#ifdef TRACING + goto begindozerop; +#endif + +DoZeropFP: + if (_trace) printf("DoZeropFP:\n"); + +begindozerop: + if (_trace) printf("begindozerop:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + t6 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + t1 = *(s32 *)(arg1 + 4); + t12 = *(u64 *)&(processor->taddress); + t2 = *(s32 *)arg1; + LDS(1, f1, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t5 = (t4 == Type_Fixnum) ? 1 : 0; + +g6335: + if (_trace) printf("g6335:\n"); + if (t5 == 0) + goto g6331; + /* Here if argument TypeFixnum */ + iPC = t6; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if predicate succeeds */ + if (t2 == 0) + t11 = t12; + *(u64 *)(iSP + 8) = t11; + iSP = iSP + 8; + goto cachevalid; + +g6331: + if (_trace) printf("g6331:\n"); + t5 = (t4 == Type_SingleFloat) ? 1 : 0; + +g6336: + if (_trace) printf("g6336:\n"); + if (t5 == 0) + goto g6332; + /* Here if argument TypeSingleFloat */ + iPC = t6; + *(u64 *)(iSP + 8) = t12; + iSP = iSP + 8; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + if (FLTU64(1, f1) == 0.0) + goto cachevalid; + /* Didn't branch, answer is NIL */ + *(u64 *)iSP = t11; + goto cachevalid; + +g6332: + if (_trace) printf("g6332:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 1; + goto unarynumericexception; + +g6330: + if (_trace) printf("g6330:\n"); +#ifdef TRACING + goto DoZeropIM; +#endif + +DoZeropIM: + if (_trace) printf("DoZeropIM:\n"); + t2 = *(u64 *)&(processor->taddress); + iSP = iSP + 8; + t1 = *(u64 *)&(processor->niladdress); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + if (arg2 == 0) + t1 = t2; + /* yes Virginia, we dual issue with above yahoo */ + *(u64 *)iSP = t1; + goto cachevalid; + +/* end DoZerop */ + /* End of Halfword operand from stack instruction - DoZerop */ +/* start DoSetSpToAddress */ + + /* Halfword operand from stack instruction - DoSetSpToAddress */ + /* arg2 has the preloaded 8 bit operand. */ + +dosetsptoaddress: + if (_trace) printf("dosetsptoaddress:\n"); +#ifdef TRACING +#endif + +DoSetSpToAddressSP: + if (_trace) printf("DoSetSpToAddressSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindosetsptoaddress; +#endif + +DoSetSpToAddressLP: + if (_trace) printf("DoSetSpToAddressLP:\n"); +#ifdef TRACING + goto begindosetsptoaddress; +#endif + +DoSetSpToAddressFP: + if (_trace) printf("DoSetSpToAddressFP:\n"); + +begindosetsptoaddress: + if (_trace) printf("begindosetsptoaddress:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Set iSP=address of operand */ + iSP = arg1; + goto cachevalid; +#ifdef TRACING +#endif + +DoSetSpToAddressIM: + goto doistageerror; + +/* end DoSetSpToAddress */ + /* End of Halfword operand from stack instruction - DoSetSpToAddress */ +/* start DoEq */ + + /* Halfword operand from stack instruction - DoEq */ + /* arg2 has the preloaded 8 bit operand. */ + +doeq: + if (_trace) printf("doeq:\n"); +#ifdef TRACING +#endif + +DoEqSP: + if (_trace) printf("DoEqSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindoeq; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindoeq; +#endif + +DoEqLP: + if (_trace) printf("DoEqLP:\n"); +#ifdef TRACING + goto begindoeq; +#endif + +DoEqFP: + if (_trace) printf("DoEqFP:\n"); + +begindoeq: + if (_trace) printf("begindoeq:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + arg3 = arg3 >> 12; + t12 = *(u64 *)&(processor->taddress); + /* load op2 */ + arg1 = *(u64 *)arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* 1 if no-pop, 0 if pop */ + arg3 = arg3 & 1; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* compare tag and data */ + t3 = arg6 ^ arg1; + /* shift off the cdr code */ + t3 = t3 << 26; + /* Either a stack-push or a stack-write */ + iSP = (arg3 * 8) + iSP; + /* pick up T or NIL */ + if (t3 == 0) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +/* end DoEq */ + /* End of Halfword operand from stack instruction - DoEq */ +/* start DoAref1 */ + + /* Halfword operand from stack instruction - DoAref1 */ + /* arg2 has the preloaded 8 bit operand. */ + +doaref1: + if (_trace) printf("doaref1:\n"); +#ifdef TRACING +#endif + +DoAref1SP: + if (_trace) printf("DoAref1SP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto headdoaref1; + /* SP-pop mode, TOS->arg1 */ + arg1 = arg6; + /* Reload TOS */ + arg6 = *(u64 *)arg4; + /* Adjust SP */ + iSP = arg4; + goto begindoaref1; +#ifdef TRACING + goto headdoaref1; +#endif + +DoAref1LP: + if (_trace) printf("DoAref1LP:\n"); +#ifdef TRACING + goto headdoaref1; +#endif + +DoAref1FP: + if (_trace) printf("DoAref1FP:\n"); + +headdoaref1: + if (_trace) printf("headdoaref1:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoaref1: + if (_trace) printf("begindoaref1:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + arg3 = (u32)(arg6 >> ((4&7)*8)); + /* Get the array tag/data */ + arg4 = (u32)arg6; + /* (sign-extended, for fast bounds check) Index Data */ + arg2 = (s32)arg1 + (s32)0; + t8 = zero + AutoArrayRegMask; + t8 = arg4 & t8; + /* Index Tag */ + arg1 = arg1 >> 32; + t7 = (u64)&processor->ac0array; + /* This is the address if the array register block. */ + t7 = t7 + t8; + t1 = arg1 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto aref1illegal; + +aref1merge: + if (_trace) printf("aref1merge:\n"); + if (arg4 == 0) + goto aref1regset; + /* Cached array object. */ + t8 = *(u64 *)&(((ARRAYCACHEP)t7)->array); + t1 = arg3 - Type_Array; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto reallyaref1exc; + /* t8==1 iff cached array is ours. */ + t8 = (arg4 == t8) ? 1 : 0; + /* Go and setup the array register. */ + if (t8 == 0) + goto aref1regset; +#ifdef SLOWARRAYS + goto aref1regset; +#endif + arg6 = *(u64 *)&(((ARRAYCACHEP)t7)->arword); + /* high order bits all zero */ + t9 = *(u64 *)&(((ARRAYCACHEP)t7)->locat); + /* high order bits all zero */ + t3 = *(u64 *)&(((ARRAYCACHEP)t7)->length); + t5 = arg6 << 42; + t4 = *(u64 *)&(processor->areventcount); + t5 = t5 >> 42; + t2 = ((u64)arg2 < (u64)t3) ? 1 : 0; + t6 = t4 - t5; + /* J. if event count ticked. */ + if (t6 != 0) + goto aref1regset; + if (t2 == 0) + goto aref1bounds; + arg5 = arg6 >> (Array_RegisterBytePackingPos & 63); + arg4 = arg6 >> (Array_RegisterByteOffsetPos & 63); + t8 = arg6 >> (Array_RegisterElementTypePos & 63); + arg4 = arg4 & Array_RegisterByteOffsetMask; + arg5 = arg5 & Array_RegisterBytePackingMask; + arg6 = t8 & Array_RegisterElementTypeMask; + +aref1restart: + if (_trace) printf("aref1restart:\n"); + if (arg5 != 0) + goto g6345; + t1 = t9 + arg2; + +g6346: + if (_trace) printf("g6346:\n"); + /* Memory Read Internal */ + +g6353: + /* Base of stack cache */ + t2 = *(u64 *)&(processor->stackcachebasevma); + t5 = t1 + ivory; + t3 = *(s32 *)&processor->scovlimit; + t9 = (t5 * 4); + arg3 = LDQ_U(t5); + /* Stack cache offset */ + t2 = t1 - t2; + t6 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t3 = ((u64)t2 < (u64)t3) ? 1 : 0; + t9 = *(s32 *)t9; + arg3 = (u8)(arg3 >> ((t5&7)*8)); + if (t3 != 0) + goto g6355; + +g6354: + t5 = zero + 240; + t6 = t6 >> (arg3 & 63); + t5 = t5 >> (arg3 & 63); + t9 = (u32)t9; + if (t6 & 1) + goto g6357; + +g6364: + if (arg5 != 0) + goto g6347; + +g6348: + if (_trace) printf("g6348:\n"); + r31 = r31 | r31; + t1 = arg6 - 2; + if ((s64)t1 <= 0) + goto g6349; + /* TagType. */ + arg3 = arg3 & 63; + +g6350: + if (_trace) printf("g6350:\n"); + *(u32 *)(iSP + 4) = arg3; + t5 = (arg5 == 0) ? 1 : 0; + if (t5 == 0) + goto case_others_7; + +case_0_1: + if (_trace) printf("case_0_1:\n"); + r31 = r31 | r31; + if (t1 == 0) + goto g6351; + *(u32 *)iSP = t9; + goto NEXTINSTRUCTION; + +case_2_2: + if (_trace) printf("case_2_2:\n"); + /* AREF1-8B */ + r31 = r31 | r31; + t5 = arg2 & 3; + t6 = (u8)(t9 >> ((t5&7)*8)); + if (t1 == 0) + goto g6351; + *(u32 *)iSP = t6; + goto NEXTINSTRUCTION; + +case_3_3: + if (_trace) printf("case_3_3:\n"); + /* AREF1-4B */ + r31 = r31 | r31; + /* byte-index */ + t5 = arg2 & 7; + /* byte-position */ + t5 = t5 << 2; + /* byte in position */ + t6 = t9 >> (t5 & 63); + /* byte masked */ + t6 = t6 & 15; + if (t1 == 0) + goto g6351; + *(u32 *)iSP = t6; + goto NEXTINSTRUCTION; + +case_5_4: + if (_trace) printf("case_5_4:\n"); + /* AREF1-1B */ + r31 = r31 | r31; + /* byte-index */ + t5 = arg2 & 31; + r31 = r31 | r31; + /* byte in position */ + t6 = t9 >> (t5 & 63); + /* byte masked */ + t6 = t6 & 1; + if (t1 == 0) + goto g6351; + *(u32 *)iSP = t6; + goto NEXTINSTRUCTION; + +case_1_5: + if (_trace) printf("case_1_5:\n"); + /* AREF1-16B */ + t5 = arg2 & 1; + /* Bletch, it's a byte ref */ + t5 = t5 + t5; + t6 = (u16)(t9 >> ((t5&7)*8)); + if (t1 == 0) + goto g6351; + *(u32 *)iSP = t6; + goto NEXTINSTRUCTION; + +case_others_7: + if (_trace) printf("case_others_7:\n"); + r31 = r31 | r31; + t5 = (arg5 == 2) ? 1 : 0; + t6 = (arg5 == 3) ? 1 : 0; + if (t5 != 0) + goto case_2_2; + t5 = (arg5 == 5) ? 1 : 0; + if (t6 != 0) + goto case_3_3; + t6 = (arg5 == 1) ? 1 : 0; + if (t5 != 0) + goto case_5_4; + if (t6 != 0) + goto case_1_5; + +case_4_6: + if (_trace) printf("case_4_6:\n"); + /* AREF1-2B */ + r31 = r31 | r31; + /* byte-index */ + t5 = arg2 & 15; + /* byte-position */ + t5 = t5 << 1; + /* byte in position */ + t6 = t9 >> (t5 & 63); + /* byte masked */ + t6 = t6 & 3; + if (t1 == 0) + goto g6351; + *(u32 *)iSP = t6; + goto NEXTINSTRUCTION; + +g6345: + if (_trace) printf("g6345:\n"); + arg2 = arg4 + arg2; + /* Convert byte index to word index */ + t1 = arg2 >> (arg5 & 63); + /* Address of word containing byte */ + t1 = t1 + t9; + goto g6346; + +g6347: + if (_trace) printf("g6347:\n"); + t1 = arg3 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto g6352; + goto g6348; + +g6349: + if (_trace) printf("g6349:\n"); + arg3 = Type_Character; + if (arg6 & 1) + goto g6350; + arg3 = Type_Fixnum; + if (arg6 == 0) + goto g6350; + t2 = *(u64 *)&(processor->niladdress); + t3 = *(u64 *)&(processor->taddress); + goto g6350; + +g6351: + if (_trace) printf("g6351:\n"); + if (t6) + t2 = t3; + *(u64 *)iSP = t2; + goto NEXTINSTRUCTION; + +g6352: + if (_trace) printf("g6352:\n"); + arg5 = t1; + arg2 = 25; + goto illegaloperand; +#ifdef TRACING + goto DoAref1IM; +#endif + +DoAref1IM: + if (_trace) printf("DoAref1IM:\n"); + t8 = zero + AutoArrayRegMask; + /* Get the array tag/data */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + t7 = (u64)&processor->ac0array; + t8 = arg4 & t8; + /* This is the address of the array register block. */ + t7 = t7 + t8; + goto aref1merge; + +g6355: + if (_trace) printf("g6355:\n"); + t3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t2 = (t2 * 8) + t3; + t9 = *(s32 *)t2; + /* Read from stack cache */ + arg3 = *(s32 *)(t2 + 4); + goto g6354; + +g6357: + if (_trace) printf("g6357:\n"); + if ((t5 & 1) == 0) + goto g6356; + /* Do the indirect thing */ + t1 = (u32)t9; + goto g6353; + +g6356: + if (_trace) printf("g6356:\n"); + /* Load the memory action table for cycle */ + t6 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t5 = arg3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t5 = (t5 * 4) + t6; + /* Get the memory action */ + t6 = *(s32 *)t5; + +g6361: + if (_trace) printf("g6361:\n"); + t5 = t6 & MemoryActionTransform; + if (t5 == 0) + goto g6360; + arg3 = arg3 & ~63L; + arg3 = arg3 | Type_ExternalValueCellPointer; + goto g6364; +#ifndef MINIMA + +g6360: +#endif +#ifdef MINIMA + +g6360: + if (_trace) printf("g6360:\n"); + t5 = t6 & MemoryActionBinding; + t3 = *(u64 *)&(processor->dbcmask); + if (t5 == 0) + goto g6359; + t2 = t1 << 1; + t5 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t2 = t2 & t3; + t3 = 1; + t3 = t3 << (ivorymemorydata & 63); + t2 = (s32)t2 + (s32)t5; + /* Clear sign-extension */ + t2 = (u32)t2; + t3 = (t2 * 4) + t3; + /* Fetch the key */ + t2 = *(s32 *)t3; + /* Fetch value */ + t9 = *(s32 *)(t3 + 4); + /* Compare */ + t5 = (s32)t1 - (s32)t2; + /* Trap on miss */ + if (t5 != 0) + goto g6363; + /* Extract the pointer, and indirect */ + t1 = (u32)t9; + goto g6353; + +g6363: + if (_trace) printf("g6363:\n"); + goto dbcachemisstrap; +#endif + +g6359: + /* Perform memory action */ + arg1 = t6; + arg2 = 0; + goto performmemoryaction; + +/* end DoAref1 */ + /* End of Halfword operand from stack instruction - DoAref1 */ +/* start DoTypeMember */ + + /* Halfword 10 bit immediate instruction - DoTypeMember */ + +dotypemember: + if (_trace) printf("dotypemember:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoTypeMemberIM: + if (_trace) printf("DoTypeMemberIM:\n"); + +DoTypeMemberSP: + if (_trace) printf("DoTypeMemberSP:\n"); + +DoTypeMemberLP: + if (_trace) printf("DoTypeMemberLP:\n"); + +DoTypeMemberFP: + if (_trace) printf("DoTypeMemberFP:\n"); + /* arg1 has operand preloaded. */ + /* Position the opcode */ + t6 = arg3 >> 6; + t4 = *(u64 *)&(processor->taddress); + /* get op1's tag */ + arg4 = *(s32 *)(iSP + 4); + t1 = 1; + t5 = *(u64 *)&(processor->niladdress); + /* Get pop-bit while stalled */ + t7 = arg3 >> 12; + /* Get field-number*4 from the opcode */ + arg1 = t6 & 60; + /* TagType. */ + /* Strip off CDR code. */ + arg4 = arg4 & 63; + /* T1 is type type code bit position. */ + t1 = t1 << (arg4 & 63); + /* Pop bit */ + t7 = t7 & 1; + /* t2 is the mask. */ + t2 = arg2 << (arg1 & 63); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = (t7 * 8) + iSP; + /* t3 is the result. */ + t3 = t2 & t1; + +g6373: + if (_trace) printf("g6373:\n"); + if (t3) + t5 = t4; + *(u64 *)iSP = t5; + goto cachevalid; + +/* end DoTypeMember */ + /* End of Halfword operand from stack instruction - DoTypeMember */ +/* start DoPointerPlus */ + + /* Halfword operand from stack instruction - DoPointerPlus */ + /* arg2 has the preloaded 8 bit operand. */ + +dopointerplus: + if (_trace) printf("dopointerplus:\n"); +#ifdef TRACING +#endif + +DoPointerPlusSP: + if (_trace) printf("DoPointerPlusSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindopointerplus; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindopointerplus; +#endif + +DoPointerPlusLP: + if (_trace) printf("DoPointerPlusLP:\n"); +#ifdef TRACING + goto begindopointerplus; +#endif + +DoPointerPlusFP: + if (_trace) printf("DoPointerPlusFP:\n"); + +begindopointerplus: + if (_trace) printf("begindopointerplus:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Get the data of op2 */ + t2 = *(s32 *)arg1; + /* (%32-bit-plus (data arg1) (data arg2)) */ + t3 = (s32)arg6 + (s32)t2; + /* Put result back on the stack */ + *(u32 *)iSP = t3; + goto cachevalid; +#ifdef TRACING + goto DoPointerPlusIM; +#endif + +DoPointerPlusIM: + if (_trace) printf("DoPointerPlusIM:\n"); + t2 = arg2 << 56; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t2 = (s64)t2 >> 56; + +g6374: + if (_trace) printf("g6374:\n"); + /* (%32-bit-plus (data arg1) (data arg2)) */ + t3 = (s32)arg6 + (s32)t2; + /* Put result back on the stack */ + *(u32 *)iSP = t3; + goto cachevalid; + +/* end DoPointerPlus */ + /* End of Halfword operand from stack instruction - DoPointerPlus */ +/* start DoLdb */ + + /* Field Extraction instruction - DoLdb */ + +doldb: + if (_trace) printf("doldb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoLdbIM: + if (_trace) printf("DoLdbIM:\n"); + +DoLdbSP: + if (_trace) printf("DoLdbSP:\n"); + +DoLdbLP: + if (_trace) printf("DoLdbLP:\n"); + +DoLdbFP: + if (_trace) printf("DoLdbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + arg3 = (u32)(arg6 >> ((4&7)*8)); + /* get ARG1 tag/data */ + arg4 = (u32)arg6; + /* TagType. */ + t8 = arg3 & 63; + t9 = t8 - Type_Fixnum; + /* Shift ARG1 left to get new high bits */ + t3 = arg4 << (arg2 & 63); + /* Not a fixnum */ + if (t9 != 0) + goto ldbexception; + t7 = zero + -2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Get new low bits */ + t6 = (u32)(t3 >> ((4&7)*8)); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* Glue two parts of shifted operand together */ + t3 = t3 | t6; + /* T8 is TypeFixnum from above */ + *(u32 *)(iSP + 4) = t8; + /* T3= masked value. */ + t3 = t3 & ~t7; + *(u32 *)iSP = t3; + goto cachevalid; + +/* end DoLdb */ + /* End of Halfword operand from stack instruction - DoLdb */ +/* start DoSetSpToAddressSaveTos */ + + /* Halfword operand from stack instruction - DoSetSpToAddressSaveTos */ + /* arg2 has the preloaded 8 bit operand. */ + +dosetsptoaddresssavetos: + if (_trace) printf("dosetsptoaddresssavetos:\n"); +#ifdef TRACING +#endif + +DoSetSpToAddressSaveTosSP: + if (_trace) printf("DoSetSpToAddressSaveTosSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindosetsptoaddresssavetos; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindosetsptoaddresssavetos; +#endif + +DoSetSpToAddressSaveTosLP: + if (_trace) printf("DoSetSpToAddressSaveTosLP:\n"); +#ifdef TRACING + goto begindosetsptoaddresssavetos; +#endif + +DoSetSpToAddressSaveTosFP: + if (_trace) printf("DoSetSpToAddressSaveTosFP:\n"); + +begindosetsptoaddresssavetos: + if (_trace) printf("begindosetsptoaddresssavetos:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Set the stack top as specified. */ + iSP = arg1; + /* Restore the TOS. */ + *(u64 *)arg1 = arg6; + goto cachevalid; +#ifdef TRACING +#endif + +DoSetSpToAddressSaveTosIM: + goto doistageerror; + +/* end DoSetSpToAddressSaveTos */ + /* End of Halfword operand from stack instruction - DoSetSpToAddressSaveTos */ +/* start DoPop */ + + /* Halfword operand from stack instruction - DoPop */ + /* arg2 has the preloaded 8 bit operand. */ + +dopop: + if (_trace) printf("dopop:\n"); +#ifdef TRACING +#endif + +DoPopSP: + if (_trace) printf("DoPopSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindopop; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindopop; +#endif + +DoPopLP: + if (_trace) printf("DoPopLP:\n"); +#ifdef TRACING + goto begindopop; +#endif + +DoPopFP: + if (_trace) printf("DoPopFP:\n"); + +begindopop: + if (_trace) printf("begindopop:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Pop Stack. */ + iSP = iSP - 8; + /* Store all 40 bits on stack */ + *(u64 *)arg1 = arg6; + goto cachevalid; +#ifdef TRACING +#endif + +DoPopIM: + goto doistageerror; + +/* end DoPop */ + /* End of Halfword operand from stack instruction - DoPop */ +/* start DoMovem */ + + /* Halfword operand from stack instruction - DoMovem */ + /* arg2 has the preloaded 8 bit operand. */ + +domovem: + if (_trace) printf("domovem:\n"); +#ifdef TRACING +#endif + +DoMovemSP: + if (_trace) printf("DoMovemSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindomovem; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindomovem; +#endif + +DoMovemLP: + if (_trace) printf("DoMovemLP:\n"); +#ifdef TRACING + goto begindomovem; +#endif + +DoMovemFP: + if (_trace) printf("DoMovemFP:\n"); + +begindomovem: + if (_trace) printf("begindomovem:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Store all 40 bits of TOS on stack */ + *(u64 *)arg1 = arg6; + goto cachevalid; +#ifdef TRACING +#endif + +DoMovemIM: + goto doistageerror; + +/* end DoMovem */ + /* End of Halfword operand from stack instruction - DoMovem */ +/* start DoPushAddress */ + + /* Halfword operand from stack instruction - DoPushAddress */ + /* arg2 has the preloaded 8 bit operand. */ + +dopushaddress: + if (_trace) printf("dopushaddress:\n"); +#ifdef TRACING +#endif + +DoPushAddressSP: + if (_trace) printf("DoPushAddressSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindopushaddress; +#endif + +DoPushAddressLP: + if (_trace) printf("DoPushAddressLP:\n"); +#ifdef TRACING + goto begindopushaddress; +#endif + +DoPushAddressFP: + if (_trace) printf("DoPushAddressFP:\n"); + +begindopushaddress: + if (_trace) printf("begindopushaddress:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = arg1 - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t3 = Type_Locative; + *(u32 *)(iSP + 8) = t1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t3; + iSP = iSP + 8; + goto cachevalid; +#ifdef TRACING +#endif + +DoPushAddressIM: + goto doistageerror; + +/* end DoPushAddress */ + /* End of Halfword operand from stack instruction - DoPushAddress */ +/* start DoMemoryRead */ + + /* Halfword 10 bit immediate instruction - DoMemoryRead */ + +domemoryread: + if (_trace) printf("domemoryread:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoMemoryReadIM: + if (_trace) printf("DoMemoryReadIM:\n"); + +DoMemoryReadSP: + if (_trace) printf("DoMemoryReadSP:\n"); + +DoMemoryReadLP: + if (_trace) printf("DoMemoryReadLP:\n"); + +DoMemoryReadFP: + if (_trace) printf("DoMemoryReadFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + /* Low bit clear if memory-read, set if memory-read-address */ + t1 = arg3 >> 10; + /* T2 = fixnum check */ + t2 = arg1 & 32; + /* T3 = reset CDR code */ + t3 = arg1 & 16; + /* arg3 = cycle type */ + arg3 = arg1 >> 6; + arg1 = (u32)(arg6 >> ((4&7)*8)); + /* Get tag/data */ + arg2 = (u32)arg6; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g6391: + t7 = arg2 + ivory; + /* Cycle-number -> table offset */ + t8 = (arg3 * 4); + arg5 = LDQ_U(t7); + t8 = (t8 * 4) + ivory; + arg6 = (t7 * 4); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)(t8 + PROCESSORSTATE_DATAREAD_MASK); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6393; + +g6392: + t8 = t8 >> (arg5 & 63); + if (t8 & 1) + goto g6395; + +g6402: + /* J. if no check for fixnum. */ + if (t2 == 0) + goto mrdataok; + t5 = arg5 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto mrnotfixnum; + +mrdataok: + if (_trace) printf("mrdataok:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Get original tag if memory-read-address */ + if (t1 & 1) + arg5 = arg1; + /* J. if no reset CDR code */ + if (t3 == 0) + goto mrcdrunch; + /* TagType. */ + arg5 = arg5 & 63; + +mrcdrunch: + if (_trace) printf("mrcdrunch:\n"); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Get forwarded address if memory-read-address */ + if (t1 & 1) + arg6 = arg2; + *(u32 *)iSP = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 4) = arg5; + goto cachevalid; + +mrnotfixnum: + if (_trace) printf("mrnotfixnum:\n"); + arg5 = 0; + arg2 = 5; + goto illegaloperand; + +g6395: + if (_trace) printf("g6395:\n"); + +g6393: + if (_trace) printf("g6393:\n"); + r0 = (u64)&&return0003; + goto memoryreadgeneraldecode; +return0003: + goto g6402; + +/* end DoMemoryRead */ + /* End of Halfword operand from stack instruction - DoMemoryRead */ +/* start DoBranch */ + + /* Halfword 10 bit immediate instruction - DoBranch */ + +dobranch: + if (_trace) printf("dobranch:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchIM: + if (_trace) printf("DoBranchIM:\n"); + +DoBranchSP: + if (_trace) printf("DoBranchSP:\n"); + +DoBranchLP: + if (_trace) printf("DoBranchLP:\n"); + +DoBranchFP: + if (_trace) printf("DoBranchFP:\n"); + arg1 = (s64)arg3 >> 48; + /* arg1 has signed operand preloaded. */ +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranch */ + /* End of Halfword operand from stack instruction - DoBranch */ +/* start DoGenericDispatch */ + + /* Halfword operand from stack instruction - DoGenericDispatch */ + /* arg2 has the preloaded 8 bit operand. */ + +dogenericdispatch: + if (_trace) printf("dogenericdispatch:\n"); +#ifdef TRACING +#endif + +DoGenericDispatchSP: + if (_trace) printf("DoGenericDispatchSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindogenericdispatch; +#endif + +DoGenericDispatchLP: + if (_trace) printf("DoGenericDispatchLP:\n"); +#ifdef TRACING + goto begindogenericdispatch; +#endif + +DoGenericDispatchFP: + if (_trace) printf("DoGenericDispatchFP:\n"); + +begindogenericdispatch: + if (_trace) printf("begindogenericdispatch:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + arg2 = *(s32 *)&processor->control; + /* get generic tag and data */ + arg1 = *(s32 *)(iFP + 20); + t1 = *(s32 *)(iFP + 16); + /* get number of arguments */ + arg5 = arg2 & 255; + /* get instance tag and data */ + arg3 = *(s32 *)(iFP + 28); + arg4 = *(s32 *)(iFP + 24); + /* done if 2 or more arguments (plus 2 extra words) */ + arg5 = arg5 - 4; + if ((s64)arg5 < 0) + goto verifygenericarity; + t1 = (u32)t1; + arg4 = (u32)arg4; + r0 = (u64)&&return0004; + goto lookuphandler; +return0004: + t3 = t4 - Type_EvenPC; + /* Strip CDR code, low bits */ + t3 = t3 & 62; + if (t3 != 0) + goto g6404; + /* Strip CDR code */ + t3 = t6 & 63; + t3 = t3 - Type_NIL; + if (t3 == 0) + goto g6403; + *(u32 *)(iFP + 16) = t7; + /* write the stack cache */ + *(u32 *)(iFP + 20) = t6; + +g6403: + if (_trace) printf("g6403:\n"); + /* Convert real continuation to PC. */ + iPC = t4 & 1; + iPC = t9 + iPC; + iPC = t9 + iPC; + goto interpretinstructionforjump; + +g6404: + if (_trace) printf("g6404:\n"); + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t3 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = iSP - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t3 = t2 + t3; + arg5 = t3; + arg2 = 37; + goto illegaloperand; +#ifdef TRACING +#endif + +DoGenericDispatchIM: + goto doistageerror; + +/* end DoGenericDispatch */ + /* End of Halfword operand from stack instruction - DoGenericDispatch */ +/* start LookupHandler */ + + +lookuphandler: + if (_trace) printf("lookuphandler:\n"); + sp = sp + -8; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + t5 = arg3 - Type_Instance; + /* Strip CDR code, low bits */ + t5 = t5 & 60; + if (t5 != 0) + goto g6408; + /* Don't clobber instance if it's forwarded */ + arg2 = arg4; + /* Memory Read Internal */ + +g6409: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6411; + +g6410: + t7 = zero + 64; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6413; + +g6418: + +g6407: + if (_trace) printf("g6407:\n"); + arg2 = arg6; + /* Memory Read Internal */ + +g6419: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6421; + +g6420: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6423; + +g6430: + t2 = arg6; + t5 = arg5 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g6405; + arg2 = arg2 + 1; + /* Memory Read Internal */ + +g6431: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6433; + +g6432: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6435; + +g6442: + t3 = arg6; + t5 = arg5 - Type_Locative; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g6406; + arg2 = t2 & t1; + t5 = arg2 << 1; + /* (* (logand mask data) 3) */ + arg4 = arg2 + t5; + /* TagType. */ + arg1 = arg1 & 63; + +g6444: + if (_trace) printf("g6444:\n"); + arg2 = t3 + arg4; + arg4 = arg4 + 3; + /* Read key */ + /* Memory Read Internal */ + +g6445: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6447; + +g6446: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6449; + +g6456: + /* TagType. */ + arg5 = arg5 & 63; + t5 = (arg5 == Type_NIL) ? 1 : 0; + if (t5 != 0) + goto g6443; + t5 = (arg1 == arg5) ? 1 : 0; + if (t5 == 0) + goto g6444; + t5 = (s32)t1 - (s32)arg6; + if (t5 != 0) + goto g6444; + +g6443: + if (_trace) printf("g6443:\n"); + /* Read method */ + arg2 = arg2 + 1; + /* Memory Read Internal */ + +g6457: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6459; + +g6458: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6461; + +g6468: + t4 = arg5; + arg3 = arg6; + /* Read parameter */ + arg2 = arg2 + 1; + /* Memory Read Internal */ + +g6469: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6471; + +g6470: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6473; + +g6480: + t6 = arg5; + t7 = arg6; + t9 = arg3; + sp = sp + 8; + goto *r0; /* ret */ + +g6473: + if (_trace) printf("g6473:\n"); + if ((t7 & 1) == 0) + goto g6472; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6469; + +g6472: + if (_trace) printf("g6472:\n"); + +g6471: + if (_trace) printf("g6471:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0005; + goto memoryreaddatadecode; +return0005: + r0 = *(u64 *)sp; + goto g6480; + +g6461: + if (_trace) printf("g6461:\n"); + if ((t7 & 1) == 0) + goto g6460; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6457; + +g6460: + if (_trace) printf("g6460:\n"); + +g6459: + if (_trace) printf("g6459:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0006; + goto memoryreaddatadecode; +return0006: + r0 = *(u64 *)sp; + goto g6468; + +g6449: + if (_trace) printf("g6449:\n"); + if ((t7 & 1) == 0) + goto g6448; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6445; + +g6448: + if (_trace) printf("g6448:\n"); + +g6447: + if (_trace) printf("g6447:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0007; + goto memoryreaddatadecode; +return0007: + r0 = *(u64 *)sp; + goto g6456; + +g6435: + if (_trace) printf("g6435:\n"); + if ((t7 & 1) == 0) + goto g6434; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6431; + +g6434: + if (_trace) printf("g6434:\n"); + +g6433: + if (_trace) printf("g6433:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0008; + goto memoryreaddatadecode; +return0008: + r0 = *(u64 *)sp; + goto g6442; + +g6423: + if (_trace) printf("g6423:\n"); + if ((t7 & 1) == 0) + goto g6422; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6419; + +g6422: + if (_trace) printf("g6422:\n"); + +g6421: + if (_trace) printf("g6421:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0009; + goto memoryreaddatadecode; +return0009: + r0 = *(u64 *)sp; + goto g6430; + +g6413: + if (_trace) printf("g6413:\n"); + if ((t7 & 1) == 0) + goto g6412; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6409; + +g6412: + if (_trace) printf("g6412:\n"); + +g6411: + if (_trace) printf("g6411:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0010; + goto memoryreadheaderdecode; +return0010: + r0 = *(u64 *)sp; + goto g6418; + +g6408: + if (_trace) printf("g6408:\n"); + /* not an instance, flavor description comes from magic vector */ + arg2 = *(u64 *)&(processor->trapvecbase); + /* TagType. */ + t5 = arg3 & 63; + arg2 = arg2 + 2560; + arg2 = t5 + arg2; + /* Memory Read Internal */ + +g6481: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6483; + +g6482: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6485; + goto g6407; + +g6405: + if (_trace) printf("g6405:\n"); + arg5 = arg2; + arg2 = 34; + goto illegaloperand; + +g6406: + if (_trace) printf("g6406:\n"); + arg5 = arg2; + arg2 = 35; + goto illegaloperand; + +g6485: + if (_trace) printf("g6485:\n"); + if ((t7 & 1) == 0) + goto g6484; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6481; + +g6484: + if (_trace) printf("g6484:\n"); + +g6483: + if (_trace) printf("g6483:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0011; + goto memoryreaddatadecode; +return0011: + r0 = *(u64 *)sp; + goto g6407; + +/* end LookupHandler */ +/* start DoSetTag */ + + /* Halfword operand from stack instruction - DoSetTag */ + /* arg2 has the preloaded 8 bit operand. */ + +dosettag: + if (_trace) printf("dosettag:\n"); +#ifdef TRACING +#endif + +DoSetTagSP: + if (_trace) printf("DoSetTagSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindosettag; +#endif + +DoSetTagLP: + if (_trace) printf("DoSetTagLP:\n"); +#ifdef TRACING + goto begindosettag; +#endif + +DoSetTagFP: + if (_trace) printf("DoSetTagFP:\n"); + +begindosettag: + if (_trace) printf("begindosettag:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get tag/data of op2 */ + t1 = *(s32 *)(arg1 + 4); + arg2 = *(s32 *)arg1; + t3 = t1 - Type_Fixnum; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto settagexc; +#ifdef TRACING + goto DoSetTagIM; +#endif + +DoSetTagIM: + if (_trace) printf("DoSetTagIM:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Set TAG of op1 */ + *(u32 *)(iSP + 4) = arg2; + goto cachevalid; + +settagexc: + if (_trace) printf("settagexc:\n"); + arg5 = 0; + arg2 = 63; + goto illegaloperand; + +/* end DoSetTag */ + /* End of Halfword operand from stack instruction - DoSetTag */ +/* start DoCar */ + + /* Halfword operand from stack instruction - DoCar */ + /* arg2 has the preloaded 8 bit operand. */ + +docar: + if (_trace) printf("docar:\n"); +#ifdef TRACING +#endif + +DoCarSP: + if (_trace) printf("DoCarSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindocar; +#endif + +DoCarLP: + if (_trace) printf("DoCarLP:\n"); +#ifdef TRACING + goto begindocar; +#endif + +DoCarFP: + if (_trace) printf("DoCarFP:\n"); + +begindocar: + if (_trace) printf("begindocar:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Get the operand from the stack. */ + arg5 = *(s32 *)(arg1 + 4); + arg6 = *(s32 *)arg1; + r0 = (u64)&&return0012; + goto carinternal; +return0012: + /* set CDR-NEXT */ + t5 = arg5 & 63; + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; +#ifdef TRACING +#endif + +DoCarIM: + goto doistageerror; + +/* end DoCar */ + /* End of Halfword operand from stack instruction - DoCar */ +/* start CarInternal */ + + +carinternal: + if (_trace) printf("carinternal:\n"); + sp = sp + -8; + arg2 = (u32)(arg6 >> ((zero&7)*8)); + /* Strip off any CDR code bits. */ + t5 = arg5 & 63; + t6 = (t5 == Type_List) ? 1 : 0; + +g6512: + if (_trace) printf("g6512:\n"); + if (t6 == 0) + goto g6495; + /* Here if argument TypeList */ + +g6492: + /* Memory Read Internal */ + +g6496: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6498; + +g6497: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6500; + +g6507: + +g6494: + if (_trace) printf("g6494:\n"); + +g6493: + if (_trace) printf("g6493:\n"); + sp = sp + 8; + goto *r0; /* ret */ + +g6495: + if (_trace) printf("g6495:\n"); + t6 = (t5 == Type_NIL) ? 1 : 0; + +g6513: + if (_trace) printf("g6513:\n"); + if (t6 != 0) + goto g6494; + +g6508: + if (_trace) printf("g6508:\n"); + t6 = (t5 == Type_Locative) ? 1 : 0; + +g6514: + if (_trace) printf("g6514:\n"); + if (t6 != 0) + goto g6492; + +g6509: + if (_trace) printf("g6509:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = arg5; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto listexception; + +g6500: + if (_trace) printf("g6500:\n"); + if ((t7 & 1) == 0) + goto g6499; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6496; + +g6499: + if (_trace) printf("g6499:\n"); + +g6498: + if (_trace) printf("g6498:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0013; + goto memoryreaddatadecode; +return0013: + r0 = *(u64 *)sp; + goto g6507; + +/* end CarInternal */ +/* start DoCdr */ + + /* Halfword operand from stack instruction - DoCdr */ + /* arg2 has the preloaded 8 bit operand. */ + +docdr: + if (_trace) printf("docdr:\n"); +#ifdef TRACING +#endif + +DoCdrSP: + if (_trace) printf("DoCdrSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindocdr; +#endif + +DoCdrLP: + if (_trace) printf("DoCdrLP:\n"); +#ifdef TRACING + goto begindocdr; +#endif + +DoCdrFP: + if (_trace) printf("DoCdrFP:\n"); + +begindocdr: + if (_trace) printf("begindocdr:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Get the operand from the stack. */ + arg5 = *(s32 *)(arg1 + 4); + arg6 = *(s32 *)arg1; + r0 = (u64)&&return0014; + goto cdrinternal; +return0014: + /* set CDR-NEXT */ + t5 = arg5 & 63; + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; +#ifdef TRACING +#endif + +DoCdrIM: + goto doistageerror; + +/* end DoCdr */ + /* End of Halfword operand from stack instruction - DoCdr */ +/* start CdrInternal */ + + +cdrinternal: + if (_trace) printf("cdrinternal:\n"); + sp = sp + -8; + arg2 = (u32)arg6; + /* Strip off any CDR code bits. */ + t5 = arg5 & 63; + t6 = (t5 == Type_List) ? 1 : 0; + +g6550: + if (_trace) printf("g6550:\n"); + if (t6 == 0) + goto g6518; + /* Here if argument TypeList */ + /* Memory Read Internal */ + +g6519: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->cdr_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6521; + +g6520: + t7 = zero + 192; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6523; + +g6528: + /* Extract CDR code. */ + t5 = arg5 & 192; + if (t5 != 0) + goto g6530; + /* Here if argument 0 */ + /* Address of next position is CDR */ + arg6 = arg2 + 1; + arg5 = Type_List; + +g6529: + if (_trace) printf("g6529:\n"); + +g6517: + if (_trace) printf("g6517:\n"); + +g6516: + if (_trace) printf("g6516:\n"); + sp = sp + 8; + goto *r0; /* ret */ + +g6518: + if (_trace) printf("g6518:\n"); + t6 = (t5 == Type_NIL) ? 1 : 0; + +g6551: + if (_trace) printf("g6551:\n"); + if (t6 != 0) + goto g6517; + +g6546: + if (_trace) printf("g6546:\n"); + t6 = (t5 == Type_Locative) ? 1 : 0; + +g6552: + if (_trace) printf("g6552:\n"); + if (t6 != 0) + goto g6515; + +g6547: + if (_trace) printf("g6547:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = arg5; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto listexception; + +g6530: + if (_trace) printf("g6530:\n"); + t6 = (t5 == 128) ? 1 : 0; + +g6553: + if (_trace) printf("g6553:\n"); + if (t6 == 0) + goto g6531; + /* Here if argument 128 */ + arg2 = arg2 + 1; + +g6515: + if (_trace) printf("g6515:\n"); + /* Memory Read Internal */ + +g6532: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6534; + +g6533: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6536; + goto g6516; + +g6531: + if (_trace) printf("g6531:\n"); + t6 = (t5 == 64) ? 1 : 0; + +g6554: + if (_trace) printf("g6554:\n"); + if (t6 == 0) + goto g6543; + /* Here if argument 64 */ + arg6 = *(s32 *)&processor->niladdress; + arg5 = *((s32 *)(&processor->niladdress)+1); + arg6 = (u32)arg6; + goto g6516; + +g6543: + if (_trace) printf("g6543:\n"); + /* Here for all other cases */ + arg5 = arg2; + arg2 = 15; + goto illegaloperand; + +g6536: + if (_trace) printf("g6536:\n"); + if ((t7 & 1) == 0) + goto g6535; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6532; + +g6535: + if (_trace) printf("g6535:\n"); + +g6534: + if (_trace) printf("g6534:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0015; + goto memoryreaddatadecode; +return0015: + r0 = *(u64 *)sp; + goto g6516; + +g6523: + if (_trace) printf("g6523:\n"); + if ((t7 & 1) == 0) + goto g6522; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6519; + +g6522: + if (_trace) printf("g6522:\n"); + +g6521: + if (_trace) printf("g6521:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0016; + goto memoryreadcdrdecode; +return0016: + r0 = *(u64 *)sp; + goto g6528; + +/* end CdrInternal */ +/* start DoReadInternalRegister */ + + /* Halfword 10 bit immediate instruction - DoReadInternalRegister */ + +doreadinternalregister: + if (_trace) printf("doreadinternalregister:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoReadInternalRegisterIM: + if (_trace) printf("DoReadInternalRegisterIM:\n"); + +DoReadInternalRegisterSP: + if (_trace) printf("DoReadInternalRegisterSP:\n"); + +DoReadInternalRegisterLP: + if (_trace) printf("DoReadInternalRegisterLP:\n"); + +DoReadInternalRegisterFP: + if (_trace) printf("DoReadInternalRegisterFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + t2 = *(u64 *)&(processor->internalregisterread2); + t3 = (s32)arg1 - (s32)512; + t1 = *(u64 *)&(processor->internalregisterread1); + /* We're in the 1000's */ + if ((s64)t3 >= 0) + goto g6555; + /* Keep only six bits */ + t3 = arg1 & 63; + /* In range for the low registers? */ + t2 = ((s64)t3 <= (s64)42) ? 1 : 0; + t3 = (t3 * 8) + t1; + if (t2 == 0) + goto ReadRegisterError; + t3 = *(u64 *)t3; + /* Jump to the handler */ + goto *t3; /* jmp */ + +g6555: + if (_trace) printf("g6555:\n"); + /* In range for the high registers? */ + t1 = ((s64)t3 <= (s64)33) ? 1 : 0; + t3 = (t3 * 8) + t2; + if (t1 == 0) + goto ReadRegisterError; + t3 = *(u64 *)t3; + /* Jump to the handler */ + goto *t3; /* jmp */ + +/* end DoReadInternalRegister */ + /* End of Halfword operand from stack instruction - DoReadInternalRegister */ +/* start DoWriteInternalRegister */ + + /* Halfword 10 bit immediate instruction - DoWriteInternalRegister */ + +dowriteinternalregister: + if (_trace) printf("dowriteinternalregister:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoWriteInternalRegisterIM: + if (_trace) printf("DoWriteInternalRegisterIM:\n"); + +DoWriteInternalRegisterSP: + if (_trace) printf("DoWriteInternalRegisterSP:\n"); + +DoWriteInternalRegisterLP: + if (_trace) printf("DoWriteInternalRegisterLP:\n"); + +DoWriteInternalRegisterFP: + if (_trace) printf("DoWriteInternalRegisterFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg2 = (u32)(arg6 >> ((4&7)*8)); + /* Arg2=tag arg3=data */ + arg3 = (u32)arg6; + /* Pop Stack. */ + iSP = iSP - 8; + t2 = *(u64 *)&(processor->internalregisterwrite2); + t3 = (s32)arg1 - (s32)512; + t1 = *(u64 *)&(processor->internalregisterwrite1); + /* We're in the 1000's */ + if ((s64)t3 >= 0) + goto g6556; + /* Keep only six bits */ + t3 = arg1 & 63; + /* In range for the low registers? */ + t2 = ((s64)t3 <= (s64)42) ? 1 : 0; + t3 = (t3 * 8) + t1; + if (t2 == 0) + goto WriteRegisterError; + t3 = *(u64 *)t3; + /* Jump to the handler */ + goto *t3; /* jmp */ + +g6556: + if (_trace) printf("g6556:\n"); + /* In range for the high registers? */ + t1 = ((s64)t3 <= (s64)33) ? 1 : 0; + t3 = (t3 * 8) + t2; + if (t1 == 0) + goto WriteRegisterError; + t3 = *(u64 *)t3; + /* Jump to the handler */ + goto *t3; /* jmp */ + +/* end DoWriteInternalRegister */ + /* End of Halfword operand from stack instruction - DoWriteInternalRegister */ +/* start WriteRegisterBARx */ + + +WriteRegisterBARx: + if (_trace) printf("WriteRegisterBARx:\n"); + /* BAR number into T2 */ + t2 = arg1 >> 7; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Make a quadword from tag and data */ + t3 = arg2 << 32; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t1 = (u64)&processor->bar0; + /* Now T1 points to the BAR */ + t1 = (t2 * 8) + t1; + /* Construct the combined word */ + t3 = t3 | arg3; + *(u64 *)t1 = t3; + goto cachevalid; + +/* end WriteRegisterBARx */ +/* start DoBlock3Read */ + + /* Halfword 10 bit immediate instruction - DoBlock3Read */ + +doblock3read: + if (_trace) printf("doblock3read:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock3ReadIM: + if (_trace) printf("DoBlock3ReadIM:\n"); + +DoBlock3ReadSP: + if (_trace) printf("DoBlock3ReadSP:\n"); + +DoBlock3ReadLP: + if (_trace) printf("DoBlock3ReadLP:\n"); + +DoBlock3ReadFP: + if (_trace) printf("DoBlock3ReadFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg4 = (u64)&processor->bar3; + goto blockread; + +/* end DoBlock3Read */ + /* End of Halfword operand from stack instruction - DoBlock3Read */ +/* start DoBlock2Read */ + + /* Halfword 10 bit immediate instruction - DoBlock2Read */ + +doblock2read: + if (_trace) printf("doblock2read:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock2ReadIM: + if (_trace) printf("DoBlock2ReadIM:\n"); + +DoBlock2ReadSP: + if (_trace) printf("DoBlock2ReadSP:\n"); + +DoBlock2ReadLP: + if (_trace) printf("DoBlock2ReadLP:\n"); + +DoBlock2ReadFP: + if (_trace) printf("DoBlock2ReadFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg4 = (u64)&processor->bar2; + goto blockread; + +/* end DoBlock2Read */ + /* End of Halfword operand from stack instruction - DoBlock2Read */ +/* start DoBlock1Read */ + + /* Halfword 10 bit immediate instruction - DoBlock1Read */ + +doblock1read: + if (_trace) printf("doblock1read:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBlock1ReadIM: + if (_trace) printf("DoBlock1ReadIM:\n"); + +DoBlock1ReadSP: + if (_trace) printf("DoBlock1ReadSP:\n"); + +DoBlock1ReadLP: + if (_trace) printf("DoBlock1ReadLP:\n"); + +DoBlock1ReadFP: + if (_trace) printf("DoBlock1ReadFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg4 = (u64)&processor->bar1; + +blockread: + if (_trace) printf("blockread:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Get the vma */ + arg2 = *(s32 *)arg4; + /* cycle type */ + arg3 = arg1 >> 6; + /* =no-incrementp */ + t2 = arg1 & 4; + /* =cdr-code-nextp */ + t3 = arg1 & 16; + /* =fixnum onlyp */ + t4 = arg1 & 32; + arg2 = (u32)arg2; + /* Do the read cycle */ + /* Memory Read Internal */ + +g6560: + t7 = arg2 + ivory; + /* Cycle-number -> table offset */ + t8 = (arg3 * 4); + arg5 = LDQ_U(t7); + t8 = (t8 * 4) + ivory; + arg6 = (t7 * 4); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)(t8 + PROCESSORSTATE_DATAREAD_MASK); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6562; + +g6561: + t8 = t8 >> (arg5 & 63); + if (t8 & 1) + goto g6564; + +g6571: + /* J. if we have to test for fixnump. */ + if (t4 != 0) + goto g6557; + +g6558: + /* Compute Incremented address */ + t4 = arg2 + 1; + +g6572: + if (_trace) printf("g6572:\n"); + /* Conditionally update address */ + if (t2 == 0) + arg2 = t4; + /* Store updated vma in BAR */ + *(u32 *)arg4 = arg2; + /* Compute CDR-NEXT */ + t2 = arg5 & 63; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Conditionally Set CDR-NEXT */ + if (t3) + arg5 = t2; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = arg5; + iSP = iSP + 8; + goto cachevalid; + +g6559: + if (_trace) printf("g6559:\n"); + arg5 = arg2; + arg2 = 23; + goto illegaloperand; + +g6564: + if (_trace) printf("g6564:\n"); + +g6562: + if (_trace) printf("g6562:\n"); + r0 = (u64)&&return0017; + goto memoryreadgeneraldecode; +return0017: + goto g6571; + +g6557: + if (_trace) printf("g6557:\n"); + t5 = arg5 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g6559; + goto g6558; + +/* end DoBlock1Read */ + /* End of Halfword operand from stack instruction - DoBlock1Read */ +/* start DoBlock2Write */ + + /* Halfword operand from stack instruction - DoBlock2Write */ + +doblock2write: + if (_trace) printf("doblock2write:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoBlock2WriteIM: + if (_trace) printf("DoBlock2WriteIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g6589: + if (_trace) printf("g6589:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoblock2write; +#ifdef TRACING +#endif + +DoBlock2WriteSP: + if (_trace) printf("DoBlock2WriteSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoblock2write; +#endif + +DoBlock2WriteLP: + if (_trace) printf("DoBlock2WriteLP:\n"); +#ifdef TRACING + goto headdoblock2write; +#endif + +DoBlock2WriteFP: + if (_trace) printf("DoBlock2WriteFP:\n"); + +headdoblock2write: + if (_trace) printf("headdoblock2write:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoblock2write: + if (_trace) printf("begindoblock2write:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg3 = *(s32 *)&processor->bar2; + arg2 = (u64)&processor->bar2; + goto blockwrite; + +/* end DoBlock2Write */ + /* End of Halfword operand from stack instruction - DoBlock2Write */ +/* start DoBlock1Write */ + + /* Halfword operand from stack instruction - DoBlock1Write */ + +doblock1write: + if (_trace) printf("doblock1write:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoBlock1WriteIM: + if (_trace) printf("DoBlock1WriteIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g6593: + if (_trace) printf("g6593:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoblock1write; +#ifdef TRACING +#endif + +DoBlock1WriteSP: + if (_trace) printf("DoBlock1WriteSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoblock1write; +#endif + +DoBlock1WriteLP: + if (_trace) printf("DoBlock1WriteLP:\n"); +#ifdef TRACING + goto headdoblock1write; +#endif + +DoBlock1WriteFP: + if (_trace) printf("DoBlock1WriteFP:\n"); + +headdoblock1write: + if (_trace) printf("headdoblock1write:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoblock1write: + if (_trace) printf("begindoblock1write:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg3 = *(s32 *)&processor->bar1; + arg2 = (u64)&processor->bar1; + +blockwrite: + if (_trace) printf("blockwrite:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Unsigned vma */ + arg3 = (u32)arg3; + /* Get tag */ + t2 = arg1 >> 32; + /* Get data */ + t3 = (u32)arg1; + t8 = arg3 + ivory; + t6 = (t8 * 4); + t5 = LDQ_U(t8); + /* Stack cache offset */ + t4 = arg3 - t11; + /* In range? */ + t7 = ((u64)t4 < (u64)t12) ? 1 : 0; + t4 = (t2 & 0xff) << ((t8&7)*8); + t5 = t5 & ~(0xffL << (t8&7)*8); + +g6592: + if (_trace) printf("g6592:\n"); + t5 = t5 | t4; + STQ_U(t8, t5); + *(u32 *)t6 = t3; + /* J. if in cache */ + if (t7 != 0) + goto g6591; + +g6590: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Increment the address */ + arg3 = arg3 + 1; + /* Store updated vma in BAR */ + *(u32 *)arg2 = arg3; + goto cachevalid; + +g6591: + if (_trace) printf("g6591:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t4 = arg3 - t11; + /* reconstruct SCA */ + t8 = (t4 * 8) + t8; + /* Store in stack */ + *(u32 *)t8 = t3; + /* write the stack cache */ + *(u32 *)(t8 + 4) = t2; + goto g6590; + +/* end DoBlock1Write */ + /* End of Halfword operand from stack instruction - DoBlock1Write */ +/* start DoBranchTrueNoPop */ + + /* Halfword 10 bit immediate instruction - DoBranchTrueNoPop */ + +dobranchtruenopop: + if (_trace) printf("dobranchtruenopop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueNoPopIM: + if (_trace) printf("DoBranchTrueNoPopIM:\n"); + +DoBranchTrueNoPopSP: + if (_trace) printf("DoBranchTrueNoPopSP:\n"); + +DoBranchTrueNoPopLP: + if (_trace) printf("DoBranchTrueNoPopLP:\n"); + +DoBranchTrueNoPopFP: + if (_trace) printf("DoBranchTrueNoPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto NEXTINSTRUCTION; + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrueNoPop */ + /* End of Halfword operand from stack instruction - DoBranchTrueNoPop */ +/* start DoBranchFalseNoPop */ + + /* Halfword 10 bit immediate instruction - DoBranchFalseNoPop */ + +dobranchfalsenopop: + if (_trace) printf("dobranchfalsenopop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseNoPopIM: + if (_trace) printf("DoBranchFalseNoPopIM:\n"); + +DoBranchFalseNoPopSP: + if (_trace) printf("DoBranchFalseNoPopSP:\n"); + +DoBranchFalseNoPopLP: + if (_trace) printf("DoBranchFalseNoPopLP:\n"); + +DoBranchFalseNoPopFP: + if (_trace) printf("DoBranchFalseNoPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto NEXTINSTRUCTION; + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalseNoPop */ + /* End of Halfword operand from stack instruction - DoBranchFalseNoPop */ +/* start callgeneric */ + + /* Fullword instruction - callgeneric */ +#ifdef TRACING +#endif + +callgeneric: + if (_trace) printf("callgeneric:\n"); + +callgenericprefetch: + if (_trace) printf("callgenericprefetch:\n"); + t3 = *(u64 *)&(processor->trapvecbase); + /* Get operand */ + arg4 = arg3; + arg3 = Type_GenericFunction; + arg5 = Type_EvenPC; + arg6 = t3 + 2636; + goto startcallcompiledmerge; + +/* end callgeneric */ + /* End of Fullword instruction - callgeneric */ +/* start callcompiledeven */ + + /* Fullword instruction - callcompiledeven */ +#ifdef TRACING +#endif + +callcompiledeven: + if (_trace) printf("callcompiledeven:\n"); + +callcompiledevenprefetch: + if (_trace) printf("callcompiledevenprefetch:\n"); + /* Get operand */ + arg6 = arg3; + arg5 = Type_EvenPC; + /* No extra arg */ + arg3 = zero; + goto startcallcompiledmerge; + +/* end callcompiledeven */ + /* End of Fullword instruction - callcompiledeven */ +/* start DoStartCall */ + + /* Halfword operand from stack instruction - DoStartCall */ + /* arg2 has the preloaded 8 bit operand. */ + +dostartcall: + if (_trace) printf("dostartcall:\n"); +#ifdef TRACING +#endif + +DoStartCallSP: + if (_trace) printf("DoStartCallSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindostartcall; +#endif + +DoStartCallLP: + if (_trace) printf("DoStartCallLP:\n"); +#ifdef TRACING + goto begindostartcall; +#endif + +DoStartCallFP: + if (_trace) printf("DoStartCallFP:\n"); + +begindostartcall: + if (_trace) printf("begindostartcall:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg5 = *(s32 *)(arg1 + 4); + arg6 = *(s32 *)arg1; + +startcallagain: + if (_trace) printf("startcallagain:\n"); + +g6596: + if (_trace) printf("g6596:\n"); + t1 = *(u64 *)&(processor->trapvecbase); + /* Strip off any CDR code bits. */ + t2 = arg5 & 63; + t3 = (t2 == Type_CompiledFunction) ? 1 : 0; + +g6645: + if (_trace) printf("g6645:\n"); + if (t3 == 0) + goto g6602; + /* Here if argument TypeCompiledFunction */ + +g6597: + if (_trace) printf("g6597:\n"); + /* No extra argument */ + arg3 = zero; + +g6598: + if (_trace) printf("g6598:\n"); + arg5 = Type_EvenPC; + +startcallcompiledmerge: + if (_trace) printf("startcallcompiledmerge:\n"); + t7 = *((s32 *)(&processor->continuation)+1); + /* prepare to push continuation/control register */ + iSP = iSP + 16; + t3 = *(s32 *)&processor->control; + t6 = Type_Fixnum+0xC0; + t8 = *(s32 *)&processor->continuation; + t5 = (64) << 16; + /* Set CDR code 3 */ + t7 = t7 | 192; + /* push continuation */ + *(u32 *)(iSP + -8) = t8; + /* write the stack cache */ + *(u32 *)(iSP + -4) = t7; + /* Set call started bit in CR */ + t8 = t3 | t5; + t5 = zero + 256; + /* Push control register */ + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t6; + /* Clear the extra arg bit */ + t8 = t8 & ~t5; + /* Save control with new state */ + *(u32 *)&processor->control = t8; + /* End of push-frame */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u32 *)&processor->continuation = arg6; + *((u32 *)(&processor->continuation)+1) = arg5; + *(u64 *)&processor->continuationcp = zero; + if (arg3 != 0) + goto g6599; + goto cachevalid; + +g6599: + if (_trace) printf("g6599:\n"); + t1 = *(s32 *)&processor->control; + t2 = zero + 256; + /* set CDR-NEXT */ + t3 = arg3 & 63; + /* Push the extra arg. */ + *(u32 *)(iSP + 8) = arg4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t3; + iSP = iSP + 8; + /* Set the extra arg bit */ + t1 = t1 | t2; + /* Save control with new state */ + *(u32 *)&processor->control = t1; + goto cachevalid; + +g6602: + if (_trace) printf("g6602:\n"); + t3 = (t2 == Type_GenericFunction) ? 1 : 0; + +g6646: + if (_trace) printf("g6646:\n"); + if (t3 == 0) + goto g6603; + /* Here if argument TypeGenericFunction */ + arg3 = arg5; + arg4 = (u32)arg6; + arg6 = t1 + 2636; + goto g6598; + +g6603: + if (_trace) printf("g6603:\n"); + t3 = (t2 == Type_Instance) ? 1 : 0; + +g6647: + if (_trace) printf("g6647:\n"); + if (t3 == 0) + goto g6604; + /* Here if argument TypeInstance */ + arg3 = arg5; + arg4 = (u32)arg6; + arg6 = t1 + 2638; + goto g6598; + +g6604: + if (_trace) printf("g6604:\n"); + t3 = (t2 == Type_Symbol) ? 1 : 0; + +g6648: + if (_trace) printf("g6648:\n"); + if (t3 == 0) + goto g6605; + /* Here if argument TypeSymbol */ + arg6 = (u32)arg6; + /* No extra argument */ + arg3 = zero; + /* Get to the function cell */ + arg2 = arg6 + 2; + goto startcallindirect; + +g6605: + if (_trace) printf("g6605:\n"); + t3 = (t2 == Type_LexicalClosure) ? 1 : 0; + +g6649: + if (_trace) printf("g6649:\n"); + if (t3 == 0) + goto g6606; + /* Here if argument TypeLexicalClosure */ + arg2 = (u32)arg6; + /* Memory Read Internal */ + +g6607: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6609; + +g6608: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6611; + +g6618: + arg3 = arg5; + arg4 = arg6; + arg2 = arg2 + 1; + +startcallindirect: + if (_trace) printf("startcallindirect:\n"); + /* Memory Read Internal */ + +g6619: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6621; + +g6620: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6623; + +g6630: + t5 = arg5 - Type_CompiledFunction; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g6596; + goto g6598; + +g6606: + if (_trace) printf("g6606:\n"); + /* Here for all other cases */ + +g6594: + if (_trace) printf("g6594:\n"); + arg3 = arg5; + arg4 = arg6; + t3 = t1 + 2304; + /* TagType. */ + arg5 = arg5 & 63; + arg2 = arg5 + t3; + /* Memory Read Internal */ + +g6632: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6634; + +g6633: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6636; + +g6643: + t3 = arg5 - Type_EvenPC; + /* Strip CDR code, low bits */ + t3 = t3 & 63; + if (t3 != 0) + goto g6595; + goto g6598; + +g6601: + if (_trace) printf("g6601:\n"); + +g6595: + if (_trace) printf("g6595:\n"); + arg5 = t1; + arg2 = 51; + goto illegaloperand; + +g6636: + if (_trace) printf("g6636:\n"); + if ((t7 & 1) == 0) + goto g6635; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6632; + +g6635: + if (_trace) printf("g6635:\n"); + +g6634: + if (_trace) printf("g6634:\n"); + r0 = (u64)&&return0018; + goto memoryreaddatadecode; +return0018: + goto g6643; + +g6623: + if (_trace) printf("g6623:\n"); + if ((t7 & 1) == 0) + goto g6622; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6619; + +g6622: + if (_trace) printf("g6622:\n"); + +g6621: + if (_trace) printf("g6621:\n"); + r0 = (u64)&&return0019; + goto memoryreaddatadecode; +return0019: + goto g6630; + +g6611: + if (_trace) printf("g6611:\n"); + if ((t7 & 1) == 0) + goto g6610; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6607; + +g6610: + if (_trace) printf("g6610:\n"); + +g6609: + if (_trace) printf("g6609:\n"); + r0 = (u64)&&return0020; + goto memoryreaddatadecode; +return0020: + goto g6618; +#ifdef TRACING +#endif + +DoStartCallIM: + goto doistageerror; + +/* end DoStartCall */ + /* End of Halfword operand from stack instruction - DoStartCall */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifuncom1.as */ diff --git a/stub/ifuncom2.c b/stub/ifuncom2.c new file mode 100644 index 0000000..e8eb591 --- /dev/null +++ b/stub/ifuncom2.c @@ -0,0 +1,3902 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuncom2.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* The most commonly used instructions, part 2. */ +/* start DoPushInstanceVariable */ + + /* Halfword 10 bit immediate instruction - DoPushInstanceVariable */ + +dopushinstancevariable: + if (_trace) printf("dopushinstancevariable:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPushInstanceVariableIM: + if (_trace) printf("DoPushInstanceVariableIM:\n"); + +DoPushInstanceVariableSP: + if (_trace) printf("DoPushInstanceVariableSP:\n"); + +DoPushInstanceVariableLP: + if (_trace) printf("DoPushInstanceVariableLP:\n"); + +DoPushInstanceVariableFP: + if (_trace) printf("DoPushInstanceVariableFP:\n"); + /* arg1 has operand preloaded. */ + arg1 = arg2; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Locate Instance Variable Mapped */ + /* Map */ + arg2 = *(s32 *)(iFP + 16); + arg5 = *(s32 *)(iFP + 20); + arg2 = (u32)arg2; + t2 = arg5 - Type_Array; + /* Strip CDR code */ + t2 = t2 & 63; + if (t2 != 0) + goto ivbadmap; + /* Memory Read Internal */ + +g6653: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6655; + +g6654: + t7 = zero + 64; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6657; + +g6662: + arg6 = arg6 & Array_LengthMask; + t3 = arg6 - arg1; + /* J. if mapping-table-index-out-of-bounds */ + if ((s64)t3 <= 0) + goto ivbadindex; + arg2 = arg2 + arg1; + arg2 = arg2 + 1; + /* Memory Read Internal */ + +g6663: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6665; + +g6664: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6667; + +g6674: + t1 = arg6; + t4 = arg5 - Type_Fixnum; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto pushivexception; + /* Self */ + arg2 = *(s32 *)(iFP + 24); + t4 = *(s32 *)(iFP + 28); + arg2 = (u32)arg2; + t3 = t4 - Type_Instance; + /* Strip CDR code, low bits */ + t3 = t3 & 60; + if (t3 != 0) + goto ivbadinst; + /* Unshifted cdr code */ + t3 = t4 & 192; + /* Check for CDR code 1 */ + t3 = t3 - 64; + /* J. if CDR code is not 1 */ + if (t3 != 0) + goto g6652; + +g6651: + if (_trace) printf("g6651:\n"); + arg2 = arg2 + t1; + +g6650: + if (_trace) printf("g6650:\n"); + /* Memory Read Internal */ + +g6675: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6677; + +g6676: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6679; + +g6686: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* set CDR-NEXT */ + t7 = arg5 & 63; + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t7; + iSP = iSP + 8; + goto cachevalid; + +g6679: + if (_trace) printf("g6679:\n"); + if ((t7 & 1) == 0) + goto g6678; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6675; + +g6678: + if (_trace) printf("g6678:\n"); + +g6677: + if (_trace) printf("g6677:\n"); + r0 = (u64)&&return0021; + goto memoryreaddatadecode; +return0021: + goto g6686; + +g6667: + if (_trace) printf("g6667:\n"); + if ((t7 & 1) == 0) + goto g6666; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6663; + +g6666: + if (_trace) printf("g6666:\n"); + +g6665: + if (_trace) printf("g6665:\n"); + r0 = (u64)&&return0022; + goto memoryreaddatadecode; +return0022: + goto g6674; + +g6657: + if (_trace) printf("g6657:\n"); + if ((t7 & 1) == 0) + goto g6656; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6653; + +g6656: + if (_trace) printf("g6656:\n"); + +g6655: + if (_trace) printf("g6655:\n"); + r0 = (u64)&&return0023; + goto memoryreadheaderdecode; +return0023: + goto g6662; + +g6652: + if (_trace) printf("g6652:\n"); + t3 = arg2; + /* Memory Read Internal */ + +g6687: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6689; + +g6688: + t7 = zero + 64; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6691; + +g6696: + t3 = t3 - arg2; + if (t3 != 0) + goto g6651; + /* TagType. */ + t4 = t4 & 63; + /* Set CDR code to 1 */ + t4 = t4 | 64; + /* Update self */ + *(u32 *)(iFP + 24) = arg2; + /* write the stack cache */ + *(u32 *)(iFP + 28) = t4; + goto g6651; + +g6691: + if (_trace) printf("g6691:\n"); + if ((t7 & 1) == 0) + goto g6690; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6687; + +g6690: + if (_trace) printf("g6690:\n"); + +g6689: + if (_trace) printf("g6689:\n"); + r0 = (u64)&&return0024; + goto memoryreadheaderdecode; +return0024: + goto g6696; + +/* end DoPushInstanceVariable */ + /* End of Halfword operand from stack instruction - DoPushInstanceVariable */ +/* start DoAdd */ + + /* Halfword operand from stack instruction - DoAdd */ + /* arg2 has the preloaded 8 bit operand. */ + +doadd: + if (_trace) printf("doadd:\n"); +#ifdef TRACING +#endif + +DoAddSP: + if (_trace) printf("DoAddSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindoadd; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindoadd; +#endif + +DoAddLP: + if (_trace) printf("DoAddLP:\n"); +#ifdef TRACING + goto begindoadd; +#endif + +DoAddFP: + if (_trace) printf("DoAddFP:\n"); + +begindoadd: + if (_trace) printf("begindoadd:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + LDS(1, f1, *(u32 *)iSP ); + /* ARG1 tag */ + t1 = (u32)(arg6 >> ((4&7)*8)); + /* ARG2 tag */ + t3 = *(s32 *)(arg1 + 4); + /* ARG1 data */ + t2 = (s32)arg6; + /* ARG2 data */ + t4 = *(s32 *)arg1; + LDS(2, f2, *(u32 *)arg1 ); + /* NIL */ + /* Strip off any CDR code bits. */ + t9 = t1 & 63; + /* Strip off any CDR code bits. */ + t11 = t3 & 63; + t10 = (t9 == Type_Fixnum) ? 1 : 0; + +g6736: + if (_trace) printf("g6736:\n"); + if (t10 == 0) + goto g6707; + /* Here if argument TypeFixnum */ + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6713: + if (_trace) printf("g6713:\n"); + if (t12 == 0) + goto g6709; + /* Here if argument TypeFixnum */ + t6 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* compute 64-bit result */ +// t5 = (u64)((s32)t2 + (s64)(s32)t4); /* addl/v */ + /* x86_64 replacement for addl/v */ + asm("movl %k2,%k0 \n\t" + "addl %k3,%k0 \n\t" + "seto %b1" + : "=r"(t5),"=rm"(oflo) + : "rm"(t2),"rm"(t4) + : "cc"); +// if (t5 >> 32) +// exception(); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + CHECK_OFLO(); /* check overflow */ + /* Semi-cheat, we know temp2 has CDRNext/TypeFixnum */ + *(u32 *)(iSP + 4) = t9; + iPC = t6; + *(u32 *)iSP = t5; + iCP = t7; + goto cachevalid; + +g6709: + if (_trace) printf("g6709:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g6714: + if (_trace) printf("g6714:\n"); + if (t12 == 0) + goto g6710; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g6697; + +g6710: + if (_trace) printf("g6710:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g6715: + if (_trace) printf("g6715:\n"); + if (t12 == 0) + goto g6704; + /* Here if argument TypeDoubleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g6700; + +g6708: + if (_trace) printf("g6708:\n"); + +g6707: + if (_trace) printf("g6707:\n"); + t10 = (t9 == Type_SingleFloat) ? 1 : 0; + +g6737: + if (_trace) printf("g6737:\n"); + if (t10 == 0) + goto g6716; + /* Here if argument TypeSingleFloat */ + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g6722: + if (_trace) printf("g6722:\n"); + if (t12 == 0) + goto g6718; + /* Here if argument TypeSingleFloat */ + +g6697: + if (_trace) printf("g6697:\n"); + ADDS(0, f0, 1, f1, 2, f2); /* adds */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + goto cachevalid; + +g6718: + if (_trace) printf("g6718:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6723: + if (_trace) printf("g6723:\n"); + if (t12 == 0) + goto g6719; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g6697; + +g6719: + if (_trace) printf("g6719:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g6724: + if (_trace) printf("g6724:\n"); + if (t12 == 0) + goto g6704; + /* Here if argument TypeDoubleFloat */ + +g6700: + if (_trace) printf("g6700:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + goto g6701; + +g6717: + if (_trace) printf("g6717:\n"); + +g6716: + if (_trace) printf("g6716:\n"); + t10 = (t9 == Type_DoubleFloat) ? 1 : 0; + +g6738: + if (_trace) printf("g6738:\n"); + if (t10 == 0) + goto g6725; + /* Here if argument TypeDoubleFloat */ + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g6731: + if (_trace) printf("g6731:\n"); + if (t12 == 0) + goto g6727; + /* Here if argument TypeDoubleFloat */ + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + r0 = (u64)&&return0025; + goto fetchdoublefloat; +return0025: + LDT(1, f1, processor->fp0); + +g6701: + if (_trace) printf("g6701:\n"); + arg2 = (u32)t4; + r0 = (u64)&&return0026; + goto fetchdoublefloat; +return0026: + LDT(2, f2, processor->fp0); + +g6698: + if (_trace) printf("g6698:\n"); + ADDT(0, f0, 1, f1, 2, f2); /* addt */ + STT( (u64 *)&processor->fp0, 0, f0 ); + r0 = (u64)&&return0027; + goto consdoublefloat; +return0027: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t8 = Type_DoubleFloat; + *(u32 *)iSP = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + goto cachevalid; + +g6727: + if (_trace) printf("g6727:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g6732: + if (_trace) printf("g6732:\n"); + if (t12 == 0) + goto g6728; + /* Here if argument TypeSingleFloat */ + +g6699: + if (_trace) printf("g6699:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + r0 = (u64)&&return0028; + goto fetchdoublefloat; +return0028: + LDT(1, f1, processor->fp0); + goto g6698; + +g6728: + if (_trace) printf("g6728:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6733: + if (_trace) printf("g6733:\n"); + if (t12 == 0) + goto g6704; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g6699; + +g6726: + if (_trace) printf("g6726:\n"); + +g6725: + if (_trace) printf("g6725:\n"); + /* Here for all other cases */ + +g6703: + if (_trace) printf("g6703:\n"); + +doaddovfl: + if (_trace) printf("doaddovfl:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g6705; + +g6704: + if (_trace) printf("g6704:\n"); + t1 = t3; + goto doaddovfl; + +g6705: + if (_trace) printf("g6705:\n"); + +g6706: + if (_trace) printf("g6706:\n"); +#ifdef TRACING + goto DoAddIM; +#endif + +DoAddIM: + if (_trace) printf("DoAddIM:\n"); + t1 = (u32)(arg6 >> ((4&7)*8)); + /* get ARG1 tag/data */ + t2 = (s32)arg6; + /* Strip off any CDR code bits. */ + t11 = t1 & 63; + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6743: + if (_trace) printf("g6743:\n"); + if (t12 == 0) + goto g6740; + /* Here if argument TypeFixnum */ + /* compute 64-bit result */ + t3 = t2 + arg2; + t4 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* compute 32-bit sign-extended result */ + t10 = (s32)t3; + t5 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* is it the same as the 64-bit result? */ + t10 = (t3 == t10) ? 1 : 0; + /* if not, we overflowed */ + if (t10 == 0) + goto doaddovfl; + /* Semi-cheat, we know temp2 has CDRNext/TypeFixnum */ + *(u32 *)(iSP + 4) = t11; + iPC = t4; + *(u32 *)iSP = t3; + iCP = t5; + goto cachevalid; + +g6740: + if (_trace) printf("g6740:\n"); + /* Here for all other cases */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + arg2 = zero; + goto begindoadd; + +g6739: + if (_trace) printf("g6739:\n"); + +/* end DoAdd */ + /* End of Halfword operand from stack instruction - DoAdd */ +/* start DoBlock3Write */ + + /* Halfword operand from stack instruction - DoBlock3Write */ + +doblock3write: + if (_trace) printf("doblock3write:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoBlock3WriteIM: + if (_trace) printf("DoBlock3WriteIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g6744: + if (_trace) printf("g6744:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoblock3write; +#ifdef TRACING +#endif + +DoBlock3WriteSP: + if (_trace) printf("DoBlock3WriteSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoblock3write; +#endif + +DoBlock3WriteLP: + if (_trace) printf("DoBlock3WriteLP:\n"); +#ifdef TRACING + goto headdoblock3write; +#endif + +DoBlock3WriteFP: + if (_trace) printf("DoBlock3WriteFP:\n"); + +headdoblock3write: + if (_trace) printf("headdoblock3write:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoblock3write: + if (_trace) printf("begindoblock3write:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg3 = *(s32 *)&processor->bar3; + arg2 = (u64)&processor->bar3; + goto blockwrite; + +/* end DoBlock3Write */ + /* End of Halfword operand from stack instruction - DoBlock3Write */ +/* start DoAset1 */ + + /* Halfword operand from stack instruction - DoAset1 */ + /* arg2 has the preloaded 8 bit operand. */ + +doaset1: + if (_trace) printf("doaset1:\n"); +#ifdef TRACING +#endif + +DoAset1SP: + if (_trace) printf("DoAset1SP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoaset1; +#endif + +DoAset1LP: + if (_trace) printf("DoAset1LP:\n"); +#ifdef TRACING + goto headdoaset1; +#endif + +DoAset1FP: + if (_trace) printf("DoAset1FP:\n"); + +headdoaset1: + if (_trace) printf("headdoaset1:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoaset1: + if (_trace) printf("begindoaset1:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get the array tag/data */ + arg4 = *(s32 *)iSP; + /* Get the array tag/data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* Get the new value tag/data */ + t6 = *(s32 *)iSP; + /* Get the new value tag/data */ + t5 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t6 = (u32)t6; + /* (sign-extended, for fast bounds check) Index Data */ + arg2 = (s32)arg1 + (s32)0; + t8 = zero + AutoArrayRegMask; + t8 = arg4 & t8; + /* Index Tag */ + arg1 = arg1 >> 32; + t7 = (u64)&processor->ac0array; + /* This is the address if the array register block. */ + t7 = t7 + t8; + t1 = arg1 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto aset1illegal; + +aset1merge: + if (_trace) printf("aset1merge:\n"); + if (arg4 == 0) + goto aset1regset; + /* Cached array object. */ + t8 = *(u64 *)&(((ARRAYCACHEP)t7)->array); + t1 = arg3 - Type_Array; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto reallyaset1exc; + /* t8==1 iff cached array is ours. */ + t8 = (arg4 == t8) ? 1 : 0; + /* Go and setup the array register. */ + if (t8 == 0) + goto aset1regset; +#ifdef SLOWARRAYS + goto aset1regset; +#endif + arg6 = *(u64 *)&(((ARRAYCACHEP)t7)->arword); + /* high order bits all zero */ + t9 = *(u64 *)&(((ARRAYCACHEP)t7)->locat); + /* high order bits all zero */ + t3 = *(u64 *)&(((ARRAYCACHEP)t7)->length); + t11 = arg6 << 42; + t4 = *(u64 *)&(processor->areventcount); + t11 = t11 >> 42; + t2 = ((u64)arg2 < (u64)t3) ? 1 : 0; + t12 = t4 - t11; + /* J. if event count ticked. */ + if (t12 != 0) + goto aset1regset; + if (t2 == 0) + goto aset1bounds; + arg5 = arg6 >> (Array_RegisterBytePackingPos & 63); + t8 = arg6 >> (Array_RegisterElementTypePos & 63); + arg4 = arg6 >> (Array_RegisterByteOffsetPos & 63); + arg5 = arg5 & Array_RegisterBytePackingMask; + arg4 = arg4 & Array_RegisterByteOffsetMask; + arg6 = t8 & Array_RegisterElementTypeMask; + +aset1restart: + if (_trace) printf("aset1restart:\n"); + /* Element checking and foreplay. */ + /* TagType. */ + t1 = t5 & 63; + t8 = (arg6 == Array_ElementTypeCharacter) ? 1 : 0; + +g6755: + if (_trace) printf("g6755:\n"); + if (t8 == 0) + goto g6751; + /* Here if argument ArrayElementTypeCharacter */ + t2 = t1 - Type_Character; + if (t2 == 0) + goto g6746; + arg5 = 0; + arg2 = 29; + goto illegaloperand; + +g6746: + if (_trace) printf("g6746:\n"); + /* Certainly will fit if not packed! */ + if (arg5 == 0) + goto g6745; + t2 = 32; + /* Compute size of byte */ + t2 = t2 >> (arg5 & 63); + t1 = ~zero; + t1 = t1 << (t2 & 63); + /* Compute mask for byte */ + t1 = ~t1; + t1 = t6 & t1; + t1 = t6 - t1; + /* J. if character fits. */ + if (t1 == 0) + goto g6745; + arg5 = 0; + arg2 = 62; + goto illegaloperand; + +g6751: + if (_trace) printf("g6751:\n"); + t8 = (arg6 == Array_ElementTypeFixnum) ? 1 : 0; + +g6756: + if (_trace) printf("g6756:\n"); + if (t8 == 0) + goto g6752; + /* Here if argument ArrayElementTypeFixnum */ + t2 = t1 - Type_Fixnum; + if (t2 == 0) + goto g6745; + arg5 = 0; + arg2 = 33; + goto illegaloperand; + +g6752: + if (_trace) printf("g6752:\n"); + t8 = (arg6 == Array_ElementTypeBoolean) ? 1 : 0; + +g6757: + if (_trace) printf("g6757:\n"); + if (t8 == 0) + goto g6750; + /* Here if argument ArrayElementTypeBoolean */ + t6 = 1; + t1 = t1 - Type_NIL; + /* J. if True */ + if (t1 != 0) + goto g6745; + t6 = zero; + goto g6745; + +g6750: + if (_trace) printf("g6750:\n"); + /* Shove it in. */ + +g6745: + if (_trace) printf("g6745:\n"); + /* J. if packed */ + if (arg5 != 0) + goto g6747; + t1 = arg6 - Array_ElementTypeObject; + if (t1 != 0) + goto g6747; + /* Here for the simple non packed case */ + t1 = t9 + arg2; + /* Memory Read Internal */ + +g6758: + /* Base of stack cache */ + t4 = *(u64 *)&(processor->stackcachebasevma); + t8 = t1 + ivory; + t7 = *(s32 *)&processor->scovlimit; + t3 = (t8 * 4); + t2 = LDQ_U(t8); + /* Stack cache offset */ + t4 = t1 - t4; + arg1 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t4 < (u64)t7) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t8&7)*8)); + if (t7 != 0) + goto g6760; + +g6759: + t8 = zero + 240; + arg1 = arg1 >> (t2 & 63); + t8 = t8 >> (t2 & 63); + if (arg1 & 1) + goto g6762; + +g6768: + /* Merge cdr-code */ + t3 = t5 & 63; + t2 = t2 & 192; + t2 = t2 | t3; + t7 = *(u64 *)&(processor->stackcachebasevma); + t4 = t1 + ivory; + arg1 = *(s32 *)&processor->scovlimit; + t3 = (t4 * 4); + t8 = LDQ_U(t4); + /* Stack cache offset */ + t7 = t1 - t7; + /* In range? */ + arg1 = ((u64)t7 < (u64)arg1) ? 1 : 0; + t7 = (t2 & 0xff) << ((t4&7)*8); + t8 = t8 & ~(0xffL << (t4&7)*8); + +g6770: + if (_trace) printf("g6770:\n"); + t8 = t8 | t7; + STQ_U(t4, t8); + *(u32 *)t3 = t6; + /* J. if in cache */ + if (arg1 != 0) + goto g6769; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + /* Here for the slow packed version */ + +g6747: + if (_trace) printf("g6747:\n"); + arg2 = arg4 + arg2; + /* Convert byte index to word index */ + t1 = arg2 >> (arg5 & 63); + /* Address of word containing byte */ + t1 = t1 + t9; + /* Memory Read Internal */ + +g6771: + /* Base of stack cache */ + t2 = *(u64 *)&(processor->stackcachebasevma); + t4 = t1 + ivory; + t3 = *(s32 *)&processor->scovlimit; + t9 = (t4 * 4); + arg3 = LDQ_U(t4); + /* Stack cache offset */ + t2 = t1 - t2; + t7 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t3 = ((u64)t2 < (u64)t3) ? 1 : 0; + t9 = *(s32 *)t9; + arg3 = (u8)(arg3 >> ((t4&7)*8)); + if (t3 != 0) + goto g6773; + +g6772: + t4 = zero + 240; + t7 = t7 >> (arg3 & 63); + t4 = t4 >> (arg3 & 63); + t9 = (u32)t9; + if (t7 & 1) + goto g6775; + +g6782: + /* Check fixnum element type */ + /* TagType. */ + t2 = arg3 & 63; + t2 = t2 - Type_Fixnum; + /* J. if element type not fixnum. */ + if (t2 != 0) + goto g6748; + /* J. if unpacked fixnum element type. */ + if (arg5 == 0) + goto g6749; + t8 = ~zero; + t8 = t8 << (arg5 & 63); + t2 = zero - arg5; + /* Compute subword index */ + t8 = arg2 & ~t8; + t2 = t2 + 5; + /* Compute shift to get byte */ + t2 = t8 << (t2 & 63); + t8 = 32; + /* Compute size of byte */ + t8 = t8 >> (arg5 & 63); + t3 = ~zero; + t3 = t3 << (t8 & 63); + /* Compute mask for byte */ + t4 = ~t3; + /* inserting into the low byte is easy */ + if (t2 == 0) + goto g6783; + /* Inserting the byte into any byte other than the low byte */ + t7 = 64; + /* = the left shift rotate amount */ + t8 = t7 - t2; + /* shift selected byte into low end of word. */ + t7 = t9 >> (t2 & 63); + /* rotate low bits into high end of word. */ + t9 = t9 << (t8 & 63); + /* Remove unwanted bits */ + t7 = t3 & t7; + /* rotate low bits back into place. */ + t9 = t9 >> (t8 & 63); + /* Strip any extra bits from element */ + t8 = t6 & t4; + /* Insert new bits. */ + t7 = t8 | t7; + /* reposition bits */ + t7 = t7 << (t2 & 63); + /* Replace low order bits */ + t9 = t9 | t7; + goto g6784; + +g6783: + if (_trace) printf("g6783:\n"); + /* Inserting the byte into the low byte */ + /* Remove the old low byte */ + t9 = t9 & t3; + /* Remove unwanted bits from the new byte */ + t8 = t6 & t4; + /* Insert the new byte in place of the old byte */ + t9 = t9 | t8; + +g6784: + if (_trace) printf("g6784:\n"); + t6 = t9; + +g6749: + if (_trace) printf("g6749:\n"); + t3 = *(u64 *)&(processor->stackcachebasevma); + t2 = t1 + ivory; + t8 = *(s32 *)&processor->scovlimit; + t7 = (t2 * 4); + t4 = LDQ_U(t2); + /* Stack cache offset */ + t3 = t1 - t3; + /* In range? */ + t8 = ((u64)t3 < (u64)t8) ? 1 : 0; + t3 = (arg3 & 0xff) << ((t2&7)*8); + t4 = t4 & ~(0xffL << (t2&7)*8); + +g6786: + if (_trace) printf("g6786:\n"); + t4 = t4 | t3; + STQ_U(t2, t4); + *(u32 *)t7 = t6; + /* J. if in cache */ + if (t8 != 0) + goto g6785; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g6748: + if (_trace) printf("g6748:\n"); + arg5 = t1; + arg2 = 25; + goto illegaloperand; +#ifdef TRACING + goto DoAset1IM; +#endif + +DoAset1IM: + if (_trace) printf("DoAset1IM:\n"); + t8 = zero + AutoArrayRegMask; + /* Get the array tag/data */ + arg4 = *(s32 *)iSP; + /* Get the array tag/data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + t7 = (u64)&processor->ac0array; + t8 = arg4 & t8; + /* This is the address of the array register block. */ + t7 = t7 + t8; + /* Get the new value tag/data */ + t6 = *(s32 *)iSP; + /* Get the new value tag/data */ + t5 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t6 = (u32)t6; + goto aset1merge; + +g6785: + if (_trace) printf("g6785:\n"); + t3 = *(u64 *)&(processor->stackcachebasevma); + +g6787: + if (_trace) printf("g6787:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t3 = t1 - t3; + /* reconstruct SCA */ + t2 = (t3 * 8) + t2; + /* Store in stack */ + *(u32 *)t2 = t6; + /* write the stack cache */ + *(u32 *)(t2 + 4) = arg3; + goto NEXTINSTRUCTION; + +g6773: + if (_trace) printf("g6773:\n"); + t3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t2 = (t2 * 8) + t3; + t9 = *(s32 *)t2; + /* Read from stack cache */ + arg3 = *(s32 *)(t2 + 4); + goto g6772; + +g6775: + if (_trace) printf("g6775:\n"); + if ((t4 & 1) == 0) + goto g6774; + /* Do the indirect thing */ + t1 = (u32)t9; + goto g6771; + +g6774: + if (_trace) printf("g6774:\n"); + /* Load the memory action table for cycle */ + t7 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t4 = arg3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t4 = (t4 * 4) + t7; + /* Get the memory action */ + t7 = *(s32 *)t4; + +g6779: + if (_trace) printf("g6779:\n"); + t4 = t7 & MemoryActionTransform; + if (t4 == 0) + goto g6778; + arg3 = arg3 & ~63L; + arg3 = arg3 | Type_ExternalValueCellPointer; + goto g6782; +#ifndef MINIMA + +g6778: +#endif +#ifdef MINIMA + +g6778: + if (_trace) printf("g6778:\n"); + t4 = t7 & MemoryActionBinding; + t3 = *(u64 *)&(processor->dbcmask); + if (t4 == 0) + goto g6777; + t2 = t1 << 1; + t4 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t2 = t2 & t3; + t3 = 1; + t3 = t3 << (ivorymemorydata & 63); + t2 = (s32)t2 + (s32)t4; + /* Clear sign-extension */ + t2 = (u32)t2; + t3 = (t2 * 4) + t3; + /* Fetch the key */ + t2 = *(s32 *)t3; + /* Fetch value */ + t9 = *(s32 *)(t3 + 4); + /* Compare */ + t4 = (s32)t1 - (s32)t2; + /* Trap on miss */ + if (t4 != 0) + goto g6781; + /* Extract the pointer, and indirect */ + t1 = (u32)t9; + goto g6771; + +g6781: + if (_trace) printf("g6781:\n"); + goto dbcachemisstrap; +#endif + +g6777: + /* Perform memory action */ + arg1 = t7; + arg2 = 0; + goto performmemoryaction; + +g6769: + if (_trace) printf("g6769:\n"); + t7 = *(u64 *)&(processor->stackcachebasevma); + +g6788: + if (_trace) printf("g6788:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = t1 - t7; + /* reconstruct SCA */ + t4 = (t7 * 8) + t4; + /* Store in stack */ + *(u32 *)t4 = t6; + /* write the stack cache */ + *(u32 *)(t4 + 4) = t2; + goto NEXTINSTRUCTION; + +g6760: + if (_trace) printf("g6760:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t4 = (t4 * 8) + t7; + t3 = *(s32 *)t4; + /* Read from stack cache */ + t2 = *(s32 *)(t4 + 4); + goto g6759; + +g6762: + if (_trace) printf("g6762:\n"); + if ((t8 & 1) == 0) + goto g6761; + /* Do the indirect thing */ + t1 = (u32)t3; + goto g6758; + +g6761: + if (_trace) printf("g6761:\n"); + /* Load the memory action table for cycle */ + arg1 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + arg1; + /* Get the memory action */ + arg1 = *(s32 *)t8; +#ifndef MINIMA + +g6765: +#endif +#ifdef MINIMA + +g6765: + if (_trace) printf("g6765:\n"); + t8 = arg1 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g6764; + t4 = t1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t4 = t4 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t4 = (s32)t4 + (s32)t8; + /* Clear sign-extension */ + t4 = (u32)t4; + t7 = (t4 * 4) + t7; + /* Fetch the key */ + t4 = *(s32 *)t7; + /* Fetch value */ + t3 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)t1 - (s32)t4; + /* Trap on miss */ + if (t8 != 0) + goto g6767; + /* Extract the pointer, and indirect */ + t1 = (u32)t3; + goto g6758; + +g6767: + if (_trace) printf("g6767:\n"); + goto dbcachemisstrap; +#endif + +g6764: + /* Perform memory action */ + arg1 = arg1; + arg2 = 1; + goto performmemoryaction; + +/* end DoAset1 */ + /* End of Halfword operand from stack instruction - DoAset1 */ +/* start DoFastAref1 */ + + /* Halfword operand from stack instruction - DoFastAref1 */ + /* arg2 has the preloaded 8 bit operand. */ + +dofastaref1: + if (_trace) printf("dofastaref1:\n"); +#ifdef TRACING +#endif + +DoFastAref1SP: + if (_trace) printf("DoFastAref1SP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindofastaref1; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindofastaref1; +#endif + +DoFastAref1LP: + if (_trace) printf("DoFastAref1LP:\n"); +#ifdef TRACING + goto begindofastaref1; +#endif + +DoFastAref1FP: + if (_trace) printf("DoFastAref1FP:\n"); + +begindofastaref1: + if (_trace) printf("begindofastaref1:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (s32)arg6; + t1 = arg3 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto fastaref1iop; + +fastaref1retry: + if (_trace) printf("fastaref1retry:\n"); + arg6 = *(s32 *)arg1; + t9 = *(s32 *)(arg1 + 8); + t3 = *(s32 *)(arg1 + 16); + arg6 = (u32)arg6; + t9 = (u32)t9; + t5 = arg6 << 42; + t3 = (u32)t3; + t4 = *(u64 *)&(processor->areventcount); + t5 = t5 >> 42; + t2 = ((u64)arg4 < (u64)t3) ? 1 : 0; + if (t2 == 0) + goto fastaref1bounds; + t6 = t4 - t5; + if (t6 != 0) + goto aref1recomputearrayregister; + t6 = arg6 >> (Array_RegisterBytePackingPos & 63); + t7 = arg6 >> (Array_RegisterByteOffsetPos & 63); + t8 = arg6 >> (Array_RegisterElementTypePos & 63); + t6 = t6 & Array_RegisterBytePackingMask; + t7 = t7 & Array_RegisterByteOffsetMask; + t8 = t8 & Array_RegisterElementTypeMask; + if (t6 != 0) + goto g6789; + t1 = t9 + arg4; + +g6790: + if (_trace) printf("g6790:\n"); + /* Memory Read Internal */ + +g6797: + /* Base of stack cache */ + t2 = *(u64 *)&(processor->stackcachebasevma); + t4 = t1 + ivory; + t3 = *(s32 *)&processor->scovlimit; + t9 = (t4 * 4); + arg5 = LDQ_U(t4); + /* Stack cache offset */ + t2 = t1 - t2; + t5 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t3 = ((u64)t2 < (u64)t3) ? 1 : 0; + t9 = *(s32 *)t9; + arg5 = (u8)(arg5 >> ((t4&7)*8)); + if (t3 != 0) + goto g6799; + +g6798: + t4 = zero + 240; + t5 = t5 >> (arg5 & 63); + t4 = t4 >> (arg5 & 63); + t9 = (u32)t9; + if (t5 & 1) + goto g6801; + +g6808: + if (t6 != 0) + goto g6791; + +g6792: + if (_trace) printf("g6792:\n"); + r31 = r31 | r31; + t1 = t8 - 2; + if ((s64)t1 <= 0) + goto g6793; + /* TagType. */ + arg5 = arg5 & 63; + +g6794: + if (_trace) printf("g6794:\n"); + *(u32 *)(iSP + 4) = arg5; + t4 = (t6 == 0) ? 1 : 0; + if (t4 == 0) + goto case_others_14; + +case_0_8: + if (_trace) printf("case_0_8:\n"); + r31 = r31 | r31; + if (t1 == 0) + goto g6795; + *(u32 *)iSP = t9; + goto NEXTINSTRUCTION; + +case_2_9: + if (_trace) printf("case_2_9:\n"); + /* AREF1-8B */ + r31 = r31 | r31; + t4 = arg4 & 3; + t5 = (u8)(t9 >> ((t4&7)*8)); + if (t1 == 0) + goto g6795; + *(u32 *)iSP = t5; + goto NEXTINSTRUCTION; + +case_3_10: + if (_trace) printf("case_3_10:\n"); + /* AREF1-4B */ + r31 = r31 | r31; + /* byte-index */ + t4 = arg4 & 7; + /* byte-position */ + t4 = t4 << 2; + /* byte in position */ + t5 = t9 >> (t4 & 63); + /* byte masked */ + t5 = t5 & 15; + if (t1 == 0) + goto g6795; + *(u32 *)iSP = t5; + goto NEXTINSTRUCTION; + +case_5_11: + if (_trace) printf("case_5_11:\n"); + /* AREF1-1B */ + r31 = r31 | r31; + /* byte-index */ + t4 = arg4 & 31; + r31 = r31 | r31; + /* byte in position */ + t5 = t9 >> (t4 & 63); + /* byte masked */ + t5 = t5 & 1; + if (t1 == 0) + goto g6795; + *(u32 *)iSP = t5; + goto NEXTINSTRUCTION; + +case_1_12: + if (_trace) printf("case_1_12:\n"); + /* AREF1-16B */ + t4 = arg4 & 1; + /* Bletch, it's a byte ref */ + t4 = t4 + t4; + t5 = (u16)(t9 >> ((t4&7)*8)); + if (t1 == 0) + goto g6795; + *(u32 *)iSP = t5; + goto NEXTINSTRUCTION; + +case_others_14: + if (_trace) printf("case_others_14:\n"); + r31 = r31 | r31; + t4 = (t6 == 2) ? 1 : 0; + t5 = (t6 == 3) ? 1 : 0; + if (t4 != 0) + goto case_2_9; + t4 = (t6 == 5) ? 1 : 0; + if (t5 != 0) + goto case_3_10; + t5 = (t6 == 1) ? 1 : 0; + if (t4 != 0) + goto case_5_11; + if (t5 != 0) + goto case_1_12; + +case_4_13: + if (_trace) printf("case_4_13:\n"); + /* AREF1-2B */ + r31 = r31 | r31; + /* byte-index */ + t4 = arg4 & 15; + /* byte-position */ + t4 = t4 << 1; + /* byte in position */ + t5 = t9 >> (t4 & 63); + /* byte masked */ + t5 = t5 & 3; + if (t1 == 0) + goto g6795; + *(u32 *)iSP = t5; + goto NEXTINSTRUCTION; + +g6789: + if (_trace) printf("g6789:\n"); + arg4 = t7 + arg4; + /* Convert byte index to word index */ + t1 = arg4 >> (t6 & 63); + /* Address of word containing byte */ + t1 = t1 + t9; + goto g6790; + +g6791: + if (_trace) printf("g6791:\n"); + t1 = arg5 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto g6796; + goto g6792; + +g6793: + if (_trace) printf("g6793:\n"); + arg5 = Type_Character; + if (t8 & 1) + goto g6794; + arg5 = Type_Fixnum; + if (t8 == 0) + goto g6794; + t2 = *(u64 *)&(processor->niladdress); + t3 = *(u64 *)&(processor->taddress); + goto g6794; + +g6795: + if (_trace) printf("g6795:\n"); + if (t5) + t2 = t3; + *(u64 *)iSP = t2; + goto NEXTINSTRUCTION; + +g6796: + if (_trace) printf("g6796:\n"); + arg5 = t1; + arg2 = 25; + goto illegaloperand; + +fastaref1iop: + if (_trace) printf("fastaref1iop:\n"); + arg5 = 0; + arg2 = 32; + goto illegaloperand; + +fastaref1bounds: + if (_trace) printf("fastaref1bounds:\n"); + arg5 = 0; + arg2 = 13; + goto illegaloperand; + +g6799: + if (_trace) printf("g6799:\n"); + t3 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t2 = (t2 * 8) + t3; + t9 = *(s32 *)t2; + /* Read from stack cache */ + arg5 = *(s32 *)(t2 + 4); + goto g6798; + +g6801: + if (_trace) printf("g6801:\n"); + if ((t4 & 1) == 0) + goto g6800; + /* Do the indirect thing */ + t1 = (u32)t9; + goto g6797; + +g6800: + if (_trace) printf("g6800:\n"); + /* Load the memory action table for cycle */ + t5 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t4 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t4 = (t4 * 4) + t5; + /* Get the memory action */ + t5 = *(s32 *)t4; + +g6805: + if (_trace) printf("g6805:\n"); + t4 = t5 & MemoryActionTransform; + if (t4 == 0) + goto g6804; + arg5 = arg5 & ~63L; + arg5 = arg5 | Type_ExternalValueCellPointer; + goto g6808; +#ifndef MINIMA + +g6804: +#endif +#ifdef MINIMA + +g6804: + if (_trace) printf("g6804:\n"); + t4 = t5 & MemoryActionBinding; + t3 = *(u64 *)&(processor->dbcmask); + if (t4 == 0) + goto g6803; + t2 = t1 << 1; + t4 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t2 = t2 & t3; + t3 = 1; + t3 = t3 << (ivorymemorydata & 63); + t2 = (s32)t2 + (s32)t4; + /* Clear sign-extension */ + t2 = (u32)t2; + t3 = (t2 * 4) + t3; + /* Fetch the key */ + t2 = *(s32 *)t3; + /* Fetch value */ + t9 = *(s32 *)(t3 + 4); + /* Compare */ + t4 = (s32)t1 - (s32)t2; + /* Trap on miss */ + if (t4 != 0) + goto g6807; + /* Extract the pointer, and indirect */ + t1 = (u32)t9; + goto g6797; + +g6807: + if (_trace) printf("g6807:\n"); + goto dbcachemisstrap; +#endif + +g6803: + /* Perform memory action */ + arg1 = t5; + arg2 = 0; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoFastAref1IM: + goto doistageerror; + +/* end DoFastAref1 */ + /* End of Halfword operand from stack instruction - DoFastAref1 */ +/* start DoRplaca */ + + /* Halfword operand from stack instruction - DoRplaca */ + +dorplaca: + if (_trace) printf("dorplaca:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoRplacaIM: + if (_trace) printf("DoRplacaIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g6822: + if (_trace) printf("g6822:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindorplaca; +#ifdef TRACING +#endif + +DoRplacaSP: + if (_trace) printf("DoRplacaSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto headdorplaca; + /* SP-pop mode, TOS->arg1 */ + arg1 = arg6; + /* Reload TOS */ + arg6 = *(u64 *)arg4; + /* Adjust SP */ + iSP = arg4; + goto begindorplaca; +#ifdef TRACING + goto headdorplaca; +#endif + +DoRplacaLP: + if (_trace) printf("DoRplacaLP:\n"); +#ifdef TRACING + goto headdorplaca; +#endif + +DoRplacaFP: + if (_trace) printf("DoRplacaFP:\n"); + +headdorplaca: + if (_trace) printf("headdorplaca:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindorplaca: + if (_trace) printf("begindorplaca:\n"); + /* arg1 has the operand, sign extended if immediate. */ + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + t1 = (u32)(arg6 >> ((4&7)*8)); + /* Read ARG1, the list */ + arg2 = (u32)arg6; + /* Pop Stack. */ + iSP = iSP - 8; + /* TagType. */ + t3 = t1 & 63; + t4 = t3 - Type_List; + t4 = t4 & ~4L; + if (t4 != 0) + goto rplacaexception; + +rplacstore: + if (_trace) printf("rplacstore:\n"); + /* Tag for t2 */ + t2 = arg1 >> 32; + /* data for t2 */ + arg1 = (u32)arg1; + /* Memory Read Internal */ + +g6809: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6811; + +g6810: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6813; + +g6819: + /* Merge cdr-code */ + arg6 = t2 & 63; + arg5 = arg5 & 192; + arg5 = arg5 | arg6; + t5 = arg2 + ivory; + arg6 = (t5 * 4); + t7 = LDQ_U(t5); + /* Stack cache offset */ + t6 = arg2 - t11; + /* In range? */ + t8 = ((u64)t6 < (u64)t12) ? 1 : 0; + t6 = (arg5 & 0xff) << ((t5&7)*8); + t7 = t7 & ~(0xffL << (t5&7)*8); + +g6821: + if (_trace) printf("g6821:\n"); + t7 = t7 | t6; + STQ_U(t5, t7); + *(u32 *)arg6 = arg1; + /* J. if in cache */ + if (t8 != 0) + goto g6820; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g6820: + if (_trace) printf("g6820:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t6 = arg2 - t11; + /* reconstruct SCA */ + t5 = (t6 * 8) + t5; + /* Store in stack */ + *(u32 *)t5 = arg1; + /* write the stack cache */ + *(u32 *)(t5 + 4) = arg5; + goto NEXTINSTRUCTION; + +g6811: + if (_trace) printf("g6811:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + arg6 = *(s32 *)t5; + /* Read from stack cache */ + arg5 = *(s32 *)(t5 + 4); + goto g6810; + +g6813: + if (_trace) printf("g6813:\n"); + if ((t7 & 1) == 0) + goto g6812; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6809; + +g6812: + if (_trace) printf("g6812:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t7 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; +#ifndef MINIMA + +g6816: +#endif +#ifdef MINIMA + +g6816: + if (_trace) printf("g6816:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g6815; + t5 = arg2 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + arg6 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)arg2 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g6818; + /* Extract the pointer, and indirect */ + arg2 = (u32)arg6; + goto g6809; + +g6818: + if (_trace) printf("g6818:\n"); + goto dbcachemisstrap; +#endif + +g6815: + /* Perform memory action */ + arg1 = t8; + arg2 = 1; + goto performmemoryaction; + +/* end DoRplaca */ + /* End of Halfword operand from stack instruction - DoRplaca */ +/* start MemoryReadWrite */ + + +memoryreadwrite: + if (_trace) printf("memoryreadwrite:\n"); + /* Memory Read Internal */ + +g6823: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6825; + +g6824: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6827; + +g6832: + goto *r0; /* ret */ + +memoryreadwritedecode: + if (_trace) printf("memoryreadwritedecode:\n"); + if (t6 == 0) + goto g6826; + +g6825: + if (_trace) printf("g6825:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + arg6 = *(s32 *)t5; + /* Read from stack cache */ + arg5 = *(s32 *)(t5 + 4); + goto g6824; + +g6827: + if (_trace) printf("g6827:\n"); + if ((t7 & 1) == 0) + goto g6826; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6823; + +g6826: + if (_trace) printf("g6826:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t7 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg2; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; +#ifndef MINIMA + +g6829: +#endif +#ifdef MINIMA + +g6829: + if (_trace) printf("g6829:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g6828; + t5 = arg2 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + arg6 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)arg2 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g6831; + /* Extract the pointer, and indirect */ + arg2 = (u32)arg6; + goto g6823; + +g6831: + if (_trace) printf("g6831:\n"); + goto dbcachemisstrap; +#endif + +g6828: + /* Perform memory action */ + arg1 = t8; + arg2 = 1; + goto performmemoryaction; + +/* end MemoryReadWrite */ +/* start DoRplacd */ + + /* Halfword operand from stack instruction - DoRplacd */ + +dorplacd: + if (_trace) printf("dorplacd:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoRplacdIM: + if (_trace) printf("DoRplacdIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g6843: + if (_trace) printf("g6843:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindorplacd; +#ifdef TRACING +#endif + +DoRplacdSP: + if (_trace) printf("DoRplacdSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto headdorplacd; + /* SP-pop mode, TOS->arg1 */ + arg1 = arg6; + /* Reload TOS */ + arg6 = *(u64 *)arg4; + /* Adjust SP */ + iSP = arg4; + goto begindorplacd; +#ifdef TRACING + goto headdorplacd; +#endif + +DoRplacdLP: + if (_trace) printf("DoRplacdLP:\n"); +#ifdef TRACING + goto headdorplacd; +#endif + +DoRplacdFP: + if (_trace) printf("DoRplacdFP:\n"); + +headdorplacd: + if (_trace) printf("headdorplacd:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindorplacd: + if (_trace) printf("begindorplacd:\n"); + /* arg1 has the operand, sign extended if immediate. */ + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + t1 = (u32)(arg6 >> ((4&7)*8)); + /* Read ARG1, the list */ + arg2 = (u32)arg6; + /* Pop Stack. */ + iSP = iSP - 8; + /* TagType. */ + t3 = t1 & 63; + t4 = t3 - Type_Locative; + if (t4 == 0) + goto rplacstore; + t4 = t3 - Type_List; + if (t4 != 0) + goto rplacdexception; + /* Memory Read Internal */ + +g6833: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->cdr_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6835; + +g6834: + t7 = zero + 192; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g6837; + +g6842: + /* TagCdr. */ + arg5 = arg5 >> 6; + arg5 = arg5 - Cdr_Normal; + /* J. if CDR coded */ + if (arg5 != 0) + goto rplacdexception; + /* address of CDR */ + arg2 = arg2 + 1; + goto rplacstore; + +g6837: + if (_trace) printf("g6837:\n"); + if ((t7 & 1) == 0) + goto g6836; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6833; + +g6836: + if (_trace) printf("g6836:\n"); + +g6835: + if (_trace) printf("g6835:\n"); + r0 = (u64)&&return0029; + goto memoryreadcdrdecode; +return0029: + goto g6842; + +/* end DoRplacd */ + /* End of Halfword operand from stack instruction - DoRplacd */ +/* start DoBranchTrueAndExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchTrueAndExtraPop */ + +dobranchtrueandextrapop: + if (_trace) printf("dobranchtrueandextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueAndExtraPopIM: + if (_trace) printf("DoBranchTrueAndExtraPopIM:\n"); + +DoBranchTrueAndExtraPopSP: + if (_trace) printf("DoBranchTrueAndExtraPopSP:\n"); + +DoBranchTrueAndExtraPopLP: + if (_trace) printf("DoBranchTrueAndExtraPopLP:\n"); + +DoBranchTrueAndExtraPopFP: + if (_trace) printf("DoBranchTrueAndExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto dobrpopextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrpopextrapop: + if (_trace) printf("dobrpopextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 16; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrueAndExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchTrueAndExtraPop */ +/* start DoBranchFalseAndExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchFalseAndExtraPop */ + +dobranchfalseandextrapop: + if (_trace) printf("dobranchfalseandextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseAndExtraPopIM: + if (_trace) printf("DoBranchFalseAndExtraPopIM:\n"); + +DoBranchFalseAndExtraPopSP: + if (_trace) printf("DoBranchFalseAndExtraPopSP:\n"); + +DoBranchFalseAndExtraPopLP: + if (_trace) printf("DoBranchFalseAndExtraPopLP:\n"); + +DoBranchFalseAndExtraPopFP: + if (_trace) printf("DoBranchFalseAndExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto dobrnpopextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrnpopextrapop: + if (_trace) printf("dobrnpopextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 16; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalseAndExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchFalseAndExtraPop */ +/* start DoBranchTrueAndNoPop */ + + /* Halfword 10 bit immediate instruction - DoBranchTrueAndNoPop */ + +dobranchtrueandnopop: + if (_trace) printf("dobranchtrueandnopop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueAndNoPopIM: + if (_trace) printf("DoBranchTrueAndNoPopIM:\n"); + +DoBranchTrueAndNoPopSP: + if (_trace) printf("DoBranchTrueAndNoPopSP:\n"); + +DoBranchTrueAndNoPopLP: + if (_trace) printf("DoBranchTrueAndNoPopLP:\n"); + +DoBranchTrueAndNoPopFP: + if (_trace) printf("DoBranchTrueAndNoPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto dobrelsepop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrelsepop: + if (_trace) printf("dobrelsepop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrueAndNoPop */ + /* End of Halfword operand from stack instruction - DoBranchTrueAndNoPop */ +/* start DoBranchFalseAndNoPop */ + + /* Halfword 10 bit immediate instruction - DoBranchFalseAndNoPop */ + +dobranchfalseandnopop: + if (_trace) printf("dobranchfalseandnopop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseAndNoPopIM: + if (_trace) printf("DoBranchFalseAndNoPopIM:\n"); + +DoBranchFalseAndNoPopSP: + if (_trace) printf("DoBranchFalseAndNoPopSP:\n"); + +DoBranchFalseAndNoPopLP: + if (_trace) printf("DoBranchFalseAndNoPopLP:\n"); + +DoBranchFalseAndNoPopFP: + if (_trace) printf("DoBranchFalseAndNoPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto dobrnelsepop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrnelsepop: + if (_trace) printf("dobrnelsepop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalseAndNoPop */ + /* End of Halfword operand from stack instruction - DoBranchFalseAndNoPop */ +/* start DoBranchFalseElseNoPop */ + + /* Halfword 10 bit immediate instruction - DoBranchFalseElseNoPop */ + +dobranchfalseelsenopop: + if (_trace) printf("dobranchfalseelsenopop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseElseNoPopIM: + if (_trace) printf("DoBranchFalseElseNoPopIM:\n"); + +DoBranchFalseElseNoPopSP: + if (_trace) printf("DoBranchFalseElseNoPopSP:\n"); + +DoBranchFalseElseNoPopLP: + if (_trace) printf("DoBranchFalseElseNoPopLP:\n"); + +DoBranchFalseElseNoPopFP: + if (_trace) printf("DoBranchFalseElseNoPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto NEXTINSTRUCTION; + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalseElseNoPop */ + /* End of Halfword operand from stack instruction - DoBranchFalseElseNoPop */ +/* start DoEqualNumber */ + + /* Halfword operand from stack instruction - DoEqualNumber */ + /* arg2 has the preloaded 8 bit operand. */ + +doequalnumber: + if (_trace) printf("doequalnumber:\n"); +#ifdef TRACING +#endif + +DoEqualNumberSP: + if (_trace) printf("DoEqualNumberSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindoequalnumber; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindoequalnumber; +#endif + +DoEqualNumberLP: + if (_trace) printf("DoEqualNumberLP:\n"); +#ifdef TRACING + goto begindoequalnumber; +#endif + +DoEqualNumberFP: + if (_trace) printf("DoEqualNumberFP:\n"); + +begindoequalnumber: + if (_trace) printf("begindoequalnumber:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + t7 = arg3 >> 12; + t12 = *(u64 *)&(processor->taddress); + /* Get ARG1 tag */ + arg3 = (u32)(arg6 >> ((4&7)*8)); + /* t1 is tag of arg2 */ + t1 = *(s32 *)(arg1 + 4); + LDS(1, f1, *(u32 *)iSP ); + t7 = t7 & 1; + arg2 = *(s32 *)arg1; + arg4 = (s32)arg6; + LDS(2, f2, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t5 = arg3 & 63; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t6 = (t5 == Type_Fixnum) ? 1 : 0; + +g6861: + if (_trace) printf("g6861:\n"); + if (t6 == 0) + goto g6849; + /* Here if argument TypeFixnum */ + t3 = (t4 == Type_Fixnum) ? 1 : 0; + +g6853: + if (_trace) printf("g6853:\n"); + if (t3 == 0) + goto g6844; + /* Here if argument TypeFixnum */ + t2 = (s32)arg4 - (s32)arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Pop/No-pop */ + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if (t2 == 0) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g6850: + if (_trace) printf("g6850:\n"); + +g6849: + if (_trace) printf("g6849:\n"); + t6 = (t5 == Type_SingleFloat) ? 1 : 0; + +g6862: + if (_trace) printf("g6862:\n"); + if (t6 == 0) + goto g6854; + /* Here if argument TypeSingleFloat */ + t3 = (t4 == Type_SingleFloat) ? 1 : 0; + +g6858: + if (_trace) printf("g6858:\n"); + if (t3 == 0) + goto g6844; + /* Here if argument TypeSingleFloat */ + +equalnumbermmexcfltflt: + if (_trace) printf("equalnumbermmexcfltflt:\n"); + SETFLTT(3,f3, FLTU64(1,f1) == FLTU64(2,f2) ? 2.0:0); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)iSP = t12; + if (FLTU64(3, f3) != 0.0) + goto cachevalid; + /* Didn't branch, answer is NIL */ + *(u64 *)iSP = t11; + goto cachevalid; + +g6855: + if (_trace) printf("g6855:\n"); + +g6854: + if (_trace) printf("g6854:\n"); + /* Here for all other cases */ + +g6844: + if (_trace) printf("g6844:\n"); + goto equalnumbermmexc; + +g6848: + if (_trace) printf("g6848:\n"); +#ifdef TRACING + goto DoEqualNumberIM; +#endif + +DoEqualNumberIM: + if (_trace) printf("DoEqualNumberIM:\n"); + t11 = *(u64 *)&(processor->niladdress); + /* First half of sign extension */ + arg2 = arg2 << 56; + t12 = *(u64 *)&(processor->taddress); + t7 = arg3 >> 12; + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (s32)arg6; + /* Second half of sign extension */ + arg2 = (s64)arg2 >> 56; + t7 = t7 & 1; + /* Strip off any CDR code bits. */ + t3 = arg3 & 63; + t4 = (t3 == Type_Fixnum) ? 1 : 0; + +g6867: + if (_trace) printf("g6867:\n"); + if (t4 == 0) + goto g6864; + /* Here if argument TypeFixnum */ + t2 = (s32)arg4 - (s32)arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if (t2 == 0) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g6864: + if (_trace) printf("g6864:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g6863: + if (_trace) printf("g6863:\n"); + +/* end DoEqualNumber */ + /* End of Halfword operand from stack instruction - DoEqualNumber */ +/* start DoSetToCdrPushCar */ + + /* Halfword operand from stack instruction - DoSetToCdrPushCar */ + /* arg2 has the preloaded 8 bit operand. */ + +dosettocdrpushcar: + if (_trace) printf("dosettocdrpushcar:\n"); +#ifdef TRACING +#endif + +DoSetToCdrPushCarSP: + if (_trace) printf("DoSetToCdrPushCarSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindosettocdrpushcar; +#endif + +DoSetToCdrPushCarLP: + if (_trace) printf("DoSetToCdrPushCarLP:\n"); +#ifdef TRACING + goto begindosettocdrpushcar; +#endif + +DoSetToCdrPushCarFP: + if (_trace) printf("DoSetToCdrPushCarFP:\n"); + +begindosettocdrpushcar: + if (_trace) printf("begindosettocdrpushcar:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Get the operand from the stack. */ + t2 = *(s32 *)arg1; + t1 = *(s32 *)(arg1 + 4); + t2 = (u32)t2; + /* Save the old CDR code */ + t3 = t1 & 192; + t5 = t1 - Type_Locative; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 == 0) + goto settocdrpushcarlocative; + r0 = (u64)&&return0030; + goto carcdrinternal; +return0030: + /* TagType. */ + arg5 = arg5 & 63; + /* Put back the original CDR codes */ + arg5 = arg5 | t3; + *(u32 *)arg1 = arg6; + /* write the stack cache */ + *(u32 *)(arg1 + 4) = arg5; + /* set CDR-NEXT */ + t5 = t1 & 63; + *(u32 *)(iSP + 8) = t2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; +#ifdef TRACING +#endif + +DoSetToCdrPushCarIM: + goto doistageerror; + +/* end DoSetToCdrPushCar */ + /* End of Halfword operand from stack instruction - DoSetToCdrPushCar */ +/* start DoSub */ + + /* Halfword operand from stack instruction - DoSub */ + /* arg2 has the preloaded 8 bit operand. */ + +dosub: + if (_trace) printf("dosub:\n"); +#ifdef TRACING +#endif + +DoSubSP: + if (_trace) printf("DoSubSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindosub; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindosub; +#endif + +DoSubLP: + if (_trace) printf("DoSubLP:\n"); +#ifdef TRACING + goto begindosub; +#endif + +DoSubFP: + if (_trace) printf("DoSubFP:\n"); + +begindosub: + if (_trace) printf("begindosub:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + LDS(1, f1, *(u32 *)iSP ); + /* ARG1 tag */ + t1 = (u32)(arg6 >> ((4&7)*8)); + /* ARG2 tag */ + t3 = *(s32 *)(arg1 + 4); + /* ARG1 data */ + t2 = (s32)arg6; + /* ARG2 data */ + t4 = *(s32 *)arg1; + LDS(2, f2, *(u32 *)arg1 ); + /* NIL */ + /* Strip off any CDR code bits. */ + t9 = t1 & 63; + /* Strip off any CDR code bits. */ + t11 = t3 & 63; + t10 = (t9 == Type_Fixnum) ? 1 : 0; + +g6907: + if (_trace) printf("g6907:\n"); + if (t10 == 0) + goto g6878; + /* Here if argument TypeFixnum */ + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6884: + if (_trace) printf("g6884:\n"); + if (t12 == 0) + goto g6880; + /* Here if argument TypeFixnum */ + t6 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* compute 64-bit result */ +// t5 = (s64)((s32)t2 - (s64)(s32)t4); /* subl/v */ + /* x86_64 replacement for subl/v */ + asm("movl %k2,%k0 \n\t" + "subl %k3,%k0 \n\t" + "seto %b1" + : "=r"(t5),"=rm"(oflo) + : "rm"(t2),"rm"(t4) + : "cc"); +// if (t5 >> 32) +// exception(); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + CHECK_OFLO(); /* check overflow */ + /* Semi-cheat, we know temp2 has CDRNext/TypeFixnum */ + *(u32 *)(iSP + 4) = t9; + iPC = t6; + *(u32 *)iSP = t5; + iCP = t7; + goto cachevalid; + +g6880: + if (_trace) printf("g6880:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g6885: + if (_trace) printf("g6885:\n"); + if (t12 == 0) + goto g6881; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g6868; + +g6881: + if (_trace) printf("g6881:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g6886: + if (_trace) printf("g6886:\n"); + if (t12 == 0) + goto g6875; + /* Here if argument TypeDoubleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g6871; + +g6879: + if (_trace) printf("g6879:\n"); + +g6878: + if (_trace) printf("g6878:\n"); + t10 = (t9 == Type_SingleFloat) ? 1 : 0; + +g6908: + if (_trace) printf("g6908:\n"); + if (t10 == 0) + goto g6887; + /* Here if argument TypeSingleFloat */ + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g6893: + if (_trace) printf("g6893:\n"); + if (t12 == 0) + goto g6889; + /* Here if argument TypeSingleFloat */ + +g6868: + if (_trace) printf("g6868:\n"); + SUBS(0, f0, 1, f1, 2, f2); /* subs */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + goto cachevalid; + +g6889: + if (_trace) printf("g6889:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6894: + if (_trace) printf("g6894:\n"); + if (t12 == 0) + goto g6890; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g6868; + +g6890: + if (_trace) printf("g6890:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g6895: + if (_trace) printf("g6895:\n"); + if (t12 == 0) + goto g6875; + /* Here if argument TypeDoubleFloat */ + +g6871: + if (_trace) printf("g6871:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + goto g6872; + +g6888: + if (_trace) printf("g6888:\n"); + +g6887: + if (_trace) printf("g6887:\n"); + t10 = (t9 == Type_DoubleFloat) ? 1 : 0; + +g6909: + if (_trace) printf("g6909:\n"); + if (t10 == 0) + goto g6896; + /* Here if argument TypeDoubleFloat */ + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g6902: + if (_trace) printf("g6902:\n"); + if (t12 == 0) + goto g6898; + /* Here if argument TypeDoubleFloat */ + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + r0 = (u64)&&return0031; + goto fetchdoublefloat; +return0031: + LDT(1, f1, processor->fp0); + +g6872: + if (_trace) printf("g6872:\n"); + arg2 = (u32)t4; + r0 = (u64)&&return0032; + goto fetchdoublefloat; +return0032: + LDT(2, f2, processor->fp0); + +g6869: + if (_trace) printf("g6869:\n"); + SUBT(0, f0, 1, f1, 2, f2); + STT( (u64 *)&processor->fp0, 0, f0 ); + r0 = (u64)&&return0033; + goto consdoublefloat; +return0033: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t8 = Type_DoubleFloat; + *(u32 *)iSP = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + goto cachevalid; + +g6898: + if (_trace) printf("g6898:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g6903: + if (_trace) printf("g6903:\n"); + if (t12 == 0) + goto g6899; + /* Here if argument TypeSingleFloat */ + +g6870: + if (_trace) printf("g6870:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + r0 = (u64)&&return0034; + goto fetchdoublefloat; +return0034: + LDT(1, f1, processor->fp0); + goto g6869; + +g6899: + if (_trace) printf("g6899:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6904: + if (_trace) printf("g6904:\n"); + if (t12 == 0) + goto g6875; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g6870; + +g6897: + if (_trace) printf("g6897:\n"); + +g6896: + if (_trace) printf("g6896:\n"); + /* Here for all other cases */ + +g6874: + if (_trace) printf("g6874:\n"); + +dosubovfl: + if (_trace) printf("dosubovfl:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g6876; + +g6875: + if (_trace) printf("g6875:\n"); + t1 = t3; + goto dosubovfl; + +g6876: + if (_trace) printf("g6876:\n"); + +g6877: + if (_trace) printf("g6877:\n"); +#ifdef TRACING + goto DoSubIM; +#endif + +DoSubIM: + if (_trace) printf("DoSubIM:\n"); + t1 = (u32)(arg6 >> ((4&7)*8)); + /* get ARG1 tag/data */ + t2 = (s32)arg6; + /* Strip off any CDR code bits. */ + t11 = t1 & 63; + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g6914: + if (_trace) printf("g6914:\n"); + if (t12 == 0) + goto g6911; + /* Here if argument TypeFixnum */ + /* compute 64-bit result */ + t3 = t2 - arg2; + t4 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* compute 32-bit sign-extended result */ + t10 = (s32)t3; + t5 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* is it the same as the 64-bit result? */ + t10 = (t3 == t10) ? 1 : 0; + /* if not, we overflowed */ + if (t10 == 0) + goto dosubovfl; + /* Semi-cheat, we know temp2 has CDRNext/TypeFixnum */ + *(u32 *)(iSP + 4) = t11; + iPC = t4; + *(u32 *)iSP = t3; + iCP = t5; + goto cachevalid; + +g6911: + if (_trace) printf("g6911:\n"); + /* Here for all other cases */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + arg2 = zero; + goto begindosub; + +g6910: + if (_trace) printf("g6910:\n"); + +/* end DoSub */ + /* End of Halfword operand from stack instruction - DoSub */ +/* start DoTag */ + + /* Halfword operand from stack instruction - DoTag */ + /* arg2 has the preloaded 8 bit operand. */ + +dotag: + if (_trace) printf("dotag:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoTagIM: + if (_trace) printf("DoTagIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + arg2 = zero; + goto begindotag; +#ifdef TRACING +#endif + +DoTagSP: + if (_trace) printf("DoTagSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindotag; +#endif + +DoTagLP: + if (_trace) printf("DoTagLP:\n"); +#ifdef TRACING + goto begindotag; +#endif + +DoTagFP: + if (_trace) printf("DoTagFP:\n"); + +begindotag: + if (_trace) printf("begindotag:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Get the tag of the operand */ + arg1 = *(s32 *)(arg1 + 4); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t3 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t3; + *(u32 *)(iSP + 8) = arg1; + iSP = iSP + 8; + goto cachevalid; + +/* end DoTag */ + /* End of Halfword operand from stack instruction - DoTag */ +/* start DoEndp */ + + /* Halfword operand from stack instruction - DoEndp */ + /* arg2 has the preloaded 8 bit operand. */ + +doendp: + if (_trace) printf("doendp:\n"); +#ifdef TRACING +#endif + +DoEndpSP: + if (_trace) printf("DoEndpSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoendp; +#endif + +DoEndpLP: + if (_trace) printf("DoEndpLP:\n"); +#ifdef TRACING + goto begindoendp; +#endif + +DoEndpFP: + if (_trace) printf("DoEndpFP:\n"); + +begindoendp: + if (_trace) printf("begindoendp:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t1 = *(u64 *)&(processor->niladdress); + /* Get tag. */ + arg2 = *(s32 *)(arg1 + 4); + t2 = *(u64 *)&(processor->taddress); + /* TagType. */ + arg2 = arg2 & 63; + /* Compare */ + t6 = arg2 - Type_NIL; + if (t6 != 0) + goto endpnotnil; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)(iSP + 8) = t2; + iSP = iSP + 8; + goto cachevalid; + +endpnil: + if (_trace) printf("endpnil:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)(iSP + 8) = t1; + iSP = iSP + 8; + goto cachevalid; + +endpnotnil: + if (_trace) printf("endpnotnil:\n"); + /* Now check for list */ + t6 = t6 - 1; + if (t6 == 0) + goto endpnil; + t6 = arg2 - Type_ListInstance; + if (t6 == 0) + goto endpnil; +#ifdef TRACING + goto DoEndpIM; +#endif + +DoEndpIM: + if (_trace) printf("DoEndpIM:\n"); + arg5 = 0; + arg2 = 64; + goto illegaloperand; + +/* end DoEndp */ + /* End of Halfword operand from stack instruction - DoEndp */ +/* start DoMinusp */ + + /* Halfword operand from stack instruction - DoMinusp */ + /* arg2 has the preloaded 8 bit operand. */ + +dominusp: + if (_trace) printf("dominusp:\n"); +#ifdef TRACING +#endif + +DoMinuspSP: + if (_trace) printf("DoMinuspSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindominusp; +#endif + +DoMinuspLP: + if (_trace) printf("DoMinuspLP:\n"); +#ifdef TRACING + goto begindominusp; +#endif + +DoMinuspFP: + if (_trace) printf("DoMinuspFP:\n"); + +begindominusp: + if (_trace) printf("begindominusp:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + t6 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + t1 = *(s32 *)(arg1 + 4); + t12 = *(u64 *)&(processor->taddress); + t2 = *(s32 *)arg1; + LDS(1, f1, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t5 = (t4 == Type_Fixnum) ? 1 : 0; + +g6920: + if (_trace) printf("g6920:\n"); + if (t5 == 0) + goto g6916; + /* Here if argument TypeFixnum */ + iPC = t6; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if predicate succeeds */ + if ((s64)t2 < 0) + t11 = t12; + *(u64 *)(iSP + 8) = t11; + iSP = iSP + 8; + goto cachevalid; + +g6916: + if (_trace) printf("g6916:\n"); + t5 = (t4 == Type_SingleFloat) ? 1 : 0; + +g6921: + if (_trace) printf("g6921:\n"); + if (t5 == 0) + goto g6917; + /* Here if argument TypeSingleFloat */ + iPC = t6; + *(u64 *)(iSP + 8) = t12; + iSP = iSP + 8; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + if (FLTU64(1, f1) < 0.0) + goto cachevalid; + /* Didn't branch, answer is NIL */ + *(u64 *)iSP = t11; + goto cachevalid; + +g6917: + if (_trace) printf("g6917:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 1; + goto unarynumericexception; + +g6915: + if (_trace) printf("g6915:\n"); +#ifdef TRACING + goto DoMinuspIM; +#endif + +DoMinuspIM: + if (_trace) printf("DoMinuspIM:\n"); + t1 = *(u64 *)&(processor->niladdress); + /* Turned into a signed number */ + arg2 = arg2 << 56; + t2 = *(u64 *)&(processor->taddress); + iSP = iSP + 8; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* stall 2 then di */ + if ((s64)arg2 < 0) + t1 = t2; + /* yes Virginia, we dual issue with above yahoo */ + *(u64 *)iSP = t1; + goto cachevalid; + +/* end DoMinusp */ + /* End of Halfword operand from stack instruction - DoMinusp */ +/* start DoPlusp */ + + /* Halfword operand from stack instruction - DoPlusp */ + /* arg2 has the preloaded 8 bit operand. */ + +doplusp: + if (_trace) printf("doplusp:\n"); +#ifdef TRACING +#endif + +DoPluspSP: + if (_trace) printf("DoPluspSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoplusp; +#endif + +DoPluspLP: + if (_trace) printf("DoPluspLP:\n"); +#ifdef TRACING + goto begindoplusp; +#endif + +DoPluspFP: + if (_trace) printf("DoPluspFP:\n"); + +begindoplusp: + if (_trace) printf("begindoplusp:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + t6 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + t1 = *(s32 *)(arg1 + 4); + t12 = *(u64 *)&(processor->taddress); + t2 = *(s32 *)arg1; + LDS(1, f1, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t5 = (t4 == Type_Fixnum) ? 1 : 0; + +g6927: + if (_trace) printf("g6927:\n"); + if (t5 == 0) + goto g6923; + /* Here if argument TypeFixnum */ + iPC = t6; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if predicate succeeds */ + if ((s64)t2 > 0) + t11 = t12; + *(u64 *)(iSP + 8) = t11; + iSP = iSP + 8; + goto cachevalid; + +g6923: + if (_trace) printf("g6923:\n"); + t5 = (t4 == Type_SingleFloat) ? 1 : 0; + +g6928: + if (_trace) printf("g6928:\n"); + if (t5 == 0) + goto g6924; + /* Here if argument TypeSingleFloat */ + iPC = t6; + *(u64 *)(iSP + 8) = t12; + iSP = iSP + 8; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + if (FLTU64(1, f1) > 0.0) + goto cachevalid; + /* Didn't branch, answer is NIL */ + *(u64 *)iSP = t11; + goto cachevalid; + +g6924: + if (_trace) printf("g6924:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 1; + goto unarynumericexception; + +g6922: + if (_trace) printf("g6922:\n"); +#ifdef TRACING + goto DoPluspIM; +#endif + +DoPluspIM: + if (_trace) printf("DoPluspIM:\n"); + t1 = *(u64 *)&(processor->niladdress); + /* Turned into a signed number */ + arg2 = arg2 << 56; + t2 = *(u64 *)&(processor->taddress); + iSP = iSP + 8; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* stall 2 then di */ + if ((s64)arg2 > 0) + t1 = t2; + /* yes Virginia, we dual issue with above yahoo */ + *(u64 *)iSP = t1; + goto cachevalid; + +/* end DoPlusp */ + /* End of Halfword operand from stack instruction - DoPlusp */ +/* start DoLessp */ + + /* Halfword operand from stack instruction - DoLessp */ + /* arg2 has the preloaded 8 bit operand. */ + +dolessp: + if (_trace) printf("dolessp:\n"); +#ifdef TRACING +#endif + +DoLesspSP: + if (_trace) printf("DoLesspSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindolessp; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindolessp; +#endif + +DoLesspLP: + if (_trace) printf("DoLesspLP:\n"); +#ifdef TRACING + goto begindolessp; +#endif + +DoLesspFP: + if (_trace) printf("DoLesspFP:\n"); + +begindolessp: + if (_trace) printf("begindolessp:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + t7 = arg3 >> 12; + t12 = *(u64 *)&(processor->taddress); + /* Get ARG1 tag */ + arg3 = (u32)(arg6 >> ((4&7)*8)); + /* t1 is tag of arg2 */ + t1 = *(s32 *)(arg1 + 4); + LDS(1, f1, *(u32 *)iSP ); + t7 = t7 & 1; + arg2 = *(s32 *)arg1; + arg4 = (s32)arg6; + LDS(2, f2, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t5 = arg3 & 63; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t6 = (t5 == Type_Fixnum) ? 1 : 0; + +g6946: + if (_trace) printf("g6946:\n"); + if (t6 == 0) + goto g6934; + /* Here if argument TypeFixnum */ + t3 = (t4 == Type_Fixnum) ? 1 : 0; + +g6938: + if (_trace) printf("g6938:\n"); + if (t3 == 0) + goto g6929; + /* Here if argument TypeFixnum */ + t2 = arg4 - arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Pop/No-pop */ + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if ((s64)t2 < 0) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g6935: + if (_trace) printf("g6935:\n"); + +g6934: + if (_trace) printf("g6934:\n"); + t6 = (t5 == Type_SingleFloat) ? 1 : 0; + +g6947: + if (_trace) printf("g6947:\n"); + if (t6 == 0) + goto g6939; + /* Here if argument TypeSingleFloat */ + t3 = (t4 == Type_SingleFloat) ? 1 : 0; + +g6943: + if (_trace) printf("g6943:\n"); + if (t3 == 0) + goto g6929; + /* Here if argument TypeSingleFloat */ + +lesspmmexcfltflt: + if (_trace) printf("lesspmmexcfltflt:\n"); + SETFLTT(3,f3, FLTU64(1,f1) < FLTU64(2,f2) ? 2.0:0); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)iSP = t12; + if (FLTU64(3, f3) != 0.0) + goto cachevalid; + /* Didn't branch, answer is NIL */ + *(u64 *)iSP = t11; + goto cachevalid; + +g6940: + if (_trace) printf("g6940:\n"); + +g6939: + if (_trace) printf("g6939:\n"); + /* Here for all other cases */ + +g6929: + if (_trace) printf("g6929:\n"); + goto lesspmmexc; + +g6933: + if (_trace) printf("g6933:\n"); +#ifdef TRACING + goto DoLesspIM; +#endif + +DoLesspIM: + if (_trace) printf("DoLesspIM:\n"); + t11 = *(u64 *)&(processor->niladdress); + /* First half of sign extension */ + arg2 = arg2 << 56; + t12 = *(u64 *)&(processor->taddress); + t7 = arg3 >> 12; + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (s32)arg6; + /* Second half of sign extension */ + arg2 = (s64)arg2 >> 56; + t7 = t7 & 1; + /* Strip off any CDR code bits. */ + t3 = arg3 & 63; + t4 = (t3 == Type_Fixnum) ? 1 : 0; + +g6952: + if (_trace) printf("g6952:\n"); + if (t4 == 0) + goto g6949; + /* Here if argument TypeFixnum */ + t2 = arg4 - arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if ((s64)t2 < 0) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g6949: + if (_trace) printf("g6949:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g6948: + if (_trace) printf("g6948:\n"); + +/* end DoLessp */ + /* End of Halfword operand from stack instruction - DoLessp */ +/* start DoDecrement */ + + /* Halfword operand from stack instruction - DoDecrement */ + /* arg2 has the preloaded 8 bit operand. */ + +dodecrement: + if (_trace) printf("dodecrement:\n"); +#ifdef TRACING +#endif + +DoDecrementSP: + if (_trace) printf("DoDecrementSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindodecrement; +#endif + +DoDecrementLP: + if (_trace) printf("DoDecrementLP:\n"); +#ifdef TRACING + goto begindodecrement; +#endif + +DoDecrementFP: + if (_trace) printf("DoDecrementFP:\n"); + +begindodecrement: + if (_trace) printf("begindodecrement:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* read tag/data of arg1 */ + arg3 = *(s32 *)arg1; + arg2 = *(s32 *)(arg1 + 4); + arg3 = (u32)arg3; + /* Strip off any CDR code bits. */ + t1 = arg2 & 63; + t2 = (t1 == Type_Fixnum) ? 1 : 0; + +g6958: + if (_trace) printf("g6958:\n"); + if (t2 == 0) + goto g6954; + /* Here if argument TypeFixnum */ + t2 = *(u64 *)&(processor->mostnegativefixnum); + t3 = arg3 - 1; + t2 = (arg3 == t2) ? 1 : 0; + if (t2 != 0) + goto decrementexception; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u32 *)arg1 = t3; + /* write the stack cache */ + *(u32 *)(arg1 + 4) = arg2; + goto cachevalid; + +g6954: + if (_trace) printf("g6954:\n"); + t2 = (t1 == Type_SingleFloat) ? 1 : 0; + +g6959: + if (_trace) printf("g6959:\n"); + if (t2 == 0) + goto g6955; + /* Here if argument TypeSingleFloat */ + /* NIL */ + /* Get the floating data */ + LDS(1, f1, *(u32 *)arg1 ); + /* constant 1.0 */ + LDS(2, f2, processor->sfp1); + SUBS(0, f0, 1, f1, 2, f2); /* subs */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Put the floating result */ + STS( (u32 *)arg1, 0, f0 ); + goto cachevalid; + +g6955: + if (_trace) printf("g6955:\n"); + /* Here for all other cases */ + goto decrementexception; + +g6953: + if (_trace) printf("g6953:\n"); +#ifdef TRACING +#endif + +DoDecrementIM: + goto doistageerror; + +/* end DoDecrement */ + /* End of Halfword operand from stack instruction - DoDecrement */ +/* start DoMergeCdrNoPop */ + + /* Halfword operand from stack instruction - DoMergeCdrNoPop */ + /* arg2 has the preloaded 8 bit operand. */ + +domergecdrnopop: + if (_trace) printf("domergecdrnopop:\n"); +#ifdef TRACING +#endif + +DoMergeCdrNoPopSP: + if (_trace) printf("DoMergeCdrNoPopSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindomergecdrnopop; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindomergecdrnopop; +#endif + +DoMergeCdrNoPopLP: + if (_trace) printf("DoMergeCdrNoPopLP:\n"); +#ifdef TRACING + goto begindomergecdrnopop; +#endif + +DoMergeCdrNoPopFP: + if (_trace) printf("DoMergeCdrNoPopFP:\n"); + +begindomergecdrnopop: + if (_trace) printf("begindomergecdrnopop:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Get the CDR CODE/TAG of arg2 */ + t1 = *(s32 *)(arg1 + 4); + /* Get the CDR CODE/TAG of arg1 */ + t2 = (u32)(arg6 >> ((4&7)*8)); + +g6960: + if (_trace) printf("g6960:\n"); + /* Get Just the CDR code in position */ + t2 = t2 & 192; + /* Get the TAG of arg1 */ + t1 = t1 & 63; + /* Merge the tag of arg2 with the cdr code of arg1 */ + t3 = t1 | t2; + /* Replace tag/cdr code no pop */ + *(u32 *)(arg1 + 4) = t3; + goto cachevalid; +#ifdef TRACING +#endif + +DoMergeCdrNoPopIM: + goto doistageerror; + +/* end DoMergeCdrNoPop */ + /* End of Halfword operand from stack instruction - DoMergeCdrNoPop */ +/* start DoEqImmediateHandler */ + + +doeqimmediatehandler: + if (_trace) printf("doeqimmediatehandler:\n"); +#ifdef TRACING + goto DoEqIM; +#endif + +DoEqIM: + if (_trace) printf("DoEqIM:\n"); + arg2 = arg2 << 56; + /* t4=tag t3=data */ + t4 = *(s32 *)(iSP + 4); + t3 = *(s32 *)iSP; + arg3 = arg3 >> 12; + t11 = *(u64 *)&(processor->niladdress); + /* Sign extension of arg2 is complete */ + arg2 = (s64)arg2 >> 56; + /* TagType. */ + t4 = t4 & 63; + t12 = *(u64 *)&(processor->taddress); + /* 1 if no-pop, 0 if pop */ + arg3 = arg3 & 1; + arg2 = (s32)t3 - (s32)arg2; + t4 = t4 ^ Type_Fixnum; + /* Either a stack-push or a stack-write */ + iSP = (arg3 * 8) + iSP; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + t4 = arg2 | t4; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + if (t4 == 0) + t11 = t12; + /* Yes Virginia, this does dual issue with above */ + *(u64 *)iSP = t11; + goto cachevalid; + +/* end DoEqImmediateHandler */ +/* start DoIncrement */ + + /* Halfword operand from stack instruction - DoIncrement */ + /* arg2 has the preloaded 8 bit operand. */ + +doincrement: + if (_trace) printf("doincrement:\n"); +#ifdef TRACING +#endif + +DoIncrementSP: + if (_trace) printf("DoIncrementSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoincrement; +#endif + +DoIncrementLP: + if (_trace) printf("DoIncrementLP:\n"); +#ifdef TRACING + goto begindoincrement; +#endif + +DoIncrementFP: + if (_trace) printf("DoIncrementFP:\n"); + +begindoincrement: + if (_trace) printf("begindoincrement:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* read tag/data of arg1 */ + arg3 = *(s32 *)arg1; + arg2 = *(s32 *)(arg1 + 4); + arg3 = (u32)arg3; + /* Strip off any CDR code bits. */ + t1 = arg2 & 63; + t2 = (t1 == Type_Fixnum) ? 1 : 0; + +g6966: + if (_trace) printf("g6966:\n"); + if (t2 == 0) + goto g6962; + /* Here if argument TypeFixnum */ + t2 = *(u64 *)&(processor->mostpositivefixnum); + t3 = arg3 + 1; + t2 = (arg3 == t2) ? 1 : 0; + if (t2 != 0) + goto incrementexception; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u32 *)arg1 = t3; + /* write the stack cache */ + *(u32 *)(arg1 + 4) = arg2; + goto cachevalid; + +g6962: + if (_trace) printf("g6962:\n"); + t2 = (t1 == Type_SingleFloat) ? 1 : 0; + +g6967: + if (_trace) printf("g6967:\n"); + if (t2 == 0) + goto g6963; + /* Here if argument TypeSingleFloat */ + /* NIL */ + /* Get the floating data */ + LDS(1, f1, *(u32 *)arg1 ); + /* constant 1.0 */ + LDS(2, f2, processor->sfp1); + ADDS(0, f0, 1, f1, 2, f2); /* adds */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Put the floating result */ + STS( (u32 *)arg1, 0, f0 ); + goto cachevalid; + +g6963: + if (_trace) printf("g6963:\n"); + /* Here for all other cases */ + goto incrementexception; + +g6961: + if (_trace) printf("g6961:\n"); +#ifdef TRACING +#endif + +DoIncrementIM: + goto doistageerror; + +/* end DoIncrement */ + /* End of Halfword operand from stack instruction - DoIncrement */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifuncom2.as */ diff --git a/stub/ifunfcal.c b/stub/ifunfcal.c new file mode 100644 index 0000000..b3df2b4 --- /dev/null +++ b/stub/ifunfcal.c @@ -0,0 +1,2829 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunfcal.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Function calling. */ + /* Start call. */ + /* Finish call. */ +/* start DoFinishCallTos */ + + /* Halfword 10 bit immediate instruction - DoFinishCallTos */ + +dofinishcalltos: + if (_trace) printf("dofinishcalltos:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoFinishCallTosIM: + if (_trace) printf("DoFinishCallTosIM:\n"); + +DoFinishCallTosSP: + if (_trace) printf("DoFinishCallTosSP:\n"); + +DoFinishCallTosLP: + if (_trace) printf("DoFinishCallTosLP:\n"); + +DoFinishCallTosFP: + if (_trace) printf("DoFinishCallTosFP:\n"); + /* arg1 has operand preloaded. */ + /* arg1 contains the disposition (two bits) */ + arg1 = (u8)(arg3 >> ((5&7)*8)); + /* Get the number of args */ + arg2 = *(s32 *)iSP; + /* Pop stack */ + iSP = iSP - 8; + /* Add 1 and convert to stacked word address */ + arg2 = (arg2 * 8) + 8; + goto finishcallmerge; + +/* end DoFinishCallTos */ + /* End of Halfword operand from stack instruction - DoFinishCallTos */ + /* Function entry. */ +/* start DoEntryRestAccepted */ + + /* Field Extraction instruction - DoEntryRestAccepted */ + +doentryrestaccepted: + if (_trace) printf("doentryrestaccepted:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoEntryRestAcceptedIM: + if (_trace) printf("DoEntryRestAcceptedIM:\n"); + +DoEntryRestAcceptedSP: + if (_trace) printf("DoEntryRestAcceptedSP:\n"); + +DoEntryRestAcceptedLP: + if (_trace) printf("DoEntryRestAcceptedLP:\n"); + +DoEntryRestAcceptedFP: + if (_trace) printf("DoEntryRestAcceptedFP:\n"); + /* The control register */ + arg5 = *(s32 *)&processor->control; + /* Pull down the number of optionals */ + arg4 = arg3 >> 18; + /* Extract the 'ptr' field while we are waiting */ + arg1 = (u8)(arg3 >> ((5&7)*8)); + arg4 = arg4 & 255; + /* arg1=ptr field, arg2=required, arg3=instn, arg4=optionals arg5=control-register */ + /* Get the cr.trace-pending bit */ + t2 = arg5 >> 27; + /* The supplied args */ + t1 = arg5 & 255; + if (t2 & 1) + goto tracetrap; + t3 = arg5 >> 17; + /* Get the tag of the stack top. */ + t4 = *(s32 *)(iSP + 4); + +g6973: + if (_trace) printf("g6973:\n"); + /* J. if apply args */ + if (t3 & 1) + goto g6971; + +g6972: + /* t2=supplied-minimum */ + t2 = t1 - arg2; + /* B. if too few args. */ + if ((s64)t2 < 0) + goto retryeratoofew; + /* maximum-supplied */ + arg1 = arg4 - t1; + /* B. rest args. */ + if ((s64)arg1 < 0) + goto retryerarest; + /* Compute entry position and advance PC/CP accordingly. */ + /* get the next PC */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Adjust index to halfword */ + t3 = t2 << 1; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* J. if index zero, no adjustment. */ + if (t2 == 0) + goto INTERPRETINSTRUCTION; + /* Compute the new address */ + iPC = iPC + t3; + /* Make it an DTP-EVEN-PC */ + iPC = iPC & ~1L; + goto interpretinstructionforjump; + +applysuppra: + if (_trace) printf("applysuppra:\n"); + /* maximum-supplied */ + arg1 = arg4 - t1; + /* B. rest args. */ + if ((s64)arg1 < 0) + goto retryerarest; + /* try pulling from applied args. */ + if ((s64)arg1 > 0) + goto pullapplyargs; + /* get tag */ + t6 = *(s32 *)(iSP + 4); + t6 = t6 & 63; + t6 = t6 | 64; + /* set tag */ + *(u32 *)(iSP + 4) = t6; + /* t2=supplied-minimum */ + t2 = t1 - arg2; + t2 = t2 + 1; + /* Compute entry position and advance PC/CP accordingly. */ + /* get the next PC */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Adjust index to halfword */ + t3 = t2 << 1; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* J. if index zero, no adjustment. */ + if (t2 == 0) + goto INTERPRETINSTRUCTION; + /* Compute the new address */ + iPC = iPC + t3; + /* Make it an DTP-EVEN-PC */ + iPC = iPC & ~1L; + goto interpretinstructionforjump; + +retryeratoofew: + if (_trace) printf("retryeratoofew:\n"); + arg5 = 0; + arg2 = 77; + goto illegaloperand; + +retryerarest: + if (_trace) printf("retryerarest:\n"); + /* get tag */ + t1 = *(s32 *)(iSP + 4); + t1 = t1 & 63; + t1 = t1 | 64; + /* set tag */ + *(u32 *)(iSP + 4) = t1; + t2 = arg5 >> 17; + /* Get the tag of the stack top. */ + t3 = *(s32 *)(iSP + 4); + +g6978: + if (_trace) printf("g6978:\n"); + /* J. if apply args */ + if (t2 & 1) + goto g6976; + +g6977: + t1 = (arg4 * 8) + iFP; + /* Convert stack cache address to VMA */ + t3 = *(u64 *)&(processor->stackcachedata); + t2 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t3 = t1 - t3; + /* convert byte address to word address */ + t3 = t3 >> 3; + /* reconstruct VMA */ + t2 = t3 + t2; + t1 = Type_List; + *(u32 *)(iSP + 8) = t2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto g6975; + +g6974: + if (_trace) printf("g6974:\n"); + t1 = iSP - 8; + /* get tag */ + t3 = *(s32 *)(t1 + 4); + t3 = t3 & 63; + t3 = t3 | 128; + /* set tag */ + *(u32 *)(t1 + 4) = t3; + t1 = (arg4 * 8) + iFP; + /* Convert stack cache address to VMA */ + t3 = *(u64 *)&(processor->stackcachedata); + t2 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t3 = t1 - t3; + /* convert byte address to word address */ + t3 = t3 >> 3; + /* reconstruct VMA */ + t2 = t3 + t2; + t1 = Type_List; + *(u32 *)(iSP + 8) = t2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + iLP = iLP + 8; + arg5 = arg5 + 1; + *(u32 *)&processor->control = arg5; + +g6975: + if (_trace) printf("g6975:\n"); + t1 = arg4 - arg2; + t1 = t1 + 1; + /* Compute entry position and advance PC/CP accordingly. */ + /* get the next PC */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Adjust index to halfword */ + t2 = t1 << 1; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* J. if index zero, no adjustment. */ + if (t1 == 0) + goto INTERPRETINSTRUCTION; + /* Compute the new address */ + iPC = iPC + t2; + /* Make it an DTP-EVEN-PC */ + iPC = iPC & ~1L; + goto interpretinstructionforjump; + +g6976: + if (_trace) printf("g6976:\n"); + t3 = t3 & 63; + t3 = t3 - Type_NIL; + /* J. if apply args supplied not nil. */ + if (t3 != 0) + goto g6974; + /* keep just the apply bit! */ + t2 = t2 & 1; + /* reposition the apply bit */ + t2 = t2 << 17; + /* Pop off the null applied arg. */ + iSP = iSP - 8; + /* Blast the apply arg bit away */ + arg5 = arg5 & ~t2; + /* Reset the stored cr bit */ + *(u32 *)&processor->control = arg5; + goto g6977; + +g6971: + if (_trace) printf("g6971:\n"); + t4 = t4 & 63; + t4 = t4 - Type_NIL; + /* J. if apply args supplied not nil. */ + if (t4 != 0) + goto applysuppra; + /* keep just the apply bit! */ + t3 = t3 & 1; + /* reposition the apply bit */ + t3 = t3 << 17; + /* Pop off the null applied arg. */ + iSP = iSP - 8; + /* Blast the apply arg bit away */ + arg5 = arg5 & ~t3; + /* Reset the stored cr bit */ + *(u32 *)&processor->control = arg5; + goto g6972; + +/* end DoEntryRestAccepted */ + /* End of Halfword operand from stack instruction - DoEntryRestAccepted */ +/* start CarCdrInternal */ + + +carcdrinternal: + if (_trace) printf("carcdrinternal:\n"); + sp = sp + -8; + arg2 = (u32)(t2 >> ((zero&7)*8)); + /* Strip off any CDR code bits. */ + t5 = t1 & 63; + t6 = (t5 == Type_List) ? 1 : 0; + +g7026: + if (_trace) printf("g7026:\n"); + if (t6 == 0) + goto g6983; + /* Here if argument TypeList */ + /* Memory Read Internal */ + +g6984: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g6986; + +g6985: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g6988; + +g6995: + t5 = (s32)arg2 - (s32)t2; + /* CAR forwarded, must CDR the hard way */ + if (t5 != 0) + goto g6979; + t1 = arg5; + t2 = arg6; + +g6981: + if (_trace) printf("g6981:\n"); + /* Extract CDR code. */ + t5 = arg5 & 192; + if (t5 != 0) + goto g6997; + /* Here if argument 0 */ + /* Address of next position is CDR */ + arg6 = arg2 + 1; + arg5 = Type_List; + +g6996: + if (_trace) printf("g6996:\n"); + +g6982: + if (_trace) printf("g6982:\n"); + +g6980: + if (_trace) printf("g6980:\n"); + sp = sp + 8; + goto *r0; /* ret */ + +g6983: + if (_trace) printf("g6983:\n"); + t6 = (t5 == Type_NIL) ? 1 : 0; + +g7027: + if (_trace) printf("g7027:\n"); + if (t6 == 0) + goto g7013; + /* Here if argument TypeNIL */ + arg6 = *(s32 *)&processor->niladdress; + arg5 = *((s32 *)(&processor->niladdress)+1); + arg6 = (u32)arg6; + goto g6982; + +g7013: + if (_trace) printf("g7013:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto listexception; + +g6979: + if (_trace) printf("g6979:\n"); + arg2 = (u32)(t2 >> ((zero&7)*8)); + t1 = arg5; + t2 = arg6; + /* Memory Read Internal */ + +g7015: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->cdr_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g7017; + +g7016: + t7 = zero + 192; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g7019; + +g7024: + goto g6981; + +g7019: + if (_trace) printf("g7019:\n"); + if ((t7 & 1) == 0) + goto g7018; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g7015; + +g7018: + if (_trace) printf("g7018:\n"); + +g7017: + if (_trace) printf("g7017:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0036; + goto memoryreadcdrdecode; +return0036: + r0 = *(u64 *)sp; + goto g7024; + +g6997: + if (_trace) printf("g6997:\n"); + t6 = (t5 == 128) ? 1 : 0; + +g7028: + if (_trace) printf("g7028:\n"); + if (t6 == 0) + goto g6998; + /* Here if argument 128 */ + arg2 = arg2 + 1; + /* Memory Read Internal */ + +g6999: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g7001; + +g7000: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t8 & 1) + goto g7003; + goto g6980; + +g6998: + if (_trace) printf("g6998:\n"); + t6 = (t5 == 64) ? 1 : 0; + +g7029: + if (_trace) printf("g7029:\n"); + if (t6 == 0) + goto g7010; + /* Here if argument 64 */ + arg6 = *(s32 *)&processor->niladdress; + arg5 = *((s32 *)(&processor->niladdress)+1); + arg6 = (u32)arg6; + goto g6980; + +g7010: + if (_trace) printf("g7010:\n"); + /* Here for all other cases */ + arg5 = arg2; + arg2 = 15; + goto illegaloperand; + +g7003: + if (_trace) printf("g7003:\n"); + if ((t7 & 1) == 0) + goto g7002; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6999; + +g7002: + if (_trace) printf("g7002:\n"); + +g7001: + if (_trace) printf("g7001:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0037; + goto memoryreaddatadecode; +return0037: + r0 = *(u64 *)sp; + goto g6980; + +g6988: + if (_trace) printf("g6988:\n"); + if ((t7 & 1) == 0) + goto g6987; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g6984; + +g6987: + if (_trace) printf("g6987:\n"); + +g6986: + if (_trace) printf("g6986:\n"); + *(u64 *)sp = r0; + r0 = (u64)&&return0038; + goto memoryreaddatadecode; +return0038: + r0 = *(u64 *)sp; + goto g6995; + +/* end CarCdrInternal */ +/* start PullApplyArgsSlowly */ + + +pullapplyargsslowly: + if (_trace) printf("pullapplyargsslowly:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Get the rest arg */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + t2 = (u32)(arg4 >> ((zero&7)*8)); + /* Strip off any CDR code bits. */ + t3 = arg3 & 63; + t4 = (t3 == Type_List) ? 1 : 0; + +g7077: + if (_trace) printf("g7077:\n"); + if (t4 == 0) + goto g7034; + /* Here if argument TypeList */ + /* Memory Read Internal */ + +g7035: + t5 = t2 + ivory; + arg6 = (t5 * 4); + arg5 = LDQ_U(t5); + /* Stack cache offset */ + t3 = t2 - t11; + t6 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t4 = ((u64)t3 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t5&7)*8)); + if (t4 != 0) + goto g7037; + +g7036: + t5 = zero + 240; + t6 = t6 >> (arg5 & 63); + t5 = t5 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t6 & 1) + goto g7039; + +g7046: + t3 = (s32)t2 - (s32)arg4; + /* CAR forwarded, must CDR the hard way */ + if (t3 != 0) + goto g7030; + arg3 = arg5; + arg4 = arg6; + +g7032: + if (_trace) printf("g7032:\n"); + /* Extract CDR code. */ + t3 = arg5 & 192; + if (t3 != 0) + goto g7048; + /* Here if argument 0 */ + /* Address of next position is CDR */ + arg6 = t2 + 1; + arg5 = Type_List; + +g7047: + if (_trace) printf("g7047:\n"); + +g7033: + if (_trace) printf("g7033:\n"); + +g7031: + if (_trace) printf("g7031:\n"); + /* Push the pulled argument */ + *(u32 *)iSP = arg4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = arg3; + /* set CDR-NEXT */ + t1 = arg5 & 63; + /* Push the new rest arg */ + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + arg2 = *(s32 *)&processor->control; + /* Get current arg size. */ + t2 = arg2 & 255; + arg2 = arg2 & ~255L; + t2 = t2 + 1; + /* Update the arg size */ + arg2 = t2 + arg2; + *(u32 *)&processor->control = arg2; + iLP = iLP + 8; + goto INTERPRETINSTRUCTION; + +g7034: + if (_trace) printf("g7034:\n"); + t4 = (t3 == Type_NIL) ? 1 : 0; + +g7078: + if (_trace) printf("g7078:\n"); + if (t4 == 0) + goto g7064; + /* Here if argument TypeNIL */ + arg6 = *(s32 *)&processor->niladdress; + arg5 = *((s32 *)(&processor->niladdress)+1); + arg6 = (u32)arg6; + goto g7033; + +g7064: + if (_trace) printf("g7064:\n"); + /* Here for all other cases */ + arg1 = arg1; + goto pullapplyargstrap; + +g7030: + if (_trace) printf("g7030:\n"); + t2 = (u32)(arg4 >> ((zero&7)*8)); + arg3 = arg5; + arg4 = arg6; + /* Memory Read Internal */ + +g7066: + t5 = t2 + ivory; + arg6 = (t5 * 4); + arg5 = LDQ_U(t5); + /* Stack cache offset */ + t3 = t2 - t11; + t6 = *(u64 *)&(processor->cdr_mask); + /* In range? */ + t4 = ((u64)t3 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t5&7)*8)); + if (t4 != 0) + goto g7068; + +g7067: + t5 = zero + 192; + t6 = t6 >> (arg5 & 63); + t5 = t5 >> (arg5 & 63); + if (t6 & 1) + goto g7070; + +g7075: + goto g7032; + +g7068: + if (_trace) printf("g7068:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + arg6 = *(s32 *)t3; + /* Read from stack cache */ + arg5 = *(s32 *)(t3 + 4); + goto g7067; + +g7070: + if (_trace) printf("g7070:\n"); + if ((t5 & 1) == 0) + goto g7069; + /* Do the indirect thing */ + t2 = (u32)arg6; + goto g7066; + +g7069: + if (_trace) printf("g7069:\n"); + /* Load the memory action table for cycle */ + t6 = *(u64 *)&(processor->cdr); + /* TagType. */ + /* Discard the CDR code */ + t5 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + t5 = (t5 * 4) + t6; + /* Get the memory action */ + t6 = *(s32 *)t5; + +g7072: + /* Perform memory action */ + arg1 = t6; + arg2 = 9; + goto performmemoryaction; + +g7048: + if (_trace) printf("g7048:\n"); + t4 = (t3 == 128) ? 1 : 0; + +g7079: + if (_trace) printf("g7079:\n"); + if (t4 == 0) + goto g7049; + /* Here if argument 128 */ + t2 = t2 + 1; + /* Memory Read Internal */ + +g7050: + t5 = t2 + ivory; + arg6 = (t5 * 4); + arg5 = LDQ_U(t5); + /* Stack cache offset */ + t3 = t2 - t11; + t6 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t4 = ((u64)t3 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t5&7)*8)); + if (t4 != 0) + goto g7052; + +g7051: + t5 = zero + 240; + t6 = t6 >> (arg5 & 63); + t5 = t5 >> (arg5 & 63); + arg6 = (u32)arg6; + if (t6 & 1) + goto g7054; + goto g7031; + +g7049: + if (_trace) printf("g7049:\n"); + t4 = (t3 == 64) ? 1 : 0; + +g7080: + if (_trace) printf("g7080:\n"); + if (t4 == 0) + goto g7061; + /* Here if argument 64 */ + arg6 = *(s32 *)&processor->niladdress; + arg5 = *((s32 *)(&processor->niladdress)+1); + arg6 = (u32)arg6; + goto g7031; + +g7061: + if (_trace) printf("g7061:\n"); + /* Here for all other cases */ + arg5 = t2; + arg2 = 15; + goto illegaloperand; + +g7052: + if (_trace) printf("g7052:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + arg6 = *(s32 *)t3; + /* Read from stack cache */ + arg5 = *(s32 *)(t3 + 4); + goto g7051; + +g7054: + if (_trace) printf("g7054:\n"); + if ((t5 & 1) == 0) + goto g7053; + /* Do the indirect thing */ + t2 = (u32)arg6; + goto g7050; + +g7053: + if (_trace) printf("g7053:\n"); + /* Load the memory action table for cycle */ + t6 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t5 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + t5 = (t5 * 4) + t6; + /* Get the memory action */ + t6 = *(s32 *)t5; + +g7058: + if (_trace) printf("g7058:\n"); + t5 = t6 & MemoryActionTransform; + if (t5 == 0) + goto g7057; + arg5 = arg5 & ~63L; + arg5 = arg5 | Type_ExternalValueCellPointer; + goto g7031; +#ifndef MINIMA + +g7057: +#endif +#ifdef MINIMA + +g7057: + if (_trace) printf("g7057:\n"); + t5 = t6 & MemoryActionBinding; + t4 = *(u64 *)&(processor->dbcmask); + if (t5 == 0) + goto g7056; + t3 = t2 << 1; + t5 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t3 = t3 & t4; + t4 = 1; + t4 = t4 << (ivorymemorydata & 63); + t3 = (s32)t3 + (s32)t5; + /* Clear sign-extension */ + t3 = (u32)t3; + t4 = (t3 * 4) + t4; + /* Fetch the key */ + t3 = *(s32 *)t4; + /* Fetch value */ + arg6 = *(s32 *)(t4 + 4); + /* Compare */ + t5 = (s32)t2 - (s32)t3; + /* Trap on miss */ + if (t5 != 0) + goto g7060; + /* Extract the pointer, and indirect */ + t2 = (u32)arg6; + goto g7050; + +g7060: + if (_trace) printf("g7060:\n"); + goto dbcachemisstrap; +#endif + +g7056: + /* Perform memory action */ + arg1 = t6; + arg2 = 0; + goto performmemoryaction; + +g7037: + if (_trace) printf("g7037:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + arg6 = *(s32 *)t3; + /* Read from stack cache */ + arg5 = *(s32 *)(t3 + 4); + goto g7036; + +g7039: + if (_trace) printf("g7039:\n"); + if ((t5 & 1) == 0) + goto g7038; + /* Do the indirect thing */ + t2 = (u32)arg6; + goto g7035; + +g7038: + if (_trace) printf("g7038:\n"); + /* Load the memory action table for cycle */ + t6 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t5 = arg5 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + t5 = (t5 * 4) + t6; + /* Get the memory action */ + t6 = *(s32 *)t5; + +g7043: + if (_trace) printf("g7043:\n"); + t5 = t6 & MemoryActionTransform; + if (t5 == 0) + goto g7042; + arg5 = arg5 & ~63L; + arg5 = arg5 | Type_ExternalValueCellPointer; + goto g7046; +#ifndef MINIMA + +g7042: +#endif +#ifdef MINIMA + +g7042: + if (_trace) printf("g7042:\n"); + t5 = t6 & MemoryActionBinding; + t4 = *(u64 *)&(processor->dbcmask); + if (t5 == 0) + goto g7041; + t3 = t2 << 1; + t5 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t3 = t3 & t4; + t4 = 1; + t4 = t4 << (ivorymemorydata & 63); + t3 = (s32)t3 + (s32)t5; + /* Clear sign-extension */ + t3 = (u32)t3; + t4 = (t3 * 4) + t4; + /* Fetch the key */ + t3 = *(s32 *)t4; + /* Fetch value */ + arg6 = *(s32 *)(t4 + 4); + /* Compare */ + t5 = (s32)t2 - (s32)t3; + /* Trap on miss */ + if (t5 != 0) + goto g7045; + /* Extract the pointer, and indirect */ + t2 = (u32)arg6; + goto g7035; + +g7045: + if (_trace) printf("g7045:\n"); + goto dbcachemisstrap; +#endif + +g7041: + /* Perform memory action */ + arg1 = t6; + arg2 = 0; + goto performmemoryaction; + +/* end PullApplyArgsSlowly */ +/* start DoLocateLocals */ + + /* Halfword operand from stack instruction - DoLocateLocals */ + /* arg2 has the preloaded 8 bit operand. */ + +dolocatelocals: + if (_trace) printf("dolocatelocals:\n"); +#ifdef TRACING +#endif + +DoLocateLocalsSP: + if (_trace) printf("DoLocateLocalsSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindolocatelocals; +#endif + +DoLocateLocalsLP: + if (_trace) printf("DoLocateLocalsLP:\n"); +#ifdef TRACING + goto begindolocatelocals; +#endif + +DoLocateLocalsFP: + if (_trace) printf("DoLocateLocalsFP:\n"); + +begindolocatelocals: + if (_trace) printf("begindolocatelocals:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* The control register */ + t1 = *(s32 *)&processor->control; + iLP = iSP; + /* arg size including the fudge 2 */ + t3 = iLP - iFP; + /* adjust arg size to words */ + t3 = t3 >> 3; + /* argument size */ + t2 = t1 & 255; + /* corrected arg size */ + t2 = t2 - 2; + t1 = t1 & ~255L; + /* replace the arg size */ + t1 = t1 | t3; + t4 = Type_Fixnum; + *(u32 *)(iSP + 8) = t2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + *(u32 *)&processor->control = t1; + goto NEXTINSTRUCTION; +#ifdef TRACING +#endif + +DoLocateLocalsIM: + goto doistageerror; + +/* end DoLocateLocals */ + /* End of Halfword operand from stack instruction - DoLocateLocals */ + /* Returning. */ +/* start DoReturnMultiple */ + + /* Halfword operand from stack instruction - DoReturnMultiple */ + /* arg2 has the preloaded 8 bit operand. */ + +doreturnmultiple: + if (_trace) printf("doreturnmultiple:\n"); +#ifdef TRACING +#endif + +DoReturnMultipleSP: + if (_trace) printf("DoReturnMultipleSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoreturnmultiple; +#endif + +DoReturnMultipleLP: + if (_trace) printf("DoReturnMultipleLP:\n"); +#ifdef TRACING + goto begindoreturnmultiple; +#endif + +DoReturnMultipleFP: + if (_trace) printf("DoReturnMultipleFP:\n"); + +begindoreturnmultiple: + if (_trace) printf("begindoreturnmultiple:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Fetch the tag for type-check */ + t1 = *(s32 *)(arg1 + 4); + /* Fetch the data */ + arg1 = *(s32 *)arg1; + t2 = t1 - Type_Fixnum; + /* Strip CDR code */ + t2 = t2 & 63; + if (t2 != 0) + goto returnmultipleio; + /* Discard dtp-fixnum tag word */ + arg1 = (u32)arg1; + +returnmultipletop: + if (_trace) printf("returnmultipletop:\n"); + arg5 = *(s32 *)&processor->control; + t3 = (12) << 16; + t2 = iSP + 8; + /* Value bytes */ + t1 = arg1 << 3; + /* Mask */ + t3 = t3 & arg5; + /* Shift disposition bits into place. */ + t3 = t3 >> 18; + /* Compute position of value(s) */ + arg3 = t2 - t1; + arg6 = *(u64 *)&(processor->stackcachedata); + /* arg4 -2=effect -1=value 0=return 1=multiple */ + arg4 = t3 - 2; + if ((s64)arg4 < 0) + goto returnmultiplesingle; + /* Restore machine state from frame header. */ + t3 = *(s32 *)iFP; + t1 = (1792) << 16; + t5 = *(s32 *)&processor->continuation; + /* Mask */ + t1 = arg5 & t1; + t2 = *(s32 *)(iFP + 4); + t7 = iCP; + /* Need to cleanup frame first */ + if (t1 != 0) + goto handleframecleanup; + t3 = (u32)t3; + t4 = *((s32 *)(&processor->continuation)+1); + t5 = (u32)t5; +#ifdef IVERIFY + /* check for instruction verification suite end-of-test */ + /* check for end of run */ + t6 = (s32)t2 - (s32)Type_NIL; + if (t6 == 0) + goto g7081; +#endif + /* Get saved control register */ + t6 = *(s32 *)(iFP + 8); + /* TagType. */ + t2 = t2 & 63; + /* Restore the PC. */ + if (arg4 == 0) + goto g7083; + /* Assume even PC */ + iPC = t5 << 1; + t1 = t4 & 1; + t7 = *(u64 *)&(processor->continuationcp); + iPC = iPC + t1; + +g7083: + if (_trace) printf("g7083:\n"); + /* Restore the saved continuation */ + *((u32 *)(&processor->continuation)+1) = t2; + /* Get the caller frame size into place */ + t1 = arg5 >> 9; + *(u32 *)&processor->continuation = t3; + /* Restore the stack pointer. */ + iSP = iFP - 8; + *(u64 *)&processor->continuationcp = zero; + /* Mask just the caller frame size. */ + t1 = t1 & 255; + /* *8 */ + t1 = (t1 * 8) + 0; + t2 = (2048) << 16; + t2 = t2 & arg5; + /* Get the preempt-pending bit */ + t3 = *(s32 *)&processor->interruptreg; + /* Sticky trace pending bit. */ + t6 = t2 | t6; + /* Get the trap/suspend bits */ + t4 = *(u64 *)&(processor->please_stop); + /* Restore the frame pointer. */ + iFP = iFP - t1; + /* Restore the control register */ + *(u32 *)&processor->control = t6; + /* extract the argument size */ + t1 = t6 & 255; + t3 = t3 & 1; + t3 = t4 | t3; + *(u64 *)&processor->stop_interpreter = t3; + /* Restore the local pointer. */ + iLP = (t1 * 8) + iFP; + /* ARG6 = stack-cache underflow */ + arg6 = ((u64)iFP < (u64)arg6) ? 1 : 0; + /* Compute destination of copy */ + t4 = iSP + 8; + /* Values */ + t3 = arg1; + /* mask for CDR codes */ + t1 = *(u64 *)&(processor->cdrcodemask); + goto g7084; + +g7085: + if (_trace) printf("g7085:\n"); + t3 = t3 - 1; + /* Get a word from source */ + t2 = *(u64 *)arg3; + /* advance from position */ + arg3 = arg3 + 8; + /* Strip off CDR code */ + t2 = t2 & ~t1; + /* Put word in destination */ + *(u64 *)t4 = t2; + /* advance to position */ + t4 = t4 + 8; + +g7084: + if ((s64)t3 > 0) + goto g7085; + /* Adjust iSP over returned values */ + iSP = (arg1 * 8) + iSP; + /* arg4 -2=effect -1=value 0=return 1=multiple */ + if (arg4 == 0) + goto returnmultiplereturn; + +returnmultiplemultiple: + if (_trace) printf("returnmultiplemultiple:\n"); + t1 = Type_Fixnum; + /* push the MV return count */ + *(u32 *)(iSP + 8) = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + +returnmultipledone: + if (_trace) printf("returnmultipledone:\n"); + if (arg6 != 0) + goto returnmultipleunderflow; + arg2 = t7; + if (t7 != 0) + goto interpretinstructionpredicted; + if (arg4 != 0) + goto interpretinstructionforbranch; + goto INTERPRETINSTRUCTION; + +returnmultipleunderflow: + if (_trace) printf("returnmultipleunderflow:\n"); + goto stackcacheunderflowcheck; + +returnmultiplesingle: + if (_trace) printf("returnmultiplesingle:\n"); + arg3 = *(u64 *)arg3; + t1 = *(u64 *)&(processor->niladdress); + /* Clear cdr */ + arg3 = arg3 << 26; + /* Clear cdr */ + arg3 = arg3 >> 26; + if (arg1 == 0) + arg3 = t1; + goto returncommontail; + +returnmultiplereturn: + if (_trace) printf("returnmultiplereturn:\n"); + if (arg2 != 0) + goto returnmultipledone; + t1 = Type_Fixnum; + *(u32 *)(iSP + 8) = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto returnmultipledone; +#ifdef TRACING + goto DoReturnMultipleIM; +#endif + +DoReturnMultipleIM: + if (_trace) printf("DoReturnMultipleIM:\n"); + arg1 = arg2; + arg2 = zero + 1; + goto returnmultipletop; + +returnmultipleio: + if (_trace) printf("returnmultipleio:\n"); + arg5 = 0; + arg2 = 63; + goto illegaloperand; + +/* end DoReturnMultiple */ + /* End of Halfword operand from stack instruction - DoReturnMultiple */ +/* start HANDLEFRAMECLEANUP */ + + +handleframecleanup: + if (_trace) printf("handleframecleanup:\n"); + /* Restore SP to instruction start */ + iSP = *(u64 *)&(processor->restartsp); + /* Get control register */ + arg5 = *(s32 *)&processor->control; + +g7088: + if (_trace) printf("g7088:\n"); + t1 = (1024) << 16; + t4 = *(s32 *)&processor->catchblock; + t4 = (u32)t4; + t2 = t1 & arg5; + /* J. if cr.cleanup-catch is 0 */ + if (t2 == 0) + goto g7087; + /* Convert VMA to stack cache address */ + t2 = *(u64 *)&(processor->stackcachebasevma); + t3 = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t2 = t4 - t2; + /* reconstruct SCA */ + t3 = (t2 * 8) + t3; + t6 = *(s32 *)(t3 + 16); + t5 = *(s32 *)(t3 + 20); + t6 = (u32)t6; + t2 = *(s32 *)(t3 + 8); + t1 = *(s32 *)(t3 + 12); + t2 = (u32)t2; + t12 = t1 & 64; + /* J. if catch block is UWP variety. */ + if (t12 != 0) + goto handleunwindprotect; + t3 = (1024) << 16; + /* Extract the catchcleanup bit */ + t2 = t5 & 64; + /* Shift into place for CR */ + t2 = t2 << 20; + t3 = arg5 & ~t3; + arg5 = t3 | t2; + *(u32 *)&processor->control = arg5; + /* TagType. */ + t5 = t5 & 63; + t5 = t5 << 32; + t6 = t6 | t5; + *(u64 *)&processor->catchblock = t6; + goto g7088; + +g7087: + if (_trace) printf("g7087:\n"); + t1 = (512) << 16; + t2 = t1 & arg5; + t1 = *(u64 *)&(processor->bindingstackpointer); + /* J. if cr.cleanup-bindings is 0. */ + if (t2 == 0) + goto g7086; +#ifdef MINIMA + /* BSP not a locative -> Deep-bound */ + t4 = t1 >> 32; + t3 = t4 - Type_Locative; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto dbunwindframetrap; +#endif + +g7089: + if (_trace) printf("g7089:\n"); + t1 = *(u64 *)&(processor->bindingstackpointer); + t4 = *(s32 *)&processor->control; + /* vma only */ + t1 = (u32)t1; + t2 = (512) << 16; + t5 = t1 - 1; + t3 = t4 & t2; + /* Turn off the bit */ + t4 = t4 & ~t2; + if (t3 != 0) + goto g7090; + /* Get the SP, ->op2 */ + t4 = *(u64 *)&(processor->restartsp); + arg5 = 0; + arg2 = 20; + goto illegaloperand; + +g7090: + if (_trace) printf("g7090:\n"); + /* Memory Read Internal */ + +g7091: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t9 = *(s32 *)&processor->scovlimit; + t6 = (t10 * 4); + t7 = LDQ_U(t10); + /* Stack cache offset */ + t8 = t1 - t8; + t11 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t9 = ((u64)t8 < (u64)t9) ? 1 : 0; + t6 = *(s32 *)t6; + t7 = (u8)(t7 >> ((t10&7)*8)); + if (t9 != 0) + goto g7093; + +g7092: + t10 = zero + 224; + t11 = t11 >> (t7 & 63); + t10 = t10 >> (t7 & 63); + if (t11 & 1) + goto g7095; + +g7100: + /* Memory Read Internal */ + +g7101: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + t10 = t5 + ivory; + t9 = *(s32 *)&processor->scovlimit; + t2 = (t10 * 4); + t3 = LDQ_U(t10); + /* Stack cache offset */ + t8 = t5 - t8; + t11 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t9 = ((u64)t8 < (u64)t9) ? 1 : 0; + t2 = *(s32 *)t2; + t3 = (u8)(t3 >> ((t10&7)*8)); + if (t9 != 0) + goto g7103; + +g7102: + t10 = zero + 224; + t11 = t11 >> (t3 & 63); + t10 = t10 >> (t3 & 63); + t2 = (u32)t2; + if (t11 & 1) + goto g7105; + +g7110: + /* Memory Read Internal */ + +g7111: + /* Base of stack cache */ + t10 = *(u64 *)&(processor->stackcachebasevma); + t12 = t2 + ivory; + t11 = *(s32 *)&processor->scovlimit; + t9 = (t12 * 4); + t8 = LDQ_U(t12); + /* Stack cache offset */ + t10 = t2 - t10; + /* In range? */ + t11 = ((u64)t10 < (u64)t11) ? 1 : 0; + t9 = *(s32 *)t9; + t8 = (u8)(t8 >> ((t12&7)*8)); + if (t11 != 0) + goto g7113; + +g7112: + t10 = *(u64 *)&(processor->bindwrite_mask); + t12 = zero + 224; + t10 = t10 >> (t8 & 63); + t12 = t12 >> (t8 & 63); + if (t10 & 1) + goto g7115; + +g7120: + /* Merge cdr-code */ + t9 = t7 & 63; + t8 = t8 & 192; + t8 = t8 | t9; + t10 = t2 + ivory; + t9 = (t10 * 4); + t12 = LDQ_U(t10); + t11 = (t8 & 0xff) << ((t10&7)*8); + t12 = t12 & ~(0xffL << (t10&7)*8); + +g7123: + if (_trace) printf("g7123:\n"); + t12 = t12 | t11; + t11 = *(u64 *)&(processor->stackcachebasevma); + STQ_U(t10, t12); + t10 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + t11 = t2 - t11; + /* In range? */ + t10 = ((u64)t11 < (u64)t10) ? 1 : 0; + *(u32 *)t9 = t6; + /* J. if in cache */ + if (t10 != 0) + goto g7122; + +g7121: + /* Get the old cleanup-bindings bit */ + t3 = t3 & 64; + t3 = t3 << 19; + t1 = t1 - 2; + /* vma only */ + *(u32 *)&processor->bindingstackpointer = t1; + t4 = t4 | t3; + *(u32 *)&processor->control = t4; + arg5 = *(s32 *)&processor->control; + t1 = (512) << 16; + t2 = t1 & arg5; + /* J. if cr.cleanup-bindings is 0. */ + if (t2 != 0) + goto g7089; + t2 = *(s32 *)&processor->interruptreg; + t3 = t2 & 2; + t3 = (t3 == 2) ? 1 : 0; + t2 = t2 | t3; + *(u32 *)&processor->interruptreg = t2; + if (t2 == 0) + goto g7124; + *(u64 *)&processor->stop_interpreter = t2; + +g7124: + if (_trace) printf("g7124:\n"); + +g7086: + if (_trace) printf("g7086:\n"); + t3 = (256) << 16; + t2 = t3 & arg5; + if (t2 == 0) + goto INTERPRETINSTRUCTION; + arg5 = zero; + arg2 = 79; + goto illegaloperand; + goto INTERPRETINSTRUCTION; + +g7122: + if (_trace) printf("g7122:\n"); + t10 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t10 = (t11 * 8) + t10; + /* Store in stack */ + *(u32 *)t10 = t6; + /* write the stack cache */ + *(u32 *)(t10 + 4) = t8; + goto g7121; + +g7113: + if (_trace) printf("g7113:\n"); + t11 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t10 = (t10 * 8) + t11; + t9 = *(s32 *)t10; + /* Read from stack cache */ + t8 = *(s32 *)(t10 + 4); + goto g7112; + +g7115: + if (_trace) printf("g7115:\n"); + if ((t12 & 1) == 0) + goto g7114; + /* Do the indirect thing */ + t2 = (u32)t9; + goto g7111; + +g7114: + if (_trace) printf("g7114:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->bindwrite); + /* TagType. */ + /* Discard the CDR code */ + t12 = t8 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + t12 = (t12 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t12; + +g7117: + /* Perform memory action */ + arg1 = t10; + arg2 = 3; + goto performmemoryaction; + +g7103: + if (_trace) printf("g7103:\n"); + t9 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t9; + t2 = *(s32 *)t8; + /* Read from stack cache */ + t3 = *(s32 *)(t8 + 4); + goto g7102; + +g7105: + if (_trace) printf("g7105:\n"); + if ((t10 & 1) == 0) + goto g7104; + /* Do the indirect thing */ + t5 = (u32)t2; + goto g7101; + +g7104: + if (_trace) printf("g7104:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7107: + /* Perform memory action */ + arg1 = t11; + arg2 = 2; + goto performmemoryaction; + +g7093: + if (_trace) printf("g7093:\n"); + t9 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t9; + t6 = *(s32 *)t8; + /* Read from stack cache */ + t7 = *(s32 *)(t8 + 4); + goto g7092; + +g7095: + if (_trace) printf("g7095:\n"); + if ((t10 & 1) == 0) + goto g7094; + /* Do the indirect thing */ + t1 = (u32)t6; + goto g7091; + +g7094: + if (_trace) printf("g7094:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t7 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g7097: + /* Perform memory action */ + arg1 = t11; + arg2 = 2; + goto performmemoryaction; + +/* end HANDLEFRAMECLEANUP */ +/* start StackCacheUnderflowCheck */ + + +stackcacheunderflowcheck: + if (_trace) printf("stackcacheunderflowcheck:\n"); + t1 = *(u64 *)&(processor->stackcachedata); + /* Preserve through instruction's original SP */ + t4 = *(u64 *)&(processor->restartsp); + /* Number of words*8 to fill iff positive */ + t3 = t1 - iFP; + if ((s64)t3 <= 0) + goto interpretinstructionforbranch; + /* Convert to a word count */ + t3 = (s64)t3 >> 3; + /* Account for the inclusive limit */ + t4 = t4 + 8; + /* in case only low three bits nonzero */ + if ((s64)t3 <= 0) + goto interpretinstructionforbranch; + r0 = (u64)&&return0039; + goto stackcacheunderflow; +return0039: + goto interpretinstructionforbranch; + +/* end StackCacheUnderflowCheck */ +/* start StackCacheUnderflow */ + + +stackcacheunderflow: + if (_trace) printf("stackcacheunderflow:\n"); + /* Compute target address for shift */ + t2 = (t3 * 8) + t1; + /* Compute number of elements to preserve */ + t5 = t4 - t1; + /* Convert to word count */ + t5 = (s64)t5 >> 3; + /* Shove everything up */ + /* Adjust to end of source block */ + t1 = (t5 * 8) + t1; + /* Adjust to end of target block */ + t2 = (t5 * 8) + t2; + goto g7125; + +g7126: + if (_trace) printf("g7126:\n"); + /* advance from position */ + t1 = t1 - 8; + t5 = t5 - 1; + /* Get a word from source */ + t7 = *(u64 *)t1; + /* advance to position */ + t2 = t2 - 8; + /* Put word in destination */ + *(u64 *)t2 = t7; + +g7125: + if ((s64)t5 > 0) + goto g7126; + /* Adjust stack cache relative registers */ + iFP = (t3 * 8) + iFP; + t4 = *(u64 *)&(processor->restartsp); + iSP = (t3 * 8) + iSP; + iLP = (t3 * 8) + iLP; + t4 = (t3 * 8) + t4; + /* Fill freshly opened slots of stack cache from memory */ + t1 = *(u64 *)&(processor->stackcachebasevma); + t2 = *(u64 *)&(processor->stackcachedata); + *(u64 *)&processor->restartsp = t4; + /* Compute new base address of stack cache */ + t1 = t1 - t3; + /* Top of cache */ + t4 = *(u64 *)&(processor->stackcachetopvma); + *(u64 *)&processor->stackcachebasevma = t1; + /* Adjust top of cache */ + t4 = t4 - t3; + *(u64 *)&processor->stackcachetopvma = t4; + t7 = t1 + ivory; + t5 = (t7 * 4); + t4 = LDQ_U(t7); + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t7&7)*8)); + goto g7127; + +g7128: + if (_trace) printf("g7128:\n"); + t7 = t1 + ivory; + t5 = (t7 * 4); + t4 = LDQ_U(t7); + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t7&7)*8)); + t3 = t3 - 1; + /* advance vma position */ + t1 = t1 + 1; + *(u32 *)t2 = t5; + /* write the stack cache */ + *(u32 *)(t2 + 4) = t4; + /* advance sca position */ + t2 = t2 + 8; + +g7127: + if ((s64)t3 > 0) + goto g7128; +#ifdef TRACING + /* Trace instructions if requested. */ + t4 = *(u64 *)&(processor->trace_hook); + /* J. if not tracing. */ + if (t4 == 0) + goto g7133; + /* Record an instruction trace entry */ + t5 = *(s32 *)&t4->tracedata_recording_p; + t1 = *(u64 *)&(t4->tracedata_start_pc); + /* Jump if recording is on */ + if (t5 != 0) + goto g7129; + /* Turn recording on if at the start PC */ + t1 = (t1 == iPC) ? 1 : 0; + *(u32 *)&t4->tracedata_recording_p = t1; + /* Jump if not at the start PC */ + if (t1 == 0) + goto g7133; + +g7129: + if (_trace) printf("g7129:\n"); + /* Get address of next trace record */ + t5 = *(u64 *)&(t4->tracedata_current_entry); + t1 = *(u64 *)&(processor->instruction_count); + /* Save current PC */ + *(u64 *)&t5->tracerecord_epc = iPC; + /* Save instruction count */ + *(u64 *)&t5->tracerecord_counter = t1; + t1 = *(u64 *)iSP; + /* Convert stack cache address to VMA */ + t3 = *(u64 *)&(processor->stackcachedata); + t2 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t3 = iSP - t3; + /* convert byte address to word address */ + t3 = t3 >> 3; + /* reconstruct VMA */ + t2 = t3 + t2; + /* Save current value of TOS */ + *(u64 *)&t5->tracerecord_tos = t1; + /* Save current SP */ + *(u64 *)&t5->tracerecord_sp = t2; + t1 = *(s32 *)&((CACHELINEP)iCP)->operand; + t2 = *(u64 *)&(((CACHELINEP)iCP)->code); + /* Save current instruction's operand */ + *(u32 *)&t5->tracerecord_operand = t1; + /* Save pointer to current instruction code */ + *(u64 *)&t5->tracerecord_instruction = t2; + t2 = *(u64 *)&(processor->control); + t3 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* We don't yet record catch blocks */ + *(u32 *)&t5->tracerecord_catch_block_p = zero; + /* Save control register */ + *(u64 *)&t5->tracerecord_catch_block_0 = t2; + t1 = *(u64 *)&(processor->tvi); + /* Save full word instruction operand */ + *(u64 *)&t5->tracerecord_instruction_data = t3; + /* Save trap indiciator */ + *(u32 *)&t5->tracerecord_trap_p = t1; + /* Jump if didn't trap */ + if (t1 == 0) + goto g7130; + t1 = *(u64 *)(iFP + 16); + /* Zero flag to avoid false trap entries */ + *(u64 *)&processor->tvi = zero; + t2 = *(u64 *)(iFP + 24); + /* Save trap vector index */ + *(u64 *)&t5->tracerecord_trap_data_0 = t1; + t3 = *(u64 *)(iFP + 32); + /* Save fault PC */ + *(u64 *)&t5->tracerecord_trap_data_1 = t2; + t6 = *(u64 *)(iFP + 40); + /* Save two additional arguments */ + *(u64 *)&t5->tracerecord_trap_data_2 = t3; + *(u64 *)&t5->tracerecord_trap_data_3 = t6; + +g7130: + if (_trace) printf("g7130:\n"); + /* Bump to next trace record */ + t5 = t5 + tracerecordsize; + /* Get pointer to start of trace records */ + t1 = *(u64 *)&(t4->tracedata_records_start); + /* Set record pointer to keep printer happy */ + *(u64 *)&t4->tracedata_current_entry = t5; + /* Get pointer to end of trace record */ + t2 = *(u64 *)&(t4->tracedata_records_end); + /* Function to print trace if non-zero */ + t3 = *(u64 *)&(t4->tracedata_printer); + /* Non-zero iff we're about to wrap the circular buffer */ + t2 = ((s64)t2 <= (s64)t5) ? 1 : 0; + /* Update next record pointer iff we wrapped */ + if (t2) + t5 = t1; + /* Don't print if we didn't wrap */ + if (t2 == 0) + t3 = zero; + /* Jump if we don't need to print */ + if (t3 == 0) + goto g7131; + *(u64 *)&processor->cp = iCP; + *(u64 *)&processor->epc = iPC; + *(u64 *)&processor->sp = iSP; + *(u64 *)&processor->fp = iFP; + *(u64 *)&processor->lp = iLP; + *(u64 *)&processor->asrf2 = arg1; + *(u64 *)&processor->asrf3 = arg2; + *(u64 *)&processor->asrf4 = arg3; + *(u64 *)&processor->asrf5 = arg4; + *(u64 *)&processor->asrf6 = arg5; + *(u64 *)&processor->asrf7 = arg6; + *(u64 *)&processor->asrf8 = t4; + *(u64 *)&processor->asrf9 = t5; + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + pv = t3; + r0 = (*( u64 (*)(u64, u64) )t3)(arg1, arg2); /* jsr */ + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + arg1 = *(u64 *)&(processor->asrf2); + arg2 = *(u64 *)&(processor->asrf3); + arg3 = *(u64 *)&(processor->asrf4); + arg4 = *(u64 *)&(processor->asrf5); + arg5 = *(u64 *)&(processor->asrf6); + arg6 = *(u64 *)&(processor->asrf7); + t4 = *(u64 *)&(processor->asrf8); + t5 = *(u64 *)&(processor->asrf9); + iCP = *(u64 *)&(processor->cp); + iPC = *(u64 *)&(processor->epc); + iSP = *(u64 *)&(processor->sp); + iFP = *(u64 *)&(processor->fp); + iLP = *(u64 *)&(processor->lp); + /* Claim we didn't wrap */ + t2 = zero; + +g7131: + if (_trace) printf("g7131:\n"); + /* Save next record pointer */ + *(u64 *)&t4->tracedata_current_entry = t5; + /* Jump if we didn't wrap */ + if (t2 == 0) + goto g7132; + /* Set flag indicating that we wrapped */ + *(u32 *)&t4->tracedata_wrap_p = t2; + +g7132: + if (_trace) printf("g7132:\n"); + t5 = *(u64 *)&(t4->tracedata_stop_pc); + /* Non-zero if at PC where we should stop tracing */ + t5 = (t5 == iPC) ? 1 : 0; + /* Non-zero if not at the PC */ + t5 = (t5 == 0) ? 1 : 0; + /* Update recording flag */ + *(u32 *)&t4->tracedata_recording_p = t5; + +g7133: + if (_trace) printf("g7133:\n"); +#endif + goto *r0; /* ret */ + +/* end StackCacheUnderflow */ +/* start StackCacheOverflowHandler */ + + +stackcacheoverflowhandler: + if (_trace) printf("stackcacheoverflowhandler:\n"); + /* Stack cache overflow detected */ + t1 = zero + 256; + /* Account for what we're about to push */ + t1 = t1 + arg2; + /* SCA of desired end of cache */ + t1 = (t1 * 8) + iSP; + iSP = *(u64 *)&(processor->restartsp); + /* Alpha base of stack cache */ + t4 = *(u64 *)&(processor->stackcachedata); + /* New limit*8 */ + t4 = t1 - t4; + t4 = t4 >> 3; + /* Update stack cache limit */ + *(u32 *)&processor->scovlimit = t4; + /* Check that the page underlying the end of the stack cache is accessible */ + /* Convert stack cache address to VMA */ + t4 = *(u64 *)&(processor->stackcachedata); + t3 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t4 = t1 - t4; + /* convert byte address to word address */ + t4 = t4 >> 3; + /* reconstruct VMA */ + t3 = t4 + t3; + /* Per-page attributes table */ + t5 = *(u64 *)&(processor->vmattributetable); + /* Index into the attributes table */ + t4 = t3 >> (MemoryPage_AddressShift & 63); + /* Address of the page's attributes */ + t5 = t4 + t5; + /* Get the quadword with the page's attributes */ + t4 = LDQ_U(t5); + /* Stash the VMA */ + *(u64 *)&processor->vma = t3; + /* Extract the page's attributes */ + t4 = (u8)(t4 >> ((t5&7)*8)); + /* Non-existent page */ + if (t4 == 0) + goto pagenotresident; + t5 = t4 & VMAttribute_AccessFault; + /* Access fault */ + if (t5 != 0) + goto pagefaultrequesthandler; + t5 = t4 & VMAttribute_WriteFault; + /* Write fault */ + if (t5 != 0) + goto pagewritefault; + /* Check if we must dump the cache */ + /* New stack cache limit (words) */ + t4 = *(s32 *)&processor->scovlimit; + /* Absolute size of the cache (words) */ + t5 = *(u64 *)&(processor->stackcachesize); + t5 = ((s64)t4 <= (s64)t5) ? 1 : 0; + /* We're done if new limit is less than absolute limit */ + if (t5 != 0) + goto INTERPRETINSTRUCTION; + /* Dump the stack cache to make room */ + t1 = zero + 896; + /* Stack cache base VMA */ + t2 = *(u64 *)&(processor->stackcachebasevma); + /* Alpha base of stack cache */ + t3 = *(u64 *)&(processor->stackcachedata); + /* Will be destructively modified */ + *(u32 *)&processor->scovdumpcount = t1; + /* Starting address of tags */ + t5 = t2 + ivory; + /* Starting address of data */ + t2 = (t5 * 4); + /* Dump the data */ + goto g7134; + +g7135: + if (_trace) printf("g7135:\n"); + /* Get data word */ + t4 = *(s32 *)t3; + t1 = t1 - 1; + /* Advance SCA position */ + t3 = t3 + 8; + /* Save data word */ + *(u32 *)t2 = t4; + /* Advance VMA position */ + t2 = t2 + 4; + +g7134: + if ((s64)t1 > 0) + goto g7135; + /* Dump the tags */ + /* Restore the count */ + t1 = *(s32 *)&processor->scovdumpcount; + /* Restore tag VMA */ + t2 = t5; + t4 = t1 << 3; + /* Restore orginal SCA */ + t3 = t3 - t4; + goto g7136; + +g7137: + if (_trace) printf("g7137:\n"); + t1 = t1 - 1; + /* Get tag word */ + t4 = *(s32 *)(t3 + 4); + /* Advance SCA position */ + t3 = t3 + 8; + /* Get packed tags word */ + t5 = LDQ_U(t2); + /* Position the new tag */ + t4 = (t4 & 0xff) << ((t2&7)*8); + /* Remove old tag */ + t5 = t5 & ~(0xffL << (t2&7)*8); + /* Put in new byte */ + t5 = t4 | t5; + /* Save packed tags word */ + STQ_U(t2, t5); + /* Advance VMA position */ + t2 = t2 + 1; + +g7136: + if ((s64)t1 > 0) + goto g7137; + t1 = zero + 896; + /* Stack cache base VMA */ + t2 = *(u64 *)&(processor->stackcachebasevma); + /* Top of cache */ + t4 = *(u64 *)&(processor->stackcachetopvma); + /* Cache limit in words */ + t5 = *(s32 *)&processor->scovlimit; + /* Adjust cache base VMA */ + t2 = t2 + t1; + /* Adjust top of cache */ + t4 = t4 + t1; + /* Adjust limit */ + t5 = t5 - t1; + /* Save update */ + *(u64 *)&processor->stackcachebasevma = t2; + *(u64 *)&processor->stackcachetopvma = t4; + *(u32 *)&processor->scovlimit = t5; + /* Move the cache down */ + /* Alpha base of stack cache */ + t3 = *(u64 *)&(processor->stackcachedata); + /* SCA of first word of new base */ + t2 = (t1 * 8) + t3; + goto g7138; + +g7139: + if (_trace) printf("g7139:\n"); + t1 = t1 - 1; + /* Get a word from source */ + t5 = *(u64 *)t2; + /* advance from position */ + t2 = t2 + 8; + /* Put word in destination */ + *(u64 *)t3 = t5; + /* advance to position */ + t3 = t3 + 8; + +g7138: + if ((s64)t1 > 0) + goto g7139; + /* Adjust stack cache relative registers */ + t1 = zero + 896; + /* Convert to SCA adjustment */ + t1 = t1 << 3; + iSP = iSP - t1; + iFP = iFP - t1; + iLP = iLP - t1; + *(u64 *)&processor->restartsp = iSP; + goto INTERPRETINSTRUCTION; + +/* end StackCacheOverflowHandler */ +/* start DoReturnKludge */ + + /* Halfword operand from stack instruction - DoReturnKludge */ + /* arg2 has the preloaded 8 bit operand. */ + +doreturnkludge: + if (_trace) printf("doreturnkludge:\n"); +#ifdef TRACING +#endif + +DoReturnKludgeSP: + if (_trace) printf("DoReturnKludgeSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindoreturnkludge; +#endif + +DoReturnKludgeLP: + if (_trace) printf("DoReturnKludgeLP:\n"); +#ifdef TRACING + goto begindoreturnkludge; +#endif + +DoReturnKludgeFP: + if (_trace) printf("DoReturnKludgeFP:\n"); + +begindoreturnkludge: + if (_trace) printf("begindoreturnkludge:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t1 = *(s32 *)(arg1 + 4); + arg2 = *(s32 *)arg1; + t2 = t1 - Type_Fixnum; + /* Strip CDR code */ + t2 = t2 & 63; + if (t2 != 0) + goto returnkludgeio; + arg2 = (u32)arg2; +#ifdef TRACING + goto DoReturnKludgeIM; +#endif + +DoReturnKludgeIM: + if (_trace) printf("DoReturnKludgeIM:\n"); + arg6 = *(u64 *)&(processor->stackcachedata); + t1 = (arg2 * 8) - 8; + t2 = *(s32 *)&processor->control; + /* t1 is the values block */ + t1 = iSP - t1; + /* Restore machine state from frame header. */ + t5 = *(s32 *)iFP; + t3 = (1792) << 16; + t7 = *(s32 *)&processor->continuation; + /* Mask */ + t3 = t2 & t3; + t4 = *(s32 *)(iFP + 4); + t9 = iCP; + /* Need to cleanup frame first */ + if (t3 != 0) + goto returnkludgecleanup; + t5 = (u32)t5; + t6 = *((s32 *)(&processor->continuation)+1); + t7 = (u32)t7; +#ifdef IVERIFY + /* check for instruction verification suite end-of-test */ + /* check for end of run */ + t8 = (s32)t4 - (s32)Type_NIL; + if (t8 == 0) + goto g7140; +#endif + /* Get saved control register */ + t8 = *(s32 *)(iFP + 8); + /* TagType. */ + t4 = t4 & 63; + /* Restore the PC. */ + /* Assume even PC */ + iPC = t7 << 1; + t3 = t6 & 1; + t9 = *(u64 *)&(processor->continuationcp); + iPC = iPC + t3; + +g7142: + if (_trace) printf("g7142:\n"); + /* Restore the saved continuation */ + *((u32 *)(&processor->continuation)+1) = t4; + /* Get the caller frame size into place */ + t3 = t2 >> 9; + *(u32 *)&processor->continuation = t5; + /* Restore the stack pointer. */ + iSP = iFP - 8; + *(u64 *)&processor->continuationcp = zero; + /* Mask just the caller frame size. */ + t3 = t3 & 255; + /* *8 */ + t3 = (t3 * 8) + 0; + t4 = (2048) << 16; + t4 = t4 & t2; + /* Get the preempt-pending bit */ + t5 = *(s32 *)&processor->interruptreg; + /* Sticky trace pending bit. */ + t8 = t4 | t8; + /* Get the trap/suspend bits */ + t6 = *(u64 *)&(processor->please_stop); + /* Restore the frame pointer. */ + iFP = iFP - t3; + /* Restore the control register */ + *(u32 *)&processor->control = t8; + /* extract the argument size */ + t3 = t8 & 255; + t5 = t5 & 1; + t5 = t6 | t5; + *(u64 *)&processor->stop_interpreter = t5; + /* Restore the local pointer. */ + iLP = (t3 * 8) + iFP; + /* ARG6 = stack-cache underflow */ + arg6 = ((u64)iFP < (u64)arg6) ? 1 : 0; + if (arg2 == 0) + goto rkloopdone; + +rklooptop: + if (_trace) printf("rklooptop:\n"); + /* Read a 40 bit word from the values block */ + t4 = *(u64 *)t1; + arg2 = arg2 - 1; + /* Push value onto stack cdr codes and all */ + *(u64 *)(iSP + 8) = t4; + t1 = t1 + 8; + iSP = iSP + 8; + if ((s64)arg2 > 0) + goto rklooptop; + +rkloopdone: + if (_trace) printf("rkloopdone:\n"); + if (arg6 != 0) + goto returnkludgeunderflow; + /* No prediction, validate cache */ + if (t9 == 0) + goto interpretinstructionforbranch; + iCP = t9; + goto INTERPRETINSTRUCTION; + +returnkludgeio: + if (_trace) printf("returnkludgeio:\n"); + arg5 = 0; + arg2 = 63; + goto illegaloperand; + +returnkludgecleanup: + if (_trace) printf("returnkludgecleanup:\n"); + goto handleframecleanup; + +returnkludgeunderflow: + if (_trace) printf("returnkludgeunderflow:\n"); + goto stackcacheunderflowcheck; + +/* end DoReturnKludge */ + /* End of Halfword operand from stack instruction - DoReturnKludge */ +/* start DoTakeValues */ + + /* Halfword operand from stack instruction - DoTakeValues */ + /* arg2 has the preloaded 8 bit operand. */ + +dotakevalues: + if (_trace) printf("dotakevalues:\n"); +#ifdef TRACING +#endif + +DoTakeValuesIM: + if (_trace) printf("DoTakeValuesIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindotakevalues; +#ifdef TRACING +#endif + +DoTakeValuesSP: + if (_trace) printf("DoTakeValuesSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdotakevalues; +#endif + +DoTakeValuesLP: + if (_trace) printf("DoTakeValuesLP:\n"); +#ifdef TRACING + goto headdotakevalues; +#endif + +DoTakeValuesFP: + if (_trace) printf("DoTakeValuesFP:\n"); + +headdotakevalues: + if (_trace) printf("headdotakevalues:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindotakevalues: + if (_trace) printf("begindotakevalues:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + arg6 = *(u64 *)&(processor->niladdress); + /* Number of values expected */ + arg1 = (u32)arg1; + /* Number of values provided */ + arg4 = *(s32 *)iSP; + /* Number of values provided */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + arg2 = arg1 - arg4; + /* J. if too many args supplied */ + if ((s64)arg2 < 0) + goto takevalueslose; + /* J. if too few values supplied */ + if ((s64)arg2 > 0) + goto takevaluespad; + goto NEXTINSTRUCTION; + +takevalueslose: + if (_trace) printf("takevalueslose:\n"); + /* Remove the unwanted values */ + iSP = (arg2 * 8) + iSP; + goto NEXTINSTRUCTION; + +takevaluespad: + if (_trace) printf("takevaluespad:\n"); + /* Current stack cache limit (words) */ + t4 = *(s32 *)&processor->scovlimit; + t1 = zero + 128; + /* Alpha base of stack cache */ + t2 = *(u64 *)&(processor->stackcachedata); + /* Account for what we're about to push */ + t1 = t1 + arg2; + /* SCA of desired end of cache */ + t1 = (t1 * 8) + iSP; + /* SCA of current end of cache */ + t2 = (t4 * 8) + t2; + t4 = ((s64)t1 <= (s64)t2) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t4 == 0) + goto stackcacheoverflowhandler; + +takevaluespadloop: + if (_trace) printf("takevaluespadloop:\n"); + /* Push NIL */ + *(u64 *)(iSP + 8) = arg6; + iSP = iSP + 8; + arg2 = arg2 - 1; + if ((s64)arg2 > 0) + goto takevaluespadloop; + goto NEXTINSTRUCTION; + +/* end DoTakeValues */ + /* End of Halfword operand from stack instruction - DoTakeValues */ + /* Catch Instructions */ +/* start DoCatchOpen */ + + /* Halfword 10 bit immediate instruction - DoCatchOpen */ + +docatchopen: + if (_trace) printf("docatchopen:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoCatchOpenIM: + if (_trace) printf("DoCatchOpenIM:\n"); + +DoCatchOpenSP: + if (_trace) printf("DoCatchOpenSP:\n"); + +DoCatchOpenLP: + if (_trace) printf("DoCatchOpenLP:\n"); + +DoCatchOpenFP: + if (_trace) printf("DoCatchOpenFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + /* t10=1 if unwind-protect, t10=0 if catch */ + t10 = arg1 & 1; + /* tag */ + t3 = *((s32 *)(&processor->catchblock)+1); + t10 = t10 << 38; + /* data */ + t4 = *(s32 *)&processor->catchblock; + t2 = *(u64 *)&(processor->bindingstackpointer); + /* Convert stack cache address to VMA */ + t1 = *(u64 *)&(processor->stackcachedata); + t9 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t1 = iSP - t1; + /* convert byte address to word address */ + t1 = t1 >> 3; + /* reconstruct VMA */ + t9 = t1 + t9; + t1 = t10 | t2; + *(u64 *)(iSP + 8) = t1; + iSP = iSP + 8; + t11 = *(s32 *)&processor->control; + /* Get old cleanup catch bit */ + t2 = t11 >> 20; + t2 = t2 & 64; + /* Get old extra arg bit */ + t1 = t11 >> 1; + t1 = t1 & 128; + t1 = t1 | t2; + /* TagType. */ + t2 = t3 & 63; + /* T1 now has new tag */ + t1 = t1 | t2; + *(u32 *)(iSP + 8) = t4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + if (t10 != 0) + goto catchopen2; + t2 = *(s32 *)&processor->continuation; + t1 = *((s32 *)(&processor->continuation)+1); + t2 = (u32)t2; + /* TagType. */ + t1 = t1 & 63; + /* T3 has the disposition bits in place */ + t3 = arg1 & 192; + t1 = t1 | t3; + *(u32 *)(iSP + 8) = t2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + +catchopen2: + if (_trace) printf("catchopen2:\n"); + t1 = Type_Locative; + /* tag */ + *((u32 *)(&processor->catchblock)+1) = t1; + /* data */ + *(u32 *)&processor->catchblock = t9; + t1 = (1024) << 16; + /* set it */ + t1 = t1 | t11; + *(u32 *)&processor->control = t1; + goto NEXTINSTRUCTION; + +/* end DoCatchOpen */ + /* End of Halfword operand from stack instruction - DoCatchOpen */ +/* start DoCatchClose */ + + /* Halfword operand from stack instruction - DoCatchClose */ + /* arg2 has the preloaded 8 bit operand. */ + +docatchclose: + if (_trace) printf("docatchclose:\n"); +#ifdef TRACING +#endif + +DoCatchCloseSP: + if (_trace) printf("DoCatchCloseSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindocatchclose; +#endif + +DoCatchCloseLP: + if (_trace) printf("DoCatchCloseLP:\n"); +#ifdef TRACING + goto begindocatchclose; +#endif + +DoCatchCloseFP: + if (_trace) printf("DoCatchCloseFP:\n"); + +begindocatchclose: + if (_trace) printf("begindocatchclose:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* data */ + t1 = *(s32 *)&processor->catchblock; + t1 = (u32)t1; + /* Convert VMA to stack cache address */ + t3 = *(u64 *)&(processor->stackcachebasevma); + t10 = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t3 = t1 - t3; + /* reconstruct SCA */ + t10 = (t3 * 8) + t10; + /* bstag bsdata */ + arg4 = *(s32 *)(t10 + 8); + arg3 = *(s32 *)(t10 + 12); + arg4 = (u32)arg4; + t4 = *(u64 *)&(processor->bindingstackpointer); + /* prtag prdata */ + arg6 = *(s32 *)(t10 + 16); + arg5 = *(s32 *)(t10 + 20); + arg6 = (u32)arg6; + t3 = t4 >> 32; + t5 = (s32)arg4 - (s32)t4; + if (t5 == 0) + goto catchcloseld; + t1 = t3 - Type_Locative; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto catchclosedbt; + +catchcloselt: + if (_trace) printf("catchcloselt:\n"); + t1 = *(u64 *)&(processor->bindingstackpointer); + t4 = *(s32 *)&processor->control; + /* vma only */ + t1 = (u32)t1; + t2 = (512) << 16; + t5 = t1 - 1; + t3 = t4 & t2; + /* Turn off the bit */ + t4 = t4 & ~t2; + if (t3 != 0) + goto g7144; + /* Get the SP, ->op2 */ + t4 = *(u64 *)&(processor->restartsp); + arg5 = 0; + arg2 = 20; + goto illegaloperand; + +g7144: + if (_trace) printf("g7144:\n"); + /* Memory Read Internal */ + +g7145: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + arg1 = t1 + ivory; + t9 = *(s32 *)&processor->scovlimit; + t6 = (arg1 * 4); + t7 = LDQ_U(arg1); + /* Stack cache offset */ + t8 = t1 - t8; + arg2 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t9 = ((u64)t8 < (u64)t9) ? 1 : 0; + t6 = *(s32 *)t6; + t7 = (u8)(t7 >> ((arg1&7)*8)); + if (t9 != 0) + goto g7147; + +g7146: + arg1 = zero + 224; + arg2 = arg2 >> (t7 & 63); + arg1 = arg1 >> (t7 & 63); + if (arg2 & 1) + goto g7149; + +g7154: + /* Memory Read Internal */ + +g7155: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + arg1 = t5 + ivory; + t9 = *(s32 *)&processor->scovlimit; + t2 = (arg1 * 4); + t3 = LDQ_U(arg1); + /* Stack cache offset */ + t8 = t5 - t8; + arg2 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t9 = ((u64)t8 < (u64)t9) ? 1 : 0; + t2 = *(s32 *)t2; + t3 = (u8)(t3 >> ((arg1&7)*8)); + if (t9 != 0) + goto g7157; + +g7156: + arg1 = zero + 224; + arg2 = arg2 >> (t3 & 63); + arg1 = arg1 >> (t3 & 63); + t2 = (u32)t2; + if (arg2 & 1) + goto g7159; + +g7164: + /* Memory Read Internal */ + +g7165: + /* Base of stack cache */ + arg1 = *(u64 *)&(processor->stackcachebasevma); + t11 = t2 + ivory; + arg2 = *(s32 *)&processor->scovlimit; + t9 = (t11 * 4); + t8 = LDQ_U(t11); + /* Stack cache offset */ + arg1 = t2 - arg1; + /* In range? */ + arg2 = ((u64)arg1 < (u64)arg2) ? 1 : 0; + t9 = *(s32 *)t9; + t8 = (u8)(t8 >> ((t11&7)*8)); + if (arg2 != 0) + goto g7167; + +g7166: + arg1 = *(u64 *)&(processor->bindwrite_mask); + t11 = zero + 224; + arg1 = arg1 >> (t8 & 63); + t11 = t11 >> (t8 & 63); + if (arg1 & 1) + goto g7169; + +g7174: + /* Merge cdr-code */ + t9 = t7 & 63; + t8 = t8 & 192; + t8 = t8 | t9; + arg1 = t2 + ivory; + t9 = (arg1 * 4); + t11 = LDQ_U(arg1); + arg2 = (t8 & 0xff) << ((arg1&7)*8); + t11 = t11 & ~(0xffL << (arg1&7)*8); + +g7177: + if (_trace) printf("g7177:\n"); + t11 = t11 | arg2; + arg2 = *(u64 *)&(processor->stackcachebasevma); + STQ_U(arg1, t11); + arg1 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + arg2 = t2 - arg2; + /* In range? */ + arg1 = ((u64)arg2 < (u64)arg1) ? 1 : 0; + *(u32 *)t9 = t6; + /* J. if in cache */ + if (arg1 != 0) + goto g7176; + +g7175: + /* Get the old cleanup-bindings bit */ + t3 = t3 & 64; + t3 = t3 << 19; + t1 = t1 - 2; + /* vma only */ + *(u32 *)&processor->bindingstackpointer = t1; + t4 = t4 | t3; + *(u32 *)&processor->control = t4; + t5 = (s32)arg4 - (s32)t1; + if (t5 != 0) + goto catchcloselt; + t3 = *(s32 *)&processor->interruptreg; + t4 = t3 & 2; + t4 = (t4 == 2) ? 1 : 0; + t3 = t3 | t4; + *(u32 *)&processor->interruptreg = t3; + if (t3 == 0) + goto g7178; + *(u64 *)&processor->stop_interpreter = t3; + +g7178: + if (_trace) printf("g7178:\n"); + +catchcloseld: + if (_trace) printf("catchcloseld:\n"); + /* TagType. */ + t1 = arg5 & 63; + /* tag */ + *((u32 *)(&processor->catchblock)+1) = t1; + /* extra argument bit */ + t2 = arg5 & 128; + /* mask for two bits */ + t6 = *(u64 *)&(processor->extraandcatch); + /* position in place for control register. */ + t2 = t2 << 1; + /* data */ + *(u32 *)&processor->catchblock = arg6; + /* cleanup catch bit */ + t3 = arg5 & 64; + /* position in place for cr */ + t3 = t3 << 20; + t4 = *(s32 *)&processor->control; + /* coalesce the two bits */ + t5 = t2 | t3; + /* Turn off extra-arg and cleanup-catch */ + t4 = t4 & ~t6; + /* Maybe turn them back on */ + t4 = t4 | t5; + *(u32 *)&processor->control = t4; + /* uwp bit */ + t6 = arg3 & 64; + if (t6 == 0) + goto NEXTINSTRUCTION; + /* Handle unwind-protect cleanup here */ + /* pctag pcdata */ + arg2 = *(s32 *)t10; + arg1 = *(s32 *)(t10 + 4); + arg2 = (u32)arg2; + /* Cleanup in progress bit into cdr code pos */ + t8 = t4 >> 17; + /* Next PC */ + t7 = iPC + 1; + /* Convert PC to a real continuation. */ + t8 = t7 & 1; + /* convert PC to a real word address. */ + t10 = t7 >> 1; + t8 = t8 + Type_EvenPC; + /* TagType. */ + t7 = t8 & 63; + t8 = t8 & 64; + t9 = (128) << 16; + t8 = t8 | 128; + t7 = t7 | t8; + *(u32 *)(iSP + 8) = t10; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t7; + iSP = iSP + 8; + /* set cr.cleanup-in-progress */ + t4 = t4 | t9; + *(u32 *)&processor->control = t4; + /* Convert real continuation to PC. */ + iPC = arg1 & 1; + iPC = arg2 + iPC; + iPC = arg2 + iPC; + goto interpretinstructionforjump; + +catchclosedbt: + if (_trace) printf("catchclosedbt:\n"); + goto dbunwindcatchtrap; + +g7176: + if (_trace) printf("g7176:\n"); + arg1 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + arg1 = (arg2 * 8) + arg1; + /* Store in stack */ + *(u32 *)arg1 = t6; + /* write the stack cache */ + *(u32 *)(arg1 + 4) = t8; + goto g7175; + +g7167: + if (_trace) printf("g7167:\n"); + arg2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + arg1 = (arg1 * 8) + arg2; + t9 = *(s32 *)arg1; + /* Read from stack cache */ + t8 = *(s32 *)(arg1 + 4); + goto g7166; + +g7169: + if (_trace) printf("g7169:\n"); + if ((t11 & 1) == 0) + goto g7168; + /* Do the indirect thing */ + t2 = (u32)t9; + goto g7165; + +g7168: + if (_trace) printf("g7168:\n"); + /* Load the memory action table for cycle */ + arg1 = *(u64 *)&(processor->bindwrite); + /* TagType. */ + /* Discard the CDR code */ + t11 = t8 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t2; + /* Adjust for a longword load */ + t11 = (t11 * 4) + arg1; + /* Get the memory action */ + arg1 = *(s32 *)t11; + +g7171: + /* Perform memory action */ + arg1 = arg1; + arg2 = 3; + goto performmemoryaction; + +g7157: + if (_trace) printf("g7157:\n"); + t9 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t9; + t2 = *(s32 *)t8; + /* Read from stack cache */ + t3 = *(s32 *)(t8 + 4); + goto g7156; + +g7159: + if (_trace) printf("g7159:\n"); + if ((arg1 & 1) == 0) + goto g7158; + /* Do the indirect thing */ + t5 = (u32)t2; + goto g7155; + +g7158: + if (_trace) printf("g7158:\n"); + /* Load the memory action table for cycle */ + arg2 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + arg1 = t3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + arg1 = (arg1 * 4) + arg2; + /* Get the memory action */ + arg2 = *(s32 *)arg1; + +g7161: + /* Perform memory action */ + arg1 = arg2; + arg2 = 2; + goto performmemoryaction; + +g7147: + if (_trace) printf("g7147:\n"); + t9 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t9; + t6 = *(s32 *)t8; + /* Read from stack cache */ + t7 = *(s32 *)(t8 + 4); + goto g7146; + +g7149: + if (_trace) printf("g7149:\n"); + if ((arg1 & 1) == 0) + goto g7148; + /* Do the indirect thing */ + t1 = (u32)t6; + goto g7145; + +g7148: + if (_trace) printf("g7148:\n"); + /* Load the memory action table for cycle */ + arg2 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + arg1 = t7 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + arg1 = (arg1 * 4) + arg2; + /* Get the memory action */ + arg2 = *(s32 *)arg1; + +g7151: + /* Perform memory action */ + arg1 = arg2; + arg2 = 2; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoCatchCloseIM: + goto doistageerror; + +/* end DoCatchClose */ + /* End of Halfword operand from stack instruction - DoCatchClose */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunfcal.as */ diff --git a/stub/ifunfext.c b/stub/ifunfext.c new file mode 100644 index 0000000..7357edf --- /dev/null +++ b/stub/ifunfext.c @@ -0,0 +1,874 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunfext.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Field extraction instruction. */ +/* start DoCharLdb */ + + /* Field Extraction instruction - DoCharLdb */ + +docharldb: + if (_trace) printf("docharldb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoCharLdbIM: + if (_trace) printf("DoCharLdbIM:\n"); + +DoCharLdbSP: + if (_trace) printf("DoCharLdbSP:\n"); + +DoCharLdbLP: + if (_trace) printf("DoCharLdbLP:\n"); + +DoCharLdbFP: + if (_trace) printf("DoCharLdbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + /* t7= -1 */ + t7 = zero - 1; + /* get ARG1 tag/data */ + arg3 = *(s32 *)(iSP + 4); + arg4 = *(s32 *)iSP; + /* Size of field */ + arg1 = arg1 + 1; + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* TagType. */ + t8 = arg3 & 63; + t9 = t8 - Type_Character; + /* Clear sign extension now */ + arg4 = (u32)arg4; + /* Not a character */ + if (t9 != 0) + goto charldbexc; + /* T4= shifted value if PP==0 */ + t4 = arg4 << (arg2 & 63); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* T5= shifted value if PP<>0 */ + t5 = t4 >> 32; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T5= shifted value */ + if (arg2 == 0) + t5 = t4; + /* T3= masked value. */ + t3 = t5 & ~t7; + t4 = Type_Fixnum; + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t4; + goto cachevalid; + +charldbexc: + if (_trace) printf("charldbexc:\n"); + arg5 = 0; + arg2 = 28; + goto illegaloperand; + +/* end DoCharLdb */ + /* End of Halfword operand from stack instruction - DoCharLdb */ +/* start DoPLdb */ + + /* Field Extraction instruction - DoPLdb */ + +dopldb: + if (_trace) printf("dopldb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPLdbIM: + if (_trace) printf("DoPLdbIM:\n"); + +DoPLdbSP: + if (_trace) printf("DoPLdbSP:\n"); + +DoPLdbLP: + if (_trace) printf("DoPLdbLP:\n"); + +DoPLdbFP: + if (_trace) printf("DoPLdbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + /* get arg1 tag/data */ + t2 = *(s32 *)iSP; + t1 = *(s32 *)(iSP + 4); + t2 = (u32)t2; + t3 = t1 - Type_PhysicalAddress; + t3 = t3 & 63; + if (t3 == 0) + goto pldbillop; + /* Memory Read Internal */ + +g8200: + /* Base of stack cache */ + t3 = *(u64 *)&(processor->stackcachebasevma); + t5 = t2 + ivory; + t4 = *(s32 *)&processor->scovlimit; + arg4 = (t5 * 4); + arg3 = LDQ_U(t5); + /* Stack cache offset */ + t3 = t2 - t3; + /* In range? */ + t4 = ((u64)t3 < (u64)t4) ? 1 : 0; + arg4 = *(s32 *)arg4; + arg3 = (u8)(arg3 >> ((t5&7)*8)); + if (t4 != 0) + goto g8202; + +g8201: + arg4 = (u32)arg4; + +g8208: + /* t7= -1 */ + t7 = zero - 1; + /* Size of field */ + arg1 = arg1 + 1; + /* T4= shifted value if PP==0 */ + t4 = arg4 << (arg2 & 63); + /* T5= shifted value if PP<>0 */ + t5 = t4 >> 32; + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* T5= shifted value */ + if (arg2 == 0) + t5 = t4; + /* T3= masked value. */ + t3 = t5 & ~t7; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t4 = Type_Fixnum; + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t4; + goto cachevalid; + +pldbillop: + if (_trace) printf("pldbillop:\n"); + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = iSP - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + arg5 = t2; + arg2 = 57; + goto illegaloperand; + +g8202: + if (_trace) printf("g8202:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + arg4 = *(s32 *)t3; + /* Read from stack cache */ + arg3 = *(s32 *)(t3 + 4); + goto g8201; + +/* end DoPLdb */ + /* End of Halfword operand from stack instruction - DoPLdb */ +/* start DoPTagLdb */ + + /* Field Extraction instruction - DoPTagLdb */ + +doptagldb: + if (_trace) printf("doptagldb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPTagLdbIM: + if (_trace) printf("DoPTagLdbIM:\n"); + +DoPTagLdbSP: + if (_trace) printf("DoPTagLdbSP:\n"); + +DoPTagLdbLP: + if (_trace) printf("DoPTagLdbLP:\n"); + +DoPTagLdbFP: + if (_trace) printf("DoPTagLdbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + /* get arg1 tag/data */ + t2 = *(s32 *)iSP; + t1 = *(s32 *)(iSP + 4); + t2 = (u32)t2; + t3 = t1 - Type_PhysicalAddress; + t3 = t3 & 63; + if (t3 == 0) + goto ptagldbillop; + /* Memory Read Internal */ + +g8209: + /* Base of stack cache */ + t3 = *(u64 *)&(processor->stackcachebasevma); + t5 = t2 + ivory; + t4 = *(s32 *)&processor->scovlimit; + arg4 = (t5 * 4); + arg3 = LDQ_U(t5); + /* Stack cache offset */ + t3 = t2 - t3; + /* In range? */ + t4 = ((u64)t3 < (u64)t4) ? 1 : 0; + arg4 = *(s32 *)arg4; + arg3 = (u8)(arg3 >> ((t5&7)*8)); + if (t4 != 0) + goto g8211; + +g8210: + +g8217: + /* t7= -1 */ + t7 = zero - 1; + /* Size of field */ + arg1 = arg1 + 1; + /* T4= shifted value if PP==0 */ + t4 = arg3 << (arg2 & 63); + /* T5= shifted value if PP<>0 */ + t5 = t4 >> 32; + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* T5= shifted value */ + if (arg2 == 0) + t5 = t4; + /* T3= masked value. */ + t3 = t5 & ~t7; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t4 = Type_Fixnum; + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t4; + goto cachevalid; + +ptagldbillop: + if (_trace) printf("ptagldbillop:\n"); + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = iSP - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + arg5 = t2; + arg2 = 57; + goto illegaloperand; + +g8211: + if (_trace) printf("g8211:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + arg4 = *(s32 *)t3; + /* Read from stack cache */ + arg3 = *(s32 *)(t3 + 4); + goto g8210; + +/* end DoPTagLdb */ + /* End of Halfword operand from stack instruction - DoPTagLdb */ +/* start DoDpb */ + + /* Field Extraction instruction - DoDpb */ + +dodpb: + if (_trace) printf("dodpb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoDpbIM: + if (_trace) printf("DoDpbIM:\n"); + +DoDpbSP: + if (_trace) printf("DoDpbSP:\n"); + +DoDpbLP: + if (_trace) printf("DoDpbLP:\n"); + +DoDpbFP: + if (_trace) printf("DoDpbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + /* Get arg2 tag/data */ + t6 = *(s32 *)iSP; + /* Get arg2 tag/data */ + t5 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t6 = (u32)t6; + /* get arg1 tag/data */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + /* Strip off any CDR code bits. */ + t1 = t5 & 63; + /* Strip off any CDR code bits. */ + arg6 = arg3 & 63; + t2 = (t1 == Type_Fixnum) ? 1 : 0; + +g8230: + if (_trace) printf("g8230:\n"); + if (t2 == 0) + goto g8223; + /* Here if argument TypeFixnum */ + arg5 = (arg6 == Type_Fixnum) ? 1 : 0; + +g8227: + if (_trace) printf("g8227:\n"); + if (arg5 == 0) + goto g8220; + /* Here if argument TypeFixnum */ + /* t7= -2 */ + t7 = zero - 2; + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* reuse t5 as mask */ + t5 = ~t7; + /* T3= masked new value. */ + t3 = arg4 & ~t7; + /* t5 is the inplace mask */ + t5 = t5 << (arg2 & 63); + /* t4 is the shifted field */ + t4 = t3 << (arg2 & 63); + /* Clear out existing bits in arg2 field */ + t6 = t6 & ~t5; + /* Put the new bits in */ + t6 = t4 | t6; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t4 = Type_Fixnum; + *(u32 *)iSP = t6; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t4; + goto cachevalid; + +g8224: + if (_trace) printf("g8224:\n"); + +g8223: + if (_trace) printf("g8223:\n"); + /* Here for all other cases */ + +g8219: + if (_trace) printf("g8219:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t5; + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto numericexception; + goto g8221; + +g8220: + if (_trace) printf("g8220:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto numericexception; + +g8221: + if (_trace) printf("g8221:\n"); + +g8222: + if (_trace) printf("g8222:\n"); + +/* end DoDpb */ + /* End of Halfword operand from stack instruction - DoDpb */ +/* start DoCharDpb */ + + /* Field Extraction instruction - DoCharDpb */ + +dochardpb: + if (_trace) printf("dochardpb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoCharDpbIM: + if (_trace) printf("DoCharDpbIM:\n"); + +DoCharDpbSP: + if (_trace) printf("DoCharDpbSP:\n"); + +DoCharDpbLP: + if (_trace) printf("DoCharDpbLP:\n"); + +DoCharDpbFP: + if (_trace) printf("DoCharDpbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + /* Get arg2 tag/data */ + t6 = *(s32 *)iSP; + /* Get arg2 tag/data */ + t5 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t6 = (u32)t6; + /* get arg1 tag/data */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + /* Strip off any CDR code bits. */ + t1 = t5 & 63; + /* Strip off any CDR code bits. */ + arg6 = arg3 & 63; + t2 = (t1 == Type_Character) ? 1 : 0; + +g8243: + if (_trace) printf("g8243:\n"); + if (t2 == 0) + goto g8236; + /* Here if argument TypeCharacter */ + arg5 = (arg6 == Type_Fixnum) ? 1 : 0; + +g8240: + if (_trace) printf("g8240:\n"); + if (arg5 == 0) + goto g8233; + /* Here if argument TypeFixnum */ + /* t7= -2 */ + t7 = zero - 2; + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* reuse t5 as mask */ + t5 = ~t7; + /* T3= masked new value. */ + t3 = arg4 & ~t7; + /* t5 is the inplace mask */ + t5 = t5 << (arg2 & 63); + /* t4 is the shifted field */ + t4 = t3 << (arg2 & 63); + /* Clear out existing bits in arg2 field */ + t6 = t6 & ~t5; + /* Put the new bits in */ + t6 = t4 | t6; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t4 = Type_Character; + *(u32 *)iSP = t6; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t4; + goto cachevalid; + +g8237: + if (_trace) printf("g8237:\n"); + +g8236: + if (_trace) printf("g8236:\n"); + /* Here for all other cases */ + +g8232: + if (_trace) printf("g8232:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t5; + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + arg5 = 0; + arg2 = 27; + goto spareexception; + goto g8234; + +g8233: + if (_trace) printf("g8233:\n"); + arg5 = 0; + arg2 = 27; + goto illegaloperand; + +g8234: + if (_trace) printf("g8234:\n"); + +g8235: + if (_trace) printf("g8235:\n"); + +/* end DoCharDpb */ + /* End of Halfword operand from stack instruction - DoCharDpb */ +/* start DoPDpb */ + + /* Field Extraction instruction - DoPDpb */ + +dopdpb: + if (_trace) printf("dopdpb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPDpbIM: + if (_trace) printf("DoPDpbIM:\n"); + +DoPDpbSP: + if (_trace) printf("DoPDpbSP:\n"); + +DoPDpbLP: + if (_trace) printf("DoPDpbLP:\n"); + +DoPDpbFP: + if (_trace) printf("DoPDpbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + /* Get arg2 tag/data */ + t2 = *(s32 *)iSP; + /* Get arg2 tag/data */ + t1 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t2 = (u32)t2; + t3 = t1 - Type_PhysicalAddress; + t3 = t3 & 63; + if (t3 == 0) + goto pdpbillop; + /* get arg1 tag/data */ + arg4 = *(s32 *)iSP; + /* get arg1 tag/data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* Memory Read Internal */ + +g8244: + /* Base of stack cache */ + t3 = *(u64 *)&(processor->stackcachebasevma); + t1 = t2 + ivory; + t4 = *(s32 *)&processor->scovlimit; + t6 = (t1 * 4); + t8 = LDQ_U(t1); + /* Stack cache offset */ + t3 = t2 - t3; + /* In range? */ + t4 = ((u64)t3 < (u64)t4) ? 1 : 0; + t6 = *(s32 *)t6; + t8 = (u8)(t8 >> ((t1&7)*8)); + if (t4 != 0) + goto g8246; + +g8245: + t6 = (u32)t6; + +g8252: + t6 = (u32)t6; + /* Strip off any CDR code bits. */ + t1 = arg3 & 63; + t10 = (t1 == Type_Fixnum) ? 1 : 0; + +g8259: + if (_trace) printf("g8259:\n"); + if (t10 == 0) + goto g8254; + /* Here if argument TypeFixnum */ + /* t7= -2 */ + t7 = zero - 2; + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* reuse t5 as mask */ + t5 = ~t7; + /* T3= masked new value. */ + t3 = arg4 & ~t7; + /* t5 is the inplace mask */ + t5 = t5 << (arg2 & 63); + /* t4 is the shifted field */ + t4 = t3 << (arg2 & 63); + /* Clear out existing bits in arg2 field */ + t6 = t6 & ~t5; + /* Put the new bits in */ + t6 = t4 | t6; + t4 = *(u64 *)&(processor->stackcachebasevma); + t3 = t2 + ivory; + t10 = *(s32 *)&processor->scovlimit; + t5 = (t3 * 4); + t1 = LDQ_U(t3); + /* Stack cache offset */ + t4 = t2 - t4; + /* In range? */ + t10 = ((u64)t4 < (u64)t10) ? 1 : 0; + t4 = (t8 & 0xff) << ((t3&7)*8); + t1 = t1 & ~(0xffL << (t3&7)*8); + +g8256: + if (_trace) printf("g8256:\n"); + t1 = t1 | t4; + STQ_U(t3, t1); + *(u32 *)t5 = t6; + /* J. if in cache */ + if (t10 != 0) + goto g8255; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g8254: + if (_trace) printf("g8254:\n"); + /* Here for all other cases */ + arg5 = 0; + arg2 = 6; + goto illegaloperand; + +g8253: + if (_trace) printf("g8253:\n"); + +pdpbillop: + if (_trace) printf("pdpbillop:\n"); + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = iSP - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + arg5 = t2; + arg2 = 57; + goto illegaloperand; + +g8255: + if (_trace) printf("g8255:\n"); + t4 = *(u64 *)&(processor->stackcachebasevma); + +g8260: + if (_trace) printf("g8260:\n"); + t3 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t4 = t2 - t4; + /* reconstruct SCA */ + t3 = (t4 * 8) + t3; + /* Store in stack */ + *(u32 *)t3 = t6; + /* write the stack cache */ + *(u32 *)(t3 + 4) = t8; + goto NEXTINSTRUCTION; + +g8246: + if (_trace) printf("g8246:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + t6 = *(s32 *)t3; + /* Read from stack cache */ + t8 = *(s32 *)(t3 + 4); + goto g8245; + +/* end DoPDpb */ + /* End of Halfword operand from stack instruction - DoPDpb */ +/* start DoPTagDpb */ + + /* Field Extraction instruction - DoPTagDpb */ + +doptagdpb: + if (_trace) printf("doptagdpb:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPTagDpbIM: + if (_trace) printf("DoPTagDpbIM:\n"); + +DoPTagDpbSP: + if (_trace) printf("DoPTagDpbSP:\n"); + +DoPTagDpbLP: + if (_trace) printf("DoPTagDpbLP:\n"); + +DoPTagDpbFP: + if (_trace) printf("DoPTagDpbFP:\n"); + /* Shift the 'size-1' bits into place */ + arg1 = arg3 >> 37; + /* mask out the unwanted bits in arg2 */ + arg2 = arg2 & 31; + /* mask out the unwanted bits in arg1 */ + arg1 = arg1 & 31; + /* arg1 has size-1, arg2 has position. */ + /* Get arg2 tag/data */ + t2 = *(s32 *)iSP; + /* Get arg2 tag/data */ + t1 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t2 = (u32)t2; + t3 = t1 - Type_PhysicalAddress; + t3 = t3 & 63; + if (t3 == 0) + goto ptagdpbillop; + /* get arg1 tag/data */ + arg4 = *(s32 *)iSP; + /* get arg1 tag/data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + /* Memory Read Internal */ + +g8261: + /* Base of stack cache */ + t3 = *(u64 *)&(processor->stackcachebasevma); + t1 = t2 + ivory; + t4 = *(s32 *)&processor->scovlimit; + t8 = (t1 * 4); + t6 = LDQ_U(t1); + /* Stack cache offset */ + t3 = t2 - t3; + /* In range? */ + t4 = ((u64)t3 < (u64)t4) ? 1 : 0; + t8 = *(s32 *)t8; + t6 = (u8)(t6 >> ((t1&7)*8)); + if (t4 != 0) + goto g8263; + +g8262: + +g8269: + /* Strip off any CDR code bits. */ + t1 = arg3 & 63; + t10 = (t1 == Type_Fixnum) ? 1 : 0; + +g8276: + if (_trace) printf("g8276:\n"); + if (t10 == 0) + goto g8271; + /* Here if argument TypeFixnum */ + /* t7= -2 */ + t7 = zero - 2; + /* Unmask */ + t7 = t7 << (arg1 & 63); + /* reuse t5 as mask */ + t5 = ~t7; + /* T3= masked new value. */ + t3 = arg4 & ~t7; + /* t5 is the inplace mask */ + t5 = t5 << (arg2 & 63); + /* t4 is the shifted field */ + t4 = t3 << (arg2 & 63); + /* Clear out existing bits in arg2 field */ + t6 = t6 & ~t5; + /* Put the new bits in */ + t6 = t4 | t6; + t4 = *(u64 *)&(processor->stackcachebasevma); + t3 = t2 + ivory; + t10 = *(s32 *)&processor->scovlimit; + t5 = (t3 * 4); + t1 = LDQ_U(t3); + /* Stack cache offset */ + t4 = t2 - t4; + /* In range? */ + t10 = ((u64)t4 < (u64)t10) ? 1 : 0; + t4 = (t6 & 0xff) << ((t3&7)*8); + t1 = t1 & ~(0xffL << (t3&7)*8); + +g8273: + if (_trace) printf("g8273:\n"); + t1 = t1 | t4; + STQ_U(t3, t1); + *(u32 *)t5 = t8; + /* J. if in cache */ + if (t10 != 0) + goto g8272; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g8271: + if (_trace) printf("g8271:\n"); + /* Here for all other cases */ + arg5 = 0; + arg2 = 6; + goto illegaloperand; + +g8270: + if (_trace) printf("g8270:\n"); + +ptagdpbillop: + if (_trace) printf("ptagdpbillop:\n"); + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = iSP - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + arg5 = t2; + arg2 = 57; + goto illegaloperand; + +g8272: + if (_trace) printf("g8272:\n"); + t4 = *(u64 *)&(processor->stackcachebasevma); + +g8277: + if (_trace) printf("g8277:\n"); + t3 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t4 = t2 - t4; + /* reconstruct SCA */ + t3 = (t4 * 8) + t3; + /* Store in stack */ + *(u32 *)t3 = t8; + /* write the stack cache */ + *(u32 *)(t3 + 4) = t6; + goto NEXTINSTRUCTION; + +g8263: + if (_trace) printf("g8263:\n"); + t4 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t3 = (t3 * 8) + t4; + t8 = *(s32 *)t3; + /* Read from stack cache */ + t6 = *(s32 *)(t3 + 4); + goto g8262; + +/* end DoPTagDpb */ + /* End of Halfword operand from stack instruction - DoPTagDpb */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunfext.as */ diff --git a/stub/ifunfull.c b/stub/ifunfull.c new file mode 100644 index 0000000..309fb2d --- /dev/null +++ b/stub/ifunfull.c @@ -0,0 +1,252 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunfull.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* The full word instructions */ +/* start DoIStageError */ + + /* Fullword instruction - DoIStageError */ +#ifdef TRACING +#endif + +doistageerror: + if (_trace) printf("doistageerror:\n"); + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +/* end DoIStageError */ + /* End of Fullword instruction - DoIStageError */ +/* start nullfw */ + + /* Fullword instruction - nullfw */ +#ifdef TRACING +#endif + +nullfw: + if (_trace) printf("nullfw:\n"); + arg5 = 0; + arg2 = 47; + goto illegaloperand; + +/* end nullfw */ + /* End of Fullword instruction - nullfw */ +/* start monitorforwardfw */ + + /* Fullword instruction - monitorforwardfw */ +#ifdef TRACING +#endif + +monitorforwardfw: + if (_trace) printf("monitorforwardfw:\n"); + arg5 = 0; + arg2 = 46; + goto illegaloperand; + +/* end monitorforwardfw */ + /* End of Fullword instruction - monitorforwardfw */ +/* start headerpfw */ + + /* Fullword instruction - headerpfw */ +#ifdef TRACING +#endif + +headerpfw: + if (_trace) printf("headerpfw:\n"); + arg5 = 0; + arg2 = 44; + goto illegaloperand; + +/* end headerpfw */ + /* End of Fullword instruction - headerpfw */ +/* start headerifw */ + + /* Fullword instruction - headerifw */ +#ifdef TRACING +#endif + +headerifw: + if (_trace) printf("headerifw:\n"); + arg5 = 0; + arg2 = 43; + goto illegaloperand; + +/* end headerifw */ + /* End of Fullword instruction - headerifw */ +/* start oneqforwardfw */ + + /* Fullword instruction - oneqforwardfw */ +#ifdef TRACING +#endif + +oneqforwardfw: + if (_trace) printf("oneqforwardfw:\n"); + arg5 = 0; + arg2 = 48; + goto illegaloperand; + +/* end oneqforwardfw */ + /* End of Fullword instruction - oneqforwardfw */ +/* start headerforwardfw */ + + /* Fullword instruction - headerforwardfw */ +#ifdef TRACING +#endif + +headerforwardfw: + if (_trace) printf("headerforwardfw:\n"); + arg5 = 0; + arg2 = 42; + goto illegaloperand; + +/* end headerforwardfw */ + /* End of Fullword instruction - headerforwardfw */ +/* start elementforwardfw */ + + /* Fullword instruction - elementforwardfw */ +#ifdef TRACING +#endif + +elementforwardfw: + if (_trace) printf("elementforwardfw:\n"); + arg5 = 0; + arg2 = 40; + goto illegaloperand; + +/* end elementforwardfw */ + /* End of Fullword instruction - elementforwardfw */ +/* start gcforwardfw */ + + /* Fullword instruction - gcforwardfw */ +#ifdef TRACING +#endif + +gcforwardfw: + if (_trace) printf("gcforwardfw:\n"); + arg5 = 0; + arg2 = 41; + goto illegaloperand; + +/* end gcforwardfw */ + /* End of Fullword instruction - gcforwardfw */ +/* start boundlocationfw */ + + /* Fullword instruction - boundlocationfw */ +#ifdef TRACING +#endif + +boundlocationfw: + if (_trace) printf("boundlocationfw:\n"); + arg5 = 0; + arg2 = 39; + goto illegaloperand; + +/* end boundlocationfw */ + /* End of Fullword instruction - boundlocationfw */ +/* start logicvariablefw */ + + /* Fullword instruction - logicvariablefw */ +#ifdef TRACING +#endif + +logicvariablefw: + if (_trace) printf("logicvariablefw:\n"); + arg5 = 0; + arg2 = 45; + goto illegaloperand; + +/* end logicvariablefw */ + /* End of Fullword instruction - logicvariablefw */ +/* start pushsparepointer3 */ + + /* Fullword instruction - pushsparepointer3 */ +#ifdef TRACING +#endif + +pushsparepointer3: + if (_trace) printf("pushsparepointer3:\n"); + /* Get operand */ + arg1 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +/* end pushsparepointer3 */ + /* End of Fullword instruction - pushsparepointer3 */ +/* start pushsparepointer4 */ + + /* Fullword instruction - pushsparepointer4 */ +#ifdef TRACING +#endif + +pushsparepointer4: + if (_trace) printf("pushsparepointer4:\n"); + /* Get operand */ + arg1 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + +/* end pushsparepointer4 */ + /* End of Fullword instruction - pushsparepointer4 */ +/* start callcompiledodd */ + + /* Fullword instruction - callcompiledodd */ +#ifdef TRACING +#endif + +callcompiledodd: + if (_trace) printf("callcompiledodd:\n"); + +callcompiledoddprefetch: + if (_trace) printf("callcompiledoddprefetch:\n"); + /* Get operand */ + arg6 = arg3; + arg5 = Type_OddPC; + /* No extra arg */ + arg3 = zero; + goto startcallcompiledmerge; + +/* end callcompiledodd */ + /* End of Fullword instruction - callcompiledodd */ +/* start nativeinstruction */ + + /* Fullword instruction - nativeinstruction */ +#ifdef TRACING +#endif + +nativeinstruction: + if (_trace) printf("nativeinstruction:\n"); + /* arg1 is instruction address*2 here */ + arg1 = iPC & ~1L; + /* Select the DATA address */ + arg1 = arg1 + arg1; + /* Add in the memory base */ + arg1 = (ivory * 4) + arg1; + /* Jump into the Ivory code */ + r0 = (*( u64 (*)(u64, u64) )arg1)(arg1, arg2); /* jsr */ + +/* end nativeinstruction */ + /* End of Fullword instruction - nativeinstruction */ +/* start resumeemulated */ + + +resumeemulated: + if (_trace) printf("resumeemulated:\n"); + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); + iPC = (ivory * 4) - arg1; + iPC = zero - iPC; + iPC = iPC >> 1; + if (arg2 != 0) + goto interpretinstructionpredicted; + goto interpretinstructionforbranch; + +/* end resumeemulated */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunfull.as */ diff --git a/stub/ifungene.c b/stub/ifungene.c new file mode 100644 index 0000000..9aa7e3b --- /dev/null +++ b/stub/ifungene.c @@ -0,0 +1,122 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifungene.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Generic dispatching an method lookup */ +/* start DoMessageDispatch */ + + /* Halfword operand from stack instruction - DoMessageDispatch */ + /* arg2 has the preloaded 8 bit operand. */ + +domessagedispatch: + if (_trace) printf("domessagedispatch:\n"); +#ifdef TRACING +#endif + +DoMessageDispatchSP: + if (_trace) printf("DoMessageDispatchSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindomessagedispatch; +#endif + +DoMessageDispatchLP: + if (_trace) printf("DoMessageDispatchLP:\n"); +#ifdef TRACING + goto begindomessagedispatch; +#endif + +DoMessageDispatchFP: + if (_trace) printf("DoMessageDispatchFP:\n"); + +begindomessagedispatch: + if (_trace) printf("begindomessagedispatch:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + arg2 = *(s32 *)&processor->control; + /* get message tag and data */ + arg1 = *(s32 *)(iFP + 28); + t1 = *(s32 *)(iFP + 24); + /* get number of arguments */ + arg5 = arg2 & 255; + /* get instance tag and data */ + arg3 = *(s32 *)(iFP + 20); + arg4 = *(s32 *)(iFP + 16); + /* done if 2 or more arguments (plus 2 extra words) */ + arg5 = arg5 - 4; + if ((s64)arg5 < 0) + goto verifygenericarity; + t1 = (u32)t1; + arg4 = (u32)arg4; + r0 = (u64)&&return0035; + goto lookuphandler; +return0035: + /* clobbered by |LookupHandler| */ + arg4 = *(u64 *)(iFP + 16); + t3 = t4 - Type_EvenPC; + /* Strip CDR code, low bits */ + t3 = t3 & 62; + if (t3 != 0) + goto g6970; + /* Strip CDR code */ + t3 = t6 & 63; + t3 = t3 - Type_NIL; + if (t3 == 0) + goto g6968; + *(u32 *)(iFP + 16) = t7; + /* write the stack cache */ + *(u32 *)(iFP + 20) = t6; + goto g6969; + +g6968: + if (_trace) printf("g6968:\n"); + /* swap message/instance in the frame */ + *(u32 *)(iFP + 16) = t1; + /* write the stack cache */ + *(u32 *)(iFP + 20) = arg1; + +g6969: + if (_trace) printf("g6969:\n"); + *(u64 *)(iFP + 24) = arg4; + /* Convert real continuation to PC. */ + iPC = t4 & 1; + iPC = t9 + iPC; + iPC = t9 + iPC; + goto interpretinstructionforjump; + +g6970: + if (_trace) printf("g6970:\n"); + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t3 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = iSP - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t3 = t2 + t3; + arg5 = t3; + arg2 = 37; + goto illegaloperand; +#ifdef TRACING +#endif + +DoMessageDispatchIM: + goto doistageerror; + +/* end DoMessageDispatch */ + /* End of Halfword operand from stack instruction - DoMessageDispatch */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifungene.as */ diff --git a/stub/ifunhead.c b/stub/ifunhead.c new file mode 100644 index 0000000..6499f6d --- /dev/null +++ b/stub/ifunhead.c @@ -0,0 +1,11 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunhead.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Entry points into the interpretation loop. */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunhead.as */ diff --git a/stub/ifuninst.c b/stub/ifuninst.c new file mode 100644 index 0000000..1047c94 --- /dev/null +++ b/stub/ifuninst.c @@ -0,0 +1,2995 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuninst.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Instance variable accessors.. */ +/* start DoPopInstanceVariable */ + + /* Halfword 10 bit immediate instruction - DoPopInstanceVariable */ + +dopopinstancevariable: + if (_trace) printf("dopopinstancevariable:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPopInstanceVariableIM: + if (_trace) printf("DoPopInstanceVariableIM:\n"); + +DoPopInstanceVariableSP: + if (_trace) printf("DoPopInstanceVariableSP:\n"); + +DoPopInstanceVariableLP: + if (_trace) printf("DoPopInstanceVariableLP:\n"); + +DoPopInstanceVariableFP: + if (_trace) printf("DoPopInstanceVariableFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Locate Instance Variable Mapped */ + /* Map */ + arg1 = *(s32 *)(iFP + 16); + t1 = *(s32 *)(iFP + 20); + arg1 = (u32)arg1; + t4 = t1 - Type_Array; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto ivbadmap; + /* Memory Read Internal */ + +g7230: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->header_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7232; + +g7231: + t9 = zero + 64; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + if (t10 & 1) + goto g7234; + +g7239: + t2 = t2 & Array_LengthMask; + t5 = t2 - arg2; + /* J. if mapping-table-index-out-of-bounds */ + if ((s64)t5 <= 0) + goto ivbadindex; + arg1 = arg1 + arg2; + arg1 = arg1 + 1; + /* Memory Read Internal */ + +g7240: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7242; + +g7241: + t9 = zero + 240; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + t2 = (u32)t2; + if (t10 & 1) + goto g7244; + +g7251: + t3 = t2; + t6 = t1 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto popiviex; + /* Self */ + arg1 = *(s32 *)(iFP + 24); + t6 = *(s32 *)(iFP + 28); + arg1 = (u32)arg1; + t5 = t6 - Type_Instance; + /* Strip CDR code, low bits */ + t5 = t5 & 60; + if (t5 != 0) + goto ivbadinst; + /* Unshifted cdr code */ + t5 = t6 & 192; + /* Check for CDR code 1 */ + t5 = t5 - 64; + /* J. if CDR code is not 1 */ + if (t5 != 0) + goto g7229; + +g7228: + if (_trace) printf("g7228:\n"); + arg1 = arg1 + t3; + +g7227: + if (_trace) printf("g7227:\n"); + t1 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g7252: + t8 = arg1 + ivory; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = arg1 - arg5; + t9 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)arg6) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g7254; + +g7253: + t8 = zero + 240; + t9 = t9 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t9 & 1) + goto g7256; + +g7262: + /* Merge cdr-code */ + t5 = t2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t6 = arg1 + ivory; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* In range? */ + t9 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g7264: + if (_trace) printf("g7264:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = t1; + /* J. if in cache */ + if (t9 != 0) + goto g7263; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +popiviex: + if (_trace) printf("popiviex:\n"); + t1 = zero + 8; + /* SetTag. */ + t1 = t1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = t2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +g7263: + if (_trace) printf("g7263:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = t1; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto NEXTINSTRUCTION; + +g7254: + if (_trace) printf("g7254:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g7253; + +g7256: + if (_trace) printf("g7256:\n"); + if ((t8 & 1) == 0) + goto g7255; + /* Do the indirect thing */ + arg1 = (u32)t5; + goto g7252; + +g7255: + if (_trace) printf("g7255:\n"); + /* Load the memory action table for cycle */ + t9 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t9; + /* Get the memory action */ + t9 = *(s32 *)t8; +#ifndef MINIMA + +g7259: +#endif +#ifdef MINIMA + +g7259: + if (_trace) printf("g7259:\n"); + t8 = t9 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g7258; + t6 = arg1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t6 = t6 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t6 = (s32)t6 + (s32)t8; + /* Clear sign-extension */ + t6 = (u32)t6; + t7 = (t6 * 4) + t7; + /* Fetch the key */ + t6 = *(s32 *)t7; + /* Fetch value */ + t5 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)arg1 - (s32)t6; + /* Trap on miss */ + if (t8 != 0) + goto g7261; + /* Extract the pointer, and indirect */ + arg1 = (u32)t5; + goto g7252; + +g7261: + if (_trace) printf("g7261:\n"); + goto dbcachemisstrap; +#endif + +g7258: + /* Perform memory action */ + arg1 = t9; + arg2 = 1; + goto performmemoryaction; + +g7242: + if (_trace) printf("g7242:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7241; + +g7244: + if (_trace) printf("g7244:\n"); + if ((t9 & 1) == 0) + goto g7243; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7240; + +g7243: + if (_trace) printf("g7243:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7248: + if (_trace) printf("g7248:\n"); + t9 = t10 & MemoryActionTransform; + if (t9 == 0) + goto g7247; + t1 = t1 & ~63L; + t1 = t1 | Type_ExternalValueCellPointer; + goto g7251; +#ifndef MINIMA + +g7247: +#endif +#ifdef MINIMA + +g7247: + if (_trace) printf("g7247:\n"); + t9 = t10 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t9 == 0) + goto g7246; + t7 = arg1 << 1; + t9 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t9; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + t2 = *(s32 *)(t8 + 4); + /* Compare */ + t9 = (s32)arg1 - (s32)t7; + /* Trap on miss */ + if (t9 != 0) + goto g7250; + /* Extract the pointer, and indirect */ + arg1 = (u32)t2; + goto g7240; + +g7250: + if (_trace) printf("g7250:\n"); + goto dbcachemisstrap; +#endif + +g7246: + /* Perform memory action */ + arg1 = t10; + arg2 = 0; + goto performmemoryaction; + +g7232: + if (_trace) printf("g7232:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7231; + +g7234: + if (_trace) printf("g7234:\n"); + if ((t9 & 1) == 0) + goto g7233; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7230; + +g7233: + if (_trace) printf("g7233:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7236: + /* Perform memory action */ + arg1 = t10; + arg2 = 6; + goto performmemoryaction; + +g7229: + if (_trace) printf("g7229:\n"); + t5 = arg1; + /* Memory Read Internal */ + +g7265: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->header_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7267; + +g7266: + t9 = zero + 64; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + t2 = (u32)t2; + if (t10 & 1) + goto g7269; + +g7274: + t5 = t5 - arg1; + if (t5 != 0) + goto g7228; + /* TagType. */ + t6 = t6 & 63; + /* Set CDR code to 1 */ + t6 = t6 | 64; + /* Update self */ + *(u32 *)(iFP + 24) = arg1; + /* write the stack cache */ + *(u32 *)(iFP + 28) = t6; + goto g7228; + +g7267: + if (_trace) printf("g7267:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7266; + +g7269: + if (_trace) printf("g7269:\n"); + if ((t9 & 1) == 0) + goto g7268; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7265; + +g7268: + if (_trace) printf("g7268:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7271: + /* Perform memory action */ + arg1 = t10; + arg2 = 6; + goto performmemoryaction; + +/* end DoPopInstanceVariable */ + /* End of Halfword operand from stack instruction - DoPopInstanceVariable */ +/* start DoMovemInstanceVariable */ + + /* Halfword 10 bit immediate instruction - DoMovemInstanceVariable */ + +domoveminstancevariable: + if (_trace) printf("domoveminstancevariable:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoMovemInstanceVariableIM: + if (_trace) printf("DoMovemInstanceVariableIM:\n"); + +DoMovemInstanceVariableSP: + if (_trace) printf("DoMovemInstanceVariableSP:\n"); + +DoMovemInstanceVariableLP: + if (_trace) printf("DoMovemInstanceVariableLP:\n"); + +DoMovemInstanceVariableFP: + if (_trace) printf("DoMovemInstanceVariableFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Locate Instance Variable Mapped */ + /* Map */ + arg1 = *(s32 *)(iFP + 16); + t1 = *(s32 *)(iFP + 20); + arg1 = (u32)arg1; + t4 = t1 - Type_Array; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto ivbadmap; + /* Memory Read Internal */ + +g7278: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->header_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7280; + +g7279: + t9 = zero + 64; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + if (t10 & 1) + goto g7282; + +g7287: + t2 = t2 & Array_LengthMask; + t5 = t2 - arg2; + /* J. if mapping-table-index-out-of-bounds */ + if ((s64)t5 <= 0) + goto ivbadindex; + arg1 = arg1 + arg2; + arg1 = arg1 + 1; + /* Memory Read Internal */ + +g7288: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7290; + +g7289: + t9 = zero + 240; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + t2 = (u32)t2; + if (t10 & 1) + goto g7292; + +g7299: + t3 = t2; + t6 = t1 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto movemiviex; + /* Self */ + arg1 = *(s32 *)(iFP + 24); + t6 = *(s32 *)(iFP + 28); + arg1 = (u32)arg1; + t5 = t6 - Type_Instance; + /* Strip CDR code, low bits */ + t5 = t5 & 60; + if (t5 != 0) + goto ivbadinst; + /* Unshifted cdr code */ + t5 = t6 & 192; + /* Check for CDR code 1 */ + t5 = t5 - 64; + /* J. if CDR code is not 1 */ + if (t5 != 0) + goto g7277; + +g7276: + if (_trace) printf("g7276:\n"); + arg1 = arg1 + t3; + +g7275: + if (_trace) printf("g7275:\n"); + t1 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + t1 = (u32)t1; + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g7300: + t8 = arg1 + ivory; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = arg1 - arg5; + t9 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)arg6) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g7302; + +g7301: + t8 = zero + 240; + t9 = t9 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t9 & 1) + goto g7304; + +g7310: + /* Merge cdr-code */ + t5 = t2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t6 = arg1 + ivory; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* In range? */ + t9 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g7312: + if (_trace) printf("g7312:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = t1; + /* J. if in cache */ + if (t9 != 0) + goto g7311; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +movemiviex: + if (_trace) printf("movemiviex:\n"); + t1 = zero + 8; + /* SetTag. */ + t1 = t1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = t2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +g7311: + if (_trace) printf("g7311:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = t1; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto NEXTINSTRUCTION; + +g7302: + if (_trace) printf("g7302:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g7301; + +g7304: + if (_trace) printf("g7304:\n"); + if ((t8 & 1) == 0) + goto g7303; + /* Do the indirect thing */ + arg1 = (u32)t5; + goto g7300; + +g7303: + if (_trace) printf("g7303:\n"); + /* Load the memory action table for cycle */ + t9 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t9; + /* Get the memory action */ + t9 = *(s32 *)t8; +#ifndef MINIMA + +g7307: +#endif +#ifdef MINIMA + +g7307: + if (_trace) printf("g7307:\n"); + t8 = t9 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g7306; + t6 = arg1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t6 = t6 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t6 = (s32)t6 + (s32)t8; + /* Clear sign-extension */ + t6 = (u32)t6; + t7 = (t6 * 4) + t7; + /* Fetch the key */ + t6 = *(s32 *)t7; + /* Fetch value */ + t5 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)arg1 - (s32)t6; + /* Trap on miss */ + if (t8 != 0) + goto g7309; + /* Extract the pointer, and indirect */ + arg1 = (u32)t5; + goto g7300; + +g7309: + if (_trace) printf("g7309:\n"); + goto dbcachemisstrap; +#endif + +g7306: + /* Perform memory action */ + arg1 = t9; + arg2 = 1; + goto performmemoryaction; + +g7290: + if (_trace) printf("g7290:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7289; + +g7292: + if (_trace) printf("g7292:\n"); + if ((t9 & 1) == 0) + goto g7291; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7288; + +g7291: + if (_trace) printf("g7291:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7296: + if (_trace) printf("g7296:\n"); + t9 = t10 & MemoryActionTransform; + if (t9 == 0) + goto g7295; + t1 = t1 & ~63L; + t1 = t1 | Type_ExternalValueCellPointer; + goto g7299; +#ifndef MINIMA + +g7295: +#endif +#ifdef MINIMA + +g7295: + if (_trace) printf("g7295:\n"); + t9 = t10 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t9 == 0) + goto g7294; + t7 = arg1 << 1; + t9 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t9; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + t2 = *(s32 *)(t8 + 4); + /* Compare */ + t9 = (s32)arg1 - (s32)t7; + /* Trap on miss */ + if (t9 != 0) + goto g7298; + /* Extract the pointer, and indirect */ + arg1 = (u32)t2; + goto g7288; + +g7298: + if (_trace) printf("g7298:\n"); + goto dbcachemisstrap; +#endif + +g7294: + /* Perform memory action */ + arg1 = t10; + arg2 = 0; + goto performmemoryaction; + +g7280: + if (_trace) printf("g7280:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7279; + +g7282: + if (_trace) printf("g7282:\n"); + if ((t9 & 1) == 0) + goto g7281; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7278; + +g7281: + if (_trace) printf("g7281:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7284: + /* Perform memory action */ + arg1 = t10; + arg2 = 6; + goto performmemoryaction; + +g7277: + if (_trace) printf("g7277:\n"); + t5 = arg1; + /* Memory Read Internal */ + +g7313: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->header_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7315; + +g7314: + t9 = zero + 64; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + t2 = (u32)t2; + if (t10 & 1) + goto g7317; + +g7322: + t5 = t5 - arg1; + if (t5 != 0) + goto g7276; + /* TagType. */ + t6 = t6 & 63; + /* Set CDR code to 1 */ + t6 = t6 | 64; + /* Update self */ + *(u32 *)(iFP + 24) = arg1; + /* write the stack cache */ + *(u32 *)(iFP + 28) = t6; + goto g7276; + +g7315: + if (_trace) printf("g7315:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7314; + +g7317: + if (_trace) printf("g7317:\n"); + if ((t9 & 1) == 0) + goto g7316; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7313; + +g7316: + if (_trace) printf("g7316:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7319: + /* Perform memory action */ + arg1 = t10; + arg2 = 6; + goto performmemoryaction; + +/* end DoMovemInstanceVariable */ + /* End of Halfword operand from stack instruction - DoMovemInstanceVariable */ +/* start DoPushAddressInstanceVariable */ + + /* Halfword 10 bit immediate instruction - DoPushAddressInstanceVariable */ + +dopushaddressinstancevariable: + if (_trace) printf("dopushaddressinstancevariable:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPushAddressInstanceVariableIM: + if (_trace) printf("DoPushAddressInstanceVariableIM:\n"); + +DoPushAddressInstanceVariableSP: + if (_trace) printf("DoPushAddressInstanceVariableSP:\n"); + +DoPushAddressInstanceVariableLP: + if (_trace) printf("DoPushAddressInstanceVariableLP:\n"); + +DoPushAddressInstanceVariableFP: + if (_trace) printf("DoPushAddressInstanceVariableFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Locate Instance Variable Mapped */ + /* Map */ + arg1 = *(s32 *)(iFP + 16); + t1 = *(s32 *)(iFP + 20); + arg1 = (u32)arg1; + t4 = t1 - Type_Array; + /* Strip CDR code */ + t4 = t4 & 63; + if (t4 != 0) + goto ivbadmap; + /* Memory Read Internal */ + +g7326: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->header_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7328; + +g7327: + t9 = zero + 64; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + if (t10 & 1) + goto g7330; + +g7335: + t2 = t2 & Array_LengthMask; + t5 = t2 - arg2; + /* J. if mapping-table-index-out-of-bounds */ + if ((s64)t5 <= 0) + goto ivbadindex; + arg1 = arg1 + arg2; + arg1 = arg1 + 1; + /* Memory Read Internal */ + +g7336: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7338; + +g7337: + t9 = zero + 240; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + t2 = (u32)t2; + if (t10 & 1) + goto g7340; + +g7347: + t3 = t2; + t6 = t1 - Type_Fixnum; + /* Strip CDR code */ + t6 = t6 & 63; + if (t6 != 0) + goto pushadiviex; + /* Self */ + arg1 = *(s32 *)(iFP + 24); + t6 = *(s32 *)(iFP + 28); + arg1 = (u32)arg1; + t5 = t6 - Type_Instance; + /* Strip CDR code, low bits */ + t5 = t5 & 60; + if (t5 != 0) + goto ivbadinst; + /* Unshifted cdr code */ + t5 = t6 & 192; + /* Check for CDR code 1 */ + t5 = t5 - 64; + /* J. if CDR code is not 1 */ + if (t5 != 0) + goto g7325; + +g7324: + if (_trace) printf("g7324:\n"); + arg1 = arg1 + t3; + +g7323: + if (_trace) printf("g7323:\n"); + t7 = Type_Locative; + *(u32 *)(iSP + 8) = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t7; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +pushadiviex: + if (_trace) printf("pushadiviex:\n"); + t1 = zero + 8; + /* SetTag. */ + t1 = t1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = t2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +g7338: + if (_trace) printf("g7338:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7337; + +g7340: + if (_trace) printf("g7340:\n"); + if ((t9 & 1) == 0) + goto g7339; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7336; + +g7339: + if (_trace) printf("g7339:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7344: + if (_trace) printf("g7344:\n"); + t9 = t10 & MemoryActionTransform; + if (t9 == 0) + goto g7343; + t1 = t1 & ~63L; + t1 = t1 | Type_ExternalValueCellPointer; + goto g7347; +#ifndef MINIMA + +g7343: +#endif +#ifdef MINIMA + +g7343: + if (_trace) printf("g7343:\n"); + t9 = t10 & MemoryActionBinding; + t8 = *(u64 *)&(processor->dbcmask); + if (t9 == 0) + goto g7342; + t7 = arg1 << 1; + t9 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t7 = t7 & t8; + t8 = 1; + t8 = t8 << (ivorymemorydata & 63); + t7 = (s32)t7 + (s32)t9; + /* Clear sign-extension */ + t7 = (u32)t7; + t8 = (t7 * 4) + t8; + /* Fetch the key */ + t7 = *(s32 *)t8; + /* Fetch value */ + t2 = *(s32 *)(t8 + 4); + /* Compare */ + t9 = (s32)arg1 - (s32)t7; + /* Trap on miss */ + if (t9 != 0) + goto g7346; + /* Extract the pointer, and indirect */ + arg1 = (u32)t2; + goto g7336; + +g7346: + if (_trace) printf("g7346:\n"); + goto dbcachemisstrap; +#endif + +g7342: + /* Perform memory action */ + arg1 = t10; + arg2 = 0; + goto performmemoryaction; + +g7328: + if (_trace) printf("g7328:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7327; + +g7330: + if (_trace) printf("g7330:\n"); + if ((t9 & 1) == 0) + goto g7329; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7326; + +g7329: + if (_trace) printf("g7329:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7332: + /* Perform memory action */ + arg1 = t10; + arg2 = 6; + goto performmemoryaction; + +g7325: + if (_trace) printf("g7325:\n"); + t5 = arg1; + /* Memory Read Internal */ + +g7348: + t9 = arg1 + ivory; + t2 = (t9 * 4); + t1 = LDQ_U(t9); + /* Stack cache offset */ + t7 = arg1 - arg5; + t10 = *(u64 *)&(processor->header_mask); + /* In range? */ + t8 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t2 = *(s32 *)t2; + t1 = (u8)(t1 >> ((t9&7)*8)); + if (t8 != 0) + goto g7350; + +g7349: + t9 = zero + 64; + t10 = t10 >> (t1 & 63); + t9 = t9 >> (t1 & 63); + t2 = (u32)t2; + if (t10 & 1) + goto g7352; + +g7357: + t5 = t5 - arg1; + if (t5 != 0) + goto g7324; + /* TagType. */ + t6 = t6 & 63; + /* Set CDR code to 1 */ + t6 = t6 | 64; + /* Update self */ + *(u32 *)(iFP + 24) = arg1; + /* write the stack cache */ + *(u32 *)(iFP + 28) = t6; + goto g7324; + +g7350: + if (_trace) printf("g7350:\n"); + t8 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t7 = (t7 * 8) + t8; + t2 = *(s32 *)t7; + /* Read from stack cache */ + t1 = *(s32 *)(t7 + 4); + goto g7349; + +g7352: + if (_trace) printf("g7352:\n"); + if ((t9 & 1) == 0) + goto g7351; + /* Do the indirect thing */ + arg1 = (u32)t2; + goto g7348; + +g7351: + if (_trace) printf("g7351:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t9 = t1 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t9 = (t9 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t9; + +g7354: + /* Perform memory action */ + arg1 = t10; + arg2 = 6; + goto performmemoryaction; + +/* end DoPushAddressInstanceVariable */ + /* End of Halfword operand from stack instruction - DoPushAddressInstanceVariable */ +/* start DoPushInstanceVariableOrdered */ + + /* Halfword 10 bit immediate instruction - DoPushInstanceVariableOrdered */ + +dopushinstancevariableordered: + if (_trace) printf("dopushinstancevariableordered:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPushInstanceVariableOrderedIM: + if (_trace) printf("DoPushInstanceVariableOrderedIM:\n"); + +DoPushInstanceVariableOrderedSP: + if (_trace) printf("DoPushInstanceVariableOrderedSP:\n"); + +DoPushInstanceVariableOrderedLP: + if (_trace) printf("DoPushInstanceVariableOrderedLP:\n"); + +DoPushInstanceVariableOrderedFP: + if (_trace) printf("DoPushInstanceVariableOrderedFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Locate Instance Variable Unmapped */ + /* self */ + t2 = *(s32 *)(iFP + 24); + t1 = *(s32 *)(iFP + 28); + t2 = (u32)t2; + t3 = t1 - Type_Instance; + /* Strip CDR code, low bits */ + t3 = t3 & 60; + if (t3 != 0) + goto ivbadinst; + arg1 = t2 + arg2; + /* Memory Read Internal */ + +g7358: + t6 = arg1 + ivory; + t1 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t4 = arg1 - arg5; + t7 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t5 = ((u64)t4 < (u64)arg6) ? 1 : 0; + t1 = *(s32 *)t1; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t5 != 0) + goto g7360; + +g7359: + t6 = zero + 240; + t7 = t7 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + if (t7 & 1) + goto g7362; + +g7369: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* set CDR-NEXT */ + t7 = t2 & 63; + *(u32 *)(iSP + 8) = t1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t7; + iSP = iSP + 8; + goto cachevalid; + +g7360: + if (_trace) printf("g7360:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t4 = (t4 * 8) + t5; + t1 = *(s32 *)t4; + /* Read from stack cache */ + t2 = *(s32 *)(t4 + 4); + goto g7359; + +g7362: + if (_trace) printf("g7362:\n"); + if ((t6 & 1) == 0) + goto g7361; + /* Do the indirect thing */ + arg1 = (u32)t1; + goto g7358; + +g7361: + if (_trace) printf("g7361:\n"); + /* Load the memory action table for cycle */ + t7 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t7; + /* Get the memory action */ + t7 = *(s32 *)t6; + +g7366: + if (_trace) printf("g7366:\n"); + t6 = t7 & MemoryActionTransform; + if (t6 == 0) + goto g7365; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g7369; +#ifndef MINIMA + +g7365: +#endif +#ifdef MINIMA + +g7365: + if (_trace) printf("g7365:\n"); + t6 = t7 & MemoryActionBinding; + t5 = *(u64 *)&(processor->dbcmask); + if (t6 == 0) + goto g7364; + t4 = arg1 << 1; + t6 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t4 = t4 & t5; + t5 = 1; + t5 = t5 << (ivorymemorydata & 63); + t4 = (s32)t4 + (s32)t6; + /* Clear sign-extension */ + t4 = (u32)t4; + t5 = (t4 * 4) + t5; + /* Fetch the key */ + t4 = *(s32 *)t5; + /* Fetch value */ + t1 = *(s32 *)(t5 + 4); + /* Compare */ + t6 = (s32)arg1 - (s32)t4; + /* Trap on miss */ + if (t6 != 0) + goto g7368; + /* Extract the pointer, and indirect */ + arg1 = (u32)t1; + goto g7358; + +g7368: + if (_trace) printf("g7368:\n"); + goto dbcachemisstrap; +#endif + +g7364: + /* Perform memory action */ + arg1 = t7; + arg2 = 0; + goto performmemoryaction; + +/* end DoPushInstanceVariableOrdered */ + /* End of Halfword operand from stack instruction - DoPushInstanceVariableOrdered */ +/* start DoPopInstanceVariableOrdered */ + + /* Halfword 10 bit immediate instruction - DoPopInstanceVariableOrdered */ + +dopopinstancevariableordered: + if (_trace) printf("dopopinstancevariableordered:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPopInstanceVariableOrderedIM: + if (_trace) printf("DoPopInstanceVariableOrderedIM:\n"); + +DoPopInstanceVariableOrderedSP: + if (_trace) printf("DoPopInstanceVariableOrderedSP:\n"); + +DoPopInstanceVariableOrderedLP: + if (_trace) printf("DoPopInstanceVariableOrderedLP:\n"); + +DoPopInstanceVariableOrderedFP: + if (_trace) printf("DoPopInstanceVariableOrderedFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Locate Instance Variable Unmapped */ + /* self */ + t2 = *(s32 *)(iFP + 24); + t1 = *(s32 *)(iFP + 28); + t2 = (u32)t2; + t3 = t1 - Type_Instance; + /* Strip CDR code, low bits */ + t3 = t3 & 60; + if (t3 != 0) + goto ivbadinst; + arg1 = t2 + arg2; + t1 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + /* Memory Read Internal */ + +g7370: + t8 = arg1 + ivory; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = arg1 - arg5; + t9 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)arg6) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g7372; + +g7371: + t8 = zero + 240; + t9 = t9 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t9 & 1) + goto g7374; + +g7380: + /* Merge cdr-code */ + t5 = t2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t6 = arg1 + ivory; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* In range? */ + t9 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g7382: + if (_trace) printf("g7382:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = t1; + /* J. if in cache */ + if (t9 != 0) + goto g7381; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g7381: + if (_trace) printf("g7381:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = t1; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto NEXTINSTRUCTION; + +g7372: + if (_trace) printf("g7372:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g7371; + +g7374: + if (_trace) printf("g7374:\n"); + if ((t8 & 1) == 0) + goto g7373; + /* Do the indirect thing */ + arg1 = (u32)t5; + goto g7370; + +g7373: + if (_trace) printf("g7373:\n"); + /* Load the memory action table for cycle */ + t9 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t9; + /* Get the memory action */ + t9 = *(s32 *)t8; +#ifndef MINIMA + +g7377: +#endif +#ifdef MINIMA + +g7377: + if (_trace) printf("g7377:\n"); + t8 = t9 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g7376; + t6 = arg1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t6 = t6 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t6 = (s32)t6 + (s32)t8; + /* Clear sign-extension */ + t6 = (u32)t6; + t7 = (t6 * 4) + t7; + /* Fetch the key */ + t6 = *(s32 *)t7; + /* Fetch value */ + t5 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)arg1 - (s32)t6; + /* Trap on miss */ + if (t8 != 0) + goto g7379; + /* Extract the pointer, and indirect */ + arg1 = (u32)t5; + goto g7370; + +g7379: + if (_trace) printf("g7379:\n"); + goto dbcachemisstrap; +#endif + +g7376: + /* Perform memory action */ + arg1 = t9; + arg2 = 1; + goto performmemoryaction; + +/* end DoPopInstanceVariableOrdered */ + /* End of Halfword operand from stack instruction - DoPopInstanceVariableOrdered */ +/* start DoMovemInstanceVariableOrdered */ + + /* Halfword 10 bit immediate instruction - DoMovemInstanceVariableOrdered */ + +domoveminstancevariableordered: + if (_trace) printf("domoveminstancevariableordered:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoMovemInstanceVariableOrderedIM: + if (_trace) printf("DoMovemInstanceVariableOrderedIM:\n"); + +DoMovemInstanceVariableOrderedSP: + if (_trace) printf("DoMovemInstanceVariableOrderedSP:\n"); + +DoMovemInstanceVariableOrderedLP: + if (_trace) printf("DoMovemInstanceVariableOrderedLP:\n"); + +DoMovemInstanceVariableOrderedFP: + if (_trace) printf("DoMovemInstanceVariableOrderedFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Locate Instance Variable Unmapped */ + /* self */ + t2 = *(s32 *)(iFP + 24); + t1 = *(s32 *)(iFP + 28); + t2 = (u32)t2; + t3 = t1 - Type_Instance; + /* Strip CDR code, low bits */ + t3 = t3 & 60; + if (t3 != 0) + goto ivbadinst; + arg1 = t2 + arg2; + t1 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + t1 = (u32)t1; + /* Memory Read Internal */ + +g7383: + t8 = arg1 + ivory; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = arg1 - arg5; + t9 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)arg6) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g7385; + +g7384: + t8 = zero + 240; + t9 = t9 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t9 & 1) + goto g7387; + +g7393: + /* Merge cdr-code */ + t5 = t2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t6 = arg1 + ivory; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* In range? */ + t9 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g7395: + if (_trace) printf("g7395:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = t1; + /* J. if in cache */ + if (t9 != 0) + goto g7394; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g7394: + if (_trace) printf("g7394:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = arg1 - arg5; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = t1; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto NEXTINSTRUCTION; + +g7385: + if (_trace) printf("g7385:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g7384; + +g7387: + if (_trace) printf("g7387:\n"); + if ((t8 & 1) == 0) + goto g7386; + /* Do the indirect thing */ + arg1 = (u32)t5; + goto g7383; + +g7386: + if (_trace) printf("g7386:\n"); + /* Load the memory action table for cycle */ + t9 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t9; + /* Get the memory action */ + t9 = *(s32 *)t8; +#ifndef MINIMA + +g7390: +#endif +#ifdef MINIMA + +g7390: + if (_trace) printf("g7390:\n"); + t8 = t9 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g7389; + t6 = arg1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t6 = t6 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t6 = (s32)t6 + (s32)t8; + /* Clear sign-extension */ + t6 = (u32)t6; + t7 = (t6 * 4) + t7; + /* Fetch the key */ + t6 = *(s32 *)t7; + /* Fetch value */ + t5 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)arg1 - (s32)t6; + /* Trap on miss */ + if (t8 != 0) + goto g7392; + /* Extract the pointer, and indirect */ + arg1 = (u32)t5; + goto g7383; + +g7392: + if (_trace) printf("g7392:\n"); + goto dbcachemisstrap; +#endif + +g7389: + /* Perform memory action */ + arg1 = t9; + arg2 = 1; + goto performmemoryaction; + +/* end DoMovemInstanceVariableOrdered */ + /* End of Halfword operand from stack instruction - DoMovemInstanceVariableOrdered */ +/* start DoPushAddressInstanceVariableOrdered */ + + /* Halfword 10 bit immediate instruction - DoPushAddressInstanceVariableOrdered */ + +dopushaddressinstancevariableordered: + if (_trace) printf("dopushaddressinstancevariableordered:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoPushAddressInstanceVariableOrderedIM: + if (_trace) printf("DoPushAddressInstanceVariableOrderedIM:\n"); + +DoPushAddressInstanceVariableOrderedSP: + if (_trace) printf("DoPushAddressInstanceVariableOrderedSP:\n"); + +DoPushAddressInstanceVariableOrderedLP: + if (_trace) printf("DoPushAddressInstanceVariableOrderedLP:\n"); + +DoPushAddressInstanceVariableOrderedFP: + if (_trace) printf("DoPushAddressInstanceVariableOrderedFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + /* Locate Instance Variable Unmapped */ + /* self */ + t2 = *(s32 *)(iFP + 24); + t1 = *(s32 *)(iFP + 28); + t2 = (u32)t2; + t3 = t1 - Type_Instance; + /* Strip CDR code, low bits */ + t3 = t3 & 60; + if (t3 != 0) + goto ivbadinst; + arg1 = t2 + arg2; + t7 = Type_Locative; + *(u32 *)(iSP + 8) = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t7; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +ivbadmap: + if (_trace) printf("ivbadmap:\n"); + arg5 = 0; + arg2 = 68; + goto illegaloperand; + +ivbadindex: + if (_trace) printf("ivbadindex:\n"); + arg5 = 0; + arg2 = 53; + goto illegaloperand; + +ivbadinst: + if (_trace) printf("ivbadinst:\n"); + arg5 = 0; + arg2 = 69; + goto illegaloperand; + +/* end DoPushAddressInstanceVariableOrdered */ + /* End of Halfword operand from stack instruction - DoPushAddressInstanceVariableOrdered */ +/* start DoInstanceRef */ + + /* Halfword operand from stack instruction - DoInstanceRef */ + /* arg2 has the preloaded 8 bit operand. */ + +doinstanceref: + if (_trace) printf("doinstanceref:\n"); +#ifdef TRACING +#endif + +DoInstanceRefIM: + if (_trace) printf("DoInstanceRefIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoinstanceref; +#ifdef TRACING +#endif + +DoInstanceRefSP: + if (_trace) printf("DoInstanceRefSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoinstanceref; +#endif + +DoInstanceRefLP: + if (_trace) printf("DoInstanceRefLP:\n"); +#ifdef TRACING + goto headdoinstanceref; +#endif + +DoInstanceRefFP: + if (_trace) printf("DoInstanceRefFP:\n"); + +headdoinstanceref: + if (_trace) printf("headdoinstanceref:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoinstanceref: + if (_trace) printf("begindoinstanceref:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Locate Arbitrary Instance Variable */ + t1 = arg3 - Type_Instance; + /* Strip CDR code, low bits */ + t1 = t1 & 60; + if (t1 != 0) + goto ivrefbadinst; + t1 = arg2 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto ivrefbadoffset; + /* Memory Read Internal */ + +g7396: + t7 = arg4 + ivory; + t1 = (t7 * 4); + t2 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg4 - t11; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + t1 = *(s32 *)t1; + t2 = (u8)(t2 >> ((t7&7)*8)); + if (t6 != 0) + goto g7398; + +g7397: + t7 = zero + 64; + t8 = t8 >> (t2 & 63); + t7 = t7 >> (t2 & 63); + t1 = (u32)t1; + if (t8 & 1) + goto g7400; + +g7405: + t1 = t1 - 1; + /* Memory Read Internal */ + +g7406: + t7 = t1 + ivory; + t2 = (t7 * 4); + t4 = LDQ_U(t7); + /* Stack cache offset */ + t5 = t1 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + t2 = *(s32 *)t2; + t4 = (u8)(t4 >> ((t7&7)*8)); + if (t6 != 0) + goto g7408; + +g7407: + t7 = zero + 240; + t8 = t8 >> (t4 & 63); + t7 = t7 >> (t4 & 63); + if (t8 & 1) + goto g7410; + +g7417: + t5 = t4 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto ivrefbadoffset; + /* J. if offset <0 */ + if ((s64)arg1 < 0) + goto ivrefbadoffset; + t4 = arg1 - t2; + /* J. if offset out of bounds */ + if ((s64)t4 >= 0) + goto ivrefbadoffset; + arg5 = arg1 + arg4; + /* Memory Read Internal */ + +g7418: + /* Base of stack cache */ + t4 = *(u64 *)&(processor->stackcachebasevma); + t6 = arg5 + ivory; + t5 = *(s32 *)&processor->scovlimit; + t1 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t4 = arg5 - t4; + t7 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t5 = ((u64)t4 < (u64)t5) ? 1 : 0; + t1 = *(s32 *)t1; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t5 != 0) + goto g7420; + +g7419: + t6 = zero + 240; + t7 = t7 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + if (t7 & 1) + goto g7422; + +g7429: + /* set CDR-NEXT */ + t2 = t2 & 63; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u32 *)iSP = t1; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t2; + goto cachevalid; + +g7420: + if (_trace) printf("g7420:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t4 = (t4 * 8) + t5; + t1 = *(s32 *)t4; + /* Read from stack cache */ + t2 = *(s32 *)(t4 + 4); + goto g7419; + +g7422: + if (_trace) printf("g7422:\n"); + if ((t6 & 1) == 0) + goto g7421; + /* Do the indirect thing */ + arg5 = (u32)t1; + goto g7418; + +g7421: + if (_trace) printf("g7421:\n"); + /* Load the memory action table for cycle */ + t7 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg5; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t7; + /* Get the memory action */ + t7 = *(s32 *)t6; + +g7426: + if (_trace) printf("g7426:\n"); + t6 = t7 & MemoryActionTransform; + if (t6 == 0) + goto g7425; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g7429; +#ifndef MINIMA + +g7425: +#endif +#ifdef MINIMA + +g7425: + if (_trace) printf("g7425:\n"); + t6 = t7 & MemoryActionBinding; + t5 = *(u64 *)&(processor->dbcmask); + if (t6 == 0) + goto g7424; + t4 = arg5 << 1; + t6 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t4 = t4 & t5; + t5 = 1; + t5 = t5 << (ivorymemorydata & 63); + t4 = (s32)t4 + (s32)t6; + /* Clear sign-extension */ + t4 = (u32)t4; + t5 = (t4 * 4) + t5; + /* Fetch the key */ + t4 = *(s32 *)t5; + /* Fetch value */ + t1 = *(s32 *)(t5 + 4); + /* Compare */ + t6 = (s32)arg5 - (s32)t4; + /* Trap on miss */ + if (t6 != 0) + goto g7428; + /* Extract the pointer, and indirect */ + arg5 = (u32)t1; + goto g7418; + +g7428: + if (_trace) printf("g7428:\n"); + goto dbcachemisstrap; +#endif + +g7424: + /* Perform memory action */ + arg1 = t7; + arg2 = 0; + goto performmemoryaction; + +g7408: + if (_trace) printf("g7408:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t2 = *(s32 *)t5; + /* Read from stack cache */ + t4 = *(s32 *)(t5 + 4); + goto g7407; + +g7410: + if (_trace) printf("g7410:\n"); + if ((t7 & 1) == 0) + goto g7409; + /* Do the indirect thing */ + t1 = (u32)t2; + goto g7406; + +g7409: + if (_trace) printf("g7409:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t7 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7414: + if (_trace) printf("g7414:\n"); + t7 = t8 & MemoryActionTransform; + if (t7 == 0) + goto g7413; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g7417; +#ifndef MINIMA + +g7413: +#endif +#ifdef MINIMA + +g7413: + if (_trace) printf("g7413:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g7412; + t5 = t1 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + t2 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)t1 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g7416; + /* Extract the pointer, and indirect */ + t1 = (u32)t2; + goto g7406; + +g7416: + if (_trace) printf("g7416:\n"); + goto dbcachemisstrap; +#endif + +g7412: + /* Perform memory action */ + arg1 = t8; + arg2 = 0; + goto performmemoryaction; + +g7398: + if (_trace) printf("g7398:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t1 = *(s32 *)t5; + /* Read from stack cache */ + t2 = *(s32 *)(t5 + 4); + goto g7397; + +g7400: + if (_trace) printf("g7400:\n"); + if ((t7 & 1) == 0) + goto g7399; + /* Do the indirect thing */ + arg4 = (u32)t1; + goto g7396; + +g7399: + if (_trace) printf("g7399:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t7 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7402: + /* Perform memory action */ + arg1 = t8; + arg2 = 6; + goto performmemoryaction; + +/* end DoInstanceRef */ + /* End of Halfword operand from stack instruction - DoInstanceRef */ +/* start DoInstanceSet */ + + /* Halfword operand from stack instruction - DoInstanceSet */ + /* arg2 has the preloaded 8 bit operand. */ + +doinstanceset: + if (_trace) printf("doinstanceset:\n"); +#ifdef TRACING +#endif + +DoInstanceSetIM: + if (_trace) printf("DoInstanceSetIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoinstanceset; +#ifdef TRACING +#endif + +DoInstanceSetSP: + if (_trace) printf("DoInstanceSetSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoinstanceset; +#endif + +DoInstanceSetLP: + if (_trace) printf("DoInstanceSetLP:\n"); +#ifdef TRACING + goto headdoinstanceset; +#endif + +DoInstanceSetFP: + if (_trace) printf("DoInstanceSetFP:\n"); + +headdoinstanceset: + if (_trace) printf("headdoinstanceset:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoinstanceset: + if (_trace) printf("begindoinstanceset:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Locate Arbitrary Instance Variable */ + t1 = arg3 - Type_Instance; + /* Strip CDR code, low bits */ + t1 = t1 & 60; + if (t1 != 0) + goto ivrefbadinst3; + t1 = arg2 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto ivrefbadoffset; + /* Memory Read Internal */ + +g7430: + t7 = arg4 + ivory; + t1 = (t7 * 4); + t2 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg4 - t11; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + t1 = *(s32 *)t1; + t2 = (u8)(t2 >> ((t7&7)*8)); + if (t6 != 0) + goto g7432; + +g7431: + t7 = zero + 64; + t8 = t8 >> (t2 & 63); + t7 = t7 >> (t2 & 63); + t1 = (u32)t1; + if (t8 & 1) + goto g7434; + +g7439: + t1 = t1 - 1; + /* Memory Read Internal */ + +g7440: + t7 = t1 + ivory; + t2 = (t7 * 4); + t4 = LDQ_U(t7); + /* Stack cache offset */ + t5 = t1 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + t2 = *(s32 *)t2; + t4 = (u8)(t4 >> ((t7&7)*8)); + if (t6 != 0) + goto g7442; + +g7441: + t7 = zero + 240; + t8 = t8 >> (t4 & 63); + t7 = t7 >> (t4 & 63); + if (t8 & 1) + goto g7444; + +g7451: + t5 = t4 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto ivrefbadoffset; + /* J. if offset <0 */ + if ((s64)arg1 < 0) + goto ivrefbadoffset; + t4 = arg1 - t2; + /* J. if offset out of bounds */ + if ((s64)t4 >= 0) + goto ivrefbadoffset; + arg5 = arg1 + arg4; + t1 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g7452: + t7 = arg5 + ivory; + t4 = (t7 * 4); + t3 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg5 - t11; + t8 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + t4 = *(s32 *)t4; + t3 = (u8)(t3 >> ((t7&7)*8)); + if (t6 != 0) + goto g7454; + +g7453: + t7 = zero + 240; + t8 = t8 >> (t3 & 63); + t7 = t7 >> (t3 & 63); + if (t8 & 1) + goto g7456; + +g7462: + /* Merge cdr-code */ + t4 = t2 & 63; + t3 = t3 & 192; + t3 = t3 | t4; + t5 = arg5 + ivory; + t4 = (t5 * 4); + t7 = LDQ_U(t5); + /* Stack cache offset */ + t6 = arg5 - t11; + /* In range? */ + t8 = ((u64)t6 < (u64)t12) ? 1 : 0; + t6 = (t3 & 0xff) << ((t5&7)*8); + t7 = t7 & ~(0xffL << (t5&7)*8); + +g7464: + if (_trace) printf("g7464:\n"); + t7 = t7 | t6; + STQ_U(t5, t7); + *(u32 *)t4 = t1; + /* J. if in cache */ + if (t8 != 0) + goto g7463; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +ivrefbadinst3: + if (_trace) printf("ivrefbadinst3:\n"); + arg5 = 0; + arg2 = 4; + goto illegaloperand; + +g7463: + if (_trace) printf("g7463:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t6 = arg5 - t11; + /* reconstruct SCA */ + t5 = (t6 * 8) + t5; + /* Store in stack */ + *(u32 *)t5 = t1; + /* write the stack cache */ + *(u32 *)(t5 + 4) = t3; + goto NEXTINSTRUCTION; + +g7454: + if (_trace) printf("g7454:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t4 = *(s32 *)t5; + /* Read from stack cache */ + t3 = *(s32 *)(t5 + 4); + goto g7453; + +g7456: + if (_trace) printf("g7456:\n"); + if ((t7 & 1) == 0) + goto g7455; + /* Do the indirect thing */ + arg5 = (u32)t4; + goto g7452; + +g7455: + if (_trace) printf("g7455:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t7 = t3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg5; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; +#ifndef MINIMA + +g7459: +#endif +#ifdef MINIMA + +g7459: + if (_trace) printf("g7459:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g7458; + t5 = arg5 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + t4 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)arg5 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g7461; + /* Extract the pointer, and indirect */ + arg5 = (u32)t4; + goto g7452; + +g7461: + if (_trace) printf("g7461:\n"); + goto dbcachemisstrap; +#endif + +g7458: + /* Perform memory action */ + arg1 = t8; + arg2 = 1; + goto performmemoryaction; + +g7442: + if (_trace) printf("g7442:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t2 = *(s32 *)t5; + /* Read from stack cache */ + t4 = *(s32 *)(t5 + 4); + goto g7441; + +g7444: + if (_trace) printf("g7444:\n"); + if ((t7 & 1) == 0) + goto g7443; + /* Do the indirect thing */ + t1 = (u32)t2; + goto g7440; + +g7443: + if (_trace) printf("g7443:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t7 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7448: + if (_trace) printf("g7448:\n"); + t7 = t8 & MemoryActionTransform; + if (t7 == 0) + goto g7447; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g7451; +#ifndef MINIMA + +g7447: +#endif +#ifdef MINIMA + +g7447: + if (_trace) printf("g7447:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g7446; + t5 = t1 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + t2 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)t1 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g7450; + /* Extract the pointer, and indirect */ + t1 = (u32)t2; + goto g7440; + +g7450: + if (_trace) printf("g7450:\n"); + goto dbcachemisstrap; +#endif + +g7446: + /* Perform memory action */ + arg1 = t8; + arg2 = 0; + goto performmemoryaction; + +g7432: + if (_trace) printf("g7432:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t1 = *(s32 *)t5; + /* Read from stack cache */ + t2 = *(s32 *)(t5 + 4); + goto g7431; + +g7434: + if (_trace) printf("g7434:\n"); + if ((t7 & 1) == 0) + goto g7433; + /* Do the indirect thing */ + arg4 = (u32)t1; + goto g7430; + +g7433: + if (_trace) printf("g7433:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t7 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7436: + /* Perform memory action */ + arg1 = t8; + arg2 = 6; + goto performmemoryaction; + +/* end DoInstanceSet */ + /* End of Halfword operand from stack instruction - DoInstanceSet */ +/* start DoInstanceLoc */ + + /* Halfword operand from stack instruction - DoInstanceLoc */ + /* arg2 has the preloaded 8 bit operand. */ + +doinstanceloc: + if (_trace) printf("doinstanceloc:\n"); +#ifdef TRACING +#endif + +DoInstanceLocIM: + if (_trace) printf("DoInstanceLocIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoinstanceloc; +#ifdef TRACING +#endif + +DoInstanceLocSP: + if (_trace) printf("DoInstanceLocSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoinstanceloc; +#endif + +DoInstanceLocLP: + if (_trace) printf("DoInstanceLocLP:\n"); +#ifdef TRACING + goto headdoinstanceloc; +#endif + +DoInstanceLocFP: + if (_trace) printf("DoInstanceLocFP:\n"); + +headdoinstanceloc: + if (_trace) printf("headdoinstanceloc:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoinstanceloc: + if (_trace) printf("begindoinstanceloc:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Locate Arbitrary Instance Variable */ + t1 = arg3 - Type_Instance; + /* Strip CDR code, low bits */ + t1 = t1 & 60; + if (t1 != 0) + goto ivrefbadinst; + t1 = arg2 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto ivrefbadoffset; + /* Memory Read Internal */ + +g7465: + t7 = arg4 + ivory; + t1 = (t7 * 4); + t2 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg4 - t11; + t8 = *(u64 *)&(processor->header_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + t1 = *(s32 *)t1; + t2 = (u8)(t2 >> ((t7&7)*8)); + if (t6 != 0) + goto g7467; + +g7466: + t7 = zero + 64; + t8 = t8 >> (t2 & 63); + t7 = t7 >> (t2 & 63); + t1 = (u32)t1; + if (t8 & 1) + goto g7469; + +g7474: + t1 = t1 - 1; + /* Memory Read Internal */ + +g7475: + t7 = t1 + ivory; + t2 = (t7 * 4); + t4 = LDQ_U(t7); + /* Stack cache offset */ + t5 = t1 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + t2 = *(s32 *)t2; + t4 = (u8)(t4 >> ((t7&7)*8)); + if (t6 != 0) + goto g7477; + +g7476: + t7 = zero + 240; + t8 = t8 >> (t4 & 63); + t7 = t7 >> (t4 & 63); + if (t8 & 1) + goto g7479; + +g7486: + t5 = t4 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto ivrefbadoffset; + /* J. if offset <0 */ + if ((s64)arg1 < 0) + goto ivrefbadoffset; + t4 = arg1 - t2; + /* J. if offset out of bounds */ + if ((s64)t4 >= 0) + goto ivrefbadoffset; + arg5 = arg1 + arg4; + t7 = Type_Locative; + *(u32 *)iSP = arg5; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t7; + goto NEXTINSTRUCTION; + +ivrefbadinst: + if (_trace) printf("ivrefbadinst:\n"); + arg5 = 0; + arg2 = 3; + goto illegaloperand; + +ivrefbadoffset: + if (_trace) printf("ivrefbadoffset:\n"); + arg5 = 0; + arg2 = 49; + goto illegaloperand; + +g7477: + if (_trace) printf("g7477:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t2 = *(s32 *)t5; + /* Read from stack cache */ + t4 = *(s32 *)(t5 + 4); + goto g7476; + +g7479: + if (_trace) printf("g7479:\n"); + if ((t7 & 1) == 0) + goto g7478; + /* Do the indirect thing */ + t1 = (u32)t2; + goto g7475; + +g7478: + if (_trace) printf("g7478:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t7 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7483: + if (_trace) printf("g7483:\n"); + t7 = t8 & MemoryActionTransform; + if (t7 == 0) + goto g7482; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g7486; +#ifndef MINIMA + +g7482: +#endif +#ifdef MINIMA + +g7482: + if (_trace) printf("g7482:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g7481; + t5 = t1 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + t2 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)t1 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g7485; + /* Extract the pointer, and indirect */ + t1 = (u32)t2; + goto g7475; + +g7485: + if (_trace) printf("g7485:\n"); + goto dbcachemisstrap; +#endif + +g7481: + /* Perform memory action */ + arg1 = t8; + arg2 = 0; + goto performmemoryaction; + +g7467: + if (_trace) printf("g7467:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t1 = *(s32 *)t5; + /* Read from stack cache */ + t2 = *(s32 *)(t5 + 4); + goto g7466; + +g7469: + if (_trace) printf("g7469:\n"); + if ((t7 & 1) == 0) + goto g7468; + /* Do the indirect thing */ + arg4 = (u32)t1; + goto g7465; + +g7468: + if (_trace) printf("g7468:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->header); + /* TagType. */ + /* Discard the CDR code */ + t7 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg4; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g7471: + /* Perform memory action */ + arg1 = t8; + arg2 = 6; + goto performmemoryaction; + +/* end DoInstanceLoc */ + /* End of Halfword operand from stack instruction - DoInstanceLoc */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifuninst.as */ diff --git a/stub/ifunjosh.c b/stub/ifunjosh.c new file mode 100644 index 0000000..83b420b --- /dev/null +++ b/stub/ifunjosh.c @@ -0,0 +1,766 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunjosh.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* 'AI' instructions. */ +/* start DoDereference */ + + /* Halfword operand from stack instruction - DoDereference */ + +dodereference: + if (_trace) printf("dodereference:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoDereferenceIM: + if (_trace) printf("DoDereferenceIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8930: + if (_trace) printf("g8930:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindodereference; +#ifdef TRACING +#endif + +DoDereferenceSP: + if (_trace) printf("DoDereferenceSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdodereference; +#endif + +DoDereferenceLP: + if (_trace) printf("DoDereferenceLP:\n"); +#ifdef TRACING + goto headdodereference; +#endif + +DoDereferenceFP: + if (_trace) printf("DoDereferenceFP:\n"); + +headdodereference: + if (_trace) printf("headdodereference:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindodereference: + if (_trace) printf("begindodereference:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + /* Strip off any CDR code bits. */ + t1 = arg2 & 63; + t2 = (t1 == Type_OneQForward) ? 1 : 0; + +g8925: + if (_trace) printf("g8925:\n"); + if (t2 != 0) + goto g8921; + t2 = (t1 == Type_ElementForward) ? 1 : 0; + +g8926: + if (_trace) printf("g8926:\n"); + if (t2 != 0) + goto g8921; + t2 = (t1 == Type_HeaderForward) ? 1 : 0; + +g8927: + if (_trace) printf("g8927:\n"); + if (t2 != 0) + goto g8921; + t2 = (t1 == Type_ExternalValueCellPointer) ? 1 : 0; + +g8928: + if (_trace) printf("g8928:\n"); + if (t2 == 0) + goto g8908; + +g8921: + if (_trace) printf("g8921:\n"); + /* Here if argument (TypeOneQForward TypeElementForward TypeHeaderForward TypeExternalValueCellPointer) */ + /* Memory Read Internal */ + +g8909: + /* Base of stack cache */ + t5 = *(u64 *)&(processor->stackcachebasevma); + t7 = arg1 + ivory; + t6 = *(s32 *)&processor->scovlimit; + t3 = (t7 * 4); + t4 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg1 - t5; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t6) ? 1 : 0; + t3 = *(s32 *)t3; + t4 = (u8)(t4 >> ((t7&7)*8)); + if (t6 != 0) + goto g8911; + +g8910: + t7 = zero + 240; + t8 = t8 >> (t4 & 63); + t7 = t7 >> (t4 & 63); + if (t8 & 1) + goto g8913; + +g8920: + /* set CDR-NEXT */ + t5 = t4 & 63; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g8908: + if (_trace) printf("g8908:\n"); + t2 = (t1 == Type_LogicVariable) ? 1 : 0; + +g8929: + if (_trace) printf("g8929:\n"); + if (t2 == 0) + goto g8922; + /* Here if argument TypeLogicVariable */ + t5 = Type_ExternalValueCellPointer; + *(u32 *)(iSP + 8) = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g8922: + if (_trace) printf("g8922:\n"); + /* Here for all other cases */ + /* set CDR-NEXT */ + t5 = arg2 & 63; + *(u32 *)(iSP + 8) = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g8907: + if (_trace) printf("g8907:\n"); + +g8911: + if (_trace) printf("g8911:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t5 = (t5 * 8) + t6; + t3 = *(s32 *)t5; + /* Read from stack cache */ + t4 = *(s32 *)(t5 + 4); + goto g8910; + +g8913: + if (_trace) printf("g8913:\n"); + if ((t7 & 1) == 0) + goto g8912; + /* Do the indirect thing */ + arg1 = (u32)t3; + goto g8909; + +g8912: + if (_trace) printf("g8912:\n"); + /* Load the memory action table for cycle */ + t8 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t7 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t7 = (t7 * 4) + t8; + /* Get the memory action */ + t8 = *(s32 *)t7; + +g8917: + if (_trace) printf("g8917:\n"); + t7 = t8 & MemoryActionTransform; + if (t7 == 0) + goto g8916; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g8920; +#ifndef MINIMA + +g8916: +#endif +#ifdef MINIMA + +g8916: + if (_trace) printf("g8916:\n"); + t7 = t8 & MemoryActionBinding; + t6 = *(u64 *)&(processor->dbcmask); + if (t7 == 0) + goto g8915; + t5 = arg1 << 1; + t7 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t5 = t5 & t6; + t6 = 1; + t6 = t6 << (ivorymemorydata & 63); + t5 = (s32)t5 + (s32)t7; + /* Clear sign-extension */ + t5 = (u32)t5; + t6 = (t5 * 4) + t6; + /* Fetch the key */ + t5 = *(s32 *)t6; + /* Fetch value */ + t3 = *(s32 *)(t6 + 4); + /* Compare */ + t7 = (s32)arg1 - (s32)t5; + /* Trap on miss */ + if (t7 != 0) + goto g8919; + /* Extract the pointer, and indirect */ + arg1 = (u32)t3; + goto g8909; + +g8919: + if (_trace) printf("g8919:\n"); + goto dbcachemisstrap; +#endif + +g8915: + /* Perform memory action */ + arg1 = t8; + arg2 = 0; + goto performmemoryaction; + +/* end DoDereference */ + /* End of Halfword operand from stack instruction - DoDereference */ +/* start DoUnify */ + + /* Halfword operand from stack instruction - DoUnify */ + +dounify: + if (_trace) printf("dounify:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoUnifyIM: + if (_trace) printf("DoUnifyIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8931: + if (_trace) printf("g8931:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindounify; +#ifdef TRACING +#endif + +DoUnifySP: + if (_trace) printf("DoUnifySP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdounify; +#endif + +DoUnifyLP: + if (_trace) printf("DoUnifyLP:\n"); +#ifdef TRACING + goto headdounify; +#endif + +DoUnifyFP: + if (_trace) printf("DoUnifyFP:\n"); + +headdounify: + if (_trace) printf("headdounify:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindounify: + if (_trace) printf("begindounify:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + goto NEXTINSTRUCTION; + +/* end DoUnify */ + /* End of Halfword operand from stack instruction - DoUnify */ +/* start DoPushLocalLogicVariables */ + + /* Halfword operand from stack instruction - DoPushLocalLogicVariables */ + /* arg2 has the preloaded 8 bit operand. */ + +dopushlocallogicvariables: + if (_trace) printf("dopushlocallogicvariables:\n"); +#ifdef TRACING +#endif + +DoPushLocalLogicVariablesIM: + if (_trace) printf("DoPushLocalLogicVariablesIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindopushlocallogicvariables; +#ifdef TRACING +#endif + +DoPushLocalLogicVariablesSP: + if (_trace) printf("DoPushLocalLogicVariablesSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdopushlocallogicvariables; +#endif + +DoPushLocalLogicVariablesLP: + if (_trace) printf("DoPushLocalLogicVariablesLP:\n"); +#ifdef TRACING + goto headdopushlocallogicvariables; +#endif + +DoPushLocalLogicVariablesFP: + if (_trace) printf("DoPushLocalLogicVariablesFP:\n"); + +headdopushlocallogicvariables: + if (_trace) printf("headdopushlocallogicvariables:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindopushlocallogicvariables: + if (_trace) printf("begindopushlocallogicvariables:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + arg6 = Type_LogicVariable; + t1 = arg1 >> 32; + arg2 = (u32)arg1; + t2 = t1 - Type_Fixnum; + /* Strip CDR code */ + t2 = t2 & 63; + if (t2 != 0) + goto pllvillop; + /* Current stack cache limit (words) */ + t4 = *(s32 *)&processor->scovlimit; + t1 = zero + 128; + /* Alpha base of stack cache */ + t2 = *(u64 *)&(processor->stackcachedata); + /* Account for what we're about to push */ + t1 = t1 + arg2; + /* SCA of desired end of cache */ + t1 = (t1 * 8) + iSP; + /* SCA of current end of cache */ + t2 = (t4 * 8) + t2; + t4 = ((s64)t1 <= (s64)t2) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t4 == 0) + goto stackcacheoverflowhandler; + goto pllvloopend; + +pllvlooptop: + if (_trace) printf("pllvlooptop:\n"); + *(u32 *)(iSP + 8) = iSP; + /* write the stack cache */ + *(u32 *)(iSP + 12) = arg6; + iSP = iSP + 8; + +pllvloopend: + if (_trace) printf("pllvloopend:\n"); + arg2 = arg2 - 1; + /* J. If iterations to go. */ + if ((s64)arg2 >= 0) + goto pllvlooptop; + goto NEXTINSTRUCTION; + +pllvillop: + if (_trace) printf("pllvillop:\n"); + arg5 = 0; + arg2 = 63; + goto illegaloperand; + +/* end DoPushLocalLogicVariables */ + /* End of Halfword operand from stack instruction - DoPushLocalLogicVariables */ +/* start DoPushGlobalLogicVariable */ + + /* Halfword operand from stack instruction - DoPushGlobalLogicVariable */ + +dopushgloballogicvariable: + if (_trace) printf("dopushgloballogicvariable:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoPushGlobalLogicVariableIM: + if (_trace) printf("DoPushGlobalLogicVariableIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8948: + if (_trace) printf("g8948:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindopushgloballogicvariable; +#ifdef TRACING +#endif + +DoPushGlobalLogicVariableSP: + if (_trace) printf("DoPushGlobalLogicVariableSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdopushgloballogicvariable; +#endif + +DoPushGlobalLogicVariableLP: + if (_trace) printf("DoPushGlobalLogicVariableLP:\n"); +#ifdef TRACING + goto headdopushgloballogicvariable; +#endif + +DoPushGlobalLogicVariableFP: + if (_trace) printf("DoPushGlobalLogicVariableFP:\n"); + +headdopushgloballogicvariable: + if (_trace) printf("headdopushgloballogicvariable:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindopushgloballogicvariable: + if (_trace) printf("begindopushgloballogicvariable:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* Get the structure stack pointer */ + t1 = *(s32 *)&processor->bar2; + t3 = Type_ExternalValueCellPointer; + *(u32 *)(iSP + 8) = t1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t3; + iSP = iSP + 8; + /* Memory Read Internal */ + +g8933: + /* Base of stack cache */ + t6 = *(u64 *)&(processor->stackcachebasevma); + t8 = t1 + ivory; + t7 = *(s32 *)&processor->scovlimit; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = t1 - t6; + t9 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)t7) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g8935; + +g8934: + t8 = zero + 240; + t9 = t9 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t9 & 1) + goto g8937; + +g8943: + /* Merge cdr-code */ + t5 = t3 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t7 = *(u64 *)&(processor->stackcachebasevma); + t6 = t1 + ivory; + t9 = *(s32 *)&processor->scovlimit; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = t1 - t7; + /* In range? */ + t9 = ((u64)t7 < (u64)t9) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g8946: + if (_trace) printf("g8946:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = t1; + /* J. if in cache */ + if (t9 != 0) + goto g8945; + +g8944: + /* Increment the structure-stack-pointer */ + t2 = t1 + 1; + /* Set the structure stack pointer */ + *(u32 *)&processor->bar2 = t2; + goto NEXTINSTRUCTION; + +g8945: + if (_trace) printf("g8945:\n"); + t7 = *(u64 *)&(processor->stackcachebasevma); + +g8947: + if (_trace) printf("g8947:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = t1 - t7; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = t1; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto g8944; + +g8935: + if (_trace) printf("g8935:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g8934; + +g8937: + if (_trace) printf("g8937:\n"); + if ((t8 & 1) == 0) + goto g8936; + /* Do the indirect thing */ + t1 = (u32)t5; + goto g8933; + +g8936: + if (_trace) printf("g8936:\n"); + /* Load the memory action table for cycle */ + t9 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t9; + /* Get the memory action */ + t9 = *(s32 *)t8; +#ifndef MINIMA + +g8940: +#endif +#ifdef MINIMA + +g8940: + if (_trace) printf("g8940:\n"); + t8 = t9 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g8939; + t6 = t1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t6 = t6 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t6 = (s32)t6 + (s32)t8; + /* Clear sign-extension */ + t6 = (u32)t6; + t7 = (t6 * 4) + t7; + /* Fetch the key */ + t6 = *(s32 *)t7; + /* Fetch value */ + t5 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)t1 - (s32)t6; + /* Trap on miss */ + if (t8 != 0) + goto g8942; + /* Extract the pointer, and indirect */ + t1 = (u32)t5; + goto g8933; + +g8942: + if (_trace) printf("g8942:\n"); + goto dbcachemisstrap; +#endif + +g8939: + /* Perform memory action */ + arg1 = t9; + arg2 = 1; + goto performmemoryaction; + +/* end DoPushGlobalLogicVariable */ + /* End of Halfword operand from stack instruction - DoPushGlobalLogicVariable */ +/* start DoLogicTailTest */ + + /* Halfword operand from stack instruction - DoLogicTailTest */ + +dologictailtest: + if (_trace) printf("dologictailtest:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoLogicTailTestIM: + if (_trace) printf("DoLogicTailTestIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8958: + if (_trace) printf("g8958:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindologictailtest; +#ifdef TRACING +#endif + +DoLogicTailTestSP: + if (_trace) printf("DoLogicTailTestSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdologictailtest; +#endif + +DoLogicTailTestLP: + if (_trace) printf("DoLogicTailTestLP:\n"); +#ifdef TRACING + goto headdologictailtest; +#endif + +DoLogicTailTestFP: + if (_trace) printf("DoLogicTailTestFP:\n"); + +headdologictailtest: + if (_trace) printf("headdologictailtest:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindologictailtest: + if (_trace) printf("begindologictailtest:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg2 = arg1 >> 32; + /* Strip off any CDR code bits. */ + t1 = arg2 & 63; + t2 = (t1 == Type_List) ? 1 : 0; + +g8955: + if (_trace) printf("g8955:\n"); + if (t2 == 0) + goto g8950; + /* Here if argument TypeList */ + t3 = *(u64 *)&(processor->niladdress); + /* push the data */ + *(u64 *)(iSP + 8) = t3; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g8950: + if (_trace) printf("g8950:\n"); + t2 = (t1 == Type_ExternalValueCellPointer) ? 1 : 0; + +g8956: + if (_trace) printf("g8956:\n"); + if (t2 == 0) + goto g8951; + /* Here if argument TypeExternalValueCellPointer */ + t3 = *(u64 *)&(processor->taddress); + /* push the data */ + *(u64 *)(iSP + 8) = t3; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g8951: + if (_trace) printf("g8951:\n"); + t2 = (t1 == Type_ListInstance) ? 1 : 0; + +g8957: + if (_trace) printf("g8957:\n"); + if (t2 == 0) + goto g8952; + /* Here if argument TypeListInstance */ + t3 = *(u64 *)&(processor->niladdress); + /* push the data */ + *(u64 *)(iSP + 8) = t3; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g8952: + if (_trace) printf("g8952:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = t2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +g8949: + if (_trace) printf("g8949:\n"); + +/* end DoLogicTailTest */ + /* End of Halfword operand from stack instruction - DoLogicTailTest */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunjosh.as */ diff --git a/stub/ifunlexi.c b/stub/ifunlexi.c new file mode 100644 index 0000000..627f2e8 --- /dev/null +++ b/stub/ifunlexi.c @@ -0,0 +1,624 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunlexi.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Lexical variable accessors. */ +/* start DoPushLexicalVarN */ + + /* Halfword operand from stack instruction - DoPushLexicalVarN */ + /* arg2 has the preloaded 8 bit operand. */ + +dopushlexicalvarn: + if (_trace) printf("dopushlexicalvarn:\n"); +#ifdef TRACING +#endif + +DoPushLexicalVarNSP: + if (_trace) printf("DoPushLexicalVarNSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindopushlexicalvarn; +#endif + +DoPushLexicalVarNLP: + if (_trace) printf("DoPushLexicalVarNLP:\n"); +#ifdef TRACING + goto begindopushlexicalvarn; +#endif + +DoPushLexicalVarNFP: + if (_trace) printf("DoPushLexicalVarNFP:\n"); + +begindopushlexicalvarn: + if (_trace) printf("begindopushlexicalvarn:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Position the opcode */ + t4 = arg3 >> 10; + t1 = *(s32 *)arg1; + t2 = *(s32 *)(arg1 + 4); + /* Get the lexical var number */ + t4 = t4 & 7; + t1 = (u32)t1; + /* TagType. */ + t3 = t2 & 63; + t3 = t3 - Type_List; + t3 = t3 & ~4L; + /* Compute the address of the lexical variable. */ + t1 = t1 + t4; + if (t3 != 0) + goto pushlexvariop; + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g8278: + t6 = t1 + ivory; + t3 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t4 = t1 - arg5; + t7 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t5 = ((u64)t4 < (u64)arg6) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t5 != 0) + goto g8280; + +g8279: + t6 = zero + 240; + t7 = t7 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + if (t7 & 1) + goto g8282; + +g8289: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* set CDR-NEXT */ + t4 = t2 & 63; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + goto cachevalid; + +pushlexvariop: + if (_trace) printf("pushlexvariop:\n"); + arg5 = 0; + arg2 = 82; + goto illegaloperand; + +g8280: + if (_trace) printf("g8280:\n"); + t5 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t4 = (t4 * 8) + t5; + t3 = *(s32 *)t4; + /* Read from stack cache */ + t2 = *(s32 *)(t4 + 4); + goto g8279; + +g8282: + if (_trace) printf("g8282:\n"); + if ((t6 & 1) == 0) + goto g8281; + /* Do the indirect thing */ + t1 = (u32)t3; + goto g8278; + +g8281: + if (_trace) printf("g8281:\n"); + /* Load the memory action table for cycle */ + t7 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t7; + /* Get the memory action */ + t7 = *(s32 *)t6; + +g8286: + if (_trace) printf("g8286:\n"); + t6 = t7 & MemoryActionTransform; + if (t6 == 0) + goto g8285; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g8289; +#ifndef MINIMA + +g8285: +#endif +#ifdef MINIMA + +g8285: + if (_trace) printf("g8285:\n"); + t6 = t7 & MemoryActionBinding; + t5 = *(u64 *)&(processor->dbcmask); + if (t6 == 0) + goto g8284; + t4 = t1 << 1; + t6 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t4 = t4 & t5; + t5 = 1; + t5 = t5 << (ivorymemorydata & 63); + t4 = (s32)t4 + (s32)t6; + /* Clear sign-extension */ + t4 = (u32)t4; + t5 = (t4 * 4) + t5; + /* Fetch the key */ + t4 = *(s32 *)t5; + /* Fetch value */ + t3 = *(s32 *)(t5 + 4); + /* Compare */ + t6 = (s32)t1 - (s32)t4; + /* Trap on miss */ + if (t6 != 0) + goto g8288; + /* Extract the pointer, and indirect */ + t1 = (u32)t3; + goto g8278; + +g8288: + if (_trace) printf("g8288:\n"); + goto dbcachemisstrap; +#endif + +g8284: + /* Perform memory action */ + arg1 = t7; + arg2 = 0; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoPushLexicalVarNIM: + goto doistageerror; + +/* end DoPushLexicalVarN */ + /* End of Halfword operand from stack instruction - DoPushLexicalVarN */ +/* start DoPopLexicalVarN */ + + /* Halfword operand from stack instruction - DoPopLexicalVarN */ + /* arg2 has the preloaded 8 bit operand. */ + +dopoplexicalvarn: + if (_trace) printf("dopoplexicalvarn:\n"); +#ifdef TRACING +#endif + +DoPopLexicalVarNSP: + if (_trace) printf("DoPopLexicalVarNSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindopoplexicalvarn; +#endif + +DoPopLexicalVarNLP: + if (_trace) printf("DoPopLexicalVarNLP:\n"); +#ifdef TRACING + goto begindopoplexicalvarn; +#endif + +DoPopLexicalVarNFP: + if (_trace) printf("DoPopLexicalVarNFP:\n"); + +begindopoplexicalvarn: + if (_trace) printf("begindopoplexicalvarn:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Position the opcode */ + t4 = arg3 >> 10; + t1 = *(s32 *)arg1; + t2 = *(s32 *)(arg1 + 4); + /* Get the lexical var number */ + t4 = t4 & 7; + t1 = (u32)t1; + /* TagType. */ + t3 = t2 & 63; + t3 = t3 - Type_List; + t3 = t3 & ~4L; + /* Compute the address of the lexical variable. */ + t1 = t1 + t4; + if (t3 != 0) + goto poplexvariop; + t3 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t3 = (u32)t3; + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g8290: + t8 = t1 + ivory; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = t1 - arg5; + t9 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)arg6) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g8292; + +g8291: + t8 = zero + 240; + t9 = t9 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t9 & 1) + goto g8294; + +g8300: + /* Merge cdr-code */ + t5 = t2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t6 = t1 + ivory; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = t1 - arg5; + /* In range? */ + t9 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g8302: + if (_trace) printf("g8302:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = t3; + /* J. if in cache */ + if (t9 != 0) + goto g8301; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +poplexvariop: + if (_trace) printf("poplexvariop:\n"); + arg5 = 0; + arg2 = 17; + goto illegaloperand; + +g8301: + if (_trace) printf("g8301:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = t1 - arg5; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = t3; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto NEXTINSTRUCTION; + +g8292: + if (_trace) printf("g8292:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g8291; + +g8294: + if (_trace) printf("g8294:\n"); + if ((t8 & 1) == 0) + goto g8293; + /* Do the indirect thing */ + t1 = (u32)t5; + goto g8290; + +g8293: + if (_trace) printf("g8293:\n"); + /* Load the memory action table for cycle */ + t9 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t9; + /* Get the memory action */ + t9 = *(s32 *)t8; +#ifndef MINIMA + +g8297: +#endif +#ifdef MINIMA + +g8297: + if (_trace) printf("g8297:\n"); + t8 = t9 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g8296; + t6 = t1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t6 = t6 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t6 = (s32)t6 + (s32)t8; + /* Clear sign-extension */ + t6 = (u32)t6; + t7 = (t6 * 4) + t7; + /* Fetch the key */ + t6 = *(s32 *)t7; + /* Fetch value */ + t5 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)t1 - (s32)t6; + /* Trap on miss */ + if (t8 != 0) + goto g8299; + /* Extract the pointer, and indirect */ + t1 = (u32)t5; + goto g8290; + +g8299: + if (_trace) printf("g8299:\n"); + goto dbcachemisstrap; +#endif + +g8296: + /* Perform memory action */ + arg1 = t9; + arg2 = 1; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoPopLexicalVarNIM: + goto doistageerror; + +/* end DoPopLexicalVarN */ + /* End of Halfword operand from stack instruction - DoPopLexicalVarN */ +/* start DoMovemLexicalVarN */ + + /* Halfword operand from stack instruction - DoMovemLexicalVarN */ + /* arg2 has the preloaded 8 bit operand. */ + +domovemlexicalvarn: + if (_trace) printf("domovemlexicalvarn:\n"); +#ifdef TRACING +#endif + +DoMovemLexicalVarNSP: + if (_trace) printf("DoMovemLexicalVarNSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindomovemlexicalvarn; +#endif + +DoMovemLexicalVarNLP: + if (_trace) printf("DoMovemLexicalVarNLP:\n"); +#ifdef TRACING + goto begindomovemlexicalvarn; +#endif + +DoMovemLexicalVarNFP: + if (_trace) printf("DoMovemLexicalVarNFP:\n"); + +begindomovemlexicalvarn: + if (_trace) printf("begindomovemlexicalvarn:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Position the opcode */ + t4 = arg3 >> 10; + t1 = *(s32 *)arg1; + t2 = *(s32 *)(arg1 + 4); + /* Get the lexical var number */ + t4 = t4 & 7; + t1 = (u32)t1; + /* TagType. */ + t3 = t2 & 63; + t3 = t3 - Type_List; + t3 = t3 & ~4L; + /* Compute the address of the lexical variable. */ + t1 = t1 + t4; + if (t3 != 0) + goto movemlexvariop; + t3 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + t3 = (u32)t3; + arg5 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + arg6 = *(s32 *)&processor->scovlimit; + /* Memory Read Internal */ + +g8303: + t8 = t1 + ivory; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = t1 - arg5; + t9 = *(u64 *)&(processor->datawrite_mask); + /* In range? */ + t7 = ((u64)t6 < (u64)arg6) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g8305; + +g8304: + t8 = zero + 240; + t9 = t9 >> (t4 & 63); + t8 = t8 >> (t4 & 63); + if (t9 & 1) + goto g8307; + +g8313: + /* Merge cdr-code */ + t5 = t2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t6 = t1 + ivory; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = t1 - arg5; + /* In range? */ + t9 = ((u64)t7 < (u64)arg6) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g8315: + if (_trace) printf("g8315:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = t3; + /* J. if in cache */ + if (t9 != 0) + goto g8314; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +movemlexvariop: + if (_trace) printf("movemlexvariop:\n"); + arg5 = 0; + arg2 = 17; + goto illegaloperand; + +g8314: + if (_trace) printf("g8314:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = t1 - arg5; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = t3; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto NEXTINSTRUCTION; + +g8305: + if (_trace) printf("g8305:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g8304; + +g8307: + if (_trace) printf("g8307:\n"); + if ((t8 & 1) == 0) + goto g8306; + /* Do the indirect thing */ + t1 = (u32)t5; + goto g8303; + +g8306: + if (_trace) printf("g8306:\n"); + /* Load the memory action table for cycle */ + t9 = *(u64 *)&(processor->datawrite); + /* TagType. */ + /* Discard the CDR code */ + t8 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t8 = (t8 * 4) + t9; + /* Get the memory action */ + t9 = *(s32 *)t8; +#ifndef MINIMA + +g8310: +#endif +#ifdef MINIMA + +g8310: + if (_trace) printf("g8310:\n"); + t8 = t9 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t8 == 0) + goto g8309; + t6 = t1 << 1; + t8 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t6 = t6 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t6 = (s32)t6 + (s32)t8; + /* Clear sign-extension */ + t6 = (u32)t6; + t7 = (t6 * 4) + t7; + /* Fetch the key */ + t6 = *(s32 *)t7; + /* Fetch value */ + t5 = *(s32 *)(t7 + 4); + /* Compare */ + t8 = (s32)t1 - (s32)t6; + /* Trap on miss */ + if (t8 != 0) + goto g8312; + /* Extract the pointer, and indirect */ + t1 = (u32)t5; + goto g8303; + +g8312: + if (_trace) printf("g8312:\n"); + goto dbcachemisstrap; +#endif + +g8309: + /* Perform memory action */ + arg1 = t9; + arg2 = 1; + goto performmemoryaction; +#ifdef TRACING +#endif + +DoMovemLexicalVarNIM: + goto doistageerror; + +/* end DoMovemLexicalVarN */ + /* End of Halfword operand from stack instruction - DoMovemLexicalVarN */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunlexi.as */ diff --git a/stub/ifunlist.c b/stub/ifunlist.c new file mode 100644 index 0000000..2f4115c --- /dev/null +++ b/stub/ifunlist.c @@ -0,0 +1,714 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunlist.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* List Operations. */ +/* start DoSetToCar */ + + /* Halfword operand from stack instruction - DoSetToCar */ + /* arg2 has the preloaded 8 bit operand. */ + +dosettocar: + if (_trace) printf("dosettocar:\n"); +#ifdef TRACING +#endif + +DoSetToCarSP: + if (_trace) printf("DoSetToCarSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindosettocar; +#endif + +DoSetToCarLP: + if (_trace) printf("DoSetToCarLP:\n"); +#ifdef TRACING + goto begindosettocar; +#endif + +DoSetToCarFP: + if (_trace) printf("DoSetToCarFP:\n"); + +begindosettocar: + if (_trace) printf("begindosettocar:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Get the operand from the stack. */ + arg5 = *(s32 *)(arg1 + 4); + arg6 = *(s32 *)arg1; + /* Save the old CDR code */ + t2 = arg5 & 192; + r0 = (u64)&&return0040; + goto carinternal; +return0040: + /* TagType. */ + arg5 = arg5 & 63; + /* Put back the original CDR codes */ + arg5 = arg5 | t2; + *(u32 *)arg1 = arg6; + /* write the stack cache */ + *(u32 *)(arg1 + 4) = arg5; + goto NEXTINSTRUCTION; +#ifdef TRACING +#endif + +DoSetToCarIM: + goto doistageerror; + +/* end DoSetToCar */ + /* End of Halfword operand from stack instruction - DoSetToCar */ +/* start DoSetToCdr */ + + /* Halfword operand from stack instruction - DoSetToCdr */ + /* arg2 has the preloaded 8 bit operand. */ + +dosettocdr: + if (_trace) printf("dosettocdr:\n"); +#ifdef TRACING +#endif + +DoSetToCdrSP: + if (_trace) printf("DoSetToCdrSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindosettocdr; +#endif + +DoSetToCdrLP: + if (_trace) printf("DoSetToCdrLP:\n"); +#ifdef TRACING + goto begindosettocdr; +#endif + +DoSetToCdrFP: + if (_trace) printf("DoSetToCdrFP:\n"); + +begindosettocdr: + if (_trace) printf("begindosettocdr:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + /* Get the operand from the stack. */ + arg5 = *(s32 *)(arg1 + 4); + arg6 = *(s32 *)arg1; + /* Save the old CDR code */ + t2 = arg5 & 192; + r0 = (u64)&&return0041; + goto cdrinternal; +return0041: + /* TagType. */ + arg5 = arg5 & 63; + /* Put back the original CDR codes */ + arg5 = arg5 | t2; + *(u32 *)arg1 = arg6; + /* write the stack cache */ + *(u32 *)(arg1 + 4) = arg5; + goto NEXTINSTRUCTION; +#ifdef TRACING +#endif + +DoSetToCdrIM: + goto doistageerror; + +/* end DoSetToCdr */ + /* End of Halfword operand from stack instruction - DoSetToCdr */ +/* start SetToCdrPushCarLocative */ + + +SetToCdrPushCarLocative: + if (_trace) printf("SetToCdrPushCarLocative:\n"); + +settocdrpushcarlocative: + if (_trace) printf("settocdrpushcarlocative:\n"); + arg2 = t2; + /* Memory Read Internal */ + +g7187: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g7189; + +g7188: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g7191; + +g7198: + /* TagType. */ + t1 = t1 & 63; + *(u32 *)(iSP + 8) = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = arg5; + iSP = iSP + 8; + /* Put back the original CDR codes */ + t1 = t1 | t3; + *(u32 *)arg1 = arg6; + /* write the stack cache */ + *(u32 *)(arg1 + 4) = arg5; + goto NEXTINSTRUCTION; + +g7191: + if (_trace) printf("g7191:\n"); + if ((t7 & 1) == 0) + goto g7190; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g7187; + +g7190: + if (_trace) printf("g7190:\n"); + +g7189: + if (_trace) printf("g7189:\n"); + r0 = (u64)&&return0042; + goto memoryreaddatadecode; +return0042: + goto g7198; + +/* end SetToCdrPushCarLocative */ +/* start DoAssoc */ + + /* Halfword operand from stack instruction - DoAssoc */ + /* arg2 has the preloaded 8 bit operand. */ + +doassoc: + if (_trace) printf("doassoc:\n"); +#ifdef TRACING +#endif + +DoAssocSP: + if (_trace) printf("DoAssocSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindoassoc; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindoassoc; +#endif + +DoAssocLP: + if (_trace) printf("DoAssocLP:\n"); +#ifdef TRACING + goto begindoassoc; +#endif + +DoAssocFP: + if (_trace) printf("DoAssocFP:\n"); + +begindoassoc: + if (_trace) printf("begindoassoc:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + t5 = zero + -2048; + t5 = t5 + ((1) << 16); + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (u32)arg6; + t1 = *(s32 *)(arg1 + 4); + t2 = *(s32 *)arg1; + /* TagType. */ + /* Get the object type bits */ + arg3 = arg3 & 63; + /* Low bit will set iff EQ-NOT-EQL */ + t5 = t5 >> (arg3 & 63); + /* TagType. */ + /* Strip cdr code */ + t1 = t1 & 63; + /* Remove sign-extension */ + t2 = (u32)t2; + if (t5 & 1) + goto assocexc; + t6 = zero; + goto g7200; + +assoccdr: + if (_trace) printf("assoccdr:\n"); + /* Have we been asked to stop or trap? */ + t6 = *(u64 *)&(processor->stop_interpreter); + /* Move cdr to car for next carcdr-internal */ + /* TagType. */ + t1 = arg5 & 63; + t2 = arg6; + +g7200: + if (_trace) printf("g7200:\n"); + t5 = t1 - Type_NIL; + /* Asked to stop, check for sequence break */ + if (t6 != 0) + goto g7199; + if (t5 == 0) + goto g7201; + r0 = (u64)&&return0043; + goto carcdrinternal; +return0043: + /* Strip off any CDR code bits. */ + t7 = t1 & 63; + t8 = (t7 == Type_List) ? 1 : 0; + +g7219: + if (_trace) printf("g7219:\n"); + if (t8 == 0) + goto g7203; + /* Here if argument TypeList */ + arg2 = t2; + t3 = arg5; + arg1 = arg6; + /* Memory Read Internal */ + +g7204: + t7 = arg2 + ivory; + arg6 = (t7 * 4); + arg5 = LDQ_U(t7); + /* Stack cache offset */ + t5 = arg2 - t11; + t8 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t6 = ((u64)t5 < (u64)t12) ? 1 : 0; + arg6 = *(s32 *)arg6; + arg5 = (u8)(arg5 >> ((t7&7)*8)); + if (t6 != 0) + goto g7206; + +g7205: + t7 = zero + 240; + t8 = t8 >> (arg5 & 63); + t7 = t7 >> (arg5 & 63); + if (t8 & 1) + goto g7208; + +g7215: + /* TagType. */ + t5 = arg5 & 63; + arg5 = t3; + /* t6=0 if data same */ + t6 = (s32)arg4 - (s32)arg6; + arg6 = arg1; + /* J. if different */ + if (t6 != 0) + goto assoccdr; + /* t5 zero if same tag */ + t5 = arg3 - t5; + /* J. if tags different */ + if (t5 != 0) + goto assoccdr; + /* we found a match! */ + /* TagType. */ + t1 = t1 & 63; + *(u32 *)iSP = t2; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t1; + goto NEXTINSTRUCTION; + +g7203: + if (_trace) printf("g7203:\n"); + t8 = (t7 == Type_NIL) ? 1 : 0; + +g7220: + if (_trace) printf("g7220:\n"); + if (t8 == 0) + goto g7216; + /* Here if argument TypeNIL */ + goto assoccdr; + +g7216: + if (_trace) printf("g7216:\n"); + /* Here for all other cases */ + /* SetTag. */ + t1 = arg4 << 32; + t1 = arg5 | t1; + arg5 = t1; + arg2 = 14; + goto illegaloperand; + +g7202: + if (_trace) printf("g7202:\n"); + +g7201: + if (_trace) printf("g7201:\n"); + /* Return NIL */ + t1 = *(u64 *)&(processor->niladdress); + /* push the data */ + *(u64 *)iSP = t1; + goto NEXTINSTRUCTION; + +assocexc: + if (_trace) printf("assocexc:\n"); + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +g7208: + if (_trace) printf("g7208:\n"); + if ((t7 & 1) == 0) + goto g7207; + /* Do the indirect thing */ + arg2 = (u32)arg6; + goto g7204; + +g7207: + if (_trace) printf("g7207:\n"); + +g7206: + if (_trace) printf("g7206:\n"); + r0 = (u64)&&return0044; + goto memoryreaddatadecode; +return0044: + goto g7215; + +g7199: + if (_trace) printf("g7199:\n"); + iSP = *(u64 *)&(processor->restartsp); + goto INTERPRETINSTRUCTION; +#ifdef TRACING +#endif + +DoAssocIM: + goto doistageerror; + +/* end DoAssoc */ + /* End of Halfword operand from stack instruction - DoAssoc */ +/* start DoMember */ + + /* Halfword operand from stack instruction - DoMember */ + /* arg2 has the preloaded 8 bit operand. */ + +domember: + if (_trace) printf("domember:\n"); +#ifdef TRACING +#endif + +DoMemberSP: + if (_trace) printf("DoMemberSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindomember; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindomember; +#endif + +DoMemberLP: + if (_trace) printf("DoMemberLP:\n"); +#ifdef TRACING + goto begindomember; +#endif + +DoMemberFP: + if (_trace) printf("DoMemberFP:\n"); + +begindomember: + if (_trace) printf("begindomember:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + t5 = zero + -2048; + t5 = t5 + ((1) << 16); + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (u32)arg6; + t1 = *(s32 *)(arg1 + 4); + t2 = *(s32 *)arg1; + /* TagType. */ + /* Get the object type bits */ + arg3 = arg3 & 63; + /* Low bit will set iff EQ-NOT-EQL */ + t5 = t5 >> (arg3 & 63); + /* TagType. */ + /* Strip cdr code */ + t1 = t1 & 63; + /* Remove sign-extension */ + t2 = (u32)t2; + if (t5 & 1) + goto memberexc; + t6 = zero; + goto g7222; + +membercdr: + if (_trace) printf("membercdr:\n"); + /* Have we been asked to stop or trap? */ + t6 = *(u64 *)&(processor->stop_interpreter); + /* Move cdr to car for next carcdr-internal */ + /* TagType. */ + t1 = arg5 & 63; + t2 = arg6; + +g7222: + if (_trace) printf("g7222:\n"); + /* TagType. */ + t3 = t1 & 63; + arg1 = t2; + t5 = t1 - Type_NIL; + /* Asked to stop, check for sequence break */ + if (t6 != 0) + goto g7221; + if (t5 == 0) + goto g7223; + r0 = (u64)&&return0045; + goto carcdrinternal; +return0045: + /* TagType. */ + t5 = t1 & 63; + /* t7=0 if data same */ + t7 = arg4 - t2; + /* J. if different */ + if (t7 != 0) + goto membercdr; + /* t6 zero if same tag */ + t6 = arg3 - t5; + /* J. if tags different */ + if (t6 != 0) + goto membercdr; + /* we found a match! */ + *(u32 *)iSP = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t3; + goto NEXTINSTRUCTION; + +g7223: + if (_trace) printf("g7223:\n"); + /* Return NIL */ + t1 = *(u64 *)&(processor->niladdress); + /* push the data */ + *(u64 *)iSP = t1; + goto NEXTINSTRUCTION; + +memberexc: + if (_trace) printf("memberexc:\n"); + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +g7221: + if (_trace) printf("g7221:\n"); + iSP = *(u64 *)&(processor->restartsp); + goto INTERPRETINSTRUCTION; +#ifdef TRACING +#endif + +DoMemberIM: + goto doistageerror; + +/* end DoMember */ + /* End of Halfword operand from stack instruction - DoMember */ +/* start DoRgetf */ + + /* Halfword operand from stack instruction - DoRgetf */ + /* arg2 has the preloaded 8 bit operand. */ + +dorgetf: + if (_trace) printf("dorgetf:\n"); +#ifdef TRACING +#endif + +DoRgetfSP: + if (_trace) printf("DoRgetfSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindorgetf; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindorgetf; +#endif + +DoRgetfLP: + if (_trace) printf("DoRgetfLP:\n"); +#ifdef TRACING + goto begindorgetf; +#endif + +DoRgetfFP: + if (_trace) printf("DoRgetfFP:\n"); + +begindorgetf: + if (_trace) printf("begindorgetf:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + t5 = zero + -2048; + t5 = t5 + ((1) << 16); + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (u32)arg6; + t1 = *(s32 *)(arg1 + 4); + t2 = *(s32 *)arg1; + /* TagType. */ + /* Get the object type bits */ + arg3 = arg3 & 63; + /* Low bit will set iff EQ-NOT-EQL */ + t5 = t5 >> (arg3 & 63); + /* TagType. */ + /* Strip cdr code */ + t1 = t1 & 63; + /* Remove sign-extension */ + t2 = (u32)t2; + if (t5 & 1) + goto rgetfexc; + t6 = zero; + goto g7225; + +rgetfcdr: + if (_trace) printf("rgetfcdr:\n"); + r0 = (u64)&&return0046; + goto cdrinternal; +return0046: + /* Have we been asked to stop or trap? */ + t6 = *(u64 *)&(processor->stop_interpreter); + /* Move cdr to car for next carcdr-internal */ + /* TagType. */ + t1 = arg5 & 63; + t2 = arg6; + +g7225: + if (_trace) printf("g7225:\n"); + t5 = t1 - Type_NIL; + /* Asked to stop, check for sequence break */ + if (t6 != 0) + goto g7224; + if (t5 == 0) + goto g7226; + r0 = (u64)&&return0047; + goto carcdrinternal; +return0047: + /* TagType. */ + t5 = t1 & 63; + /* t7=0 if data same */ + t7 = arg4 - t2; + /* J. if different */ + if (t7 != 0) + goto rgetfcdr; + /* t6 zero if same tag */ + t6 = arg3 - t5; + /* J. if tags different */ + if (t6 != 0) + goto rgetfcdr; + /* we found a match! */ + /* TagType. */ + /* Strip CDR code */ + t1 = arg5 & 63; + /* t5=0 if end of list */ + t5 = t1 - Type_NIL; + /* after all this effort we lose! */ + if (t5 == 0) + goto rgetfexc; + t2 = arg6; + r0 = (u64)&&return0048; + goto carinternal; +return0048: + /* TagType. */ + /* Strip the CDR code */ + arg5 = arg5 & 63; + *(u32 *)iSP = arg6; + /* write the stack cache */ + *(u32 *)(iSP + 4) = arg5; + /* set CDR-NEXT */ + arg2 = t1 & 63; + /* Push the second result */ + *(u32 *)(iSP + 8) = t2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = arg2; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +g7226: + if (_trace) printf("g7226:\n"); + /* Return NIL */ + arg2 = *(u64 *)&(processor->niladdress); + *(u64 *)iSP = arg2; + /* push the data */ + *(u64 *)(iSP + 8) = arg2; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +rgetfexc: + if (_trace) printf("rgetfexc:\n"); + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +g7224: + if (_trace) printf("g7224:\n"); + iSP = *(u64 *)&(processor->restartsp); + goto INTERPRETINSTRUCTION; +#ifdef TRACING +#endif + +DoRgetfIM: + goto doistageerror; + +/* end DoRgetf */ + /* End of Halfword operand from stack instruction - DoRgetf */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunlist.as */ diff --git a/stub/ifunloop.c b/stub/ifunloop.c new file mode 100644 index 0000000..c1c6009 --- /dev/null +++ b/stub/ifunloop.c @@ -0,0 +1,600 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunloop.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Branch and loop instructions. */ +/* start DoBranchTrueElseNoPop */ + + /* Halfword 10 bit immediate instruction - DoBranchTrueElseNoPop */ + +dobranchtrueelsenopop: + if (_trace) printf("dobranchtrueelsenopop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueElseNoPopIM: + if (_trace) printf("DoBranchTrueElseNoPopIM:\n"); + +DoBranchTrueElseNoPopSP: + if (_trace) printf("DoBranchTrueElseNoPopSP:\n"); + +DoBranchTrueElseNoPopLP: + if (_trace) printf("DoBranchTrueElseNoPopLP:\n"); + +DoBranchTrueElseNoPopFP: + if (_trace) printf("DoBranchTrueElseNoPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto NEXTINSTRUCTION; + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrueElseNoPop */ + /* End of Halfword operand from stack instruction - DoBranchTrueElseNoPop */ +/* start DoBranchTrueElseExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchTrueElseExtraPop */ + +dobranchtrueelseextrapop: + if (_trace) printf("dobranchtrueelseextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueElseExtraPopIM: + if (_trace) printf("DoBranchTrueElseExtraPopIM:\n"); + +DoBranchTrueElseExtraPopSP: + if (_trace) printf("DoBranchTrueElseExtraPopSP:\n"); + +DoBranchTrueElseExtraPopLP: + if (_trace) printf("DoBranchTrueElseExtraPopLP:\n"); + +DoBranchTrueElseExtraPopFP: + if (_trace) printf("DoBranchTrueElseExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto dobrelsepopextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 16; + goto cachevalid; + +dobrelsepopextrapop: + if (_trace) printf("dobrelsepopextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrueElseExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchTrueElseExtraPop */ +/* start DoBranchFalseElseExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchFalseElseExtraPop */ + +dobranchfalseelseextrapop: + if (_trace) printf("dobranchfalseelseextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseElseExtraPopIM: + if (_trace) printf("DoBranchFalseElseExtraPopIM:\n"); + +DoBranchFalseElseExtraPopSP: + if (_trace) printf("DoBranchFalseElseExtraPopSP:\n"); + +DoBranchFalseElseExtraPopLP: + if (_trace) printf("DoBranchFalseElseExtraPopLP:\n"); + +DoBranchFalseElseExtraPopFP: + if (_trace) printf("DoBranchFalseElseExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto dobrnelsepopextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 16; + goto cachevalid; + +dobrnelsepopextrapop: + if (_trace) printf("dobrnelsepopextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalseElseExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchFalseElseExtraPop */ +/* start DoBranchFalseExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchFalseExtraPop */ + +dobranchfalseextrapop: + if (_trace) printf("dobranchfalseextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseExtraPopIM: + if (_trace) printf("DoBranchFalseExtraPopIM:\n"); + +DoBranchFalseExtraPopSP: + if (_trace) printf("DoBranchFalseExtraPopSP:\n"); + +DoBranchFalseExtraPopLP: + if (_trace) printf("DoBranchFalseExtraPopLP:\n"); + +DoBranchFalseExtraPopFP: + if (_trace) printf("DoBranchFalseExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto dobrnpopelsepopextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 16; + goto cachevalid; + +dobrnpopelsepopextrapop: + if (_trace) printf("dobrnpopelsepopextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 16; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalseExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchFalseExtraPop */ +/* start DoLoopDecrementTos */ + + /* Halfword 10 bit immediate instruction - DoLoopDecrementTos */ + +doloopdecrementtos: + if (_trace) printf("doloopdecrementtos:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoLoopDecrementTosIM: + if (_trace) printf("DoLoopDecrementTosIM:\n"); + +DoLoopDecrementTosSP: + if (_trace) printf("DoLoopDecrementTosSP:\n"); + +DoLoopDecrementTosLP: + if (_trace) printf("DoLoopDecrementTosLP:\n"); + +DoLoopDecrementTosFP: + if (_trace) printf("DoLoopDecrementTosFP:\n"); + arg1 = (s64)arg3 >> 48; + /* arg1 has signed operand preloaded. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + t2 = (u32)arg6; + t3 = t1 - Type_Fixnum; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto g7179; + t3 = (s32)t2 - (s32)1; + t4 = ((s64)t3 < (s64)t2) ? 1 : 0; + if (t4 == 0) + goto g7181; + t6 = Type_Fixnum; + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t6; + if ((s64)t3 <= 0) + goto NEXTINSTRUCTION; + /* Here if branch taken. */ + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +g7179: + if (_trace) printf("g7179:\n"); + t3 = t1 - Type_Fixnum; + /* Strip CDR code, low bits */ + t3 = t3 & 56; + if (t3 != 0) + goto g7180; + +g7181: + if (_trace) printf("g7181:\n"); + /* Compute next-pc */ + arg5 = iPC + arg1; + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto loopexception; + +g7180: + if (_trace) printf("g7180:\n"); + arg5 = 0; + arg2 = 81; + goto illegaloperand; + +/* end DoLoopDecrementTos */ + /* End of Halfword operand from stack instruction - DoLoopDecrementTos */ +/* start DoLoopIncrementTosLessThan */ + + /* Halfword 10 bit immediate instruction - DoLoopIncrementTosLessThan */ + +doloopincrementtoslessthan: + if (_trace) printf("doloopincrementtoslessthan:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoLoopIncrementTosLessThanIM: + if (_trace) printf("DoLoopIncrementTosLessThanIM:\n"); + +DoLoopIncrementTosLessThanSP: + if (_trace) printf("DoLoopIncrementTosLessThanSP:\n"); + +DoLoopIncrementTosLessThanLP: + if (_trace) printf("DoLoopIncrementTosLessThanLP:\n"); + +DoLoopIncrementTosLessThanFP: + if (_trace) printf("DoLoopIncrementTosLessThanFP:\n"); + arg1 = (s64)arg3 >> 48; + /* arg1 has signed operand preloaded. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + t2 = (u32)arg6; + t5 = t1 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g7182; + /* Get arg1. */ + t4 = *(s32 *)(iSP + -8); + t3 = *(s32 *)(iSP + -4); + t4 = (u32)t4; + t5 = t3 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g7183; + t5 = (s32)t2 + (s32)1; + t6 = ((s64)t2 <= (s64)t5) ? 1 : 0; + if (t6 == 0) + goto g7184; + t6 = Type_Fixnum; + *(u32 *)iSP = t5; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t6; + t6 = ((s64)t5 <= (s64)t4) ? 1 : 0; + if (t6 == 0) + goto NEXTINSTRUCTION; + /* Here if branch taken. */ + +g7186: + if (_trace) printf("g7186:\n"); + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +g7182: + if (_trace) printf("g7182:\n"); + t5 = t1 - Type_Fixnum; + /* Strip CDR code, low bits */ + t5 = t5 & 56; + if (t5 != 0) + goto g7185; + +g7183: + if (_trace) printf("g7183:\n"); + t5 = t3 - Type_Fixnum; + /* Strip CDR code, low bits */ + t5 = t5 & 56; + if (t5 != 0) + goto g7185; + +g7184: + if (_trace) printf("g7184:\n"); + /* Compute next-pc */ + arg5 = iPC + arg1; + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto loopexception; + +g7185: + if (_trace) printf("g7185:\n"); + arg5 = 0; + arg2 = 16; + goto illegaloperand; + +/* end DoLoopIncrementTosLessThan */ + /* End of Halfword operand from stack instruction - DoLoopIncrementTosLessThan */ +/* start DoBranchTrueExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchTrueExtraPop */ + +dobranchtrueextrapop: + if (_trace) printf("dobranchtrueextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueExtraPopIM: + if (_trace) printf("DoBranchTrueExtraPopIM:\n"); + +DoBranchTrueExtraPopSP: + if (_trace) printf("DoBranchTrueExtraPopSP:\n"); + +DoBranchTrueExtraPopLP: + if (_trace) printf("DoBranchTrueExtraPopLP:\n"); + +DoBranchTrueExtraPopFP: + if (_trace) printf("DoBranchTrueExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto dobrpopelsepopextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 16; + goto cachevalid; + +dobrpopelsepopextrapop: + if (_trace) printf("dobrpopelsepopextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 16; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrueExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchTrueExtraPop */ +/* start DoBranchTrueAndNoPopElseNoPopExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchTrueAndNoPopElseNoPopExtraPop */ + +dobranchtrueandnopopelsenopopextrapop: + if (_trace) printf("dobranchtrueandnopopelsenopopextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchTrueAndNoPopElseNoPopExtraPopIM: + if (_trace) printf("DoBranchTrueAndNoPopElseNoPopExtraPopIM:\n"); + +DoBranchTrueAndNoPopElseNoPopExtraPopSP: + if (_trace) printf("DoBranchTrueAndNoPopElseNoPopExtraPopSP:\n"); + +DoBranchTrueAndNoPopElseNoPopExtraPopLP: + if (_trace) printf("DoBranchTrueAndNoPopElseNoPopExtraPopLP:\n"); + +DoBranchTrueAndNoPopElseNoPopExtraPopFP: + if (_trace) printf("DoBranchTrueAndNoPopElseNoPopExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 != 0) + goto dobrextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrextrapop: + if (_trace) printf("dobrextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchTrueAndNoPopElseNoPopExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchTrueAndNoPopElseNoPopExtraPop */ +/* start DoBranchFalseAndNoPopElseNoPopExtraPop */ + + /* Halfword 10 bit immediate instruction - DoBranchFalseAndNoPopElseNoPopExtraPop */ + +dobranchfalseandnopopelsenopopextrapop: + if (_trace) printf("dobranchfalseandnopopelsenopopextrapop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoBranchFalseAndNoPopElseNoPopExtraPopIM: + if (_trace) printf("DoBranchFalseAndNoPopElseNoPopExtraPopIM:\n"); + +DoBranchFalseAndNoPopElseNoPopExtraPopSP: + if (_trace) printf("DoBranchFalseAndNoPopElseNoPopExtraPopSP:\n"); + +DoBranchFalseAndNoPopElseNoPopExtraPopLP: + if (_trace) printf("DoBranchFalseAndNoPopElseNoPopExtraPopLP:\n"); + +DoBranchFalseAndNoPopElseNoPopExtraPopFP: + if (_trace) printf("DoBranchFalseAndNoPopElseNoPopExtraPopFP:\n"); + /* arg1 has signed operand preloaded. */ + /* Check tag of word in TOS. */ + t1 = (u32)(arg6 >> ((4&7)*8)); +#ifndef CACHEMETERING + arg2 = *(u64 *)&(((CACHELINEP)iCP)->annotation); +#endif + /* Get signed 10-bit immediate arg */ + arg1 = (s64)arg3 >> 48; + /* TagType. */ + /* strip the cdr code off. */ + t1 = t1 & 63; + /* Compare to NIL */ + t1 = t1 - Type_NIL; + if (t1 == 0) + goto dobrnextrapop; + /* Here if branch not taken. Pop the argument. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + iSP = iSP - 8; + goto cachevalid; + +dobrnextrapop: + if (_trace) printf("dobrnextrapop:\n"); + /* Can't branch to ourself */ + if (arg1 == 0) + goto branchexception; + iSP = iSP - 8; + /* Update the PC in halfwords */ + iPC = iPC + arg1; +#ifndef CACHEMETERING + if (arg2 != 0) + goto interpretinstructionpredicted; +#endif + goto interpretinstructionforbranch; + +/* end DoBranchFalseAndNoPopElseNoPopExtraPop */ + /* End of Halfword operand from stack instruction - DoBranchFalseAndNoPopElseNoPopExtraPop */ +/* start BranchException */ + + +branchexception: + if (_trace) printf("branchexception:\n"); + arg5 = 0; + arg2 = 24; + goto illegaloperand; + +/* end BranchException */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunloop.as */ diff --git a/stub/ifunmath.c b/stub/ifunmath.c new file mode 100644 index 0000000..87a7473 --- /dev/null +++ b/stub/ifunmath.c @@ -0,0 +1,2050 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunmath.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Arithmetic. */ +/* start DoUnaryMinus */ + + /* Halfword operand from stack instruction - DoUnaryMinus */ + /* arg2 has the preloaded 8 bit operand. */ + +dounaryminus: + if (_trace) printf("dounaryminus:\n"); +#ifdef TRACING +#endif + +DoUnaryMinusSP: + if (_trace) printf("DoUnaryMinusSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindounaryminus; +#endif + +DoUnaryMinusLP: + if (_trace) printf("DoUnaryMinusLP:\n"); +#ifdef TRACING + goto begindounaryminus; +#endif + +DoUnaryMinusFP: + if (_trace) printf("DoUnaryMinusFP:\n"); + +begindounaryminus: + if (_trace) printf("begindounaryminus:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t6 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* tag of ARG2 */ + arg5 = *(s32 *)(arg1 + 4); + arg6 = *(s32 *)arg1; + t2 = *(u64 *)&(processor->mostnegativefixnum); + LDS(1, f1, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t5 = arg5 & 63; + t4 = (t5 == Type_Fixnum) ? 1 : 0; + +g7492: + if (_trace) printf("g7492:\n"); + if (t4 == 0) + goto g7488; + /* Here if argument TypeFixnum */ + t2 = (s32)arg6 - (s32)t2; + arg2 = (s32)zero - (s32)arg6; + if (t2 == 0) + goto unaryminusexc; + iPC = t6; + /* Semi-cheat, we know t5 has CDRNext/TypeFixnum */ + *(u32 *)(iSP + 12) = t5; + iCP = t7; + /* Push the data */ + *(u32 *)(iSP + 8) = arg2; + iSP = iSP + 8; + goto cachevalid; + +g7488: + if (_trace) printf("g7488:\n"); + t4 = (t5 == Type_SingleFloat) ? 1 : 0; + +g7493: + if (_trace) printf("g7493:\n"); + if (t4 == 0) + goto g7489; + /* Here if argument TypeSingleFloat */ + /* NIL */ + SUBS(0, f0, 3, f31, 1, f1); /* subs */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = t6; + /* Semi-cheat, we know t5 has CDRNext/TypeSingleFloat */ + *(u32 *)(iSP + 12) = t5; + iCP = t7; + /* Push the data */ + STS( (u32 *)(iSP + 8), 0, f0 ); + iSP = iSP + 8; + goto cachevalid; + +g7489: + if (_trace) printf("g7489:\n"); + /* Here for all other cases */ + +unaryminusexc: + if (_trace) printf("unaryminusexc:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg5; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 1; + goto unarynumericexception; + +g7487: + if (_trace) printf("g7487:\n"); +#ifdef TRACING + goto DoUnaryMinusIM; +#endif + +DoUnaryMinusIM: + if (_trace) printf("DoUnaryMinusIM:\n"); + /* Negate the 8 bit immediate operand */ + arg2 = (s32)zero - (s32)arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t7 = Type_Fixnum; + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t7; + iSP = iSP + 8; + goto cachevalid; + +/* end DoUnaryMinus */ + /* End of Halfword operand from stack instruction - DoUnaryMinus */ +/* start DoMultiply */ + + /* Halfword operand from stack instruction - DoMultiply */ + /* arg2 has the preloaded 8 bit operand. */ + +domultiply: + if (_trace) printf("domultiply:\n"); +#ifdef TRACING +#endif + +DoMultiplySP: + if (_trace) printf("DoMultiplySP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindomultiply; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindomultiply; +#endif + +DoMultiplyLP: + if (_trace) printf("DoMultiplyLP:\n"); +#ifdef TRACING + goto begindomultiply; +#endif + +DoMultiplyFP: + if (_trace) printf("DoMultiplyFP:\n"); + +begindomultiply: + if (_trace) printf("begindomultiply:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + LDS(1, f1, *(u32 *)iSP ); + /* ARG1 tag */ + t1 = (u32)(arg6 >> ((4&7)*8)); + /* ARG2 tag */ + t3 = *(s32 *)(arg1 + 4); + /* ARG1 data */ + t2 = (s32)arg6; + /* ARG2 data */ + t4 = *(s32 *)arg1; + LDS(2, f2, *(u32 *)arg1 ); + /* NIL */ + /* Strip off any CDR code bits. */ + t9 = t1 & 63; + /* Strip off any CDR code bits. */ + t11 = t3 & 63; + t10 = (t9 == Type_Fixnum) ? 1 : 0; + +g7533: + if (_trace) printf("g7533:\n"); + if (t10 == 0) + goto g7504; + /* Here if argument TypeFixnum */ + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7510: + if (_trace) printf("g7510:\n"); + if (t12 == 0) + goto g7506; + /* Here if argument TypeFixnum */ + t6 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* compute 64-bit result */ +// t5 = (s64)((s32)t2 * (s64)(s32)t4); /* mull/v */ + /* x86_64 replacement for mull/v */ + asm("movl %k2,%k0 \n\t" + "imull %k3,%k0 \n\t" + "seto %b1" + : "=r"(t5),"=rm"(oflo) + : "rm"(t2),"rm"(t4) + : "cc"); +// if (t5 >> 32) +// exception(); + t7 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + CHECK_OFLO(); /* check overflow */ + /* Semi-cheat, we know temp2 has CDRNext/TypeFixnum */ + *(u32 *)(iSP + 4) = t9; + iPC = t6; + *(u32 *)iSP = t5; + iCP = t7; + goto cachevalid; + +g7506: + if (_trace) printf("g7506:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7511: + if (_trace) printf("g7511:\n"); + if (t12 == 0) + goto g7507; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g7494; + +g7507: + if (_trace) printf("g7507:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g7512: + if (_trace) printf("g7512:\n"); + if (t12 == 0) + goto g7501; + /* Here if argument TypeDoubleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g7497; + +g7505: + if (_trace) printf("g7505:\n"); + +g7504: + if (_trace) printf("g7504:\n"); + t10 = (t9 == Type_SingleFloat) ? 1 : 0; + +g7534: + if (_trace) printf("g7534:\n"); + if (t10 == 0) + goto g7513; + /* Here if argument TypeSingleFloat */ + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7519: + if (_trace) printf("g7519:\n"); + if (t12 == 0) + goto g7515; + /* Here if argument TypeSingleFloat */ + +g7494: + if (_trace) printf("g7494:\n"); + MULS(0, f0, 1, f1, 2, f2); /* muls */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + goto cachevalid; + +g7515: + if (_trace) printf("g7515:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7520: + if (_trace) printf("g7520:\n"); + if (t12 == 0) + goto g7516; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g7494; + +g7516: + if (_trace) printf("g7516:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g7521: + if (_trace) printf("g7521:\n"); + if (t12 == 0) + goto g7501; + /* Here if argument TypeDoubleFloat */ + +g7497: + if (_trace) printf("g7497:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + goto g7498; + +g7514: + if (_trace) printf("g7514:\n"); + +g7513: + if (_trace) printf("g7513:\n"); + t10 = (t9 == Type_DoubleFloat) ? 1 : 0; + +g7535: + if (_trace) printf("g7535:\n"); + if (t10 == 0) + goto g7522; + /* Here if argument TypeDoubleFloat */ + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g7528: + if (_trace) printf("g7528:\n"); + if (t12 == 0) + goto g7524; + /* Here if argument TypeDoubleFloat */ + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + r0 = (u64)&&return0049; + goto fetchdoublefloat; +return0049: + LDT(1, f1, processor->fp0); + +g7498: + if (_trace) printf("g7498:\n"); + arg2 = (u32)t4; + r0 = (u64)&&return0050; + goto fetchdoublefloat; +return0050: + LDT(2, f2, processor->fp0); + +g7495: + if (_trace) printf("g7495:\n"); + MULT(0, f0, 1, f1, 2, f2); + STT( (u64 *)&processor->fp0, 0, f0 ); + r0 = (u64)&&return0051; + goto consdoublefloat; +return0051: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t8 = Type_DoubleFloat; + *(u32 *)iSP = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + goto cachevalid; + +g7524: + if (_trace) printf("g7524:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7529: + if (_trace) printf("g7529:\n"); + if (t12 == 0) + goto g7525; + /* Here if argument TypeSingleFloat */ + +g7496: + if (_trace) printf("g7496:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + r0 = (u64)&&return0052; + goto fetchdoublefloat; +return0052: + LDT(1, f1, processor->fp0); + goto g7495; + +g7525: + if (_trace) printf("g7525:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7530: + if (_trace) printf("g7530:\n"); + if (t12 == 0) + goto g7501; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g7496; + +g7523: + if (_trace) printf("g7523:\n"); + +g7522: + if (_trace) printf("g7522:\n"); + /* Here for all other cases */ + +g7500: + if (_trace) printf("g7500:\n"); + +domulovfl: + if (_trace) printf("domulovfl:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g7502; + +g7501: + if (_trace) printf("g7501:\n"); + t1 = t3; + goto domulovfl; + +g7502: + if (_trace) printf("g7502:\n"); + +g7503: + if (_trace) printf("g7503:\n"); +#ifdef TRACING + goto DoMultiplyIM; +#endif + +DoMultiplyIM: + if (_trace) printf("DoMultiplyIM:\n"); + arg2 = arg2 << 56; + t1 = (u32)(arg6 >> ((4&7)*8)); + /* get ARG1 tag/data */ + t2 = (s32)arg6; + arg2 = (s64)arg2 >> 56; + /* Strip off any CDR code bits. */ + t11 = t1 & 63; + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7540: + if (_trace) printf("g7540:\n"); + if (t12 == 0) + goto g7537; + /* Here if argument TypeFixnum */ + /* compute 64-bit result */ + t3 = t2 * arg2; + t4 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* compute 32-bit sign-extended result */ + t10 = (s32)t3; + t5 = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* is it the same as the 64-bit result? */ + t10 = (t3 == t10) ? 1 : 0; + /* if not, we overflowed */ + if (t10 == 0) + goto domulovfl; + /* Semi-cheat, we know temp2 has CDRNext/TypeFixnum */ + *(u32 *)(iSP + 4) = t11; + iPC = t4; + *(u32 *)iSP = t3; + iCP = t5; + goto cachevalid; + +g7537: + if (_trace) printf("g7537:\n"); + /* Here for all other cases */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = (u64)&processor->immediate_arg; + arg2 = zero; + goto begindomultiply; + +g7536: + if (_trace) printf("g7536:\n"); + +/* end DoMultiply */ + /* End of Halfword operand from stack instruction - DoMultiply */ +/* start BinaryArithmeticDivisionPrelude */ + + +binaryarithmeticdivisionprelude: + if (_trace) printf("binaryarithmeticdivisionprelude:\n"); + sp = sp + -8; + LDS(1, f1, *(u32 *)iSP ); + /* ARG1 data */ + t2 = (s32)arg6; + /* ARG2 data */ + t4 = *(s32 *)arg1; + /* ARG1 tag */ + t1 = (u32)(arg6 >> ((4&7)*8)); + /* ARG2 tag */ + t3 = *(s32 *)(arg1 + 4); + LDS(2, f2, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t9 = t1 & 63; + /* Strip off any CDR code bits. */ + t11 = t3 & 63; + t10 = (t9 == Type_Fixnum) ? 1 : 0; + +g7578: + if (_trace) printf("g7578:\n"); + if (t10 == 0) + goto g7551; + /* Here if argument TypeFixnum */ + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7557: + if (_trace) printf("g7557:\n"); + if (t12 == 0) + goto g7553; + /* Here if argument TypeFixnum */ + CVTLQ(1, f1, f31, 1, f1); + CVTLQ(2, f2, f31, 2, f2); + CVTQT(1, f1, f31, 1, f1); + CVTQT(2, f2, f31, 2, f2); + +g7552: + if (_trace) printf("g7552:\n"); + +g7550: + if (_trace) printf("g7550:\n"); + +g7541: + if (_trace) printf("g7541:\n"); + sp = sp + 8; + goto *r0; /* ret */ + +g7551: + if (_trace) printf("g7551:\n"); + t10 = (t9 == Type_SingleFloat) ? 1 : 0; + +g7579: + if (_trace) printf("g7579:\n"); + if (t10 == 0) + goto g7558; + /* Here if argument TypeSingleFloat */ + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7564: + if (_trace) printf("g7564:\n"); + if (t12 != 0) + goto g7541; + +g7560: + if (_trace) printf("g7560:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7565: + if (_trace) printf("g7565:\n"); + if (t12 == 0) + goto g7561; + /* Here if argument TypeFixnum */ + /* contagion */ + t3 = t1; + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g7541; + +g7561: + if (_trace) printf("g7561:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g7566: + if (_trace) printf("g7566:\n"); + if (t12 == 0) + goto g7548; + /* Here if argument TypeDoubleFloat */ + +g7543: + if (_trace) printf("g7543:\n"); + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + goto g7544; + +g7559: + if (_trace) printf("g7559:\n"); + +g7558: + if (_trace) printf("g7558:\n"); + t10 = (t9 == Type_DoubleFloat) ? 1 : 0; + +g7580: + if (_trace) printf("g7580:\n"); + if (t10 == 0) + goto g7567; + /* Here if argument TypeDoubleFloat */ + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g7573: + if (_trace) printf("g7573:\n"); + if (t12 == 0) + goto g7569; + /* Here if argument TypeDoubleFloat */ + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + *(u64 *)sp = r0; + r0 = (u64)&&return0053; + goto fetchdoublefloat; +return0053: + r0 = *(u64 *)sp; + LDT(1, f1, processor->fp0); + +g7544: + if (_trace) printf("g7544:\n"); + arg2 = (u32)t4; + *(u64 *)sp = r0; + r0 = (u64)&&return0054; + goto fetchdoublefloat; +return0054: + r0 = *(u64 *)sp; + LDT(2, f2, processor->fp0); + goto g7541; + +g7569: + if (_trace) printf("g7569:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7574: + if (_trace) printf("g7574:\n"); + if (t12 == 0) + goto g7570; + /* Here if argument TypeSingleFloat */ + +g7542: + if (_trace) printf("g7542:\n"); + /* contagion */ + t3 = t1; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + arg2 = (u32)t2; + *(u64 *)sp = r0; + r0 = (u64)&&return0055; + goto fetchdoublefloat; +return0055: + r0 = *(u64 *)sp; + LDT(1, f1, processor->fp0); + goto g7541; + +g7570: + if (_trace) printf("g7570:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7575: + if (_trace) printf("g7575:\n"); + if (t12 == 0) + goto g7548; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQT(2, f2, f31, 2, f2); + goto g7542; + +g7568: + if (_trace) printf("g7568:\n"); + +g7567: + if (_trace) printf("g7567:\n"); + /* Here for all other cases */ + +g7547: + if (_trace) printf("g7547:\n"); + +g7545: + if (_trace) printf("g7545:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g7549; + +g7548: + if (_trace) printf("g7548:\n"); + t1 = t3; + goto g7545; + +g7549: + if (_trace) printf("g7549:\n"); + +g7553: + if (_trace) printf("g7553:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7581: + if (_trace) printf("g7581:\n"); + if (t12 == 0) + goto g7554; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g7541; + +g7554: + if (_trace) printf("g7554:\n"); + t12 = (t11 == Type_DoubleFloat) ? 1 : 0; + +g7582: + if (_trace) printf("g7582:\n"); + if (t12 == 0) + goto g7548; + /* Here if argument TypeDoubleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQT(1, f1, f31, 1, f1); + goto g7543; + +/* end BinaryArithmeticDivisionPrelude */ +/* start DoQuotient */ + + /* Halfword operand from stack instruction - DoQuotient */ + /* arg2 has the preloaded 8 bit operand. */ + +doquotient: + if (_trace) printf("doquotient:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoQuotientIM: + if (_trace) printf("DoQuotientIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindoquotient; +#ifdef TRACING +#endif + +DoQuotientSP: + if (_trace) printf("DoQuotientSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindoquotient; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindoquotient; +#endif + +DoQuotientLP: + if (_trace) printf("DoQuotientLP:\n"); +#ifdef TRACING + goto begindoquotient; +#endif + +DoQuotientFP: + if (_trace) printf("DoQuotientFP:\n"); + +begindoquotient: + if (_trace) printf("begindoquotient:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + r0 = (u64)&&return0056; + goto binaryarithmeticdivisionprelude; +return0056: + /* Strip off any CDR code bits. */ + t8 = t3 & 63; + t9 = (t8 == Type_Fixnum) ? 1 : 0; + +g7588: + if (_trace) printf("g7588:\n"); + if (t9 == 0) + goto g7584; + /* Here if argument TypeFixnum */ + DIVT(0, f0, 1, f1, 2, f2); + CVTTQVC(0, f0, f31, 0, f0); + CVTQLV(0, f0, f31, 0, f0); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + +g7583: + if (_trace) printf("g7583:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + goto cachevalid; + +g7584: + if (_trace) printf("g7584:\n"); + t9 = (t8 == Type_SingleFloat) ? 1 : 0; + +g7589: + if (_trace) printf("g7589:\n"); + if (t9 == 0) + goto g7585; + /* Here if argument TypeSingleFloat */ + DIVS(0, f0, 1, f1, 2, f2); /* divs */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + goto g7583; + +g7585: + if (_trace) printf("g7585:\n"); + t9 = (t8 == Type_DoubleFloat) ? 1 : 0; + +g7590: + if (_trace) printf("g7590:\n"); + if (t9 == 0) + goto g7583; + /* Here if argument TypeDoubleFloat */ + DIVT(0, f0, 1, f1, 2, f2); + STT( (u64 *)&processor->fp0, 0, f0 ); + r0 = (u64)&&return0057; + goto consdoublefloat; +return0057: + t8 = Type_DoubleFloat; + *(u32 *)iSP = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + goto g7583; + +/* end DoQuotient */ + /* End of Halfword operand from stack instruction - DoQuotient */ +/* start DoRationalQuotient */ + + /* Halfword operand from stack instruction - DoRationalQuotient */ + /* arg2 has the preloaded 8 bit operand. */ + +dorationalquotient: + if (_trace) printf("dorationalquotient:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoRationalQuotientIM: + if (_trace) printf("DoRationalQuotientIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindorationalquotient; +#ifdef TRACING +#endif + +DoRationalQuotientSP: + if (_trace) printf("DoRationalQuotientSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindorationalquotient; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindorationalquotient; +#endif + +DoRationalQuotientLP: + if (_trace) printf("DoRationalQuotientLP:\n"); +#ifdef TRACING + goto begindorationalquotient; +#endif + +DoRationalQuotientFP: + if (_trace) printf("DoRationalQuotientFP:\n"); + +begindorationalquotient: + if (_trace) printf("begindorationalquotient:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + r0 = (u64)&&return0058; + goto binaryarithmeticdivisionprelude; +return0058: + /* Strip off any CDR code bits. */ + t8 = t3 & 63; + t9 = (t8 == Type_Fixnum) ? 1 : 0; + +g7596: + if (_trace) printf("g7596:\n"); + if (t9 == 0) + goto g7592; + /* Here if argument TypeFixnum */ + /* x86_64 replacement for fixnum rational quotient */ + asm("movl %k2,%%eax \n\t" // get arg1 into res + "cdq \n\t" // sign extend into edx:eax + "idivl %k3 \n\t" // divide by arg2 + "movl %%eax,%k0 \n\t" // result into f0 + "movl %%edx,%k1" // remainder into im1 + : "=mr"(f0),"=rm"(im1) // %0;res, %1:im1 + : "rm"(t2),"rm"(t4) // %2:t2, %3:t4 + : "rax", "rdx", "cc"); // clobbers eax, edx and cc; + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + if (im1) + goto arithmeticexception; + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + +g7591: + if (_trace) printf("g7591:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + goto cachevalid; + +g7592: + if (_trace) printf("g7592:\n"); + t9 = (t8 == Type_SingleFloat) ? 1 : 0; + +g7597: + if (_trace) printf("g7597:\n"); + if (t9 == 0) + goto g7593; + /* Here if argument TypeSingleFloat */ + DIVS(0, f0, 1, f1, 2, f2); /* divs */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + goto g7591; + +g7593: + if (_trace) printf("g7593:\n"); + t9 = (t8 == Type_DoubleFloat) ? 1 : 0; + +g7598: + if (_trace) printf("g7598:\n"); + if (t9 == 0) + goto g7591; + /* Here if argument TypeDoubleFloat */ + DIVT(0, f0, 1, f1, 2, f2); + STT( (u64 *)&processor->fp0, 0, f0 ); + r0 = (u64)&&return0059; + goto consdoublefloat; +return0059: + t8 = Type_DoubleFloat; + *(u32 *)iSP = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + goto g7591; + +/* end DoRationalQuotient */ + /* End of Halfword operand from stack instruction - DoRationalQuotient */ +/* start DoFloor */ + + /* Halfword operand from stack instruction - DoFloor */ + /* arg2 has the preloaded 8 bit operand. */ + +dofloor: + if (_trace) printf("dofloor:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoFloorIM: + if (_trace) printf("DoFloorIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindofloor; +#ifdef TRACING +#endif + +DoFloorSP: + if (_trace) printf("DoFloorSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindofloor; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindofloor; +#endif + +DoFloorLP: + if (_trace) printf("DoFloorLP:\n"); +#ifdef TRACING + goto begindofloor; +#endif + +DoFloorFP: + if (_trace) printf("DoFloorFP:\n"); + +begindofloor: + if (_trace) printf("begindofloor:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + r0 = (u64)&&return0060; + goto binaryarithmeticdivisionprelude; +return0060: + /* use libc function floor for rounding-mode :down */ + { + extern double floor(double); + double c = floor( FLTU64(1, f1) / FLTU64(2, f2) ); + double d = FLTU64(1, f1) - (c * FLTU64(2, f2)) ; + LDS(0, f0, (int)c); + LDT(3, f3, U64FLTT(d)); + } + /* Strip off any CDR code bits. */ + t8 = t3 & 63; + t9 = (t8 == Type_Fixnum) ? 1 : 0; + +g7604: + if (_trace) printf("g7604:\n"); + if (t9 == 0) + goto g7600; + /* Here if argument TypeFixnum */ + CVTTQ(3, f3, f31, 3, f3); + CVTQL(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + +g7599: + if (_trace) printf("g7599:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + goto cachevalid; + +g7600: + if (_trace) printf("g7600:\n"); + t9 = (t8 == Type_SingleFloat) ? 1 : 0; + +g7605: + if (_trace) printf("g7605:\n"); + if (t9 == 0) + goto g7601; + /* Here if argument TypeSingleFloat */ + CVTTS(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + goto g7599; + +g7601: + if (_trace) printf("g7601:\n"); + t9 = (t8 == Type_DoubleFloat) ? 1 : 0; + +g7606: + if (_trace) printf("g7606:\n"); + if (t9 == 0) + goto g7599; + /* Here if argument TypeDoubleFloat */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + STT( (u64 *)&processor->fp0, 3, f3 ); + r0 = (u64)&&return0061; + goto consdoublefloat; +return0061: + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_DoubleFloat; + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto g7599; + +/* end DoFloor */ + /* End of Halfword operand from stack instruction - DoFloor */ +/* start DoCeiling */ + + /* Halfword operand from stack instruction - DoCeiling */ + /* arg2 has the preloaded 8 bit operand. */ + +doceiling: + if (_trace) printf("doceiling:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoCeilingIM: + if (_trace) printf("DoCeilingIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindoceiling; +#ifdef TRACING +#endif + +DoCeilingSP: + if (_trace) printf("DoCeilingSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindoceiling; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindoceiling; +#endif + +DoCeilingLP: + if (_trace) printf("DoCeilingLP:\n"); +#ifdef TRACING + goto begindoceiling; +#endif + +DoCeilingFP: + if (_trace) printf("DoCeilingFP:\n"); + +begindoceiling: + if (_trace) printf("begindoceiling:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + r0 = (u64)&&return0062; + goto binaryarithmeticdivisionprelude; +return0062: + /* use libc function ceil for rounding-mode :up */ + { + extern double ceil(double); + double c = ceil( FLTU64(1, f1) / FLTU64(2, f2) ); + double d = FLTU64(1, f1) - (c * FLTU64(2, f2)) ; + LDS(0, f0, (int)c); + LDT(3, f3, U64FLTT(d)); + } + /* Strip off any CDR code bits. */ + t8 = t3 & 63; + t9 = (t8 == Type_Fixnum) ? 1 : 0; + +g7612: + if (_trace) printf("g7612:\n"); + if (t9 == 0) + goto g7608; + /* Here if argument TypeFixnum */ + CVTTQ(3, f3, f31, 3, f3); + CVTQL(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + +g7607: + if (_trace) printf("g7607:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + goto cachevalid; + +g7608: + if (_trace) printf("g7608:\n"); + t9 = (t8 == Type_SingleFloat) ? 1 : 0; + +g7613: + if (_trace) printf("g7613:\n"); + if (t9 == 0) + goto g7609; + /* Here if argument TypeSingleFloat */ + CVTTS(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + goto g7607; + +g7609: + if (_trace) printf("g7609:\n"); + t9 = (t8 == Type_DoubleFloat) ? 1 : 0; + +g7614: + if (_trace) printf("g7614:\n"); + if (t9 == 0) + goto g7607; + /* Here if argument TypeDoubleFloat */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + STT( (u64 *)&processor->fp0, 3, f3 ); + r0 = (u64)&&return0063; + goto consdoublefloat; +return0063: + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_DoubleFloat; + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto g7607; + +/* end DoCeiling */ + /* End of Halfword operand from stack instruction - DoCeiling */ +/* start DoTruncate */ + + /* Halfword operand from stack instruction - DoTruncate */ + /* arg2 has the preloaded 8 bit operand. */ + +dotruncate: + if (_trace) printf("dotruncate:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoTruncateIM: + if (_trace) printf("DoTruncateIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindotruncate; +#ifdef TRACING +#endif + +DoTruncateSP: + if (_trace) printf("DoTruncateSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindotruncate; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindotruncate; +#endif + +DoTruncateLP: + if (_trace) printf("DoTruncateLP:\n"); +#ifdef TRACING + goto begindotruncate; +#endif + +DoTruncateFP: + if (_trace) printf("DoTruncateFP:\n"); + +begindotruncate: + if (_trace) printf("begindotruncate:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + r0 = (u64)&&return0064; + goto binaryarithmeticdivisionprelude; +return0064: + /* use libc function trunc for rounding-mode :truncate */ + { + extern double trunc(double); + double c = trunc( FLTU64(1, f1) / FLTU64(2, f2) ); + double d = FLTU64(1, f1) - (c * FLTU64(2, f2)) ; + LDS(0, f0, (int)c); + LDT(3, f3, U64FLTT(d)); + } + /* Strip off any CDR code bits. */ + t8 = t3 & 63; + t9 = (t8 == Type_Fixnum) ? 1 : 0; + +g7620: + if (_trace) printf("g7620:\n"); + if (t9 == 0) + goto g7616; + /* Here if argument TypeFixnum */ + CVTTQ(3, f3, f31, 3, f3); + CVTQL(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + +g7615: + if (_trace) printf("g7615:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + goto cachevalid; + +g7616: + if (_trace) printf("g7616:\n"); + t9 = (t8 == Type_SingleFloat) ? 1 : 0; + +g7621: + if (_trace) printf("g7621:\n"); + if (t9 == 0) + goto g7617; + /* Here if argument TypeSingleFloat */ + CVTTS(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + goto g7615; + +g7617: + if (_trace) printf("g7617:\n"); + t9 = (t8 == Type_DoubleFloat) ? 1 : 0; + +g7622: + if (_trace) printf("g7622:\n"); + if (t9 == 0) + goto g7615; + /* Here if argument TypeDoubleFloat */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + STT( (u64 *)&processor->fp0, 3, f3 ); + r0 = (u64)&&return0065; + goto consdoublefloat; +return0065: + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_DoubleFloat; + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto g7615; + +/* end DoTruncate */ + /* End of Halfword operand from stack instruction - DoTruncate */ +/* start DoRound */ + + /* Halfword operand from stack instruction - DoRound */ + /* arg2 has the preloaded 8 bit operand. */ + +doround: + if (_trace) printf("doround:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoRoundIM: + if (_trace) printf("DoRoundIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindoround; +#ifdef TRACING +#endif + +DoRoundSP: + if (_trace) printf("DoRoundSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindoround; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindoround; +#endif + +DoRoundLP: + if (_trace) printf("DoRoundLP:\n"); +#ifdef TRACING + goto begindoround; +#endif + +DoRoundFP: + if (_trace) printf("DoRoundFP:\n"); + +begindoround: + if (_trace) printf("begindoround:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + r0 = (u64)&&return0066; + goto binaryarithmeticdivisionprelude; +return0066: + /* use libc function rint for rounding-mode :round */ + { + extern double rint(double); + double c = rint( FLTU64(1, f1) / FLTU64(2, f2) ); + double d = FLTU64(1, f1) - (c * FLTU64(2, f2)) ; + LDS(0, f0, (int)c); + LDT(3, f3, U64FLTT(d)); + } + /* Strip off any CDR code bits. */ + t8 = t3 & 63; + t9 = (t8 == Type_Fixnum) ? 1 : 0; + +g7628: + if (_trace) printf("g7628:\n"); + if (t9 == 0) + goto g7624; + /* Here if argument TypeFixnum */ + CVTTQ(3, f3, f31, 3, f3); + CVTQL(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + +g7623: + if (_trace) printf("g7623:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + goto cachevalid; + +g7624: + if (_trace) printf("g7624:\n"); + t9 = (t8 == Type_SingleFloat) ? 1 : 0; + +g7629: + if (_trace) printf("g7629:\n"); + if (t9 == 0) + goto g7625; + /* Here if argument TypeSingleFloat */ + CVTTS(3, f3, f31, 3, f3); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + STS( (u32 *)(iSP + 8), 3, f3 ); + iSP = iSP + 8; + goto g7623; + +g7625: + if (_trace) printf("g7625:\n"); + t9 = (t8 == Type_DoubleFloat) ? 1 : 0; + +g7630: + if (_trace) printf("g7630:\n"); + if (t9 == 0) + goto g7623; + /* Here if argument TypeDoubleFloat */ + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + STT( (u64 *)&processor->fp0, 3, f3 ); + r0 = (u64)&&return0067; + goto consdoublefloat; +return0067: + t8 = Type_Fixnum; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 0, f0 ); + t8 = Type_DoubleFloat; + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + goto g7623; + +/* end DoRound */ + /* End of Halfword operand from stack instruction - DoRound */ + /* Other arithmetic. */ +/* start DoMax */ + + /* Halfword operand from stack instruction - DoMax */ + /* arg2 has the preloaded 8 bit operand. */ + +domax: + if (_trace) printf("domax:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoMaxIM: + if (_trace) printf("DoMaxIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindomax; +#ifdef TRACING +#endif + +DoMaxSP: + if (_trace) printf("DoMaxSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindomax; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindomax; +#endif + +DoMaxLP: + if (_trace) printf("DoMaxLP:\n"); +#ifdef TRACING + goto begindomax; +#endif + +DoMaxFP: + if (_trace) printf("DoMaxFP:\n"); + +begindomax: + if (_trace) printf("begindomax:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + LDS(1, f1, *(u32 *)iSP ); + /* ARG1 tag */ + t1 = (u32)(arg6 >> ((4&7)*8)); + /* ARG2 tag */ + t3 = *(s32 *)(arg1 + 4); + /* ARG1 data */ + t2 = (s32)arg6; + /* ARG2 data */ + t4 = *(s32 *)arg1; + LDS(2, f2, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t9 = t1 & 63; + /* Strip off any CDR code bits. */ + t11 = t3 & 63; + t10 = (t9 == Type_Fixnum) ? 1 : 0; + +g7654: + if (_trace) printf("g7654:\n"); + if (t10 == 0) + goto g7638; + /* Here if argument TypeFixnum */ + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7643: + if (_trace) printf("g7643:\n"); + if (t12 == 0) + goto g7640; + /* Here if argument TypeFixnum */ + t5 = t2 - t4; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + if ((s64)t5 > 0) + t4 = t2; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* We know temp2 has CDRNext/TypeFixnum */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t9; + goto cachevalid; + +g7640: + if (_trace) printf("g7640:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7644: + if (_trace) printf("g7644:\n"); + if (t12 == 0) + goto g7635; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQS(1, f1, f31, 1, f1); + goto g7632; + +g7639: + if (_trace) printf("g7639:\n"); + +g7638: + if (_trace) printf("g7638:\n"); + t10 = (t9 == Type_SingleFloat) ? 1 : 0; + +g7655: + if (_trace) printf("g7655:\n"); + if (t10 == 0) + goto g7645; + /* Here if argument TypeSingleFloat */ + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7650: + if (_trace) printf("g7650:\n"); + if (t12 == 0) + goto g7647; + /* Here if argument TypeSingleFloat */ + +g7632: + if (_trace) printf("g7632:\n"); + /* NIL */ + SUBS(0, f0, 1, f1, 2, f2); /* subs */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + if (FLTU64(0, f0) > 0.0) + f2 = f1; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 2, f2 ); + goto cachevalid; + +g7647: + if (_trace) printf("g7647:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7651: + if (_trace) printf("g7651:\n"); + if (t12 == 0) + goto g7635; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQS(2, f2, f31, 2, f2); + goto g7632; + +g7646: + if (_trace) printf("g7646:\n"); + +g7645: + if (_trace) printf("g7645:\n"); + /* Here for all other cases */ + +g7634: + if (_trace) printf("g7634:\n"); + +g7631: + if (_trace) printf("g7631:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g7636; + +g7635: + if (_trace) printf("g7635:\n"); + t1 = t3; + goto g7631; + +g7636: + if (_trace) printf("g7636:\n"); + +g7637: + if (_trace) printf("g7637:\n"); + +/* end DoMax */ + /* End of Halfword operand from stack instruction - DoMax */ +/* start DoMin */ + + /* Halfword operand from stack instruction - DoMin */ + /* arg2 has the preloaded 8 bit operand. */ + +domin: + if (_trace) printf("domin:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoMinIM: + if (_trace) printf("DoMinIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg1 = arg2 << 56; + arg2 = zero; + /* Rest of sign extension */ + arg1 = (s64)arg1 >> 56; + *(u32 *)&processor->immediate_arg = arg1; + arg1 = (u64)&processor->immediate_arg; + goto begindomin; +#ifdef TRACING +#endif + +DoMinSP: + if (_trace) printf("DoMinSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindomin; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindomin; +#endif + +DoMinLP: + if (_trace) printf("DoMinLP:\n"); +#ifdef TRACING + goto begindomin; +#endif + +DoMinFP: + if (_trace) printf("DoMinFP:\n"); + +begindomin: + if (_trace) printf("begindomin:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + LDS(1, f1, *(u32 *)iSP ); + /* ARG1 tag */ + t1 = (u32)(arg6 >> ((4&7)*8)); + /* ARG2 tag */ + t3 = *(s32 *)(arg1 + 4); + /* ARG1 data */ + t2 = (s32)arg6; + /* ARG2 data */ + t4 = *(s32 *)arg1; + LDS(2, f2, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t9 = t1 & 63; + /* Strip off any CDR code bits. */ + t11 = t3 & 63; + t10 = (t9 == Type_Fixnum) ? 1 : 0; + +g7679: + if (_trace) printf("g7679:\n"); + if (t10 == 0) + goto g7663; + /* Here if argument TypeFixnum */ + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7668: + if (_trace) printf("g7668:\n"); + if (t12 == 0) + goto g7665; + /* Here if argument TypeFixnum */ + t5 = t2 - t4; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + if ((s64)t5 < 0) + t4 = t2; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* We know temp2 has CDRNext/TypeFixnum */ + *(u32 *)iSP = t4; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t9; + goto cachevalid; + +g7665: + if (_trace) printf("g7665:\n"); + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7669: + if (_trace) printf("g7669:\n"); + if (t12 == 0) + goto g7660; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQS(1, f1, f31, 1, f1); + goto g7657; + +g7664: + if (_trace) printf("g7664:\n"); + +g7663: + if (_trace) printf("g7663:\n"); + t10 = (t9 == Type_SingleFloat) ? 1 : 0; + +g7680: + if (_trace) printf("g7680:\n"); + if (t10 == 0) + goto g7670; + /* Here if argument TypeSingleFloat */ + t12 = (t11 == Type_SingleFloat) ? 1 : 0; + +g7675: + if (_trace) printf("g7675:\n"); + if (t12 == 0) + goto g7672; + /* Here if argument TypeSingleFloat */ + +g7657: + if (_trace) printf("g7657:\n"); + /* NIL */ + SUBS(0, f0, 1, f1, 2, f2); /* subs */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + if (FLTU64(0, f0) < 0.0) + f2 = f1; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + t8 = Type_SingleFloat; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t8; + STS( (u32 *)iSP, 2, f2 ); + goto cachevalid; + +g7672: + if (_trace) printf("g7672:\n"); + t12 = (t11 == Type_Fixnum) ? 1 : 0; + +g7676: + if (_trace) printf("g7676:\n"); + if (t12 == 0) + goto g7660; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQS(2, f2, f31, 2, f2); + goto g7657; + +g7671: + if (_trace) printf("g7671:\n"); + +g7670: + if (_trace) printf("g7670:\n"); + /* Here for all other cases */ + +g7659: + if (_trace) printf("g7659:\n"); + +g7656: + if (_trace) printf("g7656:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g7661; + +g7660: + if (_trace) printf("g7660:\n"); + t1 = t3; + goto g7656; + +g7661: + if (_trace) printf("g7661:\n"); + +g7662: + if (_trace) printf("g7662:\n"); + +/* end DoMin */ + /* End of Halfword operand from stack instruction - DoMin */ +/* start DoMultiplyDouble */ + + /* Halfword operand from stack instruction - DoMultiplyDouble */ + +domultiplydouble: + if (_trace) printf("domultiplydouble:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoMultiplyDoubleIM: + if (_trace) printf("DoMultiplyDoubleIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g7681: + if (_trace) printf("g7681:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindomultiplydouble; +#ifdef TRACING +#endif + +DoMultiplyDoubleSP: + if (_trace) printf("DoMultiplyDoubleSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdomultiplydouble; +#endif + +DoMultiplyDoubleLP: + if (_trace) printf("DoMultiplyDoubleLP:\n"); +#ifdef TRACING + goto headdomultiplydouble; +#endif + +DoMultiplyDoubleFP: + if (_trace) printf("DoMultiplyDoubleFP:\n"); + +headdomultiplydouble: + if (_trace) printf("headdomultiplydouble:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindomultiplydouble: + if (_trace) printf("begindomultiplydouble:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* ARG2 tag */ + t2 = arg1 >> 32; + /* ARG1 data, sign extended */ + t3 = *(s32 *)iSP; + /* ARG2 data, sign extended */ + t4 = (s32)arg1 + (s32)0; + /* ARG1 tag */ + t1 = *(s32 *)(iSP + 4); + /* TagType. */ + /* Strip CDR code if any. */ + t1 = t1 & 63; + t1 = t1 - Type_Fixnum; + /* TagType. */ + /* Strip CDR code if any. */ + t2 = t2 & 63; + /* Perform the 63 bit multiply. */ + t5 = t3 * t4; + t2 = t2 - Type_Fixnum; + if (t1 != 0) + goto muldexc; + if (t2 != 0) + goto muldexc; + /* Get the low 32 bit half. */ + t6 = (u32)t5; + /* Get the high 32 bit half. */ + t5 = (u32)(t5 >> ((4&7)*8)); + /* Put the result back on the stack */ + *(u32 *)iSP = t6; + t1 = Type_Fixnum; + /* Push high order half */ + *(u32 *)(iSP + 8) = t5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +muldexc: + if (_trace) printf("muldexc:\n"); + arg5 = 0; + arg2 = 80; + goto illegaloperand; + +/* end DoMultiplyDouble */ + /* End of Halfword operand from stack instruction - DoMultiplyDouble */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunmath.as */ diff --git a/stub/ifunmove.c b/stub/ifunmove.c new file mode 100644 index 0000000..6b56ec4 --- /dev/null +++ b/stub/ifunmove.c @@ -0,0 +1,419 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunmove.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Data movement. */ +/* start DoPushNNils */ + + /* Halfword operand from stack instruction - DoPushNNils */ + /* arg2 has the preloaded 8 bit operand. */ + +dopushnnils: + if (_trace) printf("dopushnnils:\n"); +#ifdef TRACING +#endif + +DoPushNNilsSP: + if (_trace) printf("DoPushNNilsSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdopushnnils; +#endif + +DoPushNNilsLP: + if (_trace) printf("DoPushNNilsLP:\n"); +#ifdef TRACING + goto headdopushnnils; +#endif + +DoPushNNilsFP: + if (_trace) printf("DoPushNNilsFP:\n"); + +headdopushnnils: + if (_trace) printf("headdopushnnils:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindopushnnils: + if (_trace) printf("begindopushnnils:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get the data */ + arg2 = (u32)arg1; + /* and the tag */ + t1 = arg1 >> 32; + t5 = t1 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto pushnnbadop; +#ifdef TRACING + goto DoPushNNilsIM; +#endif + +DoPushNNilsIM: + if (_trace) printf("DoPushNNilsIM:\n"); + /* Current stack cache limit (words) */ + t4 = *(s32 *)&processor->scovlimit; + t1 = zero + 128; + /* Alpha base of stack cache */ + t2 = *(u64 *)&(processor->stackcachedata); + /* Account for what we're about to push */ + t1 = t1 + arg2; + /* SCA of desired end of cache */ + t1 = (t1 * 8) + iSP; + /* SCA of current end of cache */ + t2 = (t4 * 8) + t2; + t4 = ((s64)t1 <= (s64)t2) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t4 == 0) + goto stackcacheoverflowhandler; + arg6 = *(u64 *)&(processor->niladdress); + goto pushnnilsl2; + +pushnnilsl1: + if (_trace) printf("pushnnilsl1:\n"); + /* Push NIL */ + *(u64 *)(iSP + 8) = arg6; + iSP = iSP + 8; + arg2 = arg2 - 1; + +pushnnilsl2: + if ((s64)arg2 > 0) + goto pushnnilsl1; + goto NEXTINSTRUCTION; + +pushnnbadop: + if (_trace) printf("pushnnbadop:\n"); + arg5 = 0; + arg2 = 63; + goto illegaloperand; + +/* end DoPushNNils */ + /* End of Halfword operand from stack instruction - DoPushNNils */ +/* start DoPushAddressSpRelative */ + + /* Halfword operand from stack instruction - DoPushAddressSpRelative */ + /* arg2 has the preloaded 8 bit operand. */ + +dopushaddresssprelative: + if (_trace) printf("dopushaddresssprelative:\n"); +#ifdef TRACING +#endif + +DoPushAddressSpRelativeIM: + if (_trace) printf("DoPushAddressSpRelativeIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindopushaddresssprelative; +#ifdef TRACING +#endif + +DoPushAddressSpRelativeSP: + if (_trace) printf("DoPushAddressSpRelativeSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdopushaddresssprelative; +#endif + +DoPushAddressSpRelativeLP: + if (_trace) printf("DoPushAddressSpRelativeLP:\n"); +#ifdef TRACING + goto headdopushaddresssprelative; +#endif + +DoPushAddressSpRelativeFP: + if (_trace) printf("DoPushAddressSpRelativeFP:\n"); + +headdopushaddresssprelative: + if (_trace) printf("headdopushaddresssprelative:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindopushaddresssprelative: + if (_trace) printf("begindopushaddresssprelative:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* SP before any popping */ + t4 = *(u64 *)&(processor->restartsp); + t1 = arg1 >> 32; + arg1 = (u32)arg1; + /* Base of the stack cache */ + t6 = *(u64 *)&(processor->stackcachebasevma); + /* THe stack cache data block */ + t7 = *(u64 *)&(processor->stackcachedata); + /* Strip off any CDR code bits. */ + t2 = t1 & 63; + t3 = (t2 == Type_Fixnum) ? 1 : 0; + +g7983: + if (_trace) printf("g7983:\n"); + if (t3 == 0) + goto g7980; + /* Here if argument TypeFixnum */ + arg1 = (arg1 * 8) + 8; + /* Compute stack relative pointer */ + t5 = t4 - arg1; + /* Index into stack data */ + t5 = t5 - t7; + /* Convert to word index */ + t5 = t5 >> 3; + /* Convert to an ivory word address */ + t5 = t6 + t5; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t6 = Type_Locative; + *(u32 *)(iSP + 8) = t5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t6; + iSP = iSP + 8; + goto cachevalid; + +g7980: + if (_trace) printf("g7980:\n"); + /* Here for all other cases */ + arg5 = 0; + arg2 = 63; + goto illegaloperand; + +g7979: + if (_trace) printf("g7979:\n"); + +/* end DoPushAddressSpRelative */ + /* End of Halfword operand from stack instruction - DoPushAddressSpRelative */ +/* start DoStackBlt */ + + /* Halfword operand from stack instruction - DoStackBlt */ + /* arg2 has the preloaded 8 bit operand. */ + +dostackblt: + if (_trace) printf("dostackblt:\n"); +#ifdef TRACING +#endif + +DoStackBltIM: + if (_trace) printf("DoStackBltIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindostackblt; +#ifdef TRACING +#endif + +DoStackBltSP: + if (_trace) printf("DoStackBltSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdostackblt; +#endif + +DoStackBltLP: + if (_trace) printf("DoStackBltLP:\n"); +#ifdef TRACING + goto headdostackblt; +#endif + +DoStackBltFP: + if (_trace) printf("DoStackBltFP:\n"); + +headdostackblt: + if (_trace) printf("headdostackblt:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindostackblt: + if (_trace) printf("begindostackblt:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Destination locative */ + t3 = *(s32 *)iSP; + /* Destination locative */ + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t3 = (u32)t3; + t1 = (u32)arg1; + /* Convert VMA to stack cache address */ + t4 = *(u64 *)&(processor->stackcachebasevma); + arg1 = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t4 = t1 - t4; + /* reconstruct SCA */ + arg1 = (t4 * 8) + arg1; + /* Base of the stack cache */ + t4 = *(u64 *)&(processor->stackcachebasevma); + /* End ofthe stack cache */ + t5 = *(u64 *)&(processor->stackcachetopvma); + /* THe stack cache data block */ + t1 = *(u64 *)&(processor->stackcachedata); + /* BAse of Stack Cache. */ + t6 = t3 - t4; + /* Top of Stack Cache. */ + t7 = t3 - t5; + /* J. if vma below stack cache */ + if ((s64)t6 < 0) + goto stkbltexc; + /* J. if vma above stack cache */ + if ((s64)t7 >= 0) + goto stkbltexc; + /* Compute the stackcache address */ + t6 = (t6 * 8) + t1; + goto stkbltloopend; + +stkbltloop: + if (_trace) printf("stkbltloop:\n"); + /* Advance Source */ + arg1 = arg1 + 8; + /* Advance destination */ + t6 = t6 + 8; + +stkbltloopend: + /* Read a word from the source */ + t1 = *(u64 *)arg1; + t4 = arg1 - iSP; + /* copy the word */ + *(u64 *)t6 = t1; + /* J. if sourse not stack top */ + if (t4 != 0) + goto stkbltloop; + /* Update the SP to point at the last written location */ + iSP = t6; + goto NEXTINSTRUCTION; + +stkbltexc: + if (_trace) printf("stkbltexc:\n"); + arg5 = 0; + arg2 = 73; + goto illegaloperand; + +/* end DoStackBlt */ + /* End of Halfword operand from stack instruction - DoStackBlt */ +/* start DoStackBltAddress */ + + /* Halfword operand from stack instruction - DoStackBltAddress */ + /* arg2 has the preloaded 8 bit operand. */ + +dostackbltaddress: + if (_trace) printf("dostackbltaddress:\n"); +#ifdef TRACING +#endif + +DoStackBltAddressSP: + if (_trace) printf("DoStackBltAddressSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindostackbltaddress; +#endif + +DoStackBltAddressLP: + if (_trace) printf("DoStackBltAddressLP:\n"); +#ifdef TRACING + goto begindostackbltaddress; +#endif + +DoStackBltAddressFP: + if (_trace) printf("DoStackBltAddressFP:\n"); + +begindostackbltaddress: + if (_trace) printf("begindostackbltaddress:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Destination locative */ + t3 = *(s32 *)iSP; + /* Destination locative */ + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t3 = (u32)t3; + /* Base of the stack cache */ + t4 = *(u64 *)&(processor->stackcachebasevma); + /* End ofthe stack cache */ + t5 = *(u64 *)&(processor->stackcachetopvma); + /* THe stack cache data block */ + t1 = *(u64 *)&(processor->stackcachedata); + /* Base of Stack Cache. */ + t6 = t3 - t4; + /* Top of Stack Cache. */ + t7 = t3 - t5; + /* J. if vma below stack cache */ + if ((s64)t6 < 0) + goto stkbltadrexc; + /* J. if vma above stack cache */ + if ((s64)t7 >= 0) + goto stkbltadrexc; + /* Compute the stackcache address */ + t6 = (t6 * 8) + t1; + goto stkbltaddloopend; + +stkbltaddloop: + if (_trace) printf("stkbltaddloop:\n"); + /* Advance Source */ + arg1 = arg1 + 8; + /* Advance destination */ + t6 = t6 + 8; + +stkbltaddloopend: + /* Read a word from the source */ + t1 = *(u64 *)arg1; + t4 = arg1 - iSP; + /* copy the word */ + *(u64 *)t6 = t1; + /* J. if sourse not stack top */ + if (t4 != 0) + goto stkbltaddloop; + /* Update the SP to point at the last written location */ + iSP = t6; + goto NEXTINSTRUCTION; + +stkbltadrexc: + if (_trace) printf("stkbltadrexc:\n"); + arg5 = 0; + arg2 = 73; + goto illegaloperand; +#ifdef TRACING +#endif + +DoStackBltAddressIM: + goto doistageerror; + +/* end DoStackBltAddress */ + /* End of Halfword operand from stack instruction - DoStackBltAddress */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunmove.as */ diff --git a/stub/ifunpred.c b/stub/ifunpred.c new file mode 100644 index 0000000..1a2668c --- /dev/null +++ b/stub/ifunpred.c @@ -0,0 +1,763 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunpred.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Predicates. */ +/* start DoEql */ + + /* Halfword operand from stack instruction - DoEql */ + /* arg2 has the preloaded 8 bit operand. */ + +doeql: + if (_trace) printf("doeql:\n"); +#ifdef TRACING +#endif + +DoEqlSP: + if (_trace) printf("DoEqlSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoeql; +#endif + +DoEqlLP: + if (_trace) printf("DoEqlLP:\n"); +#ifdef TRACING + goto headdoeql; +#endif + +DoEqlFP: + if (_trace) printf("DoEqlFP:\n"); + +headdoeql: + if (_trace) printf("headdoeql:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoeql: + if (_trace) printf("begindoeql:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + arg6 = arg3 >> 12; + /* Load arg1 into t3 */ + t3 = *(u64 *)iSP; + /* Low part of EQ-NOT-EQL mask */ + t4 = zero + -2048; + t11 = *(u64 *)&(processor->niladdress); + /* High part of EQ-NOT-EQL mask */ + t4 = t4 + ((1) << 16); + /* Assume result will be T */ + t12 = *(u64 *)&(processor->taddress); + t5 = arg1 ^ t3; + /* Shift left to lose CDRCODE. */ + t5 = t5 << 26; + /* 1 if no-pop, 0 if pop */ + arg6 = arg6 & 1; + if (t5 == 0) + goto eqldone; + /* They are not EQ, if types different or not numeric return nil */ + /* Get the tag alone */ + t5 = t5 >> 58; + /* Now assume result will be NIL */ + t12 = t11; + /* Return NIL if tags different */ + if (t5 != 0) + goto eqldone; + /* Get tag, check for numeric */ + t3 = t3 >> 32; + /* TagType. */ + t3 = t3 & 63; + /* Type is now a bit mask */ + t4 = t4 >> (t3 & 63); + /* If funny numeric type, exception */ + if (t4 & 1) + goto eqlexc; + +eqldone: + if (_trace) printf("eqldone:\n"); + /* Either a stack-push or a stack-write */ + iSP = (arg6 * 8) + iSP; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)iSP = t12; + goto cachevalid; +#ifdef TRACING + goto DoEqlIM; +#endif + +DoEqlIM: + if (_trace) printf("DoEqlIM:\n"); + arg2 = arg2 << 56; + /* t4=tag t3=data */ + t4 = *(s32 *)(iSP + 4); + t3 = *(s32 *)iSP; + arg6 = arg3 >> 12; + /* Sign extension of arg2 is complete */ + arg2 = (s64)arg2 >> 56; + t3 = (u32)t3; + t11 = *(u64 *)&(processor->niladdress); + /* TagType. */ + t4 = t4 & 63; + t12 = *(u64 *)&(processor->taddress); + arg2 = (s32)t3 - (s32)arg2; + t4 = t4 ^ Type_Fixnum; + /* 1 if no-pop, 0 if pop */ + arg6 = arg6 & 1; + t4 = arg2 | t4; + /* Either a stack-push or a stack-write */ + iSP = (arg6 * 8) + iSP; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + if (t4 == 0) + t11 = t12; + /* Yes Virginia, this does dual issue with above */ + *(u64 *)iSP = t11; + goto cachevalid; + +eqlexc: + if (_trace) printf("eqlexc:\n"); + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto exception; + +/* end DoEql */ + /* End of Halfword operand from stack instruction - DoEql */ +/* start DoGreaterp */ + + /* Halfword operand from stack instruction - DoGreaterp */ + /* arg2 has the preloaded 8 bit operand. */ + +dogreaterp: + if (_trace) printf("dogreaterp:\n"); +#ifdef TRACING +#endif + +DoGreaterpSP: + if (_trace) printf("DoGreaterpSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindogreaterp; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindogreaterp; +#endif + +DoGreaterpLP: + if (_trace) printf("DoGreaterpLP:\n"); +#ifdef TRACING + goto begindogreaterp; +#endif + +DoGreaterpFP: + if (_trace) printf("DoGreaterpFP:\n"); + +begindogreaterp: + if (_trace) printf("begindogreaterp:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + t7 = arg3 >> 12; + t12 = *(u64 *)&(processor->taddress); + /* Get ARG1 tag */ + arg3 = (u32)(arg6 >> ((4&7)*8)); + /* t1 is tag of arg2 */ + t1 = *(s32 *)(arg1 + 4); + LDS(1, f1, *(u32 *)iSP ); + t7 = t7 & 1; + arg2 = *(s32 *)arg1; + arg4 = (s32)arg6; + LDS(2, f2, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t5 = arg3 & 63; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t6 = (t5 == Type_Fixnum) ? 1 : 0; + +g8001: + if (_trace) printf("g8001:\n"); + if (t6 == 0) + goto g7989; + /* Here if argument TypeFixnum */ + t3 = (t4 == Type_Fixnum) ? 1 : 0; + +g7993: + if (_trace) printf("g7993:\n"); + if (t3 == 0) + goto g7984; + /* Here if argument TypeFixnum */ + t2 = arg4 - arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Pop/No-pop */ + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if ((s64)t2 > 0) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g7990: + if (_trace) printf("g7990:\n"); + +g7989: + if (_trace) printf("g7989:\n"); + t6 = (t5 == Type_SingleFloat) ? 1 : 0; + +g8002: + if (_trace) printf("g8002:\n"); + if (t6 == 0) + goto g7994; + /* Here if argument TypeSingleFloat */ + t3 = (t4 == Type_SingleFloat) ? 1 : 0; + +g7998: + if (_trace) printf("g7998:\n"); + if (t3 == 0) + goto g7984; + /* Here if argument TypeSingleFloat */ + +greaterpmmexcfltflt: + if (_trace) printf("greaterpmmexcfltflt:\n"); + SETFLTT(3,f3, FLTU64(1,f1) <= FLTU64(2,f2) ? 2.0:0); + /* Force the trap to occur here */ + /* trapb force the trap to occur here */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)iSP = t12; + if (FLTU64(3, f3) == 0.0) + goto cachevalid; + /* Didn't branch, answer is NIL */ + *(u64 *)iSP = t11; + goto cachevalid; + +g7995: + if (_trace) printf("g7995:\n"); + +g7994: + if (_trace) printf("g7994:\n"); + /* Here for all other cases */ + +g7984: + if (_trace) printf("g7984:\n"); + goto greaterpmmexc; + +g7988: + if (_trace) printf("g7988:\n"); +#ifdef TRACING + goto DoGreaterpIM; +#endif + +DoGreaterpIM: + if (_trace) printf("DoGreaterpIM:\n"); + t11 = *(u64 *)&(processor->niladdress); + /* First half of sign extension */ + arg2 = arg2 << 56; + t12 = *(u64 *)&(processor->taddress); + t7 = arg3 >> 12; + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (s32)arg6; + /* Second half of sign extension */ + arg2 = (s64)arg2 >> 56; + t7 = t7 & 1; + /* Strip off any CDR code bits. */ + t3 = arg3 & 63; + t4 = (t3 == Type_Fixnum) ? 1 : 0; + +g8007: + if (_trace) printf("g8007:\n"); + if (t4 == 0) + goto g8004; + /* Here if argument TypeFixnum */ + t2 = arg4 - arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if ((s64)t2 > 0) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g8004: + if (_trace) printf("g8004:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8003: + if (_trace) printf("g8003:\n"); + +/* end DoGreaterp */ + /* End of Halfword operand from stack instruction - DoGreaterp */ +/* start DoLogtest */ + + /* Halfword operand from stack instruction - DoLogtest */ + /* arg2 has the preloaded 8 bit operand. */ + +dologtest: + if (_trace) printf("dologtest:\n"); +#ifdef TRACING +#endif + +DoLogtestSP: + if (_trace) printf("DoLogtestSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + if (arg2 != 0) + goto begindologtest; + /* SP-pop, Reload TOS */ + arg6 = *(u64 *)arg4; + /* SP-pop mode */ + arg1 = iSP; + /* Adjust SP */ + iSP = arg4; +#ifdef TRACING + goto begindologtest; +#endif + +DoLogtestLP: + if (_trace) printf("DoLogtestLP:\n"); +#ifdef TRACING + goto begindologtest; +#endif + +DoLogtestFP: + if (_trace) printf("DoLogtestFP:\n"); + +begindologtest: + if (_trace) printf("begindologtest:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + t11 = *(u64 *)&(processor->niladdress); + t7 = arg3 >> 12; + t12 = *(u64 *)&(processor->taddress); + /* Get ARG1 tag */ + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg2 = *(s32 *)arg1; + LDS(1, f1, *(u32 *)iSP ); + t7 = t7 & 1; + /* t1 is tag of arg2 */ + t1 = *(s32 *)(arg1 + 4); + arg4 = (u32)arg6; + arg2 = (u32)arg2; + LDS(2, f2, *(u32 *)arg1 ); + /* Strip off any CDR code bits. */ + t5 = arg3 & 63; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t6 = (t5 == Type_Fixnum) ? 1 : 0; + +g8020: + if (_trace) printf("g8020:\n"); + if (t6 == 0) + goto g8013; + /* Here if argument TypeFixnum */ + t3 = (t4 == Type_Fixnum) ? 1 : 0; + +g8017: + if (_trace) printf("g8017:\n"); + if (t3 == 0) + goto g8010; + /* Here if argument TypeFixnum */ + t2 = arg4 & arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + /* Pop/No-pop */ + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if (t2) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g8014: + if (_trace) printf("g8014:\n"); + +g8013: + if (_trace) printf("g8013:\n"); + /* Here for all other cases */ + +g8009: + if (_trace) printf("g8009:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g8011; + +g8010: + if (_trace) printf("g8010:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8011: + if (_trace) printf("g8011:\n"); + +g8012: + if (_trace) printf("g8012:\n"); +#ifdef TRACING + goto DoLogtestIM; +#endif + +DoLogtestIM: + if (_trace) printf("DoLogtestIM:\n"); + t11 = *(u64 *)&(processor->niladdress); + /* First half of sign extension */ + arg2 = arg2 << 56; + t12 = *(u64 *)&(processor->taddress); + t7 = arg3 >> 12; + arg3 = (u32)(arg6 >> ((4&7)*8)); + arg4 = (s32)arg6; + /* Second half of sign extension */ + arg2 = (s64)arg2 >> 56; + t7 = t7 & 1; + /* Strip off any CDR code bits. */ + t3 = arg3 & 63; + t4 = (t3 == Type_Fixnum) ? 1 : 0; + +g8025: + if (_trace) printf("g8025:\n"); + if (t4 == 0) + goto g8022; + /* Here if argument TypeFixnum */ + t2 = arg4 & arg2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iSP = (t7 * 8) + iSP; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* T if the test succeeds */ + if (t2) + t11 = t12; + *(u64 *)iSP = t11; + goto cachevalid; + +g8022: + if (_trace) printf("g8022:\n"); + /* Here for all other cases */ + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8021: + if (_trace) printf("g8021:\n"); + +/* end DoLogtest */ + /* End of Halfword operand from stack instruction - DoLogtest */ +/* start EqualNumberMMExc */ + + +equalnumbermmexc: + if (_trace) printf("equalnumbermmexc:\n"); + /* Strip off any CDR code bits. */ + t5 = arg3 & 63; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t6 = (t5 == Type_Fixnum) ? 1 : 0; + +g8043: + if (_trace) printf("g8043:\n"); + if (t6 == 0) + goto g8031; + /* Here if argument TypeFixnum */ + t3 = (t4 == Type_SingleFloat) ? 1 : 0; + +g8035: + if (_trace) printf("g8035:\n"); + if (t3 == 0) + goto g8028; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQS(1, f1, f31, 1, f1); + goto equalnumbermmexcfltflt; + +g8032: + if (_trace) printf("g8032:\n"); + +g8031: + if (_trace) printf("g8031:\n"); + t6 = (t5 == Type_SingleFloat) ? 1 : 0; + +g8044: + if (_trace) printf("g8044:\n"); + if (t6 == 0) + goto g8036; + /* Here if argument TypeSingleFloat */ + t3 = (t4 == Type_Fixnum) ? 1 : 0; + +g8040: + if (_trace) printf("g8040:\n"); + if (t3 == 0) + goto g8028; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQS(2, f2, f31, 2, f2); + goto equalnumbermmexcfltflt; + +g8037: + if (_trace) printf("g8037:\n"); + +g8036: + if (_trace) printf("g8036:\n"); + /* Here for all other cases */ + +g8027: + if (_trace) printf("g8027:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g8029; + +g8028: + if (_trace) printf("g8028:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8029: + if (_trace) printf("g8029:\n"); + +g8030: + if (_trace) printf("g8030:\n"); + +/* end EqualNumberMMExc */ +/* start LesspMMExc */ + + +lesspmmexc: + if (_trace) printf("lesspmmexc:\n"); + /* Strip off any CDR code bits. */ + t5 = arg3 & 63; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t6 = (t5 == Type_Fixnum) ? 1 : 0; + +g8062: + if (_trace) printf("g8062:\n"); + if (t6 == 0) + goto g8050; + /* Here if argument TypeFixnum */ + t3 = (t4 == Type_SingleFloat) ? 1 : 0; + +g8054: + if (_trace) printf("g8054:\n"); + if (t3 == 0) + goto g8047; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQS(1, f1, f31, 1, f1); + goto lesspmmexcfltflt; + +g8051: + if (_trace) printf("g8051:\n"); + +g8050: + if (_trace) printf("g8050:\n"); + t6 = (t5 == Type_SingleFloat) ? 1 : 0; + +g8063: + if (_trace) printf("g8063:\n"); + if (t6 == 0) + goto g8055; + /* Here if argument TypeSingleFloat */ + t3 = (t4 == Type_Fixnum) ? 1 : 0; + +g8059: + if (_trace) printf("g8059:\n"); + if (t3 == 0) + goto g8047; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQS(2, f2, f31, 2, f2); + goto lesspmmexcfltflt; + +g8056: + if (_trace) printf("g8056:\n"); + +g8055: + if (_trace) printf("g8055:\n"); + /* Here for all other cases */ + +g8046: + if (_trace) printf("g8046:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g8048; + +g8047: + if (_trace) printf("g8047:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8048: + if (_trace) printf("g8048:\n"); + +g8049: + if (_trace) printf("g8049:\n"); + +/* end LesspMMExc */ +/* start GreaterpMMExc */ + + +greaterpmmexc: + if (_trace) printf("greaterpmmexc:\n"); + /* Strip off any CDR code bits. */ + t5 = arg3 & 63; + /* Strip off any CDR code bits. */ + t4 = t1 & 63; + t6 = (t5 == Type_Fixnum) ? 1 : 0; + +g8081: + if (_trace) printf("g8081:\n"); + if (t6 == 0) + goto g8069; + /* Here if argument TypeFixnum */ + t3 = (t4 == Type_SingleFloat) ? 1 : 0; + +g8073: + if (_trace) printf("g8073:\n"); + if (t3 == 0) + goto g8066; + /* Here if argument TypeSingleFloat */ + CVTLQ(1, f1, f31, 1, f1); + CVTQS(1, f1, f31, 1, f1); + goto greaterpmmexcfltflt; + +g8070: + if (_trace) printf("g8070:\n"); + +g8069: + if (_trace) printf("g8069:\n"); + t6 = (t5 == Type_SingleFloat) ? 1 : 0; + +g8082: + if (_trace) printf("g8082:\n"); + if (t6 == 0) + goto g8074; + /* Here if argument TypeSingleFloat */ + t3 = (t4 == Type_Fixnum) ? 1 : 0; + +g8078: + if (_trace) printf("g8078:\n"); + if (t3 == 0) + goto g8066; + /* Here if argument TypeFixnum */ + CVTLQ(2, f2, f31, 2, f2); + CVTQS(2, f2, f31, 2, f2); + goto greaterpmmexcfltflt; + +g8075: + if (_trace) printf("g8075:\n"); + +g8074: + if (_trace) printf("g8074:\n"); + /* Here for all other cases */ + +g8065: + if (_trace) printf("g8065:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + goto g8067; + +g8066: + if (_trace) printf("g8066:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 1; + goto numericexception; + +g8067: + if (_trace) printf("g8067:\n"); + +g8068: + if (_trace) printf("g8068:\n"); + +/* end GreaterpMMExc */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunpred.as */ diff --git a/stub/ifunsubp.c b/stub/ifunsubp.c new file mode 100644 index 0000000..7aed125 --- /dev/null +++ b/stub/ifunsubp.c @@ -0,0 +1,3446 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifunsubp.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* Subprimitives. */ +/* start DoEphemeralp */ + + /* Halfword operand from stack instruction - DoEphemeralp */ + +doephemeralp: + if (_trace) printf("doephemeralp:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoEphemeralpIM: + if (_trace) printf("DoEphemeralpIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8083: + if (_trace) printf("g8083:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoephemeralp; +#ifdef TRACING +#endif + +DoEphemeralpSP: + if (_trace) printf("DoEphemeralpSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoephemeralp; +#endif + +DoEphemeralpLP: + if (_trace) printf("DoEphemeralpLP:\n"); +#ifdef TRACING + goto headdoephemeralp; +#endif + +DoEphemeralpFP: + if (_trace) printf("DoEphemeralpFP:\n"); + +headdoephemeralp: + if (_trace) printf("headdoephemeralp:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoephemeralp: + if (_trace) printf("begindoephemeralp:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* ptr type array */ + t1 = *(u64 *)&(processor->ptrtype); + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + /* TagType. */ + arg2 = arg2 & 63; + t2 = (arg2 * 4) + t1; + arg1 = arg1 >> 27; + /* =0 if not a pointer */ + t3 = *(s32 *)t2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* J. if zone not ephemeral */ + if (arg1 != 0) + goto nonephem; + /* J. if not a pointer */ + if (t3 == 0) + goto nonephem; + t6 = *(u64 *)&(processor->taddress); + /* push the data */ + *(u64 *)(iSP + 8) = t6; + iSP = iSP + 8; + goto cachevalid; + +nonephem: + if (_trace) printf("nonephem:\n"); + t6 = *(u64 *)&(processor->niladdress); + /* push the data */ + *(u64 *)(iSP + 8) = t6; + iSP = iSP + 8; + goto cachevalid; + +/* end DoEphemeralp */ + /* End of Halfword operand from stack instruction - DoEphemeralp */ +/* start DoUnsignedLessp */ + + /* Halfword operand from stack instruction - DoUnsignedLessp */ + /* arg2 has the preloaded 8 bit operand. */ + +dounsignedlessp: + if (_trace) printf("dounsignedlessp:\n"); +#ifdef TRACING +#endif + +DoUnsignedLesspSP: + if (_trace) printf("DoUnsignedLesspSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdounsignedlessp; +#endif + +DoUnsignedLesspLP: + if (_trace) printf("DoUnsignedLesspLP:\n"); +#ifdef TRACING + goto headdounsignedlessp; +#endif + +DoUnsignedLesspFP: + if (_trace) printf("DoUnsignedLesspFP:\n"); + +headdounsignedlessp: + if (_trace) printf("headdounsignedlessp:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindounsignedlessp: + if (_trace) printf("begindounsignedlessp:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get data from arg1 */ + t2 = *(s32 *)iSP; + arg3 = arg3 >> 12; + t11 = *(u64 *)&(processor->niladdress); + /* Get unsigned data from arg2 */ + t4 = (u32)arg1; + t12 = *(u64 *)&(processor->taddress); + /* 1 if no-pop, 0 if pop */ + arg3 = arg3 & 1; + /* Unsigned arg1 */ + t2 = (u32)t2; + /* Either a stack-push or a stack-write */ + iSP = (arg3 * 8) + iSP; + /* t6:=arg2-arg1 unsigned */ + t6 = t4 - t2; + if ((s64)t6 > 0) + t11 = t12; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)iSP = t11; + goto cachevalid; +#ifdef TRACING + goto DoUnsignedLesspIM; +#endif + +DoUnsignedLesspIM: + if (_trace) printf("DoUnsignedLesspIM:\n"); + /* Get data from arg1 */ + t2 = *(s32 *)iSP; + arg3 = arg3 >> 12; + t11 = *(u64 *)&(processor->niladdress); + /* ... */ + t2 = (u32)t2; + t12 = *(u64 *)&(processor->taddress); + /* 1 if no-pop, 0 if pop */ + arg3 = arg3 & 1; + /* t6:=arg2-arg1 unsigned */ + t6 = arg2 - t2; + /* Either a stack-push or a stack-write */ + iSP = (arg3 * 8) + iSP; + if ((s64)t6 > 0) + t11 = t12; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + *(u64 *)iSP = t11; + goto cachevalid; + +/* end DoUnsignedLessp */ + /* End of Halfword operand from stack instruction - DoUnsignedLessp */ +/* start DoAllocateListBlock */ + + /* Halfword operand from stack instruction - DoAllocateListBlock */ + /* arg2 has the preloaded 8 bit operand. */ + +doallocatelistblock: + if (_trace) printf("doallocatelistblock:\n"); +#ifdef TRACING +#endif + +DoAllocateListBlockIM: + if (_trace) printf("DoAllocateListBlockIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoallocatelistblock; +#ifdef TRACING +#endif + +DoAllocateListBlockSP: + if (_trace) printf("DoAllocateListBlockSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoallocatelistblock; +#endif + +DoAllocateListBlockLP: + if (_trace) printf("DoAllocateListBlockLP:\n"); +#ifdef TRACING + goto headdoallocatelistblock; +#endif + +DoAllocateListBlockFP: + if (_trace) printf("DoAllocateListBlockFP:\n"); + +headdoallocatelistblock: + if (_trace) printf("headdoallocatelistblock:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoallocatelistblock: + if (_trace) printf("begindoallocatelistblock:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + t1 = *(u64 *)&(processor->lcarea); + arg3 = *(u64 *)iSP; + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t5 = arg2 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g8084; + t4 = *(s32 *)&processor->lclength; + t2 = (arg3 == t1) ? 1 : 0; + /* Wrong area */ + if (t2 == 0) + goto g8085; + /* Effectively an unsigned 32-bit compare */ + t2 = t4 - arg1; + /* Insufficient cache */ + if ((s64)t2 < 0) + goto g8085; + /* Fetch address */ + t1 = *(u64 *)&(processor->lcaddress); + t3 = (-16384) << 16; + t3 = (u32)t3; + /* Store remaining length */ + *(u32 *)&processor->lclength = t2; + /* Cache address/tag -> TOS */ + *(u64 *)iSP = t1; + /* Cache address -> BAR1 */ + *(u32 *)&processor->bar1 = t1; + t1 = (u32)t1; + /* Verify trap mode */ + t4 = *(s32 *)&processor->control; + /* Increment address */ + t1 = t1 + arg1; + /* Store updated address */ + *(u32 *)&processor->lcaddress = t1; + t3 = t3 & t4; + /* Already above emulator mode */ + if (t3 != 0) + goto NEXTINSTRUCTION; + t3 = (16384) << 16; + t4 = t4 | t3; + *(u32 *)&processor->control = t4; + goto NEXTINSTRUCTION; + +g8084: + if (_trace) printf("g8084:\n"); + arg5 = 0; + arg2 = 1; + goto illegaloperand; + +g8085: + if (_trace) printf("g8085:\n"); + /* SetTag. */ + t1 = arg2 << 32; + t1 = arg1 | t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +/* end DoAllocateListBlock */ + /* End of Halfword operand from stack instruction - DoAllocateListBlock */ +/* start DoAllocateStructureBlock */ + + /* Halfword operand from stack instruction - DoAllocateStructureBlock */ + /* arg2 has the preloaded 8 bit operand. */ + +doallocatestructureblock: + if (_trace) printf("doallocatestructureblock:\n"); +#ifdef TRACING +#endif + +DoAllocateStructureBlockIM: + if (_trace) printf("DoAllocateStructureBlockIM:\n"); + /* This sequence is lukewarm */ + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoallocatestructureblock; +#ifdef TRACING +#endif + +DoAllocateStructureBlockSP: + if (_trace) printf("DoAllocateStructureBlockSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoallocatestructureblock; +#endif + +DoAllocateStructureBlockLP: + if (_trace) printf("DoAllocateStructureBlockLP:\n"); +#ifdef TRACING + goto headdoallocatestructureblock; +#endif + +DoAllocateStructureBlockFP: + if (_trace) printf("DoAllocateStructureBlockFP:\n"); + +headdoallocatestructureblock: + if (_trace) printf("headdoallocatestructureblock:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoallocatestructureblock: + if (_trace) printf("begindoallocatestructureblock:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + t1 = *(u64 *)&(processor->scarea); + arg3 = *(u64 *)iSP; + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t5 = arg2 - Type_Fixnum; + /* Strip CDR code */ + t5 = t5 & 63; + if (t5 != 0) + goto g8086; + t4 = *(s32 *)&processor->sclength; + t2 = (arg3 == t1) ? 1 : 0; + /* Wrong area */ + if (t2 == 0) + goto g8087; + /* Effectively an unsigned 32-bit compare */ + t2 = t4 - arg1; + /* Insufficient cache */ + if ((s64)t2 < 0) + goto g8087; + /* Fetch address */ + t1 = *(u64 *)&(processor->scaddress); + t3 = (-16384) << 16; + t3 = (u32)t3; + /* Store remaining length */ + *(u32 *)&processor->sclength = t2; + /* Cache address/tag -> TOS */ + *(u64 *)iSP = t1; + /* Cache address -> BAR1 */ + *(u32 *)&processor->bar1 = t1; + t1 = (u32)t1; + /* Verify trap mode */ + t4 = *(s32 *)&processor->control; + /* Increment address */ + t1 = t1 + arg1; + /* Store updated address */ + *(u32 *)&processor->scaddress = t1; + t3 = t3 & t4; + /* Already above emulator mode */ + if (t3 != 0) + goto NEXTINSTRUCTION; + t3 = (16384) << 16; + t4 = t4 | t3; + *(u32 *)&processor->control = t4; + goto NEXTINSTRUCTION; + +g8086: + if (_trace) printf("g8086:\n"); + arg5 = 0; + arg2 = 1; + goto illegaloperand; + +g8087: + if (_trace) printf("g8087:\n"); + /* SetTag. */ + t1 = arg2 << 32; + t1 = arg1 | t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +/* end DoAllocateStructureBlock */ + /* End of Halfword operand from stack instruction - DoAllocateStructureBlock */ +/* start DoPointerDifference */ + + /* Halfword operand from stack instruction - DoPointerDifference */ + /* arg2 has the preloaded 8 bit operand. */ + +dopointerdifference: + if (_trace) printf("dopointerdifference:\n"); +#ifdef TRACING +#endif + +DoPointerDifferenceSP: + if (_trace) printf("DoPointerDifferenceSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdopointerdifference; +#endif + +DoPointerDifferenceLP: + if (_trace) printf("DoPointerDifferenceLP:\n"); +#ifdef TRACING + goto headdopointerdifference; +#endif + +DoPointerDifferenceFP: + if (_trace) printf("DoPointerDifferenceFP:\n"); + +headdopointerdifference: + if (_trace) printf("headdopointerdifference:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindopointerdifference: + if (_trace) printf("begindopointerdifference:\n"); + /* arg1 has the operand, not sign extended if immediate. */ + /* Get the data of ARG1 */ + t1 = *(s32 *)iSP; + /* Get the data of ARG2 */ + t2 = (u32)arg1; + /* (%32-bit-difference (data arg1) (data arg2)) */ + t3 = (s32)t1 - (s32)t2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t4 = Type_Fixnum; + /* Save result and coerce to a FIXNUM */ + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t4; + goto cachevalid; +#ifdef TRACING + goto DoPointerDifferenceIM; +#endif + +DoPointerDifferenceIM: + if (_trace) printf("DoPointerDifferenceIM:\n"); + t2 = arg2 << 56; + /* Get the data of arg1 */ + t1 = *(s32 *)iSP; + t2 = (s64)t2 >> 56; + /* (%32-bit-difference (data arg1) (data arg2)) */ + t3 = (s32)t1 - (s32)t2; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t4 = Type_Fixnum; + /* Save result and coerce to a FIXNUM */ + *(u32 *)iSP = t3; + /* write the stack cache */ + *(u32 *)(iSP + 4) = t4; + goto cachevalid; + +/* end DoPointerDifference */ + /* End of Halfword operand from stack instruction - DoPointerDifference */ +/* start DoPointerIncrement */ + + /* Halfword operand from stack instruction - DoPointerIncrement */ + /* arg2 has the preloaded 8 bit operand. */ + +dopointerincrement: + if (_trace) printf("dopointerincrement:\n"); +#ifdef TRACING +#endif + +DoPointerIncrementSP: + if (_trace) printf("DoPointerIncrementSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindopointerincrement; +#endif + +DoPointerIncrementLP: + if (_trace) printf("DoPointerIncrementLP:\n"); +#ifdef TRACING + goto begindopointerincrement; +#endif + +DoPointerIncrementFP: + if (_trace) printf("DoPointerIncrementFP:\n"); + +begindopointerincrement: + if (_trace) printf("begindopointerincrement:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the data of arg2 */ + t2 = *(s32 *)arg1; + /* (%32-bit-plus (data arg1) 1) */ + t3 = (s32)t2 + (s32)1; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Put result back */ + *(u32 *)arg1 = t3; + goto cachevalid; +#ifdef TRACING +#endif + +DoPointerIncrementIM: + goto doistageerror; + +/* end DoPointerIncrement */ + /* End of Halfword operand from stack instruction - DoPointerIncrement */ +/* start DoStoreConditional */ + + /* Halfword operand from stack instruction - DoStoreConditional */ + +dostoreconditional: + if (_trace) printf("dostoreconditional:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoStoreConditionalIM: + if (_trace) printf("DoStoreConditionalIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8104: + if (_trace) printf("g8104:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindostoreconditional; +#ifdef TRACING +#endif + +DoStoreConditionalSP: + if (_trace) printf("DoStoreConditionalSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdostoreconditional; +#endif + +DoStoreConditionalLP: + if (_trace) printf("DoStoreConditionalLP:\n"); +#ifdef TRACING + goto headdostoreconditional; +#endif + +DoStoreConditionalFP: + if (_trace) printf("DoStoreConditionalFP:\n"); + +headdostoreconditional: + if (_trace) printf("headdostoreconditional:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindostoreconditional: + if (_trace) printf("begindostoreconditional:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg2 = arg1 >> 32; + /* old tag and data */ + arg4 = *(s32 *)iSP; + /* old tag and data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + arg1 = (u32)arg1; + /* address tag and data */ + arg6 = *(s32 *)iSP; + /* address tag and data */ + arg5 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg6 = (u32)arg6; + /* TagType. */ + t1 = arg5 & 63; + t2 = t1 - Type_Locative; + /* Strip CDR code */ + t2 = t2 & 63; + if (t2 != 0) + goto storecondiop; + /* Read the location, checking write access */ + /* Memory Read Internal */ + +g8088: + /* Base of stack cache */ + t1 = *(u64 *)&(processor->stackcachebasevma); + t3 = arg6 + ivory; + t2 = *(s32 *)&processor->scovlimit; + t5 = (t3 * 4); + t4 = LDQ_U(t3); + /* Stack cache offset */ + t1 = arg6 - t1; + /* In range? */ + t2 = ((u64)t1 < (u64)t2) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t3&7)*8)); + if (t2 != 0) + goto g8090; + +g8089: + t1 = *(u64 *)&(processor->dataread_mask); + t3 = zero + 240; + t1 = t1 >> (t4 & 63); + t3 = t3 >> (t4 & 63); + if (t1 & 1) + goto g8092; + +g8099: + /* Check for data match - NOT */ + t1 = (s32)arg4 - (s32)t5; + /* Zero if tags match */ + t2 = arg3 ^ t4; + /* Jump if data didn't match */ + if (t1 != 0) + goto storecondnil; + /* TagType. */ + /* Stip result of comparing CDR-CODEs */ + t2 = t2 & 63; + /* Jump if tags don't match */ + if (t2 != 0) + goto storecondnil; + /* Strip CDR-CODE */ + t1 = arg2 & 63; + /* Retain CDR-CODE */ + t4 = t4 & 192; + /* Merge new tag with old CDR-CODE */ + t4 = t1 | t4; + t2 = *(u64 *)&(processor->stackcachebasevma); + t1 = arg6 + ivory; + t6 = *(s32 *)&processor->scovlimit; + t5 = (t1 * 4); + t3 = LDQ_U(t1); + /* Stack cache offset */ + t2 = arg6 - t2; + /* In range? */ + t6 = ((u64)t2 < (u64)t6) ? 1 : 0; + t2 = (t4 & 0xff) << ((t1&7)*8); + t3 = t3 & ~(0xffL << (t1&7)*8); + +g8102: + if (_trace) printf("g8102:\n"); + t3 = t3 | t2; + STQ_U(t1, t3); + *(u32 *)t5 = arg1; + /* J. if in cache */ + if (t6 != 0) + goto g8101; + +g8100: + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t6 = *(u64 *)&(processor->taddress); + /* push the data */ + *(u64 *)(iSP + 8) = t6; + iSP = iSP + 8; + goto cachevalid; + +storecondnil: + if (_trace) printf("storecondnil:\n"); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + t6 = *(u64 *)&(processor->niladdress); + /* push the data */ + *(u64 *)(iSP + 8) = t6; + iSP = iSP + 8; + goto cachevalid; + +storecondiop: + if (_trace) printf("storecondiop:\n"); + arg5 = 0; + arg2 = 65; + goto illegaloperand; + +g8101: + if (_trace) printf("g8101:\n"); + t2 = *(u64 *)&(processor->stackcachebasevma); + +g8103: + if (_trace) printf("g8103:\n"); + t1 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t2 = arg6 - t2; + /* reconstruct SCA */ + t1 = (t2 * 8) + t1; + /* Store in stack */ + *(u32 *)t1 = arg1; + /* write the stack cache */ + *(u32 *)(t1 + 4) = t4; + goto g8100; + +g8090: + if (_trace) printf("g8090:\n"); + t2 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t1 = (t1 * 8) + t2; + t5 = *(s32 *)t1; + /* Read from stack cache */ + t4 = *(s32 *)(t1 + 4); + goto g8089; + +g8092: + if (_trace) printf("g8092:\n"); + if ((t3 & 1) == 0) + goto g8091; + /* Do the indirect thing */ + arg6 = (u32)t5; + goto g8088; + +g8091: + if (_trace) printf("g8091:\n"); + /* Load the memory action table for cycle */ + t1 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t3 = t4 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg6; + /* Adjust for a longword load */ + t3 = (t3 * 4) + t1; + /* Get the memory action */ + t1 = *(s32 *)t3; + +g8096: + if (_trace) printf("g8096:\n"); + t3 = t1 & MemoryActionTransform; + if (t3 == 0) + goto g8095; + t4 = t4 & ~63L; + t4 = t4 | Type_ExternalValueCellPointer; + goto g8099; +#ifndef MINIMA + +g8095: +#endif +#ifdef MINIMA + +g8095: + if (_trace) printf("g8095:\n"); + t3 = t1 & MemoryActionBinding; + t2 = *(u64 *)&(processor->dbcmask); + if (t3 == 0) + goto g8094; + t1 = arg6 << 1; + t3 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t1 = t1 & t2; + t2 = 1; + t2 = t2 << (ivorymemorydata & 63); + t1 = (s32)t1 + (s32)t3; + /* Clear sign-extension */ + t1 = (u32)t1; + t2 = (t1 * 4) + t2; + /* Fetch the key */ + t1 = *(s32 *)t2; + /* Fetch value */ + t5 = *(s32 *)(t2 + 4); + /* Compare */ + t3 = (s32)arg6 - (s32)t1; + /* Trap on miss */ + if (t3 != 0) + goto g8098; + /* Extract the pointer, and indirect */ + arg6 = (u32)t5; + goto g8088; + +g8098: + if (_trace) printf("g8098:\n"); + goto dbcachemisstrap; +#endif + +g8094: + /* Perform memory action */ + arg1 = t1; + arg2 = 0; + goto performmemoryaction; + +/* end DoStoreConditional */ + /* End of Halfword operand from stack instruction - DoStoreConditional */ +/* start DoMemoryWrite */ + + /* Halfword operand from stack instruction - DoMemoryWrite */ + +domemorywrite: + if (_trace) printf("domemorywrite:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoMemoryWriteIM: + if (_trace) printf("DoMemoryWriteIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8108: + if (_trace) printf("g8108:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindomemorywrite; +#ifdef TRACING +#endif + +DoMemoryWriteSP: + if (_trace) printf("DoMemoryWriteSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdomemorywrite; +#endif + +DoMemoryWriteLP: + if (_trace) printf("DoMemoryWriteLP:\n"); +#ifdef TRACING + goto headdomemorywrite; +#endif + +DoMemoryWriteFP: + if (_trace) printf("DoMemoryWriteFP:\n"); + +headdomemorywrite: + if (_trace) printf("headdomemorywrite:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindomemorywrite: + if (_trace) printf("begindomemorywrite:\n"); + /* arg1 has the operand, sign extended if immediate. */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + t2 = *(u64 *)&(processor->stackcachebasevma); + t1 = arg4 + ivory; + t5 = *(s32 *)&processor->scovlimit; + t4 = (t1 * 4); + t3 = LDQ_U(t1); + /* Stack cache offset */ + t2 = arg4 - t2; + /* In range? */ + t5 = ((u64)t2 < (u64)t5) ? 1 : 0; + t2 = (arg2 & 0xff) << ((t1&7)*8); + t3 = t3 & ~(0xffL << (t1&7)*8); + +g8106: + if (_trace) printf("g8106:\n"); + t3 = t3 | t2; + STQ_U(t1, t3); + *(u32 *)t4 = arg1; + /* J. if in cache */ + if (t5 != 0) + goto g8105; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g8105: + if (_trace) printf("g8105:\n"); + t2 = *(u64 *)&(processor->stackcachebasevma); + +g8107: + if (_trace) printf("g8107:\n"); + t1 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t2 = arg4 - t2; + /* reconstruct SCA */ + t1 = (t2 * 8) + t1; + /* Store in stack */ + *(u32 *)t1 = arg1; + /* write the stack cache */ + *(u32 *)(t1 + 4) = arg2; + goto NEXTINSTRUCTION; + +/* end DoMemoryWrite */ + /* End of Halfword operand from stack instruction - DoMemoryWrite */ +/* start DoPStoreContents */ + + /* Halfword operand from stack instruction - DoPStoreContents */ + +dopstorecontents: + if (_trace) printf("dopstorecontents:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoPStoreContentsIM: + if (_trace) printf("DoPStoreContentsIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8121: + if (_trace) printf("g8121:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindopstorecontents; +#ifdef TRACING +#endif + +DoPStoreContentsSP: + if (_trace) printf("DoPStoreContentsSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdopstorecontents; +#endif + +DoPStoreContentsLP: + if (_trace) printf("DoPStoreContentsLP:\n"); +#ifdef TRACING + goto headdopstorecontents; +#endif + +DoPStoreContentsFP: + if (_trace) printf("DoPStoreContentsFP:\n"); + +headdopstorecontents: + if (_trace) printf("headdopstorecontents:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindopstorecontents: + if (_trace) printf("begindopstorecontents:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* address tag and data */ + arg4 = *(s32 *)iSP; + /* address tag and data */ + arg3 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + arg4 = (u32)arg4; + arg2 = arg1 >> 32; + arg1 = (u32)arg1; + /* Memory Read Internal */ + +g8109: + /* Base of stack cache */ + t6 = *(u64 *)&(processor->stackcachebasevma); + t8 = arg4 + ivory; + t7 = *(s32 *)&processor->scovlimit; + t5 = (t8 * 4); + t4 = LDQ_U(t8); + /* Stack cache offset */ + t6 = arg4 - t6; + /* In range? */ + t7 = ((u64)t6 < (u64)t7) ? 1 : 0; + t5 = *(s32 *)t5; + t4 = (u8)(t4 >> ((t8&7)*8)); + if (t7 != 0) + goto g8111; + +g8110: + +g8117: + /* Merge cdr-code */ + t5 = arg2 & 63; + t4 = t4 & 192; + t4 = t4 | t5; + t7 = *(u64 *)&(processor->stackcachebasevma); + t6 = arg4 + ivory; + t9 = *(s32 *)&processor->scovlimit; + t5 = (t6 * 4); + t8 = LDQ_U(t6); + /* Stack cache offset */ + t7 = arg4 - t7; + /* In range? */ + t9 = ((u64)t7 < (u64)t9) ? 1 : 0; + t7 = (t4 & 0xff) << ((t6&7)*8); + t8 = t8 & ~(0xffL << (t6&7)*8); + +g8119: + if (_trace) printf("g8119:\n"); + t8 = t8 | t7; + STQ_U(t6, t8); + *(u32 *)t5 = arg1; + /* J. if in cache */ + if (t9 != 0) + goto g8118; + goto NEXTINSTRUCTION; + goto NEXTINSTRUCTION; + +g8118: + if (_trace) printf("g8118:\n"); + t7 = *(u64 *)&(processor->stackcachebasevma); + +g8120: + if (_trace) printf("g8120:\n"); + t6 = *(u64 *)&(processor->stackcachedata); + /* Stack cache offset */ + t7 = arg4 - t7; + /* reconstruct SCA */ + t6 = (t7 * 8) + t6; + /* Store in stack */ + *(u32 *)t6 = arg1; + /* write the stack cache */ + *(u32 *)(t6 + 4) = t4; + goto NEXTINSTRUCTION; + +g8111: + if (_trace) printf("g8111:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t6 = (t6 * 8) + t7; + t5 = *(s32 *)t6; + /* Read from stack cache */ + t4 = *(s32 *)(t6 + 4); + goto g8110; + +/* end DoPStoreContents */ + /* End of Halfword operand from stack instruction - DoPStoreContents */ +/* start DoSetCdrCode1 */ + + /* Halfword operand from stack instruction - DoSetCdrCode1 */ + /* arg2 has the preloaded 8 bit operand. */ + +dosetcdrcode1: + if (_trace) printf("dosetcdrcode1:\n"); +#ifdef TRACING +#endif + +DoSetCdrCode1SP: + if (_trace) printf("DoSetCdrCode1SP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindosetcdrcode1; +#endif + +DoSetCdrCode1LP: + if (_trace) printf("DoSetCdrCode1LP:\n"); +#ifdef TRACING + goto begindosetcdrcode1; +#endif + +DoSetCdrCode1FP: + if (_trace) printf("DoSetCdrCode1FP:\n"); + +begindosetcdrcode1: + if (_trace) printf("begindosetcdrcode1:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get CDR CODE/TAG of operand */ + t1 = *(s32 *)(arg1 + 4); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Strip off any existing CDR code bits */ + t1 = t1 & 63; + /* OR in the CDR */ + t1 = t1 | 64; + /* Replace the CDE CODE/TAG */ + *(u32 *)(arg1 + 4) = t1; + goto cachevalid; +#ifdef TRACING +#endif + +DoSetCdrCode1IM: + goto doistageerror; + +/* end DoSetCdrCode1 */ + /* End of Halfword operand from stack instruction - DoSetCdrCode1 */ +/* start DoSetCdrCode2 */ + + /* Halfword operand from stack instruction - DoSetCdrCode2 */ + /* arg2 has the preloaded 8 bit operand. */ + +dosetcdrcode2: + if (_trace) printf("dosetcdrcode2:\n"); +#ifdef TRACING +#endif + +DoSetCdrCode2SP: + if (_trace) printf("DoSetCdrCode2SP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindosetcdrcode2; +#endif + +DoSetCdrCode2LP: + if (_trace) printf("DoSetCdrCode2LP:\n"); +#ifdef TRACING + goto begindosetcdrcode2; +#endif + +DoSetCdrCode2FP: + if (_trace) printf("DoSetCdrCode2FP:\n"); + +begindosetcdrcode2: + if (_trace) printf("begindosetcdrcode2:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get CDR CODE/TAG of operand */ + t1 = *(s32 *)(arg1 + 4); + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Strip off any existing CDR code bits */ + t1 = t1 & 63; + /* OR in the CDR */ + t1 = t1 | 128; + /* Replace the CDE CODE/TAG */ + *(u32 *)(arg1 + 4) = t1; + goto cachevalid; +#ifdef TRACING +#endif + +DoSetCdrCode2IM: + goto doistageerror; + +/* end DoSetCdrCode2 */ + /* End of Halfword operand from stack instruction - DoSetCdrCode2 */ +/* start DoJump */ + + /* Halfword operand from stack instruction - DoJump */ + /* arg2 has the preloaded 8 bit operand. */ + +dojump: + if (_trace) printf("dojump:\n"); +#ifdef TRACING +#endif + +DoJumpSP: + if (_trace) printf("DoJumpSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto begindojump; +#endif + +DoJumpLP: + if (_trace) printf("DoJumpLP:\n"); +#ifdef TRACING + goto begindojump; +#endif + +DoJumpFP: + if (_trace) printf("DoJumpFP:\n"); + +begindojump: + if (_trace) printf("begindojump:\n"); + /* arg1 has the operand address. */ + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Read address and even/odd PC tag. */ + t4 = *(s32 *)arg1; + t3 = *(s32 *)(arg1 + 4); + t4 = (u32)t4; + t5 = t3 - Type_EvenPC; + /* Strip CDR code, low bits */ + t5 = t5 & 62; + if (t5 != 0) + goto jexc; + t4 = t4 << 1; + iPC = t3 & 1; + iPC = iPC + t4; + t5 = t3 & 128; + if (t5 == 0) + goto interpretinstructionforjump; + /* Bit 39=1 indicates we need to update control reg */ + /* Get the cleanup bit */ + t6 = t3 & 64; + /* Processor control register. */ + t5 = *(u64 *)&(processor->control); + /* shift into cleanup-in-progress place */ + t6 = t6 << 17; + t7 = (128) << 16; + /* Mask */ + t5 = t5 & ~t7; + /* Set */ + t5 = t5 | t6; + *(u64 *)&processor->control = t5; + goto interpretinstructionforjump; + +jexc: + if (_trace) printf("jexc:\n"); + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 0; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; +#ifdef TRACING +#endif + +DoJumpIM: + goto doistageerror; + +/* end DoJump */ + /* End of Halfword operand from stack instruction - DoJump */ +/* start DoCheckPreemptRequest */ + + /* Halfword 10 bit immediate instruction - DoCheckPreemptRequest */ + +docheckpreemptrequest: + if (_trace) printf("docheckpreemptrequest:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoCheckPreemptRequestIM: + if (_trace) printf("DoCheckPreemptRequestIM:\n"); + +DoCheckPreemptRequestSP: + if (_trace) printf("DoCheckPreemptRequestSP:\n"); + +DoCheckPreemptRequestLP: + if (_trace) printf("DoCheckPreemptRequestLP:\n"); + +DoCheckPreemptRequestFP: + if (_trace) printf("DoCheckPreemptRequestFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + t1 = *(s32 *)&processor->interruptreg; + t2 = t1 & 2; + t2 = (t2 == 2) ? 1 : 0; + t1 = t1 | t2; + *(u32 *)&processor->interruptreg = t1; + if (t1 == 0) + goto NEXTINSTRUCTION; + *(u64 *)&processor->stop_interpreter = t1; + goto NEXTINSTRUCTION; + +/* end DoCheckPreemptRequest */ + /* End of Halfword operand from stack instruction - DoCheckPreemptRequest */ +/* start DoHalt */ + + /* Halfword 10 bit immediate instruction - DoHalt */ + +dohalt: + if (_trace) printf("dohalt:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoHaltIM: + if (_trace) printf("DoHaltIM:\n"); + +DoHaltSP: + if (_trace) printf("DoHaltSP:\n"); + +DoHaltLP: + if (_trace) printf("DoHaltLP:\n"); + +DoHaltFP: + if (_trace) printf("DoHaltFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + t1 = *(s32 *)&processor->control; + /* Isolate current trap mode (FEP mode = -1) */ + t1 = t1 >> 30; + /* t1 is zero iff we're in trap mode FEP */ + t1 = (s32)t1 + (s32)1; + if (t1 != 0) + goto haltexc; + goto haltmachine; + +haltexc: + if (_trace) printf("haltexc:\n"); + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 0; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +/* end DoHalt */ + /* End of Halfword operand from stack instruction - DoHalt */ +/* start DoNoOp */ + + /* Halfword 10 bit immediate instruction - DoNoOp */ + +donoop: + if (_trace) printf("donoop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoNoOpIM: + if (_trace) printf("DoNoOpIM:\n"); + +DoNoOpSP: + if (_trace) printf("DoNoOpSP:\n"); + +DoNoOpLP: + if (_trace) printf("DoNoOpLP:\n"); + +DoNoOpFP: + if (_trace) printf("DoNoOpFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + goto NEXTINSTRUCTION; + +/* end DoNoOp */ + /* End of Halfword operand from stack instruction - DoNoOp */ +/* start DoAlu */ + + /* Halfword operand from stack instruction - DoAlu */ + +doalu: + if (_trace) printf("doalu:\n"); + /* arg2 has the preloaded 8 bit operand. */ +#ifdef TRACING +#endif + +DoAluIM: + if (_trace) printf("DoAluIM:\n"); + /* This sequence only sucks a moderate amount */ + /* sign extend the byte argument. */ + arg2 = arg2 << 56; + +g8192: + if (_trace) printf("g8192:\n"); + /* Rest of sign extension */ + arg2 = (s64)arg2 >> 56; + *(u32 *)&processor->immediate_arg = arg2; + arg1 = *(u64 *)&(processor->immediate_arg); + goto begindoalu; +#ifdef TRACING +#endif + +DoAluSP: + if (_trace) printf("DoAluSP:\n"); + /* Assume SP mode */ + arg1 = arg5; + /* SP-pop mode */ + if (arg2 == 0) + arg1 = iSP; + /* Adjust SP if SP-pop mode */ + if (arg2 == 0) + iSP = arg4; +#ifdef TRACING + goto headdoalu; +#endif + +DoAluLP: + if (_trace) printf("DoAluLP:\n"); +#ifdef TRACING + goto headdoalu; +#endif + +DoAluFP: + if (_trace) printf("DoAluFP:\n"); + +headdoalu: + if (_trace) printf("headdoalu:\n"); + /* Compute operand address */ + arg1 = (arg2 * 8) + arg1; + /* Get the operand */ + arg1 = *(u64 *)arg1; + +begindoalu: + if (_trace) printf("begindoalu:\n"); + /* arg1 has the operand, sign extended if immediate. */ + /* Get tag of ARG2 */ + arg2 = arg1 >> 32; + /* Get data of ARG2 */ + arg1 = (u32)arg1; + /* Get ARG1 */ + arg4 = *(s32 *)iSP; + arg3 = *(s32 *)(iSP + 4); + arg4 = (u32)arg4; + t1 = arg2 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto aluexc; + t1 = arg3 - Type_Fixnum; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto aluexc; + arg5 = *(u64 *)&(processor->aluop); + *(u64 *)&processor->aluoverflow = zero; + arg6 = *(u64 *)&(processor->aluandrotatecontrol); + t1 = (arg5 == ALUFunction_Boolean) ? 1 : 0; + +g8182: + if (_trace) printf("g8182:\n"); + if (t1 == 0) + goto g8123; + /* Here if argument ALUFunctionBoolean */ + t10 = arg6 >> 10; + /* Extract the ALU boolean function */ + t10 = t10 & 15; + t1 = (t10 == Boole_Clear) ? 1 : 0; + +g8142: + if (_trace) printf("g8142:\n"); + if (t1 != 0) + goto g8124; + +g8125: + if (_trace) printf("g8125:\n"); + t1 = (t10 == Boole_And) ? 1 : 0; + +g8143: + if (_trace) printf("g8143:\n"); + if (t1 == 0) + goto g8126; + /* Here if argument BooleAnd */ + t10 = arg4 & arg1; + goto g8124; + +g8126: + if (_trace) printf("g8126:\n"); + t1 = (t10 == Boole_AndC1) ? 1 : 0; + +g8144: + if (_trace) printf("g8144:\n"); + if (t1 == 0) + goto g8127; + /* Here if argument BooleAndC1 */ + t10 = arg1 & ~arg4; + goto g8124; + +g8127: + if (_trace) printf("g8127:\n"); + t1 = (t10 == Boole_2) ? 1 : 0; + +g8145: + if (_trace) printf("g8145:\n"); + if (t1 == 0) + goto g8128; + /* Here if argument Boole2 */ + t10 = arg1; + goto g8124; + +g8128: + if (_trace) printf("g8128:\n"); + t1 = (t10 == Boole_AndC2) ? 1 : 0; + +g8146: + if (_trace) printf("g8146:\n"); + if (t1 == 0) + goto g8129; + /* Here if argument BooleAndC2 */ + t10 = arg4 & ~arg1; + goto g8124; + +g8129: + if (_trace) printf("g8129:\n"); + t1 = (t10 == Boole_1) ? 1 : 0; + +g8147: + if (_trace) printf("g8147:\n"); + if (t1 == 0) + goto g8130; + /* Here if argument Boole1 */ + t10 = arg4; + goto g8124; + +g8130: + if (_trace) printf("g8130:\n"); + t1 = (t10 == Boole_Xor) ? 1 : 0; + +g8148: + if (_trace) printf("g8148:\n"); + if (t1 == 0) + goto g8131; + /* Here if argument BooleXor */ + t10 = arg4 ^ arg1; + goto g8124; + +g8131: + if (_trace) printf("g8131:\n"); + t1 = (t10 == Boole_Ior) ? 1 : 0; + +g8149: + if (_trace) printf("g8149:\n"); + if (t1 == 0) + goto g8132; + /* Here if argument BooleIor */ + t10 = arg4 | arg1; + goto g8124; + +g8132: + if (_trace) printf("g8132:\n"); + t1 = (t10 == Boole_Nor) ? 1 : 0; + +g8150: + if (_trace) printf("g8150:\n"); + if (t1 == 0) + goto g8133; + /* Here if argument BooleNor */ + t10 = arg4 | arg1; + t10 = ~t10; + goto g8124; + +g8133: + if (_trace) printf("g8133:\n"); + t1 = (t10 == Boole_Equiv) ? 1 : 0; + +g8151: + if (_trace) printf("g8151:\n"); + if (t1 == 0) + goto g8134; + /* Here if argument BooleEquiv */ + t10 = arg4 ^ arg1; + t10 = ~t10; + goto g8124; + +g8134: + if (_trace) printf("g8134:\n"); + t1 = (t10 == Boole_C1) ? 1 : 0; + +g8152: + if (_trace) printf("g8152:\n"); + if (t1 == 0) + goto g8135; + /* Here if argument BooleC1 */ + t10 = ~arg4; + goto g8124; + +g8135: + if (_trace) printf("g8135:\n"); + t1 = (t10 == Boole_OrC1) ? 1 : 0; + +g8153: + if (_trace) printf("g8153:\n"); + if (t1 == 0) + goto g8136; + /* Here if argument BooleOrC1 */ + t10 = arg1 | ~(arg4); + goto g8124; + +g8136: + if (_trace) printf("g8136:\n"); + t1 = (t10 == Boole_C2) ? 1 : 0; + +g8154: + if (_trace) printf("g8154:\n"); + if (t1 == 0) + goto g8137; + /* Here if argument BooleC2 */ + t10 = ~arg1; + goto g8124; + +g8137: + if (_trace) printf("g8137:\n"); + t1 = (t10 == Boole_OrC2) ? 1 : 0; + +g8155: + if (_trace) printf("g8155:\n"); + if (t1 == 0) + goto g8138; + /* Here if argument BooleOrC2 */ + t10 = arg4 & ~arg1; + goto g8124; + +g8138: + if (_trace) printf("g8138:\n"); + t1 = (t10 == Boole_Nand) ? 1 : 0; + +g8156: + if (_trace) printf("g8156:\n"); + if (t1 == 0) + goto g8139; + /* Here if argument BooleNand */ + t10 = arg4 & arg1; + goto g8124; + +g8139: + if (_trace) printf("g8139:\n"); + t1 = (t10 == Boole_Set) ? 1 : 0; + +g8157: + if (_trace) printf("g8157:\n"); + if (t1 == 0) + goto g8124; + /* Here if argument BooleSet */ + t10 = ~zero; + +g8124: + if (_trace) printf("g8124:\n"); + *(u32 *)iSP = t10; + goto NEXTINSTRUCTION; + +g8123: + if (_trace) printf("g8123:\n"); + t1 = (arg5 == ALUFunction_Byte) ? 1 : 0; + +g8183: + if (_trace) printf("g8183:\n"); + if (t1 == 0) + goto g8158; + /* Here if argument ALUFunctionByte */ + /* Get rotate */ + t2 = *(u64 *)&(processor->byterotate); + /* Get bytesize */ + t3 = *(u64 *)&(processor->bytesize); + /* Get background */ + t1 = arg6 >> 10; + /* Extract the byte background */ + t1 = t1 & 3; + t4 = (t1 == ALUByteBackground_Op1) ? 1 : 0; + +g8165: + if (_trace) printf("g8165:\n"); + if (t4 == 0) + goto g8161; + /* Here if argument ALUByteBackgroundOp1 */ + t1 = arg4; + +g8160: + if (_trace) printf("g8160:\n"); + t5 = arg6 >> 12; + /* Extractthe byte rotate latch */ + t5 = t5 & 1; + t10 = arg1 << (t2 & 63); + t4 = (u32)(t10 >> ((4&7)*8)); + t10 = (u32)t10; + /* OP2 rotated */ + t10 = t10 | t4; + /* Don't update rotate latch if not requested */ + if (t5 == 0) + goto g8159; + *(u64 *)&processor->rotatelatch = t10; + +g8159: + if (_trace) printf("g8159:\n"); + t5 = zero + -2; + t5 = t5 << (t3 & 63); + /* Compute mask */ + t5 = ~t5; + /* Get byte function */ + t4 = arg6 >> 13; + t4 = t4 & 1; + t3 = (t4 == ALUByteFunction_Dpb) ? 1 : 0; + +g8170: + if (_trace) printf("g8170:\n"); + if (t3 == 0) + goto g8167; + /* Here if argument ALUByteFunctionDpb */ + /* Position mask */ + t5 = t5 << (t2 & 63); + +g8166: + if (_trace) printf("g8166:\n"); + /* rotated&mask */ + t10 = t10 & t5; + /* background&~mask */ + t1 = t1 & ~t5; + t10 = t10 | t1; + *(u32 *)iSP = t10; + goto NEXTINSTRUCTION; + +g8158: + if (_trace) printf("g8158:\n"); + t1 = (arg5 == ALUFunction_Adder) ? 1 : 0; + +g8184: + if (_trace) printf("g8184:\n"); + if (t1 == 0) + goto g8171; + /* Here if argument ALUFunctionAdder */ + t3 = arg6 >> 11; + /* Extract the op2 */ + t3 = t3 & 3; + t2 = arg6 >> 10; + /* Extract the adder carry in */ + t2 = t2 & 1; + t4 = (t3 == ALUAdderOp2_Op2) ? 1 : 0; + +g8179: + if (_trace) printf("g8179:\n"); + if (t4 == 0) + goto g8174; + /* Here if argument ALUAdderOp2Op2 */ + t1 = arg1; + +g8173: + if (_trace) printf("g8173:\n"); + t10 = arg4 + t1; + t10 = t10 + t2; + /* Sign bit */ + t3 = t10 >> 31; + /* Next bit */ + t4 = t10 >> 32; + /* Low bit is now overflow indicator */ + t3 = t3 ^ t4; + /* Get the load-carry-in bit */ + t4 = arg6 >> 24; + *(u64 *)&processor->aluoverflow = t3; + if ((t4 & 1) == 0) + goto g8172; + /* Get the carry */ + t3 = (u32)(t10 >> ((4&7)*8)); + t4 = zero + 1024; + arg6 = arg6 & ~t4; + t4 = t3 & 1; + t4 = t4 << 10; + /* Set the adder carry in */ + arg6 = arg6 | t4; + *(u64 *)&processor->aluandrotatecontrol = arg6; + +g8172: + if (_trace) printf("g8172:\n"); + t3 = ((s64)arg4 < (s64)t1) ? 1 : 0; + *(u64 *)&processor->aluborrow = t3; + arg4 = (s32)arg4; + arg1 = (s32)arg1; + t3 = ((s64)arg4 < (s64)t1) ? 1 : 0; + *(u64 *)&processor->alulessthan = t3; + *(u32 *)iSP = t10; + goto NEXTINSTRUCTION; + +g8171: + if (_trace) printf("g8171:\n"); + t1 = (arg5 == ALUFunction_MultiplyDivide) ? 1 : 0; + +g8185: + if (_trace) printf("g8185:\n"); + if (t1 == 0) + goto g8122; + /* Here if argument ALUFunctionMultiplyDivide */ + /* This instruction has not been written yet. */ + arg5 = 0; + arg2 = 38; + goto illegaloperand; + *(u32 *)iSP = t10; + goto NEXTINSTRUCTION; + +g8122: + if (_trace) printf("g8122:\n"); + +aluexc: + if (_trace) printf("aluexc:\n"); + arg5 = 0; + arg2 = 80; + goto illegaloperand; + +g8174: + if (_trace) printf("g8174:\n"); + t4 = (t3 == ALUAdderOp2_Zero) ? 1 : 0; + +g8186: + if (_trace) printf("g8186:\n"); + if (t4 == 0) + goto g8175; + /* Here if argument ALUAdderOp2Zero */ + t1 = zero; + goto g8173; + +g8175: + if (_trace) printf("g8175:\n"); + t4 = (t3 == ALUAdderOp2_Invert) ? 1 : 0; + +g8187: + if (_trace) printf("g8187:\n"); + if (t4 == 0) + goto g8176; + /* Here if argument ALUAdderOp2Invert */ + t1 = (s32)arg1; + t1 = zero - t1; + t1 = (u32)t1; + goto g8173; + +g8176: + if (_trace) printf("g8176:\n"); + t4 = (t3 == ALUAdderOp2_MinusOne) ? 1 : 0; + +g8188: + if (_trace) printf("g8188:\n"); + if (t4 == 0) + goto g8173; + /* Here if argument ALUAdderOp2MinusOne */ + t1 = ~zero; + t1 = (u32)t1; + goto g8173; + +g8167: + if (_trace) printf("g8167:\n"); + t3 = (t4 == ALUByteFunction_Ldb) ? 1 : 0; + +g8189: + if (_trace) printf("g8189:\n"); + if (t3 != 0) + goto g8166; + goto g8166; + +g8161: + if (_trace) printf("g8161:\n"); + t4 = (t1 == ALUByteBackground_RotateLatch) ? 1 : 0; + +g8190: + if (_trace) printf("g8190:\n"); + if (t4 == 0) + goto g8162; + /* Here if argument ALUByteBackgroundRotateLatch */ + t1 = *(u64 *)&(processor->rotatelatch); + goto g8160; + +g8162: + if (_trace) printf("g8162:\n"); + t4 = (t1 == ALUByteBackground_Zero) ? 1 : 0; + +g8191: + if (_trace) printf("g8191:\n"); + if (t4 == 0) + goto g8160; + /* Here if argument ALUByteBackgroundZero */ + t1 = zero; + goto g8160; + +/* end DoAlu */ + /* End of Halfword operand from stack instruction - DoAlu */ +/* start DoSpareOp */ + + /* Halfword 10 bit immediate instruction - DoSpareOp */ + +dospareop: + if (_trace) printf("dospareop:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoSpareOpIM: + if (_trace) printf("DoSpareOpIM:\n"); + +DoSpareOpSP: + if (_trace) printf("DoSpareOpSP:\n"); + +DoSpareOpLP: + if (_trace) printf("DoSpareOpLP:\n"); + +DoSpareOpFP: + if (_trace) printf("DoSpareOpFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + /* Get the instruction */ + t1 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* Position the opcode */ + t1 = t1 >> 10; + /* Extract it */ + t1 = t1 & 255; + /* arg1 = instruction arity */ + arg1 = 0; + /* arg2 = instruction opcode */ + arg2 = t1; + /* arg3 = stackp */ + arg3 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + /* when not stackp arg5=the arg */ + arg5 = 0; + /* arg6=tag to dispatch on */ + arg6 = 0; + goto exception; + goto NEXTINSTRUCTION; + +/* end DoSpareOp */ + /* End of Halfword operand from stack instruction - DoSpareOp */ + /* Reading and writing internal registers */ +/* start ReadRegisterFP */ + + +ReadRegisterFP: + if (_trace) printf("ReadRegisterFP:\n"); + /* Convert stack cache address to VMA */ + t5 = *(u64 *)&(processor->stackcachedata); + t4 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t5 = iFP - t5; + /* convert byte address to word address */ + t5 = t5 >> 3; + /* reconstruct VMA */ + t4 = t5 + t4; + t5 = Type_Locative; + *(u32 *)(iSP + 8) = t4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterFP */ +/* start ReadRegisterLP */ + + +ReadRegisterLP: + if (_trace) printf("ReadRegisterLP:\n"); + /* Convert stack cache address to VMA */ + t5 = *(u64 *)&(processor->stackcachedata); + t4 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t5 = iLP - t5; + /* convert byte address to word address */ + t5 = t5 >> 3; + /* reconstruct VMA */ + t4 = t5 + t4; + t5 = Type_Locative; + *(u32 *)(iSP + 8) = t4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterLP */ +/* start ReadRegisterSP */ + + +ReadRegisterSP: + if (_trace) printf("ReadRegisterSP:\n"); + /* Convert stack cache address to VMA */ + t5 = *(u64 *)&(processor->stackcachedata); + t4 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t5 = iSP - t5; + /* convert byte address to word address */ + t5 = t5 >> 3; + /* reconstruct VMA */ + t4 = t5 + t4; + t5 = Type_Locative; + *(u32 *)(iSP + 8) = t4; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterSP */ +/* start ReadRegisterStackCacheLowerBound */ + + +ReadRegisterStackCacheLowerBound: + if (_trace) printf("ReadRegisterStackCacheLowerBound:\n"); + t3 = *(u64 *)&(processor->stackcachebasevma); + t5 = Type_Locative; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStackCacheLowerBound */ +/* start ReadRegisterBARx */ + + +ReadRegisterBARx: + if (_trace) printf("ReadRegisterBARx:\n"); + /* BAR number into T2 */ + t2 = arg1 >> 7; + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + t1 = (u64)&processor->bar0; + iCP = *(u64 *)&(((CACHELINEP)iCP)->nextcp); + /* Now T1 points to the BAR */ + t1 = (t2 * 8) + t1; + t3 = *(u64 *)t1; + t4 = Type_Locative; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + goto cachevalid; + +/* end ReadRegisterBARx */ +/* start ReadRegisterContinuation */ + + +ReadRegisterContinuation: + if (_trace) printf("ReadRegisterContinuation:\n"); + t3 = *(u64 *)&(processor->continuation); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterContinuation */ +/* start ReadRegisterAluAndRotateControl */ + + +ReadRegisterAluAndRotateControl: + if (_trace) printf("ReadRegisterAluAndRotateControl:\n"); + t3 = *(u64 *)&(processor->aluandrotatecontrol); + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterAluAndRotateControl */ +/* start ReadRegisterControlRegister */ + + +ReadRegisterControlRegister: + if (_trace) printf("ReadRegisterControlRegister:\n"); + t3 = *(s32 *)&processor->control; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterControlRegister */ +/* start ReadRegisterCRArgumentSize */ + + +ReadRegisterCRArgumentSize: + if (_trace) printf("ReadRegisterCRArgumentSize:\n"); + t3 = *(s32 *)&processor->control; + /* Get the argument size field */ + t3 = t3 & 255; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterCRArgumentSize */ +/* start ReadRegisterEphemeralOldspaceRegister */ + + +ReadRegisterEphemeralOldspaceRegister: + if (_trace) printf("ReadRegisterEphemeralOldspaceRegister:\n"); + t3 = *(s32 *)&processor->ephemeraloldspace; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterEphemeralOldspaceRegister */ +/* start ReadRegisterZoneOldspaceRegister */ + + +ReadRegisterZoneOldspaceRegister: + if (_trace) printf("ReadRegisterZoneOldspaceRegister:\n"); + t3 = *(s32 *)&processor->zoneoldspace; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterZoneOldspaceRegister */ +/* start ReadRegisterChipRevision */ + + +ReadRegisterChipRevision: + if (_trace) printf("ReadRegisterChipRevision:\n"); + t3 = 5; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterChipRevision */ +/* start ReadRegisterFPCoprocessorPresent */ + + +ReadRegisterFPCoprocessorPresent: + if (_trace) printf("ReadRegisterFPCoprocessorPresent:\n"); + t4 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterFPCoprocessorPresent */ +/* start ReadRegisterPreemptRegister */ + + +ReadRegisterPreemptRegister: + if (_trace) printf("ReadRegisterPreemptRegister:\n"); + t3 = *(s32 *)&processor->interruptreg; + t3 = t3 & 3; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterPreemptRegister */ +/* start ReadRegisterIcacheControl */ + + +ReadRegisterIcacheControl: + if (_trace) printf("ReadRegisterIcacheControl:\n"); + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterIcacheControl */ +/* start ReadRegisterPrefetcherControl */ + + +ReadRegisterPrefetcherControl: + if (_trace) printf("ReadRegisterPrefetcherControl:\n"); + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterPrefetcherControl */ +/* start ReadRegisterMapCacheControl */ + + +ReadRegisterMapCacheControl: + if (_trace) printf("ReadRegisterMapCacheControl:\n"); + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterMapCacheControl */ +/* start ReadRegisterMemoryControl */ + + +ReadRegisterMemoryControl: + if (_trace) printf("ReadRegisterMemoryControl:\n"); + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterMemoryControl */ +/* start ReadRegisterStackCacheOverflowLimit */ + + +ReadRegisterStackCacheOverflowLimit: + if (_trace) printf("ReadRegisterStackCacheOverflowLimit:\n"); + t3 = *(s32 *)&processor->scovlimit; + t4 = *(u64 *)&(processor->stackcachebasevma); + t3 = t3 + t4; + t4 = Type_Locative; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStackCacheOverflowLimit */ +/* start ReadRegisterMicrosecondClock */ + + +ReadRegisterMicrosecondClock: + if (_trace) printf("ReadRegisterMicrosecondClock:\n"); + t1 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t1; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterMicrosecondClock */ +/* start ReadRegisterTOS */ + + +ReadRegisterTOS: + if (_trace) printf("ReadRegisterTOS:\n"); + t1 = *(u64 *)iSP; + iSP = iSP + 8; + t2 = t1 << 26; + t2 = t2 >> 26; + /* Push CDR-NEXT TOS */ + *(u64 *)iSP = t2; + goto NEXTINSTRUCTION; + +/* end ReadRegisterTOS */ +/* start ReadRegisterEventCount */ + + +ReadRegisterEventCount: + if (_trace) printf("ReadRegisterEventCount:\n"); + t3 = *(u64 *)&(processor->areventcount); + t4 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterEventCount */ +/* start ReadRegisterBindingStackPointer */ + + +ReadRegisterBindingStackPointer: + if (_trace) printf("ReadRegisterBindingStackPointer:\n"); + t3 = *(u64 *)&(processor->bindingstackpointer); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterBindingStackPointer */ +/* start ReadRegisterCatchBlockList */ + + +ReadRegisterCatchBlockList: + if (_trace) printf("ReadRegisterCatchBlockList:\n"); + t3 = *(u64 *)&(processor->catchblock); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterCatchBlockList */ +/* start ReadRegisterControlStackLimit */ + + +ReadRegisterControlStackLimit: + if (_trace) printf("ReadRegisterControlStackLimit:\n"); + t3 = *(s32 *)&processor->cslimit; + t5 = Type_Locative; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterControlStackLimit */ +/* start ReadRegisterControlStackExtraLimit */ + + +ReadRegisterControlStackExtraLimit: + if (_trace) printf("ReadRegisterControlStackExtraLimit:\n"); + t3 = *(s32 *)&processor->csextralimit; + t5 = Type_Locative; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterControlStackExtraLimit */ +/* start ReadRegisterBindingStackLimit */ + + +ReadRegisterBindingStackLimit: + if (_trace) printf("ReadRegisterBindingStackLimit:\n"); + t3 = *(u64 *)&(processor->bindingstacklimit); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterBindingStackLimit */ +/* start ReadRegisterPHTBase */ + + +ReadRegisterPHTBase: + if (_trace) printf("ReadRegisterPHTBase:\n"); + t5 = Type_Locative; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterPHTBase */ +/* start ReadRegisterPHTMask */ + + +ReadRegisterPHTMask: + if (_trace) printf("ReadRegisterPHTMask:\n"); + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterPHTMask */ +/* start ReadRegisterCountMapReloads */ + + +ReadRegisterCountMapReloads: + if (_trace) printf("ReadRegisterCountMapReloads:\n"); + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = zero; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterCountMapReloads */ +/* start ReadRegisterListCacheArea */ + + +ReadRegisterListCacheArea: + if (_trace) printf("ReadRegisterListCacheArea:\n"); + t3 = *(u64 *)&(processor->lcarea); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterListCacheArea */ +/* start ReadRegisterListCacheAddress */ + + +ReadRegisterListCacheAddress: + if (_trace) printf("ReadRegisterListCacheAddress:\n"); + t3 = *(u64 *)&(processor->lcaddress); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterListCacheAddress */ +/* start ReadRegisterListCacheLength */ + + +ReadRegisterListCacheLength: + if (_trace) printf("ReadRegisterListCacheLength:\n"); + t3 = *(s32 *)&processor->lclength; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterListCacheLength */ +/* start ReadRegisterStructureCacheArea */ + + +ReadRegisterStructureCacheArea: + if (_trace) printf("ReadRegisterStructureCacheArea:\n"); + t3 = *(u64 *)&(processor->scarea); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStructureCacheArea */ +/* start ReadRegisterStructureCacheAddress */ + + +ReadRegisterStructureCacheAddress: + if (_trace) printf("ReadRegisterStructureCacheAddress:\n"); + t3 = *(u64 *)&(processor->scaddress); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStructureCacheAddress */ +/* start ReadRegisterStructureCacheLength */ + + +ReadRegisterStructureCacheLength: + if (_trace) printf("ReadRegisterStructureCacheLength:\n"); + t3 = *(s32 *)&processor->sclength; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStructureCacheLength */ +/* start ReadRegisterDynamicBindingCacheBase */ + + +ReadRegisterDynamicBindingCacheBase: + if (_trace) printf("ReadRegisterDynamicBindingCacheBase:\n"); + t3 = *(u64 *)&(processor->dbcbase); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterDynamicBindingCacheBase */ +/* start ReadRegisterDynamicBindingCacheMask */ + + +ReadRegisterDynamicBindingCacheMask: + if (_trace) printf("ReadRegisterDynamicBindingCacheMask:\n"); + t3 = *(u64 *)&(processor->dbcmask); + iSP = iSP + 8; + t5 = t3 << 26; + t5 = t5 >> 26; + *(u64 *)iSP = t5; + goto NEXTINSTRUCTION; + +/* end ReadRegisterDynamicBindingCacheMask */ +/* start ReadRegisterChoicePointer */ + + +ReadRegisterChoicePointer: + if (_trace) printf("ReadRegisterChoicePointer:\n"); + t3 = *(s32 *)&processor->choiceptr; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterChoicePointer */ +/* start ReadRegisterStructureStackChoicePointer */ + + +ReadRegisterStructureStackChoicePointer: + if (_trace) printf("ReadRegisterStructureStackChoicePointer:\n"); + t3 = *(s32 *)&processor->sstkchoiceptr; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStructureStackChoicePointer */ +/* start ReadRegisterFEPModeTrapVectorAddress */ + + +ReadRegisterFEPModeTrapVectorAddress: + if (_trace) printf("ReadRegisterFEPModeTrapVectorAddress:\n"); + t3 = *(u64 *)&(processor->fepmodetrapvecaddress); + goto NEXTINSTRUCTION; + +/* end ReadRegisterFEPModeTrapVectorAddress */ +/* start ReadRegisterStackFrameMaximumSize */ + + +ReadRegisterStackFrameMaximumSize: + if (_trace) printf("ReadRegisterStackFrameMaximumSize:\n"); + t3 = zero + 128; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStackFrameMaximumSize */ +/* start ReadRegisterStackCacheDumpQuantum */ + + +ReadRegisterStackCacheDumpQuantum: + if (_trace) printf("ReadRegisterStackCacheDumpQuantum:\n"); + t3 = zero + 896; + t5 = Type_Fixnum; + *(u32 *)(iSP + 8) = t3; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterStackCacheDumpQuantum */ +/* start ReadRegisterConstantNIL */ + + +ReadRegisterConstantNIL: + if (_trace) printf("ReadRegisterConstantNIL:\n"); + t5 = *(u64 *)&(processor->taddress); + /* push the data */ + *(u64 *)(iSP + 8) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterConstantNIL */ +/* start ReadRegisterConstantT */ + + +ReadRegisterConstantT: + if (_trace) printf("ReadRegisterConstantT:\n"); + t5 = *(u64 *)&(processor->niladdress); + /* push the data */ + *(u64 *)(iSP + 8) = t5; + iSP = iSP + 8; + goto NEXTINSTRUCTION; + +/* end ReadRegisterConstantT */ +/* start ReadRegisterError */ + + +ReadRegisterError: + if (_trace) printf("ReadRegisterError:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +/* end ReadRegisterError */ +/* start WriteRegisterFP */ + + +WriteRegisterFP: + if (_trace) printf("WriteRegisterFP:\n"); +#ifdef IVERIFY + /* Base of the stack cache */ + t2 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t1 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + t2 = arg3 - t2; + /* In range? */ + t3 = ((u64)t2 < (u64)t1) ? 1 : 0; + t1 = *(u64 *)&(processor->stackcachedata); + /* J. if not in cache */ + if (t3 == 0) + goto badregister; + /* reconstruct SCA */ + t1 = (t2 * 8) + t1; + iFP = t1; + goto NEXTINSTRUCTION; + arg5 = 0; + arg2 = 84; + goto illegaloperand; +#endif + +/* end WriteRegisterFP */ +/* start WriteRegisterLP */ + + +WriteRegisterLP: + if (_trace) printf("WriteRegisterLP:\n"); +#ifdef IVERIFY + /* Base of the stack cache */ + t2 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t1 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + t2 = arg3 - t2; + /* In range? */ + t3 = ((u64)t2 < (u64)t1) ? 1 : 0; + t1 = *(u64 *)&(processor->stackcachedata); + /* J. if not in cache */ + if (t3 == 0) + goto badregister; + /* reconstruct SCA */ + t1 = (t2 * 8) + t1; + iLP = t1; + goto NEXTINSTRUCTION; + arg5 = 0; + arg2 = 84; + goto illegaloperand; +#endif + +/* end WriteRegisterLP */ +/* start WriteRegisterSP */ + + +WriteRegisterSP: + if (_trace) printf("WriteRegisterSP:\n"); +#ifdef IVERIFY + /* Base of the stack cache */ + t2 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t1 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + t2 = arg3 - t2; + /* In range? */ + t3 = ((u64)t2 < (u64)t1) ? 1 : 0; + t1 = *(u64 *)&(processor->stackcachedata); + /* J. if not in cache */ + if (t3 == 0) + goto badregister; + /* reconstruct SCA */ + t1 = (t2 * 8) + t1; + iSP = t1; + goto NEXTINSTRUCTION; + arg5 = 0; + arg2 = 84; + goto illegaloperand; +#endif + +/* end WriteRegisterSP */ +/* start WriteRegisterStackCacheLowerBound */ + + +WriteRegisterStackCacheLowerBound: + if (_trace) printf("WriteRegisterStackCacheLowerBound:\n"); +#ifdef IVERIFY + *(u64 *)&processor->stackcachebasevma = arg3; + t1 = *(u64 *)&(processor->stackcachesize); + t1 = arg3 + t1; + *(u64 *)&processor->stackcachetopvma = t1; + goto NEXTINSTRUCTION; + arg5 = 0; + arg2 = 84; + goto illegaloperand; +#endif + +/* end WriteRegisterStackCacheLowerBound */ +/* start WriteRegisterContinuation */ + + +WriteRegisterContinuation: + if (_trace) printf("WriteRegisterContinuation:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->continuation = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterContinuation */ +/* start WriteRegisterAluAndRotateControl */ + + +WriteRegisterAluAndRotateControl: + if (_trace) printf("WriteRegisterAluAndRotateControl:\n"); + t1 = arg3 >> 14; + /* Extract the function class bits */ + t1 = t1 & 3; + *(u64 *)&processor->aluandrotatecontrol = arg3; + t2 = arg3 >> 5; + /* Extract the byte size */ + t2 = t2 & 31; + *(u64 *)&processor->aluop = t1; + /* Extract the Byte Rotate */ + t3 = arg3 & 31; + *(u64 *)&processor->bytesize = t2; + *(u64 *)&processor->byterotate = t3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterAluAndRotateControl */ +/* start WriteRegisterControlRegister */ + + +WriteRegisterControlRegister: + if (_trace) printf("WriteRegisterControlRegister:\n"); + *(u32 *)&processor->control = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterControlRegister */ +/* start WriteRegisterEphemeralOldspaceRegister */ + + +WriteRegisterEphemeralOldspaceRegister: + if (_trace) printf("WriteRegisterEphemeralOldspaceRegister:\n"); + *(u64 *)&processor->ac0array = zero; + *(u64 *)&processor->ac1array = zero; + *(u64 *)&processor->ac2array = zero; + *(u64 *)&processor->ac3array = zero; + *(u64 *)&processor->ac4array = zero; + *(u64 *)&processor->ac5array = zero; + *(u64 *)&processor->ac6array = zero; + *(u64 *)&processor->ac7array = zero; + *(u32 *)&processor->ephemeraloldspace = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterEphemeralOldspaceRegister */ +/* start WriteRegisterZoneOldspaceRegister */ + + +WriteRegisterZoneOldspaceRegister: + if (_trace) printf("WriteRegisterZoneOldspaceRegister:\n"); + *(u32 *)&processor->zoneoldspace = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterZoneOldspaceRegister */ +/* start WriteRegisterFPCoprocessorPresent */ + + +WriteRegisterFPCoprocessorPresent: + if (_trace) printf("WriteRegisterFPCoprocessorPresent:\n"); + goto NEXTINSTRUCTION; + +/* end WriteRegisterFPCoprocessorPresent */ +/* start WriteRegisterPreemptRegister */ + + +WriteRegisterPreemptRegister: + if (_trace) printf("WriteRegisterPreemptRegister:\n"); + t3 = *(s32 *)&processor->interruptreg; + t3 = t3 & ~3L; + arg3 = arg3 & 3; + t3 = t3 | arg3; + *(u32 *)&processor->interruptreg = t3; + if ((t3 & 1) == 0) + goto NEXTINSTRUCTION; + *(u64 *)&processor->stop_interpreter = t3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterPreemptRegister */ +/* start WriteRegisterStackCacheOverflowLimit */ + + +WriteRegisterStackCacheOverflowLimit: + if (_trace) printf("WriteRegisterStackCacheOverflowLimit:\n"); + t1 = *(u64 *)&(processor->stackcachebasevma); + t1 = (u32)t1; + t1 = arg3 - t1; + *(u32 *)&processor->scovlimit = t1; + goto NEXTINSTRUCTION; + +/* end WriteRegisterStackCacheOverflowLimit */ +/* start WriteRegisterTOS */ + + +WriteRegisterTOS: + if (_trace) printf("WriteRegisterTOS:\n"); + goto NEXTINSTRUCTION; + +/* end WriteRegisterTOS */ +/* start WriteRegisterEventCount */ + + +WriteRegisterEventCount: + if (_trace) printf("WriteRegisterEventCount:\n"); + *(u64 *)&processor->areventcount = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterEventCount */ +/* start WriteRegisterBindingStackPointer */ + + +WriteRegisterBindingStackPointer: + if (_trace) printf("WriteRegisterBindingStackPointer:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->bindingstackpointer = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterBindingStackPointer */ +/* start WriteRegisterCatchBlockList */ + + +WriteRegisterCatchBlockList: + if (_trace) printf("WriteRegisterCatchBlockList:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->catchblock = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterCatchBlockList */ +/* start WriteRegisterControlStackLimit */ + + +WriteRegisterControlStackLimit: + if (_trace) printf("WriteRegisterControlStackLimit:\n"); + *(u32 *)&processor->cslimit = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterControlStackLimit */ +/* start WriteRegisterControlStackExtraLimit */ + + +WriteRegisterControlStackExtraLimit: + if (_trace) printf("WriteRegisterControlStackExtraLimit:\n"); + *(u32 *)&processor->csextralimit = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterControlStackExtraLimit */ +/* start WriteRegisterBindingStackLimit */ + + +WriteRegisterBindingStackLimit: + if (_trace) printf("WriteRegisterBindingStackLimit:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->bindingstacklimit = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterBindingStackLimit */ +/* start WriteRegisterListCacheArea */ + + +WriteRegisterListCacheArea: + if (_trace) printf("WriteRegisterListCacheArea:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->lcarea = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterListCacheArea */ +/* start WriteRegisterListCacheAddress */ + + +WriteRegisterListCacheAddress: + if (_trace) printf("WriteRegisterListCacheAddress:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->lcaddress = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterListCacheAddress */ +/* start WriteRegisterListCacheLength */ + + +WriteRegisterListCacheLength: + if (_trace) printf("WriteRegisterListCacheLength:\n"); + *(u32 *)&processor->lclength = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterListCacheLength */ +/* start WriteRegisterStructureCacheArea */ + + +WriteRegisterStructureCacheArea: + if (_trace) printf("WriteRegisterStructureCacheArea:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->scarea = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterStructureCacheArea */ +/* start WriteRegisterStructureCacheAddress */ + + +WriteRegisterStructureCacheAddress: + if (_trace) printf("WriteRegisterStructureCacheAddress:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->scaddress = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterStructureCacheAddress */ +/* start WriteRegisterStructureCacheLength */ + + +WriteRegisterStructureCacheLength: + if (_trace) printf("WriteRegisterStructureCacheLength:\n"); + *(u32 *)&processor->sclength = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterStructureCacheLength */ +/* start WriteRegisterDynamicBindingCacheBase */ + + +WriteRegisterDynamicBindingCacheBase: + if (_trace) printf("WriteRegisterDynamicBindingCacheBase:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->dbcbase = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterDynamicBindingCacheBase */ +/* start WriteRegisterDynamicBindingCacheMask */ + + +WriteRegisterDynamicBindingCacheMask: + if (_trace) printf("WriteRegisterDynamicBindingCacheMask:\n"); + arg4 = arg2 << 32; + /* construct the combined word */ + arg4 = arg4 | arg3; + *(u64 *)&processor->dbcmask = arg4; + goto NEXTINSTRUCTION; + +/* end WriteRegisterDynamicBindingCacheMask */ +/* start WriteRegisterChoicePointer */ + + +WriteRegisterChoicePointer: + if (_trace) printf("WriteRegisterChoicePointer:\n"); + *(u32 *)&processor->choiceptr = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterChoicePointer */ +/* start WriteRegisterStructureStackChoicePointer */ + + +WriteRegisterStructureStackChoicePointer: + if (_trace) printf("WriteRegisterStructureStackChoicePointer:\n"); + *(u32 *)&processor->sstkchoiceptr = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterStructureStackChoicePointer */ +/* start WriteRegisterFEPModeTrapVectorAddress */ + + +WriteRegisterFEPModeTrapVectorAddress: + if (_trace) printf("WriteRegisterFEPModeTrapVectorAddress:\n"); + *(u32 *)&processor->fepmodetrapvecaddress = arg3; + goto NEXTINSTRUCTION; + +/* end WriteRegisterFEPModeTrapVectorAddress */ +/* start WriteRegisterMappingTableCache */ + + +WriteRegisterMappingTableCache: + if (_trace) printf("WriteRegisterMappingTableCache:\n"); + goto NEXTINSTRUCTION; + +/* end WriteRegisterMappingTableCache */ +/* start WriteRegisterError */ + + +WriteRegisterError: + if (_trace) printf("WriteRegisterError:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +/* end WriteRegisterError */ + /* Coprocessor read and write are implemented in C in order to */ + /* encourage creativity! The hooks are in aicoproc.c */ +/* start DoCoprocessorRead */ + + /* Halfword 10 bit immediate instruction - DoCoprocessorRead */ + +docoprocessorread: + if (_trace) printf("docoprocessorread:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoCoprocessorReadIM: + if (_trace) printf("DoCoprocessorReadIM:\n"); + +DoCoprocessorReadSP: + if (_trace) printf("DoCoprocessorReadSP:\n"); + +DoCoprocessorReadLP: + if (_trace) printf("DoCoprocessorReadLP:\n"); + +DoCoprocessorReadFP: + if (_trace) printf("DoCoprocessorReadFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + r0 = *(u64 *)&(processor->coprocessorreadhook); + *(u64 *)&processor->cp = iCP; + *(u64 *)&processor->epc = iPC; + *(u64 *)&processor->sp = iSP; + *(u64 *)&processor->fp = iFP; + *(u64 *)&processor->lp = iLP; + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + pv = r0; + r0 = (*( u64 (*)(u64, u64) )r0)(arg1, arg2); /* jsr */ + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + iCP = *(u64 *)&(processor->cp); + iPC = *(u64 *)&(processor->epc); + iSP = *(u64 *)&(processor->sp); + iFP = *(u64 *)&(processor->fp); + iLP = *(u64 *)&(processor->lp); + /* Long -1 is never a valid LISP value */ + t1 = zero + -1; + t1 = (r0 == t1) ? 1 : 0; + /* J. if CoprocessorRead exception return */ + if (t1 != 0) + goto cpreadexc; + iSP = iSP + 8; + t1 = r0 << 26; + t1 = t1 >> 26; + /* Push the result of coprocessor read! */ + *(u64 *)iSP = t1; + goto NEXTINSTRUCTION; + +cpreadexc: + if (_trace) printf("cpreadexc:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +/* end DoCoprocessorRead */ + /* End of Halfword operand from stack instruction - DoCoprocessorRead */ +/* start DoCoprocessorWrite */ + + /* Halfword 10 bit immediate instruction - DoCoprocessorWrite */ + +docoprocessorwrite: + if (_trace) printf("docoprocessorwrite:\n"); + /* Actually only one entry point, but simulate others for dispatch */ +#ifdef TRACING +#endif + +DoCoprocessorWriteIM: + if (_trace) printf("DoCoprocessorWriteIM:\n"); + +DoCoprocessorWriteSP: + if (_trace) printf("DoCoprocessorWriteSP:\n"); + +DoCoprocessorWriteLP: + if (_trace) printf("DoCoprocessorWriteLP:\n"); + +DoCoprocessorWriteFP: + if (_trace) printf("DoCoprocessorWriteFP:\n"); + arg1 = (u16)(arg3 >> ((4&7)*8)); + /* arg1 has operand preloaded. */ + /* The value to be written */ + arg2 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t2 = zero + CoprocessorRegister_UnwindStackForRestartOrApply; + t2 = arg1 - t2; + if (t2 != 0) + goto g8194; + /* Here if argument CoprocessorRegisterUnwindStackForRestartOrApply */ + /* peek at new continuation to look at tag */ + t1 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + t1 = (u32)t1; + t3 = t2 - Type_EvenPC; + /* Strip CDR code, low bits */ + t3 = t3 & 62; + if (t3 != 0) + goto unwindillegalcontinuation; + /* Get new continuation */ + t1 = *(u64 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + /* Update continuation register */ + *(u64 *)&processor->continuation = t1; + *(u64 *)&processor->continuationcp = zero; + /* Get new FP */ + t1 = *(s32 *)iSP; + /* Get new FP */ + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + t3 = t2 - Type_Locative; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto unwindillegalfp; + /* Convert VMA to stack cache address */ + t2 = *(u64 *)&(processor->stackcachebasevma); + iFP = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t2 = t1 - t2; + /* reconstruct SCA */ + iFP = (t2 * 8) + iFP; + /* Get new LP */ + t1 = *(s32 *)iSP; + /* Get new LP */ + t2 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + t3 = t2 - Type_Locative; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto unwindillegallp; + /* Convert VMA to stack cache address */ + t2 = *(u64 *)&(processor->stackcachebasevma); + iLP = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t2 = t1 - t2; + /* reconstruct SCA */ + iLP = (t2 * 8) + iLP; + /* Update CDR-CODEs to make it a legitimate frame */ + /* Tag of saved continuation register */ + t1 = *(s32 *)(iFP + 4); + /* Tag of saved control register */ + t2 = *(s32 *)(iFP + 12); + /* Set CDR-CODE to 3 */ + t1 = t1 | 192; + /* Put it back */ + *(u32 *)(iFP + 4) = t1; + /* Set CDR-CODE to 3 */ + t2 = t2 | 192; + /* Put it back */ + *(u32 *)(iFP + 12) = t2; + /* Copy the current trap-on-exit bit into the saved control register */ + /* Get control register */ + t1 = *(s32 *)&processor->control; + /* Get saved control register */ + t2 = *(s32 *)(iFP + 8); + t2 = (u32)t2; + t3 = (256) << 16; + /* Remove saved control register's trap-on-exit bit */ + t2 = t2 & ~t3; + /* Extract control register's trap-on-exit bit */ + t1 = t1 & t3; + /* Copy it into saved control register */ + t2 = t2 | t1; + /* Update saved control register */ + *(u32 *)(iFP + 8) = t2; + /* Restore the new control register with proper trap mode */ + /* peek at new control register to look at tag */ + t1 = *(s32 *)iSP; + t2 = *(s32 *)(iSP + 4); + t1 = (u32)t1; + t3 = t2 - Type_Fixnum; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto unwindillegalcontrol; + /* Get new control register */ + t1 = *(s32 *)iSP; + /* Pop Stack. */ + iSP = iSP - 8; + t1 = (u32)t1; + *(u32 *)&processor->control = t1; + goto g8193; + +g8194: + if (_trace) printf("g8194:\n"); + t2 = zero + CoprocessorRegister_FlushIDCaches; + t2 = arg1 - t2; + if (t2 != 0) + goto g8195; + /* Here if argument CoprocessorRegisterFlushIDCaches */ + /* We're about to flush the instruction cache so we can't rely */ + /* on ContinueToNextInstruction working. Instead, we must load */ + /* the next PC now and explicitly fill the cache. */ + iPC = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + t1 = *(u64 *)&(processor->flushcaches_hook); + *(u64 *)&processor->cp = iCP; + *(u64 *)&processor->epc = iPC; + *(u64 *)&processor->sp = iSP; + *(u64 *)&processor->fp = iFP; + *(u64 *)&processor->lp = iLP; + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + pv = t1; + r0 = (*( u64 (*)(u64, u64) )t1)(arg1, arg2); /* jsr */ + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + iCP = *(u64 *)&(processor->cp); + iPC = *(u64 *)&(processor->epc); + iSP = *(u64 *)&(processor->sp); + iFP = *(u64 *)&(processor->fp); + iLP = *(u64 *)&(processor->lp); + /* Compute proper iCP after FlushCaches resets it. */ + goto ICACHEMISS; + goto g8193; + +g8195: + if (_trace) printf("g8195:\n"); + t2 = zero + CoprocessorRegister_FlushCachesForVMA; + t2 = arg1 - t2; + if (t2 != 0) + goto g8196; + /* Here if argument CoprocessorRegisterFlushCachesForVMA */ + /* Extract the VMA */ + arg2 = (u32)arg2; + /* convert continuation to an even pc */ + t1 = arg2 << 1; + /* Convert a halfword address into a CP pointer. */ + /* Get third byte into bottom */ + t2 = t1 >> (CacheLine_RShift & 63); + /* get the base of the icache */ + t4 = *(u64 *)&(processor->icachebase); + t3 = zero + -1; + t3 = t3 + ((4) << 16); + /* Now third byte is zero-shifted */ + t2 = t2 << (CacheLine_LShift & 63); + t2 = t1 + t2; + t2 = t2 & t3; + /* temp=cpos*32 */ + t3 = t2 << 5; + /* cpos=cpos*16 */ + t2 = t2 << 4; + /* temp2=base+cpos*32 */ + t4 = t4 + t3; + /* cpos=base+cpos*48 */ + t2 = t4 + t2; + t3 = *(u64 *)&(((CACHELINEP)t2)->pcdata); + /* Is this VMA in the cache? */ + t3 = (t1 == t3) ? 1 : 0; + /* No. */ + if (t3 == 0) + goto dcwnotincache; + /* Yes, flush it */ + *(u64 *)&((CACHELINEP)t2)->pcdata = zero; + *((u64 *)(&((CACHELINEP)t2)->pcdata)+CACHELINESIZE/8) = zero; + +dcwnotincache: + if (_trace) printf("dcwnotincache:\n"); + goto g8193; + +g8196: + if (_trace) printf("g8196:\n"); + t2 = zero + CoprocessorRegister_FlushHiddenArrayRegisters; + t2 = arg1 - t2; + if (t2 != 0) + goto g8197; + /* Here if argument CoprocessorRegisterFlushHiddenArrayRegisters */ + /* Get the VMA of the new stack array */ + arg2 = (u32)arg2; + t8 = zero + AutoArrayRegMask; + t8 = arg2 & t8; + t7 = (u64)&processor->ac0array; + /* Here is our array register block */ + t7 = t7 + t8; + /* And here is the cached array */ + t8 = *(u64 *)&(((ARRAYCACHEP)t7)->array); + /* t8==1 iff cached array is ours */ + t8 = (arg2 == t8) ? 1 : 0; + if (t8 == 0) + goto arraynotincache; + /* Flush it */ + *(u64 *)&((ARRAYCACHEP)t7)->array = zero; + +arraynotincache: + if (_trace) printf("arraynotincache:\n"); + goto g8193; + +g8197: + if (_trace) printf("g8197:\n"); + /* Here for all other cases */ + /* Standard coprocessor register processing */ + r0 = *(u64 *)&(processor->coprocessorwritehook); + *(u64 *)&processor->cp = iCP; + *(u64 *)&processor->epc = iPC; + *(u64 *)&processor->sp = iSP; + *(u64 *)&processor->fp = iFP; + *(u64 *)&processor->lp = iLP; + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + pv = r0; + r0 = (*( u64 (*)(u64, u64) )r0)(arg1, arg2); /* jsr */ + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + iCP = *(u64 *)&(processor->cp); + iPC = *(u64 *)&(processor->epc); + iSP = *(u64 *)&(processor->sp); + iFP = *(u64 *)&(processor->fp); + iLP = *(u64 *)&(processor->lp); + /* J. if CoprocessorWrite exception return */ + if (r0 == 0) + goto cpreadexc; + goto g8193; + +g8198: + if (_trace) printf("g8198:\n"); + +g8193: + if (_trace) printf("g8193:\n"); + goto NEXTINSTRUCTION; + +unwindillegalcontinuation: + if (_trace) printf("unwindillegalcontinuation:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +unwindillegalcontrol: + if (_trace) printf("unwindillegalcontrol:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +unwindillegalfp: + if (_trace) printf("unwindillegalfp:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +unwindillegallp: + if (_trace) printf("unwindillegallp:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +cpwriteexc: + if (_trace) printf("cpwriteexc:\n"); + arg5 = 0; + arg2 = 84; + goto illegaloperand; + +/* end DoCoprocessorWrite */ + /* End of Halfword operand from stack instruction - DoCoprocessorWrite */ +/* start GetRPCC */ + + +getrpcc: + if (_trace) printf("getrpcc:\n"); + goto *ra; /* ret */ + +/* end GetRPCC */ +/* start SpinWheels */ + + +spinwheels: + if (_trace) printf("spinwheels:\n"); + arg1 = 1; + arg1 = arg1 << 25; + +spinwheelaxis: + if (_trace) printf("spinwheelaxis:\n"); + arg1 = arg1 + -1; + if ((s64)arg1 > 0) + goto spinwheelaxis; + goto *ra; /* ret */ + +/* end SpinWheels */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifunsubp.as */ diff --git a/stub/ifuntran.c b/stub/ifuntran.c new file mode 100644 index 0000000..c11e88e --- /dev/null +++ b/stub/ifuntran.c @@ -0,0 +1,112 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuntran.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* start NativeException */ + + +nativeexception: + if (_trace) printf("nativeexception:\n"); + /* Load linkage to escape block */ + t1 = *(u64 *)&(processor->linkage); + /* Re-load resumemulator */ + r0 = *(u64 *)&(processor->resumeema); + /* Restore SP (Just in case?) */ + iSP = *(u64 *)&(processor->restartsp); + *(u64 *)&processor->linkage = zero; + goto *t1; /* ret */ + +/* end NativeException */ +/* start PadPastAref1 */ + + +padpastaref1: + if (_trace) printf("padpastaref1:\n"); + /* Load linkage to escape block */ + t1 = *(u64 *)&(processor->linkage); + /* Re-load resumemulator */ + r0 = *(u64 *)&(processor->resumeema); + /* Restore SP (Just in case?) */ + iSP = *(u64 *)&(processor->restartsp); + *(u64 *)&processor->linkage = zero; + /* Load linkage to escape block */ + t1 = *(u64 *)&(processor->linkage); + /* Re-load resumemulator */ + r0 = *(u64 *)&(processor->resumeema); + /* Restore SP (Just in case?) */ + iSP = *(u64 *)&(processor->restartsp); + *(u64 *)&processor->linkage = zero; + goto *t1; /* ret */ + +/* end PadPastAref1 */ +/* start CarSubroutine */ + + +carsubroutine: + if (_trace) printf("carsubroutine:\n"); + sp = sp + -8; + *(u64 *)&processor->linkage = r0; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + r0 = r0 + 4; + *(u64 *)&processor->restartsp = iSP; + *(u64 *)sp = r0; + r0 = (u64)&&return0093; + goto carinternal; +return0093: + r0 = *(u64 *)sp; + *(u64 *)&processor->linkage = zero; + sp = sp + 8; + goto *r0; /* ret */ + +/* end CarSubroutine */ +/* start CdrSubroutine */ + + +cdrsubroutine: + if (_trace) printf("cdrsubroutine:\n"); + sp = sp + -8; + *(u64 *)&processor->linkage = r0; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + r0 = r0 + 4; + *(u64 *)&processor->restartsp = iSP; + *(u64 *)sp = r0; + r0 = (u64)&&return0094; + goto cdrinternal; +return0094: + r0 = *(u64 *)sp; + *(u64 *)&processor->linkage = zero; + sp = sp + 8; + goto *r0; /* ret */ + +/* end CdrSubroutine */ +/* start CarCdrSubroutine */ + + +carcdrsubroutine: + if (_trace) printf("carcdrsubroutine:\n"); + sp = sp + -8; + *(u64 *)&processor->linkage = r0; + t11 = *(u64 *)&(processor->stackcachebasevma); + /* Size of the stack cache (words) */ + t12 = *(s32 *)&processor->scovlimit; + r0 = r0 + 4; + *(u64 *)&processor->restartsp = iSP; + *(u64 *)sp = r0; + r0 = (u64)&&return0095; + goto carcdrinternal; +return0095: + r0 = *(u64 *)sp; + *(u64 *)&processor->linkage = zero; + sp = sp + 8; + goto *r0; /* ret */ + +/* end CarCdrSubroutine */ + + + +/* End of file automatically generated from ../alpha-emulator/ifuntran.as */ diff --git a/stub/ifuntrap.c b/stub/ifuntrap.c new file mode 100644 index 0000000..5269262 --- /dev/null +++ b/stub/ifuntrap.c @@ -0,0 +1,2676 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ifuntrap.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + +/* start DECODEFAULT */ + + +decodefault: + if (_trace) printf("decodefault:\n"); + /* We come here when a memory access faults to figure out why */ + /* retrieve the trapping VMA */ + t1 = *(u64 *)&(processor->vma); + /* Per-page attributes table */ + t3 = *(u64 *)&(processor->vmattributetable); + /* Index into the attributes table */ + t2 = t1 >> (MemoryPage_AddressShift & 63); + /* Address of the page's attributes */ + t3 = t2 + t3; + /* Get the quadword with the page's attributes */ + t2 = LDQ_U(t3); + /* Stash the VMA */ + *(u64 *)&processor->vma = t1; + /* Extract the page's attributes */ + t2 = (u8)(t2 >> ((t3&7)*8)); + /* Non-existent page */ + if (t2 == 0) + goto pagenotresident; + t3 = t2 & VMAttribute_AccessFault; + /* Access fault */ + if (t3 != 0) + goto pagefaultrequesthandler; + t3 = t2 & VMAttribute_TransportFault; + /* Transport fault */ + if (t3 != 0) + goto transporttrap; + t3 = t2 & VMAttribute_WriteFault; + /* Write fault */ + if (t3 != 0) + goto pagewritefault; + goto buserror; + +/* end DECODEFAULT */ +/* start HANDLEUNWINDPROTECT */ + + +handleunwindprotect: + if (_trace) printf("handleunwindprotect:\n"); + t4 = *(s32 *)&processor->catchblock; + t4 = (u32)t4; + /* Convert VMA to stack cache address */ + t2 = *(u64 *)&(processor->stackcachebasevma); + t3 = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t2 = t4 - t2; + /* reconstruct SCA */ + t3 = (t2 * 8) + t3; + t6 = *(s32 *)(t3 + 16); + t5 = *(s32 *)(t3 + 20); + t6 = (u32)t6; + t2 = *(s32 *)(t3 + 8); + t1 = *(s32 *)(t3 + 12); + t2 = (u32)t2; + /* Restore SP */ + iSP = *(u64 *)&(processor->restartsp); + t1 = *(u64 *)&(processor->bindingstackpointer); +#ifdef MINIMA + t4 = t1 >> 32; +#endif + t3 = (s32)t1 - (s32)t2; + /* J. if binding level= binding stack */ + if (t3 == 0) + goto g8736; +#ifdef MINIMA + /* BSP not a locative -> Deep-bound */ + t3 = t4 - Type_Locative; + /* Strip CDR code */ + t3 = t3 & 63; + if (t3 != 0) + goto dbunwindframetrap; +#endif + +g8737: + if (_trace) printf("g8737:\n"); + t1 = *(u64 *)&(processor->bindingstackpointer); + t4 = *(s32 *)&processor->control; + /* vma only */ + t1 = (u32)t1; + arg1 = (512) << 16; + t5 = t1 - 1; + t3 = t4 & arg1; + /* Turn off the bit */ + t4 = t4 & ~arg1; + if (t3 != 0) + goto g8738; + /* Get the SP, ->op2 */ + t4 = *(u64 *)&(processor->restartsp); + arg5 = 0; + arg2 = 20; + goto illegaloperand; + +g8738: + if (_trace) printf("g8738:\n"); + /* Memory Read Internal */ + +g8739: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + t10 = t1 + ivory; + t9 = *(s32 *)&processor->scovlimit; + t6 = (t10 * 4); + t7 = LDQ_U(t10); + /* Stack cache offset */ + t8 = t1 - t8; + t11 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t9 = ((u64)t8 < (u64)t9) ? 1 : 0; + t6 = *(s32 *)t6; + t7 = (u8)(t7 >> ((t10&7)*8)); + if (t9 != 0) + goto g8741; + +g8740: + t10 = zero + 224; + t11 = t11 >> (t7 & 63); + t10 = t10 >> (t7 & 63); + if (t11 & 1) + goto g8743; + +g8748: + /* Memory Read Internal */ + +g8749: + /* Base of stack cache */ + t8 = *(u64 *)&(processor->stackcachebasevma); + t10 = t5 + ivory; + t9 = *(s32 *)&processor->scovlimit; + arg1 = (t10 * 4); + t3 = LDQ_U(t10); + /* Stack cache offset */ + t8 = t5 - t8; + t11 = *(u64 *)&(processor->bindread_mask); + /* In range? */ + t9 = ((u64)t8 < (u64)t9) ? 1 : 0; + arg1 = *(s32 *)arg1; + t3 = (u8)(t3 >> ((t10&7)*8)); + if (t9 != 0) + goto g8751; + +g8750: + t10 = zero + 224; + t11 = t11 >> (t3 & 63); + t10 = t10 >> (t3 & 63); + arg1 = (u32)arg1; + if (t11 & 1) + goto g8753; + +g8758: + /* Memory Read Internal */ + +g8759: + /* Base of stack cache */ + t10 = *(u64 *)&(processor->stackcachebasevma); + t12 = arg1 + ivory; + t11 = *(s32 *)&processor->scovlimit; + t9 = (t12 * 4); + t8 = LDQ_U(t12); + /* Stack cache offset */ + t10 = arg1 - t10; + /* In range? */ + t11 = ((u64)t10 < (u64)t11) ? 1 : 0; + t9 = *(s32 *)t9; + t8 = (u8)(t8 >> ((t12&7)*8)); + if (t11 != 0) + goto g8761; + +g8760: + t10 = *(u64 *)&(processor->bindwrite_mask); + t12 = zero + 224; + t10 = t10 >> (t8 & 63); + t12 = t12 >> (t8 & 63); + if (t10 & 1) + goto g8763; + +g8768: + /* Merge cdr-code */ + t9 = t7 & 63; + t8 = t8 & 192; + t8 = t8 | t9; + t10 = arg1 + ivory; + t9 = (t10 * 4); + t12 = LDQ_U(t10); + t11 = (t8 & 0xff) << ((t10&7)*8); + t12 = t12 & ~(0xffL << (t10&7)*8); + +g8771: + if (_trace) printf("g8771:\n"); + t12 = t12 | t11; + t11 = *(u64 *)&(processor->stackcachebasevma); + STQ_U(t10, t12); + t10 = *(s32 *)&processor->scovlimit; + /* Stack cache offset */ + t11 = arg1 - t11; + /* In range? */ + t10 = ((u64)t11 < (u64)t10) ? 1 : 0; + *(u32 *)t9 = t6; + /* J. if in cache */ + if (t10 != 0) + goto g8770; + +g8769: + /* Get the old cleanup-bindings bit */ + t3 = t3 & 64; + t3 = t3 << 19; + t1 = t1 - 2; + /* vma only */ + *(u32 *)&processor->bindingstackpointer = t1; + t4 = t4 | t3; + *(u32 *)&processor->control = t4; + t1 = *(u64 *)&(processor->bindingstackpointer); + t3 = (s32)t1 - (s32)t2; + /* J. if binding level/= binding stack */ + if (t3 != 0) + goto g8737; + t2 = *(s32 *)&processor->interruptreg; + t3 = t2 & 2; + t3 = (t3 == 2) ? 1 : 0; + t2 = t2 | t3; + *(u32 *)&processor->interruptreg = t2; + if (t2 == 0) + goto g8736; + *(u64 *)&processor->stop_interpreter = t2; + +g8736: + if (_trace) printf("g8736:\n"); + /* Convert PC to a real continuation. */ + t3 = iPC & 1; + /* convert PC to a real word address. */ + t1 = iPC >> 1; + t3 = t3 + Type_EvenPC; + arg1 = *(s32 *)&processor->control; + t2 = arg1 >> 17; + t2 = t2 | 128; + t2 = t2 & 192; + /* TagType. */ + t3 = t3 & 63; + t3 = t3 | t2; + *(u32 *)(iSP + 8) = t1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t3; + iSP = iSP + 8; + /* Load catch-block PC */ + t4 = *(s32 *)&processor->catchblock; + t4 = (u32)t4; + /* Convert VMA to stack cache address */ + t2 = *(u64 *)&(processor->stackcachebasevma); + t3 = *(u64 *)&(processor->stackcachedata); + /* stack cache base relative offset */ + t2 = t4 - t2; + /* reconstruct SCA */ + t3 = (t2 * 8) + t3; + t6 = *(s32 *)t3; + t5 = *(s32 *)(t3 + 4); + t6 = (u32)t6; + /* Convert real continuation to PC. */ + iPC = t5 & 1; + iPC = t6 + iPC; + iPC = t6 + iPC; + t1 = (128) << 16; + arg1 = arg1 | t1; + t10 = *(s32 *)(t3 + 16); + t5 = *(s32 *)(t3 + 20); + t10 = (u32)t10; + /* This is the extra-arg bit */ + t6 = t5 & 128; + t8 = *(s32 *)&processor->extraandcatch; + /* This is the cleanup-catch bit */ + t7 = t5 & 64; + /* Shift bit into place for cr */ + t6 = t6 << 1; + /* Shift extra arg bit into place for cr */ + t7 = t7 << 20; + arg1 = arg1 & ~t8; + t6 = t6 | t7; + /* update the bits extra-arg/cleanupcatch */ + arg1 = arg1 | t6; + *(u32 *)&processor->control = arg1; + /* TagType. */ + t5 = t5 & 63; + t5 = t5 << 32; + t5 = t5 | t10; + *(u64 *)&processor->catchblock = t5; + goto interpretinstructionforbranch; +#ifdef MINIMA + +dbunwindframetrap: + if (_trace) printf("dbunwindframetrap:\n"); + goto dbunwindframetrap; +#endif + +g8770: + if (_trace) printf("g8770:\n"); + t10 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t10 = (t11 * 8) + t10; + /* Store in stack */ + *(u32 *)t10 = t6; + /* write the stack cache */ + *(u32 *)(t10 + 4) = t8; + goto g8769; + +g8761: + if (_trace) printf("g8761:\n"); + t11 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t10 = (t10 * 8) + t11; + t9 = *(s32 *)t10; + /* Read from stack cache */ + t8 = *(s32 *)(t10 + 4); + goto g8760; + +g8763: + if (_trace) printf("g8763:\n"); + if ((t12 & 1) == 0) + goto g8762; + /* Do the indirect thing */ + arg1 = (u32)t9; + goto g8759; + +g8762: + if (_trace) printf("g8762:\n"); + /* Load the memory action table for cycle */ + t10 = *(u64 *)&(processor->bindwrite); + /* TagType. */ + /* Discard the CDR code */ + t12 = t8 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = arg1; + /* Adjust for a longword load */ + t12 = (t12 * 4) + t10; + /* Get the memory action */ + t10 = *(s32 *)t12; + +g8765: + /* Perform memory action */ + arg1 = t10; + arg2 = 3; + goto performmemoryaction; + +g8751: + if (_trace) printf("g8751:\n"); + t9 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t9; + arg1 = *(s32 *)t8; + /* Read from stack cache */ + t3 = *(s32 *)(t8 + 4); + goto g8750; + +g8753: + if (_trace) printf("g8753:\n"); + if ((t10 & 1) == 0) + goto g8752; + /* Do the indirect thing */ + t5 = (u32)arg1; + goto g8749; + +g8752: + if (_trace) printf("g8752:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t3 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t5; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g8755: + /* Perform memory action */ + arg1 = t11; + arg2 = 2; + goto performmemoryaction; + +g8741: + if (_trace) printf("g8741:\n"); + t9 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t8 = (t8 * 8) + t9; + t6 = *(s32 *)t8; + /* Read from stack cache */ + t7 = *(s32 *)(t8 + 4); + goto g8740; + +g8743: + if (_trace) printf("g8743:\n"); + if ((t10 & 1) == 0) + goto g8742; + /* Do the indirect thing */ + t1 = (u32)t6; + goto g8739; + +g8742: + if (_trace) printf("g8742:\n"); + /* Load the memory action table for cycle */ + t11 = *(u64 *)&(processor->bindread); + /* TagType. */ + /* Discard the CDR code */ + t10 = t7 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t1; + /* Adjust for a longword load */ + t10 = (t10 * 4) + t11; + /* Get the memory action */ + t11 = *(s32 *)t10; + +g8745: + /* Perform memory action */ + arg1 = t11; + arg2 = 2; + goto performmemoryaction; + +/* end HANDLEUNWINDPROTECT */ +/* start PERFORMMEMORYACTION */ + + +performmemoryaction: + if (_trace) printf("performmemoryaction:\n"); + /* We get here when a memory action that will trap is detected. */ + /* ARG1 contains the memory action code with the Transport bit removed. */ + /* ARG2 contains the memory cycle so we can generate the proper microstate. */ + t1 = (arg1 == MemoryActionTrap) ? 1 : 0; + +g8800: + if (_trace) printf("g8800:\n"); + if (t1 == 0) + goto g8773; + /* Here if argument MemoryActionTrap */ + /* Get the failing VMA */ + t1 = *(u64 *)&(processor->vma); + t2 = (arg2 == Cycle_DataRead) ? 1 : 0; + +g8787: + if (_trace) printf("g8787:\n"); + if (t2 == 0) + goto g8775; + /* Here if argument CycleDataRead */ + arg5 = t1; + arg2 = 57; + goto illegaloperand; + +g8775: + if (_trace) printf("g8775:\n"); + t2 = (arg2 == Cycle_DataWrite) ? 1 : 0; + +g8788: + if (_trace) printf("g8788:\n"); + if (t2 == 0) + goto g8776; + /* Here if argument CycleDataWrite */ + arg5 = t1; + arg2 = 58; + goto illegaloperand; + +g8776: + if (_trace) printf("g8776:\n"); + t2 = (arg2 == Cycle_BindRead) ? 1 : 0; + +g8789: + if (_trace) printf("g8789:\n"); + if (t2 != 0) + goto g8778; + t2 = (arg2 == Cycle_BindReadNoMonitor) ? 1 : 0; + +g8790: + if (_trace) printf("g8790:\n"); + if (t2 == 0) + goto g8777; + +g8778: + if (_trace) printf("g8778:\n"); + /* Here if argument (CycleBindRead CycleBindReadNoMonitor) */ + arg5 = t1; + arg2 = 54; + goto illegaloperand; + +g8777: + if (_trace) printf("g8777:\n"); + t2 = (arg2 == Cycle_BindWrite) ? 1 : 0; + +g8791: + if (_trace) printf("g8791:\n"); + if (t2 != 0) + goto g8780; + t2 = (arg2 == Cycle_BindWriteNoMonitor) ? 1 : 0; + +g8792: + if (_trace) printf("g8792:\n"); + if (t2 == 0) + goto g8779; + +g8780: + if (_trace) printf("g8780:\n"); + /* Here if argument (CycleBindWrite CycleBindWriteNoMonitor) */ + arg5 = t1; + arg2 = 55; + goto illegaloperand; + +g8779: + if (_trace) printf("g8779:\n"); + t2 = (arg2 == Cycle_Header) ? 1 : 0; + +g8793: + if (_trace) printf("g8793:\n"); + if (t2 != 0) + goto g8782; + t2 = (arg2 == Cycle_StructureOffset) ? 1 : 0; + +g8794: + if (_trace) printf("g8794:\n"); + if (t2 == 0) + goto g8781; + +g8782: + if (_trace) printf("g8782:\n"); + /* Here if argument (CycleHeader CycleStructureOffset) */ + arg5 = t1; + arg2 = 59; + goto illegaloperand; + +g8781: + if (_trace) printf("g8781:\n"); + t2 = (arg2 == Cycle_Scavenge) ? 1 : 0; + +g8795: + if (_trace) printf("g8795:\n"); + if (t2 != 0) + goto g8784; + t2 = (arg2 == Cycle_GCCopy) ? 1 : 0; + +g8796: + if (_trace) printf("g8796:\n"); + if (t2 == 0) + goto g8783; + +g8784: + if (_trace) printf("g8784:\n"); + /* Here if argument (CycleScavenge CycleGCCopy) */ + arg5 = t1; + arg2 = 60; + goto illegaloperand; + +g8783: + if (_trace) printf("g8783:\n"); + t2 = (arg2 == Cycle_Cdr) ? 1 : 0; + +g8797: + if (_trace) printf("g8797:\n"); + if (t2 == 0) + goto g8774; + /* Here if argument CycleCdr */ + arg5 = t1; + arg2 = 56; + goto illegaloperand; + +g8774: + if (_trace) printf("g8774:\n"); + +g8773: + if (_trace) printf("g8773:\n"); + t1 = (arg1 == MemoryActionMonitor) ? 1 : 0; + +g8801: + if (_trace) printf("g8801:\n"); + if (t1 == 0) + goto g8772; + /* Here if argument MemoryActionMonitor */ + goto monitortrap; + +g8772: + if (_trace) printf("g8772:\n"); + +/* end PERFORMMEMORYACTION */ +/* start OutOfLineExceptions */ + + +outoflineexceptions: + if (_trace) printf("outoflineexceptions:\n"); + +ldbexception: + if (_trace) printf("ldbexception:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg3; + /* arg3 = stackp */ + arg3 = 1; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto numericexception; + +rplacaexception: + if (_trace) printf("rplacaexception:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto listexception; + +rplacdexception: + if (_trace) printf("rplacdexception:\n"); + /* arg6 = tag to dispatch on */ + arg6 = t1; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 2; + /* arg4 = arithmeticp */ + arg4 = 0; + goto listexception; + +pushivexception: + if (_trace) printf("pushivexception:\n"); + t1 = zero + 8; + /* SetTag. */ + t1 = t1 << 32; + t1 = arg2 | t1; + /* arg6 = tag to dispatch on */ + arg6 = t2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto exception; + +incrementexception: + if (_trace) printf("incrementexception:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto unarynumericexception; + +decrementexception: + if (_trace) printf("decrementexception:\n"); + /* arg6 = tag to dispatch on */ + arg6 = arg2; + /* arg3 = stackp */ + arg3 = 0; + /* arg1 = instruction arity */ + arg1 = 1; + /* arg4 = arithmeticp */ + arg4 = 0; + goto unarynumericexception; + +/* end OutOfLineExceptions */ +/* start NUMERICEXCEPTION */ + + +numericexception: + if (_trace) printf("numericexception:\n"); + t1 = arg6 - Type_Fixnum; + /* Strip CDR code, low bits */ + t1 = t1 & 56; + if (t1 != 0) + goto notnumeric; + goto exception; + +notnumeric: + if (_trace) printf("notnumeric:\n"); + arg5 = 0; + arg2 = 16; + goto illegaloperand; + +/* end NUMERICEXCEPTION */ +/* start UNARYNUMERICEXCEPTION */ + + +unarynumericexception: + if (_trace) printf("unarynumericexception:\n"); + t1 = arg6 - Type_Fixnum; + /* Strip CDR code, low bits */ + t1 = t1 & 56; + if (t1 != 0) + goto unarynotnumeric; + goto exception; + +unarynotnumeric: + if (_trace) printf("unarynotnumeric:\n"); + arg5 = 0; + arg2 = 81; + goto illegaloperand; + +/* end UNARYNUMERICEXCEPTION */ +/* start LISTEXCEPTION */ + + +listexception: + if (_trace) printf("listexception:\n"); + t1 = arg6 - Type_List; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto notlist1; + goto exception; + +notlist1: + if (_trace) printf("notlist1:\n"); + t1 = arg6 - Type_ListInstance; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto notlist2; + goto exception; + +notlist2: + if (_trace) printf("notlist2:\n"); + arg5 = 0; + arg2 = 26; + goto illegaloperand; + +/* end LISTEXCEPTION */ +/* start ARRAYEXCEPTION */ + + +arrayexception: + if (_trace) printf("arrayexception:\n"); + t1 = arg6 - Type_Array; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto notarray1; + goto exception; + +notarray1: + if (_trace) printf("notarray1:\n"); + t1 = arg6 - Type_ArrayInstance; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto notarray2; + goto exception; + +notarray2: + if (_trace) printf("notarray2:\n"); + goto spareexception; + +/* end ARRAYEXCEPTION */ +/* start SPAREEXCEPTION */ + + +spareexception: + if (_trace) printf("spareexception:\n"); + t1 = arg6 - Type_SparePointer1; + /* Strip CDR code, low bits */ + t1 = t1 & 62; + if (t1 != 0) + goto notspare1; + goto exception; + +notspare1: + if (_trace) printf("notspare1:\n"); + +notspare2: + if (_trace) printf("notspare2:\n"); + t1 = arg6 - Type_SpareNumber; + /* Strip CDR code */ + t1 = t1 & 63; + if (t1 != 0) + goto notspare3; + goto exception; + +notspare3: + if (_trace) printf("notspare3:\n"); + goto illegaloperand; + +/* end SPAREEXCEPTION */ +/* start EXCEPTION */ + + +exception: + if (_trace) printf("exception:\n"); + /* J. if arithmetic exception */ + if (arg4 != 0) + goto arithmeticexception; + t2 = *(u64 *)&(processor->linkage); + /* fix the stack pointer */ + iSP = *(u64 *)&(processor->restartsp); + /* fetch the real opcode */ + arg2 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + if (t2 != 0) + goto nativeexception; + /* J. if arguments stacked */ + if (arg3 != 0) + goto g8803; + /* Get original operand */ + t1 = (u16)(arg2 >> ((4&7)*8)); + /* t3 is non-zero iff SP|POP operand */ + t3 = (t1 == 512) ? 1 : 0; + /* SP|POP operand recovered by restoring SP */ + if (t3 != 0) + goto g8803; + /* Assume FP mode */ + arg5 = iFP; + /* SP mode constant */ + t3 = iSP + -2040; + /* Get the mode bits */ + t4 = (u8)(arg2 >> ((5&7)*8)); + /* Extract (8-bit, unsigned) operand */ + t2 = (u8)(arg2 >> ((4&7)*8)); + /* t4 = -2 FP, -1 LP, 0 SP, 1 Imm */ + t4 = t4 - 2; + /* LP or Immediate mode */ + if (t4 & 1) + arg5 = iLP; + /* SP mode */ + if (t4 == 0) + arg5 = t3; + /* Compute operand address */ + arg5 = (t2 * 8) + arg5; + /* Not immediate mode */ + if ((s64)t4 <= 0) + goto g8804; + t1 = t2 << 56; + t3 = arg2 >> 16; + t1 = (s64)t1 >> 56; + /* Immediate mode constant */ + arg5 = (u64)&processor->immediate_arg; + /* Signed immediate */ + if ((t3 & 1) == 0) + t2 = t1; + *(u32 *)&processor->immediate_arg = t2; + +g8804: + if (_trace) printf("g8804:\n"); + t1 = zero + -32768; + t1 = t1 + ((2) << 16); + t2 = arg2 & t1; + t3 = (t1 == t2) ? 1 : 0; + /* J. if not address-format operand */ + if (t3 == 0) + goto g8805; + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = arg5 - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + t2 = Type_Locative; + /* SetTag. */ + arg5 = t2 << 32; + arg5 = t1 | arg5; + goto g8806; + +g8805: + if (_trace) printf("g8805:\n"); + /* Fetch the arg */ + arg5 = *(u64 *)arg5; + +g8806: + if (_trace) printf("g8806:\n"); + *(u64 *)(iSP + 8) = arg5; + iSP = iSP + 8; + +g8803: + if (_trace) printf("g8803:\n"); + /* Shift opcode into position */ + arg2 = arg2 >> 10; + /* Just 8-bits of opcode */ + arg2 = arg2 & 255; + t11 = arg2 + TrapVector_InstructionException; +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_InstructionException; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + t12 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + goto handleexception; + +arex: + if (_trace) printf("arex:\n"); + +/* end EXCEPTION */ +/* start ARITHMETICEXCEPTION */ + + +arithmeticexception: + if (_trace) printf("arithmeticexception:\n"); + t2 = *(u64 *)&(processor->linkage); + /* fix the stack pointer */ + iSP = *(u64 *)&(processor->restartsp); + /* fetch the real opcode */ + arg2 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + if (t2 != 0) + goto nativeexception; + /* get opcode into low byte */ + arg2 = arg2 >> 10; + /* low byte only */ + arg2 = arg2 & 255; + /* is it DoubleFloatOp ? */ + arg2 = (arg2 == Opcode_DoubleFloatOp) ? 1 : 0; + /* not a doublefloat */ + if (arg2 == 0) + goto g8813; + goto doublefloatexc; + +g8813: + if (_trace) printf("g8813:\n"); + /* fetch the real opcode again */ + arg2 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + /* Get original operand */ + t1 = (u16)(arg2 >> ((4&7)*8)); + /* t3 is non-zero iff SP|POP operand */ + t3 = (t1 == 512) ? 1 : 0; + /* SP|POP operand recovered by restoring SP */ + if (t3 != 0) + goto g8809; + /* Assume FP mode */ + arg5 = iFP; + /* SP mode constant */ + t3 = iSP + -2040; + /* Get the mode bits */ + t4 = (u8)(arg2 >> ((5&7)*8)); + /* Extract (8-bit, unsigned) operand */ + t2 = (u8)(arg2 >> ((4&7)*8)); + /* t4 = -2 FP, -1 LP, 0 SP, 1 Imm */ + t4 = t4 - 2; + /* LP or Immediate mode */ + if (t4 & 1) + arg5 = iLP; + /* SP mode */ + if (t4 == 0) + arg5 = t3; + /* Compute operand address */ + arg5 = (t2 * 8) + arg5; + /* Not immediate mode */ + if ((s64)t4 <= 0) + goto g8810; + t1 = t2 << 56; + t3 = arg2 >> 16; + t1 = (s64)t1 >> 56; + /* Immediate mode constant */ + arg5 = (u64)&processor->immediate_arg; + /* Signed immediate */ + if ((t3 & 1) == 0) + t2 = t1; + *(u32 *)&processor->immediate_arg = t2; + +g8810: + if (_trace) printf("g8810:\n"); + t1 = zero + -32768; + t1 = t1 + ((2) << 16); + t2 = arg2 & t1; + t3 = (t1 == t2) ? 1 : 0; + /* J. if not address-format operand */ + if (t3 == 0) + goto g8811; + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = arg5 - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + t2 = Type_Locative; + /* SetTag. */ + arg5 = t2 << 32; + arg5 = t1 | arg5; + goto g8812; + +g8811: + if (_trace) printf("g8811:\n"); + /* Fetch the arg */ + arg5 = *(u64 *)arg5; + +g8812: + if (_trace) printf("g8812:\n"); + *(u64 *)(iSP + 8) = arg5; + iSP = iSP + 8; + +g8809: + if (_trace) printf("g8809:\n"); + /* Get unary/nary bit of opcode */ + t4 = arg2 >> 17; + /* Assume unary */ + arg1 = 1; + t11 = zero; + t2 = iSP; + /* J. if not binary arithmetic dispatch */ + if ((t4 & 1) == 0) + goto g8808; + /* Nary -> Binary */ + arg1 = 2; + t11 = *(s32 *)(iSP + 4); + t2 = t2 - 8; + /* low three bits has opcode tag for op2 */ + t11 = t11 & 7; + +g8808: + if (_trace) printf("g8808:\n"); + /* Shift opcode into position */ + arg2 = arg2 >> 4; + t2 = *(s32 *)(t2 + 4); + /* five bits from the opcode */ + arg2 = arg2 & 1984; + t2 = t2 & 7; + t11 = (t2 * 8) + t11; + t11 = arg2 | t11; + t11 = t11 + TrapVector_ArithmeticInstructionException; +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_ArithmeticInstructionException; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + t12 = *(u64 *)&(((CACHELINEP)iCP)->nextpcdata); + goto handleexception; + +/* end ARITHMETICEXCEPTION */ +/* start LOOPEXCEPTION */ + + +loopexception: + if (_trace) printf("loopexception:\n"); + t2 = *(u64 *)&(processor->linkage); + /* fix the stack pointer */ + iSP = *(u64 *)&(processor->restartsp); + /* fetch the real opcode */ + arg2 = *(u64 *)&(((CACHELINEP)iCP)->instruction); + if (t2 != 0) + goto nativeexception; + /* J. if arguments stacked */ + if (arg3 != 0) + goto g8815; + /* Get original operand */ + t1 = (u16)(arg2 >> ((4&7)*8)); + /* t3 is non-zero iff SP|POP operand */ + t3 = (t1 == 512) ? 1 : 0; + /* SP|POP operand recovered by restoring SP */ + if (t3 != 0) + goto g8815; + /* Assume FP mode */ + arg5 = iFP; + /* SP mode constant */ + t3 = iSP + -2040; + /* Get the mode bits */ + t4 = (u8)(arg2 >> ((5&7)*8)); + /* Extract (8-bit, unsigned) operand */ + t2 = (u8)(arg2 >> ((4&7)*8)); + /* t4 = -2 FP, -1 LP, 0 SP, 1 Imm */ + t4 = t4 - 2; + /* LP or Immediate mode */ + if (t4 & 1) + arg5 = iLP; + /* SP mode */ + if (t4 == 0) + arg5 = t3; + /* Compute operand address */ + arg5 = (t2 * 8) + arg5; + /* Not immediate mode */ + if ((s64)t4 <= 0) + goto g8816; + t1 = t2 << 56; + t3 = arg2 >> 16; + t1 = (s64)t1 >> 56; + /* Immediate mode constant */ + arg5 = (u64)&processor->immediate_arg; + /* Signed immediate */ + if ((t3 & 1) == 0) + t2 = t1; + *(u32 *)&processor->immediate_arg = t2; + +g8816: + if (_trace) printf("g8816:\n"); + t1 = zero + -32768; + t1 = t1 + ((2) << 16); + t2 = arg2 & t1; + t3 = (t1 == t2) ? 1 : 0; + /* J. if not address-format operand */ + if (t3 == 0) + goto g8817; + /* Convert stack cache address to VMA */ + t2 = *(u64 *)&(processor->stackcachedata); + t1 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t2 = arg5 - t2; + /* convert byte address to word address */ + t2 = t2 >> 3; + /* reconstruct VMA */ + t1 = t2 + t1; + t2 = Type_Locative; + /* SetTag. */ + arg5 = t2 << 32; + arg5 = t1 | arg5; + goto g8818; + +g8817: + if (_trace) printf("g8817:\n"); + /* Fetch the arg */ + arg5 = *(u64 *)arg5; + +g8818: + if (_trace) printf("g8818:\n"); + *(u64 *)(iSP + 8) = arg5; + iSP = iSP + 8; + +g8815: + if (_trace) printf("g8815:\n"); + /* Shift opcode into position */ + arg2 = arg2 >> 10; + /* Just 8-bits of opcode */ + arg2 = arg2 & 255; + t11 = arg2 + TrapVector_InstructionException; +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_InstructionException; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + t12 = arg5; + goto handleexception; + +/* end LOOPEXCEPTION */ +/* start HandleException */ + + +handleexception: + if (_trace) printf("handleexception:\n"); + /* save old frame pointer */ + t1 = iFP; + t4 = *(s32 *)&processor->control; + t9 = *(u64 *)&(processor->fepmodetrapvecaddress); + t8 = *(u64 *)&(processor->trapvecbase); + t5 = (-16384) << 16; + t6 = t4 >> 30; + /* Set trap mode to 3 */ + t5 = t4 | t5; + t6 = t6 & 3; + *(u32 *)&processor->control = t5; + t7 = t6 - 3; + t8 = t8 + t11; + if (t7 == 0) + t8 = t9; + /* Record TVI for tracing (if enabled) */ + *(u64 *)&processor->tvi = t8; + /* Memory Read Internal */ + +g8823: + /* Base of stack cache */ + t9 = *(u64 *)&(processor->stackcachebasevma); + t6 = t8 + ivory; + t7 = *(s32 *)&processor->scovlimit; + t3 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t9 = t8 - t9; + t5 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t7 = ((u64)t9 < (u64)t7) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t7 != 0) + goto g8825; + +g8824: + t6 = zero + 240; + t5 = t5 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + t3 = (u32)t3; + if (t5 & 1) + goto g8827; + +g8834: + t5 = t2 - Type_EvenPC; + /* Strip CDR code, low bits */ + t5 = t5 & 62; + if (t5 != 0) + goto g8822; + /* Restore the cr */ + *(u32 *)&processor->control = t4; + /* Current stack cache limit (words) */ + t8 = *(s32 *)&processor->scovlimit; + t5 = zero + 128; + /* Alpha base of stack cache */ + t6 = *(u64 *)&(processor->stackcachedata); + /* Account for what we're about to push */ + t5 = t5 + 8; + /* SCA of desired end of cache */ + t5 = (t5 * 8) + iSP; + /* SCA of current end of cache */ + t6 = (t8 * 8) + t6; + t8 = ((s64)t5 <= (s64)t6) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t8 == 0) + goto g8835; + iFP = (arg1 * 8) + zero; + iFP = iSP - iFP; + iFP = iFP + 8; + if (arg1 == 0) + goto g8820; + t5 = *(u64 *)iSP; + *(u64 *)(iSP + 32) = t5; + arg1 = arg1 - 1; + if (arg1 == 0) + goto g8820; + t5 = *(u64 *)(iSP + -8); + *(u64 *)(iSP + 24) = t5; + arg1 = arg1 - 1; + if (arg1 == 0) + goto g8820; + t5 = *(u64 *)(iSP + -16); + *(u64 *)(iSP + 16) = t5; + arg1 = arg1 - 1; + if (arg1 == 0) + goto g8820; + t5 = *(u64 *)(iSP + -24); + *(u64 *)(iSP + 8) = t5; + arg1 = arg1 - 1; + +g8820: + if (_trace) printf("g8820:\n"); + iSP = iSP + 32; + t5 = *(s32 *)&processor->continuation; + t7 = *((s32 *)(&processor->continuation)+1); + t5 = (u32)t5; + t8 = (8192) << 16; + t4 = (u32)t4; + t7 = t7 | 192; + *(u32 *)iFP = t5; + /* write the stack cache */ + *(u32 *)(iFP + 4) = t7; + t8 = t4 & t8; + t8 = t8 >> 2; + t6 = Type_Fixnum+0xC0; + t8 = t4 | t8; + *(u32 *)(iFP + 8) = t8; + /* write the stack cache */ + *(u32 *)(iFP + 12) = t6; + iLP = iSP + 8; + t6 = Type_Fixnum; + t8 = t11; + *(u32 *)(iFP + 16) = t8; + /* write the stack cache */ + *(u32 *)(iFP + 20) = t6; + /* Convert PC to a real continuation. */ + t6 = iPC & 1; + /* convert PC to a real word address. */ + t8 = iPC >> 1; + t6 = t6 + Type_EvenPC; + *(u32 *)(iFP + 24) = t8; + /* write the stack cache */ + *(u32 *)(iFP + 28) = t6; + /* Get CR mask */ + t7 = *(u64 *)&(processor->fccrtrapmask); + /* 1<<18! */ + t5 = (ValueDisposition_Value*4) << 16; + /* Arg size */ + t6 = iLP - iFP; + /* Caller Frame Size */ + t8 = iFP - t1; + /* Arg size in words */ + t6 = t6 >> 3; + /* Caller Frame Size in words in place */ + t8 = t8 << 6; + t5 = t5 | t6; + t5 = t5 | t8; + /* TagCdr. */ + t9 = t2 >> 6; + t6 = t4 >> 30; + t8 = t9 - t6; + if ((s64)t8 >= 0) + t6 = t9; + t6 = t6 << 30; + /* Mask off unwanted bits */ + t4 = t4 & t7; + /* Add trap mode */ + t4 = t4 | t6; + /* Add argsize, apply, disposition, caller FS */ + t4 = t4 | t5; + *(u32 *)&processor->control = t4; + /* Convert PC to a real continuation. */ + t6 = t12 & 1; + /* convert PC to a real word address. */ + t8 = t12 >> 1; + t6 = t6 + Type_EvenPC; + *(u64 *)&processor->continuationcp = zero; + *((u32 *)(&processor->continuation)+1) = t6; + *(u32 *)&processor->continuation = t8; + /* Convert real continuation to PC. */ + iPC = t2 & 1; + iPC = t3 + iPC; + iPC = t3 + iPC; + /* Save current trap mode */ + t6 = t4 >> 30; + /* Isolate trap mode */ + t4 = t4 >> 30; + /* Limit for emulator mode */ + t8 = *(s32 *)&processor->cslimit; + /* Limit for extra stack and higher modes */ + t9 = *(s32 *)&processor->csextralimit; + /* Get the right limit for the current trap mode */ + if (t4) + t8 = t9; + /* Might have been sign extended */ + t8 = (u32)t8; + /* Convert stack cache address to VMA */ + t9 = *(u64 *)&(processor->stackcachedata); + t4 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t9 = iSP - t9; + /* convert byte address to word address */ + t9 = t9 >> 3; + /* reconstruct VMA */ + t4 = t9 + t4; + /* Check for overflow */ + t9 = ((s64)t4 < (s64)t8) ? 1 : 0; + /* Jump if overflow */ + if (t9 == 0) + goto g8821; + /* Convert a halfword address into a CP pointer. */ + /* Get third byte into bottom */ + iCP = iPC >> (CacheLine_RShift & 63); + /* get the base of the icache */ + t9 = *(u64 *)&(processor->icachebase); + t8 = zero + -1; + t8 = t8 + ((4) << 16); + /* Now third byte is zero-shifted */ + iCP = iCP << (CacheLine_LShift & 63); + iCP = iPC + iCP; + iCP = iCP & t8; + /* temp=cpos*32 */ + t8 = iCP << 5; + /* cpos=cpos*16 */ + iCP = iCP << 4; + /* temp2=base+cpos*32 */ + t9 = t9 + t8; + /* cpos=base+cpos*48 */ + iCP = t9 + iCP; + goto cachevalid; + +g8821: + if (_trace) printf("g8821:\n"); + /* Take the overflow if in emulator mode */ + if (t6 == 0) + goto stackoverflow; + goto fatalstackoverflow; + +g8835: + if (_trace) printf("g8835:\n"); + arg2 = 8; + goto stackcacheoverflowhandler; + +g8825: + if (_trace) printf("g8825:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t9 = (t9 * 8) + t7; + t3 = *(s32 *)t9; + /* Read from stack cache */ + t2 = *(s32 *)(t9 + 4); + goto g8824; + +g8827: + if (_trace) printf("g8827:\n"); + if ((t6 & 1) == 0) + goto g8826; + /* Do the indirect thing */ + t8 = (u32)t3; + goto g8823; + +g8826: + if (_trace) printf("g8826:\n"); + /* Load the memory action table for cycle */ + t5 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t8; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t5; + /* Get the memory action */ + t5 = *(s32 *)t6; + +g8831: + if (_trace) printf("g8831:\n"); + t6 = t5 & MemoryActionTransform; + if (t6 == 0) + goto g8830; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g8834; +#ifndef MINIMA + +g8830: +#endif +#ifdef MINIMA + +g8830: + if (_trace) printf("g8830:\n"); + t6 = t5 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t6 == 0) + goto g8829; + t9 = t8 << 1; + t6 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t9 = t9 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t9 = (s32)t9 + (s32)t6; + /* Clear sign-extension */ + t9 = (u32)t9; + t7 = (t9 * 4) + t7; + /* Fetch the key */ + t9 = *(s32 *)t7; + /* Fetch value */ + t3 = *(s32 *)(t7 + 4); + /* Compare */ + t6 = (s32)t8 - (s32)t9; + /* Trap on miss */ + if (t6 != 0) + goto g8833; + /* Extract the pointer, and indirect */ + t8 = (u32)t3; + goto g8823; + +g8833: + if (_trace) printf("g8833:\n"); + goto dbcachemisstrap; +#endif + +g8829: + /* Perform memory action */ + arg1 = t5; + arg2 = 0; + goto performmemoryaction; + +g8822: + if (_trace) printf("g8822:\n"); + goto illegaltrapvector; + +/* end HandleException */ +/* start STACKOVERFLOW */ + + +stackoverflow: + if (_trace) printf("stackoverflow:\n"); + *(u64 *)&processor->restartsp = iSP; + /* save old frame pointer */ + t1 = iFP; + t4 = *(s32 *)&processor->control; + t9 = *(u64 *)&(processor->fepmodetrapvecaddress); + t8 = *(u64 *)&(processor->trapvecbase); + t5 = (-16384) << 16; + t6 = t4 >> 30; + /* Set trap mode to 3 */ + t5 = t4 | t5; + t6 = t6 & 3; + *(u32 *)&processor->control = t5; + t7 = t6 - 3; + t8 = t8 + TrapVector_StackOverflow; + if (t7 == 0) + t8 = t9; + /* Record TVI for tracing (if enabled) */ + *(u64 *)&processor->tvi = t8; + /* Memory Read Internal */ + +g8839: + /* Base of stack cache */ + t9 = *(u64 *)&(processor->stackcachebasevma); + t6 = t8 + ivory; + t7 = *(s32 *)&processor->scovlimit; + t3 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t9 = t8 - t9; + t5 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t7 = ((u64)t9 < (u64)t7) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t7 != 0) + goto g8841; + +g8840: + t6 = zero + 240; + t5 = t5 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + t3 = (u32)t3; + if (t5 & 1) + goto g8843; + +g8850: + t5 = t2 - Type_EvenPC; + /* Strip CDR code, low bits */ + t5 = t5 & 62; + if (t5 != 0) + goto g8838; + /* Restore the cr */ + *(u32 *)&processor->control = t4; + /* Current stack cache limit (words) */ + t8 = *(s32 *)&processor->scovlimit; + t5 = zero + 128; + /* Alpha base of stack cache */ + t6 = *(u64 *)&(processor->stackcachedata); + /* Account for what we're about to push */ + t5 = t5 + 8; + /* SCA of desired end of cache */ + t5 = (t5 * 8) + iSP; + /* SCA of current end of cache */ + t6 = (t8 * 8) + t6; + t8 = ((s64)t5 <= (s64)t6) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t8 == 0) + goto g8851; + iFP = (zero * 8) + zero; + iFP = iSP - iFP; + iFP = iFP + 8; + if (zero == 0) + goto g8836; + t5 = *(u64 *)iSP; + *(u64 *)(iSP + 32) = t5; + if (zero == 0) + goto g8836; + t5 = *(u64 *)(iSP + -8); + *(u64 *)(iSP + 24) = t5; + if (zero == 0) + goto g8836; + t5 = *(u64 *)(iSP + -16); + *(u64 *)(iSP + 16) = t5; + if (zero == 0) + goto g8836; + t5 = *(u64 *)(iSP + -24); + *(u64 *)(iSP + 8) = t5; + +g8836: + if (_trace) printf("g8836:\n"); + iSP = iSP + 32; + t5 = *(s32 *)&processor->continuation; + t7 = *((s32 *)(&processor->continuation)+1); + t5 = (u32)t5; + t8 = (8192) << 16; + t4 = (u32)t4; + t7 = t7 | 192; + *(u32 *)iFP = t5; + /* write the stack cache */ + *(u32 *)(iFP + 4) = t7; + t8 = t4 & t8; + t8 = t8 >> 2; + t6 = Type_Fixnum+0xC0; + t8 = t4 | t8; + *(u32 *)(iFP + 8) = t8; + /* write the stack cache */ + *(u32 *)(iFP + 12) = t6; + iLP = iSP + 8; + t6 = Type_Fixnum; + t8 = TrapVector_StackOverflow; + *(u32 *)(iFP + 16) = t8; + /* write the stack cache */ + *(u32 *)(iFP + 20) = t6; + /* Convert PC to a real continuation. */ + t6 = iPC & 1; + /* convert PC to a real word address. */ + t8 = iPC >> 1; + t6 = t6 + Type_EvenPC; + *(u32 *)(iFP + 24) = t8; + /* write the stack cache */ + *(u32 *)(iFP + 28) = t6; + /* Get CR mask */ + t7 = *(u64 *)&(processor->fccrtrapmask); + /* 1<<18! */ + t5 = (ValueDisposition_Value*4) << 16; + /* Arg size */ + t6 = iLP - iFP; + /* Caller Frame Size */ + t8 = iFP - t1; + /* Arg size in words */ + t6 = t6 >> 3; + /* Caller Frame Size in words in place */ + t8 = t8 << 6; + t5 = t5 | t6; + t5 = t5 | t8; + /* TagCdr. */ + t9 = t2 >> 6; + t6 = t4 >> 30; + t8 = t9 - t6; + if ((s64)t8 >= 0) + t6 = t9; + t6 = t6 << 30; + /* Mask off unwanted bits */ + t4 = t4 & t7; + /* Add trap mode */ + t4 = t4 | t6; + /* Add argsize, apply, disposition, caller FS */ + t4 = t4 | t5; + *(u32 *)&processor->control = t4; + /* Convert PC to a real continuation. */ + t6 = iPC & 1; + /* convert PC to a real word address. */ + t8 = iPC >> 1; + t6 = t6 + Type_EvenPC; + *(u64 *)&processor->continuationcp = zero; + *((u32 *)(&processor->continuation)+1) = t6; + *(u32 *)&processor->continuation = t8; + /* Convert real continuation to PC. */ + iPC = t2 & 1; + iPC = t3 + iPC; + iPC = t3 + iPC; + /* Save current trap mode */ + t6 = t4 >> 30; + /* Isolate trap mode */ + t4 = t4 >> 30; + /* Limit for emulator mode */ + t8 = *(s32 *)&processor->cslimit; + /* Limit for extra stack and higher modes */ + t9 = *(s32 *)&processor->csextralimit; + /* Get the right limit for the current trap mode */ + if (t4) + t8 = t9; + /* Might have been sign extended */ + t8 = (u32)t8; + /* Convert stack cache address to VMA */ + t9 = *(u64 *)&(processor->stackcachedata); + t4 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t9 = iSP - t9; + /* convert byte address to word address */ + t9 = t9 >> 3; + /* reconstruct VMA */ + t4 = t9 + t4; + /* Check for overflow */ + t9 = ((s64)t4 < (s64)t8) ? 1 : 0; + /* Jump if overflow */ + if (t9 == 0) + goto g8837; + /* Convert a halfword address into a CP pointer. */ + /* Get third byte into bottom */ + iCP = iPC >> (CacheLine_RShift & 63); + /* get the base of the icache */ + t9 = *(u64 *)&(processor->icachebase); + t8 = zero + -1; + t8 = t8 + ((4) << 16); + /* Now third byte is zero-shifted */ + iCP = iCP << (CacheLine_LShift & 63); + iCP = iPC + iCP; + iCP = iCP & t8; + /* temp=cpos*32 */ + t8 = iCP << 5; + /* cpos=cpos*16 */ + iCP = iCP << 4; + /* temp2=base+cpos*32 */ + t9 = t9 + t8; + /* cpos=base+cpos*48 */ + iCP = t9 + iCP; + goto cachevalid; + +g8837: + if (_trace) printf("g8837:\n"); + /* Take the overflow if in emulator mode */ + if (t6 == 0) + goto stackoverflow; + goto fatalstackoverflow; + +g8851: + if (_trace) printf("g8851:\n"); + arg2 = 8; + goto stackcacheoverflowhandler; + +g8841: + if (_trace) printf("g8841:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t9 = (t9 * 8) + t7; + t3 = *(s32 *)t9; + /* Read from stack cache */ + t2 = *(s32 *)(t9 + 4); + goto g8840; + +g8843: + if (_trace) printf("g8843:\n"); + if ((t6 & 1) == 0) + goto g8842; + /* Do the indirect thing */ + t8 = (u32)t3; + goto g8839; + +g8842: + if (_trace) printf("g8842:\n"); + /* Load the memory action table for cycle */ + t5 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t8; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t5; + /* Get the memory action */ + t5 = *(s32 *)t6; + +g8847: + if (_trace) printf("g8847:\n"); + t6 = t5 & MemoryActionTransform; + if (t6 == 0) + goto g8846; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g8850; +#ifndef MINIMA + +g8846: +#endif +#ifdef MINIMA + +g8846: + if (_trace) printf("g8846:\n"); + t6 = t5 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t6 == 0) + goto g8845; + t9 = t8 << 1; + t6 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t9 = t9 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t9 = (s32)t9 + (s32)t6; + /* Clear sign-extension */ + t9 = (u32)t9; + t7 = (t9 * 4) + t7; + /* Fetch the key */ + t9 = *(s32 *)t7; + /* Fetch value */ + t3 = *(s32 *)(t7 + 4); + /* Compare */ + t6 = (s32)t8 - (s32)t9; + /* Trap on miss */ + if (t6 != 0) + goto g8849; + /* Extract the pointer, and indirect */ + t8 = (u32)t3; + goto g8839; + +g8849: + if (_trace) printf("g8849:\n"); + goto dbcachemisstrap; +#endif + +g8845: + /* Perform memory action */ + arg1 = t5; + arg2 = 0; + goto performmemoryaction; + +g8838: + if (_trace) printf("g8838:\n"); + goto illegaltrapvector; + +/* end STACKOVERFLOW */ +/* start StartPreTrap */ + + +startpretrap: + if (_trace) printf("startpretrap:\n"); + t2 = *(u64 *)&(processor->linkage); + if (t2 != 0) + goto nativeexception; + t4 = *(s32 *)&processor->control; + t9 = *(u64 *)&(processor->fepmodetrapvecaddress); + t8 = *(u64 *)&(processor->trapvecbase); + t5 = (-16384) << 16; + t6 = t4 >> 30; + /* Set trap mode to 3 */ + t5 = t4 | t5; + t6 = t6 & 3; + *(u32 *)&processor->control = t5; + t7 = t6 - 3; + t8 = t8 + t10; + if (t7 == 0) + t8 = t9; + /* Record TVI for tracing (if enabled) */ + *(u64 *)&processor->tvi = t8; + /* Memory Read Internal */ + +g8853: + /* Base of stack cache */ + t9 = *(u64 *)&(processor->stackcachebasevma); + t6 = t8 + ivory; + t7 = *(s32 *)&processor->scovlimit; + t3 = (t6 * 4); + t2 = LDQ_U(t6); + /* Stack cache offset */ + t9 = t8 - t9; + t5 = *(u64 *)&(processor->dataread_mask); + /* In range? */ + t7 = ((u64)t9 < (u64)t7) ? 1 : 0; + t3 = *(s32 *)t3; + t2 = (u8)(t2 >> ((t6&7)*8)); + if (t7 != 0) + goto g8855; + +g8854: + t6 = zero + 240; + t5 = t5 >> (t2 & 63); + t6 = t6 >> (t2 & 63); + t3 = (u32)t3; + if (t5 & 1) + goto g8857; + +g8864: + t5 = t2 - Type_EvenPC; + /* Strip CDR code, low bits */ + t5 = t5 & 62; + if (t5 != 0) + goto g8852; + /* Restore the cr */ + *(u32 *)&processor->control = t4; + iSP = *(u64 *)&(processor->restartsp); + /* Current stack cache limit (words) */ + t7 = *(s32 *)&processor->scovlimit; + t4 = zero + 128; + /* Alpha base of stack cache */ + t5 = *(u64 *)&(processor->stackcachedata); + /* Account for what we're about to push */ + t4 = t4 + 8; + /* SCA of desired end of cache */ + t4 = (t4 * 8) + iSP; + /* SCA of current end of cache */ + t5 = (t7 * 8) + t5; + t7 = ((s64)t4 <= (s64)t5) ? 1 : 0; + /* We're done if new SCA is within bounds */ + if (t7 == 0) + goto g8865; + t5 = *(s32 *)&processor->continuation; + t4 = *((s32 *)(&processor->continuation)+1); + t5 = (u32)t5; + t7 = *(s32 *)&processor->control; + t7 = (u32)t7; + t4 = t4 | 192; + *(u32 *)(iSP + 8) = t5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t4; + iSP = iSP + 8; + t6 = Type_Fixnum+0xC0; + *(u32 *)(iSP + 8) = t7; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t6; + iSP = iSP + 8; + t6 = t10; + t8 = Type_Fixnum; + *(u32 *)(iSP + 8) = t6; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t8; + iSP = iSP + 8; + /* Convert PC to a real continuation. */ + t6 = iPC & 1; + /* convert PC to a real word address. */ + t8 = iPC >> 1; + t6 = t6 + Type_EvenPC; + *((u32 *)(&processor->continuation)+1) = t6; + *(u32 *)&processor->continuation = t8; + *(u64 *)&processor->continuationcp = iCP; + /* set CDR-NEXT */ + t9 = t6 & 63; + *(u32 *)(iSP + 8) = t8; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t9; + iSP = iSP + 8; + goto *r0; /* ret */ + +g8865: + if (_trace) printf("g8865:\n"); + arg2 = 8; + goto stackcacheoverflowhandler; + +g8855: + if (_trace) printf("g8855:\n"); + t7 = *(u64 *)&(processor->stackcachedata); + /* reconstruct SCA */ + t9 = (t9 * 8) + t7; + t3 = *(s32 *)t9; + /* Read from stack cache */ + t2 = *(s32 *)(t9 + 4); + goto g8854; + +g8857: + if (_trace) printf("g8857:\n"); + if ((t6 & 1) == 0) + goto g8856; + /* Do the indirect thing */ + t8 = (u32)t3; + goto g8853; + +g8856: + if (_trace) printf("g8856:\n"); + /* Load the memory action table for cycle */ + t5 = *(u64 *)&(processor->dataread); + /* TagType. */ + /* Discard the CDR code */ + t6 = t2 & 63; + /* stash the VMA for the (likely) trap */ + *(u64 *)&processor->vma = t8; + /* Adjust for a longword load */ + t6 = (t6 * 4) + t5; + /* Get the memory action */ + t5 = *(s32 *)t6; + +g8861: + if (_trace) printf("g8861:\n"); + t6 = t5 & MemoryActionTransform; + if (t6 == 0) + goto g8860; + t2 = t2 & ~63L; + t2 = t2 | Type_ExternalValueCellPointer; + goto g8864; +#ifndef MINIMA + +g8860: +#endif +#ifdef MINIMA + +g8860: + if (_trace) printf("g8860:\n"); + t6 = t5 & MemoryActionBinding; + t7 = *(u64 *)&(processor->dbcmask); + if (t6 == 0) + goto g8859; + t9 = t8 << 1; + t6 = *(u64 *)&(processor->dbcbase); + /* Hash index */ + t9 = t9 & t7; + t7 = 1; + t7 = t7 << (ivorymemorydata & 63); + t9 = (s32)t9 + (s32)t6; + /* Clear sign-extension */ + t9 = (u32)t9; + t7 = (t9 * 4) + t7; + /* Fetch the key */ + t9 = *(s32 *)t7; + /* Fetch value */ + t3 = *(s32 *)(t7 + 4); + /* Compare */ + t6 = (s32)t8 - (s32)t9; + /* Trap on miss */ + if (t6 != 0) + goto g8863; + /* Extract the pointer, and indirect */ + t8 = (u32)t3; + goto g8853; + +g8863: + if (_trace) printf("g8863:\n"); + goto dbcachemisstrap; +#endif + +g8859: + /* Perform memory action */ + arg1 = t5; + arg2 = 0; + goto performmemoryaction; + +g8852: + if (_trace) printf("g8852:\n"); + goto illegaltrapvector; + +/* end StartPreTrap */ +/* start FinishPreTrap */ + + +finishpretrap: + if (_trace) printf("finishpretrap:\n"); + iFP = *(u64 *)&(processor->restartsp); + /* iFP now points to the start of our new frame */ + iFP = iFP + 8; + /* Points beyond the last argument */ + iLP = iSP + 8; + /* Get CR mask */ + t4 = *(u64 *)&(processor->fccrtrapmask); + /* 1<<18! */ + t5 = (ValueDisposition_Value*4) << 16; + /* Arg size */ + t6 = iLP - iFP; + /* Caller Frame Size */ + t8 = iFP - t1; + /* Arg size in words */ + t6 = t6 >> 3; + /* Caller Frame Size in words in place */ + t8 = t8 << 6; + t5 = t5 | t6; + t5 = t5 | t8; + /* TagCdr. */ + t9 = t2 >> 6; + t6 = t7 >> 30; + t8 = t9 - t6; + if ((s64)t8 >= 0) + t6 = t9; + t6 = t6 << 30; + /* Mask off unwanted bits */ + t7 = t7 & t4; + /* Add trap mode */ + t7 = t7 | t6; + /* Add argsize, apply, disposition, caller FS */ + t7 = t7 | t5; + *(u32 *)&processor->control = t7; + /* Convert real continuation to PC. */ + iPC = t2 & 1; + iPC = t3 + iPC; + iPC = t3 + iPC; + /* Check for stack overflow */ + /* Isolate trap mode */ + t7 = t7 >> 30; + /* Limit for emulator mode */ + t8 = *(s32 *)&processor->cslimit; + /* Limit for extra stack and higher modes */ + t9 = *(s32 *)&processor->csextralimit; + /* Get the right limit for the current trap mode */ + if (t7) + t8 = t9; + /* Might have been sign extended */ + t8 = (u32)t8; + /* Convert stack cache address to VMA */ + t9 = *(u64 *)&(processor->stackcachedata); + t7 = *(u64 *)&(processor->stackcachebasevma); + /* stack cache base relative offset */ + t9 = iSP - t9; + /* convert byte address to word address */ + t9 = t9 >> 3; + /* reconstruct VMA */ + t7 = t9 + t7; + /* Check for overflow */ + t9 = ((s64)t7 < (s64)t8) ? 1 : 0; + /* Jump if overflow */ + if (t9 == 0) + goto stackoverflow; + /* Convert a halfword address into a CP pointer. */ + /* Get third byte into bottom */ + iCP = iPC >> (CacheLine_RShift & 63); + /* get the base of the icache */ + t9 = *(u64 *)&(processor->icachebase); + t8 = zero + -1; + t8 = t8 + ((4) << 16); + /* Now third byte is zero-shifted */ + iCP = iCP << (CacheLine_LShift & 63); + iCP = iPC + iCP; + iCP = iCP & t8; + /* temp=cpos*32 */ + t8 = iCP << 5; + /* cpos=cpos*16 */ + iCP = iCP << 4; + /* temp2=base+cpos*32 */ + t9 = t9 + t8; + /* cpos=base+cpos*48 */ + iCP = t9 + iCP; + goto cachevalid; + +/* end FinishPreTrap */ +/* start ILLEGALOPERAND */ + + +illegaloperand: + if (_trace) printf("illegaloperand:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmetererror; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_Error; + r0 = (u64)&&return0074; + goto startpretrap; +return0074: + t11 = Type_Fixnum; + *(u32 *)(iSP + 8) = arg2; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t11; + iSP = iSP + 8; + t11 = Type_Locative; + *(u32 *)(iSP + 8) = arg5; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t11; + iSP = iSP + 8; + goto finishpretrap; + +/* end ILLEGALOPERAND */ +/* start RESETTRAP */ + + +resettrap: + if (_trace) printf("resettrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_Reset; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_Reset; + r0 = (u64)&&return0075; + goto startpretrap; +return0075: + goto finishpretrap; + +/* end RESETTRAP */ +/* start PULLAPPLYARGSTRAP */ + + +pullapplyargstrap: + if (_trace) printf("pullapplyargstrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_PullApplyArgs; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + t12 = *(s32 *)iSP; + t11 = *(s32 *)(iSP + 4); + /* Pop Stack. */ + iSP = iSP - 8; + t12 = (u32)t12; + *(u64 *)&processor->restartsp = iSP; + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_PullApplyArgs; + r0 = (u64)&&return0076; + goto startpretrap; +return0076: + arg2 = Type_Fixnum; + *(u32 *)(iSP + 8) = arg1; + /* write the stack cache */ + *(u32 *)(iSP + 12) = arg2; + iSP = iSP + 8; + /* set CDR-NEXT */ + arg2 = t11 & 63; + *(u32 *)(iSP + 8) = t12; + /* write the stack cache */ + *(u32 *)(iSP + 12) = arg2; + iSP = iSP + 8; + goto finishpretrap; + +/* end PULLAPPLYARGSTRAP */ +/* start TRACETRAP */ + + +tracetrap: + if (_trace) printf("tracetrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_Trace; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_Trace; + r0 = (u64)&&return0077; + goto startpretrap; +return0077: + goto finishpretrap; + +/* end TRACETRAP */ +/* start PREEMPTREQUESTTRAP */ + + +preemptrequesttrap: + if (_trace) printf("preemptrequesttrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_PreemptRequest; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_PreemptRequest; + r0 = (u64)&&return0078; + goto startpretrap; +return0078: + goto finishpretrap; + +/* end PREEMPTREQUESTTRAP */ +/* start HIGHPRIORITYSEQUENCEBREAK */ + + +highprioritysequencebreak: + if (_trace) printf("highprioritysequencebreak:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_HighPrioritySequenceBreak; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_HighPrioritySequenceBreak; + r0 = (u64)&&return0079; + goto startpretrap; +return0079: + goto finishpretrap; + +/* end HIGHPRIORITYSEQUENCEBREAK */ +/* start LOWPRIORITYSEQUENCEBREAK */ + + +lowprioritysequencebreak: + if (_trace) printf("lowprioritysequencebreak:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_LowPrioritySequenceBreak; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_LowPrioritySequenceBreak; + r0 = (u64)&&return0080; + goto startpretrap; +return0080: + goto finishpretrap; + +/* end LOWPRIORITYSEQUENCEBREAK */ +/* start DBUNWINDFRAMETRAP */ + + +dbunwindframetrap: + if (_trace) printf("dbunwindframetrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_DBUnwindFrame; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_DBUnwindFrame; + r0 = (u64)&&return0081; + goto startpretrap; +return0081: + t11 = *(u64 *)&(processor->bindingstackpointer); + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end DBUNWINDFRAMETRAP */ +/* start DBUNWINDCATCHTRAP */ + + +dbunwindcatchtrap: + if (_trace) printf("dbunwindcatchtrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + TrapVector_DBUnwindCatch; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_DBUnwindCatch; + r0 = (u64)&&return0082; + goto startpretrap; +return0082: + t11 = *(u64 *)&(processor->bindingstackpointer); + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end DBUNWINDCATCHTRAP */ +/* start TRANSPORTTRAP */ + + +transporttrap: + if (_trace) printf("transporttrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmetertransport; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_Transport; + r0 = (u64)&&return0083; + goto startpretrap; +return0083: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end TRANSPORTTRAP */ +/* start MONITORTRAP */ + + +monitortrap: + if (_trace) printf("monitortrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmetermonitor; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_Monitor; + r0 = (u64)&&return0084; + goto startpretrap; +return0084: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end MONITORTRAP */ +/* start PAGENOTRESIDENT */ + + +pagenotresident: + if (_trace) printf("pagenotresident:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmeterpagenotresident; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_PageNotResident; + r0 = (u64)&&return0085; + goto startpretrap; +return0085: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end PAGENOTRESIDENT */ +/* start PAGEFAULTREQUESTHANDLER */ + + +pagefaultrequesthandler: + if (_trace) printf("pagefaultrequesthandler:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmeterpagefaultrequest; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_PageFaultRequest; + r0 = (u64)&&return0086; + goto startpretrap; +return0086: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end PAGEFAULTREQUESTHANDLER */ +/* start PAGEWRITEFAULT */ + + +pagewritefault: + if (_trace) printf("pagewritefault:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmeterpagewritefault; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_PageWriteFault; + r0 = (u64)&&return0087; + goto startpretrap; +return0087: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end PAGEWRITEFAULT */ +#ifdef MINIMA +/* start DBCACHEMISSTRAP */ + + +dbcachemisstrap: + if (_trace) printf("dbcachemisstrap:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmeterdbcachemiss; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = trapvectordbcachemiss; + r0 = (u64)&&return0088; + goto startpretrap; +return0088: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end DBCACHEMISSTRAP */ +#endif + /* The following handlers should never be invoked. */ +/* start UNCORRECTABLEMEMORYERROR */ + + +uncorrectablememoryerror: + if (_trace) printf("uncorrectablememoryerror:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmeteruncorrectablememoryerror; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_UncorrectableMemoryError; + r0 = (u64)&&return0089; + goto startpretrap; +return0089: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end UNCORRECTABLEMEMORYERROR */ +/* start BUSERROR */ + + +buserror: + if (_trace) printf("buserror:\n"); +#ifdef TRAPMETERING + /* pointer to trap data vector */ + t1 = *(u64 *)&(processor->trapmeterdata); + /* get the vector index */ + t2 = zero + trapmetermemorybuserror; + t1 = (t2 * 8) + t1; + /* get the old value */ + t2 = *(u64 *)t1; + /* increment it */ + t2 = t2 + 1; + /* and store it back */ + *(u64 *)t1 = t2; +#endif + /* Preserve VMA against reading trap vector */ + t11 = *(u64 *)&(processor->vma); + /* save old frame pointer */ + t1 = iFP; + /* save the trap vector index */ + t10 = TrapVector_MemoryBusError; + r0 = (u64)&&return0090; + goto startpretrap; +return0090: + t12 = Type_Locative; + *(u32 *)(iSP + 8) = t11; + /* write the stack cache */ + *(u32 *)(iSP + 12) = t12; + iSP = iSP + 8; + goto finishpretrap; + +/* end BUSERROR */ + /* Fin. */ + + + +/* End of file automatically generated from ../alpha-emulator/ifuntrap.as */ diff --git a/stub/ihalt.c b/stub/ihalt.c new file mode 100644 index 0000000..59f8a6b --- /dev/null +++ b/stub/ihalt.c @@ -0,0 +1,137 @@ +/************************************************************************ + * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED + * FROM ../alpha-emulator/ihalt.as. ANY CHANGES MADE TO THIS FILE WILL BE LOST + ************************************************************************/ + + /* This file implements the out-of-line parts of the instruction dispatch loop. */ +/* start iOutOfLine */ + + +ioutofline: + if (_trace) printf("ioutofline:\n"); + +traporsuspendmachine: + if (_trace) printf("traporsuspendmachine:\n"); + t4 = *(s32 *)&processor->control; + /* Be sure this is up-to-date */ + *(u64 *)&processor->restartsp = iSP; + /* Has the spy asked us to stop or trap? */ + r0 = *(u64 *)&(processor->please_stop); /* lock */ + t5 = zero; + *(u64 *)&processor->please_stop = t5; /* lock */ + t5 = 1; + if (t5 == 0) + goto collision; + *(u64 *)&processor->stop_interpreter = zero; + +collision: + /* t3<0>=1 if we've been asked to stop */ + t3 = CMPBGE(r0, HaltReason_IllInstn); + if (t3 & 1) + goto SUSPENDMACHINE; + /* Here when someone wants the emulator to trap. */ + /* Extract PROCESSORSTATE_PLEASE_TRAP (ivory) */ + r0 = (u32)(r0 >> ((4&7)*8)); + /* Isolate current trap mode */ + t4 = t4 >> 30; + t3 = (r0 == TrapReason_HighPrioritySequenceBreak) ? 1 : 0; + +g8871: + if (_trace) printf("g8871:\n"); + if (t3 == 0) + goto g8867; + /* Here if argument TrapReasonHighPrioritySequenceBreak */ + /* Only interrupts EXTRA-STACK and EMULATOR */ + t4 = ((u64)t4 <= (u64)TrapMode_ExtraStack) ? 1 : 0; + if (t4 == 0) + goto continuecurrentinstruction; + goto highprioritysequencebreak; + +g8867: + if (_trace) printf("g8867:\n"); + t3 = (r0 == TrapReason_LowPrioritySequenceBreak) ? 1 : 0; + +g8872: + if (_trace) printf("g8872:\n"); + if (t3 == 0) + goto g8868; + /* Here if argument TrapReasonLowPrioritySequenceBreak */ + /* Only interrupts EMULATOR */ + if (t4 != 0) + goto continuecurrentinstruction; + goto lowprioritysequencebreak; + +g8868: + if (_trace) printf("g8868:\n"); + /* Here for all other cases */ + /* Check for preempt-request trap */ + /* Get the preempt-pending bit */ + t5 = *(s32 *)&processor->interruptreg; + /* Don't take preempt trap unless in emulator mode */ + if (t4 != 0) + goto continuecurrentinstruction; + /* Jump if preempt request not pending */ + if ((t5 & 1) == 0) + goto continuecurrentinstruction; + goto preemptrequesttrap; + +g8866: + if (_trace) printf("g8866:\n"); + +SUSPENDMACHINE: + if (_trace) printf("SUSPENDMACHINE:\n"); + /* Get the reason */ + t1 = (u32)r0; + goto stopinterp; + +ILLEGALINSTRUCTION: + if (_trace) printf("ILLEGALINSTRUCTION:\n"); + t1 = HaltReason_IllInstn; + goto stopinterp; + +haltmachine: + if (_trace) printf("haltmachine:\n"); + t1 = HaltReason_Halted; + goto stopinterp; + +fatalstackoverflow: + if (_trace) printf("fatalstackoverflow:\n"); + t1 = HaltReason_FatalStackOverflow; + goto stopinterp; + +illegaltrapvector: + if (_trace) printf("illegaltrapvector:\n"); + t1 = HaltReason_IllegalTrapVector; + goto stopinterp; + +stopinterp: + if (_trace) printf("stopinterp:\n"); + /* Return the halt reason */ + r0 = t1; + /* Clear the request flag */ + *(u32 *)&processor->please_stop = zero; + *(u64 *)&processor->cp = iCP; + *(u64 *)&processor->epc = iPC; + *(u64 *)&processor->sp = iSP; + *(u64 *)&processor->fp = iFP; + *(u64 *)&processor->lp = iLP; + /* Stop the (emulated) chip */ + *(u64 *)&processor->runningp = zero; + r9 = *(u64 *)&(processor->asrr9); + r10 = *(u64 *)&(processor->asrr10); + r11 = *(u64 *)&(processor->asrr11); + r12 = *(u64 *)&(processor->asrr12); + r13 = *(u64 *)&(processor->asrr13); + r15 = *(u64 *)&(processor->asrr15); + r26 = *(u64 *)&(processor->asrr26); + r27 = *(u64 *)&(processor->asrr27); + r29 = *(u64 *)&(processor->asrr29); + r30 = *(u64 *)&(processor->asrr30); + r14 = *(u64 *)&(processor->asrr14); + goto *ra; /* ret */ + +/* end iOutOfLine */ + + + +/* End of file automatically generated from ../alpha-emulator/ihalt.as */ diff --git a/stub/intrpmac.lisp b/stub/intrpmac.lisp new file mode 100644 index 0000000..e11e289 --- /dev/null +++ b/stub/intrpmac.lisp @@ -0,0 +1,1351 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: ALPHA-AXP-INTERNALS; Base: 10; Lowercase: T -*- + +(in-package "ALPHA-AXP-INTERNALS") + +(defmacro check-temporaries ((&rest lives) (&rest temps)) + `(check-temporaries-1 (list ,@lives) (list ,@temps))) +;(defmacro check-temporaries ((&rest lives) (&rest temps))) + +(defvar *memoized-vmdata* nil) +(defvar *memoized-vmtags* nil) +(defvar *memoized-base* nil) +(defvar *memoized-limit* nil) +(defvar *memoized-action* nil) +(defvar *memoized-action-cycle* nil) +(defvar *cant-be-in-cache-p* nil) + +;;+++ Is this ever a kludge or what! +(defvar *inhibit-alignment-in-memory-read* nil) + + (eval-when (compile load eval) + (defun check-temporaries-1 (lives temps) + (let ((shared (intersection lives temps + :test #'(lambda (r1 r2) + (eql (register-asmname (find-register r1)) + (register-asmname (find-register r2))))))) + (when shared + (warn "The following registers are used as both live ~ + registers and temps in ~A:~%~A" + *function-being-processed* shared))) + (when *memoized-vmdata* + (stack-let ((sc-memos (list *memoized-vmdata* *memoized-vmtags* + *memoized-base* *memoized-limit*)) + (memos (list *memoized-vmdata* *memoized-vmtags*)) + (regs (append lives temps))) + (let ((shared (intersection (if *cant-be-in-cache-p* memos sc-memos) regs + :test #'(lambda (r1 r2) + (eql (register-asmname (find-register r1)) + (register-asmname (find-register r2))))))) + (when shared + (warn "The following memoized registers are being reused in ~A:~%~A" + *function-being-processed* shared)))))) + ) ;eval-when + +(defmacro branch-true (r label &optional comment) + `((BNE ,r ,label ,@(if comment `(,comment))))) + +(defmacro branch-false (r label &optional comment) + `((BEQ ,r ,label ,@(if comment `(,comment))))) + +(defmacro force-alignment () + `((label ,(gensym)))) + + +;;; This macro assumes that the PC is a halfword address where the lsbit +;;; is 1 for odd, 0 for even. +;;; If you are using this, chances are you want to just jump to either +;;; InterpretInstructionForJump or InterpretInstructionForBranch... +#+old-cache-hash +(defmacro PC-TO-iCACHEENT (address cpos temp temp2) + (check-temporaries (address cpos) (temp temp2)) + `((comment "Convert a halfword address into a CP pointer.") + ;; In the case where the cache line mask is 16 or fewer bits, this + ;; will expand to an LDA... + (load-constant ,temp ,(eval |cacheline$K-mask|)) + (LDQ ,temp2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (AND ,address ,temp ,cpos) + ;; Knowing that cachelinesize is 48 bytes 3<<4 + (SLL ,cpos 5 ,temp "temp=cpos*32") + (SLL ,cpos 4 ,cpos "cpos=cpos*16") + (ADDQ ,temp2 ,temp ,temp2 "temp2=base+cpos*32") + (ADDQ ,temp2 ,cpos ,cpos "cpos=base+cpos*48"))) + +;;; New version tries to use some of the higher order bits in order to +;;; get better distribution through the instruction cache +#-old-cache-hash +(defmacro PC-TO-iCACHEENT (address cpos temp temp2) + (check-temporaries (address cpos) (temp temp2)) + `((comment "Convert a halfword address into a CP pointer.") + ;; In the case where the cache line mask is 16 or fewer bits, this + ;; will expand to an LDA... + (SRL ,address |CacheLineRShift| ,cpos "Get third byte into bottom") + (LDQ ,temp2 PROCESSORSTATE_ICACHEBASE (ivory) "get the base of the icache") + (load-constant ,temp ,(eval |cacheline$K-mask|)) + (SLL ,cpos |CacheLineLShift| ,cpos "Now third byte is zero-shifted") + (ADDQ ,address ,cpos ,cpos) + (AND ,cpos ,temp ,cpos) + ;; Knowing that cachelinesize is 48 bytes 3<<4 + (SLL ,cpos 5 ,temp "temp=cpos*32") + (SLL ,cpos 4 ,cpos "cpos=cpos*16") + (ADDQ ,temp2 ,temp ,temp2 "temp2=base+cpos*32") + (ADDQ ,temp2 ,cpos ,cpos "cpos=base+cpos*48"))) + +;;; The next two macros deal with translating between halfword addresses and PC's +(defmacro convert-pc-to-continuation (apc ctag cdata &optional ignore) + (declare (ignore ignore)) + (check-temporaries (apc) (ctag cdata)) + `((comment "Convert PC to a real continuation.") + (AND ,apc 1 ,ctag) + (SRL ,apc 1 ,cdata "convert PC to a real word address.") + (LDA ,ctag |TypeEvenPC| (,ctag)))) + +(defmacro convert-continuation-to-pc (ctag cdata apc &optional ignore) + (declare (ignore ignore)) + (check-temporaries (ctag cdata) (apc)) + `((comment "Convert real continuation to PC.") + (AND ,ctag 1 ,apc) + (ADDQ ,cdata ,apc ,apc) + (ADDQ ,cdata ,apc ,apc))) + + +;;; The next two macros deal with converting between stack cache addresses +;;; and vma's. Both of these macros assume that SCA / VMA are stack cache +;;; addresses +(defmacro SCAtoVMA (SCA VMA temp) + (check-temporaries (SCA) (VMA temp)) + `((comment "Convert stack cache address to VMA") + (LDQ ,temp PROCESSORSTATE_STACKCACHEDATA (ivory)) + ,@(if *memoized-base* + `() + `( + (LDQ ,vma PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + )) + (SUBQ ,sca ,temp ,temp "stack cache base relative offset") + (SRL ,temp 3 ,temp "convert byte address to word address") + (ADDQ ,temp ,(or *memoized-base* vma) ,vma "reconstruct VMA"))) + +(defmacro VMAtoSCA (VMA SCA temp) + (check-temporaries (VMA) (SCA temp)) + `((comment "Convert VMA to stack cache address") + ,@(if *memoized-base* + `() + `( + (LDQ ,temp PROCESSORSTATE_STACKCACHEBASEVMA (ivory)) + )) + (LDQ ,sca PROCESSORSTATE_STACKCACHEDATA (ivory)) + (SUBQ ,vma ,(or *memoized-base* temp) ,temp "stack cache base relative offset") + (S8ADDQ ,temp ,sca ,sca "reconstruct SCA"))) + + +(defmacro VMAinStackCache (VMA notincache word-offset temp2) + "Branches to NOTINCACHE if out of range, leaves stack-cache word-offset in WORD-OFFSET" + (check-temporaries (VMA) (word-offset temp2)) + (assert (not (eq VMA word-offset)) () "Can't use ~A as ~A" VMA 'word-offset) + `(,@(if (lisp:and *memoized-base* *memoized-limit*) + `() + `( + (LDQ ,word-offset PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the cache") + (LDL ,temp2 PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)") + )) + (SUBQ ,VMA ,(or *memoized-base* word-offset) ,word-offset "Stack cache offset") + (CMPULT ,word-offset ,(or *memoized-limit* temp2) ,temp2 "In range?") + (branch-false ,temp2 ,notincache "J. if not in cache"))) + +(defmacro VMAtoSCAmaybe (VMA SCA notincache temp temp2) + "Either branches to notincache or converts VMA" + (check-temporaries (VMA SCA) (temp temp2)) + `(;; In-line (VMAinStackCache ,VMA ,notincache ,temp ,SCA) for dual-issue + ,@(if (lisp:and *memoized-base* *memoized-limit*) + `() + `( + (LDQ ,temp PROCESSORSTATE_STACKCACHEBASEVMA (ivory) "Base of the stack cache") + (LDL ,sca PROCESSORSTATE_SCOVLIMIT (ivory) "Size of the stack cache (words)") + )) + (SUBQ ,vma ,(or *memoized-base* temp) ,temp "Stack cache offset") + (CMPULT ,temp ,(or *memoized-limit* sca) ,temp2 "In range?") + (LDQ ,sca PROCESSORSTATE_STACKCACHEDATA (ivory)) + (branch-false ,temp2 ,notincache "J. if not in cache") + ;; Depends on VMAinStackCache leaving TEMP in a useful state + (S8ADDQ ,temp ,sca ,sca "reconstruct SCA"))) + +;;; These pseud instructions extract parts from a packed Ivory word. In such a word, +;;; the most significantthree bytes are zero, the next byte is TAG, the next 32 bits +;;; are data. Within the interpreter Ivory words are passed around like this. + +(defmacro TagTypeFromLispObj (from to &optional comment) + `((comment "TagType from LispObj.") + (SRL ,from 32 ,to ,@(if comment `(,comment))) + (AND ,to 63 ,to))) + +(defmacro TagCdrFromLispObj (from to &optional comment) + `((comment "TagCdr from LispObj.") + (SRL ,from ,(+ 32 6) ,to ,@(if comment `(,comment))))) + +(defmacro PackedInstructionP (iword temp &optional comment) + (check-temporaries (iword) (temp)) + `((comment "Identifiy a packed instruction type.") + (EXTBL ,iword 4 ,temp "Extract the tag byte") + (AND ,temp #o60 ,temp "Select two bits") + (SUBQ ,temp #o60 ,temp "temp==0 if packed"))) + +;;; These pseudo instructions extract parts from unpacked pieces. A register contains +;;; either a tag in the least significant byte, zeros elsewhere, or a datum in the +;;; least significant longword, zeros elsewhere. + +(defmacro TagType (from to &optional comment) + `((comment "TagType.") + (AND ,from 63 ,to ,@(if comment `(,comment))))) + +(defmacro TagCdr (from to &optional comment) + `((comment "TagCdr.") + (SRL ,from 6 ,to ,@(if comment `(,comment))))) + +(defmacro SetTag (tag data word &optional comment) + (assert (not (eq data word)) () "~A would be smashed before used" data) + `((comment "SetTag.") + (SLL ,tag 32 ,word) + (BIS ,data ,word ,word ,@(if comment `(,comment))))) + +(defmacro CheckDataType (tag type labl temp) + (check-temporaries (tag) (temp)) + `((SUBQ ,tag ,type ,temp) + (AND ,temp #x3F ,temp "Strip CDR code") + (BNE ,temp ,labl))) + +(defmacro CheckAdjacentDataTypes (tag base-type ntypes labl temp) + (check-temporaries (tag) (temp)) + (assert (zerop (mod ntypes (lsh 1 (1- (integer-length ntypes))))) (ntypes) + "NTYPES (~D) must be a power of two." ntypes) + `((SUBQ ,tag ,base-type ,temp) + (AND ,temp ,(logand #x3F (lognot (1- ntypes))) ,temp "Strip CDR code, low bits") + (BNE ,temp ,labl))) + +(defmacro NumericTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch numericexception))) + +(defmacro UnaryNumericTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch unarynumericexception))) + +(defmacro SpareTypeException (tag instruction op condition) + `((prepare-exception ,instruction 0 ,op ,tag) + (prepare-trap 0 ,condition nil) + (external-branch spareexception))) + +(defmacro ListTypeException (tag instruction &optional op) + `((prepare-exception ,instruction 0 ,op ,tag) + (external-branch listexception))) + +;; Idea here is that prepare-trap saves the relevant microstate in case +;; we decide we don't have an exception, but rather just have a plain +;; old illegal operand. +(defmacro ArrayTypeException (tag instruction op condition) + `((prepare-exception ,instruction 0 ,op ,tag) + (prepare-trap 0 ,condition nil) + (external-branch arrayexception))) + +(defmacro maybe-icount (r) + (let ((lb (gensym))) + `((comment "Update the instruction count.") + (LDQ ,r PROCESSORSTATE_INSTRUCTION_COUNT (ivory)) + (SUBQ ,r 1 ,r "Decrement the instruction count.") + (BNE ,r ,lb "J. if not reached stop point.") + (BIS zero zero zero "put a breakpoint here to catch stops") + (label ,lb) + (STQ ,r PROCESSORSTATE_INSTRUCTION_COUNT (ivory))))) + +(defmacro maybe-statistics (temp temp2 temp3 temp4 temp5 temp6) + `((LDQ ,temp CACHELINE_CODE (iCP) "The instruction.") + (LDQ ,temp2 PROCESSORSTATE_STATISTICS (ivory) "The usage statistics array") + (load-constant ,temp6 #x1FFF) + (SRL ,temp 4 ,temp3) + (AND ,temp3 ,temp6 ,temp3 "Extract the address") +;; (S4ADDQ ,temp3 ,temp2 ,temp4 "Compute the index to the usage data for this instn.") + (S8ADDQ ,temp3 ,temp2 ,temp4 "Compute the index to the usage data for this instn.") + +;; (LDL ,temp5 0 (,temp4) "Get current usage data") + (LDQ ,temp5 0 (,temp4) "Get current usage data") + (ADDQ ,temp5 1 ,temp5 "Increment") +;; (STL ,temp5 0 (,temp4) "Set current usage data"))) + (STQ ,temp5 0 (,temp4) "Set current usage data") + (X64EXECTIMES ,temp3))) + +(defmacro maybe-meter-hit (temp temp2 temp3 temp4 temp5 temp6) + (let ((done (gensym))) + `((LDL ,temp2 PROCESSORSTATE_METERCOUNT (ivory) "The number of remaining tokens.") + (LDQ ,temp PROCESSORSTATE_METERDATABUFF (ivory) "The cache miss meter buffer.") + (LDL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (SUBQ ,temp2 1 ,temp2 "record a cache hit") + (BNE ,temp2 ,done) + ;; Here is we reached the end of our gathering window. + (LDL ,temp5 PROCESSORSTATE_METERMASK (ivory)) + (S4ADDQ ,temp4 ,temp ,temp "position of the current data item") + (LDL ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (ADDQ ,temp4 1 ,temp4) + (AND ,temp4 ,temp5 ,temp4) + (LDL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (SUBQ ,temp6 ,temp5 ,temp3) + (CMOVGT ,temp3 ,temp6 ,temp5) + (STL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (STL ,temp6 0 (,temp) "store the datapoint") + (STL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (STL zero PROCESSORSTATE_METERVALUE (ivory)) + (LDL ,temp2 PROCESSORSTATE_METERFREQ (ivory)) + (label ,done) + (STL ,temp2 PROCESSORSTATE_METERCOUNT (ivory))))) + +(defmacro maybe-meter-miss (temp temp2 temp3 temp4 temp5 temp6) + (let ((done (gensym))) + `((LDL ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (LDL ,temp2 PROCESSORSTATE_METERCOUNT (ivory) "The number of remaining tokens.") + (LDQ ,temp PROCESSORSTATE_METERDATABUFF (ivory) "The cache miss meter buffer.") + ;(SUBQ ,temp2 1 ,temp2 "record a cache miss") + (ADDQ ,temp6 1 ,temp6 "count the miss.") + (LDL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (STL ,temp6 PROCESSORSTATE_METERVALUE (ivory)) + (BNE ,temp2 ,done) + ;; Here is we reached the end of our gathering window. + (LDL ,temp5 PROCESSORSTATE_METERMASK (ivory)) + (S4ADDQ ,temp4 ,temp ,temp "position of the current data item") + (ADDQ ,temp4 1 ,temp4) + (AND ,temp4 ,temp5 ,temp4) + (LDL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (SUBQ ,temp6 ,temp5 ,temp3) + (CMOVGT ,temp3 ,temp6 ,temp5) + (STL ,temp5 PROCESSORSTATE_METERMAX (ivory)) + (STL ,temp6 0 (,temp) "store the datapoint") + (STL ,temp4 PROCESSORSTATE_METERPOS (ivory) "Position for new data.") + (STL zero PROCESSORSTATE_METERVALUE (ivory)) + (LDL ,temp2 PROCESSORSTATE_METERFREQ (ivory)) + (label ,done) + (STL ,temp2 PROCESSORSTATE_METERCOUNT (ivory))))) + +#+Genera +(defun show-icache-histogram (&optional pathname (stream *standard-output*)) + (declare (special sct:*vlm-destination*)) + (when (null pathname) + (setq pathname (merge-pathnames "cachedata.lisp" sct:*vlm-destination*))) + (let ((cache-data (with-open-file (s pathname :direction :input) + (read s))) + (sum 0)) + (destructuring-bind ((size max freq) missdata filldata) cache-data + ;; The idea here is to draw a histogram in chunks that are + ;; about as wide as the viewport. We do this because if we + ;; draw the entire histogram in one chunk, it takes forever to + ;; do horizontal scrolling because the underlying window system + ;; spends forever drawing lines. + (fresh-line stream) + (let ((vw (floor (clim:bounding-rectangle-width (clim:window-viewport stream)) 2)) + (x 0) + (p missdata)) + (clim:with-end-of-line-action (stream :allow) + (clim:with-room-for-graphics (stream) + (loop while p doing + (let ((segments nil)) + (dotimes (i vw) + (when (null p) (return)) + (let* ((raw-y (pop p)) + (y (round raw-y 10))) + (setq segments (nconc segments (list x 0 x y))) + (incf sum raw-y) + (incf x))) + (clim:draw-lines* stream segments))))) + (fresh-line stream) + (let* ((avg (float (/ sum size))) + (std (let ((diffs 0)) + (dolist (y missdata) + (incf diffs (* (- y avg) (- y avg)))) + (sqrt (/ diffs size))))) + (format stream "Average is ~D (deviation ~D) fills per ~D cycles" + avg std freq)))))) + +(defmacro maybe-meter-trap (tvi temp temp2) + `((LDQ ,temp PROCESSORSTATE_TRAPMETERDATA (ivory) "pointer to trap data vector") + (LDA ,temp2 ,tvi (zero) "get the vector index") + (S8ADDQ ,temp2 ,temp ,temp) + (LDQ ,temp2 0 (,temp) "get the old value") + (LDA ,temp2 1 ,temp2 "increment it") + (STQ ,temp2 0 (,temp) "and store it back"))) + +(defmacro maybe-trace (temp temp2 temp3 temp4 temp5 temp6 &optional dispatch) + (let ((dotrace (gensym)) + (finishtrace (gensym)) + (noprint (gensym)) + (nowrap (gensym)) + (notrace (gensym))) + `((comment "Trace instructions if requested.") + (LDQ ,temp PROCESSORSTATE_TRACE_HOOK (ivory)) + (BEQ ,temp ,notrace "J. if not tracing.") + (comment "Record an instruction trace entry") + (LDL ,temp2 TRACEDATA_RECORDING_P (,temp)) + (LDQ ,temp3 TRACEDATA_START_PC (,temp)) + (branch-true ,temp2 ,dotrace "Jump if recording is on") + (CMPEQ ,temp3 iPC ,temp3 "Turn recording on if at the start PC") + (STL ,temp3 TRACEDATA_RECORDING_P (,temp)) + (branch-false ,temp3 ,notrace "Jump if not at the start PC") + (label ,dotrace) + (LDQ ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Get address of next trace record ") + (LDQ ,temp3 PROCESSORSTATE_INSTRUCTION_COUNT (ivory)) + (STQ iPC TRACERECORD_EPC (,temp2) "Save current PC") + (STQ ,temp3 TRACERECORD_COUNTER (,temp2) "Save instruction count") + (LDQ ,temp3 0 (iSP)) + (SCAtoVMA iSP ,temp4 ,temp5) + (STQ ,temp3 TRACERECORD_TOS (,temp2) "Save current value of TOS") + (STQ ,temp4 TRACERECORD_SP (,temp2) "Save current SP") + (LDL ,temp3 CACHELINE_OPERAND (iCP)) + (LDQ ,temp4 CACHELINE_CODE (iCP)) + (STL ,temp3 TRACERECORD_OPERAND (,temp2) "Save current instruction's operand") + (STQ ,temp4 TRACERECORD_INSTRUCTION (,temp2) "Save pointer to current instruction code") + (LDQ ,temp4 PROCESSORSTATE_CONTROL (ivory)) ;+++TEMPORARY + (LDQ ,temp5 CACHELINE_INSTRUCTION (iCP)) + (STL zero TRACERECORD_CATCH_BLOCK_P (,temp2) "We don't yet record catch blocks") + (STQ ,temp4 TRACERECORD_CATCH_BLOCK_0 (,temp2) "Save control register") ;+++TEMPORARY + (LDQ ,temp3 PROCESSORSTATE_TVI (ivory)) + (STQ ,temp5 TRACERECORD_INSTRUCTION_DATA (,temp2) "Save full word instruction operand") + (STL ,temp3 TRACERECORD_TRAP_P (,temp2) "Save trap indiciator") + (BEQ ,temp3 ,finishtrace "Jump if didn't trap") + (stack-read-disp iFP #.(* 8 2) ,temp3) + (STQ zero PROCESSORSTATE_TVI (ivory) "Zero flag to avoid false trap entries") + (stack-read-disp iFP #.(* 8 3) ,temp4) + (STQ ,temp3 TRACERECORD_TRAP_DATA_0 (,temp2) "Save trap vector index") + (stack-read-disp iFP #.(* 8 4) ,temp5) + (STQ ,temp4 TRACERECORD_TRAP_DATA_1 (,temp2) "Save fault PC") + (stack-read-disp iFP #.(* 8 5) ,temp6) + (STQ ,temp5 TRACERECORD_TRAP_DATA_2 (,temp2) "Save two additional arguments") + (STQ ,temp6 TRACERECORD_TRAP_DATA_3 (,temp2)) + (label ,finishtrace) + (ADDQ ,temp2 TRACERECORDSIZE ,temp2 "Bump to next trace record") + (LDQ ,temp3 TRACEDATA_RECORDS_START (,temp) "Get pointer to start of trace records") + (STQ ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Set record pointer to keep printer happy") + (LDQ ,temp4 TRACEDATA_RECORDS_END (,temp) "Get pointer to end of trace record") + (LDQ ,temp5 TRACEDATA_PRINTER (,temp) "Function to print trace if non-zero") + (CMPLE ,temp4 ,temp2 ,temp4 "Non-zero iff we're about to wrap the circular buffer") + (CMOVNE ,temp4 ,temp3 ,temp2 "Update next record pointer iff we wrapped") + (CMOVEQ ,temp4 zero ,temp5 "Don't print if we didn't wrap") + (BEQ ,temp5 ,noprint "Jump if we don't need to print") + (with-c-registers (,temp6 arg1 arg2 arg3 arg4 arg5 arg6 ,temp ,temp2 + ,@(if dispatch `(,dispatch))) + (BIS ,temp5 zero pv) + (JSR RA ,temp5 0)) + (BIS zero zero ,temp4 "Claim we didn't wrap") + (label ,noprint) + (STQ ,temp2 TRACEDATA_CURRENT_ENTRY (,temp) "Save next record pointer") + (BEQ ,temp4 ,nowrap "Jump if we didn't wrap") + (STL ,temp4 TRACEDATA_WRAP_P (,temp) "Set flag indicating that we wrapped") + (label ,nowrap) + (LDQ ,temp2 TRACEDATA_STOP_PC (,temp)) + (CMPEQ ,temp2 iPC ,temp2 "Non-zero if at PC where we should stop tracing") + (CMPEQ ,temp2 0 ,temp2 "Non-zero if not at the PC") + (STL ,temp2 TRACEDATA_RECORDING_P (,temp) "Update recording flag") + (label ,notrace)))) + +;; This means "iPC and iCP have been set up, so execute that instruction". +;; Note the interpretInstruction also checks to see if we have been +;; requested to stop. +(defmacro ContinueToInterpretInstruction (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero interpretinstruction ,@(if comment `(,comment))))) + +;; Use this if you have only set up the PC +(defmacro ContinueToInterpretInstruction-ValidateCache (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero interpretInstructionForBranch ,@(if comment `(,comment))))) + +;; This means "increment the PC by 1 (by picking up iPC and iCP from the +;; current instruction's cache line) and execute that instruction". That +;; is, this is used to continue executing straight-line code, and hence +;; does not check to see if the emulator has been requested to stop. +;; This can often dual issue with previous instruction. +(defmacro ContinueToNextInstruction (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero nextinstruction ,@(if comment `(,comment))))) + +(defmacro GetNextPC () + `((LDQ iPC CACHELINE_NEXTPCDATA (iCP)))) + +(defmacro PrefetchNextPC (temp) + `((LDQ ,temp CACHELINE_NEXTPCDATA (iCP)))) + +(defmacro SetNextPC (temp) + `((BIS ,temp zero iPC))) + +(defmacro GetNextCP () + `((LDQ iCP CACHELINE_NEXTCP (iCP)))) + +(defmacro PrefetchNextCP (temp) + `((LDQ ,temp CACHELINE_NEXTCP (iCP)))) + +(defmacro SetNextCP (temp) + `((BIS ,temp zero iCP))) + +(defmacro GetNextPCandCP () + `((LDQ iPC CACHELINE_NEXTPCDATA (iCP)) + (LDQ iCP CACHELINE_NEXTCP (iCP)))) + +;; Like ContinueToNextInstruction, except that the new iPC and iCP have been +;; set up, which means that we can avoid some stalls in nextInstruction. +(defmacro ContinueToNextInstruction-NoStall (&optional comment) + ;; Don't use EXTERNAL-BRANCH because we want to get a warning... + `((BR zero cacheValid ,@(if comment `(,comment))))) + +(defmacro instruction-exception (&optional comment) + `((external-branch exception ,@(if comment `(,comment))))) + +(defmacro arithmetic-exception (&optional comment) + `((external-branch exception ,@(if comment `(,comment))))) + +;; Condition to microstate computation now handled in prepare-trap +(defmacro illegal-operand (condition &optional vma comment) + `((prepare-trap 0 ,condition ,vma) + (external-branch illegaloperand ,@(if comment `(,comment))))) + +(defmacro illegal-instruction (&optional comment) + `((external-branch illegalinstruction ,@(if comment `(,comment))))) + +(defmacro halt-machine (&optional (reason 'HaltReasonHalted) comment) + (ecase reason + (HaltReasonHalted + `((external-branch haltmachine ,@(if comment `(,comment))))) + (HaltReasonFatalStackOverflow + `((external-branch fatalstackoverflow ,@(if comment `(,comment))))) + (HaltReasonIllegalTrapVector + `((external-branch illegaltrapvector ,@(if comment `(,comment))))))) + + +;;; Macros for predicate support. + +;;; If the body can trap, be sure to supply :CAN-TRAP T, otherwise iPC and +;;; iCP will get clobbered prematurely and the trap handler will lose! +(defmacro with-predicate-store ((ttag niltag fall-into t1 t2 &key can-trap) + &body body) + (let* ((prelude `(,(if fall-into `(get-t ,t1) `(get-nil ,t2)) + (force-alignment) ; if in same word separate! + ,(if fall-into `(get-nil ,t2) `(get-t ,t1)) + ,@(unless can-trap `((GetNextPCandCP))))) + (tclause `((label ,ttag "Here to push T") + (STQ ,t1 0 (iSP)) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall)))) + (nilclause `((comment "here to push NIL") + (label ,niltag) + (STQ ,t2 0 (iSP)) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall))))) + (if fall-into + (append prelude `(,@body) tclause nilclause) + (append prelude `(,@body) nilclause tclause)))) + +;;; We now increment iSP *before* the body, so if body uses iSP *BEWARE*! +;;; If the body can trap, be sure to supply :CAN-TRAP T, otherwise iPC and +;;; iCP will get clobbered prematurely and the trap handler will lose! +(defmacro with-predicate-push ((ttag niltag fall-into t1 t2 &key can-trap) + &body body) + (let* ((prelude `((force-alignment) + ,(if fall-into `(get-t ,t1) `(get-nil ,t2)) + (force-alignment) + ,(if fall-into `(get-nil ,t2) `(get-t ,t1)) + ,@(unless can-trap `((GetNextPCandCP))))) + (tclause `((label ,ttag "Here to push T") + (STQ ,t1 8 (iSP)) + (ADDQ iSP 8 iSP) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall)))) + (nilclause `((comment "here to push NIL") + (label ,niltag) + (STQ ,t2 8 (iSP)) + (ADDQ iSP 8 iSP) + ,(if can-trap + `(ContinueToNextInstruction) + `(ContinueToNextInstruction-NoStall))))) + (if fall-into + (append prelude `(,@body) tclause nilclause) + (append prelude `(,@body) nilclause tclause)))) + + + +(defmacro align4k () + `((passthru ,(format nil ".align ~D" 12)) #|| 2^ 12 = 4096 ||#)) + +;;; This will get us to the end of the current 4k chunk (which must be the second 4K +;;; chunk of the page. Then two 4k chunks are skipped. + +(defmacro align4Kskip8K () + `((align4k) ; skip to end of current 4k chunk + (AND zero zero zero) + (align4k) ; skip a half page + (AND zero zero zero) + (align4k))) ; skip another half page + +(defmacro align4kskip4k () + `((align4k) ; skip to end of current 4k chunk + (AND zero zero zero) + (align4k))) + +(defmacro define-instruction (name format (&rest options) &body body &environment env) + #+Genera (declare (zwei:indentation . indent-define-procedure)) + (let ((*function-being-processed* name)) + `((start ,name) + ,@(apply #'expand-instruction-procedure-header format name options) + ,@(collecting-function-epilogue body env) + #---ignore ,@(apply #'expand-instruction-procedure-trailer format name options) + #+++ignore (end ,name ,format)))) + +(clos:defgeneric expand-instruction-procedure-header (format name &key &allow-other-keys)) +(clos:defgeneric expand-instruction-procedure-trailer (format name &key &allow-other-keys)) + +;;; A :full-word-instruction has a single entry point defined to be 'name' +;;; No default unpacking is necessary. All information about the instruction +;;; is available via iCP and iPC. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :full-word-instruction)) name &key) + `((comment ,(format nil "Fullword instruction - ~a" name)) + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x80")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" name)))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :full-word-instruction)) name &key) + `((end ,name) + (comment ,(format nil "End of Fullword instruction - ~a" name)))) + + +;;; A :operand-from-stack has four entrypoints, FP LP SP and IM, IM is an +;;; error case, the other cases generate operand loading code and then fall +;;; into the body. The operand obtained is left in 'arg1'. +;;; the SP pop mode falls into the body. This mode needs to be +;;; watched carefully since the arg2 is left with a pointer beyond the top +;;; of the stack. The operand value must be read before the stack is pushed +;;; or it will be overwritten. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack)) name + &key own-immediate needs-tos + provide-immediate signed-immediate) + (assert (not (lisp:and own-immediate provide-immediate)) () "Huh?") + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (comment "arg2 has the preloaded 8 bit operand.") + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + + ,@(when provide-immediate + `((comment "arg2 has the preloaded 8 bit operand.") + (passthru "#ifdef TRACING") + ,@(if signed-immediate + `((passthru ,(format nil " .byte 0x83"))) + `((passthru ,(format nil " .byte 0x82")))) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + ,@(if signed-immediate + `((comment "This sequence only sucks a moderate amount") + ;; Careful! We are using arg1 as a temp so we can + ;; clear arg2 in the stall slot + (SLL arg2 #.(- 64 8) arg1 "sign extend the byte argument.") + (BIS zero zero arg2) + (SRA arg1 #.(- 64 8) arg1 "Rest of sign extension") + (STL arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDA arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory))) + `((comment "This sequence is lukewarm") + (STL arg2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDA arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BIS zero zero arg2))) + (BR zero ,bodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciiz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (BIS arg5 zero arg1 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((BNE arg2 ,bodyname) + (LDQ arg6 0 (arg4) "SP-pop, Reload TOS") + (BIS iSP zero arg1 "SP-pop mode") + (BIS arg4 zero iSP "Adjust SP")) + `((CMOVEQ arg2 iSP arg1 "SP-pop mode") + (CMOVEQ arg2 arg4 iSP "Adjust SP if SP-pop mode"))) + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciiz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciiz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (comment "arg1 has the operand address.") + (S8ADDQ arg2 arg1 arg1 "Compute operand address") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack)) name &key own-immediate provide-immediate) + (let ((imname (format nil "~aIM" name))) + `(;; put this here for lack of a better spot + ,@(unless (or own-immediate provide-immediate) + `((passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (unlikely-label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (external-branch |DoIStageError| ,(format nil "IMMEDIATE mode not legal in ~a." + name)))) + (end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name))))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack-immediate)) name &key own-immediate needs-tos) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "head~a" name)) + (realbodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (comment "arg2 has the preloaded 8 bit operand.") + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + ,@(unless own-immediate + `((passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (comment "This sequence is lukewarm") + (STL arg2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDQ arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BR zero ,realbodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciiz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (BIS arg5 zero arg1 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((BNE arg2 ,bodyname) + (BIS arg6 zero arg1 "SP-pop mode, TOS->arg1") + (LDQ arg6 0 (arg4) "Reload TOS") + (BIS arg4 zero iSP "Adjust SP") + (BR zero ,realbodyname)) + `((CMOVEQ arg2 iSP arg1 "SP-pop mode") + (CMOVEQ arg2 arg4 iSP "Adjust SP if SP-pop mode"))) + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciiz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciiz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (S8ADDQ arg2 arg1 arg1 "Compute operand address") + (LDQ arg1 0 (arg1) "Get the operand") + (label ,realbodyname) + (comment "arg1 has the operand, not sign extended if immediate.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +(defmacro immediate-handler (name) + (let ((imname (format nil "~aIM" name))) + `((passthru "#ifdef TRACING") + (BR zero ,imname) + (passthru ,(format nil " .byte 0x82")) + (passthru ,(format nil " .asciiz \"~aIM\"" name)) + (passthru "#endif") + (passthru ,(format nil ".align ~D" *function-alignment*)) + (label ,imname "Entry point for IMMEDIATE mode")))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :operand-from-stack-signed-immediate)) name &key own-immediate needs-tos) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name)) + (bodyname (format nil "head~a" name)) + (realbodyname (format nil "begin~a" name))) + `((comment ,(format nil "Halfword operand from stack instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + ,@(unless own-immediate + `((comment "arg2 has the preloaded 8 bit operand.") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x83")) + (passthru ,(format nil " .asciiz \"~a\"" imname)) + (passthru "#endif") + (label ,(format nil "~a" imname) "Entry point for IMMEDIATE mode") + (comment "This sequence only sucks a moderate amount") + (SLL arg2 #.(- 64 8) arg2 "sign extend the byte argument.") + (force-alignment) + (SRA arg2 #.(- 64 8) arg2 "Rest of sign extension") + (STL arg2 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (LDQ arg1 PROCESSORSTATE_IMMEDIATE_ARG (Ivory)) + (BR zero ,realbodyname))) + + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0x88")) + (passthru ,(format nil " .asciiz \"~a\"" spname)) + (passthru "#endif") + (label ,(format nil "~a" spname) "Entry point for SP relative") + (BIS arg5 zero arg1 "Assume SP mode") + ,@(if needs-tos + ;; This sequence gets assumes sp|pop most likely (sp-relative + ;; takes a forward branch). As a consolation, it gets more + ;; dual-issues than would be needed to do everything + ;; conditionally. + `((BNE arg2 ,bodyname) + (BIS arg6 zero arg1 "SP-pop mode, TOS->arg1") + (LDQ arg6 0 (arg4) "Reload TOS") + (BIS arg4 zero iSP "Adjust SP") + (BR zero ,realbodyname)) + `((CMOVEQ arg2 iSP arg1 "SP-pop mode") + (CMOVEQ arg2 arg4 iSP "Adjust SP if SP-pop mode"))) + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x90")) + (passthru ,(format nil " .asciiz \"~a\"" lpname)) + (passthru "#endif") + (label ,(format nil "~a" lpname) "Entry point for LP relative") + + (passthru "#ifdef TRACING") + (BR zero ,bodyname) + (passthru ,(format nil " .byte 0x84")) + (passthru ,(format nil " .asciiz \"~a\"" fpname)) + (passthru "#endif") + (label ,(format nil "~a" fpname) "Entry point for FP relative") + + (label ,bodyname) + (S8ADDQ arg2 arg1 arg1 "Compute operand address") + (LDQ arg1 0 (arg1) "Get the operand") + (label ,realbodyname) + (comment "arg1 has the operand, sign extended if immediate.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :operand-from-stack-signed-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :10-bit-immediate)) name &key own-immediate needs-tos) + (declare (ignore needs-tos)) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Halfword 10 bit immediate instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA0")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + ,@(unless own-immediate + `((EXTWL arg3 4 arg1))) + (comment "arg1 has operand preloaded.") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :10-bit-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + +(clos:defmethod expand-instruction-procedure-header + ((format (eql :10-bit-signed-immediate)) name &key own-immediate needs-tos) + (declare (ignore needs-tos)) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Halfword 10 bit immediate instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA1")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + ,@(unless own-immediate + `((SRA arg3 48 arg1))) + (comment "arg1 has signed operand preloaded.") + ))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :10-bit-signed-immediate)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + +;;; 10 bit operand encoded position= ls 5 bits size=ms5 bits. +;;; 10 bit operand is in arg1, truncated 8 bit is in arg2 +;;; shift arg1 right by 5 bits to give 'size-1' +;;; mask arg2 by #x1F to give position. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :field-extraction)) name &key) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Field Extraction instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xA0")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + (SRL arg3 #.(+ 32 5) arg1 "Shift the 'size-1' bits into place") + (AND arg2 #x1F arg2 "mask out the unwanted bits in arg2") + (AND arg1 #x1F arg1 "mask out the unwanted bits in arg1") + (comment "arg1 has size-1, arg2 has position.")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :field-extraction)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + +;;; AH! this is a fun one +;;; This instruction type is actually a fullword in disguise! It therefore +;;; is always on an even instruction boundary! +;;; upon entry, arg2 already has the number of required args. +;;; arg1 has the 10 bit immediate, of which two bits are the ptr field. +;;; we'll shift them into place. We must load the instruction from the cache +;;; to get at the rest of the bits. +;;; we lose two cycles to stalling, and we get no dual. We may want to +;;; pull out the last two instructions and hand position them. Especially as +;;; there are very few of these instructions. +(clos:defmethod expand-instruction-procedure-header + ((format (eql :entry-instruction)) name &key) + (let ((fpname (format nil "~aFP" name)) + (spname (format nil "~aSP" name)) + (lpname (format nil "~aLP" name)) + (imname (format nil "~aIM" name))) + `((comment ,(format nil "Field Extraction instruction - ~a" name)) + (passthru ,(format nil " .globl ~a" fpname)) + (passthru ,(format nil " .globl ~a" spname)) + (passthru ,(format nil " .globl ~a" lpname)) + (passthru ,(format nil " .globl ~a" imname)) + (label ,(format nil "~a" name)) + (comment "Actually only one entry point, but simulate others for dispatch") + (passthru "#ifdef TRACING") + (passthru ,(format nil " .byte 0xB0")) + (passthru ,(format nil " .asciiz \"~a\"" name)) + (passthru "#endif") + (label ,(format nil "~a" imname)) + (label ,(format nil "~a" spname)) + (label ,(format nil "~a" lpname)) + (label ,(format nil "~a" fpname)) + (get-control-register arg5 "The control register") + (SRL arg3 18 arg4 "Pull down the number of optionals") + (EXTBL arg3 5 arg1 "Extract the 'ptr' field while we are waiting") + (AND arg4 #xFF arg4) + (comment "arg1=ptr field, arg2=required, arg3=instn, arg4=optionals arg5=control-register")))) + +(clos:defmethod expand-instruction-procedure-trailer + ((format (eql :entry-instruction)) name &key) + `((end ,name) + (comment ,(format nil "End of Halfword operand from stack instruction - ~a" name)))) + + + +(defmacro UnimplementedInstruction () + `((comment "This instruction has not been written yet.") + (illegal-operand i-stage-error))) + +;;; Section Conditional macros. + +;;; because the dispatch table for all types is large and prohibitive for +;;; repeating over many instructions, we will attempt to dispatch sequentially. +;;; It is imperative that the order be chosen very carefully! +;;; 1 cycle + 3 cycles per clause until match. +;;; so match on the first clause costs 4 cycles + body of clause +;;; match on second clause costs 7 cycles + body of clause etc. + +(defun last-instruction-is-branch-p (body) + (loop named branchp for clause in (reverse body) do + (loop for instruction = clause then (car instruction) do + (when (atom instruction) + (cond ((member instruction '(label unlikely-label comment)) + (return nil)) + ((member instruction '(BR external-branch)) + (return-from branchp t)) + (t + (return-from branchp nil))))))) + +;;; deals with tags of up to 8 bits only +(defmacro basic-dispatch (t1 t2 &body clauses &environment env) + (let* ((expanded ()) + (end-label (gensym)) + (else-label (assoc :else-label clauses)) + (fall-through nil) + ) + (when else-label + (setq clauses (remove else-label clauses) + else-label (second else-label))) + (loop for rest-label = nil then label + as label = (gensym) + for (clause . rest) on clauses do ;dolist (clause clauses) + (when (null rest) + (if else-label + (setq label else-label) + (setq label end-label))) + (destructuring-bind (key &rest body) clause + (let* ((body (if (lisp:and (atom (car body)) (null (cdr body))) + (car body) + (macroexpand-asm-form body env))) + (dont-emit-branch + (cond + ;; An atom for a clause body means the clause's body + ;; is implemented by branching to that atom (as a + ;; label) + ((atom body) t) + ;; On the first clause, we never emit a branch. If + ;; the clause does not end in a branch, we arrange + ;; for it to "fall-through" to the end-label by + ;; moving the other clauses out of line. If it does + ;; end in a branch, we don't move the other clauses + ;; out of line, but we still don't need to emit a + ;; branch + ((null rest-label) + (setq fall-through (not (last-instruction-is-branch-p body))) + t) + ;; On the last clause, we emit a branch if it doesn't + ;; end in one and the first clause is going to fall + ;; through (otherwise the last clause does) + ((null rest) + (or (null fall-through) + (last-instruction-is-branch-p body))) + ;; Otherwise, we emit a branch if the clause does not supply it's own + (t (last-instruction-is-branch-p body))))) + (cond ((member key '(:else :otherwise 'else 'otherwise)) + (assert (null rest) () "Else clause not last in dispatch") + (push + `(,@(when rest-label + `((label ,rest-label))) + (comment ,(format nil "Here for all other cases")) + ,@body + ,@(unless dont-emit-branch + `((BR zero ,end-label)))) + expanded)) + ((listp key) + (let ((matchlabel (gensym))) + (push + `(,@(when rest-label + `((label ,rest-label))) + ,@(loop for (cl . rest) on key + collect + (if (lisp:and (integerp cl) (zerop cl)) + `(,@(if (null rest) + `((BNE ,t1 ,label)) + `((BEQ ,t1 ,matchlabel)))) + `((CMPEQ ,t1 ,cl ,t2) + ;; Can't di with SUBQ, so align to possibly + ;; di with first instruction of body + (force-alignment) + ,@(if (null rest) + `((branch-false ,t2 ,label)) + `((branch-true ,t2 ,matchlabel)))))) + (label ,matchlabel) + (comment ,(format nil "Here if argument ~a" key)) + ,@body + ,@(unless dont-emit-branch + `((BR zero ,end-label)))) + expanded))) + (t + (push + `(,@(when rest-label + `((label ,rest-label))) + ,(if (lisp:and (integerp key) (zerop key)) + (cond ((null body) + `(BEQ ,t1 ,end-label)) + ((atom body) + `(BEQ ,t1 ,body)) + (t + `(BNE ,t1 ,label))) + `((CMPEQ ,t1 ,key ,t2) + ;; Can't di with SUBQ, so align to possibly + ;; di with first instruction of body + (force-alignment) + ,(cond ((null body) + `(branch-true ,t2 ,end-label)) + ((atom body) + `(branch-true ,t2 ,body)) + (t + `(branch-false ,t2 ,label))))) + ,@(if (atom body) + ;; When last dispatch would fall-though on no + ;; match, have to create an else clause + (when (null rest) + `((BR zero ,label))) + `(((comment ,(format nil "Here if argument ~a" key)) + ,@body + ,@(unless dont-emit-branch + `((BR zero ,end-label))))))) + expanded)))))) + (setq expanded (nreverse expanded)) + (if fall-through + (let ((first (pop expanded))) + (when expanded + (push (apply #'nconc expanded) + *function-epilogue*)) + `(,first + (label ,end-label))) + `(,@(apply #'nconc expanded) + (label ,end-label))))) + +;;; deals with tags of up to 16 bits only +(defmacro mondo-dispatch (t1 t2 &body clauses) + (let* ((expanded ()) + (nlabels (let ((n 0)) + (dolist (clause clauses) + (if (listp (car clause)) + (incf n (length (car clause))) + (incf n 1))) + n)) + (end-label (gensym)) + (i 0) + (label (gensym))) + (dolist (clause clauses) + (cond ((member (car clause) '(:else :otherwise 'else 'otherwise)) + (push + `((comment ,(format nil "Here for all other cases")) + ,@(cdr clause) + ,@(unless (= i nlabels) `((BR zero ,end-label))) + (label ,label)) + expanded)) + ((listp (car clause)) ;+++ this generates more code than it should + (dolist (cl (car clause)) + (push + `((LDA ,t2 ,cl (zero)) + (SUBQ ,t1 ,t2 ,t2) + (BNE ,t2 ,label) + (comment ,(format nil "Here if argument ~a" cl)) + ,@(cdr clause) + ,@(unless (= i nlabels) `((BR zero ,end-label))) + (label ,label)) + expanded) + (incf i) + (setq label (gensym)))) + (t + (push + `((LDA ,t2 ,(car clause) (zero)) + (SUBQ ,t1 ,t2 ,t2) + (BNE ,t2 ,label) + (comment ,(format nil "Here if argument ~a" (car clause))) + ,@(cdr clause) + ,@(unless (= i nlabels) `((BR zero ,end-label))) + (label ,label)) + expanded))) + (incf i) + (setq label (gensym))) + `(,@(apply #'nconc (nreverse expanded)) + (label ,end-label)))) + +(defmacro cdr-code-dispatch (tagreg t1 t2 &body clauses) + (check-temporaries (tagreg) (t1 t2)) + `((AND ,tagreg #b11000000 ,t1 "Extract CDR code.") + (basic-dispatch ,t1 ,t2 ,@(sublis `((|CdrNext| . ,(lsh |cdr|$k-|next| 6)) + (|CdrNormal| . ,(lsh |cdr|$k-|normal| 6)) + (|CdrNil| . ,(lsh |cdr|$k-|nil| 6)) + (3 . ,(lsh 3 6))) + clauses)))) + +(defmacro register-dispatch (tagreg t1 t2 &body clauses) + (check-temporaries (tagreg) (t1 t2)) + `(mondo-dispatch ,tagreg ,t2 ,@clauses)) + +(defmacro type-dispatch (tagreg t1 t2 &body clauses) + (check-temporaries (tagreg) (t1 t2)) + `((AND ,tagreg #x3F ,t1 "Strip off any CDR code bits.") + (basic-dispatch ,t1 ,t2 ,@clauses))) + + +(defmacro binary-type-dispatch ((tag1 tag2 tag1-stripped t2 tag2-stripped t4) &body clauses) + (check-temporaries (tag1 tag2) (tag1-stripped t2 tag2-stripped t4)) + "Clauses are ((type1 type2) . body) or (:else1 . body), (:else2 . + body), or (:else . body)" + (let ((subclause-alist ()) + (inner-dispatches ()) + (elseclause nil) + (else1clause nil) + (else2clause nil) + (eclabel (gensym)) + (ec1label (gensym)) + (ec2label (gensym)) + (done (gensym))) + ;; For each clause, sort into first type, subclauses + ;; Next make a nested type-dispatch + (dolist (cl clauses) + (cond ((eq (car cl) :else1) + (setq else1clause `((label ,ec1label) ,@(cdr cl)))) + ((eq (car cl) :else2) + (setq else2clause `((label ,ec2label) ,@(cdr cl)))) + ((eq (car cl) :else) + (setq elseclause `((label ,eclabel) ,@(cdr cl)))) + (t (let ((scl (assoc (caar cl) subclause-alist))) + (if scl + (setf (cdr scl) (cons `(,(cadar cl) ,@(cdr cl)) (cdr scl))) + (push `(,(caar cl) (,(cadar cl) ,@(cdr cl))) subclause-alist)))))) + (assert (not (lisp:and elseclause (or else1clause else2clause))) () + "Can't have :else and :else") + (assert (or elseclause (lisp:and else1clause else2clause)) () + "Must supply both :else1 and :else2") + ;; Add else clauses to the embedded dispatches if required + (cond (else2clause + (dolist (cl subclause-alist) + (push `(:else-label ,ec2label) (cdr cl)))) + (elseclause + (dolist (cl subclause-alist) + (push `(:else-label ,eclabel) (cdr cl))))) + ;; All clauses have been organized, now construct the inner type-dispatches + ;; Clauses are reversed in alist entries. + (dolist (cl subclause-alist) + (push `(,(car cl) + ;; Cdr stripped in top-level + (basic-dispatch ,tag2-stripped ,t4 ,@(nreverse (cdr cl)))) inner-dispatches)) + + ;; Finally emit the outer dispatch! + `(;; Touch the tags in 1/2 order, as callee might expect + (AND ,tag1 #x3F ,tag1-stripped "Strip off any CDR code bits.") + (AND ,tag2 #x3F ,tag2-stripped "Strip off any CDR code bits.") + (basic-dispatch ,tag1-stripped ,t2 + ,@inner-dispatches + (:else + ,@elseclause + ,@else1clause + ,@(when else2clause + `((BR zero ,done) + ,@else2clause + (label ,done)))))))) + +;;; State Saving and restoring, register definitions. + +;;; Macros to save and restore the cached state of the machine in the ivory object. + +(defmacro cache-ivory-state () + `((LDQ iCP PROCESSORSTATE_CP (ivory)) + (LDQ iPC PROCESSORSTATE_EPC (ivory)) + (LDQ iSP PROCESSORSTATE_SP (ivory)) + (LDQ iFP PROCESSORSTATE_FP (ivory)) + (LDQ iLP PROCESSORSTATE_LP (ivory)))) + +(defmacro decache-ivory-state () + `((STQ iCP PROCESSORSTATE_CP (ivory)) + (STQ iPC PROCESSORSTATE_EPC (ivory)) + (STQ iSP PROCESSORSTATE_SP (ivory)) + (STQ iFP PROCESSORSTATE_FP (ivory)) + (STQ iLP PROCESSORSTATE_LP (ivory)))) + +(eval-when (compile load eval) +;;; Register definitions. +(define-integer-register t1 1) +(define-integer-register t2 2) +(define-integer-register t3 3) +(define-integer-register t4 4) +(define-integer-register t5 5) +(define-integer-register t6 6) +(define-integer-register t7 7) +(define-integer-register t8 8) +(define-integer-register iPC 9) +(define-integer-register iFP 10) +(define-integer-register iLP 11) +(define-integer-register iSP 12) +(define-integer-register iCP 13) +(define-integer-register ivory 14) ; ivory processor object +(define-integer-register arg1 16) +(define-integer-register arg2 17) +(define-integer-register arg3 18) +(define-integer-register arg4 19) +(define-integer-register arg5 20) +(define-integer-register arg6 21) +(define-integer-register t9 22) +(define-integer-register t10 23) +(define-integer-register t11 24) +(define-integer-register t12 25) +(define-integer-register ra r26) +(define-integer-register pv r27) +(define-integer-register gp r29) +(define-integer-register sp r30) + +(define-integer-register none 31) +(define-integer-register instn 1) ; = T1 +(define-integer-register iword 2) ; = T2 +(define-integer-register ecp 3) ; = T3 +(define-integer-register ocp 4) ; = T4 +(define-integer-register icsize 5) ; = T5 (icache size in bytes) +(define-integer-register epc 6) ; = T6 +(define-integer-register opc 7) ; = T7 +(define-integer-register count 8) ; = T8 +(define-integer-register hwopmask 20) ; = ARG5 (the halfword operand mask) +(define-integer-register fwdispatch 21) ; = ARG6 (the fullword dispatch table) +(define-integer-register hwdispatch 22) ; = T9 (the halfword dispatch table) +) diff --git a/stub/makediff.sh b/stub/makediff.sh new file mode 100644 index 0000000..ef3eb1f --- /dev/null +++ b/stub/makediff.sh @@ -0,0 +1,28 @@ +#!/bin/sh + +diff -u xoutput1 output1 +diff -u xoutput2 output2 +diff -u xoutput3 output3 +diff -u xoutput4 output4 +diff -u xoutput5 output5 +diff -u xoutput6 output6 +diff -u xoutput7 output7 +diff -u xoutput8 output8 +diff -u xoutput9 output9 +diff -u xoutput10 output10 +diff -u xoutput11 output11 +diff -u xoutput12 output12 +diff -u xoutput13 output13 +diff -u xoutput14 output14 +diff -u xoutput15 output15 +diff -u xoutput16 output16 +diff -u xoutput17 output17 +diff -u xoutput18 output18 +diff -u xoutput19 output19 +diff -u xoutput20 output20 +diff -u xoutput21 output21 +diff -u xoutput22 output22 +diff -u xoutput23 output23 +diff -u xoutput24 output24 +diff -u xoutput25 output25 +diff -u xoutput26 output26 diff --git a/stub/process.lisp b/stub/process.lisp new file mode 100644 index 0000000..8853952 --- /dev/null +++ b/stub/process.lisp @@ -0,0 +1,2482 @@ +;; +;; convert alpha assembler lisp into C +;; I may never live this down, but I had to try it... +;; +;; Brad Parker 4/2006 +;; brad@heeltoe.com +;; + +(progn + (defmacro unlock-package (pack) + (setf *locked-package-saved-value* (ext:package-lock pack) + (ext:package-lock pack) nil)) + + (unlock-package system) + (unlock-package common-lisp) + (unlock-package clos) +) + +(unlock-package system) + +(defpackage ALPHA-AXP-INTERNALS + (:nicknames AXPI) + (:use COMMON-LISP) + (:shadow AND)) + +(defpackage I-LISP-COMPILER + (:use COMMON-LISP) + (:export *FINISH-CALL-N-OPCODE*)) + +(in-package "ALPHA-AXP-INTERNALS") + +(defmacro lc (str) + `(if (numberp ,str) + ,str + (string-downcase ,str))) + +(defmacro defsubst (name arglist &body body) + `(progn + (declaim (inline ,name)) + (defun ,name ,arglist ,@body))) + +(defmacro stack-let (vars-and-vals &body body) + (let ((vars (loop for var-and-val in vars-and-vals + if (atom var-and-val) + collect var-and-val + else + collect (first var-and-val)))) + `(let ,vars-and-vals + (declare (dynamic-extent ,@vars)) + ,@body))) + +(defun circular-list (&rest list) + (let ((list (copy-list list))) + (setf (cdr (last list)) list) + list)) + +(defmacro define-integer-register (name reg &rest other)) + +(defun register-asmname (name) +; (format t "register-asmname: ~S~%" name) + (lc name)) + +(defun find-register (name) +; (format t "find-register: ~S~%" name) + (lc name)) + +(in-package "SYSTEM") + +(defun %logdpb (value bytespec integer) + (let ((result (dpb value bytespec integer))) + (if (zerop (ldb (byte 1 31) result)) + result + (- (ldb (byte 31 0) (1+ (lognot result))))))) + +;; +(in-package "ALPHA-AXP-INTERNALS") + +;; The function alignment is 3 so that calling into a new procedure +;; causes all a large number of the instructions following the initial +;; instruction to be read into the cache. +(defparameter *function-alignment* 5) + +(defun coerce-to-register (reg) + reg) + +(defun coerce-to-register-or-literal (reglit) + reglit) + +(defun lsh (num places) + (if (>= num 0) (ash num places) + (if (>= places 0) (ash num places) + (ash + (logior + (ash (logand -1 most-positive-fixnum) -1) + (ash (+ most-positive-fixnum 1) -2)) (+ 1 places))))) + +;; + +(defun c-header (destination sourcename) + (format destination + "~&/************************************************************************") + (format destination + "~& * WARNING: DO NOT EDIT THIS FILE. THIS FILE WAS AUTOMATICALLY GENERATED") + (format destination + "~& * FROM ~a. ANY CHANGES MADE TO THIS FILE WILL BE LOST" sourcename) + (format destination + "~& ************************************************************************/~%~%")) + +(defun c-trailer (destination sourcename) + (format destination + "~%~%~%/* End of file automatically generated from ~a */~%" sourcename)) + +(defvar *function-being-processed* nil) +(defvar *function-epilogue*) +(defvar *do-check-oflo* nil) +(defvar *do-check-ratquo* nil) + +; +(defun macroexpand-careful (form env) +; (format t "xxx: ~S~%" (car form)) + (if (eq (car form) 'AND) + form + (macroexpand form env))) + +(defun macroexpand-asm-form (form &optional env) + (if (consp (first form)) + (loop for meform in form + as expanded = (macroexpand-asm-form meform env) + if (consp (first expanded)) + append expanded + else + collect expanded) + (let ((expanded (macroexpand-careful form env))) + (if (eq expanded form) +(progn +;(format t "macroexpand-asm-form: form ~S~%" form) + form +) + (macroexpand-asm-form expanded env))))) + +(defun collecting-function-epilogue (body env) + (let ((*function-epilogue* nil)) + `(,@(mapcar #'(lambda (x) (macroexpand-asm-form x env)) body) + ,@(loop while *function-epilogue* + append (mapcar #'(lambda (x) (macroexpand-asm-form x env)) + (shiftf *function-epilogue* nil)))))) + +;; (defmacro define-procedure (name (&rest args) &body body &environment env) +;; (let ((*function-being-processed* name)) +;; `((start ,name ,(length args)) +;; ; (label ,name) +;; (func-label ,name) +;; ,@(collecting-function-epilogue body env) +;; (end ,name)))) + +(defmacro check-comment (arg) + `(if ,arg (format destination " /* ~A */~%" ,arg))) + +(defun remap-arg (str) + (cdr (assoc str + '((ICP . "iCP") + (IPC . "iPC") + (ISP . "iSP") + (IFP . "iFP") + (ILP . "iLP") + (ILP . "iLP") + (CACHELINE_NEXTPCDATA . "nextpcdata") + (CACHELINE_NEXTCP . "nextcp") + (CACHELINE_PCDATA . "pcdata") + (CACHELINE_INSTRUCTION . "instruction") + (CACHELINE_ANNOTATION . "annotation") + (CACHELINE_CODE . "code") + (CACHELINE_OPERAND . "operand") + (CACHELINESIZE . "CACHELINE_SIZE") ; + + ;;-- + (PROCESSORSTATE_TRANSPARE3 . "transpare3") + (PROCESSORSTATE_TRANSPARE2 . "transpare2") + (PROCESSORSTATE_TRANSPARE1 . "transpare1") + (PROCESSORSTATE_CARCDRSUBROUTINE . "carcdrsubroutine") + (PROCESSORSTATE_CDRSUBROUTINE . "cdrsubroutine") + (PROCESSORSTATE_CARSUBROUTINE . "carsubroutine") + (PROCESSORSTATE_LINKAGE . "linkage") + (PROCESSORSTATE_RESUMEEMA . "resumeema") + (PROCESSORSTATE_STATISTICS . "statistics") + (PROCESSORSTATE_TRACE_HOOK . "trace_hook") + (PROCESSORSTATE_INSTRUCTION_COUNT . "instruction_count") + (PROCESSORSTATE_LONG_PAD0 . "long_pad0") + (PROCESSORSTATE_ASRR9 . "asrr9") + (PROCESSORSTATE_ASRR10 . "asrr10") + (PROCESSORSTATE_ASRR11 . "asrr11") + (PROCESSORSTATE_ASRR12 . "asrr12") + (PROCESSORSTATE_ASRR13 . "asrr13") + (PROCESSORSTATE_ASRR14 . "asrr14") + (PROCESSORSTATE_ASRR15 . "asrr15") + (PROCESSORSTATE_LONG_PAD1 . "long_pad1") + (PROCESSORSTATE_ASRR26 . "asrr26") + (PROCESSORSTATE_ASRR27 . "asrr27") + (PROCESSORSTATE_ASRR29 . "asrr29") + (PROCESSORSTATE_ASRR30 . "asrr30") + (PROCESSORSTATE_ASRF2 . "asrf2") + (PROCESSORSTATE_ASRF3 . "asrf3") + (PROCESSORSTATE_ASRF4 . "asrf4") + (PROCESSORSTATE_ASRF5 . "asrf5") + (PROCESSORSTATE_ASRF6 . "asrf6") + (PROCESSORSTATE_ASRF7 . "asrf7") + (PROCESSORSTATE_ASRF8 . "asrf8") + (PROCESSORSTATE_ASRF9 . "asrf9") + (PROCESSORSTATE_METERDATABUFF . "meterdatabuff") + (PROCESSORSTATE_METERPOS . "meterpos") + (PROCESSORSTATE_METERMAX . "metermax") + (PROCESSORSTATE_METERFREQ . "meterfreq") + (PROCESSORSTATE_METERMASK . "metermask") + (PROCESSORSTATE_METERVALUE . "metervalue") + (PROCESSORSTATE_METERCOUNT . "metercount") + (PROCESSORSTATE_CHOICEPTR . "choiceptr") + (PROCESSORSTATE_SSTKCHOICEPTR . "sstkchoiceptr") + (PROCESSORSTATE_DBCBASE . "dbcbase") + (PROCESSORSTATE_DBCMASK . "dbcmask") + (PROCESSORSTATE_COPROCESSORREADHOOK . "coprocessorreadhook") + (PROCESSORSTATE_COPROCESSORWRITEHOOK . "coprocessorwritehook") + (PROCESSORSTATE_FLUSHCACHES_HOOK . "flushcaches_hook") + (PROCESSORSTATE_I_STAGE_ERROR_HOOK . "i_stage_error_hook") + (PROCESSORSTATE_SFP1 . "sfp1") + (PROCESSORSTATE_FP0 . "fp0") + (PROCESSORSTATE_FP1 . "fp1") + (PROCESSORSTATE_FLOATING_EXCEPTION . "floating_exception") + (PROCESSORSTATE_ALUANDROTATECONTROL . "aluandrotatecontrol") + (PROCESSORSTATE_ROTATELATCH . "rotatelatch") + (PROCESSORSTATE_ALUBORROW . "aluborrow") + (PROCESSORSTATE_ALUOVERFLOW . "aluoverflow") + (PROCESSORSTATE_ALULESSTHAN . "alulessthan") + (PROCESSORSTATE_ALUOP . "aluop") + (PROCESSORSTATE_BYTEROTATE . "byterotate") + (PROCESSORSTATE_BYTESIZE . "bytesize") + (PROCESSORSTATE_BINDINGSTACKLIMIT . "bindingstacklimit") + (PROCESSORSTATE_BINDINGSTACKPOINTER . "bindingstackpointer") + (PROCESSORSTATE_CATCHBLOCK . "catchblock") + (PROCESSORSTATE_EXTRAANDCATCH . "extraandcatch") + (PROCESSORSTATE_MSCLOCKCACHE . "msclockcache") + (PROCESSORSTATE_MSCMULTIPLIER . "mscmultiplier") + (PROCESSORSTATE_PREVIOUSRCPP . "previousrcpp") + (PROCESSORSTATE_RLINK . "rlink") + (PROCESSORSTATE_INTERRUPTREG . "interruptreg") + (PROCESSORSTATE_ZONEOLDSPACE . "zoneoldspace") + (PROCESSORSTATE_EPHEMERALOLDSPACE . "ephemeraloldspace") + (PROCESSORSTATE_INT_PAD0 . "int_pad0") + (PROCESSORSTATE_EQNOTEQL . "eqnoteql") + (PROCESSORSTATE_LCLENGTH . "lclength") + (PROCESSORSTATE_SCLENGTH . "sclength") + (PROCESSORSTATE_LCAREA . "lcarea") + (PROCESSORSTATE_LCADDRESS . "lcaddress") + (PROCESSORSTATE_SCAREA . "scarea") + (PROCESSORSTATE_SCADDRESS . "scaddress") + (PROCESSORSTATE_RESTARTSP . "restartsp") + (PROCESSORSTATE_STOP_INTERPRETER . "stop_interpreter") + (PROCESSORSTATE_IMMEDIATE_ARG . "immediate_arg") + (PROCESSORSTATE_CONTINUATIONCP . "continuationcp") + (PROCESSORSTATE_CONTINUATION . "continuation") + (PROCESSORSTATE_CONTROL . "control") + (PROCESSORSTATE_NILADDRESS . "niladdress") + (PROCESSORSTATE_TADDRESS . "taddress") + (PROCESSORSTATE_BAR0 . "bar0") + (PROCESSORSTATE_BAR1 . "bar1") + (PROCESSORSTATE_BAR2 . "bar2") + (PROCESSORSTATE_BAR3 . "bar3") + (PROCESSORSTATE_EPC . "epc") + (PROCESSORSTATE_FP . "fp") + (PROCESSORSTATE_LP . "lp") + (PROCESSORSTATE_SP . "sp") + (PROCESSORSTATE_CP . "cp") + (PROCESSORSTATE_FCCRMASK . "fccrmask") + (PROCESSORSTATE_CSLIMIT . "cslimit") + (PROCESSORSTATE_CSEXTRALIMIT . "csextralimit") + (PROCESSORSTATE_TRAPMETERDATA . "trapmeterdata") + (PROCESSORSTATE_FEPMODETRAPVECADDRESS . "fepmodetrapvecaddress") + (PROCESSORSTATE_TRAPVECBASE . "trapvecbase") + (PROCESSORSTATE_TVI . "tvi") + (PROCESSORSTATE_FCCRTRAPMASK . "fccrtrapmask") + (PROCESSORSTATE_PTRTYPE . "ptrtype") + (PROCESSORSTATE_VMATTRIBUTETABLE . "vmattributetable") + (PROCESSORSTATE_VMA . "vma") + (PROCESSORSTATE_MOSTNEGATIVEFIXNUM . "mostnegativefixnum") + (PROCESSORSTATE_ICACHEBASE . "icachebase") + (PROCESSORSTATE_ENDICACHE . "endicache") + (PROCESSORSTATE_FULLWORDDISPATCH . "fullworddispatch") + (PROCESSORSTATE_HALFWORDDISPATCH . "halfworddispatch") + (PROCESSORSTATE_AREVENTCOUNT . "areventcount") + (PROCESSORSTATE_STACKCACHESIZE . "stackcachesize") + (PROCESSORSTATE_STACKCACHETOPVMA . "stackcachetopvma") + (PROCESSORSTATE_CDRCODEMASK . "cdrcodemask") + (PROCESSORSTATE_STACKCACHEDATA . "stackcachedata") + (PROCESSORSTATE_STACKCACHEBASEVMA . "stackcachebasevma") + (PROCESSORSTATE_SCOVLIMIT . "scovlimit") + (PROCESSORSTATE_SCOVDUMPCOUNT . "scovdumpcount") + (PROCESSORSTATE_MOSTPOSITIVEFIXNUM . "mostpositivefixnum") + (PROCESSORSTATE_INTERNALREGISTERREAD1 . "internalregisterread1") + (PROCESSORSTATE_INTERNALREGISTERREAD2 . "internalregisterread2") + (PROCESSORSTATE_INTERNALREGISTERWRITE1 . "internalregisterwrite1") + (PROCESSORSTATE_INTERNALREGISTERWRITE2 . "internalregisterwrite2") + (PROCESSORSTATE_DATAREAD_MASK . "dataread_mask") + (PROCESSORSTATE_DATAREAD . "dataread") + (PROCESSORSTATE_DATAWRITE_MASK . "datawrite_mask") + (PROCESSORSTATE_DATAWRITE . "datawrite") + (PROCESSORSTATE_BINDREAD_MASK . "bindread_mask") + (PROCESSORSTATE_BINDREAD . "bindread") + (PROCESSORSTATE_BINDWRITE_MASK . "bindwrite_mask") + (PROCESSORSTATE_BINDWRITE . "bindwrite") + (PROCESSORSTATE_BINDREADNOMONITOR_MASK . "bindreadnomonitor_mask") + (PROCESSORSTATE_BINDREADNOMONITOR . "bindreadnomonitor") + (PROCESSORSTATE_BINDWRITENOMONITOR_MASK . "bindwritenomonitor_mask") + (PROCESSORSTATE_BINDWRITENOMONITOR . "bindwritenomonitor") + (PROCESSORSTATE_HEADER_MASK . "header_mask") + (PROCESSORSTATE_HEADER . "header") + (PROCESSORSTATE_STRUCTUREOFFSET_MASK . "structureoffset_mask") + (PROCESSORSTATE_STRUCTUREOFFSET . "structureoffset") + (PROCESSORSTATE_SCAVENGE_MASK . "scavenge_mask") + (PROCESSORSTATE_SCAVENGE . "scavenge") + (PROCESSORSTATE_CDR_MASK . "cdr_mask") + (PROCESSORSTATE_CDR . "cdr") + (PROCESSORSTATE_GCCOPY_MASK . "gccopy_mask") + (PROCESSORSTATE_GCCOPY . "gccopy") + (PROCESSORSTATE_RAW_MASK . "raw_mask") + (PROCESSORSTATE_RAW . "raw") + (PROCESSORSTATE_RAWTRANSLATE_MASK . "rawtranslate_mask") + (PROCESSORSTATE_RAWTRANSLATE . "rawtranslate") + (PROCESSORSTATE_PLEASE_STOP . "please_stop") + (PROCESSORSTATE_PLEASE_TRAP . "please_trap") + (PROCESSORSTATE_RUNNINGP . "runningp") + (PROCESSORSTATE_AC0ARRAY . "ac0array") + (PROCESSORSTATE_AC0ARWORD . "ac0arword") + (PROCESSORSTATE_AC0LOCAT . "ac0locat") + (PROCESSORSTATE_AC0LENGTH . "ac0length") + (PROCESSORSTATE_AC1ARRAY . "ac1array") + (PROCESSORSTATE_AC1ARWORD . "ac1arword") + (PROCESSORSTATE_AC1LOCAT . "ac1locat") + (PROCESSORSTATE_AC1LENGTH . "ac1length") + (PROCESSORSTATE_AC2ARRAY . "ac2array") + (PROCESSORSTATE_AC2ARWORD . "ac2arword") + (PROCESSORSTATE_AC2LOCAT . "ac2locat") + (PROCESSORSTATE_AC2LENGTH . "ac2length") + (PROCESSORSTATE_AC3ARRAY . "ac3array") + (PROCESSORSTATE_AC3ARWORD . "ac3arword") + (PROCESSORSTATE_AC3LOCAT . "ac3locat") + (PROCESSORSTATE_AC3LENGTH . "ac3length") + (PROCESSORSTATE_AC4ARRAY . "ac4array") + (PROCESSORSTATE_AC4ARWORD . "ac4arword") + (PROCESSORSTATE_AC4LOCAT . "ac4locat") + (PROCESSORSTATE_AC4LENGTH . "ac4length") + (PROCESSORSTATE_AC5ARRAY . "ac5array") + (PROCESSORSTATE_AC5ARWORD . "ac5arword") + (PROCESSORSTATE_AC5LOCAT . "ac5locat") + (PROCESSORSTATE_AC5LENGTH . "ac5length") + (PROCESSORSTATE_AC6ARRAY . "ac6array") + (PROCESSORSTATE_AC6ARWORD . "ac6arword") + (PROCESSORSTATE_AC6LOCAT . "ac6locat") + (PROCESSORSTATE_AC6LENGTH . "ac6length") + (PROCESSORSTATE_AC7ARRAY . "ac7array") + (PROCESSORSTATE_AC7ARWORD . "ac7arword") + (PROCESSORSTATE_AC7LOCAT . "ac7locat") + (PROCESSORSTATE_AC7LENGTH . "ac7length") + (PROCESSORSTATE_TMCURRENTTRANSACTION . "tmcurrenttransaction") + (PROCESSORSTATE_TMWRITESTART . "tmwritestart") + (PROCESSORSTATE_TMWRITECURRENT . "tmwritecurrent") + (PROCESSORSTATE_TMWRITELIMIT . "tmwritelimit") + (PROCESSORSTATE_TMRECORDINGREADS . "tmrecordingreads") + (PROCESSORSTATE_TMREADSTART . "tmreadstart") + (PROCESSORSTATE_TMREADCURRENT . "tmreadcurrent") + (PROCESSORSTATE_TMREADLIMIT . "tmreadlimit") + ;;-- + + (|Opcode_DoubleFloatOp| . "Opcode_DoubleFloatOp") + (arraycache_array . "array") + (arraycache_arword . "arword") + (arraycache_locat . "locat") + (arraycache_length . "length") + + (CACHELINERSHIFT . "CacheLine_RShift") + (CACHELINELSHIFT . "CacheLine_LShift") + + (|CacheLineRShift| . "CacheLine_RShift") + (|CacheLineLShift| . "CacheLine_LShift") + + ("CacheLineRShift" . "CacheLine_RShift") + ("CacheLineLShift" . "CacheLine_LShift") + + (|MemoryActionIndirect| . "MemoryActionIndirect") + (|MemoryActionMonitor| . "MemoryActionMonitor") + (|MemoryActionTransport| . "MemoryActionTransport") + (|MemoryActionTrap| . "MemoryActionTrap") + (|MemoryActionTransform| . "MemoryActionTransform") + (|MemoryActionBinding| . "MemoryActionBinding") + + (|MemoryPageSize| . "MemoryPage_Size") + (|MemoryPageAddressShift| . "MemoryPage_AddressShift") + + (|VMAttributeAccessFault| . "VMAttribute_AccessFault") + (|VMAttributeWriteFault| . "VMAttribute_WriteFault") + (|VMAttributeTransportFault| . "VMAttribute_TransportFault") + (|VMAttributeTransportDisable| . "VMAttribute_TransportDisable") + (|VMAttributeEphemeral| . "VMAttribute_Ephemeral") + (|VMAttributeModified| . "VMAttribute_Modified") + (|VMAttributeExists| . "VMAttribute_Exists") + (|VMAttributeCreatedDefault| . "VMAttribute_CreatedDefault") + + + (twocachelinesize . "TWOCACHELINESIZE") + (fourcachelinesize . "FOURCACHELINESIZE") + + ;;-- + (|TypeNull| . "Type_Null") + (|TypeMonitorForward| . "Type_MonitorForward") + (|TypeHeaderP| . "Type_HeaderP") + (|TypeHeaderI| . "Type_HeaderI") + (|TypeExternalValueCellPointer| . "Type_ExternalValueCellPointer") + (|TypeOneQForward| . "Type_OneQForward") + (|TypeHeaderForward| . "Type_HeaderForward") + (|TypeElementForward| . "Type_ElementForward") + (|TypeFixnum| . "Type_Fixnum") + (|TypeSmallRatio| . "Type_SmallRatio") + (|TypeSingleFloat| . "Type_SingleFloat") + (|TypeDoubleFloat| . "Type_DoubleFloat") + (|TypeBignum| . "Type_Bignum") + (|TypeBigRatio| . "Type_BigRatio") + (|TypeComplex| . "Type_Complex") + (|TypeSpareNumber| . "Type_SpareNumber") + (|TypeInstance| . "Type_Instance") + (|TypeListInstance| . "Type_ListInstance") + (|TypeArrayInstance| . "Type_ArrayInstance") + (|TypeStringInstance| . "Type_StringInstance") + (|TypeNIL| . "Type_NIL") + (|TypeList| . "Type_List") + (|TypeArray| . "Type_Array") + (|TypeString| . "Type_String") + (|TypeSymbol| . "Type_Symbol") + (|TypeLocative| . "Type_Locative") + (|TypeLexicalClosure| . "Type_LexicalClosure") + (|TypeDynamicClosure| . "Type_DynamicClosure") + (|TypeCompiledFunction| . "Type_CompiledFunction") + (|TypeGenericFunction| . "Type_GenericFunction") + (|TypeSparePointer1| . "Type_SparePointer1") + (|TypeSparePointer2| . "Type_SparePointer2") + (|TypePhysicalAddress| . "Type_PhysicalAddress") + (|TypeNativeInstruction| . "Type_NativeInstruction") + (|TypeBoundLocation| . "Type_BoundLocation") + (|TypeCharacter| . "Type_Character") + (|TypeLogicVariable| . "Type_LogicVariable") + (|TypeGCForward| . "Type_GCForward") + (|TypeEvenPC| . "Type_EvenPC") + (|TypeOddPC| . "Type_OddPC") + (|TypeCallCompiledEven| . "Type_CallCompiledEven") + (|TypeCallCompiledOdd| . "Type_CallCompiledOdd") + (|TypeCallIndirect| . "Type_CallIndirect") + (|TypeCallGeneric| . "Type_CallGeneric") + (|TypeCallCompiledEvenPrefetch| . "Type_CallCompiledEvenPrefetch") + (|TypeCallCompiledOddPrefetch| . "Type_CallCompiledOddPrefetch") + (|TypeCallIndirectPrefetch| . "Type_CallIndirectPrefetch") + (|TypeCallGenericPrefetch| . "Type_CallGenericPrefetch") + (|TypePackedInstruction60| . "Type_PackedInstruction60") + (|TypeTypePackedInstruction61| . "Type_TypePackedInstruction61") + (|TypeTypePackedInstruction62| . "Type_TypePackedInstruction62") + (|TypePackedInstruction63| . "Type_PackedInstruction63") + (|TypeTypePackedInstruction64| . "Type_TypePackedInstruction64") + (|TypeTypePackedInstruction65| . "Type_TypePackedInstruction65") + (|TypePackedInstruction66| . "Type_PackedInstruction66") + (|TypeTypePackedInstruction67| . "Type_TypePackedInstruction67") + (|TypeTypePackedInstruction70| . "Type_TypePackedInstruction70") + (|TypePackedInstruction71| . "Type_PackedInstruction71") + (|TypeTypePackedInstruction72| . "Type_TypePackedInstruction72") + (|TypeTypePackedInstruction73| . "Type_TypePackedInstruction73") + (|TypePackedInstruction74| . "Type_PackedInstruction74") + (|TypeTypePackedInstruction75| . "Type_TypePackedInstruction75") + (|TypeTypePackedInstruction76| . "Type_TypePackedInstruction76") + (|TypePackedInstruction77| . "Type_PackedInstruction77") + ;;-- + + (|ArrayElementTypeFixnum| . "Array_ElementTypeFixnum") + (|ArrayElementTypeCharacter| . "Array_ElementTypeCharacter") + (|ArrayElementTypeBoolean| . "Array_ElementTypeBoolean") + (|ArrayElementTypeObject| . "Array_ElementTypeObject") + (|ArrayTypeFieldPos| . "Array_TypeFieldPos") + (|ArrayTypeFieldSize| . "Array_TypeFieldSize") + (|ArrayTypeFieldMask| . "Array_TypeFieldMask") + (|ArrayElementTypePos| . "Array_ElementTypePos") + (|ArrayElementTypeSize| . "Array_ElementTypeSize") + (|ArrayElementTypeMask| . "Array_ElementTypeMask") + (|ArrayBytePackingPos| . "Array_BytePackingPos") + (|ArrayBytePackingSize| . "Array_BytePackingSize") + (|ArrayBytePackingMask| . "Array_BytePackingMask") + (|ArrayListBitPos| . "Array_ListBitPos") + (|ArrayListBitSize| . "Array_ListBitSize") + (|ArrayListBitMask| . "Array_ListBitMask") + (|ArrayNamedStructureBitPos| . "Array_NamedStructureBitPos") + (|ArrayNamedStructureBitSize| . "Array_NamedStructureBitSize") + (|ArrayNamedStructureBitMask| . "Array_NamedStructureBitMask") + (|ArraySpare1Pos| . "Array_Spare1Pos") + (|ArraySpare1Size| . "Array_Spare1Size") + (|ArraySpare1Mask| . "Array_Spare1Mask") + (|ArrayLongPrefixBitPos| . "Array_LongPrefixBitPos") + (|ArrayLongPrefixBitSize| . "Array_LongPrefixBitSize") + (|ArrayLongPrefixBitMask| . "Array_LongPrefixBitMask") + (|ArrayLeaderLengthFieldPos| . "Array_LeaderLengthFieldPos") + (|ArrayLeaderLengthFieldSize| . "Array_LeaderLengthFieldSize") + (|ArrayLeaderLengthFieldMask| . "Array_LeaderLengthFieldMask") + (|ArrayLengthPos| . "Array_LengthPos") + (|ArrayLengthSize| . "Array_LengthSize") + (|ArrayLengthMask| . "Array_LengthMask") + (|ArrayDisplacedBitPos| . "Array_DisplacedBitPos") + (|ArrayDisplacedBitSize| . "Array_DisplacedBitSize") + (|ArrayDisplacedBitMask| . "Array_DisplacedBitMask") + (|ArrayDiscontiguousBitPos| . "Array_DiscontiguousBitPos") + (|ArrayDiscontinuousBitSize| . "Array_DiscontinuousBitSize") + (|ArrayDiscontiguousBitMask| . "Array_DiscontiguousBitMask") + (|ArrayLongSparePos| . "Array_LongSparePos") + (|ArrayLongSpareSize| . "Array_LongSpareSize") + (|ArrayLongSpareMask| . "Array_LongSpareMask") + (|ArrayLongDimensionsFieldPos| . "Array_LongDimensionsFieldPos") + (|ArrayLongDimensionsFieldSize| . "Array_LongDimensionsFieldSize") + (|ArrayLongDimensionsFieldMask| . "Array_LongDimensionsFieldMask") + (|ArrayRegisterElementTypePos| . "Array_RegisterElementTypePos") + (|ArrayRegisterElementTypeSize| . "Array_RegisterElementTypeSize") + (|ArrayRegisterElementTypeMask| . "Array_RegisterElementTypeMask") + (|ArrayRegisterBytePackingPos| . "Array_RegisterBytePackingPos") + (|ArrayRegisterBytePackingSize| . "Array_RegisterBytePackingSize") + (|ArrayRegisterBytePackingMask| . "Array_RegisterBytePackingMask") + (|ArrayRegisterByteOffsetPos| . "Array_RegisterByteOffsetPos") + (|ArrayRegisterByteOffsetSize| . "Array_RegisterByteOffsetSize") + (|ArrayRegisterByteOffsetMask| . "Array_RegisterByteOffsetMask") + (|ArrayRegisterEventCountPos| . "Array_RegisterEventCountPos") + (|ArrayRegisterEventCountSize| . "Array_RegisterEventCountSize") + (|ArrayRegisterEventCountMask| . "Array_RegisterEventCountMask") + + (|AutoArrayRegMask| . "AutoArrayRegMask") + (|AutoArrayRegSize| . "AutoArrayRegSize") + (|AutoArrayRegShift| . "AutoArrayRegShift") + + (|CdrNext| . "Cdr_Next") + (|CdrNil| . "Cdr_Nil") + (|CdrNormal| . "Cdr_Normal") + + (|ReturnValueNormal| . "ReturnValue_Normal") + (|ReturnValueException| . "ReturnValue_Exception") + (|ReturnValueIllegalOperand| . "ReturnValue_IllegalOperand") + + (|ALUFunctionBoolean| . "ALUFunction_Boolean") + (|ALUFunctionByte| . "ALUFunction_Byte") + (|ALUFunctionAdder| . "ALUFunction_Adder") + (|ALUFunctionMultiplyDivide| . "ALUFunction_MultiplyDivide") + + (|ALUConditionSignedLessThanOrEqual| . "ALUCondition_SignedLessThanOrEqual") + (|ALUConditionSignedLessThan| . "ALUCondition_SignedLessThan") + (|ALUConditionNegative| . "ALUCondition_Negative") + (|ALUConditionSignedOverflow| . "ALUCondition_SignedOverflow") + (|ALUConditionUnsignedLessThanOrEqual| . "ALUCondition_UnsignedLessThanOrEqual") + (|ALUConditionUnsignedLessThan| . "ALUCondition_UnsignedLessThan") + (|ALUConditionZero| . "ALUCondition_Zero") + (|ALUConditionHigh25Zero| . "ALUCondition_High25Zero") + (|ALUConditionEq| . "ALUCondition_Eq") + (|ALUConditionOp1Ephemeralp| . "ALUCondition_Op1Ephemeralp") + (|ALUConditionOp1TypeAcceptable| . "ALUCondition_Op1TypeAcceptable") + (|ALUConditionOp1TypeCondition| . "ALUCondition_Op1TypeCondition") + (|ALUConditionResultTypeNil| . "ALUCondition_ResultTypeNil") + (|ALUConditionOp2Fixnum| . "ALUCondition_Op2Fixnum") + (|ALUConditionFalse| . "ALUCondition_False") + (|ALUConditionResultCdrLow| . "ALUCondition_ResultCdrLow") + (|ALUConditionCleanupBitsSet| . "ALUCondition_CleanupBitsSet") + (|ALUConditionAddressInStackCache| . "ALUCondition_AddressInStackCache") + (|ALUConditionPendingSequenceBreakEnabled| . "ALUCondition_PendingSequenceBreakEnabled") + (|ALUConditionExtraStackMode| . "ALUCondition_ExtraStackMode") + (|ALUConditionFepMode| . "ALUCondition_FepMode") + (|ALUConditionFpCoprocessorPresent| . "ALUCondition_FpCoprocessorPresent") + (|ALUConditionOp1Oldspacep| . "ALUCondition_Op1Oldspacep") + (|ALUConditionStackCacheOverflow| . "ALUCondition_StackCacheOverflow") + (|ALUConditionOrLogicVariable| . "ALUCondition_OrLogicVariable") + (|ALUAdderOp2Op2| . "ALUAdderOp2_Op2") + (|ALUAdderOp2Zero| . "ALUAdderOp2_Zero") + (|ALUAdderOp2Invert| . "ALUAdderOp2_Invert") + (|ALUAdderOp2MinusOne| . "ALUAdderOp2_MinusOne") + (|ALUByteFunctionDpb| . "ALUByteFunction_Dpb") + (|ALUByteFunctionLdb| . "ALUByteFunction_Ldb") + (|ALUByteBackgroundOp1| . "ALUByteBackground_Op1") + (|ALUByteBackgroundRotateLatch| . "ALUByteBackground_RotateLatch") + (|ALUByteBackgroundZero| . "ALUByteBackground_Zero") + + (|BooleClear| . "Boole_Clear") + (|BooleAnd| . "Boole_And") + (|BooleAndC1| . "Boole_AndC1") + (|Boole2| . "Boole_2") + (|BooleAndC2| . "Boole_AndC2") + (|Boole1| . "Boole_1") + (|BooleXor| . "Boole_Xor") + (|BooleIor| . "Boole_Ior") + (|BooleNor| . "Boole_Nor") + (|BooleEquiv| . "Boole_Equiv") + (|BooleC1| . "Boole_C1") + (|BooleOrC1| . "Boole_OrC1") + (|BooleC2| . "Boole_C2") + (|BooleOrC2| . "Boole_OrC2") + (|BooleNand| . "Boole_Nand") + (|BooleSet| . "Boole_Set") + + (|CoprocessorRegisterUnwindStackForRestartOrApply| . "CoprocessorRegister_UnwindStackForRestartOrApply") + (|CoprocessorRegisterFlushIDCaches| . "CoprocessorRegister_FlushIDCaches") + (|CoprocessorRegisterFlushCachesForVMA| . "CoprocessorRegister_FlushCachesForVMA") + (|CoprocessorRegisterFlushHiddenArrayRegisters| . "CoprocessorRegister_FlushHiddenArrayRegisters") + + (|CycleDataRead| . "Cycle_DataRead") + (|CycleDataWrite| . "Cycle_DataWrite") + (|CycleBindRead| . "Cycle_BindRead") + (|CycleBindWrite| . "Cycle_BindWrite") + (|CycleBindReadNoMonitor| . "Cycle_BindReadNoMonitor") + (|CycleBindWriteNoMonitor| . "Cycle_BindWriteNoMonitor") + (|CycleHeader| . "Cycle_Header") + (|CycleStructureOffset| . "Cycle_StructureOffset") + (|CycleScavenge| . "Cycle_Scavenge") + (|CycleCdr| . "Cycle_Cdr") + (|CycleGCCopy| . "Cycle_GCCopy") + (|CycleRaw| . "Cycle_Raw") + (|CycleRawTranslate| . "Cycle_RawTranslate") + + (|TrapVectorArithmeticInstructionException| . "TrapVector_ArithmeticInstructionException") + (|TrapVectorStackOverflow| . "TrapVector_StackOverflow") + (|TrapVectorInstructionException| . "TrapVector_InstructionException") + (|TrapVectorError| . "TrapVector_Error") + (|TrapVectorReset| . "TrapVector_Reset") + (|TrapVectorPullApplyArgs| . "TrapVector_PullApplyArgs") + (|TrapVectorTrace| . "TrapVector_Trace") + (|TrapVectorPreemptRequest| . "TrapVector_PreemptRequest") + (|TrapVectorLowPrioritySequenceBreak| . "TrapVector_LowPrioritySequenceBreak") + (|TrapVectorHighPrioritySequenceBreak| . "TrapVector_HighPrioritySequenceBreak") + (|TrapVectorDBUnwindFrame| . "TrapVector_DBUnwindFrame") + (|TrapVectorDBUnwindCatch| . "TrapVector_DBUnwindCatch") + (|TrapVectorTransport| . "TrapVector_Transport") + (|TrapVectorMonitor| . "TrapVector_Monitor") + (|TrapVectorPageNotResident| . "TrapVector_PageNotResident") + (|TrapVectorPageFaultRequest| . "TrapVector_PageFaultRequest") + (|TrapVectorPageWriteFault| . "TrapVector_PageWriteFault") + (|TrapVectorUncorrectableMemoryError| . "TrapVector_UncorrectableMemoryError") + (|TrapVectorMemoryBusError| . "TrapVector_MemoryBusError") + + (|ValueDispositionEffect| . "ValueDisposition_Effect") + (|ValueDispositionValue| . "ValueDisposition_Value") + (|ValueDispositionReturn| . "ValueDisposition_Return") + (|ValueDispositionMultiple| . "ValueDisposition_Multiple") + + (|TrapReasonHighPrioritySequenceBreak| . "TrapReason_HighPrioritySequenceBreak") + (|TrapReasonLowPrioritySequenceBreak| . "TrapReason_LowPrioritySequenceBreak") + + (|TrapModeEmulator| . "TrapMode_Emulator") + (|TrapModeExtraStack| . "TrapMode_ExtraStack") + (|TrapModeIO| . "TrapMode_IO") + (|TrapModeFEP| . "TrapMode_FEP") + + (|HaltReasonIllInstn| . "HaltReason_IllInstn") + (|HaltReasonHalted| . "HaltReason_Halted") + (|HaltReasonSpyCalled| . "HaltReason_SpyCalled") + (|HaltReasonFatalStackOverflow| . "HaltReason_FatalStackOverflow") + (|HaltReasonIllegalTrapVector| . "HaltReason_IllegalTrapVector") + + (|DoubleFloatOpAdd| . "DoubleFloatOp_Add") + (|DoubleFloatOpSub| . "DoubleFloatOp_Sub") + (|DoubleFloatOpMultiply| . "DoubleFloatOp_Multiply") + (|DoubleFloatOpDivide| . "DoubleFloatOp_Divide") + + )))) + +; +(defun isconstant (sym) + (member sym + '(|TypeEvenPC| + |TrapVectorArithmeticInstructionException| + |TrapVectorStackOverflow| + |TrapVectorInstructionException| + |TrapVectorError| + |TrapVectorReset| + |TrapVectorPullApplyArgs| + |TrapVectorTrace| + |TrapVectorPreemptRequest| + |TrapVectorLowPrioritySequenceBreak| + |TrapVectorHighPrioritySequenceBreak| + |TrapVectorDBUnwindFrame| + |TrapVectorDBUnwindCatch| + |TrapVectorTransport| + |TrapVectorMonitor| + |TrapVectorPageNotResident| + |TrapVectorPageFaultRequest| + |TrapVectorPageWriteFault| + |TrapVectorUncorrectableMemoryError| + |TrapVectorMemoryBusError| + |ValueDispositionEffect| + |ValueDispositionValue| + |ValueDispositionReturn| + |ValueDispositionMultiple| + ))) + +;; (cond +;; ((eq sym '|TypeEvenPC|) t) +;; (t nil))) + +; return list of strings separated by char +(defun split-by-one-char (string char) + (loop for i = 0 then (1+ j) + as j = (position char string :start i) + collect (subseq string i j) + while j)) + +; return list of strings separated by "+" +(defun split-by-one-plus (string) + (split-by-one-char string #\+)) + +; return list of strings separated by " " +(defun split-by-one-space (string) + (split-by-one-char string #\Space)) + +; return list of strings separated by "*" +(defun split-by-one-star (string) + (split-by-one-char string #\*)) + +(defun fixarg (str) +; (format t "fixarg: str ~S~%" str) + (let ((sym-name (if (symbolp str) (symbol-name str) nil))) + (if (search "+" sym-name) + ;; handle case of xxx+4 + (let* ((split-list (split-by-one-plus sym-name)) + (fixed-arg (fixarg (intern (car split-list)))) + (last-part (car (cdr split-list)))) + (setq str (concatenate 'string fixed-arg "+" last-part)) +;; (format t "fixarg+: a=~S b=~S result ~S~%" fixed-arg last-part str) + ) + (if (search "*" sym-name) + ;; handle case of xxx*4 + (let* ((split-list (split-by-one-star sym-name)) + (fixed-arg (fixarg (intern (car split-list)))) + (last-part (car (cdr split-list)))) + (setq str (concatenate 'string fixed-arg "*" last-part)) +;; (format t "fixarg+: a=~S b=~S result ~S~%" fixed-arg last-part str) + ) + ;; normal case + (let ((new (remap-arg str))) + (if new new + (if (numberp str) str + (string-downcase str)))))))) + +(defun regnum (arg) + (subseq arg 1 2)) + +; return t if string is not a number +(defun notnumber (str) + (let ((d0 (char-code #\0)) + (d9 (char-code #\9))) + (some + #'(lambda (c) (let ((cc (char-code c))) (or (< cc d0) (> cc d9)))) + str))) + +;; return (ptr member offset) +(defun decompose-args (arg1 arg2) + (let ((arg2-name (if (symbolp arg2) (symbol-name arg2) arg2))) + (if (not (search "+" arg2-name)) + (values (structptr arg1 arg2) arg2 0) + ;; handle case of xxx+4 + (let* ((split-list (split-by-one-plus arg2-name)) + (real-arg2 (intern (car split-list))) + (fixed-arg2 (fixarg real-arg2)) + (offsetlast-part (car (cdr split-list))) + (ptr (structptr arg1 real-arg2)) + (offset (if (notnumber offsetlast-part) + offsetlast-part (parse-integer offsetlast-part)))) + (values ptr fixed-arg2 offset))))) + + +; severe hackery +(defun is-cachep-member (smember) + (member smember + '(cacheline_annotation cacheline_nextpdata cacheline_nextptag + cacheline_nextcp cacheline_instruction + cacheline_operand cacheline_pcdata + cacheline_pctag cacheline_code))) + +(defun is-cachep-ptr (str) + (or (eq str 'ocp) (eq str 'ecp) (eq str 'iCP) (equal str "iCP"))) + +(defun cacheline-ptr-str (ptr) + (if (or (eq ptr 'iCP) (equal ptr "iCP")) + "iCP" + (string-downcase ptr))) + +(defun needs-cacheline-cast (ptr member) +; (format t "needs-cacheline-cast: ptr ~S member ~S~%" ptr member) + (or + (is-cachep-ptr ptr) + (is-cachep-member member))) + +(defun is-arrachcachep-member (amember) + (member amember + '(arraycache_array + arraycache_arword arraycache_locat arraycache_length))) + +(defun needs-arraycache-cast (ptr member) + (is-arrachcachep-member member)) + +(defun is-processorstatep-member (pmember) + (member pmember + '( + ;;-- + PROCESSORSTATE_TRANSPARE3 + PROCESSORSTATE_TRANSPARE2 + PROCESSORSTATE_TRANSPARE1 + PROCESSORSTATE_CARCDRSUBROUTINE + PROCESSORSTATE_CDRSUBROUTINE + PROCESSORSTATE_CARSUBROUTINE + PROCESSORSTATE_LINKAGE + PROCESSORSTATE_RESUMEEMA + PROCESSORSTATE_STATISTICS + PROCESSORSTATE_TRACE_HOOK + PROCESSORSTATE_INSTRUCTION_COUNT + PROCESSORSTATE_LONG_PAD0 + PROCESSORSTATE_ASRR9 + PROCESSORSTATE_ASRR10 + PROCESSORSTATE_ASRR11 + PROCESSORSTATE_ASRR12 + PROCESSORSTATE_ASRR13 + PROCESSORSTATE_ASRR14 + PROCESSORSTATE_ASRR15 + PROCESSORSTATE_LONG_PAD1 + PROCESSORSTATE_ASRR26 + PROCESSORSTATE_ASRR27 + PROCESSORSTATE_ASRR29 + PROCESSORSTATE_ASRR30 + PROCESSORSTATE_ASRF2 + PROCESSORSTATE_ASRF3 + PROCESSORSTATE_ASRF4 + PROCESSORSTATE_ASRF5 + PROCESSORSTATE_ASRF6 + PROCESSORSTATE_ASRF7 + PROCESSORSTATE_ASRF8 + PROCESSORSTATE_ASRF9 + PROCESSORSTATE_METERDATABUFF + PROCESSORSTATE_METERPOS + PROCESSORSTATE_METERMAX + PROCESSORSTATE_METERFREQ + PROCESSORSTATE_METERMASK + PROCESSORSTATE_METERVALUE + PROCESSORSTATE_METERCOUNT + PROCESSORSTATE_CHOICEPTR + PROCESSORSTATE_SSTKCHOICEPTR + PROCESSORSTATE_DBCBASE + PROCESSORSTATE_DBCMASK + PROCESSORSTATE_COPROCESSORREADHOOK + PROCESSORSTATE_COPROCESSORWRITEHOOK + PROCESSORSTATE_FLUSHCACHES_HOOK + PROCESSORSTATE_I_STAGE_ERROR_HOOK + PROCESSORSTATE_SFP1 + PROCESSORSTATE_FP0 + PROCESSORSTATE_FP1 + PROCESSORSTATE_FLOATING_EXCEPTION + PROCESSORSTATE_ALUANDROTATECONTROL + PROCESSORSTATE_ROTATELATCH + PROCESSORSTATE_ALUBORROW + PROCESSORSTATE_ALUOVERFLOW + PROCESSORSTATE_ALULESSTHAN + PROCESSORSTATE_ALUOP + PROCESSORSTATE_BYTEROTATE + PROCESSORSTATE_BYTESIZE + PROCESSORSTATE_BINDINGSTACKLIMIT + PROCESSORSTATE_BINDINGSTACKPOINTER + PROCESSORSTATE_CATCHBLOCK + PROCESSORSTATE_EXTRAANDCATCH + PROCESSORSTATE_MSCLOCKCACHE + PROCESSORSTATE_MSCMULTIPLIER + PROCESSORSTATE_PREVIOUSRCPP + PROCESSORSTATE_RLINK + PROCESSORSTATE_INTERRUPTREG + PROCESSORSTATE_ZONEOLDSPACE + PROCESSORSTATE_EPHEMERALOLDSPACE + PROCESSORSTATE_INT_PAD0 + PROCESSORSTATE_EQNOTEQL + PROCESSORSTATE_LCLENGTH + PROCESSORSTATE_SCLENGTH + PROCESSORSTATE_LCAREA + PROCESSORSTATE_LCADDRESS + PROCESSORSTATE_SCAREA + PROCESSORSTATE_SCADDRESS + PROCESSORSTATE_RESTARTSP + PROCESSORSTATE_STOP_INTERPRETER + PROCESSORSTATE_IMMEDIATE_ARG + PROCESSORSTATE_CONTINUATIONCP + PROCESSORSTATE_CONTINUATION + PROCESSORSTATE_CONTROL + PROCESSORSTATE_NILADDRESS + PROCESSORSTATE_TADDRESS + PROCESSORSTATE_BAR0 + PROCESSORSTATE_BAR1 + PROCESSORSTATE_BAR2 + PROCESSORSTATE_BAR3 + PROCESSORSTATE_EPC + PROCESSORSTATE_FP + PROCESSORSTATE_LP + PROCESSORSTATE_SP + PROCESSORSTATE_CP + PROCESSORSTATE_FCCRMASK + PROCESSORSTATE_CSLIMIT + PROCESSORSTATE_CSEXTRALIMIT + PROCESSORSTATE_TRAPMETERDATA + PROCESSORSTATE_FEPMODETRAPVECADDRESS + PROCESSORSTATE_TRAPVECBASE + PROCESSORSTATE_TVI + PROCESSORSTATE_FCCRTRAPMASK + PROCESSORSTATE_PTRTYPE + PROCESSORSTATE_VMATTRIBUTETABLE + PROCESSORSTATE_VMA + PROCESSORSTATE_MOSTNEGATIVEFIXNUM + PROCESSORSTATE_ICACHEBASE + PROCESSORSTATE_ENDICACHE + PROCESSORSTATE_FULLWORDDISPATCH + PROCESSORSTATE_HALFWORDDISPATCH + PROCESSORSTATE_AREVENTCOUNT + PROCESSORSTATE_STACKCACHESIZE + PROCESSORSTATE_STACKCACHETOPVMA + PROCESSORSTATE_CDRCODEMASK + PROCESSORSTATE_STACKCACHEDATA + PROCESSORSTATE_STACKCACHEBASEVMA + PROCESSORSTATE_SCOVLIMIT + PROCESSORSTATE_SCOVDUMPCOUNT + PROCESSORSTATE_MOSTPOSITIVEFIXNUM + PROCESSORSTATE_INTERNALREGISTERREAD1 + PROCESSORSTATE_INTERNALREGISTERREAD2 + PROCESSORSTATE_INTERNALREGISTERWRITE1 + PROCESSORSTATE_INTERNALREGISTERWRITE2 + PROCESSORSTATE_DATAREAD_MASK + PROCESSORSTATE_DATAREAD + PROCESSORSTATE_DATAWRITE_MASK + PROCESSORSTATE_DATAWRITE + PROCESSORSTATE_BINDREAD_MASK + PROCESSORSTATE_BINDREAD + PROCESSORSTATE_BINDWRITE_MASK + PROCESSORSTATE_BINDWRITE + PROCESSORSTATE_BINDREADNOMONITOR_MASK + PROCESSORSTATE_BINDREADNOMONITOR + PROCESSORSTATE_BINDWRITENOMONITOR_MASK + PROCESSORSTATE_BINDWRITENOMONITOR + PROCESSORSTATE_HEADER_MASK + PROCESSORSTATE_HEADER + PROCESSORSTATE_STRUCTUREOFFSET_MASK + PROCESSORSTATE_STRUCTUREOFFSET + PROCESSORSTATE_SCAVENGE_MASK + PROCESSORSTATE_SCAVENGE + PROCESSORSTATE_CDR_MASK + PROCESSORSTATE_CDR + PROCESSORSTATE_GCCOPY_MASK + PROCESSORSTATE_GCCOPY + PROCESSORSTATE_RAW_MASK + PROCESSORSTATE_RAW + PROCESSORSTATE_RAWTRANSLATE_MASK + PROCESSORSTATE_RAWTRANSLATE + PROCESSORSTATE_PLEASE_STOP + PROCESSORSTATE_PLEASE_TRAP + PROCESSORSTATE_RUNNINGP + PROCESSORSTATE_AC0ARRAY + PROCESSORSTATE_AC0ARWORD + PROCESSORSTATE_AC0LOCAT + PROCESSORSTATE_AC0LENGTH + PROCESSORSTATE_AC1ARRAY + PROCESSORSTATE_AC1ARWORD + PROCESSORSTATE_AC1LOCAT + PROCESSORSTATE_AC1LENGTH + PROCESSORSTATE_AC2ARRAY + PROCESSORSTATE_AC2ARWORD + PROCESSORSTATE_AC2LOCAT + PROCESSORSTATE_AC2LENGTH + PROCESSORSTATE_AC3ARRAY + PROCESSORSTATE_AC3ARWORD + PROCESSORSTATE_AC3LOCAT + PROCESSORSTATE_AC3LENGTH + PROCESSORSTATE_AC4ARRAY + PROCESSORSTATE_AC4ARWORD + PROCESSORSTATE_AC4LOCAT + PROCESSORSTATE_AC4LENGTH + PROCESSORSTATE_AC5ARRAY + PROCESSORSTATE_AC5ARWORD + PROCESSORSTATE_AC5LOCAT + PROCESSORSTATE_AC5LENGTH + PROCESSORSTATE_AC6ARRAY + PROCESSORSTATE_AC6ARWORD + PROCESSORSTATE_AC6LOCAT + PROCESSORSTATE_AC6LENGTH + PROCESSORSTATE_AC7ARRAY + PROCESSORSTATE_AC7ARWORD + PROCESSORSTATE_AC7LOCAT + PROCESSORSTATE_AC7LENGTH + PROCESSORSTATE_TMCURRENTTRANSACTION + PROCESSORSTATE_TMWRITESTART + PROCESSORSTATE_TMWRITECURRENT + PROCESSORSTATE_TMWRITELIMIT + PROCESSORSTATE_TMRECORDINGREADS + PROCESSORSTATE_TMREADSTART + PROCESSORSTATE_TMREADCURRENT + PROCESSORSTATE_TMREADLIMIT + ;;-- + ))) + +(defun needs-processorstate-cast (ptr member) + (is-processorstatep-member member)) + +(defun check-needs-cast (ptr member) + (cond + ((needs-cacheline-cast ptr member) + (format nil "((CACHELINEP)~A)" (cacheline-ptr-str ptr))) + ((needs-arraycache-cast ptr member) + (format nil "((ARRAYCACHEP)~A)" (string-downcase ptr))) + ((eq ptr 'ivory) "processor") + ((needs-processorstate-cast ptr member) + (format nil "((PROCESSORSTATEP)~A)" (string-downcase ptr))) + (t + (if (stringp ptr) ptr (string-downcase ptr))))) + +(defun structptr (str &optional member) + (let ((new (remap-arg str))) + (if new (check-needs-cast new member) + (check-needs-cast str member)))) + +;;(defun gotolabel (str) +;; (lc str)) + +(defun add-global-label-symbol (sym) + (setq global-labels (append global-labels (list sym)))) + +(defun is-global-label (label) + (if (equal label '|SetToCdrPushCarLocative|) + t + (if (equal label '|HALTMACHINE|) + nil + (member (if (stringp label) (intern label) label) global-labels)))) + +(defun gotolabel (str) + (if (is-global-label str) + str + (lc str))) + +; if number, return number+L, else return string +(defun longnum (str) + (if (numberp str) + (format nil "~AL" str) + (string-downcase str))) + +; +(setq call-label-count 0) + +(defun make-call-label () + (setq call-label-count (+ 1 call-label-count)) + (format nil "return~4,'0D" call-label-count)) + +(setq just-start nil) +(setq global-labels nil) + +;;;; +;; undo passthrus +(defun fix-passthrus nil + (fmakunbound 'ldgp) + (defmacro ldgp (&optional comment) + `((ldgp $gp 0($27) ,@(if comment `(,comment))))) + + (fmakunbound 'divl) + (defmacro divl (div by res &optional comment) + `((divl ,div ,by ,res ,@(if comment `(,comment))))) + + (fmakunbound 'divq) + (defmacro divq (div by res &optional comment) + `((divq ,div ,by ,res ,@(if comment `(,comment))))) + + (fmakunbound 'divlu) + (defmacro divlu (div by res &optional comment) + `((divlu ,div ,by ,res ,@(if comment `(,comment))))) + + (fmakunbound 'divqu) + (defmacro divqu (div by res &optional comment) + `((m-divqu ,div ,by ,res ,@(if comment `(,comment))))) + + (fmakunbound 'reml) + (defmacro reml (div by res &optional comment) + `((reml ,div ,by ,res ,@(if comment `(,comment))))) + + (fmakunbound 'remlu) + (defmacro remlu (div by res &optional comment) + `((remlu ,div ,by ,res ,@(if comment `(,comment))))) + + (fmakunbound 'remlq) + (defmacro remlq (div by res &optional comment) + `((remlq ,div ,by ,res ,@(if comment `(,comment))))) + + (fmakunbound 'remqu) + (defmacro remqu (div by res &optional comment) + `((remqu ,div ,by ,res ,@(if comment `(,comment))))) + ) +;;;; + +;; +(defun emit-operation (form destination) +;; (format t "emit-operation: form ~S~%" form) +;; (format t "~S~%" form) + (let ((cmd (car form)) + (arg1 (car (cdr form))) + (arg2 (car (cddr form))) + (arg3 (car (cdddr form))) + (arg4 (car (cddddr form)))) +;; (format t "cmd: ~S~%" cmd) + (case cmd + (start + (setq just-start t) + (format destination "/* start ~A */~%~%" arg1)) + (end + (format destination "~%/* end ~A */~%" arg1)) + (comment + (format destination " /* ~A */~%" arg1)) + + (label +;; (format t "label: ~S~%" arg1) + (let ((lname (if (is-global-label arg1) arg1 (gotolabel arg1)))) + (format destination "~%~A:~%" lname) + (format destination " if (_trace) printf(\"~A:\\n\");~%" lname) + (if (equal lname "continuecurrentinstruction") + (format destination " if (_show) show_loc();~%" lname)))) + + (func-label + (format destination "~%~A:~%" arg1)) + + (unlikely-label + (format destination "~%~A:~%" (gotolabel arg1))) + + (cache-ivory-state + (format destination " /* cache-ivory-state */~%") + (format destination " iCP = processor->cp;~%") + (format destination " iPC = processor->epc;~%") + (format destination " iSP = processor->sp;~%") + (format destination " iFP = processor->fp;~%") + (format destination " iLP = processor->lp;~%")) + + (ADDL + (check-comment arg4) + (cond + ((equal arg1 'zero) + (format destination " ~A = (s32)~A;~%" + (fixarg arg3) (fixarg arg2))) + ((equal arg2 'zero) + (format destination " ~A = (s32)~A;~%" + (fixarg arg3) (fixarg arg1))) + (t + (format destination " ~A = (s32)~A + (s32)~A;~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2))))) + + (ADDL/V + (check-comment arg4) + (format destination + "// ~A = (u64)((s32)~A + (s64)(s32)~A); /* addl/v */~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2)) + (format destination + " /* x86_64 replacement for addl/v */~%") + (format destination + " asm(\"movl %k2,%k0 \\n\\t\" + \"addl %k3,%k0 \\n\\t\" + \"seto %b1\" + : \"=r\"(~a),\"=rm\"(~a) + : \"rm\"(~a),\"rm\"(~a) + : \"cc\");~%" + (fixarg arg3) + "oflo" + (fixarg arg1) + (fixarg arg2)) + (setq *do-check-oflo* t) + (format destination "// if (~A >> 32)~%// exception();~%" + (fixarg arg3))) + + (SUBL/V + (check-comment arg4) + (format destination + "// ~A = (s64)((s32)~A - (s64)(s32)~A); /* subl/v */~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2)) + (format destination + " /* x86_64 replacement for subl/v */~%") + (format destination + " asm(\"movl %k2,%k0 \\n\\t\" + \"subl %k3,%k0 \\n\\t\" + \"seto %b1\" + : \"=r\"(~a),\"=rm\"(~a) + : \"rm\"(~a),\"rm\"(~a) + : \"cc\");~%" + (fixarg arg3) + "oflo" + (fixarg arg1) + (fixarg arg2)) + (format destination "// if (~A >> 32)~%// exception();~%" + (fixarg arg3)) + (setq *do-check-oflo* t)) + + (ADDQ + (check-comment arg4) + (cond + ((eq arg1 'zero) + (format destination " ~A = ~A;~%" (fixarg arg3) (fixarg arg2))) + ((eq arg2 'zero) + (format destination " ~A = ~A;~%" (fixarg arg3) (fixarg arg1))) + (t + (format destination " ~A = ~A + ~A;~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2))))) + + ('AND + (check-comment arg4) + (if (not (eq arg3 'zero)) + (format destination " ~A = ~A & ~A;~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (BIC + (check-comment arg4) + (format destination " ~A = ~A & ~~~A;~%" + (fixarg arg3) + (fixarg arg1) + (longnum arg2) + )) + + (BIS + (check-comment arg4) + (cond + ((eq arg1 'zero) + (format destination " ~A = ~A;~%" (fixarg arg3) (fixarg arg2))) + ((eq arg2 'zero) + (format destination " ~A = ~A;~%" (fixarg arg3) (fixarg arg1))) + (t + (format destination " ~A = ~A | ~A;~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2))))) + + (BEQ + (check-comment arg3) + (format destination " if (~A == 0)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BLE + (check-comment arg3) + (format destination " if ((s64)~A <= 0)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BLT + (check-comment arg3) + (format destination " if ((s64)~A < 0)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BLBC + (check-comment arg3) + (format destination " if ((~A & 1) == 0)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BLBS + (check-comment arg3) + (format destination " if (~A & 1)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BGE + (check-comment arg3) + (format destination " if ((s64)~A >= 0)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BGT + (check-comment arg3) + (format destination " if ((s64)~A > 0)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BNE + (check-comment arg3) + (format destination " if (~A != 0)~% goto ~A;~%" + (fixarg arg1) (gotolabel arg2))) + + (BR + (check-comment arg4) + (format destination " goto ~A;~%" + (gotolabel arg2))) + + (CLR + (check-comment arg2) + (format destination " ~A = 0;~%" + (fixarg arg1))) + + (CMPBGE + (check-comment arg4) + (format destination " ~A = CMPBGE(~A, ~A);~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (CMPLE + (check-comment arg4) + (format destination " ~A = ((s64)~A <= (s64)~A) ? 1 : 0;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (CMPEQ + (check-comment arg4) + (format destination " ~A = (~A == ~A) ? 1 : 0;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (CMPLT + (check-comment arg4) + (format destination " ~A = ((s64)~A < (s64)~A) ? 1 : 0;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (CMPTLE + (check-comment arg4) + (format destination + " SETFLTT(~A,~A, FLTU64(~A,~A) <= FLTU64(~A,~A) ? 2.0:0);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (CMPTLT + (check-comment arg4) + (format destination + " SETFLTT(~A,~A, FLTU64(~A,~A) < FLTU64(~A,~A) ? 2.0:0);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (CMPTEQ + (check-comment arg4) + (format destination + " SETFLTT(~A,~A, FLTU64(~A,~A) == FLTU64(~A,~A) ? 2.0:0);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (CMPULE + (check-comment arg4) + (format destination " ~A = ((u64)~A <= (u64)~A) ? 1 : 0;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (CMPULT + (check-comment arg4) + (format destination " ~A = ((u64)~A < (u64)~A) ? 1 : 0;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (CMOVLBS + (check-comment arg4) + (format destination " if (~A & 1)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CMOVLBC + (check-comment arg4) + (format destination " if ((~A & 1) == 0)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CMOVEQ + (check-comment arg4) + (format destination " if (~A == 0)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CMOVGE + (check-comment arg4) + (format destination " if ((s64)~A >= 0)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CMOVGT + (check-comment arg4) + (format destination " if ((s64)~A > 0)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CMOVLE + (check-comment arg4) + (format destination " if ((s64)~A <= 0)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CMOVLT + (check-comment arg4) + (format destination " if ((s64)~A < 0)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CMOVNE + (check-comment arg4) + (format destination " if (~A)~%" + (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) + (fixarg arg2))) + + (CPYSN + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " CPYSN(~A, ~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTQL + (format destination " CVTQL(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTQL/V + (format destination " CVTQLV(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTQS + (format destination " CVTQS(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTQT + (format destination " CVTQT(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTLQ + (format destination " CVTLQ(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTTQ + (format destination " CVTTQ(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTTQ/V + (format destination " CVTTQV(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTTQ/VC + (format destination " CVTTQVC(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTTQ/VM + (format destination " CVTTQVM(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTTQ/SVI + (format destination " CVTTQSVI(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (CVTTS + (format destination " CVTTS(~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (fixarg arg1) (regnum (fixarg arg2)) (fixarg arg2))) + + (M-DIVQU + (check-comment arg4) + (format destination " ~A = ~A / ~A;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (EXTERNAL-BRANCH + (format destination " goto ~A;~%" + (gotolabel arg1))) + + (EXTBL + (check-comment arg4) + (if (eq arg2 0) + (format destination " ~A = (u8)~A;~%" + (fixarg arg3) (fixarg arg1)) + (format destination " ~A = (u8)(~A >> ((~A&7)*8));~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (EXTWL + (check-comment arg4) + (if (eq arg2 0) + (format destination " ~A = (u16)~A;~%" + (fixarg arg3) (fixarg arg1)) + (format destination " ~A = (u16)(~A >> ((~A&7)*8));~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (EXTLL + (check-comment arg4) + (if (eq arg2 0) + (format destination " ~A = (u32)~A;~%" + (fixarg arg3) (fixarg arg1)) + (format destination " ~A = (u32)(~A >> ((~A&7)*8));~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (FBEQ + (check-comment arg3) + (format destination " if (FLTU64(~A, ~A) == 0.0)~% goto ~A;~%" + (regnum (fixarg arg1)) (fixarg arg1) + (gotolabel arg2))) + + (FBLT + (check-comment arg3) + (format destination " if (FLTU64(~A, ~A) < 0.0)~% goto ~A;~%" + (regnum (fixarg arg1)) (fixarg arg1) + (gotolabel arg2))) + + (FBGT + (check-comment arg3) + (format destination " if (FLTU64(~A, ~A) > 0.0)~% goto ~A;~%" + (regnum (fixarg arg1)) (fixarg arg1) + (gotolabel arg2))) + + (FBNE + (check-comment arg3) + (format destination " if (FLTU64(~A, ~A) != 0.0)~% goto ~A;~%" + (regnum (fixarg arg1)) (fixarg arg1) + (gotolabel arg2))) + + (FCMOVGT + (check-comment arg4) + (format destination " if (FLTU64(~A, ~A) > 0.0)~%" + (regnum (fixarg arg1)) (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) (fixarg arg2))) + + (FCMOVLT + (check-comment arg4) + (format destination " if (FLTU64(~A, ~A) < 0.0)~%" + (regnum (fixarg arg1)) (fixarg arg1)) + (format destination " ~A = ~A;~%" + (fixarg arg3) (fixarg arg2))) + + (INSBL + (check-comment arg4) + (format destination " ~A = (~A & 0xff) << ((~A&7)*8);~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2))) + + (JMP + (check-comment arg4) + (format destination " goto *~A; /* jmp */~%" + (fixarg arg2))) + + (JSR + (check-comment arg4) + (format destination + " r0 = (*( u64 (*)(u64, u64) )~A)(arg1, arg2); /* jsr */~%" + (fixarg arg2))) + + (FETCH) + (FETCH_M) + + (LDA + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (cond + ((eq arg2 0) + (format destination " ~A = ~A;~%" + (fixarg arg1) (fixarg arg3))) + ((or (numberp arg2) (isconstant arg2) (eq arg3 'zero)) + (format destination " ~A = ~A + ~A;~%" + (fixarg arg1) (fixarg arg3) (fixarg arg2))) + (t + (format destination " ~A = (u64)&~A->~A;~%" + (fixarg arg1) (structptr arg3 arg2) (fixarg arg2))))) + + (LDAH + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (or (eq arg3 0) (eq arg3 'zero)) + (format destination " ~A = (~A) << 16;~%" + (fixarg arg1) (fixarg arg2)) + (if (or (numberp arg2) (isconstant arg2)) + (format destination " ~A = ~A + ((~A) << 16);~%" + (fixarg arg1) (fixarg arg3) (fixarg arg2)) + (format destination " ~A = (u64)&~A->~A;~%" + (fixarg arg1) (structptr arg3 arg2) (fixarg arg2))))) + + (LDL + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (numberp arg2) + (if (eq arg2 0) + (format destination " ~A = *(s32 *)~A;~%" + (fixarg arg1) (fixarg arg3)) + (format destination " ~A = *(s32 *)(~A + ~A);~%" + (fixarg arg1) (fixarg arg3) (fixarg arg2))) + ;; handle ugly x+4 case + (multiple-value-bind (ptr member offset) + (decompose-args arg3 arg2) + (if (numberp offset) + (progn + (if (eq (mod offset 4) 0) + (setq offset (/ offset 4)) + (format t "*** LDL, offset not mult 4; ~S" form))) + (setq offset (format nil "~A/4" offset))) + (cond + ((eq offset 0) + (format destination " ~A = *(s32 *)&~A->~A;~%" + (fixarg arg1) ptr (fixarg member))) + (t + (format destination " ~A = *((s32 *)(&~A->~A)+~A);~%" + (fixarg arg1) ptr (fixarg member) offset)))))) + + (LDQ + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (or (numberp arg2) (isconstant arg2)) + (if (eq arg2 0) + (format destination " ~A = *(u64 *)~A;~%" + (fixarg arg1) (fixarg arg3)) + (format destination " ~A = *(u64 *)(~A + ~A);~%" + (fixarg arg1) (fixarg arg3) (fixarg arg2))) + ;; member not number or constant + (let ((ptr (structptr arg3 arg2))) + ;; hack + (if (or + (equal ptr "((PROCESSORSTATEP)t8)") + (equal ptr "((PROCESSORSTATEP)t12)")) + (let ((asmoffset + (cond + ((eq arg2 'PROCESSORSTATE_DATAREAD_MASK) + "PROCESSORSTATE_DATAREAD_MASK") + ((eq arg2 'PROCESSORSTATE_DATAREAD) + "PROCESSORSTATE_DATAREAD")))) + (format destination " ~A = *(u64 *)(~A + ~A);~%" + (fixarg arg1) (fixarg arg3) asmoffset)) + ;; normal case + (format destination " ~A = *(u64 *)&(~A->~A);~%" + (fixarg arg1) ptr (fixarg arg2)))))) + + (LDQ_U + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (eq arg2 0) + (format destination " ~A = LDQ_U(~A);~%" + (fixarg arg1) (fixarg arg3)) + (format destination " ~A = LDQ_U(&~A->~A);~%" + (fixarg arg1) (structptr arg3) (fixarg arg2)))) + + (LDQ_L + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (eq arg2 0) + (format destination " ~A = *(u64 *)~A; /* lock */~%" + (fixarg arg1) (fixarg arg3)) + (format destination " ~A = *(u64 *)&(~A->~A); /* lock */~%" + (fixarg arg1) (structptr arg3) (fixarg arg2)))) + + (LDS + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (eq arg2 0) + (format destination " LDS(~A, ~A, *(u32 *)~A );~%" + (regnum (fixarg arg1)) (fixarg arg1) (fixarg arg3)) + (format destination " LDS(~A, ~A, ~A->~A);~%" + (regnum (fixarg arg1)) + (fixarg arg1) (structptr arg3) (fixarg arg2)))) + + (LDT + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (eq arg2 0) + (format destination " LDT(~A, ~A, *(u32 *)~A );~%" + (regnum (fixarg arg1)) (fixarg arg1) (fixarg arg3)) + (format destination " LDT(~A, ~A, ~A->~A);~%" + (regnum (fixarg arg1)) + (fixarg arg1) (structptr arg3) (fixarg arg2)))) + + (STS + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (numberp arg2) + (if (eq arg2 0) + (format destination " STS( (u32 *)~A, ~A, ~A );~%" + (structptr arg3) (regnum (fixarg arg1)) (fixarg arg1)) + (format destination " STS( (u32 *)(~A + ~A), ~A, ~A );~%" + (structptr arg3 arg2) (fixarg arg2) + (regnum (fixarg arg1)) (fixarg arg1))) + (format destination " STS( (u32 *)&~A->~A, ~A, ~A );~%" + (structptr arg3) (fixarg arg2) + (regnum (fixarg arg1)) (fixarg arg1)))) + + (STT + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (numberp arg2) + (if (eq arg2 0) + (format destination " STT( (u64 *)~A, ~A, ~A );~%" + (structptr arg3) (regnum (fixarg arg1)) (fixarg arg1)) + (format destination " STT( (u64 *)(~A + ~A), ~A, ~A );~%" + (structptr arg3 arg2) (fixarg arg2) + (regnum (fixarg arg1)) (fixarg arg1))) + (format destination " STT( (u64 *)&~A->~A, ~A, ~A );~%" + (structptr arg3) (fixarg arg2) + (regnum (fixarg arg1)) (fixarg arg1)))) + + (ADDS + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " ADDS(~A, ~A, ~A, ~A, ~A, ~A); /* adds */~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (ADDT + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " ADDT(~A, ~A, ~A, ~A, ~A, ~A); /* addt */~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (SUBS + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (not (equal arg3 'zero)) + (format destination " SUBS(~A, ~A, ~A, ~A, ~A, ~A); /* subs */~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2)))) + + (SUBT + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " SUBT(~A, ~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (MULS + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " MULS(~A, ~A, ~A, ~A, ~A, ~A); /* muls */~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (MULT + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " MULT(~A, ~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (DIVS + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " DIVS(~A, ~A, ~A, ~A, ~A, ~A); /* divs */~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (DIVT + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " DIVT(~A, ~A, ~A, ~A, ~A, ~A);~%" + (regnum (fixarg arg3)) (fixarg arg3) + (regnum (fixarg arg1)) (fixarg arg1) + (regnum (fixarg arg2)) (fixarg arg2))) + + (LOAD-CONSTANT + (check-comment arg4) + (if (numberp arg2) + (format destination " ~A = 0x~X;~%" + (fixarg arg1) + arg2) + (format destination " ~A = ~A;~%" + (fixarg arg1) + (fixarg arg2)))) + + (MSKBL + (check-comment arg4) + (format destination " ~A = ~A & ~~(0xffL << (~A&7)*8);~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2))) + + (MULQ + (check-comment arg4) + (format destination " ~A = ~A * ~A;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (MULL/V + (check-comment arg4) + (format destination + "// ~A = (s64)((s32)~A * (s64)(s32)~A); /* mull/v */~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2)) + (format destination + " /* x86_64 replacement for mull/v */~%") + (format destination + " asm(\"movl %k2,%k0 \\n\\t\" + \"imull %k3,%k0 \\n\\t\" + \"seto %b1\" + : \"=r\"(~a),\"=rm\"(~a) + : \"rm\"(~a),\"rm\"(~a) + : \"cc\");~%" + (fixarg arg3) + "oflo" + (fixarg arg1) + (fixarg arg2)) + (setq *do-check-oflo* t) + (format destination "// if (~A >> 32)~%// exception();~%" + (fixarg arg3))) + + (X64RATQUO + (check-comment arg4) + (format destination + " /* x86_64 replacement for fixnum rational quotient */~%") + (format destination + " asm(\"movl %k2,%%eax \\n\\t\"~36,4T// get arg1 into res + \"cdq \\n\\t\"~36,4T// sign extend into edx:eax + \"idivl %k3 \\n\\t\"~36,4T// divide by arg2 + \"movl %%eax,%k0 \\n\\t\"~36,4T// result into f0 + \"movl %%edx,%k1\"~36,4T// remainder into im1 + : \"=mr\"(~a),\"=rm\"(~a)~36,4T// %0;res, %1:im1 + : \"rm\"(~a),\"rm\"(~a)~36,4T// %2:t2, %3:t4 + : \"rax\", \"rdx\", \"cc\");~36,4T// clobbers eax, edx and cc;~%" + (fixarg arg1) + "im1" + (fixarg arg2) + (fixarg arg3)) + (setq *do-check-ratquo* t)) + + (LIBMFLOOR + (format destination + " /* use libc function floor for rounding-mode :down */~%") + (format destination + " {~% extern double floor(double);~%") + (format destination + " double c = floor( FLTU64(1, ~a) / FLTU64(2, ~a) );~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " double d = FLTU64(1, ~a) - (c * FLTU64(2, ~a)) ;~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " LDS(0, ~a, (int)c);~%" + (fixarg arg4)) + (format destination + " LDT(3, ~a, U64FLTT(d));~% }~%" + (fixarg arg3))) + + (LIBMCEIL +;; (check-comment arg4) + (format destination + " /* use libc function ceil for rounding-mode :up */~%") + (format destination + " {~% extern double ceil(double);~%") + (format destination + " double c = ceil( FLTU64(1, ~a) / FLTU64(2, ~a) );~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " double d = FLTU64(1, ~a) - (c * FLTU64(2, ~a)) ;~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " LDS(0, ~a, (int)c);~%" + (fixarg arg4)) + (format destination + " LDT(3, ~a, U64FLTT(d));~% }~%" + (fixarg arg3))) + + (LIBMTRUNC +;; (check-comment arg4) + (format destination + " /* use libc function trunc for rounding-mode :truncate */~%") + (format destination + " {~% extern double trunc(double);~%") + (format destination + " double c = trunc( FLTU64(1, ~a) / FLTU64(2, ~a) );~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " double d = FLTU64(1, ~a) - (c * FLTU64(2, ~a)) ;~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " LDS(0, ~a, (int)c);~%" + (fixarg arg4)) + (format destination + " LDT(3, ~a, U64FLTT(d));~% }~%" + (fixarg arg3))) + + (LIBMRINT +;; (check-comment arg4) + (format destination + " /* use libc function rint for rounding-mode :round */~%") + (format destination + " {~% extern double rint(double);~%") + (format destination + " double c = rint( FLTU64(1, ~a) / FLTU64(2, ~a) );~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " double d = FLTU64(1, ~a) - (c * FLTU64(2, ~a)) ;~%" + (fixarg arg1) + (fixarg arg2)) + (format destination + " LDS(0, ~a, (int)c);~%" + (fixarg arg4)) + (format destination + " LDT(3, ~a, U64FLTT(d));~% }~%" + (fixarg arg3))) + + ;; (X64DFLTEXC + ;; (check-comment arg4) + ;; (format destination + ;; " if (((~a >> 10) & 0xff) == Opcode_DoubleFloatOp) goto ~a;~%" + ;; (fixarg arg1) + ;; (fixarg arg2))) + + (X64EXECTIMES + (format destination + "#ifdef EXECTIMES~%") + (format destination + " getrusage(RUSAGE_SELF,&_rusage);~%") + (format destination + " if (_lastcode != 0xFFFF) {~%") + (format destination + " _exectimes[_lastcode] += (_rusage.ru_utime.tv_usec +~%") + (format destination + " _rusage.ru_utime.tv_sec * 1000000) - _lastinststart;~% }~%") + (format destination + " _lastcode = ~a ;~%" + (fixarg arg1)) + (format destination + " _lastinststart = (_rusage.ru_utime.tv_usec +~%") + (format destination + " _rusage.ru_utime.tv_sec * 1000000);~%") + (format destination + "#endif // EXECTIMES~%")) + + (NOP) + + (ORNOT + (check-comment arg4) + (if (eq arg1 'zero) + (format destination " ~A = ~~~A;~%" + (fixarg arg3) (fixarg arg2)) + (format destination " ~A = ~A | ~~(~A);~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (RPCC + (format destination " ~A = RPCC();~%" + (fixarg arg1))) + + (SRA + (check-comment arg4) + (setq shiftarg + (if (numberp arg2) (logand arg2 63) + (format nil "(~A & 63)" (fixarg arg2)))) + (format destination " ~A = (s64)~A >> ~A;~%" + (fixarg arg3) (fixarg arg1) shiftarg)) + + (SRL + (check-comment arg4) + (setq shiftarg + (if (numberp arg2) (logand arg2 63) + (format nil "(~A & 63)" (fixarg arg2)))) + (format destination " ~A = ~A >> ~A;~%" + (fixarg arg3) (fixarg arg1) shiftarg)) + + (SLL + (check-comment arg4) + (setq shiftarg + (if (numberp arg2) (logand arg2 63) + (format nil "(~A & 63)" (fixarg arg2)))) + (format destination " ~A = ~A << ~A;~%" + (fixarg arg3) (fixarg arg1) shiftarg)) + + (SUBQ + (check-comment arg4) + (if (not (equal arg3 'zero)) + (format destination " ~A = ~A - ~A;~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (SUBL + (check-comment arg4) + (if (not (equal arg3 'zero)) + (format destination " ~A = (s32)~A - (s32)~A;~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (S4ADDQ + (check-comment arg4) + (if (equal arg2 'zero) + (format destination " ~A = (~A * 4);~%" + (fixarg arg3) (fixarg arg1)) + (format destination " ~A = (~A * 4) + ~A;~%" + (fixarg arg3) (fixarg arg1) (fixarg arg2)))) + + (S8ADDQ + (check-comment arg4) + (format destination " ~A = (~A * 8) + ~A;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (S4SUBQ + (check-comment arg4) + (format destination " ~A = (~A * 4) - ~A;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (S8SUBQ + (check-comment arg4) + (format destination " ~A = (~A * 8) - ~A;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + (STL + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (numberp arg2) + (if (eq arg2 0) + (format destination " *(u32 *)~A = ~A;~%" + (fixarg arg3) (fixarg arg1)) + (format destination " *(u32 *)(~A + ~A) = ~A;~%" + (fixarg arg3) (fixarg arg2) (fixarg arg1))) + ;; handle ugly x+4 case + (multiple-value-bind (ptr member offset) + (decompose-args arg3 arg2) + (if (numberp offset) + (progn + (if (eq (mod offset 4) 0) + (setq offset (/ offset 4)) + (format t "*** STL, offset not mult 4; ~S" form))) + (setq offset (format nil "~A/4" offset))) + (cond + ((eq offset 0) + (format destination " *(u32 *)&~A->~A = ~A;~%" + ptr (fixarg member) (fixarg arg1))) + (t + (format destination " *((u32 *)(&~A->~A)+~A) = ~A;~%" + ptr (fixarg member) offset (fixarg arg1))))))) + + (STQ + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (numberp arg2) + (if (eq arg2 0) + (format destination " *(u64 *)~A = ~A;~%" + (structptr arg3 arg2) (fixarg arg1)) + (format destination " *(u64 *)(~A + ~A) = ~A;~%" + (structptr arg3 arg2) (fixarg arg2) (fixarg arg1))) + ;; handle ugly x+4 case + (multiple-value-bind (ptr member offset) + (decompose-args arg3 arg2) + (if (numberp offset) + (progn + (if (eq (mod offset 8) 0) + (setq offset (/ offset 8)) + (format t "*** STQ, offset not mult 8; ~S" form))) + (setq offset (format nil "~A/8" offset))) + (cond + ((eq offset 0) + ;; hack! two even! + (if (equal ptr "((PROCESSORSTATEP)arg1)") + (setq ptr "processor")) + ;; + (format destination " *(u64 *)&~A->~A = ~A;~%" + ptr (fixarg member) (fixarg arg1))) + (t + (format destination " *((u64 *)(&~A->~A)+~A) = ~A;~%" + ptr (fixarg member) offset (fixarg arg1))))))) + + (STQ_C + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (format destination " *(u64 *)&~A->~A = ~A; /* lock */~%" + (structptr arg3) (fixarg arg2) (fixarg arg1)) + (format destination " ~A = 1;~%" + (fixarg arg1))) + + (STQ_U + (check-comment arg4) + (if (listp arg3) + (setq arg3 (car arg3))) + (if (eq arg2 0) + (format destination " STQ_U(~A, ~A);~%" + (fixarg arg3) + (fixarg arg1)) + (format destination " STQ_U((u64)&~A->~A, ~A);~%" + (structptr arg3) + (fixarg arg2) + (fixarg arg1)))) + + (TRAPB + (check-comment arg1) + (format destination " /* trapb ~A */~%" + (fixarg arg1)) + (when *do-check-oflo* + (format destination " CHECK_OFLO(); /* check overflow */~%") + (setq *do-check-oflo* nil)) + (when *do-check-ratquo* + (format destination " if (im1)~% goto arithmeticexception;~%") + (setq *do-check-ratquo* nil))) + + (XOR + (check-comment arg4) + (format destination " ~A = ~A ^ ~A;~%" + (fixarg arg3) + (fixarg arg1) + (fixarg arg2))) + + ;------------------------------------- + + (CALL-SUBROUTINE + (setq label (make-call-label)) + (format destination " ~A = (u64)&&~A;~%" (fixarg arg1) label) + (format destination " goto ~A;~%" (gotolabel arg2)) + (format destination "~A:~%" label)) + + (RET + (if (eq arg1 'zero) + (format destination " goto *~A; /* ret */~%" (fixarg arg2)) + (format t "*** RET w/arg1"))) + + (TAGTYPE + (check-comment arg3) + (format destination " ~A = ~A & 0x3f;~%" + (fixarg arg2) + (fixarg arg1))) + + (VM-READ + (setq arg5 (car (cdr (cddddr form)))) + (format destination " /* vm-read */~%") + (format destination " ~A = (char *)ivory + ~A;~%" + (fixarg arg5) (fixarg arg1)) + (format destination " ~A = ~A << 2;~%" + (fixarg arg3) (fixarg arg5)) + (format destination " ~A = *(unsigned char *)~A;~%" + (fixarg arg2) (fixarg arg5)) + (format destination " ~A = *(u32 *)~A;~%" + (fixarg arg2) (fixarg arg2))) + + (PASSTHRU + (if (search ".globl" arg1) + (let ((split-list (split-by-one-space arg1))) + (add-global-label-symbol (intern (car (cdr split-list)))))) +;; (format t "~S~%" global-labels) +;; (format t "passthru: arg1 ~S form ~S~%" arg1 form) + (if (or (equal (ext:substring arg1 0 5) "#ifde") + (equal (ext:substring arg1 0 5) "#ifnd") + (equal (ext:substring arg1 0 4) "#end")) + (format destination "~A~%" arg1))) + + (otherwise + (format t "***UNKNOWN FORM: ~S~%" form)) + + )) + 1 + ) + +;;; PROCESS-ASM-FORM handles the expansion of assembler macros. An +;;; assembler macro expands into a list of assembler operations any one of +;;; these may also be a macro The result of this loop is the linearization +;;; of assembler macros. +(defun process-asm-form (form destination &optional env) +; (format t "process-asm-form: form ~S~%" form) + (if (consp (first form)) + (loop for meform in form + summing (process-asm-form meform destination env)) + (let ((expanded (macroexpand-careful form env))) + (if (eq expanded form) + (emit-operation form destination) + (loop for meform in expanded + summing (process-asm-form meform destination env)))))) + + +(defun process-asm-source (sourcefilename targetname) + (with-open-file (sfs sourcefilename :direction :input) + (with-open-file (tfs targetname :direction :output + :if-exists :supersede) + (let () + (c-header tfs sourcefilename) + (do ((form (read sfs nil :eof) (read sfs nil :eof))) + ((eq form :eof) nil) + (when (consp form) + (process-asm-form form tfs))) + (c-trailer tfs sourcefilename))))) + +(defun create-output-files () +; (setq count 0) +; (format t "~%") + (dolist (file '("ifunhead" "idispat" "ifuncom1" "ifuncom2" + "ifungene" "ifunfcal" "ifunloop" "ifunlist" + "ifuninst" "ifunmath" "ifunarra" "ifunmove" + "ifunpred" "ifunsubp" "ifunfext" "ifunlexi" + "ifunbits" "ifunblok" "ifunbind" "ifunfull" + "ifunbnum" "ifuntrap" "ihalt" "idouble" + "ifunjosh" "ifuntran")) + (progn +; (setq count (+ 1 count)) + (setq outputfilename (format nil "~A.c" file)) + (setq inputfilename (format nil "../alpha-emulator/~A.as" file)) + (format t "compiling ~A~8,11T" inputfilename) + (format t "--> ~A~%" outputfilename) + (process-asm-source + inputfilename + outputfilename))) + +; (format t "DONE:~%") +; (format t "~%") +) + +(defun load-macros () + + (load "clisp-support.lisp") + (load "../emulator/aihead.lisp") + (load "../emulator/errortbl.lisp") + (load "../emulator/traps.lisp") + (load "intrpmac.lisp") + + (load "../alpha-emulator/aistat.lisp") + + (dolist (file + '("alphamac" +; "intrpmac" + "stacklis" + "memoryem" "imaclist" "fcallmac" "imacbits" + "imacblok" "imaclexi" "imacgene" "imacinst" "imacialu" + "imacloop" "imacmath" "imacbind" "imacjosh" "imacarra" + "imacpred" "imacsubp" "imactrap")) + (progn + (setq filename (format nil "../alpha-emulator/~A.lisp" file)) + (load filename)))) + +(defun load-macros-old () + (load "clisp-support.lisp") + (load "../emulator/aihead.lisp") + (load "../emulator/errortbl.lisp") + (load "intrpmac.lisp") + (load "../alpha-emulator/aistat.lisp") + (load "../alpha-emulator/alphamac.lisp") + (load "../alpha-emulator/stacklis.lisp") + (load "../alpha-emulator/imacloop.lisp") + (load "../alpha-emulator/fcallmac.lisp") + (load "../alpha-emulator/memoryem.lisp") + (load "../alpha-emulator/imactrap.lisp") + (load "../alpha-emulator/imacmath.lisp") + (load "../alpha-emulator/imacsubp.lisp") + (load "../alpha-emulator/imacblok.lisp") + (load "../alpha-emulator/imacialu.lisp") + (load "../alpha-emulator/imacbits.lisp") + (load "../alpha-emulator/imacpred.lisp") + (load "../alpha-emulator/imacarra.lisp") + (load "../alpha-emulator/imacgene.lisp") + (load "../alpha-emulator/imaclist.lisp") + (load "../alpha-emulator/imacinst.lisp") + (load "../alpha-emulator/imacbind.lisp")) + +(defun add-missing-global-symbols () + + (dolist (sym + '( + |ReadRegisterError| + |ReadRegisterFP| + |ReadRegisterLP| + |ReadRegisterSP| + |ReadRegisterError| + |ReadRegisterStackCacheLowerBound| + |ReadRegisterBARx| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterContinuation| + |ReadRegisterAluAndRotateControl| + |ReadRegisterControlRegister| + |ReadRegisterCRArgumentSize| + |ReadRegisterEphemeralOldspaceRegister| + |ReadRegisterZoneOldspaceRegister| + |ReadRegisterChipRevision| + |ReadRegisterFPCoprocessorPresent| + |ReadRegisterError| + |ReadRegisterPreemptRegister| + |ReadRegisterIcacheControl| + |ReadRegisterPrefetcherControl| + |ReadRegisterMapCacheControl| + |ReadRegisterMemoryControl| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterStackCacheOverflowLimit| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterMicrosecondClock| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterTOS| + |ReadRegisterEventCount| + |ReadRegisterBindingStackPointer| + |ReadRegisterCatchBlockList| + |ReadRegisterControlStackLimit| + |ReadRegisterControlStackExtraLimit| + |ReadRegisterBindingStackLimit| + |ReadRegisterPHTBase| + |ReadRegisterPHTMask| + |ReadRegisterCountMapReloads| + |ReadRegisterListCacheArea| + |ReadRegisterListCacheAddress| + |ReadRegisterListCacheLength| + |ReadRegisterStructureCacheArea| + |ReadRegisterStructureCacheAddress| + |ReadRegisterStructureCacheLength| + |ReadRegisterDynamicBindingCacheBase| + |ReadRegisterDynamicBindingCacheMask| + |ReadRegisterChoicePointer| + |ReadRegisterStructureStackChoicePointer| + |ReadRegisterFEPModeTrapVectorAddress| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterStackFrameMaximumSize| + |ReadRegisterStackCacheDumpQuantum| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterError| + |ReadRegisterConstantNIL| + |ReadRegisterConstantT| + |WriteRegisterError| + |WriteRegisterFP| + |WriteRegisterLP| + |WriteRegisterSP| + |WriteRegisterError| + |WriteRegisterStackCacheLowerBound| + |WriteRegisterBARx| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterContinuation| + |WriteRegisterAluAndRotateControl| + |WriteRegisterControlRegister| + |WriteRegisterError| + |WriteRegisterEphemeralOldspaceRegister| + |WriteRegisterZoneOldspaceRegister| + |WriteRegisterError| + |WriteRegisterFPCoprocessorPresent| + |WriteRegisterError| + |WriteRegisterPreemptRegister| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterStackCacheOverflowLimit| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterTOS| + |WriteRegisterEventCount| + |WriteRegisterBindingStackPointer| + |WriteRegisterCatchBlockList| + |WriteRegisterControlStackLimit| + |WriteRegisterControlStackExtraLimit| + |WriteRegisterBindingStackLimit| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterListCacheArea| + |WriteRegisterListCacheAddress| + |WriteRegisterListCacheLength| + |WriteRegisterStructureCacheArea| + |WriteRegisterStructureCacheAddress| + |WriteRegisterStructureCacheLength| + |WriteRegisterDynamicBindingCacheBase| + |WriteRegisterDynamicBindingCacheMask| + |WriteRegisterChoicePointer| + |WriteRegisterStructureStackChoicePointer| + |WriteRegisterFEPModeTrapVectorAddress| + |WriteRegisterError| + |WriteRegisterMappingTableCache| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + |WriteRegisterError| + )) + (add-global-label-symbol sym))) + + +(defun build () +; (load-macros-old) + (load-macros) +;; (defmacro define-procedure (name (&rest args) &body body &environment env) +;; (let ((*function-being-processed* name)) +;; `((start ,name ,(length args)) +;; ; (label ,name) +;; (func-label ,name) +;; ,@(collecting-function-epilogue body env) +;; (end ,name)))) + + (setq *gensym-counter* 6022) + (fix-passthrus) + (add-missing-global-symbols) + (create-output-files) +) + +(build) + +;(process-asm-source "input1" "output") +;(process-asm-source "../alpha-emulator/ifunhead.as" "output1") +;(process-asm-source "../alpha-emulator/idispat.as" "output2") diff --git a/stub/stub.c b/stub/stub.c new file mode 100644 index 0000000..54b49c8 --- /dev/null +++ b/stub/stub.c @@ -0,0 +1,717 @@ +/* + * OG "C" instruction stubs + */ +#define _GNU_SOURCE +#include +#include +#include "std.h" + +#ifdef STATISTICS +#ifdef EXECTIMES +#include +#include +#endif // EXECTIMES +#endif + +#include "aihead.h" +#include "ivoryrep.h" +#include "embed.h" +#include "traps.h" + +#include "ivory.h" + +typedef unsigned char u8; +typedef unsigned short u16; +typedef unsigned int u32; +typedef unsigned long u64; + +typedef char s8; +typedef int s32; +typedef long s64; + +#define MemoryActionIndirect 01 +#define MemoryActionMonitor 02 +#define MemoryActionTransport 04 +#define MemoryActionTrap 010 +#define MemoryActionTransform 020 +#define MemoryActionBinding 040 + +#define CACHELINESIZE 48 +#define TWOCACHELINESIZE (2*CACHELINESIZE) +#define FOURCACHELINESIZE (4*CACHELINESIZE) + +#define AutoArrayRegMask 224 +#define AutoArrayRegSize 32 +#define AutoArrayRegShift 0 + +#define PROCESSORSTATE_DATAREAD -504 +#define PROCESSORSTATE_DATAREAD_MASK -512 + +/* +t1 1 instn +t2 2 iword +t3 3 ecp +t4 4 ocp +t5 5 icsize +t6 6 epc +t7 7 opc +t8 8 count +iPC 9 +iFP 10 +iLP 11 +iSP 12 +iCP 13 +ivory 14 ; ivory processor object +arg1 16 +arg2 17 +arg3 18 +arg4 19 +arg5 20 hwopmask +arg6 21 fwdispatch +t9 22 hwdispatch +t10 23 +t11 24 +t12 25 +ra r26 +pv r27 +gp r29 +sp r30 + +none 31 +instn 1 ; = T1 +iword 2 ; = T2 +ecp 3 ; = T3 +ocp 4 ; = T4 +icsize 5 ; = T5 (icache size in bytes +epc 6 ; = T6 +opc 7 ; = T7 +count 8 ; = T8 +hwopmask 20 ; = ARG5 (the halfword operand mask +fwdispatch 21 ; = ARG6 (the fullword dispatch table +hwdispatch 22 ; = T9 (the halfword dispatch table) +*/ + +////u64 r0, r1, r2, r3, r4, r5, r6, r7, r8, r9, r10, r11, r12, r13, r14, r15; +//static u64 r0, instn, iword, ecp, ocp, icsize, epc, opc, count; + +#define r1 instn +#define r2 iword +#define r3 ecp +#define r4 ocp +#define r5 icsize +#define r6 epc +#define r7 opc +#define r8 count +//static u64 r9, r10, r11, r12, r13, r14, r15; +//static u64 r16, r17, r18, r19, r20, r21, r22, r23, r24, r25, r26, r27, r29; +//static u64 sp; +#define r30 sp +//static u64 r31 = 0; + +//#define zero 0 +#define zero r31 + +#define t1 r1 +#define t2 r2 +#define t3 r3 +#define t4 r4 +#define t5 r5 +#define t6 r6 +#define t7 r7 +#define t8 r8 +#define iPC r9 +#define iFP r10 +#define iLP r11 +#define iSP r12 +#define iCP r13 +#define arg1 r16 +#define arg2 r17 +#define arg3 r18 +#define arg4 r19 +#define arg5 r20 +#define arg6 r21 +#define t9 r22 +#define t10 r23 +#define t11 r24 +#define t12 r25 +#define ra r26 +#define pv r27 +#define gp r29 +//#define sp r30 + +//#define instn r1 +//#define iword r2 +//#define ecp r3 +//#define ocp r4 +//#define icsize r5 +//#define epc r6 +//#define opc r7 +//#define count r8 + +#define hwopmask r20 +#define fwdispatch r21 +#define hwdispatch r22 + +#define rdtscll(val) \ + __asm__ __volatile__ ("rdtsc" : "=A" (val)) + + +// these need to be in-line for DECODEFAULT to work +#define LDQ_U(ptr) *(u64 *)(ptr & ~7L) +#define STQ_U(ptr, v) *(u64 *)(ptr & ~7L) = v + +static u64 f0, f1, f2, f3, f31; + +#include "float2" +//#include "float1" +extern inline double fixtfloat(int r, u64 v); +extern inline u64 _ADDS(int rd, int ra, u64 a, int rb, u64 b); +extern inline u64 _SUBS(int rd, int ra, u64 a, int rb, u64 b); +extern inline u64 _MULS(int rd, int ra, u64 a, int rb, u64 b); +extern inline u64 _DIVS(int rd, int ra, u64 a, int rb, u64 b); + +inline u64 CMPBGE(u64 a, u64 b) +{ + u64 res = 0; + u8 aa, bb; + int i; + + // printf("CMPBGE %p %p ", a, b); + + for (i = 0; i < 8; i++) { + aa = a & 0xff; + a >>= 8; + bb = b & 0xff; + b >>= 8; + if (aa >= bb) + res |= 1 << i; + } + + // printf("-> %p\n", res); + return res; +} +// jj +#define CHECK_OFLO32(r) \ + if (((r) & 0x8000000000000000) == 0 && ((r) >> 31)) { \ + printf("arithmeticexception; oflo32 file %s line %d\n", \ + __FILE__, __LINE__); \ + goto arithmeticexception; } + +/* #define CHECK_OFLO() \ */ +/* if (oflo) { \ */ +/* printf("arithmeticexception; file %s line %d\n", __FILE__, __LINE__); \ */ +/* goto arithmeticexception; } */ +/* #define CHECK_OFLO32(r) \ */ +/* if (((r) & 0x8000000000000000) == 0 && ((r) >> 31)) { goto arithmeticexception; } */ + +#define CHECK_OFLO() \ + if (oflo) { goto arithmeticexception; } +// jj + +int8_t oflo; + +void exception(int which, u64 r) +{ + if (r & 0x8000000000000000) return; + printf("exception(%d, %p)!!!\n",which, (void *)r); +} + +char *halfwordnames[256*4] + = { + "DoCarFP", "DoCarLP", "DoCarSP", "DoCarIM", /* #o00 */ + "DoCdrFP", "DoCdrLP", "DoCdrSP", "DoCdrIM", /* #o01 */ + "DoEndpFP", "DoEndpLP", "DoEndpSP", "DoEndpIM", /* #o02 */ + "DoSetup1DArrayFP", "DoSetup1DArrayLP", "DoSetup1DArraySP", "DoSetup1DArrayIM", /* #o03 */ + "DoSetupForce1DArrayFP", "DoSetupForce1DArrayLP", "DoSetupForce1DArraySP", "DoSetupForce1DArrayIM", /* #o04 */ + "DoBindLocativeFP", "DoBindLocativeLP", "DoBindLocativeSP", "DoBindLocativeIM", /* #o05 */ + "DoRestoreBindingStackFP", "DoRestoreBindingStackLP", "DoRestoreBindingStackSP", "DoRestoreBindingStackIM", /* #o06 */ + "DoEphemeralpFP", "DoEphemeralpLP", "DoEphemeralpSP", "DoEphemeralpIM", /* #o07 */ + "DoStartCallFP", "DoStartCallLP", "DoStartCallSP", "DoStartCallIM", /* #o010 */ + "DoJumpFP", "DoJumpLP", "DoJumpSP", "DoJumpIM", /* #o011 */ + "DoTagFP", "DoTagLP", "DoTagSP", "DoTagIM", /* #o012 */ + "DoDereferenceFP", "DoDereferenceLP", "DoDereferenceSP", "DoDereferenceIM", /* #o013 */ + "DoLogicTailTestFP", "DoLogicTailTestLP", "DoLogicTailTestSP", "DoLogicTailTestIM", /* #o014 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /* #o015 +++ Used for breakpoints!!! */ + "DoDoubleFloatOpFP", "DoDoubleFloatOpLP", "DoDoubleFloatOpSP", "DoDoubleFloatOpIM", /* #o016 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /* #o017 */ + "DoPushLexicalVar0FP", "DoPushLexicalVar0LP", "DoPushLexicalVar0SP", "DoPushLexicalVar0IM", /* #o020 */ + "DoPushLexicalVar1FP", "DoPushLexicalVar1LP", "DoPushLexicalVar1SP", "DoPushLexicalVar1IM", /* #o021 */ + "DoPushLexicalVar2FP", "DoPushLexicalVar2LP", "DoPushLexicalVar2SP", "DoPushLexicalVar2IM", /* #o022 */ + "DoPushLexicalVar3FP", "DoPushLexicalVar3LP", "DoPushLexicalVar3SP", "DoPushLexicalVar3IM", /* #o023 */ + "DoPushLexicalVar4FP", "DoPushLexicalVar4LP", "DoPushLexicalVar4SP", "DoPushLexicalVar4IM", /* #o024 */ + "DoPushLexicalVar5FP", "DoPushLexicalVar5LP", "DoPushLexicalVar5SP", "DoPushLexicalVar5IM", /* #o025 */ + "DoPushLexicalVar6FP", "DoPushLexicalVar6LP", "DoPushLexicalVar6SP", "DoPushLexicalVar6IM", /* #o026 */ + "DoPushLexicalVar7FP", "DoPushLexicalVar7LP", "DoPushLexicalVar7SP", "DoPushLexicalVar7IM", /* #o027 */ + "DoBlock0WriteFP", "DoBlock0WriteLP", "DoBlock0WriteSP", "DoBlock0WriteIM", /* #o030 */ + "DoBlock1WriteFP", "DoBlock1WriteLP", "DoBlock1WriteSP", "DoBlock1WriteIM", /* #o031 */ + "DoBlock2WriteFP", "DoBlock2WriteLP", "DoBlock2WriteSP", "DoBlock2WriteIM", /* #o032 */ + "DoBlock3WriteFP", "DoBlock3WriteLP", "DoBlock3WriteSP", "DoBlock3WriteIM", /* #o033 */ + "DoZeropFP", "DoZeropLP", "DoZeropSP", "DoZeropIM", /* #o034 */ + "DoMinuspFP", "DoMinuspLP", "DoMinuspSP", "DoMinuspIM", /* #o035 */ + "DoPluspFP", "DoPluspLP", "DoPluspSP", "DoPluspIM", /* #o036 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o037 */ + "DoTypeMember0FP", "DoTypeMember0LP", "DoTypeMember0SP", "DoTypeMember0IM", /* #o040 */ + "DoTypeMember1FP", "DoTypeMember1LP", "DoTypeMember1SP", "DoTypeMember1IM", /* #o041 */ + "DoTypeMember2FP", "DoTypeMember2LP", "DoTypeMember2SP", "DoTypeMember2IM", /* #o042 */ + "DoTypeMember3FP", "DoTypeMember3LP", "DoTypeMember3SP", "DoTypeMember3IM", /* #o043 */ + "DoTypeMemberNoPop0FP", "DoTypeMemberNoPop0LP", "DoTypeMemberNoPop0SP", "DoTypeMemberNoPop0IM", /* #o044 */ + "DoTypeMemberNoPop1FP", "DoTypeMemberNoPop1LP", "DoTypeMemberNoPop1SP", "DoTypeMemberNoPop1IM", /* #o045 */ + "DoTypeMemberNoPop2FP", "DoTypeMemberNoPop2LP", "DoTypeMemberNoPop2SP", "DoTypeMemberNoPop2IM", /* #o046 */ + "DoTypeMemberNoPop3FP", "DoTypeMemberNoPop3LP", "DoTypeMemberNoPop3SP", "DoTypeMemberNoPop3IM", /* #o047 */ + "DoLocateLocalsFP", "DoLocateLocalsLP", "DoLocateLocalsSP", "DoLocateLocalsIM", /* #o050 */ + "DoCatchCloseFP", "DoCatchCloseLP", "DoCatchCloseSP", "DoCatchCloseIM", /* #o051 */ + "DoGenericDispatchFP", "DoGenericDispatchLP", "DoGenericDispatchSP", "DoGenericDispatchIM", /* #o052 */ + "DoMessageDispatchFP", "DoMessageDispatchLP", "DoMessageDispatchSP", "DoMessageDispatchIM", /* #o053 */ + "DoCheckPreemptRequestFP", "DoCheckPreemptRequestLP", "DoCheckPreemptRequestSP", "DoCheckPreemptRequestIM", /* #o054 */ + "DoPushGlobalLogicVariableFP", "DoPushGlobalLogicVariableLP", "DoPushGlobalLogicVariableSP", "DoPushGlobalLogicVariableIM", /* #o055 */ + "DoNoOpFP", "DoNoOpLP", "DoNoOpSP", "DoNoOpIM", /* #o056 */ + "DoHaltFP", "DoHaltLP", "DoHaltSP", "DoHaltIM", /* #o057 */ + "DoBranchTrueFP", "DoBranchTrueLP", "DoBranchTrueSP", "DoBranchTrueIM", /* #o060 */ + "DoBranchTrueElseExtraPopFP", "DoBranchTrueElseExtraPopLP", "DoBranchTrueElseExtraPopSP", "DoBranchTrueElseExtraPopIM", /* #o061 */ + "DoBranchTrueAndExtraPopFP", "DoBranchTrueAndExtraPopLP", "DoBranchTrueAndExtraPopSP", "DoBranchTrueAndExtraPopIM", /* #o062 */ + "DoBranchTrueExtraPopFP", "DoBranchTrueExtraPopLP", "DoBranchTrueExtraPopSP", "DoBranchTrueExtraPopIM", /* #o063 */ + "DoBranchTrueNoPopFP", "DoBranchTrueNoPopLP", "DoBranchTrueNoPopSP", "DoBranchTrueNoPopIM", /* #o064 */ + "DoBranchTrueAndNoPopFP", "DoBranchTrueAndNoPopLP", "DoBranchTrueAndNoPopSP", "DoBranchTrueAndNoPopIM", /* #o065 */ + "DoBranchTrueElseNoPopFP", "DoBranchTrueElseNoPopLP", "DoBranchTrueElseNoPopSP", "DoBranchTrueElseNoPopIM", /* #o066 */ + "DoBranchTrueAndNoPopElseNoPopExtraPopFP", "DoBranchTrueAndNoPopElseNoPopExtraPopLP", "DoBranchTrueAndNoPopElseNoPopExtraPopSP", "DoBranchTrueAndNoPopElseNoPopExtraPopIM", /* #o067 */ + "DoBranchFalseFP", "DoBranchFalseLP", "DoBranchFalseSP", "DoBranchFalseIM", /* #o070 */ + "DoBranchFalseElseExtraPopFP", "DoBranchFalseElseExtraPopLP", "DoBranchFalseElseExtraPopSP", "DoBranchFalseElseExtraPopIM", /* #o071 */ + "DoBranchFalseAndExtraPopFP", "DoBranchFalseAndExtraPopLP", "DoBranchFalseAndExtraPopSP", "DoBranchFalseAndExtraPopIM", /* #o072 */ + "DoBranchFalseExtraPopFP", "DoBranchFalseExtraPopLP", "DoBranchFalseExtraPopSP", "DoBranchFalseExtraPopIM", /* #o073 */ + "DoBranchFalseNoPopFP", "DoBranchFalseNoPopLP", "DoBranchFalseNoPopSP", "DoBranchFalseNoPopIM", /* #o074 */ + "DoBranchFalseAndNoPopFP", "DoBranchFalseAndNoPopLP", "DoBranchFalseAndNoPopSP", "DoBranchFalseAndNoPopIM", /* #o075 */ + "DoBranchFalseElseNoPopFP", "DoBranchFalseElseNoPopLP", "DoBranchFalseElseNoPopSP", "DoBranchFalseElseNoPopIM", /* #o076 */ + "DoBranchFalseAndNoPopElseNoPopExtraPopFP", "DoBranchFalseAndNoPopElseNoPopExtraPopLP", "DoBranchFalseAndNoPopElseNoPopExtraPopSP", "DoBranchFalseAndNoPopElseNoPopExtraPopIM", /* #o077 */ + "DoPushFP", "DoPushLP", "DoPushSP", "DoPushIM", /* #o0100 */ + "DoPushNNilsFP", "DoPushNNilsLP", "DoPushNNilsSP", "DoPushNNilsIM", /* #o0101 */ + "DoPushAddressSpRelativeFP", "DoPushAddressSpRelativeLP", "DoPushAddressSpRelativeSP", "DoPushAddressSpRelativeIM", /* #o0102 */ + "DoPushLocalLogicVariablesFP", "DoPushLocalLogicVariablesLP", "DoPushLocalLogicVariablesSP", "DoPushLocalLogicVariablesIM", /* #o0103 */ + "DoReturnMultipleFP", "DoReturnMultipleLP", "DoReturnMultipleSP", "DoReturnMultipleIM", /* #o0104 */ + "DoReturnKludgeFP", "DoReturnKludgeLP", "DoReturnKludgeSP", "DoReturnKludgeIM", /* #o0105 */ + "DoTakeValuesFP", "DoTakeValuesLP", "DoTakeValuesSP", "DoTakeValuesIM", /* #o0106 */ + "DoUnbindNFP", "DoUnbindNLP", "DoUnbindNSP", "DoUnbindNIM", /* #o0107 */ + "DoPushInstanceVariableFP", "DoPushInstanceVariableLP", "DoPushInstanceVariableSP", "DoPushInstanceVariableIM", /* #o0110 */ + "DoPushAddressInstanceVariableFP", "DoPushAddressInstanceVariableLP", "DoPushAddressInstanceVariableSP", "DoPushAddressInstanceVariableIM", /* #o0111 */ + "DoPushInstanceVariableOrderedFP", "DoPushInstanceVariableOrderedLP", "DoPushInstanceVariableOrderedSP", "DoPushInstanceVariableOrderedIM", /* #o0112 */ + "DoPushAddressInstanceVariableOrderedFP", "DoPushAddressInstanceVariableOrderedLP", "DoPushAddressInstanceVariableOrderedSP", "DoPushAddressInstanceVariableOrderedIM", /* #o0113 */ + "DoUnaryMinusFP", "DoUnaryMinusLP", "DoUnaryMinusSP", "DoUnaryMinusIM", /* #o0114 */ + "DoReturnSingleFP", "DoReturnSingleLP", "DoReturnSingleSP", "DoReturnSingleIM", /* #o0115 */ + "DoMemoryReadFP", "DoMemoryReadLP", "DoMemoryReadSP", "DoMemoryReadIM", /* #o0116 */ + "DoMemoryReadAddressFP", "DoMemoryReadAddressLP", "DoMemoryReadAddressSP", "DoMemoryReadAddressIM", /* #o0117 */ + "DoBlock0ReadFP", "DoBlock0ReadLP", "DoBlock0ReadSP", "DoBlock0ReadIM", /* #o0120 */ + "DoBlock1ReadFP", "DoBlock1ReadLP", "DoBlock1ReadSP", "DoBlock1ReadIM", /* #o0121 */ + "DoBlock2ReadFP", "DoBlock2ReadLP", "DoBlock2ReadSP", "DoBlock2ReadIM", /* #o0122 */ + "DoBlock3ReadFP", "DoBlock3ReadLP", "DoBlock3ReadSP", "DoBlock3ReadIM", /* #o0123 */ + "DoBlock0ReadShiftFP", "DoBlock0ReadShiftLP", "DoBlock0ReadShiftSP", "DoBlock0ReadShiftIM", /* #o0124 */ + "DoBlock1ReadShiftFP", "DoBlock1ReadShiftLP", "DoBlock1ReadShiftSP", "DoBlock1ReadShiftIM", /* #o0125 */ + "DoBlock2ReadShiftFP", "DoBlock2ReadShiftLP", "DoBlock2ReadShiftSP", "DoBlock2ReadShiftIM", /* #o0126 */ + "DoBlock3ReadShiftFP", "DoBlock3ReadShiftLP", "DoBlock3ReadShiftSP", "DoBlock3ReadShiftIM", /* #o0127 */ + "DoBlock0ReadTestFP", "DoBlock0ReadTestLP", "DoBlock0ReadTestSP", "DoBlock0ReadTestIM", /* #o0130 */ + "DoBlock1ReadTestFP", "DoBlock1ReadTestLP", "DoBlock1ReadTestSP", "DoBlock1ReadTestIM", /* #o0131 */ + "DoBlock2ReadTestFP", "DoBlock2ReadTestLP", "DoBlock2ReadTestSP", "DoBlock2ReadTestIM", /* #o0132 */ + "DoBlock3ReadTestFP", "DoBlock3ReadTestLP", "DoBlock3ReadTestSP", "DoBlock3ReadTestIM", /* #o0133 */ + "DoFinishCallNFP", "DoFinishCallNLP", "DoFinishCallNSP", "DoFinishCallNIM", /* #o0134 */ + "DoFinishCallNApplyFP", "DoFinishCallNApplyLP", "DoFinishCallNApplySP", "DoFinishCallNApplyIM", /* #o0135 */ + "DoFinishCallTosFP", "DoFinishCallTosLP", "DoFinishCallTosSP", "DoFinishCallTosIM", /* #o0136 */ + "DoFinishCallTosApplyFP", "DoFinishCallTosApplyLP", "DoFinishCallTosApplySP", "DoFinishCallTosApplyIM", /* #o0137 */ + "DoSetToCarFP", "DoSetToCarLP", "DoSetToCarSP", "DoSetToCarIM", /* #o0140 */ + "DoSetToCdrFP", "DoSetToCdrLP", "DoSetToCdrSP", "DoSetToCdrIM", /* #o0141 */ + "DoSetToCdrPushCarFP", "DoSetToCdrPushCarLP", "DoSetToCdrPushCarSP", "DoSetToCdrPushCarIM", /* #o0142 */ + "DoIncrementFP", "DoIncrementLP", "DoIncrementSP", "DoIncrementIM", /* #o0143 */ + "DoDecrementFP", "DoDecrementLP", "DoDecrementSP", "DoDecrementIM", /* #o0144 */ + "DoPointerIncrementFP", "DoPointerIncrementLP", "DoPointerIncrementSP", "DoPointerIncrementIM", /* #o0145 */ + "DoSetCdrCode1FP", "DoSetCdrCode1LP", "DoSetCdrCode1SP", "DoSetCdrCode1IM", /* #o0146 */ + "DoSetCdrCode2FP", "DoSetCdrCode2LP", "DoSetCdrCode2SP", "DoSetCdrCode2IM", /* #o0147 */ + "DoPushAddressFP", "DoPushAddressLP", "DoPushAddressSP", "DoPushAddressIM", /* #o0150 */ + "DoSetSpToAddressFP", "DoSetSpToAddressLP", "DoSetSpToAddressSP", "DoSetSpToAddressIM", /* #o0151 */ + "DoSetSpToAddressSaveTosFP", "DoSetSpToAddressSaveTosLP", "DoSetSpToAddressSaveTosSP", "DoSetSpToAddressSaveTosIM", /* #o0152 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0153 */ + "DoReadInternalRegisterFP", "DoReadInternalRegisterLP", "DoReadInternalRegisterSP", "DoReadInternalRegisterIM", /* #o0154 */ + "DoWriteInternalRegisterFP", "DoWriteInternalRegisterLP", "DoWriteInternalRegisterSP", "DoWriteInternalRegisterIM", /* #o0155 */ + "DoCoprocessorReadFP", "DoCoprocessorReadLP", "DoCoprocessorReadSP", "DoCoprocessorReadIM", /* #o0156 */ + "DoCoprocessorWriteFP", "DoCoprocessorWriteLP", "DoCoprocessorWriteSP", "DoCoprocessorWriteIM", /* #o0157 */ + "DoBlock0ReadAluFP", "DoBlock0ReadAluLP", "DoBlock0ReadAluSP", "DoBlock0ReadAluIM", /* #o0160 */ + "DoBlock1ReadAluFP", "DoBlock1ReadAluLP", "DoBlock1ReadAluSP", "DoBlock1ReadAluIM", /* #o0161 */ + "DoBlock2ReadAluFP", "DoBlock2ReadAluLP", "DoBlock2ReadAluSP", "DoBlock2ReadAluIM", /* #o0162 */ + "DoBlock3ReadAluFP", "DoBlock3ReadAluLP", "DoBlock3ReadAluSP", "DoBlock3ReadAluIM", /* #o0163 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0164 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0165 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0166 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0167 */ + "DoLdbFP", "DoLdbLP", "DoLdbSP", "DoLdbIM", /* #o0170 */ + "DoCharLdbFP", "DoCharLdbLP", "DoCharLdbSP", "DoCharLdbIM", /* #o0171 */ + "DoPLdbFP", "DoPLdbLP", "DoPLdbSP", "DoPLdbIM", /* #o0172 */ + "DoPTagLdbFP", "DoPTagLdbLP", "DoPTagLdbSP", "DoPTagLdbIM", /* #o0173 */ + "DoBranchFP", "DoBranchLP", "DoBranchSP", "DoBranchIM", /* #o0174 */ + "DoLoopDecrementTosFP", "DoLoopDecrementTosLP", "DoLoopDecrementTosSP", "DoLoopDecrementTosIM", /* #o0175 */ + "DoEntryRestAcceptedFP", "DoEntryRestAcceptedLP", "DoEntryRestAcceptedSP", "DoEntryRestAcceptedIM", /* #o0176 */ + "DoEntryRestNotAcceptedFP", "DoEntryRestNotAcceptedLP", "DoEntryRestNotAcceptedSP", "DoEntryRestNotAcceptedIM", /* #o0177 */ + "DoRplacaFP", "DoRplacaLP", "DoRplacaSP", "DoRplacaIM", /* #o0200 */ + "DoRplacdFP", "DoRplacdLP", "DoRplacdSP", "DoRplacdIM", /* #o0201 */ + "DoMultiplyFP", "DoMultiplyLP", "DoMultiplySP", "DoMultiplyIM", /* #o0202 */ + "DoQuotientFP", "DoQuotientLP", "DoQuotientSP", "DoQuotientIM", /* #o0203 */ + "DoCeilingFP", "DoCeilingLP", "DoCeilingSP", "DoCeilingIM", /* #o0204 */ + "DoFloorFP", "DoFloorLP", "DoFloorSP", "DoFloorIM", /* #o0205 */ + "DoTruncateFP", "DoTruncateLP", "DoTruncateSP", "DoTruncateIM", /* #o0206 */ + "DoRoundFP", "DoRoundLP", "DoRoundSP", "DoRoundIM", /* #o0207 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0210 */ + "DoRationalQuotientFP", "DoRationalQuotientLP", "DoRationalQuotientSP", "DoRationalQuotientIM", /* #o0211 */ + "DoMinFP", "DoMinLP", "DoMinSP", "DoMinIM", /* #o0212 */ + "DoMaxFP", "DoMaxLP", "DoMaxSP", "DoMaxIM", /* #o0213 */ + "DoAluFP", "DoAluLP", "DoAluSP", "DoAluIM", /* #o0214 */ + "DoLogandFP", "DoLogandLP", "DoLogandSP", "DoLogandIM", /* #o0215 */ + "DoLogxorFP", "DoLogxorLP", "DoLogxorSP", "DoLogxorIM", /* #o0216 */ + "DoLogiorFP", "DoLogiorLP", "DoLogiorSP", "DoLogiorIM", /* #o0217 */ + "DoRotFP", "DoRotLP", "DoRotSP", "DoRotIM", /* #o0220 */ + "DoLshFP", "DoLshLP", "DoLshSP", "DoLshIM", /* #o0221 */ + "DoMultiplyDoubleFP", "DoMultiplyDoubleLP", "DoMultiplyDoubleSP", "DoMultiplyDoubleIM", /* #o0222 */ + "DoLshcBignumStepFP", "DoLshcBignumStepLP", "DoLshcBignumStepSP", "DoLshcBignumStepIM", /* #o0223 */ + "DoStackBltFP", "DoStackBltLP", "DoStackBltSP", "DoStackBltIM", /* #o0224 */ + "DoRgetfFP", "DoRgetfLP", "DoRgetfSP", "DoRgetfIM", /* #o0225 */ + "DoMemberFP", "DoMemberLP", "DoMemberSP", "DoMemberIM", /* #o0226 */ + "DoAssocFP", "DoAssocLP", "DoAssocSP", "DoAssocIM", /* #o0227 */ + "DoPointerPlusFP", "DoPointerPlusLP", "DoPointerPlusSP", "DoPointerPlusIM", /* #o0230 */ + "DoPointerDifferenceFP", "DoPointerDifferenceLP", "DoPointerDifferenceSP", "DoPointerDifferenceIM", /* #o0231 */ + "DoAshFP", "DoAshLP", "DoAshSP", "DoAshIM", /* #o0232 */ + "DoStoreConditionalFP", "DoStoreConditionalLP", "DoStoreConditionalSP", "DoStoreConditionalIM", /* #o0233 */ + "DoMemoryWriteFP", "DoMemoryWriteLP", "DoMemoryWriteSP", "DoMemoryWriteIM", /* #o0234 */ + "DoPStoreContentsFP", "DoPStoreContentsLP", "DoPStoreContentsSP", "DoPStoreContentsIM", /* #o0235 */ + "DoBindLocativeToValueFP", "DoBindLocativeToValueLP", "DoBindLocativeToValueSP", "DoBindLocativeToValueIM", /* #o0236 */ + "DoUnifyFP", "DoUnifyLP", "DoUnifySP", "DoUnifyIM", /* #o0237 */ + "DoPopLexicalVar0FP", "DoPopLexicalVar0LP", "DoPopLexicalVar0SP", "DoPopLexicalVar0IM", /* #o0240 */ + "DoPopLexicalVar1FP", "DoPopLexicalVar1LP", "DoPopLexicalVar1SP", "DoPopLexicalVar1IM", /* #o0241 */ + "DoPopLexicalVar2FP", "DoPopLexicalVar2LP", "DoPopLexicalVar2SP", "DoPopLexicalVar2IM", /* #o0242 */ + "DoPopLexicalVar3FP", "DoPopLexicalVar3LP", "DoPopLexicalVar3SP", "DoPopLexicalVar3IM", /* #o0243 */ + "DoPopLexicalVar4FP", "DoPopLexicalVar4LP", "DoPopLexicalVar4SP", "DoPopLexicalVar4IM", /* #o0244 */ + "DoPopLexicalVar5FP", "DoPopLexicalVar5LP", "DoPopLexicalVar5SP", "DoPopLexicalVar5IM", /* #o0245 */ + "DoPopLexicalVar6FP", "DoPopLexicalVar6LP", "DoPopLexicalVar6SP", "DoPopLexicalVar6IM", /* #o0246 */ + "DoPopLexicalVar7FP", "DoPopLexicalVar7LP", "DoPopLexicalVar7SP", "DoPopLexicalVar7IM", /* #o0247 */ + "DoMovemLexicalVar0FP", "DoMovemLexicalVar0LP", "DoMovemLexicalVar0SP", "DoMovemLexicalVar0IM", /* #o0250 */ + "DoMovemLexicalVar1FP", "DoMovemLexicalVar1LP", "DoMovemLexicalVar1SP", "DoMovemLexicalVar1IM", /* #o0251 */ + "DoMovemLexicalVar2FP", "DoMovemLexicalVar2LP", "DoMovemLexicalVar2SP", "DoMovemLexicalVar2IM", /* #o0252 */ + "DoMovemLexicalVar3FP", "DoMovemLexicalVar3LP", "DoMovemLexicalVar3SP", "DoMovemLexicalVar3IM", /* #o0253 */ + "DoMovemLexicalVar4FP", "DoMovemLexicalVar4LP", "DoMovemLexicalVar4SP", "DoMovemLexicalVar4IM", /* #o0254 */ + "DoMovemLexicalVar5FP", "DoMovemLexicalVar5LP", "DoMovemLexicalVar5SP", "DoMovemLexicalVar5IM", /* #o0255 */ + "DoMovemLexicalVar6FP", "DoMovemLexicalVar6LP", "DoMovemLexicalVar6SP", "DoMovemLexicalVar6IM", /* #o0256 */ + "DoMovemLexicalVar7FP", "DoMovemLexicalVar7LP", "DoMovemLexicalVar7SP", "DoMovemLexicalVar7IM", /* #o0257 */ + "DoEqualNumberFP", "DoEqualNumberLP", "DoEqualNumberSP", "DoEqualNumberIM", /* #o0260 */ + "DoLesspFP", "DoLesspLP", "DoLesspSP", "DoLesspIM", /* #o0261 */ + "DoGreaterpFP", "DoGreaterpLP", "DoGreaterpSP", "DoGreaterpIM", /* #o0262 */ + "DoEqlFP", "DoEqlLP", "DoEqlSP", "DoEqlIM", /* #o0263 */ + "DoEqualNumberNoPopFP", "DoEqualNumberNoPopLP", "DoEqualNumberNoPopSP", "DoEqualNumberNoPopIM", /* #o0264 */ + "DoLesspNoPopFP", "DoLesspNoPopLP", "DoLesspNoPopSP", "DoLesspNoPopIM", /* #o0265 */ + "DoGreaterpNoPopFP", "DoGreaterpNoPopLP", "DoGreaterpNoPopSP", "DoGreaterpNoPopIM", /* #o0266 */ + "DoEqlNoPopFP", "DoEqlNoPopLP", "DoEqlNoPopSP", "DoEqlNoPopIM", /* #o0267 */ + "DoEqFP", "DoEqLP", "DoEqSP", "DoEqIM", /* #o0270 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0271 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0272 */ + "DoLogtestFP", "DoLogtestLP", "DoLogtestSP", "DoLogtestIM", /* #o0273 */ + "DoEqNoPopFP", "DoEqNoPopLP", "DoEqNoPopSP", "DoEqNoPopIM", /* #o0274 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0275 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0276 */ + "DoLogtestNoPopFP", "DoLogtestNoPopLP", "DoLogtestNoPopSP", "DoLogtestNoPopIM", /* #o0277 */ + "DoAddFP", "DoAddLP", "DoAddSP", "DoAddIM", /* #o0300 */ + "DoSubFP", "DoSubLP", "DoSubSP", "DoSubIM", /* #o0301 */ + "Do32BitPlusFP", "Do32BitPlusLP", "Do32BitPlusSP", "Do32BitPlusIM", /* #o0302 */ + "Do32BitDifferenceFP", "Do32BitDifferenceLP", "Do32BitDifferenceSP", "Do32BitDifferenceIM", /* #o0303 */ + "DoAddBignumStepFP", "DoAddBignumStepLP", "DoAddBignumStepSP", "DoAddBignumStepIM", /* #o0304 */ + "DoSubBignumStepFP", "DoSubBignumStepLP", "DoSubBignumStepSP", "DoSubBignumStepIM", /* #o0305 */ + "DoMultiplyBignumStepFP", "DoMultiplyBignumStepLP", "DoMultiplyBignumStepSP", "DoMultiplyBignumStepIM", /* #o0306 */ + "DoDivideBignumStepFP", "DoDivideBignumStepLP", "DoDivideBignumStepSP", "DoDivideBignumStepIM", /* #o0307 */ + "DoAset1FP", "DoAset1LP", "DoAset1SP", "DoAset1IM", /* #o0310 */ + "DoAllocateListBlockFP", "DoAllocateListBlockLP", "DoAllocateListBlockSP", "DoAllocateListBlockIM", /* #o0311 */ + "DoAref1FP", "DoAref1LP", "DoAref1SP", "DoAref1IM", /* #o0312 */ + "DoAloc1FP", "DoAloc1LP", "DoAloc1SP", "DoAloc1IM", /* #o0313 */ + "DoStoreArrayLeaderFP", "DoStoreArrayLeaderLP", "DoStoreArrayLeaderSP", "DoStoreArrayLeaderIM", /* #o0314 */ + "DoAllocateStructureBlockFP", "DoAllocateStructureBlockLP", "DoAllocateStructureBlockSP", "DoAllocateStructureBlockIM", /* #o0315 */ + "DoArrayLeaderFP", "DoArrayLeaderLP", "DoArrayLeaderSP", "DoArrayLeaderIM", /* #o0316 */ + "DoAlocLeaderFP", "DoAlocLeaderLP", "DoAlocLeaderSP", "DoAlocLeaderIM", /* #o0317 */ + "DoPopInstanceVariableFP", "DoPopInstanceVariableLP", "DoPopInstanceVariableSP", "DoPopInstanceVariableIM", /* #o0320 */ + "DoMovemInstanceVariableFP", "DoMovemInstanceVariableLP", "DoMovemInstanceVariableSP", "DoMovemInstanceVariableIM", /* #o0321 */ + "DoPopInstanceVariableOrderedFP", "DoPopInstanceVariableOrderedLP", "DoPopInstanceVariableOrderedSP", "DoPopInstanceVariableOrderedIM", /* #o0322 */ + "DoMovemInstanceVariableOrderedFP", "DoMovemInstanceVariableOrderedLP", "DoMovemInstanceVariableOrderedSP", "DoMovemInstanceVariableOrderedIM", /* #o0323 */ + "DoInstanceRefFP", "DoInstanceRefLP", "DoInstanceRefSP", "DoInstanceRefIM", /* #o0324 */ + "DoInstanceSetFP", "DoInstanceSetLP", "DoInstanceSetSP", "DoInstanceSetIM", /* #o0325 */ + "DoInstanceLocFP", "DoInstanceLocLP", "DoInstanceLocSP", "DoInstanceLocIM", /* #o0326 */ + "DoSetTagFP", "DoSetTagLP", "DoSetTagSP", "DoSetTagIM", /* #o0327 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0330 */ + "DoUnsignedLesspFP", "DoUnsignedLesspLP", "DoUnsignedLesspSP", "DoUnsignedLesspIM", /* #o0331 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0332 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0333 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0334 */ + "DoUnsignedLesspNoPopFP", "DoUnsignedLesspNoPopLP", "DoUnsignedLesspNoPopSP", "DoUnsignedLesspNoPopIM", /* #o0335 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0336 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0337 */ + "DoPopFP", "DoPopLP", "DoPopSP", "DoPopIM", /* #o0340 */ + "DoMovemFP", "DoMovemLP", "DoMovemSP", "DoMovemIM", /* #o0341 */ + "DoMergeCdrNoPopFP", "DoMergeCdrNoPopLP", "DoMergeCdrNoPopSP", "DoMergeCdrNoPopIM", /* #o0342 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0343 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0344 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0345 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0346 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0347 */ + "DoFastAref1FP", "DoFastAref1LP", "DoFastAref1SP", "DoFastAref1IM", /* #o0350 */ + "DoFastAset1FP", "DoFastAset1LP", "DoFastAset1SP", "DoFastAset1IM", /* #o0351 */ + "DoStackBltAddressFP", "DoStackBltAddressLP", "DoStackBltAddressSP", "DoStackBltAddressIM", /* #o0352 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0353 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0354 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0355 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0356 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0357 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0360 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0361 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0362 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0363 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0364 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0365 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0366 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0367 */ + "DoDpbFP", "DoDpbLP", "DoDpbSP", "DoDpbIM", /* #o0370 */ + "DoCharDpbFP", "DoCharDpbLP", "DoCharDpbSP", "DoCharDpbIM", /* #o0371 */ + "DoPDpbFP", "DoPDpbLP", "DoPDpbSP", "DoPDpbIM", /* #o0372 */ + "DoPTagDpbFP", "DoPTagDpbLP", "DoPTagDpbSP", "DoPTagDpbIM", /* #o0373 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0374 */ + "DoLoopIncrementTosLessThanFP", "DoLoopIncrementTosLessThanLP", "DoLoopIncrementTosLessThanSP", "DoLoopIncrementTosLessThanIM", /* #o0375 */ + "DoCatchOpenFP", "DoCatchOpenLP", "DoCatchOpenSP", "DoCatchOpenIM", /* #o0376 */ + "DoSpareOpFP", "DoSpareOpLP", "DoSpareOpSP", "DoSpareOpIM", /*#o0377 */ +}; + +void +dumpstack(void) +{ +#if 0 + u64 *p = (u64 *)iSP; + int i; + + printf("iPC %p, iSP %p\n", iPC, iSP); + for (i = 0; i < 5; i++) { + printf("%p: %016llx\n", p, *p); + if ((u64)p == 0xfffffc000) + break; + p--; + } + + // if (iPC == 0x1f000000e) exit(1); + // { static int c = 0; if (++c == 10000) exit(1); } +#endif +} + + +/* idispat */ +// +// jj +// +//jmp_buf arex_env ; +void *arexp ; +uint64_t iipsp ; +#ifdef STATISTICS +void DumpInstructionUsageData( void ); +#ifdef EXECTIMES +uint32_t _lastcode = 0xFFFF ; +uint64_t _lastinststart = 0; +struct rusage _rusage ; +uint64_t _exectimes[0x2000]; +#endif // EXECTIMES +#endif + +int iInterpret (PROCESSORSTATEP ivoryp) { + PROCESSORSTATEP processor; + u64 ivory = (u64)ivoryp; + int _trace = 0; + int _show = 0; + u64 cpustack[1024]; + + u64 r0; + u64 volatile instn; + u64 iword, ecp, ocp, icsize; + u64 volatile epc, opc; + u64 volatile count; + u64 r9; + u64 volatile r10, r11; + u64 r12, r13, r14=0; + u64 volatile r15, r16; + u64 volatile r17; + u64 r18, r19; + u64 volatile r20, r21, r22, r23, r24, r25, r26, r27, r29; + u64 sp; + u64 r31 = 0; + // + // jj + // + int im1 ; + + arexp = &&arex; + asm("movq %%rsp,%0" : "=m"(iipsp) : : ); + // +#include "dispatch" +#ifdef STATISTICS + extern void *_copyhalfworddispatch[]; + extern void *_copyfullworddispatch[]; +// copy the _halfworddispatch and _fullworddispatch tables + memcpy(_copyhalfworddispatch,_halfworddispatch,256*4*8); + memcpy(_copyfullworddispatch,_fullworddispatch,48*8); +#ifdef EXECTIMES + memset(_exectimes,0,sizeof(_exectimes)); +#endif // EXECTIMES +#endif + +void +dumpcache(PROCESSORSTATEP p) +{ + CACHELINEP c, ce; + int i, n; + char *name; + + printf("icachebase %p, endicache %p\n", + processor->icachebase, processor->endicache); + + ce = (CACHELINEP)processor->endicache; + for (c = (CACHELINEP)processor->icachebase, n = 0; c <= ce; c++, n++) { + + // if (n > 16) break; + + if (c->pctag == 0 && c->pcdata == 0) + continue; + + for (i = 0; i < 256*4; i++) + if (_halfworddispatch[i] == c->code) + break; + if (i == 256*4) + name = "unknown"; + else + name = halfwordnames[i]; + + printf("%p: nextcp %p pc %08x %08x inst %08x code %p %s\n", + c, c->nextcp, c->pctag, c->pcdata, c->instruction, c->code, name); + } +} + +void +show_loc(void) +{ + static int c = 0; + static u64 bsp; + u64 *p = (u64 *)iSP; + u64 tos = *p; + u32 cc, t, v; + char *str = 0; + int i; + + cc = ((tos >> 32) & 0xc0) >> 6; + t = (tos >> 32) & 0x3f; + v = (u32)tos; + + c++; + // if (c >= 20) exit(1); + if (c == 1) bsp = iSP; + // printf("%d: ", c); + + + for (i = 0; i < 256*4; i++) + if (_halfworddispatch[i] == ((CACHELINEP)iCP)->code) + break; + + if (i == 256*4) + str = 0; + else + str = halfwordnames[i]; + + printf("PC %08x(%s), SP: %08x, TOS: %d.%02x.%08x,%s%s\n", + (int)iPC/2, (iPC&1) ? "Odd" : "Even", + (int)(0xf8000101 + ((iSP - bsp) / 8)), + cc, t, v, str ? " " : "", str ? str : ""); +} + + +// printf("[iInterpret]\n"); + + processor = (PROCESSORSTATEP)((char *)ivory - PROCESSORSTATE_SIZE); + /* printf("%p\n", processor); */ + /* printf("ivory %p\n", ivory); */ + /* printf("epc %p, fp %p, lp %p, sp %p, cp %p\n", */ + /* processor->epc, processor->fp, processor->lp, */ + /* processor->sp, processor->cp); */ + /* printf("icachebase %p, endicache %p\n", */ + /* processor->icachebase, processor->endicache); */ + + /* i still can't believe this works */ + processor->halfworddispatch=(int64_t)_halfworddispatch; + processor->fullworddispatch=(int64_t)_fullworddispatch; + + processor->internalregisterread1 = (int64_t)_internalregisterread1; + processor->internalregisterread2 = (int64_t)_internalregisterread2; + processor->internalregisterwrite1 = (int64_t)_internalregisterwrite1; + processor->internalregisterwrite2 = (int64_t)_internalregisterwrite2; + +processor->stop_interpreter = 0; + + arg1 = (u64)ivoryp; + ra = (u64)&&iguessimdone; + + sp = (u64)&cpustack[1024]; + + if (processor->epc > 0x1f0000000) { +#if 0 +// _trace = 1; + _show = 1; +#endif + } + + feclearexcept(FE_ALL_EXCEPT); + // jj + // fedisableexcept(FE_ALL_EXCEPT); + fedisableexcept(FE_INEXACT); + // jj + + { + extern void *DECODEFAULT, *ICACHEMISS; + DECODEFAULT = &&decodefault; + ICACHEMISS = &&ICACHEMISS; + // + } + + goto iinterpret; + + iguessimdone: + // printf("I guess I'm done!! r1 %p\n", (int)r1); + //if (_show) while (1); +#ifdef STATISTICS + DumpInstructionUsageData(); +#endif + return r1; + +#include "ifunhead.c" +#include "idispat.c" +#include "ifuncom1.c" +#include "ifuncom2.c" +#include "ifungene.c" +#include "ifunfcal.c" +#include "ifunloop.c" +#include "ifunlist.c" +#include "ifuninst.c" +#include "ifunmath.c" +#include "ifunarra.c" +#include "ifunmove.c" +#include "ifunpred.c" +#include "ifunsubp.c" +#include "ifunfext.c" +#include "ifunlexi.c" +#include "ifunbits.c" +#include "ifunblok.c" +#include "ifunbind.c" +#include "ifunfull.c" +#include "ifunbnum.c" +#include "ifuntrap.c" +#include "ihalt.c" +#include "idouble.c" +#include "ifunjosh.c" +#include "ifuntran.c" +} + +void SpinWheels () { + int i; + for (i = 0; i < 0x2000000; i++); + } + +#include "blanks.c" + diff --git a/support/clear-all-histories.lisp b/support/clear-all-histories.lisp new file mode 100644 index 0000000..c8d61d4 --- /dev/null +++ b/support/clear-all-histories.lisp @@ -0,0 +1,72 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Reason: CLIM Command M-DBG::COM-CLEAR-OUTPUT-HISTORY: . +;;; Written by Palter, 1/08/93 18:15:39 +;;; while running on Sour Cream from FEP0:>dMinima-49-D.ilod.1 +;;; with Experimental System 447.22, Experimental CLOS 433.0, Experimental RPC 437.0, +;;; Experimental Embedding Support 429.1, Experimental MacIvory Support 443.1, +;;; Experimental UX Support 438.0, Experimental Development Utilities 433.0, +;;; Experimental Old TV 431.0, Experimental Zwei 431.3, Experimental Utilities 440.4, +;;; Experimental RPC Development 432.0, Experimental MacIvory Development 430.0, +;;; Experimental UX Development 437.0, Experimental Server Utilities 438.0, +;;; Experimental Serial 431.0, Experimental Hardcopy 441.1, Experimental Zmail 438.0, +;;; Experimental LMFS Defstorage 416.0, Experimental SCSI 427.3, +;;; Experimental Tape 440.0, Experimental LMFS 439.0, Experimental NSage 436.1, +;;; Experimental Extended Help 437.0, Experimental CL Developer 424.0, +;;; Experimental Documentation Database 435.2, Experimental IP-TCP 447.2, +;;; Experimental IP-TCP Documentation 418.0, Experimental CLX 443.0, +;;; Experimental X Remote Screen 441.2, Experimental X Documentation 417.0, +;;; Experimental NFS Client 437.0, Experimental NFS Documentation 419.0, +;;; Experimental Serial Networks 4.3, Experimental Serial Networks Documentation 5.0, +;;; Experimental DNA 435.0, Experimental Metering 440.0, +;;; Experimental Metering Substrate 440.0, Experimental Conversion Tools 432.0, +;;; Experimental Hacks 436.0, Experimental Mac Dex 429.0, +;;; Experimental HyperCard/MacIvory 429.0, Statice Runtime 461.3, Statice 461.1, +;;; Statice Browser 461.0, Experimental Statice Documentation 422.0, +;;; Experimental CLIM 63.6, Experimental Genera CLIM 63.2, +;;; Experimental CLX CLIM 63.0, Experimental PostScript CLIM 63.1, +;;; Experimental CLIM Documentation 40.0, Experimental CLIM Demo 63.3, +;;; Experimental Symbolics Concordia 440.1, +;;; Experimental Essential Image Substrate 428.0, Experimental Image Substrate 436.0, +;;; Experimental Graphic Editing Documentation 428.0, +;;; Experimental Graphic Editing 437.0, Experimental Graphic Editor 436.0, +;;; Experimental Bitmap Editor 437.0, Experimental Postscript 432.0, +;;; Experimental Concordia Documentation 428.0, Experimental Lock Simple 433.0, +;;; Experimental Producer 417.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 439.1, +;;; Symbolics In-House Documentation 420.0, SCRC 437.0, Weather User 421.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 52.2, +;;; Experimental IFEP Kernel 329.5, Experimental IFEP Utilities 329.1, +;;; Experimental Minima Developer 49.4, Experimental Minima Kernel 32.10, +;;; Experimental Minima Debugger 29.2, Experimental Minima Documentation 21.0, +;;; Palter's Environment 24.0, cold load 1, Ivory Revision 4A (FPA enabled), FEP 329, +;;; FEP0:>I329-loaders.flod(4), FEP0:>I329-info.flod(4), FEP0:>I329-debug.flod(4), +;;; FEP0:>I329-lisp.flod(4), FEP0:>I329-kernel.fep(45), Boot ROM version 320, +;;; Device PROM version 325, Genera application 5.6, +;;; MacIvory SCSI Manager Server 4.3.1, Toolbox Servers 4.2, +;;; MacIvory & RPC library 6.3.2, MacIvory life support 4.3.5, +;;; Macintosh System Software 7.1, 1152x806 Screen with Genera fonts, +;;; Machine serial number 30014, Macintosh IIfx, Apple Extended Keyboard II, +;;; Make the Minima Debugger Start commands work without Load World... (from S:>Palter>VLM>start-without-load-world.lisp.1), +;;; Provide access path to UNIX emulator (from VLM:EMULATOR;UNIX-ACCESS-PATH.LISP.6). + + +#+(OR MINIMA-RUNTIME MINIMA-DEVELOPER) (IN-PACKAGE "COMMON-LISP-USER") + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI"); 0(SCT:NOTE-PRIVATE-PATCH "Clear all Minima Debugger histories") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.101") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH + +(define-debugger-command (com-Clear-Output-History :name t) + () + (window-clear *standard-output*) +(2 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") (window-clear *standard-input*)0) + diff --git a/support/clisp-packages.lisp b/support/clisp-packages.lisp new file mode 100644 index 0000000..7aea9b6 --- /dev/null +++ b/support/clisp-packages.lisp @@ -0,0 +1,29 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: COMMON-LISP-USER; Base: 10; Lowercase: Yes -*- +(in-package "COMMON-LISP-USER") + +;;; Packages used by the emulator that aren't defined in OpenMCL + +;;(defpackage LISP +;; (:use COMMON-LISP) +;; (:export "AND" "OR")) + +(defpackage CLOS + (:use COMMON-LISP) + (:export "DEFCLASS" "DEFGENERIC" "DEFMETHOD" "INITIALIZE-INSTANCE" "WITH-SLOTS" + "PRINT-OBJECT" "SLOT-VALUE" "MAKE-INSTANCE")) + +(defpackage FUTURE-COMMON-LISP + (:use COMMON-LISP) + (:export "PRINT-UNREADABLE-OBJECT")) + +;;(defpackage COMPILER +;; (:use COMMON-LISP) +;; (:export "WARN")) + +(defpackage SYSTEM + (:nicknames "SYS") + (:use COMMON-LISP)) + +(defpackage I-LISP-COMPILER + (:use COMMON-LISP) + (:export *FINISH-CALL-N-OPCODE*)) diff --git a/support/clisp-support.lisp b/support/clisp-support.lisp new file mode 100644 index 0000000..c68a7c2 --- /dev/null +++ b/support/clisp-support.lisp @@ -0,0 +1,359 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SYSTEM; Base: 10; Lowercase: Yes -*- + +;;; + +;; (in-package "CCL") + +;; (defmacro defsubst (name arglist &body body) +;; `(progn +;; (declaim (inline ,name)) +;; (defun ,name ,arglist ,@body))) + +(defmacro defsubst (name arglist &body body) + `(progn + (declaim (inline ,name)) + (defun ,name ,arglist ,@body))) + +(defmacro stack-let (vars-and-vals &body body) + (let ((vars (loop for var-and-val in vars-and-vals + if (atom var-and-val) + collect var-and-val + else + collect (first var-and-val)))) + `(let ,vars-and-vals + (declare (dynamic-extent ,@vars)) + ,@body))) + +;; (declaim (inline circular-list)) +;; (defun circular-list (&rest list) +;; (let ((list (copy-list list))) +;; (setf (cdr (last list)) list) +;; list)) + +;;; + +(in-package "SYSTEM") + +;;(defsubst %32-bit-difference (x y) +;; (- x y)) + +(defun %32-bit-difference (x y) + (- x y)) + +(export '(%logldb %logdpb %32-bit-difference)) + +;(ccl::defsubst %logldb (bytespec integer) +; (ldb bytespec integer)) + +;; (ccl::defsubst %logdpb (value bytespec integer) +;; (let ((result (dpb value bytespec integer))) +;; (if (zerop (ldb (byte 1 31) result)) +;; result +;; (- (ldb (byte 31 0) (1+ (lognot result))))))) + +;;(ccl::defsubst %32-bit-difference (x y) +;; (- x y)) + +;;; + +(defmacro defsysconstant (name value) + `(progn + (defconstant ,name ,value) + (export ',name))) + +(defmacro defenumerated (list-name code-list &optional (start 0) (increment 1) end) + (when (and end (not (= (length code-list) (/ (- end start) increment)))) + (error "~s has ~s codes where ~s are required" + list-name (length code-list) (/ (- end start) increment))) + `(progn + (defsysconstant ,list-name ',code-list) + ,@(loop for code in code-list and prev = 0 then code + as value from start by increment + unless (eq code prev) ;kludge for data-types + collect `(defsysconstant ,code ,value)))) + +(defmacro defsysbyte (name size position) + `(defsysconstant ,name (byte ,size ,position))) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDEF.LISP ... +;;; + +;; --- most of the below is L-specific +;; To add a new data type, update the following (at least): +;; *DATA-TYPES* and *POINTER-DATA-TYPES* in this file +;; Patch *DATA-TYPE-NAME*, set up by from *DATA-TYPES* by the cold-load generator +;; type-map-for-transport, transporter-type-map-alist in sys: l-ucode; uu.lisp +;; *storing-type-map* in sys: l-ucode; uux.lisp and reload that whole file +;; It is important that the form near the end of that file that sets up the +;; no-trap type-map be executed before any other type maps are assigned. +;; simulate-transporter in sys: l-ucode; simx.lisp +;; and recompile the whole microcode to get the type-maps updated +;; typep-alist and related stuff in sys: sys; lcons.lisp +;; dbg:*good-data-types* if it is indeed a good data type +;; Send a message to the maintainer of the FEP-resident debugger. + +(DEFENUMERATED *DATA-TYPES* ( + ;; Headers, special markers, and forwarding pointers. + DTP-NULL ;00 Unbound variable/function, uninitialized storage + DTP-MONITOR-FORWARD ;01 This cell being monitored + DTP-HEADER-P ;02 Structure header, with pointer field + DTP-HEADER-I ;03 Structure header, with immediate bits + DTP-EXTERNAL-VALUE-CELL-POINTER ;04 Invisible except for binding + DTP-ONE-Q-FORWARD ;05 Invisible pointer (forwards one cell) + DTP-HEADER-FORWARD ;06 Invisible pointer (forwards whole structure) + DTP-ELEMENT-FORWARD ;07 Invisible pointer in element of structure + ;; Numeric data types. + DTP-FIXNUM ;10 Small integer + DTP-SMALL-RATIO ;11 Ratio with small numerator and denominator + DTP-SINGLE-FLOAT ;12 Single-precision floating point + DTP-DOUBLE-FLOAT ;13 Double-precision floating point + DTP-BIGNUM ;14 Big integer + DTP-BIG-RATIO ;15 Ratio with big numerator or denominator + DTP-COMPLEX ;16 Complex number + DTP-SPARE-NUMBER ;17 A number to the hardware trap mechanism + ;; Instance data types. + DTP-INSTANCE ;20 Ordinary instance + DTP-LIST-INSTANCE ;21 Instance that masquerades as a cons + DTP-ARRAY-INSTANCE ;22 Instance that masquerades as an array + DTP-STRING-INSTANCE ;23 Instance that masquerades as a string + ;; Primitive data types. + DTP-NIL ;24 The symbol NIL + DTP-LIST ;25 A cons + DTP-ARRAY ;26 An array that is not a string + DTP-STRING ;27 A string + DTP-SYMBOL ;30 A symbol other than NIL + DTP-LOCATIVE ;31 Locative pointer + DTP-LEXICAL-CLOSURE ;32 Lexical closure of a function + DTP-DYNAMIC-CLOSURE ;33 Dynamic closure of a function + DTP-COMPILED-FUNCTION ;34 Compiled code + DTP-GENERIC-FUNCTION ;35 Generic function (see later section) + DTP-SPARE-POINTER-1 ;36 Spare + DTP-SPARE-POINTER-2 ;37 Spare + DTP-PHYSICAL-ADDRESS ;40 Physical address + DTP-SPARE-IMMEDIATE-1 ;41 Spare + DTP-BOUND-LOCATION ;42 Deep bound marker + DTP-CHARACTER ;43 Common Lisp character object + DTP-LOGIC-VARIABLE ;44 Unbound logic variable marker + DTP-GC-FORWARD ;45 Object-moved flag for garbage collector + DTP-EVEN-PC ;46 PC at first instruction in word + DTP-ODD-PC ;47 PC at second instruction in word + ;; Full-word instructions. + DTP-CALL-COMPILED-EVEN ;50 Start call, address is compiled function + DTP-CALL-COMPILED-ODD ;51 Start call, address is compiled function + DTP-CALL-INDIRECT ;52 Start call, address is function cell + DTP-CALL-GENERIC ;53 Start call, address is generic function + DTP-CALL-COMPILED-EVEN-PREFETCH ;54 Like above, but prefetching is desireable + DTP-CALL-COMPILED-ODD-PREFETCH ;55 Like above, but prefetching is desireable + DTP-CALL-INDIRECT-PREFETCH ;56 Like above, but prefetching is desireable + DTP-CALL-GENERIC-PREFETCH ;57 Like above, but prefetching is desireable + ;; Half-word (packed) instructions consume 4 bits of data type field (opcodes 60..77). + DTP-PACKED-INSTRUCTION-60 DTP-PACKED-INSTRUCTION-61 DTP-PACKED-INSTRUCTION-62 + DTP-PACKED-INSTRUCTION-63 DTP-PACKED-INSTRUCTION-64 DTP-PACKED-INSTRUCTION-65 + DTP-PACKED-INSTRUCTION-66 DTP-PACKED-INSTRUCTION-67 DTP-PACKED-INSTRUCTION-70 + DTP-PACKED-INSTRUCTION-71 DTP-PACKED-INSTRUCTION-72 DTP-PACKED-INSTRUCTION-73 + DTP-PACKED-INSTRUCTION-74 DTP-PACKED-INSTRUCTION-75 DTP-PACKED-INSTRUCTION-76 + DTP-PACKED-INSTRUCTION-77 + ) + 0 1 #o100) + +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* ( + ARRAY-ELEMENT-TYPE-FIXNUM + ARRAY-ELEMENT-TYPE-CHARACTER + ARRAY-ELEMENT-TYPE-BOOLEAN + ARRAY-ELEMENT-TYPE-OBJECT + )) + +;;; Control register. + +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 8. 0) ;Number of spread arguments supplied by caller +(DEFSYSBYTE %%CR.APPLY 1 17.) ;1 If caller used APPLY, 0 otherwise +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 2 18.) ;The value of this function +(DEFSYSBYTE %%CR.CLEANUP-BITS 3 24.) ;All the cleanup bits +(DEFSYSBYTE %%CR.CLEANUP-CATCH 1 26.) ;There are active catch blocks in the current frame +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 1 25.) ;There are active bindings in the current frame +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 1 24.) ;Software trap before exiting this frame +(DEFSYSBYTE %%CR.TRAP-MODE 2 30.) ;1 If we are executing on the "extra stack" + ;Extra stack inhibits sequence breaks and preemption + ;It also allows the "overflow" part of the stack to + ;be used without traps. +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 1 8.) ;The call instruction supplied an "extra" argument +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 8 9.) ;The frame size of the Caller +(DEFSYSBYTE %%CR.CALL-STARTED 1 22.) ;Between start-call and finish-call. +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 1 23.) +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 1 29.) +(DEFSYSBYTE %%CR.CALL-TRACE 1 28.) +(DEFSYSBYTE %%CR.TRACE-PENDING 1 27.) +(DEFSYSBYTE %%CR.TRACE-BITS 3 27.) + +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 6 24.) + +(DEFENUMERATED *VALUE-DISPOSITIONS* ( + VALUE-DISPOSITION-EFFECT ;The callers wants no return values + VALUE-DISPOSITION-VALUE ;The caller wants a single return value + VALUE-DISPOSITION-RETURN ;The caller wants to return whatever values are + ;returned by this function + VALUE-DISPOSITION-MULTIPLE ;The callers wants multiple values + )) + +(DEFENUMERATED *TRAP-MODES* ( + TRAP-MODE-EMULATOR + TRAP-MODE-EXTRA-STACK + TRAP-MODE-IO + TRAP-MODE-FEP)) + +(DEFENUMERATED *MEMORY-CYCLE-TYPES* ( + %MEMORY-DATA-READ + %MEMORY-DATA-WRITE + %MEMORY-BIND-READ + %MEMORY-BIND-WRITE + %MEMORY-BIND-READ-NO-MONITOR + %MEMORY-BIND-WRITE-NO-MONITOR + %MEMORY-HEADER + %MEMORY-STRUCTURE-OFFSET + %MEMORY-SCAVENGE + %MEMORY-CDR + %MEMORY-GC-COPY + %MEMORY-RAW + %MEMORY-RAW-TRANSLATE + )) + +;;; Internal register definitions + +;;; %REGISTER-ALU-AND-ROTATE-CONTROL fields (DP-OP in hardware spec) + +(DEFSYSBYTE %%ALU-BYTE-R 5 0.) +(DEFSYSBYTE %%ALU-BYTE-S 5 5.) +(DEFSYSBYTE %%ALU-FUNCTION 6 10.) +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 2 14.) +(DEFSYSBYTE %%ALU-FUNCTION-BITS 4 10.) +(DEFSYSBYTE %%ALU-CONDITION 5 16.) +(DEFSYSBYTE %%ALU-CONDITION-SENSE 1 21.) + +;; The following are implemented in Rev3 only. +;; Software forces them to the proper value for compatible operation in Rev1 and Rev2. +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 1 22.) +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 1 23.) +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 1 24.) + +(DEFENUMERATED *ALU-CONDITION-SENSES* + (%ALU-CONDITION-SENSE-TRUE + %ALU-CONDITION-SENSE-FALSE)) + +(DEFENUMERATED *ALU-CONDITIONS* + (%ALU-CONDITION-SIGNED-LESS-THAN-OR-EQUAL ;00 + %ALU-CONDITION-SIGNED-LESS-THAN ;01 + %ALU-CONDITION-NEGATIVE ;02 + %ALU-CONDITION-SIGNED-OVERFLOW ;03 + %ALU-CONDITION-UNSIGNED-LESS-THAN-OR-EQUAL ;04 + %ALU-CONDITION-UNSIGNED-LESS-THAN ;05 + %ALU-CONDITION-ZERO ;06 + %ALU-CONDITION-HIGH-25-ZERO ;07 + %ALU-CONDITION-EQ ;10 + %ALU-CONDITION-OP1-EPHEMERALP ;11 + %ALU-CONDITION-OP1-TYPE-ACCEPTABLE ;12 + %ALU-CONDITION-OP1-TYPE-CONDITION ;13 + %ALU-CONDITION-RESULT-TYPE-NIL ;14 + %ALU-CONDITION-OP2-FIXNUM ;15 + %ALU-CONDITION-FALSE ;16 + %ALU-CONDITION-RESULT-CDR-LOW ;17 + %ALU-CONDITION-CLEANUP-BITS-SET ;20 + %ALU-CONDITION-ADDRESS-IN-STACK-CACHE ;21 + %ALU-CONDITION-PENDING-SEQUENCE-BREAK-ENABLED ;22 + %ALU-CONDITION-EXTRA-STACK-MODE ;23 + %ALU-CONDITION-FEP-MODE ;24 + %ALU-CONDITION-FP-COPROCESSOR-PRESENT ;25 + %ALU-CONDITION-OP1-OLDSPACEP ;26 + %ALU-CONDITION-STACK-CACHE-OVERFLOW ;27 + %ALU-CONDITION-OR-LOGIC-VARIABLE ;30 + )) + +(DEFENUMERATED *ALU-FUNCTION-CLASSES* + (%ALU-FUNCTION-CLASS-BOOLEAN + %ALU-FUNCTION-CLASS-BYTE + %ALU-FUNCTION-CLASS-ADDER + %ALU-FUNCTION-CLASS-MULTIPLY-DIVIDE)) + +(DEFENUMERATED *ALU-FUNCTIONS* + (%ALU-FUNCTION-OP-BOOLEAN-0 + %ALU-FUNCTION-OP-BOOLEAN-1 + %ALU-FUNCTION-OP-DPB + %ALU-FUNCTION-OP-LDB + %ALU-FUNCTION-OP-ADD + %ALU-FUNCTION-OP-RESERVED + %ALU-FUNCTION-OP-MULTIPLY-STEP + %ALU-FUNCTION-OP-MULTIPLY-INVERT-STEP + %ALU-FUNCTION-OP-DIVIDE-STEP + %ALU-FUNCTION-OP-DIVIDE-INVERT-STEP)) + +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS* + (%ALU-BYTE-BACKGROUND-OP1 + %ALU-BYTE-BACKGROUND-ROTATE-LATCH + %ALU-BYTE-BACKGROUND-ZERO)) + +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH* + (%ALU-BYTE-HOLD-ROTATE-LATCH + %ALU-BYTE-SET-ROTATE-LATCH)) + +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS* + (%ALU-ADD-OP2-PASS + %ALU-ADD-OP2-INVERT)) + +(DEFENUMERATED *ALU-ADDER-OPS* + (%ALU-ADD-OP2 + %ALU-ADD-ZERO)) + +(defmacro %alu-function-dpb (background rotate-latch) + `(%logdpb %alu-function-op-dpb (byte 3 3) + (%logdpb ,rotate-latch (byte 1 2) + (%logdpb ,background (byte 2 0) + 0)))) +(export '%alu-function-dpb) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDF1.LISP ... +;;; + +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR #o0) +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR #o4000) +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR #o4400) +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR #o5000) + +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR #o5100) +(DEFSYSCONSTANT %RESET-TRAP-VECTOR #o5101) +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR #o5102) +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR #o5103) +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR #o5104) +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR #o5105) +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR #o5106) +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR #o5107) + +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5110) +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5111) +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR #o5112) +;;; 5113 reserved for future use +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR #o5114) +;;; 5115 reserved for a fence word +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR #o5116) +;;; 5117 reserved for a fence word + +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR #o5120) +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR #o5121) +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR #o5122) +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR #o5123) +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR #o5124) +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR #o5125) +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR #o5126) +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 5127) +;;; 5130 through 5177 reserved for future use + + +;;; +;;; The following definitions are from SYS:I-SYS;OPSDEF.LISP ... +;;; + +(in-package "I-LISP-COMPILER") + +(DEFCONSTANT *FINISH-CALL-N-OPCODE* #o134) diff --git a/support/compile-Minima-for-VLM.lisp b/support/compile-Minima-for-VLM.lisp new file mode 100644 index 0000000..9f1ae6f --- /dev/null +++ b/support/compile-Minima-for-VLM.lisp @@ -0,0 +1,305 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Reason: Function MINIMA-COMPILER::COMPILE-ENVIRONMENT-FILE: . +;;; Function MINIMA-COMPILER::LOAD-ENVIRONMENT-FILE: . +;;; Function MINIMA-COMPILER::COMPILE-A-FILE: . +;;; Function MINIMA-COMPILER::COMPILE-FORM-TO-STREAM: . +;;; Written by Palter, 2/04/93 10:59:22 +;;; while running on Sour Cream from FEP0:>dMinima-49-E.ilod.1 +;;; with Experimental System 447.30, Experimental CLOS 433.1, Experimental RPC 437.0, +;;; Experimental Embedding Support 429.1, Experimental MacIvory Support 443.1, +;;; Experimental UX Support 438.0, Experimental Development Utilities 433.0, +;;; Experimental Old TV 431.0, Experimental Zwei 431.4, Experimental Utilities 440.6, +;;; Experimental RPC Development 432.0, Experimental MacIvory Development 430.0, +;;; Experimental UX Development 437.0, Experimental Server Utilities 438.1, +;;; Experimental Serial 431.0, Experimental Hardcopy 441.2, Experimental Zmail 438.0, +;;; Experimental LMFS Defstorage 416.0, Experimental SCSI 427.3, +;;; Experimental Tape 440.0, Experimental LMFS 439.0, Experimental NSage 436.1, +;;; Experimental Extended Help 437.0, Experimental CL Developer 424.0, +;;; Experimental Documentation Database 438.1, Experimental IP-TCP 447.2, +;;; Experimental IP-TCP Documentation 420.0, Experimental CLX 443.0, +;;; Experimental X Remote Screen 441.2, Experimental X Documentation 419.0, +;;; Experimental NFS Client 437.0, Experimental NFS Documentation 421.0, +;;; Experimental Serial Networks 4.3, Experimental Serial Networks Documentation 7.0, +;;; Experimental DNA 435.0, Experimental Metering 440.0, +;;; Experimental Metering Substrate 440.0, Experimental Conversion Tools 432.0, +;;; Experimental Hacks 436.0, Experimental Mac Dex 429.0, +;;; Experimental HyperCard/MacIvory 429.0, Experimental Statice Runtime 461.3, +;;; Experimental Statice 461.1, Experimental Statice Browser 461.0, +;;; Experimental Statice Documentation 424.0, Experimental CLIM 63.21, +;;; Experimental Genera CLIM 63.5, Experimental CLX CLIM 63.1, +;;; Experimental PostScript CLIM 63.1, Experimental CLIM Documentation 63.0, +;;; Experimental CLIM Demo 63.3, Experimental Symbolics Concordia 440.1, +;;; Experimental Essential Image Substrate 428.0, Experimental Image Substrate 436.0, +;;; Experimental Graphic Editing Documentation 430.0, +;;; Experimental Graphic Editing 437.0, Experimental Graphic Editor 436.0, +;;; Experimental Bitmap Editor 437.0, Experimental Postscript 432.0, +;;; Experimental Concordia Documentation 430.0, Experimental Lock Simple 433.0, +;;; Experimental Producer 417.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 439.1, +;;; Symbolics In-House Documentation 422.0, SCRC 437.0, Weather User 421.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 52.2, +;;; Experimental IFEP Kernel 329.7, Experimental IFEP Utilities 329.1, +;;; Experimental Minima Developer 49.4, Experimental Minima Kernel 32.15, +;;; Experimental Minima Debugger 29.2, Experimental Minima Documentation 21.0, +;;; Palter's Environment 24.0, Experimental Alpha Assembler NEWEST, +;;; Experimental Alpha Ivory Emulator NEWEST, cold load 1, +;;; Ivory Revision 4A (FPA enabled), FEP 329, FEP0:>I329-loaders.flod(4), +;;; FEP0:>I329-info.flod(4), FEP0:>I329-debug.flod(4), FEP0:>I329-lisp.flod(4), +;;; FEP0:>I329-kernel.fep(45), Boot ROM version 320, Device PROM version 325, +;;; Genera application 5.6, MacIvory SCSI Manager Server 4.3.1, Toolbox Servers 4.2, +;;; MacIvory & RPC library 6.3.2, MacIvory life support 4.3.6, +;;; Macintosh System Software 7.1, 1152x806 Screen with Genera fonts, +;;; Machine serial number 30014, Macintosh IIfx, Apple Extended Keyboard II, +;;; Add a control register view to the Minima Debugger (from S:>Palter>VLM>control-register-view.lisp.2), +;;; Clear all Minima Debugger histories (from S:>Palter>VLM>clear-all-histories.lisp.1), +;;; Provide access path to UNIX emulator (from VLM:EMULATOR;UNIX-ACCESS-PATH.LISP.6), +;;; Force the FEP to print backtraces in error messages by default (from S:>Palter>VLM>FEP-prints-backtraces), +;;; Fake a Rev5 trap dispatch table for the IFEP (from S:>Palter>VLM>FEP-Rev5-trap-dispatch-table). + + +#+(OR MINIMA-RUNTIME MINIMA-DEVELOPER) (IN-PACKAGE "COMMON-LISP-USER") + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "MINIMA:COMPILER;TOP-LEVEL-FORMS.LISP.68") + + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI"); 0(SCT:NOTE-PRIVATE-PATCH "Add the :VLM feature while compiling Minima files") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:COMPILER;TOP-LEVEL-FORMS.LISP.68") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: Minima-Compiler; Lowercase: Yes -*-") + +#+IMACH + +(defun compile-environment-file (file &key output-file package (verbose *compile-verbose*) (print *compile-print*)) + (setf file (merge-pathnames file (make-pathname :type "LISP"))) + (when verbose + (format t "~&; Compiling file ~A~%" file)) + (setf output-file (make-pathname :type "MEBIN" :defaults (if output-file (merge-pathnames output-file file) file))) + (with-open-file (lisp file) + (with-minima-environment () + (let* ((*package* (sys:find-package-for-syntax (or package "COMMON-LISP-USER") + :minima)) + (minima-common-lisp:*package* *package*) + (cl:*readtable* si:*minima-readtable*) + (*readtable* *standard-readtable*) + (minima-common-lisp:*readtable* *readtable*) + (minima-common-lisp:*compile-file-pathname* file) + (minima-common-lisp:*compile-file-truename* (truename lisp)) + (sys:fdefine-file-pathname (scl:send file :generic-pathname)) + (*other-features* '((2 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB"):VLM 0:Minima-Developer)) + (eof '#:eof) + (first-form t)) + (values + output-file + minima-common-lisp:*compile-file-truename* + (si:writing-bin-file (bin output-file) + (loop + (let ((form (read lisp nil eof))) + (when (eq form eof) (return)) + (process-top-level-form + form + '(() () () () (((compile-file)))) + #'minima-macroexpand-1 + #'(lambda (form env) + (setf form + (compiler:optimize-top-level-form + form :repeat t :do-macro-expansion t :do-named-constants t + :do-constant-folding t :do-function-args t + :environment env)) + (eval form env)) + #'(lambda (form env) + (catch 'compiler:phase-1 + (setf form + (compiler:optimize-top-level-form + form :compile t :do-style-checking t :environment env + :compile-function #'(lambda (lambda-exp env) + (let ((compiler:*compile-function* #'compiler:compile-to-file) + (compiler:*&rest-arguments-always-dynamic* nil) + (compiler:compiler-verbose print)) + (compiler:compile-lambda-exp lambda-exp t nil env)))))) + (when (shiftf first-form nil) + (unless (and (consp form) + (member (first form) + '(minima-minima-internals::in-package-1 + minima-minima-internals::defpackage-1))) + (warn "~A does not begin with an IN-PACKAGE form." file)) + (let ((source-file-id minima-common-lisp:*compile-file-pathname*) + (truename minima-common-lisp:*compile-file-truename*)) + (when (eq :newest (pathname-version source-file-id)) + (setf source-file-id + (make-pathname :version (pathname-version truename) + :defaults source-file-id))) + (si:dump-attribute-list + `(:syntax :ansi-common-lisp + :package ,(intern (si:pkg-name *package*) "KEYWORD") + :binary-source-file-original-truename ,(string truename) + :qfasl-source-file-unique-id ,source-file-id + :source-file-generic-pathname ,sys:fdefine-file-pathname + ) + bin))) + (si:dump-form-to-eval form bin))))))))))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:COMPILER;TOP-LEVEL-FORMS.LISP.68") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: Minima-Compiler; Lowercase: Yes -*-") + +#+IMACH + +(defun load-environment-file (file &key (verbose *load-verbose*) (print *load-print*) package default-package) + (flet ((load-it (lisp) + (with-minima-environment () + (let* ((*package* (sys:find-package-for-syntax + (or package default-package "COMMON-LISP-USER") + :minima)) + (minima-common-lisp:*package* *package*) + (cl:*readtable* si:*minima-readtable*) + (*readtable* *standard-readtable*) + (minima-common-lisp:*readtable* *readtable*) + (minima-common-lisp:*load-pathname* (pathname lisp))) + (when verbose + (format t "~&; Loading file ~A~%" minima-common-lisp:*load-pathname*)) + (if (subtypep (stream-element-type lisp) 'character) + (let ((*other-features* '(2:VLM 0:Minima-Developer)) + (eof '#:eof) + (first-form (not (or package default-package)))) + (loop + (let ((form (read lisp nil eof))) + (when (eq form eof) (return)) + (when (and (shiftf first-form nil) + (not (and (consp form) + (member (first form) + '(minima-common-lisp:in-package + minima-common-lisp:defpackage))))) + (warn "~A does not begin with an IN-PACKAGE form." file)) + (process-top-level-form + form nil #'minima-macroexpand-1 nil + #'(lambda (form env) + (setf form + (compiler:optimize-top-level-form + form :compile t :do-style-checking t :environment env + :compile-function #'(lambda (lambda-exp env) + (let ((compiler:*compile-function* #'compiler:compile-to-core) + (compiler:*&rest-arguments-always-dynamic* nil) + (compiler:compiler-verbose print)) + (compiler:compile-lambda-exp lambda-exp t nil env))))) + (if print + (map nil #'print (multiple-value-list (eval form env))) + (eval form env))))))) + (fs:load-stream lisp package t)))))) + (cond ((streamp file) + (load-it file) + nil) + (t + (setf file (pathname file)) + (sys:with-open-file-search (lisp ('load-environment-file *default-pathname-defaults* nil) + ((lambda (pathname) + (case (pathname-type pathname) + ((nil :unspecific) + (values '(:mebin :lisp) pathname)) + (otherwise + (values (list (pathname-type pathname)) pathname)))) + file) + :element-type :default) + (let ((sys:fdefine-file-pathname (scl:send (pathname lisp) :generic-pathname)) + (minima-common-lisp:*load-truename* (truename lisp))) + (load-it lisp) + minima-common-lisp:*load-truename*)))))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:COMPILER;TOP-LEVEL-FORMS.LISP.68") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: Minima-Compiler; Lowercase: Yes -*-") + +#+IMACH + +(defun compile-a-file (file &key (output-file file) package (verbose *compile-verbose*) (print *compile-print*)) + (setf file (merge-pathnames file (make-pathname :type "LISP"))) + (when verbose + (format t "~&; Compiling file ~A~%" file)) + (setf output-file (make-pathname :type "MBIN" + :defaults (if output-file + (merge-pathnames output-file file) + file))) + (with-open-file (lisp file) + (with-open-file (bin output-file :direction :output :element-type '(unsigned-byte 8)) + (minima-minima-internals::with-dumper-1 + #'(lambda (dumper) + (with-minima-environment () + (let* ((*package* (sys:find-package-for-syntax (or package "COMMON-LISP-USER") + :minima)) + (cl:*readtable* si:*minima-readtable*) + (*readtable* *standard-readtable*) + (eof '#:eof) + (minima-common-lisp:*compile-file-pathname* (pathname lisp)) + (minima-common-lisp:*compile-file-truename* (truename lisp)) + (sys:fdefine-file-pathname + (scl:send minima-common-lisp:*compile-file-pathname* :generic-pathname)) + (minima-common-lisp:*package* *package*) + (*other-features* '(2:VLM 0:Minima-Runtime)) + (first-form t)) + (loop + (let ((form (read lisp nil eof))) + (when (eq form eof) (return)) + (when (and (shiftf first-form nil) + (not (and (consp form) + (member (first form) + '(minima-common-lisp:in-package + minima-common-lisp:defpackage))))) + (warn "~A does not begin with an IN-PACKAGE form." file)) + (process-top-level-form + form '(() () () () (((compile-file)))) + #'minima-macroexpand-1 + #'eval + #'(lambda (form env) + (unless (constantp form env) + (let ((compiler:compiler-verbose print)) + (minima-minima-internals::dump-form-to-evaluate form env dumper bin))))))) + (values output-file + minima-common-lisp:*compile-file-truename* + (truename bin))))) + bin)))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:COMPILER;TOP-LEVEL-FORMS.LISP.68") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: ANSI-Common-Lisp; Package: Minima-Compiler; Lowercase: Yes -*-") + +#+IMACH + +(defun compile-form-to-stream (form bin) + (minima-minima-internals::with-dumper-1 + #'(lambda (dumper) + (with-minima-environment () + (let* ((*package* (sys:find-package-for-syntax "COMMON-LISP-USER" :minima)) + (cl:*readtable* si:*minima-readtable*) + (*readtable* *standard-readtable*) + (minima-common-lisp:*compile-file-pathname* nil) + (minima-common-lisp:*compile-file-truename* nil) + (sys:fdefine-file-pathname nil) + (minima-common-lisp:*package* *package*) + (*other-features* '(2:VLM 0:Minima-Runtime))) + (process-top-level-form + form '(() () () () (((compile-file)))) + #'minima-macroexpand-1 + #'eval + #'(lambda (form env) + (unless (constantp form env) + (minima-minima-internals::dump-form-to-evaluate form env dumper bin))))))) + bin)) + diff --git a/support/control-register-view.lisp b/support/control-register-view.lisp new file mode 100644 index 0000000..9b93f06 --- /dev/null +++ b/support/control-register-view.lisp @@ -0,0 +1,154 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T; Lowercase: Yes -*- +;;; Patch file for Private version 0.0 +;;; Reason: Debugger View M-DBG::C: . +;;; Variable M-DBG::*TRAP-MODE-NAMES*: . +;;; Variable M-DBG::*VALUE-DISPOSITION-NAMES*: . +;;; Function (CLOS:METHOD CLIM:PRESENT-METHOD (REMOTE:OBJECT T T T T T M-DBG::C-VIEW)): . +;;; Written by Palter, 1/22/93 20:06:49 +;;; while running on Sour Cream from FEP0:>dMinima-49-D.ilod.1 +;;; with Experimental System 447.28, Experimental CLOS 433.1, Experimental RPC 437.0, +;;; Experimental Embedding Support 429.1, Experimental MacIvory Support 443.1, +;;; Experimental UX Support 438.0, Experimental Development Utilities 433.0, +;;; Experimental Old TV 431.0, Experimental Zwei 431.4, Experimental Utilities 440.6, +;;; Experimental RPC Development 432.0, Experimental MacIvory Development 430.0, +;;; Experimental UX Development 437.0, Experimental Server Utilities 438.1, +;;; Experimental Serial 431.0, Experimental Hardcopy 441.2, Experimental Zmail 438.0, +;;; Experimental LMFS Defstorage 416.0, Experimental SCSI 427.3, +;;; Experimental Tape 440.0, Experimental LMFS 439.0, Experimental NSage 436.1, +;;; Experimental Extended Help 437.0, Experimental CL Developer 424.0, +;;; Experimental Documentation Database 435.5, Experimental IP-TCP 447.2, +;;; Experimental IP-TCP Documentation 418.0, Experimental CLX 443.0, +;;; Experimental X Remote Screen 441.2, Experimental X Documentation 417.0, +;;; Experimental NFS Client 437.0, Experimental NFS Documentation 419.0, +;;; Experimental Serial Networks 4.3, Experimental Serial Networks Documentation 5.0, +;;; Experimental DNA 435.0, Experimental Metering 440.0, +;;; Experimental Metering Substrate 440.0, Experimental Conversion Tools 432.0, +;;; Experimental Hacks 436.0, Experimental Mac Dex 429.0, +;;; Experimental HyperCard/MacIvory 429.0, Experimental Statice Runtime 461.3, +;;; Experimental Statice 461.1, Experimental Statice Browser 461.0, +;;; Experimental Statice Documentation 422.0, Experimental CLIM 63.20, +;;; Experimental Genera CLIM 63.5, Experimental CLX CLIM 63.1, +;;; Experimental PostScript CLIM 63.1, Experimental CLIM Documentation 40.0, +;;; Experimental CLIM Demo 63.3, Experimental Symbolics Concordia 440.1, +;;; Experimental Essential Image Substrate 428.0, Experimental Image Substrate 436.0, +;;; Experimental Graphic Editing Documentation 428.0, +;;; Experimental Graphic Editing 437.0, Experimental Graphic Editor 436.0, +;;; Experimental Bitmap Editor 437.0, Experimental Postscript 432.0, +;;; Experimental Concordia Documentation 428.0, Experimental Lock Simple 433.0, +;;; Experimental Producer 417.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 439.1, +;;; Symbolics In-House Documentation 420.0, SCRC 437.0, Weather User 421.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 52.2, +;;; Experimental IFEP Kernel 329.7, Experimental IFEP Utilities 329.1, +;;; Experimental Minima Developer 49.4, Experimental Minima Kernel 32.15, +;;; Experimental Minima Debugger 29.2, Experimental Minima Documentation 21.0, +;;; Palter's Environment 24.0, Experimental Alpha Assembler NEWEST, +;;; Experimental Alpha Ivory Emulator NEWEST, cold load 1, +;;; Ivory Revision 4A (FPA enabled), FEP 329, FEP0:>I329-loaders.flod(4), +;;; FEP0:>I329-info.flod(4), FEP0:>I329-debug.flod(4), FEP0:>I329-lisp.flod(4), +;;; FEP0:>I329-kernel.fep(45), Boot ROM version 320, Device PROM version 325, +;;; Genera application 5.6, MacIvory SCSI Manager Server 4.3.1, Toolbox Servers 4.2, +;;; MacIvory & RPC library 6.3.2, MacIvory life support 4.3.5, +;;; Macintosh System Software 7.1, 1152x806 Screen with Genera fonts, +;;; Machine serial number 30014, Macintosh IIfx, Apple Extended Keyboard II, +;;; Provide access path to UNIX emulator (from VLM:EMULATOR;UNIX-ACCESS-PATH.LISP.6), +;;; Clear all Minima Debugger histories (from S:>Palter>VLM>clear-all-histories.lisp.1). + + +#+(OR MINIMA-RUNTIME MINIMA-DEVELOPER) (IN-PACKAGE "COMMON-LISP-USER") + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI"); 0(SCT:NOTE-PRIVATE-PATCH "Add a control register view to the Minima Debugger") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;VIEWS.LISP.30") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH +;;; +(define-view c "Control Register") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;VIEWS.LISP.30") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH +(defparameter *trap-mode-names* + (map 'list #'(lambda (name) (subseq (string name) #.(length "TRAP-MODE-"))) + sys:*trap-modes*)) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;VIEWS.LISP.30") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH +(defparameter *value-disposition-names* + (map 'list + #'(lambda (name) (subseq (string name) #.(length "VALUE-DISPOSITION-"))) + sys:*value-dispositions*)) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;VIEWS.LISP.30") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH +(define-presentation-method present (object (type remote:object) stream (view c-view) + &key) + (let ((fixnum (remote:%data object))) + (print-control-register fixnum stream))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;VIEWS.LISP.30") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH +(defun print-control-register (fixnum &optional (stream *standard-output*)) + (let ((trap-mode (ldb sys:%%cr.trap-mode fixnum))) + (when (plusp trap-mode) + (format stream "Trap mode ~A; " (nth (ldb sys:%%cr.trap-mode fixnum) + *trap-mode-names*)))) + (format stream "~S Arguments~A~A~A; Called for ~A" + (- (ldb sys:%%cr.argument-size fixnum) + sys:(defstorage-size stack-frame)) + (if (ldb-test sys:%%cr.extra-argument fixnum) " + Extra" "") + (if (ldb-test sys:%%cr.apply fixnum) ", Applied" "") + (if (ldb-test sys:%%cr.call-started fixnum) "; Call-Started" "") + (nth (ldb sys:%%cr.value-disposition fixnum) *value-disposition-names*)) + (format stream "; Frame size ~S" (ldb sys:%%cr.caller-frame-size fixnum)) + (let ((cleanup-catch (ldb-test sys:%%cr.cleanup-catch fixnum)) + (cleanup-bindings (ldb-test sys:%%cr.cleanup-bindings fixnum)) + (trap-on-exit (ldb-test sys:%%cr.trap-on-exit-bit fixnum)) + (cleanup-in-progress (ldb-test sys:%%cr.cleanup-in-progress fixnum))) + (when (or cleanup-catch cleanup-bindings trap-on-exit cleanup-in-progress) + (format stream "; Cleanup~A~A~A~A" + (if cleanup-catch " Catch" "") + (if cleanup-bindings " Bindings" "") + (if trap-on-exit " Trap-on-exit" "") + (if cleanup-in-progress " In Progress" "")))) + (let ((instruction (ldb-test sys:%%cr.instruction-trace fixnum)) + (call (ldb-test sys:%%cr.call-trace fixnum)) + (pending (ldb-test sys:%%cr.trace-pending fixnum))) + (when (or instruction call pending) + (format stream "; Trace~A~A~A" + (if instruction " Instructions" "") + (if call " Calls" "") + (if pending " Pending" ""))))) diff --git a/support/debug-kludges.lisp b/support/debug-kludges.lisp new file mode 100644 index 0000000..92d03f9 --- /dev/null +++ b/support/debug-kludges.lisp @@ -0,0 +1,100 @@ +;;; -*- Package: PPCI; Syntax: Common-Lisp; Mode: LISP; Base: 10; Lowercase: Yes -*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; (instnref compiled-function index) +;;; +;;; Index is an index into the compiled function in fullwords. First +;;; instruction is at 0. The instruction returns multiple values as +;;; follows: +;;; cdr-code +;;; type The (6) type bits (cdr code removed) +;;; tag The full tag including cdr-code +;;; data The data word as a fixnum +;;; word The full word including tag and cdr code. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tag-data-type (tag) + (logand tag #x3f)) + +(defun tag-cdr-code (tag) + (ash tag -6)) + +(defun instnref (fcn index) + (let* ((datum (si:%memory-read (si:%pointer-plus fcn index) + :cycle-type si:%memory-scavenge + :set-cdr-next nil)) + (tag (si:%tag datum))) + (values (tag-cdr-code tag) ;The CDR code + (tag-data-type tag) ;The type (tag wo cdr code) + tag ;The complete 8 bit tag + (si:%set-tag datum si:dtp-fixnum) ;The data word as a fixnum + ;; If it is a pointer, we need to keep a locative to it (so + ;; the GC doesn't move it on us, but we can't always use the + ;; raw word (e.g., EVCP). For non-pointer data, the raw + ;; word is safe + (if (sys:%pointerp datum) + (si:%set-tag datum si:dtp-locative) + datum)))) + + +#|| +int FIBTestCode [51][3] = { + { 03, 060, 03376003 }, + { 00, 067, 030005200002 }, + { 03, 056, 0xF8000000L+06 }, + { 00, 065, 030002201424 }, /* 030002201424 */ + { 00, 061, 032003311377 }, +/* { 00, 064, 033040161772 }, */ + { 00, 062, 037000161772 }, + { 00, Type_CompiledFunction, 0xF8000000L+07 }, + { 03, 060, 03376003 }, + { 00, 073, 013402703377 }, + { 00, 064, 033000160002 }, + { 03, 056, 0xF8000000L+06 }, + { 00, 074, 03401200002 }, + { 03, 064, 02270402 }, + { 02, 056, 0xF8000000L+06 }, + { 00, 065, 030402603402 }, + { 00, 064, 033000601000 }, + { 01, 000, 0 } /* End of compiled code */ +}; +||# + +(defun emit-c-test-function (fn &optional (fname "og5:/home/paulr/VLM/VLM/emulator/testfunction.h")) + (with-open-file (strm fname :direction :output) + (emit-fcn-as-c (symbol-function fn) strm))) + +(defun emit-fcn-as-c (fcn &optional (strm t) (name "TESTFCN")) + (assert (typep fcn 'compiled-function)) + (format strm "~%") + (let ((endcc nil) + (length 0)) + (do ((index 0 (+ index 1))) + (endcc ()) + (multiple-value-bind (cc type tag data word) (instnref fcn index) + (declare (ignore type word)) + (cond ((= cc 1) + (setq endcc t)) + (:otherwise + (incf length))))) + (setq endcc nil) + (format strm "#define TESTFCNLENGTH ~d~%" (+ length 1)) + (format strm "int ~a [TESTFCNLENGTH][3] = {~%" name) + (do ((index 0 (+ index 1))) + (endcc ()) + (multiple-value-bind (cc type tag data word) (instnref fcn index) + (declare (ignore tag word)) + (cond ((= cc 1) + (setq endcc t)) + (:otherwise + (format strm " { 0x~2,'0x, 0x~2,'0x, 0x~8,'0x },~%" cc type (logand #xFFFFFFFF data)))))) + (format strm " { 01, 000, 0 } /* End of compiled code */~%};~%") + nil)) + + +(defun fact3 () + (let ((fa 1)) + (do ((n 3 (- n 1))) + ((zerop n) fa) + (setq fa (* fa n)))) + (sys:%halt)) \ No newline at end of file diff --git a/support/development-sysdcl.lisp b/support/development-sysdcl.lisp new file mode 100644 index 0000000..9152c02 --- /dev/null +++ b/support/development-sysdcl.lisp @@ -0,0 +1,17 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + +(defsystem vlm-development + (:pretty-name "VLM Development" + :default-pathname "VLM:SUPPORT;") + (:module developer-patches ("compile-Minima-for-VLM") + (:load-when-systems-loaded "Minima-Developer")) + (:module debugger-patches ("clear-all-histories" + "control-register-view" + "more-VLM-access-path-hackery" + "robust-MBIN" + "start-without-Load-World" + "Unix-access-path") + (:load-when-systems-loaded "Minima-Debugger")) + (:serial + developer-patches + debugger-patches)) diff --git a/support/more-VLM-access-path-hackery.lisp b/support/more-VLM-access-path-hackery.lisp new file mode 100644 index 0000000..78c4443 --- /dev/null +++ b/support/more-VLM-access-path-hackery.lisp @@ -0,0 +1,125 @@ + +;;; Reason: Function (CLOS:METHOD MINIMACCESS::ACCESS-PATH-SUPPORTS-MULTIPLE-INTERACTORS-P (MINIMACCESS::ACCESS-PATH)): . +;;; Function (CLOS:METHOD MINIMACCESS::ACCESS-PATH-SUPPORTS-MULTIPLE-INTERACTORS-P (M-DBG::MINIMA-ACCESS-PATH)): . +;;; Function (CLOS:METHOD MINIMACCESS::UDP-ACCESS-PATH-ADDRESS-MATCH-P (MINIMACCESS::UDP-ACCESS-PATH T)): . +;;; Written by Palter, 3/12/93 18:31:23 +;;; while running on Sour Cream from FEP0:>VLM-Minima-B.ilod.1 +;;; with Experimental System 447.37, Experimental CLOS 433.1, Experimental RPC 437.0, +;;; Experimental Embedding Support 429.1, Experimental MacIvory Support 443.2, +;;; Experimental UX Support 438.0, Experimental Development Utilities 433.0, +;;; Experimental Old TV 431.0, Experimental Zwei 431.4, Experimental Utilities 440.7, +;;; Experimental RPC Development 432.0, Experimental MacIvory Development 430.0, +;;; Experimental UX Development 437.0, Experimental Server Utilities 438.1, +;;; Experimental Serial 431.1, Experimental Hardcopy 441.2, Experimental Zmail 438.0, +;;; Experimental LMFS Defstorage 416.0, Experimental SCSI 427.3, +;;; Experimental Tape 440.0, Experimental LMFS 439.0, Experimental NSage 436.1, +;;; Experimental Extended Help 437.0, Experimental CL Developer 424.0, +;;; Experimental Documentation Database 438.12, Experimental IP-TCP 447.3, +;;; Experimental IP-TCP Documentation 420.0, Experimental CLX 443.0, +;;; Experimental X Remote Screen 441.2, Experimental X Documentation 419.0, +;;; Experimental NFS Client 437.0, Experimental NFS Documentation 421.0, +;;; Experimental Serial Networks 4.8, Experimental Serial Networks Documentation 7.0, +;;; Experimental DNA 435.0, Experimental Metering 440.0, +;;; Experimental Metering Substrate 440.0, Experimental Conversion Tools 432.0, +;;; Experimental Hacks 436.0, Experimental Mac Dex 429.0, +;;; Experimental HyperCard/MacIvory 429.0, Experimental Statice Runtime 461.3, +;;; Experimental Statice 461.1, Experimental Statice Browser 461.0, +;;; Experimental Statice Documentation 424.0, Experimental CLIM 63.31, +;;; Experimental Genera CLIM 63.11, Experimental CLX CLIM 63.5, +;;; Experimental PostScript CLIM 63.2, Experimental CLIM Documentation 63.5, +;;; Experimental CLIM Demo 63.4, Experimental Symbolics Concordia 440.1, +;;; Experimental Essential Image Substrate 428.0, Experimental Image Substrate 436.0, +;;; Experimental Graphic Editing Documentation 430.0, +;;; Experimental Graphic Editing 437.0, Experimental Graphic Editor 436.0, +;;; Experimental Bitmap Editor 437.0, Experimental Postscript 432.0, +;;; Experimental Concordia Documentation 430.0, Experimental Lock Simple 433.0, +;;; Experimental Producer 417.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 439.1, +;;; Symbolics In-House Documentation 422.0, SCRC 437.0, Weather User 421.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 52.3, +;;; Experimental IFEP Kernel 329.10, Experimental IFEP Utilities 329.1, +;;; Experimental Alpha Assembler NEWEST, Experimental Alpha Ivory Emulator NEWEST, +;;; Experimental Minima Developer 49.5, Experimental Minima Kernel 35.6, +;;; Experimental Minima Debugger 29.17, Palter's Environment 24.0, +;;; Experimental Minima Kernel Network 23.1, Experimental VLM Debugger 2.0, +;;; cold load 1, Ivory Revision 4A (FPA enabled), FEP 328, +;;; FEP0:>I328-loaders.flod(24), FEP0:>I328-info.flod(24), FEP0:>I328-debug.flod(24), +;;; FEP0:>I328-lisp.flod(25), FEP0:>I328-kernel.fep(44), Boot ROM version 320, +;;; Device PROM version 325, Genera application 5.6, +;;; MacIvory SCSI Manager Server 4.3.1, Toolbox Servers 4.2, +;;; MacIvory & RPC library 6.3.2, MacIvory life support 4.3.6, +;;; Macintosh System Software 7.1, 1152x806 Screen with Genera fonts, +;;; Machine serial number 30014, Macintosh IIfx, Apple Extended Keyboard II, +;;; Add the :VLM feature while compiling Minima files (from S:>Palter>VLM>compile-Minima-for-VLM.lisp.1), +;;; Provide access path to UNIX emulator (from VLM:EMULATOR;UNIX-ACCESS-PATH.LISP.8), +;;; Clear all Minima Debugger histories (from S:>Palter>VLM>clear-all-histories.lisp.1), +;;; Add a control register view to the Minima Debugger (from S:>Palter>VLM>control-register-view.lisp.2), +;;; Make the "ROM" MBIN protocol more robust (from S:>Palter>VLM>robust-MBIN.lisp.3), +;;; Make the Minima Debugger Start commands work without Load World... (from S:>Palter>VLM>start-without-load-world.lisp.1), +;;; Smarter SYSTEM-CASE macro (from S:>Palter>VLM>smarter-system-case.lisp.1). + + +#+(OR MINIMA-RUNTIME MINIMA-DEVELOPER) (IN-PACKAGE "COMMON-LISP-USER") + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "MINIMA:ACCESS;ACCESS-PATHS.LISP.72" + "MINIMA:DEBUGGER;PATHS.LISP.38" + "MINIMA:ACCESS;UDP.LISP.20") + + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI"); 0(SCT:NOTE-PRIVATE-PATCH "More VLM access path hackery") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;ACCESS-PATHS.LISP.72") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Base: 10; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH + +(2 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")(defmethod access-path-supports-multiple-interactors-p ((access-path access-path)) nil) + + +0;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;PATHS.LISP.38") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Lowercase: Yes -*-") + +#+IMACH + +2(defmethod minimaccess::access-path-supports-multiple-interactors-p ((path minima-access-path)) +0 2t) + + + +0;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;UDP.LISP.20") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH + +(defmethod udp-access-path-address-match-p ((access-path udp-access-path) address) + (let ((network (neti:local-network-of-type :internet))) + 2(or 0(loop for (host-network host-address) + in (scl:send (slot-value access-path 'host) :network-addresses) + thereis2 (and 0(and (eql host-network network) (eql host-address address)) + 2(access-path-supports-multiple-interactors-p access-path))0) + 2(let* ((remote-host (neti:get-host-from-network-address address network)) +0 2(embedded-host-name (and remote-host +0 2(not (scl:send remote-host :uninterned-p)) +0 2(scl:send remote-host :user-get :embedded-in))) + (embedded-host (and embedded-host-name + (net:parse-host embedded-host-name t)))) +0 2(and (eql embedded-host (access-path-host access-path)) +0 2(access-path-supports-multiple-interactors-p access-path))))0)) + +bedded-host (access-path-host access-path)) +0 2(access-path-supports-multiple-interactors-p access-path))))0)) + diff --git a/support/openmcl-packages.lisp b/support/openmcl-packages.lisp new file mode 100644 index 0000000..398e311 --- /dev/null +++ b/support/openmcl-packages.lisp @@ -0,0 +1,29 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: COMMON-LISP-USER; Base: 10; Lowercase: Yes -*- +(in-package "COMMON-LISP-USER") + +;;; Packages used by the emulator that aren't defined in OpenMCL + +(defpackage LISP + (:use COMMON-LISP) + (:export "AND" "OR")) + +(defpackage CLOS + (:use COMMON-LISP) + (:export "DEFCLASS" "DEFGENERIC" "DEFMETHOD" "INITIALIZE-INSTANCE" "WITH-SLOTS" + "PRINT-OBJECT" "SLOT-VALUE" "MAKE-INSTANCE")) + +(defpackage FUTURE-COMMON-LISP + (:use COMMON-LISP) + (:export "PRINT-UNREADABLE-OBJECT")) + +(defpackage COMPILER + (:use COMMON-LISP) + (:export "WARN")) + +(defpackage SYSTEM + (:nicknames "SYS") + (:use COMMON-LISP)) + +(defpackage I-LISP-COMPILER + (:use COMMON-LISP) + (:export *FINISH-CALL-N-OPCODE*)) diff --git a/support/openmcl-support.lisp b/support/openmcl-support.lisp new file mode 100644 index 0000000..a668714 --- /dev/null +++ b/support/openmcl-support.lisp @@ -0,0 +1,348 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SYSTEM; Base: 10; Lowercase: Yes -*- + +;;; + +(in-package "CCL") + +(defmacro defsubst (name arglist &body body) + `(progn + (declaim (inline ,name)) + (defun ,name ,arglist ,@body))) + +(defmacro stack-let (vars-and-vals &body body) + (let ((vars (loop for var-and-val in vars-and-vals + if (atom var-and-val) + collect var-and-val + else + collect (first var-and-val)))) + `(let ,vars-and-vals + (declare (dynamic-extent ,@vars)) + ,@body))) + +(declaim (inline circular-list)) +(defun circular-list (&rest list) + (let ((list (copy-list list))) + (setf (cdr (last list)) list) + list)) + +;;; + +(in-package "SYSTEM") + +(export '(%logldb %logdpb %32-bit-difference)) + +(ccl::defsubst %logldb (bytespec integer) + (ldb bytespec integer)) + +(ccl::defsubst %logdpb (value bytespec integer) + (let ((result (dpb value bytespec integer))) + (if (zerop (ldb (byte 1 31) result)) + result + (- (ldb (byte 31 0) (1+ (lognot result))))))) + +(ccl::defsubst %32-bit-difference (x y) + (- x y)) + +;;; + +(defmacro defsysconstant (name value) + `(progn + (defconstant ,name ,value) + (export ',name))) + +(defmacro defenumerated (list-name code-list &optional (start 0) (increment 1) end) + (when (and end (not (= (length code-list) (/ (- end start) increment)))) + (error "~s has ~s codes where ~s are required" + list-name (length code-list) (/ (- end start) increment))) + `(progn + (defsysconstant ,list-name ',code-list) + ,@(loop for code in code-list and prev = 0 then code + as value from start by increment + unless (eq code prev) ;kludge for data-types + collect `(defsysconstant ,code ,value)))) + +(defmacro defsysbyte (name size position) + `(defsysconstant ,name (byte ,size ,position))) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDEF.LISP ... +;;; + +;; --- most of the below is L-specific +;; To add a new data type, update the following (at least): +;; *DATA-TYPES* and *POINTER-DATA-TYPES* in this file +;; Patch *DATA-TYPE-NAME*, set up by from *DATA-TYPES* by the cold-load generator +;; type-map-for-transport, transporter-type-map-alist in sys: l-ucode; uu.lisp +;; *storing-type-map* in sys: l-ucode; uux.lisp and reload that whole file +;; It is important that the form near the end of that file that sets up the +;; no-trap type-map be executed before any other type maps are assigned. +;; simulate-transporter in sys: l-ucode; simx.lisp +;; and recompile the whole microcode to get the type-maps updated +;; typep-alist and related stuff in sys: sys; lcons.lisp +;; dbg:*good-data-types* if it is indeed a good data type +;; Send a message to the maintainer of the FEP-resident debugger. + +(DEFENUMERATED *DATA-TYPES* ( + ;; Headers, special markers, and forwarding pointers. + DTP-NULL ;00 Unbound variable/function, uninitialized storage + DTP-MONITOR-FORWARD ;01 This cell being monitored + DTP-HEADER-P ;02 Structure header, with pointer field + DTP-HEADER-I ;03 Structure header, with immediate bits + DTP-EXTERNAL-VALUE-CELL-POINTER ;04 Invisible except for binding + DTP-ONE-Q-FORWARD ;05 Invisible pointer (forwards one cell) + DTP-HEADER-FORWARD ;06 Invisible pointer (forwards whole structure) + DTP-ELEMENT-FORWARD ;07 Invisible pointer in element of structure + ;; Numeric data types. + DTP-FIXNUM ;10 Small integer + DTP-SMALL-RATIO ;11 Ratio with small numerator and denominator + DTP-SINGLE-FLOAT ;12 Single-precision floating point + DTP-DOUBLE-FLOAT ;13 Double-precision floating point + DTP-BIGNUM ;14 Big integer + DTP-BIG-RATIO ;15 Ratio with big numerator or denominator + DTP-COMPLEX ;16 Complex number + DTP-SPARE-NUMBER ;17 A number to the hardware trap mechanism + ;; Instance data types. + DTP-INSTANCE ;20 Ordinary instance + DTP-LIST-INSTANCE ;21 Instance that masquerades as a cons + DTP-ARRAY-INSTANCE ;22 Instance that masquerades as an array + DTP-STRING-INSTANCE ;23 Instance that masquerades as a string + ;; Primitive data types. + DTP-NIL ;24 The symbol NIL + DTP-LIST ;25 A cons + DTP-ARRAY ;26 An array that is not a string + DTP-STRING ;27 A string + DTP-SYMBOL ;30 A symbol other than NIL + DTP-LOCATIVE ;31 Locative pointer + DTP-LEXICAL-CLOSURE ;32 Lexical closure of a function + DTP-DYNAMIC-CLOSURE ;33 Dynamic closure of a function + DTP-COMPILED-FUNCTION ;34 Compiled code + DTP-GENERIC-FUNCTION ;35 Generic function (see later section) + DTP-SPARE-POINTER-1 ;36 Spare + DTP-SPARE-POINTER-2 ;37 Spare + DTP-PHYSICAL-ADDRESS ;40 Physical address + DTP-SPARE-IMMEDIATE-1 ;41 Spare + DTP-BOUND-LOCATION ;42 Deep bound marker + DTP-CHARACTER ;43 Common Lisp character object + DTP-LOGIC-VARIABLE ;44 Unbound logic variable marker + DTP-GC-FORWARD ;45 Object-moved flag for garbage collector + DTP-EVEN-PC ;46 PC at first instruction in word + DTP-ODD-PC ;47 PC at second instruction in word + ;; Full-word instructions. + DTP-CALL-COMPILED-EVEN ;50 Start call, address is compiled function + DTP-CALL-COMPILED-ODD ;51 Start call, address is compiled function + DTP-CALL-INDIRECT ;52 Start call, address is function cell + DTP-CALL-GENERIC ;53 Start call, address is generic function + DTP-CALL-COMPILED-EVEN-PREFETCH ;54 Like above, but prefetching is desireable + DTP-CALL-COMPILED-ODD-PREFETCH ;55 Like above, but prefetching is desireable + DTP-CALL-INDIRECT-PREFETCH ;56 Like above, but prefetching is desireable + DTP-CALL-GENERIC-PREFETCH ;57 Like above, but prefetching is desireable + ;; Half-word (packed) instructions consume 4 bits of data type field (opcodes 60..77). + DTP-PACKED-INSTRUCTION-60 DTP-PACKED-INSTRUCTION-61 DTP-PACKED-INSTRUCTION-62 + DTP-PACKED-INSTRUCTION-63 DTP-PACKED-INSTRUCTION-64 DTP-PACKED-INSTRUCTION-65 + DTP-PACKED-INSTRUCTION-66 DTP-PACKED-INSTRUCTION-67 DTP-PACKED-INSTRUCTION-70 + DTP-PACKED-INSTRUCTION-71 DTP-PACKED-INSTRUCTION-72 DTP-PACKED-INSTRUCTION-73 + DTP-PACKED-INSTRUCTION-74 DTP-PACKED-INSTRUCTION-75 DTP-PACKED-INSTRUCTION-76 + DTP-PACKED-INSTRUCTION-77 + ) + 0 1 #o100) + +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* ( + ARRAY-ELEMENT-TYPE-FIXNUM + ARRAY-ELEMENT-TYPE-CHARACTER + ARRAY-ELEMENT-TYPE-BOOLEAN + ARRAY-ELEMENT-TYPE-OBJECT + )) + +;;; Control register. + +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 8. 0) ;Number of spread arguments supplied by caller +(DEFSYSBYTE %%CR.APPLY 1 17.) ;1 If caller used APPLY, 0 otherwise +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 2 18.) ;The value of this function +(DEFSYSBYTE %%CR.CLEANUP-BITS 3 24.) ;All the cleanup bits +(DEFSYSBYTE %%CR.CLEANUP-CATCH 1 26.) ;There are active catch blocks in the current frame +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 1 25.) ;There are active bindings in the current frame +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 1 24.) ;Software trap before exiting this frame +(DEFSYSBYTE %%CR.TRAP-MODE 2 30.) ;1 If we are executing on the "extra stack" + ;Extra stack inhibits sequence breaks and preemption + ;It also allows the "overflow" part of the stack to + ;be used without traps. +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 1 8.) ;The call instruction supplied an "extra" argument +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 8 9.) ;The frame size of the Caller +(DEFSYSBYTE %%CR.CALL-STARTED 1 22.) ;Between start-call and finish-call. +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 1 23.) +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 1 29.) +(DEFSYSBYTE %%CR.CALL-TRACE 1 28.) +(DEFSYSBYTE %%CR.TRACE-PENDING 1 27.) +(DEFSYSBYTE %%CR.TRACE-BITS 3 27.) + +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 6 24.) + +(DEFENUMERATED *VALUE-DISPOSITIONS* ( + VALUE-DISPOSITION-EFFECT ;The callers wants no return values + VALUE-DISPOSITION-VALUE ;The caller wants a single return value + VALUE-DISPOSITION-RETURN ;The caller wants to return whatever values are + ;returned by this function + VALUE-DISPOSITION-MULTIPLE ;The callers wants multiple values + )) + +(DEFENUMERATED *TRAP-MODES* ( + TRAP-MODE-EMULATOR + TRAP-MODE-EXTRA-STACK + TRAP-MODE-IO + TRAP-MODE-FEP)) + +(DEFENUMERATED *MEMORY-CYCLE-TYPES* ( + %MEMORY-DATA-READ + %MEMORY-DATA-WRITE + %MEMORY-BIND-READ + %MEMORY-BIND-WRITE + %MEMORY-BIND-READ-NO-MONITOR + %MEMORY-BIND-WRITE-NO-MONITOR + %MEMORY-HEADER + %MEMORY-STRUCTURE-OFFSET + %MEMORY-SCAVENGE + %MEMORY-CDR + %MEMORY-GC-COPY + %MEMORY-RAW + %MEMORY-RAW-TRANSLATE + )) + +;;; Internal register definitions + +;;; %REGISTER-ALU-AND-ROTATE-CONTROL fields (DP-OP in hardware spec) + +(DEFSYSBYTE %%ALU-BYTE-R 5 0.) +(DEFSYSBYTE %%ALU-BYTE-S 5 5.) +(DEFSYSBYTE %%ALU-FUNCTION 6 10.) +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 2 14.) +(DEFSYSBYTE %%ALU-FUNCTION-BITS 4 10.) +(DEFSYSBYTE %%ALU-CONDITION 5 16.) +(DEFSYSBYTE %%ALU-CONDITION-SENSE 1 21.) + +;; The following are implemented in Rev3 only. +;; Software forces them to the proper value for compatible operation in Rev1 and Rev2. +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 1 22.) +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 1 23.) +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 1 24.) + +(DEFENUMERATED *ALU-CONDITION-SENSES* + (%ALU-CONDITION-SENSE-TRUE + %ALU-CONDITION-SENSE-FALSE)) + +(DEFENUMERATED *ALU-CONDITIONS* + (%ALU-CONDITION-SIGNED-LESS-THAN-OR-EQUAL ;00 + %ALU-CONDITION-SIGNED-LESS-THAN ;01 + %ALU-CONDITION-NEGATIVE ;02 + %ALU-CONDITION-SIGNED-OVERFLOW ;03 + %ALU-CONDITION-UNSIGNED-LESS-THAN-OR-EQUAL ;04 + %ALU-CONDITION-UNSIGNED-LESS-THAN ;05 + %ALU-CONDITION-ZERO ;06 + %ALU-CONDITION-HIGH-25-ZERO ;07 + %ALU-CONDITION-EQ ;10 + %ALU-CONDITION-OP1-EPHEMERALP ;11 + %ALU-CONDITION-OP1-TYPE-ACCEPTABLE ;12 + %ALU-CONDITION-OP1-TYPE-CONDITION ;13 + %ALU-CONDITION-RESULT-TYPE-NIL ;14 + %ALU-CONDITION-OP2-FIXNUM ;15 + %ALU-CONDITION-FALSE ;16 + %ALU-CONDITION-RESULT-CDR-LOW ;17 + %ALU-CONDITION-CLEANUP-BITS-SET ;20 + %ALU-CONDITION-ADDRESS-IN-STACK-CACHE ;21 + %ALU-CONDITION-PENDING-SEQUENCE-BREAK-ENABLED ;22 + %ALU-CONDITION-EXTRA-STACK-MODE ;23 + %ALU-CONDITION-FEP-MODE ;24 + %ALU-CONDITION-FP-COPROCESSOR-PRESENT ;25 + %ALU-CONDITION-OP1-OLDSPACEP ;26 + %ALU-CONDITION-STACK-CACHE-OVERFLOW ;27 + %ALU-CONDITION-OR-LOGIC-VARIABLE ;30 + )) + +(DEFENUMERATED *ALU-FUNCTION-CLASSES* + (%ALU-FUNCTION-CLASS-BOOLEAN + %ALU-FUNCTION-CLASS-BYTE + %ALU-FUNCTION-CLASS-ADDER + %ALU-FUNCTION-CLASS-MULTIPLY-DIVIDE)) + +(DEFENUMERATED *ALU-FUNCTIONS* + (%ALU-FUNCTION-OP-BOOLEAN-0 + %ALU-FUNCTION-OP-BOOLEAN-1 + %ALU-FUNCTION-OP-DPB + %ALU-FUNCTION-OP-LDB + %ALU-FUNCTION-OP-ADD + %ALU-FUNCTION-OP-RESERVED + %ALU-FUNCTION-OP-MULTIPLY-STEP + %ALU-FUNCTION-OP-MULTIPLY-INVERT-STEP + %ALU-FUNCTION-OP-DIVIDE-STEP + %ALU-FUNCTION-OP-DIVIDE-INVERT-STEP)) + +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS* + (%ALU-BYTE-BACKGROUND-OP1 + %ALU-BYTE-BACKGROUND-ROTATE-LATCH + %ALU-BYTE-BACKGROUND-ZERO)) + +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH* + (%ALU-BYTE-HOLD-ROTATE-LATCH + %ALU-BYTE-SET-ROTATE-LATCH)) + +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS* + (%ALU-ADD-OP2-PASS + %ALU-ADD-OP2-INVERT)) + +(DEFENUMERATED *ALU-ADDER-OPS* + (%ALU-ADD-OP2 + %ALU-ADD-ZERO)) + +(defmacro %alu-function-dpb (background rotate-latch) + `(%logdpb %alu-function-op-dpb (byte 3 3) + (%logdpb ,rotate-latch (byte 1 2) + (%logdpb ,background (byte 2 0) + 0)))) +(export '%alu-function-dpb) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDF1.LISP ... +;;; + +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR #o0) +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR #o4000) +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR #o4400) +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR #o5000) + +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR #o5100) +(DEFSYSCONSTANT %RESET-TRAP-VECTOR #o5101) +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR #o5102) +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR #o5103) +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR #o5104) +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR #o5105) +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR #o5106) +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR #o5107) + +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5110) +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5111) +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR #o5112) +;;; 5113 reserved for future use +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR #o5114) +;;; 5115 reserved for a fence word +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR #o5116) +;;; 5117 reserved for a fence word + +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR #o5120) +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR #o5121) +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR #o5122) +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR #o5123) +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR #o5124) +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR #o5125) +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR #o5126) +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 5127) +;;; 5130 through 5177 reserved for future use + + +;;; +;;; The following definitions are from SYS:I-SYS;OPSDEF.LISP ... +;;; + +(in-package "I-LISP-COMPILER") + +(DEFCONSTANT *FINISH-CALL-N-OPCODE* #o134) diff --git a/support/robust-MBIN.lisp b/support/robust-MBIN.lisp new file mode 100644 index 0000000..c4b4f82 --- /dev/null +++ b/support/robust-MBIN.lisp @@ -0,0 +1,258 @@ +;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Reason: Function D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")(clos:method minimaccess::discard-transmit-buffer (minimaccess::udp-access-path t))0: . +;;; Variable 1minimaccess::*remote-memory-retransmission-interval*0: . +;;; Function 1(clos:method minimaccess::remote-memory-mbin-advance-output-buffer (minimaccess::remote-memory-access-path t))0: . +;;; Function (CLOS:METHOD MINIMACCESS::INITIALIZE-ACCESS-PATH (MINIMACCESS::CACHED-ACCESS-PATH) :AFTER): . +;;; Variable MINIMACCESS::*SAVED-WORLD-HEADER*: . +;;; Function MINIMACCESS::SAVE-WORLD: . +;;; Written by Palter, 2/11/93 22:50:13 +;;; while running on Sour Cream from FEP0:>Minima-Developer-for-VLM.ilod.1 +;;; with Experimental System 447.30, Experimental CLOS 433.1, Experimental RPC 437.0, +;;; Experimental Embedding Support 429.1, Experimental MacIvory Support 443.1, +;;; Experimental UX Support 438.0, Experimental Development Utilities 433.0, +;;; Experimental Old TV 431.0, Experimental Zwei 431.4, Experimental Utilities 440.6, +;;; Experimental RPC Development 432.0, Experimental MacIvory Development 430.0, +;;; Experimental UX Development 437.0, Experimental Server Utilities 438.1, +;;; Experimental Serial 431.0, Experimental Hardcopy 441.2, Experimental Zmail 438.0, +;;; Experimental LMFS Defstorage 416.0, Experimental SCSI 427.3, +;;; Experimental Tape 440.0, Experimental LMFS 439.0, Experimental NSage 436.1, +;;; Experimental Extended Help 437.0, Experimental CL Developer 424.0, +;;; Experimental Documentation Database 438.7, Experimental IP-TCP 447.3, +;;; Experimental IP-TCP Documentation 420.0, Experimental CLX 443.0, +;;; Experimental X Remote Screen 441.2, Experimental X Documentation 419.0, +;;; Experimental NFS Client 437.0, Experimental NFS Documentation 421.0, +;;; Experimental Serial Networks 4.6, Experimental Serial Networks Documentation 7.0, +;;; Experimental DNA 435.0, Experimental Metering 440.0, +;;; Experimental Metering Substrate 440.0, Experimental Conversion Tools 432.0, +;;; Experimental Hacks 436.0, Experimental Mac Dex 429.0, +;;; Experimental HyperCard/MacIvory 429.0, Experimental Statice Runtime 461.3, +;;; Experimental Statice 461.1, Experimental Statice Browser 461.0, +;;; Experimental Statice Documentation 424.0, Experimental CLIM 63.22, +;;; Experimental Genera CLIM 63.6, Experimental CLX CLIM 63.2, +;;; Experimental PostScript CLIM 63.2, Experimental CLIM Documentation 63.1, +;;; Experimental CLIM Demo 63.4, Experimental Symbolics Concordia 440.1, +;;; Experimental Essential Image Substrate 428.0, Experimental Image Substrate 436.0, +;;; Experimental Graphic Editing Documentation 430.0, +;;; Experimental Graphic Editing 437.0, Experimental Graphic Editor 436.0, +;;; Experimental Bitmap Editor 437.0, Experimental Postscript 432.0, +;;; Experimental Concordia Documentation 430.0, Experimental Lock Simple 433.0, +;;; Experimental Producer 417.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 439.1, +;;; Symbolics In-House Documentation 422.0, SCRC 437.0, Weather User 421.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 52.3, +;;; Experimental IFEP Kernel 329.7, Experimental IFEP Utilities 329.1, +;;; Experimental Alpha Assembler NEWEST, Experimental Minima Developer 49.5, +;;; Experimental Minima Debugger 29.3, Palter's Environment 24.0, +;;; Experimental Alpha Ivory Emulator NEWEST, Experimental Minima Kernel 33.0, +;;; cold load 1, Ivory Revision 4A (FPA enabled), FEP 329, +;;; FEP0:>I329-loaders.flod(5), FEP0:>I329-info.flod(5), FEP0:>I329-debug.flod(5), +;;; FEP0:>I329-lisp.flod(5), FEP0:>I329-kernel.fep(46), Boot ROM version 320, +;;; Device PROM version 325, Genera application 5.6, +;;; MacIvory SCSI Manager Server 4.3.1, Toolbox Servers 4.2, +;;; MacIvory & RPC library 6.3.2, MacIvory life support 4.3.6, +;;; Macintosh System Software 7.1, 1152x806 Screen with Genera fonts, +;;; Machine serial number 30014, Macintosh IIfx, Apple Extended Keyboard II, +;;; Fake a Rev5 trap dispatch table for the IFEP (from S:>Palter>VLM>FEP-Rev5-trap-dispatch-table), +;;; Force the FEP to print backtraces in error messages by default (from S:>Palter>VLM>FEP-prints-backtraces), +;;; Clear all Minima Debugger histories (from S:>Palter>VLM>clear-all-histories.lisp.1), +;;; Add a control register view to the Minima Debugger (from S:>Palter>VLM>control-register-view.lisp.2), +;;; Add the :VLM feature while compiling Minima files (from S:>Palter>VLM>compile-Minima-for-VLM.lisp.1), +;;; Provide access path to UNIX emulator (from VLM:EMULATOR;UNIX-ACCESS-PATH.LISP.6). + +;;; Patch file for Private version 0.0 +;;; Written by Palter, 2/14/93 16:40:41 +;;; while running on Herman from FEP0:>Sheltie-B-from-GMP-447-10.ilod.1 +;;; with Experimental System 447.31, Experimental CLOS 433.1, Experimental RPC 437.0, +;;; Experimental Embedding Support 429.1, Experimental MacIvory Support 443.1, +;;; Experimental UX Support 438.0, Experimental Development Utilities 433.0, +;;; Experimental Old TV 431.0, Experimental Zwei 431.4, Experimental Utilities 440.7, +;;; Experimental RPC Development 432.0, Experimental MacIvory Development 430.0, +;;; Experimental UX Development 437.0, Experimental Server Utilities 438.1, +;;; Experimental Serial 431.0, Experimental Hardcopy 441.2, Experimental Zmail 438.0, +;;; Experimental LMFS Defstorage 416.0, Experimental SCSI 427.3, +;;; Experimental Tape 440.0, Experimental LMFS 439.0, Experimental NSage 436.1, +;;; Experimental Extended Help 437.0, Experimental CL Developer 424.0, +;;; Experimental Documentation Database 434.30, Experimental IP-TCP 447.3, +;;; Experimental IP-TCP Documentation 417.0, Experimental CLX 443.0, +;;; Experimental X Remote Screen 441.2, Experimental X Documentation 416.1, +;;; Experimental NFS Client 437.0, Experimental NFS Documentation 418.0, +;;; Experimental Serial Networks 4.6, Experimental Serial Networks Documentation 4.0, +;;; Experimental DNA 435.0, Experimental Metering 440.0, +;;; Experimental Metering Substrate 440.0, Experimental Conversion Tools 431.0, +;;; Experimental Hacks 436.0, Experimental Mac Dex 429.0, +;;; Experimental HyperCard/MacIvory 429.0, +;;; Experimental Flavors-Statice Runtime 442.5, Experimental Flavors-Statice 442.0, +;;; Experimental Flavors-Statice Browser 442.0, +;;; Experimental Statice Documentation 421.1, Obsolete CLIM 62.33, +;;; Obsolete Genera CLIM 62.8, Obsolete CLX CLIM 62.4, Obsolete PostScript CLIM 62.4, +;;; Experimental CLIM Documentation 39.0, Obsolete CLIM Demo 62.4, +;;; Experimental Symbolics Concordia 440.1, +;;; Experimental Essential Image Substrate 428.0, Experimental Image Substrate 436.0, +;;; Experimental Graphic Editing Documentation 427.0, +;;; Experimental Graphic Editing 437.0, Experimental Graphic Editor 436.0, +;;; Experimental Bitmap Editor 437.0, Experimental Postscript 432.0, +;;; Experimental Concordia Documentation 427.0, Experimental Lock Simple 433.0, +;;; Experimental Producer 417.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 439.1, +;;; Symbolics In-House Documentation 419.1, SCRC 437.0, Weather User 421.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 52.3, +;;; Experimental IFEP Kernel 329.8, Experimental IFEP Utilities 329.1, +;;; Experimental Minima Developer 49.5, Experimental Minima Kernel 32.16, +;;; Experimental Minima Debugger 29.3, Experimental Minima Documentation 21.0, +;;; Palter's Environment 24.0, Sheltie Environment 2.0, +;;; Experimental Alpha Assembler NEWEST, Experimental Alpha Ivory Emulator NEWEST, +;;; cold load 1, Ivory Revision 4A, FEP 328, FEP0:>I328-loaders.flod(24), +;;; FEP0:>I328-info.flod(24), FEP0:>I328-debug.flod(24), FEP0:>I328-lisp.flod(25), +;;; FEP0:>I328-kernel.fep(44), Boot ROM version 320, Device PROM version 325, +;;; Genera application 5.6, MacIvory SCSI Manager Server 4.3.1, Toolbox Servers 4.2, +;;; MacIvory Serial I/O Server 1.2.1, MacIvory & RPC library 6.3.2, +;;; MacIvory life support 4.3.6, Macintosh System Software 7.1, +;;; 832x566 Screen with small Genera fonts, Machine serial number 30372, +;;; Macintosh Quadra 700, Apple Extended Keyboard II, +;;; Fix packet loss in embedded serial (from SYS:SHELTIE;EMB-SERIAL-FIX.LISP.1), +;;; Clear all Minima Debugger histories (from S:>Palter>VLM>clear-all-histories.lisp.1), +;;; Add the :VLM feature while compiling Minima files (from S:>Palter>VLM>compile-Minima-for-VLM.lisp.1), +;;; Add a control register view to the Minima Debugger (from S:>Palter>VLM>control-register-view.lisp.2), +;;; Make the "ROM" MBIN protocol more robust (from S:>Palter>VLM>robust-MBIN.lisp.2), +;;; Provide access path to UNIX emulator (from VLM:EMULATOR;UNIX-ACCESS-PATH.LISP.6). + + + +#+(OR MINIMA-RUNTIME MINIMA-DEVELOPER) (IN-PACKAGE "COMMON-LISP-USER") + +(2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI"); 0(SCT:NOTE-PRIVATE-PATCH "Make the \"ROM\" MBIN protocol more robust") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;UDP.LISP.20") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH +1(defmethod discard-transmit-buffer ((access-path udp-access-path) buffer-pma) +0 1(with-slots (conn buffer-map) access-path +0 1(scl:send conn :discard-output-buffer (gethash buffer-pma buffer-map)))) + + +0;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;REMOTE-MEMORY.LISP.38") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH +(defparameter *remote-memory-retransmission-interval* 120) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;REMOTE-MEMORY.LISP.38") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH +(defmethod remote-memory-mbin-advance-output-buffer + ((access-path remote-memory-access-path) index) + (with-slots (communications-buffer communications-bitmap mbin-buffer) access-path + (with-embedded-communications (comm-addr access-path) + (declare (ignore comm-addr)) + 1(with-buffer (access-path) +0 1((buffer) +0 (setf (remote-memory-command-opcode mbin-buffer) remote-memory-mbin) + (setf (remote-memory-command-operand mbin-buffer) index) + 1(let ((id (remote-memory-command-message-id buffer)) + (words (ceiling (+ 8 index) 4))) +0 1(si:%block-scavenge-copy mbin-buffer buffer words) + (setf (remote-memory-command-message-id buffer) id)) + index) +0 1((buffer) +0 1(declare (ignore buffer)) +0 1(setf (aref communications-bitmap (ldb (byte 4 0)0 1(remote-memory-command-message-id + mbin-buffer))) + nil) +0 1(discard-transmit-buffer access-path (shiftf mbin-buffer nil))))0))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;ACCESS-PATHS.LISP.71") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Base: 10; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH + +1(defmethod initialize-access-path :after ((access-path cached-access-path)) +0 1(clear-caches access-path)) + + +0;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;ACCESS-PATHS.LISP.71") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Base: 10; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH + +1(defparameter *saved-world-header* (sys:%make-unmapped-address 0#x411031)) + + +0;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:ACCESS;ACCESS-PATHS.LISP.71") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Base: 10; Package: MINIMACCESS; Syntax: ANSI-COMMON-LISP; Lowercase: Yes -*-") + +#+IMACH + +(defun save-world (access-path file) + (loop until (multiple-value-bind (tag pointer successp) + (remote-memory-read access-path 1:virtual *saved-world-header*0) + (declare (ignore pointer)) + (and successp (= tag sys:dtp-locative))) + do (minimaccess::clear-caches access-path) + (sleep 1)) + (flet ((read-word (loc-type location cdr type) + (multiple-value-bind (tag pointer successp) + (remote-memory-read access-path loc-type location) + (unless (and successp (= tag (dpb cdr (byte 2 6) type))) + (error "Remote world is not set up properly.")) + pointer))) + (let* ((header (read-word 1:virtual *saved-world-header* 00 sys:dtp-locative)) + (header-length + (+ 8 (* 3 (+ (read-word :virtual (+ header 1) 1 sys:dtp-small-ratio) + (read-word :virtual (+ header 2) 1 sys:dtp-single-float))))) + (estimated-length + (* sys:page-size + 5 + (+ (read-word :virtual (+ header header-length -1) 0 sys:dtp-fixnum) + (ldb (byte 16 8) (1- (read-word :virtual (+ header header-length -2) + 0 sys:dtp-fixnum))) + 1)))) + (scl:with-open-file (stream file :direction :output :element-type '(unsigned-byte 8) + :estimated-length estimated-length) + (flet ((copy-to-file (base-position address words) + (quad-buffered-map-over-addresses + access-path :read :virtual address words + #'(lambda (offset array start-position n-words) + (unless (= (file-position stream) (+ base-position (* 5 offset))) + (file-position stream (+ base-position (* 5 offset)))) + (scl:stack-let ((buffer (make-array + (* (length array) 4) + :displaced-to array + :element-type '(unsigned-byte 8)))) + (scl:send stream :string-out buffer start-position (* n-words 5))))))) + (copy-to-file 0 header (* 256 (ceiling header-length 256))) + (loop for i from 8 below header-length by 3 do + (copy-to-file (* 256 5 (read-word :virtual (+ header i 2) 0 sys:dtp-fixnum)) + (read-word :virtual (+ header i 0) 0 sys:dtp-locative) + (ldb (byte 24 0) + (read-word :virtual (+ header i 1) 0 sys:dtp-fixnum))))))))) + diff --git a/support/sbcl-packages.lisp b/support/sbcl-packages.lisp new file mode 100644 index 0000000..398e311 --- /dev/null +++ b/support/sbcl-packages.lisp @@ -0,0 +1,29 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: COMMON-LISP-USER; Base: 10; Lowercase: Yes -*- +(in-package "COMMON-LISP-USER") + +;;; Packages used by the emulator that aren't defined in OpenMCL + +(defpackage LISP + (:use COMMON-LISP) + (:export "AND" "OR")) + +(defpackage CLOS + (:use COMMON-LISP) + (:export "DEFCLASS" "DEFGENERIC" "DEFMETHOD" "INITIALIZE-INSTANCE" "WITH-SLOTS" + "PRINT-OBJECT" "SLOT-VALUE" "MAKE-INSTANCE")) + +(defpackage FUTURE-COMMON-LISP + (:use COMMON-LISP) + (:export "PRINT-UNREADABLE-OBJECT")) + +(defpackage COMPILER + (:use COMMON-LISP) + (:export "WARN")) + +(defpackage SYSTEM + (:nicknames "SYS") + (:use COMMON-LISP)) + +(defpackage I-LISP-COMPILER + (:use COMMON-LISP) + (:export *FINISH-CALL-N-OPCODE*)) diff --git a/support/sbcl-support.lisp b/support/sbcl-support.lisp new file mode 100644 index 0000000..e522c54 --- /dev/null +++ b/support/sbcl-support.lisp @@ -0,0 +1,360 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SYSTEM; Base: 10; Lowercase: Yes -*- + +;;; +;;(declaim (sb-ext:muffle-conditions sb-ext:compiler-note)) + +;; (in-package "CCL") + +;; (defmacro defsubst (name arglist &body body) +;; `(progn +;; (declaim (inline ,name)) +;; (defun ,name ,arglist ,@body))) + +(defmacro defsubst (name arglist &body body) + `(progn + (declaim (inline ,name)) + (defun ,name ,arglist ,@body))) + +(defmacro stack-let (vars-and-vals &body body) + (let ((vars (loop for var-and-val in vars-and-vals + if (atom var-and-val) + collect var-and-val + else + collect (first var-and-val)))) + `(let ,vars-and-vals + (declare (dynamic-extent ,@vars)) + ,@body))) + +;; (declaim (inline circular-list)) +;; (defun circular-list (&rest list) +;; (let ((list (copy-list list))) +;; (setf (cdr (last list)) list) +;; list)) + +;;; + +(in-package "SYSTEM") + +;;(defsubst %32-bit-difference (x y) +;; (- x y)) + +(defun %32-bit-difference (x y) + (- x y)) + +(export '(%logldb %logdpb %32-bit-difference)) + +;(ccl::defsubst %logldb (bytespec integer) +; (ldb bytespec integer)) + +;; (ccl::defsubst %logdpb (value bytespec integer) +;; (let ((result (dpb value bytespec integer))) +;; (if (zerop (ldb (byte 1 31) result)) +;; result +;; (- (ldb (byte 31 0) (1+ (lognot result))))))) + +;;(ccl::defsubst %32-bit-difference (x y) +;; (- x y)) + +;;; + +(defmacro defsysconstant (name value) + `(progn + (defconstant ,name ,value) + (export ',name))) + +(defmacro defenumerated (list-name code-list &optional (start 0) (increment 1) end) + (when (and end (not (= (length code-list) (/ (- end start) increment)))) + (error "~s has ~s codes where ~s are required" + list-name (length code-list) (/ (- end start) increment))) + `(progn + (defsysconstant ,list-name ',code-list) + ,@(loop for code in code-list and prev = 0 then code + as value from start by increment + unless (eq code prev) ;kludge for data-types + collect `(defsysconstant ,code ,value)))) + +(defmacro defsysbyte (name size position) + `(defsysconstant ,name (byte ,size ,position))) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDEF.LISP ... +;;; + +;; --- most of the below is L-specific +;; To add a new data type, update the following (at least): +;; *DATA-TYPES* and *POINTER-DATA-TYPES* in this file +;; Patch *DATA-TYPE-NAME*, set up by from *DATA-TYPES* by the cold-load generator +;; type-map-for-transport, transporter-type-map-alist in sys: l-ucode; uu.lisp +;; *storing-type-map* in sys: l-ucode; uux.lisp and reload that whole file +;; It is important that the form near the end of that file that sets up the +;; no-trap type-map be executed before any other type maps are assigned. +;; simulate-transporter in sys: l-ucode; simx.lisp +;; and recompile the whole microcode to get the type-maps updated +;; typep-alist and related stuff in sys: sys; lcons.lisp +;; dbg:*good-data-types* if it is indeed a good data type +;; Send a message to the maintainer of the FEP-resident debugger. + +(DEFENUMERATED *DATA-TYPES* ( + ;; Headers, special markers, and forwarding pointers. + DTP-NULL ;00 Unbound variable/function, uninitialized storage + DTP-MONITOR-FORWARD ;01 This cell being monitored + DTP-HEADER-P ;02 Structure header, with pointer field + DTP-HEADER-I ;03 Structure header, with immediate bits + DTP-EXTERNAL-VALUE-CELL-POINTER ;04 Invisible except for binding + DTP-ONE-Q-FORWARD ;05 Invisible pointer (forwards one cell) + DTP-HEADER-FORWARD ;06 Invisible pointer (forwards whole structure) + DTP-ELEMENT-FORWARD ;07 Invisible pointer in element of structure + ;; Numeric data types. + DTP-FIXNUM ;10 Small integer + DTP-SMALL-RATIO ;11 Ratio with small numerator and denominator + DTP-SINGLE-FLOAT ;12 Single-precision floating point + DTP-DOUBLE-FLOAT ;13 Double-precision floating point + DTP-BIGNUM ;14 Big integer + DTP-BIG-RATIO ;15 Ratio with big numerator or denominator + DTP-COMPLEX ;16 Complex number + DTP-SPARE-NUMBER ;17 A number to the hardware trap mechanism + ;; Instance data types. + DTP-INSTANCE ;20 Ordinary instance + DTP-LIST-INSTANCE ;21 Instance that masquerades as a cons + DTP-ARRAY-INSTANCE ;22 Instance that masquerades as an array + DTP-STRING-INSTANCE ;23 Instance that masquerades as a string + ;; Primitive data types. + DTP-NIL ;24 The symbol NIL + DTP-LIST ;25 A cons + DTP-ARRAY ;26 An array that is not a string + DTP-STRING ;27 A string + DTP-SYMBOL ;30 A symbol other than NIL + DTP-LOCATIVE ;31 Locative pointer + DTP-LEXICAL-CLOSURE ;32 Lexical closure of a function + DTP-DYNAMIC-CLOSURE ;33 Dynamic closure of a function + DTP-COMPILED-FUNCTION ;34 Compiled code + DTP-GENERIC-FUNCTION ;35 Generic function (see later section) + DTP-SPARE-POINTER-1 ;36 Spare + DTP-SPARE-POINTER-2 ;37 Spare + DTP-PHYSICAL-ADDRESS ;40 Physical address + DTP-SPARE-IMMEDIATE-1 ;41 Spare + DTP-BOUND-LOCATION ;42 Deep bound marker + DTP-CHARACTER ;43 Common Lisp character object + DTP-LOGIC-VARIABLE ;44 Unbound logic variable marker + DTP-GC-FORWARD ;45 Object-moved flag for garbage collector + DTP-EVEN-PC ;46 PC at first instruction in word + DTP-ODD-PC ;47 PC at second instruction in word + ;; Full-word instructions. + DTP-CALL-COMPILED-EVEN ;50 Start call, address is compiled function + DTP-CALL-COMPILED-ODD ;51 Start call, address is compiled function + DTP-CALL-INDIRECT ;52 Start call, address is function cell + DTP-CALL-GENERIC ;53 Start call, address is generic function + DTP-CALL-COMPILED-EVEN-PREFETCH ;54 Like above, but prefetching is desireable + DTP-CALL-COMPILED-ODD-PREFETCH ;55 Like above, but prefetching is desireable + DTP-CALL-INDIRECT-PREFETCH ;56 Like above, but prefetching is desireable + DTP-CALL-GENERIC-PREFETCH ;57 Like above, but prefetching is desireable + ;; Half-word (packed) instructions consume 4 bits of data type field (opcodes 60..77). + DTP-PACKED-INSTRUCTION-60 DTP-PACKED-INSTRUCTION-61 DTP-PACKED-INSTRUCTION-62 + DTP-PACKED-INSTRUCTION-63 DTP-PACKED-INSTRUCTION-64 DTP-PACKED-INSTRUCTION-65 + DTP-PACKED-INSTRUCTION-66 DTP-PACKED-INSTRUCTION-67 DTP-PACKED-INSTRUCTION-70 + DTP-PACKED-INSTRUCTION-71 DTP-PACKED-INSTRUCTION-72 DTP-PACKED-INSTRUCTION-73 + DTP-PACKED-INSTRUCTION-74 DTP-PACKED-INSTRUCTION-75 DTP-PACKED-INSTRUCTION-76 + DTP-PACKED-INSTRUCTION-77 + ) + 0 1 #o100) + +(DEFENUMERATED *ARRAY-ELEMENT-DATA-TYPES* ( + ARRAY-ELEMENT-TYPE-FIXNUM + ARRAY-ELEMENT-TYPE-CHARACTER + ARRAY-ELEMENT-TYPE-BOOLEAN + ARRAY-ELEMENT-TYPE-OBJECT + )) + +;;; Control register. + +(DEFSYSBYTE %%CR.ARGUMENT-SIZE 8. 0) ;Number of spread arguments supplied by caller +(DEFSYSBYTE %%CR.APPLY 1 17.) ;1 If caller used APPLY, 0 otherwise +(DEFSYSBYTE %%CR.VALUE-DISPOSITION 2 18.) ;The value of this function +(DEFSYSBYTE %%CR.CLEANUP-BITS 3 24.) ;All the cleanup bits +(DEFSYSBYTE %%CR.CLEANUP-CATCH 1 26.) ;There are active catch blocks in the current frame +(DEFSYSBYTE %%CR.CLEANUP-BINDINGS 1 25.) ;There are active bindings in the current frame +(DEFSYSBYTE %%CR.TRAP-ON-EXIT-BIT 1 24.) ;Software trap before exiting this frame +(DEFSYSBYTE %%CR.TRAP-MODE 2 30.) ;1 If we are executing on the "extra stack" + ;Extra stack inhibits sequence breaks and preemption + ;It also allows the "overflow" part of the stack to + ;be used without traps. +(DEFSYSBYTE %%CR.EXTRA-ARGUMENT 1 8.) ;The call instruction supplied an "extra" argument +(DEFSYSBYTE %%CR.CALLER-FRAME-SIZE 8 9.) ;The frame size of the Caller +(DEFSYSBYTE %%CR.CALL-STARTED 1 22.) ;Between start-call and finish-call. +(DEFSYSBYTE %%CR.CLEANUP-IN-PROGRESS 1 23.) +(DEFSYSBYTE %%CR.INSTRUCTION-TRACE 1 29.) +(DEFSYSBYTE %%CR.CALL-TRACE 1 28.) +(DEFSYSBYTE %%CR.TRACE-PENDING 1 27.) +(DEFSYSBYTE %%CR.TRACE-BITS 3 27.) + +(DEFSYSBYTE %%CR.CLEANUP-AND-TRACE-BITS 6 24.) + +(DEFENUMERATED *VALUE-DISPOSITIONS* ( + VALUE-DISPOSITION-EFFECT ;The callers wants no return values + VALUE-DISPOSITION-VALUE ;The caller wants a single return value + VALUE-DISPOSITION-RETURN ;The caller wants to return whatever values are + ;returned by this function + VALUE-DISPOSITION-MULTIPLE ;The callers wants multiple values + )) + +(DEFENUMERATED *TRAP-MODES* ( + TRAP-MODE-EMULATOR + TRAP-MODE-EXTRA-STACK + TRAP-MODE-IO + TRAP-MODE-FEP)) + +(DEFENUMERATED *MEMORY-CYCLE-TYPES* ( + %MEMORY-DATA-READ + %MEMORY-DATA-WRITE + %MEMORY-BIND-READ + %MEMORY-BIND-WRITE + %MEMORY-BIND-READ-NO-MONITOR + %MEMORY-BIND-WRITE-NO-MONITOR + %MEMORY-HEADER + %MEMORY-STRUCTURE-OFFSET + %MEMORY-SCAVENGE + %MEMORY-CDR + %MEMORY-GC-COPY + %MEMORY-RAW + %MEMORY-RAW-TRANSLATE + )) + +;;; Internal register definitions + +;;; %REGISTER-ALU-AND-ROTATE-CONTROL fields (DP-OP in hardware spec) + +(DEFSYSBYTE %%ALU-BYTE-R 5 0.) +(DEFSYSBYTE %%ALU-BYTE-S 5 5.) +(DEFSYSBYTE %%ALU-FUNCTION 6 10.) +(DEFSYSBYTE %%ALU-FUNCTION-CLASS 2 14.) +(DEFSYSBYTE %%ALU-FUNCTION-BITS 4 10.) +(DEFSYSBYTE %%ALU-CONDITION 5 16.) +(DEFSYSBYTE %%ALU-CONDITION-SENSE 1 21.) + +;; The following are implemented in Rev3 only. +;; Software forces them to the proper value for compatible operation in Rev1 and Rev2. +(DEFSYSBYTE %%ALU-OUTPUT-CONDITION 1 22.) +(DEFSYSBYTE %%ALU-ENABLE-CONDITION-EXCEPTION 1 23.) +(DEFSYSBYTE %%ALU-ENABLE-LOAD-CIN 1 24.) + +(DEFENUMERATED *ALU-CONDITION-SENSES* + (%ALU-CONDITION-SENSE-TRUE + %ALU-CONDITION-SENSE-FALSE)) + +(DEFENUMERATED *ALU-CONDITIONS* + (%ALU-CONDITION-SIGNED-LESS-THAN-OR-EQUAL ;00 + %ALU-CONDITION-SIGNED-LESS-THAN ;01 + %ALU-CONDITION-NEGATIVE ;02 + %ALU-CONDITION-SIGNED-OVERFLOW ;03 + %ALU-CONDITION-UNSIGNED-LESS-THAN-OR-EQUAL ;04 + %ALU-CONDITION-UNSIGNED-LESS-THAN ;05 + %ALU-CONDITION-ZERO ;06 + %ALU-CONDITION-HIGH-25-ZERO ;07 + %ALU-CONDITION-EQ ;10 + %ALU-CONDITION-OP1-EPHEMERALP ;11 + %ALU-CONDITION-OP1-TYPE-ACCEPTABLE ;12 + %ALU-CONDITION-OP1-TYPE-CONDITION ;13 + %ALU-CONDITION-RESULT-TYPE-NIL ;14 + %ALU-CONDITION-OP2-FIXNUM ;15 + %ALU-CONDITION-FALSE ;16 + %ALU-CONDITION-RESULT-CDR-LOW ;17 + %ALU-CONDITION-CLEANUP-BITS-SET ;20 + %ALU-CONDITION-ADDRESS-IN-STACK-CACHE ;21 + %ALU-CONDITION-PENDING-SEQUENCE-BREAK-ENABLED ;22 + %ALU-CONDITION-EXTRA-STACK-MODE ;23 + %ALU-CONDITION-FEP-MODE ;24 + %ALU-CONDITION-FP-COPROCESSOR-PRESENT ;25 + %ALU-CONDITION-OP1-OLDSPACEP ;26 + %ALU-CONDITION-STACK-CACHE-OVERFLOW ;27 + %ALU-CONDITION-OR-LOGIC-VARIABLE ;30 + )) + +(DEFENUMERATED *ALU-FUNCTION-CLASSES* + (%ALU-FUNCTION-CLASS-BOOLEAN + %ALU-FUNCTION-CLASS-BYTE + %ALU-FUNCTION-CLASS-ADDER + %ALU-FUNCTION-CLASS-MULTIPLY-DIVIDE)) + +(DEFENUMERATED *ALU-FUNCTIONS* + (%ALU-FUNCTION-OP-BOOLEAN-0 + %ALU-FUNCTION-OP-BOOLEAN-1 + %ALU-FUNCTION-OP-DPB + %ALU-FUNCTION-OP-LDB + %ALU-FUNCTION-OP-ADD + %ALU-FUNCTION-OP-RESERVED + %ALU-FUNCTION-OP-MULTIPLY-STEP + %ALU-FUNCTION-OP-MULTIPLY-INVERT-STEP + %ALU-FUNCTION-OP-DIVIDE-STEP + %ALU-FUNCTION-OP-DIVIDE-INVERT-STEP)) + +(DEFENUMERATED *ALU-BYTE-BACKGROUNDS* + (%ALU-BYTE-BACKGROUND-OP1 + %ALU-BYTE-BACKGROUND-ROTATE-LATCH + %ALU-BYTE-BACKGROUND-ZERO)) + +(DEFENUMERATED *ALU-BYTE-ROTATE-LATCH* + (%ALU-BYTE-HOLD-ROTATE-LATCH + %ALU-BYTE-SET-ROTATE-LATCH)) + +(DEFENUMERATED *ALU-ADD-OP2-ACTIONS* + (%ALU-ADD-OP2-PASS + %ALU-ADD-OP2-INVERT)) + +(DEFENUMERATED *ALU-ADDER-OPS* + (%ALU-ADD-OP2 + %ALU-ADD-ZERO)) + +(defmacro %alu-function-dpb (background rotate-latch) + `(%logdpb %alu-function-op-dpb (byte 3 3) + (%logdpb ,rotate-latch (byte 1 2) + (%logdpb ,background (byte 2 0) + 0)))) +(export '%alu-function-dpb) + + +;;; +;;; The following definitions are from SYS:I-SYS;SYSDF1.LISP ... +;;; + +(DEFSYSCONSTANT %ARITHMETIC-INSTRUCTION-EXCEPTION-VECTOR #o0) +(DEFSYSCONSTANT %INSTRUCTION-EXCEPTION-VECTOR #o4000) +(DEFSYSCONSTANT %INTERPRETER-FUNCTION-VECTOR #o4400) +(DEFSYSCONSTANT %GENERIC-DISPATCH-VECTOR #o5000) + +(DEFSYSCONSTANT %ERROR-TRAP-VECTOR #o5100) +(DEFSYSCONSTANT %RESET-TRAP-VECTOR #o5101) +(DEFSYSCONSTANT %PULL-APPLY-ARGS-TRAP-VECTOR #o5102) +(DEFSYSCONSTANT %STACK-OVERFLOW-TRAP-VECTOR #o5103) +(DEFSYSCONSTANT %TRACE-TRAP-VECTOR #o5104) +(DEFSYSCONSTANT %PREEMPT-REQUEST-TRAP-VECTOR #o5105) +(DEFSYSCONSTANT %TRANSPORT-TRAP-VECTOR #o5106) +(DEFSYSCONSTANT %FEP-MODE-TRAP-VECTOR #o5107) + +(DEFSYSCONSTANT %LOW-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5110) +(DEFSYSCONSTANT %HIGH-PRIORITY-SEQUENCE-BREAK-TRAP-VECTOR #o5111) +(DEFSYSCONSTANT %MONITOR-TRAP-VECTOR #o5112) +;;; 5113 reserved for future use +(DEFSYSCONSTANT %GENERIC-DISPATCH-TRAP-VECTOR #o5114) +;;; 5115 reserved for a fence word +(DEFSYSCONSTANT %MESSAGE-DISPATCH-TRAP-VECTOR #o5116) +;;; 5117 reserved for a fence word + +(DEFSYSCONSTANT %PAGE-NOT-RESIDENT-TRAP-VECTOR #o5120) +(DEFSYSCONSTANT %PAGE-FAULT-REQUEST-TRAP-VECTOR #o5121) +(DEFSYSCONSTANT %PAGE-WRITE-FAULT-TRAP-VECTOR #o5122) +(DEFSYSCONSTANT %UNCORRECTABLE-MEMORY-ERROR-TRAP-VECTOR #o5123) +(DEFSYSCONSTANT %MEMORY-BUS-ERROR-TRAP-VECTOR #o5124) +(DEFSYSCONSTANT %DB-CACHE-MISS-TRAP-VECTOR #o5125) +(DEFSYSCONSTANT %DB-UNWIND-FRAME-TRAP-VECTOR #o5126) +(DEFSYSCONSTANT %DB-UNWIND-CATCH-TRAP-VECTOR 5127) +;;; 5130 through 5177 reserved for future use + + +;;; +;;; The following definitions are from SYS:I-SYS;OPSDEF.LISP ... +;;; + +(in-package "I-LISP-COMPILER") + +(DEFCONSTANT *FINISH-CALL-N-OPCODE* #o134) diff --git a/support/start-without-Load-World.lisp b/support/start-without-Load-World.lisp new file mode 100644 index 0000000..14d4e3c --- /dev/null +++ b/support/start-without-Load-World.lisp @@ -0,0 +1,98 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T -*- +;;; Patch file for Private version 0.0 +;;; Reason: CLIM Command M-DBG::COM-START-APPLICATION: . +;;; CLIM Command M-DBG::COM-START-INTERACTOR: . +;;; Written by Palter, 12/31/92 03:28:55 +;;; while running on Herman from FEP0:>Sheltie-B-from-GMP-447-10.ilod.1 +;;; with Experimental System 447.18, Experimental CLOS 433.0, Experimental RPC 437.0, +;;; Experimental Embedding Support 429.0, Experimental MacIvory Support 443.1, +;;; Experimental UX Support 438.0, Experimental Development Utilities 433.0, +;;; Experimental Old TV 431.0, Experimental Zwei 431.3, Experimental Utilities 440.4, +;;; Experimental RPC Development 432.0, Experimental MacIvory Development 430.0, +;;; Experimental UX Development 437.0, Experimental Server Utilities 438.0, +;;; Experimental Serial 431.0, Experimental Hardcopy 441.1, Experimental Zmail 438.0, +;;; Experimental LMFS Defstorage 416.0, Experimental SCSI 427.2, +;;; Experimental Tape 440.0, Experimental LMFS 439.0, Experimental NSage 436.1, +;;; Experimental Extended Help 437.0, Experimental CL Developer 424.0, +;;; Experimental Documentation Database 434.30, Experimental IP-TCP 447.1, +;;; Experimental IP-TCP Documentation 417.0, Experimental CLX 443.0, +;;; Experimental X Remote Screen 441.1, Experimental X Documentation 416.1, +;;; Experimental NFS Client 437.0, Experimental NFS Documentation 418.0, +;;; Experimental Serial Networks 4.2, Experimental Serial Networks Documentation 4.0, +;;; Experimental DNA 435.0, Experimental Metering 440.0, +;;; Experimental Metering Substrate 440.0, Experimental Conversion Tools 431.0, +;;; Experimental Hacks 436.0, Experimental Mac Dex 429.0, +;;; Experimental HyperCard/MacIvory 429.0, +;;; Experimental Flavors-Statice Runtime 442.5, Experimental Flavors-Statice 442.0, +;;; Experimental Flavors-Statice Browser 442.0, +;;; Experimental Statice Documentation 421.1, Obsolete CLIM 62.33, +;;; Obsolete Genera CLIM 62.8, Obsolete CLX CLIM 62.4, Obsolete PostScript CLIM 62.4, +;;; Experimental CLIM Documentation 39.0, Obsolete CLIM Demo 62.4, +;;; Experimental Symbolics Concordia 440.1, +;;; Experimental Essential Image Substrate 428.0, Experimental Image Substrate 436.0, +;;; Experimental Graphic Editing Documentation 427.0, +;;; Experimental Graphic Editing 437.0, Experimental Graphic Editor 436.0, +;;; Experimental Bitmap Editor 437.0, Experimental Postscript 432.0, +;;; Experimental Concordia Documentation 427.0, Experimental Lock Simple 433.0, +;;; Experimental Producer 417.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 439.1, +;;; Symbolics In-House Documentation 419.1, SCRC 437.0, Weather User 421.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 52.2, +;;; Experimental IFEP Kernel 329.5, Experimental IFEP Utilities 329.1, +;;; Experimental Minima Developer 49.3, Experimental Minima Kernel 32.10, +;;; Experimental Minima Debugger 29.2, Experimental Minima Documentation 21.0, +;;; Palter's Environment 24.0, Sheltie Environment 2.0, cold load 1, +;;; Ivory Revision 4A, FEP 328, FEP0:>I328-loaders.flod(24), +;;; FEP0:>I328-info.flod(24), FEP0:>I328-debug.flod(24), FEP0:>I328-lisp.flod(25), +;;; FEP0:>I328-kernel.fep(44), Boot ROM version 320, Device PROM version 325, +;;; Genera application 5.6, MacIvory SCSI Manager Server 4.3.1, Toolbox Servers 4.2, +;;; MacIvory Serial I/O Server 1.2.1, MacIvory & RPC library 6.3.2, +;;; MacIvory life support 4.3.6, Macintosh System Software 7.1, +;;; 832x566 Screen with small Genera fonts, Machine serial number 30372, +;;; Macintosh Quadra 700, Apple Extended Keyboard II, +;;; Fix packet loss in embedded serial (from SYS:SHELTIE;EMB-SERIAL-FIX.LISP.1), +;;; Provide access path to UNIX emulator (from VLM:EMULATOR;UNIX-ACCESS-PATH.LISP.6). + + +#+(OR MINIMA-RUNTIME MINIMA-DEVELOPER) (IN-PACKAGE "COMMON-LISP-USER") + +(SCT:FILES-PATCHED-IN-THIS-PATCH-FILE + "MINIMA:DEBUGGER;COMMANDS.LISP.101") + + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI"); 0(SCT:NOTE-PRIVATE-PATCH "Make the Minima Debugger Start commands work without Load World...") + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.101") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH + +(define-debugger-command (com-Start-Application :menu t :name t) + () + "Start the application, if any, in the loaded image, starting the image if necessary" + (let ((access-path (debugger-access-path *application-frame*))) + (minimaccess::remote-memory-cold-boot access-path :boot-type :cold) + (minimaccess::remote-memory-system-startup access-path :startup-type :application))) + + +;======================== +(SCT:BEGIN-PATCH-SECTION) +(SCT:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.101") +#+IMACH +(SCT:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +#+IMACH + +(define-debugger-command (com-Start-Interactor :menu t :name t) + () + "Start a Lisp interactor in the loaded image, starting the image if necessary" + (let ((access-path (debugger-access-path *application-frame*))) + (minimaccess::remote-memory-cold-boot access-path :boot-type :cold) + (minimaccess::remote-memory-system-startup access-path :startup-type :interactor))) + diff --git a/support/unix-access-path.lisp b/support/unix-access-path.lisp new file mode 100644 index 0000000..2fd713b --- /dev/null +++ b/support/unix-access-path.lisp @@ -0,0 +1,188 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: USER; Base: 10; Patch-File: T; Lowercase: Yes -*- +;;; Patch file for Private version 0.0 +;;; Reason: CLOS class MINIMACCESS::UDP-ACCESS-PATH: Add PORT slot for rendezvous port +;;; Function (CLOS:METHOD MINIMACCESS::ENSURE-CONN (MINIMACCESS::UDP-ACCESS-PATH)): Use it +;;; Command M-DBG::COM-CREATE-MINIMA-ACCESS-PATH: Create one +;;; Written by Kaufman, 3/25/92 17:59:27 +;;; while running on Ged from FEP8:>Minima-38-D.ilod.1 +;;; with Experimental System 441.47, Experimental CLOS 426.1, Experimental RPC 430.1, +;;; Experimental Embedding Support 422.1, Experimental MacIvory Support 436.4, +;;; Experimental UX Support 431.0, Experimental Development Utilities 426.2, +;;; Experimental Old TV 424.0, Experimental Zwei 424.4, Experimental Utilities 434.2, +;;; Experimental RPC Development 425.1, Experimental MacIvory Development 424.1, +;;; Experimental UX Development 430.0, Experimental Server Utilities 432.0, +;;; Experimental Serial 425.12, Experimental Hardcopy 435.0, +;;; Experimental Zmail 432.2, Experimental LMFS Defstorage 408.0, +;;; Experimental SCSI 421.2, Experimental Tape 434.1, Experimental LMFS 433.0, +;;; Experimental NSage 430.0, Experimental Extended Help 431.0, +;;; Experimental CL Developer 418.0, Experimental Documentation Database 429.37, +;;; Experimental IP-TCP 440.5, Experimental IP-TCP Documentation 413.0, +;;; Experimental CLX 436.3, Experimental X Remote Screen 434.2, +;;; Experimental X Documentation 412.0, Experimental NFS Client 430.1, +;;; Experimental NFS Documentation 414.1, Experimental DNA 429.0, +;;; Experimental Metering 434.0, Experimental Metering Substrate 434.0, +;;; Experimental Conversion Tools 425.0, Experimental Hacks 430.0, +;;; Experimental Mac Dex 423.0, Experimental HyperCard/MacIvory 423.1, +;;; Experimental Statice Runtime 414.1, Experimental Statice 435.1, +;;; Experimental Statice Browser 411.0, Experimental Statice Documentation 417.0, +;;; Experimental CLIM 35.12, Experimental CLIM Documentation 35.10, +;;; Experimental CLIM Demo 35.2, Experimental Symbolics Concordia 434.0, +;;; Experimental Essential Image Substrate 422.0, Experimental Image Substrate 430.1, +;;; Experimental Graphic Editing Documentation 422.1, +;;; Experimental Graphic Editing 431.0, Experimental Graphic Editor 430.1, +;;; Experimental Bitmap Editor 431.0, Experimental Postscript 426.0, +;;; Experimental Concordia Documentation 422.0, Experimental Lock Simple 427.0, +;;; Experimental Producer 411.0, Version Control 404.4, Compare Merge 403.0, +;;; VC Documentation 401.0, Symbolics In-House 433.6, +;;; Symbolics In-House Documentation 415.15, SCRC 431.1, Weather User 415.0, +;;; Logical Pathnames Translation Files NEWEST, Experimental IFEP Compiler 51.17, +;;; Experimental IFEP Kernel 328.0, Experimental IFEP Utilities 328.0, +;;; Experimental Minima Developer 38.9, Experimental Minima Storage Cold 26, +;;; Experimental Minima Storage 21, Experimental Minima Storage CLOS 11, +;;; Experimental Minima Developer Network 7.1, Experimental Minima Debugger 17.33, +;;; Experimental Minima Documentation 12.9, cold load 3, +;;; Ivory Revision 4 (FPA enabled), SCSI part WD33C93A, FEP 327, +;;; FEP0:>I327-loaders.flod(13), FEP0:>I327-info.flod(14), FEP0:>I327-debug.flod(5), +;;; FEP0:>I327-lisp.flod(5), FEP0:>I327-kernel.fep(10), Boot ROM version 316, +;;; Device PROM version 327, 1024x798 B&W Screen, Machine serial number 357, +;;; Integrate REXEC password checking with NFS password checking (from R:>kaufman>rel-8-2>rexec-passwords.lisp.5). + + +(SYSTEM-INTERNALS:FILES-PATCHED-IN-THIS-PATCH-FILE + "MINIMA:DEBUGGER;COMMANDS.LISP.90" + "MINIMA:ACCESS;UDP.LISP.17") + + +D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI"); 0(NOTE-PRIVATE-PATCH "Provide access path to UNIX emulator") + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.90") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +(defclass remote-minima-udp-native-fep-access-path + (fep-access-path native-access-path + minimaccess::udp-access-path ;real path + remote-access-path ;type + remote-memory-access-path ;type + ) + () + ) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.90") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +(defclass remote-minima-udp-native-genera-access-path + (genera-access-path native-access-path + minimaccess::udp-access-path ;real path + remote-access-path ;type + remote-memory-access-path ;type + ) + () + ) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.90") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +;; This is to make a path that is actually local but pretends not to be +(defclass dummy-remote-access-path + (remote-access-path) + ((host :initarg :host :initform "Local" :reader minimaccess::access-path-host) + (local-path :initform (make-instance 'local-access-path :complete nil)) + sg-to-debug + ) + ) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.90") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +(cp:define-command (com-create-emulator-access-path :command-table "Minima") + ((host 'net:host + :documentation "UNIX host" + :prompt "to host") + &key (type '((scl:alist-member + :alist (("FEP" :value :FEP + :documentation "Create a FEP access path") + ("Genera" :value :Genera + :documentation "Create a Genera access path") + ("Minima" :value :Minima + :documentation "Create a Minima access path")))) + :default :FEP + :documentation "Specify type of access path to be created")) + (let ((path (clos::make-instance (ecase type + (:FEP 'remote-minima-udp-native-fep-access-path) + (:Genera 'remote-minima-udp-native-genera-access-path) + (:Minima 'remote-minima-udp-native-minima-access-path)) + :port (divine-port-number) + :host host))) + (minimaccess::initialize-access-path path))) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.90") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +(cp:define-command (com-remake-emulator-access-path :command-table "Minima") + ((host 'net:host + :documentation "Unix host" + :prompt "to host" + :default (slot-value (car m-dbg::*access-paths*) 'minimaccess::host)) + (port 'integer + :documentation "port number as provided by emulator" + :prompt "port number" + :default (divine-port-number))) + (dolist (path *access-paths*) + (when (eql (minimaccess::access-path-host path) host) + (setf (slot-value path 'minimaccess::port) port) + (minimaccess::initialize-access-path path)))) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.90") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +(defun divine-port-number () + (let* ((basic (numericalize "128.81.41.00")) + (this (numericalize + (loop for x in (zl:send net:*local-host* :get :address) + if (string-equal (zl:send (zl:send (first x) :name) :string) "INTERNET") + return (second x)))) + (diff (abs (- this basic)))) + (if (> diff 256) + (+ 2900 256 (mod diff 256)) + (+ 2900 diff)))) + + +;===================================== +(SYSTEM-INTERNALS:BEGIN-PATCH-SECTION) +(SYSTEM-INTERNALS:PATCH-SECTION-SOURCE-FILE "MINIMA:DEBUGGER;COMMANDS.LISP.90") +(SYSTEM-INTERNALS:PATCH-SECTION-ATTRIBUTES + "-*- Mode: LISP; Syntax: Ansi-Common-Lisp; Package: MINIMA-DEBUGGER; Base: 10; Lowercase: Yes -*-") + +(defun numericalize (address) + (let ((result 0)) + (loop with start = 0 + for end = (position #\. address :start start) + do (setq result (+ (ash result 8) + (read-from-string (subseq address start end)))) + while end do (setq start (1+ end))) + result)) + diff --git a/sysdcl.lisp b/sysdcl.lisp new file mode 100644 index 0000000..26b7bb8 --- /dev/null +++ b/sysdcl.lisp @@ -0,0 +1,244 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + +(setq *vlm-host* (if (variable-boundp *vlm-host*) + *vlm-host* + (scl:accept 'neti:host + :prompt "Target Host" + :default (net:parse-host "og5.ai.mit.edu")))) +(setq *vlm-destination* + (cl:pathname (format nil "~A:/home/~(~A~)/VLM/VLM/" + *vlm-host* si:*user*))) + +(setq *life-destination* + (scl:merge-pathnames "life-support/" *vlm-destination*)) + +(setq *emulator-destination* + (scl:merge-pathnames "emulator/" *vlm-destination*)) + +(defsystem alpha-axp-osf-vlm + (:pretty-name "Alpha AXP OSF VLM" + :default-pathname "VLM:VLM;" + :default-destination-pathname #.*vlm-destination* + :default-module-type :copied-file + :maintain-journals t + :patchable nil + :required-systems ("Alpha-AXP-Assembler")) + (:module emulator ("alpha-axp-ivory-emulator") (:type :system)) + (:module makefile ("Makefile") (:type :makefile)) + (:module includes ("spy.h" + "utilities.h" + "VLM_configuration.h" + "world_tools.h")) + (:module main ("main.c" + "spy.c")) + (:module utils ("utilities.c" + "world_tools.c")) + (:module life-support ("alpha-axp-osf-life-support") (:type :system)) + (:serial makefile includes main life-support utils emulator)) + +(defsubsystem alpha-axp-osf-life-support + (:pretty-name "Alpha AXP OSF Life Support" + :default-pathname "vlm:life-support;" + :default-destination-pathname #.*life-destination* + :default-module-type :copied-file) + (:module life-includes ("BootComm.h" + "embed.h" + "FEPComm.h" + "life_prototypes.h" + "life_types.h" + "pfilt_wrapper.h" + "symbolics_characters.h" + "SystemComm.h")) + (:module life-bitmaps ("genera-cptfont.xbm" + "genera-icon-32.xbm")) + (:module life ("cold_load.c" + "console.c" + "disks.c" + "initialization.c" + "network.c" + "message_channels.c" + "polling.c" + "queues.c" + "signals.c")) + (:serial life-includes life-bitmaps life)) + +(defsubsystem alpha-axp-ivory-emulator + (:pretty-name "Alpha AXP Ivory Emulator" + :default-pathname "VLM:EMULATOR;" + :default-destination-pathname #.*emulator-destination*) + (:module includes (("vlm:alpha-emulator;aistat.sid" "vlm:alpha-emulator;aistat.lisp") + ("aihead.sid" "vlm:emulator;aihead.lisp") + ("traps.sid" "vlm:emulator;traps.lisp")) + (:type :dsdl)) + (:module support ("alpha-axp-emulator-support") (:type :system)) + (:module copy-includes ("vlm:alpha-emulator;aistat.s" "vlm:alpha-emulator;aistat.h" + "aihead.s" "aihead.h" + "traps.s" "traps.h" + "vlm:alpha-emulator;emulator.S") + (:type :copied-file) + (:uses-definitions-from includes)) + (:module h-files ("ivoryrep.h" + "asmfuns.h" + "memory.h") + (:type :copied-file)) + (:module c-files ("interfac.c" + "interpds.c" + "externals.c" + "memory.c") + (:type :copied-file)) + (:module s-files ("kludges.s") + (:type :copied-file)) + (:module emulator ("alpha-axp-ivory-emulator-guts") (:type :system)) + (:serial includes support h-files c-files s-files emulator)) + +(defsubsystem alpha-axp-ivory-emulator-guts + (:pretty-name "Alpha AXP Ivory Emulator Guts" + :default-pathname "VLM:ALPHA-EMULATOR;" + :default-destination-pathname #.*emulator-destination*) + (:module emulator ("ifunhead.as" + "idispat.as" + "ifuncom1.as" + "ifuncom2.as" + "ifungene.as" + "ifunfcal.as" + "ifunloop.as" + "ifunlist.as" + "ifuninst.as" + "ifunmath.as" + "ifunarra.as" + "ifunmove.as" + "ifunpred.as" + "ifunsubp.as" + "ifunfext.as" + "ifunlexi.as" + "ifunbits.as" + "ifunblok.as" + "ifunbind.as" + "ifunfull.as" + "ifunbnum.as" + "ifuntrap.as" + "ihalt.as" + "idouble.as" + "ifunjosh.as" + "ifuntran.as") + (:type :alpha-assembly)) + (:serial emulator)) + +(defsystem powerpc-linux-vlm + (:pretty-name "PowerPC Linux VLM" + :default-pathname "VLM:VLM;" + :default-destination-pathname #.*vlm-destination* + :default-module-type :copied-file + :maintain-journals t + :patchable nil + :required-systems ("PowerPC-Assembler")) + (:module emulator ("powerpc-ivory-emulator") (:type :system)) + (:serial emulator) +#| + (:module makefile ("GNUMakefile") (:type :makefile)) + (:module includes ("spy.h" + "utilities.h" + "VLM_configuration.h" + "world_tools.h")) + (:module main ("main.c" + "spy.c")) + (:module utils ("utilities.c" + "world_tools.c")) + (:module life-support ("powerpc-linux-life-support") (:type :system)) + (:serial makefile includes main life-support utils emulator) +|# + ) + +#|| +(defsubsystem powerpc-linux-life-support + (:pretty-name "PowerPC Linux Life Support" + :default-pathname "vlm:life-support;" + :default-destination-pathname #.*life-destination* + :default-module-type :copied-file) + (:module life-includes ("BootComm.h" + "embed.h" + "FEPComm.h" + "life_prototypes.h" + "life_types.h" + "pfilt_wrapper.h" + "symbolics_characters.h" + "SystemComm.h")) + (:module life-bitmaps ("genera-cptfont.xbm" + "genera-icon-32.xbm")) + (:module life ("cold_load.c" + "console.c" + "disks.c" + "initialization.c" + "network.c" + "message_channels.c" + "polling.c" + "queues.c" + "signals.c")) + (:serial life-includes life-bitmaps life)) +||# + +(defsubsystem powerpc-ivory-emulator + (:pretty-name "PowerPC Ivory Emulator" + :default-pathname "VLM:EMULATOR;" + :default-destination-pathname #.*emulator-destination*) + (:module includes (("vlm:g5-emulator;aistat.sid" "vlm:g5-emulator;aistat.lisp") + ("aihead.sid" "vlm:emulator;aihead.lisp") + ("traps.sid" "vlm:emulator;traps.lisp")) + (:type :dsdl)) + (:module support ("powerpc-emulator-support") (:type :system)) + #+ignore + (:module copy-includes ("vlm:g5-emulator;aistat.s" "vlm:g5-emulator;aistat.h" + "aihead.s" "aihead.h" + "traps.s" "traps.h" + "vlm:g5-emulator;emulator.S") + (:type :copied-file) + (:uses-definitions-from includes)) + #+ignore + (:module h-files ("ivoryrep.h" + "asmfuns.h" + "memory.h") + (:type :copied-file)) + #+ignore + (:module c-files ("interfac.c" + "interpds.c" + "externals.c" + "memory.c") + (:type :copied-file)) + #+ignore + (:module s-files ("kludges.s") + (:type :copied-file)) + (:module emulator ("powerpc-ivory-emulator-guts") (:type :system)) + (:serial includes support #+ignore h-files #+ignore c-files #+ignore s-files emulator)) + +(defsubsystem powerpc-ivory-emulator-guts + (:pretty-name "PowerPC Ivory Emulator Guts" + :default-pathname "VLM:G5-EMULATOR;" + :default-destination-pathname #.*emulator-destination*) + (:module emulator ("ifunhead.ppcs" + "idispat.ppcs" + "ifuncom1.ppcs" + "ifuncom2.ppcs" + "ifungene.ppcs" + "ifunfcal.ppcs" + "ifunloop.ppcs" + "ifunlist.ppcs" + "ifuninst.ppcs" + "ifunmath.ppcs" + "ifunarra.ppcs" + "ifunmove.ppcs" + "ifunpred.ppcs" + "ifunsubp.ppcs" + "ifunfext.ppcs" + "ifunlexi.ppcs" + "ifunbits.ppcs" + "ifunblok.ppcs" + "ifunbind.ppcs" + "ifunfull.ppcs" + "ifunbnum.ppcs" + "ifuntrap.ppcs" + "ihalt.ppcs" + "idouble.ppcs" + "ifunjosh.ppcs" + "ifuntran.ppcs") + (:type :powerpc-assembly)) + (:serial emulator)) diff --git a/translator/hitlist.text b/translator/hitlist.text new file mode 100644 index 0000000..7d8e869 --- /dev/null +++ b/translator/hitlist.text @@ -0,0 +1,66 @@ + Status of Ivory-Alpha Opcode translation + +Instructions implemented: + +SetSpToAddressHW +SetSpToAddressSaveTosHW +PushHW +PopHW +MovemHW +PushAddressHW +pushconstantvalue +TypeMemberHW +PointerPlusHW +PointerDifferenceHW +ZeropHW +AddHW +LoopDecrementTosHW +32BitPLUSHW +32BitDifferenceHW +PushNNilsHW +BranchHW +++ debug + +These instructions SHOULD be added. + +CARHW ;done +CDRHW ;done +SetToCarHW ;done +SetToCdrHW ;done +SetToCdrPushCarHW ;done +ENDPHW ;done +TAGHW ;done +MINUSPHW ;done +PLUSPHW ;done + +PushAddressSpRelativeHW +UnaryMinusHW +IncrementHW +DecrementHW +PointerIncrementHW +SetCdrCode1HW +SetCdrCode2HW +LdbHW +CharLdbHW +PLdbHW +PTagLdbHW +EqlHW ;done +EqHW ;done +valuecell + +These instructions may be worth adding. + +TakeValuesHW +PushAddressInstanceVariableHW +MemoryReadHW +Block0ReadHW +Block1ReadHW +Block2ReadHW +Block3ReadHW +RplacaHW +RplacdHW +AshHW +MemoryWriteHW + + + + diff --git a/translator/support-sysdcl.lisp b/translator/support-sysdcl.lisp new file mode 100644 index 0000000..f60102d --- /dev/null +++ b/translator/support-sysdcl.lisp @@ -0,0 +1,27 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + +(defsystem alpha-axp-translator-support + (:pretty-name "Alpha AXP Translator Support" + :default-pathname "VLM:EMULATOR;" + :journal-directory "VLM:TRANSLATOR;PATCH;" + :maintain-journals t + :patchable t) + (:module definitions ("vlm:alpha-emulator;aistat" "aihead" "traps") (:type :lisp-read-only)) + (:module error-table ("errortbl")) + (:module basic-macros ("vlm:alpha-emulator;alphamac" + "vlm:alpha-emulator;intrpmac")) + (:module macros ("vlm:alpha-emulator;stacklis")) + (:serial definitions error-table basic-macros macros)) + +(defsystem powerpc-translator-support + (:pretty-name "PowerPC Translator Support" + :default-pathname "VLM:EMULATOR;" + :journal-directory "VLM:TRANSLATOR;PATCH;" + :maintain-journals t + :patchable t) + (:module definitions ("vlm:g5-emulator;aistat" "aihead" "traps") (:type :lisp-read-only)) + (:module error-table ("errortbl")) + (:module basic-macros ("vlm:g5-emulator;powermac" + "vlm:g5-emulator;intrpmac")) + (:module macros ("vlm:g5-emulator;stacklis")) + (:serial definitions error-table basic-macros macros)) diff --git a/translator/sysdcl.lisp b/translator/sysdcl.lisp new file mode 100644 index 0000000..151b2de --- /dev/null +++ b/translator/sysdcl.lisp @@ -0,0 +1,14 @@ +;;; -*- Mode: LISP; Syntax: Common-Lisp; Package: SCT; Base: 10; Lowercase: Yes -*- + +(defsystem alpha-axp-translator + (:pretty-name "Alpha AXP Translator" + :default-pathname "VLM:TRANSLATOR;" + :maintain-journals t + :patchable t) + (:module assembler ("Alpha-AXP-Assembler") (:type :system)) + (:module support ("Alpha-AXP-Translator-Support") (:type :system)) + (:serial + assembler + support + "translat" + "tranrule")) diff --git a/translator/tranrule.lisp b/translator/tranrule.lisp new file mode 100644 index 0000000..6d58273 --- /dev/null +++ b/translator/tranrule.lisp @@ -0,0 +1,815 @@ +;;; -*- Package: ALPHA-AXP-INTERNALS; Syntax: Common-Lisp; Mode: LISP; Base: 10; Lowercase: Yes -*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetSpToAddressHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;(def-halfword-translation SetSpToAddressHW (instn) +; (do-default instn)) + + +(def-halfword-translation SetSpToAddressHW (instn); #o0151 + (compute-operand-address instn 'iSP) + (TOSvalid :invalid)) ;restore TOS + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetSpToAddressSaveTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;(def-halfword-translation SetSpToAddressSaveTosHW (instn) +; (do-default instn)) + +(def-halfword-translation SetSpToAddressSaveTosHW (instn) ; #o0152 + (cacheTOS) ; get TOS cached. + (multiple-value-bind (vma offset) + (compute-operand-register-offset instn 'iSP) + (writeTOS vma offset) ; store TOS + ;; now pop + (compute-operand-address instn 'iSP))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation PushHW (instn relto offset popp) ; #o0100 + (declare (ignore offset)) + (compute-operand-value2 instn 'arg5 'arg6 :signed t) + (if (eq relto :immediate) + (emit '(stack-push2-with-cdr arg5 arg6)) + (emit `(stack-push2 arg5 arg6 arg5))) + (TOSvalid :arg5arg6 :next)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopHW (instn) ; #o0340 + (cacheTOS) ; get TOS cached. + (multiple-value-bind (vma offset) + (compute-operand-register-offset instn nil) + (writeTOS vma offset)) + (emit '(SUBQ iSP 8 iSP "Pop Stack.")) + (TOSvalid :invalid)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemHW (instn) ; #o0341 + (cacheTOS) ; get TOS cached. + (multiple-value-bind (vma offset) + (compute-operand-register-offset instn nil) + ;; Don't emit FIXUP-TOS: it's unneccesary on the emulator + (unless (lisp:and (eq vma 'iSP) (eql offset 0)) + (writeTOS vma offset)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushAddressHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressHW (instn) ; #o0150 + (with-temporary-registers (sca temp) + (compute-operand-address instn sca) + (emit `((xlatSCAtoVMA ,sca arg6 ,temp) + (BIS zero ,|type|$k-|locative| arg5) + (stack-push2-with-cdr arg5 arg6))) + (TOSvalid :arg5arg6 :next))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for pushconstantvalue instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Note that this cannot be used for "pointer" constants, which aren't +;; really constant. This should really be called pushimmediateconstant. +;; We could have a pushconstantvalue if the "real" constant were stuck +;; in the function epilogue and we could do a load offset against the +;; PC. +(def-fullword-translation pushimmediateconstant (instn) + (clos:with-slots (opcode constant) instn + (emit `((BIS zero ,(logand opcode #x3F) arg5) + (load-constant arg6 ,(sys:%set-tag constant sys:dtp-fixnum)) + (stack-push2-with-cdr arg5 arg6))) + (TOSvalid :arg5arg6 :next))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TypeMemberHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TypeMemberHW (instn) ; #o040 + (clos:with-slots (opcode operand) instn + (let ((fieldno (logior (ash (logand opcode #x3) 2) (ldb (byte 2 8) operand))) + (mask (ldb (byte 8 0) operand)) + (pop (not (ldb-test (byte 1 2) opcode)))) + (with-temporary-registers (tval fmask) + (emit `((stack-read-tag iSP arg5 :tos-valid ,(TOSStatus)) + (LDQ ,tval ,(symbol-value 'processorstate$q-taddress) (ivory)) + ,@(if (< fieldno 8) ; fields 0-7 in low 32 bit word + `((load-constant ,fmask ,(ash mask (* 4 fieldno)))) + `((BIS zero ,mask ,fmask) + (SLL ,fmask ,(* 4 fieldno) ,fmask))) + (LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)) + (TagType arg5 arg5) ;no CDR code. + (SRL ,fmask arg5 ,fmask) + (CMOVLBS ,fmask ,tval arg6) + ,@(if pop + `((stack-write iSP arg6)) + `((stack-push arg6 nil :set-cdr-next nil))))) + (TOSvalid :arg6 :next))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PointerPlusHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation PointerPlusHW (instn relto offset popp) + (cacheTOS) ; get TOS cached. + (with-temporary-registers (temp) + (unless (eq relto :immediate) + (compute-operand-data instn temp :signed t)) + (emit `((ADDL arg6 ,(if (eq relto :immediate) + (sign-extend offset 8) + temp) arg6) + (stack-write-data iSP arg6))) + (if (eq (TOSstatus) :arg6) (TOSvalid :invalid)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PointerDifferenceHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation PointerDifferenceHW (instn relto offset popp) + (cacheTOS) ; get TOS cached. + (with-temporary-registers (temp) + (unless (eq relto :immediate) + (compute-operand-data instn temp :signed t)) + (emit `((SUBL arg6 ,(if (eq relto :immediate) + (sign-extend offset 8) + temp) arg6) + (BIS zero ,|type$K-fixnum| arg5) + (stack-write2 iSP arg5 arg6))) + (TOSvalid :arg5arg6 :next))) + +;;; Arith Predicates + +(defmacro unary-arithmetic-predicate-translation (instn test) + `(with-temporary-registers (true tag data temp1 temp2) + (let ((done (gensym))) + (multiple-value-bind (imove fbranch) + ;; floating branch is opposite of integer move + (ecase ,test + (zerop (values 'CMOVEQ 'FBNE)) + (plusp (values 'CMOVGT 'FBLE)) + (minusp (values 'CMOVLT 'FBGE))) + (multiple-value-bind (esclab returnlab) (make-escape ,instn) + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset ,instn 'iSP) + (emit + `((stack-read-tag-disp ,vma ,offset ,tag :tos-valid ,(TOSStatus)) + (LDQ ,true ,(symbol-value 'processorstate$q-taddress) (ivory)) + (stack-read-data-disp ,vma ,offset ,data :signed t :tos-valid ,(TOSStatus)) + ;; --- with-temporary-floating-registers + (stack-read-data-disp ,vma ,offset f1 :floating t) + (LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)) + (type-dispatch ,tag ,temp1 ,temp2 + (,|type$K-fixnum| + (,imove ,data ,true arg6 "T if predicate succeeds")) + (,|type$K-singlefloat| + (,fbranch f1 ,done) + (BIS ,true zero arg6 "Didn't branch, answer is T")) + (:else-label + ,esclab)) + (label ,done) + ,@(if popp + `((stack-write iSP arg6)) + `((stack-push arg6 nil :set-cdr-next nil))))) + (ivory-label returnlab) + ;; Emulator always leaves TOS in arg6, we arrange to do same + (TOSvalid :arg6 :next))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ZeropHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation ZeropHW (instn relto offset popp) ; #o034 + (cond + ((eq relto :immediate) + (if (zerop offset) + (emit `(LDQ arg6 ,(symbol-value 'processorstate$q-taddress) (ivory))) + (emit `(LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)))) + (emit `((stack-push-with-cdr arg6))) + (TOSvalid :arg6 :next)) + (:otherwise + (unary-arithmetic-predicate-translation instn 'zerop)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PluspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation PluspHW (instn relto offset popp) ; #o034 + (cond + ((eq relto :immediate) + (if (plusp offset) + (emit `(LDQ arg6 ,(symbol-value 'processorstate$q-taddress) (ivory))) + (emit `(LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)))) + (emit `((stack-push-with-cdr arg6))) + (TOSvalid :arg6 :next)) + (:otherwise + (unary-arithmetic-predicate-translation instn 'plusp)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MinuspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation MinuspHW (instn relto offset popp) ; #o034 + (cond + ((eq relto :immediate) + (if (minusp offset) + (emit `(LDQ arg6 ,(symbol-value 'processorstate$q-taddress) (ivory))) + (emit `(LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)))) + (emit `((stack-push-with-cdr arg6))) + (TOSvalid :arg6 :next)) + (:otherwise + (unary-arithmetic-predicate-translation instn 'minusp)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EndpHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation EndpHW (instn relto offset popp) ; #o034 + (declare (ignore offset)) + (cond + ((eq relto :immediate) + (do-default instn) ;stupid + ) + (:otherwise + (with-temporary-registers (true tag temp1 temp2) + (multiple-value-bind (esclab returnlab) (make-escape instn) + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset instn 'iSP) + (emit + `((LDQ ,true ,(symbol-value 'processorstate$q-taddress) (ivory)) + (stack-read-tag-disp ,vma ,offset ,tag :tos-valid ,(TOSStatus)) + (LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)) + ;; NIL or list, don't bother with list-instance! + (CheckAdjacentDataTypes ,tag ,|type$K-NIL| 2 ,esclab ,temp1) + (CMOVLBC ,tag ,true arg6 "NIL => T") + ,@(if popp + `((stack-write iSP arg6)) + `((stack-push arg6 nil :set-cdr-next nil))))) + (ivory-label returnlab) + ;; Emulator always leaves TOS in arg6, we arrange to do same + (TOSvalid :arg6 :next))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation EqHW (instn relto offset popp) ; #o034 + (cond + ((eq relto :immediate) + (with-temporary-registers (true temp1 temp2) + (multiple-value-bind (valid cdr) (TOSStatus) + (emit + ;; --- should we try to do better if tos is in arg6? + `((stack-read2 iSP arg5 arg6 :tos-valid ,valid :signed t) + (LDQ ,true ,(symbol-value 'processorstate$q-taddress) (ivory)) + ,@(unless (eq cdr :next) `((TagType arg5 arg5))) + (SUBL arg6 ,(sign-extend offset 8) ,temp1 "compare tag and data") + (LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)) + (SUBL arg5 ,|type$K-fixnum| ,temp2) + (BIS ,temp1 ,temp2 ,temp1) + (CMOVEQ ,temp1 ,true arg6 "EQ => T") + ,@(if popp + `((stack-write iSP arg6)) + `((stack-push arg6 nil :set-cdr-next nil))))))) + ) + (:otherwise + (with-temporary-registers (true op2 temp1) + (multiple-value-bind (op1 op2) + (if popp (values op2 'arg6) (values 'arg6 op2)) + (compute-operand-value instn op2) + (multiple-value-bind (valid) (TOSStatus) + (emit + ;; --- should we try to do better if tos is in arg5/arg6? + `((stack-read iSP ,op1 :tos-valid ,valid) + (LDQ ,true ,(symbol-value 'processorstate$q-taddress) (ivory)) + (XOR ,op1 ,op2 ,temp1 "compare tag and data") + (LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)) + (SLL ,temp1 #.(- 32 6) ,temp1 "shift off the cdr code") + (CMOVEQ ,temp1 ,true arg6 "EQ => T") + (stack-write iSP arg6))))))) + (TOSvalid :arg6 :next))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqlHW instruction $$?? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation EqlHW (instn relto offset popp) ; #o034 + (cond + ((eq relto :immediate) + ;; Same as EQ + (with-temporary-registers (true temp1 temp2) + (multiple-value-bind (valid cdr) (TOSStatus) + (emit + ;; --- should we try to do better if tos is in arg6? + `((stack-read2 iSP arg5 arg6 :tos-valid ,valid :signed t) + (LDQ ,true ,(symbol-value 'processorstate$q-taddress) (ivory)) + (SUBL arg6 ,(sign-extend offset 8) ,temp1 "compare tag and data") + (LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)) + ,@(unless (eq cdr :next) `((TagType arg5 arg5))) + (SUBL arg5 ,|type$K-fixnum| ,temp2) + (BIS ,temp1 ,temp2 ,temp1) + (CMOVEQ ,temp1 ,true arg6 "EQ => T") + (stack-write iSP arg6))))) + (TOSvalid :arg6 :next)) + (:otherwise + (with-temporary-registers (op2 temp1 temp2) + (multiple-value-bind (op1 op2) + (if popp (values op2 'arg6) (values 'arg6 op2)) + (compute-operand-value instn op2) + (multiple-value-bind (valid cdr) (TOSStatus) + (multiple-value-bind (esclab returnlab) (make-escape instn) + (let ((done (gensym))) + (emit + ;; --- should we try to do better if tos is in arg5/arg6? + `((stack-read iSP ,op1 :tos-valid ,valid) + ,@(unless (eq valid :arg5arg6) + `((EXTLL ,op1 4 arg5))) + (load-constant ,temp2 #xf800 "EQL-NOT-EQ mask") + ,@(unless (eq cdr :next) + `((TagType arg5 arg5))) + (XOR ,op1 ,op2 ,temp1 "compare tag and data") + (LDQ arg6 ,(symbol-value 'processorstate$q-taddress) (ivory)) + (SLL ,temp1 #.(- 32 6) ,temp1 "shift off the cdr code") + (BEQ ,temp1 ,done "EQ => T") + (LDQ arg6 ,(symbol-value 'processorstate$q-niladdress) (ivory)) + (SRL ,temp1 #. (+ 32 (- 32 6)) ,temp1 "Get the tag alone") + (BNE ,temp1 ,done "Type mis-match => NIL") + (SRL ,temp2 arg5 ,temp2) + (BLBS ,temp2 ,esclab "Exception on numerics") + (label ,done) + (stack-write iSP arg6)))) + (ivory-label returnlab) + (TOSvalid :arg6 :next)))))))) + +;;; General form of an arithemetic translation + +(defmacro simple-binary-arithmetic-translation (instn relto offset popp op) + `(with-temporary-registers (op2tag op2data tempt2) + (multiple-value-bind (esclab returnlab) (make-escape ,instn (unless popp :arg5arg6)) + (multiple-value-bind (op1tag op1data op2tag op2data) + (if ,popp + (values op2tag op2data 'arg5 'arg6) + (values 'arg5 'arg6 op2tag op2data)) + (unless (eq ,relto :immediate) + (compute-operand-value2 ,instn op2tag op2data :signed t)) + (multiple-value-bind (valid cdr) (TOSStatus) + (emit + `((stack-read2-signed iSP ,op1tag ,op1data :tos-valid ,valid) + ,@(unless (eq ,relto :immediate) + `((tagtype ,op2tag ,op2tag))) + ,@(unless (eq cdr :next) + `((tagtype ,op1tag ,op1tag))) + ,@(unless (eq ,relto :immediate) + `((SUBQ ,op2tag ,|type$K-fixnum| ,op2tag))) + (SUBQ ,op1tag ,|type$K-fixnum| ,tempt2) + ,@(unless (eq ,relto :immediate) + `((BNE ,op2tag ,esclab))) + (BNE ,tempt2 ,esclab) + ,@(if (eq ,relto :immediate) + `((,',op ,op1data ,(sign-extend ,offset 8) ,op1data + "compute 64-bit result")) + `((,',op ,op1data ,op2data ,op1data "compute 64-bit result"))) + (ADDL ,op1data 0 ,op2data "compute 32-bit sign-extended result") + (CMPEQ ,op1data ,op2data ,op2data "is it the same as the 64-bit result?") + (branch-false ,op2data ,esclab "if not, we overflowed") + (stack-write2 iSP ,op1tag ,op1data))))) + (ivory-label returnlab) + (if popp + (TOSvalid :invalid) + (TOSvalid :arg5arg6 :next))))) + +(defmacro unary-minus-translation (instn) + `(with-temporary-registers (true tag data temp1 temp2) + (let ((done (gensym))) + (multiple-value-bind (esclab returnlab) (make-escape ,instn :arg5arg6) + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset ,instn 'iSP) + (multiple-value-bind (valid cdr-next) (TOSStatus) + (emit + `((LDQ ,mnf ,(symbol-value 'processorstate$q-mostnegativefixnum) (ivory)) + (stack-read-data-disp ,vma ,offset arg6 :signed t :tos-valid ,valid) + (stack-read-tag-disp ,vma ,offset arg5 :tos-valid ,valid) + ;; --- with-temporary-floating-registers + (stack-read-data-disp ,vma ,offset f1 :floating t) + ,@(unless cdr-next + `((TagType arg5 arg5))) + (CMPEQ arg6 ,mnf ,mnf) + (basic-dispatch arg5 ,temp1 + (,|type$K-fixnum| + (SUBL zero arg6 arg6) + (branch-true ,mnf ,esclab) + ,@(if popp + (stack-write2 iSP arg5 arg6) + (stack-push2 arg5 arg6 nil :set-cdr-next nil))) + (,|type$K-singlefloat| + (CPSYN f1 f1 f1) + ,@(if popp + (stack-write2 iSP arg5 f1 :floating t) + (stack-push2 arg5 f1 nil :floating t :set-cdr-next nil)) + ) + (:else-label + ,esclab)))) + (ivory-label returnlab) + ;; We know the new value is cdr-next + (TOSvalid :arg5arg6 :next))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AddHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation AddHW (instn relto offset popp) ; #o0300 + (simple-binary-arithmetic-translation instn relto offset popp ADDQ)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SubHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation SubHW (instn relto offset popp) ; #o0300 + (simple-binary-arithmetic-translation instn relto offset popp SUBQ)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MulHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation MulHW (instn relto offset popp) ; #o0300 + (simple-binary-arithmetic-translation instn relto offset popp MULQ)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LoopDecrementTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LoopDecrementTosHW (instn) ; #o0175 + (let ((ntreturnlab (gensym))) + (with-temporary-registers (tempt1 tempd1 tempt2 tempd2) + (clos:with-slots (target) instn + (multiple-value-bind (esclab returnlab) (make-escape instn) + (multiple-value-bind (valid cdr) + (TOSstatus) + (emit `((stack-read2-signed iSP arg5 arg6 :tos-valid ,valid) + ,@(unless (eq cdr :next) + `((Tagtype arg5 arg5))) + (SUBQ arg5 ,|type$K-fixnum| ,tempt1) + (BNE ,tempt1 ,esclab) + (SUBL arg6 1 ,tempd1) + (CMPLT ,tempd1 arg6 ,tempd2) + (branch-false ,tempd2 ,esclab) ; escape if overflow + (BLE ,tempd1 ,ntreturnlab) ; branch not taken. + ;; test please_stop + (LDQ ,tempd2 ,(symbol-value 'processorstate$l-please-stop) (ivory)) + (BNE ,tempd2 ,esclab) + (stack-write2 iSP arg5 ,tempd1) + (BR zero ,target)))) + (alpha-label ntreturnlab) + (emit `(stack-write2 iSP arg5 ,tempd1)) + (alpha-label returnlab) + (TOSvalid :invalid)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CarHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CarHW (instn) ; #o00 + (with-specific-registers (arg1 #+ignore arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (clos:with-slots (target) instn + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset instn 'iSP) + (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `((ldq arg1 ,(symbol-value 'processorstate$q-carsubroutine) (Ivory)) + ;; :tos-valid is useful for sp-pop case + (stack-read2-disp ,vma ,offset arg5 arg6 "Get the operand" + :signed t :tos-valid ,(TOSStatus)) + (JSR r0 arg1 0) + (BR zero ,esclab) + (LDQ r0 ,(symbol-value 'processorstate$q-resumeema) (ivory) + "R0 is the link back to emulated mode.") + ,@(if popp + `((stack-write2 iSP arg5 arg6 :set-cdr-next arg5)) + `((stack-push2 arg5 arg6 t5))) + )) + (alpha-label returnlab) + ;; We happen to know the emulated instruction leaves TOS in 5/6 + ;; too! + (TOSvalid :arg5arg6 :next))))) + + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CdrHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CdrHW (instn) ; #o00 + (with-specific-registers (arg1 #+ignore arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (clos:with-slots (target) instn + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset instn 'iSP) + (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `((ldq arg1 ,(symbol-value 'processorstate$q-cdrsubroutine) (Ivory)) + ;; :tos-valid is useful for sp-pop case + (stack-read2-disp ,vma ,offset arg5 arg6 "Get the operand" + :signed t :tos-valid ,(TOSStatus)) + (JSR r0 arg1 0) + (BR zero ,esclab) + (LDQ r0 ,(symbol-value 'processorstate$q-resumeema) (ivory) + "R0 is the link back to emulated mode.") + ,@(if popp + `((stack-write2 iSP arg5 arg6 :set-cdr-next arg5)) + `((stack-push2 arg5 arg6 t5))) + )) + (alpha-label returnlab) + ;; We happen to know the emulated instruction leaves TOS in 5/6 + ;; too! + (TOSvalid :arg5arg6 :next))))) + + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SettoCarHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SettoCarHW (instn) ; #o00 + (with-specific-registers (arg1 #+ignore arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (with-temporary-registers (temp) + (clos:with-slots (target) instn + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset instn 'iSP) + (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `((ldq arg1 ,(symbol-value 'processorstate$q-carsubroutine) (Ivory)) + ;; :tos-valid is useful for sp-pop case + (stack-read2-disp ,vma ,offset arg5 arg6 "Get the operand" + :signed t :tos-valid ,(TOSStatus)) + (and arg5 192 ,temp "Save the old CAR code") + (JSR r0 arg1 0) + (BR zero ,esclab) + (LDQ r0 ,(symbol-value 'processorstate$q-resumeema) (ivory) + "R0 is the link back to emulated mode.") + (TagType arg5 arg5) + (BIS arg5 ,temp arg5 "Put back the original CAR codes") + (stack-write2-disp ,vma ,offset arg5 arg6) + )) + (alpha-label returnlab) + ;; We happen to know the emulated instruction leaves TOS in 5/6 + ;; too! + (if (lisp:and (eq vma 'iSP) (eq offset 0)) + (TOSValid :arg5arg6 :next) + (TOSValid :invalid))))))) + + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SettoCdrHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SettoCdrHW (instn) ; #o00 + (with-specific-registers (arg1 #+ignore arg2 t5 t6 t7 t8 t9 t10 t11 t12) + (with-temporary-registers (temp) + (clos:with-slots (target) instn + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset instn 'iSP) + (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `((ldq arg1 ,(symbol-value 'processorstate$q-cdrsubroutine) (Ivory)) + ;; :tos-valid is useful for sp-pop case + (stack-read2-disp ,vma ,offset arg5 arg6 "Get the operand" + :signed t :tos-valid ,(TOSStatus)) + (and arg5 192 ,temp "Save the old CDR code") + (JSR r0 arg1 0) + (BR zero ,esclab) + (LDQ r0 ,(symbol-value 'processorstate$q-resumeema) (ivory) + "R0 is the link back to emulated mode.") + (TagType arg5 arg5) + (BIS arg5 ,temp arg5 "Put back the original CDR codes") + (stack-write2-disp ,vma ,offset arg5 arg6) + )) + (alpha-label returnlab) + ;; We happen to know the emulated instruction leaves TOS in 5/6 + ;; too! + (if (lisp:and (eq vma 'iSP) (eq offset 0)) + (TOSValid :arg5arg6 :next) + (TOSValid :invalid))))))) + + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SettoCdrPushCarHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SettoCdrPushCarHW (instn) ; #o00 + (with-specific-registers (arg1 #+ignore arg2 t1 t2 t5 t6 t7 t8 t9 t10 t11 t12) + (with-temporary-registers (temp) + (clos:with-slots (target) instn + (multiple-value-bind (vma offset popp) + (compute-operand-register-offset instn 'iSP) + (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `((ldq arg1 ,(symbol-value 'processorstate$q-carcdrsubroutine) (Ivory)) + ;; :tos-valid is useful for sp-pop case + (stack-read2-disp ,vma ,offset t1 t2 "Get the operand" + :signed t :tos-valid ,(TOSStatus)) + (AND t1 192 ,temp "Save the old CDR code") + (SUBQ t1 ,|type|$k-|locative| t5) + (AND t5 63 t5 "Strip CDR code") + (BEQ t5 ,esclab) + (JSR r0 arg1 0) + (BR zero ,esclab) + (LDQ r0 ,(symbol-value 'processorstate$q-resumeema) (ivory) + "R0 is the link back to emulated mode.") + (TagType arg5 arg5) + (BIS arg5 ,temp arg5 "Put back the original CDR codes") + (stack-write2-disp ,vma ,offset arg5 arg6) + (stack-push2 t1 t2 t5) + )) + (alpha-label returnlab) + ;; Sorry, the car comes back in t1/t2 + (TOSvalid :invalid)))))) + + ) + +;;; Branch instructions + +(defmacro trbranchcond (invertp popp elsepopp extrapopp) + `(with-temporary-registers (tempt1 tempt2 tempd2) + (clos:with-slots (target operand) instn + (multiple-value-bind (valid cdr) (TOSStatus) + (let* ((nbrpop ,(+ (if elsepopp 1 0) (if extrapopp 1 0))) + (brpop ,(+ (if popp 1 0) (if extrapopp 1 0))) + (ntlab (gensym)) ; target if branch not taken + (backward (minusp (sign-extend operand 10)))) + (multiple-value-bind (esclab returnlab) (when backward (make-escape instn)) + (emit `((stack-read-tag iSP arg5 :tos-valid ,valid) + ,@(when backward + `((LDQ ,tempd2 ,(symbol-value 'processorstate$l-please-stop) (ivory))) + ) + ,@(if (eq cdr :next) + `((CMPEQ arg5 ,|type$K-NIL| ,tempt1)) + `((TagType arg5 ,tempt1 "Check tag of word in TOS.") + (CMPEQ ,tempt1 ,|type$K-NIL| ,tempt1))) + (,,(if invertp ''branch-false ''branch-true) ,tempt1 ,ntlab) + ;; Here to take the branch. + ,@(when backward + `((BNE ,tempd2 ,esclab "Test please-stop"))) + ,@(if (not (zerop brpop)) + `((SUBQ iSP ,(* 8 brpop) iSP))) + (BR zero ,target) + (label ,ntlab) + ,@(if (not (zerop nbrpop)) + `((SUBQ iSP ,(* 8 nbrpop) iSP))) + )) + (when backward (ivory-label returnlab)) + (when (or backward (not (= nbrpop brpop 0))) + (TOSvalid :invalid)))))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueNoPopHW (instn) ; #o064 + (trbranchcond nil nil nil nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndNoPopElseNoPopExtraPopHW +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndNoPopElseNoPopExtraPopHW (instn) ; #o067 + (trbranchcond nil nil nil t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndNoPopHW (instn) ; #o065 + (trbranchcond nil nil t nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueElseExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueElseExtraPopHW (instn) ; #o061 + (trbranchcond nil nil t t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueElseNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueElseNoPopHW (instn) ; #o066 + (trbranchcond nil t nil nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndExtraPopHW (instn) ; #o062 + (trbranchcond nil t nil t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueHW (instn) ; #o060 + (trbranchcond nil t t nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueExtraPopHW (instn) ; #o063 + (trbranchcond nil t t t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseNoPopHW (instn) ; #o074 + (trbranchcond t nil nil nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndNoPopElseNoPopExtraPopHW +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndNoPopElseNoPopExtraPopHW (instn) ; #o077 + (trbranchcond t nil nil t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndNoPopHW (instn) ; #o075 + (trbranchcond t nil t nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseElseExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseElseExtraPopHW (instn) ; #o071 + (trbranchcond t nil t t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseElseNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseElseNoPopHW (instn) ; #o076 + (trbranchcond t t nil nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndExtraPopHW (instn) ; #o072 + (trbranchcond t t nil t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseHW (instn) ; #o070 + (trbranchcond t t t nil)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseExtraPopHW (instn) ; #o073 + (trbranchcond t t t t)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchHW (instn) ; #o0174 + (clos:with-slots (target) instn + (emit `((BR zero ,target))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TagHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TagHW (instn) ; #o012 + (multiple-value-bind (vma offset) + (compute-operand-register-offset instn nil) + (emit `((stack-read-tag-disp ,vma ,offset arg6 "Get the tag of the operand" + :tos-valid ,(TOSStatus)) + (BIS zero ,|type|$k-|fixnum| arg5) + (stack-push2-with-cdr arg5 arg6))) + (TOSvalid :arg5arg6 :next))) + +;;; Fin + diff --git a/translator/translat.lisp b/translator/translat.lisp new file mode 100644 index 0000000..05baf04 --- /dev/null +++ b/translator/translat.lisp @@ -0,0 +1,3108 @@ +;;; -*- Package: ALPHA-AXP-INTERNALS; Syntax: Common-Lisp; Mode: LISP; Base: 10; Lowercase: Yes -*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Part 1 - the beginning ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +#| +The translator analyser takes a function object and internalizes it into instruction objects. +Each object is chained in PC sequence and references to the function code from within itself +are resolved into pointers to instruction objects in the sequence. The internalized form +is the input to the code generator portion. +|# + +(clos:defclass translation-state () + ((source :initarg :source) + (target :initarg :target) + (i-lisp-compiler:newfun :initarg :newfun) + (nativemodep :initform nil) ;initially in emulated mode. + (pendinglabel :initform nil) + (toscache :initform :arg6) ;(one of :invalid :arg6 :arg5arg6) + (toscdr :initform nil) ;(either nil or :next) + (freeregs :initarg :freeregs :initform (list 't1 't2 't3 't4 't5 't6 + 't7 't8 't9 't10 't11 't12 + 'arg1 'arg3 'arg4)) + )) + + +(clos:defclass decoded-function () + ((instructions :initform ()) + (escapeblocks :initform ()) + (icount :initform 0) + (debug-info :initform ()) + (packed-instructions :initform ()) + (packed-size :initform ()))) + +(clos:defclass ivory-instruction () + ((pc :initarg :pc :accessor ivory-instruction-pc :initform -1) + (order :initarg :order :accessor ivory-instruction-order :initform nil) + (sequence :initform 0 :initarg :sequence) ;normal + (nextpc :initarg :nextpc :initform -1) + (opcode :initarg :opcode) + (label :initarg :label :initform ()) + (originalpc :initform nil) + (nextinstn :initarg :nextinstn :initform nil))) + +(clos:defclass fullword-instruction (ivory-instruction) + ((constant :initarg :constant))) + +(clos:defclass alpha-native-instruction (fullword-instruction) + ()) + +(clos:defclass alpha-native-branch-instruction (alpha-native-instruction) + ((target :initarg :target :initform nil))) + +(clos:defclass halfword-instruction (ivory-instruction) + ((operand :initform 0 :initarg :operand))) + +(clos:defclass ibranch-format-instruction (halfword-instruction) + ((target :initarg :target :initform nil))) + + +(defun branch-format-hw-opcodep (code) + (svref *branch-format-opcodes* code)) + +(clos:defmethod instruction-labeledp ((decinst ivory-instruction)) + (clos:with-slots (label) decinst + label)) + +(clos:defmethod label-instruction ((decinst ivory-instruction)) + (clos:with-slots (label) decinst + (first + (if label + label + (push (gensym) label))))) + +(clos:defmethod instruction-kind ((decinst fullword-instruction)) :fullword) + +(clos:defmethod instruction-kind ((decinst halfword-instruction)) :halfword) + +(clos:defmethod entry-instructionp ((decinst fullword-instruction)) ()) + +(clos:defmethod entry-instructionp ((decinst halfword-instruction)) + (clos:with-slots (opcode) decinst + (or (= opcode #o176) (= opcode #o177)))) + +(clos:defmethod native-instructionp ((decinst fullword-instruction)) + (clos:with-slots (opcode) decinst + (= opcode i-lisp-compiler:*vlm-native-instruction-opcode*))) + +(clos:defmethod native-instructionp ((decinst halfword-instruction)) + ()) + +(defvar *Major-opcodes* + #( + PAL* ???? ???? ???? ???? ???? ???? ???? + LDA LDAH ???? LDQU ???? ???? ???? STQU + INTA INTL INTS INTM ???? FLTV FLTI FLTL + MISC \PAL JSR* \PAL ???? \PAL \PAL \PAL + LDF LDG LDS LDT STF STG STS STT + LDL LDQ LDLL LDQL STL STQ STLC STQC + BR FBEQ FBLT FBLE BSR FBNE FBGE FBGT + BLBC BEQ BLT BLE BLBS BNE BGE BGT + )) + +(defvar *Opcode-Format* + #( + pal res res res res res res res + mem mem res mem res res res mem + op op op op res op op op + mem non mem non res non non non + mem mem mem mem mem mem mem mem + mem mem mem mem mem mem mem mem + br br br br br br br br + br br br br br br br br + )) + +(defvar *register-names* + #( r0 t1 t2 t3 t4 t5 t6 t7 + t8 iPC iFP iLP iSP iCP ivory r15 + arg1 arg2 arg3 arg4 arg5 arg6 t9 t10 + t11 t12 ra pv r28 gp sp zero)) + +(defvar *op10-fcns* + '((0 . ADDL) (#x9 . SUBL) (#x2d . CMPEQ) (#x40 . ADDL/V) (#x49 . SUBL/V) + (#x4D . CMPLT) (#x20 . ADDQ) (#x29 . SUBQ) (#x6D . CMPLE) (#x60 . ADDQ/V) + (#x69 . SUBQ/V) (#x1D . CMPULT) (#x3D . CMPULE) (#xF . CMPBGE) (2 . S4ADDL) + (#xB . S4SUBL) (#x12 . S8ADDL) (#x1B . S8SUBL) (#x22 . S4ADDQ) (#x2B . S4SUBQ) + (#x32 . S8ADDQ) (#x2B . S4SUBQ) (#x32 . S8ADDQ) (#x3B . S8SUBQ))) + +(defvar *op11-fcns* + '((#x0 . AND) (#x20 . BIS) (#x40 . XOR) (#x8 . BIC) (#x28 . ORNOT) (#x48 . EQV) + (#x24 . CMOVEQ) (#x44 . CMOVLT) (#x64 . CMOVLE) (#x26 . CMOVNE) + (#x46 . CMOVGE) (#x66 . CMOVGT) (#x14 . CMOVLBS) (#x16 . CMOVLBC))) + +(defvar *op12-fcns* + '((#x39 . SLL) (#x3C . SRA) (#x34 . SRL) (#x6 . EXTBL) (#xB . INSBL) (#x2 . MSKBL) + (#x16 . EXTWL) (#x1B . INSWL) (#x12 . MSKWL) (#x26 . EXTLL) (#x2b . INSLL) (#x22 . MSKLL) + (#x36 . EXTQL) (#x3b . INSQL) (#x32 . MSKQL) (#x5a . EXTWH) (#x57 . INSWH) (#x52 . MSKWH) + (#x6a . EXTLH) (#x67 . INSLH) (#x62 . MSKLH) (#x7a . EXTQH) (#x77 . INSQH) (#x72 . MSKQH) + (#x30 . ZAP) (#x31 . ZAPNOT))) + +(defvar *op13-fcns* + '((#x0 . MULL) (#x40 . MULL?V) (#x20 . MULQ) (#x60 . MULQ/V) (#x30 . UMULH))) + +(defun regname(n) (svref *register-names* n)) + +(defun fcnname (opcode fcncode) + (or + (cond ((= opcode #x10) (cdr (assoc fcncode *op10-fcns*))) + ((= opcode #x11) (cdr (assoc fcncode *op11-fcns*))) + ((= opcode #x12) (cdr (assoc fcncode *op12-fcns*))) + ((= opcode #x13) (cdr (assoc fcncode *op13-fcns*)))) + (future-common-lisp::format nil "#x~x" fcncode))) + + +;;; This vector is the master translation dispatch vector. It served the double purpose +;;; of supporting the instruction printer. + +(defvar *halfwordinstns* #( ; [256] + CarHW ; #o00 + CdrHW ; #o01 + EndpHW ; #o02 + Setup1DArrayHW ; #o03 + SetupForce1DArrayHW ; #o04 + BindLocativeHW ; #o05 + RestoreBindingStackHW ; #o06 + EphemeralpHW ; #o07 + StartCallHW ; #o010 + JumpHW ; #o011 + TagHW ; #o012 + DereferenceHW ; #o013 + LogicTailTestHW ; #o014 + SpareOpHW ; #o015 +++ Used for breakpoints!!! + DoubleFloatOpHW ; #o016 + SpareOpHW ; #o017 + PushLexicalVarNHW ; #o020 + PushLexicalVarNHW ; #o021 + PushLexicalVarNHW ; #o022 + PushLexicalVarNHW ; #o023 + PushLexicalVarNHW ; #o024 + PushLexicalVarNHW ; #o025 + PushLexicalVarNHW ; #o026 + PushLexicalVarNHW ; #o027 + Block0WriteHW ; #o030 + Block1WriteHW ; #o031 + Block2WriteHW ; #o032 + Block3WriteHW ; #o033 + ZeropHW ; #o034 + MinuspHW ; #o035 + PluspHW ; #o036 + SpareOpHW ;#o037 + TypeMemberHW ; #o040 + TypeMemberHW ; #o041 + TypeMemberHW ; #o042 + TypeMemberHW ; #o043 + TypeMemberHW ; #o044 + TypeMemberHW ; #o045 + TypeMemberHW ; #o046 + TypeMemberHW ; #o047 + LocateLocalsHW ; #o050 + CatchCloseHW ; #o051 + GenericDispatchHW ; #o052 + MessageDispatchHW ; #o053 + CheckPreemptRequestHW ; #o054 + PushGlobalLogicVariableHW ; #o055 + NoOpHW ; #o056 + HaltHW ; #o057 + BranchTrueHW ; #o060 + BranchTrueElseExtraPopHW ; #o061 + BranchTrueAndExtraPopHW ; #o062 + BranchTrueExtraPopHW ; #o063 + BranchTrueNoPopHW ; #o064 + BranchTrueAndNoPopHW ; #o065 + BranchTrueElseNoPopHW ; #o066 + BranchTrueAndNoPopElseNoPopExtraPopHW ; #o067 + BranchFalseHW ; #o070 + BranchFalseElseExtraPopHW ; #o071 + BranchFalseAndExtraPopHW ; #o072 + BranchFalseExtraPopHW ; #o073 + BranchFalseNoPopHW ; #o074 + BranchFalseAndNoPopHW ; #o075 + BranchFalseElseNoPopHW ; #o076 + BranchFalseAndNoPopElseNoPopExtraPopHW ; #o077 + PushHW ; #o0100 + PushNNilsHW ; #o0101 + PushAddressSpRelativeHW ; #o0102 + PushLocalLogicVariablesHW ; #o0103 + ReturnMultipleHW ; #o0104 + ReturnKludgeHW ; #o0105 + TakeValuesHW ; #o0106 + UnbindNHW ; #o0107 + PushInstanceVariableHW ; #o0110 + PushAddressInstanceVariableHW ; #o0111 + PushInstanceVariableOrderedHW ; #o0112 + PushAddressInstanceVariableOrderedHW ; #o0113 + UnaryMinusHW ; #o0114 + ReturnSingleHW ; #o0115 + MemoryReadHW ; #o0116 + MemoryReadHW ; #o0117 + Block0ReadHW ; #o0120 + Block1ReadHW ; #o0121 + Block2ReadHW ; #o0122 + Block3ReadHW ; #o0123 + Block0ReadShiftHW ; #o0124 + Block1ReadShiftHW ; #o0125 + Block2ReadShiftHW ; #o0126 + Block3ReadShiftHW ; #o0127 + Block0ReadTestHW ; #o0130 + Block1ReadTestHW ; #o0131 + Block2ReadTestHW ; #o0132 + Block3ReadTestHW ; #o0133 + FinishCallNHW ; #o0134 + FinishCallNHW ; #o0135 + FinishCallTosHW ; #o0136 + FinishCallTosHW ; #o0137 + SetToCarHW ; #o0140 + SetToCdrHW ; #o0141 + SetToCdrPushCarHW ; #o0142 + IncrementHW ; #o0143 + DecrementHW ; #o0144 + PointerIncrementHW ; #o0145 + SetCdrCode1HW ; #o0146 + SetCdrCode2HW ; #o0147 + PushAddressHW ; #o0150 + SetSpToAddressHW ; #o0151 + SetSpToAddressSaveTosHW ; #o0152 + SpareOpHW ;#o0153 + ReadInternalRegisterHW ; #o0154 + WriteInternalRegisterHW ; #o0155 + CoprocessorReadHW ; #o0156 + CoprocessorWriteHW ; #o0157 + Block0ReadAluHW ; #o0160 + Block1ReadAluHW ; #o0161 + Block2ReadAluHW ; #o0162 + Block3ReadAluHW ; #o0163 + SpareOpHW ;#o0164 + SpareOpHW ;#o0165 + SpareOpHW ;#o0166 + SpareOpHW ;#o0167 + LdbHW ; #o0170 + CharLdbHW ; #o0171 + PLdbHW ; #o0172 + PTagLdbHW ; #o0173 + BranchHW ; #o0174 + LoopDecrementTosHW ; #o0175 + EntryRestAcceptedHW ; #o0176 + EntryRestNotAcceptedHW ; #o0177 + RplacaHW ; #o0200 + RplacdHW ; #o0201 + MultiplyHW ; #o0202 + QuotientHW ; #o0203 + CeilingHW ; #o0204 + FloorHW ; #o0205 + TruncateHW ; #o0206 + RoundHW ; #o0207 + SpareOpHW ; #o0210 +++ Use for DoRemainder + RationalQuotientHW ; #o0211 + MinHW ; #o0212 + MaxHW ; #o0213 + AluHW ; #o0214 + LogandHW ; #o0215 + LogxorHW ; #o0216 + LogiorHW ; #o0217 + RotHW ; #o0220 + LshHW ; #o0221 + MultiplyDoubleHW ; #o0222 + LshcBignumStepHW ; #o0223 + StackBltHW ; #o0224 + RgetfHW ; #o0225 + MemberHW ; #o0226 + AssocHW ; #o0227 + PointerPlusHW ; #o0230 + PointerDifferenceHW ; #o0231 + AshHW ; #o0232 + StoreConditionalHW ; #o0233 + MemoryWriteHW ; #o0234 + PStoreContentsHW ; #o0235 + BindLocativeToValueHW ; #o0236 + UnifyHW ; #o0237 + PopLexicalVarNHW ; #o0240 + PopLexicalVarNHW ; #o0241 + PopLexicalVarNHW ; #o0242 + PopLexicalVarNHW ; #o0243 + PopLexicalVarNHW ; #o0244 + PopLexicalVarNHW ; #o0245 + PopLexicalVarNHW ; #o0246 + PopLexicalVarNHW ; #o0247 + MovemLexicalVarNHW ; #o0250 + MovemLexicalVarNHW ; #o0251 + MovemLexicalVarNHW ; #o0252 + MovemLexicalVarNHW ; #o0253 + MovemLexicalVarNHW ; #o0254 + MovemLexicalVarNHW ; #o0255 + MovemLexicalVarNHW ; #o0256 + MovemLexicalVarNHW ; #o0257 + EqualNumberHW ; #o0260 + LesspHW ; #o0261 + GreaterpHW ; #o0262 + EqlHW ; #o0263 + EqualNumberHW ; #o0264 + LesspHW ; #o0265 + GreaterpHW ; #o0266 + EqlHW ; #o0267 + EqHW ; #o0270 + SpareOpHW ; #o0271 + SpareOpHW ; #o0272 + LogtestHW ; #o0273 + EqHW ; #o0274 + SpareOpHW ; #o0275 + SpareOpHW ; #o0276 + LogtestHW ; #o0277 + AddHW ; #o0300 + SubHW ; #o0301 + 32BitPlusHW ; #o0302 + 32BitDifferenceHW ; #o0303 + AddBignumStepHW ; #o0304 + SubBignumStepHW ; #o0305 + MultiplyBignumStepHW ; #o0306 + DivideBignumStepHW ; #o0307 + Aset1HW ; #o0310 + AllocateListBlockHW ; #o0311 + Aref1HW ; #o0312 + Aloc1HW ; #o0313 + StoreArrayLeaderHW ; #o0314 + AllocateStructureBlockHW ; #o0315 + ArrayLeaderHW ; #o0316 + AlocLeaderHW ; #o0317 + PopInstanceVariableHW ; #o0320 + MovemInstanceVariableHW ; #o0321 + PopInstanceVariableOrderedHW ; #o0322 + MovemInstanceVariableOrderedHW ; #o0323 + InstanceRefHW ; #o0324 + InstanceSetHW ; #o0325 + InstanceLocHW ; #o0326 + SetTagHW ; #o0327 + SpareOpHW ;#o0330 + UnsignedLesspHW ; #o0331 + SpareOpHW ;#o0332 + SpareOpHW ;#o0333 + SpareOpHW ;#o0334 + UnsignedLesspHW ; #o0335 + SpareOpHW ;#o0336 + SpareOpHW ;#o0337 + PopHW ; #o0340 + MovemHW ; #o0341 + MergeCdrNoPopHW ; #o0342 + SpareOpHW ;#o0343 + SpareOpHW ;#o0344 + SpareOpHW ;#o0345 + SpareOpHW ;#o0346 + SpareOpHW ;#o0347 + FastAref1HW ; #o0350 + FastAset1HW ; #o0351 + StackBltAddressHW ; #o0352 + SpareOpHW ;#o0353 + SpareOpHW ;#o0354 + SpareOpHW ;#o0355 + SpareOpHW ;#o0356 + SpareOpHW ;#o0357 + SpareOpHW ;#o0360 + SpareOpHW ;#o0361 + SpareOpHW ;#o0362 + SpareOpHW ;#o0363 + SpareOpHW ;#o0364 + SpareOpHW ;#o0365 + SpareOpHW ;#o0366 + SpareOpHW ;#o0367 + DpbHW ; #o0370 + CharDpbHW ; #o0371 + PDpbHW ; #o0372 + PTagDpbHW ; #o0373 + SpareOpHW ;#o0374 + LoopIncrementTosLessThanHW ; #o0375 + CatchOpenHW ; #o0376 + SpareOpHW ;#o0377 +)) + +(defvar *branch-format-opcodes* #( ; [256] + nil ; CarHW ; #o00 + nil ; CdrHW ; #o01 + nil ; EndpHW ; #o02 + nil ; Setup1DArrayHW ; #o03 + nil ; SetupForce1DArrayHW ; #o04 + nil ; BindLocativeHW ; #o05 + nil ; RestoreBindingStackHW ; #o06 + nil ; EphemeralpHW ; #o07 + nil ; StartCallHW ; #o010 + nil ; JumpHW ; #o011 + nil ; TagHW ; #o012 + nil ; DereferenceHW ; #o013 + nil ; LogicTailTestHW ; #o014 + nil ; SpareOpHW ; #o015 +++ Used for breakpoints!!! + nil ; DoubleFloatOpHW ; #o016 + nil ; SpareOpHW ; #o017 + nil ; PushLexicalVarNHW ; #o020 + nil ; PushLexicalVarNHW ; #o021 + nil ; PushLexicalVarNHW ; #o022 + nil ; PushLexicalVarNHW ; #o023 + nil ; PushLexicalVarNHW ; #o024 + nil ; PushLexicalVarNHW ; #o025 + nil ; PushLexicalVarNHW ; #o026 + nil ; PushLexicalVarNHW ; #o027 + nil ; Block0WriteHW ; #o030 + nil ; Block1WriteHW ; #o031 + nil ; Block2WriteHW ; #o032 + nil ; Block3WriteHW ; #o033 + nil ; ZeropHW ; #o034 + nil ; MinuspHW ; #o035 + nil ; PluspHW ; #o036 + nil ; SpareOpHW ;#o037 + nil ; TypeMemberHW ; #o040 + nil ; TypeMemberHW ; #o041 + nil ; TypeMemberHW ; #o042 + nil ; TypeMemberHW ; #o043 + nil ; TypeMemberHW ; #o044 + nil ; TypeMemberHW ; #o045 + nil ; TypeMemberHW ; #o046 + nil ; TypeMemberHW ; #o047 + nil ; LocateLocalsHW ; #o050 + nil ; CatchCloseHW ; #o051 + nil ; GenericDispatchHW ; #o052 + nil ; MessageDispatchHW ; #o053 + nil ; CheckPreemptRequestHW ; #o054 + nil ; PushGlobalLogicVariableHW ; #o055 + nil ; NoOpHW ; #o056 + nil ; HaltHW ; #o057 + t ; BranchTrueHW ; #o060 + t ; BranchTrueElseExtraPopHW ; #o061 + t ; BranchTrueAndExtraPopHW ; #o062 + t ; BranchTrueExtraPopHW ; #o063 + t ; BranchTrueNoPopHW ; #o064 + t ; BranchTrueAndNoPopHW ; #o065 + t ; BranchTrueElseNoPopHW ; #o066 + t ; BranchTrueAndNoPopElseNoPopExtraPopHW ; #o067 + t ; BranchFalseHW ; #o070 + t ; BranchFalseElseExtraPopHW ; #o071 + t ; BranchFalseAndExtraPopHW ; #o072 + t ; BranchFalseExtraPopHW ; #o073 + t ; BranchFalseNoPopHW ; #o074 + t ; BranchFalseAndNoPopHW ; #o075 + t ; BranchFalseElseNoPopHW ; #o076 + t ; BranchFalseAndNoPopElseNoPopExtraPopHW ; #o077 + nil ; PushHW ; #o0100 + nil ; PushNNilsHW ; #o0101 + nil ; PushAddressSpRelativeHW ; #o0102 + nil ; PushLocalLogicVariablesHW ; #o0103 + nil ; ReturnMultipleHW ; #o0104 + nil ; ReturnKludgeHW ; #o0105 + nil ; TakeValuesHW ; #o0106 + nil ; UnbindNHW ; #o0107 + nil ; PushInstanceVariableHW ; #o0110 + nil ; PushAddressInstanceVariableHW ; #o0111 + nil ; PushInstanceVariableOrderedHW ; #o0112 + nil ; PushAddressInstanceVariableOrderedHW ; #o0113 + nil ; UnaryMinusHW ; #o0114 + nil ; ReturnSingleHW ; #o0115 + nil ; MemoryReadHW ; #o0116 + nil ; MemoryReadHW ; #o0117 + nil ; Block0ReadHW ; #o0120 + nil ; Block1ReadHW ; #o0121 + nil ; Block2ReadHW ; #o0122 + nil ; Block3ReadHW ; #o0123 + nil ; Block0ReadShiftHW ; #o0124 + nil ; Block1ReadShiftHW ; #o0125 + nil ; Block2ReadShiftHW ; #o0126 + nil ; Block3ReadShiftHW ; #o0127 + nil ; Block0ReadTestHW ; #o0130 + nil ; Block1ReadTestHW ; #o0131 + nil ; Block2ReadTestHW ; #o0132 + nil ; Block3ReadTestHW ; #o0133 + nil ; FinishCallNHW ; #o0134 + nil ; FinishCallNHW ; #o0135 + nil ; FinishCallTosHW ; #o0136 + nil ; FinishCallTosHW ; #o0137 + nil ; SetToCarHW ; #o0140 + nil ; SetToCdrHW ; #o0141 + nil ; SetToCdrPushCarHW ; #o0142 + nil ; IncrementHW ; #o0143 + nil ; DecrementHW ; #o0144 + nil ; PointerIncrementHW ; #o0145 + nil ; SetCdrCode1HW ; #o0146 + nil ; SetCdrCode2HW ; #o0147 + nil ; PushAddressHW ; #o0150 + nil ; SetSpToAddressHW ; #o0151 + nil ; SetSpToAddressSaveTosHW ; #o0152 + nil ; SpareOpHW ;#o0153 + nil ; ReadInternalRegisterHW ; #o0154 + nil ; WriteInternalRegisterHW ; #o0155 + nil ; CoprocessorReadHW ; #o0156 + nil ; CoprocessorWriteHW ; #o0157 + nil ; Block0ReadAluHW ; #o0160 + nil ; Block1ReadAluHW ; #o0161 + nil ; Block2ReadAluHW ; #o0162 + nil ; Block3ReadAluHW ; #o0163 + nil ; SpareOpHW ;#o0164 + nil ; SpareOpHW ;#o0165 + nil ; SpareOpHW ;#o0166 + nil ; SpareOpHW ;#o0167 + nil ; LdbHW ; #o0170 + nil ; CharLdbHW ; #o0171 + nil ; PLdbHW ; #o0172 + nil ; PTagLdbHW ; #o0173 + t ; BranchHW ; #o0174 + t ; LoopDecrementTosHW ; #o0175 + nil ; EntryRestAcceptedHW ; #o0176 + nil ; EntryRestNotAcceptedHW ; #o0177 + nil ; RplacaHW ; #o0200 + nil ; RplacdHW ; #o0201 + nil ; MultiplyHW ; #o0202 + nil ; QuotientHW ; #o0203 + nil ; CeilingHW ; #o0204 + nil ; FloorHW ; #o0205 + nil ; TruncateHW ; #o0206 + nil ; RoundHW ; #o0207 + nil ; SpareOpHW ; #o0210 +++ Use for DoRemainder + nil ; RationalQuotientHW ; #o0211 + nil ; MinHW ; #o0212 + nil ; MaxHW ; #o0213 + nil ; AluHW ; #o0214 + nil ; LogandHW ; #o0215 + nil ; LogxorHW ; #o0216 + nil ; LogiorHW ; #o0217 + nil ; RotHW ; #o0220 + nil ; LshHW ; #o0221 + nil ; MultiplyDoubleHW ; #o0222 + nil ; LshcBignumStepHW ; #o0223 + nil ; StackBltHW ; #o0224 + nil ; RgetfHW ; #o0225 + nil ; MemberHW ; #o0226 + nil ; AssocHW ; #o0227 + nil ; PointerPlusHW ; #o0230 + nil ; PointerDifferenceHW ; #o0231 + nil ; AshHW ; #o0232 + nil ; StoreConditionalHW ; #o0233 + nil ; MemoryWriteHW ; #o0234 + nil ; PStoreContentsHW ; #o0235 + nil ; BindLocativeToValueHW ; #o0236 + nil ; UnifyHW ; #o0237 + nil ; PopLexicalVarNHW ; #o0240 + nil ; PopLexicalVarNHW ; #o0241 + nil ; PopLexicalVarNHW ; #o0242 + nil ; PopLexicalVarNHW ; #o0243 + nil ; PopLexicalVarNHW ; #o0244 + nil ; PopLexicalVarNHW ; #o0245 + nil ; PopLexicalVarNHW ; #o0246 + nil ; PopLexicalVarNHW ; #o0247 + nil ; MovemLexicalVarNHW ; #o0250 + nil ; MovemLexicalVarNHW ; #o0251 + nil ; MovemLexicalVarNHW ; #o0252 + nil ; MovemLexicalVarNHW ; #o0253 + nil ; MovemLexicalVarNHW ; #o0254 + nil ; MovemLexicalVarNHW ; #o0255 + nil ; MovemLexicalVarNHW ; #o0256 + nil ; MovemLexicalVarNHW ; #o0257 + nil ; EqualNumberHW ; #o0260 + nil ; LesspHW ; #o0261 + nil ; GreaterpHW ; #o0262 + nil ; EqlHW ; #o0263 + nil ; EqualNumberHW ; #o0264 + nil ; LesspHW ; #o0265 + nil ; GreaterpHW ; #o0266 + nil ; EqlHW ; #o0267 + nil ; EqHW ; #o0270 + nil ; SpareOpHW ; #o0271 + nil ; SpareOpHW ; #o0272 + nil ; LogtestHW ; #o0273 + nil ; EqHW ; #o0274 + nil ; SpareOpHW ; #o0275 + nil ; SpareOpHW ; #o0276 + nil ; LogtestHW ; #o0277 + nil ; AddHW ; #o0300 + nil ; SubHW ; #o0301 + nil ; 32BitPlusHW ; #o0302 + nil ; 32BitDifferenceHW ; #o0303 + nil ; AddBignumStepHW ; #o0304 + nil ; SubBignumStepHW ; #o0305 + nil ; MultiplyBignumStepHW ; #o0306 + nil ; DivideBignumStepHW ; #o0307 + nil ; Aset1HW ; #o0310 + nil ; AllocateListBlockHW ; #o0311 + nil ; Aref1HW ; #o0312 + nil ; Aloc1HW ; #o0313 + nil ; StoreArrayLeaderHW ; #o0314 + nil ; AllocateStructureBlockHW ; #o0315 + nil ; ArrayLeaderHW ; #o0316 + nil ; AlocLeaderHW ; #o0317 + nil ; PopInstanceVariableHW ; #o0320 + nil ; MovemInstanceVariableHW ; #o0321 + nil ; PopInstanceVariableOrderedHW ; #o0322 + nil ; MovemInstanceVariableOrderedHW ; #o0323 + nil ; InstanceRefHW ; #o0324 + nil ; InstanceSetHW ; #o0325 + nil ; InstanceLocHW ; #o0326 + nil ; SetTagHW ; #o0327 + nil ; SpareOpHW ;#o0330 + nil ; UnsignedLesspHW ; #o0331 + nil ; SpareOpHW ;#o0332 + nil ; SpareOpHW ;#o0333 + nil ; SpareOpHW ;#o0334 + nil ; UnsignedLesspHW ; #o0335 + nil ; SpareOpHW ;#o0336 + nil ; SpareOpHW ;#o0337 + nil ; PopHW ; #o0340 + nil ; MovemHW ; #o0341 + nil ; MergeCdrNoPopHW ; #o0342 + nil ; SpareOpHW ;#o0343 + nil ; SpareOpHW ;#o0344 + nil ; SpareOpHW ;#o0345 + nil ; SpareOpHW ;#o0346 + nil ; SpareOpHW ;#o0347 + nil ; FastAref1HW ; #o0350 + nil ; FastAset1HW ; #o0351 + nil ; StackBltAddressHW ; #o0352 + nil ; SpareOpHW ;#o0353 + nil ; SpareOpHW ;#o0354 + nil ; SpareOpHW ;#o0355 + nil ; SpareOpHW ;#o0356 + nil ; SpareOpHW ;#o0357 + nil ; SpareOpHW ;#o0360 + nil ; SpareOpHW ;#o0361 + nil ; SpareOpHW ;#o0362 + nil ; SpareOpHW ;#o0363 + nil ; SpareOpHW ;#o0364 + nil ; SpareOpHW ;#o0365 + nil ; SpareOpHW ;#o0366 + nil ; SpareOpHW ;#o0367 + nil ; DpbHW ; #o0370 + nil ; CharDpbHW ; #o0371 + nil ; PDpbHW ; #o0372 + nil ; PTagDpbHW ; #o0373 + nil ; SpareOpHW ;#o0374 + t ; LoopIncrementTosLessThanHW ; #o0375 + nil ; CatchOpenHW ; #o0376 + nil ; SpareOpHW ;#o0377 +)) + +(defvar *fullwordinstns* #( ; [48] + nullfw ; #o00 = DTP-NULL + monitorforwardfw ; #o01 = DTP-MONITOR-FORWARD + headerpfw ; #o02 = DTP-HEADER-P + headerifw ; #o03 = DTP-HEADER-I + valuecell ; #o04 = DTP-EXTERNAL-VALUE-CELL-POINTER + oneqforwardfw ; #o05 = DTP-ONE-Q-FORWARD + headerforwardfw ; #o06 = DTP-HEADER-FORWARD + elementforwardfw ; #o07 = DTP-ELEMENT-FORWARD + pushimmediateconstant ; #o10 = DTP-FIXNUM + pushimmediateconstant ; #o11 = DTP-SMALL-RATIO + pushimmediateconstant ; #o12 = DTP-SINGLE-FLOAT + pushconstantvalue ; #o13 = DTP-DOUBLE-FLOAT + pushconstantvalue ; #o14 = DTP-BIGNUM + pushconstantvalue ; #o15 = DTP-BIG-RATIO + pushconstantvalue ; #o16 = DTP-COMPLEX + pushconstantvalue ; #o17 = DTP-SPARE-NUMBER + pushconstantvalue ; #o20 = DTP-INSTANCE + pushconstantvalue ; #o21 = DTP-LIST-INSTANCE + pushconstantvalue ; #o22 = DTP-ARRAY-INSTANCE + pushconstantvalue ; #o23 = DTP-STRING-INSTANCE + pushimmediateconstant ; #o24 = DTP-NIL + pushconstantvalue ; #o25 = DTP-LIST + pushconstantvalue ; #o26 = DTP-ARRAY + pushconstantvalue ; #o27 = DTP-STRING + pushconstantvalue ; #o30 = DTP-SYMBOL + pushconstantvalue ; #o31 = DTP-LOCATIVE + pushconstantvalue ; #o32 = DTP-LEXICAL-CLOSURE + pushconstantvalue ; #o33 = DTP-DYNAMIC-CLOSURE + pushconstantvalue ; #o34 = DTP-COMPILED-FUNCTION + pushconstantvalue ; #o35 = DTP-GENERIC-FUNCTION + pushconstantvalue ; #o36 = DTP-SPARE-POINTER-1 + pushconstantvalue ; #o37 = DTP-SPARE-POINTER-2 + pushimmediateconstant ; #o40 = DTP-PHYSICAL-ADDRESS + nativeinstruction ; #o41 = DTP-NATIVE-INSTRUCTION + boundlocationfw ; #o42 = DTP-BOUND-LOCATION + pushimmediateconstant ; #o43 = DTP-CHARACTER + logicvariablefw ; #o44 = DTP-LOGIC-VARIABLE + gcforwardfw ; #o45 = DTP-GC-FORWARD + pushconstantvalue ; #o46 = DTP-EVEN-PC + pushconstantvalue ; #o47 = DTP-ODD-PC + callcompiledeven ; #o50 = DTP-CALL-COMPILED-EVEN + callcompiledodd ; #o51 = DTP-CALL-COMPILED-ODD + callindirect ; #o52 = DTP-CALL-INDIRECT + callgeneric ; #o53 = DTP-CALL-GENERIC + callcompiledevenprefetch ; #o54 = DTP-CALL-COMPILED-EVEN-PREFETCH + callcompiledoddprefetch ; #o55 = DTP-CALL-COMPILED-ODD-PREFETCH + callindirectprefetch ; #o56 = DTP-CALL-INDIRECT-PREFETCH + callgenericprefetch ; #o57 = DTP-CALL-GENERIC-PREFETCH +)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The Disassembler ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; The Disassembler is only required for debugging purposes. Someone should hack the +;;; real disassembler to disassemble 'fully assembled functions and integrate it. + +(defun sign-extend (value bits) + (dpb value (byte (1- bits) 0) (- (ldb (byte 1 (1- bits)) value)))) + +(clos:defmethod instruction-name ((decinst fullword-instruction)) + (clos:with-slots (opcode) decinst + (svref *fullwordinstns* opcode))) + +(clos:defmethod instruction-name ((decinst halfword-instruction)) + (clos:with-slots (opcode) decinst + (svref *halfwordinstns* opcode))) + +;; Broken out for calling from Genera disassembler +(defun i-lisp-compiler:vlm-print-native-instruction (constant stream &optional pc) + (let* ((opcode (ldb %%alpha-inst-opcode constant)) + (mopname (svref *Major-opcodes* opcode)) + (ftyp (svref *Opcode-Format* opcode)) + (ra (ldb %%alpha-inst-ra constant)) + (rb (ldb %%alpha-inst-rb constant)) + (rc (ldb %%alpha-inst-rc constant)) + (function (ldb (byte 7 5) constant)) + (litp (= 1 (ldb (byte 1 12) constant))) + (lit (ldb (byte 8 13) constant)) + (mdisp (ldb %%alpha-inst-memory-disp constant)) + (bdisp (ldb %%alpha-inst-branch-disp constant)) + (palfun (ldb (byte 26 0) constant))) + (case ftyp + ((pal) + (future-common-lisp::format stream "~a(~x) #x~x" + mopname opcode palfun) + nil) + ((res) + (future-common-lisp::format stream "~a #x~x" mopname constant) + nil) + ((mem) + (if (not (zerop (logand mdisp #x8000))) (setq mdisp (dpb mdisp (byte 16 0) -1))) + (future-common-lisp::format stream "~a ~a, #x~x(~a)" + mopname (regname ra) mdisp (regname rb)) + (multiple-value-bind (disp tag) (floor mdisp 8) + (let ((component + (unless (member mopname '(LDQ STQ LDA LDAH)) + (if (zerop tag) "Data" "Tag")))) + (case (regname rb) + (iSP (unless (plusp disp) (values :SP (- disp) component))) + (iFP (unless (minusp disp) (values :FP disp component))) + (iLP (unless (minusp disp) (values :LP disp component))))))) + ((op) + (future-common-lisp::format stream "~a ~a, ~a, ~a" + (fcnname opcode function) + (regname ra) + (if litp lit (regname rb)) + (regname rc)) + nil) + ((non) + (future-common-lisp::format stream "~a #x~x" pc mopname constant) + nil) + ((br) + (future-common-lisp::format stream "~a ~a, #x~x(~o)" + mopname (regname ra) bdisp + (+ (or pc 0) + (* (if (zerop (ldb (byte 1 20) bdisp)) + bdisp + (dpb bdisp (byte 21 0) -1)) + 2) + ;; Branch is on advanced pc + 2)) + nil)))) + +(defun i-lisp-compiler:vlm-emulate-native-instruction (constant) + (let* ((opcode (ldb %%alpha-inst-opcode constant)) + (mopname (svref *Major-opcodes* opcode)) + (ftyp (svref *Opcode-Format* opcode)) + (ra (ldb %%alpha-inst-ra constant)) + (rb (ldb %%alpha-inst-rb constant)) + (rc (ldb %%alpha-inst-rc constant)) + (function (ldb (byte 7 5) constant)) + (litp (= 1 (ldb (byte 1 12) constant))) + (lit (ldb (byte 8 13) constant)) + (bdisp (ldb %%alpha-inst-branch-disp constant)) + (mdisp (ldb %%alpha-inst-memory-disp constant))) + (case ftyp + ((mem) + (if (not (zerop (logand mdisp #x8000))) (setq mdisp (dpb mdisp (byte 16 0) -1))) + (case mopname + (LDA + (when (eq (regname ra) 'iSP) + (assert (lisp:and (eq (regname rb) 'iSP) litp)) + (values (/ mdisp 8)))))) + ((op) + (case (fcnname opcode function) + (ADDQ + (when (eq (regname rc) 'iSP) + (assert (lisp:and (eq (regname ra) 'iSP) litp)) + (values (/ lit 8)))) + (SUBQ + (when (eq (regname rc) 'iSP) + (assert (lisp:and (eq (regname ra) 'iSP) litp)) + (values (- (/ lit 8))))))) + ((br) + (values nil (+ (* (sign-extend bdisp 21) 2) 2) (eq mopname 'br)))))) + +(clos:defmethod print-instruction ((decinst fullword-instruction) &optional (stream t)) + (clos:with-slots (pc constant nextpc) decinst + (fresh-line stream) + (if (native-instructionp decinst) + (clos:with-slots (constant) decinst + (i-lisp-compiler:vlm-print-native-instruction constant stream pc)) + (let* ((instname (instruction-name decinst))) + (future-common-lisp::format stream "~o: ~a constant=~a nextpc=~o~%" + pc instname constant nextpc))))) + +(clos:defmethod print-instruction ((decinst halfword-instruction) &optional (stream t)) + (clos:with-slots (pc operand nextpc) decinst + (fresh-line stream) + (let* ((instname (instruction-name decinst))) + (future-common-lisp::format stream "~o: ~a operand=~a nextpc=~o~%" + pc instname operand nextpc)))) + +(clos:defmethod print-function ((decfcn decoded-function) &optional (stream t)) + (clos:with-slots (instructions) decfcn + (dolist (inst instructions) + (print-instruction inst stream)))) + +(clos:defmethod print-function ((ts translation-state) &optional (stream t)) + (clos:with-slots (source target) ts + (print-function (or target source) stream))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for pulling apart an ivory function object. This is almost certainly +;;; provided by existing Genera functions, and this code shoule probably be replaced by +;;; use of standard Genera primitives intended for this purpose. It should probab;y be +;;; done at the time that the translator technology is integrated so as to allow +;;; fasl files to be written, and for functions to get translated automatically if they +;;; have a magic declaration. For the time being, the task is to get the translator +;;; core working. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; (instnref compiled-function index) +;;; +;;; Index is an index into the compiled function in fullwords. First +;;; instruction is at 0. The instruction returns multiple values as +;;; follows: +;;; cdr-code +;;; type The (6) type bits (cdr code removed) +;;; tag The full tag including cdr-code +;;; data The data word as a fixnum +;;; word The full word including tag and cdr code. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tag-data-type (tag) + (logand tag #x3f)) + +(defun tag-cdr-code (tag) + (ash tag -6)) + +(defun instnref (fcn index) + (let* ((datum (si:%memory-read (si:%pointer-plus fcn index) + :cycle-type si:%memory-scavenge + :set-cdr-next nil)) + (tag (si:%tag datum))) + (values (tag-cdr-code tag) ;The CDR code + (tag-data-type tag) ;The type (tag wo cdr code) + tag ;The complete 8 bit tag + (si:%set-tag datum si:dtp-fixnum) ;The data word as a fixnum + ;; If it is a pointer, we need to keep a locative to it (so + ;; the GC doesn't move it on us, but we can't always use the + ;; raw word (e.g., EVCP). For non-pointer data, the raw + ;; word is safe + (if (sys:%pointerp datum) + (si:%set-tag datum si:dtp-locative) + datum)))) + +(clos:defmethod findpc ((decfcn decoded-function) apc) + (clos:with-slots (instructions) decfcn + (dolist (in instructions) + (clos:with-slots (pc) in + (if (= pc apc) (return-from findpc in)))))) + +(clos:defmethod abstract-branch-target ((decfcn decoded-function) + (inst ibranch-format-instruction)) + (clos:with-slots (instruction) decfcn + (clos:with-slots (pc operand target) inst + (let* ((offset (sign-extend operand 10)) + (targetpc (+ pc offset)) + (targetinst (findpc decfcn targetpc))) + (if (null targetinst) (error "Can't find target instruction")) + (setq target (label-instruction targetinst)))))) + +(clos:defmethod linkup-function ((decfcn decoded-function)) + (clos:with-slots (instructions) decfcn + ;; First for every instruction, find its PC sequencing successor. + (dolist (instn instructions) + (if (typep instn 'ibranch-format-instruction) + (abstract-branch-target decfcn instn)) + (clos:with-slots (nextinstn nextpc pc) instn + (setq nextinstn (findpc decfcn nextpc)))) + ;; Next starting with the first instruction assign an execution order. + (do ((iorder 0 (+ iorder 1)) + (instn (first instructions) (clos:with-slots (nextinstn) instn nextinstn))) + ((null instn) + ;; Finally sort the instructions into execution order + (setq instructions + (sort (delete nil instructions :key 'ivory-instruction-order) + #'< :key 'ivory-instruction-order))) + (clos:with-slots (order) instn + (setq order iorder))))) + +(defun i-lisp-compiler:vlm-decode-ivory-function (fcn) + (assert (typep fcn 'compiled-function)) + (let ((decfcn (clos:make-instance 'decoded-function)) + (endcc nil) + (info nil)) + (do ((index 0 (+ index 1))) + (endcc ()) + (multiple-value-bind (cc type tag data word) (instnref fcn index) + (declare (ignore type)) + (cond ((= cc 1) + ;reconstitute the debug info + (setq info (sys:%set-tag word tag)) + (setq endcc t)) + (:otherwise + (decode-ivory-instruction decfcn index tag data word))))) + (clos:with-slots (packed-instructions debug-info instructions) decfcn + (setq instructions (nreverse instructions)) + (setq debug-info info)) + (linkup-function decfcn) + decfcn)) + +(defun make-hwinst (cc pc opcode datum tag nextpc) + (clos:make-instance (if (branch-format-hw-opcodep opcode) + 'ibranch-format-instruction + 'halfword-instruction) + :sequence cc + :pc pc + :nextpc (+ (ash nextpc 1) (if (eq tag si:dtp-odd-pc) 1 0)) + :opcode opcode + :operand datum)) + +(defun make-fwinst (cc pc opcode datum tag nextpc) + (clos:make-instance 'fullword-instruction + :sequence cc + :pc pc + :nextpc (+ (ash nextpc 1) (if (eq tag si:dtp-odd-pc) 1 0)) + :opcode opcode + :constant datum)) + +(clos:defmethod copy-instruction ((oldinst fullword-instruction)) + (clos:with-slots (label sequence pc nextpc opcode constant) oldinst + (clos:make-instance 'fullword-instruction + :label label + :sequence sequence + :pc pc + :nextpc nextpc + :opcode opcode + :constant constant))) + +(clos:defmethod copy-instruction ((oldinst halfword-instruction)) + (clos:with-slots (label sequence pc nextpc opcode operand) oldinst + (clos:make-instance 'halfword-instruction + :label label + :sequence sequence + :pc pc + :nextpc nextpc + :opcode opcode + :operand operand))) + +(clos:defmethod copy-instruction ((oldinst ibranch-format-instruction)) + (clos:with-slots (label sequence pc nextpc opcode operand target) oldinst + (clos:make-instance 'ibranch-format-instruction + :label label + :sequence sequence + :pc pc + :nextpc nextpc + :opcode opcode + :operand operand + :target target))) + +(defun make-alpha-instruction (bits) + (let* ((fnbits (if (zerop (ldb (byte 1 31) bits)) + bits + (dpb (ldb (byte 31 0) bits) (byte 31 0) -1))) + (opcodebits (ldb %%alpha-inst-opcode bits)) + (opcodetype (aref *Opcode-Format* opcodebits))) + (clos:make-instance (if (eq opcodetype 'br) + 'alpha-native-branch-instruction + 'alpha-native-instruction) + :opcode i-lisp-compiler:*vlm-native-instruction-opcode* + :sequence 3 + :constant fnbits))) + +(clos:defmethod add-instruction ((nuinst ivory-instruction) (istream translation-state)) + (clos:with-slots (target pendinglabel) istream + (clos:with-slots (instructions icount) target + (clos:with-slots (order label) nuinst + (when pendinglabel + (setq label (append label (shiftf pendinglabel nil)))) + (setq order icount) + (push nuinst instructions) + (incf icount))))) + +;;; on entry PC is a word index, we convert it to hwpc by doubling +(clos:defmethod decode-ivory-instruction ((decfcn decoded-function) pc tag data word) + (multiple-value-bind (cc even-tag even-pc odd-tag odd-pc) + (case (tag-cdr-code tag) + (0 (values 0 si:dtp-odd-pc pc si:dtp-even-pc (+ pc 1))) + (3 (values 3 si:dtp-even-pc (+ pc 1) si:dtp-even-pc (+ pc 2))) + (2 (values 2 si:dtp-odd-pc (- pc 1) si:dtp-even-pc pc)) + (1 (error "Illegal Sequencing Code"))) + (clos:with-slots (instructions packed-instructions) decfcn + (cond ((let ((opcode (ldb (byte 8 10) data))) ;entry instruction ? + (lisp:and (= (tag-data-type tag) #o60) + (or (= opcode #o176) (= opcode #o177)))) + ;; Entry instruction + (push (make-hwinst cc (ash pc 1) + (logand #xFF (ash data -10)) + data + even-tag even-pc) + instructions)) + ((>= (tag-data-type tag) #o60) + (let ((even-instruction (ldb si:%%q-even-instruction data)) + (odd-instruction (dpb tag (byte 4 14.) (ldb (byte 14. 18.) data)))) + (push (make-hwinst cc (ash pc 1) + (logand #xFF (ash even-instruction -10)) + (logand #x3FF even-instruction) + even-tag even-pc) + instructions) + (push (make-hwinst cc (+ (ash pc 1) 1) + (logand #xFF (ash odd-instruction -10)) + (logand #x3FF odd-instruction) + odd-tag odd-pc) + instructions))) + (t + (push (make-fwinst cc (ash pc 1) + (logand tag #x3F) + word + even-tag even-pc) + instructions))))) + nil) + +(clos:defmethod set-instn-cdr-code ((decinst ivory-instruction) cc) + (clos:with-slots (sequence) decinst + (setq sequence cc))) + +(defmacro ivory-label (lab) + `(setlabel istream ,lab)) + +(defmacro alpha-label (lab) + `(setlabel istream ,lab)) + +(clos:defmethod setlabel ((istream translation-state) label) + (clos:with-slots (pendinglabel) istream + (if (listp label) + (setq pendinglabel (append label pendinglabel)) + (push label pendinglabel)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation driver. + +;;; Translate function takes one decoded function and creates another +;;; decoded function in which some of the instructions have been +;;; translated and now appear as fullword DTP-NATIVE-INSTRUCTION. + +(defmacro emit (&rest forms) + `(assemble-asm-form (list ,@forms) istream)) + +;;; Registers to remember! +;;; (define-integer-register iPC 9) +;;; (define-integer-register iFP 10) +;;; (define-integer-register iLP 11) +;;; (define-integer-register iSP 12) +;;; (define-integer-register iCP 13) +;;; (define-integer-register ivory 14) ; ivory processor object + +(clos:defmethod i-lisp-compiler:vlm-translate-function ((decfcn decoded-function)) + (let* ((newfcn (clos:make-instance 'decoded-function)) + (tstate (clos:make-instance 'translation-state :source decfcn :target newfcn)) + (newinfo nil) + (fcnloc nil)) + (clos:with-slots (instructions debug-info) decfcn + (setq newinfo debug-info) + (let ((*function-epilogue* nil)) + (dolist (instn instructions) + (clos:with-slots (label) instn + (setlabel tstate (shiftf label nil))) ;move label to first emitted inst + (funcall (instruction-name instn) tstate instn) + ;; Note original pc on last instruction of expansion + (clos:with-slots (pc) instn + (clos:with-slots (target) tstate + (clos:with-slots (instructions) target + (clos:with-slots (originalpc) (first instructions) + (setf originalpc pc)))))) + (loop while *function-epilogue* + do (assemble-asm-form (shiftf *function-epilogue* nil) tstate)))) + (emit-escape-blocks tstate) + (clos:with-slots (instructions debug-info) newfcn + (setq debug-info newinfo) + (setq instructions (nreverse instructions))) + (pack-instructions newfcn) ; Pack the instructions and assign PC's + ;; --- Need to handle other pc lists in debug-info: lexicals, instances, traps + (clos:with-slots (instructions debug-info) newfcn + (let ((vca (cdr (assoc :variable-creation-alist (cdr debug-info))))) + (loop for inst in instructions + while vca do + (clos:with-slots (originalpc pc) inst + (let ((hit (assoc originalpc vca))) + (when hit + (setf (car hit) pc) + (pop vca))))))) + (clos:with-slots (target i-lisp-compiler:newfun) tstate + (clos:with-slots (packed-instructions packed-size debug-info) target + (multiple-value-setq (fcnloc i-lisp-compiler:newfun) + (si:make-compiled-code (+ packed-size 3) 1)) + (do ((i 0 (+ i 1))) + ((>= i packed-size) + (setf (si:cca-extra-info fcnloc) debug-info) + i-lisp-compiler:newfun) + (si:%memory-write (si:%pointer-plus fcnloc (+ i 2)) + (si:%memory-read (si:aloc packed-instructions i) + :cycle-type sys:%memory-scavenge + :set-cdr-next nil))))) + tstate)) + +;;; Instructions in the generated instruction stream are entered in order of expected +;;; execution, and not in a packed sequence. pack-instructions assigns packed PC's +;;; to the instructions and sets cdr code bits for sequencing. +;;; The resulting sequence is stored as a list in 'packed-instns' for later storage +;;; in a compiled function object. + +(clos:defmethod pack-instructions ((decfcn decoded-function)) ; + (clos:with-slots (instructions packed-instructions packed-size) decfcn + (let* ((thispc 0) ;The current PC + (thistype nil) ;The current instruction type + (prvpc -2) ;The previous PC + (prvprvpc -4) ;The pc before last + (prvtype :fullword) ;Previous instruction type + (prvprvtype :fullword) ;Prev Prev instruction type + (prvinstn nil) + (instvec (make-array (length instructions))) + (instptr (si:aloc instvec 0)) + (wordcount 0) + (labels-alist ()) + (branches-list ()) + (alpha-branches-list ()) + (maxpc 0)) + ;; First assign PC's and CDR codes. + (dolist (instn instructions) + (setq thistype (instruction-kind instn)) + (clos:with-slots (pc opcode nextpc nextinstn label) instn + (if (entry-instructionp instn) (setq thistype :fullword)) + (cond + ((eq thistype :halfword) + (cond ((eq prvtype :halfword) + (cond ((= (- prvprvpc prvpc) 1) + (setq thispc (+ maxpc 2)) + (set-instn-cdr-code instn 0) + (setq maxpc thispc)) + (:otherwise + (setq thispc (+ maxpc 1)) + (set-instn-cdr-code instn 0) + (setq maxpc thispc)))) + + ((lisp:and (eq prvtype :fullword) + (eq prvprvtype :halfword) + (= (- prvpc prvprvpc) 2) + (not (native-instructionp prvinstn))) + ;; we have a hole to fill, an we fit! + (set-instn-cdr-code prvinstn 2) + (set-instn-cdr-code instn 3) + (setq thispc (- prvpc 1))) + + (:otherwise + (setq thispc (+ prvpc 2)) ;prev was :fullword + (set-instn-cdr-code instn 0) + (setq maxpc thispc)))) + + ((eq thistype :fullword) + (cond ((eq prvtype :fullword) + (setq thispc (+ prvpc 2)) + (setq maxpc thispc) + (set-instn-cdr-code instn 3)) + + ((evenp prvpc) + (setq thispc (+ prvpc 2)) + (setq maxpc thispc) + (set-instn-cdr-code prvinstn 3) + (set-instn-cdr-code instn 3)) + + ((oddp prvpc) + (setq maxpc thispc) + (setq thispc (+ prvpc 1)) + (set-instn-cdr-code instn 3))))) + + (setq pc thispc) + (if (typep instn 'ibranch-format-instruction) + (push instn branches-list)) + (if (typep instn 'alpha-native-branch-instruction ) + (push instn alpha-branches-list)) + (if label + (loop for l in label do + (assert (not (assoc l labels-alist)) () "Duplicate label ~A" l) + (push (cons l instn) labels-alist))) + (setq prvprvtype prvtype + prvtype thistype + prvprvpc prvpc + prvpc thispc + prvinstn instn))) + ;; Next fixup the labels. + (dolist (ob branches-list) + (clos:with-slots (operand target pc) ob + (let* ((targetinst (assoc target labels-alist)) + (sourcepc pc)) + (if (null targetinst) + (error "Can't find target for branch instruction.")) + (clos:with-slots (pc) (cdr targetinst) + (let ((delta (- pc sourcepc))) + ;(break "branch computation for ~a." targetinst) + (setq operand (dpb delta (byte 10 0) operand))))))) + (dolist (ob alpha-branches-list) + (clos:with-slots (constant target pc) ob + (let* ((targetinst (assoc target labels-alist)) + (sourcepc pc)) + (if (null targetinst) + (error "Can't find target for alpha branch instruction.")) + (clos:with-slots (pc) (cdr targetinst) + (let ((delta (- pc sourcepc 2))) + (setq constant (dpb (ash delta -1) (byte 21 0) constant))))))) + ;; Next sort according to PC + (setq instructions (sort instructions #'< :key 'ivory-instruction-pc)) + ;; Finally assemble the instructions + (setq packed-instructions ()) + (do ((ilist instructions (cdr ilist))) + ((null ilist) + (setq packed-size wordcount) + (setq packed-instructions instvec)) + (let* ((inst (car ilist)) + (nextinst (cadr ilist)) + (hwinstn2 0) + (opcode2 0) + (ityp (instruction-kind inst)) + (nextityp (lisp:and nextinst (instruction-kind nextinst)))) + (cond + ((eq ityp :fullword) ; Simple case. 1 fullword instruction + (clos:with-slots (opcode constant sequence pc) inst + (let* ((tag (logior opcode (ash sequence 6))) + (instn (si:%make-pointer tag constant))) + (setq instn (si:%set-tag instn tag)) + (si:%memory-write instptr instn) + (incf wordcount) + (setq instptr (si:%pointer-plus instptr 1))))) + ((eq ityp :halfword) + (cond ((lisp:and (eq nextityp :halfword) (not (entry-instructionp inst))) + (pop ilist) + (clos:with-slots (operand opcode) nextinst + (setq opcode2 opcode) + (setq hwinstn2 operand)))) + (clos:with-slots (tag opcode operand sequence) inst + (let ((instn (si:%make-pointer + (logior #x30 (ash opcode2 -4)) + (+ + (if (zerop (logand opcode2 #x8)) + 0 + most-negative-fixnum) + (logior + (ash (logand opcode2 #x7) 28) + (ash (logand hwinstn2 #x3FF) 18) + (logior (ash opcode 10) operand)))))) + (setq instn (si:%set-tag instn (logior (ash sequence 6) (si:%tag instn)))) + (si:%memory-write instptr instn) + (incf wordcount) + (setq instptr (si:%pointer-plus instptr 1))))) + (:otherwise (error "Unknown instruction kind.")))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; set-instruction-mode is used to track the emulater instruction mode. Instruction +;;; mode is tracked in the translation-state. Switching from nativemode to emulated +;;; mode is done explicitely via a call to a subroutine in the IVORY object. Switching +;;; into native mode is done automatically because of the fullword native-instruction. +;;; Hence emulated instructions can switch into native instructions without an explicit +;;; switch, but the contrary direction emits a call. +;;; The resume-emulated slot contains a JMP instruction to the interpreter reentry loop. +;;; arg1 has the PC from the native mode call so that the new ivory PC can be computed from +;;; it. The trampoline througfh ivory is done so that we can get back into emulated mode +;;; with a single nativemode instruction to avoid code bloat. Ivory could conatina the +;;; address to jump to, but then we would have to load it before the jump and it would take +;;; two emited instructions. + +(defparameter *resume-emulated* 0) ;; This is the resume location +++ add to aistat + +(clos:defmethod set-instruction-mode ((ts translation-state) mode) + (assert (or (eq mode :emulated) (eq mode :native))) + (clos:with-slots (nativemodep) ts + (cond + ((lisp:and (eq mode :emulated) nativemodep) + (assemble-asm-form +#+OLDWAY + `((LDQ arg1 ,processorstate$q-resumeema (ivory)) + (JMP arg1 arg1 0)) +#-OLDWAY + '(JMP arg1 r0 #x8000) + ts) + (setf nativemodep nil)) + ((lisp:and (eq mode :native) (not nativemodep)) + (setf nativemodep t))))) + +(clos:defmethod emit-alphabits ((destination translation-state) bits &optional disp) + (set-instruction-mode destination :native) + (let ((instn (make-alpha-instruction bits))) + (if (lisp:and disp (symbolp disp)) + (clos:with-slots (target) instn + (setq target disp))) + (add-instruction instn destination))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation handler functions. ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Support for 'single-shot' escape blocks. A single shot sequence is a sequence +;;; of instructions that emulates a single ivory instruction and then returns to the +;;; instruction stream. It is used to 'punt' translated instruction cases that are +;;; hard to do such as instructions twould cause an exception, or other hard sequences. +;;; The single shot sequences are emited at the end. Each sequence assumes that it +;;; is being entered in native mode so that it can be the target of an alpha branch. + +(defmacro make-escape (instn &optional tosstatus) + `(emit-make-escape istream ,instn ,tosstatus)) + +;;; Adds an escape sequence for the single instruction 'instn' Two values are returned, +;;; both labels (symbols). The first is the label for the escape sequence. This label can be +;;; jumped to from an alpha-branch instruction to execute the escape. The second label, is +;;; the return label. The caller is responsible for setting the return label. The return +;;; label is an ivory label. + +(clos:defclass escape-block () + ((instruction :initarg :instruction) + (returnto :initarg :returnto) + (tosstatus :initarg :tosstatus))) + +(clos:defmethod emit-make-escape ((istream translation-state) instn &optional tosstatus) + (clos:with-slots (target) istream + (clos:with-slots (escapeblocks) target + (let* ((escapelabel (gensym)) + (returnlabel (gensym)) + (nuinst (copy-instruction instn))) + ;; Caution! The escaped instruction may already have a label on + ;; it, but that label should already have been emitted on the + ;; translated version, so don't keep it + (clos:with-slots (label) nuinst + (setf label `(,escapelabel))) + (push (clos:make-instance 'escape-block + :instruction nuinst + :returnto returnlabel + :tosstatus tosstatus) + escapeblocks) + (values escapelabel returnlabel))))) + +(clos:defmethod emit-escape-blocks ((istream translation-state)) + (clos:with-slots (target) istream + (clos:with-slots (escapeblocks) target + (dolist (esc (reverse escapeblocks)) + ;; emit each escape in the order that it was received. + (set-instruction-mode istream :native) ;force native mode for entry. + (emit-block istream esc)) + ;; should delete emited blocks.+++ + ))) + +(clos:defmethod emit-block ((istream translation-state) (esc escape-block)) + (clos:with-slots (instruction returnto tosstatus) esc + (clos:with-slots (label) instruction + ;; Don't leave the label on the passed-through instruction, it + ;; needs to go on the first instruction emitted + (setlabel istream (shiftf label nil))) + (ecase tosstatus + ((nil :arg6) + (let ((returninst (clos:make-instance 'ibranch-format-instruction + :opcode #o0174 ; +++ Branch + :target returnto))) + (passthrough-ivory-instruction istream instruction) ; emit the single shot + (passthrough-ivory-instruction istream returninst))) + (:arg5arg6 + (passthrough-ivory-instruction istream instruction) ; emit the single shot + (emit + `((stack-read2 iSP arg5 arg6 :tos-valid nil :signed t "Cache TOS") + (BR zero ,returnto))))) + )) + +;;; Support for decoding and interpreting halfword instruction 10 bit operands. + +(defun map-cs-rel (n) (svref #(:FP :LP :SP :Immediate) n)) + +(defun map-ivory-register (regid) + (case regid + ((:SP) 'iSP) + ((:FP) 'iFP) + ((:LP) 'iLP))) + +;;; Val is evalueted multiple times in below. Is should therefore be a symbol! +++ +;;; fix this macro to make the right thing happen when its nota symbol or constant. +(defmacro decode-operand-specifier ((relto offset popp) val &body body) + `(let* ((,relto (map-cs-rel (ldb (byte 2 8) ,val))) + (,popp (lisp:and (eq ,relto :SP) (= (ldb (byte 8 0) ,val) 0))) + (,offset (if ,popp + 0 + (if (eq ,relto :SP) + (- (ldb (byte 8 0) ,val) 255) + (ldb (byte 8 0) ,val))))) + ,@body)) + +(defmacro compute-operand-value (instn reg &rest stack-options) + `(emit-compute-operand-value istream ,instn ,reg ,@stack-options)) + +(defmacro compute-operand-value2 (instn regtag regdata &rest stack-options) + `(emit-compute-operand-value2 istream ,instn ,regtag ,regdata ,@stack-options)) + +(defmacro compute-operand-data (instn regdata &rest stack-options) + `(emit-compute-operand-data istream ,instn ,regdata ,@stack-options)) + +(defmacro compute-operand-address (instn reg) + `(emit-compute-operand-address istream ,instn ,reg)) + +(defmacro compute-operand-register-offset (instn reg) + `(emit-compute-operand-register-offset istream ,instn ,reg)) + +;;; Computes the operand value and stores the result in dest. The stack may be popped +;;; if the operand mode calls for it. dest may be iSP! If the operand in immediate, +;;; the value may be sign extended, or not. The default is to sign extend, the optional +;;; argument signextendimm controls this behavior. + +;;; Computes the operand value and stores the result in dest. The stack may be popped +;;; if the operand mode calls for it. dest may be iSP! If the operand in immediate, +;;; the value may be sign extended, or not. The default is to sign extend, the optional +;;; argument signextendimm controls this behavior. + +(clos:defmethod emit-compute-operand-value ((istream translation-state) + instn dest &rest stack-options) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (if (getf stack-options :signed t) + (setq offset (dpb offset (byte 8 0) (- (logand #x80 offset))))) + (if (zerop offset) + (emit `((STL zero ,(symbol-value 'processorstate$q-immediate-arg) (Ivory)) + (LDQ ,dest ,(symbol-value 'processorstate$q-immediate-arg) (Ivory)))) + (emit `((BIS zero ,offset ,dest) + (STL ,dest ,(symbol-value 'processorstate$q-immediate-arg) (Ivory)) + (LDQ ,dest ,(symbol-value 'processorstate$q-immediate-arg) (Ivory))))) + ) + ((lisp:and popp (not (eq dest 'iSP))) + ;; The SP-POP case! + (emit `(stack-pop ,dest :tos-valid ,(TOSStatus) ,@stack-options)) + (TOSValid :invalid)) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit + `(stack-read-disp ,(map-ivory-register relto) ,(* 8 offset) ,dest + :tos-valid ,(TOSStatus) ,@stack-options))))))) + + +(clos:defmethod emit-compute-operand-value2 ((istream translation-state) + instn desttag destdata &rest stack-options) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (if (getf stack-options :signed t) + (setq offset (dpb offset (byte 8 0) (- (logand #x80 offset))))) + (emit `(LDA ,destdata ,offset (zero))) + (emit `(BIS zero ,|type|$k-|fixnum| ,desttag))) + ((lisp:and popp (not (eq destdata 'iSP))) + ;; The SP-POP case! + (emit `(stack-pop2 ,desttag ,destdata :tos-valid ,(TOSStatus) ,@stack-options)) + (TOSValid :invalid)) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit + `(stack-read2-disp ,(map-ivory-register relto) ,(* 8 offset) ,desttag ,destdata + :tos-valid ,(TOSStatus) ,@stack-options))))))) + +(clos:defmethod emit-compute-operand-data ((istream translation-state) + instn dest &rest stack-options) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (if (getf stack-options :signed t) + (setq offset (dpb offset (byte 8 0) (- (logand #x80 offset))))) + (emit `((LDA ,dest ,offset (zero))))) + ((lisp:and popp (not (eq dest 'iSP))) + ;; The SP-POP case! + (emit `(stack-pop-data ,dest :tos-valid ,(TOSStatus) ,@stack-options)) + (TOSValid :invalid)) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit + `(stack-read-data-disp ,(map-ivory-register relto) ,(* 8 offset) ,dest + :tos-valid ,(TOSStatus) ,@stack-options))))))) + +;;; Computes the operand address and stores the result in dest. The stack may be popped +;;; if the operand mode calls for it. dest may be iSP! + +(clos:defmethod emit-compute-operand-address ((istream translation-state) + instn dest) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (error "Immediate mode operand not allowed here")) + (popp + ;; The SP-POP case! + (emit `(LDA ,dest ,(* 8 offset) (,(map-ivory-register relto)))) + (if (not (eq dest 'iSP)) + (emit `(stack-pop-discard nil)) + (TOSValid :invalid))) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit `(LDA ,dest ,(* 8 offset) (,(map-ivory-register relto))))))))) + +(clos:defmethod emit-compute-operand-register-offset ((istream translation-state) + instn dest) + (declare (values register offset popp)) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (error "immediate mode operand not allowed here")) + ((lisp:and popp (not (eq dest 'isp))) + ;; the sp-pop case! + (emit `(stack-pop-discard nil)) + (TOSValid :invalid) + ;; note we have (pre-) popped the stack, so we have to + ;; adjust offset + (values (map-ivory-register relto) (* 8 (+ offset 1)) t)) + (:otherwise + ;;; the :sp :lp :fp cases (not sp-pop). justload the value into the + ;;; target. + (values (map-ivory-register relto) (* 8 offset) popp)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for managing the TOS cached state. the translation-state slot 'toscache' is +;;; used to track the state of the TOS cache. The TOS is cached opportunistically. +;;; An instruction can inherit a state in which the TOS is valid in one form or another +;;; or it can find the TOS uncached. Presently supported states are :invalid, :arg6 and +;;; :arg5arg6. Macros below allow the trivial management of TOS needs. + +(defmacro TOSvalid (status &optional cdr) + `(clos:with-slots (toscache toscdr) istream + (setf toscache ,status + toscdr ,cdr))) + +(defmacro TOSstatus () + `(clos:with-slots (toscache toscdr) istream + (values toscache toscdr))) + +(defmacro cacheTOS () + `(clos:with-slots (toscache) istream + (when (eq toscache :invalid) + (emit '(LDQ arg6 0 (iSP))) + (TOSvalid :arg6)))) + +(defmacro storeTOS () '(writeTOS 'iSP)) + +(defmacro writeTOS (vma &optional (offset 0)) + `(clos:with-slots (toscache) istream + (cond ((eq toscache :invalid) (error "TOS invalid")) + ((eq toscache :arg6) + (emit `(stack-write-disp ,,vma ,,offset arg6))) + ((eq toscache :arg5arg6) + (emit `(stack-write2-disp ,,vma ,,offset arg5 arg6)))))) + +(defmacro getTOStag (reg) + `(clos:with-slots (toscache) istream + (cond ((eq toscache :invalid) + (emit `(LDL ,,reg 4 (iSP)))) ;Load the tag + ((eq toscache :arg6) + (emit `(SRL arg6 32 ,,reg))) + ((lisp:and (eq toscache :arg5arg6) (not (eq ,reg 'arg5))) + (emit `(BIS arg5 zero ,,reg)))))) + +(defmacro getTOSdata (reg) + `(clos:with-slots (toscache) istream + (cond ((eq toscache :invalid) + (emit `(LDL ,,reg 0 (iSP)))) ;Load the data + ((eq toscache :arg6) + ;; Other two cases returned signed data, so be consistent + (emit `(ADDL arg6 0 ,,reg))) + ((lisp:and (eq toscache :arg5arg6) (not (eq ,reg 'arg6))) + (emit `(BIS arg6 zero ,,reg)))))) + +(defun allocate-registers (reglist) + (let ((allocforms ())) + (dolist (reg reglist) + (push `(setq ,reg (allocate-register istream)) allocforms)) + (nreverse allocforms))) + +(defun allocate-specific-registers (reglist istream) + (clos:with-slots (freeregs) istream + (dolist (reg reglist) + (if (member reg freeregs) + (setq freeregs (delete reg freeregs)) + (error "Can't allocate ~A" reg))) + reglist)) + +(defun release-registers (reglist) + (let ((forms ())) + (dolist (reg reglist) + (push `(free-register istream ,reg) forms)) + (nreverse forms))) + +(defun release-specific-registers (reglist istream) + (clos:with-slots (freeregs) istream + (dolist (reg reglist) + (pushnew reg freeregs)))) + +(defmacro with-temporary-registers ((&rest registers) &body body) + (if (null registers) + `(progn ,@body) + `(let (,@registers) + ,@(allocate-registers registers) + (unwind-protect + (progn ,@body) + ,@(release-registers registers))))) + +(defmacro with-specific-registers ((&rest registers) &body body) + (if (null registers) + `(progn ,@body) + `(progn + (allocate-specific-registers ',registers istream) + (unwind-protect + (progn ,@body) + (release-specific-registers ',registers istream))))) + +(defmacro xlatSCAtoVMA (sca vma temp) + `((LDQ ,temp ,(symbol-value 'processorstate$p-stackcachedata) (ivory)) + (LDQ ,vma ,(symbol-value 'processorstate$q-stackcachebasevma) (ivory)) + (SUBQ ,sca ,temp ,temp) + (SRL ,temp 3 ,temp) + (ADDQ ,temp ,vma ,vma))) + +(defmacro xlatConvertPcToContinuation (apc ctag cdata) + `((AND ,apc 1 ,ctag) + (SRL ,apc 1 ,cdata) ; convert PC to a real word address. + (LDA ,ctag ,|type|$k-|evenpc| (,ctag)))) + +(defmacro xlatConvertContinuationToPc (ctag cdata apc) + `((AND ,ctag 1 ,apc) + (ADDQ ,cdata ,apc ,apc) + (ADDQ ,cdata ,apc ,apc))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Register conventions: +;;; +;;; TOS is cached on a convenience basis. IF it is convenient to cache it, we do so +;;; in whatever form it pleases to to so do. The state of the TOS cache is recorded in +;;; translation-state slot 'toscache' and can have the following values: +;;; +;;; :invalid The TOS is not cached, you must reload it if you want it. +;;; :arg6 The TOS is stored as a 64 bit quantity in arg6 +;;; :arg5arg6 The TOS is stored as a tag+data in arg5/arg6 +;;; +;;; Upon entry from emulated mode, TOS is in :arg6 state because the emulator loop +;;; implements this behavior. When we exist to emulated mode, the emulator reloads TOS +;;; to arg6 for us. When loading values specifically for pushing, we can put them in arg5/6 +;;; so that TOS is in :arg5arg6 state after the operation. We don't waste cycles explicitely +;;; loading the TOS unless there is a clear and obvious win, because it causes code bloat +;;; and we can't guarantee a dual issue. Later an instruction lookahead mechanism could +;;; decide whether to preload TOS or not. +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; The register allocations and freeing mechainsm is simplistic. free registers are +;;; organized as a fifo, so that the registers get cycled rather than a few registers being +;;; reused again and again. the reason for cyclingthe registers is that itgives the greatest +;;; freedom for instruction scheduling without register conflicts. There is not presently +;;; an instruction scheduler. Nothing clever happens when a register is needed but is not +;;; available (it just errors out). There are numerous ways in which the register allocation +;;; mechanism could and should be improved including doing something when registers are +;;; exhausted, and keeping track of who the registers are allocated to. + +(clos:defmethod allocate-register ((ts translation-state)) + (clos:with-slots (freeregs) ts + (if (null freeregs) (error "Not enough registers!")) + (let ((reg (car (last freeregs)))) + (setf freeregs (delete reg freeregs)) + reg))) + +(clos:defmethod free-register ((ts translation-state) reg) + (clos:with-slots (freeregs) ts + (pushnew reg freeregs))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for defining translation rules. +;;; These are rather primitive at present, and I'm not entirely happy with them +;;; but time doesn't permit cleaning them up at this point. + +(defmacro def-fullword-translation (name arglist &rest body) + `(clos:defmethod ,name ((istream translation-state) ,@arglist) ,@body)) + +(defmacro def-halfword-translation (name arglist &rest body) + `(clos:defmethod ,name ((istream translation-state) ,@arglist) ,@body)) + +(defmacro def-decoded-halfword-translation (name (instn relto offset popp) &rest body) + `(def-halfword-translation ,name (,instn) + (clos:with-slots (operand) ,instn + (decode-operand-specifier (,relto ,offset ,popp) operand + ,@body)))) + +;(defmacro emit (&rest forms) +; `(assemble-asm-form (list ,@forms) istream)) + +(defmacro do-default (instn) + `(passthrough-ivory-instruction istream ,instn)) + +;;; Passing through an instruction (punting) causes the emulator to reenter emulator +;;; mode. The emulator mode maintains TOS in arg6. We don't force it tobe valid because +;;; the emulator does it or us, and even if it didn't it is better to have it out of +;;; line. Revertive to emulator mode has the side effect of acusing TOScache to be +;;; :arg6 (when it reenters native mode). + +(clos:defmethod passthrough-ivory-instruction ((istream translation-state) instn) + (set-instruction-mode istream :emulated) + (add-instruction (copy-instruction instn) istream) + (TOSvalid :arg6)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Passthrough section ;;; +;;; ;;; +;;; Instructions in this section have been selected to be punted ;;; +;;; in some cases this is because of 'risk of introducing bugs', in ;;; +;;; some cases it is because code bloat is prohinitive, and in other ;;; +;;; cases, it is because we didn't get around to it yet. ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Setup1DArrayHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Setup1DArrayHW (instn) ; #o03 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetupForce1DArrayHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetupForce1DArrayHW (instn) ; #o04 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BindLocativeHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BindLocativeHW (instn) ; #o05 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RestoreBindingStackHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RestoreBindingStackHW (instn) ; #o06 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EphemeralpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EphemeralpHW (instn) ; #o07 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StartCallHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StartCallHW (instn) ; #o010 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for JumpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation JumpHW (instn) ; #o011 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DereferenceHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DereferenceHW (instn) ; #o013 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogicTailTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogicTailTestHW (instn) ; #o014 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SpareOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SpareOpHW (instn) ; #o015 +++ Used for breakpoints!!! + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DoubleFloatOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DoubleFloatOpHW (instn) ; #o016 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushLexicalVarNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushLexicalVarNHW (instn) ; #o020 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0WriteHW (instn) ; #o030 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1WriteHW (instn) ; #o031 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2WriteHW (instn) ; #o032 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3WriteHW (instn) ; #o033 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LocateLocalsHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LocateLocalsHW (instn) ; #o050 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CatchCloseHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CatchCloseHW (instn) ; #o051 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for GenericDispatchHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation GenericDispatchHW (instn) ; #o052 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MessageDispatchHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MessageDispatchHW (instn) ; #o053 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CheckPreemptRequestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CheckPreemptRequestHW (instn) ; #o054 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushGlobalLogicVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushGlobalLogicVariableHW (instn) ; #o055 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for NoOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation NoOpHW (instn) ; #o056 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for HaltHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation HaltHW (instn) ; #o057 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushNNilsHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushNNilsHW (instn) ; #o0101 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushAddressSpRelativeHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressSpRelativeHW (instn) ; #o0102 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushLocalLogicVariablesHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushLocalLogicVariablesHW (instn) ; #o0103 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReturnMultipleHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReturnMultipleHW (instn) ; #o0104 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReturnKludgeHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReturnKludgeHW (instn) ; #o0105 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TakeValuesHW instruction ????? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TakeValuesHW (instn) ; #o0106 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnbindNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnbindNHW (instn) ; #o0107 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushInstanceVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushInstanceVariableHW (instn) ; #o0110 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushAddressInstanceVariableHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressInstanceVariableHW (instn) ; #o0111 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushInstanceVariableOrderedHW (instn) ; #o0112 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;Translation support for PushAddressInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressInstanceVariableOrderedHW (instn) ; #o0113 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnaryMinusHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnaryMinusHW (instn) ; #o0114 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReturnSingleHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReturnSingleHW (instn) ; #o0115 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MemoryReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MemoryReadHW (instn) ; #o0116 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadHW (instn) ; #o0120 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadHW (instn) ; #o0121 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadHW (instn) ; #o0122 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadHW (instn) ; #o0123 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadShiftHW (instn) ; #o0124 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadShiftHW (instn) ; #o0125 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadShiftHW (instn) ; #o0126 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadShiftHW (instn) ; #o0127 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadTestHW (instn) ; #o0130 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadTestHW (instn) ; #o0131 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadTestHW (instn) ; #o0132 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadTestHW (instn) ; #o0133 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FinishCallNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FinishCallNHW (instn) ; #o0134 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FinishCallTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FinishCallTosHW (instn) ; #o0136 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FinishCallTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FinishCallTosHW (instn) ; #o0137 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for IncrementHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation IncrementHW (instn) ; #o0143 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DecrementHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DecrementHW (instn) ; #o0144 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PointerIncrementHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PointerIncrementHW (instn) ; #o0145 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetCdrCode1HW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetCdrCode1HW (instn) ; #o0146 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetCdrCode2HW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetCdrCode2HW (instn) ; #o0147 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReadInternalRegisterHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReadInternalRegisterHW (instn) ; #o0154 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for WriteInternalRegisterHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation WriteInternalRegisterHW (instn) ; #o0155 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CoprocessorReadHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CoprocessorReadHW (instn) ; #o0156 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CoprocessorWriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CoprocessorWriteHW (instn) ; #o0157 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadAluHW (instn) ; #o0160 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadAluHW (instn) ; #o0161 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadAluHW (instn) ; #o0162 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadAluHW (instn) ; #o0163 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LdbHW (instn) ; #o0170 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CharLdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CharLdbHW (instn) ; #o0171 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PLdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PLdbHW (instn) ; #o0172 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PTagLdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PTagLdbHW (instn) ; #o0173 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EntryRestAcceptedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EntryRestAcceptedHW (instn) ; #o0176 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EntryRestNotAcceptedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EntryRestNotAcceptedHW (instn) ; #o0177 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RplacaHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RplacaHW (instn) ; #o0200 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RplacdHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RplacdHW (instn) ; #o0201 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MultiplyHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MultiplyHW (instn) ; #o0202 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for QuotientHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation QuotientHW (instn) ; #o0203 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CeilingHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CeilingHW (instn) ; #o0204 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FloorHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FloorHW (instn) ; #o0205 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TruncateHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TruncateHW (instn) ; #o0206 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RoundHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RoundHW (instn) ; #o0207 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RationalQuotientHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RationalQuotientHW (instn) ; #o0211 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MinHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MinHW (instn) ; #o0212 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MaxHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MaxHW (instn) ; #o0213 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AluHW (instn) ; #o0214 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogandHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogandHW (instn) ; #o0215 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogxorHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogxorHW (instn) ; #o0216 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogiorHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogiorHW (instn) ; #o0217 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RotHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RotHW (instn) ; #o0220 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LshHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LshHW (instn) ; #o0221 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MultiplyDoubleHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MultiplyDoubleHW (instn) ; #o0222 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LshcBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LshcBignumStepHW (instn) ; #o0223 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StackBltHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StackBltHW (instn) ; #o0224 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RgetfHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RgetfHW (instn) ; #o0225 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MemberHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MemberHW (instn) ; #o0226 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AssocHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AssocHW (instn) ; #o0227 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AshHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AshHW (instn) ; #o0232 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StoreConditionalHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StoreConditionalHW (instn) ; #o0233 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MemoryWriteHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MemoryWriteHW (instn) ; #o0234 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PStoreContentsHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PStoreContentsHW (instn) ; #o0235 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BindLocativeToValueHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BindLocativeToValueHW (instn) ; #o0236 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnifyHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnifyHW (instn) ; #o0237 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopLexicalVarNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopLexicalVarNHW (instn) ; #o0240 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemLexicalVarNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemLexicalVarNHW (instn) ; #o0250 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqualNumberHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqualNumberHW (instn) ; #o0260 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LesspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LesspHW (instn) ; #o0261 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for GreaterpHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation GreaterpHW (instn) ; #o0262 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqlHW instruction $$?? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqlHW (instn) ; #o0263 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqualNumberHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqualNumberHW (instn) ; #o0264 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LesspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LesspHW (instn) ; #o0265 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for GreaterpHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation GreaterpHW (instn) ; #o0266 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogtestHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogtestHW (instn) ; #o0273 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogtestHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogtestHW (instn) ; #o0277 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SubHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SubHW (instn) ; #o0301 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for 32BitPlusHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation 32BitPlusHW (instn) ; #o0302 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for 32BitDifferenceHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation 32BitDifferenceHW (instn) ; #o0303 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AddBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AddBignumStepHW (instn) ; #o0304 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SubBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SubBignumStepHW (instn) ; #o0305 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MultiplyBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MultiplyBignumStepHW (instn) ; #o0306 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DivideBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DivideBignumStepHW (instn) ; #o0307 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Aset1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Aset1HW (instn) ; #o0310 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AllocateListBlockHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AllocateListBlockHW (instn) ; #o0311 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Aref1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Aref1HW (instn) ; #o0312 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Aloc1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Aloc1HW (instn) ; #o0313 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StoreArrayLeaderHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StoreArrayLeaderHW (instn) ; #o0314 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AllocateStructureBlockHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AllocateStructureBlockHW (instn) ; #o0315 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ArrayLeaderHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ArrayLeaderHW (instn) ; #o0316 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AlocLeaderHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AlocLeaderHW (instn) ; #o0317 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopInstanceVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopInstanceVariableHW (instn) ; #o0320 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemInstanceVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemInstanceVariableHW (instn) ; #o0321 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopInstanceVariableOrderedHW (instn) ; #o0322 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemInstanceVariableOrderedHW (instn) ; #o0323 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for InstanceRefHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation InstanceRefHW (instn) ; #o0324 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for InstanceSetHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation InstanceSetHW (instn) ; #o0325 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for InstanceLocHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation InstanceLocHW (instn) ; #o0326 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetTagHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetTagHW (instn) ; #o0327 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnsignedLesspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnsignedLesspHW (instn) ; #o0331 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MergeCdrNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MergeCdrNoPopHW (instn) ; #o0342 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FastAref1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FastAref1HW (instn) ; #o0350 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FastAset1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FastAset1HW (instn) ; #o0351 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StackBltAddressHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StackBltAddressHW (instn) ; #o0352 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DpbHW (instn) ; #o0370 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CharDpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CharDpbHW (instn) ; #o0371 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PDpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PDpbHW (instn) ; #o0372 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PTagDpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PTagDpbHW (instn) ; #o0373 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LoopIncrementTosLessThanHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LoopIncrementTosLessThanHW (instn) ; #o0375 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CatchOpenHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CatchOpenHW (instn) ; #o0376 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SpareOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SpareOpHW (instn) ;#o0377 + (do-default instn)) + + +;;; The fullword instructions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation pushconstantvalue (instn) + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for nullfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation nullfw (instn) ; #o00 = DTP-NULL + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for monitorforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation monitorforwardfw (instn) ; #o01 = DTP-MONITOR-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for headerpfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation headerpfw (instn) ; #o02 = DTP-HEADER-P + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for headerifw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation headerifw (instn) ; #o03 = DTP-HEADER-I + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for valuecell instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation valuecell (instn) ; #o04 = DTP-EXTERNAL-VALUE-CELL-POINTER + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for oneqforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation oneqforwardfw (instn) ; #o05 = DTP-ONE-Q-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for headerforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation headerforwardfw (instn) ; #o06 = DTP-HEADER-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for elementforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation elementforwardfw (instn) ; #o07 = DTP-ELEMENT-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for boundlocationfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation boundlocationfw (instn) ; #o42 = DTP-BOUND-LOCATION + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for logicvariablefw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation logicvariablefw (instn) ; #o44 = DTP-LOGIC-VARIABLE + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for gcforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation gcforwardfw (instn) ; #o45 = DTP-GC-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledeven instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledeven (instn) ; #o50 = DTP-CALL-COMPILED-EVEN + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledodd instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledodd (instn) ; #o51 = DTP-CALL-COMPILED-ODD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callindirect instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callindirect (instn) ; #o52 = DTP-CALL-INDIRECT + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callgeneric instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callgeneric (instn) ; #o53 = DTP-CALL-GENERIC + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledevenprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledevenprefetch (instn) ; #o54 = DTP-CALL-COMPILED-EVEN-PREFETCH + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledoddprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledoddprefetch (instn) ; #o55 = DTP-CALL-COMPILED-ODD-PREFETCH + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callindirectprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callindirectprefetch (instn) ; #o56 = DTP-CALL-INDIRECT-PREFETCH + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callgenericprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callgenericprefetch (instn) ; #o57 = DTP-CALL-GENERIC-PREFETCH + (do-default instn)) + + +;;; Branch instructions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueHW (instn) ; #o060 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueElseExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueElseExtraPopHW (instn) ; #o061 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndExtraPopHW (instn) ; #o062 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueExtraPopHW (instn) ; #o063 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueNoPopHW (instn) ; #o064 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndNoPopHW (instn) ; #o065 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueElseNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueElseNoPopHW (instn) ; #o066 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndNoPopElseNoPopExtraPopHW $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndNoPopElseNoPopExtraPopHW (instn) ; #o067 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseHW (instn) ; #o070 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseElseExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseElseExtraPopHW (instn) ; #o071 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndExtraPopHW (instn) ; #o072 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseExtraPopHW (instn) ; #o073 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseNoPopHW (instn) ; #o074 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndNoPopHW (instn) ; #o075 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseElseNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseElseNoPopHW (instn) ; #o076 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndNoPopElseNoPopExtraPopHW $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndNoPopElseNoPopExtraPopHW (instn) ; #o077 + (do-default instn)) + +;;; New Instructions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for fullword instructions. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation nativeinstruction (instn) ; #o37 = DTP-NATIVE-INSTRUCTION + (do-default instn)) + + +#|| +;;; test code. +(proclaim '(translated-function fib)) +(defun fib (n) + (declare (translated-function)) + (let ((m 1) (q 1)) + (dotimes (i (- n 2)) + (let ((nv (+ m q))) + (setq m q) + (setq q nv))) + q)) +||# + +(defun tfib (n) + (let ((m 1) (q 1)) + (dotimes (i (- n 2)) + (let ((nv (+ m q))) + (setq m q) + (setq q nv))) + q)) + +#|| Compiles into +Command: (disassemble 'fib) + 0 ENTRY: 1 REQUIRED, 0 OPTIONAL ;Creating N + 2 PUSH 1 ;Creating M + 3 PUSH 1 ;Creating Q + 4 PUSH FP|2 ;N + 5 SUB 2 + 6 PLUSP FP|5 + 7 BRANCH-FALSE-AND-EXTRA-POP 17 + 10 PUSH FP|3 ;M + 11 ADD FP|4 ;Q Creating NV + 12 PUSH FP|4 ;Q + 13 POP FP|3 ;M + 14 POP FP|4 ;Q + 15 LOOP-DECREMENT-TOS 10 + 16 SET-SP-TO-ADDRESS SP|-1 + 17 RETURN-SINGLE-STACK +||# + +;;; Fin. diff --git a/translator/xtranrule.lisp b/translator/xtranrule.lisp new file mode 100644 index 0000000..cf08eaa --- /dev/null +++ b/translator/xtranrule.lisp @@ -0,0 +1,470 @@ +;;; -*- Package: ALPHA-AXP-INTERNALS; Syntax: Common-Lisp; Mode: LISP; Base: 10; Lowercase: Yes -*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetSpToAddressHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;(def-halfword-translation SetSpToAddressHW (instn) +; (do-default instn)) + + +(def-halfword-translation SetSpToAddressHW (instn); #o0151 + (compute-operand-address instn 'iSP) + (TOSvalid :invalid)) ;restore TOS + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetSpToAddressSaveTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;(def-halfword-translation SetSpToAddressSaveTosHW (instn) +; (do-default instn)) + +(def-halfword-translation SetSpToAddressSaveTosHW (instn) ; #o0152 + (cacheTOS) ; get TOS cached. + (compute-operand-address instn 'iSP) + (storeTOS)) ; store TOS + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation PushHW (instn relto offset popp) ; #o0100 + (declare (ignore popp)) + (compute-operand-value2 instn 'arg5 'arg6 :signed t) + (if (eq relto :immediate) + (emit '(stack-push2-with-cdr arg5 arg6)) + (emit `(stack-push2 arg5 arg6 arg5))) + (TOSvalid :arg5arg6)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopHW (instn) ; #o0340 + (cacheTOS) ; get TOS cached. + (emit '(SUBQ iSP 8 iSP "Pop Stack.")) + (with-temporary-registers (temp) + (compute-operand-address instn temp) + (writeTOS temp)) + (TOSvalid :invalid) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemHW (instn) ; #o0341 + (cacheTOS) ; get TOS cached. + (multiple-value-bind (vma offset) + (compute-operand-register-offset instn nil) + (writeTOS vma offset))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushAddressHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressHW (instn) ; #o0150 + (with-temporary-registers (sca temp) + (compute-operand-address instn sca) + (emit `((xlatSCAtoVMA ,sca arg6 ,temp) + (BIS zero ,|type|$k-|locative| arg5) + (stack-push2-with-cdr arg5 arg6))) + (TOSvalid :arg5arg6))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for pushconstantvalue instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Note that this cannot be used for "pointer" constants, which aren't +;; really constant. This should really be called pushimmediateconstant. +;; We could have a pushconstantvalue if the "real" constant were stuck +;; in the function epilogue and we could do a load offset against the +;; PC. +(def-fullword-translation pushimmediateconstant (instn) + (clos:with-slots (opcode constant) instn + (emit `((BIS zero ,(logand opcode #x3F) arg5) + (load-constant arg6 ,constant) + (stack-push2-with-cdr arg5 arg6))) + (TOSvalid :arg5arg6))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TypeMemberHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TypeMemberHW (instn) ; #o040 + (clos:with-slots (opcode operand) instn + (let ((fieldno (logior (ash (logand opcode #x3) 2) (ldb (byte 2 8) operand))) + (mask (ldb (byte 8 0) operand)) + (nopop (ldb (byte 1 2) opcode))) + (with-temporary-registers (o1tag tbit tval fmask) + (getTOStag o1tag) + (emit `((LDQ ,tval ,processorstate$q-taddress (ivory)) + (BIS zero 1 ,tbit) + (LDQ arg6 ,processorstate$q-niladdress (ivory)) + (TagType ,o1tag ,o1tag) ;no CDR code. + (SLL ,tbit ,o1tag ,tbit))) + (if (< fieldno 8) ; fields 0-7 in low 32 bit word + (emit `(load-constant ,fmask ,(ash mask (* 4 fieldno)))) + (emit `((BIS zero ,mask ,fmask) + (SLL ,fmask ,(* 4 fieldno) ,fmask)))) + (if (not (zerop nopop)) (emit `(ADDQ iSP 8 iSP))) + (emit `((AND ,fmask ,tbit ,tbit) + (CMOVNE ,tbit ,tval arg6) + (STQ arg6 0 (iSP)))) + (TOSvalid :arg6))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PointerPlusHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PointerPlusHW (instn) ; #o0230 + (cacheTOS) ; get TOS cached. + (with-temporary-registers (temp) + (compute-operand-data instn temp) + (emit `((ADDL arg6 ,temp arg6) + (stack-write-data iSP arg6))) + (if (eq (TOSstatus) :arg6) (TOSvalid :invalid)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PointerDifferenceHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PointerDifferenceHW (instn) ; #o0231 + (cacheTOS) ; get TOS cached. + (with-temporary-registers (temp) + (compute-operand-data instn temp) + (emit `((SUBL arg6 ,temp arg6) + (stack-write-data iSP arg6))) + (if (eq (TOSstatus) :arg6) (TOSvalid :invalid)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ZeropHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation ZeropHW (instn relto offset popp) ; #o034 + (declare (ignore popp)) + (cond + ((eq relto :immediate) + (if (zerop offset) + (emit `(LDQ arg6 ,processorstate$q-taddress (ivory))) + (emit `(LDQ arg6 ,processorstate$q-niladdress (ivory)))) + (emit `((stack-push-with-cdr arg6))) + (TOSvalid :arg6)) + + (:otherwise + (do-default instn)))) + +;;; General form of an arithemetic translation + +(defmacro simple-binary-arithmetic-translation (instn relto offset op) + `(with-temporary-registers (tempt1 tempd1 tempt2) + (multiple-value-bind (esclab returnlab) (make-escape ,instn) + (unless (eq ,relto :immediate) + (compute-operand-value2 ,instn tempt1 tempd1 :signed t)) + (emit + `((stack-read2-signed iSP arg5 arg6 :tos-valid ,(TOSstatus)) + ,@(unless (eq ,relto :immediate) + `((tagtype ,tempt1 ,tempt1))) + (tagtype arg5 arg5) + ,@(unless (eq ,relto :immediate) + `((SUBQ ,tempt1 ,|type$K-fixnum| ,tempt1))) + (SUBQ arg5 ,|type$K-fixnum| ,tempt2) + ,@(unless (eq ,relto :immediate) + `((BNE ,tempt1 ,esclab))) + (BNE ,tempt2 ,esclab) + ,@(if (eq ,relto :immediate) + `((,',op arg6 ,(dpb ,offset (byte 8 0) (- (logand #x80 ,offset))) arg6 + "compute 64-bit result")) + `((,',op arg6 ,tempd1 arg6 "compute 64-bit result"))) + (ADDL arg6 0 ,tempd1 "compute 32-bit sign-extended result") + (CMPEQ arg6 ,tempd1 ,tempd1 "is it the same as the 64-bit result?") + (branch-false ,tempd1 ,esclab "if not, we overflowed") + (stack-write2 iSP arg5 arg6))) + (ivory-label returnlab) + (TOSvalid :invalid)))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AddHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation AddHW (instn relto offset popp) ; #o0300 + (declare (ignore popp)) + (simple-binary-arithmetic-translation instn relto offset ADDQ)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SubHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation SubHW (instn relto offset popp) ; #o0300 + (declare (ignore popp)) + (simple-binary-arithmetic-translation instn relto offset SUBQ)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MulHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-decoded-halfword-translation MulHW (instn relto offset popp) ; #o0300 + (declare (ignore popp)) + (simple-binary-arithmetic-translation instn relto offset MULQ)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LoopDecrementTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LoopDecrementTosHW (instn) ; #o0175 + (let ((ntreturnlab (gensym))) + (with-temporary-registers (tempt1 tempd1 tempt2 tempd2) + (clos:with-slots (target) instn + (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `((stack-read2-signed iSP arg5 arg6D,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") :tos-valid ,(TOSstatus)0) + (Tagtype arg5 arg5) + (SUBQ arg5 ,|type$K-fixnum| ,tempt1) + (BNE ,tempt1 ,esclab) + (SUBL arg6 1 ,tempd1) + (CMPLT ,tempd1 arg6 ,tempd2) + (branch-false ,tempd2 ,esclab) ; escape if overflow + (BLE ,tempd1 ,ntreturnlab) ; branch not taken. + ;; test please_stop + (LDQ ,tempd2 ,processorstate$l-please-stop (ivory)) + (BNE ,tempd2 ,esclab) + (stack-write2 iSP arg5 ,tempd1) + (BR zero ,target))) + (alpha-label ntreturnlab) + (emit `(stack-write2 iSP arg5 ,tempd1)) + (alpha-label returnlab) + (TOSvalid :invalid)))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CarHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CarHW (instn) ; #o00 + (with-1specific0-registers (1arg1 #+ignore 0arg2 t5 t6 t7 t81 0t9 t10 t11 t12) + (clos:with-slots (target) instn + (multiple-value-bind (vma offset1 popp0) + 1(0compute-operand-1register-offset 0instn1 'iSP) +0 (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `(1(ldq arg1 0,processorstate$1q0-carsubroutine1 (Ivory)) +0 1;; :tos-valid is useful for sp-pop case +0 (stack-read21-disp0 1,0vma1 ,0offset1 0arg5 arg6 "Get the operand" + :signed t1 :tos-valid ,(TOSStatus)0) + 1(JSR r0 arg1 0) +0 1(BR zero ,esclab) +0 (LDQ r0 1,0processorstate$q-resumeema1 0(ivory) "R0 is the link back to emulated mode.") + 1,@(if popp +0 1`((stack-write2 iSP arg5 arg6 :set-cdr-next arg5)) +0 1`(0(stack-push2 arg5 arg6 t5)1)) +0 )) + (alpha-label returnlab) + 1;; We happen to know the emulated instruction leaves TOS in 5/6 +0 1;; too! +0 (TOSvalid 1:arg5arg60)))1)0) + + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CdrHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CdrHW (instn) ; #o00 + (with-1specific0-registers (1arg1 #+ignore 0arg2 t5 t6 t7 t81 0t9 t10 t11 t12) + (clos:with-slots (target) instn + (multiple-value-bind (vma offset1 popp0) + 1(0compute-operand-1register-offset 0instn1 'iSP) +0 (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `(1(ldq arg1 0,processorstate$1q0-cdrsubroutine1 (Ivory)) +0 1;; :tos-valid is useful for sp-pop case +0 (stack-read21-disp0 1,0vma1 ,0offset1 0arg5 arg6 "Get the operand" + :signed t1 :tos-valid ,(TOSStatus)0) + 1(JSR r0 arg1 0) +0 1(BR zero ,esclab) +0 (LDQ r0 1,0processorstate$q-resumeema1 0(ivory) "R0 is the link back to emulated mode.") + 1,@(if popp +0 1`((stack-write2 iSP arg5 arg6 :set-cdr-next arg5)) +0 1`(0(stack-push2 arg5 arg6 t5)1)) +0 )) + (alpha-label returnlab) + 1;; We happen to know the emulated instruction leaves TOS in 5/6 +0 1;; too! +0 (TOSvalid 1:arg5arg60)))1)0) + + ) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SettoCdrHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SettoCdrHW (instn) ; #o00 + (with-1specific0-registers (1arg1 #+ignore 0arg2 t5 t6 t7 t81 0t9 t10 t11 t12) + 1(with-temporary-registers (temp) +0 (clos:with-slots (target) instn + (multiple-value-bind (vma offset1 popp0) + 1(0compute-operand-1register-offset 0instn1 'iSP) +0 (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `(1(ldq arg1 0,processorstate$1q0-SettoCdrsubroutine1 (Ivory)) +0 1;; :tos-valid is useful for sp-pop case +0 (stack-read21-disp0 1,0vma1 ,0offset1 0arg5 arg6 "Get the operand" + :signed t1 :tos-valid ,(TOSStatus)0) + (and arg5 192 1,temp 0"Save the old CDR code") + 1(JSR r0 arg1 0) +0 1(BR zero ,esclab) +0 (LDQ r0 1,0processorstate$q-resumeema1 0(ivory) "R0 is the link back to emulated mode.") + (TagType arg5 arg5) + (BIS arg5 1,temp0 arg5 "Put back the original CDR codes") + (stack-write21-disp ,vma ,offset0 arg5 arg6) + )) + (alpha-label returnlab) + 1;; We happen to know the emulated instruction leaves TOS in 5/6 +0 1;; too! +0 (TOSvalid 1(if (lisp:and (eq vma 'iSP) (eq offset 0)) :arg5arg6 :invalid)0)))1))0) + + ) + + +1 +0;;; Branch instructions + +(defmacro trbranchcond (invertp popp elsepopp extrapopp) + `(with-temporary-registers (tempt1 1tempt2 0tempd2) +1 0 (let ((ntlab (gensym))1)0 1; target if branch not taken +0 (clos:with-slots (target) instn + (multiple-value-bind (esclab returnlab) (make-escape instn) + (emit `((LDQ ,tempd2 ,processorstate$l-please-stop (ivory)) +1 (stack-read-tag iSP arg5 :tos-valid ,(TOSStatus)) +0 (1TagType0 arg150 1,tempt2 0"Check tag of word in TOS.") + 1(CMPEQ ,tempt2 ,|type$K-NIL| ,tempt1) +0 1(,,(if invertp ''branch-false ''branch-true) ,tempt1 ,ntlab) +0 1;; Here to take the branch. +0 1;; Test please stop +0 (BNE ,tempd2 ,esclab) +1 )) +0 1,@(if (not (zerop 0(+ (if popp 1 0) (if extrapopp 1 0))1)) +0 1`((emit `((SUBQ iSP ,,(* 8 0(+ (if popp 1 0) (if extrapopp 1 0))1) iSP))))) +0 1(emit `((BR zero ,target))) +0 1;; Here when branch not taken +0 1(alpha-label ntlab) +0 1,@(if (not (zerop 0(+ (if elsepopp 1 0) (if extrapopp 1 0))1)) +0 1`((emit `((SUBQ iSP ,,(* 8 0(+ (if elsepopp 1 0) (if extrapopp 1 0))1) iSP))))) +0 1(ivory-label returnlab) +0 1(TOSvalid :invalid)))))) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueNoPopHW (instn) ; #o064 + (1trbranchcond nil nil nil nil)) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndNoPopElseNoPopExtraPopHW +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndNoPopElseNoPopExtraPopHW (instn) ; #o067 + 1(trbranchcond nil nil nil t)) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +1(def0-halfword-translation BranchTrueAndNoPopHW (instn) ; #o065 + 1(trbranchcond nil nil t nil)0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueElseExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueElseExtraPopHW (instn) ; #o061 + 1(trbranchcond nil nil t t)0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueElseNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueElseNoPopHW (instn) ; #o066 + 1(trbranchcond nil t nil nil)) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueAndExtraPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueAndExtraPopHW (instn) ; #o062 + 1(trbranchcond nil t nil t)) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueHW (instn) ; #o060 + 1(trbranchcond nil t t nil0)1) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchTrueExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchTrueExtraPopHW (instn) ; #o063 + 1(trbranchcond nil t t t)0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseNoPopHW (instn) ; #o074 + 1(trbranchcond t nil nil nil)0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndNoPopElseNoPopExtraPopHW +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndNoPopElseNoPopExtraPopHW (instn) ; #o077 + 1(trbranchcond t nil nil t)) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndNoPopHW (instn) ; #o075 + 1(trbranchcond t nil t nil)0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseElseExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseElseExtraPopHW (instn) ; #o071 + 1(trbranchcond t nil t t)) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseElseNoPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseElseNoPopHW (instn) ; #o076 + 1(trbranchcond t t nil nil)0) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseAndExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseAndExtraPopHW (instn) ; #o072 + 1(trbranchcond t t nil t)) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseHW (instn) ; #o070 + 1(trbranchcond t t t nil0)1) + +0;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchFalseExtraPopHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchFalseExtraPopHW (instn) ; #o073 + 1(trbranchcond t t t t)) + +0;;; Fin + + + diff --git a/translator/xtranslat.lisp b/translator/xtranslat.lisp new file mode 100644 index 0000000..c001e7c --- /dev/null +++ b/translator/xtranslat.lisp @@ -0,0 +1,3009 @@ +;;; -*- Package: ALPHA-AXP-INTERNALS; Syntax: Common-Lisp; Mode: LISP; Base: 10; Lowercase: Yes -*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Part 1 - the beginning ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +#| +The translator analyser takes a function object and internalizes it into instruction objects. +Each object is chained in PC sequence and references to the function code from within itself +are resolved into pointers to instruction objects in the sequence. The internalized form +is the input to the code generator portion. +|# + +(clos:defclass translation-state () + ((source :initarg :source) + (target :initarg :target) + (newfun :initarg :newfun) + (nativemodep :initform nil) ;initially in emulated mode. + (pendinglabel :initform nil) + (toscache :initform :arg6) ;(one of :invalid :arg6 :arg5arg6) + (freeregs :initarg :freeregs :initform (list 't3 't4 't5 't6 + 't7 't8 't9 't10 't11 't12 + 'arg1 'arg3 'arg4)) + )) + +(clos:defclass decoded-function () + ((instructions :initform ()) + (escapeblocks :initform ()) + (icount :initform 0) + (debug-info :initform ()) + (packed-instructions :initform ()) + (packed-size :initform ()))) + +(clos:defclass ivory-instruction () + ((pc :initarg :pc :accessor ivory-instruction-pc :initform -1) + (order :initarg :order :accessor ivory-instruction-orderD,#TD1PsT[Begin using 006 escapes](1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB") :initform -10) + (sequence :initform 0 :initarg :sequence) ;normal + (nextpc :initarg :nextpc :initform -1) + (opcode :initarg :opcode) + (label :initarg :label :initform ()) + (nextinstn :initarg :nextinstn :initform nil))) + +(clos:defclass fullword-instruction (ivory-instruction) + ((constant :initarg :constant))) + +(clos:defclass alpha-native-instruction (fullword-instruction) + ()) + +(clos:defclass alpha-native-branch-instruction (alpha-native-instruction) + ((target :initarg :target :initform nil))) + +(clos:defclass halfword-instruction (ivory-instruction) + ((operand :initform 0 :initarg :operand))) + +(clos:defclass ibranch-format-instruction (halfword-instruction) + ((target :initarg :target :initform nil))) + + +(defun branch-format-hw-opcodep (code) + (svref *branch-format-opcodes* code)) + +(clos:defmethod instruction-labeledp ((decinst ivory-instruction)) + (clos:with-slots (label) decinst + label)) + +(clos:defmethod label-instruction ((decinst ivory-instruction)) + (clos:with-slots (label) decinst + (if label + 1(first 0label1) +0 (1push 0(gensym) label)))) + +(clos:defmethod instruction-kind ((decinst fullword-instruction)) :fullword) + +(clos:defmethod instruction-kind ((decinst halfword-instruction)) :halfword) + +(clos:defmethod entry-instructionp ((decinst fullword-instruction)) ()) + +(clos:defmethod entry-instructionp ((decinst halfword-instruction)) + (clos:with-slots (opcode) decinst + (or (= opcode #o176) (= opcode #o177)))) + +(clos:defmethod native-instructionp ((decinst fullword-instruction)) + (clos:with-slots (opcode) decinst + (= opcode *native-instruction-opcode*))) + +(clos:defmethod native-instructionp ((decinst halfword-instruction)) + ()) + +(defvar *Major-opcodes* + #( + "PAL*" "????" "????" "????" "????" "????" "????" "????" + "LDA" "LDAH" "????" "LDQU" "????" "????" "????" "STQU" + "INTA" "INTL" "INTS" "INTM" "????" "FLTV" "FLTI" "FLTL" + "MISC" "\PAL" "JSR*" "\PAL" "????" "\PAL" "\PAL" "\PAL" + "LDF" "LDG" "LDS" "LDT" "STF" "STG" "STS" "STT" + "LDL" "LDQ" "LDLL" "LDQL" "STL" "STQ" "STLC" "STQC" + "BR" "FBEQ" "FBLT" "FBLE" "BSR" "FBNE" "FBGE" "FBGT" + "BLBC" "BEQ" "BLT" "BLE" "BLBS" "BNE" "BGE" "BGT" + )) + +(defvar *Opcode-Format* + #( + pal res res res res res res res + mem mem res mem res res res mem + op op op op res op op op + mem non mem non res non non non + mem mem mem mem mem mem mem mem + mem mem mem mem mem mem mem mem + br br br br br br br br + br br br br br br br br + )) + +(defvar *register-names* + #( r0 t1 t2 t3 t4 t5 t6 t7 + t8 iPC iFP iLP iSP iCP ivory r15 + arg1 arg2 arg3 arg4 arg5 arg6 t9 t10 + t11 t12 ra pv r28 gp sp zero)) + +(defvar *op10-fcns* + '((0 . ADDL) (#x9 . SUBL) (#x2d . CMPEQ) (#x40 . ADDL/V) (#x49 . SUBL/V) + (#x4D . CMPLT) (#x20 . ADDQ) (#x29 . SUBQ) (#x6D . CMPLE) (#x60 . ADDQ/V) + (#x69 . SUBQ/V) (#x1D . CMPULT) (#x3D . CMPULE) (#xF . CMPBGE) (2 . S4ADDL) + (#xB . S4SUBL) (#x12 . S8ADDL) (#x1B . S8SUBL) (#x22 . S4ADDQ) (#x2B . S4SUBQ) + (#x32 . S8ADDQ) (#x2B . S4SUBQ) (#x32 . S8ADDQ) (#x3B . S8SUBQ))) + +(defvar *op11-fcns* + '((#x0 . AND) (#x20 . BIS) (#x40 . XOR) (#x8 . BIC) (#x28 . ORNOT) (#x48 . EQV) + (#x24 . CMOVEQ) (#x44 . CMOVLT) (#x64 . CMOVLE) (#x26 . CMOVBE) + (#x46 . CMOVGE) (#x66 . CMOVGT) (#x14 . CMOVLBS) (#x16 . CMOVLBC))) + +(defvar *op12-fcns* + '((#x39 . SLL) (#x3C . SRA) (#x34 . SRL) (#x6 . EXTBL) (#xB . INSBL) (#x2 . MSKBL) + (#x16 . EXTWL) (#x1B . INSWL) (#x12 . MSKWL) (#x26 . EXTLL) (#x2b . INSLL) (#x22 . MSKLL) + (#x36 . EXTQL) (#x3b . INSQL) (#x32 . MSKQL) (#x5a . EXTWH) (#x57 . INSWH) (#x52 . MSKWH) + (#x6a . EXTLH) (#x67 . INSLH) (#x62 . MSKLH) (#x7a . EXTQH) (#x77 . INSQH) (#x72 . MSKQH) + (#x30 . ZAP) (#x31 . ZAPNOT))) + +(defvar *op13-fcns* + '((#x0 . MULL) (#x40 . MULL?V) (#x20 . MULQ) (#x60 . MULQ/V) (#x30 . UMULH))) + +(defun regname(n) (svref *register-names* n)) + +(defun fcnname (opcode fcncode) + (or + (cond ((= opcode #x10) (cdr (assoc fcncode *op10-fcns*))) + ((= opcode #x11) (cdr (assoc fcncode *op11-fcns*))) + ((= opcode #x12) (cdr (assoc fcncode *op12-fcns*))) + ((= opcode #x13) (cdr (assoc fcncode *op13-fcns*)))) + (future-common-lisp::format nil "#x~x" fcncode))) + + +;;; This vector is the master translation dispatch vector. It served the double purpose +;;; of supporting the instruction printer. + +(defvar *halfwordinstns* #( ; [256] + CarHW ; #o00 + CdrHW ; #o01 + EndpHW ; #o02 + Setup1DArrayHW ; #o03 + SetupForce1DArrayHW ; #o04 + BindLocativeHW ; #o05 + RestoreBindingStackHW ; #o06 + EphemeralpHW ; #o07 + StartCallHW ; #o010 + JumpHW ; #o011 + TagHW ; #o012 + DereferenceHW ; #o013 + LogicTailTestHW ; #o014 + SpareOpHW ; #o015 +++ Used for breakpoints!!! + DoubleFloatOpHW ; #o016 + SpareOpHW ; #o017 + PushLexicalVarNHW ; #o020 + PushLexicalVarNHW ; #o021 + PushLexicalVarNHW ; #o022 + PushLexicalVarNHW ; #o023 + PushLexicalVarNHW ; #o024 + PushLexicalVarNHW ; #o025 + PushLexicalVarNHW ; #o026 + PushLexicalVarNHW ; #o027 + Block0WriteHW ; #o030 + Block1WriteHW ; #o031 + Block2WriteHW ; #o032 + Block3WriteHW ; #o033 + ZeropHW ; #o034 + MinuspHW ; #o035 + PluspHW ; #o036 + SpareOpHW ;#o037 + TypeMemberHW ; #o040 + TypeMemberHW ; #o041 + TypeMemberHW ; #o042 + TypeMemberHW ; #o043 + TypeMemberHW ; #o044 + TypeMemberHW ; #o045 + TypeMemberHW ; #o046 + TypeMemberHW ; #o047 + LocateLocalsHW ; #o050 + CatchCloseHW ; #o051 + GenericDispatchHW ; #o052 + MessageDispatchHW ; #o053 + CheckPreemptRequestHW ; #o054 + PushGlobalLogicVariableHW ; #o055 + NoOpHW ; #o056 + HaltHW ; #o057 + BranchTrueHW ; #o060 + BranchTrueElseExtraPopHW ; #o061 + BranchTrueAndExtraPopHW ; #o062 + BranchTrueExtraPopHW ; #o063 + BranchTrueNoPopHW ; #o064 + BranchTrueAndNoPopHW ; #o065 + BranchTrueElseNoPopHW ; #o066 + BranchTrueAndNoPopElseNoPopExtraPopHW ; #o067 + BranchFalseHW ; #o070 + BranchFalseElseExtraPopHW ; #o071 + BranchFalseAndExtraPopHW ; #o072 + BranchFalseExtraPopHW ; #o073 + BranchFalseNoPopHW ; #o074 + BranchFalseAndNoPopHW ; #o075 + BranchFalseElseNoPopHW ; #o076 + BranchFalseAndNoPopElseNoPopExtraPopHW ; #o077 + PushHW ; #o0100 + PushNNilsHW ; #o0101 + PushAddressSpRelativeHW ; #o0102 + PushLocalLogicVariablesHW ; #o0103 + ReturnMultipleHW ; #o0104 + ReturnKludgeHW ; #o0105 + TakeValuesHW ; #o0106 + UnbindNHW ; #o0107 + PushInstanceVariableHW ; #o0110 + PushAddressInstanceVariableHW ; #o0111 + PushInstanceVariableOrderedHW ; #o0112 + PushAddressInstanceVariableOrderedHW ; #o0113 + UnaryMinusHW ; #o0114 + ReturnSingleHW ; #o0115 + MemoryReadHW ; #o0116 + MemoryReadHW ; #o0117 + Block0ReadHW ; #o0120 + Block1ReadHW ; #o0121 + Block2ReadHW ; #o0122 + Block3ReadHW ; #o0123 + Block0ReadShiftHW ; #o0124 + Block1ReadShiftHW ; #o0125 + Block2ReadShiftHW ; #o0126 + Block3ReadShiftHW ; #o0127 + Block0ReadTestHW ; #o0130 + Block1ReadTestHW ; #o0131 + Block2ReadTestHW ; #o0132 + Block3ReadTestHW ; #o0133 + FinishCallNHW ; #o0134 + FinishCallNHW ; #o0135 + FinishCallTosHW ; #o0136 + FinishCallTosHW ; #o0137 + SetToCarHW ; #o0140 + SetToCdrHW ; #o0141 + SetToCdrPushCarHW ; #o0142 + IncrementHW ; #o0143 + DecrementHW ; #o0144 + PointerIncrementHW ; #o0145 + SetCdrCode1HW ; #o0146 + SetCdrCode2HW ; #o0147 + PushAddressHW ; #o0150 + SetSpToAddressHW ; #o0151 + SetSpToAddressSaveTosHW ; #o0152 + SpareOpHW ;#o0153 + ReadInternalRegisterHW ; #o0154 + WriteInternalRegisterHW ; #o0155 + CoprocessorReadHW ; #o0156 + CoprocessorWriteHW ; #o0157 + Block0ReadAluHW ; #o0160 + Block1ReadAluHW ; #o0161 + Block2ReadAluHW ; #o0162 + Block3ReadAluHW ; #o0163 + SpareOpHW ;#o0164 + SpareOpHW ;#o0165 + SpareOpHW ;#o0166 + SpareOpHW ;#o0167 + LdbHW ; #o0170 + CharLdbHW ; #o0171 + PLdbHW ; #o0172 + PTagLdbHW ; #o0173 + BranchHW ; #o0174 + LoopDecrementTosHW ; #o0175 + EntryRestAcceptedHW ; #o0176 + EntryRestNotAcceptedHW ; #o0177 + RplacaHW ; #o0200 + RplacdHW ; #o0201 + MultiplyHW ; #o0202 + QuotientHW ; #o0203 + CeilingHW ; #o0204 + FloorHW ; #o0205 + TruncateHW ; #o0206 + RoundHW ; #o0207 + SpareOpHW ; #o0210 +++ Use for DoRemainder + RationalQuotientHW ; #o0211 + MinHW ; #o0212 + MaxHW ; #o0213 + AluHW ; #o0214 + LogandHW ; #o0215 + LogxorHW ; #o0216 + LogiorHW ; #o0217 + RotHW ; #o0220 + LshHW ; #o0221 + MultiplyDoubleHW ; #o0222 + LshcBignumStepHW ; #o0223 + StackBltHW ; #o0224 + RgetfHW ; #o0225 + MemberHW ; #o0226 + AssocHW ; #o0227 + PointerPlusHW ; #o0230 + PointerDifferenceHW ; #o0231 + AshHW ; #o0232 + StoreConditionalHW ; #o0233 + MemoryWriteHW ; #o0234 + PStoreContentsHW ; #o0235 + BindLocativeToValueHW ; #o0236 + UnifyHW ; #o0237 + PopLexicalVarNHW ; #o0240 + PopLexicalVarNHW ; #o0241 + PopLexicalVarNHW ; #o0242 + PopLexicalVarNHW ; #o0243 + PopLexicalVarNHW ; #o0244 + PopLexicalVarNHW ; #o0245 + PopLexicalVarNHW ; #o0246 + PopLexicalVarNHW ; #o0247 + MovemLexicalVarNHW ; #o0250 + MovemLexicalVarNHW ; #o0251 + MovemLexicalVarNHW ; #o0252 + MovemLexicalVarNHW ; #o0253 + MovemLexicalVarNHW ; #o0254 + MovemLexicalVarNHW ; #o0255 + MovemLexicalVarNHW ; #o0256 + MovemLexicalVarNHW ; #o0257 + EqualNumberHW ; #o0260 + LesspHW ; #o0261 + GreaterpHW ; #o0262 + EqlHW ; #o0263 + EqualNumberHW ; #o0264 + LesspHW ; #o0265 + GreaterpHW ; #o0266 + EqlHW ; #o0267 + EqHW ; #o0270 + SpareOpHW ; #o0271 + SpareOpHW ; #o0272 + LogtestHW ; #o0273 + EqHW ; #o0274 + SpareOpHW ; #o0275 + SpareOpHW ; #o0276 + LogtestHW ; #o0277 + AddHW ; #o0300 + SubHW ; #o0301 + 32BitPlusHW ; #o0302 + 32BitDifferenceHW ; #o0303 + AddBignumStepHW ; #o0304 + SubBignumStepHW ; #o0305 + MultiplyBignumStepHW ; #o0306 + DivideBignumStepHW ; #o0307 + Aset1HW ; #o0310 + AllocateListBlockHW ; #o0311 + Aref1HW ; #o0312 + Aloc1HW ; #o0313 + StoreArrayLeaderHW ; #o0314 + AllocateStructureBlockHW ; #o0315 + ArrayLeaderHW ; #o0316 + AlocLeaderHW ; #o0317 + PopInstanceVariableHW ; #o0320 + MovemInstanceVariableHW ; #o0321 + PopInstanceVariableOrderedHW ; #o0322 + MovemInstanceVariableOrderedHW ; #o0323 + InstanceRefHW ; #o0324 + InstanceSetHW ; #o0325 + InstanceLocHW ; #o0326 + SetTagHW ; #o0327 + SpareOpHW ;#o0330 + UnsignedLesspHW ; #o0331 + SpareOpHW ;#o0332 + SpareOpHW ;#o0333 + SpareOpHW ;#o0334 + UnsignedLesspHW ; #o0335 + SpareOpHW ;#o0336 + SpareOpHW ;#o0337 + PopHW ; #o0340 + MovemHW ; #o0341 + MergeCdrNoPopHW ; #o0342 + SpareOpHW ;#o0343 + SpareOpHW ;#o0344 + SpareOpHW ;#o0345 + SpareOpHW ;#o0346 + SpareOpHW ;#o0347 + FastAref1HW ; #o0350 + FastAset1HW ; #o0351 + StackBltAddressHW ; #o0352 + SpareOpHW ;#o0353 + SpareOpHW ;#o0354 + SpareOpHW ;#o0355 + SpareOpHW ;#o0356 + SpareOpHW ;#o0357 + SpareOpHW ;#o0360 + SpareOpHW ;#o0361 + SpareOpHW ;#o0362 + SpareOpHW ;#o0363 + SpareOpHW ;#o0364 + SpareOpHW ;#o0365 + SpareOpHW ;#o0366 + SpareOpHW ;#o0367 + DpbHW ; #o0370 + CharDpbHW ; #o0371 + PDpbHW ; #o0372 + PTagDpbHW ; #o0373 + SpareOpHW ;#o0374 + LoopIncrementTosLessThanHW ; #o0375 + CatchOpenHW ; #o0376 + SpareOpHW ;#o0377 +)) + +(defvar *branch-format-opcodes* #( ; [256] + nil ; CarHW ; #o00 + nil ; CdrHW ; #o01 + nil ; EndpHW ; #o02 + nil ; Setup1DArrayHW ; #o03 + nil ; SetupForce1DArrayHW ; #o04 + nil ; BindLocativeHW ; #o05 + nil ; RestoreBindingStackHW ; #o06 + nil ; EphemeralpHW ; #o07 + nil ; StartCallHW ; #o010 + nil ; JumpHW ; #o011 + nil ; TagHW ; #o012 + nil ; DereferenceHW ; #o013 + nil ; LogicTailTestHW ; #o014 + nil ; SpareOpHW ; #o015 +++ Used for breakpoints!!! + nil ; DoubleFloatOpHW ; #o016 + nil ; SpareOpHW ; #o017 + nil ; PushLexicalVarNHW ; #o020 + nil ; PushLexicalVarNHW ; #o021 + nil ; PushLexicalVarNHW ; #o022 + nil ; PushLexicalVarNHW ; #o023 + nil ; PushLexicalVarNHW ; #o024 + nil ; PushLexicalVarNHW ; #o025 + nil ; PushLexicalVarNHW ; #o026 + nil ; PushLexicalVarNHW ; #o027 + nil ; Block0WriteHW ; #o030 + nil ; Block1WriteHW ; #o031 + nil ; Block2WriteHW ; #o032 + nil ; Block3WriteHW ; #o033 + nil ; ZeropHW ; #o034 + nil ; MinuspHW ; #o035 + nil ; PluspHW ; #o036 + nil ; SpareOpHW ;#o037 + nil ; TypeMemberHW ; #o040 + nil ; TypeMemberHW ; #o041 + nil ; TypeMemberHW ; #o042 + nil ; TypeMemberHW ; #o043 + nil ; TypeMemberHW ; #o044 + nil ; TypeMemberHW ; #o045 + nil ; TypeMemberHW ; #o046 + nil ; TypeMemberHW ; #o047 + nil ; LocateLocalsHW ; #o050 + nil ; CatchCloseHW ; #o051 + nil ; GenericDispatchHW ; #o052 + nil ; MessageDispatchHW ; #o053 + nil ; CheckPreemptRequestHW ; #o054 + nil ; PushGlobalLogicVariableHW ; #o055 + nil ; NoOpHW ; #o056 + nil ; HaltHW ; #o057 + t ; BranchTrueHW ; #o060 + t ; BranchTrueElseExtraPopHW ; #o061 + t ; BranchTrueAndExtraPopHW ; #o062 + t ; BranchTrueExtraPopHW ; #o063 + t ; BranchTrueNoPopHW ; #o064 + t ; BranchTrueAndNoPopHW ; #o065 + t ; BranchTrueElseNoPopHW ; #o066 + t ; BranchTrueAndNoPopElseNoPopExtraPopHW ; #o067 + t ; BranchFalseHW ; #o070 + t ; BranchFalseElseExtraPopHW ; #o071 + t ; BranchFalseAndExtraPopHW ; #o072 + t ; BranchFalseExtraPopHW ; #o073 + t ; BranchFalseNoPopHW ; #o074 + t ; BranchFalseAndNoPopHW ; #o075 + t ; BranchFalseElseNoPopHW ; #o076 + t ; BranchFalseAndNoPopElseNoPopExtraPopHW ; #o077 + nil ; PushHW ; #o0100 + nil ; PushNNilsHW ; #o0101 + nil ; PushAddressSpRelativeHW ; #o0102 + nil ; PushLocalLogicVariablesHW ; #o0103 + nil ; ReturnMultipleHW ; #o0104 + nil ; ReturnKludgeHW ; #o0105 + nil ; TakeValuesHW ; #o0106 + nil ; UnbindNHW ; #o0107 + nil ; PushInstanceVariableHW ; #o0110 + nil ; PushAddressInstanceVariableHW ; #o0111 + nil ; PushInstanceVariableOrderedHW ; #o0112 + nil ; PushAddressInstanceVariableOrderedHW ; #o0113 + nil ; UnaryMinusHW ; #o0114 + nil ; ReturnSingleHW ; #o0115 + nil ; MemoryReadHW ; #o0116 + nil ; MemoryReadHW ; #o0117 + nil ; Block0ReadHW ; #o0120 + nil ; Block1ReadHW ; #o0121 + nil ; Block2ReadHW ; #o0122 + nil ; Block3ReadHW ; #o0123 + nil ; Block0ReadShiftHW ; #o0124 + nil ; Block1ReadShiftHW ; #o0125 + nil ; Block2ReadShiftHW ; #o0126 + nil ; Block3ReadShiftHW ; #o0127 + nil ; Block0ReadTestHW ; #o0130 + nil ; Block1ReadTestHW ; #o0131 + nil ; Block2ReadTestHW ; #o0132 + nil ; Block3ReadTestHW ; #o0133 + nil ; FinishCallNHW ; #o0134 + nil ; FinishCallNHW ; #o0135 + nil ; FinishCallTosHW ; #o0136 + nil ; FinishCallTosHW ; #o0137 + nil ; SetToCarHW ; #o0140 + nil ; SetToCdrHW ; #o0141 + nil ; SetToCdrPushCarHW ; #o0142 + nil ; IncrementHW ; #o0143 + nil ; DecrementHW ; #o0144 + nil ; PointerIncrementHW ; #o0145 + nil ; SetCdrCode1HW ; #o0146 + nil ; SetCdrCode2HW ; #o0147 + nil ; PushAddressHW ; #o0150 + nil ; SetSpToAddressHW ; #o0151 + nil ; SetSpToAddressSaveTosHW ; #o0152 + nil ; SpareOpHW ;#o0153 + nil ; ReadInternalRegisterHW ; #o0154 + nil ; WriteInternalRegisterHW ; #o0155 + nil ; CoprocessorReadHW ; #o0156 + nil ; CoprocessorWriteHW ; #o0157 + nil ; Block0ReadAluHW ; #o0160 + nil ; Block1ReadAluHW ; #o0161 + nil ; Block2ReadAluHW ; #o0162 + nil ; Block3ReadAluHW ; #o0163 + nil ; SpareOpHW ;#o0164 + nil ; SpareOpHW ;#o0165 + nil ; SpareOpHW ;#o0166 + nil ; SpareOpHW ;#o0167 + nil ; LdbHW ; #o0170 + nil ; CharLdbHW ; #o0171 + nil ; PLdbHW ; #o0172 + nil ; PTagLdbHW ; #o0173 + t ; BranchHW ; #o0174 + t ; LoopDecrementTosHW ; #o0175 + nil ; EntryRestAcceptedHW ; #o0176 + nil ; EntryRestNotAcceptedHW ; #o0177 + nil ; RplacaHW ; #o0200 + nil ; RplacdHW ; #o0201 + nil ; MultiplyHW ; #o0202 + nil ; QuotientHW ; #o0203 + nil ; CeilingHW ; #o0204 + nil ; FloorHW ; #o0205 + nil ; TruncateHW ; #o0206 + nil ; RoundHW ; #o0207 + nil ; SpareOpHW ; #o0210 +++ Use for DoRemainder + nil ; RationalQuotientHW ; #o0211 + nil ; MinHW ; #o0212 + nil ; MaxHW ; #o0213 + nil ; AluHW ; #o0214 + nil ; LogandHW ; #o0215 + nil ; LogxorHW ; #o0216 + nil ; LogiorHW ; #o0217 + nil ; RotHW ; #o0220 + nil ; LshHW ; #o0221 + nil ; MultiplyDoubleHW ; #o0222 + nil ; LshcBignumStepHW ; #o0223 + nil ; StackBltHW ; #o0224 + nil ; RgetfHW ; #o0225 + nil ; MemberHW ; #o0226 + nil ; AssocHW ; #o0227 + nil ; PointerPlusHW ; #o0230 + nil ; PointerDifferenceHW ; #o0231 + nil ; AshHW ; #o0232 + nil ; StoreConditionalHW ; #o0233 + nil ; MemoryWriteHW ; #o0234 + nil ; PStoreContentsHW ; #o0235 + nil ; BindLocativeToValueHW ; #o0236 + nil ; UnifyHW ; #o0237 + nil ; PopLexicalVarNHW ; #o0240 + nil ; PopLexicalVarNHW ; #o0241 + nil ; PopLexicalVarNHW ; #o0242 + nil ; PopLexicalVarNHW ; #o0243 + nil ; PopLexicalVarNHW ; #o0244 + nil ; PopLexicalVarNHW ; #o0245 + nil ; PopLexicalVarNHW ; #o0246 + nil ; PopLexicalVarNHW ; #o0247 + nil ; MovemLexicalVarNHW ; #o0250 + nil ; MovemLexicalVarNHW ; #o0251 + nil ; MovemLexicalVarNHW ; #o0252 + nil ; MovemLexicalVarNHW ; #o0253 + nil ; MovemLexicalVarNHW ; #o0254 + nil ; MovemLexicalVarNHW ; #o0255 + nil ; MovemLexicalVarNHW ; #o0256 + nil ; MovemLexicalVarNHW ; #o0257 + nil ; EqualNumberHW ; #o0260 + nil ; LesspHW ; #o0261 + nil ; GreaterpHW ; #o0262 + nil ; EqlHW ; #o0263 + nil ; EqualNumberHW ; #o0264 + nil ; LesspHW ; #o0265 + nil ; GreaterpHW ; #o0266 + nil ; EqlHW ; #o0267 + nil ; EqHW ; #o0270 + nil ; SpareOpHW ; #o0271 + nil ; SpareOpHW ; #o0272 + nil ; LogtestHW ; #o0273 + nil ; EqHW ; #o0274 + nil ; SpareOpHW ; #o0275 + nil ; SpareOpHW ; #o0276 + nil ; LogtestHW ; #o0277 + nil ; AddHW ; #o0300 + nil ; SubHW ; #o0301 + nil ; 32BitPlusHW ; #o0302 + nil ; 32BitDifferenceHW ; #o0303 + nil ; AddBignumStepHW ; #o0304 + nil ; SubBignumStepHW ; #o0305 + nil ; MultiplyBignumStepHW ; #o0306 + nil ; DivideBignumStepHW ; #o0307 + nil ; Aset1HW ; #o0310 + nil ; AllocateListBlockHW ; #o0311 + nil ; Aref1HW ; #o0312 + nil ; Aloc1HW ; #o0313 + nil ; StoreArrayLeaderHW ; #o0314 + nil ; AllocateStructureBlockHW ; #o0315 + nil ; ArrayLeaderHW ; #o0316 + nil ; AlocLeaderHW ; #o0317 + nil ; PopInstanceVariableHW ; #o0320 + nil ; MovemInstanceVariableHW ; #o0321 + nil ; PopInstanceVariableOrderedHW ; #o0322 + nil ; MovemInstanceVariableOrderedHW ; #o0323 + nil ; InstanceRefHW ; #o0324 + nil ; InstanceSetHW ; #o0325 + nil ; InstanceLocHW ; #o0326 + nil ; SetTagHW ; #o0327 + nil ; SpareOpHW ;#o0330 + nil ; UnsignedLesspHW ; #o0331 + nil ; SpareOpHW ;#o0332 + nil ; SpareOpHW ;#o0333 + nil ; SpareOpHW ;#o0334 + nil ; UnsignedLesspHW ; #o0335 + nil ; SpareOpHW ;#o0336 + nil ; SpareOpHW ;#o0337 + nil ; PopHW ; #o0340 + nil ; MovemHW ; #o0341 + nil ; MergeCdrNoPopHW ; #o0342 + nil ; SpareOpHW ;#o0343 + nil ; SpareOpHW ;#o0344 + nil ; SpareOpHW ;#o0345 + nil ; SpareOpHW ;#o0346 + nil ; SpareOpHW ;#o0347 + nil ; FastAref1HW ; #o0350 + nil ; FastAset1HW ; #o0351 + nil ; StackBltAddressHW ; #o0352 + nil ; SpareOpHW ;#o0353 + nil ; SpareOpHW ;#o0354 + nil ; SpareOpHW ;#o0355 + nil ; SpareOpHW ;#o0356 + nil ; SpareOpHW ;#o0357 + nil ; SpareOpHW ;#o0360 + nil ; SpareOpHW ;#o0361 + nil ; SpareOpHW ;#o0362 + nil ; SpareOpHW ;#o0363 + nil ; SpareOpHW ;#o0364 + nil ; SpareOpHW ;#o0365 + nil ; SpareOpHW ;#o0366 + nil ; SpareOpHW ;#o0367 + nil ; DpbHW ; #o0370 + nil ; CharDpbHW ; #o0371 + nil ; PDpbHW ; #o0372 + nil ; PTagDpbHW ; #o0373 + nil ; SpareOpHW ;#o0374 + t ; LoopIncrementTosLessThanHW ; #o0375 + nil ; CatchOpenHW ; #o0376 + nil ; SpareOpHW ;#o0377 +)) + +(defvar *fullwordinstns* #( ; [48] + nullfw ; #o00 = DTP-NULL + monitorforwardfw ; #o01 = DTP-MONITOR-FORWARD + headerpfw ; #o02 = DTP-HEADER-P + headerifw ; #o03 = DTP-HEADER-I + valuecell ; #o04 = DTP-EXTERNAL-VALUE-CELL-POINTER + oneqforwardfw ; #o05 = DTP-ONE-Q-FORWARD + headerforwardfw ; #o06 = DTP-HEADER-FORWARD + elementforwardfw ; #o07 = DTP-ELEMENT-FORWARD + pushimmediateconstant ; #o10 = DTP-FIXNUM + pushimmediateconstant ; #o11 = DTP-SMALL-RATIO + pushimmediateconstant ; #o12 = DTP-SINGLE-FLOAT + pushconstantvalue ; #o13 = DTP-DOUBLE-FLOAT + pushconstantvalue ; #o14 = DTP-BIGNUM + pushconstantvalue ; #o15 = DTP-BIG-RATIO + pushconstantvalue ; #o16 = DTP-COMPLEX + pushconstantvalue ; #o17 = DTP-SPARE-NUMBER + pushconstantvalue ; #o20 = DTP-INSTANCE + pushconstantvalue ; #o21 = DTP-LIST-INSTANCE + pushconstantvalue ; #o22 = DTP-ARRAY-INSTANCE + pushconstantvalue ; #o23 = DTP-STRING-INSTANCE + pushimmediateconstant ; #o24 = DTP-NIL + pushconstantvalue ; #o25 = DTP-LIST + pushconstantvalue ; #o26 = DTP-ARRAY + pushconstantvalue ; #o27 = DTP-STRING + pushconstantvalue ; #o30 = DTP-SYMBOL + pushconstantvalue ; #o31 = DTP-LOCATIVE + pushconstantvalue ; #o32 = DTP-LEXICAL-CLOSURE + pushconstantvalue ; #o33 = DTP-DYNAMIC-CLOSURE + pushconstantvalue ; #o34 = DTP-COMPILED-FUNCTION + pushconstantvalue ; #o35 = DTP-GENERIC-FUNCTION + pushconstantvalue ; #o36 = DTP-SPARE-POINTER-1 + pushconstantvalue ; #o37 = DTP-SPARE-POINTER-2 + pushimmediateconstant ; #o40 = DTP-PHYSICAL-ADDRESS + nativeinstruction ; #o41 = DTP-NATIVE-INSTRUCTION + boundlocationfw ; #o42 = DTP-BOUND-LOCATION + pushimmediateconstant ; #o43 = DTP-CHARACTER + logicvariablefw ; #o44 = DTP-LOGIC-VARIABLE + gcforwardfw ; #o45 = DTP-GC-FORWARD + pushconstantvalue ; #o46 = DTP-EVEN-PC + pushconstantvalue ; #o47 = DTP-ODD-PC + callcompiledeven ; #o50 = DTP-CALL-COMPILED-EVEN + callcompiledodd ; #o51 = DTP-CALL-COMPILED-ODD + callindirect ; #o52 = DTP-CALL-INDIRECT + callgeneric ; #o53 = DTP-CALL-GENERIC + callcompiledevenprefetch ; #o54 = DTP-CALL-COMPILED-EVEN-PREFETCH + callcompiledoddprefetch ; #o55 = DTP-CALL-COMPILED-ODD-PREFETCH + callindirectprefetch ; #o56 = DTP-CALL-INDIRECT-PREFETCH + callgenericprefetch ; #o57 = DTP-CALL-GENERIC-PREFETCH +)) + +(defconstant *native-instruction-opcode* #o41) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; The Disassembler ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; The Disassembler is only required for debugging purposes. Someone should hack the +;;; real disassembler to disassemble 'fully assembled functions and integrate it. + +(clos:defmethod instruction-name ((decinst fullword-instruction)) + (clos:with-slots (opcode) decinst + (svref *fullwordinstns* opcode))) + +(clos:defmethod instruction-name ((decinst halfword-instruction)) + (clos:with-slots (opcode) decinst + (svref *halfwordinstns* opcode))) + +;; Broken out for calling from Genera disassembler +(defun print-native-instruction (constant stream &optional pc) + (let* ((opcode (ldb %%alpha-inst-opcode constant)) + (mopname (svref *Major-opcodes* opcode)) + (ftyp (svref *Opcode-Format* opcode)) + (ra (ldb %%alpha-inst-ra constant)) + (rb (ldb %%alpha-inst-rb constant)) + (rc (ldb %%alpha-inst-rc constant)) + (function (ldb (byte 7 5) constant)) + (litp (= 1 (ldb (byte 1 12) constant))) + (lit (ldb (byte 8 13) constant)) + (mdisp (ldb %%alpha-inst-memory-disp constant)) + (bdisp (ldb %%alpha-inst-branch-disp constant)) + (palfun (ldb (byte 26 0) constant))) + (when pc + (future-common-lisp::format stream "~o: " pc)) + (case ftyp + ((pal) + (future-common-lisp::format stream "~a(~x) #x~x" + mopname opcode palfun)) + ((res) + (future-common-lisp::format stream "~a #x~x" mopname constant)) + ((mem) + (if (not (zerop (logand mdisp #x8000))) (setq mdisp (dpb mdisp (byte 16 0) -1))) + (future-common-lisp::format stream "~a ~a, #x~x(~a)" + mopname (regname ra) mdisp (regname rb))) + ((op) + (future-common-lisp::format stream "~a ~a, ~a, ~a" + (fcnname opcode function) + (regname ra) + (if litp lit (regname rb)) + (regname rc))) + ((non) + (future-common-lisp::format stream "~a #x~x" pc mopname constant)) + ((br) + (future-common-lisp::format stream "~a ~a, #x~x(~o)" + mopname (regname ra) bdisp + (+ (or pc 0) (* (if (zerop (ldb (byte 1 20) bdisp)) + bdisp + (dpb bdisp (byte 21 0) -1)) + 2))))) + (when pc + (fresh-line stream)))) + +(clos:defmethod print-instruction ((decinst fullword-instruction) &optional (stream t)) + (clos:with-slots (pc constant nextpc) decinst + (fresh-line stream) + (if (native-instructionp decinst) + (clos:with-slots (constant) decinst + (print-native-instruction constant stream pc)) + (let* ((instname (instruction-name decinst))) + (future-common-lisp::format stream "~o: ~a constant=~a nextpc=~o~%" + pc instname constant nextpc))))) + +(clos:defmethod print-instruction ((decinst halfword-instruction) &optional (stream t)) + (clos:with-slots (pc operand nextpc) decinst + (fresh-line stream) + (let* ((instname (instruction-name decinst))) + (future-common-lisp::format stream "~o: ~a operand=~a nextpc=~o~%" + pc instname operand nextpc)))) + +(clos:defmethod print-function ((decfcn decoded-function) &optional (stream t)) + (clos:with-slots (instructions) decfcn + (dolist (inst instructions) + (print-instruction inst stream)))) + +(clos:defmethod print-function ((ts translation-state) &optional (stream t)) + (clos:with-slots (source target) ts + (print-function (or target source) stream))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for pulling apart an ivory function object. This is almost certainly +;;; provided by existing Genera functions, and this code shoule probably be replaced by +;;; use of standard Genera primitives intended for this purpose. It should probab;y be +;;; done at the time that the translator technology is integrated so as to allow +;;; fasl files to be written, and for functions to get translated automatically if they +;;; have a magic declaration. For the time being, the task is to get the translator +;;; core working. + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; (instnref compiled-function index) +;;; +;;; Index is an index into the compiled function in fullwords. First +;;; instruction is at 0. The instruction returns multiple values as +;;; follows: +;;; cdr-code +;;; type The (6) type bits (cdr code removed) +;;; tag The full tag including cdr-code +;;; data The data word as a fixnum +;;; word The full word including tag and cdr code. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(defun tag-data-type (tag) + (logand tag #x3f)) + +(defun tag-cdr-code (tag) + (ash tag -6)) + +(defun instnref (fcn index) + (let* ((datum (si:%memory-read (si:%pointer-plus fcn index) :set-cdr-next nil)) + (tag (si:%tag datum))) + (values (tag-cdr-code tag) ;The CDR code + (tag-data-type tag) ;The type (tag wo cdr code) + tag ;The complete 8 bit tag + (si:%set-tag datum si:dtp-fixnum) ;The data word as a fixnum + datum))) ;The full word including tag (and cdrcode) + +(clos:defmethod findpc ((decfcn decoded-function) apc) + (clos:with-slots (instructions) decfcn + (dolist (in instructions) + (clos:with-slots (pc) in + (if (= pc apc) (return-from findpc in)))))) + +(clos:defmethod abstract-branch-target ((decfcn decoded-function) + (inst ibranch-format-instruction)) + (clos:with-slots (instruction) decfcn + (clos:with-slots (pc operand target) inst + (let* ((uoffset (logand operand #x3FF)) + (offset (if (not (zerop (logand uoffset #x200))) + (logior (ash -1 10) uoffset) + uoffset)) + (targetpc (+ pc offset)) + (targetinst (findpc decfcn targetpc))) + (if (null targetinst) (error "Can't find target instruction")) + (setq operand (logand (lognot #x3FF) operand)) ;discard the offset bits + (setq target (label-instruction targetinst)))))) + +(clos:defmethod linkup-function ((decfcn decoded-function)) + (clos:with-slots (instructions) decfcn + ;; First for every instruction, find its PC sequencing successor. + (dolist (instn instructions) + (if (typep instn 'ibranch-format-instruction) + (abstract-branch-target decfcn instn)) + (clos:with-slots (nextinstn nextpc pc) instn + (setq nextinstn (findpc decfcn nextpc)))) + ;; Next starting with the first instruction assign an execution order. + (do ((iorder 0 (+ iorder 1)) + (instn (first instructions) (clos:with-slots (nextinstn) instn nextinstn))) + ((null instn) + ;; Finally sort1 0the instructions into execution order + (setq instructions (sort instructions #'< :key 'ivory-instruction-order)) + 1(do ((instns instructions (cdr instns0)1)) +0 1((clos:with-slots (order) (car instns) (>= order 0)) +0 1(setq instructions instns)))) +0 (clos:with-slots (order) instn + (setq order iorder))))) + +(defun decode-ivory-function (fcn) + (assert (typep fcn 'compiled-function)) + (let ((decfcn (clos:make-instance 'decoded-function)) + (endcc nil) + (info nil) + (ilist ())) + (do ((index 0 (+ index 1))) + (endcc ()) + (multiple-value-bind (cc type tag data word) (instnref fcn index) + (declare (ignore type)) + (cond ((= cc 1) + (setq info word) + (setq endcc t)) + (:otherwise + (push word ilist) + (decode-ivory-instruction decfcn index tag data word))))) + (clos:with-slots (packed-instructions debug-info instructions) decfcn + (setq instructions (nreverse instructions)) + (setq debug-info info) + (setq packed-instructions (nreverse ilist))) + (linkup-function decfcn) + decfcn)) + +(defun make-hwinst (cc pc opcode datum tag nextpc) + (clos:make-instance (if (branch-format-hw-opcodep opcode) + 'ibranch-format-instruction + 'halfword-instruction) + :sequence cc + :pc pc + :nextpc (+ (ash nextpc 1) (if (eq tag si:dtp-odd-pc) 1 0)) + :opcode opcode + :operand datum)) + +(defun make-fwinst (cc pc opcode datum tag nextpc) + (clos:make-instance 'fullword-instruction + :sequence cc + :pc pc + :nextpc (+ (ash nextpc 1) (if (eq tag si:dtp-odd-pc) 1 0)) + :opcode opcode + :constant datum)) + +(clos:defmethod copy-instruction ((oldinst fullword-instruction)) + (clos:with-slots (label sequence pc nextpc opcode constant) oldinst + (clos:make-instance 'fullword-instruction + :label label + :sequence sequence + :pc pc + :nextpc nextpc + :opcode opcode + :constant constant))) + +(clos:defmethod copy-instruction ((oldinst halfword-instruction)) + (clos:with-slots (label sequence pc nextpc opcode operand) oldinst + (clos:make-instance 'halfword-instruction + :label label + :sequence sequence + :pc pc + :nextpc nextpc + :opcode opcode + :operand operand))) + +(clos:defmethod copy-instruction ((oldinst ibranch-format-instruction)) + (clos:with-slots (label sequence pc nextpc opcode operand target) oldinst + (clos:make-instance 'ibranch-format-instruction + :label label + :sequence sequence + :pc pc + :nextpc nextpc + :opcode opcode + :operand operand + :target target))) + +(defun make-alpha-instruction (bits) + (let* ((fnbits (if (zerop (ldb (byte 1 31) bits)) + bits + (dpb (ldb (byte 31 0) bits) (byte 31 0) -1))) + (opcodebits (ldb %%alpha-inst-opcode bits)) + (opcodetype (aref *Opcode-Format* opcodebits))) + (clos:make-instance (if (eq opcodetype 'br) + 'alpha-native-branch-instruction + 'alpha-native-instruction) + :opcode *native-instruction-opcode* + :sequence 3 + :constant fnbits))) + +(clos:defmethod add-instruction ((nuinst ivory-instruction) (istream translation-state)) + (clos:with-slots (target pendinglabel) istream + (clos:with-slots (instructions icount) target + (clos:with-slots (order label) nuinst + 1(when 0pendinglabel + 1(setq label (append label (shiftf 0pendinglabel1 0nil1)))) +0 (setq order icount) + (push nuinst instructions) + (incf icount))))) + +;;; on entry PC is a word index, we convert it to hwpc by doubling +(clos:defmethod decode-ivory-instruction ((decfcn decoded-function) pc tag data word) + (multiple-value-bind (cc even-tag even-pc odd-tag odd-pc) + (case (tag-cdr-code tag) + (0 (values 0 si:dtp-odd-pc pc si:dtp-even-pc (+ pc 1))) + (3 (values 3 si:dtp-even-pc (+ pc 1) si:dtp-even-pc (+ pc 2))) + (2 (values 2 si:dtp-odd-pc (- pc 1) si:dtp-even-pc pc)) + (1 (error "Illegal Sequencing Code"))) + (clos:with-slots (instructions packed-instructions) decfcn + (cond (1(let ((opcode (ldb (byte 8 10) data)))0 1;entry instruction ? +0 1(lisp:and 0(= (tag-data-type tag) #o60) + (or (= opcode #o176) (= opcode #o177))1)) +0 ;; Entry instruction + (push (make-hwinst cc (ash pc 1) + (logand #xFF (ash data -10)) + data + even-tag even-pc) + instructions)) + ((>1=0 (tag-data-type tag) #o60) + (let ((even-instruction (ldb si:%%q-even-instruction data)) + (odd-instruction (dpb tag (byte 4 14.) (ldb (byte 14. 18.) data)))) + (push (make-hwinst cc (ash pc 1) + (logand #xFF (ash even-instruction -10)) + (logand #x3FF even-instruction) + even-tag even-pc) + instructions) + (push (make-hwinst cc (+ (ash pc 1) 1) + (logand #xFF (ash odd-instruction -10)) + (logand #x3FF odd-instruction) + odd-tag odd-pc) + instructions))) + (t1 +0 (push (make-fwinst cc (ash pc 1) + (logand tag #x3F) + word + even-tag even-pc) + instructions))))) + nil) + +(clos:defmethod set-instn-cdr-code ((decinst ivory-instruction) cc) + (clos:with-slots (sequence) decinst + (setq sequence cc))) + +(defmacro ivory-label (lab) + `(setlabel istream ,lab)) + +(defmacro alpha-label (lab) + `(setlabel istream ,lab)) + +(clos:defmethod setlabel ((istream translation-state) label) + (clos:with-slots (pendinglabel) istream + 1(if (listp label) +0 1(setq pendinglabel (append label pendinglabel)) +0 1(push label pendinglabel))0)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation driver. + +;;; Translate function takes one decoded function and creates another +;;; decoded function in which some of the instructions have been +;;; translated and now appear as fullword DTP-NATIVE-INSTRUCTION. + +(defmacro emit (&rest forms) + `(assemble-asm-form (list ,@forms) istream)) + +;;; Registers to remember! +;;; (define-integer-register iPC 9) +;;; (define-integer-register iFP 10) +;;; (define-integer-register iLP 11) +;;; (define-integer-register iSP 12) +;;; (define-integer-register iCP 13) +;;; (define-integer-register ivory 14) ; ivory processor object + +(clos:defmethod translate-function ((decfcn decoded-function)) + (let* ((newfcn (clos:make-instance 'decoded-function)) + (tstate (clos:make-instance 'translation-state :source decfcn :target newfcn)) + (newinfo nil) + (newname nil) + (fcnloc nil)) + (clos:with-slots (instructions debug-info) decfcn +; (setq newname (intern (string-append "TRANSLATED-" (symbol-name (car debug-info))) +; (symbol-package (car debug-info)))) + (setq newinfo debug-info #+ign `(,(car debug-info) (untranslated-function nil) .,(cdr debug-info))) +; (setq newinfo debug-info) + 1(let ((*function-epilogue* nil)) +0 (dolist (instn instructions) + (clos:with-slots (label) instn + (setlabel tstate label)) + (funcall (instruction-name instn) tstate instn)) + 1(loop while *function-epilogue* +0 1do (0assemble-asm-form1 (shiftf *function-epilogue* nil) 0tstate1))) +0 ) + (emit-escape-blocks tstate) + (clos:with-slots (instructions debug-info) newfcn + (setq debug-info newinfo) + (setq instructions (nreverse instructions))) + (pack-instructions newfcn) ; Pack the instructions and assign PC's + (clos:with-slots (target newfun) tstate + (clos:with-slots (packed-instructions packed-size debug-info) target + (multiple-value-setq (fcnloc newfun) + (si:make-compiled-code (+ packed-size 3) 1)) + (do ((i 0 (+ i 1))) + ((>= i packed-size) + (setf (si:cca-extra-info fcnloc) debug-info) + #+ign + (si:%memory-write (si:%pointer-plus fcnloc (+ i 2)) + (si:%set-tag debug-info ;set fence + (logior (ash 1 6) (si:%tag debug-info)))) + newfun) + (si:%memory-write (si:%pointer-plus fcnloc (+ i 2)) + (si:%memory-read (si:aloc packed-instructions i) + :set-cdr-next nil))))) + tstate)) + +;;; Instructions in the generated instruction stream are entered in order of expected +;;; execution, and not in a packed sequence. pack-instructions assigns packed PC's +;;; to the instructions and sets cdr code bits for sequencing. +;;; The resulting sequence is stored as a list in 'packed-instns' for later storage +;;; in a compiled function object. + +(clos:defmethod pack-instructions ((decfcn decoded-function)) ; + (clos:with-slots (instructions packed-instructions packed-size) decfcn + (let* ((thispc 0) ;The current PC + (thistype nil) ;The current instruction type + (prvpc -2) ;The previous PC + (prvprvpc -4) ;The pc before last + (prvtype :fullword) ;Previous instruction type + (prvprvtype :fullword) ;Prev Prev instruction type + (prvinstn nil) + (instvec (make-array (length instructions))) + (instptr (si:aloc instvec 0)) + (wordcount 0) + (labels-alist ()) + (branches-list ()) + (alpha-branches-list ()) + (maxpc 0)) + ;; First assign PC's and CDR codes. + (dolist (instn instructions) + (setq thistype (instruction-kind instn)) + (clos:with-slots (pc opcode nextpc nextinstn label) instn + (if (entry-instructionp instn) (setq thistype :fullword)) + (cond + ((eq thistype :halfword) + (cond ((eq prvtype :halfword) + (cond ((= (- prvprvpc prvpc) 1) + (setq thispc (+ maxpc 2)) + (set-instn-cdr-code instn 0) + (setq maxpc thispc)) + (:otherwise + (setq thispc (+ maxpc 1)) + (set-instn-cdr-code instn 0) + (setq maxpc thispc)))) + + ((lisp:and (eq prvtype :fullword) + (eq prvprvtype :halfword) + (= (- prvpc prvprvpc) 2) + (not (native-instructionp prvinstn))) + ;; we have a hole to fill, an we fit! + (set-instn-cdr-code prvinstn 2) + (set-instn-cdr-code instn 3) + (setq thispc (- prvpc 1))) + + (:otherwise + (setq thispc (+ prvpc 2)) ;prev was :fullword + (set-instn-cdr-code instn 0) + (setq maxpc thispc)))) + + ((eq thistype :fullword) + (cond ((eq prvtype :fullword) + (setq thispc (+ prvpc 2)) + (setq maxpc thispc) + (set-instn-cdr-code instn 3)) + + ((evenp prvpc) + (setq thispc (+ prvpc 2)) + (setq maxpc thispc) + (set-instn-cdr-code prvinstn 3) + (set-instn-cdr-code instn 3)) + + ((oddp prvpc) + (setq maxpc thispc) + (setq thispc (+ prvpc 1)) + (set-instn-cdr-code instn 3))))) + + (setq pc thispc) + (if (typep instn 'ibranch-format-instruction) + (push instn branches-list)) + (if (typep instn 'alpha-native-branch-instruction ) + (push instn alpha-branches-list)) + (if label + 1(loop for l in label do +0 (push (cons l instn) labels-alist)1)0) + (setq prvprvtype prvtype + prvtype thistype + prvprvpc prvpc + prvpc thispc + prvinstn instn))) + ;; Next fixup the labels. + (dolist (ob branches-list) + (clos:with-slots (operand target pc) ob + (let* ((targetinst (assoc target labels-alist)) + (sourcepc pc)) + (if (null targetinst) + (error "Can't find target for branch instruction.")) + (clos:with-slots (pc) (cdr targetinst) + (let* ((delta (- pc sourcepc)) + (delta10 (logand delta #x3FF))) + ;(break "branch computation for ~a." targetinst) + (setq operand (logior operand delta10))))))) + (dolist (ob alpha-branches-list) + (clos:with-slots (constant target pc) ob + (let* ((targetinst (assoc target labels-alist)) + (sourcepc pc)) + (if (null targetinst) + (error "Can't find target for alpha branch instruction.")) + (clos:with-slots (pc) (cdr targetinst) + (let* ((delta (- pc sourcepc 2)) + (delta21 (logand (ash delta -1) #x1FFFFF))) + (setq constant (logior constant delta21))))))) + ;; Next sort according to PC + (setq instructions (sort instructions #'< :key 'ivory-instruction-pc)) + ;; Finally assemble the instructions + (setq packed-instructions ()) + (do ((ilist instructions (cdr ilist))) + ((null ilist) + (setq packed-size wordcount) + (setq packed-instructions instvec)) + (let* ((inst (car ilist)) + (nextinst (cadr ilist)) + (hwinstn2 0) + (opcode2 0) + (ityp (instruction-kind inst)) + (nextityp (lisp:and nextinst (instruction-kind nextinst)))) + (cond + ((eq ityp :fullword) ; Simple case. 1 fullword instruction + (clos:with-slots (opcode constant sequence pc) inst + (let* ((tag (logior opcode (ash sequence 6))) + (instn (si:%make-pointer tag constant))) + (setq instn (si:%set-tag instn tag)) + (si:%memory-write instptr instn) + (incf wordcount) + (setq instptr (si:%pointer-plus instptr 1))))) + ((eq ityp :halfword) + (cond ((lisp:and (eq nextityp :halfword) (not (entry-instructionp inst))) + (pop ilist) + (clos:with-slots (operand opcode) nextinst + (setq opcode2 opcode) + (setq hwinstn2 operand)))) + (clos:with-slots (tag opcode operand sequence) inst + (let ((instn (si:%make-pointer + (logior #x30 (ash opcode2 -4)) + (+ + (if (zerop (logand opcode2 #x8)) + 0 + most-negative-fixnum) + (logior + (ash (logand opcode2 #x7) 28) + (ash (logand hwinstn2 #x3FF) 18) + (logior (ash opcode 10) operand)))))) + (format t "opcode = ~a opcode2=~a operand=~a operand2=~a sequence=~a~%" + opcode opcode2 operand hwinstn2 sequence) + (setq instn (si:%set-tag instn (logior (ash sequence 6) (si:%tag instn)))) + (format t "cdrcode= ~a~%" (ash (si:%tag instn) -6)) + (si:%memory-write instptr instn) + (incf wordcount) + (setq instptr (si:%pointer-plus instptr 1))))) + (:otherwise (error "Unknown instruction kind.")))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; set-instruction-mode is used to track the emulater instruction mode. Instruction +;;; mode is tracked in the translation-state. Switching from nativemode to emulated +;;; mode is done explicitely via a call to a subroutine in the IVORY object. Switching +;;; into native mode is done automatically because of the fullword native-instruction. +;;; Hence emulated instructions can switch into native instructions without an explicit +;;; switch, but the contrary direction emits a call. +;;; The resume-emulated slot contains a JMP instruction to the interpreter reentry loop. +;;; arg1 has the PC from the native mode call so that the new ivory PC can be computed from +;;; it. The trampoline througfh ivory is done so that we can get back into emulated mode +;;; with a single nativemode instruction to avoid code bloat. Ivory could conatina the +;;; address to jump to, but then we would have to load it before the jump and it would take +;;; two emited instructions. + +(defparameter *resume-emulated* 0) ;; This is the resume location +++ add to aistat + +(clos:defmethod set-instruction-mode ((ts translation-state) mode) + (assert (or (eq mode :emulated) (eq mode :native))) + (clos:with-slots (nativemodep) ts + (cond + ((lisp:and (eq mode :emulated) nativemodep) + (assemble-asm-form +#+OLDWAY + `((LDQ arg1 ,processorstate$q-resumeema (ivory)) + (JMP arg1 arg1 0)) +#-OLDWAY + '(JMP arg1 r0 #x8000) + ts) + (setf nativemodep nil)) + ((lisp:and (eq mode :native) (not nativemodep)) + (setf nativemodep t))))) + +(clos:defmethod emit-alphabits ((destination translation-state) bits &optional disp) + (set-instruction-mode destination :native) + (let ((instn (make-alpha-instruction bits))) + (if (lisp:and disp (symbolp disp)) + (clos:with-slots (target) instn + (setq target disp))) + (add-instruction instn destination))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation handler functions. ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; Support for 'single-shot' escape blocks. A single shot sequence is a sequence +;;; of instructions that emulates a single ivory instruction and then returns to the +;;; instruction stream. It is used to 'punt' translated instruction cases that are +;;; hard to do such as instructions twould cause an exception, or other hard sequences. +;;; The single shot sequences are emited at the end. Each sequence assumes that it +;;; is being entered in native mode so that it can be the target of an alpha branch. + +(defmacro make-escape (instn) + `(emit-make-escape istream ,instn)) + +;;; Adds an escape sequence for the single instruction 'instn' Two values are returned, +;;; both labels (symbols). The first is the label for the escape sequence. This label can be +;;; jumped to from an alpha-branch instruction to execute the escape. The second label, is +;;; the return label. The caller is responsible for setting the return label. The return +;;; label is an ivory label. + +(clos:defclass escape-block () + ((instruction :initarg :instruction) + (returnto :initarg :returnto))) + +(clos:defmethod emit-make-escape ((istream translation-state) instn) + (clos:with-slots (target) istream + (clos:with-slots (escapeblocks) target + (let* ((escapelabel (gensym)) + (returnlabel (gensym)) + (nuinst (copy-instruction instn))) + 1;; Caution! The escaped instruction may already have a label on +0 1;; it, but that label should already have been emitted on the +0 1;; translated version, so don't keep it +0 (clos:with-slots (label) nuinst + (setf label 1`(,0escapelabel1)0)) + (push (clos:make-instance 'escape-block + :instruction nuinst + :returnto returnlabel) + escapeblocks) + (values escapelabel returnlabel))))) + +(clos:defmethod emit-escape-blocks ((istream translation-state)) + (clos:with-slots (target) istream + (clos:with-slots (escapeblocks) target + (dolist (esc (reverse escapeblocks)) + ;; emit each escape in the order that it was received. + (set-instruction-mode istream :native) ;force native mode for entry. + (emit-block istream esc)) + ;; should delete emited blocks.+++ + ))) + +(clos:defmethod emit-block ((istream translation-state) (esc escape-block)) + (clos:with-slots (instruction returnto) esc + (clos:with-slots (label) instruction + (setlabel istream label)) + (let ((returninst (clos:make-instance 'ibranch-format-instruction + :opcode #o0174 ; +++ Branch + :target returnto))) + (passthrough-ivory-instruction istream instruction) ; emit the single shot + (passthrough-ivory-instruction istream returninst)))) ; emit the single shot + +;;; Support for decoding and interpreting halfword instruction 10 bit operands. + +(defun map-cs-rel (n) (svref #(:FP :LP :SP :Immediate) n)) + +(defun map-ivory-register (regid) + (case regid + ((:SP) 'iSP) + ((:FP) 'iFP) + ((:LP) 'iLP))) + +;;; Val is evalueted multiple times in below. Is should therefore be a symbol! +++ +;;; fix this macro to make the right thing happen when its nota symbol or constant. +(defmacro decode-operand-specifier ((relto offset popp) val &body body) + `(let* ((,relto (map-cs-rel (ldb (byte 2 8) ,val))) + (,popp (lisp:and (eq ,relto :SP) (= (ldb (byte 8 0) ,val)1 00))) + (,offset1 (if ,popp + 0 +0 (if (eq ,relto :SP) + (- (ldb (byte 8 0) ,val) 255) + (ldb (byte 8 0) ,val))1)0)) + ,@body)) + +(defmacro compute-operand-value (instn reg &rest stack-options) + `(emit-compute-operand-value istream ,instn ,reg ,@stack-options)) + +(defmacro compute-operand-value2 (instn regtag regdata &rest stack-options) + `(emit-compute-operand-value2 istream ,instn ,regtag ,regdata ,@stack-options)) + +(defmacro compute-operand-data (instn regdata &rest stack-options) + `(emit-compute-operand-data istream ,instn ,regdata ,@stack-options)) + +(defmacro compute-operand-address (instn reg) + `(emit-compute-operand-address istream ,instn ,reg)) + +(defmacro compute-operand-register-offset (instn reg) + `(emit-compute-operand-register-offset istream ,instn ,reg)) + +;;; Computes the operand value and stores the result in dest. The stack may be popped +;;; if the operand mode calls for it. dest may be iSP! If the operand in immediate, +;;; the value may be sign extended, or not. The default is to sign extend, the optional +;;; argument signextendimm controls this behavior. + +;;; Computes the operand value and stores the result in dest. The stack may be popped +;;; if the operand mode calls for it. dest may be iSP! If the operand in immediate, +;;; the value may be sign extended, or not. The default is to sign extend, the optional +;;; argument signextendimm controls this behavior. + +(clos:defmethod emit-compute-operand-value ((istream translation-state) + instn dest &rest stack-options) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (if (getf stack-options :signed t) + (setq offset (dpb offset (byte 8 0) (- (logand #x80 offset))))) + (if (zerop offset) + (emit '((STL zero ,processorstate$q-immediate-arg (Ivory)) + (LDQ ,dest ,processorstate$q-immediate-arg (Ivory)))) + (emit `((BIS zero ,offset ,dest) + (STL ,dest ,processorstate$q-immediate-arg (Ivory)) + (LDQ ,dest ,processorstate$q-immediate-arg (Ivory)))))) + ((lisp:and popp (not (eq dest 'iSP))) + ;; The SP-POP case! + (emit `(stack-pop ,dest :tos-valid ,(TOSStatus) ,@stack-options))) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit + `(stack-read-disp ,(map-ivory-register relto) ,(* 8 offset) ,dest + :tos-valid ,(TOSStatus) ,@stack-options))))))) + + +(clos:defmethod emit-compute-operand-value2 ((istream translation-state) + instn desttag destdata &rest stack-options) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (if (getf stack-options :signed t) + (setq offset (dpb offset (byte 8 0) (- (logand #x80 offset))))) + (emit `(LDA ,destdata ,offset (zero))) + (emit `(BIS zero ,|type|$k-|fixnum| ,desttag))) + ((lisp:and popp (not (eq destdata 'iSP))) + ;; The SP-POP case! + (emit `(stack-pop2 ,desttag ,destdata :tos-valid ,(TOSStatus) ,@stack-options))) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit + `(stack-read2-disp ,(map-ivory-register relto) ,(* 8 offset) ,desttag ,destdata + :tos-valid ,(TOSStatus) ,@stack-options))))))) + +(clos:defmethod emit-compute-operand-data ((istream translation-state) + instn dest &rest stack-options) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (if (getf stack-options :signed t) + (setq offset (dpb offset (byte 8 0) (- (logand #x80 offset))))) + (emit `((LDA ,dest ,offset (zero))))) + ((lisp:and popp (not (eq dest 'iSP))) + ;; The SP-POP case! + (emit `(stack-pop-data ,dest :tos-valid ,(TOSStatus) ,@stack-options))) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit + `(stack-read-data-disp ,(map-ivory-register relto) ,(* 8 offset) ,dest + :tos-valid ,(TOSStatus) ,@stack-options))))))) + +;;; Computes the operand address and stores the result in dest. The stack may be popped +;;; if the operand mode calls for it. dest may be iSP! + +(clos:defmethod emit-compute-operand-address ((istream translation-state) + instn dest) + (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (error "Immediate mode operand not allowed here")) + (popp + ;; The SP-POP case! + (emit `(LDA ,dest ,(* 8 offset) (,(map-ivory-register relto)))) + (if (not (eq dest 'iSP)) + (emit `(stack-pop-discard nil)))) + (:otherwise + ;;; The :SP :LP :FP cases (not SP-POP). Justload the value into the + ;;; target. + (emit `(LDA ,dest ,(* 8 offset) (,(map-ivory-register relto))))))))) + +(clos:defmethod emit-compute-operand-register-offset ((istream translation-state) + instn dest) + 1(declare (values register offset popp)) +0 (clos:with-slots (operand) instn + (decode-operand-specifier (relto offset popp) operand + (cond ((eq relto :immediate) + (error "immediate mode operand not allowed here")) + ((lisp:and popp (not (eq dest 'isp))) + ;; the sp-pop case! + (emit `(stack-pop-discard nil)) + ;; note we have (pre-) popped the stack, so we have to + ;; adjust offset + (values (map-ivory-register relto) (* 8 (+ offset 1))1 t0)) + (:otherwise + ;;; the :sp :lp :fp cases (not sp-pop). justload the value into the + ;;; target. + (values (map-ivory-register relto) (* 8 offset)1 popp0)))))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for managing the TOS cached state. the translation-state slot 'toscache' is +;;; used to track the state of the TOS cache. The TOS is cached opportunistically. +;;; An instruction can inherit a state in which the TOS is valid in one form or another +;;; or it can find the TOS uncached. Presently supported states are :invalid, :arg6 and +;;; :arg5arg6. Macros below allow the trivial management of TOS needs. + +(defmacro TOSvalid (status) + `(clos:with-slots (toscache) istream + (setf toscache ,status))) + +(defmacro TOSstatus () + `(clos:with-slots (toscache) istream + toscache)) + +(defmacro cacheTOS () + `(clos:with-slots (toscache) istream + (when (eq toscache :invalid) + (emit '(LDQ arg6 0 (iSP))) + (TOSvalid :arg6)))) + +(defmacro storeTOS () '(writeTOS 'iSP)) + +(defmacro writeTOS (vma &optional (offset 0)) + `(clos:with-slots (toscache) istream + (cond ((eq toscache :invalid) (error "TOS invalid")) + ((eq toscache :arg6) + (emit `(stack-write-disp ,,vma ,,offset arg6))) + ((eq toscache :arg5arg6) + (emit `(stack-write2-disp ,,vma ,,offset arg5 arg6)))))) + +(defmacro getTOStag (reg) + `(clos:with-slots (toscache) istream + (cond ((eq toscache :invalid) + (emit `(LDL ,,reg 4 (iSP)))) ;Load the tag + ((eq toscache :arg6) + (emit `(SRL arg6 32 ,,reg))) + ((lisp:and (eq toscache :arg5arg6) (not (eq ,reg 'arg5))) + (emit `(BIS arg5 zero ,,reg)))))) + +(defmacro getTOSdata (reg) + `(clos:with-slots (toscache) istream + (cond ((eq toscache :invalid) + (emit `(LDL ,,reg 0 (iSP)))) ;Load the data + ((eq toscache :arg6) + ;; Other two cases returned signed data, so be consistent + (emit `(ADDL arg6 0 ,,reg))) + ((lisp:and (eq toscache :arg5arg6) (not (eq ,reg 'arg6))) + (emit `(BIS arg6 zero ,,reg)))))) + +(defun allocate-registers (reglist) + (let ((allocforms ())) + (dolist (reg reglist) + (push `(setq ,reg (allocate-register istream)) allocforms)) + (nreverse allocforms))) + +(defun allocate-1specific-0registers (reglist1 0istream) + (clos:with-slots (freeregs) istream + (dolist (reg reglist) + 1(if (member reg freeregs) +0 1(setq freeregs (delete reg freeregs)) +0 1(error "Can't allocate ~A" reg))0) + reglist1)0) + +(defun release-registers (reglist) + (let ((forms ())) + (dolist (reg reglist) + (push `(free-register istream ,reg) forms)) + (nreverse forms))) + +(defun release-1specific-0registers (reglist1 0istream) + (clos:with-slots (freeregs) istream + (dolist (reg reglist) + 1(pushnew reg freeregs)0)1)0) + +(defmacro with-temporary-registers ((&rest registers) &body body) + (if (null registers) + `(progn ,@body) + `(let (,@registers) + ,@(allocate-registers registers) + (unwind-protect + (progn ,@body) + ,@(release-registers registers))))) + +(defmacro with-1specific0-registers ((&rest registers) &body body) + (if (null registers) + `(progn ,@body) + `(1progn +0 (allocate-1specific-0registers 1',0registers1 istream0) + (unwind-protect + (progn ,@body) + (release-1specific-0registers 1',0registers1 istream0))))) + +(defmacro xlatSCAtoVMA (sca vma temp) + `((LDQ ,temp ,processorstate$p-stackcachedata (ivory)) + (LDQ ,vma ,processorstate$q-stackcachebasevma (ivory)) + (SUBQ ,sca ,temp ,temp) + (SRL ,temp 3 ,temp) + (ADDQ ,temp ,vma ,vma))) + +(defmacro xlatConvertPcToContinuation (apc ctag cdata) + `((AND ,apc 1 ,ctag) + (SRL ,apc 1 ,cdata) ; convert PC to a real word address. + (LDA ,ctag ,|type|$k-|evenpc| (,ctag)))) + +(defmacro xlatConvertContinuationToPc (ctag cdata apc) + `((AND ,ctag 1 ,apc) + (ADDQ ,cdata ,apc ,apc) + (ADDQ ,cdata ,apc ,apc))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Register conventions: +;;; +;;; TOS is cached on a convenience basis. IF it is convenient to cache it, we do so +;;; in whatever form it pleases to to so do. The state of the TOS cache is recorded in +;;; translation-state slot 'toscache' and can have the following values: +;;; +;;; :invalid The TOS is not cached, you must reload it if you want it. +;;; :arg6 The TOS is stored as a 64 bit quantity in arg6 +;;; :arg5arg6 The TOS is stored as a tag+data in arg5/arg6 +;;; +;;; Upon entry from emulated mode, TOS is in :arg6 state because the emulator loop +;;; implements this behavior. When we exist to emulated mode, the emulator reloads TOS +;;; to arg6 for us. When loading values specifically for pushing, we can put them in arg5/6 +;;; so that TOS is in :arg5arg6 state after the operation. We don't waste cycles explicitely +;;; loading the TOS unless there is a clear and obvious win, because it causes code bloat +;;; and we can't guarantee a dual issue. Later an instruction lookahead mechanism could +;;; decide whether to preload TOS or not. +;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;;; The register allocations and freeing mechainsm is simplistic. free registers are +;;; organized as a fifo, so that the registers get cycled rather than a few registers being +;;; reused again and again. the reason for cyclingthe registers is that itgives the greatest +;;; freedom for instruction scheduling without register conflicts. There is not presently +;;; an instruction scheduler. Nothing clever happens when a register is needed but is not +;;; available (it just errors out). There are numerous ways in which the register allocation +;;; mechanism could and should be improved including doing something when registers are +;;; exhausted, and keeping track of who the registers are allocated to. + +(clos:defmethod allocate-register ((ts translation-state)) + (clos:with-slots (freeregs) ts + (if (null freeregs) (error "Not enough registers!")) + (let ((reg (car (last freeregs)))) + (setf freeregs (delete reg freeregs)) + reg))) + +(clos:defmethod free-register ((ts translation-state) reg) + (clos:with-slots (freeregs) ts + (pushnew reg freeregs))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Support for defining translation rules. +;;; These are rather primitive at present, and I'm not entirely happy with them +;;; but time doesn't permit cleaning them up at this point. + +(defmacro def-fullword-translation (name arglist &rest body) + `(clos:defmethod ,name ((istream translation-state) ,@arglist) ,@body)) + +(defmacro def-halfword-translation (name arglist &rest body) + `(clos:defmethod ,name ((istream translation-state) ,@arglist) ,@body)) + +(defmacro def-decoded-halfword-translation (name (instn relto offset popp) &rest body) + `(def-halfword-translation ,name (,instn) + (clos:with-slots (operand) ,instn + (decode-operand-specifier (,relto ,offset ,popp) operand + ,@body)))) + +;(defmacro emit (&rest forms) +; `(assemble-asm-form (list ,@forms) istream)) + +(defmacro do-default (instn) + `(passthrough-ivory-instruction istream ,instn)) + +;;; Passing through an instruction (punting) causes the emulator to reenter emulator +;;; mode. The emulator mode maintains TOS in arg6. We don't force it tobe valid because +;;; the emulator does it or us, and even if it didn't it is better to have it out of +;;; line. Revertive to emulator mode has the side effect of acusing TOScache to be +;;; :arg6 (when it reenters native mode). + +(clos:defmethod passthrough-ivory-instruction ((istream translation-state) instn) + (set-instruction-mode istream :emulated) + (add-instruction (copy-instruction instn) istream) + (TOSvalid :arg6)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Passthrough section ;;; +;;; ;;; +;;; Instructions in this section have been selected to be punted ;;; +;;; in some cases this is because of 'risk of introducing bugs', in ;;; +;;; some cases it is because code bloat is prohinitive, and in other ;;; +;;; cases, it is because we didn't get around to it yet. ;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CdrHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CdrHW (instn) ; #o01 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EndpHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EndpHW (instn) ; #o02 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Setup1DArrayHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Setup1DArrayHW (instn) ; #o03 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetupForce1DArrayHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetupForce1DArrayHW (instn) ; #o04 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BindLocativeHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BindLocativeHW (instn) ; #o05 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RestoreBindingStackHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RestoreBindingStackHW (instn) ; #o06 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EphemeralpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EphemeralpHW (instn) ; #o07 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StartCallHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StartCallHW (instn) ; #o010 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for JumpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation JumpHW (instn) ; #o011 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TagHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TagHW (instn) ; #o012 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DereferenceHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DereferenceHW (instn) ; #o013 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogicTailTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogicTailTestHW (instn) ; #o014 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SpareOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SpareOpHW (instn) ; #o015 +++ Used for breakpoints!!! + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DoubleFloatOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DoubleFloatOpHW (instn) ; #o016 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushLexicalVarNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushLexicalVarNHW (instn) ; #o020 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0WriteHW (instn) ; #o030 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1WriteHW (instn) ; #o031 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2WriteHW (instn) ; #o032 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3WriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3WriteHW (instn) ; #o033 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MinuspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MinuspHW (instn) ; #o035 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PluspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PluspHW (instn) ; #o036 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LocateLocalsHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LocateLocalsHW (instn) ; #o050 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CatchCloseHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CatchCloseHW (instn) ; #o051 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for GenericDispatchHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation GenericDispatchHW (instn) ; #o052 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MessageDispatchHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MessageDispatchHW (instn) ; #o053 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CheckPreemptRequestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CheckPreemptRequestHW (instn) ; #o054 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushGlobalLogicVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushGlobalLogicVariableHW (instn) ; #o055 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for NoOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation NoOpHW (instn) ; #o056 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for HaltHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation HaltHW (instn) ; #o057 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushNNilsHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushNNilsHW (instn) ; #o0101 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushAddressSpRelativeHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressSpRelativeHW (instn) ; #o0102 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushLocalLogicVariablesHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushLocalLogicVariablesHW (instn) ; #o0103 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReturnMultipleHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReturnMultipleHW (instn) ; #o0104 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReturnKludgeHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReturnKludgeHW (instn) ; #o0105 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TakeValuesHW instruction ????? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TakeValuesHW (instn) ; #o0106 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnbindNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnbindNHW (instn) ; #o0107 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushInstanceVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushInstanceVariableHW (instn) ; #o0110 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushAddressInstanceVariableHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressInstanceVariableHW (instn) ; #o0111 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PushInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushInstanceVariableOrderedHW (instn) ; #o0112 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;Translation support for PushAddressInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PushAddressInstanceVariableOrderedHW (instn) ; #o0113 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnaryMinusHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnaryMinusHW (instn) ; #o0114 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReturnSingleHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReturnSingleHW (instn) ; #o0115 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MemoryReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MemoryReadHW (instn) ; #o0116 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadHW (instn) ; #o0120 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadHW (instn) ; #o0121 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadHW (instn) ; #o0122 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadHW (instn) ; #o0123 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadShiftHW (instn) ; #o0124 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadShiftHW (instn) ; #o0125 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadShiftHW (instn) ; #o0126 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadShiftHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadShiftHW (instn) ; #o0127 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadTestHW (instn) ; #o0130 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadTestHW (instn) ; #o0131 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadTestHW (instn) ; #o0132 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadTestHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadTestHW (instn) ; #o0133 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FinishCallNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FinishCallNHW (instn) ; #o0134 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FinishCallTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FinishCallTosHW (instn) ; #o0136 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FinishCallTosHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FinishCallTosHW (instn) ; #o0137 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetToCarHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetToCarHW (instn) ; #o0140 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetToCdrHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetToCdrHW (instn) ; #o0141 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetToCdrPushCarHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetToCdrPushCarHW (instn) ; #o0142 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for IncrementHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation IncrementHW (instn) ; #o0143 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DecrementHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DecrementHW (instn) ; #o0144 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PointerIncrementHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PointerIncrementHW (instn) ; #o0145 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetCdrCode1HW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetCdrCode1HW (instn) ; #o0146 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetCdrCode2HW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetCdrCode2HW (instn) ; #o0147 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ReadInternalRegisterHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ReadInternalRegisterHW (instn) ; #o0154 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for WriteInternalRegisterHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation WriteInternalRegisterHW (instn) ; #o0155 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CoprocessorReadHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CoprocessorReadHW (instn) ; #o0156 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CoprocessorWriteHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CoprocessorWriteHW (instn) ; #o0157 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block0ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block0ReadAluHW (instn) ; #o0160 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block1ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block1ReadAluHW (instn) ; #o0161 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block2ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block2ReadAluHW (instn) ; #o0162 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Block3ReadAluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Block3ReadAluHW (instn) ; #o0163 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LdbHW (instn) ; #o0170 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CharLdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CharLdbHW (instn) ; #o0171 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PLdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PLdbHW (instn) ; #o0172 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PTagLdbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PTagLdbHW (instn) ; #o0173 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BranchHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BranchHW (instn) ; #o0174 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EntryRestAcceptedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EntryRestAcceptedHW (instn) ; #o0176 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EntryRestNotAcceptedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EntryRestNotAcceptedHW (instn) ; #o0177 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RplacaHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RplacaHW (instn) ; #o0200 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RplacdHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RplacdHW (instn) ; #o0201 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MultiplyHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MultiplyHW (instn) ; #o0202 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for QuotientHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation QuotientHW (instn) ; #o0203 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CeilingHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CeilingHW (instn) ; #o0204 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FloorHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FloorHW (instn) ; #o0205 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for TruncateHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation TruncateHW (instn) ; #o0206 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RoundHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RoundHW (instn) ; #o0207 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RationalQuotientHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RationalQuotientHW (instn) ; #o0211 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MinHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MinHW (instn) ; #o0212 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MaxHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MaxHW (instn) ; #o0213 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AluHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AluHW (instn) ; #o0214 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogandHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogandHW (instn) ; #o0215 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogxorHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogxorHW (instn) ; #o0216 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogiorHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogiorHW (instn) ; #o0217 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RotHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RotHW (instn) ; #o0220 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LshHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LshHW (instn) ; #o0221 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MultiplyDoubleHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MultiplyDoubleHW (instn) ; #o0222 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LshcBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LshcBignumStepHW (instn) ; #o0223 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StackBltHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StackBltHW (instn) ; #o0224 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for RgetfHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation RgetfHW (instn) ; #o0225 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MemberHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MemberHW (instn) ; #o0226 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AssocHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AssocHW (instn) ; #o0227 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AshHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AshHW (instn) ; #o0232 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StoreConditionalHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StoreConditionalHW (instn) ; #o0233 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MemoryWriteHW instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MemoryWriteHW (instn) ; #o0234 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PStoreContentsHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PStoreContentsHW (instn) ; #o0235 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for BindLocativeToValueHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation BindLocativeToValueHW (instn) ; #o0236 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnifyHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnifyHW (instn) ; #o0237 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopLexicalVarNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopLexicalVarNHW (instn) ; #o0240 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemLexicalVarNHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemLexicalVarNHW (instn) ; #o0250 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqualNumberHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqualNumberHW (instn) ; #o0260 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LesspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LesspHW (instn) ; #o0261 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for GreaterpHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation GreaterpHW (instn) ; #o0262 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqlHW instruction $$?? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqlHW (instn) ; #o0263 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqualNumberHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqualNumberHW (instn) ; #o0264 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LesspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LesspHW (instn) ; #o0265 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for GreaterpHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation GreaterpHW (instn) ; #o0266 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqlHW instruction $$?? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqlHW (instn) ; #o0267 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for EqHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation EqHW (instn) ; #o0270 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogtestHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogtestHW (instn) ; #o0273 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LogtestHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LogtestHW (instn) ; #o0277 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SubHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SubHW (instn) ; #o0301 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for 32BitPlusHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation 32BitPlusHW (instn) ; #o0302 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for 32BitDifferenceHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation 32BitDifferenceHW (instn) ; #o0303 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AddBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AddBignumStepHW (instn) ; #o0304 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SubBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SubBignumStepHW (instn) ; #o0305 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MultiplyBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MultiplyBignumStepHW (instn) ; #o0306 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DivideBignumStepHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DivideBignumStepHW (instn) ; #o0307 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Aset1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Aset1HW (instn) ; #o0310 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AllocateListBlockHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AllocateListBlockHW (instn) ; #o0311 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Aref1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Aref1HW (instn) ; #o0312 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for Aloc1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation Aloc1HW (instn) ; #o0313 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StoreArrayLeaderHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StoreArrayLeaderHW (instn) ; #o0314 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AllocateStructureBlockHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AllocateStructureBlockHW (instn) ; #o0315 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for ArrayLeaderHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation ArrayLeaderHW (instn) ; #o0316 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for AlocLeaderHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation AlocLeaderHW (instn) ; #o0317 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopInstanceVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopInstanceVariableHW (instn) ; #o0320 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemInstanceVariableHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemInstanceVariableHW (instn) ; #o0321 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PopInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PopInstanceVariableOrderedHW (instn) ; #o0322 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MovemInstanceVariableOrderedHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MovemInstanceVariableOrderedHW (instn) ; #o0323 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for InstanceRefHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation InstanceRefHW (instn) ; #o0324 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for InstanceSetHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation InstanceSetHW (instn) ; #o0325 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for InstanceLocHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation InstanceLocHW (instn) ; #o0326 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SetTagHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SetTagHW (instn) ; #o0327 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for UnsignedLesspHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation UnsignedLesspHW (instn) ; #o0331 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for MergeCdrNoPopHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation MergeCdrNoPopHW (instn) ; #o0342 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FastAref1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FastAref1HW (instn) ; #o0350 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for FastAset1HW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation FastAset1HW (instn) ; #o0351 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for StackBltAddressHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation StackBltAddressHW (instn) ; #o0352 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for DpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation DpbHW (instn) ; #o0370 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CharDpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CharDpbHW (instn) ; #o0371 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PDpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PDpbHW (instn) ; #o0372 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for PTagDpbHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation PTagDpbHW (instn) ; #o0373 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for LoopIncrementTosLessThanHW instruction $$$$ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation LoopIncrementTosLessThanHW (instn) ; #o0375 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for CatchOpenHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation CatchOpenHW (instn) ; #o0376 + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for SpareOpHW instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-halfword-translation SpareOpHW (instn) ;#o0377 + (do-default instn)) + + +;;; The fullword instructions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for constants +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation pushconstantvalue (instn) + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for nullfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation nullfw (instn) ; #o00 = DTP-NULL + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for monitorforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation monitorforwardfw (instn) ; #o01 = DTP-MONITOR-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for headerpfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation headerpfw (instn) ; #o02 = DTP-HEADER-P + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for headerifw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation headerifw (instn) ; #o03 = DTP-HEADER-I + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for valuecell instruction ???? +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation valuecell (instn) ; #o04 = DTP-EXTERNAL-VALUE-CELL-POINTER + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for oneqforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation oneqforwardfw (instn) ; #o05 = DTP-ONE-Q-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for headerforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation headerforwardfw (instn) ; #o06 = DTP-HEADER-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for elementforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation elementforwardfw (instn) ; #o07 = DTP-ELEMENT-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for boundlocationfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation boundlocationfw (instn) ; #o42 = DTP-BOUND-LOCATION + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for logicvariablefw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation logicvariablefw (instn) ; #o44 = DTP-LOGIC-VARIABLE + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for gcforwardfw instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation gcforwardfw (instn) ; #o45 = DTP-GC-FORWARD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledeven instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledeven (instn) ; #o50 = DTP-CALL-COMPILED-EVEN + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledodd instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledodd (instn) ; #o51 = DTP-CALL-COMPILED-ODD + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callindirect instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callindirect (instn) ; #o52 = DTP-CALL-INDIRECT + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callgeneric instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callgeneric (instn) ; #o53 = DTP-CALL-GENERIC + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledevenprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledevenprefetch (instn) ; #o54 = DTP-CALL-COMPILED-EVEN-PREFETCH + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callcompiledoddprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callcompiledoddprefetch (instn) ; #o55 = DTP-CALL-COMPILED-ODD-PREFETCH + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callindirectprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callindirectprefetch (instn) ; #o56 = DTP-CALL-INDIRECT-PREFETCH + (do-default instn)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for callgenericprefetch instruction +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation callgenericprefetch (instn) ; #o57 = DTP-CALL-GENERIC-PREFETCH + (do-default instn)) + + + +;;; New Instructions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; Translation support for fullword instructions. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(def-fullword-translation nativeinstruction (instn) ; #o37 = DTP-NATIVE-INSTRUCTION + (do-default instn)) + + +#|| +;;; test code. +(proclaim '(translated-function fib)) +(defun fib (n) + (declare (translated-function)) + (let ((m 1) (q 1)) + (dotimes (i (- n 2)) + (let ((nv (+ m q))) + (setq m q) + (setq q nv))) + q)) +||# + +(defun tfib (n) + (let ((m 1) (q 1)) + (dotimes (i (- n 2)) + (let ((nv (+ m q))) + (setq m q) + (setq q nv))) + q)) + +#|| Compiles into +Command: (disassemble 'fib) + 0 ENTRY: 1 REQUIRED, 0 OPTIONAL ;Creating N + 2 PUSH 1 ;Creating M + 3 PUSH 1 ;Creating Q + 4 PUSH FP|2 ;N + 5 SUB 2 + 6 PLUSP FP|5 + 7 BRANCH-FALSE-AND-EXTRA-POP 17 + 10 PUSH FP|3 ;M + 11 ADD FP|4 ;Q Creating NV + 12 PUSH FP|4 ;Q + 13 POP FP|3 ;M + 14 POP FP|4 ;Q + 15 LOOP-DECREMENT-TOS 10 + 16 SET-SP-TO-ADDRESS SP|-1 + 17 RETURN-SINGLE-STACK +||# + +;;; Fin. + + +1;(defun my-car (x) (declare (axpi::translated-function)) (car x)) + +;(defun not-my-car (x) (car x)) + +;(defun my-cadr (x) (declare (axpi::translated-function)) (car (cdr x))) + +;(defun foo (x) (declare (axpi::translated-function)) +; (if (zerop x) 1 2)) \ No newline at end of file diff --git a/unlock.lisp b/unlock.lisp new file mode 100644 index 0000000..2fbcc1f --- /dev/null +++ b/unlock.lisp @@ -0,0 +1,5 @@ + +(defmacro unlock-package (pack) + `(eval-when (:compile-toplevel) + (setf *locked-package-saved-value* (ext:package-lock ,pack) + (ext:package-lock ,pack) nill))) diff --git a/x86_64-emulator/aistat.h b/x86_64-emulator/aistat.h new file mode 100644 index 0000000..8286e12 --- /dev/null +++ b/x86_64-emulator/aistat.h @@ -0,0 +1,326 @@ +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid Any changes made to it will be lost. */ + +#ifndef _AISTAT_ +#define _AISTAT_ + + + +typedef struct processorstate { + uint64_t transpare3; + uint64_t transpare2; + uint64_t transpare1; + uint64_t carcdrsubroutine; + uint64_t cdrsubroutine; + uint64_t carsubroutine; + uint64_t linkage; + uint64_t resumeema; + char *statistics; + char *trace_hook; + int64_t instruction_count; + uint64_t long_pad0; + uint64_t asrr9; + uint64_t asrr10; + uint64_t asrr11; + uint64_t asrr12; + uint64_t asrr13; + uint64_t asrr14; + uint64_t asrr15; + uint64_t long_pad1; + uint64_t asrr26; + uint64_t asrr27; + uint64_t asrr29; + uint64_t asrr30; + uint64_t asrf2; + uint64_t asrf3; + uint64_t asrf4; + uint64_t asrf5; + uint64_t asrf6; + uint64_t asrf7; + uint64_t asrf8; + uint64_t asrf9; + char *meterdatabuff; + uint32_t meterpos; + uint32_t metermax; + uint32_t meterfreq; + uint32_t metermask; + uint32_t metervalue; + uint32_t metercount; + uint64_t choiceptr; + uint64_t sstkchoiceptr; + uint64_t dbcbase; + uint64_t dbcmask; + char *coprocessorreadhook; + char *coprocessorwritehook; + char *flushcaches_hook; + char *i_stage_error_hook; + uint64_t sfp1; + uint64_t fp0; + uint64_t fp1; + uint64_t floating_exception; + uint64_t aluandrotatecontrol; + uint64_t rotatelatch; + uint64_t aluborrow; + uint64_t aluoverflow; + uint64_t alulessthan; + uint64_t aluop; + uint64_t byterotate; + uint64_t bytesize; + int64_t bindingstacklimit; + int64_t bindingstackpointer; + uint64_t catchblock; + uint64_t extraandcatch; + uint64_t msclockcache; + uint64_t mscmultiplier; + uint64_t previousrcpp; + char *rlink; + uint32_t interruptreg; + uint32_t zoneoldspace; + uint32_t ephemeraloldspace; + uint32_t int_pad0; + uint64_t eqnoteql; + uint32_t lclength; + uint32_t sclength; + uint64_t lcarea; + uint64_t lcaddress; + uint64_t scarea; + uint64_t scaddress; + uint64_t restartsp; + uint64_t stop_interpreter; + uint64_t immediate_arg; + uint64_t continuationcp; + int64_t continuation; + int64_t control; + int64_t niladdress; + int64_t taddress; + int64_t bar0; + int64_t bar1; + int64_t bar2; + int64_t bar3; + int64_t epc; + int64_t fp; + int64_t lp; + int64_t sp; + char *cp; + uint64_t fccrmask; + uint32_t cslimit; + uint32_t csextralimit; + char *trapmeterdata; + uint64_t fepmodetrapvecaddress; + uint64_t trapvecbase; + uint64_t tvi; + uint64_t fccrtrapmask; + char *ptrtype; + char *vmattributetable; + uint64_t vma; + int64_t mostnegativefixnum; + char *icachebase; + char *endicache; + uint64_t fullworddispatch; + uint64_t halfworddispatch; + int64_t areventcount; + uint64_t stackcachesize; + uint64_t stackcachetopvma; + uint64_t cdrcodemask; + char *stackcachedata; + uint64_t stackcachebasevma; + uint32_t scovlimit; + uint32_t scovdumpcount; + int64_t mostpositivefixnum; + uint64_t internalregisterread1; + uint64_t internalregisterread2; + uint64_t internalregisterwrite1; + uint64_t internalregisterwrite2; + uint64_t dataread_mask; + char *dataread; + uint64_t datawrite_mask; + char *datawrite; + uint64_t bindread_mask; + char *bindread; + uint64_t bindwrite_mask; + char *bindwrite; + uint64_t bindreadnomonitor_mask; + char *bindreadnomonitor; + uint64_t bindwritenomonitor_mask; + char *bindwritenomonitor; + uint64_t header_mask; + char *header; + uint64_t structureoffset_mask; + char *structureoffset; + uint64_t scavenge_mask; + char *scavenge; + uint64_t cdr_mask; + char *cdr; + uint64_t gccopy_mask; + char *gccopy; + uint64_t raw_mask; + char *raw; + uint64_t rawtranslate_mask; + char *rawtranslate; + int32_t please_stop; + int32_t please_trap; + int64_t runningp; + uint64_t ac0array; + uint64_t ac0arword; + uint64_t ac0locat; + uint64_t ac0length; + uint64_t ac1array; + uint64_t ac1arword; + uint64_t ac1locat; + uint64_t ac1length; + uint64_t ac2array; + uint64_t ac2arword; + uint64_t ac2locat; + uint64_t ac2length; + uint64_t ac3array; + uint64_t ac3arword; + uint64_t ac3locat; + uint64_t ac3length; + uint64_t ac4array; + uint64_t ac4arword; + uint64_t ac4locat; + uint64_t ac4length; + uint64_t ac5array; + uint64_t ac5arword; + uint64_t ac5locat; + uint64_t ac5length; + uint64_t ac6array; + uint64_t ac6arword; + uint64_t ac6locat; + uint64_t ac6length; + uint64_t ac7array; + uint64_t ac7arword; + uint64_t ac7locat; + uint64_t ac7length; + uint32_t tmcurrenttransaction; + uint32_t tmwritestart; + uint32_t tmwritecurrent; + uint32_t tmwritelimit; + uint32_t tmrecordingreads; + uint32_t tmreadstart; + uint32_t tmreadcurrent; + uint32_t tmreadlimit; + } PROCESSORSTATE, *PROCESSORSTATEP; + +#define PROCESSORSTATE_SIZE 1440 + +typedef struct cacheline { + uint64_t annotation; + uint32_t nextpcdata; + uint32_t nextpctag; + char *nextcp; + uint32_t instruction; + uint32_t operand; + uint32_t pcdata; + uint32_t pctag; + char *code; + } CACHELINE, *CACHELINEP; + +#define CACHELINE_SIZE 48 + +#define CacheLine_Bits 18 + +#define CacheLine_Mask 262143 + +#define CacheLine_RShift 16 + +#define CacheLine_LShift 6 + +#define CacheLine_FillAmount 20 + +typedef struct arraycache { + uint64_t array; + uint64_t arword; + uint64_t locat; + uint64_t length; + } ARRAYCACHE, *ARRAYCACHEP; + +#define AutoArrayReg_Mask 224 + +#define AutoArrayReg_Size 32 + +#define AutoArrayReg_Shift 0 + +#define MSclock_UnitsToMSShift 24 + +#define MSclock_UnitsPerMicrosecond 16777216 + +#define Stack_CacheSize 1792 + +#define Stack_MaxFrameSize 128 + +#define Stack_CacheMargin 128 + +#define Stack_CacheDumpQuantum 896 + +#define IvoryMemory_Data 35 + +#define IvoryMemory_Tag 33 + +typedef struct savedregisters { + uint64_t r9; + uint64_t r10; + uint64_t r11; + uint64_t r12; + uint64_t r13; + uint64_t r14; + uint64_t r15; + uint64_t r29; + uint64_t f2; + uint64_t f3; + uint64_t f4; + uint64_t f5; + uint64_t f6; + uint64_t f7; + uint64_t f8; + uint64_t f9; + } SAVEDREGISTERS, *SAVEDREGISTERSP; + +#define SAVEDREGISTERS_SIZE 128 + +typedef struct tracedata { + uint64_t n_entries; + uint32_t recording_p; + uint32_t wrap_p; + uint64_t start_pc; + uint64_t stop_pc; + char *records_start; + char *records_end; + char *current_entry; + char *printer; + } TRACEDATA, *TRACEDATAP; + +#define TRACEDATA_SIZE 64 + +typedef struct tracerecord { + uint64_t counter; + uint64_t epc; + uint64_t tos; + uint64_t sp; + char *instruction; + uint64_t instruction_data; + uint32_t operand; + uint32_t trap_p; + uint64_t trap_data_0; + uint64_t trap_data_1; + uint64_t trap_data_2; + uint64_t trap_data_3; + uint32_t catch_block_p; + uint32_t int_pad0; + uint64_t catch_block_0; + uint64_t catch_block_1; + uint64_t catch_block_2; + uint64_t catch_block_3; + } TRACERECORD, *TRACERECORDP; + +#define TRACERECORD_SIZE 128 + +#define CacheMeter_Pwr 14 + +#define CacheMeter_DefaultFreq 1000 +/* WARNING!! DO NOT MODIFY THIS FILE! */ +/* It was automatically generated from vlm:alpha-emulator;aistat.sid Any changes made to it will be lost. */ + +#endif + +