mach/m68k2/libem/libem_s.a

   1 e�ara.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0z\ 4.define .sar
   2 .define .lar
   3 .define .aar
   4 .sect .text
   5 .sect .rom
   6 .sect .data
   7 .sect .bss
   8
   9         !register usage:
  10         ! a0 : descriptor address
  11         ! d0 : index
  12         ! a1 : base address
  13         .sect .text
  14 .aar:
  15         move.l  (sp)+,d2        ! return address
  16         move.l  (sp)+,a0
  17         move.w  (sp)+,d0
  18         move.l  (sp)+,a1
  19         sub     (a0),d0         ! index - lower bound : relative index
  20         !chk    2(a0),d0
  21         !blt    9f
  22         !cmp    2(a0),d0
  23         !bgt    9f
  24         mulu    4(a0),d0        ! total # bytes
  25         add     d0,a1           ! address of element
  26         move.l  a1,-(sp)
  27         move.l  d2,-(sp)
  28         rts
  29
  30
  31 .lar:
  32         move.l  (sp)+,d2        ! return address
  33         move.l  (sp)+,a0
  34         move.w  (sp)+,d0
  35         move.l  (sp)+,a1
  36         sub     (a0),d0
  37         !chk    2(a0),d0
  38         !blt    9f
  39         !cmp    2(a0),d0
  40         !bgt    9f
  41         move    4(a0),d1
  42         mulu    d1,d0
  43         add     d0,a1
  44         add     d1,a1
  45         asr     #1,d1
  46         bne     3f
  47         clr     d1
  48         move.b  -(a1),d1
  49         move    d1,-(sp)
  50         bra     4f
  51 3:
  52         move    -(a1),-(sp)
  53         sub     #1,d1
  54         bgt     3b
  55 4:
  56         move.l  d2,-(sp)
  57         rts
  58
  59
  60 !9:
  61         !move.w #EARRAY,-(sp)
  62         !jmp    .fat
  63 .sar:
  64         move.l  (sp)+,d2
  65         move.l  (sp)+,a0
  66         move.w  (sp)+,d0
  67         move.l  (sp)+,a1
  68         sub     (a0),d0
  69         !chk    2(a0),d0
  70         !blt    9b
  71         !cmp    2(a0),d0
  72         !bgt    9b
  73         move    4(a0),d1
  74         mulu    d1,d0
  75         add     d0,a1
  76         asr     #1,d1
  77         bne     3f
  78         move    (sp)+,d1
  79         move.b  d1,(a1)
  80         bra     4f
  81 3:
  82         move    (sp)+,(a1)+
  83         sub     #1,d1
  84         bgt     3b
  85 4:
  86         move.l  d2,-(sp)
  87         rts
  88 cii.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0N\ 1.define       .cii
  89 .sect .text
  90 .sect .rom
  91 .sect .data
  92 .sect .bss
  93
  94         .sect .text
  95 .cii:
  96         move.l  (sp)+,a0        ! return address
  97         move    (sp)+,d0        ! destination size
  98         sub     (sp)+,d0        ! destination - source size
  99         bgt     1f
 100         sub     d0,sp           ! pop extra bytes
 101         bra     3f
 102 1:
 103         move    (sp),d1
 104         ext.l   d1
 105         swap    d1
 106         asr     #1,d0
 107 2:
 108         move.w  d1,-(sp)
 109         sub     #1,d0
 110         bgt     2b
 111 3:
 112         jmp     (a0)
 113 cmi.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define       .cmi, .cmi_
 114 .sect .text
 115 .sect .rom
 116 .sect .data
 117 .sect .bss
 118
 119         ! NUM == 4
 120         ! result in d1
 121         .sect .text
 122 .cmi:
 123 .cmi_:
 124         move.l  (sp)+,a0
 125         move.l  #1,d1
 126         move.l  (sp)+,d0
 127         cmp.l   (sp)+,d0
 128         bne     1f
 129         clr     d1
 130         1:
 131         ble     2f
 132         neg     d1
 133         2:
 134         jmp     (a0)
 135 1cmp.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define      .cmp
 136 .sect .text
 137 .sect .rom
 138 .sect .data
 139 .sect .bss
 140
 141         .sect .text
 142 .cmp:
 143         move.l  (sp)+,a0        ! return address
 144         move.l  #1,d1
 145         move.l  (sp)+,d0
 146         cmp.l   (sp)+,d0
 147         bne     1f
 148         clr     d1
 149         1:
 150         bcs     2f
 151         neg     d1
 152         2:
 153         jmp     (a0)
 154 cmu.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\9f\ 1.define .cmu
 155 .sect .text
 156 .sect .rom
 157 .sect .data
 158 .sect .bss
 159
 160         ! d0 : # bytes of 1 block
 161         .sect .text
 162 .cmu:
 163         move.l  (sp)+,d2        ! reta
 164         move.l  sp,a0           ! top block
 165         move.l  sp,a1
 166         move.l  d2,-(sp)
 167         add     d0,a1           ! lower block
 168         move    d0,d2
 169         asr     #1,d0
 170         move.l  #1,d1           ! greater
 171 1:
 172         cmp     (a0)+,(a1)+
 173         bne     2f
 174         sub     #1,d0
 175         bgt     1b
 176         clr     d1              ! equal
 177 2:
 178         bcc     3f
 179         neg     d1              ! less
 180 3:
 181         move.l  (sp)+,a0
 182         asl     #1,d2
 183         add     d2,sp           ! new sp
 184         jmp     (a0)
 185 !csa.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .csa2
 186 .sect .text
 187 .sect .rom
 188 .sect .data
 189 .sect .bss
 190
 191         .sect .text
 192 .csa2:
 193         move.l  (a0)+,a1        ! default address
 194         sub     (a0)+,d0        ! index - lower bound
 195         blt     1f
 196         cmp     (a0)+,d0        ! rel. index <-> upper - lower bound
 197         bgt     1f
 198         asl     #2,d0
 199         add     d0,a0
 200         move.l  (a0),d1         ! test jump address
 201         move.l  d1,d0
 202         beq     1f
 203         move.l  d1,a1
 204         bra     3f
 205 1:
 206         move.l  a1,d0           ! test default jump address
 207         beq     2f
 208 3:
 209         jmp     (a1)
 210 2:
 211         move.w  #ECASE,-(sp)
 212         jmp     .fat
 213 scsa4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .csa4
 214 .sect .text
 215 .sect .rom
 216 .sect .data
 217 .sect .bss
 218
 219         .sect .text
 220 .csa4:
 221         move.l  (a0)+,a1        ! default address
 222         sub.l   (a0)+,d0        ! index - lower bound
 223         blt     1f
 224         cmp.l   (a0)+,d0        ! rel. index <-> upper - lower bound
 225         bgt     1f
 226         asl.l   #2,d0
 227         add.l   d0,a0
 228         move.l  (a0),d1         ! test jump address
 229         move.l  d1,d0
 230         beq     1f
 231         move.l  d1,a1
 232         bra     3f
 233 1:
 234         move.l  a1,d0           ! test default jump address
 235         beq     2f
 236 3:
 237         jmp     (a1)
 238 2:
 239         move.w  #ECASE,-(sp)
 240         jmp     .fat
 241 mcsb.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0p\ 1.define .csb2
 242 .sect .text
 243 .sect .rom
 244 .sect .data
 245 .sect .bss
 246
 247         .sect .text
 248 .csb2:
 249         move.l  (a0)+,a1        ! default jump address
 250         move.w  (a0)+,d1        ! # entries
 251         beq     2f
 252 1:
 253         cmp     (a0)+,d0
 254         beq     3f
 255         tst.l   (a0)+           ! skip jump address
 256         sub     #1,d1
 257         bgt     1b
 258 2:
 259         move.l  a1,d1           ! default jump address
 260         bne     4f
 261         move.w  #ECASE,-(sp)
 262         jmp     .fat
 263 3:
 264         move.l  (a0)+,a1        ! get jump address
 265 4:
 266         jmp     (a1)
 267 csb4.s\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0t\ 1.define .csb4
 268 .sect .text
 269 .sect .rom
 270 .sect .data
 271 .sect .bss
 272
 273         .sect .text
 274 .csb4:
 275         move.l  (a0)+,a1        ! default jump address
 276         move.l  (a0)+,d1        ! # entries
 277         beq     2f
 278 1:
 279         cmp.l   (a0)+,d0
 280         beq     3f
 281         tst.l   (a0)+           ! skip jump address
 282         sub.l   #1,d1
 283         bgt     1b
 284 2:
 285         move.l  a1,d1           ! default jump address
 286         bne     4f
 287         move.w  #ECASE,-(sp)
 288         jmp     .fat
 289 3:
 290         move.l  (a0)+,a1        ! get jump address
 291 4:
 292         jmp     (a1)
 293 cuu.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\1d\ 1.define       .ciu
 294 .define .cui
 295 .define .cuu
 296 .sect .text
 297 .sect .rom
 298 .sect .data
 299 .sect .bss
 300
 301         .sect .text
 302 .ciu:
 303 .cui:
 304 .cuu:
 305         move.l  (sp)+,a0        ! return address
 306         move    (sp)+,d0        ! destination size
 307         sub     (sp)+,d0
 308         bgt     1f
 309         sub     d0,sp
 310         jmp     (a0)
 311 1:
 312         asr     #1,d0
 313 2:
 314         clr     -(sp)
 315         sub     #1,d0
 316         bgt     2b
 317         jmp     (a0)
 318         exg.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0X\ 1.define .exg
 319 .sect .text
 320 .sect .rom
 321 .sect .data
 322 .sect .bss
 323
 324         ! d0 : exchange size in bytes
 325         .sect .text
 326 .exg:
 327         move.l  (sp)+,d2        ! return address
 328         move.l  sp,a1
 329         sub.w   d0,sp
 330         move.l  sp,a0
 331         move.w  d0,d1
 332 1:
 333         move.w  (a1)+,(a0)+
 334         sub     #1,d0
 335         bgt     1b
 336         move.l  sp,a1
 337         asr     #1,d1
 338 1:
 339         move.w  (a1)+,(a0)+
 340         sub     #1,d1
 341         bgt     1b
 342         move.l  a1,sp
 343         move.l  d2,-(sp)
 344         rts
 345 inn.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\89\ 1.define .inn
 346 .sect .text
 347 .sect .rom
 348 .sect .data
 349 .sect .bss
 350
 351 ! d0 : set size in bytes
 352 ! d1 : bitnumber
 353
 354         .sect .text
 355 .inn:
 356         move.l  (sp)+,d2        ! return address
 357         move.w  (sp)+,d1
 358         move.l  sp,a1
 359         add     d0,a1
 360         move.l  sp,a0
 361         move.l  d2,-(sp)
 362         move    d1,d2
 363         asr     #3,d2
 364         bchg    #0,d2
 365         cmp     d0,d2
 366         bcc     1f
 367         add     d2,a0
 368         btst    d1,(a0)
 369         beq     1f
 370         move.l  #1,d0
 371         bra     2f
 372 1:
 373         clr     d0
 374 2:
 375         move.l  (sp)+,a0
 376         move.l  a1,sp
 377         jmp     (a0)
 378 alos.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .los
 379 .define .los4
 380 .sect .text
 381 .sect .rom
 382 .sect .data
 383 .sect .bss
 384
 385         ! d0 : # bytes
 386         ! a0 : source address
 387         .sect .text
 388 .los:
 389         move.l  (sp)+,a1
 390         move.w  (sp)+,d0
 391         ext.l   d0
 392 9:
 393         move.l  (sp)+,a0
 394         cmp     #1,d0
 395         bne     1f
 396         clr     d0
 397         move.b  (a0),d0
 398         move.w  d0,-(sp)
 399         bra     3f
 400 1:
 401         add.l   d0,a0
 402         asr.l   #1,d0
 403 2:
 404         move    -(a0),-(sp)
 405         sub.l   #1,d0
 406         bgt     2b
 407 3:
 408         jmp     (a1)
 409
 410         ! d0 : # bytes
 411         ! a0 : source address
 412         .sect .text
 413 .los4:
 414         move.l  (sp)+,a1
 415         move.l  (sp)+,d0
 416         bra 9b
 417 .align 2
 418 lrck.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define .rck
 419 .sect .text
 420 .sect .rom
 421 .sect .data
 422 .sect .bss
 423
 424         .sect .text
 425 .rck:
 426         move.l  (sp)+,a1
 427         move.l  (sp)+,a0        ! descriptor address
 428         move.w  (sp),d0
 429         cmp     (a0),d0
 430         blt     1f
 431         cmp     2(a0),d0
 432         ble     2f
 433 1:
 434         move.w  #ERANGE,-(sp)
 435         jsr     .trp
 436 2:
 437         jmp     (a1)
 438 oret.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\1d\ 1.define .ret
 439 .sect .text
 440 .sect .rom
 441 .sect .data
 442 .sect .bss
 443
 444         .sect .text
 445 .ret:
 446         beq 3f
 447         cmp #2,d0
 448         bne 1f
 449         move (sp)+,d0
 450         bra 3f
 451 1:
 452         cmp #4,d0
 453         bne 2f
 454         move.l (sp)+,d0
 455         bra 3f
 456 2:
 457         cmp #8,d0
 458         bne 4f
 459         move.l (sp)+,d0
 460         move.l (sp)+,d1
 461 3:
 462         unlk a6
 463         rts
 464 4:
 465         move.w  #EILLINS,-(sp)
 466         jmp     .fat
 467 lset.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0}\ 1.define .set
 468 .sect .text
 469 .sect .rom
 470 .sect .data
 471 .sect .bss
 472
 473         ! d0 : setsize in bytes
 474         ! d1 : bitnumber
 475         .sect .text
 476 .set:
 477         move.l  (sp)+,a0
 478         move.w  (sp)+,d1
 479         move.w  d0,d2
 480         asr     #1,d2
 481 1:
 482         clr     -(sp)
 483         sub     #1,d2
 484         bgt     1b
 485         move.l  sp,a1           ! set base
 486         move.w  d1,d2
 487         asr     #3,d2
 488         bchg    #0,d2
 489         cmp     d0,d2
 490         bcs     1f
 491         move.w  #ESET,-(sp)
 492         move.l  a0,-(sp)
 493         jmp     .trp
 494 1:
 495         add     d2,a1
 496         bset    d1,(a1)
 497         jmp     (a0)
 498 dsts.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\81\ 1.define .sts
 499 .define .sts4
 500 .sect .text
 501 .sect .rom
 502 .sect .data
 503 .sect .bss
 504
 505         ! d0 : # bytes
 506         ! a0 : destination address
 507         .sect .text
 508 .sts:
 509         move.l  (sp)+,a1
 510         move.w  (sp)+,d0
 511         ext.l   d0
 512 9:
 513         move.l  (sp)+,a0
 514         cmp.l   #1,d0
 515         bne     1f
 516         move.w  (sp)+,d0
 517         move.b  d0,(a0)
 518         bra     3f
 519 1:
 520         asr.l   #1,d0
 521 2:
 522         move.w  (sp)+,(a0)+
 523         sub.l   #1,d0
 524         bgt     2b
 525 3:
 526         jmp     (a1)
 527 .sts4:
 528         move.l  (sp)+,a1
 529         move.l  (sp)+,d0
 530         bra     9b
 531 snop.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define .nop
 532 .sect .text
 533 .sect .rom
 534 .sect .data
 535 .sect .bss
 536
 537         .sect .text
 538 .nop:
 539         move.w  hol0,-(sp)
 540         pea     fmt
 541         jsr     .diagnos
 542         add     #6,sp
 543         rts
 544
 545         .sect .data
 546 fmt:    .asciz "test %d\n"
 547 .align 2
 548 mon.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define .mon
 549 .sect .text
 550 .sect .rom
 551 .sect .data
 552 .sect .bss
 553         .sect .text
 554 .mon:
 555         move.l  (sp)+,a0
 556         pea     fmt
 557         jsr     .diagnos
 558         add     #6,sp
 559         jmp     EXIT
 560
 561         .sect .data
 562 fmt:    .asciz "system call %d not implemented\n"
 563 .align 2
 564 1dvi.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\8d\v.define .dvi
 565 .sect .text
 566 .sect .rom
 567 .sect .data
 568 .sect .bss
 569
 570  ! signed long divide
 571  !-----------------------------------------------------------------------------
 572  ! rewritten by Kai-Uwe Bloem (i5110401@dbstu1.bitnet) for speed.
 573  !   #1  01/12/90  initial revision. Minor reduce of shift operations.
 574  !   #2  03/07/90  use 68000 divu instruction whereever possible. This change
 575  !                 makes #1 superflous. (derived from my GNU division routine)
 576  !-----------------------------------------------------------------------------
 577  ! Some common cases can be handled in a special, much faster way :
 578  !      1) divisor = 0
 579  !          => cause trap, then return to user. Result is undefined
 580  !      2) dividend < divisor
 581  !          => quotient = 0, remainder = dividend
 582  !      3) divisor < 0x10000 ( i.e. divisor is only 16 bits wide )
 583  !          => quotient and remainder can be calculated quite fast by repeated
 584  !             application of 68000 divu operations (ca. 400 cycles)
 585  !      4) otherwise (due to #2, #3 dividend, divisor both wider then 16 bits)
 586  !          => do slow division by shift and subtract
 587  !-----------------------------------------------------------------------------
 588
 589
 590  ! register usage:
 591  !       : d0 divisor
 592  !         d1 dividend
 593  ! exit  : d1 quotient
 594  !         d2 remainder
 595
 596         .sect .text
 597 .dvi:
 598         move.l  (sp)+,a1        ! return address
 599         move.l  (sp)+,d0        ! divisor
 600         move.l  (sp)+,d2        ! dividend
 601         move.l  d3,a0           ! save d3
 602         move.l  d4,-(sp)        ! save result sign register
 603         clr.l   d4
 604         tst.l   d2
 605         bpl     0f              ! dividend is negative ?
 606         neg.l   d2              ! yes - negate
 607         not.l   d4              ! and note negation in d4
 608 0:
 609         tst.l   d0
 610         bpl     0f              ! divisor is negative ?
 611         neg.l   d0              ! yes - negate
 612         not.w   d4              ! note negation
 613 0:
 614         clr.l   d1              ! prepare quotient
 615 ! === case 1: divisor = 0
 616         tst.l   d0              ! divisor = 0 ?
 617         beq     9f              ! yes - divide by zero trap
 618 ! === case 2: dividend < divisor
 619         cmp.l   d0,d2           ! dividend < divisor ?
 620         bcs     8f              ! yes - division already finished
 621 ! === case 3: divisor <= 0x0ffff
 622         cmp.l   #0x0ffff,d0     ! is divisor only 16 bits wide ?
 623         bhi     2f
 624         move.w  d2,d3           ! save dividend.l
 625         clr.w   d2              ! prepare dividend.h for divu operation
 626         swap    d2
 627         beq     0f              ! dividend.h is all zero, no divu necessary
 628         divu    d0,d2
 629 0:      move.w  d2,d1           ! save quotient.h
 630         swap    d1
 631         move.w  d3,d2           ! divide dividend.l
 632         divu    d0,d2           ! (d2.h = remainder of prev divu)
 633         move.w  d2,d1           ! save qoutient.l
 634         clr.w   d2              ! get remainder
 635         swap    d2
 636         bra     8f
 637 ! === case 4: divisor and dividend both > 0x0ffff
 638 2:
 639         move    #32-1,d3        ! loop count
 640 4:
 641         lsl.l   #1,d2           ! shift dividend ...
 642         roxl.l  #1,d1           !  ... into d1
 643         cmp.l   d0,d1           ! compare with divisor
 644         bcs     5f
 645         sub.l   d0,d1           ! bigger, subtract divisor
 646         add     #1,d2           ! note subtraction in result
 647 5:
 648         dbra    d3,4b
 649         exg     d1,d2           ! get results in the correct registers
 650 8:
 651         tst.w   d4              ! quotient < 0 ?
 652         bpl     0f
 653         neg.l   d1              ! yes - negate
 654 0:      tst.l   d4              ! remainder < 0 ?
 655         bpl     0f
 656         neg.l   d2
 657 0:      move.l  (sp)+,d4        ! restore d4
 658         move.l  a0,d3           ! restore d3
 659         jmp     (a1)
 660
 661 EIDIVZ  = 6
 662 9:      move.w  #EIDIVZ,-(sp)
 663         jsr     .trp
 664 \0dvu.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�      .define .dvu
 665 .sect .text
 666 .sect .rom
 667 .sect .data
 668 .sect .bss
 669
 670  ! unsigned long divide
 671  !-----------------------------------------------------------------------------
 672  ! rewritten by Kai-Uwe Bloem (i5110401@dbstu1.bitnet) for speed.
 673  !   #1  01/12/90  initial revision. Minor reduce of shift operations.
 674  !   #2  03/07/90  use 68000 divu instruction whereever possible. This change
 675  !                 makes #1 superflous. (derived from my GNU division routine)
 676  !-----------------------------------------------------------------------------
 677  ! Some common cases can be handled in a special, much faster way :
 678  !      1) divisor = 0
 679  !          => cause trap, then return to user. Result is undefined
 680  !      2) dividend < divisor
 681  !          => quotient = 0, remainder = dividend
 682  !      3) divisor < 0x10000 ( i.e. divisor is only 16 bits wide )
 683  !          => quotient and remainder can be calculated quite fast by repeated
 684  !             application of 68000 divu operations (ca. 400 cycles)
 685  !      4) otherwise (due to #2, #3 dividend, divisor both wider then 16 bits)
 686  !          => do slow division by shift and subtract
 687  !-----------------------------------------------------------------------------
 688
 689
 690  ! register usage:
 691  !       : d0 divisor
 692  !         d1 dividend
 693  ! exit  : d1 quotient
 694  !         d2 remainder
 695
 696         .sect .text
 697 .dvu:
 698         move.l  d3,a0           ! save d3
 699         move.l  (sp)+,a1        ! return address
 700         move.l  (sp)+,d0        ! divisor
 701         move.l  (sp)+,d2        ! dividend
 702         clr.l   d1              ! prepare quotient
 703 ! === case 1: divisor = 0
 704         tst.l   d0              ! divisor = 0 ?
 705         beq     9f              ! yes - divide by zero trap
 706 ! === case 2: dividend < divisor
 707         cmp.l   d0,d2           ! dividend < divisor ?
 708         bcs     8f              ! yes - division already finished
 709 ! === case 3: divisor <= 0x0ffff
 710         cmp.l   #0x0ffff,d0     ! is divisor only 16 bits wide ?
 711         bhi     2f
 712         move.w  d2,d3           ! save dividend.l
 713         clr.w   d2              ! prepare dividend.h for divu operation
 714         swap    d2
 715         beq     0f              ! dividend.h is all zero, no divu necessary
 716         divu    d0,d2
 717 0:      move.w  d2,d1           ! save quotient.h
 718         swap    d1
 719         move.w  d3,d2           ! divide dividend.l
 720         divu    d0,d2           ! (d2.h = remainder of prev divu)
 721         move.w  d2,d1           ! save qoutient.l
 722         clr.w   d2              ! get remainder
 723         swap    d2
 724         bra     8f
 725 ! === case 4: divisor and dividend both > 0x0ffff
 726 2:
 727         move    #32-1,d3        ! loop count
 728 4:
 729         lsl.l   #1,d2           ! shift dividend ...
 730         roxl.l  #1,d1           !  ... into d1
 731         cmp.l   d0,d1           ! compare with divisor
 732         bcs     5f
 733         sub.l   d0,d1           ! bigger, subtract divisor
 734         add     #1,d2           ! note subtraction in result
 735 5:
 736         dbra    d3,4b
 737         exg     d1,d2           ! get results in the correct registers
 738 8:
 739         move.l  a0,d3           ! restore d3
 740         jmp     (a1)
 741
 742 EIDIVZ  = 6
 743 9:      move.w  #EIDIVZ,-(sp)
 744         jsr     .trp
 745 mli.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0R       .define .mli
 746 .sect .text
 747 .sect .rom
 748 .sect .data
 749 .sect .bss
 750
 751  ! signed long mulitply
 752  !-----------------------------------------------------------------------------
 753  ! rewritten by Kai-Uwe Bloem (i5110401@dbstu1.bitnet) for speed.
 754  !   #1  01/12/90  initial revision
 755  !-----------------------------------------------------------------------------
 756  !   3 cases worth to recognize :
 757  !      1) both the upper word of u and v are zero
 758  !          => 1 mult : Low*Low
 759  !      2) only one of the upper words is zero
 760  !          => 2 mult : Low*HighLow
 761  !      3) both upper words are not zero
 762  !          => 4 mult : HighLow*HighLow
 763  !   there are other cases (e.g. lower word is zero but high word is not, or
 764  !   one operand is all zero). However, this seems not to be very common, so
 765  !   they are ignored for the price of superfluous multiplications in these
 766  !   cases.
 767  !-----------------------------------------------------------------------------
 768
 769  ! entry : d0 multiplicand
 770  !         d1 multiplier
 771  ! exit  : d0 high order result
 772  !         d1 low order result
 773  !         d2,a0,a1 : destroyed
 774
 775         .sect .text
 776 .mli:
 777         move.l  (sp)+,a1        ! return address
 778         move.l  d3,a0           ! save register
 779         movem.w (sp)+,d0-d3     ! get v and u
 780         move.w  d5,-(sp)        ! save sign register
 781         move.w  d2,d5
 782         bge     0f              ! negate u if neccessary
 783         neg.w   d1
 784         negx.w  d0
 785 0:      tst.w   d0
 786         bge     0f              ! negate v if neccessary
 787         eor.w   d0,d5
 788         neg.w   d1
 789         negx.w  d0
 790 0:      bne     1f              ! case 2) or 3)
 791         tst.w   d2
 792         bne     2f              ! case 2)
 793 ! === case 1: _l x _l ===
 794         mulu    d3,d1           ! r.l = u.l x v.l
 795 9:                              ! (r.h is already zero)
 796         tst.w   d5              ! negate result if neccessary
 797         bpl     0f
 798         neg.l   d1
 799         negx.l  d0
 800 0:      move.w  (sp)+,d5        ! return
 801         move.l  a0,d3
 802         jmp     (a1)
 803 ! === possibly case 2) or case 3) ===
 804 1:
 805         tst.w   d2
 806         bne     3f              ! case 3)
 807 ! === case 2: _l x hl ===
 808         exg     d0,d2           ! exchange u and v
 809         exg     d1,d3           ! (minimizes number of distinct cases)
 810 2:
 811         mulu    d1,d2           ! a = v.l x u.h
 812         mulu    d3,d1           ! r.l = v.l x u.l
 813         swap    d2              ! a = a << 16
 814         clr.l   d3
 815         move.w  d2,d3
 816         clr.w   d2
 817         add.l   d2,d1           ! r += a
 818         addx.l  d3,d0
 819         bra     9b
 820 ! === case 3: hl x hl ===
 821 3:
 822         move.l  d4,-(sp)        ! need more registers
 823         move.w  d2,d4
 824         mulu    d1,d4           ! a = v.l x u.h
 825         mulu    d3,d1           ! r.l = u.l x v.l
 826         mulu    d0,d3           ! b = v.h x u.l
 827         mulu    d2,d0           ! r.h = u.h x v.h
 828         swap    d1              ! (just for simplicity)
 829         add.w   d4,d1           ! r += a << 16
 830         clr.w   d4
 831         swap    d4
 832         addx.l  d4,d0
 833         add.w   d3,d1           ! r += b << 16
 834         clr.w   d3
 835         swap    d3
 836         addx.l  d3,d0
 837         swap    d1
 838         move.l  (sp)+,d4        ! return
 839         bra     9b
 840 mlu.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0n\b.define .mlu
 841 .sect .text
 842 .sect .rom
 843 .sect .data
 844 .sect .bss
 845
 846  ! unsigned long mulitply
 847  !-----------------------------------------------------------------------------
 848  ! rewritten by Kai-Uwe Bloem (i5110401@dbstu1.bitnet) for speed.
 849  !   #1  01/12/90  initial revision
 850  !-----------------------------------------------------------------------------
 851  !   3 cases worth to recognize :
 852  !      1) both the upper word of u and v are zero
 853  !          => 1 mult : Low*Low
 854  !      2) only one of the upper words is zero
 855  !          => 2 mult : Low*HighLow
 856  !      3) both upper words are not zero
 857  !          => 4 mult : HighLow*HighLow
 858  !   there are other cases (e.g. lower word is zero but high word is not, or
 859  !   one operand is all zero). However, this seems not to be very common, so
 860  !   they are ignored for the price of superfluous multiplications in these
 861  !   cases.
 862  !-----------------------------------------------------------------------------
 863
 864  ! entry : d0 multiplicand
 865  !         d1 multiplier
 866  ! exit  : d0 high order result
 867  !         d1 low order result
 868  !         d2,a0,a1 : destroyed
 869
 870         .sect .text
 871 .mlu:
 872         move.l  (sp)+,a1        ! return address
 873         move.l  d3,a0           ! save register
 874         movem.w (sp)+,d0-d3     ! get v and u
 875         tst.w   d0
 876         bne     1f              ! case 2) or 3)
 877         tst.w   d2
 878         bne     2f              ! case 2)
 879 ! === case 1: _l x _l ===
 880         mulu    d3,d1           ! r.l = u.l x v.l
 881         move.l  a0,d3           ! (r.h is already zero)
 882         jmp     (a1)            ! return
 883 ! === possibly case 2) or case 3) ===
 884 1:
 885         tst.w   d2
 886         bne     3f              ! case 3)
 887 ! === case 2: _l x hl ===
 888         exg     d0,d2           ! exchange u and v
 889         exg     d1,d3           ! (minimizes number of distinct cases)
 890 2:
 891         mulu    d1,d2           ! a = v.l x u.h
 892         mulu    d3,d1           ! r.l = v.l x u.l
 893         swap    d2              ! a = a << 16
 894         clr.l   d3
 895         move.w  d2,d3
 896         clr.w   d2
 897         add.l   d2,d1           ! r += a
 898         addx.l  d3,d0
 899         move.l  a0,d3           ! return
 900         jmp     (a1)
 901 ! === case 3: hl x hl ===
 902 3:
 903         move.l  d4,-(sp)        ! need more registers
 904         move.w  d2,d4
 905         mulu    d1,d4           ! a = v.l x u.h
 906         mulu    d3,d1           ! r.l = u.l x v.l
 907         mulu    d0,d3           ! b = v.h x u.l
 908         mulu    d2,d0           ! r.h = u.h x v.h
 909         swap    d1              ! (just for simplicity)
 910         add.w   d4,d1           ! r += a << 16
 911         clr.w   d4
 912         swap    d4
 913         addx.l  d4,d0
 914         add.w   d3,d1           ! r += b << 16
 915         clr.w   d3
 916         swap    d3
 917         addx.l  d3,d0
 918         swap    d1
 919         move.l  (sp)+,d4        ! return
 920         move.l  a0,d3
 921         jmp     (a1)
 922 shp.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0x\ 1.define       .strhp
 923 .sect .text
 924 .sect .rom
 925 .sect .data
 926 .sect .bss
 927
 928         .sect .text
 929 .strhp:
 930         move.l  (sp)+,a0
 931         move.l  (sp)+,d0        ! heap pointer
 932         move.l  d0,.reghp
 933         cmp.l   .limhp,d0
 934         bmi     1f
 935         add.l   #0x400,d0
 936         and.l   #~0x3ff,d0
 937         move.l  a0,-(sp)
 938         move.l  d0,-(sp)
 939         move.l  d0,.limhp
 940         jsr     BRK
 941         tst.l   (sp)+
 942         move.l  (sp)+,a0
 943         tst.w   d0
 944         bne     2f
 945 1:
 946         jmp     (a0)
 947 2:
 948         move.w  #EHEAP,-(sp)
 949         jsr     .trp
 950         jmp     (a0)
 951 sig.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\0.define       .sig
 952 .sect .text
 953 .sect .rom
 954 .sect .data
 955 .sect .bss
 956
 957         .sect .text
 958 .sig:
 959         move.l  (sp)+,a0
 960         move.l  (sp)+,a1        ! trap pc
 961         move.l  .trppc,-(sp)
 962         move.l  a1,.trppc
 963         jmp     (a0)
 964 cms.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\09\ 1.define       .cms
 965 .sect .text
 966 .sect .rom
 967 .sect .data
 968 .sect .bss
 969
 970         ! d0 contains set size
 971
 972         .sect .text
 973 .cms:
 974         move.l  (sp)+,d2        ! return address
 975         move.l  sp,a0
 976         move.l  sp,a1
 977         add     d0,a1
 978         move.w  d0,d1
 979         asr     #1,d0
 980 1:
 981         cmp     (a0)+,(a1)+
 982         bne     2f
 983         sub     #1,d0
 984         bgt     1b
 985 2:
 986         asl     #1,d1
 987         add     d1,sp
 988         move.w  d0,-(sp)
 989         move.l  d2,-(sp)
 990         rts
 991 ngto.s\0\0\0\0\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 6.define .gto
 992 .sect .text
 993 .sect .rom
 994 .sect .data
 995 .sect .bss
 996 .extern .gto
 997
 998         .sect .text
 999 .gto:
1000         ! nonlocal goto
1001         ! the argument on the stack is a pointer to a GTO-descriptor containing:
1002         !  - the new local base
1003         !  - the new stackpointer
1004         !  - the new program counter
1005         !
1006         ! The main task of the GTO instruction is to restore the registers
1007         ! used for local variables. It uses a word stored in each stackframe,
1008         ! indicating how many data -and address registers the procedure of
1009         ! that stackframe has.
1010
1011         move.l  (sp)+,a0
1012         add.l   #8,a0           ! a0 now points to new local base entry
1013                                 ! of the descriptor
1014         cmp.l   (a0),a6         ! GTO within same procedure?
1015         beq     noregs
1016         move.l  d0,savd0        ! gto may not destroy the return area
1017         move.l  d1,savd1
1018 1:
1019         tst.l   (a6)
1020         beq     err
1021         unlk    a6
1022         move.w  (sp)+,d0        ! word indicating which regs. were saved
1023         jsr     restr
1024         cmp.l   (a0),a6
1025         bne     1b
1026         move.l  savd0,d0
1027         move.l  savd1,d1
1028 noregs:
1029         move.l  -4(a0),sp
1030         move.l  -8(a0),a0       ! new program counter
1031         jmp     (a0)
1032 err:
1033         move.w  #EBADGTO,-(sp)
1034         jmp     .fat
1035
1036 restr:
1037         ! restore the registers. Note that scratch register a0 may
1038         ! not be changed here. d0 contains (8*#addr.regs + #data regs.)
1039         ! note that registers are assigned in the order d7,d6 .. and
1040         ! a5,a4...
1041
1042         move.l  (sp)+,d2        ! return address; can't use a0 here
1043         move.w  d0,d1
1044         and.l   #7,d0           ! #data registers
1045         asl.l   #1,d0           ! * 2
1046         lea     etabd,a1
1047         sub.l   d0,a1
1048         jmp     (a1)
1049         move.l  (sp)+,d3
1050         move.l  (sp)+,d4
1051         move.l  (sp)+,d5
1052         move.l  (sp)+,d6
1053         move.l  (sp)+,d7
1054 etabd:
1055         and.l   #070,d1
1056         asr.l   #2,d1           ! # address registers
1057         lea     etaba,a1
1058         sub.l   d1,a1
1059         jmp     (a1)
1060         move.l  (sp)+,a2
1061         move.l  (sp)+,a3
1062         move.l  (sp)+,a4
1063         move.l  (sp)+,a5
1064 etaba:
1065         move.l  d2,a1
1066         jmp     (a1)            ! return
1067 .sect .data
1068 savd0:  .data4 0
1069 savd1:  .data4 0
1070 .sect .text
1071 fp68881.s\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\11.define .adf4, .adf8, .sbf4, .sbf8, .mlf4, .mlf8, .dvf4, .dvf8
1072 .define .ngf4, .ngf8, .fif4, .fif8, .fef4, .fef8
1073 .define .cif4, .cif8, .cuf4, .cuf8, .cfi, .cfu, .cff4, .cff8
1074 .define .cmf4, .cmf8
1075 .sect .text
1076 .sect .rom
1077 .sect .data
1078 .sect .bss
1079
1080 !       $Id: fp68881.s,v 1.3 1994/06/24 13:04:30 ceriel Exp $
1081
1082 !       Implement interface to floating point package for M68881
1083
1084         .sect .text
1085 .adf4:
1086         move.l  (sp)+,a0
1087         fmove.s (sp),fp0
1088         fadd.s  4(sp),fp0
1089         fmove.s fp0,4(sp)
1090         jmp     (a0)
1091
1092 .adf8:
1093         move.l  (sp)+,a0
1094         fmove.d (sp),fp0
1095         fadd.d  8(sp),fp0
1096         fmove.d fp0,8(sp)
1097         jmp     (a0)
1098
1099 .sbf4:
1100         move.l  (sp)+,a0
1101         fmove.s (sp),fp0
1102         fmove.s 4(sp),fp1
1103         fsub    fp0,fp1
1104         fmove.s fp1,4(sp)
1105         jmp     (a0)
1106
1107 .sbf8:
1108         move.l  (sp)+,a0
1109         fmove.d (sp),fp0
1110         fmove.d 8(sp),fp1
1111         fsub    fp0,fp1
1112         fmove.d fp1,8(sp)
1113         jmp     (a0)
1114
1115 .mlf4:
1116         move.l  (sp)+,a0
1117         fmove.s (sp),fp0
1118         fmul.s  4(sp),fp0
1119         fmove.s fp0,4(sp)
1120         jmp     (a0)
1121
1122 .mlf8:
1123         move.l  (sp)+,a0
1124         fmove.d (sp),fp0
1125         fmul.d  8(sp),fp0
1126         fmove.d fp0,8(sp)
1127         jmp     (a0)
1128
1129 .dvf4:
1130         move.l  (sp)+,a0
1131         fmove.s (sp),fp0
1132         fmove.s 4(sp),fp1
1133         fdiv    fp0,fp1
1134         fmove.s fp1,4(sp)
1135         jmp     (a0)
1136
1137 .dvf8:
1138         move.l  (sp)+,a0
1139         fmove.d (sp),fp0
1140         fmove.d 8(sp),fp1
1141         fdiv    fp0,fp1
1142         fmove.d fp1,8(sp)
1143         jmp     (a0)
1144
1145 .ngf4:
1146         fmove.s 4(sp),fp0
1147         fneg    fp0
1148         fmove.s fp0,4(sp)
1149         rts
1150
1151 .ngf8:
1152         fmove.d 4(sp),fp0
1153         fneg    fp0
1154         fmove.d fp0,4(sp)
1155         rts
1156
1157 .fif4:
1158         move.l  (sp)+,a0
1159         move.l  (sp),a1
1160         fmove.s 4(sp),fp0
1161         fmove.s 8(sp),fp1
1162         fmul    fp0,fp1
1163         fintrz  fp1,fp0
1164         fsub    fp0,fp1
1165         fmove.s fp1,4(a1)
1166         fmove.s fp0,(a1)
1167         jmp     (a0)
1168
1169 .fif8:
1170         move.l  (sp)+,a0
1171         move.l  (sp),a1
1172         fmove.d 4(sp),fp0
1173         fmove.d 12(sp),fp1
1174         fmul    fp0,fp1
1175         fintrz  fp1,fp0
1176         fsub    fp0,fp1
1177         fmove.d fp1,8(a1)
1178         fmove.d fp0,(a1)
1179         jmp     (a0)
1180
1181 .fef4:
1182         move.l  (sp)+,a0
1183         move.l  (sp),a1
1184         fmove.s 4(sp),fp0
1185         fgetexp fp0,fp1
1186         fmove.l fpsr,d0
1187         and.l   #0x2000,d0      ! set if Infinity
1188         beq     1f
1189         move.w  #129,(a1)
1190         fmove.s 4(sp),fp0
1191         fblt    2f
1192         move.l  #0x3f000000,2(a1)
1193         jmp     (a0)
1194 2:
1195         move.l  #0xbf000000,2(a1)
1196         jmp     (a0)
1197 1:
1198         fmove.l fp1,d0
1199         add.l   #1,d0
1200         fgetman fp0
1201         fbne    1f
1202         clr.l   d0
1203         bra     2f
1204 1:
1205         fmove.l #2,fp1
1206         fdiv    fp1,fp0
1207 2:
1208         fmove.s fp0,2(a1)
1209         move.w  d0,(a1)
1210         jmp     (a0)
1211
1212 .fef8:
1213         move.l  (sp)+,a0
1214         move.l  (sp),a1
1215         fmove.d 4(sp),fp0
1216         fgetexp fp0,fp1
1217         fmove.l fpsr,d0
1218         and.l   #0x2000,d0      ! set if Infinity
1219         beq     1f
1220         move.w  #1025,(a1)
1221         fmove.d 4(sp),fp0
1222         fblt    2f
1223         move.l  #0x3fe00000,2(a1)
1224         clr.l   6(a1)
1225         jmp     (a0)
1226 2:
1227         move.l  #0xbfe00000,2(a1)
1228         clr.l   6(a1)
1229         jmp     (a0)
1230 1:
1231         fmove.l fp1,d0
1232         add.l   #1,d0
1233         fgetman fp0
1234         fbne    1f
1235         clr.l   d0
1236         bra     2f
1237 1:
1238         fmove.l #2,fp1
1239         fdiv    fp1,fp0
1240 2:
1241         fmove.d fp0,2(a1)
1242         move.w  d0,(a1)
1243         jmp     (a0)
1244
1245 .cif4:
1246         move.l  (sp)+,a0
1247         cmp.w   #2,(sp)
1248         bne     1f
1249         fmove.w 2(sp),fp0
1250         fmove.s fp0,(sp)
1251         jmp     (a0)
1252 1:
1253         fmove.l 2(sp),fp0
1254         fmove.s fp0,2(sp)
1255         jmp     (a0)
1256
1257 .cif8:
1258         move.l  (sp)+,a0
1259         cmp.w   #2,(sp)
1260         bne     1f
1261         fmove.w 2(sp),fp0
1262         fmove.d fp0,(sp)
1263         jmp     (a0)
1264 1:
1265         fmove.l 2(sp),fp0
1266         fmove.d fp0,(sp)
1267         jmp     (a0)
1268
1269 .cuf4:
1270         move.l  (sp)+,a0
1271         cmp.w   #2,(sp)
1272         bne     2f
1273         fmove.w 2(sp),fp0
1274         tst.w   2(sp)
1275         bge     1f
1276         fadd.l  #65536,fp0
1277 1:
1278         fmove.s fp0,(sp)
1279         jmp     (a0)
1280 2:
1281         fmove.l 2(sp),fp0
1282         tst.l   2(sp)
1283         bge     1f
1284         fsub.l  #-2147483648,fp0
1285         fsub.l  #-2147483648,fp0
1286 1:
1287         fmove.s fp0,2(sp)
1288         jmp     (a0)
1289
1290 .cuf8:
1291         move.l  (sp)+,a0
1292         move.w  (sp),d0
1293         cmp.w   #2,d0
1294         bne     2f
1295         fmove.w 2(sp),fp0
1296         tst.w   2(sp)
1297         bge     1f
1298         fadd.l  #65536,fp0
1299         bra     1f
1300 2:
1301         fmove.l 2(sp),fp0
1302         tst.l   2(sp)
1303         bge     1f
1304         fsub.l  #-2147483648,fp0
1305         fsub.l  #-2147483648,fp0
1306 1:
1307         fmove.d fp0,(sp)
1308         jmp     (a0)
1309
1310 .cfi:
1311         move.l  (sp)+,a0
1312         move.w  (sp),d1
1313         move.w  2(sp),d0
1314         cmp.w   #4,d0
1315         bne     1f
1316         fmove.s 4(sp),fp0
1317         bra     2f
1318 1:
1319         fmove.d 4(sp),fp0
1320         add.l   #4,sp
1321 2:
1322         fintrz  fp0,fp0
1323         cmp.w   #2,d1
1324         bne     1f
1325         fmove.w fp0,6(sp)
1326         bra     2f
1327 1:
1328         fmove.l fp0,4(sp)
1329 2:
1330         cmp.w   #4,d0
1331         beq     1f
1332         sub.l   #4,sp
1333 1:
1334         jmp     (a0)
1335
1336 .cfu:
1337         move.l  (sp)+,a0
1338         move.w  (sp),d1
1339         move.w  2(sp),d2
1340         cmp.w   #4,d2
1341         bne     1f
1342         fmove.s 4(sp),fp0
1343         fabs    fp0
1344         cmp.l   #0x4f000000,4(sp)
1345         bge     2f
1346         fintrz  fp0,fp0
1347         fmove.l fp0,d0
1348         bra     3f
1349 2:
1350         fadd.l  #-2147483648,fp0
1351         fintrz  fp0,fp0
1352         fmove.l fp0,d0
1353         bchg    #31,d0
1354         bra     3f
1355 1:
1356         fmove.d 4(sp),fp0
1357         add.l   #4,sp
1358         fabs    fp0
1359         cmp.l   #0x41e00000,(sp)
1360         bge     1f
1361         fintrz  fp0,fp0
1362         fmove.l fp0,d0
1363         bra     3f
1364 1:
1365         fadd.l  #-2147483648,fp0
1366         fintrz  fp0,fp0
1367         fmove.l fp0,d0
1368         bchg    #31,d0
1369 3:
1370         cmp.w   #2,d1
1371         bne     1f
1372         move.w  d0,6(sp)
1373         bra     2f
1374 1:
1375         move.l  d0,4(sp)
1376 2:
1377         cmp.w   #4,d2
1378         beq     1f
1379         sub.l   #4,sp
1380 1:
1381         jmp     (a0)
1382
1383 .cff4:
1384         move.l  (sp)+,a0
1385         fmove.d (sp),fp0
1386         fmove.s fp0,4(sp)
1387         jmp     (a0)
1388
1389 .cff8:
1390         move.l  (sp)+,a0
1391         fmove.s (sp),fp0
1392         fmove.d fp0,(sp)
1393         jmp     (a0)
1394
1395 .cmf4:
1396         move.l  (sp)+,a0
1397         clr.l   d0
1398         fmove.s (sp),fp0
1399         fmove.s 4(sp),fp1
1400         fcmp    fp0,fp1
1401         fbeq    2f
1402         fblt    1f
1403         add.l   #1,d0
1404         jmp     (a0)
1405 1:
1406         sub.l   #1,d0
1407 2:
1408         jmp     (a0)
1409
1410 .cmf8:
1411         move.l  (sp)+,a0
1412         clr.l   d0
1413         fmove.d (sp),fp0
1414         fmove.d 8(sp),fp1
1415         fcmp    fp0,fp1
1416         fbeq    2f
1417         fblt    1f
1418         add.l   #1,d0
1419         jmp     (a0)
1420 1:
1421         sub.l   #1,d0
1422 2:
1423         jmp     (a0)
1424 \0fat.s\01.s\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0d\0.define      .fat
1425 .sect .text
1426 .sect .rom
1427 .sect .data
1428 .sect .bss
1429
1430         .sect .text
1431 .fat:
1432         jsr     .trp
1433         jmp     EXIT
1434 trp.s\01.s\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define       .trp
1435 .sect .text
1436 .sect .rom
1437 .sect .data
1438 .sect .bss
1439
1440         .sect .text
1441 .trp:
1442         move.l  (sp)+,a1        ! return address
1443         move.w  (sp)+,d0        ! error number
1444         move.l  a1,-(sp)
1445         move.w  d0,-(sp)
1446         cmp     #16,d0
1447         bcc     1f
1448         cmp     #8,d0
1449         bcc     4f
1450         btst    d0,.trpim
1451         bra     5f
1452 4:
1453         btst    d0,.trpim+1
1454 5:
1455         bne     3f
1456 1:
1457         move.l  .trppc,a0
1458         move.l  a0,d0
1459         beq     9f
1460         clr.l   .trppc
1461         jsr     (a0)
1462 3:
1463         add     #2,sp
1464         rts
1465 9:
1466         pea     fmt
1467         jsr     .diagnos
1468         jmp     EXIT
1469
1470         .sect .data
1471 .rettrp: .data4 0
1472 fmt:    .asciz "trap %d called\n"
1473 .align 2
1474 dia.s\01.s\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0U\f.define       .diagnos
1475 .sect .text
1476 .sect .rom
1477 .sect .data
1478 .sect .bss
1479
1480 space   = 040
1481 del     = 0177
1482
1483         .sect .text
1484 .diagnos:
1485         move.w  hol0,-(sp)
1486         move.l  hol0+4,d2
1487         beq     1f
1488         move.l  d2,a0
1489         move.l  #40,d0
1490 3:
1491         move.b  (a0)+,d1
1492         beq     2f
1493         cmp.b   #del,d1
1494         bge     1f
1495         cmp.b   #space,d1
1496         blt     1f
1497         sub     #1,d0
1498         bgt     3b
1499         clr.b   (a0)
1500 2:
1501         move.l  d2,-(sp)
1502         pea     fmt
1503         jsr     printf
1504         add     #10,sp
1505         jmp     printf
1506
1507 1:
1508         move.l  #unknwn,d2
1509         bra     2b
1510
1511 .sect .text
1512 putchar:
1513         move.w  #1,-(sp)
1514         pea     7(sp)
1515         move.w  #1,-(sp)
1516         jsr     WRITE
1517         add.l   #8,sp
1518         rts
1519 printf:
1520         link    a6,#-12
1521 .sect .data
1522 _12:
1523         .data2  28786
1524         .data2  26990
1525         .data2  29798
1526         .data2  11875
1527         .data2  0
1528 .sect .text
1529         pea     8+4(a6)
1530         move.l  (sp)+,-6(a6)
1531 I004:
1532         move.l  8+0(a6),-(sp)
1533         move.l  (sp),-(sp)
1534         move.l  (sp)+,a0
1535         add     #1,a0
1536         move.l  a0,-(sp)
1537         move.l  (sp)+,8+0(a6)
1538         move.l  (sp)+,a0
1539         clr     d0
1540         move.b  (a0),d0
1541         move.w  d0,-(sp)
1542         move.w  (sp),-(sp)
1543         move.w  (sp)+,-2(a6)
1544         move.w  #37,-(sp)
1545         move.w  (sp)+,d0
1546         cmp     (sp)+,d0
1547         beq     I005
1548         move.w  -2(a6),-(sp)
1549         tst     (sp)+
1550         beq     I002
1551         move.w  -2(a6),-(sp)
1552         jsr     putchar
1553         add     #2,sp
1554         jmp     I004
1555 I005:
1556         move.l  8+0(a6),-(sp)
1557         move.l  (sp),-(sp)
1558         move.l  (sp)+,a0
1559         add     #1,a0
1560         move.l  a0,-(sp)
1561         move.l  (sp)+,8+0(a6)
1562         move.l  (sp)+,a0
1563         clr     d0
1564         move.b  (a0),d0
1565         move.w  d0,-(sp)
1566         move.w  (sp)+,-2(a6)
1567         move.w  -2(a6),-(sp)
1568         move.w  #100,-(sp)
1569         move.w  (sp)+,d0
1570         cmp     (sp)+,d0
1571         beq     I008
1572         move.w  -2(a6),-(sp)
1573         move.w  #117,-(sp)
1574         move.w  (sp)+,d0
1575         cmp     (sp)+,d0
1576         bne     I007
1577 I008:
1578         move.l  -6(a6),-(sp)
1579         move.l  (sp)+,a0
1580         add     #2,a0
1581         move.l  a0,-(sp)
1582         move.l  (sp),-(sp)
1583         move.l  (sp)+,-6(a6)
1584         move.l  (sp)+,a0
1585         move.w  -2(a0),-(sp)
1586         move.w  (sp)+,-8(a6)
1587         move.w  -2(a6),-(sp)
1588         move.w  #100,-(sp)
1589         move.w  (sp)+,d0
1590         cmp     (sp)+,d0
1591         bne     I009
1592         move.w  -8(a6),-(sp)
1593         tst     (sp)+
1594         bge     I009
1595         move.w  #0,-(sp)
1596         move.w  -8(a6),-(sp)
1597         move.w  (sp)+,d0
1598         move.w  (sp)+,d1
1599         sub     d0,d1
1600         move.w  d1,-(sp)
1601         move.w  (sp)+,-8(a6)
1602         move.w  #45,-(sp)
1603         jsr     putchar
1604         add     #2,sp
1605 I009:
1606         move.w  -8(a6),-(sp)
1607         jsr     printn
1608         add     #2,sp
1609         jmp     I004
1610 I007:
1611         move.w  -2(a6),-(sp)
1612         move.w  #115,-(sp)
1613         move.w  (sp)+,d0
1614         cmp     (sp)+,d0
1615         bne     I004
1616         move.l  -6(a6),-(sp)
1617         move.l  (sp)+,a0
1618         add     #4,a0
1619         move.l  a0,-(sp)
1620         move.l  (sp),-(sp)
1621         move.l  (sp)+,-6(a6)
1622         move.l  (sp)+,a0
1623         move.l  -4(a0),-(sp)
1624         move.l  (sp)+,-12(a6)
1625 I00c:
1626         move.l  -12(a6),-(sp)
1627         move.l  (sp),-(sp)
1628         move.l  (sp)+,a0
1629         add     #1,a0
1630         move.l  a0,-(sp)
1631         move.l  (sp)+,-12(a6)
1632         move.l  (sp)+,a0
1633         clr     d0
1634         move.b  (a0),d0
1635         move.w  d0,-(sp)
1636         move.w  (sp),-(sp)
1637         move.w  (sp)+,-2(a6)
1638         tst     (sp)+
1639         beq     I004
1640         move.w  -2(a6),-(sp)
1641         jsr     putchar
1642         add     #2,sp
1643         jmp     I00c
1644 I002:
1645         unlk    a6
1646         rts
1647 printn:
1648         link    a6,#-2
1649 .sect .data
1650 _15:
1651         .data2  12337
1652         .data2  12851
1653         .data2  13365
1654         .data2  13879
1655         .data2  14393
1656         .data2  0
1657 .sect .text
1658         move.w  8+0(a6),-(sp)
1659         move.w  #10,-(sp)
1660         move.w  (sp)+,d0
1661         clr.l   d1
1662         move.w  (sp)+,d1
1663         divu    d0,d1
1664         move.w  d1,-(sp)
1665         move.w  (sp),-(sp)
1666         move.w  (sp)+,-2(a6)
1667         tst     (sp)+
1668         beq     I013
1669         move.w  -2(a6),-(sp)
1670         jsr     printn
1671         add     #2,sp
1672 I013:
1673         pea     _15
1674         move.w  8+0(a6),-(sp)
1675         move.w  #10,-(sp)
1676         move.w  (sp)+,d0
1677         clr.l   d1
1678         move.w  (sp)+,d1
1679         divu    d0,d1
1680         swap    d1
1681         move.w  d1,-(sp)
1682         move.w  (sp)+,d0
1683         ext.l   d0
1684         add.l   (sp)+,d0
1685         move.l  d0,-(sp)
1686         move.l  (sp)+,a0
1687         clr     d0
1688         move.b  (a0),d0
1689         move.w  d0,-(sp)
1690         jsr     putchar
1691         add     #2,sp
1692         unlk    a6
1693         rts
1694         .sect .data
1695 fmt:    .asciz "%s, line %d: "
1696 unknwn: .asciz "unknown file"
1697 .align 2
1698 llxl.s\01.s\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0B\ 1.define .lxl
1699 .sect .text
1700 .sect .rom
1701 .sect .data
1702 .sect .bss
1703 .extern .lxl
1704         .sect .text
1705 .lxl:
1706         ! #levels on stack (> 0)
1707
1708         move.l  (sp)+,a0        ! return address
1709         move.w  (sp)+,d2        ! d2 is not destroyed by .lpb
1710         move.l  a0,-(sp)
1711         sub.w   #1,d2
1712         move.l  a6,a0
1713 1:
1714         move.l  a0,-(sp)
1715         jsr     .lpb
1716         move.l  (a0),a0
1717         dbf     d2,1b
1718         rts                     ! result in a0
1719 lxa.s\01.s\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0\1a\ 1.define .lxa
1720 .sect .text
1721 .sect .rom
1722 .sect .data
1723 .sect .bss
1724 .extern .lxa
1725         .sect .text
1726 .lxa:
1727         ! #levels (>= 0) on stack
1728
1729         move.l  (sp)+,a0        ! return address
1730         move.w  (sp)+,d2
1731         move.l  a0,-(sp)
1732         move.l  a6,a0
1733 1:
1734         move.l  a0,-(sp)
1735         jsr     .lpb
1736         sub     #1,d2
1737         blt     2f
1738         move.l  (a0),a0
1739         bra     1b
1740 2:
1741         rts
1742 lpb.s\01.s\0\0\0\0\0\0\0\0\0\ 2\ 2�\ 1\0\0�\ 1.define .lpb
1743 .sect .text
1744 .sect .rom
1745 .sect .data
1746 .sect .bss
1747 .extern .lpb
1748         .sect .text
1749 .lpb:
1750         ! convert local to argument base
1751         ! should not destroy register d2 (used by lxa/lxl)
1752
1753         move.l  (sp)+,a1        ! return address
1754         move.l  (sp)+,a0        ! local base
1755         move.w  4(a0),d0        ! register save word
1756         move.w  d0,d1
1757         and.l   #7,d0           ! #data registers
1758         and.l   #070,d1
1759         asr.l   #3,d1           ! #address registers
1760         add.w   d1,d0
1761         asl.l   #2,d0           ! 4 * #registers
1762         add.w   #10,d0          ! reg. save word, lb, pc
1763         add.l   d0,a0
1764         jmp     (a1)