My first initial commit with all of mine experimental changes.

Dmitry Kabak (userdima committed 13 years ago

Commit d37b88d1 parent 3f5b46618352 files · +2598093 −-8690Browse files

Showing the changes to java/appl/java (19 of 18352 files). Show all

Unified · Split

19 files

java/appl/java/cast.base +53 −0
java/appl/java/cast.s +53 −0
java/appl/java/castproto.b +144 −0
java/appl/java/classloader.b +3452 −0
java/appl/java/dump.b +216 −0
java/appl/java/javaassist.base +148 −0
java/appl/java/javaassist.s +148 −0
java/appl/java/javaassistproto.b +261 −0
java/appl/java/javanative.b +32 −0
java/appl/java/javatrace.b +66 −0
java/appl/java/jinfo.b +25 −0
java/appl/java/jni.b +1735 −0
java/appl/java/jvm.b +142 −0
java/appl/java/low.base +140 −0
java/appl/java/low.s +140 −0
java/appl/java/lowproto.b +65 −0
java/appl/java/mkfile +45 −0
java/appl/java/sign.sed +38 −0
java/appl/java/sign.sh +6 −0

@@ -0,0 +1,53 @@
	1	+#0
	2	+ movp 32(fp),0(16(fp))
	3	+ ret
	4	+ desc $0,0,""
	5	+ desc $1,40,"0080"
	6	+ var @mp,0
	7	+ module Cast
	8	+# cast to JObject
	9	+ link 1,0,0xaaaaaaaa,"FromJArray"
	10	+ link 1,0,0xaaaaaaaa,"FromJClass"
	11	+ link 1,0,0xaaaaaaaa,"FromJString"
	12	+# cast JArray* to JArray
	13	+ link 1,0,0xaaaaaaaa,"ByteToJArray"
	14	+ link 1,0,0xaaaaaaaa,"IntToJArray"
	15	+ link 1,0,0xaaaaaaaa,"BigToJArray"
	16	+ link 1,0,0xaaaaaaaa,"RealToJArray"
	17	+ link 1,0,0xaaaaaaaa,"ClassToJArray"
	18	+ link 1,0,0xaaaaaaaa,"StringToJArray"
	19	+ link 1,0,0xaaaaaaaa,"ObjectToJArray"
	20	+# cast JArray to JArray*
	21	+ link 1,0,0xaaaaaaaa,"JArrayToByte"
	22	+ link 1,0,0xaaaaaaaa,"JArrayToInt"
	23	+ link 1,0,0xaaaaaaaa,"JArrayToBig"
	24	+ link 1,0,0xaaaaaaaa,"JArrayToReal"
	25	+ link 1,0,0xaaaaaaaa,"JArrayToClass"
	26	+ link 1,0,0xaaaaaaaa,"JArrayToString"
	27	+ link 1,0,0xaaaaaaaa,"JArrayToObject"
	28	+
	29	+# cast from JObject
	30	+ link 1,0,0xaaaaaaaa,"ToJArray"
	31	+ link 1,0,0xaaaaaaaa,"ToJArrayB"
	32	+ link 1,0,0xaaaaaaaa,"ToJArrayC"
	33	+ link 1,0,0xaaaaaaaa,"ToJArrayS"
	34	+ link 1,0,0xaaaaaaaa,"ToJArrayI"
	35	+ link 1,0,0xaaaaaaaa,"ToJArrayJ"
	36	+ link 1,0,0xaaaaaaaa,"ToJArrayF"
	37	+ link 1,0,0xaaaaaaaa,"ToJArrayD"
	38	+ link 1,0,0xaaaaaaaa,"ToJArrayZ"
	39	+ link 1,0,0xaaaaaaaa,"ToJArrayJString"
	40	+ link 1,0,0xaaaaaaaa,"ToJArrayJObject"
	41	+ link 1,0,0xaaaaaaaa,"ToJClass"
	42	+ link 1,0,0xaaaaaaaa,"ToJString"
	43	+
	44	+# cast thread data
	45	+ link 1,0,0xaaaaaaaa,"JObjToJThd"
	46	+ link 1,0,0xaaaaaaaa,"JThdToJObj"
	47	+
	48	+# misc cast
	49	+ link 1,0,0xaaaaaaaa,"Class2Niladt"
	50	+ link 1,0,0xaaaaaaaa,"Obj2Niladt"
	51	+ link 1,0,0xaaaaaaaa,"JNI2Nilmod"
	52	+ link 1,0,0xaaaaaaaa,"JArrayToHolder"
	53	+

java/appl/java/cast.s+53−0

@@ -0,0 +1,53 @@
	1	+#0
	2	+ movp 32(fp),0(16(fp))
	3	+ ret
	4	+ desc $0,0,""
	5	+ desc $1,40,"0080"
	6	+ var @mp,0
	7	+ module Cast
	8	+# cast to JObject
	9	+ link 1,0,0xb8ed9861,"FromJArray"
	10	+ link 1,0,0xb8884c9a,"FromJClass"
	11	+ link 1,0,0x76cd0754,"FromJString"
	12	+# cast JArray* to JArray
	13	+ link 1,0,0x308d465a,"ByteToJArray"
	14	+ link 1,0,0x54d1047d,"IntToJArray"
	15	+ link 1,0,0x8943ab,"BigToJArray"
	16	+ link 1,0,0xf7ce22ea,"RealToJArray"
	17	+ link 1,0,0x7e0e257a,"ClassToJArray"
	18	+ link 1,0,0xf0709f5f,"StringToJArray"
	19	+ link 1,0,0x5e96bb51,"ObjectToJArray"
	20	+# cast JArray to JArray*
	21	+ link 1,0,0xdab35b9b,"JArrayToByte"
	22	+ link 1,0,0xdfce047b,"JArrayToInt"
	23	+ link 1,0,0x8b84c7a8,"JArrayToBig"
	24	+ link 1,0,0x7960d11,"JArrayToReal"
	25	+ link 1,0,0xdaebabf,"JArrayToClass"
	26	+ link 1,0,0x1102d2ef,"JArrayToString"
	27	+ link 1,0,0x14d3cbb9,"JArrayToObject"
	28	+
	29	+# cast from JObject
	30	+ link 1,0,0x6d675ef6,"ToJArray"
	31	+ link 1,0,0xe0b15252,"ToJArrayB"
	32	+ link 1,0,0x32346c9,"ToJArrayC"
	33	+ link 1,0,0x32346c9,"ToJArrayS"
	34	+ link 1,0,0x32346c9,"ToJArrayI"
	35	+ link 1,0,0xdea604f9,"ToJArrayJ"
	36	+ link 1,0,0x5cde7840,"ToJArrayF"
	37	+ link 1,0,0x5cde7840,"ToJArrayD"
	38	+ link 1,0,0xe0b15252,"ToJArrayZ"
	39	+ link 1,0,0xe6e32a84,"ToJArrayJString"
	40	+ link 1,0,0x4cbbe2c3,"ToJArrayJObject"
	41	+ link 1,0,0x424af2d7,"ToJClass"
	42	+ link 1,0,0x4fd3acd0,"ToJString"
	43	+
	44	+# cast thread data
	45	+ link 1,0,0x52e73674,"JObjToJThd"
	46	+ link 1,0,0x7e48ea3a,"JThdToJObj"
	47	+
	48	+# misc cast
	49	+ link 1,0,0x2b7b0708,"Class2Niladt"
	50	+ link 1,0,0x2e1c372c,"Obj2Niladt"
	51	+ link 1,0,0x69964565,"JNI2Nilmod"
	52	+ link 1,0,0xe04c9ec8,"JArrayToHolder"
	53	+

java/appl/java/castproto.b+144−0

@@ -0,0 +1,144 @@
	1	+#
	2	+# this file contains stubs for the fcts
	3	+# declared in cast.m. This file is
	4	+# run through the limbo compiler in order
	5	+# to obtain valid funtion signatures which
	6	+# are then combined with cast.base (the
	7	+# dis assmebly code) to produce a valid
	8	+# cast.s. The generated cast.s will contain
	9	+# the code from cast.base and the correct
	10	+# function signatures generated by limbo
	11	+# and this file. cast.s is then run through
	12	+# the assembler to produce cast.dis.
	13	+# weird, but it works.
	14	+#
	15	+implement Cast;
	16	+
	17	+include "jni.m";
	18	+
	19	+
	20	+#
	21	+# to JObject
	22	+#
	23	+FromJArray( o : JNI->JArray ) : JNI->JObject
	24	+{ junk := o; return(nil); }
	25	+
	26	+FromJClass( o : JNI->JClass ) : JNI->JObject
	27	+{ junk := o; return(nil); }
	28	+
	29	+FromJString( o : JNI->JString ) : JNI->JObject
	30	+{ junk := o; return(nil); }
	31	+
	32	+#
	33	+# cast JArray* to JArray
	34	+#
	35	+ByteToJArray( o : ref JNI->ByteArray ) : JNI->JArray
	36	+{ junk := o; return(nil); }
	37	+
	38	+IntToJArray( o : ref JNI->IntArray ) : JNI->JArray
	39	+{ junk := o; return(nil); }
	40	+
	41	+BigToJArray( o : ref JNI->BigArray ) : JNI->JArray
	42	+{ junk := o; return(nil); }
	43	+
	44	+RealToJArray( o : ref JNI->RealArray ) : JNI->JArray
	45	+{ junk := o; return(nil); }
	46	+
	47	+ClassToJArray( o : ref JNI->ClassArray ) : JNI->JArray
	48	+{ junk := o; return(nil); }
	49	+
	50	+StringToJArray( o : ref JNI->StringArray ) : JNI->JArray
	51	+{ junk := o; return(nil); }
	52	+
	53	+ObjectToJArray( o : ref JNI->ObjectArray ) : JNI->JArray
	54	+{ junk := o; return(nil); }
	55	+
	56	+#
	57	+# cast JArray to JArray*
	58	+#
	59	+JArrayToByte( ptr : JNI->JArray ) : ref JNI->ByteArray
	60	+{ junk := ptr; return(nil); }
	61	+
	62	+JArrayToInt( ptr : JNI->JArray ) : ref JNI->IntArray
	63	+{ junk := ptr; return(nil); }
	64	+
	65	+JArrayToBig( ptr : JNI->JArray ) : ref JNI->BigArray
	66	+{ junk := ptr; return(nil); }
	67	+
	68	+JArrayToReal( ptr : JNI->JArray ) : ref JNI->RealArray
	69	+{ junk := ptr; return(nil); }
	70	+
	71	+JArrayToClass( ptr : JNI->JArray ) : ref JNI->ClassArray
	72	+{ junk := ptr; return(nil); }
	73	+
	74	+JArrayToString( ptr : JNI->JArray ) : ref JNI->StringArray
	75	+{ junk := ptr; return(nil); }
	76	+
	77	+JArrayToObject( ptr : JNI->JArray ) : ref JNI->ObjectArray
	78	+{ junk := ptr; return(nil); }
	79	+
	80	+
	81	+#
	82	+# cast from JObjects
	83	+#
	84	+ToJClass( o : JNI->JObject ) : JNI->JClass
	85	+{ junk := o; return(nil); }
	86	+
	87	+ToJString( o : JNI->JObject ) : JNI->JString
	88	+{ junk := o; return(nil); }
	89	+
	90	+ToJArray( o : JNI->JObject ) : JNI->JArray
	91	+{ junk := o; return(nil); }
	92	+
	93	+ToJArrayB( o : JNI->JObject ) : JNI->JArrayB
	94	+{ junk := o; return(nil); }
	95	+
	96	+ToJArrayC( o : JNI->JObject ) : JNI->JArrayC
	97	+{ junk := o; return(nil); }
	98	+
	99	+ToJArrayS( o : JNI->JObject ) : JNI->JArrayS
	100	+{ junk := o; return(nil); }
	101	+
	102	+ToJArrayI( o : JNI->JObject ) : JNI->JArrayI
	103	+{ junk := o; return(nil); }
	104	+
	105	+ToJArrayJ( o : JNI->JObject ) : JNI->JArrayJ
	106	+{ junk := o; return(nil); }
	107	+
	108	+ToJArrayF( o : JNI->JObject ) : JNI->JArrayF
	109	+{ junk := o; return(nil); }
	110	+
	111	+ToJArrayD( o : JNI->JObject ) : JNI->JArrayD
	112	+{ junk := o; return(nil); }
	113	+
	114	+ToJArrayZ( o : JNI->JObject ) : JNI->JArrayZ
	115	+{ junk := o; return(nil); }
	116	+
	117	+ToJArrayJString( o : JNI->JObject ) : JNI->JArrayJString
	118	+{ junk := o; return(nil); }
	119	+
	120	+ToJArrayJObject( o : JNI->JObject ) : JNI->JArrayJObject
	121	+{ junk := o; return(nil); }
	122	+
	123	+#
	124	+# cast for thread data
	125	+JObjToJThd( o : JNI->JObject ) : (JNI->JThread)
	126	+{ junk := o; return(nil); }
	127	+
	128	+JThdToJObj( o : JNI->JThread ) : (JNI->JObject)
	129	+{ junk := o; return(nil); }
	130	+
	131	+#
	132	+# misc casts
	133	+#
	134	+Class2Niladt( o : JNI->ClassData ) : ref Loader->Niladt
	135	+{ junk := o; return(nil); }
	136	+
	137	+Obj2Niladt( o : JNI->JObject ) : ref Loader->Niladt
	138	+{ junk := o; return(nil); }
	139	+
	140	+JNI2Nilmod( o : JNI ) : Nilmod
	141	+{ junk := o; return(nil); }
	142	+
	143	+JArrayToHolder( o : array of JNI->JArray ) : array of JNI->JString
	144	+{ junk := o; return(nil); }

java/appl/java/classloader.b+3452−0

@@ -0,0 +1,3452 @@
	1	+implement JavaClassLoader;
	2	+
	3	+#
	4	+# Java Class Loader.
	5	+#
	6	+
	7	+include "sys.m";
	8	+ sys: Sys;
	9	+
	10	+stderr: ref Sys->FD;
	11	+
	12	+include "keyring.m";
	13	+ kr: Keyring;
	14	+
	15	+include "string.m";
	16	+ str: String;
	17	+
	18	+include "math.m";
	19	+ math: Math;
	20	+
	21	+include "hash.m";
	22	+ hash: Hash;
	23	+
	24	+include "loader.m";
	25	+include "classloader.m";
	26	+ ld: Loader;
	27	+ Niladt: import Loader;
	28	+ jassist: JavaAssist;
	29	+ jtrace: JavaTrace;
	30	+
	31	+ JDEBUG, JVERBOSE: import JavaTrace;
	32	+
	33	+ getint, getintarray, getptr: import jassist;
	34	+ getreloc, getrtreloc, getstring: import jassist;
	35	+ getclassadt, getabsint, getadtstring: import jassist;
	36	+ getbytearray, getstrarray, arrayof: import jassist;
	37	+ getmd, putclass, putint, putmod: import jassist;
	38	+ putobj, putptr, putstring, makeadt: import jassist;
	39	+ bytearraytoJS, intarraytoJS: import jassist;
	40	+ bigarraytoJS, realarraytoJS: import jassist;
	41	+ ArraytoJS, JStoObject: import jassist;
	42	+
	43	+this: JavaClassLoader;
	44	+thisnil: Nilmod;
	45	+sysnil: Nilmod;
	46	+loadlinks: array of Loader->Link;
	47	+syslinks: array of Loader->Link;
	48	+relocs: list of ref Class;
	49	+relocd: list of ref Class;
	50	+interf: list of ref Class;
	51	+interfx: list of ref Class;
	52	+initcl: list of ref Class;
	53	+main: ref Class;
	54	+arrayclass: ref Class;
	55	+arraymd: ref Loader->Niladt;
	56	+stringclass: ref Class;
	57	+fsindir: int;
	58	+cur: string;
	59	+
	60	+interfaces: array of ref Class;
	61	+ninterfaces: int = 0;
	62	+linterfaces: int = 0;
	63	+
	64	+INITINTER: con 32;
	65	+
	66	+acqchan: chan of int;
	67	+relchan: chan of int;
	68	+exitchan: chan of int;
	69	+
	70	+MSHUTDOWN, MENTER, MEXIT, MWAIT, MNOTIFY, MSLEEP, MINTERRUPT, MTIMER, MSYNC:
	71	+ con iota;
	72	+
	73	+monitorctl: chan of (int, ref ThreadData, ref Object, int);
	74	+threadctl: chan of (ref ThreadData, int);
	75	+
	76	+threadcount: int = 0;
	77	+daemoncount: int = 0;
	78	+stopped: int = 0;
	79	+
	80	+ident: con "ClassLoader";
	81	+warn: int = 1;
	82	+debug: int = 0;
	83	+verbose: int = 0;
	84	+errors: int = 0;
	85	+
	86	+# for generating ClassLoader exceptions use
	87	+# the following con's. They will be turned
	88	+# into a corresponding Java Exception by
	89	+# sysexcetion
	90	+# when thrown the format is:
	91	+# raise( ex +":"+detail );
	92	+# see loaderror();
	93	+#
	94	+# NOTE: the "raise" string has limited size
	95	+# hence the "e"+<int>
	96	+#
	97	+JCLDREX : con "JLD:"; #prefix
	98	+noclassdeffound,
	99	+classcircularity,
	100	+classformat,
	101	+nosuchmethod,
	102	+nosuchfield,
	103	+unsatisfiedlink,
	104	+linkageerr,
	105	+exceptionininitializer
	106	+ : con "e" + (string iota);
	107	+
	108	+badcallindex : con "call index";
	109	+nocloneindex : con "clone index";
	110	+
	111	+encoding := array[] of
	112	+{
	113	+ 'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H',
	114	+ 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P',
	115	+ 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X',
	116	+ 'Y', 'Z', 'a', 'b', 'c', 'd', 'e', 'f',
	117	+ 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n',
	118	+ 'o', 'p', 'q', 'r', 's', 't', 'u', 'v',
	119	+ 'w', 'x', 'y', 'z', '0', '1', '2', '3',
	120	+ '4', '5', '6', '7', '8', '9', '+', '-',
	121	+};
	122	+
	123	+bits := array[] of { 16r80, 16r40, 16r20, 16r10, 16r08, 16r04, 16r02, 16r01 };
	124	+mbits := array[] of { 16r80, 16r20, 16r08, 16r02 };
	125	+
	126	+#
	127	+# Diagnostics.
	128	+#
	129	+
	130	+mesg(s: string)
	131	+{
	132	+ sys->fprint(stderr, "%s: %s\n", ident, s);
	133	+}
	134	+
	135	+diag(s: string)
	136	+{
	137	+ if (cur != nil)
	138	+ s = cur + ": " + s;
	139	+ mesg(s);
	140	+ errors++;
	141	+}
	142	+
	143	+loaderror( ex : string, msg : string )
	144	+{
	145	+ s := msg;
	146	+
	147	+ # if prefix exists then just rethrow msg
	148	+ if ( str->prefix( JCLDREX+ex, msg ) == 0 )
	149	+ {
	150	+ if ( cur != nil )
	151	+ s = cur +": " + s;
	152	+
	153	+ s = sys->sprint( "%s%s:%s", JCLDREX, ex, s );
	154	+ }
	155	+
	156	+ trace(JDEBUG,s);
	157	+
	158	+ raise s;
	159	+}
	160	+
	161	+error(s: string)
	162	+{
	163	+ if ( s == nil )
	164	+ s = JCLDREX + "fatal error";
	165	+ else
	166	+ {
	167	+ # if prefix exists then just re-throw s
	168	+ if ( str->prefix(JCLDREX,s) == 0 )
	169	+ {
	170	+ # add prefix to tag as a Loader ex
	171	+ s = sys->sprint( "%s%s:%s", JCLDREX, s, cur );
	172	+ }
	173	+ }
	174	+
	175	+ trace(JDEBUG,s);
	176	+
	177	+ raise s;
	178	+}
	179	+
	180	+warning(s: string)
	181	+{
	182	+ if (!warn)
	183	+ return;
	184	+ if (cur != nil)
	185	+ s = cur + ": " + s;
	186	+ sys->fprint(stderr, "%s: warning: %s\n", ident, s);
	187	+}
	188	+
	189	+trace(c: int, s: string)
	190	+{
	191	+ if (jtrace != nil)
	192	+ jtrace->trace(c, s);
	193	+}
	194	+
	195	+loadtrace()
	196	+{
	197	+ if (jtrace != nil)
	198	+ return;
	199	+ jtrace = load JavaTrace JavaTrace->PATH;
	200	+ if (jtrace == nil)
	201	+ error(sys->sprint("could not load %s: %r", JavaTrace->PATH));
	202	+ jtrace->init(jassist);
	203	+}
	204	+
	205	+#
	206	+# Load synchronization. Allow only one thread to be loading at a time.
	207	+#
	208	+
	209	+loadsync()
	210	+{
	211	+ for (;;) {
	212	+ alt {
	213	+ <- acqchan =>
	214	+ ;
	215	+ <- exitchan =>
	216	+ return;
	217	+ }
	218	+ alt {
	219	+ <- relchan =>
	220	+ ;
	221	+ <- exitchan =>
	222	+ return;
	223	+ }
	224	+ }
	225	+}
	226	+
	227	+acquire()
	228	+{
	229	+ acqchan <-= 0;
	230	+}
	231	+
	232	+release()
	233	+{
	234	+ relchan <-= 0;
	235	+}
	236	+
	237	+context: ref Draw->Context;
	238	+
	239	+#
	240	+# Initialize loader. Entry.
	241	+#
	242	+init(j: JavaClassLoader, ctxt: ref Draw->Context)
	243	+{
	244	+ sys = load Sys Sys->PATH;
	245	+ stderr = sys->fildes(2);
	246	+ context = ctxt;
	247	+ kr = load Keyring Keyring->PATH;
	248	+ if (kr == nil)
	249	+ error(sys->sprint("could not load %s: %r", Keyring->PATH));
	250	+ str = load String String->PATH;
	251	+ if (str == nil)
	252	+ error(sys->sprint("could not load %s: %r", String->PATH));
	253	+ math = load Math Math->PATH;
	254	+ if (math == nil)
	255	+ error(sys->sprint("could not load %s: %r", Math->PATH));
	256	+ math->FPcontrol(0, Math->INVAL\|Math->ZDIV\|Math->OVFL\|Math->UNFL\|Math->INEX);
	257	+ hash = load Hash Hash->PATH;
	258	+ if (hash == nil)
	259	+ error(sys->sprint("could not load %s: %r", Hash->PATH));
	260	+ ld = load Loader Loader->PATH;
	261	+ if (ld == nil)
	262	+ error(sys->sprint("could not load %s: %r", Loader->PATH));
	263	+ jassist = load JavaAssist JavaAssist->PATH;
	264	+ if (jassist == nil)
	265	+ error(sys->sprint("could not load %s: %r", JavaAssist->PATH));
	266	+ if (verbose) {
	267	+ loadtrace();
	268	+ if (debug)
	269	+ jtrace->level = JDEBUG;
	270	+ else
	271	+ jtrace->level = JVERBOSE;
	272	+ }
	273	+ fsindir = jassist->little_endian();
	274	+ this = j;
	275	+ thisnil = jassist->jclnilmod(j);
	276	+ sysnil = jassist->sysnilmod(sys);
	277	+ loadlinks = ld->link(thisnil);
	278	+ syslinks = ld->link(sysnil);
	279	+ if (loadlinks == nil \|\| syslinks == nil)
	280	+ error(sys->sprint("Loader->link failed: %r"));
	281	+ initloadhash();
	282	+ acqchan = chan of int;
	283	+ relchan = chan of int;
	284	+ exitchan = chan of int;
	285	+ spawn loadsync();
	286	+ monitorctl = chan of (int, ref ThreadData, ref Object, int);
	287	+ spawn monitor();
	288	+ threadctl = chan of (ref ThreadData, int);
	289	+ spawn threadmanager();
	290	+ jniinit();
	291	+}
	292	+
	293	+loadarrayclass()
	294	+{
	295	+ arrayclass = loader(ARRAYCLASS);
	296	+ arraymd = arrayclass.moddata;
	297	+}
	298	+
	299	+loadstringclass()
	300	+{
	301	+ stringclass = loader(STRINGCLASS);
	302	+}
	303	+
	304	+#
	305	+# Native interface initialization.
	306	+#
	307	+jniinit()
	308	+{
	309	+ j := load JavaNative JavaNative->PATH;
	310	+ if (j == nil)
	311	+ error(sys->sprint("could not load %s: %r", JavaNative->PATH));
	312	+ e := j->init(sys, ld, this, jassist);
	313	+ if (e != nil)
	314	+ error(sys->sprint("JavaNative->init failed: %s", e));
	315	+}
	316	+
	317	+#
	318	+# Shutdown loader. Entry.
	319	+#
	320	+shutdown()
	321	+{
	322	+ if (exitchan != nil) {
	323	+ exitchan <-= 0;
	324	+ exitchan = nil;
	325	+ }
	326	+ if (monitorctl != nil) {
	327	+ monitorctl <-= (MSHUTDOWN, nil, nil, 0);
	328	+ monitorctl = nil;
	329	+ }
	330	+ if (threadctl != nil) {
	331	+ threadctl <-= (nil, ThreadData.SHUTDOWN);
	332	+ threadctl = nil;
	333	+ }
	334	+}
	335	+
	336	+#
	337	+# Load a class and print information about it.
	338	+# Does not resolve the class and should not be
	339	+# called in the execution environment. Entry.
	340	+#
	341	+info(name: string)
	342	+{
	343	+ c := getclass(name);
	344	+ if (c.state == NEW)
	345	+ c.loadclass();
	346	+ loadtrace();
	347	+ jtrace->info(c);
	348	+}
	349	+
	350	+#
	351	+# Perform outstanding relocation on loaded classes.
	352	+#
	353	+doreloc()
	354	+{
	355	+ #
	356	+ # Load classes we need for relocation.
	357	+ #
	358	+ while (relocs != nil) {
	359	+ r: list of ref Class;
	360	+ r = nil;
	361	+ reloc := hd relocs;
	362	+ relocs = tl relocs;
	363	+ trace(JDEBUG, sys->sprint("reloc %s", reloc.name));
	364	+ i := CLASSREF;
	365	+ while ((s := getstring(reloc.mod, i)) != nil) {
	366	+ if (s != LOADER)
	367	+ r = loadhierarchy(s) :: r;
	368	+ else
	369	+ r = nil :: r;
	370	+ i += 2 * WORDZ;
	371	+ }
	372	+ reloc.refs = mkclarray(r);
	373	+ reloc.relocate();
	374	+ relocd = reloc :: relocd;
	375	+ }
	376	+ #
	377	+ # Patch the module data of the relocated classes.
	378	+ #
	379	+ while (relocd != nil) {
	380	+ patch := hd relocd;
	381	+ relocd = tl relocd;
	382	+ trace(JDEBUG, sys->sprint("modpatch %s", patch.name));
	383	+ patch.modpatch();
	384	+ if (patch.native != nil \|\| patch.classinit != nil) {
	385	+ initcl = patch :: initcl;
	386	+ patch.state = LOADED;
	387	+ } else
	388	+ patch.state = INITED;
	389	+ }
	390	+ #
	391	+ # Extend interfaces.
	392	+ #
	393	+ while (interfx != nil) {
	394	+ extend := hd interfx;
	395	+ interfx = tl interfx;
	396	+ extend.interdirect = extend.interextends;
	397	+ extend.extinterfaces();
	398	+ }
	399	+ #
	400	+ # Make interface linkage tables for classes that implement interfaces.
	401	+ #
	402	+ while (interf != nil) {
	403	+ inter := hd interf;
	404	+ interf = tl interf;
	405	+ inter.interdirect = inter.interextends;
	406	+ inter.linkinterfaces();
	407	+ }
	408	+ #
	409	+ # Call class initializers.
	410	+ #
	411	+ initc : ref Class;
	412	+ t : ref ThreadData;
	413	+
	414	+ {
	415	+ while (initcl != nil) {
	416	+ initc = hd initcl;
	417	+ initcl = tl initcl;
	418	+ initc.state = INITED;
	419	+ trace(JVERBOSE, sys->sprint("Switching class %s state to INITED", initc.name));
	420	+ t = getthreaddata();
	421	+ release();
	422	+ unblock(t);
	423	+ if (initc.native != nil)
	424	+ initc.initjni();
	425	+ if (initc.classinit != nil) {
	426	+ trace(JVERBOSE, sys->sprint("%s-><clinit>()", initc.name));
	427	+ jassist->mcall0(initc.mod, initc.classinit.value);
	428	+ trace(JDEBUG, sys->sprint("clinit done"));
	429	+ }
	430	+ block(t);
	431	+ acquire();
	432	+ }
	433	+ }
	434	+ exception e
	435	+ {
	436	+ "*" =>
	437	+ #NOTE: a raise is only expected from the init calls therefore
	438	+ # when we reach here we need to block and acquire
	439	+ block(t);
	440	+ acquire();
	441	+ trace(JVERBOSE, sys->sprint("Some exception: %s", e));
	442	+ if ( str->prefix(JCLDREX+exceptionininitializer, e ) == 1 )
	443	+ loaderror(exceptionininitializer, e ); #rethrow
	444	+ else
	445	+ {
	446	+ # clear any java exception; we are replacing it
	447	+ t.culprit = nil;
	448	+ loaderror(exceptionininitializer, sys->sprint("%s[unk]", initc.name));
	449	+ }
	450	+ }
	451	+}
	452	+
	453	+#
	454	+# Main "load class" routine. Load a class hierarchy and
	455	+# its dependencies and prepare it for use. Entry.
	456	+# No return on error.
	457	+#
	458	+loader(name: string): ref Class
	459	+{
	460	+ released := 0;
	461	+ t := getthreaddata();
	462	+ {
	463	+ trace(JDEBUG, sys->sprint("load class %s", name));
	464	+ block(t);
	465	+ acquire();
	466	+ c := loadhierarchy(name);
	467	+ if (relocs != nil)
	468	+ doreloc();
	469	+ release();
	470	+ unblock(t);
	471	+ released = 1;
	472	+ trace(JDEBUG, sys->sprint("loader() exit"));
	473	+# if (errors)
	474	+# error(nil);
	475	+ return c;
	476	+ }
	477	+ exception e
	478	+ {
	479	+ "*" =>
	480	+ if(released == 0) {
	481	+ release();
	482	+ unblock(t);
	483	+ }
	484	+ if (e == nil)
	485	+ e = "exit";
	486	+
	487	+ if ( str->prefix(JCLDREX, e) == 1 )
	488	+ error(e);
	489	+
	490	+ error( sys->sprint( "%s", e) );
	491	+
	492	+ #else if (e.name == noclassdeffound)
	493	+ #{
	494	+ # error(nil);
	495	+ #}
	496	+ #else
	497	+ # error(sys->sprint("loader exception: %s: %s: %d", e.mod, e.name, e.pc));
	498	+ }
	499	+ return nil;
	500	+}
	501	+
	502	+#
	503	+# Recursively load a hierarchy.
	504	+#
	505	+loadhierarchy(name: string): ref Class
	506	+{
	507	+ c := getclass(name);
	508	+ case c.state {
	509	+ NEW =>
	510	+ trace(JVERBOSE, sys->sprint("[%s]", name));
	511	+ c.loadclass();
	512	+ relocs = c :: relocs;
	513	+ if ((s := getstring(c.mod, SUPER)) != nil) {
	514	+ c.state = HIER;
	515	+ trace(JVERBOSE, sys->sprint("Switching class %s state to HIER", name));
	516	+ c.super = loadhierarchy(s);
	517	+ } else
	518	+ c.super = nil;
	519	+ c.state = RESOLVE;
	520	+ trace(JVERBOSE, sys->sprint("Switching class %s state to RESOLVE", name));
	521	+ c.resolve();
	522	+ c.loadinterfaces();
	523	+ HIER =>
	524	+ loaderror( classcircularity, name );
	525	+ }
	526	+ return c;
	527	+}
	528	+
	529	+#
	530	+# Check if a string matches exception,
	531	+# right aligned in string
	532	+#
	533	+matches(str, e: string): int
	534	+{
	535	+ if (len str >= len e && str[len str - len e:] == e)
	536	+ return 1;
	537	+ return 0;
	538	+}
	539	+
	540	+#
	541	+# Encode a class name path if its final component
	542	+# will be too long. Entry.
	543	+#
	544	+encodename(name: string): string
	545	+{
	546	+ (dir, base) := str->splitr(name, "/");
	547	+ b := array of byte base;
	548	+ if (len b <= MAXUNENCODED)
	549	+ return name;
	550	+ d := array[kr->MD5dlen] of byte;
	551	+ if (kr->md5(b, len b, d, nil) == nil)
	552	+ error(sys->sprint("md5 failed: %r"));
	553	+ e := array[ENCODEDLEN] of byte;
	554	+ v := 0;
	555	+ n := 0;
	556	+ r := 0;
	557	+ for (i := 0; i < ENCODEDLEN; i++) {
	558	+ if (r < 6) {
	559	+ v \|= int d[n++] << r;
	560	+ r += 8;
	561	+ }
	562	+ e[i] = byte encoding[v & 16r3F];
	563	+ v >>= 6;
	564	+ r -= 6;
	565	+ }
	566	+ return dir + string e;
	567	+}
	568	+
	569	+##
	570	+## Runtime entries.
	571	+##
	572	+
	573	+#
	574	+# Runtime load. Passed a pointer into a module's data of a rtload table.
	575	+#
	576	+rtload(addr: int)
	577	+{
	578	+ o := getabsint(addr + RTTHISOFFSET);
	579	+ r := getabsint(addr - (o + WORDZ));
	580	+ l := o + r;
	581	+ d := makeadt(addr - l);
	582	+ s := getadtstring(d, l + RTCLASSOFFSET);
	583	+ a := getrtreloc(d, l + RTRELOCOFFSET);
	584	+ t := getclassadt(d, CLASSADTOFFSET);
	585	+ trace(JVERBOSE, sys->sprint("rtload %s [%d -> %d] for %s", s, o, r, t.name));
	586	+ if (t.state != INITED)
	587	+ error("this not loaded");
	588	+ c := loader(s);
	589	+ cur = c.name;
	590	+ putmod(d, l, c.mod);
	591	+ putmod(d, l + RTCLASSOFFSET, c.native);
	592	+ putclass(d, l + RTRELOCOFFSET, c);
	593	+ putint(d, l + RTTHISOFFSET, c.objtype);
	594	+ o = l + RTFIRSTRELOC;
	595	+ n := len a;
	596	+ for (i := 0; i < n; i++) {
	597	+ if ((a[i].flags & Rmask) == Rinvokespecial) {
	598	+ (w, m, x) := t.special(a[i].field, a[i].signature, a[i].flags, c);
	599	+ if (a[i].flags & Rspecialmp) {
	600	+ if (w == CMP)
	601	+ putmod(d, o, m.mod);
	602	+ else if (w == CNP)
	603	+ putmod(d, o, m.native);
	604	+ else
	605	+ error("bad special");
	606	+ } else
	607	+ putint(d, o, x);
	608	+ } else {
	609	+ (w, v) := c.resolvereloc(a[i].field, a[i].signature, a[i].flags);
	610	+ case w {
	611	+ VVAL =>
	612	+ putint(d, o, v);
	613	+ VMP =>
	614	+ putmod(d, o, c.mod);
	615	+ VNP =>
	616	+ putmod(d, o, c.native);
	617	+ VOBJ =>
	618	+ putobj(d, o, c.this);
	619	+ * =>
	620	+ error("bad resolve");
	621	+ }
	622	+ }
	623	+ o += WORDZ;
	624	+ }
	625	+ cur = nil;
	626	+# if (errors)
	627	+# error("rtload failed");
	628	+}
	629	+
	630	+#
	631	+# Get a Class adt by name. Used internally and made visible.
	632	+# It does no loading so should only be called if you know
	633	+# the class is loaded (or are loading it).
	634	+#
	635	+
	636	+CHSZ: con 31;
	637	+classhash := array[CHSZ] of list of ref Class;
	638	+
	639	+getclass(name: string): ref Class
	640	+{
	641	+ h := classhash[hash->fun1(name, CHSZ):];
	642	+ for (l := h[0]; l != nil; l = tl l) {
	643	+ c := hd l;
	644	+ if (c.name == name)
	645	+ return c;
	646	+ }
	647	+ c := ref Class;
	648	+ c.state = NEW;
	649	+ trace(JVERBOSE, sys->sprint("Switching class %s state to NEW", name));
	650	+ c.name = name;
	651	+ c.flags = 0;
	652	+ c.info = ref Ldinfo;
	653	+ h[0] = c :: h[0];
	654	+ return c;
	655	+}
	656	+
	657	+#
	658	+# Map a module to its class. This works for native modules too.
	659	+#
	660	+
	661	+MHSZ: con 31;
	662	+modhash := array[MHSZ] of list of (Nilmod, ref Class);
	663	+
	664	+addmodclass(m: Nilmod, c: ref Class)
	665	+{
	666	+ h := modhash[jassist->modhash(m) % MHSZ:];
	667	+ h[0] = (m, c) :: h[0];
	668	+}
	669	+
	670	+getmodclass(m: Nilmod): ref Class
	671	+{
	672	+ for (l := modhash[jassist->modhash(m) % MHSZ]; l != nil; l = tl l) {
	673	+ (t, c) := hd l;
	674	+ if (t == m)
	675	+ return c;
	676	+ }
	677	+ return nil;
	678	+}
	679	+
	680	+#
	681	+# Thread data.
	682	+#
	683	+
	684	+THSZ: con 31;
	685	+threadhash := array[THSZ] of list of ref ThreadData;
	686	+
	687	+getpid(): int
	688	+{
	689	+ return sys->pctl(0, nil);
	690	+}
	691	+
	692	+getcontext(): ref Draw->Context
	693	+{
	694	+ return context;
	695	+}
	696	+
	697	+getthreaddata(): ref ThreadData
	698	+{
	699	+ p := getpid();
	700	+ for (l := threadhash[p % THSZ]; l != nil; l = tl l) {
	701	+ t := hd l;
	702	+ if (t.pid == p)
	703	+ return t;
	704	+ }
	705	+ acquire();
	706	+ h := threadhash[p % THSZ:];
	707	+ d := ref ThreadData;
	708	+ d.pid = p;
	709	+ d.wchan = chan of int;
	710	+ d.flags = 0;
	711	+ h[0] = d :: h[0];
	712	+ threadcount++;
	713	+ trace(JVERBOSE, sys->sprint("count = %d + %d", threadcount, daemoncount));
	714	+ release();
	715	+ return d;
	716	+}
	717	+
	718	+delthreaddata()
	719	+{
	720	+ n: list of ref ThreadData;
	721	+ acquire();
	722	+ p := getpid();
	723	+ h := threadhash[p % THSZ:];
	724	+ for (l := h[0]; l != nil; l = tl l) {
	725	+ t := hd l;
	726	+ if (t.pid == p) {
	727	+ if (t.flags & ThreadData.DAEMON)
	728	+ daemoncount--;
	729	+ else
	730	+ threadcount--;
	731	+ } else
	732	+ n = t :: n;
	733	+ }
	734	+ h[0] = n;
	735	+ trace(JVERBOSE, sys->sprint("count = %d + %d", threadcount, daemoncount));
	736	+ if (threadcount == 0)
	737	+ nothreads(nil);
	738	+ else
	739	+ release();
	740	+}
	741	+
	742	+#
	743	+# Mark current thread a daemon. Entry.
	744	+#
	745	+daemonize()
	746	+{
	747	+ t := getthreaddata();
	748	+ acquire();
	749	+ if ((t.flags & ThreadData.DAEMON) == 0) {
	750	+ t.flags \|= ThreadData.DAEMON;
	751	+ daemoncount++;
	752	+ threadcount--;
	753	+ }
	754	+ trace(JVERBOSE, sys->sprint("count = %d + %d", threadcount, daemoncount));
	755	+ if (threadcount == 0)
	756	+ nothreads(t);
	757	+ else
	758	+ release();
	759	+}
	760	+
	761	+#
	762	+# Stop all threads. When all are dead we will shutdown.
	763	+#
	764	+stopthreads(t: ref ThreadData)
	765	+{
	766	+ for (i := 0; i < THSZ; i++)
	767	+ for (l := threadhash[i]; l != nil; l = tl l) {
	768	+ s := hd l;
	769	+ if (s != t)
	770	+ stop(s, nil);
	771	+ }
	772	+ stopped = 1;
	773	+}
	774	+
	775	+#
	776	+# No non-daemon threads. Maybe clean up, maybe shutdown.
	777	+#
	778	+nothreads(t: ref ThreadData)
	779	+{
	780	+ if (!stopped)
	781	+ stopthreads(t);
	782	+ if (daemoncount != 0) {
	783	+ release();
	784	+ if (t != nil) {
	785	+ t.culprit = threaddeath().new();
	786	+ raise JAVAEXCEPTION;
	787	+ }
	788	+ return;
	789	+ }
	790	+ release();
	791	+ shutdown();
	792	+}
	793	+
	794	+#
	795	+# Entry for system.exit().
	796	+#
	797	+system_exit()
	798	+{
	799	+ t := getthreaddata();
	800	+ acquire();
	801	+ stopthreads(t);
	802	+ release();
	803	+ t.culprit = threaddeath().new();
	804	+ raise JAVAEXCEPTION;
	805	+}
	806	+
	807	+cmd_start: array of byte;
	808	+cmd_stop: array of byte;
	809	+cmd_kill: array of byte;
	810	+cmd_failed: int = 0;
	811	+tdclass: ref Class;
	812	+
	813	+ctlfile(t: ref ThreadData)
	814	+{
	815	+ if (t.ctlfile == nil)
	816	+ t.ctlfile = PROG + "/" + string t.pid + "/dbgctl";
	817	+}
	818	+
	819	+threaddeath(): ref Class
	820	+{
	821	+ if (tdclass == nil)
	822	+ tdclass = loader(EXCEPTIONPATH + "ThreadDeath");
	823	+ return tdclass;
	824	+}
	825	+
	826	+dosuspend(t: ref ThreadData)
	827	+{
	828	+ ctlfile(t);
	829	+ f := sys->open(t.ctlfile, Sys->ORDWR);
	830	+ monsync();
	831	+ t.flags \|= ThreadData.SUSPENDED;
	832	+ if (f == nil) {
	833	+ if (!cmd_failed) {
	834	+ warning(sys->sprint("could not open %s: %r", t.ctlfile));
	835	+ cmd_failed = 1;
	836	+ }
	837	+ } else {
	838	+ sys->write(f, cmd_stop, len cmd_stop);
	839	+ t.control = f;
	840	+ }
	841	+}
	842	+
	843	+doresume(t: ref ThreadData)
	844	+{
	845	+ if (t.control != nil) {
	846	+ sys->write(t.control, cmd_start, len cmd_start);
	847	+ t.control = nil;
	848	+ }
	849	+ monsync();
	850	+ t.flags &= ~ThreadData.SUSPENDED;
	851	+ if (t.flags & ThreadData.ACKSUSP) {
	852	+ t.wchan <-= MONOK;
	853	+ t.flags &= ~ThreadData.ACKSUSP;
	854	+ }
	855	+}
	856	+
	857	+dostop(t: ref ThreadData)
	858	+{
	859	+ ctlfile(t);
	860	+ f := sys->open(t.ctlfile, Sys->ORDWR);
	861	+ if (f == nil) {
	862	+ if (!cmd_failed) {
	863	+ warning(sys->sprint("could not open %s: %r", t.ctlfile));
	864	+ cmd_failed = 1;
	865	+ }
	866	+ } else
	867	+ sys->write(f, cmd_kill, len cmd_kill);
	868	+}
	869	+
	870	+#
	871	+# The thread manager looks after suspend and resume.
	872	+# A thread that cannot be suspended enters a block()/unblock()
	873	+# pair for the duration of its critical region.
	874	+#
	875	+
	876	+threadmanager()
	877	+{
	878	+ cmd_start = array of byte "start";
	879	+ cmd_stop = array of byte "stop";
	880	+ cmd_kill = array of byte "maim";
	881	+ for (;;) {
	882	+ (t, c) := <- threadctl;
	883	+ if (t != nil && (t.flags & ThreadData.EXITED)) {
	884	+ t = nil;
	885	+ continue;
	886	+ }
	887	+ case c {
	888	+ ThreadData.SHUTDOWN =>
	889	+ return;
	890	+ ThreadData.BLOCK =>
	891	+ t.flags \|= ThreadData.BLOCKED;
	892	+ ThreadData.UNBLOCK =>
	893	+ if (t.flags & ThreadData.WAITSTOP)
	894	+ dostop(t);
	895	+ else if (t.flags & ThreadData.WAITSUSP)
	896	+ dosuspend(t);
	897	+ t.flags &= ~(ThreadData.BLOCKED \| ThreadData.WAITSTOP \| ThreadData.WAITSUSP);
	898	+ ThreadData.SUSPEND =>
	899	+ if ((t.flags & ThreadData.SUSPENDED) == 0) {
	900	+ if (t.flags & ThreadData.BLOCKED)
	901	+ t.flags \|= ThreadData.WAITSUSP;
	902	+ else
	903	+ dosuspend(t);
	904	+ }
	905	+ ThreadData.RESUME =>
	906	+ if (t.flags & ThreadData.SUSPENDED)
	907	+ doresume(t);
	908	+ else
	909	+ t.flags &= ~ThreadData.WAITSUSP;
	910	+ ThreadData.STOP =>
	911	+ if (t.flags & ThreadData.BLOCKED)
	912	+ t.flags \|= ThreadData.WAITSTOP;
	913	+ else
	914	+ dostop(t);
	915	+ * =>
	916	+ threadctl = nil;
	917	+ raise "bad threadctl command"; #error("bad threadctl command");
	918	+ }
	919	+ t = nil;
	920	+ }
	921	+}
	922	+
	923	+block(t: ref ThreadData)
	924	+{
	925	+ threadctl <-= (t, ThreadData.BLOCK);
	926	+}
	927	+
	928	+unblock(t: ref ThreadData)
	929	+{
	930	+ threadctl <-= (t, ThreadData.UNBLOCK);
	931	+}
	932	+
	933	+suspend(t: ref ThreadData)
	934	+{
	935	+ threadctl <-= (t, ThreadData.SUSPEND);
	936	+}
	937	+
	938	+resume(t: ref ThreadData)
	939	+{
	940	+ threadctl <-= (t, ThreadData.RESUME);
	941	+}
	942	+
	943	+stop(t: ref ThreadData, o: ref Object)
	944	+{
	945	+ if (o == nil)
	946	+ o = threaddeath().new();
	947	+ t.culprit = o;
	948	+ threadctl <-= (t, ThreadData.STOP);
	949	+}
	950	+
	951	+#
	952	+# Exceptions.
	953	+#
	954	+
	955	+mkexception( name : string ) : ref Object
	956	+{
	957	+ return(loader(EXCEPTIONPATH + name).new());
	958	+}
	959	+
	960	+# convert an Inferno exception into a Java Exception
	961	+sysexception( e : string ) : ref Object
	962	+{
	963	+ s : string;
	964	+ msg : string;
	965	+
	966	+
	967	+ if ( e == nil )
	968	+ {
	969	+ s = "InternalError";
	970	+ msg = "unknown";
	971	+ }
	972	+ else if ( str->prefix(JCLDREX,e) == 1 )
	973	+ {
	974	+ trace(JDEBUG, sys->sprint("sysexception: / %s /", e));
	975	+ # try to convert JavaClassLoader exceptions first
	976	+ rest := e[len JCLDREX:]; #strip off prefix
	977	+
	978	+ # pull the possible java ex name; save the rest as a message
	979	+ ex : string;
	980	+ (ex,msg) = str->splitl(rest, ":");
	981	+
	982	+ # convert to coresponding Java Exception, if any
	983	+ case ex
	984	+ {
	985	+ noclassdeffound => s = "NoClassDefFoundError";
	986	+ nosuchmethod => s = "NoSuchMethodError";
	987	+ classcircularity => s = "ClassCircularityError";
	988	+ classformat => s = "ClassFormatError";
	989	+ unsatisfiedlink => s = "UnsatisfiedLinkError";
	990	+ exceptionininitializer => s = "ExceptionInInitializerError";
	991	+ linkageerr => s = "LinkageError"; #different then '*'
	992	+
	993	+ # if none found then make into a generic LinkageError
	994	+ * => s = "LinkageError";
	995	+ msg = rest;
	996	+ }
	997	+ }
	998	+ else
	999	+ {
	1000	+ trace(JDEBUG, sys->sprint("sysexception: / %s /", e));
	1001	+ case e
	1002	+ {
	1003	+ #
	1004	+ # inferno system exceptions
	1005	+ #
	1006	+ "zero divide" or
	1007	+ "invalid math argument" or
	1008	+ "Floating point exception" or
	1009	+ "Integer Overflow" or
	1010	+ "Divide by Zero" or
	1011	+ "Floating Point Divide by Zero" or
	1012	+ "Inexact Floating Point" or
	1013	+ "Invalid Floating Operation" or
	1014	+ "Floating Point Result Overflow" or
	1015	+ "Floating Point Stack Check" or
	1016	+ "Floating Point Result Underflow" =>
	1017	+ s = "ArithmeticException";
	1018	+ "heap full" or
	1019	+ "no memory" =>
	1020	+ s = "OutOfMemoryError";
	1021	+ "array bounds error" or
	1022	+ "Array Bounds Check" =>
	1023	+ s = "ArrayIndexOutOfBoundsException";
	1024	+ "negative array size" =>
	1025	+ s = "NegativeArraySizeException";
	1026	+ "dereference of nil" or
	1027	+ "Segmentation violation" or
	1028	+ "Bus error" =>
	1029	+ s = "NullPointerException";
	1030	+ "Stack Overflow" =>
	1031	+ s = "StackOverflowError";
	1032	+ * =>
	1033	+ s = "InternalError";
	1034	+ }
	1035	+
	1036	+ # fill throwable object with information from inferno ex
	1037	+ #msg = sys->sprint( "%s[%d]:%s", e.mod, e.pc, e.name );
	1038	+ }
	1039	+
	1040	+ obj := mkexception(s); #create Java Ex object
	1041	+
	1042	+
	1043	+ # set the detailed message
	1044	+ throwable := jassist->ObjecttoJT(obj);
	1045	+ if (stringclass == nil)
	1046	+ loadstringclass();
	1047	+ throwable.msg = ref JavaString(stringclass.moddata, msg);
	1048	+
	1049	+ return( obj );
	1050	+}
	1051	+
	1052	+culprit(e: string): ref Object
	1053	+{
	1054	+ thd := getthreaddata();
	1055	+
	1056	+ if ( thd.culprit == nil \|\| e != JAVAEXCEPTION )
	1057	+ {
	1058	+ # no java exception -- turn an inferno
	1059	+ # exception into a Java Exception
	1060	+ thd.culprit = sysexception(e);
	1061	+ }
	1062	+
	1063	+ return( thd.culprit );
	1064	+}
	1065	+
	1066	+throw(c: ref Object)
	1067	+{
	1068	+ getthreaddata().culprit = c;
	1069	+ raise JAVAEXCEPTION;
	1070	+}
	1071	+
	1072	+sthrow(s: string)
	1073	+{
	1074	+ throw(mkexception(s));
	1075	+}
	1076	+
	1077	+#
	1078	+# Monitors.
	1079	+#
	1080	+
	1081	+MONOK, MONILL, MONINT:
	1082	+ con iota;
	1083	+
	1084	+Synch: adt
	1085	+{
	1086	+ thread: ref ThreadData;
	1087	+ count: int;
	1088	+ status: int;
	1089	+ next: cyclic ref Synch;
	1090	+};
	1091	+
	1092	+Monitor: adt
	1093	+{
	1094	+ thread: ref ThreadData;
	1095	+ object: ref Object;
	1096	+ count: int;
	1097	+ head: ref Synch;
	1098	+ tail: ref Synch;
	1099	+};
	1100	+
	1101	+Waiter: adt
	1102	+{
	1103	+ thread: ref ThreadData;
	1104	+ object: ref Object;
	1105	+ count: int;
	1106	+ time: int;
	1107	+ next: cyclic ref Waiter;
	1108	+};
	1109	+
	1110	+sleepers: ref Waiter;
	1111	+waiters: ref Waiter;
	1112	+timeout: int;
	1113	+
	1114	+MAXSLEEP: con 1000;
	1115	+SLEEPTOL: con 50;
	1116	+
	1117	+MONHSZ: con 31;
	1118	+monhash := array[MONHSZ] of list of ref Monitor;
	1119	+
	1120	+getmonitor(o: ref Object): ref Monitor
	1121	+{
	1122	+ z: ref Monitor;
	1123	+ h := monhash[jassist->objhash(o) % MONHSZ:];
	1124	+ for (l := h[0]; l != nil; l = tl l) {
	1125	+ m := hd l;
	1126	+ if (m.object == o)
	1127	+ return m;
	1128	+ if (m.count == 0)
	1129	+ z = m;
	1130	+ }
	1131	+ if (z == nil) {
	1132	+ z = ref Monitor;
	1133	+ z.count = 0;
	1134	+ h[0] = z :: h[0];
	1135	+ }
	1136	+ z.object = o;
	1137	+ return z;
	1138	+}
	1139	+
	1140	+#
	1141	+# Timer thread.
	1142	+#
	1143	+timer(t: int)
	1144	+{
	1145	+ s := t - sys->millisec();
	1146	+ if (s > 0)
	1147	+ sys->sleep(s);
	1148	+ if(monitorctl != nil)
	1149	+ monitorctl <-= (MTIMER, nil, nil, t);
	1150	+}
	1151	+
	1152	+#
	1153	+# Wait to be interrupted, notified or for timeout to expire.
	1154	+#
	1155	+waiter(w: ref Waiter)
	1156	+{
	1157	+ w.thread.flags &= ~ThreadData.INTERRUPTED;
	1158	+ s := w.time;
	1159	+ if (s == 0) {
	1160	+ w.next = waiters.next;
	1161	+ waiters.next = w;
	1162	+ } else {
	1163	+ t := sys->millisec();
	1164	+ w.time += t;
	1165	+ if (sleepers.next == nil) {
	1166	+ sleepers.next = w;
	1167	+ if (s > MAXSLEEP)
	1168	+ s = MAXSLEEP;
	1169	+ timeout = t + s;
	1170	+ spawn timer(timeout);
	1171	+ } else if (w.time >= sleepers.next.time) {
	1172	+ h := sleepers.next;
	1173	+ while (h.next != nil && w.time > h.next.time)
	1174	+ h = h.next;
	1175	+ w.next = h.next;
	1176	+ h.next = w;
	1177	+ } else {
	1178	+ w.next = sleepers.next;
	1179	+ sleepers.next = w;
	1180	+ if (w.time < timeout - SLEEPTOL) {
	1181	+ timeout = w.time;
	1182	+ spawn timer(timeout);
	1183	+ }
	1184	+ }
	1185	+ }
	1186	+}
	1187	+
	1188	+#
	1189	+# Respond to timer.
	1190	+#
	1191	+dotimer(t: int)
	1192	+{
	1193	+ c := sys->millisec();
	1194	+ n := t;
	1195	+ if (t < c)
	1196	+ n = c;
	1197	+ n += SLEEPTOL;
	1198	+ w := sleepers;
	1199	+ while ((l := w.next) != nil && l.time <= n) {
	1200	+ w.next = l.next;
	1201	+ mondone(l, MONOK);
	1202	+ }
	1203	+ if (t == timeout && l != nil) {
	1204	+ timeout = l.time;
	1205	+ if (timeout - c > MAXSLEEP)
	1206	+ timeout = c + MAXSLEEP;
	1207	+ spawn timer(timeout);
	1208	+ }
	1209	+}
	1210	+
	1211	+#
	1212	+# Notify.
	1213	+#
	1214	+
	1215	+donotifyl(w: ref Waiter, o: ref Object): ref Waiter
	1216	+{
	1217	+ while ((l := w.next) != nil) {
	1218	+ if (l.object == o) {
	1219	+ w.next = l.next;
	1220	+ return l;
	1221	+ }
	1222	+ else
	1223	+ w = l;
	1224	+ }
	1225	+ return nil;
	1226	+}
	1227	+
	1228	+donotify(o: ref Object)
	1229	+{
	1230	+ if ((l := donotifyl(waiters, o)) != nil \|\| (l = donotifyl(sleepers, o)) != nil)
	1231	+ mondone(l, MONOK);
	1232	+}
	1233	+
	1234	+#
	1235	+# Notify all.
	1236	+#
	1237	+
	1238	+donotifyalll(w: ref Waiter, o: ref Object)
	1239	+{
	1240	+ while ((t := w.next) != nil) {
	1241	+ if (t.object == o) {
	1242	+ w.next = t.next;
	1243	+ mondone(t, MONOK);
	1244	+ } else
	1245	+ w = t;
	1246	+ }
	1247	+}
	1248	+
	1249	+donotifyall(o: ref Object)
	1250	+{
	1251	+ donotifyalll(waiters, o);
	1252	+ donotifyalll(sleepers, o);
	1253	+}
	1254	+
	1255	+#
	1256	+# Interrupt.
	1257	+#
	1258	+
	1259	+dointerruptl(w: ref Waiter, t: ref ThreadData): ref Waiter
	1260	+{
	1261	+ while ((l := w.next) != nil) {
	1262	+ if (l.thread == t) {
	1263	+ w.next = l.next;
	1264	+ return l;
	1265	+ }
	1266	+ else
	1267	+ w = l;
	1268	+ }
	1269	+ return nil;
	1270	+}
	1271	+
	1272	+dointerrupt(t: ref ThreadData)
	1273	+{
	1274	+ if ((l := dointerruptl(waiters, t)) != nil \|\| (l = dointerruptl(sleepers, t)) != nil) {
	1275	+ l.thread.flags \|= ThreadData.INTERRUPTED;
	1276	+ mondone(l, MONINT);
	1277	+ }
	1278	+}
	1279	+
	1280	+#
	1281	+# Enter or reenter a monitor.
	1282	+#
	1283	+doenter(t: ref ThreadData, o: ref Object, n: int, s: int)
	1284	+{
	1285	+ m := getmonitor(o);
	1286	+ if (m.count == 0) {
	1287	+ m.thread = t;
	1288	+ m.count = n;
	1289	+ } else if (m.thread == t)
	1290	+ m.count += n;
	1291	+ else {
	1292	+ w := ref Synch;
	1293	+ w.thread = t;
	1294	+ w.count = n;
	1295	+ w.status = s;
	1296	+ if (m.tail == nil) {
	1297	+ m.head = w;
	1298	+ m.tail = w;
	1299	+ } else {
	1300	+ m.tail.next = w;
	1301	+ m.tail = w;
	1302	+ }
	1303	+ return ;
	1304	+ }
	1305	+ for (;;) {
	1306	+ alt {
	1307	+ t.wchan <-= s =>
	1308	+ return;
	1309	+ * =>
	1310	+ if (t.flags & ThreadData.SUSPENDED) {
	1311	+ t.flags \|= ThreadData.ACKSUSP;
	1312	+ return;
	1313	+ }
	1314	+ sys->sleep(0);
	1315	+ }
	1316	+ }
	1317	+}
	1318	+
	1319	+#
	1320	+# A sleeper or waiter is done.
	1321	+#
	1322	+mondone(w: ref Waiter, s: int)
	1323	+{
	1324	+ if (w.object != nil)
	1325	+ doenter(w.thread, w.object, w.count, s);
	1326	+ else
	1327	+ w.thread.wchan <-= s;
	1328	+}
	1329	+
	1330	+#
	1331	+# Concede monitor to next synchronizer.
	1332	+#
	1333	+monitornext(m: ref Monitor)
	1334	+{
	1335	+ h := m.head;
	1336	+ if (h != nil) {
	1337	+ x := h.next;
	1338	+ m.head = x;
	1339	+ if (x == nil)
	1340	+ m.tail = nil;
	1341	+ m.thread = h.thread;
	1342	+ m.count = h.count;
	1343	+ m.thread.wchan <-= h.status;
	1344	+ } else {
	1345	+ m.thread = nil;
	1346	+ m.object = nil;
	1347	+ m.count = 0;
	1348	+ }
	1349	+}
	1350	+
	1351	+#
	1352	+# Monitor thread.
	1353	+#
	1354	+monitor()
	1355	+{
	1356	+ m: ref Monitor;
	1357	+ sleepers = ref Waiter;
	1358	+ waiters = ref Waiter;
	1359	+ for (;;) {
	1360	+ (c, t, o, n) := <- monitorctl;
	1361	+ case c {
	1362	+ MSHUTDOWN =>
	1363	+ return;
	1364	+ MSYNC =>
	1365	+ sys->sleep(0);
	1366	+ MENTER =>
	1367	+ doenter(t, o, n, MONOK);
	1368	+ MEXIT =>
	1369	+ m = getmonitor(o);
	1370	+ if (m.count == 0)
	1371	+ raise "mexit inbalance"; #error("mexit inbalance");
	1372	+ if (m.thread != t)
	1373	+ raise "mexit mismatch"; #error("mexit mismatch");
	1374	+ m.count--;
	1375	+ if (m.count == 0)
	1376	+ monitornext(m);
	1377	+ MWAIT =>
	1378	+ m = getmonitor(o);
	1379	+ if (m.count == 0 \|\| m.thread != t) {
	1380	+ t.wchan <-= MONILL;
	1381	+ break;
	1382	+ }
	1383	+ waiter(ref Waiter(t, o, m.count, n, nil));
	1384	+ monitornext(m);
	1385	+ MNOTIFY =>
	1386	+ m = getmonitor(o);
	1387	+ if (m.count == 0 \|\| m.thread != t) {
	1388	+ t.wchan <-= MONILL;
	1389	+ break;
	1390	+ }
	1391	+ if (n)
	1392	+ donotifyall(o);
	1393	+ else
	1394	+ donotify(o);
	1395	+ t.wchan <-= MONOK;
	1396	+ MSLEEP =>
	1397	+ waiter(ref Waiter(t, nil, 0, n, nil));
	1398	+ MINTERRUPT =>
	1399	+ dointerrupt(t);
	1400	+ MTIMER =>
	1401	+ dotimer(n);
	1402	+ * =>
	1403	+ monitorctl = nil;
	1404	+ raise "bad monitorctl command"; #error("bad monitorctl command");
	1405	+ }
	1406	+ t = nil;
	1407	+ o = nil;
	1408	+ m = nil;
	1409	+ }
	1410	+}
	1411	+
	1412	+#
	1413	+# Common resume code.
	1414	+#
	1415	+monitorresume(d: ref ThreadData)
	1416	+{
	1417	+ case <- d.wchan {
	1418	+ MONILL =>
	1419	+ unblock(d);
	1420	+ sthrow("IllegalMonitorStateException");
	1421	+ MONINT =>
	1422	+ unblock(d);
	1423	+ sthrow("InterruptedException");
	1424	+ }
	1425	+ unblock(d);
	1426	+}
	1427	+
	1428	+#
	1429	+# Monitor / thread control entries.
	1430	+#
	1431	+
	1432	+monitorenter(o: ref Object)
	1433	+{
	1434	+ if ( o == nil )
	1435	+ sthrow("NullPointerException");
	1436	+ d := getthreaddata();
	1437	+ if (monitorctl != nil) {
	1438	+ monitorctl <-= (MENTER, d, o, 1);
	1439	+ <- d.wchan;
	1440	+ }
	1441	+}
	1442	+
	1443	+monitorexit(o: ref Object)
	1444	+{
	1445	+ if ( o == nil )
	1446	+ sthrow("NullPointerException");
	1447	+ d := getthreaddata();
	1448	+ if (monitorctl != nil)
	1449	+ monitorctl <-= (MEXIT, d, o, 0);
	1450	+}
	1451	+
	1452	+monitorwait(o: ref Object, l: int)
	1453	+{
	1454	+ if ( o == nil )
	1455	+ sthrow("NullPointerException");
	1456	+ d := getthreaddata();
	1457	+ if (monitorctl != nil) {
	1458	+ block(d);
	1459	+ monitorctl <-= (MWAIT, d, o, l);
	1460	+ monitorresume(d);
	1461	+ }
	1462	+}
	1463	+
	1464	+monitornotify(o: ref Object, f: int)
	1465	+{
	1466	+ if ( o == nil )
	1467	+ sthrow("NullPointerException");
	1468	+ d := getthreaddata();
	1469	+ if (monitorctl != nil) {
	1470	+ block(d);
	1471	+ monitorctl <-= (MNOTIFY, d, o, f);
	1472	+ monitorresume(d);
	1473	+ }
	1474	+}
	1475	+
	1476	+monsync()
	1477	+{
	1478	+ monitorctl <-= (MSYNC, nil, nil, 0);
	1479	+}
	1480	+
	1481	+sleep(l: int)
	1482	+{
	1483	+ if (l <= 100) {
	1484	+ sys->sleep(l);
	1485	+ return;
	1486	+ }
	1487	+ d := getthreaddata();
	1488	+ if (monitorctl != nil) {
	1489	+ block(d);
	1490	+ monitorctl <-= (MSLEEP, d, nil, l);
	1491	+ monitorresume(d);
	1492	+ }
	1493	+}
	1494	+
	1495	+interrupt(t: ref ThreadData)
	1496	+{
	1497	+ d := getthreaddata();
	1498	+ if (monitorctl != nil) {
	1499	+ block(d);
	1500	+ monitorctl <-= (MINTERRUPT, t, nil, 0);
	1501	+ unblock(d);
	1502	+ }
	1503	+}
	1504	+
	1505	+#
	1506	+# Runtime hierarchy/type check routines.
	1507	+#
	1508	+
	1509	+compatclass(who, what: ref Class): int
	1510	+{
	1511	+ if ((what.flags & ACC_INTERFACE) && (who.flags & ACC_INTERFACE) == 0)
	1512	+ return who.getinterface(what) != nil;
	1513	+ do {
	1514	+ if (who == what)
	1515	+ return 1;
	1516	+ who = who.super;
	1517	+ } while (who != nil);
	1518	+ return 0;
	1519	+}
	1520	+
	1521	+checkcast(who: ref Object, what: ref Class)
	1522	+{
	1523	+ if (who != nil && !instanceof(who, what))
	1524	+ sthrow("ClassCastException");
	1525	+}
	1526	+
	1527	+instanceof(who: ref Object, what: ref Class): int
	1528	+{
	1529	+ if (who == nil)
	1530	+ return 0;
	1531	+ return compatclass(who.class(), what);
	1532	+}
	1533	+
	1534	+acheckcast(who: ref Array, what: ref Class, dims: int)
	1535	+{
	1536	+ if (who != nil && !ainstanceof(who, what, dims))
	1537	+ sthrow("ClassCastException");
	1538	+}
	1539	+
	1540	+ainstanceof(who: ref Array, what: ref Class, dims: int): int
	1541	+{
	1542	+ if (who == nil)
	1543	+ return 0;
	1544	+ if (arrayclass == nil)
	1545	+ loadarrayclass();
	1546	+ if (who.mod != arraymd)
	1547	+ return 0;
	1548	+ # is 'what' Object[]... ?
	1549	+ if (who.dims > dims && what.super == nil && (what.flags & ACC_INTERFACE) == 0)
	1550	+ return 1;
	1551	+ if (who.dims != dims \|\| who.class == nil)
	1552	+ return 0;
	1553	+ return compatclass(who.class, what);
	1554	+}
	1555	+
	1556	+pcheckcast(who: ref Array, what, dims: int)
	1557	+{
	1558	+ if (who != nil && !pinstanceof(who, what, dims))
	1559	+ sthrow("ClassCastException");
	1560	+}
	1561	+
	1562	+pinstanceof(who: ref Array, what, dims: int): int
	1563	+{
	1564	+ if (who == nil)
	1565	+ return 0;
	1566	+ if (arrayclass == nil)
	1567	+ loadarrayclass();
	1568	+ if (who.mod != arraymd \|\| who.dims != dims \|\| who.class != nil)
	1569	+ return 0;
	1570	+ return who.primitive == what;
	1571	+}
	1572	+
	1573	+aastoreinstanceof(who: ref Object, what: ref Array): int
	1574	+{
	1575	+ if (arrayclass == nil)
	1576	+ loadarrayclass();
	1577	+ if (what.mod != arraymd)
	1578	+ return 0;
	1579	+ if (what.dims == 1) {
	1580	+ if (what.class == nil)
	1581	+ return 0;
	1582	+ if (who == nil)
	1583	+ return 1;
	1584	+ return compatclass(who.class(), what.class);
	1585	+ } else {
	1586	+ if (who == nil)
	1587	+ return 1;
	1588	+ if (who.class() != arrayclass)
	1589	+ return 0;
	1590	+ a := arrayof(who);
	1591	+ if (a.dims != what.dims - 1)
	1592	+ return 0;
	1593	+ if (a.class == nil)
	1594	+ return what.class == nil && a.primitive == what.primitive;
	1595	+ if (what.class == nil)
	1596	+ return 0;
	1597	+ return compatclass(a.class, what.class);
	1598	+ }
	1599	+}
	1600	+
	1601	+aastorecheck(who: ref Object, what: ref Array)
	1602	+{
	1603	+ if (what == nil)
	1604	+ sthrow("NullPointerException");
	1605	+ if (!aastoreinstanceof(who, what))
	1606	+ sthrow("ArrayStoreException");
	1607	+}
	1608	+
	1609	+multianewarray(ndim: int, c: ref Class, etype: int, bounds: array of int): ref Array
	1610	+{
	1611	+ n := bounds[0];
	1612	+ if (n < 0)
	1613	+ sthrow("NegativeArraySizeException");
	1614	+ if (arrayclass == nil)
	1615	+ loadarrayclass();
	1616	+ a := ref Array(arraymd, nil, ndim, c, etype);
	1617	+ if (etype == 0 \|\| ndim > 1)
	1618	+ a.holder = array[n] of ref JavaString;
	1619	+ else {
	1620	+ case etype {
	1621	+ T_BOOLEAN or T_BYTE =>
	1622	+ a.holder = bytearraytoJS(array[n] of byte);
	1623	+ T_CHAR or T_SHORT or T_INT =>
	1624	+ a.holder = intarraytoJS(array[n] of int);
	1625	+ T_LONG =>
	1626	+ a.holder = bigarraytoJS(array[n] of big);
	1627	+ T_FLOAT or T_DOUBLE =>
	1628	+ a.holder = realarraytoJS(array[n] of real);
	1629	+ }
	1630	+ }
	1631	+ if (len bounds > 1) {
	1632	+ for (i := 0; i < n; i++)
	1633	+ a.holder[i] = ArraytoJS(multianewarray(ndim - 1, c, etype, bounds[1:]));
	1634	+ }
	1635	+ return a;
	1636	+}
	1637	+
	1638	+arraycopy(src: ref Array, sx: int, dst: ref Array, dx: int, n: int)
	1639	+{
	1640	+ if (arrayclass == nil)
	1641	+ loadarrayclass();
	1642	+ if (src == nil \|\| dst == nil)
	1643	+ sthrow("NullPointerException");
	1644	+ if (src.mod != arraymd \|\| dst.mod != arraymd)
	1645	+ sthrow("ArrayStoreException");
	1646	+ sa := src.holder;
	1647	+ if (src.dims == dst.dims) {
	1648	+ if (src.class == nil) {
	1649	+ if (dst.class != nil \|\| src.primitive != dst.primitive)
	1650	+ sthrow("ArrayStoreException");
	1651	+ } else {
	1652	+ if (dst.class == nil)
	1653	+ sthrow("ArrayStoreException");
	1654	+ if (src.class != dst.class && !compatclass(src.class, dst.class))
	1655	+ for (i := 0; i < n; i++)
	1656	+ if (!aastoreinstanceof(JStoObject(sa[sx + i]), dst))
	1657	+ sthrow("ArrayStoreException");
	1658	+ }
	1659	+ } else if (dst.class == nil \|\| dst.class.super != nil \|\| dst.dims > src.dims)
	1660	+ sthrow("ArrayStoreException");
	1661	+ if (sx < 0 \|\| dx < 0 \|\| n < 0 \|\| sx + n > len src.holder \|\| dx + n > len dst.holder \|\| sx > 2147483647 - n \|\| dx > 2147483647 - n)
	1662	+ sthrow("ArrayIndexOutOfBoundsException");
	1663	+ dst.holder[dx:] = sa[sx:sx + n];
	1664	+}
	1665	+
	1666	+#
	1667	+# Map a class and a interface cookie to a methodtable entry.
	1668	+#
	1669	+getinterface(c: ref Class, cookie: int) : int
	1670	+{
	1671	+ x := cookie >> 16;
	1672	+ t := cookie & 16rFFFF;
	1673	+ if (x >= ninterfaces)
	1674	+ error("bad interface number");
	1675	+ k := interfaces[x];
	1676	+ m := c.getinterface(k);
	1677	+ if (m == nil)
	1678	+ error(sys->sprint("class %s does not implement interface %s", c.name, k.name));
	1679	+ if (t >= len m)
	1680	+ error("bad interface index");
	1681	+ return m[t];
	1682	+}
	1683	+
	1684	+#
	1685	+# Math.
	1686	+#
	1687	+
	1688	+lcmp(x, y: big): int
	1689	+{
	1690	+ if(x < y)
	1691	+ return -1;
	1692	+ if(x == y)
	1693	+ return 0;
	1694	+ return 1;
	1695	+}
	1696	+
	1697	+truncate(x: real): real
	1698	+{
	1699	+ if (x < 0.0)
	1700	+ x = math->ceil(x);
	1701	+ else
	1702	+ x = math->floor(x);
	1703	+ return x;
	1704	+}
	1705	+
	1706	+d2i(x: real): int
	1707	+{
	1708	+ return int truncate(x);
	1709	+}
	1710	+
	1711	+d2l(x: real): big
	1712	+{
	1713	+ return big truncate(x);
	1714	+}
	1715	+
	1716	+dcmpg(x, y: real): int
	1717	+{
	1718	+ if (math->isnan(x) \|\| math->isnan(y) \|\| x > y)
	1719	+ return 1;
	1720	+ if (x == y)
	1721	+ return 0;
	1722	+ return -1;
	1723	+}
	1724	+
	1725	+dcmpl(x, y: real): int
	1726	+{
	1727	+ if (math->isnan(x) \|\| math->isnan(y) \|\| x < y)
	1728	+ return -1;
	1729	+ if (x == y)
	1730	+ return 0;
	1731	+ return 1;
	1732	+}
	1733	+
	1734	+drem(x, y: real): real
	1735	+{
	1736	+ if (math->isnan(x) \|\| math->isnan(y) \|\| !math->finite(x) \|\| y == 0.0)
	1737	+ return math->NaN;
	1738	+ if ((math->finite(x) && !math->finite(y)) \|\| (x == 0.0 && math->finite(y)))
	1739	+ return x;
	1740	+ return math->fmod(x, y);
	1741	+}
	1742	+
	1743	+#
	1744	+# Class entries.
	1745	+#
	1746	+
	1747	+Class.run(c: self ref Class, args: list of string)
	1748	+{
	1749	+ m := c.findsmethod(MAINFIELD, MAINSIGNATURE);
	1750	+ if (m == nil)
	1751	+ loaderror( nosuchmethod, sys->sprint("%s: missing static method main", c.name));
	1752	+ main = c;
	1753	+ if (arrayclass == nil)
	1754	+ loadarrayclass();
	1755	+ if (stringclass == nil)
	1756	+ loadstringclass();
	1757	+ n := len args;
	1758	+ h := array[n] of ref JavaString;
	1759	+ d := stringclass.moddata;
	1760	+ for (i := 0; i < n; i++) {
	1761	+ h[i] = ref JavaString(d, hd args);
	1762	+ args = tl args;
	1763	+ }
	1764	+ #c.xeq(m.value, ref Array(arraymd, h, 1, stringclass, 0));
	1765	+ getthreaddata();
	1766	+ r := jassist->mcalla(c.mod, m.value, ref Array(arraymd, h, 1, stringclass, 0));
	1767	+ delthreaddata();
	1768	+}
	1769	+
	1770	+
	1771	+Class.new(c: self ref Class): ref Object
	1772	+{
	1773	+ o := jassist->new(c.mod, c.objtype);
	1774	+ o.mod = c.moddata;
	1775	+ f := findasig(c.initmethods, VOIDSIGNATURE);
	1776	+ if (f == nil)
	1777	+ error(sys->sprint("%s: %s: missing constructor", nosuchmethod, c.name));
	1778	+ c.call(f.value, o);
	1779	+ return o;
	1780	+}
	1781	+
	1782	+Class.call(c: self ref Class, x: int, a: ref Object): ref Object
	1783	+{
	1784	+ if (x < 0 \|\| x >= c.mlinks)
	1785	+ raise badcallindex;
	1786	+ return jassist->mcall1(c.mod, x, a);
	1787	+}
	1788	+
	1789	+Class.clone(c: self ref Class, o: ref Object): ref Object
	1790	+{
	1791	+ if (c.cloneindex < 0)
	1792	+ raise nocloneindex;
	1793	+ return jassist->mcall1(c.mod, c.cloneindex, o);
	1794	+}
	1795	+
	1796	+#
	1797	+# Class private methods.
	1798	+#
	1799	+
	1800	+#
	1801	+# Load a class file.
	1802	+#
	1803	+Class.loadclass(c: self ref Class)
	1804	+{
	1805	+ c.encoding = encodename(c.name);
	1806	+ f := c.encoding + ".dis";
	1807	+ m := load Nilmod f;
	1808	+ if (m == nil) {
	1809	+ e := sys->sprint("%r");
	1810	+ if (!matches(e, EXIST))
	1811	+ error(f + ": " + e);
	1812	+ f = ROOT + f;
	1813	+ m = load Nilmod f;
	1814	+ if (m == nil) {
	1815	+ e = sys->sprint("%r");
	1816	+ m : string;
	1817	+ if (!matches(e, EXIST))
	1818	+ m = f + ": " + e;
	1819	+ else
	1820	+ m = c.name + ": class not found";
	1821	+ loaderror(noclassdeffound, m);
	1822	+ }
	1823	+ }
	1824	+ trace(JDEBUG, sys->sprint("\"%s\"", f));
	1825	+ c.file = f;
	1826	+ c.mod = m;
	1827	+ if (getint(m, MAGIC) != JAVA)
	1828	+ loaderror(classformat, f + ": bad magic number");
	1829	+ c.version = getint(m, VERSION) & 16rFF;
	1830	+ if (c.version != SUXV)
	1831	+ loaderror(classformat, f + ": incompatible version (rerun j2d)");
	1832	+ c.ownname = getstring(m, NAME);
	1833	+ if (c.ownname != c.name && encodename(c.ownname) != c.name)
	1834	+ warning("class file " + f + ": inconsistent classname: " + c.ownname);
	1835	+}
	1836	+
	1837	+#
	1838	+# The bulk of the work for loading a class is done here.
	1839	+# This is the essentially the first (resolution) pass.
	1840	+#
	1841	+Class.resolve(c: self ref Class)
	1842	+{
	1843	+ od, vm, pm, sd, sm, im: list of ref Field;
	1844	+ oz, vz, sz: int;
	1845	+ cur = c.name;
	1846	+ c.info.links = ld->link(c.mod);
	1847	+ if (c.info.links == nil)
	1848	+ error(sys->sprint("link failed: %r"));
	1849	+ c.mlinks = len c.info.links;
	1850	+ c.info.types = ld->tdesc(c.mod);
	1851	+ if (c.info.types == nil)
	1852	+ error(sys->sprint("tdesc failed: %r"));
	1853	+ c.objtype = len c.info.types;
	1854	+ c.cloneindex = -1;
	1855	+ if (c.super != nil) {
	1856	+ od = c.super.objectdata;
	1857	+ vz = len c.super.virtualmethods;
	1858	+ oz = c.super.objectsize;
	1859	+ } else {
	1860	+ od = nil;
	1861	+ vz = 0;
	1862	+ oz = WORDZ;
	1863	+ }
	1864	+ vm = nil;
	1865	+ pm = nil;
	1866	+ sd = nil;
	1867	+ sm = nil;
	1868	+ im = nil;
	1869	+ sz = 0;
	1870	+ r := getreloc(c.mod, RELOC);
	1871	+ n := len r;
	1872	+ p := array[n] of Patch;
	1873	+ e := 0;
	1874	+ for (i := 0; i < n; i++) {
	1875	+ s := r[i].field;
	1876	+ if (s[0] != '@')
	1877	+ break;
	1878	+ case s {
	1879	+ CLASS =>
	1880	+ p[i].what = PVALUE;
	1881	+ p[i].value = c.objtype;
	1882	+ c.flags = r[i].flags;
	1883	+ MP or NP or ADT or OBJ =>
	1884	+ p[i].what = PEXTRA;
	1885	+ p[i].value = e++;
	1886	+ JEX =>
	1887	+ error("@jex not in @Loader");
	1888	+ SYS =>
	1889	+ error("@sys not in @Loader");
	1890	+ }
	1891	+ }
	1892	+ for (; i < n; i++) {
	1893	+ t := r[i];
	1894	+ if (isdata(t.signature)) {
	1895	+ if (isspecial(t.field))
	1896	+ error(sys->sprint("unknown special data: %s", t.field));
	1897	+ else if (isstatic(t.flags)) {
	1898	+ trace(JDEBUG, sys->sprint("%s: static data", t.field));
	1899	+ sz = alignto(sz, t.signature);
	1900	+ p[i].what = PSTATIC;
	1901	+ p[i].value = sz;
	1902	+ f := ref Field(t.field, t.signature, t.flags, sz);
	1903	+ sz += sizeof(t.signature);
	1904	+ sd = f :: sd;
	1905	+ } else {
	1906	+ trace(JDEBUG, sys->sprint("%s: new data", t.field));
	1907	+ oz = alignto(oz, t.signature);
	1908	+ p[i].what = PVALUE;
	1909	+ p[i].value = oz;
	1910	+ f := ref Field(t.field, t.signature, t.flags, oz);
	1911	+ od = f :: od;
	1912	+ oz += sizeof(t.signature);
	1913	+ }
	1914	+ } else {
	1915	+ if (isspecial(t.field)) {
	1916	+ s := t.field;
	1917	+ case s {
	1918	+ SPECIALINIT =>
	1919	+ if (isstatic(t.flags))
	1920	+ error("<init> static");
	1921	+ x := c.getmethod(s, t.signature, t.flags);
	1922	+ if (t.flags & Rspecialmp) {
	1923	+ p[i].what = PEXTRA;
	1924	+ p[i].value = e++;
	1925	+ } else {
	1926	+ p[i].what = PVALUE;
	1927	+ p[i].value = x;
	1928	+ }
	1929	+ if (findsig(im, t.signature) == nil)
	1930	+ im = ref Field(s, t.signature, t.flags, x) :: im;
	1931	+ SPECIALCLINIT or SPECIALCLONE =>
	1932	+ if (!isstatic(t.flags))
	1933	+ error(s + " not static");
	1934	+ if (t.patch != nil)
	1935	+ error(s + " patches");
	1936	+ if (t.signature != VOIDSIGNATURE)
	1937	+ error(s + " bad signature");
	1938	+ if (isnative(t.flags))
	1939	+ error(s + " is native");
	1940	+ x := c.getmethod(s, t.signature, t.flags);
	1941	+ if (s == SPECIALCLINIT)
	1942	+ c.classinit = ref Field(s, t.signature, t.flags, x);
	1943	+ else
	1944	+ c.cloneindex = x;
	1945	+ p[i].what = PVALUE;
	1946	+ p[i].value = x;
	1947	+ * =>
	1948	+ error(sys->sprint("unknown special: %s", s));
	1949	+ }
	1950	+ } else if (isvirtual(t.flags)) {
	1951	+ f := findfs(vm, t.field, t.signature);
	1952	+ if (f == nil) {
	1953	+ x := c.override(t.field, t.signature);
	1954	+ if (x < 0) {
	1955	+ trace(JDEBUG, sys->sprint("%s: new method", t.field));
	1956	+ x = vz++;
	1957	+ } else {
	1958	+ trace(JDEBUG, sys->sprint("%s: overriden method", t.field));
	1959	+ }
	1960	+ f = ref Field(t.field, t.signature, t.flags, x);
	1961	+ vm = f :: vm;
	1962	+ }
	1963	+ if (t.flags & Rspecialmp) {
	1964	+ p[i].what = PVALUE;
	1965	+ p[i].value = e++;
	1966	+ } else {
	1967	+ p[i].what = PMETHOD;
	1968	+ p[i].value = f.value;
	1969	+ }
	1970	+ } else {
	1971	+ trace(JDEBUG, sys->sprint("%s: static method", t.field));
	1972	+ x := c.getmethod(t.field, t.signature, t.flags);
	1973	+ f := ref Field(t.field, t.signature, t.flags, x);
	1974	+ p[i].what = PVALUE;
	1975	+ p[i].value = x;
	1976	+ if (isstatic(t.flags)) {
	1977	+ trace(JDEBUG, sys->sprint("%s: static method", t.field));
	1978	+ sm = f :: sm;
	1979	+ } else {
	1980	+ trace(JDEBUG, sys->sprint("%s: private method", t.field));
	1981	+ pm = f :: pm;
	1982	+ }
	1983	+ }
	1984	+ }
	1985	+ }
	1986	+ if (c.flags & ACC_INTERFACE)
	1987	+ c.addinterface();
	1988	+ c.info.reloc = p;
	1989	+ c.objectdata = od;
	1990	+ c.virtualmethods = c.makevmtable(vm, vz);
	1991	+ c.staticdata = mkfdarray(sd);
	1992	+ c.staticmethods = mkfdarray(sm);
	1993	+ c.privatemethods = mkfdarray(pm);
	1994	+ c.initmethods = mkfdarray(im);
	1995	+ c.objectsize = alignto(oz, nil);
	1996	+ c.staticsize = alignto(sz, nil);
	1997	+ c.info.extrabase = e;
	1998	+ cur = nil;
	1999	+}
	2000	+
	2001	+#
	2002	+# Make a type for a class object.
	2003	+#
	2004	+Class.makeobjtype(c: self ref Class)
	2005	+{
	2006	+ z := ((c.objectsize / WORDZ) + 7) / 8;
	2007	+ m := array[z] of byte;
	2008	+ m[0] = byte 16r80;
	2009	+ for (i := 1; i < z; i++)
	2010	+ m[i] = byte 0;
	2011	+ for (l := c.objectdata; l != nil; l = tl l) {
	2012	+ f := hd l;
	2013	+ if (ispointer(f.signature)) {
	2014	+ v := f.value / WORDZ;
	2015	+ x := v / 8;
	2016	+ m[x] = byte ((int m[x]) \| bits[v & 7]);
	2017	+ }
	2018	+ }
	2019	+ c.objmap = m;
	2020	+ if (ld->tnew(c.mod, c.objectsize, c.objmap) != c.objtype)
	2021	+ error("objtype mismatch");
	2022	+}
	2023	+
	2024	+#
	2025	+# Make a virtual method table from that of the superclass
	2026	+# and the overriden and new entries.
	2027	+#
	2028	+Class.makevmtable(c: self ref Class, m: list of ref Field, z: int): array of Method
	2029	+{
	2030	+ t := array[z] of Method;
	2031	+ if (c.super != nil) {
	2032	+ s := c.super.virtualmethods;
	2033	+ n := len s;
	2034	+ for (i := 0; i < n; i++)
	2035	+ t[i] = s[i];
	2036	+ }
	2037	+ while (m != nil) {
	2038	+ f := hd m;
	2039	+ n := f.value;
	2040	+ # TODO: check if we don't have this method in links, so just use parent class's one
	2041	+ trace(JDEBUG, sys->sprint("Makevmtable for %s, %d", c.name, z));
	2042	+ {
	2043	+ f.value = c.getmethod(f.field, f.signature, f.flags);
	2044	+ }
	2045	+ exception e {
	2046	+ JCLDREX + nosuchmethod + "*" =>
	2047	+ ; # silently ignore
	2048	+ }
	2049	+ t[n].field = f;
	2050	+ t[n].class = c;
	2051	+ m = tl m;
	2052	+ }
	2053	+ return t;
	2054	+}
	2055	+
	2056	+#
	2057	+# Load the interfaces implemented by a class.
	2058	+#
	2059	+Class.loadinterfaces(c: self ref Class)
	2060	+{
	2061	+ s := getstrarray(c.mod, INTERFACES);
	2062	+ if (s == nil)
	2063	+ return;
	2064	+ n := len s;
	2065	+ trace(JDEBUG, sys->sprint("inter %s %d", c.name, n));
	2066	+ l: list of ref Class;
	2067	+ for (i := 0; i < n; i++)
	2068	+ l = loadhierarchy(s[i]) :: l;
	2069	+ c.interextends = l;
	2070	+ if (c.flags & ACC_INTERFACE) {
	2071	+ c.flags \|= JCL_INTEREXT;
	2072	+ interfx = c :: interfx;
	2073	+ } else
	2074	+ interf = c :: interf;
	2075	+}
	2076	+
	2077	+#
	2078	+# Add a class to a list.
	2079	+#
	2080	+addclass(c: ref Class, n: list of ref Class): list of ref Class
	2081	+{
	2082	+ for (l := n; l != nil; l = tl l)
	2083	+ if (hd l == c)
	2084	+ return n;
	2085	+ return c :: n;
	2086	+}
	2087	+
	2088	+#
	2089	+# Extend list of interfaces.
	2090	+#
	2091	+interext(l: list of ref Class): list of ref Class
	2092	+{
	2093	+ n: list of ref Class;
	2094	+ while (l != nil) {
	2095	+ c := hd l;
	2096	+ n = addclass(c, n);
	2097	+ for (x := c.interextends; x != nil; x = tl x)
	2098	+ n = addclass(hd x, n);
	2099	+ l = tl l;
	2100	+ }
	2101	+ return n;
	2102	+}
	2103	+
	2104	+#
	2105	+# Extend (transitively) an interface.
	2106	+#
	2107	+intertrans(c: ref Class, n: list of ref Class): list of ref Class
	2108	+{
	2109	+ if (c.flags & JCL_INTERWORK)
	2110	+ error("circular interface extension"); #ClassCircularityError ??
	2111	+ n = addclass(c, n);
	2112	+ c.extinterfaces();
	2113	+ for (l := c.interextends; l != nil; l = tl l)
	2114	+ n = addclass(hd l, n);
	2115	+ return n;
	2116	+}
	2117	+
	2118	+#
	2119	+# Extend interfaces.
	2120	+#
	2121	+Class.extinterfaces(c: self ref Class)
	2122	+{
	2123	+ if ((c.flags & JCL_INTEREXT) == 0)
	2124	+ return;
	2125	+ c.flags \|= JCL_INTERWORK;
	2126	+ n: list of ref Class;
	2127	+ for (l := c.interextends; l != nil; l = tl l)
	2128	+ n = intertrans(hd l, n);
	2129	+ c.interextends = n;
	2130	+ c.flags &= ~(JCL_INTEREXT \| JCL_INTERWORK);
	2131	+}
	2132	+
	2133	+#
	2134	+# Resolve the implementation of a class' interfaces.
	2135	+#
	2136	+Class.linkinterfaces(c: self ref Class)
	2137	+{
	2138	+ cur = c.name;
	2139	+ l := interext(c.interextends);
	2140	+ n := len l;
	2141	+ a := array[n] of Interface;
	2142	+ c.interfaces = a;
	2143	+ for (i := 0; i < n; i++) {
	2144	+ s := hd l;
	2145	+ l = tl l;
	2146	+ a[i].class = s;
	2147	+ if ((s.flags & ACC_INTERFACE) == 0)
	2148	+ loaderror(linkageerr, sys->sprint("%s not an interface", s.name));
	2149	+ v := s.virtualmethods;
	2150	+ m := len v;
	2151	+ o := array[m] of int;
	2152	+ a[i].methods = o;
	2153	+ for (j := 0; j < m; j++) {
	2154	+ f := v[j].field;
	2155	+ x := findmfsx(c.virtualmethods, f.field, f.signature);
	2156	+ if (x < 0)
	2157	+ loaderror( nosuchmethod, sys->sprint("method %s'%s' of interface %s not implemented",
	2158	+ f.field, f.signature, s.name));
	2159	+ else
	2160	+ o[j] = (METHODOFFSET + x * 2) * WORDZ;
	2161	+ }
	2162	+ }
	2163	+ cur = nil;
	2164	+}
	2165	+
	2166	+#
	2167	+# This is the second pass of class loading. All classes needed for
	2168	+# relocation have been resolved.
	2169	+#
	2170	+Class.relocate(c: self ref Class)
	2171	+{
	2172	+ cur = c.name;
	2173	+ trace(JDEBUG, sys->sprint("relocate(%s) enter", c.name));
	2174	+ #
	2175	+ # Count extra entries (e.g. @mp and @adt).
	2176	+ #
	2177	+ n := nextra(getreloc(c.mod, RELOC));
	2178	+ i := CLASSREF;
	2179	+ while ((s := getstring(c.mod, i)) != nil) {
	2180	+ n += nextra(getreloc(c.mod, i + WORDZ));
	2181	+ i += 2 * WORDZ;
	2182	+ }
	2183	+ c.dataoffset = (i + 4 + 31) & ~31;
	2184	+ c.nextra = n;
	2185	+ #
	2186	+ # Record extras.
	2187	+ #
	2188	+ c.info.extras = array[n] of Extra;
	2189	+ n = c.extras(getreloc(c.mod, RELOC), 0, c);
	2190	+ j := 0;
	2191	+ i = CLASSREF;
	2192	+ while ((s = getstring(c.mod, i)) != nil) {
	2193	+ n = c.extras(getreloc(c.mod, i + WORDZ), n, c.refs[j]);
	2194	+ i += 2 * WORDZ;
	2195	+ j++;
	2196	+ }
	2197	+ #
	2198	+ # Determine size of new module data.
	2199	+ #
	2200	+ v := len c.virtualmethods;
	2201	+ z := METHODOFFSET * WORDZ + v * 2 * WORDZ + c.staticsize + c.nextra * WORDZ + WORDZ;
	2202	+ c.datareloc = (z + 31) & ~31;
	2203	+ c.datasize = getint(c.mod, DSIZE);
	2204	+ c.modsize = c.datareloc + c.datasize;
	2205	+ z = ((c.modsize / WORDZ) + 7) / 8;
	2206	+ m := array[z] of byte;
	2207	+ #
	2208	+ # Create type map for module.
	2209	+ #
	2210	+ c.modmap = m;
	2211	+ #
	2212	+ # First two entries are nil and ref Class adt.
	2213	+ #
	2214	+ m[0] = byte 16rC0;
	2215	+ for (i = 1; i < z; i++)
	2216	+ m[i] = byte 0;
	2217	+ #
	2218	+ # Method table.
	2219	+ #
	2220	+ for (i = 1; i <= v; i++) {
	2221	+ x := i / 4;
	2222	+ m[x] = byte ((int m[x]) \| mbits[i & 3]);
	2223	+ }
	2224	+ o := METHODOFFSET + v * 2;
	2225	+ #
	2226	+ # Static data.
	2227	+ #
	2228	+ c.staticoffset = o * WORDZ;
	2229	+ d := c.staticdata;
	2230	+ for (i = 0; i < len d; i++) {
	2231	+ f := d[i];
	2232	+ if (ispointer(f.signature)) {
	2233	+ w := o + (f.value / WORDZ);
	2234	+ x := w / 8;
	2235	+ m[x] = byte ((int m[x]) \| bits[w & 7]);
	2236	+ }
	2237	+ }
	2238	+ o += c.staticsize / WORDZ;
	2239	+ #
	2240	+ # Extra data.
	2241	+ #
	2242	+ c.info.extraoffset = o * WORDZ;
	2243	+ for (i = 0; i < c.nextra; i++) {
	2244	+ x := o / 8;
	2245	+ m[x] = byte ((int m[x]) \| bits[o & 7]);
	2246	+ o++;
	2247	+ }
	2248	+ #
	2249	+ # Copy class module data and its map.
	2250	+ #
	2251	+ if (c.datasize > 0) {
	2252	+ if (c.datasize + c.dataoffset > c.info.types[0].size) {
	2253	+ error("bad data size/offset");
	2254	+ c.datasize = 0;
	2255	+ } else
	2256	+ c.copymap(c.info.types[0].map, c.dataoffset);
	2257	+ }
	2258	+ trace(JDEBUG, sys->sprint("%s data %d reloc %d", c.name, c.modsize, c.datareloc));
	2259	+ trace(JDEBUG, sys->sprint("\t%d bytes at %d", c.datasize, c.dataoffset));
	2260	+ md := ld->dnew(c.modsize, c.modmap);
	2261	+ if (md == nil)
	2262	+ error(sys->sprint("dnew failed: %r"));
	2263	+ c.moddata = md;
	2264	+ c.this = ref ClassObject(nil, c, nil);
	2265	+ #
	2266	+ # Fetch the instruction stream and patch it.
	2267	+ #
	2268	+ instructions := ld->ifetch(c.mod);
	2269	+ if (instructions == nil)
	2270	+ error(sys->sprint("ifetch failed: %r"));
	2271	+ c.instrpatch(instructions);
	2272	+ trace(JDEBUG, sys->sprint("\t%d instrs", len instructions));
	2273	+ #
	2274	+ # Make the new module.
	2275	+ #
	2276	+ links := c.info.links;
	2277	+ oldmod := c.mod;
	2278	+ c.mod = ld->newmod(c.name, STACKSIZE, len links, instructions, md);
	2279	+ if (c.mod == nil)
	2280	+ error(sys->sprint("newmod failed: %r"));
	2281	+ addmodclass(c.mod, c);
	2282	+ #
	2283	+ # Install the new types.
	2284	+ #
	2285	+ types := c.info.types;
	2286	+ for (i = 1; i < len types; i++) {
	2287	+ if (ld->tnew(c.mod, types[i].size, types[i].map) != i)
	2288	+ error(sys->sprint("tnew failed: %r"));
	2289	+ }
	2290	+ #
	2291	+ # Install the links.
	2292	+ #
	2293	+ for (i = 0; i < len links; i++) {
	2294	+ if (ld->ext(c.mod, i, links[i].pc, links[i].tdesc) < 0)
	2295	+ error(sys->sprint("ext failed: %r"));
	2296	+ }
	2297	+ #
	2298	+ # This word is used by rtload.
	2299	+ #
	2300	+ putint(md, c.datareloc - WORDZ, c.datareloc);
	2301	+ if (c.datasize > 0)
	2302	+ c.copymd(md, c.dataoffset, oldmod);
	2303	+ c.makeobjtype();
	2304	+ trace(JDEBUG, sys->sprint("relocate(%s) exit", c.name));
	2305	+ cur = nil;
	2306	+}
	2307	+
	2308	+#
	2309	+# Instruction patching.
	2310	+#
	2311	+Class.instrpatch(c: self ref Class, inst: array of Loader->Inst)
	2312	+{
	2313	+ #
	2314	+ # A class' own relocations were determined in resolve.
	2315	+ #
	2316	+ r := getreloc(c.mod, RELOC);
	2317	+ p := c.info.reloc;
	2318	+ x := c.info.extraoffset;
	2319	+ n := len r;
	2320	+ for (i := 0; i < n; i++) {
	2321	+ v: int;
	2322	+ case p[i].what {
	2323	+ PVALUE =>
	2324	+ v = p[i].value;
	2325	+ PEXTRA =>
	2326	+ v = x + p[i].value * WORDZ;
	2327	+ PMETHOD =>
	2328	+ v = (METHODOFFSET + p[i].value * 2) * WORDZ;
	2329	+ PSTATIC =>
	2330	+ v = c.staticoffset + p[i].value;
	2331	+ * =>
	2332	+ error("bad Patch");
	2333	+ }
	2334	+ ipatch(inst, r[i].patch, v);
	2335	+ }
	2336	+ x += c.info.extrabase * WORDZ;
	2337	+ #
	2338	+ # Data relocation.
	2339	+ #
	2340	+ ipatch(inst, getbytearray(c.mod, DRELOC), c.datareloc);
	2341	+ #
	2342	+ # Patching for referenced classes (and @Loader).
	2343	+ #
	2344	+ j := 0;
	2345	+ i = CLASSREF;
	2346	+ while ((s := getstring(c.mod, i)) != nil) {
	2347	+ k := c.refs[j];
	2348	+ if (k != nil)
	2349	+ x = k.relocref(c, inst, getreloc(c.mod, i + WORDZ), x);
	2350	+ else
	2351	+ x = relocloader(inst, getreloc(c.mod, i + WORDZ), x);
	2352	+ i += 2 * WORDZ;
	2353	+ j++;
	2354	+ }
	2355	+}
	2356	+
	2357	+#
	2358	+# Third pass of class loader. All referenced classes
	2359	+# have had new modules allocated.
	2360	+#
	2361	+Class.modpatch(c: self ref Class)
	2362	+{
	2363	+ cur = c.name;
	2364	+ d := c.moddata;
	2365	+ putclass(d, CLASSADTOFFSET, c);
	2366	+ v := c.virtualmethods;
	2367	+ n := len v;
	2368	+ o := METHODOFFSET * WORDZ;
	2369	+ for (i := 0; i < n; i++) {
	2370	+ m := v[i];
	2371	+ if (isnative(m.field.flags))
	2372	+ putmod(d, o, m.class.native);
	2373	+ else
	2374	+ putmod(d, o, m.class.mod);
	2375	+ putint(d, o + WORDZ, m.field.value);
	2376	+ o += 2 * WORDZ;
	2377	+ }
	2378	+ x := c.info.extras;
	2379	+ n = len x;
	2380	+ o = c.info.extraoffset;
	2381	+ for (i = 0; i < n; i++) {
	2382	+ e := x[i];
	2383	+ case e.what {
	2384	+ CMP =>
	2385	+ if (e.class == nil)
	2386	+ putmod(d, o, thisnil);
	2387	+ else
	2388	+ putmod(d, o, e.class.mod);
	2389	+ CADT =>
	2390	+ putclass(d, o, e.class);
	2391	+ CNP =>
	2392	+ putmod(d, o, e.class.native);
	2393	+ COBJ =>
	2394	+ putobj(d, o, e.class.this);
	2395	+ CJEX =>
	2396	+ putstring(d, o, JAVAEXCEPTION);
	2397	+ CSYS =>
	2398	+ putmod(d, o, sysnil);
	2399	+ * =>
	2400	+ error("bad extra what");
	2401	+ }
	2402	+ o += WORDZ;
	2403	+ }
	2404	+ trace(JDEBUG, sys->sprint("compile %s", c.name));
	2405	+ if ((c.flags & DONTCOMPILE) == 0) {
	2406	+ if (ld->compile(c.mod, c.flags & MUSTCOMPILE) < 0)
	2407	+ error(sys->sprint("compile %s failed: %r", c.name));
	2408	+ if (c.native != nil) {
	2409	+ trace(JDEBUG, sys->sprint("compile native %s", c.name));
	2410	+ if (ld->compile(c.native, c.flags & MUSTCOMPILE) < 0)
	2411	+ error(sys->sprint("compile native %s failed: %r", c.name));
	2412	+ }
	2413	+ }
	2414	+ cur = nil;
	2415	+}
	2416	+
	2417	+#
	2418	+# Resolution routines.
	2419	+#
	2420	+
	2421	+#
	2422	+# Check for method override.
	2423	+#
	2424	+Class.override(c: self ref Class, f, s: string): int
	2425	+{
	2426	+ if (c.super == nil)
	2427	+ return -1;
	2428	+ m := c.super.virtualmethods;
	2429	+ n := len m;
	2430	+ for (i := 0; i < n; i++) {
	2431	+ t := m[i].field;
	2432	+ if (t.field == f && t.signature == s)
	2433	+ return i;
	2434	+ }
	2435	+ return -1;
	2436	+}
	2437	+
	2438	+#
	2439	+# Find init method.
	2440	+#
	2441	+Class.findimethod(c: self ref Class, s: string): ref Field
	2442	+{
	2443	+ return findasig(c.initmethods, s);
	2444	+}
	2445	+
	2446	+#
	2447	+# Find private method.
	2448	+#
	2449	+Class.findpmethod(c: self ref Class, f, s: string): ref Field
	2450	+{
	2451	+ return findafs(c.privatemethods, f, s);
	2452	+}
	2453	+
	2454	+#
	2455	+# Find static field.
	2456	+#
	2457	+Class.findsfield(c: self ref Class, f: string): ref Field
	2458	+{
	2459	+ return findafield(c.staticdata, f);
	2460	+}
	2461	+
	2462	+#
	2463	+# Find static method.
	2464	+#
	2465	+Class.findsmethod(c: self ref Class, f, s: string): ref Field
	2466	+{
	2467	+ return findafs(c.staticmethods, f, s);
	2468	+}
	2469	+
	2470	+#
	2471	+# Find object field.
	2472	+#
	2473	+Class.findofield(c: self ref Class, f: string): ref Field
	2474	+{
	2475	+ return findfield(c.objectdata, f);
	2476	+}
	2477	+
	2478	+#
	2479	+# Find virtual method.
	2480	+#
	2481	+Class.findvmethod(c: self ref Class, f, s: string): int
	2482	+{
	2483	+ a := c.virtualmethods;
	2484	+ n := len a;
	2485	+ if (c.name == "java/lang/StringBuffer") {
	2486	+ trace(JDEBUG, sys->sprint("Class: %s, virtual methods: %d", c.name, n));
	2487	+ trace(JDEBUG, sys->sprint("Started looking for method: %s, %s", f, s));
	2488	+ statenames := array [] of {"NEW", "HIER", "RESOLVE", "LOADED", "INITED"};
	2489	+ trace(JDEBUG, sys->sprint("Class state: %s", statenames[c.state]));
	2490	+ }
	2491	+ for (i := 0; i < n; i++) {
	2492	+ t := a[i].field;
	2493	+ if (t.field == f && t.signature == s)
	2494	+ return i;
	2495	+ }
	2496	+ trace(JDEBUG, "returned fail");
	2497	+ return -1;
	2498	+}
	2499	+
	2500	+Class.loadnative(c: self ref Class)
	2501	+{
	2502	+ native := ROOT + c.encoding + "_L.dis";
	2503	+ mod := load Nilmod native;
	2504	+ if (mod == nil) {
	2505	+ trace(JVERBOSE, sys->sprint("Load native failed: %r"));
	2506	+ return;
	2507	+ }
	2508	+ trace(JDEBUG, sys->sprint("\"%s\"", native));
	2509	+ links := ld->link(mod);
	2510	+ if (links == nil)
	2511	+ error(sys->sprint("%s: native Loader->link failed: %r", unsatisfiedlink));
	2512	+ c.info.nlinks = links;
	2513	+ types := ld->tdesc(mod);
	2514	+ if (types == nil)
	2515	+ error(sys->sprint("%s: native tdesc failed: %r",unsatisfiedlink));
	2516	+ instrs := ld->ifetch(mod);
	2517	+ if (instrs == nil)
	2518	+ error(sys->sprint("%s: native ifetch failed: %r",unsatisfiedlink));
	2519	+ nm := ld->newmod("N-" + c.name, STACKSIZE, len links, instrs, getmd(mod));
	2520	+ if (nm == nil)
	2521	+ error(sys->sprint("%s: native newmod failed: %r",unsatisfiedlink));
	2522	+ n := len types;
	2523	+ for (i := 1; i < n; i++) {
	2524	+ if (ld->tnew(nm, types[i].size, types[i].map) != i)
	2525	+ error(sys->sprint("%s: native tnew failed: %r",unsatisfiedlink));
	2526	+ }
	2527	+ n = len links;
	2528	+ for (i = 0; i < n; i++) {
	2529	+ if (ld->ext(nm, i, links[i].pc, links[i].tdesc) < 0)
	2530	+ error(sys->sprint("%s: native ext failed: %r",unsatisfiedlink));
	2531	+ }
	2532	+ addmodclass(nm, c);
	2533	+ c.native = nm;
	2534	+}
	2535	+
	2536	+#
	2537	+# Search the links for a method. Maybe load the native module.
	2538	+#
	2539	+Class.getmethod(c: self ref Class, f, s: string, flags: int): int
	2540	+{
	2541	+ trace(JDEBUG, sys->sprint("Getmethod of %s: %s, %s, %d", c.name, f, s, flags));
	2542	+ l: array of Loader->Link;
	2543	+ m: string;
	2544	+ if (isnative(flags)) {
	2545	+ if (c.native == nil)
	2546	+ c.loadnative();
	2547	+ l = c.info.nlinks;
	2548	+ m = mangle(f, s);
	2549	+ } else {
	2550	+ l = c.info.links;
	2551	+ m = f + s;
	2552	+ }
	2553	+ n := len l;
	2554	+ for (i := 0; i < n; i++) {
	2555	+ if (l[i].name == m)
	2556	+ return i;
	2557	+ }
	2558	+ if (!(flags & (ACC_ABSTRACT \| ACC_NATIVE)))
	2559	+ {
	2560	+ loaderror( nosuchmethod, sys->sprint("method %x %s '%s' %s not found", flags, f, s, m) );
	2561	+ }
	2562	+ return -1;
	2563	+}
	2564	+
	2565	+#
	2566	+# Find method called with invokespecial.
	2567	+#
	2568	+Class.special(c: self ref Class, f, s: string, flags: int, r: ref Class): (int, ref Class, int)
	2569	+{
	2570	+ if (f == SPECIALINIT) {
	2571	+ i := findasig(r.initmethods, s);
	2572	+ if (i == nil)
	2573	+ error(sys->sprint("%s: <init> '%s' not found in class %s", nosuchmethod, s, r.name));
	2574	+ return (CMP, r, i.value);
	2575	+ } else if (isprivate(flags)) {
	2576	+ p := findafs(r.privatemethods, f, s);
	2577	+ if (p == nil)
	2578	+ error("invokespecial private botch");
	2579	+ if (isnative(p.flags))
	2580	+ return (CNP, r, p.value);
	2581	+ else
	2582	+ return (CMP, r, p.value);
	2583	+ } else {
	2584	+ r = c.super;
	2585	+ if (r == nil)
	2586	+ error("invokespecial super botch");
	2587	+ i := r.findvmethod(f, s);
	2588	+ if (i < 0)
	2589	+ error("invokespecial botch");
	2590	+ m := r.virtualmethods[i];
	2591	+ if (isnative(m.field.flags))
	2592	+ return (CNP, m.class, m.field.value);
	2593	+ else
	2594	+ return (CMP, m.class, m.field.value);
	2595	+ }
	2596	+}
	2597	+
	2598	+#
	2599	+# Record info for an extra.
	2600	+#
	2601	+Class.extra(c: self ref Class, w, n: int, r: ref Class)
	2602	+{
	2603	+ c.info.extras[n].what = w;
	2604	+ c.info.extras[n].class = r;
	2605	+}
	2606	+
	2607	+#
	2608	+# Record info for extras.
	2609	+#
	2610	+Class.extras(c: self ref Class, a: array of Reloc, n: int, r: ref Class): int
	2611	+{
	2612	+ l := len a;
	2613	+ for (i := 0; i < l; i++) {
	2614	+ f := a[i].field;
	2615	+ if (f[0] != '@')
	2616	+ break;
	2617	+ case f {
	2618	+ MP =>
	2619	+ c.extra(CMP, n, r);
	2620	+ ADT =>
	2621	+ c.extra(CADT, n, r);
	2622	+ NP =>
	2623	+ c.extra(CNP, n, r);
	2624	+ OBJ =>
	2625	+ c.extra(COBJ, n, r);
	2626	+ JEX =>
	2627	+ if (r != nil)
	2628	+ error("@jex not in @Loader");
	2629	+ c.extra(CJEX, n, nil);
	2630	+ SYS =>
	2631	+ if (r != nil)
	2632	+ error("@sys not in @Loader");
	2633	+ c.extra(CSYS, n, nil);
	2634	+ CLASS =>
	2635	+ n--;
	2636	+ * =>
	2637	+ error(sys->sprint("unknown reloc: %s", f));
	2638	+ }
	2639	+ n++;
	2640	+ }
	2641	+ for (; i < l; i++) {
	2642	+ if (a[i].flags & Rspecialmp) {
	2643	+ if ((a[i].flags & Rmask) != Rinvokespecial)
	2644	+ error("bad Rspecialmp");
	2645	+ (v, s, nil) := c.special(a[i].field, a[i].signature, a[i].flags, r);
	2646	+ c.extra(v, n, s);
	2647	+ n++;
	2648	+ }
	2649	+ }
	2650	+ return n;
	2651	+}
	2652	+
	2653	+#
	2654	+# Count the extra data fields need for a Reloc.
	2655	+#
	2656	+nextra(a: array of Reloc): int
	2657	+{
	2658	+ n := 0;
	2659	+ l := len a;
	2660	+ for (i := 0; i < l; i++) {
	2661	+ f := a[i].field;
	2662	+ if (f[0] != '@')
	2663	+ break;
	2664	+ case f {
	2665	+ MP or NP or ADT or OBJ or JEX or SYS =>
	2666	+ n++;
	2667	+ }
	2668	+ }
	2669	+ for (; i < l; i++) {
	2670	+ if (a[i].flags & Rspecialmp)
	2671	+ n++;
	2672	+ }
	2673	+ return n;
	2674	+}
	2675	+
	2676	+#
	2677	+# Copy old module map corresponding to module data to new map.
	2678	+#
	2679	+Class.copymap(c: self ref Class, om: array of byte, dr: int)
	2680	+{
	2681	+ nm := c.modmap;
	2682	+ s := dr / MAPZ;
	2683	+ d := c.datareloc / MAPZ;
	2684	+ while (d < len nm) {
	2685	+ if (s < len om)
	2686	+ nm[d] = om[s];
	2687	+ else
	2688	+ nm[d] = byte 0;
	2689	+ s++;
	2690	+ d++;
	2691	+ }
	2692	+}
	2693	+
	2694	+#
	2695	+# Copy old module data to new module data.
	2696	+#
	2697	+Class.copymd(c: self ref Class, md: ref Niladt, dr: int, om: Nilmod)
	2698	+{
	2699	+ m := c.modmap;
	2700	+ s := dr;
	2701	+ d := c.datareloc;
	2702	+ for (i := 0; i < c.datasize; i+= WORDZ) {
	2703	+ w := d / WORDZ;
	2704	+ if ((int m[w / 8] & bits[w & 7]) != 0)
	2705	+ putptr(md, d, getptr(om, s));
	2706	+ else
	2707	+ putint(md, d, getint(om, s));
	2708	+ d += WORDZ;
	2709	+ s += WORDZ;
	2710	+ }
	2711	+}
	2712	+
	2713	+#
	2714	+# Resolve a relocation for a referenced class.
	2715	+#
	2716	+Class.resolvereloc(c: self ref Class, r, s: string, flags: int): (int, int)
	2717	+{
	2718	+ v: int;
	2719	+ f: ref Field;
	2720	+ case flags & Rmask {
	2721	+ Rgetputfield =>
	2722	+ f = findfield(c.objectdata, r);
	2723	+ if (f == nil)
	2724	+ loaderror(nosuchfield, sys->sprint("%s not resolved in class %s", r, c.name));
	2725	+ else {
	2726	+ if (f.signature != s) {
	2727	+ loaderror(nosuchfield, sys->sprint("%s type mismatch in class %s:%s vs %s", r, c.name, f.signature, s));
	2728	+ }
	2729	+ v = f.value;
	2730	+ }
	2731	+ Rgetputstatic =>
	2732	+ f = c.findsfield(r);
	2733	+ if (f == nil)
	2734	+ loaderror( nosuchfield, sys->sprint("static %s not found in class %s", r, c.name));
	2735	+ else {
	2736	+ if (f.signature != s) {
	2737	+ loaderror(nosuchfield, sys->sprint("%s static type mismatch in class %s:%s vs %s", r, c.name, f.signature, s));
	2738	+ }
	2739	+ v = c.staticoffset + f.value;
	2740	+ }
	2741	+ Rinvokeinterface =>
	2742	+ if ((c.flags & ACC_INTERFACE) == 0) {
	2743	+ loaderror(linkageerr, sys->sprint("%s is not an interface", c.name));
	2744	+ break;
	2745	+ }
	2746	+ v = findmfsx(c.virtualmethods, r, s);
	2747	+ if (v < 0)
	2748	+ loaderror( nosuchmethod, sys->sprint("interface method %s '%s' not found in class %s", r, s, c.name));
	2749	+ v \|= c.interindex << 16;
	2750	+ Rinvokespecial =>
	2751	+ error("Rinvokespecial botch");
	2752	+ Rinvokestatic =>
	2753	+ f = c.findsmethod(r, s);
	2754	+ if (f == nil)
	2755	+ loaderror( nosuchmethod, sys->sprint("static method %s '%s' not found in class %s", r, s, c.name));
	2756	+ else if (flags & Rstaticmp) {
	2757	+ if (f.flags & ACC_NATIVE)
	2758	+ return (VNP, 0);
	2759	+ else
	2760	+ return (VMP, 0);
	2761	+ } else
	2762	+ v = f.value;
	2763	+ Rinvokevirtual =>
	2764	+ v = c.findvmethod(r, s);
	2765	+ if (v < 0)
	2766	+ loaderror( nosuchmethod, sys->sprint("method %s '%s' not resolved in class %s", r, s, c.name));
	2767	+ v = (METHODOFFSET + v * 2) * WORDZ;
	2768	+ * =>
	2769	+ if (r == OBJ)
	2770	+ return (VOBJ, 0);
	2771	+ error(sys->sprint("%s: bad Rmask", c.name));
	2772	+ }
	2773	+ return (VVAL, v);
	2774	+}
	2775	+
	2776	+#
	2777	+# Perform relocation for a referenced class.
	2778	+#
	2779	+Class.relocref(c: self ref Class, t: ref Class, inst: array of Loader->Inst, a: array of Reloc, x: int): int
	2780	+{
	2781	+ v, w: int;
	2782	+ mp := -1;
	2783	+ np := -1;
	2784	+ n := len a;
	2785	+ for (i := 0; i < n; i++) {
	2786	+ f := a[i].field;
	2787	+ if (f[0] != '@')
	2788	+ break;
	2789	+ case f {
	2790	+ MP =>
	2791	+ if (mp >= 0)
	2792	+ error("repeat @mp");
	2793	+ mp = x;
	2794	+ v = x;
	2795	+ x += WORDZ;
	2796	+ NP =>
	2797	+ if (np >= 0)
	2798	+ error("repeat @np");
	2799	+ np = x;
	2800	+ v = x;
	2801	+ x += WORDZ;
	2802	+ ADT =>
	2803	+ v = x;
	2804	+ x += WORDZ;
	2805	+ OBJ =>
	2806	+ v = x;
	2807	+ x += WORDZ;
	2808	+ JEX =>
	2809	+ error("@jex not in @Loader");
	2810	+ SYS =>
	2811	+ error("@sys not in @Loader");
	2812	+ CLASS =>
	2813	+ v = c.objtype;
	2814	+ * =>
	2815	+ error("@botch");
	2816	+ }
	2817	+ ipatch(inst, a[i].patch, v);
	2818	+ }
	2819	+ for (; i < n; i++) {
	2820	+ if ((a[i].flags & Rmask) == Rinvokespecial) {
	2821	+ if (a[i].flags & Rspecialmp) {
	2822	+ v = x;
	2823	+ x += WORDZ;
	2824	+ } else
	2825	+ (nil, nil, v) = t.special(a[i].field, a[i].signature, a[i].flags, c);
	2826	+ } else {
	2827	+ (w, v) = c.resolvereloc(a[i].field, a[i].signature, a[i].flags);
	2828	+ if (w == VMP) {
	2829	+ if (mp < 0)
	2830	+ error("no @mp for Rstaticmp");
	2831	+ v = mp;
	2832	+ } else if (w == VNP) {
	2833	+ if (np < 0)
	2834	+ error("no @np for Rstaticmp");
	2835	+ v = np;
	2836	+ }
	2837	+ }
	2838	+ ipatch(inst, a[i].patch, v);
	2839	+ }
	2840	+ return x;
	2841	+}
	2842	+
	2843	+#
	2844	+# Record an interface and assign it an ordinal.
	2845	+#
	2846	+Class.addinterface(c: self ref Class)
	2847	+{
	2848	+ if (ninterfaces == linterfaces) {
	2849	+ if (ninterfaces == 0) {
	2850	+ linterfaces = INITINTER;
	2851	+ interfaces = array[INITINTER] of ref Class;
	2852	+ } else {
	2853	+ n := linterfaces * 3 / 2;
	2854	+ a := array[n] of ref Class;
	2855	+ for (i := 0; i < linterfaces; i++)
	2856	+ a[i] = interfaces[i];
	2857	+ linterfaces = n;
	2858	+ interfaces = a;
	2859	+ }
	2860	+ }
	2861	+ c.interindex = ninterfaces;
	2862	+ interfaces[ninterfaces++] = c;
	2863	+}
	2864	+
	2865	+#
	2866	+# Search for an interface implementation.
	2867	+#
	2868	+Class.interlook(c: self ref Class, a: array of Interface): array of int
	2869	+{
	2870	+ if (a == nil)
	2871	+ return nil;
	2872	+ n := len a;
	2873	+ for (i := 0; i < n; i++) {
	2874	+ d := a[i].class;
	2875	+ do {
	2876	+ if (d == c)
	2877	+ return a[i].methods;
	2878	+ d = d.super;
	2879	+ } while (d != nil);
	2880	+ }
	2881	+ return nil;
	2882	+}
	2883	+
	2884	+#
	2885	+# Fetch interface table, possibly cached.
	2886	+#
	2887	+Class.getinterface(c: self ref Class, k: ref Class): array of int
	2888	+{
	2889	+ for (l := c.intercache; l != nil; l = tl l) {
	2890	+ (d, m) := hd l;
	2891	+ if (d == k)
	2892	+ return m;
	2893	+ }
	2894	+ m: array of int;
	2895	+ d := c;
	2896	+ do {
	2897	+ m = k.interlook(d.interfaces);
	2898	+ d = d.super;
	2899	+ } while (m == nil && d != nil);
	2900	+ if (m != nil) {
	2901	+ c.intercache = (k, m) :: c.intercache;
	2902	+ return m;
	2903	+ }
	2904	+ return nil;
	2905	+}
	2906	+
	2907	+#
	2908	+# Call native module init function.
	2909	+#
	2910	+Class.initjni(c: self ref Class)
	2911	+{
	2912	+ trace(JVERBOSE, sys->sprint("%s->init()", c.name));
	2913	+ l := c.info.nlinks;
	2914	+ n := len l;
	2915	+ for (i := 0; i < n; i++) {
	2916	+ if (l[i].name == "init") {
	2917	+ if (l[i].sig != jnisig)
	2918	+ error(sys->sprint("init typecheck in class %s native", c.name));
	2919	+ jassist->mcallm(c.native, i, jninil);
	2920	+ trace(JDEBUG, "done");
	2921	+ return;
	2922	+ }
	2923	+ }
	2924	+ error(sys->sprint("no init function in class %s native", c.name));
	2925	+}
	2926	+
	2927	+#
	2928	+# @Loader relocation.
	2929	+#
	2930	+relocloader(inst: array of Loader->Inst, a: array of Reloc, x: int): int
	2931	+{
	2932	+ v: int;
	2933	+ n := len a;
	2934	+ for (i := 0; i < n; i++) {
	2935	+ r := a[i].field;
	2936	+ case r {
	2937	+ MP or JEX or SYS =>
	2938	+ v = x;
	2939	+ x += WORDZ;
	2940	+ CLASS =>
	2941	+ error("@Loader @Class");
	2942	+ ADT =>
	2943	+ error("@Loader @adt");
	2944	+ NP =>
	2945	+ error("@Loader @np");
	2946	+ OBJ =>
	2947	+ error("@Loader @obj");
	2948	+ * =>
	2949	+ v = getloader(r);
	2950	+ if (v < 0)
	2951	+ error(sys->sprint("no ClassLoader/Sys entry %s", r));
	2952	+ }
	2953	+ ipatch(inst, a[i].patch, v);
	2954	+ }
	2955	+ return x;
	2956	+}
	2957	+
	2958	+#
	2959	+# @Loader and @Sys entries.
	2960	+# This uses a magic hash which maps each loadkey to a unique index.
	2961	+# If you add a loadkey you will need new magic.
	2962	+#
	2963	+
	2964	+LDHASH: con 38;
	2965	+
	2966	+LoadMap: adt
	2967	+{
	2968	+ name: string;
	2969	+ value: int;
	2970	+};
	2971	+
	2972	+loadtable := array[LDHASH] of LoadMap;
	2973	+
	2974	+loadkeys := array[] of
	2975	+{
	2976	+ "aastorecheck",
	2977	+ "acheckcast",
	2978	+ "ainstanceof",
	2979	+ "checkcast",
	2980	+ "culprit",
	2981	+ "d2i",
	2982	+ "d2l",
	2983	+ "dcmpg",
	2984	+ "dcmpl",
	2985	+ "drem",
	2986	+ "getinterface",
	2987	+ "instanceof",
	2988	+ "lcmp",
	2989	+ "monitorenter",
	2990	+ "monitorexit",
	2991	+ "multianewarray",
	2992	+ "pcheckcast",
	2993	+ "pinstanceof",
	2994	+ "raise",
	2995	+ "rescue",
	2996	+ "rtload",
	2997	+ "throw",
	2998	+ "unrescue",
	2999	+};
	3000	+
	3001	+#
	3002	+# This function maps the above 23 strings to unique integers from 0 to 37.
	3003	+#
	3004	+loadhash(s: string): int
	3005	+{
	3006	+ return ((s[len s - 1] + 49) * len s + 19 * s[0]) % LDHASH;
	3007	+}
	3008	+
	3009	+loadenter(s: string, x: int)
	3010	+{
	3011	+ n := loadhash(s);
	3012	+ if (loadtable[n].name == s)
	3013	+ loadtable[n].value = x;
	3014	+}
	3015	+
	3016	+initloadhash()
	3017	+{
	3018	+ n := len loadkeys;
	3019	+ for (i := 0; i < n; i++) {
	3020	+ s := loadkeys[i];
	3021	+ loadtable[loadhash(s)].name = s;
	3022	+ }
	3023	+ a := loadlinks;
	3024	+ n = len a;
	3025	+ for (i = 0; i < n; i++)
	3026	+ loadenter(a[i].name, i);
	3027	+ a = syslinks;
	3028	+ n = len a;
	3029	+ for (i = 0; i < n; i++)
	3030	+ loadenter(a[i].name, i);
	3031	+}
	3032	+
	3033	+#
	3034	+# Map a string to a @Loader or @Sys index.
	3035	+#
	3036	+getloader(s: string): int
	3037	+{
	3038	+ n := loadhash(s);
	3039	+ if (loadtable[n].name != s)
	3040	+ error("getloader botch");
	3041	+ return loadtable[n].value;
	3042	+}
	3043	+
	3044	+#
	3045	+# Get Class adt from an object.
	3046	+#
	3047	+Object.class(o: self ref Object): ref Class
	3048	+{
	3049	+ return getclassadt(o.mod, CLASSADTOFFSET);
	3050	+}
	3051	+
	3052	+#
	3053	+# Categorizers.
	3054	+#
	3055	+isdata(sig: string): int
	3056	+{
	3057	+ return sig[0] != '(';
	3058	+}
	3059	+
	3060	+isspecial(field: string): int
	3061	+{
	3062	+ return field[0] == '<';
	3063	+}
	3064	+
	3065	+ispointer(sig: string): int
	3066	+{
	3067	+ case sig[0] {
	3068	+ 'L' or '[' =>
	3069	+ return 1;
	3070	+ }
	3071	+ return 0;
	3072	+}
	3073	+
	3074	+isprivate(flags: int): int
	3075	+{
	3076	+ return flags & ACC_PRIVATE;
	3077	+}
	3078	+
	3079	+isstatic(flags: int): int
	3080	+{
	3081	+ return flags & ACC_STATIC;
	3082	+}
	3083	+
	3084	+isnative(flags: int): int
	3085	+{
	3086	+ return flags & ACC_NATIVE;
	3087	+}
	3088	+
	3089	+isvirtual(flags: int): int
	3090	+{
	3091	+ return (flags & (ACC_PRIVATE \| ACC_STATIC)) == 0;
	3092	+}
	3093	+
	3094	+isabstract(flags: int): int
	3095	+{
	3096	+ return flags & ACC_ABSTRACT;
	3097	+}
	3098	+
	3099	+#
	3100	+# Type alignment.
	3101	+#
	3102	+alignto(sz: int, sig: string): int
	3103	+{
	3104	+ a: int;
	3105	+ if (sig == nil)
	3106	+ a = WORDZ;
	3107	+ else {
	3108	+ a = sizeof(sig);
	3109	+ if (a == 1)
	3110	+ return sz;
	3111	+ }
	3112	+ a--;
	3113	+ return (sz + a) & ~a;
	3114	+}
	3115	+
	3116	+#
	3117	+# Type size.
	3118	+#
	3119	+sizeof(sig: string): int
	3120	+{
	3121	+ case sig[0] {
	3122	+ 'Z' or 'B' =>
	3123	+ return 1;
	3124	+ 'D' or 'J' or 'F' =>
	3125	+ return 2 * WORDZ;
	3126	+ 'C' or 'S' or 'I' or 'L' or '[' =>
	3127	+ return WORDZ;
	3128	+ }
	3129	+ warning("unknown size: " + sig);
	3130	+ return WORDZ;
	3131	+}
	3132	+
	3133	+#
	3134	+# Utilities.
	3135	+#
	3136	+
	3137	+mkclarray(l: list of ref Class): array of ref Class
	3138	+{
	3139	+ n := len l;
	3140	+ a := array[n] of ref Class;
	3141	+ while (--n >= 0) {
	3142	+ a[n] = hd l;
	3143	+ l = tl l;
	3144	+ }
	3145	+ return a;
	3146	+}
	3147	+
	3148	+mkfdarray(l: list of ref Field): array of ref Field
	3149	+{
	3150	+ n := len l;
	3151	+ a := array[n] of ref Field;
	3152	+ while (--n >= 0) {
	3153	+ a[n] = hd l;
	3154	+ l = tl l;
	3155	+ }
	3156	+ return a;
	3157	+}
	3158	+
	3159	+findfield(l: list of ref Field, f: string): ref Field
	3160	+{
	3161	+ while (l != nil) {
	3162	+ h := hd l;
	3163	+ if (h.field == f)
	3164	+ return h;
	3165	+ l = tl l;
	3166	+ }
	3167	+ return nil;
	3168	+}
	3169	+
	3170	+findsig(l: list of ref Field, s: string): ref Field
	3171	+{
	3172	+ while (l != nil) {
	3173	+ h := hd l;
	3174	+ if (h.signature == s)
	3175	+ return h;
	3176	+ l = tl l;
	3177	+ }
	3178	+ return nil;
	3179	+}
	3180	+
	3181	+findfs(l: list of ref Field, f, s: string): ref Field
	3182	+{
	3183	+ while (l != nil) {
	3184	+ h := hd l;
	3185	+ if (h.field == f && h.signature == s)
	3186	+ return h;
	3187	+ l = tl l;
	3188	+ }
	3189	+ return nil;
	3190	+}
	3191	+
	3192	+findafield(a: array of ref Field, f: string): ref Field
	3193	+{
	3194	+ n := len a;
	3195	+ for (i := 0; i < n; i++) {
	3196	+ if (a[i].field == f)
	3197	+ return a[i];
	3198	+ }
	3199	+ return nil;
	3200	+}
	3201	+
	3202	+findasig(a: array of ref Field, s: string): ref Field
	3203	+{
	3204	+ n := len a;
	3205	+ for (i := 0; i < n; i++) {
	3206	+ if (a[i].signature == s)
	3207	+ return a[i];
	3208	+ }
	3209	+ return nil;
	3210	+}
	3211	+
	3212	+findafs(a: array of ref Field, f, s: string): ref Field
	3213	+{
	3214	+ n := len a;
	3215	+ for (i := 0; i < n; i++) {
	3216	+ if (a[i].field == f && a[i].signature == s)
	3217	+ return a[i];
	3218	+ }
	3219	+ return nil;
	3220	+}
	3221	+
	3222	+findmfsx(a: array of Method, f, s: string): int
	3223	+{
	3224	+ n := len a;
	3225	+ for (i := 0; i < n; i++) {
	3226	+ t := a[i].field;
	3227	+ if (t.field == f && t.signature == s)
	3228	+ return i;
	3229	+ }
	3230	+ return -1;
	3231	+}
	3232	+
	3233	+#
	3234	+# Patch an instruction.
	3235	+#
	3236	+ipatch(inst: array of Loader->Inst, p: array of byte, d: int)
	3237	+{
	3238	+ v: int;
	3239	+ l := len inst;
	3240	+ n := len p;
	3241	+ x := 0;
	3242	+ if (fsindir) {
	3243	+ for (i := 0; i < n; i++) {
	3244	+ t := int p[i];
	3245	+ if (t & RDELTA) {
	3246	+ x += (256 - t) << 3;
	3247	+ continue;
	3248	+ }
	3249	+ x += t >> ISHIFT;
	3250	+ if (x < 0 \|\| x >= l)
	3251	+ error("bad inst index");
	3252	+ if (inst[x].op == byte 57 && inst[x].mid == 0) {
	3253	+ trace(JVERBOSE, sys->sprint("Skipping instruction %d", x));
	3254	+ continue;
	3255	+ }
	3256	+ case t & (POP \| PTYPE) {
	3257	+ PSRC \| PIMM or PSRC \| PSIND =>
	3258	+ inst[x].src += d;
	3259	+ PSRC \| PDIND1 =>
	3260	+ v = inst[x].src;
	3261	+ inst[x].src = (v & int 16rFFFF0000) \| ((v & 16rFFFF) + d);
	3262	+ PSRC \| PDIND2 =>
	3263	+ v = inst[x].src;
	3264	+ inst[x].src = (v & 16rFFFF) \| ((v & int 16rFFFF0000) + (d << 16));
	3265	+ PMID \| PIMM or PMID \| PSIND =>
	3266	+ inst[x].mid += d;
	3267	+ PDST \| PIMM or PDST \| PSIND =>
	3268	+ inst[x].dst += d;
	3269	+ PDST \| PDIND1 =>
	3270	+ v = inst[x].dst;
	3271	+ inst[x].dst = (v & int 16rFFFF0000) \| ((v & 16rFFFF) + d);
	3272	+ PDST \| PDIND2 =>
	3273	+ v = inst[x].dst;
	3274	+ inst[x].dst = (v & 16rFFFF) \| ((v & int 16rFFFF0000) + (d << 16));
	3275	+ * =>
	3276	+ error("bad reloc");
	3277	+ }
	3278	+ }
	3279	+ } else {
	3280	+ for (i := 0; i < n; i++) {
	3281	+ t := int p[i];
	3282	+ if (t & RDELTA) {
	3283	+ x += (256 - t) << 3;
	3284	+ continue;
	3285	+ }
	3286	+ x += t >> ISHIFT;
	3287	+ if (x < 0 \|\| x >= l)
	3288	+ error("bad inst index");
	3289	+ case t & (POP \| PTYPE) {
	3290	+ PSRC \| PIMM or PSRC \| PSIND =>
	3291	+ inst[x].src += d;
	3292	+ PSRC \| PDIND1 =>
	3293	+ v = inst[x].src;
	3294	+ inst[x].src = (v & 16rFFFF) \| ((v & int 16rFFFF0000) + (d << 16));
	3295	+ PSRC \| PDIND2 =>
	3296	+ v = inst[x].src;
	3297	+ inst[x].src = (v & int 16rFFFF0000) \| ((v & 16rFFFF) + d);
	3298	+ PMID \| PIMM or PMID \| PSIND =>
	3299	+ inst[x].mid += d;
	3300	+ PDST \| PIMM or PDST \| PSIND =>
	3301	+ inst[x].dst += d;
	3302	+ PDST \| PDIND1 =>
	3303	+ v = inst[x].dst;
	3304	+ inst[x].dst = (v & 16rFFFF) \| ((v & int 16rFFFF0000) + (d << 16));
	3305	+ PDST \| PDIND2 =>
	3306	+ v = inst[x].dst;
	3307	+ inst[x].dst = (v & int 16rFFFF0000) \| ((v & 16rFFFF) + d);
	3308	+ * =>
	3309	+ error("bad POP");
	3310	+ }
	3311	+ }
	3312	+ }
	3313	+}
	3314	+
	3315	+#
	3316	+# String concatenation.
	3317	+#
	3318	+concat(l: list of string, r: int): string
	3319	+{
	3320	+ n := len l;
	3321	+ do {
	3322	+ t: list of string;
	3323	+ t = nil;
	3324	+ do {
	3325	+ if (n > 1) {
	3326	+ s0, s1: string;
	3327	+ if (r) {
	3328	+ s1 = hd l;
	3329	+ l = tl l;
	3330	+ s0 = hd l;
	3331	+ l = tl l;
	3332	+ } else {
	3333	+ s0 = hd l;
	3334	+ l = tl l;
	3335	+ s1 = hd l;
	3336	+ l = tl l;
	3337	+ }
	3338	+ t = (s0 + s1) :: t;
	3339	+ n -= 2;
	3340	+ } else {
	3341	+ t = (hd l) :: t;
	3342	+ break;
	3343	+ }
	3344	+ } while (l != nil);
	3345	+ l = t;
	3346	+ n = len l;
	3347	+ r = 1 - r;
	3348	+ } while (n > 1);
	3349	+ return hd l;
	3350	+}
	3351	+
	3352	+#
	3353	+# Native name mangling.
	3354	+#
	3355	+mangle(f, s: string): string
	3356	+{
	3357	+ l := f :: nil;
	3358	+ _ := 1;
	3359	+ a := 0;
	3360	+ while (s != nil) {
	3361	+ n := len s;
	3362	+ i := 0;
	3363	+ scan: for (;;) {
	3364	+ if (i == n) {
	3365	+ s = nil;
	3366	+ break;
	3367	+ }
	3368	+ if (_)
	3369	+ l = "_" :: l;
	3370	+ case s[i] {
	3371	+ '(' or ')' =>
	3372	+ _ = 0;
	3373	+ '[' =>
	3374	+ l = "a" :: l;
	3375	+ _ = 0;
	3376	+ a = 1;
	3377	+ 'L' =>
	3378	+ (c, r) := str->splitl(s[i + 1:], ";)");
	3379	+ (nil, b) := str->splitr(c, "/");
	3380	+ if (a)
	3381	+ l = b :: l;
	3382	+ else
	3383	+ l = b :: "r" :: l;
	3384	+ if (r == nil)
	3385	+ s = nil;
	3386	+ else
	3387	+ s = r[1:];
	3388	+ _ = 1;
	3389	+ a = 0;
	3390	+ break scan;
	3391	+ * =>
	3392	+ l = s[i:i + 1] :: l;
	3393	+ _ = 1;
	3394	+ a = 0;
	3395	+ }
	3396	+ i++;
	3397	+ }
	3398	+ }
	3399	+ return concat(l, 1);
	3400	+}
	3401	+
	3402	+handlejavaex(nil: string, obj: ref Object)
	3403	+{
	3404	+ class := obj.class();
	3405	+ if (class != tdclass) {
	3406	+ throwable := jassist->ObjecttoJT(obj);
	3407	+ msg : string = nil;
	3408	+ if ( throwable.msg != nil )
	3409	+ msg = throwable.msg.str;
	3410	+ sys->fprint(stderr, "%s: %s\n", class.name, msg);
	3411	+ if (throwable.trace != nil)
	3412	+ sys->fprint(stderr, "%s\n", string throwable.trace);
	3413	+ }
	3414	+ delthreaddata();
	3415	+ exit;
	3416	+}
	3417	+
	3418	+setflags( flags : list of (string,int) )
	3419	+{
	3420	+ if ( flags == nil ) return;
	3421	+
	3422	+ for((f,v):=hd flags; flags != nil; flags = tl flags )
	3423	+ {
	3424	+ case (f)
	3425	+ {
	3426	+ "debug" => loadtrace();
	3427	+ jtrace->level = JDEBUG;
	3428	+ "verbose" => loadtrace();
	3429	+ jtrace->level = JVERBOSE;
	3430	+ "warn" => warn = v;
	3431	+ }
	3432	+ }
	3433	+}
	3434	+
	3435	+runmain( classloader : JavaClassLoader, classname : string, argv : list of string )
	3436	+{
	3437	+ {
	3438	+ classloader->loader(classname).run(tl tl argv);
	3439	+ }
	3440	+ exception e
	3441	+ {
	3442	+ "*" =>
	3443	+ m := sys->sprint("uncaught exception: %s", e);
	3444	+ mesg(m);
	3445	+ if ( (obj := culprit(e)) != nil)
	3446	+ handlejavaex(e, obj);
	3447	+ else {
	3448	+ raise m; #just giveup
	3449	+ }
	3450	+ classloader->shutdown();
	3451	+ }
	3452	+}

java/appl/java/dump.b+216−0

@@ -0,0 +1,216 @@
	1	+implement Dump;
	2	+
	3	+include "sys.m";
	4	+include "draw.m";
	5	+include "loader.m";
	6	+include "classloader.m";
	7	+
	8	+Context: import Draw;
	9	+
	10	+Dump: module
	11	+{
	12	+ MP: con "@mp";
	13	+ ADT: con "@adt";
	14	+
	15	+ JAVA: con ('J'<<24)\|('a'<<16)\|('v'<<8)\|'a';
	16	+
	17	+ MAGIC, VERSION, NAME, SUPER, RELOC, DSIZE, DRELOC, CLASSREF:
	18	+ con (iota * 4);
	19	+ WORDZ: con 4;
	20	+
	21	+ init: fn(nil: ref Context, argv: list of string);
	22	+
	23	+ Reloc: adt
	24	+ {
	25	+ field: string;
	26	+ signature: string;
	27	+ flags: int;
	28	+ patch: array of int;
	29	+ };
	30	+
	31	+ Field: adt
	32	+ {
	33	+ field: string;
	34	+ signature: string;
	35	+ flags: int;
	36	+ value: int;
	37	+ class: cyclic ref Class;
	38	+ };
	39	+
	40	+ Class: adt
	41	+ {
	42	+ state: int;
	43	+ name: string;
	44	+ ownname: string;
	45	+ file: string;
	46	+ version: int;
	47	+ mod: Nilmod;
	48	+ super: cyclic ref Class;
	49	+ refs: cyclic array of ref Class;
	50	+ objectdata: cyclic list of ref Field;
	51	+ virtualmethod: cyclic list of ref Field;
	52	+ staticdata: cyclic array of ref Field;
	53	+ staticmethod: cyclic array of ref Field;
	54	+ objectsize: int;
	55	+ staticsize: int;
	56	+ nextra: int;
	57	+ datasize: int;
	58	+ datareloc: int;
	59	+ modsize: int;
	60	+ modmap: array of byte;
	61	+ objmap: array of byte;
	62	+ objtype: int;
	63	+ };
	64	+
	65	+};
	66	+
	67	+sys: Sys;
	68	+jassist: JavaAssist;
	69	+
	70	+ getint, getptr, getreloc, getstring: import jassist;
	71	+ putclass, putint, putmod, putptr: import jassist;
	72	+ mnew: import jassist;
	73	+
	74	+stderr: ref Sys->FD;
	75	+
	76	+ident: con "Dump";
	77	+
	78	+mesg(s: string)
	79	+{
	80	+ sys->fprint(stderr, "%s: %s\n", ident, s);
	81	+}
	82	+
	83	+error(s: string)
	84	+{
	85	+ mesg(s);
	86	+ exit;
	87	+}
	88	+
	89	+init(nil: ref Context, argv: list of string)
	90	+{
	91	+ s := "";
	92	+ t: string;
	93	+ a: array of byte;
	94	+
	95	+ sys = load Sys Sys->PATH;
	96	+ stderr = sys->fildes(2);
	97	+
	98	+ jassist = load JavaAssist JavaAssist->PATH;
	99	+ if (jassist == nil)
	100	+ error(sys->sprint(
	101	+ "could not load %s: %r", JavaAssist->PATH));
	102	+
	103	+ argv = tl argv;
	104	+
	105	+ if(argv == nil)
	106	+ exit;
	107	+
	108	+ i := 0;
	109	+ junk := array[10] of Nilmod;
	110	+ while(argv != nil) {
	111	+ s = hd argv;
	112	+ t = "\n" + s + "\n";
	113	+ a = array of byte t;
	114	+ if(sys->write(sys->fildes(1), a, len a) != len a)
	115	+ sys->fprint(sys->fildes(2), "load: write error: %r\n");
	116	+ junk[i] = load Nilmod s;
	117	+ dump(junk[i]);
	118	+ if(junk == nil)
	119	+ sys->fprint(sys->fildes(2), "load: error: %r\n");
	120	+ argv = tl argv;
	121	+ }
	122	+}
	123	+
	124	+nextra(a: array of Reloc): int
	125	+{
	126	+ n := 0;
	127	+ for (i := 0; i < len a; i++) {
	128	+ case a[i].field {
	129	+ MP or ADT =>
	130	+ n++;
	131	+ }
	132	+ }
	133	+ return n;
	134	+}
	135	+
	136	+dump(m: Nilmod)
	137	+{
	138	+ ld := load Loader Loader->PATH;
	139	+ if(ld == nil)
	140	+ error(sys->sprint("could not load %s: %r", Loader->PATH));
	141	+
	142	+ if (getint(m, MAGIC) != JAVA){
	143	+ sys->fprint(sys->fildes(2), "\tbad magic number\n");
	144	+ return;
	145	+ }
	146	+
	147	+ version := getint(m, VERSION) & 16rFF;
	148	+ sys->fprint(sys->fildes(1),"\tversion: %d\n",version);
	149	+ ownname := getstring(m, NAME);
	150	+ a := array of byte ownname;
	151	+ sys->fprint(sys->fildes(1),"\townname: ");
	152	+ if(sys->write(sys->fildes(1), a, len a) != len a)
	153	+ sys->fprint(sys->fildes(2), "load: write error: %r\n");
	154	+
	155	+ super := getstring(m, SUPER);
	156	+ sys->fprint(sys->fildes(1),"\tsuper: %s\n",super);
	157	+
	158	+ r := getreloc(m, RELOC);
	159	+ i := len r;
	160	+ sys->fprint(sys->fildes(1),"\tlen r: %d\n",i);
	161	+ for (j := 0; j < len r; j++) {
	162	+ t := r[j];
	163	+ sys->fprint(sys->fildes(1),"\t\t%s\t%s\n",t.field,t.signature);
	164	+ }
	165	+
	166	+ datasize := getint(m, DSIZE);
	167	+ sys->fprint(sys->fildes(1),"\tdatasize: %d\n",datasize);
	168	+ dr := getint(m, DRELOC);
	169	+ sys->fprint(sys->fildes(1), "\treloc: %d\n",dr);
	170	+ i = CLASSREF;
	171	+ n := 0;
	172	+
	173	+ sys->fprint(sys->fildes(1),"\tclassrefs:\n");
	174	+ while ((s := getstring(m, i)) != nil) {
	175	+ n += nextra(getreloc(m, i + WORDZ));
	176	+ sys->fprint(sys->fildes(1),"\t\t%s %d\n",s,n);
	177	+ i += 2 * WORDZ;
	178	+ }
	179	+
	180	+# td := ld->tdesc(m);
	181	+# z := 2 * WORDZ + n*WORDZ;
	182	+# mod := array[z] of byte;
	183	+# for (i = 1; i < z; i++)
	184	+# mod[i] = byte 0;
	185	+# # nil and ref Class
	186	+# mod[0] = byte 16rC0;
	187	+# md := ld->dnew(datasize,mod);
	188	+# instructions := ld->ifetch(m);
	189	+ links := ld->link(m);
	190	+
	191	+ R := ref Class;
	192	+ S := ref Class;
	193	+ classes: list of ref Class;
	194	+ classes = S :: classes;
	195	+ classes = R :: classes;
	196	+
	197	+ refs := mkclarray(classes);
	198	+
	199	+ sys->fprint(sys->fildes(1),"\n");
	200	+}
	201	+
	202	+mkclarray(l: list of ref Class): array of ref Class
	203	+{
	204	+ n := len l;
	205	+ sys->fprint(stderr, "mkclarray, len: %d\n",n);
	206	+ a := array[n] of ref Class;
	207	+ while (--n >= 0) {
	208	+ sys->fprint(stderr, "mkclarray, len: %d\n",n);
	209	+ a[n] = hd l;
	210	+ l = tl l;
	211	+ }
	212	+ sys->fprint(stderr, "mkclarray, exitting\n");
	213	+ return a;
	214	+}
	215	+
	216	+

java/appl/java/javaassist.base+148−0

@@ -0,0 +1,148 @@
	1	+#
	2	+# Java Class Loader dis assist.
	3	+#
	4	+
	5	+#0
	6	+# getint:
	7	+ addw 0(32(fp)),36(fp),40(fp)
	8	+ movw 0(40(fp)),0(16(fp))
	9	+ ret
	10	+#3
	11	+# getbytearray:
	12	+# getintarray:
	13	+# getreloc:
	14	+# getstrarray:
	15	+# getstring:
	16	+ addw 0(32(fp)),36(fp),40(fp)
	17	+ movp 0(40(fp)),0(16(fp))
	18	+ ret
	19	+#6
	20	+# putint:
	21	+ addw 32(fp),36(fp),44(fp)
	22	+ movw 40(fp),0(44(fp))
	23	+ ret
	24	+#9
	25	+# putclass:
	26	+# putmod:
	27	+# putobj:
	28	+# putptr:
	29	+# putstring:
	30	+ addw 32(fp),36(fp),44(fp)
	31	+ movp 40(fp),0(44(fp))
	32	+ ret
	33	+#12
	34	+# little_endian:
	35	+#
	36	+ movw $0,0(16(fp))
	37	+ movb 0(mp),0(16(fp))
	38	+ ret
	39	+#15
	40	+# jclnilmod:
	41	+# sysnilmod:
	42	+# arrayof:
	43	+# bytearraytoJS:
	44	+# intarraytoJS:
	45	+# bigarraytoJS:
	46	+# realarraytoJS:
	47	+# ArraytoJS:
	48	+# JStoObject:
	49	+# ObjecttoJT:
	50	+ movp 32(fp),0(16(fp))
	51	+ ret
	52	+#17
	53	+# new:
	54	+ mnewz 32(fp),36(fp),0(16(fp))
	55	+ ret
	56	+#19
	57	+# getobjclass:
	58	+ movp 0(32(fp)),36(fp)
	59	+ movp 4(36(fp)),0(16(fp))
	60	+ ret
	61	+#22
	62	+# modhash:
	63	+# objhash:
	64	+ andw 32(fp),4(mp),0(16(fp))
	65	+ ret
	66	+#24
	67	+# getrtreloc:
	68	+# getclassadt:
	69	+# getadtstring:
	70	+ addw 32(fp),36(fp),40(fp)
	71	+ movp 0(40(fp)),0(16(fp))
	72	+ ret
	73	+#27
	74	+# getabsint
	75	+ movw 0(32(fp)),0(16(fp))
	76	+ ret
	77	+#29
	78	+# mcall0:
	79	+ mframe 32(fp),36(fp),40(fp)
	80	+ lea 0(16(fp)),16(40(fp))
	81	+ mcall 40(fp),36(fp),32(fp)
	82	+ ret
	83	+#33
	84	+# mcall1:
	85	+# mcalla:
	86	+# mcallm:
	87	+ mframe 32(fp),36(fp),44(fp)
	88	+ movp 40(fp),32(44(fp))
	89	+ lea 0(16(fp)),16(44(fp))
	90	+ mcall 44(fp),36(fp),32(fp)
	91	+ ret
	92	+#38
	93	+# getmd:
	94	+ movp 0(32(fp)),0(16(fp))
	95	+ ret
	96	+#40
	97	+# makeadt:
	98	+ movp 32(fp),0(16(fp))
	99	+ ret
	100	+ desc $0,8,""
	101	+ desc $1,48,"0080"
	102	+ desc $2,48,"00a0"
	103	+ desc $3,32,""
	104	+ desc $4,40,"0080"
	105	+ desc $5,40,"00c0"
	106	+ desc $6,40,""
	107	+ var @mp,8
	108	+ word @mp+0,1
	109	+ word @mp+4,2147483647
	110	+ module JavaAssist
	111	+ link 1,0,0x9af56bb1,"getint"
	112	+ link 1,3,0x480b7ac3,"getbytearray"
	113	+ link 1,3,0x55e7e9b3,"getintarray"
	114	+ link 1,3,0xd7e85087,"getptr"
	115	+ link 1,3,0xbb4256c7,"getreloc"
	116	+ link 1,3,0x67808576,"getstrarray"
	117	+ link 1,3,0xe6647e4a,"getstring"
	118	+ link 1,6,0x2de68727,"putint"
	119	+ link 2,9,0xaa939019,"putclass"
	120	+ link 2,9,0x66b5c780,"putmod"
	121	+ link 2,9,0xa780c055,"putobj"
	122	+ link 2,9,0x43ec4524,"putptr"
	123	+ link 2,9,0x46bbe09a,"putstring"
	124	+ link 3,12,0x616977e8,"little_endian"
	125	+ link 4,15,0xfbfab1de,"jclnilmod"
	126	+ link 4,15,0xa0d4011e,"sysnilmod"
	127	+ link 4,15,0xafae2abc,"arrayof"
	128	+ link 4,15,0x79238ebb,"bytearraytoJS"
	129	+ link 4,15,0x9dfa2ee1,"intarraytoJS"
	130	+ link 4,15,0x1ebcdfdd,"bigarraytoJS"
	131	+ link 4,15,0xc8107991,"realarraytoJS"
	132	+ link 4,15,0x464a7f42,"ArraytoJS"
	133	+ link 4,15,0x76cd0754,"JStoObject"
	134	+ link 4,15,0xaaaaaaaa,"ObjecttoJT"
	135	+ link 1,17,0xbb2da06c,"new"
	136	+ link 5,19,0x4e5bdbec,"getobjclass"
	137	+ link 4,22,0x4e5d43e7,"modhash"
	138	+ link 4,22,0x646cd7d0,"objhash"
	139	+ link 1,24,0xa1fa7e52,"getrtreloc"
	140	+ link 1,24,0x9d2938ae,"getclassadt"
	141	+ link 1,24,0x3911b054,"getadtstring"
	142	+ link 6,27,0xe67bf126,"getabsint"
	143	+ link 1,29,0x9af56bb1,"mcall0"
	144	+ link 2,33,0xcbd2cc54,"mcall1"
	145	+ link 2,33,0x69095c2,"mcalla"
	146	+ link 2,33,0x1fe62f91,"mcallm"
	147	+ link 4,38,0x21126c42,"getmd"
	148	+ link 6,40,0x2d805d,"makeadt"

java/appl/java/javaassist.s+148−0

@@ -0,0 +1,148 @@
	1	+#
	2	+# Java Class Loader dis assist.
	3	+#
	4	+
	5	+#0
	6	+# getint:
	7	+ addw 0(32(fp)),36(fp),40(fp)
	8	+ movw 0(40(fp)),0(16(fp))
	9	+ ret
	10	+#3
	11	+# getbytearray:
	12	+# getintarray:
	13	+# getreloc:
	14	+# getstrarray:
	15	+# getstring:
	16	+ addw 0(32(fp)),36(fp),40(fp)
	17	+ movp 0(40(fp)),0(16(fp))
	18	+ ret
	19	+#6
	20	+# putint:
	21	+ addw 32(fp),36(fp),44(fp)
	22	+ movw 40(fp),0(44(fp))
	23	+ ret
	24	+#9
	25	+# putclass:
	26	+# putmod:
	27	+# putobj:
	28	+# putptr:
	29	+# putstring:
	30	+ addw 32(fp),36(fp),44(fp)
	31	+ movp 40(fp),0(44(fp))
	32	+ ret
	33	+#12
	34	+# little_endian:
	35	+#
	36	+ movw $0,0(16(fp))
	37	+ movb 0(mp),0(16(fp))
	38	+ ret
	39	+#15
	40	+# jclnilmod:
	41	+# sysnilmod:
	42	+# arrayof:
	43	+# bytearraytoJS:
	44	+# intarraytoJS:
	45	+# bigarraytoJS:
	46	+# realarraytoJS:
	47	+# ArraytoJS:
	48	+# JStoObject:
	49	+# ObjecttoJT:
	50	+ movp 32(fp),0(16(fp))
	51	+ ret
	52	+#17
	53	+# new:
	54	+ mnewz 32(fp),36(fp),0(16(fp))
	55	+ ret
	56	+#19
	57	+# getobjclass:
	58	+ movp 0(32(fp)),36(fp)
	59	+ movp 4(36(fp)),0(16(fp))
	60	+ ret
	61	+#22
	62	+# modhash:
	63	+# objhash:
	64	+ andw 32(fp),4(mp),0(16(fp))
	65	+ ret
	66	+#24
	67	+# getrtreloc:
	68	+# getclassadt:
	69	+# getadtstring:
	70	+ addw 32(fp),36(fp),40(fp)
	71	+ movp 0(40(fp)),0(16(fp))
	72	+ ret
	73	+#27
	74	+# getabsint
	75	+ movw 0(32(fp)),0(16(fp))
	76	+ ret
	77	+#29
	78	+# mcall0:
	79	+ mframe 32(fp),36(fp),40(fp)
	80	+ lea 0(16(fp)),16(40(fp))
	81	+ mcall 40(fp),36(fp),32(fp)
	82	+ ret
	83	+#33
	84	+# mcall1:
	85	+# mcalla:
	86	+# mcallm:
	87	+ mframe 32(fp),36(fp),44(fp)
	88	+ movp 40(fp),32(44(fp))
	89	+ lea 0(16(fp)),16(44(fp))
	90	+ mcall 44(fp),36(fp),32(fp)
	91	+ ret
	92	+#38
	93	+# getmd:
	94	+ movp 0(32(fp)),0(16(fp))
	95	+ ret
	96	+#40
	97	+# makeadt:
	98	+ movp 32(fp),0(16(fp))
	99	+ ret
	100	+ desc $0,8,""
	101	+ desc $1,48,"0080"
	102	+ desc $2,48,"00a0"
	103	+ desc $3,32,""
	104	+ desc $4,40,"0080"
	105	+ desc $5,40,"00c0"
	106	+ desc $6,40,""
	107	+ var @mp,8
	108	+ word @mp+0,1
	109	+ word @mp+4,2147483647
	110	+ module JavaAssist
	111	+ link 1,0,0x9af56bb1,"getint"
	112	+ link 1,3,0x480b7ac3,"getbytearray"
	113	+ link 1,3,0x55e7e9b3,"getintarray"
	114	+ link 1,3,0xd7e85087,"getptr"
	115	+ link 1,3,0xbb4256c7,"getreloc"
	116	+ link 1,3,0x67808576,"getstrarray"
	117	+ link 1,3,0xe6647e4a,"getstring"
	118	+ link 1,6,0x2de68727,"putint"
	119	+ link 2,9,0x8f05c931,"putclass"
	120	+ link 2,9,0x66b5c780,"putmod"
	121	+ link 2,9,0x4f9a2948,"putobj"
	122	+ link 2,9,0x43ec4524,"putptr"
	123	+ link 2,9,0x46bbe09a,"putstring"
	124	+ link 3,12,0x616977e8,"little_endian"
	125	+ link 4,15,0x18138a11,"jclnilmod"
	126	+ link 4,15,0x8cdb1059,"sysnilmod"
	127	+ link 4,15,0x6d675ef6,"arrayof"
	128	+ link 4,15,0x79238ebb,"bytearraytoJS"
	129	+ link 4,15,0x9dfa2ee1,"intarraytoJS"
	130	+ link 4,15,0x1ebcdfdd,"bigarraytoJS"
	131	+ link 4,15,0xc8107991,"realarraytoJS"
	132	+ link 4,15,0xfb08d2ba,"ArraytoJS"
	133	+ link 4,15,0x76cd0754,"JStoObject"
	134	+ link 4,15,0xae823704,"ObjecttoJT"
	135	+ link 1,17,0xbb2da06c,"new"
	136	+ link 5,19,0x7e47f344,"getobjclass"
	137	+ link 4,22,0x4e5d43e7,"modhash"
	138	+ link 4,22,0x646cd7d0,"objhash"
	139	+ link 1,24,0xa1fa7e52,"getrtreloc"
	140	+ link 1,24,0x45af8037,"getclassadt"
	141	+ link 1,24,0x3911b054,"getadtstring"
	142	+ link 6,27,0xe67bf126,"getabsint"
	143	+ link 1,29,0x9af56bb1,"mcall0"
	144	+ link 2,33,0xcbd2cc54,"mcall1"
	145	+ link 2,33,0x2c8f47,"mcalla"
	146	+ link 2,33,0x1fe62f91,"mcallm"
	147	+ link 4,38,0x21126c42,"getmd"
	148	+ link 6,40,0x2d805d,"makeadt"

java/appl/java/javaassistproto.b+261−0

@@ -0,0 +1,261 @@
	1	+implement JavaAssist;
	2	+
	3	+include "sys.m";
	4	+
	5	+include "loader.m";
	6	+include "classloader.m";
	7	+
	8	+i: int = 23;
	9	+r: array of JavaClassLoader->Reloc;
	10	+s: string = "23";
	11	+c: ref JavaClassLoader->Class;
	12	+p: ref Loader->Niladt;
	13	+x: int;
	14	+j: JavaAssist;
	15	+
	16	+plus(a, b: int): int
	17	+{
	18	+ return a + b;
	19	+}
	20	+
	21	+getint(mod: Nilmod, index: int): int
	22	+{
	23	+ modref(mod);
	24	+ x = index;
	25	+ return plus(1, 3);
	26	+}
	27	+
	28	+getbytearray(mod: Nilmod, index: int): array of byte
	29	+{
	30	+ modref(mod);
	31	+ x = index;
	32	+ return array[1] of byte;
	33	+}
	34	+
	35	+getintarray(mod: Nilmod, index: int): array of int
	36	+{
	37	+ modref(mod);
	38	+ x = index;
	39	+ return array[1] of int;
	40	+}
	41	+
	42	+getptr(mod: Nilmod, index: int): ref Loader->Niladt
	43	+{
	44	+ modref(mod);
	45	+ x = index;
	46	+ return p;
	47	+}
	48	+
	49	+getreloc(mod: Nilmod, index: int): array of JavaClassLoader->Reloc
	50	+{
	51	+ modref(mod);
	52	+ x = index;
	53	+ return r;
	54	+}
	55	+
	56	+getrtreloc(data: ref Loader->Niladt, index: int): array of JavaClassLoader->RTReloc
	57	+{
	58	+ p = data;
	59	+ x = index;
	60	+ return nil;
	61	+}
	62	+
	63	+getclassadt(data: ref Loader->Niladt, index: int): ref JavaClassLoader->Class
	64	+{
	65	+ p = data;
	66	+ x = index;
	67	+ return nil;
	68	+}
	69	+
	70	+getabsint(addr: int): int
	71	+{
	72	+ return 0;
	73	+}
	74	+
	75	+getadtstring(data: ref Loader->Niladt, index: int): string
	76	+{
	77	+ p = data;
	78	+ x = index;
	79	+ return nil;
	80	+}
	81	+
	82	+getstring(mod: Nilmod, index: int): string
	83	+{
	84	+ modref(mod);
	85	+ x = index;
	86	+ return s;
	87	+}
	88	+
	89	+mnew(mod: Nilmod, index: int): ref Loader->Niladt
	90	+{
	91	+ modref(mod);
	92	+ x = index;
	93	+ return p;
	94	+}
	95	+
	96	+putclass(data: ref Loader->Niladt, index: int, value: ref JavaClassLoader->Class)
	97	+{
	98	+ p = data;
	99	+ x = index;
	100	+ c = value;
	101	+}
	102	+
	103	+putint(data: ref Loader->Niladt, index: int, value: int)
	104	+{
	105	+ p = data;
	106	+ x = index;
	107	+ x = value;
	108	+}
	109	+
	110	+putmod(data: ref Loader->Niladt, index: int, value: Nilmod)
	111	+{
	112	+ p = data;
	113	+ x = index;
	114	+ modref(value);
	115	+}
	116	+
	117	+putobj(data: ref Loader->Niladt, index: int, value: ref JavaClassLoader->ClassObject)
	118	+{
	119	+ p = data;
	120	+ x = index;
	121	+ o := value;
	122	+}
	123	+
	124	+putptr(data: ref Loader->Niladt, index: int, value: ref Loader->Niladt)
	125	+{
	126	+ p = data;
	127	+ x = index;
	128	+ p = value;
	129	+}
	130	+
	131	+putstring(data: ref Loader->Niladt, index: int, value: string)
	132	+{
	133	+ p = data;
	134	+ x = index;
	135	+ s = value;
	136	+}
	137	+
	138	+modref(nil: Nilmod)
	139	+{
	140	+}
	141	+
	142	+modref2(nil, nil: Nilmod)
	143	+{
	144	+}
	145	+
	146	+little_endian(): int
	147	+{
	148	+ return 1;
	149	+}
	150	+
	151	+jclnilmod(nil: JavaClassLoader): Nilmod
	152	+{
	153	+ return nil;
	154	+}
	155	+
	156	+sysnilmod(nil: Sys): Nilmod
	157	+{
	158	+ return nil;
	159	+}
	160	+
	161	+new(mod: Nilmod, index: int): ref JavaClassLoader->Object
	162	+{
	163	+ modref(mod);
	164	+ x = index;
	165	+ return nil;
	166	+}
	167	+
	168	+getobjclass(j: ref JavaClassLoader->Object): ref JavaClassLoader->Class
	169	+{
	170	+ a := j.mod;
	171	+ return nil;
	172	+}
	173	+
	174	+modhash(mod: Nilmod): int
	175	+{
	176	+ modref(mod);
	177	+ return i & 16r7FFFFFFF;
	178	+}
	179	+
	180	+objhash(nil: ref JavaClassLoader->Object): int
	181	+{
	182	+ return 0;
	183	+}
	184	+
	185	+mcall0(nil: Nilmod, nil: int): int
	186	+{
	187	+ return j->little_endian();
	188	+}
	189	+
	190	+mcall1(nil: Nilmod, nil: int, nil: ref JavaClassLoader->Object): ref JavaClassLoader->Object
	191	+{
	192	+ return j->JStoObject(nil);
	193	+}
	194	+
	195	+mcalla(nil: Nilmod, nil: int, nil: ref JavaClassLoader->Array): int
	196	+{
	197	+ return 0;
	198	+}
	199	+
	200	+mcallm(nil: Nilmod, nil: int, arg: Nilmod): int
	201	+{
	202	+ return j->modhash(arg);
	203	+}
	204	+
	205	+getstrarray(mod: Nilmod, index: int): array of string
	206	+{
	207	+ modref(mod);
	208	+ x = index;
	209	+ return array[1] of string;
	210	+}
	211	+
	212	+arrayof(nil: ref JavaClassLoader->Object): ref JavaClassLoader->Array
	213	+{
	214	+ return nil;
	215	+}
	216	+
	217	+bytearraytoJS(nil: array of byte): array of ref JavaClassLoader->JavaString
	218	+{
	219	+ return nil;
	220	+}
	221	+
	222	+intarraytoJS(nil: array of int): array of ref JavaClassLoader->JavaString
	223	+{
	224	+ return nil;
	225	+}
	226	+
	227	+bigarraytoJS(nil: array of big): array of ref JavaClassLoader->JavaString
	228	+{
	229	+ return nil;
	230	+}
	231	+
	232	+realarraytoJS(nil: array of real): array of ref JavaClassLoader->JavaString
	233	+{
	234	+ return nil;
	235	+}
	236	+
	237	+ArraytoJS(nil: ref JavaClassLoader->Array): ref JavaClassLoader->JavaString
	238	+{
	239	+ return nil;
	240	+}
	241	+
	242	+JStoObject(nil: ref JavaClassLoader->JavaString): ref JavaClassLoader->Object
	243	+{
	244	+ return nil;
	245	+}
	246	+
	247	+ObjecttoJT(nil: ref JavaClassLoader->Object): ref JavaClassLoader->JavaThrowable
	248	+{
	249	+ return nil;
	250	+}
	251	+
	252	+getmd(nil: Nilmod): ref Loader->Niladt
	253	+{
	254	+ return nil;
	255	+}
	256	+
	257	+makeadt(addr: int): ref Loader->Niladt
	258	+{
	259	+ x = addr;
	260	+ return nil;
	261	+}

java/appl/java/javanative.b+32−0

@@ -0,0 +1,32 @@
	1	+implement JavaNative;
	2	+
	3	+include "jni.m";
	4	+
	5	+#
	6	+# This is to isolate jni from the classloader.
	7	+#
	8	+
	9	+init(sys: Sys, ld: Loader, jldr: JavaClassLoader, jass: JavaAssist): string
	10	+{
	11	+ j := load JNI JNI->PATH;
	12	+ if (j == nil)
	13	+ return sys->sprint("could not load %s: %r", JNI->PATH);
	14	+ (m, s) := j->Self(sys, j);
	15	+ if (s != nil)
	16	+ return s;
	17	+ l := ld->link(m);
	18	+ if (l == nil)
	19	+ return sys->sprint("link failed: %r");
	20	+ n := len l;
	21	+ t := -1;
	22	+ for (i := 0; i < n; i++) {
	23	+ if (l[i].name == "init")
	24	+ t = i;
	25	+ }
	26	+ if (t == -1)
	27	+ return sys->sprint("%s: not signed", JNI->PATH);
	28	+ jldr->jninil = m;
	29	+ jldr->jnisig = l[t].sig;
	30	+ j->jinit(jldr, jass);
	31	+ return nil;
	32	+}

java/appl/java/javatrace.b+66−0

@@ -0,0 +1,66 @@
	1	+implement JavaTrace;
	2	+
	3	+include "sys.m";
	4	+ sys: Sys;
	5	+
	6	+include "loader.m";
	7	+include "classloader.m";
	8	+
	9	+Class, Reloc: import JavaClassLoader;
	10	+RELOC, CLASSREF, WORDZ: import JavaClassLoader;
	11	+
	12	+jassist: JavaAssist;
	13	+
	14	+ getint, getintarray, getptr, getreloc, getstring: import jassist;
	15	+
	16	+init(a: JavaAssist)
	17	+{
	18	+ if (sys == nil)
	19	+ sys = load Sys Sys->PATH;
	20	+ jassist = a;
	21	+ level = -1;
	22	+ outfd = sys->fildes(2);
	23	+}
	24	+
	25	+trace(c: int, s: string)
	26	+{
	27	+ if (c <= level)
	28	+ sys->fprint(outfd, "%s\n", s);
	29	+}
	30	+
	31	+info(c: ref Class)
	32	+{
	33	+ sys->fprint(outfd, "Class: %s [%s]\n", c.name, c.file);
	34	+ sys->fprint(outfd, "--- Relocs ---\n");
	35	+ pr_relocs(getreloc(c.mod, RELOC));
	36	+ i := CLASSREF;
	37	+ while ((s := getstring(c.mod, i)) != nil) {
	38	+ sys->fprint(outfd, "--- %s ---\n", s);
	39	+ pr_relocs(getreloc(c.mod, i + WORDZ));
	40	+ i += 2 * WORDZ;
	41	+ }
	42	+}
	43	+
	44	+pr_reloc(r: Reloc)
	45	+{
	46	+ f := r.field;
	47	+ if (f == nil)
	48	+ f = "@";
	49	+ s := r.signature;
	50	+ if (s == nil)
	51	+ s = "@";
	52	+ n: int;
	53	+ if (r.patch == nil)
	54	+ n = -1;
	55	+ else
	56	+ n = len r.patch;
	57	+ sys->fprint(outfd, "%s %s %d %d\n", f, s, r.flags, n);
	58	+}
	59	+
	60	+pr_relocs(r: array of JavaClassLoader->Reloc)
	61	+{
	62	+ n := len r;
	63	+ for (i := 0; i < n; i++)
	64	+ pr_reloc(r[i]);
	65	+}
	66	+

java/appl/java/jinfo.b+25−0

@@ -0,0 +1,25 @@
	1	+implement JInfo;
	2	+
	3	+include "sys.m";
	4	+include "loader.m";
	5	+include "classloader.m";
	6	+
	7	+JInfo: module
	8	+{
	9	+ init: fn(ctxt: ref Draw->Context, argv: list of string);
	10	+};
	11	+
	12	+sys: Sys;
	13	+
	14	+init(ctxt: ref Draw->Context, args: list of string)
	15	+{
	16	+ sys = load Sys Sys->PATH;
	17	+ cl := load JavaClassLoader JavaClassLoader->PATH;
	18	+ if (cl == nil) {
	19	+ sys->print("could not load %s: %r\n", JavaClassLoader->PATH);
	20	+ exit;
	21	+ }
	22	+ cl->init(cl, ctxt);
	23	+ for (l := tl args; l != nil; l = tl l)
	24	+ cl->info(hd l);
	25	+}

java/appl/java/jni.b+1735−0

@@ -0,0 +1,1735 @@
	1	+implement JNI;
	2	+
	3	+include "jni.m";
	4	+include "hash.m";
	5	+
	6	+cast : Cast;
	7	+low : Low;
	8	+hash : Hash;
	9	+
	10	+JNI_VER := 16r00010001;
	11	+
	12	+#
	13	+# use the access functions at the bottom to
	14	+# retrive the values stored here. thease vars
	15	+# are initialized as late as possible.
	16	+#
	17	+string_class, # class data for java.lang.String
	18	+array_class, # for inferno.vm.Array
	19	+class_class, # for java.lang.Class
	20	+throwable_class, # for java.lang.Throwable
	21	+thread_class # for java.lang.Thread
	22	+ : ClassData;
	23	+
	24	+# cache the main thread group
	25	+mainthreadgroup : JObject;
	26	+
	27	+GetVersion() : int
	28	+{
	29	+ return( JNI_VER );
	30	+}
	31	+
	32	+
	33	+FindClass( name : string ) : ClassData
	34	+{
	35	+ # return class data adt used by the Java Loader
	36	+ # which stores all the class information.
	37	+
	38	+ # replace all ocurrences of "." with "/" in name
	39	+ newname : string;
	40	+ for(x:=0;x<len name; x++)
	41	+ {
	42	+ if (name[x]=='.')
	43	+ newname[x] = '/';
	44	+ else
	45	+ newname[x] = name[x];
	46	+ }
	47	+ cl_data : ClassData;
	48	+ if ( newname != nil && newname[0] == '[' ) {
	49	+ class := LookupArrayClass(newname);
	50	+ cl_data = class.class;
	51	+ } else {
	52	+ cl_data = jldr->loader(newname);
	53	+ }
	54	+ return cl_data;
	55	+}
	56	+
	57	+getContext(): ref Draw->Context
	58	+{
	59	+ return(jldr->getcontext());
	60	+}
	61	+
	62	+
	63	+GetSuperclass( cl_data : ClassData ) : ClassData
	64	+{
	65	+ # we need the superclass of this
	66	+ # class.
	67	+ if ( cl_data == nil )
	68	+ return(nil);
	69	+ return( cl_data.super );
	70	+}
	71	+
	72	+
	73	+#
	74	+# Return the java.lang.Class instance associated
	75	+# with this instance.
	76	+#
	77	+GetObjectClass( obj : JObject ) : JClass
	78	+{
	79	+ if ( obj == nil )
	80	+ return( nil );
	81	+ # return the class of this obj
	82	+ Object : import jldr;
	83	+ cldata := obj.class();
	84	+ if ( cldata == nil )
	85	+ ThrowException( "java/lang/InternalError", "could not get objects class data" );
	86	+ if ( cldata.name == "inferno/vm/Array" )
	87	+ {
	88	+ # handle arrays specially synthesize a unique class object
	89	+ # for each type of array, and cache it for future use.
	90	+ # this blows memory, but java requires a unique class object
	91	+ # so two [[I's must result in the same class
	92	+ return( ArrayClassObject( cast->ToJArray(obj) ) );
	93	+ }
	94	+ return( GetClassObject( cldata ) );
	95	+}
	96	+
	97	+#
	98	+# Return the internal Class Data information
	99	+# associated with this instance
	100	+#
	101	+GetObjectClassData( obj : JObject ) : ClassData
	102	+{
	103	+ if ( obj == nil )
	104	+ return( nil );
	105	+ # return the class of this obj
	106	+ Object : import jldr;
	107	+ return( obj.class() );
	108	+}
	109	+
	110	+
	111	+
	112	+#
	113	+# return the associated java.lang.Class instance
	114	+# associated with the given internal Class
	115	+# Data.
	116	+#
	117	+GetClassObject( cl_data : ClassData ) : JClass
	118	+{
	119	+ if ( cl_data == nil )
	120	+ return( nil );
	121	+ # return the stored java.lang.Class instance
	122	+ classobj := cl_data.this;
	123	+
	124	+ if ( classobj.mod == nil )
	125	+ {
	126	+ # first time, we used this object, we
	127	+ # must patch the objects's 'mod' field.
	128	+ classobj.mod = classclass().moddata;
	129	+ }
	130	+
	131	+ return( classobj );
	132	+}
	133	+
	134	+
	135	+SetStaticField( class : ClassData, name : string, val : ref Value ) : int
	136	+{
	137	+ # get field info
	138	+ Class : import jldr;
	139	+
	140	+ if ( (class == nil) \|\| (val == nil) )
	141	+ return( ERR );
	142	+
	143	+ field := class.findsfield( name );
	144	+
	145	+ if ( ! CheckField( field, val ) )
	146	+ return( ERR );
	147	+
	148	+ # static data is located in the "module data"
	149	+ # of the module wich corresponds to the class.
	150	+ # we can get this from the class.mod field and
	151	+ # then we must convert it to a "generic" Niladt
	152	+ ptr := jassist->getmd( class.mod );
	153	+
	154	+ # check offset and compute absolute offset
	155	+ if ( field.value >= class.staticsize )
	156	+ return( ERR );
	157	+
	158	+ off := class.staticoffset + field.value;
	159	+
	160	+ return( SetField( ptr, off, val ) );
	161	+}
	162	+
	163	+
	164	+
	165	+GetStaticField( class : ClassData, name : string, typsig : string ) : ref Value
	166	+{
	167	+ # get field info
	168	+ Class : import jldr;
	169	+
	170	+ if ( class == nil )
	171	+ return( nil );
	172	+
	173	+ field := class.findsfield( name );
	174	+
	175	+ if ( (field == nil) \|\| (field.signature != typsig) )
	176	+ return( nil );
	177	+
	178	+ # Static data is located in the "module data"
	179	+ # of the module which corresponds to the class.
	180	+ # We can get this from the class.mod field and
	181	+ # then we must convert it to a "generic" Niladt
	182	+ ptr := jassist->getmd( class.mod );
	183	+
	184	+ # check offset and compute absolute offset
	185	+ if ( field.value >= class.staticsize )
	186	+ return( nil );
	187	+
	188	+ off := class.staticoffset + field.value;
	189	+
	190	+ return( GetField( ptr, off, typsig[0] ) );
	191	+}
	192	+
	193	+
	194	+SetObjField( object : JObject, name : string, val : ref Value ) : int
	195	+{
	196	+ # get field info
	197	+ Object : import jldr;
	198	+ Class : import jldr;
	199	+
	200	+ if ( (object == nil) \|\| (val == nil) )
	201	+ return( ERR );
	202	+
	203	+ class := object.class();
	204	+ field := class.findofield( name );
	205	+
	206	+ if ( ! CheckField( field, val ) )
	207	+ return( ERR );
	208	+
	209	+ # convert the object to a "generic" Niladt
	210	+ ptr := cast->Obj2Niladt(object);
	211	+
	212	+ # check offset and compute absolute offset
	213	+ if ( field.value >= class.objectsize )
	214	+ return( ERR );
	215	+
	216	+ SetField( ptr, field.value, val );
	217	+
	218	+ return( OK );
	219	+}
	220	+
	221	+
	222	+GetObjField( object : JObject, name : string, typsig : string ) : ref Value
	223	+{
	224	+ # get field info
	225	+ Object : import jldr;
	226	+ Class : import jldr;
	227	+
	228	+ if ( object == nil )
	229	+ return( nil );
	230	+
	231	+ class := object.class();
	232	+ field := class.findofield( name );
	233	+
	234	+ if ( (field == nil) \|\| (field.signature != typsig) )
	235	+ return( nil );
	236	+
	237	+ # convert the object to a "generic" Niladt
	238	+ ptr := cast->Obj2Niladt(object);
	239	+
	240	+ # check offset and compute absolute offset
	241	+ if ( field.value >= class.objectsize )
	242	+ return( nil );
	243	+
	244	+ return( GetField( ptr, field.value, typsig[0] ) );
	245	+}
	246	+
	247	+
	248	+CallStatic( cldata : ClassData, meth : string, sig : string, args : array of ref Value ) : (ref Value,int)
	249	+{
	250	+ # lookup method first
	251	+ (mod,idx) := FindMethod( cldata, meth, sig, METH_STATIC );
	252	+
	253	+ if ( mod == nil )
	254	+ return( nil, CALLERR_NOMETHOD );
	255	+
	256	+ # check args against sig
	257	+ (fctdesc, err) := CheckMethodArgs( sig, args );
	258	+ if ( err )
	259	+ return( nil, err );
	260	+
	261	+ retval : ref Value;
	262	+ if ( fctdesc != nil )
	263	+ {
	264	+ # create a Value to hold function result
	265	+ if ( fctdesc.class != nil )
	266	+ retval = ref Value.TObject;
	267	+ else
	268	+ case fctdesc.prim
	269	+ {
	270	+ T_BOOLEAN => retval = ref Value.TBoolean;
	271	+ T_CHAR => retval = ref Value.TChar;
	272	+ T_FLOAT => retval = ref Value.TFloat;
	273	+ T_DOUBLE => retval = ref Value.TDouble;
	274	+ T_BYTE => retval = ref Value.TByte;
	275	+ T_SHORT => retval = ref Value.TShort;
	276	+ T_INT => retval = ref Value.TInt;
	277	+ T_LONG => retval = ref Value.TLong;
	278	+ * => return( nil, ERR );
	279	+ }
	280	+ }
	281	+
	282	+ low->CallMethod( mod, idx, nil, args, retval );
	283	+ return( retval, OK );
	284	+
	285	+}
	286	+
	287	+CallMethod( obj : JObject, meth : string, sig : string, args : array of ref Value ) : (ref Value,int)
	288	+{
	289	+ # lookup method first
	290	+ cldata := GetObjectClassData(obj);
	291	+ (mod,idx) := FindMethod( cldata, meth, sig, (METH_VIRTUAL\|METH_PRIVATE\|METH_INIT) );
	292	+
	293	+ if ( mod == nil )
	294	+ return( nil, CALLERR_NOMETHOD );
	295	+
	296	+ # check args against sig -- sig can be assumed to be a
	297	+ # valid meth sig, since a matching meth was found above
	298	+ (fctdesc, err) := CheckMethodArgs( sig, args );
	299	+ if ( err )
	300	+ return( nil, err );
	301	+
	302	+ retval : ref Value;
	303	+ if ( fctdesc != nil )
	304	+ {
	305	+ # create a Value to hold function result
	306	+ if ( fctdesc.class != nil )
	307	+ retval = ref Value.TObject;
	308	+ else
	309	+ case fctdesc.prim
	310	+ {
	311	+ T_BOOLEAN => retval = ref Value.TBoolean;
	312	+ T_CHAR => retval = ref Value.TChar;
	313	+ T_FLOAT => retval = ref Value.TFloat;
	314	+ T_DOUBLE => retval = ref Value.TDouble;
	315	+ T_BYTE => retval = ref Value.TByte;
	316	+ T_SHORT => retval = ref Value.TShort;
	317	+ T_INT => retval = ref Value.TInt;
	318	+ T_LONG => retval = ref Value.TLong;
	319	+ * => return( nil, ERR );
	320	+ }
	321	+ }
	322	+
	323	+ low->CallMethod( mod, idx, obj, args, retval );
	324	+ return( retval, OK );
	325	+}
	326	+
	327	+
	328	+LowCall( mod : Nilmod, idx : int, this : JNI->JObject, args : array of ref JNI->Value, retval : ref JNI->Value )
	329	+{
	330	+ low->CallMethod( mod, idx, this, args, retval );
	331	+}
	332	+
	333	+
	334	+# return modifiers
	335	+
	336	+GetClassFlags(jcl : JClass) : int
	337	+{
	338	+ if ( jcl == nil )
	339	+ return 0;
	340	+ return jcl.class.flags;
	341	+}
	342	+
	343	+GetFieldFlags(jcl : JClass, namesig : string) : int
	344	+{
	345	+ Class : import jldr;
	346	+
	347	+ if ( jcl == nil \|\| len namesig == 0 )
	348	+ return 0;
	349	+ (name, sig) := str->splitl(namesig, " ");
	350	+ if ( len sig == 0 )
	351	+ return 0;
	352	+ sig = sig[1:];
	353	+
	354	+ field := jcl.class.findsfield(name);
	355	+ if ( field != nil && field.signature == sig )
	356	+ return field.flags;
	357	+
	358	+ object := jcl.class.objectdata;
	359	+ super := GetSuperclass(jcl.class);
	360	+ while ( object != nil && object != super.objectdata ) {
	361	+ field = hd object;
	362	+ if ( field.field == name && field.signature == sig )
	363	+ return field.flags;
	364	+ object = tl object;
	365	+ }
	366	+ return 0;
	367	+}
	368	+
	369	+GetMethodFlags(jcl : JClass, namesig : string) : int
	370	+{
	371	+ Class : import jldr;
	372	+
	373	+ if ( jcl == nil \|\| len namesig == 0 )
	374	+ return 0;
	375	+ (name, sig) := str->splitl(namesig, " ");
	376	+ if ( len sig == 0 )
	377	+ return 0;
	378	+ sig = sig[1:];
	379	+
	380	+ method := jcl.class.findsmethod(name, sig);
	381	+ if ( method != nil )
	382	+ return method.flags;
	383	+
	384	+ method = jcl.class.findpmethod(name, sig);
	385	+ if ( method != nil )
	386	+ return method.flags;
	387	+
	388	+ method = jcl.class.findimethod(sig);
	389	+ if ( method != nil )
	390	+ return method.flags;
	391	+
	392	+ vindex := jcl.class.findvmethod(name, sig);
	393	+ if ( vindex > -1 ) {
	394	+ vmethod := jcl.class.virtualmethods[vindex];
	395	+ if ( vmethod.class == jcl.class )
	396	+ return vmethod.field.flags;
	397	+ }
	398	+ return 0;
	399	+}
	400	+
	401	+# Return array of names combined with signatures.
	402	+
	403	+GetFieldSignatures(jcl : JClass, excl : int) : JArrayJString
	404	+{
	405	+ Class : import jldr;
	406	+
	407	+ jary := array[0] of string;
	408	+ if ( jcl == nil )
	409	+ return MkAString(jary);
	410	+ class := jcl.class;
	411	+ static := class.staticdata;
	412	+ object := class.objectdata;
	413	+ jary = array[len static + len object] of string;
	414	+ l := len static;
	415	+ i := 0;
	416	+ for ( j := 0; j < l; j++ ) {
	417	+ field := static[j];
	418	+ tmpf := field.flags & ACC_WRITTEN_FLAGS;
	419	+ if ( (tmpf & excl) != 0 )
	420	+ continue;
	421	+ jary[i++] = field.field + " " + field.signature;
	422	+ }
	423	+ for ( ; object != nil && object != class.super.objectdata; object = tl object ) {
	424	+ field := hd object;
	425	+ tmpf := field.flags & ACC_WRITTEN_FLAGS;
	426	+ if ( (tmpf & excl) != 0 )
	427	+ continue;
	428	+ jary[i++] = field.field + " " + field.signature;
	429	+ }
	430	+ if ( i < len jary ) {
	431	+ newj := array[i] of string;
	432	+ for ( j = 0; j < i; j++ )
	433	+ newj[j] = jary[j];
	434	+ jary = newj;
	435	+ }
	436	+ return MkAString(jary);
	437	+}
	438	+
	439	+GetMethodSignatures(jcl : JClass, excl : int) : JArrayJString
	440	+{
	441	+ Class : import jldr;
	442	+
	443	+ jary := array[0] of string;
	444	+ if ( jcl == nil )
	445	+ return MkAString(jary);
	446	+ class := jcl.class;
	447	+ static := class.staticmethods;
	448	+ virtual := class.virtualmethods;
	449	+ private := class.privatemethods;
	450	+ construct := class.initmethods;
	451	+ l := len static;
	452	+ jary = array[l + len virtual + len private + len construct + 1] of string;
	453	+
	454	+ i := 0;
	455	+ if ( class.classinit != nil )
	456	+ jary[i++] = class.classinit.field + " " + class.classinit.signature;
	457	+
	458	+ for ( j := 0; j < l; j++ ) {
	459	+ method := static[j];
	460	+ tmpf := method.flags & ACC_WRITTEN_FLAGS;
	461	+ if ( (tmpf & excl) != 0 )
	462	+ continue;
	463	+ jary[i++] = method.field + " " + method.signature;
	464	+ }
	465	+ l = len virtual;
	466	+ for ( j = 0; j < l; j++ ) {
	467	+ vmethod := virtual[j];
	468	+ if ( vmethod.class != class )
	469	+ continue;
	470	+ method := vmethod.field;
	471	+ tmpf := method.flags & ACC_WRITTEN_FLAGS;
	472	+ if ( (tmpf & excl) != 0 )
	473	+ continue;
	474	+ jary[i++] = method.field + " " + method.signature;
	475	+ }
	476	+ l = len private;
	477	+ for ( j = 0; j < l; j++ ) {
	478	+ method := private[j];
	479	+ tmpf := method.flags & ACC_WRITTEN_FLAGS;
	480	+ if ( (tmpf & excl) != 0 )
	481	+ continue;
	482	+ jary[i++] = method.field + " " + method.signature;
	483	+ }
	484	+ l = len construct;
	485	+ for ( j = 0; j < l; j++ ) {
	486	+ method := construct[j];
	487	+ tmpf := method.flags & ACC_WRITTEN_FLAGS;
	488	+ if ( (tmpf & excl) != 0 )
	489	+ continue;
	490	+ jary[i++] = method.field + " " + method.signature;
	491	+ }
	492	+ if ( i < len jary ) {
	493	+ newj := array[i] of string;
	494	+ for ( j = 0; j < i; j++ )
	495	+ newj[j] = jary[j];
	496	+ jary = newj;
	497	+ }
	498	+ return MkAString(jary);
	499	+}
	500	+
	501	+# make a temporary JArray for IsAssignable()
	502	+tmpJArray( c : JClass ) : JArray
	503	+{
	504	+ desc := JSigToDescriptor( c.aryname );
	505	+ return JArray(arrayclass().moddata, nil, desc.dims, desc.class, desc.prim);
	506	+}
	507	+
	508	+# can src be assigned to dst?
	509	+IsAssignable( src, dst : JClass ) : JBoolean
	510	+{
	511	+ if ( (src==nil) \|\| (dst==nil) )
	512	+ return( FALSE );
	513	+
	514	+ if ( dst.aryname != nil ) {
	515	+ if ( src.aryname == nil )
	516	+ return( FALSE );
	517	+ jasrc := tmpJArray(src);
	518	+ jadst := tmpJArray(dst);
	519	+ if ( jadst.class == nil )
	520	+ return jldr->pinstanceof(jasrc, jadst.primitive, jadst.dims);
	521	+ else
	522	+ return jldr->ainstanceof(jasrc, jadst.class, jadst.dims);
	523	+ }
	524	+
	525	+ return( jldr->compatclass(src.class, dst.class) );
	526	+}
	527	+
	528	+IsInstanceOf( obj : JObject, cl_data : ClassData ) : JBoolean
	529	+{
	530	+ if ( cl_data == nil )
	531	+ return( FALSE );
	532	+ return( jldr->instanceof( obj, cl_data ) );
	533	+}
	534	+
	535	+
	536	+ArrayInstanceOf( ary : JArray, desc : ref Descriptor ) : JBoolean
	537	+{
	538	+ if ( (ary != nil) && (desc != nil) )
	539	+ {
	540	+ # is it a array of ref or array of primitive
	541	+ if ( ary.class != nil )
	542	+ return( jldr->ainstanceof(ary, desc.class, desc.dims) );
	543	+ else
	544	+ return( jldr->pinstanceof(ary, desc.prim, desc.dims) );
	545	+ }
	546	+ # not an array or not expected instance
	547	+ return( FALSE );
	548	+}
	549	+
	550	+
	551	+IsArray( obj : JObject ) : JBoolean
	552	+{
	553	+ if ( obj == nil )
	554	+ return( FALSE );
	555	+
	556	+ return( IsInstanceOf( obj, arrayclass() ) );
	557	+}
	558	+
	559	+
	560	+# are obj1 and obj2 the same object
	561	+IsSameObject( obj1, obj2 : JObject ) : JBoolean
	562	+{
	563	+ return( obj1 == obj2 );
	564	+}
	565	+
	566	+# Return T_BOOLEAN..T_LONG, T_VOID or 0 according to whether c represents
	567	+# a Java primitive type. If ignorevoid != 0, return 0 for 'void';
	568	+# refection code generally wants to ignore void.
	569	+
	570	+PrimitiveIndex(c : JClass, ignorevoid : int) : int
	571	+{
	572	+ clname := c.class.name; # name of class
	573	+ prefix : con "inferno/vm/"; # will begin with this if primitive
	574	+ prefix_len : con len prefix;
	575	+ ret := 0;
	576	+ if ( len clname > prefix_len && prefix == clname[:prefix_len] )
	577	+ {
	578	+ # check rest of name
	579	+ suffix := clname[prefix_len:];
	580	+ case ( suffix )
	581	+ {
	582	+ # primitive class names
	583	+ "boolean_p" =>
	584	+ ret = T_BOOLEAN;
	585	+ "byte_p" =>
	586	+ ret = T_BYTE;
	587	+ "char_p" =>
	588	+ ret = T_CHAR;
	589	+ "short_p" =>
	590	+ ret = T_SHORT;
	591	+ "int_p" =>
	592	+ ret = T_INT;
	593	+ "long_p" =>
	594	+ ret = T_LONG;
	595	+ "float_p" =>
	596	+ ret = T_FLOAT;
	597	+ "double_p" =>
	598	+ ret = T_DOUBLE;
	599	+ "void_p" =>
	600	+ if ( ! ignorevoid )
	601	+ ret = T_VOID;
	602	+ }
	603	+ }
	604	+ return ret;
	605	+}
	606	+
	607	+#
	608	+# throw the object
	609	+#
	610	+Throw( throwable : JObject )
	611	+{
	612	+ if ( jldr->instanceof( throwable, throwableclass() ) )
	613	+ jldr->throw( throwable );
	614	+
	615	+ FatalError( "JNI Error: attempt to throw a non-throwable object" );
	616	+}
	617	+
	618	+
	619	+#
	620	+# create an instance of the throwable class 'name'
	621	+# fill it with 'msg' and throw it
	622	+#
	623	+ThrowException( name : string, msg : string )
	624	+{
	625	+ class := FindClass( name );
	626	+ if ( (class != nil) && (jldr->compatclass( class, throwableclass() )) )
	627	+ {
	628	+ obj := AllocObject( class );
	629	+
	630	+ # put msg into the object and throw the object
	631	+ args := array [1] of ref Value;
	632	+ args[0] = ref Value.TObject(cast->FromJString(NewString(msg)));
	633	+ #if ( SetObjField( obj, "detailMessage", val ) == OK )
	634	+ (val,err) := CallMethod( obj, "<init>", "(Ljava/lang/String;)V", args );
	635	+
	636	+ # throw regardless of constructor call
	637	+ jldr->throw( obj );
	638	+ }
	639	+
	640	+ FatalError( sys->sprint("JNI Error: while throwing an Exception[%s:%s]",
	641	+ name, msg ) );
	642	+}
	643	+
	644	+#
	645	+# return a Java Exception
	646	+#
	647	+JavaException( ex : string ) : JObject
	648	+{
	649	+ # grab any Java object currently being thrown.
	650	+ jthrow := jldr->getthreaddata().culprit;
	651	+
	652	+ # if ex is nil then the caller is just querying for
	653	+ # the current java throwable so just return 'jthrow'
	654	+
	655	+ # if jthrow is non-nil then return it and ignore ex
	656	+
	657	+ if ( (jthrow != nil) \|\| (ex == nil) )
	658	+ return( jthrow );
	659	+
	660	+ # if no java throwable but we have a non-nil ex then
	661	+ # convert the Inferno exception to an appropriate Java ex.
	662	+ # this will always produce a Java throwable object
	663	+ return( jldr->sysexception(ex) );
	664	+
	665	+}
	666	+
	667	+#
	668	+# clear the exception of the current thread.
	669	+#
	670	+ExceptionClear()
	671	+{
	672	+ thd := jldr->getthreaddata();
	673	+ thd.culprit = nil;
	674	+}
	675	+
	676	+
	677	+
	678	+# allocate a new instance of the class; no constructor called
	679	+AllocObject( cl_data : ClassData ) : JObject
	680	+{
	681	+ Class : import jldr;
	682	+
	683	+ if ( cl_data == nil )
	684	+ return( nil );
	685	+
	686	+ obj := jassist->new(cl_data.mod, cl_data.objtype);
	687	+ obj.mod = cl_data.moddata;
	688	+ return( obj );
	689	+}
	690	+
	691	+
	692	+# allocate a new instance of the class; call default constructor
	693	+NewObject( cl_data : ClassData ) : JObject
	694	+{
	695	+ Class : import jldr;
	696	+
	697	+ if ( cl_data == nil )
	698	+ return( nil );
	699	+
	700	+ return( cl_data.new() );
	701	+}
	702	+
	703	+
	704	+#
	705	+# Create an instance of java.lang.Class which
	706	+# represents a specific java class. This
	707	+# instance contains a ptr to its own class
	708	+# information, as well as a ptr to the class
	709	+# it represents.
	710	+#
	711	+NewClassObject( targ_class : ClassData ) : JClass
	712	+{
	713	+ # create an instance of java.lang.Class
	714	+ cl_data := classclass();
	715	+ return( JClass(classclass().moddata, targ_class, nil) );
	716	+}
	717	+
	718	+
	719	+NewString( val : string ) : JString
	720	+{
	721	+ return( JString( stringclass().moddata, val ) );
	722	+}
	723	+
	724	+#
	725	+# just like above but return as a
	726	+# JObject type, rather then JString
	727	+#
	728	+NewStringObject( val : string ) : JObject
	729	+{
	730	+ # create a java string instance
	731	+ jstr := JString( stringclass().moddata, val );
	732	+
	733	+ return( cast->FromJString(jstr) );
	734	+}
	735	+
	736	+# duplicate the object
	737	+DupObject( src : JObject ) : JObject
	738	+{
	739	+ Object : import jldr;
	740	+ Class : import jldr;
	741	+ newobj : JObject;
	742	+
	743	+ if ( src == nil )
	744	+ return( nil );
	745	+
	746	+ class := src.class();
	747	+ if ( class != arrayclass() )
	748	+ {
	749	+ # safe-copy memory contents
	750	+ # this calls a j2d generated <clone> method
	751	+ newobj = class.clone( src );
	752	+ }
	753	+ else
	754	+ {
	755	+ # handle arrays
	756	+
	757	+ # create object wrapper fro the array
	758	+ newobj = AllocObject( class );
	759	+ asrc := cast->ToJArray(src);
	760	+ adst := cast->ToJArray(newobj);
	761	+ # copy array description
	762	+ adst.dims = asrc.dims;
	763	+ adst.class = asrc.class;
	764	+ adst.primitive = asrc.primitive;
	765	+
	766	+ # copy array data
	767	+
	768	+ # first create the appropriate "kind" of array
	769	+
	770	+ length := len asrc.holder;
	771	+ etype := asrc.primitive;
	772	+
	773	+ if ( etype == 0 \|\| asrc.dims > 1 )
	774	+ adst.holder = array[length] of JString; #any reference type
	775	+ else
	776	+ {
	777	+ case asrc.primitive
	778	+ {
	779	+ T_BOOLEAN or T_BYTE =>
	780	+ adst.holder = jassist->bytearraytoJS(array[length] of byte);
	781	+ T_CHAR or T_SHORT or T_INT =>
	782	+ adst.holder = jassist->intarraytoJS(array[length] of int);
	783	+ T_LONG =>
	784	+ adst.holder = jassist->bigarraytoJS(array[length] of big);
	785	+ T_FLOAT or T_DOUBLE =>
	786	+ adst.holder = jassist->realarraytoJS(array[length] of real);
	787	+ }
	788	+ }
	789	+
	790	+ # copy the contents
	791	+ adst.holder[:] = asrc.holder[:];
	792	+
	793	+ }
	794	+ return( newobj );
	795	+}
	796	+
	797	+
	798	+IdentityHash( obj : JObject ) : int
	799	+{
	800	+ return( jassist->objhash(obj) );
	801	+}
	802	+
	803	+
	804	+GetArrayLength ( ary : JArray ) : int
	805	+{
	806	+ return( len ary.holder );
	807	+}
	808	+
	809	+#
	810	+# grab the lock associated with the object
	811	+#
	812	+MonitorEnter( obj : JObject )
	813	+{
	814	+ if ( obj == nil )
	815	+ ThrowException( "java.lang.NullPointerException", "JNI Error: nil passed to MonitorEnter()" );
	816	+
	817	+ jldr->monitorenter( obj );
	818	+}
	819	+
	820	+
	821	+#
	822	+# release the lock associated with the object
	823	+#
	824	+MonitorExit( obj :JObject )
	825	+{
	826	+ if ( obj == nil )
	827	+ ThrowException( "java.lang.NullPointerException", "JNI Error: nil passed to MonitorExit()" );
	828	+ jldr->monitorexit( obj );
	829	+}
	830	+
	831	+#
	832	+# Notify any waiters
	833	+# all==1 => notify all
	834	+#
	835	+MonitorLockNotify( obj : JObject, all : int )
	836	+{
	837	+ if ( obj == nil )
	838	+ ThrowException( "java.lang.NullPointerException", "JNI Error: nil passed to MonitorNotify()" );
	839	+ jldr->monitorenter(obj);
	840	+ jldr->monitornotify(obj,(all==1));
	841	+ jldr->monitorexit(obj);
	842	+}
	843	+
	844	+#
	845	+# Same as above but don't do the monitor-enter/exit
	846	+#
	847	+MonitorNotify( obj : JObject, all : int )
	848	+{
	849	+ if ( obj == nil )
	850	+ ThrowException( "java.lang.NullPointerException", "JNI Error: nil passed to MonitorNotify()" );
	851	+ jldr->monitornotify(obj,(all==1));
	852	+}
	853	+
	854	+#
	855	+# attach/detach a Limbo thread
	856	+#
	857	+
	858	+thdcnt := 0; #use to number threads
	859	+
	860	+AttachCurrentThread( arg : ref ThreadAttachArgs ) : int
	861	+{
	862	+ # grab/create a thread struct for this thread
	863	+ thd := jldr->getthreaddata();
	864	+
	865	+ # if no java obj then create and install one
	866	+ if ( thd.this == nil )
	867	+ {
	868	+ jobj := AllocObject( threadclass() );
	869	+ if (jobj == nil )
	870	+ return( -1 );
	871	+ jthd := cast->JObjToJThd(jobj);
	872	+ jthd.PrivateInfo = thd;
	873	+ jthd.daemon = arg.daemon;
	874	+ if ( arg.daemon == byte 1)
	875	+ jldr->daemonize();
	876	+
	877	+ if ( arg.group == nil )
	878	+ jthd.group = MainThreadGroup();
	879	+ else
	880	+ jthd.group = arg.group;
	881	+
	882	+ thdname : string;
	883	+ if ( arg.name == nil )
	884	+ thdname = "nativethd-"+ string thdcnt++;
	885	+ else
	886	+ thdname = arg.name;
	887	+ jthd.name = StringToAChar( thdname );
	888	+
	889	+ # set rest to defaults
	890	+ jthd.priority = 5; #fake; not used
	891	+ jthd.was_interrupted = byte 0;
	892	+ jthd.stillborn = byte 0;
	893	+ jthd.target = nil;
	894	+
	895	+ # put thread object into thread data struct
	896	+ thd.this = jobj;
	897	+ }
	898	+
	899	+ return( 0 ); #no error
	900	+}
	901	+
	902	+
	903	+DetachCurrentThread() : int
	904	+{
	905	+ # get the low-thread struct
	906	+ thd := jldr->getthreaddata();
	907	+
	908	+ jobj := thd.this; # grab the java Thread obj
	909	+
	910	+ if ( jobj != nil )
	911	+ {
	912	+ #notify all waiters
	913	+ MonitorLockNotify(jobj,1);
	914	+
	915	+ # do some cleanup -- break circularity
	916	+ jthd := cast->JObjToJThd(jobj);
	917	+ jthd.PrivateInfo = nil;
	918	+ thd.this = nil;
	919	+ }
	920	+
	921	+ # remove calling thd from the internal list
	922	+ jldr->delthreaddata();
	923	+
	924	+ return( 0 );
	925	+}
	926	+
	927	+
	928	+MainThreadGroup() : JObject
	929	+{
	930	+ if ( mainthreadgroup == nil )
	931	+ {
	932	+ thd_grp_cl := FindClass( "java.lang.ThreadGroup" );
	933	+ if ( thd_grp_cl == nil )
	934	+ FatalError( "could not obtain ThreadGroup class" );
	935	+
	936	+ mainthreadgroup = NewObject( thd_grp_cl );
	937	+ if ( mainthreadgroup == nil )
	938	+ FatalError( "could not create root threadgroup" );
	939	+ }
	940	+
	941	+ return( mainthreadgroup );
	942	+}
	943	+
	944	+
	945	+FatalError( msg : string )
	946	+{
	947	+ ThrowException( "java/lang/InternalError", msg );
	948	+}
	949	+
	950	+
	951	+InitError( msg : string )
	952	+{
	953	+ # prepend string to insure msg is not nil
	954	+ # nil passed to error forces reporting which
	955	+ # we will leave to the loader to determine
	956	+ jldr->error( "JNI: "+ msg );
	957	+}
	958	+
	959	+
	960	+#
	961	+# functions to make "java" arrays from limbo arrays
	962	+#
	963	+MkAByte( bary : array of byte ) : JArrayB
	964	+{
	965	+ # create Array object
	966	+ cl_data := arrayclass();
	967	+ jbary := cast->ToJArrayB( AllocObject( cl_data ) );
	968	+
	969	+ jbary.ary = bary;
	970	+ jbary.dims = 1;
	971	+ jbary.class = nil;
	972	+ jbary.primitive = T_BYTE;
	973	+
	974	+ return( jbary );
	975	+}
	976	+
	977	+MkAChar( ary : array of int ) : JArrayC
	978	+{
	979	+ # create Array object
	980	+ jary := cast->ToJArrayC( AllocObject( arrayclass() ) );
	981	+
	982	+ jary.ary = ary;
	983	+ jary.dims = 1;
	984	+ jary.class = nil;
	985	+ jary.primitive = T_CHAR;
	986	+
	987	+ return( jary );
	988	+}
	989	+
	990	+MkAShort( ary : array of int ) : JArrayS
	991	+{
	992	+ # create Array object
	993	+ jary := cast->ToJArrayC( AllocObject( arrayclass() ) );
	994	+
	995	+ jary.ary = ary;
	996	+ jary.dims = 1;
	997	+ jary.class = nil;
	998	+ jary.primitive = T_SHORT;
	999	+
	1000	+ return( jary );
	1001	+}
	1002	+
	1003	+MkAInt( iary : array of int ) : JArrayI
	1004	+{
	1005	+ # create Array object
	1006	+ jiary := cast->ToJArrayI( AllocObject( arrayclass() ) );
	1007	+
	1008	+ jiary.ary = iary;
	1009	+ jiary.dims = 1;
	1010	+ jiary.class = nil;
	1011	+ jiary.primitive = T_INT;
	1012	+
	1013	+ return( jiary );
	1014	+}
	1015	+
	1016	+MkALong( ary : array of big ) : JArrayJ
	1017	+{
	1018	+ # create Array object
	1019	+ jary := cast->ToJArrayJ( AllocObject( arrayclass() ) );
	1020	+
	1021	+ jary.ary = ary;
	1022	+ jary.dims = 1;
	1023	+ jary.class = nil;
	1024	+ jary.primitive = T_LONG;
	1025	+
	1026	+ return( jary );
	1027	+}
	1028	+
	1029	+MkAFloat( ary : array of real ) : JArrayF
	1030	+{
	1031	+ # create Array object
	1032	+ jary := cast->ToJArrayF( AllocObject( arrayclass() ) );
	1033	+
	1034	+ jary.ary = ary;
	1035	+ jary.dims = 1;
	1036	+ jary.class = nil;
	1037	+ jary.primitive = T_FLOAT;
	1038	+
	1039	+ return( jary );
	1040	+}
	1041	+
	1042	+MkADouble( ary : array of real ) : JArrayD
	1043	+{
	1044	+ # create Array object
	1045	+ jary := cast->ToJArrayD( AllocObject( arrayclass() ) );
	1046	+
	1047	+ jary.ary = ary;
	1048	+ jary.dims = 1;
	1049	+ jary.class = nil;
	1050	+ jary.primitive = T_DOUBLE;
	1051	+
	1052	+ return( jary );
	1053	+}
	1054	+
	1055	+MkABoolean( ary : array of byte ) : JArrayZ
	1056	+{
	1057	+ # create Array object
	1058	+ jary := cast->ToJArrayZ( AllocObject( arrayclass() ) );
	1059	+
	1060	+ jary.ary = ary;
	1061	+ jary.dims = 1;
	1062	+ jary.class = nil;
	1063	+ jary.primitive = T_BOOLEAN;
	1064	+
	1065	+ return( jary );
	1066	+}
	1067	+
	1068	+
	1069	+MkAString( sary : array of string ) : JArrayJString
	1070	+{
	1071	+ # create Array object
	1072	+ jstrary := cast->ToJArrayJString( AllocObject( arrayclass() ) );
	1073	+
	1074	+ # fill it with the real dis array
	1075	+ jstrary.ary = array[len sary] of JString;
	1076	+
	1077	+ # now fill the dis array
	1078	+ for( x:=0; x < len sary; x++ )
	1079	+ jstrary.ary[x] = NewString( sary[x] );
	1080	+
	1081	+ jstrary.dims = 1;
	1082	+ jstrary.class = stringclass();
	1083	+ jstrary.primitive = 0;
	1084	+
	1085	+ return( jstrary );
	1086	+}
	1087	+
	1088	+MkAObject( ary : array of JObject ) : JArrayJObject
	1089	+{
	1090	+ # create Array object
	1091	+ jary := cast->ToJArrayJObject( AllocObject( arrayclass() ) );
	1092	+
	1093	+ jary.ary = ary;
	1094	+ jary.dims = 1;
	1095	+ jary.class = stringclass();
	1096	+ if ( len ary > 0 )
	1097	+ jary.class = GetObjectClassData(ary[0]);
	1098	+ jary.primitive = 0;
	1099	+
	1100	+ return( jary );
	1101	+}
	1102	+
	1103	+
	1104	+MkAJArray( jaary : array of JArray ) : JArray
	1105	+{
	1106	+ # create Array object
	1107	+ jary := cast->ToJArray( AllocObject( arrayclass() ) );
	1108	+
	1109	+ # fill it with the real dis array
	1110	+ jary.holder = cast->JArrayToHolder( jaary );
	1111	+ jary.dims = jaary[0].dims + 1;
	1112	+ jary.class = arrayclass();
	1113	+ jary.primitive = 0;
	1114	+ return( jary );
	1115	+}
	1116	+
	1117	+
	1118	+MkAAByte( aabyte : array of array of byte ) : JArray
	1119	+{
	1120	+ # create array of JArray
	1121	+ contents := array[len aabyte] of JArray;
	1122	+
	1123	+ # fill contents with converted byte array
	1124	+ for( x:=0; x<len aabyte; x++ )
	1125	+ {
	1126	+ contents[x] = cast->ByteToJArray( MkAByte( aabyte[x] ) );
	1127	+ }
	1128	+
	1129	+ # wrap up in an array of its own and return
	1130	+ return( MkAJArray( contents ) );
	1131	+}
	1132	+
	1133	+MkAAInt( aary : array of array of int ) : JArray
	1134	+{
	1135	+ # create array of JArray
	1136	+ contents := array[len aary] of JArray;
	1137	+
	1138	+ # fill contents with converted byte array
	1139	+ for( x:=0; x<len aary; x++ )
	1140	+ {
	1141	+ contents[x] = cast->IntToJArray( MkAInt( aary[x] ) );
	1142	+ }
	1143	+
	1144	+ # wrap up in an array of its own and return
	1145	+ return( MkAJArray( contents ) );
	1146	+}
	1147	+
	1148	+
	1149	+#
	1150	+# Value adt
	1151	+#
	1152	+
	1153	+Value.Boolean( this : self ref Value ) : JBoolean
	1154	+{
	1155	+ pick sw := this
	1156	+ {
	1157	+ TBoolean => return( sw.jboolean );
	1158	+ * => FatalError( "Value: bad pick access" );
	1159	+ }
	1160	+ return( 0);
	1161	+}
	1162	+
	1163	+Value.Byte( this : self ref Value ) : int
	1164	+{
	1165	+ pick sw := this
	1166	+ {
	1167	+ TByte => return( sw.jbyte );
	1168	+ * => FatalError( "Value: bad pick access" );
	1169	+ }
	1170	+ return(0);
	1171	+}
	1172	+
	1173	+Value.Short( this : self ref Value ) : int
	1174	+{
	1175	+ pick sw := this
	1176	+ {
	1177	+ TShort => return( sw.jshort );
	1178	+ * => FatalError( "Value: bad pick access" );
	1179	+ }
	1180	+ return(0);
	1181	+}
	1182	+
	1183	+Value.Int( this : self ref Value ) : int
	1184	+{
	1185	+ pick sw := this
	1186	+ {
	1187	+ TInt => return( sw.jint );
	1188	+ * => FatalError( "Value: bad pick access" );
	1189	+ }
	1190	+ return(0);
	1191	+}
	1192	+
	1193	+Value.Long( this : self ref Value ) : big
	1194	+{
	1195	+ pick sw := this
	1196	+ {
	1197	+ TLong => return( sw.jlong );
	1198	+ * => FatalError( "Value: bad pick access" );
	1199	+ }
	1200	+ return(big 0);
	1201	+}
	1202	+
	1203	+Value.Float( this : self ref Value ) : real
	1204	+{
	1205	+ pick sw := this
	1206	+ {
	1207	+ TFloat => return( sw.jfloat );
	1208	+ * => FatalError( "Value: bad pick access" );
	1209	+ }
	1210	+ return(0.0);
	1211	+}
	1212	+
	1213	+Value.Double( this : self ref Value ) : real
	1214	+{
	1215	+ pick sw := this
	1216	+ {
	1217	+ TDouble => return( sw.jdouble );
	1218	+ * => FatalError( "Value: bad pick access" );
	1219	+ }
	1220	+ return(0.0);
	1221	+}
	1222	+
	1223	+Value.Char( this : self ref Value ) : int
	1224	+{
	1225	+ pick sw := this
	1226	+ {
	1227	+ TChar => return( sw.jchar );
	1228	+ * => FatalError( "Value: bad pick access" );
	1229	+ }
	1230	+ return(0);
	1231	+}
	1232	+
	1233	+Value.Object( this : self ref Value ) : JObject
	1234	+{
	1235	+ pick sw := this
	1236	+ {
	1237	+ TObject => return( sw.jobj);
	1238	+ * => FatalError( "Value: bad pick access" );
	1239	+ }
	1240	+ return(nil);
	1241	+}
	1242	+
	1243	+
	1244	+#
	1245	+# Take a "java vm" signagure string and
	1246	+# return a structure which describes the
	1247	+# type represented by the sig.
	1248	+# SEE: declaration of 'Descriptor'
	1249	+#
	1250	+JSigToDescriptor( sig : string ) : ref Descriptor
	1251	+{
	1252	+ desc := ref Descriptor(nil,0,0,nil,nil);
	1253	+ siglen := len sig;
	1254	+ if ( sig[0] == '(' ) # method
	1255	+ {
	1256	+ methsig := sig[1:];
	1257	+ sigsize := 2; #account for '(' and ')' in method sig
	1258	+ while ( methsig[0] != ')' )
	1259	+ {
	1260	+ # get descriptor for current param
	1261	+ paramdesc := JSigToDescriptor(methsig);
	1262	+ if ( paramdesc == nil )
	1263	+ return( nil ); #error
	1264	+
	1265	+ # add the param to the list
	1266	+ desc.params = paramdesc :: desc.params;
	1267	+
	1268	+ # advance to next param
	1269	+ tmp := len paramdesc.sig;
	1270	+ if ( tmp >= len methsig )
	1271	+ return( nil ); #error in signature
	1272	+ methsig = methsig[tmp:];
	1273	+ sigsize += tmp;
	1274	+ }
	1275	+
	1276	+ if ( len methsig <= 1 )
	1277	+ return( nil ); #error expected a return type
	1278	+
	1279	+ rettyp := JSigToDescriptor( methsig[1:] );
	1280	+ if ( rettyp == nil )
	1281	+ return( nil ); #error
	1282	+ # save the return type information in the current desc
	1283	+ desc.class = rettyp.class;
	1284	+ desc.prim = rettyp.prim;
	1285	+ desc.dims = rettyp.dims;
	1286	+
	1287	+ # set sig for method
	1288	+ desc.sig = sig[0:sigsize+len rettyp.sig];
	1289	+
	1290	+ }
	1291	+ else if ( sig[0] == 'L' ) # object (non-array)
	1292	+ {
	1293	+ # find ';' indicating end of class name or
	1294	+ # the end of the str
	1295	+ for( last := 1; last<siglen; last++ )
	1296	+ if ( sig[last] == ';' )
	1297	+ break;
	1298	+ desc.class = FindClass( sig[1:last] );
	1299	+ desc.sig = sig[:last] + ";";
	1300	+ }
	1301	+ else if ( sig[0] == '[' ) # array
	1302	+ {
	1303	+ # count dimensions
	1304	+ last := siglen;
	1305	+ for(x:=1; x<last; x++)
	1306	+ {
	1307	+ if ( sig[x] != '[' )
	1308	+ break;
	1309	+ }
	1310	+ if ( x >= last )
	1311	+ return nil; #error expect at least 1 char following ['s
	1312	+ desc = JSigToDescriptor( sig[x:] );
	1313	+ if ( desc == nil )
	1314	+ return nil;
	1315	+
	1316	+ # else just set dimensions and sig
	1317	+ desc.dims = x;
	1318	+ tmp := x + len desc.sig;
	1319	+ desc.sig = sig[:tmp];
	1320	+ }
	1321	+ else # primitive type
	1322	+ {
	1323	+ case sig[0]
	1324	+ {
	1325	+ 'B' => desc.prim = T_BYTE;
	1326	+ 'Z' => desc.prim = T_BOOLEAN;
	1327	+ 'S' => desc.prim = T_SHORT;
	1328	+ 'C' => desc.prim = T_CHAR;
	1329	+ 'I' => desc.prim = T_INT;
	1330	+ 'J' => desc.prim = T_LONG;
	1331	+ 'F' => desc.prim = T_FLOAT;
	1332	+ 'D' => desc.prim = T_DOUBLE;
	1333	+ 'V' => desc.prim = T_VOID;
	1334	+ * => return( nil ); #unknown signature
	1335	+ }
	1336	+ desc.sig = sig[0:1];
	1337	+ }
	1338	+
	1339	+ return desc;
	1340	+}
	1341	+
	1342	+
	1343	+IsNative( flags : int ) : int
	1344	+{
	1345	+ return( flags & ACC_NATIVE );
	1346	+}
	1347	+
	1348	+
	1349	+#
	1350	+# Search for a method. Flags indicates which methods to
	1351	+# search for, and we may try to find in more than one
	1352	+# group, so cascade down.
	1353	+#
	1354	+FindMethod( class : ClassData, name : string, sig : string, flags : int ) : (Nilmod,int)
	1355	+{
	1356	+ Class : import jldr;
	1357	+
	1358	+ if ( class == nil )
	1359	+ return( nil, 0 );
	1360	+
	1361	+ if ( flags & METH_PRIVATE )
	1362	+ {
	1363	+ f := class.findpmethod( name, sig );
	1364	+ if ( f != nil )
	1365	+ {
	1366	+ mod : Nilmod;
	1367	+ if ( IsNative(f.flags) )
	1368	+ mod = class.native;
	1369	+ else
	1370	+ mod = class.mod;
	1371	+
	1372	+ return ( mod, f.value );
	1373	+ }
	1374	+ }
	1375	+
	1376	+ if ( flags & METH_VIRTUAL )
	1377	+ {
	1378	+ idx := class.findvmethod( name, sig );
	1379	+ if ( idx != -1 )
	1380	+ {
	1381	+ m := class.virtualmethods[idx];
	1382	+ return( m.class.mod, m.field.value );
	1383	+ }
	1384	+ }
	1385	+
	1386	+ if ( flags & METH_STATIC )
	1387	+ {
	1388	+ f := class.findsmethod( name, sig );
	1389	+ if ( f != nil )
	1390	+ {
	1391	+ mod : Nilmod;
	1392	+ if ( IsNative(f.flags) )
	1393	+ mod = class.native;
	1394	+ else
	1395	+ mod = class.mod;
	1396	+
	1397	+ return ( mod, f.value );
	1398	+ }
	1399	+ }
	1400	+
	1401	+ if ( flags & METH_INIT )
	1402	+ {
	1403	+ f := class.findimethod( sig );
	1404	+ if ( f != nil )
	1405	+ {
	1406	+ mod := class.mod; #constructors can't be native
	1407	+ return ( mod, f.value );
	1408	+ }
	1409	+ }
	1410	+
	1411	+ return (nil,0);
	1412	+}
	1413	+
	1414	+CastMod() : Cast
	1415	+{
	1416	+ return( cast );
	1417	+}
	1418	+
	1419	+LowMod() : Low
	1420	+{
	1421	+ return( low );
	1422	+}
	1423	+
	1424	+########## functions called by JavaClassLoader
	1425	+
	1426	+jinit( ldr : JavaClassLoader, jass : JavaAssist )
	1427	+{
	1428	+ jldr = ldr;
	1429	+ jassist = jass;
	1430	+}
	1431	+
	1432	+Self(s: Sys, j: JNI): (Nilmod, string)
	1433	+{
	1434	+ sys = s;
	1435	+ math = load Math Math->PATH;
	1436	+ if ( math == nil )
	1437	+ return (nil, sys->sprint("could not load %s: %r", Math->PATH));
	1438	+
	1439	+ str = load String String->PATH;
	1440	+ if ( str == nil )
	1441	+ return (nil, sys->sprint("could not load %s: %r", String->PATH));
	1442	+
	1443	+ cast = load Cast Cast->PATH;
	1444	+ if (cast == nil)
	1445	+ return (nil, sys->sprint("could not load %s: %r", Cast->PATH));
	1446	+ low = load Low Low->PATH;
	1447	+ if (low == nil)
	1448	+ return (nil, sys->sprint("could not load %s: %r", Low->PATH));
	1449	+ return (cast->JNI2Nilmod(j), nil);
	1450	+}
	1451	+
	1452	+init(nil: JNI)
	1453	+{
	1454	+}
	1455	+
	1456	+########## private functions
	1457	+
	1458	+#
	1459	+# private fct to create an instance of java.lang.Class
	1460	+# for a specific array type. each class instance is
	1461	+# cached in a hash table so future queries for the same
	1462	+# class will get the same object back.
	1463	+ArrayClassObject( ary : JArray ) : JClass
	1464	+{
	1465	+ arycodes := "[[[[[[[[[[";
	1466	+ if ( ary.dims >= len arycodes )
	1467	+ while ( ary.dims >= len arycodes )
	1468	+ arycodes += arycodes;
	1469	+ sig := arycodes[:ary.dims];
	1470	+ if ( ary.primitive == 0 )
	1471	+ {
	1472	+ clname := ary.class.name;
	1473	+ for(x:=0;x<len clname; x++ )
	1474	+ if ( clname[x] == '.' )
	1475	+ clname[x] = '/';
	1476	+ sig += "L"+ clname +";";
	1477	+ }
	1478	+ else
	1479	+ {
	1480	+ typ := ary.primitive;
	1481	+ if ( (typ >= T_BOOLEAN) \|\| (typ <= T_LONG) )
	1482	+ {
	1483	+ typcode := "ZCFDBSIJ";
	1484	+ sig[len sig] = typcode[typ-T_BOOLEAN];
	1485	+ }
	1486	+ }
	1487	+ clobj := LookupArrayClass( sig );
	1488	+
	1489	+ return( clobj );
	1490	+}
	1491	+
	1492	+#
	1493	+# maintain a hash table of array class objects
	1494	+# order based on the array signature string.
	1495	+#
	1496	+ACSZ : con 31;
	1497	+actable := array[ACSZ] of list of JClass;
	1498	+
	1499	+LookupArrayClass( sig : string ) : JClass
	1500	+{
	1501	+ if ( hash == nil )
	1502	+ {
	1503	+ hash = load Hash Hash->PATH;
	1504	+ if ( hash == nil )
	1505	+ FatalError( sys->sprint( "could not load %s:%r", Hash->PATH ) );
	1506	+ }
	1507	+
	1508	+ # search for an existing class object with same name
	1509	+ for( l := actable[hash->fun1(sig,ACSZ)]; l != nil; l = tl l )
	1510	+ {
	1511	+ class := hd l;
	1512	+ if (class.aryname == sig)
	1513	+ return( class );
	1514	+ }
	1515	+
	1516	+ # could not find so add this class
	1517	+ class := NewClassObject( arrayclass() );
	1518	+ class.aryname = sig;
	1519	+ idx := hash->fun1(sig,ACSZ);
	1520	+ actable[idx] = class :: actable[idx];
	1521	+ return( class );
	1522	+}
	1523	+
	1524	+
	1525	+#
	1526	+# check argument array against method signature. It is assumed
	1527	+# that 'sig' is a well-formed method signature. This fct verifies
	1528	+# that the arguments match the signature (no widening of primtive
	1529	+# types is performed. It returns a tuple specifiying if the method
	1530	+# is a function and an error flag
	1531	+# RETURN: (isfct,err)
	1532	+# (desc,0) -- function; no error
	1533	+# (nil,0) -- procedure; no error
	1534	+# (nil,ERR) -- error; params did not match
	1535	+#
	1536	+CheckMethodArgs( sig : string, args : array of ref Value ) : (ref Descriptor,int)
	1537	+{
	1538	+ desc := JSigToDescriptor( sig ); # description of method
	1539	+ if ( desc == nil )
	1540	+ return( nil,ERR ); # error
	1541	+
	1542	+ # determine if the method returns a value
	1543	+ isfct : ref Descriptor;
	1544	+ if ((desc.class!=nil) \|\| (desc.prim!=T_VOID))
	1545	+ isfct = desc;
	1546	+
	1547	+ count := len args;
	1548	+ if ( count != len desc.params )
	1549	+ return(nil,CALLERR_BADARGCNT); #argument count mismatch
	1550	+
	1551	+ if ( count == 0 )
	1552	+ return(isfct,OK); # no params to compare
	1553	+
	1554	+ for( params := desc.params; params!=nil; params = tl params )
	1555	+ {
	1556	+ param := hd params;
	1557	+ count--;
	1558	+ valid := 0; #assume bad arg
	1559	+ pick sw := args[count]
	1560	+ {
	1561	+ TObject =>
	1562	+ # check if actual ref arg compatible with formal
	1563	+ if ( ( sw.jobj == nil )
	1564	+ \|\| ( IsArray(sw.jobj) && (ArrayInstanceOf(cast->ToJArray(sw.jobj), param) ) )
	1565	+ \|\| ( IsInstanceOf( sw.jobj, param.class ) ) )
	1566	+ valid = 1;
	1567	+ TByte => valid = (param.prim == T_BYTE);
	1568	+ TBoolean => valid = (param.prim == T_BOOLEAN);
	1569	+ TChar => valid = (param.prim == T_CHAR);
	1570	+ TShort => valid = (param.prim == T_SHORT);
	1571	+ TInt => valid = (param.prim == T_INT);
	1572	+ TLong => valid = (param.prim == T_LONG);
	1573	+ TFloat => valid = (param.prim == T_FLOAT);
	1574	+ TDouble => valid = (param.prim == T_DOUBLE);
	1575	+ }
	1576	+
	1577	+ if ( ! valid )
	1578	+ return(nil,CALLERR_BADARG+count); #class mismatch
	1579	+ }
	1580	+
	1581	+ # if we survived then all args matched
	1582	+ return(isfct,OK);
	1583	+}
	1584	+
	1585	+# verify that 'val' matches 'field'
	1586	+# RETURN: 0 => no match
	1587	+# 1 => match
	1588	+#
	1589	+CheckField( field : ref jldr->Field, val : ref Value ) : int
	1590	+{
	1591	+ # check we have the right one
	1592	+ if ( field == nil )
	1593	+ return( 0 );
	1594	+
	1595	+ valid := 0;
	1596	+
	1597	+ pick sw := val
	1598	+ {
	1599	+ TObject =>
	1600	+ {
	1601	+ # check reference type: object or array
	1602	+ desc := JSigToDescriptor( field.signature );
	1603	+
	1604	+ if ( (field.signature[0] == 'L') && (desc.class != nil) )
	1605	+ {
	1606	+ if ( sw.jobj != nil && IsInstanceOf( sw.jobj, desc.class ) == FALSE )
	1607	+ return( 0 );
	1608	+ }
	1609	+ else if ( (field.signature[0] == '[') && (desc.dims>0) )
	1610	+ {
	1611	+ # array ref type
	1612	+ if ( sw.jobj != nil && ArrayInstanceOf( cast->ToJArray(sw.jobj), desc ) == FALSE )
	1613	+ return( 0 );
	1614	+ }
	1615	+ else
	1616	+ return( 0 );
	1617	+ valid = 1; # ref field is ok
	1618	+ }
	1619	+ TByte => valid = (field.signature[0] == 'B');
	1620	+ TBoolean => valid = (field.signature[0] == 'Z');
	1621	+ TChar => valid = (field.signature[0] == 'C');
	1622	+ TShort => valid = (field.signature[0] == 'S');
	1623	+ TInt => valid = (field.signature[0] == 'I');
	1624	+ TLong => valid = (field.signature[0] == 'J');
	1625	+ TFloat => valid = (field.signature[0] == 'F');
	1626	+ TDouble => valid = (field.signature[0] == 'D');
	1627	+ }
	1628	+
	1629	+ return( valid );
	1630	+}
	1631	+
	1632	+#
	1633	+# Set a field at the given refernce and offset.
	1634	+#
	1635	+SetField( ptr : ref Loader->Niladt, off : int, val : ref Value ) : int
	1636	+{
	1637	+ # must be good, set the field to the provided value
	1638	+ pick sw := val
	1639	+ {
	1640	+ TByte => low->SetByte( ptr, off, byte sw.jbyte );
	1641	+ TBoolean => low->SetByte( ptr, off, byte sw.jboolean );
	1642	+ TShort => low->SetInt( ptr, off, sw.jshort );
	1643	+ TChar => low->SetInt( ptr, off, sw.jchar );
	1644	+ TInt => low->SetInt( ptr, off, sw.jint );
	1645	+ TLong => low->SetBig( ptr, off, sw.jlong );
	1646	+ TFloat => low->SetReal( ptr, off, sw.jfloat );
	1647	+ TDouble => low->SetReal( ptr, off, sw.jdouble );
	1648	+ TObject => low->SetObj( ptr, off, sw.jobj );
	1649	+ * => return( ERR );
	1650	+ }
	1651	+
	1652	+ return( OK );
	1653	+}
	1654	+
	1655	+
	1656	+#
	1657	+# grab a given field from the reference and offset given
	1658	+#
	1659	+GetField( ptr : ref Loader->Niladt, off : int, typ : int ) : ref Value
	1660	+{
	1661	+ val : ref Value;
	1662	+
	1663	+ if ( (ptr==nil) \|\| (off < 0) )
	1664	+ return( nil );
	1665	+
	1666	+ # use typ char to determine type we are after
	1667	+ case typ
	1668	+ {
	1669	+ 'B' => val = ref Value.TByte(int low->GetByte( ptr, off ));
	1670	+ 'C' => val = ref Value.TChar(low->GetInt( ptr, off ));
	1671	+ 'S' => val = ref Value.TShort(low->GetInt( ptr, off ));
	1672	+ 'I' => val = ref Value.TInt(low->GetInt( ptr, off ));
	1673	+ 'Z' => val = ref Value.TBoolean(int low->GetByte( ptr, off ));
	1674	+ 'J' => val = ref Value.TLong(low->GetBig( ptr, off ));
	1675	+ 'F' => val = ref Value.TFloat(low->GetReal( ptr, off ));
	1676	+ 'D' => val = ref Value.TDouble(low->GetReal( ptr, off ));
	1677	+ 'L' or
	1678	+ '[' => val = ref Value.TObject(low->GetObj( ptr, off ));
	1679	+ * => return(nil);
	1680	+ }
	1681	+
	1682	+ return( val );
	1683	+}
	1684	+
	1685	+
	1686	+#
	1687	+# The following functions will load specific java
	1688	+# classes on demand. The classes are loaded as late
	1689	+# as possible
	1690	+#
	1691	+stringclass() : ClassData
	1692	+{
	1693	+ if ( string_class == nil )
	1694	+ string_class = jldr->loader( "java/lang/String" );
	1695	+ return( string_class );
	1696	+}
	1697	+
	1698	+arrayclass() : ClassData
	1699	+{
	1700	+ if ( array_class == nil )
	1701	+ array_class = jldr->loader( "inferno/vm/Array" );
	1702	+ return( array_class );
	1703	+}
	1704	+
	1705	+classclass() : ClassData
	1706	+{
	1707	+ if ( class_class == nil )
	1708	+ class_class = jldr->loader( "java/lang/Class" );
	1709	+ return( class_class );
	1710	+}
	1711	+
	1712	+throwableclass() : ClassData
	1713	+{
	1714	+ if (throwable_class == nil)
	1715	+ throwable_class = jldr->loader("java/lang/Throwable");
	1716	+ return( throwable_class );
	1717	+}
	1718	+
	1719	+threadclass() : ClassData
	1720	+{
	1721	+ if (thread_class == nil)
	1722	+ thread_class = jldr->loader("java/lang/Thread");
	1723	+ return( thread_class );
	1724	+}
	1725	+
	1726	+StringToAChar( s : string ) : JArrayC
	1727	+{
	1728	+ l := len s;
	1729	+ ac := array[l] of int;
	1730	+
	1731	+ for( x:=0; x<l; x++ )
	1732	+ ac[x] = s[x];
	1733	+
	1734	+ return( MkAChar(ac) );
	1735	+}

java/appl/java/jvm.b+142−0

@@ -0,0 +1,142 @@
	1	+implement jvm;
	2	+
	3	+include "sys.m";
	4	+ FD: import Sys;
	5	+
	6	+include "loader.m";
	7	+include "classloader.m";
	8	+Context: import Draw;
	9	+
	10	+jvm: module
	11	+{
	12	+ init: fn(ctxt: ref Context, argv: list of string);
	13	+};
	14	+
	15	+PJAVAVER : con "v1.0"; #javasoft pjava we are based on
	16	+
	17	+sys: Sys;
	18	+stderr: ref FD;
	19	+classloader: JavaClassLoader;
	20	+Class: import classloader;
	21	+
	22	+init(ctxt: ref Context, argv: list of string)
	23	+{
	24	+ sys = load Sys Sys->PATH;
	25	+ stderr = sys->fildes(2);
	26	+
	27	+ # split args into classloader options and java app args
	28	+ (opts,args) := processargs(argv);
	29	+
	30	+ classloader = load JavaClassLoader JavaClassLoader->PATH;
	31	+ if (classloader == nil) {
	32	+ sys->fprint(stderr, "could not load %s: %r\n", JavaClassLoader->PATH);
	33	+ exit;
	34	+ }
	35	+ s := classname(hd tl args);
	36	+ sys->pctl(sys->NEWPGRP, nil);
	37	+
	38	+ classloader->init(classloader,ctxt);
	39	+
	40	+ if ( opts != nil )
	41	+ classloader->setflags(opts);
	42	+
	43	+ classloader->runmain(classloader, s, args);
	44	+}
	45	+
	46	+classname(s: string): string
	47	+{
	48	+ d: string;
	49	+ n := len s;
	50	+ for (i := 0; i < n; i++) {
	51	+ c := s[i];
	52	+ if (c == '.')
	53	+ d[i] = '/';
	54	+ else
	55	+ d[i] = c;
	56	+ }
	57	+ return d;
	58	+}
	59	+
	60	+#
	61	+# process the argv of 'jvm' and handle any 'jvm' flags here
	62	+# and return:
	63	+# classloader options in the form of 'list of (string,val)'
	64	+# java class args in the form of 'list of string'
	65	+# valid classloader options are:
	66	+# ("debug",1\|0) -- debug messages on==1
	67	+# ("verbose",1\|0) -- verbose messages on==1
	68	+# ("warn",1\|0) -- warning messages on==1
	69	+# valid local jvm options are:
	70	+# i == version information
	71	+# h == jvm help
	72	+#
	73	+processargs( argv : list of string ) : (list of (string,int), list of string)
	74	+{
	75	+ if ( argv == nil )
	76	+ {
	77	+ mesg("error: invalid parameters");
	78	+ showhelp("jvm"); #exits
	79	+ }
	80	+
	81	+ # cmd ::= 'jvm' [flags] javastuff
	82	+ # flags ::= '-' CHAR+
	83	+ jvmcmd := hd argv;
	84	+ stuff := tl argv;
	85	+ flags : string;
	86	+ if ( (stuff != nil) && (hd stuff)[0] == '-' )
	87	+ {
	88	+ flags = hd stuff;
	89	+ stuff = tl stuff;
	90	+ }
	91	+
	92	+ # process flags
	93	+ opts : list of (string,int);
	94	+ for(x:=1;x<len flags; x++)
	95	+ {
	96	+ case flags[x]
	97	+ {
	98	+ 'v' => opts = ("verbose",1)::opts;
	99	+ 'd' => opts = ("debug",1)::opts;
	100	+ 'w' => opts = ("warn",1)::opts;
	101	+ 'i' => showinfo(); #exits
	102	+ 'h' => showhelp(jvmcmd); #exits
	103	+ * => mesg(sys->sprint( "error: %c is an invalid option\n", flags[x] ));
	104	+ showhelp(jvmcmd);
	105	+
	106	+ }
	107	+ }
	108	+
	109	+ if ( stuff == nil )
	110	+ {
	111	+ mesg("error: missing classname");
	112	+ showhelp(jvmcmd); #exits
	113	+ }
	114	+
	115	+ return(opts,jvmcmd::stuff);
	116	+}
	117	+
	118	+
	119	+mesg(s:string)
	120	+{
	121	+ sys->fprint(stderr,"%s\n", s);
	122	+}
	123	+
	124	+showinfo()
	125	+{
	126	+ mesg(sys->sprint("Inferno PJava v%c [PJava %s]\n", JavaClassLoader->SUXV, PJAVAVER ));
	127	+ exit;
	128	+}
	129	+
	130	+showhelp(cmd:string)
	131	+{
	132	+ mesg(sys->sprint( "usage:\t%s [-vdwih] classname classargs", cmd ));
	133	+ mesg(sys->sprint( "\tv=verbose; d=debug; w=warnings; i=version; h=help" ));
	134	+ exit;
	135	+}
	136	+
	137	+badopt(opt : int)
	138	+{
	139	+}
	140	+
	141	+
	142	+

java/appl/java/low.base+140−0

@@ -0,0 +1,140 @@
	1	+#0
	2	+# SetByte
	3	+ addw 32(fp),36(fp),44(fp)
	4	+ movb 40(fp),0(44(fp))
	5	+ ret
	6	+#3
	7	+# SetInt
	8	+ addw 32(fp),36(fp),44(fp)
	9	+ movw 40(fp),0(44(fp))
	10	+ ret
	11	+#6
	12	+# SetBig
	13	+ addw 32(fp),36(fp),48(fp)
	14	+ movl 40(fp),0(48(fp))
	15	+ ret
	16	+#9
	17	+# SetReal
	18	+ addw 32(fp),36(fp),48(fp)
	19	+ movf 40(fp),0(48(fp))
	20	+ ret
	21	+#12
	22	+# SetObj
	23	+ addw 32(fp),36(fp),44(fp)
	24	+ movp 40(fp),0(44(fp))
	25	+ ret
	26	+#15
	27	+# GetByte
	28	+ addw 32(fp),36(fp),40(fp)
	29	+ movb 0(40(fp)),0(16(fp))
	30	+ ret
	31	+#18
	32	+# GetInt
	33	+ addw 32(fp),36(fp),40(fp)
	34	+ movw 0(40(fp)),0(16(fp))
	35	+ ret
	36	+#21
	37	+# GetBig
	38	+ addw 32(fp),36(fp),40(fp)
	39	+ movl 0(40(fp)),0(16(fp))
	40	+ ret
	41	+#24
	42	+# GetReal
	43	+ addw 32(fp),36(fp),40(fp)
	44	+ movf 0(40(fp)),0(16(fp))
	45	+ ret
	46	+#27
	47	+# GetObj
	48	+ addw 32(fp),36(fp),40(fp)
	49	+ movp 0(40(fp)),0(16(fp))
	50	+ ret
	51	+#30
	52	+#CallMethod: frame size==80 map==0x00b840
	53	+# params
	54	+# module ptr: 32(fp) ptr
	55	+# method idx: 36(fp)
	56	+# this ptr: 40(fp) ptr
	57	+# args: 44(fp) ptr
	58	+# ret-val: 48(fp) ptr
	59	+# local vars used:
	60	+# frame: 52(fp) not-marked
	61	+# frame-slot: 56(fp)
	62	+# loop index: 60(fp)
	63	+# tmp: 64(fp) -- used for array idexing & alignment ck
	64	+# pick-tmp: 68(fp) ptr
	65	+# array len: 72(fp)
	66	+#
	67	+ mframe 32(fp),36(fp),52(fp)
	68	+ addw 52(fp),$32,56(fp) #compute slot address for arg
	69	+ beqw 0(mp),40(fp),$35 #if static then 'this' is nil
	70	+ movp 40(fp),0(56(fp)) #move 'this' into frame
	71	+ addw $4,56(fp) #next slot
	72	+#35
	73	+ # move args into frame
	74	+ # for(idx:=0; idx <len args; idx++ )
	75	+ movw $0,60(fp) #initialize loop idx
	76	+ lena 44(fp),72(fp) #length of array
	77	+#37
	78	+ blew 72(fp),60(fp),$60 #loop condition
	79	+ indw 44(fp),64(fp),60(fp) #index the array
	80	+ movp 0(64(fp)),68(fp) #grab the array element; its a ref pick-adt
	81	+ case 0(68(fp)),4(mp) #switch off of the 'pick' id
	82	+#41
	83	+ movp 4(68(fp)),0(56(fp)) # object param
	84	+ jmp $57
	85	+#43
	86	+ movw 4(68(fp)),0(56(fp)) # word param (byte,short,char,boolean,int)
	87	+ jmp $57
	88	+#45
	89	+ andw 56(fp),$7,64(fp) # check for 8-byte alignment
	90	+ beqw 64(fp),$0,$48 # branch if already aligned
	91	+ addw $4,56(fp) # next slot is aligned
	92	+ movl 8(68(fp)),0(56(fp)) # big param (long)
	93	+ addw $8,56(fp) # next param slot
	94	+ jmp $58
	95	+#51
	96	+ andw 56(fp),$7,64(fp) # check for 8-byte alignment
	97	+ beqw 64(fp),$0,$54 # branch if already aligned
	98	+ addw $4,56(fp) # next slot is aligned
	99	+ movf 8(68(fp)),0(56(fp)) # real param (float,double)
	100	+ addw $8,56(fp) # next param slot
	101	+ jmp $58
	102	+#57
	103	+ addw $4,56(fp) # next slot
	104	+#58
	105	+ addw $1,60(fp) #inc loop index
	106	+ jmp $37 #end-for
	107	+#60
	108	+ # setup return value if one exists
	109	+ beqw 0(mp),48(fp),$65 #if nil then no functional return
	110	+ case 0(48(fp)),60(mp) #switch off pick field of ret-value
	111	+#62
	112	+ lea 4(48(fp)),16(52(fp)) #4-byte aligned return addr
	113	+ jmp $65
	114	+ lea 8(48(fp)),16(52(fp)) #8-byte aligned return addr
	115	+#65
	116	+ mcall 52(fp),36(fp),32(fp)
	117	+ ret
	118	+#
	119	+# change the following with care
	120	+#
	121	+ desc $0,92,"80"
	122	+ desc $1,48,"00a0"
	123	+ desc $2,40,"0080"
	124	+ desc $3,48,"0080"
	125	+ desc $4,80,"00b840"
	126	+ var @mp,92
	127	+ word @mp+4,4,0,1,41,1,6,43,6,7,45,7,9,51,66
	128	+ word @mp+60,2,0,6,62,6,9,64,66
	129	+ module Low
	130	+ link 3,0, 0xaaaaaaaa,"SetByte"
	131	+ link 3,3, 0xaaaaaaaa,"SetInt"
	132	+ link 3,6, 0xaaaaaaaa,"SetBig"
	133	+ link 3,9 ,0xaaaaaaaa,"SetReal"
	134	+ link 1,12,0xaaaaaaaa,"SetObj"
	135	+ link 2,15,0xaaaaaaaa,"GetByte"
	136	+ link 2,18,0xaaaaaaaa,"GetInt"
	137	+ link 2,21,0xaaaaaaaa,"GetBig"
	138	+ link 2,24,0xaaaaaaaa,"GetReal"
	139	+ link 2,27,0xaaaaaaaa,"GetObj"
	140	+ link 4,30,0xaaaaaaaa,"CallMethod"

java/appl/java/low.s+140−0

@@ -0,0 +1,140 @@
	1	+#0
	2	+# SetByte
	3	+ addw 32(fp),36(fp),44(fp)
	4	+ movb 40(fp),0(44(fp))
	5	+ ret
	6	+#3
	7	+# SetInt
	8	+ addw 32(fp),36(fp),44(fp)
	9	+ movw 40(fp),0(44(fp))
	10	+ ret
	11	+#6
	12	+# SetBig
	13	+ addw 32(fp),36(fp),48(fp)
	14	+ movl 40(fp),0(48(fp))
	15	+ ret
	16	+#9
	17	+# SetReal
	18	+ addw 32(fp),36(fp),48(fp)
	19	+ movf 40(fp),0(48(fp))
	20	+ ret
	21	+#12
	22	+# SetObj
	23	+ addw 32(fp),36(fp),44(fp)
	24	+ movp 40(fp),0(44(fp))
	25	+ ret
	26	+#15
	27	+# GetByte
	28	+ addw 32(fp),36(fp),40(fp)
	29	+ movb 0(40(fp)),0(16(fp))
	30	+ ret
	31	+#18
	32	+# GetInt
	33	+ addw 32(fp),36(fp),40(fp)
	34	+ movw 0(40(fp)),0(16(fp))
	35	+ ret
	36	+#21
	37	+# GetBig
	38	+ addw 32(fp),36(fp),40(fp)
	39	+ movl 0(40(fp)),0(16(fp))
	40	+ ret
	41	+#24
	42	+# GetReal
	43	+ addw 32(fp),36(fp),40(fp)
	44	+ movf 0(40(fp)),0(16(fp))
	45	+ ret
	46	+#27
	47	+# GetObj
	48	+ addw 32(fp),36(fp),40(fp)
	49	+ movp 0(40(fp)),0(16(fp))
	50	+ ret
	51	+#30
	52	+#CallMethod: frame size==80 map==0x00b840
	53	+# params
	54	+# module ptr: 32(fp) ptr
	55	+# method idx: 36(fp)
	56	+# this ptr: 40(fp) ptr
	57	+# args: 44(fp) ptr
	58	+# ret-val: 48(fp) ptr
	59	+# local vars used:
	60	+# frame: 52(fp) not-marked
	61	+# frame-slot: 56(fp)
	62	+# loop index: 60(fp)
	63	+# tmp: 64(fp) -- used for array idexing & alignment ck
	64	+# pick-tmp: 68(fp) ptr
	65	+# array len: 72(fp)
	66	+#
	67	+ mframe 32(fp),36(fp),52(fp)
	68	+ addw 52(fp),$32,56(fp) #compute slot address for arg
	69	+ beqw 0(mp),40(fp),$35 #if static then 'this' is nil
	70	+ movp 40(fp),0(56(fp)) #move 'this' into frame
	71	+ addw $4,56(fp) #next slot
	72	+#35
	73	+ # move args into frame
	74	+ # for(idx:=0; idx <len args; idx++ )
	75	+ movw $0,60(fp) #initialize loop idx
	76	+ lena 44(fp),72(fp) #length of array
	77	+#37
	78	+ blew 72(fp),60(fp),$60 #loop condition
	79	+ indw 44(fp),64(fp),60(fp) #index the array
	80	+ movp 0(64(fp)),68(fp) #grab the array element; its a ref pick-adt
	81	+ case 0(68(fp)),4(mp) #switch off of the 'pick' id
	82	+#41
	83	+ movp 4(68(fp)),0(56(fp)) # object param
	84	+ jmp $57
	85	+#43
	86	+ movw 4(68(fp)),0(56(fp)) # word param (byte,short,char,boolean,int)
	87	+ jmp $57
	88	+#45
	89	+ andw 56(fp),$7,64(fp) # check for 8-byte alignment
	90	+ beqw 64(fp),$0,$48 # branch if already aligned
	91	+ addw $4,56(fp) # next slot is aligned
	92	+ movl 8(68(fp)),0(56(fp)) # big param (long)
	93	+ addw $8,56(fp) # next param slot
	94	+ jmp $58
	95	+#51
	96	+ andw 56(fp),$7,64(fp) # check for 8-byte alignment
	97	+ beqw 64(fp),$0,$54 # branch if already aligned
	98	+ addw $4,56(fp) # next slot is aligned
	99	+ movf 8(68(fp)),0(56(fp)) # real param (float,double)
	100	+ addw $8,56(fp) # next param slot
	101	+ jmp $58
	102	+#57
	103	+ addw $4,56(fp) # next slot
	104	+#58
	105	+ addw $1,60(fp) #inc loop index
	106	+ jmp $37 #end-for
	107	+#60
	108	+ # setup return value if one exists
	109	+ beqw 0(mp),48(fp),$65 #if nil then no functional return
	110	+ case 0(48(fp)),60(mp) #switch off pick field of ret-value
	111	+#62
	112	+ lea 4(48(fp)),16(52(fp)) #4-byte aligned return addr
	113	+ jmp $65
	114	+ lea 8(48(fp)),16(52(fp)) #8-byte aligned return addr
	115	+#65
	116	+ mcall 52(fp),36(fp),32(fp)
	117	+ ret
	118	+#
	119	+# change the following with care
	120	+#
	121	+ desc $0,92,"80"
	122	+ desc $1,48,"00a0"
	123	+ desc $2,40,"0080"
	124	+ desc $3,48,"0080"
	125	+ desc $4,80,"00b840"
	126	+ var @mp,92
	127	+ word @mp+4,4,0,1,41,1,6,43,6,7,45,7,9,51,66
	128	+ word @mp+60,2,0,6,62,6,9,64,66
	129	+ module Low
	130	+ link 3,0, 0x349a7796,"SetByte"
	131	+ link 3,3, 0x2de68727,"SetInt"
	132	+ link 3,6, 0xd7e9f417,"SetBig"
	133	+ link 3,9 ,0xa51f3c84,"SetReal"
	134	+ link 1,12,0x2ada273,"SetObj"
	135	+ link 2,15,0x65a049aa,"GetByte"
	136	+ link 2,18,0x7060ebba,"GetInt"
	137	+ link 2,21,0x9f04ed0,"GetBig"
	138	+ link 2,24,0x553990fb,"GetReal"
	139	+ link 2,27,0x30af57fd,"GetObj"
	140	+ link 4,30,0x2943aeae,"CallMethod"

java/appl/java/lowproto.b+65−0

@@ -0,0 +1,65 @@
	1	+# proto file will be replaced with low.s
	2	+implement Low;
	3	+
	4	+include "jni.m";
	5	+
	6	+SetByte( ptr : ref Loader->Niladt, off : int, val : byte )
	7	+{
	8	+ junk := (ptr,off,val);
	9	+}
	10	+
	11	+SetInt( ptr : ref Loader->Niladt, off : int, val : int )
	12	+{
	13	+ junk := (ptr,off,val);
	14	+}
	15	+
	16	+SetBig( ptr : ref Loader->Niladt, off : int, val : big )
	17	+{
	18	+ junk := (ptr,off,val);
	19	+}
	20	+
	21	+SetReal( ptr : ref Loader->Niladt, off : int, val : real )
	22	+{
	23	+ junk := (ptr,off,val);
	24	+}
	25	+
	26	+SetObj( ptr : ref Loader->Niladt, off : int, val : JNI->JObject )
	27	+{
	28	+ junk := (ptr,off,val);
	29	+}
	30	+
	31	+GetByte( ptr : ref Loader->Niladt, off : int ) : byte
	32	+{
	33	+ junk := (ptr,off);
	34	+ return( byte 0 );
	35	+}
	36	+
	37	+GetInt( ptr : ref Loader->Niladt, off : int ) : int
	38	+{
	39	+ junk := (ptr,off);
	40	+ return( 0 );
	41	+}
	42	+
	43	+GetBig( ptr : ref Loader->Niladt, off : int ) : big
	44	+{
	45	+ junk := (ptr,off);
	46	+ return( big 0 );
	47	+}
	48	+
	49	+GetReal( ptr : ref Loader->Niladt, off : int ) : real
	50	+{
	51	+ junk := (ptr,off);
	52	+ return( 0.0 );
	53	+}
	54	+
	55	+GetObj( ptr : ref Loader->Niladt, off : int ) : JNI->JObject
	56	+{
	57	+ junk := (ptr,off);
	58	+ return( nil );
	59	+}
	60	+
	61	+CallMethod( mod : Nilmod, idx : int, this : JNI->JObject, args : array of ref JNI->Value, retval : ref JNI->Value )
	62	+{
	63	+ junk := (mod,idx,this,args,retval);
	64	+}
	65	+

java/appl/java/mkfile+45−0

@@ -0,0 +1,45 @@
	1	+<../../../mkconfig
	2	+
	3	+TARG=\
	4	+ cast.dis\
	5	+ low.dis\
	6	+ jni.dis\
	7	+ classloader.dis\
	8	+ javaassist.dis\
	9	+ javatrace.dis\
	10	+ javanative.dis\
	11	+ jvm.dis\
	12	+ jinfo.dis\
	13	+
	14	+MODULES=\
	15	+ $ROOT/java/module/classloader.m\
	16	+ $ROOT/java/module/jni.m\
	17	+ $ROOT/java/module/cast.m\
	18	+
	19	+SYSMODULES=\
	20	+ draw.m\
	21	+ hash.m\
	22	+ keyring.m\
	23	+ loader.m\
	24	+ math.m\
	25	+ string.m\
	26	+ sys.m\
	27	+
	28	+DISBIN=$ROOT/java/dis/java
	29	+
	30	+<$ROOT/mkfiles/mkdis
	31	+
	32	+LIMBOFLAGS=-I$MODDIR\
	33	+ -I$ROOT/java/module\
	34	+
	35	+%.dis: sign.sh
	36	+
	37	+%.dis: %.base
	38	+ chmod +x sign.sh
	39	+ sh sign.sh ${stem}proto $stem
	40	+
	41	+classloader.dis: classloader.b
	42	+ limbo -z $LIMBOFLAGS -gw classloader.b
	43	+
	44	+clean-std:V:
	45	+ rm -f .dis .sbl *.s sign.sed

java/appl/java/sign.sed+38−0

@@ -0,0 +1,38 @@
	1	+/^ link."ArraytoJS"$/s/0x[^,]/0xfb08d2ba/
	2	+/^ link."JStoObject"$/s/0x[^,]/0x76cd0754/
	3	+/^ link."ObjecttoJT"$/s/0x[^,]/0xae823704/
	4	+/^ link."arrayof"$/s/0x[^,]/0x6d675ef6/
	5	+/^ link."bigarraytoJS"$/s/0x[^,]/0x1ebcdfdd/
	6	+/^ link."bytearraytoJS"$/s/0x[^,]/0x79238ebb/
	7	+/^ link."getabsint"$/s/0x[^,]/0xe67bf126/
	8	+/^ link."getadtstring"$/s/0x[^,]/0x3911b054/
	9	+/^ link."getbytearray"$/s/0x[^,]/0x480b7ac3/
	10	+/^ link."getclassadt"$/s/0x[^,]/0x45af8037/
	11	+/^ link."getint"$/s/0x[^,]/0x9af56bb1/
	12	+/^ link."getintarray"$/s/0x[^,]/0x55e7e9b3/
	13	+/^ link."getmd"$/s/0x[^,]/0x21126c42/
	14	+/^ link."getobjclass"$/s/0x[^,]/0x7e47f344/
	15	+/^ link."getptr"$/s/0x[^,]/0xd7e85087/
	16	+/^ link."getreloc"$/s/0x[^,]/0xbb4256c7/
	17	+/^ link."getrtreloc"$/s/0x[^,]/0xa1fa7e52/
	18	+/^ link."getstrarray"$/s/0x[^,]/0x67808576/
	19	+/^ link."getstring"$/s/0x[^,]/0xe6647e4a/
	20	+/^ link."intarraytoJS"$/s/0x[^,]/0x9dfa2ee1/
	21	+/^ link."jclnilmod"$/s/0x[^,]/0x18138a11/
	22	+/^ link."little_endian"$/s/0x[^,]/0x616977e8/
	23	+/^ link."makeadt"$/s/0x[^,]/0x2d805d/
	24	+/^ link."mcall0"$/s/0x[^,]/0x9af56bb1/
	25	+/^ link."mcall1"$/s/0x[^,]/0xcbd2cc54/
	26	+/^ link."mcalla"$/s/0x[^,]/0x2c8f47/
	27	+/^ link."mcallm"$/s/0x[^,]/0x1fe62f91/
	28	+/^ link."modhash"$/s/0x[^,]/0x4e5d43e7/
	29	+/^ link."new"$/s/0x[^,]/0xbb2da06c/
	30	+/^ link."objhash"$/s/0x[^,]/0x646cd7d0/
	31	+/^ link."putclass"$/s/0x[^,]/0x8f05c931/
	32	+/^ link."putint"$/s/0x[^,]/0x2de68727/
	33	+/^ link."putmod"$/s/0x[^,]/0x66b5c780/
	34	+/^ link."putobj"$/s/0x[^,]/0x4f9a2948/
	35	+/^ link."putptr"$/s/0x[^,]/0x43ec4524/
	36	+/^ link."putstring"$/s/0x[^,]/0x46bbe09a/
	37	+/^ link."realarraytoJS"$/s/0x[^,]/0xc8107991/
	38	+/^ link."sysnilmod"$/s/0x[^,]/0x8cdb1059/

java/appl/java/sign.sh+6−0

@@ -0,0 +1,6 @@
	1	+set -e
	2	+limbo -I../../module -GS $1.b
	3	+sed -n '/^ link/s;.,$0x[^,]$,"$.$"$;/^ link."\2"$/s/0x[^,]*/\1/;p' $1.s > sign.sed
	4	+sed -f sign.sed $2.base \| tr -d '\15' > $2.s
	5	+asm $2.s
	6	+rm $1.s

@@ -0,0 +1,38 @@
	1	+/^ link."ArraytoJS"$/s/0x[^,]/0xfb08d2ba/
	2	+/^ link."JStoObject"$/s/0x[^,]/0x76cd0754/
	3	+/^ link."ObjecttoJT"$/s/0x[^,]/0xae823704/
	4	+/^ link."arrayof"$/s/0x[^,]/0x6d675ef6/
	5	+/^ link."bigarraytoJS"$/s/0x[^,]/0x1ebcdfdd/
	6	+/^ link."bytearraytoJS"$/s/0x[^,]/0x79238ebb/
	7	+/^ link."getabsint"$/s/0x[^,]/0xe67bf126/
	8	+/^ link."getadtstring"$/s/0x[^,]/0x3911b054/
	9	+/^ link."getbytearray"$/s/0x[^,]/0x480b7ac3/
	10	+/^ link."getclassadt"$/s/0x[^,]/0x45af8037/
	11	+/^ link."getint"$/s/0x[^,]/0x9af56bb1/
	12	+/^ link."getintarray"$/s/0x[^,]/0x55e7e9b3/
	13	+/^ link."getmd"$/s/0x[^,]/0x21126c42/
	14	+/^ link."getobjclass"$/s/0x[^,]/0x7e47f344/
	15	+/^ link."getptr"$/s/0x[^,]/0xd7e85087/
	16	+/^ link."getreloc"$/s/0x[^,]/0xbb4256c7/
	17	+/^ link."getrtreloc"$/s/0x[^,]/0xa1fa7e52/
	18	+/^ link."getstrarray"$/s/0x[^,]/0x67808576/
	19	+/^ link."getstring"$/s/0x[^,]/0xe6647e4a/
	20	+/^ link."intarraytoJS"$/s/0x[^,]/0x9dfa2ee1/
	21	+/^ link."jclnilmod"$/s/0x[^,]/0x18138a11/
	22	+/^ link."little_endian"$/s/0x[^,]/0x616977e8/
	23	+/^ link."makeadt"$/s/0x[^,]/0x2d805d/
	24	+/^ link."mcall0"$/s/0x[^,]/0x9af56bb1/
	25	+/^ link."mcall1"$/s/0x[^,]/0xcbd2cc54/
	26	+/^ link."mcalla"$/s/0x[^,]/0x2c8f47/
	27	+/^ link."mcallm"$/s/0x[^,]/0x1fe62f91/
	28	+/^ link."modhash"$/s/0x[^,]/0x4e5d43e7/
	29	+/^ link."new"$/s/0x[^,]/0xbb2da06c/
	30	+/^ link."objhash"$/s/0x[^,]/0x646cd7d0/
	31	+/^ link."putclass"$/s/0x[^,]/0x8f05c931/
	32	+/^ link."putint"$/s/0x[^,]/0x2de68727/
	33	+/^ link."putmod"$/s/0x[^,]/0x66b5c780/
	34	+/^ link."putobj"$/s/0x[^,]/0x4f9a2948/
	35	+/^ link."putptr"$/s/0x[^,]/0x43ec4524/
	36	+/^ link."putstring"$/s/0x[^,]/0x46bbe09a/
	37	+/^ link."realarraytoJS"$/s/0x[^,]/0xc8107991/
	38	+/^ link."sysnilmod"$/s/0x[^,]/0x8cdb1059/