~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).

384

385

BASIC_CURLIN: equ 0xF41C ; BASIC current line number

386

BASIC_INTVAL: equ 0xFCA0 ; interval value

387

BASIC_INTCNT: equ 0xFCA2 ; interval current count

388

389

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

390

391

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

392

393

BASIC_TRPTBL_KEY: equ 0xFC4C ; 30 ON KEY GOSUB

394

BASIC_TRPTBL_STOP: equ 0xFC6A ; 3 ON STOP GOSUB

395

BASIC_TRPTBL_SPRITE: equ 0xFC6D ; 3 ON SPRITE GOSUB

396

BASIC_TRPTBL_STRIG: equ 0xFC70 ; 15 ON STRIG GOSUB

397

BASIC_TRPTBL_INTERVAL: equ 0xFC7F ; 3 ON INTERVAL GOSUB

398

BASIC_TRPTBL_OTHER: equ 0xFC82 ; 24 reserved for expansion

399

400

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

401

402

403

404

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

405

; MATH PACK ROUTINES

406

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

407

408

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

409

; SUPPORT MACROS

410

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

411

MACRO __call_bios,CALL_PARM

412

call CALL_PARM

413

ENDM

414

415

MACRO __call_basic,CALL_PARM

416

ld ix, (CALL_PARM)

417

call BIOS_BASIC

418

ENDM

419

420

MACRO push.parm

421

push hl ; save parameter

422

ENDM

423

424

MACRO pop.parm

425

pop iy ; restore PC of caller

426

pop hl ; get next parameter

427

push iy ; save PC of caller

428

ENDM

429

430

MACRO push.ret.parm

431

pop iy ; restore PC of caller

432

push hl ; save return parameter

433

push iy ; save PC of caller

434

ENDM

435

436

MACRO ret.parm

437

pop iy ; restore PC of caller

438

push hl ; save return parameter

439

push iy ; save PC of caller

440

ret ; return

441

ENDM

442

443

MACRO set.line.number, line_number

444

ld bc, line_number ; current line number

445

ld (BASIC_CURLIN), bc

446

ENDM

447

448

MACRO verify.break

449

ld a, (BIOS_INTFLG) ; verify CTRL+BREAK

450

or a

451

jp nz, end_pgm

452

ENDM

453

454

MACRO check.traps

455

ld a, (BASIC_ONGSBF) ; trap occured counter

456

or a

457

call nz, RUN_TRAPS

458

ENDM

459

460

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

461

; MSX PROGRAM HEADER

462

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

463

pgmArea: equ 0x8000 ; page 2 - program area

464

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

465

466

org pgmArea ; program rom type start address

467

db 'AB' ; rom file ID

468

dw start_pgm ; INIT

469

dw 0x0000 ; STATEMENT

470

dw 0x0000 ; DEVICE

471

dw 0x0000 ; TEXT

472

ds 6,0 ; RESERVED

473

474

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

475

; MAIN BASIC CODE

476

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

477

478

start_pgm: ; start of the program

479

call BIOS_BASIC_SLOT_ENABLE ; enable bios and basic on page 0 and 1

480

__call_bios BIOS_ERAFNK ; turn off function keys display

481

__call_bios BIOS_GICINI ; initialize sound system

482

__call_bios BIOS_INITXT ; initialize text screen

483

xor a ;

484

ld (BIOS_CLIKSW), a ; disable keyboard click

485

ld bc, 0xFFFF ;

486

ld (BASIC_CURLIN), bc ; interpreter in direct mode

487

call BASIC_TRAP_CLEAR ; clear traps work space

488

call memory.init ; initialize memory allocation

489

call INITIALIZE_VARIABLES ; initialize variables

490

491

TAG_10:

492

493

TAG_20:

494

495

TAG_25:

496

497

TAG_30:

498

499

TAG_40:

500

501

TAG_50:

502

ld hl, LIT_4 ; parameter

503

push.parm

504

call SCREEN ; action call

505

ld hl, LIT_11 ; parameter

506

push.parm

507

call COLOR_BORDER ; action call

508

ld hl, LIT_9 ; parameter

509

push.parm

510

call COLOR_BACKGROUND ; action call

511

ld hl, LIT_7 ; parameter

512

push.parm

513

call COLOR_FOREGROUND ; action call

514

call COLOR ; action call

515

ld hl, LIT_13 ; parameter

516

push.parm

517

ld hl, IDF_12 ; parameter

518

push.parm

519

call LET ; action call

520

ld hl, LIT_15 ; parameter

521

push.parm

522

ld hl, IDF_14 ; parameter

523

push.parm

524

call LET ; action call

525

526

TAG_51:

527

ld hl, LIT_17 ; parameter

528

push.parm

529

ld hl, IDF_16 ; parameter

530

push.parm

531

call LET ; action call

532

ld hl, LIT_19 ; parameter

533

push.parm

534

ld hl, IDF_18 ; parameter

535

push.parm

536

call LET ; action call

537

ld hl, LIT_21 ; parameter

538

push.parm

539

ld hl, IDF_20 ; parameter

540

push.parm

541

call LET ; action call

542

ld hl, LIT_23 ; parameter

543

push.parm

544

ld hl, IDF_22 ; parameter

545

push.parm

546

call LET ; action call

547

548

TAG_55:

549

ld hl, LIT_25 ; parameter

550

push.parm

551

ld hl, IDF_24 ; parameter

552

push.parm

553

call LET ; action call

554

ld hl, IDF_24 ; parameter

555

push.parm

556

ld hl, IDF_24 ; parameter

557

push.parm

558

call MATH.ADD ; action call

559

ld hl, IDF_24 ; parameter

560

push.parm

561

call MATH.ADD ; action call

562

ld hl, IDF_24 ; parameter

563

push.parm

564

call LET ; action call

565

call CLS ; action call

566

567

TAG_60:

568

ld hl, LIT_31 ; parameter

569

push.parm

570

ld hl, LIT_30 ; parameter

571

push.parm

572

call LOCATE ; action call

573

ld hl, LIT_33 ; parameter

574

push.parm

575

call PRINT ; action call

576

ld hl, PRINT.CRLF ; parameter

577

push.parm

578

call PRINT ; action call

579

580

TAG_61:

581

ld hl, LIT_35 ; parameter

582

push.parm

583

ld hl, LIT_34 ; parameter

584

push.parm

585

call LOCATE ; action call

586

ld hl, LIT_36 ; parameter

587

push.parm

588

call PRINT ; action call

589

ld hl, PRINT.CRLF ; parameter

590

push.parm

591

call PRINT ; action call

592

593

TAG_62:

594

ld hl, LIT_38 ; parameter

595

push.parm

596

ld hl, LIT_37 ; parameter

597

push.parm

598

call LOCATE ; action call

599

ld hl, LIT_39 ; parameter

600

push.parm

601

call PRINT ; action call

602

ld hl, PRINT.CRLF ; parameter

603

push.parm

604

call PRINT ; action call

605

606

TAG_65:

607

608

TAG_70:

609

IF_1 : ; start of IF command

610

ld hl, LIT_42 ; parameter

611

push.parm

612

call STRIG ; action call

613

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

614

or a ; cp 0 = false

615

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

616

THEN_1 : ; THEN actions

617

call CLS ; action call

618

jp TAG_90 ; go to

619

jp ENDIF_1 ; jump to END of IF command

620

ELSE_1 : ; ELSE actions

621

ENDIF_1 : ; end of IF command

622

623

TAG_80:

624

jp TAG_70 ; go to

625

626

TAG_90:

627

call BEEP ; action call

628

ld hl, LIT_48 ; parameter

629

push.parm

630

call SCREEN ; action call

631

ld hl, LIT_50 ; parameter

632

push.parm

633

call SPRITEMODE ; action call

634

call RESTORE ; action call

635

636

TAG_91:

637

call TAG_300 ; gosub

638

639

TAG_92:

640

641

TAG_93:

642

643

TAG_94:

644

FOR_1 : ; start of FOR command

645

ld hl, LIT_57 ; parameter

646

push.parm

647

ld hl, IDF_56 ; parameter

648

push.parm

649

call LET ; action call

650

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

651

FOR.STEP_1 : ; STEP action

652

ld hl, LIT_59 ; parameter

653

push.parm

654

ld hl, IDF_56 ; parameter

655

push.parm

656

call MATH.ADD ; action call

657

ld hl, IDF_56 ; parameter

658

push.parm

659

call LET ; action call

660

FOR.WHILE_1 : ; test if end of FOR

661

ld hl, IDF_56 ; parameter

662

push.parm

663

ld hl, LIT_62 ; parameter

664

push.parm

665

call BOOLEAN.LE ; action call

666

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

667

or a ; cp 0 = false

668

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

669

FOR.BODY_1 : ; start of FOR user code

670

ld hl, LIT_66 ; parameter

671

push.parm

672

call RND ; action call

673

ld hl, LIT_67 ; parameter

674

push.parm

675

call MATH.MULT ; action call

676

call INT ; action call

677

ld hl, IDF_63 ; parameter

678

push.parm

679

call LET ; action call

680

ld hl, IDF_63 ; parameter

681

push.parm

682

call PSET.COLOR ; action call

683

ld hl, LIT_73 ; parameter

684

push.parm

685

call RND ; action call

686

ld hl, LIT_74 ; parameter

687

push.parm

688

call MATH.MULT ; action call

689

call INT ; action call

690

ld hl, LIT_71 ; parameter

691

push.parm

692

call RND ; action call

693

ld hl, LIT_72 ; parameter

694

push.parm

695

call MATH.MULT ; action call

696

call INT ; action call

697

call PSET.XY ; action call

698

call PSET ; action call

699

jp FOR.STEP_1 ; repeat actions

700

ENDFOR_1 : ; END of FOR command

701

702

TAG_95:

703

call TAG_190 ; gosub

704

ld hl, LIT_80 ; parameter

705

push.parm

706

call COLOR_BORDER ; action call

707

ld hl, LIT_79 ; parameter

708

push.parm

709

call COLOR_BACKGROUND ; action call

710

ld hl, LIT_78 ; parameter

711

push.parm

712

call COLOR_FOREGROUND ; action call

713

call COLOR ; action call

714

715

TAG_100:

716

ld hl, LIT_82 ; parameter

717

push.parm

718

call STICK ; action call

719

ld hl, IDF_63 ; parameter

720

push.parm

721

call LET ; action call

722

723

TAG_110:

724

IF_2 : ; start of IF command

725

ld hl, IDF_63 ; parameter

726

push.parm

727

ld hl, LIT_83 ; parameter

728

push.parm

729

call BOOLEAN.EQ ; action call

730

ld hl, IDF_16 ; parameter

731

push.parm

732

ld hl, LIT_85 ; parameter

733

push.parm

734

call BOOLEAN.LT ; action call

735

call BOOLEAN.AND ; action call

736

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

737

or a ; cp 0 = false

738

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

739

THEN_2 : ; THEN actions

740

ld hl, IDF_16 ; parameter

741

push.parm

742

ld hl, LIT_88 ; parameter

743

push.parm

744

call MATH.ADD ; action call

745

ld hl, IDF_16 ; parameter

746

push.parm

747

call LET ; action call

748

jp ENDIF_2 ; jump to END of IF command

749

ELSE_2 : ; ELSE actions

750

ENDIF_2 : ; end of IF command

751

752

TAG_120:

753

IF_3 : ; start of IF command

754

ld hl, IDF_63 ; parameter

755

push.parm

756

ld hl, LIT_89 ; parameter

757

push.parm

758

call BOOLEAN.EQ ; action call

759

ld hl, IDF_16 ; parameter

760

push.parm

761

ld hl, LIT_90 ; parameter

762

push.parm

763

call BOOLEAN.GT ; action call

764

call BOOLEAN.AND ; action call

765

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

766

or a ; cp 0 = false

767

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

768

THEN_3 : ; THEN actions

769

ld hl, IDF_16 ; parameter

770

push.parm

771

ld hl, LIT_92 ; parameter

772

push.parm

773

call MATH.SUB ; action call

774

ld hl, IDF_16 ; parameter

775

push.parm

776

call LET ; action call

777

jp ENDIF_3 ; jump to END of IF command

778

ELSE_3 : ; ELSE actions

779

ENDIF_3 : ; end of IF command

780

781

TAG_130:

782

ld hl, LIT_97 ; parameter

783

push.parm

784

ld hl, LIT_96 ; parameter

785

push.parm

786

ld hl, IDF_18 ; parameter

787

push.parm

788

ld hl, IDF_16 ; parameter

789

push.parm

790

ld hl, LIT_95 ; parameter

791

push.parm

792

call PUT_SPRITE_COLOR ; action call

793

794

TAG_140:

795

796

TAG_150:

797

IF_4 : ; start of IF command

798

ld hl, IDF_14 ; parameter

799

push.parm

800

ld hl, LIT_98 ; parameter

801

push.parm

802

call BOOLEAN.EQ ; action call

803

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

804

or a ; cp 0 = false

805

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

806

THEN_4 : ; THEN actions

807

jp TAG_210 ; go to

808

jp ENDIF_4 ; jump to END of IF command

809

ELSE_4 : ; ELSE actions

810

ENDIF_4 : ; end of IF command

811

812

TAG_160:

813

ld hl, LIT_103 ; parameter

814

push.parm

815

ld hl, LIT_102 ; parameter

816

push.parm

817

ld hl, IDF_20 ; parameter

818

push.parm

819

ld hl, IDF_101 ; parameter

820

push.parm

821

ld hl, LIT_100 ; parameter

822

push.parm

823

call PUT_SPRITE_COLOR ; action call

824

825

TAG_165:

826

IF_5 : ; start of IF command

827

ld hl, LIT_104 ; parameter

828

push.parm

829

call STRIG ; action call

830

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

831

or a ; cp 0 = false

832

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

833

THEN_5 : ; THEN actions

834

jp TAG_50 ; go to

835

jp ENDIF_5 ; jump to END of IF command

836

ELSE_5 : ; ELSE actions

837

ENDIF_5 : ; end of IF command

838

839

TAG_170:

840

841

TAG_175:

842

jp TAG_100 ; go to

843

844

TAG_180:

845

846

TAG_181:

847

ld hl, LIT_107 ; parameter

848

push.parm

849

call COLOR_BORDER ; action call

850

call COLOR ; action call

851

ld hl, LIT_109 ; parameter

852

push.parm

853

call SET_PLAY_VOICE_1 ; action call

854

call DO_PLAY ; action call

855

ld hl, IDF_14 ; parameter

856

push.parm

857

ld hl, LIT_111 ; parameter

858

push.parm

859

call MATH.ADD ; action call

860

ld hl, IDF_14 ; parameter

861

push.parm

862

call LET ; action call

863

ld hl, IDF_12 ; parameter

864

push.parm

865

ld hl, LIT_112 ; parameter

866

push.parm

867

call MATH.ADD ; action call

868

ld hl, IDF_12 ; parameter

869

push.parm

870

call LET ; action call

871

ld hl, LIT_113 ; parameter

872

push.parm

873

call COLOR_BORDER ; action call

874

call COLOR ; action call

875

call TAG_190 ; gosub

876

ret ; return/gosub

877

878

TAG_185:

879

ld hl, LIT_118 ; parameter

880

push.parm

881

ld hl, LIT_117 ; parameter

882

push.parm

883

ld hl, IDF_20 ; parameter

884

push.parm

885

ld hl, IDF_101 ; parameter

886

push.parm

887

ld hl, LIT_116 ; parameter

888

push.parm

889

call PUT_SPRITE_COLOR ; action call

890

ld hl, LIT_119 ; parameter

891

push.parm

892

call SET_PLAY_VOICE_1 ; action call

893

call DO_PLAY ; action call

894

ld hl, IDF_14 ; parameter

895

push.parm

896

ld hl, LIT_120 ; parameter

897

push.parm

898

call MATH.SUB ; action call

899

ld hl, IDF_14 ; parameter

900

push.parm

901

call LET ; action call

902

903

TAG_190:

904

ld hl, LIT_121 ; parameter

905

push.parm

906

ld hl, IDF_20 ; parameter

907

push.parm

908

call LET ; action call

909

ld hl, LIT_122 ; parameter

910

push.parm

911

call RND ; action call

912

ld hl, LIT_123 ; parameter

913

push.parm

914

call MATH.MULT ; action call

915

ld hl, LIT_124 ; parameter

916

push.parm

917

call MATH.ADD ; action call

918

call INT ; action call

919

ld hl, IDF_101 ; parameter

920

push.parm

921

call LET ; action call

922

IF_6 : ; start of IF command

923

ld hl, IDF_101 ; parameter

924

push.parm

925

ld hl, LIT_125 ; parameter

926

push.parm

927

call MATH.MOD ; action call

928

ld hl, LIT_127 ; parameter

929

push.parm

930

call BOOLEAN.EQ ; action call

931

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

932

or a ; cp 0 = false

933

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

934

THEN_6 : ; THEN actions

935

ld hl, LIT_128 ; parameter

936

push.parm

937

ld hl, IDF_22 ; parameter

938

push.parm

939

call LET ; action call

940

jp ENDIF_6 ; jump to END of IF command

941

ELSE_6 : ; ELSE actions

942

ld hl, LIT_130 ; parameter

943

push.parm

944

ld hl, IDF_22 ; parameter

945

push.parm

946

call LET ; action call

947

ENDIF_6 : ; end of IF command

948

949

TAG_200:

950

ld hl, LIT_136 ; parameter

951

push.parm

952

call PSET.COLOR ; action call

953

ld hl, LIT_135 ; parameter

954

push.parm

955

ld hl, LIT_134 ; parameter

956

push.parm

957

ld hl, LIT_133 ; parameter

958

push.parm

959

ld hl, LIT_132 ; parameter

960

push.parm

961

call PSET.XY ; action call

962

call FBOX ; action call

963

964

TAG_205:

965

ld hl, LIT_137 ; parameter

966

push.parm

967

call COLOR_FOREGROUND ; action call

968

call COLOR ; action call

969

ld hl, LIT_139 ; parameter

970

push.parm

971

ld hl, LIT_138 ; parameter

972

push.parm

973

call LOCATE ; action call

974

ld hl, LIT_140 ; parameter

975

push.parm

976

call PRINT ; action call

977

ld hl, IDF_12 ; parameter

978

push.parm

979

call PRINT ; action call

980

ld hl, LIT_141 ; parameter

981

push.parm

982

call PRINT ; action call

983

ld hl, IDF_14 ; parameter

984

push.parm

985

call PRINT ; action call

986

ld hl, PRINT.CRLF ; parameter

987

push.parm

988

call PRINT ; action call

989

990

ret ; return/gosub

991

992

TAG_210:

993

ld hl, LIT_142 ; parameter

994

push.parm

995

call SCREEN ; action call

996

ld hl, LIT_144 ; parameter

997

push.parm

998

ld hl, LIT_143 ; parameter

999

push.parm

1000

call LOCATE ; action call

1001

ld hl, LIT_145 ; parameter

1002

push.parm

1003

call PRINT ; action call

1004

ld hl, PRINT.CRLF ; parameter

1005

push.parm

1006

call PRINT ; action call

1007

1008

TAG_215:

1009

ld hl, LIT_146 ; parameter

1010

push.parm

1011

call SET_PLAY_VOICE_1 ; action call

1012

call DO_PLAY ; action call

1013

1014

TAG_220:

1015

IF_7 : ; start of IF command

1016

ld hl, LIT_147 ; parameter

1017

push.parm

1018

call STRIG ; action call

1019

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

1020

or a ; cp 0 = false

1021

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

1022

THEN_7 : ; THEN actions

1023

call CLS ; action call

1024

jp TAG_50 ; go to

1025

jp ENDIF_7 ; jump to END of IF command

1026

ELSE_7 : ; ELSE actions

1027

jp TAG_220 ; go to

1028

ENDIF_7 : ; end of IF command

1029

1030

TAG_230:

1031

IF_8 : ; start of IF command

1032

ld hl, IDF_20 ; parameter

1033

push.parm

1034

ld hl, LIT_150 ; parameter

1035

push.parm

1036

call BOOLEAN.LT ; action call

1037

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

1038

or a ; cp 0 = false

1039

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

1040

THEN_8 : ; THEN actions

1041

ld hl, IDF_20 ; parameter

1042

push.parm

1043

ld hl, IDF_22 ; parameter

1044

push.parm

1045

call MATH.ADD ; action call

1046

ld hl, IDF_20 ; parameter

1047

push.parm

1048

call LET ; action call

1049

jp ENDIF_8 ; jump to END of IF command

1050

ELSE_8 : ; ELSE actions

1051

call TAG_185 ; gosub

1052

ENDIF_8 : ; end of IF command

1053

1054

TAG_235:

1055

ret ; return/gosub

1056

1057

TAG_300:

1058

ld hl, LIT_153 ; parameter

1059

push.parm

1060

ld hl, IDF_152 ; parameter

1061

push.parm

1062

call LET ; action call

1063

FOR_2 : ; start of FOR command

1064

ld hl, LIT_154 ; parameter

1065

push.parm

1066

ld hl, IDF_56 ; parameter

1067

push.parm

1068

call LET ; action call

1069

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

1070

FOR.STEP_2 : ; STEP action

1071

ld hl, LIT_155 ; parameter

1072

push.parm

1073

ld hl, IDF_56 ; parameter

1074

push.parm

1075

call MATH.ADD ; action call

1076

ld hl, IDF_56 ; parameter

1077

push.parm

1078

call LET ; action call

1079

FOR.WHILE_2 : ; test if end of FOR

1080

ld hl, IDF_56 ; parameter

1081

push.parm

1082

ld hl, LIT_156 ; parameter

1083

push.parm

1084

call BOOLEAN.LE ; action call

1085

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

1086

or a ; cp 0 = false

1087

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

1088

FOR.BODY_2 : ; start of FOR user code

1089

ld hl, IDF_158 ; parameter

1090

push.parm

1091

call READ ; action call

1092

ld hl, IDF_152 ; parameter

1093

push.parm

1094

ld hl, IDF_158 ; parameter

1095

push.parm

1096

call CHR ; action call

1097

call MATH.ADD ; action call

1098

ld hl, IDF_152 ; parameter

1099

push.parm

1100

call LET ; action call

1101

jp FOR.STEP_2 ; repeat actions

1102

ENDFOR_2 : ; END of FOR command

1103

1104

TAG_310:

1105

ld hl, LIT_161 ; parameter

1106

push.parm

1107

ld hl, IDF_160 ; parameter

1108

push.parm

1109

call LET ; action call

1110

FOR_3 : ; start of FOR command

1111

ld hl, LIT_162 ; parameter

1112

push.parm

1113

ld hl, IDF_56 ; parameter

1114

push.parm

1115

call LET ; action call

1116

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

1117

FOR.STEP_3 : ; STEP action

1118

ld hl, LIT_163 ; parameter

1119

push.parm

1120

ld hl, IDF_56 ; parameter

1121

push.parm

1122

call MATH.ADD ; action call

1123

ld hl, IDF_56 ; parameter

1124

push.parm

1125

call LET ; action call

1126

FOR.WHILE_3 : ; test if end of FOR

1127

ld hl, IDF_56 ; parameter

1128

push.parm

1129

ld hl, LIT_164 ; parameter

1130

push.parm

1131

call BOOLEAN.LE ; action call

1132

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

1133

or a ; cp 0 = false

1134

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

1135

FOR.BODY_3 : ; start of FOR user code

1136

ld hl, IDF_158 ; parameter

1137

push.parm

1138

call READ ; action call

1139

ld hl, IDF_160 ; parameter

1140

push.parm

1141

ld hl, IDF_158 ; parameter

1142

push.parm

1143

call CHR ; action call

1144

call MATH.ADD ; action call

1145

ld hl, IDF_160 ; parameter

1146

push.parm

1147

call LET ; action call

1148

jp FOR.STEP_3 ; repeat actions

1149

ENDFOR_3 : ; END of FOR command

1150

1151

TAG_320:

1152

ld hl, IDF_152 ; parameter

1153

push.parm

1154

ld hl, LIT_166 ; parameter

1155

push.parm

1156

call SPRITE ; action call

1157

1158

ld hl, IDF_160 ; parameter

1159

push.parm

1160

ld hl, LIT_167 ; parameter

1161

push.parm

1162

call SPRITE ; action call

1163

1164

TAG_390:

1165

ret ; return/gosub

1166

1167

TAG_399:

1168

1169

TAG_400:

1170

1171

TAG_410:

1172

1173

TAG_420:

1174

1175

TAG_430:

1176

1177

TAG_440:

1178

1179

TAG_450:

1180

1181

TAG_460:

1182

1183

TAG_470:

1184

1185

TAG_499:

1186

1187

TAG_500:

1188

1189

TAG_510:

1190

1191

TAG_520:

1192

1193

TAG_530:

1194

1195

TAG_540:

1196

1197

TAG_550:

1198

1199

TAG_560:

1200

1201

TAG_570:

1202

1203

end_pgm: __call_bios BIOS_DSPFNK ; turn on function keys display

1204

ld a, 1 ;

1205

ld (BIOS_CLIKSW), a ; enable keyboard click

1206

jp BASIC_READYR ; warm start Basic

1207

ret ; end of the program

1208

1209

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

1210

; LITERALS / VARIABLES / CONFIGURATIONS

1211

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

1212

1213

VAR_STACK.START: equ ramArea

1214

1215

; begin change

1216

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

1217

; end change

1218

1219

VAR_STACK.POINTER: equ VAR_STACK.START

1220

1221

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

1222

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

1223

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

1224

1225

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

1226

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

1227

PRINT.TAB.DATA: db 09,0

1228

1229

; null double

1230

LIT_NULL_DBL: dw 0, 0, 0, 0

1231

1232

; null string

1233

LIT_NULL_STR: db 0

1234

1235

; quote string

1236

LIT_QUOTE_CHAR: db '"'

1237

1238

; logical true

1239

LIT_TRUE: db 2, 0, 0

1240

dw 0, 0xFFFF, 0, 0

1241

1242

; logical false

1243

LIT_FALSE: db 2, 0, 0

1244

dw 0, 0, 0, 0

1245

1246

1247

; numerical literal

1248

LIT_4: db 2, 0, 0

1249

dw 0, 1, 0, 0

1250

1251

; numerical literal

1252

LIT_7: db 2, 0, 0

1253

dw 0, 15, 0, 0

1254

1255

; numerical literal

1256

LIT_9: db 2, 0, 0

1257

dw 0, 2, 0, 0

1258

1259

; numerical literal

1260

LIT_11: db 2, 0, 0

1261

dw 0, 1, 0, 0

1262

1263

; identifier P

1264

IDF_12: equ VAR_STACK.POINTER + 0

1265

1266

; numerical literal

1267

LIT_13: db 2, 0, 0

1268

dw 0, 0, 0, 0

1269

1270

; identifier E

1271

IDF_14: equ VAR_STACK.POINTER + 11

1272

1273

; numerical literal

1274

LIT_15: db 2, 0, 0

1275

dw 0, 10, 0, 0

1276

1277

; identifier X

1278

IDF_16: equ VAR_STACK.POINTER + 22

1279

1280

; numerical literal

1281

LIT_17: db 2, 0, 0

1282

dw 0, 150, 0, 0

1283

1284

; identifier Y

1285

IDF_18: equ VAR_STACK.POINTER + 33

1286

1287

; numerical literal

1288

LIT_19: db 2, 0, 0

1289

dw 0, 150, 0, 0

1290

1291

; identifier MY

1292

IDF_20: equ VAR_STACK.POINTER + 44

1293

1294

; numerical literal

1295

LIT_21: db 2, 0, 0

1296

dw 0, 1, 0, 0

1297

1298

; identifier F

1299

IDF_22: equ VAR_STACK.POINTER + 55

1300

1301

; numerical literal

1302

LIT_23: db 2, 0, 0

1303

dw 0, 3, 0, 0

1304

1305

; identifier A$

1306

IDF_24: equ VAR_STACK.POINTER + 66

1307

1308

; string literal

1309

LIT_25: db 3, 0, 0, 17

1310

dw LIT_25_DATA, 0, 0

1311

db 0

1312

LIT_25_DATA: db "O4L8EBGBEAO5C#O4A", 0

1313

1314

; numerical literal

1315

LIT_30: db 2, 0, 0

1316

dw 0, 10, 0, 0

1317

1318

; numerical literal

1319

LIT_31: db 2, 0, 0

1320

dw 0, 10, 0, 0

1321

1322

; string literal

1323

LIT_33: db 3, 0, 0, 12

1324

dw LIT_33_DATA, 0, 0

1325

db 0

1326

LIT_33_DATA: db "CATA-METEORO", 0

1327

1328

; numerical literal

1329

LIT_34: db 2, 0, 0

1330

dw 0, 10, 0, 0

1331

1332

; numerical literal

1333

LIT_35: db 2, 0, 0

1334

dw 0, 11, 0, 0

1335

1336

; string literal

1337

LIT_36: db 3, 0, 0, 12

1338

dw LIT_36_DATA, 0, 0

1339

db 0

1340

LIT_36_DATA: db "************", 0

1341

1342

; numerical literal

1343

LIT_37: db 2, 0, 0

1344

dw 0, 8, 0, 0

1345

1346

; numerical literal

1347

LIT_38: db 2, 0, 0

1348

dw 0, 120, 0, 0

1349

1350

; string literal

1351

LIT_39: db 3, 0, 0, 16

1352

dw LIT_39_DATA, 0, 0

1353

db 0

1354

LIT_39_DATA: db "CLUBE MSX - 2019", 0

1355

1356

; numerical literal

1357

LIT_42: db 2, 0, 0

1358

dw 0, 0, 0, 0

1359

1360

; numerical literal

1361

LIT_45: db 2, 0, 0

1362

dw 0, 90, 0, 0

1363

1364

; numerical literal

1365

LIT_46: db 2, 0, 0

1366

dw 0, 70, 0, 0

1367

1368

; numerical literal

1369

LIT_48: db 2, 0, 0

1370

dw 0, 5, 0, 0

1371

1372

; numerical literal

1373

LIT_50: db 2, 0, 0

1374

dw 0, 1, 0, 0

1375

1376

; numerical literal

1377

LIT_53: db 2, 0, 0

1378

dw 0, 300, 0, 0

1379

1380

; identifier I

1381

IDF_56: equ VAR_STACK.POINTER + 77

1382

1383

; numerical literal

1384

LIT_57: db 2, 0, 0

1385

dw 0, 0, 0, 0

1386

1387

; numerical literal

1388

LIT_59: db 2, 0, 0

1389

dw 0, 1, 0, 0

1390

1391

; numerical literal

1392

LIT_62: db 2, 0, 0

1393

dw 0, 30, 0, 0

1394

1395

; identifier C%

1396

IDF_63: equ VAR_STACK.POINTER + 88

1397

1398

; numerical literal

1399

LIT_66: db 2, 0, 0

1400

dw 0, 1, 0, 0

1401

1402

; numerical literal

1403

LIT_67: db 2, 0, 0

1404

dw 0, 15, 0, 0

1405

1406

; numerical literal

1407

LIT_71: db 2, 0, 0

1408

dw 0, 1, 0, 0

1409

1410

; numerical literal

1411

LIT_72: db 2, 0, 0

1412

dw 0, 250, 0, 0

1413

1414

; numerical literal

1415

LIT_73: db 2, 0, 0

1416

dw 0, 1, 0, 0

1417

1418

; numerical literal

1419

LIT_74: db 2, 0, 0

1420

dw 0, 150, 0, 0

1421

1422

; numerical literal

1423

LIT_77: db 2, 0, 0

1424

dw 0, 190, 0, 0

1425

1426

; numerical literal

1427

LIT_78: db 2, 0, 0

1428

dw 0, 15, 0, 0

1429

1430

; numerical literal

1431

LIT_79: db 2, 0, 0

1432

dw 0, 2, 0, 0

1433

1434

; numerical literal

1435

LIT_80: db 2, 0, 0

1436

dw 0, 1, 0, 0

1437

1438

; numerical literal

1439

LIT_82: db 2, 0, 0

1440

dw 0, 0, 0, 0

1441

1442

; numerical literal

1443

LIT_83: db 2, 0, 0

1444

dw 0, 3, 0, 0

1445

1446

; numerical literal

1447

LIT_85: db 2, 0, 0

1448

dw 0, 280, 0, 0

1449

1450

; numerical literal

1451

LIT_88: db 2, 0, 0

1452

dw 0, 4, 0, 0

1453

1454

; numerical literal

1455

LIT_89: db 2, 0, 0

1456

dw 0, 7, 0, 0

1457

1458

; numerical literal

1459

LIT_90: db 2, 0, 0

1460

dw 0, 4, 0, 0

1461

1462

; numerical literal

1463

LIT_92: db 2, 0, 0

1464

dw 0, 4, 0, 0

1465

1466

; numerical literal

1467

LIT_95: db 2, 0, 0

1468

dw 0, 1, 0, 0

1469

1470

; numerical literal

1471

LIT_96: db 2, 0, 0

1472

dw 0, 15, 0, 0

1473

1474

; numerical literal

1475

LIT_97: db 2, 0, 0

1476

dw 0, 1, 0, 0

1477

1478

; numerical literal

1479

LIT_98: db 2, 0, 0

1480

dw 0, 0, 0, 0

1481

1482

; numerical literal

1483

LIT_99: db 2, 0, 0

1484

dw 0, 210, 0, 0

1485

1486

; numerical literal

1487

LIT_100: db 2, 0, 0

1488

dw 0, 0, 0, 0

1489

1490

; identifier MX

1491

IDF_101: equ VAR_STACK.POINTER + 99

1492

1493

; numerical literal

1494

LIT_102: db 2, 0, 0

1495

dw 0, 8, 0, 0

1496

1497

; numerical literal

1498

LIT_103: db 2, 0, 0

1499

dw 0, 0, 0, 0

1500

1501

; numerical literal

1502

LIT_104: db 2, 0, 0

1503

dw 0, 0, 0, 0

1504

1505

; numerical literal

1506

LIT_105: db 2, 0, 0

1507

dw 0, 50, 0, 0

1508

1509

; numerical literal

1510

LIT_106: db 2, 0, 0

1511

dw 0, 100, 0, 0

1512

1513

; numerical literal

1514

LIT_107: db 2, 0, 0

1515

dw 0, 10, 0, 0

1516

1517

; string literal

1518

LIT_109: db 3, 0, 0, 5

1519

dw LIT_109_DATA, 0, 0

1520

db 0

1521

LIT_109_DATA: db "L8DC-", 0

1522

1523

; numerical literal

1524

LIT_111: db 2, 0, 0

1525

dw 0, 1, 0, 0

1526

1527

; numerical literal

1528

LIT_112: db 2, 0, 0

1529

dw 0, 10, 0, 0

1530

1531

; numerical literal

1532

LIT_113: db 2, 0, 0

1533

dw 0, 1, 0, 0

1534

1535

; numerical literal

1536

LIT_114: db 2, 0, 0

1537

dw 0, 190, 0, 0

1538

1539

; numerical literal

1540

LIT_116: db 2, 0, 0

1541

dw 0, 0, 0, 0

1542

1543

; numerical literal

1544

LIT_117: db 2, 0, 0

1545

dw 0, 3, 0, 0

1546

1547

; numerical literal

1548

LIT_118: db 2, 0, 0

1549

dw 0, 0, 0, 0

1550

1551

; string literal

1552

LIT_119: db 3, 0, 0, 5

1553

dw LIT_119_DATA, 0, 0

1554

db 0

1555

LIT_119_DATA: db "L8C+C", 0

1556

1557

; numerical literal

1558

LIT_120: db 2, 0, 0

1559

dw 0, 1, 0, 0

1560

1561

; numerical literal

1562

LIT_121: db 2, 0, 0

1563

dw 0, 1, 0, 0

1564

1565

; numerical literal

1566

LIT_122: db 2, 0, 0

1567

dw 0, 1, 0, 0

1568

1569

; numerical literal

1570

LIT_123: db 2, 0, 0

1571

dw 0, 250, 0, 0

1572

1573

; numerical literal

1574

LIT_124: db 2, 0, 0

1575

dw 0, 2, 0, 0

1576

1577

; numerical literal

1578

LIT_125: db 2, 0, 0

1579

dw 0, 2, 0, 0

1580

1581

; numerical literal

1582

LIT_127: db 2, 0, 0

1583

dw 0, 1, 0, 0

1584

1585

; numerical literal

1586

LIT_128: db 2, 0, 0

1587

dw 0, 6, 0, 0

1588

1589

; numerical literal

1590

LIT_130: db 2, 0, 0

1591

dw 0, 3, 0, 0

1592

1593

; numerical literal

1594

LIT_132: db 2, 0, 0

1595

dw 0, 1, 0, 0

1596

1597

; numerical literal

1598

LIT_133: db 2, 0, 0

1599

dw 0, 180, 0, 0

1600

1601

; numerical literal

1602

LIT_134: db 2, 0, 0

1603

dw 0, 200, 0, 0

1604

1605

; numerical literal

1606

LIT_135: db 2, 0, 0

1607

dw 0, 200, 0, 0

1608

1609

; numerical literal

1610

LIT_136: db 2, 0, 0

1611

dw 0, 2, 0, 0

1612

1613

; numerical literal

1614

LIT_137: db 2, 0, 0

1615

dw 0, 15, 0, 0

1616

1617

; numerical literal

1618

LIT_138: db 2, 0, 0

1619

dw 0, 2, 0, 0

1620

1621

; numerical literal

1622

LIT_139: db 2, 0, 0

1623

dw 0, 180, 0, 0

1624

1625

; string literal

1626

LIT_140: db 3, 0, 0, 7

1627

dw LIT_140_DATA, 0, 0

1628

db 0

1629

LIT_140_DATA: db "PLACAR:", 0

1630

1631

; string literal

1632

LIT_141: db 3, 0, 0, 14

1633

dw LIT_141_DATA, 0, 0

1634

db 0

1635

LIT_141_DATA: db " ENERGIA:", 0

1636

1637

; numerical literal

1638

LIT_142: db 2, 0, 0

1639

dw 0, 1, 0, 0

1640

1641

; numerical literal

1642

LIT_143: db 2, 0, 0

1643

dw 0, 10, 0, 0

1644

1645

; numerical literal

1646

LIT_144: db 2, 0, 0

1647

dw 0, 10, 0, 0

1648

1649

; string literal

1650

LIT_145: db 3, 0, 0, 12

1651

dw LIT_145_DATA, 0, 0

1652

db 0

1653

LIT_145_DATA: db "FIM DE JOGO!", 0

1654

1655

; string literal

1656

LIT_146: db 3, 0, 0, 56

1657

dw LIT_146_DATA, 0, 0

1658

db 0

1659

LIT_146_DATA: db "A3R15A4R15A8R15A3R15O5C5O4R15B8R15B5R15A8R15A5R15A8R15A1", 0

1660

1661

; numerical literal

1662

LIT_147: db 2, 0, 0

1663

dw 0, 0, 0, 0

1664

1665

; numerical literal

1666

LIT_148: db 2, 0, 0

1667

dw 0, 50, 0, 0

1668

1669

; numerical literal

1670

LIT_149: db 2, 0, 0

1671

dw 0, 220, 0, 0

1672

1673

; numerical literal

1674

LIT_150: db 2, 0, 0

1675

dw 0, 150, 0, 0

1676

1677

; numerical literal

1678

LIT_151: db 2, 0, 0

1679

dw 0, 185, 0, 0

1680

1681

; identifier M$

1682

IDF_152: equ VAR_STACK.POINTER + 110

1683

1684

; string literal

1685

LIT_153: db 3, 0, 0, 0

1686

dw LIT_153_DATA, 0, 0

1687

db 0

1688

LIT_153_DATA: db "", 0

1689

1690

; numerical literal

1691

LIT_154: db 2, 0, 0

1692

dw 0, 1, 0, 0

1693

1694

; numerical literal

1695

LIT_155: db 2, 0, 0

1696

dw 0, 1, 0, 0

1697

1698

; numerical literal

1699

LIT_156: db 2, 0, 0

1700

dw 0, 8, 0, 0

1701

1702

; identifier S

1703

IDF_158: equ VAR_STACK.POINTER + 121

1704

1705

; identifier CM$

1706

IDF_160: equ VAR_STACK.POINTER + 132

1707

1708

; string literal

1709

LIT_161: db 3, 0, 0, 0

1710

dw LIT_161_DATA, 0, 0

1711

db 0

1712

LIT_161_DATA: db "", 0

1713

1714

; numerical literal

1715

LIT_162: db 2, 0, 0

1716

dw 0, 1, 0, 0

1717

1718

; numerical literal

1719

LIT_163: db 2, 0, 0

1720

dw 0, 1, 0, 0

1721

1722

; numerical literal

1723

LIT_164: db 2, 0, 0

1724

dw 0, 8, 0, 0

1725

1726

; numerical literal

1727

LIT_166: db 2, 0, 0

1728

dw 0, 0, 0, 0

1729

1730

; numerical literal

1731

LIT_167: db 2, 0, 0

1732

dw 0, 1, 0, 0

1733

1734

; numerical literal

1735

LIT_169: db 2, 0, 0

1736

dw 0, &x00011000, 0, 0

1737

1738

; numerical literal

1739

LIT_170: db 2, 0, 0

1740

dw 0, &x00100100, 0, 0

1741

1742

; numerical literal

1743

LIT_171: db 2, 0, 0

1744

dw 0, &x01110110, 0, 0

1745

1746

; numerical literal

1747

LIT_172: db 2, 0, 0

1748

dw 0, &x11011111, 0, 0

1749

1750

; numerical literal

1751

LIT_173: db 2, 0, 0

1752

dw 0, &x11001111, 0, 0

1753

1754

; numerical literal

1755

LIT_174: db 2, 0, 0

1756

dw 0, &x01100110, 0, 0

1757

1758

; numerical literal

1759

LIT_175: db 2, 0, 0

1760

dw 0, &x00110100, 0, 0

1761

1762

; numerical literal

1763

LIT_176: db 2, 0, 0

1764

dw 0, &x00011000, 0, 0

1765

1766

; numerical literal

1767

LIT_177: db 2, 0, 0

1768

dw 0, &x10000001, 0, 0

1769

1770

; numerical literal

1771

LIT_178: db 2, 0, 0

1772

dw 0, &x10000001, 0, 0

1773

1774

; numerical literal

1775

LIT_179: db 2, 0, 0

1776

dw 0, &x10000001, 0, 0

1777

1778

; numerical literal

1779

LIT_180: db 2, 0, 0

1780

dw 0, &x11000011, 0, 0

1781

1782

; numerical literal

1783

LIT_181: db 2, 0, 0

1784

dw 0, &x11000011, 0, 0

1785

1786

; numerical literal

1787

LIT_182: db 2, 0, 0

1788

dw 0, &x11111111, 0, 0

1789

1790

; numerical literal

1791

LIT_183: db 2, 0, 0

1792

dw 0, &x11111111, 0, 0

1793

1794

; numerical literal

1795

LIT_184: db 2, 0, 0

1796

dw 0, &x11000011, 0, 0

1797

1798

AFTER_LAST_VARIABLE: equ VAR_STACK.POINTER + 143

1799

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

1800

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

1801

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

1802

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

1803

1804

; begin change

1805

VAR_DUMMY.SIZE: equ 8

1806

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

1807

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

1808

VAR_STACK.END: equ VAR_DUMMY.END + 1

1809

; end change

1810

1811

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

1812

; DATA SIMBOLS

1813

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

1814

1815

DATA_ITEMS:

1816

dw LIT_169

1817

dw LIT_170

1818

dw LIT_171

1819

dw LIT_172

1820

dw LIT_173

1821

dw LIT_174

1822

dw LIT_175

1823

dw LIT_176

1824

dw LIT_177

1825

dw LIT_178

1826

dw LIT_179

1827

dw LIT_180

1828

dw LIT_181

1829

dw LIT_182

1830

dw LIT_183

1831

dw LIT_184

1832

DATA_ITEMS_COUNT: equ 16

1833

1834

1835

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

1836

; MSX BASIC KEYWORDS

1837

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

1838

1839

; keyword

1840

LET:

1841

1842

; out IX = variable assigned address

1843

pop.parm ; get variable address parameter

1844

push hl ; just to transfer hl to ix

1845

pop ix ;

1846

ld a, (ix) ; get variable type

1847

cp 3 ; test if string

1848

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

1849

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

1850

or a ; cp 0

1851

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

1852

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

1853

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

1854

push ix ; save variable address

1855

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

1856

pop ix ;

1857

call memory.free ; free memory

1858

pop ix ; restore variable address

1859

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

1860

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

1861

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

1862

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

1863

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

1864

pop de ;

1865

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

1866

inc de ; go to variable data area

1867

inc de ;

1868

inc hl ; go to data data area

1869

inc hl ;

1870

ld bc, 8 ; data = 8 bytes

1871

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

1872

ld a, (ix) ; get variable type

1873

cp 3 ; test if string

1874

ret nz ; if not string, return

1875

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

1876

LET.FIXED: push ix ; save variable destination address

1877

push hl ; save variable source address

1878

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

1879

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

1880

pop de

1881

pop ix ; restore variable address

1882

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

1883

cp 3 ; test if string

1884

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

1885

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

1886

cp 3 ; test if string

1887

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

1888

inc de

1889

inc de

1890

inc de

1891

ld a, (de)

1892

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

1893

jr LET.FIX2

1894

LET.FIX1: push hl

1895

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

1896

pop hl

1897

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

1898

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

1899

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

1900

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

1901

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

1902

pop de ;

1903

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

1904

inc de ;

1905

inc de ;

1906

ld bc, 8 ; data = 8 bytes

1907

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

1908

ret ;

1909

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

1910

or a ; cp 0 - test if null

1911

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

1912

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

1913

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

1914

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

1915

ret ;

1916

LET.ALLOC: push ix ; save variable address

1917

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

1918

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

1919

push hl ; save copy from address

1920

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

1921

ld b, 0 ;

1922

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

1923

push bc ; save variable lenght + 1

1924

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

1925

jp z, memory.error

1926

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

1927

pop de ;

1928

pop bc ; restore bytes to be copied

1929

pop hl ; restore copy from string address

1930

push de ; save copy to address

1931

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

1932

; begin changed

1933

;xor a

1934

;ld (de), a

1935

; end changed

1936

pop de ; restore copy to address

1937

pop ix ; restore variable address

1938

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

1939

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

1940

ret ; variable assigned

1941

1942

; keyword

1943

BOOLEAN.IF:

1944

1945

pop.parm ; get parameter boolean result in hl

1946

push hl ; ix = hl

1947

pop ix ;

1948

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

1949

ret ;

1950

1951

; keyword

1952

SCREEN:

1953

1954

pop.parm ; get first parameter

1955

call CAST_TO.INT ;

1956

call GET_INT.VALUE ; output BC with integer value

1957

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

1958

cp 9

1959

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

1960

ld a, 8 ; else, fix to 8

1961

SCREEN.1:

1962

jp gfxSetScreenMode

1963

1964

; keyword

1965

COLOR:

1966

1967

;call gfxSetColor

1968

__call_bios BIOS_CHGCLR ; change VDP colors

1969

ret ;

1970

1971

; keyword

1972

COLOR_FOREGROUND:

1973

1974

pop.parm ; get first parameter

1975

call CAST_TO.INT ;

1976

call GET_INT.VALUE ; output BC with integer value

1977

ld a, c ; A = pixel color

1978

;call gfxSetForeColor

1979

ld (BIOS_FORCLR), a ; foreground color

1980

ld (BIOS_ATRBYT), a

1981

ret ;

1982

1983

; keyword

1984

COLOR_BACKGROUND:

1985

1986

pop.parm ; get first parameter

1987

call CAST_TO.INT ;

1988

call GET_INT.VALUE ; output BC with integer value

1989

ld a, c ; A = pixel color

1990

;call gfxSetBackColor

1991

ld (BIOS_BAKCLR), a ; foreground color

1992

ret ;

1993

1994

; keyword

1995

COLOR_BORDER:

1996

1997

pop.parm ; get first parameter

1998

call CAST_TO.INT ;

1999

call GET_INT.VALUE ; output BC with integer value

2000

ld a, c ; A = pixel color

2001

;call gfxSetBorderColor

2002

ld (BIOS_BDRCLR), a ; border color

2003

ret ;

2004

2005

; keyword

2006

MATH.ADD:

2007

2008

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

2009

ld a, (BASIC_VALTYP) ;

2010

cp 2 ; test if integer

2011

jp z, MATH.ADD.INT ;

2012

cp 3 ; test if string

2013

jp z, STRING.CONCAT ;

2014

cp 4 ; test if single

2015

jp z, MATH.ADD.SGL ;

2016

jp MATH.ADD.DBL ; it is a double

2017

2018

; keyword

2019

CLS:

2020

2021

xor a ; reset Z flag

2022

__call_bios BIOS_CLS ; clear screen

2023

ret ;

2024

2025

; keyword

2026

LOCATE:

2027

2028

pop.parm ; get first parameter

2029

call CAST_TO.INT ;

2030

call GET_INT.VALUE ; output BC with integer value

2031

pop.parm ; get second parameter

2032

push bc ; save first parameter as integer

2033

call CAST_TO.INT ;

2034

call GET_INT.VALUE ; output BC with integer value

2035

inc c ; BASIC has start position on 0,0 instead of 1,1 of BIOS

2036

ld l, c ; set second parameter (L = Y position)

2037

pop bc ; restore first parameter as integer

2038

inc c ; BASIC has start position on 0,0 instead of 1,1 of BIOS

2039

ld h, c ; set first parameter (H = X position)

2040

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

2041

cp 2 ;

2042

jr nc, LOCATE.G ; jump if graphic screen mode (not a < 2)

2043

LOCATE.T: __call_bios BIOS_POSIT ; H = X, L = Y

2044

ret ;

2045

LOCATE.G: ld b, 0 ;

2046

ld c, h ;

2047

ld d, 0 ;

2048

ld e, l ;

2049

ld (BIOS_GRPACX), bc ;

2050

ld (BIOS_GRPACY), de ;

2051

__call_bios BIOS_SCALXY ; BC = X, DE = Y

2052

__call_bios BIOS_MAPXYC ; BC = X, DE = Y

2053

ret ;

2054

2055

; keyword

2056

PRINT:

2057

2058

pop.parm ; get first parameter

2059

call CAST_TO.STR ;

2060

jp STRING.PRINT ;

2061

2062

; keyword

2063

STRIG:

2064

2065

pop.parm ; get first parameter

2066

call CAST_TO.INT ;

2067

call GET_INT.VALUE ; output BC with integer value

2068

ld a, c

2069

__call_bios BIOS_GTTRIG

2070

or a ; cp 0

2071

jp z, BOOLEAN.RET.FALSE ;

2072

jp BOOLEAN.RET.TRUE

2073

2074

; keyword

2075

GOTO:

2076

; abstract virtual GOTO

2077

; keyword

2078

BEEP:

2079

2080

__call_basic BASIC_BEEP ; play a beep in the system speaker

2081

ret ;

2082

2083

; keyword

2084

SPRITEMODE:

2085

2086

pop.parm ; get first parameter

2087

call CAST_TO.INT ;

2088

call GET_INT.VALUE ; output BC with integer value

2089

ld a, c ; A = sprite mode (0 to 3)

2090

jp gfxSetSpriteMode

2091

2092

; keyword

2093

RESTORE:

2094

2095

ld hl, DATA_ITEMS

2096

ld (BASIC_DATPTR), hl ; data items pointer

2097

ld hl, 0

2098

ld (BASIC_DATLIN), hl ; data items index

2099

ret

2100

2101

; keyword

2102

GOSUB:

2103

; abstract virtual GOSUB

2104

; keyword

2105

FOR:

2106

; abstract virtual FOR

2107

; keyword

2108

BOOLEAN.LE:

2109

2110

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

2111

ld a, (BASIC_VALTYP) ;

2112

cp 2 ; test if integer

2113

jp z, BOOLEAN.LE.INT ;

2114

cp 3 ; test if string

2115

jp z, BOOLEAN.LE.STR ;

2116

cp 4 ; test if single

2117

jp z, BOOLEAN.LE.SGL ;

2118

jp BOOLEAN.LE.DBL ; it is a double

2119

2120

; keyword

2121

INT:

2122

2123

pop.parm ; get first parameter in HL

2124

call CAST_TO.INT ;

2125

call GET_INT.VALUE ; put parameter into BC

2126

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

2127

ret.parm ;

2128

2129

; keyword

2130

RND:

2131

2132

pop.parm ; get parameter

2133

call COPY_TO.DAC ; put in DAC

2134

and 12 ; test if single/double

2135

jr nz, RND.1 ; if already double

2136

__call_bios MATH_FRCDBL ; convert DAC to double

2137

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

2138

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

2139

2140

; keyword

2141

MATH.MULT:

2142

2143

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

2144

ld a, (BASIC_VALTYP) ;

2145

cp 2 ; test if integer

2146

jp z, MATH.MULT.INT ;

2147

cp 3 ; test if string

2148

jp z, MATH.ERROR ;

2149

cp 4 ; test if single

2150

jp z, MATH.MULT.SGL ;

2151

jp MATH.MULT.DBL ; it is a double

2152

2153

; keyword

2154

PSET:

2155

2156

jp gfxSetPixel

2157

2158

; keyword

2159

PSET.XY:

2160

2161

pop.parm ; get first parameter

2162

call CAST_TO.INT ;

2163

call GET_INT.VALUE ; output BC with integer value

2164

ld (BIOS_GRPACX), bc ; X

2165

pop.parm ; get second parameter

2166

call CAST_TO.INT ;

2167

call GET_INT.VALUE ; output BC with integer value

2168

ld (BIOS_GRPACY), bc ; Y

2169

jp gfxRefreshXY

2170

2171

; keyword

2172

PSET.COLOR:

2173

2174

pop.parm ; get first parameter

2175

call CAST_TO.INT ;

2176

call GET_INT.VALUE ; output BC with integer value

2177

ld a, c

2178

call gfxSetForeColor

2179

jp gfxSetColor

2180

2181

; keyword

2182

2183

; abstract virtual NEXT

2184

; keyword

2185

STICK:

2186

2187

pop.parm ; get first parameter

2188

call CAST_TO.INT ;

2189

call GET_INT.VALUE ; output BC with integer value

2190

ld a, c

2191

__call_bios BIOS_GTSTCK

2192

ld b, 0 ;

2193

ld c, a ;

2194

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

2195

ret.parm ;

2196

2197

; keyword

2198

BOOLEAN.EQ:

2199

2200

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

2201

ld a, (BASIC_VALTYP) ;

2202

cp 2 ; test if integer

2203

jp z, BOOLEAN.EQ.INT ;

2204

cp 3 ; test if string

2205

jp z, BOOLEAN.EQ.STR ;

2206

cp 4 ; test if single

2207

jp z, BOOLEAN.EQ.SGL ;

2208

jp BOOLEAN.EQ.DBL ; it is a double

2209

2210

; keyword

2211

BOOLEAN.LT:

2212

2213

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

2214

ld a, (BASIC_VALTYP) ;

2215

cp 2 ; test if integer

2216

jp z, BOOLEAN.LT.INT ;

2217

cp 3 ; test if string

2218

jp z, BOOLEAN.LT.STR ;

2219

cp 4 ; test if single

2220

jp z, BOOLEAN.LT.SGL ;

2221

jp BOOLEAN.LT.DBL ; it is a double

2222

2223

; keyword

2224

BOOLEAN.AND:

2225

2226

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

2227

ld a, (BASIC_VALTYP) ;

2228

cp 2 ; test if integer

2229

jp z, BOOLEAN.AND.INT ;

2230

jp MATH.ERROR ; it is a double

2231

2232

; keyword

2233

BOOLEAN.GT:

2234

2235

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

2236

ld a, (BASIC_VALTYP) ;

2237

cp 2 ; test if integer

2238

jp z, BOOLEAN.GT.INT ;

2239

cp 3 ; test if string

2240

jp z, BOOLEAN.GT.STR ;

2241

cp 4 ; test if single

2242

jp z, BOOLEAN.GT.SGL ;

2243

jp BOOLEAN.GT.DBL ; it is a double

2244

2245

; keyword

2246

MATH.SUB:

2247

2248

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

2249

ld a, (BASIC_VALTYP) ;

2250

cp 2 ; test if integer

2251

jp z, MATH.SUB.INT ;

2252

cp 3 ; test if string

2253

jp z, MATH.ERROR ;

2254

cp 4 ; test if single

2255

jp z, MATH.SUB.SGL ;

2256

jp MATH.SUB.DBL ; it is a double

2257

2258

; keyword

2259

PUT_SPRITE_COLOR:

2260

2261

pop.parm ; get sprite number

2262

call CAST_TO.INT ;

2263

call GET_INT.VALUE ; output BC with integer value

2264

ld (GFX_TEMP), bc ; sprite number

2265

2266

pop.parm ; get X

2267

call CAST_TO.INT ;

2268

call GET_INT.VALUE ; output BC with integer value

2269

ld (GFX_TEMP1), bc ; X

2270

2271

pop.parm ; get Y

2272

call CAST_TO.INT ;

2273

call GET_INT.VALUE ; output BC with integer value

2274

ld (GFX_TEMP2), bc ; Y

2275

2276

pop.parm ; get color

2277

call CAST_TO.INT ;

2278

call GET_INT.VALUE ; output BC with integer value

2279

ld (GFX_TEMP3), bc ; color

2280

2281

ld bc, (GFX_TEMP2)

2282

ld a, (GFX_TEMP1)

2283

ld b, a

2284

ld a, (GFX_TEMP)

2285

call gfxSetSpriteXY

2286

2287

ld a, (GFX_TEMP)

2288

ld bc, (GFX_TEMP3)

2289

call gfxSetSpriteColorInt

2290

2291

ret

2292

2293

; keyword

2294

SET_PLAY_VOICE_1:

2295

2296

ld a, 0

2297

jp SET_PLAY_VOICE

2298

2299

; keyword

2300

DO_PLAY:

2301

2302

ld HL, 0x752E

2303

ld (BIOS_MCLTAB),HL

2304

ld a, 1

2305

ld (BIOS_MCLFLG),A

2306

ld hl, BIOS_TEMP ; voice count

2307

ld a, 3

2308

sub (hl)

2309

dec a

2310

ld (BIOS_PRSCNT), a

2311

xor a

2312

ld (BIOS_VOICEN), a

2313

ld (BIOS_QUEUEN), a

2314

ld (BIOS_MUSICF), a

2315

ld HL,-12 ; -10

2316

add HL,SP

2317

ld (BIOS_SAVSP),HL

2318

ld HL, BIOS_PLYCNT

2319

ld (HL), 0

2320

jp BASIC_PLAY_DIRECT

2321

2322

; keyword

2323

RETURN:

2324

; abstract virtual RETURN

2325

; keyword

2326

MATH.MOD:

2327

2328

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

2329

; begin changed

2330

jp MATH.MOD.INT ;

2331

; end changed

2332

2333

; keyword

2334

FBOX:

2335

2336

pop.parm ; get first parameter

2337

call CAST_TO.INT ;

2338

call GET_INT.VALUE ; output BC with integer value

2339

ld (GFX_TEMP1), bc ; dX

2340

pop.parm ; get second parameter

2341

call CAST_TO.INT ;

2342

call GET_INT.VALUE ; output BC with integer value

2343

push bc ; dY

2344

pop de

2345

ld bc, (GFX_TEMP1) ; dX

2346

or 1 ; a = 1 (filled box)

2347

jp gfxDrawBox

2348

2349

; keyword

2350

READ:

2351

2352

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

2353

push hl ; save input variable...

2354

xor a ; clear carry

2355

ld hl, (BASIC_DATLIN) ; index of data items

2356

ld de, DATA_ITEMS_COUNT ; count of data items

2357

sbc hl, de ; compare hl >= de

2358

jr z, READ.END ; jump if equal

2359

jr nc, READ.END ; jump if above

2360

pop de ; restore saved input variable to DE

2361

ld ix, (BASIC_DATPTR) ; data items pointer

2362

ld l, (ix)

2363

ld h, (ix+1)

2364

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

2365

ex de, hl ; put DE into HL

2366

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

2367

call LET ; put data into variable

2368

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

2369

inc hl ; next item

2370

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

2371

ld hl, (BASIC_DATPTR) ; old data items pointer

2372

push hl

2373

inc hl ; next item

2374

inc hl ; next item

2375

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

2376

READ.END: pop hl

2377

ret

2378

2379

; keyword

2380

CHR:

2381

2382

pop.parm ; get first parameter

2383

call CAST_TO.INT ;

2384

call GET_INT.VALUE ; output BC with integer value

2385

2386

; begin change

2387

push bc

2388

ld bc, 2 ; string size

2389

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

2390

jp z, memory.error ;

2391

pop bc

2392

ld a, c ; A = char

2393

; end change

2394

2395

ld (ix), a

2396

xor a

2397

ld (ix+1), a

2398

push ix

2399

pop hl

2400

ld a, 1

2401

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

2402

ret.parm ;

2403

2404

; keyword

2405

SPRITE:

2406

2407

pop.parm ; get sprite number

2408

call CAST_TO.INT ;

2409

call GET_INT.VALUE ; output BC with integer value

2410

ld (GFX_TEMP), bc ; sprite number

2411

2412

pop.parm ; get sprite data

2413

ld a, (hl)

2414

cp 3 ; is string?

2415

ret nz

2416

2417

call GET_STR.ADDR ; put string address into hl

2418

; begin changed

2419

or a

2420

ret z ; is string empty?

2421

; end changed

2422

2423

ld c, a ; string size

2424

ld a, (GFX_TEMP) ; sprite number

2425

call gfxSetSpriteData

2426

2427

ld a, (GFX_TEMP)

2428

ld b, 0

2429

ld c, a ; sprite number

2430

call gfxSetSpritePattern

2431

2432

ld b, 0

2433

ld a, (BIOS_FORCLR)

2434

ld c, a

2435

ld a, (GFX_TEMP)

2436

call gfxSetSpriteColorInt

2437

2438

;ld bc, 0

2439

;ld a, (GFX_TEMP)

2440

;call gfxSetSpriteXY

2441

2442

ret

2443

2444

; keyword

2445

DATA:

2446

; abstract virtual DATA

2447

2448

2449

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

2450

; INITIALIZE VARIABLES

2451

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

2452

2453

; begin change

2454

INITIALIZE_DUMMY:

2455

xor a

2456

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

2457

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

2458

ld (VAR_DUMMY.POINTER), hl

2459

ld b, VAR_DUMMY.LENGTH

2460

ld c, 0

2461

INITIALIZE_DUMMY.1:

2462

ld (hl), a

2463

inc hl

2464

djnz INITIALIZE_DUMMY.1

2465

ret

2466

INITIALIZE_DATA:

2467

ld hl, DATA_ITEMS

2468

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

2469

ld hl, 0

2470

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

2471

ret

2472

; end change

2473

2474

INITIALIZE_VARIABLES:

2475

; begin change

2476

call INITIALIZE_DATA

2477

call INITIALIZE_DUMMY

2478

; end change

2479

2480

ld hl, IDF_12

2481

ld d, 2 ; any = default integer

2482

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

2483

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

2484

call INIT_VAR ; variable initialize

2485

ld hl, IDF_14

2486

ld d, 2 ; any = default integer

2487

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

2488

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

2489

call INIT_VAR ; variable initialize

2490

ld hl, IDF_16

2491

ld d, 2 ; any = default integer

2492

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

2493

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

2494

call INIT_VAR ; variable initialize

2495

ld hl, IDF_18

2496

ld d, 2 ; any = default integer

2497

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

2498

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

2499

call INIT_VAR ; variable initialize

2500

ld hl, IDF_20

2501

ld d, 2 ; any = default integer

2502

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

2503

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

2504

call INIT_VAR ; variable initialize

2505

ld hl, IDF_22

2506

ld d, 2 ; any = default integer

2507

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

2508

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

2509

call INIT_VAR ; variable initialize

2510

ld hl, IDF_24

2511

ld d, 3 ; string

2512

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

2513

ld b, 255 ; variable name 2 (type flag=fixed)

2514

call INIT_VAR ; variable initialize

2515

ld hl, IDF_56

2516

ld d, 2 ; any = default integer

2517

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

2518

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

2519

call INIT_VAR ; variable initialize

2520

ld hl, IDF_63

2521

ld d, 2 ; integer

2522

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

2523

ld b, 255 ; variable name 2 (type flag=fixed)

2524

call INIT_VAR ; variable initialize

2525

ld hl, IDF_101

2526

ld d, 2 ; any = default integer

2527

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

2528

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

2529

call INIT_VAR ; variable initialize

2530

ld hl, IDF_152

2531

ld d, 3 ; string

2532

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

2533

ld b, 255 ; variable name 2 (type flag=fixed)

2534

call INIT_VAR ; variable initialize

2535

ld hl, IDF_158

2536

ld d, 2 ; any = default integer

2537

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

2538

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

2539

call INIT_VAR ; variable initialize

2540

ld hl, IDF_160

2541

ld d, 3 ; string

2542

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

2543

ld b, 255 ; variable name 2 (type flag=fixed)

2544

call INIT_VAR ; variable initialize

2545

ret

2546

2547

2548

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

2549

; PROGRAM ROUTINES

2550

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

2551

2552

BIOS_BASIC_SLOT_ENABLE:

2553

ld a, (BIOS_EXPTBL)

2554

ld hl,0

2555

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

2556

ld a, (BIOS_EXPTBL)

2557

ld hl,04000h

2558

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

2559

ret

2560

2561

BIOS_BASIC_SLOT_DISABLE:

2562

ret

2563

2564

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

2565

2566

RUN_TRAPS: ld b, 26

2567

ld hl, BASIC_TRPTBL

2568

RUN_TRAPS.1: push hl

2569

push bc

2570

call TRAP_HANDLER

2571

pop bc

2572

pop hl

2573

inc hl

2574

inc hl

2575

inc hl

2576

djnz RUN_TRAPS.1

2577

ret

2578

2579

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

2580

TRAP_HANDLER:

2581

ld a, (hl) ; trap status

2582

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

2583

ret nz ; return if false

2584

inc hl

2585

ld e, (hl) ; get trap address

2586

inc hl

2587

ld d, (hl)

2588

dec hl

2589

dec hl

2590

ld a, d

2591

or e

2592

ret z ; return if address zero

2593

push hl

2594

call BASIC_TRAP_ACKNW

2595

call BASIC_TRAP_PAUSE

2596

ld hl, TRAP_HANDLER.1

2597

push hl ; next return will be to trap handler

2598

push de ; indirect jump to trap address

2599

ret

2600

TRAP_HANDLER.1: pop hl

2601

ld a, (hl)

2602

cp 1 ; trap enabled?

2603

ret z

2604

jp BASIC_TRAP_UNPAUSE

2605

2606

; hl = trap block, de = trap handler

2607

SET_TRAP: xor a

2608

ld (hl), a ; trap block status

2609

inc hl

2610

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

2611

inc hl

2612

ld (hl), d

2613

ret

2614

2615

endif

2616

2617

if defined SET_PLAY_VOICE_1 or defined SET_PLAY_VOICE_2 or defined SET_PLAY_VOICE_3 or defined DO_PLAY

2618

2619

SET_PLAY_VOICE:

2620

ld (BIOS_TEMP), a ; save voice number

2621

pop.parm

2622

ld a, (hl)

2623

cp 3

2624

ret nz ; return if not string

2625

call GET_STR.ADDR

2626

ld (BIOS_TEMP2), a ; save string size

2627

push hl ; string address

2628

ld a, (BIOS_TEMP) ; restore voice number

2629

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

2630

pop de

2631

ld a, (BIOS_TEMP2) ; restore string size

2632

ld (hl), a ; string size

2633

inc hl

2634

ld (hl), e ; string address

2635

inc hl

2636

ld (hl), d

2637

inc hl

2638

ld D,H ; voice stack

2639

ld E,L

2640

ld BC,001CH

2641

add HL,BC

2642

ex DE,HL

2643

ld (HL),E

2644

inc HL

2645

ld (HL),D

2646

ret

2647

2648

endif

2649

2650

2651

2652

2653

2654

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

2655

; VARIABLES ROUTINES

2656

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

2657

2658

; input hl = variable address

2659

; input bc = variable name

2660

; input d = variable type

2661

INIT_VAR: ld (hl), d ; variable type

2662

inc hl

2663

ld (hl), c ; variable name 1

2664

inc hl

2665

ld (hl), b ; variable name 2

2666

ld a, d

2667

cp 3

2668

jp nz, CLEAR.VAR

2669

ld de, LIT_NULL_STR

2670

inc hl

2671

ld (hl), 0

2672

inc hl

2673

ld (hl), e

2674

inc hl

2675

ld (hl), d

2676

ld b, 5

2677

jr CLEAR.VAR.LOOP

2678

CLEAR.VAR: ld b, 8

2679

CLEAR.VAR.LOOP: inc hl

2680

ld (hl), 0 ; data address/value

2681

djnz CLEAR.VAR.LOOP

2682

ret

2683

; input HL = variable address

2684

; input A = variable output type

2685

; output HL = casted data address

2686

CAST_TO: cp 2

2687

jp z, CAST_TO.INT

2688

cp 3

2689

jp z, CAST_TO.STR

2690

cp 4

2691

jp z, CAST_TO.SGL

2692

cp 8

2693

jp z, CAST_TO.DBL

2694

ret

2695

; input HL = variable address

2696

; output HL = variable address

2697

CAST_TO.INT: ;push af

2698

ld a, (HL)

2699

cp 2

2700

jp z, GET_INT.ADDR

2701

cp 3

2702

jp z, CAST_STR_TO.INT

2703

cp 4

2704

jp z, CAST_SGL_TO.INT

2705

cp 8

2706

jp z, CAST_DBL_TO.INT

2707

;pop af

2708

ret

2709

; input HL = variable address

2710

; output HL = variable address

2711

CAST_TO.STR: ;push af

2712

ld a, (HL)

2713

cp 2

2714

jp z, CAST_INT_TO.STR

2715

cp 3

2716

jp z, GET_STR.ADDR

2717

cp 4

2718

jp z, CAST_SGL_TO.STR

2719

cp 8

2720

jp z, CAST_DBL_TO.STR

2721

;pop af

2722

ret

2723

; input HL = variable address

2724

; output HL = variable address

2725

CAST_TO.SGL: ;push af

2726

ld a, (HL)

2727

cp 2

2728

jp z, CAST_INT_TO.SGL

2729

cp 3

2730

jp z, CAST_STR_TO.SGL

2731

cp 4

2732

jp z, GET_SGL.ADDR

2733

cp 8

2734

jp z, CAST_DBL_TO.SGL

2735

;pop af

2736

ret

2737

; input HL = variable address

2738

; output HL = variable address

2739

CAST_TO.DBL: ;push af

2740

ld a, (hl)

2741

cp 2

2742

jp z, CAST_INT_TO.DBL

2743

cp 3

2744

jp z, CAST_STR_TO.DBL

2745

cp 4

2746

jp z, CAST_SGL_TO.DBL

2747

cp 8

2748

jp z, GET_DBL.ADDR

2749

;pop af

2750

ret

2751

CAST_SGL_TO.STR: ; same as CAST_INT_TO.STR

2752

CAST_DBL_TO.STR: ; same as CAST_INT_TO.STR

2753

CAST_INT_TO.STR: call COPY_TO.DAC

2754

xor a

2755

__call_bios MATH_FOUT ; convert DAC to string

2756

;pop af

2757

ret

2758

CAST_INT_TO.SGL: call COPY_TO.DAC

2759

__call_bios MATH_FRCSGL

2760

ld hl, BASIC_DAC

2761

ret

2762

CAST_INT_TO.DBL: call COPY_TO.DAC

2763

__call_bios MATH_FRCDBL

2764

ld hl, BASIC_DAC

2765

ret

2766

CAST_SGL_TO.INT: ; same as CAST_DBL_TO.INT

2767

CAST_DBL_TO.INT: call COPY_TO.DAC

2768

__call_bios MATH_FRCINT

2769

ld hl, BASIC_DAC

2770

ret

2771

CAST_STR_TO.INT: call CAST_STR_TO.VAL ;

2772

__call_bios MATH_FRCINT ;

2773

ld hl, BASIC_DAC ;

2774

ret ;

2775

CAST_STR_TO.SGL: call CAST_STR_TO.VAL ;

2776

__call_bios MATH_FRCSGL ;

2777

ld hl, BASIC_DAC ;

2778

ret ;

2779

CAST_STR_TO.DBL: call CAST_STR_TO.VAL ;

2780

__call_bios MATH_FRCDBL ;

2781

ld hl, BASIC_DAC ;

2782

ret ;

2783

CAST_STR_TO.VAL: call GET_STR.ADDR ;

2784

ld a, (hl) ;

2785

__call_bios MATH_FIN ; convert string to a value type

2786

ld hl, BASIC_DAC ;

2787

ret ;

2788

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

2789

inc hl ;

2790

ld c, (hl) ;

2791

inc hl ;

2792

ld b, (hl) ;

2793

ret ;

2794

CAST_SGL_TO.DBL: ; same as GET_DBL.ADDR

2795

CAST_DBL_TO.SGL: ; same as GET_DBL.ADDR

2796

GET_INT.ADDR: ; same as GET_DBL.ADDR

2797

GET_SGL.ADDR: ; same as GET_DBL.ADDR

2798

GET_DBL.ADDR: inc hl

2799

inc hl

2800

inc hl

2801

;pop af

2802

ret

2803

GET_STR.ADDR: push hl

2804

pop ix

2805

ld a, (ix + 3)

2806

ld l, (ix + 4)

2807

ld h, (ix + 5)

2808

ret

2809

; input hl = string address

2810

; output b = string length

2811

GET_STR.LENGTH: ld b, 0

2812

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

2813

or a ; cp 0

2814

ret z

2815

inc b

2816

inc hl

2817

ld a, b

2818

cp 255

2819

jr z, GET_STR.LEN.ERR

2820

jr GET_STR.LEN.NEXT

2821

GET_STR.LEN.ERR: ld b, 0

2822

ret

2823

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

2824

ld iy, (BASIC_ARG+1) ; string 2

2825

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

2826

cp (iy) ; char s1 = char s2?

2827

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

2828

cp 0 ;

2829

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

2830

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

2831

cp 0 ;

2832

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

2833

inc ix ;

2834

inc iy ;

2835

jr STRING.COMPARE.NX ; get next char pair

2836

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

2837

cp 0 ;

2838

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

2839

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

2840

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

2841

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

2842

ret ;

2843

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

2844

ret ;

2845

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

2846

ret ;

2847

STRING.CONCAT: ld ix, BASIC_DAC ; s1 size

2848

ld a, (BASIC_ARG) ; s2 size

2849

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

2850

push af

2851

push af

2852

call memory.get_free

2853

pop af

2854

ld b, 0

2855

ld c, a ;

2856

inc bc ; add 1 byte to size

2857

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

2858

jp z, memory.error ;

2859

push ix ; save ix

2860

push ix ; save ix

2861

pop de ; de = ix

2862

ld a, (BASIC_DAC) ; s1 size

2863

ld hl, (BASIC_DAC + 1) ; string 1

2864

call COPY_TO.STR ; copy to new memory

2865

ld a, (BASIC_ARG) ; s2 size

2866

ld hl, (BASIC_ARG + 1) ; string 2

2867

call COPY_TO.STR ; copy to new memory

2868

xor a

2869

ld (de), a ; null terminated

2870

pop hl ; hl = ix

2871

pop af

2872

call COPY_TO.VAR_DUMMY.STR ;

2873

ret.parm ; WARNING - VERIFY STRING MEMORY LEAKs

2874

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

2875

cp 5 ;

2876

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

2877

cp 2 ;

2878

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

2879

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

2880

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

2881

ret z ; exit if yes

2882

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

2883

inc hl ; next char

2884

jr STRING.PRINT.T ; repeat

2885

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

2886

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

2887

ret z ; exit if yes

2888

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

2889

inc hl ; next char

2890

jr STRING.PRINT.G1 ; repeat

2891

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

2892

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

2893

ret z ; exit if yes

2894

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

2895

call BIOS_EXTROM

2896

inc hl ; next char

2897

jr STRING.PRINT.G2 ; repeat

2898

2899

; a = string size to copy

2900

; input hl = string from

2901

; input de = string to

2902

COPY_TO.STR: or a

2903

ret z ; avoid copy if size = zero

2904

ld b, 0

2905

ld c, a ; string size

2906

ldir ; copy bc bytes from hl to de

2907

ret ;

2908

COPY_TO.BASIC_BUF: ld bc, BASIC_BUF

2909

ld a, (LIT_QUOTE_CHAR)

2910

ld (bc), a

2911

inc bc

2912

COPY_BAS_BUF.LOOP: ld a, (hl)

2913

or a ; cp 0

2914

jr z, COPY_BAS_BUF.EXIT

2915

ld (bc), a

2916

inc bc

2917

inc hl

2918

jr COPY_BAS_BUF.LOOP

2919

COPY_BAS_BUF.EXIT: ld a, (LIT_QUOTE_CHAR)

2920

ld (bc), a

2921

inc bc

2922

xor a

2923

ld (bc), a

2924

ld hl, BASIC_BUF

2925

ret

2926

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

2927

cp 3 ;

2928

jr nz, COPY_TO.VAR_DUMMY.DBL

2929

; begin changed

2930

push hl

2931

call GET_STR.LENGTH ; get string length

2932

pop hl

2933

ld a, b ; string length

2934

; end changed

2935

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

2936

ld (ix), 3 ; data type string

2937

ld (ix+1), 0 ;

2938

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

2939

ld (ix+3), a ; string length

2940

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

2941

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

2942

;call GET_STR.LENGTH ; get string length

2943

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

2944

push ix ; output var address...

2945

pop hl ; ...into hl

2946

ret ;

2947

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

2948

ld (ix), 2 ; data type string

2949

ld (ix+1), 0 ;

2950

ld (ix+2), 0 ;

2951

ld (ix+3), 0 ;

2952

ld (ix+4), 0 ;

2953

ld (ix+5), c ;

2954

ld (ix+6), b ;

2955

ld (ix+7), 0 ;

2956

ld (ix+8), 0 ;

2957

ld (ix+9), 0 ;

2958

ld (ix+10), 0 ;

2959

push ix ; output var address...

2960

pop hl ; ...into hl

2961

ret ;

2962

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

2963

ld (ix), a ; data type

2964

ld (ix+1), 0 ;

2965

ld (ix+2), 0 ;

2966

ld bc, 8 ;

2967

ld hl, BASIC_DAC ;

2968

push ix ; just to copy ix to de

2969

pop de ;

2970

inc de ;

2971

inc de ;

2972

inc de ;

2973

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

2974

push ix ; output var address...

2975

pop hl ; ...into hl

2976

ret ;

2977

; begin changed

2978

GET_VAR_DUMMY.ADDR: push af ;

2979

push de

2980

ld de, 11 ;

2981

ld ix, (VAR_DUMMY.POINTER) ;

2982

ld a, (VAR_DUMMY.COUNTER) ;

2983

GET_VAR_DUMMY.NEXT: add ix, de ;

2984

inc a ;

2985

cp VAR_DUMMY.SIZE ;

2986

jr nz, GET_VAR_DUMMY.EXIT ;

2987

xor a ;

2988

ld ix, VAR_DUMMY.DATA ;

2989

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

2990

ld (VAR_DUMMY.COUNTER), a ;

2991

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

2992

cp 3 ; is it string?

2993

call z, GET_VAR_DUMMY.FREE ; free string memory

2994

pop de

2995

pop af ;

2996

ret ;

2997

GET_VAR_DUMMY.FREE:

2998

push hl

2999

push ix

3000

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

3001

ld h, (ix+5)

3002

push hl

3003

pop ix

3004

call memory.free ; free memory

3005

pop ix

3006

pop hl

3007

ret

3008

; end changed

3009

3010

; input hl = variable address

3011

COPY_TO.DAC: ld de, BASIC_DAC

3012

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

3013

ld (BASIC_VALTYP), a

3014

inc hl

3015

inc hl

3016

inc hl

3017

ld bc, 8 ; data = 8 bytes

3018

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

3019

ret

3020

COPY_TO.ARG: ld de, BASIC_ARG ;

3021

jr COPY_TO.DAC.DATA ;

3022

COPY_TO.DAC_ARG: ld hl, BASIC_DAC ;

3023

ld de, BASIC_ARG ;

3024

ld bc, 8 ; data = 8 bytes

3025

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

3026

ret ;

3027

COPY_TO.ARG_DAC: ld hl, BASIC_ARG ;

3028

ld de, BASIC_DAC ;

3029

ld bc, 8 ; data = 8 bytes

3030

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

3031

ret ;

3032

COPY_TO.DAC_TMP: ld hl, BASIC_DAC ;

3033

ld de, BASIC_SWPTMP ;

3034

ld bc, 8 ; data = 8 bytes

3035

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

3036

ret ;

3037

COPY_TO.TMP_DAC: ld hl, BASIC_SWPTMP ;

3038

ld de, BASIC_DAC ;

3039

ld bc, 8 ; data = 8 bytes

3040

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

3041

ret ;

3042

SWAP.DAC.ARG: di

3043

exx ; save registers

3044

ld bc, 8 ;

3045

ld hl, BASIC_DAC ;

3046

ld de, BASIC_SWPTMP ;

3047

ldir ; copy bc bytes from hl to de

3048

ld bc, 8 ;

3049

ld hl, BASIC_ARG ;

3050

ld de, BASIC_DAC ;

3051

ldir ; copy bc bytes from hl to de

3052

ld bc, 8 ;

3053

ld hl, BASIC_SWPTMP ;

3054

ld de, BASIC_ARG ;

3055

ldir ; copy bc bytes from hl to de

3056

exx ; restore registers

3057

3058

ret ;

3059

CLEAR.DAC: ld de, BASIC_DAC

3060

CLEAR.DAC.DATA: ld hl, BASIC_VALTYP

3061

ld (hl), 2

3062

ld hl, LIT_NULL_DBL

3063

ld bc, 8 ; data = 8 bytes

3064

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

3065

ret

3066

CLEAR.ARG: ld de, BASIC_ARG

3067

jr CLEAR.DAC.DATA

3068

3069

3070

3071

3072

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

3073

; MATH 16 BITS ROUTINES

3074

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

3075

3076

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

3077

ex af, af' ; save PC to temp

3078

pop.parm ; get first parameter

3079

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

3080

pop.parm ; get second parameter

3081

ex af, af' ; restore PC from temp

3082

push af ; put again PC from caller in stack

3083

ex af, af' ; restore 1st data type

3084

push af ; save 1st data type

3085

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

3086

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

3087

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

3088

ret z ; return if is equal data types

3089

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

3090

and 12 ; test if single/double

3091

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

3092

__call_bios MATH_FRCDBL ; convert DAC to double

3093

MATH.PARM.CST1: pop af ;

3094

and 12 ; test if single/double

3095

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

3096

ld (BASIC_VALTYP), a ;

3097

call COPY_TO.DAC_TMP ;

3098

call COPY_TO.ARG_DAC ;

3099

__call_bios MATH_FRCDBL ; convert ARG to double

3100

call COPY_TO.DAC_ARG ;

3101

call COPY_TO.TMP_DAC ;

3102

MATH.PARM.CST2: ld a, 8 ;

3103

ld (BASIC_VALTYP), a ;

3104

ret ;

3105

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

3106

pop af ; get PC from caller stack

3107

ex af, af' ; save PC to temp

3108

pop.parm ; get first parameter

3109

ld a, (hl) ; get parameter type

3110

and 2 ; test if integer

3111

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

3112

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

3113

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

3114

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

3115

__call_bios MATH_FRCINT ; convert DAC to int

3116

call COPY_TO.DAC_ARG ; copy DAC to ARG

3117

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

3118

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

3119

and 2 ; test if integer

3120

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

3121

__call_bios MATH_FRCINT ; convert DAC to int

3122

ld a, 2 ;

3123

ld (BASIC_VALTYP), a ;

3124

MATH.PARM.POP.I3:

3125

ex af, af' ; restore PC from temp

3126

push af ; put again PC from caller in stack

3127

ret ;

3128

MATH.PARM.PUSH: call COPY_TO.VAR_DUMMY ;

3129

ret.parm ;

3130

; input DAC, ARG

3131

; output in parm stack

3132

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

3133

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

3134

ld bc, (BASIC_ARG+2) ;

3135

add hl, bc ;

3136

ld (BASIC_DAC+2), hl ;

3137

jp MATH.PARM.PUSH ;

3138

; input DAC, ARG

3139

; output in parm stack

3140

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

3141

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

3142

ld de, (BASIC_ARG+2) ;

3143

and a ; clear carry

3144

sbc hl, de ;

3145

ld (BASIC_DAC+2), hl ;

3146

jp MATH.PARM.PUSH ;

3147

; input DAC, ARG

3148

; output in parm stack

3149

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

3150

ld bc, (BASIC_ARG+2) ;

3151

call MATH.MULT.16 ;

3152

ld (BASIC_DAC+2), hl ;

3153

jp MATH.PARM.PUSH ;

3154

; input HL = multiplicand

3155

; input BC = multiplier

3156

; output HL = result

3157

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

3158

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

3159

ld c, b ; high multiplier

3160

ld b, 16

3161

ld d, h ; multiplicand

3162

ld e, l

3163

ld hl, 0

3164

MULT16LOOP: srl c ; right shift multiplier high

3165

rra ; rotate right multiplier low

3166

jr nc, MULT16NOADD ; test carry

3167

add hl, de ; add multiplicand to result

3168

MULT16NOADD: ex de, hl

3169

add hl, hl ; double - shift multiplicand

3170

ex de, hl

3171

djnz MULT16LOOP

3172

ret

3173

; input AC = dividend

3174

; input DE = divisor

3175

; output AC = quotient

3176

; output HL = remainder

3177

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

3178

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

3179

ld b, 16 ; set counter

3180

DIV16LOOP: rl c ; rotate accumulator result left

3181

rla

3182

adc hl, hl ; left shift

3183

sbc hl, de ; trial subtract divisor

3184

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

3185

add hl, de ; restore accumulator

3186

ccf ; calculate result bit

3187

djnz DIV16LOOP ; counter not zero

3188

rl c ; shift in last result bit

3189

rla

3190

ret

3191

3192

; compare two signed 16 bits integers

3193

; HL < DE: Carry flag

3194

; HL = DE: Zero flag

3195

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

3196

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

3197

and 0x80 ; test sign, clear carry

3198

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

3199

bit 7, d

3200

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

3201

ld a, h

3202

cp d ; signs are both positive, so normal compare

3203

ret nz

3204

ld a, l ; test low order byte

3205

cp e

3206

ret

3207

MATH.COMP.S16.NEGM1:

3208

xor d

3209

rla ; sign bit into carry

3210

ret c ; signs different

3211

ld a, h

3212

cp d ; both signs negative

3213

ret nz

3214

ld a, l

3215

cp e

3216

ret

3217

3218

MATH.ADD.SGL: ld a, 8 ;

3219

ld (BASIC_VALTYP), a ;

3220

MATH.ADD.DBL: __call_bios MATH_DECADD ;

3221

jp MATH.PARM.PUSH ;

3222

MATH.SUB.SGL: ld a, 8 ;

3223

ld (BASIC_VALTYP), a ;

3224

MATH.SUB.DBL: __call_bios MATH_DECSUB ;

3225

jp MATH.PARM.PUSH ;

3226

MATH.MULT.SGL: ld a, 8 ;

3227

ld (BASIC_VALTYP), a ;

3228

MATH.MULT.DBL: __call_bios MATH_DECMUL ;

3229

jp MATH.PARM.PUSH ;

3230

; input DAC, ARG

3231

; output in parm stack

3232

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

3233

call SWAP.DAC.ARG ;

3234

ld a, 2 ;

3235

ld (BASIC_VALTYP), a ;

3236

__call_bios MATH_FRCDBL ; convert ARG to double

3237

call SWAP.DAC.ARG ;

3238

MATH.DIV.SGL: ld a, 8 ;

3239

ld (BASIC_VALTYP), a ;

3240

MATH.DIV.DBL: __call_bios MATH_DECDIV ;

3241

jp MATH.PARM.PUSH ;

3242

; input DAC, ARG

3243

; output in parm stack

3244

MATH.IDIV.SGL: ld a, 8 ;

3245

ld (BASIC_VALTYP), a ;

3246

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

3247

call SWAP.DAC.ARG ;

3248

ld a, 8 ;

3249

ld (BASIC_VALTYP), a ;

3250

__call_bios MATH_FRCINT ; convert ARG to integer

3251

call SWAP.DAC.ARG ;

3252

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

3253

ld a, h ;

3254

ld c, l ;

3255

ld de, (BASIC_ARG+2) ;

3256

call MATH.DIV.16 ;

3257

ld h, a ;

3258

ld l, c ;

3259

ld (BASIC_DAC+2), hl ; quotient

3260

jp MATH.PARM.PUSH ;

3261

if defined MATH.POW

3262

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

3263

__call_bios MATH_FRCDBL ; convert DAC to double

3264

call SWAP.DAC.ARG ;

3265

ld a, 2 ;

3266

ld (BASIC_VALTYP), a ;

3267

__call_bios MATH_FRCDBL ; convert ARG to double

3268

call SWAP.DAC.ARG ;

3269

MATH.POW.SGL: ld a, 8 ;

3270

ld (BASIC_VALTYP), a ;

3271

MATH.POW.DBL: __call_bios MATH_DBLEXP ;

3272

jp MATH.PARM.PUSH ;

3273

endif

3274

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

3275

; ld (BASIC_VALTYP), a ;

3276

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

3277

; call SWAP.DAC.ARG ;

3278

; ld a, 8 ;

3279

; ld (BASIC_VALTYP), a ;

3280

; __call_bios MATH_FRCINT ; convert ARG to integer

3281

; call SWAP.DAC.ARG ;

3282

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

3283

ld a, h ;

3284

ld c, l ;

3285

ld de, (BASIC_ARG+2) ;

3286

call MATH.DIV.16 ;

3287

ld (BASIC_DAC+2), hl ; remainder

3288

jp MATH.PARM.PUSH ;

3289

3290

; fast 16-bit integer square root

3291

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

3292

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

3293

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

3294

; call with hl = number to square root

3295

; returns a = square root

3296

; corrupts hl, de

3297

3298

MATH.INT.SQR:

3299

ld a,h

3300

ld de,0B0C0h

3301

add a,e

3302

jr c,sq7

3303

ld a,h

3304

ld d,0F0h

3305

sq7:

3306

add a,d

3307

jr nc,sq6

3308

res 5,d

3309

db 254

3310

sq6:

3311

sub d

3312

sra d

3313

set 2,d

3314

add a,d

3315

jr nc,sq5

3316

res 3,d

3317

db 254

3318

sq5:

3319

sub d

3320

sra d

3321

inc d

3322

add a,d

3323

jr nc,sq4

3324

res 1,d

3325

db 254

3326

sq4:

3327

sub d

3328

sra d

3329

ld h,a

3330

add hl,de

3331

jr nc,sq3

3332

ld e,040h

3333

db 210

3334

sq3:

3335

sbc hl,de

3336

sra d

3337

ld a,e

3338

rra

3339

or 010h

3340

ld e,a

3341

add hl,de

3342

jr nc,sq2

3343

and 0DFh

3344

db 218

3345

sq2:

3346

sbc hl,de

3347

sra d

3348

rra

3349

or 04h

3350

ld e,a

3351

add hl,de

3352

jr nc,sq1

3353

and 0F7h

3354

db 218

3355

sq1:

3356

sbc hl,de

3357

sra d

3358

rra

3359

inc a

3360

ld e,a

3361

add hl,de

3362

jr nc,sq0

3363

and 0FDh

3364

sq0:

3365

sra d

3366

rra

3367

cpl

3368

ret

3369

3370

MATH.RANDOMIZE: ld ix, BIOS_JIFFY ;

3371

di ;

3372

ld c, (ix) ;

3373

ld b, (ix+1) ;

3374

ei ;

3375

MATH.SEED: push bc ; in bc = new integer seed

3376

call CLEAR.DAC ;

3377

ld ix, BASIC_DAC ;

3378

pop bc ;

3379

ld (ix+2), c ; copy bc to dac

3380

ld (ix+3), b ;

3381

ld a, 2 ; type integer

3382

ld (BASIC_VALTYP), a ;

3383

__call_bios MATH_FRCDBL ; convert DAC integer to DAC double

3384

__call_bios MATH_NEG ; DAC = -DAC

3385

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

3386

ret ;

3387

MATH.ERROR: ld e, 13 ; type mismatch

3388

jp BASIC_ERROR_HANDLER ;

3389

;__call_basic BASIC_END ;

3390

;ret ;

3391

3392

3393

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

3394

; BOOLEAN ROUTINES

3395

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

3396

3397

BOOLEAN.RET.TRUE: ld hl, LIT_TRUE ;

3398

ret.parm ;

3399

BOOLEAN.RET.FALSE: ld hl, LIT_FALSE ;

3400

ret.parm ;

3401

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

3402

ld de, (BASIC_ARG+2) ;

3403

__call_bios MATH_ICOMP ;

3404

ret ;

3405

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

3406

ld de, (BASIC_ARG+2) ;

3407

__call_bios MATH_DCOMP ;

3408

ret ;

3409

BOOLEAN.CMP.DBL: __call_bios MATH_XDCOMP ;

3410

ret ;

3411

BOOLEAN.CMP.STR: call STRING.COMPARE ;

3412

ret ;

3413

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

3414

jr BOOLEAN.GT.RET ;

3415

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

3416

jr BOOLEAN.GT.RET ;

3417

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

3418

jr BOOLEAN.GT.RET ;

3419

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

3420

jr BOOLEAN.GT.RET ;

3421

BOOLEAN.GT.RET: cp 0x01 ;

3422

jp z, BOOLEAN.RET.TRUE ;

3423

jp BOOLEAN.RET.FALSE ;

3424

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

3425

jr BOOLEAN.LT.RET ;

3426

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

3427

jr BOOLEAN.LT.RET ;

3428

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

3429

jr BOOLEAN.LT.RET ;

3430

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

3431

jr BOOLEAN.LT.RET ;

3432

BOOLEAN.LT.RET: cp 0xFF ;

3433

jp z, BOOLEAN.RET.TRUE ;

3434

jp BOOLEAN.RET.FALSE ;

3435

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

3436

jr BOOLEAN.GE.RET ;

3437

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

3438

jr BOOLEAN.GE.RET ;

3439

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

3440

jr BOOLEAN.GE.RET ;

3441

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

3442

jr BOOLEAN.GE.RET ;

3443

BOOLEAN.GE.RET: cp 0x01 ;

3444

jp z, BOOLEAN.RET.TRUE ;

3445

or a ; cp 0

3446

jp z, BOOLEAN.RET.TRUE ;

3447

jp BOOLEAN.RET.FALSE ;

3448

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

3449

jr BOOLEAN.LE.RET ;

3450

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

3451

jr BOOLEAN.LE.RET ;

3452

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

3453

jr BOOLEAN.LE.RET ;

3454

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

3455

jr BOOLEAN.LE.RET ;

3456

BOOLEAN.LE.RET: cp 0xFF ;

3457

jp z, BOOLEAN.RET.TRUE ;

3458

or a ; cp 0

3459

jp z, BOOLEAN.RET.TRUE ;

3460

jp BOOLEAN.RET.FALSE ;

3461

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

3462

jr BOOLEAN.NE.RET ;

3463

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

3464

jr BOOLEAN.NE.RET ;

3465

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

3466

jr BOOLEAN.NE.RET ;

3467

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

3468

jr BOOLEAN.NE.RET ;

3469

BOOLEAN.NE.RET: or a ; cp 0

3470

jp nz, BOOLEAN.RET.TRUE ;

3471

jp BOOLEAN.RET.FALSE ;

3472

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

3473

jr BOOLEAN.EQ.RET ;

3474

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

3475

jr BOOLEAN.EQ.RET ;

3476

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

3477

jr BOOLEAN.EQ.RET ;

3478

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

3479

jr BOOLEAN.EQ.RET ;

3480

BOOLEAN.EQ.RET: or a ; cp 0

3481

jp z, BOOLEAN.RET.TRUE ;

3482

jp BOOLEAN.RET.FALSE ;

3483

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

3484

ld hl, BASIC_ARG+2 ;

3485

and (hl) ;

3486

ld (BASIC_DAC+2), a ;

3487

inc hl ;

3488

ld a, (BASIC_DAC+3) ;

3489

and (hl) ;

3490

ld (BASIC_DAC+3), a ;

3491

ld a, 2 ;

3492

jp MATH.PARM.PUSH ;

3493

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

3494

ld hl, BASIC_ARG+2 ;

3495

or (hl) ;

3496

ld (BASIC_DAC+2), a ;

3497

inc hl ;

3498

ld a, (BASIC_DAC+3) ;

3499

or (hl) ;

3500

ld (BASIC_DAC+3), a ;

3501

ld a, 2 ;

3502

jp MATH.PARM.PUSH ;

3503

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

3504

ld hl, BASIC_ARG+2 ;

3505

xor (hl) ;

3506

ld (BASIC_DAC+2), a ;

3507

inc hl ;

3508

ld a, (BASIC_DAC+3) ;

3509

xor (hl) ;

3510

ld (BASIC_DAC+3), a ;

3511

ld a, 2 ;

3512

jp MATH.PARM.PUSH ;

3513

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

3514

ld hl, BASIC_ARG+2 ;

3515

xor (hl) ;

3516

cpl ;

3517

ld (BASIC_DAC+2), a ;

3518

inc hl ;

3519

ld a, (BASIC_DAC+3) ;

3520

xor (hl) ;

3521

cpl ;

3522

ld (BASIC_DAC+3), a ;

3523

ld a, 2 ;

3524

jp MATH.PARM.PUSH ;

3525

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

3526

ld hl, BASIC_ARG+2 ;

3527

cpl ;

3528

or (hl) ;

3529

ld (BASIC_DAC+2), a ;

3530

inc hl ;

3531

ld a, (BASIC_DAC+3) ;

3532

cpl ;

3533

or (hl) ;

3534

ld (BASIC_DAC+3), a ;

3535

ld a, 2 ;

3536

jp MATH.PARM.PUSH ;

3537

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

3538

ld a, (BASIC_ARG+2) ;

3539

or a ; clear carry

3540

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

3541

ld b, a ; shift count

3542

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

3543

rr (ix) ;

3544

or a ; clear carry

3545

djnz BOOLEAN.SHR.INT.N ; next shift

3546

ld a, 2 ;

3547

jp MATH.PARM.PUSH ; return DAC

3548

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

3549

ld a, (BASIC_ARG+2) ;

3550

or a ; clear carry

3551

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

3552

ld b, a ; shift count

3553

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

3554

rl (ix+1) ;

3555

or a ; clear carry

3556

djnz BOOLEAN.SHL.INT.N ; next shift

3557

ld a, 2 ;

3558

jp MATH.PARM.PUSH ; return DAC

3559

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

3560

cpl ;

3561

ld (BASIC_DAC+2), a ;

3562

ld a, (BASIC_DAC+3) ;

3563

cpl ;

3564

ld (BASIC_DAC+3), a ;

3565

ld a, 2 ;

3566

jp MATH.PARM.PUSH ;

3567

3568

3569

3570

3571

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

3572

; MEMORY ALLOCATION ROUTINES

3573

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

3574

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

3575

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

3576

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

3577

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

3578

; begin changed

3579

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

3580

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

3581

block.next: equ 0 ; next free block address

3582

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

3583

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

3584

3585

;; init

3586

memory.init:

3587

ld ix,memory.heap_start ; first block

3588

ld hl,memory.heap_start+block ; second block

3589

;; first block NEXT=secondblock, SIZE=0

3590

;; with this block we have a fixed start location

3591

;; because never will be allocated

3592

ld (ix+block.next),l

3593

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

3594

ld (ix+block.size),0

3595

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

3596

;; second block NEXT=0, SIZE=all

3597

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

3598

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

3599

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

3600

xor a

3601

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

3602

ld (BIOS_TEMP), sp

3603

ld hl, (BIOS_TEMP)

3604

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

3605

sbc hl,de

3606

;ld de, block * 2 + 100

3607

;sbc hl, de

3608

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

3609

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

3610

ret

3611

3612

;; alloc

3613

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

3614

memory.alloc:

3615

ld hl,block

3616

add hl,bc

3617

push hl

3618

pop bc

3619

ld ix,memory.heap_start ; this

3620

ld iy,0 ; prev

3621

memory.alloc.find:

3622

ld l,(ix+block.size)

3623

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

3624

xor a

3625

sbc hl,bc

3626

jp z, memory.alloc.exactfit

3627

jp c, memory.alloc.nextblock

3628

;; split found block

3629

memory.alloc.splitfit:

3630

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

3631

or h

3632

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

3633

ld a, l

3634

cp 4

3635

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

3636

memory.alloc.splitfit.do:

3637

;; newfreeblock = this + BC

3638

push ix

3639

pop hl

3640

add hl,bc

3641

;; prevblock->next = newfreeblock

3642

ld (iy+block.next),l

3643

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

3644

;; newfreeblock->next = this->next

3645

push hl

3646

pop iy ; iy = newfreeblock

3647

ld l,(ix+block.next)

3648

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

3649

ld (iy+block.next),l

3650

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

3651

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

3652

ld l,(ix+block.size)

3653

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

3654

xor a

3655

sbc hl,bc

3656

ld (iy+block.size),l

3657

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

3658

;; this->size = BC

3659

ld (ix+block.size),c

3660

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

3661

jr memory.alloc.ok

3662

;; use whole found block

3663

memory.alloc.exactfit:

3664

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

3665

ld l,(ix+block.next)

3666

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

3667

ld (iy+block.next),l

3668

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

3669

memory.alloc.ok:

3670

;; ix = first byte

3671

ld de,block

3672

add ix,de

3673

;; enable z-flag

3674

ld a,1

3675

or a

3676

ret

3677

memory.alloc.nextblock:

3678

ld l,(ix+block.next)

3679

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

3680

ld a,l

3681

cp h

3682

ret z

3683

;; prevblock = this

3684

push ix

3685

pop iy

3686

;; this = this->next

3687

push hl

3688

pop ix

3689

jp memory.alloc.find

3690

3691

;; free

3692

;; IN IX=memptr

3693

memory.free:

3694

;; HL = IX - block_header_size

3695

push ix

3696

pop hl

3697

ld de, block

3698

xor a

3699

sbc hl,de

3700

;; start of search

3701

ld ix,memory.heap_start

3702

memory.free.find:

3703

ld e,(ix+block.next)

3704

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

3705

ld a,d

3706

or e

3707

jp z, memory.free.passedend

3708

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

3709

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

3710

add hl,de ; restore hl value

3711

push de

3712

pop ix ; current = next

3713

jr memory.free.find

3714

3715

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

3716

memory.free.found:

3717

add hl,de ; restore hl value

3718

ld (ix+block.next), l

3719

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

3720

push hl

3721

pop iy

3722

ld (iy+block.next), e

3723

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

3724

push ix ; prev x this

3725

pop iy

3726

push hl

3727

pop ix

3728

push de

3729

call memory.free.coalesce

3730

pop ix ; this x next

3731

jr memory.free.coalesce

3732

3733

;; parm1 = *next

3734

;; parm2 = *this

3735

memory.free.coalesce:

3736

ld c, (iy+block.size)

3737

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

3738

push iy

3739

pop hl

3740

xor a

3741

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

3742

push ix

3743

pop de

3744

xor a

3745

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

3746

jr z, memory.free.coalesce.do

3747

push ix ; else, new *this = *next

3748

pop iy

3749

ret

3750

memory.free.coalesce.do:

3751

ld l, (ix+block.size)

3752

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

3753

xor a

3754

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

3755

ld (iy+block.size), l

3756

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

3757

ld l, (ix+block.next)

3758

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

3759

ld (iy+block.next), l

3760

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

3761

ret

3762

3763

memory.free.passedend:

3764

;; append block at the end of the free list

3765

ld (ix+block.next),l

3766

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

3767

push hl

3768

pop iy

3769

ld (iy+block.next),0

3770

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

3771

ret

3772

3773

;; get_free

3774

;; OUT BC=freespace

3775

memory.get_free:

3776

ld ix,memory.heap_start

3777

ld bc,0

3778

memory.get_free.count:

3779

ld a,c

3780

add a,(ix+block.size)

3781

ld c,a

3782

ld a,b

3783

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

3784

ld b,a

3785

ld l,(ix+block.next)

3786

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

3787

ld a,h

3788

or l

3789

ret z

3790

push hl

3791

pop ix

3792

jr memory.get_free.count

3793

3794

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

3795

jp BASIC_ERROR_HANDLER ;

3796

3797

; end changed

3798

3799

3800

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

3801

; GRAPHICS LIBRARY

3802

; By: Amaury Carvalho, 2019

3803

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

3804

; References:

3805

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

3806

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

3807

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

3808

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

3809

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

3810

3811

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

3812

; Bios functions

3813

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

3814

3815

BIOS_WRTVDP: EQU 0x0047

3816

BIOS_RDVRM: EQU 0x004A

3817

BIOS_WRTVRM: EQU 0x004D

3818

BIOS_LDIRVM: EQU 0x005C

3819

BIOS_PNTINI: EQU 0x18CF

3820

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

3821

BIOS_TRIGHTC: EQU 0x16AC ; Test then RIGHTC if legal

3822

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

3823

BIOS_TLEFTC: EQU 0x16D8 ; Test then LEFTC if legal

3824

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

3825

BIOS_TUPC: EQU 0x173C ; Test then UPC if legal

3826

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

3827

BIOS_TDOWNC: EQU 0x170A ; Test then DOWNC if legal

3828

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

3829

; begin changed

3830

BIOS_FILVRM: EQU 0x0056 ; fill VRAM with value

3831

; end changed

3832

3833

BIOS_BIGFIL: EQU 0x016B ; msx 2

3834

BIOS_NRDVRM: EQU 0x0174 ; msx 2

3835

BIOS_NWRVRM: EQU 0x0177 ; msx 2

3836

BIOS_NRDVDP: EQU 0x013E ; msx 2

3837

BIOS_VDPSTA: EQU 0x0131 ; msx 2

3838

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

3839

3840

BASIC_SUB_LINE: equ 0x58fc

3841

BASIC_SUB_LINEBOX: equ 0x5912

3842

BASIC_SUB_LINEBOXFILLED: equ 0x58C1

3843

BASIC_SUB_CIRCLE: equ 0x5B19

3844

BASIC_SUB_PAINT1: equ 0x59DA ;0x59C8

3845

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

3846

3847

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

3848

; Work areas

3849

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

3850

3851

BIOS_RG0SAV: EQU 0xF3DF

3852

BIOS_RG1SAV: EQU 0xF3E0

3853

BIOS_RG8SAV: EQU 0xFFE7

3854

BIOS_BDRATR: EQU 0xFCB2

3855

BIOS_STATFL: EQU 0xF3E7 ; VDP status register

3856

3857

BIOS_CXOFF: EQU 0xF945

3858

BIOS_CYOFF: EQU 0xF947

3859

BIOS_GXPOS: EQU 0xFCB3

3860

BIOS_GYPOS: EQU 0xFCB5

3861

3862

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

3863

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

3864

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

3865

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

3866

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

3867

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

3868

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

3869

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

3870

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

3871

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

3872

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

3873

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

3874

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

3875

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

3876

3877

BIOS_PARM1: EQU 0xF6E8 ; 100

3878

BIOS_PARM2: EQU 0xF750 ; 100

3879

3880

GFX_TEMP: EQU BIOS_PARM1 ; 2

3881

GFX_TEMP1: EQU GFX_TEMP + 2 ; 2

3882

GFX_TEMP2: EQU GFX_TEMP1 + 2 ; 2

3883

GFX_TEMP3: EQU GFX_TEMP2 + 2 ; 2

3884

GFX_TEMP4: EQU GFX_TEMP3 + 2 ; 2

3885

GFX_TEMP5: EQU GFX_TEMP4 + 2 ; 2

3886

GFX_TEMP6: EQU GFX_TEMP5 + 2 ; 2

3887

GFX_TEMP7: EQU GFX_TEMP6 + 2 ; 2

3888

GFX_TEMP8: EQU GFX_TEMP7 + 2 ; 2

3889

GFX_TEMP9: EQU GFX_TEMP8 + 2 ; 2

3890

3891

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

3892

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

3893

3894

3895

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

3896

; gfxIsScreenModeMSX2

3897

; return if screen mode is from MSX 2

3898

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

3899

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

3900

3901

gfxIsScreenModeMSX2:

3902

ld a, (BIOS_VERSION)

3903

or 0

3904

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

3905

scf

3906

ret

3907

3908

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

3909

; gfxSetScreenMode

3910

; set current screen mode

3911

; in A = screen number

3912

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

3913

3914

gfxSetScreenMode:

3915

push af

3916

ld a, (BIOS_VERSION)

3917

or 0

3918

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

3919

pop af

3920

cp 4

3921

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

3922

__call_bios BIOS_CHGMOD ; change the screen mode (msx1)

3923

jr gfxSetScreenMode.2

3924

3925

gfxSetScreenMode.0:

3926

ld a, 2

3927

ret

3928

3929

gfxSetScreenMode.1:

3930

pop af

3931

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

3932

call BIOS_EXTROM

3933

3934

gfxSetScreenMode.2:

3935

call gfxGetScreenHeight

3936

jp gfxGetScreenWidth

3937

3938

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

3939

; gfxGetScreenMode

3940

; return current screen mode

3941

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

3942

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

3943

3944

gfxGetScreenMode:

3945

ld a, (BIOS_SCRMOD)

3946

ret

3947

3948

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

3949

; gfxSetXY

3950

; set current screen location

3951

; in BC = x

3952

; DE = y

3953

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

3954

3955

gfxSetXY:

3956

ld (BIOS_GRPACX), bc ; x

3957

;ld (BIOS_GXPOS), bc

3958

ld (BIOS_GRPACY), de ; y

3959

;ld (BIOS_GYPOS), de

3960

jr gfxRefreshXY.1

3961

3962

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

3963

; gfxRefreshXY

3964

; refresh current screen location

3965

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

3966

3967

gfxRefreshXY:

3968

ld bc, (BIOS_GRPACX) ; x

3969

ld de, (BIOS_GRPACY) ; y

3970

gfxRefreshXY.1:

3971

call gfxIsScreenModeMSX2

3972

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

3973

__call_bios BIOS_SCALXY ; BC = X, DE = Y

3974

__call_bios BIOS_MAPXYC ; in BC = X, DE = Y

3975

ret

3976

gfxRefreshXY.2:

3977

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

3978

call BIOS_EXTROM

3979

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

3980

jp BIOS_EXTROM

3981

3982

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

3983

; gfxGetXY

3984

; get current screen location

3985

; out BC = x

3986

; DE = y

3987

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

3988

3989

gfxGetXY:

3990

ld bc, (BIOS_GRPACX) ; x

3991

ld de, (BIOS_GRPACY) ; y

3992

ret

3993

3994

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

3995

; gfxGetScreenHeight

3996

; get screen height

3997

; out hl = screen height

3998

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

3999

4000

gfxGetScreenHeight:

4001

push ix

4002

push af

4003

push de

4004

ld ix, BIOS_SCR_SIZE_Y

4005

ld a, (BIOS_SCRMOD)

4006

add a, a

4007

ld e, a

4008

ld d, 0

4009

add ix, de

4010

ld l, (ix)

4011

ld h, (ix+1)

4012

ld (BIOS_CYOFF), hl

4013

pop de

4014

pop af

4015

pop ix

4016

ret

4017

4018

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

4019

; gfxGetScreenWidth

4020

; get screen width

4021

; out hl = screen width

4022

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

4023

4024

gfxGetScreenWidth:

4025

push ix

4026

push af

4027

push de

4028

ld ix, BIOS_SCR_SIZE_X

4029

ld a, (BIOS_SCRMOD)

4030

add a, a

4031

ld e, a

4032

ld d, 0

4033

add ix, de

4034

ld l, (ix)

4035

ld h, (ix+1)

4036

ld (BIOS_CXOFF), hl

4037

pop de

4038

pop af

4039

pop ix

4040

ret

4041

4042

if defined GFX_FAST and defined PAINT

4043

4044

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

4045

; gfxUp

4046

; move screen current location up

4047

; out: carry if off screen

4048

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

4049

4050

gfxUp:

4051

push bc

4052

ld hl, 0

4053

ld de, (BIOS_GRPACY)

4054

or a

4055

sbc hl, de

4056

jr z, gfxUp.1

4057

dec de

4058

ld (BIOS_GRPACY), de

4059

call gfxRefreshXY

4060

scf

4061

ccf

4062

jr gfxUp.2

4063

gfxUp.1:

4064

scf

4065

gfxUp.2:

4066

pop bc

4067

ret

4068

4069

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

4070

; gfxDown

4071

; move screen current location down

4072

; out: carry if off screen

4073

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

4074

4075

gfxDown:

4076

push bc

4077

ld hl, (BIOS_CYOFF)

4078

ld de, (BIOS_GRPACY)

4079

or a

4080

sbc hl, de

4081

jr z, gfxDown.1

4082

inc de

4083

ld (BIOS_GRPACY), de

4084

call gfxRefreshXY

4085

scf

4086

ccf

4087

jr gfxDown.2

4088

gfxDown.1:

4089

scf

4090

gfxDown.2:

4091

pop bc

4092

ret

4093

4094

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

4095

; gfxLeft

4096

; move screen current location left

4097

; out: carry if off screen

4098

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

4099

4100

gfxLeft:

4101

push bc

4102

ld hl, 0

4103

ld de, (BIOS_GRPACX)

4104

or a

4105

sbc hl, de

4106

jr z, gfxLeft.1

4107

dec de

4108

ld (BIOS_GRPACX), de

4109

call gfxRefreshXY

4110

scf

4111

ccf

4112

jr gfxLeft.2

4113

gfxLeft.1:

4114

scf

4115

gfxLeft.2:

4116

pop bc

4117

ret

4118

4119

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

4120

; gfxRight

4121

; move screen current location right

4122

; out: carry if off screen

4123

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

4124

4125

gfxRight:

4126

push bc

4127

ld hl, (BIOS_CXOFF)

4128

ld de, (BIOS_GRPACX)

4129

or a

4130

sbc hl, de

4131

jr z, gfxRight.1

4132

inc de

4133

ld (BIOS_GRPACX), de

4134

call gfxRefreshXY

4135

scf

4136

ccf

4137

jr gfxRight.2

4138

gfxRight.1:

4139

scf

4140

gfxRight.2:

4141

pop bc

4142

ret

4143

4144

endif

4145

4146

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

4147

; gfxPushXY

4148

; push current screen location

4149

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

4150

4151

gfxPushXY:

4152

4153

pop ix

4154

ld iy, (BIOS_GRPACX) ; x

4155

push iy

4156

ld iy, (BIOS_GRPACY) ; y

4157

push iy

4158

push ix

4159

4160

ret

4161

4162

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

4163

; gfxPopXY

4164

; pop current screen location

4165

; out BC = x

4166

; DE = y

4167

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

4168

4169

gfxPopXY:

4170

pop ix

4171

pop de ; y

4172

pop bc ; x

4173

push ix

4174

jp gfxSetXY

4175

4176

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

4177

; gfxSetForeColor

4178

; set current foreground color

4179

; A = color

4180

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

4181

4182

gfxSetForeColor:

4183

ld (BIOS_FORCLR), a ; foreground color

4184

ld (BIOS_ATRBYT), a

4185

ret

4186

4187

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

4188

; gfxGetForeColor

4189

; get current foreground color

4190

; out A = color

4191

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

4192

4193

gfxGetForeColor:

4194

ld a, (BIOS_FORCLR) ; foreground color

4195

ret

4196

4197

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

4198

; gfxSetBackColor

4199

; set current background color

4200

; A = color

4201

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

4202

4203

gfxSetBackColor:

4204

ld (BIOS_BAKCLR), a ; foreground color

4205

ret

4206

4207

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

4208

; gfxGetBackColor

4209

; get current background color

4210

; out A = color

4211

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

4212

4213

gfxGetBackColor:

4214

ld a, (BIOS_BAKCLR) ; foreground color

4215

ret

4216

4217

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

4218

; gfxSetBorderColor

4219

; set current border color

4220

; A = color

4221

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

4222

4223

gfxSetBorderColor:

4224

ld (BIOS_BDRCLR), a ; border color

4225

ret

4226

4227

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

4228

; gfxGetBorderColor

4229

; get current border color

4230

; out A = color

4231

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

4232

4233

gfxGetBorderColor:

4234

ld a, (BIOS_BDRCLR) ; border color

4235

ret

4236

4237

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

4238

; gfxSetBorderFill

4239

; set fill border color

4240

; A = color

4241

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

4242

4243

gfxSetBorderFill:

4244

ld (BIOS_BDRATR), a ; border color

4245

ret

4246

4247

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

4248

; gfxGetBorderFill

4249

; get fill border color

4250

; out A = color

4251

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

4252

4253

gfxGetBorderFill:

4254

ld a, (BIOS_BDRATR) ; border color

4255

ret

4256

4257

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

4258

; gfxSetColor

4259

; set current color (foreground, background and border)

4260

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

4261

4262

gfxSetColor:

4263

ld a, (BIOS_SCRMOD)

4264

bit 3, a

4265

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

4266

bit 2, a

4267

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

4268

jp BIOS_CHGCLR ; change VDP colors

4269

; __call_bios BIOS_SETATR ; change the pixel color

4270

;ret

4271

4272

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

4273

; gfxSetPixel

4274

; set pixel in current position to current foreground color

4275

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

4276

4277

gfxSetPixel:

4278

call gfxIsScreenModeMSX2

4279

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

4280

__call_bios BIOS_SETC

4281

ret

4282

gfxSetPixel.1:

4283

ld ix, BIOS_SETC2

4284

jp BIOS_EXTROM

4285

4286

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

4287

; gfxGetPixel

4288

; get pixel color in current position

4289

; out A = pixel color

4290

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

4291

4292

gfxGetPixel:

4293

call gfxIsScreenModeMSX2

4294

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

4295

__call_bios BIOS_READC

4296

ret

4297

gfxGetPixel.1:

4298

ld ix, BIOS_READC2

4299

jp BIOS_EXTROM

4300

4301

if defined LINE

4302

4303

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

4304

; gfxDrawLine

4305

; plot a line from current position to informed destination

4306

; in BC = destination x

4307

; DE = destination y

4308

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

4309

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

4310

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

4311

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

4312

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

4313

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

4314

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

4315

; for(;;){

4316

; setPixel(x0,y0);

4317

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

4318

; e2 = err;

4319

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

4320

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

4321

; }

4322

;}

4323

4324

gfxDrawLine:

4325

if not defined GFX_FAST

4326

ld hl, (BIOS_GRPACX)

4327

ld (BIOS_GXPOS), hl

4328

ld hl, (BIOS_GRPACY)

4329

ld (BIOS_GYPOS), hl

4330

jp BASIC_SUB_LINE

4331

4332

else

4333

4334

ld (GFX_TEMP2), bc ; x

4335

ld (GFX_TEMP3), de ; y

4336

4337

ld hl, (BIOS_GRPACX) ; x0

4338

ld de, (GFX_TEMP2) ; x

4339

;or a

4340

;sbc hl, de

4341

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

4342

call MATH.COMP.S16

4343

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

4344

or a

4345

sbc hl, de

4346

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

4347

ld hl, 0xffff

4348

ld (GFX_TEMP5), hl ; sx = -1

4349

jr gfxLine.2

4350

4351

gfxLine.1:

4352

ld de, (BIOS_GRPACX) ; x0

4353

ld hl, (GFX_TEMP2) ; x

4354

or a

4355

sbc hl, de

4356

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

4357

ld hl, 1

4358

ld (GFX_TEMP5), hl ; sx = 1

4359

4360

gfxLine.2:

4361

ld hl, (BIOS_GRPACY) ; y0

4362

ld de, (GFX_TEMP3) ; y

4363

;or a

4364

;sbc hl, de

4365

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

4366

call MATH.COMP.S16

4367

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

4368

or a

4369

sbc hl, de

4370

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

4371

ld hl, 0xffff

4372

ld (GFX_TEMP7), hl ; sy = -1

4373

jr gfxLine.4

4374

4375

gfxLine.3:

4376

ld de, (BIOS_GRPACY) ; y0

4377

ld hl, (GFX_TEMP3) ; y

4378

or a

4379

sbc hl, de

4380

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

4381

ld hl, 1

4382

ld (GFX_TEMP7), hl ; sy = 1

4383

4384

gfxLine.4:

4385

ld hl, (GFX_TEMP6) ; dy

4386

ld de, 0

4387

call MATH.COMP.S16

4388

jp z, gfxLine.h ; dy = 0?

4389

4390

ld hl, (GFX_TEMP4) ; dx

4391

ld de, 0

4392

call MATH.COMP.S16

4393

jp z, gfxLine.v ; dx = 0?

4394

4395

ld de, (GFX_TEMP4) ; dx

4396

ld hl, (GFX_TEMP6) ; dy

4397

or a

4398

adc hl, de

4399

dec hl

4400

dec hl

4401

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

4402

4403

ld de, (GFX_TEMP4) ; dx

4404

ld hl, (GFX_TEMP6) ; dy

4405

;or a

4406

;sbc hl, de

4407

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

4408

call MATH.COMP.S16

4409

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

4410

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

4411

;ld hl, 0

4412

ld de, (GFX_TEMP6) ; dy

4413

or a

4414

srl d

4415

rr e ; dy / 2

4416

;or a

4417

;sbc hl, de ; -dy

4418

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

4419

jr gfxLine.loop

4420

4421

gfxLine.5:

4422

ld hl, (GFX_TEMP4) ; dx

4423

or a

4424

srl h

4425

rr l

4426

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

4427

4428

gfxLine.loop:

4429

call gfxSetPixel

4430

4431

ld hl, (GFX_TEMP9) ; dxy

4432

ld de, 0

4433

call MATH.COMP.S16

4434

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

4435

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

4436

4437

ret

4438

4439

gfxLine.loop.0:

4440

ld hl, 0

4441

ld de, (GFX_TEMP4) ; dx

4442

or a

4443

sbc hl, de ; -dx

4444

ld de, (GFX_TEMP8) ; e2 = err

4445

push de

4446

;or a

4447

;sbc hl, de

4448

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

4449

call MATH.COMP.S16

4450

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

4451

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

4452

ld hl, (GFX_TEMP8) ; err

4453

ld de, (GFX_TEMP6) ; dy

4454

or a

4455

sbc hl, de

4456

ld (GFX_TEMP8), hl ; err -= dy

4457

4458

ld hl, (GFX_TEMP9) ; dxy

4459

dec hl

4460

ld (GFX_TEMP9), hl ; dxy -= 1

4461

4462

ld hl, (BIOS_GRPACX)

4463

ld de, (GFX_TEMP5)

4464

or a

4465

adc hl, de

4466

ld (BIOS_GRPACX), hl ; x0 += sx

4467

4468

gfxLine.loop.1:

4469

pop hl ; e2

4470

ld de, (GFX_TEMP6) ; dy

4471

;or a

4472

;sbc hl, de

4473

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

4474

call MATH.COMP.S16

4475

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

4476

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

4477

ld hl, (GFX_TEMP8) ; err

4478

ld de, (GFX_TEMP4) ; dx

4479

or a

4480

adc hl, de

4481

ld (GFX_TEMP8), hl ; err += dx

4482

4483

ld hl, (GFX_TEMP9) ; dxy

4484

dec hl

4485

ld (GFX_TEMP9), hl ; dxy -= 1

4486

4487

ld hl, (BIOS_GRPACY)

4488

ld de, (GFX_TEMP7)

4489

or a

4490

adc hl, de

4491

ld (BIOS_GRPACY), hl ; y0 += sy

4492

4493

gfxLine.loop.2:

4494

call gfxRefreshXY

4495

jp gfxLine.loop

4496

4497

gfxLine.h:

4498

ld a, (GFX_TEMP5) ; sx

4499

bit 7, a

4500

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

4501

ld hl, (BIOS_GRPACX)

4502

ld de, (GFX_TEMP4)

4503

or a

4504

sbc hl, de

4505

ld (BIOS_GRPACX), hl

4506

call gfxRefreshXY

4507

4508

gfxLine.h.1:

4509

__call_bios BIOS_FETCHC

4510

ld hl, (GFX_TEMP4) ; dx

4511

inc hl

4512

call gfxDrawHorLine ; HL = pixel count

4513

ret

4514

4515

gfxLine.v:

4516

ld a, (GFX_TEMP7) ; sy

4517

bit 7, a

4518

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

4519

ld hl, (BIOS_GRPACY)

4520

ld de, (GFX_TEMP6)

4521

or a

4522

sbc hl, de

4523

ld (BIOS_GRPACY), hl

4524

call gfxRefreshXY

4525

4526

gfxLine.v.1:

4527

call gfxSetPixel

4528

ld hl, (GFX_TEMP6) ; dy

4529

inc hl

4530

ld (GFX_TEMP3), hl

4531

jp gfxBox.drawVerLine

4532

endif

4533

4534

endif

4535

4536

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

4537

4538

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

4539

; gfxDrawBox

4540

; plot a box from current position to informed destination

4541

; in BC = destination x

4542

; DE = destination y

4543

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

4544

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

4545

4546

gfxDrawBox:

4547

4548

if not defined GFX_FAST

4549

ld hl, (BIOS_GRPACX)

4550

ld (BIOS_GXPOS), hl

4551

ld hl, (BIOS_GRPACY)

4552

ld (BIOS_GYPOS), hl

4553

ld hl, BASIC_SUB_LINEBOX

4554

or 0

4555

jr z, gfxDrawBox.1

4556

call gfxIsScreenModeMSX2

4557

jr nc, gfxDrawBox.2

4558

ld hl, BASIC_SUB_LINEBOXFILLED

4559

4560

gfxDrawBox.1:

4561

jp (hl)

4562

4563

gfxDrawBox.2:

4564

xor a

4565

ld hl, BASIC_BUF

4566

ld (hl), a

4567

ld ix, BIOS_DOBOXF

4568

jp BIOS_EXTROM

4569

4570

else

4571

call gfxAdjustDestXY

4572

or 0

4573

jr nz, gfxBox.filled

4574

4575

gfxBox.notFilled:

4576

call gfxPushXY

4577

call gfxBox.drawHorLine

4578

ld hl, (GFX_TEMP2)

4579

ld de, (BIOS_GRPACX)

4580

or a

4581

adc hl, de

4582

dec hl

4583

ld (BIOS_GRPACX), hl

4584

call gfxRefreshXY

4585

call gfxBox.drawVerLine

4586

call gfxPopXY

4587

call gfxBox.drawVerLine

4588

call gfxBox.drawHorLine

4589

ret

4590

4591

gfxBox.filled:

4592

ld hl, (GFX_TEMP3)

4593

;inc hl

4594

gfxBox.filled.loop:

4595

push hl

4596

ld bc, (BIOS_GRPACX)

4597

push bc

4598

call gfxBox.drawHorLine

4599

pop bc

4600

ld (BIOS_GRPACX), bc

4601

ld bc, (BIOS_GRPACY)

4602

inc bc

4603

ld (BIOS_GRPACY), bc

4604

call gfxRefreshXY

4605

pop hl

4606

ld de, 1

4607

or a

4608

sbc hl, de

4609

jr nz, gfxBox.filled.loop

4610

ret

4611

4612

gfxBox.drawHorLine:

4613

ld hl, (GFX_TEMP2)

4614

;inc hl

4615

call gfxDrawHorLine

4616

ret

4617

4618

gfxBox.drawVerLine:

4619

ld hl, (GFX_TEMP3)

4620

dec hl

4621

gfxBox.drawVerLine.loop:

4622

push hl

4623

call gfxDown

4624

call gfxSetPixel

4625

pop hl

4626

ld de, 1

4627

or a

4628

sbc hl, de

4629

jr nz, gfxBox.drawVerLine.loop

4630

ret

4631

4632

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

4633

; gfxDrawHorLine

4634

; draw a horizontal line

4635

; HL = pixel count

4636

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

4637

4638

gfxDrawHorLine:

4639

ld a, (BIOS_SCRMOD)

4640

cp 5

4641

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

4642

bit 7, h

4643

ret nz ; return if negative

4644

xor a

4645

cp h

4646

jr nz, gfxDrawHorLine.1

4647

cp l

4648

ret z ; return if hl = 0

4649

call gfxPushXY

4650

gfxDrawHorLine.1:

4651

push hl

4652

call gfxSetPixel

4653

call gfxRight

4654

pop hl

4655

ld de, 1

4656

sbc hl, de

4657

jr nz, gfxDrawHorLine.1

4658

call gfxPopXY

4659

ret

4660

gfxDrawHorLine.2:

4661

__call_bios BIOS_NSETCX ; HL = fill count

4662

ret

4663

4664

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

4665

; gfxAdjustDestXY

4666

; invert if dest XY is less than current XY position

4667

; BC = dest x

4668

; DE = dest y

4669

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

4670

4671

gfxAdjustDestXY:

4672

push af

4673

ld (GFX_TEMP2), bc ; x

4674

ld (GFX_TEMP3), de ; y

4675

4676

; verify x againt current position

4677

ld hl, (BIOS_GRPACX)

4678

ld de, (GFX_TEMP2)

4679

and a

4680

sbc hl, de ; dx = x1 - x0

4681

bit 7, h ; result is negative?

4682

jr z, gfxAdjustDestXY.1

4683

add hl, de

4684

ld (BIOS_GRPACX), hl

4685

ex de, hl

4686

or a

4687

sbc hl, de

4688

gfxAdjustDestXY.1:

4689

inc hl

4690

ld (GFX_TEMP2), hl

4691

4692

; verify y againt current position

4693

ld hl, (BIOS_GRPACY)

4694

ld de, (GFX_TEMP3)

4695

and a

4696

sbc hl, de ; dy = y1 - y0

4697

bit 7, h ; result is negative?

4698

jr z, gfxAdjustDestXY.2

4699

add hl, de

4700

ld (BIOS_GRPACY), hl

4701

ex de, hl

4702

or a

4703

sbc hl, de

4704

gfxAdjustDestXY.2:

4705

inc hl

4706

ld (GFX_TEMP3), hl

4707

4708

; refresh new position

4709

call gfxRefreshXY

4710

pop af

4711

ret

4712

endif

4713

4714

endif

4715

4716

if defined CIRCLE

4717

4718

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

4719

; gfxDrawCircle

4720

; plot a circle centered in current position

4721

; BC = tracing end x

4722

; DE = tracing end y

4723

; HL = radius

4724

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

4725

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

4726

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

4727

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

4728

4729

gfxDrawCircle:

4730

4731

if not defined GFX_FAST

4732

bit 7,h

4733

ret nz ; return if negative radius

4734

ld (BIOS_GXPOS), hl ; circle ray

4735

ld de, (BIOS_GXPOS)

4736

ld bc, (BIOS_GRPACY)

4737

ld (BIOS_GYPOS), bc

4738

xor a

4739

;cp h

4740

;jr nz, gfxDrawCircle.1

4741

;cp l

4742

;ret z

4743

gfxDrawCircle.1:

4744

ld hl, BASIC_BUF

4745

ld (hl), a

4746

ld ix, 0xFFFF

4747

jp BASIC_SUB_CIRCLE

4748

else

4749

ld (GFX_TEMP), hl ; radius

4750

ld de, 0

4751

sbc hl, de

4752

ret z ; return if zero radius

4753

bit 7,h

4754

ret nz ; return if negative radius

4755

4756

call gfxGetXY

4757

ld (GFX_TEMP1), bc ; x0

4758

ld (GFX_TEMP2), de ; y0

4759

4760

or 0

4761

jp nz, gfxCircle.filled

4762

4763

gfxCircle.notFilled:

4764

ld hl, 1

4765

ld de, (GFX_TEMP) ; radius

4766

or a

4767

sbc hl, de

4768

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

4769

4770

ld hl, 0

4771

ld (GFX_TEMP4), hl ; ddF_x = 0

4772

4773

ld hl, (GFX_TEMP)

4774

or a

4775

adc hl, hl

4776

ex de, hl

4777

ld hl, 0

4778

or a

4779

sbc hl, de

4780

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

4781

4782

ld hl, 0

4783

ld (GFX_TEMP6), hl ; x = 0

4784

4785

ld hl, (GFX_TEMP)

4786

ld (GFX_TEMP7), hl ; y = radius

4787

4788

; plot(x0, y0 + radius)

4789

ld de, (GFX_TEMP) ; radius

4790

ld hl, (GFX_TEMP2) ; y0

4791

or a

4792

adc hl, de

4793

ex de, hl

4794

ld bc, (GFX_TEMP1) ; x0

4795

call gfxSetXY

4796

call gfxSetPixel

4797

4798

; plot(x0, y0 - radius)

4799

ld de, (GFX_TEMP) ; radius

4800

ld hl, (GFX_TEMP2) ; y0

4801

or a

4802

sbc hl, de

4803

ex de, hl

4804

ld bc, (GFX_TEMP1) ; x0

4805

call gfxSetXY

4806

call gfxSetPixel

4807

4808

; plot(x0 + radius, y0)

4809

ld hl, (GFX_TEMP1) ; x0

4810

ld de, (GFX_TEMP) ; radius

4811

or a

4812

adc hl, de

4813

push hl

4814

pop bc

4815

ld de, (GFX_TEMP2) ; y0

4816

call gfxSetXY

4817

call gfxSetPixel

4818

4819

; plot(x0 - radius, y0)

4820

ld hl, (GFX_TEMP1) ; x0

4821

ld de, (GFX_TEMP) ; radius

4822

or a

4823

sbc hl, de

4824

push hl

4825

pop bc

4826

ld de, (GFX_TEMP2) ; y0

4827

call gfxSetXY

4828

call gfxSetPixel

4829

jp gfxCircle.notFilled.3

4830

4831

gfxCircle.notFilled.1:

4832

ld hl, (GFX_TEMP3) ; f

4833

bit 7, h

4834

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

4835

4836

ld hl, (GFX_TEMP7) ; y -= 1

4837

dec hl

4838

ld (GFX_TEMP7), hl

4839

4840

ld hl, (GFX_TEMP5) ; ddF_y += 2

4841

inc hl

4842

inc hl

4843

ld (GFX_TEMP5), hl

4844

4845

ld hl, (GFX_TEMP3) ; f

4846

ld de, (GFX_TEMP5) ; ddF_y

4847

or a

4848

adc hl, de

4849

ld (GFX_TEMP3), hl ; f += ddF_y

4850

4851

gfxCircle.notFilled.2:

4852

ld hl, (GFX_TEMP6) ; x

4853

inc hl

4854

ld (GFX_TEMP6), hl ; x++

4855

4856

ld hl, (GFX_TEMP4) ; ddF_x += 2

4857

inc hl

4858

inc hl

4859

ld (GFX_TEMP4), hl

4860

4861

ld hl, (GFX_TEMP3) ; f

4862

ld de, (GFX_TEMP4) ; ddF_x

4863

or a

4864

adc hl, de

4865

inc hl

4866

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

4867

4868

; plot(x0 + x, y0 + y)

4869

ld hl, (GFX_TEMP1) ; x0

4870

ld de, (GFX_TEMP6) ; x

4871

or a

4872

adc hl, de

4873

push hl

4874

pop bc

4875

ld hl, (GFX_TEMP2) ; y0

4876

ld de, (GFX_TEMP7) ; y

4877

or a

4878

adc hl, de

4879

ex de, hl

4880

call gfxSetXY

4881

call gfxSetPixel

4882

4883

; plot(x0 - x, y0 + y)

4884

ld hl, (GFX_TEMP1) ; x0

4885

ld de, (GFX_TEMP6) ; x

4886

or a

4887

sbc hl, de

4888

push hl

4889

pop bc

4890

ld hl, (GFX_TEMP2) ; y0

4891

ld de, (GFX_TEMP7) ; y

4892

or a

4893

adc hl, de

4894

ex de, hl

4895

call gfxSetXY

4896

call gfxSetPixel

4897

4898

; plot(x0 + x, y0 - y)

4899

ld hl, (GFX_TEMP1) ; x0

4900

ld de, (GFX_TEMP6) ; x

4901

or a

4902

adc hl, de

4903

push hl

4904

pop bc

4905

ld hl, (GFX_TEMP2) ; y0

4906

ld de, (GFX_TEMP7) ; y

4907

or a

4908

sbc hl, de

4909

ex de, hl

4910

call gfxSetXY

4911

call gfxSetPixel

4912

4913

; plot(x0 - x, y0 - y)

4914

ld hl, (GFX_TEMP1) ; x0

4915

ld de, (GFX_TEMP6) ; x

4916

or a

4917

sbc hl, de

4918

push hl

4919

pop bc

4920

ld hl, (GFX_TEMP2) ; y0

4921

ld de, (GFX_TEMP7) ; y

4922

or a

4923

sbc hl, de

4924

ex de, hl

4925

call gfxSetXY

4926

call gfxSetPixel

4927

4928

; plot(x0 + y, y0 + x)

4929

ld hl, (GFX_TEMP1) ; x0

4930

ld de, (GFX_TEMP7) ; y

4931

or a

4932

adc hl, de

4933

push hl

4934

pop bc

4935

ld hl, (GFX_TEMP2) ; y0

4936

ld de, (GFX_TEMP6) ; x

4937

or a

4938

adc hl, de

4939

ex de, hl

4940

call gfxSetXY

4941

call gfxSetPixel

4942

4943

; plot(x0 - y, y0 + x)

4944

ld hl, (GFX_TEMP1) ; x0

4945

ld de, (GFX_TEMP7) ; y

4946

or a

4947

sbc hl, de

4948

push hl

4949

pop bc

4950

ld hl, (GFX_TEMP2) ; y0

4951

ld de, (GFX_TEMP6) ; x

4952

or a

4953

adc hl, de

4954

ex de, hl

4955

call gfxSetXY

4956

call gfxSetPixel

4957

4958

; plot(x0 + y, y0 - x)

4959

ld hl, (GFX_TEMP1) ; x0

4960

ld de, (GFX_TEMP7) ; y

4961

or a

4962

adc hl, de

4963

push hl

4964

pop bc

4965

ld hl, (GFX_TEMP2) ; y0

4966

ld de, (GFX_TEMP6) ; x

4967

or a

4968

sbc hl, de

4969

ex de, hl

4970

call gfxSetXY

4971

call gfxSetPixel

4972

4973

; plot(x0 - y, y0 - x)

4974

ld hl, (GFX_TEMP1) ; x0

4975

ld de, (GFX_TEMP7) ; y

4976

or a

4977

sbc hl, de

4978

push hl

4979

pop bc

4980

ld hl, (GFX_TEMP2) ; y0

4981

ld de, (GFX_TEMP6) ; x

4982

or a

4983

sbc hl, de

4984

ex de, hl

4985

call gfxSetXY

4986

call gfxSetPixel

4987

4988

gfxCircle.notFilled.3:

4989

ld hl, (GFX_TEMP6) ; x

4990

ld de, (GFX_TEMP7) ; y

4991

or a

4992

sbc hl, de

4993

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

4994

ld bc, (GFX_TEMP1) ; x0

4995

ld de, (GFX_TEMP2) ; y0

4996

call gfxSetXY

4997

ret

4998

4999

gfxCircle.filled

5000

call gfxCircle.notFilled

5001

ld hl, (BIOS_BDRATR)

5002

push hl

5003

ld hl, (BIOS_FORCLR)

5004

ld (BIOS_BDRATR), hl

5005

ld a, 1

5006

call gfxBorderFill

5007

pop hl

5008

ld (BIOS_BDRATR), hl

5009

ret

5010

endif

5011

5012

endif

5013

5014

if defined PAINT or (defined CIRCLE and defined GFX_FAST)

5015

5016

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

5017

; gfxBorderFill

5018

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

5019

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

5020

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

5021

5022

gfxBorderFill:

5023

5024

if not defined GFX_FAST

5025

5026

ld bc, (BIOS_GRPACX)

5027

ld (BIOS_GXPOS), bc

5028

ld de, (BIOS_GRPACY)

5029

ld (BIOS_GYPOS), de

5030

push bc

5031

push de

5032

5033

xor a

5034

ld hl, BASIC_BUF

5035

ld (hl), a

5036

5037

ld a, (BIOS_BDRATR)

5038

xor b

5039

ld e, a

5040

ld a, (BIOS_ATRBYT)

5041

xor d

5042

ld c, a

5043

;ld ix, 0xFFFF

5044

;ld iy, 0xFFFF

5045

5046

call gfxIsScreenModeMSX2

5047

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

5048

ld a, (BIOS_BDRATR)

5049

ld (BIOS_ATRBYT), a

5050

ld e, a

5051

jp BASIC_SUB_PAINT1

5052

5053

gfxBorderFill.1:

5054

jp BASIC_SUB_PAINT1

5055

;ld ix, BASIC_SUB_PAINT2

5056

;jp BIOS_EXTROM

5057

5058

else

5059

5060

ld (GFX_TEMP1), a

5061

ld hl, (BIOS_GRPACY)

5062

push hl

5063

call gfxBorderFill.down

5064

pop hl

5065

push hl

5066

ld (BIOS_GRPACY), hl

5067

call gfxRefreshXY

5068

call gfxBorderFill.up

5069

pop hl

5070

ld (BIOS_GRPACY), hl

5071

call gfxRefreshXY

5072

ret

5073

5074

gfxBorderFill.down:

5075

call gfxBorderFill.line

5076

call gfxDown

5077

ret c

5078

call gfxGetPixel

5079

ld hl, BIOS_BDRATR

5080

cp (hl)

5081

jr nz, gfxBorderFill.down

5082

ret

5083

5084

gfxBorderFill.up:

5085

call gfxBorderFill.line

5086

call gfxUp

5087

ret c

5088

call gfxGetPixel

5089

ld hl, BIOS_BDRATR

5090

cp (hl)

5091

jr nz, gfxBorderFill.up

5092

ret

5093

5094

gfxBorderFill.line:

5095

ld de, (BIOS_GRPACX)

5096

push de

5097

ld b, 1 ; fill flag

5098

ld de, 1 ; skip count

5099

__call_bios BIOS_SCANR

5100

;inc hl

5101

;ld (GFX_TEMP2), hl ; pixel count transversed

5102

pop de

5103

push de

5104

ld (BIOS_GRPACX), de

5105

call gfxRefreshXY

5106

;ld a, (GFX_TEMP1)

5107

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

5108

;jr z, gfxBorderFill.line.1

5109

;ld hl, (GFX_TEMP2)

5110

;__call_bios BIOS_NSETCX ; HL = fill count

5111

;jr gfxBorderFill.line.2

5112

gfxBorderFill.line.1:

5113

ld b, 1 ; fill flag

5114

ld de, 0 ; skip count

5115

__call_bios BIOS_SCANL

5116

gfxBorderFill.line.2:

5117

pop de

5118

ld (BIOS_GRPACX), de

5119

call gfxRefreshXY

5120

ret

5121

5122

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

5123

; gfxFloadFill

5124

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

5125

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

5126

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

5127

5128

gfxFloadFill:

5129

call gfxGetPixel

5130

ld (GFX_TEMP), a ; replacement-color

5131

call gfxFloadFill.recursive

5132

ret

5133

5134

gfxFloadFill.recursive:

5135

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

5136

ld a, (GFX_TEMP)

5137

ld hl, BIOS_FORCLR

5138

cp (hl)

5139

ret z

5140

5141

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

5142

call gfxGetPixel

5143

ld hl, GFX_TEMP

5144

cp (hl)

5145

ret nz

5146

5147

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

5148

call gfxSetPixel

5149

5150

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

5151

gfxFloadFill.recursive.left:

5152

call gfxLeft

5153

jr c, gfxFloadFill.recursive.right

5154

call gfxFloadFill.recursive

5155

call gfxRight

5156

5157

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

5158

gfxFloadFill.recursive.right:

5159

call gfxRight

5160

jr c, gfxFloadFill.recursive.up

5161

call gfxFloadFill.recursive

5162

call gfxLeft

5163

5164

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

5165

gfxFloadFill.recursive.up:

5166

call gfxUp

5167

jr c, gfxFloadFill.recursive.down

5168

call gfxFloadFill.recursive

5169

call gfxDown

5170

5171

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

5172

gfxFloadFill.recursive.down:

5173

call gfxDown

5174

ret c

5175

call gfxFloadFill.recursive

5176

call gfxUp

5177

ret

5178

5179

endif

5180

5181

endif

5182

5183

if defined SPRITEMODE

5184

5185

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

5186

; gfxSetSpriteMode

5187

; set current sprite mode

5188

; A = sprite mode

5189

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

5190

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

5191

; 2: Spritesize is 16 by 16 pixels

5192

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

5193

; RG1SAV bit 0 = magnify sprite (double size)

5194

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

5195

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

5196

5197

; begin changed

5198

gfxSetSpriteMode:

5199

and 3 ; keeps only bits 0 and 1 from A

5200

ld b, a

5201

5202

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

5203

and 0xFC ; clear bits 0 and 1 from A

5204

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

5205

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

5206

ld b, a ; value to write

5207

ld c, 1 ; register number to write

5208

call gfxWRTVDP ; write register to VDP

5209

call gfxCLRSPR ; clear sprites

5210

5211

ret

5212

5213

; end changed

5214

5215

endif

5216

5217

5218

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

5219

5220

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

5221

; gfxSetSpriteColorInt

5222

; A = sprite number

5223

; BC = color number

5224

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

5225

5226

gfxSetSpriteColorInt:

5227

ld b, a ; save sprite number

5228

; begin changed

5229

call gfxCALATR ; get sprite attribute table address

5230

; end changed

5231

inc hl

5232

inc hl

5233

inc hl

5234

ld a, c ; color

5235

call gfxWRTVRM

5236

5237

ld a, (BIOS_SCRMOD)

5238

cp 3

5239

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

5240

5241

ld a, b ; recover sprite number

5242

call gfxGetSpriteColorTable

5243

5244

ld a, c ; color

5245

ld b, 16 ; array of 16 bytes

5246

5247

gfxSetSpriteColorInt.1:

5248

; begin changed

5249

push bc

5250

call gfxWRTVRM

5251

pop bc

5252

; end changed

5253

inc hl

5254

djnz gfxSetSpriteColorInt.1

5255

ret

5256

5257

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

5258

; gfxSetSpriteColorStr

5259

; A = sprite number

5260

; DE = address to color byte array

5261

; BC = color byte array size

5262

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

5263

5264

gfxSetSpriteColorStr:

5265

ld b, a ; save sprite number

5266

push bc

5267

push de

5268

; begin changed

5269

call gfxCALATR ; get sprite attribute table

5270

; end changed

5271

pop de

5272

pop bc

5273

5274

ld a, c ; byte array zero length?

5275

or a

5276

ret z

5277

5278

inc hl

5279

inc hl

5280

inc hl

5281

ld a, (de) ; color

5282

call gfxWRTVRM

5283

5284

ld a, (BIOS_SCRMOD)

5285

cp 3

5286

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

5287

5288

ld a, b ; recover sprite number

5289

call gfxGetSpriteColorTable

5290

5291

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

5292

ld a, c ; size of color array

5293

push de

5294

pop iy ; save array start

5295

5296

gfxSetSpriteColorStr.1:

5297

push af

5298

ld a, (de)

5299

call gfxWRTVRM

5300

inc hl

5301

inc de

5302

pop af

5303

dec a

5304

jr nz, gfxSetSpriteColorStr.2

5305

ld a, c ; recover array size

5306

push iy

5307

pop de ; recover array start

5308

5309

gfxSetSpriteColorStr.2:

5310

djnz gfxSetSpriteColorStr.1

5311

ret

5312

5313

5314

5315

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

5316

; gfxGetSpriteColorTable

5317

; A = sprite number

5318

; HL = address to color table

5319

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

5320

5321

gfxGetSpriteColorTable:

5322

push af

5323

push de

5324

ld h, 0

5325

ld l, a ; recover sprite number

5326

add hl, hl

5327

add hl, hl

5328

add hl, hl

5329

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

5330

push hl

5331

xor a

5332

; begin changed

5333

call gfxCALATR ; get sprite attribute table address

5334

; end changed

5335

pop de

5336

add hl, de

5337

xor a

5338

ld de, 512

5339

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

5340

pop de

5341

pop af

5342

ret

5343

5344

endif

5345

5346

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

5347

5348

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

5349

; gfxSetSpriteXY

5350

; A = sprite number

5351

; BC = XY

5352

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

5353

5354

; begin changed

5355

5356

gfxSetSpriteXY:

5357

push bc

5358

call gfxCALATR ; get sprite attribute table address

5359

pop bc

5360

ld a, c ; y

5361

call gfxWRTVRM

5362

inc hl

5363

ld a, b ; x

5364

call gfxWRTVRM

5365

ret

5366

5367

; end changed

5368

5369

endif

5370

5371

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

5372

5373

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

5374

; gfxSetSpritePattern

5375

; A = sprite number

5376

; BC = pattern number

5377

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

5378

5379

; begin changed

5380

5381

gfxSetSpritePattern:

5382

push bc

5383

call gfxCALATR ; get sprite attribute table address

5384

pop bc

5385

inc hl

5386

inc hl

5387

ld a, c ; pattern number

5388

call gfxWRTVRM

5389

ret

5390

5391

; end changed

5392

5393

endif

5394

5395

if defined SPRITE

5396

5397

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

5398

; gfxSetSpriteData

5399

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

5400

; A = sprite number

5401

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

5402

5403

; begin changed

5404

5405

gfxSetSpriteData:

5406

push AF

5407

push HL

5408

call gfxCALPAT ; get sprite pattern data address

5409

ex DE, HL

5410

call gfxGSPSIZ ; return in 'a' sprite default size

5411

pop HL

5412

ld b, 0

5413

cp c

5414

jr z, gfxSetSpriteData.1

5415

jr nc, gfxSetSpriteData.1

5416

ld c, a

5417

gfxSetSpriteData.1:

5418

push bc

5419

ld c, a

5420

xor a

5421

call gfxFILVRM

5422

pop bc

5423

pop AF

5424

call gfxLDIRVM

5425

ret

5426

5427

; end changed

5428

5429

endif

5430

5431

if defined GFX_SPRITES

5432

5433

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

5434

; gfxInitSprites

5435

; initialises all sprites

5436

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

5437

5438

; begin changed

5439

gfxInitSprites:

5440

call gfxCLRSPR

5441

ret

5442

; end changed

5443

5444

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

5445

; gfxSetSpriteAttrs

5446

; set sprite default x, y, pattern and color

5447

; A = sprite number

5448

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

5449

5450

gfxSetSpriteAttrs:

5451

push af

5452

; begin changed

5453

call gfxCALATR

5454

; end changed

5455

ld a, (BIOS_GRPACY) ; y

5456

call gfxWRTVRM

5457

inc hl

5458

ld a, (BIOS_GRPACX) ; x

5459

call gfxWRTVRM

5460

inc hl

5461

pop af ; pattern

5462

call gfxWRTVRM

5463

inc hl

5464

ld a, (BIOS_FORCLR) ; color

5465

call gfxWRTVRM

5466

ret

5467

5468

endif

5469

5470

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

5471

; VDP / VRAM support routines

5472

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

5473

5474

; WRITE TO VDP

5475

; in b = data

5476

; c = register number

5477

; a = register number

5478

gfxWRTVDP:

5479

bit 7, a

5480

ret nz ; is negative? read only

5481

cp 8

5482

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

5483

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

5484

jr gfxWRTVDP.3

5485

gfxWRTVDP.1:

5486

ld ix, BIOS_SCRMOD

5487

bit 3, (ix)

5488

jr nz, gfxWRTVDP.2

5489

bit 2, (ix)

5490

jr nz, gfxWRTVDP.2

5491

ret

5492

gfxWRTVDP.2:

5493

dec a

5494

ld c, a

5495

gfxWRTVDP.3:

5496

;ld ix, BIOS_SCRMOD

5497

;bit 3, (ix)

5498

;jp nz, BIOS_NWRVDP ; msx 2

5499

;bit 2, (ix)

5500

;jp nz, BIOS_NWRVDP ; msx 2

5501

jp BIOS_WRTVDP ; msx 1

5502

5503

; READ FROM VDP

5504

; in a = register number

5505

; out a = data

5506

gfxRDVDP:

5507

bit 7, a

5508

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

5509

cp 8

5510

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

5511

cp 9

5512

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

5513

ld hl, BIOS_RG0SAV ; else is correct control registers numbers

5514

jr gfxRDVDP.4

5515

gfxRDVDP.1:

5516

ld ix, BIOS_SCRMOD

5517

bit 3, (ix)

5518

jr nz, gfxRDVDP.1.a

5519

bit 2, (ix)

5520

jr nz, gfxRDVDP.1.a

5521

xor a

5522

ret

5523

gfxRDVDP.1.a:

5524

neg

5525

jp BIOS_NRDVDP ;BIOS_VDPSTA

5526

gfxRDVDP.2:

5527

ld a, (BIOS_STATFL)

5528

ret

5529

;xor a

5530

;jp BIOS_VDPSTA

5531

gfxRDVDP.3:

5532

ld hl, BIOS_RG8SAV-9

5533

gfxRDVDP.4:

5534

ld d, 0

5535

ld e, a

5536

add hl,de

5537

ld a, (hl)

5538

ret

5539

5540

; begin changed

5541

gfxFILVRM:

5542

ld ix, BIOS_SCRMOD

5543

bit 3, (ix)

5544

jp nz, BIOS_BIGFIL

5545

bit 2, (ix)

5546

jp nz, BIOS_BIGFIL

5547

jp BIOS_FILVRM

5548

5549

gfxCALPAT:

5550

ld iy, BIOS_SCRMOD

5551

ld ix, BIOS_CALPAT2

5552

bit 3, (iy)

5553

jp nz, BIOS_EXTROM

5554

bit 2, (iy)

5555

jp nz, BIOS_EXTROM

5556

jp BIOS_CALPAT

5557

5558

gfxCALATR:

5559

ld iy, BIOS_SCRMOD

5560

ld ix, BIOS_CALATR2

5561

bit 3, (iy)

5562

jp nz, BIOS_EXTROM

5563

bit 2, (iy)

5564

jp nz, BIOS_EXTROM

5565

jp BIOS_CALATR

5566

5567

gfxGSPSIZ:

5568

ld iy, BIOS_SCRMOD

5569

ld ix, BIOS_GSPSIZ2

5570

bit 3, (iy)

5571

jp nz, BIOS_EXTROM

5572

bit 2, (iy)

5573

jp nz, BIOS_EXTROM

5574

jp BIOS_GSPSIZ

5575

5576

gfxCLRSPR:

5577

ld iy, BIOS_SCRMOD

5578

ld ix, BIOS_CLRSPR2

5579

bit 3, (iy)

5580

jp nz, BIOS_EXTROM

5581

bit 2, (iy)

5582

jp nz, BIOS_EXTROM

5583

jp BIOS_CLRSPR

5584

5585

gfxLDIRVM:

5586

jp BIOS_LDIRVM

5587

5588

; end changed

5589

5590

; WRITE TO VRAM

5591

; in hl = address

5592

; a = data

5593

gfxWRTVRM:

5594

ld ix, BIOS_SCRMOD

5595

bit 3, (ix)

5596

jp nz, BIOS_NWRVRM

5597

bit 2, (ix)

5598

jp nz, BIOS_NWRVRM

5599

jp BIOS_WRTVRM

5600

5601

; READ FROM VRAM

5602

; in hl = address

5603

; out a = data

5604

gfxRDVRM:

5605

ld ix, BIOS_SCRMOD

5606

bit 3, (ix)

5607

jp nz, BIOS_NRDVRM

5608

bit 2, (ix)

5609

jp nz, BIOS_NRDVRM

5610

jp BIOS_RDVRM

5611

5612

5613

5614

5615

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

5616

; MATH PACK WRAPPER

5617

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

5618

5619

CALL_MATH_LIB: exx

5620

ld hl, RET_MATH_LIB

5621

push hl

5622

ld hl, BASIC_DAC

5623

ld de, BASIC_ARG

5624

ld bc, BASIC_SWPTMP

5625

jp (ix)

5626

RET_MATH_LIB: call COPY_TO.TMP_DAC

5627

exx

5628

ret

5629

5630

MATH_DECADD: ld ix, addSingle

5631

jp CALL_MATH_LIB

5632

5633

MATH_DECSUB: ld ix, subSingle

5634

jp CALL_MATH_LIB

5635

5636

MATH_DECMUL: ld ix, mulSingle

5637

jp CALL_MATH_LIB

5638

5639

MATH_DECDIV: ld ix, divSingle

5640

jp CALL_MATH_LIB

5641

5642

if defined MATH.POW

5643

MATH_DBLEXP:

5644

MATH_SNGEXP: ld ix, powSingle

5645

jp CALL_MATH_LIB

5646

endif

5647

5648

if defined COS

5649

MATH_COS: ld ix, cosSingle

5650

jp CALL_MATH_LIB

5651

endif

5652

5653

if defined SIN

5654

MATH_SIN: ld ix, sinSingle

5655

jp CALL_MATH_LIB

5656

endif

5657

5658

if defined TAN

5659

MATH_TAN: ld ix, tanSingle

5660

jp CALL_MATH_LIB

5661

endif

5662

5663

if defined ATN

5664

MATH_ATN: ld ix, atanSingle

5665

jp CALL_MATH_LIB

5666

endif

5667

5668

if defined SQR

5669

MATH_SQR: ld ix, sqrtSingle

5670

jp CALL_MATH_LIB

5671

endif

5672

5673

if defined LOG

5674

MATH_LOG: ld ix, lnSingle

5675

jp CALL_MATH_LIB

5676

endif

5677

5678

if defined EXP

5679

MATH_EXP: ld ix, expSingle

5680

jp CALL_MATH_LIB

5681

endif

5682

5683

MATH_ABSFN: ld ix, absSingle

5684

jp CALL_MATH_LIB

5685

5686

MATH_NEG: ld ix, negSingle

5687

jp CALL_MATH_LIB

5688

5689

MATH_SGN: ld ix, sgnSingle

5690

jp CALL_MATH_LIB

5691

5692

MATH_RND: ld ix, randSingle

5693

jp CALL_MATH_LIB

5694

5695

MATH_FRCINT: ld hl, BASIC_DAC

5696

ld bc, BASIC_DAC+2

5697

call single2Int

5698

ld ix, BASIC_DAC

5699

ld (ix), 0

5700

ld (ix+1), 0

5701

;ld (ix+2), l

5702

;ld (ix+3), h

5703

ld (ix+4), 0

5704

ld (ix+5), 0

5705

ld (ix+6), 0

5706

ld (ix+7), 0

5707

ld a, 2

5708

ld (BASIC_VALTYP), a

5709

ret

5710

5711

MATH_FRCDBL: ; same as MATH_FRCSGL

5712

MATH_FRCSGL: ld hl, BASIC_DAC+2 ; input address

5713

ld bc, BASIC_DAC ; output address

5714

call int2Single

5715

ld a, 8

5716

ld (BASIC_VALTYP), a

5717

ret

5718

5719

MATH_ICOMP: ld a, h ; cp hl, de (or use bios DCOMPR)

5720

cp d

5721

jr nz, MATH_ICOMP.NE

5722

ld a, l

5723

cp e

5724

jr nz, MATH_ICOMP.NE

5725

jr MATH_DCOMP.EQ

5726

MATH_ICOMP.NE: jr c, MATH_DCOMP.GT

5727

jr MATH_DCOMP.LT

5728

5729

MATH_XDCOMP: ; same as MATH_DCOMP

5730

MATH_DCOMP: ld ix, cmpSingle

5731

call CALL_MATH_LIB

5732

jr z, MATH_DCOMP.EQ

5733

jr c, MATH_DCOMP.LT

5734

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

5735

ret

5736

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

5737

ret

5738

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

5739

ret

5740

5741

5742

MATH_FIN: ; HL has the source string

5743

ld a, (BASIC_VALTYP)

5744

cp 2 ; test if integer

5745

jr nz, MATH_FIN.1

5746

ld hl, (BASIC_DAC+2)

5747

ld de, BASIC_STRBUF

5748

call StrToInt

5749

ld hl, BASIC_STRBUF

5750

ret

5751

MATH_FIN.1: ld BC, BASIC_DAC

5752

call str2single

5753

ret

5754

5755

MATH_FOUT: ld a, (BASIC_VALTYP)

5756

cp 2 ; test if integer

5757

jr nz, MATH_FOUT.1

5758

ld hl, (BASIC_DAC+2)

5759

ld de, BASIC_STRBUF

5760

call IntToStr

5761

ld hl, BASIC_STRBUF

5762

ret

5763

MATH_FOUT.1: ld hl, BASIC_DAC

5764

ld bc, BASIC_STRBUF

5765

call single2str

5766

ld hl, BASIC_STRBUF

5767

ret

5768

5769

5770

5771

5772

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

5773

; Z80FLOAT LIBRARY

5774

5775

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

5776

; References:

5777

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

5778

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

5779

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

5780

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

5781

; Parameters:

5782

; HL points to the first operand

5783

; DE points to the second operand (if needed)

5784

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

5785

; BC points to where the result should be output

5786

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

5787

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

5788

; exponent biased by +128.

5789

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

5790

; Adapted to MSXBas2Asm by Amaury Carvalho, 2019

5791

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

5792

5793

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

5794

; Work area

5795

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

5796

5797

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

5798

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

5799

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

5800

scrap: equ BASIC_HOLD8

5801

seed0: equ BASIC_RNDX

5802

seed1: equ seed0 + 4

5803

var48: equ scrap + 4

5804

quot: equ scrap + 1

5805

addend: equ scrap

5806

addend2: equ scrap+7 ;4 bytes

5807

var_x: equ BASIC_HOLD8 + 4 ;4 bytes

5808

var_y: equ var_x + 4 ;4 bytes

5809

var_z: equ var_y + 4 ;4 bytes

5810

var_a: equ var_z + 4 ;4 bytes

5811

var_b: equ var_a + 4 ;4 bytes

5812

var_c: equ var_b + 4 ;4 bytes

5813

temp: equ var_c + 4 ;4 bytes

5814

temp1: equ temp + 4 ;4 bytes

5815

temp2: equ temp1 + 4 ;4 bytes

5816

temp3: equ temp2 + 4 ;4 bytes

5817

5818

pow10exp_single: equ scrap+9

5819

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

5820

5821

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

5822

; addSingle

5823

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

5824

5825

;;Still need to tend to special cases

5826

addSingle:

5827

;;x+y

5828

push af

5829

push hl

5830

push de

5831

push bc

5832

addInject:

5833

inc de

5834

inc de

5835

inc hl

5836

inc hl

5837

ld a,(de)

5838

xor (hl)

5839

push af

5840

inc de

5841

inc hl

5842

ex de,hl

5843

ld a,(de)

5844

sub (hl)

5845

ex de,hl

5846

jr nc,$+5

5847

ex de,hl

5848

neg

5849

cp 24

5850

jp nc,add_unneeded

5851

push hl

5852

ld hl,addend+6

5853

dec de

5854

ld bc,0408h

5855

dec hl

5856

ld (hl),0

5857

sub c

5858

jr nc,$-5

5859

add a,c

5860

push af

5861

push hl

5862

ex de,hl

5863

ld a,(hl)

5864

or 80h

5865

ld (de),a

5866

dec de

5867

dec hl

5868

ldd

5869

ldd

5870

ex de,hl

5871

dec b

5872

jr z,$+7

5873

ld (hl),0

5874

dec hl

5875

djnz $-3

5876

pop hl

5877

pop af

5878

ld b,a

5879

jr z,noshift

5880

set 7,(hl)

5881

_1:

5882

push hl

5883

srl (hl)

5884

dec hl

5885

rr (hl)

5886

dec hl

5887

rr (hl)

5888

dec hl

5889

rr (hl)

5890

pop hl

5891

djnz _1

5892

noshift:

5893

pop hl ;bigger float

5894

dec hl

5895

ld b,(hl)

5896

dec hl

5897

dec hl

5898

ex de,hl

5899

pop af

5900

jp m,subtract

5901

ld hl,addend+2

5902

ld a,(hl)

5903

rla

5904

inc hl

5905

ld a,(de)

5906

adc a,(hl)

5907

ld (hl),a

5908

inc hl

5909

inc de

5910

ld a,(de)

5911

adc a,(hl)

5912

ld (hl),a

5913

inc hl

5914

inc de

5915

ld a,(de)

5916

set 7,a

5917

adc a,(hl)

5918

ld (hl),a

5919

inc hl

5920

inc de

5921

ld a,(de)

5922

ld (hl),a

5923

jp nc,add_done

5924

inc (hl)

5925

jp z,add_overflow

5926

dec hl

5927

rr (hl)

5928

dec hl

5929

rr (hl)

5930

dec hl

5931

rr (hl)

5932

jp add_done

5933

subtract:

5934

ld hl,addend

5935

xor a

5936

ld c,a

5937

sub (hl)

5938

ld (hl),a

5939

inc hl

5940

ld a,c

5941

sbc a,(hl)

5942

ld (hl),a

5943

inc hl

5944

ld a,c

5945

sbc a,(hl)

5946

ld (hl),a

5947

inc hl

5948

ld a,(de)

5949

sbc a,(hl)

5950

ld (hl),a

5951

inc hl

5952

inc de

5953

ld a,(de)

5954

sbc a,(hl)

5955

ld (hl),a

5956

inc hl

5957

inc de

5958

ld a,(de)

5959

set 7,a

5960

sbc a,(hl)

5961

ld (hl),a

5962

inc hl

5963

inc de

5964

ld a,(de)

5965

ld (hl),a

5966

dec de

5967

ex de,hl

5968

jr nc,negated

5969

ld hl,addend

5970

ld a,80h

5971

xor b

5972

ld b,a

5973

ld a,c

5974

sub (hl)

5975

ld (hl),a

5976

inc hl

5977

ld a,c

5978

sbc a,(hl)

5979

ld (hl),a

5980

inc hl

5981

ld a,c

5982

sbc a,(hl)

5983

ld (hl),a

5984

inc hl

5985

ld a,c

5986

sbc a,(hl)

5987

ld (hl),a

5988

inc hl

5989

ld a,c

5990

sbc a,(hl)

5991

ld (hl),a

5992

inc hl

5993

ld a,c

5994

sbc a,(hl)

5995

ld (hl),a

5996

negated:

5997

jp m,add_done

5998

push bc

5999

ld hl,(addend)

6000

ld de,(addend+2)

6001

ld bc,(addend+4)

6002

ld a,h

6003

or l

6004

or d

6005

or e

6006

or b

6007

or c

6008

jp z,add_underflow

6009

ld a,(addend+6)

6010

normalize:

6011

dec a

6012

jr z,add_underflow

6013

add hl,hl

6014

rl e

6015

rl d

6016

rl c

6017

rl b

6018

jp p,normalize

6019

ld (addend),hl

6020

ld (addend+2),de

6021

ld (addend+4),bc

6022

ld (addend+6),a

6023

pop bc

6024

add_done:

6025

;;Need to adjust sign flag

6026

ld hl,addend+5

6027

ld a,(hl)

6028

rla

6029

rl b

6030

rra

6031

ld (hl),a

6032

dec hl

6033

dec hl

6034

add_copy:

6035

pop de

6036

push de

6037

ldi

6038

ldi

6039

ldi

6040

ld a,(hl)

6041

ld (de),a

6042

pop bc

6043

pop de

6044

pop hl

6045

pop af

6046

ret

6047

add_underflow:

6048

;;How many push/pops are needed?

6049

;;return ZERO

6050

ld hl,0

6051

ld (addend+3),hl

6052

ld (addend+5),hl

6053

pop bc

6054

jr add_done

6055

add_overflow:

6056

;;How many push/pops are needed?

6057

;;return INF

6058

dec hl

6059

ld (hl),40h

6060

jr add_done

6061

add_unneeded:

6062

;;How many push/pops are needed?

6063

;;Return bigger number

6064

pop af

6065

dec hl

6066

dec hl

6067

dec hl

6068

jr add_copy

6069

6070

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

6071

; subSingle

6072

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

6073

6074

subSingle:

6075

;;x-y

6076

push af

6077

push hl

6078

push de

6079

push bc

6080

push hl

6081

ex de,hl

6082

ld de,addend2

6083

ldi

6084

ldi

6085

ld a,(hl)

6086

xor 80h

6087

ld (de),a

6088

inc de

6089

inc hl

6090

ld a,(hl)

6091

ld (de),a

6092

ex de,hl

6093

pop hl

6094

ld de,addend2

6095

jp addInject ;jumps in to the addSingle routine

6096

6097

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

6098

; mulSingle

6099

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

6100

6101

mulSingle:

6102

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

6103

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

6104

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

6105

;min: 1398cc

6106

;max: 2564cc

6107

;avg: 2055.13839751681cc

6108

push af

6109

push hl

6110

push de

6111

push bc

6112

6113

call _2 ;CHLB

6114

ld a,c

6115

ex de,hl

6116

pop hl

6117

push hl

6118

ld (hl),b

6119

inc hl

6120

ld (hl),e

6121

inc hl

6122

ld (hl),d

6123

inc hl

6124

ld (hl),a

6125

pop bc

6126

pop de

6127

pop hl

6128

pop af

6129

ret

6130

6131

6132

_2:

6133

;;return float in CHLB

6134

push de

6135

ld e,(hl)

6136

inc hl

6137

ld d,(hl)

6138

inc hl

6139

ld c,(hl)

6140

inc hl

6141

ld a,(hl)

6142

or a

6143

jr z,mulSingle_case0

6144

ex de,hl

6145

ex (sp),hl

6146

ld e,(hl)

6147

inc hl

6148

ld d,(hl)

6149

inc hl

6150

ld b,(hl)

6151

inc hl

6152

6153

;inc (hl)

6154

;dec (hl)

6155

;jr z,mulSingle_case1

6156

push af

6157

ld a, (hl)

6158

or a

6159

jp z,mulSingle_case1

6160

pop af

6161

6162

add a,(hl) ;\

6163

pop hl ; |

6164

rra ; |Lots of help from Runer112 and

6165

adc a,a ; |calc84maniac for optimizing

6166

jp po,bad ; |this exponent check.

6167

xor 80h ; |

6168

jr z,underflow ;/

6169

push af ;exponent

6170

ld a,b

6171

xor c

6172

push af ;sign

6173

set 7,b

6174

set 7,c

6175

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

6176

pop de

6177

ld a,e

6178

pop de

6179

jp m,_3

6180

rl c

6181

rl b

6182

adc hl,hl

6183

dec d

6184

_3:

6185

inc d

6186

jr z,overflow

6187

rl c

6188

ld c,d

6189

ld de,0

6190

push af

6191

ld a,b

6192

adc a,e

6193

ld b,a

6194

adc hl,de

6195

jr nc,_4

6196

inc c

6197

jr z,overflow

6198

rr h

6199

rr l

6200

rr b

6201

_4:

6202

pop af

6203

cpl

6204

and $80

6205

xor h

6206

ld h,a

6207

ret

6208

bad:

6209

jr nc,overflow

6210

underflow:

6211

ld hl,0

6212

rl b

6213

rr h

6214

ld c,l

6215

ld b,l

6216

ret

6217

overflow:

6218

ld hl,$8000

6219

jr underflow+3

6220

mulSingle_case1:

6221

;x*0 -> 0

6222

;x*inf -> inf

6223

;x*NaN -> NaN

6224

pop af

6225

pop hl

6226

ld h,b

6227

ld l,d

6228

ld b,e

6229

ld c,0

6230

ret

6231

mulSingle_case0:

6232

;special*x = special

6233

;NaN*x = NaN

6234

;0*0 = 0

6235

;0*NaN = NaN

6236

;0*Inf = NaN

6237

;Inf*Inf = Inf

6238

;Inf*-Inf =-Inf

6239

;0CDE

6240

pop hl

6241

inc hl

6242

inc hl

6243

inc hl

6244

ld a,(hl)

6245

or a

6246

jr z,_5

6247

ld h,c

6248

ld c,0

6249

ret

6250

_5:

6251

dec hl

6252

ld b,(hl)

6253

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

6254

ld a,b

6255

or c

6256

ld h,$20

6257

and h

6258

jr z,_6

6259

ld c,0

6260

ret

6261

_6:

6262

ld a,c

6263

xor b

6264

rl b

6265

rlca

6266

rr b

6267

res 4,b

6268

6269

rl c

6270

rrca

6271

rr c

6272

6273

ld a,c

6274

and $E0

6275

add a,b

6276

rra

6277

ld h,a

6278

ld c,0

6279

ret

6280

mul24:

6281

;;BDE*CHL -> HLBCDE

6282

;;155 bytes

6283

;;402+3*C_Times_BDE

6284

;;fastest:1201cc

6285

;;slowest:1753cc

6286

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

6287

;min: 825cc

6288

;max: 1926cc

6289

;avg: 1449.63839751681cc

6290

6291

push bc

6292

ld c,l

6293

push hl

6294

call C_Times_BDE

6295

ld (var48),hl

6296

ld l,a

6297

ld h,c

6298

ld (var48+2),hl

6299

6300

pop hl

6301

ld c,h

6302

call C_Times_BDE

6303

push bc

6304

ld bc,(var48+1)

6305

add hl,bc

6306

ld (var48+1),hl

6307

pop bc

6308

ld b,c

6309

ld c,a

6310

ld hl,(var48+3)

6311

ld h,0

6312

adc hl,bc

6313

ld (var48+3),hl

6314

6315

pop bc

6316

call C_Times_BDE

6317

ld de,(var48+2)

6318

add hl,de

6319

ld (var48+2),hl

6320

ld d,c

6321

ld e,a

6322

ld b,h

6323

ld c,l

6324

ld hl,(var48+4)

6325

ld h,0

6326

adc hl,de

6327

ld de,(var48)

6328

ret

6329

6330

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

6331

; divSingle

6332

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

6333

6334

divSingle:

6335

;;HL points to numerator

6336

;;DE points to denominator

6337

;;BC points to where the quotient gets written

6338

call pushpop

6339

divSingle_no_pushpop:

6340

inc hl

6341

inc de

6342

inc hl

6343

inc de

6344

ld a,(de) ;\

6345

xor (hl) ; |Get sign of output

6346

add a,a ; |

6347

push af ;/

6348

push bc

6349

inc hl

6350

inc de

6351

ld a,(hl) ;\

6352

ex de,hl ; |Get exponent

6353

sub (hl) ; |

6354

ex de,hl ; |

6355

6356

ld b,-1

6357

jr nc,_7

6358

dec b

6359

_7:

6360

add a,128

6361

jr nc,_8

6362

inc b

6363

_8:

6364

inc b

6365

jr z,_9

6366

jp p,divunderflow

6367

jp m,divoverflow

6368

_9:

6369

ld (quot+3),a

6370

dec hl

6371

dec de

6372

ld b,(hl)

6373

dec hl

6374

ld a,(hl)

6375

dec hl

6376

ld l,(hl)

6377

ld h,a

6378

ex de,hl

6379

6380

ld c,(hl)

6381

dec hl

6382

ld a,(hl)

6383

dec hl

6384

ld l,(hl)

6385

ld h,a

6386

ex de,hl

6387

6388

set 7,c

6389

ld a,b

6390

or 80h

6391

sbc hl,de

6392

sbc a,c

6393

jr nz,_10

6394

or h

6395

or l

6396

jr z,setmantissa0

6397

xor a

6398

_10:

6399

jr nc,startdiv

6400

ld b,a

6401

ld a,(quot+3)

6402

dec a

6403

ld (quot+3),a

6404

ld a,b

6405

add hl,hl

6406

adc a,a

6407

add hl,de

6408

adc a,c

6409

startdiv:

6410

ld b,1

6411

call divsub0+3

6412

ld (quot+1),bc

6413

call divsub0

6414

ld (quot),bc

6415

call divsub0

6416

ld (quot-1),bc

6417

add hl,hl

6418

rla

6419

jr c,_11

6420

sbc hl,de

6421

sbc a,c

6422

ccf

6423

_11:

6424

ld hl,(quot)

6425

ld de,(quot+2)

6426

ld bc,0

6427

adc hl,bc

6428

ex de,hl

6429

adc hl,bc

6430

ld b,h

6431

ld c,l

6432

writeback:

6433

pop hl

6434

ld (hl),e

6435

inc hl

6436

ld (hl),d

6437

inc hl

6438

rl c

6439

pop af

6440

rr c

6441

ld (hl),c

6442

inc hl

6443

ld (hl),b

6444

ret

6445

divoverflow:

6446

ld b,$40

6447

jr _12

6448

divunderflow:

6449

ld b,0

6450

jr _12

6451

setmantissa0:

6452

ld bc,(quot+2)

6453

_12:

6454

ld de,0

6455

ld c,e

6456

jr writeback

6457

divsub0:

6458

;;882cc max

6459

call divsub1 ;34 or 66

6460

call divsub1 ;

6461

call divsub1

6462

call divsub1

6463

call divsub1

6464

call divsub1

6465

call divsub1

6466

call divsub1

6467

or a

6468

sbc hl,de

6469

sbc a,c

6470

inc b

6471

ret nc

6472

dec b

6473

add hl,de

6474

adc a,c

6475

ret

6476

divsub1:

6477

;34cc or 66cc or 93cc

6478

sla b

6479

add hl,hl

6480

rla

6481

ret nc

6482

or a

6483

inc b

6484

sbc hl,de

6485

sbc a,c

6486

ret c

6487

inc b

6488

sbc hl,de

6489

sbc a,c

6490

ret

6491

6492

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

6493

; powSingle

6494

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

6495

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

6496

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

6497

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

6498

;{

6499

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

6500

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

6501

; else if ( precision >= 1 ) {

6502

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

6503

; else return sqrt( -base );

6504

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

6505

;}

6506

6507

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

6508

6509

powSingle:

6510

;;Computes y^x

6511

;;HL points to y

6512

;;DE points to x

6513

;;BC points to output

6514

call pushpop

6515

push bc

6516

push de

6517

ld bc, var_y ; power

6518

call copySingle

6519

pop hl

6520

ld bc, var_x ; base

6521

call copySingle

6522

ld hl, const_precision

6523

ld bc, var_a ; precision

6524

call copySingle

6525

ld hl, const_0

6526

ld bc, var_z ; result

6527

call copySingle

6528

call powSingle.loop

6529

pop bc

6530

ld hl, var_z

6531

call copySingle

6532

ret

6533

6534

powSingle.loop:

6535

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

6536

ld hl, var_y

6537

ld de, const_0

6538

call cmpSingle

6539

jp c, powSingle.1

6540

6541

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

6542

ld hl, var_y

6543

ld de, const_1

6544

call cmpSingle

6545

jp nc, powSingle.2

6546

6547

; else if ( precision >= 1 ) {

6548

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

6549

; else return sqrt( -base );

6550

ld hl, var_a

6551

ld de, const_1

6552

call cmpSingle

6553

jp nc, powSingle.3

6554

6555

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

6556

ld hl, var_y

6557

ld de, const_2

6558

ld bc, var_b

6559

call mulSingle

6560

ld hl, var_b

6561

ld bc, var_y

6562

call copySingle

6563

ld hl, var_a

6564

ld de, const_2

6565

ld bc, var_b

6566

call mulSingle

6567

ld hl, var_b

6568

ld bc, var_a

6569

call copySingle

6570

call powSingle.loop

6571

ld hl, var_z

6572

ld bc, var_b

6573

call sqrtSingle

6574

ld hl, var_b

6575

ld bc, var_z

6576

call copySingle

6577

ret

6578

6579

powSingle.1:

6580

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

6581

ld hl, const_0

6582

ld de, var_y

6583

ld bc, var_b

6584

call subSingle

6585

ld hl, var_b

6586

ld bc, var_y

6587

call copySingle

6588

call powSingle.loop

6589

ld hl, const_1

6590

ld de, var_z

6591

ld bc, var_b

6592

call divSingle

6593

ld hl, var_b

6594

ld bc, var_z

6595

call copySingle

6596

ret

6597

6598

powSingle.2:

6599

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

6600

ld hl, var_y

6601

ld de, const_1

6602

ld bc, var_b

6603

call subSingle

6604

ld hl, var_b

6605

ld bc, var_y

6606

call copySingle

6607

call powSingle.loop

6608

ld hl, var_z

6609

ld de, var_x

6610

ld bc, var_b

6611

call mulSingle

6612

ld hl, var_b

6613

ld bc, var_z

6614

call copySingle

6615

ret

6616

6617

powSingle.3:

6618

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

6619

; else return sqrt( -base );

6620

ld hl, var_x

6621

ld de, const_0

6622

call cmpSingle

6623

jp nc, powSingle.1

6624

;ld hl, var_x

6625

ld bc, var_b

6626

call negSingle

6627

ld hl, var_b

6628

;ld bc, var_z

6629

;call sqrtSingle

6630

;ret

6631

6632

powSingle.3.1:

6633

;ld hl, var_x

6634

ld bc, var_z

6635

call sqrtSingle

6636

ret

6637

6638

pow2Single:

6639

;;Computes 2^x

6640

call pushpop

6641

push bc

6642

6643

exp_inject:

6644

;if x is on [0,1):

6645

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

6646

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

6647

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

6648

;

6649

;int(x) -> out_exp

6650

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

6651

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

6652

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

6653

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

6654

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

6655

ld de,var48+10

6656

call mov4

6657

ld hl,(var48+10)

6658

ld de,(var48+12)

6659

ld a,e

6660

add a,a

6661

push af ;keep track of sign

6662

rrca

6663

ld (var48+12),a

6664

ld c,a

6665

ld a,d

6666

or a

6667

jp z,exp_spec

6668

cp 80h-23

6669

jp c,exp_underflow

6670

sub 128 ; sub a,128

6671

jr c,_pow_1 ;int(x)=0

6672

inc a

6673

cp 7

6674

jp nc,exp_overflow

6675

set 7,c

6676

ld b,a

6677

xor a

6678

add hl,hl

6679

rl c

6680

rla

6681

djnz $-4

6682

ld b,7Fh

6683

bit 7,c

6684

jr nz,exp_normalized

6685

ld e,a

6686

ld a,h

6687

or l

6688

or c

6689

ld a,e

6690

jr z,exp_zeroed

6691

dec b

6692

add hl,hl

6693

rl c

6694

jp p,$-4

6695

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

6696

exp_zeroed:

6697

ld b,0

6698

exp_normalized:

6699

ld (var48+10),hl

6700

res 7,c

6701

ld (var48+12),bc

6702

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

6703

_pow_1:

6704

xor a

6705

comp_exp:

6706

pop hl

6707

rr l

6708

jr nc,_pow_2

6709

cpl

6710

or a

6711

jp z,exp_underflow+1

6712

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

6713

ld hl,const_1

6714

ld de,var48+10

6715

ld b,d

6716

ld c,e

6717

call subSingle

6718

_pow_2:

6719

push af

6720

;our 'x' is at var48+10

6721

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

6722

;uses 14 bytes of RAM

6723

ld hl,var48+10

6724

ld de,exp_a6

6725

ld bc,var48+6

6726

call mulSingle

6727

ld d,b

6728

ld e,c

6729

ld hl,exp_a5

6730

call addSingle

6731

ld hl,var48+10

6732

call mulSingle

6733

ld hl,exp_a4

6734

call addSingle

6735

ld hl,var48+10

6736

call mulSingle

6737

ld hl,exp_a3

6738

call addSingle

6739

ld hl,var48+10

6740

call mulSingle

6741

ld hl,exp_a2

6742

call addSingle

6743

ld hl,var48+10

6744

call mulSingle

6745

ld hl,exp_a1

6746

call addSingle

6747

ld hl,var48+10

6748

call mulSingle

6749

ld hl,const_1

6750

call addSingle

6751

ld hl,var48+9

6752

pop af

6753

add a,(hl)

6754

ld (hl),a

6755

ex de,hl

6756

pop de

6757

jp mov4

6758

exp_spec:

6759

;bit 6 means INF

6760

;bit 5 means NAN

6761

;no bits means zero

6762

;NAN -> NAN

6763

;+inf -> +inf

6764

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

6765

ld a,c

6766

add a,a

6767

jr z,exp_zero

6768

jp m,exp_inf

6769

;exp_NAN

6770

pop af

6771

ld de,0040h

6772

exp_return_spec:

6773

pop hl

6774

rr e

6775

ld (hl),a

6776

inc hl

6777

ld (hl),a

6778

inc hl

6779

ld (hl),e

6780

inc hl

6781

ld (hl),d

6782

ret

6783

exp_overflow:

6784

exp_inf:

6785

;+inf -> +inf

6786

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

6787

pop af

6788

sbc a,a ;FF if should be 0,

6789

cpl

6790

and 80h

6791

ld d,0

6792

ld e,a

6793

jr exp_return_spec

6794

exp_underflow:

6795

exp_zero:

6796

pop af

6797

or a

6798

ld de,$8000

6799

jr exp_return_spec

6800

6801

endif

6802

6803

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

6804

; sqrtSingle

6805

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

6806

6807

if defined MATH_SQR or defined MATH_EXP

6808

6809

;Uses 3 bytes at scrap

6810

sqrtSingle:

6811

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

6812

;min: 1784

6813

;max: 1987

6814

;avg: 1872

6815

call pushpop

6816

push bc

6817

ld c,(hl)

6818

inc hl

6819

ld e,(hl)

6820

inc hl

6821

ld a,(hl)

6822

add a,a

6823

jp c,sqrtSingle_NaN

6824

scf

6825

rra

6826

ld d,a

6827

inc hl

6828

ld a,(hl)

6829

or a

6830

jp z,sqrtSingle_special

6831

add a,80h

6832

rra

6833

push af ;new exponent

6834

jr c,_13

6835

srl d

6836

rr e

6837

rr c

6838

_13:

6839

ex de,hl

6840

ld ixh,c

6841

ld ixl,0

6842

call sqrtHLIX

6843

;AHL is the new remainder

6844

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

6845

rra

6846

ld a,h

6847

;HL/DE to 8 bits

6848

;We are just going to approximate it

6849

res 0,l

6850

jr c,$+5

6851

cp d

6852

jr c,$+4

6853

sub d

6854

inc l

6855

sla l

6856

rla

6857

jr c,$+5

6858

cp d

6859

jr c,$+4

6860

sub d

6861

inc l

6862

sla l

6863

rla

6864

jr c,$+5

6865

cp d

6866

jr c,$+4

6867

sub d

6868

inc l

6869

sla l

6870

rla

6871

jr c,$+5

6872

cp d

6873

jr c,$+4

6874

sub d

6875

inc l

6876

sla l

6877

rla

6878

jr c,$+5

6879

cp d

6880

jr c,$+4

6881

sub d

6882

inc l

6883

sla l

6884

rla

6885

jr c,$+5

6886

cp d

6887

jr c,$+4

6888

sub d

6889

inc l

6890

sla l

6891

rla

6892

jr c,$+5

6893

cp d

6894

jr c,$+4

6895

sub d

6896

inc l

6897

sla l

6898

rla

6899

jr c,$+5

6900

cp d

6901

jr c,$+4

6902

sub d

6903

inc l

6904

6905

pop bc

6906

ld a,l

6907

pop hl

6908

;BDEA

6909

ld (hl),a

6910

inc hl

6911

ld (hl),e

6912

inc hl

6913

res 7,d

6914

ld (hl),d

6915

inc hl

6916

ld (hl),b

6917

ret

6918

sqrtSingle_NaN:

6919

ld hl,const_NaN

6920

pop de

6921

jp mov4

6922

sqrtSingle_special:

6923

dec hl

6924

dec hl

6925

pop de

6926

jp mov4

6927

6928

sqrtHLIX:

6929

;Input: HLIX

6930

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

6931

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

6932

;min: 1130

6933

;max: 1266

6934

;avg: 1190.5

6935

6936

6937

call sqrtHL

6938

add a,a

6939

ld e,a

6940

jr nc,_14

6941

inc d

6942

_14:

6943

6944

ld a,ixh

6945

sll e

6946

rl d

6947

add a,a

6948

adc hl,hl

6949

add a,a

6950

adc hl,hl

6951

sbc hl,de

6952

jr nc,_15

6953

add hl,de

6954

dec e

6955

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

6956

_15:

6957

inc e

6958

_15a:

6959

sll e

6960

rl d

6961

add a,a

6962

adc hl,hl

6963

add a,a

6964

adc hl,hl

6965

sbc hl,de

6966

jr nc,_16

6967

add hl,de

6968

dec e

6969

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

6970

_16:

6971

inc e

6972

_16a:

6973

sll e

6974

rl d

6975

add a,a

6976

adc hl,hl

6977

add a,a

6978

adc hl,hl

6979

sbc hl,de

6980

jr nc,_17

6981

add hl,de

6982

dec e

6983

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

6984

_17:

6985

inc e

6986

_17a:

6987

sll e

6988

rl d

6989

add a,a

6990

adc hl,hl

6991

add a,a

6992

adc hl,hl

6993

sbc hl,de

6994

jr nc,_18

6995

add hl,de

6996

dec e

6997

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

6998

_18:

6999

inc e

7000

_18a:

7001

;Now we have four more iterations

7002

;The first two are no problem

7003

ld a,ixl

7004

sll e

7005

rl d

7006

add a,a

7007

adc hl,hl

7008

add a,a

7009

adc hl,hl

7010

sbc hl,de

7011

jr nc,_19

7012

add hl,de

7013

dec e

7014

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

7015

_19:

7016

inc e

7017

_19a:

7018

sll e

7019

rl d

7020

add a,a

7021

adc hl,hl

7022

add a,a

7023

adc hl,hl

7024

sbc hl,de

7025

jr nc,_20

7026

add hl,de

7027

dec e

7028

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

7029

_20:

7030

inc e

7031

_20a:

7032

sqrt32_iter15:

7033

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

7034

sll e

7035

rl d ;sla e \ rl d \ inc e

7036

add a,a

7037

adc hl,hl

7038

add a,a

7039

adc hl,hl ;This might overflow!

7040

jr c,sqrt32_iter15_br0

7041

;

7042

sbc hl,de

7043

jr nc,_21

7044

add hl,de

7045

dec e

7046

jr sqrt32_iter16

7047

sqrt32_iter15_br0:

7048

or a

7049

sbc hl,de

7050

_21:

7051

inc e

7052

7053

;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

7054

sqrt32_iter16:

7055

add a,a

7056

ld b,a ;either 0x00 or 0x80

7057

adc hl,hl

7058

rla

7059

adc hl,hl

7060

rla

7061

;AHL - (DE+DE+1)

7062

sbc hl,de

7063

sbc a,b

7064

inc e

7065

or a

7066

sbc hl,de

7067

sbc a,b

7068

ret p

7069

add hl,de

7070

adc a,b

7071

dec e

7072

add hl,de

7073

adc a,b

7074

ret

7075

7076

sqrtHL:

7077

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

7078

;min: 376cc

7079

;max: 416cc

7080

;avg: 393cc

7081

ld de,$5040

7082

ld a,h

7083

sub e

7084

jr nc,_22

7085

add a,e

7086

ld d,$10

7087

_22:

7088

sub d

7089

jr nc,_23

7090

add a,d

7091

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

7092

_23:

7093

set 5,d

7094

_23a:

7095

res 4,d

7096

srl d

7097

7098

set 2,d

7099

sub d

7100

jr nc,_24

7101

add a,d

7102

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

7103

_24:

7104

set 3,d

7105

_24a:

7106

res 2,d

7107

srl d

7108

7109

inc d

7110

sub d

7111

jr nc,_25

7112

add a,d

7113

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

7114

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

7115

_25:

7116

inc d

7117

_25a:

7118

srl d

7119

ld h,a

7120

7121

7122

sbc hl,de

7123

ld a,e

7124

jr nc,_26

7125

add hl,de

7126

_26:

7127

ccf

7128

rra

7129

srl d

7130

rra

7131

ld e,a

7132

7133

sbc hl,de

7134

jr nc,_27

7135

add hl,de

7136

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

7137

_27:

7138

or %00100000

7139

_27a:

7140

xor %00011000

7141

srl d

7142

rra

7143

ld e,a

7144

7145

7146

sbc hl,de

7147

jr nc,_28

7148

add hl,de

7149

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

7150

_28:

7151

or %00001000

7152

_28a:

7153

xor %00000110

7154

srl d

7155

rra

7156

ld e,a

7157

sbc hl,de

7158

jr nc,_29

7159

add hl,de

7160

srl d

7161

rra

7162

ret

7163

_29:

7164

inc a

7165

srl d

7166

rra

7167

ret

7168

7169

endif

7170

7171

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

7172

; lnSingle

7173

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

7174

7175

if defined MATH_LOG or defined MATH_LN

7176

7177

lnSingle:

7178

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

7179

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

7180

call pushpop

7181

push bc

7182

ld de, const_100_inv

7183

ld bc, temp

7184

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

7185

ld hl, temp

7186

ld de, const_100

7187

ld bc, temp1

7188

call mulSingle ; temp1 = temp * 100

7189

ld hl, temp1

7190

pop bc

7191

call subSingle ; bc = temp1 - 100

7192

ret

7193

7194

endif

7195

7196

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

7197

; logSingle

7198

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

7199

7200

if defined MATH_LOG

7201

7202

logSingle:

7203

call pushpop

7204

push bc

7205

ld bc, temp

7206

call lnSingle

7207

ld hl, temp

7208

ld de, const_lg10

7209

pop bc

7210

call divSingle

7211

ret

7212

7213

endif

7214

7215

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

7216

; expSingle

7217

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

7218

7219

if defined MATH_EXP

7220

7221

expSingle:

7222

;;Computes e^x

7223

;;HL points to x

7224

;;BC points to the output

7225

call pushpop

7226

ld de,const_lg_e

7227

push bc

7228

pow_inject:

7229

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

7230

ld bc,var_x

7231

call mulSingle

7232

ld h,b

7233

ld l,c

7234

jp exp_inject

7235

7236

endif

7237

7238

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

7239

; sinSingle

7240

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

7241

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

7242

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

7243

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

7244

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

7245

7246

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

7247

7248

sinSingle:

7249

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

7250

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

7251

; reduction:

7252

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

7253

; var_c = x - var_b*2*PI

7254

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

7255

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

7256

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

7257

7258

call pushpop

7259

ld de, const_0

7260

call cmpSingle

7261

jr nz, sinSingle.1

7262

7263

call copySingle ; return 0

7264

ret

7265

7266

sinSingle.1:

7267

call trigRangeReductionSinCos

7268

push bc

7269

ld hl, var_a

7270

ld de, var_a

7271

ld bc, var_b

7272

call mulSingle ; var_b = var_a * var_a

7273

ld hl, var_b

7274

ld de, sin_a3

7275

ld bc, temp

7276

call mulSingle ; temp = x^2/5040

7277

ld hl, sin_a2

7278

ld de, temp

7279

ld bc, temp1

7280

call subSingle ; temp1 = 1/120 - temp

7281

ld hl, var_b

7282

ld de, temp1

7283

ld bc, temp

7284

call mulSingle ; temp = x^2 * temp1

7285

ld hl, sin_a1

7286

ld de, temp

7287

ld bc, temp1

7288

call subSingle ; temp1 = 1/6 - temp

7289

ld hl, var_b

7290

ld de, temp1

7291

ld bc, temp

7292

call mulSingle ; temp = x^2 * temp1

7293

ld hl, const_1

7294

ld de, temp

7295

ld bc, temp1

7296

call subSingle ; temp1 = 1 - temp

7297

ld hl, var_a

7298

ld de, temp1

7299

pop bc

7300

call mulSingle ; return x * temp1

7301

ret

7302

7303

trigRangeReductionSinCos:

7304

call pushpop

7305

push hl

7306

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

7307

ld de, const_2pi

7308

ld bc, var_c

7309

call divSingle

7310

ld hl, var_c

7311

ld de, 0

7312

ld bc, var_b

7313

call roundSingle

7314

; var_c = x - var_b*2*PI

7315

ld hl, var_b

7316

ld de, const_2pi

7317

ld bc, temp

7318

call mulSingle ; temp = var_b*2*PI

7319

pop hl

7320

ld de, temp

7321

ld bc, var_c

7322

call subSingle ; var_c = x - temp

7323

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

7324

ld hl, var_c

7325

ld de, const_0

7326

call cmpSingle

7327

jr nc, trigRangeReductionSinCos.else.2

7328

ld hl, var_c

7329

ld bc, temp1

7330

call copySingle ; temp1 = var_c

7331

jr trigRangeReductionSinCos.endif.2

7332

trigRangeReductionSinCos.else.2:

7333

ld hl, var_c

7334

ld de, const_2pi

7335

ld bc, temp1

7336

call addSingle ; temp1 = var_c + 2*PI

7337

trigRangeReductionSinCos.endif.2:

7338

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

7339

ld hl, const_pi

7340

ld de, temp1

7341

call cmpSingle

7342

jr c, trigRangeReductionSinCos.else.3

7343

jr z, trigRangeReductionSinCos.else.3

7344

ld hl, temp1

7345

ld de, const_pi

7346

ld bc, temp2

7347

call subSingle ; temp2

7348

jr trigRangeReductionSinCos.endif.3

7349

trigRangeReductionSinCos.else.3:

7350

ld hl, temp1

7351

ld bc, temp2

7352

call copySingle ; temp2 = temp1

7353

trigRangeReductionSinCos.endif.3:

7354

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

7355

ld hl, const_half_pi

7356

ld de, temp2

7357

call cmpSingle

7358

jr c, trigRangeReductionSinCos.else.4

7359

jr z, trigRangeReductionSinCos.else.4

7360

ld hl, const_pi

7361

ld de, temp2

7362

ld bc, var_a

7363

call subSingle ; var_a

7364

jr trigRangeReductionSinCos.endif.4

7365

trigRangeReductionSinCos.else.4:

7366

ld hl, temp2

7367

ld bc, var_a

7368

call copySingle ; var_a = temp2

7369

trigRangeReductionSinCos.endif.4:

7370

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

7371

ld hl, temp1

7372

ld de, const_pi

7373

call cmpSingle

7374

jr nc, trigRangeReductionSinCos.endif.5

7375

ld ix, var_a

7376

ld a, (ix+2)

7377

set 7, a

7378

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

7379

trigRangeReductionSinCos.endif.5:

7380

; return var_a

7381

ret

7382

7383

endif

7384

7385

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

7386

; cosSingle

7387

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

7388

7389

if defined MATH_COS or defined MATH_TAN

7390

7391

cosSingle:

7392

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

7393

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

7394

; reduction: same as sin

7395

; cos = cos * sign

7396

7397

call pushpop

7398

ld de, const_0

7399

call cmpSingle

7400

jr nz, cosSingle.1

7401

7402

ld hl, const_1

7403

call copySingle ; return 1

7404

ret

7405

7406

cosSingle.1:

7407

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

7408

call trigRangeReductionSinCos

7409

push bc

7410

ld hl, var_a

7411

ld de, var_a

7412

ld bc, var_b

7413

call mulSingle ; var_b = var_a * var_a

7414

ld hl, var_b

7415

ld de, cos_a3

7416

ld bc, temp

7417

call mulSingle ; temp = x^2/720

7418

ld hl, cos_a2

7419

ld de, temp

7420

ld bc, temp1

7421

call subSingle ; temp1 = 1/24 - temp

7422

ld hl, var_b

7423

ld de, temp1

7424

ld bc, temp

7425

call mulSingle ; temp = x^2 * temp1

7426

ld hl, cos_a1

7427

ld de, temp

7428

ld bc, temp1

7429

call subSingle ; temp1 = 1/2 - temp

7430

ld hl, var_b

7431

ld de, temp1

7432

ld bc, temp

7433

call mulSingle ; temp = x^2 * temp1

7434

ld hl, const_1

7435

ld de, temp

7436

ld bc, temp1

7437

call subSingle ; temp1 = 1 - temp

7438

7439

; temp3 = abs(var_c)

7440

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

7441

ld hl, var_c

7442

ld bc, temp3

7443

call copySingle

7444

ld ix, temp3

7445

ld a, (ix+2)

7446

res 7, a

7447

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

7448

ld hl, temp3

7449

ld de, const_half_pi

7450

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

7451

jr nc, cosSingle.endif.1

7452

ld ix, temp1

7453

ld a, (ix+2)

7454

set 7, a

7455

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

7456

cosSingle.endif.1:

7457

pop bc

7458

ld hl, temp1

7459

call copySingle ; return temp1

7460

ret

7461

7462

endif

7463

7464

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

7465

; tanSingle

7466

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

7467

7468

if defined MATH_TAN

7469

7470

tanSingle:

7471

call pushpop

7472

push bc

7473

;HL points to input

7474

ld bc,var_z

7475

ld d,b

7476

ld e,c

7477

call cosSingle

7478

ld bc,var_x

7479

call sinSingle

7480

ld h,b

7481

ld l,c

7482

pop bc

7483

jp divSingle

7484

7485

endif

7486

7487

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

7488

; atanSingle

7489

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

7490

7491

if defined MATH_ATN

7492

7493

atanSingle:

7494

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

7495

; x < -1: atan - PI/2

7496

; x >= 1: PI/2 - atan

7497

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

7498

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

7499

; X < 0: Y = -Y

7500

7501

call pushpop

7502

ld de, const_0

7503

call cmpSingle

7504

jr nz, atanSingle.1

7505

7506

ld hl, const_0

7507

call copySingle ; return 0

7508

ret

7509

7510

atanSingle.1:

7511

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

7512

call trigRangeReductionAtan

7513

push bc

7514

push hl

7515

ld hl, var_a

7516

ld de, var_a

7517

ld bc, var_b

7518

call mulSingle ; var_b = var_a * var_a

7519

ld hl, var_b

7520

ld de, const_16

7521

ld bc, temp

7522

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

7523

ld hl, temp

7524

ld de, const_9

7525

ld bc, temp1

7526

call divSingle ; temp1 = temp/9

7527

ld hl, temp1

7528

ld de, const_7

7529

ld bc, temp

7530

call addSingle ; temp = 7 + temp1

7531

ld hl, var_b

7532

ld de, const_9

7533

ld bc, temp1

7534

call mulSingle ; temp1 = var_b * 9

7535

ld hl, temp1

7536

ld de, temp

7537

ld bc, temp2

7538

call divSingle ; temp2 = temp1 / temp

7539

ld hl, temp2

7540

ld de, const_5

7541

ld bc, temp

7542

call addSingle ; temp = 5 + temp2

7543

ld hl, var_b

7544

ld de, const_4

7545

ld bc, temp1

7546

call mulSingle ; temp1 = var_b * 4

7547

ld hl, temp1

7548

ld de, temp

7549

ld bc, temp2

7550

call divSingle ; temp2 = temp1 / temp

7551

ld hl, temp2

7552

ld de, const_3

7553

ld bc, temp

7554

call addSingle ; temp = 3 + temp2

7555

ld hl, var_b

7556

ld de, temp

7557

ld bc, temp2

7558

call divSingle ; temp2 = var_b / temp

7559

ld hl, temp2

7560

ld de, const_1

7561

ld bc, temp

7562

call addSingle ; temp = 1 + temp2

7563

ld hl, var_a

7564

ld de, temp

7565

ld bc, temp2

7566

call divSingle ; temp2 = var_a / temp

7567

pop hl

7568

; x >= 1: PI/2 - atan

7569

ld de, const_1

7570

call cmpSingle

7571

jr nc, atanSingle.2

7572

ld hl, const_half_pi

7573

ld de, temp2

7574

ld bc, temp

7575

call subSingle

7576

ld hl, temp

7577

jr atanSingle.4

7578

atanSingle.2:

7579

; x < -1: atan - PI/2

7580

push hl

7581

ld hl, const_0

7582

ld de, const_1

7583

ld bc, temp

7584

call subSingle

7585

pop hl

7586

ld de, temp

7587

call cmpSingle

7588

jr c, atanSingle.3

7589

ld hl, temp2

7590

ld de, const_half_pi

7591

ld bc, temp

7592

call subSingle

7593

ld hl, temp

7594

jr atanSingle.4

7595

atanSingle.3:

7596

ld hl, temp2

7597

atanSingle.4:

7598

pop bc

7599

call copySingle ; return temp2

7600

ret

7601

7602

trigRangeReductionAtan:

7603

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

7604

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

7605

; X < 0: Y = -Y

7606

call pushpop

7607

push hl

7608

ld bc, temp

7609

call copySingle

7610

ld ix, temp

7611

ld a, (ix+2)

7612

res 7, a

7613

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

7614

ld hl, temp

7615

ld de, const_1

7616

call cmpSingle

7617

jr nc, trigRangeReductionAtan.1

7618

ld hl, const_1

7619

pop de

7620

push de

7621

ld bc, var_a

7622

call divSingle

7623

jr trigRangeReductionAtan.2

7624

trigRangeReductionAtan.1:

7625

pop hl

7626

push hl

7627

ld bc, var_a

7628

call copySingle

7629

trigRangeReductionAtan.2:

7630

pop hl

7631

ld de, const_0

7632

call cmpSingle

7633

jr c, trigRangeReductionAtan.3

7634

ld ix, var_a

7635

ld a, (ix+2)

7636

set 7, a

7637

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

7638

trigRangeReductionAtan.3:

7639

ret

7640

7641

endif

7642

7643

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

7644

; copySingle

7645

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

7646

7647

copySingle:

7648

call pushpop

7649

push bc

7650

pop de

7651

ldi

7652

ldi

7653

ldi

7654

ldi

7655

ret

7656

7657

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

7658

; roundSingle

7659

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

7660

7661

roundSingle:

7662

call pushpop

7663

call copySingle

7664

push bc

7665

pop hl

7666

push de

7667

ld a, e

7668

ld de, const_10

7669

roundSingle.1:

7670

or 0

7671

jr z, roundSingle.2

7672

ld bc, temp

7673

call mulSingle

7674

push hl

7675

pop bc

7676

ld hl, temp

7677

call copySingle

7678

push bc

7679

pop hl

7680

dec a

7681

jr roundSingle.1

7682

roundSingle.2:

7683

ld de, const_half_1

7684

ld bc, temp

7685

call addSingle

7686

push hl

7687

ld hl, temp

7688

ld bc, temp1

7689

call single2Int

7690

ld hl, temp1

7691

pop bc

7692

call int2Single

7693

push bc

7694

pop hl

7695

pop de

7696

ld a, e

7697

ld de, const_10

7698

roundSingle.3:

7699

or 0

7700

jr z, roundSingle.4

7701

ld bc, temp

7702

call divSingle

7703

push hl

7704

pop bc

7705

ld hl, temp

7706

call copySingle

7707

push bc

7708

pop hl

7709

dec a

7710

jr roundSingle.3

7711

roundSingle.4:

7712

ret

7713

7714

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

7715

; absSingle

7716

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

7717

7718

absSingle:

7719

;;HL points to the float

7720

;;BC points to where to output the result

7721

call pushpop

7722

ld d,b

7723

ld e,c

7724

ldi

7725

ldi

7726

ld a,(hl)

7727

and %01111111

7728

ld (de),a

7729

inc hl

7730

inc de

7731

ld a,(hl)

7732

ld (de),a

7733

ret

7734

7735

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

7736

; negSingle

7737

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

7738

7739

negSingle:

7740

;;HL points to the float

7741

;;BC points to where to output the result

7742

call pushpop

7743

push hl

7744

pop ix

7745

ld a, (ix+3)

7746

or 0

7747

jr nz, negSingle.test.sign

7748

ld a, (ix+2)

7749

or 0

7750

jr nz, negSingle.test.sign

7751

ld a, (ix+1)

7752

or 0

7753

jr nz, negSingle.test.sign

7754

ld a, (ix)

7755

or 0

7756

jr nz, negSingle.test.sign

7757

push bc

7758

pop de

7759

ld hl, const_0

7760

ldi

7761

ldi

7762

ldi

7763

ldi

7764

ret

7765

negSingle.test.sign:

7766

ld a, (ix+2)

7767

bit 7, a

7768

jr z, negSingle.positive

7769

negSingle.negative:

7770

push bc

7771

pop ix

7772

call negSingle.positive

7773

ld a, (ix+2)

7774

set 7, a

7775

ld (ix+2), a

7776

ret

7777

negSingle.positive:

7778

push bc

7779

pop de

7780

ld hl, const_1

7781

ldi

7782

ldi

7783

ldi

7784

ldi

7785

ret

7786

7787

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

7788

; sgnSingle

7789

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

7790

7791

sgnSingle:

7792

;;HL points to the float

7793

;;BC points to where to output the result

7794

jp negSingle

7795

7796

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

7797

; cmpSingle

7798

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

7799

7800

cmpSingle:

7801

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

7802

;Output:

7803

; float1 >= float2 : nc

7804

; float1 < float2 : c,nz

7805

; float1 == float2 : z

7806

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

7807

;

7808

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

7809

push hl

7810

push de

7811

push bc

7812

ld c, a

7813

push bc

7814

ex de, hl

7815

call _30

7816

pop bc

7817

ld a, c

7818

pop bc

7819

pop de

7820

pop hl

7821

ret

7822

_30:

7823

inc de

7824

inc de

7825

inc de

7826

ld a,(de)

7827

inc hl

7828

inc hl

7829

inc hl

7830

cp (hl)

7831

jr nc,_31

7832

ld a,(hl)

7833

_31:

7834

dec hl

7835

dec hl

7836

dec hl

7837

dec de

7838

dec de

7839

dec de

7840

push af

7841

ld bc,scrap

7842

call subSingle

7843

ld a,(scrap+3) ;new power

7844

pop bc ;B is old power

7845

or a

7846

jr z,cmp_close

7847

sub b

7848

jr nc,cmp_is_sign

7849

dec a

7850

add a,22

7851

jr nc,cmp_close

7852

cmp_is_sign:

7853

ld a,(scrap+2)

7854

or 1 ;not equal, so reset z flag

7855

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

7856

ret

7857

cmp_close:

7858

xor a

7859

ret

7860

7861

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

7862

; randSingle

7863

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

7864

7865

randSingle:

7866

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

7867

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

7868

call pushpop

7869

push bc

7870

call rand

7871

push hl

7872

call rand

7873

pop de

7874

ex de,hl

7875

ld bc,$207F

7876

;DEHL is the mantissa, B is the exponent

7877

ld a,d

7878

or a

7879

jp m,rand_normed

7880

_32:

7881

dec c

7882

add hl,hl

7883

rl e

7884

rl d

7885

jp m,rand_normed

7886

djnz _32

7887

rand_zero:

7888

ld c,l

7889

ld b,l

7890

jr rand_done

7891

rand_normed:

7892

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

7893

ld a,b

7894

cp 8

7895

jr c,rand_zero

7896

sub 24

7897

jp nc,rand_no_more_rand_data

7898

push bc

7899

push de

7900

call rand

7901

pop de

7902

ld e,h

7903

ld h,l

7904

pop bc

7905

rand_no_more_rand_data:

7906

ld b,e

7907

ld e,d

7908

ld d,c

7909

ld c,h

7910

res 7,e

7911

rand_done:

7912

pop hl

7913

;DEBC

7914

ld (hl),b

7915

inc hl

7916

ld (hl),c

7917

inc hl

7918

ld (hl),e

7919

inc hl

7920

ld (hl),d

7921

ret

7922

7923

rand:

7924

;;Tested and passes all CAcert tests

7925

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

7926

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

7927

;;roughly 18.4 quintillion.

7928

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

7929

;;323cc

7930

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

7931

;Uses 64 bits of state

7932

ld hl,(seed0)

7933

ld de,(seed0+2)

7934

ld b,h

7935

ld c,l

7936

add hl,hl

7937

rl e

7938

rl d

7939

add hl,hl

7940

rl e

7941

rl d

7942

inc l

7943

add hl,bc

7944

ld (seed0),hl

7945

ld hl,(seed0+2)

7946

adc hl,de

7947

ld (seed0+2),hl

7948

ex de,hl

7949

;;lfsr

7950

ld hl,(seed1)

7951

ld bc,(seed1+2)

7952

add hl,hl

7953

rl c

7954

rl b

7955

ld (seed1+2),bc

7956

sbc a,a

7957

and %11000101

7958

xor l

7959

ld l,a

7960

ld (seed1),hl

7961

ex de,hl

7962

add hl,bc

7963

ret

7964

7965

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

7966

; single2Str

7967

; HL = Single address

7968

; BC = String address

7969

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

7970

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

7971

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

7972

7973

single2str:

7974

call pushpop

7975

push bc

7976

call _33

7977

pop de

7978

xor a

7979

cp (hl)

7980

ldi

7981

jr nz,$-3

7982

7983

ret

7984

_33:

7985

; Move the float to scrap

7986

ld de,scrap

7987

call mov4

7988

7989

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

7990

ld de,strout_single

7991

ld hl,scrap+2

7992

ld a,(hl)

7993

;rlca

7994

;scf

7995

;rra

7996

bit 7, a

7997

jr z, _34

7998

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

7999

ld (de),a

8000

inc de

8001

ld a,(hl)

8002

_34:

8003

set 7, a

8004

ld (hl),a

8005

8006

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

8007

inc hl

8008

ld a,(hl)

8009

or a

8010

jp z,strcase_single

8011

8012

8013

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

8014

ex de,hl

8015

ld (hl),'0'

8016

inc hl

8017

8018

; Save the pointer

8019

push hl

8020

8021

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

8022

ld de,77

8023

ld h,a

8024

ld l,d

8025

call mul8_preset

8026

ld de,-77*128

8027

add hl,de

8028

ld a,h

8029

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

8030

ld de,pown10LUT

8031

jr c,_35

8032

neg

8033

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

8034

_35:

8035

ld hl, pow10exp_single

8036

ld bc,scrap

8037

call singletostr_mul

8038

call singletostr_mul

8039

call singletostr_mul

8040

call singletostr_mul

8041

call singletostr_mul

8042

call singletostr_mul

8043

;now the number is pretty close to a nice value

8044

8045

; If it is less than 1, multiply by 10

8046

ld a,(scrap+3)

8047

sub 128

8048

jr nc,_36

8049

ld de,const_10

8050

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

8051

;ld b,h

8052

;ld c,l

8053

ld h,b

8054

ld l,c

8055

call mulSingle

8056

ld hl,pow10exp_single

8057

dec (hl)

8058

ld a,(scrap+3)

8059

sub 128

8060

_36:

8061

8062

; Convert to a fixed-point number !

8063

inc a

8064

ld b,a

8065

xor a

8066

_37:

8067

ld hl,scrap

8068

sla (hl)

8069

inc hl

8070

rl (hl)

8071

inc hl

8072

rl (hl)

8073

rla

8074

djnz _37

8075

8076

;We need to get 7 digits

8077

ld b,6

8078

pop hl ;Points to the string

8079

8080

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

8081

cp 10

8082

jr c,_38

8083

dec b

8084

;Increment the exponent :)

8085

ld de,(pow10exp_single-1)

8086

inc d

8087

ld (pow10exp_single-1),de

8088

;

8089

ld (hl),'0'-1

8090

inc (hl)

8091

sub 10

8092

jr nc,$-3

8093

add a,10

8094

inc hl

8095

_38:

8096

; Get the remaining digits.

8097

_39:

8098

add a,'0'

8099

ld (hl),a

8100

inc hl

8101

push hl

8102

push bc

8103

call singletostrmul10

8104

pop bc

8105

pop hl

8106

djnz _39

8107

8108

;Save the pointer to the end of the string

8109

ld d,h

8110

ld e,l

8111

;ld (hl), 0

8112

8113

;Now let's round!

8114

cp 5

8115

jr c,rounding_done_single

8116

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

8117

_40:

8118

ld (hl),'0'

8119

_40a:

8120

dec hl

8121

inc (hl)

8122

ld a,(hl)

8123

cp $3A

8124

jr z,_40

8125

rounding_done_single:

8126

8127

8128

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

8129

ld hl,strout_single

8130

ld a,(hl)

8131

cp '-'

8132

jr nz,_41

8133

inc hl

8134

ld a,(hl)

8135

_41:

8136

cp '0'

8137

jr nz,_42

8138

dec de

8139

ex de,hl

8140

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

8141

sbc hl,de

8142

ld b,h

8143

ld c,l

8144

ld h,d

8145

ld l,e

8146

inc hl

8147

ldir

8148

cp a

8149

_42:

8150

8151

push de

8152

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

8153

ld a,(pow10exp_single)

8154

jr z,_43

8155

inc a

8156

ld (pow10exp_single),a

8157

_43:

8158

8159

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

8160

add a,4

8161

cp 10

8162

jp c,movdec_single

8163

_44:

8164

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

8165

;Then, we need to append the exponent string

8166

ld hl,strout_single

8167

ld de,strout_single-1

8168

ld a,(hl)

8169

cp '-' ;negative sign

8170

jr nz,_45

8171

ldi

8172

_45:

8173

ldi

8174

ld a,'.'

8175

ld (de),a

8176

8177

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

8178

pop hl

8179

call strip_zeroes

8180

8181

; Write the exponent

8182

ld (hl),'e'

8183

inc hl

8184

ld a,(pow10exp_single)

8185

or a

8186

jp p,_46

8187

ld (hl),'-' ;negative sign

8188

inc hl

8189

neg

8190

_46:

8191

cp 10

8192

jr c,_47

8193

ld (hl),'0'-1

8194

inc (hl)

8195

sub 10

8196

jr nc,$-3

8197

add a,10

8198

inc hl

8199

_47:

8200

add a,'0'

8201

ld (hl),a

8202

inc hl

8203

ld (hl),0

8204

ld hl,strout_single-1

8205

ret

8206

movdec_single:

8207

ld a,(pow10exp_single)

8208

or a

8209

jp p,posdec_single

8210

ld l,a

8211

;need to put zeroes before everything

8212

ld de,strout_single

8213

ld a,(de)

8214

cp '-' ;negative sign

8215

push af

8216

ld a,'0'

8217

jr z,$+3

8218

_48:

8219

dec de

8220

ld (de),a

8221

inc l

8222

jr nz,_48

8223

_49:

8224

ex de,hl

8225

ld (hl),'.'

8226

pop af

8227

jr nz,_50

8228

dec hl

8229

ld (hl),a

8230

_50:

8231

ex de,hl

8232

pop hl

8233

call strip_zeroes

8234

ld (hl),0

8235

ex de,hl

8236

ret

8237

8238

posdec_single:

8239

ld hl,strout_single

8240

ld de,strout_single-1

8241

ld c,a

8242

ld a,(hl)

8243

ld b,0

8244

cp '-' ;negative sign

8245

jr nz,_51

8246

inc c

8247

_51:

8248

inc c

8249

ldir

8250

ld a,'.'

8251

ld (de),a

8252

pop hl

8253

call strip_zeroes

8254

ld (hl),0

8255

ld hl,strout_single-1

8256

ret

8257

strcase_single:

8258

ld hl,str_Zero

8259

ld a,(scrap+2)

8260

add a,a

8261

and $C0

8262

jr z,_52

8263

ld hl,str_Inf

8264

jp pe,_52

8265

ld hl,str_NaN

8266

_52:

8267

call mov4

8268

ld hl,strout_single

8269

ret

8270

8271

singletostrmul10:

8272

;multiply the 0.24 fixed point number at scrap by 10

8273

;overflow in A register

8274

ld a,(scrap+2)

8275

ld e,a

8276

ld hl,(scrap)

8277

xor a

8278

ld d,e

8279

ld b,h

8280

ld c,l

8281

add hl,hl

8282

rl d

8283

rla

8284

add hl,hl

8285

rl d

8286

rla

8287

add hl,bc

8288

ld b,a

8289

ld a,d

8290

adc a,e

8291

ld d,a

8292

ld a,b

8293

adc a,0

8294

add hl,hl

8295

rl d

8296

rla

8297

ld (scrap+1),de

8298

ld (scrap),hl

8299

ret

8300

8301

strip_zeroes:

8302

ld a,'0'

8303

_53:

8304

dec hl

8305

cp (hl)

8306

jr z,_53

8307

8308

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

8309

ld a,'.'

8310

cp (hl)

8311

ret z

8312

inc hl

8313

ret

8314

8315

singletostr_mul:

8316

rra

8317

call c,_54

8318

ld hl,4

8319

add hl,de

8320

ex de,hl

8321

ret

8322

_54:

8323

ld h,b

8324

ld l,c

8325

jp mulSingle

8326

mul8:

8327

;H*E => HL

8328

ld l,0

8329

ld d,l

8330

mul8_preset:

8331

sla h

8332

jr nc,$+3

8333

ld l,e

8334

add hl,hl

8335

jr nc,$+3

8336

add hl,de

8337

add hl,hl

8338

jr nc,$+3

8339

add hl,de

8340

add hl,hl

8341

jr nc,$+3

8342

add hl,de

8343

add hl,hl

8344

jr nc,$+3

8345

add hl,de

8346

add hl,hl

8347

jr nc,$+3

8348

add hl,de

8349

add hl,hl

8350

jr nc,$+3

8351

add hl,de

8352

add hl,hl

8353

ret nc

8354

add hl,de

8355

ret

8356

8357

8358

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

8359

; str2Single

8360

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

8361

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

8362

8363

char_NEG: equ '-'

8364

char_ENG: equ ','

8365

char_DEC: equ '.'

8366

ptr_sto: equ scrap+9

8367

str2single:

8368

;;#Routines/Single Precision

8369

;;Inputs:

8370

;; HL points to the string

8371

;; BC points to where the float is output

8372

;;Output:

8373

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

8374

;;Destroys:

8375

;; 11 bytes at scrap ?

8376

call pushpop

8377

push bc

8378

;Check if there is a negative sign.

8379

; Save for later

8380

; Advance ptr

8381

ld a,(hl)

8382

sub char_NEG

8383

sub 1

8384

push af

8385

jr nc,$+3

8386

inc hl

8387

;Skip all leading zeroes

8388

ld a,(hl)

8389

cp '0'

8390

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

8391

;Set exponent to 0

8392

ld b,0

8393

;Check if the next char is char_DEC

8394

sub char_DEC

8395

or a ;to reset the carry flag

8396

jr nz,_55

8397

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

8398

;Get rid of zeroes

8399

dec b

8400

_54a:

8401

inc hl

8402

ld a,(hl)

8403

cp '0'

8404

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

8405

scf

8406

_55:

8407

;Now we read in the next 8 digits

8408

ld de,scrap+3

8409

call ascii_to_uint8

8410

call ascii_to_uint8

8411

call ascii_to_uint8

8412

call ascii_to_uint8

8413

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

8414

;b is the exponent

8415

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

8416

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

8417

sbc a,a

8418

inc a

8419

ld c,a

8420

_56:

8421

ld a,(hl)

8422

cp 30h

8423

jr nz,_57

8424

inc hl

8425

ld a,b

8426

add a,c

8427

jp z,strToSingle_inf

8428

ld b,a

8429

jr _56

8430

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

8431

_57:

8432

cp char_NEG

8433

call z,str_eng_exp

8434

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

8435

ld (ptr_sto),hl

8436

ld d,100

8437

call scrap_times_256

8438

ld a,c

8439

ld (scrap+6),a

8440

call scrap_times_256

8441

ld a,c

8442

ld (scrap+5),a

8443

call scrap_times_256

8444

ld a,c

8445

ld (scrap+4),a

8446

call scrap_times_256

8447

ld a,c

8448

ld (scrap+3),a

8449

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

8450

;

8451

ld hl,(scrap+3)

8452

ld a,h

8453

or l

8454

ld hl,(scrap+5)

8455

or l

8456

or h

8457

jp z,strToSingle_zero-1

8458

ld c,$7F

8459

ld a,h

8460

or a

8461

jp m,strToSingle_normed

8462

;Will need to iterate at most three times

8463

_58:

8464

dec c

8465

ld hl,scrap+3

8466

sla (hl)

8467

inc hl

8468

rl (hl)

8469

inc hl

8470

rl (hl)

8471

inc hl

8472

adc a,a

8473

jp p,_58

8474

strToSingle_normed:

8475

;Move the number to scrap

8476

ld hl,(scrap+4)

8477

ld (scrap),hl

8478

ld l,a

8479

ld h,c

8480

sla l

8481

pop af

8482

rr l

8483

ld (scrap+2),hl

8484

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

8485

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

8486

xor a

8487

sub b

8488

ld de,pown10LUT

8489

jp p,_59

8490

ld a,b

8491

ld de,pow10LUT

8492

cp 40

8493

jp nc,strToSingle_inf+1

8494

_59:

8495

cp 40

8496

jp nc,strToSingle_zero

8497

ld hl,scrap

8498

ld b,h

8499

ld c,l

8500

call _60

8501

call _60

8502

call _60

8503

call _60

8504

call _60

8505

call _60

8506

pop de

8507

jp mov4

8508

_60:

8509

rra

8510

call c,mulSingle

8511

inc de

8512

inc de

8513

inc de

8514

inc de

8515

ret

8516

str_eng_exp:

8517

ld de,0

8518

inc hl

8519

ld a,(hl)

8520

cp char_NEG ;negative exponent?

8521

push af

8522

jr nz,$+3

8523

inc hl

8524

_61:

8525

ld a,(hl)

8526

sub 3Ah

8527

add a,10

8528

jr nc,_62

8529

inc hl

8530

push hl

8531

ld h,d

8532

ld l,e

8533

add hl,hl

8534

add hl,hl

8535

add hl,de

8536

add hl,hl

8537

add a,l

8538

ld l,a

8539

ex de,hl

8540

pop hl

8541

jp c,eng_overflow

8542

inc d

8543

dec d

8544

jp z,_61

8545

jp nz,eng_overflow

8546

_62:

8547

ld a,e

8548

cp 40

8549

jr nc,eng_overflow

8550

pop af

8551

ld a,b

8552

jr nz,_63

8553

sub e

8554

ld b,a

8555

ret

8556

_63:

8557

add a,e

8558

ld b,a

8559

ret

8560

scrap_times_256:

8561

ld e,8

8562

_64:

8563

or a

8564

ld hl,scrap

8565

call _65

8566

call _65

8567

rl c

8568

dec e

8569

jr nz,_64

8570

ret

8571

_65:

8572

call scrap_times_sub

8573

scrap_times_sub:

8574

ld a,(hl)

8575

rla

8576

cp d

8577

jr c,$+3

8578

sub d

8579

ld (hl),a

8580

inc hl

8581

ccf

8582

ret

8583

eng_overflow:

8584

pop af

8585

jr nz,strToSingle_inf

8586

pop af

8587

strToSingle_zero:

8588

ld hl,const_0

8589

pop de

8590

jp mov4

8591

strToSingle_inf:

8592

;return inf

8593

pop af

8594

ld hl,const_inf

8595

jr nc,_66

8596

ld hl,const_NegInf

8597

_66:

8598

pop de

8599

jp mov4

8600

8601

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

8602

; int2Single

8603

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

8604

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

8605

8606

int2Single:

8607

call pushpop

8608

push bc

8609

push hl

8610

pop ix

8611

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

8612

ld h, (ix+1)

8613

ld bc, 0x1000 ; bynary digits count + sign

8614

8615

int2Single.test.zero:

8616

xor a

8617

or h ; test if hl is not zero

8618

jr nz, int2Single.test.negative

8619

or l

8620

jr nz, int2Single.test.negative

8621

ld hl, 0

8622

ld de, 0

8623

jp int2Single.save

8624

8625

int2Single.test.negative:

8626

bit 7, h ; test if hl is negative

8627

jr z, int2Single.normalize

8628

ld c, 0x80 ; sign negative

8629

ld a, h ;\

8630

cpl ; |

8631

ld h, a ; | abs(hl)

8632

ld a, l ; |

8633

cpl ; |

8634

ld l, a ;/

8635

inc hl

8636

8637

int2Single.normalize:

8638

dec b

8639

bit 7, h

8640

jr nz, int2Single.mount

8641

sla l

8642

rl h

8643

jr int2Single.normalize

8644

8645

int2Single.mount:

8646

res 7, h ; turn off upper bit

8647

8648

ld a, c ; restore sign

8649

or h ; put sign...

8650

ld h, a ; ...into upper mantissa

8651

8652

ld e, h ; sign+mantissa

8653

ld h, l ; high mantissa

8654

ld l, 0 ; low mantissa

8655

8656

ld a, b ; binary digits count

8657

or 0x80 ; exponent bias

8658

ld d, a ; exponent

8659

8660

int2Single.save:

8661

pop ix

8662

ld (ix), l ; low mantissa

8663

ld (ix+1), h ; high mantissa

8664

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

8665

ld (ix+3), d ; expoent

8666

ld (ix+4), 0

8667

ld (ix+5), 0

8668

ld (ix+6), 0

8669

ld (ix+7), 0

8670

ret

8671

8672

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

8673

; single2Int

8674

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

8675

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

8676

single2Int:

8677

;Input:

8678

; HL points to the single-precision float

8679

;Output:

8680

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

8681

; BC points to 16-bit signed integer

8682

call pushpop

8683

push bc

8684

ld e,(hl)

8685

inc hl

8686

ld d,(hl)

8687

inc hl

8688

ld a,(hl)

8689

add a,a

8690

push af

8691

scf

8692

rra

8693

ld c,a

8694

inc hl

8695

ld a,(hl)

8696

ld hl,0

8697

sub 80h

8698

jr c,no_shift_single_to_int16

8699

cp 39

8700

jr nc,no_shift_single_to_int16

8701

sub 8

8702

jr c,_67

8703

ld l,c

8704

ld c,d

8705

ld d,e

8706

ld e,h

8707

sub 8

8708

jr c,_67

8709

ld h,l

8710

ld l,c

8711

ld c,d

8712

ld d,e

8713

sub 8

8714

jr c,_67

8715

ld h,l

8716

ld l,c

8717

ld c,d

8718

sub 8

8719

jr c,_67

8720

ld h,l

8721

ld l,c

8722

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

8723

_67:

8724

add a,9

8725

_67a:

8726

ld b,a

8727

ld a,e

8728

_68:

8729

add a,a

8730

rl d

8731

rl c

8732

adc hl,hl

8733

djnz _68

8734

no_shift_single_to_int16:

8735

pop af

8736

jr nc,_69

8737

;need to negate

8738

xor a

8739

sub e

8740

ld e,0

8741

ld a,e

8742

sbc a,d

8743

ld a,e

8744

sbc a,c

8745

ld d,e

8746

ex de,hl

8747

sbc hl,de

8748

_69:

8749

pop ix

8750

ld (ix), l

8751

ld (ix+1), h

8752

ret

8753

8754

8755

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

8756

; Auxiliary routines

8757

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

8758

8759

str_Zero: db "0",0

8760

str_Inf: db "inf",0

8761

str_NaN: db "NaN",0

8762

8763

start_const:

8764

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

8765

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

8766

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

8767

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

8768

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

8769

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

8770

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

8771

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

8772

const_2: dw 0, 33024

8773

const_3: dw 0, 33088

8774

const_4: dw 0, 33280

8775

const_5: dw 0, 33312

8776

const_7: dw 0, 33376

8777

const_9: dw 0, 33552

8778

const_16: dw 0, 33792

8779

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

8780

const_100_inv: dw 55050, 31011

8781

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

8782

const_half_1: dw 0, 32512

8783

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

8784

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

8785

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

8786

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

8787

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

8788

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

8789

const_half_pi: dw 4059, 32841

8790

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

8791

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

8792

; db $,$,$,$

8793

end_const:

8794

sin_a1: dw 43691, 32042

8795

sin_a2: dw 34952, 30984

8796

sin_a3: dw 3329, 29520

8797

cos_a1: equ const_half_1

8798

cos_a2: dw 43691, 31530

8799

cos_a3: dw 2914, 30262

8800

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

8801

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

8802

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

8803

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

8804

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

8805

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

8806

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

8807

8808

iconstSingle:

8809

ex (sp),hl

8810

ld a,(hl)

8811

inc hl

8812

ex (sp),hl

8813

constSingle:

8814

;A is the constant ID#

8815

;returns nc if failed, c otherwise

8816

;HL points to the constant

8817

cp (end_const-start_const)>>2

8818

ret nc

8819

ld hl,start_const

8820

add a,a

8821

add a,a

8822

add a,l

8823

ld l,a

8824

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

8825

; ccf

8826

; ret c

8827

; inc h

8828

;#endif

8829

scf

8830

ret

8831

8832

;;LUTs used

8833

lut:

8834

pown10LUT:

8835

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

8836

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

8837

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

8838

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

8839

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

8840

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

8841

pow10LUT:

8842

const_10:

8843

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

8844

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

8845

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

8846

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

8847

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

8848

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

8849

8850

C_Times_BDE:

8851

;;C*BDE => CAHL

8852

;C = 0 157

8853

;C = 1 141

8854

;141+

8855

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

8856

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

8857

;C>=32 95+4{0,33+{0,1}}+{0,20+{0,8}}

8858

;C>=16 75+3{0,33+{0,1}}+{0,20+{0,8}}

8859

;C>=8 55+2{0,33+{0,1}}+{0,20+{0,8}}

8860

;C>=4 35+{0,33+{0,1}}+{0,20+{0,8}}

8861

;C>=2 15+{0,20+{0,8}}

8862

;min: 141cc

8863

;max: 508cc

8864

;avg: 349.21279907227cc

8865

8866

ld a,b

8867

ld h,d

8868

ld l,e

8869

sla c

8870

jr c,mul8_24_1

8871

sla c

8872

jr c,mul8_24_2

8873

sla c

8874

jr c,mul8_24_3

8875

sla c

8876

jr c,mul8_24_4

8877

sla c

8878

jr c,mul8_24_5

8879

sla c

8880

jr c,mul8_24_6

8881

sla c

8882

jr c,mul8_24_7

8883

sla c

8884

ret c

8885

ld a,c

8886

ld h,c

8887

ld l,c

8888

ret

8889

mul8_24_1:

8890

add hl,hl

8891

rla

8892

rl c

8893

jr nc,$+7

8894

add hl,de

8895

adc a,b

8896

jr nc,$+3

8897

inc c

8898

mul8_24_2:

8899

add hl,hl

8900

rla

8901

rl c

8902

jr nc,$+7

8903

add hl,de

8904

adc a,b

8905

jr nc,$+3

8906

inc c

8907

mul8_24_3:

8908

add hl,hl

8909

rla

8910

rl c

8911

jr nc,$+7

8912

add hl,de

8913

adc a,b

8914

jr nc,$+3

8915

inc c

8916

mul8_24_4:

8917

add hl,hl

8918

rla

8919

rl c

8920

jr nc,$+7

8921

add hl,de

8922

adc a,b

8923

jr nc,$+3

8924

inc c

8925

mul8_24_5:

8926

add hl,hl

8927

rla

8928

rl c

8929

jr nc,$+7

8930

add hl,de

8931

adc a,b

8932

jr nc,$+3

8933

inc c

8934

mul8_24_6:

8935

add hl,hl

8936

rla

8937

rl c

8938

jr nc,$+7

8939

add hl,de

8940

adc a,b

8941

jr nc,$+3

8942

inc c

8943

mul8_24_7:

8944

add hl,hl

8945

rla

8946

rl c

8947

ret nc

8948

add hl,de

8949

adc a,b

8950

ret nc

8951

inc c

8952

ret

8953

8954

pushpop:

8955

;26 bytes, adds 118cc to the traditional routine

8956

ex (sp),hl

8957

push de

8958

push bc

8959

push af

8960

push hl

8961

ld hl,pushpopret

8962

ex (sp),hl

8963

push hl

8964

push af

8965

ld hl,12

8966

add hl,sp

8967

ld a,(hl)

8968

inc hl

8969

ld h,(hl)

8970

ld l,a

8971

pop af

8972

ret

8973

pushpopret:

8974

pop af

8975

pop bc

8976

pop de

8977

pop hl

8978

ret

8979

8980

mov4:

8981

ldi

8982

ldi

8983

ldi

8984

ldi

8985

ret

8986

8987

ascii_to_uint8:

8988

;c flag means don't increment the exponent

8989

ld c,0

8990

ld a,(hl)

8991

jr c,ascii_to_uint8_noexp

8992

cp char_DEC

8993

jr z,ascii_to_uint8_noexp-2

8994

_70:

8995

sub 3Ah

8996

add a,10

8997

jr nc,ascii_to_uint8_noexp_end

8998

inc b

8999

ld c,a

9000

add a,a

9001

add a,a

9002

add a,c

9003

add a,a

9004

ld c,a

9005

inc hl

9006

_71:

9007

ld a,(hl)

9008

cp char_DEC

9009

jr z,ascii_to_uint8_noexp_2nd

9010

_72:

9011

sub 3Ah

9012

add a,10

9013

jr nc,ascii_to_uint8_noexp_end

9014

inc b

9015

add a,c

9016

inc hl

9017

ld (de),a

9018

dec de

9019

or a

9020

ret

9021

9022

inc hl

9023

ld a,(hl)

9024

ascii_to_uint8_noexp:

9025

sub 3Ah

9026

add a,10

9027

jr nc,ascii_to_uint8_noexp_end

9028

ld c,a

9029

add a,a

9030

add a,a

9031

add a,c

9032

add a,a

9033

ld c,a

9034

ascii_to_uint8_noexp_2nd:

9035

inc hl

9036

ld a,(hl)

9037

sub 3Ah

9038

add a,10

9039

jr nc,ascii_to_uint8_noexp_end

9040

add a,c

9041

inc hl

9042

jr ascii_2 ;.db $FE ;start of `cp **`, saves 1cc

9043

ascii_to_uint8_noexp_end:

9044

ld a,c

9045

ascii_2:

9046

ld (de),a

9047

dec de

9048

scf

9049

ret

9050

9051

rsubSingle:

9052

;;-x+y

9053

push af

9054

push hl

9055

push de

9056

push bc

9057

push de

9058

ld de,addend2

9059

ldi

9060

ldi

9061

ld a,(hl)

9062

xor 80h

9063

ld (de),a

9064

inc de

9065

inc hl

9066

ld a,(hl)

9067

ld (de),a

9068

pop de

9069

ld hl,addend2

9070

jp addInject ;jumps in to the addSingle routine

9071

9072

;This routine performs `x mod 1`, returning a non-negative value.

9073

;+inf -> NaN

9074

;-inf -> NaN

9075

;NaN -> NaN

9076

mod1Single:

9077

call pushpop

9078

push bc

9079

ld e,(hl)

9080

inc hl

9081

ld d,(hl)

9082

inc hl

9083

ld c,(hl)

9084

ld a,c

9085

xor 80h

9086

push af

9087

jp p,mod1Single.1

9088

ld c,a

9089

mod1Single.1:

9090

9091

inc hl

9092

ld a,(hl)

9093

ld b,a

9094

or a

9095

jr z,mod1Single_special

9096

sub $80

9097

jr c,mod1_end

9098

inc a

9099

ld b,a

9100

ld a,c

9101

ex de,hl

9102

mod1Single.2:

9103

add hl,hl

9104

rla

9105

djnz mod1Single.2

9106

ld c,a

9107

9108

;If it is zero, need to set exponent to zero and return

9109

or h

9110

or l

9111

ex de,hl

9112

jr z,mod1_end

9113

9114

;Need to normalize

9115

ld b,$7F

9116

ld a,c

9117

or a

9118

jp m,mod1_end

9119

ex de,hl

9120

mod1Single.3:

9121

dec b

9122

add hl,hl

9123

adc a,a

9124

jp p,mod1Single.3

9125

ld c,a

9126

ex de,hl

9127

mod1_end:

9128

pop af

9129

pop hl

9130

jp m,mod1Single.4

9131

;make sure it isn't zero else we need to add 1

9132

ld a,b

9133

or a

9134

jr z,mod1Single.4

9135

ld (scrap),de

9136

ld (scrap+2),bc

9137

ld b,h

9138

ld c,l

9139

ld hl,scrap

9140

ld de,const_1

9141

jp addSingle

9142

mod1Single_special:

9143

;If INF, need to return NaN instead

9144

;For 0 and NaN, just return itself :)

9145

pop af

9146

pop hl

9147

ld a,c

9148

add a,a

9149

jp p,mod1Single.4

9150

ld c,$40

9151

mod1Single.4:

9152

res 7,c

9153

ld (hl),e

9154

inc hl

9155

ld (hl),d

9156

inc hl

9157

ld (hl),c

9158

inc hl

9159

ld (hl),b

9160

ret

9161

9162

; --------------------------------------------------------------

9163

; Converts a signed integer value to a zero-terminated ASCII

9164

; string representative of that value (using radix 10).

9165

; References:

9166

; Brandon Wilson WikiTI

9167

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Other:DispA#Decimal_Signed_Version

9168

; --------------------------------------------------------------

9169

; INPUTS:

9170

; HL Value to convert (two's complement integer).

9171

; DE Base address of string destination. (pointer).

9172

; --------------------------------------------------------------

9173

; OUTPUTS:

9174

; None

9175

; --------------------------------------------------------------

9176

; REGISTERS/MEMORY DESTROYED

9177

; AF HL

9178

; --------------------------------------------------------------

9179

9180

IntToStr:

9181

push de

9182

push bc

9183

9184

; Detect sign of HL.

9185

bit 7, h

9186

jr z, _DoConvert

9187

9188

; HL is negative. Output '-' to string and negate HL.

9189

ld a, '-'

9190

ld (de), a

9191

inc de

9192

9193

; Negate HL (using two's complement)

9194

xor a

9195

sub l

9196

ld l, a

9197

ld a, 0 ; Note that XOR A or SUB A would disturb CF

9198

sbc a, h

9199

ld h, a

9200

9201

; Convert HL to digit characters

9202

_DoConvert:

9203

ld b, 0 ; B will count character length of number

9204

_DoConvert.1:

9205

ld c, 10

9206

call div_hl_c; HL = HL / A, A = remainder

9207

push af

9208

inc b

9209

ld a, h

9210

or l

9211

jr nz, _DoConvert.1

9212

9213

; Retrieve digits from stack

9214

_DoConvert.2:

9215

pop af

9216

or $30

9217

ld (de), a

9218

inc de

9219

djnz _DoConvert.2

9220

9221

; Terminate string with NULL

9222

xor a

9223

ld (de), a

9224

9225

pop bc

9226

pop de

9227

ret

9228

9229

;===============================================================

9230

; Convert a string of base-10 digits to a 16-bit value.

9231

; http://z80-heaven.wikidot.com/math#toc32

9232

;Input:

9233

; DE points to the base 10 number string in RAM.

9234

;Outputs:

9235

; HL is the 16-bit value of the number

9236

; DE points to the byte after the number

9237

; BC is HL/10

9238

; z flag reset (nz)

9239

; c flag reset (nc)

9240

;Destroys:

9241

; A (actually, add 30h and you get the ending token)

9242

;Size: 23 bytes

9243

;Speed: 104n+42+11c

9244

; n is the number of digits

9245

; c is at most n-2

9246

; at most 595 cycles for any 16-bit decimal value

9247

;===============================================================

9248

9249

StrToInt:

9250

ld hl,0 ; 10 : 210000

9251

ConvLoop: ;

9252

ld a,(de) ; 7 : 1A

9253

sub 30h ; 7 : D630

9254

cp 10 ; 7 : FE0A

9255

ret nc ;5|11 : D0

9256

inc de ; 6 : 13

9257

;

9258

ld b,h ; 4 : 44

9259

ld c,l ; 4 : 4D

9260

add hl,hl ; 11 : 29

9261

add hl,hl ; 11 : 29

9262

add hl,bc ; 11 : 09

9263

add hl,hl ; 11 : 29

9264

;

9265

add a,l ; 4 : 85

9266

ld l,a ; 4 : 6F

9267

jr nc,ConvLoop ;12|23: 30EE

9268

inc h ; --- : 24

9269

jr ConvLoop ; --- : 18EB

9270

9271

; divides hl by c

9272

; return remainder in a

9273

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division

9274

div_hl_c:

9275

push bc

9276

xor a

9277

ld b, 16

9278

div_hl_c.loop:

9279

add hl, hl

9280

rla

9281

jr c, $+5

9282

cp c

9283

jr c, $+4

9284

sub c

9285

inc l

9286

djnz div_hl_c.loop

9287

pop bc

9288

ret

9289

9290

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division

9291

div_ehl_d:

9292

xor a

9293

ld b, 24

9294

div_ehl_d.loop:

9295

add hl, hl

9296

rl e

9297

rla

9298

jr c, $+5

9299

cp d

9300

jr c, $+4

9301

sub d

9302

inc l

9303

djnz div_ehl_d.loop

9304

ret

9305

9306

div_dehl_c:

9307

push bc

9308

xor a

9309

ld b, 32

9310

div_dehl_c.loop:

9311

add hl, hl

9312

rl e

9313

rl d

9314

rla

9315

jr c, $+5

9316

cp c

9317

jr c, $+4

9318

sub c

9319

inc l

9320

djnz div_dehl_c.loop

9321

pop bc

9322

ret

9323

9324

9325

9326

9327

9328

;--------------------------------------------------------

9329

romSize: equ 0x4000 ; ROM size (16k)

9330

romPad:

9331

ds romSize-(romPad-pgmArea),0

9332

end_file: end start_pgm ; label start is the entry point

Older »