mach/z80/int/em.s

   1 #
   2 .sect .text
   3 .sect .rom
   4 .sect .data
   5 .sect .bss
   6 .sect .text
   7 ! This program is an EM interpreter for the Z80.
   8 ! Register pair bc is used to hold lb.
   9 ! Register ix is used to hold the EM program counter.
  10 ! The interpreter assumes 16-bit words and 16-bit pointers.
  11
  12 ! #define       CPM1    1
  13
  14 ! Definitions:
  15    zone = 8     ! size of subroutine call block (address + old lb)
  16    bdos = 5     ! standard entry into I/O-routines
  17    boot = 0
  18    fcb = 0x5c   ! file descriptor of EM-1 file (5C hex)
  19
  20    reset=0
  21    delete=19
  22    makefile=22
  23    close=16
  24    readconsole = 10
  25    writeconsole = 2
  26    open = 15
  27    read = 20
  28    write = 21
  29    setdma = 26
  30    printstring = 9
  31    seqread = 20
  32    randomread = 33
  33    seqwrite = 21
  34    randomwrite = 34
  35    consolein = 1
  36    diconio = 6
  37    RAW=0                        !0 for cooked,1 for raw io
  38
  39    timebuf=0xFFDE
  40
  41    b_lolp = 176
  42    b_loln = 179
  43    b_lof = 161
  44    b_loi = 168
  45    b_lal = 130
  46    b_lil = 146
  47    b_stlm = 227
  48    b_stf = 214
  49    b_sti = 218
  50    b_inl = 112
  51    b_cal = 63
  52    b_asp = 44
  53    b_zrl = 249
  54
  55    EARRAY = 0
  56    ERANGE = 1
  57    EILLINS=18
  58    EILLSIZE=19
  59    ECASE=20
  60    EMON=25
  61
  62 !--------------------------- Initialization ---------------------------
  63
  64         jp init         ! 3 byte instruction.
  65
  66 !------------------------- MAIN DISPATCH ------------------------------
  67 !
  68 ! must be put in a suitable place in memory to reduce memory usage
  69 ! must be put on a page boundary
  70
  71
  72 .data1 0                ! fourth byte
  73 dispat = . - 4  ! base of dispatch table
  74 !       .data2  loc.0
  75 !       .data2  loc.1
  76         .data2  loc.2
  77         .data2  loc.3
  78         .data2  loc.4
  79         .data2  loc.5
  80         .data2  loc.6
  81         .data2  loc.7
  82         .data2  loc.8
  83         .data2  loc.9
  84         .data2  loc.10
  85         .data2  loc.11
  86         .data2  loc.12
  87         .data2  loc.13
  88         .data2  loc.14
  89         .data2  loc.15
  90         .data2  loc.16
  91         .data2  loc.17
  92         .data2  loc.18
  93         .data2  loc.19
  94         .data2  loc.20
  95         .data2  loc.21
  96         .data2  loc.22
  97         .data2  loc.23
  98         .data2  loc.24
  99         .data2  loc.25
 100         .data2  loc.26
 101         .data2  loc.27
 102         .data2  loc.28
 103         .data2  loc.29
 104         .data2  loc.30
 105         .data2  loc.31
 106         .data2  loc.32
 107         .data2  loc.33
 108         .data2  aar.2
 109         .data2  adf.s0
 110         .data2  adi.2
 111         .data2  adi.4
 112         .data2  adp.l
 113         .data2  adp.1
 114         .data2  adp.2
 115         .data2  adp.s0
 116         .data2  adp.sm1
 117         .data2  ads.2
 118         .data2  and.2
 119         .data2  asp.2
 120         .data2  asp.4
 121         .data2  asp.6
 122         .data2  asp.8
 123         .data2  asp.10
 124         .data2  asp.w0
 125         .data2  beq.l
 126         .data2  beq.s0
 127         .data2  bge.s0
 128         .data2  bgt.s0
 129         .data2  ble.s0
 130         .data2  blm.s0
 131         .data2  blt.s0
 132         .data2  bne.s0
 133         .data2  bra.l
 134         .data2  bra.sm1
 135         .data2  bra.sm2
 136         .data2  bra.s0
 137         .data2  bra.s1
 138         .data2  cal.1
 139         .data2  cal.2
 140         .data2  cal.3
 141         .data2  cal.4
 142         .data2  cal.5
 143         .data2  cal.6
 144         .data2  cal.7
 145         .data2  cal.8
 146         .data2  cal.9
 147         .data2  cal.10
 148         .data2  cal.11
 149         .data2  cal.12
 150         .data2  cal.13
 151         .data2  cal.14
 152         .data2  cal.15
 153         .data2  cal.16
 154         .data2  cal.17
 155         .data2  cal.18
 156         .data2  cal.19
 157         .data2  cal.20
 158         .data2  cal.21
 159         .data2  cal.22
 160         .data2  cal.23
 161         .data2  cal.24
 162         .data2  cal.25
 163         .data2  cal.26
 164         .data2  cal.27
 165         .data2  cal.28
 166         .data2  cal.s0
 167         .data2  cff.z
 168         .data2  cif.z
 169         .data2  cii.z
 170         .data2  cmf.s0
 171         .data2  cmi.2
 172         .data2  cmi.4
 173         .data2  cmp.z
 174         .data2  cms.s0
 175         .data2  csa.2
 176         .data2  csb.2
 177         .data2  dec.z
 178         .data2  dee.w0
 179         .data2  del.wm1
 180         .data2  dup.2
 181         .data2  dvf.s0
 182         .data2  dvi.2
 183         .data2  fil.l
 184         .data2  inc.z
 185         .data2  ine.l
 186         .data2  ine.w0
 187         .data2  inl.m2
 188         .data2  inl.m4
 189         .data2  inl.m6
 190         .data2  inl.wm1
 191         .data2  inn.s0
 192         .data2  ior.2
 193         .data2  ior.s0
 194         .data2  lae.l
 195         .data2  lae.w0
 196         .data2  lae.w1
 197         .data2  lae.w2
 198         .data2  lae.w3
 199         .data2  lae.w4
 200         .data2  lae.w5
 201         .data2  lae.w6
 202         .data2  lal.p
 203         .data2  lal.n
 204         .data2  lal.0
 205         .data2  lal.m1
 206         .data2  lal.w0
 207         .data2  lal.wm1
 208         .data2  lal.wm2
 209         .data2  lar.2
 210         .data2  ldc.0
 211         .data2  lde.l
 212         .data2  lde.w0
 213         .data2  ldl.0
 214         .data2  ldl.wm1
 215         .data2  lfr.2
 216         .data2  lfr.4
 217         .data2  lfr.s0
 218         .data2  lil.wm1
 219         .data2  lil.w0
 220         .data2  lil.0
 221         .data2  lil.2
 222         .data2  lin.l
 223         .data2  lin.s0
 224         .data2  lni.z
 225         .data2  loc.l
 226         .data2  loc.m1
 227         .data2  loc.s0
 228         .data2  loc.sm1
 229         .data2  loe.l
 230         .data2  loe.w0
 231         .data2  loe.w1
 232         .data2  loe.w2
 233         .data2  loe.w3
 234         .data2  loe.w4
 235         .data2  lof.l
 236         .data2  lof.2
 237         .data2  lof.4
 238         .data2  lof.6
 239         .data2  lof.8
 240         .data2  lof.s0
 241         .data2  loi.l
 242         .data2  loi.1
 243         .data2  loi.2
 244         .data2  loi.4
 245         .data2  loi.6
 246         .data2  loi.8
 247         .data2  loi.s0
 248         .data2  lol.p
 249         .data2  lol.n
 250         .data2  lol.0
 251         .data2  lol.2
 252         .data2  lol.4
 253         .data2  lol.6
 254         .data2  lol.m2
 255         .data2  lol.m4
 256         .data2  lol.m6
 257         .data2  lol.m8
 258         .data2  lol.m10
 259         .data2  lol.m12
 260         .data2  lol.m14
 261         .data2  lol.m16
 262         .data2  lol.w0
 263         .data2  lol.wm1
 264         .data2  lxa.1
 265         .data2  lxl.1
 266         .data2  lxl.2
 267         .data2  mlf.s0
 268         .data2  mli.2
 269         .data2  mli.4
 270         .data2  rck.2
 271         .data2  ret.0
 272         .data2  ret.2
 273         .data2  ret.s0
 274         .data2  rmi.2
 275         .data2  sar.2
 276         .data2  sbf.s0
 277         .data2  sbi.2
 278         .data2  sbi.4
 279         .data2  sdl.wm1
 280         .data2  set.s0
 281         .data2  sil.wm1
 282         .data2  sil.w0
 283         .data2  sli.2
 284         .data2  ste.l
 285         .data2  ste.w0
 286         .data2  ste.w1
 287         .data2  ste.w2
 288         .data2  stf.l
 289         .data2  stf.2
 290         .data2  stf.4
 291         .data2  stf.s0
 292         .data2  sti.1
 293         .data2  sti.2
 294         .data2  sti.4
 295         .data2  sti.6
 296         .data2  sti.8
 297         .data2  sti.s0
 298         .data2  stl.p
 299         .data2  stl.n
 300         .data2  stl.p0
 301         .data2  stl.p2
 302         .data2  stl.m2
 303         .data2  stl.m4
 304         .data2  stl.m6
 305         .data2  stl.m8
 306         .data2  stl.m10
 307         .data2  stl.wm1
 308         .data2  teq.z
 309         .data2  tgt.z
 310         .data2  tlt.z
 311         .data2  tne.z
 312         .data2  zeq.l
 313         .data2  zeq.s0
 314         .data2  zeq.s1
 315         .data2  zer.s0
 316         .data2  zge.s0
 317         .data2  zgt.s0
 318         .data2  zle.s0
 319         .data2  zlt.s0
 320         .data2  zne.s0
 321         .data2  zne.sm1
 322         .data2  zre.l
 323         .data2  zre.w0
 324         .data2  zrl.m2
 325         .data2  zrl.m4
 326         .data2  zrl.wm1
 327         .data2  zrl.n
 328         .data2  loop1
 329         .data2  loop2
 330
 331 !----------------- END OF MAIN DISPATCH -------------------------------
 332
 333 xxx:
 334         .data2  loc.0
 335         .data2  loc.1
 336 init:
 337         ld sp,(bdos+1)  ! address of fbase
 338         ld hl,xxx
 339         ld de,dispat
 340         ld bc,4
 341         ldir
 342         call uxinit
 343 warmstart:
 344         ld sp,(bdos+1)  ! address of fbase
 345         call makeargv
 346         ld de,0x80
 347         ld c,setdma
 348         call bdos
 349         ld c,open
 350         ld de,fcb
 351         call bdos
 352         inc a
 353         jr z,bademfile
 354         ld c,read
 355         ld de,fcb
 356         call bdos
 357         or a
 358         jr nz,bademfile ! no file
 359         ld de,header
 360         ld hl,0x90      ! start of 2nd half of header
 361         ld bc,10        ! we copy only first 5 words
 362         ldir
 363         ld de,(ntext)   ! size of program text in bytes
 364         ld hl,0
 365         sbc hl,de
 366         add hl,sp
 367         ld sp,hl        ! save space for program
 368         ld (pb),hl      ! set procedure base
 369         ld a,0xa0
 370         ld (nextp),a
 371         ld de,(ntext)
 372         xor a
 373         ld h,a
 374         ld l,a
 375         sbc hl,de
 376         ex de,hl
 377         ld h,a
 378         ld l,a
 379         add hl,sp
 380 1:      call getb
 381         ld (hl),c
 382         inc hl
 383         inc e
 384         jr nz,1b
 385         inc d
 386         jr nz,1b
 387                         ! now program text has been read,so start read-
 388         ld iy,0         ! ing data descriptors, (nextp) (was hl) is
 389         ld ix,eb        ! pointer into DMA,ix is pointer into global
 390         ! data area,iy is #bytes pushed in last instr (used for repeat)
 391 rddata: ld hl,(ndata)
 392         ld a,h
 393         or l
 394         jr z,prdes      ! no data left
 395         dec hl
 396         ld (ndata),hl
 397         call getb       ! read 1 byte (here:init type) into register c
 398         dec c
 399         jp p,2f
 400         call getw
 401         push iy
 402         pop hl
 403         ld a,h
 404         or l
 405         jr z,5f         ! size of block is zero, so no work
 406         push hl
 407         push bc
 408 3:      pop hl          ! #repeats
 409         pop bc          ! block size
 410         push bc
 411         ld a,h
 412         or l
 413         jr z,4f         ! ready
 414         dec hl
 415         push hl
 416         push ix
 417         pop hl
 418         add ix,bc
 419         dec hl
 420         ld d,h
 421         ld e,l
 422         add hl,bc
 423         ex de,hl
 424         lddr
 425         jr 3b
 426 4:      pop bc
 427 5:      ld iy,0         ! now last instruction = repeat = type 0
 428         jr rddata
 429 2:      ld b,c          ! here other types come
 430         jr nz,2f        ! Z-flag was (re-)set when decrementing c
 431         call getb       ! uninitialized words, fetch #words
 432         sla c
 433         rl b
 434         ld iy,0
 435         add iy,bc
 436         add ix,bc
 437 4:      jr rddata
 438 2:      call getb       ! remaining types, first fetch #bytes/words
 439         ld a,b
 440         cp 7
 441         jr z,rdflt
 442         jp p,bademfile  ! floats are not accepted,nor are illegal types
 443         ld b,0
 444         cp 1
 445         jr z,2f
 446         cp 5
 447         jp m,1f
 448 2:      ld iy,0         ! initialized bytes, simply copy from EM-1 file
 449         add iy,bc
 450         ld b,c          ! #bytes
 451 3:
 452         call getb
 453         ld (ix),c
 454         inc ix
 455         djnz 3b
 456         jr 4b
 457 1:      cp 2
 458         jr z,2f
 459         cp 3
 460         jr z,3f
 461         ld hl,(pb)
 462         jr 4f
 463 3:      ld hl,eb
 464         jr 4f
 465 2:      ld hl,0
 466 4:      ld (ntext),hl   ! ntext is used here to hold base address of
 467         ld iy,0         ! correct type: data,instr or 0 (plain numbers)
 468         add iy,bc
 469         add iy,bc
 470         ld b,c
 471 1:
 472         push bc
 473         ex de,hl        ! save e into l
 474         call getw
 475         ex de,hl
 476         ld hl,(ntext)
 477         add hl,bc
 478         ld (ix),l
 479         inc ix
 480         ld (ix),h
 481         inc ix
 482         pop bc
 483         djnz 1b
 484 2:      jr rddata
 485 rdflt:
 486         ld a,c
 487         cp 4
 488         jr nz,bademfile
 489         push ix
 490         pop hl
 491 1:      call getb
 492         ld a,c
 493         ld (hl),a
 494         inc hl
 495         or a
 496         jr nz,1b
 497         push ix
 498         pop hl
 499         call atof
 500         ld b,4
 501 1:      ld a,(hl)
 502         ld (ix),a
 503         inc ix
 504         inc hl
 505         djnz 1b
 506         jr rddata
 507
 508 bademfile:
 509         ld c,printstring
 510         ld de,1f
 511         call bdos
 512         jp 0
 513 1:      .ascii 'load file error\r\n$'
 514
 515 ! now all data has been read,so on with the procedure descriptors
 516 prdes:
 517         ld (hp),ix      ! initialize heap pointer
 518         ld de,(nproc)
 519         ld hl,0
 520         xor a
 521         sbc hl,de
 522         add hl,hl
 523         add hl,hl       ! 4 bytes per proc-descriptor
 524         add hl,sp
 525         ld sp,hl        ! save space for procedure descriptors
 526         push hl
 527         pop ix
 528         ld (pd),hl      ! initialize base
 529         ld hl,(nproc)
 530 1:      ld a,h
 531         or l
 532         jr z,2f
 533         dec hl
 534         call getb
 535         ld (ix),c
 536         inc ix
 537         call getb
 538         ld (ix),c
 539         inc ix
 540         call getw
 541         ex de,hl
 542         ld hl,(pb)
 543         add hl,bc
 544         ld (ix),l
 545         inc ix
 546         ld (ix),h
 547         inc ix
 548         ex de,hl
 549         jr 1b
 550 2:
 551         ld de,(entry)   ! get ready for start of program
 552         ld ix,0         ! reta, jumping here will stop execution
 553         push ix
 554         ld hl,argv
 555         push hl
 556         ld hl,(argc)
 557         push hl
 558         jr cal          ! call EM-1 main program
 559
 560 getw:   call getb
 561         ld b,c
 562         call getb
 563         ld a,b
 564         ld b,c
 565         ld c,a
 566         ret
 567 getb:   push hl         ! getb reads 1 byte in register c from standard
 568         push de
 569         ld a,(nextp)    ! DMA buffer and refills if necessary
 570         or a
 571         jr nz,1f
 572         push bc
 573         ld c,read
 574         ld de,fcb
 575         call bdos
 576         or a
 577         jr nz,bademfile
 578         pop bc
 579         ld a,0x80
 580 1:      ld l,a
 581         ld h,0
 582         ld c,(hl)
 583         inc a
 584         ld (nextp),a
 585         pop de
 586         pop hl
 587         ret
 588
 589 !------------------------- Main loop of the interpreter ---------------
 590
 591 phl:    push hl
 592 loop:   ld e,(ix)       ! e = opcode byte
 593         inc ix          ! advance EM program counter to next byte
 594         ld hl,dispat    ! hl = address of dispatching table
 595         xor a
 596         ld d,a
 597         add hl,de       ! compute address of routine for this opcode
 598         add hl,de       ! hl = address of routine to dispatch to
 599         ld d,(hl)       ! e = low byte of routine address
 600         inc hl          ! hl now points to 2nd byte of routine address
 601         ld h,(hl)       ! h = high byte of routine address
 602         ld l,d          ! hl = address of routine
 603         ld d,a
 604         jp (hl)         ! go execute the routine
 605
 606 loop1:  ld e,(ix)       ! e = opcode byte
 607         inc ix          ! advance EM program counter to next byte
 608         ld hl,dispat1   ! hl = address of dispatching table
 609         xor a
 610         ld d,a
 611         add hl,de       ! compute address of routine for this opcode
 612         add hl,de       ! hl = address of routine to dispatch to
 613         ld d,(hl)       ! e = low byte of routine address
 614         inc hl          ! hl now points to 2nd byte of routine address
 615         ld h,(hl)       ! h = high byte of routine address
 616         ld l,d          ! hl = address of routine
 617         ld d,a
 618         jp (hl)         ! go execute the routine
 619
 620 loop2:  ld e,(ix)       ! e = opcode byte
 621         inc ix          ! advance EM program counter to next byte
 622         ld hl,dispat2   ! hl = address of dispatching table
 623         xor a
 624         ld d,a
 625         add hl,de       ! compute address of routine for this opcode
 626         add hl,de       ! hl = address of routine to dispatch to
 627         ld d,(hl)       ! e = low byte of routine address
 628         inc hl          ! hl now points to 2nd byte of routine address
 629         ld h,(hl)       ! h = high byte of routine address
 630         ld l,d          ! hl = address of routine
 631         ld d,a
 632         jp (hl)         ! go execute the routine
 633
 634 ! Note that d and a are both still 0, and the carry bit is cleared.
 635 ! The execution routines make heavy use of these properties.
 636 ! The reason that the carry bit is cleared is a little subtle, since the
 637 ! two instructions add hl,de affect it.  However, since dispat is being
 638 ! added twice a number < 256, no carry can occur.
 639
 640
 641
 642 !---------------------- Routines to compute addresses of locals -------
 643
 644 ! There are four addressing routines, corresponding to four ways the
 645 ! offset can be represented:
 646 ! loml: 16-bit offset.  Codes 1-32767 mean offsets -2 to -65534 bytes
 647 ! loms:  8-bit offset.  Codes 1-255   mean offsets -2 to   -510 bytes
 648 ! lopl: 16-bit offset.  Codes 0-32767 mean offsets  0 to +65534 bytes
 649 ! lops:  8-bit offset.  Codes 0-255   mean offsets  0 to   +510 bytes
 650
 651 loml:   ld d,(ix)       ! loml is for 16-bit offsets with implied minus
 652         inc ix
 653         jr 1f
 654 loms:
 655         dec d
 656 1:      ld e,(ix)       ! loms is for 8-bit offsets with implied minus
 657         inc ix
 658         ld h,b
 659         ld l,c          ! hl = bc
 660         add hl,de
 661         add hl,de       ! hl now equals lb - byte offset
 662         jp (iy)
 663
 664 lopl:   ld d,(ix)       ! lopl is for 16-bit offsets >= 0
 665         inc ix
 666 lops:   ld h,d
 667         ld l,(ix)       ! fetch low order byte of offset
 668         inc ix
 669         add hl,hl       ! convert offset to bytes
 670         ld de,zone      ! to account of return address zone
 671         add hl,de
 672         add hl,bc       ! hl now equals lb - byte offset
 673         jp (iy)
 674
 675
 676
 677 !---------------------------- LOADS -----------------------------------
 678
 679 ! LOC, LPI
 680 loc.l: lpi.l:
 681         ld d,(ix)       ! loc with 16-bit offset
 682         inc ix
 683 loc.s0: ld e,(ix)       ! loc with 8-bit offset
 684         inc ix
 685 loc.0:  loc.1:  loc.2:  loc.3:  loc.4:  loc.5:  loc.6:  loc.7:
 686 loc.8:  loc.9:  loc.10: loc.11: loc.12: loc.13: loc.14: loc.15:
 687 loc.16: loc.17: loc.18: loc.19: loc.20: loc.21: loc.22: loc.23:
 688 loc.24: loc.25: loc.26: loc.27: loc.28: loc.29: loc.30: loc.31:
 689 loc.32: loc.33:
 690         push de
 691         jr loop
 692
 693 loc.m1: ld hl,-1
 694         jr phl
 695
 696
 697 loc.sm1:dec d           ! for constants -256...-1
 698         jr loc.s0
 699
 700
 701 ! LDC
 702 ldc.f:  ld h,(ix)
 703         inc ix
 704         ld l,(ix)
 705         inc ix
 706         push hl
 707         ld h,(ix)
 708         inc ix
 709         ld l,(ix)
 710         inc ix
 711         jr phl
 712 ldc.l:  ld h,(ix)
 713         inc ix
 714         ld l,(ix)
 715         inc ix
 716         ld e,d
 717         bit 7,h
 718         jr z,1f
 719         dec de
 720 1:
 721         push de
 722         jr phl
 723
 724 ldc.0:  ld e,d
 725         push de
 726         push de
 727         jr loop
 728
 729
 730 ! LOL
 731
 732 lol.0: lol.1: lol.2: lol.3: lol.4: lol.5: lol.6:
 733         ld hl,-b_lolp-b_lolp+zone
 734         add hl,de
 735         add hl,de
 736         add hl,bc
 737         jr ipsh
 738
 739 lol.m2: lol.m4: lol.m6: lol.m8: lol.m10: lol.m12: lol.m14: lol.m16:
 740         ld hl,b_loln+b_loln
 741         sbc hl,de
 742         xor a           ! clear carry bit
 743         sbc hl,de
 744         add hl,bc       ! hl = lb - byte offset
 745
 746 ipsh:   ld e,(hl)
 747         inc hl
 748         ld d,(hl)
 749         push de
 750         jr loop
 751
 752 lol.wm1:ld iy,ipsh
 753         jr loms
 754 lol.n:  ld iy,ipsh
 755         jr loml
 756 lol.w0: ld iy,ipsh
 757         jr lops
 758 lol.p:  ld iy,ipsh
 759         jr lopl
 760
 761
 762 ! LOE
 763
 764 loe.w4: inc d
 765 loe.w3: inc d
 766 loe.w2: inc d
 767 loe.w1: inc d
 768 loe.w0: ld e,(ix)
 769         inc ix
 770         ld hl,eb
 771         add hl,de
 772         add hl,de
 773         jr ipsh
 774
 775 loe.l:  ld d,(ix)
 776         inc ix
 777         jr loe.w0
 778
 779
 780
 781 ! LOF
 782 lof.2: lof.4: lof.6: lof.8:
 783         ld hl,-b_lof-b_lof      ! assume lof 1 means stack +2, not -2
 784         add hl,de
 785         add hl,de
 786  1:     pop de
 787         add hl,de
 788         jr ipsh
 789
 790 lof.s0: ld h,d
 791  2:     ld l,(ix)
 792         inc ix
 793         jr 1b
 794
 795 lof.l:  ld h,(ix)
 796         inc ix
 797         jr 2b
 798
 799
 800
 801 ! LAL
 802 lal.m1: ld h,b
 803         ld l,c
 804         dec hl
 805         jr phl
 806 lal.0:  ld h,b
 807         ld l,c
 808         ld de,zone
 809         add hl,de
 810         jr phl
 811
 812 lal.wm2:dec d
 813 lal.wm1:ld iy,phl
 814         jr loms
 815 lal.w0: ld iy,phl
 816         jr lops
 817 lal.n:  ld h,(ix)
 818         inc ix
 819         ld l,(ix)
 820         inc ix
 821         add hl,bc
 822         jr phl
 823
 824 lal.p:  ld h,(ix)
 825         inc ix
 826         ld l,(ix)
 827         inc ix
 828         add hl,bc
 829         ld de,zone
 830         add hl,de
 831         jr phl
 832
 833
 834
 835 ! LAE
 836
 837 lae.w8: inc d
 838 lae.w7: inc d
 839 lae.w6: inc d
 840 lae.w5: inc d
 841 lae.w4: inc d
 842 lae.w3: inc d
 843 lae.w2: inc d
 844 lae.w1: inc d
 845 lae.w0: ld e,(ix)
 846         inc ix
 847         ld hl,eb
 848         add hl,de
 849         add hl,de
 850         jr phl
 851
 852 lae.l:  ld d,(ix)
 853         inc ix
 854         ld e,(ix)
 855         inc ix
 856         ld hl,eb
 857         add hl,de
 858         jr phl
 859
 860
 861
 862 ! LIL
 863 lil.0: lil.2:
 864         ld hl,-b_lil-b_lil+zone
 865         add hl,de
 866         add hl,de
 867         add hl,bc
 868  1:     ld e,(hl)
 869         inc hl
 870         ld h,(hl)
 871         ld l,e
 872         jr ipsh
 873
 874 lil.wm1:ld iy,1b
 875         jr loms
 876 lil.n:  ld iy,1b
 877         jr loml
 878 lil.w0: ld iy,1b
 879         jr lops
 880 lil.p:  ld iy,1b
 881         jr lopl
 882
 883
 884
 885 ! LXL, LXA
 886 lxl.1:
 887         ld a,1
 888         jr 7f
 889
 890 lxl.2:
 891         ld a,2
 892         jr 7f
 893
 894 lxl.l:  ld d,(ix)
 895         inc ix
 896 lxl.s:  ld a,(ix)
 897         inc ix
 898 7:      ld iy,phl
 899 5:      ld h,b
 900         ld l,c
 901         or a
 902         jr z,3f
 903 2:      inc hl
 904         inc hl
 905         inc hl
 906         inc hl
 907         inc hl
 908         inc hl
 909         inc hl
 910         inc hl
 911         .assert [ .-2b-zone] == 0
 912         ld e,(hl)
 913         inc hl
 914         ld h,(hl)
 915         ld l,e
 916         dec a
 917         jr nz,2b
 918 3:      cp d
 919         jr z,4f
 920         dec d
 921         jr 2b
 922 4:      jp (iy)
 923
 924 lxa.1:
 925         ld a,1
 926         jr 7f
 927
 928 lxa.l:  ld d,(ix)
 929         inc ix
 930 lxa.s:  ld a,(ix)
 931         inc ix
 932 7:      ld iy,1f
 933         jr 5b
 934 1:      ld de,zone
 935         add hl,de
 936         jr phl
 937
 938 lpb.z:
 939         pop hl
 940         .assert [ zone/256] == 0
 941         ld e,zone
 942         add hl,de
 943         jr phl
 944
 945 dch.z:
 946         ld e,2
 947         jr loi
 948
 949 exg.z:
 950         pop de
 951         jr exg
 952 exg.l:
 953         ld d,(ix)
 954         inc ix
 955 exg.s0:
 956         ld e,(ix)
 957         inc ix
 958 exg:
 959         push bc
 960         pop iy
 961         ld hl,0
 962         add hl,sp
 963         ld b,h
 964         ld c,l
 965         add hl,de
 966 1:
 967         ld a,(bc)
 968         ex af,af2
 969         ld a,(hl)
 970         ld (bc),a
 971         ex af,af2
 972         ld (hl),a
 973         inc bc
 974         inc hl
 975         dec de
 976         ld a,d
 977         or e
 978         jr nz,1b
 979         push iy
 980         pop bc
 981         jr loop
 982
 983
 984 ! LDL
 985 ldl.0:  ld de,zone
 986         ld h,b
 987         ld l,c
 988         add hl,de
 989 dipsh:  inc hl
 990         inc hl
 991         inc hl
 992         ld d,(hl)
 993         dec hl
 994         ld e,(hl)
 995         dec hl
 996         push de
 997         ld d,(hl)
 998         dec hl
 999         ld e,(hl)
1000         push de
1001         jr loop
1002
1003 ldl.wm1:ld iy,dipsh
1004         jr loms
1005 ldl.n:  ld iy,dipsh
1006         jr loml
1007 ldl.w0: ld iy,dipsh
1008         jr lops
1009 ldl.p:  ld iy,dipsh
1010         jr lopl
1011
1012
1013 ! LDE
1014 lde.l:  ld d,(ix)
1015         inc ix
1016         jr lde.w0
1017
1018 lde.w3: inc d
1019 lde.w2: inc d
1020 lde.w1: inc d
1021 lde.w0: ld e,(ix)
1022         inc ix
1023         ld hl,eb
1024         add hl,de
1025         add hl,de
1026         jr dipsh
1027
1028
1029 ! LDF
1030 ldf.l:  ld d,(ix)
1031         inc ix
1032         ld e,(ix)
1033         inc ix
1034         pop hl
1035         add hl,de
1036         jr dipsh
1037
1038
1039 ! LOI,LOS
1040 los.z:
1041         ld iy,los.2
1042         jr pop2
1043 los.l:  call long2
1044 los.2:  pop de
1045 loi:    pop hl
1046         add hl,de
1047         dec hl
1048         srl d
1049         rr e
1050         jr nc,1f
1051         ld a,e
1052         or d
1053         jr nz,eilsize
1054         ld e,(hl)       ! here the 1-byte case is caught
1055         push de
1056         jr loop
1057 1:      push bc
1058         pop iy
1059 2:      ld b,(hl)
1060         dec hl
1061         ld c,(hl)
1062         dec hl
1063         push bc
1064         dec de
1065         ld a,d
1066         or e
1067         jr nz,2b
1068 loiend: push iy
1069         pop bc
1070         jr loop
1071
1072 loi.1: loi.2: loi.4: loi.6: loi.8:
1073         ld hl,-b_loi-b_loi
1074         add hl,de
1075         adc hl,de       ! again we use that the carry is cleared
1076         jr nz,1f
1077         inc hl          ! in case loi.0 object size is 1 byte!
1078 1:      ex de,hl
1079         jr loi
1080
1081 loi.l:  ld d,(ix)
1082         inc ix
1083 loi.s0: ld e,(ix)
1084         inc ix
1085         jr loi
1086
1087
1088 ! ------------------------------ STORES --------------------------------
1089
1090 ! STL
1091 stl.p2: ld hl,2
1092         jr 4f
1093 stl.p0: ld hl,0
1094 4:      ld de,zone
1095         add hl,de
1096         add hl,bc
1097         jr ipop
1098
1099 stl.m2: stl.m4: stl.m6: stl.m8: stl.m10:
1100         ld hl,b_stlm+b_stlm
1101 stl.zrl:sbc hl,de
1102         xor a
1103         sbc hl,de
1104         add hl,bc
1105 ipop:   pop de
1106         ld (hl),e
1107         inc hl
1108         ld (hl),d
1109         jr loop
1110
1111 stl.wm1:ld iy,ipop
1112         jr loms
1113 stl.n:  ld iy,ipop
1114         jr loml
1115 stl.w0: ld iy,ipop
1116         jr lops
1117 stl.p:  ld iy,ipop
1118         jr lopl
1119
1120
1121
1122
1123 ! STE
1124
1125 ste.w3: inc d
1126 ste.w2: inc d
1127 ste.w1: inc d
1128 ste.w0: ld e,(ix)
1129         inc ix
1130         ld hl,eb
1131         add hl,de
1132         add hl,de
1133         jr ipop
1134
1135 ste.l:  ld d,(ix)
1136         inc ix
1137         jr ste.w0
1138
1139
1140
1141 ! STF
1142 stf.2: stf.4: stf.6:
1143         ld hl,-b_stf-b_stf
1144         add hl,de
1145         add hl,de
1146  1:     pop de
1147         add hl,de
1148         jr ipop
1149
1150 stf.s0: ld h,d
1151  2:     ld l,(ix)
1152         inc ix
1153         jr 1b
1154
1155 stf.l:  ld h,(ix)
1156         inc ix
1157         jr 2b
1158
1159
1160
1161 ! SIL
1162 1:      ld e,(hl)
1163         inc hl
1164         ld h,(hl)
1165         ld l,e
1166         jr ipop
1167
1168 sil.wm1:ld iy,1b
1169         jr loms
1170 sil.n:  ld iy,1b
1171         jr loml
1172 sil.w0: ld iy,1b
1173         jr lops
1174 sil.p:  ld iy,1b
1175         jr lopl
1176
1177
1178 ! STI, STS
1179 sts.z:
1180         ld iy,sts.2
1181         jr pop2
1182 sts.l:  call long2
1183 sts.2:  pop de
1184 sti:    pop hl
1185         srl d
1186         rr e
1187         jr nc,1f
1188         ld a,e
1189         or d
1190         jr nz,eilsize
1191         pop de          ! here the 1-byte case is caught
1192         ld (hl),e
1193         jr loop
1194 1:      push bc
1195         pop iy
1196 2:      pop bc
1197         ld (hl),c
1198         inc hl
1199         ld (hl),b
1200         inc hl
1201         dec de
1202         ld a,e
1203         or d
1204         jr nz,2b
1205         jr loiend
1206
1207 sti.1: sti.2: sti.4: sti.6: sti.8:
1208         ld hl,-b_sti-b_sti
1209         add hl,de
1210         adc hl,de       ! again we use that the carry is cleared
1211         jr nz,1f
1212         inc hl          ! in case sti.0 object size is 1 byte!
1213 1:      ex de,hl
1214         jr sti
1215
1216 sti.l:  ld d,(ix)
1217         inc ix
1218 sti.s0: ld e,(ix)
1219         inc ix
1220         jr  sti
1221
1222
1223 ! SDL
1224 sdl.wm1:ld iy,1f
1225         jr loms
1226 sdl.n:  ld iy,1f
1227         jr loml
1228 sdl.w0: ld iy,1f
1229         jr lops
1230 sdl.p:  ld iy,1f
1231         jr lopl
1232
1233
1234 ! SDE
1235 sde.l:  ld d,(ix)
1236         inc ix
1237         ld e,(ix)
1238         inc ix
1239         ld hl,eb
1240 2:      add hl,de
1241 1:      pop de
1242         ld (hl),e
1243         inc hl
1244         ld (hl),d
1245         inc hl
1246         jr ipop
1247
1248
1249 ! SDF
1250 sdf.l:  ld d,(ix)
1251         inc ix
1252         ld e,(ix)
1253         inc ix
1254         pop hl
1255         jr 2b
1256
1257
1258 !------------------------- SINGLE PRECISION ARITHMETIC ---------------
1259
1260 ! ADI, ADP, ADS, ADU
1261
1262 adi.z: adu.z:
1263         pop de
1264 9:
1265         call chk24
1266         .data2 adi.2,adi.4
1267 adi.l: adu.l:
1268         ld d,(ix)       ! I guess a routine chk24.l could do this job
1269         inc ix
1270         ld e,(ix)
1271         inc ix
1272         jr 9b
1273 ads.z:
1274         ld iy,adi.2
1275         jr pop2
1276 ads.l:
1277         call long2
1278 ads.2: adi.2: adu.2:
1279         pop de
1280 1:      pop hl
1281         add hl,de
1282         jr phl
1283
1284 adp.l:  ld d,(ix)
1285         inc ix
1286         ld e,(ix)
1287         inc ix
1288         jr 1b
1289
1290 adp.sm1:dec d
1291 adp.s0: ld e,(ix)
1292         inc ix
1293         jr 1b
1294
1295 adp.2:  pop hl
1296         inc hl
1297         jr 1f
1298 inc.z:
1299 adp.1:  pop hl
1300 1:      inc hl
1301         jr phl
1302
1303
1304 ! SBI, SBP, SBS, SBU    (but what is SBP?)
1305
1306 sbi.z: sbu.z:
1307         pop de
1308 9:
1309         call chk24
1310         .data2 sbi.2,sbi.4
1311 sbi.l: sbu.l:
1312         ld d,(ix)
1313         inc ix
1314         ld e,(ix)
1315         inc ix
1316         jr 9b
1317 sbs.z:
1318         ld iy,sbi.2
1319         jr pop2
1320 sbs.l:
1321         call long2
1322 sbi.2:
1323         pop de
1324         pop hl
1325         sbc hl,de
1326         jr phl
1327
1328
1329 ! NGI
1330 ngi.z:
1331         pop de
1332 9:
1333         call chk24
1334         .data2 ngi.2,ngi.4
1335 ngi.l:
1336         ld d,(ix)
1337         inc ix
1338         ld e,(ix)
1339         inc ix
1340         jr 9b
1341 ngi.2:  ld hl,0
1342         pop de
1343         sbc hl,de
1344         jr phl
1345
1346
1347 ! MLI, MLU      Johan version
1348 mli.z: mlu.z:
1349         pop de
1350 9:
1351         call chk24
1352         .data2 mli.2,mli.4
1353 mli.l: mlu.l:
1354         ld d,(ix)
1355         inc ix
1356         ld e,(ix)
1357         inc ix
1358         jr 9b
1359 mli.2: mlu.2:
1360         ld iy,loop
1361 mliint: pop de
1362         pop hl
1363         push bc
1364         ld b,h
1365         ld c,l
1366         ld hl,0
1367         ld a,16
1368 0:
1369         bit 7,d
1370         jr z,1f
1371         add hl,bc
1372 1:
1373         dec a
1374         jr z,2f
1375         ex de,hl
1376         add hl,hl
1377         ex de,hl
1378         add hl,hl
1379         jr 0b
1380 2:
1381         pop bc
1382         push hl
1383         jp (iy)
1384
1385
1386 ! DVI, DVU
1387 dvi.z:
1388         pop de
1389 9:
1390         call chk24
1391         .data2 dvi.2,dvi.4
1392 dvi.l:
1393         ld d,(ix)
1394         inc ix
1395         ld e,(ix)
1396         inc ix
1397         jr 9b
1398 dvi.2:
1399         pop     hl
1400         pop     de
1401         push    bc
1402         ld      b,h
1403         ld      c,l
1404         xor     a
1405         ld      h,a
1406         ld      l,a
1407         sbc     hl,bc
1408         jp      m,1f
1409         ld      b,h
1410         ld      c,l
1411         cpl
1412 1:
1413         or      a
1414         ld      hl,0
1415         sbc     hl,de
1416         jp      m,1f
1417         ex      de,hl
1418         cpl
1419 1:
1420         push    af
1421         ld      hl,0
1422         ld      a,16
1423 0:
1424         add     hl,hl
1425         ex      de,hl
1426         add     hl,hl
1427         ex      de,hl
1428         jr      nc,1f
1429         inc     hl
1430         or      a
1431 1:
1432         sbc     hl,bc
1433         inc     de
1434         jp      p,2f
1435         add     hl,bc
1436         dec     de
1437 2:
1438         dec     a
1439         jr      nz,0b
1440         pop     af
1441         or      a
1442         jr      z,1f
1443         ld      hl,0
1444         sbc     hl,de
1445         ex      de,hl
1446 1:
1447         pop     bc
1448         push    de
1449         jr      loop
1450
1451
1452 dvu.z:
1453         pop de
1454 9:
1455         call chk24
1456         .data2 dvu.2,dvu.4
1457 dvu.l:
1458         ld d,(ix)
1459         inc ix
1460         ld e,(ix)
1461         inc ix
1462         jr 9b
1463 dvu.2:
1464         pop     hl
1465         pop     de
1466         push    bc
1467         ld      b,h
1468         ld      c,l
1469         ld      hl,0
1470         ld      a,16
1471 0:
1472         add     hl,hl
1473         ex      de,hl
1474         add     hl,hl
1475         ex      de,hl
1476         jr      nc,1f
1477         inc     hl
1478         or      a
1479 1:
1480         sbc     hl,bc
1481         inc     de
1482         jp      p,2f
1483         add     hl,bc
1484         dec     de
1485 2:
1486         dec     a
1487         jr      nz,0b
1488         pop     bc
1489         push    de
1490         jr loop
1491
1492
1493 ! RMI, RMU
1494 rmi.z:
1495         pop de
1496 9:
1497         call chk24
1498         .data2 rmi.2,rmi.4
1499 rmi.l:
1500         ld d,(ix)
1501         inc ix
1502         ld e,(ix)
1503         inc ix
1504         jr 9b
1505 rmi.2:
1506         pop     hl
1507         pop     de
1508         push    bc
1509         ld      b,h
1510         ld      c,l
1511         xor     a
1512         ld      h,a
1513         ld      l,a
1514         sbc     hl,bc
1515         jp      m,1f
1516         ld      b,h
1517         ld      c,l
1518 1:
1519         or      a
1520         ld      hl,0
1521         sbc     hl,de
1522         jp      m,1f
1523         ex      de,hl
1524         cpl
1525 1:
1526         push    af
1527         ld      hl,0
1528         ld      a,16
1529 0:
1530         add     hl,hl
1531         ex      de,hl
1532         add     hl,hl
1533         ex      de,hl
1534         jr      nc,1f
1535         inc     hl
1536         or      a
1537 1:
1538         sbc     hl,bc
1539         inc     de
1540         jp      p,2f
1541         add     hl,bc
1542         dec     de
1543 2:
1544         dec     a
1545         jr      nz,0b
1546         ex      de,hl
1547         pop     af
1548         or      a
1549         jr      z,1f
1550         ld      hl,0
1551         sbc     hl,de
1552         ex      de,hl
1553 1:
1554         pop     bc
1555         push    de
1556         jr      loop
1557
1558
1559 rmu.4:
1560         ld iy,.dvu4
1561         jr 1f
1562 rmi.4:
1563         ld iy,.dvi4
1564 1:
1565         ld (retarea),bc
1566         ld (retarea+2),ix
1567         ld hl,1f
1568         push hl
1569         push iy
1570         ret
1571 1:
1572         pop hl
1573         pop hl
1574         push bc
1575         push de
1576         ld bc,(retarea)
1577         ld ix,(retarea+2)
1578         jr loop
1579 rmu.z:
1580         pop de
1581 9:
1582         call chk24
1583         .data2 rmu.2,rmu.4
1584 rmu.l:
1585         ld d,(ix)
1586         inc ix
1587         ld e,(ix)
1588         inc ix
1589         jr 9b
1590 rmu.2:
1591         pop     hl
1592         pop     de
1593         push    bc
1594         ld      b,h
1595         ld      c,l
1596         ld      hl,0
1597         ld      a,16
1598 0:
1599         add     hl,hl
1600         ex      de,hl
1601         add     hl,hl
1602         ex      de,hl
1603         jr      nc,1f
1604         inc     hl
1605         or      a
1606 1:
1607         sbc     hl,bc
1608         inc     de
1609         jp      p,2f
1610         add     hl,bc
1611         dec     de
1612 2:
1613         dec     a
1614         jr      nz,0b
1615         pop     bc
1616         jr      phl
1617
1618 ! SLI, SLU
1619
1620 slu.z: sli.z:
1621         pop de
1622 9:
1623         call chk24
1624         .data2 sli.2,sli.4
1625 slu.l:
1626 sli.l:
1627         ld d,(ix)
1628         inc ix
1629         ld e,(ix)
1630         inc ix
1631         jr 9b
1632 sli.2:
1633         pop de
1634         pop hl
1635         ld a,d
1636         or a
1637         jr z,1f
1638         ld e,15
1639 2:      add hl,hl
1640 1:      dec e
1641         jp m,phl
1642         jr 2b
1643
1644 sli.4:
1645 slu.4:
1646         pop de
1647         pop iy
1648         pop hl
1649         inc d
1650         dec d
1651         jr z,1f
1652         ld e,31
1653 1:
1654         dec e
1655         jp m,2f
1656         add iy,iy
1657         adc hl,hl
1658         jr 1b
1659 2:
1660         push hl
1661         push iy
1662         jr loop
1663
1664 ! SRI, SRU
1665
1666 sri.z:
1667         pop de
1668 9:
1669         call chk24
1670         .data2 sri.2,sri.4
1671 sri.l:
1672         ld d,(ix)
1673         inc ix
1674         ld e,(ix)
1675         inc ix
1676         jr 9b
1677 sri.2:  pop de
1678         pop hl
1679         ld a,d
1680         or a
1681         jr z,1f
1682         ld e,15
1683 2:      sra h
1684         rr l
1685 1:      dec e
1686         jp m,phl
1687         jr 2b
1688
1689
1690 sri.4:
1691         pop de
1692         ld a,e
1693         inc d
1694         dec d
1695         pop de
1696         pop hl
1697         jr z,1f
1698         ld a,31
1699 1:
1700         dec a
1701         jp m,2f
1702         sra h
1703         rr l
1704         rr d
1705         rr e
1706         jr 1b
1707 2:
1708         push hl
1709         push de
1710         jr loop
1711
1712 sru.z:
1713         pop de
1714 9:
1715         call chk24
1716         .data2 sru.2,sru.4
1717 sru.l:
1718         ld d,(ix)
1719         inc ix
1720         ld e,(ix)
1721         inc ix
1722         jr 9b
1723 sru.2:  pop de
1724         pop hl
1725         ld a,d
1726         or a
1727         jr z,1f
1728         ld e,15
1729 2:      srl h
1730         rr l
1731 1:      dec e
1732         jp m,phl
1733         jr 2b
1734
1735 sru.4:
1736         pop de
1737         ld a,e
1738         inc d
1739         dec d
1740         pop de
1741         pop hl
1742         jr z,1f
1743         ld a,31
1744 1:
1745         dec a
1746         jp m,2f
1747         srl h
1748         rr l
1749         rr d
1750         rr e
1751         jr 1b
1752 2:
1753         push hl
1754         push de
1755         jr loop
1756
1757 ! ROL, ROR
1758 rol.z:
1759         pop de
1760 9:
1761         call chk24
1762         .data2 rol.2,rol.4
1763 rol.l:
1764         ld d,(ix)
1765         inc ix
1766         ld e,(ix)
1767         inc ix
1768         jr 9b
1769 rol.2:  pop de
1770         pop hl
1771         ld a,e
1772         and 15
1773         jr z,phl
1774         ld de,0
1775 1:      add hl,hl
1776         adc hl,de
1777         dec a
1778         jr nz,1b
1779         jr phl
1780
1781
1782 rol.4:
1783         pop de
1784         pop iy
1785         pop hl
1786         ld a,e
1787         and 31
1788         jr z,3f
1789 1:
1790         add iy,iy
1791         adc hl,hl
1792         jr nc,2f
1793         inc iy
1794 2:
1795         dec a
1796         jr nz,1b
1797 3:
1798         push hl
1799         push iy
1800
1801 ror.z:
1802         pop de
1803 9:
1804         call chk24
1805         .data2 ror.2,ror.4
1806 ror.l:
1807         ld d,(ix)
1808         inc ix
1809         ld e,(ix)
1810         inc ix
1811         jr 9b
1812 ror.2:  pop de
1813         pop hl
1814         ld a,e
1815         and 15
1816         jr z,phl
1817 1:      srl h
1818         rr l
1819         jr nc,2f
1820         set 7,h
1821 2:      dec a
1822         jr nz,1b
1823         jr phl
1824
1825
1826 ror.4:
1827         pop de
1828         ld a,e
1829         pop de
1830         pop hl
1831         and 31
1832         jr z,0f
1833 1:
1834         srl h
1835         rr l
1836         rr d
1837         rr e
1838         jr nc,2f
1839         set 7,h
1840 2:
1841         dec a
1842         jr nz,1b
1843 0:
1844         push hl
1845         push de
1846         jr loop
1847 pop2:   ld de,2
1848         pop hl
1849         sbc hl,de
1850         jr nz,eilsize
1851         xor a
1852         ld d,a
1853         jp (iy)
1854
1855
1856 chk24:
1857         ! this routine is used to call indirectly
1858         ! a routine for either 2 or 4 byte operation
1859         ! ( e.g. mli.2 or mli.4)
1860         ! de contains 2 or 4
1861         ! iy points to a descriptor containing
1862         ! the addresses of both routines
1863         pop iy          ! address of descriptor
1864         ld a,d          ! high byte must be 0
1865         or a
1866         jr nz,unimpld
1867         ld a,e
1868         cp 2
1869         jr z,1f
1870         inc iy
1871         inc iy          ! points to word containing
1872                         ! address of 4 byte routine
1873         cp 4
1874         jr nz,unimpld
1875 1:
1876         ld h,(iy+1)
1877         ld l,(iy)
1878         xor a
1879         jp (hl)
1880 !--------------------- INCREMENT, DECREMENT, ZERO ----------------------
1881
1882 ! INC
1883 inl.m2: inl.m4: inl.m6:
1884         ld hl, b_inl+b_inl
1885         sbc hl,de
1886         xor a
1887         sbc hl,de
1888         add hl,bc
1889 1:      inc (hl)
1890         jr nz,loop
1891         inc hl
1892         inc (hl)
1893         jr loop
1894
1895 inl.wm1:ld iy,1b
1896         jr loms
1897 inl.n:  ld iy,1b
1898         jr loml
1899 inl.p:  ld iy,1b
1900         jr lopl
1901
1902
1903 ! INE
1904
1905 ine.w3: inc d
1906 ine.w2: inc d
1907 ine.w1: inc d
1908 ine.w0: ld e,(ix)
1909         inc ix
1910         ld hl,eb
1911         add hl,de
1912         add hl,de
1913         jr 1b
1914
1915 ine.l:  ld d,(ix)
1916         inc ix
1917         jr ine.w0
1918
1919
1920 ! DEC
1921 dec.z:  pop hl
1922         dec hl
1923         push hl
1924         jr loop
1925
1926 1:      ld e,(hl)
1927         inc hl
1928         ld d,(hl)
1929         dec de
1930         ld (hl),d
1931         dec hl
1932         ld (hl),e
1933         jr loop
1934
1935 del.wm1:ld iy,1b
1936         jr loms
1937 del.n:  ld iy,1b
1938         jr loml
1939 del.p:  ld iy,1b
1940         jr lopl
1941
1942
1943 ! DEE
1944
1945 dee.w3: inc d
1946 dee.w2: inc d
1947 dee.w1: inc d
1948 dee.w0: ld e,(ix)
1949         inc ix
1950         ld hl,eb
1951         add hl,de
1952         add hl,de
1953         jr 1b
1954
1955 dee.l:  ld d,(ix)
1956         inc ix
1957         jr dee.w0
1958
1959
1960 ! ZERO
1961 zri2: zru2:
1962         ld h,d
1963         ld l,d
1964         jr phl
1965
1966
1967 zrf.z:
1968 zer.z:  pop de
1969 2:      ld hl,0
1970         sra d
1971         rr e
1972 1:      push hl
1973         dec de
1974         ld a,e
1975         or d
1976         jr nz,1b
1977         jr loop
1978
1979 zrf.l:
1980 zer.l:  ld d,(ix)
1981         inc ix
1982 zer.s0: ld e,(ix)
1983         inc ix
1984         jr 2b
1985
1986
1987 zrl.m2: zrl.m4:
1988         ld h,d
1989         ld l,d
1990         push hl
1991         ld hl,b_zrl+b_zrl
1992         jr stl.zrl
1993
1994 zrl.wm1:
1995         ld h,d
1996         ld l,d
1997         push hl
1998         jr stl.wm1
1999
2000 zrl.n:
2001         ld h,d
2002         ld l,d
2003         push hl
2004         jr stl.n
2005
2006 zrl.w0:
2007         ld h,d
2008         ld l,d
2009         push hl
2010         jr stl.w0
2011
2012 zrl.p:
2013         ld h,d
2014         ld l,d
2015         push hl
2016         jr stl.p
2017
2018
2019
2020 zre.w0:
2021         ld h,d
2022         ld l,d
2023         push hl
2024         jr ste.w0
2025
2026 zre.l:
2027         ld h,d
2028         ld l,d
2029         push hl
2030         jr ste.l
2031
2032
2033 ! ------------------------- CONVERT GROUP ------------------------------
2034
2035 ! CII, CIU
2036 cii.z: ciu.z:
2037         pop hl
2038         pop de
2039         sbc hl,de       ! hl and de can only have values 2 or 4, that's
2040                         ! why a single subtract can split the 3 cases
2041         jr z,loop       ! equal, so do nothing
2042         jp p,2f
2043 3:      pop hl          ! smaller, so shrink size from double to single
2044         pop de
2045         jr phl
2046 2:      pop hl          ! larger, so expand (for cii with sign extend)
2047         res 1,e
2048         bit 7,h
2049         jr z,1f
2050         dec de
2051 1:      push de
2052         jr phl
2053
2054 ! CUI, CUU
2055 cui.z: cuu.z:
2056         pop hl
2057         pop de
2058         sbc hl,de
2059         jr z,loop
2060         jp m,3b
2061         res 1,e
2062         pop hl
2063         jr 1b
2064
2065
2066 ! ------------------------------ SETS ---------------------------------
2067
2068 ! SET
2069 set.z:  pop hl
2070 doset:  pop de
2071         push bc
2072         pop iy
2073         ld b,h
2074         ld c,l
2075         xor a
2076 0:      push af
2077         inc sp
2078         dec c
2079         jr nz,0b
2080         dec b
2081         jp p,0b
2082         push iy
2083         pop bc
2084         ex de,hl
2085         ld a,l
2086         sra h
2087         jp m,unimpld
2088         rr l
2089         sra h
2090         rr l
2091         sra h
2092         rr l
2093         push hl
2094         or a
2095         sbc hl,de
2096         pop hl
2097         jp p,unimpld
2098         add hl,sp
2099         ld (hl),1
2100         and 7
2101         jr 1f
2102 0:      sla (hl)
2103         dec a
2104 1:      jr nz,0b
2105         jr loop
2106
2107 set.l:  ld d,(ix)
2108         inc ix
2109 set.s0: ld e,(ix)
2110         inc ix
2111         ex de,hl
2112         jr doset
2113
2114
2115 ! INN
2116 inn.z:  pop hl
2117         jr 1f
2118 inn.l:  ld d,(ix)
2119         inc ix
2120 inn.s0: ld e,(ix)
2121         inc ix
2122         ex de,hl
2123 1:
2124         pop de
2125         add hl,sp
2126         push hl
2127         pop iy
2128         ex de,hl
2129         ld a,l
2130         sra h
2131         jp m,0f
2132         rr l
2133         sra h
2134         rr l
2135         sra h
2136         rr l
2137         add hl,sp
2138         push hl
2139         or a            ! clear carry
2140         sbc hl,de
2141         pop hl
2142         jp m,1f
2143 0:      xor a
2144         jr 4f
2145 1:      ld e,(hl)
2146         and 7
2147         jr 2f
2148 3:      rrc e
2149         dec a
2150 2:      jr nz,3b
2151         ld a,e
2152         and 1
2153 4:      ld l,a
2154         ld h,0
2155         ld sp,iy
2156         jr phl
2157
2158
2159
2160 ! ------------------------- LOGICAL GROUP -----------------------------
2161
2162 ! AND
2163 and.z:  pop de
2164 doand:  ld h,d
2165         ld l,e
2166         add hl,sp
2167         push bc
2168         ld b,h
2169         ld c,l
2170         ex de,hl
2171         add hl,de
2172 1:      dec hl
2173         dec de
2174         ld a,(de)
2175         and (hl)
2176         ld (hl),a
2177         xor a
2178         sbc hl,bc
2179         jr z,2f
2180         add hl,bc
2181         jr 1b
2182 2:      ld h,b
2183         ld l,c
2184         pop bc
2185         ld sp,hl
2186         jr loop
2187
2188 and.l:  ld d,(ix)
2189         inc ix
2190 and.s0: ld e,(ix)
2191         inc ix
2192         jr doand
2193
2194 and.2:  ld e,2
2195         jr doand
2196
2197 ! IOR
2198 ior.z:  pop de
2199 ior:    ld h,d
2200         ld l,e
2201         add hl,sp
2202         push bc
2203         ld b,h
2204         ld c,l
2205         ex de,hl
2206         add hl,de
2207 1:      dec hl
2208         dec de
2209         ld a,(de)
2210         or (hl)
2211         ld (hl),a
2212         xor a
2213         sbc hl,bc
2214         jr z,2f
2215         add hl,bc
2216         jr 1b
2217 2:      ld h,b
2218         ld l,c
2219         pop bc
2220         ld sp,hl
2221         jr loop
2222
2223 ior.l:  ld d,(ix)
2224         inc ix
2225 ior.s0: ld e,(ix)
2226         inc ix
2227         jr ior
2228
2229 ior.2:  ld e,2
2230         jr ior
2231
2232 ! XOR
2233 xor.z:  pop de
2234 exor:   ld h,d
2235         ld l,e
2236         add hl,sp
2237         push bc
2238         ld b,h
2239         ld c,l
2240         ex de,hl
2241         add hl,de
2242 1:      dec hl
2243         dec de
2244         ld a,(de)
2245         xor (hl)
2246         ld (hl),a
2247         xor a
2248         sbc hl,bc
2249         jr z,2f
2250         add hl,bc
2251         jr 1b
2252 2:      ld h,b
2253         ld l,c
2254         pop bc
2255         ld sp,hl
2256         jr loop
2257
2258 xor.l:  ld d,(ix)
2259         inc ix
2260         ld e,(ix)
2261         inc ix
2262         jr exor
2263
2264 ! COM
2265 com.z:  pop hl
2266 com:    add hl,sp
2267 1:      dec hl
2268         ld a,(hl)
2269         cpl
2270         ld (hl),a
2271         xor a
2272         sbc hl,sp
2273         jr z,loop
2274         add hl,sp
2275         jr 1b
2276
2277 com.l:  ld d,(ix)
2278         inc ix
2279         ld e,(ix)
2280         inc ix
2281         ex de,hl
2282         jr com
2283
2284
2285 ! ------------------------- COMPARE GROUP ------------------------------
2286
2287 ! CMI
2288
2289
2290 cmi.2:  pop de
2291         pop hl
2292         ld a,h
2293         xor d           ! check sign bit to catch overflow with subtract
2294         jp m,1f
2295         sbc hl,de
2296         jr phl
2297 1:      xor d           ! now a equals (original) h again
2298         jp m,phl
2299         set 0,l         ! to catch case hl=0>de bit 0 is set explicitly
2300         jr phl
2301
2302
2303
2304 ! CMU, CMP
2305
2306 cmi.4:  inc a
2307         ld de,4
2308         jr docmu
2309 cmp.z:  ld de,2
2310         jr docmu
2311 cmi.z:  inc a
2312 cmu.z:
2313         pop de
2314         jr docmu
2315
2316 cmi.l:  inc a
2317 cmu.l:  ld d,(ix)
2318         inc ix
2319         ld e,(ix)
2320         inc ix
2321 docmu:  push bc
2322         pop iy
2323         ld b,d
2324         ld c,e
2325         ld hl,0
2326         add hl,sp
2327         add hl,bc
2328         dec hl
2329         ld d,h
2330         ld e,l
2331         add hl,bc
2332         ld (retarea),hl         ! save new sp-1
2333         or a
2334         jr z,1f
2335         ld a,(de)
2336         cp (hl)
2337         dec hl
2338         dec de
2339         dec bc
2340         jr z,1f
2341         jp p,4f
2342         jp pe,5f
2343         jr 6f
2344 1:
2345         ld a,(de)
2346         cp (hl)
2347         dec de
2348         dec hl
2349         dec bc
2350         jr nz,2f
2351         ld a,b
2352         or c
2353         jr nz,1b
2354         ld d,a
2355         ld e,a
2356         jr 3f
2357 2:
2358         jr nc,5f
2359 6:
2360         ld de,1
2361         jr 3f
2362 4:
2363         jp pe,6b
2364 5:
2365         ld de,-1
2366 3:
2367         ld hl,(retarea)
2368         inc hl
2369         ld sp,hl
2370         push de
2371         push iy
2372         pop bc
2373         jr loop
2374
2375
2376
2377 ! CMS
2378
2379 cms.z:  pop hl
2380         jr 1f
2381 cms.l:  ld d,(ix)
2382         inc ix
2383 cms.s0: ld e,(ix)
2384         inc ix
2385         ex de,hl
2386 1:      push bc
2387         pop iy
2388         ld b,h
2389         ld c,l
2390         add hl,sp
2391 0:
2392         dec sp
2393         pop af
2394         cpi
2395         jr nz,1f
2396         ld a,b
2397         or c
2398         jr nz,0b
2399         ld de,0
2400         jr 2f
2401 1:
2402         add hl,bc
2403         ld de,1
2404 2:
2405         ld sp,hl
2406         push de
2407         push iy
2408         pop bc
2409         jr loop
2410
2411
2412 ! TLT, TLE, TEQ, TNE, TGE, TGT
2413 tlt.z:
2414         ld h,d
2415         ld l,d
2416         pop de
2417         bit 7,d
2418         jr z,1f
2419         inc l
2420 1:
2421         jr phl
2422
2423 tle.z:  ld hl,1
2424         pop de
2425         xor a
2426         add a,d
2427         jp m,phl
2428         jr nz,1f
2429         xor a
2430         add a,e
2431         jr z,2f
2432 1:      dec l
2433 2:
2434         jr phl
2435
2436 teq.z:
2437         ld h,d
2438         ld l,d
2439         pop de
2440         ld a,d
2441         or e
2442         jr nz,1f
2443         inc l
2444 1:
2445         jr phl
2446
2447 tne.z:
2448         ld h,d
2449         ld l,d
2450         pop de
2451         ld a,d
2452         or e
2453         jr z,1f
2454         inc l
2455 1:
2456         jr phl
2457
2458 tge.z:
2459         ld h,d
2460         ld l,d
2461         pop de
2462         bit 7,d
2463         jr nz,1f
2464         inc l
2465 1:
2466         jr phl
2467
2468 tgt.z:
2469         ld h,d
2470         ld l,d
2471         pop de
2472         xor a
2473         add a,d
2474         jp m,phl
2475         jr nz,1f
2476         xor a
2477         add a,e
2478         jr z,2f
2479 1:      inc l
2480 2:
2481         jr phl
2482
2483
2484 ! ------------------------- BRANCH GROUP -------------------------------
2485
2486 ! BLT, BLE, BEQ, BNE, BGE, BGT, BRA
2487
2488 b.pl:   ld d,(ix)
2489         inc ix
2490 b.ps:   ld e,(ix)
2491         inc ix
2492         push ix
2493         pop hl
2494         add hl,de
2495         pop de
2496         ex (sp),hl
2497         xor a
2498         jp (iy)
2499
2500
2501 bra.l:  ld d,(ix)
2502         inc ix
2503         jr bra.s0
2504
2505 bra.sm2:dec d
2506 bra.sm1:dec d
2507         dec d
2508 bra.s1: inc d
2509 bra.s0: ld e,(ix)
2510         inc ix
2511         add ix,de
2512         jr loop
2513
2514
2515 bgo:    pop ix          ! take branch
2516         jr loop
2517
2518
2519 blt.s0: ld iy,blt
2520         jr b.ps
2521 blt.l:  ld iy,blt
2522         jr b.pl
2523 blt:    ld a,h
2524         xor d
2525         jp m,1f
2526         sbc hl,de
2527         jr 2f
2528 1:      xor d
2529 2:      jp m,bgo
2530         pop de
2531         jr loop
2532
2533
2534 ble.s0: ld iy,ble
2535         jr b.ps
2536 ble.l:  ld iy,ble
2537         jr b.pl
2538 ble:    ex de,hl
2539         jr bge
2540
2541
2542 beq.s0: ld iy,beq
2543         jr b.ps
2544 beq.l:  ld iy,beq
2545         jr b.pl
2546 beq:    sbc hl,de
2547         jr z,bgo
2548         pop de          ! keep stack clean, so dump unused jump address
2549         jr loop
2550
2551
2552 bne.s0: ld iy,bne
2553         jr b.ps
2554 bne.l:  ld iy,bne
2555         jr b.pl
2556 bne:    sbc hl,de
2557         jr nz,bgo
2558         pop de          ! keep stack clean, so dump unused jump address
2559         jr loop
2560
2561
2562 bge.s0: ld iy,bge
2563         jr b.ps
2564 bge.l:  ld iy,bge
2565         jr b.pl
2566 bge:    ld a,h
2567         xor d           ! check sign bit to catch overflow with subtract
2568         jp m,1f
2569         sbc hl,de
2570         jr 2f
2571 1:      xor d           ! now a equals (original) h again
2572 2:      jp p,bgo
2573         pop de          ! keep stack clean, so dump unused jump address
2574         jr loop
2575
2576
2577 bgt.s0: ld iy,bgt
2578         jr b.ps
2579 bgt.l:  ld iy,bgt
2580         jr b.pl
2581 bgt:    ex de,hl
2582         jr blt
2583
2584
2585
2586 ! ZLT, ZLE, ZEQ, ZNE, ZGE, ZGT
2587
2588
2589 z.pl:   ld d,(ix)
2590         inc ix
2591 z.ps:   ld e,(ix)
2592         inc ix
2593         push ix
2594         pop hl
2595         add hl,de
2596         ex de,hl
2597         pop hl
2598         xor a
2599         add a,h
2600         jp (iy)
2601
2602
2603
2604 zlt.l:  ld iy,zlt
2605         jr z.pl
2606 zlt.s0: ld iy,zlt
2607         jr z.ps
2608 zlt:    jp m,zgo
2609         jr loop
2610
2611
2612 zle.l:  ld iy,zle
2613         jr z.pl
2614 zle.s0: ld iy,zle
2615         jr z.ps
2616 zle:    jp m,zgo
2617         jr nz,loop
2618         xor a
2619         add a,l
2620         jr z,zgo
2621         jr loop
2622
2623
2624 zeq.l:  ld iy,zeq
2625         jr z.pl
2626 zeq.s1: inc d
2627 zeq.s0: ld iy,zeq
2628         jr z.ps
2629 zeq:    ld a,l
2630         or h
2631         jr nz,loop
2632 zgo:    push de
2633         pop ix
2634         jr loop
2635
2636
2637 zne.sm1:dec d
2638         jr zne.s0
2639 zne.l:  ld iy,zne
2640         jr z.pl
2641 zne.s0: ld iy,zne
2642         jr z.ps
2643 zne:    ld a,l
2644         or h
2645         jr nz,zgo
2646         jr loop
2647
2648
2649 zge.l:  ld iy,zge
2650         jr z.pl
2651 zge.s0: ld iy,zge
2652         jr z.ps
2653 zge:    jp m,loop
2654         jr zgo
2655
2656
2657 zgt.l:  ld iy,zgt
2658         jr z.pl
2659 zgt.s0: ld iy,zgt
2660         jr z.ps
2661 zgt:    jp m,loop
2662         jr nz,zgo
2663         xor a
2664         add a,l
2665         jr z,loop
2666         jr zgo
2667
2668
2669 ! ------------------- ARRAY REFERENCE GROUP ---------------------------
2670
2671 ! AAR
2672 aar.z:
2673         ld iy,aar.2
2674         jr pop2
2675 aar.l:  call long2
2676 aar.2:  ld hl,loop
2677 aarint: pop iy          ! descriptor
2678         ex (sp),hl      ! save return address and hl:=index
2679         ld e,(iy+0)
2680         ld d,(iy+1)     ! de := lwb
2681         ld a,h
2682         xor d
2683         jp m,1f
2684         sbc hl,de
2685         jr 2f
2686 1:      sbc hl,de
2687         xor d
2688 2:      call m,e.array
2689         ld e,(iy+2)
2690         ld d,(iy+3)     ! de := upb - lwb
2691         push hl
2692         ex de,hl
2693         ld a,h
2694         xor d
2695         jp m,1f
2696         sbc hl,de
2697         jr 2f
2698 1:      xor d
2699 2:      ex de,hl
2700         pop hl
2701         call m,e.array
2702 1:      ld e,(iy+4)
2703         ld d,(iy+5)
2704         pop iy
2705         ex (sp),iy
2706         push iy         ! exchange base address and return address
2707         push de
2708         push de
2709         push hl
2710         ld iy,1f
2711         jr mliint
2712 1:      pop de
2713         pop iy
2714         pop hl
2715         push iy
2716         add hl,de
2717         pop de
2718         ex (sp),hl
2719         jp (hl)
2720
2721 lar.l:  call long2
2722 lar.2:  ld hl,loi
2723         jr aarint
2724 lar.z:
2725         ld iy,lar.2
2726         jr pop2
2727
2728
2729 sar.l:  call long2
2730 sar.2:  ld hl,sti
2731         jr aarint
2732 sar.z:
2733         ld iy,sar.2
2734         jr pop2
2735
2736
2737 ! --------------------- PROCEDURE CALL/RETURN --------------------------
2738
2739 ! CAL
2740
2741 cal.1: cal.2: cal.3: cal.4: cal.5: cal.6: cal.7: cal.8:
2742 cal.9: cal.10: cal.11: cal.12: cal.13: cal.14: cal.15: cal.16:
2743 cal.17: cal.18: cal.19: cal.20: cal.21: cal.22: cal.23: cal.24:
2744 cal.25: cal.26: cal.27: cal.28:
2745         ld hl,-b_cal
2746         add hl,de
2747         ex de,hl
2748         jr cal
2749
2750 cal.l:  ld d,(ix)
2751         inc ix
2752 cal.s0: ld e,(ix)
2753         inc ix
2754 cal:    push ix         ! entry point for main program of interpreter
2755         push bc
2756         ld hl,(eb)
2757         push hl
2758         ld hl,(ebp4)
2759         push hl
2760 ! temporary tracing facility
2761 ! NOP it if you don't want it
2762         push de
2763         ld de,(ebp4)
2764         ld hl,(eb)
2765         call prline
2766         pop de
2767 ! end of temporary tracing
2768         ld hl,0
2769         add hl,sp
2770         ld b,h
2771         ld c,l
2772         ld hl,(pd)
2773         ex de,hl
2774         add hl,hl
2775         add hl,hl
2776         add hl,de
2777         push hl
2778         pop iy
2779         ld e,(iy+0)
2780         ld d,(iy+1)
2781         ld l,c
2782         ld h,b
2783         xor a
2784         sbc hl,de
2785         ld sp,hl
2786         ld e,(iy+2)
2787         ld d,(iy+3)
2788         ld ix,0
2789         add ix,de
2790         jr loop
2791
2792
2793 ! CAI
2794
2795 cai.z:  pop de
2796         jr cal
2797
2798
2799 ! LFR
2800 lfr.z:  pop de
2801 2:      ld a,e
2802         rr a
2803         cp 5
2804         jp p,eilsize    ! only result sizes <= 8 are allowed
2805         ld hl,retarea
2806         add hl,de
2807 1:      dec hl
2808         ld d,(hl)
2809         dec hl
2810         ld e,(hl)
2811         push de
2812         dec a
2813         jr nz,1b
2814         jr loop
2815
2816 lfr.l:  ld d,(ix)
2817         inc ix
2818 lfr.s0: ld e,(ix)
2819         inc ix
2820         jr 2b
2821
2822 lfr.2:  ld hl,(retarea)
2823         jr phl
2824
2825 lfr.4:  ld de,4
2826         jr 2b
2827
2828
2829 ! RET
2830 ret.2:  ld a,1
2831         jr 3f
2832
2833 ret.z:  pop de
2834 2:      ld a,d
2835         or e
2836         jr z,ret.0
2837         rr a
2838         cp 5
2839         jp p,eilsize    ! only result sizes <= 8 bytes are allowed
2840 3:      ld hl,retarea
2841 1:      pop de
2842         ld (hl),e
2843         inc hl
2844         ld (hl),d
2845         inc hl
2846         dec a
2847         jr nz,1b
2848 ret.0:
2849         ld h,b
2850         ld l,c
2851         ld sp,hl
2852         pop hl
2853         ld (ebp4),hl
2854         pop hl
2855         ld (eb),hl
2856         pop bc          ! old LB
2857         pop ix          ! reta
2858         push ix         ! check to see if reta = boot (= 0)
2859         pop hl
2860         ld a,l
2861         or h
2862         jr nz,loop      ! not done yet
2863         call uxfinish
2864         jr boot
2865
2866 ret.l:  ld d,(ix)
2867         inc ix
2868 ret.s0: ld e,(ix)
2869         inc ix
2870         jr 2b
2871
2872
2873 ! ------------------------- MISCELLANEOUS -----------------------------
2874
2875 ! SIG, TRP, RTT
2876
2877 sig.z:
2878         ld hl,(trapproc)
2879         ex (sp),hl
2880         ld (trapproc),hl
2881         jr loop
2882
2883 trp.z:
2884         ex (sp),hl
2885         push de
2886         push af
2887         push ix
2888         push iy
2889         push bc
2890 !       ld iy,trapproc
2891 !       ld a,(iy)
2892 !       or (iy+1)
2893 !       jr nz,1f
2894         ld iy,2f+13
2895         call octnr
2896         ld c,printstring
2897         ld de,2f
2898         call bdos
2899         ld de,(ebp4)
2900         ld hl,(eb)
2901         call prline
2902 0:
2903         pop iy          ! LB
2904         ld a,(iy+6)
2905         or (iy+7)       ! reta
2906         jr nz,3f
2907         call uxfinish
2908         jp boot
2909 3:
2910         ld c,(iy+4)
2911         ld b,(iy+5)
2912         push bc         ! next LB
2913         ld e,(iy)
2914         ld d,(iy+1)     ! file name
2915         ld l,(iy+2)
2916         ld h,(iy+3)     ! lineno
2917         call prline
2918         jr 0b
2919 !1:
2920 !       ld ix,0
2921 !       push hl
2922 !       ld hl,(trapproc)
2923 !       push hl
2924 !       ld hl,0
2925 !       ld (trapproc),hl
2926 !       jr cai.z
2927 2:      .ascii 'error 0xxxxxx\r\n$'
2928
2929 prline:
2930 ! prints lineno (hl) and filename (de)
2931         push de
2932         ld iy,2f+12
2933         call octnr
2934         ld c,printstring
2935         ld de,2f
2936         call bdos
2937         pop de
2938         ld hl,4f
2939 0:
2940         ld a,(de)
2941         or a
2942         jr z,1f
2943         ld (hl),a
2944         inc de
2945         inc hl
2946         jr 0b
2947 1:
2948         ld (hl),36      ! '$'
2949         ld de,4f
2950         ld c,printstring
2951         call bdos
2952         ld de,3f
2953         ld c,printstring
2954         call bdos
2955         ret
2956 2:      .ascii 'line 0xxxxxx in $'
2957 3:      .ascii '\r\n$'
2958 4:      .space 12
2959
2960 rtt.z=ret.0
2961
2962
2963
2964 ! NOP
2965 ! changed into output routine to print linenumber
2966 ! in octal (6 digits)
2967
2968 nop.z:  push bc
2969         ld iy,1f+12
2970         ld hl,(eb)
2971         call octnr
2972         ld iy,1f+20
2973         ld hl,0
2974         add hl,sp
2975         call octnr
2976         ld c,printstring
2977         ld de,1f
2978         call bdos
2979         pop bc
2980         jr loop
2981 1:      .ascii 'test 0xxxxxx 0xxxxxx\r\n$'
2982
2983 octnr:
2984         ld b,6
2985 1:      ld a,7
2986         and l
2987         add a,'0'
2988         dec iy
2989         ld (iy+0),a
2990         srl h
2991         rr l
2992         srl h
2993         rr l
2994         srl h
2995         rr l
2996         djnz 1b
2997         ret
2998
2999
3000 ! DUP
3001
3002 dup.2:  pop hl
3003         push hl
3004         jr phl
3005
3006 dus.z:
3007         ld iy,1f
3008         jr pop2
3009 dus.l:  call long2
3010 1:      push bc
3011         pop iy
3012         pop bc
3013         jr dodup
3014 dup.l:
3015         push bc
3016         pop iy
3017         ld b,(ix)
3018         inc ix
3019         ld c,(ix)
3020         inc ix
3021 dodup:  ld h,d
3022         ld l,d          ! ld hl,0
3023         add hl,sp
3024         ld d,h
3025         ld e,l
3026         xor a
3027         sbc hl,bc
3028         ld sp,hl
3029         ex de,hl
3030         ldir
3031         push iy
3032         pop bc
3033         jr loop
3034
3035
3036 ! BLM, BLS
3037 bls.z:
3038         ld iy,blm
3039         jr pop2
3040 bls.l:  call long2
3041 blm:
3042         push bc
3043         pop iy
3044         pop bc
3045         pop de
3046         pop hl
3047         ldir
3048         push iy
3049         pop bc
3050         jr loop
3051
3052 blm.l:
3053         ld d,(ix)
3054         inc ix
3055 blm.s0: ld e,(ix)
3056         inc ix
3057         push de
3058         jr blm
3059
3060
3061 ! ASP, ASS
3062 ass.z:
3063         ld iy,1f
3064         jr pop2
3065 ass.l:  call long2
3066 1:      pop hl
3067         jr 1f
3068 asp.l:
3069         ld h,(ix)
3070         inc ix
3071         ld l,(ix)
3072         inc ix
3073 asp:    add hl,hl
3074 1:      add hl,sp
3075         ld sp,hl
3076         jr loop
3077
3078
3079 asp.2: asp.4: asp.6: asp.8: asp.10:
3080         ld hl,-b_asp
3081         add hl,de
3082         jr asp
3083
3084 asp.w0: ld e,(ix)
3085         inc ix
3086         ex de,hl
3087         jr asp
3088
3089
3090 ! CSA
3091
3092 csa.z:
3093         ld iy,csa.2
3094         jr pop2
3095 csa.l:  call long2
3096 csa.2:
3097 !! temporary version while bug in cem remains
3098 !       pop iy
3099 !       pop de
3100 !       push bc
3101 !       ld c,(iy)
3102 !       ld b,(iy+1)
3103 !       ld l,(iy+4)
3104 !       ld h,(iy+5)
3105 !       xor a
3106 !       sbc hl,de
3107 !       jp m,1f
3108 !       ex de,hl
3109 !       ld e,(iy+2)
3110 !       ld d,(iy+3)
3111 !       xor a
3112 !       sbc hl,de
3113 !       jp m,1f
3114 ! end of temporary piece
3115         pop iy
3116         pop hl
3117         push bc
3118         ld c,(iy)
3119         ld b,(iy+1)
3120         ld e,(iy+2)
3121         ld d,(iy+3)
3122         xor a
3123         sbc hl,de
3124         jp m,1f
3125         ex de,hl
3126         ld l,(iy+4)
3127         ld h,(iy+5)
3128         xor a
3129         sbc hl,de
3130         jp m,1f
3131         ex de,hl
3132         add hl,hl
3133         ld de,6
3134         add hl,de
3135         ex de,hl
3136         add iy,de
3137         ld l,(iy)
3138         ld h,(iy+1)
3139         ld a,h
3140         or l
3141         jr nz,2f
3142 1:      ld a,b
3143         or c
3144         jr z,e.case
3145         ld l,c
3146         ld h,b
3147 2:      pop bc
3148         push hl
3149         pop ix
3150         jr loop
3151 ! CSB
3152
3153 csb.z:
3154         ld iy,csb.2
3155         jr pop2
3156 csb.l:  call long2
3157 csb.2:
3158         pop ix
3159         pop iy
3160         ld e,(ix)
3161         inc ix
3162         ld d,(ix)
3163         inc ix
3164         push de
3165         ex (sp),iy
3166         pop de
3167         push bc
3168         ld c,(ix)
3169         inc ix
3170         ld b,(ix)
3171         inc ix
3172 1:
3173         ld a,b
3174         or c
3175         jr z,noteq
3176         ld a,(ix+0)
3177         cp e
3178         jr nz,2f
3179         ld a,(ix+1)
3180         cp d
3181         jr nz,2f
3182         ld l,(ix+2)
3183         ld h,(ix+3)
3184         jr 3f
3185 2:      inc ix
3186         inc ix
3187         inc ix
3188         inc ix
3189         dec bc
3190         jr 1b
3191 noteq:  push iy
3192         pop hl
3193 3:      ld a,l
3194         or h
3195         jr z,e.case
3196 2:
3197         pop bc
3198         push hl
3199         pop ix
3200         jr loop
3201
3202
3203 ! LIN
3204 lin.l:  ld d,(ix)
3205         inc ix
3206 lin.s0: ld e,(ix)
3207         inc ix
3208         ld (eb),de
3209         jr loop
3210
3211
3212 ! FIL
3213 fil.z:  pop hl
3214 1:
3215         ld (ebp4),hl
3216         jr loop
3217
3218 fil.l:  ld h,(ix)
3219         inc ix
3220         ld l,(ix)
3221         inc ix
3222         ld de,eb
3223         add hl,de
3224         jr 1b
3225
3226
3227 ! LNI
3228 lni.z:  ld hl,(eb)
3229         inc hl
3230         ld (eb),hl
3231         jr loop
3232
3233
3234 ! RCK
3235 rck.z:
3236         ld iy,rck.2
3237         jr pop2
3238 rck.l:  call long2
3239 rck.2:
3240         pop iy
3241 3:      pop hl
3242         push hl
3243         ld e,(iy)
3244         ld d,(iy+1)
3245         ld a,h
3246         xor d           ! check sign bit to catch overflow with subtract
3247         jp m,1f
3248         sbc hl,de
3249         jr 2f
3250 1:      xor d           ! now a equals (original) h again
3251 2:      call m,e.rck
3252         pop de
3253         push de
3254         ld l,(iy+2)
3255         ld h,(iy+3)
3256         ld a,h
3257         xor d           ! check sign bit to catch overflow with subtract
3258         jp m,1f
3259         sbc hl,de
3260         jr 2f
3261 1:      xor d           ! now a equals (original) h again
3262 2:      call m,e.rck
3263         jr loop
3264
3265
3266 ! LIM
3267 lim.z:  ld hl,(ignmask)
3268         jr phl
3269
3270
3271 ! SIM
3272 sim.z:  pop de
3273         ld (ignmask),de
3274         jr loop
3275
3276
3277 ! LOR
3278
3279 lor.s0: ld e,(ix)
3280         inc ix
3281         ld a,d
3282         or e
3283         jr nz,1f
3284         push bc
3285         jr loop
3286 1:      ld hl,-1
3287         adc hl,de
3288         jr nz,1f
3289         add hl,sp
3290         jr phl
3291 1:      ld hl,(hp)
3292         jr phl
3293
3294
3295 ! STR
3296
3297 str.s0: ld e,(ix)
3298         inc ix
3299         ld a,d
3300         or e
3301         jr nz,1f
3302         pop bc
3303         jr loop
3304 1:      pop hl
3305         dec de
3306         ld a,d
3307         or e
3308         jr nz,1f
3309         ld sp,hl
3310         jr loop
3311 1:      ld (hp),hl
3312         jr loop
3313
3314 ! Floating point calling routines
3315
3316 loadfregs:
3317         pop hl
3318         pop de
3319         ld (fpac),de
3320         pop de
3321         ld (fpac+2),de
3322         pop de
3323         ld (fpop),de
3324         pop de
3325         ld (fpop+2),de
3326         jp (hl)
3327
3328 dofltop:
3329         call loadfregs
3330         push bc
3331         push ix
3332         ld hl,1f
3333         push hl
3334         push iy
3335         ret             ! really a call
3336 1:
3337         pop ix
3338         pop bc
3339         ld hl,(fpac+2)
3340         push hl
3341         ld hl,(fpac)
3342         jr phl
3343
3344 pop4:
3345         pop hl
3346         or h
3347         jr nz,9f
3348         ld a,l
3349         cp 4
3350         jr nz,9f
3351         jp (iy)
3352 arg4:
3353         or d
3354         jr nz,9f
3355         ld a,(ix)
3356         inc ix
3357         cp 4
3358         jr nz,9f
3359         jp (iy)
3360 9:      jr unimpld
3361
3362 adf.z:  ld iy,doadf
3363         jr pop4
3364 adf.l:  ld d,(ix)
3365         inc ix
3366 adf.s0: ld iy,doadf
3367         jr arg4
3368 doadf:
3369         ld iy,fpadd     ! routine to call
3370         jr dofltop
3371
3372 sbf.z:  ld iy,dosbf
3373         jr pop4
3374 sbf.l:  ld d,(ix)
3375         inc ix
3376 sbf.s0: ld iy,dosbf
3377         jr arg4
3378 dosbf:
3379         ld iy,fpsub     ! routine to call
3380         jr dofltop
3381
3382 mlf.z:  ld iy,domlf
3383         jr pop4
3384 mlf.l:  ld d,(ix)
3385         inc ix
3386 mlf.s0: ld iy,domlf
3387         jr arg4
3388 domlf:
3389         ld iy,fpmult    ! routine to call
3390         jr dofltop
3391
3392 dvf.z:  ld iy,dodvf
3393         jr pop4
3394 dvf.l:  ld d,(ix)
3395         inc ix
3396 dvf.s0: ld iy,dodvf
3397         jr arg4
3398 dodvf:
3399         ld iy,fpdiv     ! routine to call
3400         jr dofltop
3401
3402 cmf.z:  ld iy,docmf
3403         jr pop4
3404 cmf.l:  ld d,(ix)
3405         inc ix
3406 cmf.s0: ld iy,docmf
3407         jr arg4
3408 docmf:
3409         call loadfregs
3410         push bc
3411         push ix
3412         call fpcmf
3413         pop ix
3414         pop bc
3415         ld hl,(fpac)
3416         jr phl
3417 cfi.z:
3418         pop de
3419         call chk24
3420         .data2 1f,0f
3421 1:      ld iy,1f
3422         jr pop4
3423 1:      pop hl
3424         ld (fpac),hl
3425         pop hl
3426         ld (fpac+2),hl
3427         push bc
3428         push ix
3429         call fpcfi
3430         pop ix
3431         pop bc
3432         ld hl,(fpac)
3433         jr phl
3434 0:      ld iy,1f
3435         jr pop4
3436 1:      pop hl
3437         ld (fpac),hl
3438         pop hl
3439 ld (fpac+2),hl!
3440         push bc
3441         push ix
3442         call fpcfd
3443         jr 8f
3444 cif.z:
3445         ld iy,1f
3446         jr pop4
3447 1:
3448         pop de
3449         call chk24
3450         .data2 1f,0f
3451 1:      pop hl
3452         ld (fpac),hl
3453         push bc
3454         push ix
3455         call fpcif
3456 8:      pop ix
3457         pop bc
3458         ld hl,(fpac+2)
3459         push hl
3460         ld hl,(fpac)
3461         jr phl
3462 0:      pop hl
3463         ld (fpac),hl
3464         pop hl
3465         ld (fpac+2),hl
3466         push bc
3467         push ix
3468         call fpcdf
3469         jr 8b
3470
3471 ngf.l:  ld d,(ix)
3472         inc ix
3473         ld iy,1f
3474         jr arg4
3475 ngf.z:
3476         ld iy,1f
3477         jr pop4
3478 1:      pop hl
3479         ld (fpac),hl
3480         pop hl
3481         ld (fpac+2),hl
3482         push bc
3483         push ix
3484         call fpcomp
3485         jr 8b
3486
3487 fif.z:
3488         ld iy,1f
3489         jr pop4
3490 fif.l:
3491         ld d,(ix)
3492         inc ix
3493         ld iy,1f
3494         jr arg4
3495 1:      call loadfregs
3496         push bc
3497         push ix
3498         call fpfif
3499         pop ix
3500         pop bc
3501         ld hl,(fpac+2)
3502         push hl
3503         ld hl,(fpac)
3504         push hl
3505         ld hl,(fpop+2)
3506         push hl
3507         ld hl,(fpop)
3508         jr phl
3509
3510 fef.z:
3511         ld iy,1f
3512         jr pop4
3513 fef.l:
3514         ld d,(ix)
3515         inc ix
3516         ld iy,1f
3517         jr arg4
3518 1:      pop hl
3519         ld (fpop),hl
3520         pop hl
3521         ld (fpop+2),hl
3522         push bc
3523         push ix
3524         call fpfef
3525         pop ix
3526         pop bc
3527         ld hl,(fpop+2)
3528         push hl
3529         ld hl,(fpop)
3530         push hl
3531         ld hl,(fpac)
3532         jr phl
3533
3534 ! double aritmetic
3535
3536 adi.4:
3537         push bc
3538         pop iy
3539         pop hl
3540         pop de
3541         pop bc
3542         add hl,bc
3543         ex de,hl
3544         pop bc
3545         adc hl,bc
3546         push hl
3547         push de
3548         push iy
3549         pop bc
3550         jr loop
3551 sbi.4:
3552         push bc
3553         pop iy
3554         pop bc
3555         pop de
3556         pop hl
3557         sbc hl,bc
3558         ex de,hl
3559         ld b,h
3560         ld c,l
3561         pop hl
3562 9:
3563         sbc hl,bc
3564         push hl
3565         push de
3566         push iy
3567         pop bc
3568         jr loop
3569 ngi.4:
3570         push bc
3571         pop iy
3572         ld hl,0
3573         pop de
3574         sbc hl,de
3575         ex de,hl
3576         ld hl,0
3577         pop bc
3578         jr 9b
3579 mli.4:
3580         ld iy,.mli4
3581 0:
3582         ld (retarea),bc
3583         ld (retarea+2),ix
3584         ld hl,1f
3585         push hl
3586         push iy
3587         ret
3588 1:
3589         ld bc,(retarea)
3590         ld ix,(retarea+2)
3591         jr loop
3592 dvu.4:
3593         ld iy,.dvu4
3594         jr 0b
3595
3596 dvi.4:
3597         ld iy,.dvi4
3598         jr 0b
3599
3600 ! list of not yet implemented instructions
3601 cuf.z:
3602 cff.z:
3603 cfu.z:
3604 unimpld:                ! used in dispatch table to
3605                         ! catch unimplemented instructions
3606         ld hl,EILLINS
3607 9:      push hl
3608         jr trp.z
3609
3610 eilsize:
3611         ld hl,EILLSIZE
3612         jr 9b
3613
3614 e.case:
3615         ld hl,ECASE
3616         jr 9b
3617 e.mon:
3618         ld hl,EMON
3619         jr 9b
3620 e.array:
3621         push af
3622         ld a,(ignmask)
3623         bit 0,a
3624         jr nz,8f
3625         ld hl,EARRAY
3626         jr 9b
3627 e.rck:
3628         push af
3629         ld a,(ignmask)
3630         bit 1,a
3631         jr nz,8f
3632         ld hl,ERANGE
3633         jr 9b
3634 8:
3635         pop af
3636         ret
3637
3638 long2:  ld a,(ix)
3639         inc ix
3640         or a
3641         jr nz,unimpld
3642         ld a,(ix)
3643         inc ix
3644         cp 2
3645         jr nz,unimpld
3646         xor a           ! clear carry
3647         ret
3648
3649 ! monitor instruction
3650 ! a small collection of UNIX system calls implemented under CP/M
3651
3652         ux_indir=e.mon
3653         ux_fork=e.mon
3654         ux_wait=e.mon
3655         ux_link=e.mon
3656         ux_exec=e.mon
3657         ux_chdir=e.mon
3658         ux_mknod=e.mon
3659         ux_chmod=e.mon
3660         ux_chown=e.mon
3661         ux_break=e.mon
3662         ux_stat=e.mon
3663         ux_seek=e.mon
3664         ux_mount=e.mon
3665         ux_umount=e.mon
3666         ux_setuid=e.mon
3667         ux_getuid=e.mon
3668         ux_stime=e.mon
3669         ux_ptrace=e.mon
3670         ux_alarm=e.mon
3671         ux_fstat=e.mon
3672         ux_pause=e.mon
3673         ux_utime=e.mon
3674         ux_stty=e.mon
3675         ux_gtty=e.mon
3676         ux_access=e.mon
3677         ux_nice=e.mon
3678         ux_sync=e.mon
3679         ux_kill=e.mon
3680         ux_dup=e.mon
3681         ux_pipe=e.mon
3682         ux_times=e.mon
3683         ux_prof=e.mon
3684         ux_unused=e.mon
3685         ux_setgid=e.mon
3686         ux_getgid=e.mon
3687         ux_sig=e.mon
3688         ux_umask=e.mon
3689         ux_chroot=e.mon
3690
3691         EPERM   = 1
3692         ENOENT  = 2
3693         ESRCH   = 3
3694         EINTR   = 4
3695         EIO     = 5
3696         ENXIO   = 6
3697         E2BIG   = 7
3698         ENOEXEC = 8
3699         EBADF   = 9
3700         ECHILD  = 10
3701         EAGAIN  = 11
3702         ENOMEM  = 12
3703         EACCES  = 13
3704         EFAULT  = 14
3705         ENOTBLK = 15
3706         EBUSY   = 16
3707         EEXIST  = 17
3708         EXDEV   = 18
3709         ENODEV  = 19
3710         ENOTDIR = 20
3711         EISDIR  = 21
3712         EINVAL  = 22
3713         ENFILE  = 23
3714         EMFILE  = 24
3715         ENOTTY  = 25
3716         ETXTBSY = 26
3717         EFBIG   = 27
3718         ENOSPC  = 28
3719         ESPIPE  = 29
3720         EROFS   = 30
3721         EMLINK  = 31
3722         EPIPE   = 32
3723         EDOM    = 33
3724 ! Structure of filearea maintained by this implementation
3725 ! First iobuffer of 128 bytes
3726 ! Then the fcb area of 36 bytes
3727 ! The number of bytes left in the buffer, 1 byte
3728 ! The iopointer into the buffer, 2 bytes
3729 ! The openflag 0 unused, 1 reading, 2 writing, 1 byte
3730 ! The filedescriptor starting at 3, 1 byte
3731 ! The number of CTRL-Zs that have been absorbed, 1 byte
3732 ! The byte read after a sequence of CTRL-Zs, 1 byte
3733
3734         maxfiles=8
3735         filesize=128+36+1+2+1+1+1+1
3736
3737         filefcb=0       ! pointers point to fcb
3738         position=33
3739         nleft=36
3740         iopointer=37
3741         openflag=39
3742         fildes=40
3743         zcount=41
3744         zsave=42
3745
3746         .assert [ filefcb] == 0
3747
3748 0:      .space maxfiles*filesize
3749         filearea = 0b+128
3750 sibuf:
3751         .data2 0
3752         .space 82
3753 siptr:  .space 2
3754 saveargs:
3755         .space 128
3756 argv:   .space 40               ! not more than 20 args
3757 argc:   .space 2
3758 ttymode:.data1 9,9,8,21;.data2 06310+RAW*040    ! raw = 040
3759
3760 uxinit:
3761         xor a
3762         ld c,maxfiles
3763         ld hl,0b
3764 1:      ld b,filesize
3765 2:      ld (hl),a
3766         inc hl
3767         djnz 2b
3768         dec c
3769         jr nz,1b
3770         ret
3771
3772 uxfinish:
3773         ld a,maxfiles-1
3774 1:      push af
3775         call closefil
3776         pop af
3777         dec a
3778         cp 0377
3779         jr nz,1b
3780         ret
3781
3782 makeargv:
3783         ld hl,0x80
3784         ld de,saveargs
3785         ld bc,128
3786         ldir
3787         ld hl,saveargs
3788         ld e,(hl)
3789         inc hl
3790         ld d,0
3791         add hl,de
3792         ld (hl),0
3793         ld hl,saveargs+1
3794         ld ix,argv
3795 1:      ld a,(hl)
3796         or a
3797         jr z,9f
3798         cp ' '
3799         jr nz,2f
3800 4:      ld (hl),0
3801         inc hl
3802         jr 1b
3803 2:      ld (ix),l
3804         inc ix
3805         ld (ix),h
3806         inc ix
3807 3:      inc hl
3808         ld a,(hl)
3809         or a
3810         jr z,9f
3811         cp ' '
3812         jr nz,3b
3813         jr 4b
3814 9:      push ix
3815         pop hl
3816         ld de,argv
3817         or a
3818         sbc hl,de
3819         srl h;rr l
3820         ld (argc),hl
3821         ld (ix+0),0
3822         ld (ix+1),0
3823         ret
3824
3825 mon.z:
3826         pop de          ! system call number
3827         xor a
3828         or d
3829         jr nz,unimpld   ! too big
3830         ld a,e
3831         and 0300        ! only 64 system calls
3832         jr nz,unimpld
3833         sla e
3834         ld hl,systab
3835         add hl,de
3836         ld e,(hl)
3837         inc hl
3838         ld d,(hl)
3839         ex de,hl
3840         jp (hl)
3841
3842 systab:
3843         .data2 ux_indir
3844         .data2 ux_exit
3845         .data2 ux_fork
3846         .data2 ux_read
3847         .data2 ux_write
3848         .data2 ux_open
3849         .data2 ux_close
3850         .data2 ux_wait
3851         .data2 ux_creat
3852         .data2 ux_link
3853         .data2 ux_unlink
3854         .data2 ux_exec
3855         .data2 ux_chdir
3856         .data2 ux_time
3857         .data2 ux_mknod
3858         .data2 ux_chmod
3859         .data2 ux_chown
3860         .data2 ux_break
3861         .data2 ux_stat
3862         .data2 ux_seek
3863         .data2 ux_getpid
3864         .data2 ux_mount
3865         .data2 ux_umount
3866         .data2 ux_setuid
3867         .data2 ux_getuid
3868         .data2 ux_stime
3869         .data2 ux_ptrace
3870         .data2 ux_alarm
3871         .data2 ux_fstat
3872         .data2 ux_pause
3873         .data2 ux_utime
3874         .data2 ux_stty
3875         .data2 ux_gtty
3876         .data2 ux_access
3877         .data2 ux_nice
3878         .data2 ux_ftime
3879         .data2 ux_sync
3880         .data2 ux_kill
3881         .data2 unimpld
3882         .data2 unimpld
3883         .data2 unimpld
3884         .data2 ux_dup
3885         .data2 ux_pipe
3886         .data2 ux_times
3887         .data2 ux_prof
3888         .data2 ux_unused
3889         .data2 ux_setgid
3890         .data2 ux_getgid
3891         .data2 ux_sig
3892         .data2 unimpld
3893         .data2 unimpld
3894         .data2 unimpld
3895         .data2 unimpld
3896         .data2 unimpld
3897         .data2 ux_ioctl
3898         .data2 unimpld
3899         .data2 unimpld
3900         .data2 unimpld
3901         .data2 unimpld
3902         .data2 ux_exece
3903         .data2 ux_umask
3904         .data2 ux_chroot
3905         .data2 unimpld
3906         .data2 unimpld
3907
3908 emptyfile:
3909         ! searches for a free filestructure
3910         ! returns pointer in iy, 0 if not found
3911         ld iy,filearea
3912         ld l,maxfiles
3913 1:
3914         xor a
3915         or (iy+openflag)
3916         jr nz,3f
3917         ld a,maxfiles+3
3918         sub l
3919         ld (iy+fildes),a
3920 #ifdef  CPM1
3921         push bc
3922         push iy
3923         ld de,-128
3924         add iy,de
3925         push iy
3926         pop de
3927         ld c,setdma
3928         call bdos
3929         pop iy
3930         pop bc
3931         or a            ! to clear C
3932 #endif
3933         ret
3934 3:
3935         ld de,filesize
3936         add iy,de
3937         dec l
3938         jr nz,1b
3939         scf
3940         ret
3941
3942 findfile:
3943         ld iy,filearea
3944         ld de,filesize
3945 0:
3946         dec a
3947         ret m
3948         add iy,de
3949         jr 0b
3950
3951 getchar:
3952         push bc
3953         push de
3954         push hl
3955         dec (iy+nleft)
3956         jp p,0f
3957         push iy
3958         pop hl
3959         ld de,-128
3960         add hl,de
3961         ld (iy+iopointer),l
3962         ld (iy+iopointer+1),h
3963         ex de,hl
3964         push iy
3965         ld c,setdma
3966         call bdos
3967 #ifdef  CPM1
3968         ld c,seqread
3969 #else
3970         ld c,randomread
3971 #endif
3972         pop de
3973         call bdos
3974         or a
3975         jr z,1f
3976         ld (iy+zcount),0
3977         pop hl
3978         pop de
3979         pop bc
3980         scf
3981         ret
3982 1:
3983         inc (iy+position)
3984         jr nz,2f
3985         inc (iy+position+1)
3986 2:
3987         ld a,127
3988         ld (iy+nleft),a
3989 0:
3990         ld h,(iy+iopointer+1)
3991         ld l,(iy+iopointer)
3992         ld a,(hl)
3993         inc hl
3994         ld (iy+iopointer),l
3995         ld (iy+iopointer+1),h
3996         pop hl
3997         pop de
3998         pop bc
3999         ret
4000         or a
4001
4002 putchar:
4003         push hl
4004         ld h,(iy+iopointer+1)
4005         ld l,(iy+iopointer)
4006         ld (hl),a
4007         dec (iy+nleft)
4008         jr z,0f
4009         inc hl
4010         ld (iy+iopointer+1),h
4011         ld (iy+iopointer),l
4012         pop hl
4013         ret
4014 0:
4015         pop hl
4016 flsbuf:
4017         push hl
4018         push de
4019         push bc
4020         push iy
4021         pop hl
4022         ld de,-128
4023         add hl,de
4024         ld (iy+iopointer+1),h
4025         ld (iy+iopointer),l
4026         ex de,hl
4027         push iy
4028         ld c,setdma
4029         call bdos
4030         pop de
4031 #ifdef  CPM1
4032         ld c,seqwrite
4033 #else
4034         ld c,randomwrite
4035 #endif
4036         call bdos
4037         or a
4038         jr z,1f
4039         pop bc
4040         pop de
4041         pop hl
4042         scf
4043         ret
4044 1:
4045         inc (iy+position)
4046         jr nz,2f
4047         inc (iy+position+1)
4048 2:
4049         ld a,128
4050         ld (iy+nleft),a
4051         ld b,a
4052         push iy
4053         pop hl
4054         ld de,-128
4055         add hl,de
4056         ld a,26                 ! ctrl z
4057 1:      ld (hl),a
4058         inc hl
4059         djnz 1b
4060         pop bc
4061         pop de
4062         pop hl
4063         or a
4064         ret
4065
4066 parsename:
4067         ! parses file name pointed to by hl and fills in fcb
4068         ! of the file pointed to by iy.
4069         ! recognizes filenames as complicated as 'b:file.zot'
4070         ! and as simple as 'x'
4071
4072         push bc
4073         push iy
4074         pop de
4075         xor a
4076         push de
4077         ld b,36         ! sizeof fcb
4078 0:      ld (de),a
4079         inc de
4080         djnz 0b
4081         pop de
4082         inc hl
4083         ld a,(hl)
4084         dec hl
4085         cp ':'          ! drive specified ?
4086         jr nz,1f
4087         ld a,(hl)
4088         inc hl
4089         inc hl
4090         dec a
4091         and 15
4092         inc a           ! now 1<= a <= 16
4093         ld (de),a
4094 1:      inc de
4095         ld b,8          ! filename maximum of 8 characters
4096 1:      ld a,(hl)
4097         or a
4098         jr nz,8f
4099         dec hl
4100         ld a,'.'
4101 8:
4102         inc hl
4103         cp '.'
4104         jr z,2f
4105         and 0177        ! no parity
4106         bit 6,a
4107         jr z,9f
4108         and 0337        ! UPPER case
4109 9:
4110         ld (de),a
4111         inc de
4112         djnz 1b
4113         ld a,(hl)
4114         inc hl
4115         cp '.'
4116         jr z,3f
4117         ld a,' '
4118         ld (de),a
4119         inc de
4120         ld (de),a
4121         inc de
4122         ld (de),a
4123         pop bc
4124         ret             ! filenames longer than 8 are truncated
4125 2:      ld a,' '        ! fill with spaces
4126 0:      ld (de),a
4127         inc de
4128         djnz 0b
4129 3:      ld b,3          ! length of extension
4130 1:      ld a,(hl)
4131         inc hl
4132         or a
4133         jr z,4f
4134         cp 0100
4135         jp m,2f
4136         and 0137
4137 2:      ld (de),a
4138         inc de
4139         djnz 1b
4140         pop bc
4141         ret
4142 4:      ld a,' '
4143 0:      ld (de),a
4144         inc de
4145         djnz 0b
4146         pop bc
4147         ret
4148
4149 ! various routines
4150 ux_close:
4151         pop hl
4152         ld a,l
4153         sub 3
4154         jp m,1f
4155         cp maxfiles
4156         call m,closefil
4157 1:      ld hl,0
4158         jr phl
4159
4160 closefil:
4161         call findfile
4162         ld a,(iy+openflag)
4163         or a
4164         jr z,3f
4165         ld (iy+openflag),0
4166         cp 1
4167         jr z,2f
4168         ld a,(iy+nleft)
4169         cp 128
4170         jr z,2f
4171         call flsbuf
4172 2:
4173         push bc
4174         push iy
4175         pop de
4176         ld c,close
4177         call bdos
4178         pop bc
4179 3:      ret
4180
4181 ux_ioctl:
4182         pop hl
4183         ld a,l
4184         sub 3
4185         jp p,1f
4186         pop hl
4187         ld a,h
4188         cp 't'
4189         jr nz,e.mon
4190         ld a,l
4191         cp 8
4192         jr z,tiocgetp
4193         cp 9
4194         jr z,tiocsetp
4195         jr e.mon
4196 1:      pop hl
4197         pop hl
4198         ld hl,-1
4199         jr phl
4200 tiocgetp:
4201         pop de
4202         ld hl,ttymode
4203 2:      push bc
4204         ld bc,6
4205         ldir
4206         ld h,b
4207         ld l,c
4208         pop bc
4209         jr phl
4210 tiocsetp:
4211         pop hl
4212         ld de,ttymode
4213         jr 2b
4214
4215 ux_time:
4216         call time4
4217         jr loop
4218
4219 ux_ftime:
4220         pop hl
4221         ld (retarea+6),hl
4222         call time4
4223         ld hl,(retarea+6)
4224         pop de
4225         ld (hl),e
4226         inc hl
4227         ld (hl),d
4228         inc hl
4229         pop de
4230         ld (hl),e
4231         inc hl
4232         ld (hl),d
4233         inc hl
4234         xor a
4235         ld (hl),a
4236         inc hl
4237         ld (hl),a
4238         inc hl
4239         ld (hl),a
4240         inc hl
4241         ld (hl),a
4242         inc hl
4243         ld (hl),a
4244         inc hl
4245         ld (hl),a
4246         jr loop
4247
4248 time4:
4249         pop hl
4250         ld (retarea),bc
4251         ld (retarea+2),ix
4252         ld (retarea+4),hl
4253         ld hl,(timebuf+2)
4254         push hl
4255         ld hl,(timebuf)
4256         push hl
4257         ld hl,0
4258         push hl
4259         ld hl,50
4260         push hl
4261         call .dvu4
4262         ld bc,(retarea)
4263         ld ix,(retarea+2)
4264         ld hl,(retarea+4)
4265         jp (hl)
4266 ux_exit:
4267         call uxfinish
4268         ld c,reset
4269         call bdos
4270         ! no return
4271
4272 ux_creat:
4273         call emptyfile
4274         jr c,openfailed
4275         pop hl
4276         call parsename
4277         pop hl                  ! file mode, not used under CP/M
4278         push bc
4279         push iy
4280         push iy
4281         pop de
4282         ld c,delete
4283         call bdos
4284         pop de
4285         ld c,makefile
4286         call bdos
4287         pop bc
4288         ld l,1
4289         jr afteropen
4290 ux_open:
4291         call emptyfile
4292         jr nc,1f
4293 openfailed:
4294         pop hl
4295         pop hl          ! remove params
4296         ld hl,EMFILE
4297         push hl
4298         jr phl
4299 1:
4300         pop hl          ! filename
4301         call parsename
4302         push bc
4303         ld c,open
4304         push iy
4305         pop de
4306         call bdos
4307         pop bc
4308         pop hl
4309 afteropen:
4310         inc a
4311         jr nz,1f
4312         ld hl,ENOENT
4313         push hl
4314         jr phl
4315 1:
4316         inc l
4317         ld (iy+openflag),l
4318         xor a
4319         ld (iy+nleft),a
4320         ld (iy+zcount),a
4321         ld (iy+zsave),26
4322         bit 1,l
4323         jr z,2f
4324         ld (iy+nleft),128
4325 2:
4326         ld (iy+position),a
4327         ld (iy+position+1),a
4328         push iy
4329         pop hl
4330         push bc
4331         ld b,128
4332 3:      dec hl
4333         ld (hl),26
4334         djnz 3b
4335         pop bc
4336         ld (iy+iopointer+1),h
4337         ld (iy+iopointer),l
4338         ld h,a
4339         ld l,(iy+fildes)
4340         push hl
4341         ld l,a
4342         jr phl
4343
4344 ux_read:
4345         pop hl
4346         ld a,l
4347         sub 3
4348         jp p,readfile
4349         ld a,(ttymode+4)
4350         bit 5,a
4351         jr z,1f                 ! not raw
4352         push bc
4353 #ifdef  CPM1
4354 !raw echo interface
4355         ld c,consolein
4356         call bdos
4357 #else
4358 !no echo interface
4359 4:
4360         ld c,diconio
4361         ld e,0xff
4362         call bdos
4363         or a
4364         jr z,4b
4365 !end of no echo interface
4366 #endif
4367         pop bc
4368         pop hl
4369         ld (hl),a
4370         pop hl
4371         ld hl,1
4372         push hl
4373         ld hl,0
4374         jr phl
4375 1:
4376         ld hl,sibuf+1           ! read from console assumed
4377         dec (hl)
4378         jp p,2f
4379         dec hl                  ! go read console line
4380         ld (hl),80              ! max line length
4381         push bc
4382         push hl
4383         ld c,readconsole
4384         ex de,hl
4385         call bdos
4386         ld c,writeconsole
4387         ld e,'\n'
4388         call bdos
4389         pop hl
4390         pop bc
4391         inc hl
4392         inc (hl)
4393         ld (siptr),hl           ! ready for transfer
4394         push hl
4395         ld e,(hl)
4396         ld d,0
4397         add hl,de
4398         ld (hl),'\r'
4399         inc hl
4400         ld (hl),'\n'
4401         pop hl
4402 2:
4403         push bc
4404         pop iy
4405         ld b,(hl)
4406         inc b                   ! bytes remaining
4407         pop hl                  ! copy to
4408         pop de                  ! bytes wanted (probably 512)
4409         push iy
4410         ld iy,(siptr)           ! copy from
4411         xor a                   ! find out minimum of ramaining and wanted
4412         or d
4413         jr nz,3f                ! more than 255 wanted (forget that)
4414         ld a,b
4415         cp e
4416         jp m,3f                 ! not enough remaining
4417         ld b,e
4418 3:
4419         ld c,b                  ! keep copy
4420 0:
4421         inc iy
4422         ld a,(iy)
4423         ld (hl),a
4424         inc hl
4425         djnz 0b
4426         ld a,(sibuf+1)
4427         sub c
4428         inc a
4429         ld (sibuf+1),a
4430         ld (siptr),iy
4431         pop hl
4432         push bc
4433         ld c,b
4434         push bc                 ! load 0
4435         ld b,h
4436         ld c,l
4437         jr loop
4438 readfile:
4439         call findfile
4440         pop de
4441         pop hl                  ! count
4442         push bc
4443         ld bc,0
4444 0:
4445         xor a
4446         or l
4447         jr z,1f
4448         dec l
4449 3:
4450 ! warning: this may not work if zcount overflows
4451         ld a,(iy+zcount)
4452         or a
4453         jr nz,5f
4454         ld a,(iy+zsave)
4455         cp 26
4456         jr z,4f
4457         ld (iy+zsave),26
4458         jr 8f
4459 4:
4460         call getchar
4461         jr c,2f
4462         ld (de),a
4463         sub 26          ! CTRL-Z
4464         jr z,7f
4465         ld a,(iy+zcount)
4466         or a
4467         jr z,6f
4468         ld a,(de)
4469         ld (iy+zsave),a
4470 5:
4471         ld a,26
4472         dec (iy+zcount)
4473 8:
4474         ld (de),a
4475 6:
4476         inc de
4477         inc bc
4478         jr 0b
4479 1:
4480         dec l
4481         dec h
4482         jp p,3b
4483 2:
4484         pop hl
4485         push bc
4486         ld b,h
4487         ld c,l
4488         ld hl,0
4489         jr phl
4490 7:
4491         inc (iy+zcount)
4492         jr 4b
4493
4494 ux_write:
4495         pop hl
4496         ld a,l
4497         sub 3
4498         jp p,writefile
4499         pop hl                  ! buffer address
4500         pop de                  ! count
4501         push de
4502         ld iy,0
4503         push iy
4504         push bc
4505         ld b,e                  ! count now in 'db'
4506 0:
4507         ld a,b
4508         or a
4509         jr nz,1f
4510         ld a,d
4511         or a
4512         jr nz,2f
4513         pop bc
4514         jr loop
4515 2:
4516         dec d
4517 1:
4518         dec b
4519         ld e,(hl)
4520         inc hl
4521         push bc
4522         push de
4523         push hl
4524         ld c,writeconsole
4525         call bdos
4526         pop hl
4527         pop de
4528         pop bc
4529         jr 0b
4530 writefile:
4531         call findfile
4532         pop de
4533         pop hl                  ! count
4534         push bc
4535         ld bc,0
4536 0:
4537         xor a
4538         or l
4539         jr z,1f
4540         dec l
4541 3:
4542         ld a,(de)
4543         inc de
4544         call putchar
4545         jr c,4f
4546         inc bc
4547         jr 0b
4548 1:
4549         dec l
4550         dec h
4551         jp p,3b
4552         ld iy,0
4553 2:
4554         pop hl
4555         push bc
4556         ld b,h
4557         ld c,l
4558         push iy
4559         jr loop
4560 4:
4561         ld iy,ENOSPC
4562         jr 2b
4563
4564 ux_unlink:
4565         pop hl
4566         ld iy,fcb
4567         call parsename
4568         push bc
4569         ld c,delete
4570         ld de,fcb
4571         call bdos
4572         pop bc
4573         inc a
4574         jr nz,1f
4575         ld hl,ENOENT
4576         jr phl
4577 1:
4578         ld hl,0
4579         jr phl
4580
4581 ux_getpid:
4582         ld hl,12345             ! nice number
4583         jr phl
4584
4585 ux_exece:
4586         ld iy,fcb
4587         pop hl
4588         call parsename
4589         pop hl
4590         ld b,h;ld c,l
4591         pop iy
4592         ld ix,0x82
4593         ld (ix-1),' '
4594 4:      ld h,b;ld l,c
4595 3:      ld e,(hl)
4596         inc hl
4597         ld d,(hl)
4598         inc hl
4599         ld b,h;ld c,l
4600         ex de,hl
4601         ld a,h
4602         or l
4603         jr z,1f
4604 2:
4605         ld a,(hl)
4606         inc hl
4607         ld (ix),a
4608         inc ix
4609         or a
4610         jr nz,2b
4611         ld (ix-1),' '
4612         jr 4b
4613 1:
4614         ld (ix),'X'
4615         ld (ix+1),'\r'
4616         ld (ix+2),'\n'
4617         ld (ix+3),'$'
4618         ld de,0x81
4619         push ix
4620         ld c,printstring
4621         call bdos
4622         pop hl
4623         ld de,-129
4624         add hl,de
4625         ld a,l
4626         ld (0x80),a
4627         jr warmstart
4628
4629
4630
4631
4632 dispat1:        ! base for escaped opcodes
4633 .data2  aar.l,  aar.z,  adf.l,  adf.z,  adi.l,  adi.z,  ads.l,  ads.z
4634 .data2  adu.l,  adu.z,  and.l,  and.z,  asp.l,  ass.l,  ass.z,  bge.l
4635 .data2  bgt.l,  ble.l,  blm.l,  bls.l,  bls.z,  blt.l,  bne.l,  cai.z
4636 .data2  cal.l,  cfi.z,  cfu.z,  ciu.z,  cmf.l,  cmf.z,  cmi.l,  cmi.z
4637 .data2  cms.l,  cms.z,  cmu.l,  cmu.z,  com.l,  com.z,  csa.l,  csa.z
4638 .data2  csb.l,  csb.z,  cuf.z,  cui.z,  cuu.z,  dee.l,  del.p,  del.n
4639 .data2  dup.l,  dus.l,  dus.z,  dvf.l,  dvf.z,  dvi.l,  dvi.z,  dvu.l
4640 .data2  dvu.z,  fef.l,  fef.z,  fif.l,  fif.z,  inl.p,  inl.n,  inn.l
4641 .data2  inn.z,  ior.l,  ior.z,  lar.l,  lar.z,  ldc.l,  ldf.l,  ldl.p
4642 .data2  ldl.n,  lfr.l,  lil.p,  lil.n,  lim.z,  los.l,  los.z,  lor.s0
4643 .data2  lpi.l,  lxa.l,  lxl.l,  mlf.l,  mlf.z,  mli.l,  mli.z,  mlu.l
4644 .data2  mlu.z,  mon.z,  ngf.l,  ngf.z,  ngi.l,  ngi.z,  nop.z,  rck.l
4645 .data2  rck.z,  ret.l,  rmi.l,  rmi.z,  rmu.l,  rmu.z,  rol.l,  rol.z
4646 .data2  ror.l,  ror.z,  rtt.z,  sar.l,  sar.z,  sbf.l,  sbf.z,  sbi.l
4647 .data2  sbi.z,  sbs.l,  sbs.z,  sbu.l,  sbu.z,  sde.l,  sdf.l,  sdl.p
4648 .data2  sdl.n,  set.l,  set.z,  sig.z,  sil.p,  sil.n,  sim.z,  sli.l
4649 .data2  sli.z,  slu.l,  slu.z,  sri.l,  sri.z,  sru.l,  sru.z,  sti.l
4650 .data2  sts.l,  sts.z,  str.s0, tge.z,  tle.z,  trp.z,  xor.l,  xor.z
4651 .data2  zer.l,  zer.z,  zge.l,  zgt.l,  zle.l,  zlt.l,  zne.l,  zrf.l
4652 .data2  zrf.z,  zrl.p,  dch.z,  exg.s0, exg.l,  exg.z,  lpb.z
4653
4654 dispat2:        ! base for 4 byte offsets
4655 .data2  ldc.f
4656
4657
4658 ignmask: .data2 0       ! ignore mask (variable)
4659 retarea: .data2 0       ! base of buffer for result values (max 8 bytes)
4660          .data2 0
4661          .data2 0
4662          .data2 0
4663
4664 trapproc:
4665         .data2 0
4666
4667 nextp:  .data1 0
4668
4669 header:
4670 ntext:  .data2 0
4671 ndata:  .data2 0
4672 nproc:  .data2 0
4673 entry:  .data2 0
4674 nline:  .data2 0
4675
4676 hp:     .data2 0
4677 pb:     .data2 0
4678 pd:     .data2 0