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 * ------------------------------------LICENSE-------------------------------------
  10 *
  11 * Copyright (c) 2009, 2010, 2011 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
  40 KERNLIB SECTION.S 0
  41
  42
  43 BYTESZ  EQU 8   ; bit count in byte
  44
  45 * I may want to explore non-linear addressing in the 68000
  46 * (and apply it to the 6805) once the basic interpreter is done
  47 * in the natural 32-bit CELL.
  48
  49 ADRWDSZ EQU 4   ; bytes per address word
  50 ADRWREM EQU (ADRWDSZ-1) ; for masking in address-odd remainder bits
  51 ADRWMSK EQU ((-ADRWREM)-1)      ; for masking out odd parts of addresses (manual bit invert)
  52
  53 HALFSZ  EQU 2
  54 HALFBSZ EQU (HALFSZ*2)          ; bit count in half-CELL
  55 * If at all possible, a CELL should be able to contain an address.
  56 * Otherwise, fetch and store become oddities.
  57 CELLSZ  EQU ADRWDSZ
  58 CELLBSZ EQU (ADRWDSZ*BYTESZ)    ; bit count in CELL
  59 DBLSZ   EQU (ADRWDSZ*2)
  60 DBLBSZ  EQU (DBLSZ*BYTESZ)      ; bit count in DOUBLE
  61
  62 GAPCT   EQU 2   ; address words for the gaps
  63 ALLOGAP EQU (GAPCT*ADRWDSZ)     ; For crude checks, gaps always zero.
  64
  65
  66 * Declare initial Return Stack (flow-of-control stack):
  67 RSTKBND EQU ($8000-ADRWDSZ      ; Bound: one beyond, but avoiding wraparound
  68 RSTKINI EQU (RSTKBND)   ; Init: next available byte on 68000 -- pre-dec
  69 RSTKSZ  EQU (62*ADRWDSZ)        ; Size: Safe for most purposes.
  70 RSTKLIM EQU (RSTKBND-RSTKSZ)    ; Limit: Last useable
  71 * Kibitzing -- CPUs really should have automatic stack bounds checking.
  72 * Don't forget gaps for CPUs that don't automatically check.
  73 * Crude guard rails is better than none?
  74
  75 * Declare initial Parameter Stack (data stack):
  76 SSTKBND EQU (RSTKLIM-ALLOGAP)
  77 SSTKINI EQU (SSTKBND)   ; Also pre-dec, but on address word boundary.
  78 SSTKSZ  EQU (126*ADRWDSZ)       ; Size: CELL addressing, small stacks.
  79 SSTKLIM EQU (SSTKBND-SSTKSZ)
  80
  81 * The paramater stack and heap at opposite ends of the same region
  82 * has mixed benefits.
  83
  84 * The initial per-user allocation heap:
  85 UPGBND  EQU (SSTKLIM-ALLOGAP)
  86 UPGSZ   EQU 64*ADRWDSZ  ; This will need adjusting in many cases.
  87 UPGBASE EQU (UPGBND-UPGSZ)
  88 UPGINI  EQU UPGBASE
  89
  90
  91 * ORG directives in older assemblers can get tangled up
  92 * if they are convoluted. Keep the ORGs in assending order.
  93
  94
  95 * Check DP handling!
  96         ORG.S $40
  97
  98 * Internal registers --
  99 * (When switching contexts, these must be saved and restored.):
 100
 101 * RP    RMB ADRWDSZ
 102 *                       A7/SP == RP, the return/flow-of-control stack on 68000
 103 *
 104 * PSP   RMB ADRWDSZ
 105 *                       A6 == PSP, the parameter/data stack pointer on 68000
 106 * UP    RMB ADRWDSZ
 107 *                       A5 == UP, the pointer to the per-task heap on 68000
 108 * LP    RMB ADRWDSZ
 109 *                       A4 == LSP, optional local stack pointer on 68000
 110 * TEMP  RMB 2*ADRWDSZ
 111 *                       all temps not in registers are allocated locally
 112 *                       -- on RP/A7, PSP/A6, UP/A5, or possibly LSP/A4
 113 * GCOUNT        RMB ADRWDSZ
 114 *                       general counter allocated in any free Dn
 115 * IXDEST        RMB ADRWDSZ
 116 *                       destination index pointer as any free An (A0 .. A3)
 117 * IXSRC RMB ADRWDSZ
 118 *                       source index pointer as any free An (A0 .. A3)
 119
 120
 121 ***    D0 to D3, A0, and A1 are throwaway or return values
 122 * and should be saved by the caller before calls when necessary;
 123 * maybe be used freely in called routines.
 124
 125 ***    D4 to D7, A2, A3, and maybe A4 are persistent or parameters
 126 * and should be saved before being used in called routines.
 127
 128
 129         ORG.S $100
 130         NOP
 131 COLD    JMP.S COLDENT
 132         NOP
 133 WARM    JMP.S WARMENT
 134
 135
 136 ****** Working in here to make it go both ways.
 137 ****** Also need to check multiply and divide.
 138 ****** And need to convert the stuff past multiply and divide to 68000
 139
 140
 141 * Entry point below.
 142 * SMOVEL
 143 *       MOVE.B (A2)+,(A3)+
 144 *
 145 * not_LOWORD_ Move 2^16-1 bytes or less:
 146 * source in A2, destination in A3, count in D4:
 147 * Overlaps only work if source is higher than dest.
 148 * SMOVE
 149 *       DBF D4,SMOVEL
 150 *       RTS
 151
 152 * _WORD_ Move up to 32K (2^15) bytes ( src dest count --- ):
 153 * Copies zero when count > 2^15. (Limited for safety.)
 154 * Compare CMOVE in Forth.
 155 BMOVE
 156         MOVE.L (2*ADRWDSZ,A6),A2        ; src
 157         MOVE.L (ADRWDSZ,A6),A3 ; dest
 158         MOVE.L (A6),D4
 159         CMP.L #$8000    ; Pre-test, do nothing if too big,
 160         BLS.B BMOVEE    ; or if zero.
 161         BRA.B BMOVEX
 162 BMOVEL
 163         MOVE.B (A2)+,(A3)+
 164 BMOVEE
 165         DBF D4,SMOVEL   ; Catches zero count here and stops.
 166 BMOVEX  LEAU (3*ADRWDSZ,A6),A6
 167         RTS
 168
 169 * _WORD_ Take logical AND of top two on stack ( n1 n2 --- n3 ):
 170 AND
 171         MOVE.L (ADRWDSZ,A6),D3
 172         AND.L (A6)+,D3
 173         MOVE.l D0,(A6)
 174         RTS
 175
 176 * _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
 177 OR
 178         MOVE.L (ADRWDSZ,A6),D3
 179         OR.L (A6)+,D3
 180         MOVE.l D0,(A6)
 181         RTS
 182
 183 * _WORD_ Take logical OR of top two on stack ( n1 n2 --- n3 ):
 184 XOR
 185         MOVE.L (ADRWDSZ,A6),D3
 186         EOR.L (A6)+,D3
 187         MOVE.l D0,(A6)
 188         RTS
 189
 190 * _WORD_ Add top two cells on stack ( n1 n2 --- sum ):
 191 ADD
 192         MOVE.L (ADRWDSZ,A6),D3
 193         ADD.L (A6)+,D3
 194         MOVE.l D0,(A6)
 195         RTS
 196
 197 * _WORD_ Subtract top cell on stack from second ( n1 n2 --- difference(n1-n2) ):
 198 SUB
 199         MOVE.L (ADRWDSZ,A6),D3
 200         SUB.L (A6)+,D3
 201         MOVE.l D0,(A6)
 202         RTS
 203
 204 * _WORD_ Fetch byte only pointed to by top cell on stack ( adr --- b(at adr) ):
 205 * (Refer to Forth's C@, but byte is not character!)
 206 BFETCH
 207         MOVE.L (A6).A1
 208         CLR.L D3
 209         MOVE.B (A1),D3
 210         MOVE.L D3,(A6)
 211         RTS
 212
 213 * _WORD_ Store low byte of cell at 2nd at address on top of stack, deallocate both ( b adr --- ):
 214 * (Refer to Forth's C!, but byte is not character!)
 215 BSTORE
 216         MOVE.L (A6)+,A1
 217         MOVE.L (A6)+,D3 ; Get whole cell instead of pre-clearing.
 218         MOVE.B D3,(A1)  ; Store only byte, do not clear low bytes!
 219         RTS
 220
 221 * _WORD_ Fetch half-cell only pointed to by top cell on stack ( adr --- h(at adr) ):
 222 * adr must be even address aligned on many 68K.
 223 SFETCH
 224         MOVE.L (A6).A1
 225         CLR.L D3
 226         MOVE.W (A1),D3
 227         MOVE.L D3,(A6)
 228         RTS
 229
 230 * _WORD_ Store half-cell at 2nd at address on top of stack, deallocate both ( h adr --- ):
 231 * adr must be even address aligned on many 68K.
 232 SSTORE
 233         MOVE.L (A6)+,A1
 234         MOVE.L (A6)+,D3 ; Get whole cell from stack instead of pre-clearing.
 235         MOVE.W D3,(A1)  ; Store only half-cell, do not clear low half!
 236         RTS
 237
 238 * _WORD_ Fetch cell pointed to by top cell on stack ( adr --- n(at adr) ):
 239 * adr must be even address aligned on many 68K.
 240 FETCH
 241         MOVE.L (A6).A1
 242         MOVE.L (A1),D3
 243         MOVE.L D3,(A6)
 244         RTS
 245
 246 * _WORD_ Store cell at 2nd at address on top of stack, deallocate both ( n adr --- ):
 247 * adr must be even address aligned on many 68K.
 248 STORE
 249         MOVE.L (A6)+,A1
 250         MOVE.L (A6)+,D3
 251         MOVE.L D3,(A1)  ; Store only byte, do not clear high byte!
 252         RTS
 253
 254 * u1  h1:l1 ADRWDSZ:HALFSZ+ADRWDSZ
 255 * u2  h2:l2               0:HALFSZ
 256 *
 257 * _WORD_ Unsigned multiply of top two on stack ( u1 u2 --- udproduct(n1*n2) ):
 258 USTARB
 259         MOVEQ #CELLBSZ,D0       ; bits/cell
 260         MOVEQ #0,D2     ; Clears carry, not extend
 261         MOVE.L (ADRWDSZ,A6),D3  ; multiplicand
 262         MOVE.L (A6),D1  ; multiplier
 263 USTARL
 264         ROXR.L D3
 265         DBF D0,USTART   ; done? hits both carry and extend!
 266         BRA.B USTARX
 267 USTART
 268         BCC.B USTARNA
 269         ADD.L (ADRWDSZ,A6),D2
 270 USTARNA RORX.L D2       ; shift result in
 271         BRA USTARL
 272 USTARX  MOVEM.L D2/D3,(A6)      ; Store result.
 273         RTS
 274
 275 * u1  h1:l1 ADRWDSZ:HALFSZ+ADRWDSZ
 276 * u2  h2:l2               0:HALFSZ
 277 *
 278 * _WORD_ Unsigned multiply of top two on stack ( u1 u2 --- udproduct(n1*n2) )
 279 * Using 6809's MUL for speed -- more code less time:
 280 USTAR
 281         MOVEQ #0 D1     ; Scratch area for inner products
 282         MOVEQ #0 D0
 283 *
 284         MOVE.W (HALFSZ+ADRWDSZ,A6),D3   ; low halves
 285         MULU (HALFSZ,A6),D3
 286 * max: $FFFE0001
 287 *
 288         MOVE.W (ADRWDSZ,A6),D2  ; inner1: u1 high
 289         MULU (HALFSZ,A6),D2     ; u2 low
 290 * max: $FFFE0001
 291 *
 292         MOVE.W D2,D1    ; lower half of inner1
 293         ADD.L D1,D3     ; No carry possible yet.
 294 * bound: $FFFE0001+$0000FFFF=$FFFF0000
 295 *
 296         SWAP D2
 297         MOVE.W D2,D1    ; higher half of inner1, hold it.
 298 *
 299         MOVE.W (HALFSZ+ADRWDSZ,A6),D2   ; inner2: u1 low
 300         MULU (A6),D2    ; u2 high
 301 * max: $FFFE0001
 302 *
 303         MOVE.W D2,D0    ; lower half of inner2
 304         ADD.L D0,D3     ; Still no carry possible.
 305 * bound: $FFFF0000+$0000FFFF=$FFFFFFFF
 306         SWAP D2
 307         MOVE.W D2,D0    ; higher half of inner2
 308         ADD.L D0,D1     ; add to inner1 higher half
 309 * bound: $0000FFFF+$0000FFFF=$0001FFFE
 310         MOVE.W (ADRWDSZ,A6),D2  ; high halves
 311         MULU (A6),D2
 312 * max $FFFE0001
 313         ADD.L D1,D2
 314 * bound: $FFFE0001+$0001FFFE=$FFFFFFFF
 315 * Done, result in D2:D3
 316         MOVEM.L D2/D3,(A6)
 317         RTS
 318
 319 * _WORD_ swap top two cells on stack ( n1 n2 --- n2 n1 ):
 320 SWAP
 321         MOVEM.L (A6),D2/D3
 322         EXG D2,D3
 323         MOVEM.L D2/D3,(A6)
 324         RTS
 325 * As opposed to
 326 *       MOVE.L D2,(ADRWDSZ,A6)
 327 *       MOVE.L D3,(A6)
 328 * Which will be smaller, faster, less bus activity?
 329
 330
 331 * _WORD_ Unsigned divide of unsigned double dividend in 2nd:3rd on stack by top unsigned divisor
 332 * ( ud u --- uremainder uquotient )
 333 * Dividend should be range of product of 16 by 16 bit unsigned multiply,
 334 * divisor should be the multiplier or multiplicand:
 335 USLASH
 336         LDA #1+CELLBSZ bit ct
 337         PSHS A
 338         LDD ADRWDSZ,U dividend
 339 USLDIV  CMPD ,U divisor
 340         BHS USLSUB
 341         ANDCC #^1
 342         BRA USLBIT
 343 USLSUB  SUBD ,U
 344         ORCC #1 quotient,
 345 USLBIT  ROL 1+2*ADRWDSZ,U save it
 346         ROL 2*ADRWDSZ,U
 347         DEC ,S more bits?
 348         BEQ USLR
 349         ROLB remainder
 350         ROLA
 351         BCC USLDIV
 352         BRA USLSUB
 353 USLR    LEAS 1,S
 354         LEAU ADRWDSZ,U
 355         LDX ADRWDSZ,U
 356         STD ADRWDSZ,U
 357         STX ,U
 358         RTS
 359
 360 **** gotta look at ,S references, work around the PC!
 361
 362 * _WORD_ Save top cell on stack to return stack ( n --- ) { --- n }:
 363 TOR
 364         LDX ,S
 365         PULU D
 366         STD ,S
 367         JMP ,X
 368
 369 * _WORD_ Pop top of return stack to parameter stack ( --- n ) { n --- }:
 370 RFROM
 371         PULS D,X
 372         PSHU X
 373         TFR D,X
 374
 375 * _WORD_ Retrieve, do not pop top of return stack to parameter stack ( --- n ) { n --- n }:
 376 R
 377         LDD ADRWDSZ,S
 378         PSHU D
 379         RTS
 380
 381 * Should true be set as 1 or -1?
 382 * _WORD_ Test top cell on stack for zero ( n --- f(top==0) ):
 383         LDX PSP
 384
 385         CLR A
 386         CLR B
 387         LDX     0,X
 388         BNE     ZEQU2
 389         INC B
 390 ZEQU2   TSX
 391 *       JMP     STABX
 392
 393
 394
 395 * _LOWORD_ Duplicate (count in B) bytes on stack:
 396 NDUP
 397         LDX PSP
 398         STX TEMP
 399
 400
 401
 402 * _WORD_ Execute the address on the stack:
 403 EXEC
 404         LDX PSP
 405         INX
 406         INX
 407         STX PSP
 408         LDX 0,X
 409         JSR 0,X ; For debugging and flattening, no early optimizations.
 410         RTS
 411
 412
 413
 414 COLDENT EQU *
 415         LDS #RSTKINI
 416         LDX #SSTKINI
 417         STX PSP
 418 WARMENT EQU *
 419         LDS #RSTKINI
 420         LDX #SSTKINI
 421         STX PSP
 422         LDX #UPGINI
 423         STX UP
 424
 425
 426