00001 *************************
00002 *
00003 * CF83COR1.ASM
00004 * MDJ 06-13-91
00005 *
00006 * CF83 CORE WORDS
00007 * SET #1
00008 *
00009 * CORE FORTH WORDS
00010 * IMPLEMENTED BY DIRECT
00011 * JSR'S TO SACORE WORDS
00012 *
00013 *************************
00014 *
00015 * MUST ALTER  ON
00016 * ==========  ==
00017 * CF83COR0    ZEXCLN
00018 * CF83COR2    ZXORN
00019 * CF83COR4    ZCNTC
00020 * CF83COR4    ZNEPLC
00021 * CF83COR4    ZDROPC
00022 * CF83COR4    ZTYPEC
00023 * CF83COR5    ZEXCLC
00024 * CF83COR5    ZEQC
00025 * CF83COR5    ZWOPLC
00026 * CF83COR5    ZCMVC
00027 * CF83COR5    ZDUPC
00028 * CF83COR5    ZSWAPC
00029 * CF83COR5    ZCNTC
00030 * CF83COR5    ZNEPLC
00031 * CF83COR5    ZDROPC
00032 *
00033 *************************
00034 *
00035 ZTORN   EQU     $62A4
00036 ZLOCKN  EQU     $5D93
00037 EXCL    EQU     $4B2D
00038 NUM     EQU     $4DB5
00039 NUMG    EQU     $4D7F
00040 NUMS    EQU     $4DE2
00041 NTIB    EQU     $5023
00042 MULT    EQU     $48CB
00043 MULTD   EQU     $4915
00044 MLTDM   EQU     $4928
00045 PLUS    EQU     $48AF
00046 EXPL    EQU     $4B38
00047 MINUS   EQU     $48BC
00048 TRAIL   EQU     $4D0B
00049 DOT     EQU     $4F13
00050 DIV     EQU     $48DF
00051 DIVM    EQU     $4905
00052 ZLT     EQU     $4B9F
00053 ZEQ     EQU     $4BB6
00054 ZGT     EQU     $4BCD
00055 ONEPL   EQU     $49CE
00056 ONEMN   EQU     $49E6
00057 TWOPL   EQU     $49DA
00058 TWOMN   EQU     $49F2
 
 
 
 
 
 
 
 
00059 TWOD    EQU     $49BB
00060 LT      EQU     $4BE4
00061 LNUM    EQU     $4D69
00062 EQ      EQU     $4BFE
00063 GT      EQU     $4C16
00064 TOIN    EQU     $502D
00065 QDUP    EQU     $4800
00066 AT      EQU     $4B45
00067 ABS     EQU     $48ED
00068 AND     EQU     $4B67
00069 BASE    EQU     $4CF7
00070 CEXCL   EQU     $4B50
00071 CAT     EQU     $4B5B
00072 CMV     EQU     $4C89
00073 CMVTO   EQU     $4CA7
00074 CNVRT   EQU     $4E12
00075 CNT     EQU     $4CD1
00076 CR      EQU     $4E84
00077 DPLUS   EQU     $4979
00078 DLT     EQU     $4C30
00079 DECML   EQU     $4D2A
00080 DEPTH   EQU     $4818
00081 DNGT    EQU     $495D
00082 DROP    EQU     $4811
00083 DUP     EQU     $4836
00084 EMIT    EQU     $4E88
00085 EXPCT   EQU     $504E
00086 FILL    EQU     $4CE1
00087 HOLD    EQU     $4D44
00088 KEY     EQU     $5041
00089 MAX     EQU     $499B
00090 MIN     EQU     $49AB
00091 MOD     EQU     $493D
00092 NGT     EQU     $494B
00093 NOT     EQU     $4B76
00094 OR      EQU     $4B81
00095 OVER    EQU     $484E
00096 PAD     EQU     $4D01
00097 PICK    EQU     $4868
00098 ROLL    EQU     $4884
00099 ROT     EQU     $4857
00100 SIGN    EQU     $4DA1
00101 SPACE   EQU     $4EBD
00102 SPCES   EQU     $4EC8
00103 SPAN    EQU     $5037
00104 SWAP    EQU     $4841
00105 TYPE    EQU     $4EF1
00106 UDOT    EQU     $4F76
00107 ULT     EQU     $4C6F
00108 UMT     EQU     $49FE
00109 UMMOD   EQU     $4A16
00110 XOR     EQU     $4B90
00111         ORG     $5DA0
00112 ZEXCLN  FCB     1
00113         FCC     '!'
00114         FDB     ZLOCKN
00115         FDB     NUMN
00116 ZEXCLC  FDB     *+2
 
 
 
 
 
 
 
 
00117         JSR     EXCL
00118         LDX     ,Y++
00119         JMP     [,X++]
00120 NUMN    FCB     1
00121         FCC     '#'
00122         FDB     ZEXCLN
00123         FDB     NUMGN
00124         FDB     *+2
00125         JSR     NUM
00126         LDX     ,Y++
00127         JMP     [,X++]
00128 NUMGN   FCB     2
00129         FCC     '#>'
00130         FDB     NUMN
00131         FDB     NUMSN
00132         FDB     *+2
00133         JSR     NUMG
00134         LDX     ,Y++
00135         JMP     [,X++]
00136 NUMSN   FCB     2
00137         FCC     '#S'
00138         FDB     NUMGN
00139         FDB     NTIBN
00140         FDB     *+2
00141         JSR     NUMS
00142         LDX     ,Y++
00143         JMP     [,X++]
00144 NTIBN   FCB     4
00145         FCC     '#TIB'
00146         FDB     NUMSN
00147         FDB     MULTN
00148         FDB     *+2
00149         JSR     NTIB
00150         LDX     ,Y++
00151         JMP     [,X++]
00152 MULTN   FCB     1
00153         FCC     '*'
00154         FDB     NTIBN
00155         FDB     MULTDN
00156         FDB     *+2
00157         JSR     MULT
00158         LDX     ,Y++
00159         JMP     [,X++]
00160 MULTDN  FCB     2
00161         FCC     '*/'
00162         FDB     MULTN
00163         FDB     MLTDMN
00164         FDB     *+2
00165         JSR     MULTD
00166         LDX     ,Y++
00167         JMP     [,X++]
00168 MLTDMN  FCB     5
00169         FCC     '*/MOD'
00170         FDB     MULTDN
00171         FDB     PLUSN
00172         FDB     *+2
00173         JSR     MLTDM
00174         LDX     ,Y++
 
 
 
 
 
 
 
 
00175         JMP     [,X++]
00176 PLUSN   FCB     1
00177         FCC     '+'
00178         FDB     MLTDMN
00179         FDB     EXPLN
00180         FDB     *+2
00181         JSR     PLUS
00182         LDX     ,Y++
00183         JMP     [,X++]
00184 EXPLN   FCB     2
00185         FCC     '+!'
00186         FDB     PLUSN
00187         FDB     MINUSN
00188         FDB     *+2
00189         JSR     EXPL
00190         LDX     ,Y++
00191         JMP     [,X++]
00192 MINUSN  FCB     1
00193         FCC     '-'
00194         FDB     EXPLN
00195         FDB     TRAILN
00196         FDB     *+2
00197         JSR     MINUS
00198         LDX     ,Y++
00199         JMP     [,X++]
00200 TRAILN  FCB     9
00201         FCC     '-TRAILING'
00202         FDB     MINUSN
00203         FDB     DOTN
00204         FDB     *+2
00205         JSR     TRAIL
00206         LDX     ,Y++
00207         JMP     [,X++]
00208 DOTN    FCB     1
00209         FCC     '.'
00210         FDB     TRAILN
00211         FDB     DIVN
00212         FDB     *+2
00213         JSR     DOT
00214         LDX     ,Y++
00215         JMP     [,X++]
00216 DIVN    FCB     1
00217         FCC     '/'
00218         FDB     DOTN
00219         FDB     DIVMN
00220         FDB     *+2
00221         JSR     DIV
00222         LDX     ,Y++
00223         JMP     [,X++]
00224 DIVMN   FCB     4
00225         FCC     '/MOD'
00226         FDB     DIVN
00227         FDB     ZLTN
00228         FDB     *+2
00229         JSR     DIVM
00230         LDX     ,Y++
00231         JMP     [,X++]
00232 ZLTN    FCB     2
 
 
 
 
 
 
 
 
00233         FCC     '0<'
00234         FDB     DIVMN
00235         FDB     ZEQN
00236         FDB     *+2
00237         JSR     ZLT
00238         LDX     ,Y++
00239         JMP     [,X++]
00240 ZEQN    FCB     2
00241         FCC     '0='
00242         FDB     ZLTN
00243         FDB     ZGTN
00244 ZEQC    FDB     *+2
00245         JSR     ZEQ
00246         LDX     ,Y++
00247         JMP     [,X++]
00248 ZGTN    FCB     2
00249         FCC     '0>'
00250         FDB     ZEQN
00251         FDB     ONEPLN
00252         FDB     *+2
00253         JSR     ZGT
00254         LDX     ,Y++
00255         JMP     [,X++]
00256 ONEPLN  FCB     2
00257         FCC     '1+'
00258         FDB     ZGTN
00259         FDB     ONEMNN
00260 ZNEPLC  FDB     *+2
00261         JSR     ONEPL
00262         LDX     ,Y++
00263         JMP     [,X++]
00264 ONEMNN  FCB     2
00265         FCC     '1-'
00266         FDB     ONEPLN
00267         FDB     TWOPLN
00268         FDB     *+2
00269         JSR     ONEMN
00270         LDX     ,Y++
00271         JMP     [,X++]
00272 TWOPLN  FCB     2
00273         FCC     '2+'
00274         FDB     ONEMNN
00275         FDB     TWOMNN
00276 ZWOPLC  FDB     *+2
00277         JSR     TWOPL
00278         LDX     ,Y++
00279         JMP     [,X++]
00280 TWOMNN  FCB     2
00281         FCC     '2-'
00282         FDB     TWOPLN
00283         FDB     TWODN
00284         FDB     *+2
00285         JSR     TWOMN
00286         LDX     ,Y++
00287         JMP     [,X++]
00288 TWODN   FCB     2
00289         FCC     '2/'
00290         FDB     TWOMNN
 
 
 
 
 
 
 
 
00291         FDB     LTN
00292         FDB     *+2
00293         JSR     TWOD
00294         LDX     ,Y++
00295         JMP     [,X++]
00296 LTN     FCB     1
00297         FCC     '<'
00298         FDB     TWODN
00299         FDB     LNUMN
00300         FDB     *+2
00301         JSR     LT
00302         LDX     ,Y++
00303         JMP     [,X++]
00304 LNUMN   FCB     2
00305         FCC     '<#'
00306         FDB     LTN
00307         FDB     EQN
00308         FDB     *+2
00309         JSR     LNUM
00310         LDX     ,Y++
00311         JMP     [,X++]
00312 EQN     FCB     1
00313         FCC     '='
00314         FDB     LNUMN
00315         FDB     GTN
00316         FDB     *+2
00317         JSR     EQ
00318         LDX     ,Y++
00319         JMP     [,X++]
00320 GTN     FCB     1
00321         FCC     '>'
00322         FDB     EQN
00323         FDB     TOINN
00324         FDB     *+2
00325         JSR     GT
00326         LDX     ,Y++
00327         JMP     [,X++]
00328 TOINN   FCB     3
00329         FCC     '>IN'
00330         FDB     GTN
00331         FDB     QDUPN
00332         FDB     *+2
00333         JSR     TOIN
00334         LDX     ,Y++
00335         JMP     [,X++]
00336 QDUPN   FCB     4
00337         FCC     '?DUP'
00338         FDB     TOINN
00339         FDB     ATN
00340         FDB     *+2
00341         JSR     QDUP
00342         LDX     ,Y++
00343         JMP     [,X++]
00344 ATN     FCB     1
00345         FCC     '@'
00346         FDB     QDUPN
00347         FDB     ABSN
00348         FDB     *+2
 
 
 
 
 
 
 
 
00349         JSR     AT
00350         LDX     ,Y++
00351         JMP     [,X++]
00352 ABSN    FCB     3
00353         FCC     'ABS'
00354         FDB     ATN
00355         FDB     ANDN
00356         FDB     *+2
00357         JSR     ABS
00358         LDX     ,Y++
00359         JMP     [,X++]
00360 ANDN    FCB     3
00361         FCC     'AND'
00362         FDB     ABSN
00363         FDB     BASEN
00364         FDB     *+2
00365         JSR     AND
00366         LDX     ,Y++
00367         JMP     [,X++]
00368 BASEN   FCB     4
00369         FCC     'BASE'
00370         FDB     ANDN
00371         FDB     CEXCLN
00372         FDB     *+2
00373         JSR     BASE
00374         LDX     ,Y++
00375         JMP     [,X++]
00376 CEXCLN  FCB     2
00377         FCC     'C!'
00378         FDB     BASEN
00379         FDB     CATN
00380         FDB     *+2
00381         JSR     CEXCL
00382         LDX     ,Y++
00383         JMP     [,X++]
00384 CATN    FCB     2
00385         FCC     'C@'
00386         FDB     CEXCLN
00387         FDB     CMVN
00388         FDB     *+2
00389         JSR     CAT
00390         LDX     ,Y++
00391         JMP     [,X++]
00392 CMVN    FCB     5
00393         FCC     'CMOVE'
00394         FDB     CATN
00395         FDB     CMVTON
00396 ZCMVC   FDB     *+2
00397         JSR     CMV
00398         LDX     ,Y++
00399         JMP     [,X++]
00400 CMVTON  FCB     6
00401         FCC     'CMOVE>'
00402         FDB     CMVN
00403         FDB     CNVRTN
00404         FDB     *+2
00405         JSR     CMVTO
00406         LDX     ,Y++
 
 
 
 
 
 
 
 
00407         JMP     [,X++]
00408 CNVRTN  FCB     7
00409         FCC     'CONVERT'
00410         FDB     CMVTON
00411         FDB     CNTN
00412         FDB     *+2
00413         JSR     CNVRT
00414         LDX     ,Y++
00415         JMP     [,X++]
00416 CNTN    FCB     5
00417         FCC     'COUNT'
00418         FDB     CNVRTN
00419         FDB     CRN
00420 ZCNTC   FDB     *+2
00421         JSR     CNT
00422         LDX     ,Y++
00423         JMP     [,X++]
00424 CRN     FCB     2
00425         FCC     'CR'
00426         FDB     CNTN
00427         FDB     DPLUSN
00428         FDB     *+2
00429         JSR     CR
00430         LDX     ,Y++
00431         JMP     [,X++]
00432 DPLUSN  FCB     2
00433         FCC     'D+'
00434         FDB     CRN
00435         FDB     DLTN
00436         FDB     *+2
00437         JSR     DPLUS
00438         LDX     ,Y++
00439         JMP     [,X++]
00440 DLTN    FCB     2
00441         FCC     'D<'
00442         FDB     DPLUSN
00443         FDB     DECMLN
00444         FDB     *+2
00445         JSR     DLT
00446         LDX     ,Y++
00447         JMP     [,X++]
00448 DECMLN  FCB     7
00449         FCC     'DECIMAL'
00450         FDB     DLTN
00451         FDB     DEPTHN
00452         FDB     *+2
00453         JSR     DECML
00454         LDX     ,Y++
00455         JMP     [,X++]
00456 DEPTHN  FCB     5
00457         FCC     'DEPTH'
00458         FDB     DECMLN
00459         FDB     DNGTN
00460         FDB     *+2
00461         JSR     DEPTH
00462         LDX     ,Y++
00463         JMP     [,X++]
00464 DNGTN   FCB     7
 
 
 
 
 
 
 
 
00465         FCC     'DNEGATE'
00466         FDB     DEPTHN
00467         FDB     DROPN
00468         FDB     *+2
00469         JSR     DNGT
00470         LDX     ,Y++
00471         JMP     [,X++]
00472 DROPN   FCB     4
00473         FCC     'DROP'
00474         FDB     DNGTN
00475         FDB     DUPN
00476 ZDROPC  FDB     *+2
00477         JSR     DROP
00478         LDX     ,Y++
00479         JMP     [,X++]
00480 DUPN    FCB     3
00481         FCC     'DUP'
00482         FDB     DROPN
00483         FDB     EMITN
00484 ZDUPC   FDB     *+2
00485         JSR     DUP
00486         LDX     ,Y++
00487         JMP     [,X++]
00488 EMITN   FCB     4
00489         FCC     'EMIT'
00490         FDB     DUPN
00491         FDB     EXPCTN
00492         FDB     *+2
00493         JSR     EMIT
00494         LDX     ,Y++
00495         JMP     [,X++]
00496 EXPCTN  FCB     6
00497         FCC     'EXPECT'
00498         FDB     EMITN
00499         FDB     FILLN
00500         FDB     *+2
00501         JSR     EXPCT
00502         LDX     ,Y++
00503         JMP     [,X++]
00504 FILLN   FCB     4
00505         FCC     'FILL'
00506         FDB     EXPCTN
00507         FDB     HOLDN
00508         FDB     *+2
00509         JSR     FILL
00510         LDX     ,Y++
00511         JMP     [,X++]
00512 HOLDN   FCB     4
00513         FCC     'HOLD'
00514         FDB     FILLN
00515         FDB     KEYN
00516         FDB     *+2
00517         JSR     HOLD
00518         LDX     ,Y++
00519         JMP     [,X++]
00520 KEYN    FCB     3
00521         FCC     'KEY'
00522         FDB     HOLDN
 
 
 
 
 
 
 
 
00523         FDB     MAXN
00524         FDB     *+2
00525         JSR     KEY
00526         PSHS    A,B
00527         PULU    A,B
00528         ANDB    #127
00529         PSHU    A,B
00530         PULS    A,B
00531         LDX     ,Y++
00532         JMP     [,X++]
00533 MAXN    FCB     3
00534         FCC     'MAX'
00535         FDB     KEYN
00536         FDB     MINN
00537         FDB     *+2
00538         JSR     MAX
00539         LDX     ,Y++
00540         JMP     [,X++]
00541 MINN    FCB     3
00542         FCC     'MIN'
00543         FDB     MAXN
00544         FDB     MODN
00545         FDB     *+2
00546         JSR     MIN
00547         LDX     ,Y++
00548         JMP     [,X++]
00549 MODN    FCB     3
00550         FCC     'MOD'
00551         FDB     MINN
00552         FDB     NGTN
00553         FDB     *+2
00554         JSR     MOD
00555         LDX     ,Y++
00556         JMP     [,X++]
00557 NGTN    FCB     6
00558         FCC     'NEGATE'
00559         FDB     MODN
00560         FDB     NOTN
00561         FDB     *+2
00562         JSR     NGT
00563         LDX     ,Y++
00564         JMP     [,X++]
00565 NOTN    FCB     3
00566         FCC     'NOT'
00567         FDB     NGTN
00568         FDB     ORN
00569         FDB     *+2
00570         JSR     NOT
00571         LDX     ,Y++
00572         JMP     [,X++]
00573 ORN     FCB     2
00574         FCC     'OR'
00575         FDB     NOTN
00576         FDB     OVERN
00577         FDB     *+2
00578         JSR     OR
00579         LDX     ,Y++
00580         JMP     [,X++]
 
 
 
 
 
 
 
 
00581 OVERN   FCB     4
00582         FCC     'OVER'
00583         FDB     ORN
00584         FDB     PADN
00585         FDB     *+2
00586         JSR     OVER
00587         LDX     ,Y++
00588         JMP     [,X++]
00589 PADN    FCB     3
00590         FCC     'PAD'
00591         FDB     OVERN
00592         FDB     PICKN
00593         FDB     *+2
00594         JSR     PAD
00595         LDX     ,Y++
00596         JMP     [,X++]
00597 PICKN   FCB     4
00598         FCC     'PICK'
00599         FDB     PADN
00600         FDB     ROLLN
00601         FDB     *+2
00602         JSR     PICK
00603         LDX     ,Y++
00604         JMP     [,X++]
00605 ROLLN   FCB     4
00606         FCC     'ROLL'
00607         FDB     PICKN
00608         FDB     ROTN
00609         FDB     *+2
00610         JSR     ROLL
00611         LDX     ,Y++
00612         JMP     [,X++]
00613 ROTN    FCB     3
00614         FCC     'ROT'
00615         FDB     ROLLN
00616         FDB     SIGNN
00617         FDB     *+2
00618         JSR     ROT
00619         LDX     ,Y++
00620         JMP     [,X++]
00621 SIGNN   FCB     4
00622         FCC     'SIGN'
00623         FDB     ROTN
00624         FDB     SPACEN
00625         FDB     *+2
00626         JSR     SIGN
00627         LDX     ,Y++
00628         JMP     [,X++]
00629 SPACEN  FCB     5
00630         FCC     'SPACE'
00631         FDB     SIGNN
00632         FDB     SPCESN
00633         FDB     *+2
00634         JSR     SPACE
00635         LDX     ,Y++
00636         JMP     [,X++]
00637 SPCESN  FCB     6
00638         FCC     'SPACES'
 
 
 
 
 
 
 
 
00639         FDB     SPACEN
00640         FDB     SPANN
00641         FDB     *+2
00642         JSR     SPCES
00643         LDX     ,Y++
00644         JMP     [,X++]
00645 SPANN   FCB     4
00646         FCC     'SPAN'
00647         FDB     SPCESN
00648         FDB     SWAPN
00649         FDB     *+2
00650         JSR     SPAN
00651         LDX     ,Y++
00652         JMP     [,X++]
00653 SWAPN   FCB     4
00654         FCC     'SWAP'
00655         FDB     SPANN
00656         FDB     TYPEN
00657 ZSWAPC  FDB     *+2
00658         JSR     SWAP
00659         LDX     ,Y++
00660         JMP     [,X++]
00661 TYPEN   FCB     4
00662         FCC     'TYPE'
00663         FDB     SWAPN
00664         FDB     UDOTN
00665 ZTYPEC  FDB     *+2
00666         JSR     TYPE
00667         LDX     ,Y++
00668         JMP     [,X++]
00669 UDOTN   FCB     2
00670         FCC     'U.'
00671         FDB     TYPEN
00672         FDB     ULTN
00673         FDB     *+2
00674         JSR     UDOT
00675         LDX     ,Y++
00676         JMP     [,X++]
00677 ULTN    FCB     2
00678         FCC     'U<'
00679         FDB     UDOTN
00680         FDB     UMTN
00681         FDB     *+2
00682         JSR     ULT
00683         LDX     ,Y++
00684         JMP     [,X++]
00685 UMTN    FCB     3
00686         FCC     'UM*'
00687         FDB     ULTN
00688         FDB     UMMODN
00689         FDB     *+2
00690         JSR     UMT
00691         LDX     ,Y++
00692         JMP     [,X++]
00693 UMMODN  FCB     6
00694         FCC     'UM/MOD'
00695         FDB     UMTN
00696         FDB     ZXORN
 
 
 
 
 
 
 
 
00697         FDB     *+2
00698         JSR     UMMOD
00699         LDX     ,Y++
00700         JMP     [,X++]
00701 ZXORN   FCB     3
00702         FCC     'XOR'
00703         FDB     UMMODN
00704         FDB     ZTORN
00705         FDB     *+2
00706         JSR     XOR
00707         LDX     ,Y++
00708         JMP     [,X++]
00709 ZEND    NOP
00710         END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
