runt6800.68c

   1         OPT PRT
   2
   3 * runtimelib FOR 6800
   4 * Joel Matthew Rees April 2020
   5
   6 * Borrowing some concepts from fig-Forth.
   7 * Not tested!
   8
   9 * ------------------------------------LICENSE-------------------------------------
  10 *
  11 * Copyright (c) 2009, 2010, 2011, 2020 Joel Matthew Rees
  12 *
  13 * Permission is hereby granted, free of charge, to any person obtaining a copy
  14 * of this software and associated documentation files (the "Software"), to deal
  15 * in the Software without restriction, including without limitation the rights
  16 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  17 * copies of the Software, and to permit persons to whom the Software is
  18 * furnished to do so, subject to the following conditions:
  19 *
  20 * The above copyright notice and this permission notice shall be included in
  21 * all copies or substantial portions of the Software.
  22 *
  23 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  24 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  25 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  26 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  27 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  28 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  29 * THE SOFTWARE.
  30 *
  31 * --------------------------------END-OF-LICENSE----------------------------------
  32 *
  33
  34
  35 * These must be edited for target runtime:
  36
  37 * Necessary here for forward referencing:
  38
  39 BYTESZ  EQU 8   ; bit count in byte
  40
  41 ADRWDSZ EQU 2   ; bytes per address word
  42
  43 * If at all possible, a CELL should be able to contain an address.
  44 * Otherwise, fetch and store become oddities.
  45 CELLSZ  EQU ADRWDSZ
  46 CELLBSZ EQU (CELLSZ*BYTESZ)     ; bit count in CELL
  47 DBLSZ   EQU (CELLSZ*2)
  48 DBLBSZ  EQU (DBLSZ*BYTESZ)      ; bit count in DOUBLE
  49
  50 GAPCT   EQU 2   ; address words for the gaps
  51 ALLOGAP EQU (GAPCT*CELLSZ)      ; For crude checks, gaps always zero.
  52
  53
  54 * Declare initial Return Stack (flow-of-control stack):
  55 RSTKBND EQU $8000       ; Bound: one beyond
  56 RSTKINI EQU (RSTKBND-1) ; Init: next available byte on 6800
  57 RSTKSZ  EQU (62*CELLSZ) ; Size: Safe for most purposes.
  58 RSTKLIM EQU (RSTKBND-RSTKSZ)    ; Limit: Last useable (Ignore pre-dec.)
  59 * Kibitzing -- CPUs really should have automatic stack bounds checking.
  60 * Don't forget gaps for CPUs that don't automatically check.
  61 * Crude guard rails is better than none?
  62
  63 * Declare initial Locals Stack (temporaries stack):
  64 LSTKBND EQU (RSTKLIM-ALLOGAP)
  65 LSTKINI EQU (LSTKBND-CELLSZ)    ; Pre-dec, even on 6800, but on address word boundary.
  66 LSTKSZ  EQU (30*CELLSZ) ; Size: CELL addressing, small stacks.
  67 LSTKLIM EQU (LSTKBND-LSTKSZ)
  68
  69 * Declare initial Parameter Stack (data stack):
  70 SSTKBND EQU (LSTKLIM-ALLOGAP)
  71 SSTKINI EQU (SSTKBND-CELLSZ)    ; Pre-dec, even on 6800, but on address word boundary.
  72 SSTKSZ  EQU (126*CELLSZ)        ; Size: CELL addressing, small stacks.
  73 SSTKLIM EQU (SSTKBND-SSTKSZ)
  74
  75 * The paramater stack and heap at opposite ends of the same region
  76 * has mixed benefits.
  77
  78 * The initial per-user allocation heap:
  79 UPGBND  EQU (SSTKLIM-ALLOGAP)
  80 UPGSZ   EQU (30*CELLSZ) ; This will need adjusting in many cases.
  81 UPGBASE EQU (UPGBND-UPGSZ)
  82 UPGINI  EQU UPGBASE
  83
  84
  85 * ORG directives in older assemblers can get tangled up
  86 * if they are convoluted.
  87 * Keep the ORGs in ascending order.
  88
  89
  90         ORG $40
  91
  92 * Internal registers --
  93 * (When switching contexts, these must be saved and restored.):
  94
  95 * RP    RMB ADRWDSZ     ; the return/flow-of-control stack pointer is 6800 S
  96 * A software locals stack would require thrashing X,
  97 * so we'll take the unwise expedient of using the return stack.
  98 LSP     RMB ADRWDSZ     ; the locals stack pointer (for locals, i. e., instead of RP)
  99 PSP     RMB ADRWDSZ     ; the parameter/data stack pointer (Forth SP)
 100 UP      RMB ADRWDSZ     ; pointer to the per-task heap
 101 TEMP    RMB 2*CELLSZ    ; for general math
 102 GCOUNT  RMB CELLSZ      ; general counter
 103 IXDEST  RMB ADRWDSZ     ; destination index pointer
 104 IXSRC   RMB ADRWDSZ     ; source index pointer
 105 IXTERM  RMB ADRWDSZ     ; terminator for moves
 106
 107
 108
 109
 110         ORG $100
 111         NOP
 112 COLD    JMP COLDENT
 113         NOP
 114 WARM    JMP WARMENT
 115
 116
 117 * _LOWORD_ Subtract byte in B from cell pointed to by X:
 118 * Not really all that useful when you can CLRA and SUBCELL?
 119 * SUBBYT
 120 *       LDAA 1,X
 121 *       SBA
 122 *       STAA 1,X
 123 *       BCC ADDBYTX
 124 *       DEC 0,X
 125 * SUBBYTX       RTS
 126
 127 * _LOWORD_ Add byte in B to cell pointed to by X:
 128 * Not really all that useful when you can CLRA and ADDCELL?
 129 * ADDBYT
 130 *       ADDB 1,X
 131 *       STAB 1,X
 132 *       BCC ADDBYTX
 133 *       INC 0,X
 134 * ADDBYTX       RTS
 135
 136
 137 * GETAB MACRO
 138 *       LDX PSP
 139 *       LDAB 1,X
 140 *       LDAA 0,X
 141 *       INX
 142 *       INX
 143 *       STX PSP
 144 *       ENDM
 145 * Or doing as subroutine would would add 4 bytes and about ten cycles?
 146 * How useful would it be?
 147 *
 148 * Instead of providing such here, plan on providing funtionality later.
 149
 150
 151 * _WORD_ AND Take logical AND of top two on stack ( n1 n2 --- n3 ):
 152 AND
 153         LDX PSP
 154         LDAA 0,X
 155         LDAB 1,X
 156         ANDA CELLSZ,X
 157         ANDB 1+CELLSZ,X
 158         BRA STDEALL
 159 *
 160 * Stack maintenance:
 161 *
 162 * Might replace the first three instructions with
 163 * LDDACCM
 164 *       LDX PSP
 165 *       LDAA 0,X
 166 *       LDAB 1,X
 167 *       RTS
 168 *
 169 * AND
 170 *       BSR LDDSUB
 171 *
 172 * But that only saves four bytes each,
 173 * at a cost of some thirteen cycles
 174 * in code that we assume will become a bottleneck.
 175 *
 176 * The number of places it would be used are less than ten, I think.
 177 * Less than 40 bytes saved.
 178 *
 179 * Tail-stealing the STDEALL code costs enough to throw that into question as it is,
 180 * but that's seven bytes saved at a cost of four cycles.
 181 *
 182 * We will assume that auto-in-lining for the 6800 will be not be in this version.
 183
 184 * _WORD_ OR Take logical OR of top two on stack ( n1 n2 --- n3 ):
 185 OR
 186         LDX PSP
 187         LDAA 0,X
 188         LDAB 1,X
 189         ORAA CELLSZ,X
 190         ORAB 1+CELLSZ,X
 191         BRA STDEALL
 192
 193 * _WORD_ XOR Take logical OR of top two on stack ( n1 n2 --- n3 ):
 194 XOR
 195         LDX PSP
 196         LDAA 0,X
 197         LDAB 1,X
 198         EORA CELLSZ,X
 199         EORB 1+CELLSZ,X
 200         BRA STDEALL
 201
 202 * _WORD_ Add top two cells on stack ( n1 n2 --- sum ):
 203 ADD
 204         LDX PSP ; MACRO GETAB
 205         LDAB 1+CELLSZ,X ; n2
 206         LDAA CELLSZ,X
 207 * Fall through:
 208 *
 209 * _LOWORD_ + Add cell in A:B to cell pointed to by X:
 210 ADDCELL
 211         ADDB 1,X
 212         ADCA 0,X
 213 * Keep rob point for storing over 2nd and deallocating top.
 214 STDEALL
 215         STAB 1+CELLSZ,X
 216         STAA CELLSZ,X
 217         INX     ; deallocate
 218         INX
 219         STX PSP
 220         RTS
 221
 222 * _WORD_ - Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
 223 SUB
 224         LDX PSP ; MACRO GETAB
 225         LDAB 1+CELLSZ,X
 226         LDAA CELLSZ,X
 227 * Fall through:
 228 *
 229 * !xxx _LOWORD_ Subtract cell pointed to by 2,X from cell in A:B (not useful?):
 230 SUBCELL
 231         SUBB 1,X
 232         SBCA 0,X
 233         BRA STDEALL
 234 *       STAB 1+CELLSZ,X
 235 *       STAA CELLSZ,X
 236 *       INX     ; deallocate
 237 *       INX
 238 *       STX PSP
 239 *       RTS
 240
 241 * ASSERT CELLSZ == ADRWDSZ
 242
 243 * _WORD_ B@ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
 244 * (Refer to Forth's C@, but byte is not character!)
 245 BFETCH
 246         LDX PSP
 247         LDX 0,X ; adr
 248         LDAB 1,X
 249         LDX PSP
 250         CLR 0,X
 251         STAB 1,X        ; Not worth robbing.
 252         RTS
 253
 254 * _WORD_ B! Store low byte of cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
 255 * (Refer to Forth's C!, but byte is not character!)
 256 BSTORE
 257         LDX PSP
 258         LDAB 1+ADRWDSZ,X        ; n low byte only
 259         LDX 0,X         ; adr
 260         STAB 0,X        ; Store only byte, do not clear high byte!
 261         BRA DEALL2      ; Rob code to deallocate, assumes CELLSZ == ADRWDSZ.
 262
 263 * _WORD_ @ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
 264 FETCH
 265         LDX PSP
 266         LDX 0,X ; adr
 267         LDAA 0,X
 268         LDAB 1,X
 269         LDX PSP
 270         STAA 0,X
 271         STAB 1,X
 272         RTS
 273
 274 * _WORD_ ! Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
 275 STORE
 276         LDX PSP
 277         LDAA ADRWDSZ,X  ; n
 278         LDAB 1+ADRWDSZ,X
 279         LDX 0,X         ; adr
 280         STAA 0,X
 281         STAB 1,X
 282 * Rob point to deallocate 2 on stack.
 283 DEALL2
 284         LDX PSP
 285         INX     ; implicit dependency on CELLSZ and ADRWDSZ
 286         INX
 287         INX
 288         INX
 289         STX PSP
 290         RTS
 291
 292 * _WORD_ U* Unsigned multiply of top two on stack ( n1 n2 --- udproduct(n1*n2) ):
 293 USTAR
 294         LDX PSP
 295         LDAA #CELLBSZ   ; bits/cell
 296         STAA 1+GCOUNT
 297         CLRA    ; Clear Carry, too.
 298         CLRB
 299 USTARL  ROR CELLSZ,X    ; shift multiplier
 300         ROR 1+CELLSZ,X
 301         DEC 1+GCOUNT    ; done?
 302         BMI USTARX
 303         BCC USTARNA
 304         ADDB 1+CELLSZ,X
 305         ADCA CELLSZ,X
 306 USTARNA RORA
 307         RORB ; shift result in
 308         BRA USTARL
 309 USTARX  STAB 1,X        ; store more significant 16 bits
 310         STAA 0,X
 311         RTS
 312
 313 * _WORD_ SWAP swap top two cells on stack ( n1 n2 --- n2 n1 ):
 314 SWAP
 315         LDX PSP
 316 SWAPROB
 317         LDAA 0,X
 318         LDAB CELLSZ,X
 319         STAB 0,X
 320         STAA CELLSZ,x
 321         LDAA 1,X
 322         LDAB 1+CELLSZ,X
 323         STAB 1,X
 324         STAA 1+CELLSZ,x
 325         RTS
 326
 327 * _WORD_ U/MOD Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
 328 * ( ud u --- uremainder uquotient )
 329 * Dividend should be range of product of 16 by 16 bit unsigned multiply,
 330 * divisor should be the multiplier or multiplicand:
 331 USLASH
 332         LDX PSP
 333         LDAA #1+CELLBSZ ; one more than bits/cell
 334         STAA 1+GCOUNT
 335         LDAA CELLSZ,X   ; dividend
 336         LDAB 1+CELLSZ,X
 337 USLLUP  CMPA 0,X        ; divisor
 338         BHI USLSUB      ; If equal, must compare low byte.
 339         BCS USLNSUB
 340         CMPB 1,X
 341         BCC USLSUB      ; CC = HS (High or Same)
 342 USLNSUB CLC     ; For shifting
 343         BRA USLNEXT
 344 USLSUB  SUBB 1,X
 345         SBCA 0,X
 346         SEC     ; For shifting
 347 USLNEXT ROL 1+2*CELLSZ,X
 348         ROL 2*CELLSZ,X
 349         DEC 1+GCOUNT
 350         BEQ USLX
 351         ROLB
 352         ROLA
 353         BCC USLLUP
 354         BRA USLSUB      ; Catch the excess.
 355 USLX    INX     ; Drop high cell.
 356         INX
 357         STX PSP
 358         STAA 0,X        ; High cell now empty, save remainder.
 359         STAB 1,X        ; But remainder is now top.
 360         BRA SWAPROB     ; PSP in X, reverse quotient & remainder.
 361 * Steal return.
 362
 363 * _WORD_ >L Save top cell on stack to locals stack ( n --- ) { --- n }:
 364 TOL
 365         LDX PSP
 366         LDAA 0,X
 367         LDAB 1,X
 368         INX     ; Not worth robbing code.
 369         INX
 370         STX PSP
 371         LDX LSP
 372         DEX
 373         DEX
 374         STAA 0,X        ; save it
 375         STAB 1,X
 376         STX LSP
 377         RTS
 378
 379 * _WORD_ >R Save top cell on stack to return stack ( n --- ) { --- n }:
 380 TOR
 381         LDX PSP
 382         LDAA 0,X
 383         LDAB 1,X
 384         INX     ; Not worth robbing code.
 385         INX
 386         STX PSP
 387         TSX
 388         LDX 0,X ; get return address
 389         INS     ; drop it
 390         INS
 391         PSHB    ; Watch order!
 392         PSHA
 393         JMP 0,X
 394
 395 * _WORD_ L> Pop top of locals stack to parameter stack ( --- n ) { n --- }:
 396 LFROM
 397         LDX LSP
 398         LDAA 0,X top cell on locals stack
 399         LDAB 1,X
 400         INX
 401         INX
 402         STX LSP
 403         LDX PSP
 404         DEX
 405         DEX
 406         STX PSP
 407         STAA 0,X        ; save it before you leave
 408         STAB 1,X
 409         RTS
 410
 411 * _WORD_ R> Pop top of return stack to parameter stack ( --- n ) { n --- }:
 412 RFROM
 413         TSX
 414         LDAA ADRWDSZ,X top cell on R stack -- dodge return address
 415         LDAB 1+ADRWDSZ,X
 416         LDX PSP
 417         DEX
 418         DEX
 419         STX PSP
 420         STAA 0,X        ; save it first
 421         STAB 1,X
 422         TSX
 423         LDX 0,X ; get return address
 424         INS     ; drop it
 425         INS
 426         JMP 0,X ; return
 427
 428 * _WORD_ L Retrieve, do not pop top of locals stack to parameter stack ( --- n ) { n --- n }:
 429 L
 430         LDX LSP
 431         LDAA 0,X top cell on locals stack
 432         LDAB 1,X
 433         LDX PSP
 434         BRA DUPST
 435
 436 * _WORD_ R Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }:
 437 R
 438         TSX
 439         LDAA ADRWDSZ,X  ; top cell on R stack -- dodge return address
 440         LDAB 1+ADRWDSZ,X
 441         LDX PSP ; allocate
 442         BRA DUPST
 443
 444 * _WORD_ DUP Duplicate top cell on stack ( n --- n n ):
 445 DUP
 446         LDX PSP
 447         LDAA 0,X
 448         LDAB 1,X
 449 DUPST
 450         DEX
 451         DEX
 452         STX PSP
 453         STAA 0,X
 454         STAB 1,X
 455         RTS
 456
 457 * _WORD_ DROP Remove a cell from the parameter stack ( n --- )
 458 DROP
 459         LDX PSP
 460         INX
 461         INX
 462         STX PSP
 463         RTS
 464
 465 * _WORD_ 2DROP Remove two cells from the parameter stack ( d --- )
 466 DDROP
 467         LDX PSP
 468         INX
 469         INX
 470         INX
 471         INX
 472         STX PSP
 473         RTS
 474
 475
 476 * Should true be set as 1 or -1?
 477 * Going with all bits False (0)
 478 * or all bits True (-1) as the flag to set.
 479 * _WORD_ 0= Test top cell on stack for zero ( n --- f(top==0) ):
 480 ZEQU
 481         LDX PSP
 482         CLRA
 483         LDAB 0,X
 484         ORAB 1,X
 485         BNE ZEQUF
 486         COMA
 487 ZEQUF
 488         STAA 0,X
 489         STAA 1,X
 490         RTS
 491 *
 492 * True as 1 would look like
 493 * ZEQU
 494 *       LDX PSP
 495 *       CLRA
 496 *       LDAB 0,X
 497 *       ORAB 1,X
 498 *       BNE ZEQUF
 499 *       INCA
 500 * ZEQUF
 501 *       CLR 0,X
 502 *       STAA 1,X
 503 *       RTS
 504
 505
 506
 507 * _LOWORD_ Duplicate (count in B) bytes on stack:
 508 NDUP
 509         LDX PSP
 510         STX TEMP
 511
 512
 513
 514 * _LOWORD_ Move 256 bytes or less going up:
 515 * 0=256, do not enter without pretesting for 0 count!
 516 * source in IXSRC, destination in IXDEST, count in B:
 517 * Overlaps only work if source is higher than dest.
 518 SMOVEUP
 519         BSR GMVPRM
 520 SMOVEUL
 521         LDX IXSRC
 522         LDAA 0,X
 523         INX
 524         STX IXSRC
 525         LDX IXDEST
 526         STAA 0,X
 527         INX
 528         STX IXDEST
 529         DECB
 530         BNE SMOVEUL
 531         RTS
 532
 533 * _LOWORD_ Move 256 bytes or less going down:
 534 * 0=256, do not enter without pretesting for 0 count!
 535 * source in IXSRC, destination in IXDEST, count in B, A is overwritten:
 536 * Overlaps only work if source is higher than dest.
 537 SMOVEDN
 538         BSR GMVPRM
 539 SMOVEDL
 540         TBA
 541         ADDA 1+IXSRC
 542         STAA 1+IXSRC
 543         CLRA    ; 1# 2~ -- BCC takes 2#, 4~; INC IXSRC takes 3# & 6~
 544         ADCA IXSRC ; 2# 3~
 545         STAA IXSRC ; 2# 4~
 546         TBA
 547         ADDA 1+IXDEST
 548         STAA 1+IXDEST
 549         CLRA    ; 1# 2~ -- BCC takes 2#, 4~; INC IXDEST takes 3# & 6~
 550         ADCA IXDEST ; 2# 3~
 551         STAA IXDEST ; 2# 4~
 552 SMOVEDL
 553         LDX IXSRC
 554         DEX
 555         LDAA 0,X
 556         STX IXSRC
 557         LDX IXDEST
 558         DEX
 559         STAA 0,X
 560         STX IXDEST
 561         DECB
 562         BNE SMOVEDL
 563         RTS
 564
 565 * _LOWORD_ Set up parameters for MOVE  ( src dest count --- )
 566 * Return without copying if count is zero or if 2^15 or more.
 567 * Make sure destination is left in A:B for math.
 568 GMVPRM
 569         LDX PSP ; get paramaters for move
 570         LDX 0,X ; count
 571         BEQ GMVPRX      ; bail now if zero
 572         BMI GMVPRX      ; also if greater than 32K
 573         STX GCOUNT
 574         LDX PSP
 575         LDAA CELLSZ,X   ; preparing for math
 576         LDAB 1+CELLSZ,X
 577         STAA IXDEST
 578         STAB 1+IXDEST
 579         LDX CELLSZ+ADRWDSZ,X
 580         STX IXDEST
 581         RTS     ; Back to MOVE that called us.
 582 *
 583 GMVPRX
 584         INS     ; Drop return to MOVE code.
 585         INS
 586         BRA DEALL3
 587
 588 * _WORD_ Move up to 32K bytes ( src dest count --- ):
 589 * Copies zero when count >= 2^15
 590 * Compare CMOVE in Forth.
 591 BMOVE
 592         BSR GMVPRM
 593         SUBB 1+CELLSZ+ADRWDSZ,X ;
 594         SBCA CELLSZ+ADRWDSZ,X
 595         STAB 1+TEMP
 596         STAA TEMP
 597         BCS BMOVEDN
 598 BMOVEUP
 599 ****** Working in here to make it go both ways.
 600 ****** Also need to check multiply and divide.
 601
 602         LDX PSP
 603         LDX CELLSZ+ADRWDSZ,X
 604         STX IXSRC
 605 *
 606         SUBB
 607
 608
 609         LDAB 1+GCOUNT   ; Get low byte for partial block
 610         CLR 1+GCOUNT    ; To avoid debugging confusion.
 611 BMOVEL  BSR SMOVE       ; partial block and full blocks
 612         DEC GCOUNT      ; count high byte down (blocks)
 613         BPL BMOVEL ; This limits the count.
 614 * Rob point to deallocate 3 on stack, as long as CELLSZ == ADRWDSZ.
 615 DEALL3
 616         LDAB 1+PSP      ; 2# 3~
 617         ADDB #(CELLSZ+2*ADRWDSZ)        ; 2# 3~
 618         STAB 1+PSP      ; 2# 4~
 619         BCC BMOVEX      ; 2# 4~
 620         INC PSP ; 3# 6~ Unaries have no direct page version. => 11# 20~
 621 BMOVEX  RTS
 622 * DEALL3
 623 *       LDAB 1+PSP      ; 2# 3~
 624 *       ADDB #(CELLSZ+2*ADRWDSZ)        ; 2# 3~
 625 *       STAB 1+PSP      ; 2# 4~
 626 *       LDAA PSP        ; 2# 3~
 627 *       ADCA #(CELLSZ+2*ADRWDSZ)        ; 2# 3~
 628 *       STAA PSP        ; 2# 4~ => 12# 20~
 629 *       RTS
 630 * DEALL3
 631 *       LDX PSP ; 6 INXs is around the breakover point in the 6800.
 632 *       INX     ; 2 + 6 + 2 bytes => 11#
 633 *       INX     ; 4 + 24 + 5 cycles => 33~
 634 *       INX
 635 *       INX
 636 *       INX
 637 *       INX
 638 *       STX PSP
 639 *       RTS
 640 *
 641
 642
 643 * _WORD_ Execute the address on the stack:
 644 EXEC
 645         LDX PSP
 646         INX
 647         INX
 648         STX PSP
 649         LDX 0,X
 650         JSR 0,X ; For debugging and flattening, no early optimizations.
 651         RTS
 652
 653
 654
 655 COLDENT EQU *
 656 WARMENT EQU *
 657         LDS #RSTKINI
 658         LDX #SSTKINI
 659         STX PSP
 660         LDX #LSTKINI
 661         STX LSP
 662         LDX #UPGINI
 663         STX UP
 664
 665
 666