From 8c53e4007e6b235f4daa105a0c82b3fc1b2bb6e7 Mon Sep 17 00:00:00 2001 From: Ben Gras Date: Mon, 10 Oct 2005 15:27:47 +0000 Subject: [PATCH] ack subdir for combined ack/gcc library build --- lib/ack/Makefile | 12 + lib/ack/Makefile.ack | 11 + lib/ack/float/FP.compile | 19 + lib/ack/float/FP.script | 39 ++ lib/ack/float/FP_bias.h | 28 ++ lib/ack/float/FP_shift.h | 49 +++ lib/ack/float/FP_trap.h | 22 ++ lib/ack/float/FP_types.h | 113 ++++++ lib/ack/float/Makefile | 61 +++ lib/ack/float/add_ext.fc | 56 +++ lib/ack/float/adder.fc | 50 +++ lib/ack/float/adder.h | 15 + lib/ack/float/adf4.fc | 32 ++ lib/ack/float/adf8.fc | 32 ++ lib/ack/float/byte_order.h | 6 + lib/ack/float/cff4.fc | 28 ++ lib/ack/float/cff8.fc | 28 ++ lib/ack/float/cfi.fc | 52 +++ lib/ack/float/cfu.fc | 43 +++ lib/ack/float/cif4.fc | 56 +++ lib/ack/float/cif8.fc | 55 +++ lib/ack/float/cmf4.fc | 40 ++ lib/ack/float/cmf8.fc | 61 +++ lib/ack/float/compact.fc | 202 ++++++++++ lib/ack/float/cuf4.fc | 57 +++ lib/ack/float/cuf8.fc | 54 +++ lib/ack/float/div_ext.fc | 266 +++++++++++++ lib/ack/float/dvf4.fc | 26 ++ lib/ack/float/dvf8.fc | 26 ++ lib/ack/float/extend.fc | 111 ++++++ lib/ack/float/fef4.fc | 33 ++ lib/ack/float/fef8.fc | 33 ++ lib/ack/float/fif4.fc | 46 +++ lib/ack/float/fif8.fc | 48 +++ lib/ack/float/fptrp.s | 19 + lib/ack/float/get_put.h | 41 ++ lib/ack/float/mlf4.fc | 25 ++ lib/ack/float/mlf8.fc | 25 ++ lib/ack/float/mul_ext.fc | 98 +++++ lib/ack/float/ngf4.fc | 27 ++ lib/ack/float/ngf8.fc | 28 ++ lib/ack/float/nrm_ext.fc | 50 +++ lib/ack/float/sbf4.fc | 27 ++ lib/ack/float/sbf8.fc | 27 ++ lib/ack/float/sft_ext.fc | 39 ++ lib/ack/float/shifter.fc | 75 ++++ lib/ack/float/sub_ext.fc | 53 +++ lib/ack/float/zrf4.fc | 19 + lib/ack/float/zrf8.fc | 21 + lib/ack/float/zrf_ext.fc | 22 ++ lib/ack/fphook/FP.compile | 19 + lib/ack/fphook/FP.script | 39 ++ lib/ack/fphook/FP_bias.h | 28 ++ lib/ack/fphook/FP_shift.h | 49 +++ lib/ack/fphook/FP_trap.h | 22 ++ lib/ack/fphook/FP_types.h | 113 ++++++ lib/ack/fphook/Makefile | 19 + lib/ack/fphook/Makefile.ack.conv | 32 ++ lib/ack/fphook/add_ext.fc | 56 +++ lib/ack/fphook/adder.fc | 50 +++ lib/ack/fphook/adder.h | 15 + lib/ack/fphook/adf4.fc | 32 ++ lib/ack/fphook/adf8.fc | 32 ++ lib/ack/fphook/byte_order.h | 6 + lib/ack/fphook/cff4.fc | 28 ++ lib/ack/fphook/cff8.fc | 28 ++ lib/ack/fphook/cfi.fc | 52 +++ lib/ack/fphook/cfu.fc | 43 +++ lib/ack/fphook/cif4.fc | 56 +++ lib/ack/fphook/cif8.fc | 55 +++ lib/ack/fphook/cmf4.fc | 40 ++ lib/ack/fphook/cmf8.fc | 61 +++ lib/ack/fphook/compact.fc | 202 ++++++++++ lib/ack/fphook/cuf4.fc | 57 +++ lib/ack/fphook/cuf8.fc | 54 +++ lib/ack/fphook/div_ext.fc | 266 +++++++++++++ lib/ack/fphook/dvf4.fc | 26 ++ lib/ack/fphook/dvf8.fc | 26 ++ lib/ack/fphook/extend.fc | 111 ++++++ lib/ack/fphook/fef4.fc | 33 ++ lib/ack/fphook/fef8.fc | 33 ++ lib/ack/fphook/fif4.fc | 46 +++ lib/ack/fphook/fif8.fc | 48 +++ lib/ack/fphook/fltpr.c | 12 + lib/ack/fphook/fphook.c | 195 ++++++++++ lib/ack/fphook/fptrp.s | 19 + lib/ack/fphook/get_put.h | 41 ++ lib/ack/fphook/mlf4.fc | 25 ++ lib/ack/fphook/mlf8.fc | 25 ++ lib/ack/fphook/mul_ext.fc | 98 +++++ lib/ack/fphook/ngf4.fc | 27 ++ lib/ack/fphook/ngf8.fc | 28 ++ lib/ack/fphook/nrm_ext.fc | 50 +++ lib/ack/fphook/sbf4.fc | 27 ++ lib/ack/fphook/sbf8.fc | 27 ++ lib/ack/fphook/sft_ext.fc | 39 ++ lib/ack/fphook/shifter.fc | 75 ++++ lib/ack/fphook/strtod.c | 9 + lib/ack/fphook/sub_ext.fc | 53 +++ lib/ack/fphook/zrf4.fc | 19 + lib/ack/fphook/zrf8.fc | 21 + lib/ack/fphook/zrf_ext.fc | 22 ++ lib/ack/h/em_abs.h | 35 ++ lib/ack/h/m2_traps.h | 16 + lib/ack/h/pc_err.h | 29 ++ lib/ack/h/pc_file.h | 24 ++ lib/ack/h/pc_math.h | 42 ++ lib/ack/i386/Makefile | 4 + lib/ack/i386/Makefile.ack | 5 + lib/ack/i386/em/Makefile | 78 ++++ lib/ack/i386/em/Makefile.ack.conv | 289 ++++++++++++++ lib/ack/i386/em/byte_order.h | 6 + lib/ack/i386/em/em_adf4.s | 11 + lib/ack/i386/em/em_adf8.s | 11 + lib/ack/i386/em/em_adi.s | 18 + lib/ack/i386/em/em_and.s | 20 + lib/ack/i386/em/em_blm.s | 16 + lib/ack/i386/em/em_cff4.s | 19 + lib/ack/i386/em/em_cff8.s | 10 + lib/ack/i386/em/em_cfi.s | 27 ++ lib/ack/i386/em/em_cfu.s | 38 ++ lib/ack/i386/em/em_cif4.s | 10 + lib/ack/i386/em/em_cif8.s | 10 + lib/ack/i386/em/em_cii.s | 31 ++ lib/ack/i386/em/em_cmf4.s | 22 ++ lib/ack/i386/em/em_cmf8.s | 22 ++ lib/ack/i386/em/em_cms.s | 23 ++ lib/ack/i386/em/em_com.s | 14 + lib/ack/i386/em/em_csa4.s | 27 ++ lib/ack/i386/em/em_csb4.s | 29 ++ lib/ack/i386/em/em_cuf4.s | 15 + lib/ack/i386/em/em_cuf8.s | 15 + lib/ack/i386/em/em_cuu.s | 22 ++ lib/ack/i386/em/em_dup.s | 17 + lib/ack/i386/em/em_dvf4.s | 11 + lib/ack/i386/em/em_dvf8.s | 11 + lib/ack/i386/em/em_dvi.s | 21 + lib/ack/i386/em/em_dvu.s | 21 + lib/ack/i386/em/em_error.s | 32 ++ lib/ack/i386/em/em_exg.s | 22 ++ lib/ack/i386/em/em_fat.s | 10 + lib/ack/i386/em/em_fef4.s | 49 +++ lib/ack/i386/em/em_fef8.s | 56 +++ lib/ack/i386/em/em_fif4.s | 37 ++ lib/ack/i386/em/em_fif8.s | 37 ++ lib/ack/i386/em/em_fp8087.s | 10 + lib/ack/i386/em/em_gto.s | 8 + lib/ack/i386/em/em_hol0.s | 7 + lib/ack/i386/em/em_iaar.s | 18 + lib/ack/i386/em/em_ilar.s | 15 + lib/ack/i386/em/em_inn.s | 32 ++ lib/ack/i386/em/em_ior.s | 18 + lib/ack/i386/em/em_isar.s | 15 + lib/ack/i386/em/em_lar4.s | 37 ++ lib/ack/i386/em/em_loi.s | 44 +++ lib/ack/i386/em/em_mlf4.s | 11 + lib/ack/i386/em/em_mlf8.s | 11 + lib/ack/i386/em/em_mli.s | 20 + lib/ack/i386/em/em_mon.s | 7 + lib/ack/i386/em/em_ngf4.s | 11 + lib/ack/i386/em/em_ngf8.s | 11 + lib/ack/i386/em/em_ngi.s | 19 + lib/ack/i386/em/em_nop.s | 10 + lib/ack/i386/em/em_print.s | 47 +++ lib/ack/i386/em/em_rck.s | 20 + lib/ack/i386/em/em_rmi.s | 21 + lib/ack/i386/em/em_rmu.s | 21 + lib/ack/i386/em/em_rol.s | 20 + lib/ack/i386/em/em_ror.s | 20 + lib/ack/i386/em/em_sar4.s | 33 ++ lib/ack/i386/em/em_sbf4.s | 11 + lib/ack/i386/em/em_sbf8.s | 11 + lib/ack/i386/em/em_sbi.s | 19 + lib/ack/i386/em/em_set.s | 42 ++ lib/ack/i386/em/em_sli.s | 20 + lib/ack/i386/em/em_sri.s | 20 + lib/ack/i386/em/em_sti.s | 41 ++ lib/ack/i386/em/em_stop.s | 5 + lib/ack/i386/em/em_trp.s | 18 + lib/ack/i386/em/em_unknown.s | 9 + lib/ack/i386/em/em_xor.s | 18 + lib/ack/i386/head/Makefile | 9 + lib/ack/i386/head/Makefile.ack.conv | 13 + lib/ack/i386/head/em_abs.h | 35 ++ lib/ack/i386/head/em_head.s | 20 + lib/ack/libm2/Arguments.c | 73 ++++ lib/ack/libm2/ArraySort.mod | 155 ++++++++ lib/ack/libm2/CSP.mod | 347 +++++++++++++++++ lib/ack/libm2/Conversion.mod | 73 ++++ lib/ack/libm2/EM.e | 100 +++++ lib/ack/libm2/InOut.mod | 371 ++++++++++++++++++ lib/ack/libm2/LtoUset.e | 61 +++ lib/ack/libm2/Makefile | 57 +++ lib/ack/libm2/Makefile.ack.conv | 204 ++++++++++ lib/ack/libm2/MathLib0.mod | 69 ++++ lib/ack/libm2/Mathlib.mod | 576 ++++++++++++++++++++++++++++ lib/ack/libm2/PascalIO.mod | 437 +++++++++++++++++++++ lib/ack/libm2/Processes.mod | 101 +++++ lib/ack/libm2/RealConver.mod | 337 ++++++++++++++++ lib/ack/libm2/RealInOut.mod | 97 +++++ lib/ack/libm2/SYSTEM.c | 115 ++++++ lib/ack/libm2/Semaphores.mod | 118 ++++++ lib/ack/libm2/Storage.mod | 353 +++++++++++++++++ lib/ack/libm2/StrAss.c | 23 ++ lib/ack/libm2/Streams.mod | 443 +++++++++++++++++++++ lib/ack/libm2/Strings.mod | 171 +++++++++ lib/ack/libm2/Termcap.mod | 99 +++++ lib/ack/libm2/Terminal.mod | 114 ++++++ lib/ack/libm2/Traps.mod | 96 +++++ lib/ack/libm2/XXTermcap.c | 573 +++++++++++++++++++++++++++ lib/ack/libm2/absd.c | 18 + lib/ack/libm2/absf.e | 30 ++ lib/ack/libm2/absi.c | 15 + lib/ack/libm2/absl.c | 16 + lib/ack/libm2/blockmove.c | 23 ++ lib/ack/libm2/cap.c | 18 + lib/ack/libm2/catch.c | 99 +++++ lib/ack/libm2/confarray.c | 72 ++++ lib/ack/libm2/dvi.c | 68 ++++ lib/ack/libm2/halt.c | 37 ++ lib/ack/libm2/head_m2.e | 63 +++ lib/ack/libm2/init.c | 47 +++ lib/ack/libm2/load.c | 45 +++ lib/ack/libm2/par_misc.e | 175 +++++++++ lib/ack/libm2/random.mod | 58 +++ lib/ack/libm2/rcka.c | 25 ++ lib/ack/libm2/rcki.c | 23 ++ lib/ack/libm2/rckil.c | 24 ++ lib/ack/libm2/rcku.c | 24 ++ lib/ack/libm2/rckul.c | 24 ++ lib/ack/libm2/sigtrp.c | 82 ++++ lib/ack/libm2/stackprio.c | 27 ++ lib/ack/libm2/store.c | 43 +++ lib/ack/libm2/ucheck.c | 65 ++++ lib/ack/libp/Makefile | 83 ++++ lib/ack/libp/Makefile.ack.conv | 305 +++++++++++++++ lib/ack/libp/abi.c | 23 ++ lib/ack/libp/abl.c | 23 ++ lib/ack/libp/abr.c | 23 ++ lib/ack/libp/arg.c | 56 +++ lib/ack/libp/ass.c | 33 ++ lib/ack/libp/asz.c | 29 ++ lib/ack/libp/atn.c | 72 ++++ lib/ack/libp/bcp.c | 30 ++ lib/ack/libp/bts.e | 56 +++ lib/ack/libp/buff.c | 35 ++ lib/ack/libp/catch.c | 154 ++++++++ lib/ack/libp/clock.c | 47 +++ lib/ack/libp/cls.c | 67 ++++ lib/ack/libp/cvt.c | 119 ++++++ lib/ack/libp/diag.c | 34 ++ lib/ack/libp/dis.c | 87 +++++ lib/ack/libp/efl.c | 36 ++ lib/ack/libp/eln.c | 33 ++ lib/ack/libp/encaps.e | 144 +++++++ lib/ack/libp/exp.c | 118 ++++++ lib/ack/libp/fef.e | 39 ++ lib/ack/libp/fif.e | 41 ++ lib/ack/libp/get.c | 31 ++ lib/ack/libp/gto.e | 85 ++++ lib/ack/libp/head_pc.e | 3 + lib/ack/libp/hlt.c | 35 ++ lib/ack/libp/hol0.e | 29 ++ lib/ack/libp/incpt.c | 75 ++++ lib/ack/libp/ini.c | 72 ++++ lib/ack/libp/log.c | 65 ++++ lib/ack/libp/mdi.c | 71 ++++ lib/ack/libp/mdl.c | 33 ++ lib/ack/libp/new.c | 69 ++++ lib/ack/libp/nfa.c | 16 + lib/ack/libp/nobuff.c | 33 ++ lib/ack/libp/notext.c | 23 ++ lib/ack/libp/opn.c | 118 ++++++ lib/ack/libp/outcpt.c | 50 +++ lib/ack/libp/pac.c | 63 +++ lib/ack/libp/pclose.c | 27 ++ lib/ack/libp/pcreat.c | 41 ++ lib/ack/libp/pentry.c | 35 ++ lib/ack/libp/perrno.c | 25 ++ lib/ack/libp/pexit.c | 33 ++ lib/ack/libp/popen.c | 41 ++ lib/ack/libp/put.c | 27 ++ lib/ack/libp/rcka.c | 25 ++ lib/ack/libp/rdc.c | 31 ++ lib/ack/libp/rdi.c | 78 ++++ lib/ack/libp/rdl.c | 41 ++ lib/ack/libp/rdr.c | 78 ++++ lib/ack/libp/rf.c | 35 ++ lib/ack/libp/rln.c | 30 ++ lib/ack/libp/rnd.c | 21 + lib/ack/libp/sav.e | 49 +++ lib/ack/libp/sig.e | 35 ++ lib/ack/libp/sin.c | 101 +++++ lib/ack/libp/sqt.c | 72 ++++ lib/ack/libp/string.c | 60 +++ lib/ack/libp/trap.e | 33 ++ lib/ack/libp/trp.e | 38 ++ lib/ack/libp/unp.c | 65 ++++ lib/ack/libp/uread.c | 25 ++ lib/ack/libp/uwrite.c | 25 ++ lib/ack/libp/wdw.c | 30 ++ lib/ack/libp/wf.c | 32 ++ lib/ack/libp/wrc.c | 41 ++ lib/ack/libp/wrf.c | 68 ++++ lib/ack/libp/wri.c | 72 ++++ lib/ack/libp/wrl.c | 51 +++ lib/ack/libp/wrr.c | 67 ++++ lib/ack/libp/wrs.c | 68 ++++ lib/ack/libp/wrz.c | 38 ++ lib/ack/liby/Makefile | 11 + lib/ack/liby/Makefile.ack.conv | 21 + lib/ack/liby/main.c | 41 ++ lib/ack/liby/yyerror.c | 45 +++ lib/ack/math/Makefile | 13 + lib/ack/math/Makefile.ack.conv | 29 ++ lib/ack/math/frexp.s | 35 ++ lib/ack/math/isnan.c | 11 + lib/ack/math/ldexp.c | 55 +++ lib/ack/math/modf.s | 49 +++ lib/ack/rts/Makefile | 10 + lib/ack/rts/Makefile.ack.conv | 19 + lib/ack/rts/setjmp.e | 112 ++++++ 322 files changed, 17865 insertions(+) create mode 100644 lib/ack/Makefile create mode 100644 lib/ack/Makefile.ack create mode 100755 lib/ack/float/FP.compile create mode 100755 lib/ack/float/FP.script create mode 100755 lib/ack/float/FP_bias.h create mode 100755 lib/ack/float/FP_shift.h create mode 100755 lib/ack/float/FP_trap.h create mode 100755 lib/ack/float/FP_types.h create mode 100644 lib/ack/float/Makefile create mode 100755 lib/ack/float/add_ext.fc create mode 100755 lib/ack/float/adder.fc create mode 100755 lib/ack/float/adder.h create mode 100755 lib/ack/float/adf4.fc create mode 100755 lib/ack/float/adf8.fc create mode 100755 lib/ack/float/byte_order.h create mode 100755 lib/ack/float/cff4.fc create mode 100755 lib/ack/float/cff8.fc create mode 100755 lib/ack/float/cfi.fc create mode 100755 lib/ack/float/cfu.fc create mode 100755 lib/ack/float/cif4.fc create mode 100755 lib/ack/float/cif8.fc create mode 100755 lib/ack/float/cmf4.fc create mode 100755 lib/ack/float/cmf8.fc create mode 100755 lib/ack/float/compact.fc create mode 100755 lib/ack/float/cuf4.fc create mode 100755 lib/ack/float/cuf8.fc create mode 100755 lib/ack/float/div_ext.fc create mode 100755 lib/ack/float/dvf4.fc create mode 100755 lib/ack/float/dvf8.fc create mode 100755 lib/ack/float/extend.fc create mode 100755 lib/ack/float/fef4.fc create mode 100755 lib/ack/float/fef8.fc create mode 100755 lib/ack/float/fif4.fc create mode 100755 lib/ack/float/fif8.fc create mode 100755 lib/ack/float/fptrp.s create mode 100755 lib/ack/float/get_put.h create mode 100755 lib/ack/float/mlf4.fc create mode 100755 lib/ack/float/mlf8.fc create mode 100755 lib/ack/float/mul_ext.fc create mode 100755 lib/ack/float/ngf4.fc create mode 100755 lib/ack/float/ngf8.fc create mode 100755 lib/ack/float/nrm_ext.fc create mode 100755 lib/ack/float/sbf4.fc create mode 100755 lib/ack/float/sbf8.fc create mode 100755 lib/ack/float/sft_ext.fc create mode 100755 lib/ack/float/shifter.fc create mode 100755 lib/ack/float/sub_ext.fc create mode 100755 lib/ack/float/zrf4.fc create mode 100755 lib/ack/float/zrf8.fc create mode 100755 lib/ack/float/zrf_ext.fc create mode 100755 lib/ack/fphook/FP.compile create mode 100755 lib/ack/fphook/FP.script create mode 100755 lib/ack/fphook/FP_bias.h create mode 100755 lib/ack/fphook/FP_shift.h create mode 100755 lib/ack/fphook/FP_trap.h create mode 100755 lib/ack/fphook/FP_types.h create mode 100644 lib/ack/fphook/Makefile create mode 100755 lib/ack/fphook/Makefile.ack.conv create mode 100755 lib/ack/fphook/add_ext.fc create mode 100755 lib/ack/fphook/adder.fc create mode 100755 lib/ack/fphook/adder.h create mode 100755 lib/ack/fphook/adf4.fc create mode 100755 lib/ack/fphook/adf8.fc create mode 100755 lib/ack/fphook/byte_order.h create mode 100755 lib/ack/fphook/cff4.fc create mode 100755 lib/ack/fphook/cff8.fc create mode 100755 lib/ack/fphook/cfi.fc create mode 100755 lib/ack/fphook/cfu.fc create mode 100755 lib/ack/fphook/cif4.fc create mode 100755 lib/ack/fphook/cif8.fc create mode 100755 lib/ack/fphook/cmf4.fc create mode 100755 lib/ack/fphook/cmf8.fc create mode 100755 lib/ack/fphook/compact.fc create mode 100755 lib/ack/fphook/cuf4.fc create mode 100755 lib/ack/fphook/cuf8.fc create mode 100755 lib/ack/fphook/div_ext.fc create mode 100755 lib/ack/fphook/dvf4.fc create mode 100755 lib/ack/fphook/dvf8.fc create mode 100755 lib/ack/fphook/extend.fc create mode 100755 lib/ack/fphook/fef4.fc create mode 100755 lib/ack/fphook/fef8.fc create mode 100755 lib/ack/fphook/fif4.fc create mode 100755 lib/ack/fphook/fif8.fc create mode 100755 lib/ack/fphook/fltpr.c create mode 100755 lib/ack/fphook/fphook.c create mode 100755 lib/ack/fphook/fptrp.s create mode 100755 lib/ack/fphook/get_put.h create mode 100755 lib/ack/fphook/mlf4.fc create mode 100755 lib/ack/fphook/mlf8.fc create mode 100755 lib/ack/fphook/mul_ext.fc create mode 100755 lib/ack/fphook/ngf4.fc create mode 100755 lib/ack/fphook/ngf8.fc create mode 100755 lib/ack/fphook/nrm_ext.fc create mode 100755 lib/ack/fphook/sbf4.fc create mode 100755 lib/ack/fphook/sbf8.fc create mode 100755 lib/ack/fphook/sft_ext.fc create mode 100755 lib/ack/fphook/shifter.fc create mode 100755 lib/ack/fphook/strtod.c create mode 100755 lib/ack/fphook/sub_ext.fc create mode 100755 lib/ack/fphook/zrf4.fc create mode 100755 lib/ack/fphook/zrf8.fc create mode 100755 lib/ack/fphook/zrf_ext.fc create mode 100755 lib/ack/h/em_abs.h create mode 100755 lib/ack/h/m2_traps.h create mode 100755 lib/ack/h/pc_err.h create mode 100755 lib/ack/h/pc_file.h create mode 100755 lib/ack/h/pc_math.h create mode 100644 lib/ack/i386/Makefile create mode 100644 lib/ack/i386/Makefile.ack create mode 100644 lib/ack/i386/em/Makefile create mode 100755 lib/ack/i386/em/Makefile.ack.conv create mode 100755 lib/ack/i386/em/byte_order.h create mode 100755 lib/ack/i386/em/em_adf4.s create mode 100755 lib/ack/i386/em/em_adf8.s create mode 100755 lib/ack/i386/em/em_adi.s create mode 100755 lib/ack/i386/em/em_and.s create mode 100755 lib/ack/i386/em/em_blm.s create mode 100755 lib/ack/i386/em/em_cff4.s create mode 100755 lib/ack/i386/em/em_cff8.s create mode 100755 lib/ack/i386/em/em_cfi.s create mode 100755 lib/ack/i386/em/em_cfu.s create mode 100755 lib/ack/i386/em/em_cif4.s create mode 100755 lib/ack/i386/em/em_cif8.s create mode 100755 lib/ack/i386/em/em_cii.s create mode 100755 lib/ack/i386/em/em_cmf4.s create mode 100755 lib/ack/i386/em/em_cmf8.s create mode 100755 lib/ack/i386/em/em_cms.s create mode 100755 lib/ack/i386/em/em_com.s create mode 100755 lib/ack/i386/em/em_csa4.s create mode 100755 lib/ack/i386/em/em_csb4.s create mode 100755 lib/ack/i386/em/em_cuf4.s create mode 100755 lib/ack/i386/em/em_cuf8.s create mode 100755 lib/ack/i386/em/em_cuu.s create mode 100755 lib/ack/i386/em/em_dup.s create mode 100755 lib/ack/i386/em/em_dvf4.s create mode 100755 lib/ack/i386/em/em_dvf8.s create mode 100755 lib/ack/i386/em/em_dvi.s create mode 100755 lib/ack/i386/em/em_dvu.s create mode 100755 lib/ack/i386/em/em_error.s create mode 100755 lib/ack/i386/em/em_exg.s create mode 100755 lib/ack/i386/em/em_fat.s create mode 100755 lib/ack/i386/em/em_fef4.s create mode 100755 lib/ack/i386/em/em_fef8.s create mode 100755 lib/ack/i386/em/em_fif4.s create mode 100755 lib/ack/i386/em/em_fif8.s create mode 100755 lib/ack/i386/em/em_fp8087.s create mode 100755 lib/ack/i386/em/em_gto.s create mode 100755 lib/ack/i386/em/em_hol0.s create mode 100755 lib/ack/i386/em/em_iaar.s create mode 100755 lib/ack/i386/em/em_ilar.s create mode 100755 lib/ack/i386/em/em_inn.s create mode 100755 lib/ack/i386/em/em_ior.s create mode 100755 lib/ack/i386/em/em_isar.s create mode 100755 lib/ack/i386/em/em_lar4.s create mode 100755 lib/ack/i386/em/em_loi.s create mode 100755 lib/ack/i386/em/em_mlf4.s create mode 100755 lib/ack/i386/em/em_mlf8.s create mode 100755 lib/ack/i386/em/em_mli.s create mode 100755 lib/ack/i386/em/em_mon.s create mode 100755 lib/ack/i386/em/em_ngf4.s create mode 100755 lib/ack/i386/em/em_ngf8.s create mode 100755 lib/ack/i386/em/em_ngi.s create mode 100755 lib/ack/i386/em/em_nop.s create mode 100755 lib/ack/i386/em/em_print.s create mode 100755 lib/ack/i386/em/em_rck.s create mode 100755 lib/ack/i386/em/em_rmi.s create mode 100755 lib/ack/i386/em/em_rmu.s create mode 100755 lib/ack/i386/em/em_rol.s create mode 100755 lib/ack/i386/em/em_ror.s create mode 100755 lib/ack/i386/em/em_sar4.s create mode 100755 lib/ack/i386/em/em_sbf4.s create mode 100755 lib/ack/i386/em/em_sbf8.s create mode 100755 lib/ack/i386/em/em_sbi.s create mode 100755 lib/ack/i386/em/em_set.s create mode 100755 lib/ack/i386/em/em_sli.s create mode 100755 lib/ack/i386/em/em_sri.s create mode 100755 lib/ack/i386/em/em_sti.s create mode 100755 lib/ack/i386/em/em_stop.s create mode 100755 lib/ack/i386/em/em_trp.s create mode 100755 lib/ack/i386/em/em_unknown.s create mode 100755 lib/ack/i386/em/em_xor.s create mode 100644 lib/ack/i386/head/Makefile create mode 100755 lib/ack/i386/head/Makefile.ack.conv create mode 100755 lib/ack/i386/head/em_abs.h create mode 100755 lib/ack/i386/head/em_head.s create mode 100755 lib/ack/libm2/Arguments.c create mode 100755 lib/ack/libm2/ArraySort.mod create mode 100755 lib/ack/libm2/CSP.mod create mode 100755 lib/ack/libm2/Conversion.mod create mode 100755 lib/ack/libm2/EM.e create mode 100755 lib/ack/libm2/InOut.mod create mode 100755 lib/ack/libm2/LtoUset.e create mode 100644 lib/ack/libm2/Makefile create mode 100755 lib/ack/libm2/Makefile.ack.conv create mode 100755 lib/ack/libm2/MathLib0.mod create mode 100755 lib/ack/libm2/Mathlib.mod create mode 100755 lib/ack/libm2/PascalIO.mod create mode 100755 lib/ack/libm2/Processes.mod create mode 100755 lib/ack/libm2/RealConver.mod create mode 100755 lib/ack/libm2/RealInOut.mod create mode 100755 lib/ack/libm2/SYSTEM.c create mode 100755 lib/ack/libm2/Semaphores.mod create mode 100755 lib/ack/libm2/Storage.mod create mode 100755 lib/ack/libm2/StrAss.c create mode 100755 lib/ack/libm2/Streams.mod create mode 100755 lib/ack/libm2/Strings.mod create mode 100755 lib/ack/libm2/Termcap.mod create mode 100755 lib/ack/libm2/Terminal.mod create mode 100755 lib/ack/libm2/Traps.mod create mode 100755 lib/ack/libm2/XXTermcap.c create mode 100755 lib/ack/libm2/absd.c create mode 100755 lib/ack/libm2/absf.e create mode 100755 lib/ack/libm2/absi.c create mode 100755 lib/ack/libm2/absl.c create mode 100755 lib/ack/libm2/blockmove.c create mode 100755 lib/ack/libm2/cap.c create mode 100755 lib/ack/libm2/catch.c create mode 100755 lib/ack/libm2/confarray.c create mode 100755 lib/ack/libm2/dvi.c create mode 100755 lib/ack/libm2/halt.c create mode 100755 lib/ack/libm2/head_m2.e create mode 100755 lib/ack/libm2/init.c create mode 100755 lib/ack/libm2/load.c create mode 100755 lib/ack/libm2/par_misc.e create mode 100755 lib/ack/libm2/random.mod create mode 100755 lib/ack/libm2/rcka.c create mode 100755 lib/ack/libm2/rcki.c create mode 100755 lib/ack/libm2/rckil.c create mode 100755 lib/ack/libm2/rcku.c create mode 100755 lib/ack/libm2/rckul.c create mode 100755 lib/ack/libm2/sigtrp.c create mode 100755 lib/ack/libm2/stackprio.c create mode 100755 lib/ack/libm2/store.c create mode 100755 lib/ack/libm2/ucheck.c create mode 100644 lib/ack/libp/Makefile create mode 100755 lib/ack/libp/Makefile.ack.conv create mode 100755 lib/ack/libp/abi.c create mode 100755 lib/ack/libp/abl.c create mode 100755 lib/ack/libp/abr.c create mode 100755 lib/ack/libp/arg.c create mode 100755 lib/ack/libp/ass.c create mode 100755 lib/ack/libp/asz.c create mode 100755 lib/ack/libp/atn.c create mode 100755 lib/ack/libp/bcp.c create mode 100755 lib/ack/libp/bts.e create mode 100755 lib/ack/libp/buff.c create mode 100755 lib/ack/libp/catch.c create mode 100755 lib/ack/libp/clock.c create mode 100755 lib/ack/libp/cls.c create mode 100755 lib/ack/libp/cvt.c create mode 100755 lib/ack/libp/diag.c create mode 100755 lib/ack/libp/dis.c create mode 100755 lib/ack/libp/efl.c create mode 100755 lib/ack/libp/eln.c create mode 100755 lib/ack/libp/encaps.e create mode 100755 lib/ack/libp/exp.c create mode 100755 lib/ack/libp/fef.e create mode 100755 lib/ack/libp/fif.e create mode 100755 lib/ack/libp/get.c create mode 100755 lib/ack/libp/gto.e create mode 100755 lib/ack/libp/head_pc.e create mode 100755 lib/ack/libp/hlt.c create mode 100755 lib/ack/libp/hol0.e create mode 100755 lib/ack/libp/incpt.c create mode 100755 lib/ack/libp/ini.c create mode 100755 lib/ack/libp/log.c create mode 100755 lib/ack/libp/mdi.c create mode 100755 lib/ack/libp/mdl.c create mode 100755 lib/ack/libp/new.c create mode 100755 lib/ack/libp/nfa.c create mode 100755 lib/ack/libp/nobuff.c create mode 100755 lib/ack/libp/notext.c create mode 100755 lib/ack/libp/opn.c create mode 100755 lib/ack/libp/outcpt.c create mode 100755 lib/ack/libp/pac.c create mode 100755 lib/ack/libp/pclose.c create mode 100755 lib/ack/libp/pcreat.c create mode 100755 lib/ack/libp/pentry.c create mode 100755 lib/ack/libp/perrno.c create mode 100755 lib/ack/libp/pexit.c create mode 100755 lib/ack/libp/popen.c create mode 100755 lib/ack/libp/put.c create mode 100755 lib/ack/libp/rcka.c create mode 100755 lib/ack/libp/rdc.c create mode 100755 lib/ack/libp/rdi.c create mode 100755 lib/ack/libp/rdl.c create mode 100755 lib/ack/libp/rdr.c create mode 100755 lib/ack/libp/rf.c create mode 100755 lib/ack/libp/rln.c create mode 100755 lib/ack/libp/rnd.c create mode 100755 lib/ack/libp/sav.e create mode 100755 lib/ack/libp/sig.e create mode 100755 lib/ack/libp/sin.c create mode 100755 lib/ack/libp/sqt.c create mode 100755 lib/ack/libp/string.c create mode 100755 lib/ack/libp/trap.e create mode 100755 lib/ack/libp/trp.e create mode 100755 lib/ack/libp/unp.c create mode 100755 lib/ack/libp/uread.c create mode 100755 lib/ack/libp/uwrite.c create mode 100755 lib/ack/libp/wdw.c create mode 100755 lib/ack/libp/wf.c create mode 100755 lib/ack/libp/wrc.c create mode 100755 lib/ack/libp/wrf.c create mode 100755 lib/ack/libp/wri.c create mode 100755 lib/ack/libp/wrl.c create mode 100755 lib/ack/libp/wrr.c create mode 100755 lib/ack/libp/wrs.c create mode 100755 lib/ack/libp/wrz.c create mode 100644 lib/ack/liby/Makefile create mode 100755 lib/ack/liby/Makefile.ack.conv create mode 100755 lib/ack/liby/main.c create mode 100755 lib/ack/liby/yyerror.c create mode 100644 lib/ack/math/Makefile create mode 100755 lib/ack/math/Makefile.ack.conv create mode 100755 lib/ack/math/frexp.s create mode 100755 lib/ack/math/isnan.c create mode 100755 lib/ack/math/ldexp.c create mode 100755 lib/ack/math/modf.s create mode 100644 lib/ack/rts/Makefile create mode 100755 lib/ack/rts/Makefile.ack.conv create mode 100755 lib/ack/rts/setjmp.e diff --git a/lib/ack/Makefile b/lib/ack/Makefile new file mode 100644 index 000000000..9ddb4776a --- /dev/null +++ b/lib/ack/Makefile @@ -0,0 +1,12 @@ + +SUBDIRS = \ + float \ + fphook \ + i386 \ + libm2 \ + libp \ + liby \ + math \ + rts \ + +include ../Makefile.inc diff --git a/lib/ack/Makefile.ack b/lib/ack/Makefile.ack new file mode 100644 index 000000000..f26c4657b --- /dev/null +++ b/lib/ack/Makefile.ack @@ -0,0 +1,11 @@ + +all: + cd float && make + cd fphook && make + cd `arch` && make + cd libm2 && make + cd libp && make + cd liby && make + cd math && make + cd rts && make + diff --git a/lib/ack/float/FP.compile b/lib/ack/float/FP.compile new file mode 100755 index 000000000..3ca814d8a --- /dev/null +++ b/lib/ack/float/FP.compile @@ -0,0 +1,19 @@ +#!/bin/sh +# Author: Kees J. Bot +# Compile one soft FP source file. +# (These files shouldn't be optimized normally, but the 16-bit C compiler +# only optimizes scratch register allocation a bit with -O. To the 32-bit +# compiler -O is a no-op.) + +case $#:$1 in +1:*.fc) ;; +*) echo "$0: $1: not a FC file" >&2; exit 1 +esac + +base="`basename "$1" .fc`" +trap 'rm -f tmp.c tmp.s"; exit 1' 2 + +cp "$1" tmp.c && +cc -O -I. -D_MINIX -D_POSIX_SOURCE -S tmp.c && +sed -f FP.script tmp.s > "$base.s" && +rm tmp.c tmp.s diff --git a/lib/ack/float/FP.script b/lib/ack/float/FP.script new file mode 100755 index 000000000..56a3fd608 --- /dev/null +++ b/lib/ack/float/FP.script @@ -0,0 +1,39 @@ +s/_adf4/.adf4/ +s/_adf8/.adf8/ +s/_cff4/.cff4/ +s/_cff8/.cff8/ +s/_cfi/.cfi/ +s/_cfu/.cfu/ +s/_cif4/.cif4/ +s/_cif8/.cif8/ +s/_cmf4/.cmf4/ +s/_cmf8/.cmf8/ +s/_cuf4/.cuf4/ +s/_cuf8/.cuf8/ +s/_dvf4/.dvf4/ +s/_dvf8/.dvf8/ +s/_fef4/.fef4/ +s/_fef8/.fef8/ +s/_fif4/.fif4/ +s/_fif8/.fif8/ +s/_mlf4/.mlf4/ +s/_mlf8/.mlf8/ +s/_ngf4/.ngf4/ +s/_ngf8/.ngf8/ +s/_sbf4/.sbf4/ +s/_sbf8/.sbf8/ +s/_zrf4/.zrf4/ +s/_zrf8/.zrf8/ +s/_add_ext/.add_ext/ +s/_div_ext/.div_ext/ +s/_mul_ext/.mul_ext/ +s/_nrm_ext/.nrm_ext/ +s/_sft_ext/.sft_ext/ +s/_sub_ext/.sub_ext/ +s/_zrf_ext/.zrf_ext/ +s/_compact/.compact/ +s/_extend/.extend/ +s/_b64_add/.b64_add/ +s/_b64_sft/.b64_sft/ +s/_b64_rsft/.b64_rsft/ +s/_b64_lsft/.b64_lsft/ diff --git a/lib/ack/float/FP_bias.h b/lib/ack/float/FP_bias.h new file mode 100755 index 000000000..db17a4132 --- /dev/null +++ b/lib/ack/float/FP_bias.h @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + include file for floating point package +*/ + + /* FLOAT FORMAT EXPONENT BIAS */ + +#define SGL_BIAS 127 /* excess 128 notation used */ +#define DBL_BIAS 1023 /* excess 1024 notation used */ +#define EXT_BIAS 0 /* 2s-complement notation used */ + /* this is possible because the */ + /* sign is in a seperate word */ + + /* VARIOUS MAX AND MIN VALUES */ + /* 1) FOR THE DIFFERENT FORMATS */ + +#define SGL_MAX 254 /* standard definition */ +#define SGL_MIN 1 /* standard definition */ +#define DBL_MAX 2046 /* standard definition */ +#define DBL_MIN 1 /* standard definition */ +#define EXT_MAX 16383 /* standard minimum */ +#define EXT_MIN -16382 /* standard minimum */ diff --git a/lib/ack/float/FP_shift.h b/lib/ack/float/FP_shift.h new file mode 100755 index 000000000..5b685636f --- /dev/null +++ b/lib/ack/float/FP_shift.h @@ -0,0 +1,49 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + include file for floating point package +*/ + +# define CARRYBIT 0x80000000L +# define NORMBIT 0x80000000L +# define EXP_STORE 16 + + + /* parameters for Single Precision */ +#define SGL_EXPSHIFT 7 +#define SGL_M1LEFT 8 +#define SGL_ZERO 0xffffff80L +#define SGL_EXACT 0xff +#define SGL_RUNPACK SGL_M1LEFT + +#define SGL_ROUNDUP 0x80 +#define SGL_CARRYOUT 0x01000000L +#define SGL_MASK 0x007fffffL + + /* parameters for Double Precision */ + /* used in extend.c */ + +#define DBL_EXPSHIFT 4 + +#define DBL_M1LEFT 11 + +#define DBL_RPACK (32-DBL_M1LEFT) +#define DBL_LPACK DBL_M1LEFT + + /* used in compact.c */ + +#define DBL_ZERO 0xfffffd00L + +#define DBL_EXACT 0x7ff + +#define DBL_RUNPACK DBL_M1LEFT +#define DBL_LUNPACK (32-DBL_RUNPACK) + +#define DBL_ROUNDUP 0x400 +#define DBL_CARRYOUT 0x00200000L +#define DBL_MASK 0x000fffffL diff --git a/lib/ack/float/FP_trap.h b/lib/ack/float/FP_trap.h new file mode 100755 index 000000000..045897bc3 --- /dev/null +++ b/lib/ack/float/FP_trap.h @@ -0,0 +1,22 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + include file for floating point package +*/ + + /* EM TRAPS */ + +#define EIOVFL 3 /* Integer Overflow */ +#define EFOVFL 4 /* Floating Overflow */ +#define EFUNFL 5 /* Floating Underflow */ +#define EIDIVZ 6 /* Integer Divide by 0 */ +#define EFDIVZ 7 /* Floating Divide by 0.0 */ +#define EIUND 8 /* Integer Undefined Number */ +#define EFUND 9 /* Floating Undefined Number */ +#define ECONV 10 /* Conversion Error */ +# define trap(x) _fptrp(x) diff --git a/lib/ack/float/FP_types.h b/lib/ack/float/FP_types.h new file mode 100755 index 000000000..a23f32b89 --- /dev/null +++ b/lib/ack/float/FP_types.h @@ -0,0 +1,113 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/********************************************************/ +/* + Type definitions for C Floating Point Package + include file for floating point package +*/ +/********************************************************/ +/* + THESE STRUCTURES ARE USED TO ADDRESS THE INDIVIDUAL + PARTS OF THE FLOATING POINT NUMBER REPRESENTATIONS. + + THREE STRUCTURES ARE DEFINED: + SINGLE: single precision floating format + DOUBLE: double precision floating format + EXTEND: double precision extended format +*/ +/********************************************************/ + +#ifndef __FPTYPES +#define __FPTYPES + +typedef struct { + unsigned long h_32; /* higher 32 bits of 64 */ + unsigned long l_32; /* lower 32 bits of 64 */ +} B64; + +typedef unsigned long SINGLE; + +typedef struct { + unsigned long d[2]; +} DOUBLE; + +typedef struct { /* expanded float format */ + short sign; + short exp; + B64 mantissa; +#define m1 mantissa.h_32 +#define m2 mantissa.l_32 +} EXTEND; + +struct fef4_returns { + int e; + SINGLE f; +}; + +struct fef8_returns { + int e; + DOUBLE f; +}; + +struct fif4_returns { + SINGLE ipart; + SINGLE fpart; +}; + +struct fif8_returns { + DOUBLE ipart; + DOUBLE fpart; +}; + +#if __STDC__ +#define _PROTOTYPE(function, params) function params +#else +#define _PROTOTYPE(function, params) function() +#endif +_PROTOTYPE( void add_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void mul_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void div_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void sub_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void sft_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void nrm_ext, (EXTEND *e1)); +_PROTOTYPE( void zrf_ext, (EXTEND *e1)); +_PROTOTYPE( void extend, (unsigned long *from, EXTEND *to, int size)); +_PROTOTYPE( void compact, (EXTEND *from, unsigned long *to, int size)); +_PROTOTYPE( void _fptrp, (int)); +_PROTOTYPE( void adf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void adf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void sbf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void sbf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void dvf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void dvf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void mlf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void mlf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void ngf4, (SINGLE f)); +_PROTOTYPE( void ngf8, (DOUBLE f)); +_PROTOTYPE( void zrf4, (SINGLE *l)); +_PROTOTYPE( void zrf8, (DOUBLE *z)); +_PROTOTYPE( void cff4, (DOUBLE src)); +_PROTOTYPE( void cff8, (SINGLE src)); +_PROTOTYPE( void cif4, (int ss, long src)); +_PROTOTYPE( void cif8, (int ss, long src)); +_PROTOTYPE( void cuf4, (int ss, long src)); +_PROTOTYPE( void cuf8, (int ss, long src)); +_PROTOTYPE( long cfu, (int ds, int ss, DOUBLE src)); +_PROTOTYPE( long cfi, (int ds, int ss, DOUBLE src)); +_PROTOTYPE( int cmf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( int cmf8, (DOUBLE d1, DOUBLE d2)); +_PROTOTYPE( void fef4, (struct fef4_returns *r, SINGLE s1)); +_PROTOTYPE( void fef8, (struct fef8_returns *r, DOUBLE s1)); +_PROTOTYPE( void fif4, (struct fif4_returns *p, SINGLE x, SINGLE y)); +_PROTOTYPE( void fif8, (struct fif8_returns *p, DOUBLE x, DOUBLE y)); + +_PROTOTYPE( void b64_sft, (B64 *, int)); +_PROTOTYPE( void b64_lsft, (B64 *)); +_PROTOTYPE( void b64_rsft, (B64 *)); +_PROTOTYPE( int b64_add, (B64 *, B64 *)); +#endif diff --git a/lib/ack/float/Makefile b/lib/ack/float/Makefile new file mode 100644 index 000000000..7b2715c0b --- /dev/null +++ b/lib/ack/float/Makefile @@ -0,0 +1,61 @@ +# Makefile for lib/float. + +CC1 = /bin/sh ./FP.compile + +LIBRARIES = libfp + +libfp_OBJECTS = \ + add_ext.o \ + adder.o \ + adf4.o \ + adf8.o \ + cff4.o \ + cff8.o \ + cfi.o \ + cfu.o \ + cif4.o \ + cif8.o \ + cmf4.o \ + cmf8.o \ + compact.o \ + cuf4.o \ + cuf8.o \ + div_ext.o \ + dvf4.o \ + dvf8.o \ + extend.o \ + fef4.o \ + fef8.o \ + fif4.o \ + fif8.o \ + fptrp.o \ + mlf4.o \ + mlf8.o \ + mul_ext.o \ + ngf4.o \ + ngf8.o \ + nrm_ext.o \ + sbf4.o \ + sbf8.o \ + sft_ext.o \ + shifter.o \ + sub_ext.o \ + zrf4.o \ + zrf8.o \ + zrf_ext.o \ + +include ../../Makefile.ack.inc + +#extra commands to convert the c files to the correct assembler files + +%.s: %.fc + /bin/sh ./FP.compile $< + +#1. make a assembler file of the c file +#%.fs: %.fc +# -cp $< $(<:.fc=.c) && cc -O -I. -D_MINIX -D_POSIX_SOURCE -S $(<:.fc=.c) && cp $(<:.fc=.s) $(<:.fc=.fs) +# @rm $(<:.fc=.c) $(<:.fc=.s) + +#2. modify the assembler file +#%.s: %.fs +# sed -f FP.script $< > $@ diff --git a/lib/ack/float/add_ext.fc b/lib/ack/float/add_ext.fc new file mode 100755 index 000000000..a077663ab --- /dev/null +++ b/lib/ack/float/add_ext.fc @@ -0,0 +1,56 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ADD TWO EXTENDED FORMAT NUMBERS +*/ + +#include "FP_types.h" + +void +add_ext(e1,e2) +register EXTEND *e1,*e2; +{ + if ((e2->m1 | e2->m2) == 0L) { + return; + } + if ((e1->m1 | e1->m2) == 0L) { + *e1 = *e2; + return; + } + sft_ext(e1, e2); /* adjust mantissas to equal powers */ + if (e1->sign != e2->sign) { + /* e1 + e2 = e1 - (-e2) */ + if (e2->m1 > e1->m1 || + (e2->m1 == e1->m1 && e2->m2 > e1->m2)) { + /* abs(e2) > abs(e1) */ + EXTEND x; + + x = *e1; + *e1 = *e2; + if (x.m2 > e1->m2) { + e1->m1 -= 1; /* carry in */ + } + e1->m1 -= x.m1; + e1->m2 -= x.m2; + } + else { + if (e2->m2 > e1->m2) + e1->m1 -= 1; /* carry in */ + e1->m1 -= e2->m1; + e1->m2 -= e2->m2; + } + } + else { + if (b64_add(&e1->mantissa,&e2->mantissa)) { /* addition carry */ + b64_rsft(&e1->mantissa); /* shift mantissa one bit RIGHT */ + e1->m1 |= 0x80000000L; /* set max bit */ + e1->exp++; /* increase the exponent */ + } + } + nrm_ext(e1); +} diff --git a/lib/ack/float/adder.fc b/lib/ack/float/adder.fc new file mode 100755 index 000000000..a0af3ce75 --- /dev/null +++ b/lib/ack/float/adder.fc @@ -0,0 +1,50 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * these are the routines the routines to do 32 and 64-bit addition + */ + +# ifdef EXT_DEBUG +# include +# endif + +# include "FP_types.h" +# define UNKNOWN -1 +# define TRUE 1 +# define FALSE 0 +# define MAXBIT 0x80000000L + + /* + * add 64 bits + */ +int +b64_add(e1,e2) + /* + * pointers to 64 bit 'registers' + */ +register B64 *e1,*e2; +{ + register int overflow; + int carry; + + /* add higher pair of 32 bits */ + overflow = ((unsigned long) 0xFFFFFFFF - e1->h_32 < e2->h_32); + e1->h_32 += e2->h_32; + + /* add lower pair of 32 bits */ + carry = ((unsigned long) 0xFFFFFFFF - e1->l_32 < e2->l_32); + e1->l_32 += e2->l_32; +# ifdef EXT_DEBUG + printf("\t\t\t\t\tb64_add: overflow (%d); internal carry(%d)\n", + overflow,carry); + fflush(stdout); +# endif + if ((carry) && (++e1->h_32 == 0)) + return(TRUE); /* had a 64 bit overflow */ + return(overflow); /* return status from higher add */ +} diff --git a/lib/ack/float/adder.h b/lib/ack/float/adder.h new file mode 100755 index 000000000..2fed41451 --- /dev/null +++ b/lib/ack/float/adder.h @@ -0,0 +1,15 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * include file for 32 & 64 bit addition + */ + +typedef struct B64 { + unsigned long h_32; /* higher 32 bits of 64 */ + unsigned long l_32; /* lower 32 bits of 64 */ +} B64; diff --git a/lib/ack/float/adf4.fc b/lib/ack/float/adf4.fc new file mode 100755 index 000000000..572f3daa3 --- /dev/null +++ b/lib/ack/float/adf4.fc @@ -0,0 +1,32 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ADD TWO FLOATS - SINGLE (ADF 4) +*/ + +#include "FP_types.h" + +void +adf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + int swap = 0; + + if (s1 == (SINGLE) 0) { + s1 = s2; + return; + } + if (s2 == (SINGLE) 0) { + return; + } + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + add_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/float/adf8.fc b/lib/ack/float/adf8.fc new file mode 100755 index 000000000..387c975c0 --- /dev/null +++ b/lib/ack/float/adf8.fc @@ -0,0 +1,32 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ADD TWO FLOATS - DOUBLE (ADF 8) +*/ + +#include "FP_types.h" + +void +adf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1,e2; + + if (s1.d[0] == 0 && s1.d[1] == 0) { + s1 = s2; + return; + } + if (s2.d[0] == 0 && s2.d[1] == 0) { + return; + } + + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + add_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/float/byte_order.h b/lib/ack/float/byte_order.h new file mode 100755 index 000000000..d08b45a5d --- /dev/null +++ b/lib/ack/float/byte_order.h @@ -0,0 +1,6 @@ +#define CHAR_UNSIGNED 0 +#define MSB_AT_LOW_ADDRESS 0 +#define MSW_AT_LOW_ADDRESS 0 +#define FL_MSB_AT_LOW_ADDRESS 0 +#define FL_MSW_AT_LOW_ADDRESS 0 +#define FL_MSL_AT_LOW_ADDRESS 0 diff --git a/lib/ack/float/cff4.fc b/lib/ack/float/cff4.fc new file mode 100755 index 000000000..ae3b740c5 --- /dev/null +++ b/lib/ack/float/cff4.fc @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT DOUBLE TO SINGLE (CFF 8 4) + + This routine works quite simply. A floating point + of size 08 is converted to extended format. + This extended variable is converted back to + a floating point of size 04. + +*/ + +#include "FP_types.h" + +void +cff4(src) +DOUBLE src; /* the source itself - THIS TIME it's DOUBLE */ +{ + EXTEND buf; + + extend(&src.d[0],&buf,sizeof(DOUBLE)); /* no matter what */ + compact(&buf,&(src.d[1]),sizeof(SINGLE)); +} diff --git a/lib/ack/float/cff8.fc b/lib/ack/float/cff8.fc new file mode 100755 index 000000000..a851803ad --- /dev/null +++ b/lib/ack/float/cff8.fc @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT SINGLE TO DOUBLE (CFF 4 8) + + This routine works quite simply. A floating point + of size 04 is converted to extended format. + This extended variable is converted back to + a floating point of size 08. + +*/ + +#include "FP_types.h" + +void +cff8(src) +SINGLE src; +{ + EXTEND buf; + + extend(&src,&buf,sizeof(SINGLE)); /* no matter what */ + compact(&buf, &src,sizeof(DOUBLE)); +} diff --git a/lib/ack/float/cfi.fc b/lib/ack/float/cfi.fc new file mode 100755 index 000000000..cfd28230e --- /dev/null +++ b/lib/ack/float/cfi.fc @@ -0,0 +1,52 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT FLOAT TO SIGNED (CFI m n) + + N.B. The caller must know what it is getting. + A LONG is always returned. If it is an + integer the high byte is cleared first. +*/ + +#include "FP_trap.h" +#include "FP_types.h" +#include "FP_shift.h" + +long +cfi(ds,ss,src) +int ds; /* destination size (2 or 4) */ +int ss; /* source size (4 or 8) */ +DOUBLE src; /* assume worst case */ +{ + EXTEND buf; + long new; + short max_exp; + + extend(&src.d[0],&buf,ss); /* get extended format */ + if (buf.exp < 0) { /* no conversion needed */ + src.d[ss == 8] = 0L; + return(0L); + } + max_exp = (ds << 3) - 2; /* signed numbers */ + /* have more limited max_exp */ + if (buf.exp > max_exp) { + if (buf.exp == max_exp+1 && buf.sign && buf.m1 == NORMBIT && + buf.m2 == 0L) { + } + else { + trap(EIOVFL); /* integer overflow */ + buf.exp %= max_exp; /* truncate */ + } + } + new = buf.m1 >> (31-buf.exp); + if (buf.sign) + new = -new; +done: + src.d[ss == 8] = new; + return(new); +} diff --git a/lib/ack/float/cfu.fc b/lib/ack/float/cfu.fc new file mode 100755 index 000000000..e9a551ac7 --- /dev/null +++ b/lib/ack/float/cfu.fc @@ -0,0 +1,43 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT FLOAT TO UNSIGNED (CFU m n) + + N.B. The caller must know what it is getting. + A LONG is always returned. If it is an + integer the high byte is cleared first. +*/ + +#include "FP_trap.h" +#include "FP_types.h" + +long +cfu(ds,ss,src) +int ds; /* destination size (2 or 4) */ +int ss; /* source size (4 or 8) */ +DOUBLE src; /* assume worst case */ +{ + EXTEND buf; + long new; + short newint, max_exp; + + extend(&src.d[0],&buf,ss); /* get extended format */ + if (buf.exp < 0) { /* no conversion needed */ + src.d[ss == 8] = 0L; + return(0L); + } + max_exp = (ds << 3) - 1; + if (buf.exp > max_exp) { + trap(EIOVFL); /* integer overflow */ + buf.exp %= max_exp; + } + new = buf.m1 >> (31-buf.exp); +done: + src.d[ss == 8] = new; + return(new); +} diff --git a/lib/ack/float/cif4.fc b/lib/ack/float/cif4.fc new file mode 100755 index 000000000..160d5f6d2 --- /dev/null +++ b/lib/ack/float/cif4.fc @@ -0,0 +1,56 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO SINGLE (CIF n 4) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cif4(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + short *ipt; + long i_src; + SINGLE *result; + + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + result = (SINGLE *) &src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + result = (SINGLE *) &ss; + } + if (i_src == 0) { + *result = (SINGLE) 0L; + return; + } + /* ESTABLISHED THAT src != 0 */ + /* adjust exponent field */ + buf.sign = (i_src < 0) ? 0x8000 : 0; + /* clear sign bit of integer */ + /* move to mantissa field */ + buf.m1 = (i_src < 0) ? -i_src : i_src; + /* adjust mantissa field */ + if (ss != sizeof(long)) + buf.m1 <<= 16; + nrm_ext(&buf); /* adjust mantissa field */ + compact(&buf, result,sizeof(SINGLE)); /* put on stack */ +} diff --git a/lib/ack/float/cif8.fc b/lib/ack/float/cif8.fc new file mode 100755 index 000000000..1ab979813 --- /dev/null +++ b/lib/ack/float/cif8.fc @@ -0,0 +1,55 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO FLOAT (CIF n 8) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cif8(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + DOUBLE *result; /* for return value */ + short *ipt; + long i_src; + + result = (DOUBLE *) ((void *) &ss); /* always */ + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + } + if (i_src == 0) { + zrf8(result); + return; + } + /* ESTABLISHED THAT src != 0 */ + /* adjust exponent field */ + buf.sign = (i_src < 0) ? 0x8000 : 0; + /* clear sign bit of integer */ + /* move to mantissa field */ + buf.m1 = (i_src < 0) ? -i_src : i_src; + /* adjust mantissa field */ + if (ss != sizeof(long)) + buf.m1 <<= 16; + nrm_ext(&buf); + compact(&buf,&result->d[0],8); +} diff --git a/lib/ack/float/cmf4.fc b/lib/ack/float/cmf4.fc new file mode 100755 index 000000000..ee186ff4c --- /dev/null +++ b/lib/ack/float/cmf4.fc @@ -0,0 +1,40 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + COMPARE SINGLES (CMF 4) +*/ + +#include "FP_types.h" +#include "get_put.h" + +int +cmf4(f1,f2) +SINGLE f1,f2; +{ + /* + * return ((f1 < f2) ? 1 : (f1 - f2)) + */ +#define SIGN(x) (((x) < 0) ? -1 : 1) + int sign1,sign2; + long l1,l2; + + l1 = get4((char *) &f1); + l2 = get4((char *) &f2); + + if (l1 == l2) return 0; + + sign1 = SIGN(l1); + sign2 = SIGN(l2); + if (sign1 != sign2) { + if ((l1 & 0x7fffffff) == 0 && + (l2 & 0x7fffffff) == 0) return 0; + return ((sign1 > 0) ? -1 : 1); + } + + return (sign1 * ((l1 < l2) ? 1 : -1)); +} diff --git a/lib/ack/float/cmf8.fc b/lib/ack/float/cmf8.fc new file mode 100755 index 000000000..5badab0c4 --- /dev/null +++ b/lib/ack/float/cmf8.fc @@ -0,0 +1,61 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + COMPARE DOUBLES (CMF 8) +*/ + +#include "FP_types.h" +#include "get_put.h" + +int +cmf8(d1,d2) +DOUBLE d1,d2; +{ +#define SIGN(x) (((x) < 0) ? -1 : 1) + /* + * return ((d1 < d2) ? 1 : (d1 > d2) ? -1 : 0)) + */ + long l1,l2; + int sign1,sign2; + int rv; + +#if FL_MSL_AT_LOW_ADDRESS + l1 = get4((char *)&d1); + l2 = get4((char *)&d2); +#else + l1 = get4(((char *)&d1+4)); + l2 = get4(((char *)&d2+4)); +#endif + sign1 = SIGN(l1); + sign2 = SIGN(l2); + if (sign1 != sign2) { + l1 &= 0x7fffffff; + l2 &= 0x7fffffff; + if (l1 != 0 || l2 != 0) { + return ((sign1 > 0) ? -1 : 1); + } + } + if (l1 != l2) { /* we can decide here */ + rv = l1 < l2 ? 1 : -1; + } + else { /* decide in 2nd half */ + unsigned long u1, u2; +#if FL_MSL_AT_LOW_ADDRESS + u1 = get4(((char *)&d1 + 4)); + u2 = get4(((char *)&d2 + 4)); +#else + u1 = get4((char *)&d1); + u2 = get4((char *)&d2); +#endif + if (u1 == u2) + return(0); + if (u1 < u2) rv = 1; + else rv = -1; + } + return sign1 * rv; +} diff --git a/lib/ack/float/compact.fc b/lib/ack/float/compact.fc new file mode 100755 index 000000000..a5a1074d1 --- /dev/null +++ b/lib/ack/float/compact.fc @@ -0,0 +1,202 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + COMPACT EXTEND FORMAT INTO FLOAT OF PROPER SIZE +*/ + +# include "FP_bias.h" +# include "FP_shift.h" +# include "FP_trap.h" +# include "FP_types.h" +# include "get_put.h" + +void +compact(f,to,size) +EXTEND *f; +unsigned long *to; +int size; +{ + int error = 0; + + if (size == sizeof(DOUBLE)) { + /* + * COMPACT EXTENDED INTO DOUBLE + */ + DOUBLE *DBL = (DOUBLE *) (void *) to; + + if ((f->m1|(f->m2 & DBL_ZERO)) == 0L) { + zrf8(DBL); + return; + } + f->exp += DBL_BIAS; /* restore proper bias */ + if (f->exp > DBL_MAX) { +dbl_over: trap(EFOVFL); + f->exp = DBL_MAX+1; + f->m1 = 0; + f->m2 = 0; + if (error++) + return; + } + else if (f->exp < DBL_MIN) { + b64_rsft(&(f->mantissa)); + if (f->exp < 0) { + b64_sft(&(f->mantissa), -f->exp); + f->exp = 0; + } + /* underflow ??? */ + } + + /* local CAST conversion */ + + /* because of special format shift only 10 bits */ + /* bit shift mantissa 10 bits */ + + /* first align within words, then do store operation */ + + DBL->d[0] = f->m1 >> DBL_RUNPACK; /* plus 22 == 32 */ + DBL->d[1] = f->m2 >> DBL_RUNPACK; /* plus 22 == 32 */ + DBL->d[1] |= (f->m1 << DBL_LUNPACK); /* plus 10 == 32 */ + + /* if not exact then round to nearest */ + /* on a tie, round to even */ + +#ifdef EXCEPTION_INEXACT + if ((f->m2 & DBL_EXACT) != 0) { + INEXACT(); +#endif + if (((f->m2 & DBL_EXACT) > DBL_ROUNDUP) + || ((f->m2 & DBL_EXACT) == DBL_ROUNDUP + && (f->m2 & (DBL_ROUNDUP << 1)))) { + DBL->d[1]++; /* rounding up */ + if (DBL->d[1] == 0L) { /* carry out */ + DBL->d[0]++; + + if (f->exp == 0 && (DBL->d[0] & ~DBL_MASK)) { + f->exp++; + } + if (DBL->d[0] & DBL_CARRYOUT) { /* carry out */ + if (DBL->d[0] & 01) + DBL->d[1] = CARRYBIT; + DBL->d[0] >>= 1; + f->exp++; + } + } + /* check for overflow */ + if (f->exp > DBL_MAX) + goto dbl_over; + } +#ifdef EXCEPTION_INEXACT + } +#endif + + /* + * STORE EXPONENT AND SIGN: + * + * 1) clear leading bits (B4-B15) + * 2) shift and store exponent + */ + + DBL->d[0] &= DBL_MASK; + DBL->d[0] |= + ((long) (f->exp << DBL_EXPSHIFT) << EXP_STORE); + if (f->sign) + DBL->d[0] |= CARRYBIT; + + /* + * STORE MANTISSA + */ + +#if FL_MSL_AT_LOW_ADDRESS + put4(DBL->d[0], (char *) &DBL->d[0]); + put4(DBL->d[1], (char *) &DBL->d[1]); +#else + { unsigned long l; + put4(DBL->d[1], (char *) &l); + put4(DBL->d[0], (char *) &DBL->d[1]); + DBL->d[0] = l; + } +#endif + } + else { + /* + * COMPACT EXTENDED INTO FLOAT + */ + SINGLE *SGL; + + /* local CAST conversion */ + SGL = (SINGLE *) (void *) to; + if ((f->m1 & SGL_ZERO) == 0L) { + *SGL = 0L; + return; + } + f->exp += SGL_BIAS; /* restore bias */ + if (f->exp > SGL_MAX) { +sgl_over: trap(EFOVFL); + f->exp = SGL_MAX+1; + f->m1 = 0L; + f->m2 = 0L; + if (error++) + return; + } + else if (f->exp < SGL_MIN) { + b64_rsft(&(f->mantissa)); + if (f->exp < 0) { + b64_sft(&(f->mantissa), -f->exp); + f->exp = 0; + } + /* underflow ??? */ + } + + /* shift mantissa and store */ + *SGL = (f->m1 >> SGL_RUNPACK); + + /* check for rounding to nearest */ + /* on a tie, round to even */ +#ifdef EXCEPTION_INEXACT + if (f->m2 != 0 || + (f->m1 & SGL_EXACT) != 0L) { + INEXACT(); +#endif + if (((f->m1 & SGL_EXACT) > SGL_ROUNDUP) + || ((f->m1 & SGL_EXACT) == SGL_ROUNDUP + && (f->m1 & (SGL_ROUNDUP << 1)))) { + (*SGL)++; + if (f->exp == 0 && (*SGL & ~SGL_MASK)) { + f->exp++; + } + /* check normal */ + if (*SGL & SGL_CARRYOUT) { + *SGL >>= 1; + f->exp++; + } + if (f->exp > SGL_MAX) + goto sgl_over; + } +#ifdef EXCEPTION_INEXACT + } +#endif + + /* + * STORE EXPONENT AND SIGN: + * + * 1) clear leading bit of fraction + * 2) shift and store exponent + */ + + *SGL &= SGL_MASK; /* B23-B31 are 0 */ + *SGL |= ((long) (f->exp << SGL_EXPSHIFT) << EXP_STORE); + if (f->sign) + *SGL |= CARRYBIT; + + /* + * STORE MANTISSA + */ + + put4(*SGL, (char *) &SGL); + } +} diff --git a/lib/ack/float/cuf4.fc b/lib/ack/float/cuf4.fc new file mode 100755 index 000000000..c022f0e90 --- /dev/null +++ b/lib/ack/float/cuf4.fc @@ -0,0 +1,57 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO SINGLE (CUF n 4) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cuf4(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + short *ipt; + SINGLE *result; + long i_src; + + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + result = (SINGLE *) &src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + result = (SINGLE *) ((void *) &ss); + } + if (i_src == 0) { + *result = (SINGLE) 0L; + return; + } + /* ESTABLISHED THAT src != 0 */ + + /* adjust exponent field */ + if (ss != sizeof(long)) + i_src <<= 16; + + /* move to mantissa field */ + buf.m1 = i_src; + + /* adjust mantissa field */ + nrm_ext(&buf); + compact(&buf,result,4); +} diff --git a/lib/ack/float/cuf8.fc b/lib/ack/float/cuf8.fc new file mode 100755 index 000000000..d18ec6c7a --- /dev/null +++ b/lib/ack/float/cuf8.fc @@ -0,0 +1,54 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO FLOAT (CUF n 8) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cuf8(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + short *ipt; + long i_src; + + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + } + if (i_src == 0) { + zrf8((DOUBLE *)((void *)&ss)); + return; + } + /* ESTABLISHED THAT src != 0 */ + + /* adjust exponent field */ + if (ss != sizeof(long)) + i_src <<= 16; + + /* move to mantissa field */ + buf.m1 = i_src; + + /* adjust mantissa field */ + nrm_ext(&buf); + compact(&buf,(unsigned long *) (void *)&ss,8); +} diff --git a/lib/ack/float/div_ext.fc b/lib/ack/float/div_ext.fc new file mode 100755 index 000000000..bb9531178 --- /dev/null +++ b/lib/ack/float/div_ext.fc @@ -0,0 +1,266 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + DIVIDE EXTENDED FORMAT +*/ + +#include "FP_bias.h" +#include "FP_trap.h" +#include "FP_types.h" + +/* + November 15, 1984 + + This is a routine to do the work. + There are two versions: + One is based on the partial products method + and makes no use possible machine instructions + to divide (hardware dividers). + The other is used when USE_DIVIDE is defined. It is much faster on + machines with fast 4 byte operations. +*/ +/********************************************************/ + +void +div_ext(e1,e2) +EXTEND *e1,*e2; +{ + short error = 0; + B64 result; + register unsigned long *lp; +#ifndef USE_DIVIDE + short count; +#else + unsigned short u[9], v[5]; + register int j; + register unsigned short *u_p = u; + int maxv = 4; +#endif + + if ((e2->m1 | e2->m2) == 0) { + /* + * Exception 8.2 - Divide by zero + */ + trap(EFDIVZ); + e1->m1 = e1->m2 = 0L; + e1->exp = EXT_MAX; + return; + } + if ((e1->m1 | e1->m2) == 0) { /* 0 / anything == 0 */ + e1->exp = 0; /* make sure */ + return; + } +#ifndef USE_DIVIDE + /* + * numbers are right shifted one bit to make sure + * that m1 is quaranteed to be larger if its + * maximum bit is set + */ + b64_rsft(&e1->mantissa); /* 64 bit shift right */ + b64_rsft(&e2->mantissa); /* 64 bit shift right */ + e1->exp++; + e2->exp++; +#endif + /* check for underflow, divide by zero, etc */ + e1->sign ^= e2->sign; + e1->exp -= e2->exp; + +#ifndef USE_DIVIDE + /* do division of mantissas */ + /* uses partial product method */ + /* init control variables */ + + count = 64; + result.h_32 = 0L; + result.l_32 = 0L; + + /* partial product division loop */ + + while (count--) { + /* first left shift result 1 bit */ + /* this is ALWAYS done */ + + b64_lsft(&result); + + /* compare dividend and divisor */ + /* if dividend >= divisor add a bit */ + /* and subtract divisior from dividend */ + + if ( (e1->m1 < e2->m1) || + ((e1->m1 == e2->m1) && (e1->m2 < e2->m2) )) + ; /* null statement */ + /* i.e., don't add or subtract */ + else { + result.l_32++; /* ADD */ + if (e2->m2 > e1->m2) + e1->m1 -= 1; /* carry in */ + e1->m1 -= e2->m1; /* do SUBTRACTION */ + e1->m2 -= e2->m2; /* SUBTRACTION */ + } + + /* shift dividend left one bit OR */ + /* IF it equals ZERO we can break out */ + /* of the loop, but still must shift */ + /* the quotient the remaining count bits */ + /* NB save the results of this test in error */ + /* if not zero, then the result is inexact. */ + /* this would be reported in IEEE standard */ + + /* lp points to dividend */ + lp = &e1->m1; + + error = ((*lp | *(lp+1)) != 0L) ? 1 : 0; + if (error) { /* more work */ + /* assume max bit == 0 (see above) */ + b64_lsft(&e1->mantissa); + continue; + } + else + break; /* leave loop */ + } /* end of divide by subtraction loop */ + + if (count > 0) { + lp = &result.h_32; + if (count > 31) { /* move to higher word */ + *lp = *(lp+1); + count -= 32; + *(lp+1) = 0L; /* clear low word */ + } + if (*lp) + *lp <<= count; /* shift rest of way */ + lp++; /* == &result.l_32 */ + if (*lp) { + result.h_32 |= (*lp >> 32-count); + *lp <<= count; + } + } +#else /* USE_DIVIDE */ + + u[4] = (e1->m2 & 1) << 15; + b64_rsft(&(e1->mantissa)); + u[0] = e1->m1 >> 16; + u[1] = e1->m1; + u[2] = e1->m2 >> 16; + u[3] = e1->m2; + u[5] = 0; u[6] = 0; u[7] = 0; + v[1] = e2->m1 >> 16; + v[2] = e2->m1; + v[3] = e2->m2 >> 16; + v[4] = e2->m2; + while (! v[maxv]) maxv--; + result.h_32 = 0; + result.l_32 = 0; + lp = &result.h_32; + + /* + * Use an algorithm of Knuth (The art of programming, Seminumerical + * algorithms), to divide u by v. u and v are both seen as numbers + * with base 65536. + */ + for (j = 0; j <= 3; j++, u_p++) { + unsigned long q_est, temp; + + if (j == 2) lp++; + if (u_p[0] == 0 && u_p[1] < v[1]) continue; + temp = ((unsigned long)u_p[0] << 16) + u_p[1]; + if (u_p[0] >= v[1]) { + q_est = 0x0000FFFFL; + } + else { + q_est = temp / v[1]; + } + temp -= q_est * v[1]; + while (temp < 0x10000 && v[2]*q_est > ((temp<<16)+u_p[2])) { + q_est--; + temp += v[1]; + } + /* Now, according to Knuth, we have an estimate of the + quotient, that is either correct or one too big, but + almost always correct. + */ + if (q_est != 0) { + int i; + unsigned long k = 0; + int borrow = 0; + + for (i = maxv; i > 0; i--) { + unsigned long tmp = q_est * v[i] + k + borrow; + unsigned short md = tmp; + + borrow = (md > u_p[i]); + u_p[i] -= md; + k = tmp >> 16; + } + k += borrow; + borrow = u_p[0] < k; + u_p[0] -= k; + + if (borrow) { + /* So, this does not happen often; the estimate + was one too big; correct this + */ + *lp |= (j & 1) ? (q_est - 1) : ((q_est-1)<<16); + borrow = 0; + for (i = maxv; i > 0; i--) { + unsigned long tmp + = v[i]+(unsigned long)u_p[i]+borrow; + + u_p[i] = tmp; + borrow = tmp >> 16; + } + u_p[0] += borrow; + } + else *lp |= (j & 1) ? q_est : (q_est<<16); + } + } +#ifdef EXCEPTION_INEXACT + u_p = &u[0]; + for (j = 7; j >= 0; j--) { + if (*u_p++) { + error = 1; + break; + } + } +#endif +#endif + +#ifdef EXCEPTION_INEXACT + if (error) { + /* + * report here exception 8.5 - Inexact + * from Draft 8.0 of IEEE P754: + * In the absence of an invalid operation exception, + * if the rounded result of an operation is not exact or if + * it overflows without a trap, then the inexact exception + * shall be assigned. The rounded or overflowed result + * shall be delivered to the destination. + */ + INEXACT(); +#endif + e1->mantissa = result; + + nrm_ext(e1); + if (e1->exp < EXT_MIN) { + /* + * Exception 8.4 - Underflow + */ + trap(EFUNFL); /* underflow */ + e1->exp = EXT_MIN; + e1->m1 = e1->m2 = 0L; + return; + } + if (e1->exp >= EXT_MAX) { + /* + * Exception 8.3 - Overflow + */ + trap(EFOVFL); /* overflow */ + e1->exp = EXT_MAX; + e1->m1 = e1->m2 = 0L; + return; + } +} diff --git a/lib/ack/float/dvf4.fc b/lib/ack/float/dvf4.fc new file mode 100755 index 000000000..7d82cd8b8 --- /dev/null +++ b/lib/ack/float/dvf4.fc @@ -0,0 +1,26 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + DIVIDE TWO SINGLES - SINGLE Precision (dvf 4) +*/ + +#include "FP_types.h" + +void +dvf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + + /* do a divide */ + div_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/float/dvf8.fc b/lib/ack/float/dvf8.fc new file mode 100755 index 000000000..fafe50f53 --- /dev/null +++ b/lib/ack/float/dvf8.fc @@ -0,0 +1,26 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + DIVIDE TWO FLOATS - DOUBLE Precision (DVF 8) +*/ + +#include "FP_types.h" + +void +dvf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + + /* do a divide */ + div_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/float/extend.fc b/lib/ack/float/extend.fc new file mode 100755 index 000000000..70febb1e3 --- /dev/null +++ b/lib/ack/float/extend.fc @@ -0,0 +1,111 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERTS FLOATING POINT TO EXTENDED FORMAT + + Two sizes of FLOATING Point are known: + SINGLE and DOUBLE +*/ +/********************************************************/ +/* + It is not required to normalize in extended + format, but it has been chosen to do so. + Extended Format is as follows (at exit): + +->sign S000 0000 | 0000 0000 +->exp 0EEE EEEE | EEEE EEEE +->m1 LFFF FFFF | FFFF FFFF + FFFF FFFF | FFFF FFFF +->m2 FFFF FFFF | FFFF FFFF + FFFF F000 | 0000 0000 +*/ +/********************************************************/ + +#include "FP_bias.h" +#include "FP_shift.h" +#include "FP_types.h" +#include "get_put.h" +/********************************************************/ + +void +extend(from,to,size) +unsigned long *from; +EXTEND *to; +int size; +{ + register char *cpt1; + unsigned long tmp; + int leadbit = 0; + + cpt1 = (char *) from; + +#if FL_MSL_AT_LOW_ADDRESS +#if FL_MSW_AT_LOW_ADDRESS + to->exp = uget2(cpt1); +#else + to->exp = uget2(cpt1+2); +#endif +#else +#if FL_MSW_AT_LOW_ADDRESS + to->exp = uget2(cpt1+(size == sizeof(DOUBLE) ? 4 : 0)); +#else + to->exp = uget2(cpt1+(size == sizeof(DOUBLE) ? 6 : 2)); +#endif +#endif + to->sign = (to->exp & 0x8000); /* set sign bit */ + to->exp ^= to->sign; + if (size == sizeof(DOUBLE)) + to->exp >>= DBL_EXPSHIFT; + else + to->exp >>= SGL_EXPSHIFT; + if (to->exp > 0) + leadbit++; /* will set Lead bit later */ + else to->exp++; + + if (size == sizeof(DOUBLE)) { +#if FL_MSL_AT_LOW_ADDRESS + to->m1 = get4(cpt1); + cpt1 += 4; + tmp = get4(cpt1); +#else + tmp = get4(cpt1); + cpt1 += 4; + to->m1 = get4(cpt1); +#endif + if (to->exp == 1 && to->m1 == 0 && tmp == 0) { + to->exp = 0; + to->sign = 0; + to->m1 = 0; + to->m2 = 0; + return; + } + to->m1 <<= DBL_M1LEFT; /* shift */ + to->exp -= DBL_BIAS; /* remove bias */ + to->m1 |= (tmp>>DBL_RPACK); /* plus 10 == 32 */ + to->m2 = (tmp<m1 = get4(cpt1); + to->m1 <<= SGL_M1LEFT; /* shift */ + if (to->exp == 1 && to->m1 == 0) { + to->exp = 0; + to->sign = 0; + to->m1 = 0; + to->m2 = 0; + return; + } + to->exp -= SGL_BIAS; /* remove bias */ + to->m2 = 0L; + } + + to->m1 |= NORMBIT; /* set bit L */ + if (leadbit == 0) { /* set or clear Leading Bit */ + to->m1 &= ~NORMBIT; /* clear bit L */ + nrm_ext(to); /* and normalize */ + } +} diff --git a/lib/ack/float/fef4.fc b/lib/ack/float/fef4.fc new file mode 100755 index 000000000..ff426f57b --- /dev/null +++ b/lib/ack/float/fef4.fc @@ -0,0 +1,33 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SEPERATE INTO EXPONENT AND FRACTION (FEF 4) +*/ + +#include "FP_types.h" + +void +fef4(r,s1) +SINGLE s1; +struct fef4_returns *r; +{ + EXTEND buf; + register struct fef4_returns *p = r; /* make copy; r might refer + to itself (see table) + */ + + extend(&s1,&buf,sizeof(SINGLE)); + if (buf.exp == 0 && buf.m1 == 0 && buf.m2 == 0) { + p->e = 0; + } + else { + p->e = buf.exp+1; + buf.exp = -1; + } + compact(&buf,&p->f,sizeof(SINGLE)); +} diff --git a/lib/ack/float/fef8.fc b/lib/ack/float/fef8.fc new file mode 100755 index 000000000..1c3b3b0b5 --- /dev/null +++ b/lib/ack/float/fef8.fc @@ -0,0 +1,33 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SEPERATE DOUBLE INTO EXPONENT AND FRACTION (FEF 8) +*/ + +#include "FP_types.h" + +void +fef8(r, s1) +DOUBLE s1; +struct fef8_returns *r; +{ + EXTEND buf; + register struct fef8_returns *p = r; /* make copy, r might refer + to itself (see table) + */ + + extend(&s1.d[0],&buf,sizeof(DOUBLE)); + if (buf.exp == 0 && buf.m1 == 0 && buf.m2 == 0) { + p->e = 0; + } + else { + p->e = buf.exp + 1; + buf.exp = -1; + } + compact(&buf,&p->f.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/float/fif4.fc b/lib/ack/float/fif4.fc new file mode 100755 index 000000000..059372469 --- /dev/null +++ b/lib/ack/float/fif4.fc @@ -0,0 +1,46 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + MULTIPLY AND DISMEMBER PARTS (FIF 4) +*/ + +#include "FP_types.h" +#include "FP_shift.h" + +void +fif4(p,x,y) +SINGLE x,y; +struct fif4_returns *p; +{ + + EXTEND e1,e2; + + extend(&y,&e1,sizeof(SINGLE)); + extend(&x,&e2,sizeof(SINGLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + e2 = e1; + compact(&e2,&y,sizeof(SINGLE)); + if (e1.exp < 0) { + p->ipart = 0; + p->fpart = y; + return; + } + if (e1.exp > 30 - SGL_M1LEFT) { + p->ipart = y; + p->fpart = 0; + return; + } + b64_sft(&e1.mantissa, 63 - e1.exp); + b64_sft(&e1.mantissa, e1.exp - 63); /* "loose" low order bits */ + compact(&e1,&(p->ipart),sizeof(SINGLE)); + extend(&(p->ipart), &e2, sizeof(SINGLE)); + extend(&y, &e1, sizeof(SINGLE)); + sub_ext(&e1, &e2); + compact(&e1, &(p->fpart), sizeof(SINGLE)); +} diff --git a/lib/ack/float/fif8.fc b/lib/ack/float/fif8.fc new file mode 100755 index 000000000..9f1b9b15e --- /dev/null +++ b/lib/ack/float/fif8.fc @@ -0,0 +1,48 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + MULTIPLY AND DISMEMBER PARTS (FIF 8) +*/ + +#include "FP_types.h" +#include "FP_shift.h" + +void +fif8(p,x,y) +DOUBLE x,y; +struct fif8_returns *p; +{ + + EXTEND e1,e2; + + extend(&y.d[0],&e1,sizeof(DOUBLE)); + extend(&x.d[0],&e2,sizeof(DOUBLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + e2 = e1; + compact(&e2, &y.d[0], sizeof(DOUBLE)); + if (e1.exp < 0) { + p->ipart.d[0] = 0; + p->ipart.d[1] = 0; + p->fpart = y; + return; + } + if (e1.exp > 62 - DBL_M1LEFT) { + p->ipart = y; + p->fpart.d[0] = 0; + p->fpart.d[1] = 0; + return; + } + b64_sft(&e1.mantissa, 63 - e1.exp); + b64_sft(&e1.mantissa, e1.exp - 63); /* "loose" low order bits */ + compact(&e1, &(p->ipart.d[0]), sizeof(DOUBLE)); + extend(&(p->ipart.d[0]), &e2, sizeof(DOUBLE)); + extend(&y.d[0], &e1, sizeof(DOUBLE)); + sub_ext(&e1, &e2); + compact(&e1, &(p->fpart.d[0]), sizeof(DOUBLE)); +} diff --git a/lib/ack/float/fptrp.s b/lib/ack/float/fptrp.s new file mode 100755 index 000000000..d2823f4d7 --- /dev/null +++ b/lib/ack/float/fptrp.s @@ -0,0 +1,19 @@ +# +.sect .text; .sect .rom; .sect .data; .sect .bss +.define __fptrp +.sect .text +__fptrp: +#if __i386 + push ebp + mov ebp, esp + mov eax, 8(bp) + call .Xtrp + leave + ret +#else /* i86 */ + push bp + mov bp, sp + mov ax, 4(bp) + call .Xtrp + jmp .cret +#endif diff --git a/lib/ack/float/get_put.h b/lib/ack/float/get_put.h new file mode 100755 index 000000000..9fd7f606f --- /dev/null +++ b/lib/ack/float/get_put.h @@ -0,0 +1,41 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +#include + +#if CHAR_UNSIGNED +#define Xchar(ch) (ch) +#else +#define Xchar(ch) ((ch) & 0377) +#endif + +#define BYTES_REVERSED (MSB_AT_LOW_ADDRESS != FL_MSB_AT_LOW_ADDRESS) +#define WORDS_REVERSED (MSW_AT_LOW_ADDRESS != FL_MSW_AT_LOW_ADDRESS) +#define LONGS_REVERSED (FL_MSL_AT_LOW_ADDRESS) + +#if BYTES_REVERSED +#define uget2(c) (Xchar((c)[1]) | ((unsigned) Xchar((c)[0]) << 8)) +#define Xput2(i, c) (((c)[1] = (i)), ((c)[0] = (i) >> 8)) +#define put2(i, c) { register int j = (i); Xput2(j, c); } +#else +#define uget2(c) (* ((unsigned short *) (c))) +#define Xput2(i, c) (* ((short *) (c)) = (i)) +#define put2(i, c) Xput2(i, c) +#endif + +#define get2(c) ((short) uget2(c)) + +#if WORDS_REVERSED || BYTES_REVERSED +#define get4(c) (uget2((c)+2) | ((long) uget2(c) << 16)) +#define put4(l, c) { register long x=(l); \ + Xput2((int)x,(c)+2); \ + Xput2((int)(x>>16),(c)); \ + } +#else +#define get4(c) (* ((long *) (c))) +#define put4(l, c) (* ((long *) (c)) = (l)) +#endif diff --git a/lib/ack/float/mlf4.fc b/lib/ack/float/mlf4.fc new file mode 100755 index 000000000..d5f515d19 --- /dev/null +++ b/lib/ack/float/mlf4.fc @@ -0,0 +1,25 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * Multiply Single Precesion Float (MLF 4) + */ + +#include "FP_types.h" + +void +mlf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/float/mlf8.fc b/lib/ack/float/mlf8.fc new file mode 100755 index 000000000..b43cdf3c1 --- /dev/null +++ b/lib/ack/float/mlf8.fc @@ -0,0 +1,25 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * Multiply Double Precision Float (MLF 8) + */ + +#include "FP_types.h" + +void +mlf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/float/mul_ext.fc b/lib/ack/float/mul_ext.fc new file mode 100755 index 000000000..78a614014 --- /dev/null +++ b/lib/ack/float/mul_ext.fc @@ -0,0 +1,98 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ROUTINE TO MULTIPLY TWO EXTENDED FORMAT NUMBERS +*/ + +# include "FP_bias.h" +# include "FP_trap.h" +# include "FP_types.h" +# include "FP_shift.h" + +void +mul_ext(e1,e2) +EXTEND *e1,*e2; +{ + register int i,j; /* loop control */ + unsigned short mp[4]; /* multiplier */ + unsigned short mc[4]; /* multipcand */ + unsigned short result[8]; /* result */ + register unsigned short *pres; + + /* first save the sign (XOR) */ + e1->sign ^= e2->sign; + + /* compute new exponent */ + e1->exp += e2->exp + 1; + /* 128 bit multiply of mantissas */ + + /* assign unknown long formats */ + /* to known unsigned word formats */ + mp[0] = e1->m1 >> 16; + mp[1] = (unsigned short) e1->m1; + mp[2] = e1->m2 >> 16; + mp[3] = (unsigned short) e1->m2; + mc[0] = e2->m1 >> 16; + mc[1] = (unsigned short) e2->m1; + mc[2] = e2->m2 >> 16; + mc[3] = (unsigned short) e2->m2; + for (i = 8; i--;) { + result[i] = 0; + } + /* + * fill registers with their components + */ + for(i=4, pres = &result[4];i--;pres--) if (mp[i]) { + unsigned short k = 0; + unsigned long mpi = mp[i]; + for(j=4;j--;) { + unsigned long tmp = (unsigned long)pres[j] + k; + if (mc[j]) tmp += mpi * mc[j]; + pres[j] = tmp; + k = tmp >> 16; + } + pres[-1] = k; + } + if (! (result[0] & 0x8000)) { + e1->exp--; + for (i = 0; i <= 3; i++) { + result[i] <<= 1; + if (result[i+1]&0x8000) result[i] |= 1; + } + result[4] <<= 1; + } + + /* + * combine the registers to a total + */ + e1->m1 = ((unsigned long)(result[0]) << 16) + result[1]; + e1->m2 = ((unsigned long)(result[2]) << 16) + result[3]; + if (result[4] & 0x8000) { + if (++e1->m2 == 0) + if (++e1->m1 == 0) { + e1->m1 = NORMBIT; + e1->exp++; + } + } + + /* check for overflow */ + if (e1->exp >= EXT_MAX) { + trap(EFOVFL); + /* if caught */ + /* return signed infinity */ + e1->exp = EXT_MAX; +infinity: e1->m1 = e1->m2 =0L; + return; + } + /* check for underflow */ + if (e1->exp < EXT_MIN) { + trap(EFUNFL); + e1->exp = EXT_MIN; + goto infinity; + } +} diff --git a/lib/ack/float/ngf4.fc b/lib/ack/float/ngf4.fc new file mode 100755 index 000000000..9f1f812ea --- /dev/null +++ b/lib/ack/float/ngf4.fc @@ -0,0 +1,27 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + NEGATE A FLOATING POINT (NGF 4) +*/ +/********************************************************/ + +#include "FP_types.h" +#include "get_put.h" + +#define OFF ((FL_MSW_AT_LOW_ADDRESS ? 0 : 2) + (FL_MSB_AT_LOW_ADDRESS ? 0 : 1)) +void +ngf4(f) +SINGLE f; +{ + unsigned char *p; + + if (f != (SINGLE) 0) { + p = (unsigned char *) &f + OFF; + *p ^= 0x80; + } +} diff --git a/lib/ack/float/ngf8.fc b/lib/ack/float/ngf8.fc new file mode 100755 index 000000000..473ffa510 --- /dev/null +++ b/lib/ack/float/ngf8.fc @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + NEGATE A FLOATING POINT (NGF 8) +*/ +/********************************************************/ + +#include "FP_types.h" +#include "get_put.h" + +#define OFF ((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) + (FL_MSB_AT_LOW_ADDRESS ? 0 : 1)) + +void +ngf8(f) +DOUBLE f; +{ + unsigned char *p; + + if (f.d[0] != 0 || f.d[1] != 0) { + p = (unsigned char *) &f + OFF; + *p ^= 0x80; + } +} diff --git a/lib/ack/float/nrm_ext.fc b/lib/ack/float/nrm_ext.fc new file mode 100755 index 000000000..dc83554b1 --- /dev/null +++ b/lib/ack/float/nrm_ext.fc @@ -0,0 +1,50 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/********************************************************/ +/* + NORMALIZE an EXTENDED FORMAT NUMBER +*/ +/********************************************************/ + +#include "FP_shift.h" +#include "FP_types.h" + +void +nrm_ext(e1) +EXTEND *e1; +{ + /* we assume that the mantissa != 0 */ + /* if it is then just return */ + /* to let it be a problem elsewhere */ + /* THAT IS, The exponent is not set to */ + /* zero. If we don't test here an */ + /* infinite loop is generated when */ + /* mantissa is zero */ + + if ((e1->m1 | e1->m2) == 0L) + return; + + /* if top word is zero mov low word */ + /* to top word, adjust exponent value */ + if (e1->m1 == 0L) { + e1->m1 = e1->m2; + e1->m2 = 0L; + e1->exp -= 32; + } + if ((e1->m1 & NORMBIT) == 0) { + unsigned long l = ((unsigned long)NORMBIT >> 1); + int cnt = -1; + + while (! (l & e1->m1)) { + l >>= 1; + cnt--; + } + e1->exp += cnt; + b64_sft(&(e1->mantissa), cnt); + } +} diff --git a/lib/ack/float/sbf4.fc b/lib/ack/float/sbf4.fc new file mode 100755 index 000000000..368c11102 --- /dev/null +++ b/lib/ack/float/sbf4.fc @@ -0,0 +1,27 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SUBTRACT TWO FLOATS - SINGLE Precision (SBF 4) +*/ + +#include "FP_types.h" + +void +sbf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + + if (s2 == (SINGLE) 0) { + return; + } + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + sub_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/float/sbf8.fc b/lib/ack/float/sbf8.fc new file mode 100755 index 000000000..9d4c1067c --- /dev/null +++ b/lib/ack/float/sbf8.fc @@ -0,0 +1,27 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SUBTRACT TWO FLOATS - DOUBLE Precision (SBF 8) +*/ + +#include "FP_types.h" + +void +sbf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1, e2; + + if (s2.d[0] == 0 && s2.d[1] == 0) { + return; + } + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + sub_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/float/sft_ext.fc b/lib/ack/float/sft_ext.fc new file mode 100755 index 000000000..a933f9dc9 --- /dev/null +++ b/lib/ack/float/sft_ext.fc @@ -0,0 +1,39 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SHIFT TWO EXTENDED NUMBERS INTO PROPER + ALIGNMENT FOR ADDITION (exponents are equal) + Numbers should not be zero on entry. +*/ + +#include "FP_types.h" + +void +sft_ext(e1,e2) +EXTEND *e1,*e2; +{ + register EXTEND *s; + register int diff; + + diff = e1->exp - e2->exp; + + if (!diff) + return; /* exponents are equal */ + + if (diff < 0) { /* e2 is larger */ + /* shift e1 */ + diff = -diff; + s = e1; + } + else /* e1 is larger */ + /* shift e2 */ + s = e2; + + s->exp += diff; + b64_sft(&(s->mantissa), diff); +} diff --git a/lib/ack/float/shifter.fc b/lib/ack/float/shifter.fc new file mode 100755 index 000000000..089da20c2 --- /dev/null +++ b/lib/ack/float/shifter.fc @@ -0,0 +1,75 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +# include "FP_types.h" + +void +b64_sft(e1,n) +B64 *e1; +int n; +{ + if (n > 0) { + if (n > 63) { + e1->l_32 = 0; + e1->h_32 = 0; + return; + } + if (n >= 32) { + e1->l_32 = e1->h_32; + e1->h_32 = 0; + n -= 32; + } + if (n > 0) { + e1->l_32 >>= n; + if (e1->h_32 != 0) { + e1->l_32 |= (e1->h_32 << (32 - n)); + e1->h_32 >>= n; + } + } + return; + } + n = -n; + if (n > 0) { + if (n > 63) { + e1->l_32 = 0; + e1->h_32 = 0; + return; + } + if (n >= 32) { + e1->h_32 = e1->l_32; + e1->l_32 = 0; + n -= 32; + } + if (n > 0) { + e1->h_32 <<= n; + if (e1->l_32 != 0) { + e1->h_32 |= (e1->l_32 >> (32 - n)); + e1->l_32 <<= n; + } + } + } +} + +void +b64_lsft(e1) +B64 *e1; +{ + /* shift left 1 bit */ + e1->h_32 <<= 1; + if (e1->l_32 & 0x80000000L) e1->h_32 |= 1; + e1->l_32 <<= 1; +} + +void +b64_rsft(e1) +B64 *e1; +{ + /* shift right 1 bit */ + e1->l_32 >>= 1; + if (e1->h_32 & 1) e1->l_32 |= 0x80000000L; + e1->h_32 >>= 1; +} diff --git a/lib/ack/float/sub_ext.fc b/lib/ack/float/sub_ext.fc new file mode 100755 index 000000000..64180aa6f --- /dev/null +++ b/lib/ack/float/sub_ext.fc @@ -0,0 +1,53 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SUBTRACT 2 EXTENDED FORMAT NUMBERS +*/ + +#include "FP_types.h" + +void +sub_ext(e1,e2) +EXTEND *e1,*e2; +{ + if ((e2->m1 | e2->m2) == 0L) { + return; + } + if ((e1->m1 | e1->m2) == 0L) { + *e1 = *e2; + e1->sign = e2->sign ? 0 : 1; + return; + } + sft_ext(e1, e2); + if (e1->sign != e2->sign) { + /* e1 - e2 = e1 + (-e2) */ + if (b64_add(&e1->mantissa,&e2->mantissa)) { /* addition carry */ + b64_rsft(&e1->mantissa); /* shift mantissa one bit RIGHT */ + e1->m1 |= 0x80000000L; /* set max bit */ + e1->exp++; /* increase the exponent */ + } + } + else if (e2->m1 > e1->m1 || + (e2->m1 == e1->m1 && e2->m2 > e1->m2)) { + /* abs(e2) > abs(e1) */ + if (e1->m2 > e2->m2) { + e2->m1 -= 1; /* carry in */ + } + e2->m1 -= e1->m1; + e2->m2 -= e1->m2; + *e1 = *e2; + e1->sign = e2->sign ? 0 : 1; + } + else { + if (e2->m2 > e1->m2) + e1->m1 -= 1; /* carry in */ + e1->m1 -= e2->m1; + e1->m2 -= e2->m2; + } + nrm_ext(e1); +} diff --git a/lib/ack/float/zrf4.fc b/lib/ack/float/zrf4.fc new file mode 100755 index 000000000..a913e813d --- /dev/null +++ b/lib/ack/float/zrf4.fc @@ -0,0 +1,19 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + return a zero float (ZRF 4) +*/ + +#include "FP_types.h" + +void +zrf4(l) +SINGLE *l; +{ + *l = 0L; +} diff --git a/lib/ack/float/zrf8.fc b/lib/ack/float/zrf8.fc new file mode 100755 index 000000000..4fcdbb85b --- /dev/null +++ b/lib/ack/float/zrf8.fc @@ -0,0 +1,21 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + return a zero double (ZRF 8) +*/ + +#include "FP_types.h" + +void +zrf8(z) +DOUBLE *z; +{ + + z->d[0] = 0L; + z->d[1] = 0L; +} diff --git a/lib/ack/float/zrf_ext.fc b/lib/ack/float/zrf_ext.fc new file mode 100755 index 000000000..8f5878989 --- /dev/null +++ b/lib/ack/float/zrf_ext.fc @@ -0,0 +1,22 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ZERO and return EXTEND FORMAT FLOAT +*/ + +#include "FP_types.h" + +void +zrf_ext(e) +EXTEND *e; +{ + e->m1 = 0; + e->m2 = 0; + e->exp = 0; + e->sign = 0; +} diff --git a/lib/ack/fphook/FP.compile b/lib/ack/fphook/FP.compile new file mode 100755 index 000000000..3ca814d8a --- /dev/null +++ b/lib/ack/fphook/FP.compile @@ -0,0 +1,19 @@ +#!/bin/sh +# Author: Kees J. Bot +# Compile one soft FP source file. +# (These files shouldn't be optimized normally, but the 16-bit C compiler +# only optimizes scratch register allocation a bit with -O. To the 32-bit +# compiler -O is a no-op.) + +case $#:$1 in +1:*.fc) ;; +*) echo "$0: $1: not a FC file" >&2; exit 1 +esac + +base="`basename "$1" .fc`" +trap 'rm -f tmp.c tmp.s"; exit 1' 2 + +cp "$1" tmp.c && +cc -O -I. -D_MINIX -D_POSIX_SOURCE -S tmp.c && +sed -f FP.script tmp.s > "$base.s" && +rm tmp.c tmp.s diff --git a/lib/ack/fphook/FP.script b/lib/ack/fphook/FP.script new file mode 100755 index 000000000..56a3fd608 --- /dev/null +++ b/lib/ack/fphook/FP.script @@ -0,0 +1,39 @@ +s/_adf4/.adf4/ +s/_adf8/.adf8/ +s/_cff4/.cff4/ +s/_cff8/.cff8/ +s/_cfi/.cfi/ +s/_cfu/.cfu/ +s/_cif4/.cif4/ +s/_cif8/.cif8/ +s/_cmf4/.cmf4/ +s/_cmf8/.cmf8/ +s/_cuf4/.cuf4/ +s/_cuf8/.cuf8/ +s/_dvf4/.dvf4/ +s/_dvf8/.dvf8/ +s/_fef4/.fef4/ +s/_fef8/.fef8/ +s/_fif4/.fif4/ +s/_fif8/.fif8/ +s/_mlf4/.mlf4/ +s/_mlf8/.mlf8/ +s/_ngf4/.ngf4/ +s/_ngf8/.ngf8/ +s/_sbf4/.sbf4/ +s/_sbf8/.sbf8/ +s/_zrf4/.zrf4/ +s/_zrf8/.zrf8/ +s/_add_ext/.add_ext/ +s/_div_ext/.div_ext/ +s/_mul_ext/.mul_ext/ +s/_nrm_ext/.nrm_ext/ +s/_sft_ext/.sft_ext/ +s/_sub_ext/.sub_ext/ +s/_zrf_ext/.zrf_ext/ +s/_compact/.compact/ +s/_extend/.extend/ +s/_b64_add/.b64_add/ +s/_b64_sft/.b64_sft/ +s/_b64_rsft/.b64_rsft/ +s/_b64_lsft/.b64_lsft/ diff --git a/lib/ack/fphook/FP_bias.h b/lib/ack/fphook/FP_bias.h new file mode 100755 index 000000000..db17a4132 --- /dev/null +++ b/lib/ack/fphook/FP_bias.h @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + include file for floating point package +*/ + + /* FLOAT FORMAT EXPONENT BIAS */ + +#define SGL_BIAS 127 /* excess 128 notation used */ +#define DBL_BIAS 1023 /* excess 1024 notation used */ +#define EXT_BIAS 0 /* 2s-complement notation used */ + /* this is possible because the */ + /* sign is in a seperate word */ + + /* VARIOUS MAX AND MIN VALUES */ + /* 1) FOR THE DIFFERENT FORMATS */ + +#define SGL_MAX 254 /* standard definition */ +#define SGL_MIN 1 /* standard definition */ +#define DBL_MAX 2046 /* standard definition */ +#define DBL_MIN 1 /* standard definition */ +#define EXT_MAX 16383 /* standard minimum */ +#define EXT_MIN -16382 /* standard minimum */ diff --git a/lib/ack/fphook/FP_shift.h b/lib/ack/fphook/FP_shift.h new file mode 100755 index 000000000..5b685636f --- /dev/null +++ b/lib/ack/fphook/FP_shift.h @@ -0,0 +1,49 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + include file for floating point package +*/ + +# define CARRYBIT 0x80000000L +# define NORMBIT 0x80000000L +# define EXP_STORE 16 + + + /* parameters for Single Precision */ +#define SGL_EXPSHIFT 7 +#define SGL_M1LEFT 8 +#define SGL_ZERO 0xffffff80L +#define SGL_EXACT 0xff +#define SGL_RUNPACK SGL_M1LEFT + +#define SGL_ROUNDUP 0x80 +#define SGL_CARRYOUT 0x01000000L +#define SGL_MASK 0x007fffffL + + /* parameters for Double Precision */ + /* used in extend.c */ + +#define DBL_EXPSHIFT 4 + +#define DBL_M1LEFT 11 + +#define DBL_RPACK (32-DBL_M1LEFT) +#define DBL_LPACK DBL_M1LEFT + + /* used in compact.c */ + +#define DBL_ZERO 0xfffffd00L + +#define DBL_EXACT 0x7ff + +#define DBL_RUNPACK DBL_M1LEFT +#define DBL_LUNPACK (32-DBL_RUNPACK) + +#define DBL_ROUNDUP 0x400 +#define DBL_CARRYOUT 0x00200000L +#define DBL_MASK 0x000fffffL diff --git a/lib/ack/fphook/FP_trap.h b/lib/ack/fphook/FP_trap.h new file mode 100755 index 000000000..045897bc3 --- /dev/null +++ b/lib/ack/fphook/FP_trap.h @@ -0,0 +1,22 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + include file for floating point package +*/ + + /* EM TRAPS */ + +#define EIOVFL 3 /* Integer Overflow */ +#define EFOVFL 4 /* Floating Overflow */ +#define EFUNFL 5 /* Floating Underflow */ +#define EIDIVZ 6 /* Integer Divide by 0 */ +#define EFDIVZ 7 /* Floating Divide by 0.0 */ +#define EIUND 8 /* Integer Undefined Number */ +#define EFUND 9 /* Floating Undefined Number */ +#define ECONV 10 /* Conversion Error */ +# define trap(x) _fptrp(x) diff --git a/lib/ack/fphook/FP_types.h b/lib/ack/fphook/FP_types.h new file mode 100755 index 000000000..a23f32b89 --- /dev/null +++ b/lib/ack/fphook/FP_types.h @@ -0,0 +1,113 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/********************************************************/ +/* + Type definitions for C Floating Point Package + include file for floating point package +*/ +/********************************************************/ +/* + THESE STRUCTURES ARE USED TO ADDRESS THE INDIVIDUAL + PARTS OF THE FLOATING POINT NUMBER REPRESENTATIONS. + + THREE STRUCTURES ARE DEFINED: + SINGLE: single precision floating format + DOUBLE: double precision floating format + EXTEND: double precision extended format +*/ +/********************************************************/ + +#ifndef __FPTYPES +#define __FPTYPES + +typedef struct { + unsigned long h_32; /* higher 32 bits of 64 */ + unsigned long l_32; /* lower 32 bits of 64 */ +} B64; + +typedef unsigned long SINGLE; + +typedef struct { + unsigned long d[2]; +} DOUBLE; + +typedef struct { /* expanded float format */ + short sign; + short exp; + B64 mantissa; +#define m1 mantissa.h_32 +#define m2 mantissa.l_32 +} EXTEND; + +struct fef4_returns { + int e; + SINGLE f; +}; + +struct fef8_returns { + int e; + DOUBLE f; +}; + +struct fif4_returns { + SINGLE ipart; + SINGLE fpart; +}; + +struct fif8_returns { + DOUBLE ipart; + DOUBLE fpart; +}; + +#if __STDC__ +#define _PROTOTYPE(function, params) function params +#else +#define _PROTOTYPE(function, params) function() +#endif +_PROTOTYPE( void add_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void mul_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void div_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void sub_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void sft_ext, (EXTEND *e1, EXTEND *e2)); +_PROTOTYPE( void nrm_ext, (EXTEND *e1)); +_PROTOTYPE( void zrf_ext, (EXTEND *e1)); +_PROTOTYPE( void extend, (unsigned long *from, EXTEND *to, int size)); +_PROTOTYPE( void compact, (EXTEND *from, unsigned long *to, int size)); +_PROTOTYPE( void _fptrp, (int)); +_PROTOTYPE( void adf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void adf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void sbf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void sbf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void dvf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void dvf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void mlf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( void mlf8, (DOUBLE s2, DOUBLE s1)); +_PROTOTYPE( void ngf4, (SINGLE f)); +_PROTOTYPE( void ngf8, (DOUBLE f)); +_PROTOTYPE( void zrf4, (SINGLE *l)); +_PROTOTYPE( void zrf8, (DOUBLE *z)); +_PROTOTYPE( void cff4, (DOUBLE src)); +_PROTOTYPE( void cff8, (SINGLE src)); +_PROTOTYPE( void cif4, (int ss, long src)); +_PROTOTYPE( void cif8, (int ss, long src)); +_PROTOTYPE( void cuf4, (int ss, long src)); +_PROTOTYPE( void cuf8, (int ss, long src)); +_PROTOTYPE( long cfu, (int ds, int ss, DOUBLE src)); +_PROTOTYPE( long cfi, (int ds, int ss, DOUBLE src)); +_PROTOTYPE( int cmf4, (SINGLE s2, SINGLE s1)); +_PROTOTYPE( int cmf8, (DOUBLE d1, DOUBLE d2)); +_PROTOTYPE( void fef4, (struct fef4_returns *r, SINGLE s1)); +_PROTOTYPE( void fef8, (struct fef8_returns *r, DOUBLE s1)); +_PROTOTYPE( void fif4, (struct fif4_returns *p, SINGLE x, SINGLE y)); +_PROTOTYPE( void fif8, (struct fif8_returns *p, DOUBLE x, DOUBLE y)); + +_PROTOTYPE( void b64_sft, (B64 *, int)); +_PROTOTYPE( void b64_lsft, (B64 *)); +_PROTOTYPE( void b64_rsft, (B64 *)); +_PROTOTYPE( int b64_add, (B64 *, B64 *)); +#endif diff --git a/lib/ack/fphook/Makefile b/lib/ack/fphook/Makefile new file mode 100644 index 000000000..29f0d98e1 --- /dev/null +++ b/lib/ack/fphook/Makefile @@ -0,0 +1,19 @@ +# Makefile for lib/ack/fphook. + +# The ACK ANSI C compiler has an nice trick to reduce the size of programs +# that do not use floating point. If a program uses floating point then the +# compiler generates an external reference to the label '_fp_hook'. This makes +# the loader bring in the floating point printing and conversion routines +# '_f_print' and 'strtod' from the library libd.a. Otherwise two dummy +# routines are found in libc.a. (The printf and scanf need floating point +# for the %f formats, whether you use them or not.) + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE -I.. + +LIBRARIES = libd libc + +libd_OBJECTS = fphook.o + +libc_OBJECTS = fltpr.o strtod.o + +include ../../Makefile.ack.inc diff --git a/lib/ack/fphook/Makefile.ack.conv b/lib/ack/fphook/Makefile.ack.conv new file mode 100755 index 000000000..765313be6 --- /dev/null +++ b/lib/ack/fphook/Makefile.ack.conv @@ -0,0 +1,32 @@ +# Makefile for lib/i86/fphook. + +# The ACK ANSI C compiler has an nice trick to reduce the size of programs +# that do not use floating point. If a program uses floating point then the +# compiler generates an external reference to the label '_fp_hook'. This makes +# the loader bring in the floating point printing and conversion routines +# '_f_print' and 'strtod' from the library libd.a. Otherwise two dummy +# routines are found in libc.a. (The printf and scanf need floating point +# for the %f formats, whether you use them or not.) + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE +CC1 = $(CC) $(CFLAGS) -c -I$(SRCDIR)/ack + +LIBD = ../../libd.a +LIBC = ../../libc.a + +all: $(LIBD) $(LIBC) + +$(LIBD): fphook.c + $(CC1) fphook.c + aal cr $@ fphook.o + rm fphook.o + +$(LIBC): $(LIBC)(fltpr.o) $(LIBC)(strtod.o) + aal cr $@ *.o + rm *.o + +$(LIBC)(fltpr.o): fltpr.c + $(CC1) fltpr.c + +$(LIBC)(strtod.o): strtod.c + $(CC1) strtod.c diff --git a/lib/ack/fphook/add_ext.fc b/lib/ack/fphook/add_ext.fc new file mode 100755 index 000000000..a077663ab --- /dev/null +++ b/lib/ack/fphook/add_ext.fc @@ -0,0 +1,56 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ADD TWO EXTENDED FORMAT NUMBERS +*/ + +#include "FP_types.h" + +void +add_ext(e1,e2) +register EXTEND *e1,*e2; +{ + if ((e2->m1 | e2->m2) == 0L) { + return; + } + if ((e1->m1 | e1->m2) == 0L) { + *e1 = *e2; + return; + } + sft_ext(e1, e2); /* adjust mantissas to equal powers */ + if (e1->sign != e2->sign) { + /* e1 + e2 = e1 - (-e2) */ + if (e2->m1 > e1->m1 || + (e2->m1 == e1->m1 && e2->m2 > e1->m2)) { + /* abs(e2) > abs(e1) */ + EXTEND x; + + x = *e1; + *e1 = *e2; + if (x.m2 > e1->m2) { + e1->m1 -= 1; /* carry in */ + } + e1->m1 -= x.m1; + e1->m2 -= x.m2; + } + else { + if (e2->m2 > e1->m2) + e1->m1 -= 1; /* carry in */ + e1->m1 -= e2->m1; + e1->m2 -= e2->m2; + } + } + else { + if (b64_add(&e1->mantissa,&e2->mantissa)) { /* addition carry */ + b64_rsft(&e1->mantissa); /* shift mantissa one bit RIGHT */ + e1->m1 |= 0x80000000L; /* set max bit */ + e1->exp++; /* increase the exponent */ + } + } + nrm_ext(e1); +} diff --git a/lib/ack/fphook/adder.fc b/lib/ack/fphook/adder.fc new file mode 100755 index 000000000..a0af3ce75 --- /dev/null +++ b/lib/ack/fphook/adder.fc @@ -0,0 +1,50 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * these are the routines the routines to do 32 and 64-bit addition + */ + +# ifdef EXT_DEBUG +# include +# endif + +# include "FP_types.h" +# define UNKNOWN -1 +# define TRUE 1 +# define FALSE 0 +# define MAXBIT 0x80000000L + + /* + * add 64 bits + */ +int +b64_add(e1,e2) + /* + * pointers to 64 bit 'registers' + */ +register B64 *e1,*e2; +{ + register int overflow; + int carry; + + /* add higher pair of 32 bits */ + overflow = ((unsigned long) 0xFFFFFFFF - e1->h_32 < e2->h_32); + e1->h_32 += e2->h_32; + + /* add lower pair of 32 bits */ + carry = ((unsigned long) 0xFFFFFFFF - e1->l_32 < e2->l_32); + e1->l_32 += e2->l_32; +# ifdef EXT_DEBUG + printf("\t\t\t\t\tb64_add: overflow (%d); internal carry(%d)\n", + overflow,carry); + fflush(stdout); +# endif + if ((carry) && (++e1->h_32 == 0)) + return(TRUE); /* had a 64 bit overflow */ + return(overflow); /* return status from higher add */ +} diff --git a/lib/ack/fphook/adder.h b/lib/ack/fphook/adder.h new file mode 100755 index 000000000..2fed41451 --- /dev/null +++ b/lib/ack/fphook/adder.h @@ -0,0 +1,15 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * include file for 32 & 64 bit addition + */ + +typedef struct B64 { + unsigned long h_32; /* higher 32 bits of 64 */ + unsigned long l_32; /* lower 32 bits of 64 */ +} B64; diff --git a/lib/ack/fphook/adf4.fc b/lib/ack/fphook/adf4.fc new file mode 100755 index 000000000..572f3daa3 --- /dev/null +++ b/lib/ack/fphook/adf4.fc @@ -0,0 +1,32 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ADD TWO FLOATS - SINGLE (ADF 4) +*/ + +#include "FP_types.h" + +void +adf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + int swap = 0; + + if (s1 == (SINGLE) 0) { + s1 = s2; + return; + } + if (s2 == (SINGLE) 0) { + return; + } + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + add_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/fphook/adf8.fc b/lib/ack/fphook/adf8.fc new file mode 100755 index 000000000..387c975c0 --- /dev/null +++ b/lib/ack/fphook/adf8.fc @@ -0,0 +1,32 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ADD TWO FLOATS - DOUBLE (ADF 8) +*/ + +#include "FP_types.h" + +void +adf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1,e2; + + if (s1.d[0] == 0 && s1.d[1] == 0) { + s1 = s2; + return; + } + if (s2.d[0] == 0 && s2.d[1] == 0) { + return; + } + + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + add_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/fphook/byte_order.h b/lib/ack/fphook/byte_order.h new file mode 100755 index 000000000..d08b45a5d --- /dev/null +++ b/lib/ack/fphook/byte_order.h @@ -0,0 +1,6 @@ +#define CHAR_UNSIGNED 0 +#define MSB_AT_LOW_ADDRESS 0 +#define MSW_AT_LOW_ADDRESS 0 +#define FL_MSB_AT_LOW_ADDRESS 0 +#define FL_MSW_AT_LOW_ADDRESS 0 +#define FL_MSL_AT_LOW_ADDRESS 0 diff --git a/lib/ack/fphook/cff4.fc b/lib/ack/fphook/cff4.fc new file mode 100755 index 000000000..ae3b740c5 --- /dev/null +++ b/lib/ack/fphook/cff4.fc @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT DOUBLE TO SINGLE (CFF 8 4) + + This routine works quite simply. A floating point + of size 08 is converted to extended format. + This extended variable is converted back to + a floating point of size 04. + +*/ + +#include "FP_types.h" + +void +cff4(src) +DOUBLE src; /* the source itself - THIS TIME it's DOUBLE */ +{ + EXTEND buf; + + extend(&src.d[0],&buf,sizeof(DOUBLE)); /* no matter what */ + compact(&buf,&(src.d[1]),sizeof(SINGLE)); +} diff --git a/lib/ack/fphook/cff8.fc b/lib/ack/fphook/cff8.fc new file mode 100755 index 000000000..a851803ad --- /dev/null +++ b/lib/ack/fphook/cff8.fc @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT SINGLE TO DOUBLE (CFF 4 8) + + This routine works quite simply. A floating point + of size 04 is converted to extended format. + This extended variable is converted back to + a floating point of size 08. + +*/ + +#include "FP_types.h" + +void +cff8(src) +SINGLE src; +{ + EXTEND buf; + + extend(&src,&buf,sizeof(SINGLE)); /* no matter what */ + compact(&buf, &src,sizeof(DOUBLE)); +} diff --git a/lib/ack/fphook/cfi.fc b/lib/ack/fphook/cfi.fc new file mode 100755 index 000000000..cfd28230e --- /dev/null +++ b/lib/ack/fphook/cfi.fc @@ -0,0 +1,52 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT FLOAT TO SIGNED (CFI m n) + + N.B. The caller must know what it is getting. + A LONG is always returned. If it is an + integer the high byte is cleared first. +*/ + +#include "FP_trap.h" +#include "FP_types.h" +#include "FP_shift.h" + +long +cfi(ds,ss,src) +int ds; /* destination size (2 or 4) */ +int ss; /* source size (4 or 8) */ +DOUBLE src; /* assume worst case */ +{ + EXTEND buf; + long new; + short max_exp; + + extend(&src.d[0],&buf,ss); /* get extended format */ + if (buf.exp < 0) { /* no conversion needed */ + src.d[ss == 8] = 0L; + return(0L); + } + max_exp = (ds << 3) - 2; /* signed numbers */ + /* have more limited max_exp */ + if (buf.exp > max_exp) { + if (buf.exp == max_exp+1 && buf.sign && buf.m1 == NORMBIT && + buf.m2 == 0L) { + } + else { + trap(EIOVFL); /* integer overflow */ + buf.exp %= max_exp; /* truncate */ + } + } + new = buf.m1 >> (31-buf.exp); + if (buf.sign) + new = -new; +done: + src.d[ss == 8] = new; + return(new); +} diff --git a/lib/ack/fphook/cfu.fc b/lib/ack/fphook/cfu.fc new file mode 100755 index 000000000..e9a551ac7 --- /dev/null +++ b/lib/ack/fphook/cfu.fc @@ -0,0 +1,43 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT FLOAT TO UNSIGNED (CFU m n) + + N.B. The caller must know what it is getting. + A LONG is always returned. If it is an + integer the high byte is cleared first. +*/ + +#include "FP_trap.h" +#include "FP_types.h" + +long +cfu(ds,ss,src) +int ds; /* destination size (2 or 4) */ +int ss; /* source size (4 or 8) */ +DOUBLE src; /* assume worst case */ +{ + EXTEND buf; + long new; + short newint, max_exp; + + extend(&src.d[0],&buf,ss); /* get extended format */ + if (buf.exp < 0) { /* no conversion needed */ + src.d[ss == 8] = 0L; + return(0L); + } + max_exp = (ds << 3) - 1; + if (buf.exp > max_exp) { + trap(EIOVFL); /* integer overflow */ + buf.exp %= max_exp; + } + new = buf.m1 >> (31-buf.exp); +done: + src.d[ss == 8] = new; + return(new); +} diff --git a/lib/ack/fphook/cif4.fc b/lib/ack/fphook/cif4.fc new file mode 100755 index 000000000..160d5f6d2 --- /dev/null +++ b/lib/ack/fphook/cif4.fc @@ -0,0 +1,56 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO SINGLE (CIF n 4) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cif4(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + short *ipt; + long i_src; + SINGLE *result; + + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + result = (SINGLE *) &src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + result = (SINGLE *) &ss; + } + if (i_src == 0) { + *result = (SINGLE) 0L; + return; + } + /* ESTABLISHED THAT src != 0 */ + /* adjust exponent field */ + buf.sign = (i_src < 0) ? 0x8000 : 0; + /* clear sign bit of integer */ + /* move to mantissa field */ + buf.m1 = (i_src < 0) ? -i_src : i_src; + /* adjust mantissa field */ + if (ss != sizeof(long)) + buf.m1 <<= 16; + nrm_ext(&buf); /* adjust mantissa field */ + compact(&buf, result,sizeof(SINGLE)); /* put on stack */ +} diff --git a/lib/ack/fphook/cif8.fc b/lib/ack/fphook/cif8.fc new file mode 100755 index 000000000..1ab979813 --- /dev/null +++ b/lib/ack/fphook/cif8.fc @@ -0,0 +1,55 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO FLOAT (CIF n 8) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cif8(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + DOUBLE *result; /* for return value */ + short *ipt; + long i_src; + + result = (DOUBLE *) ((void *) &ss); /* always */ + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + } + if (i_src == 0) { + zrf8(result); + return; + } + /* ESTABLISHED THAT src != 0 */ + /* adjust exponent field */ + buf.sign = (i_src < 0) ? 0x8000 : 0; + /* clear sign bit of integer */ + /* move to mantissa field */ + buf.m1 = (i_src < 0) ? -i_src : i_src; + /* adjust mantissa field */ + if (ss != sizeof(long)) + buf.m1 <<= 16; + nrm_ext(&buf); + compact(&buf,&result->d[0],8); +} diff --git a/lib/ack/fphook/cmf4.fc b/lib/ack/fphook/cmf4.fc new file mode 100755 index 000000000..ee186ff4c --- /dev/null +++ b/lib/ack/fphook/cmf4.fc @@ -0,0 +1,40 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + COMPARE SINGLES (CMF 4) +*/ + +#include "FP_types.h" +#include "get_put.h" + +int +cmf4(f1,f2) +SINGLE f1,f2; +{ + /* + * return ((f1 < f2) ? 1 : (f1 - f2)) + */ +#define SIGN(x) (((x) < 0) ? -1 : 1) + int sign1,sign2; + long l1,l2; + + l1 = get4((char *) &f1); + l2 = get4((char *) &f2); + + if (l1 == l2) return 0; + + sign1 = SIGN(l1); + sign2 = SIGN(l2); + if (sign1 != sign2) { + if ((l1 & 0x7fffffff) == 0 && + (l2 & 0x7fffffff) == 0) return 0; + return ((sign1 > 0) ? -1 : 1); + } + + return (sign1 * ((l1 < l2) ? 1 : -1)); +} diff --git a/lib/ack/fphook/cmf8.fc b/lib/ack/fphook/cmf8.fc new file mode 100755 index 000000000..5badab0c4 --- /dev/null +++ b/lib/ack/fphook/cmf8.fc @@ -0,0 +1,61 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + COMPARE DOUBLES (CMF 8) +*/ + +#include "FP_types.h" +#include "get_put.h" + +int +cmf8(d1,d2) +DOUBLE d1,d2; +{ +#define SIGN(x) (((x) < 0) ? -1 : 1) + /* + * return ((d1 < d2) ? 1 : (d1 > d2) ? -1 : 0)) + */ + long l1,l2; + int sign1,sign2; + int rv; + +#if FL_MSL_AT_LOW_ADDRESS + l1 = get4((char *)&d1); + l2 = get4((char *)&d2); +#else + l1 = get4(((char *)&d1+4)); + l2 = get4(((char *)&d2+4)); +#endif + sign1 = SIGN(l1); + sign2 = SIGN(l2); + if (sign1 != sign2) { + l1 &= 0x7fffffff; + l2 &= 0x7fffffff; + if (l1 != 0 || l2 != 0) { + return ((sign1 > 0) ? -1 : 1); + } + } + if (l1 != l2) { /* we can decide here */ + rv = l1 < l2 ? 1 : -1; + } + else { /* decide in 2nd half */ + unsigned long u1, u2; +#if FL_MSL_AT_LOW_ADDRESS + u1 = get4(((char *)&d1 + 4)); + u2 = get4(((char *)&d2 + 4)); +#else + u1 = get4((char *)&d1); + u2 = get4((char *)&d2); +#endif + if (u1 == u2) + return(0); + if (u1 < u2) rv = 1; + else rv = -1; + } + return sign1 * rv; +} diff --git a/lib/ack/fphook/compact.fc b/lib/ack/fphook/compact.fc new file mode 100755 index 000000000..a5a1074d1 --- /dev/null +++ b/lib/ack/fphook/compact.fc @@ -0,0 +1,202 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + COMPACT EXTEND FORMAT INTO FLOAT OF PROPER SIZE +*/ + +# include "FP_bias.h" +# include "FP_shift.h" +# include "FP_trap.h" +# include "FP_types.h" +# include "get_put.h" + +void +compact(f,to,size) +EXTEND *f; +unsigned long *to; +int size; +{ + int error = 0; + + if (size == sizeof(DOUBLE)) { + /* + * COMPACT EXTENDED INTO DOUBLE + */ + DOUBLE *DBL = (DOUBLE *) (void *) to; + + if ((f->m1|(f->m2 & DBL_ZERO)) == 0L) { + zrf8(DBL); + return; + } + f->exp += DBL_BIAS; /* restore proper bias */ + if (f->exp > DBL_MAX) { +dbl_over: trap(EFOVFL); + f->exp = DBL_MAX+1; + f->m1 = 0; + f->m2 = 0; + if (error++) + return; + } + else if (f->exp < DBL_MIN) { + b64_rsft(&(f->mantissa)); + if (f->exp < 0) { + b64_sft(&(f->mantissa), -f->exp); + f->exp = 0; + } + /* underflow ??? */ + } + + /* local CAST conversion */ + + /* because of special format shift only 10 bits */ + /* bit shift mantissa 10 bits */ + + /* first align within words, then do store operation */ + + DBL->d[0] = f->m1 >> DBL_RUNPACK; /* plus 22 == 32 */ + DBL->d[1] = f->m2 >> DBL_RUNPACK; /* plus 22 == 32 */ + DBL->d[1] |= (f->m1 << DBL_LUNPACK); /* plus 10 == 32 */ + + /* if not exact then round to nearest */ + /* on a tie, round to even */ + +#ifdef EXCEPTION_INEXACT + if ((f->m2 & DBL_EXACT) != 0) { + INEXACT(); +#endif + if (((f->m2 & DBL_EXACT) > DBL_ROUNDUP) + || ((f->m2 & DBL_EXACT) == DBL_ROUNDUP + && (f->m2 & (DBL_ROUNDUP << 1)))) { + DBL->d[1]++; /* rounding up */ + if (DBL->d[1] == 0L) { /* carry out */ + DBL->d[0]++; + + if (f->exp == 0 && (DBL->d[0] & ~DBL_MASK)) { + f->exp++; + } + if (DBL->d[0] & DBL_CARRYOUT) { /* carry out */ + if (DBL->d[0] & 01) + DBL->d[1] = CARRYBIT; + DBL->d[0] >>= 1; + f->exp++; + } + } + /* check for overflow */ + if (f->exp > DBL_MAX) + goto dbl_over; + } +#ifdef EXCEPTION_INEXACT + } +#endif + + /* + * STORE EXPONENT AND SIGN: + * + * 1) clear leading bits (B4-B15) + * 2) shift and store exponent + */ + + DBL->d[0] &= DBL_MASK; + DBL->d[0] |= + ((long) (f->exp << DBL_EXPSHIFT) << EXP_STORE); + if (f->sign) + DBL->d[0] |= CARRYBIT; + + /* + * STORE MANTISSA + */ + +#if FL_MSL_AT_LOW_ADDRESS + put4(DBL->d[0], (char *) &DBL->d[0]); + put4(DBL->d[1], (char *) &DBL->d[1]); +#else + { unsigned long l; + put4(DBL->d[1], (char *) &l); + put4(DBL->d[0], (char *) &DBL->d[1]); + DBL->d[0] = l; + } +#endif + } + else { + /* + * COMPACT EXTENDED INTO FLOAT + */ + SINGLE *SGL; + + /* local CAST conversion */ + SGL = (SINGLE *) (void *) to; + if ((f->m1 & SGL_ZERO) == 0L) { + *SGL = 0L; + return; + } + f->exp += SGL_BIAS; /* restore bias */ + if (f->exp > SGL_MAX) { +sgl_over: trap(EFOVFL); + f->exp = SGL_MAX+1; + f->m1 = 0L; + f->m2 = 0L; + if (error++) + return; + } + else if (f->exp < SGL_MIN) { + b64_rsft(&(f->mantissa)); + if (f->exp < 0) { + b64_sft(&(f->mantissa), -f->exp); + f->exp = 0; + } + /* underflow ??? */ + } + + /* shift mantissa and store */ + *SGL = (f->m1 >> SGL_RUNPACK); + + /* check for rounding to nearest */ + /* on a tie, round to even */ +#ifdef EXCEPTION_INEXACT + if (f->m2 != 0 || + (f->m1 & SGL_EXACT) != 0L) { + INEXACT(); +#endif + if (((f->m1 & SGL_EXACT) > SGL_ROUNDUP) + || ((f->m1 & SGL_EXACT) == SGL_ROUNDUP + && (f->m1 & (SGL_ROUNDUP << 1)))) { + (*SGL)++; + if (f->exp == 0 && (*SGL & ~SGL_MASK)) { + f->exp++; + } + /* check normal */ + if (*SGL & SGL_CARRYOUT) { + *SGL >>= 1; + f->exp++; + } + if (f->exp > SGL_MAX) + goto sgl_over; + } +#ifdef EXCEPTION_INEXACT + } +#endif + + /* + * STORE EXPONENT AND SIGN: + * + * 1) clear leading bit of fraction + * 2) shift and store exponent + */ + + *SGL &= SGL_MASK; /* B23-B31 are 0 */ + *SGL |= ((long) (f->exp << SGL_EXPSHIFT) << EXP_STORE); + if (f->sign) + *SGL |= CARRYBIT; + + /* + * STORE MANTISSA + */ + + put4(*SGL, (char *) &SGL); + } +} diff --git a/lib/ack/fphook/cuf4.fc b/lib/ack/fphook/cuf4.fc new file mode 100755 index 000000000..c022f0e90 --- /dev/null +++ b/lib/ack/fphook/cuf4.fc @@ -0,0 +1,57 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO SINGLE (CUF n 4) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cuf4(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + short *ipt; + SINGLE *result; + long i_src; + + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + result = (SINGLE *) &src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + result = (SINGLE *) ((void *) &ss); + } + if (i_src == 0) { + *result = (SINGLE) 0L; + return; + } + /* ESTABLISHED THAT src != 0 */ + + /* adjust exponent field */ + if (ss != sizeof(long)) + i_src <<= 16; + + /* move to mantissa field */ + buf.m1 = i_src; + + /* adjust mantissa field */ + nrm_ext(&buf); + compact(&buf,result,4); +} diff --git a/lib/ack/fphook/cuf8.fc b/lib/ack/fphook/cuf8.fc new file mode 100755 index 000000000..d18ec6c7a --- /dev/null +++ b/lib/ack/fphook/cuf8.fc @@ -0,0 +1,54 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERT INTEGER TO FLOAT (CUF n 8) + + THIS ROUTINE WORKS BY FILLING AN EXTENDED + WITH THE INTEGER VALUE IN EXTENDED FORMAT + AND USES COMPACT() TO PUT IT INTO THE PROPER + FLOATING POINT PRECISION. +*/ + +#include "FP_types.h" + +void +cuf8(ss,src) +int ss; /* source size */ +long src; /* largest possible integer to convert */ +{ + EXTEND buf; + short *ipt; + long i_src; + + zrf_ext(&buf); + if (ss == sizeof(long)) { + buf.exp = 31; + i_src = src; + } + else { + ipt = (short *) &src; + i_src = (long) *ipt; + buf.exp = 15; + } + if (i_src == 0) { + zrf8((DOUBLE *)((void *)&ss)); + return; + } + /* ESTABLISHED THAT src != 0 */ + + /* adjust exponent field */ + if (ss != sizeof(long)) + i_src <<= 16; + + /* move to mantissa field */ + buf.m1 = i_src; + + /* adjust mantissa field */ + nrm_ext(&buf); + compact(&buf,(unsigned long *) (void *)&ss,8); +} diff --git a/lib/ack/fphook/div_ext.fc b/lib/ack/fphook/div_ext.fc new file mode 100755 index 000000000..bb9531178 --- /dev/null +++ b/lib/ack/fphook/div_ext.fc @@ -0,0 +1,266 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + DIVIDE EXTENDED FORMAT +*/ + +#include "FP_bias.h" +#include "FP_trap.h" +#include "FP_types.h" + +/* + November 15, 1984 + + This is a routine to do the work. + There are two versions: + One is based on the partial products method + and makes no use possible machine instructions + to divide (hardware dividers). + The other is used when USE_DIVIDE is defined. It is much faster on + machines with fast 4 byte operations. +*/ +/********************************************************/ + +void +div_ext(e1,e2) +EXTEND *e1,*e2; +{ + short error = 0; + B64 result; + register unsigned long *lp; +#ifndef USE_DIVIDE + short count; +#else + unsigned short u[9], v[5]; + register int j; + register unsigned short *u_p = u; + int maxv = 4; +#endif + + if ((e2->m1 | e2->m2) == 0) { + /* + * Exception 8.2 - Divide by zero + */ + trap(EFDIVZ); + e1->m1 = e1->m2 = 0L; + e1->exp = EXT_MAX; + return; + } + if ((e1->m1 | e1->m2) == 0) { /* 0 / anything == 0 */ + e1->exp = 0; /* make sure */ + return; + } +#ifndef USE_DIVIDE + /* + * numbers are right shifted one bit to make sure + * that m1 is quaranteed to be larger if its + * maximum bit is set + */ + b64_rsft(&e1->mantissa); /* 64 bit shift right */ + b64_rsft(&e2->mantissa); /* 64 bit shift right */ + e1->exp++; + e2->exp++; +#endif + /* check for underflow, divide by zero, etc */ + e1->sign ^= e2->sign; + e1->exp -= e2->exp; + +#ifndef USE_DIVIDE + /* do division of mantissas */ + /* uses partial product method */ + /* init control variables */ + + count = 64; + result.h_32 = 0L; + result.l_32 = 0L; + + /* partial product division loop */ + + while (count--) { + /* first left shift result 1 bit */ + /* this is ALWAYS done */ + + b64_lsft(&result); + + /* compare dividend and divisor */ + /* if dividend >= divisor add a bit */ + /* and subtract divisior from dividend */ + + if ( (e1->m1 < e2->m1) || + ((e1->m1 == e2->m1) && (e1->m2 < e2->m2) )) + ; /* null statement */ + /* i.e., don't add or subtract */ + else { + result.l_32++; /* ADD */ + if (e2->m2 > e1->m2) + e1->m1 -= 1; /* carry in */ + e1->m1 -= e2->m1; /* do SUBTRACTION */ + e1->m2 -= e2->m2; /* SUBTRACTION */ + } + + /* shift dividend left one bit OR */ + /* IF it equals ZERO we can break out */ + /* of the loop, but still must shift */ + /* the quotient the remaining count bits */ + /* NB save the results of this test in error */ + /* if not zero, then the result is inexact. */ + /* this would be reported in IEEE standard */ + + /* lp points to dividend */ + lp = &e1->m1; + + error = ((*lp | *(lp+1)) != 0L) ? 1 : 0; + if (error) { /* more work */ + /* assume max bit == 0 (see above) */ + b64_lsft(&e1->mantissa); + continue; + } + else + break; /* leave loop */ + } /* end of divide by subtraction loop */ + + if (count > 0) { + lp = &result.h_32; + if (count > 31) { /* move to higher word */ + *lp = *(lp+1); + count -= 32; + *(lp+1) = 0L; /* clear low word */ + } + if (*lp) + *lp <<= count; /* shift rest of way */ + lp++; /* == &result.l_32 */ + if (*lp) { + result.h_32 |= (*lp >> 32-count); + *lp <<= count; + } + } +#else /* USE_DIVIDE */ + + u[4] = (e1->m2 & 1) << 15; + b64_rsft(&(e1->mantissa)); + u[0] = e1->m1 >> 16; + u[1] = e1->m1; + u[2] = e1->m2 >> 16; + u[3] = e1->m2; + u[5] = 0; u[6] = 0; u[7] = 0; + v[1] = e2->m1 >> 16; + v[2] = e2->m1; + v[3] = e2->m2 >> 16; + v[4] = e2->m2; + while (! v[maxv]) maxv--; + result.h_32 = 0; + result.l_32 = 0; + lp = &result.h_32; + + /* + * Use an algorithm of Knuth (The art of programming, Seminumerical + * algorithms), to divide u by v. u and v are both seen as numbers + * with base 65536. + */ + for (j = 0; j <= 3; j++, u_p++) { + unsigned long q_est, temp; + + if (j == 2) lp++; + if (u_p[0] == 0 && u_p[1] < v[1]) continue; + temp = ((unsigned long)u_p[0] << 16) + u_p[1]; + if (u_p[0] >= v[1]) { + q_est = 0x0000FFFFL; + } + else { + q_est = temp / v[1]; + } + temp -= q_est * v[1]; + while (temp < 0x10000 && v[2]*q_est > ((temp<<16)+u_p[2])) { + q_est--; + temp += v[1]; + } + /* Now, according to Knuth, we have an estimate of the + quotient, that is either correct or one too big, but + almost always correct. + */ + if (q_est != 0) { + int i; + unsigned long k = 0; + int borrow = 0; + + for (i = maxv; i > 0; i--) { + unsigned long tmp = q_est * v[i] + k + borrow; + unsigned short md = tmp; + + borrow = (md > u_p[i]); + u_p[i] -= md; + k = tmp >> 16; + } + k += borrow; + borrow = u_p[0] < k; + u_p[0] -= k; + + if (borrow) { + /* So, this does not happen often; the estimate + was one too big; correct this + */ + *lp |= (j & 1) ? (q_est - 1) : ((q_est-1)<<16); + borrow = 0; + for (i = maxv; i > 0; i--) { + unsigned long tmp + = v[i]+(unsigned long)u_p[i]+borrow; + + u_p[i] = tmp; + borrow = tmp >> 16; + } + u_p[0] += borrow; + } + else *lp |= (j & 1) ? q_est : (q_est<<16); + } + } +#ifdef EXCEPTION_INEXACT + u_p = &u[0]; + for (j = 7; j >= 0; j--) { + if (*u_p++) { + error = 1; + break; + } + } +#endif +#endif + +#ifdef EXCEPTION_INEXACT + if (error) { + /* + * report here exception 8.5 - Inexact + * from Draft 8.0 of IEEE P754: + * In the absence of an invalid operation exception, + * if the rounded result of an operation is not exact or if + * it overflows without a trap, then the inexact exception + * shall be assigned. The rounded or overflowed result + * shall be delivered to the destination. + */ + INEXACT(); +#endif + e1->mantissa = result; + + nrm_ext(e1); + if (e1->exp < EXT_MIN) { + /* + * Exception 8.4 - Underflow + */ + trap(EFUNFL); /* underflow */ + e1->exp = EXT_MIN; + e1->m1 = e1->m2 = 0L; + return; + } + if (e1->exp >= EXT_MAX) { + /* + * Exception 8.3 - Overflow + */ + trap(EFOVFL); /* overflow */ + e1->exp = EXT_MAX; + e1->m1 = e1->m2 = 0L; + return; + } +} diff --git a/lib/ack/fphook/dvf4.fc b/lib/ack/fphook/dvf4.fc new file mode 100755 index 000000000..7d82cd8b8 --- /dev/null +++ b/lib/ack/fphook/dvf4.fc @@ -0,0 +1,26 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + DIVIDE TWO SINGLES - SINGLE Precision (dvf 4) +*/ + +#include "FP_types.h" + +void +dvf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + + /* do a divide */ + div_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/fphook/dvf8.fc b/lib/ack/fphook/dvf8.fc new file mode 100755 index 000000000..fafe50f53 --- /dev/null +++ b/lib/ack/fphook/dvf8.fc @@ -0,0 +1,26 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + DIVIDE TWO FLOATS - DOUBLE Precision (DVF 8) +*/ + +#include "FP_types.h" + +void +dvf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + + /* do a divide */ + div_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/fphook/extend.fc b/lib/ack/fphook/extend.fc new file mode 100755 index 000000000..70febb1e3 --- /dev/null +++ b/lib/ack/fphook/extend.fc @@ -0,0 +1,111 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + CONVERTS FLOATING POINT TO EXTENDED FORMAT + + Two sizes of FLOATING Point are known: + SINGLE and DOUBLE +*/ +/********************************************************/ +/* + It is not required to normalize in extended + format, but it has been chosen to do so. + Extended Format is as follows (at exit): + +->sign S000 0000 | 0000 0000 +->exp 0EEE EEEE | EEEE EEEE +->m1 LFFF FFFF | FFFF FFFF + FFFF FFFF | FFFF FFFF +->m2 FFFF FFFF | FFFF FFFF + FFFF F000 | 0000 0000 +*/ +/********************************************************/ + +#include "FP_bias.h" +#include "FP_shift.h" +#include "FP_types.h" +#include "get_put.h" +/********************************************************/ + +void +extend(from,to,size) +unsigned long *from; +EXTEND *to; +int size; +{ + register char *cpt1; + unsigned long tmp; + int leadbit = 0; + + cpt1 = (char *) from; + +#if FL_MSL_AT_LOW_ADDRESS +#if FL_MSW_AT_LOW_ADDRESS + to->exp = uget2(cpt1); +#else + to->exp = uget2(cpt1+2); +#endif +#else +#if FL_MSW_AT_LOW_ADDRESS + to->exp = uget2(cpt1+(size == sizeof(DOUBLE) ? 4 : 0)); +#else + to->exp = uget2(cpt1+(size == sizeof(DOUBLE) ? 6 : 2)); +#endif +#endif + to->sign = (to->exp & 0x8000); /* set sign bit */ + to->exp ^= to->sign; + if (size == sizeof(DOUBLE)) + to->exp >>= DBL_EXPSHIFT; + else + to->exp >>= SGL_EXPSHIFT; + if (to->exp > 0) + leadbit++; /* will set Lead bit later */ + else to->exp++; + + if (size == sizeof(DOUBLE)) { +#if FL_MSL_AT_LOW_ADDRESS + to->m1 = get4(cpt1); + cpt1 += 4; + tmp = get4(cpt1); +#else + tmp = get4(cpt1); + cpt1 += 4; + to->m1 = get4(cpt1); +#endif + if (to->exp == 1 && to->m1 == 0 && tmp == 0) { + to->exp = 0; + to->sign = 0; + to->m1 = 0; + to->m2 = 0; + return; + } + to->m1 <<= DBL_M1LEFT; /* shift */ + to->exp -= DBL_BIAS; /* remove bias */ + to->m1 |= (tmp>>DBL_RPACK); /* plus 10 == 32 */ + to->m2 = (tmp<m1 = get4(cpt1); + to->m1 <<= SGL_M1LEFT; /* shift */ + if (to->exp == 1 && to->m1 == 0) { + to->exp = 0; + to->sign = 0; + to->m1 = 0; + to->m2 = 0; + return; + } + to->exp -= SGL_BIAS; /* remove bias */ + to->m2 = 0L; + } + + to->m1 |= NORMBIT; /* set bit L */ + if (leadbit == 0) { /* set or clear Leading Bit */ + to->m1 &= ~NORMBIT; /* clear bit L */ + nrm_ext(to); /* and normalize */ + } +} diff --git a/lib/ack/fphook/fef4.fc b/lib/ack/fphook/fef4.fc new file mode 100755 index 000000000..ff426f57b --- /dev/null +++ b/lib/ack/fphook/fef4.fc @@ -0,0 +1,33 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SEPERATE INTO EXPONENT AND FRACTION (FEF 4) +*/ + +#include "FP_types.h" + +void +fef4(r,s1) +SINGLE s1; +struct fef4_returns *r; +{ + EXTEND buf; + register struct fef4_returns *p = r; /* make copy; r might refer + to itself (see table) + */ + + extend(&s1,&buf,sizeof(SINGLE)); + if (buf.exp == 0 && buf.m1 == 0 && buf.m2 == 0) { + p->e = 0; + } + else { + p->e = buf.exp+1; + buf.exp = -1; + } + compact(&buf,&p->f,sizeof(SINGLE)); +} diff --git a/lib/ack/fphook/fef8.fc b/lib/ack/fphook/fef8.fc new file mode 100755 index 000000000..1c3b3b0b5 --- /dev/null +++ b/lib/ack/fphook/fef8.fc @@ -0,0 +1,33 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SEPERATE DOUBLE INTO EXPONENT AND FRACTION (FEF 8) +*/ + +#include "FP_types.h" + +void +fef8(r, s1) +DOUBLE s1; +struct fef8_returns *r; +{ + EXTEND buf; + register struct fef8_returns *p = r; /* make copy, r might refer + to itself (see table) + */ + + extend(&s1.d[0],&buf,sizeof(DOUBLE)); + if (buf.exp == 0 && buf.m1 == 0 && buf.m2 == 0) { + p->e = 0; + } + else { + p->e = buf.exp + 1; + buf.exp = -1; + } + compact(&buf,&p->f.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/fphook/fif4.fc b/lib/ack/fphook/fif4.fc new file mode 100755 index 000000000..059372469 --- /dev/null +++ b/lib/ack/fphook/fif4.fc @@ -0,0 +1,46 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + MULTIPLY AND DISMEMBER PARTS (FIF 4) +*/ + +#include "FP_types.h" +#include "FP_shift.h" + +void +fif4(p,x,y) +SINGLE x,y; +struct fif4_returns *p; +{ + + EXTEND e1,e2; + + extend(&y,&e1,sizeof(SINGLE)); + extend(&x,&e2,sizeof(SINGLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + e2 = e1; + compact(&e2,&y,sizeof(SINGLE)); + if (e1.exp < 0) { + p->ipart = 0; + p->fpart = y; + return; + } + if (e1.exp > 30 - SGL_M1LEFT) { + p->ipart = y; + p->fpart = 0; + return; + } + b64_sft(&e1.mantissa, 63 - e1.exp); + b64_sft(&e1.mantissa, e1.exp - 63); /* "loose" low order bits */ + compact(&e1,&(p->ipart),sizeof(SINGLE)); + extend(&(p->ipart), &e2, sizeof(SINGLE)); + extend(&y, &e1, sizeof(SINGLE)); + sub_ext(&e1, &e2); + compact(&e1, &(p->fpart), sizeof(SINGLE)); +} diff --git a/lib/ack/fphook/fif8.fc b/lib/ack/fphook/fif8.fc new file mode 100755 index 000000000..9f1b9b15e --- /dev/null +++ b/lib/ack/fphook/fif8.fc @@ -0,0 +1,48 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + MULTIPLY AND DISMEMBER PARTS (FIF 8) +*/ + +#include "FP_types.h" +#include "FP_shift.h" + +void +fif8(p,x,y) +DOUBLE x,y; +struct fif8_returns *p; +{ + + EXTEND e1,e2; + + extend(&y.d[0],&e1,sizeof(DOUBLE)); + extend(&x.d[0],&e2,sizeof(DOUBLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + e2 = e1; + compact(&e2, &y.d[0], sizeof(DOUBLE)); + if (e1.exp < 0) { + p->ipart.d[0] = 0; + p->ipart.d[1] = 0; + p->fpart = y; + return; + } + if (e1.exp > 62 - DBL_M1LEFT) { + p->ipart = y; + p->fpart.d[0] = 0; + p->fpart.d[1] = 0; + return; + } + b64_sft(&e1.mantissa, 63 - e1.exp); + b64_sft(&e1.mantissa, e1.exp - 63); /* "loose" low order bits */ + compact(&e1, &(p->ipart.d[0]), sizeof(DOUBLE)); + extend(&(p->ipart.d[0]), &e2, sizeof(DOUBLE)); + extend(&y.d[0], &e1, sizeof(DOUBLE)); + sub_ext(&e1, &e2); + compact(&e1, &(p->fpart.d[0]), sizeof(DOUBLE)); +} diff --git a/lib/ack/fphook/fltpr.c b/lib/ack/fphook/fltpr.c new file mode 100755 index 000000000..7ba3fb018 --- /dev/null +++ b/lib/ack/fphook/fltpr.c @@ -0,0 +1,12 @@ +#include +#include +#include "../stdio/loc_incl.h" + +int _fp_hook = 1; + +char * +_f_print(va_list *ap, int flags, char *s, char c, int precision) +{ + fprintf(stderr,"cannot print floating point\n"); + exit(EXIT_FAILURE); +} diff --git a/lib/ack/fphook/fphook.c b/lib/ack/fphook/fphook.c new file mode 100755 index 000000000..61730d609 --- /dev/null +++ b/lib/ack/fphook/fphook.c @@ -0,0 +1,195 @@ +/* + * fltpr.c - print floating point numbers + */ +/* $Header$ */ + +#ifndef NOFLOAT +#include +#include +#include "../stdio/loc_incl.h" +int _fp_hook = 1; + +static char * +_pfloat(long double r, register char *s, int n, int flags) +{ + register char *s1; + int sign, dp; + register int i; + + s1 = _fcvt(r, n, &dp, &sign); + if (sign) + *s++ = '-'; + else if (flags & FL_SIGN) + *s++ = '+'; + else if (flags & FL_SPACE) + *s++ = ' '; + + if (dp<=0) + *s++ = '0'; + for (i=dp; i>0; i--) + if (*s1) *s++ = *s1++; + else *s++ = '0'; + if (((i=n) > 0) || (flags & FL_ALT)) + *s++ = '.'; + while (++dp <= 0) { + if (--i<0) + break; + *s++ = '0'; + } + while (--i >= 0) + if (*s1) *s++ = *s1++; + else *s++ = '0'; + return s; +} + +static char * +_pscien(long double r, register char *s, int n, int flags) +{ + int sign, dp; + register char *s1; + + s1 = _ecvt(r, n + 1, &dp, &sign); + if (sign) + *s++ = '-'; + else if (flags & FL_SIGN) + *s++ = '+'; + else if (flags & FL_SPACE) + *s++ = ' '; + + *s++ = *s1++; + if ((n > 0) || (flags & FL_ALT)) + *s++ = '.'; + while (--n >= 0) + if (*s1) *s++ = *s1++; + else *s++ = '0'; + *s++ = 'e'; + if ( r != 0 ) --dp ; + if ( dp<0 ) { + *s++ = '-' ; dp= -dp ; + } else { + *s++ = '+' ; + } + if (dp >= 100) { + *s++ = '0' + (dp / 100); + dp %= 100; + } + *s++ = '0' + (dp/10); + *s++ = '0' + (dp%10); + return s; +} + +#define NDIGINEXP(exp) (((exp) >= 100 || (exp) <= -100) ? 3 : 2) +#define LOW_EXP -4 +#define USE_EXP(exp, ndigits) (((exp) < LOW_EXP + 1) || (exp >= ndigits + 1)) + +static char * +_gcvt(long double value, int ndigit, char *s, int flags) +{ + int sign, dp; + register char *s1, *s2; + register int i; + register int nndigit = ndigit; + + s1 = _ecvt(value, ndigit, &dp, &sign); + s2 = s; + if (sign) *s2++ = '-'; + else if (flags & FL_SIGN) + *s2++ = '+'; + else if (flags & FL_SPACE) + *s2++ = ' '; + + if (!(flags & FL_ALT)) + for (i = nndigit - 1; i > 0 && s1[i] == '0'; i--) + nndigit--; + + if (USE_EXP(dp,ndigit)) { + /* Use E format */ + dp--; + *s2++ = *s1++; + if ((nndigit > 1) || (flags & FL_ALT)) *s2++ = '.'; + while (--nndigit > 0) *s2++ = *s1++; + *s2++ = 'e'; + if (dp < 0) { + *s2++ = '-'; + dp = -dp; + } + else *s2++ = '+'; + s2 += NDIGINEXP(dp); + *s2 = 0; + for (i = NDIGINEXP(dp); i > 0; i--) { + *--s2 = dp % 10 + '0'; + dp /= 10; + } + return s; + } + /* Use f format */ + if (dp <= 0) { + if (*s1 != '0') { + /* otherwise the whole number is 0 */ + *s2++ = '0'; + *s2++ = '.'; + } + while (dp < 0) { + dp++; + *s2++ = '0'; + } + } + for (i = 1; i <= nndigit; i++) { + *s2++ = *s1++; + if (i == dp) *s2++ = '.'; + } + if (i <= dp) { + while (i++ <= dp) *s2++ = '0'; + *s2++ = '.'; + } + if ((s2[-1]=='.') && !(flags & FL_ALT)) s2--; + *s2 = '\0'; + return s; +} + +char * +_f_print(va_list *ap, int flags, char *s, char c, int precision) +{ + register char *old_s = s; + long double ld_val; + + if (flags & FL_LONGDOUBLE) ld_val = va_arg(*ap, long double); + else ld_val = (long double) va_arg(*ap, double); + + switch(c) { + case 'f': + s = _pfloat(ld_val, s, precision, flags); + break; + case 'e': + case 'E': + s = _pscien(ld_val, s, precision , flags); + break; + case 'g': + case 'G': + s = _gcvt(ld_val, precision, s, flags); + s += strlen(s); + break; + } + if ( c == 'E' || c == 'G') { + while (*old_s && *old_s != 'e') old_s++; + if (*old_s == 'e') *old_s = 'E'; + } + return s; +} +#endif /* NOFLOAT */ +/* $Header$ */ + +#include +#include "../ansi/ext_fmt.h" + +void _str_ext_cvt(const char *s, char **ss, struct EXTEND *e); +double _ext_dbl_cvt(struct EXTEND *e); + +double +strtod(const char *p, char **pp) +{ + struct EXTEND e; + + _str_ext_cvt(p, pp, &e); + return _ext_dbl_cvt(&e); +} diff --git a/lib/ack/fphook/fptrp.s b/lib/ack/fphook/fptrp.s new file mode 100755 index 000000000..d2823f4d7 --- /dev/null +++ b/lib/ack/fphook/fptrp.s @@ -0,0 +1,19 @@ +# +.sect .text; .sect .rom; .sect .data; .sect .bss +.define __fptrp +.sect .text +__fptrp: +#if __i386 + push ebp + mov ebp, esp + mov eax, 8(bp) + call .Xtrp + leave + ret +#else /* i86 */ + push bp + mov bp, sp + mov ax, 4(bp) + call .Xtrp + jmp .cret +#endif diff --git a/lib/ack/fphook/get_put.h b/lib/ack/fphook/get_put.h new file mode 100755 index 000000000..9fd7f606f --- /dev/null +++ b/lib/ack/fphook/get_put.h @@ -0,0 +1,41 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +#include + +#if CHAR_UNSIGNED +#define Xchar(ch) (ch) +#else +#define Xchar(ch) ((ch) & 0377) +#endif + +#define BYTES_REVERSED (MSB_AT_LOW_ADDRESS != FL_MSB_AT_LOW_ADDRESS) +#define WORDS_REVERSED (MSW_AT_LOW_ADDRESS != FL_MSW_AT_LOW_ADDRESS) +#define LONGS_REVERSED (FL_MSL_AT_LOW_ADDRESS) + +#if BYTES_REVERSED +#define uget2(c) (Xchar((c)[1]) | ((unsigned) Xchar((c)[0]) << 8)) +#define Xput2(i, c) (((c)[1] = (i)), ((c)[0] = (i) >> 8)) +#define put2(i, c) { register int j = (i); Xput2(j, c); } +#else +#define uget2(c) (* ((unsigned short *) (c))) +#define Xput2(i, c) (* ((short *) (c)) = (i)) +#define put2(i, c) Xput2(i, c) +#endif + +#define get2(c) ((short) uget2(c)) + +#if WORDS_REVERSED || BYTES_REVERSED +#define get4(c) (uget2((c)+2) | ((long) uget2(c) << 16)) +#define put4(l, c) { register long x=(l); \ + Xput2((int)x,(c)+2); \ + Xput2((int)(x>>16),(c)); \ + } +#else +#define get4(c) (* ((long *) (c))) +#define put4(l, c) (* ((long *) (c)) = (l)) +#endif diff --git a/lib/ack/fphook/mlf4.fc b/lib/ack/fphook/mlf4.fc new file mode 100755 index 000000000..d5f515d19 --- /dev/null +++ b/lib/ack/fphook/mlf4.fc @@ -0,0 +1,25 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * Multiply Single Precesion Float (MLF 4) + */ + +#include "FP_types.h" + +void +mlf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/fphook/mlf8.fc b/lib/ack/fphook/mlf8.fc new file mode 100755 index 000000000..b43cdf3c1 --- /dev/null +++ b/lib/ack/fphook/mlf8.fc @@ -0,0 +1,25 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + * Multiply Double Precision Float (MLF 8) + */ + +#include "FP_types.h" + +void +mlf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1,e2; + + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + /* do a multiply */ + mul_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/fphook/mul_ext.fc b/lib/ack/fphook/mul_ext.fc new file mode 100755 index 000000000..78a614014 --- /dev/null +++ b/lib/ack/fphook/mul_ext.fc @@ -0,0 +1,98 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ROUTINE TO MULTIPLY TWO EXTENDED FORMAT NUMBERS +*/ + +# include "FP_bias.h" +# include "FP_trap.h" +# include "FP_types.h" +# include "FP_shift.h" + +void +mul_ext(e1,e2) +EXTEND *e1,*e2; +{ + register int i,j; /* loop control */ + unsigned short mp[4]; /* multiplier */ + unsigned short mc[4]; /* multipcand */ + unsigned short result[8]; /* result */ + register unsigned short *pres; + + /* first save the sign (XOR) */ + e1->sign ^= e2->sign; + + /* compute new exponent */ + e1->exp += e2->exp + 1; + /* 128 bit multiply of mantissas */ + + /* assign unknown long formats */ + /* to known unsigned word formats */ + mp[0] = e1->m1 >> 16; + mp[1] = (unsigned short) e1->m1; + mp[2] = e1->m2 >> 16; + mp[3] = (unsigned short) e1->m2; + mc[0] = e2->m1 >> 16; + mc[1] = (unsigned short) e2->m1; + mc[2] = e2->m2 >> 16; + mc[3] = (unsigned short) e2->m2; + for (i = 8; i--;) { + result[i] = 0; + } + /* + * fill registers with their components + */ + for(i=4, pres = &result[4];i--;pres--) if (mp[i]) { + unsigned short k = 0; + unsigned long mpi = mp[i]; + for(j=4;j--;) { + unsigned long tmp = (unsigned long)pres[j] + k; + if (mc[j]) tmp += mpi * mc[j]; + pres[j] = tmp; + k = tmp >> 16; + } + pres[-1] = k; + } + if (! (result[0] & 0x8000)) { + e1->exp--; + for (i = 0; i <= 3; i++) { + result[i] <<= 1; + if (result[i+1]&0x8000) result[i] |= 1; + } + result[4] <<= 1; + } + + /* + * combine the registers to a total + */ + e1->m1 = ((unsigned long)(result[0]) << 16) + result[1]; + e1->m2 = ((unsigned long)(result[2]) << 16) + result[3]; + if (result[4] & 0x8000) { + if (++e1->m2 == 0) + if (++e1->m1 == 0) { + e1->m1 = NORMBIT; + e1->exp++; + } + } + + /* check for overflow */ + if (e1->exp >= EXT_MAX) { + trap(EFOVFL); + /* if caught */ + /* return signed infinity */ + e1->exp = EXT_MAX; +infinity: e1->m1 = e1->m2 =0L; + return; + } + /* check for underflow */ + if (e1->exp < EXT_MIN) { + trap(EFUNFL); + e1->exp = EXT_MIN; + goto infinity; + } +} diff --git a/lib/ack/fphook/ngf4.fc b/lib/ack/fphook/ngf4.fc new file mode 100755 index 000000000..9f1f812ea --- /dev/null +++ b/lib/ack/fphook/ngf4.fc @@ -0,0 +1,27 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + NEGATE A FLOATING POINT (NGF 4) +*/ +/********************************************************/ + +#include "FP_types.h" +#include "get_put.h" + +#define OFF ((FL_MSW_AT_LOW_ADDRESS ? 0 : 2) + (FL_MSB_AT_LOW_ADDRESS ? 0 : 1)) +void +ngf4(f) +SINGLE f; +{ + unsigned char *p; + + if (f != (SINGLE) 0) { + p = (unsigned char *) &f + OFF; + *p ^= 0x80; + } +} diff --git a/lib/ack/fphook/ngf8.fc b/lib/ack/fphook/ngf8.fc new file mode 100755 index 000000000..473ffa510 --- /dev/null +++ b/lib/ack/fphook/ngf8.fc @@ -0,0 +1,28 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + NEGATE A FLOATING POINT (NGF 8) +*/ +/********************************************************/ + +#include "FP_types.h" +#include "get_put.h" + +#define OFF ((FL_MSL_AT_LOW_ADDRESS ? 0 : 4) + (FL_MSW_AT_LOW_ADDRESS ? 0 : 2) + (FL_MSB_AT_LOW_ADDRESS ? 0 : 1)) + +void +ngf8(f) +DOUBLE f; +{ + unsigned char *p; + + if (f.d[0] != 0 || f.d[1] != 0) { + p = (unsigned char *) &f + OFF; + *p ^= 0x80; + } +} diff --git a/lib/ack/fphook/nrm_ext.fc b/lib/ack/fphook/nrm_ext.fc new file mode 100755 index 000000000..dc83554b1 --- /dev/null +++ b/lib/ack/fphook/nrm_ext.fc @@ -0,0 +1,50 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/********************************************************/ +/* + NORMALIZE an EXTENDED FORMAT NUMBER +*/ +/********************************************************/ + +#include "FP_shift.h" +#include "FP_types.h" + +void +nrm_ext(e1) +EXTEND *e1; +{ + /* we assume that the mantissa != 0 */ + /* if it is then just return */ + /* to let it be a problem elsewhere */ + /* THAT IS, The exponent is not set to */ + /* zero. If we don't test here an */ + /* infinite loop is generated when */ + /* mantissa is zero */ + + if ((e1->m1 | e1->m2) == 0L) + return; + + /* if top word is zero mov low word */ + /* to top word, adjust exponent value */ + if (e1->m1 == 0L) { + e1->m1 = e1->m2; + e1->m2 = 0L; + e1->exp -= 32; + } + if ((e1->m1 & NORMBIT) == 0) { + unsigned long l = ((unsigned long)NORMBIT >> 1); + int cnt = -1; + + while (! (l & e1->m1)) { + l >>= 1; + cnt--; + } + e1->exp += cnt; + b64_sft(&(e1->mantissa), cnt); + } +} diff --git a/lib/ack/fphook/sbf4.fc b/lib/ack/fphook/sbf4.fc new file mode 100755 index 000000000..368c11102 --- /dev/null +++ b/lib/ack/fphook/sbf4.fc @@ -0,0 +1,27 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SUBTRACT TWO FLOATS - SINGLE Precision (SBF 4) +*/ + +#include "FP_types.h" + +void +sbf4(s2,s1) +SINGLE s1,s2; +{ + EXTEND e1,e2; + + if (s2 == (SINGLE) 0) { + return; + } + extend(&s1,&e1,sizeof(SINGLE)); + extend(&s2,&e2,sizeof(SINGLE)); + sub_ext(&e1,&e2); + compact(&e1,&s1,sizeof(SINGLE)); +} diff --git a/lib/ack/fphook/sbf8.fc b/lib/ack/fphook/sbf8.fc new file mode 100755 index 000000000..9d4c1067c --- /dev/null +++ b/lib/ack/fphook/sbf8.fc @@ -0,0 +1,27 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SUBTRACT TWO FLOATS - DOUBLE Precision (SBF 8) +*/ + +#include "FP_types.h" + +void +sbf8(s2,s1) +DOUBLE s1,s2; +{ + EXTEND e1, e2; + + if (s2.d[0] == 0 && s2.d[1] == 0) { + return; + } + extend(&s1.d[0],&e1,sizeof(DOUBLE)); + extend(&s2.d[0],&e2,sizeof(DOUBLE)); + sub_ext(&e1,&e2); + compact(&e1,&s1.d[0],sizeof(DOUBLE)); +} diff --git a/lib/ack/fphook/sft_ext.fc b/lib/ack/fphook/sft_ext.fc new file mode 100755 index 000000000..a933f9dc9 --- /dev/null +++ b/lib/ack/fphook/sft_ext.fc @@ -0,0 +1,39 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SHIFT TWO EXTENDED NUMBERS INTO PROPER + ALIGNMENT FOR ADDITION (exponents are equal) + Numbers should not be zero on entry. +*/ + +#include "FP_types.h" + +void +sft_ext(e1,e2) +EXTEND *e1,*e2; +{ + register EXTEND *s; + register int diff; + + diff = e1->exp - e2->exp; + + if (!diff) + return; /* exponents are equal */ + + if (diff < 0) { /* e2 is larger */ + /* shift e1 */ + diff = -diff; + s = e1; + } + else /* e1 is larger */ + /* shift e2 */ + s = e2; + + s->exp += diff; + b64_sft(&(s->mantissa), diff); +} diff --git a/lib/ack/fphook/shifter.fc b/lib/ack/fphook/shifter.fc new file mode 100755 index 000000000..089da20c2 --- /dev/null +++ b/lib/ack/fphook/shifter.fc @@ -0,0 +1,75 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +# include "FP_types.h" + +void +b64_sft(e1,n) +B64 *e1; +int n; +{ + if (n > 0) { + if (n > 63) { + e1->l_32 = 0; + e1->h_32 = 0; + return; + } + if (n >= 32) { + e1->l_32 = e1->h_32; + e1->h_32 = 0; + n -= 32; + } + if (n > 0) { + e1->l_32 >>= n; + if (e1->h_32 != 0) { + e1->l_32 |= (e1->h_32 << (32 - n)); + e1->h_32 >>= n; + } + } + return; + } + n = -n; + if (n > 0) { + if (n > 63) { + e1->l_32 = 0; + e1->h_32 = 0; + return; + } + if (n >= 32) { + e1->h_32 = e1->l_32; + e1->l_32 = 0; + n -= 32; + } + if (n > 0) { + e1->h_32 <<= n; + if (e1->l_32 != 0) { + e1->h_32 |= (e1->l_32 >> (32 - n)); + e1->l_32 <<= n; + } + } + } +} + +void +b64_lsft(e1) +B64 *e1; +{ + /* shift left 1 bit */ + e1->h_32 <<= 1; + if (e1->l_32 & 0x80000000L) e1->h_32 |= 1; + e1->l_32 <<= 1; +} + +void +b64_rsft(e1) +B64 *e1; +{ + /* shift right 1 bit */ + e1->l_32 >>= 1; + if (e1->h_32 & 1) e1->l_32 |= 0x80000000L; + e1->h_32 >>= 1; +} diff --git a/lib/ack/fphook/strtod.c b/lib/ack/fphook/strtod.c new file mode 100755 index 000000000..8f58baa08 --- /dev/null +++ b/lib/ack/fphook/strtod.c @@ -0,0 +1,9 @@ +#include +#include + +double +strtod(const char *p, char **pp) +{ + fprintf(stderr,"cannot print floating point\n"); + exit(EXIT_FAILURE); +} diff --git a/lib/ack/fphook/sub_ext.fc b/lib/ack/fphook/sub_ext.fc new file mode 100755 index 000000000..64180aa6f --- /dev/null +++ b/lib/ack/fphook/sub_ext.fc @@ -0,0 +1,53 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + SUBTRACT 2 EXTENDED FORMAT NUMBERS +*/ + +#include "FP_types.h" + +void +sub_ext(e1,e2) +EXTEND *e1,*e2; +{ + if ((e2->m1 | e2->m2) == 0L) { + return; + } + if ((e1->m1 | e1->m2) == 0L) { + *e1 = *e2; + e1->sign = e2->sign ? 0 : 1; + return; + } + sft_ext(e1, e2); + if (e1->sign != e2->sign) { + /* e1 - e2 = e1 + (-e2) */ + if (b64_add(&e1->mantissa,&e2->mantissa)) { /* addition carry */ + b64_rsft(&e1->mantissa); /* shift mantissa one bit RIGHT */ + e1->m1 |= 0x80000000L; /* set max bit */ + e1->exp++; /* increase the exponent */ + } + } + else if (e2->m1 > e1->m1 || + (e2->m1 == e1->m1 && e2->m2 > e1->m2)) { + /* abs(e2) > abs(e1) */ + if (e1->m2 > e2->m2) { + e2->m1 -= 1; /* carry in */ + } + e2->m1 -= e1->m1; + e2->m2 -= e1->m2; + *e1 = *e2; + e1->sign = e2->sign ? 0 : 1; + } + else { + if (e2->m2 > e1->m2) + e1->m1 -= 1; /* carry in */ + e1->m1 -= e2->m1; + e1->m2 -= e2->m2; + } + nrm_ext(e1); +} diff --git a/lib/ack/fphook/zrf4.fc b/lib/ack/fphook/zrf4.fc new file mode 100755 index 000000000..a913e813d --- /dev/null +++ b/lib/ack/fphook/zrf4.fc @@ -0,0 +1,19 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + return a zero float (ZRF 4) +*/ + +#include "FP_types.h" + +void +zrf4(l) +SINGLE *l; +{ + *l = 0L; +} diff --git a/lib/ack/fphook/zrf8.fc b/lib/ack/fphook/zrf8.fc new file mode 100755 index 000000000..4fcdbb85b --- /dev/null +++ b/lib/ack/fphook/zrf8.fc @@ -0,0 +1,21 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + return a zero double (ZRF 8) +*/ + +#include "FP_types.h" + +void +zrf8(z) +DOUBLE *z; +{ + + z->d[0] = 0L; + z->d[1] = 0L; +} diff --git a/lib/ack/fphook/zrf_ext.fc b/lib/ack/fphook/zrf_ext.fc new file mode 100755 index 000000000..8f5878989 --- /dev/null +++ b/lib/ack/fphook/zrf_ext.fc @@ -0,0 +1,22 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* $Header$ */ + +/* + ZERO and return EXTEND FORMAT FLOAT +*/ + +#include "FP_types.h" + +void +zrf_ext(e) +EXTEND *e; +{ + e->m1 = 0; + e->m2 = 0; + e->exp = 0; + e->sign = 0; +} diff --git a/lib/ack/h/em_abs.h b/lib/ack/h/em_abs.h new file mode 100755 index 000000000..9855cff5a --- /dev/null +++ b/lib/ack/h/em_abs.h @@ -0,0 +1,35 @@ +/* $Header$ */ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ +#define LINO_AD 0 +#define FILN_AD 4 + +#define LINO (*(int *)(_hol0()+LINO_AD)) +#define FILN (*(char **)(_hol0()+FILN_AD)) + +#define EARRAY 0 +#define ERANGE 1 +#define ESET 2 +#define EIOVFL 3 +#define EFOVFL 4 +#define EFUNFL 5 +#define EIDIVZ 6 +#define EFDIVZ 7 +#define EIUND 8 +#define EFUND 9 +#define ECONV 10 + +#define ESTACK 16 +#define EHEAP 17 +#define EILLINS 18 +#define EODDZ 19 +#define ECASE 20 +#define EMEMFLT 21 +#define EBADPTR 22 +#define EBADPC 23 +#define EBADLAE 24 +#define EBADMON 25 +#define EBADLIN 26 +#define EBADGTO 27 diff --git a/lib/ack/h/m2_traps.h b/lib/ack/h/m2_traps.h new file mode 100755 index 000000000..9ea6330f0 --- /dev/null +++ b/lib/ack/h/m2_traps.h @@ -0,0 +1,16 @@ +/* $Header$ */ +/* + * (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ + +/* Modula-2 runtime errors */ + +#define M2_TOOLARGE 64 /* stack of process too large */ +#define M2_TOOMANY 65 /* too many nested traps & handlers */ +#define M2_NORESULT 66 /* no RETURN from procedure function */ +#define M2_UOVFL 67 /* cardinal overflow */ +#define M2_FORCH 68 /* FOR-loop control variable changed */ +#define M2_UUVFL 69 /* cardinal underflow */ +#define M2_INTERNAL 70 /* internal error, should not happen */ +#define M2_UNIXSIG 71 /* unix signal */ diff --git a/lib/ack/h/pc_err.h b/lib/ack/h/pc_err.h new file mode 100755 index 000000000..bf72386c7 --- /dev/null +++ b/lib/ack/h/pc_err.h @@ -0,0 +1,29 @@ +/* $Header$ */ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ +#define EARGC 64 +#define EEXP 65 +#define ELOG 66 +#define ESQT 67 +#define EASS 68 +#define EPACK 69 +#define EUNPACK 70 +#define EMOD 71 +#define EBADF 72 +#define EFREE 73 +#define EFUNASS 74 +#define EWIDTH 75 + +#define EWRITEF 96 +#define EREADF 97 +#define EEOF 98 +#define EFTRUNC 99 +#define ERESET 100 +#define EREWR 101 +#define ECLOSE 102 +#define EREAD 103 +#define EWRITE 104 +#define EDIGIT 105 +#define EASCII 106 diff --git a/lib/ack/h/pc_file.h b/lib/ack/h/pc_file.h new file mode 100755 index 000000000..3cd9f9dcd --- /dev/null +++ b/lib/ack/h/pc_file.h @@ -0,0 +1,24 @@ +/* $Header$ */ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ +#define WRBIT 0100000 +#define TXTBIT 040000 +#define EOFBIT 020000 +#define ELNBIT 010000 +#define WINDOW 04000 +#define MAGIC 0252 + +#define PC_BUFLEN 1024 + +struct file { + char *ptr; + unsigned flags; + char *fname; + int ufd; + int size; + int count; + int buflen; + char bufadr[PC_BUFLEN]; +}; diff --git a/lib/ack/h/pc_math.h b/lib/ack/h/pc_math.h new file mode 100755 index 000000000..0b2aaea83 --- /dev/null +++ b/lib/ack/h/pc_math.h @@ -0,0 +1,42 @@ +/* + * localmath.h - This header is used by the mathematical library. + */ +/* $Header$ */ + +/* some constants (Hart & Cheney) */ +#define M_PI 3.14159265358979323846264338327950288 +#define M_2PI 6.28318530717958647692528676655900576 +#define M_3PI_4 2.35619449019234492884698253745962716 +#define M_PI_2 1.57079632679489661923132169163975144 +#define M_3PI_8 1.17809724509617246442349126872981358 +#define M_PI_4 0.78539816339744830961566084581987572 +#define M_PI_8 0.39269908169872415480783042290993786 +#define M_1_PI 0.31830988618379067153776752674502872 +#define M_2_PI 0.63661977236758134307553505349005744 +#define M_4_PI 1.27323954473516268615107010698011488 +#define M_E 2.71828182845904523536028747135266250 +#define M_LOG2E 1.44269504088896340735992468100189213 +#define M_LOG10E 0.43429448190325182765112891891660508 +#define M_LN2 0.69314718055994530941723212145817657 +#define M_LN10 2.30258509299404568401799145468436421 +#define M_SQRT2 1.41421356237309504880168872420969808 +#define M_1_SQRT2 0.70710678118654752440084436210484904 +#define M_EULER 0.57721566490153286060651209008240243 + +/* macros for constructing polynomials */ +#define POLYNOM1(x, a) ((a)[1]*(x)+(a)[0]) +#define POLYNOM2(x, a) (POLYNOM1((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM3(x, a) (POLYNOM2((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM4(x, a) (POLYNOM3((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM5(x, a) (POLYNOM4((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM6(x, a) (POLYNOM5((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM7(x, a) (POLYNOM6((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM8(x, a) (POLYNOM7((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM9(x, a) (POLYNOM8((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM10(x, a) (POLYNOM9((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM11(x, a) (POLYNOM10((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM12(x, a) (POLYNOM11((x),(a)+1)*(x)+(a)[0]) +#define POLYNOM13(x, a) (POLYNOM12((x),(a)+1)*(x)+(a)[0]) + +#define M_LN_MAX_D (M_LN2 * DBL_MAX_EXP) +#define M_LN_MIN_D (M_LN2 * (DBL_MIN_EXP - 1)) diff --git a/lib/ack/i386/Makefile b/lib/ack/i386/Makefile new file mode 100644 index 000000000..b13ca13cf --- /dev/null +++ b/lib/ack/i386/Makefile @@ -0,0 +1,4 @@ + +SUBDIRS = em head + +include ../../Makefile.ack.inc diff --git a/lib/ack/i386/Makefile.ack b/lib/ack/i386/Makefile.ack new file mode 100644 index 000000000..e9a936902 --- /dev/null +++ b/lib/ack/i386/Makefile.ack @@ -0,0 +1,5 @@ + +all: + cd em && make + cd head && make + diff --git a/lib/ack/i386/em/Makefile b/lib/ack/i386/em/Makefile new file mode 100644 index 000000000..33f335c7f --- /dev/null +++ b/lib/ack/i386/em/Makefile @@ -0,0 +1,78 @@ +# Makefile for lib/ack/i386/em. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE -Was-ack + +LIBRARIES = libe + +libe_OBJECTS = \ + em_adf4.o \ + em_adf8.o \ + em_adi.o \ + em_and.o \ + em_blm.o \ + em_cff4.o \ + em_cff8.o \ + em_cfi.o \ + em_cfu.o \ + em_cif4.o \ + em_cif8.o \ + em_cii.o \ + em_cmf4.o \ + em_cmf8.o \ + em_cms.o \ + em_com.o \ + em_csa4.o \ + em_csb4.o \ + em_cuf4.o \ + em_cuf8.o \ + em_cuu.o \ + em_dup.o \ + em_dvf4.o \ + em_dvf8.o \ + em_dvi.o \ + em_dvu.o \ + em_error.o \ + em_exg.o \ + em_fat.o \ + em_fef4.o \ + em_fef8.o \ + em_fif4.o \ + em_fif8.o \ + em_fp8087.o \ + em_gto.o \ + em_hol0.o \ + em_iaar.o \ + em_ilar.o \ + em_inn.o \ + em_ior.o \ + em_isar.o \ + em_lar4.o \ + em_loi.o \ + em_mlf4.o \ + em_mlf8.o \ + em_mli.o \ + em_mon.o \ + em_ngf4.o \ + em_ngf8.o \ + em_ngi.o \ + em_nop.o \ + em_print.o \ + em_rck.o \ + em_rmi.o \ + em_rmu.o \ + em_rol.o \ + em_ror.o \ + em_sar4.o \ + em_sbf4.o \ + em_sbf8.o \ + em_sbi.o \ + em_set.o \ + em_sli.o \ + em_sri.o \ + em_sti.o \ + em_stop.o \ + em_trp.o \ + em_unknown.o \ + em_xor.o \ + +include ../../../Makefile.ack.inc diff --git a/lib/ack/i386/em/Makefile.ack.conv b/lib/ack/i386/em/Makefile.ack.conv new file mode 100755 index 000000000..86b2cac31 --- /dev/null +++ b/lib/ack/i386/em/Makefile.ack.conv @@ -0,0 +1,289 @@ +# Makefile for lib/i386/em. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE -Was-ack +CC1 = $(CC) $(CFLAGS) -c + +LIBRARY = ../../../libe.a +all: $(LIBRARY) + +OBJECTS = \ + $(LIBRARY)(em_adf4.o) \ + $(LIBRARY)(em_adf8.o) \ + $(LIBRARY)(em_adi.o) \ + $(LIBRARY)(em_and.o) \ + $(LIBRARY)(em_blm.o) \ + $(LIBRARY)(em_cff4.o) \ + $(LIBRARY)(em_cff8.o) \ + $(LIBRARY)(em_cfi.o) \ + $(LIBRARY)(em_cfu.o) \ + $(LIBRARY)(em_cif4.o) \ + $(LIBRARY)(em_cif8.o) \ + $(LIBRARY)(em_cii.o) \ + $(LIBRARY)(em_cmf4.o) \ + $(LIBRARY)(em_cmf8.o) \ + $(LIBRARY)(em_cms.o) \ + $(LIBRARY)(em_com.o) \ + $(LIBRARY)(em_csa4.o) \ + $(LIBRARY)(em_csb4.o) \ + $(LIBRARY)(em_cuf4.o) \ + $(LIBRARY)(em_cuf8.o) \ + $(LIBRARY)(em_cuu.o) \ + $(LIBRARY)(em_dup.o) \ + $(LIBRARY)(em_dvf4.o) \ + $(LIBRARY)(em_dvf8.o) \ + $(LIBRARY)(em_dvi.o) \ + $(LIBRARY)(em_dvu.o) \ + $(LIBRARY)(em_error.o) \ + $(LIBRARY)(em_exg.o) \ + $(LIBRARY)(em_fat.o) \ + $(LIBRARY)(em_fef4.o) \ + $(LIBRARY)(em_fef8.o) \ + $(LIBRARY)(em_fif4.o) \ + $(LIBRARY)(em_fif8.o) \ + $(LIBRARY)(em_fp8087.o) \ + $(LIBRARY)(em_gto.o) \ + $(LIBRARY)(em_hol0.o) \ + $(LIBRARY)(em_iaar.o) \ + $(LIBRARY)(em_ilar.o) \ + $(LIBRARY)(em_inn.o) \ + $(LIBRARY)(em_ior.o) \ + $(LIBRARY)(em_isar.o) \ + $(LIBRARY)(em_lar4.o) \ + $(LIBRARY)(em_loi.o) \ + $(LIBRARY)(em_mlf4.o) \ + $(LIBRARY)(em_mlf8.o) \ + $(LIBRARY)(em_mli.o) \ + $(LIBRARY)(em_mon.o) \ + $(LIBRARY)(em_ngf4.o) \ + $(LIBRARY)(em_ngf8.o) \ + $(LIBRARY)(em_ngi.o) \ + $(LIBRARY)(em_nop.o) \ + $(LIBRARY)(em_print.o) \ + $(LIBRARY)(em_rck.o) \ + $(LIBRARY)(em_rmi.o) \ + $(LIBRARY)(em_rmu.o) \ + $(LIBRARY)(em_rol.o) \ + $(LIBRARY)(em_ror.o) \ + $(LIBRARY)(em_sar4.o) \ + $(LIBRARY)(em_sbf4.o) \ + $(LIBRARY)(em_sbf8.o) \ + $(LIBRARY)(em_sbi.o) \ + $(LIBRARY)(em_set.o) \ + $(LIBRARY)(em_sli.o) \ + $(LIBRARY)(em_sri.o) \ + $(LIBRARY)(em_sti.o) \ + $(LIBRARY)(em_stop.o) \ + $(LIBRARY)(em_trp.o) \ + $(LIBRARY)(em_unknown.o) \ + $(LIBRARY)(em_xor.o) \ + +$(LIBRARY): $(OBJECTS) + aal cr $@ *.o + rm *.o + +$(LIBRARY)(em_adf4.o): em_adf4.s + $(CC1) em_adf4.s + +$(LIBRARY)(em_adf8.o): em_adf8.s + $(CC1) em_adf8.s + +$(LIBRARY)(em_adi.o): em_adi.s + $(CC1) em_adi.s + +$(LIBRARY)(em_and.o): em_and.s + $(CC1) em_and.s + +$(LIBRARY)(em_blm.o): em_blm.s + $(CC1) em_blm.s + +$(LIBRARY)(em_cff4.o): em_cff4.s + $(CC1) em_cff4.s + +$(LIBRARY)(em_cff8.o): em_cff8.s + $(CC1) em_cff8.s + +$(LIBRARY)(em_cfi.o): em_cfi.s + $(CC1) em_cfi.s + +$(LIBRARY)(em_cfu.o): em_cfu.s + $(CC1) em_cfu.s + +$(LIBRARY)(em_cif4.o): em_cif4.s + $(CC1) em_cif4.s + +$(LIBRARY)(em_cif8.o): em_cif8.s + $(CC1) em_cif8.s + +$(LIBRARY)(em_cii.o): em_cii.s + $(CC1) em_cii.s + +$(LIBRARY)(em_cmf4.o): em_cmf4.s + $(CC1) em_cmf4.s + +$(LIBRARY)(em_cmf8.o): em_cmf8.s + $(CC1) em_cmf8.s + +$(LIBRARY)(em_cms.o): em_cms.s + $(CC1) em_cms.s + +$(LIBRARY)(em_com.o): em_com.s + $(CC1) em_com.s + +$(LIBRARY)(em_csa4.o): em_csa4.s + $(CC1) em_csa4.s + +$(LIBRARY)(em_csb4.o): em_csb4.s + $(CC1) em_csb4.s + +$(LIBRARY)(em_cuf4.o): em_cuf4.s + $(CC1) em_cuf4.s + +$(LIBRARY)(em_cuf8.o): em_cuf8.s + $(CC1) em_cuf8.s + +$(LIBRARY)(em_cuu.o): em_cuu.s + $(CC1) em_cuu.s + +$(LIBRARY)(em_dup.o): em_dup.s + $(CC1) em_dup.s + +$(LIBRARY)(em_dvf4.o): em_dvf4.s + $(CC1) em_dvf4.s + +$(LIBRARY)(em_dvf8.o): em_dvf8.s + $(CC1) em_dvf8.s + +$(LIBRARY)(em_dvi.o): em_dvi.s + $(CC1) em_dvi.s + +$(LIBRARY)(em_dvu.o): em_dvu.s + $(CC1) em_dvu.s + +$(LIBRARY)(em_error.o): em_error.s + $(CC1) em_error.s + +$(LIBRARY)(em_exg.o): em_exg.s + $(CC1) em_exg.s + +$(LIBRARY)(em_fat.o): em_fat.s + $(CC1) em_fat.s + +$(LIBRARY)(em_fef4.o): em_fef4.s + $(CC1) em_fef4.s + +$(LIBRARY)(em_fef8.o): em_fef8.s + $(CC1) em_fef8.s + +$(LIBRARY)(em_fif4.o): em_fif4.s + $(CC1) em_fif4.s + +$(LIBRARY)(em_fif8.o): em_fif8.s + $(CC1) em_fif8.s + +$(LIBRARY)(em_fp8087.o): em_fp8087.s + $(CC1) em_fp8087.s + +$(LIBRARY)(em_gto.o): em_gto.s + $(CC1) em_gto.s + +$(LIBRARY)(em_hol0.o): em_hol0.s + $(CC1) em_hol0.s + +$(LIBRARY)(em_iaar.o): em_iaar.s + $(CC1) em_iaar.s + +$(LIBRARY)(em_ilar.o): em_ilar.s + $(CC1) em_ilar.s + +$(LIBRARY)(em_inn.o): em_inn.s + $(CC1) em_inn.s + +$(LIBRARY)(em_ior.o): em_ior.s + $(CC1) em_ior.s + +$(LIBRARY)(em_isar.o): em_isar.s + $(CC1) em_isar.s + +$(LIBRARY)(em_lar4.o): em_lar4.s + $(CC1) em_lar4.s + +$(LIBRARY)(em_loi.o): em_loi.s + $(CC1) em_loi.s + +$(LIBRARY)(em_mlf4.o): em_mlf4.s + $(CC1) em_mlf4.s + +$(LIBRARY)(em_mlf8.o): em_mlf8.s + $(CC1) em_mlf8.s + +$(LIBRARY)(em_mli.o): em_mli.s + $(CC1) em_mli.s + +$(LIBRARY)(em_mon.o): em_mon.s + $(CC1) em_mon.s + +$(LIBRARY)(em_ngf4.o): em_ngf4.s + $(CC1) em_ngf4.s + +$(LIBRARY)(em_ngf8.o): em_ngf8.s + $(CC1) em_ngf8.s + +$(LIBRARY)(em_ngi.o): em_ngi.s + $(CC1) em_ngi.s + +$(LIBRARY)(em_nop.o): em_nop.s + $(CC1) em_nop.s + +$(LIBRARY)(em_print.o): em_print.s + $(CC1) em_print.s + +$(LIBRARY)(em_rck.o): em_rck.s + $(CC1) em_rck.s + +$(LIBRARY)(em_rmi.o): em_rmi.s + $(CC1) em_rmi.s + +$(LIBRARY)(em_rmu.o): em_rmu.s + $(CC1) em_rmu.s + +$(LIBRARY)(em_rol.o): em_rol.s + $(CC1) em_rol.s + +$(LIBRARY)(em_ror.o): em_ror.s + $(CC1) em_ror.s + +$(LIBRARY)(em_sar4.o): em_sar4.s + $(CC1) em_sar4.s + +$(LIBRARY)(em_sbf4.o): em_sbf4.s + $(CC1) em_sbf4.s + +$(LIBRARY)(em_sbf8.o): em_sbf8.s + $(CC1) em_sbf8.s + +$(LIBRARY)(em_sbi.o): em_sbi.s + $(CC1) em_sbi.s + +$(LIBRARY)(em_set.o): em_set.s + $(CC1) em_set.s + +$(LIBRARY)(em_sli.o): em_sli.s + $(CC1) em_sli.s + +$(LIBRARY)(em_sri.o): em_sri.s + $(CC1) em_sri.s + +$(LIBRARY)(em_sti.o): em_sti.s + $(CC1) em_sti.s + +$(LIBRARY)(em_stop.o): em_stop.s + $(CC1) em_stop.s + +$(LIBRARY)(em_trp.o): em_trp.s + $(CC1) em_trp.s + +$(LIBRARY)(em_unknown.o): em_unknown.s + $(CC1) em_unknown.s + +$(LIBRARY)(em_xor.o): em_xor.s + $(CC1) em_xor.s diff --git a/lib/ack/i386/em/byte_order.h b/lib/ack/i386/em/byte_order.h new file mode 100755 index 000000000..d08b45a5d --- /dev/null +++ b/lib/ack/i386/em/byte_order.h @@ -0,0 +1,6 @@ +#define CHAR_UNSIGNED 0 +#define MSB_AT_LOW_ADDRESS 0 +#define MSW_AT_LOW_ADDRESS 0 +#define FL_MSB_AT_LOW_ADDRESS 0 +#define FL_MSW_AT_LOW_ADDRESS 0 +#define FL_MSL_AT_LOW_ADDRESS 0 diff --git a/lib/ack/i386/em/em_adf4.s b/lib/ack/i386/em/em_adf4.s new file mode 100755 index 000000000..c36c7b4d3 --- /dev/null +++ b/lib/ack/i386/em/em_adf4.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .adf4 + + .sect .text +.adf4: + mov bx,sp + flds 4(bx) + fadds 8(bx) + fstps 8(bx) + wait + ret diff --git a/lib/ack/i386/em/em_adf8.s b/lib/ack/i386/em/em_adf8.s new file mode 100755 index 000000000..253dda9e7 --- /dev/null +++ b/lib/ack/i386/em/em_adf8.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .adf8 + + .sect .text +.adf8: + mov bx,sp + fldd 4(bx) + faddd 12(bx) + fstpd 12(bx) + wait + ret diff --git a/lib/ack/i386/em/em_adi.s b/lib/ack/i386/em/em_adi.s new file mode 100755 index 000000000..396c197fe --- /dev/null +++ b/lib/ack/i386/em/em_adi.s @@ -0,0 +1,18 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .adi + + ! #bytes in ecx , top of stack in eax + .sect .text +.adi: + pop ebx ! return address + cmp ecx,4 + jne 9f + pop ecx + add eax,ecx + jmp ebx +9: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_and.s b/lib/ack/i386/em/em_and.s new file mode 100755 index 000000000..eddfa7976 --- /dev/null +++ b/lib/ack/i386/em/em_and.s @@ -0,0 +1,20 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .and + + ! #bytes in ecx + ! save edi; it might be a register variable + + .sect .text +.and: + pop ebx ! return address + mov edx,edi + mov edi,esp + add edi,ecx + sar ecx,2 +1: + pop eax + and eax,(edi) + stos + loop 1b + mov edi,edx + jmp ebx diff --git a/lib/ack/i386/em/em_blm.s b/lib/ack/i386/em/em_blm.s new file mode 100755 index 000000000..a2a1c6814 --- /dev/null +++ b/lib/ack/i386/em/em_blm.s @@ -0,0 +1,16 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .blm + + ! ecx: count in words +.blm: + mov ebx,esp + mov eax,esi + mov edx,edi + mov edi,4(ebx) + mov esi,8(ebx) + rep movs + mov esi,eax + mov edi,edx + ret 8 + diff --git a/lib/ack/i386/em/em_cff4.s b/lib/ack/i386/em/em_cff4.s new file mode 100755 index 000000000..42b946433 --- /dev/null +++ b/lib/ack/i386/em/em_cff4.s @@ -0,0 +1,19 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cff4 + + .sect .text +.cff4: + mov bx,sp + fldd 4(bx) + fstcw 4(bx) + wait + mov dx,4(bx) + and 4(bx),0xf3ff ! set to rounding mode + wait + fldcw 4(bx) + fstps 8(bx) + mov 4(bx),dx + wait + fldcw 4(bx) + wait + ret diff --git a/lib/ack/i386/em/em_cff8.s b/lib/ack/i386/em/em_cff8.s new file mode 100755 index 000000000..cc038a818 --- /dev/null +++ b/lib/ack/i386/em/em_cff8.s @@ -0,0 +1,10 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cff8 + + .sect .text +.cff8: + mov bx,sp + flds 4(bx) + fstpd 4(bx) + wait + ret diff --git a/lib/ack/i386/em/em_cfi.s b/lib/ack/i386/em/em_cfi.s new file mode 100755 index 000000000..900f4e5f3 --- /dev/null +++ b/lib/ack/i386/em/em_cfi.s @@ -0,0 +1,27 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cfi + + .sect .text +.cfi: + mov bx,sp + fstcw 4(bx) + wait + mov dx,4(bx) + or 4(bx),0xc00 ! truncating mode + wait + fldcw 4(bx) + cmp 8(bx),4 + jne 2f + ! loc 4 loc ? cfi + flds 12(bx) + fistpl 12(bx) +1: + mov 4(bx),dx + wait + fldcw 4(bx) + ret +2: + ! loc 8 loc ? cfi + fldd 12(bx) + fistpl 16(bx) + jmp 1b diff --git a/lib/ack/i386/em/em_cfu.s b/lib/ack/i386/em/em_cfu.s new file mode 100755 index 000000000..96c98bb95 --- /dev/null +++ b/lib/ack/i386/em/em_cfu.s @@ -0,0 +1,38 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cfu + + .sect .text +.cfu: + mov bx,sp + fstcw 4(bx) + wait + mov dx,4(bx) + or 4(bx),0xc00 ! truncating mode + wait + fldcw 4(bx) + cmp 8(bx),4 + jne 2f + ! loc 4 loc ? cfu + flds 12(bx) + fabs ! ??? + fiaddl (bigmin) + fistpl 12(bx) + wait + mov ax,12(bx) + sub ax,(bigmin) + mov 12(bx),ax +1: + mov 4(bx),dx + wait + fldcw 4(bx) + ret +2: + ! loc 8 loc ? cfu + fldd 12(bx) + fabs ! ??? + fiaddl (bigmin) + fistpl 16(bx) + mov ax,16(bx) + sub ax,(bigmin) + mov 16(bx),ax + jmp 1b diff --git a/lib/ack/i386/em/em_cif4.s b/lib/ack/i386/em/em_cif4.s new file mode 100755 index 000000000..0ccb187d5 --- /dev/null +++ b/lib/ack/i386/em/em_cif4.s @@ -0,0 +1,10 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cif4 + + .sect .text +.cif4: + mov bx,sp + fildl 8(bx) + fstps 8(bx) + wait + ret diff --git a/lib/ack/i386/em/em_cif8.s b/lib/ack/i386/em/em_cif8.s new file mode 100755 index 000000000..94be62af0 --- /dev/null +++ b/lib/ack/i386/em/em_cif8.s @@ -0,0 +1,10 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cif8 + + .sect .text +.cif8: + mov bx,sp + fildl 8(bx) + fstpd 4(bx) + wait + ret diff --git a/lib/ack/i386/em/em_cii.s b/lib/ack/i386/em/em_cii.s new file mode 100755 index 000000000..0ad7ce302 --- /dev/null +++ b/lib/ack/i386/em/em_cii.s @@ -0,0 +1,31 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cii + +.sect .text +.cii: + pop ebx ! return address + ! pop ecx, dest. size + ! pop edx, src. size + ! eax is source + cmp edx,1 + jne 2f + movsxb eax,al + mov edx,4 + jmp 1f +2: + cmp edx,2 + jne 1f + cwde ! convert from 2 to 4 bytes + mov edx,4 +1: + cmp edx,ecx + jne 9f + cmp edx,4 + jne 9f + jmp ebx +9: +.extern EILLINS +.extern .fat + mov eax,EILLINS + push eax + jmp .fat diff --git a/lib/ack/i386/em/em_cmf4.s b/lib/ack/i386/em/em_cmf4.s new file mode 100755 index 000000000..0e2f02361 --- /dev/null +++ b/lib/ack/i386/em/em_cmf4.s @@ -0,0 +1,22 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cmf4 + + .sect .text +.cmf4: + mov bx,sp + xor cx,cx + flds 8(bx) + flds 4(bx) + fcompp ! compare and pop operands + fstsw ax + wait + sahf + je 1f + jb 2f + dec cx + jmp 1f +2: + inc cx +1: + mov ax,cx + ret diff --git a/lib/ack/i386/em/em_cmf8.s b/lib/ack/i386/em/em_cmf8.s new file mode 100755 index 000000000..00a15db7d --- /dev/null +++ b/lib/ack/i386/em/em_cmf8.s @@ -0,0 +1,22 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cmf8 + + .sect .text +.cmf8: + mov bx,sp + xor cx,cx + fldd 12(bx) + fldd 4(bx) + fcompp ! compare and pop operands + fstsw ax + wait + sahf + je 1f + jb 2f + dec cx + jmp 1f +2: + inc cx +1: + mov ax,cx + ret diff --git a/lib/ack/i386/em/em_cms.s b/lib/ack/i386/em/em_cms.s new file mode 100755 index 000000000..d8d263918 --- /dev/null +++ b/lib/ack/i386/em/em_cms.s @@ -0,0 +1,23 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cms + + ! #bytes in ecx + .sect .text +.cms: + pop ebx ! return address + mov edx,esp + push esi + push edi + mov esi,edx + add edx,ecx + mov edi,edx + add edx,ecx + sar ecx,2 + repe cmps + je 1f + inc ecx +1: + pop edi + pop esi + mov esp,edx + jmp ebx diff --git a/lib/ack/i386/em/em_com.s b/lib/ack/i386/em/em_com.s new file mode 100755 index 000000000..dfc5f702b --- /dev/null +++ b/lib/ack/i386/em/em_com.s @@ -0,0 +1,14 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .com + + ! #bytes in ecx + .sect .text +.com: + mov ebx,esp + add ebx,4 + sar ecx,2 +1: + not (ebx) + add ebx,4 + loop 1b + ret diff --git a/lib/ack/i386/em/em_csa4.s b/lib/ack/i386/em/em_csa4.s new file mode 100755 index 000000000..f90245062 --- /dev/null +++ b/lib/ack/i386/em/em_csa4.s @@ -0,0 +1,27 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .csa4 + +.sect .text +.csa4: + ! ebx, descriptor address + ! eax, index + mov edx,(ebx) ! default + sub eax,4(ebx) + cmp eax,8(ebx) + ja 1f + sal eax,2 + add ebx,eax + mov ebx,12(ebx) + test ebx,ebx + jnz 2f +1: + mov ebx,edx + test ebx,ebx + jnz 2f +.extern ECASE +.extern .fat + mov eax,ECASE + push eax + jmp .fat +2: + jmp ebx diff --git a/lib/ack/i386/em/em_csb4.s b/lib/ack/i386/em/em_csb4.s new file mode 100755 index 000000000..4a8214183 --- /dev/null +++ b/lib/ack/i386/em/em_csb4.s @@ -0,0 +1,29 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .csb4 + +.sect .text +.csb4: + !ebx, descriptor address + !eax, index + mov edx,(ebx) + mov ecx,4(ebx) +1: + add ebx,8 + dec ecx + jl 4f + cmp eax,(ebx) + jne 1b + mov ebx,4(ebx) +2: + test ebx,ebx + jnz 3f +.extern ECASE +.extern .fat + mov eax,ECASE + push eax + jmp .fat +3: + jmp ebx +4: + mov ebx,edx + jmp 2b diff --git a/lib/ack/i386/em/em_cuf4.s b/lib/ack/i386/em/em_cuf4.s new file mode 100755 index 000000000..a99961b7a --- /dev/null +++ b/lib/ack/i386/em/em_cuf4.s @@ -0,0 +1,15 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cuf4 + + .sect .text +.cuf4: + mov bx,sp + fildl 8(bx) + cmp 8(bx),0 + jge 1f + fisubl (bigmin) + fisubl (bigmin) +1: + fstps 8(bx) + wait + ret diff --git a/lib/ack/i386/em/em_cuf8.s b/lib/ack/i386/em/em_cuf8.s new file mode 100755 index 000000000..928cb9fa9 --- /dev/null +++ b/lib/ack/i386/em/em_cuf8.s @@ -0,0 +1,15 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .cuf8 + + .sect .text +.cuf8: + mov bx,sp + fildl 8(bx) + cmp 8(bx),0 + jge 1f + fisubl (bigmin) + fisubl (bigmin) +1: + fstpd 4(bx) + wait + ret diff --git a/lib/ack/i386/em/em_cuu.s b/lib/ack/i386/em/em_cuu.s new file mode 100755 index 000000000..16177b6c3 --- /dev/null +++ b/lib/ack/i386/em/em_cuu.s @@ -0,0 +1,22 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .ciu +.define .cui +.define .cuu + +.sect .text +.ciu: +.cui: +.cuu: + pop ebx ! return address + ! pop ecx, dest. size + ! pop edx, source size + ! eax is source + cmp edx,ecx + jne 8f + jmp ebx +8: +.extern EILLINS +.extern .fat + mov eax,EILLINS + push eax + jmp .fat diff --git a/lib/ack/i386/em/em_dup.s b/lib/ack/i386/em/em_dup.s new file mode 100755 index 000000000..071a46c32 --- /dev/null +++ b/lib/ack/i386/em/em_dup.s @@ -0,0 +1,17 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .dup + + ! #bytes in ecx + .sect .text +.dup: + pop ebx ! return address + mov eax,esi + mov edx,edi + mov esi,esp + sub esp,ecx + mov edi,esp + sar ecx,2 + rep movs + mov esi,eax + mov edi,edx + jmp ebx diff --git a/lib/ack/i386/em/em_dvf4.s b/lib/ack/i386/em/em_dvf4.s new file mode 100755 index 000000000..8897227bf --- /dev/null +++ b/lib/ack/i386/em/em_dvf4.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .dvf4 + + .sect .text +.dvf4: + mov bx,sp + flds 8(bx) + fdivs 4(bx) + fstps 8(bx) + wait + ret diff --git a/lib/ack/i386/em/em_dvf8.s b/lib/ack/i386/em/em_dvf8.s new file mode 100755 index 000000000..8fb6a47fe --- /dev/null +++ b/lib/ack/i386/em/em_dvf8.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .dvf8 + + .sect .text +.dvf8: + mov bx,sp + fldd 12(bx) + fdivd 4(bx) + fstpd 12(bx) + wait + ret diff --git a/lib/ack/i386/em/em_dvi.s b/lib/ack/i386/em/em_dvi.s new file mode 100755 index 000000000..f7a87300e --- /dev/null +++ b/lib/ack/i386/em/em_dvi.s @@ -0,0 +1,21 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .dvi + + ! #bytes in eax + .sect .text +.dvi: + pop ebx ! return address + cmp eax,4 + jne 1f + pop eax + cwd + pop ecx + idiv ecx + push eax + jmp ebx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_dvu.s b/lib/ack/i386/em/em_dvu.s new file mode 100755 index 000000000..5f5a71784 --- /dev/null +++ b/lib/ack/i386/em/em_dvu.s @@ -0,0 +1,21 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .dvu + + ! #bytes in eax + .sect .text +.dvu: + pop ebx ! return address + cmp eax,4 + jne 1f + pop eax + xor edx,edx + pop ecx + div ecx + push eax + jmp ebx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_error.s b/lib/ack/i386/em/em_error.s new file mode 100755 index 000000000..f2501e152 --- /dev/null +++ b/lib/ack/i386/em/em_error.s @@ -0,0 +1,32 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .error +.define .Xtrp + + ! eax is trap number + ! all registers must be saved + ! because return is possible + ! May only be called with error no's <16 +.sect .text +.error: + mov ecx,eax + mov ebx,1 + sal ebx,cl +.extern .ignmask +.extern .trp + test ebx,(.ignmask) + jne 2f + call .trp +2: + ret + +.Xtrp: + pusha + cmp eax,16 + jge 1f + call .error + popa + ret +1: + call .trp + popa + ret diff --git a/lib/ack/i386/em/em_exg.s b/lib/ack/i386/em/em_exg.s new file mode 100755 index 000000000..ad693dbaa --- /dev/null +++ b/lib/ack/i386/em/em_exg.s @@ -0,0 +1,22 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .exg + + ! #bytes in ecx +.sect .text +.exg: + push edi + mov edi,esp + add edi,8 + mov ebx,edi + add ebx,ecx + sar ecx,2 +1: + mov eax,(ebx) + xchg eax,(edi) + mov (ebx),eax + add edi,4 + add ebx,4 + loop 1b +2: + pop edi + ret diff --git a/lib/ack/i386/em/em_fat.s b/lib/ack/i386/em/em_fat.s new file mode 100755 index 000000000..0302552dc --- /dev/null +++ b/lib/ack/i386/em/em_fat.s @@ -0,0 +1,10 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .fat + +.fat: +.extern .trp +.extern .stop + call .trp + call .stop + ! no return diff --git a/lib/ack/i386/em/em_fef4.s b/lib/ack/i386/em/em_fef4.s new file mode 100755 index 000000000..adc69799e --- /dev/null +++ b/lib/ack/i386/em/em_fef4.s @@ -0,0 +1,49 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .fef4 + + .sect .text +.fef4: + ! this could be simpler, if only the + ! fxtract instruction was emulated properly + mov bx,sp + mov ax,8(bx) + and ax,0x7f800000 + je 1f ! zero exponent + shr ax,23 + sub ax,126 + mov cx,ax ! exponent in cx + mov ax,8(bx) + and ax,0x807fffff + or ax,0x3f000000 ! load -1 exponent + mov bx,4(bx) + mov 4(bx),ax + mov (bx),cx + ret +1: ! we get here on zero exp + mov ax,8(bx) + and ax,0x007fffff + jne 1f ! zero result + mov bx,4(bx) + mov (bx),ax + mov 4(bx),ax + ret +1: ! otherwise unnormalized number + mov cx,8(bx) + and cx,0x807fffff + mov dx,cx + and cx,0x80000000 + mov ax,-125 +2: + test dx,0x800000 + jne 1f + dec ax + shl dx,1 + or dx,cx + jmp 2b +1: + mov bx,4(bx) + mov (bx),ax + and dx,0x807fffff + or dx,0x3f000000 ! load -1 exponent + mov 4(bx),dx + ret diff --git a/lib/ack/i386/em/em_fef8.s b/lib/ack/i386/em/em_fef8.s new file mode 100755 index 000000000..48234edb2 --- /dev/null +++ b/lib/ack/i386/em/em_fef8.s @@ -0,0 +1,56 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .fef8 + + .sect .text +.fef8: + ! this could be simpler, if only the + ! fxtract instruction was emulated properly + mov bx,sp + mov ax,12(bx) + and ax,0x7ff00000 + je 1f ! zero exponent + shr ax,20 + sub ax,1022 + mov cx,ax ! exponent in cx + mov ax,12(bx) + and ax,0x800fffff + or ax,0x3fe00000 ! load -1 exponent + mov dx,8(bx) + mov bx,4(bx) + mov 4(bx),dx + mov 8(bx),ax + mov (bx),cx + ret +1: ! we get here on zero exp + mov ax,12(bx) + and ax,0xfffff + or ax,8(bx) + jne 1f ! zero result + mov bx,4(bx) + mov (bx),ax + mov 4(bx),ax + mov 8(bx),ax + ret +1: ! otherwise unnormalized number + mov cx,12(bx) + and cx,0x800fffff + mov dx,cx + and cx,0x80000000 + mov ax,-1021 +2: + test dx,0x100000 + jne 1f + dec ax + shl 8(bx),1 + rcl dx,1 + or dx,cx + jmp 2b +1: + and dx,0x800fffff + or dx,0x3fe00000 ! load -1 exponent + mov cx,8(bx) + mov bx,4(bx) + mov (bx),ax + mov 8(bx),dx + mov 4(bx),cx + ret diff --git a/lib/ack/i386/em/em_fif4.s b/lib/ack/i386/em/em_fif4.s new file mode 100755 index 000000000..04f702f0e --- /dev/null +++ b/lib/ack/i386/em/em_fif4.s @@ -0,0 +1,37 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .fif4 + + .sect .text +.fif4: + mov bx,sp + flds 8(bx) + fmuls 12(bx) ! multiply + fld st ! copy result + ftst ! test sign; handle negative separately + fstsw ax + wait + sahf ! result of test in condition codes + jb 1f + frndint ! this one rounds (?) + fcom st(1) ! compare with original; if <=, then OK + fstsw ax + wait + sahf + jbe 2f + fisubs (one) ! else subtract 1 + jmp 2f +1: ! here, negative case + frndint ! this one rounds (?) + fcom st(1) ! compare with original; if >=, then OK + fstsw ax + wait + sahf + jae 2f + fiadds (one) ! else add 1 +2: + fsub st(1),st ! subtract integer part + mov bx,4(bx) + fstps (bx) + fstps 4(bx) + wait + ret diff --git a/lib/ack/i386/em/em_fif8.s b/lib/ack/i386/em/em_fif8.s new file mode 100755 index 000000000..2b8154d11 --- /dev/null +++ b/lib/ack/i386/em/em_fif8.s @@ -0,0 +1,37 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .fif8 + + .sect .text +.fif8: + mov bx,sp + fldd 8(bx) + fmuld 16(bx) ! multiply + fld st ! and copy result + ftst ! test sign; handle negative separately + fstsw ax + wait + sahf ! result of test in condition codes + jb 1f + frndint ! this one rounds (?) + fcom st(1) ! compare with original; if <=, then OK + fstsw ax + wait + sahf + jbe 2f + fisubs (one) ! else subtract 1 + jmp 2f +1: ! here, negative case + frndint ! this one rounds (?) + fcom st(1) ! compare with original; if >=, then OK + fstsw ax + wait + sahf + jae 2f + fiadds (one) ! else add 1 +2: + fsub st(1),st ! subtract integer part + mov bx,4(bx) + fstpd (bx) + fstpd 8(bx) + wait + ret diff --git a/lib/ack/i386/em/em_fp8087.s b/lib/ack/i386/em/em_fp8087.s new file mode 100755 index 000000000..53f6b7f93 --- /dev/null +++ b/lib/ack/i386/em/em_fp8087.s @@ -0,0 +1,10 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define one, bigmin + + .sect .rom +one: + .data2 1 +two: + .data2 2 +bigmin: + .data4 -2147483648 diff --git a/lib/ack/i386/em/em_gto.s b/lib/ack/i386/em/em_gto.s new file mode 100755 index 000000000..0149f27ca --- /dev/null +++ b/lib/ack/i386/em/em_gto.s @@ -0,0 +1,8 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .gto + +.gto: + mov ebp,8(ebx) + mov esp,4(ebx) + jmp (ebx) diff --git a/lib/ack/i386/em/em_hol0.s b/lib/ack/i386/em/em_hol0.s new file mode 100755 index 000000000..8c919aeee --- /dev/null +++ b/lib/ack/i386/em/em_hol0.s @@ -0,0 +1,7 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss + +.define hol0 +.sect .data +hol0: + .data4 0, 0 + .data4 0, 0 diff --git a/lib/ack/i386/em/em_iaar.s b/lib/ack/i386/em/em_iaar.s new file mode 100755 index 000000000..b74dc3fa4 --- /dev/null +++ b/lib/ack/i386/em/em_iaar.s @@ -0,0 +1,18 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .iaar + +.iaar: + pop ecx + pop edx + cmp edx,4 +.extern .unknown + jne .unknown + pop ebx ! descriptor address + pop eax ! index + sub eax,(ebx) + mul 8(ebx) + pop ebx ! array base + add ebx,eax + push ecx + ret diff --git a/lib/ack/i386/em/em_ilar.s b/lib/ack/i386/em/em_ilar.s new file mode 100755 index 000000000..15514863e --- /dev/null +++ b/lib/ack/i386/em/em_ilar.s @@ -0,0 +1,15 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .ilar + +.ilar: + pop ecx + pop edx +.extern .unknown + cmp edx,4 + jne .unknown + pop ebx ! descriptor address + pop eax ! index + push ecx +.extern .lar4 + jmp .lar4 diff --git a/lib/ack/i386/em/em_inn.s b/lib/ack/i386/em/em_inn.s new file mode 100755 index 000000000..95d8ac01b --- /dev/null +++ b/lib/ack/i386/em/em_inn.s @@ -0,0 +1,32 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .inn + + ! #bytes in ecx + ! bit # in eax +.inn: + xor edx,edx + mov ebx,8 + div ebx + mov ebx,esp + add ebx,4 + add ebx,eax + cmp eax,ecx + jae 1f + movb al,(ebx) + mov ebx,edx + testb al,bits(ebx) + jz 1f + mov eax,1 + jmp 2f +1: + xor eax,eax +2: + pop ebx + add esp,ecx + ! eax is result + jmp ebx + + .sect .rom +bits: + .data1 1,2,4,8,16,32,64,128 diff --git a/lib/ack/i386/em/em_ior.s b/lib/ack/i386/em/em_ior.s new file mode 100755 index 000000000..3981ff5ae --- /dev/null +++ b/lib/ack/i386/em/em_ior.s @@ -0,0 +1,18 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .ior + + ! #bytes in ecx +.ior: + pop ebx ! return address + mov edx,edi + mov edi,esp + add edi,ecx + sar ecx,2 +1: + pop eax + or eax,(edi) + stos + loop 1b + mov edi,edx + jmp ebx diff --git a/lib/ack/i386/em/em_isar.s b/lib/ack/i386/em/em_isar.s new file mode 100755 index 000000000..75b46b7b5 --- /dev/null +++ b/lib/ack/i386/em/em_isar.s @@ -0,0 +1,15 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .isar + +.isar: + pop ecx + pop eax + cmp eax,4 +.extern .unknown + jne .unknown + pop ebx ! descriptor address + pop eax ! index + push ecx +.extern .sar4 + jmp .sar4 diff --git a/lib/ack/i386/em/em_lar4.s b/lib/ack/i386/em/em_lar4.s new file mode 100755 index 000000000..643ec961f --- /dev/null +++ b/lib/ack/i386/em/em_lar4.s @@ -0,0 +1,37 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .lar4 + +.lar4: + ! ebx, descriptor address + ! eax, index + sub eax,(ebx) + mov ecx,8(ebx) + imul ecx + pop ebx + pop edx ! base address + add edx,eax + sar ecx,1 + jnb 1f + xor eax,eax + movb al,(edx) + push eax + jmp ebx +1: + sar ecx,1 + jnb 1f + xor eax,eax + o16 mov ax,(edx) + push eax + jmp ebx +1: + xchg edx,esi ! saved esi + mov eax,ecx + sal eax,2 + sub esp,eax + mov eax,edi ! save edi + mov edi,esp + rep movs + mov edi,eax + mov esi,edx + jmp ebx diff --git a/lib/ack/i386/em/em_loi.s b/lib/ack/i386/em/em_loi.s new file mode 100755 index 000000000..c0ed170d5 --- /dev/null +++ b/lib/ack/i386/em/em_loi.s @@ -0,0 +1,44 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .loi +.define .los + + ! #bytes in ecx + ! address in ebx + ! save esi/edi. they might be register variables +.los: + pop edx + mov eax,ecx + sar ecx,1 + jnb 1f + movsxb eax,(ebx) + push eax + jmp edx +1: + sar ecx,1 + jnb 1f + movsx eax,(ebx) + push eax + jmp edx +1: + push edx + mov edx,esi + mov esi,ebx + pop ebx + sub esp,eax + jmp 1f + +.loi: + ! only called with size >= 4 + mov edx,esi + mov esi,ebx + pop ebx + sub esp,ecx + sar ecx,2 +1: + mov eax,edi + mov edi,esp + rep movs + mov esi,edx + mov edi,eax + jmp ebx diff --git a/lib/ack/i386/em/em_mlf4.s b/lib/ack/i386/em/em_mlf4.s new file mode 100755 index 000000000..e3068ac6c --- /dev/null +++ b/lib/ack/i386/em/em_mlf4.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .mlf4 + + .sect .text +.mlf4: + mov bx,sp + flds 4(bx) + fmuls 8(bx) + fstps 8(bx) + wait + ret diff --git a/lib/ack/i386/em/em_mlf8.s b/lib/ack/i386/em/em_mlf8.s new file mode 100755 index 000000000..56ff130ef --- /dev/null +++ b/lib/ack/i386/em/em_mlf8.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .mlf8 + + .sect .text +.mlf8: + mov bx,sp + fldd 4(bx) + fmuld 12(bx) + fstpd 12(bx) + wait + ret diff --git a/lib/ack/i386/em/em_mli.s b/lib/ack/i386/em/em_mli.s new file mode 100755 index 000000000..84185fb62 --- /dev/null +++ b/lib/ack/i386/em/em_mli.s @@ -0,0 +1,20 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .mli + + ! #bytes in eax +.mli: + pop ebx ! return address + cmp eax,4 + jne 1f + pop eax + pop ecx + mul ecx + push eax + jmp ebx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_mon.s b/lib/ack/i386/em/em_mon.s new file mode 100755 index 000000000..42cac7ca8 --- /dev/null +++ b/lib/ack/i386/em/em_mon.s @@ -0,0 +1,7 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .mon + +.mon: +.extern .stop + call .stop diff --git a/lib/ack/i386/em/em_ngf4.s b/lib/ack/i386/em/em_ngf4.s new file mode 100755 index 000000000..e21fe2b0c --- /dev/null +++ b/lib/ack/i386/em/em_ngf4.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .ngf4 + + .sect .text +.ngf4: + mov bx,sp + flds 4(bx) + fchs + fstps 4(bx) + wait + ret diff --git a/lib/ack/i386/em/em_ngf8.s b/lib/ack/i386/em/em_ngf8.s new file mode 100755 index 000000000..baec4bcf3 --- /dev/null +++ b/lib/ack/i386/em/em_ngf8.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .ngf8 + + .sect .text +.ngf8: + mov bx,sp + fldd 4(bx) + fchs + fstpd 4(bx) + wait + ret diff --git a/lib/ack/i386/em/em_ngi.s b/lib/ack/i386/em/em_ngi.s new file mode 100755 index 000000000..b15a1fab8 --- /dev/null +++ b/lib/ack/i386/em/em_ngi.s @@ -0,0 +1,19 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .ngi + + ! #bytes in eax +.ngi: + pop ebx ! return address + cmp eax,4 + jne 1f + pop ecx + neg ecx + push ecx + jmp ebx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_nop.s b/lib/ack/i386/em/em_nop.s new file mode 100755 index 000000000..46fbbb7ff --- /dev/null +++ b/lib/ack/i386/em/em_nop.s @@ -0,0 +1,10 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .nop +.extern printd, printc, hol0 + +.nop: + mov eax,(hol0) + call printd + movb al,'\n' + jmp printc diff --git a/lib/ack/i386/em/em_print.s b/lib/ack/i386/em/em_print.s new file mode 100755 index 000000000..8b09b5044 --- /dev/null +++ b/lib/ack/i386/em/em_print.s @@ -0,0 +1,47 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define printc,printd,prints + + ! argument in eax + ! uses ebx +prints: + xchg eax,ebx +1: + movb al,(ebx) + inc ebx + testb al,al + jz 2f + call printc + jmp 1b +2: + ret + + ! argument in eax + ! uses ecx and edx +printd: + xor edx,edx + mov ecx,10 + div ecx + test eax,eax + jz 1f + push edx + call printd + pop edx +1: + xchg eax,edx + addb al,'0' + + ! argument in eax +printc: + push eax + mov ebx,esp + mov eax,1 + push eax + push ebx + push eax + call __write + pop ebx + pop ebx + pop ebx + pop ebx + ret diff --git a/lib/ack/i386/em/em_rck.s b/lib/ack/i386/em/em_rck.s new file mode 100755 index 000000000..e1a6669e4 --- /dev/null +++ b/lib/ack/i386/em/em_rck.s @@ -0,0 +1,20 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .rck + + ! descriptor address in ebx + ! value in eax, must be left there +.rck: + cmp eax,(ebx) + jl 2f + cmp eax,4(ebx) + jg 2f + ret +2: + push eax +.extern ERANGE +.extern .error + mov eax,ERANGE + call .error + pop eax + ret diff --git a/lib/ack/i386/em/em_rmi.s b/lib/ack/i386/em/em_rmi.s new file mode 100755 index 000000000..775abbdd7 --- /dev/null +++ b/lib/ack/i386/em/em_rmi.s @@ -0,0 +1,21 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .rmi + + ! #bytes in eax +.rmi: + pop ebx ! return address + cmp eax,4 + jne 1f + pop eax + cwd + pop ecx + idiv ecx + push edx + jmp ebx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_rmu.s b/lib/ack/i386/em/em_rmu.s new file mode 100755 index 000000000..d51029d58 --- /dev/null +++ b/lib/ack/i386/em/em_rmu.s @@ -0,0 +1,21 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .rmu + + ! #bytes in eax +.rmu: + pop ebx ! return address + cmp eax,4 + jne 1f + pop eax + xor edx,edx + pop ecx + idiv ecx + push edx + jmp ebx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_rol.s b/lib/ack/i386/em/em_rol.s new file mode 100755 index 000000000..68365d7fc --- /dev/null +++ b/lib/ack/i386/em/em_rol.s @@ -0,0 +1,20 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .rol + + ! #bytes in eax +.rol: + pop edx ! return address + cmp eax,4 + jne 1f + pop eax + pop ecx + rol eax,cl + push eax + jmp edx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push edx + jmp .trp diff --git a/lib/ack/i386/em/em_ror.s b/lib/ack/i386/em/em_ror.s new file mode 100755 index 000000000..ef34a9658 --- /dev/null +++ b/lib/ack/i386/em/em_ror.s @@ -0,0 +1,20 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .ror + + ! #bytes in eax +.ror: + pop edx ! return address + cmp eax,4 + jne 1f + pop eax + pop ecx + ror eax,cl + push eax + jmp edx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push edx + jmp .trp diff --git a/lib/ack/i386/em/em_sar4.s b/lib/ack/i386/em/em_sar4.s new file mode 100755 index 000000000..52a1f6192 --- /dev/null +++ b/lib/ack/i386/em/em_sar4.s @@ -0,0 +1,33 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .sar4 + +.sar4: + ! ebx, descriptor address + ! eax, index + sub eax,(ebx) + mov ecx,8(ebx) + imul ecx + pop ebx + pop edx ! base address + add edx,eax + sar ecx,1 + jnb 1f + pop eax + movb (edx),al + jmp ebx +1: + sar ecx,1 + jnb 1f + pop eax + o16 mov (edx),ax + jmp ebx +1: + xchg edi,edx ! edi = base address, edx is saved edi + mov eax,esi + mov esi,esp + rep movs + mov esp,esi + mov esi,eax + mov edi,edx + jmp ebx diff --git a/lib/ack/i386/em/em_sbf4.s b/lib/ack/i386/em/em_sbf4.s new file mode 100755 index 000000000..e76f9d1aa --- /dev/null +++ b/lib/ack/i386/em/em_sbf4.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .sbf4 + + .sect .text +.sbf4: + mov bx,sp + flds 8(bx) + fsubs 4(bx) + fstps 8(bx) + wait + ret diff --git a/lib/ack/i386/em/em_sbf8.s b/lib/ack/i386/em/em_sbf8.s new file mode 100755 index 000000000..cab3d7830 --- /dev/null +++ b/lib/ack/i386/em/em_sbf8.s @@ -0,0 +1,11 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.define .sbf8 + + .sect .text +.sbf8: + mov bx,sp + fldd 12(bx) + fsubd 4(bx) + fstpd 12(bx) + wait + ret diff --git a/lib/ack/i386/em/em_sbi.s b/lib/ack/i386/em/em_sbi.s new file mode 100755 index 000000000..2897d3181 --- /dev/null +++ b/lib/ack/i386/em/em_sbi.s @@ -0,0 +1,19 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .sbi + + ! #bytes in ecx , top of stack in eax +.sbi: + pop ebx ! return subress + cmp ecx,4 + jne 1f + pop ecx + sub eax,ecx + neg eax + jmp ebx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push ebx + jmp .trp diff --git a/lib/ack/i386/em/em_set.s b/lib/ack/i386/em/em_set.s new file mode 100755 index 000000000..3493eac52 --- /dev/null +++ b/lib/ack/i386/em/em_set.s @@ -0,0 +1,42 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .set + + ! #bytes in ecx + ! bit # in eax +.set: + pop ebx ! return address + xor edx,edx +!ifdef create set + sub esp,ecx + push ebx + push edi + mov ebx,esp + xor edi,edi + sar ecx,2 +1: + mov 8(ebx)(edi),edx + add edi,4 + loop 1b +!endif + mov ebx,8 + div ebx + cmp eax,edi + jae 2f + mov edi,edx + movb dl,bits(edi) + mov edi,esp + add edi,eax + orb 8(edi),dl + pop edi + ret +2: +.extern ESET +.extern .trp + pop edi + mov eax,ESET + jmp .trp + + .sect .rom +bits: + .data1 1,2,4,8,16,32,64,128 diff --git a/lib/ack/i386/em/em_sli.s b/lib/ack/i386/em/em_sli.s new file mode 100755 index 000000000..dd5b61667 --- /dev/null +++ b/lib/ack/i386/em/em_sli.s @@ -0,0 +1,20 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .sli + + ! #bytes in eax +.sli: + pop edx ! return address + cmp eax,4 + jne 1f + pop eax + pop ecx + sal eax,cl + push eax + jmp edx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push edx + jmp .trp diff --git a/lib/ack/i386/em/em_sri.s b/lib/ack/i386/em/em_sri.s new file mode 100755 index 000000000..2fb78715f --- /dev/null +++ b/lib/ack/i386/em/em_sri.s @@ -0,0 +1,20 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .sri + + ! #bytes in eax +.sri: + pop edx ! return address + cmp eax,4 + jne 1f + pop eax + pop ecx + sar eax,cl + push eax + jmp edx +1: +.extern EODDZ +.extern .trp + mov eax,EODDZ + push edx + jmp .trp diff --git a/lib/ack/i386/em/em_sti.s b/lib/ack/i386/em/em_sti.s new file mode 100755 index 000000000..12385eedd --- /dev/null +++ b/lib/ack/i386/em/em_sti.s @@ -0,0 +1,41 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .sti +.define .sts + + ! #bytes in ecx + ! address in ebx + ! save edi/esi. they might be register variables +.sts: + pop edx + sar ecx,1 + jnb 1f + pop eax + movb (ebx),al + jmp edx +1: + sar ecx,1 + jnb 1f + pop eax + o16 mov (ebx),ax + jmp edx +1: + push edx + mov edx,edi + mov edi,ebx + pop ebx + jmp 1f +.sti: + ! only called with count >> 4 + mov edx,edi + mov edi,ebx + pop ebx + sar ecx,2 +1: + mov eax,esi + mov esi,esp + rep movs + mov esp,esi + mov edi,edx + mov esi,eax + jmp ebx diff --git a/lib/ack/i386/em/em_stop.s b/lib/ack/i386/em/em_stop.s new file mode 100755 index 000000000..476045f0a --- /dev/null +++ b/lib/ack/i386/em/em_stop.s @@ -0,0 +1,5 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .stop +.stop: + jmp ___exit diff --git a/lib/ack/i386/em/em_trp.s b/lib/ack/i386/em/em_trp.s new file mode 100755 index 000000000..24af0e6f4 --- /dev/null +++ b/lib/ack/i386/em/em_trp.s @@ -0,0 +1,18 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .trp +.extern .trppc, .stop + + ! eax is trap number +.trp: + xor ebx,ebx + xchg ebx,(.trppc) + test ebx,ebx + jz 2f + push eax + call ebx + pop eax + ret +2: + push eax + call .stop diff --git a/lib/ack/i386/em/em_unknown.s b/lib/ack/i386/em/em_unknown.s new file mode 100755 index 000000000..59425f25c --- /dev/null +++ b/lib/ack/i386/em/em_unknown.s @@ -0,0 +1,9 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .unknown +.extern EILLINS, .fat + +.unknown: + mov eax,EILLINS + push eax + jmp .fat diff --git a/lib/ack/i386/em/em_xor.s b/lib/ack/i386/em/em_xor.s new file mode 100755 index 000000000..2dfb30d96 --- /dev/null +++ b/lib/ack/i386/em/em_xor.s @@ -0,0 +1,18 @@ +.sect .text; .sect .rom; .sect .data; .sect .bss +.sect .text +.define .xor + + ! #bytes in ecx +.xor: + pop ebx ! return address + mov edx,edi + mov edi,esp + add edi,ecx + sar ecx,2 +1: + pop eax + xor eax,(edi) + stos + loop 1b + mov edi,edx + jmp ebx diff --git a/lib/ack/i386/head/Makefile b/lib/ack/i386/head/Makefile new file mode 100644 index 000000000..1d2bd521a --- /dev/null +++ b/lib/ack/i386/head/Makefile @@ -0,0 +1,9 @@ +# Makefile for lib/ack/i386/head. + +ASFLAGS = -I. + +LIBRARIES = libe + +libe_OBJECTS = em_head.o + +include ../../../Makefile.ack.inc diff --git a/lib/ack/i386/head/Makefile.ack.conv b/lib/ack/i386/head/Makefile.ack.conv new file mode 100755 index 000000000..e4d5ddb58 --- /dev/null +++ b/lib/ack/i386/head/Makefile.ack.conv @@ -0,0 +1,13 @@ +# Makefile for lib/i386/head. + +CC1 = $(CC) -Was-ack -c -I$(SRCDIR)/$(SUBDIR) + +LIBRARY = ../../../libe.a +all: $(LIBRARY) + +$(LIBRARY): $(LIBRARY)(em_head.o) + aal cr $@ *.o + rm *.o + +$(LIBRARY)(em_head.o): em_head.s + $(CC1) -I. em_head.s diff --git a/lib/ack/i386/head/em_abs.h b/lib/ack/i386/head/em_abs.h new file mode 100755 index 000000000..9855cff5a --- /dev/null +++ b/lib/ack/i386/head/em_abs.h @@ -0,0 +1,35 @@ +/* $Header$ */ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ +#define LINO_AD 0 +#define FILN_AD 4 + +#define LINO (*(int *)(_hol0()+LINO_AD)) +#define FILN (*(char **)(_hol0()+FILN_AD)) + +#define EARRAY 0 +#define ERANGE 1 +#define ESET 2 +#define EIOVFL 3 +#define EFOVFL 4 +#define EFUNFL 5 +#define EIDIVZ 6 +#define EFDIVZ 7 +#define EIUND 8 +#define EFUND 9 +#define ECONV 10 + +#define ESTACK 16 +#define EHEAP 17 +#define EILLINS 18 +#define EODDZ 19 +#define ECASE 20 +#define EMEMFLT 21 +#define EBADPTR 22 +#define EBADPC 23 +#define EBADLAE 24 +#define EBADMON 25 +#define EBADLIN 26 +#define EBADGTO 27 diff --git a/lib/ack/i386/head/em_head.s b/lib/ack/i386/head/em_head.s new file mode 100755 index 000000000..2164dbcc7 --- /dev/null +++ b/lib/ack/i386/head/em_head.s @@ -0,0 +1,20 @@ +# +.sect .text; .sect .rom; .sect .data; .sect .bss +.define ERANGE,ESET,EHEAP,ECASE,EILLINS,EIDIVZ,EODDZ +.define .trppc, .ignmask + +ERANGE = 1 +ESET = 2 +EIDIVZ = 6 +EHEAP = 17 +EILLINS = 18 +EODDZ = 19 +ECASE = 20 + +#include + +.sect .data +.trppc: + .data4 0 +.ignmask: + .data4 EIOVFL | EIUND | ECONV | EFOVFL | EFUNFL diff --git a/lib/ack/libm2/Arguments.c b/lib/ack/libm2/Arguments.c new file mode 100755 index 000000000..eaf696236 --- /dev/null +++ b/lib/ack/libm2/Arguments.c @@ -0,0 +1,73 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: Access to program arguments and environment + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +extern char **argv, ***_penviron; +extern int argc; +unsigned int _Arguments__Argc; + +static char * +findname(s1, s2) +register char *s1, *s2; +{ + + while (*s1 == *s2++) s1++; + if (*s1 == '\0' && *(s2-1) == '=') return s2; + return 0; +} + +static unsigned int +scopy(src, dst, max) + register char *src, *dst; + unsigned int max; +{ + register unsigned int i = 0; + + while (*src && i <= max) { + i++; + *dst++ = *src++; + } + if (i <= max) { + *dst = '\0'; + return i+1; + } + while (*src++) i++; + return i + 1; +} + +_Arguments_() +{ + _Arguments__Argc = argc; +} + +unsigned +_Arguments__Argv(n, argument, l, u, s) + unsigned int u; + char *argument; +{ + + if (n >= argc) return 0; + return scopy(argv[n], argument, u); +} + +unsigned +_Arguments__GetEnv(name, nn, nu, ns, value, l, u, s) + char *name, *value; + unsigned int nu, u; +{ + register char **p = *_penviron; + register char *v = 0; + + while (*p && !(v = findname(name, *p++))) { + /* nothing */ + } + if (!v) return 0; + return scopy(v, value, u); +} diff --git a/lib/ack/libm2/ArraySort.mod b/lib/ack/libm2/ArraySort.mod new file mode 100755 index 000000000..147ca9e60 --- /dev/null +++ b/lib/ack/libm2/ArraySort.mod @@ -0,0 +1,155 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE ArraySort; +(* + Module: Array sorting module. + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + FROM SYSTEM IMPORT ADDRESS, BYTE; (* no generics in Modula-2, sorry *) + + TYPE BytePtr = POINTER TO BYTE; + + VAR compareproc: CompareProc; + + PROCEDURE Sort(base: ADDRESS; (* address of array *) + nel: CARDINAL; (* number of elements in array *) + size: CARDINAL; (* size of each element *) + compar: CompareProc); (* the comparison procedure *) + BEGIN + compareproc := compar; + qsort(base, base+(nel-1)*size, size); + END Sort; + + PROCEDURE qsort(a1, a2: ADDRESS; size: CARDINAL); + (* Implemented with quick-sort, with some extra's *) + VAR left, right, lefteq, righteq: ADDRESS; + cmp: CompareResult; + mainloop: BOOLEAN; + BEGIN + WHILE a2 > a1 DO + left := a1; + right := a2; + lefteq := a1 + size * (((a2 - a1) + size) DIV (2 * size)); + righteq := lefteq; + (* + Pick an element in the middle of the array. + We will collect the equals around it. + "lefteq" and "righteq" indicate the left and right + bounds of the equals respectively. + Smaller elements end up left of it, larger elements end + up right of it. + *) + LOOP + LOOP + IF left >= lefteq THEN EXIT END; + cmp := compareproc(left, lefteq); + IF cmp = greater THEN EXIT END; + IF cmp = less THEN + left := left + size; + ELSE + (* equal, so exchange with the element + to the left of the "equal"-interval. + *) + lefteq := lefteq - size; + exchange(left, lefteq, size); + END; + END; + mainloop := FALSE; + LOOP + IF right <= righteq THEN EXIT END; + cmp := compareproc(right, righteq); + IF cmp = less THEN + IF left < lefteq THEN + (* larger one at the left, + so exchange + *) + exchange(left,right,size); + left := left + size; + right := right - size; + mainloop := TRUE; + EXIT; + END; + (* + no more room at the left part, so we + move the "equal-interval" one place to the + right, and the smaller element to the + left of it. + This is best expressed as a three-way + exchange. + *) + righteq := righteq + size; + threewayexchange(left, righteq, right, + size); + lefteq := lefteq + size; + left := lefteq; + ELSIF cmp = equal THEN + (* equal, zo exchange with the element + to the right of the "equal" + interval + *) + righteq := righteq + size; + exchange(right, righteq, size); + ELSE + (* leave it where it is *) + right := right - size; + END; + END; + IF (NOT mainloop) THEN + IF left >= lefteq THEN + (* sort "smaller" part *) + qsort(a1, lefteq - size, size); + (* and now the "larger" part, saving a + procedure call, because of this big + WHILE loop + *) + a1 := righteq + size; + EXIT; (* from the LOOP *) + END; + (* larger element to the left, but no more room, + so move the "equal-interval" one place to the + left, and the larger element to the right + of it. + *) + lefteq := lefteq - size; + threewayexchange(right, lefteq, left, size); + righteq := righteq - size; + right := righteq; + END; + END; + END; + END qsort; + + PROCEDURE exchange(a,b: BytePtr; size : CARDINAL); + VAR c: BYTE; + BEGIN + WHILE size > 0 DO + DEC(size); + c := a^; + a^ := b^; + a := ADDRESS(a) + 1; + b^ := c; + b := ADDRESS(b) + 1; + END; + END exchange; + + PROCEDURE threewayexchange(p,q,r: BytePtr; size: CARDINAL); + VAR c: BYTE; + BEGIN + WHILE size > 0 DO + DEC(size); + c := p^; + p^ := r^; + p := ADDRESS(p) + 1; + r^ := q^; + r := ADDRESS(r) + 1; + q^ := c; + q := ADDRESS(q) + 1; + END; + END threewayexchange; + +END ArraySort. diff --git a/lib/ack/libm2/CSP.mod b/lib/ack/libm2/CSP.mod new file mode 100755 index 000000000..7a50df425 --- /dev/null +++ b/lib/ack/libm2/CSP.mod @@ -0,0 +1,347 @@ +(*$R-*) +IMPLEMENTATION MODULE CSP; +(* + Module: Communicating Sequential Processes + From: "A Modula-2 Implementation of CSP", + M. Collado, R. Morales, J.J. Moreno, + SIGPlan Notices, Volume 22, Number 6, June 1987. + Some modifications by Ceriel J.H. Jacobs + Version: $Header$ + + See this article for an explanation of the use of this module. +*) + + FROM random IMPORT Uniform; + FROM SYSTEM IMPORT BYTE, ADDRESS, NEWPROCESS, TRANSFER; + FROM Storage IMPORT Allocate, Deallocate; + FROM Traps IMPORT Message; + + CONST WorkSpaceSize = 2000; + + TYPE ByteAddress = POINTER TO BYTE; + Channel = POINTER TO ChannelDescriptor; + ProcessType = POINTER TO ProcessDescriptor; + ProcessDescriptor = RECORD + next: ProcessType; + father: ProcessType; + cor: ADDRESS; + wsp: ADDRESS; + guardindex: INTEGER; + guardno: CARDINAL; + guardcount: CARDINAL; + opened: Channel; + sons: CARDINAL; + msgadr: ADDRESS; + msglen: CARDINAL; + END; + + Queue = RECORD + head, tail: ProcessType; + END; + + ChannelDescriptor = RECORD + senders: Queue; + owner: ProcessType; + guardindex: INTEGER; + next: Channel; + END; + + VAR cp: ProcessType; + free, ready: Queue; + +(* ------------ Private modules and procedures ------------- *) + + MODULE ProcessQueue; + + IMPORT ProcessType, Queue; + EXPORT Push, Pop, InitQueue, IsEmpty; + + PROCEDURE InitQueue(VAR q: Queue); + BEGIN + WITH q DO + head := NIL; + tail := NIL + END + END InitQueue; + + PROCEDURE Push(p: ProcessType; VAR q: Queue); + BEGIN + p^.next := NIL; + WITH q DO + IF head = NIL THEN + tail := p + ELSE + head^.next := p + END; + head := p + END + END Push; + + PROCEDURE Pop(VAR q: Queue; VAR p: ProcessType); + BEGIN + WITH q DO + p := tail; + IF p # NIL THEN + tail := tail^.next; + IF head = p THEN + head := NIL + END + END + END + END Pop; + + PROCEDURE IsEmpty(q: Queue): BOOLEAN; + BEGIN + RETURN q.head = NIL + END IsEmpty; + + END ProcessQueue; + + + PROCEDURE DoTransfer; + VAR aux: ProcessType; + BEGIN + aux := cp; + Pop(ready, cp); + IF cp = NIL THEN + HALT + ELSE + TRANSFER(aux^.cor, cp^.cor) + END + END DoTransfer; + + PROCEDURE OpenChannel(ch: Channel; n: INTEGER); + BEGIN + WITH ch^ DO + IF guardindex = 0 THEN + guardindex := n; + next := cp^.opened; + cp^.opened := ch + END + END + END OpenChannel; + + PROCEDURE CloseChannels(p: ProcessType); + BEGIN + WITH p^ DO + WHILE opened # NIL DO + opened^.guardindex := 0; + opened := opened^.next + END + END + END CloseChannels; + + PROCEDURE ThereAreOpenChannels(): BOOLEAN; + BEGIN + RETURN cp^.opened # NIL; + END ThereAreOpenChannels; + + PROCEDURE Sending(ch: Channel): BOOLEAN; + BEGIN + RETURN NOT IsEmpty(ch^.senders) + END Sending; + +(* -------------- Public Procedures ----------------- *) + + PROCEDURE COBEGIN; + (* Beginning of a COBEGIN .. COEND structure *) + BEGIN + END COBEGIN; + + PROCEDURE COEND; + (* End of a COBEGIN .. COEND structure *) + (* VAR aux: ProcessType; *) + BEGIN + IF cp^.sons > 0 THEN + DoTransfer + END + END COEND; + + PROCEDURE StartProcess(P: PROC); + (* Start an anonimous process that executes the procedure P *) + VAR newprocess: ProcessType; + BEGIN + Pop(free, newprocess); + IF newprocess = NIL THEN + Allocate(newprocess,SIZE(ProcessDescriptor)); + Allocate(newprocess^.wsp, WorkSpaceSize) + END; + WITH newprocess^ DO + father := cp; + sons := 0; + msglen := 0; + NEWPROCESS(P, wsp, WorkSpaceSize, cor) + END; + cp^.sons := cp^.sons + 1; + Push(newprocess, ready) + END StartProcess; + + PROCEDURE StopProcess; + (* Terminate a Process (itself) *) + VAR aux: ProcessType; + BEGIN + aux := cp^.father; + aux^.sons := aux^.sons - 1; + IF aux^.sons = 0 THEN + Push(aux, ready) + END; + aux := cp; + Push(aux, free); + Pop(ready, cp); + IF cp = NIL THEN + HALT + ELSE + TRANSFER(aux^.cor, cp^.cor) + END + END StopProcess; + + PROCEDURE InitChannel(VAR ch: Channel); + (* Initialize the channel ch *) + BEGIN + Allocate(ch, SIZE(ChannelDescriptor)); + WITH ch^ DO + InitQueue(senders); + owner := NIL; + next := NIL; + guardindex := 0 + END + END InitChannel; + + PROCEDURE GetChannel(ch: Channel); + (* Assign the channel ch to the process that gets it *) + BEGIN + WITH ch^ DO + IF owner # NIL THEN + Message("Channel already has an owner"); + HALT + END; + owner := cp + END + END GetChannel; + + PROCEDURE Send(data: ARRAY OF BYTE; VAR ch: Channel); + (* Send a message with the data to the cvhannel ch *) + VAR m: ByteAddress; + (* aux: ProcessType; *) + i: CARDINAL; + BEGIN + WITH ch^ DO + Push(cp, senders); + Allocate(cp^.msgadr, SIZE(data)); + m := cp^.msgadr; + cp^.msglen := HIGH(data); + FOR i := 0 TO HIGH(data) DO + m^ := data[i]; + m := ADDRESS(m) + 1 + END; + IF guardindex # 0 THEN + owner^.guardindex := guardindex; + CloseChannels(owner); + Push(owner, ready) + END + END; + DoTransfer + END Send; + + PROCEDURE Receive(VAR ch: Channel; VAR dest: ARRAY OF BYTE); + (* Receive a message from the channel ch into the dest variable *) + VAR aux: ProcessType; + m: ByteAddress; + i: CARDINAL; + BEGIN + WITH ch^ DO + IF cp # owner THEN + Message("Only owner of channel can receive from it"); + HALT + END; + IF Sending(ch) THEN + Pop(senders, aux); + m := aux^.msgadr; + FOR i := 0 TO aux^.msglen DO + dest[i] := m^; + m := ADDRESS(m) + 1 + END; + Push(aux, ready); + Push(cp, ready); + CloseChannels(cp) + ELSE + OpenChannel(ch, -1); + DoTransfer; + Pop(senders, aux); + m := aux^.msgadr; + FOR i := 0 TO aux^.msglen DO + dest[i] := m^; + m := ADDRESS(m) + 1 + END; + Push(cp, ready); + Push(aux, ready) + END; + Deallocate(aux^.msgadr, aux^.msglen+1); + DoTransfer + END + END Receive; + + PROCEDURE SELECT(n: CARDINAL); + (* Beginning of a SELECT structure with n guards *) + BEGIN + cp^.guardindex := Uniform(1,n); + cp^.guardno := n; + cp^.guardcount := n + END SELECT; + + PROCEDURE NEXTGUARD(): CARDINAL; + (* Returns an index to the next guard to be evaluated in a SELECT *) + BEGIN + RETURN cp^.guardindex + END NEXTGUARD; + + PROCEDURE GUARD(cond: BOOLEAN; ch: Channel; + VAR dest: ARRAY OF BYTE): BOOLEAN; + (* Evaluates a guard, including reception management *) + (* VAR aux: ProcessType; *) + BEGIN + IF NOT cond THEN + RETURN FALSE + ELSIF ch = NIL THEN + CloseChannels(cp); + cp^.guardindex := 0; + RETURN TRUE + ELSIF Sending(ch) THEN + Receive(ch, dest); + cp^.guardindex := 0; + RETURN TRUE + ELSE + OpenChannel(ch, cp^.guardindex); + RETURN FALSE + END + END GUARD; + + PROCEDURE ENDSELECT(): BOOLEAN; + (* End of a SELECT structure *) + BEGIN + WITH cp^ DO + IF guardindex <= 0 THEN + RETURN TRUE + END; + guardcount := guardcount - 1; + IF guardcount # 0 THEN + guardindex := (guardindex MOD INTEGER(guardno)) + 1 + ELSIF ThereAreOpenChannels() THEN + DoTransfer + ELSE + guardindex := 0 + END + END; + RETURN FALSE + END ENDSELECT; + +BEGIN + InitQueue(free); + InitQueue(ready); + Allocate(cp,SIZE(ProcessDescriptor)); + WITH cp^ DO + sons := 0; + father := NIL + END +END CSP. + diff --git a/lib/ack/libm2/Conversion.mod b/lib/ack/libm2/Conversion.mod new file mode 100755 index 000000000..b64ebc42c --- /dev/null +++ b/lib/ack/libm2/Conversion.mod @@ -0,0 +1,73 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Conversions; +(* + Module: numeric-to-string conversions + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + PROCEDURE ConvertNum(num, len, base: CARDINAL; + neg: BOOLEAN; + VAR str: ARRAY OF CHAR); + VAR i: CARDINAL; + r: CARDINAL; + tmp: ARRAY [0..20] OF CHAR; + BEGIN + i := 0; + REPEAT + r := num MOD base; + num := num DIV base; + IF r <= 9 THEN + tmp[i] := CHR(r + ORD('0')); + ELSE + tmp[i] := CHR(r - 10 + ORD('A')); + END; + INC(i); + UNTIL num = 0; + IF neg THEN + tmp[i] := '-'; + INC(i) + END; + IF len > HIGH(str) + 1 THEN len := HIGH(str) + 1; END; + IF i > HIGH(str) + 1 THEN i := HIGH(str) + 1; END; + r := 0; + WHILE len > i DO str[r] := ' '; INC(r); DEC(len); END; + WHILE i > 0 DO str[r] := tmp[i-1]; DEC(i); INC(r); END; + WHILE r <= HIGH(str) DO + str[r] := 0C; + INC(r); + END; + END ConvertNum; + + PROCEDURE ConvertOctal(num, len: CARDINAL; VAR str: ARRAY OF CHAR); + BEGIN + ConvertNum(num, len, 8, FALSE, str); + END ConvertOctal; + + PROCEDURE ConvertHex(num, len: CARDINAL; VAR str: ARRAY OF CHAR); + BEGIN + ConvertNum(num, len, 16, FALSE, str); + END ConvertHex; + + PROCEDURE ConvertCardinal(num, len: CARDINAL; VAR str: ARRAY OF CHAR); + BEGIN + ConvertNum(num, len, 10, FALSE, str); + END ConvertCardinal; + + PROCEDURE ConvertInteger(num: INTEGER; + len: CARDINAL; + VAR str: ARRAY OF CHAR); + BEGIN + IF (num < 0) AND (num >= -MAX(INTEGER)) THEN + ConvertNum(-num, len, 10, TRUE, str); + ELSE + ConvertNum(CARDINAL(num), len, 10, num < 0, str); + END; + END ConvertInteger; + +END Conversions. diff --git a/lib/ack/libm2/EM.e b/lib/ack/libm2/EM.e new file mode 100755 index 000000000..ae6f42e62 --- /dev/null +++ b/lib/ack/libm2/EM.e @@ -0,0 +1,100 @@ +# +; +; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. +; See the copyright notice in the ACK home directory, in the file "Copyright". +; +; +; Module: Interface to some EM instructions and data +; Author: Ceriel J.H. Jacobs +; Version: $Header$ +; + mes 2,_EM_WSIZE,_EM_PSIZE + +#define ARG1 0 +#define ARG2 _EM_DSIZE +#define IRES 2*_EM_DSIZE + +; FIF is called with three parameters: +; - address of integer part result (IRES) +; - float two (ARG2) +; - float one (ARG1) +; and returns an _EM_DSIZE-byte floating point number +; Definition: +; PROCEDURE FIF(ARG1, ARG2: LONGREAL; VAR IRES: LONGREAL) : LONGREAL; + + exp $FIF + pro $FIF,0 + lal 0 + loi 2*_EM_DSIZE + fif _EM_DSIZE + lal IRES + loi _EM_PSIZE + sti _EM_DSIZE + ret _EM_DSIZE + end ? + +#define FARG 0 +#define ERES _EM_DSIZE + +; FEF is called with two parameters: +; - address of base 2 exponent result (ERES) +; - floating point number to be split (FARG) +; and returns an _EM_DSIZE-byte floating point number (the mantissa) +; Definition: +; PROCEDURE FEF(FARG: LONGREAL; VAR ERES: integer): LONGREAL; + + exp $FEF + pro $FEF,0 + lal FARG + loi _EM_DSIZE + fef _EM_DSIZE + lal ERES + loi _EM_PSIZE + sti _EM_WSIZE + ret _EM_DSIZE + end ? + +#define TRAP 0 + +; TRP is called with one parameter: +; - trap number (TRAP) +; Definition: +; PROCEDURE TRP(trapno: INTEGER); + + exp $TRP + pro $TRP, 0 + lol TRAP + trp + ret 0 + end ? + +#define PROC 0 + +; SIG is called with one parameter: +; - procedure instance identifier (PROC) +; and returns the old traphandler. + + exa handler + exp $SIG + pro $SIG, 0 + lae handler + loi _EM_PSIZE + lal PROC + loi _EM_PSIZE + lae handler + sti _EM_PSIZE + ret _EM_PSIZE + end ? + + exp $LINO + pro $LINO,0 + loe 0 + ret _EM_WSIZE + end ? + + exp $FILN + pro $FILN,0 + lae 4 + loi _EM_PSIZE + ret _EM_PSIZE + end ? diff --git a/lib/ack/libm2/InOut.mod b/lib/ack/libm2/InOut.mod new file mode 100755 index 000000000..74e56af52 --- /dev/null +++ b/lib/ack/libm2/InOut.mod @@ -0,0 +1,371 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE InOut ; +(* + Module: Wirth's Input/Output module + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + IMPORT Streams; + FROM Conversions IMPORT + ConvertCardinal, ConvertInteger, + ConvertOctal, ConvertHex; + FROM Traps IMPORT Message; + + CONST TAB = 11C; + + TYPE numbuf = ARRAY[0..255] OF CHAR; + + VAR unread: BOOLEAN; + unreadch: CHAR; + CurrIn, CurrOut: Streams.Stream; + result: Streams.StreamResult; + + PROCEDURE Read(VAR c : CHAR); + + BEGIN + IF unread THEN + unread := FALSE; + c := unreadch; + Done := TRUE; + ELSE + Streams.Read(CurrIn, c, result); + Done := result = Streams.succeeded; + END; + END Read; + + PROCEDURE UnRead(ch: CHAR); + BEGIN + unread := TRUE; + unreadch := ch; + END UnRead; + + PROCEDURE Write(c: CHAR); + BEGIN + Streams.Write(CurrOut, c, result); + END Write; + + PROCEDURE OpenInput(defext: ARRAY OF CHAR); + VAR namebuf : ARRAY [1..128] OF CHAR; + BEGIN + IF CurrIn # Streams.InputStream THEN + Streams.CloseStream(CurrIn, result); + END; + MakeFileName("Name of input file: ", defext, namebuf); + IF NOT Done THEN RETURN; END; + openinput(namebuf); + END OpenInput; + + PROCEDURE OpenInputFile(filename: ARRAY OF CHAR); + BEGIN + IF CurrIn # Streams.InputStream THEN + Streams.CloseStream(CurrIn, result); + END; + openinput(filename); + END OpenInputFile; + + PROCEDURE openinput(namebuf: ARRAY OF CHAR); + BEGIN + IF (namebuf[0] = '-') AND (namebuf[1] = 0C) THEN + CurrIn := Streams.InputStream; + Done := TRUE; + ELSE + Streams.OpenStream(CurrIn, namebuf, Streams.text, + Streams.reading, result); + Done := result = Streams.succeeded; + END; + END openinput; + + PROCEDURE CloseInput; + BEGIN + IF CurrIn # Streams.InputStream THEN + Streams.CloseStream(CurrIn, result); + END; + CurrIn := Streams.InputStream; + END CloseInput; + + PROCEDURE OpenOutput(defext: ARRAY OF CHAR); + VAR namebuf : ARRAY [1..128] OF CHAR; + BEGIN + IF CurrOut # Streams.OutputStream THEN + Streams.CloseStream(CurrOut, result); + END; + MakeFileName("Name of output file: ", defext, namebuf); + IF NOT Done THEN RETURN; END; + openoutput(namebuf); + END OpenOutput; + + PROCEDURE OpenOutputFile(filename: ARRAY OF CHAR); + BEGIN + IF CurrOut # Streams.OutputStream THEN + Streams.CloseStream(CurrOut, result); + END; + openoutput(filename); + END OpenOutputFile; + + PROCEDURE openoutput(namebuf: ARRAY OF CHAR); + BEGIN + IF (namebuf[1] = '-') AND (namebuf[2] = 0C) THEN + CurrOut := Streams.OutputStream; + Done := TRUE; + ELSE + Streams.OpenStream(CurrOut, namebuf, Streams.text, + Streams.writing, result); + Done := result = Streams.succeeded; + END; + END openoutput; + + PROCEDURE CloseOutput; + BEGIN + IF CurrOut # Streams.OutputStream THEN + Streams.CloseStream(CurrOut, result); + END; + CurrOut := Streams.OutputStream; + END CloseOutput; + + PROCEDURE MakeFileName(prompt, defext : ARRAY OF CHAR; + VAR buf : ARRAY OF CHAR); + VAR i : INTEGER; + j : CARDINAL; + BEGIN + Done := TRUE; + IF Streams.isatty(Streams.InputStream, result) THEN + XWriteString(prompt); + END; + XReadString(buf); + i := 0; + WHILE buf[i] # 0C DO i := i + 1 END; + IF i # 0 THEN + i := i - 1; + IF buf[i] = '.' THEN + FOR j := 0 TO HIGH(defext) DO + i := i + 1; + buf[i] := defext[j]; + END; + buf[i+1] := 0C; + END; + RETURN; + END; + Done := FALSE; + END MakeFileName; + + PROCEDURE ReadInt(VAR integ : INTEGER); + CONST + SAFELIMITDIV10 = MAX(INTEGER) DIV 10; + SAFELIMITREM10 = MAX(INTEGER) MOD 10; + TYPE + itype = [0..31]; + ibuf = ARRAY itype OF CHAR; + VAR + int : INTEGER; + neg : BOOLEAN; + safedigit: [0 .. 9]; + chvalue: CARDINAL; + buf : ibuf; + index : itype; + BEGIN + ReadString(buf); + IF NOT Done THEN + RETURN + END; + index := 0; + IF buf[index] = '-' THEN + neg := TRUE; + INC(index); + ELSIF buf[index] = '+' THEN + neg := FALSE; + INC(index); + ELSE + neg := FALSE + END; + + safedigit := SAFELIMITREM10; + IF neg THEN safedigit := safedigit + 1 END; + int := 0; + WHILE (buf[index] >= '0') & (buf[index] <= '9') DO + chvalue := ORD(buf[index]) - ORD('0'); + IF (int > SAFELIMITDIV10) OR + ( (int = SAFELIMITDIV10) AND + (chvalue > safedigit)) THEN + Message("integer too large"); + HALT; + ELSE + int := 10*int + VAL(INTEGER, chvalue); + INC(index) + END; + END; + IF neg THEN + integ := -int + ELSE + integ := int + END; + IF buf[index] > " " THEN + Message("illegal integer"); + HALT; + END; + Done := TRUE; + END ReadInt; + + PROCEDURE ReadCard(VAR card : CARDINAL); + CONST + SAFELIMITDIV10 = MAX(CARDINAL) DIV 10; + SAFELIMITREM10 = MAX(CARDINAL) MOD 10; + + TYPE + itype = [0..31]; + ibuf = ARRAY itype OF CHAR; + + VAR + int : CARDINAL; + index : itype; + buf : ibuf; + safedigit: [0 .. 9]; + chvalue: CARDINAL; + BEGIN + ReadString(buf); + IF NOT Done THEN RETURN; END; + index := 0; + safedigit := SAFELIMITREM10; + int := 0; + WHILE (buf[index] >= '0') & (buf[index] <= '9') DO + chvalue := ORD(buf[index]) - ORD('0'); + IF (int > SAFELIMITDIV10) OR + ( (int = SAFELIMITDIV10) AND + (chvalue > safedigit)) THEN + Message("cardinal too large"); + HALT; + ELSE + int := 10*int + chvalue; + INC(index); + END; + END; + IF buf[index] > " " THEN + Message("illegal cardinal"); + HALT; + END; + card := int; + Done := TRUE; + END ReadCard; + + PROCEDURE ReadString(VAR s : ARRAY OF CHAR); + TYPE charset = SET OF CHAR; + VAR i : CARDINAL; + ch : CHAR; + + BEGIN + i := 0; + REPEAT + Read(ch); + UNTIL NOT (ch IN charset{' ', TAB, 12C, 15C}); + IF NOT Done THEN + RETURN; + END; + UnRead(ch); + REPEAT + Read(ch); + termCH := ch; + IF i <= HIGH(s) THEN + s[i] := ch; + IF (NOT Done) OR (ch <= " ") THEN + s[i] := 0C; + END; + END; + INC(i); + UNTIL (NOT Done) OR (ch <= " "); + IF Done THEN UnRead(ch); END; + END ReadString; + + PROCEDURE XReadString(VAR s : ARRAY OF CHAR); + VAR j : CARDINAL; + ch : CHAR; + + BEGIN + j := 0; + LOOP + Streams.Read(Streams.InputStream, ch, result); + IF result # Streams.succeeded THEN + EXIT; + END; + IF ch <= " " THEN + s[j] := 0C; + EXIT; + END; + IF j < HIGH(s) THEN + s[j] := ch; + INC(j); + END; + END; + END XReadString; + + PROCEDURE XWriteString(s: ARRAY OF CHAR); + VAR i: CARDINAL; + BEGIN + i := 0; + LOOP + IF (i <= HIGH(s)) AND (s[i] # 0C) THEN + Streams.Write(Streams.OutputStream, s[i], result); + INC(i); + ELSE + EXIT; + END; + END; + END XWriteString; + + PROCEDURE WriteCard(card, width : CARDINAL); + VAR + buf : numbuf; + BEGIN + ConvertCardinal(card, width, buf); + WriteString(buf); + END WriteCard; + + PROCEDURE WriteInt(int : INTEGER; width : CARDINAL); + VAR + buf : numbuf; + BEGIN + ConvertInteger(int, width, buf); + WriteString(buf); + END WriteInt; + + PROCEDURE WriteHex(card, width : CARDINAL); + VAR + buf : numbuf; + BEGIN + ConvertHex(card, width, buf); + WriteString(buf); + END WriteHex; + + PROCEDURE WriteLn; + BEGIN + Write(EOL) + END WriteLn; + + PROCEDURE WriteOct(card, width : CARDINAL); + VAR + buf : numbuf; + BEGIN + ConvertOctal(card, width, buf); + WriteString(buf); + END WriteOct; + + PROCEDURE WriteString(str : ARRAY OF CHAR); + VAR + nbytes : CARDINAL; + BEGIN + nbytes := 0; + WHILE (nbytes <= HIGH(str)) AND (str[nbytes] # 0C) DO + Write(str[nbytes]); + INC(nbytes) + END; + END WriteString; + +BEGIN (* InOut initialization *) + CurrIn := Streams.InputStream; + CurrOut := Streams.OutputStream; + unread := FALSE; +END InOut. diff --git a/lib/ack/libm2/LtoUset.e b/lib/ack/libm2/LtoUset.e new file mode 100755 index 000000000..a724aff44 --- /dev/null +++ b/lib/ack/libm2/LtoUset.e @@ -0,0 +1,61 @@ +# +; +; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. +; See the copyright notice in the ACK home directory, in the file "Copyright". +; +; +; Module: Compute non-constant set displays +; Author: Ceriel J.H. Jacobs +; Version: $Header$ +; + mes 2,_EM_WSIZE,_EM_PSIZE + + ; LtoUset is called for set displays containing { expr1 .. expr2 }. + ; It has six parameters, of which the caller must pop five: + ; - The set in which bits must be set. + ; - the lower bound of the set type. + ; - The set size in bytes. + ; - The upper bound of set elements, specified by the set-type. + ; - "expr2", the upper bound + ; - "expr1", the lower bound + +#define SETBASE 5*_EM_WSIZE +#define SETLOW 4*_EM_WSIZE +#define SETSIZE 3*_EM_WSIZE +#define USETSIZ 2*_EM_WSIZE +#define LWB _EM_WSIZE +#define UPB 0 + exp $LtoUset + pro $LtoUset,0 + lal SETBASE ; address of initial set + lol SETSIZE + los _EM_WSIZE ; load initial set + lol LWB ; low bound + lol SETLOW + sbu _EM_WSIZE + stl LWB + lol UPB ; high bound + lol SETLOW + sbu _EM_WSIZE + stl UPB +1 + lol LWB + lol UPB + cmu _EM_WSIZE + zgt *2 ; while low <= high + lol LWB + lol SETSIZE + set ? ; create [low] + lol SETSIZE + ior ? ; merge with initial set + lol LWB + loc 1 + adu _EM_WSIZE + stl LWB + bra *1 ; loop back +2 + lal SETBASE + lol SETSIZE + sts _EM_WSIZE ; store result over initial set + ret 0 + end 0 diff --git a/lib/ack/libm2/Makefile b/lib/ack/libm2/Makefile new file mode 100644 index 000000000..a9ec9b7e3 --- /dev/null +++ b/lib/ack/libm2/Makefile @@ -0,0 +1,57 @@ +# Makefile for lib/ack/libm2. + +CFLAGS = -O -I../h -wo +M2FLAGS = -O -ws -n + +LIBRARIES = libm2 + +libm2_OBJECTS = \ + Arguments.o \ + ArraySort.o \ + CSP.o \ + Conversion.o \ + EM.o \ + InOut.o \ + LtoUset.o \ + MathLib0.o \ + Mathlib.o \ + PascalIO.o \ + Processes.o \ + RealConver.o \ + RealInOut.o \ + SYSTEM.o \ + Semaphores.o \ + Storage.o \ + StrAss.o \ + Streams.o \ + Strings.o \ + Termcap.o \ + Terminal.o \ + Traps.o \ + XXTermcap.o \ + absd.o \ + absf.o \ + absi.o \ + absl.o \ + blockmove.o \ + cap.o \ + catch.o \ + confarray.o \ + dvi.o \ + halt.o \ + head_m2.o \ + init.o \ + load.o \ + par_misc.o \ + random.o \ + rcka.o \ + rcki.o \ + rckil.o \ + rcku.o \ + rckul.o \ + sigtrp.o \ + stackprio.o \ + store.o \ + ucheck.o \ + +include ../../Makefile.ack.inc diff --git a/lib/ack/libm2/Makefile.ack.conv b/lib/ack/libm2/Makefile.ack.conv new file mode 100755 index 000000000..956ea09c0 --- /dev/null +++ b/lib/ack/libm2/Makefile.ack.conv @@ -0,0 +1,204 @@ +# Makefile for lib/ack/libm2. + +M2 = m2 +CFLAGS = -O -I$(SRCDIR)/ack/h -wo +CC1 = $(CC) $(CFLAGS) -c +M2FLAGS = -O -ws -n +M21 = $(M2) $(M2FLAGS) -c + +LIBRARY = ../../libm2.a +all: $(LIBRARY) + +OBJECTS = \ + $(LIBRARY)(Arguments.o) \ + $(LIBRARY)(ArraySort.o) \ + $(LIBRARY)(CSP.o) \ + $(LIBRARY)(Conversion.o) \ + $(LIBRARY)(EM.o) \ + $(LIBRARY)(InOut.o) \ + $(LIBRARY)(LtoUset.o) \ + $(LIBRARY)(MathLib0.o) \ + $(LIBRARY)(Mathlib.o) \ + $(LIBRARY)(PascalIO.o) \ + $(LIBRARY)(Processes.o) \ + $(LIBRARY)(RealConver.o) \ + $(LIBRARY)(RealInOut.o) \ + $(LIBRARY)(SYSTEM.o) \ + $(LIBRARY)(Semaphores.o) \ + $(LIBRARY)(Storage.o) \ + $(LIBRARY)(StrAss.o) \ + $(LIBRARY)(Streams.o) \ + $(LIBRARY)(Strings.o) \ + $(LIBRARY)(Termcap.o) \ + $(LIBRARY)(Terminal.o) \ + $(LIBRARY)(Traps.o) \ + $(LIBRARY)(XXTermcap.o) \ + $(LIBRARY)(absd.o) \ + $(LIBRARY)(absf.o) \ + $(LIBRARY)(absi.o) \ + $(LIBRARY)(absl.o) \ + $(LIBRARY)(blockmove.o) \ + $(LIBRARY)(cap.o) \ + $(LIBRARY)(catch.o) \ + $(LIBRARY)(confarray.o) \ + $(LIBRARY)(dvi.o) \ + $(LIBRARY)(halt.o) \ + $(LIBRARY)(head_m2.o) \ + $(LIBRARY)(init.o) \ + $(LIBRARY)(load.o) \ + $(LIBRARY)(par_misc.o) \ + $(LIBRARY)(random.o) \ + $(LIBRARY)(rcka.o) \ + $(LIBRARY)(rcki.o) \ + $(LIBRARY)(rckil.o) \ + $(LIBRARY)(rcku.o) \ + $(LIBRARY)(rckul.o) \ + $(LIBRARY)(sigtrp.o) \ + $(LIBRARY)(stackprio.o) \ + $(LIBRARY)(store.o) \ + $(LIBRARY)(ucheck.o) \ + +$(LIBRARY): $(OBJECTS) + aal cr $@ *.o + rm *.o + +$(LIBRARY)(Arguments.o): Arguments.c + $(CC1) Arguments.c + +$(LIBRARY)(ArraySort.o): ArraySort.mod + $(M21) ArraySort.mod + +$(LIBRARY)(CSP.o): CSP.mod + $(M21) CSP.mod + +$(LIBRARY)(Conversion.o): Conversion.mod + $(M21) Conversion.mod + +$(LIBRARY)(EM.o): EM.e + $(CC1) EM.e + +$(LIBRARY)(InOut.o): InOut.mod + $(M21) InOut.mod + +$(LIBRARY)(LtoUset.o): LtoUset.e + $(CC1) LtoUset.e + +$(LIBRARY)(MathLib0.o): MathLib0.mod + $(M21) MathLib0.mod + +$(LIBRARY)(Mathlib.o): Mathlib.mod + $(M21) Mathlib.mod + +$(LIBRARY)(PascalIO.o): PascalIO.mod + $(M21) PascalIO.mod + +$(LIBRARY)(Processes.o): Processes.mod + $(M21) Processes.mod + +$(LIBRARY)(RealConver.o): RealConver.mod + $(M21) RealConver.mod + +$(LIBRARY)(RealInOut.o): RealInOut.mod + $(M21) RealInOut.mod + +$(LIBRARY)(SYSTEM.o): SYSTEM.c + $(CC1) SYSTEM.c + +$(LIBRARY)(Semaphores.o): Semaphores.mod + $(M21) Semaphores.mod + +$(LIBRARY)(Storage.o): Storage.mod + $(M21) Storage.mod + +$(LIBRARY)(StrAss.o): StrAss.c + $(CC1) StrAss.c + +$(LIBRARY)(Streams.o): Streams.mod + $(M21) Streams.mod + +$(LIBRARY)(Strings.o): Strings.mod + $(M21) Strings.mod + +$(LIBRARY)(Termcap.o): Termcap.mod + $(M21) Termcap.mod + +$(LIBRARY)(Terminal.o): Terminal.mod + $(M21) -D__USG Terminal.mod + +$(LIBRARY)(Traps.o): Traps.mod + $(M21) Traps.mod + +$(LIBRARY)(XXTermcap.o): XXTermcap.c + $(CC1) XXTermcap.c + +$(LIBRARY)(absd.o): absd.c + $(CC1) absd.c + +$(LIBRARY)(absf.o): absf.e + $(CC1) absf.e + +$(LIBRARY)(absi.o): absi.c + $(CC1) absi.c + +$(LIBRARY)(absl.o): absl.c + $(CC1) absl.c + +$(LIBRARY)(blockmove.o): blockmove.c + $(CC1) blockmove.c + +$(LIBRARY)(cap.o): cap.c + $(CC1) cap.c + +$(LIBRARY)(catch.o): catch.c + $(CC1) catch.c + +$(LIBRARY)(confarray.o): confarray.c + $(CC1) confarray.c + +$(LIBRARY)(dvi.o): dvi.c + $(CC1) dvi.c + +$(LIBRARY)(halt.o): halt.c + $(CC1) halt.c + +$(LIBRARY)(head_m2.o): head_m2.e + $(CC1) head_m2.e + +$(LIBRARY)(init.o): init.c + $(CC1) init.c + +$(LIBRARY)(load.o): load.c + $(CC1) load.c + +$(LIBRARY)(par_misc.o): par_misc.e + $(CC1) par_misc.e + +$(LIBRARY)(random.o): random.mod + $(M21) random.mod + +$(LIBRARY)(rcka.o): rcka.c + $(CC1) rcka.c + +$(LIBRARY)(rcki.o): rcki.c + $(CC1) rcki.c + +$(LIBRARY)(rckil.o): rckil.c + $(CC1) rckil.c + +$(LIBRARY)(rcku.o): rcku.c + $(CC1) rcku.c + +$(LIBRARY)(rckul.o): rckul.c + $(CC1) rckul.c + +$(LIBRARY)(sigtrp.o): sigtrp.c + $(CC1) sigtrp.c + +$(LIBRARY)(stackprio.o): stackprio.c + $(CC1) stackprio.c + +$(LIBRARY)(store.o): store.c + $(CC1) store.c + +$(LIBRARY)(ucheck.o): ucheck.c + $(CC1) ucheck.c diff --git a/lib/ack/libm2/MathLib0.mod b/lib/ack/libm2/MathLib0.mod new file mode 100755 index 000000000..ba40da625 --- /dev/null +++ b/lib/ack/libm2/MathLib0.mod @@ -0,0 +1,69 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE MathLib0; +(* + Module: Some mathematical functions + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + IMPORT Mathlib; + + PROCEDURE cos(arg: REAL): REAL; + BEGIN + RETURN Mathlib.cos(arg); + END cos; + + PROCEDURE sin(arg: REAL): REAL; + BEGIN + RETURN Mathlib.sin(arg); + END sin; + + PROCEDURE arctan(arg: REAL): REAL; + BEGIN + RETURN Mathlib.arctan(arg); + END arctan; + + PROCEDURE sqrt(arg: REAL): REAL; + BEGIN + RETURN Mathlib.sqrt(arg); + END sqrt; + + PROCEDURE ln(arg: REAL): REAL; + BEGIN + RETURN Mathlib.ln(arg); + END ln; + + PROCEDURE exp(arg: REAL): REAL; + BEGIN + RETURN Mathlib.exp(arg); + END exp; + + PROCEDURE entier(x: REAL): INTEGER; + VAR i: INTEGER; + BEGIN + IF x < 0.0 THEN + i := TRUNC(-x); + IF FLOAT(i) = -x THEN + RETURN -i; + ELSE + RETURN -i -1; + END; + END; + RETURN TRUNC(x); + END entier; + + PROCEDURE real(x: INTEGER): REAL; + BEGIN + IF x < 0 THEN + RETURN - FLOAT(-x); + END; + RETURN FLOAT(x); + END real; + +BEGIN +END MathLib0. diff --git a/lib/ack/libm2/Mathlib.mod b/lib/ack/libm2/Mathlib.mod new file mode 100755 index 000000000..31899e8d3 --- /dev/null +++ b/lib/ack/libm2/Mathlib.mod @@ -0,0 +1,576 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Mathlib; +(* + Module: Mathematical functions + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + FROM EM IMPORT FIF, FEF; + FROM Traps IMPORT Message; + + CONST + OneRadianInDegrees = 57.295779513082320876798155D; + OneDegreeInRadians = 0.017453292519943295769237D; + OneOverSqrt2 = 0.70710678118654752440084436210484904D; + + (* basic functions *) + + PROCEDURE pow(x: REAL; i: INTEGER): REAL; + BEGIN + RETURN SHORT(longpow(LONG(x), i)); + END pow; + + PROCEDURE longpow(x: LONGREAL; i: INTEGER): LONGREAL; + VAR val: LONGREAL; + ri: LONGREAL; + BEGIN + ri := FLOATD(i); + IF x < 0.0D THEN + val := longexp(longln(-x) * ri); + IF ODD(i) THEN RETURN -val; + ELSE RETURN val; + END; + ELSIF x = 0.0D THEN + RETURN 0.0D; + ELSE + RETURN longexp(longln(x) * ri); + END; + END longpow; + + PROCEDURE sqrt(x: REAL): REAL; + BEGIN + RETURN SHORT(longsqrt(LONG(x))); + END sqrt; + + PROCEDURE longsqrt(x: LONGREAL): LONGREAL; + VAR + temp: LONGREAL; + exp, i: INTEGER; + BEGIN + IF x <= 0.0D THEN + IF x < 0.0D THEN + Message("sqrt: negative argument"); + HALT + END; + RETURN 0.0D; + END; + temp := FEF(x,exp); + (* + * NOTE + * this wont work on 1's comp + *) + IF ODD(exp) THEN + temp := 2.0D * temp; + DEC(exp); + END; + temp := 0.5D*(1.0D + temp); + + WHILE exp > 28 DO + temp := temp * 16384.0D; + exp := exp - 28; + END; + WHILE exp < -28 DO + temp := temp / 16384.0D; + exp := exp + 28; + END; + WHILE exp >= 2 DO + temp := temp * 2.0D; + exp := exp - 2; + END; + WHILE exp <= -2 DO + temp := temp / 2.0D; + exp := exp + 2; + END; + FOR i := 0 TO 5 DO + temp := 0.5D*(temp + x/temp); + END; + RETURN temp; + END longsqrt; + + PROCEDURE ldexp(x:LONGREAL; n: INTEGER): LONGREAL; + BEGIN + WHILE n >= 16 DO + x := x * 65536.0D; + n := n - 16; + END; + WHILE n > 0 DO + x := x * 2.0D; + DEC(n); + END; + WHILE n <= -16 DO + x := x / 65536.0D; + n := n + 16; + END; + WHILE n < 0 DO + x := x / 2.0D; + INC(n); + END; + RETURN x; + END ldexp; + + PROCEDURE exp(x: REAL): REAL; + BEGIN + RETURN SHORT(longexp(LONG(x))); + END exp; + + PROCEDURE longexp(x: LONGREAL): LONGREAL; + (* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + *) + CONST + p0 = 0.25000000000000000000D+00; + p1 = 0.75753180159422776666D-02; + p2 = 0.31555192765684646356D-04; + q0 = 0.50000000000000000000D+00; + q1 = 0.56817302698551221787D-01; + q2 = 0.63121894374398503557D-03; + q3 = 0.75104028399870046114D-06; + + VAR + neg: BOOLEAN; + n: INTEGER; + xn, g, x1, x2: LONGREAL; + BEGIN + neg := x < 0.0D; + IF neg THEN + x := -x; + END; + n := TRUNC(x/longln2 + 0.5D); + xn := FLOATD(n); + x1 := FLOATD(TRUNCD(x)); + x2 := x - x1; + g := ((x1 - xn * 0.693359375D)+x2) - xn * (-2.1219444005469058277D-4); + IF neg THEN + g := -g; + n := -n; + END; + xn := g*g; + x := g*((p2*xn+p1)*xn+p0); + INC(n); + RETURN ldexp(0.5D + x/((((q3*xn+q2)*xn+q1)*xn+q0) - x), n); + END longexp; + + PROCEDURE ln(x: REAL): REAL; (* natural log *) + BEGIN + RETURN SHORT(longln(LONG(x))); + END ln; + + PROCEDURE longln(x: LONGREAL): LONGREAL; (* natural log *) + (* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + *) + CONST + p0 = -0.64124943423745581147D+02; + p1 = 0.16383943563021534222D+02; + p2 = -0.78956112887491257267D+00; + q0 = -0.76949932108494879777D+03; + q1 = 0.31203222091924532844D+03; + q2 = -0.35667977739034646171D+02; + q3 = 1.0D; + VAR + exp: INTEGER; + z, znum, zden, w: LONGREAL; + + BEGIN + IF x <= 0.0D THEN + Message("ln: argument <= 0"); + HALT + END; + x := FEF(x, exp); + IF x > OneOverSqrt2 THEN + znum := (x - 0.5D) - 0.5D; + zden := x * 0.5D + 0.5D; + ELSE + znum := x - 0.5D; + zden := znum * 0.5D + 0.5D; + DEC(exp); + END; + z := znum / zden; + w := z * z; + x := z + z * w * (((p2*w+p1)*w+p0)/(((q3*w+q2)*w+q1)*w+q0)); + z := FLOATD(exp); + x := x + z * (-2.121944400546905827679D-4); + RETURN x + z * 0.693359375D; + END longln; + + PROCEDURE log(x: REAL): REAL; (* log with base 10 *) + BEGIN + RETURN SHORT(longlog(LONG(x))); + END log; + + PROCEDURE longlog(x: LONGREAL): LONGREAL; (* log with base 10 *) + BEGIN + RETURN longln(x)/longln10; + END longlog; + + (* trigonometric functions; arguments in radians *) + + PROCEDURE sin(x: REAL): REAL; + BEGIN + RETURN SHORT(longsin(LONG(x))); + END sin; + + PROCEDURE sinus(x: LONGREAL; cosflag: BOOLEAN) : LONGREAL; + (* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + *) + CONST + r0 = -0.16666666666666665052D+00; + r1 = 0.83333333333331650314D-02; + r2 = -0.19841269841201840457D-03; + r3 = 0.27557319210152756119D-05; + r4 = -0.25052106798274584544D-07; + r5 = 0.16058936490371589114D-09; + r6 = -0.76429178068910467734D-12; + r7 = 0.27204790957888846175D-14; + A1 = 3.1416015625D; + A2 = -8.908910206761537356617D-6; + VAR + x1, x2, y : LONGREAL; + neg : BOOLEAN; + BEGIN + IF x < 0.0D THEN + neg := TRUE; + x := -x + ELSE neg := FALSE + END; + IF cosflag THEN + neg := FALSE; + y := longhalfpi + x + ELSE + y := x + END; + y := y / longpi + 0.5D; + + IF FIF(y, 1.0D, y) < 0.0D THEN ; END; + IF FIF(y, 0.5D, x1) # 0.0D THEN neg := NOT neg END; + IF cosflag THEN y := y - 0.5D END; + x2 := FIF(x, 1.0, x1); + x := x1 - y * A1; + x := x + x2; + x := x - y * A2; + + IF x < 0.0D THEN + neg := NOT neg; + x := -x + END; + y := x * x; + x := x + x * y * (((((((r7*y+r6)*y+r5)*y+r4)*y+r3)*y+r2)*y+r1)*y+r0); + IF neg THEN RETURN -x END; + RETURN x; + END sinus; + + PROCEDURE longsin(x: LONGREAL): LONGREAL; + BEGIN + RETURN sinus(x, FALSE); + END longsin; + + PROCEDURE cos(x: REAL): REAL; + BEGIN + RETURN SHORT(longcos(LONG(x))); + END cos; + + PROCEDURE longcos(x: LONGREAL): LONGREAL; + BEGIN + IF x < 0.0D THEN x := -x; END; + RETURN sinus(x, TRUE); + END longcos; + + PROCEDURE tan(x: REAL): REAL; + BEGIN + RETURN SHORT(longtan(LONG(x))); + END tan; + + PROCEDURE longtan(x: LONGREAL): LONGREAL; + (* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + *) + + CONST + p1 = -0.13338350006421960681D+00; + p2 = 0.34248878235890589960D-02; + p3 = -0.17861707342254426711D-04; + + q0 = 1.0D; + q1 = -0.46671683339755294240D+00; + q2 = 0.25663832289440112864D-01; + q3 = -0.31181531907010027307D-03; + q4 = 0.49819433993786512270D-06; + + A1 = 1.57080078125D; + A2 = -4.454455103380768678308D-06; + + VAR y, x1, x2: LONGREAL; + negative: BOOLEAN; + invert: BOOLEAN; + BEGIN + negative := x < 0.0D; + y := x / longhalfpi + 0.5D; + + (* Use extended precision to calculate reduced argument. + Here we used 12 bits of the mantissa for a1. + Also split x in integer part x1 and fraction part x2. + *) + IF FIF(y, 1.0D, y) < 0.0D THEN ; END; + invert := FIF(y, 0.5D, x1) # 0.0D; + x2 := FIF(x, 1.0D, x1); + x := x1 - y * A1; + x := x + x2; + x := x - y * A2; + + y := x * x; + x := x + x * y * ((p3*y+p2)*y+p1); + y := (((q4*y+q3)*y+q2)*y+q1)*y+q0; + IF negative THEN x := -x END; + IF invert THEN RETURN -y/x END; + RETURN x/y; + END longtan; + + PROCEDURE arcsin(x: REAL): REAL; + BEGIN + RETURN SHORT(longarcsin(LONG(x))); + END arcsin; + + PROCEDURE arcsincos(x: LONGREAL; cosfl: BOOLEAN): LONGREAL; + CONST + p0 = -0.27368494524164255994D+02; + p1 = 0.57208227877891731407D+02; + p2 = -0.39688862997540877339D+02; + p3 = 0.10152522233806463645D+02; + p4 = -0.69674573447350646411D+00; + + q0 = -0.16421096714498560795D+03; + q1 = 0.41714430248260412556D+03; + q2 = -0.38186303361750149284D+03; + q3 = 0.15095270841030604719D+03; + q4 = -0.23823859153670238830D+02; + q5 = 1.0D; + VAR + negative : BOOLEAN; + big: BOOLEAN; + g: LONGREAL; + BEGIN + negative := x < 0.0D; + IF negative THEN x := -x; END; + IF x > 0.5D THEN + big := TRUE; + IF x > 1.0D THEN + Message("arcsin or arccos: argument > 1"); + HALT + END; + g := 0.5D - 0.5D * x; + x := -longsqrt(g); + x := x + x; + ELSE + big := FALSE; + g := x * x; + END; + x := x + x * g * + ((((p4*g+p3)*g+p2)*g+p1)*g+p0)/(((((q5*g+q4)*g+q3)*g+q2)*g+q1)*g+q0); + IF cosfl AND NOT negative THEN x := -x END; + IF cosfl = NOT big THEN + x := (x + longquartpi) + longquartpi; + ELSIF cosfl AND negative AND big THEN + x := (x + longhalfpi) + longhalfpi; + END; + IF negative AND NOT cosfl THEN x := -x END; + RETURN x; + END arcsincos; + + PROCEDURE longarcsin(x: LONGREAL): LONGREAL; + BEGIN + RETURN arcsincos(x, FALSE); + END longarcsin; + + PROCEDURE arccos(x: REAL): REAL; + BEGIN + RETURN SHORT(longarccos(LONG(x))); + END arccos; + + PROCEDURE longarccos(x: LONGREAL): LONGREAL; + BEGIN + RETURN arcsincos(x, TRUE); + END longarccos; + + PROCEDURE arctan(x: REAL): REAL; + BEGIN + RETURN SHORT(longarctan(LONG(x))); + END arctan; + + VAR A: ARRAY[0..3] OF LONGREAL; + arctaninit: BOOLEAN; + + PROCEDURE longarctan(x: LONGREAL): LONGREAL; + (* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + *) + CONST + p0 = -0.13688768894191926929D+02; + p1 = -0.20505855195861651981D+02; + p2 = -0.84946240351320683534D+01; + p3 = -0.83758299368150059274D+00; + q0 = 0.41066306682575781263D+02; + q1 = 0.86157349597130242515D+02; + q2 = 0.59578436142597344465D+02; + q3 = 0.15024001160028576121D+02; + q4 = 1.0D; + VAR + g: LONGREAL; + neg: BOOLEAN; + n: INTEGER; + BEGIN + IF NOT arctaninit THEN + arctaninit := TRUE; + A[0] := 0.0D; + A[1] := 0.52359877559829887307710723554658381D; (* p1/6 *) + A[2] := longhalfpi; + A[3] := 1.04719755119659774615421446109316763D; (* pi/3 *) + END; + neg := FALSE; + IF x < 0.0D THEN + neg := TRUE; + x := -x; + END; + IF x > 1.0D THEN + x := 1.0D/x; + n := 2 + ELSE + n := 0 + END; + IF x > 0.26794919243112270647D (* 2-sqrt(3) *) THEN + INC(n); + x := (((0.73205080756887729353D*x-0.5D)-0.5D)+x)/ + (1.73205080756887729353D + x); + END; + g := x*x; + x := x + x * g * (((p3*g+p2)*g+p1)*g+p0) / ((((q4*g+q3)*g+q2)*g+q1)*g+q0); + IF n > 1 THEN x := -x END; + x := x + A[n]; + IF neg THEN RETURN -x; END; + RETURN x; + END longarctan; + + (* hyperbolic functions *) + (* The C math library has better implementations for some of these, but + they depend on some properties of the floating point implementation, + and, for now, we don't want that in the Modula-2 system. + *) + + PROCEDURE sinh(x: REAL): REAL; + BEGIN + RETURN SHORT(longsinh(LONG(x))); + END sinh; + + PROCEDURE longsinh(x: LONGREAL): LONGREAL; + VAR expx: LONGREAL; + BEGIN + expx := longexp(x); + RETURN (expx - 1.0D/expx)/2.0D; + END longsinh; + + PROCEDURE cosh(x: REAL): REAL; + BEGIN + RETURN SHORT(longcosh(LONG(x))); + END cosh; + + PROCEDURE longcosh(x: LONGREAL): LONGREAL; + VAR expx: LONGREAL; + BEGIN + expx := longexp(x); + RETURN (expx + 1.0D/expx)/2.0D; + END longcosh; + + PROCEDURE tanh(x: REAL): REAL; + BEGIN + RETURN SHORT(longtanh(LONG(x))); + END tanh; + + PROCEDURE longtanh(x: LONGREAL): LONGREAL; + VAR expx: LONGREAL; + BEGIN + expx := longexp(x); + RETURN (expx - 1.0D/expx) / (expx + 1.0D/expx); + END longtanh; + + PROCEDURE arcsinh(x: REAL): REAL; + BEGIN + RETURN SHORT(longarcsinh(LONG(x))); + END arcsinh; + + PROCEDURE longarcsinh(x: LONGREAL): LONGREAL; + VAR neg: BOOLEAN; + BEGIN + neg := FALSE; + IF x < 0.0D THEN + neg := TRUE; + x := -x; + END; + x := longln(x + longsqrt(x*x+1.0D)); + IF neg THEN RETURN -x; END; + RETURN x; + END longarcsinh; + + PROCEDURE arccosh(x: REAL): REAL; + BEGIN + RETURN SHORT(longarccosh(LONG(x))); + END arccosh; + + PROCEDURE longarccosh(x: LONGREAL): LONGREAL; + BEGIN + IF x < 1.0D THEN + Message("arccosh: argument < 1"); + HALT + END; + RETURN longln(x + longsqrt(x*x - 1.0D)); + END longarccosh; + + PROCEDURE arctanh(x: REAL): REAL; + BEGIN + RETURN SHORT(longarctanh(LONG(x))); + END arctanh; + + PROCEDURE longarctanh(x: LONGREAL): LONGREAL; + BEGIN + IF (x <= -1.0D) OR (x >= 1.0D) THEN + Message("arctanh: ABS(argument) >= 1"); + HALT + END; + RETURN longln((1.0D + x)/(1.0D - x)) / 2.0D; + END longarctanh; + + (* conversions *) + + PROCEDURE RadianToDegree(x: REAL): REAL; + BEGIN + RETURN SHORT(longRadianToDegree(LONG(x))); + END RadianToDegree; + + PROCEDURE longRadianToDegree(x: LONGREAL): LONGREAL; + BEGIN + RETURN x * OneRadianInDegrees; + END longRadianToDegree; + + PROCEDURE DegreeToRadian(x: REAL): REAL; + BEGIN + RETURN SHORT(longDegreeToRadian(LONG(x))); + END DegreeToRadian; + + PROCEDURE longDegreeToRadian(x: LONGREAL): LONGREAL; + BEGIN + RETURN x * OneDegreeInRadians; + END longDegreeToRadian; + +BEGIN + arctaninit := FALSE; +END Mathlib. diff --git a/lib/ack/libm2/PascalIO.mod b/lib/ack/libm2/PascalIO.mod new file mode 100755 index 000000000..b29049bd3 --- /dev/null +++ b/lib/ack/libm2/PascalIO.mod @@ -0,0 +1,437 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE PascalIO; +(* + Module: Pascal-like Input/Output + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + FROM Conversions IMPORT + ConvertInteger, ConvertCardinal; + FROM RealConversions IMPORT + LongRealToString, StringToLongReal; + FROM Traps IMPORT Message; + FROM Streams IMPORT Stream, StreamKind, StreamMode, StreamResult, + InputStream, OutputStream, OpenStream, CloseStream, + EndOfStream, Read, Write, StreamBuffering; + FROM Storage IMPORT Allocate; + FROM SYSTEM IMPORT ADR; + + TYPE charset = SET OF CHAR; + btype = (Preading, Pwriting, free); + + CONST spaces = charset{11C, 12C, 13C, 14C, 15C, ' '}; + + TYPE IOstream = RECORD + type: btype; + done, eof : BOOLEAN; + ch: CHAR; + next: Text; + stream: Stream; + END; + Text = POINTER TO IOstream; + numbuf = ARRAY[0..255] OF CHAR; + + VAR ibuf, obuf: IOstream; + head: Text; + result: StreamResult; + + PROCEDURE Reset(VAR InputText: Text; Filename: ARRAY OF CHAR); + BEGIN + doclose(InputText); + getstruct(InputText); + WITH InputText^ DO + OpenStream(stream, Filename, text, reading, result); + IF result # succeeded THEN + Message("could not open input file"); + HALT; + END; + type := Preading; + done := FALSE; + eof := FALSE; + END; + END Reset; + + PROCEDURE Rewrite(VAR OutputText: Text; Filename: ARRAY OF CHAR); + BEGIN + doclose(OutputText); + getstruct(OutputText); + WITH OutputText^ DO + OpenStream(stream, Filename, text, writing, result); + IF result # succeeded THEN + Message("could not open output file"); + HALT; + END; + type := Pwriting; + END; + END Rewrite; + + PROCEDURE CloseOutput(); + VAR p: Text; + BEGIN + p := head; + WHILE p # NIL DO + doclose(p); + p := p^.next; + END; + END CloseOutput; + + PROCEDURE doclose(Xtext: Text); + BEGIN + IF Xtext # Notext THEN + WITH Xtext^ DO + IF type # free THEN + CloseStream(stream, result); + type := free; + END; + END; + END; + END doclose; + + PROCEDURE getstruct(VAR Xtext: Text); + BEGIN + Xtext := head; + WHILE (Xtext # NIL) AND (Xtext^.type # free) DO + Xtext := Xtext^.next; + END; + IF Xtext = NIL THEN + Allocate(Xtext,SIZE(IOstream)); + Xtext^.next := head; + head := Xtext; + END; + END getstruct; + + PROCEDURE Error(tp: btype); + BEGIN + IF tp = Preading THEN + Message("input text expected"); + ELSE + Message("output text expected"); + END; + HALT; + END Error; + + PROCEDURE ReadChar(InputText: Text; VAR ch : CHAR); + BEGIN + ch := NextChar(InputText); + IF InputText^.eof THEN + Message("unexpected EOF"); + HALT; + END; + InputText^.done := FALSE; + END ReadChar; + + PROCEDURE NextChar(InputText: Text): CHAR; + BEGIN + WITH InputText^ DO + IF type # Preading THEN Error(Preading); END; + IF NOT done THEN + IF EndOfStream(stream, result) THEN + eof := TRUE; + ch := 0C; + ELSE + Read(stream, ch, result); + done := TRUE; + END; + END; + RETURN ch; + END; + END NextChar; + + PROCEDURE Get(InputText: Text); + VAR dummy: CHAR; + BEGIN + ReadChar(InputText, dummy); + END Get; + + PROCEDURE Eoln(InputText: Text): BOOLEAN; + BEGIN + RETURN NextChar(InputText) = 12C; + END Eoln; + + PROCEDURE Eof(InputText: Text): BOOLEAN; + BEGIN + RETURN (NextChar(InputText) = 0C) AND InputText^.eof; + END Eof; + + PROCEDURE ReadLn(InputText: Text); + VAR ch: CHAR; + BEGIN + REPEAT + ReadChar(InputText, ch) + UNTIL ch = 12C; + END ReadLn; + + PROCEDURE WriteChar(OutputText: Text; char: CHAR); + BEGIN + WITH OutputText^ DO + IF type # Pwriting THEN Error(Pwriting); END; + Write(stream, char, result); + END; + END WriteChar; + + PROCEDURE WriteLn(OutputText: Text); + BEGIN + WriteChar(OutputText, 12C); + END WriteLn; + + PROCEDURE Page(OutputText: Text); + BEGIN + WriteChar(OutputText, 14C); + END Page; + + PROCEDURE ReadInteger(InputText: Text; VAR int : INTEGER); + CONST + SAFELIMITDIV10 = MAX(INTEGER) DIV 10; + SAFELIMITREM10 = MAX(INTEGER) MOD 10; + VAR + neg : BOOLEAN; + safedigit: CARDINAL; + ch: CHAR; + chvalue: CARDINAL; + BEGIN + WHILE NextChar(InputText) IN spaces DO + Get(InputText); + END; + ch := NextChar(InputText); + IF ch = '-' THEN + Get(InputText); + ch := NextChar(InputText); + neg := TRUE; + ELSIF ch = '+' THEN + Get(InputText); + ch := NextChar(InputText); + neg := FALSE; + ELSE + neg := FALSE + END; + + safedigit := SAFELIMITREM10; + IF neg THEN safedigit := safedigit + 1 END; + int := 0; + IF (ch >= '0') AND (ch <= '9') THEN + WHILE (ch >= '0') & (ch <= '9') DO + chvalue := ORD(ch) - ORD('0'); + IF (int < -SAFELIMITDIV10) OR + ( (int = -SAFELIMITDIV10) AND + (chvalue > safedigit)) THEN + Message("integer too large"); + HALT; + ELSE + int := 10*int - VAL(INTEGER, chvalue); + Get(InputText); + ch := NextChar(InputText); + END; + END; + IF NOT neg THEN + int := -int + END; + ELSE + Message("integer expected"); + HALT; + END; + END ReadInteger; + + PROCEDURE ReadCardinal(InputText: Text; VAR card : CARDINAL); + CONST + SAFELIMITDIV10 = MAX(CARDINAL) DIV 10; + SAFELIMITREM10 = MAX(CARDINAL) MOD 10; + + VAR + ch : CHAR; + safedigit: CARDINAL; + chvalue: CARDINAL; + BEGIN + WHILE NextChar(InputText) IN spaces DO + Get(InputText); + END; + ch := NextChar(InputText); + safedigit := SAFELIMITREM10; + card := 0; + IF (ch >= '0') AND (ch <= '9') THEN + WHILE (ch >= '0') & (ch <= '9') DO + chvalue := ORD(ch) - ORD('0'); + IF (card > SAFELIMITDIV10) OR + ( (card = SAFELIMITDIV10) AND + (chvalue > safedigit)) THEN + Message("cardinal too large"); + HALT; + ELSE + card := 10*card + chvalue; + Get(InputText); + ch := NextChar(InputText); + END; + END; + ELSE + Message("cardinal expected"); + HALT; + END; + END ReadCardinal; + + PROCEDURE ReadReal(InputText: Text; VAR real: REAL); + VAR x1: LONGREAL; + BEGIN + ReadLongReal(InputText, x1); + real := x1 + END ReadReal; + + PROCEDURE ReadLongReal(InputText: Text; VAR real: LONGREAL); + VAR + buf: numbuf; + ch: CHAR; + ok: BOOLEAN; + index: INTEGER; + + PROCEDURE inch(): CHAR; + BEGIN + buf[index] := ch; + INC(index); + Get(InputText); + RETURN NextChar(InputText); + END inch; + + BEGIN + index := 0; + ok := TRUE; + WHILE NextChar(InputText) IN spaces DO + Get(InputText); + END; + ch := NextChar(InputText); + IF (ch ='+') OR (ch = '-') THEN + ch := inch(); + END; + IF (ch >= '0') AND (ch <= '9') THEN + WHILE (ch >= '0') AND (ch <= '9') DO + ch := inch(); + END; + IF (ch = '.') THEN + ch := inch(); + IF (ch >= '0') AND (ch <= '9') THEN + WHILE (ch >= '0') AND (ch <= '9') DO + ch := inch(); + END; + ELSE + ok := FALSE; + END; + END; + IF ok AND (ch = 'E') THEN + ch := inch(); + IF (ch ='+') OR (ch = '-') THEN + ch := inch(); + END; + IF (ch >= '0') AND (ch <= '9') THEN + WHILE (ch >= '0') AND (ch <= '9') DO + ch := inch(); + END; + ELSE + ok := FALSE; + END; + END; + ELSE + ok := FALSE; + END; + IF ok THEN + buf[index] := 0C; + StringToLongReal(buf, real, ok); + END; + IF NOT ok THEN + Message("Illegal real"); + HALT; + END; + END ReadLongReal; + + PROCEDURE WriteCardinal(OutputText: Text; card: CARDINAL; width: CARDINAL); + VAR + buf : numbuf; + BEGIN + ConvertCardinal(card, 1, buf); + WriteString(OutputText, buf, width); + END WriteCardinal; + + PROCEDURE WriteInteger(OutputText: Text; int: INTEGER; width: CARDINAL); + VAR + buf : numbuf; + BEGIN + ConvertInteger(int, 1, buf); + WriteString(OutputText, buf, width); + END WriteInteger; + + PROCEDURE WriteBoolean(OutputText: Text; bool: BOOLEAN; width: CARDINAL); + BEGIN + IF bool THEN + WriteString(OutputText, " TRUE", width); + ELSE + WriteString(OutputText, "FALSE", width); + END; + END WriteBoolean; + + PROCEDURE WriteReal(OutputText: Text; real: REAL; width, nfrac: CARDINAL); + BEGIN + WriteLongReal(OutputText, LONG(real), width, nfrac) + END WriteReal; + + PROCEDURE WriteLongReal(OutputText: Text; real: LONGREAL; width, nfrac: CARDINAL); + VAR + buf: numbuf; + ok: BOOLEAN; + digits: INTEGER; + BEGIN + IF width > SIZE(buf) THEN + width := SIZE(buf); + END; + IF nfrac > 0 THEN + LongRealToString(real, width, nfrac, buf, ok); + ELSE + IF width < 9 THEN width := 9; END; + IF real < 0.0D THEN + digits := 7 - INTEGER(width); + ELSE + digits := 6 - INTEGER(width); + END; + LongRealToString(real, width, digits, buf, ok); + END; + WriteString(OutputText, buf, 0); + END WriteLongReal; + + PROCEDURE WriteString(OutputText: Text; str: ARRAY OF CHAR; width: CARDINAL); + VAR index: CARDINAL; + BEGIN + index := 0; + WHILE (index <= HIGH(str)) AND (str[index] # Eos) DO + INC(index); + END; + WHILE index < width DO + WriteChar(OutputText, " "); + INC(index); + END; + index := 0; + WHILE (index <= HIGH(str)) AND (str[index] # Eos) DO + WriteChar(OutputText, str[index]); + INC(index); + END; + END WriteString; + +BEGIN (* PascalIO initialization *) + WITH ibuf DO + stream := InputStream; + eof := FALSE; + type := Preading; + done := FALSE; + END; + WITH obuf DO + stream := OutputStream; + eof := FALSE; + type := Pwriting; + END; + Notext := NIL; + Input := ADR(ibuf); + Output := ADR(obuf); + Input^.next := Output; + Output^.next := NIL; + head := Input; +END PascalIO. diff --git a/lib/ack/libm2/Processes.mod b/lib/ack/libm2/Processes.mod new file mode 100755 index 000000000..152c7e640 --- /dev/null +++ b/lib/ack/libm2/Processes.mod @@ -0,0 +1,101 @@ +(*$R-*) +IMPLEMENTATION MODULE Processes [1]; +(* + Module: Processes + From: "Programming in Modula-2", 3rd, corrected edition, by N. Wirth + Version: $Header$ +*) + + FROM SYSTEM IMPORT ADDRESS, TSIZE, NEWPROCESS, TRANSFER; + FROM Storage IMPORT Allocate; + FROM Traps IMPORT Message; + + TYPE SIGNAL = POINTER TO ProcessDescriptor; + + ProcessDescriptor = + RECORD next: SIGNAL; (* ring *) + queue: SIGNAL; (* queue of waiting processes *) + cor: ADDRESS; + ready: BOOLEAN; + END; + + VAR cp: SIGNAL; (* current process *) + + PROCEDURE StartProcess(P: PROC; n: CARDINAL); + VAR s0: SIGNAL; + wsp: ADDRESS; + BEGIN + s0 := cp; + Allocate(wsp, n); + Allocate(cp, TSIZE(ProcessDescriptor)); + WITH cp^ DO + next := s0^.next; + s0^.next := cp; + ready := TRUE; + queue := NIL + END; + NEWPROCESS(P, wsp, n, cp^.cor); + TRANSFER(s0^.cor, cp^.cor); + END StartProcess; + + PROCEDURE SEND(VAR s: SIGNAL); + VAR s0: SIGNAL; + BEGIN + IF s # NIL THEN + s0 := cp; + cp := s; + WITH cp^ DO + s := queue; + ready := TRUE; + queue := NIL + END; + TRANSFER(s0^.cor, cp^.cor); + END + END SEND; + + PROCEDURE WAIT(VAR s: SIGNAL); + VAR s0, s1: SIGNAL; + BEGIN + (* insert cp in queue s *) + IF s = NIL THEN + s := cp + ELSE + s0 := s; + s1 := s0^.queue; + WHILE s1 # NIL DO + s0 := s1; + s1 := s0^.queue + END; + s0^.queue := cp + END; + s0 := cp; + REPEAT + cp := cp^.next + UNTIL cp^.ready; + IF cp = s0 THEN + (* deadlock *) + Message("deadlock"); + HALT + END; + s0^.ready := FALSE; + TRANSFER(s0^.cor, cp^.cor) + END WAIT; + + PROCEDURE Awaited(s: SIGNAL): BOOLEAN; + BEGIN + RETURN s # NIL + END Awaited; + + PROCEDURE Init(VAR s: SIGNAL); + BEGIN + s := NIL + END Init; + +BEGIN + Allocate(cp, TSIZE(ProcessDescriptor)); + WITH cp^ DO + next := cp; + ready := TRUE; + queue := NIL + END +END Processes. diff --git a/lib/ack/libm2/RealConver.mod b/lib/ack/libm2/RealConver.mod new file mode 100755 index 000000000..c663f5ed0 --- /dev/null +++ b/lib/ack/libm2/RealConver.mod @@ -0,0 +1,337 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE RealConversions; +(* + Module: string-to-real and real-to-string conversions + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + + PROCEDURE RealToString(arg: REAL; + width, digits: INTEGER; + VAR str: ARRAY OF CHAR; + VAR ok: BOOLEAN); + BEGIN + LongRealToString(LONG(arg), width, digits, str, ok); + END RealToString; + + TYPE + Powers = RECORD + pval: LONGREAL; + rpval: LONGREAL; + exp: INTEGER + END; + + VAR Powers10: ARRAY[1..6] OF Powers; + + PROCEDURE LongRealToString(arg: LONGREAL; + width, digits: INTEGER; + VAR str: ARRAY OF CHAR; + VAR ok: BOOLEAN); + VAR pointpos: INTEGER; + i: CARDINAL; + ecvtflag: BOOLEAN; + r: LONGREAL; + ind1, ind2 : CARDINAL; + sign: BOOLEAN; + ndigits: CARDINAL; + + BEGIN + r := arg; + IF digits < 0 THEN + ecvtflag := TRUE; + ndigits := -digits; + ELSE + ecvtflag := FALSE; + ndigits := digits; + END; + IF (HIGH(str) < ndigits + 3) THEN + str[0] := 0C; ok := FALSE; RETURN + END; + pointpos := 0; + sign := r < 0.0D; + IF sign THEN r := -r END; + ok := TRUE; + IF NOT (r / 10.0D < r) THEN + (* assume Nan or Infinity *) + r := 0.0D; + ok := FALSE; + END; + IF r # 0.0D THEN + IF r >= 10.0D THEN + FOR i := 1 TO 6 DO + WITH Powers10[i] DO + WHILE r >= pval DO + r := r * rpval; + INC(pointpos, exp) + END; + END; + END; + END; + IF r < 1.0D THEN + FOR i := 1 TO 6 DO + WITH Powers10[i] DO + WHILE r*pval < 10.0D DO + r := r * pval; + DEC(pointpos, exp) + END; + END; + END; + END; + (* Now, we have r in [1.0, 10.0) *) + INC(pointpos); + END; + ind1 := 0; + ind2 := ndigits+1; + + IF NOT ecvtflag THEN + IF INTEGER(ind2) + pointpos <= 0 THEN + ind2 := 1; + ELSE + ind2 := INTEGER(ind2) + pointpos + END; + END; + IF ind2 > HIGH(str) THEN + ok := FALSE; + str[0] := 0C; + RETURN; + END; + WHILE ind1 < ind2 DO + str[ind1] := CHR(TRUNC(r)+ORD('0')); + r := 10.0D * (r - FLOATD(TRUNC(r))); + INC(ind1); + END; + IF ind2 > 0 THEN + DEC(ind2); + ind1 := ind2; + str[ind2] := CHR(ORD(str[ind2])+5); + WHILE str[ind2] > '9' DO + str[ind2] := '0'; + IF ind2 > 0 THEN + DEC(ind2); + str[ind2] := CHR(ORD(str[ind2])+1); + ELSE + str[ind2] := '1'; + INC(pointpos); + IF NOT ecvtflag THEN + IF ind1 > 0 THEN str[ind1] := '0'; END; + INC(ind1); + END; + END; + END; + IF (NOT ecvtflag) AND (ind1 = 0) THEN + str[0] := CHR(ORD(str[0])-5); + INC(ind1); + END; + END; + IF ecvtflag THEN + FOR i := ind1 TO 2 BY -1 DO + str[i] := str[i-1]; + END; + str[1] := '.'; + INC(ind1); + IF sign THEN + FOR i := ind1 TO 1 BY -1 DO + str[i] := str[i-1]; + END; + INC(ind1); + str[0] := '-'; + END; + IF (ind1 + 4) > HIGH(str) THEN + str[0] := 0C; + ok := FALSE; + RETURN; + END; + str[ind1] := 'E'; INC(ind1); + IF arg # 0.0D THEN DEC(pointpos); END; + IF pointpos < 0 THEN + pointpos := -pointpos; + str[ind1] := '-'; + ELSE + str[ind1] := '+'; + END; + INC(ind1); + str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 100)); + pointpos := pointpos MOD 100; + INC(ind1); + str[ind1] := CHR(ORD('0') + CARDINAL(pointpos DIV 10)); + INC(ind1); + str[ind1] := CHR(ORD('0') + CARDINAL(pointpos MOD 10)); + ELSE + IF pointpos <= 0 THEN + FOR i := ind1 TO 1 BY -1 DO + str[i+CARDINAL(-pointpos)] := str[i-1]; + END; + FOR i := 0 TO CARDINAL(-pointpos) DO + str[i] := '0'; + END; + ind1 := ind1 + CARDINAL(1 - pointpos); + pointpos := 1; + END; + FOR i := ind1 TO CARDINAL(pointpos+1) BY -1 DO + str[i] := str[i-1]; + END; + IF ndigits = 0 THEN + str[pointpos] := 0C; + ind1 := pointpos - 1; + ELSE + str[pointpos] := '.'; + IF INTEGER(ind1) > pointpos+INTEGER(ndigits) THEN + ind1 := pointpos+INTEGER(ndigits); + END; + str[pointpos+INTEGER(ndigits)+1] := 0C; + END; + IF sign THEN + FOR i := ind1 TO 0 BY -1 DO + str[i+1] := str[i]; + END; + str[0] := '-'; + INC(ind1); + END; + END; + IF (ind1+1) <= HIGH(str) THEN str[ind1+1] := 0C; END; + IF ind1 >= CARDINAL(width) THEN + ok := FALSE; + RETURN; + END; + IF width > 0 THEN + DEC(width); + END; + IF (width > 0) AND (ind1 < CARDINAL(width)) THEN + FOR i := ind1 TO 0 BY -1 DO + str[i + CARDINAL(width) - ind1] := str[i]; + END; + FOR i := 0 TO CARDINAL(width)-(ind1+1) DO + str[i] := ' '; + END; + ind1 := CARDINAL(width); + IF (ind1+1) <= HIGH(str) THEN + FOR ind1 := ind1+1 TO HIGH(str) DO + str[ind1] := 0C; + END; + END; + END; + + END LongRealToString; + + + PROCEDURE StringToReal(str: ARRAY OF CHAR; + VAR r: REAL; VAR ok: BOOLEAN); + VAR x: LONGREAL; + BEGIN + StringToLongReal(str, x, ok); + IF ok THEN + r := x; + END; + END StringToReal; + + PROCEDURE StringToLongReal(str: ARRAY OF CHAR; + VAR r: LONGREAL; VAR ok: BOOLEAN); + CONST BIG = 1.0D17; + TYPE SETOFCHAR = SET OF CHAR; + VAR pow10 : INTEGER; + i : INTEGER; + e : LONGREAL; + ch : CHAR; + signed: BOOLEAN; + signedexp: BOOLEAN; + iB: CARDINAL; + + BEGIN + r := 0.0D; + pow10 := 0; + iB := 0; + ok := TRUE; + signed := FALSE; + WHILE (str[iB] = ' ') OR (str[iB] = CHR(9)) DO + INC(iB); + IF iB > HIGH(str) THEN + ok := FALSE; + RETURN; + END; + END; + IF str[iB] = '-' THEN signed := TRUE; INC(iB) + ELSIF str[iB] = '+' THEN INC(iB) + END; + ch := str[iB]; INC(iB); + IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END; + REPEAT + IF r>BIG THEN INC(pow10) ELSE r:= 10.0D*r+FLOATD(ORD(ch)-ORD('0')) END; + IF iB <= HIGH(str) THEN + ch := str[iB]; INC(iB); + END; + UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'}); + IF (ch = '.') AND (iB <= HIGH(str)) THEN + ch := str[iB]; INC(iB); + IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END; + REPEAT + IF r < BIG THEN + r := 10.0D * r + FLOATD(ORD(ch)-ORD('0')); + DEC(pow10); + END; + IF iB <= HIGH(str) THEN + ch := str[iB]; INC(iB); + END; + UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'}); + END; + IF (ch = 'E') THEN + IF iB > HIGH(str) THEN + ok := FALSE; + RETURN; + ELSE + ch := str[iB]; INC(iB); + END; + i := 0; + signedexp := FALSE; + IF (ch = '-') OR (ch = '+') THEN + signedexp := ch = '-'; + IF iB > HIGH(str) THEN + ok := FALSE; + RETURN; + ELSE + ch := str[iB]; INC(iB); + END; + END; + IF NOT (ch IN SETOFCHAR{'0'..'9'}) THEN ok := FALSE; RETURN END; + REPEAT + i := i*10 + INTEGER(ORD(ch) - ORD('0')); + IF iB <= HIGH(str) THEN + ch := str[iB]; INC(iB); + END; + UNTIL (iB > HIGH(str)) OR NOT (ch IN SETOFCHAR{'0'..'9'}); + IF signedexp THEN i := -i END; + pow10 := pow10 + i; + END; + IF pow10 < 0 THEN i := -pow10; ELSE i := pow10; END; + e := 1.0D; + DEC(i); + WHILE i >= 10 DO + e := e * 10000000000.0D; + DEC(i,10); + END; + WHILE i >= 0 DO + e := e * 10.0D; + DEC(i) + END; + IF pow10<0 THEN + r := r / e; + ELSE + r := r * e; + END; + IF signed THEN r := -r; END; + IF (iB <= HIGH(str)) AND (ORD(ch) > ORD(' ')) THEN ok := FALSE; END + END StringToLongReal; + +BEGIN + WITH Powers10[1] DO pval := 1.0D32; rpval := 1.0D-32; exp := 32 END; + WITH Powers10[2] DO pval := 1.0D16; rpval := 1.0D-16; exp := 16 END; + WITH Powers10[3] DO pval := 1.0D8; rpval := 1.0D-8; exp := 8 END; + WITH Powers10[4] DO pval := 1.0D4; rpval := 1.0D-4; exp := 4 END; + WITH Powers10[5] DO pval := 1.0D2; rpval := 1.0D-2; exp := 2 END; + WITH Powers10[6] DO pval := 1.0D1; rpval := 1.0D-1; exp := 1 END; +END RealConversions. diff --git a/lib/ack/libm2/RealInOut.mod b/lib/ack/libm2/RealInOut.mod new file mode 100755 index 000000000..e2565cc2f --- /dev/null +++ b/lib/ack/libm2/RealInOut.mod @@ -0,0 +1,97 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE RealInOut; +(* + Module: InOut for REAL numbers + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + FROM InOut IMPORT ReadString, WriteString, WriteOct; + FROM Traps IMPORT Message; + FROM SYSTEM IMPORT WORD; + FROM RealConversions IMPORT + LongRealToString, StringToLongReal; + + CONST MAXNDIG = 32; + MAXWIDTH = MAXNDIG+7; + TYPE RBUF = ARRAY [0..MAXWIDTH+1] OF CHAR; + + PROCEDURE WriteReal(arg: REAL; ndigits: CARDINAL); + BEGIN + WriteLongReal(LONG(arg), ndigits) + END WriteReal; + + PROCEDURE WriteLongReal(arg: LONGREAL; ndigits: CARDINAL); + VAR buf : RBUF; + ok : BOOLEAN; + + BEGIN + IF ndigits > MAXWIDTH THEN ndigits := MAXWIDTH; END; + IF ndigits < 10 THEN ndigits := 10; END; + LongRealToString(arg, ndigits, -INTEGER(ndigits - 7), buf, ok); + WriteString(buf); + END WriteLongReal; + + PROCEDURE WriteFixPt(arg: REAL; n, k: CARDINAL); + BEGIN + WriteLongFixPt(LONG(arg), n, k) + END WriteFixPt; + + PROCEDURE WriteLongFixPt(arg: LONGREAL; n, k: CARDINAL); + VAR buf: RBUF; + ok : BOOLEAN; + + BEGIN + IF n > MAXWIDTH THEN n := MAXWIDTH END; + LongRealToString(arg, n, k, buf, ok); + WriteString(buf); + END WriteLongFixPt; + + PROCEDURE ReadReal(VAR x: REAL); + VAR x1: LONGREAL; + BEGIN + ReadLongReal(x1); + x := x1 + END ReadReal; + + PROCEDURE ReadLongReal(VAR x: LONGREAL); + VAR Buf: ARRAY[0..512] OF CHAR; + ok: BOOLEAN; + + BEGIN + ReadString(Buf); + StringToLongReal(Buf, x, ok); + IF NOT ok THEN + Message("real expected"); + HALT; + END; + Done := TRUE; + END ReadLongReal; + + PROCEDURE wroct(x: ARRAY OF WORD); + VAR i: CARDINAL; + BEGIN + FOR i := 0 TO HIGH(x) DO + WriteOct(CARDINAL(x[i]), 0); + WriteString(" "); + END; + END wroct; + + PROCEDURE WriteRealOct(x: REAL); + BEGIN + wroct(x); + END WriteRealOct; + + PROCEDURE WriteLongRealOct(x: LONGREAL); + BEGIN + wroct(x); + END WriteLongRealOct; + +BEGIN + Done := FALSE; +END RealInOut. diff --git a/lib/ack/libm2/SYSTEM.c b/lib/ack/libm2/SYSTEM.c new file mode 100755 index 000000000..51def5596 --- /dev/null +++ b/lib/ack/libm2/SYSTEM.c @@ -0,0 +1,115 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: SYSTEM + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +/* + An implementation of the Modula-2 NEWPROCESS and TRANSFER facilities + using the topsize, topsave, and topload facilities. + For each coroutine, a proc structure is built. For the main routine, + a static space is declared to save its stack. For the other coroutines, + the user specifies this space. +*/ + +#include + +#define MAXMAIN 2048 + +struct proc { + unsigned size; /* size of saved stackframe(s) */ + int (*proc)(); /* address of coroutine procedure */ + char *brk; /* stack break of this coroutine */ +}; + +extern unsigned topsize(); + +static struct proc mainproc[MAXMAIN/sizeof(struct proc) + 1]; + +static struct proc *curproc = 0;/* current coroutine */ +extern char *MainLB; /* stack break of main routine */ + +_SYSTEM__NEWPROCESS(p, a, n, p1) + int (*p)(); /* coroutine procedure */ + struct proc *a; /* pointer to area for saved stack-frame */ + unsigned n; /* size of this area */ + struct proc **p1; /* where to leave coroutine descriptor, + in this implementation the address of + the area for saved stack-frame(s) */ +{ + /* This procedure creates a new coroutine, but does not + transfer control to it. The routine "topsize" will compute the + stack break, which will be the local base of this routine. + Notice that we can do this because we do not need the stack + above this point for this coroutine. In Modula-2, coroutines + must be level 0 procedures without parameters. + */ + char *brk = 0; + unsigned sz = topsize(&brk); + + if (sz + sizeof(struct proc) > n) { + /* not enough space */ + TRP(M2_TOOLARGE); + } + a->size = n; + a->proc = p; + a->brk = brk; + *p1 = a; + if (topsave(brk, a+1)) + /* stack frame saved; now just return */ + ; + else { + /* We get here through the first transfer to the coroutine + created above. + This also means that curproc is now set to this coroutine. + We cannot trust the parameters anymore. + Just call the coroutine procedure. + */ + (*(curproc->proc))(); + _cleanup(); + _exit(0); + } +} + +_SYSTEM__TRANSFER(a, b) + struct proc **a, **b; +{ + /* transfer from one coroutine to another, saving the current + descriptor in the space indicated by "a", and transfering to + the coroutine in descriptor "b". + */ + unsigned size; + + if (! curproc) { + /* the current coroutine is the main process; + initialize a coroutine descriptor for it ... + */ + mainproc[0].brk = MainLB; + mainproc[0].size = sizeof(mainproc); + curproc = &mainproc[0]; + } + *a = curproc; /* save current descriptor in "a" */ + if (*b == curproc) { + /* transfer to itself is a no-op */ + return; + } + size = topsize(&(curproc->brk)); + if (size + sizeof(struct proc) > curproc->size) { + TRP(M2_TOOLARGE); + } + if (topsave(curproc->brk, curproc+1)) { + /* stack top saved. Now restore context of target + coroutine + */ + curproc = *b; + topload(curproc+1); + /* we never get here ... */ + } + /* but we do get here, when a transfer is done to the coroutine in "a". + */ +} diff --git a/lib/ack/libm2/Semaphores.mod b/lib/ack/libm2/Semaphores.mod new file mode 100755 index 000000000..d6c056649 --- /dev/null +++ b/lib/ack/libm2/Semaphores.mod @@ -0,0 +1,118 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Semaphores [1]; +(* + Module: Processes with semaphores + Author: Ceriel J.H. Jacobs + Version: $Header$ + + Quasi-concurrency implementation +*) + + FROM SYSTEM IMPORT ADDRESS, NEWPROCESS, TRANSFER; + FROM Storage IMPORT Allocate; + FROM random IMPORT Uniform; + FROM Traps IMPORT Message; + + TYPE Sema = POINTER TO Semaphore; + Processes = POINTER TO Process; + Semaphore = + RECORD + level: CARDINAL; + END; + Process = + RECORD next: Processes; + proc: ADDRESS; + waiting: Sema; + END; + + VAR cp: Processes; (* current process *) + + PROCEDURE StartProcess(P: PROC; n: CARDINAL); + VAR s0: Processes; + wsp: ADDRESS; + BEGIN + s0 := cp; + Allocate(wsp, n); + Allocate(cp, SIZE(Process)); + WITH cp^ DO + next := s0^.next; + s0^.next := cp; + waiting := NIL; + END; + NEWPROCESS(P, wsp, n, cp^.proc); + TRANSFER(s0^.proc, cp^.proc); + END StartProcess; + + PROCEDURE Up(VAR s: Sema); + BEGIN + s^.level := s^.level + 1; + ReSchedule; + END Up; + + PROCEDURE Down(VAR s: Sema); + BEGIN + IF s^.level = 0 THEN + cp^.waiting := s; + ELSE + s^.level := s^.level - 1; + END; + ReSchedule; + END Down; + + PROCEDURE NewSema(n: CARDINAL): Sema; + VAR s: Sema; + BEGIN + Allocate(s, SIZE(Semaphore)); + s^.level := n; + RETURN s; + END NewSema; + + PROCEDURE Level(s: Sema): CARDINAL; + BEGIN + RETURN s^.level; + END Level; + + PROCEDURE ReSchedule; + VAR s0: Processes; + i, j: CARDINAL; + BEGIN + s0 := cp; + i := Uniform(1, 5); + j := i; + LOOP + cp := cp^.next; + IF Runnable(cp) THEN + DEC(i); + IF i = 0 THEN EXIT END; + END; + IF (cp = s0) AND (j = i) THEN + (* deadlock *) + Message("deadlock"); + HALT + END; + END; + IF cp # s0 THEN TRANSFER(s0^.proc, cp^.proc); END; + END ReSchedule; + + PROCEDURE Runnable(p: Processes): BOOLEAN; + BEGIN + IF p^.waiting = NIL THEN RETURN TRUE; END; + IF p^.waiting^.level > 0 THEN + p^.waiting^.level := p^.waiting^.level - 1; + p^.waiting := NIL; + RETURN TRUE; + END; + RETURN FALSE; + END Runnable; +BEGIN + Allocate(cp, SIZE(Process)); + WITH cp^ DO + next := cp; + waiting := NIL; + END +END Semaphores. diff --git a/lib/ack/libm2/Storage.mod b/lib/ack/libm2/Storage.mod new file mode 100755 index 000000000..a416f4901 --- /dev/null +++ b/lib/ack/libm2/Storage.mod @@ -0,0 +1,353 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Storage; +(* + Module: Dynamic Storage Allocation + Author: Ceriel J.H. Jacobs + Adapted from a version in C by Hans Tebra + Version: $Header$ +*) +(* This storage manager maintains an array of lists of objects with the + same size. Commonly used sizes have their own bucket. The larger ones + are put in a single list. +*) + FROM Unix IMPORT sbrk, ILLBREAK; + FROM SYSTEM IMPORT ADDRESS, ADR; + FROM Traps IMPORT Message; + + CONST + NLISTS = 20; + MAGICW = 0A5A5H; + MAGICC = 175C; + + TYPE + ALIGNTYPE = + RECORD + CASE : INTEGER OF + 1: l: LONGINT | + 2: p: ADDRESS | + 3: d: LONGREAL + END + END; (* A type with high alignment requirements *) + BucketPtr = POINTER TO Bucket; + Bucket = + RECORD + CASE : BOOLEAN OF + FALSE: + BNEXT: BucketPtr; (* next free Bucket *) + BSIZE: CARDINAL; | (* size of user part in UNITs *) + TRUE: BXX: ALIGNTYPE + END; + BSTORE: ALIGNTYPE; + END; + + CONST + UNIT = SIZE(ALIGNTYPE); + + VAR + FreeLists: ARRAY[0..NLISTS] OF BucketPtr; (* small blocks *) + Llist: BucketPtr; (* others *) + Compacted: BOOLEAN; (* avoid recursive reorganization *) + FirstBlock: BucketPtr; + USED: ADDRESS; + + PROCEDURE MyAllocate(size: CARDINAL) : ADDRESS; + VAR nu : CARDINAL; + b : CARDINAL; + p, q: BucketPtr; + pc: POINTER TO CHAR; + brk : ADDRESS; + BEGIN + IF size > CARDINAL(MAX(INTEGER)-2*UNIT + 1) THEN + RETURN NIL; + END; + nu := (size + (UNIT-1)) DIV UNIT; + IF nu = 0 THEN + nu := 1; + END; + IF nu <= NLISTS THEN + b := nu; + IF FreeLists[b] # NIL THEN + (* Exact fit *) + p := FreeLists[b]; + FreeLists[b] := p^.BNEXT; + p^.BNEXT := USED; + IF p^.BSIZE * UNIT # size THEN + pc := ADR(p^.BSTORE) + size; + pc^ := MAGICC; + END; + p^.BSIZE := size; + RETURN ADR(p^.BSTORE); + END; + + (* Search for a block with >= 2 units more than requested. + We pay for an additional header when the block is split. + *) + FOR b := b+2 TO NLISTS DO + IF FreeLists[b] # NIL THEN + q := FreeLists[b]; + FreeLists[b] := q^.BNEXT; + p := ADDRESS(q) + (nu+1)*UNIT; + (* p indicates the block that must be given + back + *) + p^.BSIZE := q^.BSIZE - nu - 1; + p^.BNEXT := FreeLists[p^.BSIZE]; + FreeLists[p^.BSIZE] := p; + q^.BSIZE := nu; + q^.BNEXT := USED; + IF q^.BSIZE * UNIT # size THEN + pc := ADR(q^.BSTORE) + size; + pc^ := MAGICC; + END; + q^.BSIZE := size; + RETURN ADR(q^.BSTORE); + END; + END; + END; + + p := Llist; + IF p # NIL THEN + q := NIL; + WHILE (p # NIL) AND (p^.BSIZE < nu) DO + q := p; + p := p^.BNEXT; + END; + + IF p # NIL THEN + (* p^.BSIZE >= nu *) + IF p^.BSIZE <= nu + NLISTS + 1 THEN + (* Remove p from this list *) + IF q # NIL THEN q^.BNEXT := p^.BNEXT + ELSE Llist := p^.BNEXT; + END; + p^.BNEXT := USED; + IF p^.BSIZE > nu + 1 THEN + (* split block, + tail goes to FreeLists area + *) + q := ADDRESS(p) + (nu+1)*UNIT; + q^.BSIZE := p^.BSIZE -nu -1; + q^.BNEXT := FreeLists[q^.BSIZE]; + FreeLists[q^.BSIZE] := q; + p^.BSIZE := nu; + END; + IF p^.BSIZE * UNIT # size THEN + pc := ADR(p^.BSTORE) + size; + pc^ := MAGICC; + END; + p^.BSIZE := size; + RETURN ADR(p^.BSTORE); + END; + (* Give part of tail of original block. + Block stays in this list. + *) + q := ADDRESS(p) + (p^.BSIZE-nu)*UNIT; + q^.BSIZE := nu; + p^.BSIZE := p^.BSIZE - nu - 1; + q^.BNEXT := USED; + IF q^.BSIZE * UNIT # size THEN + pc := ADR(q^.BSTORE) + size; + pc^ := MAGICC; + END; + q^.BSIZE := size; + RETURN ADR(q^.BSTORE); + END; + END; + + IF Compacted THEN + (* reorganization did not yield sufficient memory *) + RETURN NIL; + END; + + brk := sbrk(UNIT * (nu + 1)); + IF brk = ILLBREAK THEN + ReOrganize(); + Compacted := TRUE; + brk := MyAllocate(size); + Compacted := FALSE; + RETURN brk; + END; + + p := brk; + p^.BSIZE := nu; + p^.BNEXT := USED; + IF p^.BSIZE * UNIT # size THEN + pc := ADR(p^.BSTORE) + size; + pc^ := MAGICC; + END; + p^.BSIZE := size; + RETURN ADR(p^.BSTORE); + END MyAllocate; + + PROCEDURE ALLOCATE(VAR a: ADDRESS; size: CARDINAL); + BEGIN + Allocate(a, size); + END ALLOCATE; + + PROCEDURE Allocate(VAR a: ADDRESS; size: CARDINAL); + BEGIN + a := MyAllocate(size); + IF a = NIL THEN + Message("out of core"); + HALT; + END; + END Allocate; + + PROCEDURE Available(size: CARDINAL): BOOLEAN; + VAR a: ADDRESS; + BEGIN + a:= MyAllocate(size); + IF a # NIL THEN + Deallocate(a, size); + RETURN TRUE; + END; + RETURN FALSE; + END Available; + + PROCEDURE DEALLOCATE(VAR a: ADDRESS; size: CARDINAL); + BEGIN + Deallocate(a, size); + END DEALLOCATE; + + PROCEDURE Deallocate(VAR a: ADDRESS; size: CARDINAL); + VAR p: BucketPtr; + pc: POINTER TO CHAR; + BEGIN + IF (a = NIL) THEN + Message("(Warning) Deallocate: NIL pointer deallocated"); + RETURN; + END; + p := a - UNIT; + IF (p^.BNEXT # BucketPtr(USED)) THEN + Message("(Warning) Deallocate: area already deallocated or heap corrupted"); + a := NIL; + RETURN; + END; + WITH p^ DO + IF BSIZE # size THEN + Message("(Warning) Deallocate: wrong size or heap corrupted"); + END; + BSIZE := (size + (UNIT - 1)) DIV UNIT; + IF (BSIZE*UNIT # size) THEN + pc := a + size; + IF pc^ # MAGICC THEN + Message("(Warning) Deallocate: heap corrupted"); + END; + END; + IF BSIZE <= NLISTS THEN + BNEXT := FreeLists[BSIZE]; + FreeLists[BSIZE] := p; + ELSE + BNEXT := Llist; + Llist := p; + END; + END; + a := NIL + END Deallocate; + + PROCEDURE ReOrganize(); + VAR lastblock: BucketPtr; + b, be: BucketPtr; + i: CARDINAL; + BEGIN + lastblock := NIL; + FOR i := 1 TO NLISTS DO + b := FreeLists[i]; + WHILE b # NIL DO + IF ADDRESS(b) > ADDRESS(lastblock) THEN + lastblock := b; + END; + be := b^.BNEXT; + b^.BNEXT := NIL; (* temporary free mark *) + b := be; + END; + END; + + b := Llist; + WHILE b # NIL DO + IF ADDRESS(b) > ADDRESS(lastblock) THEN + lastblock := b; + END; + be := b^.BNEXT; + b^.BNEXT := NIL; + b := be; + END; + + (* Now, all free blocks have b^.BNEXT = NIL *) + + b := FirstBlock; + WHILE ADDRESS(b) < ADDRESS(lastblock) DO + LOOP + be := ADDRESS(b)+(b^.BSIZE+1)*UNIT; + IF b^.BNEXT # NIL THEN + (* this block is not free *) + EXIT; + END; + IF ADDRESS(be) > ADDRESS(lastblock) THEN + (* no next block *) + EXIT; + END; + IF be^.BNEXT # NIL THEN + (* next block is not free *) + EXIT; + END; + (* this block and the next one are free, + so merge them, but only if it is not too big + *) + IF MAX(CARDINAL) - b^.BSIZE > be^.BSIZE THEN + b^.BSIZE := b^.BSIZE + be^.BSIZE + 1; + ELSE + EXIT; + END; + END; + b := be; + END; + + (* clear all free lists *) + FOR i := 1 TO NLISTS DO FreeLists[i] := NIL; END; + Llist := NIL; + + (* collect free blocks in them again *) + b := FirstBlock; + WHILE ADDRESS(b) <= ADDRESS(lastblock) DO + WITH b^ DO + IF BNEXT = NIL THEN + IF BSIZE <= NLISTS THEN + BNEXT := FreeLists[BSIZE]; + FreeLists[BSIZE] := b; + ELSE + BNEXT := Llist; + Llist := b; + END; + b := ADDRESS(b) + (BSIZE+1) * UNIT; + ELSE + b := ADDRESS(b) + + ((BSIZE + (UNIT - 1)) DIV UNIT + 1) * UNIT; + END; + END; + END; + END ReOrganize; + + PROCEDURE InitStorage(); + VAR i: CARDINAL; + brk: ADDRESS; + BEGIN + FOR i := 1 TO NLISTS DO + FreeLists[i] := NIL; + END; + Llist := NIL; + brk := sbrk(0); + brk := sbrk(UNIT - brk MOD UNIT); + FirstBlock := sbrk(0); + Compacted := FALSE; + USED := MAGICW; + END InitStorage; + +BEGIN + InitStorage(); +END Storage. diff --git a/lib/ack/libm2/StrAss.c b/lib/ack/libm2/StrAss.c new file mode 100755 index 000000000..c8c49f713 --- /dev/null +++ b/lib/ack/libm2/StrAss.c @@ -0,0 +1,23 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: assign string to character array, with possible 0-byte + extension + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ +StringAssign(dstsiz, srcsiz, dstaddr, srcaddr) + register char *dstaddr, *srcaddr; +{ + while (srcsiz > 0) { + *dstaddr++ = *srcaddr++; + srcsiz--; + dstsiz--; + } + if (dstsiz > 0) { + *dstaddr = 0; + } +} diff --git a/lib/ack/libm2/Streams.mod b/lib/ack/libm2/Streams.mod new file mode 100755 index 000000000..451470149 --- /dev/null +++ b/lib/ack/libm2/Streams.mod @@ -0,0 +1,443 @@ +# +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Streams; +(* + Module: Stream Input/Output + Author: Ceriel J.H. Jacobs + Version: $Header$ + + Implementation for Unix +*) + + FROM SYSTEM IMPORT BYTE, ADR; + FROM Epilogue IMPORT CallAtEnd; + FROM Storage IMPORT Allocate, Available; + FROM StripUnix IMPORT + open, close, lseek, read, write, creat; + IMPORT StripUnix; + + CONST BUFSIZ = 1024; (* tunable *) + TYPE IOB = RECORD + kind: StreamKind; + mode: StreamMode; + eof: BOOLEAN; + buffering: StreamBuffering; + next : Stream; + fildes: INTEGER; + cnt, maxcnt: INTEGER; + bufferedcnt: INTEGER; + buf: ARRAY[1..BUFSIZ] OF BYTE; + END; + Stream = POINTER TO IOB; + VAR + ibuf, obuf, ebuf: IOB; + head: Stream; + + PROCEDURE getstruct(VAR stream: Stream); + BEGIN + stream := head; + WHILE (stream # NIL) AND (stream^.kind # none) DO + stream := stream^.next; + END; + IF stream = NIL THEN + IF NOT Available(SIZE(IOB)) THEN + RETURN; + END; + Allocate(stream,SIZE(IOB)); + stream^.next := head; + head := stream; + END; + END getstruct; + + PROCEDURE freestruct(stream: Stream); + BEGIN + stream^.kind := none; + END freestruct; + + PROCEDURE OpenStream(VAR stream: Stream; + filename: ARRAY OF CHAR; + kind: StreamKind; + mode: StreamMode; + VAR result: StreamResult); + VAR fd: INTEGER; + i: CARDINAL; + BEGIN + IF kind = none THEN + result := illegaloperation; + RETURN; + END; + getstruct(stream); + IF stream = NIL THEN + result := nomemory; + RETURN; + END; + WITH stream^ DO + FOR i := 0 TO HIGH(filename) DO + buf[i+1] := BYTE(filename[i]); + END; + buf[HIGH(filename)+2] := BYTE(0C); + END; + IF (mode = reading) THEN + fd := open(ADR(stream^.buf), 0); + ELSE + fd := -1; + IF (mode = appending) THEN + fd := open(ADR(stream^.buf), 1); + IF fd >= 0 THEN + IF (lseek(fd, 0D , 2) < 0D) THEN ; END; + END; + END; + IF fd < 0 THEN + fd := creat(ADR(stream^.buf), 666B); + END; + END; + IF fd < 0 THEN + result := openfailed; + freestruct(stream); + stream := NIL; + RETURN; + END; + result := succeeded; + stream^.fildes := fd; + stream^.kind := kind; + stream^.mode := mode; + stream^.buffering := blockbuffered; + stream^.bufferedcnt := BUFSIZ; + stream^.maxcnt := 0; + stream^.eof := FALSE; + IF mode = reading THEN + stream^.cnt := 1; + ELSE + stream^.cnt := 0; + END; + END OpenStream; + + PROCEDURE SetStreamBuffering( stream: Stream; + b: StreamBuffering; + VAR result: StreamResult); + BEGIN + result := succeeded; + IF (stream = NIL) OR (stream^.kind = none) THEN + result := nostream; + RETURN; + END; + IF (stream^.mode = reading) OR + ((b = linebuffered) AND (stream^.kind = binary)) THEN + result := illegaloperation; + RETURN; + END; + FlushStream(stream, result); + IF b = unbuffered THEN + stream^.bufferedcnt := 1; + END; + stream^.buffering := b; + END SetStreamBuffering; + + PROCEDURE FlushStream(stream: Stream; VAR result: StreamResult); + VAR cnt1: INTEGER; + BEGIN + result := succeeded; + IF (stream = NIL) OR (stream^.kind = none) THEN + result := nostream; + RETURN; + END; + WITH stream^ DO + IF mode = reading THEN + result := illegaloperation; + RETURN; + END; + IF (cnt > 0) THEN + cnt1 := cnt; + cnt := 0; + IF write(fildes, ADR(buf), cnt1) < 0 THEN END; + END; + END; + END FlushStream; + + PROCEDURE CloseStream(VAR stream: Stream; VAR result: StreamResult); + BEGIN + IF (stream # NIL) AND (stream^.kind # none) THEN + result := succeeded; + IF stream^.mode # reading THEN + FlushStream(stream, result); + END; + IF close(stream^.fildes) < 0 THEN ; END; + freestruct(stream); + ELSE + result := nostream; + END; + stream := NIL; + END CloseStream; + + PROCEDURE EndOfStream(stream: Stream; VAR result: StreamResult): BOOLEAN; + BEGIN + result := succeeded; + IF (stream = NIL) OR (stream^.kind = none) THEN + result := nostream; + RETURN FALSE; + END; + IF stream^.mode # reading THEN + result := illegaloperation; + RETURN FALSE; + END; + IF stream^.eof THEN RETURN TRUE; END; + RETURN (CHAR(NextByte(stream)) = 0C) AND stream^.eof; + END EndOfStream; + + PROCEDURE FlushLineBuffers(); + VAR s: Stream; + result: StreamResult; + BEGIN + s := head; + WHILE s # NIL DO + IF (s^.kind # none) AND (s^.buffering = linebuffered) THEN + FlushStream(s, result); + END; + s := s^.next; + END; + END FlushLineBuffers; + + PROCEDURE NextByte(stream: Stream): BYTE; + VAR c: BYTE; + BEGIN + WITH stream^ DO + IF cnt <= maxcnt THEN + c := buf[cnt]; + ELSE + IF eof THEN RETURN BYTE(0C); END; + IF stream = InputStream THEN + FlushLineBuffers(); + END; + maxcnt := read(fildes, ADR(buf), bufferedcnt); + cnt := 1; + IF maxcnt <= 0 THEN + eof := TRUE; + c := BYTE(0C); + ELSE + c := buf[1]; + END; + END; + END; + RETURN c; + END NextByte; + + PROCEDURE Read(stream: Stream; VAR ch: CHAR; VAR result: StreamResult); + VAR EoF: BOOLEAN; + BEGIN + ch := 0C; + EoF := EndOfStream(stream, result); + IF result # succeeded THEN RETURN; END; + IF EoF THEN + result := endoffile; + RETURN; + END; + WITH stream^ DO + ch := CHAR(buf[cnt]); + INC(cnt); + END; + END Read; + + PROCEDURE ReadByte(stream: Stream; VAR byte: BYTE; VAR result: StreamResult); + VAR EoF: BOOLEAN; + BEGIN + byte := BYTE(0C); + EoF := EndOfStream(stream, result); + IF result # succeeded THEN RETURN; END; + IF EoF THEN + result := endoffile; + RETURN; + END; + WITH stream^ DO + byte := buf[cnt]; + INC(cnt); + END; + END ReadByte; + + PROCEDURE ReadBytes(stream: Stream; + VAR bytes: ARRAY OF BYTE; + VAR result: StreamResult); + VAR i: CARDINAL; + BEGIN + FOR i := 0 TO HIGH(bytes) DO + ReadByte(stream, bytes[i], result); + END; + END ReadBytes; + + PROCEDURE Write(stream: Stream; ch: CHAR; VAR result: StreamResult); + BEGIN + IF (stream = NIL) OR (stream^.kind = none) THEN + result := nostream; + RETURN; + END; + IF (stream^.kind # text) OR (stream^.mode = reading) THEN + result := illegaloperation; + RETURN; + END; + WITH stream^ DO + INC(cnt); + buf[cnt] := BYTE(ch); + IF (cnt >= bufferedcnt) OR + ((ch = 12C) AND (buffering = linebuffered)) + THEN + FlushStream(stream, result); + END; + END; + END Write; + + PROCEDURE WriteByte(stream: Stream; byte: BYTE; VAR result: StreamResult); + BEGIN + IF (stream = NIL) OR (stream^.kind = none) THEN + result := nostream; + RETURN; + END; + IF (stream^.kind # binary) OR (stream^.mode = reading) THEN + result := illegaloperation; + RETURN; + END; + WITH stream^ DO + INC(cnt); + buf[cnt] := byte; + IF cnt >= bufferedcnt THEN + FlushStream(stream, result); + END; + END; + END WriteByte; + + PROCEDURE WriteBytes(stream: Stream; bytes: ARRAY OF BYTE; VAR result: StreamResult); + VAR i: CARDINAL; + BEGIN + FOR i := 0 TO HIGH(bytes) DO + WriteByte(stream, bytes[i], result); + END; + END WriteBytes; + + PROCEDURE EndIt; + VAR h, h1 : Stream; + result: StreamResult; + BEGIN + h := head; + WHILE h # NIL DO + h1 := h; + CloseStream(h1, result); + h := h^.next; + END; + END EndIt; + + PROCEDURE GetPosition(s: Stream; VAR position: LONGINT; + VAR result: StreamResult); + BEGIN + IF (s = NIL) OR (s^.kind = none) THEN + result := illegaloperation; + RETURN; + END; + IF (s^.mode # reading) THEN FlushStream(s, result); END; + position := lseek(s^.fildes, 0D, 1); + IF position < 0D THEN + result := illegaloperation; + RETURN; + END; + IF s^.mode = reading THEN + position := position + LONG(s^.maxcnt - s^.cnt + 1); + END; + END GetPosition; + + PROCEDURE SetPosition(s: Stream; position: LONGINT; VAR result: StreamResult); + VAR currpos: LONGINT; + BEGIN + currpos := 0D; + IF (s = NIL) OR (s^.kind = none) THEN + result := nostream; + RETURN; + END; + IF (s^.mode # reading) THEN + FlushStream(s, result); + ELSE + s^.maxcnt := 0; + s^.eof := FALSE; + END; + IF s^.mode = appending THEN + currpos := lseek(s^.fildes, 0D, 1); + IF currpos < 0D THEN + result := illegaloperation; + RETURN; + END; + END; + IF position < currpos THEN + result := illegaloperation; + RETURN; + END; + currpos := lseek(s^.fildes, position, 0); + IF currpos < 0D THEN + result := illegaloperation; + RETURN; + END; + result := succeeded; + END SetPosition; + + PROCEDURE isatty(stream: Stream; VAR result: StreamResult): BOOLEAN; + BEGIN + IF (stream = NIL) OR (stream^.kind = none) THEN + result := nostream; + RETURN FALSE; + END; + RETURN StripUnix.isatty(stream^.fildes); + END isatty; + + PROCEDURE InitStreams; + VAR result: StreamResult; + BEGIN + InputStream := ADR(ibuf); + OutputStream := ADR(obuf); + ErrorStream := ADR(ebuf); + WITH ibuf DO + kind := text; + mode := reading; + eof := FALSE; + next := ADR(obuf); + fildes := 0; + maxcnt := 0; + cnt := 1; + bufferedcnt := BUFSIZ; + END; + WITH obuf DO + kind := text; + mode := writing; + eof := TRUE; + next := ADR(ebuf); + fildes := 1; + maxcnt := 0; + cnt := 0; + bufferedcnt := BUFSIZ; + IF isatty(OutputStream, result) THEN + buffering := linebuffered; + ELSE + buffering := blockbuffered; + END; + END; + WITH ebuf DO + kind := text; + mode := writing; + eof := TRUE; + next := NIL; + fildes := 2; + maxcnt := 0; + cnt := 0; + bufferedcnt := BUFSIZ; + IF isatty(ErrorStream, result) THEN + buffering := linebuffered; + ELSE + buffering := blockbuffered; + END; + END; + head := InputStream; + IF CallAtEnd(EndIt) THEN ; END; + END InitStreams; + +BEGIN + InitStreams +END Streams. diff --git a/lib/ack/libm2/Strings.mod b/lib/ack/libm2/Strings.mod new file mode 100755 index 000000000..8ae31eea5 --- /dev/null +++ b/lib/ack/libm2/Strings.mod @@ -0,0 +1,171 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Strings; +(* + Module: String manipulations + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + PROCEDURE Assign(source: ARRAY OF CHAR; VAR dest: ARRAY OF CHAR); + (* Assign string source to dest + *) + VAR i: CARDINAL; + max: CARDINAL; + BEGIN + max := HIGH(source); + IF HIGH(dest) < max THEN max := HIGH(dest); END; + i := 0; + WHILE (i <= max) AND (source[i] # 0C) DO + dest[i] := source[i]; + INC(i); + END; + IF i < HIGH(dest) THEN dest[i] := 0C; END; + END Assign; + + PROCEDURE Insert(substr: ARRAY OF CHAR; VAR str: ARRAY OF CHAR; inx: CARDINAL); + (* Insert the string substr into str, starting at str[inx]. + If inx is equal to or greater than Length(str) then substr is appended + to the end of str. + *) + VAR sublen, length, i: CARDINAL; + BEGIN + sublen := Length(substr); + IF sublen = 0 THEN RETURN; END; + length := Length(str); + IF inx > length THEN inx := length; END; + i := length; + IF i + sublen - 1 > HIGH(str) THEN i := HIGH(str); END; + WHILE i > inx DO + str[i+sublen-1] := str[i-1]; + DEC(i); + END; + FOR i := 0 TO sublen - 1 DO + IF i + inx <= HIGH(str) THEN + str[i + inx] := substr[i]; + ELSE + RETURN; + END; + END; + IF length + sublen <= HIGH(str) THEN + str[length + sublen] := 0C; + END; + END Insert; + + PROCEDURE Delete(VAR str: ARRAY OF CHAR; inx, len: CARDINAL); + (* Delete len characters from str, starting at str[inx]. + If inx >= Length(str) then nothing happens. + If there are not len characters to delete, characters to the end of the + string are deleted. + *) + VAR length: CARDINAL; + BEGIN + IF len = 0 THEN RETURN; END; + length := Length(str); + IF inx >= length THEN RETURN; END; + WHILE inx + len < length DO + str[inx] := str[inx + len]; + INC(inx); + END; + str[inx] := 0C; + END Delete; + + PROCEDURE Pos(substr, str: ARRAY OF CHAR): CARDINAL; + (* Return the index into str of the first occurrence of substr. + Pos returns a value greater than HIGH(str) of no occurrence is found. + *) + VAR i, j, max, subl: CARDINAL; + BEGIN + max := Length(str); + subl := Length(substr); + IF subl > max THEN RETURN HIGH(str) + 1; END; + IF subl = 0 THEN RETURN 0; END; + max := max - subl; + FOR i := 0 TO max DO + j := 0; + WHILE (j <= subl-1) AND (str[i+j] = substr[j]) DO + INC(j); + END; + IF j = subl THEN RETURN i; END; + END; + RETURN HIGH(str) + 1; + END Pos; + + PROCEDURE Copy(str: ARRAY OF CHAR; + inx, len: CARDINAL; + VAR result: ARRAY OF CHAR); + (* Copy at most len characters from str into result, starting at str[inx]. + *) + VAR i: CARDINAL; + BEGIN + IF Length(str) <= inx THEN RETURN END; + i := 0; + LOOP + IF i > HIGH(result) THEN RETURN; END; + IF len = 0 THEN EXIT; END; + IF inx > HIGH(str) THEN EXIT; END; + result[i] := str[inx]; + INC(i); INC(inx); DEC(len); + END; + IF i <= HIGH(result) THEN result[i] := 0C; END; + END Copy; + + PROCEDURE Concat(s1, s2: ARRAY OF CHAR; VAR result: ARRAY OF CHAR); + (* Concatenate two strings. + *) + VAR i, j: CARDINAL; + BEGIN + i := 0; + WHILE (i <= HIGH(s1)) AND (s1[i] # 0C) DO + IF i > HIGH(result) THEN RETURN END; + result[i] := s1[i]; + INC(i); + END; + j := 0; + WHILE (j <= HIGH(s2)) AND (s2[j] # 0C) DO + IF i > HIGH(result) THEN RETURN END; + result[i] := s2[j]; + INC(i); + INC(j); + END; + IF i <= HIGH(result) THEN result[i] := 0C; END; + END Concat; + + PROCEDURE Length(str: ARRAY OF CHAR): CARDINAL; + (* Return number of characters in str. + *) + VAR i: CARDINAL; + BEGIN + i := 0; + WHILE (i <= HIGH(str)) DO + IF str[i] = 0C THEN RETURN i; END; + INC(i); + END; + RETURN i; + END Length; + + PROCEDURE CompareStr(s1, s2: ARRAY OF CHAR): INTEGER; + (* Compare two strings, return -1 if s1 < s2, 0 if s1 = s2, and 1 if s1 > s2. + *) + VAR i: CARDINAL; + max: CARDINAL; + BEGIN + max := HIGH(s1); + IF HIGH(s2) < max THEN max := HIGH(s2); END; + i := 0; + WHILE (i <= max) DO + IF s1[i] < s2[i] THEN RETURN -1; END; + IF s1[i] > s2[i] THEN RETURN 1; END; + IF s1[i] = 0C THEN RETURN 0; END; + INC(i); + END; + IF (i <= HIGH(s1)) AND (s1[i] # 0C) THEN RETURN 1; END; + IF (i <= HIGH(s2)) AND (s2[i] # 0C) THEN RETURN -1; END; + RETURN 0; + END CompareStr; + +END Strings. diff --git a/lib/ack/libm2/Termcap.mod b/lib/ack/libm2/Termcap.mod new file mode 100755 index 000000000..1098f7884 --- /dev/null +++ b/lib/ack/libm2/Termcap.mod @@ -0,0 +1,99 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(* + Module: Interface to termcap database + From: Unix manual chapter 3 + Version: $Header$ +*) + +(*$R-*) +IMPLEMENTATION MODULE Termcap; + + IMPORT XXTermcap; + FROM SYSTEM IMPORT ADR, ADDRESS; + FROM Unix IMPORT isatty; + FROM Arguments IMPORT + GetEnv; + + TYPE STR = ARRAY[1..32] OF CHAR; + STRCAP = POINTER TO STR; + + VAR Buf, Buf1 : ARRAY [1..1024] OF CHAR; + BufCnt : INTEGER; + + PROCEDURE Tgetent(name: ARRAY OF CHAR) : INTEGER; + VAR i: INTEGER; + x: STRCAP; + BEGIN + i := XXTermcap.tgetent(ADR(Buf), ADR(name)); + BufCnt := 1; + IF isatty(1) THEN + ELSE + (* This used to be something returned by gtty(). To increase + * portability we forget about old terminals needing delays. + * (kjb) + *) + XXTermcap.ospeed := 0; + END; + IF i > 0 THEN + IF Tgetstr("pc", x) THEN + XXTermcap.PC := x^[1]; + ELSE XXTermcap.PC := 0C; + END; + IF Tgetstr("up", x) THEN ; END; XXTermcap.UP := x; + IF Tgetstr("bc", x) THEN ; END; XXTermcap.BC := x; + END; + RETURN i; + END Tgetent; + + PROCEDURE Tgetnum(id: ARRAY OF CHAR): INTEGER; + BEGIN + RETURN XXTermcap.tgetnum(ADR(id)); + END Tgetnum; + + PROCEDURE Tgetflag(id: ARRAY OF CHAR): BOOLEAN; + BEGIN + RETURN XXTermcap.tgetflag(ADR(id)) = 1; + END Tgetflag; + + PROCEDURE Tgoto(cm: STRCAP; col, line: INTEGER): STRCAP; + BEGIN + RETURN XXTermcap.tgoto(cm, col, line); + END Tgoto; + + PROCEDURE Tgetstr(id: ARRAY OF CHAR; VAR res: STRCAP) : BOOLEAN; + VAR a, a2: ADDRESS; + b: CARDINAL; + BEGIN + a := ADR(Buf1[BufCnt]); + a2 := XXTermcap.tgetstr(ADR(id), ADR(a)); + res := a2; + IF a2 = NIL THEN + RETURN FALSE; + END; + b := a - a2; + INC(BufCnt, b); + RETURN TRUE; + END Tgetstr; + + PROCEDURE Tputs(cp: STRCAP; affcnt: INTEGER; p: PUTPROC); + BEGIN + XXTermcap.tputs(cp, affcnt, XXTermcap.PUTPROC(p)); + END Tputs; + + PROCEDURE InitTermcap; + VAR Bf: STR; + BEGIN + IF GetEnv("TERM", Bf) = 0 THEN + Bf := "dumb"; + END; + IF Tgetent(Bf) <= 0 THEN + END; + END InitTermcap; + +BEGIN + InitTermcap; +END Termcap. diff --git a/lib/ack/libm2/Terminal.mod b/lib/ack/libm2/Terminal.mod new file mode 100755 index 000000000..7a6c0a66f --- /dev/null +++ b/lib/ack/libm2/Terminal.mod @@ -0,0 +1,114 @@ +# +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Terminal; +(* + Module: Input/Output to/from terminals + Author: Ceriel J.H. Jacobs + Version: $Header$ + + Implementation for Unix. +*) + FROM SYSTEM IMPORT ADR; +#ifdef __USG + FROM Unix IMPORT read, write, open, fcntl; +#else + FROM Unix IMPORT read, write, open, ioctl; +#endif + VAR fildes: INTEGER; + unreadch: CHAR; + unread: BOOLEAN; + tty: ARRAY[0..8] OF CHAR; + + PROCEDURE Read(VAR ch: CHAR); + BEGIN + IF unread THEN + ch := unreadch; + unread := FALSE + ELSE + IF read(fildes, ADR(ch), 1) < 0 THEN + ; + END; + END; + unreadch := ch; + END Read; + + PROCEDURE BusyRead(VAR ch: CHAR); + VAR l: INTEGER; + BEGIN + IF unread THEN + ch := unreadch; + unread := FALSE + ELSE +#ifdef __USG + l := fcntl(fildes, (*FGETFL*) 3, 0); + IF fcntl(fildes, + (* FSETFL *) 4, + l + (*ONDELAY*) 2) < 0 THEN + ; + END; + IF read(fildes, ADR(ch), 1) = 0 THEN + ch := 0C; + ELSE + unreadch := ch; + END; + IF fcntl(fildes, (*FSETFL*)4, l) < 0 THEN + ; + END; +#else +#ifdef __BSD4_2 + IF ioctl(fildes, INTEGER(ORD('f')*256+127+4*65536+40000000H), ADR(l)) < 0 THEN +#else + IF ioctl(fildes, INTEGER(ORD('f')*256+127), ADR(l)) < 0 THEN +#endif + ; + END; + + IF l = 0 THEN + ch := 0C; + ELSE + IF read(fildes, ADR(ch), 1) < 0 THEN + ; + END; + unreadch := ch; + END; +#endif + END; + END BusyRead; + + PROCEDURE ReadAgain; + BEGIN + unread := TRUE; + END ReadAgain; + + PROCEDURE Write(ch: CHAR); + BEGIN + IF write(fildes, ADR(ch), 1) < 0 THEN + ; + END; + END Write; + + PROCEDURE WriteLn; + BEGIN + Write(12C); + END WriteLn; + + PROCEDURE WriteString(s: ARRAY OF CHAR); + VAR i: CARDINAL; + BEGIN + i := 0; + WHILE (i <= HIGH(s)) & (s[i] # 0C) DO + Write(s[i]); + INC(i) + END + END WriteString; + +BEGIN + tty := "/dev/tty"; + fildes := open(ADR(tty), 2); + unread := FALSE; +END Terminal. diff --git a/lib/ack/libm2/Traps.mod b/lib/ack/libm2/Traps.mod new file mode 100755 index 000000000..913ee4a8d --- /dev/null +++ b/lib/ack/libm2/Traps.mod @@ -0,0 +1,96 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE Traps; +(* + Module: Facility for handling traps + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + FROM EM IMPORT SIG, LINO, FILN, TRP; + FROM Unix IMPORT write; + FROM SYSTEM IMPORT ADDRESS, ADR; + FROM Arguments IMPORT + Argv; + + PROCEDURE InstallTrapHandler(t: TrapHandler): TrapHandler; + (* Install a new trap handler, and return the previous one. + Parameter of trap handler is the trap number. + *) + BEGIN + RETURN SIG(t); + END InstallTrapHandler; + + PROCEDURE Message(str: ARRAY OF CHAR); + (* Write message "str" on standard error, preceeded by filename and + linenumber if possible + *) + VAR p: POINTER TO CHAR; + l: CARDINAL; + lino: INTEGER; + buf, buf2: ARRAY [0..255] OF CHAR; + i, j: CARDINAL; + BEGIN + p := FILN(); + IF p # NIL THEN + i := 1; + buf[0] := '"'; + WHILE p^ # 0C DO + buf[i] := p^; + INC(i); + p := ADDRESS(p) + 1; + END; + buf[i] := '"'; + INC(i); + IF write(2, ADR(buf), i) < 0 THEN END; + ELSE + l := Argv(0, buf); + IF write(2, ADR(buf), l-1) < 0 THEN END; + END; + lino := LINO(); + i := 0; + IF lino # 0 THEN + i := 7; + buf[0] := ','; buf[1] := ' '; + buf[2] := 'l'; buf[3] := 'i'; buf[4] := 'n'; buf[5] := 'e'; + buf[6] := ' '; + IF lino < 0 THEN + buf[7] := '-'; + i := 8; + lino := - lino; + END; + j := 0; + REPEAT + buf2[j] := CHR(CARDINAL(lino) MOD 10 + ORD('0')); + lino := lino DIV 10; + INC(j); + UNTIL lino = 0; + WHILE j > 0 DO + DEC(j); + buf[i] := buf2[j]; + INC(i); + END; + END; + buf[i] := ':'; + buf[i+1] := ' '; + IF write(2, ADR(buf), i+2) < 0 THEN END; + i := 0; + WHILE (i <= HIGH(str)) AND (str[i] # 0C) DO + INC(i); + END; + IF write(2, ADR(str), i) < 0 THEN END; + buf[0] := 12C; + IF write(2, ADR(buf), 1) < 0 THEN END; + END Message; + + PROCEDURE Trap(n: INTEGER); + (* cause trap number "n" to occur *) + BEGIN + TRP(n); + END Trap; + +END Traps. diff --git a/lib/ack/libm2/XXTermcap.c b/lib/ack/libm2/XXTermcap.c new file mode 100755 index 000000000..56a4f9c77 --- /dev/null +++ b/lib/ack/libm2/XXTermcap.c @@ -0,0 +1,573 @@ +/* + * termcap.c 1.1 20/7/87 agc Joypace Ltd + * + * Copyright Joypace Ltd, London, UK, 1987. All rights reserved. + * This file may be freely distributed provided that this notice + * remains attached. + * + * A public domain implementation of the termcap(3) routines. + * + * Made fully functional by Ceriel J.H. Jacobs. + * + * BUGS: + * - does not check termcap entry sizes + * - not fully tested + */ + +#define CAPABLEN 2 + +#define ISSPACE(c) ((c) == ' ' || (c) == '\t' || (c) == '\r' || (c) == '\n') +#define ISDIGIT(x) ((x) >= '0' && (x) <= '9') + +short ospeed = 0; /* output speed */ +char PC = 0; /* padding character */ +char *BC = 0; /* back cursor movement */ +char *UP = 0; /* up cursor movement */ + +static char *capab = 0; /* the capability itself */ +static int check_for_tc(); +static int match_name(); + +#define NULL 0 + +/* Some things from C-library, needed here because the C-library is not + loaded with Modula-2 programs +*/ + +static char * +strcat(s1, s2) +register char *s1, *s2; +{ + /* Append s2 to the end of s1. */ + + char *original = s1; + + /* Find the end of s1. */ + while (*s1 != 0) s1++; + + /* Now copy s2 to the end of s1. */ + while (*s1++ = *s2++) /* nothing */ ; + return(original); +} + +static char * +strcpy(s1, s2) +register char *s1, *s2; +{ +/* Copy s2 to s1. */ + char *original = s1; + + while (*s1++ = *s2++) /* nothing */; + return(original); +} + +static int +strlen(s) +char *s; +{ +/* Return length of s. */ + + char *original = s; + + while (*s != 0) s++; + return(s - original); +} + +static int +strcmp(s1, s2) +register char *s1, *s2; +{ +/* Compare 2 strings. */ + + for(;;) { + if (*s1 != *s2) { + if (!*s1) return -1; + if (!*s2) return 1; + return(*s1 - *s2); + } + if (*s1++ == 0) return(0); + s2++; + } +} + +static int +strncmp(s1, s2, n) + register char *s1, *s2; + int n; +{ +/* Compare two strings, but at most n characters. */ + + while (n-- > 0) { + if (*s1 != *s2) { + if (!*s1) return -1; + if (!*s2) return 1; + return(*s1 - *s2); + } + if (*s1++ == 0) break; + s2++; + } + return 0; +} + +static char * +getenv(name) +register char *name; +{ + extern char ***_penviron; + register char **v = *_penviron, *p, *q; + + if (v == 0 || name == 0) return 0; + while ((p = *v++) != 0) { + q = name; + while (*q && *q++ == *p++) /* nothing */ ; + if (*q || *p != '=') continue; + return(p+1); + } + return(0); +} + +static char * +fgets(buf, count, fd) + char *buf; +{ + static char bf[1024]; + static int cnt = 0; + static char *pbf = &bf[0]; + register char *c = buf; + + + while (--count) { + if (pbf >= &bf[cnt]) { + if ((cnt = read(fd, bf, 1024)) <= 0) { + if (c == buf) return (char *) NULL; + *c = 0; + return buf; + } + pbf = &bf[0]; + } + *c = *pbf++; + if (*c++ == '\n') { + *c = 0; + return buf; + } + } + *c = 0; + return buf; +} + +/* + * tgetent - get the termcap entry for terminal name, and put it + * in bp (which must be an array of 1024 chars). Returns 1 if + * termcap entry found, 0 if not found, and -1 if file not found. + */ +int +tgetent(bp, name) +char *bp; +char *name; +{ + int fp; + char *file; + char *cp; + short len = strlen(name); + char buf[1024]; + + capab = bp; + if ((file = getenv("TERMCAP")) != (char *) NULL) { + if (*file != '/' && + (cp = getenv("TERM")) != NULL && strcmp(name, cp) == 0) { + (void) strcpy(bp, file); + return(1); + } + else file = "/etc/termcap"; + } else + file = "/etc/termcap"; + if ((fp = open(file, 0)) < 0) { + capab = 0; + return(-1); + } + while (fgets(buf, 1024, fp) != NULL) { + if (buf[0] == '#') continue; + while (*(cp = &buf[strlen(buf) - 2]) == '\\') + if (fgets(cp, 1024, fp) == NULL) + return (0); + if (match_name(buf, name)) { + strcpy(bp, buf); + close(fp); + if(check_for_tc() == 0) { + capab = 0; + return 0; + } + return 1; + } + } + capab = 0; + close(fp); + return(0); +} + +/* + * Compare the terminal name with each termcap entry name; Return 1 if a + * match is found. + */ +static int +match_name(buf, name) + char *buf; + char *name; +{ + register char *tp = buf; + register char *np; + + for (;;) { + for (np = name; *np && *tp == *np; np++, tp++) { } + if (*np == 0 && (*tp == '|' || *tp == ':' || *tp == 0)) + return(1); + while (*tp != 0 && *tp != '|' && *tp != ':') tp++; + if (*tp++ != '|') return (0); + } +} + +/* + * Handle tc= definitions recursively. + */ +static int +check_for_tc() +{ + static int count = 0; + char *savcapab = capab; + char buf[1024]; + char terminalname[128]; + register char *p = capab + strlen(capab) - 2, *q; + + while (*p != ':') + if (--p < capab) + return(0); /* no : in termcap entry */ + if (p[1] != 't' || p[2] != 'c') + return(1); + if (count > 16) { + return(0); /* recursion in tc= definitions */ + } + count++; + strcpy(terminalname, &p[4]); + q = terminalname; + while (*q && *q != ':') q++; + *q = 0; + if (tgetent(buf, terminalname) != 1) { + --count; + return(0); + } + --count; + for (q = buf; *q && *q != ':'; q++) { } + strcpy(p, q); + capab = savcapab; + return(1); +} + +/* + * tgetnum - get the numeric terminal capability corresponding + * to id. Returns the value, -1 if invalid. + */ +int +tgetnum(id) +char *id; +{ + char *cp; + int ret; + + if ((cp = capab) == NULL || id == NULL || *cp == 0) + return(-1); + while (*++cp && *cp != ':') + ; + while (*cp) { + cp++; + while (ISSPACE(*cp)) + cp++; + if (strncmp(cp, id, CAPABLEN) == 0) { + while (*cp && *cp != ':' && *cp != '#') + cp++; + if (*cp != '#') + return(-1); + for (ret = 0, cp++ ; *cp && ISDIGIT(*cp) ; cp++) + ret = ret * 10 + *cp - '0'; + return(ret); + } + while (*cp && *cp != ':') + cp++; + } + return(-1); +} + +/* + * tgetflag - get the boolean flag corresponding to id. Returns -1 + * if invalid, 0 if the flag is not in termcap entry, or 1 if it is + * present. + */ +int +tgetflag(id) +char *id; +{ + char *cp; + + if ((cp = capab) == NULL || id == NULL || *cp == 0) + return(-1); + while (*++cp && *cp != ':') + ; + while (*cp) { + cp++; + while (ISSPACE(*cp)) + cp++; + if (strncmp(cp, id, CAPABLEN) == 0) + return(1); + while (*cp && *cp != ':') + cp++; + } + return(0); +} + +/* + * tgetstr - get the string capability corresponding to id and place + * it in area (advancing area at same time). Expand escape sequences + * etc. Returns the string, or NULL if it can't do it. + */ +char * +tgetstr(id, area) +char *id; +char **area; +{ + char *cp; + char *ret; + int i; + + if ((cp = capab) == NULL || id == NULL || *cp == 0) + return(NULL); + while (*++cp != ':') + ; + while (*cp) { + cp++; + while (ISSPACE(*cp)) + cp++; + if (strncmp(cp, id, CAPABLEN) == 0) { + while (*cp && *cp != ':' && *cp != '=') + cp++; + if (*cp != '=') + return(NULL); + for (ret = *area, cp++; *cp && *cp != ':' ; (*area)++, cp++) + switch(*cp) { + case '^' : + **area = *++cp - 'A' + 1; + break; + case '\\' : + switch(*++cp) { + case 'E' : + **area = '\033'; + break; + case 'n' : + **area = '\n'; + break; + case 'r' : + **area = '\r'; + break; + case 't' : + **area = '\t'; + break; + case 'b' : + **area = '\b'; + break; + case 'f' : + **area = '\f'; + break; + case '0' : + case '1' : + case '2' : + case '3' : + for (i=0 ; *cp && ISDIGIT(*cp) ; cp++) + i = i * 8 + *cp - '0'; + **area = i; + cp--; + break; + case '^' : + case '\\' : + **area = *cp; + break; + } + break; + default : + **area = *cp; + } + *(*area)++ = '\0'; + return(ret); + } + while (*cp && *cp != ':') + cp++; + } + return(NULL); +} + +/* + * tgoto - given the cursor motion string cm, make up the string + * for the cursor to go to (destcol, destline), and return the string. + * Returns "OOPS" if something's gone wrong, or the string otherwise. + */ +char * +tgoto(cm, destcol, destline) +char *cm; +int destcol; +int destline; +{ + register char *rp; + static char ret[32]; + char added[16]; + int *dp = &destline; + int numval; + int swapped = 0; + + added[0] = 0; + for (rp = ret ; *cm ; cm++) { + if (*cm == '%') { + switch(*++cm) { + case '>' : + if (dp == NULL) + return("OOPS"); + cm++; + if (*dp > *cm++) { + *dp += *cm; + } + break; + case '+' : + case '.' : + if (dp == NULL) + return("OOPS"); + if (*cm == '+') *dp = *dp + *++cm; + for (;;) { + switch(*dp) { + case 0: + case 04: + case '\t': + case '\n': + /* filter these out */ + if (dp == &destcol || swapped || UP) { + strcat(added, dp == &destcol || swapped ? + (BC ? BC : "\b") : + UP); + (*dp)++; + continue; + } + } + break; + } + *rp++ = *dp; + dp = (dp == &destline) ? &destcol : NULL; + break; + + case 'r' : { + int tmp = destline; + + destline = destcol; + destcol = tmp; + swapped = 1 - swapped; + break; + } + case 'n' : + destcol ^= 0140; + destline ^= 0140; + break; + + case '%' : + *rp++ = '%'; + break; + + case 'i' : + destcol++; + destline++; + break; + + case 'B' : + if (dp == NULL) + return("OOPS"); + *dp = 16 * (*dp / 10) + *dp % 10; + break; + + case 'D' : + if (dp == NULL) + return("OOPS"); + *dp = *dp - 2 * (*dp % 16); + break; + + case 'd' : + case '2' : + case '3' : + if (dp == NULL) + return("OOPS"); + numval = *dp; + dp = (dp == &destline) ? &destcol : NULL; + if (numval >= 100) { + *rp++ = '0' + numval / 100; + } + else if (*cm == '3') { + *rp++ = ' '; + } + if (numval >= 10) { + *rp++ = '0' + ((numval%100)/10); + } + else if (*cm == '3' || *cm == '2') { + *rp++ = ' '; + } + *rp++ = '0' + (numval%10); + break; + default : + return("OOPS"); + } + } + else *rp++ = *cm; + } + *rp = '\0'; + strcpy(rp, added); + return(ret); +} + +static int tens_of_ms_p_char[] = { /* index as returned by gtty */ + /* assume 10 bits per char */ + 0, 2000, 1333, 909, 743, 666, 500, 333, 166, 83, 55, 41, 20, 10, 5, 2 +}; +/* + * tputs - put the string cp out onto the terminal, using the function + * outc. Also handle padding. + */ +int +tputs(cp, affcnt, outc) +register char *cp; +int affcnt; +int (*outc)(); +{ + int delay = 0; + if (cp == NULL) + return(1); + while (ISDIGIT(*cp)) { + delay = delay * 10 + (*cp++ - '0'); + } + delay *= 10; + if (*cp == '.') { + cp++; + if (ISDIGIT(*cp)) { + delay += *cp++ - '0'; + } + while (ISDIGIT(*cp)) cp++; + } + if (*cp == '*') { + delay *= affcnt; + cp++; + } + while (*cp) + (*outc)(*cp++); + if (delay != 0 && + ospeed > 0 && + ospeed < (sizeof tens_of_ms_p_char / sizeof tens_of_ms_p_char[0])) { + delay = (delay + tens_of_ms_p_char[ospeed] - 1) / + tens_of_ms_p_char[ospeed]; + while (delay--) (*outc)(PC); + } + return(1); +} + +/* + * That's all, folks... + */ diff --git a/lib/ack/libm2/absd.c b/lib/ack/libm2/absd.c new file mode 100755 index 000000000..07aa4d242 --- /dev/null +++ b/lib/ack/libm2/absd.c @@ -0,0 +1,18 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: double abs function + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ +#ifndef NOFLOAT +double +absd(i) + double i; +{ + return i >= 0 ? i : -i; +} +#endif diff --git a/lib/ack/libm2/absf.e b/lib/ack/libm2/absf.e new file mode 100755 index 000000000..c8a9b880a --- /dev/null +++ b/lib/ack/libm2/absf.e @@ -0,0 +1,30 @@ +# +; +; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. +; See the copyright notice in the ACK home directory, in the file "Copyright". +; +; +; Module: REAL abs function +; Author: Ceriel J.H. Jacobs +; Version: $Header$ +; + mes 2,_EM_WSIZE,_EM_PSIZE + exp $absf + pro $absf,0 + mes 5 + mes 9,8 + lal 0 + loi _EM_FSIZE + zrf _EM_FSIZE + cmf _EM_FSIZE + zlt *3 + lal 0 + loi _EM_FSIZE + bra *4 +3 + lal 0 + loi _EM_FSIZE + ngf _EM_FSIZE +4 + ret _EM_FSIZE + end 0 diff --git a/lib/ack/libm2/absi.c b/lib/ack/libm2/absi.c new file mode 100755 index 000000000..6306dbfb9 --- /dev/null +++ b/lib/ack/libm2/absi.c @@ -0,0 +1,15 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: integer abs function + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +absi(i) +{ + return i >= 0 ? i : -i; +} diff --git a/lib/ack/libm2/absl.c b/lib/ack/libm2/absl.c new file mode 100755 index 000000000..27f5ddb0d --- /dev/null +++ b/lib/ack/libm2/absl.c @@ -0,0 +1,16 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: longint abs function + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ +long +absl(i) + long i; +{ + return i >= 0 ? i : -i; +} diff --git a/lib/ack/libm2/blockmove.c b/lib/ack/libm2/blockmove.c new file mode 100755 index 000000000..18f2d3b5c --- /dev/null +++ b/lib/ack/libm2/blockmove.c @@ -0,0 +1,23 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: block moves + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +#if _EM_WSIZE==_EM_PSIZE +typedef unsigned pcnt; +#else +typedef unsigned long pcnt; +#endif + +blockmove(siz, dst, src) + pcnt siz; + register char *dst, *src; +{ + while (siz--) *dst++ = *src++; +} diff --git a/lib/ack/libm2/cap.c b/lib/ack/libm2/cap.c new file mode 100755 index 000000000..28f03b5e3 --- /dev/null +++ b/lib/ack/libm2/cap.c @@ -0,0 +1,18 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: cap; implementation of CAP + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +cap(u) + unsigned u; +{ + register unsigned *p = &u; + + if (*p >= 'a' && *p <= 'z') *p += 'A'-'a'; +} diff --git a/lib/ack/libm2/catch.c b/lib/ack/libm2/catch.c new file mode 100755 index 000000000..378bac1cc --- /dev/null +++ b/lib/ack/libm2/catch.c @@ -0,0 +1,99 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: default modula-2 trap handler + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ +#include +#include +#include + +static struct errm { + int errno; + char *errmes; +} errors[] = { + { EARRAY, "array bound error"}, + { ERANGE, "range bound error"}, + { ESET, "set bound error"}, + { EIOVFL, "integer overflow"}, + { EFOVFL, "real overflow"}, + { EFUNFL, "real underflow"}, + { EIDIVZ, "divide by 0"}, + { EFDIVZ, "divide by 0.0"}, + { EIUND, "undefined integer"}, + { EFUND, "undefined real"}, + { ECONV, "conversion error"}, + + { ESTACK, "stack overflow"}, + { EHEAP, "heap overflow"}, + { EILLINS, "illegal instruction"}, + { EODDZ, "illegal size argument"}, + { ECASE, "case error"}, + { EMEMFLT, "addressing non existent memory"}, + { EBADPTR, "bad pointer used"}, + { EBADPC, "program counter out of range"}, + { EBADLAE, "bad argument of lae"}, + { EBADMON, "bad monitor call"}, + { EBADLIN, "argument if LIN too high"}, + { EBADGTO, "GTO descriptor error"}, + + { M2_TOOLARGE, "stack size of process too large"}, + { M2_TOOMANY, "too many nested traps + handlers"}, + { M2_NORESULT, "no RETURN from function procedure"}, + { M2_UOVFL, "cardinal overflow"}, + { M2_FORCH, "(warning) FOR-loop control variable was changed in the body"}, + { M2_UUVFL, "cardinal underflow"}, + { M2_INTERNAL, "internal error; ask an expert for help"}, + { M2_UNIXSIG, "got a unix signal"}, + { -1, 0} +}; + +catch(trapno) + int trapno; +{ + register struct errm *ep = &errors[0]; + char *errmessage; + char buf[20]; + register char *p, *s; + + while (ep->errno != trapno && ep->errmes != 0) ep++; + if (p = ep->errmes) { + while (*p) p++; + _Traps__Message(ep->errmes, 0, (int) (p - ep->errmes), 1); + } + else { + int i = trapno; + static char q[] = "error number xxxxxxxxxxxxx"; + + p = &q[13]; + s = buf; + if (i < 0) { + i = -i; + *p++ = '-'; + } + do + *s++ = i % 10 + '0'; + while (i /= 10); + while (s > buf) *p++ = *--s; + *p = 0; + _Traps__Message(q, 0, (int) (p - q), 1); + } +#if !defined(__em24) && !defined(__em44) && !defined(__em22) + if (trapno == M2_UNIXSIG) { + extern int __signo; + signal(__signo, SIG_DFL); + _cleanup(); + kill(getpid(), __signo); + _exit(trapno); + } +#endif + if (trapno != M2_FORCH) { + _cleanup(); + _exit(trapno); + } + SIG(catch); +} diff --git a/lib/ack/libm2/confarray.c b/lib/ack/libm2/confarray.c new file mode 100755 index 000000000..d282a270c --- /dev/null +++ b/lib/ack/libm2/confarray.c @@ -0,0 +1,72 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: runtime support for conformant arrays + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ +#include + +#ifndef EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#define EM_PSIZE _EM_PSIZE +#endif + +#if EM_WSIZE==EM_PSIZE +typedef unsigned pcnt; +#else +typedef unsigned long pcnt; +#endif + +struct descr { + char *addr; + int low; + unsigned int highminlow; + unsigned int size; +}; + +static struct descr *descrs[10]; +static struct descr **ppdescr = descrs; + +pcnt +new_stackptr(pdscr, a) + struct descr *pdscr; +{ + register struct descr *pdescr = pdscr; + pcnt size = (((pdescr->highminlow + 1) * pdescr->size + + (EM_WSIZE - 1)) & ~(EM_WSIZE - 1)); + + if (ppdescr >= &descrs[10]) { + /* to many nested traps + handlers ! */ + TRP(M2_TOOMANY); + } + *ppdescr++ = pdescr; + if ((char *) &a - (char *) &pdscr > 0) { + /* stack grows downwards */ + return - size; + } + return size; +} + +copy_array(pp, a) + char *pp; +{ + register char *p = pp; + register char *q; + register pcnt sz; + char dummy; + + ppdescr--; + sz = ((*ppdescr)->highminlow + 1) * (*ppdescr)->size; + + if ((char *) &a - (char *) &pp > 0) { + (*ppdescr)->addr = q = (char *) &a; + } + else (*ppdescr)->addr = q = (char *) &a - + ((sz + (EM_WSIZE - 1)) & ~ (EM_WSIZE - 1)); + + while (sz--) *q++ = *p++; +} diff --git a/lib/ack/libm2/dvi.c b/lib/ack/libm2/dvi.c new file mode 100755 index 000000000..d72076def --- /dev/null +++ b/lib/ack/libm2/dvi.c @@ -0,0 +1,68 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: implementation of DIV and MOD + Author: Ceriel J.H. Jacobs + Version: $Header$ + Reason: We cannot use DVI and RMI, because DVI rounds towards 0 + and Modula-2 requires truncation +*/ + +#include + +int +dvi(j,i) + int j,i; +{ + if (j == 0) TRP(EIDIVZ); + if ((i < 0) != (j < 0)) { + if (i < 0) i = -i; + else j = -j; + return -((i+j-1)/j); + } + else return i/j; +} + +long +dvil(j,i) + long j,i; +{ + if (j == 0) TRP(EIDIVZ); + if ((i < 0) != (j < 0)) { + if (i < 0) i = -i; + else j = -j; + return -((i+j-1)/j); + } + else return i/j; +} + +int +rmi(j,i) + int j,i; +{ + if (j == 0) TRP(EIDIVZ); + if (i == 0) return 0; + if ((i < 0) != (j < 0)) { + if (i < 0) i = -i; + else j = -j; + return j*((i+j-1)/j)-i; + } + else return i%j; +} + +long +rmil(j,i) + long j,i; +{ + if (j == 0) TRP(EIDIVZ); + if (i == 0) return 0L; + if ((i < 0) != (j < 0)) { + if (i < 0) i = -i; + else j = -j; + return j*((i+j-1)/j)-i; + } + else return i%j; +} diff --git a/lib/ack/libm2/halt.c b/lib/ack/libm2/halt.c new file mode 100755 index 000000000..0c257d0db --- /dev/null +++ b/lib/ack/libm2/halt.c @@ -0,0 +1,37 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: program termination routines + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ +#define MAXPROCS 32 + +static int callindex = 0; +static int (*proclist[MAXPROCS])(); + +_cleanup() +{ + while (--callindex >= 0) + (*proclist[callindex])(); + callindex = 0; +} + +CallAtEnd(p) + int (*p)(); +{ + if (callindex >= MAXPROCS) { + return 0; + } + proclist[callindex++] = p; + return 1; +} + +halt() +{ + _cleanup(); + _exit(0); +} diff --git a/lib/ack/libm2/head_m2.e b/lib/ack/libm2/head_m2.e new file mode 100755 index 000000000..6de740921 --- /dev/null +++ b/lib/ack/libm2/head_m2.e @@ -0,0 +1,63 @@ +# +; +; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. +; See the copyright notice in the ACK home directory, in the file "Copyright". +; +; +; Module: Modula-2 runtime startoff +; Author: Ceriel J.H. Jacobs +; Version: $Header$ +; + + mes 2,_EM_WSIZE,_EM_PSIZE + + exa handler + exa argv + exa argc + exa MainLB + exa bkillbss + exp $catch + exp $init + inp $trap_handler + +bkillbss + bss _EM_PSIZE,0,0 + + exp $_m_a_i_n + pro $_m_a_i_n, 0 + + lor 0 + lae MainLB + sti _EM_PSIZE + + lal _EM_WSIZE + loi _EM_PSIZE + lae argv ; save argument pointer + sti _EM_PSIZE + + lol 0 + ste argc ; save argument count + + lpi $trap_handler + sig + asp _EM_PSIZE + cal $init + cal $__M2M_ + cal $halt + loc 0 ; should not get here + ret _EM_WSIZE + end + + pro $trap_handler,0 + lpi $trap_handler + sig + lol 0 ; trap number + lae handler + loi _EM_PSIZE + lpi $catch + lae handler + sti _EM_PSIZE + cai + asp _EM_PSIZE+_EM_WSIZE + rtt + end 0 diff --git a/lib/ack/libm2/init.c b/lib/ack/libm2/init.c new file mode 100755 index 000000000..29a0f3d1b --- /dev/null +++ b/lib/ack/libm2/init.c @@ -0,0 +1,47 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: initialization and some global vars + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +#include +#include +#include + +/* map unix signals onto EM traps */ +init() +{ + sigtrp(M2_UNIXSIG, SIGHUP); + sigtrp(M2_UNIXSIG, SIGINT); + sigtrp(M2_UNIXSIG, SIGQUIT); + sigtrp(EILLINS, SIGILL); + sigtrp(M2_UNIXSIG, SIGTRAP); + sigtrp(M2_UNIXSIG, SIGIOT); + sigtrp(M2_UNIXSIG, SIGEMT); + sigtrp(M2_UNIXSIG, SIGFPE); + sigtrp(M2_UNIXSIG, SIGBUS); + sigtrp(M2_UNIXSIG, SIGSEGV); +#ifdef SIGSYS + sigtrp(EBADMON, SIGSYS); +#endif + sigtrp(M2_UNIXSIG, SIGPIPE); + sigtrp(M2_UNIXSIG, SIGALRM); + sigtrp(M2_UNIXSIG, SIGTERM); +} + +killbss() +{ + /* Fill bss with junk? Make lots of VM pages dirty? No way! */ +} + +extern int catch(); + +int (*handler)() = catch; +char **argv; +int argc; +char *MainLB; diff --git a/lib/ack/libm2/load.c b/lib/ack/libm2/load.c new file mode 100755 index 000000000..3ec6321b2 --- /dev/null +++ b/lib/ack/libm2/load.c @@ -0,0 +1,45 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: get value on stack, byte by byte + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +#include + +#ifndef EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#define EM_PSIZE _EM_PSIZE +#endif + +#if EM_WSIZE==EM_PSIZE +typedef unsigned pcnt; +#else +typedef long pcnt; +#endif + +load(siz, addr, p) + register char *addr; + register pcnt siz; +{ + /* Make sure, that a value with a size that could have been + handled by the LOI instruction ends up at the same place, + where it would, were the LOI instruction used. + */ + register char *q = (char *) &p; + char t[4]; + + if (siz < EM_WSIZE && EM_WSIZE % siz == 0) { + /* as long as EM_WSIZE <= 4 ... */ + if (siz != 2) TRP(M2_INTERNAL); /* internal error */ + q = &t[0]; + } + while (siz--) *q++ = *addr++; + if (q - t == 2) { + *((unsigned *)(&p)) = *((unsigned short *) (&t[0])); + } +} diff --git a/lib/ack/libm2/par_misc.e b/lib/ack/libm2/par_misc.e new file mode 100755 index 000000000..b0e86969e --- /dev/null +++ b/lib/ack/libm2/par_misc.e @@ -0,0 +1,175 @@ +# +; +; (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. +; See the copyright notice in the ACK home directory, in the file "Copyright". +; + +; +; Module: coroutine primitives +; Author: Kees Bot, Edwin Scheffer, Ceriel Jacobs +; Version: $Header$ +; + + mes 2,_EM_WSIZE,_EM_PSIZE + + ; topsize takes care of two things: + ; - given a stack-break, + ; it computes the size of the chunk of memory needed to save the stack; + ; - also, if this stack-break = 0, it creates one, assuming that caller is + ; the stack-break. + ; + ; This implementation assumes a continuous stack growing downwards + + exp $topsize +#ifdef __sparc + inp $topsize2 + pro $topsize, 0 + mes 11 + zer _EM_PSIZE + lal 0 + loi _EM_PSIZE + cal $topsize2 + asp 2*_EM_PSIZE + lfr _EM_WSIZE + ret _EM_WSIZE + end 0 + pro $topsize2, (3*_EM_WSIZE+3*_EM_PSIZE) +#else + pro $topsize, (3*_EM_WSIZE+3*_EM_PSIZE) +#endif + ; local space for line-number, ignoremask, filename, stack-break, size, + ; and stack-pointer (see the topsave routine) + mes 11 + lal 0 + loi _EM_PSIZE + loi _EM_PSIZE ; stack-break or 0 + zer _EM_PSIZE + cmp + zne *1 + lxl 0 + dch ; local base of caller +#ifdef __sparc + dch ; because of the extra layer +#endif + lal 0 + loi _EM_PSIZE + sti _EM_PSIZE +1 + lal 0 + loi _EM_PSIZE + loi _EM_PSIZE + lpb ; convert this local base to an argument base. + ; An implementation of a sort of "topsize" EM + ; instruction should take a local base, and save + ; the whole frame. + + lor 1 ; stack-break SP + sbs _EM_WSIZE ; stack-break-SP + ret _EM_WSIZE ; return size of block to be saved + end 3*_EM_WSIZE+3*_EM_PSIZE + + exp $topsave +#ifdef __sparc + inp $topsave2 + pro $topsave,0 + mes 11 + lal 0 + loi 2*_EM_PSIZE + cal $topsave2 + asp 2*_EM_PSIZE + lfr _EM_WSIZE + ret _EM_WSIZE + end 0 + pro $topsave2,0 +#else + pro $topsave, 0 +#endif + mes 11 + loe 0 + lae 4 ; load line number and file name + loi _EM_PSIZE + lim ; ignore mask + lor 0 ; LB + lal 0 + loi _EM_PSIZE ; stack-break + lpb + lor 1 + sbs _EM_WSIZE + loc _EM_WSIZE + adu _EM_WSIZE ; gives size + dup _EM_WSIZE + stl 0 ; save size + lor 1 ; SP (the SP BEFORE pushing) + lor 1 ; SP (address of stack top to save) + lal _EM_PSIZE ; area + loi _EM_PSIZE + lol 0 ; size + bls _EM_WSIZE ; move whole block + asp 3*_EM_PSIZE+3*_EM_WSIZE ; remove the lot from the stack + loc 1 + ret _EM_WSIZE ; return 1 + end 0 + +sv + bss _EM_PSIZE,0,0 + + exp $topload +#ifdef __sparc + inp $topload1 + pro $topload,0 + lal 0 + loi _EM_PSIZE + cal $topload1 + asp _EM_PSIZE + lfr _EM_WSIZE + ret _EM_WSIZE + end 0 + pro $topload1, 0 +#else + pro $topload, 0 +#endif + mes 11 + + lal 0 + loi _EM_PSIZE + lae sv + sti _EM_PSIZE ; saved parameter + + lxl 0 +2 + dup _EM_PSIZE + adp -3*_EM_PSIZE + lal 0 + loi _EM_PSIZE ; compare target SP with current LB to see if we must + loi _EM_PSIZE + cmp ; find another LB first + zgt *1 + dch ; just follow dynamic chain to make sure we find + ; a legal one + bra *2 +1 + str 0 + + lae sv + loi _EM_PSIZE + loi _EM_PSIZE ; load indirect to + str 1 ; restore SP + asp 0-_EM_PSIZE ; to stop int from complaining about non-existent memory + lae sv + loi _EM_PSIZE ; source address + lor 1 + adp _EM_PSIZE ; destination address + lae sv + loi _EM_PSIZE + adp _EM_PSIZE + loi _EM_WSIZE ; size of block + bls _EM_WSIZE + asp _EM_PSIZE+_EM_WSIZE ; drop size + SP + str 0 ; restore local base + sim ; ignore mask + lae 4 + sti _EM_PSIZE + ste 0 ; line and file + loc 0 + ret _EM_WSIZE + end 0 diff --git a/lib/ack/libm2/random.mod b/lib/ack/libm2/random.mod new file mode 100755 index 000000000..826e99f69 --- /dev/null +++ b/lib/ack/libm2/random.mod @@ -0,0 +1,58 @@ +(* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*) + +(*$R-*) +IMPLEMENTATION MODULE random; +(* + Module: random numbers + Author: Ceriel J.H. Jacobs + Version: $Header$ +*) + + FROM Unix IMPORT getpid, time; + TYPE index = [1..55]; + + VAR X: ARRAY index OF CARDINAL; + j, k: index; + tm: LONGINT; + + PROCEDURE Random(): CARDINAL; + BEGIN + IF k-1 <= 0 THEN k := 55; ELSE DEC(k) END; + IF j-1 <= 0 THEN j := 55; ELSE DEC(j) END; + X[k] := X[k] + X[j]; + RETURN X[k] + END Random; + + PROCEDURE Uniform (lwb, upb: CARDINAL): CARDINAL; + BEGIN + IF upb <= lwb THEN RETURN lwb; END; + RETURN lwb + (Random() MOD (upb - lwb + 1)); + END Uniform; + + PROCEDURE StartSeed(seed: CARDINAL); + VAR v: CARDINAL; + BEGIN + FOR k := 1 TO 55 DO + seed := 1297 * seed + 123; + X[k] := seed; + END; + FOR k := 1 TO 15 DO + j := tm MOD 55D + 1D; + v := X[j]; + tm := tm DIV 7D; + j := tm MOD 55D + 1D; + X[j] := v; + tm := tm * 3D; + END; + k := 1; + j := 25; + END StartSeed; + +BEGIN + tm := time(NIL); + X[1] := tm; + StartSeed(CARDINAL(getpid()) * X[1]); +END random. diff --git a/lib/ack/libm2/rcka.c b/lib/ack/libm2/rcka.c new file mode 100755 index 000000000..6178bd6fb --- /dev/null +++ b/lib/ack/libm2/rcka.c @@ -0,0 +1,25 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * + * Module: range checks for INTEGER, now for array indexing + * Author: Ceriel J.H. Jacobs + * Version: $Header$ +*/ + +#include + +extern TRP(); + +struct array_descr { + int lbound; + int n_elts_min_one; + unsigned size; +}; + +rcka(descr, indx) + struct array_descr *descr; +{ + if (indx < 0 || indx > descr->n_elts_min_one) TRP(EARRAY); +} diff --git a/lib/ack/libm2/rcki.c b/lib/ack/libm2/rcki.c new file mode 100755 index 000000000..289646170 --- /dev/null +++ b/lib/ack/libm2/rcki.c @@ -0,0 +1,23 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * + * Module: range checks for INTEGER + * Author: Ceriel J.H. Jacobs + * Version: $Header$ +*/ + +#include + +extern TRP(); + +struct range_descr { + int low, high; +}; + +rcki(descr, val) + struct range_descr *descr; +{ + if (val < descr->low || val > descr->high) TRP(ERANGE); +} diff --git a/lib/ack/libm2/rckil.c b/lib/ack/libm2/rckil.c new file mode 100755 index 000000000..2c4328d4c --- /dev/null +++ b/lib/ack/libm2/rckil.c @@ -0,0 +1,24 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * + * Module: range checks for LONGINT + * Author: Ceriel J.H. Jacobs + * Version: $Header$ +*/ + +#include + +extern TRP(); + +struct range_descr { + long low, high; +}; + +rckil(descr, val) + struct range_descr *descr; + long val; +{ + if (val < descr->low || val > descr->high) TRP(ERANGE); +} diff --git a/lib/ack/libm2/rcku.c b/lib/ack/libm2/rcku.c new file mode 100755 index 000000000..8dfb3204f --- /dev/null +++ b/lib/ack/libm2/rcku.c @@ -0,0 +1,24 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * + * Module: range checks for CARDINAL + * Author: Ceriel J.H. Jacobs + * Version: $Header$ +*/ + +#include + +extern TRP(); + +struct range_descr { + unsigned low, high; +}; + +rcku(descr, val) + struct range_descr *descr; + unsigned val; +{ + if (val < descr->low || val > descr->high) TRP(ERANGE); +} diff --git a/lib/ack/libm2/rckul.c b/lib/ack/libm2/rckul.c new file mode 100755 index 000000000..86647502c --- /dev/null +++ b/lib/ack/libm2/rckul.c @@ -0,0 +1,24 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * + * Module: range checks for LONGCARD + * Author: Ceriel J.H. Jacobs + * Version: $Header$ +*/ + +#include + +extern TRP(); + +struct range_descr { + unsigned long low, high; +}; + +rckul(descr, val) + struct range_descr *descr; + unsigned long val; +{ + if (val < descr->low || val > descr->high) TRP(ERANGE); +} diff --git a/lib/ack/libm2/sigtrp.c b/lib/ack/libm2/sigtrp.c new file mode 100755 index 000000000..6dc777d69 --- /dev/null +++ b/lib/ack/libm2/sigtrp.c @@ -0,0 +1,82 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: Mapping of Unix signals to EM traps + (only when not using the MON instruction) + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +#if !defined(__em22) && !defined(__em24) && !defined(__em44) + +#define EM_trap(n) TRP(n) /* define to whatever is needed to cause the trap */ + +#include +#include + +int __signo; + +static int __traps[] = { + -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, + -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, + -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, -2, +}; + +static void +__ctchsig(signo) +{ + signal(signo,__ctchsig); +#ifdef __BSD4_2 + sigsetmask(sigblock(0) & ~(1<<(signo - 1))); +#endif + __signo = signo; + EM_trap(__traps[signo]); +} + +int +sigtrp(trapno, signo) +{ + /* Let Unix signal signo cause EM trap trapno to occur. + If trapno = -2, restore default, + If trapno = -3, ignore. + Return old trapnumber. + Careful, this could be -2 or -3; But return value of -1 + indicates failure, with error number in errno. + */ + extern int errno; + void (*ctch)() = __ctchsig; + void (*oldctch)(); + int oldtrap; + + if (signo <= 0 || signo >= sizeof(__traps)/sizeof(__traps[0])) { + errno = EINVAL; + return -1; + } + + if (trapno == -3) + ctch = SIG_IGN; + else if (trapno == -2) + ctch = SIG_DFL; + else if (trapno >= 0 && trapno <= 252) + ; + else { + errno = EINVAL; + return -1; + } + + oldtrap = __traps[signo]; + + if ((oldctch = signal(signo, ctch)) == (void (*)())-1) /* errno set by signal */ + return -1; + + else if (oldctch == SIG_IGN) { + signal(signo, SIG_IGN); + } + else __traps[signo] = trapno; + + return oldtrap; +} +#endif diff --git a/lib/ack/libm2/stackprio.c b/lib/ack/libm2/stackprio.c new file mode 100755 index 000000000..ecd3fee2a --- /dev/null +++ b/lib/ack/libm2/stackprio.c @@ -0,0 +1,27 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: Dummy priority routines + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +static unsigned prio = 0; + +stackprio(n) + unsigned n; +{ + unsigned old = prio; + + if (n > prio) prio = n; + return old; +} + +unstackprio(n) + unsigned n; +{ + prio = n; +} diff --git a/lib/ack/libm2/store.c b/lib/ack/libm2/store.c new file mode 100755 index 000000000..d69aa4023 --- /dev/null +++ b/lib/ack/libm2/store.c @@ -0,0 +1,43 @@ +/* + (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + See the copyright notice in the ACK home directory, in the file "Copyright". +*/ + +/* + Module: store values from stack, byte by byte + Author: Ceriel J.H. Jacobs + Version: $Header$ +*/ + +#include + +#ifndef EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#define EM_PSIZE _EM_PSIZE +#endif + +#if EM_WSIZE==EM_PSIZE +typedef unsigned pcnt; +#else +typedef long pcnt; +#endif + +store(siz, addr, p) + register char *addr; + register pcnt siz; +{ + /* Make sure, that a value with a size that could have been + handled by the LOI instruction is handled as if it was + loaded with the LOI instruction. + */ + register char *q = (char *) &p; + char t[4]; + + if (siz < EM_WSIZE && EM_WSIZE % siz == 0) { + /* as long as EM_WSIZE <= 4 ... */ + if (siz != 2) TRP(M2_INTERNAL); /* internal error */ + *((unsigned short *) (&t[0])) = *((unsigned *) q); + q = &t[0]; + } + while (siz--) *addr++ = *q++; +} diff --git a/lib/ack/libm2/ucheck.c b/lib/ack/libm2/ucheck.c new file mode 100755 index 000000000..411a7ce33 --- /dev/null +++ b/lib/ack/libm2/ucheck.c @@ -0,0 +1,65 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * + * Module: CARDINAL operations with overflow checking + * Author: Ceriel J.H. Jacobs + * Version: $Header$ +*/ + +#ifndef EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#endif +#ifndef EM_LSIZE +#define EM_LSIZE _EM_LSIZE +#endif + +#include + +#define MAXCARD ((unsigned)-1) +#if EM_WSIZE < EM_LSIZE +#define MAXLONGCARD ((unsigned long) -1L) +#endif + +adduchk(a,b) + unsigned a,b; +{ + if (MAXCARD - a < b) TRP(M2_UOVFL); +} + +#if EM_WSIZE < EM_LSIZE +addulchk(a,b) + unsigned long a,b; +{ + if (MAXLONGCARD - a < b) TRP(M2_UOVFL); +} +#endif + +muluchk(a,b) + unsigned a,b; +{ + if (a != 0 && MAXCARD/a < b) TRP(M2_UOVFL); +} + +#if EM_WSIZE < EM_LSIZE +mululchk(a,b) + unsigned long a,b; +{ + if (a != 0 && MAXLONGCARD/a < b) TRP(M2_UOVFL); +} +#endif + +subuchk(a,b) + unsigned a,b; +{ + if (b < a) TRP(M2_UUVFL); +} + +#if EM_WSIZE < EM_LSIZE +subulchk(a,b) + unsigned long a,b; +{ + if (b < a) TRP(M2_UUVFL); +} +#endif diff --git a/lib/ack/libp/Makefile b/lib/ack/libp/Makefile new file mode 100644 index 000000000..6a780d79b --- /dev/null +++ b/lib/ack/libp/Makefile @@ -0,0 +1,83 @@ +# Makefile for lib/ack/libp. + +CFLAGS = -O -I../h -wo +CC1 = $(CC) $(CFLAGS) -c + +LIBRARIES = libp + +libp_OBJECTS = \ + abi.o \ + abl.o \ + abr.o \ + arg.o \ + ass.o \ + asz.o \ + atn.o \ + bcp.o \ + bts.o \ + buff.o \ + catch.o \ + clock.o \ + cls.o \ + cvt.o \ + diag.o \ + dis.o \ + efl.o \ + eln.o \ + encaps.o \ + exp.o \ + fef.o \ + fif.o \ + get.o \ + gto.o \ + head_pc.o \ + hlt.o \ + hol0.o \ + incpt.o \ + ini.o \ + log.o \ + mdi.o \ + mdl.o \ + new.o \ + nfa.o \ + nobuff.o \ + notext.o \ + opn.o \ + outcpt.o \ + pac.o \ + pclose.o \ + pcreat.o \ + pentry.o \ + perrno.o \ + pexit.o \ + popen.o \ + put.o \ + rcka.o \ + rdc.o \ + rdi.o \ + rdl.o \ + rdr.o \ + rf.o \ + rln.o \ + rnd.o \ + sav.o \ + sig.o \ + sin.o \ + sqt.o \ + string.o \ + trap.o \ + trp.o \ + unp.o \ + uread.o \ + uwrite.o \ + wdw.o \ + wf.o \ + wrc.o \ + wrf.o \ + wri.o \ + wrl.o \ + wrr.o \ + wrs.o \ + wrz.o \ + +include ../../Makefile.ack.inc diff --git a/lib/ack/libp/Makefile.ack.conv b/lib/ack/libp/Makefile.ack.conv new file mode 100755 index 000000000..144e80cd4 --- /dev/null +++ b/lib/ack/libp/Makefile.ack.conv @@ -0,0 +1,305 @@ +# Makefile for lib/libp. + +CFLAGS = -O -I$(SRCDIR)/ack/h -wo +CC1 = $(CC) $(CFLAGS) -c + +LIBRARY = ../../libp.a +all: $(LIBRARY) + +OBJECTS = \ + $(LIBRARY)(abi.o) \ + $(LIBRARY)(abl.o) \ + $(LIBRARY)(abr.o) \ + $(LIBRARY)(arg.o) \ + $(LIBRARY)(ass.o) \ + $(LIBRARY)(asz.o) \ + $(LIBRARY)(atn.o) \ + $(LIBRARY)(bcp.o) \ + $(LIBRARY)(bts.o) \ + $(LIBRARY)(buff.o) \ + $(LIBRARY)(catch.o) \ + $(LIBRARY)(clock.o) \ + $(LIBRARY)(cls.o) \ + $(LIBRARY)(cvt.o) \ + $(LIBRARY)(diag.o) \ + $(LIBRARY)(dis.o) \ + $(LIBRARY)(efl.o) \ + $(LIBRARY)(eln.o) \ + $(LIBRARY)(encaps.o) \ + $(LIBRARY)(exp.o) \ + $(LIBRARY)(fef.o) \ + $(LIBRARY)(fif.o) \ + $(LIBRARY)(get.o) \ + $(LIBRARY)(gto.o) \ + $(LIBRARY)(head_pc.o) \ + $(LIBRARY)(hlt.o) \ + $(LIBRARY)(hol0.o) \ + $(LIBRARY)(incpt.o) \ + $(LIBRARY)(ini.o) \ + $(LIBRARY)(log.o) \ + $(LIBRARY)(mdi.o) \ + $(LIBRARY)(mdl.o) \ + $(LIBRARY)(new.o) \ + $(LIBRARY)(nfa.o) \ + $(LIBRARY)(nobuff.o) \ + $(LIBRARY)(notext.o) \ + $(LIBRARY)(opn.o) \ + $(LIBRARY)(outcpt.o) \ + $(LIBRARY)(pac.o) \ + $(LIBRARY)(pclose.o) \ + $(LIBRARY)(pcreat.o) \ + $(LIBRARY)(pentry.o) \ + $(LIBRARY)(perrno.o) \ + $(LIBRARY)(pexit.o) \ + $(LIBRARY)(popen.o) \ + $(LIBRARY)(put.o) \ + $(LIBRARY)(rcka.o) \ + $(LIBRARY)(rdc.o) \ + $(LIBRARY)(rdi.o) \ + $(LIBRARY)(rdl.o) \ + $(LIBRARY)(rdr.o) \ + $(LIBRARY)(rf.o) \ + $(LIBRARY)(rln.o) \ + $(LIBRARY)(rnd.o) \ + $(LIBRARY)(sav.o) \ + $(LIBRARY)(sig.o) \ + $(LIBRARY)(sin.o) \ + $(LIBRARY)(sqt.o) \ + $(LIBRARY)(string.o) \ + $(LIBRARY)(trap.o) \ + $(LIBRARY)(trp.o) \ + $(LIBRARY)(unp.o) \ + $(LIBRARY)(uread.o) \ + $(LIBRARY)(uwrite.o) \ + $(LIBRARY)(wdw.o) \ + $(LIBRARY)(wf.o) \ + $(LIBRARY)(wrc.o) \ + $(LIBRARY)(wrf.o) \ + $(LIBRARY)(wri.o) \ + $(LIBRARY)(wrl.o) \ + $(LIBRARY)(wrr.o) \ + $(LIBRARY)(wrs.o) \ + $(LIBRARY)(wrz.o) \ + +$(LIBRARY): $(OBJECTS) + aal cr $@ *.o + rm *.o + +$(LIBRARY)(abi.o): abi.c + $(CC1) abi.c + +$(LIBRARY)(abl.o): abl.c + $(CC1) abl.c + +$(LIBRARY)(abr.o): abr.c + $(CC1) abr.c + +$(LIBRARY)(arg.o): arg.c + $(CC1) arg.c + +$(LIBRARY)(ass.o): ass.c + $(CC1) ass.c + +$(LIBRARY)(asz.o): asz.c + $(CC1) asz.c + +$(LIBRARY)(atn.o): atn.c + $(CC1) atn.c + +$(LIBRARY)(bcp.o): bcp.c + $(CC1) bcp.c + +$(LIBRARY)(bts.o): bts.e + $(CC1) bts.e + +$(LIBRARY)(buff.o): buff.c + $(CC1) buff.c + +$(LIBRARY)(catch.o): catch.c + $(CC1) catch.c + +$(LIBRARY)(clock.o): clock.c + $(CC1) clock.c + +$(LIBRARY)(cls.o): cls.c + $(CC1) cls.c + +$(LIBRARY)(cvt.o): cvt.c + $(CC1) cvt.c + +$(LIBRARY)(diag.o): diag.c + $(CC1) diag.c + +$(LIBRARY)(dis.o): dis.c + $(CC1) dis.c + +$(LIBRARY)(efl.o): efl.c + $(CC1) efl.c + +$(LIBRARY)(eln.o): eln.c + $(CC1) eln.c + +$(LIBRARY)(encaps.o): encaps.e + $(CC1) encaps.e + +$(LIBRARY)(exp.o): exp.c + $(CC1) exp.c + +$(LIBRARY)(fef.o): fef.e + $(CC1) fef.e + +$(LIBRARY)(fif.o): fif.e + $(CC1) fif.e + +$(LIBRARY)(get.o): get.c + $(CC1) get.c + +$(LIBRARY)(gto.o): gto.e + $(CC1) gto.e + +$(LIBRARY)(head_pc.o): head_pc.e + $(CC1) head_pc.e + +$(LIBRARY)(hlt.o): hlt.c + $(CC1) hlt.c + +$(LIBRARY)(hol0.o): hol0.e + $(CC1) hol0.e + +$(LIBRARY)(incpt.o): incpt.c + $(CC1) incpt.c + +$(LIBRARY)(ini.o): ini.c + $(CC1) ini.c + +$(LIBRARY)(log.o): log.c + $(CC1) log.c + +$(LIBRARY)(mdi.o): mdi.c + $(CC1) mdi.c + +$(LIBRARY)(mdl.o): mdl.c + $(CC1) mdl.c + +$(LIBRARY)(new.o): new.c + $(CC1) new.c + +$(LIBRARY)(nfa.o): nfa.c + $(CC1) nfa.c + +$(LIBRARY)(nobuff.o): nobuff.c + $(CC1) nobuff.c + +$(LIBRARY)(notext.o): notext.c + $(CC1) notext.c + +$(LIBRARY)(opn.o): opn.c + $(CC1) opn.c + +$(LIBRARY)(outcpt.o): outcpt.c + $(CC1) outcpt.c + +$(LIBRARY)(pac.o): pac.c + $(CC1) pac.c + +$(LIBRARY)(pclose.o): pclose.c + $(CC1) pclose.c + +$(LIBRARY)(pcreat.o): pcreat.c + $(CC1) pcreat.c + +$(LIBRARY)(pentry.o): pentry.c + $(CC1) pentry.c + +$(LIBRARY)(perrno.o): perrno.c + $(CC1) perrno.c + +$(LIBRARY)(pexit.o): pexit.c + $(CC1) pexit.c + +$(LIBRARY)(popen.o): popen.c + $(CC1) popen.c + +$(LIBRARY)(put.o): put.c + $(CC1) put.c + +$(LIBRARY)(rcka.o): rcka.c + $(CC1) rcka.c + +$(LIBRARY)(rdc.o): rdc.c + $(CC1) rdc.c + +$(LIBRARY)(rdi.o): rdi.c + $(CC1) rdi.c + +$(LIBRARY)(rdl.o): rdl.c + $(CC1) rdl.c + +$(LIBRARY)(rdr.o): rdr.c + $(CC1) rdr.c + +$(LIBRARY)(rf.o): rf.c + $(CC1) rf.c + +$(LIBRARY)(rln.o): rln.c + $(CC1) rln.c + +$(LIBRARY)(rnd.o): rnd.c + $(CC1) rnd.c + +$(LIBRARY)(sav.o): sav.e + $(CC1) sav.e + +$(LIBRARY)(sig.o): sig.e + $(CC1) sig.e + +$(LIBRARY)(sin.o): sin.c + $(CC1) sin.c + +$(LIBRARY)(sqt.o): sqt.c + $(CC1) sqt.c + +$(LIBRARY)(string.o): string.c + $(CC1) string.c + +$(LIBRARY)(trap.o): trap.e + $(CC1) trap.e + +$(LIBRARY)(trp.o): trp.e + $(CC1) trp.e + +$(LIBRARY)(unp.o): unp.c + $(CC1) unp.c + +$(LIBRARY)(uread.o): uread.c + $(CC1) uread.c + +$(LIBRARY)(uwrite.o): uwrite.c + $(CC1) uwrite.c + +$(LIBRARY)(wdw.o): wdw.c + $(CC1) wdw.c + +$(LIBRARY)(wf.o): wf.c + $(CC1) wf.c + +$(LIBRARY)(wrc.o): wrc.c + $(CC1) wrc.c + +$(LIBRARY)(wrf.o): wrf.c + $(CC1) wrf.c + +$(LIBRARY)(wri.o): wri.c + $(CC1) wri.c + +$(LIBRARY)(wrl.o): wrl.c + $(CC1) wrl.c + +$(LIBRARY)(wrr.o): wrr.c + $(CC1) wrr.c + +$(LIBRARY)(wrs.o): wrs.c + $(CC1) wrs.c + +$(LIBRARY)(wrz.o): wrz.c + $(CC1) wrz.c diff --git a/lib/ack/libp/abi.c b/lib/ack/libp/abi.c new file mode 100755 index 000000000..abfe4e9be --- /dev/null +++ b/lib/ack/libp/abi.c @@ -0,0 +1,23 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +int _abi(i) int i; { + return(i>=0 ? i : -i); +} diff --git a/lib/ack/libp/abl.c b/lib/ack/libp/abl.c new file mode 100755 index 000000000..9ffbfbe96 --- /dev/null +++ b/lib/ack/libp/abl.c @@ -0,0 +1,23 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +long _abl(i) long i; { + return(i>=0 ? i : -i); +} diff --git a/lib/ack/libp/abr.c b/lib/ack/libp/abr.c new file mode 100755 index 000000000..9a8c0bdfd --- /dev/null +++ b/lib/ack/libp/abr.c @@ -0,0 +1,23 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +double _abr(r) double r; { + return(r>=0 ? r : -r); +} diff --git a/lib/ack/libp/arg.c b/lib/ack/libp/arg.c new file mode 100755 index 000000000..fdbf14c3f --- /dev/null +++ b/lib/ack/libp/arg.c @@ -0,0 +1,56 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +/* function argc:integer; extern; */ +/* function argv(i:integer):string; extern; */ +/* procedure argshift; extern; */ +/* function environ(i:integer):string; extern; */ + +extern int _pargc; +extern char **_pargv; +extern char ***_penviron; + +int argc() { + return(_pargc); +} + +char *argv(i) { + if (i >= _pargc) + return(0); + return(_pargv[i]); +} + +argshift() { + + if (_pargc > 1) { + --_pargc; + _pargv++; + } +} + +char *environ(i) { + char **p; char *q; + + if (p = *_penviron) + while (q = *p++) + if (i-- < 0) + return(q); + return(0); +} diff --git a/lib/ack/libp/ass.c b/lib/ack/libp/ass.c new file mode 100755 index 000000000..8522d9426 --- /dev/null +++ b/lib/ack/libp/ass.c @@ -0,0 +1,33 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern char *_hol0(); +extern _trp(); + +_ass(line,bool) int line,bool; { + + if (bool==0) { + LINO = line; + _trp(EASS); + } +} diff --git a/lib/ack/libp/asz.c b/lib/ack/libp/asz.c new file mode 100755 index 000000000..271b882da --- /dev/null +++ b/lib/ack/libp/asz.c @@ -0,0 +1,29 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +struct descr { + int low; + int diff; + int size; +}; + +int _asz(dp) struct descr *dp; { + return(dp->size * (dp->diff + 1)); +} diff --git a/lib/ack/libp/atn.c b/lib/ack/libp/atn.c new file mode 100755 index 000000000..320c18923 --- /dev/null +++ b/lib/ack/libp/atn.c @@ -0,0 +1,72 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* $Header$ */ + +#define __NO_DEFS +#include + +#if __STDC__ +#include +#endif + +double +_atn(x) + double x; +{ + /* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + */ + + static double p[] = { + -0.13688768894191926929e+2, + -0.20505855195861651981e+2, + -0.84946240351320683534e+1, + -0.83758299368150059274e+0 + }; + static double q[] = { + 0.41066306682575781263e+2, + 0.86157349597130242515e+2, + 0.59578436142597344465e+2, + 0.15024001160028576121e+2, + 1.0 + }; + static double a[] = { + 0.0, + 0.52359877559829887307710723554658381, /* pi/6 */ + M_PI_2, + 1.04719755119659774615421446109316763 /* pi/3 */ + }; + + int neg = x < 0; + int n; + double g; + + if (neg) { + x = -x; + } + if (x > 1.0) { + x = 1.0/x; + n = 2; + } + else n = 0; + + if (x > 0.26794919243112270647) { /* 2-sqtr(3) */ + n = n + 1; + x = (((0.73205080756887729353*x-0.5)-0.5)+x)/ + (1.73205080756887729353+x); + } + + /* ??? avoid underflow ??? */ + + g = x * x; + x += x * g * POLYNOM3(g, p) / POLYNOM4(g, q); + if (n > 1) x = -x; + x += a[n]; + return neg ? -x : x; +} diff --git a/lib/ack/libp/bcp.c b/lib/ack/libp/bcp.c new file mode 100755 index 000000000..ef8edf605 --- /dev/null +++ b/lib/ack/libp/bcp.c @@ -0,0 +1,30 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +int _bcp(sz,y,x) int sz; unsigned char *y,*x; { + + while (--sz >= 0) { + if (*x < *y) + return(-1); + if (*x++ > *y++) + return(1); + } + return(0); +} diff --git a/lib/ack/libp/bts.e b/lib/ack/libp/bts.e new file mode 100755 index 000000000..adb57f360 --- /dev/null +++ b/lib/ack/libp/bts.e @@ -0,0 +1,56 @@ +# +; $Header$ +; +; (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 +; +; + +; Author: J.W. Stevenson */ + + mes 2,_EM_WSIZE,_EM_PSIZE + +#define SIZE 0 +#define HIGH _EM_WSIZE +#define LOWB 2*_EM_WSIZE +#define BASE 3*_EM_WSIZE + +; _bts is called with four parameters: +; - the initial set (BASE) +; - low bound of range of bits (LOWB) +; - high bound of range of bits (HIGH) +; - set size in bytes (SIZE) + + exp $_bts + pro $_bts,0 + lal BASE ; address of initial set + lol SIZE + los _EM_WSIZE ; load initial set +1 + lol LOWB ; low bound + lol HIGH ; high bound + bgt *2 ; while low <= high + lol LOWB + lol SIZE + set ? ; create [low] + lol SIZE + ior ? ; merge with initial set + inl LOWB ; increment low bound + bra *1 ; loop back +2 + lal BASE + lol SIZE + sts _EM_WSIZE ; store result over initial set + ret 0 + end ? diff --git a/lib/ack/libp/buff.c b/lib/ack/libp/buff.c new file mode 100755 index 000000000..471025c48 --- /dev/null +++ b/lib/ack/libp/buff.c @@ -0,0 +1,35 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern _flush(); + +/* procedure buff(var f:file of ?); */ + +buff(f) struct file *f; { + int sz; + + if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT)) + return; + _flush(f); + sz = f->size; + f->count = f->buflen = (sz>PC_BUFLEN ? sz : PC_BUFLEN-PC_BUFLEN%sz); +} diff --git a/lib/ack/libp/catch.c b/lib/ack/libp/catch.c new file mode 100755 index 000000000..204a8a1cf --- /dev/null +++ b/lib/ack/libp/catch.c @@ -0,0 +1,154 @@ +/* $Header$ */ +/* + * (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 +#include +#include + +/* to make it easier to patch ... */ +extern struct file *_curfil; + +static struct errm { + int errno; + char *errmes; +} errors[] = { + { EARRAY, "array bound error"}, + { ERANGE, "range bound error"}, + { ESET, "set bound error"}, + { EIOVFL, "integer overflow"}, + { EFOVFL, "real overflow"}, + { EFUNFL, "real underflow"}, + { EIDIVZ, "divide by 0"}, + { EFDIVZ, "divide by 0.0"}, + { EIUND, "undefined integer"}, + { EFUND, "undefined real"}, + { ECONV, "conversion error"}, + + { ESTACK, "stack overflow"}, + { EHEAP, "heap overflow"}, + { EILLINS, "illegal instruction"}, + { EODDZ, "illegal size argument"}, + { ECASE, "case error"}, + { EMEMFLT, "addressing non existent memory"}, + { EBADPTR, "bad pointer used"}, + { EBADPC, "program counter out of range"}, + { EBADLAE, "bad argument of lae"}, + { EBADMON, "bad monitor call"}, + { EBADLIN, "argument if LIN too high"}, + { EBADGTO, "GTO descriptor error"}, + + { EARGC, "more args expected" }, + { EEXP, "error in exp" }, + { ELOG, "error in ln" }, + { ESQT, "error in sqrt" }, + { EASS, "assertion failed" }, + { EPACK, "array bound error in pack" }, + { EUNPACK, "array bound error in unpack" }, + { EMOD, "only positive j in 'i mod j'" }, + { EBADF, "file not yet open" }, + { EFREE, "dispose error" }, + { EFUNASS, "function not assigned" }, + { EWIDTH, "illegal field width" }, + + { EWRITEF, "not writable" }, + { EREADF, "not readable" }, + { EEOF, "end of file" }, + { EFTRUNC, "truncated" }, + { ERESET, "reset error" }, + { EREWR, "rewrite error" }, + { ECLOSE, "close error" }, + { EREAD, "read error" }, + { EWRITE, "write error" }, + { EDIGIT, "digit expected" }, + { EASCII, "non-ASCII char read" }, + { -1, 0} +}; + +extern int _pargc; +extern char **_pargv; +extern char ***_penviron; + +extern char *_hol0(); +extern _trp(); +extern _exit(); +extern int _write(); + +_catch(erno) unsigned erno; { + register struct errm *ep = &errors[0]; + char *p,*q,*s,**qq; + char buf[20]; + unsigned i; + int j = erno; + char *pp[11]; + char xbuf[100]; + + qq = pp; + if (p = FILN) + *qq++ = p; + else + *qq++ = _pargv[0]; + + while (ep->errno != erno && ep->errmes != 0) ep++; + p = buf; + s = xbuf; + if (i = LINO) { + *qq++ = ", "; + do + *p++ = i % 10 + '0'; + while (i /= 10); + while (p > buf) *s++ = *--p; + } + *s++ = ':'; + *s++ = ' '; + *s++ = '\0'; + *qq++ = xbuf; + if ((erno & ~037) == 0140 && (_curfil->flags&0377)==MAGIC) { + /* file error */ + *qq++ = "file "; + *qq++ = _curfil->fname; + *qq++ = ": "; + } + if (ep->errmes) *qq++ = ep->errmes; + else { + *qq++ = "error number "; + *qq++ = s; + p = buf; + if (j < 0) { + j = -j; + *s++ = '-'; + } + do + *p++ = j % 10 + '0'; + while (j /= 10); + while (p > buf) *s++ = *--p; + *s = 0; + } + *qq++ = "\n"; + *qq = 0; + qq = pp; + while (q = *qq++) { + p = q; + while (*p) + p++; + if (_write(2,q,(int)(p-q)) < 0) + ; + } + _exit(erno); +error: + _trp(erno); +} diff --git a/lib/ack/libp/clock.c b/lib/ack/libp/clock.c new file mode 100755 index 000000000..f5847696a --- /dev/null +++ b/lib/ack/libp/clock.c @@ -0,0 +1,47 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +/* function clock:integer; extern; */ + +extern int _times(); + +struct tbuf { + long utime; + long stime; + long cutime; + long cstime; +}; + +#ifndef EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#endif + +int clock() { + struct tbuf t; + + _times(&t); + return( (int)(t.utime + t.stime) & +#if EM_WSIZE <= 2 + 077777 +#else + 0x7fffffffL +#endif + ); +} diff --git a/lib/ack/libp/cls.c b/lib/ack/libp/cls.c new file mode 100755 index 000000000..f891a3658 --- /dev/null +++ b/lib/ack/libp/cls.c @@ -0,0 +1,67 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern struct file *_curfil; +extern _trp(); +extern _flush(); +extern _outcpt(); +extern int _close(); + +_xcls(f) struct file *f; { + + if ((f->flags & WRBIT) == 0) + return; + if ((f->flags & (TXTBIT|ELNBIT)) == TXTBIT) { +#ifdef CPM + *f->ptr = '\r'; + _outcpt(f); +#endif + *f->ptr = '\n'; + _outcpt(f); + } + _flush(f); +} + +_cls(f) struct file *f; { +#ifdef MAYBE + char *p; +#endif + + _curfil = f; + if ((f->flags&0377) != MAGIC) + return; +#ifdef MAYBE + p = f->bufadr; + if (f->ptr < p) + return; + if (f->buflen <= 0) + return; + p += f->buflen; + if (f->ptr >= p) + return; +#endif + _xcls(f); + if (_close(f->ufd) != 0) + _trp(ECLOSE); + f->flags = 0; +} diff --git a/lib/ack/libp/cvt.c b/lib/ack/libp/cvt.c new file mode 100755 index 000000000..d3c2116dc --- /dev/null +++ b/lib/ack/libp/cvt.c @@ -0,0 +1,119 @@ +/* $Header$ */ +#ifndef NOFLOAT + +#if __STDC__ +#include +#else +#include +#define DBL_MAX M_MAX_D +#endif + +static char *cvt(); +#define NDIGITS 128 + +char * +_ecvt(value, ndigit, decpt, sign) + double value; + int ndigit, *decpt, *sign; +{ + return cvt(value, ndigit, decpt, sign, 1); +} + +char * +_fcvt(value, ndigit, decpt, sign) + double value; + int ndigit, *decpt, *sign; +{ + return cvt(value, ndigit, decpt, sign, 0); +} + +static struct powers_of_10 { + double pval; + double rpval; + int exp; +} p10[] = { + 1.0e32, 1.0e-32, 32, + 1.0e16, 1.0e-16, 16, + 1.0e8, 1.0e-8, 8, + 1.0e4, 1.0e-4, 4, + 1.0e2, 1.0e-2, 2, + 1.0e1, 1.0e-1, 1, + 1.0e0, 1.0e0, 0 +}; + +static char * +cvt(value, ndigit, decpt, sign, ecvtflag) + double value; + int ndigit, *decpt, *sign; +{ + static char buf[NDIGITS+1]; + register char *p = buf; + register char *pe; + + if (ndigit < 0) ndigit = 0; + if (ndigit > NDIGITS) ndigit = NDIGITS; + pe = &buf[ndigit]; + buf[0] = '\0'; + + *sign = 0; + if (value < 0) { + *sign = 1; + value = -value; + } + + *decpt = 0; + if (value >= DBL_MAX) { + value = DBL_MAX; + } + if (value != 0.0) { + register struct powers_of_10 *pp = &p10[0]; + + if (value >= 10.0) do { + while (value >= pp->pval) { + value *= pp->rpval; + *decpt += pp->exp; + } + } while ((++pp)->exp > 0); + + pp = &p10[0]; + if (value < 1.0) do { + while (value * pp->pval < 10.0) { + value *= pp->pval; + *decpt -= pp->exp; + } + } while ((++pp)->exp > 0); + + (*decpt)++; /* because now value in [1.0, 10.0) */ + } + if (! ecvtflag) { + /* for fcvt() we need ndigit digits behind the dot */ + pe += *decpt; + if (pe > &buf[NDIGITS]) pe = &buf[NDIGITS]; + } + while (p <= pe) { + *p++ = (int)value + '0'; + value = 10.0 * (value - (int)value); + } + if (pe >= buf) { + p = pe; + *p += 5; /* round of at the end */ + while (*p > '9') { + *p = '0'; + if (p > buf) ++*--p; + else { + *p = '1'; + ++*decpt; + if (! ecvtflag) { + /* maybe add another digit at the end, + because the point was shifted right + */ + if (pe > buf) *pe = '0'; + pe++; + } + } + } + *pe = '\0'; + } + return buf; +} +#endif diff --git a/lib/ack/libp/diag.c b/lib/ack/libp/diag.c new file mode 100755 index 000000000..ea16c0b7d --- /dev/null +++ b/lib/ack/libp/diag.c @@ -0,0 +1,34 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +/* procedure diag(var f:text); */ + +diag(f) struct file *f; { + + f->ptr = f->bufadr; + f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC; + f->fname = "DIAG"; + f->ufd = 2; + f->size = 1; + f->count = 1; + f->buflen = 1; +} diff --git a/lib/ack/libp/dis.c b/lib/ack/libp/dis.c new file mode 100755 index 000000000..7d8c738e2 --- /dev/null +++ b/lib/ack/libp/dis.c @@ -0,0 +1,87 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +#define assert() /* nothing */ + +/* + * use circular list of free blocks from low to high addresses + * _highp points to free block with highest address + */ +struct adm { + struct adm *next; + int size; +}; + +extern struct adm *_lastp; +extern struct adm *_highp; +extern _trp(); + +static int merge(p1,p2) struct adm *p1,*p2; { + struct adm *p; + + p = (struct adm *)((char *)p1 + p1->size); + if (p > p2) + _trp(EFREE); + if (p != p2) + return(0); + p1->size += p2->size; + p1->next = p2->next; + return(1); +} + +_dis(n,pp) int n; struct adm **pp; { + struct adm *p1,*p2; + + /* + * NOTE: dispose only objects whose size is a multiple of sizeof(*pp). + * this is always true for objects allocated by _new() + */ + n = ((n+sizeof(*p1)-1) / sizeof(*p1)) * sizeof(*p1); + if (n == 0) + return; + if ((p1= *pp) == (struct adm *) 0) + _trp(EFREE); + p1->size = n; + if ((p2 = _highp) == 0) /*p1 is the only free block*/ + p1->next = p1; + else { + if (p2 > p1) { + /*search for the preceding free block*/ + if (_lastp < p1) /*reduce search*/ + p2 = _lastp; + while (p2->next < p1) + p2 = p2->next; + } + /* if p2 preceeds p1 in the circular list, + * try to merge them */ + p1->next = p2->next; p2->next = p1; + if (p2 <= p1 && merge(p2,p1)) + p1 = p2; + p2 = p1->next; + /* p1 preceeds p2 in the circular list */ + if (p2 > p1) merge(p1,p2); + } + if (p1 >= p1->next) + _highp = p1; + _lastp = p1; + *pp = (struct adm *) 0; +} diff --git a/lib/ack/libp/efl.c b/lib/ack/libp/efl.c new file mode 100755 index 000000000..888de603a --- /dev/null +++ b/lib/ack/libp/efl.c @@ -0,0 +1,36 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern struct file *_curfil; +extern _trp(); +extern _incpt(); + +int _efl(f) struct file *f; { + + _curfil = f; + if ((f->flags & 0377) != MAGIC) + _trp(EBADF); + if ((f->flags & (WINDOW|WRBIT|EOFBIT)) == 0) + _incpt(f); + return((f->flags & EOFBIT) != 0); +} diff --git a/lib/ack/libp/eln.c b/lib/ack/libp/eln.c new file mode 100755 index 000000000..08be0a547 --- /dev/null +++ b/lib/ack/libp/eln.c @@ -0,0 +1,33 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _trp(); +extern _rf(); + +int _eln(f) struct file *f; { + + _rf(f); + if (f->flags & EOFBIT) + _trp(EEOF); + return((f->flags & ELNBIT) != 0); +} diff --git a/lib/ack/libp/encaps.e b/lib/ack/libp/encaps.e new file mode 100755 index 000000000..43557e904 --- /dev/null +++ b/lib/ack/libp/encaps.e @@ -0,0 +1,144 @@ +# + + +; $Header$ +; (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 +; + + mes 2,_EM_WSIZE,_EM_PSIZE + +; procedure encaps(procedure p; procedure(q(n:integer)); +; {call q if a trap occurs during the execution of p} +; {if q returns, continue execution of p} + + + inp $handler + +#define PIISZ 2*_EM_PSIZE + +#define PARG 0 +#define QARG PIISZ +#define E_ELB 0-_EM_PSIZE +#define E_EHA -2*_EM_PSIZE + +; encaps is called with two parameters: +; - procedure instance identifier of q (QARG) +; - procedure instance identifier of p (PARG) +; and two local variables: +; - the lb of the previous encaps (E_ELB) +; - the procedure identifier of the previous handler (E_EHA) +; +; One static variable: +; - the lb of the currently active encaps (enc_lb) + +enc_lb + bss _EM_PSIZE,0,0 + + exp $encaps + pro $encaps,PIISZ + ; save lb of previous encaps + lae enc_lb + loi _EM_PSIZE + lal E_ELB + sti _EM_PSIZE + ; set new lb + lxl 0 + lae enc_lb + sti _EM_PSIZE + ; save old handler id while setting up the new handler + lpi $handler + sig + lal E_EHA + sti _EM_PSIZE + ; handler is ready, p can be called + ; p doesn't expect parameters except possibly the static link + ; always passing the link won't hurt + lal PARG + loi PIISZ + cai + asp _EM_PSIZE + ; reinstate old handler + lal E_ELB + loi _EM_PSIZE + lae enc_lb + sti _EM_PSIZE + lal E_EHA + loi _EM_PSIZE + sig + asp _EM_PSIZE + ret 0 + end ? + +#define TRAP 0 +#define H_ELB 0-_EM_PSIZE + +; handler is called with one parameter: +; - trap number (TRAP) +; one local variable +; - the current LB of the enclosing encaps (H_ELB) + + + pro $handler,_EM_PSIZE + ; save LB of nearest encaps + lae enc_lb + loi _EM_PSIZE + lal H_ELB + sti _EM_PSIZE + ; fetch setting for previous encaps via LB of nearest + lal H_ELB + loi _EM_PSIZE + adp E_ELB + loi _EM_PSIZE ; LB of previous encaps + lae enc_lb + sti _EM_PSIZE + lal H_ELB + loi _EM_PSIZE + adp E_EHA + loi _EM_PSIZE ; previous handler + sig + asp _EM_PSIZE + ; previous handler is re-instated, time to call Q + lol TRAP ; the one and only real parameter + lal H_ELB + loi _EM_PSIZE + lpb ; argument base of enclosing encaps + adp QARG + loi PIISZ + exg _EM_PSIZE + dup _EM_PSIZE ; The static link is now on top + zer _EM_PSIZE + cmp + zeq *1 + ; non-zero LB + exg _EM_PSIZE + cai + asp _EM_WSIZE+_EM_PSIZE + bra *2 +1 + ; zero LB + asp _EM_PSIZE + cai + asp _EM_WSIZE +2 + ; now reinstate handler for continued execution of p + lal H_ELB + loi _EM_PSIZE + lae enc_lb + sti _EM_PSIZE + lpi $handler + sig + asp _EM_PSIZE + rtt + end ? diff --git a/lib/ack/libp/exp.c b/lib/ack/libp/exp.c new file mode 100755 index 000000000..f1f78498a --- /dev/null +++ b/lib/ack/libp/exp.c @@ -0,0 +1,118 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* $Header$ */ +#define __NO_DEFS +#include +#include +extern _trp(); + +#if __STDC__ +#include +#include +#define M_MIN_D DBL_MIN +#define M_MAX_D DBL_MAX +#define M_DMINEXP DBL_MIN_EXP +#endif +#undef HUGE +#define HUGE 1e1000 + +static double +Ldexp(fl,exp) + double fl; + int exp; +{ + extern double _fef(); + int sign = 1; + int currexp; + + if (fl<0) { + fl = -fl; + sign = -1; + } + fl = _fef(fl,&currexp); + exp += currexp; + if (exp > 0) { + while (exp>30) { + fl *= (double) (1L << 30); + exp -= 30; + } + fl *= (double) (1L << exp); + } + else { + while (exp<-30) { + fl /= (double) (1L << 30); + exp += 30; + } + fl /= (double) (1L << -exp); + } + return sign * fl; +} + +double +_exp(x) + double x; +{ + /* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + */ + + static double p[] = { + 0.25000000000000000000e+0, + 0.75753180159422776666e-2, + 0.31555192765684646356e-4 + }; + + static double q[] = { + 0.50000000000000000000e+0, + 0.56817302698551221787e-1, + 0.63121894374398503557e-3, + 0.75104028399870046114e-6 + }; + double xn, g; + int n; + int negative = x < 0; + + if (x <= M_LN_MIN_D) { + g = M_MIN_D/4.0; + + if (g != 0.0) { + /* unnormalized numbers apparently exist */ + if (x < (M_LN2 * (M_DMINEXP - 53))) return 0.0; + } + else { + if (x < M_LN_MIN_D) return 0.0; + return M_MIN_D; + } + } + if (x >= M_LN_MAX_D) { + if (x > M_LN_MAX_D) { + _trp(EEXP); + return HUGE; + } + return M_MAX_D; + } + if (negative) x = -x; + + n = x * M_LOG2E + 0.5; /* 1/ln(2) = log2(e), 0.5 added for rounding */ + xn = n; + { + double x1 = (long) x; + double x2 = x - x1; + + g = ((x1-xn*0.693359375)+x2) - xn*(-2.1219444005469058277e-4); + } + if (negative) { + g = -g; + n = -n; + } + xn = g * g; + x = g * POLYNOM2(xn, p); + n += 1; + return (Ldexp(0.5 + x/(POLYNOM3(xn, q) - x), n)); +} diff --git a/lib/ack/libp/fef.e b/lib/ack/libp/fef.e new file mode 100755 index 000000000..0caaedcd6 --- /dev/null +++ b/lib/ack/libp/fef.e @@ -0,0 +1,39 @@ +# +; $Header$ +; +; (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 +; +; + + mes 2,_EM_WSIZE,_EM_PSIZE + +#define FARG 0 +#define ERES _EM_DSIZE + +; _fef is called with two parameters: +; - address of exponent result (ERES) +; - floating point number to be split (FARG) +; and returns an _EM_DSIZE-byte floating point number + + exp $_fef + pro $_fef,0 + lal FARG + loi _EM_DSIZE + fef _EM_DSIZE + lal ERES + loi _EM_PSIZE + sti _EM_WSIZE + ret _EM_DSIZE + end ? diff --git a/lib/ack/libp/fif.e b/lib/ack/libp/fif.e new file mode 100755 index 000000000..2e11cf3b3 --- /dev/null +++ b/lib/ack/libp/fif.e @@ -0,0 +1,41 @@ +# +; $Header$ +; +; (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 +; +; + + mes 2,_EM_WSIZE,_EM_PSIZE + +#define ARG1 0 +#define ARG2 _EM_DSIZE +#define IRES 2*_EM_DSIZE + +; _fif is called with three parameters: +; - address of integer part result (IRES) +; - float two (ARG2) +; - float one (ARG1) +; and returns an _EM_DSIZE-byte floating point number + + exp $_fif + pro $_fif,0 + lal 0 + loi 2*_EM_DSIZE + fif _EM_DSIZE + lal IRES + loi _EM_PSIZE + sti _EM_DSIZE + ret _EM_DSIZE + end ? diff --git a/lib/ack/libp/get.c b/lib/ack/libp/get.c new file mode 100755 index 000000000..ec8420772 --- /dev/null +++ b/lib/ack/libp/get.c @@ -0,0 +1,31 @@ +/* $Header$ */ +/* + * (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 +#include + +extern _rf(); +extern _trp(); + +_get(f) struct file *f; { + + _rf(f); + if (f->flags&EOFBIT) + _trp(EEOF); + f->flags &= ~WINDOW; +} diff --git a/lib/ack/libp/gto.e b/lib/ack/libp/gto.e new file mode 100755 index 000000000..be9efa0ff --- /dev/null +++ b/lib/ack/libp/gto.e @@ -0,0 +1,85 @@ +# +; $Header$ +; (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 +; + +/* Author: J.W. Stevenson */ + + + mes 2,_EM_WSIZE,_EM_PSIZE + +#define TARLB 0 +#define DESCR _EM_PSIZE + +#define NEWPC 0 +#define SAVSP _EM_PSIZE + +#define D_PC 0 +#define D_SP _EM_PSIZE +#define D_LB _EM_PSIZE+_EM_PSIZE + +#define LOCLB 0-_EM_PSIZE + +; _gto is called with two arguments: +; - pointer to the label descriptor (DESCR) +; - local base (LB) of target procedure (TARLB) +; the label descriptor contains two items: +; - label address i.e. new PC (NEWPC) +; - offset in target procedure frame (SAVSP) +; using this offset and the LB of the target procedure, the address of +; of local variable of the target procedure is constructed. +; the target procedure must have stored the correct target SP there. + +descr + bss 3*_EM_PSIZE,0,0 + + exp $_gto + pro $_gto,_EM_PSIZE + lal DESCR + loi _EM_PSIZE + adp NEWPC + loi _EM_PSIZE + lae descr+D_PC + sti _EM_PSIZE + lal TARLB + loi _EM_PSIZE + zer _EM_PSIZE + cmp + zeq *1 + lal TARLB + loi _EM_PSIZE + bra *2 +1 + lae _m_lb + loi _EM_PSIZE +2 + lal LOCLB + sti _EM_PSIZE + lal LOCLB + loi _EM_PSIZE + lal DESCR + loi _EM_PSIZE + adp SAVSP + loi _EM_WSIZE ; or _EM_PSIZE ? + ads _EM_WSIZE ; or _EM_PSIZE ? + loi _EM_PSIZE + lae descr+D_SP + sti _EM_PSIZE + lal LOCLB + loi _EM_PSIZE + lae descr+D_LB + sti _EM_PSIZE + gto descr + end ? diff --git a/lib/ack/libp/head_pc.e b/lib/ack/libp/head_pc.e new file mode 100755 index 000000000..63ad6ae5d --- /dev/null +++ b/lib/ack/libp/head_pc.e @@ -0,0 +1,3 @@ +# +; $Header$ + mes 2,_EM_WSIZE,_EM_PSIZE diff --git a/lib/ack/libp/hlt.c b/lib/ack/libp/hlt.c new file mode 100755 index 000000000..0c04c592e --- /dev/null +++ b/lib/ack/libp/hlt.c @@ -0,0 +1,35 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern struct file **_extfl; +extern int _extflc; +extern _cls(); +extern _exit(); + +_hlt(ecode) int ecode; { + int i; + + for (i = 0; i < _extflc; i++) + if (_extfl[i] != (struct file *) 0) + _cls(_extfl[i]); + _exit(ecode); +} diff --git a/lib/ack/libp/hol0.e b/lib/ack/libp/hol0.e new file mode 100755 index 000000000..d84d7731f --- /dev/null +++ b/lib/ack/libp/hol0.e @@ -0,0 +1,29 @@ +# + +; $Header$ +; +; (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 +; +; + + mes 2,_EM_WSIZE,_EM_PSIZE + +; _hol0 return the address of the ABS block (hol0) + + exp $_hol0 + pro $_hol0,0 + lae 0 + ret _EM_PSIZE + end ? diff --git a/lib/ack/libp/incpt.c b/lib/ack/libp/incpt.c new file mode 100755 index 000000000..5818a8604 --- /dev/null +++ b/lib/ack/libp/incpt.c @@ -0,0 +1,75 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +#define EINTR 4 + +extern int errno; +extern _trp(); +extern int _read(); + +_incpt(f) struct file *f; { + + if (f->flags & EOFBIT) + _trp(EEOF); + f->flags |= WINDOW; + f->flags &= ~ELNBIT; +#ifdef CPM + do { +#endif + f->ptr += f->size; + if (f->count == 0) { + f->ptr = f->bufadr; + for(;;) { + f->count=_read(f->ufd,f->bufadr,f->buflen); + if ( f->count<0 ) { + if (errno != EINTR) _trp(EREAD) ; + continue ; + } + break ; + } + if (f->count == 0) { + f->flags |= EOFBIT; + *f->ptr = '\0'; + return; + } + } + if ((f->count -= f->size) < 0) + _trp(EFTRUNC); +#ifdef CPM + } while ((f->flags&TXTBIT) && *f->ptr == '\r'); +#endif + if (f->flags & TXTBIT) { + if (*f->ptr & 0200) + _trp(EASCII); + if (*f->ptr == '\n') { + f->flags |= ELNBIT; + *f->ptr = ' '; + } +#ifdef CPM + if (*f->ptr == 26) { + f->flags |= EOFBIT; + *f->ptr = 0; + } +#endif + } +} diff --git a/lib/ack/libp/ini.c b/lib/ack/libp/ini.c new file mode 100755 index 000000000..149bbe444 --- /dev/null +++ b/lib/ack/libp/ini.c @@ -0,0 +1,72 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern (*_sig())(); +extern _catch(); +#ifndef CPM +extern int _isatty(); +#endif + +struct file **_extfl; +int _extflc; /* number of external files */ +char *_m_lb; /* LB of _m_a_i_n */ +struct file *_curfil; /* points to file struct in case of errors */ +int _pargc; +char **_pargv; +char ***_penviron; +int _fp_hook = 1; /* This is for Minix, but does not harm others */ + +_ini(args,c,p,mainlb) char *args,*mainlb; int c; struct file **p; { + struct file *f; + char buf[128]; + + _pargc= *(int *)args; args += sizeof (int); + _pargv= *(char ***)args; + _sig(_catch); + _extfl = p; + _extflc = c; + if( !c ) return; + _m_lb = mainlb; + if ( (f = _extfl[0]) != (struct file *) 0) { + f->ptr = f->bufadr; + f->flags = MAGIC|TXTBIT; + f->fname = "INPUT"; + f->ufd = 0; + f->size = 1; + f->count = 0; + f->buflen = PC_BUFLEN; + } + if ( (f = _extfl[1]) != (struct file *) 0) { + f->ptr = f->bufadr; + f->flags = MAGIC|TXTBIT|WRBIT|EOFBIT|ELNBIT; + f->fname = "OUTPUT"; + f->ufd = 1; + f->size = 1; +#ifdef CPM + f->count = 1; +#else + f->count = (_isatty(1) ? 1 : PC_BUFLEN); +#endif + f->buflen = f->count; + } +} diff --git a/lib/ack/libp/log.c b/lib/ack/libp/log.c new file mode 100755 index 000000000..d5ba0e4e1 --- /dev/null +++ b/lib/ack/libp/log.c @@ -0,0 +1,65 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* $Header$ */ + +#define __NO_DEFS +#include +#include + +#if __STDC__ +#include +#include +#endif +#undef HUGE +#define HUGE 1e1000 + +double +_log(x) + double x; +{ + /* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + */ + static double a[] = { + -0.64124943423745581147e2, + 0.16383943563021534222e2, + -0.78956112887491257267e0 + }; + static double b[] = { + -0.76949932108494879777e3, + 0.31203222091924532844e3, + -0.35667977739034646171e2, + 1.0 + }; + + extern double _fef(); + double znum, zden, z, w; + int exponent; + + if (x <= 0) { + _trp(ELOG); + return -HUGE; + } + + x = _fef(x, &exponent); + if (x > M_1_SQRT2) { + znum = (x - 0.5) - 0.5; + zden = x * 0.5 + 0.5; + } + else { + znum = x - 0.5; + zden = znum * 0.5 + 0.5; + exponent--; + } + z = znum/zden; w = z * z; + x = z + z * w * (POLYNOM2(w,a)/POLYNOM3(w,b)); + z = exponent; + x += z * (-2.121944400546905827679e-4); + return x + z * 0.693359375; +} diff --git a/lib/ack/libp/mdi.c b/lib/ack/libp/mdi.c new file mode 100755 index 000000000..af9438d74 --- /dev/null +++ b/lib/ack/libp/mdi.c @@ -0,0 +1,71 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern _trp(); + +int _mdi(j,i) int j,i; { + + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} + +long _mdil(j,i) long j,i; { + + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} + +int _dvi(j, i) unsigned int j,i; { + int neg = 0; + + if ((int)j < 0) { + j = -(int)j; neg = 1; + } + if ((int)i < 0) { + i = -(int)i; neg = !neg; + } + i = i / j; + if (neg) return -(int)i; + return i; +} + +long _dvil(j, i) unsigned long j,i; { + int neg = 0; + + if ((long)j < 0) { + j = -(long)j; neg = 1; + } + if ((long)i < 0) { + i = -(long)i; neg = !neg; + } + i = i / j; + if (neg) return -(long)i; + return i; +} diff --git a/lib/ack/libp/mdl.c b/lib/ack/libp/mdl.c new file mode 100755 index 000000000..8c8272f44 --- /dev/null +++ b/lib/ack/libp/mdl.c @@ -0,0 +1,33 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern _trp(); + +long _mdl(j,i) long j,i; { + + if (j <= 0) + _trp(EMOD); + i = i % j; + if (i < 0) + i += j; + return(i); +} diff --git a/lib/ack/libp/new.c b/lib/ack/libp/new.c new file mode 100755 index 000000000..6ea6a304a --- /dev/null +++ b/lib/ack/libp/new.c @@ -0,0 +1,69 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +extern _sav(); +extern _rst(); + +#define assert(x) /* nothing */ +#define UNDEF 0x8000 + +struct adm { + struct adm *next; + int size; +}; + +struct adm *_lastp = 0; +struct adm *_highp = 0; + +_new(n,pp) int n; struct adm **pp; { + struct adm *p,*q; + int *ptmp; + + n = ((n+sizeof(*p)-1) / sizeof(*p)) * sizeof(*p); + if ((p = _lastp) != 0) + do { + q = p->next; + if (q->size >= n) { + assert(q->size%sizeof(adm) == 0); + if ((q->size -= n) == 0) { + if (p == q) + p = 0; + else + p->next = q->next; + if (q == _highp) + _highp = p; + } + _lastp = p; + p = (struct adm *)((char *)q + q->size); + q = (struct adm *)((char *)p + n); + goto initialize; + } + p = q; + } while (p != _lastp); + /*no free block big enough*/ + _sav(&p); + q = (struct adm *)((char *)p + n); + _rst(&q); +initialize: + *pp = p; + ptmp = (int *)p; + while (ptmp < (int *)q) + *ptmp++ = UNDEF; +} diff --git a/lib/ack/libp/nfa.c b/lib/ack/libp/nfa.c new file mode 100755 index 000000000..cfdb9af4d --- /dev/null +++ b/lib/ack/libp/nfa.c @@ -0,0 +1,16 @@ +/* $Header$ */ +/* + * (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ + +/* Author: Hans van Eck */ + +#include + +extern _trp(); + +_nfa(bool) +{ + if (! bool) _trp(EFUNASS); +} diff --git a/lib/ack/libp/nobuff.c b/lib/ack/libp/nobuff.c new file mode 100755 index 000000000..10f80cb48 --- /dev/null +++ b/lib/ack/libp/nobuff.c @@ -0,0 +1,33 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern _flush(); + +/* procedure nobuff(var f:file of ?); */ + +nobuff(f) struct file *f; { + + if ((f->flags & (0377|WRBIT)) != (MAGIC|WRBIT)) + return; + _flush(f); + f->count = f->buflen = f->size; +} diff --git a/lib/ack/libp/notext.c b/lib/ack/libp/notext.c new file mode 100755 index 000000000..8a46e5f35 --- /dev/null +++ b/lib/ack/libp/notext.c @@ -0,0 +1,23 @@ +/* $Header$ */ +/* + * (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 + +notext(f) struct file *f; { + f->flags &= ~TXTBIT; +} diff --git a/lib/ack/libp/opn.c b/lib/ack/libp/opn.c new file mode 100755 index 000000000..2df6d3834 --- /dev/null +++ b/lib/ack/libp/opn.c @@ -0,0 +1,118 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern struct file **_extfl; +extern int _extflc; +extern struct file *_curfil; +extern int _pargc; +extern char **_pargv; +extern char ***_penviron; + +extern _cls(); +extern _xcls(); +extern _trp(); +extern int _getpid(); +extern int _creat(); +extern int _open(); +extern int _close(); +extern int _unlink(); +extern long _lseek(); + +static int tmpfil() { + static char namebuf[] = "/usr/tmp/plf.xxxxx"; + int i; char *p,*q; + + i = _getpid(); + p = namebuf; + q = p + 13; + do + *q++ = (i & 07) + '0'; + while (i >>= 3); + *q = '\0'; + if ((i = _creat(p,0644)) < 0) + if ((i = _creat(p += 4,0644)) < 0) + if ((i = _creat(p += 5,0644)) < 0) + goto error; + if (_close(i) != 0) + goto error; + if ((i = _open(p,2)) < 0) + goto error; + if (_unlink(p) != 0) +error: _trp(EREWR); + return(i); +} + +static int initfl(descr,sz,f) int descr; int sz; struct file *f; { + int i; + + _curfil = f; + if (sz == 0) { + sz++; + descr |= TXTBIT; + } + for (i=0; i<_extflc; i++) + if (f == _extfl[i]) + break; + if (i >= _extflc) { /* local file */ + f->fname = "LOCAL"; + if ((descr & WRBIT) == 0 && (f->flags & 0377) == MAGIC) { + _xcls(f); + if (_lseek(f->ufd,(long)0,0) == -1) + _trp(ERESET); + } else { + _cls(f); + f->ufd = tmpfil(); + } + } else { /* external file */ + if (--i <= 0) + return(0); + if (i >= _pargc) + _trp(EARGC); + f->fname = _pargv[i]; + _cls(f); + if ((descr & WRBIT) == 0) { + if ((f->ufd = _open(f->fname,0)) < 0) + _trp(ERESET); + } else { + if ((f->ufd = _creat(f->fname,0644)) < 0) + _trp(EREWR); + } + } + f->buflen = (sz>PC_BUFLEN ? sz : PC_BUFLEN-PC_BUFLEN%sz); + f->size = sz; + f->ptr = f->bufadr; + f->flags = descr; + return(1); +} + +_opn(sz,f) int sz; struct file *f; { + + if (initfl(MAGIC,sz,f)) + f->count = 0; +} + +_cre(sz,f) int sz; struct file *f; { + + if (initfl(WRBIT|EOFBIT|ELNBIT|MAGIC,sz,f)) + f->count = f->buflen; +} diff --git a/lib/ack/libp/outcpt.c b/lib/ack/libp/outcpt.c new file mode 100755 index 000000000..98b02e5b3 --- /dev/null +++ b/lib/ack/libp/outcpt.c @@ -0,0 +1,50 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +#define EINTR 4 + +extern int errno; +extern _trp(); +extern int _write(); + +_flush(f) struct file *f; { + int i,n; + + f->ptr = f->bufadr; + n = f->buflen - f->count; + if (n <= 0) + return; + f->count = f->buflen; + if ((i = _write(f->ufd,f->bufadr,n)) < 0 && errno == EINTR) + return; + if (i != n) + _trp(EWRITE); +} + +_outcpt(f) struct file *f; { + + f->flags &= ~ELNBIT; + f->ptr += f->size; + if ((f->count -= f->size) <= 0) + _flush(f); +} diff --git a/lib/ack/libp/pac.c b/lib/ack/libp/pac.c new file mode 100755 index 000000000..6ce3751ff --- /dev/null +++ b/lib/ack/libp/pac.c @@ -0,0 +1,63 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern _trp(); + +#define assert(x) /* nothing */ + +#ifndef EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#endif + +struct descr { + int low; + int diff; + int size; +}; + +_pac(ad,zd,zp,i,ap) int i; struct descr *ad,*zd; char *zp,*ap; { + + if (zd->diff > ad->diff || + (i -= ad->low) < 0 || + (i+zd->diff) > ad->diff) + _trp(EPACK); + ap += (i * ad->size); + i = (zd->diff + 1) * zd->size; + if (zd->size == 1) { + int *aptmp = (int *)ap; + assert(ad->size == EM_WSIZE); + while (--i >= 0) + *zp++ = *aptmp++; +#if EM_WSIZE > 2 + } else if (zd->size == 2) { + int *aptmp = (int *)ap; + short *zptmp = (short *) zp; + assert(ad->size == EM_WSIZE); + while (--i >= 0) + *zptmp++ = *aptmp++; +#endif + } else { + assert(ad->size == zd->size); + while (--i >= 0) + *zp++ = *ap++; + } +} diff --git a/lib/ack/libp/pclose.c b/lib/ack/libp/pclose.c new file mode 100755 index 000000000..88ba88aea --- /dev/null +++ b/lib/ack/libp/pclose.c @@ -0,0 +1,27 @@ +/* $Header$ */ +/* + * (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 + +extern _cls(); + +/* procedure pclose(var f:file of ??); */ + +pclose(f) struct file *f; { + _cls(f); +} diff --git a/lib/ack/libp/pcreat.c b/lib/ack/libp/pcreat.c new file mode 100755 index 000000000..f1190b922 --- /dev/null +++ b/lib/ack/libp/pcreat.c @@ -0,0 +1,41 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _cls(); +extern _trp(); +extern int _creat(); + +/* procedure pcreat(var f:text; s:string); */ + +pcreat(f,s) struct file *f; char *s; { + + _cls(f); /* initializes _curfil */ + f->ptr = f->bufadr; + f->flags = WRBIT|EOFBIT|ELNBIT|TXTBIT|MAGIC; + f->fname = s; + f->size = 1; + f->count = PC_BUFLEN; + f->buflen = PC_BUFLEN; + if ((f->ufd = _creat(s,0644)) < 0) + _trp(EREWR); +} diff --git a/lib/ack/libp/pentry.c b/lib/ack/libp/pentry.c new file mode 100755 index 000000000..bac8aad0c --- /dev/null +++ b/lib/ack/libp/pentry.c @@ -0,0 +1,35 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern struct file **_extfl; +extern _wrs(); +extern _wrz(); +extern _wln(); + +procentry(name) char *name; { + struct file *f; + + f = _extfl[1]; + _wrs(5,"call ",f); + _wrz(name,f); + _wln(f); +} diff --git a/lib/ack/libp/perrno.c b/lib/ack/libp/perrno.c new file mode 100755 index 000000000..3cc6a1b6d --- /dev/null +++ b/lib/ack/libp/perrno.c @@ -0,0 +1,25 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* function perrno:integer; extern; */ + +extern int errno; + +int perrno() { + return(errno); +} diff --git a/lib/ack/libp/pexit.c b/lib/ack/libp/pexit.c new file mode 100755 index 000000000..2b00a28ac --- /dev/null +++ b/lib/ack/libp/pexit.c @@ -0,0 +1,33 @@ +/* $Header$ */ +/* + * (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 + +extern struct file **_extfl; +extern _wrs(); +extern _wrz(); +extern _wln(); + +procexit(name) char *name; { + struct file *f; + + f = _extfl[1]; + _wrs(5,"exit ",f); + _wrz(name,f); + _wln(f); +} diff --git a/lib/ack/libp/popen.c b/lib/ack/libp/popen.c new file mode 100755 index 000000000..b542c7ee3 --- /dev/null +++ b/lib/ack/libp/popen.c @@ -0,0 +1,41 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _cls(); +extern _trp(); +extern int _open(); + +/* procedure popen(var f:text; s:string); */ + +popen(f,s) struct file *f; char *s; { + + _cls(f); /* initializes _curfil */ + f->ptr = f->bufadr; + f->flags = TXTBIT|MAGIC; + f->fname = s; + f->size = 1; + f->count = 0; + f->buflen = PC_BUFLEN; + if ((f->ufd = _open(s,0)) < 0) + _trp(ERESET); +} diff --git a/lib/ack/libp/put.c b/lib/ack/libp/put.c new file mode 100755 index 000000000..dcc86e196 --- /dev/null +++ b/lib/ack/libp/put.c @@ -0,0 +1,27 @@ +/* $Header$ */ +/* + * (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 + +extern _wf(); +extern _outcpt(); + +_put(f) struct file *f; { + _wf(f); + _outcpt(f); +} diff --git a/lib/ack/libp/rcka.c b/lib/ack/libp/rcka.c new file mode 100755 index 000000000..b08b6b0be --- /dev/null +++ b/lib/ack/libp/rcka.c @@ -0,0 +1,25 @@ +/* $Header$ */ +/* + * (c) copyright 1990 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ + +/* Author: Hans van Eck */ + +#include + +extern _trp(); + +struct array_descr { + int lbound; + unsigned n_elts_min_one; + unsigned size; /* doesn't really matter */ + }; + +_rcka(descr, index) +struct array_descr *descr; +{ + if( index < descr->lbound || + index > (int) descr->n_elts_min_one + descr->lbound ) + _trp(EARRAY); +} diff --git a/lib/ack/libp/rdc.c b/lib/ack/libp/rdc.c new file mode 100755 index 000000000..17f0708a8 --- /dev/null +++ b/lib/ack/libp/rdc.c @@ -0,0 +1,31 @@ +/* $Header$ */ +/* + * (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 + +extern _rf(); +extern _incpt(); + +int _rdc(f) struct file *f; { + int c; + + _rf(f); + c = *f->ptr; + _incpt(f); + return(c); +} diff --git a/lib/ack/libp/rdi.c b/lib/ack/libp/rdi.c new file mode 100755 index 000000000..fa1909b81 --- /dev/null +++ b/lib/ack/libp/rdi.c @@ -0,0 +1,78 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _trp(); +extern _rf(); +extern _incpt(); + +_skipsp(f) struct file *f; { + while ((*f->ptr == ' ') || (*f->ptr == '\t')) + _incpt(f); +} + +int _getsig(f) struct file *f; { + int sign; + + if ((sign = (*f->ptr == '-')) || *f->ptr == '+') + _incpt(f); + return(sign); +} + +int _fstdig(f) struct file *f; { + int ch; + + ch = *f->ptr - '0'; + if ((unsigned) ch > 9) { + _trp(EDIGIT); + ch = 0; + } + return(ch); +} + +int _nxtdig(f) struct file *f; { + int ch; + + _incpt(f); + ch = *f->ptr - '0'; + if ((unsigned) ch > 9) + return(-1); + return(ch); +} + +int _getint(f) struct file *f; { + int is_signed,i,ch; + + is_signed = _getsig(f); + ch = _fstdig(f); + i = 0; + do + i = i*10 - ch; + while ((ch = _nxtdig(f)) >= 0); + return(is_signed ? i : -i); +} + +int _rdi(f) struct file *f; { + _rf(f); + _skipsp(f); + return(_getint(f)); +} diff --git a/lib/ack/libp/rdl.c b/lib/ack/libp/rdl.c new file mode 100755 index 000000000..76fa6a3f8 --- /dev/null +++ b/lib/ack/libp/rdl.c @@ -0,0 +1,41 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern _rf(); +extern _skipsp(); +extern int _getsig(); +extern int _fstdig(); +extern int _nxtdig(); + +long _rdl(f) struct file *f; { + int is_signed,ch; long l; + + _rf(f); + _skipsp(f); + is_signed = _getsig(f); + ch = _fstdig(f); + l = 0; + do + l = l*10 - ch; + while ((ch = _nxtdig(f)) >= 0); + return(is_signed ? l : -l); +} diff --git a/lib/ack/libp/rdr.c b/lib/ack/libp/rdr.c new file mode 100755 index 000000000..a9ea1c8f3 --- /dev/null +++ b/lib/ack/libp/rdr.c @@ -0,0 +1,78 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +#define BIG 1e17 + +extern _rf(); +extern _incpt(); +extern _skipsp(); +extern int _getsig(); +extern int _getint(); +extern int _fstdig(); +extern int _nxtdig(); + +static double r; +static int pow10; + +static dig(ch) int ch; { + + if (r>BIG) + pow10++; + else + r = r*10.0 + ch; +} + +double _rdr(f) struct file *f; { + int i; double e; int is_signed,ch; + + r = 0; + pow10 = 0; + _rf(f); + _skipsp(f); + is_signed = _getsig(f); + ch = _fstdig(f); + do + dig(ch); + while ((ch = _nxtdig(f)) >= 0); + if (*f->ptr == '.') { + _incpt(f); + ch = _fstdig(f); + do { + dig(ch); + pow10--; + } while ((ch = _nxtdig(f)) >= 0); + } + if ((*f->ptr == 'e') || (*f->ptr == 'E')) { + _incpt(f); + pow10 += _getint(f); + } + if ((i = pow10) < 0) + i = -i; + e = 1.0; + while (--i >= 0) + e *= 10.0; + if (pow10<0) + r /= e; + else + r *= e; + return(is_signed? -r : r); +} diff --git a/lib/ack/libp/rf.c b/lib/ack/libp/rf.c new file mode 100755 index 000000000..dee966838 --- /dev/null +++ b/lib/ack/libp/rf.c @@ -0,0 +1,35 @@ +/* $Header$ */ +/* + * (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 +#include + +extern struct file *_curfil; +extern _trp(); +extern _incpt(); + +_rf(f) struct file *f; { + + _curfil = f; + if ((f->flags&0377) != MAGIC) + _trp(EBADF); + if (f->flags & WRBIT) + _trp(EREADF); + if ((f->flags & WINDOW) == 0) + _incpt(f); +} diff --git a/lib/ack/libp/rln.c b/lib/ack/libp/rln.c new file mode 100755 index 000000000..16e93c0ce --- /dev/null +++ b/lib/ack/libp/rln.c @@ -0,0 +1,30 @@ +/* $Header$ */ +/* + * (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 + +extern _rf(); +extern _incpt(); + +_rln(f) struct file *f; { + + _rf(f); + while ((f->flags & ELNBIT) == 0) + _incpt(f); + f->flags &= ~WINDOW; +} diff --git a/lib/ack/libp/rnd.c b/lib/ack/libp/rnd.c new file mode 100755 index 000000000..0345caa87 --- /dev/null +++ b/lib/ack/libp/rnd.c @@ -0,0 +1,21 @@ +/* $Header$ */ +/* + * (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 + * + */ + +double _rnd(r) double r; { + return(r + (r<0 ? -0.5 : 0.5)); +} diff --git a/lib/ack/libp/sav.e b/lib/ack/libp/sav.e new file mode 100755 index 000000000..317567833 --- /dev/null +++ b/lib/ack/libp/sav.e @@ -0,0 +1,49 @@ +# +; $Header$ +; (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 +; + +/* Author: J.W. Stevenson */ + + + mes 2,_EM_WSIZE,_EM_PSIZE + +#define PTRAD 0 + +#define HP 2 + +; _sav called with one parameter: +; - address of pointer variable (PTRAD) + + exp $_sav + pro $_sav,0 + lor HP + lal PTRAD + loi _EM_PSIZE + sti _EM_PSIZE + ret 0 + end ? + +; _rst is called with one parameter: +; - address of pointer variable (PTRAD) + + exp $_rst + pro $_rst,0 + lal PTRAD + loi _EM_PSIZE + loi _EM_PSIZE + str HP + ret 0 + end ? diff --git a/lib/ack/libp/sig.e b/lib/ack/libp/sig.e new file mode 100755 index 000000000..8aec2651e --- /dev/null +++ b/lib/ack/libp/sig.e @@ -0,0 +1,35 @@ +#define PROC 0 + +; $Header$ +; +; (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 +; +; + + mes 2,_EM_WSIZE,_EM_PSIZE + +; _sig is called with one parameter: +; - procedure instance identifier (PROC) +; and returns nothing. +; only the procedure identifier inside the PROC is used. + + exp $_sig + pro $_sig,0 + lal PROC + loi _EM_PSIZE + sig + asp _EM_PSIZE + ret 0 ; ignore the result of sig + end ? diff --git a/lib/ack/libp/sin.c b/lib/ack/libp/sin.c new file mode 100755 index 000000000..47132a45d --- /dev/null +++ b/lib/ack/libp/sin.c @@ -0,0 +1,101 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* $Header$ */ + +#define __NO_DEFS +#include + +#if __STDC__ +#include +#endif + +static double +sinus(x, cos_flag) + double x; +{ + /* Algorithm and coefficients from: + "Software manual for the elementary functions" + by W.J. Cody and W. Waite, Prentice-Hall, 1980 + */ + + static double r[] = { + -0.16666666666666665052e+0, + 0.83333333333331650314e-2, + -0.19841269841201840457e-3, + 0.27557319210152756119e-5, + -0.25052106798274584544e-7, + 0.16058936490371589114e-9, + -0.76429178068910467734e-12, + 0.27204790957888846175e-14 + }; + + double xsqr; + double y; + int neg = 0; + + if (x < 0) { + x = -x; + neg = 1; + } + if (cos_flag) { + neg = 0; + y = M_PI_2 + x; + } + else y = x; + + /* ??? avoid loss of significance, if y is too large, error ??? */ + + y = y * M_1_PI + 0.5; + + /* Use extended precision to calculate reduced argument. + Here we used 12 bits of the mantissa for a1. + Also split x in integer part x1 and fraction part x2. + */ +#define A1 3.1416015625 +#define A2 -8.908910206761537356617e-6 + { + double x1, x2; + extern double _fif(); + + _fif(y, 1.0, &y); + if (_fif(y, 0.5, &x1)) neg = !neg; + if (cos_flag) y -= 0.5; + x2 = _fif(x, 1.0, &x1); + x = x1 - y * A1; + x += x2; + x -= y * A2; +#undef A1 +#undef A2 + } + + if (x < 0) { + neg = !neg; + x = -x; + } + + /* ??? avoid underflow ??? */ + + y = x * x; + x += x * y * POLYNOM7(y, r); + return neg ? -x : x; +} + +double +_sin(x) + double x; +{ + return sinus(x, 0); +} + +double +_cos(x) + double x; +{ + if (x < 0) x = -x; + return sinus(x, 1); +} diff --git a/lib/ack/libp/sqt.c b/lib/ack/libp/sqt.c new file mode 100755 index 000000000..5f6f1b9d7 --- /dev/null +++ b/lib/ack/libp/sqt.c @@ -0,0 +1,72 @@ +/* + * (c) copyright 1988 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + * + * Author: Ceriel J.H. Jacobs + */ + +/* $Header$ */ +#define __NO_DEFS +#include +#include +extern _trp(); + +#define NITER 5 + +static double +Ldexp(fl,exp) + double fl; + int exp; +{ + extern double _fef(); + int sign = 1; + int currexp; + + if (fl<0) { + fl = -fl; + sign = -1; + } + fl = _fef(fl,&currexp); + exp += currexp; + if (exp > 0) { + while (exp>30) { + fl *= (double) (1L << 30); + exp -= 30; + } + fl *= (double) (1L << exp); + } + else { + while (exp<-30) { + fl /= (double) (1L << 30); + exp += 30; + } + fl /= (double) (1L << -exp); + } + return sign * fl; +} + +double +_sqt(x) + double x; +{ + extern double _fef(); + int exponent; + double val; + + if (x <= 0) { + if (x < 0) _trp(ESQT); + return 0; + } + + val = _fef(x, &exponent); + if (exponent & 1) { + exponent--; + val *= 2; + } + val = Ldexp(val + 1.0, exponent/2 - 1); + /* was: val = (val + 1.0)/2.0; val = Ldexp(val, exponent/2); */ + for (exponent = NITER - 1; exponent >= 0; exponent--) { + val = (val + x / val) / 2.0; + } + return val; +} diff --git a/lib/ack/libp/string.c b/lib/ack/libp/string.c new file mode 100755 index 000000000..a36f608a0 --- /dev/null +++ b/lib/ack/libp/string.c @@ -0,0 +1,60 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* function strbuf(var b:charbuf):string; */ + +char *strbuf(s) char *s; { + return(s); +} + +/* function strtobuf(s:string; var b:charbuf; blen:integer):integer; */ + +int strtobuf(s,b,l) char *s,*b; { + int i; + + i = 0; + while (--l>=0) { + if ((*b++ = *s++) == 0) + break; + i++; + } + return(i); +} + +/* function strlen(s:string):integer; */ + +int strlen(s) char *s; { + int i; + + i = 0; + while (*s++) + i++; + return(i); +} + +/* function strfetch(s:string; i:integer):char; */ + +int strfetch(s,i) char *s; { + return(s[i-1]); +} + +/* procedure strstore(s:string; i:integer; c:char); */ + +strstore(s,i,c) char *s; { + s[i-1] = c; +} diff --git a/lib/ack/libp/trap.e b/lib/ack/libp/trap.e new file mode 100755 index 000000000..cb4424ba9 --- /dev/null +++ b/lib/ack/libp/trap.e @@ -0,0 +1,33 @@ +# + +; $Header$ +; +; (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 +; +; + + mes 2,_EM_WSIZE,_EM_PSIZE + +#define TRAP 0 + +; trap is called with one parameter: +; - trap number (TRAP) + + exp $trap + pro $trap,0 + lol TRAP + trp + ret 0 + end ? diff --git a/lib/ack/libp/trp.e b/lib/ack/libp/trp.e new file mode 100755 index 000000000..430669aa7 --- /dev/null +++ b/lib/ack/libp/trp.e @@ -0,0 +1,38 @@ +# + +; $Header$ +; +; (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 +; +; + + mes 2,_EM_WSIZE,_EM_PSIZE + +#define TRAP 0 + +; _trp() and trap() perform the same function, +; but have to be separate. trap exists to facilitate the user. +; _trp is there for the system, trap cannot be used for that purpose +; because a user might define its own Pascal routine called trap. + +; _trp is called with one parameter: +; - trap number (TRAP) + + exp $_trp + pro $_trp,0 + lol TRAP + trp + ret 0 + end ? diff --git a/lib/ack/libp/unp.c b/lib/ack/libp/unp.c new file mode 100755 index 000000000..d9d5a5fa8 --- /dev/null +++ b/lib/ack/libp/unp.c @@ -0,0 +1,65 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include + +extern _trp(); + +#define assert(x) /* nothing */ + +#ifndef EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#endif + +struct descr { + int low; + int diff; + int size; +}; + +_unp(ad,zd,i,ap,zp,noext) int i; struct descr *ad,*zd; char *ap,*zp; int noext; { + + if (zd->diff > ad->diff || + (i -= ad->low) < 0 || + (i+zd->diff) > ad->diff) + _trp(EUNPACK); + ap += (i * ad->size); + i = (zd->diff + 1) * zd->size; + if (zd->size == 1) { + int *aptmp = (int *) ap; + assert(ad->size == EM_WSIZE); + while (--i >= 0) + if (noext) *aptmp++ = *zp++ & 0377; + else *aptmp++ = *zp++; +#if EM_WSIZE > 2 + } else if (zd->size == 2) { + int *aptmp = (int *) ap; + short *zptmp = (short *) zp; + assert(ad->size == EM_WSIZE); + while (--i >= 0) + if (noext) *aptmp++ = *zptmp++ & 0177777; + else *aptmp++ = *zptmp++; +#endif + } else { + assert(ad->size == zd->size); + while (--i >= 0) + *ap++ = *zp++; + } +} diff --git a/lib/ack/libp/uread.c b/lib/ack/libp/uread.c new file mode 100755 index 000000000..ce700470e --- /dev/null +++ b/lib/ack/libp/uread.c @@ -0,0 +1,25 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* function uread(fd:integer; var b:buf; n:integer):integer; */ + +extern int _read(); + +int uread(fd,b,n) char *b; int fd,n; { + return(_read(fd,b,n)); +} diff --git a/lib/ack/libp/uwrite.c b/lib/ack/libp/uwrite.c new file mode 100755 index 000000000..1a1a20c0a --- /dev/null +++ b/lib/ack/libp/uwrite.c @@ -0,0 +1,25 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* function uwrite(fd:integer; var b:buf; n:integer):integer; */ + +extern int _write(); + +int uwrite(fd,b,n) char *b; int fd,n; { + return(_write(fd,b,n)); +} diff --git a/lib/ack/libp/wdw.c b/lib/ack/libp/wdw.c new file mode 100755 index 000000000..33ac2f77a --- /dev/null +++ b/lib/ack/libp/wdw.c @@ -0,0 +1,30 @@ +/* $Header$ */ +/* + * (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 + +extern struct file *_curfil; +extern _incpt(); + +char *_wdw(f) struct file *f; { + + _curfil = f; + if ((f->flags & (WINDOW|WRBIT|0377)) == MAGIC) + _incpt(f); + return(f->ptr); +} diff --git a/lib/ack/libp/wf.c b/lib/ack/libp/wf.c new file mode 100755 index 000000000..cd0f2b9f0 --- /dev/null +++ b/lib/ack/libp/wf.c @@ -0,0 +1,32 @@ +/* $Header$ */ +/* + * (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 +#include + +extern struct file *_curfil; +extern _trp(); + +_wf(f) struct file *f; { + + _curfil = f; + if ((f->flags&0377) != MAGIC) + _trp(EBADF); + if ((f->flags & WRBIT) == 0) + _trp(EWRITEF); +} diff --git a/lib/ack/libp/wrc.c b/lib/ack/libp/wrc.c new file mode 100755 index 000000000..95b6ea25e --- /dev/null +++ b/lib/ack/libp/wrc.c @@ -0,0 +1,41 @@ +/* $Header$ */ +/* + * (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 + +extern _wf(); +extern _outcpt(); + +_wrc(c,f) int c; struct file *f; { + *f->ptr = c; + _wf(f); + _outcpt(f); +} + +_wln(f) struct file *f; { +#ifdef CPM + _wrc('\r',f); +#endif + _wrc('\n',f); + f->flags |= ELNBIT; +} + +_pag(f) struct file *f; { + _wrc('\014',f); + f->flags |= ELNBIT; +} diff --git a/lib/ack/libp/wrf.c b/lib/ack/libp/wrf.c new file mode 100755 index 000000000..5ee6e629a --- /dev/null +++ b/lib/ack/libp/wrf.c @@ -0,0 +1,68 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _wstrin(); +extern char *_fcvt(); + +#define assert(x) /* nothing */ + +#if __STDC__ +#include +#define HUGE_DIG DBL_MAX_10_EXP /* log10(maxreal) */ +#else +#define HUGE_DIG 400 /* log10(maxreal) */ +#endif +#define PREC_DIG 80 /* the maximum digits returned by _fcvt() */ +#define FILL_CHAR '0' /* char printed if all of _fcvt() used */ +#define BUFSIZE HUGE_DIG + PREC_DIG + 3 + +_wrf(n,w,r,f) int n,w; double r; struct file *f; { + char *p,*b; int s,d; char buf[BUFSIZE]; + + if ( n < 0 || w < 0) _trp(EWIDTH); + p = buf; + if (n > PREC_DIG) + n = PREC_DIG; + b = _fcvt(r,n,&d,&s); + assert(abs(d) <= HUGE_DIG); + if (s) + *p++ = '-'; + if (d<=0) + *p++ = '0'; + else + do + *p++ = (*b ? *b++ : FILL_CHAR); + while (--d > 0); + if (n > 0) + *p++ = '.'; + while (++d <= 0) { + if (--n < 0) + break; + *p++ = '0'; + } + while (--n >= 0) { + *p++ = (*b ? *b++ : FILL_CHAR); + assert(p <= buf+BUFSIZE); + } + _wstrin(w,(int)(p-buf),buf,f); +} diff --git a/lib/ack/libp/wri.c b/lib/ack/libp/wri.c new file mode 100755 index 000000000..5c06e5290 --- /dev/null +++ b/lib/ack/libp/wri.c @@ -0,0 +1,72 @@ +/* $Header$ */ +/* + * (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 +#include + +extern _wstrin(); + +#ifndef EM_WSIZE +#ifdef _EM_WSIZE +#define EM_WSIZE _EM_WSIZE +#endif +#endif + +#if EM_WSIZE==4 +#define SZ 11 +#define MININT -2147483648 +#define STRMININT "-2147483648" +#endif +#if EM_WSIZE==2 +#define SZ 6 +#define MININT -32768 +#define STRMININT "-32768" +#endif +#if EM_WSIZE==1 +#define SZ 4 +#define MININT -128 +#define STRMININT "-128" +#endif + +#ifndef STRMININT +Something wrong here! +#endif + +_wsi(w,i,f) int w,i; struct file *f; { + char *p; int j; char buf[SZ]; + + if (w < 0) _trp(EWIDTH); + p = &buf[SZ]; + if ((j=i) < 0) { + if (i == MININT) { + _wstrin(w,SZ,STRMININT,f); + return; + } + j = -j; + } + do + *--p = '0' + j%10; + while (j /= 10); + if (i<0) + *--p = '-'; + _wstrin(w,(int)(&buf[SZ]-p),p,f); +} + +_wri(i,f) int i; struct file *f; { + _wsi(SZ,i,f); +} diff --git a/lib/ack/libp/wrl.c b/lib/ack/libp/wrl.c new file mode 100755 index 000000000..f5a3d67ca --- /dev/null +++ b/lib/ack/libp/wrl.c @@ -0,0 +1,51 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _wstrin(); + +#define MAXNEGLONG -2147483648 + +_wsl(w,l,f) int w; long l; struct file *f; { + char *p,c; long j; char buf[11]; + + if (w < 0) _trp(EWIDTH); + p = &buf[11]; + if ((j=l) < 0) { + if (l == MAXNEGLONG) { + _wstrin(w,11,"-2147483648",f); + return; + } + j = -j; + } + do { + c = j%10; + *--p = c + '0'; + } while (j /= 10); + if (l<0) + *--p = '-'; + _wstrin(w,(int)(&buf[11]-p),p,f); +} + +_wrl(l,f) long l; struct file *f; { + _wsl(11,l,f); +} diff --git a/lib/ack/libp/wrr.c b/lib/ack/libp/wrr.c new file mode 100755 index 000000000..5c2df66e7 --- /dev/null +++ b/lib/ack/libp/wrr.c @@ -0,0 +1,67 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _wstrin(); +extern char *_ecvt(); + +#define PREC_DIG 80 /* maximum digits produced by _ecvt() */ + +_wsr(w,r,f) int w; double r; struct file *f; { + char *p,*b; int s,d,i; char buf[PREC_DIG+7]; + + if (w < 0) _trp(EWIDTH); + p = buf; + if ((i = w-6) < 2) + i = 2; + b = _ecvt(r,i,&d,&s); + *p++ = s? '-' : ' '; + if (*b == '0') + d++; + *p++ = *b++; + *p++ = '.'; + while (--i > 0) + *p++ = *b++; + *p++ = 'e'; + d--; + if (d < 0) { + d = -d; + *p++ = '-'; + } else + *p++ = '+'; + + if (d >= 1000) { + *p++ = '*'; + *p++ = '*'; + *p++ = '*'; + } + else { + *p++ = '0' + d/100; + *p++ = '0' + (d/10) % 10; + *p++ = '0' + d%10; + } + _wstrin(w,(int)(p-buf),buf,f); +} + +_wrr(r,f) double r; struct file *f; { + _wsr(13,r,f); +} diff --git a/lib/ack/libp/wrs.c b/lib/ack/libp/wrs.c new file mode 100755 index 000000000..a10951c61 --- /dev/null +++ b/lib/ack/libp/wrs.c @@ -0,0 +1,68 @@ +/* $Header$ */ +/* + * (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 + * + */ + +/* Author: J.W. Stevenson */ + +#include +#include + +extern _wf(); +extern _outcpt(); + +_wstrin(width,len,buf,f) int width,len; char *buf; struct file *f; { + + _wf(f); + for (width -= len; width>0; width--) { + *f->ptr = ' '; + _outcpt(f); + } + while (--len >= 0) { + *f->ptr = *buf++; + _outcpt(f); + } +} + +_wsc(w,c,f) int w; char c; struct file *f; { + + if (w < 0) _trp(EWIDTH); + _wss(w,1,&c,f); +} + +_wss(w,len,s,f) int w,len; char *s; struct file *f; { + + if (w < 0 || len < 0) _trp(EWIDTH); + if (w < len) + len = w; + _wstrin(w,len,s,f); +} + +_wrs(len,s,f) int len; char *s; struct file *f; { + if (len < 0) _trp(EWIDTH); + _wss(len,len,s,f); +} + +_wsb(w,b,f) int w,b; struct file *f; { + if (b) + _wss(w,4,"true",f); + else + _wss(w,5,"false",f); +} + +_wrb(b,f) int b; struct file *f; { + _wsb(5,b,f); +} diff --git a/lib/ack/libp/wrz.c b/lib/ack/libp/wrz.c new file mode 100755 index 000000000..220c66a49 --- /dev/null +++ b/lib/ack/libp/wrz.c @@ -0,0 +1,38 @@ +/* $Header$ */ +/* + * (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 +#include + +extern _wss(); +extern _wrs(); + +_wsz(w,s,f) int w; char *s; struct file *f; { + char *p; + + if (w < 0) _trp(EWIDTH); + for (p=s; *p; p++); + _wss(w,(int)(p-s),s,f); +} + +_wrz(s,f) char *s; struct file *f; { + char *p; + + for (p=s; *p; p++); + _wrs((int)(p-s),s,f); +} diff --git a/lib/ack/liby/Makefile b/lib/ack/liby/Makefile new file mode 100644 index 000000000..e1bac55a8 --- /dev/null +++ b/lib/ack/liby/Makefile @@ -0,0 +1,11 @@ +# Makefile for lib/liby. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE -wo + +LIBRARIES = liby + +liby_OBJECTS = \ + main.o \ + yyerror.o \ + +include ../../Makefile.ack.inc diff --git a/lib/ack/liby/Makefile.ack.conv b/lib/ack/liby/Makefile.ack.conv new file mode 100755 index 000000000..664b34839 --- /dev/null +++ b/lib/ack/liby/Makefile.ack.conv @@ -0,0 +1,21 @@ +# Makefile for lib/liby. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE -wo +CC1 = $(CC) $(CFLAGS) -c + +LIBRARY = ../../liby.a +all: $(LIBRARY) + +OBJECTS = \ + $(LIBRARY)(main.o) \ + $(LIBRARY)(yyerror.o) \ + +$(LIBRARY): $(OBJECTS) + aal cr $@ *.o + rm *.o + +$(LIBRARY)(main.o): main.c + $(CC1) main.c + +$(LIBRARY)(yyerror.o): yyerror.c + $(CC1) yyerror.c diff --git a/lib/ack/liby/main.c b/lib/ack/liby/main.c new file mode 100755 index 000000000..bd5041975 --- /dev/null +++ b/lib/ack/liby/main.c @@ -0,0 +1,41 @@ +/*- + * Copyright (c) 1990 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. All advertising materials mentioning features or use of this software + * must display the following acknowledgement: + * This product includes software developed by the University of + * California, Berkeley and its contributors. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +#if defined(LIBC_SCCS) && !defined(lint) +static char sccsid[] = "@(#)main.c 5.3 (Berkeley) 1/13/91"; +#endif /* not lint */ + +main() +{ + exit(yyparse()); +} diff --git a/lib/ack/liby/yyerror.c b/lib/ack/liby/yyerror.c new file mode 100755 index 000000000..f20628e64 --- /dev/null +++ b/lib/ack/liby/yyerror.c @@ -0,0 +1,45 @@ +/*- + * Copyright (c) 1990 The Regents of the University of California. + * All rights reserved. + * + * Redistribution and use in source and binary forms, with or without + * modification, are permitted provided that the following conditions + * are met: + * 1. Redistributions of source code must retain the above copyright + * notice, this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright + * notice, this list of conditions and the following disclaimer in the + * documentation and/or other materials provided with the distribution. + * 3. All advertising materials mentioning features or use of this software + * must display the following acknowledgement: + * This product includes software developed by the University of + * California, Berkeley and its contributors. + * 4. Neither the name of the University nor the names of its contributors + * may be used to endorse or promote products derived from this software + * without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND + * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE + * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE + * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE + * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL + * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS + * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) + * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT + * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY + * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF + * SUCH DAMAGE. + */ + +#if defined(LIBC_SCCS) && !defined(lint) +static char sccsid[] = "@(#)yyerror.c 5.2 (Berkeley) 5/15/90"; +#endif /* not lint */ + +#include + +yyerror(msg) +char *msg; +{ + (void)fprintf(stderr, "%s\n", msg); + return(0); +} diff --git a/lib/ack/math/Makefile b/lib/ack/math/Makefile new file mode 100644 index 000000000..e1f51c7c1 --- /dev/null +++ b/lib/ack/math/Makefile @@ -0,0 +1,13 @@ +# Makefile for lib/ack/math. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE + +LIBRARIES = libc + +libc_OBJECTS = \ + frexp.o \ + modf.o \ + isnan.o \ + ldexp.o \ + +include ../../Makefile.ack.inc diff --git a/lib/ack/math/Makefile.ack.conv b/lib/ack/math/Makefile.ack.conv new file mode 100755 index 000000000..b520ac82b --- /dev/null +++ b/lib/ack/math/Makefile.ack.conv @@ -0,0 +1,29 @@ +# Makefile for lib/math. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE +CC1 = $(CC) $(CFLAGS) -c + +LIBRARY = ../../libc.a +all: $(LIBRARY) + +OBJECTS = \ + $(LIBRARY)(frexp.o) \ + $(LIBRARY)(modf.o) \ + $(LIBRARY)(isnan.o) \ + $(LIBRARY)(ldexp.o) \ + +$(LIBRARY): $(OBJECTS) + aal cr $@ *.o + rm *.o + +$(LIBRARY)(frexp.o): frexp.s + $(CC1) frexp.s + +$(LIBRARY)(modf.o): modf.s + $(CC1) modf.s + +$(LIBRARY)(isnan.o): isnan.c + $(CC1) isnan.c + +$(LIBRARY)(ldexp.o): ldexp.c + $(CC1) ldexp.c diff --git a/lib/ack/math/frexp.s b/lib/ack/math/frexp.s new file mode 100755 index 000000000..502caf783 --- /dev/null +++ b/lib/ack/math/frexp.s @@ -0,0 +1,35 @@ +# +.sect .text; .sect .rom; .sect .data; .sect .bss +.extern _frexp +.sect .text +_frexp: +#if __i386 + push ebp + mov ebp, esp + push 12(ebp) + push 8(ebp) + mov eax, esp + add eax, -4 + push eax + call .fef8 + mov eax, 16(ebp) + pop (eax) + pop eax + pop edx + leave + ret +#else /* i86 */ + push bp + mov bp, sp + lea bx, 4(bp) + mov cx, #8 + call .loi + mov ax, sp + add ax, #-2 + push ax + call .fef8 + mov bx, 12(bp) + pop (bx) + call .ret8 + jmp .cret +#endif diff --git a/lib/ack/math/isnan.c b/lib/ack/math/isnan.c new file mode 100755 index 000000000..97257f45b --- /dev/null +++ b/lib/ack/math/isnan.c @@ -0,0 +1,11 @@ +int __IsNan(double d) +{ +#if defined(vax) || defined(pdp) +#else + float f = d; + + if ((*((long *) &f) & 0x7f800000) == 0x7f800000 && + (*((long *) &f) & 0x007fffff) != 0) return 1; +#endif + return 0; +} diff --git a/lib/ack/math/ldexp.c b/lib/ack/math/ldexp.c new file mode 100755 index 000000000..501dac452 --- /dev/null +++ b/lib/ack/math/ldexp.c @@ -0,0 +1,55 @@ +/* + * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands. + * See the copyright notice in the ACK home directory, in the file "Copyright". + */ +/* $Header$ */ + +#include +#include +#include + +double +ldexp(double fl, int exp) +{ + int sign = 1; + int currexp; + + if (__IsNan(fl)) { + errno = EDOM; + return fl; + } + if (fl == 0.0) return 0.0; + if (fl<0) { + fl = -fl; + sign = -1; + } + if (fl > DBL_MAX) { /* for infinity */ + errno = ERANGE; + return sign * fl; + } + fl = frexp(fl,&currexp); + exp += currexp; + if (exp > 0) { + if (exp > DBL_MAX_EXP) { + errno = ERANGE; + return sign * HUGE_VAL; + } + while (exp>30) { + fl *= (double) (1L << 30); + exp -= 30; + } + fl *= (double) (1L << exp); + } + else { + /* number need not be normalized */ + if (exp < DBL_MIN_EXP - DBL_MANT_DIG) { + return 0.0; + } + while (exp<-30) { + fl /= (double) (1L << 30); + exp += 30; + } + fl /= (double) (1L << -exp); + } + return sign * fl; +} diff --git a/lib/ack/math/modf.s b/lib/ack/math/modf.s new file mode 100755 index 000000000..5d1e39c0b --- /dev/null +++ b/lib/ack/math/modf.s @@ -0,0 +1,49 @@ +# +.sect .text; .sect .rom; .sect .data; .sect .bss +.extern _modf +.sect .text +_modf: +#if __i386 + push ebp + mov ebp, esp + push 12(ebp) + push 8(ebp) + push 1 + push 4 + call .cif8 + mov eax, esp + push eax + call .fif8 + pop ecx + mov edx, 16(ebp) + pop ecx + pop ebx + mov 0(edx), ecx + mov 4(edx), ebx + pop eax + pop edx + leave + ret +#else /* i86 */ + push bp + mov bp, sp + lea bx, 4(bp) + mov cx, #8 + call .loi + mov dx, #1 + push dx + push dx + push dx + mov ax, #2 + push ax + call .cif8 + mov ax, sp + push ax + call .fif8 + pop bx + mov bx, 12(bp) + mov cx, #8 + call .sti + call .ret8 + jmp .cret +#endif diff --git a/lib/ack/rts/Makefile b/lib/ack/rts/Makefile new file mode 100644 index 000000000..47785c427 --- /dev/null +++ b/lib/ack/rts/Makefile @@ -0,0 +1,10 @@ +# Makefile for lib/ack/rts. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE + +LIBRARIES = libc + +libc_OBJECTS = \ + setjmp.o \ + +include ../../Makefile.ack.inc diff --git a/lib/ack/rts/Makefile.ack.conv b/lib/ack/rts/Makefile.ack.conv new file mode 100755 index 000000000..4020dde29 --- /dev/null +++ b/lib/ack/rts/Makefile.ack.conv @@ -0,0 +1,19 @@ +# Makefile for lib/rts. + +CFLAGS = -O -D_MINIX -D_POSIX_SOURCE +CC1 = $(CC) $(CFLAGS) -c + +LIBRARY = ../../libc.a + +all: \ + $(LIBRARY) + +OBJECTS = \ + $(LIBRARY)(setjmp.o) \ + +$(LIBRARY): $(OBJECTS) + aal cr $@ *.o + rm *.o + +$(LIBRARY)(setjmp.o): setjmp.e + $(CC1) setjmp.e diff --git a/lib/ack/rts/setjmp.e b/lib/ack/rts/setjmp.e new file mode 100755 index 000000000..7036e2418 --- /dev/null +++ b/lib/ack/rts/setjmp.e @@ -0,0 +1,112 @@ +# + mes 2,_EM_WSIZE,_EM_PSIZE +; +; layout of a setjmp buffer: +; +; ----------------- +; | flag | (!0 when blocked signals saved (POSIX)) +; ----------------- +; | signal mask/set | (for Berkeley 4.[2-] / POSIX) +; ----------------- +; | | +; | GTO descriptor | +; | (SP, LB, PC) | +; | | +; ----------------- +; +; setjmp saves the signalmask, PC, SP, and LB of caller, and creates a +; GTO descriptor from this. +; The big problem here is how to get the return address, i.e. the PC of +; the caller; This problem is solved by the front-end, which must pass +; it as an extra parameter to setjmp. + +; a GTO descriptor must be in the global data area +gtobuf + bss 3*_EM_PSIZE,0,0 + + inp $fill_ret_area + exp $__setjmp + pro $__setjmp,0 +#if defined(_POSIX_SOURCE) +; save mask of currently blocked signals. +; longjmp must restore this mask + lol _EM_PSIZE ; the flag integer at offset _EM_PSIZE + lal 0 + loi _EM_PSIZE + stf 3*_EM_PSIZE+_EM_LSIZE + lol _EM_PSIZE ; the flag integer at offset _EM_PSIZE + zeq *1 + lal 0 + loi _EM_PSIZE + adp 3*_EM_PSIZE + cal $__newsigset + asp _EM_PSIZE +1 +#elif defined(__BSD4_2) + loc 0 + cal $sigblock + asp _EM_WSIZE + lfr _EM_WSIZE + lal 0 + loi _EM_PSIZE + stf 3*_EM_PSIZE +#endif +; create GTO descriptor for longjmp + lxl 0 + dch ; Local Base of caller + lxa 0 ; Stackpointer of caller + lal _EM_PSIZE+_EM_WSIZE + loi _EM_PSIZE ; Return address of caller + lal 0 + loi _EM_PSIZE ; address of jmpbuf + sti 3*_EM_PSIZE ; LB, SP, and PC stored in jmpbuf + loc 0 + ret _EM_WSIZE ; setjmp must return 0 + end 0 + + pro $fill_ret_area,0 +; put argument in function result area + lol 0 + ret _EM_WSIZE + end 0 + + exp $longjmp + pro $longjmp,? +#if defined(_POSIX_SOURCE) +; restore blocked mask + lal 0 + loi _EM_PSIZE + lof 3*_EM_PSIZE+_EM_LSIZE + zeq *2 + lal 0 + loi _EM_PSIZE + adp 3*_EM_PSIZE + cal $__oldsigset + asp _EM_PSIZE +2 +#elif defined(__BSD4_2) +; restore signal mask + lal 0 + loi _EM_PSIZE + lof 3*_EM_PSIZE + cal $_sigsetmask + asp _EM_WSIZE + lfr _EM_WSIZE + asp _EM_WSIZE +#endif + lal 0 + loi _EM_PSIZE ; address of jmpbuf + lae gtobuf + blm 3*_EM_PSIZE ; fill GTO descriptor from jmpbuf + lol _EM_PSIZE ; second parameter of longjmp: the return value + dup _EM_WSIZE + zne *3 +; of course, longjmp may not return 0! + inc +3 +; put return value in function result area + cal $fill_ret_area + asp _EM_WSIZE + gto gtobuf ; there we go ... +; ASP and GTO do not damage function result area + end 0 -- 2.44.0