runt8080DE.asm

   1         OPT PRT
   2
   3 ; runtimelib FOR 8080 using DE as the parameter stack pointer
   4 ; Joel Matthew Rees September 2020
   5
   6 ; Borrowing some concepts from fig-Forth.
   7 ; Not tested!
   8 ; In fact, I was never all that good with 8080 code,
   9 ; and it has been almost 40 years, so ...
  10 ;     don't expect it to work without fixing it.
  11 ; Patterned after 6800 libs.
  12
  13 ; ------------------------------------LICENSE-------------------------------------
  14 ;
  15 ; Copyright (c) 2020 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 ; Watch label width, 5 significant characters on original 8080
  44
  45 BYTESZ: EQU 8   ; bit count in byte
  46
  47 ADRWDSZ:        EQU 2   ; bytes per address word
  48
  49 ; If at all possible, a CELL should be able to contain an address.
  50 ; Otherwise, fetch and store become oddities.
  51 CELLSZ: EQU ADRWDSZ
  52 CELLBSZ:        EQU (CELLSZ*BYTESZ)     ; bit count in CELL
  53 DBLSZ:  EQU (CELLSZ*2)
  54 DBLBSZ: EQU (DBLSZ*BYTESZ)      ; bit count in DOUBLE
  55
  56 GAPCT:  EQU 2   ; address words for the gaps
  57 ALLOGAP:        EQU (GAPCT*CELLSZ)      ; For crude checks, gaps always zero.
  58
  59
  60 ; Declare initial Return Stack (flow-of-control stack):
  61 RSTKBND:        EQU 08000H      ; Bound: one beyond
  62 RSTKINI:        EQU (RSTKBND-1) ; Init: 8080? next available byte on 6800
  63 RSTKSZ: EQU (62*CELLSZ) ; Size: Safe for most purposes.
  64 RSTKLIM:        EQU (RSTKBND-RSTKSZ)    ; Limit: Last useable
  65 ; Kibitzing -- CPUs really should have automatic stack bounds checking.
  66 ; Don't forget gaps for CPUs that don't automatically check.
  67 ; Crude guard rails is better than none?
  68
  69 ; Declare initial Parameter Stack (data stack):
  70 SSTKBND:        EQU (RSTKLIM-ALLOGAP)
  71 SSTKINI:        EQU (SSTKBND-CELLSZ)    ; 8080? post-dec 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 (64*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 040H ; 8080?
  91
  92 ; Internal registers --
  93 ; (When switching contexts, these must be saved and restored.):
  94
  95 ; RP:   EQU SP  ; ??    ; the return/flow-of-control stack pointer is 8080 SP
  96 ; PSP:  EQU DE  ; the parameter/data stack pointer (Forth SP)
  97 ; Maybe we can put PSP in HL?
  98 UP:     DS ADRWDSZ      ; pointer to the per-task heap -- BC?
  99 ; TEMP: DS 2*CELLSZ     ; for general math
 100 ; GCOUNT:       DS CELLSZ       ; general counter
 101 ; IXDEST:       DS ADRWDSZ      ; destination index pointer
 102 ; IXSRC:        DS ADRWDSZ      ; source index pointer
 103 ; IXTERM:       DS ADRWDSZ      ; terminator for moves
 104
 105 ; ****
 106 ; Any
 107 ; Using DE for the parameter stack pointer means that
 108 ; interrupts must *not* use the interrupted routine's parameter stack.
 109 ;
 110 ; If we used DE as the stack pointer, it could remain constant while HL indexed the stack.
 111 ; But since we are indexing the stack with the stack pointer itself,
 112 ; the stack pointer will often be out of position to protect the active contents.
 113 ;
 114 ; We could gamble and guess that six bytes or sixteen would be enough to avoid active stack,
 115 ; but it will be better to just have the interrupt routines set their own parameter stacks.
 116 ;
 117 ; Note that using DE as the stack pointer would not mean we could use XCHG
 118 ; to save the current pointer and index the stack, for reasons evident from the above.
 119 ; ****
 120
 121
 122
 123         ORG 0100H ; 8080?
 124         NOP
 125 COLD:   JMP COLDENT
 126         NOP
 127 WARM:   JMP WARMENT
 128
 129
 130 ; _LOWORD_ Subtract byte in B from cell pointed to by X:
 131 ; Not really all that useful when you can CLRA and SUBCELL?
 132 ; SUBBYT
 133 ;       LDAA 1,X
 134 ;       SBA
 135 ;       STAA 1,X
 136 ;       BCC ADDBYTX
 137 ;       DEC 0,X
 138 ; SUBBYTX       RTS
 139
 140 ; _LOWORD_ Add byte in B to cell pointed to by X:
 141 ; Not really all that useful when you can CLRA and ADDCELL?
 142 ; ADDBYT
 143 ;       ADDB 1,X
 144 ;       STAB 1,X
 145 ;       BCC ADDBYTX
 146 ;       INC 0,X
 147 ; ADDBYTX       RTS
 148
 149
 150 ; GETAB MACRO
 151 ;       LDX PSP
 152 ;       LDAB 1,X
 153 ;       LDAA 0,X
 154 ;       INX
 155 ;       INX
 156 ;       STX PSP
 157 ;       ENDM
 158 ; Or doing as subroutine would would add 4 bytes and about ten cycles?
 159 ; How useful would it be?
 160
 161
 162 LOGOP:  MACRO   OP0     ; hides a lot of cycles and object code
 163         XCHG    ; DE with HL, make PSP accessible to OP0
 164         MOV A,M
 165         INX HL
 166         INX HL
 167         OP0 M   ; less significant byte on 8080
 168         MOV M,A
 169         DCX HL
 170         MOV A,M
 171         INX HL
 172         INX HL
 173         OP0 M   ; more significant byte on 8080
 174         DCX HL
 175         XCHG    ; Update PSP
 176         RET
 177         ENDM
 178
 179
 180 ; _WORD_ Take logical AND of top two on stack ( n1 n2 --- n3 ):
 181 AND:    LOGOP ANA
 182
 183 ; _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
 184 OR:     LOGOP ORA
 185
 186 ; _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
 187 XOR:    LOGOP XRA
 188
 189
 190 ; _WORD_ Add top two cells on stack ( n1 n2 --- sum ):
 191 ADD:    STC     ; clear carry (LSB first required!)
 192         CMC     ; So we don't have to rewrite all of LOGOP
 193         LOGOP ADC       ; to use ADD first and ADC second.
 194
 195 ; _WORD_ Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
 196 SUB:    STC     ; clear carry (See ADD.)
 197         CMC
 198         LOGOP SBB
 199
 200
 201 ; _WORD_ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
 202 ; (Refer to Forth's C@, but byte is not character!)
 203 ; BFETCH: LDAX DE
 204 ;       MOV C,A
 205 ;       INX DE
 206 ;       LDAX DE
 207 ;       MOV B,A
 208 ;       XRA A
 209 ;       STAX DE ; more significant byte
 210 ;       DCX DE
 211 ;       LDAX BC
 212 ;       STAX DE
 213 ;       RET
 214
 215 BFETCH: XCHG    ; Make PSP available.
 216         MOV C,M
 217         INX HL
 218         MOV B,M
 219         LDAX BC ; fetch it
 220         MVI C,0
 221         MOV M,C ; Clear high byte.
 222         DCX HL
 223         MOV M,A ; Store byte
 224         RET     ; PSP unchanged
 225
 226 ; _WORD_ Store low byte of cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
 227 ; (Refer to Forth's C!, but byte is not character!)
 228 BSTORE: XCHG
 229         MOV C,M ; address low byte
 230         INX HL
 231         MOV B,M ; address high byte
 232         INX HL
 233         MOV A,M ; ignore high byte.
 234         STAX BC
 235         INX HL
 236         INX HL
 237         XCHG
 238         RET
 239
 240 ; ASSERT CELLSZ == ADRWDSZ
 241 ; _WORD_ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
 242 FETCH:
 243
 244         LDX PSP
 245         LDX 0,X ; adr
 246         LDAA 0,X
 247         LDAB 1,X
 248         LDX PSP
 249         STAA 0,X
 250         STAB 1,X
 251         RTS
 252
 253 ; _WORD_ Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
 254 STORE:
 255         LDX PSP
 256         LDAA ADRWDSZ,X  ; n
 257         LDAB ADRWDSZ+1,X
 258         LDX 0,X         ; adr
 259         STAA 0,X
 260         STAB 1,X
 261 ; Rob point to deallocate 2 on stack.
 262 DEALL2:
 263         LDX PSP
 264         INX
 265         INX
 266         INX
 267         INX
 268         STX PSP
 269         RTS
 270
 271 ; _WORD_ Unsigned multiply of top two on stack ( n1 n2 --- uproduct(n1*n2) ):
 272 USTAR:
 273         LDX PSP
 274         LDAA #CELLBSZ   ; bits/cell
 275         STAA GCOUNT+1
 276         CLRA
 277         CLRB
 278 USTARL: ROR CELLSZ,X    ; shift multiplier
 279         ROR CELLSZ+1,X
 280         DEC GCOUNT+1    ; done?
 281         BMI USTARX
 282         BCC USTARNA
 283         ADDB CELLSZ+1,X
 284         ADCA CELLSZ,X
 285 USTARNA:        RORA
 286         RORB ; shift result in
 287         BRA USTARL
 288 USTARX: STAB 1,X        ; store more significant 16 bits
 289         STAA 0,X
 290         RTS
 291
 292 ; _WORD_ swap top two cells on stack ( n1 n2 --- n2 n1 ):
 293 SWAP:
 294         LDX PSP
 295 SWAPROB:
 296         LDAA 0,X
 297         LDAB CELLSZ,X
 298         STAB 0,X
 299         STAA CELLSZ,x
 300         LDAA 1,X
 301         LDAB CELLSZ+1,X
 302         STAB 1,X
 303         STAA CELLSZ+1,x
 304         RTS
 305
 306 ; _WORD_ Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
 307 ; ( ud u --- uremainder uquotient )
 308 ; Dividend should be range of product of 16 by 16 bit unsigned multiply,
 309 ; divisor should be the multiplier or multiplicand:
 310 USLASH:
 311         LDX PSP
 312         LDAA #CELLBSZ+1 ; one more than bits/cell
 313         STAA GCOUNT+1
 314         LDAA CELLSZ,X   ; dividend
 315         LDAB CELLSZ+1,X
 316 USLLUP: CMPA 0,X        ; divisor
 317         BHI USLSUB      ; Make sure carry from LSB would carry over
 318         BCS USLNSUB
 319         CMPB 1,X
 320         BCC USLSUB      ; CC = HS (High or Same)
 321 USLNSUB:        CLC     ; For shifting
 322         BRA USLNEXT
 323 USLSUB: SUBB 1,X
 324         SBCA 0,X
 325         SEC     ; For shifting
 326 USLNEXT:        ROL 1+2*CELLSZ,X
 327         ROL 2*CELLSZ,X
 328         DEC GCOUNT+1
 329         BEQ USLX
 330         ROLB
 331         ROLA
 332         BCC USLLUP
 333         BRA USLSUB      ; Catch the excess.
 334 USLX:   INX     ; Drop high cell.
 335         INX
 336         STX PSP
 337         STAA 0,X        ; High cell now empty, save remainder.
 338         STAB 1,X        ; But remainder is now top.
 339         BRA SWAPROB     ; PSP in X, reverse quotient & remainder.
 340 ; Steal return.
 341
 342
 343 ; _WORD_ Save top cell on stack to return stack ( n --- ) { --- n }:
 344 TOR:
 345         LDX PSP
 346         LDAA 0,X
 347         LDAB 1,X
 348         PSHB    ; Watch order!
 349         PSHA
 350         INX     ; Not worth robbing code.
 351         INX
 352         STX PSP
 353         RTS
 354
 355 ; _WORD_ Pop top of return stack to parameter stack ( --- n ) { n --- }:
 356 RFROM:
 357         PULA    ; Watch order
 358         PULB
 359         BRA ALLOSTO
 360
 361 ; _WORD_ Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }:
 362 R:
 363         TSX
 364         LDAA 0,X
 365         LDAB 1,X
 366 ALLOSTO:
 367         LDX PSP ; allocate
 368         DEX
 369         DEX
 370         STX PSP
 371         STAA 0,X
 372         STAB 1,X
 373         RTS
 374
 375 ; Should true be set as 1 or -1?
 376 ; _WORD_ Test top cell on stack for zero ( n --- f(top==0) ):
 377         LDX PSP
 378
 379         CLR A
 380         CLR B
 381         LDX     0,X
 382         BNE     ZEQU2
 383         INC B
 384 ZEQU2:  TSX
 385 ;       JMP     STABX
 386
 387
 388
 389 ; _LOWORD_ Duplicate (count in B) bytes on stack:
 390 NDUP:
 391         LDX PSP
 392         STX TEMP
 393
 394
 395
 396 ; _LOWORD_ Move 256 bytes or less going up:
 397 ; 0=256, do not enter without pretesting for 0 count!
 398 ; source in IXSRC, destination in IXDEST, count in B:
 399 ; Overlaps only work if source is higher than dest.
 400 SMOVEUP:
 401         BSR GMVPRM
 402 SMOVEUL:
 403         LDX IXSRC
 404         LDAA 0,X
 405         INX
 406         STX IXSRC
 407         LDX IXDEST
 408         STAA 0,X
 409         INX
 410         STX IXDEST
 411         DECB
 412         BNE SMOVEUL
 413         RTS
 414
 415 ; _LOWORD_ Move 256 bytes or less going down:
 416 ; 0=256, do not enter without pretesting for 0 count!
 417 ; source in IXSRC, destination in IXDEST, count in B, A is overwritten:
 418 ; Overlaps only work if source is higher than dest.
 419 SMOVEDN:
 420         BSR GMVPRM
 421 SMOVEDL:
 422         TBA
 423         ADDA IXSRC+1
 424         STAA IXSRC+1
 425         CLRA    ; 1# 2~ -- BCC takes 2#, 4~; INC IXSRC takes 3# & 6~
 426         ADCA IXSRC ; 2# 3~
 427         STAA IXSRC ; 2# 4~
 428         TBA
 429         ADDA IXDEST+1
 430         STAA IXDEST+1
 431         CLRA    ; 1# 2~ -- BCC takes 2#, 4~; INC IXDEST takes 3# & 6~
 432         ADCA IXDEST ; 2# 3~
 433         STAA IXDEST ; 2# 4~
 434 SMOVEDL:
 435         LDX IXSRC
 436         DEX
 437         LDAA 0,X
 438         STX IXSRC
 439         LDX IXDEST
 440         DEX
 441         STAA 0,X
 442         STX IXDEST
 443         DECB
 444         BNE SMOVEDL
 445         RTS
 446
 447 ; _LOWORD_ Set up parameters for MOVE  ( src dest count --- )
 448 ; Return without copying if count is zero or if 2^15 or more.
 449 ; Make sure destination is left in A:B for math.
 450 GMVPRM:
 451         LDX PSP ; get paramaters for move
 452         LDX 0,X ; count
 453         BEQ GMVPRX      ; bail now if zero
 454         BMI GMVPRX      ; also if greater than 32K
 455         STX GCOUNT
 456         LDX PSP
 457         LDAA CELLSZ,X   ; preparing for math
 458         LDAB CELLSZ+1,X
 459         STAA IXDEST
 460         STAB IXDEST+1
 461         LDX CELLSZ+ADRWDSZ,X
 462         STX IXDEST
 463         RTS     ; Back to MOVE that called us.
 464 ;
 465 GMVPRX:
 466         INS     ; Drop return to MOVE code.
 467         INS
 468         BRA DEALL3
 469
 470 ; _WORD_ Move up to 32K bytes ( src dest count --- ):
 471 ; Copies zero when count >= 2^15
 472 ; Compare CMOVE in Forth.
 473 BMOVE:
 474         BSR GMVPRM
 475         SUBB CELLSZ+ADRWDSZ+1,X ;
 476         SBCA CELLSZ+ADRWDSZ,X
 477         STAB TEMP+1
 478         STAA TEMP
 479         BCS BMOVEDN
 480 BMOVEUP:
 481 ;***** Working in here to make it go both ways.
 482 ;***** Also need to check multiply and divide.
 483
 484         LDX PSP
 485         LDX CELLSZ+ADRWDSZ,X
 486         STX IXSRC
 487 ;
 488         SUBB
 489
 490
 491         LDAB GCOUNT+1   ; Get low byte for partial block
 492         CLR GCOUNT+1    ; To avoid debugging confusion.
 493 BMOVEL: BSR SMOVE       ; partial block and full blocks
 494         DEC GCOUNT      ; count high byte down (blocks)
 495         BPL BMOVEL ; This limits the count.
 496 ; Rob point to deallocate 3 on stack, as long as CELLSZ == ADRWDSZ.
 497 DEALL3:
 498         LDAB PSP+1      ; 2# 3~
 499         ADDB #(CELLSZ+2*ADRWDSZ)        ; 2# 3~
 500         STAB PSP+1      ; 2# 4~
 501         BCC BMOVEX      ; 2# 4~
 502         INC PSP ; 3# 6~ Unaries have no direct page version. => 11# 20~
 503 BMOVEX: RTS
 504 ; DEALL3
 505 ;       LDAB PSP+1      ; 2# 3~
 506 ;       ADDB #(CELLSZ+2*ADRWDSZ)        ; 2# 3~
 507 ;       STAB PSP+1      ; 2# 4~
 508 ;       LDAA PSP        ; 2# 3~
 509 ;       ADCA #(CELLSZ+2*ADRWDSZ)        ; 2# 3~
 510 ;       STAA PSP        ; 2# 4~ => 12# 20~
 511 ;       RTS
 512 ; DEALL3
 513 ;       LDX PSP ; 6 INXs is around the breakover point in the 6800.
 514 ;       INX     ; 2 + 6 + 2 bytes => 11#
 515 ;       INX     ; 4 + 24 + 5 cycles => 33~
 516 ;       INX
 517 ;       INX
 518 ;       INX
 519 ;       INX
 520 ;       STX PSP
 521 ;       RTS
 522 ;
 523
 524
 525 ; _WORD_ Execute the address on the stack:
 526 EXEC:
 527         LDX PSP
 528         INX
 529         INX
 530         STX PSP
 531         LDX 0,X
 532         JSR 0,X ; For debugging and flattening, no early optimizations.
 533         RTS
 534
 535
 536
 537 COLDENT:        EQU *
 538         LDS #RSTKINI
 539         LDX #SSTKINI
 540         STX PSP
 541 WARMENT:        EQU *
 542         LDS #RSTKINI
 543         LDX #SSTKINI
 544         STX PSP
 545         LDX #UPGINI
 546         STX UP
 547
 548
 549