00001 *************************
00002 *
00003 * CF83COR3.ASM
00004 * MDJ 06-13-91
00005 *
00006 * CF83 CORE WORDS
00007 * SET #3
00008 *
00009 * COMPILER LEVEL WORDS
00010 * FIRST PART OF TWO
00011 *
00012 *************************
00013 *
00014 * MUST ALTER  ON
00015 * ==========  ==
00016 * CF83COR2    ZLLOTN
00017 * CF83COR4    ZLLOTC
00018 * CF83COR4    ZREATR
00019 * CF83COR4    ZMMEDN
00020 * CF83COR5    ZOMMAC
00021 * CF83COR6    ZORTHC
00022 * CF83COR6    ZREATC
00023 * CF83COR7    ZREATR
00024 *
00025 *************************
00026 *
00027 ZEXITN  EQU     $66EC
00028 ZDEFNN  EQU     $642F
00029 COLON   EQU     $07
00030 SEMI    EQU     $0D
00031 DPDP    EQU     $1B
00032 TDPDP   EQU     $1D
00033 LAST    EQU     $1F
00034 TLAST   EQU     $21
00035 TCUR    EQU     $29
00036 BLKL    EQU     $2B
00037 STATEL  EQU     $2D
00038 TOINL   EQU     $01D1
00039 TIB     EQU     $01DA
00040 ETIB    EQU     $02DB
00041 VOCAB   EQU     $0989
00042 CONTXT  EQU     $098B
00043 CURENT  EQU     $098D
00044 SCHORD  EQU     $098F
00045 VAF00   EQU     $0991
00046 VAL00   EQU     $0993
00047 VAF01   EQU     $0995
00048 VAF26   EQU     $09F9
00049 ZLOCKC  EQU     $5336
00050 ZESTR3  EQU     $558A
00051 ZENDB   EQU     $5B0C
00052 ZOKENX  EQU     $5B0E
00053 ZADDRH  EQU     $5C6E
00054         ORG     $6457
00055 ZLLOTN  FCB     5
00056         FCC     /ALLOT/
00057 ALLOTL  FDB     ZDEFNN
00058         FDB     COMMAN
 
 
 
 
 
 
 
 
00059 ZLLOTC  FDB     *+2
00060 ALLOTP  PSHS    A,B
00061         PULU    A,B     GET # OF BYTES FROM U-STACK
00062         ADDD    DPDP    ADD TO DICTIONARY POINTER
00063         STD     DPDP    STORE NEW DICTIONARY POINTER
00064         PULS    A,B
00065         LDX     ,Y++
00066         JMP     [,X++]
00067 COMMAN  FCB     1
00068         FCC     /,/
00069 COMMAL  FDB     ZLLOTN
00070         FDB     STATEN
00071 ZOMMAC  FDB     *+2
00072 COMMAP  PSHS    A,B
00073         PULU    A,B     GET 16 BITS FROM U-STACK
00074         STD     [DPDP]  STORE THEM TO DICTIONARY
00075         LDD     DPDP    UPDATE DICTIONARY POINTER
00076         ADDD    #2
00077         STD     DPDP
00078         PULS    A,B
00079         LDX     ,Y++
00080         JMP     [,X++]
00081 STATEN  FCB     5
00082         FCC     /STATE/
00083 STATXL  FDB     COMMAN
00084         FDB     LBRKTN
00085 STATEC  FDB     *+2
00086 STATEP  PSHS    X
00087         LDX     #STATEL GET ADDRESS OF STATEL
00088         PSHU    X       PUSH IT TO U-STACK
00089         PULS    X
00090         LDX     ,Y++
00091         JMP     [,X++]
00092 LBRKTN  FCB     129
00093         FCC     /[/
00094 LBRKTL  FDB     STATEN
00095         FDB     RBRKTN
00096 LBRKTC  FDB     *+2
00097 LBRKTP  CLR     STATEL  SET INTERPRET STATE (STATEL = 0)
00098         LDX     ,Y++
00099         JMP     [,X++]
00100 RBRKTN  FCB     1
00101         FCC     /]/
00102 RBRKTL  FDB     LBRKTN
00103         FDB     FORTHN
00104 RBRKTC  FDB     *+2
00105 RBRKTP  CLR     STATEL  SET COMPILATION STATE ($FFFF)
00106         DEC     STATEL
00107         LDX     ,Y++
00108         JMP     [,X++]
00109 FORTHN  FCB     5
00110         FCC     /FORTH/
00111 FORTHL  FDB     RBRKTN
00112         FDB     CREATN
00113 ZORTHC  FDB     *+2
00114 FORTHP  PSHS    X
00115         LDX     #VAF00  FORTH FIRST WORD POINTER ADDRESS
00116         STX     VOCAB   INDIRECT CUR. FIRST WORD POINTER
 
 
 
 
 
 
 
 
00117         LDX     #VAL00  FORTH LAST WORD POINTER ADDRESS
00118         STX     CONTXT  INDIRECT CTX. LAST WORD POINTER
00119         STX     SCHORD  SEARCH ORDER POINTER
00120         PULS    X
00121         LDX     ,Y++
00122         JMP     [,X++]
00123 CREATN  FCB     6
00124         FCC     /CREATE/
00125 CREATL  FDB     FORTHN
00126         FDB     COLN
00127 ZREATC  FDB     COLON
00128 CREATP  FDB     ZREATR
00129         FDB     CREATS
00130         FDB     SEMI
00131 ZREATR  FDB     *+2
00132         PSHS    X
00133         LDX     BLKL    GET BLOCK NUMBER
00134         CMPX    #0      IS IT ZERO?
00135         BEQ     CREAT1  GO CREATE FROM TERMINAL
00136         PSHU    X       PUSH BLOCK NUMBER TO U-STACK
00137         PULS    X
00138         LDX     #CRBLK  POINT TO BLOCK CREATION ROUTINE
00139         JMP     [,X++]  JUMP TO IT
00140 CREAT1  PULS    X
00141         LDX     #CRLIN  POINT TO TERMINAL CREATION ROUTINE
00142         JMP     [,X++]  JUMP TO IT
00143 CRBLK   FDB     COLON   BLOCK CREATION ROUTINE
00144         FDB     ZLOCKC
00145         FDB     CRTKB
00146         FDB     SEMI
00147 CRTKB   FDB     *+2
00148         PSHS    A,B,X
00149         PULU    A,B     GET BLOCK START ADDRESS
00150         STD     ZADDRH  SAVE IT
00151         ADDD    #1025   ADD BLOCK LENGTH+1
00152         STD     ZENDB   TO END-OF-BLOCK VARIABLE
00153         LDD     ZADDRH  GET BLOCK START ADDRESS AGAIN
00154         ADDD    TOINL   ADD PRESENT CHARACTER OFFSET
00155         PSHU    A,B     PUSH IT TO U-STACK
00156         JSR     ZOKENX  GO USE OUTER INTERPRETER ROUTINE
00157         PULU    A,B     GET TOKEN FLAG
00158         PULU    X       GET TOKEN POINTER
00159         CMPD    #0      FALSE FLAG? (TOKEN COUNT > 0?)
00160         BEQ     CRTKB1  GO IF YES
00161 CRERR   JMP     ZESTR3  ERROR RESTART
00162 CRTKB1  TFR     X,D     MOVE TOKEN POINTER TO D
00163         SUBD    ZADDRH  SUBTRACT BLOCK START ADDRESS
00164         STD     TOINL   STORE CHARACTER OFFSET
00165         PULS    A,B,X
00166         LDX     ,Y++
00167         JMP     [,X++]
00168 CRLIN   FDB     *+2     TERMINAL CREATION ROUTINE
00169         PSHS    A,B,X
00170         LDD     #ETIB   GET END OF TIB ADDRESS
00171         STD     ZENDB   TO END-OF-BLOCK VARIABLE
00172         LDD     #TIB    GET START OF TIB ADDRESS
00173         ADDD    TOINL   ADD CHARACTER OFFSET
00174         PSHU    A,B     PUSH IT TO U-STACK
 
 
 
 
 
 
 
 
00175         JSR     ZOKENX  GO USE OUTER INTERPRETER ROUTINE
00176         PULU    X       GET TOKEN FLAG
00177         PULU    A,B     GET TOKEN POINTER
00178         CMPX    #0      FALSE FLAG? (TOKEN COUNT > 0?)
00179         BNE     CRERR   GO IF NO
00180         SUBD    #TIB    SUBTRACT TIB START ADDRESS
00181         STD     TOINL   STORE CHARACTER OFFSET
00182         PULS    A,B,X
00183         LDX     ,Y++
00184         JMP     [,X++]
00185 CREATS  FDB     *+2
00186         PSHS    A,B,X,Y
00187         LDD     LAST    SET TEMP. DICTIONARY PARAMETERS
00188         STD     TLAST
00189         LDD     [CURENT] SET TEMP. DICTIONARY PARAMETER
00190         STD     TCUR
00191         STD     VAF26   SET TEMP. LAST WORD CFA
00192         LDY     DPDP
00193         STY     TDPDP
00194         LDX     TCUR    GET NFA OF PREVIOUS WORD
00195         LDB     ,X      GET PREVIOUS WORD TOKEN COUNT
00196         ABX             ADD TOKEN COUNT TO NFA
00197         LEAX    3,X     POINT TO FORWARDS LINK ADDRESS
00198         STY     ,X      STORE NEW FORWARDS LINK
00199         TFR     Y,X     MOVE DICTIONARY POINTER TO X
00200         LDB     ,X      GET NEW TOKEN'S COUNT
00201         CMPB    #32     IS IT WITHIN LIMIT?
00202         BLO     CREAT2  GO IF YES
00203         LDB     #31     SET MAXIMUM TOKEN LENGTH
00204         STB     ,X      STORE IT TO TOKEN COUNT
00205 CREAT2  ABX             ADD TOKEN COUNT TO DPDP
00206         LEAX    1,X     BUMP DPDP PAST TOKEN
00207         LDD     TCUR    LOAD BACKWARDS LINK ADDRESS
00208         STD     ,X++    STORE IT TO DICTIONARY
00209         CLRA            LOAD DUMMY FORWARDS LINK
00210         CLRB
00211         STD     ,X++    STORE IT TO DICTIONARY
00212         LDD     #CREATT LOAD RUN-TIME CODE ADDRESS
00213         STD     ,X++    STORE IT TO DICTIONARY
00214         STX     DPDP    STORE NEW DICTIONARY POINTER
00215         LDD     TDPDP
00216         STD     LAST    STORE NEW LAST
00217         STD     [CURENT] STORE NEW CURRENT LAST WORD ADDR
00218         STD     TCUR
00219         PSHS    A,B,X,Y
00220         LDY     #VAF01  GET FIRST POINTER ARRAY ENTRY
00221 CRTY1   CMPY    #VAF26  DONE?
00222         BHS     CRTY3   GO IF YES
00223         LDX     ,Y      GET ENTRY (FIRST WORD NFA)
00224         CMPX    #0      IS IT EMPTY?
00225         BEQ     CRTY3   GO IF YES
00226         LDB     ,X      GET CHARACTER COUNT
00227         ABX             BUMP PAST WORD NAME
00228         LEAX    1,X     POINT TO LFA
00229         LDD     ,X      GET LFA
00230         CMPD    VAF26   IS IT OLD CURRENT ADDRESS?
00231         BNE     CRTY2   GO IF NO
00232         LDD     [CURENT] GET NEW CURRENT ADDRESS
 
 
 
 
 
 
 
 
00233         STD     ,X      STORE IT TO LFA
00234 CRTY2   LEAY    4,Y     POINT TO NEXT ARRAY ENTRY
00235         BRA     CRTY1   RETURN FOR NEXT ENTRY
00236 CRTY3   PULS    A,B,X,Y
00237         PULS    A,B,X,Y
00238         LDX     ,Y++
00239         JMP     [,X++]
00240 CREATT  PSHU    X       RUN-TIME CODE
00241         LDX     ,Y++
00242         JMP     [,X++]
00243 COLN    FCB     1
00244         FCC     /:/
00245 COLL    FDB     CREATN
00246         FDB     SEMN
00247 COLC    FDB     COLON
00248 COLP    FDB     ZREATC
00249         FDB     COLR
00250         FDB     RBRKTC
00251         FDB     SEMI
00252 COLR    FDB     *+2
00253         PSHS    A,B,X
00254         LDX     DPDP    GET DICTIONARY POINTER
00255         LEAX    -2,X    BUMP IT BACK TWO BYTES
00256         LDD     #COLON  INNER INTERPRETER COLON ADDRESS
00257         STD     ,X      STORE IT TO DICTIONARY
00258         JSR     COLS
00259         PULS    A,B,X
00260         LDX     ,Y++
00261         JMP     [,X++]
00262 COLS    LDD     TLAST   UPDATE DICTIONARY PARAMETERS
00263         STD     LAST
00264         LDD     TCUR
00265         STD     [CURENT]
00266         RTS
00267 SEMN    FCB     129
00268         FCC     /;/
00269 SEML    FDB     COLN
00270         FDB     VARIAN
00271 SEMC    FDB     COLON
00272 SEMP    FDB     LBRKTC
00273         FDB     SEMR
00274         FDB     SEMI
00275 SEMR    FDB     *+2
00276         PSHS    A,B,X
00277         LDX     DPDP    GET DICTIONARY POINTER
00278         LDD     #SEMI   INNER INTERPRETER SEMI ADDRESS
00279         STD     ,X++    STORE IT TO DICTIONARY
00280         STX     DPDP    STORE NEW DICTIONARY POINTER
00281         JSR     SEMS
00282         LDX     DPDP    GET DICTIONARY POINTER AGAIN
00283         STX     TDPDP   COPY IT TO TEMPORARY DPDP
00284         PULS    A,B,X
00285         LDX     ,Y++
00286         JMP     [,X++]
00287 SEMS    LDD     TDPDP   UPDATE DICTIONARY PARAMETERS
00288         STD     LAST
00289         STD     TLAST
00290         STD     TCUR
 
 
 
 
 
 
 
 
00291         STD     [CURENT]
00292         RTS
00293 VARIAN  FCB     8
00294         FCC     /VARIABLE/
00295 VARIAL  FDB     SEMN
00296         FDB     CONSTN
00297 VARIAC  FDB     COLON
00298 VARIAP  FDB     ZREATC
00299         FDB     VARIAR
00300         FDB     SEMI
00301 VARIAR  FDB     *+2
00302         PSHS    A,B,X
00303         LDX     DPDP    GET DICTIONARY POINTER
00304         LDD     #0      CLEAR VARIABLE VALUE
00305         STD     ,X++    STORE IT TO DICTIONARY
00306         STX     DPDP    STORE NEW DICTIONARY POINTER
00307         STX     TDPDP   STORE NEW TEMPORARY DPDP
00308         PULS    A,B,X
00309         LDX     ,Y++
00310         JMP     [,X++]
00311 CONSTN  FCB     8
00312         FCC     /CONSTANT/
00313 CONSTL  FDB     VARIAN
00314         FDB     ZMMEDN
00315 CONSTC  FDB     COLON
00316 CONSTP  FDB     ZREATC
00317         FDB     CONSTR
00318         FDB     SEMI
00319 CONSTR  FDB     *+2
00320         PSHS    A,B,X
00321         LDX     DPDP    GET DICTIONARY POINTER  
00322         LEAX    -2,X    BUMP IT BACK TWO BYTES
00323         LDD     #CONSTT LOAD RUN-TIME CODE
00324         STD     ,X++    STORE IT TO DICTIONARY
00325         PULU    A,B     PULL CONSTANT VALUE FROM U-STACK
00326         STD     ,X++    STORE IT TO DICTIONARY
00327         STX     DPDP    STORE NEW DICTIONARY POINTER
00328         STX     TDPDP   STORE NEW TEMPORARY DPDP
00329         PULS    A,B,X
00330         LDX     ,Y++
00331         JMP     [,X++]
00332 CONSTT  PSHS    Y       RUN-TIME CODE
00333         LDY     ,X      GET CONSTANT VALUE FROM WORD
00334         PSHU    Y       PUSH IT TO U-STACK
00335         PULS    Y
00336         LDX     ,Y++
00337         JMP     [,X++]
00338 ZMMEDN  FCB     9
00339         FCC     /IMMEDIATE/
00340 IMMEDL  FDB     CONSTN
00341         FDB     ZEXITN
00342 IMMEDC  FDB     *+2
00343 IMMEDP  PSHS    A,X
00344         LDX     LAST    GET NFA OF WORD JUST DEFINED
00345         LDA     ,X      LOAD TOKEN COUNT
00346         ORA     #128    SET HIGH BIT
00347         STA     ,X      STORE REVISED TOKEN COUNT
00348         PULS    A,X
 
 
 
 
 
 
 
 
00349         LDX     ,Y++
00350         JMP     [,X++]
00351 ZEND    NOP
00352         END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
