~amaurycarvalho/msxbas2asm/trunk

BASIC_DEFTBL: equ 0xF6CA ; 26 table of variables defined by DEFINT, DEFSTR, DEFSNG and DEFDBL for each alphabet letter (2 = integer, 3 = String, 4 = Simple precision, 8 = Double precision).

389

390

BASIC_CURLIN: equ 0xF41C ; BASIC current line number

391

BASIC_INTVAL: equ 0xFCA0 ; interval value

392

BASIC_INTCNT: equ 0xFCA2 ; interval current count

393

394

BASIC_PRMPRV: equ 0xF74C ; Pointer to previous parameter block in PARM1

395

396

BASIC_TRPTBL: equ 0xFC4C ; 78 trap table - array of 3 bytes - state[1] (bit 0=on, bit 1=stop, bit 2=active) + address[2]

397

398

BASIC_TRPTBL_KEY: equ 0xFC4C ; 30 ON KEY GOSUB

399

BASIC_TRPTBL_STOP: equ 0xFC6A ; 3 ON STOP GOSUB

400

BASIC_TRPTBL_SPRITE: equ 0xFC6D ; 3 ON SPRITE GOSUB

401

BASIC_TRPTBL_STRIG: equ 0xFC70 ; 15 ON STRIG GOSUB

402

BASIC_TRPTBL_INTERVAL: equ 0xFC7F ; 3 ON INTERVAL GOSUB

403

BASIC_TRPTBL_OTHER: equ 0xFC82 ; 24 reserved for expansion

404

405

BASIC_ONGSBF: equ 0xFBD8 ; 1 trap occurred counter (0=not occurred)

406

407

408

409

;--------------------------------------------------------

410

; MATH PACK ROUTINES

411

;--------------------------------------------------------

412

413

;--------------------------------------------------------

414

; SUPPORT MACROS

415

;--------------------------------------------------------

416

COMPILE_TO_ROM: EQU 1

417

418

MACRO __call_basic,CALL_PARM

419

ld ix, CALL_PARM

420

call BIOS_CALBAS

421

ENDM

422

423

if defined COMPILE_TO_DOS

424

425

MACRO __call_bios,CALL_PARM

426

;ld iy,(BIOS_EXPTBL-1)

427

ld ix, CALL_PARM

428

call BIOS_CALBAS ; BIOS_CALSLT

429

ENDM

430

431

else

432

433

MACRO __call_bios,CALL_PARM

434

call CALL_PARM

435

ENDM

436

437

endif

438

439

MACRO push.parm

440

push hl ; save parameter

441

ENDM

442

443

MACRO pop.parm

444

pop iy ; restore PC of caller

445

pop hl ; get next parameter

446

push iy ; save PC of caller

447

ENDM

448

449

MACRO push.ret.parm

450

pop iy ; restore PC of caller

451

push hl ; save return parameter

452

push iy ; save PC of caller

453

ENDM

454

455

MACRO ret.parm

456

pop iy ; restore PC of caller

457

push hl ; save return parameter

458

push iy ; save PC of caller

459

ret ; return

460

ENDM

461

462

MACRO set.line.number, line_number

463

ld bc, line_number ; current line number

464

ld (BASIC_CURLIN), bc

465

ENDM

466

467

MACRO verify.break

468

ld a, (BIOS_INTFLG) ; verify CTRL+BREAK

469

or a

470

jp nz, end_pgm

471

ENDM

472

473

MACRO check.traps

474

ld a, (BASIC_ONGSBF) ; trap occured counter

475

or a

476

call nz, RUN_TRAPS

477

ENDM

478

479

480

;---------------------------------------------------------------------------------------------------------

481

; PROGRAM HEADER

482

;---------------------------------------------------------------------------------------------------------

483

484

romSize: equ 0x8000 ; ROM size (32k)

485

pageSize: equ 0x4000 ; Page size (16k)

486

lowLimitSize: equ 0x400 ; 10% of a page size

487

488

if defined COMPILE_TO_BIN

489

490

pgmArea: equ 0x8000 ; page 2 - program area

491

ramArea: equ 0xc000 ; page 3 - free RAM start area

492

493

org pgmArea ; program binary type start address

494

db 0FEh ; binary file ID

495

dw start_pgm ; begin address

496

dw end_file - 1 ; end address

497

dw start_pgm ; program execution address (for ,R option)

498

499

else

500

if defined COMPILE_TO_ROM

501

502

pgmArea: equ 0x4000 ; page 1 and 2 - program area

503

ramArea: equ 0xc000 ; page 3 - free RAM start area

504

505

org pgmArea ; program rom type start address

506

db 'AB' ; rom file ID

507

dw start_pgm ; INIT

508

dw 0x0000 ; STATEMENT

509

dw 0x0000 ; DEVICE

510

dw 0x0000 ; TEXT

511

ds 6,0 ; RESERVED

512

513

else

514

515

pgmArea: equ 0x8000 ; page 2 - program area

516

ramArea: equ 0xc000 ; page 3 - free RAM start area

517

518

org pgmArea ; program DOS type start address ; 0x0100

519

520

endif

521

endif

522

523

524

;---------------------------------------------------------------------------------------------------------

525

; PROGRAM ROUTINES

526

;---------------------------------------------------------------------------------------------------------

527

528

if defined COMPILE_TO_ROM

529

530

PROGRAM_TO_BASIC:

531

call PROGRAM_SLOT_2_RESTORE

532

__call_basic BASIC_READYR ; warm start Basic

533

ret

534

535

PROGRAM_SLOT_2_SAVE:

536

ld h,080h

537

call PROGRAM_SLOT_GET

538

ld (BIOS_RAMAD2), a ; Save RAM slot of page 8000h-BFFFh

539

ret

540

541

PROGRAM_SLOT_2_RESTORE:

542

ld a, (BIOS_RAMAD2)

543

ld h,080h

544

jp BIOS_ENASLT ; Select the RAM on page 8000h-BFFFh

545

546

PROGRAM_SLOT_2_ENABLE:

547

call BIOS_RSLREG

548

call PROGRAM_SLOT_ENABLE_SUB

549

ld h,080h

550

jp BIOS_ENASLT ; Select the ROM on page 8000h-BFFFh

551

552

PROGRAM_SLOT_1_ENABLE:

553

call BIOS_RSLREG

554

rrca

555

rrca

556

call PROGRAM_SLOT_ENABLE_SUB

557

ld h,040h

558

jp BIOS_ENASLT ; Select the ROM on page 4000h-7FFFh

559

560

PROGRAM_SLOT_ENABLE_SUB:

561

rrca

562

rrca

563

and 3 ;Keep bits corresponding to the page

564

ld c,a

565

ld b,0

566

ld hl,BIOS_EXPTBL

567

add hl,bc

568

ld a,(hl)

569

and 80h

570

or c

571

ld c,a

572

inc hl

573

inc hl

574

inc hl

575

inc hl

576

ld a,(hl)

577

and 0Ch

578

or c

579

ret

580

581

; h = memory page

582

; a <- slot ID formatted FxxxSSPP

583

; Modifies: af, bc, de, hl

584

; ref: https://www.msx.org/forum/msx-talk/development/fusion-c-and-htimi#comment-366469

585

PROGRAM_SLOT_GET:

586

call BIOS_RSLREG

587

bit 7,h

588

jr z,PrimaryShiftContinue

589

rrca

590

rrca

591

rrca

592

rrca

593

PrimaryShiftContinue:

594

bit 6,h

595

jr z,PrimaryShiftDone

596

rrca

597

rrca

598

PrimaryShiftDone:

599

and 00000011B

600

ld c,a

601

ld b,0

602

ex de,hl

603

ld hl,BIOS_EXPTBL

604

add hl,bc

605

ld c,a

606

ld a,(hl)

607

and 80H

608

or c

609

ld c,a

610

inc hl ; move to SLTTBL

611

inc hl

612

inc hl

613

inc hl

614

ld a,(hl)

615

ex de,hl

616

bit 7,h

617

jr z,SecondaryShiftContinue

618

rrca

619

rrca

620

rrca

621

rrca

622

SecondaryShiftContinue:

623

bit 6,h

624

jr nz,SecondaryShiftDone

625

rlca

626

rlca

627

SecondaryShiftDone:

628

and 00001100B

629

or c

630

ret

631

632

endif

633

634

if defined COMPILE_TO_DOS

635

636

BIOS_SLOT_ENABLE:

637

ld a, (BIOS_EXPTBL)

638

ld hl,0

639

__call_bios BIOS_ENASLT ; Select main ROM on page 0 (0000h~3FFFh)

640

ret

641

642

BASIC_SLOT_ENABLE:

643

ld a, (BIOS_EXPTBL)

644

ld hl,04000h

645

__call_bios BIOS_ENASLT ; Select main ROM on page 1 (4000h~7FFFh)

646

ret

647

648

endif

649

650

651

652

;---------------------------------------------------------------------------------------------------------

653

; PROGRAM MAIN CODE

654

;---------------------------------------------------------------------------------------------------------

655

656

start_pgm: ; start of the program

657

658

if defined COMPILE_TO_DOS

659

660

call BIOS_SLOT_ENABLE ; enable bios on page 0

661

call BASIC_SLOT_ENABLE ; enable basic on page 1

662

663

else

664

if defined COMPILE_TO_ROM

665

666

call PROGRAM_SLOT_2_SAVE ; save slot on page 2

667

call PROGRAM_SLOT_2_ENABLE ; enable program on page 2

668

669

endif

670

endif

671

672

__call_bios BIOS_ERAFNK ; turn off function keys display

673

__call_bios BIOS_GICINI ; initialize sound system

674

__call_bios BIOS_INITXT ; initialize text screen

675

xor a

676

ld (BIOS_CLIKSW), a ; disable keyboard click

677

ld bc, 0xFFFF ;

678

ld (BASIC_CURLIN), bc ; interpreter in direct mode

679

__call_basic BASIC_TRAP_CLEAR ; clear traps work space

680

;call INITIALIZE_PARAMETERS ; initialize parameters stack

681

call memory.init ; initialize memory allocation

682

call INITIALIZE_VARIABLES ; initialize variables

683

684

685

TAG_10:

686

call CLS ; action call

687

688

TAG_20:

689

ld hl, LIT_5 ; parameter

690

push.parm

691

call PRINT ; action call

692

ld hl, PRINT.CRLF ; parameter

693

push.parm

694

call PRINT ; action call

695

696

TAG_30:

697

ld hl, LIT_7 ; parameter

698

push.parm

699

ld hl, IDF_6 ; parameter

700

push.parm

701

call LET ; action call

702

703

TAG_40:

704

ld hl, IDF_6 ; parameter

705

push.parm

706

ld hl, LIT_9 ; parameter

707

push.parm

708

call MATH.ADD ; action call

709

ld hl, IDF_6 ; parameter

710

push.parm

711

call LET ; action call

712

713

TAG_50:

714

ld hl, IDF_6 ; parameter

715

push.parm

716

ld hl, LIT_12 ; parameter

717

push.parm

718

call MATH.MULT ; action call

719

ld hl, LIT_14 ; parameter

720

push.parm

721

call MATH.ADD ; action call

722

ld hl, IDF_11 ; parameter

723

push.parm

724

call LET ; action call

725

726

TAG_60:

727

ld hl, IDF_6 ; parameter

728

push.parm

729

call PRINT ; action call

730

ld hl, LIT_15 ; parameter

731

push.parm

732

call PRINT ; action call

733

ld hl, IDF_11 ; parameter

734

push.parm

735

call PRINT ; action call

736

ld hl, PRINT.CRLF ; parameter

737

push.parm

738

call PRINT ; action call

739

740

TAG_70:

741

jp TAG_40 ; go to

742

743

;---------------------------------------------------------------------------------------------------------

744

; PROGRAM END CODE

745

;---------------------------------------------------------------------------------------------------------

746

747

end_pgm: __call_bios BIOS_DSPFNK ; turn on function keys display

748

ld a, 1 ;

749

ld (BIOS_CLIKSW), a ; enable keyboard click

750

751

if defined COMPILE_TO_ROM

752

jp PROGRAM_TO_BASIC

753

else

754

__call_basic BASIC_READYR ; warm start Basic

755

endif

756

757

ret ; end of the program

758

759

;__call_bios BIOS_GICINI ; initialize sound system

760

;if defined COMPILE_TO_DOS or defined COMPILE_TO_ROM

761

; __call_bios BIOS_RESET ; restart Basic

762

;else

763

; __call_basic BASIC_END ; end to Basic

764

;endif

765

766

767

;---------------------------------------------------------------------------------------------------------

768

; MSX BASIC KEYWORDS

769

;---------------------------------------------------------------------------------------------------------

770

771

; keyword

772

LET:

773

774

; out IX = variable assigned address

775

pop.parm ; get variable address parameter

776

push hl ; just to transfer hl to ix

777

pop ix ;

778

ld a, (ix) ; get variable type

779

cp 3 ; test if string

780

jr nz, LET.PARM ; if not a string, it isn't necessary to free memory

781

ld a, (ix + 3) ; get variable string length

782

or a ; cp 0

783

jr z, LET.PARM ; if zero, it isn't necessary to free memory

784

ld c, (ix + 4) ; get old string address low

785

ld b, (ix + 5) ; get old string address high

786

push ix ; save variable address

787

push bc ; just to transfer bc (old string address) to ix

788

pop ix ;

789

call memory.free ; free memory

790

pop ix ; restore variable address

791

LET.PARM: pop.parm ; get data address parameter (out hl = data address)

792

ld a, (ix + 2) ; get variable type flag

793

or a ; cp 0 - test type flag (0=any, 255=fixed)

794

jr nz, LET.FIXED ; if type flag is fixed, so casting is necessary

795

LET.ANY: push ix ; just to transfer ix (variable address) to de

796

pop de ;

797

ldi ; copy 1 byte from hl (data address) to de (variable address)

798

inc de ; go to variable data area

799

inc de ;

800

inc hl ; go to data data area

801

inc hl ;

802

ld bc, 8 ; data = 8 bytes

803

ldir ; copy bc bytes from hl (data address) to de (variable address)

804

ld a, (ix) ; get variable type

805

cp 3 ; test if string

806

ret nz ; if not string, return

807

jp LET.STRING ; else do string treatment (in ix = variable address)

808

LET.FIXED: push ix ; save variable destination address

809

push hl ; save variable source address

810

ld a, (ix) ; get variable fixed type, and hl has parameter data address

811

call CAST_TO ; cast data to type (in hl = variable address, a = type to, out hl = casted data address)

812

pop de

813

pop ix ; restore variable address

814

ld a, (ix) ; get variable destination type again

815

cp 3 ; test if string

816

jr nz, LET.VALUE ; if not string, do value treatment

817

ld a, (de) ; get variable source type again

818

cp 3 ; test if string

819

jr nz, LET.FIX1 ; if not string, get casted string size

820

inc de

821

inc de

822

inc de

823

ld a, (de)

824

ld (ix + 3), a ; source string size

825

jr LET.FIX2

826

LET.FIX1: push hl

827

call GET_STR.LENGTH ; get string length (in HL, out B)

828

pop hl

829

ld (ix + 3), b ; set variable length

830

LET.FIX2: ld (ix + 4), l ; casted data address low

831

ld (ix + 5), h ; casted data address high

832

jp LET.STRING ; do string treatment (in ix = variable address)

833

LET.VALUE: push ix ; just to transfer ix (variable address) to de

834

pop de ;

835

inc de ; go to variable data area (and the data from its casted)

836

inc de ;

837

inc de ;

838

ld bc, 8 ; data = 8 bytes

839

ldir ; copy bc bytes from hl (data address) to de (variable address)

840

ret ;

841

LET.STRING: ld a, (ix + 3) ; string size

842

or a ; cp 0 - test if null

843

jr nz, LET.ALLOC ; if not null, allocate new string (in ix = variable address)

844

ld bc, LIT_NULL_STR ; else, set to a null string literal

845

ld (ix + 4), c ; variable address low

846

ld (ix + 5), b ; variable address high

847

ret ;

848

LET.ALLOC: push ix ; save variable address

849

ld l, (ix + 4) ; source string address low

850

ld h, (ix + 5) ; source string address high

851

push hl ; save copy from address

852

ld c, (ix + 3) ; get variable length

853

ld b, 0 ;

854

inc bc ; string length have one more byte from zero terminator

855

push bc ; save variable lenght + 1

856

call memory.alloc ; in bc = size, out ix = address, nz=OK

857

jp z, memory.error

858

push ix ; just to transfer memory address from ix to de

859

pop de ;

860

pop bc ; restore bytes to be copied

861

pop hl ; restore copy from string address

862

push de ; save copy to address

863

ldir ; copy bc bytes from hl (data address) to de (variable address)

864

;xor a

865

;ld (de), a

866

pop de ; restore copy to address

867

pop ix ; restore variable address

868

ld (ix + 4), e ; put memory address low into variable

869

ld (ix + 5), d ; put memory address high into variable

870

ret ; variable assigned

871

872

; keyword

873

BOOLEAN.IF:

874

875

pop.parm ; get parameter boolean result in hl

876

push hl ; ix = hl

877

pop ix ;

878

ld a, (ix+5) ; put boolean integer result in a

879

ret ;

880

881

; keyword

882

CLS:

883

884

if defined EXIST_DATA_SET

885

call gfxIsTileMode

886

jp z, gfxClearTileScreen

887

endif

888

xor a ; reset Z flag

889

__call_bios BIOS_CLS ; clear screen

890

ret ;

891

892

; keyword

893

PRINT:

894

895

pop.parm ; get first parameter

896

call CAST_TO.STR ;

897

or 0

898

ret z ; return if string size zero

899

if defined EXIST_DATA_SET

900

ld (BIOS_TEMP), a ; size of string

901

call gfxIsTileMode

902

ld a, (BIOS_TEMP)

903

jp nz, STRING.PRINT

904

; discard if first char < 32 or > 126

905

ld a, (hl)

906

cp 126

907

ret nc

908

cp 31

909

ret c

910

push hl

911

; adjust default color

912

ld a, (BIOS_GRPACY)

913

sra a

914

sra a

915

sra a ; Y / 8 = bank

916

ld (BIOS_TEMP+1), a

917

ld a, (BIOS_TEMP)

918

PRINT.1:

919

push af

920

ld a, (BIOS_TEMP+1)

921

ld d, a

922

ld e, (hl)

923

push hl

924

call gfxSetTileDefaultColor

925

pop hl

926

inc hl

927

pop af

928

dec a

929

jr nz, PRINT.1

930

; print string

931

ld hl, (BIOS_GRPACY)

932

;ld bc, 32

933

;call MATH.MULT.16 ; slow y * 32

934

ld h, l

935

sra h

936

sra h

937

sra h

938

sla l

939

sla l

940

sla l

941

sla l

942

sla l ; fast y * 32

943

ld de, (BIOS_GRPACX)

944

add hl, de

945

ld de, (BIOS_GRPNAM)

946

add hl, de

947

ex de, hl

948

pop hl

949

ld b, 0

950

ld a, (BIOS_TEMP)

951

ld c, a

952

jp gfxLDIRVM

953

else

954

jp STRING.PRINT

955

endif

956

957

; keyword

958

MATH.ADD:

959

960

call MATH.PARM.POP ; get parameters into DAC/ARG

961

ld a, (BASIC_VALTYP) ;

962

cp 2 ; test if integer

963

jp z, MATH.ADD.INT ;

964

cp 3 ; test if string

965

jp z, STRING.CONCAT ;

966

cp 4 ; test if single

967

jp z, MATH.ADD.SGL ;

968

jp MATH.ADD.DBL ; it is a double

969

970

; keyword

971

MATH.MULT:

972

973

call MATH.PARM.POP ; get parameters into DAC/ARG

974

ld a, (BASIC_VALTYP) ;

975

cp 2 ; test if integer

976

jp z, MATH.MULT.INT ;

977

cp 3 ; test if string

978

jp z, MATH.ERROR ;

979

cp 4 ; test if single

980

jp z, MATH.MULT.SGL ;

981

jp MATH.MULT.DBL ; it is a double

982

983

; keyword

984

GOTO:

985

; abstract virtual GOTO

986

987

988

;---------------------------------------------------------------------------------------------------------

989

; MSX BASIC SUPPORT CODE

990

;---------------------------------------------------------------------------------------------------------

991

992

if defined ON_ERROR or defined ON_INTERVAL or defined ON_KEY_START or defined ON_SPRITE or defined ON_STOP or defined ON_STRIG_START or defined TRAP_ENABLED or defined TRAP_DISABLED or defined TRAP_PAUSE or defined TRAP_UNPAUSE

993

994

RUN_TRAPS: ld b, 26

995

ld hl, BASIC_TRPTBL

996

RUN_TRAPS.1: push hl

997

push bc

998

call TRAP_HANDLER

999

pop bc

1000

pop hl

1001

inc hl

1002

inc hl

1003

inc hl

1004

djnz RUN_TRAPS.1

1005

ret

1006

1007

; in hl = trap block address (handle trap: sts=5? has handler? ackn, pause, run trap, sts=1? unpause)

1008

TRAP_HANDLER:

1009

ld a, (hl) ; trap status

1010

cp 5 ; trap occured AND trap not paused AND trap enabled ?

1011

ret nz ; return if false

1012

inc hl

1013

ld e, (hl) ; get trap address

1014

inc hl

1015

ld d, (hl)

1016

dec hl

1017

dec hl

1018

ld a, d

1019

or e

1020

ret z ; return if address zero

1021

push hl

1022

__call_basic BASIC_TRAP_ACKNW

1023

__call_basic BASIC_TRAP_PAUSE

1024

ld hl, TRAP_HANDLER.1

1025

ld a, (BASIC_ONGSBF) ; save traps execution

1026

push af

1027

xor a

1028

ld (BASIC_ONGSBF), a ; disable traps execution

1029

push hl ; next return will be to trap handler

1030

push de ; indirect jump to trap address

1031

ret

1032

TRAP_HANDLER.1: pop af

1033

ld (BASIC_ONGSBF), a ; restore traps execution

1034

pop hl

1035

ld a, (hl)

1036

cp 1 ; trap enabled?

1037

ret z

1038

__call_basic BASIC_TRAP_UNPAUSE

1039

ret

1040

1041

; hl = trap block, de = trap handler

1042

SET_TRAP: xor a

1043

ld (hl), a ; trap block status

1044

inc hl

1045

ld (hl), e ; trap block handler (pointer)

1046

inc hl

1047

ld (hl), d

1048

ret

1049

1050

endif

1051

1052

if defined SET_PLAY_VOICE_1 or defined SET_PLAY_VOICE_2 or defined SET_PLAY_VOICE_3 or defined DO_PLAY or defined MUSIC_PLAY or defined MUSIC_NEXT or defined MUSIC_STOP

1053

1054

SET_PLAY_VOICE:

1055

ld (BIOS_TEMP), a ; save voice number

1056

pop.parm

1057

ld a, (hl)

1058

cp 3

1059

ret nz ; return if not string

1060

call GET_STR.ADDR

1061

SET_PLAY_VOICE.1:

1062

ld (BIOS_TEMP2), a ; save string size

1063

push hl ; string address

1064

ld a, (BIOS_TEMP) ; restore voice number

1065

call BIOS_GETVCP ; get PSG voice buffer address (in A = voice number, out HL = address of byte 2)

1066

pop de

1067

ld a, (BIOS_TEMP2) ; restore string size

1068

ld (hl), a ; string size

1069

inc hl

1070

ld (hl), e ; string address

1071

inc hl

1072

ld (hl), d

1073

inc hl

1074

ld D,H ; voice stack

1075

ld E,L

1076

ld BC,001CH

1077

add HL,BC

1078

ex DE,HL

1079

ld (HL),E

1080

inc HL

1081

ld (HL),D

1082

ret

1083

1084

START_PLAY:

1085

ld HL, 0x752E

1086

ld (BIOS_MCLTAB),HL

1087

ld a, 1

1088

ld (BIOS_MCLFLG),A

1089

ld hl, BIOS_TEMP ; voice count

1090

ld a, 3

1091

sub (hl)

1092

dec a

1093

ld (BIOS_PRSCNT), a

1094

xor a

1095

ld (BIOS_VOICEN), a

1096

ld (BIOS_QUEUEN), a

1097

ld (BIOS_MUSICF), a

1098

ld HL,-12 ; -10

1099

add HL,SP

1100

ld (BIOS_SAVSP),HL

1101

ld HL, BIOS_PLYCNT

1102

ld (HL), 0

1103

__call_basic BASIC_PLAY_DIRECT

1104

ret

1105

1106

endif

1107

1108

1109

1110

;---------------------------------------------------------------------------------------------------------

1111

; VARIABLES ROUTINES

1112

;---------------------------------------------------------------------------------------------------------

1113

1114

; input hl = variable address

1115

; input bc = variable name

1116

; input d = variable type

1117

INIT_VAR: ld (hl), d ; variable type

1118

inc hl

1119

ld (hl), c ; variable name 1

1120

inc hl

1121

ld (hl), b ; variable name 2

1122

ld a, d

1123

cp 3

1124

jp nz, CLEAR.VAR

1125

ld de, LIT_NULL_STR

1126

inc hl

1127

ld (hl), 0

1128

inc hl

1129

ld (hl), e

1130

inc hl

1131

ld (hl), d

1132

ld b, 5

1133

jr CLEAR.VAR.LOOP

1134

CLEAR.VAR: ld b, 8

1135

CLEAR.VAR.LOOP: inc hl

1136

ld (hl), 0 ; data address/value

1137

djnz CLEAR.VAR.LOOP

1138

ret

1139

; input HL = variable address

1140

; input A = variable output type

1141

; output HL = casted data address

1142

CAST_TO: cp 2

1143

jp z, CAST_TO.INT

1144

cp 3

1145

jp z, CAST_TO.STR

1146

cp 4

1147

jp z, CAST_TO.SGL

1148

cp 8

1149

jp z, CAST_TO.DBL

1150

ret

1151

; input HL = variable address

1152

; output HL = variable address

1153

CAST_TO.INT: ;push af

1154

ld a, (HL)

1155

cp 2

1156

jp z, GET_INT.ADDR

1157

cp 3

1158

jp z, CAST_STR_TO.INT

1159

cp 4

1160

jp z, CAST_SGL_TO.INT

1161

cp 8

1162

jp z, CAST_DBL_TO.INT

1163

;pop af

1164

ret

1165

; input HL = variable address

1166

; output HL = variable address

1167

CAST_TO.STR: ;push af

1168

ld a, (HL)

1169

cp 2

1170

jp z, CAST_INT_TO.STR

1171

cp 3

1172

jp z, GET_STR.ADDR

1173

cp 4

1174

jp z, CAST_SGL_TO.STR

1175

cp 8

1176

jp z, CAST_DBL_TO.STR

1177

;pop af

1178

ret

1179

; input HL = variable address

1180

; output HL = variable address

1181

CAST_TO.SGL: ;push af

1182

ld a, (HL)

1183

cp 2

1184

jp z, CAST_INT_TO.SGL

1185

cp 3

1186

jp z, CAST_STR_TO.SGL

1187

cp 4

1188

jp z, GET_SGL.ADDR

1189

cp 8

1190

jp z, CAST_DBL_TO.SGL

1191

;pop af

1192

ret

1193

; input HL = variable address

1194

; output HL = variable address

1195

CAST_TO.DBL: ;push af

1196

ld a, (hl)

1197

cp 2

1198

jp z, CAST_INT_TO.DBL

1199

cp 3

1200

jp z, CAST_STR_TO.DBL

1201

cp 4

1202

jp z, CAST_SGL_TO.DBL

1203

cp 8

1204

jp z, GET_DBL.ADDR

1205

;pop af

1206

ret

1207

CAST_SGL_TO.STR: ; same as CAST_INT_TO.STR

1208

CAST_DBL_TO.STR: ; same as CAST_INT_TO.STR

1209

CAST_INT_TO.STR: call COPY_TO.DAC

1210

xor a

1211

__call_bios MATH_FOUT ; convert DAC to string

1212

;pop af

1213

ret

1214

CAST_INT_TO.SGL: call COPY_TO.DAC

1215

__call_bios MATH_FRCSGL

1216

ld hl, BASIC_DAC

1217

ret

1218

CAST_INT_TO.DBL: call COPY_TO.DAC

1219

__call_bios MATH_FRCDBL

1220

ld hl, BASIC_DAC

1221

ret

1222

CAST_SGL_TO.INT: ; same as CAST_DBL_TO.INT

1223

CAST_DBL_TO.INT: call COPY_TO.DAC

1224

__call_bios MATH_FRCINT

1225

ld hl, BASIC_DAC

1226

ret

1227

CAST_STR_TO.INT: call CAST_STR_TO.VAL ;

1228

__call_bios MATH_FRCINT ;

1229

ld hl, BASIC_DAC ;

1230

ret ;

1231

CAST_STR_TO.SGL: call CAST_STR_TO.VAL ;

1232

__call_bios MATH_FRCSGL ;

1233

ld hl, BASIC_DAC ;

1234

ret ;

1235

CAST_STR_TO.DBL: call CAST_STR_TO.VAL ;

1236

__call_bios MATH_FRCDBL ;

1237

ld hl, BASIC_DAC ;

1238

ret ;

1239

CAST_STR_TO.VAL: call GET_STR.ADDR ;

1240

ld a, (hl) ;

1241

__call_bios MATH_FIN ; convert string to a value type

1242

ld hl, BASIC_DAC ;

1243

ret ;

1244

GET_INT.VALUE: inc hl ; output BC with integer value

1245

inc hl ;

1246

ld c, (hl) ;

1247

inc hl ;

1248

ld b, (hl) ;

1249

ret ;

1250

CAST_SGL_TO.DBL: ; same as GET_DBL.ADDR

1251

CAST_DBL_TO.SGL: ; same as GET_DBL.ADDR

1252

GET_INT.ADDR: ; same as GET_DBL.ADDR

1253

GET_SGL.ADDR: ; same as GET_DBL.ADDR

1254

GET_DBL.ADDR: inc hl

1255

inc hl

1256

inc hl

1257

;pop af

1258

ret

1259

GET_STR.ADDR: push hl

1260

pop ix

1261

ld a, (ix + 3)

1262

ld l, (ix + 4)

1263

ld h, (ix + 5)

1264

ret

1265

; input hl = string address

1266

; output b = string length

1267

GET_STR.LENGTH: ld b, 0

1268

GET_STR.LEN.NEXT: ld a, (hl)

1269

or a ; cp 0

1270

ret z

1271

inc b

1272

inc hl

1273

ld a, b

1274

cp 255

1275

jr z, GET_STR.LEN.ERR

1276

jr GET_STR.LEN.NEXT

1277

GET_STR.LEN.ERR: ld b, 0

1278

ret

1279

STRING.COMPARE: ld ix, (BASIC_DAC+1) ; string 1

1280

ld iy, (BASIC_ARG+1) ; string 2

1281

STRING.COMPARE.NX: ld a, (ix) ; next char from string 1

1282

cp (iy) ; char s1 = char s2?

1283

jr nz, STRING.COMPARE.NE ; if not equal...

1284

cp 0 ;

1285

jr z, STRING.COMPARE.F1 ; if string 1 has finished...

1286

ld a, (iy) ; next char from string 2

1287

cp 0 ;

1288

jr z, STRING.COMPARE.GT ; if s2 has finished, s1 has not finished yet, so s1 is greater than s2

1289

inc ix ;

1290

inc iy ;

1291

jr STRING.COMPARE.NX ; get next char pair

1292

STRING.COMPARE.F1: ld a, (iy) ; verify if string 2 has finished too

1293

cp 0 ;

1294

jr z, STRING.COMPARE.EQ ; if s2 has finished, then they are equals

1295

jr STRING.COMPARE.LT ; else, result = s1 is less than s2

1296

STRING.COMPARE.NE: jr c, STRING.COMPARE.GT ; verify if s1 is greater than s2...

1297

STRING.COMPARE.LT: ld a, 1 ; ...else, result = s1 less than s2

1298

ret ;

1299

STRING.COMPARE.GT: ld a, 0xFF ; result = s1 is greater than s2

1300

ret ;

1301

STRING.COMPARE.EQ: xor a ; result = s1 is equal to s2

1302

ret ;

1303

STRING.CONCAT: ld ix, BASIC_DAC ; s1 size

1304

ld a, (BASIC_ARG) ; s2 size

1305

add a, (ix) ; s3 size = s1 size + s2 size

1306

push af

1307

ld b, 0

1308

ld c, a ;

1309

inc bc ; add 1 byte to size

1310

call memory.alloc ; in bc size, out ix new memory address, nz=OK

1311

jp z, memory.error ;

1312

push ix ; save ix

1313

push ix ; save ix

1314

pop de ; de = ix

1315

ld a, (BASIC_DAC) ; s1 size

1316

ld hl, (BASIC_DAC + 1) ; string 1

1317

call COPY_TO.STR ; copy to new memory

1318

ld a, (BASIC_ARG) ; s2 size

1319

ld hl, (BASIC_ARG + 1) ; string 2

1320

call COPY_TO.STR ; copy to new memory

1321

xor a

1322

ld (de), a ; null terminated

1323

pop hl ; hl = ix

1324

pop af

1325

call COPY_TO.VAR_DUMMY.STR ;

1326

ret.parm ; WARNING - VERIFY STRING MEMORY LEAKs

1327

STRING.PRINT: ld a, (BIOS_SCRMOD) ; 0=40x24 Text Mode, 1=32x24 Text Mode, 2=Graphics Mode, 3=Multicolour Mode

1328

cp 5 ;

1329

jr nc, STRING.PRINT.G2 ; jump if graphic screen mode MSX2 (>=5)

1330

cp 2 ;

1331

jr nc, STRING.PRINT.G1 ; jump if graphic screen mode MSX1 (>=2)

1332

STRING.PRINT.T: ld a, (hl) ; get a char from a string parameter

1333

or a ; cp 0 - is it the string end?

1334

ret z ; exit if yes

1335

__call_bios BIOS_CHPUT ; put the char (a) into text screen

1336

inc hl ; next char

1337

jr STRING.PRINT.T ; repeat

1338

STRING.PRINT.G1: ld a, (hl) ; get a char from a string parameter

1339

or a ; cp 0 - is it the string end?

1340

ret z ; exit if yes

1341

__call_bios BIOS_GRPPRT ; put the char (a) into graphical screen

1342

inc hl ; next char

1343

jr STRING.PRINT.G1 ; repeat

1344

STRING.PRINT.G2: ld a, (hl) ; get a char from a string parameter

1345

or a ; cp 0 - is it the string end?

1346

ret z ; exit if yes

1347

ld ix, BIOS_GRPPRT2 ; put the char (a) into graphical screen

1348

call BIOS_EXTROM

1349

inc hl ; next char

1350

jr STRING.PRINT.G2 ; repeat

1351

1352

; a = string size to copy

1353

; input hl = string from

1354

; input de = string to

1355

COPY_TO.STR: or a

1356

ret z ; avoid copy if size = zero

1357

ld b, 0

1358

ld c, a ; string size

1359

ldir ; copy bc bytes from hl to de

1360

ret ;

1361

COPY_TO.BASIC_BUF: ld bc, BASIC_BUF

1362

ld a, (LIT_QUOTE_CHAR)

1363

ld (bc), a

1364

inc bc

1365

COPY_BAS_BUF.LOOP: ld a, (hl)

1366

or a ; cp 0

1367

jr z, COPY_BAS_BUF.EXIT

1368

ld (bc), a

1369

inc bc

1370

inc hl

1371

jr COPY_BAS_BUF.LOOP

1372

COPY_BAS_BUF.EXIT: ld a, (LIT_QUOTE_CHAR)

1373

ld (bc), a

1374

inc bc

1375

xor a

1376

ld (bc), a

1377

ld hl, BASIC_BUF

1378

ret

1379

COPY_TO.VAR_DUMMY: ld a, (BASIC_VALTYP) ; create dummy variable from VALTYPE

1380

cp 3 ;

1381

jr nz, COPY_TO.VAR_DUMMY.DBL

1382

push hl

1383

call GET_STR.LENGTH ; get string length

1384

pop hl

1385

ld a, b ; string length

1386

COPY_TO.VAR_DUMMY.STR: call GET_VAR_DUMMY.ADDR ; create dummy string variable from HL

1387

ld (ix), 3 ; data type string

1388

ld (ix+1), 0 ;

1389

ld (ix+2), 255 ; var type fixed

1390

ld (ix+3), a ; string length

1391

ld (ix+4), l ; data address low

1392

ld (ix+5), h ; data address high

1393

;call GET_STR.LENGTH ; get string length

1394

;ld (ix+3), b ; string length

1395

push ix ; output var address...

1396

pop hl ; ...into hl

1397

ret ;

1398

COPY_TO.VAR_DUMMY.INT: call GET_VAR_DUMMY.ADDR ; create dummy integer variable from BC

1399

ld (ix), 2 ; data type string

1400

ld (ix+1), 0 ;

1401

ld (ix+2), 0 ;

1402

ld (ix+3), 0 ;

1403

ld (ix+4), 0 ;

1404

ld (ix+5), c ;

1405

ld (ix+6), b ;

1406

ld (ix+7), 0 ;

1407

ld (ix+8), 0 ;

1408

ld (ix+9), 0 ;

1409

ld (ix+10), 0 ;

1410

push ix ; output var address...

1411

pop hl ; ...into hl

1412

ret ;

1413

COPY_TO.VAR_DUMMY.DBL: call GET_VAR_DUMMY.ADDR ; create dummy value variable from DAC

1414

ld (ix), a ; data type

1415

ld (ix+1), 0 ;

1416

ld (ix+2), 0 ;

1417

ld bc, 8 ;

1418

ld hl, BASIC_DAC ;

1419

push ix ; just to copy ix to de

1420

pop de ;

1421

inc de ;

1422

inc de ;

1423

inc de ;

1424

ldir ; copy bc bytes from hl (data address) to de (variable address)

1425

push ix ; output var address...

1426

pop hl ; ...into hl

1427

ret ;

1428

GET_VAR_DUMMY.ADDR: push af ;

1429

push de

1430

ld de, 11 ;

1431

ld ix, (VAR_DUMMY.POINTER) ;

1432

ld a, (VAR_DUMMY.COUNTER) ;

1433

GET_VAR_DUMMY.NEXT: add ix, de ;

1434

inc a ;

1435

cp VAR_DUMMY.SIZE ;

1436

jr nz, GET_VAR_DUMMY.EXIT ;

1437

xor a ;

1438

ld ix, VAR_DUMMY.DATA ;

1439

GET_VAR_DUMMY.EXIT: ld (VAR_DUMMY.POINTER), ix ;

1440

ld (VAR_DUMMY.COUNTER), a ;

1441

ld a, (ix) ; get last var dummy type

1442

cp 3 ; is it string?

1443

call z, GET_VAR_DUMMY.FREE ; free string memory

1444

pop de

1445

pop af ;

1446

ret ;

1447

GET_VAR_DUMMY.FREE:

1448

push hl

1449

push ix

1450

ld l, (ix+4) ; get string data address

1451

ld h, (ix+5)

1452

push hl

1453

pop ix

1454

call memory.free ; free memory

1455

pop ix

1456

pop hl

1457

ret

1458

; input hl = variable address

1459

COPY_TO.DAC: ld de, BASIC_DAC

1460

COPY_TO.DAC.DATA: ld a, (hl)

1461

ld (BASIC_VALTYP), a

1462

inc hl

1463

inc hl

1464

inc hl

1465

ld bc, 8 ; data = 8 bytes

1466

ldir ; copy bc bytes from hl (data address) to de (variable address)

1467

ret

1468

COPY_TO.ARG: ld de, BASIC_ARG ;

1469

jr COPY_TO.DAC.DATA ;

1470

COPY_TO.DAC_ARG: ld hl, BASIC_DAC ;

1471

ld de, BASIC_ARG ;

1472

ld bc, 8 ; data = 8 bytes

1473

ldir ; copy bc bytes from hl (data address) to de (variable address)

1474

ret ;

1475

COPY_TO.ARG_DAC: ld hl, BASIC_ARG ;

1476

ld de, BASIC_DAC ;

1477

ld bc, 8 ; data = 8 bytes

1478

ldir ; copy bc bytes from hl (data address) to de (variable address)

1479

ret ;

1480

COPY_TO.DAC_TMP: ld hl, BASIC_DAC ;

1481

ld de, BASIC_SWPTMP ;

1482

ld bc, 8 ; data = 8 bytes

1483

ldir ; copy bc bytes from hl (data address) to de (variable address)

1484

ret ;

1485

COPY_TO.TMP_DAC: ld hl, BASIC_SWPTMP ;

1486

ld de, BASIC_DAC ;

1487

ld bc, 8 ; data = 8 bytes

1488

ldir ; copy bc bytes from hl (data address) to de (variable address)

1489

ret ;

1490

SWAP.DAC.ARG: di

1491

exx ; save registers

1492

ld bc, 8 ;

1493

ld hl, BASIC_DAC ;

1494

ld de, BASIC_SWPTMP ;

1495

ldir ; copy bc bytes from hl to de

1496

ld bc, 8 ;

1497

ld hl, BASIC_ARG ;

1498

ld de, BASIC_DAC ;

1499

ldir ; copy bc bytes from hl to de

1500

ld bc, 8 ;

1501

ld hl, BASIC_SWPTMP ;

1502

ld de, BASIC_ARG ;

1503

ldir ; copy bc bytes from hl to de

1504

exx ; restore registers

1505

1506

ret ;

1507

CLEAR.DAC: ld de, BASIC_DAC

1508

CLEAR.DAC.DATA: ld hl, BASIC_VALTYP

1509

ld (hl), 2

1510

ld hl, LIT_NULL_DBL

1511

ld bc, 8 ; data = 8 bytes

1512

ldir ; copy bc bytes from hl (data address) to de (variable address)

1513

ret

1514

CLEAR.ARG: ld de, BASIC_ARG

1515

jr CLEAR.DAC.DATA

1516

1517

1518

1519

;---------------------------------------------------------------------------------------------------------

1520

; MATH 16 BITS ROUTINES

1521

;---------------------------------------------------------------------------------------------------------

1522

1523

MATH.PARM.POP: pop af ; get PC from caller stack

1524

ex af, af' ; save PC to temp

1525

pop.parm ; get first parameter

1526

call COPY_TO.ARG ; put HL in ARG (return var type in A)

1527

pop.parm ; get second parameter

1528

ex af, af' ; restore PC from temp

1529

push af ; put again PC from caller in stack

1530

ex af, af' ; restore 1st data type

1531

push af ; save 1st data type

1532

call COPY_TO.DAC ; put HL in DAC (return var type in A)

1533

pop bc ; restore 1st data type (ARG) in B

1534

cp b ; test if data type in A (DAC) = data type in B (ARG)

1535

ret z ; return if is equal data types

1536

MATH.PARM.CAST: push bc ; else cast both to double

1537

and 12 ; test if single/double

1538

jr nz, MATH.PARM.CST1 ; avoid cast if already single/double

1539

__call_bios MATH_FRCDBL ; convert DAC to double

1540

MATH.PARM.CST1: pop af ;

1541

and 12 ; test if single/double

1542

jr nz, MATH.PARM.CST2 ; avoid cast if already single/double

1543

ld (BASIC_VALTYP), a ;

1544

call COPY_TO.DAC_TMP ;

1545

call COPY_TO.ARG_DAC ;

1546

__call_bios MATH_FRCDBL ; convert ARG to double

1547

call COPY_TO.DAC_ARG ;

1548

call COPY_TO.TMP_DAC ;

1549

MATH.PARM.CST2: ld a, 8 ;

1550

ld (BASIC_VALTYP), a ;

1551

ret ;

1552

MATH.PARM.POP.INT: ; return result in DAC/ARG as integer

1553

pop af ; get PC from caller stack

1554

ex af, af' ; save PC to temp

1555

pop.parm ; get first parameter

1556

ld a, (hl) ; get parameter type

1557

and 2 ; test if integer

1558

jr z, MATH.PARM.POP.I1 ; do cast if not integer

1559

call COPY_TO.ARG ; put HL in ARG (return var type in A)

1560

jr MATH.PARM.POP.I2 ; go to next parameter

1561

MATH.PARM.POP.I1: call COPY_TO.DAC ; put HL in DAC (return var type in A)

1562

__call_bios MATH_FRCINT ; convert DAC to int

1563

call COPY_TO.DAC_ARG ; copy DAC to ARG

1564

MATH.PARM.POP.I2: pop.parm ; get second parameter

1565

call COPY_TO.DAC ; put HL in DAC (return var type in A)

1566

and 2 ; test if integer

1567

jr nz, MATH.PARM.POP.I3 ; avoid cast if already integer

1568

__call_bios MATH_FRCINT ; convert DAC to int

1569

ld a, 2 ;

1570

ld (BASIC_VALTYP), a ;

1571

MATH.PARM.POP.I3:

1572

ex af, af' ; restore PC from temp

1573

push af ; put again PC from caller in stack

1574

ret ;

1575

MATH.PARM.PUSH: call COPY_TO.VAR_DUMMY ;

1576

ret.parm ;

1577

1578

if defined MATH.ADD

1579

1580

; input DAC, ARG

1581

; output in parm stack

1582

; http://www.z80.info/zip/zaks_book.pdf - page 104

1583

MATH.ADD.INT: ld hl, (BASIC_DAC+2) ;

1584

ld bc, (BASIC_ARG+2) ;

1585

add hl, bc ;

1586

ld (BASIC_DAC+2), hl ;

1587

jp MATH.PARM.PUSH ;

1588

1589

endif

1590

1591

if defined MATH.SUB or defined MATH.NEG

1592

1593

; input DAC, ARG

1594

; output in parm stack

1595

; http://www.z80.info/zip/zaks_book.pdf - page 104

1596

MATH.SUB.INT: ld hl, (BASIC_DAC+2) ;

1597

ld de, (BASIC_ARG+2) ;

1598

and a ; clear carry

1599

sbc hl, de ;

1600

ld (BASIC_DAC+2), hl ;

1601

jp MATH.PARM.PUSH ;

1602

1603

endif

1604

1605

if defined MATH.MULT

1606

1607

; input DAC, ARG

1608

; output in parm stack

1609

MATH.MULT.INT: ld hl, (BASIC_DAC+2) ;

1610

ld bc, (BASIC_ARG+2) ;

1611

call MATH.MULT.16 ;

1612

ld (BASIC_DAC+2), hl ;

1613

jp MATH.PARM.PUSH ;

1614

1615

; input HL = multiplicand

1616

; input BC = multiplier

1617

; output HL = result

1618

; http://www.z80.info/zip/zaks_book.pdf - page 131

1619

MATH.MULT.16: ld a, c ; low multiplier

1620

ld c, b ; high multiplier

1621

ld b, 16

1622

ld d, h ; multiplicand

1623

ld e, l

1624

ld hl, 0

1625

MULT16LOOP: srl c ; right shift multiplier high

1626

rra ; rotate right multiplier low

1627

jr nc, MULT16NOADD ; test carry

1628

add hl, de ; add multiplicand to result

1629

MULT16NOADD: ex de, hl

1630

add hl, hl ; double - shift multiplicand

1631

ex de, hl

1632

djnz MULT16LOOP

1633

ret

1634

1635

endif

1636

1637

if defined MATH.DIV or defined MATH.IDIV or defined MATH.MOD

1638

1639

; input AC = dividend

1640

; input DE = divisor

1641

; output AC = quotient

1642

; output HL = remainder

1643

; http://www.z80.info/zip/zaks_book.pdf - page 140

1644

MATH.DIV.16: ld hl, 0 ; clear accumulator

1645

ld b, 16 ; set counter

1646

DIV16LOOP: rl c ; rotate accumulator result left

1647

rla

1648

adc hl, hl ; left shift

1649

sbc hl, de ; trial subtract divisor

1650

jr nc, $ + 3 ; subtract was OK ($ = current location)

1651

add hl, de ; restore accumulator

1652

ccf ; calculate result bit

1653

djnz DIV16LOOP ; counter not zero

1654

rl c ; shift in last result bit

1655

rla

1656

ret

1657

1658

endif

1659

1660

if defined GFX_FAST or defined LINE

1661

1662

; compare two signed 16 bits integers

1663

; HL < DE: Carry flag

1664

; HL = DE: Zero flag

1665

; http://www.z80.info/zip/zaks_book.pdf - page 531

1666

MATH.COMP.S16: ld a, h ; test high order byte

1667

and 0x80 ; test sign, clear carry

1668

jr nz, MATH.COMP.S16.NEGM1 ; jump if hl is negative

1669

bit 7, d

1670

ret nz ; de is negative (and hl is positive)

1671

ld a, h

1672

cp d ; signs are both positive, so normal compare

1673

ret nz

1674

ld a, l ; test low order byte

1675

cp e

1676

ret

1677

MATH.COMP.S16.NEGM1:

1678

xor d

1679

rla ; sign bit into carry

1680

ret c ; signs different

1681

ld a, h

1682

cp d ; both signs negative

1683

ret nz

1684

ld a, l

1685

cp e

1686

ret

1687

1688

endif

1689

1690

if defined MATH.ADD

1691

1692

MATH.ADD.SGL: ld a, 8 ;

1693

ld (BASIC_VALTYP), a ;

1694

MATH.ADD.DBL: __call_bios MATH_DECADD ;

1695

jp MATH.PARM.PUSH ;

1696

1697

endif

1698

1699

if defined MATH.SUB or defined MATH.NEG

1700

1701

MATH.SUB.SGL: ld a, 8 ;

1702

ld (BASIC_VALTYP), a ;

1703

MATH.SUB.DBL: __call_bios MATH_DECSUB ;

1704

jp MATH.PARM.PUSH ;

1705

1706

endif

1707

1708

if defined MATH.MULT

1709

1710

MATH.MULT.SGL: ld a, 8 ;

1711

ld (BASIC_VALTYP), a ;

1712

MATH.MULT.DBL: __call_bios MATH_DECMUL ;

1713

jp MATH.PARM.PUSH ;

1714

1715

endif

1716

1717

if defined MATH.DIV

1718

1719

; input DAC, ARG

1720

; output in parm stack

1721

MATH.DIV.INT: __call_bios MATH_FRCDBL ; convert DAC to double

1722

call SWAP.DAC.ARG ;

1723

ld a, 2 ;

1724

ld (BASIC_VALTYP), a ;

1725

__call_bios MATH_FRCDBL ; convert ARG to double

1726

call SWAP.DAC.ARG ;

1727

MATH.DIV.SGL: ld a, 8 ;

1728

ld (BASIC_VALTYP), a ;

1729

MATH.DIV.DBL: __call_bios MATH_DECDIV ;

1730

jp MATH.PARM.PUSH ;

1731

1732

endif

1733

1734

if defined MATH.IDIV

1735

1736

; input DAC, ARG

1737

; output in parm stack

1738

MATH.IDIV.SGL: ld a, 8 ;

1739

ld (BASIC_VALTYP), a ;

1740

MATH.IDIV.DBL: __call_bios MATH_FRCINT ; convert DAC to integer

1741

call SWAP.DAC.ARG ;

1742

ld a, 8 ;

1743

ld (BASIC_VALTYP), a ;

1744

__call_bios MATH_FRCINT ; convert ARG to integer

1745

call SWAP.DAC.ARG ;

1746

MATH.IDIV.INT: ld hl, (BASIC_DAC+2) ;

1747

ld a, h ;

1748

ld c, l ;

1749

ld de, (BASIC_ARG+2) ;

1750

call MATH.DIV.16 ;

1751

ld h, a ;

1752

ld l, c ;

1753

ld (BASIC_DAC+2), hl ; quotient

1754

jp MATH.PARM.PUSH ;

1755

1756

endif

1757

1758

if defined MATH.POW

1759

1760

MATH.POW.INT: ld (BASIC_VALTYP), a ;

1761

__call_bios MATH_FRCDBL ; convert DAC to double

1762

call SWAP.DAC.ARG ;

1763

ld a, 2 ;

1764

ld (BASIC_VALTYP), a ;

1765

__call_bios MATH_FRCDBL ; convert ARG to double

1766

call SWAP.DAC.ARG ;

1767

MATH.POW.SGL: ld a, 8 ;

1768

ld (BASIC_VALTYP), a ;

1769

MATH.POW.DBL: __call_bios MATH_DBLEXP ;

1770

jp MATH.PARM.PUSH ;

1771

1772

endif

1773

1774

if defined MATH.MOD

1775

1776

;MATH.MOD.SGL: ld a, 8 ;

1777

; ld (BASIC_VALTYP), a ;

1778

;MATH.MOD.DBL: __call_bios MATH_FRCINT ; convert DAC to integer

1779

; call SWAP.DAC.ARG ;

1780

; ld a, 8 ;

1781

; ld (BASIC_VALTYP), a ;

1782

; __call_bios MATH_FRCINT ; convert ARG to integer

1783

; call SWAP.DAC.ARG ;

1784

MATH.MOD.INT: ld hl, (BASIC_DAC+2) ;

1785

ld a, h ;

1786

ld c, l ;

1787

ld de, (BASIC_ARG+2) ;

1788

call MATH.DIV.16 ;

1789

ld (BASIC_DAC+2), hl ; remainder

1790

jp MATH.PARM.PUSH ;

1791

1792

endif

1793

1794

if defined ISQR

1795

1796

; fast 16-bit integer square root

1797

; http://www.retroprogramming.com/2017/07/a-fast-z80-integer-square-root.html

1798

; 92 bytes, 344-379 cycles (average 362)

1799

; v2 - 3 t-state optimization spotted by Russ McNulty

1800

; call with hl = number to square root

1801

; returns a = square root

1802

; corrupts hl, de

1803

1804

MATH.INT.SQR:

1805

ld a,h

1806

ld de,0B0C0h

1807

add a,e

1808

jr c,sq7

1809

ld a,h

1810

ld d,0F0h

1811

sq7:

1812

add a,d

1813

jr nc,sq6

1814

res 5,d

1815

db 254

1816

sq6:

1817

sub d

1818

sra d

1819

set 2,d

1820

add a,d

1821

jr nc,sq5

1822

res 3,d

1823

db 254

1824

sq5:

1825

sub d

1826

sra d

1827

inc d

1828

add a,d

1829

jr nc,sq4

1830

res 1,d

1831

db 254

1832

sq4:

1833

sub d

1834

sra d

1835

ld h,a

1836

add hl,de

1837

jr nc,sq3

1838

ld e,040h

1839

db 210

1840

sq3:

1841

sbc hl,de

1842

sra d

1843

ld a,e

1844

rra

1845

or 010h

1846

ld e,a

1847

add hl,de

1848

jr nc,sq2

1849

and 0DFh

1850

db 218

1851

sq2:

1852

sbc hl,de

1853

sra d

1854

rra

1855

or 04h

1856

ld e,a

1857

add hl,de

1858

jr nc,sq1

1859

and 0F7h

1860

db 218

1861

sq1:

1862

sbc hl,de

1863

sra d

1864

rra

1865

inc a

1866

ld e,a

1867

add hl,de

1868

jr nc,sq0

1869

and 0FDh

1870

sq0:

1871

sra d

1872

rra

1873

cpl

1874

ret

1875

1876

endif

1877

1878

if defined RANDOMIZE or defined SEED

1879

1880

MATH.RANDOMIZE: di ;

1881

ld bc, (BIOS_JIFFY) ;

1882

ei ;

1883

1884

MATH.SEED: ld (BASIC_RNDX), bc ; seed to IRND

1885

push bc ; in bc = new integer seed

1886

call CLEAR.DAC ;

1887

pop bc ;

1888

;ld ix, BASIC_DAC ;

1889

ld (BASIC_DAC+2), bc ; copy bc to dac

1890

ld a, 2 ; type integer

1891

ld (BASIC_VALTYP), a ;

1892

__call_bios MATH_FRCDBL ; convert DAC integer to DAC double

1893

__call_bios MATH_NEG ; DAC = -DAC

1894

__call_bios MATH_RND ; put in DAC a new random number from previous DAC parameter

1895

ret ;

1896

1897

endif

1898

1899

MATH.ERROR: ld e, 13 ; type mismatch

1900

__call_basic BASIC_ERROR_HANDLER ;

1901

ret

1902

1903

1904

;---------------------------------------------------------------------------------------------------------

1905

; BOOLEAN ROUTINES

1906

;---------------------------------------------------------------------------------------------------------

1907

1908

BOOLEAN.RET.TRUE: ld hl, LIT_TRUE ;

1909

ret.parm ;

1910

BOOLEAN.RET.FALSE: ld hl, LIT_FALSE ;

1911

ret.parm ;

1912

BOOLEAN.CMP.INT: ld hl, (BASIC_DAC+2) ;

1913

ld de, (BASIC_ARG+2) ;

1914

__call_bios MATH_ICOMP ;

1915

ret ;

1916

BOOLEAN.CMP.SGL: ld bc, (BASIC_ARG) ;

1917

ld de, (BASIC_ARG+2) ;

1918

__call_bios MATH_DCOMP ;

1919

ret ;

1920

BOOLEAN.CMP.DBL: __call_bios MATH_XDCOMP ;

1921

ret ;

1922

BOOLEAN.CMP.STR: call STRING.COMPARE ;

1923

ret ;

1924

1925

if defined BOOLEAN.GT

1926

1927

BOOLEAN.GT.INT: call BOOLEAN.CMP.INT ;

1928

jr BOOLEAN.GT.RET ;

1929

BOOLEAN.GT.STR: call BOOLEAN.CMP.STR ;

1930

jr BOOLEAN.GT.RET ;

1931

BOOLEAN.GT.SGL: call BOOLEAN.CMP.SGL ;

1932

jr BOOLEAN.GT.RET ;

1933

BOOLEAN.GT.DBL: call BOOLEAN.CMP.DBL ;

1934

jr BOOLEAN.GT.RET ;

1935

BOOLEAN.GT.RET: cp 0x01 ;

1936

jp z, BOOLEAN.RET.TRUE ;

1937

jp BOOLEAN.RET.FALSE ;

1938

endif

1939

1940

if defined BOOLEAN.LT

1941

1942

BOOLEAN.LT.INT: call BOOLEAN.CMP.INT ;

1943

jr BOOLEAN.LT.RET ;

1944

BOOLEAN.LT.STR: call BOOLEAN.CMP.STR ;

1945

jr BOOLEAN.LT.RET ;

1946

BOOLEAN.LT.SGL: call BOOLEAN.CMP.SGL ;

1947

jr BOOLEAN.LT.RET ;

1948

BOOLEAN.LT.DBL: call BOOLEAN.CMP.DBL ;

1949

jr BOOLEAN.LT.RET ;

1950

BOOLEAN.LT.RET: cp 0xFF ;

1951

jp z, BOOLEAN.RET.TRUE ;

1952

jp BOOLEAN.RET.FALSE ;

1953

1954

endif

1955

1956

if defined BOOLEAN.GE

1957

1958

BOOLEAN.GE.INT: call BOOLEAN.CMP.INT ;

1959

jr BOOLEAN.GE.RET ;

1960

BOOLEAN.GE.STR: call BOOLEAN.CMP.STR ;

1961

jr BOOLEAN.GE.RET ;

1962

BOOLEAN.GE.SGL: call BOOLEAN.CMP.SGL ;

1963

jr BOOLEAN.GE.RET ;

1964

BOOLEAN.GE.DBL: call BOOLEAN.CMP.DBL ;

1965

jr BOOLEAN.GE.RET ;

1966

BOOLEAN.GE.RET: cp 0x01 ;

1967

jp z, BOOLEAN.RET.TRUE ;

1968

or a ; cp 0

1969

jp z, BOOLEAN.RET.TRUE ;

1970

jp BOOLEAN.RET.FALSE ;

1971

1972

endif

1973

1974

if defined BOOLEAN.LE

1975

1976

BOOLEAN.LE.INT: call BOOLEAN.CMP.INT ;

1977

jr BOOLEAN.LE.RET ;

1978

BOOLEAN.LE.STR: call BOOLEAN.CMP.STR ;

1979

jr BOOLEAN.LE.RET ;

1980

BOOLEAN.LE.SGL: call BOOLEAN.CMP.SGL ;

1981

jr BOOLEAN.LE.RET ;

1982

BOOLEAN.LE.DBL: call BOOLEAN.CMP.DBL ;

1983

jr BOOLEAN.LE.RET ;

1984

BOOLEAN.LE.RET: cp 0xFF ;

1985

jp z, BOOLEAN.RET.TRUE ;

1986

or a ; cp 0

1987

jp z, BOOLEAN.RET.TRUE ;

1988

jp BOOLEAN.RET.FALSE ;

1989

1990

endif

1991

1992

if defined BOOLEAN.NE

1993

1994

BOOLEAN.NE.INT: call BOOLEAN.CMP.INT ;

1995

jr BOOLEAN.NE.RET ;

1996

BOOLEAN.NE.STR: call BOOLEAN.CMP.STR ;

1997

jr BOOLEAN.NE.RET ;

1998

BOOLEAN.NE.SGL: call BOOLEAN.CMP.SGL ;

1999

jr BOOLEAN.NE.RET ;

2000

BOOLEAN.NE.DBL: call BOOLEAN.CMP.DBL ;

2001

jr BOOLEAN.NE.RET ;

2002

BOOLEAN.NE.RET: or a ; cp 0

2003

jp nz, BOOLEAN.RET.TRUE ;

2004

jp BOOLEAN.RET.FALSE ;

2005

2006

endif

2007

2008

if defined BOOLEAN.EQ

2009

2010

BOOLEAN.EQ.INT: call BOOLEAN.CMP.INT ;

2011

jr BOOLEAN.EQ.RET ;

2012

BOOLEAN.EQ.STR: call BOOLEAN.CMP.STR ;

2013

jr BOOLEAN.EQ.RET ;

2014

BOOLEAN.EQ.SGL: call BOOLEAN.CMP.SGL ;

2015

jr BOOLEAN.EQ.RET ;

2016

BOOLEAN.EQ.DBL: call BOOLEAN.CMP.DBL ;

2017

jr BOOLEAN.EQ.RET ;

2018

BOOLEAN.EQ.RET: or a ; cp 0

2019

jp z, BOOLEAN.RET.TRUE ;

2020

jp BOOLEAN.RET.FALSE ;

2021

2022

endif

2023

2024

if defined BOOLEAN.AND

2025

2026

BOOLEAN.AND.INT: ld a, (BASIC_DAC+2) ;

2027

ld hl, BASIC_ARG+2 ;

2028

and (hl) ;

2029

ld (BASIC_DAC+2), a ;

2030

inc hl ;

2031

ld a, (BASIC_DAC+3) ;

2032

and (hl) ;

2033

ld (BASIC_DAC+3), a ;

2034

ld a, 2 ;

2035

jp MATH.PARM.PUSH ;

2036

2037

endif

2038

2039

if defined BOOLEAN.OR

2040

2041

BOOLEAN.OR.INT: ld a, (BASIC_DAC+2) ;

2042

ld hl, BASIC_ARG+2 ;

2043

or (hl) ;

2044

ld (BASIC_DAC+2), a ;

2045

inc hl ;

2046

ld a, (BASIC_DAC+3) ;

2047

or (hl) ;

2048

ld (BASIC_DAC+3), a ;

2049

ld a, 2 ;

2050

jp MATH.PARM.PUSH ;

2051

2052

endif

2053

2054

if defined BOOLEAN.XOR

2055

2056

BOOLEAN.XOR.INT: ld a, (BASIC_DAC+2) ;

2057

ld hl, BASIC_ARG+2 ;

2058

xor (hl) ;

2059

ld (BASIC_DAC+2), a ;

2060

inc hl ;

2061

ld a, (BASIC_DAC+3) ;

2062

xor (hl) ;

2063

ld (BASIC_DAC+3), a ;

2064

ld a, 2 ;

2065

jp MATH.PARM.PUSH ;

2066

2067

endif

2068

2069

if defined BOOLEAN.EQV

2070

2071

BOOLEAN.EQV.INT: ld a, (BASIC_DAC+2) ;

2072

ld hl, BASIC_ARG+2 ;

2073

xor (hl) ;

2074

cpl ;

2075

ld (BASIC_DAC+2), a ;

2076

inc hl ;

2077

ld a, (BASIC_DAC+3) ;

2078

xor (hl) ;

2079

cpl ;

2080

ld (BASIC_DAC+3), a ;

2081

ld a, 2 ;

2082

jp MATH.PARM.PUSH ;

2083

2084

endif

2085

2086

if defined BOOLEAN.IMP

2087

2088

BOOLEAN.IMP.INT: ld a, (BASIC_DAC+2) ;

2089

ld hl, BASIC_ARG+2 ;

2090

cpl ;

2091

or (hl) ;

2092

ld (BASIC_DAC+2), a ;

2093

inc hl ;

2094

ld a, (BASIC_DAC+3) ;

2095

cpl ;

2096

or (hl) ;

2097

ld (BASIC_DAC+3), a ;

2098

ld a, 2 ;

2099

jp MATH.PARM.PUSH ;

2100

2101

endif

2102

2103

if defined BOOLEAN.SHR

2104

2105

BOOLEAN.SHR.INT: ld ix, BASIC_DAC+2 ; shift DAC integer to right (bits 15...0-->)

2106

ld a, (BASIC_ARG+2) ;

2107

or a ; clear carry

2108

jp z, MATH.PARM.PUSH ; return if not shift

2109

ld b, a ; shift count

2110

BOOLEAN.SHR.INT.N: rr (ix+1) ;

2111

rr (ix) ;

2112

or a ; clear carry

2113

djnz BOOLEAN.SHR.INT.N ; next shift

2114

ld a, 2 ;

2115

jp MATH.PARM.PUSH ; return DAC

2116

2117

endif

2118

2119

if defined BOOLEAN.SHL

2120

2121

BOOLEAN.SHL.INT: ld ix, BASIC_DAC+2 ; shift DAC integer to left (<--bits 15...0)

2122

ld a, (BASIC_ARG+2) ;

2123

or a ; clear carry

2124

jp z, MATH.PARM.PUSH ; return if not shift

2125

ld b, a ; shift count

2126

BOOLEAN.SHL.INT.N: rl (ix) ;

2127

rl (ix+1) ;

2128

or a ; clear carry

2129

djnz BOOLEAN.SHL.INT.N ; next shift

2130

ld a, 2 ;

2131

jp MATH.PARM.PUSH ; return DAC

2132

2133

endif

2134

2135

if defined BOOLEAN.NOT

2136

2137

BOOLEAN.NOT.INT: ld a, (BASIC_DAC+2) ;

2138

cpl ;

2139

ld (BASIC_DAC+2), a ;

2140

ld a, (BASIC_DAC+3) ;

2141

cpl ;

2142

ld (BASIC_DAC+3), a ;

2143

ld a, 2 ;

2144

jp MATH.PARM.PUSH ;

2145

2146

endif

2147

2148

2149

2150

;---------------------------------------------------------------------------------------------------------

2151

; MEMORY ALLOCATION ROUTINES

2152

;---------------------------------------------------------------------------------------------------------

2153

; Adapted from memory allocator code by SamSaga2, Spain, 2015

2154

; https://www.msx.org/forum/msx-talk/development/asm-memory-allocator

2155

; https://www.msx.org/users/samsaga2

2156

;---------------------------------------------------------------------------------------------------------

2157

memory.heap_start: equ VAR_STACK.END + 1 ; start at end of variable stack

2158

memory.heap_end: equ 0xF0A0 - 100 ; end at start of work area for stack (100 bytes reserved), BIOS and BASIC interpreter

2159

block.next: equ 0 ; next free block address

2160

block.size: equ 2 ; size of block including header

2161

block: equ 4 ; block.next + block.size

2162

2163

;; init

2164

memory.init:

2165

ld ix,memory.heap_start ; first block

2166

ld hl,memory.heap_start+block ; second block

2167

;; first block NEXT=secondblock, SIZE=0

2168

;; with this block we have a fixed start location

2169

;; because never will be allocated

2170

ld (ix+block.next),l

2171

ld (ix+block.next+1),h

2172

ld (ix+block.size),0

2173

ld (ix+block.size+1),0

2174

;; second block NEXT=0, SIZE=all

2175

;; the first and only free block have all available memory

2176

ld (ix+block.next+block),0

2177

ld (ix+block.next+block+1),0

2178

xor a

2179

;ld hl,memory.heap_end ; size = @heap_end (stack) - heap_start - block_header * 2 - 100 (buffer for stack)

2180

ld (BIOS_TEMP), sp

2181

ld hl, (BIOS_TEMP)

2182

ld de, memory.heap_start + (block * 2) + 100

2183

sbc hl,de

2184

;ld de, block * 2 + 100

2185

;sbc hl, de

2186

ld (ix+block.size+block),l

2187

ld (ix+block.size+block+1),h

2188

ret

2189

2190

;; alloc

2191

;; IN BC=size, OUT IX=memptr, NZ=ok

2192

memory.alloc:

2193

ld hl,block

2194

add hl,bc

2195

;push hl

2196

;pop bc

2197

ld b, h

2198

ld c, l

2199

ld ix,memory.heap_start ; this

2200

ld iy,0 ; prev

2201

memory.alloc.find:

2202

ld l,(ix+block.size)

2203

ld h,(ix+block.size+1)

2204

xor a

2205

sbc hl,bc

2206

jp z, memory.alloc.exactfit

2207

jp c, memory.alloc.nextblock

2208

;; split found block

2209

memory.alloc.splitfit:

2210

;; free space must allow at least two blocks headers (current + next)

2211

or h

2212

jr nz, memory.alloc.splitfit.do ; if free space > 0xFF, do split

2213

ld a, l

2214

cp 4

2215

jr c, memory.alloc.nextblock ; if free space < 4, skip to next block

2216

memory.alloc.splitfit.do:

2217

;; newfreeblock = this + BC

2218

push ix

2219

pop hl

2220

add hl,bc

2221

;; prevblock->next = newfreeblock

2222

ld (iy+block.next),l

2223

ld (iy+block.next+1),h

2224

;; newfreeblock->next = this->next

2225

push hl

2226

pop iy ; iy = newfreeblock

2227

ld l,(ix+block.next)

2228

ld h,(ix+block.next+1)

2229

ld (iy+block.next),l

2230

ld (iy+block.next+1),h

2231

;; newfreeblock->size = this->size - BC

2232

ld l,(ix+block.size)

2233

ld h,(ix+block.size+1)

2234

xor a

2235

sbc hl,bc

2236

ld (iy+block.size),l

2237

ld (iy+block.size+1),h

2238

;; this->size = BC

2239

ld (ix+block.size),c

2240

ld (ix+block.size+1),b

2241

jr memory.alloc.ok

2242

;; use whole found block

2243

memory.alloc.exactfit:

2244

;; prevblock->next = this->next - remove block from free list

2245

ld l,(ix+block.next)

2246

ld h,(ix+block.next+1)

2247

ld (iy+block.next),l

2248

ld (iy+block.next+1),h

2249

memory.alloc.ok:

2250

;; ix = first byte

2251

ld de,block

2252

add ix,de

2253

;; enable z-flag

2254

ld a,1

2255

or a

2256

ret

2257

memory.alloc.nextblock:

2258

ld l,(ix+block.next)

2259

ld h,(ix+block.next+1)

2260

ld a,l

2261

cp h

2262

ret z

2263

;; prevblock = this

2264

push ix

2265

pop iy

2266

;; this = this->next

2267

push hl

2268

pop ix

2269

jp memory.alloc.find

2270

2271

;; free

2272

;; IN IX=memptr

2273

memory.free:

2274

;; HL = IX - block_header_size

2275

push ix

2276

pop hl

2277

ld de, block

2278

xor a

2279

sbc hl,de

2280

;; start of search

2281

ld ix,memory.heap_start

2282

memory.free.find:

2283

ld e,(ix+block.next)

2284

ld d,(ix+block.next+1)

2285

ld a,d

2286

or e

2287

jp z, memory.free.passedend

2288

sbc hl,de ; test this (HL) against next (DE)

2289

jr c, memory.free.found ; if DE > HL

2290

add hl,de ; restore hl value

2291

push de

2292

pop ix ; current = next

2293

jr memory.free.find

2294

2295

;; ix=prev, hl=this, de=next

2296

memory.free.found:

2297

add hl,de ; restore hl value

2298

ld (ix+block.next), l

2299

ld (ix+block.next+1), h ; prev->next = this

2300

push hl

2301

pop iy

2302

ld (iy+block.next), e

2303

ld (iy+block.next+1), d ; this->next = next

2304

push ix ; prev x this

2305

pop iy

2306

push hl

2307

pop ix

2308

push de

2309

call memory.free.coalesce

2310

pop ix ; this x next

2311

jr memory.free.coalesce

2312

2313

;; parm1 = *next

2314

;; parm2 = *this

2315

memory.free.coalesce:

2316

ld c, (iy+block.size)

2317

ld b, (iy+block.size+1) ; bc = this->size

2318

push iy

2319

pop hl

2320

xor a

2321

adc hl, bc ; hl = this + this->size

2322

push ix

2323

pop de

2324

xor a

2325

sbc hl, de ; if this + this->size == next, then this->size += next->size, this->next = next->next

2326

jr z, memory.free.coalesce.do

2327

push ix ; else, new *this = *next

2328

pop iy

2329

ret

2330

memory.free.coalesce.do:

2331

ld l, (ix+block.size)

2332

ld h, (ix+block.size+1) ; hl = next->size

2333

xor a

2334

adc hl, bc ; hl += this->size

2335

ld (iy+block.size), l

2336

ld (iy+block.size+1), h ; this->size = hl

2337

ld l, (ix+block.next)

2338

ld h, (ix+block.next+1) ; hl = next->next

2339

ld (iy+block.next), l

2340

ld (iy+block.next+1), h ; this->next = hl

2341

ret

2342

2343

memory.free.passedend:

2344

;; append block at the end of the free list

2345

ld (ix+block.next),l

2346

ld (ix+block.next+1),h

2347

push hl

2348

pop iy

2349

ld (iy+block.next),0

2350

ld (iy+block.next+1),0

2351

ret

2352

2353

;; get_free

2354

;; OUT BC=freespace

2355

memory.get_free:

2356

ld ix,memory.heap_start

2357

ld bc,0

2358

memory.get_free.count:

2359

ld a,c

2360

add a,(ix+block.size)

2361

ld c,a

2362

ld a,b

2363

adc a,(ix+block.size+1)

2364

ld b,a

2365

ld l,(ix+block.next)

2366

ld h,(ix+block.next+1)

2367

ld a,h

2368

or l

2369

ret z

2370

push hl

2371

pop ix

2372

jr memory.get_free.count

2373

2374

memory.error: ld e, 7 ; out of memory

2375

__call_basic BASIC_ERROR_HANDLER ;

2376

ret

2377

2378

2379

2380

;---------------------------------------------------------------------------------------------------------

2381

; MATH PACK WRAPPER

2382

;---------------------------------------------------------------------------------------------------------

2383

2384

CALL_MATH_LIB: exx

2385

ld hl, RET_MATH_LIB

2386

push hl

2387

ld hl, BASIC_DAC

2388

ld de, BASIC_ARG

2389

ld bc, BASIC_SWPTMP

2390

jp (ix)

2391

RET_MATH_LIB: call COPY_TO.TMP_DAC

2392

exx

2393

ret

2394

2395

if defined MATH.ADD

2396

2397

MATH_DECADD: ld ix, addSingle

2398

jp CALL_MATH_LIB

2399

2400

endif

2401

2402

if defined MATH.SUB or defined MATH.NEG

2403

2404

MATH_DECSUB: ld ix, subSingle

2405

jp CALL_MATH_LIB

2406

2407

endif

2408

2409

if defined MATH.MULT

2410

2411

MATH_DECMUL: ld ix, mulSingle

2412

jp CALL_MATH_LIB

2413

2414

endif

2415

2416

if defined MATH.DIV

2417

2418

MATH_DECDIV: ld ix, divSingle

2419

jp CALL_MATH_LIB

2420

2421

endif

2422

2423

if defined MATH.POW

2424

2425

MATH_DBLEXP:

2426

MATH_SNGEXP: ld ix, powSingle

2427

jp CALL_MATH_LIB

2428

2429

endif

2430

2431

if defined COS

2432

2433

MATH_COS: ld ix, cosSingle

2434

jp CALL_MATH_LIB

2435

2436

endif

2437

2438

if defined SIN

2439

2440

MATH_SIN: ld ix, sinSingle

2441

jp CALL_MATH_LIB

2442

2443

endif

2444

2445

if defined TAN

2446

2447

MATH_TAN: ld ix, tanSingle

2448

jp CALL_MATH_LIB

2449

2450

endif

2451

2452

if defined ATN

2453

2454

MATH_ATN: ld ix, atanSingle

2455

jp CALL_MATH_LIB

2456

2457

endif

2458

2459

if defined SQR

2460

2461

MATH_SQR: ld ix, sqrtSingle

2462

jp CALL_MATH_LIB

2463

2464

endif

2465

2466

if defined LOG

2467

2468

MATH_LOG: ld ix, lnSingle

2469

jp CALL_MATH_LIB

2470

2471

endif

2472

2473

if defined EXP

2474

2475

MATH_EXP: ld ix, expSingle

2476

jp CALL_MATH_LIB

2477

2478

endif

2479

2480

if defined ABS

2481

2482

MATH_ABSFN: ld ix, absSingle

2483

jp CALL_MATH_LIB

2484

2485

endif

2486

2487

if defined MATH.SEED or defined MATH.NEG

2488

2489

MATH_NEG: ld ix, negSingle

2490

jp CALL_MATH_LIB

2491

2492

endif

2493

2494

if defined SGN

2495

2496

MATH_SGN: ld ix, sgnSingle

2497

jp CALL_MATH_LIB

2498

2499

endif

2500

2501

if defined RND or defined MATH.SEED

2502

2503

MATH_RND: ld ix, randSingle

2504

jp CALL_MATH_LIB

2505

2506

endif

2507

2508

MATH_FRCINT: ld hl, BASIC_DAC

2509

ld bc, BASIC_DAC+2

2510

call single2Int

2511

ld ix, BASIC_DAC

2512

ld (ix), 0

2513

ld (ix+1), 0

2514

;ld (ix+2), l

2515

;ld (ix+3), h

2516

ld (ix+4), 0

2517

ld (ix+5), 0

2518

ld (ix+6), 0

2519

ld (ix+7), 0

2520

ld a, 2

2521

ld (BASIC_VALTYP), a

2522

ret

2523

2524

MATH_FRCDBL: ; same as MATH_FRCSGL

2525

MATH_FRCSGL: ld hl, BASIC_DAC+2 ; input address

2526

ld bc, BASIC_DAC ; output address

2527

call int2Single

2528

ld a, 8

2529

ld (BASIC_VALTYP), a

2530

ret

2531

2532

MATH_ICOMP: ld a, h ; cp hl, de (alternative to bios DCOMPR)

2533

cp d

2534

jr nz, MATH_ICOMP.NE.HIGH

2535

ld a, l

2536

cp e

2537

jr nz, MATH_ICOMP.NE.LOW

2538

jr MATH_DCOMP.EQ

2539

MATH_ICOMP.NE.HIGH: jr c, MATH_ICOMP.GT.HIGH

2540

bit 7, a

2541

jr nz, MATH_DCOMP.GT

2542

jr MATH_DCOMP.LT

2543

MATH_ICOMP.GT.HIGH: bit 7, d

2544

jr z, MATH_DCOMP.GT

2545

jr MATH_DCOMP.LT

2546

MATH_ICOMP.NE.LOW: jr c, MATH_DCOMP.GT

2547

jr MATH_DCOMP.LT

2548

2549

MATH_XDCOMP: ; same as MATH_DCOMP

2550

MATH_DCOMP: ld ix, cmpSingle

2551

call CALL_MATH_LIB

2552

jr z, MATH_DCOMP.EQ

2553

jr c, MATH_DCOMP.LT

2554

MATH_DCOMP.GT: ld a, 0xFF ; DAC > ARG

2555

ret

2556

MATH_DCOMP.EQ: ld a, 0 ; DAC = ARG

2557

ret

2558

MATH_DCOMP.LT: ld a, 1 ; DAC < ARG

2559

ret

2560

2561

if defined CAST_STR_TO.VAL

2562

2563

MATH_FIN: ; HL has the source string

2564

ld a, (BASIC_VALTYP)

2565

cp 2 ; test if integer

2566

jr nz, MATH_FIN.1

2567

ld hl, (BASIC_DAC+2)

2568

ld de, BASIC_STRBUF

2569

call StrToInt

2570

ld hl, BASIC_STRBUF

2571

ret

2572

MATH_FIN.1: ld BC, BASIC_DAC

2573

call str2single

2574

ret

2575

2576

endif

2577

2578

if defined CAST_INT_TO.STR

2579

2580

MATH_FOUT: ld a, (BASIC_VALTYP)

2581

cp 2 ; test if integer

2582

jr nz, MATH_FOUT.1

2583

ld hl, (BASIC_DAC+2)

2584

ld de, BASIC_STRBUF

2585

call IntToStr

2586

ld hl, BASIC_STRBUF

2587

ret

2588

MATH_FOUT.1: ld hl, BASIC_DAC

2589

ld bc, BASIC_STRBUF

2590

call single2str

2591

ld hl, BASIC_STRBUF

2592

ret

2593

2594

endif

2595

2596

2597

2598

2599

;---------------------------------------------------------------------------------------------------------

2600

; Z80FLOAT LIBRARY

2601

2602

;---------------------------------------------------------------------------------------------------------

2603

; References:

2604

; https://github.com/Zeda/z80float

2605

; https://www.omnimaga.org/asm-language/(z80)-floating-point-routines/

2606

; https://en.wikipedia.org/wiki/Single-precision_floating-point_format

2607

;---------------------------------------------------------------------------------------------------------

2608

; Parameters:

2609

; HL points to the first operand

2610

; DE points to the second operand (if needed)

2611

; IX points to the third operand (if needed, rare)

2612

; BC points to where the result should be output

2613

; Floats are stored by a little-endian 24-bit mantissa. However, the highest bit

2614

; is taken as implicitly 1, so we replace it as a sign bit. Next comes an 8-bit

2615

; exponent biased by +128.

2616

;---------------------------------------------------------------------------------------------------------

2617

; Adapted to MSXBas2Asm by Amaury Carvalho, 2019

2618

;---------------------------------------------------------------------------------------------------------

2619

2620

;---------------------------------------------------------------------------------------------------------

2621

; Work area

2622

;---------------------------------------------------------------------------------------------------------

2623

2624

BASIC_HOLD8: equ 0xF806 ; 48 Work area for decimal multiplications.

2625

BASIC_HOLD2: equ 0xF836 ; 8 Work area in the execution of numerical operators.

2626

BASIC_HOLD: equ 0xF83E ; 8 Work area in the execution of numerical operators.

2627

scrap: equ BASIC_HOLD8

2628

seed0: equ BASIC_RNDX

2629

seed1: equ seed0 + 4

2630

var48: equ scrap + 4

2631

quot: equ scrap + 1

2632

addend: equ scrap

2633

addend2: equ scrap+7 ;4 bytes

2634

var_x: equ BASIC_HOLD8 + 4 ;4 bytes

2635

var_y: equ var_x + 4 ;4 bytes

2636

var_z: equ var_y + 4 ;4 bytes

2637

var_a: equ var_z + 4 ;4 bytes

2638

var_b: equ var_a + 4 ;4 bytes

2639

var_c: equ var_b + 4 ;4 bytes

2640

temp: equ var_c + 4 ;4 bytes

2641

temp1: equ temp + 4 ;4 bytes

2642

temp2: equ temp1 + 4 ;4 bytes

2643

temp3: equ temp2 + 4 ;4 bytes

2644

2645

pow10exp_single: equ scrap+9

2646

strout_single: equ 0xF750 ; PARM2 - BASIC_BUF ;pow10exp_single+2

2647

2648

;---------------------------------------------------------------------------------------------------------

2649

; addSingle

2650

;---------------------------------------------------------------------------------------------------------

2651

2652

;;Still need to tend to special cases

2653

addSingle:

2654

;;x+y

2655

push af

2656

push hl

2657

push de

2658

push bc

2659

addInject:

2660

inc de

2661

inc de

2662

inc hl

2663

inc hl

2664

ld a,(de)

2665

xor (hl)

2666

push af

2667

inc de

2668

inc hl

2669

ex de,hl

2670

ld a,(de)

2671

sub (hl)

2672

ex de,hl

2673

jr nc,$+5

2674

ex de,hl

2675

neg

2676

cp 24

2677

jp nc,add_unneeded

2678

push hl

2679

ld hl,addend+6

2680

dec de

2681

ld bc,0408h

2682

dec hl

2683

ld (hl),0

2684

sub c

2685

jr nc,$-5

2686

add a,c

2687

push af

2688

push hl

2689

ex de,hl

2690

ld a,(hl)

2691

or 80h

2692

ld (de),a

2693

dec de

2694

dec hl

2695

ldd

2696

ldd

2697

ex de,hl

2698

dec b

2699

jr z,$+7

2700

ld (hl),0

2701

dec hl

2702

djnz $-3

2703

pop hl

2704

pop af

2705

ld b,a

2706

jr z,noshift

2707

set 7,(hl)

2708

_1:

2709

push hl

2710

srl (hl)

2711

dec hl

2712

rr (hl)

2713

dec hl

2714

rr (hl)

2715

dec hl

2716

rr (hl)

2717

pop hl

2718

djnz _1

2719

noshift:

2720

pop hl ;bigger float

2721

dec hl

2722

ld b,(hl)

2723

dec hl

2724

dec hl

2725

ex de,hl

2726

pop af

2727

jp m,subtract

2728

ld hl,addend+2

2729

ld a,(hl)

2730

rla

2731

inc hl

2732

ld a,(de)

2733

adc a,(hl)

2734

ld (hl),a

2735

inc hl

2736

inc de

2737

ld a,(de)

2738

adc a,(hl)

2739

ld (hl),a

2740

inc hl

2741

inc de

2742

ld a,(de)

2743

set 7,a

2744

adc a,(hl)

2745

ld (hl),a

2746

inc hl

2747

inc de

2748

ld a,(de)

2749

ld (hl),a

2750

jp nc,add_done

2751

inc (hl)

2752

jp z,add_overflow

2753

dec hl

2754

rr (hl)

2755

dec hl

2756

rr (hl)

2757

dec hl

2758

rr (hl)

2759

jp add_done

2760

subtract:

2761

ld hl,addend

2762

xor a

2763

ld c,a

2764

sub (hl)

2765

ld (hl),a

2766

inc hl

2767

ld a,c

2768

sbc a,(hl)

2769

ld (hl),a

2770

inc hl

2771

ld a,c

2772

sbc a,(hl)

2773

ld (hl),a

2774

inc hl

2775

ld a,(de)

2776

sbc a,(hl)

2777

ld (hl),a

2778

inc hl

2779

inc de

2780

ld a,(de)

2781

sbc a,(hl)

2782

ld (hl),a

2783

inc hl

2784

inc de

2785

ld a,(de)

2786

set 7,a

2787

sbc a,(hl)

2788

ld (hl),a

2789

inc hl

2790

inc de

2791

ld a,(de)

2792

ld (hl),a

2793

dec de

2794

ex de,hl

2795

jr nc,negated

2796

ld hl,addend

2797

ld a,80h

2798

xor b

2799

ld b,a

2800

ld a,c

2801

sub (hl)

2802

ld (hl),a

2803

inc hl

2804

ld a,c

2805

sbc a,(hl)

2806

ld (hl),a

2807

inc hl

2808

ld a,c

2809

sbc a,(hl)

2810

ld (hl),a

2811

inc hl

2812

ld a,c

2813

sbc a,(hl)

2814

ld (hl),a

2815

inc hl

2816

ld a,c

2817

sbc a,(hl)

2818

ld (hl),a

2819

inc hl

2820

ld a,c

2821

sbc a,(hl)

2822

ld (hl),a

2823

negated:

2824

jp m,add_done

2825

push bc

2826

ld hl,(addend)

2827

ld de,(addend+2)

2828

ld bc,(addend+4)

2829

ld a,h

2830

or l

2831

or d

2832

or e

2833

or b

2834

or c

2835

jp z,add_underflow

2836

ld a,(addend+6)

2837

normalize:

2838

dec a

2839

jr z,add_underflow

2840

add hl,hl

2841

rl e

2842

rl d

2843

rl c

2844

rl b

2845

jp p,normalize

2846

ld (addend),hl

2847

ld (addend+2),de

2848

ld (addend+4),bc

2849

ld (addend+6),a

2850

pop bc

2851

add_done:

2852

;;Need to adjust sign flag

2853

ld hl,addend+5

2854

ld a,(hl)

2855

rla

2856

rl b

2857

rra

2858

ld (hl),a

2859

dec hl

2860

dec hl

2861

add_copy:

2862

pop de

2863

push de

2864

ldi

2865

ldi

2866

ldi

2867

ld a,(hl)

2868

ld (de),a

2869

pop bc

2870

pop de

2871

pop hl

2872

pop af

2873

ret

2874

add_underflow:

2875

;;How many push/pops are needed?

2876

;;return ZERO

2877

ld hl,0

2878

ld (addend+3),hl

2879

ld (addend+5),hl

2880

pop bc

2881

jr add_done

2882

add_overflow:

2883

;;How many push/pops are needed?

2884

;;return INF

2885

dec hl

2886

ld (hl),40h

2887

jr add_done

2888

add_unneeded:

2889

;;How many push/pops are needed?

2890

;;Return bigger number

2891

pop af

2892

dec hl

2893

dec hl

2894

dec hl

2895

jr add_copy

2896

2897

;---------------------------------------------------------------------------------------------------------

2898

; subSingle

2899

;---------------------------------------------------------------------------------------------------------

2900

2901

subSingle:

2902

;;x-y

2903

push af

2904

push hl

2905

push de

2906

push bc

2907

push hl

2908

ex de,hl

2909

ld de,addend2

2910

ldi

2911

ldi

2912

ld a,(hl)

2913

xor 80h

2914

ld (de),a

2915

inc de

2916

inc hl

2917

ld a,(hl)

2918

ld (de),a

2919

ex de,hl

2920

pop hl

2921

ld de,addend2

2922

jp addInject ;jumps in to the addSingle routine

2923

2924

;---------------------------------------------------------------------------------------------------------

2925

; mulSingle

2926

;---------------------------------------------------------------------------------------------------------

2927

2928

mulSingle:

2929

;Inputs: HL points to float1, DE points to float2, BC points to where the result is copied

2930

;Outputs: float1*float2 is stored to (BC)

2931

;573+mul24+{0,35}+{0,30}

2932

;min: 1398cc

2933

;max: 2564cc

2934

;avg: 2055.13839751681cc

2935

push af

2936

push hl

2937

push de

2938

push bc

2939

2940

call _2 ;CHLB

2941

ld a,c

2942

ex de,hl

2943

pop hl

2944

push hl

2945

ld (hl),b

2946

inc hl

2947

ld (hl),e

2948

inc hl

2949

ld (hl),d

2950

inc hl

2951

ld (hl),a

2952

pop bc

2953

pop de

2954

pop hl

2955

pop af

2956

ret

2957

2958

2959

_2:

2960

;;return float in CHLB

2961

push de

2962

ld e,(hl)

2963

inc hl

2964

ld d,(hl)

2965

inc hl

2966

ld c,(hl)

2967

inc hl

2968

ld a,(hl)

2969

or a

2970

jr z,mulSingle_case0

2971

ex de,hl

2972

ex (sp),hl

2973

ld e,(hl)

2974

inc hl

2975

ld d,(hl)

2976

inc hl

2977

ld b,(hl)

2978

inc hl

2979

2980

;inc (hl)

2981

;dec (hl)

2982

;jr z,mulSingle_case1

2983

push af

2984

ld a, (hl)

2985

or a

2986

jp z,mulSingle_case1

2987

pop af

2988

2989

add a,(hl) ;\

2990

pop hl ; |

2991

rra ; |Lots of help from Runer112 and

2992

adc a,a ; |calc84maniac for optimizing

2993

jp po,bad ; |this exponent check.

2994

xor 80h ; |

2995

jr z,underflow ;/

2996

push af ;exponent

2997

ld a,b

2998

xor c

2999

push af ;sign

3000

set 7,b

3001

set 7,c

3002

call mul24 ;BDE*CHL->HLBCDE, returns sign info

3003

pop de

3004

ld a,e

3005

pop de

3006

jp m,_3

3007

rl c

3008

rl b

3009

adc hl,hl

3010

dec d

3011

_3:

3012

inc d

3013

jr z,overflow

3014

rl c

3015

ld c,d

3016

ld de,0

3017

push af

3018

ld a,b

3019

adc a,e

3020

ld b,a

3021

adc hl,de

3022

jr nc,_4

3023

inc c

3024

jr z,overflow

3025

rr h

3026

rr l

3027

rr b

3028

_4:

3029

pop af

3030

cpl

3031

and $80

3032

xor h

3033

ld h,a

3034

ret

3035

bad:

3036

jr nc,overflow

3037

underflow:

3038

ld hl,0

3039

rl b

3040

rr h

3041

ld c,l

3042

ld b,l

3043

ret

3044

overflow:

3045

ld hl,$8000

3046

jr underflow+3

3047

mulSingle_case1:

3048

;x*0 -> 0

3049

;x*inf -> inf

3050

;x*NaN -> NaN

3051

pop af

3052

pop hl

3053

ld h,b

3054

ld l,d

3055

ld b,e

3056

ld c,0

3057

ret

3058

mulSingle_case0:

3059

;special*x = special

3060

;NaN*x = NaN

3061

;0*0 = 0

3062

;0*NaN = NaN

3063

;0*Inf = NaN

3064

;Inf*Inf = Inf

3065

;Inf*-Inf =-Inf

3066

;0CDE

3067

pop hl

3068

inc hl

3069

inc hl

3070

inc hl

3071

ld a,(hl)

3072

or a

3073

jr z,_5

3074

ld h,c

3075

ld c,0

3076

ret

3077

_5:

3078

dec hl

3079

ld b,(hl)

3080

;basically, if b|c has bit 5 set, return NaN

3081

ld a,b

3082

or c

3083

ld h,$20

3084

and h

3085

jr z,_6

3086

ld c,0

3087

ret

3088

_6:

3089

ld a,c

3090

xor b

3091

rl b

3092

rlca

3093

rr b

3094

res 4,b

3095

3096

rl c

3097

rrca

3098

rr c

3099

3100

ld a,c

3101

and $E0

3102

add a,b

3103

rra

3104

ld h,a

3105

ld c,0

3106

ret

3107

mul24:

3108

;;BDE*CHL -> HLBCDE

3109

;;155 bytes

3110

;;402+3*C_Times_BDE

3111

;;fastest:1201cc

3112

;;slowest:1753cc

3113

;;avg :1464.9033203125cc (1464+925/1024)

3114

;min: 825cc

3115

;max: 1926cc

3116

;avg: 1449.63839751681cc

3117

3118

push bc

3119

ld c,l

3120

push hl

3121

call C_Times_BDE

3122

ld (var48),hl

3123

ld l,a

3124

ld h,c

3125

ld (var48+2),hl

3126

3127

pop hl

3128

ld c,h

3129

call C_Times_BDE

3130

push bc

3131

ld bc,(var48+1)

3132

add hl,bc

3133

ld (var48+1),hl

3134

pop bc

3135

ld b,c

3136

ld c,a

3137

ld hl,(var48+3)

3138

ld h,0

3139

adc hl,bc

3140

ld (var48+3),hl

3141

3142

pop bc

3143

call C_Times_BDE

3144

ld de,(var48+2)

3145

add hl,de

3146

ld (var48+2),hl

3147

ld d,c

3148

ld e,a

3149

ld b,h

3150

ld c,l

3151

ld hl,(var48+4)

3152

ld h,0

3153

adc hl,de

3154

ld de,(var48)

3155

ret

3156

3157

;---------------------------------------------------------------------------------------------------------

3158

; divSingle

3159

;---------------------------------------------------------------------------------------------------------

3160

3161

divSingle:

3162

;;HL points to numerator

3163

;;DE points to denominator

3164

;;BC points to where the quotient gets written

3165

call pushpop

3166

divSingle_no_pushpop:

3167

inc hl

3168

inc de

3169

inc hl

3170

inc de

3171

ld a,(de) ;\

3172

xor (hl) ; |Get sign of output

3173

add a,a ; |

3174

push af ;/

3175

push bc

3176

inc hl

3177

inc de

3178

ld a,(hl) ;\

3179

ex de,hl ; |Get exponent

3180

sub (hl) ; |

3181

ex de,hl ; |

3182

3183

ld b,-1

3184

jr nc,_7

3185

dec b

3186

_7:

3187

add a,128

3188

jr nc,_8

3189

inc b

3190

_8:

3191

inc b

3192

jr z,_9

3193

jp p,divunderflow

3194

jp m,divoverflow

3195

_9:

3196

ld (quot+3),a

3197

dec hl

3198

dec de

3199

ld b,(hl)

3200

dec hl

3201

ld a,(hl)

3202

dec hl

3203

ld l,(hl)

3204

ld h,a

3205

ex de,hl

3206

3207

ld c,(hl)

3208

dec hl

3209

ld a,(hl)

3210

dec hl

3211

ld l,(hl)

3212

ld h,a

3213

ex de,hl

3214

3215

set 7,c

3216

ld a,b

3217

or 80h

3218

sbc hl,de

3219

sbc a,c

3220

jr nz,_10

3221

or h

3222

or l

3223

jr z,setmantissa0

3224

xor a

3225

_10:

3226

jr nc,startdiv

3227

ld b,a

3228

ld a,(quot+3)

3229

dec a

3230

ld (quot+3),a

3231

ld a,b

3232

add hl,hl

3233

adc a,a

3234

add hl,de

3235

adc a,c

3236

startdiv:

3237

ld b,1

3238

call divsub0+3

3239

ld (quot+1),bc

3240

call divsub0

3241

ld (quot),bc

3242

call divsub0

3243

ld (quot-1),bc

3244

add hl,hl

3245

rla

3246

jr c,_11

3247

sbc hl,de

3248

sbc a,c

3249

ccf

3250

_11:

3251

ld hl,(quot)

3252

ld de,(quot+2)

3253

ld bc,0

3254

adc hl,bc

3255

ex de,hl

3256

adc hl,bc

3257

ld b,h

3258

ld c,l

3259

writeback:

3260

pop hl

3261

ld (hl),e

3262

inc hl

3263

ld (hl),d

3264

inc hl

3265

rl c

3266

pop af

3267

rr c

3268

ld (hl),c

3269

inc hl

3270

ld (hl),b

3271

ret

3272

divoverflow:

3273

ld b,$40

3274

jr _12

3275

divunderflow:

3276

ld b,0

3277

jr _12

3278

setmantissa0:

3279

ld bc,(quot+2)

3280

_12:

3281

ld de,0

3282

ld c,e

3283

jr writeback

3284

divsub0:

3285

;;882cc max

3286

call divsub1 ;34 or 66

3287

call divsub1 ;

3288

call divsub1

3289

call divsub1

3290

call divsub1

3291

call divsub1

3292

call divsub1

3293

call divsub1

3294

or a

3295

sbc hl,de

3296

sbc a,c

3297

inc b

3298

ret nc

3299

dec b

3300

add hl,de

3301

adc a,c

3302

ret

3303

divsub1:

3304

;34cc or 66cc or 93cc

3305

sla b

3306

add hl,hl

3307

rla

3308

ret nc

3309

or a

3310

inc b

3311

sbc hl,de

3312

sbc a,c

3313

ret c

3314

inc b

3315

sbc hl,de

3316

sbc a,c

3317

ret

3318

3319

;---------------------------------------------------------------------------------------------------------

3320

; powSingle

3321

; https://www.geeksforgeeks.org/write-a-c-program-to-calculate-powxn/

3322

; https://stackoverflow.com/questions/3518973/floating-point-exponentiation-without-power-function

3323

;---------------------------------------------------------------------------------------------------------

3324

;double mypow( double base, double power, double precision )

3325

;{

3326

; if ( power < 0 ) return 1 / mypow( base, -power, precision );

3327

; else if ( power >= 1 ) return base * mypow( base, power-1, precision );

3328

; else if ( precision >= 1 ) {

3329

; if( base >= 0 ) return sqrt( base );

3330

; else return sqrt( -base );

3331

; } else return sqrt( mypow( base, power*2, precision*2 ) );

3332

;}

3333

3334

if defined MATH.POW or defined MATH_EXP or defined MATH_LOG or defined MATH_LN

3335

3336

powSingle:

3337

;;Computes y^x

3338

;;HL points to y

3339

;;DE points to x

3340

;;BC points to output

3341

call pushpop

3342

push bc

3343

push de

3344

ld bc, var_y ; power

3345

call copySingle

3346

pop hl

3347

ld bc, var_x ; base

3348

call copySingle

3349

ld hl, const_precision

3350

ld bc, var_a ; precision

3351

call copySingle

3352

ld hl, const_0

3353

ld bc, var_z ; result

3354

call copySingle

3355

call powSingle.loop

3356

pop bc

3357

ld hl, var_z

3358

call copySingle

3359

ret

3360

3361

powSingle.loop:

3362

; if ( power < 0 ) return 1 / mypow( base, -power, precision );

3363

ld hl, var_y

3364

ld de, const_0

3365

call cmpSingle

3366

jp c, powSingle.1

3367

3368

; else if ( power >= 1 ) return base * mypow( base, power-1, precision );

3369

ld hl, var_y

3370

ld de, const_1

3371

call cmpSingle

3372

jp nc, powSingle.2

3373

3374

; else if ( precision >= 1 ) {

3375

; if( base >= 0 ) return sqrt( base );

3376

; else return sqrt( -base );

3377

ld hl, var_a

3378

ld de, const_1

3379

call cmpSingle

3380

jp nc, powSingle.3

3381

3382

; } else return sqrt( mypow( base, power*2, precision*2 ) );

3383

ld hl, var_y

3384

ld de, const_2

3385

ld bc, var_b

3386

call mulSingle

3387

ld hl, var_b

3388

ld bc, var_y

3389

call copySingle

3390

ld hl, var_a

3391

ld de, const_2

3392

ld bc, var_b

3393

call mulSingle

3394

ld hl, var_b

3395

ld bc, var_a

3396

call copySingle

3397

call powSingle.loop

3398

ld hl, var_z

3399

ld bc, var_b

3400

call sqrtSingle

3401

ld hl, var_b

3402

ld bc, var_z

3403

call copySingle

3404

ret

3405

3406

powSingle.1:

3407

; return 1 / mypow( base, -power, precision );

3408

ld hl, const_0

3409

ld de, var_y

3410

ld bc, var_b

3411

call subSingle

3412

ld hl, var_b

3413

ld bc, var_y

3414

call copySingle

3415

call powSingle.loop

3416

ld hl, const_1

3417

ld de, var_z

3418

ld bc, var_b

3419

call divSingle

3420

ld hl, var_b

3421

ld bc, var_z

3422

call copySingle

3423

ret

3424

3425

powSingle.2:

3426

; return base * mypow( base, power-1, precision );

3427

ld hl, var_y

3428

ld de, const_1

3429

ld bc, var_b

3430

call subSingle

3431

ld hl, var_b

3432

ld bc, var_y

3433

call copySingle

3434

call powSingle.loop

3435

ld hl, var_z

3436

ld de, var_x

3437

ld bc, var_b

3438

call mulSingle

3439

ld hl, var_b

3440

ld bc, var_z

3441

call copySingle

3442

ret

3443

3444

powSingle.3:

3445

; if( base >= 0 ) return sqrt( base );

3446

; else return sqrt( -base );

3447

ld hl, var_x

3448

ld de, const_0

3449

call cmpSingle

3450

jp nc, powSingle.1

3451

;ld hl, var_x

3452

ld bc, var_b

3453

call negSingle

3454

ld hl, var_b

3455

;ld bc, var_z

3456

;call sqrtSingle

3457

;ret

3458

3459

powSingle.3.1:

3460

;ld hl, var_x

3461

ld bc, var_z

3462

call sqrtSingle

3463

ret

3464

3465

pow2Single:

3466

;;Computes 2^x

3467

call pushpop

3468

push bc

3469

3470

exp_inject:

3471

;if x is on [0,1):

3472

; 2^x = 1.000000001752 + x * (0.693146989552 + x * (0.2402298085906 + x * (5.54833215071e-2 + x * (9.67907584392e-3 + x * (1.243632065103e-3 + x * 2.171671843714e-4)))))

3473

;Please note that usually I like to reduce to [-.5,.5] as the extra overhead is usually worth it.

3474

;In this case, our polynomial is the same degree, with error different by less than 1 bit, so it's just a waste to range-reduce in this way.

3475

;

3476

;int(x) -> out_exp

3477

;x-=int(x) ;leaves x in [0,1)

3478

;;If x==0 -> out==1

3479

;;if x==inf -> out==inf

3480

;;if x==-inf -> out==0

3481

;;if x==NAN -> out==NAN

3482

ld de,var48+10

3483

call mov4

3484

ld hl,(var48+10)

3485

ld de,(var48+12)

3486

ld a,e

3487

add a,a

3488

push af ;keep track of sign

3489

rrca

3490

ld (var48+12),a

3491

ld c,a

3492

ld a,d

3493

or a

3494

jp z,exp_spec

3495

cp 80h-23

3496

jp c,exp_underflow

3497

sub 128 ; sub a,128

3498

jr c,_pow_1 ;int(x)=0

3499

inc a

3500

cp 7

3501

jp nc,exp_overflow

3502

set 7,c

3503

ld b,a

3504

xor a

3505

add hl,hl

3506

rl c

3507

rla

3508

djnz $-4

3509

ld b,7Fh

3510

bit 7,c

3511

jr nz,exp_normalized

3512

ld e,a

3513

ld a,h

3514

or l

3515

or c

3516

ld a,e

3517

jr z,exp_zeroed

3518

dec b

3519

add hl,hl

3520

rl c

3521

jp p,$-4

3522

jr exp_normalized ;.db $11 ;start of `ld de,**`

3523

exp_zeroed:

3524

ld b,0

3525

exp_normalized:

3526

ld (var48+10),hl

3527

res 7,c

3528

ld (var48+12),bc

3529

jr comp_exp ;.db $06 ;start of 'ld b,*` just to eat the next byte

3530

_pow_1:

3531

xor a

3532

comp_exp:

3533

pop hl

3534

rr l

3535

jr nc,_pow_2

3536

cpl

3537

or a

3538

jp z,exp_underflow+1

3539

;perform 1-(var48+10)--> var48+10

3540

ld hl,const_1

3541

ld de,var48+10

3542

ld b,d

3543

ld c,e

3544

call subSingle

3545

_pow_2:

3546

push af

3547

;our 'x' is at var48+10

3548

;our `temp` is at var48+6 so as not to cause issues with mulSingle)

3549

;uses 14 bytes of RAM

3550

ld hl,var48+10

3551

ld de,exp_a6

3552

ld bc,var48+6

3553

call mulSingle

3554

ld d,b

3555

ld e,c

3556

ld hl,exp_a5

3557

call addSingle

3558

ld hl,var48+10

3559

call mulSingle

3560

ld hl,exp_a4

3561

call addSingle

3562

ld hl,var48+10

3563

call mulSingle

3564

ld hl,exp_a3

3565

call addSingle

3566

ld hl,var48+10

3567

call mulSingle

3568

ld hl,exp_a2

3569

call addSingle

3570

ld hl,var48+10

3571

call mulSingle

3572

ld hl,exp_a1

3573

call addSingle

3574

ld hl,var48+10

3575

call mulSingle

3576

ld hl,const_1

3577

call addSingle

3578

ld hl,var48+9

3579

pop af

3580

add a,(hl)

3581

ld (hl),a

3582

ex de,hl

3583

pop de

3584

jp mov4

3585

exp_spec:

3586

;bit 6 means INF

3587

;bit 5 means NAN

3588

;no bits means zero

3589

;NAN -> NAN

3590

;+inf -> +inf

3591

;-inf -> +0 because lim approaches 0 from the right

3592

ld a,c

3593

add a,a

3594

jr z,exp_zero

3595

jp m,exp_inf

3596

;exp_NAN

3597

pop af

3598

ld de,0040h

3599

exp_return_spec:

3600

pop hl

3601

rr e

3602

ld (hl),a

3603

inc hl

3604

ld (hl),a

3605

inc hl

3606

ld (hl),e

3607

inc hl

3608

ld (hl),d

3609

ret

3610

exp_overflow:

3611

exp_inf:

3612

;+inf -> +inf

3613

;-inf -> +0 because lim approaches 0 from the right

3614

pop af

3615

sbc a,a ;FF if should be 0,

3616

cpl

3617

and 80h

3618

ld d,0

3619

ld e,a

3620

jr exp_return_spec

3621

exp_underflow:

3622

exp_zero:

3623

pop af

3624

or a

3625

ld de,$8000

3626

jr exp_return_spec

3627

3628

endif

3629

3630

;---------------------------------------------------------------------------------------------------------

3631

; sqrtSingle

3632

;---------------------------------------------------------------------------------------------------------

3633

3634

if defined MATH_SQR or defined MATH_EXP

3635

3636

;Uses 3 bytes at scrap

3637

sqrtSingle:

3638

;552+{0,19}+8{0,3+{0,3}}+pushpop+sqrtHLIX

3639

;min: 1784

3640

;max: 1987

3641

;avg: 1872

3642

call pushpop

3643

push bc

3644

ld c,(hl)

3645

inc hl

3646

ld e,(hl)

3647

inc hl

3648

ld a,(hl)

3649

add a,a

3650

jp c,sqrtSingle_NaN

3651

scf

3652

rra

3653

ld d,a

3654

inc hl

3655

ld a,(hl)

3656

or a

3657

jp z,sqrtSingle_special

3658

add a,80h

3659

rra

3660

push af ;new exponent

3661

jr c,_13

3662

srl d

3663

rr e

3664

rr c

3665

_13:

3666

ex de,hl

3667

ld ixh,c

3668

ld ixl,0

3669

call sqrtHLIX

3670

;AHL is the new remainder

3671

;Need to divide by 2, then divide by the 16-bit (var_x+4)

3672

rra

3673

ld a,h

3674

;HL/DE to 8 bits

3675

;We are just going to approximate it

3676

res 0,l

3677

jr c,$+5

3678

cp d

3679

jr c,$+4

3680

sub d

3681

inc l

3682

sla l

3683

rla

3684

jr c,$+5

3685

cp d

3686

jr c,$+4

3687

sub d

3688

inc l

3689

sla l

3690

rla

3691

jr c,$+5

3692

cp d

3693

jr c,$+4

3694

sub d

3695

inc l

3696

sla l

3697

rla

3698

jr c,$+5

3699

cp d

3700

jr c,$+4

3701

sub d

3702

inc l

3703

sla l

3704

rla

3705

jr c,$+5

3706

cp d

3707

jr c,$+4

3708

sub d

3709

inc l

3710

sla l

3711

rla

3712

jr c,$+5

3713

cp d

3714

jr c,$+4

3715

sub d

3716

inc l

3717

sla l

3718

rla

3719

jr c,$+5

3720

cp d

3721

jr c,$+4

3722

sub d

3723

inc l

3724

sla l

3725

rla

3726

jr c,$+5

3727

cp d

3728

jr c,$+4

3729

sub d

3730

inc l

3731

3732

pop bc

3733

ld a,l

3734

pop hl

3735

;BDEA

3736

ld (hl),a

3737

inc hl

3738

ld (hl),e

3739

inc hl

3740

res 7,d

3741

ld (hl),d

3742

inc hl

3743

ld (hl),b

3744

ret

3745

sqrtSingle_NaN:

3746

ld hl,const_NaN

3747

pop de

3748

jp mov4

3749

sqrtSingle_special:

3750

dec hl

3751

dec hl

3752

pop de

3753

jp mov4

3754

3755

sqrtHLIX:

3756

;Input: HLIX

3757

;Output: DE is the sqrt, AHL is the remainder

3758

;speed: 754+{0,1}+6{0,6}+{0,3+{0,18}}+{0,38}+sqrtHL

3759

;min: 1130

3760

;max: 1266

3761

;avg: 1190.5

3762

3763

3764

call sqrtHL

3765

add a,a

3766

ld e,a

3767

jr nc,_14

3768

inc d

3769

_14:

3770

3771

ld a,ixh

3772

sll e

3773

rl d

3774

add a,a

3775

adc hl,hl

3776

add a,a

3777

adc hl,hl

3778

sbc hl,de

3779

jr nc,_15

3780

add hl,de

3781

dec e

3782

jr _15a ;.db $FE ;start of `cp *`

3783

_15:

3784

inc e

3785

_15a:

3786

sll e

3787

rl d

3788

add a,a

3789

adc hl,hl

3790

add a,a

3791

adc hl,hl

3792

sbc hl,de

3793

jr nc,_16

3794

add hl,de

3795

dec e

3796

jr _16a ;.db $FE ;start of `cp *`

3797

_16:

3798

inc e

3799

_16a:

3800

sll e

3801

rl d

3802

add a,a

3803

adc hl,hl

3804

add a,a

3805

adc hl,hl

3806

sbc hl,de

3807

jr nc,_17

3808

add hl,de

3809

dec e

3810

jr _17a ;.db $FE ;start of `cp *`

3811

_17:

3812

inc e

3813

_17a:

3814

sll e

3815

rl d

3816

add a,a

3817

adc hl,hl

3818

add a,a

3819

adc hl,hl

3820

sbc hl,de

3821

jr nc,_18

3822

add hl,de

3823

dec e

3824

jr _18a ;.db $FE ;start of `cp *`

3825

_18:

3826

inc e

3827

_18a:

3828

;Now we have four more iterations

3829

;The first two are no problem

3830

ld a,ixl

3831

sll e

3832

rl d

3833

add a,a

3834

adc hl,hl

3835

add a,a

3836

adc hl,hl

3837

sbc hl,de

3838

jr nc,_19

3839

add hl,de

3840

dec e

3841

jr _19a ;.db $FE ;start of `cp *`

3842

_19:

3843

inc e

3844

_19a:

3845

sll e

3846

rl d

3847

add a,a

3848

adc hl,hl

3849

add a,a

3850

adc hl,hl

3851

sbc hl,de

3852

jr nc,_20

3853

add hl,de

3854

dec e

3855

jr _20a ;.db $FE ;start of `cp *`

3856

_20:

3857

inc e

3858

_20a:

3859

sqrt32_iter15:

3860

;On the next iteration, HL might temporarily overflow by 1 bit

3861

sll e

3862

rl d ;sla e \ rl d \ inc e

3863

add a,a

3864

adc hl,hl

3865

add a,a

3866

adc hl,hl ;This might overflow!

3867

jr c,sqrt32_iter15_br0

3868

;

3869

sbc hl,de

3870

jr nc,_21

3871

add hl,de

3872

dec e

3873

jr sqrt32_iter16

3874

sqrt32_iter15_br0:

3875

or a

3876

sbc hl,de

3877

_21:

3878

inc e

3879

3880

;On the next iteration, HL is allowed to overflow, DE could overflow with our current routine, but it needs to be shifted right at the end, anyways

3881

sqrt32_iter16:

3882

add a,a

3883

ld b,a ;either 0x00 or 0x80

3884

adc hl,hl

3885

rla

3886

adc hl,hl

3887

rla

3888

;AHL - (DE+DE+1)

3889

sbc hl,de

3890

sbc a,b

3891

inc e

3892

or a

3893

sbc hl,de

3894

sbc a,b

3895

ret p

3896

add hl,de

3897

adc a,b

3898

dec e

3899

add hl,de

3900

adc a,b

3901

ret

3902

3903

sqrtHL:

3904

;returns A as the sqrt, HL as the remainder, D = 0

3905

;min: 376cc

3906

;max: 416cc

3907

;avg: 393cc

3908

ld de,$5040

3909

ld a,h

3910

sub e

3911

jr nc,_22

3912

add a,e

3913

ld d,$10

3914

_22:

3915

sub d

3916

jr nc,_23

3917

add a,d

3918

jr _23a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

3919

_23:

3920

set 5,d

3921

_23a:

3922

res 4,d

3923

srl d

3924

3925

set 2,d

3926

sub d

3927

jr nc,_24

3928

add a,d

3929

jr _24a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

3930

_24:

3931

set 3,d

3932

_24a:

3933

res 2,d

3934

srl d

3935

3936

inc d

3937

sub d

3938

jr nc,_25

3939

add a,d

3940

dec d ;this resets the low bit of D, so `srl d` resets carry.

3941

jr _25a ;.db $06 ;start of ld b,* which is 7cc to skip the next byte.

3942

_25:

3943

inc d

3944

_25a:

3945

srl d

3946

ld h,a

3947

3948

3949

sbc hl,de

3950

ld a,e

3951

jr nc,_26

3952

add hl,de

3953

_26:

3954

ccf

3955

rra

3956

srl d

3957

rra

3958

ld e,a

3959

3960

sbc hl,de

3961

jr nc,_27

3962

add hl,de

3963

jr _27a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

3964

_27:

3965

or %00100000

3966

_27a:

3967

xor %00011000

3968

srl d

3969

rra

3970

ld e,a

3971

3972

3973

sbc hl,de

3974

jr nc,_28

3975

add hl,de

3976

jr _28a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

3977

_28:

3978

or %00001000

3979

_28a:

3980

xor %00000110

3981

srl d

3982

rra

3983

ld e,a

3984

sbc hl,de

3985

jr nc,_29

3986

add hl,de

3987

srl d

3988

rra

3989

ret

3990

_29:

3991

inc a

3992

srl d

3993

rra

3994

ret

3995

3996

endif

3997

3998

;---------------------------------------------------------------------------------------------------------

3999

; lnSingle

4000

;---------------------------------------------------------------------------------------------------------

4001

4002

if defined MATH_LOG or defined MATH_LN

4003

4004

lnSingle:

4005

; x / (1 + x/(2-x+4x/(3-2x+9x/(4-3x+16x/(5-4x)))))

4006

; a * x ^ (1/a) - a, where a = 100

4007

call pushpop

4008

push bc

4009

ld de, const_100_inv

4010

ld bc, temp

4011

call powSingle ; temp = x ^ (1/100)

4012

ld hl, temp

4013

ld de, const_100

4014

ld bc, temp1

4015

call mulSingle ; temp1 = temp * 100

4016

ld hl, temp1

4017

pop bc

4018

call subSingle ; bc = temp1 - 100

4019

ret

4020

4021

endif

4022

4023

;---------------------------------------------------------------------------------------------------------

4024

; logSingle

4025

;---------------------------------------------------------------------------------------------------------

4026

4027

if defined MATH_LOG

4028

4029

logSingle:

4030

call pushpop

4031

push bc

4032

ld bc, temp

4033

call lnSingle

4034

ld hl, temp

4035

ld de, const_lg10

4036

pop bc

4037

call divSingle

4038

ret

4039

4040

endif

4041

4042

;---------------------------------------------------------------------------------------------------------

4043

; expSingle

4044

;---------------------------------------------------------------------------------------------------------

4045

4046

if defined MATH_EXP

4047

4048

expSingle:

4049

;;Computes e^x

4050

;;HL points to x

4051

;;BC points to the output

4052

call pushpop

4053

ld de,const_lg_e

4054

push bc

4055

pow_inject:

4056

;;DE points to lg(y), HL points to x, BC points to output

4057

ld bc,var_x

4058

call mulSingle

4059

ld h,b

4060

ld l,c

4061

jp exp_inject

4062

4063

endif

4064

4065

;---------------------------------------------------------------------------------------------------------

4066

; sinSingle

4067

; https://en.wikipedia.org/wiki/List_of_trigonometric_identities

4068

; https://en.wikipedia.org/wiki/Taylor_series#Trigonometric_functions

4069

; https://cs.stackexchange.com/questions/89245/how-approximate-sine-using-taylor-series

4070

; https://stackoverflow.com/questions/42217069/approximating-sinex-with-a-taylor-series-in-c-and-having-a-lot-of-problems

4071

;---------------------------------------------------------------------------------------------------------

4072

4073

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

4074

4075

sinSingle:

4076

; taylor: x - x^3/6 + x^5/120 - x^7/5040

4077

; x(1 - x^2(1/6 - x^2(1/120 - x^2/5040)) )

4078

; reduction:

4079

; var_b = round( x / (2*PI), 0 )

4080

; var_c = x - var_b*2*PI

4081

; temp1 = if( var_c >= 0, var_c, var_c + 2*PI )

4082

; temp2 = if( temp1 > PI, temp1 - PI, temp1 )

4083

; var_a = if( temp2 > PI/2, PI - temp2, temp2 ) * if( temp1 > PI, -1, 1 )

4084

4085

call pushpop

4086

ld de, const_0

4087

call cmpSingle

4088

jr nz, sinSingle.1

4089

4090

call copySingle ; return 0

4091

ret

4092

4093

sinSingle.1:

4094

call trigRangeReductionSinCos

4095

push bc

4096

ld hl, var_a

4097

ld de, var_a

4098

ld bc, var_b

4099

call mulSingle ; var_b = var_a * var_a

4100

ld hl, var_b

4101

ld de, sin_a3

4102

ld bc, temp

4103

call mulSingle ; temp = x^2/5040

4104

ld hl, sin_a2

4105

ld de, temp

4106

ld bc, temp1

4107

call subSingle ; temp1 = 1/120 - temp

4108

ld hl, var_b

4109

ld de, temp1

4110

ld bc, temp

4111

call mulSingle ; temp = x^2 * temp1

4112

ld hl, sin_a1

4113

ld de, temp

4114

ld bc, temp1

4115

call subSingle ; temp1 = 1/6 - temp

4116

ld hl, var_b

4117

ld de, temp1

4118

ld bc, temp

4119

call mulSingle ; temp = x^2 * temp1

4120

ld hl, const_1

4121

ld de, temp

4122

ld bc, temp1

4123

call subSingle ; temp1 = 1 - temp

4124

ld hl, var_a

4125

ld de, temp1

4126

pop bc

4127

call mulSingle ; return x * temp1

4128

ret

4129

4130

trigRangeReductionSinCos:

4131

call pushpop

4132

push hl

4133

; var_b = round( x / (2*PI), 0 )

4134

ld de, const_2pi

4135

ld bc, var_c

4136

call divSingle

4137

ld hl, var_c

4138

ld de, 0

4139

ld bc, var_b

4140

call roundSingle

4141

; var_c = x - var_b*2*PI

4142

ld hl, var_b

4143

ld de, const_2pi

4144

ld bc, temp

4145

call mulSingle ; temp = var_b*2*PI

4146

pop hl

4147

ld de, temp

4148

ld bc, var_c

4149

call subSingle ; var_c = x - temp

4150

; temp1 = if( var_c >= 0, var_c, var_c + 2*PI )

4151

ld hl, var_c

4152

ld de, const_0

4153

call cmpSingle

4154

jr nc, trigRangeReductionSinCos.else.2

4155

ld hl, var_c

4156

ld bc, temp1

4157

call copySingle ; temp1 = var_c

4158

jr trigRangeReductionSinCos.endif.2

4159

trigRangeReductionSinCos.else.2:

4160

ld hl, var_c

4161

ld de, const_2pi

4162

ld bc, temp1

4163

call addSingle ; temp1 = var_c + 2*PI

4164

trigRangeReductionSinCos.endif.2:

4165

; temp2 = if( temp1 > PI, temp1 - PI, temp1 )

4166

ld hl, const_pi

4167

ld de, temp1

4168

call cmpSingle

4169

jr c, trigRangeReductionSinCos.else.3

4170

jr z, trigRangeReductionSinCos.else.3

4171

ld hl, temp1

4172

ld de, const_pi

4173

ld bc, temp2

4174

call subSingle ; temp2

4175

jr trigRangeReductionSinCos.endif.3

4176

trigRangeReductionSinCos.else.3:

4177

ld hl, temp1

4178

ld bc, temp2

4179

call copySingle ; temp2 = temp1

4180

trigRangeReductionSinCos.endif.3:

4181

; var_a = if( temp2 > PI/2, PI - temp2, temp2 ) * if( temp1 > PI, -1, 1 )

4182

ld hl, const_half_pi

4183

ld de, temp2

4184

call cmpSingle

4185

jr c, trigRangeReductionSinCos.else.4

4186

jr z, trigRangeReductionSinCos.else.4

4187

ld hl, const_pi

4188

ld de, temp2

4189

ld bc, var_a

4190

call subSingle ; var_a

4191

jr trigRangeReductionSinCos.endif.4

4192

trigRangeReductionSinCos.else.4:

4193

ld hl, temp2

4194

ld bc, var_a

4195

call copySingle ; var_a = temp2

4196

trigRangeReductionSinCos.endif.4:

4197

; if( temp > PI, -1, 1 )

4198

ld hl, temp1

4199

ld de, const_pi

4200

call cmpSingle

4201

jr nc, trigRangeReductionSinCos.endif.5

4202

ld ix, var_a

4203

ld a, (ix+2)

4204

set 7, a

4205

ld (ix+2), a ; turn var_a to negative

4206

trigRangeReductionSinCos.endif.5:

4207

; return var_a

4208

ret

4209

4210

endif

4211

4212

;---------------------------------------------------------------------------------------------------------

4213

; cosSingle

4214

;---------------------------------------------------------------------------------------------------------

4215

4216

if defined MATH_COS or defined MATH_TAN

4217

4218

cosSingle:

4219

; taylor: 1 - x^2/2 + x^4/24 - x^6/720

4220

; 1 - x^2(1/2 - x^2(1/24 - x^2/720) )

4221

; reduction: same as sin

4222

; cos = cos * sign

4223

4224

call pushpop

4225

ld de, const_0

4226

call cmpSingle

4227

jr nz, cosSingle.1

4228

4229

ld hl, const_1

4230

call copySingle ; return 1

4231

ret

4232

4233

cosSingle.1:

4234

; 1 - x^2(1/2 - x^2(1/24 - x^2/720) )

4235

call trigRangeReductionSinCos

4236

push bc

4237

ld hl, var_a

4238

ld de, var_a

4239

ld bc, var_b

4240

call mulSingle ; var_b = var_a * var_a

4241

ld hl, var_b

4242

ld de, cos_a3

4243

ld bc, temp

4244

call mulSingle ; temp = x^2/720

4245

ld hl, cos_a2

4246

ld de, temp

4247

ld bc, temp1

4248

call subSingle ; temp1 = 1/24 - temp

4249

ld hl, var_b

4250

ld de, temp1

4251

ld bc, temp

4252

call mulSingle ; temp = x^2 * temp1

4253

ld hl, cos_a1

4254

ld de, temp

4255

ld bc, temp1

4256

call subSingle ; temp1 = 1/2 - temp

4257

ld hl, var_b

4258

ld de, temp1

4259

ld bc, temp

4260

call mulSingle ; temp = x^2 * temp1

4261

ld hl, const_1

4262

ld de, temp

4263

ld bc, temp1

4264

call subSingle ; temp1 = 1 - temp

4265

4266

; temp3 = abs(var_c)

4267

; temp1 = temp1 * if( temp3 >= PI/2, -1, 1 ) ==> cos sign

4268

ld hl, var_c

4269

ld bc, temp3

4270

call copySingle

4271

ld ix, temp3

4272

ld a, (ix+2)

4273

res 7, a

4274

ld (ix+2), a ; temp3 = abs(var_c)

4275

ld hl, temp3

4276

ld de, const_half_pi

4277

call cmpSingle ; if temp3 >= PI/2 then temp1 = -temp1

4278

jr nc, cosSingle.endif.1

4279

ld ix, temp1

4280

ld a, (ix+2)

4281

set 7, a

4282

ld (ix+2), a ; temp1 = -temp1

4283

cosSingle.endif.1:

4284

pop bc

4285

ld hl, temp1

4286

call copySingle ; return temp1

4287

ret

4288

4289

endif

4290

4291

;---------------------------------------------------------------------------------------------------------

4292

; tanSingle

4293

;---------------------------------------------------------------------------------------------------------

4294

4295

if defined MATH_TAN

4296

4297

tanSingle:

4298

call pushpop

4299

push bc

4300

;HL points to input

4301

ld bc,var_z

4302

ld d,b

4303

ld e,c

4304

call cosSingle

4305

ld bc,var_x

4306

call sinSingle

4307

ld h,b

4308

ld l,c

4309

pop bc

4310

jp divSingle

4311

4312

endif

4313

4314

;---------------------------------------------------------------------------------------------------------

4315

; atanSingle

4316

;---------------------------------------------------------------------------------------------------------

4317

4318

if defined MATH_ATN

4319

4320

atanSingle:

4321

;taylor: x/(1 + x^2/(3 + (2*x)^2/(5 + (3*x)^2/(7+(4*x)^2/9) ) ) )

4322

; x < -1: atan - PI/2

4323

; x >= 1: PI/2 - atan

4324

;reduction: abs(X) > 1 : Y = 1 / X

4325

; abs(X) <= 1: Y = X

4326

; X < 0: Y = -Y

4327

4328

call pushpop

4329

ld de, const_0

4330

call cmpSingle

4331

jr nz, atanSingle.1

4332

4333

ld hl, const_0

4334

call copySingle ; return 0

4335

ret

4336

4337

atanSingle.1:

4338

;x/(1 + x^2/(3 + (2*x)^2/(5 + (3*x)^2/(7+(4*x)^2/9) ) ) )

4339

call trigRangeReductionAtan

4340

push bc

4341

push hl

4342

ld hl, var_a

4343

ld de, var_a

4344

ld bc, var_b

4345

call mulSingle ; var_b = var_a * var_a

4346

ld hl, var_b

4347

ld de, const_16

4348

ld bc, temp

4349

call mulSingle ; temp = (4*x)^2

4350

ld hl, temp

4351

ld de, const_9

4352

ld bc, temp1

4353

call divSingle ; temp1 = temp/9

4354

ld hl, temp1

4355

ld de, const_7

4356

ld bc, temp

4357

call addSingle ; temp = 7 + temp1

4358

ld hl, var_b

4359

ld de, const_9

4360

ld bc, temp1

4361

call mulSingle ; temp1 = var_b * 9

4362

ld hl, temp1

4363

ld de, temp

4364

ld bc, temp2

4365

call divSingle ; temp2 = temp1 / temp

4366

ld hl, temp2

4367

ld de, const_5

4368

ld bc, temp

4369

call addSingle ; temp = 5 + temp2

4370

ld hl, var_b

4371

ld de, const_4

4372

ld bc, temp1

4373

call mulSingle ; temp1 = var_b * 4

4374

ld hl, temp1

4375

ld de, temp

4376

ld bc, temp2

4377

call divSingle ; temp2 = temp1 / temp

4378

ld hl, temp2

4379

ld de, const_3

4380

ld bc, temp

4381

call addSingle ; temp = 3 + temp2

4382

ld hl, var_b

4383

ld de, temp

4384

ld bc, temp2

4385

call divSingle ; temp2 = var_b / temp

4386

ld hl, temp2

4387

ld de, const_1

4388

ld bc, temp

4389

call addSingle ; temp = 1 + temp2

4390

ld hl, var_a

4391

ld de, temp

4392

ld bc, temp2

4393

call divSingle ; temp2 = var_a / temp

4394

pop hl

4395

; x >= 1: PI/2 - atan

4396

ld de, const_1

4397

call cmpSingle

4398

jr nc, atanSingle.2

4399

ld hl, const_half_pi

4400

ld de, temp2

4401

ld bc, temp

4402

call subSingle

4403

ld hl, temp

4404

jr atanSingle.4

4405

atanSingle.2:

4406

; x < -1: atan - PI/2

4407

push hl

4408

ld hl, const_0

4409

ld de, const_1

4410

ld bc, temp

4411

call subSingle

4412

pop hl

4413

ld de, temp

4414

call cmpSingle

4415

jr c, atanSingle.3

4416

ld hl, temp2

4417

ld de, const_half_pi

4418

ld bc, temp

4419

call subSingle

4420

ld hl, temp

4421

jr atanSingle.4

4422

atanSingle.3:

4423

ld hl, temp2

4424

atanSingle.4:

4425

pop bc

4426

call copySingle ; return temp2

4427

ret

4428

4429

trigRangeReductionAtan:

4430

;reduction: abs(X) > 1 : Y = 1 / X

4431

; abs(X) <= 1: Y = X

4432

; X < 0: Y = -Y

4433

call pushpop

4434

push hl

4435

ld bc, temp

4436

call copySingle

4437

ld ix, temp

4438

ld a, (ix+2)

4439

res 7, a

4440

ld (ix+2), a ; abs(x)

4441

ld hl, temp

4442

ld de, const_1

4443

call cmpSingle

4444

jr nc, trigRangeReductionAtan.1

4445

ld hl, const_1

4446

pop de

4447

push de

4448

ld bc, var_a

4449

call divSingle

4450

jr trigRangeReductionAtan.2

4451

trigRangeReductionAtan.1:

4452

pop hl

4453

push hl

4454

ld bc, var_a

4455

call copySingle

4456

trigRangeReductionAtan.2:

4457

pop hl

4458

ld de, const_0

4459

call cmpSingle

4460

jr c, trigRangeReductionAtan.3

4461

ld ix, var_a

4462

ld a, (ix+2)

4463

set 7, a

4464

ld (ix+2), a ; y = -y

4465

trigRangeReductionAtan.3:

4466

ret

4467

4468

endif

4469

4470

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

4471

4472

;---------------------------------------------------------------------------------------------------------

4473

; copySingle

4474

;---------------------------------------------------------------------------------------------------------

4475

4476

copySingle:

4477

call pushpop

4478

;push bc

4479

;pop de

4480

ld d, b

4481

ld e, c

4482

ldi

4483

ldi

4484

ldi

4485

ldi

4486

ret

4487

4488

;---------------------------------------------------------------------------------------------------------

4489

; roundSingle

4490

;---------------------------------------------------------------------------------------------------------

4491

4492

roundSingle:

4493

call pushpop

4494

call copySingle

4495

;push bc

4496

;pop hl

4497

ld h, b

4498

ld l, c

4499

push de

4500

ld a, e

4501

ld de, const_10

4502

roundSingle.1:

4503

or 0

4504

jr z, roundSingle.2

4505

ld bc, temp

4506

call mulSingle

4507

;push hl

4508

;pop bc

4509

ld b, h

4510

ld c, l

4511

ld hl, temp

4512

call copySingle

4513

;push bc

4514

;pop hl

4515

ld h, b

4516

ld l, c

4517

dec a

4518

jr roundSingle.1

4519

roundSingle.2:

4520

ld de, const_half_1

4521

ld bc, temp

4522

call addSingle

4523

push hl

4524

ld hl, temp

4525

ld bc, temp1

4526

call single2Int

4527

ld hl, temp1

4528

pop bc

4529

call int2Single

4530

;push bc

4531

;pop hl

4532

ld h, b

4533

ld l, c

4534

pop de

4535

ld a, e

4536

ld de, const_10

4537

roundSingle.3:

4538

or 0

4539

jr z, roundSingle.4

4540

ld bc, temp

4541

call divSingle

4542

;push hl

4543

;pop bc

4544

ld b, h

4545

ld c, l

4546

ld hl, temp

4547

call copySingle

4548

;push bc

4549

;pop hl

4550

ld h, b

4551

ld l, c

4552

dec a

4553

jr roundSingle.3

4554

roundSingle.4:

4555

ret

4556

4557

endif

4558

4559

if defined MATH_ABSFN

4560

4561

;---------------------------------------------------------------------------------------------------------

4562

; absSingle

4563

;---------------------------------------------------------------------------------------------------------

4564

4565

absSingle:

4566

;;HL points to the float

4567

;;BC points to where to output the result

4568

call pushpop

4569

ld d,b

4570

ld e,c

4571

ldi

4572

ldi

4573

ld a,(hl)

4574

and %01111111

4575

ld (de),a

4576

inc hl

4577

inc de

4578

ld a,(hl)

4579

ld (de),a

4580

ret

4581

4582

endif

4583

4584

if defined MATH_SGN

4585

4586

;---------------------------------------------------------------------------------------------------------

4587

; sgnSingle

4588

;---------------------------------------------------------------------------------------------------------

4589

4590

sgnSingle:

4591

;;HL points to the float

4592

;;BC points to where to output the result

4593

jp negSingle

4594

4595

endif

4596

4597

if defined powSingle or defined sgnSingle or defined MATH_NEG

4598

4599

;---------------------------------------------------------------------------------------------------------

4600

; negSingle

4601

;---------------------------------------------------------------------------------------------------------

4602

4603

negSingle:

4604

;;HL points to the float

4605

;;BC points to where to output the result

4606

call pushpop

4607

push hl

4608

pop ix

4609

ld a, (ix+3)

4610

or 0

4611

jr nz, negSingle.test.sign

4612

ld a, (ix+2)

4613

or 0

4614

jr nz, negSingle.test.sign

4615

ld a, (ix+1)

4616

or 0

4617

jr nz, negSingle.test.sign

4618

ld a, (ix)

4619

or 0

4620

jr nz, negSingle.test.sign

4621

;push bc

4622

;pop de

4623

ld d, b

4624

ld e, c

4625

ld hl, const_0

4626

ldi

4627

ldi

4628

ldi

4629

ldi

4630

ret

4631

negSingle.test.sign:

4632

ld a, (ix+2)

4633

bit 7, a

4634

jr z, negSingle.positive

4635

negSingle.negative:

4636

push bc

4637

pop ix

4638

call negSingle.positive

4639

ld a, (ix+2)

4640

set 7, a

4641

ld (ix+2), a

4642

ret

4643

negSingle.positive:

4644

;push bc

4645

;pop de

4646

ld d, b

4647

ld e, c

4648

ld hl, const_1

4649

ldi

4650

ldi

4651

ldi

4652

ldi

4653

ret

4654

4655

endif

4656

4657

if defined MATH_DCOMP or defined MATH.POW or defined MATH_EXP or defined MATH_LOG or defined MATH_LN or defined MATH_SIN or defined MATH_TAN or defined MATH_COS or defined MATH_ATN

4658

4659

;---------------------------------------------------------------------------------------------------------

4660

; cmpSingle

4661

;---------------------------------------------------------------------------------------------------------

4662

4663

cmpSingle:

4664

;Input: HL points to float1, DE points to float2

4665

;Output:

4666

; float1 >= float2 : nc

4667

; float1 < float2 : c,nz

4668

; float1 == float2 : z

4669

; There is a margin of error allowed in the lower 2 bits of the mantissa.

4670

;

4671

;Currently fails when both numbers have magnitude less than about 2^-106

4672

push hl

4673

push de

4674

push bc

4675

ld c, a

4676

push bc

4677

ex de, hl

4678

call _30

4679

pop bc

4680

ld a, c

4681

pop bc

4682

pop de

4683

pop hl

4684

ret

4685

_30:

4686

inc de

4687

inc de

4688

inc de

4689

ld a,(de)

4690

inc hl

4691

inc hl

4692

inc hl

4693

cp (hl)

4694

jr nc,_31

4695

ld a,(hl)

4696

_31:

4697

dec hl

4698

dec hl

4699

dec hl

4700

dec de

4701

dec de

4702

dec de

4703

push af

4704

ld bc,scrap

4705

call subSingle

4706

ld a,(scrap+3) ;new power

4707

pop bc ;B is old power

4708

or a

4709

jr z,cmp_close

4710

sub b

4711

jr nc,cmp_is_sign

4712

dec a

4713

add a,22

4714

jr nc,cmp_close

4715

cmp_is_sign:

4716

ld a,(scrap+2)

4717

or 1 ;not equal, so reset z flag

4718

rla ;if negative, float1<float2, setting c flag as wanted, else nc.

4719

ret

4720

cmp_close:

4721

xor a

4722

ret

4723

4724

endif

4725

4726

if defined MATH_RND

4727

4728

;---------------------------------------------------------------------------------------------------------

4729

; randSingle

4730

;---------------------------------------------------------------------------------------------------------

4731

4732

randSingle:

4733

;Stores a pseudo-random number on [0,1)

4734

;it won't produce values on (0,2^-23)

4735

call pushpop

4736

push bc

4737

call rand

4738

push hl

4739

call rand

4740

pop de

4741

ex de,hl

4742

ld bc,$207F

4743

;DEHL is the mantissa, B is the exponent

4744

ld a,d

4745

or a

4746

jp m,rand_normed

4747

_32:

4748

dec c

4749

add hl,hl

4750

rl e

4751

rl d

4752

jp m,rand_normed

4753

djnz _32

4754

rand_zero:

4755

ld c,l

4756

ld b,l

4757

jr rand_done

4758

rand_normed:

4759

;If we needed to shift more than 8 bits, we'll load in more random data

4760

ld a,b

4761

cp 8

4762

jr c,rand_zero

4763

sub 24

4764

jp nc,rand_no_more_rand_data

4765

push bc

4766

push de

4767

call rand

4768

pop de

4769

ld e,h

4770

ld h,l

4771

pop bc

4772

rand_no_more_rand_data:

4773

ld b,e

4774

ld e,d

4775

ld d,c

4776

ld c,h

4777

res 7,e

4778

rand_done:

4779

pop hl

4780

;DEBC

4781

ld (hl),b

4782

inc hl

4783

ld (hl),c

4784

inc hl

4785

ld (hl),e

4786

inc hl

4787

ld (hl),d

4788

ret

4789

4790

rand:

4791

;;Tested and passes all CAcert tests

4792

;;Uses a very simple 32-bit LCG and 32-bit LFSR

4793

;;it has a period of 18,446,744,069,414,584,320

4794

;;roughly 18.4 quintillion.

4795

;;LFSR taps: 0,2,6,7 = 11000101

4796

;;323cc

4797

;;Thanks to Runer112 for his help on optimizing the LCG and suggesting to try the much simpler LCG. On their own, the two are terrible, but together they are great.

4798

;Uses 64 bits of state

4799

ld hl,(seed0)

4800

ld de,(seed0+2)

4801

ld b,h

4802

ld c,l

4803

add hl,hl

4804

rl e

4805

rl d

4806

add hl,hl

4807

rl e

4808

rl d

4809

inc l

4810

add hl,bc

4811

ld (seed0),hl

4812

ld hl,(seed0+2)

4813

adc hl,de

4814

ld (seed0+2),hl

4815

ex de,hl

4816

;;lfsr

4817

ld hl,(seed1)

4818

ld bc,(seed1+2)

4819

add hl,hl

4820

rl c

4821

rl b

4822

ld (seed1+2),bc

4823

sbc a,a

4824

and %11000101

4825

xor l

4826

ld l,a

4827

ld (seed1),hl

4828

ex de,hl

4829

add hl,bc

4830

ret

4831

4832

endif

4833

4834

if defined MATH_FOUT

4835

4836

;---------------------------------------------------------------------------------------------------------

4837

; single2Str

4838

; in HL = Single address

4839

; BC = String address

4840

; out A = String size

4841

; http://0x80.pl/notesen/2015-12-29-float-to-string.html

4842

; http://0x80.pl/articles/convert-float-to-integer.html

4843

;---------------------------------------------------------------------------------------------------------

4844

4845

single2str:

4846

call pushpop

4847

push bc

4848

call _33

4849

pop de

4850

xor a

4851

cp (hl)

4852

ldi

4853

jr nz,$-3

4854

4855

ret

4856

_33:

4857

; Move the float to scrap

4858

ld de,scrap

4859

call mov4

4860

4861

; Make the float negative, write a '-' if already negative

4862

ld de,strout_single

4863

ld hl,scrap+2

4864

ld a,(hl)

4865

;rlca

4866

;scf

4867

;rra

4868

bit 7, a

4869

jr z, _34

4870

ld a,'-' ; write '-' simbol

4871

ld (de),a

4872

inc de

4873

ld a,(hl)

4874

_34:

4875

set 7, a

4876

ld (hl),a

4877

4878

; Check if the exponent field is 0 (a special value)

4879

inc hl

4880

ld a,(hl)

4881

or a

4882

jp z,strcase_single

4883

4884

4885

; We should write '0' next. When rounding 9.999999... for example, not padding with a 0 will return '.' instead of '1.'

4886

ex de,hl

4887

ld (hl),'0'

4888

inc hl

4889

4890

; Save the pointer

4891

push hl

4892

4893

; Now we need to perform signed (A-128)*77 (approximation of exponent*log10(2))

4894

ld de,77

4895

ld h,a

4896

ld l,d

4897

call mul8_preset

4898

ld de,-77*128

4899

add hl,de

4900

ld a,h

4901

ld (pow10exp_single),a ;The base-10 exponent

4902

ld de,pown10LUT

4903

jr c,_35

4904

neg

4905

ld de,pow10LUT ;get the table of 10^-(2^k)

4906

_35:

4907

ld hl, pow10exp_single

4908

ld bc,scrap

4909

call singletostr_mul

4910

call singletostr_mul

4911

call singletostr_mul

4912

call singletostr_mul

4913

call singletostr_mul

4914

call singletostr_mul

4915

;now the number is pretty close to a nice value

4916

4917

; If it is less than 1, multiply by 10

4918

ld a,(scrap+3)

4919

sub 128

4920

jr nc,_36

4921

ld de,const_10

4922

;ld hl,scrap ;Since singletostr_mul returns BC = scrap, can do this cheaper

4923

;ld b,h

4924

;ld c,l

4925

ld h,b

4926

ld l,c

4927

call mulSingle

4928

ld hl,pow10exp_single

4929

dec (hl)

4930

ld a,(scrap+3)

4931

sub 128

4932

_36:

4933

4934

; Convert to a fixed-point number !

4935

inc a

4936

ld b,a

4937

xor a

4938

_37:

4939

ld hl,scrap

4940

sla (hl)

4941

inc hl

4942

rl (hl)

4943

inc hl

4944

rl (hl)

4945

rla

4946

djnz _37

4947

4948

;We need to get 7 digits

4949

ld b,6

4950

pop hl ;Points to the string

4951

4952

;The first digit can be as large as 20, so it'll actually be two digits

4953

cp 10

4954

jr c,_38

4955

dec b

4956

;Increment the exponent :)

4957

ld de,(pow10exp_single-1)

4958

inc d

4959

ld (pow10exp_single-1),de

4960

;

4961

ld (hl),'0'-1

4962

inc (hl)

4963

sub 10

4964

jr nc,$-3

4965

add a,10

4966

inc hl

4967

_38:

4968

; Get the remaining digits.

4969

_39:

4970

add a,'0'

4971

ld (hl),a

4972

inc hl

4973

push hl

4974

push bc

4975

call singletostrmul10

4976

pop bc

4977

pop hl

4978

djnz _39

4979

4980

;Save the pointer to the end of the string

4981

ld d,h

4982

ld e,l

4983

;ld (hl), 0

4984

4985

;Now let's round!

4986

cp 5

4987

jr c,rounding_done_single

4988

jr _40a ;.db $DA ;start of `jp c,*` in order to skip the next instruction

4989

_40:

4990

ld (hl),'0'

4991

_40a:

4992

dec hl

4993

inc (hl)

4994

ld a,(hl)

4995

cp $3A

4996

jr z,_40

4997

rounding_done_single:

4998

4999

5000

;Strip the leading zero if it exists (rounding may have bumped this to `1`)

5001

ld hl,strout_single

5002

ld a,(hl)

5003

cp '-'

5004

jr nz,_41

5005

inc hl

5006

ld a,(hl)

5007

_41:

5008

cp '0'

5009

jr nz,_42

5010

dec de

5011

ex de,hl

5012

;Now lets move HL-DE bytes at DE+1 to DE

5013

sbc hl,de

5014

ld b,h

5015

ld c,l

5016

ld h,d

5017

ld l,e

5018

inc hl

5019

ldir

5020

cp a

5021

_42:

5022

5023

push de

5024

;If z flag is reset, this means that the exponent should be bumped up 1

5025

ld a,(pow10exp_single)

5026

jr z,_43

5027

inc a

5028

ld (pow10exp_single),a

5029

_43:

5030

5031

;if -4<=A<=6, then need to insert the decimal place somewhere.

5032

add a,4

5033

cp 10

5034

jp c,movdec_single

5035

_44:

5036

;for this, we need to insert the decimal after the first digit

5037

;Then, we need to append the exponent string

5038

ld hl,strout_single

5039

ld de,strout_single-1

5040

ld a,(hl)

5041

cp '-' ;negative sign

5042

jr nz,_45

5043

ldi

5044

_45:

5045

ldi

5046

ld a,'.'

5047

ld (de),a

5048

5049

;remove any stray zeroes at the end before appending the exponent

5050

pop hl

5051

call strip_zeroes

5052

5053

; Write the exponent

5054

ld (hl),'e'

5055

inc hl

5056

ld a,(pow10exp_single)

5057

or a

5058

jp p,_46

5059

ld (hl),'-' ;negative sign

5060

inc hl

5061

neg

5062

_46:

5063

cp 10

5064

jr c,_47

5065

ld (hl),'0'-1

5066

inc (hl)

5067

sub 10

5068

jr nc,$-3

5069

add a,10

5070

inc hl

5071

_47:

5072

add a,'0'

5073

ld (hl),a

5074

inc hl

5075

ld (hl),0

5076

5077

ld de, strout_single

5078

xor a

5079

sbc hl, de

5080

ld a, l ; string size

5081

5082

ld hl,strout_single-1

5083

ret

5084

5085

movdec_single:

5086

ld a,(pow10exp_single)

5087

or a

5088

jp p,posdec_single

5089

ld l,a

5090

;need to put zeroes before everything

5091

ld de,strout_single

5092

ld a,(de)

5093

cp '-' ;negative sign

5094

push af

5095

ld a,'0'

5096

jr z,$+3

5097

_48:

5098

dec de

5099

ld (de),a

5100

inc l

5101

jr nz,_48

5102

_49:

5103

ex de,hl

5104

ld (hl),'.'

5105

pop af

5106

jr nz,_50

5107

dec hl

5108

ld (hl),a

5109

_50:

5110

ex de,hl

5111

pop hl

5112

call strip_zeroes

5113

ld (hl),0

5114

ex de,hl

5115

ret

5116

5117

posdec_single:

5118

ld hl,strout_single

5119

ld de,strout_single-1

5120

ld c,a

5121

ld a,(hl)

5122

ld b,0

5123

cp '-' ;negative sign

5124

jr nz,_51

5125

inc c

5126

_51:

5127

inc c

5128

ldir

5129

ld a,'.'

5130

ld (de),a

5131

pop hl

5132

call strip_zeroes

5133

ld (hl),0

5134

ld hl,strout_single-1

5135

ret

5136

5137

strcase_single:

5138

ld hl,str_Zero

5139

ld a,(scrap+2)

5140

add a,a

5141

and $C0

5142

jr z,_52

5143

ld hl,str_Inf

5144

jp pe,_52

5145

ld hl,str_NaN

5146

_52:

5147

call mov4

5148

ld hl,strout_single

5149

ret

5150

5151

singletostrmul10:

5152

;multiply the 0.24 fixed point number at scrap by 10

5153

;overflow in A register

5154

ld a,(scrap+2)

5155

ld e,a

5156

ld hl,(scrap)

5157

xor a

5158

ld d,e

5159

ld b,h

5160

ld c,l

5161

add hl,hl

5162

rl d

5163

rla

5164

add hl,hl

5165

rl d

5166

rla

5167

add hl,bc

5168

ld b,a

5169

ld a,d

5170

adc a,e

5171

ld d,a

5172

ld a,b

5173

adc a,0

5174

add hl,hl

5175

rl d

5176

rla

5177

ld (scrap+1),de

5178

ld (scrap),hl

5179

ret

5180

5181

strip_zeroes:

5182

ld a,'0'

5183

_53:

5184

dec hl

5185

cp (hl)

5186

jr z,_53

5187

5188

;Check that the last digit isn't a decimal!

5189

ld a,'.'

5190

cp (hl)

5191

ret z

5192

inc hl

5193

ret

5194

5195

singletostr_mul:

5196

rra

5197

call c,_54

5198

ld hl,4

5199

add hl,de

5200

ex de,hl

5201

ret

5202

_54:

5203

ld h,b

5204

ld l,c

5205

jp mulSingle

5206

mul8:

5207

;H*E => HL

5208

ld l,0

5209

ld d,l

5210

mul8_preset:

5211

sla h

5212

jr nc,$+3

5213

ld l,e

5214

add hl,hl

5215

jr nc,$+3

5216

add hl,de

5217

add hl,hl

5218

jr nc,$+3

5219

add hl,de

5220

add hl,hl

5221

jr nc,$+3

5222

add hl,de

5223

add hl,hl

5224

jr nc,$+3

5225

add hl,de

5226

add hl,hl

5227

jr nc,$+3

5228

add hl,de

5229

add hl,hl

5230

jr nc,$+3

5231

add hl,de

5232

add hl,hl

5233

ret nc

5234

add hl,de

5235

ret

5236

5237

endif

5238

5239

5240

if defined MATH_FIN

5241

5242

;---------------------------------------------------------------------------------------------------------

5243

; str2Single

5244

; https://www.ticalc.org/pub/86/asm/source/routines/atof.asm

5245

;---------------------------------------------------------------------------------------------------------

5246

5247

char_NEG: equ '-'

5248

char_ENG: equ ','

5249

char_DEC: equ '.'

5250

ptr_sto: equ scrap+9

5251

5252

;;#Routines/Single Precision

5253

;;Inputs:

5254

;; HL points to the string

5255

;; BC points to where the float is output

5256

;;Output:

5257

;; scrap+9 is the pointer to the end of the string

5258

;;Destroys:

5259

;; 11 bytes at scrap ?

5260

5261

str2single:

5262

call pushpop

5263

push bc

5264

;Check if there is a negative sign.

5265

; Save for later

5266

; Advance ptr

5267

ld a,(hl)

5268

sub char_NEG

5269

sub 1

5270

push af

5271

jr nc,$+3

5272

inc hl

5273

;Skip all leading zeroes

5274

ld a,(hl)

5275

cp '0'

5276

jr z,$-4 ;jumps back to the `inc hl`

5277

;Set exponent to 0

5278

ld b,0

5279

;Check if the next char is char_DEC

5280

sub char_DEC

5281

or a ;to reset the carry flag

5282

jr nz,_55

5283

jr _54a ;.db $FE ;start of cp *

5284

;Get rid of zeroes

5285

dec b

5286

_54a:

5287

inc hl

5288

ld a,(hl)

5289

cp '0'

5290

jr z,$-5 ;jumps back to the `dec b`

5291

scf

5292

_55:

5293

;Now we read in the next 8 digits

5294

ld de,scrap+3

5295

call ascii_to_uint8

5296

call ascii_to_uint8

5297

call ascii_to_uint8

5298

call ascii_to_uint8

5299

;Now `scrap` holds the 4-digit base-100 number.

5300

;b is the exponent

5301

;if carry flag is set, just need to get rid of remaining digits

5302

;Otherwise, need to get rid of remaining digits, while incrementing the exponent

5303

sbc a,a

5304

inc a

5305

ld c,a

5306

_56:

5307

ld a,(hl)

5308

cp 30h

5309

jr nz,_57

5310

inc hl

5311

ld a,b

5312

add a,c

5313

jp z,strToSingle_inf

5314

ld b,a

5315

jr _56

5316

;Now check for engineering `E` to modify the exponent

5317

_57:

5318

cp char_NEG

5319

call z,str_eng_exp

5320

;Gotta multiply the number at (scrap) by 2^24

5321

ld (ptr_sto),hl

5322

ld d,100

5323

call scrap_times_256

5324

ld a,c

5325

ld (scrap+6),a

5326

call scrap_times_256

5327

ld a,c

5328

ld (scrap+5),a

5329

call scrap_times_256

5330

ld a,c

5331

ld (scrap+4),a

5332

call scrap_times_256

5333

ld a,c

5334

ld (scrap+3),a

5335

;Now scrap+3 is a 4-byte mantissa that needs to be normalized

5336

;

5337

ld hl,(scrap+3)

5338

ld a,h

5339

or l

5340

ld hl,(scrap+5)

5341

or l

5342

or h

5343

jp z,strToSingle_zero-1

5344

ld c,$7F

5345

ld a,h

5346

or a

5347

jp m,strToSingle_normed

5348

;Will need to iterate at most three times

5349

_58:

5350

dec c

5351

ld hl,scrap+3

5352

sla (hl)

5353

inc hl

5354

rl (hl)

5355

inc hl

5356

rl (hl)

5357

inc hl

5358

adc a,a

5359

jp p,_58

5360

strToSingle_normed:

5361

;Move the number to scrap

5362

ld hl,(scrap+4)

5363

ld (scrap),hl

5364

ld l,a

5365

ld h,c

5366

sla l

5367

pop af

5368

rr l

5369

ld (scrap+2),hl

5370

;now (scrap) is our number, need to multiply by power of 10!

5371

;Power of 10 is stored in B, need to put in A first

5372

xor a

5373

sub b

5374

ld de,pown10LUT

5375

jp p,_59

5376

ld a,b

5377

ld de,pow10LUT

5378

cp 40

5379

jp nc,strToSingle_inf+1

5380

_59:

5381

cp 40

5382

jp nc,strToSingle_zero

5383

ld hl,scrap

5384

ld b,h

5385

ld c,l

5386

call _60

5387

call _60

5388

call _60

5389

call _60

5390

call _60

5391

call _60

5392

pop de

5393

jp mov4

5394

_60:

5395

rra

5396

call c,mulSingle

5397

inc de

5398

inc de

5399

inc de

5400

inc de

5401

ret

5402

str_eng_exp:

5403

ld de,0

5404

inc hl

5405

ld a,(hl)

5406

cp char_NEG ;negative exponent?

5407

push af

5408

jr nz,$+3

5409

inc hl

5410

_61:

5411

ld a,(hl)

5412

sub 3Ah

5413

add a,10

5414

jr nc,_62

5415

inc hl

5416

push hl

5417

ld h,d

5418

ld l,e

5419

add hl,hl

5420

add hl,hl

5421

add hl,de

5422

add hl,hl

5423

add a,l

5424

ld l,a

5425

ex de,hl

5426

pop hl

5427

jp c,eng_overflow

5428

inc d

5429

dec d

5430

jp z,_61

5431

jp nz,eng_overflow

5432

_62:

5433

ld a,e

5434

cp 40

5435

jr nc,eng_overflow

5436

pop af

5437

ld a,b

5438

jr nz,_63

5439

sub e

5440

ld b,a

5441

ret

5442

_63:

5443

add a,e

5444

ld b,a

5445

ret

5446

scrap_times_256:

5447

ld e,8

5448

_64:

5449

or a

5450

ld hl,scrap

5451

call _65

5452

call _65

5453

rl c

5454

dec e

5455

jr nz,_64

5456

ret

5457

_65:

5458

call scrap_times_sub

5459

scrap_times_sub:

5460

ld a,(hl)

5461

rla

5462

cp d

5463

jr c,$+3

5464

sub d

5465

ld (hl),a

5466

inc hl

5467

ccf

5468

ret

5469

eng_overflow:

5470

pop af

5471

jr nz,strToSingle_inf

5472

pop af

5473

strToSingle_zero:

5474

ld hl,const_0

5475

pop de

5476

jp mov4

5477

strToSingle_inf:

5478

;return inf

5479

pop af

5480

ld hl,const_inf

5481

jr nc,_66

5482

ld hl,const_NegInf

5483

_66:

5484

pop de

5485

jp mov4

5486

5487

endif

5488

5489

if defined roundSingle or defined MATH_FRCSGL

5490

5491

;---------------------------------------------------------------------------------------------------------

5492

; int2Single

5493

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division

5494

;---------------------------------------------------------------------------------------------------------

5495

5496

int2Single:

5497

call pushpop

5498

push bc

5499

push hl

5500

pop ix

5501

ld l, (ix) ; convert integer parameter to single float

5502

ld h, (ix+1)

5503

ld bc, 0x1000 ; bynary digits count + sign

5504

5505

int2Single.test.zero:

5506

xor a

5507

or h ; test if hl is not zero

5508

jr nz, int2Single.test.negative

5509

or l

5510

jr nz, int2Single.test.negative

5511

ld hl, 0

5512

ld de, 0

5513

jp int2Single.save

5514

5515

int2Single.test.negative:

5516

bit 7, h ; test if hl is negative

5517

jr z, int2Single.normalize

5518

ld c, 0x80 ; sign negative

5519

ld a, h ;\

5520

cpl ; |

5521

ld h, a ; | abs(hl)

5522

ld a, l ; |

5523

cpl ; |

5524

ld l, a ;/

5525

inc hl

5526

5527

int2Single.normalize:

5528

dec b

5529

bit 7, h

5530

jr nz, int2Single.mount

5531

sla l

5532

rl h

5533

jr int2Single.normalize

5534

5535

int2Single.mount:

5536

res 7, h ; turn off upper bit

5537

5538

ld a, c ; restore sign

5539

or h ; put sign...

5540

ld h, a ; ...into upper mantissa

5541

5542

ld e, h ; sign+mantissa

5543

ld h, l ; high mantissa

5544

ld l, 0 ; low mantissa

5545

5546

ld a, b ; binary digits count

5547

or 0x80 ; exponent bias

5548

ld d, a ; exponent

5549

5550

int2Single.save:

5551

pop ix

5552

ld (ix), l ; low mantissa

5553

ld (ix+1), h ; high mantissa

5554

ld (ix+2), e ; sign + mantissa

5555

ld (ix+3), d ; expoent

5556

ld (ix+4), 0

5557

ld (ix+5), 0

5558

ld (ix+6), 0

5559

ld (ix+7), 0

5560

ret

5561

5562

endif

5563

5564

if defined roundSingle or defined MATH_FRCINT

5565

5566

;---------------------------------------------------------------------------------------------------------

5567

; single2Int

5568

; http://0x80.pl/articles/convert-float-to-integer.html

5569

;---------------------------------------------------------------------------------------------------------

5570

single2Int:

5571

;Input:

5572

; HL points to the single-precision float

5573

;Output:

5574

; HL is the 16-bit signed integer part of the float

5575

; BC points to 16-bit signed integer

5576

call pushpop

5577

push bc

5578

ld e,(hl)

5579

inc hl

5580

ld d,(hl)

5581

inc hl

5582

ld a,(hl)

5583

add a,a

5584

push af

5585

scf

5586

rra

5587

ld c,a

5588

inc hl

5589

ld a,(hl)

5590

ld hl,0

5591

sub 80h

5592

jr c,no_shift_single_to_int16

5593

cp 39

5594

jr nc,no_shift_single_to_int16

5595

sub 8

5596

jr c,_67

5597

ld l,c

5598

ld c,d

5599

ld d,e

5600

ld e,h

5601

sub 8

5602

jr c,_67

5603

ld h,l

5604

ld l,c

5605

ld c,d

5606

ld d,e

5607

sub 8

5608

jr c,_67

5609

ld h,l

5610

ld l,c

5611

ld c,d

5612

sub 8

5613

jr c,_67

5614

ld h,l

5615

ld l,c

5616

jr _67a ;.db $11 ;start of ld de,*

5617

_67:

5618

add a,9

5619

_67a:

5620

ld b,a

5621

ld a,e

5622

_68:

5623

add a,a

5624

rl d

5625

rl c

5626

adc hl,hl

5627

djnz _68

5628

no_shift_single_to_int16:

5629

pop af

5630

jr nc,_69

5631

;need to negate

5632

xor a

5633

sub e

5634

ld e,0

5635

ld a,e

5636

sbc a,d

5637

ld a,e

5638

sbc a,c

5639

ld d,e

5640

ex de,hl

5641

sbc hl,de

5642

_69:

5643

pop ix

5644

ld (ix), l

5645

ld (ix+1), h

5646

ret

5647

5648

endif

5649

5650

;---------------------------------------------------------------------------------------------------------

5651

; Auxiliary routines

5652

;---------------------------------------------------------------------------------------------------------

5653

5654

str_Zero: db "0",0

5655

str_Inf: db "inf",0

5656

str_NaN: db "NaN",0

5657

5658

start_const:

5659

const_pi: db $DB,$0F,$49,$81

5660

const_e: db $54,$f8,$2d,$81

5661

const_lg_e: db $3b,$AA,$38,$80

5662

const_ln_2: db $18,$72,$31,$7f

5663

const_log2: db $9b,$20,$1a,$7e

5664

const_lg10: db $78,$9a,$54,$81

5665

const_0: db $00,$00,$00,$00

5666

const_1: db $00,$00,$00,$80

5667

const_2: dw 0, 33024

5668

const_3: dw 0, 33088

5669

const_4: dw 0, 33280

5670

const_5: dw 0, 33312

5671

const_7: dw 0, 33376

5672

const_9: dw 0, 33552

5673

const_16: dw 0, 33792

5674

const_100: db $00,$00,$48,$86

5675

const_100_inv: dw 55050, 31011

5676

const_precision: db $77,$CC,$2B,$65 ;10^-8

5677

const_half_1: dw 0, 32512

5678

const_inf: db $00,$00,$40,$00

5679

const_NegInf: db $00,$00,$C0,$00

5680

const_NaN: db $00,$00,$20,$00

5681

const_log10_e: db $D9,$5B,$5E,$7E

5682

const_2pi: db $DB,$0F,$49,$82

5683

const_2pi_inv: db $83,$F9,$22,$7D

5684

const_half_pi: dw 4059, 32841

5685

const_p25: db $00,$00,$00,$7E

5686

const_p5: db $00,$00,$00,$7F

5687

; db $,$,$,$

5688

end_const:

5689

sin_a1: dw 43691, 32042

5690

sin_a2: dw 34952, 30984

5691

sin_a3: dw 3329, 29520

5692

cos_a1: equ const_half_1

5693

cos_a2: dw 43691, 31530

5694

cos_a3: dw 2914, 30262

5695

exp_a1: db $15,$72,$31,$7F ;.693146989552

5696

exp_a2: db $CE,$FE,$75,$7D ;.2402298085906

5697

exp_a3: db $7B,$42,$63,$7B ;.0554833215071

5698

exp_a4: db $FD,$94,$1E,$79 ;.00967907584392

5699

exp_a5: db $5E,$01,$23,$76 ;.001243632065103

5700

exp_a6: db $5F,$B7,$63,$73 ;.0002171671843714

5701

const_1p40625: db $00,$00,$34,$80 ;1.40625

5702

5703

if defined MATH_CONSTSINGLE

5704

5705

iconstSingle:

5706

ex (sp),hl

5707

ld a,(hl)

5708

inc hl

5709

ex (sp),hl

5710

constSingle:

5711

;A is the constant ID#

5712

;returns nc if failed, c otherwise

5713

;HL points to the constant

5714

cp (end_const-start_const)>>2

5715

ret nc

5716

ld hl,start_const

5717

add a,a

5718

add a,a

5719

add a,l

5720

ld l,a

5721

;#if ((end_const-4)>>8)!=(start_const>>8)

5722

; ccf

5723

; ret c

5724

; inc h

5725

;#endif

5726

scf

5727

ret

5728

5729

endif

5730

5731

;;LUTs used

5732

lut:

5733

pown10LUT:

5734

db $CD,$CC,$4C,$7C ;.1

5735

db $0A,$D7,$23,$79 ;.01

5736

db $17,$B7,$51,$72 ;.0001

5737

db $77,$CC,$2B,$65 ;10^-8

5738

db $95,$95,$66,$4A ;10^-16

5739

db $1F,$B1,$4F,$15 ;10^-32

5740

pow10LUT:

5741

const_10:

5742

db $00,$00,$20,$83 ;10

5743

db $00,$00,$48,$86 ;100

5744

db $00,$40,$1C,$8D ;10000

5745

db $20,$BC,$3E,$9A ;10^8

5746

db $CA,$1B,$0E,$B5 ;10^16

5747

db $AE,$C5,$1D,$EA ;10^32

5748

5749

C_Times_BDE:

5750

;;C*BDE => CAHL

5751

;C = 0 157

5752

;C = 1 141

5753

;141+

5754

;C>=128 135+6{0,33+{0,1}}+{0,20+{0,8}}

5755

;C>=64 115+5{0,33+{0,1}}+{0,20+{0,8}}

5756

;C>=32 95+4{0,33+{0,1}}+{0,20+{0,8}}

5757

;C>=16 75+3{0,33+{0,1}}+{0,20+{0,8}}

5758

;C>=8 55+2{0,33+{0,1}}+{0,20+{0,8}}

5759

;C>=4 35+{0,33+{0,1}}+{0,20+{0,8}}

5760

;C>=2 15+{0,20+{0,8}}

5761

;min: 141cc

5762

;max: 508cc

5763

;avg: 349.21279907227cc

5764

5765

ld a,b

5766

ld h,d

5767

ld l,e

5768

sla c

5769

jr c,mul8_24_1

5770

sla c

5771

jr c,mul8_24_2

5772

sla c

5773

jr c,mul8_24_3

5774

sla c

5775

jr c,mul8_24_4

5776

sla c

5777

jr c,mul8_24_5

5778

sla c

5779

jr c,mul8_24_6

5780

sla c

5781

jr c,mul8_24_7

5782

sla c

5783

ret c

5784

ld a,c

5785

ld h,c

5786

ld l,c

5787

ret

5788

mul8_24_1:

5789

add hl,hl

5790

rla

5791

rl c

5792

jr nc,$+7

5793

add hl,de

5794

adc a,b

5795

jr nc,$+3

5796

inc c

5797

mul8_24_2:

5798

add hl,hl

5799

rla

5800

rl c

5801

jr nc,$+7

5802

add hl,de

5803

adc a,b

5804

jr nc,$+3

5805

inc c

5806

mul8_24_3:

5807

add hl,hl

5808

rla

5809

rl c

5810

jr nc,$+7

5811

add hl,de

5812

adc a,b

5813

jr nc,$+3

5814

inc c

5815

mul8_24_4:

5816

add hl,hl

5817

rla

5818

rl c

5819

jr nc,$+7

5820

add hl,de

5821

adc a,b

5822

jr nc,$+3

5823

inc c

5824

mul8_24_5:

5825

add hl,hl

5826

rla

5827

rl c

5828

jr nc,$+7

5829

add hl,de

5830

adc a,b

5831

jr nc,$+3

5832

inc c

5833

mul8_24_6:

5834

add hl,hl

5835

rla

5836

rl c

5837

jr nc,$+7

5838

add hl,de

5839

adc a,b

5840

jr nc,$+3

5841

inc c

5842

mul8_24_7:

5843

add hl,hl

5844

rla

5845

rl c

5846

ret nc

5847

add hl,de

5848

adc a,b

5849

ret nc

5850

inc c

5851

ret

5852

5853

pushpop:

5854

;26 bytes, adds 118cc to the traditional routine

5855

ex (sp),hl

5856

push de

5857

push bc

5858

push af

5859

push hl

5860

ld hl,pushpopret

5861

ex (sp),hl

5862

push hl

5863

push af

5864

ld hl,12

5865

add hl,sp

5866

ld a,(hl)

5867

inc hl

5868

ld h,(hl)

5869

ld l,a

5870

pop af

5871

ret

5872

pushpopret:

5873

pop af

5874

pop bc

5875

pop de

5876

pop hl

5877

ret

5878

5879

mov4:

5880

ldi

5881

ldi

5882

ldi

5883

ldi

5884

ret

5885

5886

if defined MATH_FIN

5887

5888

ascii_to_uint8:

5889

;c flag means don't increment the exponent

5890

ld c,0

5891

ld a,(hl)

5892

jr c,ascii_to_uint8_noexp

5893

cp char_DEC

5894

jr z,ascii_to_uint8_noexp-2

5895

_70:

5896

sub 3Ah

5897

add a,10

5898

jr nc,ascii_to_uint8_noexp_end

5899

inc b

5900

ld c,a

5901

add a,a

5902

add a,a

5903

add a,c

5904

add a,a

5905

ld c,a

5906

inc hl

5907

_71:

5908

ld a,(hl)

5909

cp char_DEC

5910

jr z,ascii_to_uint8_noexp_2nd

5911

_72:

5912

sub 3Ah

5913

add a,10

5914

jr nc,ascii_to_uint8_noexp_end

5915

inc b

5916

add a,c

5917

inc hl

5918

ld (de),a

5919

dec de

5920

or a

5921

ret

5922

5923

inc hl

5924

ld a,(hl)

5925

ascii_to_uint8_noexp:

5926

sub 3Ah

5927

add a,10

5928

jr nc,ascii_to_uint8_noexp_end

5929

ld c,a

5930

add a,a

5931

add a,a

5932

add a,c

5933

add a,a

5934

ld c,a

5935

ascii_to_uint8_noexp_2nd:

5936

inc hl

5937

ld a,(hl)

5938

sub 3Ah

5939

add a,10

5940

jr nc,ascii_to_uint8_noexp_end

5941

add a,c

5942

inc hl

5943

jr ascii_2 ;.db $FE ;start of `cp **`, saves 1cc

5944

ascii_to_uint8_noexp_end:

5945

ld a,c

5946

ascii_2:

5947

ld (de),a

5948

dec de

5949

scf

5950

ret

5951

5952

endif

5953

5954

if defined MATH_RSUBSINGLE

5955

5956

rsubSingle:

5957

;;-x+y

5958

push af

5959

push hl

5960

push de

5961

push bc

5962

push de

5963

ld de,addend2

5964

ldi

5965

ldi

5966

ld a,(hl)

5967

xor 80h

5968

ld (de),a

5969

inc de

5970

inc hl

5971

ld a,(hl)

5972

ld (de),a

5973

pop de

5974

ld hl,addend2

5975

jp addInject ;jumps in to the addSingle routine

5976

5977

endif

5978

5979

if defined MATH_MOD1SINGLE

5980

5981

;This routine performs `x mod 1`, returning a non-negative value.

5982

;+inf -> NaN

5983

;-inf -> NaN

5984

;NaN -> NaN

5985

mod1Single:

5986

call pushpop

5987

push bc

5988

ld e,(hl)

5989

inc hl

5990

ld d,(hl)

5991

inc hl

5992

ld c,(hl)

5993

ld a,c

5994

xor 80h

5995

push af

5996

jp p,mod1Single.1

5997

ld c,a

5998

mod1Single.1:

5999

6000

inc hl

6001

ld a,(hl)

6002

ld b,a

6003

or a

6004

jr z,mod1Single_special

6005

sub $80

6006

jr c,mod1_end

6007

inc a

6008

ld b,a

6009

ld a,c

6010

ex de,hl

6011

mod1Single.2:

6012

add hl,hl

6013

rla

6014

djnz mod1Single.2

6015

ld c,a

6016

6017

;If it is zero, need to set exponent to zero and return

6018

or h

6019

or l

6020

ex de,hl

6021

jr z,mod1_end

6022

6023

;Need to normalize

6024

ld b,$7F

6025

ld a,c

6026

or a

6027

jp m,mod1_end

6028

ex de,hl

6029

mod1Single.3:

6030

dec b

6031

add hl,hl

6032

adc a,a

6033

jp p,mod1Single.3

6034

ld c,a

6035

ex de,hl

6036

mod1_end:

6037

pop af

6038

pop hl

6039

jp m,mod1Single.4

6040

;make sure it isn't zero else we need to add 1

6041

ld a,b

6042

or a

6043

jr z,mod1Single.4

6044

ld (scrap),de

6045

ld (scrap+2),bc

6046

ld b,h

6047

ld c,l

6048

ld hl,scrap

6049

ld de,const_1

6050

jp addSingle

6051

mod1Single_special:

6052

;If INF, need to return NaN instead

6053

;For 0 and NaN, just return itself :)

6054

pop af

6055

pop hl

6056

ld a,c

6057

add a,a

6058

jp p,mod1Single.4

6059

ld c,$40

6060

mod1Single.4:

6061

res 7,c

6062

ld (hl),e

6063

inc hl

6064

ld (hl),d

6065

inc hl

6066

ld (hl),c

6067

inc hl

6068

ld (hl),b

6069

ret

6070

6071

endif

6072

6073

if defined MATH_FOUT

6074

6075

; --------------------------------------------------------------

6076

; Converts a signed integer value to a zero-terminated ASCII

6077

; string representative of that value (using radix 10).

6078

; References:

6079

; Brandon Wilson WikiTI

6080

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Other:DispA#Decimal_Signed_Version

6081

; --------------------------------------------------------------

6082

; INPUTS:

6083

; HL Value to convert (two's complement integer).

6084

; DE Base address of string destination. (pointer).

6085

; --------------------------------------------------------------

6086

; OUTPUTS:

6087

; A Size of string

6088

; --------------------------------------------------------------

6089

; REGISTERS/MEMORY DESTROYED

6090

; AF HL

6091

; --------------------------------------------------------------

6092

6093

IntToStr:

6094

push de

6095

push bc

6096

6097

; Detect sign of HL.

6098

bit 7, h

6099

jr z, _DoConvert

6100

6101

; HL is negative. Output '-' to string and negate HL.

6102

ld a, '-'

6103

ld (de), a

6104

inc de

6105

6106

; Negate HL (using two's complement)

6107

xor a

6108

sub l

6109

ld l, a

6110

ld a, 0 ; Note that XOR A or SUB A would disturb CF

6111

sbc a, h

6112

ld h, a

6113

6114

; Convert HL to digit characters

6115

_DoConvert:

6116

ld b, 0 ; B will count character length of number

6117

_DoConvert.1:

6118

ld c, 10

6119

call div_hl_c; HL = HL / A, A = remainder

6120

push af

6121

inc b

6122

ld a, h

6123

or l

6124

jr nz, _DoConvert.1

6125

6126

; Retrieve digits from stack

6127

_DoConvert.2:

6128

pop af

6129

or $30

6130

ld (de), a

6131

inc de

6132

djnz _DoConvert.2

6133

6134

; Terminate string with NULL

6135

xor a

6136

ld (de), a

6137

6138

ld h, d

6139

ld l, e

6140

6141

pop bc

6142

pop de

6143

6144

sbc hl, de

6145

ld a, l ; string size

6146

6147

ret

6148

6149

endif

6150

6151

if defined MATH_FIN

6152

6153

;===============================================================

6154

; Convert a string of base-10 digits to a 16-bit value.

6155

; http://z80-heaven.wikidot.com/math#toc32

6156

;Input:

6157

; DE points to the base 10 number string in RAM.

6158

;Outputs:

6159

; HL is the 16-bit value of the number

6160

; DE points to the byte after the number

6161

; BC is HL/10

6162

; z flag reset (nz)

6163

; c flag reset (nc)

6164

;Destroys:

6165

; A (actually, add 30h and you get the ending token)

6166

;Size: 23 bytes

6167

;Speed: 104n+42+11c

6168

; n is the number of digits

6169

; c is at most n-2

6170

; at most 595 cycles for any 16-bit decimal value

6171

;===============================================================

6172

6173

StrToInt:

6174

ld hl,0 ; 10 : 210000

6175

ConvLoop: ;

6176

ld a,(de) ; 7 : 1A

6177

sub 30h ; 7 : D630

6178

cp 10 ; 7 : FE0A

6179

ret nc ;5|11 : D0

6180

inc de ; 6 : 13

6181

;

6182

ld b,h ; 4 : 44

6183

ld c,l ; 4 : 4D

6184

add hl,hl ; 11 : 29

6185

add hl,hl ; 11 : 29

6186

add hl,bc ; 11 : 09

6187

add hl,hl ; 11 : 29

6188

;

6189

add a,l ; 4 : 85

6190

ld l,a ; 4 : 6F

6191

jr nc,ConvLoop ;12|23: 30EE

6192

inc h ; --- : 24

6193

jr ConvLoop ; --- : 18EB

6194

6195

endif

6196

6197

if defined IntToStr

6198

6199

; divides hl by c

6200

; return remainder in a

6201

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division

6202

div_hl_c:

6203

push bc

6204

xor a

6205

ld b, 16

6206

div_hl_c.loop:

6207

add hl, hl

6208

rla

6209

jr c, $+5

6210

cp c

6211

jr c, $+4

6212

sub c

6213

inc l

6214

djnz div_hl_c.loop

6215

pop bc

6216

ret

6217

6218

endif

6219

6220

if defined DIV_EHL

6221

6222

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division

6223

div_ehl_d:

6224

xor a

6225

ld b, 24

6226

div_ehl_d.loop:

6227

add hl, hl

6228

rl e

6229

rla

6230

jr c, $+5

6231

cp d

6232

jr c, $+4

6233

sub d

6234

inc l

6235

djnz div_ehl_d.loop

6236

ret

6237

6238

div_dehl_c:

6239

push bc

6240

xor a

6241

ld b, 32

6242

div_dehl_c.loop:

6243

add hl, hl

6244

rl e

6245

rl d

6246

rla

6247

jr c, $+5

6248

cp c

6249

jr c, $+4

6250

sub c

6251

inc l

6252

djnz div_dehl_c.loop

6253

pop bc

6254

ret

6255

6256

endif

6257

6258

6259

6260

;---------------------------------------------------------------------------------------------------------

6261

; VARIABLES INITIALIZE

6262

;---------------------------------------------------------------------------------------------------------

6263

6264

INITIALIZE_DUMMY:

6265

xor a

6266

ld (VAR_DUMMY.COUNTER), a ; max circular queue = 8 dummys

6267

ld hl, VAR_DUMMY.DATA ; start of variable dummy circular queue

6268

ld (VAR_DUMMY.POINTER), hl

6269

ld b, VAR_DUMMY.LENGTH

6270

ld c, 0

6271

INITIALIZE_DUMMY.1:

6272

ld (hl), a

6273

inc hl

6274

djnz INITIALIZE_DUMMY.1

6275

ret

6276

6277

INITIALIZE_DATA:

6278

ld hl, DATA_ITEMS

6279

ld (BASIC_DATPTR), hl ; next DATA pointer to use by READ command

6280

ld hl, 0

6281

ld (BASIC_DATLIN), hl ; index of DATA item to use by READ command

6282

ret

6283

6284

INITIALIZE_VARIABLES:

6285

call INITIALIZE_DATA

6286

call INITIALIZE_DUMMY

6287

6288

if defined SCREEN

6289

call gfxInitSpriteCollisionTable

6290

endif

6291

6292

;if defined COMPILE_TO_ROM

6293

; ld ix, BIOS_JIFFY ; initialize rom clock

6294

; di

6295

; ld (ix), 0

6296

; ld (ix+1), 0

6297

; ei

6298

;endif

6299

6300

ld hl, IDF_6

6301

ld d, 2 ; any = default integer

6302

ld c, 0 ; variable name 1 (variable number)

6303

ld b, 0 ; variable name 2 (type flag=any)

6304

call INIT_VAR ; variable initialize

6305

ld hl, IDF_11

6306

ld d, 2 ; any = default integer

6307

ld c, 1 ; variable name 1 (variable number)

6308

ld b, 0 ; variable name 2 (type flag=any)

6309

call INIT_VAR ; variable initialize

6310

ret

6311

6312

6313

;---------------------------------------------------------------------------------------------------------

6314

; MAIN WORK AREA - LITERALS / VARIABLES / CONFIGURATIONS

6315

;---------------------------------------------------------------------------------------------------------

6316

6317

if defined COMPILE_TO_ROM

6318

6319

workAreaPad:

6320

pgmPage1.pad: equ pageSize - (workAreaPad - pgmArea)

6321

6322

if pgmPage1.pad >= 0

6323

ds pgmPage1.pad, 0

6324

;else

6325

; .WARNING "There's no free space left on program page 1"

6326

endif

6327

6328

endif

6329

6330

VAR_STACK.START: equ ramArea

6331

;VAR_STACK.END: equ VAR_STACK.START + 0x800 ; 2kb (~200 variables)

6332

6333

VAR_STACK.POINTER: equ VAR_STACK.START

6334

6335

PRINT.CRLF: db 3, 0, 0, 2

6336

dw PRINT.CRLF.DATA, 0, 0, 0

6337

PRINT.CRLF.DATA: db 13,10,0

6338

6339

PRINT.TAB: db 3, 0, 0, 1

6340

dw PRINT.TAB.DATA, 0, 0, 0

6341

PRINT.TAB.DATA: db 09,0

6342

6343

; null double

6344

LIT_NULL_DBL: dw 0, 0, 0, 0

6345

6346

; null string

6347

LIT_NULL_STR: db 0

6348

6349

; quote string

6350

LIT_QUOTE_CHAR: db '\"'

6351

6352

; logical true

6353

LIT_TRUE: db 2, 0, 0

6354

dw 0, 0xFFFF, 0, 0

6355

6356

; logical false

6357

LIT_FALSE: db 2, 0, 0

6358

dw 0, 0, 0, 0

6359

6360

6361

; string literal

6362

LIT_5: db 3, 0, 0, 16

6363

dw LIT_5_DATA, 0, 0

6364

db 0

6365

LIT_5_DATA: db "<<< Counting >>>", 0

6366

6367

; identifier A

6368

IDF_6: equ VAR_STACK.POINTER + 0

6369

6370

; numerical literal

6371

LIT_7: db 2, 0, 0

6372

dw 0, 0, 0, 0

6373

6374

; numerical literal

6375

LIT_9: db 2, 0, 0

6376

dw 0, 1, 0, 0

6377

6378

; identifier B

6379

IDF_11: equ VAR_STACK.POINTER + 11

6380

6381

; numerical literal

6382

LIT_12: db 2, 0, 0

6383

dw 0, 2, 0, 0

6384

6385

; numerical literal

6386

LIT_14: db 2, 0, 0

6387

dw 0, 1, 0, 0

6388

6389

; string literal

6390

LIT_15: db 3, 0, 0, 3

6391

dw LIT_15_DATA, 0, 0

6392

db 0

6393

LIT_15_DATA: db " = ", 0

6394

6395

; numerical literal

6396

LIT_17: db 2, 0, 0

6397

dw 0, 40, 0, 0

6398

6399

AFTER_LAST_VARIABLE: equ VAR_STACK.POINTER + 22

6400

6401

VAR_DUMMY.START: equ AFTER_LAST_VARIABLE ; variable dummy circular queue area

6402

VAR_DUMMY.COUNTER: equ VAR_DUMMY.START ; variable dummy circular queue count

6403

VAR_DUMMY.POINTER: equ VAR_DUMMY.COUNTER + 1 ; pointer to next variable dummy

6404

VAR_DUMMY.DATA: equ VAR_DUMMY.POINTER + 2 ; first variable dummy

6405

6406

VAR_DUMMY.SIZE: equ 8

6407

VAR_DUMMY.LENGTH: equ (11 * VAR_DUMMY.SIZE)

6408

VAR_DUMMY.END: equ VAR_DUMMY.DATA + VAR_DUMMY.LENGTH

6409

VAR_STACK.END: equ VAR_DUMMY.END + 1

6410

6411

;--------------------------------------------------------

6412

; DATA SIMBOLS

6413

;--------------------------------------------------------

6414

6415

DATA_ITEMS:

6416

DATA_ITEMS_COUNT: equ 0

6417

6418

DATA_SET_ITEMS_START:

6419

DATA_SET_ITEMS_COUNT: equ 0

6420

6421

6422

;---------------------------------------------------------------------------------------------------------

6423

; PROGRAM FOOTER

6424

;---------------------------------------------------------------------------------------------------------

6425

6426

if defined COMPILE_TO_ROM

6427

6428

romPad:

6429

6430

pgmPage2.pad: equ romSize - (romPad - pgmArea)

6431

6432

if pgmPage2.pad >= 0

6433

ds pgmPage2.pad, 0

6434

6435

if pgmPage2.pad < lowLimitSize

6436

.WARNING "There's only less than 5% free space on this ROM"

6437

endif

6438

else

6439

.ERROR "There's no free space left on this ROM"

6440

endif

6441

6442

endif

6443

6444

end_file: end start_pgm ; label start is the entry point

6445

Older »