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/