mach/z80/libem/libem_s.a

   1 e�aaru.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define .aaru
   2 .sect .text
   3 .sect .rom
   4 .sect .data
   5 .sect .bss
   6 .sect .text
   7
   8 ! AAR NOT DEFINED
   9
  10 .aaru:
  11         pop ix
  12         pop hl
  13         xor a
  14         xor h
  15         jp nz,1f
  16         ld a,2
  17         xor l
  18         jp z,2f
  19 1:
  20         ld hl,EARRAY
  21         call .trp.z
  22 2:
  23         push ix
  24         jp .aar
  25 aar.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define .aar
  26 .sect .text
  27 .sect .rom
  28 .sect .data
  29 .sect .bss
  30 .sect .text
  31 ! use .mli2
  32
  33 ! 2-byte descriptor elements
  34 ! any size array elements
  35 ! no range checking
  36 ! parameters:
  37 !   stack:  pointer to descriptor
  38 !           index
  39 !           base address of array
  40 !   stack:  result (out)
  41 ! uses .mli2 routine
  42 ! side-effect: size of array elements in bc
  43
  44
  45
  46 .aar:
  47         pop hl          ! return address
  48         pop ix          ! pointer to descr.
  49         ex (sp),hl      ! save ret. addr.
  50                         ! hl := index
  51         ld c,(ix+0)     ! bc := lower bound
  52         ld b,(ix+1)
  53         xor a
  54         sbc hl,bc       ! hl := index-lwb
  55         ld c,(ix+4)     ! bc := size
  56         ld b,(ix+5)
  57         ex de,hl        ! de := index-lwb
  58         call .mli2      ! hl := bc*de =
  59                         !  size*(index-lwb)
  60         pop ix          ! return address
  61         pop de          ! base
  62         add hl,de       ! addr. of element
  63         push hl
  64         jp (ix)         ! return
  65 aar2.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .aar2
  66 .sect .text
  67 .sect .rom
  68 .sect .data
  69 .sect .bss
  70 .sect .text
  71
  72 ! special case aar: element size = 2 (statically known)
  73 ! parameters:
  74 !    on stack
  75 ! execution time: 124 states
  76
  77
  78
  79 .aar2:
  80         pop ix          ! save return address
  81         pop hl          ! pointer to descriptor
  82         ld c,(hl)       ! bc := lower bound
  83         inc hl
  84         ld b,(hl)
  85         pop hl          ! index
  86         xor a
  87         sbc hl,bc       ! index - lwb
  88         add hl,hl       ! size*(index-lwb)
  89         pop de          ! base address of array
  90         add hl,de
  91         push hl
  92         jp (ix)
  93 eand.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .and
  94 .sect .text
  95 .sect .rom
  96 .sect .data
  97 .sect .bss
  98 .sect .text
  99
 100 ! auxiliary size 'and'
 101 ! parameters:
 102 !    de: size
 103 !    stack: operands
 104 !    stack: result (out)
 105
 106
 107
 108 .and:
 109         pop ix          ! save return address
 110         ld h,d
 111         ld l,e
 112         add hl,sp
 113         ex de,hl
 114         add hl,de       ! now hl is the base of second
 115         ld b,d          ! operand.  bc and de are base
 116         ld c,e          ! of the first operand
 117 1:
 118         dec hl
 119         dec de
 120         ld a,(de)
 121         and (hl)
 122         ld (hl),a
 123         xor a
 124         sbc hl,bc
 125         jr z,2f
 126         add hl,bc
 127         jr 1b
 128 2:
 129         ld h,b
 130         ld l,c
 131         ld sp,hl
 132         jp (ix)
 133 cii.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0e\f.define .cii
 134 .define .cuu
 135 .sect .text
 136 .sect .rom
 137 .sect .data
 138 .sect .bss
 139 .sect .text
 140
 141 ! cii: convert integer to integer
 142 ! parameters:
 143 !    stack:   destination size
 144 !             source size
 145 !             source
 146 !    stack:   result (out)
 147 ! This code is also used by cuu.
 148 ! The contents of the a-register determines
 149 ! if we're doing a cii (a=0) or a cuu (a=1),
 150 ! so be very careful with this register!
 151
 152
 153
 154 .cii:
 155         pop ix          ! return address
 156         pop hl          ! destination size
 157         pop de          ! source size
 158         ld b,h          ! bc := destination size
 159         ld c,l
 160         xor a           ! watch it, this is dirty!
 161                         ! Besides clearing the carry
 162                         ! this instruction sets a-reg.
 163                         ! to 0, to indicate this is
 164                         ! a cii and not a cuu.
 165         sbc hl,de       ! hl := destination size
 166                         !  - source size
 167         jr z,1f         ! equal, return
 168         jp p,2f         ! larger, expand
 169         ! smaller, shrink
 170         ! The most significant part of the source
 171         ! is removed. As the least sign. part is
 172         ! on top of the stack, we have to move an
 173         ! entire data block.
 174 9:
 175         add hl,sp       ! note that hl < 0
 176                         ! (also come here via cuu)
 177         add hl,de
 178         dec hl          ! now hl points to most
 179                         ! significant byte of what
 180                         ! will be left over of source
 181         ex de,hl
 182         add hl,sp
 183         ex de,hl
 184         dec de          ! now de points to highest
 185                         ! byte of source
 186         lddr            ! move 'destination size'
 187                         ! bytes upwards (i.e. away
 188                         ! from top of stack)
 189         inc de
 190         ex de,hl
 191         ld sp,hl        ! adjust stackpointer
 192 1:
 193         jp (ix)         ! return
 194
 195 2:
 196         ! larger, expand
 197         ! A number of bytes (containing the signbits
 198         ! of the source) is inserted before the most
 199         ! significant byte of the source.
 200         ! As this byte is somewhere in the middle of
 201         ! the stack, the entire source must first be
 202         ! moved downwards (in the direction of the
 203         ! top)
 204 8:
 205         ld b,d          ! bc := source size
 206                         ! (also come here via cuu)
 207         ld c,e
 208         ex de,hl        ! de := difference (> 0)
 209         ld hl,0
 210         add hl,sp       ! hl := sp
 211         dec de          ! if difference = 1, don't adjust stack pointer
 212         jr nz, 4f
 213         inc de
 214         jr 5f
 215 4:
 216         inc de
 217         push hl
 218         or a
 219         sbc hl,de
 220         ex de,hl        ! de := sp - difference
 221         pop hl          ! hl := sp
 222         ex de,hl        ! adjust sp
 223         ld sp,hl
 224         ex de,hl
 225         ldir            ! move source upwards,
 226                         ! creating a 'hole'
 227                         ! inside the stack
 228         ! now we will fill the hole with bytes
 229         ! containing either 0 or -1, depending
 230         ! on the signbit of the source.
 231         or a
 232         sbc hl,de
 233         ex de,hl        ! de := difference
 234         dec hl          ! now hl points to
 235                         ! most significant byte
 236                         ! of the source
 237 5:
 238         or a            ! see if we're doing
 239                         ! a 'cii' or a 'cuu'
 240         jr nz,3f        ! cuu, expand with zeroes
 241         bit 7,(hl)      ! test signbit
 242         jr z,3f
 243         dec b           ! b := -1 (was 0 after ldir)
 244 3:
 245         inc hl
 246         ld (hl),b       ! either 0 or -1
 247         dec de
 248         ld a,d
 249         or e
 250         jr nz,3b
 251         jp (ix)         ! return
 252
 253
 254
 255
 256 ! cuu: convert unsigned to unsigned
 257 ! parameters:
 258 !    stack:  destination size
 259 !            source size
 260 !            source
 261 !    stack:  result (out)
 262 ! The only difference between a cuu and a cii is:
 263 ! if the destination is larger than the source,
 264 ! the former extends with zeroes and the latter
 265 ! extends with sign bits
 266 ! cuu uses the code of cii. In this case it puts
 267 ! a '1' in the accumulator to indicate this is
 268 ! a cuu.
 269
 270
 271
 272 .cuu:
 273         pop ix
 274         pop hl
 275         pop de
 276         ld b,h
 277         ld c,l
 278         xor a           ! clear carry
 279         sbc hl,de
 280         jr z,1b         ! equal, return
 281         jp m,9b         ! smaller, shrink
 282         inc a           ! a := 1
 283         jr 8b           ! larger, expand
 284 \0cms.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0d\ 1.define .cms
 285 .sect .text
 286 .sect .rom
 287 .sect .data
 288 .sect .bss
 289 .sect .text
 290
 291 ! any size sets
 292 ! parameters:
 293 !   hl: size
 294 !   stack: second operand
 295 !          first operand
 296 !   stack: result (out)
 297
 298
 299
 300 .cms:
 301         pop ix
 302         ld b,h
 303         ld c,l
 304         add hl,sp
 305 0:
 306         dec sp
 307         pop af
 308         cpi
 309         jr nz,1f
 310         ld a,b
 311         or c
 312         jr nz,0b
 313         ld de,0
 314         jr 2f
 315 1:
 316         add hl,bc
 317         ld de,1
 318 2:
 319         ld sp,hl
 320         push de
 321         jp (ix)
 322 cmu.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 5.define .cmu
 323 .sect .text
 324 .sect .rom
 325 .sect .data
 326 .sect .bss
 327 .sect .text
 328
 329 ! parameters:
 330 !   hl   :  size (#bytes)
 331 !   stack:  second operand
 332 !           first operand
 333 !   stack:  result (out)
 334
 335
 336
 337 .cmu:
 338         ! The two operands are compared byte by byte,
 339         ! starting at the highest byte, until
 340         ! they differ.
 341         pop ix          ! return address
 342         pop hl          ! #bytes
 343         ld b,h          ! bc := hl
 344         ld c,l
 345         add hl,sp
 346         dec hl          ! pointer to highest byte
 347                         ! of second operand
 348         ld d,h          ! de := hl
 349         ld e,l
 350         add hl,bc       ! pointer to highest byte
 351                         ! of first operand
 352         ld sp,hl        ! points to where the
 353                         ! result will be stored
 354         ex de,hl
 355         ! now, de points to highest byte of 1st operand
 356         !      sp   ,,          ,,              ,,
 357         !      hl   ,,          ,,          2nd ,,
 358         ! bc contains #bytes
 359
 360 0:
 361         ! loop, compare the two operands
 362         ! byte by byte.
 363         ld a,(de)
 364         xor (hl)        ! Avoid overflow during
 365                         ! subtraction. If the
 366                         ! signbits differ, then
 367                         ! the operands differ.
 368         jp m,2f         ! signbits differ
 369         ld a,(de)       ! signbits are equal,
 370                         ! so we can savely
 371                         ! compare the bytes.
 372         sub (hl)
 373         jr nz,1f        ! operands are different
 374         dec de          ! the two bytes are the
 375                         ! same, try next bytes,
 376                         ! if any.
 377         dec hl          ! bump pointers
 378         dec bc
 379         ld a,b          ! bc = 0 ?
 380         or c
 381         jr nz,0b        ! no, try next bytes
 382         ! yes, then the two operands are equal.
 383         ! Note that a=0 now.
 384 1:
 385         ld h,a          ! hl := result
 386         ld l,a
 387         jr 3f
 388 2:
 389         ! the signbits differ
 390         ld h,(hl)       ! hl := positive if
 391                         ! signbit of current
 392                         ! byte of 2nd operand
 393                         ! is "0", else negative
 394         ld l,1          ! just in case (hl)=0
 395 3:
 396         ex (sp),hl      ! sp was set above
 397         jp (ix)         ! return
 398  cmu4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0}\ 2.define .cmu4
 399 .sect .text
 400 .sect .rom
 401 .sect .data
 402 .sect .bss
 403 .sect .text
 404
 405 ! 4 byte cmu and cmi routine
 406 ! parameters:
 407 !   a:   0 for cmu, 1 for cmi
 408 !  stack: operands
 409 !  de:   result (out)
 410
 411
 412
 413 .cmu4:
 414         pop ix
 415         ld de,4
 416         ld b,d
 417         ld c,e
 418         ld hl,0
 419         add hl,sp
 420         add hl,bc
 421         dec hl
 422         ld d,h
 423         ld e,l
 424         add hl,bc
 425         ld (savesp),hl          ! save new sp-1
 426         or a
 427         jr z,1f
 428         ld a,(de)
 429         cp (hl)
 430         dec hl
 431         dec de
 432         dec bc
 433         jr z,1f
 434         jp p,4f
 435         jr 6f
 436 1:
 437         ld a,(de)
 438         cp (hl)
 439         dec de
 440         dec hl
 441         dec bc
 442         jr nz,2f
 443         ld a,b
 444         or c
 445         jr nz,1b
 446         ld d,a
 447         ld e,a
 448         jr 3f
 449 2:
 450         jr nc,4f
 451 6:
 452         ld de,1
 453         jr 3f
 454 4:
 455         ld de,-1
 456 3:
 457         ld hl,(savesp)
 458         inc hl
 459         ld sp,hl
 460         jp (ix)
 461 .sect .data
 462 savesp: .data2 0
 463 acsa.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\03\ 2.define .csa
 464 .sect .text
 465 .sect .rom
 466 .sect .data
 467 .sect .bss
 468 .sect .text
 469
 470 ! this is not a subroutine, but just a
 471 ! piece of code that computes the jump-
 472 ! address and jumps to it.
 473 ! traps if resulting address is zero
 474
 475
 476
 477 .csa:
 478         pop ix
 479         pop hl
 480         push bc
 481         ld c,(ix)
 482         ld b,(ix+1)
 483         ld e,(ix+2)
 484         ld d,(ix+3)
 485         xor a
 486         sbc hl,de
 487         jp m,1f
 488         ex de,hl
 489         ld l,(ix+4)
 490         ld h,(ix+5)
 491         xor a
 492         sbc hl,de
 493         jp m,1f
 494         ex de,hl
 495         add hl,hl
 496         ld de,6
 497         add hl,de
 498         ex de,hl
 499         add ix,de
 500         ld l,(ix)
 501         ld h,(ix+1)
 502         ld a,h
 503         or l
 504         jr nz,2f
 505 1:      ld a,b
 506         or c
 507         jr z,.trp.z
 508         ld l,c
 509         ld h,b
 510 2:      pop bc
 511         jp (hl)
 512 :csb.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 3.define .csb
 513 .sect .text
 514 .sect .rom
 515 .sect .data
 516 .sect .bss
 517 .sect .text
 518
 519 ! this is not a subroutine, but just a
 520 ! piece of code that computes the jump-
 521 ! address and jumps to it.
 522 ! traps if resulting address is zero
 523
 524
 525
 526 .csb:
 527         pop hl          ! pointer to descriptor
 528         pop de          ! case index
 529         ld c,(hl)       ! bc := default offset
 530         inc hl
 531         ld b,(hl)
 532         inc hl
 533         push bc         ! save default on stack
 534         ld c,(hl)       ! bc := #entries
 535         inc hl
 536         ld b,(hl)
 537         inc hl
 538 1:
 539         ! loop, try to find the case index
 540         ! in the descriptor
 541         ld a,b
 542         or c
 543         jr z,noteq      ! done, index not found
 544         ld a,(hl)       ! is de=(hl) ?
 545         inc hl
 546         cp e
 547         jr nz,2f        ! no
 548         ld a,(hl)
 549         inc hl
 550         cp d
 551         jr nz,3f        ! no
 552         ld a,(hl)       ! yes, get jump address
 553         inc hl
 554         ld h,(hl)
 555         ld l,a
 556         pop af          ! remove default
 557         jr 4f
 558 2:
 559         inc hl          ! skip high byte of index
 560 3:
 561         inc hl          ! skip jump address
 562         inc hl
 563         dec bc
 564         jr 1b
 565 noteq:
 566         pop hl          ! take default exit
 567 4:
 568         ld a,l          ! jump address is zero?
 569         or h
 570         jr z,.trp.z     ! yes, trap
 571         jp (hl)
 572 dvi2.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0"\ 2.define .dvi2
 573 .sect .text
 574 .sect .rom
 575 .sect .data
 576 .sect .bss
 577 .sect .text
 578
 579 ! 16-bit signed division
 580 ! parameters:
 581 !   bc: divisor
 582 !   de: dividend
 583 !   de: result (out)
 584 ! no check on overflow
 585
 586
 587
 588 .dvi2:
 589         xor     a
 590         ld      h,a
 591         ld      l,a
 592         sbc     hl,bc
 593         jp      m,1f
 594         ld      b,h
 595         ld      c,l
 596         cpl
 597 1:
 598         or      a
 599         ld      hl,0
 600         sbc     hl,de
 601         jp      m,1f
 602         ex      de,hl
 603         cpl
 604 1:
 605         push    af
 606         ld      hl,0
 607         ld      a,16
 608 0:
 609         add     hl,hl
 610         ex      de,hl
 611         add     hl,hl
 612         ex      de,hl
 613         jr      nc,1f
 614         inc     hl
 615         or      a
 616 1:
 617         sbc     hl,bc
 618         inc     de
 619         jp      p,2f
 620         add     hl,bc
 621         dec     de
 622 2:
 623         dec     a
 624         jr      nz,0b
 625         pop     af
 626         or      a
 627         jr      z,1f
 628         ld      hl,0
 629         sbc     hl,de
 630         ex      de,hl
 631 1:
 632         ret
 633 dvi4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0%\ 4.define .dvi4
 634 .sect .text
 635 .sect .rom
 636 .sect .data
 637 .sect .bss
 638 .sect .text
 639
 640 ! 4-byte divide routine for z80
 641 ! parameters:
 642 !    stack: divisor
 643 !           dividend
 644 !    stack: quotient (out)
 645 !    bc de: remainder (out)  (high part in bc)
 646
 647
 648
 649 .dvi4:
 650         pop hl
 651         ld (retaddr),hl
 652         xor a
 653         ld (.flag1),a
 654         ld (.flag2),a
 655         ld ix,0
 656         add ix,sp
 657         ld b,(ix+7)             ! dividend
 658         bit 7,b
 659         jr z,1f
 660         ld c,(ix+6)
 661         ld d,(ix+5)
 662         ld e,(ix+4)
 663         call .negbd
 664         ld (ix+7),b
 665         ld (ix+6),c
 666         ld (ix+5),d
 667         ld (ix+4),e
 668         ld a,1
 669         ld (.flag1),a
 670 1:
 671         ld b,(ix+3)
 672         bit 7,b
 673         jr z,2f
 674         call .negst
 675         ld a,1
 676         ld (.flag2),a
 677 2:
 678         call .dvu4
 679         ld a,(.flag1)
 680         or a
 681         jr z,3f
 682         call .negbd
 683 3:
 684         ld (.savebc),bc
 685         ld (.savede),de
 686         ld a,(.flag2)
 687         ld b,a
 688         ld a,(.flag1)
 689         xor b
 690         jr z,4f
 691         call .negst
 692 4:
 693         ld bc,(.savebc)
 694         ld de,(.savede)
 695         ld hl,(retaddr)
 696         jp (hl)
 697 .negbd:
 698         xor a
 699         ld h,a
 700         ld l,a
 701         sbc hl,de
 702         ex de,hl
 703         ld h,a
 704         ld l,a
 705         sbc hl,bc
 706         ld b,h
 707         ld c,l
 708         ret
 709 .negst:
 710         pop ix
 711         pop de
 712         pop bc
 713         call .negbd
 714         push bc
 715         push de
 716         jp (ix)
 717 .sect .data
 718         .flag1: .data1 0
 719         .flag2: .data1 0
 720         retaddr:.data2 0
 721         .savebc: .data2 0
 722         .savede: .data2 0
 723 edvu2.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .dvu2
 724 .sect .text
 725 .sect .rom
 726 .sect .data
 727 .sect .bss
 728 .sect .text
 729
 730 ! 16-bit divide
 731 ! parameters:
 732 !    bc: divisor
 733 !    de: dividend
 734 !    de: quotient (out)
 735 !    hl: remainder (out)
 736 ! no overflow detection
 737
 738
 739
 740 .dvu2:
 741         or a
 742         ld h,d
 743         ld l,e
 744         sbc hl,bc
 745         jp m,3f
 746         jp c,3f ! bc > de?
 747         ld hl,0
 748         ld a,16
 749 0:
 750         add hl,hl
 751         ex de,hl
 752         add hl,hl
 753         ex de,hl
 754         jr nc,1f
 755         inc hl
 756         or a
 757 1:
 758         sbc hl,bc
 759         inc de
 760         jp p,2f
 761         add hl,bc
 762         dec de
 763 2:
 764         dec a
 765         jr nz,0b
 766         ret
 767 3:
 768         ld hl,0
 769         ex de,hl
 770         ret
 771 dvu4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\f.define .dvu4
 772 .sect .text
 773 .sect .rom
 774 .sect .data
 775 .sect .bss
 776 .sect .text
 777
 778 ! 4-byte divide routine for z80
 779 ! parameters:
 780 !    stack: divisor
 781 !           dividend
 782 !    stack: quotient (out)
 783 !    bc de: remainder (out)  (high part in bc)
 784
 785
 786
 787 ! a n-byte divide may be implemented
 788 ! using 2 (virtual) registers:
 789 !  - a n-byte register containing
 790 !    the divisor
 791 !  - a 2n-byte shiftregister (VSR)
 792 !
 793 ! Initially, the VSR contains the dividend
 794 ! in its low (right) n bytes and zeroes in its
 795 ! high n bytes. The dividend is shifted
 796 ! left into a "window" bit by bit. After
 797 ! each shift, the contents of the window
 798 ! is compared with the divisor. If it is
 799 ! higher or equal, the divisor is subtracted from
 800 ! it and a "1" bit is inserted in the
 801 ! VSR from the right side! else a "0" bit
 802 ! is inserted. These bits are shifted left
 803 ! too during subsequent iterations.
 804 ! At the end, the rightmost part of VSR
 805 ! contains the quotient.
 806 ! For n=4, we need 2*4+4 = 12 bytes of
 807 ! registers. Unfortunately we only have
 808 ! 5 2-byte registers on the z80
 809 ! (bc,de,hl,ix and iy). Therefore we use
 810 ! an overlay technique for the rightmost
 811 ! 4 bytes of the VSR. The 32 iterations
 812 ! are split up into two groups: during
 813 ! the first 16 iterations we use the high
 814 ! order 16 bits of the dividend! during
 815 ! the last 16 iterations we use the
 816 ! low order 16 bits.
 817 ! register allocation:
 818 !   VSR        iy hl ix
 819 !   divisor   -de bc
 820 .dvu4:
 821         ! initialization
 822         pop hl          ! save return address
 823         ld (.retaddr),hl
 824         pop bc          ! low part (2 bytes)
 825                         ! of divisor in bc
 826         xor a           ! clear carry, a := 0
 827         ld h,a          ! hl := 0
 828         ld l,a
 829         ld (.flag),a    ! first pass main loop
 830         pop de          ! high part divisor
 831         sbc hl,de       ! inverse of high part
 832         ex de,hl        ! of divisor in de
 833         pop hl          ! save low part of
 834                         ! dividend in memory
 835         ld (.low),hl    ! used during second
 836                         ! iteration over main loop
 837         pop ix          ! high part of dividend
 838         push iy         ! save LB
 839         ld h,a          ! hl := 0
 840         ld l,a
 841         ld iy,0         ! now the VSR is initialized
 842
 843         ! main loop, done twice
 844 1:
 845         ld a,16
 846         ! sub-loop, done 16 times
 847 2:
 848         add iy,iy       ! shift VSR left
 849         add ix,ix
 850         adc hl,hl
 851         jp nc,3f
 852         inc iy
 853 3:
 854         or a            ! subtract divisor from
 855                         ! window (iy hl)
 856         ld (.iysave),iy
 857         sbc hl,bc
 858         jr nc,4f        ! decrement iy if there
 859                         ! was no borrow
 860         dec iy
 861 4:
 862         add iy,de       ! there is no "sbc iy,ss"
 863                         ! on the z80, so de was
 864                         ! inverted during init.
 865         inc ix
 866         ! see if the result is non-negative,
 867         ! otherwise undo the subtract.
 868         ! note that this uncooperating machine
 869         ! does not set its S -or Z flag after
 870         ! a 16-bit add.
 871         ex (sp),iy      ! does anyone see a better
 872         ex (sp),hl      ! solution ???
 873         bit 7,h
 874         ex (sp),hl
 875         ex (sp),iy
 876         jp z,5f
 877         ! undo the subtract
 878         add hl,bc
 879         ld iy,(.iysave)
 880         dec ix
 881 5:
 882         dec a
 883         jr nz,2b
 884         ld a,(.flag)    ! see if this was first or
 885                         ! second iteration of main loop
 886         or a            ! 0=first, 1=second
 887         jr nz,6f
 888         inc a           ! a := 1
 889         ld (.flag),a    ! flag := 1
 890         ld (.result),ix ! save high part of result
 891         ld ix,(.low)    ! initialize second
 892                         ! iteration, ix := low
 893                         ! part of dividend
 894         jr 1b
 895 6:
 896         ! clean up
 897         push iy         ! transfer remainder
 898         pop bc          ! from iy-hl to bc-de
 899         ex de,hl
 900         pop iy          ! restore LB
 901         ld hl,(.result) ! high part of result
 902         push hl
 903         push ix         ! low part of result
 904         ld hl,(.retaddr)
 905         jp (hl)         ! return
 906
 907 .sect .data
 908 .flag:          .data1 0
 909 .low:           .data2 0
 910 .iysave:        .data2 0
 911 .retaddr:       .data2 0
 912 .result:        .data2 0
 913 exg.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\r\ 1.define .exg
 914 .sect .text
 915 .sect .rom
 916 .sect .data
 917 .sect .bss
 918 .sect .text
 919 .exg:
 920         pop ix
 921         pop de
 922         ld hl,0
 923         add hl,sp
 924         ld b,h
 925         ld c,l
 926         add hl,de
 927 1:
 928         ld a,(bc)
 929         ex af,af2
 930         ld a,(hl)
 931         ld (bc),a
 932         ex af,af2
 933         ld (hl),a
 934         inc bc
 935         inc hl
 936         dec de
 937         ld a,d
 938         or e
 939         jr nz,1b
 940         jp (ix)
 941
 942
 943  gto.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\1d\ 1.define .gto
 944 .sect .text
 945 .sect .rom
 946 .sect .data
 947 .sect .bss
 948 .sect .text
 949
 950 .gto:
 951         ld e,(hl)
 952         inc hl
 953         ld d,(hl)
 954         push de
 955         pop ix          ! new pc
 956         inc hl
 957         ld e,(hl)
 958         inc hl
 959         ld d,(hl)       ! new sp
 960         inc hl
 961         ld c,(hl)
 962         inc hl
 963         ld b,(hl)       ! new lb
 964         push bc
 965         pop iy
 966         push de
 967         pop hl
 968         ld sp,hl
 969         jp (ix)
 970 lhulp.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.sect .text
 971 .sect .rom
 972 .sect .data
 973 .sect .bss
 974 .sect .text
 975 loop = 100
 976 dvi4:
 977         xor a
 978         ld (.flag1),a
 979         ld (.flag2),a
 980         ld ix,0
 981         add ix,sp
 982         ld b,(ix+7)             ! dividend
 983         bit 7,b
 984         jr z,1f
 985         ld c,(ix+6)
 986         ld d,(ix+5)
 987         ld e,(ix+4)
 988         call .negbd
 989         ld (ix+7),d
 990         ld (ix+6),e
 991         ld (ix+5),h
 992         ld (ix+4),l
 993         ld a,1
 994         ld (.flag1),a
 995 1:
 996         ld b,(ix+3)
 997         bit 7,b
 998         jr z,2f
 999         call .negst
1000         ld a,1
1001         ld (.flag2),a
1002 2:
1003         call .dvu4
1004         ld a,(.flag1)
1005         jr z,3f
1006         call .negbd
1007 3:
1008         ld a,(.flag2)
1009         ld b,a
1010         ld a,(.flag1)
1011         xor b
1012         jr z,4f
1013         call .negst
1014 4:
1015         jr loop
1016 .negbd:
1017         xor a
1018         ld h,a
1019         ld l,a
1020         sbc hl,de
1021         ex de,hl
1022         ld h,a
1023         ld l,a
1024         sbc hl,bc
1025         ret
1026 .negst:
1027         pop iy
1028         pop de
1029         pop bc
1030         call .negbd
1031         push hl
1032         push de
1033         jp (iy)
1034 .sect .data
1035         .flag1: .data1 0
1036         .flag2: .data1 0
1037 ior.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0}\ 1.define .ior
1038 .sect .text
1039 .sect .rom
1040 .sect .data
1041 .sect .bss
1042 .sect .text
1043
1044 ! auxiliary size 'ior'
1045 ! parameters:
1046 !    de: size
1047 !    stack: operands
1048 !    stack: result (out)
1049
1050
1051
1052 .ior:
1053         pop ix
1054         ld h,d
1055         ld l,e
1056         add hl,sp
1057         ld b,h
1058         ld c,l
1059         ex de,hl
1060         add hl,de
1061 1:      dec hl
1062         dec de
1063         ld a,(de)
1064         or (hl)
1065         ld (hl),a
1066         xor a
1067         sbc hl,bc
1068         jr z,2f
1069         add hl,bc
1070         jr 1b
1071 2:      ld h,b
1072         ld l,c
1073         ld sp,hl
1074         jp (ix)
1075 .laru.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define .laru
1076 .sect .text
1077 .sect .rom
1078 .sect .data
1079 .sect .bss
1080 .sect .text
1081
1082 ! LAR NOT DEFINED
1083
1084 .laru:
1085         pop ix
1086         pop hl
1087         xor a
1088         xor h
1089         jp nz,1f
1090         ld a,2
1091         xor l
1092         jp z,2f
1093 1:
1094         ld hl,EARRAY
1095         call .trp.z
1096 2:
1097         push ix
1098         jp .lar
1099 lar.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define .lar
1100 .sect .text
1101 .sect .rom
1102 .sect .data
1103 .sect .bss
1104 .sect .text
1105 ! use .mli2
1106
1107 ! 2-byte descriptor elements
1108 ! any size array elements
1109 ! parameters:
1110 !    on stack
1111 ! uses .mli2
1112 ! no range checking
1113 ! adapted from .aar and .los
1114
1115
1116
1117 .lar:
1118         pop hl
1119         pop ix
1120         ex (sp),hl
1121         ld c,(ix+0)
1122         ld b,(ix+1)
1123         xor a
1124         sbc hl,bc
1125         ld c,(ix+4)
1126         ld b,(ix+5)
1127         ex de,hl
1128         call .mli2
1129         pop ix
1130         pop de
1131         add hl,de       ! address of array element
1132         add hl,bc
1133         dec hl          ! pointer to highest byte of element
1134         srl b
1135         rr c
1136         jr nc,1f
1137         ld a,c          ! skip check to save runtime
1138         or b
1139         jr nz,.trp.z    ! size was odd but <> 1
1140         ld c,(hl)
1141         push bc
1142         jp (ix)
1143 1:      ld d,(hl)
1144         dec hl
1145         ld e,(hl)
1146         dec hl
1147         push de
1148         dec bc
1149         ld a,b
1150         or c
1151         jr nz,1b
1152         jp (ix)
1153 .lar2.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\8a\ 1.define .lar2
1154 .sect .text
1155 .sect .rom
1156 .sect .data
1157 .sect .bss
1158 .sect .text
1159
1160 ! special case lar: element size = 2 (statically known)
1161 ! parameters:
1162 !   on stack
1163 ! adapted from .aar2
1164 ! execution time: 144 states
1165
1166
1167
1168 .lar2:
1169         pop ix
1170         pop hl
1171         ld c,(hl)
1172         inc hl
1173         ld b,(hl)
1174         pop hl
1175         xor a
1176         sbc hl,bc
1177         add hl,hl       ! size*(index-lwb)
1178         pop de
1179         add hl,de       ! + base
1180         ld e,(hl)
1181         inc hl
1182         ld d,(hl)
1183         push de
1184         jp (ix)
1185 los.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0_\ 2.define .los
1186 .sect .text
1187 .sect .rom
1188 .sect .data
1189 .sect .bss
1190 .sect .text
1191
1192
1193
1194 .los:
1195         pop ix          ! save return address
1196         pop de          ! number of bytes to transfer
1197         pop hl          ! address of lowest byte
1198         add hl,de
1199         dec hl          ! address of highest byte
1200         srl d           ! divide de by 2
1201         rr e
1202         jr nc,1f        ! see if de was odd
1203         ld a,e          ! yes, then it must be 1
1204         or d
1205         jr nz,.trp.z    ! no, error
1206         ld e,(hl)       ! pack 1 byte into integer
1207         push de
1208         jp (ix)         ! return
1209 1:
1210         ld b,(hl)       ! get 2 bytes
1211         dec hl
1212         ld c,(hl)
1213         dec hl
1214         push bc         ! put them on stack, most
1215                         ! significant byte first
1216         dec de
1217         ld a,d
1218         or e
1219         jr nz,1b        ! done ?
1220         jp (ix)         ! yes, return
1221 dmli2.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0m\ 1.define .mli2
1222 .sect .text
1223 .sect .rom
1224 .sect .data
1225 .sect .bss
1226 .sect .text
1227
1228 ! 16 bit multiply
1229 ! parameters:
1230 !   bc: multiplicand
1231 !   de: multiplier
1232 !   hl: result (out)
1233 ! multiplier (bc) is left unchanged
1234 ! no detection of overflow
1235
1236
1237
1238 .mli2:
1239         ld hl,0
1240         ld a,16
1241 0:
1242         bit 7,d
1243         jr z,1f
1244         add hl,bc
1245 1:
1246         dec a
1247         jr z,2f
1248         ex de,hl
1249         add hl,hl
1250         ex de,hl
1251         add hl,hl
1252         jr 0b
1253 2:
1254         ret
1255 lmli4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 6.define .mli4
1256 .sect .text
1257 .sect .rom
1258 .sect .data
1259 .sect .bss
1260 .sect .text
1261
1262 ! 32-bit multiply routine for z80
1263 ! parameters:
1264 !   on stack
1265
1266
1267
1268 ! register utilization:
1269 !   ix: least significant 2 bytes of result
1270 !   hl: most  significant 2 bytes of result
1271 !   bc: least significant 2 bytes of multiplicand
1272 !   de: most  significant 2 bytes of multiplicand
1273 !   iy: 2 bytes of multiplier (first most significant,
1274 !       later least significant)
1275 !   a:  bit count
1276 .mli4:
1277         !initialization
1278         pop hl          ! return address
1279         pop de
1280         ld (.mplier+2),de! least significant bytes of
1281                         ! multiplier
1282         pop de
1283         ld (.mplier),de ! most sign. bytes
1284         pop de          ! least significant bytes of
1285                         ! multiplicand
1286         pop bc          ! most sign. bytes
1287         push hl         ! return address
1288         push iy         ! LB
1289         ld ix,0
1290         xor a
1291         ld h,a          ! clear result
1292         ld l,a
1293         ld (.flag),a    ! indicate that this is
1294                         ! first pass of main loop
1295         ld iy,(.mplier)
1296         ! main loop, done twice, once for each part (2 bytes)
1297         ! of multiplier
1298 1:
1299         ld a,16
1300         ! sub-loop, done 16 times
1301 2:
1302         add iy,iy       ! shift left multiplier
1303         jr nc,3f        ! skip if most sign. bit is 0
1304         add ix,de       ! 32-bit add
1305         adc hl,bc
1306 3:
1307         dec a
1308         jr z,4f         ! done with this part of multiplier
1309         add ix,ix       ! 32-bit shift left
1310         adc hl,hl
1311         jr 2b
1312 4:
1313         ! see if we have just processed the first part
1314         ! of the multiplier (flag = 0) or the second
1315         ! part (flag = 1)
1316         ld a,(.flag)
1317         or a
1318         jr nz,5f
1319         inc a           ! a := 1
1320         ld (.flag),a    ! set flag
1321         ld iy,(.mplier+2)! least significant 2 bytes now in iy
1322         add ix,ix       ! 32-bit shift left
1323         adc hl,hl
1324         jr 1b
1325 5:
1326         ! clean up
1327         pop iy          ! restore LB
1328         ex (sp),hl      ! put most sign. 2 bytes of result
1329                         ! on stack!  put return address in hl
1330         push ix         ! least sign. 2 bytes of result
1331         jp (hl)         ! return
1332 .sect .data
1333 .flag:  .data1 0
1334 .mplier: .space 4
1335 rrck.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .rck
1336 .sect .text
1337 .sect .rom
1338 .sect .data
1339 .sect .bss
1340 .sect .text
1341 .rck:
1342         pop bc
1343         pop ix
1344 3:      pop hl
1345         push hl
1346         ld e,(ix)
1347         ld d,(ix+1)
1348         ld a,h
1349         xor d           ! check sign bit to catch overflow with subtract
1350         jp m,1f
1351         sbc hl,de
1352         jr 2f
1353 1:      xor d           ! now a equals (original) h again
1354 2:      call m,e.rck
1355         pop de
1356         push de
1357         ld l,(ix+2)
1358         ld h,(ix+3)
1359         ld a,h
1360         xor d           ! check sign bit to catch overflow with subtract
1361         jp m,1f
1362         sbc hl,de
1363         jr 2f
1364 1:      xor d           ! now a equals (original) h again
1365 2:      call m,e.rck
1366         push bc
1367         pop ix
1368         jp (ix)
1369
1370
1371 (rmi2.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0(\ 2.define .rmi2
1372 .sect .text
1373 .sect .rom
1374 .sect .data
1375 .sect .bss
1376 .sect .text
1377
1378 ! 16-bit signed remainder
1379 ! parameters:
1380 !   bc: divisor
1381 !   de: dividend
1382 !   de: result (out)
1383 ! no check on overflow
1384
1385
1386
1387 .rmi2:
1388         xor     a
1389         ld      h,a
1390         ld      l,a
1391         sbc     hl,bc
1392         jp      m,1f
1393         ld      b,h
1394         ld      c,l
1395 1:
1396         or      a
1397         ld      hl,0
1398         sbc     hl,de
1399         jp      m,1f
1400         ex      de,hl
1401         cpl
1402 1:
1403         push    af
1404         ld      hl,0
1405         ld      a,16
1406 0:
1407         add     hl,hl
1408         ex      de,hl
1409         add     hl,hl
1410         ex      de,hl
1411         jr      nc,1f
1412         inc     hl
1413         or      a
1414 1:
1415         sbc     hl,bc
1416         inc     de
1417         jp      p,2f
1418         add     hl,bc
1419         dec     de
1420 2:
1421         dec     a
1422         jr      nz,0b
1423         ex      de,hl
1424         pop     af
1425         or      a
1426         jr      z,1f
1427         ld      hl,0
1428         sbc     hl,de
1429         ex      de,hl
1430 1:
1431         ret
1432 saru.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define .saru
1433 .sect .text
1434 .sect .rom
1435 .sect .data
1436 .sect .bss
1437 .sect .text
1438
1439 ! SAR NOT DEFINED
1440
1441 .saru:
1442         pop ix
1443         pop hl
1444         xor a
1445         xor h
1446         jp nz,1f
1447         ld a,2
1448         xor l
1449         jp z,2f
1450 1:
1451         ld hl,EARRAY
1452         call .trp.z
1453 2:
1454         push ix
1455         jp .sar
1456 sar.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0O\ 2.define .sar
1457 .sect .text
1458 .sect .rom
1459 .sect .data
1460 .sect .bss
1461 .sect .text
1462 ! use .mli2
1463 ! use .trp.z
1464
1465 ! 2-byte descriptors
1466 ! any size array elements
1467 ! parameters:
1468 !    on stack
1469 ! uses .mli2
1470 ! adapted from .aar and .sts
1471
1472
1473
1474 .sar:
1475         pop hl
1476         pop ix
1477         ex (sp),hl
1478         ld c,(ix+0)
1479         ld b,(ix+1)
1480         xor a
1481         sbc hl,bc
1482         ld c,(ix+4)
1483         ld b,(ix+5)
1484         ex de,hl
1485         call .mli2
1486         pop ix
1487         pop de
1488         add hl,de
1489         srl b           ! bc contains #bytes to transfer
1490         rr c            ! divide bc by 2
1491         jr nc,1f
1492         ld a,c
1493         or b
1494         jr nz,.trp.z
1495         pop bc
1496         ld (hl),c
1497         jp (ix)
1498 1:
1499         pop de
1500         ld (hl),e
1501         inc hl
1502         ld (hl),d
1503         inc hl
1504         dec bc
1505         ld a,b
1506         or c
1507         jr nz,1b
1508         jp (ix)
1509 ,sar2.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0m\ 1.define .sar2
1510 .sect .text
1511 .sect .rom
1512 .sect .data
1513 .sect .bss
1514 .sect .text
1515
1516 ! special case sar: element size = 2 (statically known)
1517 ! parameters:
1518 !   on stack
1519 ! adapted from .aar2
1520 ! execution time: 143 states
1521
1522
1523
1524 .sar2:
1525         pop ix
1526         pop hl
1527         ld c,(hl)
1528         inc hl
1529         ld b,(hl)
1530         pop hl
1531         xor a
1532         sbc hl,bc
1533         add hl,hl
1534         pop de
1535         add hl,de
1536         pop de
1537         ld (hl),e
1538         inc hl
1539         ld (hl),d
1540         jp (ix)
1541 lsdf.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\1f\ 1.define .sdf
1542 .sect .text
1543 .sect .rom
1544 .sect .data
1545 .sect .bss
1546 .sect .text
1547
1548 ! store double offsetted
1549
1550 .sdf:
1551         pop bc
1552         push bc         !test
1553         pop ix          ! return address
1554         pop hl          ! address
1555         add hl,de
1556         pop bc
1557         ld (hl),c
1558         inc hl
1559         ld (hl),b
1560         inc hl
1561         pop bc
1562         ld (hl),c
1563         inc hl
1564         ld (hl),b
1565         jp (ix)         ! return
1566
1567 sdl.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .sdl
1568 .sect .text
1569 .sect .rom
1570 .sect .data
1571 .sect .bss
1572 .sect .text
1573
1574 ! store double local at any offset
1575 ! parameters:
1576 !    hl: offset
1577 !    stack: operand (4 bytes)
1578
1579
1580
1581 .sdl:
1582         pop ix          ! return address
1583         push iy         ! bc := LB
1584         pop bc
1585         add hl,bc       ! pointer to lowest byte
1586                         ! of local
1587         pop bc          ! low 2 bytes of source
1588         ld (hl),c
1589         inc hl
1590         ld (hl),b
1591         inc hl
1592         pop bc          ! high 2 bytes of source
1593         ld (hl),c
1594         inc hl
1595         ld (hl),b
1596         jp (ix)         ! return
1597
1598 set.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .set
1599 .sect .text
1600 .sect .rom
1601 .sect .data
1602 .sect .bss
1603 .sect .text
1604 ! use .unimpld
1605
1606 ! any size sets
1607 ! parameters:
1608 !   hl:    size
1609 !   stack: bitnumber
1610 !   stack: result (out)
1611
1612
1613
1614 .set:
1615         pop ix          ! return address
1616         pop de          ! bit number
1617         ld b,h
1618         ld c,l
1619         xor a
1620 0:      push af
1621         inc sp
1622         dec c
1623         jr nz,0b
1624         dec b
1625         jp p,0b
1626         ex de,hl
1627         ld a,l
1628         sra h
1629         jp m,.unimpld
1630         rr l
1631         srl h
1632         rr l
1633         srl h
1634         rr l
1635         push hl
1636         or a
1637         sbc hl,de
1638         pop hl
1639         jp p,.unimpld
1640         add hl,sp
1641         ld (hl),1
1642         and 7
1643         jr 1f
1644 0:      sla (hl)
1645         dec a
1646 1:      jr nz,0b
1647         jp (ix)
1648 pstr.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define .strhp
1649 .sect .text
1650 .sect .rom
1651 .sect .data
1652 .sect .bss
1653 .sect .text
1654
1655 .strhp:
1656         pop ix
1657         pop hl
1658         push hl
1659         or a
1660         sbc hl,sp
1661         jp m,1f
1662         pop hl
1663         push hl
1664         ld a,l
1665         rra
1666         jp c,1f
1667         pop hl
1668         ld (.reghp),hl
1669         jp (ix)
1670 1:
1671         pop hl
1672         ld hl,EHEAP
1673         call .trp.z
1674         jp (ix)
1675         sts.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0V\ 2.define .sts
1676 .sect .text
1677 .sect .rom
1678 .sect .data
1679 .sect .bss
1680 .sect .text
1681 ! use trp.z
1682
1683 ! object size given by 2-byte integer on
1684 ! top of stack.
1685 ! parameters:
1686 !   on stack
1687 ! checks if #bytes is even or 1,
1688 ! else traps
1689
1690
1691
1692 .sts:
1693         pop ix          ! save return address
1694         pop de          ! # bytes to transfer
1695         pop hl          ! destination address
1696         srl d           ! divide de by 2
1697         rr e
1698         jr nc,1f        ! see if it was odd
1699         ld a,e          ! yes, must be 1
1700         or d
1701         jr nz,.trp.z    ! no, error
1702         pop de          ! transfer 1 byte,
1703                         ! padded with zeroes
1704         ld (hl),e
1705         jp (ix)
1706 1:
1707         pop bc
1708         ld (hl), c
1709         inc hl
1710         ld (hl),b
1711         inc hl
1712         dec de
1713         ld a,e
1714         or d
1715         jr nz,1b
1716         jp (ix)
1717 unim.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0b\ 1.define unimpld, e.mon, e.rck, .trp.z, .unimpld
1718 .sect .text
1719 .sect .rom
1720 .sect .data
1721 .sect .bss
1722 .sect .text
1723
1724 .unimpld:
1725 unimpld:                ! used in dispatch table to
1726                         ! catch unimplemented instructions
1727         ld hl,EILLINS
1728 9:      push hl
1729         call .trp.z
1730         ret
1731
1732 e.mon:
1733         ld hl,EMON
1734         jr 9b
1735 e.rck:
1736         push af
1737         ld a,(ignmask)
1738         bit 1,a
1739         jr nz,8f
1740         ld hl,ERANGE
1741         jr 9b
1742 8:
1743         pop af
1744         ret
1745
1746
1747 trp.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define .trp.z
1748 .sect .text
1749 .sect .rom
1750 .sect .data
1751 .sect .bss
1752 .sect .text
1753
1754 ! changed into output routine to print errornumber
1755
1756 .trp.z:
1757 !       exx
1758         pop bc
1759         pop hl          !error number
1760         push hl
1761         ld de,15
1762         sbc hl,de
1763         jp p,1f         ! error no >= 16?
1764         pop hl
1765         push hl         ! save error no on stack
1766         push bc
1767         push ix
1768         push hl         ! test bit "error no" of ignmask
1769         ld hl,(ignmask)
1770         ex (sp),hl
1771         push hl
1772         ld hl,2
1773         call .inn
1774         pop hl
1775         pop ix
1776         pop bc
1777         ld a,h
1778         or l
1779         jr z,2f                 ! if bit <> 0 error
1780 1:
1781         pop hl
1782         push iy
1783         push de
1784         ld iy,1f+6
1785         call outdec
1786         ld iy,13
1787         push iy
1788         ld iy,1f
1789         push iy
1790         ld iy,2
1791         push iy
1792         call WRITE
1793         pop iy
1794         pop iy
1795         pop iy
1796         pop de
1797         pop iy
1798         push de
1799         jp EXIT
1800 2:
1801         pop hl
1802         push bc
1803 !       exx
1804         ret
1805 1:      .asciz 'error xxxxx\r\n'
1806
1807 inn.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\ 3\ 2.define .inn
1808 .sect .text
1809 .sect .rom
1810 .sect .data
1811 .sect .bss
1812 .sect .text
1813 ! use .unimpld
1814
1815 ! any size sets
1816 ! parameters:
1817 !   hl:    size
1818 !   stack: bit number
1819 !   stack: result (out)
1820
1821
1822
1823 .inn:
1824         pop ix
1825         pop de
1826         add hl,sp
1827         ld b,h
1828         ld c,l
1829         ex de,hl
1830         ld a,l
1831         sra h
1832         jp m,0f
1833         rr l
1834         sra h
1835         rr l
1836         sra h
1837         rr l
1838         add hl,sp
1839         push hl
1840         or a            ! clear carry
1841         sbc hl,de
1842         pop hl
1843         jp m,1f
1844 0:      xor a
1845         jr 4f
1846 1:      ld e,(hl)
1847         and 7
1848         jr 2f
1849 3:      rrc e
1850         dec a
1851 2:      jr nz,3b
1852         ld a,e
1853         and 1
1854 4:
1855         ld e,a
1856         ld d,0
1857         ld h,b
1858         ld l,c
1859         ld sp,hl
1860         push de
1861         jp (ix)
1862 lxor.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0~\ 1.define .xor
1863 .sect .text
1864 .sect .rom
1865 .sect .data
1866 .sect .bss
1867 .sect .text
1868
1869 ! auxiliary size 'xor'
1870 ! parameters:
1871 !    de: size
1872 !    stack: operands
1873 !    stack: result (out)
1874
1875
1876
1877 .xor:
1878         pop ix
1879         ld h,d
1880         ld l,e
1881         add hl,sp
1882         ld b,h
1883         ld c,l
1884         ex de,hl
1885         add hl,de
1886 1:      dec hl
1887         dec de
1888         ld a,(de)
1889         xor (hl)
1890         ld (hl),a
1891         xor a
1892         sbc hl,bc
1893         jr z,2f
1894         add hl,bc
1895         jr 1b
1896 2:      ld h,b
1897         ld l,c
1898         ld sp,hl
1899         jp (ix)
1900 nop.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\0\ 2.define .nop
1901 .sect .text
1902 .sect .rom
1903 .sect .data
1904 .sect .bss
1905 .sect .text
1906
1907
1908
1909 ! NOP
1910 ! changed into output routine to print linenumber
1911 ! in octal (6 digits)
1912
1913 .nop:
1914         push iy
1915         ld iy,1f+5
1916         ld hl,(hol0)
1917         call outdec
1918         ld iy,1f+18
1919         ld hl,0
1920         add hl,sp
1921         call octnr
1922         ld de,20
1923         push de
1924         ld de,1f
1925         push de
1926         ld de,1
1927         push de
1928         call WRITE
1929         pop de
1930         pop de
1931         pop de
1932         pop iy
1933         ret
1934 1:      .asciz 'test xxxxx 0xxxxxx\r\n'
1935
1936 octnr:
1937         ld b,6
1938 1:      ld a,7
1939         and l
1940         add a,'0'
1941         dec iy
1942         ld (iy+0),a
1943         srl h
1944         rr l
1945         srl h
1946         rr l
1947         srl h
1948         rr l
1949         djnz 1b
1950         ret
1951
1952
1953 outdec.s\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define outdec
1954 .sect .text
1955 .sect .rom
1956 .sect .data
1957 .sect .bss
1958 .sect .text
1959 ! output contents of HL as a sequence
1960 ! of decimal digits
1961 outdec:
1962         push    hl
1963         push    de
1964         push    bc
1965         push    af
1966         ld      de,table
1967         ld      b,4
1968 1:      call    convert
1969         or      0x30
1970         ld (iy+0),a
1971         inc iy
1972         djnz    1b
1973         ld      a,l
1974         or      0x30
1975         ld (iy+0),a
1976         pop     af
1977         pop     bc
1978         pop     de
1979         pop     hl
1980         ret
1981 ! convert returns in a a count
1982 ! hl is decremented count times by (de)
1983 ! as a usefull side effect de is incremented
1984 ! by 2
1985 convert:
1986         push    bc
1987         ld      b,h
1988         ld      c,l
1989         ex      de,hl
1990         ld      e,(hl)
1991         inc     hl
1992         ld      d,(hl)
1993         inc     hl
1994         push    hl      ! save pointer to new value
1995         ld      h,b
1996         ld      l,c
1997         xor     a
1998 1:      inc     a
1999         sbc     hl,de
2000         jr      nc,1b
2001         add     hl,de
2002         dec     a
2003         pop     de
2004         pop     bc
2005         ret
2006 table:
2007         .data2  10000
2008         .data2  1000
2009         .data2  100
2010         .data2  10
2011  ret.s\0.s\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define .ret
2012 .define .lfr
2013
2014 .sect .text
2015 .sect .rom
2016 .sect .data
2017 .sect .bss
2018
2019 ! 'ret' and 'lfr' for sizes > 4 (and <= 8)
2020
2021 retarea: .space 8
2022
2023 .sect .text
2024
2025 .ret:
2026 ! parameters:
2027 !       de: size in bytes
2028 !       stack: return value
2029
2030         pop ix          ! save return address
2031         ld hl,retarea
2032         srl d
2033         rr e            ! divide size by 2
2034 1:
2035         pop bc
2036         ld (hl), c
2037         inc hl
2038         ld (hl), b
2039         inc hl
2040         dec de
2041         ld a,d
2042         or e
2043         jr nz,1b        ! done?
2044         jp (ix)         ! yes, return
2045
2046 .lfr:
2047 ! parameters:
2048 !       de: size in bytes
2049 !       result on stack: return value
2050
2051         pop ix          ! save return address
2052         ld hl,retarea
2053         add hl,de
2054         srl d
2055         rr e            ! divide size by 2
2056 1:
2057         dec hl
2058         ld b,(hl)
2059         dec hl
2060         ld c,(hl)
2061         push bc
2062         dec de
2063         ld a,d
2064         or e
2065         jr nz,1b        ! done?
2066         jp (ix)         ! yes, return
2067