kernel/core.asm

   1 ; core of Fifth\r
   2 \r
   3 include  'define.inc'\r
   4 \r
   5 link = 0\r
   6 org 0\r
   7 \r
   8 lpad:   xnum    1       ; load rest of core into RAM\r
   9         xnum    1024\r
  10         xnum    3\r
  11         xcall   lload\r
  12         xnum    4       ; load highlevel Fifth boot code into RAM \r
  13         xnum    1500000\r
  14         xnum    32\r
  15         xcall   lload\r
  16         xnum    -1      ; initialize dictionary space\r
  17         xnum    lend\r
  18         xnum    30000\r
  19         xcfill\r
  20         xjmp    lmain\r
  21         times 15 db '*PAD*'\r
  22 \r
  23 lload:                  ;( fromdisk tomem amount -- )\r
  24 l46:    xdup\r
  25         xif     l45\r
  26         xdec\r
  27         xpush\r
  28         xover\r
  29         xover\r
  30         xdisk@\r
  31         xnum    1024\r
  32         xplus\r
  33         xswap\r
  34         xinc\r
  35         xswap\r
  36         xpop\r
  37         xjmp    l46\r
  38 l45:    xdrop\r
  39         xdrop\r
  40         xdrop\r
  41         xret\r
  42 \r
  43 ibuf:   dd 0, 0, 0, 0,  0, 0, 0, 0\r
  44 lh:     dd last+24000\r
  45 llp:    dd lastp\r
  46 \r
  47 lcount: xinc\r
  48         xdup\r
  49         xdec\r
  50         xc@\r
  51         xret\r
  52 \r
  53 vloc    dd 200000h\r
  54 llemit: ; xemit\r
  55         xnum    vloc\r
  56         x@\r
  57         xdup\r
  58         xinc\r
  59         xnum    vloc\r
  60         x!\r
  61         xc!\r
  62         xret\r
  63 \r
  64 lhere:  xnum    lh\r
  65         x@\r
  66         xret\r
  67 \r
  68 lemit:  xjmp    llemit\r
  69 \r
  70 ltype:  xdup\r
  71         xif l2\r
  72         xdec\r
  73         xpush\r
  74         xcall   lcount\r
  75         xcall   lemit\r
  76         xpop\r
  77         xjmp    ltype\r
  78 l2:     xdrop\r
  79         xdrop\r
  80         xret\r
  81 \r
  82 lwrite: xcall lcount\r
  83         xcall ltype\r
  84         xret\r
  85 \r
  86 lsadd: xdup\r
  87         xc@\r
  88         xinc\r
  89         xover\r
  90         xover\r
  91         xswap\r
  92         xc!\r
  93         xplus\r
  94         xc!\r
  95         xret\r
  96 \r
  97 llfkey: xnum    d1\r
  98         x@\r
  99         xcall   lcount\r
 100         xswap\r
 101         xnum    d1\r
 102         x!\r
 103         xret\r
 104 d1      dd 1500000\r
 105 \r
 106 lfkey:  xjmp    llfkey\r
 107 \r
 108 lskey:  xcall   lfkey\r
 109         xdup\r
 110         xnum    254\r
 111         xminus\r
 112         xif     l47\r
 113         xdup\r
 114         xnum    253\r
 115         xminus\r
 116         xif     l47\r
 117         xret\r
 118 l47:    xdrop\r
 119         xnum    255\r
 120         xret\r
 121 \r
 122 lscan:  xnum    0\r
 123         xnum    lpad\r
 124         xc!\r
 125 l4:     xcall   lskey\r
 126         xover\r
 127         xover\r
 128         xminus\r
 129         xif     l3\r
 130         xnum    lpad\r
 131         xcall   lsadd\r
 132         xjmp    l4\r
 133 l3:     xdrop\r
 134         xnum    lpad\r
 135         xc@\r
 136         xif     lscan\r
 137         xdrop\r
 138         xret\r
 139 \r
 140 lstrEQstr: xdup\r
 141         xc@\r
 142         xinc\r
 143 l8:     xdup\r
 144         xif     l6\r
 145         xdec\r
 146         xpush\r
 147         xover\r
 148         xc@\r
 149         xover\r
 150         xc@\r
 151         xminus\r
 152         xif     l7\r
 153         xpop\r
 154         xdrop\r
 155         xdrop\r
 156         xdrop\r
 157         xnum    0\r
 158         xret\r
 159 l7:     xinc\r
 160         xswap\r
 161         xinc\r
 162         xpop\r
 163         xjmp    l8\r
 164 l6:     xdrop\r
 165         xdrop\r
 166         xdrop\r
 167         xnum    -1\r
 168         xret\r
 169 \r
 170 lstrEQpad:\r
 171         xnum    lpad\r
 172         xjmp    lstrEQstr\r
 173 \r
 174 lfind:  xnum    llp\r
 175 l9:     xdup\r
 176         xnum    lprev\r
 177         x!\r
 178         x@\r
 179         xdup\r
 180         xif     l11\r
 181         xdup\r
 182         xinc\r
 183         xinc\r
 184         xinc\r
 185         xinc\r
 186         xcall   lstrEQpad\r
 187         xif     l9\r
 188 l11:    xret\r
 189 \r
 190 lprev:  dd 0\r
 191 lmode:  db 1    ; 0 compile\r
 192                 ; 1 interpret\r
 193 \r
 194 lgoto:  xnum    l44+1\r
 195         x!\r
 196 l44:    xjmp    0\r
 197 \r
 198 lexecute:\r
 199         xnum    lmode\r
 200         xc@\r
 201         xif     l19\r
 202         xcall   setint\r
 203 l19:    xcall   lfind\r
 204         xdup\r
 205         xif     l12     ; not found ?\r
 206         xnum    19\r
 207         xplus\r
 208         xdup\r
 209         xc@     ; ( addr+19 c )\r
 210         xdup\r
 211         xif     cmpnum\r
 212         xdec\r
 213         xdup\r
 214         xif     cmpmod\r
 215         xdec\r
 216         xif     cmpimm\r
 217         xdrop\r
 218         xjmp    clrint\r
 219 setint: xnum    l14\r
 220         x@\r
 221         xif     l15\r
 222         xret\r
 223 l14     dd 0\r
 224 l15:    xnum    lh\r
 225         x@\r
 226         xnum    l14\r
 227         x!\r
 228         xnum    ibuf\r
 229         xnum    lh\r
 230         x!\r
 231         xret\r
 232 clrint: xnum    l14\r
 233         x@\r
 234         xif     l20\r
 235         xnum    11\r
 236         xcall   lcsto\r
 237         xnum    l14\r
 238         x@\r
 239         xnum    lh\r
 240         x!\r
 241         xnum    0\r
 242         xnum    l14\r
 243         x!\r
 244         xjmp    ibuf\r
 245 l20:    xret\r
 246 cmpnum: xdrop\r
 247         xnum    3\r
 248         xjmp    cmpn\r
 249 cmpmod: xdrop\r
 250         xnum    5\r
 251         xjmp    cmpn\r
 252 cmpimm: xcall   setint\r
 253         xnum    5\r
 254         xjmp    cmpn\r
 255 cmpn:   xcall   lcsto\r
 256         xinc\r
 257         x@\r
 258         xcall   lsto\r
 259         xjmp    clrint\r
 260 l12:    xdrop\r
 261         xcall   l2num\r
 262         xif     l23\r
 263         xnum    3\r
 264         xcall   lcsto\r
 265         xcall   lsto\r
 266         xjmp    clrint\r
 267 l23:    xdrop\r
 268         xnum    lpad\r
 269         xcall   lwrite\r
 270         xnum    msg1\r
 271         xcall   lwrite\r
 272         xjmp    clrint\r
 273 msg1    db 3, ' ? '\r
 274 \r
 275 l2num:  xnum    lpad\r
 276         xcall   lcount  ; ( addr len )\r
 277         xnum    numlen\r
 278         xc!\r
 279         xnum    0\r
 280 l13:    xnum    numlen  ; ( addr num )\r
 281         xc@\r
 282         xdup\r
 283         xif     numend\r
 284         xdec\r
 285         xnum    numlen\r
 286         xc!\r
 287         xnum    16\r
 288         xmul\r
 289         xswap\r
 290         xcall   lcount  ; ( num addr c )\r
 291 \r
 292         xdup\r
 293         xnum    45\r
 294         xminus\r
 295         xif     l22\r
 296 l28:    xdup\r
 297         xnum    16\r
 298         xcmpg\r
 299         xif     l21\r
 300         xdrop\r
 301         xdrop\r
 302         xnum    0\r
 303         xret\r
 304 l21:    xrot\r
 305         xplus           ; ( addr num )\r
 306         xjmp    l13\r
 307 numend: xdrop\r
 308         xswap\r
 309         xdrop\r
 310         xnum    numneg\r
 311         xc@\r
 312         xif     l16\r
 313         xnum    -1\r
 314         xmul\r
 315         xnum    0\r
 316         xnum    numneg\r
 317         xc!\r
 318 l16:    xnum    -1\r
 319         xret\r
 320 numlen  db 0\r
 321 numneg  db 0\r
 322 \r
 323 l22:    xnum    numneg\r
 324         xc!\r
 325         xnum    0\r
 326         xjmp    l28\r
 327 \r
 328 lcsto:  xnum    lh\r
 329         x@\r
 330         xover\r
 331         xover   ; ( n addr n addr )\r
 332         xc!\r
 333         xinc\r
 334         xnum    lh\r
 335         x!\r
 336         xdrop\r
 337         xret\r
 338 \r
 339 lsto:   xnum    lh\r
 340         x@\r
 341         xover\r
 342         xover\r
 343         x!\r
 344         xnum    4\r
 345         xplus\r
 346         xnum    lh\r
 347         x!\r
 348         xdrop\r
 349         xret\r
 350 \r
 351 lhalt:  xhalt\r
 352 \r
 353 l@:     xnum    20\r
 354         xjmp    bcode\r
 355 \r
 356 l!:     xnum    21\r
 357         xjmp    bcode\r
 358 \r
 359 lc@:    xnum    12\r
 360         xjmp    bcode\r
 361 \r
 362 lc!:    xnum    13\r
 363         xjmp    bcode\r
 364 \r
 365 linc:   xnum    6\r
 366         xjmp    bcode\r
 367 \r
 368 ldec:   xnum    7\r
 369         xjmp    bcode\r
 370 \r
 371 lcmpg:  xnum    28\r
 372         xjmp    bcode\r
 373 \r
 374 lcmpl:  xnum    29\r
 375         xjmp    bcode\r
 376 \r
 377 lret:   xnum    11\r
 378         xjmp    bcode\r
 379 \r
 380 lplus:  xnum    24\r
 381         xjmp    bcode\r
 382 \r
 383 lminus: xnum    25\r
 384         xjmp    bcode\r
 385 \r
 386 lmul:   xnum    26\r
 387         xjmp    bcode\r
 388 \r
 389 ldrop:  xnum    9\r
 390         xjmp    bcode\r
 391 \r
 392 ldup:   xnum    8\r
 393         xjmp    bcode\r
 394 \r
 395 lswap:  xnum    23\r
 396         xjmp    bcode\r
 397 \r
 398 ldisk@: xnum    18\r
 399         xjmp    bcode\r
 400 \r
 401 lpush:  xnum    14\r
 402         xjmp    bcode\r
 403 \r
 404 lpop:   xnum    15\r
 405         xjmp    bcode\r
 406 \r
 407 lover:  xnum    22\r
 408         xjmp    bcode\r
 409 \r
 410 lcmove: xnum    43\r
 411         xjmp    bcode\r
 412 \r
 413 bcode:  xnum    lmode\r
 414         xc@\r
 415         xif     lcsto\r
 416         xnum    l25\r
 417         xc!\r
 418 l25:    db 0\r
 419         xret\r
 420 \r
 421 lne:    xcall   lfind\r
 422         xif     lne3\r
 423         xnum    lpad\r
 424         xcall   lwrite\r
 425         xnum    msg2\r
 426         xcall   lwrite\r
 427 lne3:   xnum    sf      ; pick next address\r
 428         x@\r
 429         xdup\r
 430         xnum    24\r
 431         xplus\r
 432         xdup\r
 433         xnum    last+23999\r
 434         xcmpg\r
 435         xif     lne1\r
 436         xdrop\r
 437         xnum    last\r
 438 lne1:   xnum    sf\r
 439         x!\r
 440         xdup            ; is cell empty\r
 441         x@\r
 442         xinc\r
 443         xif     lne2\r
 444         xdrop\r
 445         xjmp    lne3\r
 446 lne2:   xnum    llp     ; create entry\r
 447         x@\r
 448         xover\r
 449         x!\r
 450         xdup\r
 451         xnum    llp\r
 452         x!\r
 453         xnum    lpad\r
 454         xover\r
 455         xinc\r
 456         xinc\r
 457         xinc\r
 458         xinc\r
 459         xnum    15\r
 460         xcmove\r
 461         xnum    19\r
 462         xplus\r
 463         xdup\r
 464         xinc\r
 465         xpush\r
 466         xc!\r
 467         xpop\r
 468         x!\r
 469         xret\r
 470 sf      dd lend\r
 471 msg2    db 3, ' ! '\r
 472 \r
 473 lcolon: xnum    255\r
 474         xcall   lscan\r
 475         xnum    lh\r
 476         x@\r
 477         xnum    1\r
 478         xcall   lne\r
 479         xnum    0\r
 480         xnum    lmode\r
 481         xc!\r
 482         xret\r
 483 \r
 484 lI:     xnum    1\r
 485         xnum    lmode\r
 486         xc!\r
 487         xret\r
 488 \r
 489 ldadd:\r
 490 l27:    xdup\r
 491         xif     l26\r
 492         xdec\r
 493         xpush\r
 494         xcall   lcount\r
 495         xcall   lcsto\r
 496         xpop\r
 497         xjmp    l27\r
 498 l26:    xdrop\r
 499         xdrop\r
 500         xret\r
 501 \r
 502 lincmod: xcall  lcount\r
 503         xjmp    ldadd\r
 504 \r
 505 lif:    xcall   lhere\r
 506         xinc\r
 507         xnum    d6\r
 508         xcall   lincmod\r
 509 l35:    xnum    255\r
 510         xcall   lscan\r
 511         xnum    d7\r
 512         xcall   lstrEQpad\r
 513         xif     l36\r
 514         xcall   lhere\r
 515         xinc\r
 516         xnum    d9\r
 517         xcall   lincmod\r
 518         xswap\r
 519         xcall   lhere\r
 520         xswap\r
 521         x!\r
 522         xjmp    l35\r
 523 l36:    xnum    d8\r
 524         xcall   lstrEQpad\r
 525         xif     l37\r
 526         xcall   lhere\r
 527         xswap\r
 528         x!\r
 529         xret\r
 530 l37:    xcall   lexecute\r
 531         xjmp    l35\r
 532 \r
 533 d6      db 5, 10, 0, 0, 0, 0\r
 534 d7      db 4, 'else'\r
 535 d8      db 4, 'then'\r
 536 d9      db 5, 4, 0, 0, 0, 0\r
 537 \r
 538 ldo:    xcall   lhere\r
 539         xinc\r
 540         xinc\r
 541         xnum    d4\r
 542         xcall   lincmod\r
 543 l33:    xnum    255\r
 544         xcall   lscan\r
 545         xnum    d5\r
 546         xcall   lstrEQpad\r
 547         xif     l34\r
 548         xnum    15\r
 549         xcall   lsto\r
 550         xnum    4\r
 551         xcall   lcsto\r
 552         xdup\r
 553         xdec\r
 554         xdec\r
 555         xcall   lsto\r
 556         xcall   lhere\r
 557         xswap\r
 558         x!\r
 559         xnum    9\r
 560         xcall   lcsto\r
 561         xret\r
 562 l34:    xcall   lexecute\r
 563         xjmp    l33\r
 564 d4      db 8, 8, 10, 0, 0, 0, 0, 7, 14\r
 565 d5      db 4, 'loop'\r
 566 \r
 567 lfor:   xcall   lhere\r
 568         xnum    d10\r
 569         xcall   lincmod\r
 570 l38:    xnum    255\r
 571         xcall   lscan\r
 572         xnum    d5\r
 573         xcall   lstrEQpad\r
 574         xif     l39\r
 575         xnum    d11\r
 576         xcall   lincmod\r
 577         xcall   lhere\r
 578         xover\r
 579         xnum    5\r
 580         xplus\r
 581         x!\r
 582         xinc\r
 583         xcall   lhere\r
 584         xdec\r
 585         xdec\r
 586         xdec\r
 587         xdec\r
 588         x!\r
 589         xnum    d12\r
 590         xcall   lincmod\r
 591         xret\r
 592 l39:    xcall   lexecute\r
 593         xjmp    l38\r
 594 \r
 595 d10     db 10, 14, 8, 31, 25, 10, 0,0,0,0, 14\r
 596 d11     db 7, 15, 6, 4, 0,0,0,0\r
 597 d12     db 3, 9, 15, 9\r
 598 \r
 599 luntil: xnum    d14\r
 600         xcall   lincmod\r
 601         xcall   lhere\r
 602 l40:    xnum    255\r
 603         xcall   lscan\r
 604         xnum    d5\r
 605         xcall   lstrEQpad\r
 606         xif     l41\r
 607         xnum    d15\r
 608         xcall   lincmod\r
 609         xcall   lhere\r
 610         xnum    6\r
 611         xminus\r
 612         x!\r
 613         xret\r
 614 l41:    xcall   lexecute\r
 615         xjmp    l40\r
 616 \r
 617 d14     db 6, 3, 0, 0, 0, 0, 14\r
 618 d15     db 8, 31, 10, 0, 0, 0, 0, 15, 9\r
 619 \r
 620 lmain:\r
 621 l32:    xnum    255\r
 622         xcall   lscan\r
 623         xcall   lexecute\r
 624         xjmp    l32\r
 625 \r
 626 last:\r
 627 head 2, 'lp',           0, llp\r
 628 head 5, 'count',        1, lcount\r
 629 head 4, 'emit',         1, lemit\r
 630 head 4, 'type',         1, ltype\r
 631 head 5, 'write',        1, lwrite\r
 632 head 3, 'pad',          0, lpad\r
 633 head 5, 'c+str',        1, lsadd\r
 634 head 4, 'fkey',         1, lfkey\r
 635 head 4, 'scan',         1, lscan\r
 636 head 8, 'str=str?',     1, lstrEQstr\r
 637 head 4, 'find',         1, lfind\r
 638 head 4, 'mode',         0, lmode\r
 639 head 4, 'goto',         1, lgoto\r
 640 head 7, 'execute',      1, lexecute\r
 641 head 4, '2num',         1, l2num\r
 642 head 2, 'c,',           1, lcsto\r
 643 head 1, ',',            1, lsto\r
 644 head 4, 'halt',         1, lhalt\r
 645 head 1, '@',            2, l@\r
 646 head 1, '!',            2, l!\r
 647 head 2, 'c@',           2, lc@\r
 648 head 2, 'c!',           2, lc!\r
 649 head 2, '1+',           2, linc\r
 650 head 2, '1-',           2, ldec\r
 651 head 1, '>',            2, lcmpg\r
 652 head 1, '<',            2, lcmpl\r
 653 head 3, 'ret',          2, lret\r
 654 head 1, '+',            2, lplus\r
 655 head 1, '-',            2, lminus\r
 656 head 1, '*',            2, lmul\r
 657 head 4, 'drop',         2, ldrop\r
 658 head 3, 'dup',          2, ldup\r
 659 head 4, 'swap',         2, lswap\r
 660 head 5, 'disk@',        2, ldisk@\r
 661 head 4, 'push',         2, lpush\r
 662 head 3, 'pop',          2, lpop\r
 663 head 4, 'over',         2, lover\r
 664 head 5, 'cmove',        2, lcmove\r
 665 head 2, 'ne',           1, lne\r
 666 head 1, ':',            1, lcolon\r
 667 head 1, 'I',            2, lI\r
 668 head 5, 'bcode',        1, bcode\r
 669 head 4, 'dadd',         1, ldadd\r
 670 head 6, 'incmod',       1, lincmod\r
 671 head 2, 'if',           2, lif\r
 672 head 4, 'here',         1, lhere\r
 673 head 2, 'do',           2, ldo\r
 674 head 3, 'for',          2, lfor\r
 675 head 5, 'until',        2, luntil\r
 676 head 4, 'prev',         0, lprev\r
 677 head 4, 'skey',         1, lskey\r
 678 lastp:\r
 679 head 1, 'h',            0, lh\r
 680 lend:\r