1; This is a slightly modified version of the original source code from 2; from: https://github.com/davidgiven/cpmish/tree/master/third_party/bbcbasic 3; 4; For compatibility with z80asm the following changes were made: 5; * TITLE and PAGE directives were commented out 6; 7; For compatbility with the z88math library the following chnage was made: 8; * Implement FNEGATE in function table + code 9; 10; For compatbility with machines reserving one register the following change 11; was made: 12; * Use a static word to store the sp to be restored on error 13; 14 15IF !FORz88 16 17 SECTION bss_fp_bbc 18 19 20 21; Stores the stack for the exit condition 22stackstore: defw 0 23 24 SECTION code_fp_bbc 25 26 PUBLIC FPP 27 28; TITLE '(C) COPYRIGHT R.T.RUSSELL 1986' 29; 30;Z80 FLOATING POINT PACKAGE 31;(C) COPYRIGHT R.T.RUSSELL 1986 32;VERSION 0.0, 26-10-1986 33;VERSION 0.1, 14-12-1988 (BUG FIX) 34; 35;BINARY FLOATING POINT REPRESENTATION: 36; 32 BIT SIGN-MAGNITUDE NORMALIZED MANTISSA 37; 8 BIT EXCESS-128 SIGNED EXPONENT 38; SIGN BIT REPLACES MANTISSA MSB (IMPLIED "1") 39; MANTISSA=0 & EXPONENT=0 IMPLIES VALUE IS ZERO. 40; 41;BINARY INTEGER REPRESENTATION: 42; 32 BIT 2'S-COMPLEMENT SIGNED INTEGER 43; "EXPONENT" BYTE = 0 (WHEN PRESENT) 44; 45;NORMAL REGISTER ALLOCATION: MANTISSA - HLH'L' 46; EXPONENT - C 47;ALTERNATE REGISTER ALLOCATION: MANTISSA - DED'E' 48; EXPONENT - B 49; 50;Error codes: 51; 52BADOP EQU 1 ;Bad operation code 53DIVBY0 EQU 18 ;Division by zero 54TOOBIG EQU 20 ;Too big 55NGROOT EQU 21 ;Negative root 56LOGRNG EQU 22 ;Log range 57ACLOST EQU 23 ;Accuracy lost 58EXPRNG EQU 24 ;Exp range 59; 60 GLOBAL FPP 61; 62;Call entry and despatch code: 63; 64FPP: 65 ld (stackstore),sp ;z88dk 66; PUSH IY ;Save IY 67; LD IY,0 68; ADD IY,SP ;Save SP in IY 69 CALL OP ;Perform operation 70 CP A ;Good return (Z, NC) 71EXIT: 72 ;POP IY ;Restore IY 73 ret ;Return to caller 74; 75;Error exit: 76; 77BAD: LD A,BADOP ;"Bad operation code" 78ERROR: 79 ld sp,(stackstore) ;z88dk 80 ;LD SP,IY ;Restore SP from IY 81 OR A ;Set NZ 82 SCF ;Set C 83 JR EXIT 84; 85;Perform operation or function: 86; 87OP: CP +(RTABLE-DTABLE)/2 88 JR NC,BAD 89 CP +(FTABLE-DTABLE)/2 90 JR NC,DISPAT 91 EX AF,AF' 92 LD A,B 93 OR C ;Both integer? 94 CALL NZ,FLOATA ;No, so float both 95 EX AF,AF' 96DISPAT: PUSH HL 97 LD HL,DTABLE 98 PUSH BC 99 ADD A,A ;A = op-code * 2 100 LD C,A 101 LD B,0 ;BC = op-code * 2 102 ADD HL,BC 103 LD A,(HL) ;Get low byte 104 INC HL 105 LD H,(HL) ;Get high byte 106 LD L,A 107 POP BC 108 EX (SP),HL 109 RET ;Off to routine 110; 111;Despatch table: 112; 113DTABLE: DEFW IAND ;AND (INTEGER) 114 DEFW IBDIV ;DIV 115 DEFW IEOR ;EOR 116 DEFW IMOD ;MOD 117 DEFW IOR ;OR 118 DEFW ILE ;<= 119 DEFW INE ;<> 120 DEFW IGE ;>= 121 DEFW ILT ;< 122 DEFW IEQ ;= 123 DEFW IMUL ;* 124 DEFW IADD ;+ 125 DEFW IGT ;> 126 DEFW ISUB ;- 127 DEFW IPOW ;^ 128 DEFW IDIV ;/ 129; 130FTABLE: DEFW ABS ;ABS 131 DEFW ACS ;ACS 132 DEFW ASN ;ASN 133 DEFW ATN ;ATN 134 DEFW COS ;COS 135 DEFW DEG ;DEG 136 DEFW EXP ;EXP 137 DEFW INT ;INT 138 DEFW LN ;LN 139 DEFW LOG ;LOG 140 DEFW NOTK ;NOT 141 DEFW RAD ;RAD 142 DEFW SGN ;SGN 143 DEFW SIN ;SIN 144 DEFW SQR ;SQR 145 DEFW TAN ;TAN 146; 147 DEFW ZERO ;ZERO 148 DEFW FONE ;FONE 149 DEFW TRUE ;TRUE 150 DEFW PI ;PI 151; 152 DEFW VAL ;VAL 153 DEFW STR ;STR$ 154; 155 DEFW SFIX ;FIX 156 DEFW SFLOAT ;FLOAT 157; 158 DEFW FTEST ;TEST 159 DEFW FCOMP ;COMPARE 160 DEFW FNEGATE ;NEGATE (z88dk added) 161; 162RTABLE: DEFW FAND ;AND (FLOATING-POINT) 163 DEFW FBDIV ;DIV 164 DEFW FEOR ;EOR 165 DEFW FMOD ;MOD 166 DEFW FOR ;OR 167 DEFW FLE ;<= 168 DEFW FNE ;<> 169 DEFW FGE ;>= 170 DEFW FLT ;< 171 DEFW FEQ ;= 172 DEFW FMUL ;* 173 DEFW FADD ;+ 174 DEFW FGT ;> 175 DEFW FSUB ;- 176 DEFW FPOW ;^ 177 DEFW FDIV ;/ 178; 179 ;PAGE 180; 181;ARITHMETIC AND LOGICAL OPERATORS: 182;All take two arguments, in HLH'L'C & DED'E'B. 183;Output in HLH'L'C 184;All registers except IX, IY destroyed. 185; (N.B. FPOW destroys IX). 186; 187;FAND - Floating-point AND. 188;IAND - Integer AND. 189; 190FAND: CALL FIX2 191IAND: LD A,H 192 AND D 193 LD H,A 194 LD A,L 195 AND E 196 LD L,A 197 EXX 198 LD A,H 199 AND D 200 LD H,A 201 LD A,L 202 AND E 203 LD L,A 204 EXX 205 RET 206; 207;FEOR - Floating-point exclusive-OR. 208;IEOR - Integer exclusive-OR. 209; 210FEOR: CALL FIX2 211IEOR: LD A,H 212 XOR D 213 LD H,A 214 LD A,L 215 XOR E 216 LD L,A 217 EXX 218 LD A,H 219 XOR D 220 LD H,A 221 LD A,L 222 XOR E 223 LD L,A 224 EXX 225 RET 226; 227;FOR - Floating-point OR. 228;IOR - Integer OR. 229; 230FOR: CALL FIX2 231IOR: LD A,H 232 OR D 233 LD H,A 234 LD A,L 235 OR E 236 LD L,A 237 EXX 238 LD A,H 239 OR D 240 LD H,A 241 LD A,L 242 OR E 243 LD L,A 244 EXX 245 RET 246; 247;FMOD - Floating-point remainder. 248;IMOD - Integer remainder. 249; 250FMOD: CALL FIX2 251IMOD: LD A,H 252 XOR D ;DIV RESULT SIGN 253 BIT 7,H 254 EX AF,AF' 255 BIT 7,H 256 CALL NZ,NEGATE ;MAKE ARGUMENTS +VE 257 CALL SWAP 258 BIT 7,H 259 CALL NZ,NEGATE 260 LD B,H 261 LD C,L 262 LD HL,0 263 EXX 264 LD B,H 265 LD C,L 266 LD HL,0 267 LD A,-33 268 CALL DIVA ;DIVIDE 269 EXX 270 LD C,0 ;INTEGER MARKER 271 EX AF,AF' 272 RET Z 273 JP NEGATE 274; 275;BDIV - Integer division. 276; 277FBDIV: CALL FIX2 278IBDIV: CALL IMOD 279 OR A 280 CALL SWAP 281 LD C,0 282 RET P 283 JP NEGATE 284; 285;ISUB - Integer subtraction. 286;FSUB - Floating point subtraction with rounding. 287; 288ISUB: CALL SUB 289 RET PO 290 CALL ADD 291 CALL FLOAT2 292FSUB: LD A,D 293 XOR 80H ;CHANGE SIGN THEN ADD 294 LD D,A 295 JR FADD 296; 297;Reverse subtract. 298; 299RSUB: LD A,H 300 XOR 80H 301 LD H,A 302 JR FADD 303; 304;IADD - Integer addition. 305;FADD - Floating point addition with rounding. 306; 307IADD: CALL ADD 308 RET PO 309 CALL SUB 310 CALL FLOAT2 311FADD: DEC B 312 INC B 313 RET Z ;ARG 2 ZERO 314 DEC C 315 INC C 316 JP Z,SWAP ;ARG 1 ZERO 317 EXX 318 LD BC,0 ;INITIALISE 319 EXX 320 LD A,H 321 XOR D ;XOR SIGNS 322 PUSH AF 323 LD A,B 324 CP C ;COMPARE EXPONENTS 325 CALL C,SWAP ;MAKE DED'E'B LARGEST 326 LD A,B 327 SET 7,H ;IMPLIED 1 328 CALL NZ,FIX ;ALIGN 329 POP AF 330 LD A,D ;SIGN OF LARGER 331 SET 7,D ;IMPLIED 1 332 JP M,FADD3 ;SIGNS DIFFERENT 333 CALL ADD ;HLH'L'=HLH'L'+DED'E' 334 CALL C,DIV2 ;NORMALISE 335 SET 7,H 336 JR FADD4 337; 338FADD3: CALL SUB ;HLH'L'=HLH'L'-DED'E' 339 CALL C,NEG ;NEGATE HLH'L'B'C' 340 CALL FLO48 341 CPL ;CHANGE RESULT SIGN 342FADD4: EXX 343 EX DE,HL 344 LD HL,8000H 345 OR A ;CLEAR CARRY 346 SBC HL,BC 347 EX DE,HL 348 EXX 349 CALL Z,ODD ;ROUND UNBIASSED 350 CALL C,ADD1 ;ROUND UP 351 CALL C,INCC 352 RES 7,H 353 DEC C 354 INC C 355 JP Z,ZERO 356 OR A ;RESULT SIGNQ 357 RET P ;POSITIVE 358 SET 7,H ;NEGATIVE 359 RET 360; 361;IDIV - Integer division. 362;FDIV - Floating point division with rounding. 363; 364IDIV: CALL FLOAT2 365FDIV: DEC B ;TEST FOR ZERO 366 INC B 367 LD A,DIVBY0 368 JP Z,ERROR ;"Division by zero" 369 DEC C ;TEST FOR ZERO 370 INC C 371 RET Z 372 LD A,H 373 XOR D ;CALC. RESULT SIGN 374 EX AF,AF' ;SAVE SIGN 375 SET 7,D ;REPLACE IMPLIED 1's 376 SET 7,H 377 PUSH BC ;SAVE EXPONENTS 378 LD B,D ;LOAD REGISTERS 379 LD C,E 380 LD DE,0 381 EXX 382 LD B,D 383 LD C,E 384 LD DE,0 385 LD A,-32 ;LOOP COUNTER 386 CALL DIVA ;DIVIDE 387 EXX 388 BIT 7,D 389 EXX 390 CALL Z,DIVB ;NORMALISE & INC A 391 EX DE,HL 392 EXX 393 SRL B ;DIVISOR/2 394 RR C 395 OR A ;CLEAR CARRY 396 SBC HL,BC ;REMAINDER-DIVISOR/2 397 CCF 398 EX DE,HL ;RESULT IN HLH'L' 399 CALL Z,ODD ;ROUND UNBIASSED 400 CALL C,ADD1 ;ROUND UP 401 POP BC ;RESTORE EXPONENTS 402 CALL C,INCC 403 RRA ;LSB OF A TO CARRY 404 LD A,C ;COMPUTE NEW EXPONENT 405 SBC A,B 406 CCF 407 JP CHKOVF 408; 409;IMUL - Integer multiplication. 410; 411IMUL: LD A,H 412 XOR D 413 EX AF,AF' ;SAVE RESULT SIGN 414 BIT 7,H 415 CALL NZ,NEGATE 416 CALL SWAP 417 BIT 7,H 418 CALL NZ,NEGATE 419 LD B,H 420 LD C,L 421 LD HL,0 422 EXX 423 LD B,H 424 LD C,L 425 LD HL,0 426 LD A,-33 427 CALL MULA ;MULTIPLY 428 EXX 429 LD C,191 ;PRESET EXPONENT 430 CALL TEST ;TEST RANGE 431 JR NZ,IMUL1 ;TOO BIG 432 BIT 7,D 433 JR NZ,IMUL1 434 CALL SWAP 435 LD C,D ;INTEGER MARKER 436 EX AF,AF' 437 RET P 438 JP NEGATE 439; 440IMUL1: DEC C 441 EXX 442 SLA E 443 RL D 444 EXX 445 RL E 446 RL D 447 EXX 448 ADC HL,HL 449 EXX 450 ADC HL,HL 451 JP P,IMUL1 ;NORMALISE 452 EX AF,AF' 453 RET M 454 RES 7,H ;POSITIVE 455 RET 456; 457;FMUL - Floating point multiplication with rounding. 458; 459FMUL: DEC B ;TEST FOR ZERO 460 INC B 461 JP Z,ZERO 462 DEC C ;TEST FOR ZERO 463 INC C 464 RET Z 465 LD A,H 466 XOR D ;CALC. RESULT SIGN 467 EX AF,AF' 468 SET 7,D ;REPLACE IMPLIED 1's 469 SET 7,H 470 PUSH BC ;SAVE EXPONENTS 471 LD B,H ;LOAD REGISTERS 472 LD C,L 473 LD HL,0 474 EXX 475 LD B,H 476 LD C,L 477 LD HL,0 478 LD A,-32 ;LOOP COUNTER 479 CALL MULA ;MULTIPLY 480 CALL C,MULB ;NORMALISE & INC A 481 EXX 482 PUSH HL 483 LD HL,8000H 484 OR A ;CLEAR CARRY 485 SBC HL,DE 486 POP HL 487 CALL Z,ODD ;ROUND UNBIASSED 488 CALL C,ADD1 ;ROUND UP 489 POP BC ;RESTORE EXPONENTS 490 CALL C,INCC 491 RRA ;LSB OF A TO CARRY 492 LD A,C ;COMPUTE NEW EXPONENT 493 ADC A,B 494CHKOVF: JR C,CHKO1 495 JP P,ZERO ;UNDERFLOW 496 JR CHKO2 497CHKO1: JP M,OFLOW ;OVERFLOW 498CHKO2: ADD A,80H 499 LD C,A 500 JP Z,ZERO 501 EX AF,AF' ;RESTORE SIGN BIT 502 RES 7,H 503 RET P 504 SET 7,H 505 RET 506; 507;IPOW - Integer involution. 508; 509IPOW: CALL SWAP 510 BIT 7,H 511 PUSH AF ;SAVE SIGN 512 CALL NZ,NEGATE 513IPOW0: LD C,B 514 LD B,32 ;LOOP COUNTER 515IPOW1: CALL X2 516 JR C,IPOW2 517 DJNZ IPOW1 518 POP AF 519 EXX 520 INC L ;RESULT=1 521 EXX 522 LD C,H 523 RET 524; 525IPOW2: POP AF 526 PUSH BC 527 EX DE,HL 528 PUSH HL 529 EXX 530 EX DE,HL 531 PUSH HL 532 EXX 533 LD IX,0 534 ADD IX,SP 535 JR Z,IPOW4 536 PUSH BC 537 EXX 538 PUSH DE 539 EXX 540 PUSH DE 541 CALL SFLOAT 542 CALL RECIP 543 LD (IX+4),C 544 EXX 545 LD (IX+0),L 546 LD (IX+1),H 547 EXX 548 LD (IX+2),L 549 LD (IX+3),H 550 JR IPOW5 551; 552IPOW3: PUSH BC 553 EXX 554 SLA E 555 RL D 556 PUSH DE 557 EXX 558 RL E 559 RL D 560 PUSH DE 561 LD A,'*' & 0FH 562 PUSH AF 563 CALL COPY 564 CALL OP ;SQUARE 565 POP AF 566 CALL DLOAD5 567 CALL C,OP ;MULTIPLY BY X 568IPOW5: POP DE 569 EXX 570 POP DE 571 EXX 572 LD A,C 573 POP BC 574 LD C,A 575IPOW4: DJNZ IPOW3 576 POP AF 577 POP AF 578 POP AF 579 RET 580; 581FPOW0: POP AF 582 POP AF 583 POP AF 584 JR IPOW0 585; 586;FPOW - Floating-point involution. 587; 588FPOW: BIT 7,D 589 PUSH AF 590 CALL SWAP 591 CALL PUSH5 592 DEC C 593 INC C 594 JR Z,FPOW0 595 LD A,158 596 CP C 597 JR C,FPOW1 598 INC A 599 CALL FIX 600 EX AF,AF' 601 JP P,FPOW0 602FPOW1: CALL SWAP 603 CALL LN0 604 CALL POP5 605 POP AF 606 CALL FMUL 607 JP EXP0 608; 609;Integer and floating-point compare. 610;Result is TRUE (-1) or FALSE (0). 611; 612FLT: CALL FCP 613 JR ILT1 614ILT: CALL ICP 615ILT1: RET NC 616 JR TRUE 617; 618FGT: CALL FCP 619 JR IGT1 620IGT: CALL ICP 621IGT1: RET Z 622 RET C 623 JR TRUE 624; 625FGE: CALL FCP 626 JR IGE1 627IGE: CALL ICP 628IGE1: RET C 629 JR TRUE 630; 631FLE: CALL FCP 632 JR ILE1 633ILE: CALL ICP 634ILE1: JR Z,TRUE 635 RET NC 636 JR TRUE 637; 638FNE: CALL FCP 639 JR INE1 640INE: CALL ICP 641INE1: RET Z 642 JR TRUE 643; 644FEQ: CALL FCP 645 JR IEQ1 646IEQ: CALL ICP 647IEQ1: RET NZ 648TRUE: LD HL,-1 649 EXX 650 LD HL,-1 651 EXX 652 XOR A 653 LD C,A 654 RET 655; 656 ;PAGE 657; 658;FUNCTIONS: 659; 660;Result returned in HLH'L'C (floating point) 661;Result returned in HLH'L' (C=0) (integer) 662;All registers except IY destroyed. 663; 664;ABS - Absolute value 665;Result is numeric, variable type. 666; 667ABS: BIT 7,H 668 RET Z ;POSITIVE/ZERO 669 DEC C 670 INC C 671 JP Z,NEGATE ;INTEGER 672 RES 7,H 673 RET 674; 675;NOT - Complement integer. 676;Result is integer numeric. 677; 678NOTK: CALL SFIX 679 LD A,H 680 CPL 681 LD H,A 682 LD A,L 683 CPL 684 LD L,A 685 EXX 686 LD A,H 687 CPL 688 LD H,A 689 LD A,L 690 CPL 691 LD L,A 692 EXX 693 XOR A ;NUMERIC MARKER 694 RET 695; 696;PI - Return PI (3.141592654) 697;Result is floating-point numeric. 698; 699PI: LD HL,490FH 700 EXX 701 LD HL,0DAA2H 702 EXX 703 LD C,81H 704 XOR A ;NUMERIC MARKER 705 RET 706; 707;DEG - Convert radians to degrees 708;Result is floating-point numeric. 709; 710DEG: CALL FPI180 711 CALL FMUL 712 XOR A 713 RET 714; 715;RAD - Convert degrees to radians 716;Result is floating-point numeric. 717; 718RAD: CALL FPI180 719 CALL FDIV 720 XOR A 721 RET 722; 723;180/PI 724; 725FPI180: CALL SFLOAT 726 LD DE,652EH 727 EXX 728 LD DE,0E0D3H 729 EXX 730 LD B,85H 731 RET 732; 733;SGN - Return -1, 0 or +1 734;Result is integer numeric. 735; 736SGN: CALL TEST 737 OR C 738 RET Z ;ZERO 739 BIT 7,H 740 JP NZ,TRUE ;-1 741 CALL ZERO 742 JP ADD1 ;1 743; 744;VAL - Return numeric value of string. 745;Input: ASCII string at IX 746;Result is variable type numeric. 747; 748VAL: CALL SIGNQ 749 PUSH AF 750 CALL CON 751 POP AF 752 CP '-' 753 LD A,0 ;NUMERIC MARKER 754 RET NZ 755 DEC C 756 INC C 757 JP Z,NEGATE ;ZERO/INTEGER 758 LD A,H 759 XOR 80H ;CHANGE SIGN (FP) 760 LD H,A 761 XOR A 762 RET 763; 764;INT - Floor function 765;Result is integer numeric. 766; 767INT: DEC C 768 INC C 769 RET Z ;ZERO/INTEGER 770 LD A,159 771 LD B,H ;B7=SIGN BIT 772 CALL FIX 773 EX AF,AF' 774 AND B 775 CALL M,ADD1 ;NEGATIVE NON-INTEGER 776 LD A,B 777 OR A 778 CALL M,NEGATE 779 XOR A 780 LD C,A 781 RET 782; 783;SQR - square root 784;Result is floating-point numeric. 785; 786SQR: CALL SFLOAT 787SQR0: BIT 7,H 788 LD A,NGROOT 789 JP NZ,ERROR ;"-ve root" 790 DEC C 791 INC C 792 RET Z ;ZERO 793 SET 7,H ;IMPLIED 1 794 BIT 0,C 795 CALL Z,DIV2 ;MAKE EXPONENT ODD 796 LD A,C 797 SUB 80H 798 SRA A ;HALVE EXPONENT 799 ADD A,80H 800 LD C,A 801 PUSH BC ;SAVE EXPONENT 802 EX DE,HL 803 LD HL,0 804 LD B,H 805 LD C,L 806 EXX 807 EX DE,HL 808 LD HL,0 809 LD B,H 810 LD C,L 811 LD A,-31 812 CALL SQRA ;ROOT 813 EXX 814 BIT 7,B 815 EXX 816 CALL Z,SQRA ;NORMALISE & INC A 817 CALL SQRB 818 OR A ;CLEAR CARRY 819 CALL DIVB 820 RR E ;LSB TO CARRY 821 LD H,B 822 LD L,C 823 EXX 824 LD H,B 825 LD L,C 826 CALL C,ADD1 ;ROUND UP 827 POP BC ;RESTORE EXPONENT 828 CALL C,INCC 829 RRA 830 SBC A,A 831 ADD A,C 832 LD C,A 833 RES 7,H ;POSITIVE 834 XOR A 835 RET 836; 837;TAN - Tangent function 838;Result is floating-point numeric. 839; 840TAN: CALL SFLOAT 841 CALL PUSH5 842 CALL COS0 843 CALL POP5 844 CALL PUSH5 845 CALL SWAP 846 CALL SIN0 847 CALL POP5 848 CALL FDIV 849 XOR A ;NUMERIC MARKER 850 RET 851; 852;COS - Cosine function 853;Result is floating-point numeric. 854; 855COS: CALL SFLOAT 856COS0: CALL SCALE 857 INC E 858 INC E 859 LD A,E 860 JR SIN1 861; 862;SIN - Sine function 863;Result is floating-point numeric. 864; 865SIN: CALL SFLOAT 866SIN0: PUSH HL ;H7=SIGN 867 CALL SCALE 868 POP AF 869 RLCA 870 RLCA 871 RLCA 872 AND 4 873 XOR E 874SIN1: PUSH AF ;OCTANT 875 RES 7,H 876 RRA 877 CALL PIBY4 878 CALL C,RSUB ;X=(PI/4)-X 879 POP AF 880 PUSH AF 881 AND 3 882 JP PO,SIN2 ;USE COSINE APPROX. 883 CALL PUSH5 ;SAVE X 884 CALL SQUARE ;PUSH X*X 885 CALL POLY 886 DEFW 0A8B7H ;a(8) 887 DEFW 3611H 888 DEFB 6DH 889 DEFW 0DE26H ;a(6) 890 DEFW 0D005H 891 DEFB 73H 892 DEFW 80C0H ;a(4) 893 DEFW 888H 894 DEFB 79H 895 DEFW 0AA9DH ;a(2) 896 DEFW 0AAAAH 897 DEFB 7DH 898 DEFW 0 ;a(0) 899 DEFW 0 900 DEFB 80H 901 CALL POP5 902 CALL POP5 903 CALL FMUL 904 JP SIN3 905; 906SIN2: CALL SQUARE ;PUSH X*X 907 CALL POLY 908 DEFW 0D571H ;b(8) 909 DEFW 4C78H 910 DEFB 70H 911 DEFW 94AFH ;b(6) 912 DEFW 0B603H 913 DEFB 76H 914 DEFW 9CC8H ;b(4) 915 DEFW 2AAAH 916 DEFB 7BH 917 DEFW 0FFDDH ;b(2) 918 DEFW 0FFFFH 919 DEFB 7EH 920 DEFW 0 ;b(0) 921 DEFW 0 922 DEFB 80H 923 CALL POP5 924SIN3: POP AF 925 AND 4 926 RET Z 927 DEC C 928 INC C 929 RET Z ;ZERO 930 SET 7,H ;MAKE NEGATIVE 931 RET 932; 933;Floating-point one: 934; 935FONE: LD HL,0 936 EXX 937 LD HL,0 938 EXX 939 LD C,80H 940 RET 941; 942DONE: LD DE,0 943 EXX 944 LD DE,0 945 EXX 946 LD B,80H 947 RET 948; 949PIBY4: LD DE,490FH 950 EXX 951 LD DE,0DAA2H 952 EXX 953 LD B,7FH 954 RET 955; 956;EXP - Exponential function 957;Result is floating-point numeric. 958; 959EXP: CALL SFLOAT 960EXP0: CALL LN2 ;LN(2) 961 EXX 962 DEC E 963 LD BC,0D1CFH ;0.6931471805599453 964 EXX 965 PUSH HL ;H7=SIGN 966 CALL MOD48 ;"MODULUS" 967 POP AF 968 BIT 7,E 969 JR Z,EXP1 970 RLA 971 JP C,ZERO 972 LD A,EXPRNG 973 JP ERROR ;"Exp range" 974; 975EXP1: AND 80H 976 OR E 977 PUSH AF ;INTEGER PART 978 RES 7,H 979 CALL PUSH5 ;PUSH X*LN(2) 980 CALL POLY 981 DEFW 4072H ;a(7) 982 DEFW 942EH 983 DEFB 73H 984 DEFW 6F65H ;a(6) 985 DEFW 2E4FH 986 DEFB 76H 987 DEFW 6D37H ;a(5) 988 DEFW 8802H 989 DEFB 79H 990 DEFW 0E512H ;a(4) 991 DEFW 2AA0H 992 DEFB 7BH 993 DEFW 4F14H ;a(3) 994 DEFW 0AAAAH 995 DEFB 7DH 996 DEFW 0FD56H ;a(2) 997 DEFW 7FFFH 998 DEFB 7EH 999 DEFW 0FFFEH ;a(1) 1000 DEFW 0FFFFH 1001 DEFB 7FH 1002 DEFW 0 ;a(0) 1003 DEFW 0 1004 DEFB 80H 1005 CALL POP5 1006 POP AF 1007 PUSH AF 1008 CALL P,RECIP ;X=1/X 1009 POP AF 1010 JP P,EXP4 1011 AND 7FH 1012 NEG 1013EXP4: ADD A,80H 1014 ADD A,C 1015 JR C,EXP2 1016 JP P,ZERO ;UNDERFLOW 1017 JR EXP3 1018EXP2: JP M,OFLOW ;OVERFLOW 1019EXP3: ADD A,80H 1020 JP Z,ZERO 1021 LD C,A 1022 XOR A ;NUMERIC MARKER 1023 RET 1024; 1025RECIP: CALL DONE 1026RDIV: CALL SWAP 1027 JP FDIV ;RECIPROCAL 1028; 1029LN2: LD DE,3172H ;LN(2) 1030 EXX 1031 LD DE,17F8H 1032 EXX 1033 LD B,7FH 1034 RET 1035; 1036;LN - Natural log. 1037;Result is floating-point numeric. 1038; 1039LN: CALL SFLOAT 1040LN0: LD A,LOGRNG 1041 BIT 7,H 1042 JP NZ,ERROR ;"Log range" 1043 INC C 1044 DEC C 1045 JP Z,ERROR 1046 LD DE,3504H ;SQR(2) 1047 EXX 1048 LD DE,0F333H ;1.41421356237 1049 EXX 1050 CALL ICP0 ;MANTISSA>SQR(2)? 1051 LD A,C ;EXPONENT 1052 LD C,80H ;1 <= X < 2 1053 JR C,LN4 1054 DEC C 1055 INC A 1056LN4: PUSH AF ;SAVE EXPONENT 1057 CALL RATIO ;X=(X-1)/(X+1) 1058 CALL PUSH5 1059 CALL SQUARE ;PUSH X*X 1060 CALL POLY 1061 DEFW 0CC48H ;a(9) 1062 DEFW 74FBH 1063 DEFB 7DH 1064 DEFW 0AEAFH ;a(7) 1065 DEFW 11FFH 1066 DEFB 7EH 1067 DEFW 0D98CH ;a(5) 1068 DEFW 4CCDH 1069 DEFB 7EH 1070 DEFW 0A9E3H ;a(3) 1071 DEFW 2AAAH 1072 DEFB 7FH 1073 DEFW 0 ;a(1) 1074 DEFW 0 1075 DEFB 81H 1076 CALL POP5 1077 CALL POP5 1078 CALL FMUL 1079 POP AF ;EXPONENT 1080 CALL PUSH5 1081 EX AF,AF' 1082 CALL ZERO 1083 EX AF,AF' 1084 SUB 80H 1085 JR Z,LN3 1086 JR NC,LN1 1087 CPL 1088 INC A 1089LN1: LD H,A 1090 LD C,87H 1091 PUSH AF 1092 CALL FLOAT 1093 RES 7,H 1094 CALL LN2 1095 CALL FMUL 1096 POP AF 1097 JR NC,LN3 1098 JP M,LN3 1099 SET 7,H 1100LN3: CALL POP5 1101 CALL FADD 1102 XOR A 1103 RET 1104; 1105;LOG - base-10 logarithm. 1106;Result is floating-point numeric. 1107; 1108LOG: CALL LN 1109 LD DE,5E5BH ;LOG(e) 1110 EXX 1111 LD DE,0D8A9H 1112 EXX 1113 LD B,7EH 1114 CALL FMUL 1115 XOR A 1116 RET 1117; 1118;ASN - Arc-sine 1119;Result is floating-point numeric. 1120; 1121ASN: CALL SFLOAT 1122 CALL PUSH5 1123 CALL COPY 1124 CALL FMUL 1125 CALL DONE 1126 CALL RSUB 1127 CALL SQR0 1128 CALL POP5 1129 INC C 1130 DEC C 1131 LD A,2 1132 PUSH DE 1133 JR Z,ACS1 1134 POP DE 1135 CALL RDIV 1136 JR ATN0 1137; 1138;ATN - arc-tangent 1139;Result is floating-point numeric. 1140; 1141ATN: CALL SFLOAT 1142ATN0: PUSH HL ;SAVE SIGN 1143 RES 7,H 1144 LD DE,5413H ;TAN(PI/8)=SQR(2)-1 1145 EXX 1146 LD DE,0CCD0H 1147 EXX 1148 LD B,7EH 1149 CALL FCP0 ;COMPARE 1150 LD B,0 1151 JR C,ATN2 1152 LD DE,1A82H ;TAN(3*PI/8)=SQR(2)+1 1153 EXX 1154 LD DE,799AH 1155 EXX 1156 LD B,81H 1157 CALL FCP0 ;COMPARE 1158 JR C,ATN1 1159 CALL RECIP ;X=1/X 1160 LD B,2 1161 JP ATN2 1162ATN1: CALL RATIO ;X=(X-1)/(X+1) 1163 LD B,1 1164ATN2: PUSH BC ;SAVE FLAG 1165 CALL PUSH5 1166 CALL SQUARE ;PUSH X*X 1167 CALL POLY 1168 DEFW 0F335H ;a(13) 1169 DEFW 37D8H 1170 DEFB 7BH 1171 DEFW 6B91H ;a(11) 1172 DEFW 0AAB9H 1173 DEFB 7CH 1174 DEFW 41DEH ;a(9) 1175 DEFW 6197H 1176 DEFB 7CH 1177 DEFW 9D7BH ;a(7) 1178 DEFW 9237H 1179 DEFB 7DH 1180 DEFW 2A5AH ;a(5) 1181 DEFW 4CCCH 1182 DEFB 7DH 1183 DEFW 0A95CH ;a(3) 1184 DEFW 0AAAAH 1185 DEFB 7EH 1186 DEFW 0 ;a(1) 1187 DEFW 0 1188 DEFB 80H 1189 CALL POP5 1190 CALL POP5 1191 CALL FMUL 1192 POP AF 1193ACS1: CALL PIBY4 ;PI/4 1194 RRA 1195 PUSH AF 1196 CALL C,FADD 1197 POP AF 1198 INC B 1199 RRA 1200 CALL C,RSUB 1201 POP AF 1202 OR A 1203 RET P 1204 SET 7,H ;MAKE NEGATIVE 1205 XOR A 1206 RET 1207; 1208;ACS - Arc cosine=PI/2-ASN. 1209;Result is floating point numeric. 1210; 1211ACS: CALL ASN 1212 LD A,2 1213 PUSH AF 1214 JR ACS1 1215; 1216;Function STR - convert numeric value to ASCII string. 1217; Inputs: HLH'L'C = integer or floating-point number 1218; DE = address at which to store string 1219; IX = address of @% format control 1220; Outputs: String stored, with NUL terminator 1221; 1222;First normalise for decimal output: 1223; 1224STR: CALL SFLOAT 1225 LD B,0 ;DEFAULT PT. POSITION 1226 BIT 7,H ;NEGATIVE? 1227 JR Z,STR10 1228 RES 7,H 1229 LD A,'-' 1230 LD (DE),A ;STORE SIGN 1231 INC DE 1232STR10: XOR A ;CLEAR A 1233 CP C 1234 JR Z,STR2 ;ZERO 1235 PUSH DE ;SAVE TEXT POINTER 1236 LD A,B 1237STR11: PUSH AF ;SAVE DECIMAL COUNTER 1238 LD A,C ;BINARY EXPONENT 1239 CP 161 1240 JR NC,STR14 1241 CP 155 1242 JR NC,STR15 1243 CPL 1244 CP 225 1245 JR C,STR13 1246 LD A,-8 1247STR13: ADD A,28 1248 CALL POWR10 1249 PUSH AF 1250 CALL FMUL 1251 POP AF 1252 LD B,A 1253 POP AF 1254 SUB B 1255 JR STR11 1256STR14: SUB 32 1257 CALL POWR10 1258 PUSH AF 1259 CALL FDIV 1260 POP AF 1261 LD B,A 1262 POP AF 1263 ADD A,B 1264 JR STR11 1265STR15: LD A,9 1266 CALL POWR10 ;10^9 1267 CALL FCP0 1268 LD A,C 1269 POP BC 1270 LD C,A 1271 SET 7,H ;IMPLIED 1 1272 CALL C,X10B ;X10, DEC B 1273 POP DE ;RESTORE TEXT POINTER 1274 RES 7,C 1275 LD A,0 1276 RLA ;PUT CARRY IN LSB 1277; 1278;At this point decimal normalisation has been done, 1279;now convert to decimal digits: 1280; AHLH'L' = number in normalised integer form 1281; B = decimal place adjustment 1282; C = binary place adjustment (29-33) 1283; 1284STR2: INC C 1285 EX AF,AF' ;SAVE A 1286 LD A,B 1287 BIT 1,(IX+2) 1288 JR NZ,STR20 1289 XOR A 1290 CP (IX+1) 1291 JR Z,STR21 1292 LD A,-10 1293STR20: ADD A,(IX+1) ;SIG. FIG. COUNT 1294 OR A ;CLEAR CARRY 1295 JP M,STR21 1296 XOR A 1297STR21: PUSH AF 1298 EX AF,AF' ;RESTORE A 1299STR22: CALL X2 ;RL AHLH'L' 1300 ADC A,A 1301 CP 10 1302 JR C,STR23 1303 SUB 10 1304 EXX 1305 INC L ;SET RESULT BIT 1306 EXX 1307STR23: DEC C 1308 JR NZ,STR22 ;32 TIMES 1309 LD C,A ;REMAINDER 1310 LD A,H 1311 AND 3FH ;CLEAR OUT JUNK 1312 LD H,A 1313 POP AF 1314 JP P,STR24 1315 INC A 1316 JR NZ,STR26 1317 LD A,4 1318 CP C ;ROUND UP? 1319 LD A,0 1320 JR STR26 1321STR24: PUSH AF 1322 LD A,C 1323 ADC A,'0' ;ADD CARRY 1324 CP '0' 1325 JR Z,STR25 ;SUPPRESS ZERO 1326 CP '9'+1 1327 CCF 1328 JR NC,STR26 1329STR25: EX (SP),HL 1330 BIT 6,L ;ZERO FLAG 1331 EX (SP),HL 1332 JR NZ,STR27 1333 LD A,'0' 1334STR26: INC A ;SET +VE 1335 DEC A 1336 PUSH AF ;PUT ON STACK + CARRY 1337STR27: INC B 1338 CALL TEST ;IS HLH'L' ZERO? 1339 LD C,32 1340 LD A,0 1341 JR NZ,STR22 1342 POP AF 1343 PUSH AF 1344 LD A,0 1345 JR C,STR22 1346; 1347;At this point, the decimal character string is stored 1348; on the stack. Trailing zeroes are suppressed and may 1349; need to be replaced. 1350;B register holds decimal point position. 1351;Now format number and store as ASCII string: 1352; 1353STR3: EX DE,HL ;STRING POINTER 1354 LD C,-1 ;FLAG "E" 1355 LD D,1 1356 LD E,(IX+1) ;f2 1357 BIT 0,(IX+2) 1358 JR NZ,STR34 ;E MODE 1359 BIT 1,(IX+2) 1360 JR Z,STR31 1361 LD A,B ;F MODE 1362 OR A 1363 JR Z,STR30 1364 JP M,STR30 1365 LD D,B 1366STR30: LD A,D 1367 ADD A,(IX+1) 1368 LD E,A 1369 CP 11 1370 JR C,STR32 1371STR31: LD A,B ;G MODE 1372 LD DE,101H 1373 OR A 1374 JP M,STR34 1375 JR Z,STR32 1376 LD A,(IX+1) 1377 OR A 1378 JR NZ,STR3A 1379 LD A,10 1380STR3A: CP B 1381 JR C,STR34 1382 LD D,B 1383 LD E,B 1384STR32: LD A,B 1385 ADD A,129 1386 LD C,A 1387STR34: SET 7,D 1388 DEC E 1389STR35: LD A,D 1390 CP C 1391 JR NC,STR33 1392STR36: POP AF 1393 JR Z,STR37 1394 JP P,STR38 1395STR37: PUSH AF 1396 INC E 1397 DEC E 1398 JP M,STR4 1399STR33: LD A,'0' 1400STR38: DEC D 1401 JP PO,STR39 1402 LD (HL),'.' 1403 INC HL 1404STR39: LD (HL),A 1405 INC HL 1406 DEC E 1407 JP P,STR35 1408 JR STR36 1409; 1410STR4: POP AF 1411STR40: INC C 1412 LD C,L 1413 JR NZ,STR44 1414 LD (HL),'e' ;EXPONENT 1415 INC HL 1416 LD A,B 1417 DEC A 1418 JP P,STR41 1419 LD (HL),'-' 1420 INC HL 1421 NEG 1422STR41: LD (HL),'0' 1423 JR Z,STR47 1424 CP 10 1425 LD B,A 1426 LD A,':' 1427 JR C,STR42 1428 INC HL 1429 LD (HL),'0' 1430STR42: INC (HL) 1431 CP (HL) 1432 JR NZ,STR43 1433 LD (HL),'0' 1434 DEC HL 1435 INC (HL) 1436 INC HL 1437STR43: DJNZ STR42 1438STR47: INC HL 1439STR44: EX DE,HL 1440 RET 1441; 1442 ;PAGE 1443; 1444;Support subroutines: 1445; 1446DLOAD5: LD B,(IX+4) 1447 EXX 1448 LD E,(IX+0) 1449 LD D,(IX+1) 1450 EXX 1451 LD E,(IX+2) 1452 LD D,(IX+3) 1453 RET 1454; 1455;CON - Get unsigned numeric constant from ASCII string. 1456; Inputs: ASCII string at (IX). 1457; Outputs: Variable-type result in HLH'L'C 1458; IX updated (points to delimiter) 1459; A7 = 0 (numeric marker) 1460; 1461CON: CALL ZERO ;INITIALISE TO ZERO 1462 LD C,0 ;TRUNCATION COUNTER 1463 CALL NUMBER ;GET INTEGER PART 1464 CP '.' 1465 LD B,0 ;DECL. PLACE COUNTER 1466 CALL Z,NUMBIX ;GET FRACTION PART 1467 CP 'E' 1468 LD A,0 ;INITIALISE EXPONENT 1469 CALL Z,GETEXP ;GET EXPONENT 1470 BIT 7,H 1471 JR NZ,CON0 ;INTEGER OVERFLOW 1472 OR A 1473 JR NZ,CON0 ;EXPONENT NON-ZERO 1474 CP B 1475 JR NZ,CON0 ;DECIMAL POINT 1476 CP C 1477 RET Z ;INTEGER 1478CON0: SUB B 1479 ADD A,C 1480 LD C,159 1481 CALL FLOAT 1482 RES 7,H ;DITCH IMPLIED 1 1483 OR A 1484 RET Z ;DONE 1485 JP M,CON2 ;NEGATIVE EXPONENT 1486 CALL POWR10 1487 CALL FMUL ;SCALE 1488 XOR A 1489 RET 1490CON2: CP -38 1491 JR C,CON3 ;CAN'T SCALE IN ONE GO 1492 NEG 1493 CALL POWR10 1494 CALL FDIV ;SCALE 1495 XOR A 1496 RET 1497CON3: PUSH AF 1498 LD A,38 1499 CALL POWR10 1500 CALL FDIV 1501 POP AF 1502 ADD A,38 1503 JR CON2 1504; 1505;GETEXP - Get decimal exponent from string 1506; Inputs: ASCII string at (IX) 1507; (IX points at 'E') 1508; A = initial value 1509; Outputs: A = new exponent 1510; IX updated. 1511; Destroys: A,A',IX,F,F' 1512; 1513GETEXP: PUSH BC ;SAVE REGISTERS 1514 LD B,A ;INITIAL VALUE 1515 LD C,2 ;2 DIGITS MAX 1516 INC IX ;BUMP PAST 'E' 1517 CALL SIGNQ 1518 EX AF,AF' ;SAVE EXPONENT SIGN 1519GETEX1: CALL DIGITQ 1520 JR C,GETEX2 1521 LD A,B ;B=B*10 1522 ADD A,A 1523 ADD A,A 1524 ADD A,B 1525 ADD A,A 1526 LD B,A 1527 LD A,(IX) ;GET BACK DIGIT 1528 INC IX 1529 AND 0FH ;MASK UNWANTED BITS 1530 ADD A,B ;ADD IN DIGIT 1531 LD B,A 1532 DEC C 1533 JP P,GETEX1 1534 LD B,100 ;FORCE OVERFLOW 1535 JR GETEX1 1536GETEX2: EX AF,AF' ;RESTORE SIGN 1537 CP '-' 1538 LD A,B 1539 POP BC ;RESTORE 1540 RET NZ 1541 NEG ;NEGATE EXPONENT 1542 RET 1543; 1544;NUMBER: Get unsigned integer from string. 1545; Inputs: string at (IX) 1546; C = truncated digit count 1547; (initially zero) 1548; B = total digit count 1549; HLH'L' = initial value 1550; Outputs: HLH'L' = number (binary integer) 1551; A = delimiter. 1552; B, C & IX updated 1553; Destroys: A,B,C,D,E,H,L,B',C',D',E',H',L',IX,F 1554; 1555NUMBIX: INC IX 1556NUMBER: CALL DIGITQ 1557 RET C 1558 INC B ;INCREMENT DIGIT COUNT 1559 INC IX 1560 CALL X10 ;*10 & COPY OLD VALUE 1561 JR C,NUMB1 ;OVERFLOW 1562 DEC C ;SEE IF TRUNCATED 1563 INC C 1564 JR NZ,NUMB1 ;IMPORTANT! 1565 AND 0FH 1566 EXX 1567 LD B,0 1568 LD C,A 1569 ADD HL,BC ;ADD IN DIGIT 1570 EXX 1571 JR NC,NUMBER 1572 INC HL ;CARRY 1573 LD A,H 1574 OR L 1575 JR NZ,NUMBER 1576NUMB1: INC C ;TRUNCATION COUNTER 1577 CALL SWAP1 ;RESTORE PREVIOUS VALUE 1578 JR NUMBER 1579; 1580;FIX - Fix number to specified exponent value. 1581; Inputs: HLH'L'C = +ve non-zero number (floated) 1582; A = desired exponent (A>C) 1583; Outputs: HLH'L'C = fixed number (unsigned) 1584; fraction shifted into B'C' 1585; A'F' positive if integer input 1586; Destroys: C,H,L,A',B',C',H',L',F,F' 1587; 1588FIX: EX AF,AF' 1589 XOR A 1590 EX AF,AF' 1591 SET 7,H ;IMPLIED 1 1592FIX1: CALL DIV2 1593 CP C 1594 RET Z 1595 JP NC,FIX1 1596 JP OFLOW 1597; 1598;SFIX - Convert to integer if necessary. 1599; Input: Variable-type number in HLH'L'C 1600; Output: Integer in HLH'L', C=0 1601; Destroys: A,C,H,L,A',B',C',H',L',F,F' 1602; 1603;NEGATE - Negate HLH'L' 1604; Destroys: H,L,H',L',F 1605; 1606FIX2: CALL SWAP 1607 CALL SFIX 1608 CALL SWAP 1609SFIX: DEC C 1610 INC C 1611 RET Z ;INTEGER/ZERO 1612 BIT 7,H ;SIGN 1613 PUSH AF 1614 LD A,159 1615 CALL FIX 1616 POP AF 1617 LD C,0 1618 RET Z 1619NEGATE: OR A ;CLEAR CARRY 1620 EXX 1621NEG0: PUSH DE 1622 EX DE,HL 1623 LD HL,0 1624 SBC HL,DE 1625 POP DE 1626 EXX 1627 PUSH DE 1628 EX DE,HL 1629 LD HL,0 1630 SBC HL,DE 1631 POP DE 1632 RET 1633; 1634;NEG - Negate HLH'L'B'C' 1635; Also complements A (used in FADD) 1636; Destroys: A,H,L,B',C',H',L',F 1637; 1638NEG: EXX 1639 CPL 1640 PUSH HL 1641 OR A ;CLEAR CARRY 1642 LD HL,0 1643 SBC HL,BC 1644 LD B,H 1645 LD C,L 1646 POP HL 1647 JR NEG0 1648 1649; FNEGATE: z88dk added 1650FNEGATE: ;z88dk 1651 dec c ;z88dk 1652 inc c ;z88dk 1653 jp z, NEGATE ;z88dk 1654 ld a, h ;z88dk 1655 xor $80 ;z88dk 1656 ld h, a ;z88dk 1657 ret ;z88dk 1658 1659 1660; 1661;SCALE - Trig scaling. 1662;MOD48 - 48-bit floating-point "modulus" (remainder). 1663; Inputs: HLH'L'C unsigned floating-point dividend 1664; DED'E'B'C'B unsigned 48-bit FP divisor 1665; Outputs: HLH'L'C floating point remainder (H7=1) 1666; E = quotient (bit 7 is sticky) 1667; Destroys: A,B,C,D,E,H,L,B',C',D',E',H',L',IX,F 1668;FLO48 - Float unsigned number (48 bits) 1669; Input/output in HLH'L'B'C'C 1670; Destroys: C,H,L,B',C',H',L',F 1671; 1672SCALE: LD A,150 1673 CP C 1674 LD A,ACLOST 1675 JP C,ERROR ;"Accuracy lost" 1676 CALL PIBY4 1677 EXX 1678 LD BC,2169H ;3.141592653589793238 1679 EXX 1680MOD48: SET 7,D ;IMPLIED 1 1681 SET 7,H 1682 LD A,C 1683 LD C,0 ;INIT QUOTIENT 1684 LD IX,0 1685 PUSH IX ;PUT ZERO ON STACK 1686 CP B 1687 JR C,MOD485 ;DIVIDEND<DIVISOR 1688MOD481: EXX ;CARRY=0 HERE 1689 EX (SP),HL 1690 SBC HL,BC 1691 EX (SP),HL 1692 SBC HL,DE 1693 EXX 1694 SBC HL,DE 1695 JR NC,MOD482 ;DIVIDEND>=DIVISOR 1696 EXX 1697 EX (SP),HL 1698 ADD HL,BC 1699 EX (SP),HL 1700 ADC HL,DE 1701 EXX 1702 ADC HL,DE 1703MOD482: CCF 1704 RL C ;QUOTIENT 1705 JR NC,MOD483 1706 SET 7,C ;STICKY BIT 1707MOD483: DEC A 1708 CP B 1709 JR C,MOD484 ;DIVIDEND<DIVISOR 1710 EX (SP),HL 1711 ADD HL,HL ;DIVIDEND * 2 1712 EX (SP),HL 1713 EXX 1714 ADC HL,HL 1715 EXX 1716 ADC HL,HL 1717 JR NC,MOD481 ;AGAIN 1718 OR A 1719 EXX 1720 EX (SP),HL 1721 SBC HL,BC ;OVERFLOW, SO SUBTRACT 1722 EX (SP),HL 1723 SBC HL,DE 1724 EXX 1725 SBC HL,DE 1726 OR A 1727 JR MOD482 1728; 1729MOD484: INC A 1730MOD485: LD E,C ;QUOTIENT 1731 LD C,A ;REMAINDER EXPONENT 1732 EXX 1733 POP BC 1734 EXX 1735FLO48: BIT 7,H 1736 RET NZ 1737 EXX 1738 SLA C 1739 RL B 1740 ADC HL,HL 1741 EXX 1742 ADC HL,HL 1743 DEC C 1744 JP NZ,FLO48 1745 RET 1746; 1747;Float unsigned number 1748; Input/output in HLH'L'C 1749; Destroys: C,H,L,H',L',F 1750; 1751FLOAT: BIT 7,H 1752 RET NZ 1753 EXX ;SAME AS "X2" 1754 ADD HL,HL ;TIME-CRITICAL 1755 EXX ;REGION 1756 ADC HL,HL ;(BENCHMARKS) 1757 DEC C 1758 JP NZ,FLOAT 1759 RET 1760; 1761;SFLOAT - Convert to floating-point if necessary. 1762; Input: Variable-type number in HLH'L'C 1763; Output: Floating-point in HLH'L'C 1764; Destroys: A,C,H,L,H',L',F 1765; 1766FLOATA: EX AF,AF' 1767 ADD A,+(RTABLE-DTABLE)/2 1768 EX AF,AF' 1769FLOAT2: CALL SWAP 1770 CALL SFLOAT 1771 CALL SWAP 1772SFLOAT: DEC C 1773 INC C 1774 RET NZ ;ALREADY FLOATING-POINT 1775 CALL TEST 1776 RET Z ;ZERO 1777 LD A,H 1778 OR A 1779 CALL M,NEGATE 1780 LD C,159 1781 CALL FLOAT 1782 OR A 1783 RET M ;NEGATIVE 1784 RES 7,H 1785 RET 1786; 1787;ROUND UP 1788;Return with carry set if 32-bit overflow 1789; Destroys: H,L,B',C',H',L',F 1790; 1791ADD1: EXX 1792 LD BC,1 1793 ADD HL,BC 1794 EXX 1795 RET NC 1796 PUSH BC 1797 LD BC,1 1798 ADD HL,BC 1799 POP BC 1800 RET 1801; 1802;ODD - Add one if even, leave alone if odd. 1803; (Used to perform unbiassed rounding, i.e. 1804; number is rounded up half the time) 1805; Destroys: L',F (carry cleared) 1806; 1807ODD: OR A ;CLEAR CARRY 1808 EXX 1809 SET 0,L ;MAKE ODD 1810 EXX 1811 RET 1812; 1813;SWAP - Swap arguments. 1814; Exchanges DE,HL D'E',H'L' and B,C 1815; Destroys: A,B,C,D,E,H,L,D',E',H',L' 1816;SWAP1 - Swap DEHL with D'E'H'L' 1817; Destroys: D,E,H,L,D',E',H',L' 1818; 1819SWAP: LD A,C 1820 LD C,B 1821 LD B,A 1822SWAP1: EX DE,HL 1823 EXX 1824 EX DE,HL 1825 EXX 1826 RET 1827; 1828;DIV2 - destroys C,H,L,A',B',C',H',L',F,F' 1829;INCC - destroys C,F 1830;OFLOW 1831; 1832DIV2: CALL D2 1833 EXX 1834 RR B 1835 RR C 1836 EX AF,AF' 1837 OR B 1838 EX AF,AF' 1839 EXX 1840INCC: INC C 1841 RET NZ 1842OFLOW: LD A,TOOBIG 1843 JP ERROR ;"Too big" 1844; 1845;FTEST - Test for zero & sign 1846; Output: A=0 if zero, A=&40 if +ve, A=&C0 if -ve 1847; 1848FTEST: CALL TEST 1849 RET Z 1850 LD A,H 1851 AND 10000000B 1852 OR 01000000B 1853 RET 1854; 1855;TEST - Test HLH'L' for zero. 1856; Output: Z-flag set & A=0 if HLH'L'=0 1857; Destroys: A,F 1858; 1859TEST: LD A,H 1860 OR L 1861 EXX 1862 OR H 1863 OR L 1864 EXX 1865 RET 1866; 1867;FCOMP - Compare two numbers 1868; Output: A=0 if equal, A=&40 if L>R, A=&C0 if L<R 1869; 1870FCOMP: LD A,B 1871 OR C ;Both integer? 1872 JR NZ,FCOMP1 1873 CALL ICP 1874FCOMP0: LD A,0 1875 RET Z ;Equal 1876 LD A,80H 1877 RRA 1878 RET 1879; 1880FCOMP1: CALL FLOAT2 ;Float both 1881 CALL FCP 1882 JR FCOMP0 1883; 1884;Integer and floating point compare. 1885;Sets carry & zero flags according to HLH'L'C-DED'E'B 1886;Result pre-set to FALSE 1887;ICP1, FCP1 destroy A,F 1888; 1889;ZERO - Return zero. 1890; Destroys: A,C,H,L,H',L' 1891; 1892ICP: CALL ICP1 1893ZERO: LD A,0 1894 EXX 1895 LD H,A 1896 LD L,A 1897 EXX 1898 LD H,A 1899 LD L,A 1900 LD C,A 1901 RET 1902; 1903FCP: CALL FCP1 1904 JR ZERO ;PRESET FALSE 1905; 1906FCP0: LD A,C 1907 CP B ;COMPARE EXPONENTS 1908 RET NZ 1909ICP0: SBC HL,DE ;COMP MANTISSA MSB 1910 ADD HL,DE 1911 RET NZ 1912 EXX 1913 SBC HL,DE ;COMP MANTISSA LSB 1914 ADD HL,DE 1915 EXX 1916 RET 1917; 1918FCP1: LD A,H 1919 XOR D 1920 LD A,H 1921 RLA 1922 RET M 1923 JR NC,FCP0 1924 CALL FCP0 1925 RET Z ;** V0.1 BUG FIX 1926 CCF 1927 RET 1928; 1929ICP1: LD A,H 1930 XOR D 1931 JP P,ICP0 1932 LD A,H 1933 RLA 1934 RET 1935; 1936;ADD - Integer add. 1937;Carry, sign & zero flags valid on exit 1938; Destroys: H,L,H',L',F 1939; 1940X10B: DEC B 1941 INC C 1942X5: CALL COPY0 1943 CALL D2C 1944 CALL D2C 1945 EX AF,AF' ;SAVE CARRY 1946ADD: EXX 1947 ADD HL,DE 1948 EXX 1949 ADC HL,DE 1950 RET 1951; 1952;SUB - Integer subtract. 1953;Carry, sign & zero flags valid on exit 1954; Destroys: H,L,H',L',F 1955; 1956SUB: EXX 1957 OR A 1958 SBC HL,DE 1959 EXX 1960 SBC HL,DE 1961 RET 1962; 1963;X10 - unsigned integer * 10 1964; Inputs: HLH'L' initial value 1965; Outputs: DED'E' = initial HLH'L' 1966; Carry bit set if overflow 1967; If carry not set HLH'L'=result 1968; Destroys: D,E,H,L,D',E',H',L',F 1969;X2 - Multiply HLH'L' by 2 as 32-bit integer. 1970; Carry set if MSB=1 before shift. 1971; Sign set if MSB=1 after shift. 1972; Destroys: H,L,H',L',F 1973; 1974X10: CALL COPY0 ;DED'E'=HLH'L' 1975 CALL X2 1976 RET C ;TOO BIG 1977 CALL X2 1978 RET C 1979 CALL ADD 1980 RET C 1981X2: EXX 1982 ADD HL,HL 1983 EXX 1984 ADC HL,HL 1985 RET 1986; 1987;D2 - Divide HLH'L' by 2 as 32-bit integer. 1988; Carry set if LSB=1 before shift. 1989; Destroys: H,L,H',L',F 1990; 1991D2C: INC C 1992D2: SRL H 1993 RR L 1994 EXX 1995 RR H 1996 RR L 1997 EXX 1998 RET 1999; 2000;COPY - COPY HLH'L'C INTO DED'E'B 2001; Destroys: B,C,D,E,H,L,D',E',H',L' 2002; 2003COPY: LD B,C 2004COPY0: LD D,H 2005 LD E,L 2006 EXX 2007 LD D,H 2008 LD E,L 2009 EXX 2010 RET 2011; 2012;SQUARE - PUSH X*X 2013;PUSH5 - PUSH HLH'L'C ONTO STACK. 2014; Destroys: SP,IX 2015; 2016SQUARE: CALL COPY 2017 CALL FMUL 2018PUSH5: POP IX ;RETURN ADDRESS 2019 PUSH BC 2020 PUSH HL 2021 EXX 2022 PUSH HL 2023 EXX 2024 JP (IX) ;"RETURN" 2025; 2026;POP5 - POP DED'E'B OFF STACK. 2027; Destroys: A,B,D,E,D',E',SP,IX 2028; 2029POP5: POP IX ;RETURN ADDRESS 2030 EXX 2031 POP DE 2032 EXX 2033 POP DE 2034 LD A,C 2035 POP BC 2036 LD B,C 2037 LD C,A 2038 JP (IX) ;"RETURN" 2039; 2040;RATIO - Calculate (X-1)/(X+1) 2041; Inputs: X in HLH'L'C 2042; Outputs: (X-1)/(X+1) in HLH'L'C 2043; Destroys: Everything except IY,SP,I 2044; 2045RATIO: CALL PUSH5 ;SAVE X 2046 CALL DONE 2047 CALL FADD 2048 CALL POP5 ;RESTORE X 2049 CALL PUSH5 ;SAVE X+1 2050 CALL SWAP 2051 CALL DONE 2052 CALL FSUB 2053 CALL POP5 ;RESTORE X+1 2054 JP FDIV 2055; 2056;POLY - Evaluate a polynomial. 2057; Inputs: X in HLH'L'C and also stored at (SP+2) 2058; Polynomial coefficients follow call. 2059; Outputs: Result in HLH'L'C 2060; Destroys: Everything except IY,SP,I 2061;Routine terminates on finding a coefficient >=1. 2062;Note: The last coefficient is EXECUTED on return 2063; so must contain only innocuous bytes! 2064; 2065POLY: LD IX,2 2066 ADD IX,SP 2067 EX (SP),IX 2068 CALL DLOAD5 ;FIRST COEFFICIENT 2069POLY1: CALL FMUL 2070 LD DE,5 2071 ADD IX,DE 2072 CALL DLOAD5 ;NEXT COEFFICIENT 2073 EX (SP),IX 2074 INC B 2075 DEC B ;TEST 2076 JP M,FADD 2077 CALL FADD 2078 CALL DLOAD5 ;X 2079 EX (SP),IX 2080 JR POLY1 2081; 2082;POWR10 - Calculate power of ten. 2083; Inputs: A=power of 10 required (A<128) 2084; A=binary exponent to be exceeded (A>=128) 2085; Outputs: DED'E'B = result 2086; A = actual power of ten returned 2087; Destroys: A,B,D,E,A',D',E',F,F' 2088; 2089POWR10: INC A 2090 EX AF,AF' 2091 PUSH HL 2092 EXX 2093 PUSH HL 2094 EXX 2095 CALL DONE 2096 CALL SWAP 2097 XOR A 2098POWR11: EX AF,AF' 2099 DEC A 2100 JR Z,POWR14 ;EXIT TYPE 1 2101 JP P,POWR13 2102 CP C 2103 JR C,POWR14 ;EXIT TYPE 2 2104 INC A 2105POWR13: EX AF,AF' 2106 INC A 2107 SET 7,H 2108 CALL X5 2109 JR NC,POWR12 2110 EX AF,AF' 2111 CALL D2C 2112 EX AF,AF' 2113POWR12: EX AF,AF' 2114 CALL C,ADD1 ;ROUND UP 2115 INC C 2116 JP M,POWR11 2117 JP OFLOW 2118POWR14: CALL SWAP 2119 RES 7,D 2120 EXX 2121 POP HL 2122 EXX 2123 POP HL 2124 EX AF,AF' 2125 RET 2126; 2127;DIVA, DIVB - DIVISION PRIMITIVE. 2128; Function: D'E'DE = H'L'HLD'E'DE / B'C'BC 2129; Remainder in H'L'HL 2130; Inputs: A = loop counter (normally -32) 2131; Destroys: A,D,E,H,L,D',E',H',L',F 2132; 2133DIVA: OR A ;CLEAR CARRY 2134DIV0: SBC HL,BC ;DIVIDEND-DIVISOR 2135 EXX 2136 SBC HL,BC 2137 EXX 2138 JR NC,DIV1 2139 ADD HL,BC ;DIVIDEND+DIVISOR 2140 EXX 2141 ADC HL,BC 2142 EXX 2143DIV1: CCF 2144DIVC: RL E ;SHIFT RESULT INTO DE 2145 RL D 2146 EXX 2147 RL E 2148 RL D 2149 EXX 2150 INC A 2151 RET P 2152DIVB: ADC HL,HL ;DIVIDEND*2 2153 EXX 2154 ADC HL,HL 2155 EXX 2156 JR NC,DIV0 2157 OR A 2158 SBC HL,BC ;DIVIDEND-DIVISOR 2159 EXX 2160 SBC HL,BC 2161 EXX 2162 SCF 2163 JP DIVC 2164; 2165;MULA, MULB - MULTIPLICATION PRIMITIVE. 2166; Function: H'L'HLD'E'DE = B'C'BC * D'E'DE 2167; Inputs: A = loop counter (usually -32) 2168; H'L'HL = 0 2169; Destroys: D,E,H,L,D',E',H',L',A,F 2170; 2171MULA: OR A ;CLEAR CARRY 2172MUL0: EXX 2173 RR D ;MULTIPLIER/2 2174 RR E 2175 EXX 2176 RR D 2177 RR E 2178 JR NC,MUL1 2179 ADD HL,BC ;ADD IN MULTIPLICAND 2180 EXX 2181 ADC HL,BC 2182 EXX 2183MUL1: INC A 2184 RET P 2185MULB: EXX 2186 RR H ;PRODUCT/2 2187 RR L 2188 EXX 2189 RR H 2190 RR L 2191 JP MUL0 2192; 2193;SQRA, SQRB - SQUARE ROOT PRIMITIVES 2194; Function: B'C'BC = SQR (D'E'DE) 2195; Inputs: A = loop counter (normally -31) 2196; B'C'BCH'L'HL initialised to 0 2197; Destroys: A,B,C,D,E,H,L,B',C',D',E',H',L',F 2198; 2199SQR1: SBC HL,BC 2200 EXX 2201 SBC HL,BC 2202 EXX 2203 INC C 2204 JR NC,SQR2 2205 DEC C 2206 ADD HL,BC 2207 EXX 2208 ADC HL,BC 2209 EXX 2210 DEC C 2211SQR2: INC A 2212 RET P 2213SQRA: SLA C 2214 RL B 2215 EXX 2216 RL C 2217 RL B 2218 EXX 2219 INC C 2220 SLA E 2221 RL D 2222 EXX 2223 RL E 2224 RL D 2225 EXX 2226 ADC HL,HL 2227 EXX 2228 ADC HL,HL 2229 EXX 2230 SLA E 2231 RL D 2232 EXX 2233 RL E 2234 RL D 2235 EXX 2236 ADC HL,HL 2237 EXX 2238 ADC HL,HL 2239 EXX 2240 JP NC,SQR1 2241SQR3: OR A 2242 SBC HL,BC 2243 EXX 2244 SBC HL,BC 2245 EXX 2246 INC C 2247 JP SQR2 2248; 2249SQRB: ADD HL,HL 2250 EXX 2251 ADC HL,HL 2252 EXX 2253 JR C,SQR3 2254 INC A 2255 INC C 2256 SBC HL,BC 2257 EXX 2258 SBC HL,BC 2259 EXX 2260 RET NC 2261 ADD HL,BC 2262 EXX 2263 ADC HL,BC 2264 EXX 2265 DEC C 2266 RET 2267; 2268DIGITQ: LD A,(IX) 2269 CP '9'+1 2270 CCF 2271 RET C 2272 CP '0' 2273 RET 2274; 2275SIGNQ: LD A,(IX) 2276 INC IX 2277 CP ' ' 2278 JR Z,SIGNQ 2279 CP '+' 2280 RET Z 2281 CP '-' 2282 RET Z 2283 DEC IX 2284 RET 2285; 2286ENDIF 2287