Added .align 2. Prevents end of bss to be odd.

Especially important for malloc, it distinguishes between
odd and even word pointers.

mach/6500/Action

@@ -0,0 +1,21 @@
+name "MSC6500 assembler"
+dir as
+end
+name "MSC6500 backend"
+dir cg
+end
+name "MSC6500 download program(s)"
+dir dl
+end
+name "MSC6500 C libraries"
+dir libcc
+end
+name "MSC6500 EM library"
+dir libem
+end
+name "MSC6500 Pascal library"
+dir libpc
+end
+name "MSC6500 Basic library"
+dir libbc
+end

mach/6500/cg/Makefile

@@ -0,0 +1,185 @@
+# $Header$
+
+PREFLAGS=-I../../../h -I. -DNDEBUG
+PFLAGS=
+CFLAGS=$(PREFLAGS) $(PFLAGS) -O
+LDFLAGS=-i $(PFLAGS)
+LINTOPTS=-hbxac
+LIBS=../../../lib/em_data.a
+CDIR=../../proto/cg
+CFILES=$(CDIR)/codegen.c $(CDIR)/compute.c $(CDIR)/equiv.c $(CDIR)/fillem.c \
+       $(CDIR)/gencode.c $(CDIR)/glosym.c $(CDIR)/main.c $(CDIR)/move.c \
+       $(CDIR)/nextem.c $(CDIR)/reg.c $(CDIR)/regvar.c $(CDIR)/salloc.c \
+       $(CDIR)/state.c $(CDIR)/subr.c $(CDIR)/var.c
+OFILES=codegen.o compute.o equiv.o fillem.o gencode.o glosym.o main.o\
+       move.o nextem.o reg.o regvar.o salloc.o state.o subr.o var.o
+
+all:
+	make tables.c
+	make cg
+
+cg: tables.o $(OFILES)
+	cc $(LDFLAGS) $(OFILES) tables.o $(LIBS) -o cg
+
+tables.o: tables.c
+	cc -c $(PREFLAGS) -I$(CDIR) tables.c
+
+codegen.o: $(CDIR)/codegen.c
+	cc -c $(CFLAGS) $(CDIR)/codegen.c
+compute.o: $(CDIR)/compute.c
+	cc -c $(CFLAGS) $(CDIR)/compute.c
+equiv.o: $(CDIR)/equiv.c
+	cc -c $(CFLAGS) $(CDIR)/equiv.c
+fillem.o: $(CDIR)/fillem.c
+	cc -c $(CFLAGS) $(CDIR)/fillem.c
+gencode.o: $(CDIR)/gencode.c
+	cc -c $(CFLAGS) $(CDIR)/gencode.c
+glosym.o: $(CDIR)/glosym.c
+	cc -c $(CFLAGS) $(CDIR)/glosym.c
+main.o: $(CDIR)/main.c
+	cc -c $(CFLAGS) $(CDIR)/main.c
+move.o: $(CDIR)/move.c
+	cc -c $(CFLAGS) $(CDIR)/move.c
+nextem.o: $(CDIR)/nextem.c
+	cc -c $(CFLAGS) $(CDIR)/nextem.c
+reg.o: $(CDIR)/reg.c
+	cc -c $(CFLAGS) $(CDIR)/reg.c
+regvar.o: $(CDIR)/regvar.c
+	cc -c $(CFLAGS) $(CDIR)/regvar.c
+salloc.o: $(CDIR)/salloc.c
+	cc -c $(CFLAGS) $(CDIR)/salloc.c
+state.o: $(CDIR)/state.c
+	cc -c $(CFLAGS) $(CDIR)/state.c
+subr.o: $(CDIR)/subr.c
+	cc -c $(CFLAGS) $(CDIR)/subr.c
+var.o: $(CDIR)/var.c
+	cc -c $(CFLAGS) $(CDIR)/var.c
+
+install: all
+	../../install cg
+
+cmp:	 all
+	-../../compare cg
+
+distr:
+	make tables.c
+	rm -f tables1.[ch]
+	cp tables.c tables1.c
+	cp tables.h tables1.h
+	chmod -w tables1.[ch]
+
+
+tables.c: table
+	-mv tables.h tables.h.save
+	/lib/cpp -P table | ../../../lib/cgg > debug.out
+	-if cmp -s tables.h.save tables.h; then mv tables.h.save tables.h; else exit 0; fi
+	-if cmp -s /dev/null tables.h; then mv tables.h.save tables.h; else exit 0; fi
+
+lint: $(CFILES)
+	lint $(LINTOPTS) $(PREFLAGS) $(CFILES)
+clean:
+	rm -f *.o tables.c tables.h debug.out cg tables.h.save
+
+codegen.o:	$(CDIR)/assert.h
+codegen.o:	$(CDIR)/data.h
+codegen.o:	$(CDIR)/equiv.h
+codegen.o:	$(CDIR)/extern.h
+codegen.o:	$(CDIR)/param.h
+codegen.o:	$(CDIR)/result.h
+codegen.o:	$(CDIR)/state.h
+codegen.o:	tables.h
+codegen.o:	$(CDIR)/types.h
+compute.o:	$(CDIR)/assert.h
+compute.o:	$(CDIR)/data.h
+compute.o:	$(CDIR)/extern.h
+compute.o:	$(CDIR)/glosym.h
+compute.o:	$(CDIR)/param.h
+compute.o:	$(CDIR)/result.h
+compute.o:	tables.h
+compute.o:	$(CDIR)/types.h
+equiv.o:	$(CDIR)/assert.h
+equiv.o:	$(CDIR)/data.h
+equiv.o:	$(CDIR)/equiv.h
+equiv.o:	$(CDIR)/extern.h
+equiv.o:	$(CDIR)/param.h
+equiv.o:	$(CDIR)/result.h
+equiv.o:	tables.h
+equiv.o:	$(CDIR)/types.h
+fillem.o:	$(CDIR)/assert.h
+fillem.o:	$(CDIR)/data.h
+fillem.o:	$(CDIR)/extern.h
+fillem.o:	mach.c
+fillem.o:	mach.h
+fillem.o:	$(CDIR)/param.h
+fillem.o:	$(CDIR)/regvar.h
+fillem.o:	$(CDIR)/result.h
+fillem.o:	tables.h
+fillem.o:	$(CDIR)/types.h
+gencode.o:	$(CDIR)/assert.h
+gencode.o:	$(CDIR)/data.h
+gencode.o:	$(CDIR)/extern.h
+gencode.o:	$(CDIR)/param.h
+gencode.o:	$(CDIR)/result.h
+gencode.o:	tables.h
+gencode.o:	$(CDIR)/types.h
+glosym.o:	$(CDIR)/glosym.h
+glosym.o:	$(CDIR)/param.h
+glosym.o:	tables.h
+glosym.o:	$(CDIR)/types.h
+main.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/assert.h
+move.o:		$(CDIR)/data.h
+move.o:		$(CDIR)/extern.h
+move.o:		$(CDIR)/param.h
+move.o:		$(CDIR)/result.h
+move.o:		tables.h
+move.o:		$(CDIR)/types.h
+nextem.o:	$(CDIR)/assert.h
+nextem.o:	$(CDIR)/data.h
+nextem.o:	$(CDIR)/extern.h
+nextem.o:	$(CDIR)/param.h
+nextem.o:	$(CDIR)/result.h
+nextem.o:	tables.h
+nextem.o:	$(CDIR)/types.h
+reg.o:		$(CDIR)/assert.h
+reg.o:		$(CDIR)/data.h
+reg.o:		$(CDIR)/extern.h
+reg.o:		$(CDIR)/param.h
+reg.o:		$(CDIR)/result.h
+reg.o:		tables.h
+reg.o:		$(CDIR)/types.h
+regvar.o:	$(CDIR)/assert.h
+regvar.o:	$(CDIR)/data.h
+regvar.o:	$(CDIR)/extern.h
+regvar.o:	$(CDIR)/param.h
+regvar.o:	$(CDIR)/regvar.h
+regvar.o:	$(CDIR)/result.h
+regvar.o:	tables.h
+regvar.o:	$(CDIR)/types.h
+salloc.o:	$(CDIR)/assert.h
+salloc.o:	$(CDIR)/data.h
+salloc.o:	$(CDIR)/extern.h
+salloc.o:	$(CDIR)/param.h
+salloc.o:	$(CDIR)/result.h
+salloc.o:	tables.h
+salloc.o:	$(CDIR)/types.h
+state.o:	$(CDIR)/assert.h
+state.o:	$(CDIR)/data.h
+state.o:	$(CDIR)/extern.h
+state.o:	$(CDIR)/param.h
+state.o:	$(CDIR)/result.h
+state.o:	$(CDIR)/state.h
+state.o:	tables.h
+state.o:	$(CDIR)/types.h
+subr.o:		$(CDIR)/assert.h
+subr.o:		$(CDIR)/data.h
+subr.o:		$(CDIR)/extern.h
+subr.o:		$(CDIR)/param.h
+subr.o:		$(CDIR)/result.h
+subr.o:		tables.h
+subr.o:		$(CDIR)/types.h
+var.o:		$(CDIR)/data.h
+var.o:		$(CDIR)/param.h
+var.o:		$(CDIR)/result.h
+var.o:		tables.h
+var.o:		$(CDIR)/types.h

mach/6500/cg/mach.c

@@ -0,0 +1,83 @@
+con_part(sz,w) register sz; word w; {
+
+	while (part_size % sz)
+		part_size++;
+	if (part_size == TEM_WSIZE)
+		part_flush();
+	if (sz == 1) {
+		w &= 0xFF;
+		if (part_size)
+			w <<= 8;
+		part_word |= w;
+	} else {
+		assert(sz == 2);
+		part_word = w;
+	}
+	part_size += sz;
+}
+
+con_mult(sz) word sz; {
+	long l;
+
+	if (sz != 4)
+		fatal("bad icon/ucon size");
+	l = atol(str);
+	fprintf(codefile,".short\t%d\n",(int) l);
+	fprintf(codefile,".short\t%d\n",(int) (l >> 16));
+}
+
+
+con_float() {
+
+static int been_here;
+	if (argval != 4 && argval != 8)
+		fatal("bad fcon size");
+	fprintf(codefile,".long\t");
+	if (argval == 8)
+		fprintf(codefile,"F_DUM,");
+	fprintf(codefile,"F_DUM\n");
+	if ( !been_here++)
+	{
+	fprintf(stderr,"Warning : dummy float-constant(s)\n");
+	}
+}
+
+prolog(nlocals) full nlocals; {
+
+	fprintf(codefile,"\tjsr Pro\n");
+	if (nlocals == 0)
+		return;
+	else
+		fprintf(codefile,
+	"\tldx #[%d].h\n\tlda #[%d].l\n\tjsr Lcs\n",
+					nlocals, nlocals);
+}
+
+mes(type) word type; {
+	int argt ;
+
+	switch ( (int)type ) {
+	case ms_ext :
+		for (;;) {
+			switch ( argt=getarg(
+			    ptyp(sp_cend)|ptyp(sp_pnam)|sym_ptyp) ) {
+			case sp_cend :
+				return ;
+			default:
+				strarg(argt) ;
+				fprintf(codefile,".define %s\n",argstr) ;
+				break ;
+			}
+		}
+	default :
+		while ( getarg(any_ptyp) != sp_cend ) ;
+		break ;
+	}
+}
+
+char    *segname[] = {
+	".text",        /* SEGTXT */
+	".data",        /* SEGCON */
+	".data",        /* SEGROM */
+	".bss"          /* SEGBSS */
+};

mach/6500/cg/mach.h

@@ -0,0 +1,26 @@
+/* $Header$ */
+
+#define ex_ap(y)        fprintf(codefile,".extern %s\n",y)
+#define in_ap(y)        /* nothing */
+
+#define newilb(x)       fprintf(codefile,"%s:\n",x)
+#define newdlb(x)       fprintf(codefile,"%s:\n",x)
+#define dlbdlb(x,y)     fprintf(codefile,"%s = %s\n",x,y)
+#define newlbss(l,x)    fprintf(codefile,"%s: .space\t%d\n",l,x);
+
+#define cst_fmt         "%d"
+#define off_fmt         "%d"
+#define ilb_fmt         "I%03x%x"
+#define dlb_fmt         "_%d"
+#define hol_fmt         "hol%d"
+
+#define hol_off         "%d+hol%d"
+
+#define con_cst(x)      fprintf(codefile,".word\t%d\n",x)
+#define con_ilb(x)      fprintf(codefile,".word\t%s\n",x)
+#define con_dlb(x)      fprintf(codefile,".word\t%s\n",x)
+
+#define modhead         ""
+
+#define id_first        '_'
+#define BSS_INIT        0

mach/6500/dl/Makefile

@@ -0,0 +1,19 @@
+CFLAGS=-O
+
+dl:             dl.o
+		cc -o dl -n dl.o
+
+install:	dl
+		../../install dl
+
+cmp:		dl
+		-../../compare dl
+
+opr:
+		make pr | opr
+
+pr:
+		@pr `pwd`/dl.c
+
+clean:
+		-rm -f *.o *.old dl

mach/6500/dl/dl.c

@@ -0,0 +1,164 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include	<sgtty.h>
+#include	<stdio.h>
+#include	<assert.h>
+
+struct sgttyb	tty;
+
+#define	DATTYPE		0
+#define	EOFTYPE		1
+#define	SEGTYPE		2
+#define	PCTYPE		3
+
+#define	MAXBYTE		0x18
+
+int	check;
+int	records;
+int	echo;
+int	bytecount;
+int	ttyfd;
+
+char	*progname;
+
+char	hex[] = "0123456789ABCDEF";
+
+main(argc,argv) char **argv; {
+	register nd,pc,sg,osg,first;
+	register char *s;
+
+	progname = argv[0];
+	if (argc > 3)
+		fatal("usage: %s [object [tty]]\n",argv[0]);
+	s = "a.out";
+	if (argc >= 2)
+		s = argv[1];
+	if (freopen(s,"r",stdin) == NULL)
+		fatal("can't open %s",s);
+	ttyfd = 1;
+	first = 1; osg = 0;
+	for (;;) {
+		pc = get2c(stdin);
+		if (feof(stdin))
+			break;
+		sg = get2c(stdin);
+		nd = get2c(stdin);
+		if (first) {
+			first = 0;
+		}
+		assert(sg == osg);
+		while (nd > MAXBYTE) {
+			data(MAXBYTE,pc);
+			nd -= MAXBYTE;
+			pc += MAXBYTE;
+		}
+		if (nd > 0)
+			data(nd,pc);
+		assert(feof(stdin) == 0);
+	}
+	if (first == 0)
+		eof();
+	if (echo)
+		for (;;)
+			reply();
+}
+
+data(nd,pc) {
+
+	newline(nd,pc,DATTYPE);
+	do
+		byte(getc(stdin));
+	while (--nd);
+	endline();
+}
+
+eof() {
+
+	newline(0,records,EOFTYPE);
+	endline();
+}
+
+newline(n,pc,typ) {
+
+	records++;
+	put(';');
+	byte(n);
+	check = 0;
+	bytecount = n+4;
+	word(pc);
+}
+
+endline() {
+
+	word(check);
+	put('\r');
+	put('\n');
+	assert(bytecount == 0);
+put(0);
+put(0);
+put(0);
+put(0);
+put(0);
+put(0);
+}
+
+word(w) {
+
+	byte(w>>8);
+	byte(w);
+}
+
+byte(b) {
+
+b &= 0377;
+	check += b;
+	--bytecount;
+	put(hex[(b>>4) & 017]);
+	put(hex[b & 017]);
+}
+
+put(c) {
+
+	write(ttyfd,&c,1);
+}
+
+reply() {
+	register i;
+	int c;
+
+	if (echo == 0)
+		return;
+	i = read(ttyfd,&c,1);
+	assert(i > 0);
+	write(1,&c,1);
+}
+
+get2c(f) FILE *f; {
+	register c;
+
+	c = getc(f);
+	return((getc(f) << 8) | c);
+}
+
+fatal(s,a) {
+
+	fprintf(stderr,"%s: ",progname);
+	fprintf(stderr,s,a);
+	fprintf(stderr,"\n");
+	exit(-1);
+}

mach/6500/libbc/Makefile

@@ -0,0 +1,20 @@
+MAKEFILE=../../proto/libg/Makefile
+MACHDEF="MACH=6500" "SUF=s"
+BCDEF="PREF=bc" "SUB=" "SRC=lang/basic/lib"
+
+install:
+	make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tailcp
+
+cmp:
+	make -f $(MAKEFILE) $(BCDEF) $(MACHDEF) tail
+	-../../compare head_bc
+	-../../compare tail_bc
+
+clean:
+		-rm -f *.old *.[ce$(SUF)] tail* head*
+
+opr:
+	make pr | opr
+
+pr:
+	@pr Makefile

mach/6500/libbc/compmodule

@@ -0,0 +1,2 @@
+${MACH?} -I../../../h ${MACHFL?} $1 1>&2
+echo `basename $1 $2`.s

mach/6500/libcc/Makefile

@@ -0,0 +1,37 @@
+MAKEFILE=../../proto/libg/Makefile
+MACHDEF="MACH=6500" "SUF=s"
+STDIO="PREF=cc" "SUB=.1s" "SRC=lang/cem/libcc/stdio"
+GEN="PREF=cc" "SUB=.2g" "SRC=lang/cem/libcc/gen"
+MON="PREF=mon" "SRC=lang/cem/libcc/mon"
+
+install:	cpstdio cpgen cpmon
+
+cpstdio:
+		make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tailcp
+cpgen:
+		make -f $(MAKEFILE) $(GEN) $(MACHDEF) cp
+cpmon:
+		make -f $(MAKEFILE) $(MON) $(MACHDEF) tailcp
+
+cmp:		cmpstdio cmpgen cmpmon
+
+cmpstdio:
+		make -f $(MAKEFILE) $(STDIO) $(MACHDEF) tail
+		-../../compare tail_cc.1s
+cmpgen:
+		make -f $(MAKEFILE) $(GEN) $(MACHDEF) head
+		-../../compare head_cc
+		make -f $(MAKEFILE) $(GEN) $(MACHDEF) tail
+		-../../compare tail_cc.2g
+cmpmon:
+		make -f $(MAKEFILE) $(MON) $(MACHDEF) tail
+		-../../compare tail_mon
+
+clean:
+		-rm -f *.old *.[ce$(SUF)] tail* head*
+
+opr:
+		make pr | opr
+
+pr:
+		@pr Makefile

mach/6500/libcc/compmodule

@@ -0,0 +1,2 @@
+${MACH?} -I../../../h ${MACHFL?} $1 1>&2
+echo `basename $1 $2`.s

mach/6500/libem/LIST

@@ -0,0 +1,94 @@
+tail_em.s.a
+adi.s
+adi4.s
+and.s
+asp.s
+cii.s
+cmi.s
+cmi4.s
+cms.s
+cmu.s
+cmu4.s
+com.s
+csa.s
+csb.s
+dup.s
+dvi.s
+dvi4.s
+dvu.s
+dvu4.s
+exg.s
+exg2.s
+gto.s
+indir.s
+inn.s
+ior.s
+lar.s
+lcs.s
+loi.s
+loi1.s
+loil.s
+lol.s
+los.s
+lxa1.s
+lxa2.s
+lxl.s
+mli4.s
+mlu.s
+mlu4.s
+mon.s
+mul4.s
+ngi4.s
+printstack.s
+printhex.s
+pro.s
+read.s
+ret.s
+rmi.s
+rmi4.s
+div4.s
+rmu.s
+rmu4.s
+duv4.s
+rol.s
+rol4.s
+ror.s
+ror4.s
+rtt.s
+sar.s
+mli.s
+ngi.s
+sbi4.s
+addsub.s
+sdl.s
+set.s
+sli.s
+sli4.s
+sri.s
+sri4.s
+sti.s
+sti1.s
+stil.s
+blm.s
+stl.s
+sts.s
+teq.s
+test2.s
+testFFh.s
+tge.s
+tgt.s
+tle.s
+tlt.s
+tne.s
+dum_float.s
+trap.s
+ldi.s
+print.s
+write.s
+xor.s
+zer.s
+zri.s
+locaddr.s
+data.s
+aar.s
+sbi.s

mach/6500/libem/Makefile

@@ -0,0 +1,23 @@
+install:	tail_em.s.a tail_em.ve.s.a
+		../../install head_em.s head_em
+		../../install tail_em.s.a tail_em
+		../../install tail_em.ve.s.a tail_em.vend
+
+cmp:		tail_em.s.a tail_em.ve.s.a
+		-../../compare head_em.s head_em
+		-../../compare tail_em.s.a tail_em
+		-../../compare tail_em.ve.s.a tail_em.vend
+
+distr:		tail_em.ve.s.a
+
+tail_em.s.a:
+		arch cr `cat LIST`
+
+tail_em.ve.s.a:
+		arch cr tail_em.ve.s.a end.s
+
+opr:
+		make pr | opr
+pr:
+		@pr `pwd`/Makefile `pwd`/head_em.s
+		@pr -l33 `tail +1 LIST|sort` `pwd`/end.s

mach/6500/libem/aar.s

@@ -0,0 +1,31 @@
+.define Aar
+
+! This subroutine gets the address of the array element
+
+
+Aar:
+	stx ADDR	! address of descriptor (lowbyte)
+	sta ADDR+1	! address of descriptor (highbyte)
+	ldy #0
+	lda (ADDR),y	! lowerbound (lowbyte)
+	tax
+	iny
+	lda (ADDR),y	! lowerbound (highbyte)
+	jsr Sbi2	! index - lowerbound
+	jsr Push
+    2:	ldy #4
+	lda (ADDR),y	! objectsize (lowbyte)
+	sta NBYTES
+	tax
+	iny
+	lda (ADDR),y	! objectsize (highbyte)
+	sta NBYTES+1
+	bne 5f
+	cpx #1		! objectsize = 1 then return 
+	bne 5f		! arrayaddress + index
+	jsr Pop
+	jmp Adi2
+    5:	jsr Mli2	! objectsize > 1 then return 
+	jmp Adi2	! arrayaddress + index * objectsize
+
+

mach/6500/libem/addsub.s

@@ -0,0 +1,27 @@
+.define Addsub
+
+! This subroutine is used by the fourbyte addition and subtraction
+! routines.
+! It puts the address of the second operand into
+! the zeropage locations ADDR and ADDR+1
+! The address of the first operand is put into
+! zeropage locations ADDR+2 and ADDR+3.
+
+
+Addsub:
+	clc
+	lda SP+2
+	sta ADDR	! address of second operand (lowbyte)
+	adc #4
+	sta SP+2
+	sta ADDR+2	! address of first operand (lowbyte)
+	lda SP+1
+	sta ADDR+1	! address of second operand (highbyte)
+	adc #0
+	sta ADDR+3	! address of first operand (highbyte)
+	sta SP+1
+	ldy #0
+	ldx #0FCh	! do it 4 times
+	rts
+
+

mach/6500/libem/adi.s

@@ -0,0 +1,22 @@
+.define  Adi2
+
+! This subroutine adds two twobyte integers.
+! The first operand is on the top of the stack, the second operand
+! is in the AX registerpair.
+! The result is returned in registerpair AX.
+
+
+Adi2:
+	sta ARTH+1	! second operand (highbyte)
+	stx ARTH	! second operand (lowbyte)
+	jsr Pop		! get first operand
+	pha		! save A
+	clc
+	txa
+	adc ARTH	! add lowbytes
+	tax
+	pla		! get A
+	adc ARTH+1	! add the highbytes
+	rts
+
+

mach/6500/libem/adi4.s

@@ -0,0 +1,20 @@
+.define Adi4
+
+! This subroutine adds two fourbyte integers, which are on the stack.
+! The addresses are initiated by the subroutine Addsub.
+! Also the loopvariable (register X) is initiated by that routine.
+! The result is pushed back onto the stack
+
+
+Adi4:
+	jsr Addsub		! initiate addresses
+	clc
+    1:	lda (ADDR+2),y		! get byte first operand
+	adc (ADDR),y		! add to byte second operand
+	sta (ADDR+2),y		! push on real stack
+	iny
+	inx
+	bne 1b			! do it 4 times
+	rts
+
+

mach/6500/libem/and.s

@@ -0,0 +1,34 @@
+.define And
+
+! This subroutine performs the logical and on two groups of
+! atmost 254 bytes. The number of bytes is in register Y.
+! The two groups are on the stack.
+! First the value of the stackpointer is saved in zeropage
+! locations ADDR, ADDR+1. Then an offset of Y is added
+! and stored in ADDR+2, ADDR+3.
+! The result is pushed back on the stack.
+
+
+And:
+	lda SP+1
+	sta ADDR+1	! address of first group (lowbyte)
+	lda SP+2
+	sta ADDR	! address of first group (highbyte)
+	clc
+	tya
+	adc SP+2
+	sta SP+2	! new stackpointer (lowbyte)
+	sta ADDR+2	! stackpointer + Y (lowbyte)
+	lda #0
+	adc SP+1
+	sta SP+1	! new stackpointer (highbyte)
+	sta ADDR+3	! stackpointer + Y (highbyte)
+    1:  dey
+	lda (ADDR),y	! get byte first group
+	and (ADDR+2),y	! perform logical and with second group
+	sta (ADDR+2),y	! push result on real_stack
+	tya
+	bne 1b		! do it n times
+	rts
+
+

mach/6500/libem/asp.s

@@ -0,0 +1,20 @@
+.define Asp
+
+! This subroutine adds an offset to the stackpointer,
+! e.g. after the return from a procedurecall.
+! The offset is in registerpair AX, and is added to the
+! stackpointer.
+
+
+Asp:
+	tay		! save A
+	txa		! get X
+	clc
+	adc SP+2	! add adjustment (lowbyte)
+	sta SP+2	! new stackpointer (lowbyte)
+	tya		! get A
+	adc SP+1	! add adjustment (highbyte)
+	sta SP+1	! get stackpointer (highbyte)
+	rts
+
+

mach/6500/libem/blm.s

@@ -0,0 +1,33 @@
+.define Blm, Blmnp
+
+! This subroutine copies bytes from one place in memory to
+! another. The source address is in registerpair AX and is stored
+! in zeropage locations ADDR and ADDR+1.
+! The destination address is popped from the stack and stored in
+! zeropage locations ADDR+2 and ADDR+3.
+! The number of bytes to be copied is in register Y (lowbyte) and
+! zeropage location NBYTES+1 (highbyte).
+! The subroutine Blmnp is used when the source and destination
+! addresses are already in zeropage.
+
+
+Blm:
+	stx ADDR+2	! source address (lowbyte)
+	sta ADDR+3	! source address (highbyte)
+	jsr Pop
+	stx ADDR	! destination address (lowbyte)
+	sta ADDR+1	! destination address (highbyte)
+Blmnp:	ldx NBYTES+1
+    1:	dey
+	lda (ADDR),y	! get source byte
+	sta (ADDR+2),y	! copy to destination
+	tya
+	bne 1b
+	dec ADDR+1	! 256 bytes copied
+	dec ADDR+3	! decrement source and destination address
+	ldy #0
+	dex
+	bne 1b		! do it n times
+	rts
+
+

mach/6500/libem/cii.s

@@ -0,0 +1,50 @@
+.define Cii
+
+! This subroutine converts integers to integers.
+! Convertions of integers with the same source size as destination
+! size aren't done, there just return the source.
+! A convertion from 4 bytes to 2 bytes just strips the two
+! most significant bytes.
+! A convertion from 2 bytes to 4 bytes tests the sign of the
+! source so that sign extentension takes place if neccesairy.
+
+
+Cii:
+	cpx #2
+	beq Cii_2	! a conversion from ? to 2
+	jsr Pop		! a conversion from 4 to ?
+	cpx #4
+	beq 8f		! a conversion 4 to 4 (skip)
+	jsr Pop
+	tay		! save A for sign test
+	pha		! save A 
+	txa
+	pha		! save X
+	tya		! test on negative
+	bmi 1f		! negative means sign extension
+	lda #0		! no sign extension here
+	tax
+	beq 2f
+    1:	lda #0FFh	! sign extension here
+	tax
+    2:	jsr Push	! push twobyte integer
+	pla
+	tax		! get X
+	pla		! get A
+	jmp Push
+Cii_2:			! a conversion from 2 to ?
+	jsr Pop
+	cpx #2
+	beq 8f		! a conversion from 2 to 2 (skip)
+	jsr Pop		! a conversion from 4 to 2
+	pha		! save A
+	txa
+	pha		! save X
+	jsr Pop		! strip most significant bytes
+	pla		! get X
+	tax
+	pla		! get A
+	jmp Push	! push result
+    8:	rts
+
+

mach/6500/libem/cmi.s

@@ -0,0 +1,26 @@
+.define Cmi
+
+! This subroutine compares on two integers.
+! If T is pushed first and than S, the routine will return:
+!   -1  if S < T,
+!    0  if S = T,
+!    1  if S > T.
+
+
+Cmi:
+	jsr Sbi2	! subtract operands (T - S)
+	bpl 1f		! S >= T
+	lda #0FFh	! S < T
+	tax		! AX becomes -1
+	rts
+    1:	beq 2f
+    3:	lda #0		! S > T
+	ldx #1		! AX becomes 1
+	rts
+    2:	txa
+	bne 3b
+	lda #0		! S = T
+	tax		! AX becomes 0
+	rts
+
+

mach/6500/libem/cmi4.s

@@ -0,0 +1,37 @@
+.define Cmi4
+
+! This subroutine compares on fourbyte integers.
+! If T is pushed first and than S, the routine will return:
+!    -1   if S < T,
+!     0   if S = T,
+!     1   if S > T.
+
+
+Cmi4:
+	jsr Sbi4	! subtract operands (T - S)
+	jsr Pop		! get result (lowbyte, lowbyte+1)
+	stx ARTH	! store lowbyte
+	sta ARTH+1	! store lowbyte+1
+	jsr Pop		! get result (lowbyte+2, lowbyte+3)
+	tay		! test lowbyte+3
+	bpl 1f		! S >= T
+	lda #0FFh	! S < T
+	tax		! AX becomes -1
+	rts
+    1:	cmp #0		! test lowbyte+3 on zero
+	bne 2f
+	cpx #0		! test lowbyte+2 on zero
+	bne 2f
+	lda #0
+	cmp ARTH+1	! test lowbyte+1 on zero
+	bne 2f
+	cmp ARTH	! test lowbyte on zero
+	bne 2f
+	lda #0		! S = T
+	tax		! AX becomes 0
+	rts
+    2:	lda #0		! S > T
+	ldx #1		! AX becomes 1
+	rts
+
+

mach/6500/libem/cms.s

@@ -0,0 +1,46 @@
+.define Cms
+
+! This subroutine compares two groups of bytes, bit for bit.
+! The groups can consist of 2 or 4 bytes. This number is in
+! register Y.
+! The address of the first group is stored in zeropage locations
+! ADDR and ADDR+1, the address of the second group in ADDR+2 and ADDR+3
+! The routine returns a 0 on equality, a 1 otherwise.
+
+
+
+Cms:
+	lda SP+2
+	ldx SP+1
+	sta ADDR	! address of first group (lowbyte)
+	stx ADDR+1	! address of second group (highbyte)
+	clc
+	tya
+	adc SP+2
+	sta SP+2
+	sta ADDR+2	! address of second group (lowbyte)
+	txa
+	adc #0
+	sta ADDR+3	! address of second group (highbyte)
+	tax
+	clc
+	tya
+	adc SP+2
+	sta SP+2	! new stackpointer (lowbyte)
+	txa
+	adc #0
+	sta SP+1	! new stackpointer (highbyte)
+    1:	dey
+	lda (ADDR),y	! get byte first group
+	cmp (ADDR+2),y	! compare bit for bit with byte second group
+	bne 2f
+	tya
+	bne 1b
+	lda #0		! both groups are equal
+	tax
+	rts
+    2:	lda #0		! there is a difference between the groups
+	ldx #1
+	rts
+
+

mach/6500/libem/cmu.s

@@ -0,0 +1,30 @@
+.define Cmu2
+
+! This subroutine compares two unsigned twobyte integers.
+! If T is the first pushed and than S, the routine will return:
+!    -1  if S < T,
+!     0  if S = T,
+!     1  if S > T.
+
+Cmu2:
+	stx EXG		! S (lowbyte)
+	sta EXG+1	! S (highbyte)
+	jsr Pop		! get T
+	cmp EXG+1
+	beq 2f		! S (highbyte)  =  T (highbyte)
+	bcc 1f
+    4:	lda #0		! S > T
+	ldx #1
+	rts
+    1:	lda #0FFh	! S < T
+	tax
+	rts
+    2:	cpx EXG
+	bne 3f
+	lda #0		! S = T
+	tax
+	rts
+    3:	bcc 1b
+	bcs 4b
+
+

mach/6500/libem/cmu4.s

@@ -0,0 +1,45 @@
+.define Cmu4
+
+! This subroutine compares two unsigned fourbyte integers.
+! If T is first pushed and than S the routine will return:
+!    -1   if S < T,
+!     0   if S = T,
+!     1   if S > T.
+
+
+Cmu4:
+	lda #ARTH
+	sta ADDR
+	lda #0
+	sta ADDR+1
+	jsr Sdo		! store S in zeropage ARTH - ARTH+3
+	lda #ARTH+4
+	sta ADDR
+	jsr Sdo		! store T in zeropage ARTH+4 - ARTH+7
+	lda ARTH+7
+	cmp ARTH+3
+	bcc 3f		! S (lowbyte+3) < T (lowbyte+3)
+	bne 2f		! S (lowbyte+3) < T (lowbyte+3)
+	lda ARTH+6
+	cmp ARTH+2
+	bcc 3f		! S (lowbyte+2) < T (lowbyte+2)
+	bne 2f		! S (lowbyte+2) < T (lowbyte+2)
+	lda ARTH+5
+	cmp ARTH+1
+	bcc 3f		! S (lowbyte+1) < T (lowbyte+1)
+	bne 2f		! S (lowbyte+1) < T (lowbyte+1)
+	lda ARTH+4
+	cmp ARTH
+	bcc 3f		! S (lowbyte+0) < T (lowbyte+0)
+	bne 2f		! S (lowbyte+0) < T (lowbyte+0)
+	lda #0
+	tax		! S = T
+	rts
+    2:	lda #0		! S > T
+	ldx #1
+	rts
+    3:	lda #0FFh	! S < T
+	tax
+	rts
+
+

mach/6500/libem/com.s

@@ -0,0 +1,21 @@
+.define Com
+
+! This subroutine performs a one complement on
+! a group of atmost 254 bytes (number in register Y).
+! This group is on the top of the stack.
+
+
+Com:
+	lda SP+1
+	sta ADDR+1	! address (highbyte) of first byte
+	lda SP+2
+	sta ADDR	! address (lowbyte) of first byte
+    1:	dey
+    	lda (ADDR),y
+	eor #0FFh	! one complement
+	sta (ADDR),y
+	tya
+	bne 1b		! do it n times
+	rts
+
+

mach/6500/libem/csa.s

@@ -0,0 +1,71 @@
+.define Csa
+
+! This subroutine performs the case jump by indexing.
+! The zeropage locations ADDR, ADDR+1 contain the address of
+! the case descriptor which also is the address of the
+! default pointer.
+! The zeropage locations ADDR+2, ADDR+3 contain the address of the
+! indextable which is the casedescriptor + 6.
+
+Csa:
+	stx ADDR	! address of descriptor (lowbyte)
+	sta ADDR+1	! address of descriptor (highbyte)
+	tay
+	txa
+	clc
+	adc #6
+	sta ADDR+2	! address of index table (lowbyte)
+	tya
+	adc #0
+	sta ADDR+3	! address of index table (highbyte)
+	jsr Pop		! fetch index
+	pha		! subtract lowerbound
+	txa
+	ldy #2
+	sec
+	sbc (ADDR),y
+	sta ARTH	! lowerbound (lowbyte)
+	pla
+	iny
+	sbc (ADDR),y
+	sta ARTH+1	! lowerbound (highbyte)
+	bmi 1f		! index < lowerbound
+	ldy #5
+	lda (ADDR),y
+	cmp ARTH+1
+	bcc 1f		! index (highbyte) > upperbound - lowerbound
+	bne 2f		! index (highbyte) <= upperbound - lowerbound
+	dey
+	lda (ADDR),y
+	cmp ARTH
+	bcc 1f		! index (lowbyte) > upperbound - lowerbound
+    2:	asl ARTH
+	rol ARTH+1	! index * 2
+	clc
+	lda ADDR+2
+	adc ARTH
+	sta ADDR+2	! address of pointer (lowbyte)
+	lda ADDR+3
+	adc ARTH+1
+	sta ADDR+3	! address of pointer (highbyte)
+	ldy #0
+	lda (ADDR+2),y	! jump address (lowbyte)
+	tax
+	iny
+	lda (ADDR+2),y	! jump address (highbyte)
+	bne 3f
+	cpx #0
+	beq 1f
+    3:	stx ADDR	! pointer <> 0
+	sta ADDR+1
+	jmp (ADDR)	! jump to address
+    1:	ldy #0		! pointer = 0
+	lda (ADDR),y	! get default pointer (lowbyte)
+	tax
+	iny
+	lda (ADDR),y	! get default pointer (highbyte)
+	bne 3b
+	cpx #0
+	bne 3b		! default pointer <> 0
+
+

mach/6500/libem/csb.s

@@ -0,0 +1,62 @@
+.define Csb
+
+! This subroutine performs the case jump by searching the table.
+! The zeropage locations ADDR, ADDR+1 contain the address of the
+! case descriptor, which also is the address of the default pointer.
+! The zeropage locations ADDR+2, ADDR+3 are used to address the jump 
+! pointers.
+
+
+Csb:
+	stx ADDR	! address of descriptor (lowbyte)
+	sta ADDR+1	! address of descriptor (highbyte)
+	stx ADDR+2
+	sta ADDR+3
+	ldy #2
+	lda (ADDR),y	! number of entries (lowbyte)
+	pha
+	jsr Pop
+	stx ARTH	! index (lowbyte)
+	sta ARTH+1	! index (highbyte)
+	pla
+	tax
+	inx
+    2:	clc
+	lda #4
+	adc ADDR+2
+	sta ADDR+2	! pointer (lowbyte)
+	bcc 1f
+	lda #0
+	adc ADDR+3
+	sta ADDR+3	! pointer (highbyte)
+    1:	ldy #0
+	lda (ADDR+2),y
+	cmp ARTH
+	bne 3f		! pointer (lowbyte) <> index (lowbyte)
+	iny
+	lda (ADDR+2),y
+	cmp ARTH+1
+	bne 3f		! pointer (highbyte) <> index (highbyte)
+	iny
+	lda (ADDR+2),y	! jump address (lowbyte)
+	tax
+	iny
+	lda (ADDR+2),y	! jump address (highbyte)
+	jmp 4f
+    3:	dex
+	bne 2b
+    5:	ldy #0
+	lda (ADDR),y	! default pointer (lowbyte)
+	tax
+	iny
+	lda (ADDR),y	! default pointer (highbyte)
+	beq 1f
+    4:	bne 1f		! pointer (lowbyte) <> 0
+	cpx #0
+	bne 1f		! pointer (highbyte) <> 0
+	beq 5b		! get default pointer
+    1:	stx ADDR
+	sta ADDR+1
+	jmp (ADDR)	! jump
+
+

mach/6500/libem/data.s

@@ -0,0 +1,36 @@
+.define EARRAY,ERANGE,ESET,EIOVFL
+.define ECONV,ESTACK
+.define EHEAP,EODDZ,ECASE
+.define EBADMON,EBADLIN,EBADGTO
+
+! This file contains the global data used by the trap routine.
+
+
+! DATA
+.data
+EARRAY:
+.asciz	"Array bound error\n\r"
+ERANGE:
+.asciz	"Range bound error\n\r"
+ESET:
+.asciz	"Set bound error\n\r"
+EIOVFL:
+.asciz	"Integer overflow\n\r"
+ECONV:
+.asciz	"Conversion error\n\r"
+ESTACK:
+.asciz	"Stack overflow\n\r"
+EHEAP:
+.asciz	"Heap overflow\n\r"
+EODDZ:
+.asciz	"Illegal size argument\n\r"
+ECASE:
+.asciz	"Case error\n\r"
+EBADMON:
+.asciz	"Bad monitor call\n\r"
+EBADLIN:
+.asciz	"Argument of LIN to high\n\r"
+EBADGTO:
+.asciz	"GTO descriptor error\n\r"
+
+

mach/6500/libem/div4.s

@@ -0,0 +1,41 @@
+.define Div4
+
+! This subroutine performs a signed divide on two fourbyte integers.
+! For more detail see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+Div4:
+	ldy #0
+	sty SIGN
+	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! divisor in ARTH - ARTH+3
+	tay
+	bpl 1f
+	lda #0
+	ldx #ARTH
+	jsr Ngi4
+	ldy #1
+	sty SIGN	! it's signed
+    1:	jsr Pop
+	stx ARTH+4
+	sta ARTH+5
+	jsr Pop
+	stx ARTH+6
+	sta ARTH+7	! dividend in ARTH+4 - ARTH+7
+	tay
+	bpl 1f
+	lda #0
+	ldx #ARTH+4
+	jsr Ngi4
+	lda SIGN
+	eor #1
+	sta SIGN
+	lda #1
+	sta NBYTES
+    1:	jmp Duv4
+
+

mach/6500/libem/dum_float.s

@@ -0,0 +1,59 @@
+.define Adf4
+.define Adf8
+.define Sbf4
+.define Sbf8
+.define Mlf4
+.define Mlf8
+.define Dvf4
+.define Dvf8
+.define Ngf4
+.define Ngf8
+.define Zrf4
+.define Zrf8
+.define Cmf4
+.define Cmf8
+.define Fef4
+.define Fef8
+.define Fif4
+.define Fif8
+.define Cfi
+.define Cif
+.define Cuf
+.define Cff
+.define Cfu
+.define Lfr8
+.define Ret8
+
+! Dummy floating point package for 6500
+! every EM floating point instruction results in an
+! "Illegal EM instruction" trap.
+
+
+Adf4:
+Adf8:
+Sbf4:
+Sbf8:
+Mlf4:
+Mlf8:
+Dvf4:
+Dvf8:
+Ngf4:
+Ngf8:
+Zrf4:
+Zrf8:
+Cmf4:
+Cmf8:
+Fef4:
+Fef8:
+Fif4:
+Fif8:
+Cfi:
+Cif:
+Cuf:
+Cff:
+Cfu:
+Lfr8:
+Ret8:
+	ldx #Eillins
+	lda #0
+	jsr Trap

mach/6500/libem/dup.s

@@ -0,0 +1,30 @@
+.define Dup
+
+! This subroutine duplicate's the top n (in register Y) bytes.
+! N is atmost 256.
+! The duplicating takes place as follows.
+! The registerpair is filled with the bytes at stackpointer + N
+! and stackpopinter + N-1.
+! These two bytes then are pushed onto the stack.
+! Next the offset N is decremented and the next two byte are taken
+! care off. Until N = 0.
+
+
+Dup:
+	lda SP+1
+	ldx SP+2
+	stx ADDR	! address of group (lowbyte)
+	sta ADDR+1	! address of group (highbyte)
+    1:	dey
+	lda (ADDR),y	! get lowbyte
+	pha
+	dey
+	lda (ADDR),y	! get highbyte
+	tax
+	pla
+	jsr Push	! push them
+	tya
+	bne 1b
+	rts
+
+

mach/6500/libem/duv4.s

@@ -0,0 +1,66 @@
+.define Duv4
+
+! This subroutine performs an unsigned division on two fourbyte
+! unsigned integers.
+! For more details see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Duv4:
+    1:	ldy #0
+	sty ARTH+8
+	sty ARTH+9
+	sty ARTH+10
+	sty ARTH+11
+    	ldy #33
+    4:	lda ARTH+11
+	cmp ARTH+3
+	bcc 1f		! no sub
+	bne 2f		! sub
+	lda ARTH+10
+	cmp ARTH+2
+	bcc 1f
+	bne 2f
+	lda ARTH+9
+	cmp ARTH+1
+	bcc 1f
+	bne 2f
+	lda ARTH+8
+	cmp ARTH
+	bcc 1f
+    2:	sec
+	lda ARTH+8
+	sbc ARTH
+	sta ARTH+8
+	lda ARTH+9
+	sbc ARTH+1
+	sta ARTH+9
+	lda ARTH+10
+	sbc ARTH+2
+	sta ARTH+10
+	lda ARTH+11
+	sbc ARTH+3
+	sta ARTH+11
+	sec
+	rol ARTH+4
+	bne 3f
+    1:	asl ARTH+4
+    3:	rol ARTH+5
+	rol ARTH+6
+	rol ARTH+7
+	rol ARTH+8
+	rol ARTH+9
+	rol ARTH+10
+	rol ARTH+11
+	dey
+	bne 4b
+	ldy UNSIGN
+	beq 1f
+	ldy SIGN
+	beq 1f
+	lda #0
+	ldx #ARTH+4
+	jsr Ngi4
+    1:	rts
+
+

mach/6500/libem/dvi.s

@@ -0,0 +1,82 @@
+.define Dvi2, Div, Duv
+
+! The subroutine Dvi2 performs a signed division.
+! Its operands are on the stack.
+! The subroutine Div performs also a signed division, ecxept that
+! its operand are already in zeropage.
+! The subroutine Duv performs a n unsigned division.
+! For an explanation of the algoritm used see
+!   A. S. Tanenbaum's Structered Computer Organisation. 1976
+
+
+Dvi2:
+	stx ARTH
+	sta ARTH+1	! store divisor
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! store dividend
+	ldy #1
+	sty UNSIGN	! used for result sign
+Div:
+	ldy #0
+	sty SIGN
+	lda ARTH+1
+	bpl 1f		! if divisor is negative
+	ldx ARTH	! make it positive
+	jsr Ngi2
+	ldy #1
+	sty SIGN
+	stx ARTH
+	sta ARTH+1
+    1:	lda ARTH+3
+	bpl 1f		! if dividend is negative
+	ldx ARTH+2	! make it positive
+	jsr Ngi2
+	pha
+	lda SIGN
+	eor #1		! excusive or with sign of divisor
+	sta SIGN
+	lda #1
+	sta NBYTES
+	pla
+    	stx ARTH+2
+	sta ARTH+3
+Duv:
+    1:	ldy #0
+	sty ARTH+4
+	sty ARTH+5
+	ldy #17
+    4:	lda ARTH+5
+	cmp ARTH+1
+	bcc 1f		! no subtraction
+	bne 2f		! divisor goes into dividend
+	lda ARTH+4
+	cmp ARTH
+	bcc 1f		! no subtraction
+    2:	sec		! divisor goes into dividend
+	lda ARTH+4
+	sbc ARTH
+	sta ARTH+4
+	lda ARTH+5
+	sbc ARTH+1
+	sta ARTH+5	! subtract divisor from dividend
+	sec
+	rol ARTH+2	! a subtraction so shift in a 1
+	bne 3f
+    1:	asl ARTH+2	! no subtraction so shift in a 0
+    3:	rol ARTH+3
+	rol ARTH+4
+	rol ARTH+5	! shift dividend
+	dey
+	bne 4b
+	ldx ARTH+2
+	lda ARTH+3
+	ldy UNSIGN	! is it an unsigned division
+	beq 1f
+	ldy SIGN	! is the result negative
+	beq 1f
+	jsr Ngi2
+    1:	rts
+
+
+

mach/6500/libem/dvi4.s

@@ -0,0 +1,19 @@
+.define Dvi4
+
+! This subroutine performs a fourbyte signed division.
+! For more details see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Dvi4:
+	ldy #1
+	sty UNSIGN
+	jsr Div4
+	lda ARTH+7
+	ldx ARTH+6
+	jsr Push
+	lda ARTH+5
+	ldx ARTH+4
+	jmp Push
+
+

mach/6500/libem/dvu.s

@@ -0,0 +1,17 @@
+.define Dvu2
+
+! This subroutine performs a twobyte unsigned division
+! For more details see dvi.s.
+
+
+Dvu2:
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3
+	ldy #0
+	sty UNSIGN
+	jmp Dvu
+
+

mach/6500/libem/dvu4.s

@@ -0,0 +1,31 @@
+.define Dvu4
+
+! This subroutine performs an unsigned division on fourbyte
+! integers. For more details see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Dvu4:
+	ldy #0
+	sty UNSIGN	! it is unsigned
+	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! divisor in ARTH - ARTH+3
+	jsr Pop
+	stx ARTH+4
+	sta ARTH+5
+	jsr Pop
+	stx ARTH+6
+	sta ARTH+7	! dividend in ARTH+4 - ARTH+7
+	jsr Duv4
+	lda ARTH+7
+	ldx ARTH+6
+	jsr Push
+	lda ARTH+5
+	ldx ARTH+4	 
+	jmp Push	! store result
+
+

mach/6500/libem/exg.s

@@ -0,0 +1,33 @@
+.define Exg
+
+! This subroutine exchanges two groups of bytes on the top of the
+! stack. The groups may consist of atmost 255 bytes.
+! This number is in register Y.
+! The exchange is from ADDR, ADDR+1 to ADDR+2, ADDR+3
+
+
+Exg:
+	lda SP+1
+	ldx SP+2
+	stx ADDR	! address of first group (lowbyte)
+	sta ADDR+1	! address of first group (highbyte)
+	sty Ytmp	! save number of bytes to be exchanged
+	clc
+	lda SP+2
+	adc Ytmp
+	sta ADDR+2	! address of second group (lowbyte)
+	lda SP+1
+	adc #0
+	sta ADDR+3	! address of second group (highbyte)
+    1:	dey
+    	lda (ADDR),y	! get byte from first group
+	pha		! temporary save
+	lda (ADDR+2),y	! get byte from second group
+	sta (ADDR),y	! store in first group
+	pla		! get temporary saved byte
+	sta (ADDR+2),y	! store in second group
+	tya
+	bne 1b		! perform n times
+	rts
+
+

mach/6500/libem/exg2.s

@@ -0,0 +1,23 @@
+.define Exg2
+
+! This subroutine exchanges two words on top of the stack.
+! The top word of the stack is really in the AX registerpair.
+! So this word is exchanged with the top of the real stack.
+
+
+Exg2:
+	pha		! save A
+	txa
+	pha		! save X
+	jsr Pop		! get top real stack
+	stx EXG
+	sta EXG+1	! save top of real stack
+	pla		! get X
+	tax
+	pla		! get A
+	jsr Push	! push on real stack
+	ldx EXG		! get new X
+	lda EXG+1	! get new A
+	rts
+
+

mach/6500/libem/gto.s

@@ -0,0 +1,65 @@
+.define Gto
+
+! This subroutine performs the non_local goto.
+! The address of the descriptor is stored in zeropage locations
+! ADDR, ADDR+1.
+! Since there are two stacks (hardware_stack and the real_stack),
+! the stackpointer of the hard_stack is resetted by searching the
+! new localbase in the real_stack while adjusting the hardware_stack.
+
+
+Gto:
+	stx ADDR	! address of descripto (lowbyte)
+	sta ADDR+1	! address of descriptor (highbyte)
+	pla		! remove
+	pla		! __gto return address.
+	ldy #4
+	lda (ADDR),y	! new localbase (lowbyte)
+	sta ARTH
+	tax
+	iny
+	lda (ADDR),y	! new localbase (highbyte)
+	sta ARTH+1
+	cmp LB+1
+	bne 1f
+	cpx LB
+	beq 2f		! goto within same procedure
+    1:	ldy #0
+	lda (LB),y	! get localbase (lowbyte)
+	tax
+	iny
+	lda (LB),y	! get localbase (highbyte)
+	cmp ARTH+1
+	bne 3f
+	cpx ARTH
+	beq 2f		! found localbase
+    3:	stx LB		! temporary save of localbase
+	sta LB+1
+	pla		! adjust
+	pla		! hardware_stack
+	jmp 1b
+    2:	sta LB+1	! store localbase (highbyte)
+	pha
+	stx LB		! store localbase (lowbyte)
+	sec
+	txa
+	sbc #BASE
+	sta LBl		! localbase - 240 (lowbyte)
+	pla
+	sbc #0
+	sta LBl+1	! localbase - 240 (highbyte)
+	ldy #3
+	lda (ADDR),y	! new stackpointer (highbyte)
+	sta SP+1
+	dey
+	lda (ADDR),y	! new stackpointer (lowbyte)
+	sta SP+2
+	dey
+	lda (ADDR),y	! jump address (highbyte)
+	sta ADDR+3
+	dey
+	lda (ADDR),y	! jump address (lowbyte)
+	sta ADDR+2
+	jmp (ADDR+2)	! jump to address
+
+

mach/6500/libem/head_em.s

@@ -0,0 +1,227 @@
+.define WRCH, RDCH, Earray, Erange, Eset
+.define Eiovfl, Eidivz, Eiund, Econv
+.define Estack, Eheap, Eillins, Eoddz
+.define Ecase , Ebadmon, OSBYTE, MON
+.define Ebadlin, Ebadgto, BASE, NBYTES
+.define hol0, IGNMASK, ADDR, PROGNAME
+.define LB, LBl, SP, HP, ERRPROC, UNSIGN
+.define Ytmp, EXG, ARTH, RETURN, SIGN
+.define RETSIZE, TRAPVAL, STACK, BRANCH
+.define start, Push, Pop, STACKTh, STACKTl
+.define F_DUM
+
+! DEFINITIONS
+
+	! The next three definitions are special for the
+	! BBC microcomputer
+
+WRCH	= 0FFEEh	! This subroutine writes the character in
+			! register A to the screen
+RDCH	= 0FFE0h	! This subroutine returns a character in
+			! register A from the current input stream
+OSBYTE	= 0FFF4h	! This subroutine performs miscelaneous
+			! operating system calls
+
+F_DUM	= 0		! Dummy floating point constant
+
+	! Here are the error numbers
+
+Earray	= 0
+Erange	= 1
+Eset	= 2
+Eiovfl	= 3
+Eidivz	= 6
+Eiund	= 8
+Econv	= 10
+Estack	= 16
+Eheap	= 17
+Eillins = 18
+Eoddz	= 19
+Ecase	= 20
+Ebadmon = 25
+Ebadlin = 26
+Ebadgto = 27
+MON = 78D0h
+
+BASE	= 240		! This is the offset from the localbase
+			! for the second localbase
+
+STACKTh = 78h		! This is the top of the stack
+STACKTl = 0D0h
+
+	! Some zeropage declarations
+
+.zero
+
+RES: .space 76		! special for the operating system
+
+hol0:	.space 16	! the hol0 block
+
+IGNMASK: .space 2	! can hold the ingnore mask
+
+ADDR: .space 4		! used for indirect addressing
+
+LB: .space 2		! the localbase
+
+LBl: .space 2		! the second localbase (localbase-BASE)
+
+SP: .space 3		! the stackpointer (real_stack)
+
+HP: .space 2		! the heap pointer
+
+BRANCH: .space 2	! used for branch instructions
+
+ERRPROC: .space 2	! can hold the address of the error handler
+
+Ytmp: .space 1		! used for intermediate storage in Y
+
+EXG: .space 2		! used by the exchange subroutine Exg
+
+ARTH: .space 16		! used for arithmetic
+
+NBYTES: .space 2	! containes the number of bytes for a block move
+
+
+RETURN: .space 4	! the return area
+
+RETSIZE: .space 1	! the size of the object returned
+
+SIGN: .space 1		! the sign of the calculation
+
+UNSIGN : .space 1	! is it signed or unsigned arithmetic
+
+TRAPVAL: .space 1	! intermediate storage of the error number
+
+STACK: .space 1		! contains the hardware stackpointer on
+			! entering m_a_i_n for a neat return
+
+RESERVED: .space 112    ! used by the operating system
+
+.base 0E02h		! where to start in the BBC micro
+.text
+! GENERAL PURPOSE ROUTINES
+
+start:
+	tsx
+	stx STACK	! save stackpointer for exit and error
+
+	! The following three operating system calls are only
+	! for the BBC microcomputer
+
+	lda #2
+	ldx #0
+	ldy #0
+	jsr OSBYTE	! return control to the keyboard
+	lda #15
+	ldx #0
+	ldy #0
+	jsr OSBYTE	! clear all internal buffers
+	lda #3
+	ldx #5
+	ldy #0
+	jsr OSBYTE	! output to screen and RS423
+
+	lda #STACKTl
+	sta LB		! set localbase (lowbyte)
+	sta SP+2
+	lda #0
+	sta SP		! set stackpointer (lowbyte)
+	sta ERRPROC	! set start address for error handler (lowbyte)
+	sta ERRPROC+1	! set start address for error handler (highbyte)
+	sta hol0	! set the line number (lowbyte)
+	sta hol0+1	! set the line number (highbyte)
+	lda #STACKTh
+	sta SP+1	! set the stacpointer (highbyte)
+	sta LB+1	! set the localbase (highbyte)
+	lda #[endbss].l
+	sta HP		! set the heap pointer (lowbyte)
+	lda #[endbss].h
+	sta HP+1	! set the heap pointer (highbyte)
+	lda #[PROGNAME].l
+	sta hol0+4	! set fake programname pointer (lowbyte)
+	lda #[PROGNAME].h
+	sta hol0+5	! set fake programname pointer (highbyte)
+	lda #[beginbss].l
+	sta ADDR	! start address of bss block (lowbyte)
+	lda #[beginbss].h
+	sta ADDR+1	! start address of bss block (highbyte)
+	ldy #0
+	lda #0
+    4:	ldx #[endbss].h	! clear bss block
+	cpx ADDR+1
+	bcc 1f		! end of bss block reached
+	bne 2f
+	ldx #[endbss].l
+	cpx ADDR
+	bcc 1f		! end of bss block reached
+    2:	sta (ADDR),y
+	inc ADDR
+	bne 3f
+	inc ADDR+1
+    3:	jmp 4b
+    1:	lda #0
+	tax
+	jsr Push	! push fake envelope pointer
+	lda #[PROGNAME].h
+	ldx #[PROGNAME].l
+	jsr Push	! push argv[0]
+	lda #0
+	ldx #1
+	jsr Push	! push argc 
+    	jsr _m_a_i_n	! start the real program
+
+	lda #0FFh
+	jsr WRCH	! send end of program to R423
+	lda #3
+	ldx #0
+	jsr OSBYTE	! send output to screen only
+	lda #2
+	ldx #1
+	jsr OSBYTE	! input only from R423
+	rts
+
+
+! The subroutine Push pushes the registerpair AX onto the stack.
+
+Push:
+	sty Ytmp	! save Y
+	ldy SP+2
+	bne 1f		! lowbyte of stackpointer <> 0
+	dec SP+1	! decrement highbyte of stackpointer
+    1:  dey
+	dey		! decrement lowbyte of stackpointer
+	sty SP+2	! save lowbyte of stackpointer
+	pha		! save A
+	txa
+    	sta (SP),y	! push X onto the stack
+	iny
+	pla		! get A
+	sta (SP),y	! push A onto the stack
+	ldy Ytmp	! restore Y
+	rts
+
+
+! The subroutine Pop pops the registerpair AX from the stack.
+
+Pop:
+	sty Ytmp	! save Y
+	ldy SP+2
+	lda (SP),y	! pop X from the stack
+	tax
+	iny
+	lda (SP),y	! pop A from the stack
+	iny
+	bne 1f		! lowbyte of stackpointer <> 0
+	inc SP+1	! increment highbyte of stackpointer
+    1:  sty SP+2	! store lowbyte of stackpointer
+	pha		! save A
+	pla		! get A
+	ldy Ytmp	! restore Y
+	rts
+
+
+.data
+PROGNAME:		! for initialising the programname pointer
+.asciz "program"
+.bss
+beginbss:

mach/6500/libem/indir.s

@@ -0,0 +1,13 @@
+.define Indir
+
+! This subroutine performs an indirect procedurecall.
+! This must be done this way since the jump instruction
+! is the only one which can indirect change the programcounter.
+! The address of the function must be in zeropage loactions
+! ADDR, ADDR+1.
+
+
+Indir:
+	jmp (ADDR)
+
+

mach/6500/libem/inn.s

@@ -0,0 +1,55 @@
+.define Inn
+
+! This subroutine checks if a certain bit is set in a set
+! of n bytes on top of the stack.
+
+
+Inn:
+	stx ARTH	! save bit number (lowbyte)
+	sta ARTH+1	! save bit number (highbyte)
+	and #80h
+	beq 1f
+	lda #0		! bit number is negative
+	sta ARTH+2	! make it zero
+	beq 3f
+    1:	txa
+	and #07h	! get bit number mod 8
+	tax
+	lda #1
+	cpx #0		! bit number = 0
+	beq 2f		! no shifting to right place
+    1:	asl a		! shift left until bit is in place
+	dex
+	bne 1b
+    2:	sta ARTH+2	! bit is one in place
+	ldx #3
+    1:	lsr ARTH+1	! shift left 3 times bit number (highbyte)
+	ror ARTH	! shift left 3 times bit number (lowbyte)
+	dex		! this is bit number div 8
+	bne 1b		! which is byte number
+    3:	lda SP+1
+	ldx SP+2
+	stx ADDR	! address of the set (lowbyte)
+	sta ADDR+1	! address of the set (highbyte)
+	iny
+	tya
+	bne 2f
+	inc SP+1
+    2:	clc		! remove the set
+	adc SP+2
+	sta SP+2	! new stackpointer (lowbyte)
+	lda #0
+	adc SP+1
+	sta SP+1	! new stackpointer (highbyte)
+	ldy ARTH
+	lda (ADDR),y	! load the byte in A
+	bit ARTH+2	! test bit
+	bne 1f
+    3:	lda #0		! bit is zero
+	tax
+	rts
+    1:	lda #0		! bit is one
+	ldx #1
+	rts
+
+

mach/6500/libem/ior.s

@@ -0,0 +1,29 @@
+.define Ior
+
+! This subroutine performs the logical inclusive or on two
+! groups of bytes. The groups may consist of atmost 254 bytes.
+! The two groups are on the stack.
+
+Ior:
+	lda SP+1
+	sta ADDR+1	! address of the first group (highbyte)
+	lda SP+2
+	sta ADDR	! address of the first group (lowbyte)
+	clc
+	tya
+	adc SP+2
+	sta SP+2	! new stackpointer (lowbyte)
+	sta ADDR+2	! address of second group (lowbyte)
+	lda #0
+	adc SP+1
+	sta SP+1	! new stackpointer (highbyte)
+	sta ADDR+3	! address of second group (highbyte)
+    1:  dey
+	lda (ADDR),y	! get byte first group
+	ora (ADDR+2),y	! inclusive or with byte second group
+	sta (ADDR+2),y	! restore result on stack
+	tya
+	bne 1b		! perform n times
+	rts
+
+

mach/6500/libem/lar.s

@@ -0,0 +1,25 @@
+.define Lar
+
+! This subroutine performs the LAR instruction.
+! For details see rapport IR-81.
+
+
+Lar:
+	jsr Aar		! get object address
+	ldy NBYTES+1	! the size of the object (highbyte)
+	bne 2f
+	ldy NBYTES	! the size of the object (lowbyte)
+	cpy #1
+	bne 1f		! object size is one byte
+	jsr Loi1	! get object
+	jmp Push	! push on the stack
+    1:	cpy #2
+	bne 1f		! object size is a word
+	jsr Loi		! get word
+	jmp Push	! push on the stack
+    1:	cpy #4
+	bne 2f		! object size is four bytes
+	jmp Ldi		! get object
+    2:	jmp Loil	! get object
+
+

mach/6500/libem/lcs.s

@@ -0,0 +1,19 @@
+.define Lcs
+
+! This subroutine creates space for locals on procedure entry
+! by lowering the stackpointer.
+
+
+Lcs:
+	sta ARTH	! number of locals (lowbyte)
+	stx ARTH+1	! number of locals (highbyte)
+	sec
+	lda SP+2
+	sbc ARTH
+	sta SP+2	! new stackpointer (lowbyte)
+	lda SP+1
+	sbc ARTH+1
+	sta SP+1	! new stackpointer (highbyte)
+	rts
+
+

mach/6500/libem/ldi.s

@@ -0,0 +1,24 @@
+.define Ldi, Ldo
+
+! The subroutine Ldi pushes a four byte object onto the stack.
+! The address is in registerpair AX.
+! If the address is already in zeropage Ldo is used.
+
+
+Ldi:
+	stx ADDR	! address of object (lowbyte)
+	sta ADDR+1	! address of object (highbyte)
+Ldo:
+	ldy #3
+    1:	lda (ADDR),y	! get lowbyte
+	pha
+	dey
+	lda (ADDR),y	! get highbyte
+	tax
+	pla
+	jsr Push	! do the push
+	dey
+	bpl 1b		! perform 2 times
+	rts
+
+

mach/6500/libem/locaddr.s

@@ -0,0 +1,18 @@
+.define Locaddr
+
+! This routine gets the address of a local which offset is to big.
+! The offset is in registerpair AX.
+
+
+Locaddr:
+	pha		! save A
+	txa
+	clc
+	adc LB		! localbase + offset (lowbyte)
+	sta ADDR	! address (lowbyte)
+	pla
+	adc LB+1	! localbase + offset (highbyte)
+	sta ADDR+1	! address (highbyte)
+	rts
+
+

mach/6500/libem/loi.s

@@ -0,0 +1,17 @@
+.define Loi, Lext
+! This subroutine performs an indirect load on a word of two bytes.
+! Lext is used when the address is already in zeropage.
+
+
+Loi: 
+	stx ADDR	! address of object (lowbyte)
+	sta ADDR+1	! address of object (highbyte)
+Lext:
+	ldy #0
+	lda (ADDR),y	! get lowbyte
+	tax		
+	iny
+	lda (ADDR),y	! get highbyte
+	rts
+
+

mach/6500/libem/loi1.s

@@ -0,0 +1,15 @@
+.define Loi1
+
+! This routine loads a one byte object in registerpair AX.
+
+
+Loi1:
+	stx ADDR	! address of byte (lowbyte)
+	sta ADDR+1	! address of byte (highbyte)
+	ldy #0
+	lda (ADDR),y	! load byte
+	tax		! store byte in X
+	tya		! clear highbyte of AX
+	rts
+
+

mach/6500/libem/loil.s

@@ -0,0 +1,23 @@
+.define Loil
+
+! This subroutine pushes an object of size greater than four bytes
+! onto the stack.
+
+
+Loil:
+	sta ADDR+1	! source address (lowbyte)
+	stx ADDR	! source address (highbyte)
+	sty NBYTES
+	sec
+	lda SP+2
+	sbc NBYTES
+	sta ADDR+2	! destination address (lowbyte)
+	sta SP+2	! new stackpointer
+	lda SP+1
+	sbc NBYTES+1
+	sta ADDR+3	! destination address (highbyte)
+	sta SP+1	! new stackpointer
+	inc NBYTES+1
+	jmp Blmnp	! do the move
+
+

mach/6500/libem/lol.s

@@ -0,0 +1,16 @@
+.define Lol
+
+! This subroutine loads a local in registerpair AX which
+! offset from the localbase is to big.
+
+
+Lol:
+	jsr Locaddr	! get the address of local
+	ldy #0
+	lda (ADDR),y	! get lowbyte
+	tax
+	iny
+	lda (ADDR),y	! get highbyte
+	rts
+
+

mach/6500/libem/los.s

@@ -0,0 +1,30 @@
+.define Los
+
+! This subroutine perfoms the LOS instruction.
+! For detail see rapport IR-81.
+
+
+Los:
+	cmp #0
+	bne 3f
+	cpx #1
+	bne 1f		! the size is one
+	jsr Pop		! get address
+	jsr Loi1	! push it on the stack
+	jmp Push
+    1:	cpx #2
+	bne 2f		! the size is two
+	jsr Pop		! get address
+	jsr Loi		! push it on the stack
+	jmp Push
+    2:	cpx #4
+	bne 3f		! the size is four
+	jsr Pop		! get address
+	jmp Ldi		! push it on the stack
+    3:	sta ARTH+1	! the size is greater than four
+	txa
+	tay
+	jsr Pop		! get address
+	jmp Loil	! push it on the stack
+
+

mach/6500/libem/lxa1.s

@@ -0,0 +1,15 @@
+.define Lxa1
+
+! This subroutine loads the address of AB zero static levels back.
+
+Lxa1:
+	ldy LB+1	! load address of localbase (highbyte)
+	ldx LB		! load address of localbase (lowbyte)
+	inx
+	inx		! argumentbase = localbase + 2
+	bne 1f
+	iny
+    1:	tya
+	rts
+
+

mach/6500/libem/lxa2.s

@@ -0,0 +1,32 @@
+.define Lxa2
+
+! This subroutine load the address of AB n (255 >= n > 0) static levels
+! back.
+
+
+Lxa2:
+	lda LB
+	sta ADDR	! address of localbase (lowbyte)
+	lda LB+1
+	sta ADDR+1	! address of localbase (highbyte)
+    1:	ldy #2
+	lda (ADDR),y	! static level LB (lowbyte)
+	pha
+	iny
+	lda (ADDR),y	! static level LB (highbyte)
+	sta ADDR+1	! static level LB (highbyte)
+	pla
+	sta ADDR	! static level LB (lowbyte)
+	dex
+	bne 1b
+	tax
+	ldy ADDR+1
+	inx
+	inx		! argumentbase = localbase + 2
+	bne 1f
+	iny
+    1:	tya
+	rts
+
+
+

mach/6500/libem/lxl.s

@@ -0,0 +1,25 @@
+.define Lxl
+
+! This subroutine loads LB n (255 => n > 0) static levels back.
+
+
+Lxl:
+	lda LB
+	sta ADDR	! address of localbase (lowbyte)
+	lda LB+1
+	sta ADDR+1	! address of localbase (highbyte)
+    1:	ldy #2
+	lda (ADDR),y	! get localbase (lowbyte) 1 level back
+	pha
+	iny
+	lda (ADDR),y	! get localbase (highbyte) 1 level back
+	sta ADDR+1	! new localbase (highbyte)
+	pla
+	sta ADDR	! new localbase (lowbyte)
+	dex
+	bne 1b		! n levels
+	tax
+	lda ADDR+1
+	rts
+
+

mach/6500/libem/mli.s

@@ -0,0 +1,69 @@
+.define Mli2, Mlinp, Mul
+
+! The subroutine Mli2 multiplies two signed integers. The integers
+! are popped from the stack.
+! The subroutine Mlinp expects the two integer to be in zeropage.
+! While the subroutine Mul an unsigned multiply subroutine is.
+! For the algoritme see A. S. Tanenbaum
+!	Structured Computer Organisation. 1976.
+
+
+Mli2:
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3
+Mlinp:	ldy #1
+	sty UNSIGN	! it's signed
+	lda ARTH+1
+	bpl 3f		! multiplier negative so:
+	ldx ARTH
+	jsr Ngi2	! negate multiplier
+	stx ARTH
+	sta ARTH+1
+	ldx ARTH+2
+	lda ARTH+3
+	jsr Ngi2	! negate multiplicand
+	stx ARTH+2
+	sta ARTH+3
+Mul:
+    3:	lda #0	
+	sta ARTH+4
+	sta ARTH+5
+	sta ARTH+6
+	sta ARTH+7	! clear accumulator
+    	ldy #16
+    1:	lda #1h
+	bit ARTH
+	beq 2f		! multiplying by zero: no addition
+	clc
+	lda ARTH+6
+	adc ARTH+2
+	sta ARTH+6
+	lda ARTH+7
+	adc ARTH+3
+	sta ARTH+7
+    2:	lsr ARTH+1
+	ror ARTH	! shift multiplier
+	lsr ARTH+7
+	ror ARTH+6
+	ror ARTH+5
+	ror ARTH+4	! shift accumulator
+	lda UNSIGN
+	beq 3f		! unsigned multiply: so no shift in of signbit
+	lda ARTH+3
+	bpl 3f
+	lda #40h
+	bit ARTH+7
+	beq 3f
+	lda ARTH+7
+	ora #80h
+	sta ARTH+7
+    3:	dey
+	bne 1b
+	ldx ARTH+4
+	lda ARTH+5
+	rts
+
+

mach/6500/libem/mli4.s

@@ -0,0 +1,33 @@
+.define Mli4
+
+! This subroutine multiplies two signed fourbyte integers
+! For more detail see mli.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Mli4:
+	ldy #1
+	sty UNSIGN
+	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! multiplier
+	jsr Pop
+	stx ARTH+4
+	sta ARTH+5
+	jsr Pop
+	stx ARTH+6
+	sta ARTH+7	! multiplicand
+	lda ARTH+3
+	bpl 3f
+	lda #0
+	ldx #ARTH
+	jsr Ngi4
+	lda #0
+	ldx #ARTH+4
+	jsr Ngi4
+    3:	jmp Mul4
+
+

mach/6500/libem/mlu.s

@@ -0,0 +1,17 @@
+.define Mlu2
+
+! This subroutine multiplies two unsigned fourbyte intergers.
+! For more details see mli.s
+
+
+Mlu2:
+	stx ARTH
+	sta ARTH+1	! multiplier
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! multiplicand
+	ldy #0
+	sty UNSIGN
+	jmp Mul
+
+

mach/6500/libem/mlu4.s

@@ -0,0 +1,25 @@
+.define Mlu4
+
+! This subroutine multiplies two fourbyte unsigned integers.
+! For more details see mli.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Mlu4:
+	ldy #0
+	sty UNSIGN
+	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! multiplier
+	jsr Pop
+	stx ARTH+4
+	sta ARTH+5
+	jsr Pop
+	stx ARTH+6
+	sta ARTH+7	! multiplicand
+	jmp Mul4
+
+

mach/6500/libem/mon.s

@@ -0,0 +1,35 @@
+.define Mon
+
+! This subroutine performs some monitor calls.
+! The exit call just resets the hardware_stackpointer so
+! this routine will return to the operating system.
+! The close call just returns a zero.
+! The ioctl call just pops its arguments and returns a zero.
+! The write routine is a real one.
+
+
+Mon:
+	cpx #1
+	bne 1f		! exit
+	ldx STACK	! load stackpointer
+	dex
+	dex		! adjust stackpointer
+	txs		! set stackpointer
+	rts
+    1:	cpx #4
+	bne 1f
+	jmp Mwrite
+    1:	cpx #6		! facked
+	bne 1f		! close
+	lda #0
+	tax		! return zero
+	rts
+    1:	cpx #54
+	jsr Pop		! pop first argument (fildes)
+	jsr Pop		! pop second argument (request)
+	jsr Pop		! pop third argument (argp)
+	lda #0
+	tax		! return zero
+	rts
+
+

mach/6500/libem/mul4.s

@@ -0,0 +1,66 @@
+.define Mul4
+
+! This subroutine multiplies two fourbyte signed integers.
+! For more details see mli.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Mul4:
+    3:	lda #0
+	sta ARTH+8
+	sta ARTH+9
+	sta ARTH+10
+	sta ARTH+11
+	sta ARTH+12
+	sta ARTH+13
+	sta ARTH+14
+	sta ARTH+15	! clear accumulator
+    	ldy #32
+    1:	lda #1h
+	bit ARTH
+	beq 2f		! multiplying by zero: no addition
+	clc
+	lda ARTH+12
+	adc ARTH+4
+	sta ARTH+12
+	lda ARTH+13
+	adc ARTH+5
+	sta ARTH+13
+	lda ARTH+14
+	adc ARTH+6
+	sta ARTH+14
+	lda ARTH+15
+	adc ARTH+7
+	sta ARTH+15
+    2:	lsr ARTH+3
+	ror ARTH+2
+	ror ARTH+1
+	ror ARTH	! shift multiplier
+	lsr ARTH+15
+	ror ARTH+14
+	ror ARTH+13
+	ror ARTH+12
+	ror ARTH+11
+	ror ARTH+10
+	ror ARTH+9
+	ror ARTH+8	! shift accumulator
+	lda UNSIGN
+	beq 3f		! it's unsigned: so no shift in of signbit
+	lda ARTH+7
+	bpl 3f
+	lda #40h
+	bit ARTH+15
+	beq 3f
+	lda ARTH+15
+	ora #80h
+	sta ARTH+15
+    3:	dey
+	bne 1b
+	ldx ARTH+10
+	lda ARTH+11
+	jsr Push
+	ldx ARTH+8
+	lda ARTH+9
+	jmp Push
+
+

mach/6500/libem/ngi.s

@@ -0,0 +1,19 @@
+.define Ngi2
+
+! This subroutine negates the integer in registerpair AX.
+! The negation is a one's complement plus one.
+
+
+Ngi2:
+	eor #0FFh	! one's complement A
+	tay
+	txa
+	eor #0FFh	! one's complement X
+	tax
+	inx		! increment X
+	bne 1f
+	iny		! increment A if neccesairy
+    1:	tya
+	rts
+
+

mach/6500/libem/ngi4.s

@@ -0,0 +1,30 @@
+.define Ngi4
+
+! This subroutine takes a fourbyte interger and negates it.
+! For more details see ngi2.s
+
+
+Ngi4:
+	sta ADDR+1
+	stx ADDR
+	ldy #3
+    1:	lda (ADDR),y
+	eor #0FFh	! one's complement lowbyte+y
+	sta (ADDR),y
+	dey
+	bpl 1b
+	ldx #0FDh
+	iny
+	clc
+    	lda (ADDR),y
+	adc #1
+	sta (ADDR),y	! lowbyte+y
+    1:	iny
+	lda (ADDR),y
+	adc #0
+	sta (ADDR),y	! (lowbyte+y)+0
+	inx
+	bne 1b
+	rts
+
+

mach/6500/libem/print.s

@@ -0,0 +1,22 @@
+.define Mprint
+
+! This subroutine prints a zero terminated ascii string.
+! The registerpair AX contains the start of the string.
+! The subroutine WRCH is a special routine on the BBC microcomputer
+! which prints the character in A to the screen.
+! The subroutine WRCH is a special one provided by the BBC
+! microcomputer.
+
+
+Mprint:
+	stx ADDR	! start address of string (lowbyte)
+	sta ADDR+1	! start address of string (highbyte)
+	ldy #0
+    1:	lda (ADDR),y	! get ascii character
+	beq 2f
+	jsr WRCH	! put it on the screen
+	iny
+	bne 1b
+    2:  rts
+
+

mach/6500/libem/printhex.s

@@ -0,0 +1,27 @@
+.define Printhex
+
+! This subroutine print the contents of register A to the screen
+! in hexadecimal form.
+! The subroutine WRCH is a special one provided by the BBC
+! microcomputer.
+
+
+Printhex:
+	pha		! save A
+	lsr a
+	lsr a
+	lsr a
+	lsr a		! get four high bits
+	jsr 1f
+	pla		! restore A
+	and #0Fh	! get four low bits
+	jsr 1f
+	rts
+    1:	sed		! print in hex
+	clc
+	adc #90h
+	adc #40h
+	cld
+	jmp WRCH
+
+

mach/6500/libem/printstack.s

@@ -0,0 +1,44 @@
+.define Printstack
+
+! This a special subroutine which prints some things to the
+! monitorscreen for debugging.
+
+
+Printstack:
+	ldy #0
+    2:	lda (hol0+4),y
+	beq 1f
+	jsr WRCH	! print filename
+	iny
+	jmp 2b
+    1:	lda #32
+	jsr WRCH	! print a space
+	lda hol0+1
+	jsr Printhex	! print line number (highbyte)
+	lda hol0
+	jsr Printhex	! print line number (lowbyte)
+	lda #32
+	jsr WRCH	! print a space
+	lda SP+1
+	jsr Printhex	! print stackpointer (highbyte)
+	lda SP+2
+	jsr Printhex	! print stackpointer (lowbyte)
+	lda #32
+	jsr WRCH	! print a space
+	lda LB+1
+	jsr Printhex	! print real localbase (highbyte)
+	lda LB
+	jsr Printhex	! print real localbase (lowbyte)
+	lda #32
+	jsr WRCH	! print a space
+	lda LBl+1
+	jsr Printhex	! print second lowerbase (highbyte)
+	lda LBl
+	jsr Printhex	! print second lowerbase (lowbyte)
+	lda #10
+	jsr WRCH	! print a newline
+	lda #13
+	jsr WRCH	! print a carriagereturn
+	rts
+
+

mach/6500/libem/pro.s

@@ -0,0 +1,28 @@
+.define Pro
+
+! This routine is called at the entry of a procedure.
+! It saves the localbase of the invoking procedure, and sets the
+! new localbase to the present value of the stackpointer.
+! It then initializes the second localbase by subtracting
+! BASE from the real one.
+
+
+Pro:
+	ldx LB		! get localbase (lowbyte)
+	lda LB+1	! get localbase (highbyte)
+	jsr Push	! push localbase onto the stack
+	ldx SP+2	! get stackpointer (lowbyte)
+	lda SP+1	! get stackpointer (highbyte)
+	stx LB		! new localbase (lowbyte)
+	sta LB+1	! new localbse (highbyte)
+	tay
+	txa
+	sec
+	sbc #BASE
+	sta LBl		! second localbase (lowbyte)
+	tya
+	sbc #0
+	sta LBl+1	! second localbase (highbyte)
+    	rts
+
+

mach/6500/libem/read.s

@@ -0,0 +1,32 @@
+.define Mread
+
+! This subroutine reads characters from the standard input.
+! It ignores the filedes.
+! It reads atmost 255 characters. So the runtime system must
+! provide a way of dealing with this.
+! The subroutine RDCH is a special one provided by the BBC
+! microcomputer.
+
+
+Mread:
+	jsr Pop		! ignore filedescriptor
+	jsr Pop		! bufptr
+	stx ADDR	! address of character buffer (lowbyte)
+	sta ADDR+1	! address of character buffer (highbyte)
+	jsr Pop		! number of characters
+	ldy #0		! <= 255
+	inx
+    1:	jsr RDCH	! read a character from the current inputstream
+	bcs 8f
+	sta (ADDR),y
+	iny
+	dex
+	bne 1b
+    8:	tya
+	tax
+	lda #0
+	jsr Push	! number of characters red.
+	tax		! report a succesfull read.
+	rts
+
+

mach/6500/libem/ret.s

@@ -0,0 +1,43 @@
+.define Ret
+
+! This subroutine stores the returnvalue in the return area.
+! This area is in zeropage.
+! The size of the object to be returned is in zeropage location
+! RETSIZE.
+! It also restores the localbases and the stackpointer of the
+! invoking procedure.
+
+
+Ret:
+	sty RETSIZE	! save returnsize
+	beq 1f		! the return size is zero
+	lda #0		! address of returnvalue area (highbyte)
+	ldx #RETURN	! address of returnvalue area (lowbyte)
+	cpy #2
+	bne 2f
+	jsr Sti		! store word
+	jmp 1f
+    2:	cpy #4
+	jsr Sdi		! store fourbyte word
+    1:	ldx LB		! get old stackpointer (lowbyte)
+	stx SP+2
+	lda LB+1	! get old stackpointer (highbyte)
+	sta SP+1
+	inc LB
+	inc LB
+	bne 1f
+	inc LB+1
+    1:	jsr Pop		! get old localbase
+	stx LB		! localbase (lowbyte)
+	sta LB+1	! localbase (highbyte)
+	pha
+	sec
+	txa
+	sbc #BASE
+	sta LBl		! second localbase (lowbyte)
+	pla
+	sbc #0
+	sta LBl+1	! second localbase (highbyte)
+	rts
+
+

mach/6500/libem/rmi.s

@@ -0,0 +1,27 @@
+.define Rmi2
+
+! This subroutine returns the remainder of a twobyte signed division.
+! The sign of the result is as specified in the emtest.
+
+
+Rmi2:
+	ldy #0
+	sty NBYTES	! for the sign of the result
+	stx ARTH
+	sta ARTH+1	! first operand
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! second operand
+	ldy #0
+	sty UNSIGN	! its signed arithmetic
+	jsr Div
+	lsr ARTH+5
+	ror ARTH+4	! result must be shifted one time
+	ldx ARTH+4
+	lda ARTH+5
+	ldy NBYTES
+	beq 1f		! result must be positive
+	jmp Ngi2
+    1:	rts
+
+

mach/6500/libem/rmi4.s

@@ -0,0 +1,28 @@
+.define Rmi4
+
+! This subroutine returns the remainder of a fourbyte division.
+
+
+Rmi4:
+	ldy #0
+	sty NBYTES	! for the sign of the result
+	ldy #0
+	sty UNSIGN	! it is signed arithmetic
+	jsr Div4
+	lsr ARTH+11
+	ror ARTH+10
+	ror ARTH+9
+	ror ARTH+8	! result must be shifted one time
+	ldy NBYTES
+	beq 1f		! result is positive
+	lda #0
+	ldx #ARTH+8
+	jsr Ngi4
+    1:	lda ARTH+11
+	ldx ARTH+10
+	jsr Push
+	lda ARTH+9
+	ldx ARTH+8
+	jmp Push
+
+

mach/6500/libem/rmu.s

@@ -0,0 +1,22 @@
+.define Rmu2
+
+! This subroutine returns the remainder of an twobyte unsigned
+! integer division.
+
+
+Rmu2:
+	stx ARTH
+	sta ARTH+1	! first operand
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! second operand
+	ldy #1
+	sty UNSIGN	! it unsigned
+	jsr Duv
+	lsr ARTH+5
+	ror ARTH+4	! shift result one time
+	ldx ARTH+4
+	lda ARTH+5
+    	rts
+
+

mach/6500/libem/rmu4.s

@@ -0,0 +1,34 @@
+.define Rmu4
+
+! This subroutine returns the remainder of a fourbyte unsigned
+! division.
+
+
+Rmu4:
+	ldy #1
+	sty UNSIGN	! its unsigned
+	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3	! second operand
+	jsr Pop
+	stx ARTH+4
+	sta ARTH+5
+	jsr Pop
+	stx ARTH+6
+	sta ARTH+7	! first operand
+	jsr Duv4
+	lsr ARTH+11
+	ror ARTH+10
+	ror ARTH+9
+	ror ARTH+8	! shift result one time
+    	lda ARTH+11
+	ldx ARTH+10
+	jsr Push
+	lda ARTH+9
+	ldx ARTH+8
+	jmp Push
+
+

mach/6500/libem/rol.s

@@ -0,0 +1,26 @@
+.define Rol
+
+! This subroutine rotates left an integer n times
+! N is in register X.
+! The result is returned in registerpair AX.
+
+
+Rol:
+	
+    	txa
+	bne 1f
+	jmp Pop		! zero rotate return input
+    1:	tay		! Y contains number of rotates
+	jsr Pop
+	stx Ytmp	! save lowbyte
+    2:	clc
+	rol Ytmp	! rotate lowbyte
+	rol a		! rotate highbyte
+	bcc 1f		! no carry
+	inc Ytmp	! put carry in rightmost bit
+    1:	dey
+	bne 2b
+	ldx Ytmp	! store lowbyte in X
+	rts
+
+

mach/6500/libem/rol4.s

@@ -0,0 +1,33 @@
+.define Rol4
+
+! This subroutine rotates left a fourbyte integer n times.
+! N is in register X.
+
+
+Rol4:
+	txa
+	bne 1f		! a zero rotate skip
+	rts
+    1:	tay
+	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3
+    2:	asl ARTH
+	rol ARTH+1
+	rol ARTH+2
+	rol ARTH+3	! rotate left
+	bcc 1f
+	inc ARTH	! put carry in rightmost bit
+    1:	dey
+	bne 2b
+	ldx ARTH+2
+	lda ARTH+3
+	jsr Push
+	ldx ARTH
+	lda ARTH+1
+	jmp Push
+
+

mach/6500/libem/ror.s

@@ -0,0 +1,25 @@
+.define Ror
+
+! This subroutine rotates right a integer twobyte word.
+! The number of rotates is in X.
+! The result is returned in registerpair AX.
+
+
+Ror:
+    	txa
+	bne 1f		! a zero rotate just return input
+	jmp Pop
+    1:	tay
+	jsr Pop		! get word
+	stx Ytmp	! save lowbyte
+    2:	clc
+	ror a		! rotate highbyte
+	ror Ytmp	! rotate lowbyte
+	bcc 1f		! no carry
+	ora #80h	! put carry in leftmost bit
+    1:	dey
+	bne 2b
+	ldx Ytmp	! get lowbyte
+	rts
+
+

mach/6500/libem/ror4.s

@@ -0,0 +1,35 @@
+.define Ror4
+
+! This subroutine rotates right a fourbyte word.
+! The number of rotates is in X.
+
+
+Ror4:
+	txa
+	bne 1f		! a zero rotate skip
+	rts
+    1:	tay
+	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	sta ARTH+3
+    2:	lsr ARTH+3	! rotate word
+	ror ARTH+2
+	ror ARTH+1
+	ror ARTH
+	bcc 1f		! no carry
+	lda #80h	! put carry in leftmost bit
+	ora ARTH+3
+	sta ARTH+3
+    1:	dey
+	bne 2b
+	lda ARTH+3
+	ldx ARTH+2
+	jsr Push
+	lda ARTH+1
+	ldx ARTH
+	jmp Push	! push result onto the stack
+
+

mach/6500/libem/rtt.s

@@ -0,0 +1,21 @@
+.define Rtt
+
+! This subroutine performs the return from trap.
+
+
+Rtt:
+	ldy #0
+	jsr Ret		! restore old stackpointer and localbase
+	jsr Pop		! remove trapnumber
+	jsr Pop
+	sta hol0+1
+	stx hol0	! restore linenumber
+	jsr Pop
+	sta hol0+5
+	stx hol0+4	! restore filename pointer
+	lda #0
+	ldx #RETURN
+	jsr Sdi		! restore return area
+	rts
+
+

mach/6500/libem/sar.s

@@ -0,0 +1,23 @@
+.define Sar
+
+! This subroutine performs the SAR instruction.
+! For details see rapport IR-81.
+
+
+Sar:
+	jsr Aar		! get object address
+	ldy NBYTES+1	! the size of the object (highbyte)
+	bne 2f
+	ldy NBYTES	! the size of the object (lowbyte)
+	cpy #1
+	bne 1f		! object size is one byte
+	jmp Sti1	! put it in array
+    1:	cpy #2
+	bne 1f		! object size is two bytes
+	jmp Sti		! put it in array
+    1:	cpy #4
+	bne 2f		! object size is fourbytes
+	jmp Sdi		! put it in array
+    2:	jmp Stil	! put it in array
+
+

mach/6500/libem/sbi.s

@@ -0,0 +1,21 @@
+.define Sbi2
+
+! This subroutine subtracts two twobyte signed integers
+! and returnes the result in registerpair AX.
+
+
+Sbi2:
+	stx ARTH	! save second operand (lowbyte)
+	sta ARTH+1	! save second operand (highbyte)
+	jsr Pop
+	pha
+	sec
+	txa	 	! get first operand (lowbyte)
+	sbc ARTH	! subtract second operand (lowbyte)
+	tax
+	iny
+	pla		! get first operand (highbyte)
+	sbc ARTH+1	! subtract second operand (highbyte)
+	rts
+
+

mach/6500/libem/sbi4.s

@@ -0,0 +1,17 @@
+.define Sbi4
+
+! This subroutine subtracts two fourbyte signed integers.
+
+
+Sbi4:
+	jsr Addsub	! initiate addresses
+	sec
+    1:	lda (ADDR+2),y	! get lowbyte+y first operand
+	sbc (ADDR),y	! subtract lowbyte+y second operand
+	sta (ADDR+2),y	! put on stack lowbyte+y result
+	iny
+	inx
+	bne 1b
+	rts
+
+

mach/6500/libem/sdl.s

@@ -0,0 +1,25 @@
+.define Sdi, Sdo
+
+! The subroutine Sdi takes a fourbyte word and stores it
+! at the address in registerpair AX.
+! If the address is in zeropage, Sdo is used.
+
+
+Sdi:
+	stx ADDR	! address (lowbyte)
+	sta ADDR+1	! address (highbyte)
+Sdo:
+	ldy #0
+    1:  jsr Pop
+	pha
+	txa
+	sta (ADDR),y	! store lowbyte
+	iny
+	pla
+	sta (ADDR),y	! store highbyte
+	iny
+	cpy #4
+	bne 1b
+	rts
+
+

mach/6500/libem/set.s

@@ -0,0 +1,36 @@
+.define Set
+
+! This subroutine creates a set of n (n <= 256) bytes.
+! In this set a certain bit, which number is in registerpair AX,
+! is set. The rest is zero.
+
+
+Set:
+	stx ARTH	! save bitnumber (lowbyte)
+	sta ARTH+1	! save bitnumber (highbyte)
+	jsr Zer		! create n zerobytes
+	lda ARTH
+	and #07h	! n mod 8 (bitnumber in byte)
+	tax
+	lda #1
+	cpx #0
+	beq 2f
+    1:	asl a		! set bit (n mod 8)
+	dex
+	bne 1b
+    2:	sta ARTH+2
+	ldx #3
+    1:	lsr ARTH+1	! shiftright n 3 times (= n div 8)
+	ror ARTH	! this is the bytenumber
+	dex
+	bne 1b
+	ldy ARTH	! load bytenumber
+	lda SP+1
+	ldx SP+2
+	stx ADDR	! address of set (lowbyte)
+	sta ADDR+1	! address of set (highbyte)
+	lda ARTH+2	! get bit
+	sta (ADDR),y	! store byte with bit on
+	rts
+
+

mach/6500/libem/sli.s

@@ -0,0 +1,23 @@
+.define Sli2
+
+! This subroutine shifts a signed or unsigned interger to the
+! left n times.
+! N is in register X.
+! The returned value is in registerpair AX.
+
+
+Sli2:
+    	txa
+	bne 1f
+	jmp Pop		! zero shift, return input
+    1:	tay
+	jsr Pop		! get integer
+	stx Ytmp	! save lowbyte
+    2:	asl Ytmp
+	rol a		! shift left
+	dey
+	bne 2b
+	ldx Ytmp	! get lowbyte
+	rts
+
+

mach/6500/libem/sli4.s

@@ -0,0 +1,35 @@
+.define Sli4
+
+! This subroutine shift a signed or unsigned fourbyte integer
+! n times left. N is in register X.
+
+
+Sli4:
+	cpx #0
+	beq 9f		! zero shift, return input
+	lda SP+2	! the shifting is done on the stack
+	sta ADDR	! address of integer (lowbyte)
+	lda SP+1
+	sta ADDR+1	! address of integer (highbyte)
+    2:	ldy #0
+	clc
+	lda (ADDR),y
+	rol a
+	sta (ADDR),y
+	iny
+	lda (ADDR),y
+	rol a
+	sta (ADDR),y
+	iny
+	lda (ADDR),y
+	rol a
+	sta (ADDR),y
+	iny
+	lda (ADDR),y
+	rol a
+	sta (ADDR),y	! shift left
+	dex
+	bne 2b
+    9:	rts
+
+

mach/6500/libem/sri.s

@@ -0,0 +1,40 @@
+.define Sri2, Sru2
+
+! The subroutine Sri2 shifts a signed integer n times right.
+! In the case of a negative integer there is signextension.
+! The subroutine Sru2 shifts right an unsigned integer.
+! The returned value is in registerpair AX.
+
+
+Sru2:
+	txa
+	bne 1f
+	jmp Pop		! zero shift, return input
+    1:	tay
+	jsr Pop		! get integer
+	stx Ytmp	! save lowbyte
+	jmp 2f		! shift unsigned
+Sri2:
+	txa
+	bne 1f
+	jmp Pop		! zero shift, return input
+    1:	tay
+	jsr Pop		! get integer
+	stx Ytmp	! save lowbyte
+	tax
+	bmi 1f		! negative signextended shift
+    2:	lsr a
+	ror Ytmp	! shift not signextended
+	dey
+	bne 2b
+	ldx Ytmp	! get lowbyte
+	rts
+    1:	sec		! shift signextended
+	ror a
+	ror Ytmp
+	dey
+	bne 1b
+	ldx Ytmp	! get lowbyte
+	rts
+
+

mach/6500/libem/sri4.s

@@ -0,0 +1,52 @@
+.define Sri4, Sru4
+
+! The subroutine Sri4 shifts a signed fourbyte integer to the
+! right n times
+! N is in register X.
+! The subroutine Sru4 shifts an unsigned fourbyte integer to the
+! right n times.
+
+Sru4:
+	txa
+	tay
+	bne 1f
+	rts
+    1:	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	jmp 2f
+Sri4:
+	txa
+	tay
+	bne 1f
+	rts
+    1:	jsr Pop
+	stx ARTH
+	sta ARTH+1
+	jsr Pop
+	stx ARTH+2
+	tax
+	bmi 1f
+    2:	lsr a
+	ror ARTH+2
+	ror ARTH+1
+	ror ARTH
+    	dey
+	bne 2b
+	beq 4f
+    1:	sec
+	ror a
+	ror ARTH+2
+	ror ARTH+1
+	ror ARTH
+    3:	dey
+	bne 1b
+    4:	ldx ARTH+2
+	jsr Push
+	lda ARTH+1
+	ldx ARTH
+	jmp Push
+
+

mach/6500/libem/sti.s

@@ -0,0 +1,24 @@
+.define Sti, Sext, Stii
+
+! The subroutine Sti stores an twobyte word at the address which
+! is in registerpair AX.
+! The subroutine Sext is used when the address is already in 
+! zeropage.
+! The subroutine Stii is used when the address is in zeropage
+! and the registerpair AX contains the word.
+
+
+Sti:
+	stx ADDR	! address of word (lowbyte)
+	sta ADDR+1	! address of word (highbyte)
+Sext:
+	jsr Pop		! get word
+Stii:
+	ldy #1
+	sta (ADDR),y	! store highbyte
+	dey
+	txa
+	sta (ADDR),y	! store lowbyte
+	rts
+
+

mach/6500/libem/sti1.s

@@ -0,0 +1,16 @@
+.define Sti1
+
+! This subroutine stores an onebyte wordfractional at the address
+! which is in registerpair AX.
+
+
+Sti1:
+	stx ADDR	! address of byte (lowbyte)
+	sta ADDR+1	! address of byte (highbyte)
+	jsr Pop		! get byte
+	ldy #0
+	txa
+	sta (ADDR),y	! store byte
+	rts
+
+

mach/6500/libem/stil.s

@@ -0,0 +1,26 @@
+.define Stil
+
+! This subroutine stores indirect a block of bytes if 
+! the number of bytes is greater than four.
+! The destination address is in registerpair AX.
+! The lowbyte of the number of bytes is in Y,
+! the highbyte is in zeropage location NBYTES+1.
+
+
+Stil:
+	sta ADDR+3	! destination address (highbyte)
+	stx ADDR+2	! destination address (lowbyte)
+	sty NBYTES	! number of bytes (lowbyte)
+	clc
+	lda SP+2
+	sta ADDR	! source address (lowbyte)
+	adc NBYTES
+	sta SP+2	! new stackpointer (lowbyte)
+	lda SP+1
+	sta ADDR+1	! source address (highbyte)
+	adc NBYTES+1
+	sta SP+1	! new stackpointer (highbyte)
+	inc NBYTES+1
+	jmp Blmnp	! do the move
+
+

mach/6500/libem/stl.s

@@ -0,0 +1,17 @@
+.define Stl
+
+! This subroutine performs the storage of a local which offset
+! is to big.
+
+
+Stl:
+	jsr Locaddr	! get the local address
+	jsr Pop		! get the word
+	ldy #1
+	sta (ADDR),y	! store highbyte
+	dey
+	txa
+	sta (ADDR),y	! store lowbyte
+	rts
+
+

mach/6500/libem/sts.s

@@ -0,0 +1,28 @@
+.define Sts
+
+! This subroutine stores indirect a number of bytes.
+! The number of bytes is in the registerpair AX.
+
+
+Sts:
+	cmp #0
+	bne 3f		! number of bytes > 255
+	cpx #1
+	bne 1f		! onebyte storage
+	jsr Pop		! get the address
+	jmp Sti1	! store the byte
+    1:	cpx #2
+	bne 2f		! twobyte storage
+	jsr Pop		! get the address
+	jmp Sti		! store the word
+    2:	cpx #4
+	bne 3f		! fourbyte storage
+	jsr Pop		! get the address
+	jmp Sdi		! store the double word
+    3:	sta ARTH+1	! objectsize > 4
+	txa
+	tay
+	jsr Pop		! get address
+	jmp Stil	! store the object
+
+

mach/6500/libem/teq.s

@@ -0,0 +1,20 @@
+.define Teq
+
+! This subroutine test if the value in registerpair AX is zero
+! or nonzero.
+! The returned value, a 1 or a 0, is in AX.
+
+
+Teq:
+	tay
+	beq 1f		! A is zero
+    2:	lda #0		! AX is zero
+	tax
+	rts
+    1:	txa
+	bne 2b		! X is zero
+	lda #0		! AX is nonzero
+	ldx #1
+	rts
+
+

mach/6500/libem/test2.s

@@ -0,0 +1,19 @@
+.define Test2
+
+! This subroutine tests if the value on top of the stack is 2.
+! It is used if the size is on top of the stack.
+! The word which is to be handled is returned in registerpair AX.
+
+
+Test2:
+	tay
+	bne 1f		! value > 255
+	cpx #2
+	bne 1f		! value <> 2
+	jsr Pop		! get word
+	rts
+    1:	ldx #Eoddz
+	lda #0
+	jsr Trap
+
+

mach/6500/libem/testFFh.s

@@ -0,0 +1,23 @@
+.define TestFFh
+
+! This subroutine tests if the value on top of the stack is <= 256.
+! It is used if the istruction argument is on top of the stack.
+! The value is saved in Y.
+
+
+TestFFh:
+	cmp #2
+	bpl 1f		! value > 256
+	cmp #0
+	beq 2f
+	cpx #0
+	bne 1f		! value is zero
+    2:	dex
+	txa
+	tay
+	rts
+    1:	ldx #Eoddz
+	lda #0
+	jsr Trap
+
+

mach/6500/libem/tge.s

@@ -0,0 +1,18 @@
+.define Tge
+
+! This subroutine test if the value in registerpair AX is
+! greater than or equal to zero.
+! The result is returned in AX.
+
+
+Tge:
+	tay
+	bpl 1f		! A >= 0
+	lda #0		! AX < 0
+	tax
+	rts
+    1:	lda #0		! AX >= 0
+	ldx #1
+	rts
+
+

mach/6500/libem/tgt.s

@@ -0,0 +1,21 @@
+.define Tgt
+
+! This subroutine tests if the value in registerpair AX is
+! greater than zero.
+! The value returned is in AX.
+
+Tgt:
+	tay
+	bpl 1f		! A >= 0
+    3:	lda #0		! AX <= 0
+	tax
+	rts
+    1:	beq 1f		! A = 0
+    2:	lda #0		! AX > 0
+	ldx #1
+	rts
+    1:	txa
+	bne 2b		! X > 0
+	beq 3b		! X = 0
+
+

mach/6500/libem/tle.s

@@ -0,0 +1,22 @@
+.define Tle
+
+! This subroutine tests if the value in registerpair AX is
+! less than or equal to zero.
+! The value returned is in AX.
+
+
+Tle:
+	tay
+	bpl 1f		! A >= 0
+    3:	lda #0		! AX <= 0
+	ldx #1
+	rts
+    1:	beq 1f		! A = 0
+    2:	lda #0		! AX > 0
+	tax
+	rts
+    1:	txa
+	bne 2b		! X > 0
+	beq 3b		! x = 0
+
+