00001 *************************
00002 *
00003 * CF83COR5.ASM
00004 * MDJ 06-13-91
00005 *
00006 * CF83 CORE WORDS
00007 * SET #5
00008 *
00009 * COMPILER LAYER WORDS
00010 * SECOND PART OF TWO
00011 *
00012 * INTERPRETER LAYER WORDS
00013 * SECOND PART OF TWO
00014 *
00015 *************************
00016 *
00017 * MUST ALTER  ON
00018 * ==========  ==
00019 * CF83COR4    ZIFN
00020 * CF83COR6    ZLOADN
00021 *
00022 *************************
00023 *
00024 ZOCABN  EQU     $6B96
00025 ZABTQN  EQU     $68F4
00026 COLON   EQU     $07
00027 SEMI    EQU     $0D
00028 DPDP    EQU     $1B
00029 TDPDP   EQU     $1D
00030 BLKL    EQU     $2B
00031 MODE    EQU     $2E
00032 TOINL   EQU     $01D1
00033 ZITERT  EQU     $5328
00034 ZLOCKC  EQU     $5336
00035 ZESTR5  EQU     $5592
00036 ZERCHC  EQU     $59D7
00037 ZOUTL   EQU     $5BFC
00038 ZEXCLC  EQU     $5DA6
00039 ZEQC    EQU     $5EAE
00040 ZNEPLC  EQU     $5ECE
00041 ZWOPLC  EQU     $5EEE
00042 ZCMVC   EQU     $5FE4
00043 ZCNTC   EQU     $6020
00044 ZDROPC  EQU     $609F
00045 ZDUPC   EQU     $60B0
00046 ZSWAPC  EQU     $6232
00047 ZHEREC  EQU     $6421
00048 ZOMMAC  EQU     $6477
00049 ZTICKR  EQU     $6711
00050 ZCMPLC  EQU     $6779
00051         ORG     $6928
00052 ZIFN    FCB     130
00053         FCC     /IF/
00054 IFL     FDB     ZABTQN
00055         FDB     THENN
00056 IFC     FDB     COLON
00057 IFP     FDB     ZCMPLC  COMPILE
00058         FDB     ZQBRA   BRANCH DECISION ROUTINE
 
 
 
 
 
 
 
 
00059         FDB     ZFMARK  COMPILE FORWARD JUMP CELL
00060         FDB     SEMI
00061 ZQBRA   FDB     *+2     BRANCH DECISION ENTRY
00062         PSHS    X
00063         PULU    X
00064         CMPX    #0      FALSE FLAG? (DO FORWARD JUMP?)
00065         BEQ     QBRA1   GO IF YES
00066         LEAY    2,Y     BUMP INNER POINTER TO "IF" WORDS
00067         BRA     QBRA2
00068 ZDBRA   FDB     *+2     UNCONDITIONAL BRANCH ENTRY
00069         PSHS    X
00070 QBRA1   LDX     ,Y      LOAD JUMP CELL ADDRESS
00071         TFR     X,Y     POINT TO JUMP ADDRESS
00072 QBRA2   PULS    X
00073         LDX     ,Y++
00074         JMP     [,X++]
00075 ZFMARK  FDB     COLON   MARK FORWARD JUMP CELL
00076         FDB     ZHEREC  PUSH JUMP CELL ADDRESS TO STACK
00077         FDB     ZDUPC   DUPLICATE IT
00078         FDB     ZOMMAC  DUMMY THE JUMP CELL
00079         FDB     SEMI
00080 THENN   FCB     132
00081         FCC     /THEN/
00082 THENL   FDB     ZIFN
00083         FDB     ELSEN
00084 THENC   FDB     COLON
00085 THENP   FDB     ZFRES   FORWARD JUMP ADDRESS TO JUMP CELL
00086         FDB     SEMI
00087 ZFRES   FDB     COLON   RESOLVE FORWARD JUMP CELL
00088         FDB     ZHEREC  PUSH FWD JMP CELL ADDR TO STACK
00089         FDB     ZSWAPC  SWAP WITH JUMP CELL ADDRESS
00090         FDB     ZEXCLC  STORE JUMP ADDRESS TO JUMP CELL
00091         FDB     SEMI
00092 ELSEN   FCB     132
00093         FCC     /ELSE/
00094 ELSEL   FDB     THENN
00095         FDB     DON
00096 ELSEC   FDB     COLON
00097 ELSEP   FDB     ZCMPLC  COMPILE
00098         FDB     ZDBRA   UNCONDITIONAL BRANCH ROUTINE
00099         FDB     ZFMARK  COMPILE FORWARD JUMP CELL
00100         FDB     ZSWAPC  SWAP WITH "IF" CELL ADDRESS
00101         FDB     ZFRES   FORWARD JUMP ADDRESS TO "IF" CELL
00102         FDB     SEMI
00103 DON     FCB     130
00104         FCC     /DO/
00105 DOL     FDB     ELSEN
00106         FDB     LOOPN
00107 DOC     FDB     COLON
00108 DOP     FDB     ZCMPLC
00109         FDB     DOR
00110         FDB     ZFMARK
00111         FDB     SEMI
00112 DOR     FDB     *+2
00113         PSHS    A,B     MAKE ROOM FOR "LEAVE" ADDRESS
00114         PSHS    A,B     MAKE ROOM FOR OFFSET LIMIT
00115         PSHS    A,B     MAKE ROOM FOR SCANNING INDEX
00116         PSHS    A,B,X
 
 
 
 
 
 
 
 
00117         LDX     ,Y      "LEAVE" ADDRESS
00118         STX     8,S
00119         PULU    X       INDEX
00120         PULU    A,B     LIMIT
00121         ADDD    #$8000  OFFSET
00122         STD     6,S     OFFSET LIMIT
00123         TFR     X,D     MOVE INDEX TO D
00124         SUBD    6,S     SUBTRACT OFFSET LIMIT
00125         STD     4,S     SCANNING INDEX  
00126         LEAY    2,Y     POINT TO "DO" LIST
00127         PULS    A,B,X
00128         LDX     ,Y++
00129         JMP     [,X++]
00130 LOOPN   FCB     132
00131         FCC     /LOOP/
00132 LOOPL   FDB     DON
00133         FDB     PLOOPN
00134 LOOPC   FDB     COLON
00135 LOOPP   FDB     ZCMPLC
00136         FDB     LOOPR
00137         FDB     ZDUPC
00138         FDB     ZWOPLC
00139         FDB     ZBRES
00140         FDB     ZFRES
00141         FDB     SEMI
00142 PLOOPR  FDB     *+2
00143         PSHS    A,B,X
00144         LDD     4,S     SCANNING INDEX
00145         ADDD    ,U      ADD +LOOP INCREMENT
00146         PSHS    CC      SAVE CONDITION CODES
00147         PULU    X       DROP INCREMENT
00148         BRA     LOOPRT
00149 LOOPR   FDB     *+2
00150         PSHS    A,B,X
00151         LDD     4,S     SCANNING INDEX
00152         ADDD    #1      INCREMENT
00153         PSHS    CC      SAVE CONDITION CODES
00154 LOOPRT  STD     5,S     SCANNING INDEX BACK TO RTN STACK
00155         PULS    CC      RESTORE CONDITION CODES
00156         BVC     LOOPR1  BRANCH IF NO OVERFLOW
00157         PULS    A,B,X
00158         LEAS    6,S     DROP SCANNING INDEX, OFFSET,
00159 *                         LIMIT, AND LEAVE ADDRESS
00160         LEAY    2,Y     POINT TO NEXT INSTRUCTION
00161         BRA     LOOPR2
00162 LOOPR1  LDX     ,Y      POINT BACK TO "DO" LIST
00163         TFR     X,Y
00164         PULS    A,B,X
00165 LOOPR2  LDX     ,Y++
00166         JMP     [,X++]
00167 ZBRES   FDB     COLON
00168         FDB     ZOMMAC  STORE BACKWARD BRANCH ADDRESS
00169         FDB     SEMI
00170 PLOOPN  FCB     133
00171         FCC     /+LOOP/
00172 PLOOPL  FDB     LOOPN
00173         FDB     LEAVEN
00174 PLOOPC  FDB     COLON
 
 
 
 
 
 
 
 
00175 PLOOPP  FDB     ZCMPLC
00176         FDB     PLOOPR
00177         FDB     ZDUPC
00178         FDB     ZWOPLC
00179         FDB     ZBRES
00180         FDB     ZFRES
00181         FDB     SEMI
00182 LEAVEN  FCB     133
00183         FCC     /LEAVE/
00184 LEAVEL  FDB     PLOOPN
00185         FDB     BEGINN
00186 LEAVEC  FDB     COLON
00187 LEAVEP  FDB     ZCMPLC
00188         FDB     LEAVER
00189         FDB     SEMI
00190 LEAVER  FDB     *+2
00191         PSHU    X
00192         PULS    X       DROP SCANNING INDEX
00193         PULS    X       DROP OFFSET LIMIT
00194         PULS    Y       GET "LEAVE" ADDRESS
00195         PULU    X
00196         LDX     ,Y++
00197         JMP     [,X++]
00198 BEGINN  FCB     133
00199         FCC     /BEGIN/
00200 BEGINL  FDB     LEAVEN
00201         FDB     UNTILN
00202 ZEGINC  FDB     COLON
00203 BEGINP  FDB     ZBMARK
00204         FDB     SEMI
00205 ZBMARK  FDB     COLON
00206         FDB     ZHEREC
00207         FDB     SEMI
00208 UNTILN  FCB     133
00209         FCC     /UNTIL/
00210 UNTILL  FDB     BEGINN
00211         FDB     WHILEN
00212 UNTILC  FDB     COLON
00213 UNTILP  FDB     ZCMPLC
00214         FDB     ZQBRA
00215         FDB     ZBRES
00216         FDB     SEMI
00217 WHILEN  FCB     133
00218         FCC     /WHILE/
00219 WHILEL  FDB     UNTILN
00220         FDB     REPETN
00221 WHILEC  FDB     COLON
00222 WHILEP  FDB     ZCMPLC
00223         FDB     ZQBRA
00224         FDB     ZFMARK
00225         FDB     SEMI
00226 REPETN  FCB     134
00227         FCC     /REPEAT/
00228 REPETL  FDB     WHILEN
00229         FDB     FINDN
00230 REPETC  FDB     COLON
00231 REPETP  FDB     ZSWAPC
00232         FDB     ZCMPLC
 
 
 
 
 
 
 
 
00233         FDB     ZDBRA
00234         FDB     ZBRES
00235         FDB     ZFRES
00236         FDB     SEMI
00237 FINDN   FCB     4
00238         FCC     /FIND/
00239 FINDL   FDB     REPETN
00240         FDB     DOESTN
00241 FINDC   FDB     COLON
00242 FINDP   FDB     ZDUPC
00243         FDB     ZDUPC
00244         FDB     ZCNTC
00245         FDB     ZNEPLC
00246         FDB     ZSWAPC
00247         FDB     ZDROPC
00248         FDB     ZHEREC
00249         FDB     ZSWAPC
00250         FDB     ZCMVC
00251         FDB     ZTICKR
00252         FDB     ZERCHC
00253         FDB     ZQBRA
00254         FDB     FIND1
00255         FDB     ZITERT
00256         FDB     0
00257         FDB     SEMI
00258 FIND1   FDB     ZSWAPC
00259         FDB     ZDROPC
00260         FDB     MODECK
00261         FDB     SEMI
00262 MODECK  FDB     *+2
00263         PSHS    A,X
00264         LDA     MODE
00265         CMPA    #0      NOT IMMEDIATE MODE?
00266         BEQ     MODCK1  GO IF YES
00267         LDX     #1      "IMMEDIATE" FLAG n
00268         BRA     MODCK2
00269 MODCK1  LDX     #$FFFF  "NOT IMMEDIATE" FLAG n
00270 MODCK2  PSHU    X
00271         CLR     MODE
00272         PULS    A,X
00273         LDX     ,Y++
00274         JMP     [,X++]
00275 DOESTN  FCB     133
00276         FCC     /DOES>/
00277 DOESTL  FDB     FINDN
00278         FDB     ZLOADN
00279 DOESTC  FDB     *+2
00280 DOESTP  PSHS    A,B,X
00281         LDX     DPDP    PRESENT DICTIONARY POINTER
00282         LDD     #DOCMP  POINT TO COMPILE-TIME CODE
00283         STD     ,X++    STORE TO DICTIONARY
00284         LDD     #SEMI   POINT TO "SEMI" ADDRESS
00285         STD     ,X++    STORE TO DICTIONARY
00286         LDD     #$3610  CODE FOR "PSHU X" (PFA TO STACK)
00287         STD     ,X++    STORE TO DICTIONARY
00288         LDD     #$3420  "PSHU Y" CODE (ARTIFICIAL COLON)
00289         STD     ,X++    STORE TO DICTIONARY
00290         LDD     #$108E  CODE FOR "LDY"
 
 
 
 
 
 
 
 
00291         STD     ,X++    STORE TO DICTIONARY
00292         TFR     X,D     COPY POINTER TO D
00293         ADDD    #6      POINT PAST JUMP
00294         STD     ,X++    STORE TO DICTIONARY
00295         LDD     #$AEA1  CODE FOR "LDX ,Y++"
00296         STD     ,X++    STORE TO DICTIONARY
00297         LDD     #$6E91  CODE FOR "JMP [,X++]"
00298         STD     ,X++    STORE TO DICTIONARY
00299         STX     DPDP    STORE NEW DICTIONARY POINTER
00300         PULS    A,B,X
00301         LDX     ,Y++
00302         JMP     [,X++]
00303 DOCMP   FDB     *+2     COMPILE-TIME CODE
00304         PSHS    A,B,X
00305         LDX     TDPDP   GET OLD DICTIONARY POINTER
00306         LDB     [TDPDP] GET CHARACTER COUNT
00307         ABX
00308         LEAX    5,X     POINT TO CFA
00309         TFR     Y,D     COPY RUN POINTER TO D
00310         ADDD    #2      POINT TO RUN-TIME CODE
00311 *                         ("PFA TO STACK" ABOVE)
00312         STD     ,X      RUN-TIME ADDRESS TO CFA
00313         PULS    A,B,X
00314         LDX     ,Y++
00315         JMP     [,X++]
00316 ZLOADN  FCB     4
00317         FCC     /LOAD/
00318 LOADL   FDB     DOESTN
00319         FDB     ZOCABN
00320 LOADC   FDB     COLON
00321 LOADP   FDB     ZDUPC
00322         FDB     ZEQC
00323         FDB     ZQBRA   BRANCH IF FLAG = 0
00324         FDB     LOAD1   BRANCH CELL LOCATION
00325         FDB     LOADE   ERROR ROUTINE
00326 LOAD1   FDB     LOADR   LOAD ROUTINE
00327         FDB     SEMI
00328 LOADE   FDB     *+2
00329         JMP     ZESTR5  ERROR RESTART
00330 LOADR   FDB     *+2
00331         PSHS    A,B,X
00332         PULU    A,B     GET NEW BLOCK # FROM U-STACK
00333         LDX     BLKL    LOAD OLD BLOCK NUMBER
00334         PSHU    X
00335         LDX     TOINL   LOAD OLD OFFSET
00336         PSHU    X
00337         PSHU    Y       NEXT INSTRUCTION ADDRESS #
00338         STD     BLKL    STORE NEW BLOCK NUMBER
00339         CLR     TOINL
00340         CLR     TOINL+1 NEW OFFSET = 0
00341         PULS    A,B,X
00342         LDY     #ZOUTL
00343         LDX     ,Y++
00344         JMP     [,X++]
00345 ZEND    NOP
00346         END
 
 
 
 
 
 
 
 
 
 
