00001 *************************
00002 *
00003 * START2.ASM
00004 * MDJ 08-22-91
00005 *
00006 * CF83 START ROUTINE
00007 *
00008 *************************
00009 *
00010 * MUST ALTER  ON
00011 * ==========  ==
00012 * START       ZESTR1
00013 * START       ZESTR2
00014 * OUTER       ZOKX
00015 * CF83COR3    ZESTR3
00016 * CF83COR4    ZESTR4
00017 * CF83COR5    ZESTR5
00018 * CF83COR6    ZESTR6
00019 * CF83COR7    ZESTR7
00020 *
00021 *************************
00022 *
00023 ZFREEN  EQU     $6DA2
00024 ZLASTN  EQU     $6C89
00025 ZBORTN  EQU     $5D3E
00026 ZQUITP  EQU     $5303
00027 DPDP    EQU     $1B
00028 TDPDP   EQU     $1D
00029 LAST    EQU     $1F
00030 TLAST   EQU     $21
00031 TCON    EQU     $25
00032 S0      EQU     $27
00033 TCUR    EQU     $29
00034 BLKL    EQU     $2B
00035 BB1A    EQU     $30
00036 BB2A    EQU     $32
00037 BB3A    EQU     $34
00038 BB4A    EQU     $36
00039 BB1B    EQU     $38
00040 BB2B    EQU     $3A
00041 BB3B    EQU     $3C
00042 BB4B    EQU     $3E
00043 BB1O    EQU     $40
00044 BB2O    EQU     $41
00045 BB3O    EQU     $42
00046 BB1U    EQU     $44
00047 BB2U    EQU     $45
00048 BB3U    EQU     $46
00049 BB4U    EQU     $47
00050 XCURS   EQU     $F3
00051 YCURS   EQU     $F5
00052 TOINL   EQU     $01D1
00053 VOCAB   EQU     $0989
00054 CONTXT  EQU     $098B
00055 CURENT  EQU     $098D
00056 SCHORD  EQU     $098F
00057 VAF00   EQU     $0991
00058 VAL00   EQU     $0993
 
 
 
 
 
 
 
 
00059 SINT    EQU     $5271
00060 LINE    EQU     $3EB5
00061 TYPF    EQU     $4F02
00062 TYPEF   EQU     $465F
00063 CRLFS   EQU     $4694
00064 DOTF    EQU     $4F46
00065 KEY     EQU     $5041
00066         ORG     $54D9
00067 START2  PSHS    A,B,X
00068         LDX     #DPDP   CLEAR VARIABLES SECTION ONE
00069 STARTA  CMPX    #$4F    DONE?
00070         BHS     STARTB  GO IF YES
00071         CLR     ,X+     CLEAR BYTE
00072         BRA     STARTA  RETURN FOR NEXT BYTE
00073 STARTB  LDX     #VOCAB  CLEAR VARIABLES SECTION TWO
00074 STARTC  CMPX    #$0A00  DONE?
00075         BHS     STARTD  GO IF YES
00076         CLR     ,X+     CLEAR BYTE
00077         BRA     STARTC  RETURN FOR NEXT BYTE
00078 STARTD  LDX     #ZFREEN START OF FREE DICTIONARY SPACE
00079         STX     DPDP    DICTIONARY POINTER
00080         STX     TDPDP   TEMPORARY DICTIONARY POINTER
00081         LDX     #ZLASTN NFA, LAST WORD, SYSTEM DICTIONARY
00082         STX     VAL00   FORTH DICTIONARY LAST WORD POINTER
00083         STX     LAST    LAST WORD POINTER
00084         STX     TLAST   TEMPORARY LAST WORD POINTER
00085         STX     TCUR    TEMPORARY CURENT
00086         STX     TCON    TEMPORARY CONTXT
00087         LDX     #VAF00  FIRST FORTH WORD POINTER ADDRESS
00088         STX     VOCAB   FIRST WORD INDIRECT POINTER
00089         LDX     #VAL00  LAST FORTH WORD POINTER ADDRESS
00090         STX     CURENT  INDIRECT CURRENT POINTER
00091         STX     CONTXT  INDIRECT CONTEXT POINTER
00092         STX     SCHORD  INDIRECT SEARCH ORDER POINTER
00093         LDX     #ZBORTN NFA OF FIRST FORTH WORD
00094         STX     VAF00   FIRST FORTH WORD POINTER
00095         LDX     #$0600  BOTTOM OF U-STACK
00096         STX     S0      PARAMETER STACK BOTTOM POINTER
00097         LDX     #$2200  SET BLOCK BUFFER ADDRESSES
00098         STX     BB1A
00099         LDX     #$2600
00100         STX     BB2A
00101         LDX     #$2A00
00102         STX     BB3A
00103         LDX     #$2E00
00104         STX     BB4A
00105         LDA     #1      INITIALIZE BLOCK ACCESS ORDER
00106         STA     BB3O
00107         INCA
00108         STA     BB2O
00109         INCA
00110         STA     BB3O
00111 LDINNR  LDX     #7      LOAD CF83 INNER INTERPRETER
00112         LDD     #$3420
00113         STD     ,X++
00114         LDD     #$1F12
00115         STD     ,X++
00116         LDD     #$2004
 
 
 
 
 
 
 
 
00117         STD     ,X++
00118         LDD     #$0F
00119         STD     ,X++
00120         LDD     #$3520
00121         STD     ,X++
00122         LDD     #$AEA1
00123         STD     ,X++
00124         LDD     #$6E91
00125         STD     ,X
00126         CLRA
00127         TFR     A,DP
00128         LBSR    FOSCR   GO DISPLAY OPENING SCREEN
00129         JSR     SINT    GO SET INTERRUPTS
00130         CLR     XCURS
00131         CLR     XCURS+1
00132         CLR     YCURS
00133         CLR     YCURS+1
00134         BSR     ZOKX    GO TYPE "OK" PROMPT
00135         PULS    A,B,X
00136         PSHS    X,Y
00137         BRA     PBB
00138 ZESTR1  LDB     #1      LOADING OF ERROR LOCATION CODES
00139         BRA     RESTRW
00140 ZESTR2  LDB     #2
00141         BRA     RESTRW
00142 ZESTR3  LDB     #3
00143         BRA     RESTRW
00144 ZESTR4  LDB     #4
00145         BRA     RESTRX
00146 ZESTR5  LDB     #5
00147         BRA     RESTRX
00148 ZESTR6  LDB     #6
00149         BRA     RESTRX
00150 ZESTR7  LDB     #7
00151         BRA     RESTRX
00152 RESTRW  CLR     BLKL    CLEAR BLOCK PARAMETERS
00153         CLR     BLKL+1
00154         CLR     TOINL
00155         CLR     TOINL+1
00156 RESTRX  JSR     CRLFS   PUT ERROR CODE TO SCREEN
00157         CLRA
00158         PSHU    A,B
00159         JSR     DOTF
00160         LDU     #$0600
00161         LDS     #$0800
00162         LDX     RMSGN   RESTART MESSAGE
00163         LDY     #RMSG
00164         JSR     TYPEF
00165         JSR     CRLFS
00166 PBB     LDX     #$FFFF  PRESET BLOCK BUFFERS
00167         STX     BB1B
00168         STX     BB2B
00169         STX     BB3B
00170         STX     BB4B
00171         CLR     BB1U
00172         CLR     BB2U
00173         CLR     BB3U
00174         CLR     BB4U
 
 
 
 
 
 
 
 
00175         JMP     ZQUITP
00176 RMSGN   FDB     20
00177 RMSG    FCC     'ERROR - CF83 Restart'
00178 ZOKX    PSHS    X,Y     PRIMITIVE "OK" PROMPT GENERATOR
00179         LDX     OKMSGN
00180         LDY     #OKMSG
00181         JSR     TYPEF
00182         PULS    X,Y
00183         RTS
00184 OKMSGN  FDB     3
00185 OKMSG   FCC     ' ok'
00186 *
00187 *************************
00188 *
00189 * FOSCR DISPLAYS THE
00190 * CF83 OPENING SCREEN
00191 *
00192 *************************
00193 *
00194 FOSCR   PSHS    X
00195         LDX     #9      DRAW OUTSIDE TOP BOX
00196         PSHU    X
00197         LDX     #157
00198         PSHU    X
00199         LDX     #9
00200         PSHU    X
00201         LDX     #97
00202         PSHU    X
00203         JSR     LINE
00204         LDX     #29
00205         PSHU    X
00206         LDX     #157
00207         PSHU    X
00208         LDX     #9
00209         PSHU    X
00210         LDX     #157
00211         PSHU    X
00212         JSR     LINE
00213         LDX     #29
00214         PSHU    X
00215         LDX     #97
00216         PSHU    X
00217         LDX     #29
00218         PSHU    X
00219         LDX     #157
00220         PSHU    X
00221         JSR     LINE
00222         LDX     #9
00223         PSHU    X
00224         LDX     #97
00225         PSHU    X
00226         LDX     #29
00227         PSHU    X
00228         LDX     #97
00229         PSHU    X
00230         JSR     LINE
00231         LDX     #11     DRAW INSIDE TOP BOX
00232         PSHU    X
 
 
 
 
 
 
 
 
00233         LDX     #155
00234         PSHU    X
00235         LDX     #11
00236         PSHU    X
00237         LDX     #99
00238         PSHU    X
00239         JSR     LINE
00240         LDX     #27
00241         PSHU    X
00242         LDX     #155
00243         PSHU    X
00244         LDX     #11
00245         PSHU    X
00246         LDX     #155
00247         PSHU    X
00248         JSR     LINE
00249         LDX     #27
00250         PSHU    X
00251         LDX     #99
00252         PSHU    X
00253         LDX     #27
00254         PSHU    X
00255         LDX     #155
00256         PSHU    X
00257         JSR     LINE
00258         LDX     #11
00259         PSHU    X
00260         LDX     #99
00261         PSHU    X
00262         LDX     #27
00263         PSHU    X
00264         LDX     #99
00265         PSHU    X
00266         JSR     LINE
00267         LDX     #108    TYPE SCREEN MESSAGES
00268         STX     XCURS   MESSAGE #1
00269         LDX     #16
00270         STX     YCURS
00271         LDX     #AM1
00272         PSHU    X
00273         LDX     AN1
00274         PSHU    X
00275         JSR     TYPF
00276         LDX     #88     MESSAGE #2
00277         STX     XCURS
00278         LDX     #40
00279         STX     YCURS
00280         LDX     #AM2
00281         PSHU    X
00282         LDX     AN2
00283         PSHU    X
00284         JSR     TYPF
00285         LDX     #88     MESSAGE #3
00286         STX     XCURS
00287         LDX     #48
00288         STX     YCURS
00289         LDX     #AM3
00290         PSHU    X
 
 
 
 
 
 
 
 
00291         LDX     AN3
00292         PSHU    X
00293         JSR     TYPF
00294         LDX     #104    MESSAGE #4
00295         STX     XCURS
00296         LDX     #56
00297         STX     YCURS
00298         LDX     #AM4
00299         PSHU    X
00300         LDX     AN4
00301         PSHU    X
00302         JSR     TYPF
00303         LDX     #104    MESSAGE #5
00304         STX     XCURS
00305         LDX     #64
00306         STX     YCURS
00307         LDX     #AM5
00308         PSHU    X
00309         LDX     AN5
00310         PSHU    X
00311         JSR     TYPF
00312         LDX     #80     MESSAGE #6
00313         STX     XCURS
00314         LDX     #72
00315         STX     YCURS
00316         LDX     #AM6
00317         PSHU    X
00318         LDX     AN6
00319         PSHU    X
00320         JSR     TYPF
00321         CLR     XCURS   MESSAGE #7
00322         CLR     XCURS+1
00323         LDX     #96
00324         STX     YCURS
00325         LDX     #AM7
00326         PSHU    X
00327         LDX     AN7
00328         PSHU    X
00329         JSR     TYPF
00330         CLR     XCURS   MESSAGE #8
00331         CLR     XCURS+1
00332         LDX     #104
00333         STX     YCURS
00334         LDX     #AM8
00335         PSHU    X
00336         LDX     AN8
00337         PSHU    X
00338         JSR     TYPF
00339         CLR     XCURS   MESSAGE #9
00340         CLR     XCURS+1
00341         LDX     #112
00342         STX     YCURS
00343         LDX     #AM9
00344         PSHU    X
00345         LDX     AN9
00346         PSHU    X
00347         JSR     TYPF
00348         LDX     #84     MESSAGE #A
 
 
 
 
 
 
 
 
00349         STX     XCURS
00350         LDX     #136
00351         STX     YCURS
00352         LDX     #AMA
00353         PSHU    X
00354         LDX     ANA
00355         PSHU    X
00356         JSR     TYPF
00357         LDX     #104    MESSAGE #B
00358         STX     XCURS
00359         LDX     #152
00360         STX     YCURS
00361         LDX     #AMB
00362         PSHU    X
00363         LDX     ANB
00364         PSHU    X
00365         JSR     TYPF
00366         LDX     #131    DRAW BOTTOM BOX
00367         PSHU    X
00368         LDX     #179
00369         PSHU    X
00370         LDX     #131
00371         PSHU    X
00372         LDX     #75
00373         PSHU    X
00374         JSR     LINE
00375         LDX     #163
00376         PSHU    X
00377         LDX     #179
00378         PSHU    X
00379         LDX     #131
00380         PSHU    X
00381         LDX     #179
00382         PSHU    X
00383         JSR     LINE
00384         LDX     #163
00385         PSHU    X
00386         LDX     #75
00387         PSHU    X
00388         LDX     #163
00389         PSHU    X
00390         LDX     #179
00391         PSHU    X
00392         JSR     LINE
00393         LDX     #131
00394         PSHU    X
00395         LDX     #75
00396         PSHU    X
00397         LDX     #163
00398         PSHU    X
00399         LDX     #75
00400         PSHU    X
00401         JSR     LINE
00402         CLR     XCURS   TYPE SCREEN MESSAGE #C
00403         CLR     XCURS+1
00404         LDX     #184
00405         STX     YCURS
00406         LDX     #AMC
 
 
 
 
 
 
 
 
00407         PSHU    X
00408         LDX     ANC
00409         PSHU    X
00410         JSR     TYPF
00411         JSR     KEY     WAIT FOR KEYPRESS
00412         PULU    X       CLEAN U-STACK
00413         PULS    X
00414         RTS
00415 AN1     FDB     10
00416 AM1     FCC     'CF83 Forth'
00417 AN2     FDB     20
00418 AM2     FCC     'Copyright  (c)  1991'
00419 AN3     FDB     20
00420 AM3     FCC     'by  M. David Johnson'
00421 AN4     FDB     12
00422 AM4     FCC     'BDS Software'
00423 AN5     FDB     12
00424 AM5     FCC     'P.O. Box 485'
00425 AN6     FDB     24
00426 AM6     FCC     'Glenview, IL  60025-0485'
00427 AN7     FDB     64
00428 AM7     FCC     'You may make as many copies of this program as you wish f
or your'
00429 AN8     FDB     64
00430 AM8     FCC     'own use,  but you may not sell or give away any copies to
 anyone'
00431 AN9     FDB     5
00432 AM9     FCC     'else.'
00433 ANA     FDB     22
00434 AMA     FCC     '"Thou shalt not steal"'
00435 ANB     FDB     12
00436 AMB     FCC     'Exodus 20:15'
00437 ANC     FDB     24
00438 AMC     FCC     'Press Any Key When Ready'
00439 ZEND    NOP
00440         END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
