runt8080DE.asm

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