sm2.asm

   1 page0   =       1
   2 page1   =       2
   3
   4         .area   SM (abs,ovr)
   5
   6 ; page 0 interpreter
   7 ; stack and control transfer
   8
   9         .org    page0 * 0x100
  10
  11         jp      start
  12
  13 page0_trace:
  14         jp      print_trace
  15
  16 page0_esc:
  17         ld      l,c
  18         ld      h,b
  19         jp      (hl)
  20
  21 page0_page1:
  22         pop     de
  23         ld      a,(bc)
  24         inc     bc
  25         ld      l,a
  26         inc     h ; page 1
  27         jp      (hl)
  28
  29 page0_imm_xchg_w:
  30         ld      a,(bc)
  31         inc     bc
  32         ld      l,a
  33         ld      a,(bc)
  34         inc     bc
  35         ld      h,a
  36         .db     0x3e ; ld a,
  37 page0_xchg_w:
  38         pop     hl
  39         ex      (sp),hl
  40         push    hl
  41         ld      a,(bc)
  42         inc     bc
  43         ld      l,a
  44         ld      h,page0
  45         jp      (hl)
  46
  47 imm_call:
  48         push    de
  49         dec     h ; page 0
  50 page0_imm_call:
  51         ld      a,(bc)
  52         inc     bc
  53         ld      l,a
  54         ld      a,(bc)
  55         inc     bc
  56         push    bc
  57         ld      b,a
  58         ld      c,l
  59         ld      a,(bc)
  60         inc     bc
  61         ld      l,a
  62         jp      (hl)
  63
  64 page0_call:
  65         pop     de
  66 _call:
  67         push    bc
  68         ld      c,e
  69         ld      b,d
  70         inc     bc
  71         ld      l,(hl)
  72         jp      (hl)
  73
  74 page0_imm_jfalse:
  75         jr      nc,page0_imm_jmp
  76 imm_not_taken:
  77         inc     bc
  78         inc     bc
  79         ld      a,(bc)
  80         inc     bc
  81         ld      l,a
  82         jp      (hl)
  83
  84 page0_imm_jtrue:
  85         jr      nc,imm_not_taken
  86 page0_imm_jmp:
  87         ld      a,(bc)
  88         inc     bc
  89         ld      l,a
  90         ld      a,(bc)
  91         ld      b,a
  92         ld      c,l
  93         ld      a,(bc)
  94         inc     bc
  95         ld      l,a
  96         jp      (hl)
  97
  98 page0_jfalse:
  99         jr      nc,page0_jmp
 100 not_taken:
 101         inc     sp
 102         inc     sp
 103         ld      a,(bc)
 104         inc     bc
 105         ld      l,a
 106         jp      (hl)
 107
 108 page0_jtrue:
 109         jr      nc,not_taken
 110 page0_jmp:
 111         pop     bc
 112         ld      a,(bc)
 113         inc     bc
 114         ld      l,a
 115         jp      (hl)
 116
 117         .org    page0 * 0x100 + 0x88
 118
 119 imm_stkptr:
 120         push    de
 121 page0_imm_stkptr:
 122         ld      a,(bc)
 123         inc     bc
 124         ld      l,a
 125         ld      a,(bc)
 126         inc     bc
 127         ld      h,a
 128         .db     0x3e ; ld a,
 129 page0_stkptr:
 130         pop     hl
 131 stkptr:
 132         add     hl,sp
 133         ex      de,hl
 134         ld      a,(bc)
 135         inc     bc
 136         ld      l,a
 137         ld      h,page1
 138         jp      (hl)
 139
 140 page0_ret:
 141         pop     bc
 142 page0_imm_stkadj:
 143 imm_stkadj:
 144         ld      a,(bc)
 145         inc     bc
 146         ld      l,a
 147         ld      a,(bc)
 148         inc     bc
 149         ld      h,a
 150         .db     0x3e ; ld a,
 151 page0_stkadj:
 152         pop     hl
 153 stkadj:
 154         add     hl,sp
 155         ld      sp,hl
 156         ld      a,(bc)
 157         inc     bc
 158         ld      l,a
 159         ld      h,page0
 160         jp      (hl)
 161
 162 imm_stkld_w:
 163         push    de
 164 page0_imm_stkld_w:
 165         ld      a,(bc)
 166         inc     bc
 167         ld      l,a
 168         ld      a,(bc)
 169         inc     bc
 170         ld      h,a
 171         .db     0x3e ; ld a,
 172 page0_stkld_w:
 173         pop     hl
 174 stkld_w:
 175         add     hl,sp
 176         ld      e,(hl)
 177         inc     hl
 178         ld      d,(hl)
 179         ld      a,(bc)
 180         inc     bc
 181         ld      l,a
 182         ld      h,page1
 183         jp      (hl)
 184
 185 page0_imm_xchg_stkst_w:
 186         pop     de
 187 imm_xchg_stkst_w:
 188         ld      a,(bc)
 189         inc     bc
 190         ld      l,a
 191         ld      a,(bc)
 192         inc     bc
 193         ld      h,a
 194 stkst_entry:
 195         add     hl,sp
 196         ld      (hl),e
 197         inc     hl
 198         ld      (hl),d
 199         ld      a,(bc)
 200         inc     bc
 201         ld      l,a
 202         ld      h,page0
 203         jp      (hl)
 204
 205 page0_stkst_w:
 206         pop     de
 207 stkst_w:
 208         pop     hl
 209 ;       add     hl,sp
 210 ;       ld      (hl),e
 211 ;       inc     hl
 212 ;       ld      (hl),d
 213 ;       ld      a,(bc)
 214 ;       inc     bc
 215 ;       ld      l,a
 216 ;       ld      h,page0
 217 ;       jp      (hl)
 218 ; the non-immediate stack load/store is hardly ever used and only for symmetry
 219         jr      stkst_entry
 220
 221 page0_imm_w:
 222         inc     h ; page1
 223 imm_w:
 224         ld      a,(bc)
 225         inc     bc
 226         ld      e,a
 227         ld      a,(bc)
 228         inc     bc
 229         ld      d,a
 230         ld      a,(bc)
 231         inc     bc
 232         ld      l,a
 233         jp      (hl)
 234
 235 page0_ld_w:
 236         pop     de
 237         inc     h ; page1
 238 ld_w:
 239         ld      a,(de)
 240         inc     de
 241         ld      l,a
 242         ld      a,(de)
 243         ld      d,a
 244         ld      e,l
 245         ld      a,(bc)
 246         inc     bc
 247         ld      l,a
 248         jp      (hl)
 249
 250 page0_imm_st_w:
 251         pop     de
 252 imm_st_w:
 253         ld      a,(bc)
 254         inc     bc
 255         ld      (de),a
 256         inc     de
 257         ld      a,(bc)
 258         inc     bc
 259         ld      (de),a
 260         ld      a,(bc)
 261         inc     bc
 262         ld      l,a
 263         jp      (hl)
 264
 265 page0_st_w:
 266         pop     de
 267 st_w:
 268         pop     hl
 269         ld      (hl),e
 270         inc     hl
 271         ld      (hl),d
 272         ld      a,(bc)
 273         inc     bc
 274         ld      l,a
 275         ld      h,page0
 276         jp      (hl)
 277
 278 ; page 1 interpreter
 279 ; word arithmetic operations
 280 ; top stack word cached in de
 281
 282         .org    page1 * 0x100
 283
 284 page1_imm_stkptr:
 285         jr      imm_stkptr
 286 page1_stkptr:
 287         ex      de,hl
 288         jr      stkptr
 289 page1_imm_stkadj:
 290         push    de
 291         jr      imm_stkadj
 292 page1_stkadj:
 293         ex      de,hl
 294         jr      stkadj
 295 page1_imm_stkld_w:
 296         jr      imm_stkld_w
 297 page1_stkld_w:
 298         ex      de,hl
 299         jr      stkld_w
 300 page1_imm_xchg_stkst_w:
 301         jr      imm_xchg_stkst_w
 302 page1_stkst_w:
 303         jr      stkst_w
 304 page1_imm_w:
 305         push    de
 306         jr      imm_w
 307 page1_ld_w:
 308         jr      ld_w
 309 page1_imm_st_w:
 310         dec     h ; page0
 311         jr      imm_st_w
 312 page1_st_w:
 313         jr      st_w
 314
 315 page1_page0:
 316         push    de
 317         ld      a,(bc)
 318         inc     bc
 319         ld      l,a
 320         dec     h ; page 0
 321         jp      (hl)
 322
 323 page1_imm_call:
 324         jp      imm_call
 325
 326 page1_call:
 327         dec     h ; page 0
 328         jp      _call
 329
 330 page1_imm_and_w:
 331         ld      a,(bc)
 332         inc     bc
 333         and     e
 334         ld      e,a
 335         ld      a,(bc)
 336         inc     bc
 337         and     d
 338         ld      d,a
 339         ld      a,(bc)
 340         inc     bc
 341         ld      l,a
 342         jp      (hl)
 343
 344 page1_and_w:
 345         pop     hl
 346         ld      a,e
 347         and     l
 348         ld      e,a
 349         ld      a,d
 350         and     h
 351         ld      d,a
 352         ld      a,(bc)
 353         inc     bc
 354         ld      l,a
 355         ld      h,page1
 356         jp      (hl)
 357
 358 page1_imm_or_w:
 359         ld      a,(bc)
 360         inc     bc
 361         or      e
 362         ld      e,a
 363         ld      a,(bc)
 364         inc     bc
 365         or      d
 366         ld      d,a
 367         ld      a,(bc)
 368         inc     bc
 369         ld      l,a
 370         jp      (hl)
 371
 372 page1_or_w:
 373         pop     hl
 374         ld      a,e
 375         or      l
 376         ld      e,a
 377         ld      a,d
 378         or      h
 379         ld      d,a
 380         ld      a,(bc)
 381         inc     bc
 382         ld      l,a
 383         ld      h,page1
 384         jp      (hl)
 385
 386 ;page1_imm_xor_w:
 387 ;       ld      a,(bc)
 388 ;       inc     bc
 389 ;       xor     e
 390 ;       ld      e,a
 391 ;       ld      a,(bc)
 392 ;       inc     bc
 393 ;       xor     d
 394 ;       ld      d,a
 395 ;       ld      a,(bc)
 396 ;       inc     bc
 397 ;       ld      l,a
 398 ;       jp      (hl)
 399
 400 page1_imm_xor_w: ; xor is less common than and/or, so save space for immediate
 401         ld      a,(bc)
 402         ld      l,a
 403         inc     bc
 404         ld      a,(bc)
 405         ld      h,a
 406         inc     bc
 407         .db     0x3e ; ld a,
 408 page1_xor_w:
 409         pop     hl
 410         ld      a,e
 411         xor     l
 412         ld      e,a
 413         ld      a,d
 414         xor     h
 415         ld      d,a
 416         ld      a,(bc)
 417         inc     bc
 418         ld      l,a
 419         ld      h,page1
 420         jp      (hl)
 421
 422 page1_imm_add_w: ; use also for page1_imm_sub_w with negated argument
 423         ld      a,(bc)
 424         ld      l,a
 425         inc     bc
 426         ld      a,(bc)
 427         ld      h,a
 428         inc     bc
 429         .db     0x3e ; ld a,
 430 page1_add_w:
 431         pop     hl
 432         add     hl,de
 433         ex      de,hl
 434         ld      a,(bc)
 435         inc     bc
 436         ld      l,a
 437         ld      h,page1
 438         jp      (hl)
 439
 440 page1_imm_xchg_sub_w: ; reversed, use with argument 0 for neg, -1 for cpl
 441         ld      a,(bc)
 442         ld      l,a
 443         inc     bc
 444         ld      a,(bc)
 445         ld      h,a
 446         inc     bc
 447         .db     0x3e ; ld a,
 448 page1_sub_w:
 449         pop     hl
 450         or      a
 451         sbc     hl,de
 452 mul_done:
 453         ex      de,hl
 454         ld      a,(bc)
 455         inc     bc
 456         ld      l,a
 457         ld      h,page1
 458         jp      (hl)
 459
 460 page1_imm_eq_w:
 461         ld      a,(bc)
 462         ld      l,a
 463         inc     bc
 464         ld      a,(bc)
 465         ld      h,a
 466         inc     bc
 467         .db     0x3e ; ld a,
 468 page1_eq_w:
 469         pop     hl
 470         or      a
 471         sbc     hl,de
 472         ld      a,l
 473         or      h
 474         cp      1
 475         ld      a,(bc)
 476         inc     bc
 477         ld      l,a
 478         ld      h,page0
 479         jp      (hl)
 480
 481 page1_imm_gt_uw:
 482         ld      a,(bc)
 483         ld      l,a
 484         inc     bc
 485         ld      a,(bc)
 486         ld      h,a
 487         inc     bc
 488         .db     0x3e ; ld a,
 489 page1_lt_uw:
 490         pop     hl
 491         or      a
 492         sbc     hl,de
 493         ld      a,(bc)
 494         inc     bc
 495         ld      l,a
 496         ld      h,page0
 497         jp      (hl)
 498
 499 page1_imm_sl_w: ; nonzero unsigned byte argument
 500         jr      imm_sl_w
 501
 502 page1_sl_w:
 503         pop     hl
 504         inc     e
 505         jr      sl_loope
 506
 507 page1_imm_sr_uw: ; nonzero unsigned byte argument
 508         jr      imm_sr_uw
 509
 510 page1_sr_uw:
 511         ld      l,e
 512         pop     de
 513         ld      a,e
 514         inc     l
 515         jr      srl_loope
 516
 517 page1_imm_sr_sw: ; nonzero unsigned byte argument
 518         jr      imm_sr_sw
 519
 520 page1_sr_sw:
 521         ld      l,e
 522         pop     de
 523         ld      a,e
 524         inc     l
 525         jr      sra_loope
 526
 527 page1_div_sw:
 528         pop     hl
 529         call    div_sw
 530 div_done:
 531         push    de
 532         ex      de,hl
 533         ld      a,(bc)
 534         inc     bc
 535         ld      l,a
 536         ld      h,page1
 537         jp      (hl)
 538
 539 page1_div_uw:
 540         ld      l,<div_done
 541         ex      (sp),hl
 542         jr      div_uw
 543
 544 page1_imm_div_sw:
 545         jr      imm_div_sw
 546
 547 page1_imm_div_uw:
 548         jr      imm_div_uw
 549
 550 page1_imm_mul_w: ; big endian argument
 551         ld      l,mul_done
 552         push    hl
 553         ld      a,(bc)
 554         inc     bc
 555         ld      hl,0
 556         call    mul0
 557         ld      a,(bc)
 558         inc     bc
 559         jp      mul ; a shame it can't be jr
 560
 561 page1_mul_w:
 562         ld      l,<mul_done
 563         ex      (sp),hl
 564         jr      mul_w
 565
 566 page1_imm_gt_sw:
 567         ld      a,(bc)
 568         ld      l,a
 569         inc     bc
 570         ld      a,(bc)
 571         ld      h,a
 572         inc     bc
 573         .db     0x3e ; ld a,
 574 page1_lt_sw: ; put this at the end because it's the longest one
 575         pop     hl
 576         ld      a,l
 577         sub     e
 578         ld      a,h
 579         sbc     a,d
 580         rla
 581         jp      po,1$
 582         ccf
 583 1$:     ld      a,(bc)
 584         inc     bc
 585         ld      l,a
 586         ld      h,page0
 587         jp      (hl)
 588
 589 ; math package
 590
 591 imm_sl_w:
 592         ex      de,hl
 593         ld      a,(bc)
 594         inc     bc
 595         ld      e,a
 596 sl_loop:
 597         add     hl,hl
 598 sl_loope:
 599         dec     e
 600         jr      nz,sl_loop
 601         ex      de,hl
 602         ld      a,(bc)
 603         inc     bc
 604         ld      l,a
 605         ld      h,page1
 606         jp      (hl)
 607
 608 imm_sr_uw:
 609         ld      a,(bc)
 610         inc     bc
 611         ld      l,a
 612         ld      a,e
 613 srl_loop:
 614         srl     d
 615         rra
 616 srl_loope:
 617         dec     l
 618         jr      nz,srl_loop
 619         ld      e,a
 620         ld      a,(bc)
 621         inc     bc
 622         ld      l,a
 623         jp      (hl)
 624
 625 imm_sr_sw:
 626         ld      a,(bc)
 627         inc     bc
 628         ld      l,a
 629         ld      a,e
 630 sra_loop:
 631         sra     d
 632         rra
 633 sra_loope:
 634         dec     l
 635         jr      nz,sra_loop
 636         ld      e,a
 637         ld      a,(bc)
 638         inc     bc
 639         ld      l,a
 640         jp      (hl)
 641
 642 imm_div_uw:
 643         ld      l,div_done
 644         push    hl
 645         ld      a,(bc)
 646         inc     bc
 647         ld      l,a
 648         ld      a,(bc)
 649         inc     bc
 650         ld      h,a
 651         ex      de,hl
 652 div_uw:
 653         push    bc
 654         ld      a,h
 655         ld      c,l
 656         ld      hl,0
 657 divpp:  ; positive dividend, positive divisor
 658         call    div0
 659         ld      b,a
 660         ld      a,c
 661         call    div
 662         jr      nc,1$
 663         add     hl,de
 664 1$:     ld      d,b
 665         ld      e,a
 666         pop     bc
 667         ret
 668
 669 imm_div_sw:
 670         ld      l,div_done
 671         push    hl
 672         ld      a,(bc)
 673         inc     bc
 674         ld      l,a
 675         ld      a,(bc)
 676         inc     bc
 677         ld      h,a
 678         ex      de,hl
 679 div_sw:
 680         push    bc
 681         ld      a,h
 682         or      a
 683         ld      a,d
 684         rla
 685         jp      p,divp                  ; positive dividend
 686
 687         ; negative dividend
 688         dec     hl                      ; reduces remainder by 1 (we inc later)
 689         ld      a,h
 690         ld      c,l
 691         ld      hl,-1
 692         jr      nc,divnp ; a shame it can't be a fallthru
 693         jr      divnn                   ; negative dividend, negative divisor
 694
 695 mul_w:  ; mul placed as soon as possible after all div entry points
 696         ld      a,l
 697         push    af
 698         ld      a,h
 699         ld      hl,0
 700         call    mul0
 701         pop     af
 702 mul:    ; bit 0
 703         add     hl,hl
 704 mul0:   rla
 705         jr      nc,1$
 706         add     hl,de
 707 1$:     ; bit 1
 708         add     hl,hl
 709         rla
 710         jr      nc,2$
 711         add     hl,de
 712 2$:     ; bit 2
 713         add     hl,hl
 714         rla
 715         jr      nc,3$
 716         add     hl,de
 717 3$:     ; bit 3
 718         add     hl,hl
 719         rla
 720         jr      nc,4$
 721         add     hl,de
 722 4$:     ; bit 4
 723         add     hl,hl
 724         rla
 725         jr      nc,5$
 726         add     hl,de
 727 5$:     ; bit 5
 728         add     hl,hl
 729         rla
 730         jr      nc,6$
 731         add     hl,de
 732 6$:     ; bit 6
 733         add     hl,hl
 734         rla
 735         jr      nc,7$
 736         add     hl,de
 737 7$:     ; bit 7
 738         add     hl,hl
 739         rla
 740         ret     nc
 741         add     hl,de
 742         ret
 743
 744 divp:   ; positive dividend
 745         ld      a,h
 746         ld      c,l
 747         ld      hl,0
 748         jr      nc,divpp                ; positive dividend, positive divisor
 749
 750         ; positive dividend, negative divisor
 751         call    divn1
 752         ld      b,a
 753         ld      a,c
 754         call    divn
 755         inc     a
 756         jr      c,1$
 757         sbc     hl,de
 758 1$:     ld      d,b
 759         ld      e,a
 760         pop     bc
 761         ret
 762
 763 divnp:  ; negative dividend, positive divisor
 764         call    div1
 765         ld      b,a
 766         ld      a,c
 767         call    div
 768         inc     a
 769         jr      c,1$
 770         sbc     hl,de
 771 1$:     inc     hl                      ; get into range -divisor+1..0
 772         ld      d,b
 773         ld      e,a
 774         pop     bc
 775         ret
 776
 777 divnn:  ; negative dividend, negative divisor
 778         call    divn0
 779         ld      b,a
 780         ld      a,c
 781         call    divn
 782         jr      nc,1$
 783         add     hl,de
 784 1$:     inc     hl                      ; get into range divisor+1..0
 785         ld      d,b
 786         ld      e,a
 787         pop     bc
 788         ret
 789
 790 ; non-restoring division routine
 791
 792 ; de = divisor, hl:a = dividend with hl = previous remainder, a = next byte
 793 ; enter at div0 with positive remainder in hl, such that hl < de
 794 ; enter at div1 with negative remainder in hl, such that hl >= -de
 795
 796 ; div0/1 return a = 8-bit quotient as an odd number interpreted as -ff..ff,
 797 ; by summing positive/negative place values, e.g. -80 +40 +20 -10 +8 -4 -2 +1
 798
 799 ; if entered at div0, there is a -80 and so quotient is in range -ff..-1
 800 ; if entered at div1, there is a +80 and so quotient is in range 1..ff
 801 ; falls out of loop after div01 with positive remainder, div11 with negative,
 802 ; depending on this we should re-enter at div0 or div1, signalled by cf return
 803
 804 ; the successive quotient bytes can be concatenated into a full quotient,
 805 ; but negative bytes require the next higher quotient byte to be decremented,
 806 ; we know in advance if this will happen because the implied sign of the
 807 ; quotient byte depends only on whether we entered at div0 or div1, hence,
 808 ; before the div11 return we'll decrement to compensate for next negative byte
 809
 810 ; the decrement can also be seen as compensating for the extra add hl,de that
 811 ; may be needed to make negative remainder positive before return to caller,
 812 ; thus leaving quotient in a consistent state regardless of which exit taken,
 813 ; remainder needs the add hl,de if cf=1 returned (equiv. return byte is even)
 814
 815 ; in the following code each sbc hl,de gets an inc a and each add hl,de gets
 816 ; a dec a, guaranteeing the integrity of the division, the initial scf/rla is
 817 ; needed to make the result 100 + -ff..ff or 1..1ff, so that the decrements
 818 ; cannot borrow into the upcoming dividend bits also held in a, and there must
 819 ; be another shift between the scf/rla and increment/decrement so that the scf
 820 ; is implicitly in the 100s place, making the code awkward though it's correct
 821
 822 ; now optimized to only inc/dec a when doing zero-crossing, fix above analysis
 823
 824 div:    jr      c,div1
 825 div0:   ; bit 0, above
 826         scf
 827         rla
 828         adc     hl,hl
 829         sbc     hl,de
 830         jr      nc,div01
 831         dec     a
 832 div11:  ; bit 1, below
 833         add     a,a
 834         adc     hl,hl
 835         add     hl,de
 836         jr      nc,div12
 837         inc     a
 838 div02:  ; bit 2, above
 839         add     a,a
 840         adc     hl,hl
 841         sbc     hl,de
 842         jr      nc,div03
 843         dec     a
 844 div13:  ; bit 3, below
 845         add     a,a
 846         adc     hl,hl
 847         add     hl,de
 848         jr      nc,div14
 849         inc     a
 850 div04:  ; bit 4, above
 851         add     a,a
 852         adc     hl,hl
 853         sbc     hl,de
 854         jr      nc,div05
 855         dec     a
 856 div15:  ; bit 5, below
 857         add     a,a
 858         adc     hl,hl
 859         add     hl,de
 860         jr      nc,div16
 861         inc     a
 862 div06:  ; bit 6, above
 863         add     a,a
 864         adc     hl,hl
 865         sbc     hl,de
 866         jr      nc,div07
 867         dec     a
 868 div17:  ; bit 7, below
 869         add     a,a
 870         adc     hl,hl
 871         add     hl,de
 872         jr      nc,div18
 873         inc     a
 874 div08:  ; done, above
 875         add     a,a
 876         dec     a
 877         or      a
 878         ret
 879
 880 div1:   ; bit 0, below
 881         add     a,a
 882         adc     hl,hl
 883         add     hl,de
 884         jr      nc,div11
 885         inc     a
 886 div01:  ; bit 1, above
 887         add     a,a
 888         adc     hl,hl
 889         sbc     hl,de
 890         jr      nc,div02
 891         dec     a
 892 div12:  ; bit 2, below
 893         add     a,a
 894         adc     hl,hl
 895         add     hl,de
 896         jr      nc,div13
 897         inc     a
 898 div03:  ; bit 3, above
 899         add     a,a
 900         adc     hl,hl
 901         sbc     hl,de
 902         jr      nc,div04
 903         dec     a
 904 div14:  ; bit 4, below
 905         add     a,a
 906         adc     hl,hl
 907         add     hl,de
 908         jr      nc,div15
 909         inc     a
 910 div05:  ; bit 5, above
 911         add     a,a
 912         adc     hl,hl
 913         sbc     hl,de
 914         jr      nc,div06
 915         dec     a
 916 div16:  ; bit 6, below
 917         add     a,a
 918         adc     hl,hl
 919         add     hl,de
 920         jr      nc,div17
 921         inc     a
 922 div07:  ; bit 7, above
 923         add     a,a
 924         adc     hl,hl
 925         sbc     hl,de
 926         jr      nc,div08
 927         dec     a
 928 div18:  ; done, below
 929         add     a,a
 930         ;inc    a
 931         ;dec    a                       ; compensation
 932         scf
 933         ret
 934
 935 ; divn0/1 are the same as div0/1 but carry reversed after add/subtract divisor
 936 ; this is for negative divisors where we expect carry (means no zero crossing)
 937
 938 ; when divisor negated, remainder also negated, so we expect to do subtraction
 939 ; when remainder negative and vice versa, need to clear carry after add hl,hl
 940
 941 divn:   jr      c,divn1
 942 divn0:  ; bit 0, above
 943         scf
 944         rla
 945         adc     hl,hl
 946         or      a
 947         sbc     hl,de
 948         jr      c,divn01
 949         dec     a
 950 divn11: ; bit 1, below
 951         add     a,a
 952         adc     hl,hl
 953         add     hl,de
 954         jr      c,divn12
 955         inc     a
 956 divn02: ; bit 2, above
 957         add     a,a
 958         adc     hl,hl
 959         or      a
 960         sbc     hl,de
 961         jr      c,divn03
 962         dec     a
 963 divn13: ; bit 3, below
 964         add     a,a
 965         adc     hl,hl
 966         add     hl,de
 967         jr      c,divn14
 968         inc     a
 969 divn04: ; bit 4, above
 970         add     a,a
 971         adc     hl,hl
 972         or      a
 973         sbc     hl,de
 974         jr      c,divn05
 975         dec     a
 976 divn15: ; bit 5, below
 977         add     a,a
 978         adc     hl,hl
 979         add     hl,de
 980         jr      c,divn16
 981         inc     a
 982 divn06: ; bit 6, above
 983         add     a,a
 984         adc     hl,hl
 985         or      a
 986         sbc     hl,de
 987         jr      c,divn07
 988         dec     a
 989 divn17: ; bit 7, below
 990         add     a,a
 991         adc     hl,hl
 992         add     hl,de
 993         jr      c,divn18
 994         inc     a
 995 divn08: ; done, above
 996         add     a,a
 997         dec     a
 998         or      a
 999         ret
1000
1001 divn1:  ; bit 0, below
1002         add     a,a
1003         adc     hl,hl
1004         add     hl,de
1005         jr      c,divn11
1006         inc     a
1007 divn01: ; bit 1, above
1008         add     a,a
1009         adc     hl,hl
1010         or      a
1011         sbc     hl,de
1012         jr      c,divn02
1013         dec     a
1014 divn12: ; bit 2, below
1015         add     a,a
1016         adc     hl,hl
1017         add     hl,de
1018         jr      c,divn13
1019         inc     a
1020 divn03: ; bit 3, above
1021         add     a,a
1022         adc     hl,hl
1023         or      a
1024         sbc     hl,de
1025         jr      c,divn04
1026         dec     a
1027 divn14: ; bit 4, below
1028         add     a,a
1029         adc     hl,hl
1030         add     hl,de
1031         jr      c,divn15
1032         inc     a
1033 divn05: ; bit 5, above
1034         add     a,a
1035         adc     hl,hl
1036         or      a
1037         sbc     hl,de
1038         jr      c,divn06
1039         dec     a
1040 divn16: ; bit 6, below
1041         add     a,a
1042         adc     hl,hl
1043         add     hl,de
1044         jr      c,divn17
1045         inc     a
1046 divn07: ; bit 7, above
1047         add     a,a
1048         adc     hl,hl
1049         or      a
1050         sbc     hl,de
1051         jr      c,divn08
1052         dec     a
1053 divn18: ; done, below
1054         add     a,a
1055         ;inc    a
1056         ;dec    a                       ; compensation
1057         scf
1058         ret
1059
1060 ; debugging
1061
1062 print_trace:
1063         ld      l,c
1064         ld      h,b
1065         call    print_word
1066         ld      a,'
1067         call    print_char
1068         ld      hl,0
1069         push    af
1070         add     hl,sp
1071         pop     af
1072         call    print_word
1073         ld      a,'
1074         call    print_char
1075         pop     hl
1076         push    hl
1077         call    print_word
1078         ld      a,0xd
1079         call    print_char
1080         ld      a,0xa
1081         call    print_char
1082         ld      a,(bc)
1083         inc     bc
1084         ld      l,a
1085         ld      h,page0
1086         jp      (hl)
1087
1088 print_word:
1089         push    af
1090         ld      a,h
1091         call    print_byte
1092         ld      a,l
1093         call    print_byte
1094         pop     af
1095         ret
1096
1097 print_byte:
1098         push    af
1099         push    af
1100         rrca
1101         rrca
1102         rrca
1103         rrca
1104         call    print_digit
1105         pop     af
1106         call    print_digit
1107         pop     af
1108         ret
1109
1110 print_digit:
1111         push    de
1112         push    hl
1113         and     0xf
1114         ld      e,a
1115         ld      d,0
1116         ld      hl,digits
1117         add     hl,de
1118         ld      a,(hl)
1119         pop     hl
1120         pop     de
1121 print_char:
1122         push    bc
1123         push    de
1124         push    hl
1125         ld      e,a
1126         ld      c,2
1127         call    5
1128         pop     hl
1129         pop     de
1130         pop     bc
1131         ret
1132
1133 digits:
1134         .ascii  '0123456789abcdef'
1135
1136 ; sm code
1137
1138 start:
1139         ld      h,page0
1140         call    page0_jmp
1141         .db     <page0_imm_call
1142         .dw     sm_main
1143         .dw     0
1144         .db     <page0_esc
1145         jp      0
1146
1147 sm_main:
1148         ; create stack frame
1149         .db     <page0_imm_stkadj
1150         .dw     -2
1151
1152         ; push argument
1153         .db     <page0_imm_w
1154         .dw     5
1155
1156         ; push result pointer
1157         .db     <page1_imm_stkptr
1158         .dw     2
1159
1160         ; call sm_factorial(argument)
1161         .db     <page1_imm_call
1162         .dw     sm_factorial
1163         .dw     4
1164
1165         ; print 10000s
1166         .db     <page0_imm_stkld_w
1167         .dw     0
1168         .db     <page1_imm_div_sw
1169         .dw     10000
1170         .db     <page1_imm_xchg_stkst_w
1171         .dw     2
1172         .db     <page0_page1
1173         .db     page1_imm_add_w
1174         .dw     '0
1175         .db     <page1_imm_call
1176         .dw     sm_print_char
1177         .dw     2
1178
1179         ; print 1000s
1180         .db     <page0_imm_stkld_w
1181         .dw     0
1182         .db     <page1_imm_div_sw
1183         .dw     1000
1184         .db     <page1_imm_xchg_stkst_w
1185         .dw     2
1186         .db     <page0_page1
1187         .db     page1_imm_add_w
1188         .dw     '0
1189         .db     <page1_imm_call
1190         .dw     sm_print_char
1191         .dw     2
1192
1193         ; print 100s
1194         .db     <page0_imm_stkld_w
1195         .dw     0
1196         .db     <page1_imm_div_sw
1197         .dw     100
1198         .db     <page1_imm_xchg_stkst_w
1199         .dw     2
1200         .db     <page0_page1
1201         .db     page1_imm_add_w
1202         .dw     '0
1203         .db     <page1_imm_call
1204         .dw     sm_print_char
1205         .dw     2
1206
1207         ; print 10s
1208         .db     <page0_imm_stkld_w
1209         .dw     0
1210         .db     <page1_imm_div_sw
1211         .dw     10
1212         .db     <page1_imm_xchg_stkst_w
1213         .dw     2
1214         .db     <page0_page1
1215         .db     page1_imm_add_w
1216         .dw     '0
1217         .db     <page1_imm_call
1218         .dw     sm_print_char
1219         .dw     2
1220
1221         ; print 1s
1222         .db     <page0_imm_stkld_w
1223         .dw     0
1224         .db     page1_imm_add_w
1225         .dw     '0
1226         .db     <page1_imm_call
1227         .dw     sm_print_char
1228         .dw     2
1229
1230         ; print cr
1231         .db     <page0_imm_w
1232         .dw     0xd
1233         .db     <page1_imm_call
1234         .dw     sm_print_char
1235         .dw     2
1236
1237         ; print lf
1238         .db     <page0_imm_w
1239         .dw     0xa
1240         .db     <page1_imm_call
1241         .dw     sm_print_char
1242         .dw     2
1243
1244         ; destroy stack frame
1245         .db     <page0_imm_stkadj
1246         .dw     2
1247
1248         ; return
1249         .db     <page0_ret
1250
1251 sm_factorial:
1252  .db <page0_trace
1253         ; get argument
1254         .db     <page0_imm_stkld_w
1255         .dw     4
1256
1257         ; is argument < 2?
1258         .db     <page1_imm_gt_sw
1259         .dw     1
1260         .db     <page0_imm_jfalse
1261         .dw     1$
1262
1263         ; no, set up for *result =
1264         .db     <page0_imm_stkld_w
1265         .dw     2
1266
1267         ; get argument
1268         .db     <page1_imm_stkld_w
1269         .dw     6
1270
1271         ; subtract 1
1272         .db     <page1_imm_add_w
1273         .dw     -1
1274
1275         ; push result pointer
1276         .db     <page1_imm_stkptr
1277         .dw     0
1278
1279         ; call sm_factorial(argument - 1)
1280         .db     <page1_imm_call
1281         .dw     sm_factorial
1282         .dw     2
1283
1284         ; get argument
1285         .db     <page0_imm_stkld_w
1286         .dw     8
1287
1288         ; multiply
1289         .db     <page1_mul_w
1290
1291         ; set *result = sm_factorial(argument - 1) * argument
1292         .db     <page1_st_w
1293
1294         ; return
1295  .db <page0_trace
1296         .db     <page0_ret
1297
1298 1$:
1299         ; yes, set up for *result =
1300         .db     <page0_imm_stkld_w
1301         .dw     2
1302
1303         ; set *result = 1
1304         .db     page1_imm_w
1305         .dw     1
1306         .db     <page1_st_w
1307
1308         ; return
1309  .db <page0_trace
1310         .db     <page0_ret
1311
1312 sm_print_char:
1313         .db     <page0_esc
1314         ld      hl,2
1315         add     hl,sp
1316         ld      a,(hl)
1317         call    print_char
1318         ld      h,page0
1319         jp      page0_ret