mach/i80/libem/libem_s.a

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