housel@en.ecn.purdue.edu (Peter S. Housel) (07/29/89)
#! /bin/sh
# This is a shell archive. Remove anything before this line, then feed it
# into a shell via "sh file" or similar. To overwrite existing files,
# type "sh file -c".
# The tool that generated this appeared in the comp.sources.unix newsgroup;
# send mail to comp-sources-unix@uunet.uu.net if you want that tool.
# If this archive is complete, you will see the following message at the end:
# "End of archive 2 (of 3)."
# Contents: Makefile addsub.x cc.c.cdif cff.x cfi.x cif.x cuf.x dvf8.x
# exp.c float.h fpp.c modf.x norm4.x norm8.x strtod.c strtod_aux.x
# trp.x
# Wrapped by housel@en.ecn.purdue.edu on Fri Jul 28 13:35:05 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'Makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'Makefile'\"
else
echo shar: Extracting \"'Makefile'\" \(2672 characters\)
sed "s/^X//" >'Makefile' <<'END_OF_FILE'
X#
X# Makefile for fpp and floating point library
X#
XCFLAGS = -f -LIB -DFLOATLIB
X
XFPPOBJS = fpp.s atof.s strtod.s strtod_aux.s ldexp.s cff.s cmf8.s \
X zrf8.s norm8.s norm4.s
X
Xfpp: $(FPPOBJS)
X cc -o fpp $(FPPOBJS)
Xfpp.s:
X cc -c fpp.c
X
XCSRCS = fabs.c pow.c exp.c sqrt.c log10.c log.c _poly.c _mult.c \
X ceil.c floor.c atof.c strtod.c printf.c fprintf.c sprintf.c \
X vprintf.c vsprintf.c vfprintf.c
XCOBJS = fabs.s pow.s exp.s sqrt.s log10.s log.s _poly.s _mult.s \
X ceil.s floor.s atof.s strtod.s printf.s fprintf.s sprintf.s \
X vprintf.s vsprintf.s vfprintf.s
XGENSRCS = frexp.x modf.x strtod_aux.x ldexp.x
XGENOBJS = frexp.s modf.s strtod_aux.s ldexp.s
XAUXSRCS = cff.x cfu.x cuf.x cif.x addsub.x cfi.x fat.x trp.x dvf8.x \
X ngf8.x mlf8.x cmf8.x zrf4.x zrf8.x norm4.x norm8.x
XAUXOBJS = cff.s cfu.s cuf.s cif.s addsub.s cfi.s fat.s trp.s dvf8.s \
X ngf8.s mlf8.s cmf8.s zrf4.s zrf8.s norm4.s norm8.s
X
XMINIX1_1SRCS = ret8.x return.x
X# MINIX1_1OBJS = ret8.s return.s
X
XLIBOBJS = ${COBJS} ${GENOBJS} ${AUXOBJS} ${MINIX1_1OBJS}
X
Xlibfp.a: ${LIBOBJS}
X ar cr libfp.a `lorder ${LIBOBJS} | tsort`
X
X.SUFFIXES: .x
X.x.s:
X -libpack < $*.x | sed '/^$$/d' > $*.s
X
Xclean:
X rm -f libfp.a fpp $(LIBOBJS) core
X
Xdepend:
X mkdep fpp.c $(CSRCS)
X
X# DO NOT DELETE THIS LINE -- mkdep uses it.
X# DO NOT PUT ANYTHING AFTER THIS LINE, IT WILL GO AWAY.
X
Xfpp.s: /usr/include/stdio.h
Xfpp.s: fpp.c
Xfabs.s: /usr/include/math.h
Xfabs.s: fabs.c
Xpow.s: /usr/include/errno.h
Xpow.s: /usr/include/limits.h
Xpow.s: /usr/include/math.h
Xpow.s: pow.c
Xexp.s: /usr/include/errno.h
Xexp.s: /usr/include/limits.h
Xexp.s: /usr/include/math.h
Xexp.s: exp.c
Xsqrt.s: /usr/include/errno.h
Xsqrt.s: /usr/include/math.h
Xsqrt.s: sqrt.c
Xlog10.s: /usr/include/math.h
Xlog10.s: log10.c
Xlog.s: /usr/include/errno.h
Xlog.s: /usr/include/math.h
Xlog.s: log.c
X_poly.s: /usr/include/math.h
X_poly.s: _poly.c
X_mult.s: /usr/include/math.h
X_mult.s: _mult.c
Xceil.s: /usr/include/math.h
Xceil.s: ceil.c
Xfloor.s: /usr/include/math.h
Xfloor.s: floor.c
Xatof.s: atof.c
Xstrtod.s: /usr/include/ctype.h
Xstrtod.s: strtod.c
Xprintf.s: /usr/include/stdarg.h
Xprintf.s: /usr/include/stdio.h
Xprintf.s: printf.c
Xfprintf.s: /usr/include/stdarg.h
Xfprintf.s: /usr/include/stdio.h
Xfprintf.s: fprintf.c
Xsprintf.s: /usr/include/stdarg.h
Xsprintf.s: /usr/include/stdio.h
Xsprintf.s: sprintf.c
Xvprintf.s: /usr/include/stdarg.h
Xvprintf.s: /usr/include/stdio.h
Xvprintf.s: vprintf.c
Xvsprintf.s: /usr/include/stdarg.h
Xvsprintf.s: /usr/include/stdio.h
Xvsprintf.s: vsprintf.c
Xvfprintf.s: /usr/include/ctype.h
Xvfprintf.s: /usr/include/stdarg.h
Xvfprintf.s: /usr/include/stdio.h
Xvfprintf.s: /usr/include/sys/types.h
Xvfprintf.s: vfprintf.c
X
X# IF YOU PUT ANYTHING HERE IT WILL GO AWAY
END_OF_FILE
if test 2672 -ne `wc -c <'Makefile'`; then
echo shar: \"'Makefile'\" unpacked with wrong size!
fi
# end of 'Makefile'
fi
if test -f 'addsub.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'addsub.x'\"
else
echo shar: Extracting \"'addsub.x'\" \(3165 characters\)
sed "s/^X//" >'addsub.x' <<'END_OF_FILE'
X.define .sbf8,.adf8
X|
X| floating point add/subtract routines
X| author: Peter S. Housel 9/21/88,01/17/89,03/19/89,5/24/89
X|
X
XV = 6 | stack offset of v
XU = V + 8 | stack offset of u
X
X .text
X .globl .sbf8,.adf8,.norm8
X.sbf8:
X push si | save register variables
X push di
X mov di,sp | di => v
X add di,#V
X xorb 7(di),*128 | negate second argument
X | fall through to adf8
X jmp 0f
X.adf8:
X push si | save register variables
X push di
X mov di,sp
X add di,#V | di => v
X0: mov si,sp
X add si,#U | si => u
X
X mov bx,6(si) | extract u.exp
X movb dh,bh | extract u.sign
X shr bx,*1
X shr bx,*1
X shr bx,*1
X shr bx,*1
X and bx,#2047 | kill sign bit
X
X mov cx,6(di) | extract v.exp
X movb dl,ch | extract v.sign
X shr cx,*1
X shr cx,*1
X shr cx,*1
X shr cx,*1
X and cx,#2047 | kill sign bit
X
X mov ax,6(si) | remove exponent from u.mantissa
X and ax,#0x0F
X test bx,bx | check for zero exponent - no leading "1"
X jz 0f | for denormalized numbers
X or ax,#0x10 | restore implied leading "1"
X0: mov 6(si),ax
X
X mov ax,6(di) | remove exponent from v.mantissa
X and ax,#0x0F
X test cx,cx | check for zero exponent - no leading "1"
X jz 0f | for denormalized numbers
X or ax,#0x10 | restore implied leading "1"
X0: mov 6(di),ax
X
X mov ax,bx
X sub ax,cx | ax = u.exp - v.exp
X movb cl,*0 | (put initial zero rounding bits in cl)
X je 4f | exponents are equal - no shifting necessary
X jg 1f | not equal but no exchange necessary
X xchg si,di | exchange u and v
X xchgb dh,dl
X sub bx,ax | bx = u.exp - (u.exp - v.exp) = v.exp
X neg ax
X1:
X cmp ax,#53 | is u so much bigger that v is not
X jge 7f | significant?
X
X movb ch,#10 | shift u left up to 10 bits to minimize loss
X2:
X shl 0(si),*1
X rcl 2(si),*1
X rcl 4(si),*1
X rcl 6(si),*1
X dec bx | decrement exponent
X dec ax
X jz 4f | done shifting altogether
X decb ch
X jnz 2b | still can shift u.mant more
X3:
X shr 6(di),*1 | shift v.mant right the rest of the way
X rcr 4(di),*1 | to line it up with u.mant
X rcr 2(di),*1
X rcr 0(di),*1
X rcrb cl,*1 | shift into rounding bits
X jnc 0f
X orb cl,*1 | make least sig bit "sticky"
X0: dec ax | loop
X jne 3b
X4:
X movb al,dh | are the signs equal?
X xorb al,dl
X andb al,*128
X je 6f | yes, no negate necessary
X
X notb cl | negate rounding bits and v.mant
X addb cl,*1
X not 0(di)
X adc 0(di),#0
X not 2(di)
X adc 2(di),#0
X not 4(di)
X adc 4(di),#0
X not 6(di)
X adc 6(di),#0
X6:
X push ax | save signs flag
X mov ax,0(di) | u.mant = u.mant + v.mant
X add 0(si),ax
X mov ax,2(di)
X adc 2(si),ax
X mov ax,4(di)
X adc 4(si),ax
X mov ax,6(di)
X adc 6(si),ax
X
X pop ax | restore u.sign ^ v.sign
X jc 7f | needn't negate
X testb al,al | opposite signs?
X je 7f | don't need to negate result
X
X notb cl | negate rounding bits and u.mant
X addb cl,*1
X not 0(si)
X adc 0(si),#0
X not 2(si)
X adc 2(si),#0
X not 4(si)
X adc 4(si),#0
X not 6(si)
X adc 6(si),#0
X xorb dh,*128 | switch sign
X7:
X movb dl,cl | put rounding bits in dl for .norm8
X mov di,sp | set destination = u
X add di,#U
X mov | if we swapped, move v onto u;
X mov | if we didn't swap, move u onto itself
X mov
X mov
X pop di | restore register variables
X pop si
X pop cx | cx = return address
X add sp,#8 | remove v from the stack
X push cx | put the return address back
X jmp .norm8
END_OF_FILE
if test 3165 -ne `wc -c <'addsub.x'`; then
echo shar: \"'addsub.x'\" unpacked with wrong size!
fi
# end of 'addsub.x'
fi
if test -f 'cc.c.cdif' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'cc.c.cdif'\"
else
echo shar: Extracting \"'cc.c.cdif'\" \(4500 characters\)
sed "s/^X//" >'cc.c.cdif' <<'END_OF_FILE'
X*** cc.c Thu Jun 22 18:52:16 1989
X--- fcc.c Thu Jun 22 18:51:13 1989
X***************
X*** 42,47 ****
X--- 42,48 ----
X char *PP = "/lib/cpp";
X char *CEM = "/lib/cem";
X char *OPT = "/usr/lib/opt";
X+ char *FPP = "/usr/lib/fpp";
X char *CG = "/usr/lib/cg";
X char *ASLD = "/usr/bin/asld";
X char *AST = "/usr/bin/ast";
X***************
X*** 54,59 ****
X--- 55,61 ----
X char *PP = "/usr/lib/cpp";
X char *CEM = "/usr/lib/cem";
X char *OPT = "/usr/lib/opt";
X+ char *FPP = "/usr/lib/fpp";
X char *CG = "/usr/lib/cg";
X char *ASLD = "/usr/bin/asld";
X char *AST = "/usr/bin/ast";
X***************
X*** 66,71 ****
X--- 68,74 ----
X char *PP = "/lib/cpp";
X char *CEM = "/lib/cem";
X char *OPT = "/lib/opt";
X+ char *FPP = "/usr/fpp";
X char *CG = "/lib/cg";
X char *ASLD = "/bin/asld";
X char *AST = "/bin/ast";
X***************
X*** 76,85 ****
X--- 79,90 ----
X #ifdef RAMDISK
X struct arglist LD_HEAD = {1, { "/lib/crtso.s" } };
X struct arglist M_LD_HEAD = {1, { "/lib/mrtso.s" } };
X+ struct arglist LD_FPLIB = {1, { "/lib/libfp.a" } };
X struct arglist LD_TAIL = {2, { "/lib/libc.a", "/lib/end.s" } };
X #else
X struct arglist LD_HEAD = {1, { "/usr/lib/crtso.s" } };
X struct arglist M_LD_HEAD = {1, { "/usr/lib/mrtso.s" } };
X+ struct arglist LD_FPLIB = {1, { "/usr/lib/libfp.a" } };
X struct arglist LD_TAIL = {2, { "/usr/lib/libc.a", "/usr/lib/end.s" } };
X #endif
X
X***************
X*** 109,114 ****
X--- 114,120 ----
X int RET_CODE = 0;
X
X struct arglist OPT_FLAGS;
X+ struct arglist FPP_FLAGS;
X struct arglist CG_FLAGS;
X struct arglist ASLD_FLAGS;
X struct arglist DEBUG_FLAGS;
X***************
X*** 121,131 ****
X int F_flag = 0; /* use pipes by default */
X int s_flag = 0;
X int p_flag = 0; /* profil flag */
X
X char *mkstr();
X char *alloc();
X
X! USTRING ifile, kfile, sfile, mfile, ofile;
X USTRING BASE;
X
X char *tmpdir = "/tmp";
X--- 127,138 ----
X int F_flag = 0; /* use pipes by default */
X int s_flag = 0;
X int p_flag = 0; /* profil flag */
X+ int f_flag = 0; /* use floating point flag */
X
X char *mkstr();
X char *alloc();
X
X! USTRING ifile, kfile, sfile, mfile, Mfile, ofile;
X USTRING BASE;
X
X char *tmpdir = "/tmp";
X***************
X*** 161,169 ****
X
X ProgCall = *argv++;
X
X! signal(SIGHUP, trapcc);
X! signal(SIGINT, trapcc);
X! signal(SIGQUIT, trapcc);
X while (--argc > 0) {
X if (*(str = *argv++) != '-') {
X append(&SRCFILES, str);
X--- 168,176 ----
X
X ProgCall = *argv++;
X
X! if (signal(SIGHUP, SIG_IGN) != SIG_IGN) signal(SIGHUP, trapcc);
X! if (signal(SIGINT, SIG_IGN) != SIG_IGN) signal(SIGINT, trapcc);
X! if (signal(SIGQUIT, SIG_IGN) != SIG_IGN) signal(SIGQUIT, trapcc);
X while (--argc > 0) {
X if (*(str = *argv++) != '-') {
X append(&SRCFILES, str);
X***************
X*** 219,224 ****
X--- 226,234 ----
X p_flag = 1;
X s_flag = 1;
X break;
X+ case 'f':
X+ f_flag = 1;
X+ break;
X case 'L':
X if (strcmp(&str[1], "LIB") == 0) {
X append(&OPT_FLAGS, "-L");
X***************
X*** 316,334 ****
X cleanup(kfile);
X }
X
X! /* .m to .s */
X! if (ext == 'm') {
X! ldfile = S_flag ? ofile : alloc(strlen(BASE) + 3);
X!
X! init(call);
X! append(call, CG);
X! concat(call, &CG_FLAGS);
X! append(call, file);
X! f = mkstr(ldfile, BASE, ".s", 0);
X append(call, f);
X if (runvec(call, (char *)0) == 0)
X continue;
X cleanup(mfile);
X file = ldfile;
X ext = 's';
X }
X--- 326,360 ----
X cleanup(kfile);
X }
X
X! /* .m to .M */
X! if (ext == 'm' && f_flag) {
X! init(call);
X! append(call, FPP);
X! concat(call, &FPP_FLAGS);
X! append(call, file);
X! f = mkstr(Mfile, tmpdir, tmpname, ".M", 0);
X append(call, f);
X if (runvec(call, (char *)0) == 0)
X continue;
X cleanup(mfile);
X+ file = Mfile;
X+ ext = 'M';
X+ }
X+
X+ /* .m (or .M) to .s */
X+ if (ext == 'm' || ext == 'M') {
X+ ldfile = S_flag ? ofile : alloc(strlen(BASE) + 3);
X+
X+ init(call);
X+ append(call, CG);
X+ concat(call, &CG_FLAGS);
X+ append(call, file);
X+ f = mkstr(ldfile, BASE, ".s", 0);
X+ append(call, f);
X+ if (runvec(call, (char *)0) == 0)
X+ continue;
X+ cleanup(mfile);
X+ cleanup(Mfile);
X file = ldfile;
X ext = 's';
X }
X***************
X*** 355,360 ****
X--- 381,387 ----
X concat(call, &M_LD_HEAD);
X else concat(call, &LD_HEAD);
X concat(call, &LDFILES);
X+ if(f_flag) concat(call, &LD_FPLIB);
X concat(call, &LD_TAIL);
X if (s_flag)
X f = SYMBOL_FILE;
END_OF_FILE
if test 4500 -ne `wc -c <'cc.c.cdif'`; then
echo shar: \"'cc.c.cdif'\" unpacked with wrong size!
fi
# end of 'cc.c.cdif'
fi
if test -f 'cff.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'cff.x'\"
else
echo shar: Extracting \"'cff.x'\" \(2066 characters\)
sed "s/^X//" >'cff.x' <<'END_OF_FILE'
X.define .cff
X|
X| floating point <=> floating point conversion routines
X| author: Peter S. Housel 06/03/89
X|
X
XBIAS4 = 0x7F - 1
XBIAS8 = 0x3FF - 1
X
X .text
X .globl .cff
X|
X| on entry dx=source size, cx=dest. size
X|
X.cff:
X cmp dx,#4
X jne cff8
Xcff4:
X cmp cx,#4
X jne cff4_8
Xcff4_4: | redundant 4-byte float to 4-byte float
X ret
Xcff4_8: | 4-byte float to 8-byte double
X cmp cx,#8
X jne ill | illegal EM op
X
X pop cx | cx = return address
X xor ax,ax | append 32 bits of zeroes
X push ax
X push ax
X push cx | put return address back
X push si
X mov si,sp
X
X mov bx,4+6(si) | extract exponent
X movb dh,bh | extract sign
X movb cl,*7
X shr bx,cl
X xorb bh,bh | kill sign bit (exponent is 8 bits)
X
X mov ax,4+6(si) | remove exponent from mantissa
X and ax,#0x7F
X test bx,bx | check for zero exponent - no leading "1"
X jz 0f | for denormalized numbers
X or ax,#0x80 | restore implied leading "1"
X0: mov 4+6(si),ax
X
X add bx,#BIAS8-BIAS4-3 | adjust bias, account for shift
X xorb dl,dl
X
X pop si | restore si
X jmp .norm8 | normalize and return
Xcff8:
X cmp dx,#8
X jne ill | illegal EM op
X
X cmp cx,#4
X jne cff8_8
Xcff8_4: | 8-byte double to 4-byte float
X push si
X mov si,sp
X
X mov bx,4+6(si) | extract exp
X movb dh,bh | extract sign
X shr bx,*1
X shr bx,*1
X shr bx,*1
X shr bx,*1
X and bx,#2047 | kill sign bit
X
X mov ax,4+6(si) | remove exponent from v.mantissa
X and ax,#0x0F
X test bx,bx | check for zero exponent - no leading "1"
X jz 0f | for denormalized numbers
X or ax,#0x10 | restore implied leading "1"
X0: mov 4+6(si),ax
X
X add bx,#BIAS4-BIAS8 | adjust bias
X
X mov cx,#3 | shift up to realign mantissa for floats
X1: shl 4+0(si),*1
X rcl 4+2(si),*1
X rcl 4+4(si),*1
X rcl 4+6(si),*1
X loop 1b
X
X movb dl,4+3(si) | set rounding bits
X mov ax,4+0(si) | check to see if sticky bit should be set
X orb al,4+2(si)
X or ax,ax
X jz 2f
X orb dl,*1 | set sticky bit
X
X2: pop si | restore si
X pop cx | cx = return address
X add sp,#4 | remove lower 32 bits
X push cx | put return address back
X jmp .norm4
Xcff8_8:
X cmp cx,#8
X jne ill | illegal EM op
X ret | redundant
X
Xill:
X pop bx
X jmp .trpilin
END_OF_FILE
if test 2066 -ne `wc -c <'cff.x'`; then
echo shar: \"'cff.x'\" unpacked with wrong size!
fi
# end of 'cff.x'
fi
if test -f 'cfi.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'cfi.x'\"
else
echo shar: Extracting \"'cfi.x'\" \(3518 characters\)
sed "s/^X//" >'cfi.x' <<'END_OF_FILE'
X.define .cfi
X|
X| floating point => integer conversion routines
X| author: Peter S. Housel 6/12/89,6/14/89
X|
X
XBIAS4 = 0x7F - 1
XBIAS8 = 0x3FF - 1
X
X .text
X .globl .cfi
X|
X| on entry dx=source size, cx=dest. size
X|
X.cfi:
X push si | save register variable
X mov si,sp
X
X cmp dx,#4
X jne cfi8
Xcfi4:
X mov bx,4+2(si) | extract exp
X movb dh,bh | extract sign
X shl bx,*1 | shift up one, then down 8
X movb bl,bh
X xorb bh,bh
X
X mov ax,4+2(si) | remove exponent from mantissa
X and ax,#0x7F
X test bx,bx | check for zero exponent - no leading "1"
X jz 0f | for denormalized numbers
X or ax,#0x80 | restore implied leading "1"
X0: mov 4+2(si),ax
X
X cmp bx,#BIAS4 | check exponent
X jl zer4 | strictly fractional, no integer part?
X cmp bx,#BIAS4+32 | is it too big to fit in a 32-bit integer?
X jg toobig
X
X1: cmp bx,#BIAS4+24 | shifted all the way down yet?
X jge 2f
X shr 4+2(si),*1 | shift down to align radix point;
X rcr 4+0(si),*1 | extra bits fall off the end (no rounding)
X inc bx
X jmp 1b
X
X2: cmp bx,#BIAS4+24 | do we have to shift up?
X jle 3f
X shl 4+0(si),*1 | shift up to align radix point
X rcl 4+2(si),*1
X dec bx
X jmp 2b
Xzer4:
X xor ax,ax | make the whole thing zero
X mov 4+0(si),ax
X mov 4+2(si),ax
X
X3: jmp cfi8b | amazingly, we can share the rest of the code
X
Xcfi8:
X cmp dx,#8
X jne ill | illegal EM op
X
X mov bx,4+6(si) | extract exp
X movb dh,bh | extract sign
X shr bx,*1
X shr bx,*1
X shr bx,*1
X shr bx,*1
X and bx,#2047 | kill sign bit
X
X mov ax,4+6(si) | remove exponent from mantissa
X and ax,#0x0F
X test bx,bx | check for zero exponent - no leading "1"
X jz 0f | for denormalized numbers
X or ax,#0x10 | restore implied leading "1"
X0: mov 4+6(si),ax
X
X cmp bx,#BIAS8 | check exponent
X jl zer8 | strictly fractional, no integer part?
X cmp bx,#BIAS8+32 | is it too big to fit in a 32-bit integer?
X jg toobig
X
X1: cmp bx,#BIAS8+53 | shifted all the way down yet?
X jge cfi8b
X shr 4+6(si),*1 | shift down to align radix point;
X rcr 4+4(si),*1 | extra bits fall off the end (no rounding)
X rcr 4+2(si),*1
X rcr 4+0(si),*1
X inc bx
X jmp 1b
Xzer8:
X xor ax,ax | make the whole thing zero
X mov 4+0(si),ax
X mov 4+2(si),ax
X mov 4+4(si),ax
X mov 4+6(si),ax
X
Xcfi8b: cmp cx,#2
X jne cfi8_4
Xcfi8_2: | 8-byte float to 2-byte integer
X mov ax,4+2(si)
X or ax,ax
X jnz toobig | too big to fit into a 16-bit integer?
X mov ax,4+0(si)
X cmp ax,#0x8000 | -32768 is a nasty evil special case
X jnz 0f
X testb dh,#128 | this had better be -32768 and not 32768
X jz toobig
X jmp 3f
X0: test ax,ax | otherwise, sign bit set? (i.e. too big?)
X js toobig
X testb dh,dh | need to negate?
X jns 3f
X neg ax
X3: pop si | restore si
X pop bx | save program counter
X xorb dh,dh | dl still contains source size
X add sp,dx | get rid of source value
X push ax | put return value on stack
X push bx | put back return address
X ret
Xcfi8_4: | 8-byte float to 4-byte integer
X cmp cx,#4
X jne ill
X mov ax,4+0(si) | put integer into registers
X mov cx,4+2(si)
X cmp cx,#0x8000 | -2147483648 is a nasty evil special case
X jnz 6f
X test ax,ax
X jnz toobig
X testb dh,#128 | this had better be -2^31 and not 2^31
X jz toobig
X jmp 8f
X6: test cx,cx | sign bit set? (i.e. too big)
X js toobig
X testb dh,dh | is it negative?
X jns 8f
X neg ax | negate
X neg cx
X sbb cx,#0
X8:
X pop si | restore si
X pop bx | save program counter
X xorb dh,dh | dl still contains source size
X add sp,dx | get rid of source value
X push cx | put return value on stack
X push ax
X push bx | put back return address
X ret
Xill:
X pop bx
X jmp .trpilin
X
XECONV = 10
X .globl .fat
Xtoobig:
X mov ax,#ECONV
X push ax
X jmp .fat
END_OF_FILE
if test 3518 -ne `wc -c <'cfi.x'`; then
echo shar: \"'cfi.x'\" unpacked with wrong size!
fi
# end of 'cfi.x'
fi
if test -f 'cif.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'cif.x'\"
else
echo shar: Extracting \"'cif.x'\" \(1680 characters\)
sed "s/^X//" >'cif.x' <<'END_OF_FILE'
X.define .cif
X|
X| floating point <=> integer conversion routines
X| author: Peter S. Housel 3/28/89
X|
X
XBIAS4 = 0x7F - 1
XBIAS8 = 0x3FF - 1
X
X .text
X .globl .cif
X|
X| on entry dx=source size, cx=dest. size
X|
X.cif:
X pop bx | save return address
X cmp dx,#2
X jne cif4
Xcif2:
X pop ax
X test ax,ax | check sign of ax
X jge 1f | nonnegative
X neg ax | take absolute value
X movb dh,*128 | set sign flag to negative
X1: push ax
X cmp cx,#4
X jne cif2_8
Xcif2_4: | 2-byte integer to 4-byte float
X xor ax,ax
X push ax | pad rest of mantissa with zeroes
X push bx | restore return address
X mov bx,#BIAS4+16-8 | radix point just after most sig. word
X xorb dl,dl | set rounding = 0
X jmp .norm4
Xcif2_8: | 2-byte integer to 8-byte double
X cmp cx,#8
X jne ill | illegal EM op
X xor ax,ax
X push ax | pad rest of mantissa with zeroes
X push ax
X push ax
X push bx | restore return address
X mov bx,#BIAS8+16-11 | radix point just after most sig. word
X xorb dl,dl | rounding = 0
X jmp .norm8
X
Xcif4:
X cmp dx,#4
X jne ill | illegal EM op
X pop ax
X pop dx
X test dx,dx | check sign of number
X jge 2f
X not ax | negate
X not dx
X inc ax
X adc dx,#0
X push dx
X movb dh,*128
X jmp 3f
X2: push dx
X3: push ax
X cmp cx,#4
X jne cif4_8
Xcif4_4: | 4-byte unsigned to 4-byte float
X push bx | restore return address
X mov bx,#BIAS4+32-8 | radix point at end
X xorb dl,dl | rounding = 0 (if positive, dh already 0)
X jmp .norm4
Xcif4_8:
X cmp cx,#8
X jne ill | illegal EM op
X xor ax,ax
X push ax | zero-fill rest of mantissa
X push ax
X push bx | restore return address
X mov bx,#BIAS8+32-11 | radix point just after first 32 bits
X xorb dl,dl | rounding = 0 (if positive, dh already 0)
X jmp .norm8
X
Xill:
X pop bx
X jmp .trpilin
END_OF_FILE
if test 1680 -ne `wc -c <'cif.x'`; then
echo shar: \"'cif.x'\" unpacked with wrong size!
fi
# end of 'cif.x'
fi
if test -f 'cuf.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'cuf.x'\"
else
echo shar: Extracting \"'cuf.x'\" \(1303 characters\)
sed "s/^X//" >'cuf.x' <<'END_OF_FILE'
X.define .cuf
X|
X| floating point <=> unsigned conversion routines
X| author: Peter S. Housel 3/28/89
X|
X
XBIAS4 = 0x7F - 1
XBIAS8 = 0x3FF - 1
X
X .text
X .globl .cuf
X|
X| on entry dx=source size, cx=dest. size
X|
X.cuf:
X pop bx | save return address
X cmp dx,#2
X jne cuf4
Xcuf2:
X cmp cx,#4
X jne cuf2_8
Xcuf2_4: | 2-byte unsigned to 4-byte float
X xor ax,ax
X push ax | pad rest of mantissa with zeroes
X push bx | restore return address
X mov bx,#BIAS4+16-8 | radix point just after most sig. word
X xor dx,dx | sign = rounding = 0
X jmp .norm4
Xcuf2_8:
X cmp cx,#8
X jne ill | illegal EM op
X xor ax,ax
X push ax | pad rest of mantissa with zeroes
X push ax
X push ax
X push bx | restore return address
X mov bx,#BIAS8+16-11 | radix point just after most sig. word
X xor dx,dx | sign = rounding = 0
X jmp .norm8
X
Xcuf4:
X cmp dx,#4
X jne ill | illegal EM op
X cmp cx,#4
X jne cuf4_8
Xcuf4_4: | 4-byte unsigned to 4-byte float
X push bx | restore return address
X mov bx,#BIAS4+32-8 | radix point at end
X xor dx,dx | sign = rounding = 0
X jmp .norm4
Xcuf4_8:
X cmp cx,#8
X jne ill | illegal EM op
X xor ax,ax
X push ax | zero-fill rest of mantissa
X push ax
X push bx | restore return address
X mov bx,#BIAS8+32-11 | radix point just after first 32 bits
X xor dx,dx | sign = rounding = 0
X jmp .norm8
X
Xill:
X pop bx
X jmp .trpilin
END_OF_FILE
if test 1303 -ne `wc -c <'cuf.x'`; then
echo shar: \"'cuf.x'\" unpacked with wrong size!
fi
# end of 'cuf.x'
fi
if test -f 'dvf8.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'dvf8.x'\"
else
echo shar: Extracting \"'dvf8.x'\" \(2526 characters\)
sed "s/^X//" >'dvf8.x' <<'END_OF_FILE'
X.define .dvf8
X|
X| floating point divide routine
X| author: Peter S. Housel 4/8/89,6/2/89,6/13/89
X|
X
XU = 14 | offset of dividend
XV = 6 | offset of divisor
XBIAS8 = 0x3FF - 1
X
X .text
X .globl .dvf8
X.dvf8:
X push si | save register variables
X push di
X
X mov si,sp | point to arguments
X
X mov bx,6+U(si) | extract u.exp
X movb dh,bh | extract u.sign
X shr bx,*1
X shr bx,*1
X shr bx,*1
X shr bx,*1
X and bx,#2047 | kill sign bit
X
X mov cx,6+V(si) | extract v.exp
X movb dl,ch | extract v.sign
X shr cx,*1
X shr cx,*1
X shr cx,*1
X shr cx,*1
X and cx,#2047 | kill sign bit
X
X mov ax,6+U(si) | remove exponent from u.mantissa
X and ax,#0x0F
X test bx,bx | check for zero exponent - no leading "1"
X jz 0f
X or ax,#0x10 | restore implied leading "1"
X0: mov 6+U(si),ax
X or ax,4+U(si)
X or ax,2+U(si)
X or ax,0+U(si)
X jz retz | dividing zero
X
X mov ax,6+V(si) | remove exponent from v.mantissa
X and ax,#0x0F
X test cx,cx | check for zero exponent - no leading "1"
X jz 0f
X or ax,#0x10 | restore implied leading "1"
X0: mov 6+V(si),ax
X or ax,4+V(si)
X or ax,2+V(si)
X or ax,0+V(si)
X jz divz | dividing by zero
X
X xorb dh,dl | xor sign bits for resultant sign
X sub bx,cx | subtract exponents,
X add bx,#BIAS8-11+1 | add bias back in, account for shift
X
X xor ax,ax | zero the quotient
X push ax
X push ax
X push ax
X push ax
X mov di,sp | di => quotient
X
X mov ax,0+V(si) | initial subtraction
X sub 0+U(si),ax
X mov ax,2+V(si)
X sbb 2+U(si),ax
X mov ax,4+V(si)
X sbb 4+U(si),ax
X mov ax,6+V(si)
X sbb 6+U(si),ax
X
X mov cx,#64 | loop on all bits
X jmp 3f | skip first shift of quotient
X2:
X shl 0(di),*1 | shift quotient
X rcl 2(di),*1
X rcl 4(di),*1
X rcl 6(di),*1
X3:
X shl 0+U(si),*1 | shift dividend
X rcl 2+U(si),*1
X rcl 4+U(si),*1
X rcl 6+U(si),*1
X
X jc 4f | if carry set, add
X
X mov ax,0+V(si) | else subtract
X sub 0+U(si),ax
X mov ax,2+V(si)
X sbb 2+U(si),ax
X mov ax,4+V(si)
X sbb 4+U(si),ax
X mov ax,6+V(si)
X sbb 6+U(si),ax
X
X orb 0(di),*1 | set bit zero of quotient
X
X loop 2b
X jmp 5f
X4:
X mov ax,0+V(si) | add (restore)
X add 0+U(si),ax
X mov ax,2+V(si)
X adc 2+U(si),ax
X mov ax,4+V(si)
X adc 4+U(si),ax
X mov ax,6+V(si)
X adc 6+U(si),ax
X
X loop 2b | loop
X5:
X add si,#U | si => u, di => quotient
X xchg si,di | reverse for move into u's location
X mov
X mov
X mov
X mov
X add sp,#8 | remove result
X9: pop di | restore register variables
X pop si
X pop cx | save return address
X add sp,#8 | remove v
X push cx | restore return address
X xorb dl,dl | zero rounding bits
X jmp .norm8
X
Xretz: xor bx,bx
X xor dx,dx
X jmp 9b
X
X .globl .fat
XEFDIVZ = 7
Xdivz:
X mov ax,#EFDIVZ
X push ax
X call .fat
END_OF_FILE
if test 2526 -ne `wc -c <'dvf8.x'`; then
echo shar: \"'dvf8.x'\" unpacked with wrong size!
fi
# end of 'dvf8.x'
fi
if test -f 'exp.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'exp.c'\"
else
echo shar: Extracting \"'exp.c'\" \(1386 characters\)
sed "s/^X//" >'exp.c' <<'END_OF_FILE'
X/* exp.c */
X
X#include <limits.h>
X#include <math.h>
X#include <errno.h>
Xextern int errno;
X
Xextern double _poly(/* double z, double coeff[], int ncoeff */);
X
X#define LOG2E 1.4426950408889633870E0 /* 1/(ln 2) */
X#define LOG2 6.9314718055994530942705877E-1 /* ln 2 */
X
Xstatic double expcoeff[] =
X {
X 1.0000000000000000000E0, /* 1/0! */
X 1.0000000000000000000E0, /* 1/1! */
X 0.5000000000000000000E0, /* 1/2! and so on */
X 0.1666666666666666667E0,
X 0.0416666666666666667E0,
X 0.0083333333333333333E0,
X 0.0013888888888888889E0,
X 1.9841269841269841270E-4,
X 2.4801587301587301587E-5,
X 2.7557319223985894396E-6,
X 2.7557319223985894396E-7,
X 2.5052108385441722582E-8,
X 2.0876756987868101412E-9, /* after 1/10! things get dubious. */
X 1.6059043836821618179E-10,
X 1.1470745597729725684E-11,
X 7.6471637318198171229E-13,
X 4.7794773323873860349E-14,
X 2.8114572543455219389E-15,
X 1.5619206968586232698E-16,
X };
X
X#define NCOEFF ((sizeof expcoeff) / sizeof(double))
X
Xdouble exp(x)
Xdouble x;
X{
X double ipart, frac;
X
X frac = modf(x * LOG2E, &ipart);
X
X if(frac > 0.5)
X {
X ipart += 1.0;
X frac -= 1.0;
X }
X else if(frac < -0.5)
X {
X ipart -= 1.0;
X frac += 1.0;
X }
X
X if(ipart < (double) INT_MIN) /* really small */
X return 0;
X else if(ipart > (double) INT_MAX) /* really big */
X ipart = (double) INT_MAX;
X
X return ldexp(_poly(frac * LOG2, expcoeff, NCOEFF), (int) ipart);
X}
END_OF_FILE
if test 1386 -ne `wc -c <'exp.c'`; then
echo shar: \"'exp.c'\" unpacked with wrong size!
fi
# end of 'exp.c'
fi
if test -f 'float.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'float.h'\"
else
echo shar: Extracting \"'float.h'\" \(747 characters\)
sed "s/^X//" >'float.h' <<'END_OF_FILE'
X/* float.h */
X/* Produced by config version 4.1, CWI, Amsterdam */
X/* (on an Ardent Titan)
X/* hand-modified by Peter S. Housel */
X
X#define FLT_RADIX 2
X#define FLT_MANT_DIG 24
X#define FLT_DIG 6
X#define FLT_ROUNDS 1
X#define FLT_EPSILON ((float)1.19209290e-07)
X#define FLT_MIN_EXP (-125)
X#define FLT_MIN ((float)1.17549435e-38)
X#define FLT_MIN_10_EXP (-37)
X#define FLT_MAX_EXP 128
X#define FLT_MAX ((float)3.40282347e+38)
X#define FLT_MAX_10_EXP 38
X
X#define DBL_MANT_DIG 53
X#define DBL_DIG 15
X#define DBL_EPSILON 2.2204460492503130e-16
X#define DBL_MIN_EXP (-1021)
X#define DBL_MIN 2.2250738585072022e-308
X#define DBL_MIN_10_EXP (-307)
X#define DBL_MAX_EXP 1024
X#define DBL_MAX 1.7976931348623159e+308
X#define DBL_MAX_10_EXP 308
END_OF_FILE
if test 747 -ne `wc -c <'float.h'`; then
echo shar: \"'float.h'\" unpacked with wrong size!
fi
# end of 'float.h'
fi
if test -f 'fpp.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'fpp.c'\"
else
echo shar: Extracting \"'fpp.c'\" \(13586 characters\)
sed "s/^X//" >'fpp.c' <<'END_OF_FILE'
X/* file: fpp.c
X * EM floating-point-translator for i8088 Minix
X * (EXTREMELY machine and compiler-dependant!)
X * author: Peter S. Housel 6/12/89
X */
X
X#include <stdio.h>
X/* #include <stddef.h> */
X/* #include <stdlib.h> */
X
Xunion munge /* type-punning */
X {
X double dpart;
X float fpart;
X int ipart[4];
X };
X
Xextern double atof(/* const char * */);
X
Xmain(argc, argv)
Xint argc; char *argv[];
X{
X if(++argv, --argc)
X if(strcmp(*argv, "-") != 0)
X if(freopen(*argv, "rb", stdin) == NULL)
X {
X fprintf(stderr, "fpp: can't open %s for input\n", *argv);
X exit(1);
X }
X
X if(++argv, --argc)
X if(strcmp(*argv, "-") != 0)
X if(freopen(*argv, "wb", stdout) == NULL)
X {
X fprintf(stderr, "fpp: can't open %s for output\n", *argv);
X exit(1);
X }
X
X if(argc > 1)
X {
X fprintf(stderr, "fpp: usage: fpp [infile] [outfile]\n");
X exit(1);
X }
X
X filein();
X
X exit(0);
X}
X
Xstruct instrtab
X {
X char *iname; /* instruction name */
X char tag; /* argument description tag */
X };
X
Xstruct instrtab itab[] = { /* EM instructions */
X"NON", '-', /* [Illegal instruction] */
X"AAR", 'w', /* Load address of array element */
X"ADF", 'w', /* Floating add */
X"ADI", 'w', /* Addition */
X"ADP", 'f', /* Add f to pointer on top of stack */
X"ADS", 'w', /* Add w-byte value and pointer */
X"ADU", 'w', /* Addition */
X"AND", 'w', /* Boolean and on two groups of w bytes */
X"ASP", 'f', /* Adjust the stack pointer by f */
X"ASS", 'w', /* Adjust the stack pointer by w-byte integer */
X"BEQ", 'b', /* Branch equal */
X"BGE", 'b', /* Branch greater or equal */
X"BGT", 'b', /* Branch greater */
X"BLE", 'b', /* Branch less or equal */
X"BLM", 'z', /* Block move z bytes; first pop dest. addr, then source */
X"BLS", 'w', /* Block move, size is in w-byte integer on top of stack */
X"BLT", 'b', /* Branch less (pop 2 words, branch if top > second) */
X"BNE", 'b', /* Branch not equal */
X"BRA", 'b', /* Branch unconditionally to label b */
X"CAI", '-', /* Call procedure (procedure identifier on stack) */
X"CAL", 'p', /* Call procedure (with identifier p) */
X"CFF", '-', /* Convert floating to floating */
X"CFI", '-', /* Convert floating to integer */
X"CFU", '-', /* Convert floating to unsigned */
X"CIF", '-', /* Convert integer to floating */
X"CII", '-', /* Convert integer to integer */
X"CIU", '-', /* Convert integer to unsigned */
X"CMF", 'w', /* Compare w byte reals */
X"CMI", 'w', /* Compare w byte int, push neg., zero, pos. for <, = or > */
X"CMP", '-', /* Compare pointers */
X"CMS", 'w', /* Compare w byte values, used only for bit equality test */
X"CMU", 'w', /* Compare w byte unsigneds */
X"COM", 'w', /* Complement (one's complement of top w bytes) */
X"CSA", 'w', /* Case jump; address of jump table at top of stack */
X"CSB", 'w', /* Table lookup jump; address of jump table at top of stack */
X"CUF", '-', /* Convert unsigned to floating */
X"CUI", '-', /* Convert unsigned to integer */
X"CUU", '-', /* Convert unsigned to unsigned */
X"DCH", '-', /* Follow dynamic chain, convert LB to LB of caller */
X"DEC", '-', /* Decrement word on top of stack by 1 */
X"DEE", 'g', /* Decrement external */
X"DEL", 'l', /* Decrement local or parameter */
X"DUP", 's', /* Duplicate top s bytes */
X"DUS", 'w', /* Duplicate top w bytes */
X"DVF", 'w', /* Floating divide */
X"DVI", 'w', /* Division */
X"DVU", 'w', /* Division */
X"EXG", 'w', /* Exchange top w bytes */
X"FEF", 'w', /* Split floating number in exponent and fraction part */
X"FIF", 'w', /* Floating multiply and split integer and fraction part */
X"FIL", 'g', /* File name (external 4 := g) */
X"GTO", 'g', /* Non-local goto, descriptor at g */
X"INC", '-', /* Increment word on top of stack by 1 */
X"INE", 'g', /* Increment external */
X"INL", 'l', /* Increment local or parameter */
X"INN", 'w', /* Bit test on w byte set (bit number on top of stack) */
X"IOR", 'w', /* Boolean inclusive or on two groups of w bytes */
X"LAE", 'g', /* Load address of external */
X"LAL", 'l', /* Load address of local or parameter */
X"LAR", 'w', /* Load array element, desc. contains integers of size w */
X"LDC", 'd', /* Load double constant ( push two words ) */
X"LDE", 'g', /* Load double external (two consec. externals are stacked) */
X"LDF", 'f', /* Load double offsetted (top of stack + f yield address) */
X"LDL", 'l', /* Load double local or parameter (2 consec. words stacked) */
X"LFR", 's', /* Load function result */
X"LIL", 'l', /* Load word pointed to by l-th local or parameter */
X"LIM", '-', /* Load 16 bit ignore mask */
X"LIN", 'n', /* Line number (external 0 := n) */
X"LNI", '-', /* Line number increment */
X"LOC", 'c', /* Load constant (i.e. push one word onto the stack) */
X"LOE", 'g', /* Load external word g */
X"LOF", 'f', /* Load offsetted (top of stack + f yield address) */
X"LOI", 'o', /* Load indirect o bytes (address is popped from the stack) */
X"LOL", 'l', /* Load word at l-th local (l<0) or parameter (l>=0) */
X"LOR", 'r', /* Load register (0=LB, 1=SP, 2=HP) */
X"LOS", 'w', /* Load indirect, w-byte integer on stack top gives size */
X"LPB", '-', /* Convert local base to argument base */
X"LPI", 'p', /* Load procedure identifier */
X"LXA", 'n', /* Load lexical (address of AB n static levels back) */
X"LXL", 'n', /* Load lexical (address of LB n static levels back) */
X"MLF", 'w', /* Floating multiply */
X"MLI", 'w', /* Multiplication */
X"MLU", 'w', /* Multiplication */
X"MON", '-', /* Monitor call */
X"NGF", 'w', /* Floating negate */
X"NGI", 'w', /* Negate (two's complement) */
X"NOP", '-', /* No operation */
X"RCK", 'w', /* Range check; trap on error */
X"RET", 'z', /* Return (function result consists of top z bytes) */
X"RMI", 'w', /* Remainder */
X"RMU", 'w', /* Remainder */
X"ROL", 'w', /* Rotate left a group of w bytes */
X"ROR", 'w', /* Rotate right a group of w bytes */
X"RTT", '-', /* Return from trap */
X"SAR", 'w', /* Store array element */
X"SBF", 'w', /* Floating subtract */
X"SBI", 'w', /* Subtraction */
X"SBS", 'w', /* Subtract pointers in same fragment and push diff as size w integer */
X"SBU", 'w', /* Subtraction */
X"SDE", 'g', /* Store double external */
X"SDF", 'f', /* Store double offsetted */
X"SDL", 'l', /* Store double local or parameter */
X"SET", 'w', /* Create singleton w byte set with bit n on (n is top of stack) */
X"SIG", '-', /* Trap errors to proc identifier on top of stack, -2 resets default */
X"SIL", 'l', /* Store into word pointed to by l-th local or parameter */
X"SIM", '-', /* Store 16 bit ignore mask */
X"SLI", 'w', /* Shift left */
X"SLU", 'w', /* Shift left */
X"SRI", 'w', /* Shift right */
X"SRU", 'w', /* Shift right */
X"STE", 'g', /* Store external */
X"STF", 'f', /* Store offsetted */
X"STI", 'o', /* Store indirect o bytes (pop address, then data) */
X"STL", 'l', /* Store local or parameter */
X"STR", 'r', /* Store register (0=LB, 1=SP, 2=HP) */
X"STS", 'w', /* Store indirect, w-byte integer on top of stack gives object size */
X"TEQ", '-', /* True if equal, i.e. iff top of stack = 0 */
X"TGE", '-', /* True if greater or equal, i.e. iff top of stack >= 0 */
X"TGT", '-', /* True if greater, i.e. iff top of stack > 0 */
X"TLE", '-', /* True if less or equal, i.e. iff top of stack <= 0 */
X"TLT", '-', /* True if less, i.e. iff top of stack < 0 */
X"TNE", '-', /* True if not equal, i.e. iff top of stack non zero */
X"TRP", '-', /* Cause trap to occur (Error number on stack) */
X"XOR", 'w', /* Boolean exclusive or on two groups of w bytes */
X"ZEQ", 'b', /* Branch equal zero */
X"ZER", 'w', /* Load w zero bytes */
X"ZGE", 'b', /* Branch greater or equal zero */
X"ZGT", 'b', /* Branch greater than zero */
X"ZLE", 'b', /* Branch less or equal to zero */
X"ZLT", 'b', /* Branch less than zero (pop 1 word, branch negative) */
X"ZNE", 'b', /* Branch not zero */
X"ZRE", 'g', /* Zero external */
X"ZRF", 'w', /* Load a floating zero of size w */
X"ZRL", 'l' /* Zero local or parameter */
X};
X
Xstruct instrtab ptab[] = { /* EM pseudo-ops */
X"BSS", '3', /* Reserve storage */
X"CON", '*', /* Initialized constants */
X"END", 'B', /* End of procedure */
X"EXA", '1', /* External name */
X"EXC", '2', /* Exchange instruction blocks */
X"EXP", '1', /* External procedure identifier */
X"HOL", '3', /* Reserve global(?) storage */
X"INA", '1', /* Internal name */
X"INP", '1', /* Internal procedure name */
X"MES", '*', /* Back-end hints */
X"PRO", 'A', /* Start of procedure */
X"ROM", '*' /* Read-only constants */
X};
X
Xfilein()
X{
X int ins;
X
X /* copy magic number */
X if(getchar() != 0255)
X {
X fprintf(stderr, "fpp: bad EM file magic number\n");
X exit(1);
X }
X putchar(0255);
X if(getchar() != 0)
X {
X fprintf(stderr, "fpp: bad EM file magic number\n");
X exit(1);
X }
X putchar(0);
X
X /* neutral state */
X while((ins = getchar()) != EOF)
X {
X if(0 <= ins && ins < sizeof itab / sizeof (struct instrtab))
X { /* instruction */
X putchar(ins);
X if(itab[ins].tag != '-')
X doargs(itab[ins].tag);
X }
X else if(150 <= ins && ins < 150+(sizeof ptab)/sizeof(struct instrtab))
X { /* pseudo-op */
X putchar(ins);
X doargs(ptab[ins - 150].tag);
X }
X else if(180 <= ins && ins < 240)
X { /* instruction label */
X putchar(ins);
X }
X else if(240 <= ins && ins < 245)
X { /* instruction label */
X doarg(ins);
X }
X else
X {
X putchar(ins);
X fprintf(stderr, "illegal instruction byte %d\n", ins);
X }
X }
X}
X
Xdoargs(tag)
Xint tag;
X{
X int argbyte;
X
X switch(tag)
X {
X case '3': /* three args */
X doarg(getchar());
X /* FALLTHRU */
X case '2': /* two args */
X doarg(getchar());
X /* FALLTHRU */
X case '1': /* one arg, of one of several types */
X case 'c':
X case 'd':
X case 'l':
X case 'g':
X case 'f':
X case 'n':
X case 's':
X case 'z':
X case 'o':
X case 'p':
X case 'b':
X case 'r':
X doarg(getchar());
X break;
X
X case 'B': /* one (optional) arg */
X case 'w':
X if((argbyte = getchar()) != 255)
X doarg(argbyte);
X else
X putchar(argbyte);
X break;
X
X case '*': /* any number of args */
X while((argbyte = getchar()) != 255)
X doarg(argbyte);
X putchar(255);
X break;
X
X case 'A': /* one arg, one optional arg */
X doarg(getchar());
X if((argbyte = getchar()) != 255)
X {
X doarg(argbyte);
X }
X else
X putchar(255);
X break;
X }
X}
X
Xdoarg(byte)
Xint byte;
X{
X int b1, b2, b3, b4;
X int length;
X int i;
X
X if(byte == EOF)
X {
X fprintf(stderr, "Unexpected eof\n");
X exit(1);
X }
X
X if(byte != 253) /* special case floating point constant */
X putchar(byte);
X
X if(0 <= byte && byte < 240)
X {
X /* nothing */
X }
X else
X switch(byte)
X {
X case 240: /* 1-byte instruction label */
X putchar(getchar());
X break;
X case 241: /* 2-byte instruction label */
X b1 = getchar(); putchar(b1);
X b2 = getchar(); putchar(b2);
X break;
X case 242: /* 1-byte data label */
X putchar(getchar());
X break;
X case 243: /* 2-byte data label */
X b1 = getchar(); putchar(b1);
X b2 = getchar(); putchar(b2);
X break;
X case 244: /* global symbol */
X length = getcst();
X putcst(length);
X while(length--)
X putchar(getchar());
X break;
X case 245: /* 2-byte integer constant */
X b1 = getchar(); putchar(b1);
X b2 = getchar(); putchar(b2);
X break;
X case 246: /* 4-byte integer constant */
X b1 = getchar(); putchar(b1);
X b2 = getchar(); putchar(b2);
X b3 = getchar(); putchar(b3);
X b4 = getchar(); putchar(b4);
X break;
X case 247: /* 8-byte integer constant */
X length = 8;
X while(length--)
X putchar(getchar());
X break;
X case 248: /* global label + constant */
X doarg(getchar());
X putcst(getcst());
X break;
X case 249: /* procedure name */
X length = getcst();
X putcst(length);
X while(length--)
X putchar(getchar());
X break;
X case 250: /* string */
X length = getcst();
X putcst(length);
X while(length--)
X putchar(getchar());
X break;
X case 251: /* integer constant */
X putcst(getcst());
X length = getcst();
X putcst(length);
X while(length--)
X putchar(getchar());
X break;
X case 252: /* unsigned constant */
X putcst(getcst());
X length = getcst();
X putcst(length);
X while(length--)
X putchar(getchar());
X break;
X case 253: /* floating constant */
X if((i = getcst()) == 8 || i == 4)
X {
X char buf[512]; /* for reading ASCII constant */
X char *bufp;
X union munge number;
X
X length = getcst();
X bufp = &buf[0];
X while(length-- && (bufp - buf) < (sizeof buf) - 1)
X *bufp++ = getchar();
X *bufp = '\0';
X
X if(i == 8)
X {
X number.dpart = atof(buf); /* convert to a double, */
X putcst(number.ipart[0]); /* then write out each */
X putcst(number.ipart[1]); /* of the words that makes */
X putcst(number.ipart[2]); /* it up as a 16-bit */
X putcst(number.ipart[3]); /* integer constant */
X }
X else
X {
X number.fpart = (float) atof(buf);
X putcst(number.ipart[0]);
X putcst(number.ipart[1]);
X }
X }
X else
X fprintf(stderr, "Illegal floating-point constant size\n");
X break;
X case 254:
X case 255:
X fprintf(stderr, "Illegal argument type %d\n", byte);
X }
X}
X
Xint getcst()
X{
X int b1, b2;
X int type;
X
X type = getchar();
X if(0 <= type && type < 240) /* short constant */
X return type - 120;
X
X if(type != 245)
X {
X fprintf(stderr, "Illegal constant argument type %d\n", type);
X }
X
X b1 = getchar(); /* 16-bit integer constant */
X b2 = getchar();
X return 256 * b2 + b1;
X}
X
Xputcst(number)
Xint number;
X{
X if(-120 <= number && number < 120)
X {
X putchar(number + 120); /* short constant */
X return;
X }
X
X putchar(245); /* 16-bit integer constant */
X putchar(number & 255);
X putchar((number >> 8) & 255);
X}
END_OF_FILE
if test 13586 -ne `wc -c <'fpp.c'`; then
echo shar: \"'fpp.c'\" unpacked with wrong size!
fi
# end of 'fpp.c'
fi
if test -f 'modf.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'modf.x'\"
else
echo shar: Extracting \"'modf.x'\" \(1734 characters\)
sed "s/^X//" >'modf.x' <<'END_OF_FILE'
X.define _modf
X
XBIAS8 = 0x3ff - 1
X
X .globl _modf
X .text
X_modf:
X push bp
X mov bp,sp
X push si
X mov si,12(bp) | si -> ipart
X
X mov bx,4+6(bp) | extract value.exp
X movb dh,bh | extract value.sign
X shr bx,*1
X shr bx,*1
X shr bx,*1
X shr bx,*1
X and bx,#2047 | kill sign bit
X
X cmp bx,#BIAS8
X jge 1f | fabs(value) >= 1.0
X
X xor ax,ax | store zero as the integer part
X mov 0(si),ax
X mov 2(si),ax
X mov 4(si),ax
X mov 6(si),ax
X
X lea bx,4(bp) | return entire value as fractional part
X mov cx,#8
X call .loi
X9: call .ret8
X jmp .sret
X
X1:
X cmp bx,#BIAS8+53 | all integer, with no fractional part?
X jl 2f | no, mixed
X
X lea bx,4(bp) | store entire value as the integer part
X mov cx,#8
X call .loi
X mov bx,si
X mov cx,#8
X call .sti
X
X call .zrf8
X jmp 9b | return zero as fractional part
X
X2:
X mov ax,4+6(bp) | remove exponent from value.mantissa
X and ax,#0x0F
X or ax,#0x10 | restore implied leading "1"
X0: mov 4+6(bp),ax
X
X xor ax,ax | push a zero fractional part
X push ax
X push ax
X push ax
X push ax
X
X4:
X shr 4+6(bp),*1 | shift integer part
X rcr 4+4(bp),*1
X rcr 4+2(bp),*1
X rcr 4+0(bp),*1
X
X rcr -10+6(bp),*1 | shift high bit into fractional part
X rcr -10+4(bp),*1
X rcr -10+2(bp),*1
X rcr -10+0(bp),*1
X
X inc cx | increment frac part exponent
X inc bx | increment ipart exponent
X cmp bx,#BIAS8+53 | done?
X jl 4b | keep shifting
X
X movb dl,*0 | clear rounding bits
X push dx | save sign and rounding bits
X
X push 4+6(bp) | push the integer part
X push 4+4(bp)
X push 4+2(bp)
X push 4+0(bp)
X
X call .norm8 | renormalize the integer part
X
X mov bx,si | store indirectly through the pointer
X mov cx,#8
X call .sti
X
X pop dx | dx = frac part sign and rounding
X mov bx,#BIAS8-11 | bx = frac part exponent
X call .norm8 | normalize frac part
X jmp 9b | return frac part
END_OF_FILE
if test 1734 -ne `wc -c <'modf.x'`; then
echo shar: \"'modf.x'\" unpacked with wrong size!
fi
# end of 'modf.x'
fi
if test -f 'norm4.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'norm4.x'\"
else
echo shar: Extracting \"'norm4.x'\" \(1618 characters\)
sed "s/^X//" >'norm4.x' <<'END_OF_FILE'
X.define .norm4
X
X .globl .norm4
X|
X| on entry to norm4:
X| bx=u.exp dh=u.sign dl=rounding bits
X.norm4:
X push si | save register variables
X mov si,sp | si => u
X add si,#4
X
X mov ax,0(si) | rounding and u.mant == 0?
X orb al,dl
X or ax,2(si)
X jz retz
X1:
X mov ax,2(si) | divide (shift) until
X and ax,#0xff00 | no bits above 23
X jz 2f
X shr 2(si),*1
X rcr 0(si),*1
X rcrb dl,*1 | shift into rounding bits
X jnc 0f | make least sig bit "sticky"
X orb dl,*1
X0: inc bx | increment exponent
X jmp 1b
X2:
X mov ax,2(si) | multiply (shift) until
X and ax,#0xff80 | one in "implied" position
X jnz 3f
X shlb dl,*1 | some doubt about this one *
X rcl 0(si),*1
X rcl 2(si),*1
X dec bx | decrement exponent
X jmp 2b
X3:
X testb dl,dl | check rounding bits
X jge 5f | round down - no action necessary
X negb dl
X jge 4f | round up
X and 0(si),#0xfffe | tie case - round to even
X jmp 5f
X4:
X xorb dl,dl | zero rounding bits
X add 0(si),#1 | round up
X adc 2(si),#0
X jmp 1b | go back and renormalize just in case
X5:
X cmp bx,#0 | check for exponent overflow or underflow
X jle retz
X cmp bx,#255
X jge oflow
X6:
X movb cl,*7 | re-position exponent
X shl bx,cl
X mov ax,2(si)
X and ax,#0x7f | top mantissa bits
X or ax,bx | insert exponent
X andb dh,*128 | sign bit
X orb ah,dh | insert sign bit
X mov 2(si),ax
X pop si | restore register variables
X ret
X
Xretz:
X xor bx,bx | exponent = 0,
X mov dx,bx | sign = 0, rounding = 0,
X mov 0(si),bx | mantissa = 0
X mov 2(si),bx
X jmp 6b
X
X .globl .fat
XECONV = 10
X mov ax,#ECONV
X push ax
X jmp .fat
X
XEFOVFL = 4
Xoflow:
X mov ax,#EFOVFL
X push ax
X jmp .fat
X
X|EFUNFL = 5
X|uflow:
X| mov ax,#EFUNFL
X| push ax
X| jmp .fat
END_OF_FILE
if test 1618 -ne `wc -c <'norm4.x'`; then
echo shar: \"'norm4.x'\" unpacked with wrong size!
fi
# end of 'norm4.x'
fi
if test -f 'norm8.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'norm8.x'\"
else
echo shar: Extracting \"'norm8.x'\" \(1780 characters\)
sed "s/^X//" >'norm8.x' <<'END_OF_FILE'
X.define .norm8
X
X .globl .norm8
X|
X| on entry to norm8:
X| bx=u.exp dh=u.sign dl=rounding bits
X.norm8:
X push si | save register variables
X mov si,sp | si => u
X add si,#4
X
X mov ax,0(si) | rounding and u.mant == 0?
X orb al,dl
X or ax,2(si)
X or ax,4(si)
X or ax,6(si)
X jz retz
X1:
X mov ax,6(si) | divide (shift) until
X and ax,#0xffe0 | no bits above 53
X jz 2f
X shr 6(si),*1
X rcr 4(si),*1
X rcr 2(si),*1
X rcr 0(si),*1
X rcrb dl,*1 | shift into rounding bits
X jnc 0f | make least sig bit "sticky"
X orb dl,*1
X0: inc bx | increment exponent
X jmp 1b
X2:
X mov ax,6(si) | multiply (shift) until
X and ax,#0xfff0 | one in "implied" position
X jnz 3f
X shlb dl,*1 | some doubt about this one *
X rcl 0(si),*1
X rcl 2(si),*1
X rcl 4(si),*1
X rcl 6(si),*1
X dec bx | decrement exponent
X jmp 2b
X3:
X testb dl,dl | check rounding bits
X jge 5f | round down - no action necessary
X negb dl
X jge 4f | round up
X and 0(si),#0xfffe | tie case - round to even
X jmp 5f
X4:
X xorb dl,dl | zero rounding bits
X add 0(si),#1 | round up
X adc 2(si),#0
X adc 4(si),#0
X jnc 5f | no chance of "rounding overflow"
X adc 6(si),#0 | some chance of rounding overflow - go
X jmp 1b | back and renormalize just in case
X5:
X cmp bx,#0 | check for exponent underflow
X jle retz
X cmp bx,#2047 | check for exponent overflow
X jge oflow
X6:
X shl bx,*1 | re-position exponent
X shl bx,*1
X shl bx,*1
X shl bx,*1
X mov ax,6(si)
X and ax,#0xf | top mantissa bits
X or ax,bx | insert exponent
X andb dh,*128 | sign bit
X orb ah,dh | insert sign bit
X mov 6(si),ax
X pop si
X ret
X
Xretz:
X xor bx,bx | exponent = 0,
X mov dx,bx | sign = 0, rounding = 0
X mov 0(si),bx
X mov 2(si),bx
X mov 4(si),bx
X mov 6(si),bx
X jmp 6b
X
XEFOVFL = 4
X .globl .fat
Xoflow:
X mov ax,#EFOVFL
X push ax
X jmp .fat
X
X|EFUNFL = 5
X|uflow:
X| mov ax,#EFUNFL
X| push ax
X| jmp .fat
END_OF_FILE
if test 1780 -ne `wc -c <'norm8.x'`; then
echo shar: \"'norm8.x'\" unpacked with wrong size!
fi
# end of 'norm8.x'
fi
if test -f 'strtod.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'strtod.c'\"
else
echo shar: Extracting \"'strtod.c'\" \(1737 characters\)
sed "s/^X//" >'strtod.c' <<'END_OF_FILE'
X/* file: strtod.c */
X
X#include <ctype.h>
X/* #include <stddef.h> */
X/* #include <stdlib.h> */
X
X#ifndef NULL
X#define NULL 0
X#endif
X
X#define MSIGN 1 /* mantissa has negative sign */
X#define ESIGN 2 /* exponent has negative sign */
X#define DECPT 4 /* decimal point encountered */
X
Xdouble strtod(s, endp)
Xregister char *s;
Xchar **endp;
X{
X int flags = 0;
X int decexp = 0; /* decimal exponent */
X double value = 0; /* accumulated value - actually */
X /* a 64-bit integer */
X
X extern int _mul10add(/* double *valuep, int digit */);
X extern double _adjust(/* double *valuep, int decexp, int negflag */);
X
X while(isspace(*s)) /* skip leading white space */
X ++s;
X
X if(*s == '+')
X ++s;
X else if(*s == '-')
X {
X ++s;
X flags |= MSIGN; /* mantissa is negative */
X }
X
X for(; ; ++s)
X {
X if(isdigit(*s))
X {
X if(_mul10add(&value, *s - '0'))
X ++decexp;
X if(flags & DECPT)
X --decexp;
X }
X else if(*s == '.')
X {
X flags |= DECPT;
X }
X else
X break;
X }
X
X if(*s == 'e' || *s == 'E')
X {
X int eacc = 0; /* exponent accumulator */
X
X ++s;
X
X if(*s == '+')
X ++s;
X else if(*s == '-')
X {
X ++s;
X flags |= ESIGN; /* decimal exponent is negative */
X }
X
X while(isdigit(*s))
X {
X if(eacc < 1000)
X eacc = eacc * 10 + (*s - '0');
X ++s;
X }
X
X if(flags & ESIGN)
X decexp -= eacc;
X else
X decexp += eacc;
X }
X
X if(decexp > 350) /* outrageously large */
X decexp = 350;
X else if(decexp < -350) /* outrageously small */
X decexp = -350;
X
X if(endp != (char **)NULL) /* store endp if desired */
X *endp = s;
X
X if(value == 0)
X return 0;
X else
X return _adjust(&value, decexp, flags & MSIGN);
X}
END_OF_FILE
if test 1737 -ne `wc -c <'strtod.c'`; then
echo shar: \"'strtod.c'\" unpacked with wrong size!
fi
# end of 'strtod.c'
fi
if test -f 'strtod_aux.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'strtod_aux.x'\"
else
echo shar: Extracting \"'strtod_aux.x'\" \(3370 characters\)
sed "s/^X//" >'strtod_aux.x' <<'END_OF_FILE'
X.define __mul10add,__adjust
X
X|
X| auxiliary routines for strtod()
X| author: Peter S. Housel 6/3/89
X|
X
XBIAS8 = 0x3FF - 1
X
X .globl __mul10add
X .text
X__mul10add:
X push bp
X mov bp,sp
X push si
X mov si,4(bp)
X
X mov ax,#1 | return 1 if overflow
X cmp 6(si),#3276 | would this digit cause overflow?
X jg 1f
X
X shl 0(si),*1 | multiply accumulator by 10 - first
X rcl 2(si),*1 | we multiply by two
X rcl 4(si),*1
X rcl 6(si),*1
X
X push 6(si) | save 2x value
X push 4(si)
X push 2(si)
X push 0(si)
X
X shl 0(si),*1 | multiply by four, to make this
X rcl 2(si),*1 | 8x the original accumuator
X rcl 4(si),*1
X rcl 6(si),*1
X shl 0(si),*1
X rcl 2(si),*1
X rcl 4(si),*1
X rcl 6(si),*1
X
X pop ax | add 2x value back in
X add 0(si),ax
X pop ax
X adc 2(si),ax
X pop ax
X adc 4(si),ax
X pop ax
X adc 6(si),ax
X
X mov ax,6(bp) | get digit value
X add 0(si),ax | add it in
X adc 2(si),#0
X adc 4(si),#0
X adc 6(si),#0
X
X xor ax,ax | return zero overflow flag
X1: jmp .sret
X
X
X .globl __adjust
X__adjust:
X push bp
X mov bp,sp
X push si | si => 64-bit accumulator
X mov si,4(bp)
X push di | di = decimal exponent
X mov di,6(bp)
X
X mov bx,#0 | bx = binary scale factor
X test di,di | check decimal exponent
X jz 9f | if zero, no scaling necessary
X js 4f | if negative, do division loop
X
X1: cmp 6(si),#6553 | compare with 2^15 / 5
X jb 2f | no danger of overflow?
X shr 6(si),*1 | could overflow; divide by two
X rcr 4(si),*1 | to prevent it
X rcr 2(si),*1
X rcr 0(si),*1
X inc bx | increment scale factor to compensate
X jmp 1b | try again to see if we're ok now
X2: | now we multiply by 5:
X push 6(si) | save 1x value
X push 4(si)
X push 2(si)
X push 0(si)
X
X shl 0(si),*1 | multiply by four,
X rcl 2(si),*1
X rcl 4(si),*1
X rcl 6(si),*1
X
X shl 0(si),*1
X rcl 2(si),*1
X rcl 4(si),*1
X rcl 6(si),*1
X
X pop ax | add 1x value back in
X add 0(si),ax
X pop ax
X adc 2(si),ax
X pop ax
X adc 4(si),ax
X pop ax
X adc 6(si),ax
X
X inc bx | increment scale factor to make this
X | a multiplication by 10
X sub di,#1 | decrement decimal exponent
X jnz 1b | keep scaling if not done
X
X jmp 9f | done with multiplication loop
X
X4:
X test 6(si),#0xC000 | make sure upper bits set to preserve
X jnz 5f | as much precision as possible
X shl 0(si),*1 | if not, multiply by 2
X rcl 2(si),*1
X rcl 4(si),*1
X rcl 6(si),*1
X dec bx | decrement scale factor to compensate
X jmp 4b | and check again
X5:
X mov cx,#5 | division by 5
X xor dx,dx | start off with zero remainder
X mov ax,6(si) | get word
X div cx | divide dx/ax by 5
X mov 6(si),ax | store result; dx contains remainder
X mov ax,4(si)
X div cx
X mov 4(si),ax
X mov ax,2(si)
X div cx
X mov 2(si),ax
X mov ax,0(si)
X div cx
X mov 0(si),ax
X
X dec bx | increment scale factor to make this
X | a division by 10
X add di,#1 | increment decimal exponent
X jnz 4b | keep looping if not done
X
X9: push bx | scale factor; multiplier for ldexp()
X
X push 6(si) | copy value onto stack
X push 4(si)
X push 2(si)
X push 0(si)
X
X xor dx,dx | sign = 0, rounding bits = 0
X mov ax,8(bp) | check sign flag argument
X test ax,ax
X jz 0f
X orb dh,*128 | set sign bit in dh if negative
X0: mov bx,#BIAS8+53 | first normalize the number as
X call .norm8 | an integer,
X
X call _ldexp | then re-scale it using ldexp()
X | to check for over/underflow
X add sp,#10 | remove args
X
X| call .lfr8 | these cancel each other out;
X| call .ret8 | code generator should special-case
X jmp .dsret
END_OF_FILE
if test 3370 -ne `wc -c <'strtod_aux.x'`; then
echo shar: \"'strtod_aux.x'\" unpacked with wrong size!
fi
# end of 'strtod_aux.x'
fi
if test -f 'trp.x' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'trp.x'\"
else
echo shar: Extracting \"'trp.x'\" \(2041 characters\)
sed "s/^X//" >'trp.x' <<'END_OF_FILE'
X.define .trp,.trpilin
X|.define .trpdivz,.trpcase,.trprang,.trpset,.trpnofp,.trpheap
X
X .bss
X.M: .zerow 24/2
X
X .text
X .globl .trp,.trpilin
X| .globl .trpdivz,.trpcase,.trprang,.trpset,.trpnofp,.trpheap
X|.trpdivz:
X| mov ax,#6
X| mov dx,#.Mdivz
X| jmp .Trp
X.trpilin:
X mov ax,#18
X mov dx,#.Milin
X jmp .Trp
X|.trpcase:
X| mov ax,#20
X| mov dx,#.Mcase
X| jmp .Trp
X|.trprang:
X| mov ax,#1
X| mov dx,#.Mrang
X| jmp .Trp
X|.trpset:
X| mov ax,#2
X| mov dx,#.Mset
X| jmp .Trp
X|.trpnofp:
X| mov ax,#18
X| mov dx,#.Milin
X| jmp .Trp
X|.trpheap:
X| mov ax,#17
X| mov dx,#.Mheap
X|| jmp .Trp
X.Trp:
X xor bx,bx
X .globl .trppc
X xchg bx,.trppc
X test bx,bx
X jz 2f
X push ax
X call (bx)
X pop ax
X ret
X2:
X mov bx,#22
X push bx
X push dx
X mov ax,#2
X push ax
X call .Write
X call _exit
X
X.trp:
X mov dx,ax
X cmp dx,#21
X jae 1f
X sal dx,#1
X mov bx,#.Mtable
X add bx,dx
X mov bx,(bx)
X test bx,bx
X jz 1f
X mov dx,bx
X jmp 2f
X1:
X mov bx,#.Mtrp+14
X mov cx,#6
X mov dx,ax
X1:
X and dx,#7
X add dx,#'0'
X movb (bx),dl
X dec bx
X sar dx,#1
X sar dx,#1
X sar dx,#1
X loop 1b
X mov dx,#.Mtrp
X2:
X jmp .Trp
X
X.Write:
X push bp
X mov bp,sp
X mov .M+2,#4
X mov bx,4(bp)
X mov .M+4,bx
X mov bx,8(bp)
X mov .M+6,bx
X mov bx,6(bp)
X mov .M+10,bx
X mov ax,#.M
X push ax
X mov ax,#1
X push ax
X
X mov ax,#1
X mov bx,#.M
X mov cx,#3
X int 32
X mov sp,bp
X pop bp
X ret
X
X .data
X.Mtable:
X .word 0, .Mrang, .Mset, 0, .Mfovf, .Mfunf, .Mdivz, .Mfdvz
X .word 0, 0, .Mconv, 0, 0, 0, 0, 0
X .word 0, .Mheap, .Milin, 0, .Mcase
X
X.Mrang: .asciz "Variable out of range\n" | ERANGE = 1
X.Mset: .asciz "Err in EM set instr \n" | ESET = 2
X.Mfovf: .asciz "Floating pt. overflow\n" | EFOVFL = 4
X.Mfunf: .asciz "Floating pt underflow\n" | EFUNFL = 5
X.Mdivz: .asciz "Integer division by 0\n" | EIDIVZ = 6
X.Mfdvz: .asciz "Division by float 0.0\n" | EFDIVZ = 7
X|.Mfunf:.asciz "Bad floating pt value\n" | EFUND = 9
X.Mconv: .asciz "Bad number conversion\n" | ECONV = 10
X.Mheap: .asciz "Heap overflow \n" | EHEAP = 17
X.Milin: .asciz "Illegal EM instruct'n\n" | EILLINS = 18
X.Mcase: .asciz "Err in EM case instr \n" | ECASE = 20
X
X.Mtrp: .asciz "EM trap 0000000 octal\n"
END_OF_FILE
if test 2041 -ne `wc -c <'trp.x'`; then
echo shar: \"'trp.x'\" unpacked with wrong size!
fi
# end of 'trp.x'
fi
echo shar: End of archive 2 \(of 3\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 3 archives.
rm -f ark[1-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0