???????????????????????;7;;<:?:?:?:?<:?:?:?:?:?:?:?:?%@%@%@%@%@%@%@%@:?:?:?:?:?:?:?<:?:?:?:?:?:?:?:?:?:?:?:?:?:?:?:?:?:?:?:?:??:?:?:?:?:?:?<:?:?:?:???:?:???:?:?:?:?:?:?:??:?:?:??:????:??(MNNNTNtN5P`PLMLlMMMMMN,NPPLL,QXQO0OLOhOM|PLPXXY YXYXX Y Y Y Y YYhY Y Y Y Y Y YXYY Y Y YYGZGZZ[ZGZZGZGZ[Z[Z[Z[Z[ZZZ[Z[Z[Z[Z[Z[ZGZZZ[Z[Z[ZZ[[[[[[[[[[[[[[[[[[[[[[[[[[[[?\?\\H\?\\?\?\H\H\H\H\H\\\H\H\H\H\H\H\?\\\H\H\H\\7^7^[`?^7^[`7^7^?^?^?^?^?^{^e^?^?^?^?^?^?^7^{^{^?^?^?^[`8a8ab@a8ab8a8a@a@a@a@a@aba@a@a@a@a@a@a8abb@a@a@abMcMc.c9_Mc.cMcMc9_9_9_9_9_cb9_9_9_9_9_9_Mccc9_9_9_.cDfeeDfeeeeeee777>>>>>7770) ֺֺֺϺ˺ĺ@@e#nX8   VhhhVPPPVVV``PPPHHH\kPkRk^jTkcVkhdXk^klb b ak hk ok2jvkzkkkkk_Iakkkk_kkkkhkkkkgk&.6>de ln!%)-159     !$"#&XWYSVEP EEj Eh EHX HH  K K KKO O OOZ]^_`a @ H  @` k k ii# ##? ??B BBb@bccd d`e e P v w fpA         @`@`@`@`     0  0 00   c@`@`   bb @P            n~okcgtuvdefq r s q r q@ r@ s@      hij`ab`a7?'/ Ԙffffggff 0123 ٛw JanFebMarAprMayJunJulAugSepOctNovDecintvoidcharifelsewhilebreakreturnforexternstaticunsignedgotodocontinueswitchcaseconst__const__const__volatile__volatile__volatile__longregistersigned__signed__signed__autoinline__inline__inline__restrict__restrict__restrict____extension__floatdouble_Boolshortstructuniontypedefdefaultenumsizeof__attribute__attribute____alignof__alignof__typeof__typeof__typeof____label__asm__asm__asm__defineincludeinclude_nextifdefifndefelifendifdefinedundeferrorwarninglinepragma__LINE____FILE____DATE____TIME____FUNCTION____VA_ARGS____func__section__section__aligned__aligned__packed__packed__unused__unused__cdecl__cdecl__cdecl__stdcall__stdcall__stdcall__fastcall__fastcall__fastcall__dllexportnoreturn__noreturn____builtin_types_compatible_p__builtin_constant_p__builtin_frame_addressregparm__regparm__packmemcpymemset__divdi3__moddi3__udivdi3__umoddi3__tcc_int_fpu_control__tcc_fpu_control__ashrdi3__lshrdi3__ashldi3__floatundisf__floatundidf__floatundixf__fixunsxfdi__fixunssfdi__fixunsdfdibytealignskipspacestringascizasciigloblglobaltextdatabsspreviousfillorgquadalcldlblahchdhbhaxcxdxbxspbpsidieaxecxedxebxespebpesiedimm0mm1mm2mm3mm4mm5mm6mm7xmm0xmm1xmm2xmm3xmm4xmm5xmm6xmm7cr0cr1cr2cr3cr4cr5cr6cr7tr0tr1tr2tr3tr4tr5tr6tr7db0db1db2db3db4db5db6db7dr0dr1dr2dr3dr4dr5dr6dr7escsssdsfsgsstmovbmovwmovlmovaddbaddwaddladdorborworloradcbadcwadcladcsbbbsbbwsbblsbbandbandwandlandsubbsubwsublsubxorbxorwxorlxorcmpbcmpwcmplcmpincbincwinclincdecbdecwdecldecnotbnotwnotlnotnegbnegwneglnegmulbmulwmullmulimulbimulwimullimuldivbdivwdivldividivbidivwidivlidivxchgbxchgwxchglxchgtestbtestwtestltestrolbrolwrollrolrorbrorwrorlrorrclbrclwrcllrclrcrbrcrwrcrlrcrshlbshlwshllshlshrbshrwshrlshrsarbsarwsarlsarshldwshldlshldshrdwshrdlshrdpushwpushlpushpopwpoplpopinbinwinlinoutboutwoutloutmovzbwmovzblmovzbmovzwlmovsbwmovsblmovswlleawleallealesldslsslfslgscalljmplcallljmpjojnojbjcjnaejnbjncjaejejzjnejnzjbejnajnbejajsjnsjpjpejnpjpojljngejnljgejlejngjnlejgsetosetnosetbsetcsetnaesetnbsetncsetaesetesetzsetnesetnzsetbesetnasetnbesetasetssetnssetpsetpesetnpsetposetlsetngesetnlsetgesetlesetngsetnlesetgcmovocmovnocmovbcmovccmovnaecmovnbcmovnccmovaecmovecmovzcmovnecmovnzcmovbecmovnacmovnbecmovacmovscmovnscmovpcmovpecmovnpcmovpocmovlcmovngecmovnlcmovgecmovlecmovngcmovnlecmovgbsfwbsflbsfbsrwbsrlbsrbtwbtlbtbtswbtslbtsbtrwbtrlbtrbtcwbtclbtclslwlslllslfaddfaddpfaddsfiaddlfaddlfiaddsfmulfmulpfmulsfimullfmullfimulsfcomfcom_1fcomsficomlfcomlficomsfcompfcomppfcompsficomplfcomplficompsfsubfsubpfsubsfisublfsublfisubsfsubrfsubrpfsubrsfisubrlfsubrlfisubrsfdivfdivpfdivsfidivlfdivlfidivsfdivrfdivrpfdivrsfidivrlfdivrlfidivrsxaddbxaddwxaddlxaddcmpxchgbcmpxchgwcmpxchglcmpxchgcmpsbcmpswcmpslcmpsscmpbscmpwscmplscmpinsbinswinslinsoutsboutswoutsloutslodsblodswlodsllodsslodbslodwslodlslodmovsbmovswmovslmovssmovbsmovwsmovlsmovscasbscaswscaslscassscabsscawsscalsscastosbstoswstoslstossstobsstowsstolsstopushapopaclccldclicltscmclahfsahfpushflpopflpushfpopfstcstdstiaaaaasdaadasaadaamcbwcwdcwdecdqcbtwcwtlcwtdcltdint3intoiretrsmhltwaitnopxlatawordaddr16worddata16lockrepreperepzrepnerepnzinvdwbinvdcpuidwrmsrrdtscrdmsrrdpmcud2leaveretlretfucomppftstfxamfld1fldl2tfldl2efldpifldlg2fldln2fldzf2xm1fyl2xfptanfpatanfxtractfprem1fdecstpfincstpfpremfyl2xp1fsqrtfsincosfrndintfscalefsinfcosfchsfabsfninitfnclexfnopfwaitfxchfnstswemmsenterloopneloopnzloopeloopzloopjecxzfldfldlfldsfildlfildqfildllfldtfbldfstfstlfstsfstpsfstplfistfistpfistlfistplfstpfistpqfistpllfstptfbstpfucomfucompfinitfldcwfnstcwfstcwfstswfclexfnstenvfstenvfldenvfnsavefsavefrstorffreeffreepfxsavefxrstorarpllarlgdtlidtlldtlmswltrsgdtsidtsldtsmswstrverrverwbswapinvlpgboundlboundwcmpxchg8bfcmovbfcmovefcmovbefcmovufcmovnbfcmovnefcmovnbefcmovnufucomifcomifucomipfcomipmovdmovqpackssdwpacksswbpackuswbpaddbpaddwpadddpaddsbpaddswpaddusbpadduswpandpandnpcmpeqbpcmpeqwpcmpeqdpcmpgtbpcmpgtwpcmpgtdpmaddwdpmulhwpmullwporpsllwpslldpsllqpsrawpsradpsrlwpsrldpsrlqpsubbpsubwpsubdpsubsbpsubswpsubusbpsubuswpunpckhbwpunpckhwdpunpckhdqpunpcklbwpunpcklwdpunpckldqpxor%d idents, %d lines, %d bytes, %0.3f s, %d lines/s, %0.1f MB/s tcc version 0.9.25 - Tiny C Compiler - Copyright (C) 2001-2006 Fabrice Bellard usage: tcc [-v] [-c] [-o outfile] [-Bdir] [-bench] [-Idir] [-Dsym[=val]] [-Usym] [-Wwarn] [-g] [-b] [-bt N] [-Ldir] [-llib] [-shared] [-soname name] [-static] [infile1 infile2...] [-run infile args...] General options: -v display current version, increase verbosity -c compile only - generate an object file -o outfile set output filename -Bdir set tcc internal library path -bench output compilation statistics -run run compiled source -fflag set or reset (with 'no-' prefix) 'flag' (see man page) -Wwarning set or reset (with 'no-' prefix) 'warning' (see man page) -w disable all warnings Preprocessor options: -E preprocess only -Idir add include path 'dir' -Dsym[=val] define 'sym' with value 'val' -Usym undefine 'sym' Linker options: -Ldir add library path 'dir' -llib link with dynamic or static library 'lib' -shared generate a shared library -soname set name for shared library to be used at runtime -static static linking -rdynamic export all global symbols to dynamic linker -r generate (relocatable) object file Debugger options: -g generate runtime debug info -bt N show N callers in stack tracesunexpected end of file in commentthree 'l's in integer constantnew_bind=%x new_shndx=%x new_vis=%x old_bind=%x old_shndx=%x old_vis=%x object must contain only one symtabInvalid relocation entry [%2d] '%s' @ %.8xassembler label '%s' already definedincompatible types for redefinition of '%s'label '%s' declared but not usedlabel '%s' used but not definedcomparison between pointer and integercomparison of distinct pointer types lacks a castinvalid operands for binary operationassignment of read-only locationnonportable conversion from pointer to char/shortassignment makes pointer from integer without a castassignment from incompatible pointer typeassignment discards qualifiers from pointer target typeassignment makes integer from pointer without a castmissing terminating %c character'#include' expects "FILENAME" or invalid argument for '#if%sdef'Ignoring unknown preprocessing directive #%sunknown escape sequence: '\%c'unknown escape sequence: '\x%x'multi-character character constantbadly punctuated parameter listunsupported linker option '%s'macro '%s' used with too many argsmacro '%s' used with too few argspasting "%s" and "%s" does not give a valid preprocessing tokenlocal label '%d' not found backwardalignment must be a positive power of twono previous section referencedunknown assembler directive '.%s'segment prefix must be followed by memory referencedeclaration for parameter '%s' but no such parameterstorage class specified for '%s'deprecated use of label at end of compound statementpointer not accepted for unary plussizeof applied to an incomplete type__builtin_frame_address only takes integersTCC only supports __builtin_frame_address(0)implicit declaration of function '%s'too many arguments to functioninitializer element is not constantinitializer element is not computable at load timeinvalid reference in constraint %d ('%s')cannot reference twice the same operand'%c' modifier can only be applied to outputsasm constraint %d ('%s') could not be satisfiedcould not find free output register for reloadinginvalid operand reference after %%struct/union/enum already definednegative width in bit-field '%s'bitfields must have scalar typewidth of '%s' exceeds its typeinitializer-string for array is too longunexpected end of file in initializerrange init not supported yet for dynamic storagecannot specify multiple files with -ccannot specify libraries with -call0x%08lx: ??? %s() (%s:%d, included from %sRuntime error: at by division by zerofloating point exceptiondereferencing invalid pointerillegal instructionabort() calledcaught signal %dIn file included from %s:%d: %s:%d: %s: tcc: warning: %s not definedmemory full%s expectedlvaluenumber too longinvalid digitexponentexponent digitsinteger constant overflowtwo 'u's in integer constantinvalid number '%s' defined twiceL..%ustdinnf->%s %*s%s .rel%s%s:%c1.got_GLOBAL_OFFSET_TABLE___%s_start__%s_end_etext_edata.preinit_array.init_array.fini_array__start_%s__stop_%sinvalid object file.stabstr.gnu.linkonceinvalid section type.stab_fp_hwundefined symbol '%s'stray '\' in program/.-_+=$:\,~%LuL.%uconst volatile unsigned _Boolshortlong longfloatlong doubleenum struct (, *invalid operands to binary %scannot use pointers heredivision by zero in constantcannot cast '%s' to '%s'' ' after ' '#endif#include recursion too deepinclude file '%s' not found#else without matching #if#else after #else#elif without matching #if#elif after #else#endif without matching #if#line#error %s#warning %sout of pack stackinvalid pack pragma'.'empty character constantunrecognized character \x%02xinvalid macro name '%s'invalid option -- '%s'argument to '%s' is missing-Ttext,too many include paths0.9.25tcc version %s --oformat,binarytarget %s not foundunsupported option '%s'elf32-/usr/lib/tcc__STDC__199901L__STDC_VERSION____i386____unix____unix__linux____linux__TINYC__unsigned int__SIZE_TYPE____PTRDIFF_TYPE____WCHAR_TYPE__/usr/local/lib/usr/lib.text.data.bss.symtab.hashtab.strtab.dynsymtab.dynhashtab.dynstrtab%s %2d %d%02d:%02d:%02d>>=<<=unsupported token32 bit register'%c' expectedstring constantinvalid operation with labelinvalid number syntaxbad expression syntax [%s]64 bit constantrepeat < 0; .fill ignoredsize < 0; .fill ignoredattempt to .org backwards.%s.%s%dunknown register1, 2, 4 or 8 constant':'incorrect number of operandsincorrect prefixunknown opcode '%s'cannot infer opcode suffixinvalid displacementcannot relocateend of line';'declaration listcannot use local functionsfunction definitionunexpected end of filelabel identifierunsupported expression typecannot breakcannot continueswitchempty case rangetoo many 'default'duplicate label '%s''%s' undeclaredstruct or unionfunction pointertoo few arguments to functionfield not found: %sconstant expressionattribute namesection name'%s' attribute ignoredtoo many asm operandsmemoryinvalid clobber register '%s'unknown constraint '%c'%d(%%ebp)internal compiler error(%%%s)cannot use byte register%%%stoo many basic typessigned and unsigned modifierinvalid typeparameter declared as voidinvalid array sizestruct/union/enum nameinvalid type for '%s'zero width for bit-field '%s'index too largecastunknown type sizearray typeinvalid indexstruct/union typetoo many field initfield# %d "%s" Scould not read headerbad architecturereferenced dll '%s' not foundunrecognized ELF file! invalid archive//__.SYMDEF__.SYMDEF/ARFILENAMES/unrecognized file type%s/%slib%s.so%s/lib%s.a/usr/local/include/usr/include%s/include__CHAR_UNSIGNED__/usr/lib/crt1.o/usr/lib/crti.ofilename expectedAS_NEEDEDINPUTGROUPOUTPUT_FORMATTARGETlibtcc1.a/usr/lib/crtn.omain.interp.dynsym.hash.dynstr.dynamic.pltundefined dynamic symbol '%s'.shstrtabcould not write '%s'wb<- %s install: %s/ could not open '%sa.outcannot find %s-> %s ?IUBbenchbtstaticsharedsonamerunrdynamicWl,WOnostdincnostdlibprint-search-dirsvpipeEunsigned-charcommonleading-underscoreunsupportedwrite-stringsimplicit-function-declaration$tIO__MbP?;(|DԧdtzR| 0XAB E<hAB E\ AB E|ԩAB E@s | (`  pöooTpΊފ.>N^n~΋ދ.>N^n~Όތ.>N^n~! <=>=!=&&||++--==<<>>+=-=*=/=%=&=^=|=->..##/lib/ld-uClibc.so.0GCC: (Buildroot 2011.02) 4.3.5.shstrtab.interp.hash.dynsym.dynstr.gnu.version.gnu.version_r.rel.dyn.rel.plt.init.text.fini.rodata.eh_frame_hdr.eh_frame.ctors.dtors.jcr.dynamic.got.plt.data.bss.comment (( !``)oTTv6ö E N  W|| R ] @ci0T q0l0,\l\pppppq `r\Ц 0\{ELF44 (444Qtd/lib/ld-uClibc.so.0 g+4"" n|d"I libgcc_s.so.1__register_frame_info_bases__deregister_frame_info_bases_Jv_RegisterClasseslibc.so.0printf__uClibc_mainiopl_edata__bss_start_endGCC_3.0P&y ܕUS[]5ԕ%ؕ%ܕh%h%h%h%h 1^PTRhԄhQVh`$US=uH- X @ 9r4t h>]UZdtRjhh2=tt hЃÐL$qUQj Mb)QRh}1MɍaÐUSЃuX[]ÐUS[]Booted in %d.%03d s ]  ԄH Е(Ђooo*:JZjGCC: (Buildroot 2011.02) 4.3.5.shstrtab.interp.hash.dynsym.dynstr.gnu.version.gnu.version_r.rel.plt.init.text.fini.rodata.eh_frame.ctors.dtors.jcr.dynamic.got.plt.data.bss.comment @ HH!)o6o E Ђ( NI`TTZԄ`2hry  Е  0Z .A ..[ test4600.cal\ repeat.cal] bernoulli.cal^ randomrun.cal_ xx_print.cal` test3300.calaquat.calbpell.calcdms.cald solve.cale linear.calf test3500.calg varargs.calh psqrt.calicustomomod.calp mfactor.calqcusthelpy test8600.calzhms.cal{ regress.cal|pi.cal} unitfrac.cal~seedrandom.cal test5100.cal sumsq.cal pollard.cal prompt.cal help lucas.cal screen.cal bigprime.cal test8500.cal sumtimes.calrandbitrun.cal ellip.cal qtime.cal test2700.calsurd.calREADME lucas_chk.cal lucas_tbl.cal test5200.cal set8700.line natnumset.calrandombitrun.cal test3100.caldeg.cal test4000.cal test8400.cal test2600.cal/* * test4600 - 4600 series of the regress.cal test suite * * Copyright (C) 1999 Ernest Bowen and Landon Curt Noll * * Primary author: Ernest Bowen * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: test4600.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test4600.cal,v $ * * Under source code control: 1996/07/02 20:04:40 * File existed as early as: 1996 * * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ defaultverbose = 1; /* default verbose value */ /* * test globals */ global A, f, pos; define stest(str, verbose) { local x; /* setup */ if (isnull(verbose)) verbose = defaultverbose; if (verbose > 0) { print str:":",:; } x = rm("-f", "junk4600"); /* * do file operations */ f = fopen("junk4600", "wb"); if (iserror(f)) { print 'failed'; print '**** fopen("junk4600", "wb") failed'; return 1; } if (iserror(fputs(f, "Fourscore and seven years ago our fathers brought forth\n", "on this continent a new nation, conceived in liberty and dedicated\n", "to the proposition that all men are created equal.\n"))) { print 'failed'; print '**** fputs(f, "Fourscore ... failed'; return 1; } if (iserror(freopen(f, "rb"))) { print 'failed'; print '**** iserror(freopen(f, "rb")) failed'; return 1; } if (iserror(rewind(f))) { print 'failed'; print '**** iserror(rewind(f)) failed'; return 1; } if (search(f, "and") != 10) { print 'failed'; print '**** search(f, "and") != 10 failed'; return 1; } if (ftell(f) != 13) { print 'failed'; print '**** ftell(f) != 13 failed'; return 1; } if (search(f, "and") != 109) { print 'failed'; print '**** search(f, "and") != 109 failed'; return 1; } if (ftell(f) != 112) { print 'failed'; print '**** ftell(f) != 112 failed'; return 1; } if (!isnull(search(f, "and"))) { print 'failed'; print '**** !isnull(search(f, "and")) failed'; return 1; } if (ftell(f) != 172) { print 'failed'; print '**** ftell(f) != 172 failed'; return 1; } if (rsearch(f, "and") != 109) { print 'failed'; print '**** rsearch(f, "and") != 109 failed'; return 1; } if (ftell(f) != 111) { print 'failed'; print '**** ftell(f) != 111 failed'; return 1; } if (iserror(fseek(f, -4, 1))) { print 'failed'; print '**** iserror(fseek(f, -4, 1)) failed'; return 1; } if (rsearch(f, "and") != 10) { print 'failed'; print '**** rsearch(f, "and") != 10 failed'; return 1; } if (ftell(f) != 12) { print 'failed'; print '**** ftell(f) != 12 failed'; return 1; } if (iserror(fseek(f, -4, 1))) { print 'failed'; print '**** iserror(fseek(f, -4, 1)) failed'; return 1; } if (!isnull(rsearch(f, "and"))) { print 'failed'; print '**** !isnull(rsearch(f, "and")) failed'; return 1; } if (ftell(f) != 0) { print 'failed'; print '**** ftell(f) != 0 failed'; return 1; } if (iserror(fclose(f))) { print 'failed'; print '**** iserror(fclose(f)) failed'; return 1; } /* * cleanup */ x = rm("junk4600"); if (verbose > 0) { printf("passed\n"); } return 0; } define ttest(str, m, n, verbose) { local a, s, i, j; if (isnull(verbose)) verbose = defaultverbose; if (verbose > 0) { print str:":",:; } i = rm("-f", "junk4600"); f = fopen("junk4600", "wb"); if (isnull(n)) n = 4; if (isnull(m)) m = 4; mat A[m]; mat pos[m + 1]; pos[0] = 0; for (i = 0; i < m; i++) { j = 1 + randbit(n); a = ""; while (j-- > 0) a = strcat(a, char(rand(32, 127))); A[i] = a; fputs(f, a); pos[i+1] = ftell(f); if (verbose > 1) printf("A[%d] has length %d\n", i, strlen(a)); } fflush(f); if (verbose > 1) printf("File has size %d\n", pos[i]); freopen(f, "rb"); if (size(f) != pos[i]) { print 'failed'; printf("**** Failure 1 for file size\n"); return 1; } for (i = 0; i < m; i++) { rewind(f); for (;;) { j = search(f, A[i]); if (isnull(j) || j > pos[i]) { print 'failed'; printf("**** Failure 2 for i = %d\n", i); return 1; } if (j == pos[i]) break; fseek(f, j + 1, 0); } if (ftell(f) != pos[i + 1]) { print 'failed'; printf("**** Failure 3 for i = %d\n", i); return 1; } } for (i = m - 1; i >= 0; i--) { fseek(f, 0, 2); for (;;) { j = rsearch(f, A[i]); if (isnull(j) || j < pos[i]) { print 'failed'; printf("**** Failure 4 for i = %d\n", i); return 1; } if (j == pos[i]) break; fseek(f, -1, 1); } if (ftell(f) != pos[i + 1] - 1) { print 'failed'; printf("**** Failure 5 for i = %d\n", i); return 1; } } if (iserror(fclose(f))) { print 'failed'; printf("**** Failure 6 for i = %d\n", i); return 1; } i = rm("junk4600"); if (verbose > 0) { printf("passed\n"); } return 0; } define sprint(x) { local i, n; n = strlen(x); for (i = 1; i <= n; i++) print ord(substr(x, i, 1)),; print; } define findline(f,s) { if (!isfile(f)) quit "First argument to be a file"; if (!isstr(s)) quit "Second argument to be a string"; if (!isnull(search(f,s))) { rsearch(f, "\n"); print fgetline(f); } } define findlineold(f,s) { local str; if (!isfile(f)) quit "First argument to be a file"; if (!isstr(s)) quit "Second argument to be a string"; while (!isnull(str = fgetline(f)) && strpos(str, s) == 0); print str; } /* * test4600 - perform all of the above tests a bunch of times */ define test4600(v, tnum) { local n; /* test parameter */ local i; /* * set test parameters */ srand(4600e4600); /* * test a lot of stuff */ for (i=0; i < 10; ++i) { err += ttest(strcat(str(tnum++), ": ttest(",str(i),",",str(i),")"), i, i, v); err += stest(strcat(str(tnum++), ": stest()"), v); } /* * report results */ if (v > 1) { if (err) { print "****", err, "error(s) found in testall"; } else { print "no errors in testall"; } } return tnum; } /* * repeat - return the value of a repeated set of digits * * Copyright (C) 2003 Landon Curt Noll * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: repeat.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/repeat.cal,v $ * * Under source code control: 2003/01/05 00:00:01 * File existed as early as: 2003 * * chongo /\oo/\ http://www.isthe.com/chongo/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ /* * repeat - return the value of a repeated set of digits * * usage: * repeat(digit_set, repeat_count) */ define repeat(digit_set, repeat_count) { local digit_count; /* digits in the digit_set */ /* firewall */ if (!isint(digit_set) || digit_set <= 0) { quit "digit set must be an integer > 0"; } if (!isint(repeat_count) || repeat_count <= 0) { quit "repeat count must be an integer > 0"; } /* return repeated set of digits */ digit_count = digits(digit_set); return digit_set * (10^(digit_count*repeat_count)-1) / (10^digit_count-1); } /* * bernoulli - clculate the Nth Bernoulli number B(n) * * Copyright (C) 2000 David I. Bell and Landon Curt Noll * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: bernoulli.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/bernoulli.cal,v $ * * Under source code control: 1991/09/30 11:18:41 * File existed as early as: 1991 * * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ /* * Calculate the Nth Bernoulli number B(n). * * NOTE: This is now a bulitin function. * * The non-buildin code used the following symbolic formula to calculate B(n): * * (b+1)^(n+1) - b^(n+1) = 0 * * where b is a dummy value, and each power b^i gets replaced by B(i). * For example, for n = 3: * * (b+1)^4 - b^4 = 0 * b^4 + 4*b^3 + 6*b^2 + 4*b + 1 - b^4 = 0 * 4*b^3 + 6*b^2 + 4*b + 1 = 0 * 4*B(3) + 6*B(2) + 4*B(1) + 1 = 0 * B(3) = -(6*B(2) + 4*B(1) + 1) / 4 * * The combinatorial factors in the expansion of the above formula are * calculated interatively, and we use the fact that B(2i+1) = 0 if i > 0. * Since all previous B(n)'s are needed to calculate a particular B(n), all * values obtained are saved in an array for ease in repeated calculations. */ /* static Bnmax; static mat Bn[1001]; */ define B(n) { /* local nn, np1, i, sum, mulval, divval, combval; if (!isint(n) || (n < 0)) quit "Non-negative integer required for Bernoulli"; if (n == 0) return 1; if (n == 1) return -1/2; if (isodd(n)) return 0; if (n > 1000) quit "Very large Bernoulli"; if (n <= Bnmax) return Bn[n]; for (nn = Bnmax + 2; nn <= n; nn+=2) { np1 = nn + 1; mulval = np1; divval = 1; combval = 1; sum = 1 - np1 / 2; for (i = 2; i < np1; i+=2) { combval = combval * mulval-- / divval++; combval = combval * mulval-- / divval++; sum += combval * Bn[i]; } Bn[nn] = -sum / np1; } Bnmax = n; return Bn[n]; */ return bernoulli(n); } /* * randomrun - perform a run test on random() * * Copyright (C) 1999 Landon Curt Noll * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: randomrun.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/randomrun.cal,v $ * * Under source code control: 1997/02/19 03:35:59 * File existed as early as: 1997 * * chongo /\oo/\ http://www.isthe.com/chongo/ * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ /* * If X(j) < X(j+1) < ... X(j+k) >= X(j+k+1), then we have a run of 'k'. * We ignore the run breaker, X(j+k+1), and start with X(j+k+2) when * considering a new run in order to make our runs chi independent. * * See Knuth's "Art of Computer Programming - 2nd edition", * Volume 2 ("Seminumerical Algorithms"), Section 3.3.2. * "G. Run test", pp. 65-68, * "problem #14", pp. 74, 536. * * We use the suggestion in problem #14 to allow an application of the * chi-square test and to make estimating the run length probs easy. */ define randomrun(run_cnt) { local i; /* index */ local max_run; /* longest run */ local long_run_cnt; /* number of runs longer than MAX_RUN */ local run; /* current run length */ local tally_sum; /* sum of all tally values */ local last; /* last random number */ local current; /* current random number */ local MAX_RUN = 9; /* max run we will keep track of */ local mat tally[1:MAX_RUN]; /* tally of length of a rise run of 'x' */ local mat prob[1:MAX_RUN]; /* prob[x] = probability of 'x' length run */ /* * parse args */ if (param(0) == 0) { run_cnt = 65536; } /* * run setup */ max_run = 0; /* no runs yet */ long_run_cnt = 0; /* no long runs set */ current = random(); /* our first number */ run = 1; /* * compute the run length probabilities * * A run length of 'r' occurs with a probability of: * * 1/r! - 1/(r+1)! */ for (i=1; i <= MAX_RUN; ++i) { prob[i] = 1.0/fact(i) - 1.0/fact(i+1); } /* * look at a number of random number trials */ for (i=0; i < run_cnt; ++i) { /* get our current number */ last = current; current = random(); /* look for a run break */ if (current < last) { /* record the stats */ if (run > max_run) { max_run = run; } if (run > MAX_RUN) { ++long_run_cnt; } else { ++tally[run]; } /* start a new run */ current = random(); run = 1; /* note the continuing run */ } else { ++run; } } /* determine the number of runs found */ tally_sum = matsum(tally) + long_run_cnt; /* * print the stats */ printf("random run test used %d values to produce %d runs\n", run_cnt, tally_sum); for (i=1; i <= MAX_RUN; ++i) { printf("length=%d\tprob=%9.7f\texpect=%d \tcount=%d \terr=%9.7f\n", i, prob[i], round(tally_sum*prob[i]), tally[i], (tally[i] - round(tally_sum*prob[i]))/tally_sum); } printf("length>%d\t\t\t\t\tcount=%d\n", MAX_RUN, long_run_cnt); printf("max length=%d\n", max_run); } /* * xx_print - demo print object routines * * Copyright (C) 1999 Ernest Bowen * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: xx_print.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/xx_print.cal,v $ * * Under source code control: 1997/04/17 00:08:50 * File existed as early as: 1997 * * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ global listmax = 3; global matrowmax = 3; global matcolmax = 3; print "globals listmax, matrowmax, matcolmax defined; all assigned value 3"; print; global blkmax = 8; print "global blkmax defined, assigned value 8"; print; B = blk(); define is_octet(a) = istype(a, B[0]); define list_print(a) { local i; print "(":; for (i = 0; i < size(a); i++) { if (i > 0) print ",":; if (i >= listmax) { print "...":; break; } print a[[i]]:; } print ")":; } define mat_print (a) { local i, j; if (matdim(a) == 1) { for (i = 0; i < size(a); i++) { if (i >= matrowmax) { printf(" ..."); break; } printf("%8d", a[i]); } return; } if (matdim(a) > 2) quit "Dimension for mat_print greater than 2"; for (i = matmin(a,1); i <= matmax(a,1); i++) { if (i >= matmin(a,1) + matcolmax) { print " ..."; break; } for (j = matmin(a,2); j <= matmax(a,2); j++) { if (j >= matmin(a,2) + matrowmax) { printf(" ..."); break; } printf("%8d", a[i,j]); } print; } } define octet_print(a) { switch(a) { case 8: print "BS":; return; case 9: print "HT":; return; case 10: print "NL":; return; case 12: print "FF":; return; case 13: print "CR":; return; case 27: print "ESC":; return; } if (a > 31 && a < 127) print char(a):; else print "Non-print":; } define blk_print(a) { local i, n; n = size(a); printf("Unnamed block with %d bytes of data\n", n); print "First few characters: ":; for (i = 0; i < n; i++) { if (i >= blkmax) { print "...",; break; } print a[i],; } } define nblk_print (a) { local n, i; n = size(a); printf("Block named \"%s\" with %d bytes of data\n", name(a), n); print "First few characters: ":; for (i = 0; i < n; i++) { if (i >= blkmax) { print "...",; break; } print a[i],; } } define strchar(a) { if (isstr(a)) a = ord(a); else if (is_octet(a)) a = a; /* This converts octet to number */ else if (!isint(a) || a < 0 || a > 255) quit "Bad argument for strchar"; switch (a) { case 7: print "\\a":; return; case 8: print "\\b":; return; case 9: print "\\t":; return; case 10: print "\\n":; return; case 11: print "\\v":; return; case 12: print "\\f":; return; case 13: print "\\r":; return; case 27: print "\\e":; return; case 34: print "\\\"":; return; case 39: print "\\\'":; return; case 92: print "\\\\":; return; } if (a > 31 && a < 127) { print char(a):; return; } print "\\":; if (a >= 64) print a // 64:; a = a % 64; if (a >= 8) print a // 8:; a = a % 8; print a:; } define file_print(a) { local c; rewind(a); for (;;) { c = fgetc(a); if (iserror(c)) quit "Failure when reading from file"; if (isnull(c)) break; strchar(c); } print; } define error_print(a) { local n = iserror(a); if (n == 10001) { print "1/0":; return; } if (n == 10002) { print "0/0":; return; } print strerror(a):; } L = list(1,2,3,4,5); mat M1[5] = {1,2,3,4,5}; mat M2[4,4] = {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16}; B1 = blk() = {"A", "B", "C", "D"}; B2 = blk("sample") = {77, 102, 29, 13, 126, 8, 100, 27, 0, 1}; dummy = rm("-f", "xx_print.foo"); f = fopen("xx_print.foo", "w+"); fputstr(f, "alpha\nbeta\f\"gamma\""); fputstr(f, "\x09delta\n"); fputstr(f, "\1\2\3"); fflush(f); print "Here is a list:"; print L; print; print "A one-dimensional matrix:"; print M1; print; print "A two-dimensional matrix:"; print M2; print; print "An unnamed block:"; print B1; print; print "A named block with some special octets:"; print B2; print; print "A file:"; print f; print; undefine mat_print; fclose(f); print "f closed"; print; dummy = rm("-f", "xx_print.foo"); mat M[7] = {1, 2, 3/0, 0/0, eval(2+3), fgetc(f), 7}; print "Here is a matrix with some \"errors\" as elements": print M; print; define octet_print(a) { local b, x; x = a; for (b = 128; b; b >>= 1) print (x >= b ? (x -= b, 1) : 0):; } print "Here is the earlier block with a new octet_print()"; print B1; print; /* * test3300 - 3300 series of the regress.cal test suite * * Copyright (C) 1999 Ernest Bowen and Landon Curt Noll * * Primary author: Ernest Bowen * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: test3300.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/test3300.cal,v $ * * Under source code control: 1995/12/02 04:27:41 * File existed as early as: 1995 * * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ defaultverbose = 1; /* default verbose value */ define testi(str, n, N, verbose) { local A, t, i, j, d1, d2; local m; if (isnull(verbose)) verbose = defaultverbose; if (verbose > 0) { print str:":",:; } if (isnull(N)) N = 1e6; mat A[n,n]; for (i = 0; i < n; i++) for (j = 0; j < n; j++) A[i,j] = rand(-N, N); t = runtime(); d1 = det(A); t = runtime() - t; d2 = det(A^2); if (d2 != d1^2) { if (verbose > 0) { printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1); } return 1; /* error */ } else { if (verbose > 0) { printf("no errors\n"); } if (verbose > 1) { printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t); } } return 0; /* ok */ } define testr(str, n, N, verbose) { local A, t, i, j, d1, d2; if (isnull(verbose)) verbose = defaultverbose; if (verbose > 0) { print str:":",:; } if (isnull(N)) N = 1e6; mat A[n,n]; for (i = 0; i < n; i++) for (j = 0; j < n; j++) A[i,j] = rand(-(N^2), N^2)/rand(1, N); t = usertime(); d1 = det(A); t = usertime() - t; d2 = det(A^2); if (d2 != d1^2) { if (verbose > 0) { printf("*** Failure for n=%d, N=%d, d1=%d\n", n, N, d1); } return 1; /* error */ } else { if (verbose > 0) { printf("no errors\n"); } if (verbose > 1) { printf("ok: n=%d, N=%d, d1=%d, t=%d\n", n, N, d1, t); } } return 0; /* ok */ } /* * test3300 - perform all of the above tests a bunch of times */ define test3300(verbose, tnum) { local N; /* test parameter */ local i; /* * set test parameters */ if (isnull(verbose)) { verbose = defaultverbose; } N = 1e6; srand(3300e3300); /* * test a lot of stuff */ for (i=0; i < 19; ++i) { err += testi(strcat(str(tnum++), ": testi(", str(i), ")"), \ i, N, verbose); } for (i=0; i < 9; ++i) { err += testr(strcat(str(tnum++), ": testr(", str(i), ")"), \ i, N, verbose); } /* * test results */ if (verbose > 1) { if (err) { print "***", err, "error(s) found in testall"; } else { print "no errors in testall"; } } return tnum; } /* * quat - alculate using quaternions of the form: a + bi + cj + dk * * Copyright (C) 1999 David I. Bell * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: quat.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/quat.cal,v $ * * Under source code control: 1990/02/15 01:50:35 * File existed as early as: before 1990 * * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ /* * Routines to handle quaternions of the form: * a + bi + cj + dk * * Note: In this module, quaternians are manipulated in the form: * s + v * Where s is a scalar and v is a vector of size 3. */ obj quat {s, v}; /* definition of the quaternion object */ define quat(a,b,c,d) { local obj quat x; x.s = isnull(a) ? 0 : a; mat x.v[3]; x.v[0] = isnull(b) ? 0 : b; x.v[1] = isnull(c) ? 0 : c; x.v[2] = isnull(d) ? 0 : d; return x; } define quat_print(a) { print "quat(" : a.s : ", " : a.v[0] : ", " : a.v[1] : ", " : a.v[2] : ")" :; } define quat_norm(a) { return a.s^2 + dp(a.v, a.v); } define quat_abs(a, e) { return sqrt(a.s^2 + dp(a.v, a.v), e); } define quat_conj(a) { local obj quat x; x.s = a.s; x.v = -a.v; return x; } define quat_add(a, b) { local obj quat x; if (!istype(b, x)) { x.s = a.s + b; x.v = a.v; return x; } if (!istype(a, x)) { x.s = a + b.s; x.v = b.v; return x; } x.s = a.s + b.s; x.v = a.v + b.v; if (x.v) return x; return x.s; } define quat_sub(a, b) { local obj quat x; if (!istype(b, x)) { x.s = a.s - b; x.v = a.v; return x; } if (!istype(a, x)) { x.s = a - b.s; x.v = -b.v; return x; } x.s = a.s - b.s; x.v = a.v - b.v; if (x.v) return x; return x.s; } define quat_inc(a) { local x; x = a; x.s++; return x; } define quat_dec(a) { local x; x = a; x.s--; return x; } define quat_neg(a) { local obj quat x; x.s = -a.s; x.v = -a.v; return x; } define quat_mul(a, b) { local obj quat x; if (!istype(b, x)) { x.s = a.s * b; x.v = a.v * b; } else if (!istype(a, x)) { x.s = b.s * a; x.v = b.v * a; } else { x.s = a.s * b.s - dp(a.v, b.v); x.v = a.s * b.v + b.s * a.v + cp(a.v, b.v); } if (x.v) return x; return x.s; } define quat_div(a, b) { local obj quat x; if (!istype(b, x)) { x.s = a.s / b; x.v = a.v / b; return x; } return a * quat_inv(b); } define quat_inv(a) { local x, q2; obj quat x; q2 = a.s^2 + dp(a.v, a.v); x.s = a.s / q2; x.v = a.v / (-q2); return x; } define quat_scale(a, b) { local obj quat x; x.s = scale(a.s, b); x.v = scale(a.v, b); return x; } define quat_shift(a, b) { local obj quat x; x.s = a.s << b; x.v = a.v << b; if (x.v) return x; return x.s; } if (config("resource_debug") & 3) { print "obj quat {s, v} defined"; } /* * pell - solve Pell's equation * * Copyright (C) 1999 David I. Bell * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.1 $ * @(#) $Id: pell.cal,v 30.1 2007/03/16 11:09:54 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/pell.cal,v $ * * Under source code control: 1990/02/15 01:50:34 * File existed as early as: before 1990 * * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ /* * Solve Pell's equation; Returns the solution X to: X^2 - D * Y^2 = 1. * Type the solution to pells equation for a particular D. */ define pell(D) { local X, Y; X = pellx(D); if (isnull(X)) { print "D=":D:" is square"; return; } Y = isqrt((X^2 - 1) / D); print X : "^2 - " : D : "*" : Y : "^2 = " : X^2 - D*Y^2; } /* * Function to solve Pell's equation * Returns the solution X to: * X^2 - D * Y^2 = 1 */ define pellx(D) { local R, Rp, U, Up, V, Vp, A, T, Q1, Q2, n; local mat ans[2,2]; local mat tmp[2,2]; R = isqrt(D); Vp = D - R^2; if (Vp == 0) return; Rp = R + R; U = Rp; Up = U; V = 1; A = 0; n = 0; ans[0,0] = 1; ans[1,1] = 1; tmp[0,1] = 1; tmp[1,0] = 1; do { T = V; V = A * (Up - U) + Vp; Vp = T; A = U // V; Up = U; U = Rp - U % V; tmp[0,0] = A; ans *= tmp; n++; } while (A != Rp); Q2 = ans[[1]]; Q1 = isqrt(Q2^2 * D + 1); if (isodd(n)) { T = Q1^2 + D * Q2^2; Q2 = Q1 * Q2 * 2; Q1 = T; } return Q1; } /* * dms - calculate in degrees, minutes, and seconds (based on deg) * * Copyright (C) 1999,2010 David I. Bell and Landon Curt Noll * * Calc is open software; you can redistribute it and/or modify it under * the terms of the version 2.1 of the GNU Lesser General Public License * as published by the Free Software Foundation. * * Calc is distributed in the hope that it will be useful, but WITHOUT * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General * Public License for more details. * * A copy of version 2.1 of the GNU Lesser General Public License is * distributed with calc under the filename COPYING-LGPL. You should have * received a copy with calc; if not, write to Free Software Foundation, Inc. * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * * @(#) $Revision: 30.2 $ * @(#) $Id: dms.cal,v 30.2 2010/09/02 06:14:16 chongo Exp $ * @(#) $Source: /usr/local/src/cmd/calc/cal/RCS/dms.cal,v $ * * Under source code control: 1990/02/15 01:50:33 * File existed as early as: before 1990 * * Share and enjoy! :-) http://www.isthe.com/chongo/tech/comp/calc/ */ obj dms {deg, min, sec}; define dms(deg, min, sec) { local obj dms ans; /* return value */ /* default missing args to 0 */ if (isnull(sec)) { sec = 0; } if (isnull(min)) { min = 0; } /* load object */ ans.deg = deg; ans.min = min; ans.sec = sec; /* return properly formed object */ ans = fixdms(ans); return ans; } define dms_add(a, b) { local obj dms ans; /* return value */ /* initalize value to 1st arg */ if (istype(a, ans)) { /* 1st arg is dms object, load it */ ans.deg = a.deg; ans.min = a.min; ans.sec = a.sec; } else { /* 1st arg is not dms, assume scalar degrees */ ans.deg = a; ans.min = 0; ans.sec = 0; } /* add value of 2nd arg */ if (istype(b, ans)) { /* 2nd arg is dms object, add it */ ans.deg += b.deg; ans.min += b.min; ans.sec += b.sec; } else { /* 2nd arg is not dms, add scalar degrees */ ans.deg += b; } /* return normalized result */ ans = fixdms(ans); return ans; } define dms_neg(a) { local obj dms ans; /* return value */ /* negate argument */ if (istype(a, ans)) { /* 1st arg is dms object, load it */ ans.deg = -a.deg; ans.min = -a.min; ans.sec = -a.sec; } else { /* 2nd arg is not dms, negate scalar degrees */ ans.deg = -a; ans.min = 0; ans.sec = 0; } /* return normalized result */ ans = fixdms(ans); return ans; } define dms_sub(a, b) { local obj dms ans; /* return value */ /* initalize value to 1st arg */ if (istype(a, ans)) { /* 1st arg is dms object, load it */ ans.deg = a.deg; ans.min = a.min; ans.sec = a.sec; } else { /* 1st arg is not dms, assume scalar degrees */ ans.deg = a; ans.min = 0; ans.sec = 0; } /* subtract value of 2nd arg */ if (istype(b, ans)) { /* 2nd arg is dms object, subtract it */ ans.deg -= b.deg; ans.min -= b.min; ans.sec -= b.sec; } else { /* 2nd arg is not dms, subtract scalar degrees */ ans.deg -= b; } /* return normalized result */ ans = fixdms(ans); return ans; } define dms_mul(a, b) { local obj dms ans; /* return value */ /* dms object multiplication */ if (istype(a, ans) && istype(b, ans)) { ans.deg = dms_abs(a) * dms_abs(b); ans.min = 0; ans.sec = 0; /* scalar multiplication */ } else if (istype(a, ans)) { ans.deg = a.deg * b; ans.min = a.min * b; ans.sec = a.sec * b; } else { ans.deg = b.deg * a; ans.min = b.min * a; ans.sec = b.sec * a; } /* return normalized result */ ans = fixdms(ans); return ans; } define dms_print(a) { local obj dms ans; /* temp object for dms type testing */ /* firewall - arg must be a dms object */ if (! istype(a, ans)) { quit "dms_print called with non dms object"; } /* print in dms form */ print a.deg : 'd' : a.min : 'm' : a.sec : 's' :; } define dms_abs(a) { local obj dms ans; /* temp object for dms type testing */ local deg; /* return scalar value */ /* firewall - just absolute value non dms objects */ if (! istype(a, ans)) { return abs(a); } /* compute degrees */ deg = a.deg + a.min / 60 + a.sec / 3600; /* return degrees */ return deg; } define dms_norm(a) { local obj dms ans; /* temp object for dms type testing */ local deg; /* degrees */ /* firewall - arg must be a dms object */ if (! istype(a, ans)) { quit "dms_norm called with non dms object"; } /* square degrees (norm is the square of absolute value */ deg = dms_abs(a); /* return degrees */ return deg*deg; } define dms_test(a) { local obj dms ans; /* temp value */ /* firewall - arg must be a dms object */ if (! istype(a, ans)) { quit "dms_test called with non dms object"; } /* return false of non-zero */ ans = fixdms(a); if (ans.deg == 0 && ans.min == 0 && ans.sec == 0) { /* false */ return 0; } /* true */ return 1; } define dms_int(a) { local obj dms ans; /* return value */ /* firewall - arg must be a dms object */ if (! istype(a, ans)) { quit "dms_int called with non dms object"; } /* normalize the argument */ ans = fixdms(a); /* truncate to the nearest second */ ans.sec = int(ans.sec); /* return value to the nearest second */ return ans; } define dms_frac(a) { local obj dms ans; /* return value */ /* firewall - arg must be a dms object */ if (! istype(a, ans)) { quit "dms_frac called with non dms object"; } /* normalize the argument */ ans = fixdms(a); /* remove all but fractional seconds */ ans.deg = 0; ans.min = 0; ans.sec = frac(ans.sec); /* return value to the second fraction */ return ans; } define dms_rel(a,b) { local abs_a, abs_b; /* scalars of the arguments */ /* compute scalars of the arguments */ abs_a = dms_abs(a); abs_b = dms_abs(b);