~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_100:

686

set.line.number 100 ; current line number

687

688

TAG_101:

689

set.line.number 101 ; current line number

690

691

TAG_105:

692

set.line.number 105 ; current line number

693

ld hl, LIT_9 ; parameter

694

push.parm

695

call COLOR_BORDER ; action call

696

ld hl, LIT_7 ; parameter

697

push.parm

698

call COLOR_BACKGROUND ; action call

699

ld hl, LIT_5 ; parameter

700

push.parm

701

call COLOR_FOREGROUND ; action call

702

call COLOR ; action call

703

704

TAG_106:

705

set.line.number 106 ; current line number

706

ld hl, LIT_11 ; parameter

707

push.parm

708

call SCREEN ; action call

709

ld hl, LIT_13 ; parameter

710

push.parm

711

call WIDTH ; action call

712

713

TAG_110:

714

set.line.number 110 ; current line number

715

call TIME ; action call

716

call MATH.NEG ; action call

717

call RND ; action call

718

ld hl, IDF_14 ; parameter

719

push.parm

720

call LET ; action call

721

722

TAG_115:

723

set.line.number 115 ; current line number

724

ld hl, LIT_20 ; parameter

725

push.parm

726

ld hl, IDF_19 ; parameter

727

push.parm

728

call LET ; action call

729

ld hl, LIT_23 ; parameter

730

push.parm

731

call SPACE ; action call

732

ld hl, IDF_21 ; parameter

733

push.parm

734

call LET ; action call

735

ld hl, IDF_21 ; parameter

736

push.parm

737

call VARPTR ; action call

738

ld hl, IDF_24 ; parameter

739

push.parm

740

call LET ; action call

741

ld hl, IDF_24 ; parameter

742

push.parm

743

ld hl, LIT_27 ; parameter

744

push.parm

745

call MATH.ADD ; action call

746

call PEEK ; action call

747

ld hl, IDF_24 ; parameter

748

push.parm

749

ld hl, LIT_29 ; parameter

750

push.parm

751

call MATH.ADD ; action call

752

call PEEK ; action call

753

ld hl, LIT_30 ; parameter

754

push.parm

755

call MATH.MULT ; action call

756

call MATH.ADD ; action call

757

ld hl, IDF_24 ; parameter

758

push.parm

759

call LET ; action call

760

761

TAG_120:

762

set.line.number 120 ; current line number

763

FOR_1 : ; start of FOR command

764

ld hl, LIT_35 ; parameter

765

push.parm

766

ld hl, IDF_34 ; parameter

767

push.parm

768

call LET ; action call

769

jp FOR.WHILE_1 ; jump to test if end of FOR

770

FOR.STEP_1 : ; STEP action

771

ld hl, LIT_37 ; parameter

772

push.parm

773

ld hl, IDF_34 ; parameter

774

push.parm

775

call MATH.ADD ; action call

776

ld hl, IDF_34 ; parameter

777

push.parm

778

call LET ; action call

779

FOR.WHILE_1 : ; test if end of FOR

780

ld hl, IDF_34 ; parameter

781

push.parm

782

ld hl, LIT_40 ; parameter

783

push.parm

784

call BOOLEAN.LE ; action call

785

call BOOLEAN.IF ; verify IF condition result, out in A

786

or a ; cp 0 = false

787

jp z, ENDFOR_1 ; end the loop if while condition is false

788

FOR.BODY_1 : ; start of FOR user code

789

ld hl, LIT_42 ; parameter

790

push.parm

791

ld hl, LIT_43 ; parameter

792

push.parm

793

call RND ; action call

794

call MATH.MULT ; action call

795

ld hl, IDF_41 ; parameter

796

push.parm

797

call LET ; action call

798

799

TAG_125:

800

set.line.number 125 ; current line number

801

IF_1 : ; start of IF command

802

ld hl, IDF_41 ; parameter

803

push.parm

804

ld hl, LIT_45 ; parameter

805

push.parm

806

call BOOLEAN.GT ; action call

807

call BOOLEAN.IF ; verify IF condition result, out in A

808

or a ; cp 0 = false

809

jp z, ELSE_1 ; if false, jump to ELSE actions

810

THEN_1 : ; THEN actions

811

jp TAG_150 ; go to

812

jp ENDIF_1 ; jump to END of IF command

813

ELSE_1 : ; ELSE actions

814

ENDIF_1 : ; end of IF command

815

816

TAG_130:

817

set.line.number 130 ; current line number

818

ld hl, IDF_41 ; parameter

819

push.parm

820

ld hl, LIT_50 ; parameter

821

push.parm

822

call MATH.MULT ; action call

823

ld hl, IDF_41 ; parameter

824

push.parm

825

call LET ; action call

826

ld hl, LIT_52 ; parameter

827

push.parm

828

ld hl, LIT_53 ; parameter

829

push.parm

830

call RND ; action call

831

call MATH.MULT ; action call

832

call INT ; action call

833

ld hl, IDF_14 ; parameter

834

push.parm

835

call LET ; action call

836

837

TAG_135:

838

set.line.number 135 ; current line number

839

FOR_2 : ; start of FOR command

840

ld hl, LIT_56 ; parameter

841

push.parm

842

call BASE ; action call

843

ld hl, IDF_54 ; parameter

844

push.parm

845

call LET ; action call

846

jp FOR.WHILE_2 ; jump to test if end of FOR

847

FOR.STEP_2 : ; STEP action

848

ld hl, LIT_57 ; parameter

849

push.parm

850

ld hl, IDF_54 ; parameter

851

push.parm

852

call MATH.ADD ; action call

853

ld hl, IDF_54 ; parameter

854

push.parm

855

call LET ; action call

856

FOR.WHILE_2 : ; test if end of FOR

857

ld hl, IDF_54 ; parameter

858

push.parm

859

ld hl, LIT_58 ; parameter

860

push.parm

861

call BASE ; action call

862

ld hl, LIT_59 ; parameter

863

push.parm

864

call MATH.ADD ; action call

865

call BOOLEAN.LE ; action call

866

call BOOLEAN.IF ; verify IF condition result, out in A

867

or a ; cp 0 = false

868

jp z, ENDFOR_2 ; end the loop if while condition is false

869

FOR.BODY_2 : ; start of FOR user code

870

871

TAG_140:

872

set.line.number 140 ; current line number

873

ld hl, IDF_41 ; parameter

874

push.parm

875

ld hl, IDF_14 ; parameter

876

push.parm

877

call MATH.ADD ; action call

878

ld hl, IDF_54 ; parameter

879

push.parm

880

ld hl, IDF_34 ; parameter

881

push.parm

882

call MATH.ADD ; action call

883

call VPOKE ; action call

884

885

TAG_145:

886

set.line.number 145 ; current line number

887

ld hl, IDF_14 ; parameter

888

push.parm

889

ld hl, LIT_61 ; parameter

890

push.parm

891

call MATH.ADD ; action call

892

ld hl, LIT_62 ; parameter

893

push.parm

894

call BOOLEAN.AND ; action call

895

ld hl, IDF_14 ; parameter

896

push.parm

897

call LET ; action call

898

jp FOR.STEP_2 ; repeat actions

899

ENDFOR_2 : ; END of FOR command

900

901

TAG_150:

902

set.line.number 150 ; current line number

903

jp FOR.STEP_1 ; repeat actions

904

ENDFOR_1 : ; END of FOR command

905

906

TAG_155:

907

set.line.number 155 ; current line number

908

ld hl, IDF_24 ; parameter

909

push.parm

910

ld hl, IDF_65 ; parameter

911

push.parm

912

call LET ; action call

913

FOR_3 : ; start of FOR command

914

ld hl, LIT_66 ; parameter

915

push.parm

916

ld hl, IDF_14 ; parameter

917

push.parm

918

call LET ; action call

919

jp FOR.WHILE_3 ; jump to test if end of FOR

920

FOR.STEP_3 : ; STEP action

921

ld hl, LIT_67 ; parameter

922

push.parm

923

ld hl, IDF_14 ; parameter

924

push.parm

925

call MATH.ADD ; action call

926

ld hl, IDF_14 ; parameter

927

push.parm

928

call LET ; action call

929

FOR.WHILE_3 : ; test if end of FOR

930

ld hl, IDF_14 ; parameter

931

push.parm

932

ld hl, LIT_68 ; parameter

933

push.parm

934

call BOOLEAN.LE ; action call

935

call BOOLEAN.IF ; verify IF condition result, out in A

936

or a ; cp 0 = false

937

jp z, ENDFOR_3 ; end the loop if while condition is false

938

FOR.BODY_3 : ; start of FOR user code

939

940

TAG_160:

941

set.line.number 160 ; current line number

942

ld hl, LIT_70 ; parameter

943

push.parm

944

ld hl, LIT_71 ; parameter

945

push.parm

946

call RND ; action call

947

call MATH.MULT ; action call

948

ld hl, IDF_69 ; parameter

949

push.parm

950

call LET ; action call

951

ld hl, IDF_69 ; parameter

952

push.parm

953

ld hl, IDF_65 ; parameter

954

push.parm

955

call POKE ; action call

956

ld hl, IDF_65 ; parameter

957

push.parm

958

ld hl, LIT_73 ; parameter

959

push.parm

960

call MATH.ADD ; action call

961

ld hl, IDF_65 ; parameter

962

push.parm

963

call LET ; action call

964

965

TAG_165:

966

set.line.number 165 ; current line number

967

FOR_4 : ; start of FOR command

968

ld hl, LIT_74 ; parameter

969

push.parm

970

ld hl, IDF_41 ; parameter

971

push.parm

972

call LET ; action call

973

jp FOR.WHILE_4 ; jump to test if end of FOR

974

FOR.STEP_4 : ; STEP action

975

ld hl, LIT_75 ; parameter

976

push.parm

977

ld hl, IDF_41 ; parameter

978

push.parm

979

call MATH.ADD ; action call

980

ld hl, IDF_41 ; parameter

981

push.parm

982

call LET ; action call

983

FOR.WHILE_4 : ; test if end of FOR

984

ld hl, IDF_41 ; parameter

985

push.parm

986

ld hl, LIT_76 ; parameter

987

push.parm

988

call BOOLEAN.LE ; action call

989

call BOOLEAN.IF ; verify IF condition result, out in A

990

or a ; cp 0 = false

991

jp z, ENDFOR_4 ; end the loop if while condition is false

992

FOR.BODY_4 : ; start of FOR user code

993

994

TAG_170:

995

set.line.number 170 ; current line number

996

ld hl, IDF_19 ; parameter

997

push.parm

998

ld hl, IDF_69 ; parameter

999

push.parm

1000

ld hl, IDF_41 ; parameter

1001

push.parm

1002

call BOOLEAN.EQ ; action call

1003

call MATH.NEG ; action call

1004

call MATH.MULT ; action call

1005

ld hl, IDF_14 ; parameter

1006

push.parm

1007

ld hl, IDF_41 ; parameter

1008

push.parm

1009

call MATH.ADD ; action call

1010

call VPOKE ; action call

1011

jp FOR.STEP_4 ; repeat actions

1012

ENDFOR_4 : ; END of FOR command

1013

jp FOR.STEP_3 ; repeat actions

1014

ENDFOR_3 : ; END of FOR command

1015

1016

TAG_175:

1017

set.line.number 175 ; current line number

1018

FOR_5 : ; start of FOR command

1019

ld hl, LIT_78 ; parameter

1020

push.parm

1021

call BASE ; action call

1022

ld hl, IDF_14 ; parameter

1023

push.parm

1024

call LET ; action call

1025

jp FOR.WHILE_5 ; jump to test if end of FOR

1026

FOR.STEP_5 : ; STEP action

1027

ld hl, LIT_79 ; parameter

1028

push.parm

1029

ld hl, IDF_14 ; parameter

1030

push.parm

1031

call MATH.ADD ; action call

1032

ld hl, IDF_14 ; parameter

1033

push.parm

1034

call LET ; action call

1035

FOR.WHILE_5 : ; test if end of FOR

1036

ld hl, IDF_14 ; parameter

1037

push.parm

1038

ld hl, LIT_80 ; parameter

1039

push.parm

1040

call BASE ; action call

1041

ld hl, LIT_81 ; parameter

1042

push.parm

1043

call MATH.ADD ; action call

1044

call BOOLEAN.LE ; action call

1045

call BOOLEAN.IF ; verify IF condition result, out in A

1046

or a ; cp 0 = false

1047

jp z, ENDFOR_5 ; end the loop if while condition is false

1048

FOR.BODY_5 : ; start of FOR user code

1049

ld hl, IDF_41 ; parameter

1050

push.parm

1051

call READ ; action call

1052

1053

TAG_180:

1054

set.line.number 180 ; current line number

1055

ld hl, IDF_41 ; parameter

1056

push.parm

1057

ld hl, LIT_83 ; parameter

1058

push.parm

1059

call MATH.MULT ; action call

1060

ld hl, IDF_14 ; parameter

1061

push.parm

1062

call VPOKE ; action call

1063

jp FOR.STEP_5 ; repeat actions

1064

ENDFOR_5 : ; END of FOR command

1065

1066

TAG_185:

1067

set.line.number 185 ; current line number

1068

ld hl, LIT_90 ; parameter

1069

push.parm

1070

call SET_TIME ; action call

1071

ld hl, IDF_24 ; parameter

1072

push.parm

1073

ld hl, IDF_65 ; parameter

1074

push.parm

1075

call LET ; action call

1076

FOR_6 : ; start of FOR command

1077

ld hl, LIT_91 ; parameter

1078

push.parm

1079

ld hl, IDF_14 ; parameter

1080

push.parm

1081

call LET ; action call

1082

jp FOR.WHILE_6 ; jump to test if end of FOR

1083

FOR.STEP_6 : ; STEP action

1084

ld hl, LIT_92 ; parameter

1085

push.parm

1086

ld hl, IDF_14 ; parameter

1087

push.parm

1088

call MATH.ADD ; action call

1089

ld hl, IDF_14 ; parameter

1090

push.parm

1091

call LET ; action call

1092

FOR.WHILE_6 : ; test if end of FOR

1093

ld hl, IDF_14 ; parameter

1094

push.parm

1095

ld hl, LIT_93 ; parameter

1096

push.parm

1097

call BOOLEAN.LE ; action call

1098

call BOOLEAN.IF ; verify IF condition result, out in A

1099

or a ; cp 0 = false

1100

jp z, ENDFOR_6 ; end the loop if while condition is false

1101

FOR.BODY_6 : ; start of FOR user code

1102

ld hl, IDF_65 ; parameter

1103

push.parm

1104

call PEEK ; action call

1105

ld hl, IDF_41 ; parameter

1106

push.parm

1107

call LET ; action call

1108

1109

TAG_190:

1110

set.line.number 190 ; current line number

1111

ld hl, LIT_94 ; parameter

1112

push.parm

1113

call BASE ; action call

1114

ld hl, LIT_95 ; parameter

1115

push.parm

1116

ld hl, IDF_14 ; parameter

1117

push.parm

1118

call MATH.MULT ; action call

1119

call MATH.ADD ; action call

1120

ld hl, IDF_69 ; parameter

1121

push.parm

1122

call LET ; action call

1123

ld hl, LIT_96 ; parameter

1124

push.parm

1125

ld hl, IDF_69 ; parameter

1126

push.parm

1127

ld hl, IDF_41 ; parameter

1128

push.parm

1129

call MATH.ADD ; action call

1130

call VPOKE ; action call

1131

1132

TAG_195:

1133

set.line.number 195 ; current line number

1134

ld hl, IDF_41 ; parameter

1135

push.parm

1136

ld hl, IDF_14 ; parameter

1137

push.parm

1138

call MATH.ADD ; action call

1139

ld hl, LIT_97 ; parameter

1140

push.parm

1141

call MATH.ADD ; action call

1142

ld hl, LIT_98 ; parameter

1143

push.parm

1144

call BOOLEAN.AND ; action call

1145

ld hl, IDF_41 ; parameter

1146

push.parm

1147

call LET ; action call

1148

ld hl, IDF_19 ; parameter

1149

push.parm

1150

ld hl, IDF_69 ; parameter

1151

push.parm

1152

ld hl, IDF_41 ; parameter

1153

push.parm

1154

call MATH.ADD ; action call

1155

call VPOKE ; action call

1156

1157

TAG_200:

1158

set.line.number 200 ; current line number

1159

ld hl, IDF_41 ; parameter

1160

push.parm

1161

ld hl, IDF_65 ; parameter

1162

push.parm

1163

call POKE ; action call

1164

ld hl, IDF_65 ; parameter

1165

push.parm

1166

ld hl, LIT_99 ; parameter

1167

push.parm

1168

call MATH.ADD ; action call

1169

ld hl, IDF_65 ; parameter

1170

push.parm

1171

call LET ; action call

1172

jp FOR.STEP_6 ; repeat actions

1173

ENDFOR_6 : ; END of FOR command

1174

1175

TAG_205:

1176

set.line.number 205 ; current line number

1177

IF_2 : ; start of IF command

1178

call TIME ; action call

1179

ld hl, LIT_100 ; parameter

1180

push.parm

1181

call BOOLEAN.LT ; action call

1182

call BOOLEAN.IF ; verify IF condition result, out in A

1183

or a ; cp 0 = false

1184

jp z, ELSE_2 ; if false, jump to ELSE actions

1185

THEN_2 : ; THEN actions

1186

jp TAG_205 ; go to

1187

jp ENDIF_2 ; jump to END of IF command

1188

ELSE_2 : ; ELSE actions

1189

jp TAG_185 ; go to

1190

ENDIF_2 : ; end of IF command

1191

1192

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

1193

; PROGRAM END CODE

1194

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

1195

1196

end_pgm: __call_bios BIOS_DSPFNK ; turn on function keys display

1197

ld a, 1 ;

1198

ld (BIOS_CLIKSW), a ; enable keyboard click

1199

1200

if defined COMPILE_TO_ROM

1201

jp PROGRAM_TO_BASIC

1202

else

1203

__call_basic BASIC_READYR ; warm start Basic

1204

endif

1205

1206

ret ; end of the program

1207

1208

;__call_bios BIOS_GICINI ; initialize sound system

1209

;if defined COMPILE_TO_DOS or defined COMPILE_TO_ROM

1210

; __call_bios BIOS_RESET ; restart Basic

1211

;else

1212

; __call_basic BASIC_END ; end to Basic

1213

;endif

1214

1215

1216

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

1217

; MSX BASIC KEYWORDS

1218

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

1219

1220

; keyword

1221

LET:

1222

1223

; out IX = variable assigned address

1224

pop.parm ; get variable address parameter

1225

push hl ; just to transfer hl to ix

1226

pop ix ;

1227

ld a, (ix) ; get variable type

1228

cp 3 ; test if string

1229

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

1230

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

1231

or a ; cp 0

1232

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

1233

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

1234

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

1235

push ix ; save variable address

1236

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

1237

pop ix ;

1238

call memory.free ; free memory

1239

pop ix ; restore variable address

1240

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

1241

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

1242

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

1243

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

1244

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

1245

pop de ;

1246

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

1247

inc de ; go to variable data area

1248

inc de ;

1249

inc hl ; go to data data area

1250

inc hl ;

1251

ld bc, 8 ; data = 8 bytes

1252

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

1253

ld a, (ix) ; get variable type

1254

cp 3 ; test if string

1255

ret nz ; if not string, return

1256

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

1257

LET.FIXED: push ix ; save variable destination address

1258

push hl ; save variable source address

1259

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

1260

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

1261

pop de

1262

pop ix ; restore variable address

1263

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

1264

cp 3 ; test if string

1265

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

1266

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

1267

cp 3 ; test if string

1268

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

1269

inc de

1270

inc de

1271

inc de

1272

ld a, (de)

1273

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

1274

jr LET.FIX2

1275

LET.FIX1: push hl

1276

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

1277

pop hl

1278

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

1279

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

1280

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

1281

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

1282

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

1283

pop de ;

1284

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

1285

inc de ;

1286

inc de ;

1287

ld bc, 8 ; data = 8 bytes

1288

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

1289

ret ;

1290

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

1291

or a ; cp 0 - test if null

1292

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

1293

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

1294

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

1295

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

1296

ret ;

1297

LET.ALLOC: push ix ; save variable address

1298

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

1299

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

1300

push hl ; save copy from address

1301

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

1302

ld b, 0 ;

1303

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

1304

push bc ; save variable lenght + 1

1305

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

1306

jp z, memory.error

1307

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

1308

pop de ;

1309

pop bc ; restore bytes to be copied

1310

pop hl ; restore copy from string address

1311

push de ; save copy to address

1312

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

1313

;xor a

1314

;ld (de), a

1315

pop de ; restore copy to address

1316

pop ix ; restore variable address

1317

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

1318

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

1319

ret ; variable assigned

1320

1321

; keyword

1322

BOOLEAN.IF:

1323

1324

pop.parm ; get parameter boolean result in hl

1325

push hl ; ix = hl

1326

pop ix ;

1327

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

1328

ret ;

1329

1330

; keyword

1331

COLOR:

1332

1333

;call gfxSetColor

1334

__call_bios BIOS_CHGCLR ; change VDP colors

1335

ret ;

1336

1337

; keyword

1338

COLOR_FOREGROUND:

1339

1340

pop.parm ; get first parameter

1341

call CAST_TO.INT ;

1342

call GET_INT.VALUE ; output BC with integer value

1343

ld a, c ; A = pixel color

1344

;call gfxSetForeColor

1345

ld (BIOS_FORCLR), a ; foreground color

1346

ld (BIOS_ATRBYT), a

1347

ret ;

1348

1349

; keyword

1350

COLOR_BACKGROUND:

1351

1352

pop.parm ; get first parameter

1353

call CAST_TO.INT ;

1354

call GET_INT.VALUE ; output BC with integer value

1355

ld a, c ; A = pixel color

1356

;call gfxSetBackColor

1357

ld (BIOS_BAKCLR), a ; foreground color

1358

ret ;

1359

1360

; keyword

1361

COLOR_BORDER:

1362

1363

pop.parm ; get first parameter

1364

call CAST_TO.INT ;

1365

call GET_INT.VALUE ; output BC with integer value

1366

ld a, c ; A = pixel color

1367

;call gfxSetBorderColor

1368

ld (BIOS_BDRCLR), a ; border color

1369

ret ;

1370

1371

; keyword

1372

SCREEN:

1373

1374

pop.parm ; get first parameter

1375

call CAST_TO.INT ;

1376

call GET_INT.VALUE ; output BC with integer value

1377

ld a, c ; A = screen number (0 to 3)

1378

cp 9

1379

jr c, SCREEN.1 ; if mode < 9, jump

1380

ld a, 8 ; else, fix to 8

1381

SCREEN.1:

1382

if defined EXIST_DATA_SET

1383

call gfxSetScreenMode

1384

call gfxIsTileMode

1385

ret nz

1386

1387

jp gfxClearTileScreen

1388

else

1389

jp gfxSetScreenMode

1390

endif

1391

1392

; keyword

1393

WIDTH:

1394

1395

pop.parm ; get first parameter

1396

call CAST_TO.INT ;

1397

call GET_INT.VALUE ; output BC with integer value

1398

ld a, (BIOS_OLDSCR) ; last text screen mode

1399

and a ; test if zero

1400

ld a, c ; copy parameter to A

1401

jr z, WIDTH.40 ; if zero = 40 columns

1402

WIDTH.32: ld (BIOS_LINL32), a

1403

jr WIDTH.SET

1404

WIDTH.40: ld (BIOS_LINL40), a

1405

WIDTH.SET: ld (BIOS_LINLEN), a

1406

sub 0x0E

1407

add a, 0x1C

1408

cpl

1409

inc a

1410

add a, c

1411

ld (BIOS_CLMLST), a

1412

ld a, 0x0C ; new page (clear the screen)

1413

rst BIOS_OUTDO ; output to screen

1414

ret ;

1415

1416

; keyword

1417

RND:

1418

1419

pop.parm ; get parameter

1420

call COPY_TO.DAC ; put in DAC

1421

and 12 ; test if single/double

1422

jr nz, RND.1 ; if already double

1423

__call_bios MATH_FRCDBL ; convert DAC to double

1424

RND.1: __call_bios MATH_RND ; put in DAC a new random number from previous DAC parameter

1425

jp MATH.PARM.PUSH ; return a dummy double variable from DAC

1426

1427

; keyword

1428

TIME:

1429

1430

ld ix, BIOS_JIFFY ; time counter address

1431

di ;

1432

ld c, (ix) ; get time counter (low)

1433

ld b, (ix+1) ; get time counter (high)

1434

ei ;

1435

call COPY_TO.VAR_DUMMY.INT ; create a fake integer variable from BC in HL

1436

ret.parm ;

1437

1438

; keyword

1439

MATH.NEG:

1440

1441

call CLEAR.DAC ; put zero in DAC

1442

pop.parm ; get parameter

1443

call COPY_TO.ARG ; put in ARG

1444

cp 2 ; test if integer

1445

jp z, MATH.SUB.INT ;

1446

cp 4 ; test if single

1447

jp z, MATH.SUB.SGL ;

1448

cp 8 ; test if double

1449

jp z, MATH.SUB.DBL ;

1450

jp MATH.ERROR ;

1451

1452

; keyword

1453

SPACE:

1454

1455

pop.parm ; get first parameter

1456

call CAST_TO.INT ;

1457

call GET_INT.VALUE ; output BC with integer value

1458

push bc

1459

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

1460

pop bc

1461

ld b, c

1462

;ld ix, BASIC_BUF

1463

push ix

1464

ld a, 32 ; space

1465

SPACE.1: ld (ix), a

1466

inc ix

1467

djnz SPACE.1

1468

xor a

1469

ld (ix), a

1470

pop hl

1471

ld a, c

1472

call COPY_TO.VAR_DUMMY.STR ; create a fake string variable from HL in HL

1473

ret.parm ;

1474

1475

; keyword

1476

VARPTR:

1477

1478

pop.parm ; get first parameter in HL

1479

inc hl

1480

inc hl

1481

inc hl

1482

;push hl

1483

;pop bc

1484

ld b, h

1485

ld c, l

1486

call COPY_TO.VAR_DUMMY.INT ; create a fake integer variable from BC in HL

1487

ret.parm ;

1488

1489

; keyword

1490

PEEK:

1491

1492

pop.parm ; get first parameter in HL

1493

call CAST_TO.INT ;

1494

call GET_INT.VALUE ; put parameter into BC

1495

;push bc ; address of data

1496

;pop hl

1497

ld h, b

1498

ld l, c

1499

ld a, (hl)

1500

ld c, a

1501

;inc hl

1502

;ld a, (hl)

1503

;ld b, a

1504

ld b, 0

1505

call COPY_TO.VAR_DUMMY.INT ; create a fake integer variable from BC in HL

1506

ret.parm ;

1507

1508

; keyword

1509

MATH.ADD:

1510

1511

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

1512

ld a, (BASIC_VALTYP) ;

1513

cp 2 ; test if integer

1514

jp z, MATH.ADD.INT ;

1515

cp 3 ; test if string

1516

jp z, STRING.CONCAT ;

1517

cp 4 ; test if single

1518

jp z, MATH.ADD.SGL ;

1519

jp MATH.ADD.DBL ; it is a double

1520

1521

; keyword

1522

MATH.MULT:

1523

1524

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

1525

ld a, (BASIC_VALTYP) ;

1526

cp 2 ; test if integer

1527

jp z, MATH.MULT.INT ;

1528

cp 3 ; test if string

1529

jp z, MATH.ERROR ;

1530

cp 4 ; test if single

1531

jp z, MATH.MULT.SGL ;

1532

jp MATH.MULT.DBL ; it is a double

1533

1534

; keyword

1535

FOR:

1536

; abstract virtual FOR

1537

; keyword

1538

BOOLEAN.LE:

1539

1540

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

1541

ld a, (BASIC_VALTYP) ;

1542

cp 2 ; test if integer

1543

jp z, BOOLEAN.LE.INT ;

1544

cp 3 ; test if string

1545

jp z, BOOLEAN.LE.STR ;

1546

cp 4 ; test if single

1547

jp z, BOOLEAN.LE.SGL ;

1548

jp BOOLEAN.LE.DBL ; it is a double

1549

1550

; keyword

1551

BOOLEAN.GT:

1552

1553

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

1554

ld a, (BASIC_VALTYP) ;

1555

cp 2 ; test if integer

1556

jp z, BOOLEAN.GT.INT ;

1557

cp 3 ; test if string

1558

jp z, BOOLEAN.GT.STR ;

1559

cp 4 ; test if single

1560

jp z, BOOLEAN.GT.SGL ;

1561

jp BOOLEAN.GT.DBL ; it is a double

1562

1563

; keyword

1564

GOTO:

1565

; abstract virtual GOTO

1566

; keyword

1567

INT:

1568

1569

pop.parm ; get first parameter in HL

1570

call CAST_TO.INT ;

1571

call GET_INT.VALUE ; put parameter into BC

1572

call COPY_TO.VAR_DUMMY.INT ; create a fake integer variable from BC in HL

1573

ret.parm ;

1574

1575

; keyword

1576

BASE:

1577

1578

pop.parm ; get first parameter in HL

1579

call CAST_TO.INT ;

1580

call GET_INT.VALUE ; put parameter into BC

1581

ld hl, BIOS_TXTNAM

1582

add hl, bc

1583

add hl, bc

1584

ld a, (hl)

1585

ld c, a

1586

inc hl

1587

ld a, (hl)

1588

ld b, a

1589

call COPY_TO.VAR_DUMMY.INT ; create a fake integer variable from BC in HL

1590

ret.parm ;

1591

1592

; keyword

1593

VPOKE:

1594

1595

pop.parm ; get first parameter in HL

1596

call CAST_TO.INT ;

1597

call GET_INT.VALUE ; put parameter into BC

1598

ld (BIOS_TEMP), bc ; address

1599

pop.parm ; get second parameter in HL

1600

call CAST_TO.INT ;

1601

call GET_INT.VALUE ; put parameter into BC

1602

ld hl, (BIOS_TEMP) ; address

1603

ld a, c ; data (low)

1604

call gfxWRTVRM

1605

;inc hl

1606

;ld a, b ; data (high)

1607

;call gfxWRTVRM

1608

ret

1609

1610

; keyword

1611

BOOLEAN.AND:

1612

1613

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

1614

ld a, (BASIC_VALTYP) ;

1615

cp 2 ; test if integer

1616

jp z, BOOLEAN.AND.INT ;

1617

jp MATH.ERROR ; it is a double

1618

1619

; keyword

1620

1621

; abstract virtual NEXT

1622

; keyword

1623

POKE:

1624

1625

pop.parm ; get first parameter in HL

1626

call CAST_TO.INT ;

1627

call GET_INT.VALUE ; put parameter into BC

1628

ld (BIOS_TEMP), bc ; address

1629

pop.parm ; get second parameter in HL

1630

call CAST_TO.INT ;

1631

call GET_INT.VALUE ; put parameter into BC

1632

ld ix, (BIOS_TEMP) ; address

1633

ld (ix), c ; data (low)

1634

;ld (ix+1), b ; data (high)

1635

ret

1636

1637

; keyword

1638

BOOLEAN.EQ:

1639

1640

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

1641

ld a, (BASIC_VALTYP) ;

1642

cp 2 ; test if integer

1643

jp z, BOOLEAN.EQ.INT ;

1644

cp 3 ; test if string

1645

jp z, BOOLEAN.EQ.STR ;

1646

cp 4 ; test if single

1647

jp z, BOOLEAN.EQ.SGL ;

1648

jp BOOLEAN.EQ.DBL ; it is a double

1649

1650

; keyword

1651

READ:

1652

1653

pop.parm ; get first parameter (variable to be read)

1654

push hl ; save input variable...

1655

xor a ; clear carry

1656

ld hl, (BASIC_DATLIN) ; index of data items

1657

ld de, DATA_ITEMS_COUNT ; count of data items

1658

sbc hl, de ; compare hl >= de

1659

jr z, READ.END ; jump if equal

1660

jr nc, READ.END ; jump if above

1661

pop de ; restore saved input variable to DE

1662

ld ix, (BASIC_DATPTR) ; data items pointer

1663

ld l, (ix)

1664

ld h, (ix+1)

1665

push.parm ; LET parameter 2 - data as right operand

1666

ex de, hl ; put DE into HL

1667

push.parm ; LET parameter 1 - input variable as left operand

1668

call LET ; put data into variable

1669

ld hl, (BASIC_DATLIN) ; old index of data items

1670

inc hl ; next item

1671

ld (BASIC_DATLIN), hl ; save new index of data items

1672

ld hl, (BASIC_DATPTR) ; old data items pointer

1673

push hl

1674

inc hl ; next item

1675

inc hl ; next item

1676

ld (BASIC_DATPTR), hl ; save new data items pointer

1677

READ.END: pop hl

1678

ret

1679

1680

; keyword

1681

DATA:

1682

; abstract virtual DATA

1683

; keyword

1684

SET_TIME:

1685

1686

pop.parm ; get first parameter in HL

1687

call CAST_TO.INT ;

1688

call GET_INT.VALUE ; put parameter into BC

1689

di ;

1690

ld (BIOS_JIFFY), bc

1691

ei ;

1692

ret

1693

1694

; keyword

1695

BOOLEAN.LT:

1696

1697

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

1698

ld a, (BASIC_VALTYP) ;

1699

cp 2 ; test if integer

1700

jp z, BOOLEAN.LT.INT ;

1701

cp 3 ; test if string

1702

jp z, BOOLEAN.LT.STR ;

1703

cp 4 ; test if single

1704

jp z, BOOLEAN.LT.SGL ;

1705

jp BOOLEAN.LT.DBL ; it is a double

1706

1707

1708

1709

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

1710

; MSX BASIC SUPPORT CODE

1711

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

1712

1713

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

1714

1715

RUN_TRAPS: ld b, 26

1716

ld hl, BASIC_TRPTBL

1717

RUN_TRAPS.1: push hl

1718

push bc

1719

call TRAP_HANDLER

1720

pop bc

1721

pop hl

1722

inc hl

1723

inc hl

1724

inc hl

1725

djnz RUN_TRAPS.1

1726

ret

1727

1728

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

1729

TRAP_HANDLER:

1730

ld a, (hl) ; trap status

1731

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

1732

ret nz ; return if false

1733

inc hl

1734

ld e, (hl) ; get trap address

1735

inc hl

1736

ld d, (hl)

1737

dec hl

1738

dec hl

1739

ld a, d

1740

or e

1741

ret z ; return if address zero

1742

push hl

1743

__call_basic BASIC_TRAP_ACKNW

1744

__call_basic BASIC_TRAP_PAUSE

1745

ld hl, TRAP_HANDLER.1

1746

ld a, (BASIC_ONGSBF) ; save traps execution

1747

push af

1748

xor a

1749

ld (BASIC_ONGSBF), a ; disable traps execution

1750

push hl ; next return will be to trap handler

1751

push de ; indirect jump to trap address

1752

ret

1753

TRAP_HANDLER.1: pop af

1754

ld (BASIC_ONGSBF), a ; restore traps execution

1755

pop hl

1756

ld a, (hl)

1757

cp 1 ; trap enabled?

1758

ret z

1759

__call_basic BASIC_TRAP_UNPAUSE

1760

ret

1761

1762

; hl = trap block, de = trap handler

1763

SET_TRAP: xor a

1764

ld (hl), a ; trap block status

1765

inc hl

1766

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

1767

inc hl

1768

ld (hl), d

1769

ret

1770

1771

endif

1772

1773

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

1774

1775

SET_PLAY_VOICE:

1776

ld (BIOS_TEMP), a ; save voice number

1777

pop.parm

1778

ld a, (hl)

1779

cp 3

1780

ret nz ; return if not string

1781

call GET_STR.ADDR

1782

SET_PLAY_VOICE.1:

1783

ld (BIOS_TEMP2), a ; save string size

1784

push hl ; string address

1785

ld a, (BIOS_TEMP) ; restore voice number

1786

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

1787

pop de

1788

ld a, (BIOS_TEMP2) ; restore string size

1789

ld (hl), a ; string size

1790

inc hl

1791

ld (hl), e ; string address

1792

inc hl

1793

ld (hl), d

1794

inc hl

1795

ld D,H ; voice stack

1796

ld E,L

1797

ld BC,001CH

1798

add HL,BC

1799

ex DE,HL

1800

ld (HL),E

1801

inc HL

1802

ld (HL),D

1803

ret

1804

1805

START_PLAY:

1806

ld HL, 0x752E

1807

ld (BIOS_MCLTAB),HL

1808

ld a, 1

1809

ld (BIOS_MCLFLG),A

1810

ld hl, BIOS_TEMP ; voice count

1811

ld a, 3

1812

sub (hl)

1813

dec a

1814

ld (BIOS_PRSCNT), a

1815

xor a

1816

ld (BIOS_VOICEN), a

1817

ld (BIOS_QUEUEN), a

1818

ld (BIOS_MUSICF), a

1819

ld HL,-12 ; -10

1820

add HL,SP

1821

ld (BIOS_SAVSP),HL

1822

ld HL, BIOS_PLYCNT

1823

ld (HL), 0

1824

__call_basic BASIC_PLAY_DIRECT

1825

ret

1826

1827

endif

1828

1829

1830

1831

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

1832

; VARIABLES ROUTINES

1833

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

1834

1835

; input hl = variable address

1836

; input bc = variable name

1837

; input d = variable type

1838

INIT_VAR: ld (hl), d ; variable type

1839

inc hl

1840

ld (hl), c ; variable name 1

1841

inc hl

1842

ld (hl), b ; variable name 2

1843

ld a, d

1844

cp 3

1845

jp nz, CLEAR.VAR

1846

ld de, LIT_NULL_STR

1847

inc hl

1848

ld (hl), 0

1849

inc hl

1850

ld (hl), e

1851

inc hl

1852

ld (hl), d

1853

ld b, 5

1854

jr CLEAR.VAR.LOOP

1855

CLEAR.VAR: ld b, 8

1856

CLEAR.VAR.LOOP: inc hl

1857

ld (hl), 0 ; data address/value

1858

djnz CLEAR.VAR.LOOP

1859

ret

1860

; input HL = variable address

1861

; input A = variable output type

1862

; output HL = casted data address

1863

CAST_TO: cp 2

1864

jp z, CAST_TO.INT

1865

cp 3

1866

jp z, CAST_TO.STR

1867

cp 4

1868

jp z, CAST_TO.SGL

1869

cp 8

1870

jp z, CAST_TO.DBL

1871

ret

1872

; input HL = variable address

1873

; output HL = variable address

1874

CAST_TO.INT: ;push af

1875

ld a, (HL)

1876

cp 2

1877

jp z, GET_INT.ADDR

1878

cp 3

1879

jp z, CAST_STR_TO.INT

1880

cp 4

1881

jp z, CAST_SGL_TO.INT

1882

cp 8

1883

jp z, CAST_DBL_TO.INT

1884

;pop af

1885

ret

1886

; input HL = variable address

1887

; output HL = variable address

1888

CAST_TO.STR: ;push af

1889

ld a, (HL)

1890

cp 2

1891

jp z, CAST_INT_TO.STR

1892

cp 3

1893

jp z, GET_STR.ADDR

1894

cp 4

1895

jp z, CAST_SGL_TO.STR

1896

cp 8

1897

jp z, CAST_DBL_TO.STR

1898

;pop af

1899

ret

1900

; input HL = variable address

1901

; output HL = variable address

1902

CAST_TO.SGL: ;push af

1903

ld a, (HL)

1904

cp 2

1905

jp z, CAST_INT_TO.SGL

1906

cp 3

1907

jp z, CAST_STR_TO.SGL

1908

cp 4

1909

jp z, GET_SGL.ADDR

1910

cp 8

1911

jp z, CAST_DBL_TO.SGL

1912

;pop af

1913

ret

1914

; input HL = variable address

1915

; output HL = variable address

1916

CAST_TO.DBL: ;push af

1917

ld a, (hl)

1918

cp 2

1919

jp z, CAST_INT_TO.DBL

1920

cp 3

1921

jp z, CAST_STR_TO.DBL

1922

cp 4

1923

jp z, CAST_SGL_TO.DBL

1924

cp 8

1925

jp z, GET_DBL.ADDR

1926

;pop af

1927

ret

1928

CAST_SGL_TO.STR: ; same as CAST_INT_TO.STR

1929

CAST_DBL_TO.STR: ; same as CAST_INT_TO.STR

1930

CAST_INT_TO.STR: call COPY_TO.DAC

1931

xor a

1932

__call_bios MATH_FOUT ; convert DAC to string

1933

;pop af

1934

ret

1935

CAST_INT_TO.SGL: call COPY_TO.DAC

1936

__call_bios MATH_FRCSGL

1937

ld hl, BASIC_DAC

1938

ret

1939

CAST_INT_TO.DBL: call COPY_TO.DAC

1940

__call_bios MATH_FRCDBL

1941

ld hl, BASIC_DAC

1942

ret

1943

CAST_SGL_TO.INT: ; same as CAST_DBL_TO.INT

1944

CAST_DBL_TO.INT: call COPY_TO.DAC

1945

__call_bios MATH_FRCINT

1946

ld hl, BASIC_DAC

1947

ret

1948

CAST_STR_TO.INT: call CAST_STR_TO.VAL ;

1949

__call_bios MATH_FRCINT ;

1950

ld hl, BASIC_DAC ;

1951

ret ;

1952

CAST_STR_TO.SGL: call CAST_STR_TO.VAL ;

1953

__call_bios MATH_FRCSGL ;

1954

ld hl, BASIC_DAC ;

1955

ret ;

1956

CAST_STR_TO.DBL: call CAST_STR_TO.VAL ;

1957

__call_bios MATH_FRCDBL ;

1958

ld hl, BASIC_DAC ;

1959

ret ;

1960

CAST_STR_TO.VAL: call GET_STR.ADDR ;

1961

ld a, (hl) ;

1962

__call_bios MATH_FIN ; convert string to a value type

1963

ld hl, BASIC_DAC ;

1964

ret ;

1965

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

1966

inc hl ;

1967

ld c, (hl) ;

1968

inc hl ;

1969

ld b, (hl) ;

1970

ret ;

1971

CAST_SGL_TO.DBL: ; same as GET_DBL.ADDR

1972

CAST_DBL_TO.SGL: ; same as GET_DBL.ADDR

1973

GET_INT.ADDR: ; same as GET_DBL.ADDR

1974

GET_SGL.ADDR: ; same as GET_DBL.ADDR

1975

GET_DBL.ADDR: inc hl

1976

inc hl

1977

inc hl

1978

;pop af

1979

ret

1980

GET_STR.ADDR: push hl

1981

pop ix

1982

ld a, (ix + 3)

1983

ld l, (ix + 4)

1984

ld h, (ix + 5)

1985

ret

1986

; input hl = string address

1987

; output b = string length

1988

GET_STR.LENGTH: ld b, 0

1989

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

1990

or a ; cp 0

1991

ret z

1992

inc b

1993

inc hl

1994

ld a, b

1995

cp 255

1996

jr z, GET_STR.LEN.ERR

1997

jr GET_STR.LEN.NEXT

1998

GET_STR.LEN.ERR: ld b, 0

1999

ret

2000

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

2001

ld iy, (BASIC_ARG+1) ; string 2

2002

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

2003

cp (iy) ; char s1 = char s2?

2004

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

2005

cp 0 ;

2006

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

2007

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

2008

cp 0 ;

2009

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

2010

inc ix ;

2011

inc iy ;

2012

jr STRING.COMPARE.NX ; get next char pair

2013

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

2014

cp 0 ;

2015

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

2016

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

2017

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

2018

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

2019

ret ;

2020

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

2021

ret ;

2022

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

2023

ret ;

2024

STRING.CONCAT: ld ix, BASIC_DAC ; s1 size

2025

ld a, (BASIC_ARG) ; s2 size

2026

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

2027

push af

2028

ld b, 0

2029

ld c, a ;

2030

inc bc ; add 1 byte to size

2031

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

2032

jp z, memory.error ;

2033

push ix ; save ix

2034

push ix ; save ix

2035

pop de ; de = ix

2036

ld a, (BASIC_DAC) ; s1 size

2037

ld hl, (BASIC_DAC + 1) ; string 1

2038

call COPY_TO.STR ; copy to new memory

2039

ld a, (BASIC_ARG) ; s2 size

2040

ld hl, (BASIC_ARG + 1) ; string 2

2041

call COPY_TO.STR ; copy to new memory

2042

xor a

2043

ld (de), a ; null terminated

2044

pop hl ; hl = ix

2045

pop af

2046

call COPY_TO.VAR_DUMMY.STR ;

2047

ret.parm ; WARNING - VERIFY STRING MEMORY LEAKs

2048

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

2049

cp 5 ;

2050

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

2051

cp 2 ;

2052

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

2053

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

2054

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

2055

ret z ; exit if yes

2056

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

2057

inc hl ; next char

2058

jr STRING.PRINT.T ; repeat

2059

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

2060

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

2061

ret z ; exit if yes

2062

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

2063

inc hl ; next char

2064

jr STRING.PRINT.G1 ; repeat

2065

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

2066

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

2067

ret z ; exit if yes

2068

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

2069

call BIOS_EXTROM

2070

inc hl ; next char

2071

jr STRING.PRINT.G2 ; repeat

2072

2073

; a = string size to copy

2074

; input hl = string from

2075

; input de = string to

2076

COPY_TO.STR: or a

2077

ret z ; avoid copy if size = zero

2078

ld b, 0

2079

ld c, a ; string size

2080

ldir ; copy bc bytes from hl to de

2081

ret ;

2082

COPY_TO.BASIC_BUF: ld bc, BASIC_BUF

2083

ld a, (LIT_QUOTE_CHAR)

2084

ld (bc), a

2085

inc bc

2086

COPY_BAS_BUF.LOOP: ld a, (hl)

2087

or a ; cp 0

2088

jr z, COPY_BAS_BUF.EXIT

2089

ld (bc), a

2090

inc bc

2091

inc hl

2092

jr COPY_BAS_BUF.LOOP

2093

COPY_BAS_BUF.EXIT: ld a, (LIT_QUOTE_CHAR)

2094

ld (bc), a

2095

inc bc

2096

xor a

2097

ld (bc), a

2098

ld hl, BASIC_BUF

2099

ret

2100

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

2101

cp 3 ;

2102

jr nz, COPY_TO.VAR_DUMMY.DBL

2103

push hl

2104

call GET_STR.LENGTH ; get string length

2105

pop hl

2106

ld a, b ; string length

2107

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

2108

ld (ix), 3 ; data type string

2109

ld (ix+1), 0 ;

2110

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

2111

ld (ix+3), a ; string length

2112

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

2113

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

2114

;call GET_STR.LENGTH ; get string length

2115

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

2116

push ix ; output var address...

2117

pop hl ; ...into hl

2118

ret ;

2119

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

2120

ld (ix), 2 ; data type string

2121

ld (ix+1), 0 ;

2122

ld (ix+2), 0 ;

2123

ld (ix+3), 0 ;

2124

ld (ix+4), 0 ;

2125

ld (ix+5), c ;

2126

ld (ix+6), b ;

2127

ld (ix+7), 0 ;

2128

ld (ix+8), 0 ;

2129

ld (ix+9), 0 ;

2130

ld (ix+10), 0 ;

2131

push ix ; output var address...

2132

pop hl ; ...into hl

2133

ret ;

2134

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

2135

ld (ix), a ; data type

2136

ld (ix+1), 0 ;

2137

ld (ix+2), 0 ;

2138

ld bc, 8 ;

2139

ld hl, BASIC_DAC ;

2140

push ix ; just to copy ix to de

2141

pop de ;

2142

inc de ;

2143

inc de ;

2144

inc de ;

2145

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

2146

push ix ; output var address...

2147

pop hl ; ...into hl

2148

ret ;

2149

GET_VAR_DUMMY.ADDR: push af ;

2150

push de

2151

ld de, 11 ;

2152

ld ix, (VAR_DUMMY.POINTER) ;

2153

ld a, (VAR_DUMMY.COUNTER) ;

2154

GET_VAR_DUMMY.NEXT: add ix, de ;

2155

inc a ;

2156

cp VAR_DUMMY.SIZE ;

2157

jr nz, GET_VAR_DUMMY.EXIT ;

2158

xor a ;

2159

ld ix, VAR_DUMMY.DATA ;

2160

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

2161

ld (VAR_DUMMY.COUNTER), a ;

2162

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

2163

cp 3 ; is it string?

2164

call z, GET_VAR_DUMMY.FREE ; free string memory

2165

pop de

2166

pop af ;

2167

ret ;

2168

GET_VAR_DUMMY.FREE:

2169

push hl

2170

push ix

2171

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

2172

ld h, (ix+5)

2173

push hl

2174

pop ix

2175

call memory.free ; free memory

2176

pop ix

2177

pop hl

2178

ret

2179

; input hl = variable address

2180

COPY_TO.DAC: ld de, BASIC_DAC

2181

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

2182

ld (BASIC_VALTYP), a

2183

inc hl

2184

inc hl

2185

inc hl

2186

ld bc, 8 ; data = 8 bytes

2187

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

2188

ret

2189

COPY_TO.ARG: ld de, BASIC_ARG ;

2190

jr COPY_TO.DAC.DATA ;

2191

COPY_TO.DAC_ARG: ld hl, BASIC_DAC ;

2192

ld de, BASIC_ARG ;

2193

ld bc, 8 ; data = 8 bytes

2194

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

2195

ret ;

2196

COPY_TO.ARG_DAC: ld hl, BASIC_ARG ;

2197

ld de, BASIC_DAC ;

2198

ld bc, 8 ; data = 8 bytes

2199

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

2200

ret ;

2201

COPY_TO.DAC_TMP: ld hl, BASIC_DAC ;

2202

ld de, BASIC_SWPTMP ;

2203

ld bc, 8 ; data = 8 bytes

2204

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

2205

ret ;

2206

COPY_TO.TMP_DAC: ld hl, BASIC_SWPTMP ;

2207

ld de, BASIC_DAC ;

2208

ld bc, 8 ; data = 8 bytes

2209

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

2210

ret ;

2211

SWAP.DAC.ARG: di

2212

exx ; save registers

2213

ld bc, 8 ;

2214

ld hl, BASIC_DAC ;

2215

ld de, BASIC_SWPTMP ;

2216

ldir ; copy bc bytes from hl to de

2217

ld bc, 8 ;

2218

ld hl, BASIC_ARG ;

2219

ld de, BASIC_DAC ;

2220

ldir ; copy bc bytes from hl to de

2221

ld bc, 8 ;

2222

ld hl, BASIC_SWPTMP ;

2223

ld de, BASIC_ARG ;

2224

ldir ; copy bc bytes from hl to de

2225

exx ; restore registers

2226

2227

ret ;

2228

CLEAR.DAC: ld de, BASIC_DAC

2229

CLEAR.DAC.DATA: ld hl, BASIC_VALTYP

2230

ld (hl), 2

2231

ld hl, LIT_NULL_DBL

2232

ld bc, 8 ; data = 8 bytes

2233

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

2234

ret

2235

CLEAR.ARG: ld de, BASIC_ARG

2236

jr CLEAR.DAC.DATA

2237

2238

2239

2240

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

2241

; MATH 16 BITS ROUTINES

2242

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

2243

2244

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

2245

ex af, af' ; save PC to temp

2246

pop.parm ; get first parameter

2247

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

2248

pop.parm ; get second parameter

2249

ex af, af' ; restore PC from temp

2250

push af ; put again PC from caller in stack

2251

ex af, af' ; restore 1st data type

2252

push af ; save 1st data type

2253

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

2254

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

2255

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

2256

ret z ; return if is equal data types

2257

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

2258

and 12 ; test if single/double

2259

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

2260

__call_bios MATH_FRCDBL ; convert DAC to double

2261

MATH.PARM.CST1: pop af ;

2262

and 12 ; test if single/double

2263

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

2264

ld (BASIC_VALTYP), a ;

2265

call COPY_TO.DAC_TMP ;

2266

call COPY_TO.ARG_DAC ;

2267

__call_bios MATH_FRCDBL ; convert ARG to double

2268

call COPY_TO.DAC_ARG ;

2269

call COPY_TO.TMP_DAC ;

2270

MATH.PARM.CST2: ld a, 8 ;

2271

ld (BASIC_VALTYP), a ;

2272

ret ;

2273

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

2274

pop af ; get PC from caller stack

2275

ex af, af' ; save PC to temp

2276

pop.parm ; get first parameter

2277

ld a, (hl) ; get parameter type

2278

and 2 ; test if integer

2279

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

2280

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

2281

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

2282

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

2283

__call_bios MATH_FRCINT ; convert DAC to int

2284

call COPY_TO.DAC_ARG ; copy DAC to ARG

2285

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

2286

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

2287

and 2 ; test if integer

2288

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

2289

__call_bios MATH_FRCINT ; convert DAC to int

2290

ld a, 2 ;

2291

ld (BASIC_VALTYP), a ;

2292

MATH.PARM.POP.I3:

2293

ex af, af' ; restore PC from temp

2294

push af ; put again PC from caller in stack

2295

ret ;

2296

MATH.PARM.PUSH: call COPY_TO.VAR_DUMMY ;

2297

ret.parm ;

2298

2299

if defined MATH.ADD

2300

2301

; input DAC, ARG

2302

; output in parm stack

2303

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

2304

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

2305

ld bc, (BASIC_ARG+2) ;

2306

add hl, bc ;

2307

ld (BASIC_DAC+2), hl ;

2308

jp MATH.PARM.PUSH ;

2309

2310

endif

2311

2312

if defined MATH.SUB or defined MATH.NEG

2313

2314

; input DAC, ARG

2315

; output in parm stack

2316

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

2317

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

2318

ld de, (BASIC_ARG+2) ;

2319

and a ; clear carry

2320

sbc hl, de ;

2321

ld (BASIC_DAC+2), hl ;

2322

jp MATH.PARM.PUSH ;

2323

2324

endif

2325

2326

if defined MATH.MULT

2327

2328

; input DAC, ARG

2329

; output in parm stack

2330

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

2331

ld bc, (BASIC_ARG+2) ;

2332

call MATH.MULT.16 ;

2333

ld (BASIC_DAC+2), hl ;

2334

jp MATH.PARM.PUSH ;

2335

2336

; input HL = multiplicand

2337

; input BC = multiplier

2338

; output HL = result

2339

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

2340

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

2341

ld c, b ; high multiplier

2342

ld b, 16

2343

ld d, h ; multiplicand

2344

ld e, l

2345

ld hl, 0

2346

MULT16LOOP: srl c ; right shift multiplier high

2347

rra ; rotate right multiplier low

2348

jr nc, MULT16NOADD ; test carry

2349

add hl, de ; add multiplicand to result

2350

MULT16NOADD: ex de, hl

2351

add hl, hl ; double - shift multiplicand

2352

ex de, hl

2353

djnz MULT16LOOP

2354

ret

2355

2356

endif

2357

2358

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

2359

2360

; input AC = dividend

2361

; input DE = divisor

2362

; output AC = quotient

2363

; output HL = remainder

2364

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

2365

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

2366

ld b, 16 ; set counter

2367

DIV16LOOP: rl c ; rotate accumulator result left

2368

rla

2369

adc hl, hl ; left shift

2370

sbc hl, de ; trial subtract divisor

2371

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

2372

add hl, de ; restore accumulator

2373

ccf ; calculate result bit

2374

djnz DIV16LOOP ; counter not zero

2375

rl c ; shift in last result bit

2376

rla

2377

ret

2378

2379

endif

2380

2381

if defined GFX_FAST or defined LINE

2382

2383

; compare two signed 16 bits integers

2384

; HL < DE: Carry flag

2385

; HL = DE: Zero flag

2386

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

2387

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

2388

and 0x80 ; test sign, clear carry

2389

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

2390

bit 7, d

2391

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

2392

ld a, h

2393

cp d ; signs are both positive, so normal compare

2394

ret nz

2395

ld a, l ; test low order byte

2396

cp e

2397

ret

2398

MATH.COMP.S16.NEGM1:

2399

xor d

2400

rla ; sign bit into carry

2401

ret c ; signs different

2402

ld a, h

2403

cp d ; both signs negative

2404

ret nz

2405

ld a, l

2406

cp e

2407

ret

2408

2409

endif

2410

2411

if defined MATH.ADD

2412

2413

MATH.ADD.SGL: ld a, 8 ;

2414

ld (BASIC_VALTYP), a ;

2415

MATH.ADD.DBL: __call_bios MATH_DECADD ;

2416

jp MATH.PARM.PUSH ;

2417

2418

endif

2419

2420

if defined MATH.SUB or defined MATH.NEG

2421

2422

MATH.SUB.SGL: ld a, 8 ;

2423

ld (BASIC_VALTYP), a ;

2424

MATH.SUB.DBL: __call_bios MATH_DECSUB ;

2425

jp MATH.PARM.PUSH ;

2426

2427

endif

2428

2429

if defined MATH.MULT

2430

2431

MATH.MULT.SGL: ld a, 8 ;

2432

ld (BASIC_VALTYP), a ;

2433

MATH.MULT.DBL: __call_bios MATH_DECMUL ;

2434

jp MATH.PARM.PUSH ;

2435

2436

endif

2437

2438

if defined MATH.DIV

2439

2440

; input DAC, ARG

2441

; output in parm stack

2442

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

2443

call SWAP.DAC.ARG ;

2444

ld a, 2 ;

2445

ld (BASIC_VALTYP), a ;

2446

__call_bios MATH_FRCDBL ; convert ARG to double

2447

call SWAP.DAC.ARG ;

2448

MATH.DIV.SGL: ld a, 8 ;

2449

ld (BASIC_VALTYP), a ;

2450

MATH.DIV.DBL: __call_bios MATH_DECDIV ;

2451

jp MATH.PARM.PUSH ;

2452

2453

endif

2454

2455

if defined MATH.IDIV

2456

2457

; input DAC, ARG

2458

; output in parm stack

2459

MATH.IDIV.SGL: ld a, 8 ;

2460

ld (BASIC_VALTYP), a ;

2461

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

2462

call SWAP.DAC.ARG ;

2463

ld a, 8 ;

2464

ld (BASIC_VALTYP), a ;

2465

__call_bios MATH_FRCINT ; convert ARG to integer

2466

call SWAP.DAC.ARG ;

2467

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

2468

ld a, h ;

2469

ld c, l ;

2470

ld de, (BASIC_ARG+2) ;

2471

call MATH.DIV.16 ;

2472

ld h, a ;

2473

ld l, c ;

2474

ld (BASIC_DAC+2), hl ; quotient

2475

jp MATH.PARM.PUSH ;

2476

2477

endif

2478

2479

if defined MATH.POW

2480

2481

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

2482

__call_bios MATH_FRCDBL ; convert DAC to double

2483

call SWAP.DAC.ARG ;

2484

ld a, 2 ;

2485

ld (BASIC_VALTYP), a ;

2486

__call_bios MATH_FRCDBL ; convert ARG to double

2487

call SWAP.DAC.ARG ;

2488

MATH.POW.SGL: ld a, 8 ;

2489

ld (BASIC_VALTYP), a ;

2490

MATH.POW.DBL: __call_bios MATH_DBLEXP ;

2491

jp MATH.PARM.PUSH ;

2492

2493

endif

2494

2495

if defined MATH.MOD

2496

2497

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

2498

; ld (BASIC_VALTYP), a ;

2499

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

2500

; call SWAP.DAC.ARG ;

2501

; ld a, 8 ;

2502

; ld (BASIC_VALTYP), a ;

2503

; __call_bios MATH_FRCINT ; convert ARG to integer

2504

; call SWAP.DAC.ARG ;

2505

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

2506

ld a, h ;

2507

ld c, l ;

2508

ld de, (BASIC_ARG+2) ;

2509

call MATH.DIV.16 ;

2510

ld (BASIC_DAC+2), hl ; remainder

2511

jp MATH.PARM.PUSH ;

2512

2513

endif

2514

2515

if defined ISQR

2516

2517

; fast 16-bit integer square root

2518

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

2519

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

2520

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

2521

; call with hl = number to square root

2522

; returns a = square root

2523

; corrupts hl, de

2524

2525

MATH.INT.SQR:

2526

ld a,h

2527

ld de,0B0C0h

2528

add a,e

2529

jr c,sq7

2530

ld a,h

2531

ld d,0F0h

2532

sq7:

2533

add a,d

2534

jr nc,sq6

2535

res 5,d

2536

db 254

2537

sq6:

2538

sub d

2539

sra d

2540

set 2,d

2541

add a,d

2542

jr nc,sq5

2543

res 3,d

2544

db 254

2545

sq5:

2546

sub d

2547

sra d

2548

inc d

2549

add a,d

2550

jr nc,sq4

2551

res 1,d

2552

db 254

2553

sq4:

2554

sub d

2555

sra d

2556

ld h,a

2557

add hl,de

2558

jr nc,sq3

2559

ld e,040h

2560

db 210

2561

sq3:

2562

sbc hl,de

2563

sra d

2564

ld a,e

2565

rra

2566

or 010h

2567

ld e,a

2568

add hl,de

2569

jr nc,sq2

2570

and 0DFh

2571

db 218

2572

sq2:

2573

sbc hl,de

2574

sra d

2575

rra

2576

or 04h

2577

ld e,a

2578

add hl,de

2579

jr nc,sq1

2580

and 0F7h

2581

db 218

2582

sq1:

2583

sbc hl,de

2584

sra d

2585

rra

2586

inc a

2587

ld e,a

2588

add hl,de

2589

jr nc,sq0

2590

and 0FDh

2591

sq0:

2592

sra d

2593

rra

2594

cpl

2595

ret

2596

2597

endif

2598

2599

if defined RANDOMIZE or defined SEED

2600

2601

MATH.RANDOMIZE: di ;

2602

ld bc, (BIOS_JIFFY) ;

2603

ei ;

2604

2605

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

2606

push bc ; in bc = new integer seed

2607

call CLEAR.DAC ;

2608

pop bc ;

2609

;ld ix, BASIC_DAC ;

2610

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

2611

ld a, 2 ; type integer

2612

ld (BASIC_VALTYP), a ;

2613

__call_bios MATH_FRCDBL ; convert DAC integer to DAC double

2614

__call_bios MATH_NEG ; DAC = -DAC

2615

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

2616

ret ;

2617

2618

endif

2619

2620

MATH.ERROR: ld e, 13 ; type mismatch

2621

__call_basic BASIC_ERROR_HANDLER ;

2622

ret

2623

2624

2625

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

2626

; BOOLEAN ROUTINES

2627

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

2628

2629

BOOLEAN.RET.TRUE: ld hl, LIT_TRUE ;

2630

ret.parm ;

2631

BOOLEAN.RET.FALSE: ld hl, LIT_FALSE ;

2632

ret.parm ;

2633

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

2634

ld de, (BASIC_ARG+2) ;

2635

__call_bios MATH_ICOMP ;

2636

ret ;

2637

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

2638

ld de, (BASIC_ARG+2) ;

2639

__call_bios MATH_DCOMP ;

2640

ret ;

2641

BOOLEAN.CMP.DBL: __call_bios MATH_XDCOMP ;

2642

ret ;

2643

BOOLEAN.CMP.STR: call STRING.COMPARE ;

2644

ret ;

2645

2646

if defined BOOLEAN.GT

2647

2648

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

2649

jr BOOLEAN.GT.RET ;

2650

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

2651

jr BOOLEAN.GT.RET ;

2652

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

2653

jr BOOLEAN.GT.RET ;

2654

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

2655

jr BOOLEAN.GT.RET ;

2656

BOOLEAN.GT.RET: cp 0x01 ;

2657

jp z, BOOLEAN.RET.TRUE ;

2658

jp BOOLEAN.RET.FALSE ;

2659

endif

2660

2661

if defined BOOLEAN.LT

2662

2663

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

2664

jr BOOLEAN.LT.RET ;

2665

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

2666

jr BOOLEAN.LT.RET ;

2667

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

2668

jr BOOLEAN.LT.RET ;

2669

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

2670

jr BOOLEAN.LT.RET ;

2671

BOOLEAN.LT.RET: cp 0xFF ;

2672

jp z, BOOLEAN.RET.TRUE ;

2673

jp BOOLEAN.RET.FALSE ;

2674

2675

endif

2676

2677

if defined BOOLEAN.GE

2678

2679

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

2680

jr BOOLEAN.GE.RET ;

2681

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

2682

jr BOOLEAN.GE.RET ;

2683

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

2684

jr BOOLEAN.GE.RET ;

2685

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

2686

jr BOOLEAN.GE.RET ;

2687

BOOLEAN.GE.RET: cp 0x01 ;

2688

jp z, BOOLEAN.RET.TRUE ;

2689

or a ; cp 0

2690

jp z, BOOLEAN.RET.TRUE ;

2691

jp BOOLEAN.RET.FALSE ;

2692

2693

endif

2694

2695

if defined BOOLEAN.LE

2696

2697

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

2698

jr BOOLEAN.LE.RET ;

2699

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

2700

jr BOOLEAN.LE.RET ;

2701

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

2702

jr BOOLEAN.LE.RET ;

2703

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

2704

jr BOOLEAN.LE.RET ;

2705

BOOLEAN.LE.RET: cp 0xFF ;

2706

jp z, BOOLEAN.RET.TRUE ;

2707

or a ; cp 0

2708

jp z, BOOLEAN.RET.TRUE ;

2709

jp BOOLEAN.RET.FALSE ;

2710

2711

endif

2712

2713

if defined BOOLEAN.NE

2714

2715

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

2716

jr BOOLEAN.NE.RET ;

2717

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

2718

jr BOOLEAN.NE.RET ;

2719

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

2720

jr BOOLEAN.NE.RET ;

2721

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

2722

jr BOOLEAN.NE.RET ;

2723

BOOLEAN.NE.RET: or a ; cp 0

2724

jp nz, BOOLEAN.RET.TRUE ;

2725

jp BOOLEAN.RET.FALSE ;

2726

2727

endif

2728

2729

if defined BOOLEAN.EQ

2730

2731

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

2732

jr BOOLEAN.EQ.RET ;

2733

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

2734

jr BOOLEAN.EQ.RET ;

2735

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

2736

jr BOOLEAN.EQ.RET ;

2737

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

2738

jr BOOLEAN.EQ.RET ;

2739

BOOLEAN.EQ.RET: or a ; cp 0

2740

jp z, BOOLEAN.RET.TRUE ;

2741

jp BOOLEAN.RET.FALSE ;

2742

2743

endif

2744

2745

if defined BOOLEAN.AND

2746

2747

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

2748

ld hl, BASIC_ARG+2 ;

2749

and (hl) ;

2750

ld (BASIC_DAC+2), a ;

2751

inc hl ;

2752

ld a, (BASIC_DAC+3) ;

2753

and (hl) ;

2754

ld (BASIC_DAC+3), a ;

2755

ld a, 2 ;

2756

jp MATH.PARM.PUSH ;

2757

2758

endif

2759

2760

if defined BOOLEAN.OR

2761

2762

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

2763

ld hl, BASIC_ARG+2 ;

2764

or (hl) ;

2765

ld (BASIC_DAC+2), a ;

2766

inc hl ;

2767

ld a, (BASIC_DAC+3) ;

2768

or (hl) ;

2769

ld (BASIC_DAC+3), a ;

2770

ld a, 2 ;

2771

jp MATH.PARM.PUSH ;

2772

2773

endif

2774

2775

if defined BOOLEAN.XOR

2776

2777

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

2778

ld hl, BASIC_ARG+2 ;

2779

xor (hl) ;

2780

ld (BASIC_DAC+2), a ;

2781

inc hl ;

2782

ld a, (BASIC_DAC+3) ;

2783

xor (hl) ;

2784

ld (BASIC_DAC+3), a ;

2785

ld a, 2 ;

2786

jp MATH.PARM.PUSH ;

2787

2788

endif

2789

2790

if defined BOOLEAN.EQV

2791

2792

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

2793

ld hl, BASIC_ARG+2 ;

2794

xor (hl) ;

2795

cpl ;

2796

ld (BASIC_DAC+2), a ;

2797

inc hl ;

2798

ld a, (BASIC_DAC+3) ;

2799

xor (hl) ;

2800

cpl ;

2801

ld (BASIC_DAC+3), a ;

2802

ld a, 2 ;

2803

jp MATH.PARM.PUSH ;

2804

2805

endif

2806

2807

if defined BOOLEAN.IMP

2808

2809

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

2810

ld hl, BASIC_ARG+2 ;

2811

cpl ;

2812

or (hl) ;

2813

ld (BASIC_DAC+2), a ;

2814

inc hl ;

2815

ld a, (BASIC_DAC+3) ;

2816

cpl ;

2817

or (hl) ;

2818

ld (BASIC_DAC+3), a ;

2819

ld a, 2 ;

2820

jp MATH.PARM.PUSH ;

2821

2822

endif

2823

2824

if defined BOOLEAN.SHR

2825

2826

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

2827

ld a, (BASIC_ARG+2) ;

2828

or a ; clear carry

2829

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

2830

ld b, a ; shift count

2831

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

2832

rr (ix) ;

2833

or a ; clear carry

2834

djnz BOOLEAN.SHR.INT.N ; next shift

2835

ld a, 2 ;

2836

jp MATH.PARM.PUSH ; return DAC

2837

2838

endif

2839

2840

if defined BOOLEAN.SHL

2841

2842

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

2843

ld a, (BASIC_ARG+2) ;

2844

or a ; clear carry

2845

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

2846

ld b, a ; shift count

2847

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

2848

rl (ix+1) ;

2849

or a ; clear carry

2850

djnz BOOLEAN.SHL.INT.N ; next shift

2851

ld a, 2 ;

2852

jp MATH.PARM.PUSH ; return DAC

2853

2854

endif

2855

2856

if defined BOOLEAN.NOT

2857

2858

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

2859

cpl ;

2860

ld (BASIC_DAC+2), a ;

2861

ld a, (BASIC_DAC+3) ;

2862

cpl ;

2863

ld (BASIC_DAC+3), a ;

2864

ld a, 2 ;

2865

jp MATH.PARM.PUSH ;

2866

2867

endif

2868

2869

2870

2871

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

2872

; MEMORY ALLOCATION ROUTINES

2873

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

2874

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

2875

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

2876

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

2877

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

2878

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

2879

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

2880

block.next: equ 0 ; next free block address

2881

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

2882

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

2883

2884

;; init

2885

memory.init:

2886

ld ix,memory.heap_start ; first block

2887

ld hl,memory.heap_start+block ; second block

2888

;; first block NEXT=secondblock, SIZE=0

2889

;; with this block we have a fixed start location

2890

;; because never will be allocated

2891

ld (ix+block.next),l

2892

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

2893

ld (ix+block.size),0

2894

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

2895

;; second block NEXT=0, SIZE=all

2896

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

2897

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

2898

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

2899

xor a

2900

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

2901

ld (BIOS_TEMP), sp

2902

ld hl, (BIOS_TEMP)

2903

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

2904

sbc hl,de

2905

;ld de, block * 2 + 100

2906

;sbc hl, de

2907

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

2908

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

2909

ret

2910

2911

;; alloc

2912

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

2913

memory.alloc:

2914

ld hl,block

2915

add hl,bc

2916

;push hl

2917

;pop bc

2918

ld b, h

2919

ld c, l

2920

ld ix,memory.heap_start ; this

2921

ld iy,0 ; prev

2922

memory.alloc.find:

2923

ld l,(ix+block.size)

2924

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

2925

xor a

2926

sbc hl,bc

2927

jp z, memory.alloc.exactfit

2928

jp c, memory.alloc.nextblock

2929

;; split found block

2930

memory.alloc.splitfit:

2931

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

2932

or h

2933

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

2934

ld a, l

2935

cp 4

2936

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

2937

memory.alloc.splitfit.do:

2938

;; newfreeblock = this + BC

2939

push ix

2940

pop hl

2941

add hl,bc

2942

;; prevblock->next = newfreeblock

2943

ld (iy+block.next),l

2944

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

2945

;; newfreeblock->next = this->next

2946

push hl

2947

pop iy ; iy = newfreeblock

2948

ld l,(ix+block.next)

2949

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

2950

ld (iy+block.next),l

2951

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

2952

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

2953

ld l,(ix+block.size)

2954

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

2955

xor a

2956

sbc hl,bc

2957

ld (iy+block.size),l

2958

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

2959

;; this->size = BC

2960

ld (ix+block.size),c

2961

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

2962

jr memory.alloc.ok

2963

;; use whole found block

2964

memory.alloc.exactfit:

2965

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

2966

ld l,(ix+block.next)

2967

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

2968

ld (iy+block.next),l

2969

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

2970

memory.alloc.ok:

2971

;; ix = first byte

2972

ld de,block

2973

add ix,de

2974

;; enable z-flag

2975

ld a,1

2976

or a

2977

ret

2978

memory.alloc.nextblock:

2979

ld l,(ix+block.next)

2980

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

2981

ld a,l

2982

cp h

2983

ret z

2984

;; prevblock = this

2985

push ix

2986

pop iy

2987

;; this = this->next

2988

push hl

2989

pop ix

2990

jp memory.alloc.find

2991

2992

;; free

2993

;; IN IX=memptr

2994

memory.free:

2995

;; HL = IX - block_header_size

2996

push ix

2997

pop hl

2998

ld de, block

2999

xor a

3000

sbc hl,de

3001

;; start of search

3002

ld ix,memory.heap_start

3003

memory.free.find:

3004

ld e,(ix+block.next)

3005

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

3006

ld a,d

3007

or e

3008

jp z, memory.free.passedend

3009

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

3010

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

3011

add hl,de ; restore hl value

3012

push de

3013

pop ix ; current = next

3014

jr memory.free.find

3015

3016

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

3017

memory.free.found:

3018

add hl,de ; restore hl value

3019

ld (ix+block.next), l

3020

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

3021

push hl

3022

pop iy

3023

ld (iy+block.next), e

3024

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

3025

push ix ; prev x this

3026

pop iy

3027

push hl

3028

pop ix

3029

push de

3030

call memory.free.coalesce

3031

pop ix ; this x next

3032

jr memory.free.coalesce

3033

3034

;; parm1 = *next

3035

;; parm2 = *this

3036

memory.free.coalesce:

3037

ld c, (iy+block.size)

3038

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

3039

push iy

3040

pop hl

3041

xor a

3042

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

3043

push ix

3044

pop de

3045

xor a

3046

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

3047

jr z, memory.free.coalesce.do

3048

push ix ; else, new *this = *next

3049

pop iy

3050

ret

3051

memory.free.coalesce.do:

3052

ld l, (ix+block.size)

3053

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

3054

xor a

3055

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

3056

ld (iy+block.size), l

3057

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

3058

ld l, (ix+block.next)

3059

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

3060

ld (iy+block.next), l

3061

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

3062

ret

3063

3064

memory.free.passedend:

3065

;; append block at the end of the free list

3066

ld (ix+block.next),l

3067

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

3068

push hl

3069

pop iy

3070

ld (iy+block.next),0

3071

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

3072

ret

3073

3074

;; get_free

3075

;; OUT BC=freespace

3076

memory.get_free:

3077

ld ix,memory.heap_start

3078

ld bc,0

3079

memory.get_free.count:

3080

ld a,c

3081

add a,(ix+block.size)

3082

ld c,a

3083

ld a,b

3084

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

3085

ld b,a

3086

ld l,(ix+block.next)

3087

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

3088

ld a,h

3089

or l

3090

ret z

3091

push hl

3092

pop ix

3093

jr memory.get_free.count

3094

3095

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

3096

__call_basic BASIC_ERROR_HANDLER ;

3097

ret

3098

3099

3100

3101

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

3102

; GRAPHICS LIBRARY

3103

; By: Amaury Carvalho, 2019

3104

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

3105

; References:

3106

; https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm#Algorithm_for_integer_arithmetic

3107

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

3108

; https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#C

3109

; https://www.msx.org/wiki/MSX-BASIC_Instructions

3110

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

3111

3112

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

3113

; Bios functions

3114

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

3115

3116

BIOS_WRTVDP: EQU 0x0047

3117

BIOS_RDVRM: EQU 0x004A

3118

BIOS_WRTVRM: EQU 0x004D

3119

BIOS_LDIRVM: EQU 0x005C

3120

BIOS_LDIRMV: EQU 0x0059

3121

BIOS_PNTINI: EQU 0x18CF

3122

BIOS_RIGHTC: EQU 0x16C5 ; Move current pixel physical address right

3123

BIOS_TRIGHTC: EQU 0x16AC ; Test then RIGHTC if legal

3124

BIOS_LEFTC: EQU 0x16EE ; Move current pixel physical address left

3125

BIOS_TLEFTC: EQU 0x16D8 ; Test then LEFTC if legal

3126

BIOS_UPC: EQU 0x175D ; Move current pixel physical address up

3127

BIOS_TUPC: EQU 0x173C ; Test then UPC if legal

3128

BIOS_DOWNC: EQU 0x172A ; Move current pixel physical address down

3129

BIOS_TDOWNC: EQU 0x170A ; Test then DOWNC if legal

3130

BIOS_DCOMPR: EQU 0x146A ; compare HL and DE (Flag NC if HL>DE, Flag Z if HL=DE, Flag C if HL<DE)

3131

BIOS_FILVRM: EQU 0x0056 ; fill VRAM with value

3132

3133

BIOS_BIGFIL: EQU 0x016B ; msx 2

3134

BIOS_NRDVRM: EQU 0x0174 ; msx 2

3135

BIOS_NWRVRM: EQU 0x0177 ; msx 2

3136

BIOS_NRDVDP: EQU 0x013E ; msx 2

3137

BIOS_VDPSTA: EQU 0x0131 ; msx 2

3138

BIOS_NWRVDP: EQU 0x012D ; msx 2 (0x0647)

3139

3140

BASIC_SUB_LINE: equ 0x58fc

3141

BASIC_SUB_LINEBOX: equ 0x5912

3142

BASIC_SUB_LINEBOXFILLED: equ 0x58C1

3143

BASIC_SUB_CIRCLE: equ 0x5B19

3144

BASIC_SUB_PAINT1: equ 0x59DA ;0x59C8

3145

BASIC_SUB_PAINT2: equ 0x0069 ;0x2664 ;0x2651+3

3146

3147

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

3148

; Work areas

3149

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

3150

3151

BIOS_RG0SAV: EQU 0xF3DF

3152

BIOS_RG1SAV: EQU 0xF3E0

3153

BIOS_RG8SAV: EQU 0xFFE7

3154

BIOS_BDRATR: EQU 0xFCB2

3155

BIOS_STATFL: EQU 0xF3E7 ; VDP status register

3156

3157

BIOS_CXOFF: EQU 0xF945

3158

BIOS_CYOFF: EQU 0xF947

3159

BIOS_GXPOS: EQU 0xFCB3

3160

BIOS_GYPOS: EQU 0xFCB5

3161

3162

BIOS_GRPNAM: EQU 0xF3C7 ; pattern name table

3163

BIOS_GRPCOL: EQU 0xF3C9 ; colour table

3164

BIOS_GRPCGP: EQU 0xF3CB ; pattern generator table

3165

BIOS_GRPATR: EQU 0xF3CD ; sprite attribute table

3166

BIOS_GRPPAT: EQU 0xF3CF ; sprite generator table

3167

BIOS_CGPNT: EQU 0xF920 ; 2 - current MSX Font location (0x1BBF)

3168

BIOS_ATRBAS: EQU 0xF928 ; sprite attribute table

3169

3170

BIOS_MLTNAM: EQU 0xF3D1 ; pattern name table (screen 3, multicolor)

3171

BIOS_MLTCOL: EQU 0xF3D3 ; colour table (screen 3, multicolor)

3172

BIOS_MLTCGP: EQU 0xF3D5 ; pattern generator table (screen 3, multicolor)

3173

BIOS_MLTATR: EQU 0xF3D7 ; sprite attribute table (screen 3, multicolor)

3174

BIOS_MLTPAT: EQU 0xF3D9 ; sprite generator table (screen 3, multicolor)

3175

3176

BIOS_ASPECT: equ 0xF931 ;2 Aspect ratio of the circle; set by <ratio> of CIRCLE.

3177

BIOS_CENCNT: equ 0xF933 ;2 Counter used by CIRCLE.

3178

BIOS_CLINEF: equ 0xF935 ;1 Flag to draw line to centre, Used set by CIRCLE

3179

BIOS_CNPNTS: equ 0xF936 ;2 Point to be plottted in a 45° segment, Used set by CIRCLE

3180

BIOS_CPLOTF: equ 0xF938 ;1 Plot polarity flag, Used set by CIRCLE

3181

BIOS_CPCNT: equ 0xF939 ;2 Number of points in 1/8 of circle, Used set by CIRCLE.

3182

BIOS_CPCNT8: equ 0xF93B ;2 Number of points in the circle. Used by CIRCLE.

3183

BIOS_CRCSUM: equ 0xF93D ;2 Cyclic redundancy check sum of the circle. Used by CIRCLE.

3184

BIOS_CSTCNT: equ 0xF93F ;2 Variable to maintain the number of points of the starting angle. Used by the instruction CIRCLE

3185

BIOS_CSCLXY: equ 0xF941 ;1 Scale of X & Y. Used by the instruction CIRCLE

3186

BIOS_ASPCT1: equ 0xF40B ;2 256/aspect ratio for Basic instruction CIRCLE.

3187

BIOS_ASPCT2: equ 0xF40D ;2 256*aspect ratio for Basic instruction CIRCLE.

3188

BIOS_MAXUPD: equ 0xF3EC ;3 Work area used by the instruction CIRCLE, contains JP 0000h at start.

3189

BIOS_MINUPD: equ 0xF3EF ;3 Work area used by the instruction CIRCLE, contains JP 0000h at start.

3190

3191

BIOS_PARM1: EQU 0xF6E8 ; 100

3192

BIOS_PARM2: EQU 0xF750 ; 100

3193

3194

GFX_TEMP: EQU BIOS_PARM1 ; 2

3195

GFX_TEMP1: EQU GFX_TEMP + 2 ; 2

3196

GFX_TEMP2: EQU GFX_TEMP1 + 2 ; 2

3197

GFX_TEMP3: EQU GFX_TEMP2 + 2 ; 2

3198

GFX_TEMP4: EQU GFX_TEMP3 + 2 ; 2

3199

GFX_TEMP5: EQU GFX_TEMP4 + 2 ; 2

3200

GFX_TEMP6: EQU GFX_TEMP5 + 2 ; 2

3201

GFX_TEMP7: EQU GFX_TEMP6 + 2 ; 2

3202

GFX_TEMP8: EQU GFX_TEMP7 + 2 ; 2

3203

GFX_TEMP9: EQU GFX_TEMP8 + 2 ; 2

3204

3205

GFX_MAX_X: EQU 0xFCA4 ; 1 (CASSETE LOWLIM)

3206

GFX_MAX_Y: EQU 0xFCA5 ; 1 (CASSETE WINWID)

3207

3208

GFX_SPRITE_FLAGS: EQU 0xF40A ; 1 (CASSETE HEADER) - bits 0=check screen limits, 1=check walls, 2=check hotspots,

3209

; 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

3210

GFX_SPRITE_SIZE_DAT: EQU 0xF3FC ; 1 (CASSETE CS1200)

3211

GFX_SPRITE_SIZE_SCR: EQU 0xF3FD ; 1

3212

GFX_SPRITE_WALLS: EQU 0xF406 ; 2 (CASSETE LOW)

3213

GFX_SPRITE_HOTSPOTS: EQU 0xF408 ; 2 (CASSETE HIGH)

3214

GFX_SPRITE_HOTSPOT_TILE: EQU 0xF405 ; 1 (CASSETE CS2400)

3215

GFX_SPRITE_COLLIDER: EQU 0xF400 ; 1 (CASSETE CS1200)

3216

GFX_SPRITE_COLLISION: EQU 0xF7B5 ; 2 (ARYTA2)

3217

3218

GFX_MUSIC_START: EQU 0xF401 ; 2 (CASSETE CS2400)

3219

GFX_MUSIC_NEXT: EQU 0xF403 ; 2

3220

GFX_MUSIC_PREV: EQU 0xF74C ; 2 (PRMPRV)

3221

3222

GFX_TEMP10: EQU 0xF3FE ; 2 (CASSETE CS1200)

3223

3224

;BIOS_SCR_SIZE_X: dw 240, 256, 256, 64, 256, 256, 512, 512, 256, 512, 256, 256, 256

3225

;BIOS_SCR_SIZE_Y: dw 192, 192, 192, 48, 192, 212, 212, 212, 212, 384, 212, 212, 212

3226

BIOS_SCR_SIZE_X: db 239, 255, 255, 63, 255, 255, 255, 255, 255, 255, 255, 255, 255

3227

BIOS_SCR_SIZE_Y: db 191, 191, 191, 47, 191, 211, 211, 211, 211, 255, 211, 211, 211

3228

3229

3230

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

3231

; gfxIsScreenModeMSX2

3232

; return if screen mode is from MSX 2

3233

; out C is set, if MSX2 and screen mode above 3

3234

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

3235

3236

gfxIsScreenModeMSX2:

3237

ld a, (BIOS_VERSION)

3238

or 0

3239

jp nz, BIOS_CHKNEW ; if not MSX1, jump to CHKNEW

3240

scf

3241

ret

3242

3243

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

3244

; gfxSetScreenMode

3245

; set current screen mode

3246

; in A = screen number

3247

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

3248

3249

gfxSetScreenMode:

3250

push af

3251

call gfxInitScreenWorkspace

3252

xor a

3253

ld a, (BIOS_VERSION)

3254

or 0

3255

jr nz, gfxSetScreenMode.1 ; if not MSX1, jump

3256

pop af

3257

cp 4

3258

call nc, gfxSetScreenMode.0 ; if screen mode >= 4, change to screen 2

3259

__call_bios BIOS_CHGMOD ; change the screen mode (msx1)

3260

jr gfxSetScreenMode.2

3261

3262

gfxSetScreenMode.0:

3263

ld a, 2

3264

ret

3265

3266

gfxSetScreenMode.1:

3267

pop af

3268

ld ix, BIOS_CHGMOD2 ; change the screen mode (msx2)

3269

call BIOS_EXTROM

3270

3271

gfxSetScreenMode.2:

3272

call gfxGetScreenHeight

3273

call gfxGetScreenWidth

3274

call gfxGetSpriteSize

3275

jp gfxFillSpriteCollisionTable

3276

3277

gfxInitScreenWorkspace:

3278

ld a, 1

3279

ld (GFX_SPRITE_FLAGS), a ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

3280

xor a

3281

ld (GFX_SPRITE_WALLS), a

3282

ld (GFX_SPRITE_WALLS+1), a

3283

ld (GFX_SPRITE_HOTSPOTS), a

3284

ld (GFX_SPRITE_HOTSPOTS+1), a

3285

ld (GFX_MUSIC_START), a

3286

ld (GFX_MUSIC_START+1), a

3287

ld (GFX_MUSIC_NEXT), a

3288

ld (GFX_MUSIC_NEXT+1), a

3289

ld (GFX_MUSIC_PREV), a

3290

ld (GFX_MUSIC_PREV+1), a

3291

ld (GFX_SPRITE_HOTSPOT_TILE), a

3292

ld (GFX_SPRITE_COLLIDER), a

3293

ret

3294

3295

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

3296

; gfxGetScreenMode

3297

; return current screen mode

3298

; out A = screen number (0=40x24 Text Mode, 1=32x24 Text Mode, 2=Graphics Mode, 3=Multicolour Mode)

3299

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

3300

3301

gfxGetScreenMode:

3302

ld a, (BIOS_SCRMOD)

3303

ret

3304

3305

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

3306

; gfxSetXY

3307

; set current screen location

3308

; in BC = x

3309

; DE = y

3310

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

3311

3312

gfxSetXY:

3313

ld (BIOS_GRPACX), bc ; x

3314

;ld (BIOS_GXPOS), bc

3315

ld (BIOS_GRPACY), de ; y

3316

;ld (BIOS_GYPOS), de

3317

jr gfxRefreshXY.1

3318

3319

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

3320

; gfxRefreshXY

3321

; refresh current screen location

3322

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

3323

3324

gfxRefreshXY:

3325

ld bc, (BIOS_GRPACX) ; x

3326

ld de, (BIOS_GRPACY) ; y

3327

gfxRefreshXY.1:

3328

call gfxIsScreenModeMSX2

3329

jr nc, gfxRefreshXY.2 ; if MSX2 and screen mode above 3

3330

__call_bios BIOS_SCALXY ; BC = X, DE = Y

3331

__call_bios BIOS_MAPXYC ; in BC = X, DE = Y

3332

ret

3333

gfxRefreshXY.2:

3334

ld ix, BIOS_SCALXY2 ; BC = X, DE = Y

3335

call BIOS_EXTROM

3336

ld ix, BIOS_MAPXYC2 ; in BC = X, DE = Y

3337

jp BIOS_EXTROM

3338

3339

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

3340

; gfxGetXY

3341

; get current screen location

3342

; out BC = x

3343

; DE = y

3344

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

3345

3346

gfxGetXY:

3347

ld bc, (BIOS_GRPACX) ; x

3348

ld de, (BIOS_GRPACY) ; y

3349

ret

3350

3351

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

3352

; gfxGetScreenHeight

3353

; get screen height

3354

; out a = screen height

3355

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

3356

3357

gfxGetScreenHeight:

3358

push hl

3359

push de

3360

ld hl, BIOS_SCR_SIZE_Y

3361

ld a, (BIOS_SCRMOD)

3362

ld d, 0

3363

ld e, a

3364

add hl, de

3365

ld a, (hl)

3366

ld (GFX_MAX_Y), a

3367

pop de

3368

pop hl

3369

ret

3370

3371

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

3372

; gfxGetScreenWidth

3373

; get screen width

3374

; out a = screen height

3375

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

3376

3377

gfxGetScreenWidth:

3378

push hl

3379

push de

3380

ld hl, BIOS_SCR_SIZE_X

3381

ld a, (BIOS_SCRMOD)

3382

ld d, 0

3383

ld e, a

3384

add hl, de

3385

ld a, (hl)

3386

ld (GFX_MAX_X), a

3387

pop de

3388

pop hl

3389

ret

3390

3391

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

3392

; gfxGetSpriteSize

3393

; get sprite data size

3394

; out a = sprite data size

3395

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

3396

3397

gfxGetSpriteSize:

3398

push bc

3399

ld bc, 0x0808

3400

ld a, (BIOS_RG1SAV) ; bit 0 = double size, bit 1 = sprite size (0=8 pixels, 1=16 pixels)

3401

bit 1, a

3402

jr z, gfxGetSpriteSize.1

3403

ld bc, 0x1010

3404

3405

gfxGetSpriteSize.1:

3406

bit 0, a

3407

jr z, gfxGetSpriteSize.2

3408

sll b

3409

3410

gfxGetSpriteSize.2:

3411

ld (GFX_SPRITE_SIZE_DAT), bc

3412

ld a, c

3413

pop bc

3414

ret

3415

3416

3417

if defined GFX_FAST and defined PAINT

3418

3419

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

3420

; gfxUp

3421

; move screen current location up

3422

; out: carry if off screen

3423

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

3424

3425

gfxUp:

3426

push bc

3427

ld hl, 0

3428

ld de, (BIOS_GRPACY)

3429

or a

3430

sbc hl, de

3431

jr z, gfxUp.1

3432

dec de

3433

ld (BIOS_GRPACY), de

3434

call gfxRefreshXY

3435

scf

3436

ccf

3437

jr gfxUp.2

3438

gfxUp.1:

3439

scf

3440

gfxUp.2:

3441

pop bc

3442

ret

3443

3444

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

3445

; gfxDown

3446

; move screen current location down

3447

; out: carry if off screen

3448

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

3449

3450

gfxDown:

3451

push bc

3452

ld a, (GFX_MAX_Y)

3453

ld l, a

3454

ld h, 0

3455

ld de, (BIOS_GRPACY)

3456

or a

3457

sbc hl, de

3458

jr z, gfxDown.1

3459

inc de

3460

ld (BIOS_GRPACY), de

3461

call gfxRefreshXY

3462

scf

3463

ccf

3464

jr gfxDown.2

3465

gfxDown.1:

3466

scf

3467

gfxDown.2:

3468

pop bc

3469

ret

3470

3471

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

3472

; gfxLeft

3473

; move screen current location left

3474

; out: carry if off screen

3475

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

3476

3477

gfxLeft:

3478

push bc

3479

ld hl, 0

3480

ld de, (BIOS_GRPACX)

3481

or a

3482

sbc hl, de

3483

jr z, gfxLeft.1

3484

dec de

3485

ld (BIOS_GRPACX), de

3486

call gfxRefreshXY

3487

scf

3488

ccf

3489

jr gfxLeft.2

3490

gfxLeft.1:

3491

scf

3492

gfxLeft.2:

3493

pop bc

3494

ret

3495

3496

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

3497

; gfxRight

3498

; move screen current location right

3499

; out: carry if off screen

3500

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

3501

3502

gfxRight:

3503

push bc

3504

ld a, (GFX_MAX_X)

3505

ld l, a

3506

ld h, 0

3507

ld de, (BIOS_GRPACX)

3508

or a

3509

sbc hl, de

3510

jr z, gfxRight.1

3511

inc de

3512

ld (BIOS_GRPACX), de

3513

call gfxRefreshXY

3514

scf

3515

ccf

3516

jr gfxRight.2

3517

gfxRight.1:

3518

scf

3519

gfxRight.2:

3520

pop bc

3521

ret

3522

3523

endif

3524

3525

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

3526

; gfxPushXY

3527

; push current screen location

3528

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

3529

3530

gfxPushXY:

3531

3532

pop ix

3533

ld iy, (BIOS_GRPACX) ; x

3534

push iy

3535

ld iy, (BIOS_GRPACY) ; y

3536

push iy

3537

push ix

3538

3539

ret

3540

3541

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

3542

; gfxPopXY

3543

; pop current screen location

3544

; out BC = x

3545

; DE = y

3546

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

3547

3548

gfxPopXY:

3549

pop ix

3550

pop de ; y

3551

pop bc ; x

3552

push ix

3553

jp gfxSetXY

3554

3555

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

3556

; gfxSetForeColor

3557

; set current foreground color

3558

; A = color

3559

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

3560

3561

gfxSetForeColor:

3562

ld (BIOS_FORCLR), a ; foreground color

3563

ld (BIOS_ATRBYT), a

3564

ret

3565

3566

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

3567

; gfxGetForeColor

3568

; get current foreground color

3569

; out A = color

3570

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

3571

3572

gfxGetForeColor:

3573

ld a, (BIOS_FORCLR) ; foreground color

3574

ret

3575

3576

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

3577

; gfxSetBackColor

3578

; set current background color

3579

; A = color

3580

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

3581

3582

gfxSetBackColor:

3583

ld (BIOS_BAKCLR), a ; foreground color

3584

ret

3585

3586

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

3587

; gfxGetBackColor

3588

; get current background color

3589

; out A = color

3590

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

3591

3592

gfxGetBackColor:

3593

ld a, (BIOS_BAKCLR) ; foreground color

3594

ret

3595

3596

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

3597

; gfxSetBorderColor

3598

; set current border color

3599

; A = color

3600

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

3601

3602

gfxSetBorderColor:

3603

ld (BIOS_BDRCLR), a ; border color

3604

ret

3605

3606

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

3607

; gfxGetBorderColor

3608

; get current border color

3609

; out A = color

3610

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

3611

3612

gfxGetBorderColor:

3613

ld a, (BIOS_BDRCLR) ; border color

3614

ret

3615

3616

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

3617

; gfxSetBorderFill

3618

; set fill border color

3619

; A = color

3620

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

3621

3622

gfxSetBorderFill:

3623

ld (BIOS_BDRATR), a ; border color

3624

ret

3625

3626

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

3627

; gfxGetBorderFill

3628

; get fill border color

3629

; out A = color

3630

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

3631

3632

gfxGetBorderFill:

3633

ld a, (BIOS_BDRATR) ; border color

3634

ret

3635

3636

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

3637

; gfxSetColor

3638

; set current color (foreground, background and border)

3639

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

3640

3641

gfxSetColor:

3642

ld a, (BIOS_SCRMOD)

3643

bit 3, a

3644

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

3645

bit 2, a

3646

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

3647

jp BIOS_CHGCLR ; change VDP colors

3648

; __call_bios BIOS_SETATR ; change the pixel color

3649

;ret

3650

3651

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

3652

; gfxSetPixel

3653

; set pixel in current position to current foreground color

3654

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

3655

3656

gfxSetPixel:

3657

call gfxIsScreenModeMSX2

3658

jr nc, gfxSetPixel.1 ; if MSX2 and screen mode above 3

3659

__call_bios BIOS_SETC

3660

ret

3661

gfxSetPixel.1:

3662

ld ix, BIOS_SETC2

3663

jp BIOS_EXTROM

3664

3665

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

3666

; gfxGetPixel

3667

; get pixel color in current position

3668

; out A = pixel color

3669

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

3670

3671

gfxGetPixel:

3672

call gfxIsScreenModeMSX2

3673

jr nc, gfxGetPixel.1 ; if MSX2 and screen mode above 3

3674

__call_bios BIOS_READC

3675

ret

3676

gfxGetPixel.1:

3677

ld ix, BIOS_READC2

3678

jp BIOS_EXTROM

3679

3680

if defined LINE

3681

3682

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

3683

; gfxDrawLine

3684

; plot a line from current position to informed destination

3685

; in BC = destination x

3686

; DE = destination y

3687

; https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm#Algorithm_for_integer_arithmetic

3688

; https://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#C

3689

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

3690

;void line(int x0, int y0, int x1, int y1) {

3691

; int dx = abs(x1-x0), sx = x0<x1 ? 1 : -1;

3692

; int dy = abs(y1-y0), sy = y0<y1 ? 1 : -1;

3693

; int err = (dx>dy ? dx : -dy)/2, e2;

3694

; for(;;){

3695

; setPixel(x0,y0);

3696

; if (x0==x1 && y0==y1) break;

3697

; e2 = err;

3698

; if (e2 >-dx) { err -= dy; x0 += sx; }

3699

; if (e2 < dy) { err += dx; y0 += sy; }

3700

; }

3701

;}

3702

3703

gfxDrawLine:

3704

if not defined GFX_FAST

3705

ld hl, (BIOS_GRPACX)

3706

ld (BIOS_GXPOS), hl

3707

ld hl, (BIOS_GRPACY)

3708

ld (BIOS_GYPOS), hl

3709

__call_basic BASIC_SUB_LINE

3710

ret

3711

3712

else

3713

3714

ld (GFX_TEMP2), bc ; x

3715

ld (GFX_TEMP3), de ; y

3716

3717

ld hl, (BIOS_GRPACX) ; x0

3718

ld de, (GFX_TEMP2) ; x

3719

;or a

3720

;sbc hl, de

3721

;jp po, gfxLine.1 ; x0 >= x? else jump to endif

3722

call MATH.COMP.S16

3723

jp c, gfxLine.1 ; x0 < x? jump

3724

or a

3725

sbc hl, de

3726

ld (GFX_TEMP4), hl ; dx = x0 - x

3727

ld hl, 0xffff

3728

ld (GFX_TEMP5), hl ; sx = -1

3729

jr gfxLine.2

3730

3731

gfxLine.1:

3732

ld de, (BIOS_GRPACX) ; x0

3733

ld hl, (GFX_TEMP2) ; x

3734

or a

3735

sbc hl, de

3736

ld (GFX_TEMP4), hl ; dx = x - x0

3737

ld hl, 1

3738

ld (GFX_TEMP5), hl ; sx = 1

3739

3740

gfxLine.2:

3741

ld hl, (BIOS_GRPACY) ; y0

3742

ld de, (GFX_TEMP3) ; y

3743

;or a

3744

;sbc hl, de

3745

;jp po, gfxLine.3 ; y0 >= y? else, jump to endif

3746

call MATH.COMP.S16

3747

jp c, gfxLine.3 ; y0 < y? jump

3748

or a

3749

sbc hl, de

3750

ld (GFX_TEMP6), hl ; dy = y0 - y

3751

ld hl, 0xffff

3752

ld (GFX_TEMP7), hl ; sy = -1

3753

jr gfxLine.4

3754

3755

gfxLine.3:

3756

ld de, (BIOS_GRPACY) ; y0

3757

ld hl, (GFX_TEMP3) ; y

3758

or a

3759

sbc hl, de

3760

ld (GFX_TEMP6), hl ; dy = y - y0

3761

ld hl, 1

3762

ld (GFX_TEMP7), hl ; sy = 1

3763

3764

gfxLine.4:

3765

ld hl, (GFX_TEMP6) ; dy

3766

ld de, 0

3767

call MATH.COMP.S16

3768

jp z, gfxLine.h ; dy = 0?

3769

3770

ld hl, (GFX_TEMP4) ; dx

3771

ld de, 0

3772

call MATH.COMP.S16

3773

jp z, gfxLine.v ; dx = 0?

3774

3775

ld de, (GFX_TEMP4) ; dx

3776

ld hl, (GFX_TEMP6) ; dy

3777

or a

3778

adc hl, de

3779

dec hl

3780

dec hl

3781

ld (GFX_TEMP9), hl ; dxy = dx + dy

3782

3783

ld de, (GFX_TEMP4) ; dx

3784

ld hl, (GFX_TEMP6) ; dy

3785

;or a

3786

;sbc hl, de

3787

;jp pe, gfxLine.5 ; dy < dx? else, jump to endif

3788

call MATH.COMP.S16

3789

jp z, gfxLine.5 ; dy = dx? jump

3790

jp nc, gfxLine.5 ; dy > dx? jump

3791

;ld hl, 0

3792

ld de, (GFX_TEMP6) ; dy

3793

or a

3794

srl d

3795

rr e ; dy / 2

3796

;or a

3797

;sbc hl, de ; -dy

3798

ld (GFX_TEMP8), de ; err = -dy / 2

3799

jr gfxLine.loop

3800

3801

gfxLine.5:

3802

ld hl, (GFX_TEMP4) ; dx

3803

or a

3804

srl h

3805

rr l

3806

ld (GFX_TEMP8), hl ; err = dx/2

3807

3808

gfxLine.loop:

3809

call gfxSetPixel

3810

3811

ld hl, (GFX_TEMP9) ; dxy

3812

ld de, 0

3813

call MATH.COMP.S16

3814

jp nc, gfxLine.loop.0 ; dxy > 0? jump

3815

;jp z, gfxLine.loop.0 ; dxy = 0? jump

3816

3817

ret

3818

3819

gfxLine.loop.0:

3820

ld hl, 0

3821

ld de, (GFX_TEMP4) ; dx

3822

or a

3823

sbc hl, de ; -dx

3824

ld de, (GFX_TEMP8) ; e2 = err

3825

push de

3826

;or a

3827

;sbc hl, de

3828

;jp pe, gfxLine.loop.1 ; if -dx < e2, else jump to endif

3829

call MATH.COMP.S16

3830

jp z, gfxLine.loop.1 ; -dx = e2? jump

3831

jp nc, gfxLine.loop.1 ; -dx > e2? jump

3832

ld hl, (GFX_TEMP8) ; err

3833

ld de, (GFX_TEMP6) ; dy

3834

or a

3835

sbc hl, de

3836

ld (GFX_TEMP8), hl ; err -= dy

3837

3838

ld hl, (GFX_TEMP9) ; dxy

3839

dec hl

3840

ld (GFX_TEMP9), hl ; dxy -= 1

3841

3842

ld hl, (BIOS_GRPACX)

3843

ld de, (GFX_TEMP5)

3844

or a

3845

adc hl, de

3846

ld (BIOS_GRPACX), hl ; x0 += sx

3847

3848

gfxLine.loop.1:

3849

pop hl ; e2

3850

ld de, (GFX_TEMP6) ; dy

3851

;or a

3852

;sbc hl, de

3853

;jp pe, gfxLine.loop.2 ; if e2 < dy, else jump to endif

3854

call MATH.COMP.S16

3855

jp z, gfxLine.loop.2 ; e2 = dy? jump

3856

jp nc, gfxLine.loop.2 ; e2 > dy? jump

3857

ld hl, (GFX_TEMP8) ; err

3858

ld de, (GFX_TEMP4) ; dx

3859

or a

3860

adc hl, de

3861

ld (GFX_TEMP8), hl ; err += dx

3862

3863

ld hl, (GFX_TEMP9) ; dxy

3864

dec hl

3865

ld (GFX_TEMP9), hl ; dxy -= 1

3866

3867

ld hl, (BIOS_GRPACY)

3868

ld de, (GFX_TEMP7)

3869

or a

3870

adc hl, de

3871

ld (BIOS_GRPACY), hl ; y0 += sy

3872

3873

gfxLine.loop.2:

3874

call gfxRefreshXY

3875

jp gfxLine.loop

3876

3877

gfxLine.h:

3878

ld a, (GFX_TEMP5) ; sx

3879

bit 7, a

3880

jr z, gfxLine.h.1 ; if a is positive

3881

ld hl, (BIOS_GRPACX)

3882

ld de, (GFX_TEMP4)

3883

or a

3884

sbc hl, de

3885

ld (BIOS_GRPACX), hl

3886

call gfxRefreshXY

3887

3888

gfxLine.h.1:

3889

__call_bios BIOS_FETCHC

3890

ld hl, (GFX_TEMP4) ; dx

3891

inc hl

3892

call gfxDrawHorLine ; HL = pixel count

3893

ret

3894

3895

gfxLine.v:

3896

ld a, (GFX_TEMP7) ; sy

3897

bit 7, a

3898

jr z, gfxLine.v.1 ; if a is positive

3899

ld hl, (BIOS_GRPACY)

3900

ld de, (GFX_TEMP6)

3901

or a

3902

sbc hl, de

3903

ld (BIOS_GRPACY), hl

3904

call gfxRefreshXY

3905

3906

gfxLine.v.1:

3907

call gfxSetPixel

3908

ld hl, (GFX_TEMP6) ; dy

3909

inc hl

3910

ld (GFX_TEMP3), hl

3911

jp gfxBox.drawVerLine

3912

endif

3913

3914

endif

3915

3916

if defined BOX or defined FBOX or defined BOX_STEP or defined FBOX_STEP

3917

3918

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

3919

; gfxDrawBox

3920

; plot a box from current position to informed destination

3921

; in BC = destination x

3922

; DE = destination y

3923

; A = filled flag (0 = not filled, <>0 = filled)

3924

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

3925

3926

gfxDrawBox:

3927

3928

if not defined GFX_FAST

3929

ld hl, (BIOS_GRPACX)

3930

ld (BIOS_GXPOS), hl

3931

ld hl, (BIOS_GRPACY)

3932

ld (BIOS_GYPOS), hl

3933

ld hl, BASIC_SUB_LINEBOX

3934

or 0

3935

jr z, gfxDrawBox.1

3936

call gfxIsScreenModeMSX2

3937

jr nc, gfxDrawBox.2

3938

ld hl, BASIC_SUB_LINEBOXFILLED

3939

3940

gfxDrawBox.1:

3941

push hl

3942

pop ix

3943

jp BIOS_CALBAS ; BIOS_CALSLT

3944

3945

3946

gfxDrawBox.2:

3947

xor a

3948

ld hl, BASIC_BUF

3949

ld (hl), a

3950

ld ix, BIOS_DOBOXF

3951

jp BIOS_EXTROM

3952

3953

else

3954

call gfxAdjustDestXY

3955

or 0

3956

jr nz, gfxBox.filled

3957

3958

gfxBox.notFilled:

3959

call gfxPushXY

3960

call gfxBox.drawHorLine

3961

ld hl, (GFX_TEMP2)

3962

ld de, (BIOS_GRPACX)

3963

or a

3964

adc hl, de

3965

dec hl

3966

ld (BIOS_GRPACX), hl

3967

call gfxRefreshXY

3968

call gfxBox.drawVerLine

3969

call gfxPopXY

3970

call gfxBox.drawVerLine

3971

call gfxBox.drawHorLine

3972

ret

3973

3974

gfxBox.filled:

3975

ld hl, (GFX_TEMP3)

3976

;inc hl

3977

gfxBox.filled.loop:

3978

push hl

3979

ld bc, (BIOS_GRPACX)

3980

push bc

3981

call gfxBox.drawHorLine

3982

pop bc

3983

ld (BIOS_GRPACX), bc

3984

ld bc, (BIOS_GRPACY)

3985

inc bc

3986

ld (BIOS_GRPACY), bc

3987

call gfxRefreshXY

3988

pop hl

3989

ld de, 1

3990

or a

3991

sbc hl, de

3992

jr nz, gfxBox.filled.loop

3993

ret

3994

3995

gfxBox.drawHorLine:

3996

ld hl, (GFX_TEMP2)

3997

;inc hl

3998

call gfxDrawHorLine

3999

ret

4000

4001

gfxBox.drawVerLine:

4002

ld hl, (GFX_TEMP3)

4003

dec hl

4004

gfxBox.drawVerLine.loop:

4005

push hl

4006

call gfxDown

4007

call gfxSetPixel

4008

pop hl

4009

ld de, 1

4010

or a

4011

sbc hl, de

4012

jr nz, gfxBox.drawVerLine.loop

4013

ret

4014

4015

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

4016

; gfxDrawHorLine

4017

; draw a horizontal line

4018

; HL = pixel count

4019

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

4020

4021

gfxDrawHorLine:

4022

ld a, (BIOS_SCRMOD)

4023

cp 5

4024

jr c, gfxDrawHorLine.2 ; if screen mode < 5 then jump

4025

bit 7, h

4026

ret nz ; return if negative

4027

xor a

4028

cp h

4029

jr nz, gfxDrawHorLine.1

4030

cp l

4031

ret z ; return if hl = 0

4032

call gfxPushXY

4033

gfxDrawHorLine.1:

4034

push hl

4035

call gfxSetPixel

4036

call gfxRight

4037

pop hl

4038

ld de, 1

4039

sbc hl, de

4040

jr nz, gfxDrawHorLine.1

4041

call gfxPopXY

4042

ret

4043

gfxDrawHorLine.2:

4044

__call_bios BIOS_NSETCX ; HL = fill count

4045

ret

4046

4047

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

4048

; gfxAdjustDestXY

4049

; invert if dest XY is less than current XY position

4050

; BC = dest x

4051

; DE = dest y

4052

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

4053

4054

gfxAdjustDestXY:

4055

push af

4056

ld (GFX_TEMP2), bc ; x

4057

ld (GFX_TEMP3), de ; y

4058

4059

; verify x againt current position

4060

ld hl, (BIOS_GRPACX)

4061

ld de, (GFX_TEMP2)

4062

and a

4063

sbc hl, de ; dx = x1 - x0

4064

bit 7, h ; result is negative?

4065

jr z, gfxAdjustDestXY.1

4066

add hl, de

4067

ld (BIOS_GRPACX), hl

4068

ex de, hl

4069

or a

4070

sbc hl, de

4071

gfxAdjustDestXY.1:

4072

inc hl

4073

ld (GFX_TEMP2), hl

4074

4075

; verify y againt current position

4076

ld hl, (BIOS_GRPACY)

4077

ld de, (GFX_TEMP3)

4078

and a

4079

sbc hl, de ; dy = y1 - y0

4080

bit 7, h ; result is negative?

4081

jr z, gfxAdjustDestXY.2

4082

add hl, de

4083

ld (BIOS_GRPACY), hl

4084

ex de, hl

4085

or a

4086

sbc hl, de

4087

gfxAdjustDestXY.2:

4088

inc hl

4089

ld (GFX_TEMP3), hl

4090

4091

; refresh new position

4092

call gfxRefreshXY

4093

pop af

4094

ret

4095

endif

4096

4097

endif

4098

4099

if defined CIRCLE

4100

4101

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

4102

; gfxDrawCircle

4103

; plot a circle centered in current position

4104

; BC = tracing end x

4105

; DE = tracing end y

4106

; HL = radius

4107

; A = filled flag (0 = not filled, <>0 = filled)

4108

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

4109

; https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#C

4110

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

4111

4112

gfxDrawCircle:

4113

4114

if not defined GFX_FAST

4115

bit 7,h

4116

ret nz ; return if negative radius

4117

ld (BIOS_GXPOS), hl ; circle ray

4118

ld de, (BIOS_GXPOS)

4119

ld bc, (BIOS_GRPACY)

4120

ld (BIOS_GYPOS), bc

4121

xor a

4122

;cp h

4123

;jr nz, gfxDrawCircle.1

4124

;cp l

4125

;ret z

4126

gfxDrawCircle.1:

4127

ld hl, BASIC_BUF

4128

ld (hl), a

4129

ld ix, 0xFFFF

4130

__call_basic BASIC_SUB_CIRCLE

4131

ret

4132

else

4133

ld (GFX_TEMP), hl ; radius

4134

ld de, 0

4135

sbc hl, de

4136

ret z ; return if zero radius

4137

bit 7,h

4138

ret nz ; return if negative radius

4139

4140

call gfxGetXY

4141

ld (GFX_TEMP1), bc ; x0

4142

ld (GFX_TEMP2), de ; y0

4143

4144

or 0

4145

jp nz, gfxCircle.filled

4146

4147

gfxCircle.notFilled:

4148

ld hl, 1

4149

ld de, (GFX_TEMP) ; radius

4150

or a

4151

sbc hl, de

4152

ld (GFX_TEMP3), hl ; f = 1 - radius

4153

4154

ld hl, 0

4155

ld (GFX_TEMP4), hl ; ddF_x = 0

4156

4157

ld hl, (GFX_TEMP)

4158

or a

4159

adc hl, hl

4160

ex de, hl

4161

ld hl, 0

4162

or a

4163

sbc hl, de

4164

ld (GFX_TEMP5), hl ; ddF_y = -2 * radius

4165

4166

ld hl, 0

4167

ld (GFX_TEMP6), hl ; x = 0

4168

4169

ld hl, (GFX_TEMP)

4170

ld (GFX_TEMP7), hl ; y = radius

4171

4172

; plot(x0, y0 + radius)

4173

ld de, (GFX_TEMP) ; radius

4174

ld hl, (GFX_TEMP2) ; y0

4175

or a

4176

adc hl, de

4177

ex de, hl

4178

ld bc, (GFX_TEMP1) ; x0

4179

call gfxSetXY

4180

call gfxSetPixel

4181

4182

; plot(x0, y0 - radius)

4183

ld de, (GFX_TEMP) ; radius

4184

ld hl, (GFX_TEMP2) ; y0

4185

or a

4186

sbc hl, de

4187

ex de, hl

4188

ld bc, (GFX_TEMP1) ; x0

4189

call gfxSetXY

4190

call gfxSetPixel

4191

4192

; plot(x0 + radius, y0)

4193

ld hl, (GFX_TEMP1) ; x0

4194

ld de, (GFX_TEMP) ; radius

4195

or a

4196

adc hl, de

4197

;push hl

4198

;pop bc

4199

ld b, h

4200

ld c, l

4201

ld de, (GFX_TEMP2) ; y0

4202

call gfxSetXY

4203

call gfxSetPixel

4204

4205

; plot(x0 - radius, y0)

4206

ld hl, (GFX_TEMP1) ; x0

4207

ld de, (GFX_TEMP) ; radius

4208

or a

4209

sbc hl, de

4210

;push hl

4211

;pop bc

4212

ld b, h

4213

ld c, l

4214

ld de, (GFX_TEMP2) ; y0

4215

call gfxSetXY

4216

call gfxSetPixel

4217

jp gfxCircle.notFilled.3

4218

4219

gfxCircle.notFilled.1:

4220

ld hl, (GFX_TEMP3) ; f

4221

bit 7, h

4222

jr nz, gfxCircle.notFilled.2 ; if( f < 0 ), jump

4223

4224

ld hl, (GFX_TEMP7) ; y -= 1

4225

dec hl

4226

ld (GFX_TEMP7), hl

4227

4228

ld hl, (GFX_TEMP5) ; ddF_y += 2

4229

inc hl

4230

inc hl

4231

ld (GFX_TEMP5), hl

4232

4233

ld hl, (GFX_TEMP3) ; f

4234

ld de, (GFX_TEMP5) ; ddF_y

4235

or a

4236

adc hl, de

4237

ld (GFX_TEMP3), hl ; f += ddF_y

4238

4239

gfxCircle.notFilled.2:

4240

ld hl, (GFX_TEMP6) ; x

4241

inc hl

4242

ld (GFX_TEMP6), hl ; x++

4243

4244

ld hl, (GFX_TEMP4) ; ddF_x += 2

4245

inc hl

4246

inc hl

4247

ld (GFX_TEMP4), hl

4248

4249

ld hl, (GFX_TEMP3) ; f

4250

ld de, (GFX_TEMP4) ; ddF_x

4251

or a

4252

adc hl, de

4253

inc hl

4254

ld (GFX_TEMP3), hl ; f += ddF_x + 1

4255

4256

; plot(x0 + x, y0 + y)

4257

ld hl, (GFX_TEMP1) ; x0

4258

ld de, (GFX_TEMP6) ; x

4259

or a

4260

adc hl, de

4261

;push hl

4262

;pop bc

4263

ld b, h

4264

ld c, l

4265

ld hl, (GFX_TEMP2) ; y0

4266

ld de, (GFX_TEMP7) ; y

4267

or a

4268

adc hl, de

4269

ex de, hl

4270

call gfxSetXY

4271

call gfxSetPixel

4272

4273

; plot(x0 - x, y0 + y)

4274

ld hl, (GFX_TEMP1) ; x0

4275

ld de, (GFX_TEMP6) ; x

4276

or a

4277

sbc hl, de

4278

;push hl

4279

;pop bc

4280

ld b, h

4281

ld c, l

4282

ld hl, (GFX_TEMP2) ; y0

4283

ld de, (GFX_TEMP7) ; y

4284

or a

4285

adc hl, de

4286

ex de, hl

4287

call gfxSetXY

4288

call gfxSetPixel

4289

4290

; plot(x0 + x, y0 - y)

4291

ld hl, (GFX_TEMP1) ; x0

4292

ld de, (GFX_TEMP6) ; x

4293

or a

4294

adc hl, de

4295

;push hl

4296

;pop bc

4297

ld b, h

4298

ld c, l

4299

ld hl, (GFX_TEMP2) ; y0

4300

ld de, (GFX_TEMP7) ; y

4301

or a

4302

sbc hl, de

4303

ex de, hl

4304

call gfxSetXY

4305

call gfxSetPixel

4306

4307

; plot(x0 - x, y0 - y)

4308

ld hl, (GFX_TEMP1) ; x0

4309

ld de, (GFX_TEMP6) ; x

4310

or a

4311

sbc hl, de

4312

;push hl

4313

;pop bc

4314

ld b, h

4315

ld c, l

4316

ld hl, (GFX_TEMP2) ; y0

4317

ld de, (GFX_TEMP7) ; y

4318

or a

4319

sbc hl, de

4320

ex de, hl

4321

call gfxSetXY

4322

call gfxSetPixel

4323

4324

; plot(x0 + y, y0 + x)

4325

ld hl, (GFX_TEMP1) ; x0

4326

ld de, (GFX_TEMP7) ; y

4327

or a

4328

adc hl, de

4329

;push hl

4330

;pop bc

4331

ld b, h

4332

ld c, l

4333

ld hl, (GFX_TEMP2) ; y0

4334

ld de, (GFX_TEMP6) ; x

4335

or a

4336

adc hl, de

4337

ex de, hl

4338

call gfxSetXY

4339

call gfxSetPixel

4340

4341

; plot(x0 - y, y0 + x)

4342

ld hl, (GFX_TEMP1) ; x0

4343

ld de, (GFX_TEMP7) ; y

4344

or a

4345

sbc hl, de

4346

;push hl

4347

;pop bc

4348

ld b, h

4349

ld c, l

4350

ld hl, (GFX_TEMP2) ; y0

4351

ld de, (GFX_TEMP6) ; x

4352

or a

4353

adc hl, de

4354

ex de, hl

4355

call gfxSetXY

4356

call gfxSetPixel

4357

4358

; plot(x0 + y, y0 - x)

4359

ld hl, (GFX_TEMP1) ; x0

4360

ld de, (GFX_TEMP7) ; y

4361

or a

4362

adc hl, de

4363

;push hl

4364

;pop bc

4365

ld b, h

4366

ld c, l

4367

ld hl, (GFX_TEMP2) ; y0

4368

ld de, (GFX_TEMP6) ; x

4369

or a

4370

sbc hl, de

4371

ex de, hl

4372

call gfxSetXY

4373

call gfxSetPixel

4374

4375

; plot(x0 - y, y0 - x)

4376

ld hl, (GFX_TEMP1) ; x0

4377

ld de, (GFX_TEMP7) ; y

4378

or a

4379

sbc hl, de

4380

;push hl

4381

;pop bc

4382

ld b, h

4383

ld c, l

4384

ld hl, (GFX_TEMP2) ; y0

4385

ld de, (GFX_TEMP6) ; x

4386

or a

4387

sbc hl, de

4388

ex de, hl

4389

call gfxSetXY

4390

call gfxSetPixel

4391

4392

gfxCircle.notFilled.3:

4393

ld hl, (GFX_TEMP6) ; x

4394

ld de, (GFX_TEMP7) ; y

4395

or a

4396

sbc hl, de

4397

jp c, gfxCircle.notFilled.1 ; while( x < y )

4398

ld bc, (GFX_TEMP1) ; x0

4399

ld de, (GFX_TEMP2) ; y0

4400

call gfxSetXY

4401

ret

4402

4403

gfxCircle.filled

4404

call gfxCircle.notFilled

4405

ld hl, (BIOS_BDRATR)

4406

push hl

4407

ld hl, (BIOS_FORCLR)

4408

ld (BIOS_BDRATR), hl

4409

ld a, 1

4410

call gfxBorderFill

4411

pop hl

4412

ld (BIOS_BDRATR), hl

4413

ret

4414

endif

4415

4416

endif

4417

4418

if defined PAINT or (defined CIRCLE and defined GFX_FAST)

4419

4420

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

4421

; gfxBorderFill

4422

; Fill current region delimited by border attribute color changing pixels to foreground color

4423

; in: a = fill type (0 = not symmetric, 1 = symmetric)

4424

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

4425

4426

gfxBorderFill:

4427

4428

if not defined GFX_FAST

4429

4430

ld bc, (BIOS_GRPACX)

4431

ld (BIOS_GXPOS), bc

4432

ld de, (BIOS_GRPACY)

4433

ld (BIOS_GYPOS), de

4434

push bc

4435

push de

4436

4437

xor a

4438

ld hl, BASIC_BUF

4439

ld (hl), a

4440

4441

ld a, (BIOS_BDRATR)

4442

xor b

4443

ld e, a

4444

ld a, (BIOS_ATRBYT)

4445

xor d

4446

ld c, a

4447

;ld ix, 0xFFFF

4448

;ld iy, 0xFFFF

4449

4450

call gfxIsScreenModeMSX2

4451

jr nc, gfxBorderFill.1 ; if MSX2 and screen mode above 3, jump

4452

ld a, (BIOS_BDRATR)

4453

ld (BIOS_ATRBYT), a

4454

ld e, a

4455

__call_basic BASIC_SUB_PAINT1

4456

ret

4457

4458

gfxBorderFill.1:

4459

__call_basic BASIC_SUB_PAINT1

4460

ret

4461

;ld ix, BASIC_SUB_PAINT2

4462

;jp BIOS_EXTROM

4463

4464

else

4465

4466

ld (GFX_TEMP1), a

4467

ld hl, (BIOS_GRPACY)

4468

push hl

4469

call gfxBorderFill.down

4470

pop hl

4471

push hl

4472

ld (BIOS_GRPACY), hl

4473

call gfxRefreshXY

4474

call gfxBorderFill.up

4475

pop hl

4476

ld (BIOS_GRPACY), hl

4477

call gfxRefreshXY

4478

ret

4479

4480

gfxBorderFill.down:

4481

call gfxBorderFill.line

4482

call gfxDown

4483

ret c

4484

call gfxGetPixel

4485

ld hl, BIOS_BDRATR

4486

cp (hl)

4487

jr nz, gfxBorderFill.down

4488

ret

4489

4490

gfxBorderFill.up:

4491

call gfxBorderFill.line

4492

call gfxUp

4493

ret c

4494

call gfxGetPixel

4495

ld hl, BIOS_BDRATR

4496

cp (hl)

4497

jr nz, gfxBorderFill.up

4498

ret

4499

4500

gfxBorderFill.line:

4501

ld de, (BIOS_GRPACX)

4502

push de

4503

ld b, 1 ; fill flag

4504

ld de, 1 ; skip count

4505

__call_bios BIOS_SCANR

4506

;inc hl

4507

;ld (GFX_TEMP2), hl ; pixel count transversed

4508

pop de

4509

push de

4510

ld (BIOS_GRPACX), de

4511

call gfxRefreshXY

4512

;ld a, (GFX_TEMP1)

4513

;cp 0 ; 0 = not symmetric, 1 = symmetric

4514

;jr z, gfxBorderFill.line.1

4515

;ld hl, (GFX_TEMP2)

4516

;__call_bios BIOS_NSETCX ; HL = fill count

4517

;jr gfxBorderFill.line.2

4518

gfxBorderFill.line.1:

4519

ld b, 1 ; fill flag

4520

ld de, 0 ; skip count

4521

__call_bios BIOS_SCANL

4522

gfxBorderFill.line.2:

4523

pop de

4524

ld (BIOS_GRPACX), de

4525

call gfxRefreshXY

4526

ret

4527

4528

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

4529

; gfxFloadFill

4530

; Fload fill current region changing current pixel color to foreground color

4531

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

4532

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

4533

4534

gfxFloadFill:

4535

call gfxGetPixel

4536

ld (GFX_TEMP), a ; replacement-color

4537

call gfxFloadFill.recursive

4538

ret

4539

4540

gfxFloadFill.recursive:

4541

; 1. If target-color is equal to replacement-color, return.

4542

ld a, (GFX_TEMP)

4543

ld hl, BIOS_FORCLR

4544

cp (hl)

4545

ret z

4546

4547

; 2. ElseIf the color of node is not equal to target-color, return.

4548

call gfxGetPixel

4549

ld hl, GFX_TEMP

4550

cp (hl)

4551

ret nz

4552

4553

; 3. Else Set the color of node to replacement-color.

4554

call gfxSetPixel

4555

4556

; 4. Perform Flood-fill (one step to the left of node, target-color, replacement-color).

4557

gfxFloadFill.recursive.left:

4558

call gfxLeft

4559

jr c, gfxFloadFill.recursive.right

4560

call gfxFloadFill.recursive

4561

call gfxRight

4562

4563

; Perform Flood-fill (one step to the right of node, target-color, replacement-color).

4564

gfxFloadFill.recursive.right:

4565

call gfxRight

4566

jr c, gfxFloadFill.recursive.up

4567

call gfxFloadFill.recursive

4568

call gfxLeft

4569

4570

; Perform Flood-fill (one step to the up of node, target-color, replacement-color).

4571

gfxFloadFill.recursive.up:

4572

call gfxUp

4573

jr c, gfxFloadFill.recursive.down

4574

call gfxFloadFill.recursive

4575

call gfxDown

4576

4577

; Perform Flood-fill (one step to the down of node, target-color, replacement-color).

4578

gfxFloadFill.recursive.down:

4579

call gfxDown

4580

ret c

4581

call gfxFloadFill.recursive

4582

call gfxUp

4583

ret

4584

4585

endif

4586

4587

endif

4588

4589

if defined SPRITEMODE

4590

4591

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

4592

; gfxSetSpriteMode

4593

; set current sprite mode

4594

; A = sprite mode

4595

; 0: Spritesize is 8 by 8 pixels - default value

4596

; 1: Spritesize is 8 by 8 pixels, magnified to 16 by 16 pixels

4597

; 2: Spritesize is 16 by 16 pixels

4598

; 3: Spritesize is 16 by 16 pixels, magnified to 32 by 32 pixels

4599

; RG1SAV bit 0 = magnify sprite (double size)

4600

; RG1SAV bit 1 = sprite size (0=8 pixels, 1=16 pixels)

4601

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

4602

4603

gfxSetSpriteMode:

4604

and 3 ; keeps only bits 0 and 1 from A

4605

ld b, a

4606

4607

ld a, (BIOS_RG1SAV) ; get copy from register #1 of VDP

4608

and 0xFC ; clear bits 0 and 1 from A

4609

or b ; put parameter to A (bits 0 and 1)

4610

ld (BIOS_RG1SAV), a ; restore to register #1 of VDP

4611

ld b, a ; value to write

4612

ld c, 1 ; register number to write

4613

call gfxWRTVDP ; write register to VDP

4614

call gfxCLRSPR ; clear sprites

4615

4616

call gfxGetSpriteSize

4617

jp gfxFillSpriteCollisionTable

4618

4619

endif

4620

4621

if defined SPRITE or defined COLOR_SPRITE or defined PUT_SPRITE_COLOR or defined PUT_SPRITE_STEP_COLOR or defined PUT_SPRITE_COLOR_PATNUM or defined PUT_SPRITE_STEP_COLOR_PATNUM or defined LOAD_SET

4622

4623

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

4624

; gfxSetSpriteColorInt

4625

; A = sprite number

4626

; BC = color number

4627

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

4628

4629

gfxSetSpriteColorInt:

4630

ld b, a ; save sprite number

4631

call gfxCALATR ; get sprite attribute table address

4632

inc hl

4633

inc hl

4634

inc hl

4635

ld a, c ; color

4636

;call gfxSetSpriteColor.Adjust

4637

call gfxWRTVRM

4638

4639

ld a, (BIOS_SCRMOD)

4640

cp 3

4641

ret c ; if screen mode < 3, do not adjust sprite multicolor

4642

4643

ld a, b ; recover sprite number

4644

call gfxGetSpriteColorTable

4645

4646

ld a, c ; color

4647

;call gfxSetSpriteColor.Adjust

4648

ld b, 16 ; array of 16 bytes

4649

4650

gfxSetSpriteColorInt.1:

4651

push bc

4652

call gfxWRTVRM

4653

pop bc

4654

inc hl

4655

djnz gfxSetSpriteColorInt.1

4656

ret

4657

4658

;gfxSetSpriteColor.Adjust:

4659

; cp 0x0f

4660

; ret z

4661

; ret c

4662

; srl a

4663

; srl a

4664

; srl a

4665

; srl a

4666

; ret

4667

4668

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

4669

; gfxSetSpriteColorStr

4670

; A = sprite number

4671

; DE = address to color byte array

4672

; BC = color byte array size

4673

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

4674

4675

gfxSetSpriteColorStr:

4676

ld b, a ; save sprite number

4677

push bc

4678

push de

4679

call gfxCALATR ; get sprite attribute table

4680

pop de

4681

pop bc

4682

4683

ld a, c ; byte array zero length?

4684

or a

4685

ret z

4686

4687

inc hl

4688

inc hl

4689

inc hl

4690

ld a, (de) ; color

4691

;call gfxSetSpriteColor.Adjust

4692

call gfxWRTVRM

4693

4694

ld a, (BIOS_SCRMOD)

4695

cp 3

4696

ret c ; if screen mode < 3, do not adjust sprite mode 2

4697

4698

ld a, b ; recover sprite number

4699

call gfxGetSpriteColorTable

4700

4701

ld b, 16 ; array of 16 bytes (color table)

4702

ld a, c ; size of color array

4703

push de

4704

pop iy ; save array start

4705

4706

gfxSetSpriteColorStr.1:

4707

push af

4708

ld a, (de)

4709

;call gfxSetSpriteColor.Adjust

4710

call gfxWRTVRM

4711

inc hl

4712

inc de

4713

pop af

4714

dec a

4715

jr nz, gfxSetSpriteColorStr.2

4716

ld a, c ; recover array size

4717

push iy

4718

pop de ; recover array start

4719

4720

gfxSetSpriteColorStr.2:

4721

djnz gfxSetSpriteColorStr.1

4722

ret

4723

4724

4725

4726

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

4727

; gfxGetSpriteColorTable

4728

; A = sprite number

4729

; HL = address to color table

4730

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

4731

4732

gfxGetSpriteColorTable:

4733

push af

4734

push de

4735

ld h, 0

4736

ld l, a ; recover sprite number

4737

add hl, hl

4738

add hl, hl

4739

add hl, hl

4740

add hl, hl ; multiply by 16 (shift left 4)

4741

push hl

4742

xor a

4743

call gfxCALATR ; get sprite attribute table address

4744

pop de

4745

add hl, de

4746

xor a

4747

ld de, 512

4748

sbc hl, de ; address of color table from sprite multicolor

4749

pop de

4750

pop af

4751

ret

4752

4753

endif

4754

4755

if defined PUT_SPRITE or defined PUT_SPRITE_STEP or defined PUT_SPRITE_COLOR or defined PUT_SPRITE_STEP_COLOR or defined PUT_SPRITE_COLOR_PATNUM or defined PUT_SPRITE_STEP_COLOR_PATNUM or defined PUT_SPRITE_PATNUM or defined PUT_SPRITE_STEP_PATNUM

4756

4757

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

4758

; gfxSetSpriteXY

4759

; A = sprite number

4760

; BC = XY

4761

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

4762

4763

gfxSetSpriteXY:

4764

push bc

4765

call gfxCALATR ; get sprite attribute table address

4766

pop bc

4767

ld a, c ; y

4768

call gfxWRTVRM

4769

inc hl

4770

ld a, b ; x

4771

call gfxWRTVRM

4772

ret

4773

4774

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

4775

; gfxSpriteStepCheck

4776

; BC = XY

4777

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

4778

4779

gfxSpriteStepCheck:

4780

push hl

4781

push de

4782

push bc

4783

4784

ld de, (GFX_SPRITE_SIZE_DAT)

4785

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4786

and 7 ; clear touched and collided flags

4787

ld (GFX_SPRITE_FLAGS), a

4788

4789

bit 0, a

4790

jr z, gfxSpriteStepCheck.corners

4791

4792

gfxSpriteStepCheck.limits:

4793

ld a, (GFX_MAX_X)

4794

sub e ; sprite size

4795

cp b ; jump if x > max_x?

4796

jr c, gfxSpriteStepCheck.limits.touched

4797

4798

ld a, (GFX_MAX_Y)

4799

sub e ; sprite size

4800

cp c ; jump if y > max_y?

4801

jr c, gfxSpriteStepCheck.limits.touched

4802

4803

jr gfxSpriteStepCheck.corners

4804

4805

gfxSpriteStepCheck.limits.touched:

4806

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4807

or 8 ; set limit touched flag

4808

ld (GFX_SPRITE_FLAGS), a

4809

4810

gfxSpriteStepCheck.corners:

4811

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4812

and 2+4 ; check walls or hotspots

4813

jr z, gfxSpriteStepCheck.end

4814

4815

ld (GFX_TEMP10), bc

4816

call gfxSpriteStepCheck.corner

4817

4818

ld a, (GFX_SPRITE_SIZE_DAT)

4819

add a, b

4820

ld b, a

4821

call gfxSpriteStepCheck.corner

4822

4823

ld a, (GFX_SPRITE_SIZE_DAT)

4824

add a, c

4825

ld c, a

4826

call gfxSpriteStepCheck.corner

4827

4828

ld bc, (GFX_TEMP10)

4829

ld a, (GFX_SPRITE_SIZE_DAT)

4830

add a, c

4831

ld c, a

4832

call gfxSpriteStepCheck.corner

4833

4834

gfxSpriteStepCheck.end:

4835

pop bc

4836

pop de

4837

pop hl

4838

ret

4839

4840

gfxSpriteStepCheck.corner:

4841

call gfxGetTileFromXY

4842

ld d, a ; tile to be searched

4843

4844

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4845

bit 1, a

4846

call nz, gfxSpriteStepCheck.walls

4847

4848

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4849

bit 2, a

4850

call nz, gfxSpriteStepCheck.hotspots

4851

ret

4852

4853

gfxSpriteStepCheck.walls:

4854

ld hl, (GFX_SPRITE_WALLS)

4855

ld e, 16 ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4856

jp gfxSpriteStepCheck.search

4857

4858

gfxSpriteStepCheck.hotspots:

4859

ld hl, (GFX_SPRITE_HOTSPOTS)

4860

ld e, 32 ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4861

call gfxSpriteStepCheck.search

4862

4863

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4864

bit 5, a

4865

ret z

4866

4867

ld a, (GFX_TEMP1)

4868

ld (GFX_SPRITE_HOTSPOT_TILE), a

4869

ret

4870

4871

; d = tile, hl = search table, e = flag

4872

gfxSpriteStepCheck.search:

4873

ld a, h

4874

or l

4875

ret z

4876

4877

ld a, d ; search for this tile

4878

push bc

4879

ld c, (hl)

4880

inc hl

4881

ld b, (hl)

4882

inc hl

4883

cpir ; inc HL searching for A until BC=0 (Z flag settled if found)

4884

pop bc

4885

ret nz

4886

4887

gfxSpriteStepCheck.search.found:

4888

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

4889

or e ; set touched flag

4890

ld (GFX_SPRITE_FLAGS), a

4891

ret

4892

4893

; b = x, c = y

4894

gfxGetTileFromXY:

4895

push bc

4896

ld a, c ; y

4897

srl b ; divide by 2

4898

srl b ; divide by 4

4899

srl b ; divide by 8

4900

ld c, b

4901

srl a

4902

srl a

4903

srl a

4904

ld b, a

4905

call gfxGetScreenTile ; b = y, c = x, a = tile

4906

pop bc

4907

ret

4908

4909

endif

4910

4911

if defined SPRITE or defined PUT_SPRITE or defined PUT_SPRITE_PATNUM or defined PUT_SPRITE_STEP_PATNUM or defined PUT_SPRITE_COLOR_PATNUM or defined PUT_SPRITE_STEP_COLOR_PATNUM

4912

4913

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

4914

; gfxSetSpritePattern

4915

; A = sprite number

4916

; BC = pattern number

4917

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

4918

4919

gfxSetSpritePattern:

4920

push bc

4921

call gfxCALATR ; get sprite attribute table address

4922

pop bc

4923

inc hl

4924

inc hl

4925

ld a, (BIOS_RG1SAV) ; bit 0 = double size, bit 1 = sprite size (0=8 pixels, 1=16 pixels)

4926

bit 1, a

4927

jr z, gfxSetSpritePattern.1

4928

sll c

4929

sll c

4930

gfxSetSpritePattern.1:

4931

ld a, c ; pattern number

4932

call gfxWRTVRM

4933

ret

4934

4935

endif

4936

4937

if defined SPRITE

4938

4939

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

4940

; gfxSetSpriteData

4941

; HL = point to sprite data as a string of 8 or 32 characters according the sprites size (8x8 or 16x16)

4942

; A = sprite number

4943

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

4944

4945

gfxSetSpriteData:

4946

push AF

4947

push HL

4948

call gfxCALPAT ; get sprite pattern data address

4949

ex DE, HL

4950

call gfxGSPSIZ ; return in 'a' sprite default size

4951

pop HL

4952

ld b, 0

4953

cp c

4954

jr z, gfxSetSpriteData.1

4955

jr nc, gfxSetSpriteData.1

4956

ld c, a

4957

gfxSetSpriteData.1:

4958

push bc

4959

ld c, a

4960

xor a

4961

call gfxFILVRM

4962

pop bc

4963

pop AF

4964

call gfxLDIRVM

4965

ret

4966

4967

endif

4968

4969

if defined GFX_SPRITES

4970

4971

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

4972

; gfxInitSprites

4973

; initialises all sprites

4974

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

4975

4976

gfxInitSprites:

4977

call gfxCLRSPR

4978

ret

4979

4980

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

4981

; gfxSetSpriteAttrs

4982

; set sprite default x, y, pattern and color

4983

; A = sprite number

4984

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

4985

4986

gfxSetSpriteAttrs:

4987

push af

4988

call gfxCALATR

4989

ld a, (BIOS_GRPACY) ; y

4990

call gfxWRTVRM

4991

inc hl

4992

ld a, (BIOS_GRPACX) ; x

4993

call gfxWRTVRM

4994

inc hl

4995

pop af ; pattern

4996

call gfxWRTVRM

4997

inc hl

4998

ld a, (BIOS_FORCLR) ; color

4999

call gfxWRTVRM

5000

ret

5001

5002

endif

5003

5004

if defined EXIST_DATA_SET

5005

5006

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

5007

; gfxIsTileMode

5008

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

5009

5010

gfxIsTileMode:

5011

ld a, (BIOS_SCRMOD)

5012

cp 2

5013

ret z

5014

cp 4

5015

ret

5016

5017

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

5018

; gfxClearTileScreen

5019

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

5020

5021

gfxClearTileScreen:

5022

ld a, 0x20 ; space

5023

ld bc, 768

5024

ld hl, (BIOS_GRPNAM)

5025

call gfxFILVRM

5026

5027

ld de, 0x0020

5028

call gfxSetTileDefaultColor

5029

ld de, 0x0120

5030

call gfxSetTileDefaultColor

5031

ld de, 0x0220

5032

jp gfxSetTileDefaultColor

5033

5034

gfxSetTileDefaultColor

5035

call gfxGetTileColorAddr

5036

ex de, hl

5037

call gfxGetTileDefaultColor

5038

ld bc, 8

5039

jp gfxFILVRM

5040

5041

gfxGetTileDefaultColor:

5042

ld a, (BIOS_FORCLR)

5043

sla a

5044

sla a

5045

sla a

5046

sla a

5047

push hl

5048

ld hl, BIOS_BAKCLR

5049

or (hl)

5050

pop hl

5051

ret

5052

5053

; set tile color

5054

; HL = tile color pointer

5055

; BC = tile color size

5056

; DE = tile number

5057

5058

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

5059

; gfxSetTileData

5060

; set tile data

5061

; HL = tile data pointer

5062

; BC = tile data size

5063

; DE = tile number

5064

; A = flip (0=no, 1=yes)

5065

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

5066

5067

gfxSetTileData:

5068

or a

5069

jr nz, gfxSetTileDataFlip

5070

5071

gfxSetTileDataNoFlip:

5072

call gfxGetTileDataAddr

5073

jp gfxLDIRVM

5074

5075

gfxSetTileDataFlip:

5076

call gfxGetTileDataAddr

5077

ex de, hl

5078

gfxSetTileDataFlip.Loop:

5079

ld a, (de)

5080

call gfxReverseA

5081

call gfxWRTVRM

5082

inc de

5083

inc hl

5084

dec bc

5085

ld a, b

5086

cp c

5087

jr nz, gfxSetTileDataFlip.Loop

5088

ret

5089

5090

; in de = tile number

5091

; out de = tile number address

5092

gfxGetTileDataAddr:

5093

push hl

5094

ex de, hl

5095

add hl, hl

5096

add hl, hl

5097

add hl, hl ; tile number * 8

5098

ld de, (BIOS_GRPCGP)

5099

add hl, de

5100

ex de, hl

5101

pop hl

5102

ret

5103

5104

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

5105

; gfxSetTileColor

5106

; set tile color

5107

; HL = tile color pointer

5108

; BC = tile color size

5109

; DE = tile number

5110

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

5111

5112

gfxSetTileColor:

5113

call gfxGetTileColorAddr

5114

jp gfxLDIRVM

5115

5116

; in de = tile number

5117

; out de = tile number address

5118

gfxGetTileColorAddr:

5119

push hl

5120

ex de, hl

5121

add hl, hl

5122

add hl, hl

5123

add hl, hl ; tile number * 8

5124

ld de, (BIOS_GRPCOL)

5125

add hl, de

5126

ex de, hl

5127

pop hl

5128

ret

5129

5130

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

5131

; gfxSetScreenTile

5132

; set screen tile at x,y

5133

; C = x

5134

; B = y

5135

; a = tile number

5136

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

5137

5138

gfxSetScreenTile:

5139

ex af, af'

5140

ld a, 23

5141

cp b

5142

ret c

5143

ld a, 31

5144

cp c

5145

ret c

5146

;push bc

5147

; ld h, 0

5148

; ld l, b ; slow y * 32

5149

; ld bc, 32

5150

; call MATH.MULT.16

5151

;pop bc

5152

ld h, b

5153

sra h

5154

sra h

5155

sra h

5156

ld l, b

5157

sla l

5158

sla l

5159

sla l

5160

sla l

5161

sla l ; fast y * 32

5162

ld d, 0

5163

ld e, c ; x

5164

add hl, de

5165

ld de, (BIOS_GRPNAM)

5166

add hl, de

5167

ex af, af'

5168

jp gfxWRTVRM

5169

5170

endif

5171

5172

if defined gfxGetTileFromXY or defined EXIST_DATA_SET

5173

5174

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

5175

; gfxGetScreenTile

5176

; get screen tile at x,y

5177

; C = x

5178

; B = y

5179

; a = tile number

5180

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

5181

5182

gfxGetScreenTile:

5183

ld a, 23

5184

cp b

5185

ret c

5186

ld a, 31

5187

cp c

5188

ret c

5189

ld h, b

5190

sra h

5191

sra h

5192

sra h

5193

ld l, b

5194

sla l

5195

sla l

5196

sla l

5197

sla l

5198

sla l ; fast y * 32

5199

ld d, 0

5200

ld e, c ; x

5201

add hl, de

5202

ld de, (BIOS_GRPNAM)

5203

add hl, de

5204

jp gfxRDVRM

5205

5206

endif

5207

5208

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

5209

; Sprite collision table routines

5210

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

5211

5212

gfxInitSpriteCollisionTable:

5213

ld bc, 128

5214

call memory.alloc

5215

ld (GFX_SPRITE_COLLISION), ix

5216

ret

5217

5218

; copy sprite attribute table to ram

5219

gfxFillSpriteCollisionTable:

5220

ld hl, (BIOS_ATRBAS) ; source: attribute table

5221

ld de, (GFX_SPRITE_COLLISION) ; dest: ram

5222

ld bc, 128 ; 32*4 = size of attribute table

5223

call gfxLDIRMV

5224

5225

; pre-calculate each sprite width

5226

gfxCalculateSpriteCollisionTable:

5227

ld ix, (GFX_SPRITE_COLLISION) ; start of sprites attributes

5228

ld b, 32 ; sprite count

5229

5230

gfxCalculateSpriteCollisionTable.start:

5231

ld a, (GFX_SPRITE_SIZE_DAT) ; sprite size

5232

ld c, a

5233

ld d, 208 ; Y no-display flag

5234

5235

; test screen mode

5236

ld a, (BIOS_SCRMOD)

5237

cp 3 ; above screen 3?

5238

jr c, gfxCalculateSpriteCollisionTable.next

5239

ld d, 216 ; Y no-display flag

5240

5241

gfxCalculateSpriteCollisionTable.next:

5242

; test IC flag (no collision) in color table

5243

; test EC flag (early clock, shift 32 dots to the left) in color table

5244

; set x1 = x + size, y1 = y + size

5245

ld a, (ix) ; y

5246

cp d ; test if sprite will not be displayed

5247

ret z

5248

5249

add a, c

5250

ld (ix+2), a ; y1

5251

ld a, (ix+1) ; x

5252

add a, c

5253

ld (ix+3), a ; x1

5254

5255

inc ix

5256

inc ix

5257

inc ix

5258

inc ix

5259

djnz gfxCalculateSpriteCollisionTable.next

5260

ret

5261

5262

; BC = sprite number to check

5263

gfxUpdateSpriteCollisionTable:

5264

ld (BIOS_TEMP), bc

5265

ld h, b

5266

ld l, c

5267

add hl, hl

5268

add hl, hl

5269

ld b, h

5270

ld c, l

5271

ld hl, (GFX_SPRITE_COLLISION) ; dest: ram

5272

add hl, bc

5273

ex de, hl

5274

ld hl, (BIOS_ATRBAS) ; source: attribute table

5275

add hl, bc

5276

ld bc, 4 ; 4 = size of attribute table to 1 sprite]

5277

push de

5278

call gfxLDIRMV

5279

pop ix

5280

ld b, 1 ; sprite count

5281

push ix

5282

call gfxCalculateSpriteCollisionTable.start

5283

pop iy

5284

5285

ld a, (GFX_SPRITE_FLAGS)

5286

and 0xBF ; clear collision flag

5287

ld (GFX_SPRITE_FLAGS), a

5288

5289

ld a, (BIOS_STATFL) ; verify if collision occurred

5290

bit 5, a

5291

ret z

5292

jr gfxCheckSpriteCollisionTable.start

5293

5294

; BC = sprite number to check

5295

gfxCheckSpriteCollisionTable:

5296

; get target sprite address (iy)

5297

ld (BIOS_TEMP), bc

5298

ld h, b

5299

ld l, c

5300

ld de, (GFX_SPRITE_COLLISION)

5301

add hl, hl ; x4

5302

add hl, hl

5303

add hl, de

5304

push hl

5305

pop iy

5306

5307

gfxCheckSpriteCollisionTable.start:

5308

; start test against others sprites

5309

ld ix, (GFX_SPRITE_COLLISION)

5310

ld bc, 0

5311

ld d, 208 ; Y no-display flag

5312

5313

; test screen mode

5314

ld a, (BIOS_SCRMOD)

5315

cp 3 ; above screen 3?

5316

jr c, gfxCheckSpriteCollisionTable.test

5317

ld d, 216 ; Y no-display flag

5318

5319

gfxCheckSpriteCollisionTable.test:

5320

; skip target sprite

5321

ld a, (BIOS_TEMP)

5322

cp c

5323

jr z, gfxCheckSpriteCollisionTable.next

5324

5325

; test if x1 > nx and x < nx1 and y1 > ny and y < ny1

5326

ld a, (ix) ; ny

5327

cp d ; test if sprite will not be displayed

5328

ret z ; return false

5329

5330

cp (iy+2) ; y1

5331

jr nc, gfxCheckSpriteCollisionTable.next

5332

5333

ld a, (ix+1) ; nx

5334

cp (iy+3) ; x1

5335

jr nc, gfxCheckSpriteCollisionTable.next

5336

5337

ld a, (iy+1) ; x

5338

cp (ix+3) ; nx1

5339

jr nc, gfxCheckSpriteCollisionTable.next

5340

5341

ld a, (iy) ; y

5342

cp (ix+2) ; ny1

5343

jr nc, gfxCheckSpriteCollisionTable.next

5344

5345

; if so, save collider sprite

5346

ld a, c

5347

ld (GFX_SPRITE_COLLIDER), a

5348

5349

ld a, (GFX_SPRITE_FLAGS)

5350

or 0x40 ; set collision flag

5351

ld (GFX_SPRITE_FLAGS), a

5352

ret ; return true

5353

5354

; else, next

5355

gfxCheckSpriteCollisionTable.next:

5356

inc c

5357

inc ix

5358

inc ix

5359

inc ix

5360

inc ix

5361

ld a, 32

5362

cp c

5363

ret z ; return false

5364

jr gfxCheckSpriteCollisionTable.test

5365

5366

5367

5368

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

5369

; VDP / VRAM support routines

5370

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

5371

5372

; WRITE TO VDP

5373

; in b = data

5374

; c = register number

5375

; a = register number

5376

gfxWRTVDP:

5377

bit 7, a

5378

ret nz ; is negative? read only

5379

cp 8

5380

ret z ; is register 8? then status register 0 (read only)

5381

jr nc, gfxWRTVDP.1 ; is > 8? then control registers numbers added 1

5382

jr gfxWRTVDP.3

5383

gfxWRTVDP.1:

5384

ld ix, BIOS_SCRMOD

5385

bit 3, (ix)

5386

jr nz, gfxWRTVDP.2

5387

bit 2, (ix)

5388

jr nz, gfxWRTVDP.2

5389

ret

5390

gfxWRTVDP.2:

5391

dec a

5392

ld c, a

5393

gfxWRTVDP.3:

5394

;ld ix, BIOS_SCRMOD

5395

;bit 3, (ix)

5396

;jp nz, BIOS_NWRVDP ; msx 2

5397

;bit 2, (ix)

5398

;jp nz, BIOS_NWRVDP ; msx 2

5399

jp BIOS_WRTVDP ; msx 1

5400

5401

; READ FROM VDP

5402

; in a = register number

5403

; out a = data

5404

gfxRDVDP:

5405

bit 7, a

5406

jr nz, gfxRDVDP.1 ; is negative? then status register 1 to 9

5407

cp 8

5408

jr z, gfxRDVDP.2 ; is register 8? then status register 0

5409

cp 9

5410

jr nc, gfxRDVDP.3 ; is >= 9? then control registers numbers added 1

5411

ld hl, BIOS_RG0SAV ; else is correct control registers numbers

5412

jr gfxRDVDP.4

5413

gfxRDVDP.1:

5414

ld ix, BIOS_SCRMOD

5415

bit 3, (ix)

5416

jr nz, gfxRDVDP.1.a

5417

bit 2, (ix)

5418

jr nz, gfxRDVDP.1.a

5419

xor a

5420

ret

5421

gfxRDVDP.1.a:

5422

neg

5423

jp BIOS_NRDVDP ;BIOS_VDPSTA

5424

gfxRDVDP.2:

5425

ld a, (BIOS_STATFL)

5426

ret

5427

;xor a

5428

;jp BIOS_VDPSTA

5429

gfxRDVDP.3:

5430

ld hl, BIOS_RG8SAV-9

5431

gfxRDVDP.4:

5432

ld d, 0

5433

ld e, a

5434

add hl,de

5435

ld a, (hl)

5436

ret

5437

5438

; in: A=Data byte, BC=Length, HL=VRAM address

5439

gfxFILVRM:

5440

ld ix, BIOS_SCRMOD

5441

bit 3, (ix)

5442

jp nz, BIOS_BIGFIL

5443

bit 2, (ix)

5444

jp nz, BIOS_BIGFIL

5445

jp BIOS_FILVRM

5446

5447

; in: A=Sprite pattern number

5448

; out: HL=Sprite pattern address

5449

gfxCALPAT:

5450

ld iy, BIOS_SCRMOD

5451

ld ix, BIOS_CALPAT2

5452

bit 3, (iy)

5453

jp nz, BIOS_EXTROM

5454

bit 2, (iy)

5455

jp nz, BIOS_EXTROM

5456

jp BIOS_CALPAT

5457

5458

; in: A=Sprite number

5459

; out: HL=Sprite attribute address

5460

gfxCALATR:

5461

ld iy, BIOS_SCRMOD

5462

ld ix, BIOS_CALATR2

5463

bit 3, (iy)

5464

jp nz, BIOS_EXTROM

5465

bit 2, (iy)

5466

jp nz, BIOS_EXTROM

5467

jp BIOS_CALATR

5468

5469

; out: A=Bytes in sprite pattern (8 or 32)

5470

gfxGSPSIZ:

5471

ld iy, BIOS_SCRMOD

5472

ld ix, BIOS_GSPSIZ2

5473

bit 3, (iy)

5474

jp nz, BIOS_EXTROM

5475

bit 2, (iy)

5476

jp nz, BIOS_EXTROM

5477

jp BIOS_GSPSIZ

5478

5479

gfxCLRSPR:

5480

ld iy, BIOS_SCRMOD

5481

ld ix, BIOS_CLRSPR2

5482

bit 3, (iy)

5483

jp nz, BIOS_EXTROM

5484

bit 2, (iy)

5485

jp nz, BIOS_EXTROM

5486

jp BIOS_CLRSPR

5487

5488

; RAM to VRAM

5489

; in: BC=Length, dest DE=VRAM address, source HL=RAM address

5490

gfxLDIRVM:

5491

jp BIOS_LDIRVM

5492

5493

; VRAM to RAM

5494

; in: BC=Length, dest DE=RAM address, source HL=VRAM address

5495

gfxLDIRMV:

5496

jp BIOS_LDIRMV

5497

5498

; WRITE TO VRAM

5499

; in hl = address

5500

; a = data

5501

gfxWRTVRM:

5502

ld ix, BIOS_SCRMOD

5503

bit 3, (ix)

5504

jp nz, BIOS_NWRVRM

5505

bit 2, (ix)

5506

jp nz, BIOS_NWRVRM

5507

jp BIOS_WRTVRM

5508

5509

; READ FROM VRAM

5510

; in hl = address

5511

; out a = data

5512

gfxRDVRM:

5513

ld ix, BIOS_SCRMOD

5514

bit 3, (ix)

5515

jp nz, BIOS_NRDVRM

5516

bit 2, (ix)

5517

jp nz, BIOS_NRDVRM

5518

jp BIOS_RDVRM

5519

5520

; reverse bits in A

5521

; 8 bytes / 206 cycles

5522

; http://www.retroprogramming.com/2014/01/fast-z80-bit-reversal.html

5523

gfxReverseA:

5524

ld b,8

5525

ld l,a

5526

gfxReverseA.loop:

5527

rl l

5528

rra

5529

djnz gfxReverseA.loop

5530

ret

5531

5532

5533

5534

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

5535

; MATH PACK WRAPPER

5536

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

5537

5538

CALL_MATH_LIB: exx

5539

ld hl, RET_MATH_LIB

5540

push hl

5541

ld hl, BASIC_DAC

5542

ld de, BASIC_ARG

5543

ld bc, BASIC_SWPTMP

5544

jp (ix)

5545

RET_MATH_LIB: call COPY_TO.TMP_DAC

5546

exx

5547

ret

5548

5549

if defined MATH.ADD

5550

5551

MATH_DECADD: ld ix, addSingle

5552

jp CALL_MATH_LIB

5553

5554

endif

5555

5556

if defined MATH.SUB or defined MATH.NEG

5557

5558

MATH_DECSUB: ld ix, subSingle

5559

jp CALL_MATH_LIB

5560

5561

endif

5562

5563

if defined MATH.MULT

5564

5565

MATH_DECMUL: ld ix, mulSingle

5566

jp CALL_MATH_LIB

5567

5568

endif

5569

5570

if defined MATH.DIV

5571

5572

MATH_DECDIV: ld ix, divSingle

5573

jp CALL_MATH_LIB

5574

5575

endif

5576

5577

if defined MATH.POW

5578

5579

MATH_DBLEXP:

5580

MATH_SNGEXP: ld ix, powSingle

5581

jp CALL_MATH_LIB

5582

5583

endif

5584

5585

if defined COS

5586

5587

MATH_COS: ld ix, cosSingle

5588

jp CALL_MATH_LIB

5589

5590

endif

5591

5592

if defined SIN

5593

5594

MATH_SIN: ld ix, sinSingle

5595

jp CALL_MATH_LIB

5596

5597

endif

5598

5599

if defined TAN

5600

5601

MATH_TAN: ld ix, tanSingle

5602

jp CALL_MATH_LIB

5603

5604

endif

5605

5606

if defined ATN

5607

5608

MATH_ATN: ld ix, atanSingle

5609

jp CALL_MATH_LIB

5610

5611

endif

5612

5613

if defined SQR

5614

5615

MATH_SQR: ld ix, sqrtSingle

5616

jp CALL_MATH_LIB

5617

5618

endif

5619

5620

if defined LOG

5621

5622

MATH_LOG: ld ix, lnSingle

5623

jp CALL_MATH_LIB

5624

5625

endif

5626

5627

if defined EXP

5628

5629

MATH_EXP: ld ix, expSingle

5630

jp CALL_MATH_LIB

5631

5632

endif

5633

5634

if defined ABS

5635

5636

MATH_ABSFN: ld ix, absSingle

5637

jp CALL_MATH_LIB

5638

5639

endif

5640

5641

if defined MATH.SEED or defined MATH.NEG

5642

5643

MATH_NEG: ld ix, negSingle

5644

jp CALL_MATH_LIB

5645

5646

endif

5647

5648

if defined SGN

5649

5650

MATH_SGN: ld ix, sgnSingle

5651

jp CALL_MATH_LIB

5652

5653

endif

5654

5655

if defined RND or defined MATH.SEED

5656

5657

MATH_RND: ld ix, randSingle

5658

jp CALL_MATH_LIB

5659

5660

endif

5661

5662

MATH_FRCINT: ld hl, BASIC_DAC

5663

ld bc, BASIC_DAC+2

5664

call single2Int

5665

ld ix, BASIC_DAC

5666

ld (ix), 0

5667

ld (ix+1), 0

5668

;ld (ix+2), l

5669

;ld (ix+3), h

5670

ld (ix+4), 0

5671

ld (ix+5), 0

5672

ld (ix+6), 0

5673

ld (ix+7), 0

5674

ld a, 2

5675

ld (BASIC_VALTYP), a

5676

ret

5677

5678

MATH_FRCDBL: ; same as MATH_FRCSGL

5679

MATH_FRCSGL: ld hl, BASIC_DAC+2 ; input address

5680

ld bc, BASIC_DAC ; output address

5681

call int2Single

5682

ld a, 8

5683

ld (BASIC_VALTYP), a

5684

ret

5685

5686

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

5687

cp d

5688

jr nz, MATH_ICOMP.NE.HIGH

5689

ld a, l

5690

cp e

5691

jr nz, MATH_ICOMP.NE.LOW

5692

jr MATH_DCOMP.EQ

5693

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

5694

bit 7, a

5695

jr nz, MATH_DCOMP.GT

5696

jr MATH_DCOMP.LT

5697

MATH_ICOMP.GT.HIGH: bit 7, d

5698

jr z, MATH_DCOMP.GT

5699

jr MATH_DCOMP.LT

5700

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

5701

jr MATH_DCOMP.LT

5702

5703

MATH_XDCOMP: ; same as MATH_DCOMP

5704

MATH_DCOMP: ld ix, cmpSingle

5705

call CALL_MATH_LIB

5706

jr z, MATH_DCOMP.EQ

5707

jr c, MATH_DCOMP.LT

5708

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

5709

ret

5710

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

5711

ret

5712

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

5713

ret

5714

5715

if defined CAST_STR_TO.VAL

5716

5717

MATH_FIN: ; HL has the source string

5718

ld a, (BASIC_VALTYP)

5719

cp 2 ; test if integer

5720

jr nz, MATH_FIN.1

5721

ld hl, (BASIC_DAC+2)

5722

ld de, BASIC_STRBUF

5723

call StrToInt

5724

ld hl, BASIC_STRBUF

5725

ret

5726

MATH_FIN.1: ld BC, BASIC_DAC

5727

call str2single

5728

ret

5729

5730

endif

5731

5732

if defined CAST_INT_TO.STR

5733

5734

MATH_FOUT: ld a, (BASIC_VALTYP)

5735

cp 2 ; test if integer

5736

jr nz, MATH_FOUT.1

5737

ld hl, (BASIC_DAC+2)

5738

ld de, BASIC_STRBUF

5739

call IntToStr

5740

ld hl, BASIC_STRBUF

5741

ret

5742

MATH_FOUT.1: ld hl, BASIC_DAC

5743

ld bc, BASIC_STRBUF

5744

call single2str

5745

ld hl, BASIC_STRBUF

5746

ret

5747

5748

endif

5749

5750

5751

5752

5753

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

5754

; Z80FLOAT LIBRARY

5755

5756

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

5757

; References:

5758

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

5759

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

5760

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

5761

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

5762

; Parameters:

5763

; HL points to the first operand

5764

; DE points to the second operand (if needed)

5765

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

5766

; BC points to where the result should be output

5767

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

5768

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

5769

; exponent biased by +128.

5770

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

5771

; Adapted to MSXBas2Asm by Amaury Carvalho, 2019

5772

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

5773

5774

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

5775

; Work area

5776

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

5777

5778

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

5779

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

5780

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

5781

scrap: equ BASIC_HOLD8

5782

seed0: equ BASIC_RNDX

5783

seed1: equ seed0 + 4

5784

var48: equ scrap + 4

5785

quot: equ scrap + 1

5786

addend: equ scrap

5787

addend2: equ scrap+7 ;4 bytes

5788

var_x: equ BASIC_HOLD8 + 4 ;4 bytes

5789

var_y: equ var_x + 4 ;4 bytes

5790

var_z: equ var_y + 4 ;4 bytes

5791

var_a: equ var_z + 4 ;4 bytes

5792

var_b: equ var_a + 4 ;4 bytes

5793

var_c: equ var_b + 4 ;4 bytes

5794

temp: equ var_c + 4 ;4 bytes

5795

temp1: equ temp + 4 ;4 bytes

5796

temp2: equ temp1 + 4 ;4 bytes

5797

temp3: equ temp2 + 4 ;4 bytes

5798

5799

pow10exp_single: equ scrap+9

5800

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

5801

5802

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

5803

; addSingle

5804

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

5805

5806

;;Still need to tend to special cases

5807

addSingle:

5808

;;x+y

5809

push af

5810

push hl

5811

push de

5812

push bc

5813

addInject:

5814

inc de

5815

inc de

5816

inc hl

5817

inc hl

5818

ld a,(de)

5819

xor (hl)

5820

push af

5821

inc de

5822

inc hl

5823

ex de,hl

5824

ld a,(de)

5825

sub (hl)

5826

ex de,hl

5827

jr nc,$+5

5828

ex de,hl

5829

neg

5830

cp 24

5831

jp nc,add_unneeded

5832

push hl

5833

ld hl,addend+6

5834

dec de

5835

ld bc,0408h

5836

dec hl

5837

ld (hl),0

5838

sub c

5839

jr nc,$-5

5840

add a,c

5841

push af

5842

push hl

5843

ex de,hl

5844

ld a,(hl)

5845

or 80h

5846

ld (de),a

5847

dec de

5848

dec hl

5849

ldd

5850

ldd

5851

ex de,hl

5852

dec b

5853

jr z,$+7

5854

ld (hl),0

5855

dec hl

5856

djnz $-3

5857

pop hl

5858

pop af

5859

ld b,a

5860

jr z,noshift

5861

set 7,(hl)

5862

_1:

5863

push hl

5864

srl (hl)

5865

dec hl

5866

rr (hl)

5867

dec hl

5868

rr (hl)

5869

dec hl

5870

rr (hl)

5871

pop hl

5872

djnz _1

5873

noshift:

5874

pop hl ;bigger float

5875

dec hl

5876

ld b,(hl)

5877

dec hl

5878

dec hl

5879

ex de,hl

5880

pop af

5881

jp m,subtract

5882

ld hl,addend+2

5883

ld a,(hl)

5884

rla

5885

inc hl

5886

ld a,(de)

5887

adc a,(hl)

5888

ld (hl),a

5889

inc hl

5890

inc de

5891

ld a,(de)

5892

adc a,(hl)

5893

ld (hl),a

5894

inc hl

5895

inc de

5896

ld a,(de)

5897

set 7,a

5898

adc a,(hl)

5899

ld (hl),a

5900

inc hl

5901

inc de

5902

ld a,(de)

5903

ld (hl),a

5904

jp nc,add_done

5905

inc (hl)

5906

jp z,add_overflow

5907

dec hl

5908

rr (hl)

5909

dec hl

5910

rr (hl)

5911

dec hl

5912

rr (hl)

5913

jp add_done

5914

subtract:

5915

ld hl,addend

5916

xor a

5917

ld c,a

5918

sub (hl)

5919

ld (hl),a

5920

inc hl

5921

ld a,c

5922

sbc a,(hl)

5923

ld (hl),a

5924

inc hl

5925

ld a,c

5926

sbc a,(hl)

5927

ld (hl),a

5928

inc hl

5929

ld a,(de)

5930

sbc a,(hl)

5931

ld (hl),a

5932

inc hl

5933

inc de

5934

ld a,(de)

5935

sbc a,(hl)

5936

ld (hl),a

5937

inc hl

5938

inc de

5939

ld a,(de)

5940

set 7,a

5941

sbc a,(hl)

5942

ld (hl),a

5943

inc hl

5944

inc de

5945

ld a,(de)

5946

ld (hl),a

5947

dec de

5948

ex de,hl

5949

jr nc,negated

5950

ld hl,addend

5951

ld a,80h

5952

xor b

5953

ld b,a

5954

ld a,c

5955

sub (hl)

5956

ld (hl),a

5957

inc hl

5958

ld a,c

5959

sbc a,(hl)

5960

ld (hl),a

5961

inc hl

5962

ld a,c

5963

sbc a,(hl)

5964

ld (hl),a

5965

inc hl

5966

ld a,c

5967

sbc a,(hl)

5968

ld (hl),a

5969

inc hl

5970

ld a,c

5971

sbc a,(hl)

5972

ld (hl),a

5973

inc hl

5974

ld a,c

5975

sbc a,(hl)

5976

ld (hl),a

5977

negated:

5978

jp m,add_done

5979

push bc

5980

ld hl,(addend)

5981

ld de,(addend+2)

5982

ld bc,(addend+4)

5983

ld a,h

5984

or l

5985

or d

5986

or e

5987

or b

5988

or c

5989

jp z,add_underflow

5990

ld a,(addend+6)

5991

normalize:

5992

dec a

5993

jr z,add_underflow

5994

add hl,hl

5995

rl e

5996

rl d

5997

rl c

5998

rl b

5999

jp p,normalize

6000

ld (addend),hl

6001

ld (addend+2),de

6002

ld (addend+4),bc

6003

ld (addend+6),a

6004

pop bc

6005

add_done:

6006

;;Need to adjust sign flag

6007

ld hl,addend+5

6008

ld a,(hl)

6009

rla

6010

rl b

6011

rra

6012

ld (hl),a

6013

dec hl

6014

dec hl

6015

add_copy:

6016

pop de

6017

push de

6018

ldi

6019

ldi

6020

ldi

6021

ld a,(hl)

6022

ld (de),a

6023

pop bc

6024

pop de

6025

pop hl

6026

pop af

6027

ret

6028

add_underflow:

6029

;;How many push/pops are needed?

6030

;;return ZERO

6031

ld hl,0

6032

ld (addend+3),hl

6033

ld (addend+5),hl

6034

pop bc

6035

jr add_done

6036

add_overflow:

6037

;;How many push/pops are needed?

6038

;;return INF

6039

dec hl

6040

ld (hl),40h

6041

jr add_done

6042

add_unneeded:

6043

;;How many push/pops are needed?

6044

;;Return bigger number

6045

pop af

6046

dec hl

6047

dec hl

6048

dec hl

6049

jr add_copy

6050

6051

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

6052

; subSingle

6053

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

6054

6055

subSingle:

6056

;;x-y

6057

push af

6058

push hl

6059

push de

6060

push bc

6061

push hl

6062

ex de,hl

6063

ld de,addend2

6064

ldi

6065

ldi

6066

ld a,(hl)

6067

xor 80h

6068

ld (de),a

6069

inc de

6070

inc hl

6071

ld a,(hl)

6072

ld (de),a

6073

ex de,hl

6074

pop hl

6075

ld de,addend2

6076

jp addInject ;jumps in to the addSingle routine

6077

6078

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

6079

; mulSingle

6080

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

6081

6082

mulSingle:

6083

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

6084

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

6085

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

6086

;min: 1398cc

6087

;max: 2564cc

6088

;avg: 2055.13839751681cc

6089

push af

6090

push hl

6091

push de

6092

push bc

6093

6094

call _2 ;CHLB

6095

ld a,c

6096

ex de,hl

6097

pop hl

6098

push hl

6099

ld (hl),b

6100

inc hl

6101

ld (hl),e

6102

inc hl

6103

ld (hl),d

6104

inc hl

6105

ld (hl),a

6106

pop bc

6107

pop de

6108

pop hl

6109

pop af

6110

ret

6111

6112

6113

_2:

6114

;;return float in CHLB

6115

push de

6116

ld e,(hl)

6117

inc hl

6118

ld d,(hl)

6119

inc hl

6120

ld c,(hl)

6121

inc hl

6122

ld a,(hl)

6123

or a

6124

jr z,mulSingle_case0

6125

ex de,hl

6126

ex (sp),hl

6127

ld e,(hl)

6128

inc hl

6129

ld d,(hl)

6130

inc hl

6131

ld b,(hl)

6132

inc hl

6133

6134

;inc (hl)

6135

;dec (hl)

6136

;jr z,mulSingle_case1

6137

push af

6138

ld a, (hl)

6139

or a

6140

jp z,mulSingle_case1

6141

pop af

6142

6143

add a,(hl) ;\

6144

pop hl ; |

6145

rra ; |Lots of help from Runer112 and

6146

adc a,a ; |calc84maniac for optimizing

6147

jp po,bad ; |this exponent check.

6148

xor 80h ; |

6149

jr z,underflow ;/

6150

push af ;exponent

6151

ld a,b

6152

xor c

6153

push af ;sign

6154

set 7,b

6155

set 7,c

6156

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

6157

pop de

6158

ld a,e

6159

pop de

6160

jp m,_3

6161

rl c

6162

rl b

6163

adc hl,hl

6164

dec d

6165

_3:

6166

inc d

6167

jr z,overflow

6168

rl c

6169

ld c,d

6170

ld de,0

6171

push af

6172

ld a,b

6173

adc a,e

6174

ld b,a

6175

adc hl,de

6176

jr nc,_4

6177

inc c

6178

jr z,overflow

6179

rr h

6180

rr l

6181

rr b

6182

_4:

6183

pop af

6184

cpl

6185

and $80

6186

xor h

6187

ld h,a

6188

ret

6189

bad:

6190

jr nc,overflow

6191

underflow:

6192

ld hl,0

6193

rl b

6194

rr h

6195

ld c,l

6196

ld b,l

6197

ret

6198

overflow:

6199

ld hl,$8000

6200

jr underflow+3

6201

mulSingle_case1:

6202

;x*0 -> 0

6203

;x*inf -> inf

6204

;x*NaN -> NaN

6205

pop af

6206

pop hl

6207

ld h,b

6208

ld l,d

6209

ld b,e

6210

ld c,0

6211

ret

6212

mulSingle_case0:

6213

;special*x = special

6214

;NaN*x = NaN

6215

;0*0 = 0

6216

;0*NaN = NaN

6217

;0*Inf = NaN

6218

;Inf*Inf = Inf

6219

;Inf*-Inf =-Inf

6220

;0CDE

6221

pop hl

6222

inc hl

6223

inc hl

6224

inc hl

6225

ld a,(hl)

6226

or a

6227

jr z,_5

6228

ld h,c

6229

ld c,0

6230

ret

6231

_5:

6232

dec hl

6233

ld b,(hl)

6234

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

6235

ld a,b

6236

or c

6237

ld h,$20

6238

and h

6239

jr z,_6

6240

ld c,0

6241

ret

6242

_6:

6243

ld a,c

6244

xor b

6245

rl b

6246

rlca

6247

rr b

6248

res 4,b

6249

6250

rl c

6251

rrca

6252

rr c

6253

6254

ld a,c

6255

and $E0

6256

add a,b

6257

rra

6258

ld h,a

6259

ld c,0

6260

ret

6261

mul24:

6262

;;BDE*CHL -> HLBCDE

6263

;;155 bytes

6264

;;402+3*C_Times_BDE

6265

;;fastest:1201cc

6266

;;slowest:1753cc

6267

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

6268

;min: 825cc

6269

;max: 1926cc

6270

;avg: 1449.63839751681cc

6271

6272

push bc

6273

ld c,l

6274

push hl

6275

call C_Times_BDE

6276

ld (var48),hl

6277

ld l,a

6278

ld h,c

6279

ld (var48+2),hl

6280

6281

pop hl

6282

ld c,h

6283

call C_Times_BDE

6284

push bc

6285

ld bc,(var48+1)

6286

add hl,bc

6287

ld (var48+1),hl

6288

pop bc

6289

ld b,c

6290

ld c,a

6291

ld hl,(var48+3)

6292

ld h,0

6293

adc hl,bc

6294

ld (var48+3),hl

6295

6296

pop bc

6297

call C_Times_BDE

6298

ld de,(var48+2)

6299

add hl,de

6300

ld (var48+2),hl

6301

ld d,c

6302

ld e,a

6303

ld b,h

6304

ld c,l

6305

ld hl,(var48+4)

6306

ld h,0

6307

adc hl,de

6308

ld de,(var48)

6309

ret

6310

6311

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

6312

; divSingle

6313

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

6314

6315

divSingle:

6316

;;HL points to numerator

6317

;;DE points to denominator

6318

;;BC points to where the quotient gets written

6319

call pushpop

6320

divSingle_no_pushpop:

6321

inc hl

6322

inc de

6323

inc hl

6324

inc de

6325

ld a,(de) ;\

6326

xor (hl) ; |Get sign of output

6327

add a,a ; |

6328

push af ;/

6329

push bc

6330

inc hl

6331

inc de

6332

ld a,(hl) ;\

6333

ex de,hl ; |Get exponent

6334

sub (hl) ; |

6335

ex de,hl ; |

6336

6337

ld b,-1

6338

jr nc,_7

6339

dec b

6340

_7:

6341

add a,128

6342

jr nc,_8

6343

inc b

6344

_8:

6345

inc b

6346

jr z,_9

6347

jp p,divunderflow

6348

jp m,divoverflow

6349

_9:

6350

ld (quot+3),a

6351

dec hl

6352

dec de

6353

ld b,(hl)

6354

dec hl

6355

ld a,(hl)

6356

dec hl

6357

ld l,(hl)

6358

ld h,a

6359

ex de,hl

6360

6361

ld c,(hl)

6362

dec hl

6363

ld a,(hl)

6364

dec hl

6365

ld l,(hl)

6366

ld h,a

6367

ex de,hl

6368

6369

set 7,c

6370

ld a,b

6371

or 80h

6372

sbc hl,de

6373

sbc a,c

6374

jr nz,_10

6375

or h

6376

or l

6377

jr z,setmantissa0

6378

xor a

6379

_10:

6380

jr nc,startdiv

6381

ld b,a

6382

ld a,(quot+3)

6383

dec a

6384

ld (quot+3),a

6385

ld a,b

6386

add hl,hl

6387

adc a,a

6388

add hl,de

6389

adc a,c

6390

startdiv:

6391

ld b,1

6392

call divsub0+3

6393

ld (quot+1),bc

6394

call divsub0

6395

ld (quot),bc

6396

call divsub0

6397

ld (quot-1),bc

6398

add hl,hl

6399

rla

6400

jr c,_11

6401

sbc hl,de

6402

sbc a,c

6403

ccf

6404

_11:

6405

ld hl,(quot)

6406

ld de,(quot+2)

6407

ld bc,0

6408

adc hl,bc

6409

ex de,hl

6410

adc hl,bc

6411

ld b,h

6412

ld c,l

6413

writeback:

6414

pop hl

6415

ld (hl),e

6416

inc hl

6417

ld (hl),d

6418

inc hl

6419

rl c

6420

pop af

6421

rr c

6422

ld (hl),c

6423

inc hl

6424

ld (hl),b

6425

ret

6426

divoverflow:

6427

ld b,$40

6428

jr _12

6429

divunderflow:

6430

ld b,0

6431

jr _12

6432

setmantissa0:

6433

ld bc,(quot+2)

6434

_12:

6435

ld de,0

6436

ld c,e

6437

jr writeback

6438

divsub0:

6439

;;882cc max

6440

call divsub1 ;34 or 66

6441

call divsub1 ;

6442

call divsub1

6443

call divsub1

6444

call divsub1

6445

call divsub1

6446

call divsub1

6447

call divsub1

6448

or a

6449

sbc hl,de

6450

sbc a,c

6451

inc b

6452

ret nc

6453

dec b

6454

add hl,de

6455

adc a,c

6456

ret

6457

divsub1:

6458

;34cc or 66cc or 93cc

6459

sla b

6460

add hl,hl

6461

rla

6462

ret nc

6463

or a

6464

inc b

6465

sbc hl,de

6466

sbc a,c

6467

ret c

6468

inc b

6469

sbc hl,de

6470

sbc a,c

6471

ret

6472

6473

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

6474

; powSingle

6475

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

6476

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

6477

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

6478

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

6479

;{

6480

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

6481

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

6482

; else if ( precision >= 1 ) {

6483

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

6484

; else return sqrt( -base );

6485

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

6486

;}

6487

6488

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

6489

6490

powSingle:

6491

;;Computes y^x

6492

;;HL points to y

6493

;;DE points to x

6494

;;BC points to output

6495

call pushpop

6496

push bc

6497

push de

6498

ld bc, var_y ; power

6499

call copySingle

6500

pop hl

6501

ld bc, var_x ; base

6502

call copySingle

6503

ld hl, const_precision

6504

ld bc, var_a ; precision

6505

call copySingle

6506

ld hl, const_0

6507

ld bc, var_z ; result

6508

call copySingle

6509

call powSingle.loop

6510

pop bc

6511

ld hl, var_z

6512

call copySingle

6513

ret

6514

6515

powSingle.loop:

6516

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

6517

ld hl, var_y

6518

ld de, const_0

6519

call cmpSingle

6520

jp c, powSingle.1

6521

6522

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

6523

ld hl, var_y

6524

ld de, const_1

6525

call cmpSingle

6526

jp nc, powSingle.2

6527

6528

; else if ( precision >= 1 ) {

6529

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

6530

; else return sqrt( -base );

6531

ld hl, var_a

6532

ld de, const_1

6533

call cmpSingle

6534

jp nc, powSingle.3

6535

6536

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

6537

ld hl, var_y

6538

ld de, const_2

6539

ld bc, var_b

6540

call mulSingle

6541

ld hl, var_b

6542

ld bc, var_y

6543

call copySingle

6544

ld hl, var_a

6545

ld de, const_2

6546

ld bc, var_b

6547

call mulSingle

6548

ld hl, var_b

6549

ld bc, var_a

6550

call copySingle

6551

call powSingle.loop

6552

ld hl, var_z

6553

ld bc, var_b

6554

call sqrtSingle

6555

ld hl, var_b

6556

ld bc, var_z

6557

call copySingle

6558

ret

6559

6560

powSingle.1:

6561

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

6562

ld hl, const_0

6563

ld de, var_y

6564

ld bc, var_b

6565

call subSingle

6566

ld hl, var_b

6567

ld bc, var_y

6568

call copySingle

6569

call powSingle.loop

6570

ld hl, const_1

6571

ld de, var_z

6572

ld bc, var_b

6573

call divSingle

6574

ld hl, var_b

6575

ld bc, var_z

6576

call copySingle

6577

ret

6578

6579

powSingle.2:

6580

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

6581

ld hl, var_y

6582

ld de, const_1

6583

ld bc, var_b

6584

call subSingle

6585

ld hl, var_b

6586

ld bc, var_y

6587

call copySingle

6588

call powSingle.loop

6589

ld hl, var_z

6590

ld de, var_x

6591

ld bc, var_b

6592

call mulSingle

6593

ld hl, var_b

6594

ld bc, var_z

6595

call copySingle

6596

ret

6597

6598

powSingle.3:

6599

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

6600

; else return sqrt( -base );

6601

ld hl, var_x

6602

ld de, const_0

6603

call cmpSingle

6604

jp nc, powSingle.1

6605

;ld hl, var_x

6606

ld bc, var_b

6607

call negSingle

6608

ld hl, var_b

6609

;ld bc, var_z

6610

;call sqrtSingle

6611

;ret

6612

6613

powSingle.3.1:

6614

;ld hl, var_x

6615

ld bc, var_z

6616

call sqrtSingle

6617

ret

6618

6619

pow2Single:

6620

;;Computes 2^x

6621

call pushpop

6622

push bc

6623

6624

exp_inject:

6625

;if x is on [0,1):

6626

; 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)))))

6627

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

6628

;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.

6629

;

6630

;int(x) -> out_exp

6631

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

6632

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

6633

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

6634

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

6635

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

6636

ld de,var48+10

6637

call mov4

6638

ld hl,(var48+10)

6639

ld de,(var48+12)

6640

ld a,e

6641

add a,a

6642

push af ;keep track of sign

6643

rrca

6644

ld (var48+12),a

6645

ld c,a

6646

ld a,d

6647

or a

6648

jp z,exp_spec

6649

cp 80h-23

6650

jp c,exp_underflow

6651

sub 128 ; sub a,128

6652

jr c,_pow_1 ;int(x)=0

6653

inc a

6654

cp 7

6655

jp nc,exp_overflow

6656

set 7,c

6657

ld b,a

6658

xor a

6659

add hl,hl

6660

rl c

6661

rla

6662

djnz $-4

6663

ld b,7Fh

6664

bit 7,c

6665

jr nz,exp_normalized

6666

ld e,a

6667

ld a,h

6668

or l

6669

or c

6670

ld a,e

6671

jr z,exp_zeroed

6672

dec b

6673

add hl,hl

6674

rl c

6675

jp p,$-4

6676

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

6677

exp_zeroed:

6678

ld b,0

6679

exp_normalized:

6680

ld (var48+10),hl

6681

res 7,c

6682

ld (var48+12),bc

6683

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

6684

_pow_1:

6685

xor a

6686

comp_exp:

6687

pop hl

6688

rr l

6689

jr nc,_pow_2

6690

cpl

6691

or a

6692

jp z,exp_underflow+1

6693

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

6694

ld hl,const_1

6695

ld de,var48+10

6696

ld b,d

6697

ld c,e

6698

call subSingle

6699

_pow_2:

6700

push af

6701

;our 'x' is at var48+10

6702

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

6703

;uses 14 bytes of RAM

6704

ld hl,var48+10

6705

ld de,exp_a6

6706

ld bc,var48+6

6707

call mulSingle

6708

ld d,b

6709

ld e,c

6710

ld hl,exp_a5

6711

call addSingle

6712

ld hl,var48+10

6713

call mulSingle

6714

ld hl,exp_a4

6715

call addSingle

6716

ld hl,var48+10

6717

call mulSingle

6718

ld hl,exp_a3

6719

call addSingle

6720

ld hl,var48+10

6721

call mulSingle

6722

ld hl,exp_a2

6723

call addSingle

6724

ld hl,var48+10

6725

call mulSingle

6726

ld hl,exp_a1

6727

call addSingle

6728

ld hl,var48+10

6729

call mulSingle

6730

ld hl,const_1

6731

call addSingle

6732

ld hl,var48+9

6733

pop af

6734

add a,(hl)

6735

ld (hl),a

6736

ex de,hl

6737

pop de

6738

jp mov4

6739

exp_spec:

6740

;bit 6 means INF

6741

;bit 5 means NAN

6742

;no bits means zero

6743

;NAN -> NAN

6744

;+inf -> +inf

6745

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

6746

ld a,c

6747

add a,a

6748

jr z,exp_zero

6749

jp m,exp_inf

6750

;exp_NAN

6751

pop af

6752

ld de,0040h

6753

exp_return_spec:

6754

pop hl

6755

rr e

6756

ld (hl),a

6757

inc hl

6758

ld (hl),a

6759

inc hl

6760

ld (hl),e

6761

inc hl

6762

ld (hl),d

6763

ret

6764

exp_overflow:

6765

exp_inf:

6766

;+inf -> +inf

6767

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

6768

pop af

6769

sbc a,a ;FF if should be 0,

6770

cpl

6771

and 80h

6772

ld d,0

6773

ld e,a

6774

jr exp_return_spec

6775

exp_underflow:

6776

exp_zero:

6777

pop af

6778

or a

6779

ld de,$8000

6780

jr exp_return_spec

6781

6782

endif

6783

6784

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

6785

; sqrtSingle

6786

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

6787

6788

if defined MATH_SQR or defined MATH_EXP

6789

6790

;Uses 3 bytes at scrap

6791

sqrtSingle:

6792

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

6793

;min: 1784

6794

;max: 1987

6795

;avg: 1872

6796

call pushpop

6797

push bc

6798

ld c,(hl)

6799

inc hl

6800

ld e,(hl)

6801

inc hl

6802

ld a,(hl)

6803

add a,a

6804

jp c,sqrtSingle_NaN

6805

scf

6806

rra

6807

ld d,a

6808

inc hl

6809

ld a,(hl)

6810

or a

6811

jp z,sqrtSingle_special

6812

add a,80h

6813

rra

6814

push af ;new exponent

6815

jr c,_13

6816

srl d

6817

rr e

6818

rr c

6819

_13:

6820

ex de,hl

6821

ld ixh,c

6822

ld ixl,0

6823

call sqrtHLIX

6824

;AHL is the new remainder

6825

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

6826

rra

6827

ld a,h

6828

;HL/DE to 8 bits

6829

;We are just going to approximate it

6830

res 0,l

6831

jr c,$+5

6832

cp d

6833

jr c,$+4

6834

sub d

6835

inc l

6836

sla l

6837

rla

6838

jr c,$+5

6839

cp d

6840

jr c,$+4

6841

sub d

6842

inc l

6843

sla l

6844

rla

6845

jr c,$+5

6846

cp d

6847

jr c,$+4

6848

sub d

6849

inc l

6850

sla l

6851

rla

6852

jr c,$+5

6853

cp d

6854

jr c,$+4

6855

sub d

6856

inc l

6857

sla l

6858

rla

6859

jr c,$+5

6860

cp d

6861

jr c,$+4

6862

sub d

6863

inc l

6864

sla l

6865

rla

6866

jr c,$+5

6867

cp d

6868

jr c,$+4

6869

sub d

6870

inc l

6871

sla l

6872

rla

6873

jr c,$+5

6874

cp d

6875

jr c,$+4

6876

sub d

6877

inc l

6878

sla l

6879

rla

6880

jr c,$+5

6881

cp d

6882

jr c,$+4

6883

sub d

6884

inc l

6885

6886

pop bc

6887

ld a,l

6888

pop hl

6889

;BDEA

6890

ld (hl),a

6891

inc hl

6892

ld (hl),e

6893

inc hl

6894

res 7,d

6895

ld (hl),d

6896

inc hl

6897

ld (hl),b

6898

ret

6899

sqrtSingle_NaN:

6900

ld hl,const_NaN

6901

pop de

6902

jp mov4

6903

sqrtSingle_special:

6904

dec hl

6905

dec hl

6906

pop de

6907

jp mov4

6908

6909

sqrtHLIX:

6910

;Input: HLIX

6911

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

6912

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

6913

;min: 1130

6914

;max: 1266

6915

;avg: 1190.5

6916

6917

6918

call sqrtHL

6919

add a,a

6920

ld e,a

6921

jr nc,_14

6922

inc d

6923

_14:

6924

6925

ld a,ixh

6926

sll e

6927

rl d

6928

add a,a

6929

adc hl,hl

6930

add a,a

6931

adc hl,hl

6932

sbc hl,de

6933

jr nc,_15

6934

add hl,de

6935

dec e

6936

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

6937

_15:

6938

inc e

6939

_15a:

6940

sll e

6941

rl d

6942

add a,a

6943

adc hl,hl

6944

add a,a

6945

adc hl,hl

6946

sbc hl,de

6947

jr nc,_16

6948

add hl,de

6949

dec e

6950

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

6951

_16:

6952

inc e

6953

_16a:

6954

sll e

6955

rl d

6956

add a,a

6957

adc hl,hl

6958

add a,a

6959

adc hl,hl

6960

sbc hl,de

6961

jr nc,_17

6962

add hl,de

6963

dec e

6964

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

6965

_17:

6966

inc e

6967

_17a:

6968

sll e

6969

rl d

6970

add a,a

6971

adc hl,hl

6972

add a,a

6973

adc hl,hl

6974

sbc hl,de

6975

jr nc,_18

6976

add hl,de

6977

dec e

6978

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

6979

_18:

6980

inc e

6981

_18a:

6982

;Now we have four more iterations

6983

;The first two are no problem

6984

ld a,ixl

6985

sll e

6986

rl d

6987

add a,a

6988

adc hl,hl

6989

add a,a

6990

adc hl,hl

6991

sbc hl,de

6992

jr nc,_19

6993

add hl,de

6994

dec e

6995

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

6996

_19:

6997

inc e

6998

_19a:

6999

sll e

7000

rl d

7001

add a,a

7002

adc hl,hl

7003

add a,a

7004

adc hl,hl

7005

sbc hl,de

7006

jr nc,_20

7007

add hl,de

7008

dec e

7009

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

7010

_20:

7011

inc e

7012

_20a:

7013

sqrt32_iter15:

7014

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

7015

sll e

7016

rl d ;sla e \ rl d \ inc e

7017

add a,a

7018

adc hl,hl

7019

add a,a

7020

adc hl,hl ;This might overflow!

7021

jr c,sqrt32_iter15_br0

7022

;

7023

sbc hl,de

7024

jr nc,_21

7025

add hl,de

7026

dec e

7027

jr sqrt32_iter16

7028

sqrt32_iter15_br0:

7029

or a

7030

sbc hl,de

7031

_21:

7032

inc e

7033

7034

;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

7035

sqrt32_iter16:

7036

add a,a

7037

ld b,a ;either 0x00 or 0x80

7038

adc hl,hl

7039

rla

7040

adc hl,hl

7041

rla

7042

;AHL - (DE+DE+1)

7043

sbc hl,de

7044

sbc a,b

7045

inc e

7046

or a

7047

sbc hl,de

7048

sbc a,b

7049

ret p

7050

add hl,de

7051

adc a,b

7052

dec e

7053

add hl,de

7054

adc a,b

7055

ret

7056

7057

sqrtHL:

7058

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

7059

;min: 376cc

7060

;max: 416cc

7061

;avg: 393cc

7062

ld de,$5040

7063

ld a,h

7064

sub e

7065

jr nc,_22

7066

add a,e

7067

ld d,$10

7068

_22:

7069

sub d

7070

jr nc,_23

7071

add a,d

7072

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

7073

_23:

7074

set 5,d

7075

_23a:

7076

res 4,d

7077

srl d

7078

7079

set 2,d

7080

sub d

7081

jr nc,_24

7082

add a,d

7083

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

7084

_24:

7085

set 3,d

7086

_24a:

7087

res 2,d

7088

srl d

7089

7090

inc d

7091

sub d

7092

jr nc,_25

7093

add a,d

7094

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

7095

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

7096

_25:

7097

inc d

7098

_25a:

7099

srl d

7100

ld h,a

7101

7102

7103

sbc hl,de

7104

ld a,e

7105

jr nc,_26

7106

add hl,de

7107

_26:

7108

ccf

7109

rra

7110

srl d

7111

rra

7112

ld e,a

7113

7114

sbc hl,de

7115

jr nc,_27

7116

add hl,de

7117

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

7118

_27:

7119

or %00100000

7120

_27a:

7121

xor %00011000

7122

srl d

7123

rra

7124

ld e,a

7125

7126

7127

sbc hl,de

7128

jr nc,_28

7129

add hl,de

7130

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

7131

_28:

7132

or %00001000

7133

_28a:

7134

xor %00000110

7135

srl d

7136

rra

7137

ld e,a

7138

sbc hl,de

7139

jr nc,_29

7140

add hl,de

7141

srl d

7142

rra

7143

ret

7144

_29:

7145

inc a

7146

srl d

7147

rra

7148

ret

7149

7150

endif

7151

7152

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

7153

; lnSingle

7154

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

7155

7156

if defined MATH_LOG or defined MATH_LN

7157

7158

lnSingle:

7159

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

7160

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

7161

call pushpop

7162

push bc

7163

ld de, const_100_inv

7164

ld bc, temp

7165

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

7166

ld hl, temp

7167

ld de, const_100

7168

ld bc, temp1

7169

call mulSingle ; temp1 = temp * 100

7170

ld hl, temp1

7171

pop bc

7172

call subSingle ; bc = temp1 - 100

7173

ret

7174

7175

endif

7176

7177

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

7178

; logSingle

7179

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

7180

7181

if defined MATH_LOG

7182

7183

logSingle:

7184

call pushpop

7185

push bc

7186

ld bc, temp

7187

call lnSingle

7188

ld hl, temp

7189

ld de, const_lg10

7190

pop bc

7191

call divSingle

7192

ret

7193

7194

endif

7195

7196

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

7197

; expSingle

7198

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

7199

7200

if defined MATH_EXP

7201

7202

expSingle:

7203

;;Computes e^x

7204

;;HL points to x

7205

;;BC points to the output

7206

call pushpop

7207

ld de,const_lg_e

7208

push bc

7209

pow_inject:

7210

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

7211

ld bc,var_x

7212

call mulSingle

7213

ld h,b

7214

ld l,c

7215

jp exp_inject

7216

7217

endif

7218

7219

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

7220

; sinSingle

7221

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

7222

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

7223

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

7224

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

7225

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

7226

7227

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

7228

7229

sinSingle:

7230

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

7231

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

7232

; reduction:

7233

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

7234

; var_c = x - var_b*2*PI

7235

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

7236

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

7237

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

7238

7239

call pushpop

7240

ld de, const_0

7241

call cmpSingle

7242

jr nz, sinSingle.1

7243

7244

call copySingle ; return 0

7245

ret

7246

7247

sinSingle.1:

7248

call trigRangeReductionSinCos

7249

push bc

7250

ld hl, var_a

7251

ld de, var_a

7252

ld bc, var_b

7253

call mulSingle ; var_b = var_a * var_a

7254

ld hl, var_b

7255

ld de, sin_a3

7256

ld bc, temp

7257

call mulSingle ; temp = x^2/5040

7258

ld hl, sin_a2

7259

ld de, temp

7260

ld bc, temp1

7261

call subSingle ; temp1 = 1/120 - temp

7262

ld hl, var_b

7263

ld de, temp1

7264

ld bc, temp

7265

call mulSingle ; temp = x^2 * temp1

7266

ld hl, sin_a1

7267

ld de, temp

7268

ld bc, temp1

7269

call subSingle ; temp1 = 1/6 - temp

7270

ld hl, var_b

7271

ld de, temp1

7272

ld bc, temp

7273

call mulSingle ; temp = x^2 * temp1

7274

ld hl, const_1

7275

ld de, temp

7276

ld bc, temp1

7277

call subSingle ; temp1 = 1 - temp

7278

ld hl, var_a

7279

ld de, temp1

7280

pop bc

7281

call mulSingle ; return x * temp1

7282

ret

7283

7284

trigRangeReductionSinCos:

7285

call pushpop

7286

push hl

7287

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

7288

ld de, const_2pi

7289

ld bc, var_c

7290

call divSingle

7291

ld hl, var_c

7292

ld de, 0

7293

ld bc, var_b

7294

call roundSingle

7295

; var_c = x - var_b*2*PI

7296

ld hl, var_b

7297

ld de, const_2pi

7298

ld bc, temp

7299

call mulSingle ; temp = var_b*2*PI

7300

pop hl

7301

ld de, temp

7302

ld bc, var_c

7303

call subSingle ; var_c = x - temp

7304

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

7305

ld hl, var_c

7306

ld de, const_0

7307

call cmpSingle

7308

jr nc, trigRangeReductionSinCos.else.2

7309

ld hl, var_c

7310

ld bc, temp1

7311

call copySingle ; temp1 = var_c

7312

jr trigRangeReductionSinCos.endif.2

7313

trigRangeReductionSinCos.else.2:

7314

ld hl, var_c

7315

ld de, const_2pi

7316

ld bc, temp1

7317

call addSingle ; temp1 = var_c + 2*PI

7318

trigRangeReductionSinCos.endif.2:

7319

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

7320

ld hl, const_pi

7321

ld de, temp1

7322

call cmpSingle

7323

jr c, trigRangeReductionSinCos.else.3

7324

jr z, trigRangeReductionSinCos.else.3

7325

ld hl, temp1

7326

ld de, const_pi

7327

ld bc, temp2

7328

call subSingle ; temp2

7329

jr trigRangeReductionSinCos.endif.3

7330

trigRangeReductionSinCos.else.3:

7331

ld hl, temp1

7332

ld bc, temp2

7333

call copySingle ; temp2 = temp1

7334

trigRangeReductionSinCos.endif.3:

7335

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

7336

ld hl, const_half_pi

7337

ld de, temp2

7338

call cmpSingle

7339

jr c, trigRangeReductionSinCos.else.4

7340

jr z, trigRangeReductionSinCos.else.4

7341

ld hl, const_pi

7342

ld de, temp2

7343

ld bc, var_a

7344

call subSingle ; var_a

7345

jr trigRangeReductionSinCos.endif.4

7346

trigRangeReductionSinCos.else.4:

7347

ld hl, temp2

7348

ld bc, var_a

7349

call copySingle ; var_a = temp2

7350

trigRangeReductionSinCos.endif.4:

7351

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

7352

ld hl, temp1

7353

ld de, const_pi

7354

call cmpSingle

7355

jr nc, trigRangeReductionSinCos.endif.5

7356

ld ix, var_a

7357

ld a, (ix+2)

7358

set 7, a

7359

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

7360

trigRangeReductionSinCos.endif.5:

7361

; return var_a

7362

ret

7363

7364

endif

7365

7366

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

7367

; cosSingle

7368

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

7369

7370

if defined MATH_COS or defined MATH_TAN

7371

7372

cosSingle:

7373

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

7374

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

7375

; reduction: same as sin

7376

; cos = cos * sign

7377

7378

call pushpop

7379

ld de, const_0

7380

call cmpSingle

7381

jr nz, cosSingle.1

7382

7383

ld hl, const_1

7384

call copySingle ; return 1

7385

ret

7386

7387

cosSingle.1:

7388

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

7389

call trigRangeReductionSinCos

7390

push bc

7391

ld hl, var_a

7392

ld de, var_a

7393

ld bc, var_b

7394

call mulSingle ; var_b = var_a * var_a

7395

ld hl, var_b

7396

ld de, cos_a3

7397

ld bc, temp

7398

call mulSingle ; temp = x^2/720

7399

ld hl, cos_a2

7400

ld de, temp

7401

ld bc, temp1

7402

call subSingle ; temp1 = 1/24 - temp

7403

ld hl, var_b

7404

ld de, temp1

7405

ld bc, temp

7406

call mulSingle ; temp = x^2 * temp1

7407

ld hl, cos_a1

7408

ld de, temp

7409

ld bc, temp1

7410

call subSingle ; temp1 = 1/2 - temp

7411

ld hl, var_b

7412

ld de, temp1

7413

ld bc, temp

7414

call mulSingle ; temp = x^2 * temp1

7415

ld hl, const_1

7416

ld de, temp

7417

ld bc, temp1

7418

call subSingle ; temp1 = 1 - temp

7419

7420

; temp3 = abs(var_c)

7421

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

7422

ld hl, var_c

7423

ld bc, temp3

7424

call copySingle

7425

ld ix, temp3

7426

ld a, (ix+2)

7427

res 7, a

7428

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

7429

ld hl, temp3

7430

ld de, const_half_pi

7431

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

7432

jr nc, cosSingle.endif.1

7433

ld ix, temp1

7434

ld a, (ix+2)

7435

set 7, a

7436

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

7437

cosSingle.endif.1:

7438

pop bc

7439

ld hl, temp1

7440

call copySingle ; return temp1

7441

ret

7442

7443

endif

7444

7445

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

7446

; tanSingle

7447

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

7448

7449

if defined MATH_TAN

7450

7451

tanSingle:

7452

call pushpop

7453

push bc

7454

;HL points to input

7455

ld bc,var_z

7456

ld d,b

7457

ld e,c

7458

call cosSingle

7459

ld bc,var_x

7460

call sinSingle

7461

ld h,b

7462

ld l,c

7463

pop bc

7464

jp divSingle

7465

7466

endif

7467

7468

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

7469

; atanSingle

7470

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

7471

7472

if defined MATH_ATN

7473

7474

atanSingle:

7475

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

7476

; x < -1: atan - PI/2

7477

; x >= 1: PI/2 - atan

7478

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

7479

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

7480

; X < 0: Y = -Y

7481

7482

call pushpop

7483

ld de, const_0

7484

call cmpSingle

7485

jr nz, atanSingle.1

7486

7487

ld hl, const_0

7488

call copySingle ; return 0

7489

ret

7490

7491

atanSingle.1:

7492

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

7493

call trigRangeReductionAtan

7494

push bc

7495

push hl

7496

ld hl, var_a

7497

ld de, var_a

7498

ld bc, var_b

7499

call mulSingle ; var_b = var_a * var_a

7500

ld hl, var_b

7501

ld de, const_16

7502

ld bc, temp

7503

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

7504

ld hl, temp

7505

ld de, const_9

7506

ld bc, temp1

7507

call divSingle ; temp1 = temp/9

7508

ld hl, temp1

7509

ld de, const_7

7510

ld bc, temp

7511

call addSingle ; temp = 7 + temp1

7512

ld hl, var_b

7513

ld de, const_9

7514

ld bc, temp1

7515

call mulSingle ; temp1 = var_b * 9

7516

ld hl, temp1

7517

ld de, temp

7518

ld bc, temp2

7519

call divSingle ; temp2 = temp1 / temp

7520

ld hl, temp2

7521

ld de, const_5

7522

ld bc, temp

7523

call addSingle ; temp = 5 + temp2

7524

ld hl, var_b

7525

ld de, const_4

7526

ld bc, temp1

7527

call mulSingle ; temp1 = var_b * 4

7528

ld hl, temp1

7529

ld de, temp

7530

ld bc, temp2

7531

call divSingle ; temp2 = temp1 / temp

7532

ld hl, temp2

7533

ld de, const_3

7534

ld bc, temp

7535

call addSingle ; temp = 3 + temp2

7536

ld hl, var_b

7537

ld de, temp

7538

ld bc, temp2

7539

call divSingle ; temp2 = var_b / temp

7540

ld hl, temp2

7541

ld de, const_1

7542

ld bc, temp

7543

call addSingle ; temp = 1 + temp2

7544

ld hl, var_a

7545

ld de, temp

7546

ld bc, temp2

7547

call divSingle ; temp2 = var_a / temp

7548

pop hl

7549

; x >= 1: PI/2 - atan

7550

ld de, const_1

7551

call cmpSingle

7552

jr nc, atanSingle.2

7553

ld hl, const_half_pi

7554

ld de, temp2

7555

ld bc, temp

7556

call subSingle

7557

ld hl, temp

7558

jr atanSingle.4

7559

atanSingle.2:

7560

; x < -1: atan - PI/2

7561

push hl

7562

ld hl, const_0

7563

ld de, const_1

7564

ld bc, temp

7565

call subSingle

7566

pop hl

7567

ld de, temp

7568

call cmpSingle

7569

jr c, atanSingle.3

7570

ld hl, temp2

7571

ld de, const_half_pi

7572

ld bc, temp

7573

call subSingle

7574

ld hl, temp

7575

jr atanSingle.4

7576

atanSingle.3:

7577

ld hl, temp2

7578

atanSingle.4:

7579

pop bc

7580

call copySingle ; return temp2

7581

ret

7582

7583

trigRangeReductionAtan:

7584

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

7585

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

7586

; X < 0: Y = -Y

7587

call pushpop

7588

push hl

7589

ld bc, temp

7590

call copySingle

7591

ld ix, temp

7592

ld a, (ix+2)

7593

res 7, a

7594

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

7595

ld hl, temp

7596

ld de, const_1

7597

call cmpSingle

7598

jr nc, trigRangeReductionAtan.1

7599

ld hl, const_1

7600

pop de

7601

push de

7602

ld bc, var_a

7603

call divSingle

7604

jr trigRangeReductionAtan.2

7605

trigRangeReductionAtan.1:

7606

pop hl

7607

push hl

7608

ld bc, var_a

7609

call copySingle

7610

trigRangeReductionAtan.2:

7611

pop hl

7612

ld de, const_0

7613

call cmpSingle

7614

jr c, trigRangeReductionAtan.3

7615

ld ix, var_a

7616

ld a, (ix+2)

7617

set 7, a

7618

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

7619

trigRangeReductionAtan.3:

7620

ret

7621

7622

endif

7623

7624

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

7625

7626

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

7627

; copySingle

7628

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

7629

7630

copySingle:

7631

call pushpop

7632

;push bc

7633

;pop de

7634

ld d, b

7635

ld e, c

7636

ldi

7637

ldi

7638

ldi

7639

ldi

7640

ret

7641

7642

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

7643

; roundSingle

7644

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

7645

7646

roundSingle:

7647

call pushpop

7648

call copySingle

7649

;push bc

7650

;pop hl

7651

ld h, b

7652

ld l, c

7653

push de

7654

ld a, e

7655

ld de, const_10

7656

roundSingle.1:

7657

or 0

7658

jr z, roundSingle.2

7659

ld bc, temp

7660

call mulSingle

7661

;push hl

7662

;pop bc

7663

ld b, h

7664

ld c, l

7665

ld hl, temp

7666

call copySingle

7667

;push bc

7668

;pop hl

7669

ld h, b

7670

ld l, c

7671

dec a

7672

jr roundSingle.1

7673

roundSingle.2:

7674

ld de, const_half_1

7675

ld bc, temp

7676

call addSingle

7677

push hl

7678

ld hl, temp

7679

ld bc, temp1

7680

call single2Int

7681

ld hl, temp1

7682

pop bc

7683

call int2Single

7684

;push bc

7685

;pop hl

7686

ld h, b

7687

ld l, c

7688

pop de

7689

ld a, e

7690

ld de, const_10

7691

roundSingle.3:

7692

or 0

7693

jr z, roundSingle.4

7694

ld bc, temp

7695

call divSingle

7696

;push hl

7697

;pop bc

7698

ld b, h

7699

ld c, l

7700

ld hl, temp

7701

call copySingle

7702

;push bc

7703

;pop hl

7704

ld h, b

7705

ld l, c

7706

dec a

7707

jr roundSingle.3

7708

roundSingle.4:

7709

ret

7710

7711

endif

7712

7713

if defined MATH_ABSFN

7714

7715

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

7716

; absSingle

7717

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

7718

7719

absSingle:

7720

;;HL points to the float

7721

;;BC points to where to output the result

7722

call pushpop

7723

ld d,b

7724

ld e,c

7725

ldi

7726

ldi

7727

ld a,(hl)

7728

and %01111111

7729

ld (de),a

7730

inc hl

7731

inc de

7732

ld a,(hl)

7733

ld (de),a

7734

ret

7735

7736

endif

7737

7738

if defined MATH_SGN

7739

7740

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

7741

; sgnSingle

7742

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

7743

7744

sgnSingle:

7745

;;HL points to the float

7746

;;BC points to where to output the result

7747

jp negSingle

7748

7749

endif

7750

7751

if defined powSingle or defined sgnSingle or defined MATH_NEG

7752

7753

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

7754

; negSingle

7755

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

7756

7757

negSingle:

7758

;;HL points to the float

7759

;;BC points to where to output the result

7760

call pushpop

7761

push hl

7762

pop ix

7763

ld a, (ix+3)

7764

or 0

7765

jr nz, negSingle.test.sign

7766

ld a, (ix+2)

7767

or 0

7768

jr nz, negSingle.test.sign

7769

ld a, (ix+1)

7770

or 0

7771

jr nz, negSingle.test.sign

7772

ld a, (ix)

7773

or 0

7774

jr nz, negSingle.test.sign

7775

;push bc

7776

;pop de

7777

ld d, b

7778

ld e, c

7779

ld hl, const_0

7780

ldi

7781

ldi

7782

ldi

7783

ldi

7784

ret

7785

negSingle.test.sign:

7786

ld a, (ix+2)

7787

bit 7, a

7788

jr z, negSingle.positive

7789

negSingle.negative:

7790

push bc

7791

pop ix

7792

call negSingle.positive

7793

ld a, (ix+2)

7794

set 7, a

7795

ld (ix+2), a

7796

ret

7797

negSingle.positive:

7798

;push bc

7799

;pop de

7800

ld d, b

7801

ld e, c

7802

ld hl, const_1

7803

ldi

7804

ldi

7805

ldi

7806

ldi

7807

ret

7808

7809

endif

7810

7811

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

7812

7813

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

7814

; cmpSingle

7815

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

7816

7817

cmpSingle:

7818

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

7819

;Output:

7820

; float1 >= float2 : nc

7821

; float1 < float2 : c,nz

7822

; float1 == float2 : z

7823

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

7824

;

7825

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

7826

push hl

7827

push de

7828

push bc

7829

ld c, a

7830

push bc

7831

ex de, hl

7832

call _30

7833

pop bc

7834

ld a, c

7835

pop bc

7836

pop de

7837

pop hl

7838

ret

7839

_30:

7840

inc de

7841

inc de

7842

inc de

7843

ld a,(de)

7844

inc hl

7845

inc hl

7846

inc hl

7847

cp (hl)

7848

jr nc,_31

7849

ld a,(hl)

7850

_31:

7851

dec hl

7852

dec hl

7853

dec hl

7854

dec de

7855

dec de

7856

dec de

7857

push af

7858

ld bc,scrap

7859

call subSingle

7860

ld a,(scrap+3) ;new power

7861

pop bc ;B is old power

7862

or a

7863

jr z,cmp_close

7864

sub b

7865

jr nc,cmp_is_sign

7866

dec a

7867

add a,22

7868

jr nc,cmp_close

7869

cmp_is_sign:

7870

ld a,(scrap+2)

7871

or 1 ;not equal, so reset z flag

7872

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

7873

ret

7874

cmp_close:

7875

xor a

7876

ret

7877

7878

endif

7879

7880

if defined MATH_RND

7881

7882

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

7883

; randSingle

7884

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

7885

7886

randSingle:

7887

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

7888

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

7889

call pushpop

7890

push bc

7891

call rand

7892

push hl

7893

call rand

7894

pop de

7895

ex de,hl

7896

ld bc,$207F

7897

;DEHL is the mantissa, B is the exponent

7898

ld a,d

7899

or a

7900

jp m,rand_normed

7901

_32:

7902

dec c

7903

add hl,hl

7904

rl e

7905

rl d

7906

jp m,rand_normed

7907

djnz _32

7908

rand_zero:

7909

ld c,l

7910

ld b,l

7911

jr rand_done

7912

rand_normed:

7913

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

7914

ld a,b

7915

cp 8

7916

jr c,rand_zero

7917

sub 24

7918

jp nc,rand_no_more_rand_data

7919

push bc

7920

push de

7921

call rand

7922

pop de

7923

ld e,h

7924

ld h,l

7925

pop bc

7926

rand_no_more_rand_data:

7927

ld b,e

7928

ld e,d

7929

ld d,c

7930

ld c,h

7931

res 7,e

7932

rand_done:

7933

pop hl

7934

;DEBC

7935

ld (hl),b

7936

inc hl

7937

ld (hl),c

7938

inc hl

7939

ld (hl),e

7940

inc hl

7941

ld (hl),d

7942

ret

7943

7944

rand:

7945

;;Tested and passes all CAcert tests

7946

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

7947

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

7948

;;roughly 18.4 quintillion.

7949

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

7950

;;323cc

7951

;;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.

7952

;Uses 64 bits of state

7953

ld hl,(seed0)

7954

ld de,(seed0+2)

7955

ld b,h

7956

ld c,l

7957

add hl,hl

7958

rl e

7959

rl d

7960

add hl,hl

7961

rl e

7962

rl d

7963

inc l

7964

add hl,bc

7965

ld (seed0),hl

7966

ld hl,(seed0+2)

7967

adc hl,de

7968

ld (seed0+2),hl

7969

ex de,hl

7970

;;lfsr

7971

ld hl,(seed1)

7972

ld bc,(seed1+2)

7973

add hl,hl

7974

rl c

7975

rl b

7976

ld (seed1+2),bc

7977

sbc a,a

7978

and %11000101

7979

xor l

7980

ld l,a

7981

ld (seed1),hl

7982

ex de,hl

7983

add hl,bc

7984

ret

7985

7986

endif

7987

7988

if defined MATH_FOUT

7989

7990

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

7991

; single2Str

7992

; in HL = Single address

7993

; BC = String address

7994

; out A = String size

7995

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

7996

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

7997

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

7998

7999

single2str:

8000

call pushpop

8001

push bc

8002

call _33

8003

pop de

8004

xor a

8005

cp (hl)

8006

ldi

8007

jr nz,$-3

8008

8009

ret

8010

_33:

8011

; Move the float to scrap

8012

ld de,scrap

8013

call mov4

8014

8015

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

8016

ld de,strout_single

8017

ld hl,scrap+2

8018

ld a,(hl)

8019

;rlca

8020

;scf

8021

;rra

8022

bit 7, a

8023

jr z, _34

8024

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

8025

ld (de),a

8026

inc de

8027

ld a,(hl)

8028

_34:

8029

set 7, a

8030

ld (hl),a

8031

8032

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

8033

inc hl

8034

ld a,(hl)

8035

or a

8036

jp z,strcase_single

8037

8038

8039

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

8040

ex de,hl

8041

ld (hl),'0'

8042

inc hl

8043

8044

; Save the pointer

8045

push hl

8046

8047

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

8048

ld de,77

8049

ld h,a

8050

ld l,d

8051

call mul8_preset

8052

ld de,-77*128

8053

add hl,de

8054

ld a,h

8055

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

8056

ld de,pown10LUT

8057

jr c,_35

8058

neg

8059

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

8060

_35:

8061

ld hl, pow10exp_single

8062

ld bc,scrap

8063

call singletostr_mul

8064

call singletostr_mul

8065

call singletostr_mul

8066

call singletostr_mul

8067

call singletostr_mul

8068

call singletostr_mul

8069

;now the number is pretty close to a nice value

8070

8071

; If it is less than 1, multiply by 10

8072

ld a,(scrap+3)

8073

sub 128

8074

jr nc,_36

8075

ld de,const_10

8076

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

8077

;ld b,h

8078

;ld c,l

8079

ld h,b

8080

ld l,c

8081

call mulSingle

8082

ld hl,pow10exp_single

8083

dec (hl)

8084

ld a,(scrap+3)

8085

sub 128

8086

_36:

8087

8088

; Convert to a fixed-point number !

8089

inc a

8090

ld b,a

8091

xor a

8092

_37:

8093

ld hl,scrap

8094

sla (hl)

8095

inc hl

8096

rl (hl)

8097

inc hl

8098

rl (hl)

8099

rla

8100

djnz _37

8101

8102

;We need to get 7 digits

8103

ld b,6

8104

pop hl ;Points to the string

8105

8106

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

8107

cp 10

8108

jr c,_38

8109

dec b

8110

;Increment the exponent :)

8111

ld de,(pow10exp_single-1)

8112

inc d

8113

ld (pow10exp_single-1),de

8114

;

8115

ld (hl),'0'-1

8116

inc (hl)

8117

sub 10

8118

jr nc,$-3

8119

add a,10

8120

inc hl

8121

_38:

8122

; Get the remaining digits.

8123

_39:

8124

add a,'0'

8125

ld (hl),a

8126

inc hl

8127

push hl

8128

push bc

8129

call singletostrmul10

8130

pop bc

8131

pop hl

8132

djnz _39

8133

8134

;Save the pointer to the end of the string

8135

ld d,h

8136

ld e,l

8137

;ld (hl), 0

8138

8139

;Now let's round!

8140

cp 5

8141

jr c,rounding_done_single

8142

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

8143

_40:

8144

ld (hl),'0'

8145

_40a:

8146

dec hl

8147

inc (hl)

8148

ld a,(hl)

8149

cp $3A

8150

jr z,_40

8151

rounding_done_single:

8152

8153

8154

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

8155

ld hl,strout_single

8156

ld a,(hl)

8157

cp '-'

8158

jr nz,_41

8159

inc hl

8160

ld a,(hl)

8161

_41:

8162

cp '0'

8163

jr nz,_42

8164

dec de

8165

ex de,hl

8166

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

8167

sbc hl,de

8168

ld b,h

8169

ld c,l

8170

ld h,d

8171

ld l,e

8172

inc hl

8173

ldir

8174

cp a

8175

_42:

8176

8177

push de

8178

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

8179

ld a,(pow10exp_single)

8180

jr z,_43

8181

inc a

8182

ld (pow10exp_single),a

8183

_43:

8184

8185

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

8186

add a,4

8187

cp 10

8188

jp c,movdec_single

8189

_44:

8190

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

8191

;Then, we need to append the exponent string

8192

ld hl,strout_single

8193

ld de,strout_single-1

8194

ld a,(hl)

8195

cp '-' ;negative sign

8196

jr nz,_45

8197

ldi

8198

_45:

8199

ldi

8200

ld a,'.'

8201

ld (de),a

8202

8203

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

8204

pop hl

8205

call strip_zeroes

8206

8207

; Write the exponent

8208

ld (hl),'e'

8209

inc hl

8210

ld a,(pow10exp_single)

8211

or a

8212

jp p,_46

8213

ld (hl),'-' ;negative sign

8214

inc hl

8215

neg

8216

_46:

8217

cp 10

8218

jr c,_47

8219

ld (hl),'0'-1

8220

inc (hl)

8221

sub 10

8222

jr nc,$-3

8223

add a,10

8224

inc hl

8225

_47:

8226

add a,'0'

8227

ld (hl),a

8228

inc hl

8229

ld (hl),0

8230

8231

ld de, strout_single

8232

xor a

8233

sbc hl, de

8234

ld a, l ; string size

8235

8236

ld hl,strout_single-1

8237

ret

8238

8239

movdec_single:

8240

ld a,(pow10exp_single)

8241

or a

8242

jp p,posdec_single

8243

ld l,a

8244

;need to put zeroes before everything

8245

ld de,strout_single

8246

ld a,(de)

8247

cp '-' ;negative sign

8248

push af

8249

ld a,'0'

8250

jr z,$+3

8251

_48:

8252

dec de

8253

ld (de),a

8254

inc l

8255

jr nz,_48

8256

_49:

8257

ex de,hl

8258

ld (hl),'.'

8259

pop af

8260

jr nz,_50

8261

dec hl

8262

ld (hl),a

8263

_50:

8264

ex de,hl

8265

pop hl

8266

call strip_zeroes

8267

ld (hl),0

8268

ex de,hl

8269

ret

8270

8271

posdec_single:

8272

ld hl,strout_single

8273

ld de,strout_single-1

8274

ld c,a

8275

ld a,(hl)

8276

ld b,0

8277

cp '-' ;negative sign

8278

jr nz,_51

8279

inc c

8280

_51:

8281

inc c

8282

ldir

8283

ld a,'.'

8284

ld (de),a

8285

pop hl

8286

call strip_zeroes

8287

ld (hl),0

8288

ld hl,strout_single-1

8289

ret

8290

8291

strcase_single:

8292

ld hl,str_Zero

8293

ld a,(scrap+2)

8294

add a,a

8295

and $C0

8296

jr z,_52

8297

ld hl,str_Inf

8298

jp pe,_52

8299

ld hl,str_NaN

8300

_52:

8301

call mov4

8302

ld hl,strout_single

8303

ret

8304

8305

singletostrmul10:

8306

;multiply the 0.24 fixed point number at scrap by 10

8307

;overflow in A register

8308

ld a,(scrap+2)

8309

ld e,a

8310

ld hl,(scrap)

8311

xor a

8312

ld d,e

8313

ld b,h

8314

ld c,l

8315

add hl,hl

8316

rl d

8317

rla

8318

add hl,hl

8319

rl d

8320

rla

8321

add hl,bc

8322

ld b,a

8323

ld a,d

8324

adc a,e

8325

ld d,a

8326

ld a,b

8327

adc a,0

8328

add hl,hl

8329

rl d

8330

rla

8331

ld (scrap+1),de

8332

ld (scrap),hl

8333

ret

8334

8335

strip_zeroes:

8336

ld a,'0'

8337

_53:

8338

dec hl

8339

cp (hl)

8340

jr z,_53

8341

8342

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

8343

ld a,'.'

8344

cp (hl)

8345

ret z

8346

inc hl

8347

ret

8348

8349

singletostr_mul:

8350

rra

8351

call c,_54

8352

ld hl,4

8353

add hl,de

8354

ex de,hl

8355

ret

8356

_54:

8357

ld h,b

8358

ld l,c

8359

jp mulSingle

8360

mul8:

8361

;H*E => HL

8362

ld l,0

8363

ld d,l

8364

mul8_preset:

8365

sla h

8366

jr nc,$+3

8367

ld l,e

8368

add hl,hl

8369

jr nc,$+3

8370

add hl,de

8371

add hl,hl

8372

jr nc,$+3

8373

add hl,de

8374

add hl,hl

8375

jr nc,$+3

8376

add hl,de

8377

add hl,hl

8378

jr nc,$+3

8379

add hl,de

8380

add hl,hl

8381

jr nc,$+3

8382

add hl,de

8383

add hl,hl

8384

jr nc,$+3

8385

add hl,de

8386

add hl,hl

8387

ret nc

8388

add hl,de

8389

ret

8390

8391

endif

8392

8393

8394

if defined MATH_FIN

8395

8396

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

8397

; str2Single

8398

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

8399

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

8400

8401

char_NEG: equ '-'

8402

char_ENG: equ ','

8403

char_DEC: equ '.'

8404

ptr_sto: equ scrap+9

8405

8406

;;#Routines/Single Precision

8407

;;Inputs:

8408

;; HL points to the string

8409

;; BC points to where the float is output

8410

;;Output:

8411

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

8412

;;Destroys:

8413

;; 11 bytes at scrap ?

8414

8415

str2single:

8416

call pushpop

8417

push bc

8418

;Check if there is a negative sign.

8419

; Save for later

8420

; Advance ptr

8421

ld a,(hl)

8422

sub char_NEG

8423

sub 1

8424

push af

8425

jr nc,$+3

8426

inc hl

8427

;Skip all leading zeroes

8428

ld a,(hl)

8429

cp '0'

8430

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

8431

;Set exponent to 0

8432

ld b,0

8433

;Check if the next char is char_DEC

8434

sub char_DEC

8435

or a ;to reset the carry flag

8436

jr nz,_55

8437

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

8438

;Get rid of zeroes

8439

dec b

8440

_54a:

8441

inc hl

8442

ld a,(hl)

8443

cp '0'

8444

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

8445

scf

8446

_55:

8447

;Now we read in the next 8 digits

8448

ld de,scrap+3

8449

call ascii_to_uint8

8450

call ascii_to_uint8

8451

call ascii_to_uint8

8452

call ascii_to_uint8

8453

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

8454

;b is the exponent

8455

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

8456

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

8457

sbc a,a

8458

inc a

8459

ld c,a

8460

_56:

8461

ld a,(hl)

8462

cp 30h

8463

jr nz,_57

8464

inc hl

8465

ld a,b

8466

add a,c

8467

jp z,strToSingle_inf

8468

ld b,a

8469

jr _56

8470

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

8471

_57:

8472

cp char_NEG

8473

call z,str_eng_exp

8474

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

8475

ld (ptr_sto),hl

8476

ld d,100

8477

call scrap_times_256

8478

ld a,c

8479

ld (scrap+6),a

8480

call scrap_times_256

8481

ld a,c

8482

ld (scrap+5),a

8483

call scrap_times_256

8484

ld a,c

8485

ld (scrap+4),a

8486

call scrap_times_256

8487

ld a,c

8488

ld (scrap+3),a

8489

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

8490

;

8491

ld hl,(scrap+3)

8492

ld a,h

8493

or l

8494

ld hl,(scrap+5)

8495

or l

8496

or h

8497

jp z,strToSingle_zero-1

8498

ld c,$7F

8499

ld a,h

8500

or a

8501

jp m,strToSingle_normed

8502

;Will need to iterate at most three times

8503

_58:

8504

dec c

8505

ld hl,scrap+3

8506

sla (hl)

8507

inc hl

8508

rl (hl)

8509

inc hl

8510

rl (hl)

8511

inc hl

8512

adc a,a

8513

jp p,_58

8514

strToSingle_normed:

8515

;Move the number to scrap

8516

ld hl,(scrap+4)

8517

ld (scrap),hl

8518

ld l,a

8519

ld h,c

8520

sla l

8521

pop af

8522

rr l

8523

ld (scrap+2),hl

8524

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

8525

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

8526

xor a

8527

sub b

8528

ld de,pown10LUT

8529

jp p,_59

8530

ld a,b

8531

ld de,pow10LUT

8532

cp 40

8533

jp nc,strToSingle_inf+1

8534

_59:

8535

cp 40

8536

jp nc,strToSingle_zero

8537

ld hl,scrap

8538

ld b,h

8539

ld c,l

8540

call _60

8541

call _60

8542

call _60

8543

call _60

8544

call _60

8545

call _60

8546

pop de

8547

jp mov4

8548

_60:

8549

rra

8550

call c,mulSingle

8551

inc de

8552

inc de

8553

inc de

8554

inc de

8555

ret

8556

str_eng_exp:

8557

ld de,0

8558

inc hl

8559

ld a,(hl)

8560

cp char_NEG ;negative exponent?

8561

push af

8562

jr nz,$+3

8563

inc hl

8564

_61:

8565

ld a,(hl)

8566

sub 3Ah

8567

add a,10

8568

jr nc,_62

8569

inc hl

8570

push hl

8571

ld h,d

8572

ld l,e

8573

add hl,hl

8574

add hl,hl

8575

add hl,de

8576

add hl,hl

8577

add a,l

8578

ld l,a

8579

ex de,hl

8580

pop hl

8581

jp c,eng_overflow

8582

inc d

8583

dec d

8584

jp z,_61

8585

jp nz,eng_overflow

8586

_62:

8587

ld a,e

8588

cp 40

8589

jr nc,eng_overflow

8590

pop af

8591

ld a,b

8592

jr nz,_63

8593

sub e

8594

ld b,a

8595

ret

8596

_63:

8597

add a,e

8598

ld b,a

8599

ret

8600

scrap_times_256:

8601

ld e,8

8602

_64:

8603

or a

8604

ld hl,scrap

8605

call _65

8606

call _65

8607

rl c

8608

dec e

8609

jr nz,_64

8610

ret

8611

_65:

8612

call scrap_times_sub

8613

scrap_times_sub:

8614

ld a,(hl)

8615

rla

8616

cp d

8617

jr c,$+3

8618

sub d

8619

ld (hl),a

8620

inc hl

8621

ccf

8622

ret

8623

eng_overflow:

8624

pop af

8625

jr nz,strToSingle_inf

8626

pop af

8627

strToSingle_zero:

8628

ld hl,const_0

8629

pop de

8630

jp mov4

8631

strToSingle_inf:

8632

;return inf

8633

pop af

8634

ld hl,const_inf

8635

jr nc,_66

8636

ld hl,const_NegInf

8637

_66:

8638

pop de

8639

jp mov4

8640

8641

endif

8642

8643

if defined roundSingle or defined MATH_FRCSGL

8644

8645

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

8646

; int2Single

8647

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

8648

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

8649

8650

int2Single:

8651

call pushpop

8652

push bc

8653

push hl

8654

pop ix

8655

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

8656

ld h, (ix+1)

8657

ld bc, 0x1000 ; bynary digits count + sign

8658

8659

int2Single.test.zero:

8660

xor a

8661

or h ; test if hl is not zero

8662

jr nz, int2Single.test.negative

8663

or l

8664

jr nz, int2Single.test.negative

8665

ld hl, 0

8666

ld de, 0

8667

jp int2Single.save

8668

8669

int2Single.test.negative:

8670

bit 7, h ; test if hl is negative

8671

jr z, int2Single.normalize

8672

ld c, 0x80 ; sign negative

8673

ld a, h ;\

8674

cpl ; |

8675

ld h, a ; | abs(hl)

8676

ld a, l ; |

8677

cpl ; |

8678

ld l, a ;/

8679

inc hl

8680

8681

int2Single.normalize:

8682

dec b

8683

bit 7, h

8684

jr nz, int2Single.mount

8685

sla l

8686

rl h

8687

jr int2Single.normalize

8688

8689

int2Single.mount:

8690

res 7, h ; turn off upper bit

8691

8692

ld a, c ; restore sign

8693

or h ; put sign...

8694

ld h, a ; ...into upper mantissa

8695

8696

ld e, h ; sign+mantissa

8697

ld h, l ; high mantissa

8698

ld l, 0 ; low mantissa

8699

8700

ld a, b ; binary digits count

8701

or 0x80 ; exponent bias

8702

ld d, a ; exponent

8703

8704

int2Single.save:

8705

pop ix

8706

ld (ix), l ; low mantissa

8707

ld (ix+1), h ; high mantissa

8708

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

8709

ld (ix+3), d ; expoent

8710

ld (ix+4), 0

8711

ld (ix+5), 0

8712

ld (ix+6), 0

8713

ld (ix+7), 0

8714

ret

8715

8716

endif

8717

8718

if defined roundSingle or defined MATH_FRCINT

8719

8720

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

8721

; single2Int

8722

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

8723

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

8724

single2Int:

8725

;Input:

8726

; HL points to the single-precision float

8727

;Output:

8728

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

8729

; BC points to 16-bit signed integer

8730

call pushpop

8731

push bc

8732

ld e,(hl)

8733

inc hl

8734

ld d,(hl)

8735

inc hl

8736

ld a,(hl)

8737

add a,a

8738

push af

8739

scf

8740

rra

8741

ld c,a

8742

inc hl

8743

ld a,(hl)

8744

ld hl,0

8745

sub 80h

8746

jr c,no_shift_single_to_int16

8747

cp 39

8748

jr nc,no_shift_single_to_int16

8749

sub 8

8750

jr c,_67

8751

ld l,c

8752

ld c,d

8753

ld d,e

8754

ld e,h

8755

sub 8

8756

jr c,_67

8757

ld h,l

8758

ld l,c

8759

ld c,d

8760

ld d,e

8761

sub 8

8762

jr c,_67

8763

ld h,l

8764

ld l,c

8765

ld c,d

8766

sub 8

8767

jr c,_67

8768

ld h,l

8769

ld l,c

8770

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

8771

_67:

8772

add a,9

8773

_67a:

8774

ld b,a

8775

ld a,e

8776

_68:

8777

add a,a

8778

rl d

8779

rl c

8780

adc hl,hl

8781

djnz _68

8782

no_shift_single_to_int16:

8783

pop af

8784

jr nc,_69

8785

;need to negate

8786

xor a

8787

sub e

8788

ld e,0

8789

ld a,e

8790

sbc a,d

8791

ld a,e

8792

sbc a,c

8793

ld d,e

8794

ex de,hl

8795

sbc hl,de

8796

_69:

8797

pop ix

8798

ld (ix), l

8799

ld (ix+1), h

8800

ret

8801

8802

endif

8803

8804

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

8805

; Auxiliary routines

8806

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

8807

8808

str_Zero: db "0",0

8809

str_Inf: db "inf",0

8810

str_NaN: db "NaN",0

8811

8812

start_const:

8813

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

8814

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

8815

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

8816

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

8817

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

8818

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

8819

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

8820

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

8821

const_2: dw 0, 33024

8822

const_3: dw 0, 33088

8823

const_4: dw 0, 33280

8824

const_5: dw 0, 33312

8825

const_7: dw 0, 33376

8826

const_9: dw 0, 33552

8827

const_16: dw 0, 33792

8828

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

8829

const_100_inv: dw 55050, 31011

8830

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

8831

const_half_1: dw 0, 32512

8832

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

8833

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

8834

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

8835

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

8836

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

8837

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

8838

const_half_pi: dw 4059, 32841

8839

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

8840

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

8841

; db $,$,$,$

8842

end_const:

8843

sin_a1: dw 43691, 32042

8844

sin_a2: dw 34952, 30984

8845

sin_a3: dw 3329, 29520

8846

cos_a1: equ const_half_1

8847

cos_a2: dw 43691, 31530

8848

cos_a3: dw 2914, 30262

8849

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

8850

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

8851

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

8852

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

8853

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

8854

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

8855

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

8856

8857

if defined MATH_CONSTSINGLE

8858

8859

iconstSingle:

8860

ex (sp),hl

8861

ld a,(hl)

8862

inc hl

8863

ex (sp),hl

8864

constSingle:

8865

;A is the constant ID#

8866

;returns nc if failed, c otherwise

8867

;HL points to the constant

8868

cp (end_const-start_const)>>2

8869

ret nc

8870

ld hl,start_const

8871

add a,a

8872

add a,a

8873

add a,l

8874

ld l,a

8875

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

8876

; ccf

8877

; ret c

8878

; inc h

8879

;#endif

8880

scf

8881

ret

8882

8883

endif

8884

8885

;;LUTs used

8886

lut:

8887

pown10LUT:

8888

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

8889

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

8890

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

8891

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

8892

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

8893

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

8894

pow10LUT:

8895

const_10:

8896

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

8897

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

8898

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

8899

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

8900

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

8901

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

8902

8903

C_Times_BDE:

8904

;;C*BDE => CAHL

8905

;C = 0 157

8906

;C = 1 141

8907

;141+

8908

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

8909

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

8910

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

8911

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

8912

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

8913

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

8914

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

8915

;min: 141cc

8916

;max: 508cc

8917

;avg: 349.21279907227cc

8918

8919

ld a,b

8920

ld h,d

8921

ld l,e

8922

sla c

8923

jr c,mul8_24_1

8924

sla c

8925

jr c,mul8_24_2

8926

sla c

8927

jr c,mul8_24_3

8928

sla c

8929

jr c,mul8_24_4

8930

sla c

8931

jr c,mul8_24_5

8932

sla c

8933

jr c,mul8_24_6

8934

sla c

8935

jr c,mul8_24_7

8936

sla c

8937

ret c

8938

ld a,c

8939

ld h,c

8940

ld l,c

8941

ret

8942

mul8_24_1:

8943

add hl,hl

8944

rla

8945

rl c

8946

jr nc,$+7

8947

add hl,de

8948

adc a,b

8949

jr nc,$+3

8950

inc c

8951

mul8_24_2:

8952

add hl,hl

8953

rla

8954

rl c

8955

jr nc,$+7

8956

add hl,de

8957

adc a,b

8958

jr nc,$+3

8959

inc c

8960

mul8_24_3:

8961

add hl,hl

8962

rla

8963

rl c

8964

jr nc,$+7

8965

add hl,de

8966

adc a,b

8967

jr nc,$+3

8968

inc c

8969

mul8_24_4:

8970

add hl,hl

8971

rla

8972

rl c

8973

jr nc,$+7

8974

add hl,de

8975

adc a,b

8976

jr nc,$+3

8977

inc c

8978

mul8_24_5:

8979

add hl,hl

8980

rla

8981

rl c

8982

jr nc,$+7

8983

add hl,de

8984

adc a,b

8985

jr nc,$+3

8986

inc c

8987

mul8_24_6:

8988

add hl,hl

8989

rla

8990

rl c

8991

jr nc,$+7

8992

add hl,de

8993

adc a,b

8994

jr nc,$+3

8995

inc c

8996

mul8_24_7:

8997

add hl,hl

8998

rla

8999

rl c

9000

ret nc

9001

add hl,de

9002

adc a,b

9003

ret nc

9004

inc c

9005

ret

9006

9007

pushpop:

9008

;26 bytes, adds 118cc to the traditional routine

9009

ex (sp),hl

9010

push de

9011

push bc

9012

push af

9013

push hl

9014

ld hl,pushpopret

9015

ex (sp),hl

9016

push hl

9017

push af

9018

ld hl,12

9019

add hl,sp

9020

ld a,(hl)

9021

inc hl

9022

ld h,(hl)

9023

ld l,a

9024

pop af

9025

ret

9026

pushpopret:

9027

pop af

9028

pop bc

9029

pop de

9030

pop hl

9031

ret

9032

9033

mov4:

9034

ldi

9035

ldi

9036

ldi

9037

ldi

9038

ret

9039

9040

if defined MATH_FIN

9041

9042

ascii_to_uint8:

9043

;c flag means don't increment the exponent

9044

ld c,0

9045

ld a,(hl)

9046

jr c,ascii_to_uint8_noexp

9047

cp char_DEC

9048

jr z,ascii_to_uint8_noexp-2

9049

_70:

9050

sub 3Ah

9051

add a,10

9052

jr nc,ascii_to_uint8_noexp_end

9053

inc b

9054

ld c,a

9055

add a,a

9056

add a,a

9057

add a,c

9058

add a,a

9059

ld c,a

9060

inc hl

9061

_71:

9062

ld a,(hl)

9063

cp char_DEC

9064

jr z,ascii_to_uint8_noexp_2nd

9065

_72:

9066

sub 3Ah

9067

add a,10

9068

jr nc,ascii_to_uint8_noexp_end

9069

inc b

9070

add a,c

9071

inc hl

9072

ld (de),a

9073

dec de

9074

or a

9075

ret

9076

9077

inc hl

9078

ld a,(hl)

9079

ascii_to_uint8_noexp:

9080

sub 3Ah

9081

add a,10

9082

jr nc,ascii_to_uint8_noexp_end

9083

ld c,a

9084

add a,a

9085

add a,a

9086

add a,c

9087

add a,a

9088

ld c,a

9089

ascii_to_uint8_noexp_2nd:

9090

inc hl

9091

ld a,(hl)

9092

sub 3Ah

9093

add a,10

9094

jr nc,ascii_to_uint8_noexp_end

9095

add a,c

9096

inc hl

9097

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

9098

ascii_to_uint8_noexp_end:

9099

ld a,c

9100

ascii_2:

9101

ld (de),a

9102

dec de

9103

scf

9104

ret

9105

9106

endif

9107

9108

if defined MATH_RSUBSINGLE

9109

9110

rsubSingle:

9111

;;-x+y

9112

push af

9113

push hl

9114

push de

9115

push bc

9116

push de

9117

ld de,addend2

9118

ldi

9119

ldi

9120

ld a,(hl)

9121

xor 80h

9122

ld (de),a

9123

inc de

9124

inc hl

9125

ld a,(hl)

9126

ld (de),a

9127

pop de

9128

ld hl,addend2

9129

jp addInject ;jumps in to the addSingle routine

9130

9131

endif

9132

9133

if defined MATH_MOD1SINGLE

9134

9135

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

9136

;+inf -> NaN

9137

;-inf -> NaN

9138

;NaN -> NaN

9139

mod1Single:

9140

call pushpop

9141

push bc

9142

ld e,(hl)

9143

inc hl

9144

ld d,(hl)

9145

inc hl

9146

ld c,(hl)

9147

ld a,c

9148

xor 80h

9149

push af

9150

jp p,mod1Single.1

9151

ld c,a

9152

mod1Single.1:

9153

9154

inc hl

9155

ld a,(hl)

9156

ld b,a

9157

or a

9158

jr z,mod1Single_special

9159

sub $80

9160

jr c,mod1_end

9161

inc a

9162

ld b,a

9163

ld a,c

9164

ex de,hl

9165

mod1Single.2:

9166

add hl,hl

9167

rla

9168

djnz mod1Single.2

9169

ld c,a

9170

9171

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

9172

or h

9173

or l

9174

ex de,hl

9175

jr z,mod1_end

9176

9177

;Need to normalize

9178

ld b,$7F

9179

ld a,c

9180

or a

9181

jp m,mod1_end

9182

ex de,hl

9183

mod1Single.3:

9184

dec b

9185

add hl,hl

9186

adc a,a

9187

jp p,mod1Single.3

9188

ld c,a

9189

ex de,hl

9190

mod1_end:

9191

pop af

9192

pop hl

9193

jp m,mod1Single.4

9194

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

9195

ld a,b

9196

or a

9197

jr z,mod1Single.4

9198

ld (scrap),de

9199

ld (scrap+2),bc

9200

ld b,h

9201

ld c,l

9202

ld hl,scrap

9203

ld de,const_1

9204

jp addSingle

9205

mod1Single_special:

9206

;If INF, need to return NaN instead

9207

;For 0 and NaN, just return itself :)

9208

pop af

9209

pop hl

9210

ld a,c

9211

add a,a

9212

jp p,mod1Single.4

9213

ld c,$40

9214

mod1Single.4:

9215

res 7,c

9216

ld (hl),e

9217

inc hl

9218

ld (hl),d

9219

inc hl

9220

ld (hl),c

9221

inc hl

9222

ld (hl),b

9223

ret

9224

9225

endif

9226

9227

if defined MATH_FOUT

9228

9229

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

9230

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

9231

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

9232

; References:

9233

; Brandon Wilson WikiTI

9234

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

9235

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

9236

; INPUTS:

9237

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

9238

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

9239

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

9240

; OUTPUTS:

9241

; A Size of string

9242

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

9243

; REGISTERS/MEMORY DESTROYED

9244

; AF HL

9245

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

9246

9247

IntToStr:

9248

push de

9249

push bc

9250

9251

; Detect sign of HL.

9252

bit 7, h

9253

jr z, _DoConvert

9254

9255

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

9256

ld a, '-'

9257

ld (de), a

9258

inc de

9259

9260

; Negate HL (using two's complement)

9261

xor a

9262

sub l

9263

ld l, a

9264

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

9265

sbc a, h

9266

ld h, a

9267

9268

; Convert HL to digit characters

9269

_DoConvert:

9270

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

9271

_DoConvert.1:

9272

ld c, 10

9273

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

9274

push af

9275

inc b

9276

ld a, h

9277

or l

9278

jr nz, _DoConvert.1

9279

9280

; Retrieve digits from stack

9281

_DoConvert.2:

9282

pop af

9283

or $30

9284

ld (de), a

9285

inc de

9286

djnz _DoConvert.2

9287

9288

; Terminate string with NULL

9289

xor a

9290

ld (de), a

9291

9292

ld h, d

9293

ld l, e

9294

9295

pop bc

9296

pop de

9297

9298

sbc hl, de

9299

ld a, l ; string size

9300

9301

ret

9302

9303

endif

9304

9305

if defined MATH_FIN

9306

9307

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

9308

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

9309

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

9310

;Input:

9311

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

9312

;Outputs:

9313

; HL is the 16-bit value of the number

9314

; DE points to the byte after the number

9315

; BC is HL/10

9316

; z flag reset (nz)

9317

; c flag reset (nc)

9318

;Destroys:

9319

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

9320

;Size: 23 bytes

9321

;Speed: 104n+42+11c

9322

; n is the number of digits

9323

; c is at most n-2

9324

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

9325

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

9326

9327

StrToInt:

9328

ld hl,0 ; 10 : 210000

9329

ConvLoop: ;

9330

ld a,(de) ; 7 : 1A

9331

sub 30h ; 7 : D630

9332

cp 10 ; 7 : FE0A

9333

ret nc ;5|11 : D0

9334

inc de ; 6 : 13

9335

;

9336

ld b,h ; 4 : 44

9337

ld c,l ; 4 : 4D

9338

add hl,hl ; 11 : 29

9339

add hl,hl ; 11 : 29

9340

add hl,bc ; 11 : 09

9341

add hl,hl ; 11 : 29

9342

;

9343

add a,l ; 4 : 85

9344

ld l,a ; 4 : 6F

9345

jr nc,ConvLoop ;12|23: 30EE

9346

inc h ; --- : 24

9347

jr ConvLoop ; --- : 18EB

9348

9349

endif

9350

9351

if defined IntToStr

9352

9353

; divides hl by c

9354

; return remainder in a

9355

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

9356

div_hl_c:

9357

push bc

9358

xor a

9359

ld b, 16

9360

div_hl_c.loop:

9361

add hl, hl

9362

rla

9363

jr c, $+5

9364

cp c

9365

jr c, $+4

9366

sub c

9367

inc l

9368

djnz div_hl_c.loop

9369

pop bc

9370

ret

9371

9372

endif

9373

9374

if defined DIV_EHL

9375

9376

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

9377

div_ehl_d:

9378

xor a

9379

ld b, 24

9380

div_ehl_d.loop:

9381

add hl, hl

9382

rl e

9383

rla

9384

jr c, $+5

9385

cp d

9386

jr c, $+4

9387

sub d

9388

inc l

9389

djnz div_ehl_d.loop

9390

ret

9391

9392

div_dehl_c:

9393

push bc

9394

xor a

9395

ld b, 32

9396

div_dehl_c.loop:

9397

add hl, hl

9398

rl e

9399

rl d

9400

rla

9401

jr c, $+5

9402

cp c

9403

jr c, $+4

9404

sub c

9405

inc l

9406

djnz div_dehl_c.loop

9407

pop bc

9408

ret

9409

9410

endif

9411

9412

9413

9414

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

9415

; VARIABLES INITIALIZE

9416

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

9417

9418

INITIALIZE_DUMMY:

9419

xor a

9420

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

9421

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

9422

ld (VAR_DUMMY.POINTER), hl

9423

ld b, VAR_DUMMY.LENGTH

9424

ld c, 0

9425

INITIALIZE_DUMMY.1:

9426

ld (hl), a

9427

inc hl

9428

djnz INITIALIZE_DUMMY.1

9429

ret

9430

9431

INITIALIZE_DATA:

9432

ld hl, DATA_ITEMS

9433

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

9434

ld hl, 0

9435

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

9436

ret

9437

9438

INITIALIZE_VARIABLES:

9439

call INITIALIZE_DATA

9440

call INITIALIZE_DUMMY

9441

9442

if defined SCREEN

9443

call gfxInitSpriteCollisionTable

9444

endif

9445

9446

;if defined COMPILE_TO_ROM

9447

; ld ix, BIOS_JIFFY ; initialize rom clock

9448

; di

9449

; ld (ix), 0

9450

; ld (ix+1), 0

9451

; ei

9452

;endif

9453

9454

ld hl, IDF_14

9455

ld d, 2 ; explicitly coded defined type

9456

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

9457

ld b, 255 ; variable name 2 (type flag=fixed)

9458

call INIT_VAR ; variable initialize

9459

ld hl, IDF_19

9460

ld d, 2 ; explicitly coded defined type

9461

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

9462

ld b, 255 ; variable name 2 (type flag=fixed)

9463

call INIT_VAR ; variable initialize

9464

ld hl, IDF_21

9465

ld d, 3 ; string

9466

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

9467

ld b, 255 ; variable name 2 (type flag=fixed)

9468

call INIT_VAR ; variable initialize

9469

ld hl, IDF_24

9470

ld d, 2 ; explicitly coded defined type

9471

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

9472

ld b, 255 ; variable name 2 (type flag=fixed)

9473

call INIT_VAR ; variable initialize

9474

ld hl, IDF_34

9475

ld d, 2 ; explicitly coded defined type

9476

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

9477

ld b, 255 ; variable name 2 (type flag=fixed)

9478

call INIT_VAR ; variable initialize

9479

ld hl, IDF_41

9480

ld d, 2 ; explicitly coded defined type

9481

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

9482

ld b, 255 ; variable name 2 (type flag=fixed)

9483

call INIT_VAR ; variable initialize

9484

ld hl, IDF_54

9485

ld d, 2 ; explicitly coded defined type

9486

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

9487

ld b, 255 ; variable name 2 (type flag=fixed)

9488

call INIT_VAR ; variable initialize

9489

ld hl, IDF_65

9490

ld d, 2 ; explicitly coded defined type

9491

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

9492

ld b, 255 ; variable name 2 (type flag=fixed)

9493

call INIT_VAR ; variable initialize

9494

ld hl, IDF_69

9495

ld d, 2 ; explicitly coded defined type

9496

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

9497

ld b, 255 ; variable name 2 (type flag=fixed)

9498

call INIT_VAR ; variable initialize

9499

ret

9500

9501

9502

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

9503

; MAIN WORK AREA - LITERALS / VARIABLES / CONFIGURATIONS

9504

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

9505

9506

if defined COMPILE_TO_ROM

9507

9508

workAreaPad:

9509

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

9510

9511

if pgmPage1.pad >= 0

9512

ds pgmPage1.pad, 0

9513

;else

9514

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

9515

endif

9516

9517

endif

9518

9519

VAR_STACK.START: equ ramArea

9520

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

9521

9522

VAR_STACK.POINTER: equ VAR_STACK.START

9523

9524

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

9525

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

9526

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

9527

9528

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

9529

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

9530

PRINT.TAB.DATA: db 09,0

9531

9532

; null double

9533

LIT_NULL_DBL: dw 0, 0, 0, 0

9534

9535

; null string

9536

LIT_NULL_STR: db 0

9537

9538

; quote string

9539

LIT_QUOTE_CHAR: db '\"'

9540

9541

; logical true

9542

LIT_TRUE: db 2, 0, 0

9543

dw 0, 0xFFFF, 0, 0

9544

9545

; logical false

9546

LIT_FALSE: db 2, 0, 0

9547

dw 0, 0, 0, 0

9548

9549

9550

; numerical literal

9551

LIT_5: db 2, 0, 0

9552

dw 0, 15, 0, 0

9553

9554

; numerical literal

9555

LIT_7: db 2, 0, 0

9556

dw 0, 1, 0, 0

9557

9558

; numerical literal

9559

LIT_9: db 2, 0, 0

9560

dw 0, 1, 0, 0

9561

9562

; numerical literal

9563

LIT_11: db 2, 0, 0

9564

dw 0, 1, 0, 0

9565

9566

; numerical literal

9567

LIT_13: db 2, 0, 0

9568

dw 0, 32, 0, 0

9569

9570

; identifier I

9571

IDF_14: equ VAR_STACK.POINTER + 0

9572

9573

; identifier S

9574

IDF_19: equ VAR_STACK.POINTER + 11

9575

9576

; numerical literal

9577

LIT_20: db 2, 0, 0

9578

dw 0, 16, 0, 0

9579

9580

; identifier A$

9581

IDF_21: equ VAR_STACK.POINTER + 22

9582

9583

; numerical literal

9584

LIT_23: db 2, 0, 0

9585

dw 0, 255, 0, 0

9586

9587

; identifier B

9588

IDF_24: equ VAR_STACK.POINTER + 33

9589

9590

; numerical literal

9591

LIT_27: db 2, 0, 0

9592

dw 0, 1, 0, 0

9593

9594

; numerical literal

9595

LIT_29: db 2, 0, 0

9596

dw 0, 2, 0, 0

9597

9598

; numerical literal

9599

LIT_30: db 2, 0, 0

9600

dw 0, 255, 0, 0

9601

9602

; identifier C

9603

IDF_34: equ VAR_STACK.POINTER + 44

9604

9605

; numerical literal

9606

LIT_35: db 2, 0, 0

9607

dw 0, 0, 0, 0

9608

9609

; numerical literal

9610

LIT_37: db 2, 0, 0

9611

dw 0, 1, 0, 0

9612

9613

; numerical literal

9614

LIT_40: db 2, 0, 0

9615

dw 0, 31, 0, 0

9616

9617

; identifier J

9618

IDF_41: equ VAR_STACK.POINTER + 55

9619

9620

; numerical literal

9621

LIT_42: db 2, 0, 0

9622

dw 0, 7, 0, 0

9623

9624

; numerical literal

9625

LIT_43: db 2, 0, 0

9626

dw 0, 1, 0, 0

9627

9628

; numerical literal

9629

LIT_45: db 2, 0, 0

9630

dw 0, 3, 0, 0

9631

9632

; numerical literal

9633

LIT_49: db 2, 0, 0

9634

dw 0, 150, 0, 0

9635

9636

; numerical literal

9637

LIT_50: db 2, 0, 0

9638

dw 0, 8, 0, 0

9639

9640

; numerical literal

9641

LIT_52: db 2, 0, 0

9642

dw 0, 8, 0, 0

9643

9644

; numerical literal

9645

LIT_53: db 2, 0, 0

9646

dw 0, 1, 0, 0

9647

9648

; identifier R

9649

IDF_54: equ VAR_STACK.POINTER + 66

9650

9651

; numerical literal

9652

LIT_56: db 2, 0, 0

9653

dw 0, 5, 0, 0

9654

9655

; numerical literal

9656

LIT_57: db 2, 0, 0

9657

dw 0, 32, 0, 0

9658

9659

; numerical literal

9660

LIT_58: db 2, 0, 0

9661

dw 0, 5, 0, 0

9662

9663

; numerical literal

9664

LIT_59: db 2, 0, 0

9665

dw 0, 767, 0, 0

9666

9667

; numerical literal

9668

LIT_61: db 2, 0, 0

9669

dw 0, 1, 0, 0

9670

9671

; numerical literal

9672

LIT_62: db 2, 0, 0

9673

dw 0, 7, 0, 0

9674

9675

; identifier L

9676

IDF_65: equ VAR_STACK.POINTER + 77

9677

9678

; numerical literal

9679

LIT_66: db 2, 0, 0

9680

dw 0, 0, 0, 0

9681

9682

; numerical literal

9683

LIT_67: db 2, 0, 0

9684

dw 0, 64, 0, 0

9685

9686

; numerical literal

9687

LIT_68: db 2, 0, 0

9688

dw 0, 255, 0, 0

9689

9690

; identifier K

9691

IDF_69: equ VAR_STACK.POINTER + 88

9692

9693

; numerical literal

9694

LIT_70: db 2, 0, 0

9695

dw 0, 64, 0, 0

9696

9697

; numerical literal

9698

LIT_71: db 2, 0, 0

9699

dw 0, 1, 0, 0

9700

9701

; numerical literal

9702

LIT_73: db 2, 0, 0

9703

dw 0, 1, 0, 0

9704

9705

; numerical literal

9706

LIT_74: db 2, 0, 0

9707

dw 0, 0, 0, 0

9708

9709

; numerical literal

9710

LIT_75: db 2, 0, 0

9711

dw 0, 1, 0, 0

9712

9713

; numerical literal

9714

LIT_76: db 2, 0, 0

9715

dw 0, 63, 0, 0

9716

9717

; numerical literal

9718

LIT_78: db 2, 0, 0

9719

dw 0, 6, 0, 0

9720

9721

; numerical literal

9722

LIT_79: db 2, 0, 0

9723

dw 0, 1, 0, 0

9724

9725

; numerical literal

9726

LIT_80: db 2, 0, 0

9727

dw 0, 6, 0, 0

9728

9729

; numerical literal

9730

LIT_81: db 2, 0, 0

9731

dw 0, 3, 0, 0

9732

9733

; numerical literal

9734

LIT_83: db 2, 0, 0

9735

dw 0, 16, 0, 0

9736

9737

; numerical literal

9738

LIT_85: db 2, 0, 0

9739

dw 0, 4, 0, 0

9740

9741

; numerical literal

9742

LIT_86: db 2, 0, 0

9743

dw 0, 7, 0, 0

9744

9745

; numerical literal

9746

LIT_87: db 2, 0, 0

9747

dw 0, 14, 0, 0

9748

9749

; numerical literal

9750

LIT_88: db 2, 0, 0

9751

dw 0, 15, 0, 0

9752

9753

; numerical literal

9754

LIT_90: db 2, 0, 0

9755

dw 0, 0, 0, 0

9756

9757

; numerical literal

9758

LIT_91: db 2, 0, 0

9759

dw 0, 0, 0, 0

9760

9761

; numerical literal

9762

LIT_92: db 2, 0, 0

9763

dw 0, 1, 0, 0

9764

9765

; numerical literal

9766

LIT_93: db 2, 0, 0

9767

dw 0, 3, 0, 0

9768

9769

; numerical literal

9770

LIT_94: db 2, 0, 0

9771

dw 0, 7, 0, 0

9772

9773

; numerical literal

9774

LIT_95: db 2, 0, 0

9775

dw 0, 64, 0, 0

9776

9777

; numerical literal

9778

LIT_96: db 2, 0, 0

9779

dw 0, 0, 0, 0

9780

9781

; numerical literal

9782

LIT_97: db 2, 0, 0

9783

dw 0, 1, 0, 0

9784

9785

; numerical literal

9786

LIT_98: db 2, 0, 0

9787

dw 0, 63, 0, 0

9788

9789

; numerical literal

9790

LIT_99: db 2, 0, 0

9791

dw 0, 1, 0, 0

9792

9793

; numerical literal

9794

LIT_100: db 2, 0, 0

9795

dw 0, 6, 0, 0

9796

9797

; numerical literal

9798

LIT_102: db 2, 0, 0

9799

dw 0, 205, 0, 0

9800

9801

; numerical literal

9802

LIT_104: db 2, 0, 0

9803

dw 0, 185, 0, 0

9804

9805

AFTER_LAST_VARIABLE: equ VAR_STACK.POINTER + 99

9806

9807

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

9808

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

9809

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

9810

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

9811

9812

VAR_DUMMY.SIZE: equ 8

9813

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

9814

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

9815

VAR_STACK.END: equ VAR_DUMMY.END + 1

9816

9817

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

9818

; DATA SIMBOLS

9819

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

9820

9821

DATA_ITEMS:

9822

dw LIT_85

9823

dw LIT_86

9824

dw LIT_87

9825

dw LIT_88

9826

DATA_ITEMS_COUNT: equ 4

9827

9828

DATA_SET_ITEMS_START:

9829

DATA_SET_ITEMS_COUNT: equ 0

9830

9831

9832

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

9833

; PROGRAM FOOTER

9834

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

9835

9836

if defined COMPILE_TO_ROM

9837

9838

romPad:

9839

9840

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

9841

9842

if pgmPage2.pad >= 0

9843

ds pgmPage2.pad, 0

9844

9845

if pgmPage2.pad < lowLimitSize

9846

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

9847

endif

9848

else

9849

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

9850

endif

9851

9852

endif

9853

9854

end_file: end start_pgm ; label start is the entry point

9855

Older »