00001 *************************
00002 *
00003 * CF83COR4.ASM
00004 * MDJ 06-13-91
00005 *
00006 * CF83 CORE WORDS
00007 * SET #4
00008 *
00009 * MISCELLANEOUS WORDS
00010 *
00011 *************************
00012 *
00013 * MUST ALTER  ON
00014 * ==========  ==
00015 * CF83COR3    ZEXITN
00016 * CF83COR5    ZABTQN
00017 * CF83COR5    ZTICKR
00018 * CF83COR5    ZCMPLC
00019 * CF83COR7    ZTICKC
00020 *
00021 *************************
00022 *
00023 ZIFN    EQU     $6928
00024 ZMMEDN  EQU     $66CB
00025 COLON   EQU     $07
00026 SEMI    EQU     $0D
00027 DPDP    EQU     $1B
00028 BLKL    EQU     $2B
00029 STATEL  EQU     $2D
00030 MODE    EQU     $2E
00031 TOINL   EQU     $01D1
00032 NTIBL   EQU     $01D8
00033 TIB     EQU     $01DA
00034 CONTXT  EQU     $098B
00035 ZITERT  EQU     $5328
00036 ZLOCKC  EQU     $5336
00037 ZESTR4  EQU     $558E
00038 ZERCHC  EQU     $59D7
00039 ZENDB   EQU     $5B0C
00040 ZTCNT   EQU     $5B5B
00041 ZADDRH  EQU     $5C6E
00042 ZBORTC  EQU     $5D48
00043 ZITERC  EQU     $5D79
00044 ZNEPLC  EQU     $5ECE
00045 ZCNTC   EQU     $6020
00046 ZDROPC  EQU     $609F
00047 ZTYPEC  EQU     $6244
00048 ZLLOTC  EQU     $6461
00049 ZREATR  EQU     $64FB
00050         ORG     $66EC
00051 ZEXITN  FCB     4
00052         FCC     /EXIT/
00053 EXITL   FDB     ZMMEDN
00054         FDB     TICKN
00055 EXITC   FDB     *+2
00056 EXITP   CLR     STATEL  SET EXECUTION STATE
00057         CLR     MODE    SET "NOT IMMEDIATE" MODE
00058         JMP     [SEMI]  GO TO INNER INTERPRETER SEMI 
 
 
 
 
 
 
 
 
00059 TICKN   FCB     1
00060         FCC     /'/
00061 TICKL   FDB     ZEXITN
00062         FDB     XTICKN
00063 ZTICKC  FDB     COLON
00064         FDB     ZREATR
00065         FDB     ZTICKR
00066         FDB     ZERCHC
00067         FDB     TICKS
00068         FDB     SEMI
00069 ZTICKR  FDB     *+2
00070         PSHS    X
00071         LDX     [CONTXT] GET CONTEXT LAST WORD ADDRESS
00072         PSHU    X       PUSH IT TO U-STACK
00073         PULS    X
00074         LDX     ,Y++
00075         JMP     [,X++]
00076 TICKS   FDB     *+2
00077         PSHS    X
00078         PULU    X       GET FLAG FROM STACK
00079         CMPX    #0      IS IT FALSE? (WORD MATCH?)
00080         BEQ     TICK1   GO IF YES
00081         JMP     ZESTR4  ERROR RESTART
00082 TICK1   PULS    X
00083         LDX     ,Y++
00084         JMP     [,X++]
00085 XTICKN  FCB     131
00086         FCC     /[']/
00087 XTICKL  FDB     TICKN
00088         FDB     XXPILN
00089 XTICKC  FDB     COLON
00090 XTICKP  FDB     ZTICKC
00091         FDB     ZITERC
00092         FDB     SEMI
00093 XXPILN  FCB     137
00094         FCC     /[COMPILE]/
00095 XXPILL  FDB     XTICKN
00096         FDB     CMPLN
00097 XXPILC  FDB     COLON
00098 XXPILP  FDB     ZTICKC
00099         FDB     XXPILR
00100         FDB     SEMI
00101 XXPILR  FDB     *+2
00102         PSHS    A,B,X
00103         LDX     DPDP    GET DICTIONARY POINTER
00104         PULU    A,B     GET IMMEDIATE WORD CFA FROM STACK
00105         STD     ,X++    STORE IT TO DICTIONARY
00106         STX     DPDP    STORE NEW DICTIONARY POINTER
00107         PULS    A,B,X
00108         LDX     ,Y++
00109         JMP     [,X++]
00110 CMPLN   FCB     7
00111         FCC     /COMPILE/
00112 CMPLL   FDB     XXPILN
00113         FDB     WORDN
00114 ZCMPLC  FDB     *+2
00115 CMPLP   PSHS    A,B,X
00116         LDX     DPDP    GET DICTIONARY POINTER
 
 
 
 
 
 
 
 
00117         LDD     ,Y++    GET CFA TO BE COMPILED
00118         STD     ,X++    STORE IT TO DICTIONARY
00119         STX     DPDP    STORE NEW DICTIONARY POINTER
00120         PULS    A,B,X
00121         LDX     ,Y++
00122         JMP     [,X++]
00123 WORDN   FCB     4
00124         FCC     /WORD/
00125 WORDL   FDB     CMPLN
00126         FDB     IIN
00127 WORDC   FDB     COLON
00128 WORDP   FDB     WORDB
00129         FDB     ZLOCKC
00130         FDB     WORDTB
00131 WORDY   FDB     SEMI
00132 WORDB   FDB     *+2
00133         PSHS    A,B,X
00134         PULU    A,B     GET TERMINATOR CHARACTER
00135         STB     WORDTM  TEMPORARILY STORE IT
00136         LDX     BLKL    GET BLOCK NUMBER
00137         CMPX    #0      IS IT ZERO?
00138         BEQ     WORDB1  GO IF YES
00139         PSHU    X       PUSH BLOCK NUMBER TO U-STACK
00140         BRA     WORDB2
00141 WORDB1  PULS    A,B,X
00142         LDY     #WORDY  ADJUST INNER INTERPRETER (TERM.)
00143         LDX     #WORDTL
00144         JMP     [,X++]
00145 WORDB2  PULS    A,B,X
00146         LDX     ,Y++    EXECUTE INNER INTERPRETER (BLOCK)
00147         JMP     [,X++]
00148 WORDTM  RMB     1
00149 WORDTB  FDB     *+2
00150         PSHS    A,B,X
00151         PULU    A,B     GET BLOCK START ADDRESS
00152         STD     ZADDRH  SAVE IT
00153         ADDD    #1025   ADD BLOCK LENGTH+1
00154         STD     ZENDB   TO END-OF-BLOCK VARIABLE
00155         LDD     ZADDRH  GET BLOCK START ADDRESS AGAIN
00156         ADDD    TOINL   ADD PRESENT CHARACTER OFFSET
00157         PSHU    A,B     PUSH IT TO U-STACK
00158         JSR     WORDTX  GO CHECK TOKEN
00159         PULU    A,B     GET CHARACTER OFFSET POINTER
00160         SUBD    ZADDRH  SUBTRACT BLOCK START ADDRESS
00161         CMPD    #1024   IS IT > END OF BLOCK?
00162         BLS     WORDTA  GO IF NO
00163         LDD     #1024   SET END OF BLOCK
00164 WORDTA  STD     TOINL   STORE CHARACTER OFFSET
00165         PULS    A,B,X
00166         LDX     ,Y++
00167         JMP     [,X++]
00168 WORDTL  FDB     *+2
00169         PSHS    A,B,X
00170         CLR     NTIBL   CLEAR HIGH BIT OF TIB COUNT
00171         LDD     NTIBL   LOAD TIB COUNT
00172         ADDD    #TIB    ADD TIB ADDRESS
00173         ADDD    #1      BUMP ONE
00174         STD     ZENDB   STORE IT AS END-OF-TIB  
 
 
 
 
 
 
 
 
00175         LDD     TOINL   GET CHARACTER OFFSET
00176         ADDD    #TIB    ADD TIB ADDRESS
00177         PSHU    A,B     PUSH IT TO U-STACK
00178         JSR     WORDTX  GO CHECK TOKEN
00179         PULU    A,B     GET CHARACTER OFFSET POINTER
00180         SUBD    #TIB    SUBTRACT TIB ADDRESS
00181         CMPD    NTIBL   IS IT > TIB COUNT
00182         BLS     WORDTC  GO IF NO
00183         LDD     NTIBL   LOAD TIB COUNT
00184 WORDTC  STD     TOINL   STORE CHARACTER OFFSET
00185         PULS    A,B,X
00186         LDX     ,Y++
00187         JMP     [,X++]
00188 WORDTX  PSHS    A,B,X,Y
00189         CLR     ZTCNT   CLEAR TOKEN COUNT
00190         PULU    Y       GET CHARACTER OFFSET AS POINTER
00191         LDX     DPDP    LOAD DICTIONARY POINTER
00192         LEAX    1,X     MAKE ROOM FOR COUNT
00193 WORDT1  LDA     ,Y+     LOAD CHARACTER AND BUMP POINTER
00194         CMPY    ZENDB   IS IT END OF BLOCK/TIB?
00195         BEQ     WORDT3  GO IF YES
00196         CMPA    WORDTM  IS IT TERMINATOR CHARACTER?
00197         BEQ     WORDT1  GO IF YES
00198         LEAY    -1,Y    BUMP POINTER BACK
00199 WORDT2  LDA     ,Y+     GET CHARACTER AND BUMP POINTER
00200         CMPY    ZENDB   IS IT END OF BLOCK/TIB?
00201         BEQ     WORDT3  GO IF YES
00202         CMPA    WORDTM  IS IT TERMINATOR CHARACTER?
00203         BEQ     WORDT3  GO IF YES
00204         STA     ,X+     STORE CHARACTER TO DICTIONARY
00205         INC     ZTCNT   INCREMENT TOKEN COUNT
00206         BRA     WORDT2  RETURN FOR NEXT CHARACTER
00207 WORDT3  LDA     #32     LOAD SPACE CHARACTER
00208         STA     ,X      STORE IT TO DICTIONARY
00209         LDX     DPDP    GET ORIGINAL DICTIONARY POINTER
00210         PSHU    X       PUSH IT TO U-STACK
00211         PSHU    Y       PUSH CHARACTER POINTER TO STACK
00212         LDA     ZTCNT   LOAD TOKEN COUNT
00213         STA     ,X      STORE IT TO DICTIONARY
00214         PULS    A,B,X,Y
00215         RTS
00216 IIN     FCB     1
00217         FCC     /I/
00218 IIL     FDB     WORDN
00219         FDB     JJN
00220 IIC     FDB     *+2
00221 IIP     PSHS    A,B
00222         LDD     2,S     GET SCANNING INDEX
00223         ADDD    4,S     ADD OFFSET LIMIT
00224         PSHU    A,B     PUSH IT TO U-STACK
00225         PULS    A,B
00226         LDX     ,Y++
00227         JMP     [,X++]
00228 JJN     FCB     1
00229         FCC     /J/
00230 JJL     FDB     IIN
00231         FDB     PARN
00232 JJC     FDB     *+2
 
 
 
 
 
 
 
 
00233 JJP     PSHS    A,B
00234         LDD     8,S     GET OUTER SCANNING INDEX
00235         ADDD    10,S    ADD OUTER OFFSET LIMIT
00236         PSHU    A,B     PUSH IT TO U-STACK
00237         PULS    A,B
00238         LDX     ,Y++
00239         JMP     [,X++]
00240 PARN    FCB     129
00241         FCC     /(/
00242 PARL    FDB     JJN
00243         FDB     DPARN
00244 PARC    FDB     COLON
00245 PARP    FDB     ZITERT
00246         FDB     41
00247         FDB     WORDC
00248         FDB     ZDROPC
00249         FDB     SEMI
00250 DPARN   FCB     130
00251         FCC     /.(/
00252 DPARL   FDB     PARN
00253         FDB     DQUON
00254 DPARC   FDB     COLON
00255 DPARP   FDB     ZITERT
00256         FDB     41
00257         FDB     WORDC
00258         FDB     ZCNTC
00259         FDB     ZTYPEC
00260         FDB     SEMI
00261 DQUON   FCB     130
00262         FCC     /."/
00263 DQUOL   FDB     DPARN
00264         FDB     ZABTQN
00265 DQUOC   FDB     COLON
00266 DQUOP   FDB     ZCMPLC
00267         FDB     DQUOR
00268         FDB     ZITERT
00269         FDB     34
00270         FDB     WORDC
00271         FDB     ZCNTC
00272         FDB     ZNEPLC
00273         FDB     ZLLOTC
00274         FDB     ZDROPC
00275         FDB     ZCMPLC
00276         FDB     ZTYPEC
00277         FDB     SEMI
00278 DQUOR   FDB     *+2
00279         PSHS    A,B,X
00280         TFR     Y,X
00281         LDB     ,X+     GET CHAR. COUNT & POINT TO ADDR
00282         PSHU    X       PUSH ADDRESS TO STACK
00283         CLRA
00284         PSHU    A,B     PUSH COUNT TO STACK
00285         ABX             ADD COUNT TO ADDRESS
00286         TFR     X,Y
00287         PULS    A,B,X
00288         LDX     ,Y++
00289         JMP     [,X++]
00290 ZABTQN  FCB     134
 
 
 
 
 
 
 
 
00291         FCC     /ABORT"/
00292 ABTQL   FDB     DQUON
00293         FDB     ZIFN
00294 ABTQC   FDB     COLON
00295 ABTQP   FDB     ZCMPLC
00296         FDB     QABORT
00297         FDB     DQUOC
00298         FDB     ZCMPLC
00299         FDB     ZBORTC
00300         FDB     SEMI
00301 QABORT  FDB     *+2
00302         PSHS    B,X
00303         PULU    X       GET FLAG
00304         CMPX    #0      IS IT FALSE?
00305         BNE     QABT1   GO IF NO
00306         LDB     2,Y     GET COUNT
00307         TFR     Y,X     COPY INNER INTERPRETER POINTER
00308         ABX             BUMP IT
00309         LEAX    7,X     BUMP IT AGAIN
00310         TFR     X,Y     MOVE IT BACK
00311 QABT1   PULS    B,X
00312         LDX     ,Y++
00313         JMP     [,X++]
00314 ZEND    NOP
00315         END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
