runt68000.ask

   1         LIST
   2
   3 * runtimelib FOR 68000
   4 * Joel Matthew Rees April 2020
   5
   6 * Borrowing some concepts from fig-Forth.
   7 * Purely theoretical, not tested!
   8
   9 * Natural 32-bit version.
  10 * Unnatural 16-bit version might be a project for another day?
  11 * (Would primarily be of interest for MUL and DIV, but CPU32 version is more interesting.)
  12
  13 * ------------------------------------LICENSE-------------------------------------
  14 *
  15 * Copyright (c) 2009, 2010, 2011 Joel Matthew Rees
  16 *
  17 * Permission is hereby granted, free of charge, to any person obtaining a copy
  18 * of this software and associated documentation files (the "Software"), to deal
  19 * in the Software without restriction, including without limitation the rights
  20 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  21 * copies of the Software, and to permit persons to whom the Software is
  22 * furnished to do so, subject to the following conditions:
  23 *
  24 * The above copyright notice and this permission notice shall be included in
  25 * all copies or substantial portions of the Software.
  26 *
  27 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  28 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  29 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  30 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  31 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  32 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  33 * THE SOFTWARE.
  34 *
  35 * --------------------------------END-OF-LICENSE----------------------------------
  36 *
  37
  38
  39 * These must be edited for target runtime:
  40
  41 * Necessary here for fake forward referencing:
  42
  43
  44 KERNLIB SECTION.S 0
  45
  46
  47 BYTESZ  EQU 8   ; bit count in byte
  48
  49 * I may want to explore non-linear addressing in the 68000
  50 * (and apply it to the 6805) once the basic interpreter is done
  51 * in the natural 32-bit CELL.
  52
  53 ADRWDSZ EQU 4   ; bytes per address word
  54 ADRWREM EQU (ADRWDSZ-1) ; for masking in address-odd remainder bits
  55 ADRWMSK EQU ((-ADRWREM)-1)      ; for masking out odd parts of addresses (manual bit invert)
  56
  57 HALFSZ  EQU 2
  58 HALFBSZ EQU (HALFSZ*2)          ; bit count in half-CELL
  59 * If at all possible, a CELL should be able to contain an address.
  60 * Otherwise, fetch and store become oddities.
  61 CELLSZ  EQU ADRWDSZ
  62 CELLBSZ EQU (ADRWDSZ*BYTESZ)    ; bit count in CELL
  63 DBLSZ   EQU (ADRWDSZ*2)
  64 DBLBSZ  EQU (DBLSZ*BYTESZ)      ; bit count in DOUBLE
  65
  66 GAPCT   EQU 2   ; address words for the gaps
  67 ALLOGAP EQU (GAPCT*ADRWDSZ)     ; For crude checks, gaps always zero.
  68
  69
  70 * Declare initial Return Stack (flow-of-control stack):
  71 RSTKBND EQU ($8000-ADRWDSZ      ; Bound: one beyond, but avoiding wraparound
  72 RSTKINI EQU (RSTKBND)   ; Init: next available byte on 68000 -- pre-dec
  73 RSTKSZ  EQU (62*ADRWDSZ)        ; Size: Safe for most purposes.
  74 RSTKLIM EQU (RSTKBND-RSTKSZ)    ; Limit: Last useable
  75 * Kibitzing -- CPUs really should have automatic stack bounds checking.
  76 * Don't forget gaps for CPUs that don't automatically check.
  77 * Crude guard rails is better than none?
  78
  79 * Declare initial Locals Stack (temporaries stack):
  80 LSTKBND EQU (RSTKLIM-ALLOGAP)
  81 LSTKINI EQU (LSTKBND-CELLSZ)    ; Pre-dec, but on address word boundary.
  82 LSTKSZ  EQU (30*CELLSZ) ; Size: CELL addressing, small stacks.
  83 LSTKLIM EQU (LSTKBND-LSTKSZ)
  84
  85 * Declare initial Parameter Stack (data stack):
  86 SSTKBND EQU (LSTKLIM-ALLOGAP)
  87 SSTKINI EQU (SSTKBND)   ; Also pre-dec, but on address word boundary.
  88 SSTKSZ  EQU (126*ADRWDSZ)       ; Size: CELL addressing, small stacks.
  89 SSTKLIM EQU (SSTKBND-SSTKSZ)
  90
  91 * The paramater stack and heap at opposite ends of the same region
  92 * has mixed benefits.
  93
  94 * The initial per-user allocation heap:
  95 UPGBND  EQU (SSTKLIM-ALLOGAP)
  96 UPGSZ   EQU 30*ADRWDSZ  ; This will need adjusting in many cases.
  97 UPGBASE EQU (UPGBND-UPGSZ)
  98 UPGINI  EQU UPGBASE
  99
 100
 101 * On 6809, BRN is being inserted at the top of routines
 102 * with an offset to the end, to mark what can be pulled in
 103 * for blind in-lining.
 104 *
 105 * But I'm not sure I'm actually going to use it.
 106
 107
 108 * ORG directives in older assemblers can get tangled up
 109 * if they are convoluted.
 110 * Keep the ORGs in assending order.
 111
 112
 113 * Check DP handling!
 114         ORG.S $40
 115
 116 * Internal registers --
 117 * (When switching contexts, these must be saved and restored.):
 118
 119 * RP    RMB ADRWDSZ
 120 *                       A7/SP == RP, the return/flow-of-control stack on 68000
 121 *
 122 * PSP   RMB ADRWDSZ
 123 *                       A6 == PSP, the parameter/data stack pointer on 68000
 124 * UP    RMB ADRWDSZ
 125 *                       A5 == UP, the pointer to the per-task heap on 68000
 126 * LP    RMB ADRWDSZ
 127 *                       A4 == LSP, optional local stack pointer on 68000
 128 * TEMP  RMB 2*ADRWDSZ
 129 *                       all temps not in registers are allocated locally
 130 *                       -- on RP/A7, PSP/A6, UP/A5, or possibly LSP/A4
 131 * GCOUNT        RMB ADRWDSZ
 132 *                       general counter allocated in any free Dn
 133 * IXDEST        RMB ADRWDSZ
 134 *                       destination index pointer as any free An (A0 .. A3)
 135 * IXSRC RMB ADRWDSZ
 136 *                       source index pointer as any free An (A0 .. A3)
 137
 138
 139 ***    D0 to D3, A0, and A1 are throwaway or return values
 140 * and should be saved by the caller before calls when necessary;
 141 * maybe be used freely in called routines.
 142
 143 ***    D4 to D7, A2, A3, and maybe A4 are persistent or parameters
 144 * and should be saved before being used in called routines.
 145
 146
 147         ORG.S $100
 148         NOP
 149 COLD    JMP.S COLDENT
 150         NOP
 151 WARM    JMP.S WARMENT
 152
 153
 154 * Definitions which are good candidates for direct substitution instead of call
 155 * might be marked by something like
 156 *
 157 *       DC.B CODE_ST-*
 158 *       DC.B CODE_END-*
 159 * CODE
 160 *       CODE ...        ; not needed in substitution
 161 * CODE_ST
 162 *       CODE ...        ; code which gets substituted instead of call
 163 * CODE_END
 164 *       CODE ...        ; not needed in substitution
 165 *       RTS     ; or whatever
 166 * to bracket the substitution for the interpreter/compiler.
 167 *
 168 * This would be part of the _WORD_ macro.
 169
 170 *************
 171 * Taking the AND and the @ and ! primitives as examples,
 172 * would using intermediates make optimization easier?
 173 * (As in optimize by stripping stack maintenance
 174 * and replacing it with register allocation.)
 175 *
 176 * AND
 177 *       MOVE.L CELLSZ(A6),D3
 178 *       AND.L (A6)+,D3
 179 *       MOVE.L D3,(A6)
 180 *       RTS
 181 *
 182 * BFETCH
 183 *       MOVE.L (A6),A0
 184 *       MOVEQ #0,D0
 185 *       MOVE.B (A0),D0
 186 *       MOVE.L D0,(A6)  ; whole cell to TOS
 187 *       RTS
 188 *
 189 * SSTORE
 190 *       MOVE.L (A6)+,A0
 191 *       MOVE.L (A6)+,D0 ; Get whole cell to keep stack address correct.
 192 *       MOVE.W D0,(A1)  ; Store only half-cell, do not clear high half!
 193 *       RTS
 194
 195
 196 * _WORD_ Take logical AND of top two on stack ( n1 n2 --- n3 ):
 197 AND
 198         MOVE.L (A6)+,D3
 199         AND.L D3,(A6)
 200         RTS
 201
 202 * _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
 203 OR
 204         MOVE.L (A6)+,D3
 205         OR.L D3,(A6)
 206         RTS
 207
 208 * _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
 209 XOR
 210         MOVE.L (A6)+,D3
 211         EOR.L D3,(A6)   ; (Not) coincidentally, EOR does not do (A6),D3.
 212         RTS
 213
 214 * _WORD_ + Add top two cells on stack ( n1 n2 --- sum ):
 215 ADD
 216         MOVE.L (A6)+,D3
 217         ADD.L D3,(A6)
 218         RTS
 219
 220 * _WORD_ - Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
 221 SUB
 222         MOVE.L (A6)+,D3
 223         SUB.L D3,(A6)
 224         RTS
 225
 226 * _WORD_ B@ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
 227 * (Refer to Forth's C@, but byte is not character!)
 228 BFETCH
 229         MOVE.L (A6),A1
 230         CLR.L (A6)      ; instead of intermediate Dn and CLR
 231         MOVE.B (A1),(A6)
 232         RTS
 233
 234 * _WORD_ B! Store low byte of cell at 2nd at address on top of stack, deallocate both ( b adr --- ):
 235 * (Refer to Forth's C!, but byte is not character!)
 236 BSTORE
 237         MOVE.L (A6)+,A1
 238         MOVE.B (A6),(A1)        ; Store only byte, do not clear high bytes!
 239         LEA ADRWDSZ(A6),A6      ; Less footprint than intermediate post-inc
 240         RTS
 241
 242 * _WORD_ S@ Fetch half-cell only pointed to by top cell on stack ( adr --- h(at adr) ):
 243 * adr must be even address aligned on most 68K.
 244 SFETCH
 245         MOVE.L (A6),A1
 246         CLR.L (A6)      ; instead of intermediate Dn and CLR
 247         MOVE.W (A1),(A6)
 248         RTS
 249
 250 * _WORD_ S! Store half-cell at 2nd at address on top of stack, deallocate both ( h adr --- ):
 251 * adr must be even address aligned on most 68K.
 252 SSTORE
 253         MOVE.L (A6)+,A1
 254         MOVE.W (A6),(A1)        ; Store only half-cell, do not clear high half!
 255         LEA ADRWDSZ(A6),A6      ; Less footprint than intermediate post-inc
 256         RTS
 257
 258 * _WORD_ @ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
 259 * adr must be even address aligned on most 68K.
 260 FETCH
 261         MOVE.L (A6).A1
 262         MOVE.L (A1),(A6)
 263         RTS
 264
 265 * _WORD_ ! Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
 266 * adr must be even address aligned on most 68K.
 267 STORE
 268         MOVE.L (A6)+,A1
 269         MOVE.L (A6)+,(A1)
 270         RTS
 271
 272 * Low confidence in the multiply and divide without an emulator to check.
 273
 274 * u1  h1:l1 ADRWDSZ:HALFSZ+ADRWDSZ
 275 * u2  h2:l2               0:HALFSZ
 276 *
 277 * _WORD_ U*bit Unsigned multiply of top two on stack ( u1 u2 --- udproduct(n1*n2) ):
 278 * Consider bit test instead of shift?
 279 USTARB
 280         MOVEQ #CELLBSZ,D0       ; bits/cell -- maybe count is one less for DBcc?
 281         MOVEQ #0,D2     ; Clears carry, not extend
 282         MOVE.L ADRWDSZ(A6),D3   ; multiplicand
 283         MOVE.L (A6),D1  ; multiplier
 284 USTARL
 285         ROXR.L D3
 286         DBF D0,USTART   ; done? hits both carry and extend!
 287         BRA.B USTARX
 288 USTART
 289         BCC.B USTARNA
 290         ADD.L ADRWDSZ(A6),D2
 291 USTARNA RORX.L D2       ; shift result in
 292         BRA USTARL
 293 USTARX  MOVEM.L D2/D3,(A6)      ; Store result.
 294         RTS
 295
 296 * u1  h1:l1 ADRWDSZ:HALFSZ+ADRWDSZ
 297 * u2  h2:l2               0:HALFSZ
 298 *
 299 * _WORD_ U* Unsigned multiply of top two on stack ( u1 u2 --- udproduct(n1*n2) )
 300 * Using 68000's MUL for speed.
 301 * Optimize for small operands at runtime.
 302 * More code, less time, but I need to check that I'm handling the halves right:
 303 USTAR
 304 * D1 gets product of two low halves plus the low halves of the mixed inner products.
 305 * D0 gets product of two high halves plus the high halves of the two mixed inner products,
 306 * plus carries from D1.
 307 * Break early when we can.
 308         MOVEQ #0,D0
 309         MOVEM.L (A6),D3/D2      ; multiplicand/multiplier
 310         MOVE.W D2,D1
 311         MULU D3,D1      ; Lower halves product
 312         MOVE.L D2,D4
 313         SWAP D4         ; higher half of multiplier in D4
 314         MOVE.L D3,D5
 315         SWAP D5         ; higher half of multiplicand in D5
 316         MOVE.W D4,D6
 317         BNE.B USTAR2
 318 USTAR0
 319         MOVE.W D5,D6
 320         BNE.B USTAR3
 321 USTAR1
 322         MOVEM D1/D0,(A6)
 323         RTS
 324 USTAR2
 325         MULU D3,D6      ; multiplicand low by multiplier high
 326         SWAP D6
 327         MOVE.L D6,D7
 328         AND.L #$0000FFFF,D7
 329         AND.L #$FFF0000,D6
 330         ADD.L D6,D1
 331         ADC.L D7,D0
 332         BRA.B USTAR0
 333 USTAR3
 334         MULU D2,D6      ; multiplier low by multiplicand high
 335         SWAP D6
 336         MOVE.L D6,D7
 337         AND.L #$0000FFFF,D7
 338         AND.L #$FFF0000,D6
 339         ADD.L D6,D1
 340         ADC.L D7,D0
 341 USTAR4  ; Anyway, now do the high halves, since both were non-zero.
 342         MULU D5,D4
 343         ADD.L D4,D0
 344         BRA.B USTAR1
 345
 346 USTARSTRAIGHT
 347         MOVEQ #0 D1     ; Scratch area for inner products
 348         MOVEQ #0 D0
 349 *
 350         MOVE.W HALFSZ+ADRWDSZ(A6),D3    ; low halves
 351         MULU HALFSZ(A6),D3
 352 * max: $FFFE0001
 353 *
 354         MOVE.W ADRWDSZ(A6),D2   ; inner1: u1 high
 355         MULU HALFSZ(A6),D2      ; u2 low
 356 * max: $FFFE0001
 357 *
 358         MOVE.W D2,D1    ; lower half of inner1
 359         ADD.L D1,D3     ; No carry possible yet.
 360 * bound: $FFFE0001+$0000FFFF=$FFFF0000
 361 *
 362         SWAP D2
 363         MOVE.W D2,D1    ; higher half of inner1, hold it.
 364 *
 365         MOVE.W HALFSZ+ADRWDSZ(A6),D2    ; inner2: u1 low
 366         MULU (A6),D2    ; u2 high
 367 * max: $FFFE0001
 368 *
 369         MOVE.W D2,D0    ; lower half of inner2
 370         ADD.L D0,D3     ; Still no carry possible.
 371 * bound: $FFFF0000+$0000FFFF=$FFFFFFFF
 372         SWAP D2
 373         MOVE.W D2,D0    ; higher half of inner2
 374         ADD.L D0,D1     ; add to inner1 higher half
 375 * bound: $0000FFFF+$0000FFFF=$0001FFFE
 376         MOVE.W ADRWDSZ(A6),D2   ; high halves
 377         MULU (A6),D2
 378 * max $FFFE0001
 379         ADD.L D1,D2
 380 * bound: $FFFE0001+$0001FFFE=$FFFFFFFF
 381 * Done, result in D2:D3
 382         MOVEM.L D2/D3,(A6)
 383         RTS
 384
 385 * _WORD_ SWAP swap top two cells on stack ( n1 n2 --- n2 n1 ):
 386 SWAP
 387         MOVEM.L (A6),D2/D3
 388         EXG D2,D3
 389         MOVEM.L D2/D3,(A6)
 390         RTS
 391 * As opposed to
 392 *       MOVEM.L (A6),D2/D3
 393 *       MOVE.L D2,(ADRWDSZ,A6)
 394 *       MOVE.L D3,(A6)
 395 * Which will be smaller, faster, less bus activity?
 396
 397
 398 * _WORD_ U/MODbit Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
 399 * ( ud u --- uremainder uquotient )
 400 * Dividend should be range of product of 32 by 32 bit unsigned multiply,
 401 * divisor should be the multiplier or multiplicand:
 402 * Consider bit test instead of shift?
 403 * Also, examine the native divide again.
 404 * ** Native divide requires divide-by-zero trap code!
 405 USLASHB
 406         MOVEQ #1+CELLBSZ,D0     ; bit ct
 407         MOVEM.L (A6),D3/D2/D1   ; D1 is divisor, D2:D3 is dividend
 408 USLDIV
 409         CMP.L D1,D2     ; dividend high in D2 - divisor in D1
 410         BHS.B USLSUB    ; *** need to look at this carefully
 411         ANDI #^1,CCR    ; clear carry bit
 412         BRA.B USLBIT
 413 USLSUB
 414         SUB.L D1,D2
 415         ORI #1,CCR      ; quotient bit,
 416 USLBIT
 417         ROXL.L #1,D3    ; save it
 418         SUBQ #1,D0      ; more bits?
 419         BEQ.B USLR      ; Can DBcc be used here?
 420         ROXL.L #1,D2    ; move remainder in as we move dividend out
 421         BCC USLDIV
 422         BRA USLSUB
 423 USLR
 424         LEA ADRWDSZ(A6),A6
 425         MOVE.L D3,(A6)          ; quotient
 426         MOVE.L D2,ADRWDSZ(A6)   ; remainder
 427         RTS
 428
 429 * _WORD_ U/MOD Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
 430 * ( ud u --- uremainder uquotient )
 431 * Assume native divide trap on n/0 simply sets quotient to all ones or something.
 432 * Start by doing 32/16 divide if divisor less than 65536.
 433 * Maybe call the bit divide until I understand better, when divisor is more than 16 bits.
 434 * Dividend should be range of product of 32 by 32 bit unsigned multiply,
 435 * divisor should be the multiplier or multiplicand:
 436 * Consider bit test instead of shift?
 437 * Also, examine the native divide again.
 438 * ** Native divide requires divide-by-zero trap code!
 439 USLASH
 440         MOVEM.L (A6),D3/D2/D1   ; D1 is divisor, D2:D3 is dividend
 441         CMPI.L #$10000,D1
 442         BHS.B USLASH32
 443         DIVU
 444 USLASH32
 445
 446 Try working out 16/8 on 6801 (6800) for clues.
 447
 448 * _WORD_ >L Save top cell on stack to locals stack ( n --- ) { --- n }:
 449 TOL
 450         MOVE.L (A4)+,-(A6)
 451         RTS
 452
 453 * _WORD_ >R Save top cell on stack to return stack ( n --- ) { --- n }:
 454 TOR
 455         MOVE.L (A7),A1
 456         MOVE.L (A6)+,(A7)
 457         JMP (A1)
 458 * In-lining:
 459 TOR_ST
 460         MOVE.L (A6)+,-(A7)
 461 TOR_END
 462
 463 * _WORD_ L> Pop top of locals stack to parameter stack ( --- n ) { n --- }:
 464 LFROM
 465         MOVE.L (A4)+,-(a6)
 466         RTS
 467
 468 * _WORD_ R> Pop top of return stack to parameter stack ( --- n ) { n --- }:
 469 RFROM
 470         MOVEM.L (A7)+,A1/A0
 471         MOVE.L A1,-(A6)
 472         JMP (A0)
 473 *
 474 * In-lining:
 475 RFROM_ST
 476         MOVEM.L (A7)+,-(A6)
 477 RFROM_END
 478
 479 * _WORD_ L Retrieve, do not pop top of locals stack to parameter stack ( --- n ) { n --- n }:
 480 L
 481         MOVE.L (A4),-(a6)
 482         RTS
 483
 484 * _WORD_ R Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }:
 485 R
 486         MOVE.L ADRWDSZ(A7),-(A6)
 487         RTS
 488 * In-lining:
 489 R_ST
 490         MOVE.L (A7),-(A6)
 491 R_END
 492
 493 * _WORD_ DUP Duplicate top cell on stack ( n --- n n ):
 494 DUP
 495         MOVE.l (A6),-(A6)
 496         RTS
 497
 498 * _WORD_ DROP Remove a cell from the parameter stack ( n --- )
 499 DROP
 500         LEA CELLSZ(A7),A7       ; or PULU D and throw away
 501         RTS
 502
 503 * _WORD_ 2DROP Remove a cell from the parameter stack ( n --- )
 504 DDROP
 505         LEAU 2*CELLSZ(A7),U     ; or PULU D,X and throw away
 506         RTS
 507
 508 * Should true be set as 1 or -1?
 509 * Going with all bits False (0)
 510 * or all bits True (-1) as the flag to set.
 511 * _WORD_ 0= Test top cell on stack for zero ( n --- f(top==0) ):
 512 ZEQU
 513         MOVE.L (A7),D0
 514         SNE DO
 515         COM.B D0
 516         EXT.W D0        ; CPU32 can EXTB.L
 517         EXT.L D0
 518         MOVE.L D0,(A7)
 519         RTS
 520 *
 521 * ZEQUB
 522 *       MOVE.L (A7),D0
 523 *       BNE ZEQUBF
 524 *       CLR (A7)
 525 *       BRA ZEQUBR
 526 * ZEQUBF
 527 *       MOVE #-1,(A7)
 528 * ZEQUBR
 529 *       RTS
 530
 531 *
 532 * True as 1 would look like
 533 * ZEQU
 534 * ZEQU_ST
 535 *       MOVE.L (A7),D0
 536 *       SNE DO
 537 *       COM.B D0
 538 *       AND.L #1,D0
 539 *       MOVE.L D0,(A7)
 540 * ZEQU_END
 541 *       RTS
 542
 543
 544
 545 * _LOWORD_ Duplicate (count in B) bytes on stack:
 546 NDUP
 547         LDX PSP
 548         STX TEMP
 549
 550
 551
 552 ****** Working in here to make it go both ways.
 553 ****** Also need to check multiply and divide.
 554 ****** And need to convert the stuff past multiply and divide to 68000
 555
 556
 557 * Entry point below.
 558 * SMOVEL
 559 *       MOVE.B (A2)+,(A3)+
 560 *
 561 * not_LOWORD_ Move 2^16-1 bytes or less:
 562 * source in A2, destination in A3, count in D4:
 563 * Overlaps only work if source is higher than dest.
 564 * SMOVE
 565 *       DBF D4,SMOVEL
 566 *       RTS
 567
 568 * _WORD_ Move up to 32K (2^15) bytes ( src dest count --- ):
 569 * Copies zero when count > 2^15. (Limited for safety.)
 570 * Compare CMOVE in Forth.
 571 BMOVE
 572         MOVE.L (2*ADRWDSZ,A6),A2        ; src
 573         MOVE.L (ADRWDSZ,A6),A3 ; dest
 574         MOVE.L (A6),D4
 575         CMP.L #$8000    ; Pre-test, do nothing if too big,
 576         BLS.B BMOVEE    ; or if zero.
 577         BRA.B BMOVEX
 578 BMOVEL
 579         MOVE.B (A2)+,(A3)+
 580 BMOVEE
 581         DBF D4,SMOVEL   ; Catches zero count here and stops.
 582 BMOVEX  LEAU (3*ADRWDSZ,A6),A6
 583         RTS
 584
 585 * _WORD_ Execute the address on the stack:
 586 EXEC
 587         LDX PSP
 588         INX
 589         INX
 590         STX PSP
 591         LDX 0,X
 592         JSR 0,X ; For debugging and flattening, no early optimizations.
 593         RTS
 594
 595
 596
 597 COLDENT EQU *
 598 WARMENT EQU *
 599         MOVE.L #RSTKINI,A7
 600         MOVE.L #SSTKINI,A6
 601         MOVE.L #LSTKINI,A4
 602         MOVE.L #UPGINI,A5
 603
 604
 605
 606