~amaurycarvalho/msxbas2asm/trunk

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

389

390

BASIC_CURLIN: equ 0xF41C ; BASIC current line number

391

BASIC_INTVAL: equ 0xFCA0 ; interval value

392

BASIC_INTCNT: equ 0xFCA2 ; interval current count

393

394

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

395

396

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

397

398

BASIC_TRPTBL_KEY: equ 0xFC4C ; 30 ON KEY GOSUB

399

BASIC_TRPTBL_STOP: equ 0xFC6A ; 3 ON STOP GOSUB

400

BASIC_TRPTBL_SPRITE: equ 0xFC6D ; 3 ON SPRITE GOSUB

401

BASIC_TRPTBL_STRIG: equ 0xFC70 ; 15 ON STRIG GOSUB

402

BASIC_TRPTBL_INTERVAL: equ 0xFC7F ; 3 ON INTERVAL GOSUB

403

BASIC_TRPTBL_OTHER: equ 0xFC82 ; 24 reserved for expansion

404

405

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

406

407

408

409

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

410

; MATH PACK ROUTINES

411

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

412

413

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

414

; SUPPORT MACROS

415

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

416

COMPILE_TO_ROM: EQU 1

417

418

MACRO __call_basic,CALL_PARM

419

ld ix, CALL_PARM

420

call BIOS_CALBAS

421

ENDM

422

423

if defined COMPILE_TO_DOS

424

425

MACRO __call_bios,CALL_PARM

426

;ld iy,(BIOS_EXPTBL-1)

427

ld ix, CALL_PARM

428

call BIOS_CALBAS ; BIOS_CALSLT

429

ENDM

430

431

else

432

433

MACRO __call_bios,CALL_PARM

434

call CALL_PARM

435

ENDM

436

437

endif

438

439

MACRO push.parm

440

push hl ; save parameter

441

ENDM

442

443

MACRO pop.parm

444

pop iy ; restore PC of caller

445

pop hl ; get next parameter

446

push iy ; save PC of caller

447

ENDM

448

449

MACRO push.ret.parm

450

pop iy ; restore PC of caller

451

push hl ; save return parameter

452

push iy ; save PC of caller

453

ENDM

454

455

MACRO ret.parm

456

pop iy ; restore PC of caller

457

push hl ; save return parameter

458

push iy ; save PC of caller

459

ret ; return

460

ENDM

461

462

MACRO set.line.number, line_number

463

ld bc, line_number ; current line number

464

ld (BASIC_CURLIN), bc

465

ENDM

466

467

MACRO verify.break

468

ld a, (BIOS_INTFLG) ; verify CTRL+BREAK

469

or a

470

jp nz, end_pgm

471

ENDM

472

473

MACRO check.traps

474

ld a, (BASIC_ONGSBF) ; trap occured counter

475

or a

476

call nz, RUN_TRAPS

477

ENDM

478

479

480

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

481

; PROGRAM HEADER

482

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

483

484

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

485

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

486

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

487

488

if defined COMPILE_TO_BIN

489

490

pgmArea: equ 0x8000 ; page 2 - program area

491

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

492

493

org pgmArea ; program binary type start address

494

db 0FEh ; binary file ID

495

dw start_pgm ; begin address

496

dw end_file - 1 ; end address

497

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

498

499

else

500

if defined COMPILE_TO_ROM

501

502

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

503

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

504

505

org pgmArea ; program rom type start address

506

db 'AB' ; rom file ID

507

dw start_pgm ; INIT

508

dw 0x0000 ; STATEMENT

509

dw 0x0000 ; DEVICE

510

dw 0x0000 ; TEXT

511

ds 6,0 ; RESERVED

512

513

else

514

515

pgmArea: equ 0x8000 ; page 2 - program area

516

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

517

518

org pgmArea ; program DOS type start address ; 0x0100

519

520

endif

521

endif

522

523

524

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

525

; PROGRAM ROUTINES

526

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

527

528

if defined COMPILE_TO_ROM

529

530

PROGRAM_TO_BASIC:

531

call PROGRAM_SLOT_2_RESTORE

532

__call_basic BASIC_READYR ; warm start Basic

533

ret

534

535

PROGRAM_SLOT_2_SAVE:

536

ld h,080h

537

call PROGRAM_SLOT_GET

538

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

539

ret

540

541

PROGRAM_SLOT_2_RESTORE:

542

ld a, (BIOS_RAMAD2)

543

ld h,080h

544

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

545

546

PROGRAM_SLOT_2_ENABLE:

547

call BIOS_RSLREG

548

call PROGRAM_SLOT_ENABLE_SUB

549

ld h,080h

550

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

551

552

PROGRAM_SLOT_1_ENABLE:

553

call BIOS_RSLREG

554

rrca

555

rrca

556

call PROGRAM_SLOT_ENABLE_SUB

557

ld h,040h

558

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

559

560

PROGRAM_SLOT_ENABLE_SUB:

561

rrca

562

rrca

563

and 3 ;Keep bits corresponding to the page

564

ld c,a

565

ld b,0

566

ld hl,BIOS_EXPTBL

567

add hl,bc

568

ld a,(hl)

569

and 80h

570

or c

571

ld c,a

572

inc hl

573

inc hl

574

inc hl

575

inc hl

576

ld a,(hl)

577

and 0Ch

578

or c

579

ret

580

581

; h = memory page

582

; a <- slot ID formatted FxxxSSPP

583

; Modifies: af, bc, de, hl

584

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

585

PROGRAM_SLOT_GET:

586

call BIOS_RSLREG

587

bit 7,h

588

jr z,PrimaryShiftContinue

589

rrca

590

rrca

591

rrca

592

rrca

593

PrimaryShiftContinue:

594

bit 6,h

595

jr z,PrimaryShiftDone

596

rrca

597

rrca

598

PrimaryShiftDone:

599

and 00000011B

600

ld c,a

601

ld b,0

602

ex de,hl

603

ld hl,BIOS_EXPTBL

604

add hl,bc

605

ld c,a

606

ld a,(hl)

607

and 80H

608

or c

609

ld c,a

610

inc hl ; move to SLTTBL

611

inc hl

612

inc hl

613

inc hl

614

ld a,(hl)

615

ex de,hl

616

bit 7,h

617

jr z,SecondaryShiftContinue

618

rrca

619

rrca

620

rrca

621

rrca

622

SecondaryShiftContinue:

623

bit 6,h

624

jr nz,SecondaryShiftDone

625

rlca

626

rlca

627

SecondaryShiftDone:

628

and 00001100B

629

or c

630

ret

631

632

endif

633

634

if defined COMPILE_TO_DOS

635

636

BIOS_SLOT_ENABLE:

637

ld a, (BIOS_EXPTBL)

638

ld hl,0

639

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

640

ret

641

642

BASIC_SLOT_ENABLE:

643

ld a, (BIOS_EXPTBL)

644

ld hl,04000h

645

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

646

ret

647

648

endif

649

650

651

652

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

653

; PROGRAM MAIN CODE

654

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

655

656

start_pgm: ; start of the program

657

658

if defined COMPILE_TO_DOS

659

660

call BIOS_SLOT_ENABLE ; enable bios on page 0

661

call BASIC_SLOT_ENABLE ; enable basic on page 1

662

663

else

664

if defined COMPILE_TO_ROM

665

666

call PROGRAM_SLOT_2_SAVE ; save slot on page 2

667

call PROGRAM_SLOT_2_ENABLE ; enable program on page 2

668

669

endif

670

endif

671

672

__call_bios BIOS_ERAFNK ; turn off function keys display

673

__call_bios BIOS_GICINI ; initialize sound system

674

__call_bios BIOS_INITXT ; initialize text screen

675

xor a

676

ld (BIOS_CLIKSW), a ; disable keyboard click

677

ld bc, 0xFFFF ;

678

ld (BASIC_CURLIN), bc ; interpreter in direct mode

679

__call_basic BASIC_TRAP_CLEAR ; clear traps work space

680

;call INITIALIZE_PARAMETERS ; initialize parameters stack

681

call memory.init ; initialize memory allocation

682

call INITIALIZE_VARIABLES ; initialize variables

683

684

685

TAG_10:

686

set.line.number 10 ; current line number

687

ld hl, LIT_4 ; parameter

688

push.parm

689

call SCREEN ; action call

690

691

TAG_20:

692

set.line.number 20 ; current line number

693

ld hl, LIT_6 ; parameter

694

push.parm

695

ld hl, IDF_5 ; parameter

696

push.parm

697

call LET ; action call

698

699

TAG_30:

700

set.line.number 30 ; current line number

701

ld hl, LIT_8 ; parameter

702

push.parm

703

ld hl, IDF_7 ; parameter

704

push.parm

705

call LET ; action call

706

707

TAG_40:

708

set.line.number 40 ; current line number

709

ld hl, LIT_10 ; parameter

710

push.parm

711

ld hl, IDF_9 ; parameter

712

push.parm

713

call LET ; action call

714

715

TAG_50:

716

set.line.number 50 ; current line number

717

ld hl, LIT_12 ; parameter

718

push.parm

719

ld hl, IDF_11 ; parameter

720

push.parm

721

call LET ; action call

722

723

TAG_70:

724

set.line.number 70 ; current line number

725

ld hl, IDF_9 ; parameter

726

push.parm

727

ld hl, IDF_5 ; parameter

728

push.parm

729

call MATH.SUB ; action call

730

call ABS ; action call

731

ld hl, IDF_13 ; parameter

732

push.parm

733

call LET ; action call

734

IF_1 : ; start of IF command

735

ld hl, IDF_5 ; parameter

736

push.parm

737

ld hl, IDF_9 ; parameter

738

push.parm

739

call BOOLEAN.LT ; action call

740

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

741

or a ; cp 0 = false

742

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

743

THEN_1 : ; THEN actions

744

ld hl, LIT_21 ; parameter

745

push.parm

746

ld hl, IDF_20 ; parameter

747

push.parm

748

call LET ; action call

749

jp ENDIF_1 ; jump to END of IF command

750

ELSE_1 : ; ELSE actions

751

ld hl, LIT_23 ; parameter

752

push.parm

753

call MATH.NEG ; action call

754

ld hl, IDF_20 ; parameter

755

push.parm

756

call LET ; action call

757

ENDIF_1 : ; end of IF command

758

759

TAG_80:

760

set.line.number 80 ; current line number

761

ld hl, IDF_11 ; parameter

762

push.parm

763

ld hl, IDF_7 ; parameter

764

push.parm

765

call MATH.SUB ; action call

766

call ABS ; action call

767

ld hl, IDF_25 ; parameter

768

push.parm

769

call LET ; action call

770

IF_2 : ; start of IF command

771

ld hl, IDF_7 ; parameter

772

push.parm

773

ld hl, IDF_11 ; parameter

774

push.parm

775

call BOOLEAN.LT ; action call

776

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

777

or a ; cp 0 = false

778

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

779

THEN_2 : ; THEN actions

780

ld hl, LIT_27 ; parameter

781

push.parm

782

ld hl, IDF_26 ; parameter

783

push.parm

784

call LET ; action call

785

jp ENDIF_2 ; jump to END of IF command

786

ELSE_2 : ; ELSE actions

787

ld hl, LIT_28 ; parameter

788

push.parm

789

call MATH.NEG ; action call

790

ld hl, IDF_26 ; parameter

791

push.parm

792

call LET ; action call

793

ENDIF_2 : ; end of IF command

794

795

TAG_85:

796

set.line.number 85 ; current line number

797

IF_3 : ; start of IF command

798

ld hl, IDF_13 ; parameter

799

push.parm

800

ld hl, IDF_25 ; parameter

801

push.parm

802

call BOOLEAN.GT ; action call

803

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

804

or a ; cp 0 = false

805

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

806

THEN_3 : ; THEN actions

807

ld hl, IDF_13 ; parameter

808

push.parm

809

ld hl, LIT_31 ; parameter

810

push.parm

811

call MATH.IDIV ; action call

812

ld hl, IDF_30 ; parameter

813

push.parm

814

call LET ; action call

815

jp ENDIF_3 ; jump to END of IF command

816

ELSE_3 : ; ELSE actions

817

ld hl, IDF_25 ; parameter

818

push.parm

819

call MATH.NEG ; action call

820

ld hl, LIT_33 ; parameter

821

push.parm

822

call MATH.IDIV ; action call

823

ld hl, IDF_30 ; parameter

824

push.parm

825

call LET ; action call

826

ENDIF_3 : ; end of IF command

827

828

TAG_90:

829

set.line.number 90 ; current line number

830

ld hl, IDF_7 ; parameter

831

push.parm

832

ld hl, IDF_5 ; parameter

833

push.parm

834

call PSET.XY ; action call

835

call PSET ; action call

836

837

TAG_100:

838

set.line.number 100 ; current line number

839

IF_4 : ; start of IF command

840

ld hl, IDF_5 ; parameter

841

push.parm

842

ld hl, IDF_9 ; parameter

843

push.parm

844

call BOOLEAN.EQ ; action call

845

ld hl, IDF_7 ; parameter

846

push.parm

847

ld hl, IDF_11 ; parameter

848

push.parm

849

call BOOLEAN.EQ ; action call

850

call BOOLEAN.AND ; action call

851

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

852

or a ; cp 0 = false

853

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

854

THEN_4 : ; THEN actions

855

jp TAG_100 ; go to

856

jp ENDIF_4 ; jump to END of IF command

857

ELSE_4 : ; ELSE actions

858

ENDIF_4 : ; end of IF command

859

860

TAG_110:

861

set.line.number 110 ; current line number

862

ld hl, IDF_30 ; parameter

863

push.parm

864

ld hl, IDF_40 ; parameter

865

push.parm

866

call LET ; action call

867

868

TAG_120:

869

set.line.number 120 ; current line number

870

IF_5 : ; start of IF command

871

ld hl, IDF_40 ; parameter

872

push.parm

873

ld hl, IDF_13 ; parameter

874

push.parm

875

call MATH.NEG ; action call

876

call BOOLEAN.GT ; action call

877

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

878

or a ; cp 0 = false

879

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

880

THEN_5 : ; THEN actions

881

ld hl, IDF_30 ; parameter

882

push.parm

883

ld hl, IDF_25 ; parameter

884

push.parm

885

call MATH.SUB ; action call

886

ld hl, IDF_30 ; parameter

887

push.parm

888

call LET ; action call

889

jp ENDIF_5 ; jump to END of IF command

890

ELSE_5 : ; ELSE actions

891

ENDIF_5 : ; end of IF command

892

893

TAG_130:

894

set.line.number 130 ; current line number

895

IF_6 : ; start of IF command

896

ld hl, IDF_40 ; parameter

897

push.parm

898

ld hl, IDF_13 ; parameter

899

push.parm

900

call MATH.NEG ; action call

901

call BOOLEAN.GT ; action call

902

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

903

or a ; cp 0 = false

904

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

905

THEN_6 : ; THEN actions

906

ld hl, IDF_5 ; parameter

907

push.parm

908

ld hl, IDF_20 ; parameter

909

push.parm

910

call MATH.ADD ; action call

911

ld hl, IDF_5 ; parameter

912

push.parm

913

call LET ; action call

914

jp ENDIF_6 ; jump to END of IF command

915

ELSE_6 : ; ELSE actions

916

ENDIF_6 : ; end of IF command

917

918

TAG_140:

919

set.line.number 140 ; current line number

920

IF_7 : ; start of IF command

921

ld hl, IDF_40 ; parameter

922

push.parm

923

ld hl, IDF_25 ; parameter

924

push.parm

925

call BOOLEAN.LT ; action call

926

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

927

or a ; cp 0 = false

928

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

929

THEN_7 : ; THEN actions

930

ld hl, IDF_30 ; parameter

931

push.parm

932

ld hl, IDF_13 ; parameter

933

push.parm

934

call MATH.ADD ; action call

935

ld hl, IDF_30 ; parameter

936

push.parm

937

call LET ; action call

938

jp ENDIF_7 ; jump to END of IF command

939

ELSE_7 : ; ELSE actions

940

ENDIF_7 : ; end of IF command

941

942

TAG_150:

943

set.line.number 150 ; current line number

944

IF_8 : ; start of IF command

945

ld hl, IDF_40 ; parameter

946

push.parm

947

ld hl, IDF_25 ; parameter

948

push.parm

949

call BOOLEAN.LT ; action call

950

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

951

or a ; cp 0 = false

952

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

953

THEN_8 : ; THEN actions

954

ld hl, IDF_7 ; parameter

955

push.parm

956

ld hl, IDF_26 ; parameter

957

push.parm

958

call MATH.ADD ; action call

959

ld hl, IDF_7 ; parameter

960

push.parm

961

call LET ; action call

962

jp ENDIF_8 ; jump to END of IF command

963

ELSE_8 : ; ELSE actions

964

ENDIF_8 : ; end of IF command

965

966

TAG_160:

967

set.line.number 160 ; current line number

968

jp TAG_90 ; go to

969

970

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

971

; PROGRAM END CODE

972

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

973

974

end_pgm: __call_bios BIOS_DSPFNK ; turn on function keys display

975

ld a, 1 ;

976

ld (BIOS_CLIKSW), a ; enable keyboard click

977

978

if defined COMPILE_TO_ROM

979

jp PROGRAM_TO_BASIC

980

else

981

__call_basic BASIC_READYR ; warm start Basic

982

endif

983

984

ret ; end of the program

985

986

;__call_bios BIOS_GICINI ; initialize sound system

987

;if defined COMPILE_TO_DOS or defined COMPILE_TO_ROM

988

; __call_bios BIOS_RESET ; restart Basic

989

;else

990

; __call_basic BASIC_END ; end to Basic

991

;endif

992

993

994

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

995

; MSX BASIC KEYWORDS

996

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

997

998

; keyword

999

LET:

1000

1001

; out IX = variable assigned address

1002

pop.parm ; get variable address parameter

1003

push hl ; just to transfer hl to ix

1004

pop ix ;

1005

ld a, (ix) ; get variable type

1006

cp 3 ; test if string

1007

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

1008

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

1009

or a ; cp 0

1010

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

1011

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

1012

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

1013

push ix ; save variable address

1014

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

1015

pop ix ;

1016

call memory.free ; free memory

1017

pop ix ; restore variable address

1018

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

1019

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

1020

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

1021

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

1022

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

1023

pop de ;

1024

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

1025

inc de ; go to variable data area

1026

inc de ;

1027

inc hl ; go to data data area

1028

inc hl ;

1029

ld bc, 8 ; data = 8 bytes

1030

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

1031

ld a, (ix) ; get variable type

1032

cp 3 ; test if string

1033

ret nz ; if not string, return

1034

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

1035

LET.FIXED: push ix ; save variable destination address

1036

push hl ; save variable source address

1037

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

1038

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

1039

pop de

1040

pop ix ; restore variable address

1041

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

1042

cp 3 ; test if string

1043

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

1044

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

1045

cp 3 ; test if string

1046

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

1047

inc de

1048

inc de

1049

inc de

1050

ld a, (de)

1051

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

1052

jr LET.FIX2

1053

LET.FIX1: push hl

1054

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

1055

pop hl

1056

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

1057

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

1058

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

1059

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

1060

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

1061

pop de ;

1062

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

1063

inc de ;

1064

inc de ;

1065

ld bc, 8 ; data = 8 bytes

1066

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

1067

ret ;

1068

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

1069

or a ; cp 0 - test if null

1070

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

1071

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

1072

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

1073

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

1074

ret ;

1075

LET.ALLOC: push ix ; save variable address

1076

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

1077

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

1078

push hl ; save copy from address

1079

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

1080

ld b, 0 ;

1081

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

1082

push bc ; save variable lenght + 1

1083

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

1084

jp z, memory.error

1085

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

1086

pop de ;

1087

pop bc ; restore bytes to be copied

1088

pop hl ; restore copy from string address

1089

push de ; save copy to address

1090

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

1091

;xor a

1092

;ld (de), a

1093

pop de ; restore copy to address

1094

pop ix ; restore variable address

1095

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

1096

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

1097

ret ; variable assigned

1098

1099

; keyword

1100

BOOLEAN.IF:

1101

1102

pop.parm ; get parameter boolean result in hl

1103

push hl ; ix = hl

1104

pop ix ;

1105

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

1106

ret ;

1107

1108

; keyword

1109

SCREEN:

1110

1111

pop.parm ; get first parameter

1112

call CAST_TO.INT ;

1113

call GET_INT.VALUE ; output BC with integer value

1114

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

1115

cp 9

1116

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

1117

ld a, 8 ; else, fix to 8

1118

SCREEN.1:

1119

if defined EXIST_DATA_SET

1120

call gfxSetScreenMode

1121

call gfxIsTileMode

1122

ret nz

1123

1124

jp gfxClearTileScreen

1125

else

1126

jp gfxSetScreenMode

1127

endif

1128

1129

; keyword

1130

ABS:

1131

; abstract virtual ABS

1132

; keyword

1133

MATH.SUB:

1134

1135

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

1136

ld a, (BASIC_VALTYP) ;

1137

cp 2 ; test if integer

1138

jp z, MATH.SUB.INT ;

1139

cp 3 ; test if string

1140

jp z, MATH.ERROR ;

1141

cp 4 ; test if single

1142

jp z, MATH.SUB.SGL ;

1143

jp MATH.SUB.DBL ; it is a double

1144

1145

; keyword

1146

BOOLEAN.LT:

1147

1148

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

1149

ld a, (BASIC_VALTYP) ;

1150

cp 2 ; test if integer

1151

jp z, BOOLEAN.LT.INT ;

1152

cp 3 ; test if string

1153

jp z, BOOLEAN.LT.STR ;

1154

cp 4 ; test if single

1155

jp z, BOOLEAN.LT.SGL ;

1156

jp BOOLEAN.LT.DBL ; it is a double

1157

1158

; keyword

1159

MATH.NEG:

1160

1161

call CLEAR.DAC ; put zero in DAC

1162

pop.parm ; get parameter

1163

call COPY_TO.ARG ; put in ARG

1164

cp 2 ; test if integer

1165

jp z, MATH.SUB.INT ;

1166

cp 4 ; test if single

1167

jp z, MATH.SUB.SGL ;

1168

cp 8 ; test if double

1169

jp z, MATH.SUB.DBL ;

1170

jp MATH.ERROR ;

1171

1172

; keyword

1173

BOOLEAN.GT:

1174

1175

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

1176

ld a, (BASIC_VALTYP) ;

1177

cp 2 ; test if integer

1178

jp z, BOOLEAN.GT.INT ;

1179

cp 3 ; test if string

1180

jp z, BOOLEAN.GT.STR ;

1181

cp 4 ; test if single

1182

jp z, BOOLEAN.GT.SGL ;

1183

jp BOOLEAN.GT.DBL ; it is a double

1184

1185

; keyword

1186

MATH.IDIV:

1187

1188

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

1189

ld a, (BASIC_VALTYP) ;

1190

cp 2 ; test if integer

1191

jp z, MATH.IDIV.INT ;

1192

cp 3 ; test if string

1193

jp z, MATH.ERROR ;

1194

cp 4 ; test if single

1195

jp z, MATH.IDIV.SGL ;

1196

jp MATH.IDIV.DBL ; it is a double

1197

1198

; keyword

1199

PSET:

1200

1201

jp gfxSetPixel

1202

1203

; keyword

1204

PSET.XY:

1205

1206

pop.parm ; get first parameter

1207

call CAST_TO.INT ;

1208

call GET_INT.VALUE ; output BC with integer value

1209

ld (BIOS_GRPACX), bc ; X

1210

pop.parm ; get second parameter

1211

call CAST_TO.INT ;

1212

call GET_INT.VALUE ; output BC with integer value

1213

ld (BIOS_GRPACY), bc ; Y

1214

jp gfxRefreshXY

1215

1216

; keyword

1217

BOOLEAN.EQ:

1218

1219

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

1220

ld a, (BASIC_VALTYP) ;

1221

cp 2 ; test if integer

1222

jp z, BOOLEAN.EQ.INT ;

1223

cp 3 ; test if string

1224

jp z, BOOLEAN.EQ.STR ;

1225

cp 4 ; test if single

1226

jp z, BOOLEAN.EQ.SGL ;

1227

jp BOOLEAN.EQ.DBL ; it is a double

1228

1229

; keyword

1230

BOOLEAN.AND:

1231

1232

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

1233

ld a, (BASIC_VALTYP) ;

1234

cp 2 ; test if integer

1235

jp z, BOOLEAN.AND.INT ;

1236

jp MATH.ERROR ; it is a double

1237

1238

; keyword

1239

GOTO:

1240

; abstract virtual GOTO

1241

; keyword

1242

MATH.ADD:

1243

1244

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

1245

ld a, (BASIC_VALTYP) ;

1246

cp 2 ; test if integer

1247

jp z, MATH.ADD.INT ;

1248

cp 3 ; test if string

1249

jp z, STRING.CONCAT ;

1250

cp 4 ; test if single

1251

jp z, MATH.ADD.SGL ;

1252

jp MATH.ADD.DBL ; it is a double

1253

1254

1255

1256

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

1257

; MSX BASIC SUPPORT CODE

1258

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

1259

1260

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

1261

1262

RUN_TRAPS: ld b, 26

1263

ld hl, BASIC_TRPTBL

1264

RUN_TRAPS.1: push hl

1265

push bc

1266

call TRAP_HANDLER

1267

pop bc

1268

pop hl

1269

inc hl

1270

inc hl

1271

inc hl

1272

djnz RUN_TRAPS.1

1273

ret

1274

1275

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

1276

TRAP_HANDLER:

1277

ld a, (hl) ; trap status

1278

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

1279

ret nz ; return if false

1280

inc hl

1281

ld e, (hl) ; get trap address

1282

inc hl

1283

ld d, (hl)

1284

dec hl

1285

dec hl

1286

ld a, d

1287

or e

1288

ret z ; return if address zero

1289

push hl

1290

__call_basic BASIC_TRAP_ACKNW

1291

__call_basic BASIC_TRAP_PAUSE

1292

ld hl, TRAP_HANDLER.1

1293

ld a, (BASIC_ONGSBF) ; save traps execution

1294

push af

1295

xor a

1296

ld (BASIC_ONGSBF), a ; disable traps execution

1297

push hl ; next return will be to trap handler

1298

push de ; indirect jump to trap address

1299

ret

1300

TRAP_HANDLER.1: pop af

1301

ld (BASIC_ONGSBF), a ; restore traps execution

1302

pop hl

1303

ld a, (hl)

1304

cp 1 ; trap enabled?

1305

ret z

1306

__call_basic BASIC_TRAP_UNPAUSE

1307

ret

1308

1309

; hl = trap block, de = trap handler

1310

SET_TRAP: xor a

1311

ld (hl), a ; trap block status

1312

inc hl

1313

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

1314

inc hl

1315

ld (hl), d

1316

ret

1317

1318

endif

1319

1320

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

1321

1322

SET_PLAY_VOICE:

1323

ld (BIOS_TEMP), a ; save voice number

1324

pop.parm

1325

ld a, (hl)

1326

cp 3

1327

ret nz ; return if not string

1328

call GET_STR.ADDR

1329

SET_PLAY_VOICE.1:

1330

ld (BIOS_TEMP2), a ; save string size

1331

push hl ; string address

1332

ld a, (BIOS_TEMP) ; restore voice number

1333

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

1334

pop de

1335

ld a, (BIOS_TEMP2) ; restore string size

1336

ld (hl), a ; string size

1337

inc hl

1338

ld (hl), e ; string address

1339

inc hl

1340

ld (hl), d

1341

inc hl

1342

ld D,H ; voice stack

1343

ld E,L

1344

ld BC,001CH

1345

add HL,BC

1346

ex DE,HL

1347

ld (HL),E

1348

inc HL

1349

ld (HL),D

1350

ret

1351

1352

START_PLAY:

1353

ld HL, 0x752E

1354

ld (BIOS_MCLTAB),HL

1355

ld a, 1

1356

ld (BIOS_MCLFLG),A

1357

ld hl, BIOS_TEMP ; voice count

1358

ld a, 3

1359

sub (hl)

1360

dec a

1361

ld (BIOS_PRSCNT), a

1362

xor a

1363

ld (BIOS_VOICEN), a

1364

ld (BIOS_QUEUEN), a

1365

ld (BIOS_MUSICF), a

1366

ld HL,-12 ; -10

1367

add HL,SP

1368

ld (BIOS_SAVSP),HL

1369

ld HL, BIOS_PLYCNT

1370

ld (HL), 0

1371

__call_basic BASIC_PLAY_DIRECT

1372

ret

1373

1374

endif

1375

1376

1377

1378

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

1379

; VARIABLES ROUTINES

1380

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

1381

1382

; input hl = variable address

1383

; input bc = variable name

1384

; input d = variable type

1385

INIT_VAR: ld (hl), d ; variable type

1386

inc hl

1387

ld (hl), c ; variable name 1

1388

inc hl

1389

ld (hl), b ; variable name 2

1390

ld a, d

1391

cp 3

1392

jp nz, CLEAR.VAR

1393

ld de, LIT_NULL_STR

1394

inc hl

1395

ld (hl), 0

1396

inc hl

1397

ld (hl), e

1398

inc hl

1399

ld (hl), d

1400

ld b, 5

1401

jr CLEAR.VAR.LOOP

1402

CLEAR.VAR: ld b, 8

1403

CLEAR.VAR.LOOP: inc hl

1404

ld (hl), 0 ; data address/value

1405

djnz CLEAR.VAR.LOOP

1406

ret

1407

; input HL = variable address

1408

; input A = variable output type

1409

; output HL = casted data address

1410

CAST_TO: cp 2

1411

jp z, CAST_TO.INT

1412

cp 3

1413

jp z, CAST_TO.STR

1414

cp 4

1415

jp z, CAST_TO.SGL

1416

cp 8

1417

jp z, CAST_TO.DBL

1418

ret

1419

; input HL = variable address

1420

; output HL = variable address

1421

CAST_TO.INT: ;push af

1422

ld a, (HL)

1423

cp 2

1424

jp z, GET_INT.ADDR

1425

cp 3

1426

jp z, CAST_STR_TO.INT

1427

cp 4

1428

jp z, CAST_SGL_TO.INT

1429

cp 8

1430

jp z, CAST_DBL_TO.INT

1431

;pop af

1432

ret

1433

; input HL = variable address

1434

; output HL = variable address

1435

CAST_TO.STR: ;push af

1436

ld a, (HL)

1437

cp 2

1438

jp z, CAST_INT_TO.STR

1439

cp 3

1440

jp z, GET_STR.ADDR

1441

cp 4

1442

jp z, CAST_SGL_TO.STR

1443

cp 8

1444

jp z, CAST_DBL_TO.STR

1445

;pop af

1446

ret

1447

; input HL = variable address

1448

; output HL = variable address

1449

CAST_TO.SGL: ;push af

1450

ld a, (HL)

1451

cp 2

1452

jp z, CAST_INT_TO.SGL

1453

cp 3

1454

jp z, CAST_STR_TO.SGL

1455

cp 4

1456

jp z, GET_SGL.ADDR

1457

cp 8

1458

jp z, CAST_DBL_TO.SGL

1459

;pop af

1460

ret

1461

; input HL = variable address

1462

; output HL = variable address

1463

CAST_TO.DBL: ;push af

1464

ld a, (hl)

1465

cp 2

1466

jp z, CAST_INT_TO.DBL

1467

cp 3

1468

jp z, CAST_STR_TO.DBL

1469

cp 4

1470

jp z, CAST_SGL_TO.DBL

1471

cp 8

1472

jp z, GET_DBL.ADDR

1473

;pop af

1474

ret

1475

CAST_SGL_TO.STR: ; same as CAST_INT_TO.STR

1476

CAST_DBL_TO.STR: ; same as CAST_INT_TO.STR

1477

CAST_INT_TO.STR: call COPY_TO.DAC

1478

xor a

1479

__call_bios MATH_FOUT ; convert DAC to string

1480

;pop af

1481

ret

1482

CAST_INT_TO.SGL: call COPY_TO.DAC

1483

__call_bios MATH_FRCSGL

1484

ld hl, BASIC_DAC

1485

ret

1486

CAST_INT_TO.DBL: call COPY_TO.DAC

1487

__call_bios MATH_FRCDBL

1488

ld hl, BASIC_DAC

1489

ret

1490

CAST_SGL_TO.INT: ; same as CAST_DBL_TO.INT

1491

CAST_DBL_TO.INT: call COPY_TO.DAC

1492

__call_bios MATH_FRCINT

1493

ld hl, BASIC_DAC

1494

ret

1495

CAST_STR_TO.INT: call CAST_STR_TO.VAL ;

1496

__call_bios MATH_FRCINT ;

1497

ld hl, BASIC_DAC ;

1498

ret ;

1499

CAST_STR_TO.SGL: call CAST_STR_TO.VAL ;

1500

__call_bios MATH_FRCSGL ;

1501

ld hl, BASIC_DAC ;

1502

ret ;

1503

CAST_STR_TO.DBL: call CAST_STR_TO.VAL ;

1504

__call_bios MATH_FRCDBL ;

1505

ld hl, BASIC_DAC ;

1506

ret ;

1507

CAST_STR_TO.VAL: call GET_STR.ADDR ;

1508

ld a, (hl) ;

1509

__call_bios MATH_FIN ; convert string to a value type

1510

ld hl, BASIC_DAC ;

1511

ret ;

1512

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

1513

inc hl ;

1514

ld c, (hl) ;

1515

inc hl ;

1516

ld b, (hl) ;

1517

ret ;

1518

CAST_SGL_TO.DBL: ; same as GET_DBL.ADDR

1519

CAST_DBL_TO.SGL: ; same as GET_DBL.ADDR

1520

GET_INT.ADDR: ; same as GET_DBL.ADDR

1521

GET_SGL.ADDR: ; same as GET_DBL.ADDR

1522

GET_DBL.ADDR: inc hl

1523

inc hl

1524

inc hl

1525

;pop af

1526

ret

1527

GET_STR.ADDR: push hl

1528

pop ix

1529

ld a, (ix + 3)

1530

ld l, (ix + 4)

1531

ld h, (ix + 5)

1532

ret

1533

; input hl = string address

1534

; output b = string length

1535

GET_STR.LENGTH: ld b, 0

1536

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

1537

or a ; cp 0

1538

ret z

1539

inc b

1540

inc hl

1541

ld a, b

1542

cp 255

1543

jr z, GET_STR.LEN.ERR

1544

jr GET_STR.LEN.NEXT

1545

GET_STR.LEN.ERR: ld b, 0

1546

ret

1547

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

1548

ld iy, (BASIC_ARG+1) ; string 2

1549

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

1550

cp (iy) ; char s1 = char s2?

1551

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

1552

cp 0 ;

1553

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

1554

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

1555

cp 0 ;

1556

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

1557

inc ix ;

1558

inc iy ;

1559

jr STRING.COMPARE.NX ; get next char pair

1560

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

1561

cp 0 ;

1562

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

1563

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

1564

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

1565

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

1566

ret ;

1567

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

1568

ret ;

1569

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

1570

ret ;

1571

STRING.CONCAT: ld ix, BASIC_DAC ; s1 size

1572

ld a, (BASIC_ARG) ; s2 size

1573

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

1574

push af

1575

ld b, 0

1576

ld c, a ;

1577

inc bc ; add 1 byte to size

1578

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

1579

jp z, memory.error ;

1580

push ix ; save ix

1581

push ix ; save ix

1582

pop de ; de = ix

1583

ld a, (BASIC_DAC) ; s1 size

1584

ld hl, (BASIC_DAC + 1) ; string 1

1585

call COPY_TO.STR ; copy to new memory

1586

ld a, (BASIC_ARG) ; s2 size

1587

ld hl, (BASIC_ARG + 1) ; string 2

1588

call COPY_TO.STR ; copy to new memory

1589

xor a

1590

ld (de), a ; null terminated

1591

pop hl ; hl = ix

1592

pop af

1593

call COPY_TO.VAR_DUMMY.STR ;

1594

ret.parm ; WARNING - VERIFY STRING MEMORY LEAKs

1595

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

1596

cp 5 ;

1597

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

1598

cp 2 ;

1599

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

1600

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

1601

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

1602

ret z ; exit if yes

1603

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

1604

inc hl ; next char

1605

jr STRING.PRINT.T ; repeat

1606

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

1607

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

1608

ret z ; exit if yes

1609

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

1610

inc hl ; next char

1611

jr STRING.PRINT.G1 ; repeat

1612

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

1613

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

1614

ret z ; exit if yes

1615

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

1616

call BIOS_EXTROM

1617

inc hl ; next char

1618

jr STRING.PRINT.G2 ; repeat

1619

1620

; a = string size to copy

1621

; input hl = string from

1622

; input de = string to

1623

COPY_TO.STR: or a

1624

ret z ; avoid copy if size = zero

1625

ld b, 0

1626

ld c, a ; string size

1627

ldir ; copy bc bytes from hl to de

1628

ret ;

1629

COPY_TO.BASIC_BUF: ld bc, BASIC_BUF

1630

ld a, (LIT_QUOTE_CHAR)

1631

ld (bc), a

1632

inc bc

1633

COPY_BAS_BUF.LOOP: ld a, (hl)

1634

or a ; cp 0

1635

jr z, COPY_BAS_BUF.EXIT

1636

ld (bc), a

1637

inc bc

1638

inc hl

1639

jr COPY_BAS_BUF.LOOP

1640

COPY_BAS_BUF.EXIT: ld a, (LIT_QUOTE_CHAR)

1641

ld (bc), a

1642

inc bc

1643

xor a

1644

ld (bc), a

1645

ld hl, BASIC_BUF

1646

ret

1647

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

1648

cp 3 ;

1649

jr nz, COPY_TO.VAR_DUMMY.DBL

1650

push hl

1651

call GET_STR.LENGTH ; get string length

1652

pop hl

1653

ld a, b ; string length

1654

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

1655

ld (ix), 3 ; data type string

1656

ld (ix+1), 0 ;

1657

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

1658

ld (ix+3), a ; string length

1659

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

1660

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

1661

;call GET_STR.LENGTH ; get string length

1662

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

1663

push ix ; output var address...

1664

pop hl ; ...into hl

1665

ret ;

1666

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

1667

ld (ix), 2 ; data type string

1668

ld (ix+1), 0 ;

1669

ld (ix+2), 0 ;

1670

ld (ix+3), 0 ;

1671

ld (ix+4), 0 ;

1672

ld (ix+5), c ;

1673

ld (ix+6), b ;

1674

ld (ix+7), 0 ;

1675

ld (ix+8), 0 ;

1676

ld (ix+9), 0 ;

1677

ld (ix+10), 0 ;

1678

push ix ; output var address...

1679

pop hl ; ...into hl

1680

ret ;

1681

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

1682

ld (ix), a ; data type

1683

ld (ix+1), 0 ;

1684

ld (ix+2), 0 ;

1685

ld bc, 8 ;

1686

ld hl, BASIC_DAC ;

1687

push ix ; just to copy ix to de

1688

pop de ;

1689

inc de ;

1690

inc de ;

1691

inc de ;

1692

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

1693

push ix ; output var address...

1694

pop hl ; ...into hl

1695

ret ;

1696

GET_VAR_DUMMY.ADDR: push af ;

1697

push de

1698

ld de, 11 ;

1699

ld ix, (VAR_DUMMY.POINTER) ;

1700

ld a, (VAR_DUMMY.COUNTER) ;

1701

GET_VAR_DUMMY.NEXT: add ix, de ;

1702

inc a ;

1703

cp VAR_DUMMY.SIZE ;

1704

jr nz, GET_VAR_DUMMY.EXIT ;

1705

xor a ;

1706

ld ix, VAR_DUMMY.DATA ;

1707

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

1708

ld (VAR_DUMMY.COUNTER), a ;

1709

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

1710

cp 3 ; is it string?

1711

call z, GET_VAR_DUMMY.FREE ; free string memory

1712

pop de

1713

pop af ;

1714

ret ;

1715

GET_VAR_DUMMY.FREE:

1716

push hl

1717

push ix

1718

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

1719

ld h, (ix+5)

1720

push hl

1721

pop ix

1722

call memory.free ; free memory

1723

pop ix

1724

pop hl

1725

ret

1726

; input hl = variable address

1727

COPY_TO.DAC: ld de, BASIC_DAC

1728

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

1729

ld (BASIC_VALTYP), a

1730

inc hl

1731

inc hl

1732

inc hl

1733

ld bc, 8 ; data = 8 bytes

1734

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

1735

ret

1736

COPY_TO.ARG: ld de, BASIC_ARG ;

1737

jr COPY_TO.DAC.DATA ;

1738

COPY_TO.DAC_ARG: ld hl, BASIC_DAC ;

1739

ld de, BASIC_ARG ;

1740

ld bc, 8 ; data = 8 bytes

1741

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

1742

ret ;

1743

COPY_TO.ARG_DAC: ld hl, BASIC_ARG ;

1744

ld de, BASIC_DAC ;

1745

ld bc, 8 ; data = 8 bytes

1746

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

1747

ret ;

1748

COPY_TO.DAC_TMP: ld hl, BASIC_DAC ;

1749

ld de, BASIC_SWPTMP ;

1750

ld bc, 8 ; data = 8 bytes

1751

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

1752

ret ;

1753

COPY_TO.TMP_DAC: ld hl, BASIC_SWPTMP ;

1754

ld de, BASIC_DAC ;

1755

ld bc, 8 ; data = 8 bytes

1756

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

1757

ret ;

1758

SWAP.DAC.ARG: di

1759

exx ; save registers

1760

ld bc, 8 ;

1761

ld hl, BASIC_DAC ;

1762

ld de, BASIC_SWPTMP ;

1763

ldir ; copy bc bytes from hl to de

1764

ld bc, 8 ;

1765

ld hl, BASIC_ARG ;

1766

ld de, BASIC_DAC ;

1767

ldir ; copy bc bytes from hl to de

1768

ld bc, 8 ;

1769

ld hl, BASIC_SWPTMP ;

1770

ld de, BASIC_ARG ;

1771

ldir ; copy bc bytes from hl to de

1772

exx ; restore registers

1773

1774

ret ;

1775

CLEAR.DAC: ld de, BASIC_DAC

1776

CLEAR.DAC.DATA: ld hl, BASIC_VALTYP

1777

ld (hl), 2

1778

ld hl, LIT_NULL_DBL

1779

ld bc, 8 ; data = 8 bytes

1780

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

1781

ret

1782

CLEAR.ARG: ld de, BASIC_ARG

1783

jr CLEAR.DAC.DATA

1784

1785

1786

1787

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

1788

; MATH 16 BITS ROUTINES

1789

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

1790

1791

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

1792

ex af, af' ; save PC to temp

1793

pop.parm ; get first parameter

1794

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

1795

pop.parm ; get second parameter

1796

ex af, af' ; restore PC from temp

1797

push af ; put again PC from caller in stack

1798

ex af, af' ; restore 1st data type

1799

push af ; save 1st data type

1800

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

1801

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

1802

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

1803

ret z ; return if is equal data types

1804

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

1805

and 12 ; test if single/double

1806

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

1807

__call_bios MATH_FRCDBL ; convert DAC to double

1808

MATH.PARM.CST1: pop af ;

1809

and 12 ; test if single/double

1810

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

1811

ld (BASIC_VALTYP), a ;

1812

call COPY_TO.DAC_TMP ;

1813

call COPY_TO.ARG_DAC ;

1814

__call_bios MATH_FRCDBL ; convert ARG to double

1815

call COPY_TO.DAC_ARG ;

1816

call COPY_TO.TMP_DAC ;

1817

MATH.PARM.CST2: ld a, 8 ;

1818

ld (BASIC_VALTYP), a ;

1819

ret ;

1820

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

1821

pop af ; get PC from caller stack

1822

ex af, af' ; save PC to temp

1823

pop.parm ; get first parameter

1824

ld a, (hl) ; get parameter type

1825

and 2 ; test if integer

1826

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

1827

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

1828

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

1829

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

1830

__call_bios MATH_FRCINT ; convert DAC to int

1831

call COPY_TO.DAC_ARG ; copy DAC to ARG

1832

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

1833

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

1834

and 2 ; test if integer

1835

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

1836

__call_bios MATH_FRCINT ; convert DAC to int

1837

ld a, 2 ;

1838

ld (BASIC_VALTYP), a ;

1839

MATH.PARM.POP.I3:

1840

ex af, af' ; restore PC from temp

1841

push af ; put again PC from caller in stack

1842

ret ;

1843

MATH.PARM.PUSH: call COPY_TO.VAR_DUMMY ;

1844

ret.parm ;

1845

1846

if defined MATH.ADD

1847

1848

; input DAC, ARG

1849

; output in parm stack

1850

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

1851

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

1852

ld bc, (BASIC_ARG+2) ;

1853

add hl, bc ;

1854

ld (BASIC_DAC+2), hl ;

1855

jp MATH.PARM.PUSH ;

1856

1857

endif

1858

1859

if defined MATH.SUB or defined MATH.NEG

1860

1861

; input DAC, ARG

1862

; output in parm stack

1863

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

1864

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

1865

ld de, (BASIC_ARG+2) ;

1866

and a ; clear carry

1867

sbc hl, de ;

1868

ld (BASIC_DAC+2), hl ;

1869

jp MATH.PARM.PUSH ;

1870

1871

endif

1872

1873

if defined MATH.MULT

1874

1875

; input DAC, ARG

1876

; output in parm stack

1877

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

1878

ld bc, (BASIC_ARG+2) ;

1879

call MATH.MULT.16 ;

1880

ld (BASIC_DAC+2), hl ;

1881

jp MATH.PARM.PUSH ;

1882

1883

; input HL = multiplicand

1884

; input BC = multiplier

1885

; output HL = result

1886

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

1887

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

1888

ld c, b ; high multiplier

1889

ld b, 16

1890

ld d, h ; multiplicand

1891

ld e, l

1892

ld hl, 0

1893

MULT16LOOP: srl c ; right shift multiplier high

1894

rra ; rotate right multiplier low

1895

jr nc, MULT16NOADD ; test carry

1896

add hl, de ; add multiplicand to result

1897

MULT16NOADD: ex de, hl

1898

add hl, hl ; double - shift multiplicand

1899

ex de, hl

1900

djnz MULT16LOOP

1901

ret

1902

1903

endif

1904

1905

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

1906

1907

; input AC = dividend

1908

; input DE = divisor

1909

; output AC = quotient

1910

; output HL = remainder

1911

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

1912

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

1913

ld b, 16 ; set counter

1914

DIV16LOOP: rl c ; rotate accumulator result left

1915

rla

1916

adc hl, hl ; left shift

1917

sbc hl, de ; trial subtract divisor

1918

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

1919

add hl, de ; restore accumulator

1920

ccf ; calculate result bit

1921

djnz DIV16LOOP ; counter not zero

1922

rl c ; shift in last result bit

1923

rla

1924

ret

1925

1926

endif

1927

1928

if defined GFX_FAST or defined LINE

1929

1930

; compare two signed 16 bits integers

1931

; HL < DE: Carry flag

1932

; HL = DE: Zero flag

1933

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

1934

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

1935

and 0x80 ; test sign, clear carry

1936

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

1937

bit 7, d

1938

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

1939

ld a, h

1940

cp d ; signs are both positive, so normal compare

1941

ret nz

1942

ld a, l ; test low order byte

1943

cp e

1944

ret

1945

MATH.COMP.S16.NEGM1:

1946

xor d

1947

rla ; sign bit into carry

1948

ret c ; signs different

1949

ld a, h

1950

cp d ; both signs negative

1951

ret nz

1952

ld a, l

1953

cp e

1954

ret

1955

1956

endif

1957

1958

if defined MATH.ADD

1959

1960

MATH.ADD.SGL: ld a, 8 ;

1961

ld (BASIC_VALTYP), a ;

1962

MATH.ADD.DBL: __call_bios MATH_DECADD ;

1963

jp MATH.PARM.PUSH ;

1964

1965

endif

1966

1967

if defined MATH.SUB or defined MATH.NEG

1968

1969

MATH.SUB.SGL: ld a, 8 ;

1970

ld (BASIC_VALTYP), a ;

1971

MATH.SUB.DBL: __call_bios MATH_DECSUB ;

1972

jp MATH.PARM.PUSH ;

1973

1974

endif

1975

1976

if defined MATH.MULT

1977

1978

MATH.MULT.SGL: ld a, 8 ;

1979

ld (BASIC_VALTYP), a ;

1980

MATH.MULT.DBL: __call_bios MATH_DECMUL ;

1981

jp MATH.PARM.PUSH ;

1982

1983

endif

1984

1985

if defined MATH.DIV

1986

1987

; input DAC, ARG

1988

; output in parm stack

1989

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

1990

call SWAP.DAC.ARG ;

1991

ld a, 2 ;

1992

ld (BASIC_VALTYP), a ;

1993

__call_bios MATH_FRCDBL ; convert ARG to double

1994

call SWAP.DAC.ARG ;

1995

MATH.DIV.SGL: ld a, 8 ;

1996

ld (BASIC_VALTYP), a ;

1997

MATH.DIV.DBL: __call_bios MATH_DECDIV ;

1998

jp MATH.PARM.PUSH ;

1999

2000

endif

2001

2002

if defined MATH.IDIV

2003

2004

; input DAC, ARG

2005

; output in parm stack

2006

MATH.IDIV.SGL: ld a, 8 ;

2007

ld (BASIC_VALTYP), a ;

2008

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

2009

call SWAP.DAC.ARG ;

2010

ld a, 8 ;

2011

ld (BASIC_VALTYP), a ;

2012

__call_bios MATH_FRCINT ; convert ARG to integer

2013

call SWAP.DAC.ARG ;

2014

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

2015

ld a, h ;

2016

ld c, l ;

2017

ld de, (BASIC_ARG+2) ;

2018

call MATH.DIV.16 ;

2019

ld h, a ;

2020

ld l, c ;

2021

ld (BASIC_DAC+2), hl ; quotient

2022

jp MATH.PARM.PUSH ;

2023

2024

endif

2025

2026

if defined MATH.POW

2027

2028

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

2029

__call_bios MATH_FRCDBL ; convert DAC to double

2030

call SWAP.DAC.ARG ;

2031

ld a, 2 ;

2032

ld (BASIC_VALTYP), a ;

2033

__call_bios MATH_FRCDBL ; convert ARG to double

2034

call SWAP.DAC.ARG ;

2035

MATH.POW.SGL: ld a, 8 ;

2036

ld (BASIC_VALTYP), a ;

2037

MATH.POW.DBL: __call_bios MATH_DBLEXP ;

2038

jp MATH.PARM.PUSH ;

2039

2040

endif

2041

2042

if defined MATH.MOD

2043

2044

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

2045

; ld (BASIC_VALTYP), a ;

2046

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

2047

; call SWAP.DAC.ARG ;

2048

; ld a, 8 ;

2049

; ld (BASIC_VALTYP), a ;

2050

; __call_bios MATH_FRCINT ; convert ARG to integer

2051

; call SWAP.DAC.ARG ;

2052

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

2053

ld a, h ;

2054

ld c, l ;

2055

ld de, (BASIC_ARG+2) ;

2056

call MATH.DIV.16 ;

2057

ld (BASIC_DAC+2), hl ; remainder

2058

jp MATH.PARM.PUSH ;

2059

2060

endif

2061

2062

if defined ISQR

2063

2064

; fast 16-bit integer square root

2065

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

2066

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

2067

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

2068

; call with hl = number to square root

2069

; returns a = square root

2070

; corrupts hl, de

2071

2072

MATH.INT.SQR:

2073

ld a,h

2074

ld de,0B0C0h

2075

add a,e

2076

jr c,sq7

2077

ld a,h

2078

ld d,0F0h

2079

sq7:

2080

add a,d

2081

jr nc,sq6

2082

res 5,d

2083

db 254

2084

sq6:

2085

sub d

2086

sra d

2087

set 2,d

2088

add a,d

2089

jr nc,sq5

2090

res 3,d

2091

db 254

2092

sq5:

2093

sub d

2094

sra d

2095

inc d

2096

add a,d

2097

jr nc,sq4

2098

res 1,d

2099

db 254

2100

sq4:

2101

sub d

2102

sra d

2103

ld h,a

2104

add hl,de

2105

jr nc,sq3

2106

ld e,040h

2107

db 210

2108

sq3:

2109

sbc hl,de

2110

sra d

2111

ld a,e

2112

rra

2113

or 010h

2114

ld e,a

2115

add hl,de

2116

jr nc,sq2

2117

and 0DFh

2118

db 218

2119

sq2:

2120

sbc hl,de

2121

sra d

2122

rra

2123

or 04h

2124

ld e,a

2125

add hl,de

2126

jr nc,sq1

2127

and 0F7h

2128

db 218

2129

sq1:

2130

sbc hl,de

2131

sra d

2132

rra

2133

inc a

2134

ld e,a

2135

add hl,de

2136

jr nc,sq0

2137

and 0FDh

2138

sq0:

2139

sra d

2140

rra

2141

cpl

2142

ret

2143

2144

endif

2145

2146

if defined RANDOMIZE or defined SEED

2147

2148

MATH.RANDOMIZE: di ;

2149

ld bc, (BIOS_JIFFY) ;

2150

ei ;

2151

2152

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

2153

push bc ; in bc = new integer seed

2154

call CLEAR.DAC ;

2155

pop bc ;

2156

;ld ix, BASIC_DAC ;

2157

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

2158

ld a, 2 ; type integer

2159

ld (BASIC_VALTYP), a ;

2160

__call_bios MATH_FRCDBL ; convert DAC integer to DAC double

2161

__call_bios MATH_NEG ; DAC = -DAC

2162

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

2163

ret ;

2164

2165

endif

2166

2167

MATH.ERROR: ld e, 13 ; type mismatch

2168

__call_basic BASIC_ERROR_HANDLER ;

2169

ret

2170

2171

2172

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

2173

; BOOLEAN ROUTINES

2174

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

2175

2176

BOOLEAN.RET.TRUE: ld hl, LIT_TRUE ;

2177

ret.parm ;

2178

BOOLEAN.RET.FALSE: ld hl, LIT_FALSE ;

2179

ret.parm ;

2180

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

2181

ld de, (BASIC_ARG+2) ;

2182

__call_bios MATH_ICOMP ;

2183

ret ;

2184

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

2185

ld de, (BASIC_ARG+2) ;

2186

__call_bios MATH_DCOMP ;

2187

ret ;

2188

BOOLEAN.CMP.DBL: __call_bios MATH_XDCOMP ;

2189

ret ;

2190

BOOLEAN.CMP.STR: call STRING.COMPARE ;

2191

ret ;

2192

2193

if defined BOOLEAN.GT

2194

2195

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

2196

jr BOOLEAN.GT.RET ;

2197

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

2198

jr BOOLEAN.GT.RET ;

2199

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

2200

jr BOOLEAN.GT.RET ;

2201

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

2202

jr BOOLEAN.GT.RET ;

2203

BOOLEAN.GT.RET: cp 0x01 ;

2204

jp z, BOOLEAN.RET.TRUE ;

2205

jp BOOLEAN.RET.FALSE ;

2206

endif

2207

2208

if defined BOOLEAN.LT

2209

2210

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

2211

jr BOOLEAN.LT.RET ;

2212

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

2213

jr BOOLEAN.LT.RET ;

2214

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

2215

jr BOOLEAN.LT.RET ;

2216

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

2217

jr BOOLEAN.LT.RET ;

2218

BOOLEAN.LT.RET: cp 0xFF ;

2219

jp z, BOOLEAN.RET.TRUE ;

2220

jp BOOLEAN.RET.FALSE ;

2221

2222

endif

2223

2224

if defined BOOLEAN.GE

2225

2226

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

2227

jr BOOLEAN.GE.RET ;

2228

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

2229

jr BOOLEAN.GE.RET ;

2230

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

2231

jr BOOLEAN.GE.RET ;

2232

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

2233

jr BOOLEAN.GE.RET ;

2234

BOOLEAN.GE.RET: cp 0x01 ;

2235

jp z, BOOLEAN.RET.TRUE ;

2236

or a ; cp 0

2237

jp z, BOOLEAN.RET.TRUE ;

2238

jp BOOLEAN.RET.FALSE ;

2239

2240

endif

2241

2242

if defined BOOLEAN.LE

2243

2244

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

2245

jr BOOLEAN.LE.RET ;

2246

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

2247

jr BOOLEAN.LE.RET ;

2248

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

2249

jr BOOLEAN.LE.RET ;

2250

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

2251

jr BOOLEAN.LE.RET ;

2252

BOOLEAN.LE.RET: cp 0xFF ;

2253

jp z, BOOLEAN.RET.TRUE ;

2254

or a ; cp 0

2255

jp z, BOOLEAN.RET.TRUE ;

2256

jp BOOLEAN.RET.FALSE ;

2257

2258

endif

2259

2260

if defined BOOLEAN.NE

2261

2262

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

2263

jr BOOLEAN.NE.RET ;

2264

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

2265

jr BOOLEAN.NE.RET ;

2266

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

2267

jr BOOLEAN.NE.RET ;

2268

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

2269

jr BOOLEAN.NE.RET ;

2270

BOOLEAN.NE.RET: or a ; cp 0

2271

jp nz, BOOLEAN.RET.TRUE ;

2272

jp BOOLEAN.RET.FALSE ;

2273

2274

endif

2275

2276

if defined BOOLEAN.EQ

2277

2278

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

2279

jr BOOLEAN.EQ.RET ;

2280

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

2281

jr BOOLEAN.EQ.RET ;

2282

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

2283

jr BOOLEAN.EQ.RET ;

2284

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

2285

jr BOOLEAN.EQ.RET ;

2286

BOOLEAN.EQ.RET: or a ; cp 0

2287

jp z, BOOLEAN.RET.TRUE ;

2288

jp BOOLEAN.RET.FALSE ;

2289

2290

endif

2291

2292

if defined BOOLEAN.AND

2293

2294

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

2295

ld hl, BASIC_ARG+2 ;

2296

and (hl) ;

2297

ld (BASIC_DAC+2), a ;

2298

inc hl ;

2299

ld a, (BASIC_DAC+3) ;

2300

and (hl) ;

2301

ld (BASIC_DAC+3), a ;

2302

ld a, 2 ;

2303

jp MATH.PARM.PUSH ;

2304

2305

endif

2306

2307

if defined BOOLEAN.OR

2308

2309

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

2310

ld hl, BASIC_ARG+2 ;

2311

or (hl) ;

2312

ld (BASIC_DAC+2), a ;

2313

inc hl ;

2314

ld a, (BASIC_DAC+3) ;

2315

or (hl) ;

2316

ld (BASIC_DAC+3), a ;

2317

ld a, 2 ;

2318

jp MATH.PARM.PUSH ;

2319

2320

endif

2321

2322

if defined BOOLEAN.XOR

2323

2324

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

2325

ld hl, BASIC_ARG+2 ;

2326

xor (hl) ;

2327

ld (BASIC_DAC+2), a ;

2328

inc hl ;

2329

ld a, (BASIC_DAC+3) ;

2330

xor (hl) ;

2331

ld (BASIC_DAC+3), a ;

2332

ld a, 2 ;

2333

jp MATH.PARM.PUSH ;

2334

2335

endif

2336

2337

if defined BOOLEAN.EQV

2338

2339

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

2340

ld hl, BASIC_ARG+2 ;

2341

xor (hl) ;

2342

cpl ;

2343

ld (BASIC_DAC+2), a ;

2344

inc hl ;

2345

ld a, (BASIC_DAC+3) ;

2346

xor (hl) ;

2347

cpl ;

2348

ld (BASIC_DAC+3), a ;

2349

ld a, 2 ;

2350

jp MATH.PARM.PUSH ;

2351

2352

endif

2353

2354

if defined BOOLEAN.IMP

2355

2356

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

2357

ld hl, BASIC_ARG+2 ;

2358

cpl ;

2359

or (hl) ;

2360

ld (BASIC_DAC+2), a ;

2361

inc hl ;

2362

ld a, (BASIC_DAC+3) ;

2363

cpl ;

2364

or (hl) ;

2365

ld (BASIC_DAC+3), a ;

2366

ld a, 2 ;

2367

jp MATH.PARM.PUSH ;

2368

2369

endif

2370

2371

if defined BOOLEAN.SHR

2372

2373

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

2374

ld a, (BASIC_ARG+2) ;

2375

or a ; clear carry

2376

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

2377

ld b, a ; shift count

2378

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

2379

rr (ix) ;

2380

or a ; clear carry

2381

djnz BOOLEAN.SHR.INT.N ; next shift

2382

ld a, 2 ;

2383

jp MATH.PARM.PUSH ; return DAC

2384

2385

endif

2386

2387

if defined BOOLEAN.SHL

2388

2389

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

2390

ld a, (BASIC_ARG+2) ;

2391

or a ; clear carry

2392

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

2393

ld b, a ; shift count

2394

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

2395

rl (ix+1) ;

2396

or a ; clear carry

2397

djnz BOOLEAN.SHL.INT.N ; next shift

2398

ld a, 2 ;

2399

jp MATH.PARM.PUSH ; return DAC

2400

2401

endif

2402

2403

if defined BOOLEAN.NOT

2404

2405

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

2406

cpl ;

2407

ld (BASIC_DAC+2), a ;

2408

ld a, (BASIC_DAC+3) ;

2409

cpl ;

2410

ld (BASIC_DAC+3), a ;

2411

ld a, 2 ;

2412

jp MATH.PARM.PUSH ;

2413

2414

endif

2415

2416

2417

2418

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

2419

; MEMORY ALLOCATION ROUTINES

2420

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

2421

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

2422

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

2423

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

2424

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

2425

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

2426

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

2427

block.next: equ 0 ; next free block address

2428

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

2429

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

2430

2431

;; init

2432

memory.init:

2433

ld ix,memory.heap_start ; first block

2434

ld hl,memory.heap_start+block ; second block

2435

;; first block NEXT=secondblock, SIZE=0

2436

;; with this block we have a fixed start location

2437

;; because never will be allocated

2438

ld (ix+block.next),l

2439

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

2440

ld (ix+block.size),0

2441

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

2442

;; second block NEXT=0, SIZE=all

2443

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

2444

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

2445

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

2446

xor a

2447

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

2448

ld (BIOS_TEMP), sp

2449

ld hl, (BIOS_TEMP)

2450

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

2451

sbc hl,de

2452

;ld de, block * 2 + 100

2453

;sbc hl, de

2454

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

2455

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

2456

ret

2457

2458

;; alloc

2459

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

2460

memory.alloc:

2461

ld hl,block

2462

add hl,bc

2463

;push hl

2464

;pop bc

2465

ld b, h

2466

ld c, l

2467

ld ix,memory.heap_start ; this

2468

ld iy,0 ; prev

2469

memory.alloc.find:

2470

ld l,(ix+block.size)

2471

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

2472

xor a

2473

sbc hl,bc

2474

jp z, memory.alloc.exactfit

2475

jp c, memory.alloc.nextblock

2476

;; split found block

2477

memory.alloc.splitfit:

2478

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

2479

or h

2480

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

2481

ld a, l

2482

cp 4

2483

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

2484

memory.alloc.splitfit.do:

2485

;; newfreeblock = this + BC

2486

push ix

2487

pop hl

2488

add hl,bc

2489

;; prevblock->next = newfreeblock

2490

ld (iy+block.next),l

2491

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

2492

;; newfreeblock->next = this->next

2493

push hl

2494

pop iy ; iy = newfreeblock

2495

ld l,(ix+block.next)

2496

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

2497

ld (iy+block.next),l

2498

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

2499

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

2500

ld l,(ix+block.size)

2501

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

2502

xor a

2503

sbc hl,bc

2504

ld (iy+block.size),l

2505

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

2506

;; this->size = BC

2507

ld (ix+block.size),c

2508

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

2509

jr memory.alloc.ok

2510

;; use whole found block

2511

memory.alloc.exactfit:

2512

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

2513

ld l,(ix+block.next)

2514

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

2515

ld (iy+block.next),l

2516

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

2517

memory.alloc.ok:

2518

;; ix = first byte

2519

ld de,block

2520

add ix,de

2521

;; enable z-flag

2522

ld a,1

2523

or a

2524

ret

2525

memory.alloc.nextblock:

2526

ld l,(ix+block.next)

2527

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

2528

ld a,l

2529

cp h

2530

ret z

2531

;; prevblock = this

2532

push ix

2533

pop iy

2534

;; this = this->next

2535

push hl

2536

pop ix

2537

jp memory.alloc.find

2538

2539

;; free

2540

;; IN IX=memptr

2541

memory.free:

2542

;; HL = IX - block_header_size

2543

push ix

2544

pop hl

2545

ld de, block

2546

xor a

2547

sbc hl,de

2548

;; start of search

2549

ld ix,memory.heap_start

2550

memory.free.find:

2551

ld e,(ix+block.next)

2552

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

2553

ld a,d

2554

or e

2555

jp z, memory.free.passedend

2556

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

2557

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

2558

add hl,de ; restore hl value

2559

push de

2560

pop ix ; current = next

2561

jr memory.free.find

2562

2563

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

2564

memory.free.found:

2565

add hl,de ; restore hl value

2566

ld (ix+block.next), l

2567

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

2568

push hl

2569

pop iy

2570

ld (iy+block.next), e

2571

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

2572

push ix ; prev x this

2573

pop iy

2574

push hl

2575

pop ix

2576

push de

2577

call memory.free.coalesce

2578

pop ix ; this x next

2579

jr memory.free.coalesce

2580

2581

;; parm1 = *next

2582

;; parm2 = *this

2583

memory.free.coalesce:

2584

ld c, (iy+block.size)

2585

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

2586

push iy

2587

pop hl

2588

xor a

2589

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

2590

push ix

2591

pop de

2592

xor a

2593

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

2594

jr z, memory.free.coalesce.do

2595

push ix ; else, new *this = *next

2596

pop iy

2597

ret

2598

memory.free.coalesce.do:

2599

ld l, (ix+block.size)

2600

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

2601

xor a

2602

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

2603

ld (iy+block.size), l

2604

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

2605

ld l, (ix+block.next)

2606

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

2607

ld (iy+block.next), l

2608

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

2609

ret

2610

2611

memory.free.passedend:

2612

;; append block at the end of the free list

2613

ld (ix+block.next),l

2614

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

2615

push hl

2616

pop iy

2617

ld (iy+block.next),0

2618

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

2619

ret

2620

2621

;; get_free

2622

;; OUT BC=freespace

2623

memory.get_free:

2624

ld ix,memory.heap_start

2625

ld bc,0

2626

memory.get_free.count:

2627

ld a,c

2628

add a,(ix+block.size)

2629

ld c,a

2630

ld a,b

2631

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

2632

ld b,a

2633

ld l,(ix+block.next)

2634

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

2635

ld a,h

2636

or l

2637

ret z

2638

push hl

2639

pop ix

2640

jr memory.get_free.count

2641

2642

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

2643

__call_basic BASIC_ERROR_HANDLER ;

2644

ret

2645

2646

2647

2648

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

2649

; GRAPHICS LIBRARY

2650

; By: Amaury Carvalho, 2019

2651

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

2652

; References:

2653

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

2654

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

2655

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

2656

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

2657

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

2658

2659

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

2660

; Bios functions

2661

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

2662

2663

BIOS_WRTVDP: EQU 0x0047

2664

BIOS_RDVRM: EQU 0x004A

2665

BIOS_WRTVRM: EQU 0x004D

2666

BIOS_LDIRVM: EQU 0x005C

2667

BIOS_LDIRMV: EQU 0x0059

2668

BIOS_PNTINI: EQU 0x18CF

2669

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

2670

BIOS_TRIGHTC: EQU 0x16AC ; Test then RIGHTC if legal

2671

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

2672

BIOS_TLEFTC: EQU 0x16D8 ; Test then LEFTC if legal

2673

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

2674

BIOS_TUPC: EQU 0x173C ; Test then UPC if legal

2675

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

2676

BIOS_TDOWNC: EQU 0x170A ; Test then DOWNC if legal

2677

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

2678

BIOS_FILVRM: EQU 0x0056 ; fill VRAM with value

2679

2680

BIOS_BIGFIL: EQU 0x016B ; msx 2

2681

BIOS_NRDVRM: EQU 0x0174 ; msx 2

2682

BIOS_NWRVRM: EQU 0x0177 ; msx 2

2683

BIOS_NRDVDP: EQU 0x013E ; msx 2

2684

BIOS_VDPSTA: EQU 0x0131 ; msx 2

2685

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

2686

2687

BASIC_SUB_LINE: equ 0x58fc

2688

BASIC_SUB_LINEBOX: equ 0x5912

2689

BASIC_SUB_LINEBOXFILLED: equ 0x58C1

2690

BASIC_SUB_CIRCLE: equ 0x5B19

2691

BASIC_SUB_PAINT1: equ 0x59DA ;0x59C8

2692

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

2693

2694

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

2695

; Work areas

2696

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

2697

2698

BIOS_RG0SAV: EQU 0xF3DF

2699

BIOS_RG1SAV: EQU 0xF3E0

2700

BIOS_RG8SAV: EQU 0xFFE7

2701

BIOS_BDRATR: EQU 0xFCB2

2702

BIOS_STATFL: EQU 0xF3E7 ; VDP status register

2703

2704

BIOS_CXOFF: EQU 0xF945

2705

BIOS_CYOFF: EQU 0xF947

2706

BIOS_GXPOS: EQU 0xFCB3

2707

BIOS_GYPOS: EQU 0xFCB5

2708

2709

BIOS_GRPNAM: EQU 0xF3C7 ; pattern name table

2710

BIOS_GRPCOL: EQU 0xF3C9 ; colour table

2711

BIOS_GRPCGP: EQU 0xF3CB ; pattern generator table

2712

BIOS_GRPATR: EQU 0xF3CD ; sprite attribute table

2713

BIOS_GRPPAT: EQU 0xF3CF ; sprite generator table

2714

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

2715

BIOS_ATRBAS: EQU 0xF928 ; sprite attribute table

2716

2717

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

2718

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

2719

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

2720

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

2721

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

2722

2723

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

2724

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

2725

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

2726

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

2727

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

2728

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

2729

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

2730

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

2731

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

2732

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

2733

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

2734

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

2735

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

2736

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

2737

2738

BIOS_PARM1: EQU 0xF6E8 ; 100

2739

BIOS_PARM2: EQU 0xF750 ; 100

2740

2741

GFX_TEMP: EQU BIOS_PARM1 ; 2

2742

GFX_TEMP1: EQU GFX_TEMP + 2 ; 2

2743

GFX_TEMP2: EQU GFX_TEMP1 + 2 ; 2

2744

GFX_TEMP3: EQU GFX_TEMP2 + 2 ; 2

2745

GFX_TEMP4: EQU GFX_TEMP3 + 2 ; 2

2746

GFX_TEMP5: EQU GFX_TEMP4 + 2 ; 2

2747

GFX_TEMP6: EQU GFX_TEMP5 + 2 ; 2

2748

GFX_TEMP7: EQU GFX_TEMP6 + 2 ; 2

2749

GFX_TEMP8: EQU GFX_TEMP7 + 2 ; 2

2750

GFX_TEMP9: EQU GFX_TEMP8 + 2 ; 2

2751

2752

GFX_MAX_X: EQU 0xFCA4 ; 1 (CASSETE LOWLIM)

2753

GFX_MAX_Y: EQU 0xFCA5 ; 1 (CASSETE WINWID)

2754

2755

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

2756

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

2757

GFX_SPRITE_SIZE_DAT: EQU 0xF3FC ; 1 (CASSETE CS1200)

2758

GFX_SPRITE_SIZE_SCR: EQU 0xF3FD ; 1

2759

GFX_SPRITE_WALLS: EQU 0xF406 ; 2 (CASSETE LOW)

2760

GFX_SPRITE_HOTSPOTS: EQU 0xF408 ; 2 (CASSETE HIGH)

2761

GFX_SPRITE_HOTSPOT_TILE: EQU 0xF405 ; 1 (CASSETE CS2400)

2762

GFX_SPRITE_COLLIDER: EQU 0xF400 ; 1 (CASSETE CS1200)

2763

GFX_SPRITE_COLLISION: EQU 0xF7B5 ; 2 (ARYTA2)

2764

2765

GFX_MUSIC_START: EQU 0xF401 ; 2 (CASSETE CS2400)

2766

GFX_MUSIC_NEXT: EQU 0xF403 ; 2

2767

GFX_MUSIC_PREV: EQU 0xF74C ; 2 (PRMPRV)

2768

2769

GFX_TEMP10: EQU 0xF3FE ; 2 (CASSETE CS1200)

2770

2771

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

2772

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

2773

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

2774

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

2775

2776

2777

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

2778

; gfxIsScreenModeMSX2

2779

; return if screen mode is from MSX 2

2780

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

2781

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

2782

2783

gfxIsScreenModeMSX2:

2784

ld a, (BIOS_VERSION)

2785

or 0

2786

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

2787

scf

2788

ret

2789

2790

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

2791

; gfxSetScreenMode

2792

; set current screen mode

2793

; in A = screen number

2794

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

2795

2796

gfxSetScreenMode:

2797

push af

2798

call gfxInitScreenWorkspace

2799

xor a

2800

ld a, (BIOS_VERSION)

2801

or 0

2802

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

2803

pop af

2804

cp 4

2805

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

2806

__call_bios BIOS_CHGMOD ; change the screen mode (msx1)

2807

jr gfxSetScreenMode.2

2808

2809

gfxSetScreenMode.0:

2810

ld a, 2

2811

ret

2812

2813

gfxSetScreenMode.1:

2814

pop af

2815

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

2816

call BIOS_EXTROM

2817

2818

gfxSetScreenMode.2:

2819

call gfxGetScreenHeight

2820

call gfxGetScreenWidth

2821

call gfxGetSpriteSize

2822

jp gfxFillSpriteCollisionTable

2823

2824

gfxInitScreenWorkspace:

2825

ld a, 1

2826

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

2827

xor a

2828

ld (GFX_SPRITE_WALLS), a

2829

ld (GFX_SPRITE_WALLS+1), a

2830

ld (GFX_SPRITE_HOTSPOTS), a

2831

ld (GFX_SPRITE_HOTSPOTS+1), a

2832

ld (GFX_MUSIC_START), a

2833

ld (GFX_MUSIC_START+1), a

2834

ld (GFX_MUSIC_NEXT), a

2835

ld (GFX_MUSIC_NEXT+1), a

2836

ld (GFX_MUSIC_PREV), a

2837

ld (GFX_MUSIC_PREV+1), a

2838

ld (GFX_SPRITE_HOTSPOT_TILE), a

2839

ld (GFX_SPRITE_COLLIDER), a

2840

ret

2841

2842

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

2843

; gfxGetScreenMode

2844

; return current screen mode

2845

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

2846

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

2847

2848

gfxGetScreenMode:

2849

ld a, (BIOS_SCRMOD)

2850

ret

2851

2852

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

2853

; gfxSetXY

2854

; set current screen location

2855

; in BC = x

2856

; DE = y

2857

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

2858

2859

gfxSetXY:

2860

ld (BIOS_GRPACX), bc ; x

2861

;ld (BIOS_GXPOS), bc

2862

ld (BIOS_GRPACY), de ; y

2863

;ld (BIOS_GYPOS), de

2864

jr gfxRefreshXY.1

2865

2866

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

2867

; gfxRefreshXY

2868

; refresh current screen location

2869

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

2870

2871

gfxRefreshXY:

2872

ld bc, (BIOS_GRPACX) ; x

2873

ld de, (BIOS_GRPACY) ; y

2874

gfxRefreshXY.1:

2875

call gfxIsScreenModeMSX2

2876

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

2877

__call_bios BIOS_SCALXY ; BC = X, DE = Y

2878

__call_bios BIOS_MAPXYC ; in BC = X, DE = Y

2879

ret

2880

gfxRefreshXY.2:

2881

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

2882

call BIOS_EXTROM

2883

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

2884

jp BIOS_EXTROM

2885

2886

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

2887

; gfxGetXY

2888

; get current screen location

2889

; out BC = x

2890

; DE = y

2891

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

2892

2893

gfxGetXY:

2894

ld bc, (BIOS_GRPACX) ; x

2895

ld de, (BIOS_GRPACY) ; y

2896

ret

2897

2898

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

2899

; gfxGetScreenHeight

2900

; get screen height

2901

; out a = screen height

2902

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

2903

2904

gfxGetScreenHeight:

2905

push hl

2906

push de

2907

ld hl, BIOS_SCR_SIZE_Y

2908

ld a, (BIOS_SCRMOD)

2909

ld d, 0

2910

ld e, a

2911

add hl, de

2912

ld a, (hl)

2913

ld (GFX_MAX_Y), a

2914

pop de

2915

pop hl

2916

ret

2917

2918

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

2919

; gfxGetScreenWidth

2920

; get screen width

2921

; out a = screen height

2922

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

2923

2924

gfxGetScreenWidth:

2925

push hl

2926

push de

2927

ld hl, BIOS_SCR_SIZE_X

2928

ld a, (BIOS_SCRMOD)

2929

ld d, 0

2930

ld e, a

2931

add hl, de

2932

ld a, (hl)

2933

ld (GFX_MAX_X), a

2934

pop de

2935

pop hl

2936

ret

2937

2938

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

2939

; gfxGetSpriteSize

2940

; get sprite data size

2941

; out a = sprite data size

2942

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

2943

2944

gfxGetSpriteSize:

2945

push bc

2946

ld bc, 0x0808

2947

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

2948

bit 1, a

2949

jr z, gfxGetSpriteSize.1

2950

ld bc, 0x1010

2951

2952

gfxGetSpriteSize.1:

2953

bit 0, a

2954

jr z, gfxGetSpriteSize.2

2955

sll b

2956

2957

gfxGetSpriteSize.2:

2958

ld (GFX_SPRITE_SIZE_DAT), bc

2959

ld a, c

2960

pop bc

2961

ret

2962

2963

2964

if defined GFX_FAST and defined PAINT

2965

2966

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

2967

; gfxUp

2968

; move screen current location up

2969

; out: carry if off screen

2970

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

2971

2972

gfxUp:

2973

push bc

2974

ld hl, 0

2975

ld de, (BIOS_GRPACY)

2976

or a

2977

sbc hl, de

2978

jr z, gfxUp.1

2979

dec de

2980

ld (BIOS_GRPACY), de

2981

call gfxRefreshXY

2982

scf

2983

ccf

2984

jr gfxUp.2

2985

gfxUp.1:

2986

scf

2987

gfxUp.2:

2988

pop bc

2989

ret

2990

2991

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

2992

; gfxDown

2993

; move screen current location down

2994

; out: carry if off screen

2995

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

2996

2997

gfxDown:

2998

push bc

2999

ld a, (GFX_MAX_Y)

3000

ld l, a

3001

ld h, 0

3002

ld de, (BIOS_GRPACY)

3003

or a

3004

sbc hl, de

3005

jr z, gfxDown.1

3006

inc de

3007

ld (BIOS_GRPACY), de

3008

call gfxRefreshXY

3009

scf

3010

ccf

3011

jr gfxDown.2

3012

gfxDown.1:

3013

scf

3014

gfxDown.2:

3015

pop bc

3016

ret

3017

3018

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

3019

; gfxLeft

3020

; move screen current location left

3021

; out: carry if off screen

3022

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

3023

3024

gfxLeft:

3025

push bc

3026

ld hl, 0

3027

ld de, (BIOS_GRPACX)

3028

or a

3029

sbc hl, de

3030

jr z, gfxLeft.1

3031

dec de

3032

ld (BIOS_GRPACX), de

3033

call gfxRefreshXY

3034

scf

3035

ccf

3036

jr gfxLeft.2

3037

gfxLeft.1:

3038

scf

3039

gfxLeft.2:

3040

pop bc

3041

ret

3042

3043

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

3044

; gfxRight

3045

; move screen current location right

3046

; out: carry if off screen

3047

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

3048

3049

gfxRight:

3050

push bc

3051

ld a, (GFX_MAX_X)

3052

ld l, a

3053

ld h, 0

3054

ld de, (BIOS_GRPACX)

3055

or a

3056

sbc hl, de

3057

jr z, gfxRight.1

3058

inc de

3059

ld (BIOS_GRPACX), de

3060

call gfxRefreshXY

3061

scf

3062

ccf

3063

jr gfxRight.2

3064

gfxRight.1:

3065

scf

3066

gfxRight.2:

3067

pop bc

3068

ret

3069

3070

endif

3071

3072

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

3073

; gfxPushXY

3074

; push current screen location

3075

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

3076

3077

gfxPushXY:

3078

3079

pop ix

3080

ld iy, (BIOS_GRPACX) ; x

3081

push iy

3082

ld iy, (BIOS_GRPACY) ; y

3083

push iy

3084

push ix

3085

3086

ret

3087

3088

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

3089

; gfxPopXY

3090

; pop current screen location

3091

; out BC = x

3092

; DE = y

3093

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

3094

3095

gfxPopXY:

3096

pop ix

3097

pop de ; y

3098

pop bc ; x

3099

push ix

3100

jp gfxSetXY

3101

3102

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

3103

; gfxSetForeColor

3104

; set current foreground color

3105

; A = color

3106

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

3107

3108

gfxSetForeColor:

3109

ld (BIOS_FORCLR), a ; foreground color

3110

ld (BIOS_ATRBYT), a

3111

ret

3112

3113

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

3114

; gfxGetForeColor

3115

; get current foreground color

3116

; out A = color

3117

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

3118

3119

gfxGetForeColor:

3120

ld a, (BIOS_FORCLR) ; foreground color

3121

ret

3122

3123

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

3124

; gfxSetBackColor

3125

; set current background color

3126

; A = color

3127

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

3128

3129

gfxSetBackColor:

3130

ld (BIOS_BAKCLR), a ; foreground color

3131

ret

3132

3133

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

3134

; gfxGetBackColor

3135

; get current background color

3136

; out A = color

3137

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

3138

3139

gfxGetBackColor:

3140

ld a, (BIOS_BAKCLR) ; foreground color

3141

ret

3142

3143

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

3144

; gfxSetBorderColor

3145

; set current border color

3146

; A = color

3147

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

3148

3149

gfxSetBorderColor:

3150

ld (BIOS_BDRCLR), a ; border color

3151

ret

3152

3153

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

3154

; gfxGetBorderColor

3155

; get current border color

3156

; out A = color

3157

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

3158

3159

gfxGetBorderColor:

3160

ld a, (BIOS_BDRCLR) ; border color

3161

ret

3162

3163

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

3164

; gfxSetBorderFill

3165

; set fill border color

3166

; A = color

3167

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

3168

3169

gfxSetBorderFill:

3170

ld (BIOS_BDRATR), a ; border color

3171

ret

3172

3173

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

3174

; gfxGetBorderFill

3175

; get fill border color

3176

; out A = color

3177

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

3178

3179

gfxGetBorderFill:

3180

ld a, (BIOS_BDRATR) ; border color

3181

ret

3182

3183

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

3184

; gfxSetColor

3185

; set current color (foreground, background and border)

3186

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

3187

3188

gfxSetColor:

3189

ld a, (BIOS_SCRMOD)

3190

bit 3, a

3191

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

3192

bit 2, a

3193

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

3194

jp BIOS_CHGCLR ; change VDP colors

3195

; __call_bios BIOS_SETATR ; change the pixel color

3196

;ret

3197

3198

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

3199

; gfxSetPixel

3200

; set pixel in current position to current foreground color

3201

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

3202

3203

gfxSetPixel:

3204

call gfxIsScreenModeMSX2

3205

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

3206

__call_bios BIOS_SETC

3207

ret

3208

gfxSetPixel.1:

3209

ld ix, BIOS_SETC2

3210

jp BIOS_EXTROM

3211

3212

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

3213

; gfxGetPixel

3214

; get pixel color in current position

3215

; out A = pixel color

3216

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

3217

3218

gfxGetPixel:

3219

call gfxIsScreenModeMSX2

3220

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

3221

__call_bios BIOS_READC

3222

ret

3223

gfxGetPixel.1:

3224

ld ix, BIOS_READC2

3225

jp BIOS_EXTROM

3226

3227

if defined LINE

3228

3229

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

3230

; gfxDrawLine

3231

; plot a line from current position to informed destination

3232

; in BC = destination x

3233

; DE = destination y

3234

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

3235

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

3236

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

3237

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

3238

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

3239

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

3240

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

3241

; for(;;){

3242

; setPixel(x0,y0);

3243

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

3244

; e2 = err;

3245

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

3246

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

3247

; }

3248

;}

3249

3250

gfxDrawLine:

3251

if not defined GFX_FAST

3252

ld hl, (BIOS_GRPACX)

3253

ld (BIOS_GXPOS), hl

3254

ld hl, (BIOS_GRPACY)

3255

ld (BIOS_GYPOS), hl

3256

__call_basic BASIC_SUB_LINE

3257

ret

3258

3259

else

3260

3261

ld (GFX_TEMP2), bc ; x

3262

ld (GFX_TEMP3), de ; y

3263

3264

ld hl, (BIOS_GRPACX) ; x0

3265

ld de, (GFX_TEMP2) ; x

3266

;or a

3267

;sbc hl, de

3268

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

3269

call MATH.COMP.S16

3270

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

3271

or a

3272

sbc hl, de

3273

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

3274

ld hl, 0xffff

3275

ld (GFX_TEMP5), hl ; sx = -1

3276

jr gfxLine.2

3277

3278

gfxLine.1:

3279

ld de, (BIOS_GRPACX) ; x0

3280

ld hl, (GFX_TEMP2) ; x

3281

or a

3282

sbc hl, de

3283

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

3284

ld hl, 1

3285

ld (GFX_TEMP5), hl ; sx = 1

3286

3287

gfxLine.2:

3288

ld hl, (BIOS_GRPACY) ; y0

3289

ld de, (GFX_TEMP3) ; y

3290

;or a

3291

;sbc hl, de

3292

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

3293

call MATH.COMP.S16

3294

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

3295

or a

3296

sbc hl, de

3297

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

3298

ld hl, 0xffff

3299

ld (GFX_TEMP7), hl ; sy = -1

3300

jr gfxLine.4

3301

3302

gfxLine.3:

3303

ld de, (BIOS_GRPACY) ; y0

3304

ld hl, (GFX_TEMP3) ; y

3305

or a

3306

sbc hl, de

3307

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

3308

ld hl, 1

3309

ld (GFX_TEMP7), hl ; sy = 1

3310

3311

gfxLine.4:

3312

ld hl, (GFX_TEMP6) ; dy

3313

ld de, 0

3314

call MATH.COMP.S16

3315

jp z, gfxLine.h ; dy = 0?

3316

3317

ld hl, (GFX_TEMP4) ; dx

3318

ld de, 0

3319

call MATH.COMP.S16

3320

jp z, gfxLine.v ; dx = 0?

3321

3322

ld de, (GFX_TEMP4) ; dx

3323

ld hl, (GFX_TEMP6) ; dy

3324

or a

3325

adc hl, de

3326

dec hl

3327

dec hl

3328

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

3329

3330

ld de, (GFX_TEMP4) ; dx

3331

ld hl, (GFX_TEMP6) ; dy

3332

;or a

3333

;sbc hl, de

3334

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

3335

call MATH.COMP.S16

3336

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

3337

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

3338

;ld hl, 0

3339

ld de, (GFX_TEMP6) ; dy

3340

or a

3341

srl d

3342

rr e ; dy / 2

3343

;or a

3344

;sbc hl, de ; -dy

3345

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

3346

jr gfxLine.loop

3347

3348

gfxLine.5:

3349

ld hl, (GFX_TEMP4) ; dx

3350

or a

3351

srl h

3352

rr l

3353

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

3354

3355

gfxLine.loop:

3356

call gfxSetPixel

3357

3358

ld hl, (GFX_TEMP9) ; dxy

3359

ld de, 0

3360

call MATH.COMP.S16

3361

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

3362

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

3363

3364

ret

3365

3366

gfxLine.loop.0:

3367

ld hl, 0

3368

ld de, (GFX_TEMP4) ; dx

3369

or a

3370

sbc hl, de ; -dx

3371

ld de, (GFX_TEMP8) ; e2 = err

3372

push de

3373

;or a

3374

;sbc hl, de

3375

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

3376

call MATH.COMP.S16

3377

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

3378

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

3379

ld hl, (GFX_TEMP8) ; err

3380

ld de, (GFX_TEMP6) ; dy

3381

or a

3382

sbc hl, de

3383

ld (GFX_TEMP8), hl ; err -= dy

3384

3385

ld hl, (GFX_TEMP9) ; dxy

3386

dec hl

3387

ld (GFX_TEMP9), hl ; dxy -= 1

3388

3389

ld hl, (BIOS_GRPACX)

3390

ld de, (GFX_TEMP5)

3391

or a

3392

adc hl, de

3393

ld (BIOS_GRPACX), hl ; x0 += sx

3394

3395

gfxLine.loop.1:

3396

pop hl ; e2

3397

ld de, (GFX_TEMP6) ; dy

3398

;or a

3399

;sbc hl, de

3400

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

3401

call MATH.COMP.S16

3402

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

3403

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

3404

ld hl, (GFX_TEMP8) ; err

3405

ld de, (GFX_TEMP4) ; dx

3406

or a

3407

adc hl, de

3408

ld (GFX_TEMP8), hl ; err += dx

3409

3410

ld hl, (GFX_TEMP9) ; dxy

3411

dec hl

3412

ld (GFX_TEMP9), hl ; dxy -= 1

3413

3414

ld hl, (BIOS_GRPACY)

3415

ld de, (GFX_TEMP7)

3416

or a

3417

adc hl, de

3418

ld (BIOS_GRPACY), hl ; y0 += sy

3419

3420

gfxLine.loop.2:

3421

call gfxRefreshXY

3422

jp gfxLine.loop

3423

3424

gfxLine.h:

3425

ld a, (GFX_TEMP5) ; sx

3426

bit 7, a

3427

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

3428

ld hl, (BIOS_GRPACX)

3429

ld de, (GFX_TEMP4)

3430

or a

3431

sbc hl, de

3432

ld (BIOS_GRPACX), hl

3433

call gfxRefreshXY

3434

3435

gfxLine.h.1:

3436

__call_bios BIOS_FETCHC

3437

ld hl, (GFX_TEMP4) ; dx

3438

inc hl

3439

call gfxDrawHorLine ; HL = pixel count

3440

ret

3441

3442

gfxLine.v:

3443

ld a, (GFX_TEMP7) ; sy

3444

bit 7, a

3445

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

3446

ld hl, (BIOS_GRPACY)

3447

ld de, (GFX_TEMP6)

3448

or a

3449

sbc hl, de

3450

ld (BIOS_GRPACY), hl

3451

call gfxRefreshXY

3452

3453

gfxLine.v.1:

3454

call gfxSetPixel

3455

ld hl, (GFX_TEMP6) ; dy

3456

inc hl

3457

ld (GFX_TEMP3), hl

3458

jp gfxBox.drawVerLine

3459

endif

3460

3461

endif

3462

3463

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

3464

3465

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

3466

; gfxDrawBox

3467

; plot a box from current position to informed destination

3468

; in BC = destination x

3469

; DE = destination y

3470

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

3471

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

3472

3473

gfxDrawBox:

3474

3475

if not defined GFX_FAST

3476

ld hl, (BIOS_GRPACX)

3477

ld (BIOS_GXPOS), hl

3478

ld hl, (BIOS_GRPACY)

3479

ld (BIOS_GYPOS), hl

3480

ld hl, BASIC_SUB_LINEBOX

3481

or 0

3482

jr z, gfxDrawBox.1

3483

call gfxIsScreenModeMSX2

3484

jr nc, gfxDrawBox.2

3485

ld hl, BASIC_SUB_LINEBOXFILLED

3486

3487

gfxDrawBox.1:

3488

push hl

3489

pop ix

3490

jp BIOS_CALBAS ; BIOS_CALSLT

3491

3492

3493

gfxDrawBox.2:

3494

xor a

3495

ld hl, BASIC_BUF

3496

ld (hl), a

3497

ld ix, BIOS_DOBOXF

3498

jp BIOS_EXTROM

3499

3500

else

3501

call gfxAdjustDestXY

3502

or 0

3503

jr nz, gfxBox.filled

3504

3505

gfxBox.notFilled:

3506

call gfxPushXY

3507

call gfxBox.drawHorLine

3508

ld hl, (GFX_TEMP2)

3509

ld de, (BIOS_GRPACX)

3510

or a

3511

adc hl, de

3512

dec hl

3513

ld (BIOS_GRPACX), hl

3514

call gfxRefreshXY

3515

call gfxBox.drawVerLine

3516

call gfxPopXY

3517

call gfxBox.drawVerLine

3518

call gfxBox.drawHorLine

3519

ret

3520

3521

gfxBox.filled:

3522

ld hl, (GFX_TEMP3)

3523

;inc hl

3524

gfxBox.filled.loop:

3525

push hl

3526

ld bc, (BIOS_GRPACX)

3527

push bc

3528

call gfxBox.drawHorLine

3529

pop bc

3530

ld (BIOS_GRPACX), bc

3531

ld bc, (BIOS_GRPACY)

3532

inc bc

3533

ld (BIOS_GRPACY), bc

3534

call gfxRefreshXY

3535

pop hl

3536

ld de, 1

3537

or a

3538

sbc hl, de

3539

jr nz, gfxBox.filled.loop

3540

ret

3541

3542

gfxBox.drawHorLine:

3543

ld hl, (GFX_TEMP2)

3544

;inc hl

3545

call gfxDrawHorLine

3546

ret

3547

3548

gfxBox.drawVerLine:

3549

ld hl, (GFX_TEMP3)

3550

dec hl

3551

gfxBox.drawVerLine.loop:

3552

push hl

3553

call gfxDown

3554

call gfxSetPixel

3555

pop hl

3556

ld de, 1

3557

or a

3558

sbc hl, de

3559

jr nz, gfxBox.drawVerLine.loop

3560

ret

3561

3562

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

3563

; gfxDrawHorLine

3564

; draw a horizontal line

3565

; HL = pixel count

3566

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

3567

3568

gfxDrawHorLine:

3569

ld a, (BIOS_SCRMOD)

3570

cp 5

3571

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

3572

bit 7, h

3573

ret nz ; return if negative

3574

xor a

3575

cp h

3576

jr nz, gfxDrawHorLine.1

3577

cp l

3578

ret z ; return if hl = 0

3579

call gfxPushXY

3580

gfxDrawHorLine.1:

3581

push hl

3582

call gfxSetPixel

3583

call gfxRight

3584

pop hl

3585

ld de, 1

3586

sbc hl, de

3587

jr nz, gfxDrawHorLine.1

3588

call gfxPopXY

3589

ret

3590

gfxDrawHorLine.2:

3591

__call_bios BIOS_NSETCX ; HL = fill count

3592

ret

3593

3594

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

3595

; gfxAdjustDestXY

3596

; invert if dest XY is less than current XY position

3597

; BC = dest x

3598

; DE = dest y

3599

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

3600

3601

gfxAdjustDestXY:

3602

push af

3603

ld (GFX_TEMP2), bc ; x

3604

ld (GFX_TEMP3), de ; y

3605

3606

; verify x againt current position

3607

ld hl, (BIOS_GRPACX)

3608

ld de, (GFX_TEMP2)

3609

and a

3610

sbc hl, de ; dx = x1 - x0

3611

bit 7, h ; result is negative?

3612

jr z, gfxAdjustDestXY.1

3613

add hl, de

3614

ld (BIOS_GRPACX), hl

3615

ex de, hl

3616

or a

3617

sbc hl, de

3618

gfxAdjustDestXY.1:

3619

inc hl

3620

ld (GFX_TEMP2), hl

3621

3622

; verify y againt current position

3623

ld hl, (BIOS_GRPACY)

3624

ld de, (GFX_TEMP3)

3625

and a

3626

sbc hl, de ; dy = y1 - y0

3627

bit 7, h ; result is negative?

3628

jr z, gfxAdjustDestXY.2

3629

add hl, de

3630

ld (BIOS_GRPACY), hl

3631

ex de, hl

3632

or a

3633

sbc hl, de

3634

gfxAdjustDestXY.2:

3635

inc hl

3636

ld (GFX_TEMP3), hl

3637

3638

; refresh new position

3639

call gfxRefreshXY

3640

pop af

3641

ret

3642

endif

3643

3644

endif

3645

3646

if defined CIRCLE

3647

3648

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

3649

; gfxDrawCircle

3650

; plot a circle centered in current position

3651

; BC = tracing end x

3652

; DE = tracing end y

3653

; HL = radius

3654

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

3655

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

3656

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

3657

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

3658

3659

gfxDrawCircle:

3660

3661

if not defined GFX_FAST

3662

bit 7,h

3663

ret nz ; return if negative radius

3664

ld (BIOS_GXPOS), hl ; circle ray

3665

ld de, (BIOS_GXPOS)

3666

ld bc, (BIOS_GRPACY)

3667

ld (BIOS_GYPOS), bc

3668

xor a

3669

;cp h

3670

;jr nz, gfxDrawCircle.1

3671

;cp l

3672

;ret z

3673

gfxDrawCircle.1:

3674

ld hl, BASIC_BUF

3675

ld (hl), a

3676

ld ix, 0xFFFF

3677

__call_basic BASIC_SUB_CIRCLE

3678

ret

3679

else

3680

ld (GFX_TEMP), hl ; radius

3681

ld de, 0

3682

sbc hl, de

3683

ret z ; return if zero radius

3684

bit 7,h

3685

ret nz ; return if negative radius

3686

3687

call gfxGetXY

3688

ld (GFX_TEMP1), bc ; x0

3689

ld (GFX_TEMP2), de ; y0

3690

3691

or 0

3692

jp nz, gfxCircle.filled

3693

3694

gfxCircle.notFilled:

3695

ld hl, 1

3696

ld de, (GFX_TEMP) ; radius

3697

or a

3698

sbc hl, de

3699

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

3700

3701

ld hl, 0

3702

ld (GFX_TEMP4), hl ; ddF_x = 0

3703

3704

ld hl, (GFX_TEMP)

3705

or a

3706

adc hl, hl

3707

ex de, hl

3708

ld hl, 0

3709

or a

3710

sbc hl, de

3711

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

3712

3713

ld hl, 0

3714

ld (GFX_TEMP6), hl ; x = 0

3715

3716

ld hl, (GFX_TEMP)

3717

ld (GFX_TEMP7), hl ; y = radius

3718

3719

; plot(x0, y0 + radius)

3720

ld de, (GFX_TEMP) ; radius

3721

ld hl, (GFX_TEMP2) ; y0

3722

or a

3723

adc hl, de

3724

ex de, hl

3725

ld bc, (GFX_TEMP1) ; x0

3726

call gfxSetXY

3727

call gfxSetPixel

3728

3729

; plot(x0, y0 - radius)

3730

ld de, (GFX_TEMP) ; radius

3731

ld hl, (GFX_TEMP2) ; y0

3732

or a

3733

sbc hl, de

3734

ex de, hl

3735

ld bc, (GFX_TEMP1) ; x0

3736

call gfxSetXY

3737

call gfxSetPixel

3738

3739

; plot(x0 + radius, y0)

3740

ld hl, (GFX_TEMP1) ; x0

3741

ld de, (GFX_TEMP) ; radius

3742

or a

3743

adc hl, de

3744

;push hl

3745

;pop bc

3746

ld b, h

3747

ld c, l

3748

ld de, (GFX_TEMP2) ; y0

3749

call gfxSetXY

3750

call gfxSetPixel

3751

3752

; plot(x0 - radius, y0)

3753

ld hl, (GFX_TEMP1) ; x0

3754

ld de, (GFX_TEMP) ; radius

3755

or a

3756

sbc hl, de

3757

;push hl

3758

;pop bc

3759

ld b, h

3760

ld c, l

3761

ld de, (GFX_TEMP2) ; y0

3762

call gfxSetXY

3763

call gfxSetPixel

3764

jp gfxCircle.notFilled.3

3765

3766

gfxCircle.notFilled.1:

3767

ld hl, (GFX_TEMP3) ; f

3768

bit 7, h

3769

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

3770

3771

ld hl, (GFX_TEMP7) ; y -= 1

3772

dec hl

3773

ld (GFX_TEMP7), hl

3774

3775

ld hl, (GFX_TEMP5) ; ddF_y += 2

3776

inc hl

3777

inc hl

3778

ld (GFX_TEMP5), hl

3779

3780

ld hl, (GFX_TEMP3) ; f

3781

ld de, (GFX_TEMP5) ; ddF_y

3782

or a

3783

adc hl, de

3784

ld (GFX_TEMP3), hl ; f += ddF_y

3785

3786

gfxCircle.notFilled.2:

3787

ld hl, (GFX_TEMP6) ; x

3788

inc hl

3789

ld (GFX_TEMP6), hl ; x++

3790

3791

ld hl, (GFX_TEMP4) ; ddF_x += 2

3792

inc hl

3793

inc hl

3794

ld (GFX_TEMP4), hl

3795

3796

ld hl, (GFX_TEMP3) ; f

3797

ld de, (GFX_TEMP4) ; ddF_x

3798

or a

3799

adc hl, de

3800

inc hl

3801

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

3802

3803

; plot(x0 + x, y0 + y)

3804

ld hl, (GFX_TEMP1) ; x0

3805

ld de, (GFX_TEMP6) ; x

3806

or a

3807

adc hl, de

3808

;push hl

3809

;pop bc

3810

ld b, h

3811

ld c, l

3812

ld hl, (GFX_TEMP2) ; y0

3813

ld de, (GFX_TEMP7) ; y

3814

or a

3815

adc hl, de

3816

ex de, hl

3817

call gfxSetXY

3818

call gfxSetPixel

3819

3820

; plot(x0 - x, y0 + y)

3821

ld hl, (GFX_TEMP1) ; x0

3822

ld de, (GFX_TEMP6) ; x

3823

or a

3824

sbc hl, de

3825

;push hl

3826

;pop bc

3827

ld b, h

3828

ld c, l

3829

ld hl, (GFX_TEMP2) ; y0

3830

ld de, (GFX_TEMP7) ; y

3831

or a

3832

adc hl, de

3833

ex de, hl

3834

call gfxSetXY

3835

call gfxSetPixel

3836

3837

; plot(x0 + x, y0 - y)

3838

ld hl, (GFX_TEMP1) ; x0

3839

ld de, (GFX_TEMP6) ; x

3840

or a

3841

adc hl, de

3842

;push hl

3843

;pop bc

3844

ld b, h

3845

ld c, l

3846

ld hl, (GFX_TEMP2) ; y0

3847

ld de, (GFX_TEMP7) ; y

3848

or a

3849

sbc hl, de

3850

ex de, hl

3851

call gfxSetXY

3852

call gfxSetPixel

3853

3854

; plot(x0 - x, y0 - y)

3855

ld hl, (GFX_TEMP1) ; x0

3856

ld de, (GFX_TEMP6) ; x

3857

or a

3858

sbc hl, de

3859

;push hl

3860

;pop bc

3861

ld b, h

3862

ld c, l

3863

ld hl, (GFX_TEMP2) ; y0

3864

ld de, (GFX_TEMP7) ; y

3865

or a

3866

sbc hl, de

3867

ex de, hl

3868

call gfxSetXY

3869

call gfxSetPixel

3870

3871

; plot(x0 + y, y0 + x)

3872

ld hl, (GFX_TEMP1) ; x0

3873

ld de, (GFX_TEMP7) ; y

3874

or a

3875

adc hl, de

3876

;push hl

3877

;pop bc

3878

ld b, h

3879

ld c, l

3880

ld hl, (GFX_TEMP2) ; y0

3881

ld de, (GFX_TEMP6) ; x

3882

or a

3883

adc hl, de

3884

ex de, hl

3885

call gfxSetXY

3886

call gfxSetPixel

3887

3888

; plot(x0 - y, y0 + x)

3889

ld hl, (GFX_TEMP1) ; x0

3890

ld de, (GFX_TEMP7) ; y

3891

or a

3892

sbc hl, de

3893

;push hl

3894

;pop bc

3895

ld b, h

3896

ld c, l

3897

ld hl, (GFX_TEMP2) ; y0

3898

ld de, (GFX_TEMP6) ; x

3899

or a

3900

adc hl, de

3901

ex de, hl

3902

call gfxSetXY

3903

call gfxSetPixel

3904

3905

; plot(x0 + y, y0 - x)

3906

ld hl, (GFX_TEMP1) ; x0

3907

ld de, (GFX_TEMP7) ; y

3908

or a

3909

adc hl, de

3910

;push hl

3911

;pop bc

3912

ld b, h

3913

ld c, l

3914

ld hl, (GFX_TEMP2) ; y0

3915

ld de, (GFX_TEMP6) ; x

3916

or a

3917

sbc hl, de

3918

ex de, hl

3919

call gfxSetXY

3920

call gfxSetPixel

3921

3922

; plot(x0 - y, y0 - x)

3923

ld hl, (GFX_TEMP1) ; x0

3924

ld de, (GFX_TEMP7) ; y

3925

or a

3926

sbc hl, de

3927

;push hl

3928

;pop bc

3929

ld b, h

3930

ld c, l

3931

ld hl, (GFX_TEMP2) ; y0

3932

ld de, (GFX_TEMP6) ; x

3933

or a

3934

sbc hl, de

3935

ex de, hl

3936

call gfxSetXY

3937

call gfxSetPixel

3938

3939

gfxCircle.notFilled.3:

3940

ld hl, (GFX_TEMP6) ; x

3941

ld de, (GFX_TEMP7) ; y

3942

or a

3943

sbc hl, de

3944

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

3945

ld bc, (GFX_TEMP1) ; x0

3946

ld de, (GFX_TEMP2) ; y0

3947

call gfxSetXY

3948

ret

3949

3950

gfxCircle.filled

3951

call gfxCircle.notFilled

3952

ld hl, (BIOS_BDRATR)

3953

push hl

3954

ld hl, (BIOS_FORCLR)

3955

ld (BIOS_BDRATR), hl

3956

ld a, 1

3957

call gfxBorderFill

3958

pop hl

3959

ld (BIOS_BDRATR), hl

3960

ret

3961

endif

3962

3963

endif

3964

3965

if defined PAINT or (defined CIRCLE and defined GFX_FAST)

3966

3967

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

3968

; gfxBorderFill

3969

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

3970

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

3971

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

3972

3973

gfxBorderFill:

3974

3975

if not defined GFX_FAST

3976

3977

ld bc, (BIOS_GRPACX)

3978

ld (BIOS_GXPOS), bc

3979

ld de, (BIOS_GRPACY)

3980

ld (BIOS_GYPOS), de

3981

push bc

3982

push de

3983

3984

xor a

3985

ld hl, BASIC_BUF

3986

ld (hl), a

3987

3988

ld a, (BIOS_BDRATR)

3989

xor b

3990

ld e, a

3991

ld a, (BIOS_ATRBYT)

3992

xor d

3993

ld c, a

3994

;ld ix, 0xFFFF

3995

;ld iy, 0xFFFF

3996

3997

call gfxIsScreenModeMSX2

3998

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

3999

ld a, (BIOS_BDRATR)

4000

ld (BIOS_ATRBYT), a

4001

ld e, a

4002

__call_basic BASIC_SUB_PAINT1

4003

ret

4004

4005

gfxBorderFill.1:

4006

__call_basic BASIC_SUB_PAINT1

4007

ret

4008

;ld ix, BASIC_SUB_PAINT2

4009

;jp BIOS_EXTROM

4010

4011

else

4012

4013

ld (GFX_TEMP1), a

4014

ld hl, (BIOS_GRPACY)

4015

push hl

4016

call gfxBorderFill.down

4017

pop hl

4018

push hl

4019

ld (BIOS_GRPACY), hl

4020

call gfxRefreshXY

4021

call gfxBorderFill.up

4022

pop hl

4023

ld (BIOS_GRPACY), hl

4024

call gfxRefreshXY

4025

ret

4026

4027

gfxBorderFill.down:

4028

call gfxBorderFill.line

4029

call gfxDown

4030

ret c

4031

call gfxGetPixel

4032

ld hl, BIOS_BDRATR

4033

cp (hl)

4034

jr nz, gfxBorderFill.down

4035

ret

4036

4037

gfxBorderFill.up:

4038

call gfxBorderFill.line

4039

call gfxUp

4040

ret c

4041

call gfxGetPixel

4042

ld hl, BIOS_BDRATR

4043

cp (hl)

4044

jr nz, gfxBorderFill.up

4045

ret

4046

4047

gfxBorderFill.line:

4048

ld de, (BIOS_GRPACX)

4049

push de

4050

ld b, 1 ; fill flag

4051

ld de, 1 ; skip count

4052

__call_bios BIOS_SCANR

4053

;inc hl

4054

;ld (GFX_TEMP2), hl ; pixel count transversed

4055

pop de

4056

push de

4057

ld (BIOS_GRPACX), de

4058

call gfxRefreshXY

4059

;ld a, (GFX_TEMP1)

4060

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

4061

;jr z, gfxBorderFill.line.1

4062

;ld hl, (GFX_TEMP2)

4063

;__call_bios BIOS_NSETCX ; HL = fill count

4064

;jr gfxBorderFill.line.2

4065

gfxBorderFill.line.1:

4066

ld b, 1 ; fill flag

4067

ld de, 0 ; skip count

4068

__call_bios BIOS_SCANL

4069

gfxBorderFill.line.2:

4070

pop de

4071

ld (BIOS_GRPACX), de

4072

call gfxRefreshXY

4073

ret

4074

4075

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

4076

; gfxFloadFill

4077

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

4078

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

4079

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

4080

4081

gfxFloadFill:

4082

call gfxGetPixel

4083

ld (GFX_TEMP), a ; replacement-color

4084

call gfxFloadFill.recursive

4085

ret

4086

4087

gfxFloadFill.recursive:

4088

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

4089

ld a, (GFX_TEMP)

4090

ld hl, BIOS_FORCLR

4091

cp (hl)

4092

ret z

4093

4094

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

4095

call gfxGetPixel

4096

ld hl, GFX_TEMP

4097

cp (hl)

4098

ret nz

4099

4100

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

4101

call gfxSetPixel

4102

4103

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

4104

gfxFloadFill.recursive.left:

4105

call gfxLeft

4106

jr c, gfxFloadFill.recursive.right

4107

call gfxFloadFill.recursive

4108

call gfxRight

4109

4110

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

4111

gfxFloadFill.recursive.right:

4112

call gfxRight

4113

jr c, gfxFloadFill.recursive.up

4114

call gfxFloadFill.recursive

4115

call gfxLeft

4116

4117

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

4118

gfxFloadFill.recursive.up:

4119

call gfxUp

4120

jr c, gfxFloadFill.recursive.down

4121

call gfxFloadFill.recursive

4122

call gfxDown

4123

4124

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

4125

gfxFloadFill.recursive.down:

4126

call gfxDown

4127

ret c

4128

call gfxFloadFill.recursive

4129

call gfxUp

4130

ret

4131

4132

endif

4133

4134

endif

4135

4136

if defined SPRITEMODE

4137

4138

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

4139

; gfxSetSpriteMode

4140

; set current sprite mode

4141

; A = sprite mode

4142

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

4143

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

4144

; 2: Spritesize is 16 by 16 pixels

4145

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

4146

; RG1SAV bit 0 = magnify sprite (double size)

4147

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

4148

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

4149

4150

gfxSetSpriteMode:

4151

and 3 ; keeps only bits 0 and 1 from A

4152

ld b, a

4153

4154

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

4155

and 0xFC ; clear bits 0 and 1 from A

4156

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

4157

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

4158

ld b, a ; value to write

4159

ld c, 1 ; register number to write

4160

call gfxWRTVDP ; write register to VDP

4161

call gfxCLRSPR ; clear sprites

4162

4163

call gfxGetSpriteSize

4164

jp gfxFillSpriteCollisionTable

4165

4166

endif

4167

4168

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

4169

4170

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

4171

; gfxSetSpriteColorInt

4172

; A = sprite number

4173

; BC = color number

4174

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

4175

4176

gfxSetSpriteColorInt:

4177

ld b, a ; save sprite number

4178

call gfxCALATR ; get sprite attribute table address

4179

inc hl

4180

inc hl

4181

inc hl

4182

ld a, c ; color

4183

;call gfxSetSpriteColor.Adjust

4184

call gfxWRTVRM

4185

4186

ld a, (BIOS_SCRMOD)

4187

cp 3

4188

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

4189

4190

ld a, b ; recover sprite number

4191

call gfxGetSpriteColorTable

4192

4193

ld a, c ; color

4194

;call gfxSetSpriteColor.Adjust

4195

ld b, 16 ; array of 16 bytes

4196

4197

gfxSetSpriteColorInt.1:

4198

push bc

4199

call gfxWRTVRM

4200

pop bc

4201

inc hl

4202

djnz gfxSetSpriteColorInt.1

4203

ret

4204

4205

;gfxSetSpriteColor.Adjust:

4206

; cp 0x0f

4207

; ret z

4208

; ret c

4209

; srl a

4210

; srl a

4211

; srl a

4212

; srl a

4213

; ret

4214

4215

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

4216

; gfxSetSpriteColorStr

4217

; A = sprite number

4218

; DE = address to color byte array

4219

; BC = color byte array size

4220

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

4221

4222

gfxSetSpriteColorStr:

4223

ld b, a ; save sprite number

4224

push bc

4225

push de

4226

call gfxCALATR ; get sprite attribute table

4227

pop de

4228

pop bc

4229

4230

ld a, c ; byte array zero length?

4231

or a

4232

ret z

4233

4234

inc hl

4235

inc hl

4236

inc hl

4237

ld a, (de) ; color

4238

;call gfxSetSpriteColor.Adjust

4239

call gfxWRTVRM

4240

4241

ld a, (BIOS_SCRMOD)

4242

cp 3

4243

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

4244

4245

ld a, b ; recover sprite number

4246

call gfxGetSpriteColorTable

4247

4248

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

4249

ld a, c ; size of color array

4250

push de

4251

pop iy ; save array start

4252

4253

gfxSetSpriteColorStr.1:

4254

push af

4255

ld a, (de)

4256

;call gfxSetSpriteColor.Adjust

4257

call gfxWRTVRM

4258

inc hl

4259

inc de

4260

pop af

4261

dec a

4262

jr nz, gfxSetSpriteColorStr.2

4263

ld a, c ; recover array size

4264

push iy

4265

pop de ; recover array start

4266

4267

gfxSetSpriteColorStr.2:

4268

djnz gfxSetSpriteColorStr.1

4269

ret

4270

4271

4272

4273

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

4274

; gfxGetSpriteColorTable

4275

; A = sprite number

4276

; HL = address to color table

4277

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

4278

4279

gfxGetSpriteColorTable:

4280

push af

4281

push de

4282

ld h, 0

4283

ld l, a ; recover sprite number

4284

add hl, hl

4285

add hl, hl

4286

add hl, hl

4287

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

4288

push hl

4289

xor a

4290

call gfxCALATR ; get sprite attribute table address

4291

pop de

4292

add hl, de

4293

xor a

4294

ld de, 512

4295

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

4296

pop de

4297

pop af

4298

ret

4299

4300

endif

4301

4302

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

4303

4304

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

4305

; gfxSetSpriteXY

4306

; A = sprite number

4307

; BC = XY

4308

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

4309

4310

gfxSetSpriteXY:

4311

push bc

4312

call gfxCALATR ; get sprite attribute table address

4313

pop bc

4314

ld a, c ; y

4315

call gfxWRTVRM

4316

inc hl

4317

ld a, b ; x

4318

call gfxWRTVRM

4319

ret

4320

4321

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

4322

; gfxSpriteStepCheck

4323

; BC = XY

4324

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

4325

4326

gfxSpriteStepCheck:

4327

push hl

4328

push de

4329

push bc

4330

4331

ld de, (GFX_SPRITE_SIZE_DAT)

4332

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

4333

and 7 ; clear touched and collided flags

4334

ld (GFX_SPRITE_FLAGS), a

4335

4336

bit 0, a

4337

jr z, gfxSpriteStepCheck.corners

4338

4339

gfxSpriteStepCheck.limits:

4340

ld a, (GFX_MAX_X)

4341

sub e ; sprite size

4342

cp b ; jump if x > max_x?

4343

jr c, gfxSpriteStepCheck.limits.touched

4344

4345

ld a, (GFX_MAX_Y)

4346

sub e ; sprite size

4347

cp c ; jump if y > max_y?

4348

jr c, gfxSpriteStepCheck.limits.touched

4349

4350

jr gfxSpriteStepCheck.corners

4351

4352

gfxSpriteStepCheck.limits.touched:

4353

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

4354

or 8 ; set limit touched flag

4355

ld (GFX_SPRITE_FLAGS), a

4356

4357

gfxSpriteStepCheck.corners:

4358

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

4359

and 2+4 ; check walls or hotspots

4360

jr z, gfxSpriteStepCheck.end

4361

4362

ld (GFX_TEMP10), bc

4363

call gfxSpriteStepCheck.corner

4364

4365

ld a, (GFX_SPRITE_SIZE_DAT)

4366

add a, b

4367

ld b, a

4368

call gfxSpriteStepCheck.corner

4369

4370

ld a, (GFX_SPRITE_SIZE_DAT)

4371

add a, c

4372

ld c, a

4373

call gfxSpriteStepCheck.corner

4374

4375

ld bc, (GFX_TEMP10)

4376

ld a, (GFX_SPRITE_SIZE_DAT)

4377

add a, c

4378

ld c, a

4379

call gfxSpriteStepCheck.corner

4380

4381

gfxSpriteStepCheck.end:

4382

pop bc

4383

pop de

4384

pop hl

4385

ret

4386

4387

gfxSpriteStepCheck.corner:

4388

call gfxGetTileFromXY

4389

ld d, a ; tile to be searched

4390

4391

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

4392

bit 1, a

4393

call nz, gfxSpriteStepCheck.walls

4394

4395

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

4396

bit 2, a

4397

call nz, gfxSpriteStepCheck.hotspots

4398

ret

4399

4400

gfxSpriteStepCheck.walls:

4401

ld hl, (GFX_SPRITE_WALLS)

4402

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

4403

jp gfxSpriteStepCheck.search

4404

4405

gfxSpriteStepCheck.hotspots:

4406

ld hl, (GFX_SPRITE_HOTSPOTS)

4407

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

4408

call gfxSpriteStepCheck.search

4409

4410

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

4411

bit 5, a

4412

ret z

4413

4414

ld a, (GFX_TEMP1)

4415

ld (GFX_SPRITE_HOTSPOT_TILE), a

4416

ret

4417

4418

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

4419

gfxSpriteStepCheck.search:

4420

ld a, h

4421

or l

4422

ret z

4423

4424

ld a, d ; search for this tile

4425

push bc

4426

ld c, (hl)

4427

inc hl

4428

ld b, (hl)

4429

inc hl

4430

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

4431

pop bc

4432

ret nz

4433

4434

gfxSpriteStepCheck.search.found:

4435

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

4436

or e ; set touched flag

4437

ld (GFX_SPRITE_FLAGS), a

4438

ret

4439

4440

; b = x, c = y

4441

gfxGetTileFromXY:

4442

push bc

4443

ld a, c ; y

4444

srl b ; divide by 2

4445

srl b ; divide by 4

4446

srl b ; divide by 8

4447

ld c, b

4448

srl a

4449

srl a

4450

srl a

4451

ld b, a

4452

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

4453

pop bc

4454

ret

4455

4456

endif

4457

4458

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

4459

4460

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

4461

; gfxSetSpritePattern

4462

; A = sprite number

4463

; BC = pattern number

4464

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

4465

4466

gfxSetSpritePattern:

4467

push bc

4468

call gfxCALATR ; get sprite attribute table address

4469

pop bc

4470

inc hl

4471

inc hl

4472

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

4473

bit 1, a

4474

jr z, gfxSetSpritePattern.1

4475

sll c

4476

sll c

4477

gfxSetSpritePattern.1:

4478

ld a, c ; pattern number

4479

call gfxWRTVRM

4480

ret

4481

4482

endif

4483

4484

if defined SPRITE

4485

4486

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

4487

; gfxSetSpriteData

4488

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

4489

; A = sprite number

4490

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

4491

4492

gfxSetSpriteData:

4493

push AF

4494

push HL

4495

call gfxCALPAT ; get sprite pattern data address

4496

ex DE, HL

4497

call gfxGSPSIZ ; return in 'a' sprite default size

4498

pop HL

4499

ld b, 0

4500

cp c

4501

jr z, gfxSetSpriteData.1

4502

jr nc, gfxSetSpriteData.1

4503

ld c, a

4504

gfxSetSpriteData.1:

4505

push bc

4506

ld c, a

4507

xor a

4508

call gfxFILVRM

4509

pop bc

4510

pop AF

4511

call gfxLDIRVM

4512

ret

4513

4514

endif

4515

4516

if defined GFX_SPRITES

4517

4518

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

4519

; gfxInitSprites

4520

; initialises all sprites

4521

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

4522

4523

gfxInitSprites:

4524

call gfxCLRSPR

4525

ret

4526

4527

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

4528

; gfxSetSpriteAttrs

4529

; set sprite default x, y, pattern and color

4530

; A = sprite number

4531

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

4532

4533

gfxSetSpriteAttrs:

4534

push af

4535

call gfxCALATR

4536

ld a, (BIOS_GRPACY) ; y

4537

call gfxWRTVRM

4538

inc hl

4539

ld a, (BIOS_GRPACX) ; x

4540

call gfxWRTVRM

4541

inc hl

4542

pop af ; pattern

4543

call gfxWRTVRM

4544

inc hl

4545

ld a, (BIOS_FORCLR) ; color

4546

call gfxWRTVRM

4547

ret

4548

4549

endif

4550

4551

if defined EXIST_DATA_SET

4552

4553

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

4554

; gfxIsTileMode

4555

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

4556

4557

gfxIsTileMode:

4558

ld a, (BIOS_SCRMOD)

4559

cp 2

4560

ret z

4561

cp 4

4562

ret

4563

4564

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

4565

; gfxClearTileScreen

4566

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

4567

4568

gfxClearTileScreen:

4569

ld a, 0x20 ; space

4570

ld bc, 768

4571

ld hl, (BIOS_GRPNAM)

4572

call gfxFILVRM

4573

4574

ld de, 0x0020

4575

call gfxSetTileDefaultColor

4576

ld de, 0x0120

4577

call gfxSetTileDefaultColor

4578

ld de, 0x0220

4579

jp gfxSetTileDefaultColor

4580

4581

gfxSetTileDefaultColor

4582

call gfxGetTileColorAddr

4583

ex de, hl

4584

call gfxGetTileDefaultColor

4585

ld bc, 8

4586

jp gfxFILVRM

4587

4588

gfxGetTileDefaultColor:

4589

ld a, (BIOS_FORCLR)

4590

sla a

4591

sla a

4592

sla a

4593

sla a

4594

push hl

4595

ld hl, BIOS_BAKCLR

4596

or (hl)

4597

pop hl

4598

ret

4599

4600

; set tile color

4601

; HL = tile color pointer

4602

; BC = tile color size

4603

; DE = tile number

4604

4605

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

4606

; gfxSetTileData

4607

; set tile data

4608

; HL = tile data pointer

4609

; BC = tile data size

4610

; DE = tile number

4611

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

4612

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

4613

4614

gfxSetTileData:

4615

or a

4616

jr nz, gfxSetTileDataFlip

4617

4618

gfxSetTileDataNoFlip:

4619

call gfxGetTileDataAddr

4620

jp gfxLDIRVM

4621

4622

gfxSetTileDataFlip:

4623

call gfxGetTileDataAddr

4624

ex de, hl

4625

gfxSetTileDataFlip.Loop:

4626

ld a, (de)

4627

call gfxReverseA

4628

call gfxWRTVRM

4629

inc de

4630

inc hl

4631

dec bc

4632

ld a, b

4633

cp c

4634

jr nz, gfxSetTileDataFlip.Loop

4635

ret

4636

4637

; in de = tile number

4638

; out de = tile number address

4639

gfxGetTileDataAddr:

4640

push hl

4641

ex de, hl

4642

add hl, hl

4643

add hl, hl

4644

add hl, hl ; tile number * 8

4645

ld de, (BIOS_GRPCGP)

4646

add hl, de

4647

ex de, hl

4648

pop hl

4649

ret

4650

4651

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

4652

; gfxSetTileColor

4653

; set tile color

4654

; HL = tile color pointer

4655

; BC = tile color size

4656

; DE = tile number

4657

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

4658

4659

gfxSetTileColor:

4660

call gfxGetTileColorAddr

4661

jp gfxLDIRVM

4662

4663

; in de = tile number

4664

; out de = tile number address

4665

gfxGetTileColorAddr:

4666

push hl

4667

ex de, hl

4668

add hl, hl

4669

add hl, hl

4670

add hl, hl ; tile number * 8

4671

ld de, (BIOS_GRPCOL)

4672

add hl, de

4673

ex de, hl

4674

pop hl

4675

ret

4676

4677

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

4678

; gfxSetScreenTile

4679

; set screen tile at x,y

4680

; C = x

4681

; B = y

4682

; a = tile number

4683

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

4684

4685

gfxSetScreenTile:

4686

ex af, af'

4687

ld a, 23

4688

cp b

4689

ret c

4690

ld a, 31

4691

cp c

4692

ret c

4693

;push bc

4694

; ld h, 0

4695

; ld l, b ; slow y * 32

4696

; ld bc, 32

4697

; call MATH.MULT.16

4698

;pop bc

4699

ld h, b

4700

sra h

4701

sra h

4702

sra h

4703

ld l, b

4704

sla l

4705

sla l

4706

sla l

4707

sla l

4708

sla l ; fast y * 32

4709

ld d, 0

4710

ld e, c ; x

4711

add hl, de

4712

ld de, (BIOS_GRPNAM)

4713

add hl, de

4714

ex af, af'

4715

jp gfxWRTVRM

4716

4717

endif

4718

4719

if defined gfxGetTileFromXY or defined EXIST_DATA_SET

4720

4721

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

4722

; gfxGetScreenTile

4723

; get screen tile at x,y

4724

; C = x

4725

; B = y

4726

; a = tile number

4727

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

4728

4729

gfxGetScreenTile:

4730

ld a, 23

4731

cp b

4732

ret c

4733

ld a, 31

4734

cp c

4735

ret c

4736

ld h, b

4737

sra h

4738

sra h

4739

sra h

4740

ld l, b

4741

sla l

4742

sla l

4743

sla l

4744

sla l

4745

sla l ; fast y * 32

4746

ld d, 0

4747

ld e, c ; x

4748

add hl, de

4749

ld de, (BIOS_GRPNAM)

4750

add hl, de

4751

jp gfxRDVRM

4752

4753

endif

4754

4755

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

4756

; Sprite collision table routines

4757

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

4758

4759

gfxInitSpriteCollisionTable:

4760

ld bc, 128

4761

call memory.alloc

4762

ld (GFX_SPRITE_COLLISION), ix

4763

ret

4764

4765

; copy sprite attribute table to ram

4766

gfxFillSpriteCollisionTable:

4767

ld hl, (BIOS_ATRBAS) ; source: attribute table

4768

ld de, (GFX_SPRITE_COLLISION) ; dest: ram

4769

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

4770

call gfxLDIRMV

4771

4772

; pre-calculate each sprite width

4773

gfxCalculateSpriteCollisionTable:

4774

ld ix, (GFX_SPRITE_COLLISION) ; start of sprites attributes

4775

ld b, 32 ; sprite count

4776

4777

gfxCalculateSpriteCollisionTable.start:

4778

ld a, (GFX_SPRITE_SIZE_DAT) ; sprite size

4779

ld c, a

4780

ld d, 208 ; Y no-display flag

4781

4782

; test screen mode

4783

ld a, (BIOS_SCRMOD)

4784

cp 3 ; above screen 3?

4785

jr c, gfxCalculateSpriteCollisionTable.next

4786

ld d, 216 ; Y no-display flag

4787

4788

gfxCalculateSpriteCollisionTable.next:

4789

; test IC flag (no collision) in color table

4790

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

4791

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

4792

ld a, (ix) ; y

4793

cp d ; test if sprite will not be displayed

4794

ret z

4795

4796

add a, c

4797

ld (ix+2), a ; y1

4798

ld a, (ix+1) ; x

4799

add a, c

4800

ld (ix+3), a ; x1

4801

4802

inc ix

4803

inc ix

4804

inc ix

4805

inc ix

4806

djnz gfxCalculateSpriteCollisionTable.next

4807

ret

4808

4809

; BC = sprite number to check

4810

gfxUpdateSpriteCollisionTable:

4811

ld (BIOS_TEMP), bc

4812

ld h, b

4813

ld l, c

4814

add hl, hl

4815

add hl, hl

4816

ld b, h

4817

ld c, l

4818

ld hl, (GFX_SPRITE_COLLISION) ; dest: ram

4819

add hl, bc

4820

ex de, hl

4821

ld hl, (BIOS_ATRBAS) ; source: attribute table

4822

add hl, bc

4823

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

4824

push de

4825

call gfxLDIRMV

4826

pop ix

4827

ld b, 1 ; sprite count

4828

push ix

4829

call gfxCalculateSpriteCollisionTable.start

4830

pop iy

4831

4832

ld a, (GFX_SPRITE_FLAGS)

4833

and 0xBF ; clear collision flag

4834

ld (GFX_SPRITE_FLAGS), a

4835

4836

ld a, (BIOS_STATFL) ; verify if collision occurred

4837

bit 5, a

4838

ret z

4839

jr gfxCheckSpriteCollisionTable.start

4840

4841

; BC = sprite number to check

4842

gfxCheckSpriteCollisionTable:

4843

; get target sprite address (iy)

4844

ld (BIOS_TEMP), bc

4845

ld h, b

4846

ld l, c

4847

ld de, (GFX_SPRITE_COLLISION)

4848

add hl, hl ; x4

4849

add hl, hl

4850

add hl, de

4851

push hl

4852

pop iy

4853

4854

gfxCheckSpriteCollisionTable.start:

4855

; start test against others sprites

4856

ld ix, (GFX_SPRITE_COLLISION)

4857

ld bc, 0

4858

ld d, 208 ; Y no-display flag

4859

4860

; test screen mode

4861

ld a, (BIOS_SCRMOD)

4862

cp 3 ; above screen 3?

4863

jr c, gfxCheckSpriteCollisionTable.test

4864

ld d, 216 ; Y no-display flag

4865

4866

gfxCheckSpriteCollisionTable.test:

4867

; skip target sprite

4868

ld a, (BIOS_TEMP)

4869

cp c

4870

jr z, gfxCheckSpriteCollisionTable.next

4871

4872

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

4873

ld a, (ix) ; ny

4874

cp d ; test if sprite will not be displayed

4875

ret z ; return false

4876

4877

cp (iy+2) ; y1

4878

jr nc, gfxCheckSpriteCollisionTable.next

4879

4880

ld a, (ix+1) ; nx

4881

cp (iy+3) ; x1

4882

jr nc, gfxCheckSpriteCollisionTable.next

4883

4884

ld a, (iy+1) ; x

4885

cp (ix+3) ; nx1

4886

jr nc, gfxCheckSpriteCollisionTable.next

4887

4888

ld a, (iy) ; y

4889

cp (ix+2) ; ny1

4890

jr nc, gfxCheckSpriteCollisionTable.next

4891

4892

; if so, save collider sprite

4893

ld a, c

4894

ld (GFX_SPRITE_COLLIDER), a

4895

4896

ld a, (GFX_SPRITE_FLAGS)

4897

or 0x40 ; set collision flag

4898

ld (GFX_SPRITE_FLAGS), a

4899

ret ; return true

4900

4901

; else, next

4902

gfxCheckSpriteCollisionTable.next:

4903

inc c

4904

inc ix

4905

inc ix

4906

inc ix

4907

inc ix

4908

ld a, 32

4909

cp c

4910

ret z ; return false

4911

jr gfxCheckSpriteCollisionTable.test

4912

4913

4914

4915

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

4916

; VDP / VRAM support routines

4917

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

4918

4919

; WRITE TO VDP

4920

; in b = data

4921

; c = register number

4922

; a = register number

4923

gfxWRTVDP:

4924

bit 7, a

4925

ret nz ; is negative? read only

4926

cp 8

4927

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

4928

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

4929

jr gfxWRTVDP.3

4930

gfxWRTVDP.1:

4931

ld ix, BIOS_SCRMOD

4932

bit 3, (ix)

4933

jr nz, gfxWRTVDP.2

4934

bit 2, (ix)

4935

jr nz, gfxWRTVDP.2

4936

ret

4937

gfxWRTVDP.2:

4938

dec a

4939

ld c, a

4940

gfxWRTVDP.3:

4941

;ld ix, BIOS_SCRMOD

4942

;bit 3, (ix)

4943

;jp nz, BIOS_NWRVDP ; msx 2

4944

;bit 2, (ix)

4945

;jp nz, BIOS_NWRVDP ; msx 2

4946

jp BIOS_WRTVDP ; msx 1

4947

4948

; READ FROM VDP

4949

; in a = register number

4950

; out a = data

4951

gfxRDVDP:

4952

bit 7, a

4953

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

4954

cp 8

4955

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

4956

cp 9

4957

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

4958

ld hl, BIOS_RG0SAV ; else is correct control registers numbers

4959

jr gfxRDVDP.4

4960

gfxRDVDP.1:

4961

ld ix, BIOS_SCRMOD

4962

bit 3, (ix)

4963

jr nz, gfxRDVDP.1.a

4964

bit 2, (ix)

4965

jr nz, gfxRDVDP.1.a

4966

xor a

4967

ret

4968

gfxRDVDP.1.a:

4969

neg

4970

jp BIOS_NRDVDP ;BIOS_VDPSTA

4971

gfxRDVDP.2:

4972

ld a, (BIOS_STATFL)

4973

ret

4974

;xor a

4975

;jp BIOS_VDPSTA

4976

gfxRDVDP.3:

4977

ld hl, BIOS_RG8SAV-9

4978

gfxRDVDP.4:

4979

ld d, 0

4980

ld e, a

4981

add hl,de

4982

ld a, (hl)

4983

ret

4984

4985

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

4986

gfxFILVRM:

4987

ld ix, BIOS_SCRMOD

4988

bit 3, (ix)

4989

jp nz, BIOS_BIGFIL

4990

bit 2, (ix)

4991

jp nz, BIOS_BIGFIL

4992

jp BIOS_FILVRM

4993

4994

; in: A=Sprite pattern number

4995

; out: HL=Sprite pattern address

4996

gfxCALPAT:

4997

ld iy, BIOS_SCRMOD

4998

ld ix, BIOS_CALPAT2

4999

bit 3, (iy)

5000

jp nz, BIOS_EXTROM

5001

bit 2, (iy)

5002

jp nz, BIOS_EXTROM

5003

jp BIOS_CALPAT

5004

5005

; in: A=Sprite number

5006

; out: HL=Sprite attribute address

5007

gfxCALATR:

5008

ld iy, BIOS_SCRMOD

5009

ld ix, BIOS_CALATR2

5010

bit 3, (iy)

5011

jp nz, BIOS_EXTROM

5012

bit 2, (iy)

5013

jp nz, BIOS_EXTROM

5014

jp BIOS_CALATR

5015

5016

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

5017

gfxGSPSIZ:

5018

ld iy, BIOS_SCRMOD

5019

ld ix, BIOS_GSPSIZ2

5020

bit 3, (iy)

5021

jp nz, BIOS_EXTROM

5022

bit 2, (iy)

5023

jp nz, BIOS_EXTROM

5024

jp BIOS_GSPSIZ

5025

5026

gfxCLRSPR:

5027

ld iy, BIOS_SCRMOD

5028

ld ix, BIOS_CLRSPR2

5029

bit 3, (iy)

5030

jp nz, BIOS_EXTROM

5031

bit 2, (iy)

5032

jp nz, BIOS_EXTROM

5033

jp BIOS_CLRSPR

5034

5035

; RAM to VRAM

5036

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

5037

gfxLDIRVM:

5038

jp BIOS_LDIRVM

5039

5040

; VRAM to RAM

5041

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

5042

gfxLDIRMV:

5043

jp BIOS_LDIRMV

5044

5045

; WRITE TO VRAM

5046

; in hl = address

5047

; a = data

5048

gfxWRTVRM:

5049

ld ix, BIOS_SCRMOD

5050

bit 3, (ix)

5051

jp nz, BIOS_NWRVRM

5052

bit 2, (ix)

5053

jp nz, BIOS_NWRVRM

5054

jp BIOS_WRTVRM

5055

5056

; READ FROM VRAM

5057

; in hl = address

5058

; out a = data

5059

gfxRDVRM:

5060

ld ix, BIOS_SCRMOD

5061

bit 3, (ix)

5062

jp nz, BIOS_NRDVRM

5063

bit 2, (ix)

5064

jp nz, BIOS_NRDVRM

5065

jp BIOS_RDVRM

5066

5067

; reverse bits in A

5068

; 8 bytes / 206 cycles

5069

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

5070

gfxReverseA:

5071

ld b,8

5072

ld l,a

5073

gfxReverseA.loop:

5074

rl l

5075

rra

5076

djnz gfxReverseA.loop

5077

ret

5078

5079

5080

5081

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

5082

; MATH PACK WRAPPER

5083

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

5084

5085

CALL_MATH_LIB: exx

5086

ld hl, RET_MATH_LIB

5087

push hl

5088

ld hl, BASIC_DAC

5089

ld de, BASIC_ARG

5090

ld bc, BASIC_SWPTMP

5091

jp (ix)

5092

RET_MATH_LIB: call COPY_TO.TMP_DAC

5093

exx

5094

ret

5095

5096

if defined MATH.ADD

5097

5098

MATH_DECADD: ld ix, addSingle

5099

jp CALL_MATH_LIB

5100

5101

endif

5102

5103

if defined MATH.SUB or defined MATH.NEG

5104

5105

MATH_DECSUB: ld ix, subSingle

5106

jp CALL_MATH_LIB

5107

5108

endif

5109

5110

if defined MATH.MULT

5111

5112

MATH_DECMUL: ld ix, mulSingle

5113

jp CALL_MATH_LIB

5114

5115

endif

5116

5117

if defined MATH.DIV

5118

5119

MATH_DECDIV: ld ix, divSingle

5120

jp CALL_MATH_LIB

5121

5122

endif

5123

5124

if defined MATH.POW

5125

5126

MATH_DBLEXP:

5127

MATH_SNGEXP: ld ix, powSingle

5128

jp CALL_MATH_LIB

5129

5130

endif

5131

5132

if defined COS

5133

5134

MATH_COS: ld ix, cosSingle

5135

jp CALL_MATH_LIB

5136

5137

endif

5138

5139

if defined SIN

5140

5141

MATH_SIN: ld ix, sinSingle

5142

jp CALL_MATH_LIB

5143

5144

endif

5145

5146

if defined TAN

5147

5148

MATH_TAN: ld ix, tanSingle

5149

jp CALL_MATH_LIB

5150

5151

endif

5152

5153

if defined ATN

5154

5155

MATH_ATN: ld ix, atanSingle

5156

jp CALL_MATH_LIB

5157

5158

endif

5159

5160

if defined SQR

5161

5162

MATH_SQR: ld ix, sqrtSingle

5163

jp CALL_MATH_LIB

5164

5165

endif

5166

5167

if defined LOG

5168

5169

MATH_LOG: ld ix, lnSingle

5170

jp CALL_MATH_LIB

5171

5172

endif

5173

5174

if defined EXP

5175

5176

MATH_EXP: ld ix, expSingle

5177

jp CALL_MATH_LIB

5178

5179

endif

5180

5181

if defined ABS

5182

5183

MATH_ABSFN: ld ix, absSingle

5184

jp CALL_MATH_LIB

5185

5186

endif

5187

5188

if defined MATH.SEED or defined MATH.NEG

5189

5190

MATH_NEG: ld ix, negSingle

5191

jp CALL_MATH_LIB

5192

5193

endif

5194

5195

if defined SGN

5196

5197

MATH_SGN: ld ix, sgnSingle

5198

jp CALL_MATH_LIB

5199

5200

endif

5201

5202

if defined RND or defined MATH.SEED

5203

5204

MATH_RND: ld ix, randSingle

5205

jp CALL_MATH_LIB

5206

5207

endif

5208

5209

MATH_FRCINT: ld hl, BASIC_DAC

5210

ld bc, BASIC_DAC+2

5211

call single2Int

5212

ld ix, BASIC_DAC

5213

ld (ix), 0

5214

ld (ix+1), 0

5215

;ld (ix+2), l

5216

;ld (ix+3), h

5217

ld (ix+4), 0

5218

ld (ix+5), 0

5219

ld (ix+6), 0

5220

ld (ix+7), 0

5221

ld a, 2

5222

ld (BASIC_VALTYP), a

5223

ret

5224

5225

MATH_FRCDBL: ; same as MATH_FRCSGL

5226

MATH_FRCSGL: ld hl, BASIC_DAC+2 ; input address

5227

ld bc, BASIC_DAC ; output address

5228

call int2Single

5229

ld a, 8

5230

ld (BASIC_VALTYP), a

5231

ret

5232

5233

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

5234

cp d

5235

jr nz, MATH_ICOMP.NE.HIGH

5236

ld a, l

5237

cp e

5238

jr nz, MATH_ICOMP.NE.LOW

5239

jr MATH_DCOMP.EQ

5240

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

5241

bit 7, a

5242

jr nz, MATH_DCOMP.GT

5243

jr MATH_DCOMP.LT

5244

MATH_ICOMP.GT.HIGH: bit 7, d

5245

jr z, MATH_DCOMP.GT

5246

jr MATH_DCOMP.LT

5247

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

5248

jr MATH_DCOMP.LT

5249

5250

MATH_XDCOMP: ; same as MATH_DCOMP

5251

MATH_DCOMP: ld ix, cmpSingle

5252

call CALL_MATH_LIB

5253

jr z, MATH_DCOMP.EQ

5254

jr c, MATH_DCOMP.LT

5255

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

5256

ret

5257

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

5258

ret

5259

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

5260

ret

5261

5262

if defined CAST_STR_TO.VAL

5263

5264

MATH_FIN: ; HL has the source string

5265

ld a, (BASIC_VALTYP)

5266

cp 2 ; test if integer

5267

jr nz, MATH_FIN.1

5268

ld hl, (BASIC_DAC+2)

5269

ld de, BASIC_STRBUF

5270

call StrToInt

5271

ld hl, BASIC_STRBUF

5272

ret

5273

MATH_FIN.1: ld BC, BASIC_DAC

5274

call str2single

5275

ret

5276

5277

endif

5278

5279

if defined CAST_INT_TO.STR

5280

5281

MATH_FOUT: ld a, (BASIC_VALTYP)

5282

cp 2 ; test if integer

5283

jr nz, MATH_FOUT.1

5284

ld hl, (BASIC_DAC+2)

5285

ld de, BASIC_STRBUF

5286

call IntToStr

5287

ld hl, BASIC_STRBUF

5288

ret

5289

MATH_FOUT.1: ld hl, BASIC_DAC

5290

ld bc, BASIC_STRBUF

5291

call single2str

5292

ld hl, BASIC_STRBUF

5293

ret

5294

5295

endif

5296

5297

5298

5299

5300

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

5301

; Z80FLOAT LIBRARY

5302

5303

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

5304

; References:

5305

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

5306

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

5307

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

5308

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

5309

; Parameters:

5310

; HL points to the first operand

5311

; DE points to the second operand (if needed)

5312

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

5313

; BC points to where the result should be output

5314

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

5315

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

5316

; exponent biased by +128.

5317

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

5318

; Adapted to MSXBas2Asm by Amaury Carvalho, 2019

5319

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

5320

5321

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

5322

; Work area

5323

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

5324

5325

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

5326

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

5327

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

5328

scrap: equ BASIC_HOLD8

5329

seed0: equ BASIC_RNDX

5330

seed1: equ seed0 + 4

5331

var48: equ scrap + 4

5332

quot: equ scrap + 1

5333

addend: equ scrap

5334

addend2: equ scrap+7 ;4 bytes

5335

var_x: equ BASIC_HOLD8 + 4 ;4 bytes

5336

var_y: equ var_x + 4 ;4 bytes

5337

var_z: equ var_y + 4 ;4 bytes

5338

var_a: equ var_z + 4 ;4 bytes

5339

var_b: equ var_a + 4 ;4 bytes

5340

var_c: equ var_b + 4 ;4 bytes

5341

temp: equ var_c + 4 ;4 bytes

5342

temp1: equ temp + 4 ;4 bytes

5343

temp2: equ temp1 + 4 ;4 bytes

5344

temp3: equ temp2 + 4 ;4 bytes

5345

5346

pow10exp_single: equ scrap+9

5347

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

5348

5349

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

5350

; addSingle

5351

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

5352

5353

;;Still need to tend to special cases

5354

addSingle:

5355

;;x+y

5356

push af

5357

push hl

5358

push de

5359

push bc

5360

addInject:

5361

inc de

5362

inc de

5363

inc hl

5364

inc hl

5365

ld a,(de)

5366

xor (hl)

5367

push af

5368

inc de

5369

inc hl

5370

ex de,hl

5371

ld a,(de)

5372

sub (hl)

5373

ex de,hl

5374

jr nc,$+5

5375

ex de,hl

5376

neg

5377

cp 24

5378

jp nc,add_unneeded

5379

push hl

5380

ld hl,addend+6

5381

dec de

5382

ld bc,0408h

5383

dec hl

5384

ld (hl),0

5385

sub c

5386

jr nc,$-5

5387

add a,c

5388

push af

5389

push hl

5390

ex de,hl

5391

ld a,(hl)

5392

or 80h

5393

ld (de),a

5394

dec de

5395

dec hl

5396

ldd

5397

ldd

5398

ex de,hl

5399

dec b

5400

jr z,$+7

5401

ld (hl),0

5402

dec hl

5403

djnz $-3

5404

pop hl

5405

pop af

5406

ld b,a

5407

jr z,noshift

5408

set 7,(hl)

5409

_1:

5410

push hl

5411

srl (hl)

5412

dec hl

5413

rr (hl)

5414

dec hl

5415

rr (hl)

5416

dec hl

5417

rr (hl)

5418

pop hl

5419

djnz _1

5420

noshift:

5421

pop hl ;bigger float

5422

dec hl

5423

ld b,(hl)

5424

dec hl

5425

dec hl

5426

ex de,hl

5427

pop af

5428

jp m,subtract

5429

ld hl,addend+2

5430

ld a,(hl)

5431

rla

5432

inc hl

5433

ld a,(de)

5434

adc a,(hl)

5435

ld (hl),a

5436

inc hl

5437

inc de

5438

ld a,(de)

5439

adc a,(hl)

5440

ld (hl),a

5441

inc hl

5442

inc de

5443

ld a,(de)

5444

set 7,a

5445

adc a,(hl)

5446

ld (hl),a

5447

inc hl

5448

inc de

5449

ld a,(de)

5450

ld (hl),a

5451

jp nc,add_done

5452

inc (hl)

5453

jp z,add_overflow

5454

dec hl

5455

rr (hl)

5456

dec hl

5457

rr (hl)

5458

dec hl

5459

rr (hl)

5460

jp add_done

5461

subtract:

5462

ld hl,addend

5463

xor a

5464

ld c,a

5465

sub (hl)

5466

ld (hl),a

5467

inc hl

5468

ld a,c

5469

sbc a,(hl)

5470

ld (hl),a

5471

inc hl

5472

ld a,c

5473

sbc a,(hl)

5474

ld (hl),a

5475

inc hl

5476

ld a,(de)

5477

sbc a,(hl)

5478

ld (hl),a

5479

inc hl

5480

inc de

5481

ld a,(de)

5482

sbc a,(hl)

5483

ld (hl),a

5484

inc hl

5485

inc de

5486

ld a,(de)

5487

set 7,a

5488

sbc a,(hl)

5489

ld (hl),a

5490

inc hl

5491

inc de

5492

ld a,(de)

5493

ld (hl),a

5494

dec de

5495

ex de,hl

5496

jr nc,negated

5497

ld hl,addend

5498

ld a,80h

5499

xor b

5500

ld b,a

5501

ld a,c

5502

sub (hl)

5503

ld (hl),a

5504

inc hl

5505

ld a,c

5506

sbc a,(hl)

5507

ld (hl),a

5508

inc hl

5509

ld a,c

5510

sbc a,(hl)

5511

ld (hl),a

5512

inc hl

5513

ld a,c

5514

sbc a,(hl)

5515

ld (hl),a

5516

inc hl

5517

ld a,c

5518

sbc a,(hl)

5519

ld (hl),a

5520

inc hl

5521

ld a,c

5522

sbc a,(hl)

5523

ld (hl),a

5524

negated:

5525

jp m,add_done

5526

push bc

5527

ld hl,(addend)

5528

ld de,(addend+2)

5529

ld bc,(addend+4)

5530

ld a,h

5531

or l

5532

or d

5533

or e

5534

or b

5535

or c

5536

jp z,add_underflow

5537

ld a,(addend+6)

5538

normalize:

5539

dec a

5540

jr z,add_underflow

5541

add hl,hl

5542

rl e

5543

rl d

5544

rl c

5545

rl b

5546

jp p,normalize

5547

ld (addend),hl

5548

ld (addend+2),de

5549

ld (addend+4),bc

5550

ld (addend+6),a

5551

pop bc

5552

add_done:

5553

;;Need to adjust sign flag

5554

ld hl,addend+5

5555

ld a,(hl)

5556

rla

5557

rl b

5558

rra

5559

ld (hl),a

5560

dec hl

5561

dec hl

5562

add_copy:

5563

pop de

5564

push de

5565

ldi

5566

ldi

5567

ldi

5568

ld a,(hl)

5569

ld (de),a

5570

pop bc

5571

pop de

5572

pop hl

5573

pop af

5574

ret

5575

add_underflow:

5576

;;How many push/pops are needed?

5577

;;return ZERO

5578

ld hl,0

5579

ld (addend+3),hl

5580

ld (addend+5),hl

5581

pop bc

5582

jr add_done

5583

add_overflow:

5584

;;How many push/pops are needed?

5585

;;return INF

5586

dec hl

5587

ld (hl),40h

5588

jr add_done

5589

add_unneeded:

5590

;;How many push/pops are needed?

5591

;;Return bigger number

5592

pop af

5593

dec hl

5594

dec hl

5595

dec hl

5596

jr add_copy

5597

5598

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

5599

; subSingle

5600

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

5601

5602

subSingle:

5603

;;x-y

5604

push af

5605

push hl

5606

push de

5607

push bc

5608

push hl

5609

ex de,hl

5610

ld de,addend2

5611

ldi

5612

ldi

5613

ld a,(hl)

5614

xor 80h

5615

ld (de),a

5616

inc de

5617

inc hl

5618

ld a,(hl)

5619

ld (de),a

5620

ex de,hl

5621

pop hl

5622

ld de,addend2

5623

jp addInject ;jumps in to the addSingle routine

5624

5625

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

5626

; mulSingle

5627

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

5628

5629

mulSingle:

5630

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

5631

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

5632

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

5633

;min: 1398cc

5634

;max: 2564cc

5635

;avg: 2055.13839751681cc

5636

push af

5637

push hl

5638

push de

5639

push bc

5640

5641

call _2 ;CHLB

5642

ld a,c

5643

ex de,hl

5644

pop hl

5645

push hl

5646

ld (hl),b

5647

inc hl

5648

ld (hl),e

5649

inc hl

5650

ld (hl),d

5651

inc hl

5652

ld (hl),a

5653

pop bc

5654

pop de

5655

pop hl

5656

pop af

5657

ret

5658

5659

5660

_2:

5661

;;return float in CHLB

5662

push de

5663

ld e,(hl)

5664

inc hl

5665

ld d,(hl)

5666

inc hl

5667

ld c,(hl)

5668

inc hl

5669

ld a,(hl)

5670

or a

5671

jr z,mulSingle_case0

5672

ex de,hl

5673

ex (sp),hl

5674

ld e,(hl)

5675

inc hl

5676

ld d,(hl)

5677

inc hl

5678

ld b,(hl)

5679

inc hl

5680

5681

;inc (hl)

5682

;dec (hl)

5683

;jr z,mulSingle_case1

5684

push af

5685

ld a, (hl)

5686

or a

5687

jp z,mulSingle_case1

5688

pop af

5689

5690

add a,(hl) ;\

5691

pop hl ; |

5692

rra ; |Lots of help from Runer112 and

5693

adc a,a ; |calc84maniac for optimizing

5694

jp po,bad ; |this exponent check.

5695

xor 80h ; |

5696

jr z,underflow ;/

5697

push af ;exponent

5698

ld a,b

5699

xor c

5700

push af ;sign

5701

set 7,b

5702

set 7,c

5703

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

5704

pop de

5705

ld a,e

5706

pop de

5707

jp m,_3

5708

rl c

5709

rl b

5710

adc hl,hl

5711

dec d

5712

_3:

5713

inc d

5714

jr z,overflow

5715

rl c

5716

ld c,d

5717

ld de,0

5718

push af

5719

ld a,b

5720

adc a,e

5721

ld b,a

5722

adc hl,de

5723

jr nc,_4

5724

inc c

5725

jr z,overflow

5726

rr h

5727

rr l

5728

rr b

5729

_4:

5730

pop af

5731

cpl

5732

and $80

5733

xor h

5734

ld h,a

5735

ret

5736

bad:

5737

jr nc,overflow

5738

underflow:

5739

ld hl,0

5740

rl b

5741

rr h

5742

ld c,l

5743

ld b,l

5744

ret

5745

overflow:

5746

ld hl,$8000

5747

jr underflow+3

5748

mulSingle_case1:

5749

;x*0 -> 0

5750

;x*inf -> inf

5751

;x*NaN -> NaN

5752

pop af

5753

pop hl

5754

ld h,b

5755

ld l,d

5756

ld b,e

5757

ld c,0

5758

ret

5759

mulSingle_case0:

5760

;special*x = special

5761

;NaN*x = NaN

5762

;0*0 = 0

5763

;0*NaN = NaN

5764

;0*Inf = NaN

5765

;Inf*Inf = Inf

5766

;Inf*-Inf =-Inf

5767

;0CDE

5768

pop hl

5769

inc hl

5770

inc hl

5771

inc hl

5772

ld a,(hl)

5773

or a

5774

jr z,_5

5775

ld h,c

5776

ld c,0

5777

ret

5778

_5:

5779

dec hl

5780

ld b,(hl)

5781

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

5782

ld a,b

5783

or c

5784

ld h,$20

5785

and h

5786

jr z,_6

5787

ld c,0

5788

ret

5789

_6:

5790

ld a,c

5791

xor b

5792

rl b

5793

rlca

5794

rr b

5795

res 4,b

5796

5797

rl c

5798

rrca

5799

rr c

5800

5801

ld a,c

5802

and $E0

5803

add a,b

5804

rra

5805

ld h,a

5806

ld c,0

5807

ret

5808

mul24:

5809

;;BDE*CHL -> HLBCDE

5810

;;155 bytes

5811

;;402+3*C_Times_BDE

5812

;;fastest:1201cc

5813

;;slowest:1753cc

5814

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

5815

;min: 825cc

5816

;max: 1926cc

5817

;avg: 1449.63839751681cc

5818

5819

push bc

5820

ld c,l

5821

push hl

5822

call C_Times_BDE

5823

ld (var48),hl

5824

ld l,a

5825

ld h,c

5826

ld (var48+2),hl

5827

5828

pop hl

5829

ld c,h

5830

call C_Times_BDE

5831

push bc

5832

ld bc,(var48+1)

5833

add hl,bc

5834

ld (var48+1),hl

5835

pop bc

5836

ld b,c

5837

ld c,a

5838

ld hl,(var48+3)

5839

ld h,0

5840

adc hl,bc

5841

ld (var48+3),hl

5842

5843

pop bc

5844

call C_Times_BDE

5845

ld de,(var48+2)

5846

add hl,de

5847

ld (var48+2),hl

5848

ld d,c

5849

ld e,a

5850

ld b,h

5851

ld c,l

5852

ld hl,(var48+4)

5853

ld h,0

5854

adc hl,de

5855

ld de,(var48)

5856

ret

5857

5858

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

5859

; divSingle

5860

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

5861

5862

divSingle:

5863

;;HL points to numerator

5864

;;DE points to denominator

5865

;;BC points to where the quotient gets written

5866

call pushpop

5867

divSingle_no_pushpop:

5868

inc hl

5869

inc de

5870

inc hl

5871

inc de

5872

ld a,(de) ;\

5873

xor (hl) ; |Get sign of output

5874

add a,a ; |

5875

push af ;/

5876

push bc

5877

inc hl

5878

inc de

5879

ld a,(hl) ;\

5880

ex de,hl ; |Get exponent

5881

sub (hl) ; |

5882

ex de,hl ; |

5883

5884

ld b,-1

5885

jr nc,_7

5886

dec b

5887

_7:

5888

add a,128

5889

jr nc,_8

5890

inc b

5891

_8:

5892

inc b

5893

jr z,_9

5894

jp p,divunderflow

5895

jp m,divoverflow

5896

_9:

5897

ld (quot+3),a

5898

dec hl

5899

dec de

5900

ld b,(hl)

5901

dec hl

5902

ld a,(hl)

5903

dec hl

5904

ld l,(hl)

5905

ld h,a

5906

ex de,hl

5907

5908

ld c,(hl)

5909

dec hl

5910

ld a,(hl)

5911

dec hl

5912

ld l,(hl)

5913

ld h,a

5914

ex de,hl

5915

5916

set 7,c

5917

ld a,b

5918

or 80h

5919

sbc hl,de

5920

sbc a,c

5921

jr nz,_10

5922

or h

5923

or l

5924

jr z,setmantissa0

5925

xor a

5926

_10:

5927

jr nc,startdiv

5928

ld b,a

5929

ld a,(quot+3)

5930

dec a

5931

ld (quot+3),a

5932

ld a,b

5933

add hl,hl

5934

adc a,a

5935

add hl,de

5936

adc a,c

5937

startdiv:

5938

ld b,1

5939

call divsub0+3

5940

ld (quot+1),bc

5941

call divsub0

5942

ld (quot),bc

5943

call divsub0

5944

ld (quot-1),bc

5945

add hl,hl

5946

rla

5947

jr c,_11

5948

sbc hl,de

5949

sbc a,c

5950

ccf

5951

_11:

5952

ld hl,(quot)

5953

ld de,(quot+2)

5954

ld bc,0

5955

adc hl,bc

5956

ex de,hl

5957

adc hl,bc

5958

ld b,h

5959

ld c,l

5960

writeback:

5961

pop hl

5962

ld (hl),e

5963

inc hl

5964

ld (hl),d

5965

inc hl

5966

rl c

5967

pop af

5968

rr c

5969

ld (hl),c

5970

inc hl

5971

ld (hl),b

5972

ret

5973

divoverflow:

5974

ld b,$40

5975

jr _12

5976

divunderflow:

5977

ld b,0

5978

jr _12

5979

setmantissa0:

5980

ld bc,(quot+2)

5981

_12:

5982

ld de,0

5983

ld c,e

5984

jr writeback

5985

divsub0:

5986

;;882cc max

5987

call divsub1 ;34 or 66

5988

call divsub1 ;

5989

call divsub1

5990

call divsub1

5991

call divsub1

5992

call divsub1

5993

call divsub1

5994

call divsub1

5995

or a

5996

sbc hl,de

5997

sbc a,c

5998

inc b

5999

ret nc

6000

dec b

6001

add hl,de

6002

adc a,c

6003

ret

6004

divsub1:

6005

;34cc or 66cc or 93cc

6006

sla b

6007

add hl,hl

6008

rla

6009

ret nc

6010

or a

6011

inc b

6012

sbc hl,de

6013

sbc a,c

6014

ret c

6015

inc b

6016

sbc hl,de

6017

sbc a,c

6018

ret

6019

6020

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

6021

; powSingle

6022

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

6023

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

6024

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

6025

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

6026

;{

6027

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

6028

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

6029

; else if ( precision >= 1 ) {

6030

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

6031

; else return sqrt( -base );

6032

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

6033

;}

6034

6035

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

6036

6037

powSingle:

6038

;;Computes y^x

6039

;;HL points to y

6040

;;DE points to x

6041

;;BC points to output

6042

call pushpop

6043

push bc

6044

push de

6045

ld bc, var_y ; power

6046

call copySingle

6047

pop hl

6048

ld bc, var_x ; base

6049

call copySingle

6050

ld hl, const_precision

6051

ld bc, var_a ; precision

6052

call copySingle

6053

ld hl, const_0

6054

ld bc, var_z ; result

6055

call copySingle

6056

call powSingle.loop

6057

pop bc

6058

ld hl, var_z

6059

call copySingle

6060

ret

6061

6062

powSingle.loop:

6063

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

6064

ld hl, var_y

6065

ld de, const_0

6066

call cmpSingle

6067

jp c, powSingle.1

6068

6069

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

6070

ld hl, var_y

6071

ld de, const_1

6072

call cmpSingle

6073

jp nc, powSingle.2

6074

6075

; else if ( precision >= 1 ) {

6076

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

6077

; else return sqrt( -base );

6078

ld hl, var_a

6079

ld de, const_1

6080

call cmpSingle

6081

jp nc, powSingle.3

6082

6083

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

6084

ld hl, var_y

6085

ld de, const_2

6086

ld bc, var_b

6087

call mulSingle

6088

ld hl, var_b

6089

ld bc, var_y

6090

call copySingle

6091

ld hl, var_a

6092

ld de, const_2

6093

ld bc, var_b

6094

call mulSingle

6095

ld hl, var_b

6096

ld bc, var_a

6097

call copySingle

6098

call powSingle.loop

6099

ld hl, var_z

6100

ld bc, var_b

6101

call sqrtSingle

6102

ld hl, var_b

6103

ld bc, var_z

6104

call copySingle

6105

ret

6106

6107

powSingle.1:

6108

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

6109

ld hl, const_0

6110

ld de, var_y

6111

ld bc, var_b

6112

call subSingle

6113

ld hl, var_b

6114

ld bc, var_y

6115

call copySingle

6116

call powSingle.loop

6117

ld hl, const_1

6118

ld de, var_z

6119

ld bc, var_b

6120

call divSingle

6121

ld hl, var_b

6122

ld bc, var_z

6123

call copySingle

6124

ret

6125

6126

powSingle.2:

6127

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

6128

ld hl, var_y

6129

ld de, const_1

6130

ld bc, var_b

6131

call subSingle

6132

ld hl, var_b

6133

ld bc, var_y

6134

call copySingle

6135

call powSingle.loop

6136

ld hl, var_z

6137

ld de, var_x

6138

ld bc, var_b

6139

call mulSingle

6140

ld hl, var_b

6141

ld bc, var_z

6142

call copySingle

6143

ret

6144

6145

powSingle.3:

6146

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

6147

; else return sqrt( -base );

6148

ld hl, var_x

6149

ld de, const_0

6150

call cmpSingle

6151

jp nc, powSingle.1

6152

;ld hl, var_x

6153

ld bc, var_b

6154

call negSingle

6155

ld hl, var_b

6156

;ld bc, var_z

6157

;call sqrtSingle

6158

;ret

6159

6160

powSingle.3.1:

6161

;ld hl, var_x

6162

ld bc, var_z

6163

call sqrtSingle

6164

ret

6165

6166

pow2Single:

6167

;;Computes 2^x

6168

call pushpop

6169

push bc

6170

6171

exp_inject:

6172

;if x is on [0,1):

6173

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

6174

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

6175

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

6176

;

6177

;int(x) -> out_exp

6178

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

6179

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

6180

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

6181

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

6182

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

6183

ld de,var48+10

6184

call mov4

6185

ld hl,(var48+10)

6186

ld de,(var48+12)

6187

ld a,e

6188

add a,a

6189

push af ;keep track of sign

6190

rrca

6191

ld (var48+12),a

6192

ld c,a

6193

ld a,d

6194

or a

6195

jp z,exp_spec

6196

cp 80h-23

6197

jp c,exp_underflow

6198

sub 128 ; sub a,128

6199

jr c,_pow_1 ;int(x)=0

6200

inc a

6201

cp 7

6202

jp nc,exp_overflow

6203

set 7,c

6204

ld b,a

6205

xor a

6206

add hl,hl

6207

rl c

6208

rla

6209

djnz $-4

6210

ld b,7Fh

6211

bit 7,c

6212

jr nz,exp_normalized

6213

ld e,a

6214

ld a,h

6215

or l

6216

or c

6217

ld a,e

6218

jr z,exp_zeroed

6219

dec b

6220

add hl,hl

6221

rl c

6222

jp p,$-4

6223

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

6224

exp_zeroed:

6225

ld b,0

6226

exp_normalized:

6227

ld (var48+10),hl

6228

res 7,c

6229

ld (var48+12),bc

6230

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

6231

_pow_1:

6232

xor a

6233

comp_exp:

6234

pop hl

6235

rr l

6236

jr nc,_pow_2

6237

cpl

6238

or a

6239

jp z,exp_underflow+1

6240

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

6241

ld hl,const_1

6242

ld de,var48+10

6243

ld b,d

6244

ld c,e

6245

call subSingle

6246

_pow_2:

6247

push af

6248

;our 'x' is at var48+10

6249

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

6250

;uses 14 bytes of RAM

6251

ld hl,var48+10

6252

ld de,exp_a6

6253

ld bc,var48+6

6254

call mulSingle

6255

ld d,b

6256

ld e,c

6257

ld hl,exp_a5

6258

call addSingle

6259

ld hl,var48+10

6260

call mulSingle

6261

ld hl,exp_a4

6262

call addSingle

6263

ld hl,var48+10

6264

call mulSingle

6265

ld hl,exp_a3

6266

call addSingle

6267

ld hl,var48+10

6268

call mulSingle

6269

ld hl,exp_a2

6270

call addSingle

6271

ld hl,var48+10

6272

call mulSingle

6273

ld hl,exp_a1

6274

call addSingle

6275

ld hl,var48+10

6276

call mulSingle

6277

ld hl,const_1

6278

call addSingle

6279

ld hl,var48+9

6280

pop af

6281

add a,(hl)

6282

ld (hl),a

6283

ex de,hl

6284

pop de

6285

jp mov4

6286

exp_spec:

6287

;bit 6 means INF

6288

;bit 5 means NAN

6289

;no bits means zero

6290

;NAN -> NAN

6291

;+inf -> +inf

6292

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

6293

ld a,c

6294

add a,a

6295

jr z,exp_zero

6296

jp m,exp_inf

6297

;exp_NAN

6298

pop af

6299

ld de,0040h

6300

exp_return_spec:

6301

pop hl

6302

rr e

6303

ld (hl),a

6304

inc hl

6305

ld (hl),a

6306

inc hl

6307

ld (hl),e

6308

inc hl

6309

ld (hl),d

6310

ret

6311

exp_overflow:

6312

exp_inf:

6313

;+inf -> +inf

6314

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

6315

pop af

6316

sbc a,a ;FF if should be 0,

6317

cpl

6318

and 80h

6319

ld d,0

6320

ld e,a

6321

jr exp_return_spec

6322

exp_underflow:

6323

exp_zero:

6324

pop af

6325

or a

6326

ld de,$8000

6327

jr exp_return_spec

6328

6329

endif

6330

6331

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

6332

; sqrtSingle

6333

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

6334

6335

if defined MATH_SQR or defined MATH_EXP

6336

6337

;Uses 3 bytes at scrap

6338

sqrtSingle:

6339

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

6340

;min: 1784

6341

;max: 1987

6342

;avg: 1872

6343

call pushpop

6344

push bc

6345

ld c,(hl)

6346

inc hl

6347

ld e,(hl)

6348

inc hl

6349

ld a,(hl)

6350

add a,a

6351

jp c,sqrtSingle_NaN

6352

scf

6353

rra

6354

ld d,a

6355

inc hl

6356

ld a,(hl)

6357

or a

6358

jp z,sqrtSingle_special

6359

add a,80h

6360

rra

6361

push af ;new exponent

6362

jr c,_13

6363

srl d

6364

rr e

6365

rr c

6366

_13:

6367

ex de,hl

6368

ld ixh,c

6369

ld ixl,0

6370

call sqrtHLIX

6371

;AHL is the new remainder

6372

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

6373

rra

6374

ld a,h

6375

;HL/DE to 8 bits

6376

;We are just going to approximate it

6377

res 0,l

6378

jr c,$+5

6379

cp d

6380

jr c,$+4

6381

sub d

6382

inc l

6383

sla l

6384

rla

6385

jr c,$+5

6386

cp d

6387

jr c,$+4

6388

sub d

6389

inc l

6390

sla l

6391

rla

6392

jr c,$+5

6393

cp d

6394

jr c,$+4

6395

sub d

6396

inc l

6397

sla l

6398

rla

6399

jr c,$+5

6400

cp d

6401

jr c,$+4

6402

sub d

6403

inc l

6404

sla l

6405

rla

6406

jr c,$+5

6407

cp d

6408

jr c,$+4

6409

sub d

6410

inc l

6411

sla l

6412

rla

6413

jr c,$+5

6414

cp d

6415

jr c,$+4

6416

sub d

6417

inc l

6418

sla l

6419

rla

6420

jr c,$+5

6421

cp d

6422

jr c,$+4

6423

sub d

6424

inc l

6425

sla l

6426

rla

6427

jr c,$+5

6428

cp d

6429

jr c,$+4

6430

sub d

6431

inc l

6432

6433

pop bc

6434

ld a,l

6435

pop hl

6436

;BDEA

6437

ld (hl),a

6438

inc hl

6439

ld (hl),e

6440

inc hl

6441

res 7,d

6442

ld (hl),d

6443

inc hl

6444

ld (hl),b

6445

ret

6446

sqrtSingle_NaN:

6447

ld hl,const_NaN

6448

pop de

6449

jp mov4

6450

sqrtSingle_special:

6451

dec hl

6452

dec hl

6453

pop de

6454

jp mov4

6455

6456

sqrtHLIX:

6457

;Input: HLIX

6458

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

6459

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

6460

;min: 1130

6461

;max: 1266

6462

;avg: 1190.5

6463

6464

6465

call sqrtHL

6466

add a,a

6467

ld e,a

6468

jr nc,_14

6469

inc d

6470

_14:

6471

6472

ld a,ixh

6473

sll e

6474

rl d

6475

add a,a

6476

adc hl,hl

6477

add a,a

6478

adc hl,hl

6479

sbc hl,de

6480

jr nc,_15

6481

add hl,de

6482

dec e

6483

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

6484

_15:

6485

inc e

6486

_15a:

6487

sll e

6488

rl d

6489

add a,a

6490

adc hl,hl

6491

add a,a

6492

adc hl,hl

6493

sbc hl,de

6494

jr nc,_16

6495

add hl,de

6496

dec e

6497

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

6498

_16:

6499

inc e

6500

_16a:

6501

sll e

6502

rl d

6503

add a,a

6504

adc hl,hl

6505

add a,a

6506

adc hl,hl

6507

sbc hl,de

6508

jr nc,_17

6509

add hl,de

6510

dec e

6511

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

6512

_17:

6513

inc e

6514

_17a:

6515

sll e

6516

rl d

6517

add a,a

6518

adc hl,hl

6519

add a,a

6520

adc hl,hl

6521

sbc hl,de

6522

jr nc,_18

6523

add hl,de

6524

dec e

6525

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

6526

_18:

6527

inc e

6528

_18a:

6529

;Now we have four more iterations

6530

;The first two are no problem

6531

ld a,ixl

6532

sll e

6533

rl d

6534

add a,a

6535

adc hl,hl

6536

add a,a

6537

adc hl,hl

6538

sbc hl,de

6539

jr nc,_19

6540

add hl,de

6541

dec e

6542

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

6543

_19:

6544

inc e

6545

_19a:

6546

sll e

6547

rl d

6548

add a,a

6549

adc hl,hl

6550

add a,a

6551

adc hl,hl

6552

sbc hl,de

6553

jr nc,_20

6554

add hl,de

6555

dec e

6556

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

6557

_20:

6558

inc e

6559

_20a:

6560

sqrt32_iter15:

6561

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

6562

sll e

6563

rl d ;sla e \ rl d \ inc e

6564

add a,a

6565

adc hl,hl

6566

add a,a

6567

adc hl,hl ;This might overflow!

6568

jr c,sqrt32_iter15_br0

6569

;

6570

sbc hl,de

6571

jr nc,_21

6572

add hl,de

6573

dec e

6574

jr sqrt32_iter16

6575

sqrt32_iter15_br0:

6576

or a

6577

sbc hl,de

6578

_21:

6579

inc e

6580

6581

;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

6582

sqrt32_iter16:

6583

add a,a

6584

ld b,a ;either 0x00 or 0x80

6585

adc hl,hl

6586

rla

6587

adc hl,hl

6588

rla

6589

;AHL - (DE+DE+1)

6590

sbc hl,de

6591

sbc a,b

6592

inc e

6593

or a

6594

sbc hl,de

6595

sbc a,b

6596

ret p

6597

add hl,de

6598

adc a,b

6599

dec e

6600

add hl,de

6601

adc a,b

6602

ret

6603

6604

sqrtHL:

6605

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

6606

;min: 376cc

6607

;max: 416cc

6608

;avg: 393cc

6609

ld de,$5040

6610

ld a,h

6611

sub e

6612

jr nc,_22

6613

add a,e

6614

ld d,$10

6615

_22:

6616

sub d

6617

jr nc,_23

6618

add a,d

6619

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

6620

_23:

6621

set 5,d

6622

_23a:

6623

res 4,d

6624

srl d

6625

6626

set 2,d

6627

sub d

6628

jr nc,_24

6629

add a,d

6630

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

6631

_24:

6632

set 3,d

6633

_24a:

6634

res 2,d

6635

srl d

6636

6637

inc d

6638

sub d

6639

jr nc,_25

6640

add a,d

6641

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

6642

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

6643

_25:

6644

inc d

6645

_25a:

6646

srl d

6647

ld h,a

6648

6649

6650

sbc hl,de

6651

ld a,e

6652

jr nc,_26

6653

add hl,de

6654

_26:

6655

ccf

6656

rra

6657

srl d

6658

rra

6659

ld e,a

6660

6661

sbc hl,de

6662

jr nc,_27

6663

add hl,de

6664

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

6665

_27:

6666

or %00100000

6667

_27a:

6668

xor %00011000

6669

srl d

6670

rra

6671

ld e,a

6672

6673

6674

sbc hl,de

6675

jr nc,_28

6676

add hl,de

6677

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

6678

_28:

6679

or %00001000

6680

_28a:

6681

xor %00000110

6682

srl d

6683

rra

6684

ld e,a

6685

sbc hl,de

6686

jr nc,_29

6687

add hl,de

6688

srl d

6689

rra

6690

ret

6691

_29:

6692

inc a

6693

srl d

6694

rra

6695

ret

6696

6697

endif

6698

6699

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

6700

; lnSingle

6701

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

6702

6703

if defined MATH_LOG or defined MATH_LN

6704

6705

lnSingle:

6706

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

6707

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

6708

call pushpop

6709

push bc

6710

ld de, const_100_inv

6711

ld bc, temp

6712

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

6713

ld hl, temp

6714

ld de, const_100

6715

ld bc, temp1

6716

call mulSingle ; temp1 = temp * 100

6717

ld hl, temp1

6718

pop bc

6719

call subSingle ; bc = temp1 - 100

6720

ret

6721

6722

endif

6723

6724

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

6725

; logSingle

6726

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

6727

6728

if defined MATH_LOG

6729

6730

logSingle:

6731

call pushpop

6732

push bc

6733

ld bc, temp

6734

call lnSingle

6735

ld hl, temp

6736

ld de, const_lg10

6737

pop bc

6738

call divSingle

6739

ret

6740

6741

endif

6742

6743

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

6744

; expSingle

6745

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

6746

6747

if defined MATH_EXP

6748

6749

expSingle:

6750

;;Computes e^x

6751

;;HL points to x

6752

;;BC points to the output

6753

call pushpop

6754

ld de,const_lg_e

6755

push bc

6756

pow_inject:

6757

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

6758

ld bc,var_x

6759

call mulSingle

6760

ld h,b

6761

ld l,c

6762

jp exp_inject

6763

6764

endif

6765

6766

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

6767

; sinSingle

6768

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

6769

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

6770

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

6771

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

6772

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

6773

6774

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

6775

6776

sinSingle:

6777

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

6778

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

6779

; reduction:

6780

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

6781

; var_c = x - var_b*2*PI

6782

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

6783

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

6784

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

6785

6786

call pushpop

6787

ld de, const_0

6788

call cmpSingle

6789

jr nz, sinSingle.1

6790

6791

call copySingle ; return 0

6792

ret

6793

6794

sinSingle.1:

6795

call trigRangeReductionSinCos

6796

push bc

6797

ld hl, var_a

6798

ld de, var_a

6799

ld bc, var_b

6800

call mulSingle ; var_b = var_a * var_a

6801

ld hl, var_b

6802

ld de, sin_a3

6803

ld bc, temp

6804

call mulSingle ; temp = x^2/5040

6805

ld hl, sin_a2

6806

ld de, temp

6807

ld bc, temp1

6808

call subSingle ; temp1 = 1/120 - temp

6809

ld hl, var_b

6810

ld de, temp1

6811

ld bc, temp

6812

call mulSingle ; temp = x^2 * temp1

6813

ld hl, sin_a1

6814

ld de, temp

6815

ld bc, temp1

6816

call subSingle ; temp1 = 1/6 - temp

6817

ld hl, var_b

6818

ld de, temp1

6819

ld bc, temp

6820

call mulSingle ; temp = x^2 * temp1

6821

ld hl, const_1

6822

ld de, temp

6823

ld bc, temp1

6824

call subSingle ; temp1 = 1 - temp

6825

ld hl, var_a

6826

ld de, temp1

6827

pop bc

6828

call mulSingle ; return x * temp1

6829

ret

6830

6831

trigRangeReductionSinCos:

6832

call pushpop

6833

push hl

6834

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

6835

ld de, const_2pi

6836

ld bc, var_c

6837

call divSingle

6838

ld hl, var_c

6839

ld de, 0

6840

ld bc, var_b

6841

call roundSingle

6842

; var_c = x - var_b*2*PI

6843

ld hl, var_b

6844

ld de, const_2pi

6845

ld bc, temp

6846

call mulSingle ; temp = var_b*2*PI

6847

pop hl

6848

ld de, temp

6849

ld bc, var_c

6850

call subSingle ; var_c = x - temp

6851

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

6852

ld hl, var_c

6853

ld de, const_0

6854

call cmpSingle

6855

jr nc, trigRangeReductionSinCos.else.2

6856

ld hl, var_c

6857

ld bc, temp1

6858

call copySingle ; temp1 = var_c

6859

jr trigRangeReductionSinCos.endif.2

6860

trigRangeReductionSinCos.else.2:

6861

ld hl, var_c

6862

ld de, const_2pi

6863

ld bc, temp1

6864

call addSingle ; temp1 = var_c + 2*PI

6865

trigRangeReductionSinCos.endif.2:

6866

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

6867

ld hl, const_pi

6868

ld de, temp1

6869

call cmpSingle

6870

jr c, trigRangeReductionSinCos.else.3

6871

jr z, trigRangeReductionSinCos.else.3

6872

ld hl, temp1

6873

ld de, const_pi

6874

ld bc, temp2

6875

call subSingle ; temp2

6876

jr trigRangeReductionSinCos.endif.3

6877

trigRangeReductionSinCos.else.3:

6878

ld hl, temp1

6879

ld bc, temp2

6880

call copySingle ; temp2 = temp1

6881

trigRangeReductionSinCos.endif.3:

6882

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

6883

ld hl, const_half_pi

6884

ld de, temp2

6885

call cmpSingle

6886

jr c, trigRangeReductionSinCos.else.4

6887

jr z, trigRangeReductionSinCos.else.4

6888

ld hl, const_pi

6889

ld de, temp2

6890

ld bc, var_a

6891

call subSingle ; var_a

6892

jr trigRangeReductionSinCos.endif.4

6893

trigRangeReductionSinCos.else.4:

6894

ld hl, temp2

6895

ld bc, var_a

6896

call copySingle ; var_a = temp2

6897

trigRangeReductionSinCos.endif.4:

6898

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

6899

ld hl, temp1

6900

ld de, const_pi

6901

call cmpSingle

6902

jr nc, trigRangeReductionSinCos.endif.5

6903

ld ix, var_a

6904

ld a, (ix+2)

6905

set 7, a

6906

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

6907

trigRangeReductionSinCos.endif.5:

6908

; return var_a

6909

ret

6910

6911

endif

6912

6913

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

6914

; cosSingle

6915

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

6916

6917

if defined MATH_COS or defined MATH_TAN

6918

6919

cosSingle:

6920

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

6921

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

6922

; reduction: same as sin

6923

; cos = cos * sign

6924

6925

call pushpop

6926

ld de, const_0

6927

call cmpSingle

6928

jr nz, cosSingle.1

6929

6930

ld hl, const_1

6931

call copySingle ; return 1

6932

ret

6933

6934

cosSingle.1:

6935

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

6936

call trigRangeReductionSinCos

6937

push bc

6938

ld hl, var_a

6939

ld de, var_a

6940

ld bc, var_b

6941

call mulSingle ; var_b = var_a * var_a

6942

ld hl, var_b

6943

ld de, cos_a3

6944

ld bc, temp

6945

call mulSingle ; temp = x^2/720

6946

ld hl, cos_a2

6947

ld de, temp

6948

ld bc, temp1

6949

call subSingle ; temp1 = 1/24 - temp

6950

ld hl, var_b

6951

ld de, temp1

6952

ld bc, temp

6953

call mulSingle ; temp = x^2 * temp1

6954

ld hl, cos_a1

6955

ld de, temp

6956

ld bc, temp1

6957

call subSingle ; temp1 = 1/2 - temp

6958

ld hl, var_b

6959

ld de, temp1

6960

ld bc, temp

6961

call mulSingle ; temp = x^2 * temp1

6962

ld hl, const_1

6963

ld de, temp

6964

ld bc, temp1

6965

call subSingle ; temp1 = 1 - temp

6966

6967

; temp3 = abs(var_c)

6968

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

6969

ld hl, var_c

6970

ld bc, temp3

6971

call copySingle

6972

ld ix, temp3

6973

ld a, (ix+2)

6974

res 7, a

6975

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

6976

ld hl, temp3

6977

ld de, const_half_pi

6978

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

6979

jr nc, cosSingle.endif.1

6980

ld ix, temp1

6981

ld a, (ix+2)

6982

set 7, a

6983

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

6984

cosSingle.endif.1:

6985

pop bc

6986

ld hl, temp1

6987

call copySingle ; return temp1

6988

ret

6989

6990

endif

6991

6992

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

6993

; tanSingle

6994

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

6995

6996

if defined MATH_TAN

6997

6998

tanSingle:

6999

call pushpop

7000

push bc

7001

;HL points to input

7002

ld bc,var_z

7003

ld d,b

7004

ld e,c

7005

call cosSingle

7006

ld bc,var_x

7007

call sinSingle

7008

ld h,b

7009

ld l,c

7010

pop bc

7011

jp divSingle

7012

7013

endif

7014

7015

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

7016

; atanSingle

7017

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

7018

7019

if defined MATH_ATN

7020

7021

atanSingle:

7022

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

7023

; x < -1: atan - PI/2

7024

; x >= 1: PI/2 - atan

7025

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

7026

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

7027

; X < 0: Y = -Y

7028

7029

call pushpop

7030

ld de, const_0

7031

call cmpSingle

7032

jr nz, atanSingle.1

7033

7034

ld hl, const_0

7035

call copySingle ; return 0

7036

ret

7037

7038

atanSingle.1:

7039

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

7040

call trigRangeReductionAtan

7041

push bc

7042

push hl

7043

ld hl, var_a

7044

ld de, var_a

7045

ld bc, var_b

7046

call mulSingle ; var_b = var_a * var_a

7047

ld hl, var_b

7048

ld de, const_16

7049

ld bc, temp

7050

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

7051

ld hl, temp

7052

ld de, const_9

7053

ld bc, temp1

7054

call divSingle ; temp1 = temp/9

7055

ld hl, temp1

7056

ld de, const_7

7057

ld bc, temp

7058

call addSingle ; temp = 7 + temp1

7059

ld hl, var_b

7060

ld de, const_9

7061

ld bc, temp1

7062

call mulSingle ; temp1 = var_b * 9

7063

ld hl, temp1

7064

ld de, temp

7065

ld bc, temp2

7066

call divSingle ; temp2 = temp1 / temp

7067

ld hl, temp2

7068

ld de, const_5

7069

ld bc, temp

7070

call addSingle ; temp = 5 + temp2

7071

ld hl, var_b

7072

ld de, const_4

7073

ld bc, temp1

7074

call mulSingle ; temp1 = var_b * 4

7075

ld hl, temp1

7076

ld de, temp

7077

ld bc, temp2

7078

call divSingle ; temp2 = temp1 / temp

7079

ld hl, temp2

7080

ld de, const_3

7081

ld bc, temp

7082

call addSingle ; temp = 3 + temp2

7083

ld hl, var_b

7084

ld de, temp

7085

ld bc, temp2

7086

call divSingle ; temp2 = var_b / temp

7087

ld hl, temp2

7088

ld de, const_1

7089

ld bc, temp

7090

call addSingle ; temp = 1 + temp2

7091

ld hl, var_a

7092

ld de, temp

7093

ld bc, temp2

7094

call divSingle ; temp2 = var_a / temp

7095

pop hl

7096

; x >= 1: PI/2 - atan

7097

ld de, const_1

7098

call cmpSingle

7099

jr nc, atanSingle.2

7100

ld hl, const_half_pi

7101

ld de, temp2

7102

ld bc, temp

7103

call subSingle

7104

ld hl, temp

7105

jr atanSingle.4

7106

atanSingle.2:

7107

; x < -1: atan - PI/2

7108

push hl

7109

ld hl, const_0

7110

ld de, const_1

7111

ld bc, temp

7112

call subSingle

7113

pop hl

7114

ld de, temp

7115

call cmpSingle

7116

jr c, atanSingle.3

7117

ld hl, temp2

7118

ld de, const_half_pi

7119

ld bc, temp

7120

call subSingle

7121

ld hl, temp

7122

jr atanSingle.4

7123

atanSingle.3:

7124

ld hl, temp2

7125

atanSingle.4:

7126

pop bc

7127

call copySingle ; return temp2

7128

ret

7129

7130

trigRangeReductionAtan:

7131

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

7132

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

7133

; X < 0: Y = -Y

7134

call pushpop

7135

push hl

7136

ld bc, temp

7137

call copySingle

7138

ld ix, temp

7139

ld a, (ix+2)

7140

res 7, a

7141

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

7142

ld hl, temp

7143

ld de, const_1

7144

call cmpSingle

7145

jr nc, trigRangeReductionAtan.1

7146

ld hl, const_1

7147

pop de

7148

push de

7149

ld bc, var_a

7150

call divSingle

7151

jr trigRangeReductionAtan.2

7152

trigRangeReductionAtan.1:

7153

pop hl

7154

push hl

7155

ld bc, var_a

7156

call copySingle

7157

trigRangeReductionAtan.2:

7158

pop hl

7159

ld de, const_0

7160

call cmpSingle

7161

jr c, trigRangeReductionAtan.3

7162

ld ix, var_a

7163

ld a, (ix+2)

7164

set 7, a

7165

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

7166

trigRangeReductionAtan.3:

7167

ret

7168

7169

endif

7170

7171

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

7172

7173

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

7174

; copySingle

7175

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

7176

7177

copySingle:

7178

call pushpop

7179

;push bc

7180

;pop de

7181

ld d, b

7182

ld e, c

7183

ldi

7184

ldi

7185

ldi

7186

ldi

7187

ret

7188

7189

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

7190

; roundSingle

7191

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

7192

7193

roundSingle:

7194

call pushpop

7195

call copySingle

7196

;push bc

7197

;pop hl

7198

ld h, b

7199

ld l, c

7200

push de

7201

ld a, e

7202

ld de, const_10

7203

roundSingle.1:

7204

or 0

7205

jr z, roundSingle.2

7206

ld bc, temp

7207

call mulSingle

7208

;push hl

7209

;pop bc

7210

ld b, h

7211

ld c, l

7212

ld hl, temp

7213

call copySingle

7214

;push bc

7215

;pop hl

7216

ld h, b

7217

ld l, c

7218

dec a

7219

jr roundSingle.1

7220

roundSingle.2:

7221

ld de, const_half_1

7222

ld bc, temp

7223

call addSingle

7224

push hl

7225

ld hl, temp

7226

ld bc, temp1

7227

call single2Int

7228

ld hl, temp1

7229

pop bc

7230

call int2Single

7231

;push bc

7232

;pop hl

7233

ld h, b

7234

ld l, c

7235

pop de

7236

ld a, e

7237

ld de, const_10

7238

roundSingle.3:

7239

or 0

7240

jr z, roundSingle.4

7241

ld bc, temp

7242

call divSingle

7243

;push hl

7244

;pop bc

7245

ld b, h

7246

ld c, l

7247

ld hl, temp

7248

call copySingle

7249

;push bc

7250

;pop hl

7251

ld h, b

7252

ld l, c

7253

dec a

7254

jr roundSingle.3

7255

roundSingle.4:

7256

ret

7257

7258

endif

7259

7260

if defined MATH_ABSFN

7261

7262

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

7263

; absSingle

7264

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

7265

7266

absSingle:

7267

;;HL points to the float

7268

;;BC points to where to output the result

7269

call pushpop

7270

ld d,b

7271

ld e,c

7272

ldi

7273

ldi

7274

ld a,(hl)

7275

and %01111111

7276

ld (de),a

7277

inc hl

7278

inc de

7279

ld a,(hl)

7280

ld (de),a

7281

ret

7282

7283

endif

7284

7285

if defined MATH_SGN

7286

7287

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

7288

; sgnSingle

7289

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

7290

7291

sgnSingle:

7292

;;HL points to the float

7293

;;BC points to where to output the result

7294

jp negSingle

7295

7296

endif

7297

7298

if defined powSingle or defined sgnSingle or defined MATH_NEG

7299

7300

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

7301

; negSingle

7302

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

7303

7304

negSingle:

7305

;;HL points to the float

7306

;;BC points to where to output the result

7307

call pushpop

7308

push hl

7309

pop ix

7310

ld a, (ix+3)

7311

or 0

7312

jr nz, negSingle.test.sign

7313

ld a, (ix+2)

7314

or 0

7315

jr nz, negSingle.test.sign

7316

ld a, (ix+1)

7317

or 0

7318

jr nz, negSingle.test.sign

7319

ld a, (ix)

7320

or 0

7321

jr nz, negSingle.test.sign

7322

;push bc

7323

;pop de

7324

ld d, b

7325

ld e, c

7326

ld hl, const_0

7327

ldi

7328

ldi

7329

ldi

7330

ldi

7331

ret

7332

negSingle.test.sign:

7333

ld a, (ix+2)

7334

bit 7, a

7335

jr z, negSingle.positive

7336

negSingle.negative:

7337

push bc

7338

pop ix

7339

call negSingle.positive

7340

ld a, (ix+2)

7341

set 7, a

7342

ld (ix+2), a

7343

ret

7344

negSingle.positive:

7345

;push bc

7346

;pop de

7347

ld d, b

7348

ld e, c

7349

ld hl, const_1

7350

ldi

7351

ldi

7352

ldi

7353

ldi

7354

ret

7355

7356

endif

7357

7358

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

7359

7360

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

7361

; cmpSingle

7362

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

7363

7364

cmpSingle:

7365

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

7366

;Output:

7367

; float1 >= float2 : nc

7368

; float1 < float2 : c,nz

7369

; float1 == float2 : z

7370

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

7371

;

7372

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

7373

push hl

7374

push de

7375

push bc

7376

ld c, a

7377

push bc

7378

ex de, hl

7379

call _30

7380

pop bc

7381

ld a, c

7382

pop bc

7383

pop de

7384

pop hl

7385

ret

7386

_30:

7387

inc de

7388

inc de

7389

inc de

7390

ld a,(de)

7391

inc hl

7392

inc hl

7393

inc hl

7394

cp (hl)

7395

jr nc,_31

7396

ld a,(hl)

7397

_31:

7398

dec hl

7399

dec hl

7400

dec hl

7401

dec de

7402

dec de

7403

dec de

7404

push af

7405

ld bc,scrap

7406

call subSingle

7407

ld a,(scrap+3) ;new power

7408

pop bc ;B is old power

7409

or a

7410

jr z,cmp_close

7411

sub b

7412

jr nc,cmp_is_sign

7413

dec a

7414

add a,22

7415

jr nc,cmp_close

7416

cmp_is_sign:

7417

ld a,(scrap+2)

7418

or 1 ;not equal, so reset z flag

7419

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

7420

ret

7421

cmp_close:

7422

xor a

7423

ret

7424

7425

endif

7426

7427

if defined MATH_RND

7428

7429

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

7430

; randSingle

7431

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

7432

7433

randSingle:

7434

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

7435

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

7436

call pushpop

7437

push bc

7438

call rand

7439

push hl

7440

call rand

7441

pop de

7442

ex de,hl

7443

ld bc,$207F

7444

;DEHL is the mantissa, B is the exponent

7445

ld a,d

7446

or a

7447

jp m,rand_normed

7448

_32:

7449

dec c

7450

add hl,hl

7451

rl e

7452

rl d

7453

jp m,rand_normed

7454

djnz _32

7455

rand_zero:

7456

ld c,l

7457

ld b,l

7458

jr rand_done

7459

rand_normed:

7460

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

7461

ld a,b

7462

cp 8

7463

jr c,rand_zero

7464

sub 24

7465

jp nc,rand_no_more_rand_data

7466

push bc

7467

push de

7468

call rand

7469

pop de

7470

ld e,h

7471

ld h,l

7472

pop bc

7473

rand_no_more_rand_data:

7474

ld b,e

7475

ld e,d

7476

ld d,c

7477

ld c,h

7478

res 7,e

7479

rand_done:

7480

pop hl

7481

;DEBC

7482

ld (hl),b

7483

inc hl

7484

ld (hl),c

7485

inc hl

7486

ld (hl),e

7487

inc hl

7488

ld (hl),d

7489

ret

7490

7491

rand:

7492

;;Tested and passes all CAcert tests

7493

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

7494

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

7495

;;roughly 18.4 quintillion.

7496

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

7497

;;323cc

7498

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

7499

;Uses 64 bits of state

7500

ld hl,(seed0)

7501

ld de,(seed0+2)

7502

ld b,h

7503

ld c,l

7504

add hl,hl

7505

rl e

7506

rl d

7507

add hl,hl

7508

rl e

7509

rl d

7510

inc l

7511

add hl,bc

7512

ld (seed0),hl

7513

ld hl,(seed0+2)

7514

adc hl,de

7515

ld (seed0+2),hl

7516

ex de,hl

7517

;;lfsr

7518

ld hl,(seed1)

7519

ld bc,(seed1+2)

7520

add hl,hl

7521

rl c

7522

rl b

7523

ld (seed1+2),bc

7524

sbc a,a

7525

and %11000101

7526

xor l

7527

ld l,a

7528

ld (seed1),hl

7529

ex de,hl

7530

add hl,bc

7531

ret

7532

7533

endif

7534

7535

if defined MATH_FOUT

7536

7537

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

7538

; single2Str

7539

; in HL = Single address

7540

; BC = String address

7541

; out A = String size

7542

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

7543

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

7544

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

7545

7546

single2str:

7547

call pushpop

7548

push bc

7549

call _33

7550

pop de

7551

xor a

7552

cp (hl)

7553

ldi

7554

jr nz,$-3

7555

7556

ret

7557

_33:

7558

; Move the float to scrap

7559

ld de,scrap

7560

call mov4

7561

7562

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

7563

ld de,strout_single

7564

ld hl,scrap+2

7565

ld a,(hl)

7566

;rlca

7567

;scf

7568

;rra

7569

bit 7, a

7570

jr z, _34

7571

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

7572

ld (de),a

7573

inc de

7574

ld a,(hl)

7575

_34:

7576

set 7, a

7577

ld (hl),a

7578

7579

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

7580

inc hl

7581

ld a,(hl)

7582

or a

7583

jp z,strcase_single

7584

7585

7586

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

7587

ex de,hl

7588

ld (hl),'0'

7589

inc hl

7590

7591

; Save the pointer

7592

push hl

7593

7594

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

7595

ld de,77

7596

ld h,a

7597

ld l,d

7598

call mul8_preset

7599

ld de,-77*128

7600

add hl,de

7601

ld a,h

7602

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

7603

ld de,pown10LUT

7604

jr c,_35

7605

neg

7606

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

7607

_35:

7608

ld hl, pow10exp_single

7609

ld bc,scrap

7610

call singletostr_mul

7611

call singletostr_mul

7612

call singletostr_mul

7613

call singletostr_mul

7614

call singletostr_mul

7615

call singletostr_mul

7616

;now the number is pretty close to a nice value

7617

7618

; If it is less than 1, multiply by 10

7619

ld a,(scrap+3)

7620

sub 128

7621

jr nc,_36

7622

ld de,const_10

7623

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

7624

;ld b,h

7625

;ld c,l

7626

ld h,b

7627

ld l,c

7628

call mulSingle

7629

ld hl,pow10exp_single

7630

dec (hl)

7631

ld a,(scrap+3)

7632

sub 128

7633

_36:

7634

7635

; Convert to a fixed-point number !

7636

inc a

7637

ld b,a

7638

xor a

7639

_37:

7640

ld hl,scrap

7641

sla (hl)

7642

inc hl

7643

rl (hl)

7644

inc hl

7645

rl (hl)

7646

rla

7647

djnz _37

7648

7649

;We need to get 7 digits

7650

ld b,6

7651

pop hl ;Points to the string

7652

7653

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

7654

cp 10

7655

jr c,_38

7656

dec b

7657

;Increment the exponent :)

7658

ld de,(pow10exp_single-1)

7659

inc d

7660

ld (pow10exp_single-1),de

7661

;

7662

ld (hl),'0'-1

7663

inc (hl)

7664

sub 10

7665

jr nc,$-3

7666

add a,10

7667

inc hl

7668

_38:

7669

; Get the remaining digits.

7670

_39:

7671

add a,'0'

7672

ld (hl),a

7673

inc hl

7674

push hl

7675

push bc

7676

call singletostrmul10

7677

pop bc

7678

pop hl

7679

djnz _39

7680

7681

;Save the pointer to the end of the string

7682

ld d,h

7683

ld e,l

7684

;ld (hl), 0

7685

7686

;Now let's round!

7687

cp 5

7688

jr c,rounding_done_single

7689

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

7690

_40:

7691

ld (hl),'0'

7692

_40a:

7693

dec hl

7694

inc (hl)

7695

ld a,(hl)

7696

cp $3A

7697

jr z,_40

7698

rounding_done_single:

7699

7700

7701

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

7702

ld hl,strout_single

7703

ld a,(hl)

7704

cp '-'

7705

jr nz,_41

7706

inc hl

7707

ld a,(hl)

7708

_41:

7709

cp '0'

7710

jr nz,_42

7711

dec de

7712

ex de,hl

7713

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

7714

sbc hl,de

7715

ld b,h

7716

ld c,l

7717

ld h,d

7718

ld l,e

7719

inc hl

7720

ldir

7721

cp a

7722

_42:

7723

7724

push de

7725

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

7726

ld a,(pow10exp_single)

7727

jr z,_43

7728

inc a

7729

ld (pow10exp_single),a

7730

_43:

7731

7732

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

7733

add a,4

7734

cp 10

7735

jp c,movdec_single

7736

_44:

7737

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

7738

;Then, we need to append the exponent string

7739

ld hl,strout_single

7740

ld de,strout_single-1

7741

ld a,(hl)

7742

cp '-' ;negative sign

7743

jr nz,_45

7744

ldi

7745

_45:

7746

ldi

7747

ld a,'.'

7748

ld (de),a

7749

7750

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

7751

pop hl

7752

call strip_zeroes

7753

7754

; Write the exponent

7755

ld (hl),'e'

7756

inc hl

7757

ld a,(pow10exp_single)

7758

or a

7759

jp p,_46

7760

ld (hl),'-' ;negative sign

7761

inc hl

7762

neg

7763

_46:

7764

cp 10

7765

jr c,_47

7766

ld (hl),'0'-1

7767

inc (hl)

7768

sub 10

7769

jr nc,$-3

7770

add a,10

7771

inc hl

7772

_47:

7773

add a,'0'

7774

ld (hl),a

7775

inc hl

7776

ld (hl),0

7777

7778

ld de, strout_single

7779

xor a

7780

sbc hl, de

7781

ld a, l ; string size

7782

7783

ld hl,strout_single-1

7784

ret

7785

7786

movdec_single:

7787

ld a,(pow10exp_single)

7788

or a

7789

jp p,posdec_single

7790

ld l,a

7791

;need to put zeroes before everything

7792

ld de,strout_single

7793

ld a,(de)

7794

cp '-' ;negative sign

7795

push af

7796

ld a,'0'

7797

jr z,$+3

7798

_48:

7799

dec de

7800

ld (de),a

7801

inc l

7802

jr nz,_48

7803

_49:

7804

ex de,hl

7805

ld (hl),'.'

7806

pop af

7807

jr nz,_50

7808

dec hl

7809

ld (hl),a

7810

_50:

7811

ex de,hl

7812

pop hl

7813

call strip_zeroes

7814

ld (hl),0

7815

ex de,hl

7816

ret

7817

7818

posdec_single:

7819

ld hl,strout_single

7820

ld de,strout_single-1

7821

ld c,a

7822

ld a,(hl)

7823

ld b,0

7824

cp '-' ;negative sign

7825

jr nz,_51

7826

inc c

7827

_51:

7828

inc c

7829

ldir

7830

ld a,'.'

7831

ld (de),a

7832

pop hl

7833

call strip_zeroes

7834

ld (hl),0

7835

ld hl,strout_single-1

7836

ret

7837

7838

strcase_single:

7839

ld hl,str_Zero

7840

ld a,(scrap+2)

7841

add a,a

7842

and $C0

7843

jr z,_52

7844

ld hl,str_Inf

7845

jp pe,_52

7846

ld hl,str_NaN

7847

_52:

7848

call mov4

7849

ld hl,strout_single

7850

ret

7851

7852

singletostrmul10:

7853

;multiply the 0.24 fixed point number at scrap by 10

7854

;overflow in A register

7855

ld a,(scrap+2)

7856

ld e,a

7857

ld hl,(scrap)

7858

xor a

7859

ld d,e

7860

ld b,h

7861

ld c,l

7862

add hl,hl

7863

rl d

7864

rla

7865

add hl,hl

7866

rl d

7867

rla

7868

add hl,bc

7869

ld b,a

7870

ld a,d

7871

adc a,e

7872

ld d,a

7873

ld a,b

7874

adc a,0

7875

add hl,hl

7876

rl d

7877

rla

7878

ld (scrap+1),de

7879

ld (scrap),hl

7880

ret

7881

7882

strip_zeroes:

7883

ld a,'0'

7884

_53:

7885

dec hl

7886

cp (hl)

7887

jr z,_53

7888

7889

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

7890

ld a,'.'

7891

cp (hl)

7892

ret z

7893

inc hl

7894

ret

7895

7896

singletostr_mul:

7897

rra

7898

call c,_54

7899

ld hl,4

7900

add hl,de

7901

ex de,hl

7902

ret

7903

_54:

7904

ld h,b

7905

ld l,c

7906

jp mulSingle

7907

mul8:

7908

;H*E => HL

7909

ld l,0

7910

ld d,l

7911

mul8_preset:

7912

sla h

7913

jr nc,$+3

7914

ld l,e

7915

add hl,hl

7916

jr nc,$+3

7917

add hl,de

7918

add hl,hl

7919

jr nc,$+3

7920

add hl,de

7921

add hl,hl

7922

jr nc,$+3

7923

add hl,de

7924

add hl,hl

7925

jr nc,$+3

7926

add hl,de

7927

add hl,hl

7928

jr nc,$+3

7929

add hl,de

7930

add hl,hl

7931

jr nc,$+3

7932

add hl,de

7933

add hl,hl

7934

ret nc

7935

add hl,de

7936

ret

7937

7938

endif

7939

7940

7941

if defined MATH_FIN

7942

7943

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

7944

; str2Single

7945

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

7946

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

7947

7948

char_NEG: equ '-'

7949

char_ENG: equ ','

7950

char_DEC: equ '.'

7951

ptr_sto: equ scrap+9

7952

7953

;;#Routines/Single Precision

7954

;;Inputs:

7955

;; HL points to the string

7956

;; BC points to where the float is output

7957

;;Output:

7958

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

7959

;;Destroys:

7960

;; 11 bytes at scrap ?

7961

7962

str2single:

7963

call pushpop

7964

push bc

7965

;Check if there is a negative sign.

7966

; Save for later

7967

; Advance ptr

7968

ld a,(hl)

7969

sub char_NEG

7970

sub 1

7971

push af

7972

jr nc,$+3

7973

inc hl

7974

;Skip all leading zeroes

7975

ld a,(hl)

7976

cp '0'

7977

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

7978

;Set exponent to 0

7979

ld b,0

7980

;Check if the next char is char_DEC

7981

sub char_DEC

7982

or a ;to reset the carry flag

7983

jr nz,_55

7984

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

7985

;Get rid of zeroes

7986

dec b

7987

_54a:

7988

inc hl

7989

ld a,(hl)

7990

cp '0'

7991

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

7992

scf

7993

_55:

7994

;Now we read in the next 8 digits

7995

ld de,scrap+3

7996

call ascii_to_uint8

7997

call ascii_to_uint8

7998

call ascii_to_uint8

7999

call ascii_to_uint8

8000

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

8001

;b is the exponent

8002

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

8003

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

8004

sbc a,a

8005

inc a

8006

ld c,a

8007

_56:

8008

ld a,(hl)

8009

cp 30h

8010

jr nz,_57

8011

inc hl

8012

ld a,b

8013

add a,c

8014

jp z,strToSingle_inf

8015

ld b,a

8016

jr _56

8017

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

8018

_57:

8019

cp char_NEG

8020

call z,str_eng_exp

8021

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

8022

ld (ptr_sto),hl

8023

ld d,100

8024

call scrap_times_256

8025

ld a,c

8026

ld (scrap+6),a

8027

call scrap_times_256

8028

ld a,c

8029

ld (scrap+5),a

8030

call scrap_times_256

8031

ld a,c

8032

ld (scrap+4),a

8033

call scrap_times_256

8034

ld a,c

8035

ld (scrap+3),a

8036

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

8037

;

8038

ld hl,(scrap+3)

8039

ld a,h

8040

or l

8041

ld hl,(scrap+5)

8042

or l

8043

or h

8044

jp z,strToSingle_zero-1

8045

ld c,$7F

8046

ld a,h

8047

or a

8048

jp m,strToSingle_normed

8049

;Will need to iterate at most three times

8050

_58:

8051

dec c

8052

ld hl,scrap+3

8053

sla (hl)

8054

inc hl

8055

rl (hl)

8056

inc hl

8057

rl (hl)

8058

inc hl

8059

adc a,a

8060

jp p,_58

8061

strToSingle_normed:

8062

;Move the number to scrap

8063

ld hl,(scrap+4)

8064

ld (scrap),hl

8065

ld l,a

8066

ld h,c

8067

sla l

8068

pop af

8069

rr l

8070

ld (scrap+2),hl

8071

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

8072

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

8073

xor a

8074

sub b

8075

ld de,pown10LUT

8076

jp p,_59

8077

ld a,b

8078

ld de,pow10LUT

8079

cp 40

8080

jp nc,strToSingle_inf+1

8081

_59:

8082

cp 40

8083

jp nc,strToSingle_zero

8084

ld hl,scrap

8085

ld b,h

8086

ld c,l

8087

call _60

8088

call _60

8089

call _60

8090

call _60

8091

call _60

8092

call _60

8093

pop de

8094

jp mov4

8095

_60:

8096

rra

8097

call c,mulSingle

8098

inc de

8099

inc de

8100

inc de

8101

inc de

8102

ret

8103

str_eng_exp:

8104

ld de,0

8105

inc hl

8106

ld a,(hl)

8107

cp char_NEG ;negative exponent?

8108

push af

8109

jr nz,$+3

8110

inc hl

8111

_61:

8112

ld a,(hl)

8113

sub 3Ah

8114

add a,10

8115

jr nc,_62

8116

inc hl

8117

push hl

8118

ld h,d

8119

ld l,e

8120

add hl,hl

8121

add hl,hl

8122

add hl,de

8123

add hl,hl

8124

add a,l

8125

ld l,a

8126

ex de,hl

8127

pop hl

8128

jp c,eng_overflow

8129

inc d

8130

dec d

8131

jp z,_61

8132

jp nz,eng_overflow

8133

_62:

8134

ld a,e

8135

cp 40

8136

jr nc,eng_overflow

8137

pop af

8138

ld a,b

8139

jr nz,_63

8140

sub e

8141

ld b,a

8142

ret

8143

_63:

8144

add a,e

8145

ld b,a

8146

ret

8147

scrap_times_256:

8148

ld e,8

8149

_64:

8150

or a

8151

ld hl,scrap

8152

call _65

8153

call _65

8154

rl c

8155

dec e

8156

jr nz,_64

8157

ret

8158

_65:

8159

call scrap_times_sub

8160

scrap_times_sub:

8161

ld a,(hl)

8162

rla

8163

cp d

8164

jr c,$+3

8165

sub d

8166

ld (hl),a

8167

inc hl

8168

ccf

8169

ret

8170

eng_overflow:

8171

pop af

8172

jr nz,strToSingle_inf

8173

pop af

8174

strToSingle_zero:

8175

ld hl,const_0

8176

pop de

8177

jp mov4

8178

strToSingle_inf:

8179

;return inf

8180

pop af

8181

ld hl,const_inf

8182

jr nc,_66

8183

ld hl,const_NegInf

8184

_66:

8185

pop de

8186

jp mov4

8187

8188

endif

8189

8190

if defined roundSingle or defined MATH_FRCSGL

8191

8192

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

8193

; int2Single

8194

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

8195

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

8196

8197

int2Single:

8198

call pushpop

8199

push bc

8200

push hl

8201

pop ix

8202

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

8203

ld h, (ix+1)

8204

ld bc, 0x1000 ; bynary digits count + sign

8205

8206

int2Single.test.zero:

8207

xor a

8208

or h ; test if hl is not zero

8209

jr nz, int2Single.test.negative

8210

or l

8211

jr nz, int2Single.test.negative

8212

ld hl, 0

8213

ld de, 0

8214

jp int2Single.save

8215

8216

int2Single.test.negative:

8217

bit 7, h ; test if hl is negative

8218

jr z, int2Single.normalize

8219

ld c, 0x80 ; sign negative

8220

ld a, h ;\

8221

cpl ; |

8222

ld h, a ; | abs(hl)

8223

ld a, l ; |

8224

cpl ; |

8225

ld l, a ;/

8226

inc hl

8227

8228

int2Single.normalize:

8229

dec b

8230

bit 7, h

8231

jr nz, int2Single.mount

8232

sla l

8233

rl h

8234

jr int2Single.normalize

8235

8236

int2Single.mount:

8237

res 7, h ; turn off upper bit

8238

8239

ld a, c ; restore sign

8240

or h ; put sign...

8241

ld h, a ; ...into upper mantissa

8242

8243

ld e, h ; sign+mantissa

8244

ld h, l ; high mantissa

8245

ld l, 0 ; low mantissa

8246

8247

ld a, b ; binary digits count

8248

or 0x80 ; exponent bias

8249

ld d, a ; exponent

8250

8251

int2Single.save:

8252

pop ix

8253

ld (ix), l ; low mantissa

8254

ld (ix+1), h ; high mantissa

8255

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

8256

ld (ix+3), d ; expoent

8257

ld (ix+4), 0

8258

ld (ix+5), 0

8259

ld (ix+6), 0

8260

ld (ix+7), 0

8261

ret

8262

8263

endif

8264

8265

if defined roundSingle or defined MATH_FRCINT

8266

8267

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

8268

; single2Int

8269

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

8270

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

8271

single2Int:

8272

;Input:

8273

; HL points to the single-precision float

8274

;Output:

8275

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

8276

; BC points to 16-bit signed integer

8277

call pushpop

8278

push bc

8279

ld e,(hl)

8280

inc hl

8281

ld d,(hl)

8282

inc hl

8283

ld a,(hl)

8284

add a,a

8285

push af

8286

scf

8287

rra

8288

ld c,a

8289

inc hl

8290

ld a,(hl)

8291

ld hl,0

8292

sub 80h

8293

jr c,no_shift_single_to_int16

8294

cp 39

8295

jr nc,no_shift_single_to_int16

8296

sub 8

8297

jr c,_67

8298

ld l,c

8299

ld c,d

8300

ld d,e

8301

ld e,h

8302

sub 8

8303

jr c,_67

8304

ld h,l

8305

ld l,c

8306

ld c,d

8307

ld d,e

8308

sub 8

8309

jr c,_67

8310

ld h,l

8311

ld l,c

8312

ld c,d

8313

sub 8

8314

jr c,_67

8315

ld h,l

8316

ld l,c

8317

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

8318

_67:

8319

add a,9

8320

_67a:

8321

ld b,a

8322

ld a,e

8323

_68:

8324

add a,a

8325

rl d

8326

rl c

8327

adc hl,hl

8328

djnz _68

8329

no_shift_single_to_int16:

8330

pop af

8331

jr nc,_69

8332

;need to negate

8333

xor a

8334

sub e

8335

ld e,0

8336

ld a,e

8337

sbc a,d

8338

ld a,e

8339

sbc a,c

8340

ld d,e

8341

ex de,hl

8342

sbc hl,de

8343

_69:

8344

pop ix

8345

ld (ix), l

8346

ld (ix+1), h

8347

ret

8348

8349

endif

8350

8351

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

8352

; Auxiliary routines

8353

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

8354

8355

str_Zero: db "0",0

8356

str_Inf: db "inf",0

8357

str_NaN: db "NaN",0

8358

8359

start_const:

8360

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

8361

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

8362

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

8363

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

8364

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

8365

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

8366

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

8367

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

8368

const_2: dw 0, 33024

8369

const_3: dw 0, 33088

8370

const_4: dw 0, 33280

8371

const_5: dw 0, 33312

8372

const_7: dw 0, 33376

8373

const_9: dw 0, 33552

8374

const_16: dw 0, 33792

8375

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

8376

const_100_inv: dw 55050, 31011

8377

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

8378

const_half_1: dw 0, 32512

8379

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

8380

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

8381

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

8382

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

8383

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

8384

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

8385

const_half_pi: dw 4059, 32841

8386

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

8387

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

8388

; db $,$,$,$

8389

end_const:

8390

sin_a1: dw 43691, 32042

8391

sin_a2: dw 34952, 30984

8392

sin_a3: dw 3329, 29520

8393

cos_a1: equ const_half_1

8394

cos_a2: dw 43691, 31530

8395

cos_a3: dw 2914, 30262

8396

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

8397

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

8398

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

8399

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

8400

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

8401

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

8402

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

8403

8404

if defined MATH_CONSTSINGLE

8405

8406

iconstSingle:

8407

ex (sp),hl

8408

ld a,(hl)

8409

inc hl

8410

ex (sp),hl

8411

constSingle:

8412

;A is the constant ID#

8413

;returns nc if failed, c otherwise

8414

;HL points to the constant

8415

cp (end_const-start_const)>>2

8416

ret nc

8417

ld hl,start_const

8418

add a,a

8419

add a,a

8420

add a,l

8421

ld l,a

8422

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

8423

; ccf

8424

; ret c

8425

; inc h

8426

;#endif

8427

scf

8428

ret

8429

8430

endif

8431

8432

;;LUTs used

8433

lut:

8434

pown10LUT:

8435

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

8436

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

8437

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

8438

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

8439

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

8440

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

8441

pow10LUT:

8442

const_10:

8443

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

8444

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

8445

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

8446

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

8447

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

8448

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

8449

8450

C_Times_BDE:

8451

;;C*BDE => CAHL

8452

;C = 0 157

8453

;C = 1 141

8454

;141+

8455

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

8456

;C>=64 115+5{0,33+{0,1}}+{0,20+{0,8}}

8457

;C>=32 95+4{0,33+{0,1}}+{0,20+{0,8}}

8458

;C>=16 75+3{0,33+{0,1}}+{0,20+{0,8}}

8459

;C>=8 55+2{0,33+{0,1}}+{0,20+{0,8}}

8460

;C>=4 35+{0,33+{0,1}}+{0,20+{0,8}}

8461

;C>=2 15+{0,20+{0,8}}

8462

;min: 141cc

8463

;max: 508cc

8464

;avg: 349.21279907227cc

8465

8466

ld a,b

8467

ld h,d

8468

ld l,e

8469

sla c

8470

jr c,mul8_24_1

8471

sla c

8472

jr c,mul8_24_2

8473

sla c

8474

jr c,mul8_24_3

8475

sla c

8476

jr c,mul8_24_4

8477

sla c

8478

jr c,mul8_24_5

8479

sla c

8480

jr c,mul8_24_6

8481

sla c

8482

jr c,mul8_24_7

8483

sla c

8484

ret c

8485

ld a,c

8486

ld h,c

8487

ld l,c

8488

ret

8489

mul8_24_1:

8490

add hl,hl

8491

rla

8492

rl c

8493

jr nc,$+7

8494

add hl,de

8495

adc a,b

8496

jr nc,$+3

8497

inc c

8498

mul8_24_2:

8499

add hl,hl

8500

rla

8501

rl c

8502

jr nc,$+7

8503

add hl,de

8504

adc a,b

8505

jr nc,$+3

8506

inc c

8507

mul8_24_3:

8508

add hl,hl

8509

rla

8510

rl c

8511

jr nc,$+7

8512

add hl,de

8513

adc a,b

8514

jr nc,$+3

8515

inc c

8516

mul8_24_4:

8517

add hl,hl

8518

rla

8519

rl c

8520

jr nc,$+7

8521

add hl,de

8522

adc a,b

8523

jr nc,$+3

8524

inc c

8525

mul8_24_5:

8526

add hl,hl

8527

rla

8528

rl c

8529

jr nc,$+7

8530

add hl,de

8531

adc a,b

8532

jr nc,$+3

8533

inc c

8534

mul8_24_6:

8535

add hl,hl

8536

rla

8537

rl c

8538

jr nc,$+7

8539

add hl,de

8540

adc a,b

8541

jr nc,$+3

8542

inc c

8543

mul8_24_7:

8544

add hl,hl

8545

rla

8546

rl c

8547

ret nc

8548

add hl,de

8549

adc a,b

8550

ret nc

8551

inc c

8552

ret

8553

8554

pushpop:

8555

;26 bytes, adds 118cc to the traditional routine

8556

ex (sp),hl

8557

push de

8558

push bc

8559

push af

8560

push hl

8561

ld hl,pushpopret

8562

ex (sp),hl

8563

push hl

8564

push af

8565

ld hl,12

8566

add hl,sp

8567

ld a,(hl)

8568

inc hl

8569

ld h,(hl)

8570

ld l,a

8571

pop af

8572

ret

8573

pushpopret:

8574

pop af

8575

pop bc

8576

pop de

8577

pop hl

8578

ret

8579

8580

mov4:

8581

ldi

8582

ldi

8583

ldi

8584

ldi

8585

ret

8586

8587

if defined MATH_FIN

8588

8589

ascii_to_uint8:

8590

;c flag means don't increment the exponent

8591

ld c,0

8592

ld a,(hl)

8593

jr c,ascii_to_uint8_noexp

8594

cp char_DEC

8595

jr z,ascii_to_uint8_noexp-2

8596

_70:

8597

sub 3Ah

8598

add a,10

8599

jr nc,ascii_to_uint8_noexp_end

8600

inc b

8601

ld c,a

8602

add a,a

8603

add a,a

8604

add a,c

8605

add a,a

8606

ld c,a

8607

inc hl

8608

_71:

8609

ld a,(hl)

8610

cp char_DEC

8611

jr z,ascii_to_uint8_noexp_2nd

8612

_72:

8613

sub 3Ah

8614

add a,10

8615

jr nc,ascii_to_uint8_noexp_end

8616

inc b

8617

add a,c

8618

inc hl

8619

ld (de),a

8620

dec de

8621

or a

8622

ret

8623

8624

inc hl

8625

ld a,(hl)

8626

ascii_to_uint8_noexp:

8627

sub 3Ah

8628

add a,10

8629

jr nc,ascii_to_uint8_noexp_end

8630

ld c,a

8631

add a,a

8632

add a,a

8633

add a,c

8634

add a,a

8635

ld c,a

8636

ascii_to_uint8_noexp_2nd:

8637

inc hl

8638

ld a,(hl)

8639

sub 3Ah

8640

add a,10

8641

jr nc,ascii_to_uint8_noexp_end

8642

add a,c

8643

inc hl

8644

jr ascii_2 ;.db $FE ;start of `cp **`, saves 1cc

8645

ascii_to_uint8_noexp_end:

8646

ld a,c

8647

ascii_2:

8648

ld (de),a

8649

dec de

8650

scf

8651

ret

8652

8653

endif

8654

8655

if defined MATH_RSUBSINGLE

8656

8657

rsubSingle:

8658

;;-x+y

8659

push af

8660

push hl

8661

push de

8662

push bc

8663

push de

8664

ld de,addend2

8665

ldi

8666

ldi

8667

ld a,(hl)

8668

xor 80h

8669

ld (de),a

8670

inc de

8671

inc hl

8672

ld a,(hl)

8673

ld (de),a

8674

pop de

8675

ld hl,addend2

8676

jp addInject ;jumps in to the addSingle routine

8677

8678

endif

8679

8680

if defined MATH_MOD1SINGLE

8681

8682

;This routine performs `x mod 1`, returning a non-negative value.

8683

;+inf -> NaN

8684

;-inf -> NaN

8685

;NaN -> NaN

8686

mod1Single:

8687

call pushpop

8688

push bc

8689

ld e,(hl)

8690

inc hl

8691

ld d,(hl)

8692

inc hl

8693

ld c,(hl)

8694

ld a,c

8695

xor 80h

8696

push af

8697

jp p,mod1Single.1

8698

ld c,a

8699

mod1Single.1:

8700

8701

inc hl

8702

ld a,(hl)

8703

ld b,a

8704

or a

8705

jr z,mod1Single_special

8706

sub $80

8707

jr c,mod1_end

8708

inc a

8709

ld b,a

8710

ld a,c

8711

ex de,hl

8712

mod1Single.2:

8713

add hl,hl

8714

rla

8715

djnz mod1Single.2

8716

ld c,a

8717

8718

;If it is zero, need to set exponent to zero and return

8719

or h

8720

or l

8721

ex de,hl

8722

jr z,mod1_end

8723

8724

;Need to normalize

8725

ld b,$7F

8726

ld a,c

8727

or a

8728

jp m,mod1_end

8729

ex de,hl

8730

mod1Single.3:

8731

dec b

8732

add hl,hl

8733

adc a,a

8734

jp p,mod1Single.3

8735

ld c,a

8736

ex de,hl

8737

mod1_end:

8738

pop af

8739

pop hl

8740

jp m,mod1Single.4

8741

;make sure it isn't zero else we need to add 1

8742

ld a,b

8743

or a

8744

jr z,mod1Single.4

8745

ld (scrap),de

8746

ld (scrap+2),bc

8747

ld b,h

8748

ld c,l

8749

ld hl,scrap

8750

ld de,const_1

8751

jp addSingle

8752

mod1Single_special:

8753

;If INF, need to return NaN instead

8754

;For 0 and NaN, just return itself :)

8755

pop af

8756

pop hl

8757

ld a,c

8758

add a,a

8759

jp p,mod1Single.4

8760

ld c,$40

8761

mod1Single.4:

8762

res 7,c

8763

ld (hl),e

8764

inc hl

8765

ld (hl),d

8766

inc hl

8767

ld (hl),c

8768

inc hl

8769

ld (hl),b

8770

ret

8771

8772

endif

8773

8774

if defined MATH_FOUT

8775

8776

; --------------------------------------------------------------

8777

; Converts a signed integer value to a zero-terminated ASCII

8778

; string representative of that value (using radix 10).

8779

; References:

8780

; Brandon Wilson WikiTI

8781

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Other:DispA#Decimal_Signed_Version

8782

; --------------------------------------------------------------

8783

; INPUTS:

8784

; HL Value to convert (two's complement integer).

8785

; DE Base address of string destination. (pointer).

8786

; --------------------------------------------------------------

8787

; OUTPUTS:

8788

; A Size of string

8789

; --------------------------------------------------------------

8790

; REGISTERS/MEMORY DESTROYED

8791

; AF HL

8792

; --------------------------------------------------------------

8793

8794

IntToStr:

8795

push de

8796

push bc

8797

8798

; Detect sign of HL.

8799

bit 7, h

8800

jr z, _DoConvert

8801

8802

; HL is negative. Output '-' to string and negate HL.

8803

ld a, '-'

8804

ld (de), a

8805

inc de

8806

8807

; Negate HL (using two's complement)

8808

xor a

8809

sub l

8810

ld l, a

8811

ld a, 0 ; Note that XOR A or SUB A would disturb CF

8812

sbc a, h

8813

ld h, a

8814

8815

; Convert HL to digit characters

8816

_DoConvert:

8817

ld b, 0 ; B will count character length of number

8818

_DoConvert.1:

8819

ld c, 10

8820

call div_hl_c; HL = HL / A, A = remainder

8821

push af

8822

inc b

8823

ld a, h

8824

or l

8825

jr nz, _DoConvert.1

8826

8827

; Retrieve digits from stack

8828

_DoConvert.2:

8829

pop af

8830

or $30

8831

ld (de), a

8832

inc de

8833

djnz _DoConvert.2

8834

8835

; Terminate string with NULL

8836

xor a

8837

ld (de), a

8838

8839

ld h, d

8840

ld l, e

8841

8842

pop bc

8843

pop de

8844

8845

sbc hl, de

8846

ld a, l ; string size

8847

8848

ret

8849

8850

endif

8851

8852

if defined MATH_FIN

8853

8854

;===============================================================

8855

; Convert a string of base-10 digits to a 16-bit value.

8856

; http://z80-heaven.wikidot.com/math#toc32

8857

;Input:

8858

; DE points to the base 10 number string in RAM.

8859

;Outputs:

8860

; HL is the 16-bit value of the number

8861

; DE points to the byte after the number

8862

; BC is HL/10

8863

; z flag reset (nz)

8864

; c flag reset (nc)

8865

;Destroys:

8866

; A (actually, add 30h and you get the ending token)

8867

;Size: 23 bytes

8868

;Speed: 104n+42+11c

8869

; n is the number of digits

8870

; c is at most n-2

8871

; at most 595 cycles for any 16-bit decimal value

8872

;===============================================================

8873

8874

StrToInt:

8875

ld hl,0 ; 10 : 210000

8876

ConvLoop: ;

8877

ld a,(de) ; 7 : 1A

8878

sub 30h ; 7 : D630

8879

cp 10 ; 7 : FE0A

8880

ret nc ;5|11 : D0

8881

inc de ; 6 : 13

8882

;

8883

ld b,h ; 4 : 44

8884

ld c,l ; 4 : 4D

8885

add hl,hl ; 11 : 29

8886

add hl,hl ; 11 : 29

8887

add hl,bc ; 11 : 09

8888

add hl,hl ; 11 : 29

8889

;

8890

add a,l ; 4 : 85

8891

ld l,a ; 4 : 6F

8892

jr nc,ConvLoop ;12|23: 30EE

8893

inc h ; --- : 24

8894

jr ConvLoop ; --- : 18EB

8895

8896

endif

8897

8898

if defined IntToStr

8899

8900

; divides hl by c

8901

; return remainder in a

8902

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division

8903

div_hl_c:

8904

push bc

8905

xor a

8906

ld b, 16

8907

div_hl_c.loop:

8908

add hl, hl

8909

rla

8910

jr c, $+5

8911

cp c

8912

jr c, $+4

8913

sub c

8914

inc l

8915

djnz div_hl_c.loop

8916

pop bc

8917

ret

8918

8919

endif

8920

8921

if defined DIV_EHL

8922

8923

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division

8924

div_ehl_d:

8925

xor a

8926

ld b, 24

8927

div_ehl_d.loop:

8928

add hl, hl

8929

rl e

8930

rla

8931

jr c, $+5

8932

cp d

8933

jr c, $+4

8934

sub d

8935

inc l

8936

djnz div_ehl_d.loop

8937

ret

8938

8939

div_dehl_c:

8940

push bc

8941

xor a

8942

ld b, 32

8943

div_dehl_c.loop:

8944

add hl, hl

8945

rl e

8946

rl d

8947

rla

8948

jr c, $+5

8949

cp c

8950

jr c, $+4

8951

sub c

8952

inc l

8953

djnz div_dehl_c.loop

8954

pop bc

8955

ret

8956

8957

endif

8958

8959

8960

8961

;---------------------------------------------------------------------------------------------------------

8962

; VARIABLES INITIALIZE

8963

;---------------------------------------------------------------------------------------------------------

8964

8965

INITIALIZE_DUMMY:

8966

xor a

8967

ld (VAR_DUMMY.COUNTER), a ; max circular queue = 8 dummys

8968

ld hl, VAR_DUMMY.DATA ; start of variable dummy circular queue

8969

ld (VAR_DUMMY.POINTER), hl

8970

ld b, VAR_DUMMY.LENGTH

8971

ld c, 0

8972

INITIALIZE_DUMMY.1:

8973

ld (hl), a

8974

inc hl

8975

djnz INITIALIZE_DUMMY.1

8976

ret

8977

8978

INITIALIZE_DATA:

8979

ld hl, DATA_ITEMS

8980

ld (BASIC_DATPTR), hl ; next DATA pointer to use by READ command

8981

ld hl, 0

8982

ld (BASIC_DATLIN), hl ; index of DATA item to use by READ command

8983

ret

8984

8985

INITIALIZE_VARIABLES:

8986

call INITIALIZE_DATA

8987

call INITIALIZE_DUMMY

8988

8989

if defined SCREEN

8990

call gfxInitSpriteCollisionTable

8991

endif

8992

8993

;if defined COMPILE_TO_ROM

8994

; ld ix, BIOS_JIFFY ; initialize rom clock

8995

; di

8996

; ld (ix), 0

8997

; ld (ix+1), 0

8998

; ei

8999

;endif

9000

9001

ld hl, IDF_5

9002

ld d, 2 ; any = default integer

9003

ld c, 0 ; variable name 1 (variable number)

9004

ld b, 0 ; variable name 2 (type flag=any)

9005

call INIT_VAR ; variable initialize

9006

ld hl, IDF_7

9007

ld d, 2 ; any = default integer

9008

ld c, 1 ; variable name 1 (variable number)

9009

ld b, 0 ; variable name 2 (type flag=any)

9010

call INIT_VAR ; variable initialize

9011

ld hl, IDF_9

9012

ld d, 2 ; any = default integer

9013

ld c, 2 ; variable name 1 (variable number)

9014

ld b, 0 ; variable name 2 (type flag=any)

9015

call INIT_VAR ; variable initialize

9016

ld hl, IDF_11

9017

ld d, 2 ; any = default integer

9018

ld c, 3 ; variable name 1 (variable number)

9019

ld b, 0 ; variable name 2 (type flag=any)

9020

call INIT_VAR ; variable initialize

9021

ld hl, IDF_13

9022

ld d, 2 ; any = default integer

9023

ld c, 4 ; variable name 1 (variable number)

9024

ld b, 0 ; variable name 2 (type flag=any)

9025

call INIT_VAR ; variable initialize

9026

ld hl, IDF_20

9027

ld d, 2 ; any = default integer

9028

ld c, 5 ; variable name 1 (variable number)

9029

ld b, 0 ; variable name 2 (type flag=any)

9030

call INIT_VAR ; variable initialize

9031

ld hl, IDF_25

9032

ld d, 2 ; any = default integer

9033

ld c, 6 ; variable name 1 (variable number)

9034

ld b, 0 ; variable name 2 (type flag=any)

9035

call INIT_VAR ; variable initialize

9036

ld hl, IDF_26

9037

ld d, 2 ; any = default integer

9038

ld c, 7 ; variable name 1 (variable number)

9039

ld b, 0 ; variable name 2 (type flag=any)

9040

call INIT_VAR ; variable initialize

9041

ld hl, IDF_30

9042

ld d, 2 ; any = default integer

9043

ld c, 8 ; variable name 1 (variable number)

9044

ld b, 0 ; variable name 2 (type flag=any)

9045

call INIT_VAR ; variable initialize

9046

ld hl, IDF_40

9047

ld d, 2 ; any = default integer

9048

ld c, 9 ; variable name 1 (variable number)

9049

ld b, 0 ; variable name 2 (type flag=any)

9050

call INIT_VAR ; variable initialize

9051

ret

9052

9053

9054

;---------------------------------------------------------------------------------------------------------

9055

; MAIN WORK AREA - LITERALS / VARIABLES / CONFIGURATIONS

9056

;---------------------------------------------------------------------------------------------------------

9057

9058

if defined COMPILE_TO_ROM

9059

9060

workAreaPad:

9061

pgmPage1.pad: equ pageSize - (workAreaPad - pgmArea)

9062

9063

if pgmPage1.pad >= 0

9064

ds pgmPage1.pad, 0

9065

;else

9066

; .WARNING "There's no free space left on program page 1"

9067

endif

9068

9069

endif

9070

9071

VAR_STACK.START: equ ramArea

9072

;VAR_STACK.END: equ VAR_STACK.START + 0x800 ; 2kb (~200 variables)

9073

9074

VAR_STACK.POINTER: equ VAR_STACK.START

9075

9076

PRINT.CRLF: db 3, 0, 0, 2

9077

dw PRINT.CRLF.DATA, 0, 0, 0

9078

PRINT.CRLF.DATA: db 13,10,0

9079

9080

PRINT.TAB: db 3, 0, 0, 1

9081

dw PRINT.TAB.DATA, 0, 0, 0

9082

PRINT.TAB.DATA: db 09,0

9083

9084

; null double

9085

LIT_NULL_DBL: dw 0, 0, 0, 0

9086

9087

; null string

9088

LIT_NULL_STR: db 0

9089

9090

; quote string

9091

LIT_QUOTE_CHAR: db '\"'

9092

9093

; logical true

9094

LIT_TRUE: db 2, 0, 0

9095

dw 0, 0xFFFF, 0, 0

9096

9097

; logical false

9098

LIT_FALSE: db 2, 0, 0

9099

dw 0, 0, 0, 0

9100

9101

9102

; numerical literal

9103

LIT_4: db 2, 0, 0

9104

dw 0, 2, 0, 0

9105

9106

; identifier X0

9107

IDF_5: equ VAR_STACK.POINTER + 0

9108

9109

; numerical literal

9110

LIT_6: db 2, 0, 0

9111

dw 0, 30, 0, 0

9112

9113

; identifier Y0

9114

IDF_7: equ VAR_STACK.POINTER + 11

9115

9116

; numerical literal

9117

LIT_8: db 2, 0, 0

9118

dw 0, 30, 0, 0

9119

9120

; identifier X1

9121

IDF_9: equ VAR_STACK.POINTER + 22

9122

9123

; numerical literal

9124

LIT_10: db 2, 0, 0

9125

dw 0, 60, 0, 0

9126

9127

; identifier Y1

9128

IDF_11: equ VAR_STACK.POINTER + 33

9129

9130

; numerical literal

9131

LIT_12: db 2, 0, 0

9132

dw 0, 60, 0, 0

9133

9134

; identifier DX

9135

IDF_13: equ VAR_STACK.POINTER + 44

9136

9137

; identifier SX

9138

IDF_20: equ VAR_STACK.POINTER + 55

9139

9140

; numerical literal

9141

LIT_21: db 2, 0, 0

9142

dw 0, 1, 0, 0

9143

9144

; numerical literal

9145

LIT_23: db 2, 0, 0

9146

dw 0, 1, 0, 0

9147

9148

; identifier DY

9149

IDF_25: equ VAR_STACK.POINTER + 66

9150

9151

; identifier SY

9152

IDF_26: equ VAR_STACK.POINTER + 77

9153

9154

; numerical literal

9155

LIT_27: db 2, 0, 0

9156

dw 0, 1, 0, 0

9157

9158

; numerical literal

9159

LIT_28: db 2, 0, 0

9160

dw 0, 1, 0, 0

9161

9162

; identifier ER

9163

IDF_30: equ VAR_STACK.POINTER + 88

9164

9165

; numerical literal

9166

LIT_31: db 2, 0, 0

9167

dw 0, 2, 0, 0

9168

9169

; numerical literal

9170

LIT_33: db 2, 0, 0

9171

dw 0, 2, 0, 0

9172

9173

; numerical literal

9174

LIT_39: db 2, 0, 0

9175

dw 0, 100, 0, 0

9176

9177

; identifier E2

9178

IDF_40: equ VAR_STACK.POINTER + 99

9179

9180

; numerical literal

9181

LIT_42: db 2, 0, 0

9182

dw 0, 90, 0, 0

9183

9184

AFTER_LAST_VARIABLE: equ VAR_STACK.POINTER + 110

9185

9186

VAR_DUMMY.START: equ AFTER_LAST_VARIABLE ; variable dummy circular queue area

9187

VAR_DUMMY.COUNTER: equ VAR_DUMMY.START ; variable dummy circular queue count

9188

VAR_DUMMY.POINTER: equ VAR_DUMMY.COUNTER + 1 ; pointer to next variable dummy

9189

VAR_DUMMY.DATA: equ VAR_DUMMY.POINTER + 2 ; first variable dummy

9190

9191

VAR_DUMMY.SIZE: equ 8

9192

VAR_DUMMY.LENGTH: equ (11 * VAR_DUMMY.SIZE)

9193

VAR_DUMMY.END: equ VAR_DUMMY.DATA + VAR_DUMMY.LENGTH

9194

VAR_STACK.END: equ VAR_DUMMY.END + 1

9195

9196

;--------------------------------------------------------

9197

; DATA SIMBOLS

9198

;--------------------------------------------------------

9199

9200

DATA_ITEMS:

9201

DATA_ITEMS_COUNT: equ 0

9202

9203

DATA_SET_ITEMS_START:

9204

DATA_SET_ITEMS_COUNT: equ 0

9205

9206

9207

;---------------------------------------------------------------------------------------------------------

9208

; PROGRAM FOOTER

9209

;---------------------------------------------------------------------------------------------------------

9210

9211

if defined COMPILE_TO_ROM

9212

9213

romPad:

9214

9215

pgmPage2.pad: equ romSize - (romPad - pgmArea)

9216

9217

if pgmPage2.pad >= 0

9218

ds pgmPage2.pad, 0

9219

9220

if pgmPage2.pad < lowLimitSize

9221

.WARNING "There's only less than 5% free space on this ROM"

9222

endif

9223

else

9224

.ERROR "There's no free space left on this ROM"

9225

endif

9226

9227

endif

9228

9229

end_file: end start_pgm ; label start is the entry point

9230

Older »