mach/6500/libem/libem_s.a

   1 e�adi4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\10\ 2.define Adi4
   2 .sect .text
   3 .sect .rom
   4 .sect .data
   5 .sect .bss
   6 .sect .text
   7
   8 ! This subroutine adds two fourbyte integers, which are on the stack.
   9 ! The addresses are initiated by the subroutine Addsub.
  10 ! Also the loopvariable (register X) is initiated by that routine.
  11 ! The result is pushed back onto the stack
  12
  13
  14 Adi4:
  15         jsr Addsub              ! initiate addresses
  16         clc
  17     1:  lda (ADDR+2),y          ! get byte first operand
  18         adc (ADDR),y            ! add to byte second operand
  19         sta (ADDR+2),y          ! push on real stack
  20         iny
  21         inx
  22         bne 1b                  ! do it 4 times
  23         rts
  24
  25
  26 cmi.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Cmi
  27 .sect .text
  28 .sect .rom
  29 .sect .data
  30 .sect .bss
  31 .sect .text
  32
  33 ! This subroutine compares on two integers.
  34 ! If T is pushed first and than S, the routine will return:
  35 !   -1  if S < T,
  36 !    0  if S = T,
  37 !    1  if S > T.
  38
  39
  40 Cmi:
  41         jsr Sbi2        ! subtract operands (T - S)
  42         bpl 1f          ! S >= T
  43         lda #0x0FF      ! S < T
  44         tax             ! AX becomes -1
  45         rts
  46     1:  beq 2f
  47     3:  lda #0          ! S > T
  48         ldx #1          ! AX becomes 1
  49         rts
  50     2:  txa
  51         bne 3b
  52         lda #0          ! S = T
  53         tax             ! AX becomes 0
  54         rts
  55
  56
  57 hcmi4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0"\ 3.define Cmi4
  58 .sect .text
  59 .sect .rom
  60 .sect .data
  61 .sect .bss
  62 .sect .text
  63
  64 ! This subroutine compares on fourbyte integers.
  65 ! If T is pushed first and than S, the routine will return:
  66 !    -1   if S < T,
  67 !     0   if S = T,
  68 !     1   if S > T.
  69
  70
  71 Cmi4:
  72         jsr Sbi4        ! subtract operands (T - S)
  73         jsr Pop         ! get result (lowbyte, lowbyte+1)
  74         stx ARTH        ! store lowbyte
  75         sta ARTH+1      ! store lowbyte+1
  76         jsr Pop         ! get result (lowbyte+2, lowbyte+3)
  77         tay             ! test lowbyte+3
  78         bpl 1f          ! S >= T
  79         lda #0x0FF      ! S < T
  80         tax             ! AX becomes -1
  81         rts
  82     1:  cmp #0          ! test lowbyte+3 on zero
  83         bne 2f
  84         cpx #0          ! test lowbyte+2 on zero
  85         bne 2f
  86         lda #0
  87         cmp ARTH+1      ! test lowbyte+1 on zero
  88         bne 2f
  89         cmp ARTH        ! test lowbyte on zero
  90         bne 2f
  91         lda #0          ! S = T
  92         tax             ! AX becomes 0
  93         rts
  94     2:  lda #0          ! S > T
  95         ldx #1          ! AX becomes 1
  96         rts
  97
  98
  99 sbi4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0_\ 1.define Sbi4
 100 .sect .text
 101 .sect .rom
 102 .sect .data
 103 .sect .bss
 104 .sect .text
 105
 106 ! This subroutine subtracts two fourbyte signed integers.
 107
 108
 109 Sbi4:
 110         jsr Addsub      ! initiate addresses
 111         sec
 112     1:  lda (ADDR+2),y  ! get lowbyte+y first operand
 113         sbc (ADDR),y    ! subtract lowbyte+y second operand
 114         sta (ADDR+2),y  ! put on stack lowbyte+y result
 115         iny
 116         inx
 117         bne 1b
 118         rts
 119
 120
 121 waddsub.s\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\82\ 2.define Addsub
 122 .sect .text
 123 .sect .rom
 124 .sect .data
 125 .sect .bss
 126 .sect .text
 127
 128 ! This subroutine is used by the fourbyte addition and subtraction
 129 ! routines.
 130 ! It puts the address of the second operand into
 131 ! the zeropage locations ADDR and ADDR+1
 132 ! The address of the first operand is put into
 133 ! zeropage locations ADDR+2 and ADDR+3.
 134
 135
 136 Addsub:
 137         clc
 138         lda SP+2
 139         sta ADDR        ! address of second operand (lowbyte)
 140         adc #4
 141         sta SP+2
 142         sta ADDR+2      ! address of first operand (lowbyte)
 143         lda SP+1
 144         sta ADDR+1      ! address of second operand (highbyte)
 145         adc #0
 146         sta ADDR+3      ! address of first operand (highbyte)
 147         sta SP+1
 148         ldy #0
 149         ldx #0x0FC      ! do it 4 times
 150         rts
 151
 152
 153 cmu4.s\0s\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 3.define Cmu4
 154 .sect .text
 155 .sect .rom
 156 .sect .data
 157 .sect .bss
 158 .sect .text
 159
 160 ! This subroutine compares two unsigned fourbyte integers.
 161 ! If T is first pushed and than S the routine will return:
 162 !    -1   if S < T,
 163 !     0   if S = T,
 164 !     1   if S > T.
 165
 166
 167 Cmu4:
 168         lda #ARTH
 169         sta ADDR
 170         lda #0
 171         sta ADDR+1
 172         jsr Sdo         ! store S in zeropage ARTH - ARTH+3
 173         lda #ARTH+4
 174         sta ADDR
 175         jsr Sdo         ! store T in zeropage ARTH+4 - ARTH+7
 176         lda ARTH+7
 177         cmp ARTH+3
 178         bcc 3f          ! S (lowbyte+3) < T (lowbyte+3)
 179         bne 2f          ! S (lowbyte+3) < T (lowbyte+3)
 180         lda ARTH+6
 181         cmp ARTH+2
 182         bcc 3f          ! S (lowbyte+2) < T (lowbyte+2)
 183         bne 2f          ! S (lowbyte+2) < T (lowbyte+2)
 184         lda ARTH+5
 185         cmp ARTH+1
 186         bcc 3f          ! S (lowbyte+1) < T (lowbyte+1)
 187         bne 2f          ! S (lowbyte+1) < T (lowbyte+1)
 188         lda ARTH+4
 189         cmp ARTH
 190         bcc 3f          ! S (lowbyte+0) < T (lowbyte+0)
 191         bne 2f          ! S (lowbyte+0) < T (lowbyte+0)
 192         lda #0
 193         tax             ! S = T
 194         rts
 195     2:  lda #0          ! S > T
 196         ldx #1
 197         rts
 198     3:  lda #0x0FF      ! S < T
 199         tax
 200         rts
 201
 202
 203 \0dum_float.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define Adf4
 204 .define Adf8
 205 .define Sbf4
 206 .define Sbf8
 207 .define Mlf4
 208 .define Mlf8
 209 .define Dvf4
 210 .define Dvf8
 211 .define Ngf4
 212 .define Ngf8
 213 .define Zrf4
 214 .define Zrf8
 215 .define Cmf4
 216 .define Cmf8
 217 .define Fef4
 218 .define Fef8
 219 .define Fif4
 220 .define Fif8
 221 .define Cfi
 222 .define Cif
 223 .define Cuf
 224 .define Cff
 225 .define Cfu
 226 .define Lfr8
 227 .define Ret8
 228 .sect .text
 229 .sect .rom
 230 .sect .data
 231 .sect .bss
 232 .sect .text
 233
 234 ! Dummy floating point package for 6500
 235 ! every EM floating point instruction results in an
 236 ! "Illegal EM instruction" trap.
 237
 238
 239 Adf4:
 240 Adf8:
 241 Sbf4:
 242 Sbf8:
 243 Mlf4:
 244 Mlf8:
 245 Dvf4:
 246 Dvf8:
 247 Ngf4:
 248 Ngf8:
 249 Zrf4:
 250 Zrf8:
 251 Cmf4:
 252 Cmf8:
 253 Fef4:
 254 Fef8:
 255 Fif4:
 256 Fif8:
 257 Cfi:
 258 Cif:
 259 Cuf:
 260 Cff:
 261 Cfu:
 262 Lfr8:
 263 Ret8:
 264         ldx #Eillins
 265         lda #0
 266         jsr Trap
 267 odvi4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0K\ 1.define Dvi4
 268 .sect .text
 269 .sect .rom
 270 .sect .data
 271 .sect .bss
 272 .sect .text
 273
 274 ! This subroutine performs a fourbyte signed division.
 275 ! For more details see dvi.s
 276 ! The only difference is that zeropage locations are twice as big.
 277
 278
 279 Dvi4:
 280         ldy #1
 281         sty UNSIGN
 282         jsr Div4
 283         lda ARTH+7
 284         ldx ARTH+6
 285         jsr Push
 286         lda ARTH+5
 287         ldx ARTH+4
 288         jmp Push
 289
 290
 291
 292 dvu4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\07\ 2.define Dvu4
 293 .sect .text
 294 .sect .rom
 295 .sect .data
 296 .sect .bss
 297 .sect .text
 298
 299 ! This subroutine performs an unsigned division on fourbyte
 300 ! integers. For more details see dvi.s
 301 ! The only difference is that zeropage locations are twice as big.
 302
 303
 304 Dvu4:
 305         ldy #0
 306         sty UNSIGN      ! it is unsigned
 307         jsr Pop
 308         stx ARTH
 309         sta ARTH+1
 310         jsr Pop
 311         stx ARTH+2
 312         sta ARTH+3      ! divisor in ARTH - ARTH+3
 313         jsr Pop
 314         stx ARTH+4
 315         sta ARTH+5
 316         jsr Pop
 317         stx ARTH+6
 318         sta ARTH+7      ! dividend in ARTH+4 - ARTH+7
 319         jsr Duv4
 320         lda ARTH+7
 321         ldx ARTH+6
 322         jsr Push
 323         lda ARTH+5
 324         ldx ARTH+4
 325         jmp Push        ! store result
 326
 327
 328 rlar.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0R\ 2.define Lar
 329 .sect .text
 330 .sect .rom
 331 .sect .data
 332 .sect .bss
 333 .sect .text
 334
 335 ! This subroutine performs the LAR instruction.
 336 ! For details see rapport IR-81.
 337
 338
 339 Lar:
 340         jsr Aar         ! get object address
 341         ldy NBYTES+1    ! the size of the object (highbyte)
 342         bne 2f
 343         ldy NBYTES      ! the size of the object (lowbyte)
 344         cpy #1
 345         bne 1f          ! object size is one byte
 346         jsr Loi1        ! get object
 347         jmp Push        ! push on the stack
 348     1:  cpy #2
 349         bne 1f          ! object size is a word
 350         jsr Loi         ! get word
 351         jmp Push        ! push on the stack
 352     1:  cpy #4
 353         bne 2f          ! object size is four bytes
 354         jmp Ldi         ! get object
 355     2:  jmp Loil        ! get object
 356
 357
 358 lol.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0(\ 1.define Lol
 359 .sect .text
 360 .sect .rom
 361 .sect .data
 362 .sect .bss
 363 .sect .text
 364
 365 ! This subroutine loads a local in registerpair AX which
 366 ! offset from the localbase is to big.
 367
 368
 369 Lol:
 370         jsr Locaddr     ! get the address of local
 371         ldy #0
 372         lda (ADDR),y    ! get lowbyte
 373         tax
 374         iny
 375         lda (ADDR),y    ! get highbyte
 376         rts
 377
 378
 379 los.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0Y\ 2.define Los
 380 .sect .text
 381 .sect .rom
 382 .sect .data
 383 .sect .bss
 384 .sect .text
 385
 386 ! This subroutine perfoms the LOS instruction.
 387 ! For detail see rapport IR-81.
 388
 389
 390 Los:
 391         cmp #0
 392         bne 3f
 393         cpx #1
 394         bne 1f          ! the size is one
 395         jsr Pop         ! get address
 396         jsr Loi1        ! push it on the stack
 397         jmp Push
 398     1:  cpx #2
 399         bne 2f          ! the size is two
 400         jsr Pop         ! get address
 401         jsr Loi         ! push it on the stack
 402         jmp Push
 403     2:  cpx #4
 404         bne 3f          ! the size is four
 405         jsr Pop         ! get address
 406         jmp Ldi         ! push it on the stack
 407     3:  sta ARTH+1      ! the size is greater than four
 408         txa
 409         tay
 410         jsr Pop         ! get address
 411         jmp Loil        ! push it on the stack
 412
 413
 414
 415 loil.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Loil
 416 .sect .text
 417 .sect .rom
 418 .sect .data
 419 .sect .bss
 420 .sect .text
 421
 422 ! This subroutine pushes an object of size greater than four bytes
 423 ! onto the stack.
 424
 425
 426 Loil:
 427         sta ADDR+1      ! source address (lowbyte)
 428         stx ADDR        ! source address (highbyte)
 429         sty NBYTES
 430         sec
 431         lda SP+2
 432         sbc NBYTES
 433         sta ADDR+2      ! destination address (lowbyte)
 434         sta SP+2        ! new stackpointer
 435         lda SP+1
 436         sbc NBYTES+1
 437         sta ADDR+3      ! destination address (highbyte)
 438         sta SP+1        ! new stackpointer
 439         inc NBYTES+1
 440         jmp Blmnp       ! do the move
 441
 442
 443 Aloi1.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\08\ 1.define Loi1
 444 .sect .text
 445 .sect .rom
 446 .sect .data
 447 .sect .bss
 448 .sect .text
 449
 450 ! This routine loads a one byte object in registerpair AX.
 451
 452
 453 Loi1:
 454         stx ADDR        ! address of byte (lowbyte)
 455         sta ADDR+1      ! address of byte (highbyte)
 456         ldy #0
 457         lda (ADDR),y    ! load byte
 458         tax             ! store byte in X
 459         tya             ! clear highbyte of AX
 460         rts
 461
 462
 463 loi.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0}\ 1.define Loi, Lext
 464 .sect .text
 465 .sect .rom
 466 .sect .data
 467 .sect .bss
 468 .sect .text
 469 ! This subroutine performs an indirect load on a word of two bytes.
 470 ! Lext is used when the address is already in zeropage.
 471
 472
 473 Loi:
 474         stx ADDR        ! address of object (lowbyte)
 475         sta ADDR+1      ! address of object (highbyte)
 476 Lext:
 477         ldy #0
 478         lda (ADDR),y    ! get lowbyte
 479         tax
 480         iny
 481         lda (ADDR),y    ! get highbyte
 482         rts
 483
 484
 485 amli4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Mli4
 486 .sect .text
 487 .sect .rom
 488 .sect .data
 489 .sect .bss
 490 .sect .text
 491
 492 ! This subroutine multiplies two signed fourbyte integers
 493 ! For more detail see mli.s
 494 ! The only difference is that zeropage locations are twice as big.
 495
 496
 497 Mli4:
 498         ldy #1
 499         sty UNSIGN
 500         jsr Pop
 501         stx ARTH
 502         sta ARTH+1
 503         jsr Pop
 504         stx ARTH+2
 505         sta ARTH+3      ! multiplier
 506         jsr Pop
 507         stx ARTH+4
 508         sta ARTH+5
 509         jsr Pop
 510         stx ARTH+6
 511         sta ARTH+7      ! multiplicand
 512         lda ARTH+3
 513         bpl 3f
 514         lda #0
 515         ldx #ARTH
 516         jsr Ngi4
 517         lda #0
 518         ldx #ARTH+4
 519         jsr Ngi4
 520     3:  jmp Mul4
 521
 522
 523 emlu.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\1d\ 1.define Mlu2
 524 .sect .text
 525 .sect .rom
 526 .sect .data
 527 .sect .bss
 528 .sect .text
 529
 530 ! This subroutine multiplies two unsigned fourbyte intergers.
 531 ! For more details see mli.s
 532
 533
 534 Mlu2:
 535         stx ARTH
 536         sta ARTH+1      ! multiplier
 537         jsr Pop
 538         stx ARTH+2
 539         sta ARTH+3      ! multiplicand
 540         ldy #0
 541         sty UNSIGN
 542         jmp Mul
 543
 544
 545 jmlu4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Mlu4
 546 .sect .text
 547 .sect .rom
 548 .sect .data
 549 .sect .bss
 550 .sect .text
 551
 552 ! This subroutine multiplies two fourbyte unsigned integers.
 553 ! For more details see mli.s
 554 ! The only difference is that zeropage locations are twice as big.
 555
 556
 557 Mlu4:
 558         ldy #0
 559         sty UNSIGN
 560         jsr Pop
 561         stx ARTH
 562         sta ARTH+1
 563         jsr Pop
 564         stx ARTH+2
 565         sta ARTH+3      ! multiplier
 566         jsr Pop
 567         stx ARTH+4
 568         sta ARTH+5
 569         jsr Pop
 570         stx ARTH+6
 571         sta ARTH+7      ! multiplicand
 572         jmp Mul4
 573
 574
 575  mul4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\19\ 4.define Mul4
 576 .sect .text
 577 .sect .rom
 578 .sect .data
 579 .sect .bss
 580 .sect .text
 581
 582 ! This subroutine multiplies two fourbyte signed integers.
 583 ! For more details see mli.s
 584 ! The only difference is that zeropage locations are twice as big.
 585
 586
 587 Mul4:
 588     3:  lda #0
 589         sta ARTH+8
 590         sta ARTH+9
 591         sta ARTH+10
 592         sta ARTH+11
 593         sta ARTH+12
 594         sta ARTH+13
 595         sta ARTH+14
 596         sta ARTH+15     ! clear accumulator
 597         ldy #32
 598     1:  lda #0x01
 599         bit ARTH
 600         beq 2f          ! multiplying by zero: no addition
 601         clc
 602         lda ARTH+12
 603         adc ARTH+4
 604         sta ARTH+12
 605         lda ARTH+13
 606         adc ARTH+5
 607         sta ARTH+13
 608         lda ARTH+14
 609         adc ARTH+6
 610         sta ARTH+14
 611         lda ARTH+15
 612         adc ARTH+7
 613         sta ARTH+15
 614     2:  lsr ARTH+3
 615         ror ARTH+2
 616         ror ARTH+1
 617         ror ARTH        ! shift multiplier
 618         lsr ARTH+15
 619         ror ARTH+14
 620         ror ARTH+13
 621         ror ARTH+12
 622         ror ARTH+11
 623         ror ARTH+10
 624         ror ARTH+9
 625         ror ARTH+8      ! shift accumulator
 626         lda UNSIGN
 627         beq 3f          ! it's unsigned: so no shift in of signbit
 628         lda ARTH+7
 629         bpl 3f
 630         lda #0x40
 631         bit ARTH+15
 632         beq 3f
 633         lda ARTH+15
 634         ora #0x80
 635         sta ARTH+15
 636     3:  dey
 637         bne 1b
 638         ldx ARTH+10
 639         lda ARTH+11
 640         jsr Push
 641         ldx ARTH+8
 642         lda ARTH+9
 643         jmp Push
 644
 645
 646 \0rmi.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0$\ 2.define Rmi2
 647 .sect .text
 648 .sect .rom
 649 .sect .data
 650 .sect .bss
 651 .sect .text
 652
 653 ! This subroutine returns the remainder of a twobyte signed division.
 654 ! The sign of the result is as specified in the emtest.
 655
 656
 657 Rmi2:
 658         ldy #0
 659         sty NBYTES      ! for the sign of the result
 660         stx ARTH
 661         sta ARTH+1      ! first operand
 662         jsr Pop
 663         stx ARTH+2
 664         sta ARTH+3      ! second operand
 665         ldy #0
 666         sty UNSIGN      ! its signed arithmetic
 667         jsr Div
 668         lsr ARTH+5
 669         ror ARTH+4      ! result must be shifted one time
 670         ldx ARTH+4
 671         lda ARTH+5
 672         ldy NBYTES
 673         beq 1f          ! result must be positive
 674         jmp Ngi2
 675     1:  rts
 676
 677
 678 rmi4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Rmi4
 679 .sect .text
 680 .sect .rom
 681 .sect .data
 682 .sect .bss
 683 .sect .text
 684
 685 ! This subroutine returns the remainder of a fourbyte division.
 686
 687
 688 Rmi4:
 689         ldy #0
 690         sty NBYTES      ! for the sign of the result
 691         ldy #0
 692         sty UNSIGN      ! it is signed arithmetic
 693         jsr Div4
 694         lsr ARTH+11
 695         ror ARTH+10
 696         ror ARTH+9
 697         ror ARTH+8      ! result must be shifted one time
 698         ldy NBYTES
 699         beq 1f          ! result is positive
 700         lda #0
 701         ldx #ARTH+8
 702         jsr Ngi4
 703     1:  lda ARTH+11
 704         ldx ARTH+10
 705         jsr Push
 706         lda ARTH+9
 707         ldx ARTH+8
 708         jmp Push
 709
 710
 711 div4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0~\ 2.define Div4
 712 .sect .text
 713 .sect .rom
 714 .sect .data
 715 .sect .bss
 716 .sect .text
 717
 718 ! This subroutine performs a signed divide on two fourbyte integers.
 719 ! For more detail see dvi.s
 720 ! The only difference is that zeropage locations are twice as big.
 721
 722 Div4:
 723         ldy #0
 724         sty SIGN
 725         jsr Pop
 726         stx ARTH
 727         sta ARTH+1
 728         jsr Pop
 729         stx ARTH+2
 730         sta ARTH+3      ! divisor in ARTH - ARTH+3
 731         tay
 732         bpl 1f
 733         lda #0
 734         ldx #ARTH
 735         jsr Ngi4
 736         ldy #1
 737         sty SIGN        ! it's signed
 738     1:  jsr Pop
 739         stx ARTH+4
 740         sta ARTH+5
 741         jsr Pop
 742         stx ARTH+6
 743         sta ARTH+7      ! dividend in ARTH+4 - ARTH+7
 744         tay
 745         bpl 1f
 746         lda #0
 747         ldx #ARTH+4
 748         jsr Ngi4
 749         lda SIGN
 750         eor #1
 751         sta SIGN
 752         lda #1
 753         sta NBYTES
 754     1:  jmp Duv4
 755
 756
 757 rmu.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0y\ 1.define Rmu2
 758 .sect .text
 759 .sect .rom
 760 .sect .data
 761 .sect .bss
 762 .sect .text
 763
 764 ! This subroutine returns the remainder of an twobyte unsigned
 765 ! integer division.
 766
 767
 768 Rmu2:
 769         stx ARTH
 770         sta ARTH+1      ! first operand
 771         jsr Pop
 772         stx ARTH+2
 773         sta ARTH+3      ! second operand
 774         ldy #1
 775         sty UNSIGN      ! it unsigned
 776         jsr Duv
 777         lsr ARTH+5
 778         ror ARTH+4      ! shift result one time
 779         ldx ARTH+4
 780         lda ARTH+5
 781         rts
 782
 783
 784  dvi.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\07\ 6.define Dvi2, Div, Duv
 785 .sect .text
 786 .sect .rom
 787 .sect .data
 788 .sect .bss
 789 .sect .text
 790
 791 ! The subroutine Dvi2 performs a signed division.
 792 ! Its operands are on the stack.
 793 ! The subroutine Div performs also a signed division, ecxept that
 794 ! its operand are already in zeropage.
 795 ! The subroutine Duv performs a n unsigned division.
 796 ! For an explanation of the algoritm used see
 797 !   A. S. Tanenbaum's Structered Computer Organisation. 1976
 798
 799
 800 Dvi2:
 801         stx ARTH
 802         sta ARTH+1      ! store divisor
 803         jsr Pop
 804         stx ARTH+2
 805         sta ARTH+3      ! store dividend
 806         ldy #1
 807         sty UNSIGN      ! used for result sign
 808 Div:
 809         ldy #0
 810         sty SIGN
 811         lda ARTH+1
 812         bpl 1f          ! if divisor is negative
 813         ldx ARTH        ! make it positive
 814         jsr Ngi2
 815         ldy #1
 816         sty SIGN
 817         stx ARTH
 818         sta ARTH+1
 819     1:  lda ARTH+3
 820         bpl 1f          ! if dividend is negative
 821         ldx ARTH+2      ! make it positive
 822         jsr Ngi2
 823         pha
 824         lda SIGN
 825         eor #1          ! excusive or with sign of divisor
 826         sta SIGN
 827         lda #1
 828         sta NBYTES
 829         pla
 830         stx ARTH+2
 831         sta ARTH+3
 832 Duv:
 833     1:  ldy #0
 834         sty ARTH+4
 835         sty ARTH+5
 836         ldy #17
 837     4:  lda ARTH+5
 838         cmp ARTH+1
 839         bcc 1f          ! no subtraction
 840         bne 2f          ! divisor goes into dividend
 841         lda ARTH+4
 842         cmp ARTH
 843         bcc 1f          ! no subtraction
 844     2:  sec             ! divisor goes into dividend
 845         lda ARTH+4
 846         sbc ARTH
 847         sta ARTH+4
 848         lda ARTH+5
 849         sbc ARTH+1
 850         sta ARTH+5      ! subtract divisor from dividend
 851         sec
 852         rol ARTH+2      ! a subtraction so shift in a 1
 853         bne 3f
 854     1:  asl ARTH+2      ! no subtraction so shift in a 0
 855     3:  rol ARTH+3
 856         rol ARTH+4
 857         rol ARTH+5      ! shift dividend
 858         dey
 859         bne 4b
 860         ldx ARTH+2
 861         lda ARTH+3
 862         ldy UNSIGN      ! is it an unsigned division
 863         beq 1f
 864         ldy SIGN        ! is the result negative
 865         beq 1f
 866         jsr Ngi2
 867     1:  rts
 868
 869
 870
 871 \0rmu4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\ 1\ 2.define Rmu4
 872 .sect .text
 873 .sect .rom
 874 .sect .data
 875 .sect .bss
 876 .sect .text
 877
 878 ! This subroutine returns the remainder of a fourbyte unsigned
 879 ! division.
 880
 881
 882 Rmu4:
 883         ldy #1
 884         sty UNSIGN      ! its unsigned
 885         jsr Pop
 886         stx ARTH
 887         sta ARTH+1
 888         jsr Pop
 889         stx ARTH+2
 890         sta ARTH+3      ! second operand
 891         jsr Pop
 892         stx ARTH+4
 893         sta ARTH+5
 894         jsr Pop
 895         stx ARTH+6
 896         sta ARTH+7      ! first operand
 897         jsr Duv4
 898         lsr ARTH+11
 899         ror ARTH+10
 900         ror ARTH+9
 901         ror ARTH+8      ! shift result one time
 902         lda ARTH+11
 903         ldx ARTH+10
 904         jsr Push
 905         lda ARTH+9
 906         ldx ARTH+8
 907         jmp Push
 908
 909
 910 oduv4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\84\ 3.define Duv4
 911 .sect .text
 912 .sect .rom
 913 .sect .data
 914 .sect .bss
 915 .sect .text
 916
 917 ! This subroutine performs an unsigned division on two fourbyte
 918 ! unsigned integers.
 919 ! For more details see dvi.s
 920 ! The only difference is that zeropage locations are twice as big.
 921
 922
 923 Duv4:
 924     1:  ldy #0
 925         sty ARTH+8
 926         sty ARTH+9
 927         sty ARTH+10
 928         sty ARTH+11
 929         ldy #33
 930     4:  lda ARTH+11
 931         cmp ARTH+3
 932         bcc 1f          ! no sub
 933         bne 2f          ! sub
 934         lda ARTH+10
 935         cmp ARTH+2
 936         bcc 1f
 937         bne 2f
 938         lda ARTH+9
 939         cmp ARTH+1
 940         bcc 1f
 941         bne 2f
 942         lda ARTH+8
 943         cmp ARTH
 944         bcc 1f
 945     2:  sec
 946         lda ARTH+8
 947         sbc ARTH
 948         sta ARTH+8
 949         lda ARTH+9
 950         sbc ARTH+1
 951         sta ARTH+9
 952         lda ARTH+10
 953         sbc ARTH+2
 954         sta ARTH+10
 955         lda ARTH+11
 956         sbc ARTH+3
 957         sta ARTH+11
 958         sec
 959         rol ARTH+4
 960         bne 3f
 961     1:  asl ARTH+4
 962     3:  rol ARTH+5
 963         rol ARTH+6
 964         rol ARTH+7
 965         rol ARTH+8
 966         rol ARTH+9
 967         rol ARTH+10
 968         rol ARTH+11
 969         dey
 970         bne 4b
 971         ldy UNSIGN
 972         beq 1f
 973         ldy SIGN
 974         beq 1f
 975         lda #0
 976         ldx #ARTH+4
 977         jsr Ngi4
 978     1:  rts
 979
 980
 981 ngi4.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Ngi4
 982 .sect .text
 983 .sect .rom
 984 .sect .data
 985 .sect .bss
 986 .sect .text
 987
 988 ! This subroutine takes a fourbyte interger and negates it.
 989 ! For more details see ngi2.s
 990
 991
 992 Ngi4:
 993         sta ADDR+1
 994         stx ADDR
 995         ldy #3
 996     1:  lda (ADDR),y
 997         eor #0x0FF      ! one's complement lowbyte+y
 998         sta (ADDR),y
 999         dey
1000         bpl 1b
1001         ldx #0x0FD
1002         iny
1003         clc
1004         lda (ADDR),y
1005         adc #1
1006         sta (ADDR),y    ! lowbyte+y
1007     1:  iny
1008         lda (ADDR),y
1009         adc #0
1010         sta (ADDR),y    ! (lowbyte+y)+0
1011         inx
1012         bne 1b
1013         rts
1014
1015
1016 drtt.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\84\ 1.define Rtt
1017 .sect .text
1018 .sect .rom
1019 .sect .data
1020 .sect .bss
1021 .sect .text
1022
1023 ! This subroutine performs the return from trap.
1024
1025
1026 Rtt:
1027         ldy #0
1028         jsr Ret         ! restore old stackpointer and localbase
1029         jsr Pop         ! remove trapnumber
1030         jsr Pop
1031         sta hol0+1
1032         stx hol0        ! restore linenumber
1033         jsr Pop
1034         sta hol0+5
1035         stx hol0+4      ! restore filename pointer
1036         lda #0
1037         ldx #RETURN
1038         jsr Sdi         ! restore return area
1039         rts
1040
1041
1042 ret.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 3.define Ret
1043 .sect .text
1044 .sect .rom
1045 .sect .data
1046 .sect .bss
1047 .sect .text
1048
1049 ! This subroutine stores the returnvalue in the return area.
1050 ! This area is in zeropage.
1051 ! The size of the object to be returned is in zeropage location
1052 ! RETSIZE.
1053 ! It also restores the localbases and the stackpointer of the
1054 ! invoking procedure.
1055
1056
1057 Ret:
1058         sty RETSIZE     ! save returnsize
1059         beq 1f          ! the return size is zero
1060         lda #0          ! address of returnvalue area (highbyte)
1061         ldx #RETURN     ! address of returnvalue area (lowbyte)
1062         cpy #2
1063         bne 2f
1064         jsr Sti         ! store word
1065         jmp 1f
1066     2:  cpy #4
1067         jsr Sdi         ! store fourbyte word
1068     1:  ldx LB          ! get old stackpointer (lowbyte)
1069         stx SP+2
1070         lda LB+1        ! get old stackpointer (highbyte)
1071         sta SP+1
1072         inc LB
1073         inc LB
1074         bne 1f
1075         inc LB+1
1076     1:  jsr Pop         ! get old localbase
1077         stx LB          ! localbase (lowbyte)
1078         sta LB+1        ! localbase (highbyte)
1079         pha
1080         sec
1081         txa
1082         sbc #BASE
1083         sta LBl         ! second localbase (lowbyte)
1084         pla
1085         sbc #0
1086         sta LBl+1       ! second localbase (highbyte)
1087         rts
1088
1089
1090 sar.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0.\ 2.define Sar
1091 .sect .text
1092 .sect .rom
1093 .sect .data
1094 .sect .bss
1095 .sect .text
1096
1097 ! This subroutine performs the SAR instruction.
1098 ! For details see rapport IR-81.
1099
1100
1101 Sar:
1102         jsr Aar         ! get object address
1103         ldy NBYTES+1    ! the size of the object (highbyte)
1104         bne 2f
1105         ldy NBYTES      ! the size of the object (lowbyte)
1106         cpy #1
1107         bne 1f          ! object size is one byte
1108         jmp Sti1        ! put it in array
1109     1:  cpy #2
1110         bne 1f          ! object size is two bytes
1111         jmp Sti         ! put it in array
1112     1:  cpy #4
1113         bne 2f          ! object size is fourbytes
1114         jmp Sdi         ! put it in array
1115     2:  jmp Stil        ! put it in array
1116
1117
1118 aar.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define Aar
1119 .sect .text
1120 .sect .rom
1121 .sect .data
1122 .sect .bss
1123 .sect .text
1124
1125 ! This subroutine gets the address of the array element
1126
1127
1128 Aar:
1129         stx ADDR        ! address of descriptor (lowbyte)
1130         sta ADDR+1      ! address of descriptor (highbyte)
1131         ldy #0
1132         lda (ADDR),y    ! lowerbound (lowbyte)
1133         tax
1134         iny
1135         lda (ADDR),y    ! lowerbound (highbyte)
1136         jsr Sbi2        ! index - lowerbound
1137         jsr Push
1138     2:  ldy #4
1139         lda (ADDR),y    ! objectsize (lowbyte)
1140         sta NBYTES
1141         tax
1142         iny
1143         lda (ADDR),y    ! objectsize (highbyte)
1144         sta NBYTES+1
1145         bne 5f
1146         cpx #1          ! objectsize = 1 then return
1147         bne 5f          ! arrayaddress + index
1148         jsr Pop
1149         jmp Adi2
1150     5:  jsr Mli2        ! objectsize > 1 then return
1151         jmp Adi2        ! arrayaddress + index * objectsize
1152
1153
1154 adi.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define  Adi2
1155 .sect .text
1156 .sect .rom
1157 .sect .data
1158 .sect .bss
1159 .sect .text
1160
1161 ! This subroutine adds two twobyte integers.
1162 ! The first operand is on the top of the stack, the second operand
1163 ! is in the AX registerpair.
1164 ! The result is returned in registerpair AX.
1165
1166
1167 Adi2:
1168         sta ARTH+1      ! second operand (highbyte)
1169         stx ARTH        ! second operand (lowbyte)
1170         jsr Pop         ! get first operand
1171         pha             ! save A
1172         clc
1173         txa
1174         adc ARTH        ! add lowbytes
1175         tax
1176         pla             ! get A
1177         adc ARTH+1      ! add the highbytes
1178         rts
1179
1180
1181 sbi.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Sbi2
1182 .sect .text
1183 .sect .rom
1184 .sect .data
1185 .sect .bss
1186 .sect .text
1187
1188 ! This subroutine subtracts two twobyte signed integers
1189 ! and returnes the result in registerpair AX.
1190
1191
1192 Sbi2:
1193         stx ARTH        ! save second operand (lowbyte)
1194         sta ARTH+1      ! save second operand (highbyte)
1195         jsr Pop
1196         pha
1197         sec
1198         txa             ! get first operand (lowbyte)
1199         sbc ARTH        ! subtract second operand (lowbyte)
1200         tax
1201         iny
1202         pla             ! get first operand (highbyte)
1203         sbc ARTH+1      ! subtract second operand (highbyte)
1204         rts
1205
1206
1207 mli.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 4.define Mli2, Mlinp, Mul
1208 .sect .text
1209 .sect .rom
1210 .sect .data
1211 .sect .bss
1212 .sect .text
1213
1214 ! The subroutine Mli2 multiplies two signed integers. The integers
1215 ! are popped from the stack.
1216 ! The subroutine Mlinp expects the two integer to be in zeropage.
1217 ! While the subroutine Mul an unsigned multiply subroutine is.
1218 ! For the algoritme see A. S. Tanenbaum
1219 !       Structured Computer Organisation. 1976.
1220
1221
1222 Mli2:
1223         stx ARTH
1224         sta ARTH+1
1225         jsr Pop
1226         stx ARTH+2
1227         sta ARTH+3
1228 Mlinp:  ldy #1
1229         sty UNSIGN      ! it's signed
1230         lda ARTH+1
1231         bpl 3f          ! multiplier negative so:
1232         ldx ARTH
1233         jsr Ngi2        ! negate multiplier
1234         stx ARTH
1235         sta ARTH+1
1236         ldx ARTH+2
1237         lda ARTH+3
1238         jsr Ngi2        ! negate multiplicand
1239         stx ARTH+2
1240         sta ARTH+3
1241 Mul:
1242     3:  lda #0
1243         sta ARTH+4
1244         sta ARTH+5
1245         sta ARTH+6
1246         sta ARTH+7      ! clear accumulator
1247         ldy #16
1248     1:  lda #0x01
1249         bit ARTH
1250         beq 2f          ! multiplying by zero: no addition
1251         clc
1252         lda ARTH+6
1253         adc ARTH+2
1254         sta ARTH+6
1255         lda ARTH+7
1256         adc ARTH+3
1257         sta ARTH+7
1258     2:  lsr ARTH+1
1259         ror ARTH        ! shift multiplier
1260         lsr ARTH+7
1261         ror ARTH+6
1262         ror ARTH+5
1263         ror ARTH+4      ! shift accumulator
1264         lda UNSIGN
1265         beq 3f          ! unsigned multiply: so no shift in of signbit
1266         lda ARTH+3
1267         bpl 3f
1268         lda #0x40
1269         bit ARTH+7
1270         beq 3f
1271         lda ARTH+7
1272         ora #0x80
1273         sta ARTH+7
1274     3:  dey
1275         bne 1b
1276         ldx ARTH+4
1277         lda ARTH+5
1278         rts
1279
1280
1281 vngi.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0Z\ 1.define Ngi2
1282 .sect .text
1283 .sect .rom
1284 .sect .data
1285 .sect .bss
1286 .sect .text
1287
1288 ! This subroutine negates the integer in registerpair AX.
1289 ! The negation is a one's complement plus one.
1290
1291
1292 Ngi2:
1293         eor #0x0FF      ! one's complement A
1294         tay
1295         txa
1296         eor #0x0FF      ! one's complement X
1297         tax
1298         inx             ! increment X
1299         bne 1f
1300         iny             ! increment A if neccesairy
1301     1:  tya
1302         rts
1303
1304
1305 set.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\r\ 3.define Set
1306 .sect .text
1307 .sect .rom
1308 .sect .data
1309 .sect .bss
1310 .sect .text
1311
1312 ! This subroutine creates a set of n (n <= 256) bytes.
1313 ! In this set a certain bit, which number is in registerpair AX,
1314 ! is set. The rest is zero.
1315
1316
1317 Set:
1318         stx ARTH        ! save bitnumber (lowbyte)
1319         sta ARTH+1      ! save bitnumber (highbyte)
1320         jsr Zer         ! create n zerobytes
1321         lda ARTH
1322         and #0x07       ! n mod 8 (bitnumber in byte)
1323         tax
1324         lda #1
1325         cpx #0
1326         beq 2f
1327     1:  asl a           ! set bit (n mod 8)
1328         dex
1329         bne 1b
1330     2:  sta ARTH+2
1331         ldx #3
1332     1:  lsr ARTH+1      ! shiftright n 3 times (= n div 8)
1333         ror ARTH        ! this is the bytenumber
1334         dex
1335         bne 1b
1336         ldy ARTH        ! load bytenumber
1337         lda SP+1
1338         ldx SP+2
1339         stx ADDR        ! address of set (lowbyte)
1340         sta ADDR+1      ! address of set (highbyte)
1341         lda ARTH+2      ! get bit
1342         sta (ADDR),y    ! store byte with bit on
1343         rts
1344
1345
1346 1zer.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0.\ 1.define Zer
1347 .sect .text
1348 .sect .rom
1349 .sect .data
1350 .sect .bss
1351 .sect .text
1352
1353 ! This subroutine puts n (n <=256) zero bytes on top of
1354 ! the stack.
1355 ! The number of bytes minus one is in Y.
1356
1357
1358 Zer:
1359         tya
1360         lsr a           ! number of bytes div 2
1361         tay
1362         iny
1363         lda #0
1364         tax
1365     2:  jsr Push        ! push two bytes
1366         dey
1367         bne 2b
1368         rts
1369
1370
1371 stl.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0.\ 1.define Stl
1372 .sect .text
1373 .sect .rom
1374 .sect .data
1375 .sect .bss
1376 .sect .text
1377
1378 ! This subroutine performs the storage of a local which offset
1379 ! is to big.
1380
1381
1382 Stl:
1383         jsr Locaddr     ! get the local address
1384         jsr Pop         ! get the word
1385         ldy #1
1386         sta (ADDR),y    ! store highbyte
1387         dey
1388         txa
1389         sta (ADDR),y    ! store lowbyte
1390         rts
1391
1392
1393 sts.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0c\ 2.define Sts
1394 .sect .text
1395 .sect .rom
1396 .sect .data
1397 .sect .bss
1398 .sect .text
1399
1400 ! This subroutine stores indirect a number of bytes.
1401 ! The number of bytes is in the registerpair AX.
1402
1403
1404 Sts:
1405         cmp #0
1406         bne 3f          ! number of bytes > 255
1407         cpx #1
1408         bne 1f          ! onebyte storage
1409         jsr Pop         ! get the address
1410         jmp Sti1        ! store the byte
1411     1:  cpx #2
1412         bne 2f          ! twobyte storage
1413         jsr Pop         ! get the address
1414         jmp Sti         ! store the word
1415     2:  cpx #4
1416         bne 3f          ! fourbyte storage
1417         jsr Pop         ! get the address
1418         jmp Sdi         ! store the double word
1419     3:  sta ARTH+1      ! objectsize > 4
1420         txa
1421         tay
1422         jsr Pop         ! get address
1423         jmp Stil        ! store the object
1424
1425
1426 msdl.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Sdi, Sdo
1427 .sect .text
1428 .sect .rom
1429 .sect .data
1430 .sect .bss
1431 .sect .text
1432
1433 ! The subroutine Sdi takes a fourbyte word and stores it
1434 ! at the address in registerpair AX.
1435 ! If the address is in zeropage, Sdo is used.
1436
1437
1438 Sdi:
1439         stx ADDR        ! address (lowbyte)
1440         sta ADDR+1      ! address (highbyte)
1441 Sdo:
1442         ldy #0
1443     1:  jsr Pop
1444         pha
1445         txa
1446         sta (ADDR),y    ! store lowbyte
1447         iny
1448         pla
1449         sta (ADDR),y    ! store highbyte
1450         iny
1451         cpy #4
1452         bne 1b
1453         rts
1454
1455
1456 sti.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0/\ 2.define Sti, Sext, Stii
1457 .sect .text
1458 .sect .rom
1459 .sect .data
1460 .sect .bss
1461 .sect .text
1462
1463 ! The subroutine Sti stores an twobyte word at the address which
1464 ! is in registerpair AX.
1465 ! The subroutine Sext is used when the address is already in
1466 ! zeropage.
1467 ! The subroutine Stii is used when the address is in zeropage
1468 ! and the registerpair AX contains the word.
1469
1470
1471 Sti:
1472         stx ADDR        ! address of word (lowbyte)
1473         sta ADDR+1      ! address of word (highbyte)
1474 Sext:
1475         jsr Pop         ! get word
1476 Stii:
1477         ldy #1
1478         sta (ADDR),y    ! store highbyte
1479         dey
1480         txa
1481         sta (ADDR),y    ! store lowbyte
1482         rts
1483
1484
1485 rstil.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define Stil
1486 .sect .text
1487 .sect .rom
1488 .sect .data
1489 .sect .bss
1490 .sect .text
1491
1492 ! This subroutine stores indirect a block of bytes if
1493 ! the number of bytes is greater than four.
1494 ! The destination address is in registerpair AX.
1495 ! The lowbyte of the number of bytes is in Y,
1496 ! the highbyte is in zeropage location NBYTES+1.
1497
1498
1499 Stil:
1500         sta ADDR+3      ! destination address (highbyte)
1501         stx ADDR+2      ! destination address (lowbyte)
1502         sty NBYTES      ! number of bytes (lowbyte)
1503         clc
1504         lda SP+2
1505         sta ADDR        ! source address (lowbyte)
1506         adc NBYTES
1507         sta SP+2        ! new stackpointer (lowbyte)
1508         lda SP+1
1509         sta ADDR+1      ! source address (highbyte)
1510         adc NBYTES+1
1511         sta SP+1        ! new stackpointer (highbyte)
1512         inc NBYTES+1
1513         jmp Blmnp       ! do the move
1514
1515
1516 blm.s\0\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 3.define Blm, Blmnp
1517 .sect .text
1518 .sect .rom
1519 .sect .data
1520 .sect .bss
1521 .sect .text
1522
1523 ! This subroutine copies bytes from one place in memory to
1524 ! another. The source address is in registerpair AX and is stored
1525 ! in zeropage locations ADDR and ADDR+1.
1526 ! The destination address is popped from the stack and stored in
1527 ! zeropage locations ADDR+2 and ADDR+3.
1528 ! The number of bytes to be copied is in register Y (lowbyte) and
1529 ! zeropage location NBYTES+1 (highbyte).
1530 ! The subroutine Blmnp is used when the source and destination
1531 ! addresses are already in zeropage.
1532
1533
1534 Blm:
1535         stx ADDR+2      ! source address (lowbyte)
1536         sta ADDR+3      ! source address (highbyte)
1537         jsr Pop
1538         stx ADDR        ! destination address (lowbyte)
1539         sta ADDR+1      ! destination address (highbyte)
1540 Blmnp:  ldx NBYTES+1
1541     1:  dey
1542         lda (ADDR),y    ! get source byte
1543         sta (ADDR+2),y  ! copy to destination
1544         tya
1545         bne 1b
1546         dec ADDR+1      ! 256 bytes copied
1547         dec ADDR+3      ! decrement source and destination address
1548         ldy #0
1549         dex
1550         bne 1b          ! do it n times
1551         rts
1552
1553
1554  sti1.s\0at.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0D\ 1.define Sti1
1555 .sect .text
1556 .sect .rom
1557 .sect .data
1558 .sect .bss
1559 .sect .text
1560
1561 ! This subroutine stores an onebyte wordfractional at the address
1562 ! which is in registerpair AX.
1563
1564
1565 Sti1:
1566         stx ADDR        ! address of byte (lowbyte)
1567         sta ADDR+1      ! address of byte (highbyte)
1568         jsr Pop         ! get byte
1569         ldy #0
1570         txa
1571         sta (ADDR),y    ! store byte
1572         rts
1573
1574
1575 test2.s\0t.s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0~\ 1.define Test2
1576 .sect .text
1577 .sect .rom
1578 .sect .data
1579 .sect .bss
1580 .sect .text
1581
1582 ! This subroutine tests if the value on top of the stack is 2.
1583 ! It is used if the size is on top of the stack.
1584 ! The word which is to be handled is returned in registerpair AX.
1585
1586
1587 Test2:
1588         tay
1589         bne 1f          ! value > 255
1590         cpx #2
1591         bne 1f          ! value <> 2
1592         jsr Pop         ! get word
1593         rts
1594     1:  ldx #Eoddz
1595         lda #0
1596         jsr Trap
1597
1598
1599 testFFh.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\85\ 1.define TestFFh
1600 .sect .text
1601 .sect .rom
1602 .sect .data
1603 .sect .bss
1604 .sect .text
1605
1606 ! This subroutine tests if the value on top of the stack is <= 256.
1607 ! It is used if the istruction argument is on top of the stack.
1608 ! The value is saved in Y.
1609
1610
1611 TestFFh:
1612         cmp #2
1613         bpl 1f          ! value > 256
1614         cmp #0
1615         beq 2f
1616         cpx #0
1617         bne 1f          ! value is zero
1618     2:  dex
1619         txa
1620         tay
1621         rts
1622     1:  ldx #Eoddz
1623         lda #0
1624         jsr Trap
1625
1626
1627  trap.s\0.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\a.define Trap
1628 .sect .text
1629 .sect .rom
1630 .sect .data
1631 .sect .bss
1632 .sect .text
1633
1634 ! This subroutine performs the trap instruction.
1635
1636 Trap:
1637         txa
1638         cmp #64
1639         bcc 1f
1640     2:  jmp Dotrap
1641     1:  bmi 2b
1642         pha
1643         lda IGNMASK     ! get bitmask (lowbyte)
1644         sta ARTH
1645         lda IGNMASK+1   ! get bitmask (highbyte)
1646     2:  lsr a
1647         ror ARTH        ! shiftright bitmask n times
1648         dex
1649         bne 2b
1650         lda #1
1651         and ARTH
1652         bne 3f
1653         pla             ! clear hardware_stack
1654         jmp Dotrap
1655     3:  pla             ! clear hardware_stack
1656         rts
1657
1658 Dotrap:
1659         sta TRAPVAL
1660         lda #0
1661         cmp ERRPROC+1
1662         bne 1f          ! ERRPROC <> 0 (highbyte)
1663         cmp ERRPROC
1664         bne 1f          ! ERRPROC <> 0 (lowbyte)
1665         jmp Mtrap
1666     1:  lda #0
1667         ldx #RETURN
1668         jsr Ldi         ! save return area
1669         lda hol0+5
1670         ldx hol0+4
1671         jsr Push        ! save filename pointer
1672         lda hol0+1
1673         ldx hol0
1674         jsr Push        ! save linenumber
1675         lda ERRPROC
1676         sta ADDR        ! address of errorhandler (lowbyte)
1677         lda ERRPROC+1
1678         sta ADDR+1      ! address of errorhandler (highbyte)
1679         lda #0
1680         sta ERRPROC     ! reset ERRPROC (lowbyte)
1681         sta ERRPROC+1   ! reset ERRPROC (highbyte)
1682         ldx TRAPVAL
1683         jsr Push
1684         jmp (ADDR)      ! proceed with errorhandler
1685
1686 Mtrap:
1687         cpx #0
1688         bne 1f
1689         lda #[EARRAY].h
1690         ldx #[EARRAY].l
1691         jsr Mprint
1692         jmp errorend
1693     1:  cpx #1
1694         bne 1f
1695         lda #[ERANGE].h
1696         ldx #[ERANGE].l
1697         jsr Mprint
1698         jmp errorend
1699     1:  cpx #2
1700         bne 1f
1701         lda #[ESET].h
1702         ldx #[ESET].l
1703         jsr Mprint
1704         jmp errorend
1705     1:  cpx #3
1706         bne 1f
1707         lda #[EIOVFL].h
1708         ldx #[EIOVFL].l
1709         jsr Mprint
1710         jmp errorend
1711     1:  cpx #10
1712         bne 1f
1713         lda #[ECONV].h
1714         ldx #[ECONV].l
1715         jsr Mprint
1716         jmp errorend
1717     1:  cpx #16
1718         bne 1f
1719         lda #[ESTACK].h
1720         ldx #[ESTACK].l
1721         jsr Mprint
1722         jmp errorend
1723     1:  cpx #17
1724         bne 1f
1725         lda #[EHEAP].h
1726         ldx #[EHEAP].l
1727         jsr Mprint
1728         jmp errorend
1729     1:  cpx #19
1730         bne 1f
1731         lda #[EODDZ].h
1732         ldx #[EODDZ].l
1733         jsr Mprint
1734         jmp errorend
1735     1:  cpx #20
1736         bne 1f
1737         lda #[ECASE].h
1738         ldx #[ECASE].l
1739         jsr Mprint
1740         jmp errorend
1741     1:  cpx #25
1742         bne 1f
1743         lda #[EBADMON].h
1744         ldx #[EBADMON].l
1745         jsr Mprint
1746         jmp errorend
1747     1:  cpx #26
1748         bne 1f
1749         lda #[EBADLIN].h
1750         ldx #[EBADLIN].l
1751         jsr Mprint
1752         jmp errorend
1753     1:  cpx #27
1754         bne errorend
1755         lda #[EBADGTO].h
1756         ldx #[EBADGTO].l
1757         jsr Mprint
1758 errorend:
1759         ldx TRAPVAL
1760         jmp EXIT
1761 ldi.s\0\0.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Ldi, Ldo
1762 .sect .text
1763 .sect .rom
1764 .sect .data
1765 .sect .bss
1766 .sect .text
1767
1768 ! The subroutine Ldi pushes a four byte object onto the stack.
1769 ! The address is in registerpair AX.
1770 ! If the address is already in zeropage Ldo is used.
1771
1772
1773 Ldi:
1774         stx ADDR        ! address of object (lowbyte)
1775         sta ADDR+1      ! address of object (highbyte)
1776 Ldo:
1777         ldy #3
1778     1:  lda (ADDR),y    ! get lowbyte
1779         pha
1780         dey
1781         lda (ADDR),y    ! get highbyte
1782         tax
1783         pla
1784         jsr Push        ! do the push
1785         dey
1786         bpl 1b          ! perform 2 times
1787         rts
1788
1789
1790 data.s\0.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define EARRAY,ERANGE,ESET,EIOVFL
1791 .define ECONV,ESTACK
1792 .define EHEAP,EODDZ,ECASE
1793 .define EBADMON,EBADLIN,EBADGTO
1794 .sect .text
1795 .sect .rom
1796 .sect .data
1797 .sect .bss
1798 .sect .text
1799
1800 ! This file contains the global data used by the trap routine.
1801
1802
1803 ! DATA
1804 .sect .data
1805 EARRAY:
1806 .asciz  "Array bound error\n\r"
1807 ERANGE:
1808 .asciz  "Range bound error\n\r"
1809 ESET:
1810 .asciz  "Set bound error\n\r"
1811 EIOVFL:
1812 .asciz  "Integer overflow\n\r"
1813 ECONV:
1814 .asciz  "Conversion error\n\r"
1815 ESTACK:
1816 .asciz  "Stack overflow\n\r"
1817 EHEAP:
1818 .asciz  "Heap overflow\n\r"
1819 EODDZ:
1820 .asciz  "Illegal size argument\n\r"
1821 ECASE:
1822 .asciz  "Case error\n\r"
1823 EBADMON:
1824 .asciz  "Bad monitor call\n\r"
1825 EBADLIN:
1826 .asciz  "Argument of LIN to high\n\r"
1827 EBADGTO:
1828 .asciz  "GTO descriptor error\n\r"
1829
1830
1831 lzri.s\0\0.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\83\ 1.define Zrl, Zro
1832 .sect .text
1833 .sect .rom
1834 .sect .data
1835 .sect .bss
1836 .sect .text
1837
1838 ! The subroutine Zrl makes a local zero which offset is to big.
1839 ! The offset of the local is in registerpair AX.
1840 ! The subroutine Zro is used if the address is already in zeropage.
1841
1842
1843 Zrl:
1844         jsr Locaddr     ! get address of local
1845 Zro:
1846         lda #0
1847         tay
1848         sta (ADDR),y    ! lowbyte = 0
1849         iny
1850         sta (ADDR),y    ! highbyte = 0
1851         rts
1852
1853
1854 tlocaddr.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0s\ 1.define Locaddr
1855 .sect .text
1856 .sect .rom
1857 .sect .data
1858 .sect .bss
1859 .sect .text
1860
1861 ! This routine gets the address of a local which offset is to big.
1862 ! The offset is in registerpair AX.
1863
1864
1865 Locaddr:
1866         pha             ! save A
1867         txa
1868         clc
1869         adc LB          ! localbase + offset (lowbyte)
1870         sta ADDR        ! address (lowbyte)
1871         pla
1872         adc LB+1        ! localbase + offset (highbyte)
1873         sta ADDR+1      ! address (highbyte)
1874         rts
1875
1876
1877 band.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\96\ 3.define And
1878 .sect .text
1879 .sect .rom
1880 .sect .data
1881 .sect .bss
1882 .sect .text
1883
1884 ! This subroutine performs the logical and on two groups of
1885 ! atmost 254 bytes. The number of bytes is in register Y.
1886 ! The two groups are on the stack.
1887 ! First the value of the stackpointer is saved in zeropage
1888 ! locations ADDR, ADDR+1. Then an offset of Y is added
1889 ! and stored in ADDR+2, ADDR+3.
1890 ! The result is pushed back on the stack.
1891
1892
1893 And:
1894         lda SP+1
1895         sta ADDR+1      ! address of first group (lowbyte)
1896         lda SP+2
1897         sta ADDR        ! address of first group (highbyte)
1898         clc
1899         tya
1900         adc SP+2
1901         sta SP+2        ! new stackpointer (lowbyte)
1902         sta ADDR+2      ! stackpointer + Y (lowbyte)
1903         lda #0
1904         adc SP+1
1905         sta SP+1        ! new stackpointer (highbyte)
1906         sta ADDR+3      ! stackpointer + Y (highbyte)
1907     1:  dey
1908         lda (ADDR),y    ! get byte first group
1909         and (ADDR+2),y  ! perform logical and with second group
1910         sta (ADDR+2),y  ! push result on real_stack
1911         tya
1912         bne 1b          ! do it n times
1913         rts
1914
1915
1916 asp.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Asp
1917 .sect .text
1918 .sect .rom
1919 .sect .data
1920 .sect .bss
1921 .sect .text
1922
1923 ! This subroutine adds an offset to the stackpointer,
1924 ! e.g. after the return from a procedurecall.
1925 ! The offset is in registerpair AX, and is added to the
1926 ! stackpointer.
1927
1928
1929 Asp:
1930         tay             ! save A
1931         txa             ! get X
1932         clc
1933         adc SP+2        ! add adjustment (lowbyte)
1934         sta SP+2        ! new stackpointer (lowbyte)
1935         tya             ! get A
1936         adc SP+1        ! add adjustment (highbyte)
1937         sta SP+1        ! get stackpointer (highbyte)
1938         rts
1939
1940
1941  cii.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\96\ 4.define Cii
1942 .sect .text
1943 .sect .rom
1944 .sect .data
1945 .sect .bss
1946 .sect .text
1947
1948 ! This subroutine converts integers to integers.
1949 ! Convertions of integers with the same source size as destination
1950 ! size aren't done, there just return the source.
1951 ! A convertion from 4 bytes to 2 bytes just strips the two
1952 ! most significant bytes.
1953 ! A convertion from 2 bytes to 4 bytes tests the sign of the
1954 ! source so that sign extentension takes place if neccesairy.
1955
1956
1957 Cii:
1958         cpx #2
1959         beq Cii_2       ! a conversion from ? to 2
1960         jsr Pop         ! a conversion from 4 to ?
1961         cpx #4
1962         beq 8f          ! a conversion 4 to 4 (skip)
1963         jsr Pop
1964         tay             ! save A for sign test
1965         pha             ! save A
1966         txa
1967         pha             ! save X
1968         tya             ! test on negative
1969         bmi 1f          ! negative means sign extension
1970         lda #0          ! no sign extension here
1971         tax
1972         beq 2f
1973     1:  lda #0x0FF      ! sign extension here
1974         tax
1975     2:  jsr Push        ! push twobyte integer
1976         pla
1977         tax             ! get X
1978         pla             ! get A
1979         jmp Push
1980 Cii_2:                  ! a conversion from 2 to ?
1981         jsr Pop
1982         cpx #2
1983         beq 8f          ! a conversion from 2 to 2 (skip)
1984         jsr Pop         ! a conversion from 4 to 2
1985         pha             ! save A
1986         txa
1987         pha             ! save X
1988         jsr Pop         ! strip most significant bytes
1989         pla             ! get X
1990         tax
1991         pla             ! get A
1992         jmp Push        ! push result
1993     8:  rts
1994
1995
1996 cms.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 3.define Cms
1997 .sect .text
1998 .sect .rom
1999 .sect .data
2000 .sect .bss
2001 .sect .text
2002
2003 ! This subroutine compares two groups of bytes, bit for bit.
2004 ! The groups can consist of 2 or 4 bytes. This number is in
2005 ! register Y.
2006 ! The address of the first group is stored in zeropage locations
2007 ! ADDR and ADDR+1, the address of the second group in ADDR+2 and ADDR+3
2008 ! The routine returns a 0 on equality, a 1 otherwise.
2009
2010
2011
2012 Cms:
2013         lda SP+2
2014         ldx SP+1
2015         sta ADDR        ! address of first group (lowbyte)
2016         stx ADDR+1      ! address of second group (highbyte)
2017         clc
2018         tya
2019         adc SP+2
2020         sta SP+2
2021         sta ADDR+2      ! address of second group (lowbyte)
2022         txa
2023         adc #0
2024         sta ADDR+3      ! address of second group (highbyte)
2025         tax
2026         clc
2027         tya
2028         adc SP+2
2029         sta SP+2        ! new stackpointer (lowbyte)
2030         txa
2031         adc #0
2032         sta SP+1        ! new stackpointer (highbyte)
2033     1:  dey
2034         lda (ADDR),y    ! get byte first group
2035         cmp (ADDR+2),y  ! compare bit for bit with byte second group
2036         bne 2f
2037         tya
2038         bne 1b
2039         lda #0          ! both groups are equal
2040         tax
2041         rts
2042     2:  lda #0          ! there is a difference between the groups
2043         ldx #1
2044         rts
2045
2046
2047 cmu.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\13\ 2.define Cmu2
2048 .sect .text
2049 .sect .rom
2050 .sect .data
2051 .sect .bss
2052 .sect .text
2053
2054 ! This subroutine compares two unsigned twobyte integers.
2055 ! If T is the first pushed and than S, the routine will return:
2056 !    -1  if S < T,
2057 !     0  if S = T,
2058 !     1  if S > T.
2059
2060 Cmu2:
2061         stx EXG         ! S (lowbyte)
2062         sta EXG+1       ! S (highbyte)
2063         jsr Pop         ! get T
2064         cmp EXG+1
2065         beq 2f          ! S (highbyte)  =  T (highbyte)
2066         bcc 1f
2067     4:  lda #0          ! S > T
2068         ldx #1
2069         rts
2070     1:  lda #0xFF       ! S < T
2071         tax
2072         rts
2073     2:  cpx EXG
2074         bne 3f
2075         lda #0          ! S = T
2076         tax
2077         rts
2078     3:  bcc 1b
2079         bcs 4b
2080
2081
2082 dcom.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Com
2083 .sect .text
2084 .sect .rom
2085 .sect .data
2086 .sect .bss
2087 .sect .text
2088
2089 ! This subroutine performs a one complement on
2090 ! a group of atmost 254 bytes (number in register Y).
2091 ! This group is on the top of the stack.
2092
2093
2094 Com:
2095         lda SP+1
2096         sta ADDR+1      ! address (highbyte) of first byte
2097         lda SP+2
2098         sta ADDR        ! address (lowbyte) of first byte
2099     1:  dey
2100         lda (ADDR),y
2101         eor #0x0FF      ! one complement
2102         sta (ADDR),y
2103         tya
2104         bne 1b          ! do it n times
2105         rts
2106
2107
2108 csa.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\07\ 6.define Csa
2109 .sect .text
2110 .sect .rom
2111 .sect .data
2112 .sect .bss
2113 .sect .text
2114
2115 ! This subroutine performs the case jump by indexing.
2116 ! The zeropage locations ADDR, ADDR+1 contain the address of
2117 ! the case descriptor which also is the address of the
2118 ! default pointer.
2119 ! The zeropage locations ADDR+2, ADDR+3 contain the address of the
2120 ! indextable which is the casedescriptor + 6.
2121
2122 Csa:
2123         stx ADDR        ! address of descriptor (lowbyte)
2124         sta ADDR+1      ! address of descriptor (highbyte)
2125         tay
2126         txa
2127         clc
2128         adc #6
2129         sta ADDR+2      ! address of index table (lowbyte)
2130         tya
2131         adc #0
2132         sta ADDR+3      ! address of index table (highbyte)
2133         jsr Pop         ! fetch index
2134         pha             ! subtract lowerbound
2135         txa
2136         ldy #2
2137         sec
2138         sbc (ADDR),y
2139         sta ARTH        ! lowerbound (lowbyte)
2140         pla
2141         iny
2142         sbc (ADDR),y
2143         sta ARTH+1      ! lowerbound (highbyte)
2144         bmi 1f          ! index < lowerbound
2145         ldy #5
2146         lda (ADDR),y
2147         cmp ARTH+1
2148         bcc 1f          ! index (highbyte) > upperbound - lowerbound
2149         bne 2f          ! index (highbyte) <= upperbound - lowerbound
2150         dey
2151         lda (ADDR),y
2152         cmp ARTH
2153         bcc 1f          ! index (lowbyte) > upperbound - lowerbound
2154     2:  asl ARTH
2155         rol ARTH+1      ! index * 2
2156         clc
2157         lda ADDR+2
2158         adc ARTH
2159         sta ADDR+2      ! address of pointer (lowbyte)
2160         lda ADDR+3
2161         adc ARTH+1
2162         sta ADDR+3      ! address of pointer (highbyte)
2163         ldy #0
2164         lda (ADDR+2),y  ! jump address (lowbyte)
2165         tax
2166         iny
2167         lda (ADDR+2),y  ! jump address (highbyte)
2168         bne 3f
2169         cpx #0
2170         beq 1f
2171     3:  stx ADDR        ! pointer <> 0
2172         sta ADDR+1
2173         jmp (ADDR)      ! jump to address
2174     1:  ldy #0          ! pointer = 0
2175         lda (ADDR),y    ! get default pointer (lowbyte)
2176         tax
2177         iny
2178         lda (ADDR),y    ! get default pointer (highbyte)
2179         bne 3b
2180         cpx #0
2181         bne 3b          ! default pointer <> 0
2182
2183
2184 rcsb.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0"\ 5.define Csb
2185 .sect .text
2186 .sect .rom
2187 .sect .data
2188 .sect .bss
2189 .sect .text
2190
2191 ! This subroutine performs the case jump by searching the table.
2192 ! The zeropage locations ADDR, ADDR+1 contain the address of the
2193 ! case descriptor, which also is the address of the default pointer.
2194 ! The zeropage locations ADDR+2, ADDR+3 are used to address the jump
2195 ! pointers.
2196
2197
2198 Csb:
2199         stx ADDR        ! address of descriptor (lowbyte)
2200         sta ADDR+1      ! address of descriptor (highbyte)
2201         stx ADDR+2
2202         sta ADDR+3
2203         ldy #2
2204         lda (ADDR),y    ! number of entries (lowbyte)
2205         pha
2206         jsr Pop
2207         stx ARTH        ! index (lowbyte)
2208         sta ARTH+1      ! index (highbyte)
2209         pla
2210         tax
2211         inx
2212     2:  clc
2213         lda #4
2214         adc ADDR+2
2215         sta ADDR+2      ! pointer (lowbyte)
2216         bcc 1f
2217         lda #0
2218         adc ADDR+3
2219         sta ADDR+3      ! pointer (highbyte)
2220     1:  ldy #0
2221         lda (ADDR+2),y
2222         cmp ARTH
2223         bne 3f          ! pointer (lowbyte) <> index (lowbyte)
2224         iny
2225         lda (ADDR+2),y
2226         cmp ARTH+1
2227         bne 3f          ! pointer (highbyte) <> index (highbyte)
2228         iny
2229         lda (ADDR+2),y  ! jump address (lowbyte)
2230         tax
2231         iny
2232         lda (ADDR+2),y  ! jump address (highbyte)
2233         jmp 4f
2234     3:  dex
2235         bne 2b
2236     5:  ldy #0
2237         lda (ADDR),y    ! default pointer (lowbyte)
2238         tax
2239         iny
2240         lda (ADDR),y    ! default pointer (highbyte)
2241         beq 1f
2242     4:  bne 1f          ! pointer (lowbyte) <> 0
2243         cpx #0
2244         bne 1f          ! pointer (highbyte) <> 0
2245         beq 5b          ! get default pointer
2246     1:  stx ADDR
2247         sta ADDR+1
2248         jmp (ADDR)      ! jump
2249
2250
2251 dup.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\9a\ 2.define Dup
2252 .sect .text
2253 .sect .rom
2254 .sect .data
2255 .sect .bss
2256 .sect .text
2257
2258 ! This subroutine duplicate's the top n (in register Y) bytes.
2259 ! N is atmost 256.
2260 ! The duplicating takes place as follows.
2261 ! The registerpair is filled with the bytes at stackpointer + N
2262 ! and stackpopinter + N-1.
2263 ! These two bytes then are pushed onto the stack.
2264 ! Next the offset N is decremented and the next two byte are taken
2265 ! care off. Until N = 0.
2266
2267
2268 Dup:
2269         lda SP+1
2270         ldx SP+2
2271         stx ADDR        ! address of group (lowbyte)
2272         sta ADDR+1      ! address of group (highbyte)
2273     1:  dey
2274         lda (ADDR),y    ! get lowbyte
2275         pha
2276         dey
2277         lda (ADDR),y    ! get highbyte
2278         tax
2279         pla
2280         jsr Push        ! push them
2281         tya
2282         bne 1b
2283         rts
2284
2285
2286 dvu.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define Dvu2
2287 .sect .text
2288 .sect .rom
2289 .sect .data
2290 .sect .bss
2291 .sect .text
2292
2293 ! This subroutine performs a twobyte unsigned division
2294 ! For more details see dvi.s.
2295
2296
2297 Dvu2:
2298         stx ARTH
2299         sta ARTH+1
2300         jsr Pop
2301         stx ARTH+2
2302         sta ARTH+3
2303         ldy #0
2304         sty UNSIGN
2305         jmp Duv
2306
2307
2308 texg.s\0r.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0[\ 3.define Exg
2309 .sect .text
2310 .sect .rom
2311 .sect .data
2312 .sect .bss
2313 .sect .text
2314
2315 ! This subroutine exchanges two groups of bytes on the top of the
2316 ! stack. The groups may consist of atmost 255 bytes.
2317 ! This number is in register Y.
2318 ! The exchange is from ADDR, ADDR+1 to ADDR+2, ADDR+3
2319
2320
2321 Exg:
2322         lda SP+1
2323         ldx SP+2
2324         stx ADDR        ! address of first group (lowbyte)
2325         sta ADDR+1      ! address of first group (highbyte)
2326         sty Ytmp        ! save number of bytes to be exchanged
2327         clc
2328         lda SP+2
2329         adc Ytmp
2330         sta ADDR+2      ! address of second group (lowbyte)
2331         lda SP+1
2332         adc #0
2333         sta ADDR+3      ! address of second group (highbyte)
2334     1:  dey
2335         lda (ADDR),y    ! get byte from first group
2336         pha             ! temporary save
2337         lda (ADDR+2),y  ! get byte from second group
2338         sta (ADDR),y    ! store in first group
2339         pla             ! get temporary saved byte
2340         sta (ADDR+2),y  ! store in second group
2341         tya
2342         bne 1b          ! perform n times
2343         rts
2344
2345
2346         exg2.s\0.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Exg2
2347 .sect .text
2348 .sect .rom
2349 .sect .data
2350 .sect .bss
2351 .sect .text
2352
2353 ! This subroutine exchanges two words on top of the stack.
2354 ! The top word of the stack is really in the AX registerpair.
2355 ! So this word is exchanged with the top of the real stack.
2356
2357
2358 Exg2:
2359         pha             ! save A
2360         txa
2361         pha             ! save X
2362         jsr Pop         ! get top real stack
2363         stx EXG
2364         sta EXG+1       ! save top of real stack
2365         pla             ! get X
2366         tax
2367         pla             ! get A
2368         jsr Push        ! push on real stack
2369         ldx EXG         ! get new X
2370         lda EXG+1       ! get new A
2371         rts
2372
2373
2374 gto.s\0\0.s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 5.define Gto
2375 .sect .text
2376 .sect .rom
2377 .sect .data
2378 .sect .bss
2379 .sect .text
2380
2381 ! This subroutine performs the non_local goto.
2382 ! The address of the descriptor is stored in zeropage locations
2383 ! ADDR, ADDR+1.
2384 ! Since there are two stacks (hardware_stack and the real_stack),
2385 ! the stackpointer of the hard_stack is resetted by searching the
2386 ! new localbase in the real_stack while adjusting the hardware_stack.
2387
2388
2389 Gto:
2390         stx ADDR        ! address of descripto (lowbyte)
2391         sta ADDR+1      ! address of descriptor (highbyte)
2392         pla             ! remove
2393         pla             ! __gto return address.
2394         ldy #4
2395         lda (ADDR),y    ! new localbase (lowbyte)
2396         sta ARTH
2397         tax
2398         iny
2399         lda (ADDR),y    ! new localbase (highbyte)
2400         sta ARTH+1
2401         cmp LB+1
2402         bne 1f
2403         cpx LB
2404         beq 2f          ! goto within same procedure
2405     1:  ldy #0
2406         lda (LB),y      ! get localbase (lowbyte)
2407         tax
2408         iny
2409         lda (LB),y      ! get localbase (highbyte)
2410         cmp ARTH+1
2411         bne 3f
2412         cpx ARTH
2413         beq 2f          ! found localbase
2414     3:  stx LB          ! temporary save of localbase
2415         sta LB+1
2416         pla             ! adjust
2417         pla             ! hardware_stack
2418         jmp 1b
2419     2:  sta LB+1        ! store localbase (highbyte)
2420         pha
2421         stx LB          ! store localbase (lowbyte)
2422         sec
2423         txa
2424         sbc #BASE
2425         sta LBl         ! localbase - 240 (lowbyte)
2426         pla
2427         sbc #0
2428         sta LBl+1       ! localbase - 240 (highbyte)
2429         ldy #3
2430         lda (ADDR),y    ! new stackpointer (highbyte)
2431         sta SP+1
2432         dey
2433         lda (ADDR),y    ! new stackpointer (lowbyte)
2434         sta SP+2
2435         dey
2436         lda (ADDR),y    ! jump address (highbyte)
2437         sta ADDR+3
2438         dey
2439         lda (ADDR),y    ! jump address (lowbyte)
2440         sta ADDR+2
2441         jmp (ADDR+2)    ! jump to address
2442
2443
2444 indir.s\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0Z\ 1.define Indir
2445 .sect .text
2446 .sect .rom
2447 .sect .data
2448 .sect .bss
2449 .sect .text
2450
2451 ! This subroutine performs an indirect procedurecall.
2452 ! This must be done this way since the jump instruction
2453 ! is the only one which can indirect change the programcounter.
2454 ! The address of the function must be in zeropage loactions
2455 ! ADDR, ADDR+1.
2456
2457
2458 Indir:
2459         jmp (ADDR)
2460
2461
2462 inn.s\0s\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\9c\ 4.define Inn
2463 .sect .text
2464 .sect .rom
2465 .sect .data
2466 .sect .bss
2467 .sect .text
2468
2469 ! This subroutine checks if a certain bit is set in a set
2470 ! of n bytes on top of the stack.
2471
2472
2473 Inn:
2474         stx ARTH        ! save bit number (lowbyte)
2475         sta ARTH+1      ! save bit number (highbyte)
2476         and #0x80
2477         beq 1f
2478         lda #0          ! bit number is negative
2479         sta ARTH+2      ! make it zero
2480         beq 3f
2481     1:  txa
2482         and #0x07       ! get bit number mod 8
2483         tax
2484         lda #1
2485         cpx #0          ! bit number = 0
2486         beq 2f          ! no shifting to right place
2487     1:  asl a           ! shift left until bit is in place
2488         dex
2489         bne 1b
2490     2:  sta ARTH+2      ! bit is one in place
2491         ldx #3
2492     1:  lsr ARTH+1      ! shift left 3 times bit number (highbyte)
2493         ror ARTH        ! shift left 3 times bit number (lowbyte)
2494         dex             ! this is bit number div 8
2495         bne 1b          ! which is byte number
2496     3:  lda SP+1
2497         ldx SP+2
2498         stx ADDR        ! address of the set (lowbyte)
2499         sta ADDR+1      ! address of the set (highbyte)
2500         iny
2501         tya
2502         bne 2f
2503         inc SP+1
2504     2:  clc             ! remove the set
2505         adc SP+2
2506         sta SP+2        ! new stackpointer (lowbyte)
2507         lda #0
2508         adc SP+1
2509         sta SP+1        ! new stackpointer (highbyte)
2510         ldy ARTH
2511         lda (ADDR),y    ! load the byte in A
2512         bit ARTH+2      ! test bit
2513         bne 1f
2514     3:  lda #0          ! bit is zero
2515         tax
2516         rts
2517     1:  lda #0          ! bit is one
2518         ldx #1
2519         rts
2520
2521
2522 ior.s\0s\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define Ior
2523 .sect .text
2524 .sect .rom
2525 .sect .data
2526 .sect .bss
2527 .sect .text
2528
2529 ! This subroutine performs the logical inclusive or on two
2530 ! groups of bytes. The groups may consist of atmost 254 bytes.
2531 ! The two groups are on the stack.
2532
2533 Ior:
2534         lda SP+1
2535         sta ADDR+1      ! address of the first group (highbyte)
2536         lda SP+2
2537         sta ADDR        ! address of the first group (lowbyte)
2538         clc
2539         tya
2540         adc SP+2
2541         sta SP+2        ! new stackpointer (lowbyte)
2542         sta ADDR+2      ! address of second group (lowbyte)
2543         lda #0
2544         adc SP+1
2545         sta SP+1        ! new stackpointer (highbyte)
2546         sta ADDR+3      ! address of second group (highbyte)
2547     1:  dey
2548         lda (ADDR),y    ! get byte first group
2549         ora (ADDR+2),y  ! inclusive or with byte second group
2550         sta (ADDR+2),y  ! restore result on stack
2551         tya
2552         bne 1b          ! perform n times
2553         rts
2554
2555
2556         lcs.s\0s\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\82\ 1.define Lcs
2557 .sect .text
2558 .sect .rom
2559 .sect .data
2560 .sect .bss
2561 .sect .text
2562
2563 ! This subroutine creates space for locals on procedure entry
2564 ! by lowering the stackpointer.
2565
2566
2567 Lcs:
2568         sta ARTH        ! number of locals (lowbyte)
2569         stx ARTH+1      ! number of locals (highbyte)
2570         sec
2571         lda SP+2
2572         sbc ARTH
2573         sta SP+2        ! new stackpointer (lowbyte)
2574         lda SP+1
2575         sbc ARTH+1
2576         sta SP+1        ! new stackpointer (highbyte)
2577         rts
2578
2579
2580 lxa1.s\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0;\ 1.define Lxa1
2581 .sect .text
2582 .sect .rom
2583 .sect .data
2584 .sect .bss
2585 .sect .text
2586
2587 ! This subroutine loads the address of AB zero static levels back.
2588
2589 Lxa1:
2590         ldy LB+1        ! load address of localbase (highbyte)
2591         ldx LB          ! load address of localbase (lowbyte)
2592         inx
2593         inx             ! argumentbase = localbase + 2
2594         bne 1f
2595         iny
2596     1:  tya
2597         rts
2598
2599
2600 )lxa2.s\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\04\ 2.define Lxa2
2601 .sect .text
2602 .sect .rom
2603 .sect .data
2604 .sect .bss
2605 .sect .text
2606
2607 ! This subroutine load the address of AB n (255 >= n > 0) static levels
2608 ! back.
2609
2610
2611 Lxa2:
2612         lda LB
2613         sta ADDR        ! address of localbase (lowbyte)
2614         lda LB+1
2615         sta ADDR+1      ! address of localbase (highbyte)
2616     1:  ldy #2
2617         lda (ADDR),y    ! static level LB (lowbyte)
2618         pha
2619         iny
2620         lda (ADDR),y    ! static level LB (highbyte)
2621         sta ADDR+1      ! static level LB (highbyte)
2622         pla
2623         sta ADDR        ! static level LB (lowbyte)
2624         dex
2625         bne 1b
2626         tax
2627         ldy ADDR+1
2628         inx
2629         inx             ! argumentbase = localbase + 2
2630         bne 1f
2631         iny
2632     1:  tya
2633         rts
2634
2635
2636
2637 lxl.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Lxl
2638 .sect .text
2639 .sect .rom
2640 .sect .data
2641 .sect .bss
2642 .sect .text
2643
2644 ! This subroutine loads LB n (255 => n > 0) static levels back.
2645
2646
2647 Lxl:
2648         lda LB
2649         sta ADDR        ! address of localbase (lowbyte)
2650         lda LB+1
2651         sta ADDR+1      ! address of localbase (highbyte)
2652     1:  ldy #2
2653         lda (ADDR),y    ! get localbase (lowbyte) 1 level back
2654         pha
2655         iny
2656         lda (ADDR),y    ! get localbase (highbyte) 1 level back
2657         sta ADDR+1      ! new localbase (highbyte)
2658         pla
2659         sta ADDR        ! new localbase (lowbyte)
2660         dex
2661         bne 1b          ! n levels
2662         tax
2663         lda ADDR+1
2664         rts
2665
2666
2667 npro.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define Pro
2668 .sect .text
2669 .sect .rom
2670 .sect .data
2671 .sect .bss
2672 .sect .text
2673
2674 ! This routine is called at the entry of a procedure.
2675 ! It saves the localbase of the invoking procedure, and sets the
2676 ! new localbase to the present value of the stackpointer.
2677 ! It then initializes the second localbase by subtracting
2678 ! BASE from the real one.
2679
2680
2681 Pro:
2682         ldx LB          ! get localbase (lowbyte)
2683         lda LB+1        ! get localbase (highbyte)
2684         jsr Push        ! push localbase onto the stack
2685         ldx SP+2        ! get stackpointer (lowbyte)
2686         lda SP+1        ! get stackpointer (highbyte)
2687         stx LB          ! new localbase (lowbyte)
2688         sta LB+1        ! new localbse (highbyte)
2689         tay
2690         txa
2691         sec
2692         sbc #BASE
2693         sta LBl         ! second localbase (lowbyte)
2694         tya
2695         sbc #0
2696         sta LBl+1       ! second localbase (highbyte)
2697         rts
2698
2699
2700 frol.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Rol
2701 .sect .text
2702 .sect .rom
2703 .sect .data
2704 .sect .bss
2705 .sect .text
2706
2707 ! This subroutine rotates left an integer n times
2708 ! N is in register X.
2709 ! The result is returned in registerpair AX.
2710
2711
2712 Rol:
2713
2714         txa
2715         bne 1f
2716         jmp Pop         ! zero rotate return input
2717     1:  tay             ! Y contains number of rotates
2718         jsr Pop
2719         stx Ytmp        ! save lowbyte
2720     2:  clc
2721         rol Ytmp        ! rotate lowbyte
2722         rol a           ! rotate highbyte
2723         bcc 1f          ! no carry
2724         inc Ytmp        ! put carry in rightmost bit
2725     1:  dey
2726         bne 2b
2727         ldx Ytmp        ! store lowbyte in X
2728         rts
2729
2730
2731 rol4.s\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Rol4
2732 .sect .text
2733 .sect .rom
2734 .sect .data
2735 .sect .bss
2736 .sect .text
2737
2738 ! This subroutine rotates left a fourbyte integer n times.
2739 ! N is in register X.
2740
2741
2742 Rol4:
2743         txa
2744         bne 1f          ! a zero rotate skip
2745         rts
2746     1:  tay
2747         jsr Pop
2748         stx ARTH
2749         sta ARTH+1
2750         jsr Pop
2751         stx ARTH+2
2752         sta ARTH+3
2753     2:  asl ARTH
2754         rol ARTH+1
2755         rol ARTH+2
2756         rol ARTH+3      ! rotate left
2757         bcc 1f
2758         inc ARTH        ! put carry in rightmost bit
2759     1:  dey
2760         bne 2b
2761         ldx ARTH+2
2762         lda ARTH+3
2763         jsr Push
2764         ldx ARTH
2765         lda ARTH+1
2766         jmp Push
2767
2768
2769 ror.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Ror
2770 .sect .text
2771 .sect .rom
2772 .sect .data
2773 .sect .bss
2774 .sect .text
2775
2776 ! This subroutine rotates right a integer twobyte word.
2777 ! The number of rotates is in X.
2778 ! The result is returned in registerpair AX.
2779
2780
2781 Ror:
2782         txa
2783         bne 1f          ! a zero rotate just return input
2784         jmp Pop
2785     1:  tay
2786         jsr Pop         ! get word
2787         stx Ytmp        ! save lowbyte
2788     2:  clc
2789         ror a           ! rotate highbyte
2790         ror Ytmp        ! rotate lowbyte
2791         bcc 1f          ! no carry
2792         ora #0x80       ! put carry in leftmost bit
2793     1:  dey
2794         bne 2b
2795         ldx Ytmp        ! get lowbyte
2796         rts
2797
2798
2799 tror4.s\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\1e\ 2.define Ror4
2800 .sect .text
2801 .sect .rom
2802 .sect .data
2803 .sect .bss
2804 .sect .text
2805
2806 ! This subroutine rotates right a fourbyte word.
2807 ! The number of rotates is in X.
2808
2809
2810 Ror4:
2811         txa
2812         bne 1f          ! a zero rotate skip
2813         rts
2814     1:  tay
2815         jsr Pop
2816         stx ARTH
2817         sta ARTH+1
2818         jsr Pop
2819         stx ARTH+2
2820         sta ARTH+3
2821     2:  lsr ARTH+3      ! rotate word
2822         ror ARTH+2
2823         ror ARTH+1
2824         ror ARTH
2825         bcc 1f          ! no carry
2826         lda #0x80       ! put carry in leftmost bit
2827         ora ARTH+3
2828         sta ARTH+3
2829     1:  dey
2830         bne 2b
2831         lda ARTH+3
2832         ldx ARTH+2
2833         jsr Push
2834         lda ARTH+1
2835         ldx ARTH
2836         jmp Push        ! push result onto the stack
2837
2838
2839 sli.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define Sli2
2840 .sect .text
2841 .sect .rom
2842 .sect .data
2843 .sect .bss
2844 .sect .text
2845
2846 ! This subroutine shifts a signed or unsigned interger to the
2847 ! left n times.
2848 ! N is in register X.
2849 ! The returned value is in registerpair AX.
2850
2851
2852 Sli2:
2853         txa
2854         bne 1f
2855         jmp Pop         ! zero shift, return input
2856     1:  tay
2857         jsr Pop         ! get integer
2858         stx Ytmp        ! save lowbyte
2859     2:  asl Ytmp
2860         rol a           ! shift left
2861         dey
2862         bne 2b
2863         ldx Ytmp        ! get lowbyte
2864         rts
2865
2866
2867 Asli4.s\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0@\ 2.define Sli4
2868 .sect .text
2869 .sect .rom
2870 .sect .data
2871 .sect .bss
2872 .sect .text
2873
2874 ! This subroutine shift a signed or unsigned fourbyte integer
2875 ! n times left. N is in register X.
2876
2877
2878 Sli4:
2879         cpx #0
2880         beq 9f          ! zero shift, return input
2881         lda SP+2        ! the shifting is done on the stack
2882         sta ADDR        ! address of integer (lowbyte)
2883         lda SP+1
2884         sta ADDR+1      ! address of integer (highbyte)
2885     2:  ldy #0
2886         clc
2887         lda (ADDR),y
2888         rol a
2889         sta (ADDR),y
2890         iny
2891         lda (ADDR),y
2892         rol a
2893         sta (ADDR),y
2894         iny
2895         lda (ADDR),y
2896         rol a
2897         sta (ADDR),y
2898         iny
2899         lda (ADDR),y
2900         rol a
2901         sta (ADDR),y    ! shift left
2902         dex
2903         bne 2b
2904     9:  rts
2905
2906
2907 sri.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\13\ 3.define Sri2, Sru2
2908 .sect .text
2909 .sect .rom
2910 .sect .data
2911 .sect .bss
2912 .sect .text
2913
2914 ! The subroutine Sri2 shifts a signed integer n times right.
2915 ! In the case of a negative integer there is signextension.
2916 ! The subroutine Sru2 shifts right an unsigned integer.
2917 ! The returned value is in registerpair AX.
2918
2919
2920 Sru2:
2921         txa
2922         bne 1f
2923         jmp Pop         ! zero shift, return input
2924     1:  tay
2925         jsr Pop         ! get integer
2926         stx Ytmp        ! save lowbyte
2927         jmp 2f          ! shift unsigned
2928 Sri2:
2929         txa
2930         bne 1f
2931         jmp Pop         ! zero shift, return input
2932     1:  tay
2933         jsr Pop         ! get integer
2934         stx Ytmp        ! save lowbyte
2935         tax
2936         bmi 1f          ! negative signextended shift
2937     2:  lsr a
2938         ror Ytmp        ! shift not signextended
2939         dey
2940         bne 2b
2941         ldx Ytmp        ! get lowbyte
2942         rts
2943     1:  sec             ! shift signextended
2944         ror a
2945         ror Ytmp
2946         dey
2947         bne 1b
2948         ldx Ytmp        ! get lowbyte
2949         rts
2950
2951
2952 dsri4.s\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\95\ 2.define Sri4, Sru4
2953 .sect .text
2954 .sect .rom
2955 .sect .data
2956 .sect .bss
2957 .sect .text
2958
2959 ! The subroutine Sri4 shifts a signed fourbyte integer to the
2960 ! right n times
2961 ! N is in register X.
2962 ! The subroutine Sru4 shifts an unsigned fourbyte integer to the
2963 ! right n times.
2964
2965 Sru4:
2966         txa
2967         tay
2968         bne 1f
2969         rts
2970     1:  jsr Pop
2971         stx ARTH
2972         sta ARTH+1
2973         jsr Pop
2974         stx ARTH+2
2975         jmp 2f
2976 Sri4:
2977         txa
2978         tay
2979         bne 1f
2980         rts
2981     1:  jsr Pop
2982         stx ARTH
2983         sta ARTH+1
2984         jsr Pop
2985         stx ARTH+2
2986         tax
2987         bmi 1f
2988     2:  lsr a
2989         ror ARTH+2
2990         ror ARTH+1
2991         ror ARTH
2992         dey
2993         bne 2b
2994         beq 4f
2995     1:  sec
2996         ror a
2997         ror ARTH+2
2998         ror ARTH+1
2999         ror ARTH
3000     3:  dey
3001         bne 1b
3002     4:  ldx ARTH+2
3003         jsr Push
3004         lda ARTH+1
3005         ldx ARTH
3006         jmp Push
3007
3008
3009 2teq.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0O\ 1.define Teq
3010 .sect .text
3011 .sect .rom
3012 .sect .data
3013 .sect .bss
3014 .sect .text
3015
3016 ! This subroutine test if the value in registerpair AX is zero
3017 ! or nonzero.
3018 ! The returned value, a 1 or a 0, is in AX.
3019
3020
3021 Teq:
3022         tay
3023         beq 1f          ! A is zero
3024     2:  lda #0          ! AX is zero
3025         tax
3026         rts
3027     1:  txa
3028         bne 2b          ! X is zero
3029         lda #0          ! AX is nonzero
3030         ldx #1
3031         rts
3032
3033
3034
3035 tge.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0$\ 1.define Tge
3036 .sect .text
3037 .sect .rom
3038 .sect .data
3039 .sect .bss
3040 .sect .text
3041
3042 ! This subroutine test if the value in registerpair AX is
3043 ! greater than or equal to zero.
3044 ! The result is returned in AX.
3045
3046
3047 Tge:
3048         tay
3049         bpl 1f          ! A >= 0
3050         lda #0          ! AX < 0
3051         tax
3052         rts
3053     1:  lda #0          ! AX >= 0
3054         ldx #1
3055         rts
3056
3057
3058 tgt.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0a\ 1.define Tgt
3059 .sect .text
3060 .sect .rom
3061 .sect .data
3062 .sect .bss
3063 .sect .text
3064
3065 ! This subroutine tests if the value in registerpair AX is
3066 ! greater than zero.
3067 ! The value returned is in AX.
3068
3069 Tgt:
3070         tay
3071         bpl 1f          ! A >= 0
3072     3:  lda #0          ! AX <= 0
3073         tax
3074         rts
3075     1:  beq 1f          ! A = 0
3076     2:  lda #0          ! AX > 0
3077         ldx #1
3078         rts
3079     1:  txa
3080         bne 2b          ! X > 0
3081         beq 3b          ! X = 0
3082
3083
3084 2tle.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0k\ 1.define Tle
3085 .sect .text
3086 .sect .rom
3087 .sect .data
3088 .sect .bss
3089 .sect .text
3090
3091 ! This subroutine tests if the value in registerpair AX is
3092 ! less than or equal to zero.
3093 ! The value returned is in AX.
3094
3095
3096 Tle:
3097         tay
3098         bpl 1f          ! A >= 0
3099     3:  lda #0          ! AX <= 0
3100         ldx #1
3101         rts
3102     1:  beq 1f          ! A = 0
3103     2:  lda #0          ! AX > 0
3104         tax
3105         rts
3106     1:  txa
3107         bne 2b          ! X > 0
3108         beq 3b          ! x = 0
3109
3110
3111 ttlt.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\15\ 1.define Tlt
3112 .sect .text
3113 .sect .rom
3114 .sect .data
3115 .sect .bss
3116 .sect .text
3117
3118 ! This subroutine tests if the value in registerpair AX is
3119 ! less than zero.
3120 ! The value returned is in AX.
3121
3122
3123 Tlt:
3124         tay
3125         bpl 1f          ! A >= 0
3126         lda #0          ! AX < 0
3127         ldx #1
3128         rts
3129     1:  lda #0          ! AX >= 0
3130         tax
3131         rts
3132
3133
3134  tne.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\04\ 1.define Tne
3135 .sect .text
3136 .sect .rom
3137 .sect .data
3138 .sect .bss
3139 .sect .text
3140
3141 ! This subroutine tests if the value in registerpair AX is
3142 ! not equal to zero.
3143 ! The value returned is in AX.
3144
3145
3146 Tne:
3147         tay
3148         beq 1f          ! A = 0
3149     2:  lda #0          ! AX <> 0
3150         ldx #1
3151         rts
3152     1:  txa
3153         bne 2b          ! X <> 0
3154         lda #0          ! AX = 0
3155         tax
3156         rts
3157
3158
3159 xor.s\0\0\0s\0s\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 2.define Xor
3160 .sect .text
3161 .sect .rom
3162 .sect .data
3163 .sect .bss
3164 .sect .text
3165
3166 ! This subroutine performs the exclusive or on two groups of bytes.
3167 ! The groups consists of atmost 254 bytes.
3168 ! The result is on top of the stack.
3169
3170
3171 Xor:
3172         lda SP+1
3173         sta ADDR+1      ! address of first group (lowbyte)
3174         lda SP+2
3175         sta ADDR        ! address of first group (highbyte)
3176         clc
3177         tya
3178         adc SP+2
3179         sta SP+2        ! new stackpointer (lowbyte)
3180         sta ADDR+2      ! address of second group (lowbyte)
3181         lda #0
3182         adc SP+1
3183         sta SP+1        ! new stackpointer (highbyte)
3184         sta ADDR+3      ! address of second group (highbyte)
3185     1:  dey
3186         lda (ADDR),y    ! get byte first group
3187         eor (ADDR+2),y  ! exclusive or with byte second group
3188         sta (ADDR+2),y  ! restore result
3189         tya
3190         bne 1b
3191         rts
3192
3193