OPT PRT * fig-FORTH FOR 6800 * ASSEMBLY SOURCE LISTING * RELEASE 1 * MAY 1979 * WITH COMPILER SECURITY * AND VARIABLE LENGTH NAMES * This public domain publication is provided * through the courtesy of: * FORTH * INTEREST * GROUP * fig * P.O. Box 8231 - San Jose, CA 95155 - (408) 277-0668 * Further distribution must include this notice. PAGE NAM Copyright:FORTH Interest Group OPT NOG,PAG * filename FTH7.21 * === FORTH-6800 06-06-79 21:OO * This listing is in the PUBLIC DOMAIN and * may be freely copied or published with the * restriction that a credit line is printed * with the material, crediting the * authors and the FORTH INTEREST GROUP. * === by Dave Lion, * === with help from * === Bob Smith, * === LaFarr Stuart, * === The Forth Interest Group * === PO Box 1105 * === San Carlos, CA 94070 * === and * === Unbounded Computing * === 1134-K Aster Ave. * === Sunnyvale, CA 94086 * * This version was developed on an AMI EVK 300 PROTO * system using an ACIA for the I/O. All terminal 1/0 * is done in three subroutines: * PEMIT ( word # 182 ) * PKEY ( 183 ) * PQTERM ( 184 ) * * The FORTH words for disc related I/O follow the model * of the FORTH Interest Group, but have not been * tested using a real disc. * * Addresses in this implementation reflect the fact that, * on the development system, it was convenient to * write-protect memory at hex 1000, and leave the first * 4K bytes write-enabled. As a consequence, code from * location $1000 to lable ZZZZ could be put in ROM. * Minor deviations from the model were made in the * initialization and words ?STACK and FORGET * in order to do this. * * NBLK EQU 4 # of disc buffer blocks for virtual memory MEMEND EQU 132*NBLK+$3000 end of ram * each block is 132 bytes in size, * holding 128 characters * MEMTOP EQU $3FFF absolute end of all ram ACIAC EQU $FBCE the ACIA control address and ACIAD EQU ACIAC+1 data address for PROTO PAGE * MEMORY MAP for this 16K system: * ( positioned so that systems with 4k byte write- * protected segments can write protect FORTH ) * * addr. contents pointer init by * **** ******************************* ******* ****** * 3FFF HI * substitute for disc mass memory * 3210 LO,MEMEND * 320F * 4 buffer sectors of VIRTUAL MEMORY * 3000 FIRST * >>>>>> memory from here up must be RAM <<<<<< * * 27FF * 6k of romable "FORTH" <== IP ABORT * <== W * the VIRTUAL FORTH MACHINE * * 1004 <<< WARM START ENTRY >>> * 1000 <<< COLD START ENTRY >>> * * >>>>>> memory from here down must be RAM <<<<<< * FFE RETURN STACK base <== RP RINIT * * FB4 * INPUT LINE BUFFER * holds up to 132 characters * and is scanned upward by IN * starting at TIB * F30 <== IN TIB * F2F DATA STACK <== SP SP0,SINIT * | grows downward from F2F * v * - - * | * I DICTIONARY grows upward * * 183 end of ram-dictionary. <== DP DPINIT * "TASK" * * 150 "FORTH" ( a word ) <=, <== CONTEXT * `==== CURRENT * 148 start of ram-dictionary. * * 100 user #l table of variables <= UP DPINIT * F0 registers & pointers for the virtual machine * scratch area used by various words * E0 lowest address used by FORTH * * 0000 PAGE *** * * CONVENTIONS USED IN THIS PROGRAM ARE AS FOLLOWS : * * IP points to the current instruction ( pre-increment mode ) * RP points to second free byte (first free word) in return stack * SP (hardware SP) points to first free byte in data stack * * when A and B hold one 16 bit FORTH data word, * A contains the high byte, B, the low byte. *** ORG $E0 variables N RMB 10 used as scratch by (FIND),ENCLOSE,CMOVE,EMIT,KEY, * SP@,SWAP,DOES>,COLD * These locations are used by the TRACE routine : TRLIM RMB 1 the count for tracing without user intervention TRACEM RMB 1 non-zero = trace mode BRKPT RMB 2 the breakpoint address at which * the program will go into trace mode VECT RMB 2 vector to machine code * (only needed if the TRACE routine is resident) * Registers used by the FORTH virtual machine: * Starting at $OOFO: W RMB 2 the instruction register points to 6800 code IP RMB 2 the instruction pointer points to pointer to 6800 code RP RMB 2 the return stack pointer UP RMB 2 the pointer to base of current user's 'USER' table * ( altered during multi-tasking ) * PAGE * This system is shown with one user, but additional users * may be added by allocating additional user tables: * UORIG2 RMB 64 data table for user #2 * * * Some of this stuff gets initialized during * COLD start and WARM start: * [ names correspond to FORTH words of similar (no X) name ] * ORG $100 UORIG RMB 6 3 reserved variables XSPZER RMB 2 initial top of data stack for this user XRZERO RMB 2 initial top of return stack XTIB RMB 2 start of terminal input buffer XWIDTH RMB 2 name field width XWARN RMB 2 warning message mode (0 = no disc) XFENCE RMB 2 fence for FORGET XDP RMB 2 dictionary pointer XVOCL RMB 2 vocabulary linking XBLK RMB 2 disc block being accessed XIN RMB 2 scan pointer into the block XOUT RMB 2 cursor position XSCR RMB 2 disc screen being accessed ( O=terminal ) XOFSET RMB 2 disc sector offset for multi-disc XCONT RMB 2 last word in primary search vocabulary XCURR RMB 2 last word in extensible vocabulary XSTATE RMB 2 flag for 'interpret' or 'compile' modes XBASE RMB 2 number base for I/O numeric conversion XDPL RMB 2 decimal point place XFLD RMB 2 XCSP RMB 2 current stack position, for compile checks XRNUM RMB 2 XHLD RMB 2 XDELAY RMB 2 carriage return delay count XCOLUM RMB 2 carriage width IOSTAT RMB 2 last acia status from write/read RMB 2 ( 4 spares! ) RMB 2 RMB 2 RMB 2 * * * end of user table, start of common system variables * * * XUSE RMB 2 XPREV RMB 2 RMB 4 ( spares ) PAGE * These things, up through the lable 'REND', are overwritten * at time of cold load and should have the same contents * as shown here: * FCB $C5 immediate FCC 'FORT' ; 'FORTH' FCB $C8 FDB NOOP-7 FORTH FDB DODOES,DOVOC,$81A0,TASK-7 FDB 0 * FCC "(C) Forth Interest Group, 1979" FCB $84 FCC 'TAS' ; 'TASK' FCB $CB FDB FORTH-8 TASK FDB DOCOL,SEMIS * REND EQU * ( first empty location in dictionary ) PAGE * The FORTH program ( address $1000 to $27FF ) is written * so that it can be in a ROM, or write-protected if desired ORG $1000 * ######>> screen 3 << * *************************** ** C O L D E N T R Y ** *************************** ORIG NOP JMP CENT *************************** ** W A R M E N T R Y ** *************************** NOP JMP WENT warm-start code, keeps current dictionary intact * ******* startup parmeters ************************** * FDB $6800,0000 cpu & revision FDB 0 topmost word in FORTH vocabulary BACKSP FDB $7F backspace character for editing UPINIT FDB UORIG initial user area SINIT FDB ORIG-$D0 initial top of data stack RINIT FDB ORIG-2 initial top of return stack FDB ORIG-$D0 terminal input buffer FDB 31 initial name field width FDB 0 initial warning mode (0 = no disc) FENCIN FDB REND initial fence DPINIT FDB REND cold start value for DP VOCINT FDB FORTH+8 COLINT FDB 132 initial terminal carriage width DELINT FDB 4 initial carriage return delay **************************************************** * PAGE * * ######>> screen 13 << PULABX PULS A ; 24 cycles until 'NEXT' PULS B ; STABX STA 0,X 16 cycles until 'NEXT' STB 1,X BRA NEXT GETX LDA 0,X 18 cycles until 'NEXT' LDB 1,X PUSHBA PSHS B ; 8 cycles until 'NEXT' PSHS A ; * * "NEXT" takes 38 cycles if TRACE is removed, * * and 95 cycles if NOT tracing. * * = = = = = = = t h e v i r t u a l m a c h i n e = = = = = * = NEXT LDX IP LEAX 1,X ; pre-increment mode LEAX 1,X ; STX IP NEXT2 LDX 0,X get W which points to CFA of word to be done NEXT3 STX W LDX 0,X get VECT which points to executable code * = * The next instruction could be patched to JMP TRACE = * if a TRACE routine is available: = * = JMP 0,X NOP * JMP TRACE ( an alternate for the above ) * = * = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = PAGE * * ======>> 1 << FCB $83 FCC 'LI' ; 'LIT' : NOTE: this is different from LITERAL FCB $D4 FDB 0 link of zero to terminate dictionary scan LIT FDB *+2 LDX IP LEAX 1,X ; LEAX 1,X ; STX IP LDA 0,X LDB 1,X JMP PUSHBA * * ######>> screen 14 << * ======>> 2 << CLITER FDB *+2 (this is an invisible word, with no header) LDX IP LEAX 1,X ; STX IP CLRA ; LDB 1,X JMP PUSHBA * * ======>> 3 << FCB $87 FCC 'EXECUT' ; 'EXECUTE' FCB $C5 FDB LIT-6 EXEC FDB *+2 TFR S,X ; TSX : LDX 0,X get code field address (CFA) LEAS 1,S ; pop stack LEAS 1,S ; JMP NEXT3 * * ######>> screen 15 << * ======>> 4 << FCB $86 FCC 'BRANC' ; 'BRANCH' FCB $C8 FDB EXEC-10 BRAN FDB ZBYES Go steal code in ZBRANCH * * ======>> 5 << FCB $87 FCC '0BRANC' ; '0BRANCH' FCB $C8 FDB BRAN-9 ZBRAN FDB *+2 PULS A ; PULS B ; PSHS B ; ** emulating ABA: ADDA ,S+ ; BNE ZBNO BCS ZBNO ZBYES LDX IP Note: code is shared with BRANCH, (+LOOP), (LOOP) LDB 3,X LDA 2,X ADDB IP+1 ADCA IP STB IP+1 STA IP JMP NEXT ZBNO LDX IP no branch. This code is shared with (+LOOP), (LOOP). LEAX 1,X ; jump over branch delta LEAX 1,X ; STX IP JMP NEXT * * ######>> screen 16 << * ======>> 6 << FCB $86 FCC '(LOOP' ; '(LOOP)' FCB $A9 FDB ZBRAN-10 XLOOP FDB *+2 CLRA ; LDB #1 get set to increment counter by 1 BRA XPLOP2 go steal other guy's code! * * ======>> 7 << FCB $87 FCC '(+LOOP' ; '(+LOOP)' FCB $A9 FDB XLOOP-9 XPLOOP FDB *+2 Note: +LOOP has an un-signed loop counter PULS A ; get increment PULS B ; XPLOP2 TSTA ; BPL XPLOF forward looping BSR XPLOPS ORCC #$01 ; SEC : SBCB 5,X SBCA 4,X BPL ZBYES BRA XPLONO fall through * * the subroutine : XPLOPS LDX RP ADDB 3,X add it to counter ADCA 2,X STB 3,X store new counter value STA 2,X RTS * XPLOF BSR XPLOPS SUBB 5,X SBCA 4,X BMI ZBYES * XPLONO LEAX 1,X ; done, don't branch back LEAX 1,X ; LEAX 1,X ; LEAX 1,X ; STX RP BRA ZBNO use ZBRAN to skip over unused delta * * ######>> screen 17 << * ======>> 8 << FCB $84 FCC '(DO' ; '(DO)' FCB $A9 FDB XPLOOP-10 XDO FDB *+2 This is the RUNTIME DO, not the COMPILING DO LDX RP LEAX -1,X ; LEAX -1,X ; LEAX -1,X ; LEAX -1,X ; STX RP PULS A ; PULS B ; STA 2,X STB 3,X PULS A ; PULS B ; STA 4,X STB 5,X JMP NEXT * * ======>> 9 << FCB $81 I FCB $C9 FDB XDO-7 I FDB *+2 LDX RP LEAX 1,X ; LEAX 1,X ; JMP GETX * * ######>> screen 18 << * ======>> 10 << FCB $85 FCC 'DIGI' ; 'DIGIT' FCB $D4 FDB I-4 DIGIT FDB *+2 NOTE: legal input range is 0-9, A-Z TFR S,X ; TSX : LDA 3,X SUBA #$30 ascii zero BMI DIGIT2 IF LESS THAN '0', ILLEGAL CMPA #$A BMI DIGIT0 IF '9' OR LESS CMPA #$11 BMI DIGIT2 if less than 'A' CMPA #$2B BPL DIGIT2 if greater than 'Z' SUBA #7 translate 'A' thru 'F' DIGIT0 CMPA 1,X BPL DIGIT2 if not less than the base LDB #1 set flag STA 3,X store digit DIGIT1 STB 1,X store the flag JMP NEXT DIGIT2 CLRB ; LEAS 1,S ; LEAS 1,S ; pop bottom number TFR S,X ; TSX : STB 0,X make sure both bytes are 00 BRA DIGIT1 * * ######>> screen 19 << * * The word format in the dictionary is: * * char-count + $80 lowest address * char 1 * char 2 * * char n + $80 * link high byte \___point to previous word * link low byte / * CFA high byte \___pnt to 6800 code * CFA low byte / * parameter fields * " * " * " * * ======>> 11 << FCB $86 FCC '(FIND' ; '(FIND)' FCB $A9 FDB DIGIT-8 PFIND FDB *+2 NOP NOP PD EQU N ptr to dict word being checked PA0 EQU N+2 PA EQU N+4 PC EQU N+6 LDX #PD LDB #4 PFIND0 PULS A ; loop to get arguments STA 0,X LEAX 1,X ; DECB ; BNE PFIND0 * LDX PD PFIND1 LDB 0,X get count dict count STB PC ANDB #$3F LEAX 1,X ; STX PD update PD LDX PA0 LDA 0,X get count from arg LEAX 1,X ; STX PA intialize PA PSHS B ; ** emulating CBA: CMPA ,S+ ; compare lengths BNE PFIND4 PFIND2 LDX PA LDA 0,X LEAX 1,X ; STX PA LDX PD LDB 0,X LEAX 1,X ; STX PD TSTB ; is dict entry neg. ? BPL PFIND8 ANDB #$7F clear sign PSHS B ; ** emulating CBA: CMPA ,S+ ; BEQ FOUND PFIND3 LDX 0,X get new link BNE PFIND1 continue if link not=0 * * not found : * CLRA ; CLRB ; JMP PUSHBA PFIND8 PSHS B ; ** emulating CBA: CMPA ,S+ ; BEQ PFIND2 PFIND4 LDX PD PFIND9 LDB 0,X scan forward to end of this name LEAX 1,X ; BPL PFIND9 BRA PFIND3 * * found : * FOUND LDA PD compute CFA LDB PD+1 ADDB #4 ADCA #0 PSHS B ; PSHS A ; LDA PC PSHS A ; CLRA ; PSHS A ; LDB #1 JMP PUSHBA * PSHS A ; CLRA ; PSHS A ; LDB #1 JMP PUSHBA * * ######>> screen 20 << * ======>> 12 << FCB $87 FCC 'ENCLOS' ; 'ENCLOSE' FCB $C5 FDB PFIND-9 * NOTE : * FC means offset (bytes) to First Character of next word * EW " " to End of Word * NC " " to Next Character to start next enclose at ENCLOS FDB *+2 LEAS 1,S ; PULS B ; now, get the low byte, for an 8-bit delimiter TFR S,X ; TSX : LDX 0,X CLR N * wait for a non-delimiter or a NUL ENCL2 LDA 0,X BEQ ENCL6 PSHS B ; ** emulating CBA: CMPA ,S+ ; CHECK FOR DELIM BNE ENCL3 LEAX 1,X ; INC N BRA ENCL2 * found first character. Push FC ENCL3 LDA N found first char. PSHS A ; CLRA ; PSHS A ; * wait for a delimiter or a NUL ENCL4 LDA 0,X BEQ ENCL7 PSHS B ; ** emulating CBA: CMPA ,S+ ; ckech for delim. BEQ ENCL5 LEAX 1,X ; INC N BRA ENCL4 * found EW. Push it ENCL5 LDB N CLRA ; PSHS B ; PSHS A ; * advance and push NC INCB ; JMP PUSHBA * found NUL before non-delimiter, therefore there is no word ENCL6 LDB N found NUL PSHS B ; PSHS A ; INCB ; BRA ENCL7+2 * found NUL following the word instead of SPACE ENCL7 LDB N PSHS B ; save EW PSHS A ; ENCL8 LDB N save NC JMP PUSHBA PAGE * * ######>> screen 21 << * The next 4 words call system dependant I/O routines * which are listed after word "-->" ( lable: "arrow" ) * in the dictionary. * * ======>> 13 << FCB $84 FCC 'EMI' ; 'EMIT' FCB $D4 FDB ENCLOS-10 EMIT FDB *+2 PULS A ; PULS A ; JSR PEMIT LDX UP INC XOUT+1-UORIG,X BNE *+4 ; ****WARNING**** HARD OFFSET: *+4 **** INC XOUT-UORIG,X JMP NEXT * * ======>> 14 << FCB $83 FCC 'KE' ; 'KEY' FCB $D9 FDB EMIT-7 KEY FDB *+2 JSR PKEY PSHS A ; CLRA ; PSHS A ; JMP NEXT * * ======>> 15 << FCB $89 FCC '?TERMINA' ; '?TERMINAL' FCB $CC FDB KEY-6 QTERM FDB *+2 JSR PQTER CLRB ; JMP PUSHBA stack the flag * * ======>> 16 << FCB $82 FCC 'C' ; 'CR' FCB $D2 FDB QTERM-12 CR FDB *+2 JSR PCR JMP NEXT * * ######>> screen 22 << * ======>> 17 << FCB $85 FCC 'CMOV' ; 'CMOVE' : source, destination, count FCB $C5 FDB CR-5 CMOVE FDB *+2 takes ( 43+47*count cycles ) LDX #N LDB #6 CMOV1 PULS A ; STA 0,X move parameters to scratch area LEAX 1,X ; DECB ; BNE CMOV1 CMOV2 LDA N LDB N+1 SUBB #1 SBCA #0 STA N STB N+1 BCS CMOV3 LDX N+4 LDA 0,X LEAX 1,X ; STX N+4 LDX N+2 STA 0,X LEAX 1,X ; STX N+2 BRA CMOV2 CMOV3 JMP NEXT * * ######>> screen 23 << * ======>> 18 << FCB $82 FCC 'U' ; 'U*' FCB $AA FDB CMOVE-8 USTAR FDB *+2 BSR USTARS LEAS 1,S ; LEAS 1,S ; JMP PUSHBA * * The following is a subroutine which * multiplies top 2 words on stack, * leaving 32-bit result: high order word in A,B * low order word in 2nd word of stack. * USTARS LDA #16 bits/word counter PSHS A ; CLRA ; CLRB ; TFR S,X ; TSX : USTAR2 ROR 5,X shift multiplier ROR 6,X DEC 0,X done? BMI USTAR4 BCC USTAR3 ADDB 4,X ADCA 3,X USTAR3 RORA ; RORB ; shift result BRA USTAR2 USTAR4 LEAS 1,S ; dump counter RTS * * ######>> screen 24 << * ======>> 19 << FCB $82 FCC 'U' ; 'U/' FCB $AF FDB USTAR-5 USLASH FDB *+2 LDA #17 PSHS A ; TFR S,X ; TSX : LDA 3,X LDB 4,X USL1 CMPA 1,X BHI USL3 BCS USL2 CMPB 2,X BCC USL3 USL2 ANDCC #~$01 ; CLC : BRA USL4 USL3 SUBB 2,X SBCA 1,X ORCC #$01 ; SEC : USL4 ROL 6,X ROL 5,X DEC 0,X BEQ USL5 ROLB ; ROLA ; BCC USL1 BRA USL3 USL5 LEAS 1,S ; LEAS 1,S ; LEAS 1,S ; LEAS 1,S ; LEAS 1,S ; JMP SWAP+4 reverse quotient & remainder * * ######>> screen 25 << * ======>> 20 << FCB $83 FCC 'AN' ; 'AND' FCB $C4 FDB USLASH-5 AND FDB *+2 PULS A ; PULS B ; TFR S,X ; TSX : ANDB 1,X ANDA 0,X JMP STABX * * ======>> 21 << FCB $82 FCC 'O' ; 'OR' FCB $D2 FDB AND-6 OR FDB *+2 PULS A ; PULS B ; TFR S,X ; TSX : ORB 1,X ORA 0,X JMP STABX * * ======>> 22 << FCB $83 FCC 'XO' ; 'XOR' FCB $D2 FDB OR-5 XOR FDB *+2 PULS A ; PULS B ; TFR S,X ; TSX : EORB 1,X EORA 0,X JMP STABX * * ######>> screen 26 << * ======>> 23 << FCB $83 FCC 'SP' ; 'SP@' FCB $C0 FDB XOR-6 SPAT FDB *+2 TFR S,X ; TSX : STX N scratch area LDX #N JMP GETX * * ======>> 24 << FCB $83 FCC 'SP' ; 'SP!' FCB $A1 FDB SPAT-6 SPSTOR FDB *+2 LDX UP LDX XSPZER-UORIG,X TFR X,S ; TXS : watch it ! X and S are not equal. JMP NEXT * ======>> 25 << FCB $83 FCC 'RP' ; 'RP!' FCB $A1 FDB SPSTOR-6 RPSTOR FDB *+2 LDX RINIT initialize from rom constant STX RP JMP NEXT * * ======>> 26 << FCB $82 FCC ';' ; ';S' FCB $D3 FDB RPSTOR-6 SEMIS FDB *+2 LDX RP LEAX 1,X ; LEAX 1,X ; STX RP LDX 0,X get address we have just finished. JMP NEXT+2 increment the return address & do next word * * ######>> screen 27 << * ======>> 27 << FCB $85 FCC 'LEAV' ; 'LEAVE' FCB $C5 FDB SEMIS-5 LEAVE FDB *+2 LDX RP LDA 2,X LDB 3,X STA 4,X STB 5,X JMP NEXT * * ======>> 28 << FCB $82 FCC '>' ; '>R' FCB $D2 FDB LEAVE-8 TOR FDB *+2 LDX RP LEAX -1,X ; LEAX -1,X ; STX RP PULS A ; PULS B ; STA 2,X STB 3,X JMP NEXT * * ======>> 29 << FCB $82 FCC 'R' ; 'R>' FCB $BE FDB TOR-5 FROMR FDB *+2 LDX RP LDA 2,X LDB 3,X LEAX 1,X ; LEAX 1,X ; STX RP JMP PUSHBA * * ======>> 30 << FCB $81 R FCB $D2 FDB FROMR-5 R FDB *+2 LDX RP LEAX 1,X ; LEAX 1,X ; JMP GETX * * ######>> screen 28 << * ======>> 31 << FCB $82 FCC '0' ; '0=' FCB $BD FDB R-4 ZEQU FDB *+2 TFR S,X ; TSX : CLRA ; CLRB ; LDX 0,X BNE ZEQU2 INCB ; ZEQU2 TFR S,X ; TSX : JMP STABX * * ======>> 32 << FCB $82 FCC '0' ; '0<' FCB $BC FDB ZEQU-5 ZLESS FDB *+2 TFR S,X ; TSX : LDA #$80 check the sign bit ANDA 0,X BEQ ZLESS2 CLRA ; if neg. LDB #1 JMP STABX ZLESS2 CLRB ; JMP STABX * * ######>> screen 29 << * ======>> 33 << FCB $81 '+' FCB $AB FDB ZLESS-5 PLUS FDB *+2 PULS A ; PULS B ; TFR S,X ; TSX : ADDB 1,X ADCA 0,X JMP STABX * * ======>> 34 << FCB $82 FCC 'D' ; 'D+' FCB $AB FDB PLUS-4 DPLUS FDB *+2 TFR S,X ; TSX : ANDCC #~$01 ; CLC : LDB #4 DPLUS2 LDA 3,X ADCA 7,X STA 7,X LEAX -1,X ; DECB ; BNE DPLUS2 LEAS 1,S ; LEAS 1,S ; LEAS 1,S ; LEAS 1,S ; JMP NEXT * * ======>> 35 << FCB $85 FCC 'MINU' ; 'MINUS' FCB $D3 FDB DPLUS-5 MINUS FDB *+2 TFR S,X ; TSX : NEG 1,X BCC MINUS2 NEG 0,X BRA MINUS3 MINUS2 COM 0,X MINUS3 JMP NEXT * * ======>> 36 << FCB $86 FCC 'DMINU' ; 'DMINUS' FCB $D3 FDB MINUS-8 DMINUS FDB *+2 TFR S,X ; TSX : COM 0,X COM 1,X COM 2,X NEG 3,X BNE DMINX INC 2,X BNE DMINX INC 1,X BNE DMINX INC 0,X DMINX JMP NEXT * * ######>> screen 30 << * ======>> 37 << FCB $84 FCC 'OVE' ; 'OVER' FCB $D2 FDB DMINUS-9 OVER FDB *+2 TFR S,X ; TSX : LDA 2,X LDB 3,X JMP PUSHBA * * ======>> 38 << FCB $84 FCC 'DRO' ; 'DROP' FCB $D0 FDB OVER-7 DROP FDB *+2 LEAS 1,S ; LEAS 1,S ; JMP NEXT * * ======>> 39 << FCB $84 FCC 'SWA' ; 'SWAP' FCB $D0 FDB DROP-7 SWAP FDB *+2 PULS A ; PULS B ; TFR S,X ; TSX : LDX 0,X LEAS 1,S ; LEAS 1,S ; PSHS B ; PSHS A ; STX N LDX #N JMP GETX * * ======>> 40 << FCB $83 FCC 'DU' ; 'DUP' FCB $D0 FDB SWAP-7 DUP FDB *+2 PULS A ; PULS B ; PSHS B ; PSHS A ; JMP PUSHBA * * ######>> screen 31 << * ======>> 41 << FCB $82 FCC '+' ; '+!' FCB $A1 FDB DUP-6 PSTORE FDB *+2 TFR S,X ; TSX : LDX 0,X LEAS 1,S ; LEAS 1,S ; PULS A ; get stack data PULS B ; ADDB 1,X add & store low byte STB 1,X ADCA 0,X add & store hi byte STA 0,X JMP NEXT * * ======>> 42 << FCB $86 FCC 'TOGGL' ; 'TOGGLE' FCB $C5 FDB PSTORE-5 TOGGLE FDB DOCOL,OVER,CAT,XOR,SWAP,CSTORE FDB SEMIS * * ######>> screen 32 << * ======>> 43 << FCB $81 @ FCB $C0 FDB TOGGLE-9 AT FDB *+2 TFR S,X ; TSX : LDX 0,X get address LEAS 1,S ; LEAS 1,S ; JMP GETX * * ======>> 44 << FCB $82 FCC 'C' ; 'C@' FCB $C0 FDB AT-4 CAT FDB *+2 TFR S,X ; TSX : LDX 0,X CLRA ; LDB 0,X LEAS 1,S ; LEAS 1,S ; JMP PUSHBA * * ======>> 45 << FCB $81 FCB $A1 FDB CAT-5 STORE FDB *+2 TFR S,X ; TSX : LDX 0,X get address LEAS 1,S ; LEAS 1,S ; JMP PULABX * * ======>> 46 << FCB $82 FCC 'C' ; 'C!' FCB $A1 FDB STORE-4 CSTORE FDB *+2 TFR S,X ; TSX : LDX 0,X get address LEAS 1,S ; LEAS 1,S ; LEAS 1,S ; PULS B ; STB 0,X JMP NEXT PAGE * * ######>> screen 33 << * ======>> 47 << FCB $C1 : immediate FCB $BA FDB CSTORE-5 COLON FDB DOCOL,QEXEC,SCSP,CURENT,AT,CONTXT,STORE FDB CREATE,RBRAK FDB PSCODE * Here is the IP pusher for allowing * nested words in the virtual machine: * ( ;S is the equivalent un-nester ) DOCOL LDX RP make room in the stack LEAX -1,X ; LEAX -1,X ; STX RP LDA IP LDB IP+1 STA 2,X Store address of the high level word STB 3,X that we are starting to execute LDX W Get first sub-word of that definition JMP NEXT+2 and execute it * * ======>> 48 << FCB $C1 ; imnediate code FCB $BB FDB COLON-4 SEMI FDB DOCOL,QCSP,COMPIL,SEMIS,SMUDGE,LBRAK FDB SEMIS * * ######>> screen 34 << * ======>> 49 << FCB $88 FCC 'CONSTAN' ; 'CONSTANT' FCB $D4 FDB SEMI-4 CON FDB DOCOL,CREATE,SMUDGE,COMMA,PSCODE DOCON LDX W LDA 2,X LDB 3,X A & B now contain the constant JMP PUSHBA * * ======>> 50 << FCB $88 FCC 'VARIABL' ; 'VARIABLE' FCB $C5 FDB CON-11 VAR FDB DOCOL,CON,PSCODE DOVAR LDA W LDB W+1 ADDB #2 ADCA #0 A,B now contain the address of the variable JMP PUSHBA * * ======>> 51 << FCB $84 FCC 'USE' ; 'USER' FCB $D2 FDB VAR-11 USER FDB DOCOL,CON,PSCODE DOUSER LDX W get offset into user's table LDA 2,X LDB 3,X ADDB UP+1 add to users base address ADCA UP JMP PUSHBA push address of user's variable * * ######>> screen 35 << * ======>> 52 << FCB $81 FCB $B0 0 FDB USER-7 ZERO FDB DOCON FDB 0000 * * ======>> 53 << FCB $81 FCB $B1 1 FDB ZERO-4 ONE FDB DOCON FDB 1 * * ======>> 54 << FCB $81 FCB $B2 2 FDB ONE-4 TWO FDB DOCON FDB 2 * * ======>> 55 << FCB $81 FCB $B3 3 FDB TWO-4 THREE FDB DOCON FDB 3 * * ======>> 56 << FCB $82 FCC 'B' ; 'BL' FCB $CC FDB THREE-4 BL FDB DOCON ascii blank FDB $20 * * ======>> 57 << FCB $85 FCC 'FIRS' ; 'FIRST' FCB $D4 FDB BL-5 FIRST FDB DOCON FDB MEMEND-528 (132 * NBLK) * * ======>> 58 << FCB $85 FCC 'LIMI' ; 'LIMIT' : ( the end of memory +1 ) FCB $D4 FDB FIRST-8 LIMIT FDB DOCON FDB MEMEND * * ======>> 59 << FCB $85 FCC 'B/BU' ; 'B/BUF' : (bytes/buffer) FCB $C6 FDB LIMIT-8 BBUF FDB DOCON FDB 128 * * ======>> 60 << FCB $85 FCC 'B/SC' ; 'B/SCR' : (blocks/screen) FCB $D2 FDB BBUF-8 BSCR FDB DOCON FDB 8 * blocks/screen = 1024 / "B/BUF" = 8 * * ======>> 61 << FCB $87 FCC '+ORIGI' ; '+ORIGIN' FCB $CE FDB BSCR-8 PORIG FDB DOCOL,LIT,ORIG,PLUS FDB SEMIS * * ######>> screen 36 << * ======>> 62 << FCB $82 FCC 'S' ; 'S0' FCB $B0 FDB PORIG-10 SZERO FDB DOUSER FDB XSPZER-UORIG * * ======>> 63 << FCB $82 FCC 'R' ; 'R0' FCB $B0 FDB SZERO-5 RZERO FDB DOUSER FDB XRZERO-UORIG * * ======>> 64 << FCB $83 FCC 'TI' ; 'TIB' FCB $C2 FDB RZERO-5 TIB FDB DOUSER FDB XTIB-UORIG * * ======>> 65 << FCB $85 FCC 'WIDT' ; 'WIDTH' FCB $C8 FDB TIB-6 WIDTH FDB DOUSER FDB XWIDTH-UORIG * * ======>> 66 << FCB $87 FCC 'WARNIN' ; 'WARNING' FCB $C7 FDB WIDTH-8 WARN FDB DOUSER FDB XWARN-UORIG * * ======>> 67 << FCB $85 FCC 'FENC' ; 'FENCE' FCB $C5 FDB WARN-10 FENCE FDB DOUSER FDB XFENCE-UORIG * * ======>> 68 << FCB $82 FCC 'D' ; 'DP' : points to first free byte at end of dictionary FCB $D0 FDB FENCE-8 DP FDB DOUSER FDB XDP-UORIG * * ======>> 68.5 << FCB $88 FCC 'VOC-LIN' ; 'VOC-LINK' FCB $CB FDB DP-5 VOCLIN FDB DOUSER FDB XVOCL-UORIG * * ======>> 69 << FCB $83 FCC 'BL' ; 'BLK' FCB $CB FDB VOCLIN-11 BLK FDB DOUSER FDB XBLK-UORIG * * ======>> 70 << FCB $82 FCC 'I' ; 'IN' : scan pointer for input line buffer FCB $CE FDB BLK-6 IN FDB DOUSER FDB XIN-UORIG * * ======>> 71 << FCB $83 FCC 'OU' ; 'OUT' FCB $D4 FDB IN-5 OUT FDB DOUSER FDB XOUT-UORIG * * ======>> 72 << FCB $83 FCC 'SC' ; 'SCR' FCB $D2 FDB OUT-6 SCR FDB DOUSER FDB XSCR-UORIG * ######>> screen 37 << * * ======>> 73 << FCB $86 FCC 'OFFSE' ; 'OFFSET' FCB $D4 FDB SCR-6 OFSET FDB DOUSER FDB XOFSET-UORIG * * ======>> 74 << FCB $87 FCC 'CONTEX' ; 'CONTEXT' : points to pointer to vocab to search first FCB $D4 FDB OFSET-9 CONTXT FDB DOUSER FDB XCONT-UORIG * * ======>> 75 << FCB $87 FCC 'CURREN' ; 'CURRENT' : points to ptr. to vocab being extended FCB $D4 FDB CONTXT-10 CURENT FDB DOUSER FDB XCURR-UORIG * * ======>> 76 << FCB $85 FCC 'STAT' ; 'STATE' : 1 if compiling, 0 if not FCB $C5 FDB CURENT-10 STATE FDB DOUSER FDB XSTATE-UORIG * * ======>> 77 << FCB $84 FCC 'BAS' ; 'BASE' : number base for all input & output FCB $C5 FDB STATE-8 BASE FDB DOUSER FDB XBASE-UORIG * * ======>> 78 << FCB $83 FCC 'DP' ; 'DPL' FCB $CC FDB BASE-7 DPL FDB DOUSER FDB XDPL-UORIG * * ======>> 79 << FCB $83 FCC 'FL' ; 'FLD' FCB $C4 FDB DPL-6 FLD FDB DOUSER FDB XFLD-UORIG * * ======>> 80 << FCB $83 FCC 'CS' ; 'CSP' FCB $D0 FDB FLD-6 CSP FDB DOUSER FDB XCSP-UORIG * * ======>> 81 << FCB $82 FCC 'R' ; 'R#' FCB $A3 FDB CSP-6 RNUM FDB DOUSER FDB XRNUM-UORIG * * ======>> 82 << FCB $83 FCC 'HL' ; 'HLD' FCB $C4 FDB RNUM-5 HLD FDB DOCON FDB XHLD * * ======>> 82.5 <<== SPECIAL FCB $87 FCC 'COLUMN' ; 'COLUMNS' : line width of terminal FCB $D3 FDB HLD-6 COLUMS FDB DOUSER FDB XCOLUM-UORIG * * ######>> screen 38 << * ======>> 83 << FCB $82 FCC '1' ; '1+' FCB $AB FDB COLUMS-10 ONEP FDB DOCOL,ONE,PLUS FDB SEMIS * * ======>> 84 << FCB $82 FCC '2' ; '2+' FCB $AB FDB ONEP-5 TWOP FDB DOCOL,TWO,PLUS FDB SEMIS * * ======>> 85 << FCB $84 FCC 'HER' ; 'HERE' FCB $C5 FDB TWOP-5 HERE FDB DOCOL,DP,AT FDB SEMIS * * ======>> 86 << FCB $85 FCC 'ALLO' ; 'ALLOT' FCB $D4 FDB HERE-7 ALLOT FDB DOCOL,DP,PSTORE FDB SEMIS * * ======>> 87 << FCB $81 ; , (COMMA) FCB $AC FDB ALLOT-8 COMMA FDB DOCOL,HERE,STORE,TWO,ALLOT FDB SEMIS * * ======>> 88 << FCB $82 FCC 'C' ; 'C,' FCB $AC FDB COMMA-4 CCOMM FDB DOCOL,HERE,CSTORE,ONE,ALLOT FDB SEMIS * * ======>> 89 << FCB $81 ; - FCB $AD FDB CCOMM-5 SUB FDB DOCOL,MINUS,PLUS FDB SEMIS * * ======>> 90 << FCB $81 = FCB $BD FDB SUB-4 EQUAL FDB DOCOL,SUB,ZEQU FDB SEMIS * * ======>> 91 << FCB $81 < FCB $BC FDB EQUAL-4 LESS FDB *+2 PULS A ; PULS B ; TFR S,X ; TSX : CMPA 0,X LEAS 1,S ; BGT LESST BNE LESSF CMPB 1,X BHI LESST LESSF CLRB ; BRA LESSX LESST LDB #1 LESSX CLRA ; LEAS 1,S ; JMP PUSHBA * * ======>> 92 << FCB $81 > FCB $BE FDB LESS-4 GREAT FDB DOCOL,SWAP,LESS FDB SEMIS * * ======>> 93 << FCB $83 FCC 'RO' ; 'ROT' FCB $D4 FDB GREAT-4 ROT FDB DOCOL,TOR,SWAP,FROMR,SWAP FDB SEMIS * * ======>> 94 << FCB $85 FCC 'SPAC' ; 'SPACE' FCB $C5 FDB ROT-6 SPACE FDB DOCOL,BL,EMIT FDB SEMIS * * ======>> 95 << FCB $83 FCC 'MI' ; 'MIN' FCB $CE FDB SPACE-8 MIN FDB DOCOL,OVER,OVER,GREAT,ZBRAN FDB MIN2-* FDB SWAP MIN2 FDB DROP FDB SEMIS * * ======>> 96 << FCB $83 FCC 'MA' ; 'MAX' FCB $D8 FDB MIN-6 MAX FDB DOCOL,OVER,OVER,LESS,ZBRAN FDB MAX2-* FDB SWAP MAX2 FDB DROP FDB SEMIS * * ======>> 97 << FCB $84 FCC '-DU' ; '-DUP' FCB $D0 FDB MAX-6 DDUP FDB DOCOL,DUP,ZBRAN FDB DDUP2-* FDB DUP DDUP2 FDB SEMIS * * ######>> screen 39 << * ======>> 98 << FCB $88 FCC 'TRAVERS' ; 'TRAVERSE' FCB $C5 FDB DDUP-7 TRAV FDB DOCOL,SWAP TRAV2 FDB OVER,PLUS,CLITER FCB $7F FDB OVER,CAT,LESS,ZBRAN FDB TRAV2-* FDB SWAP,DROP FDB SEMIS * * ======>> 99 << FCB $86 FCC 'LATES' ; 'LATEST' FCB $D4 FDB TRAV-11 LATEST FDB DOCOL,CURENT,AT,AT FDB SEMIS * * ======>> 100 << FCB $83 FCC 'LF' ; 'LFA' FCB $C1 FDB LATEST-9 LFA FDB DOCOL,CLITER FCB 4 FDB SUB FDB SEMIS * * ======>> 101 << FCB $83 FCC 'CF' ; 'CFA' FCB $C1 FDB LFA-6 CFA FDB DOCOL,TWO,SUB FDB SEMIS * * ======>> 102 << FCB $83 FCC 'NF' ; 'NFA' FCB $C1 FDB CFA-6 NFA FDB DOCOL,CLITER FCB 5 FDB SUB,ONE,MINUS,TRAV FDB SEMIS * * ======>> 103 << FCB $83 FCC 'PF' ; 'PFA' FCB $C1 FDB NFA-6 PFA FDB DOCOL,ONE,TRAV,CLITER FCB 5 FDB PLUS FDB SEMIS * * ######>> screen 40 << * ======>> 104 << FCB $84 FCC '!CS' ; '!CSP' FCB $D0 FDB PFA-6 SCSP FDB DOCOL,SPAT,CSP,STORE FDB SEMIS * * ======>> 105 << FCB $86 FCC '?ERRO' ; '?ERROR' FCB $D2 FDB SCSP-7 QERR FDB DOCOL,SWAP,ZBRAN FDB QERR2-* FDB ERROR,BRAN FDB QERR3-* QERR2 FDB DROP QERR3 FDB SEMIS * * ======>> 106 << FCB $85 FCC '?COM' ; '?COMP' FCB $D0 FDB QERR-9 QCOMP FDB DOCOL,STATE,AT,ZEQU,CLITER FCB $11 FDB QERR FDB SEMIS * * ======>> 107 << FCB $85 FCC '?EXE' ; '?EXEC' FCB $C3 FDB QCOMP-8 QEXEC FDB DOCOL,STATE,AT,CLITER FCB $12 FDB QERR FDB SEMIS * * ======>> 108 << FCB $86 FCC '?PAIR' ; '?PAIRS' FCB $D3 FDB QEXEC-8 QPAIRS FDB DOCOL,SUB,CLITER FCB $13 FDB QERR FDB SEMIS * * ======>> 109 << FCB $84 FCC '?CS' ; '?CSP' FCB $D0 FDB QPAIRS-9 QCSP FDB DOCOL,SPAT,CSP,AT,SUB,CLITER FCB $14 FDB QERR FDB SEMIS * * ======>> 110 << FCB $88 FCC '?LOADIN' ; '?LOADING' FCB $C7 FDB QCSP-7 QLOAD FDB DOCOL,BLK,AT,ZEQU,CLITER FCB $16 FDB QERR FDB SEMIS * * ######>> screen 41 << * ======>> 111 << FCB $87 FCC 'COMPIL' ; 'COMPILE' FCB $C5 FDB QLOAD-11 COMPIL FDB DOCOL,QCOMP,FROMR,TWOP,DUP,TOR,AT,COMMA FDB SEMIS * * ======>> 112 << FCB $C1 [ immediate FCB $DB FDB COMPIL-10 LBRAK FDB DOCOL,ZERO,STATE,STORE FDB SEMIS * * ======>> 113 << FCB $81 ] FCB $DD FDB LBRAK-4 RBRAK FDB DOCOL,CLITER FCB $C0 FDB STATE,STORE FDB SEMIS * * ======>> 114 << FCB $86 FCC 'SMUDG' ; 'SMUDGE' FCB $C5 FDB RBRAK-4 SMUDGE FDB DOCOL,LATEST,CLITER FCB $20 FDB TOGGLE FDB SEMIS * * ======>> 115 << FCB $83 FCC 'HE' ; 'HEX' FCB $D8 FDB SMUDGE-9 HEX FDB DOCOL FDB CLITER FCB 16 FDB BASE,STORE FDB SEMIS * * ======>> 116 << FCB $87 FCC 'DECIMA' ; 'DECIMAL' FCB $CC FDB HEX-6 DEC FDB DOCOL FDB CLITER FCB 10 note: hex "A" FDB BASE,STORE FDB SEMIS * * ######>> screen 42 << * ======>> 117 << FCB $87 FCC '(;CODE' ; '(;CODE)' FCB $A9 FDB DEC-10 PSCODE FDB DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE FDB SEMIS * * ======>> 118 << FCB $C5 immediate FCC ';COD' ; ';CODE' FCB $C5 FDB PSCODE-10 SEMIC FDB DOCOL,QCSP,COMPIL,PSCODE,SMUDGE,LBRAK,QSTACK FDB SEMIS * note: "QSTACK" will be replaced by "ASSEMBLER" later * * ######>> screen 43 << * ======>> 119 << FCB $87 FCC '> 120 << FCB $85 FCC 'DOES' ; 'DOES>' FCB $BE FDB BUILDS-10 DOES FDB DOCOL,FROMR,TWOP,LATEST,PFA,STORE FDB PSCODE DODOES LDA IP LDB IP+1 LDX RP make room on return stack LEAX -1,X ; LEAX -1,X ; STX RP STA 2,X push return address STB 3,X LDX W get addr of pointer to run-time code LEAX 1,X ; LEAX 1,X ; STX N stash it in scratch area LDX 0,X get new IP STX IP CLRA ; get address of parameter LDB #2 ADDB N+1 ADCA N PSHS B ; and push it on data stack PSHS A ; JMP NEXT2 * * ######>> screen 44 << * ======>> 121 << FCB $85 FCC 'COUN' ; 'COUNT' FCB $D4 FDB DOES-8 COUNT FDB DOCOL,DUP,ONEP,SWAP,CAT FDB SEMIS * * ======>> 122 << FCB $84 FCC 'TYP' ; 'TYPE' FCB $C5 FDB COUNT-8 TYPE FDB DOCOL,DDUP,ZBRAN FDB TYPE3-* FDB OVER,PLUS,SWAP,XDO TYPE2 FDB I,CAT,EMIT,XLOOP FDB TYPE2-* FDB BRAN FDB TYPE4-* TYPE3 FDB DROP TYPE4 FDB SEMIS * * ======>> 123 << FCB $89 FCC '-TRAILIN' ; '-TRAILING' FCB $C7 FDB TYPE-7 DTRAIL FDB DOCOL,DUP,ZERO,XDO DTRAL2 FDB OVER,OVER,PLUS,ONE,SUB,CAT,BL FDB SUB,ZBRAN FDB DTRAL3-* FDB LEAVE,BRAN FDB DTRAL4-* DTRAL3 FDB ONE,SUB DTRAL4 FDB XLOOP FDB DTRAL2-* FDB SEMIS * * ======>> 124 << FCB $84 FCC '(."' ; '(.")' FCB $A9 FDB DTRAIL-12 PDOTQ FDB DOCOL,R,TWOP,COUNT,DUP,ONEP FDB FROMR,PLUS,TOR,TYPE FDB SEMIS * * ======>> 125 << FCB $C2 immediate FCC '.' ; '."' FCB $A2 FDB PDOTQ-7 DOTQ FDB DOCOL FDB CLITER FCB $22 ascii quote FDB STATE,AT,ZBRAN FDB DOTQ1-* FDB COMPIL,PDOTQ,WORD FDB HERE,CAT,ONEP,ALLOT,BRAN FDB DOTQ2-* DOTQ1 FDB WORD,HERE,COUNT,TYPE DOTQ2 FDB SEMIS * * ######>> screen 45 << * ======>> 126 <<== MACHINE DEPENDENT FCB $86 FCC '?STAC' ; '?STACK' FCB $CB FDB DOTQ-5 QSTACK FDB DOCOL,CLITER FCB $12 FDB PORIG,AT,TWO,SUB,SPAT,LESS,ONE FDB QERR * prints 'empty stack' * QSTAC2 FDB SPAT * Here, we compare with a value at least 128 * higher than dict. ptr. (DP) FDB HERE,CLITER FCB $80 FDB PLUS,LESS,ZBRAN FDB QSTAC3-* FDB TWO FDB QERR * prints 'full stack' * QSTAC3 FDB SEMIS * * ======>> 127 << this word's function * is done by ?STACK in this version * FCB $85 * FCC 4,?FREE * FCB $C5 * FDB QSTACK-9 *QFREE FDB DOCOL,SPAT,HERE,CLITER * FCB $80 * FDB PLUS,LESS,TWO,QERR,SEMIS * * ######>> screen 46 << * ======>> 128 << FCB $86 FCC 'EXPEC' ; 'EXPECT' FCB $D4 FDB QSTACK-9 EXPECT FDB DOCOL,OVER,PLUS,OVER,XDO EXPEC2 FDB KEY,DUP,CLITER FCB $0E FDB PORIG,AT,EQUAL,ZBRAN FDB EXPEC3-* FDB DROP,CLITER FCB 8 ( backspace character to emit ) FDB OVER,I,EQUAL,DUP,FROMR,TWO,SUB,PLUS FDB TOR,SUB,BRAN FDB EXPEC6-* EXPEC3 FDB DUP,CLITER FCB $D ( carriage return ) FDB EQUAL,ZBRAN FDB EXPEC4-* FDB LEAVE,DROP,BL,ZERO,BRAN FDB EXPEC5-* EXPEC4 FDB DUP EXPEC5 FDB I,CSTORE,ZERO,I,ONEP,STORE EXPEC6 FDB EMIT,XLOOP FDB EXPEC2-* FDB DROP FDB SEMIS * * ======>> 129 << FCB $85 FCC 'QUER' ; 'QUERY' FCB $D9 FDB EXPECT-9 QUERY FDB DOCOL,TIB,AT,COLUMS FDB AT,EXPECT,ZERO,IN,STORE FDB SEMIS * * ======>> 130 << FCB $C1 immediate < carriage return > FCB $80 FDB QUERY-8 NULL FDB DOCOL,BLK,AT,ZBRAN FDB NULL2-* FDB ONE,BLK,PSTORE FDB ZERO,IN,STORE,BLK,AT,BSCR,MOD FDB ZEQU * check for end of screen FDB ZBRAN FDB NULL1-* FDB QEXEC,FROMR,DROP NULL1 FDB BRAN FDB NULL3-* NULL2 FDB FROMR,DROP NULL3 FDB SEMIS * * ######>> screen 47 << * ======>> 133 << FCB $84 FCC 'FIL' ; 'FILL' FCB $CC FDB NULL-4 FILL FDB DOCOL,SWAP,TOR,OVER,CSTORE,DUP,ONEP FDB FROMR,ONE,SUB,CMOVE FDB SEMIS * * ======>> 134 << FCB $85 FCC 'ERAS' ; 'ERASE' FCB $C5 FDB FILL-7 ERASE FDB DOCOL,ZERO,FILL FDB SEMIS * * ======>> 135 << FCB $86 FCC 'BLANK' ; 'BLANKS' FCB $D3 FDB ERASE-8 BLANKS FDB DOCOL,BL,FILL FDB SEMIS * * ======>> 136 << FCB $84 FCC 'HOL' ; 'HOLD' FCB $C4 FDB BLANKS-9 HOLD FDB DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE FDB SEMIS * * ======>> 137 << FCB $83 FCC 'PA' ; 'PAD' FCB $C4 FDB HOLD-7 PAD FDB DOCOL,HERE,CLITER FCB $44 FDB PLUS FDB SEMIS * * ######>> screen 48 << * ======>> 138 << FCB $84 FCC 'WOR' ; 'WORD' FCB $C4 FDB PAD-6 WORD FDB DOCOL,BLK,AT,ZBRAN FDB WORD2-* FDB BLK,AT,BLOCK,BRAN FDB WORD3-* WORD2 FDB TIB,AT WORD3 FDB IN,AT,PLUS,SWAP,ENCLOS,HERE,CLITER FCB 34 FDB BLANKS,IN,PSTORE,OVER,SUB,TOR,R,HERE FDB CSTORE,PLUS,HERE,ONEP,FROMR,CMOVE FDB SEMIS * * ######>> screen 49 << * ======>> 139 << FCB $88 FCC '(NUMBER' ; '(NUMBER)' FCB $A9 FDB WORD-7 PNUMB FDB DOCOL PNUMB2 FDB ONEP,DUP,TOR,CAT,BASE,AT,DIGIT,ZBRAN FDB PNUMB4-* FDB SWAP,BASE,AT,USTAR,DROP,ROT,BASE FDB AT,USTAR,DPLUS,DPL,AT,ONEP,ZBRAN FDB PNUMB3-* FDB ONE,DPL,PSTORE PNUMB3 FDB FROMR,BRAN FDB PNUMB2-* PNUMB4 FDB FROMR FDB SEMIS * * ======>> 140 << FCB $86 FCC 'NUMBE' ; 'NUMBER' FCB $D2 FDB PNUMB-11 NUMB FDB DOCOL,ZERO,ZERO,ROT,DUP,ONEP,CAT,CLITER FCC "-" minus sign FDB EQUAL,DUP,TOR,PLUS,LIT,$FFFF NUMB1 FDB DPL,STORE,PNUMB,DUP,CAT,BL,SUB FDB ZBRAN FDB NUMB2-* FDB DUP,CAT,CLITER FCC "." FDB SUB,ZERO,QERR,ZERO,BRAN FDB NUMB1-* NUMB2 FDB DROP,FROMR,ZBRAN FDB NUMB3-* FDB DMINUS NUMB3 FDB SEMIS * * ======>> 141 << FCB $85 FCC '-FIN' ; '-FIND' FCB $C4 FDB NUMB-9 DFIND FDB DOCOL,BL,WORD,HERE,CONTXT,AT,AT FDB PFIND,DUP,ZEQU,ZBRAN FDB DFIND2-* FDB DROP,HERE,LATEST,PFIND DFIND2 FDB SEMIS * * ######>> screen 50 << * ======>> 142 << FCB $87 FCC '(ABORT' ; '(ABORT)' FCB $A9 FDB DFIND-8 PABORT FDB DOCOL,ABORT FDB SEMIS * * ======>> 143 << FCB $85 FCC 'ERRO' ; 'ERROR' FCB $D2 FDB PABORT-10 ERROR FDB DOCOL,WARN,AT,ZLESS FDB ZBRAN * note: WARNING is -1 to abort, 0 to print error # * and 1 to print error message from disc FDB ERROR2-* FDB PABORT ERROR2 FDB HERE,COUNT,TYPE,PDOTQ FCB 4,7 ( bell ) FCC " ? " FDB MESS,SPSTOR,IN,AT,BLK,AT,QUIT FDB SEMIS * * ======>> 144 << FCB $83 FCC 'ID' ; 'ID.' FCB $AE FDB ERROR-8 IDDOT FDB DOCOL,PAD,CLITER FCB 32 FDB CLITER FCB $5F ( underline ) FDB FILL,DUP,PFA,LFA,OVER,SUB,PAD FDB SWAP,CMOVE,PAD,COUNT,CLITER FCB 31 FDB AND,TYPE,SPACE FDB SEMIS * * ######>> screen 51 << * ======>> 145 << FCB $86 FCC 'CREAT' ; 'CREATE' FCB $C5 FDB IDDOT-6 CREATE FDB DOCOL,DFIND,ZBRAN FDB CREAT2-* FDB DROP,PDOTQ FCB 8 FCB 7 ( bel ) FCC "redef: " FDB NFA,IDDOT,CLITER FCB 4 FDB MESS,SPACE CREAT2 FDB HERE,DUP,CAT,WIDTH,AT,MIN FDB ONEP,ALLOT,DUP,CLITER FCB $A0 FDB TOGGLE,HERE,ONE,SUB,CLITER FCB $80 FDB TOGGLE,LATEST,COMMA,CURENT,AT,STORE FDB HERE,TWOP,COMMA FDB SEMIS * * ######>> screen 52 << * ======>> 146 << FCB $C9 immediate FCC '[COMPILE' ; '[COMPILE]' FCB $DD FDB CREATE-9 BCOMP FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA FDB SEMIS * * ======>> 147 << FCB $C7 immediate FCC 'LITERA' ; 'LITERAL' FCB $CC FDB BCOMP-12 LITER FDB DOCOL,STATE,AT,ZBRAN FDB LITER2-* FDB COMPIL,LIT,COMMA LITER2 FDB SEMIS * * ======>> 148 << FCB $C8 immediate FCC 'DLITERA' ; 'DLITERAL' FCB $CC FDB LITER-10 DLITER FDB DOCOL,STATE,AT,ZBRAN FDB DLITE2-* FDB SWAP,LITER,LITER DLITE2 FDB SEMIS * * ######>> screen 53 << * ======>> 149 << FCB $89 FCC 'INTERPRE' ; 'INTERPRET' FCB $D4 FDB DLITER-11 INTERP FDB DOCOL INTER2 FDB DFIND,ZBRAN FDB INTER5-* FDB STATE,AT,LESS FDB ZBRAN FDB INTER3-* FDB CFA,COMMA,BRAN FDB INTER4-* INTER3 FDB CFA,EXEC INTER4 FDB BRAN FDB INTER7-* INTER5 FDB HERE,NUMB,DPL,AT,ONEP,ZBRAN FDB INTER6-* FDB DLITER,BRAN FDB INTER7-* INTER6 FDB DROP,LITER INTER7 FDB QSTACK,BRAN FDB INTER2-* * FDB SEMIS never executed * * ######>> screen 54 << * ======>> 150 << FCB $89 FCC 'IMMEDIAT' ; 'IMMEDIATE' FCB $C5 FDB INTERP-12 IMMED FDB DOCOL,LATEST,CLITER FCB $40 FDB TOGGLE FDB SEMIS * * ======>> 151 << FCB $8A FCC 'VOCABULAR' ; 'VOCABULARY' FCB $D9 FDB IMMED-12 VOCAB FDB DOCOL,BUILDS,LIT,$81A0,COMMA,CURENT,AT,CFA FDB COMMA,HERE,VOCLIN,AT,COMMA,VOCLIN,STORE,DOES DOVOC FDB TWOP,CONTXT,STORE FDB SEMIS * * ======>> 152 << * * Note: FORTH does not go here in the rom-able dictionary, * since FORTH is a type of variable. * * * ======>> 153 << FCB $8B FCC 'DEFINITION' ; 'DEFINITIONS' FCB $D3 FDB VOCAB-13 DEFIN FDB DOCOL,CONTXT,AT,CURENT,STORE FDB SEMIS * * ======>> 154 << FCB $C1 immediate ( FCB $A8 FDB DEFIN-14 PAREN FDB DOCOL,CLITER FCC ")" FDB WORD FDB SEMIS * * ######>> screen 55 << * ======>> 155 << FCB $84 FCC 'QUI' ; 'QUIT' FCB $D4 FDB PAREN-4 QUIT FDB DOCOL,ZERO,BLK,STORE FDB LBRAK * * Here is the outer interpretter * which gets a line of input, does it, prints " OK" * then repeats : QUIT2 FDB RPSTOR,CR,QUERY,INTERP,STATE,AT,ZEQU FDB ZBRAN FDB QUIT3-* FDB PDOTQ FCB 3 FCC ' OK' ; ' OK' QUIT3 FDB BRAN FDB QUIT2-* * FDB SEMIS ( never executed ) * * ======>> 156 << FCB $85 FCC 'ABOR' ; 'ABORT' FCB $D4 FDB QUIT-7 ABORT FDB DOCOL,SPSTOR,DEC,QSTACK,DRZERO,CR,PDOTQ FCB 8 FCC "Forth-68" FDB FORTH,DEFIN FDB QUIT * FDB SEMIS never executed PAGE * * ######>> screen 56 << * bootstrap code... moves rom contents to ram : * ======>> 157 << FCB $84 FCC 'COL' ; 'COLD' FCB $C4 FDB ABORT-8 COLD FDB *+2 CENT LDS #REND-1 top of destination LDX #ERAM top of stuff to move COLD2 LEAX -1,X ; LDA 0,X PSHS A ; move TASK & FORTH to ram CMPX #RAM BNE COLD2 * LDS #XFENCE-1 put stack at a safe place for now LDX COLINT STX XCOLUM LDX DELINT STX XDELAY LDX VOCINT STX XVOCL LDX DPINIT STX XDP LDX FENCIN STX XFENCE WENT LDS #XFENCE-1 top of destination LDX #FENCIN top of stuff to move WARM2 LEAX -1,X ; LDA 0,X PSHS A ; CMPX #SINIT BNE WARM2 * LDS SINIT LDX UPINIT STX UP init user ram pointer LDX #ABORT STX IP NOP Here is a place to jump to special user NOP initializations such as I/0 interrups NOP * * For systems with TRACE: LDX #00 STX TRLIM clear trace mode LDX #0 STX BRKPT clear breakpoint address JMP RPSTOR+2 start the virtual machine running ! * * Here is the stuff that gets copied to ram : * at address $140: * RAM FDB $3000,$3000,0,0 * ======>> (152) << FCB $C5 immediate FCC 'FORT' ; 'FORTH' FCB $C8 FDB NOOP-7 RFORTH FDB DODOES,DOVOC,$81A0,TASK-7 FDB 0 FCC "(C) Forth Interest Group, 1979" FCB $84 FCC 'TAS' ; 'TASK' FCB $CB FDB FORTH-8 RTASK FDB DOCOL,SEMIS ERAM FCC "David Lion" PAGE * * ######>> screen 57 << * ======>> 158 << FCB $84 FCC 'S->' ; 'S->D' FCB $C4 FDB COLD-7 STOD FDB DOCOL,DUP,ZLESS,MINUS FDB SEMIS * * ======>> 159 << FCB $81 ; * FCB $AA FDB STOD-7 STAR FDB *+2 JSR USTARS LEAS 1,S ; LEAS 1,S ; JMP NEXT * * ======>> 160 << FCB $84 FCC '/MO' ; '/MOD' FCB $C4 FDB STAR-4 SLMOD FDB DOCOL,TOR,STOD,FROMR,USLASH FDB SEMIS * * ======>> 161 << FCB $81 ; / FCB $AF FDB SLMOD-7 SLASH FDB DOCOL,SLMOD,SWAP,DROP FDB SEMIS * * ======>> 162 << FCB $83 FCC 'MO' ; 'MOD' FCB $C4 FDB SLASH-4 MOD FDB DOCOL,SLMOD,DROP FDB SEMIS * * ======>> 163 << FCB $85 FCC '*/MO' ; '*/MOD' FCB $C4 FDB MOD-6 SSMOD FDB DOCOL,TOR,USTAR,FROMR,USLASH FDB SEMIS * * ======>> 164 << FCB $82 FCC '*' ; '*/' FCB $AF FDB SSMOD-8 SSLASH FDB DOCOL,SSMOD,SWAP,DROP FDB SEMIS * * ======>> 165 << FCB $85 FCC 'M/MO' ; 'M/MOD' FCB $C4 FDB SSLASH-5 MSMOD FDB DOCOL,TOR,ZERO,R,USLASH FDB FROMR,SWAP,TOR,USLASH,FROMR FDB SEMIS * * ======>> 166 << FCB $83 FCC 'AB' ; 'ABS' FCB $D3 FDB MSMOD-8 ABS FDB DOCOL,DUP,ZLESS,ZBRAN FDB ABS2-* FDB MINUS ABS2 FDB SEMIS * * ======>> 167 << FCB $84 FCC 'DAB' ; 'DABS' FCB $D3 FDB ABS-6 DABS FDB DOCOL,DUP,ZLESS,ZBRAN FDB DABS2-* FDB DMINUS DABS2 FDB SEMIS * * ######>> screen 58 << * Disc primatives : * ======>> 168 << FCB $83 FCC 'US' ; 'USE' FCB $C5 FDB DABS-7 USE FDB DOCON FDB XUSE * ======>> 169 << FCB $84 FCC 'PRE' ; 'PREV' FCB $D6 FDB USE-6 PREV FDB DOCON FDB XPREV * ======>> 170 << FCB $84 FCC '+BU' ; '+BUF' FCB $C6 FDB PREV-7 PBUF FDB DOCOL,CLITER FCB $84 FDB PLUS,DUP,LIMIT,EQUAL,ZBRAN FDB PBUF2-* FDB DROP,FIRST PBUF2 FDB DUP,PREV,AT,SUB FDB SEMIS * * ======>> 171 << FCB $86 FCC 'UPDAT' ; 'UPDATE' FCB $C5 FDB PBUF-7 UPDATE FDB DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE FDB SEMIS * * ======>> 172 << FCB $8D FCC 'EMPTY-BUFFER' ; 'EMPTY-BUFFERS' FCB $D3 FDB UPDATE-9 MTBUF FDB DOCOL,FIRST,LIMIT,OVER,SUB,ERASE FDB SEMIS * * ======>> 173 << FCB $83 FCC 'DR' ; 'DR0' FCB $B0 FDB MTBUF-16 DRZERO FDB DOCOL,ZERO,OFSET,STORE FDB SEMIS * * ======>> 174 <<== system dependant word FCB $83 FCC 'DR' ; 'DR1' FCB $B1 FDB DRZERO-6 DRONE FDB DOCOL,LIT,$07D0,OFSET,STORE FDB SEMIS * * ######>> screen 59 << * ======>> 175 << FCB $86 FCC 'BUFFE' ; 'BUFFER' FCB $D2 FDB DRONE-6 BUFFER FDB DOCOL,USE,AT,DUP,TOR BUFFR2 FDB PBUF,ZBRAN FDB BUFFR2-* FDB USE,STORE,R,AT,ZLESS FDB ZBRAN FDB BUFFR3-* FDB R,TWOP,R,AT,LIT,$7FFF,AND,ZERO,RW BUFFR3 FDB R,STORE,R,PREV,STORE,FROMR,TWOP FDB SEMIS * * ######>> screen 60 << * ======>> 176 << FCB $85 FCC 'BLOC' ; 'BLOCK' FCB $CB FDB BUFFER-9 BLOCK FDB DOCOL,OFSET,AT,PLUS,TOR FDB PREV,AT,DUP,AT,R,SUB,DUP,PLUS,ZBRAN FDB BLOCK5-* BLOCK3 FDB PBUF,ZEQU,ZBRAN FDB BLOCK4-* FDB DROP,R,BUFFER,DUP,R,ONE,RW,TWO,SUB BLOCK4 FDB DUP,AT,R,SUB,DUP,PLUS,ZEQU,ZBRAN FDB BLOCK3-* FDB DUP,PREV,STORE BLOCK5 FDB FROMR,DROP,TWOP FDB SEMIS * * ######>> screen 61 << * ======>> 177 << FCB $86 FCC '(LINE' ; '(LINE)' FCB $A9 FDB BLOCK-8 PLINE FDB DOCOL,TOR,CLITER FCB $40 FDB BBUF,SSMOD,FROMR,BSCR,STAR,PLUS,BLOCK,PLUS,CLITER FCB $40 FDB SEMIS * * ======>> 178 << FCB $85 FCC '.LIN' ; '.LINE' FCB $C5 FDB PLINE-9 DLINE FDB DOCOL,PLINE,DTRAIL,TYPE FDB SEMIS * * ======>> 179 << FCB $87 FCC 'MESSAG' ; 'MESSAGE' FCB $C5 FDB DLINE-8 MESS FDB DOCOL,WARN,AT,ZBRAN FDB MESS3-* FDB DDUP,ZBRAN FDB MESS3-* FDB CLITER FCB 4 FDB OFSET,AT,BSCR,SLASH,SUB,DLINE,BRAN FDB MESS4-* MESS3 FDB PDOTQ FCB 6 FCC 'err # ' ; 'err # ' FDB DOT MESS4 FDB SEMIS * * ======>> 180 << FCB $84 FCC 'LOA' ; 'LOAD' : input:scr # FCB $C4 FDB MESS-10 LOAD FDB DOCOL,BLK,AT,TOR,IN,AT,TOR,ZERO,IN,STORE FDB BSCR,STAR,BLK,STORE FDB INTERP,FROMR,IN,STORE,FROMR,BLK,STORE FDB SEMIS * * ======>> 181 << FCB $C3 FCC '--' ; '-->' FCB $BE FDB LOAD-7 ARROW FDB DOCOL,QLOAD,ZERO,IN,STORE,BSCR FDB BLK,AT,OVER,MOD,SUB,BLK,PSTORE FDB SEMIS PAGE * * * ######>> screen 63 << * The next 4 subroutines are machine dependent, and are * called by words 13 through 16 in the dictionary. * * ======>> 182 << code for EMIT PEMIT STB N save B STX N+1 save X LDB ACIAC BITB #2 check ready bit BEQ PEMIT+4 if not ready for more data STA ACIAD LDX UP STB IOSTAT-UORIG,X LDB N recover B & X LDX N+1 RTS only A register may change * PEMIT JMP $E1D1 for MIKBUG * PEMIT FCB $3F,$11,$39 for PROTO * PEMIT JMP $D286 for Smoke Signal DOS * * ======>> 183 << code for KEY PKEY STB N STX N+1 LDB ACIAC ASRB ; BCC PKEY+4 no incoming data yet LDA ACIAD ANDA #$7F strip parity bit LDX UP STB IOSTAT+1-UORIG,X LDB N LDX N+1 RTS * PKEY JMP $E1AC for MIKBUG * PKEY FCB $3F,$14,$39 for PROTO * PKEY JMP $D289 for Smoke Signal DOS * * ######>> screen 64 << * ======>> 184 << code for ?TERMINAL PQTER LDA ACIAC Test for 'break' condition ANDA #$11 mask framing error bit and * input buffer full BEQ PQTER2 LDA ACIAD clear input buffer LDA #01 PQTER2 RTS PAGE * * ======>> 185 << code for CR PCR LDA #$D carriage return BSR PEMIT LDA #$A line feed BSR PEMIT LDA #$7F rubout LDX UP LDB XDELAY+1-UORIG,X PCR2 DECB ; BMI PQTER2 return if minus PSHS B ; save counter BSR PEMIT print RUBOUTs to delay..... PULS B ; BRA PCR2 repeat PAGE * * ######>> screen 66 << * ======>> 187 << FCB $85 FCC '?DIS' ; '?DISC' FCB $C3 FDB ARROW-6 QDISC FDB *+2 JMP NEXT * * ######>> screen 67 << * ======>> 189 << FCB $8B FCC 'BLOCK-WRIT' ; 'BLOCK-WRITE' FCB $C5 FDB QDISC-8 BWRITE FDB *+2 JMP NEXT * * ######>> screen 68 << * ======>> 190 << FCB $8A FCC 'BLOCK-REA' ; 'BLOCK-READ' FCB $C4 FDB BWRITE-14 BREAD FDB *+2 JMP NEXT * *The next 3 words are written to create a substitute for disc * mass memory,located between $3210 & $3FFF in ram. * ======>> 190.1 << FCB $82 FCC 'L' ; 'LO' FCB $CF FDB BREAD-13 LO FDB DOCON FDB MEMEND a system dependent equate at front * * ======>> 190.2 << FCB $82 FCC 'H' ; 'HI' FCB $C9 FDB LO-5 HI FDB DOCON FDB MEMTOP ( $3FFF in this version ) * * ######>> screen 69 << * ======>> 191 << FCB $83 FCC 'R/' ; 'R/W' FCB $D7 FDB HI-5 RW FDB DOCOL,TOR,BBUF,STAR,LO,PLUS,DUP,HI,GREAT,ZBRAN FDB RW2-* FDB PDOTQ FCB 8 FCC ' Range ?' ; ' Range ?' FDB QUIT RW2 FDB FROMR,ZBRAN FDB RW3-* FDB SWAP RW3 FDB BBUF,CMOVE FDB SEMIS * * ######>> screen 72 << * ======>> 192 << FCB $C1 immediate FCB $A7 ' ( tick ) FDB RW-6 TICK FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,LITER FDB SEMIS * * ======>> 193 << FCB $86 FCC 'FORGE' ; 'FORGET' FCB $D4 FDB TICK-4 FORGET FDB DOCOL,CURENT,AT,CONTXT,AT,SUB,CLITER FCB $18 FDB QERR,TICK,DUP,FENCE,AT,LESS,CLITER FCB $15 FDB QERR,DUP,ZERO,PORIG,GREAT,CLITER FCB $15 FDB QERR,DUP,NFA,DP,STORE,LFA,AT,CONTXT,AT,STORE FDB SEMIS * * ######>> screen 73 << * ======>> 194 << FCB $84 FCC 'BAC' ; 'BACK' FCB $CB FDB FORGET-9 BACK FDB DOCOL,HERE,SUB,COMMA FDB SEMIS * * ======>> 195 << FCB $C5 FCC 'BEGI' ; 'BEGIN' FCB $CE FDB BACK-7 BEGIN FDB DOCOL,QCOMP,HERE,ONE FDB SEMIS * * ======>> 196 << FCB $C5 FCC 'ENDI' ; 'ENDIF' FCB $C6 FDB BEGIN-8 ENDIF FDB DOCOL,QCOMP,TWO,QPAIRS,HERE FDB OVER,SUB,SWAP,STORE FDB SEMIS * * ======>> 197 << FCB $C4 FCC 'THE' ; 'THEN' FCB $CE FDB ENDIF-8 THEN FDB DOCOL,ENDIF FDB SEMIS * * ======>> 198 << FCB $C2 FCC 'D' ; 'DO' FCB $CF FDB THEN-7 DO FDB DOCOL,COMPIL,XDO,HERE,THREE FDB SEMIS * * ======>> 199 << FCB $C4 FCC 'LOO' ; 'LOOP' FCB $D0 FDB DO-5 LOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK FDB SEMIS * * ======>> 200 << FCB $C5 FCC '+LOO' ; '+LOOP' FCB $D0 FDB LOOP-7 PLOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK FDB SEMIS * * ======>> 201 << FCB $C5 FCC 'UNTI' ; 'UNTIL' : ( same as END ) FCB $CC FDB PLOOP-8 UNTIL FDB DOCOL,ONE,QPAIRS,COMPIL,ZBRAN,BACK FDB SEMIS * * ######>> screen 74 << * ======>> 202 << FCB $C3 FCC 'EN' ; 'END' FCB $C4 FDB UNTIL-8 END FDB DOCOL,UNTIL FDB SEMIS * * ======>> 203 << FCB $C5 FCC 'AGAI' ; 'AGAIN' FCB $CE FDB END-6 AGAIN FDB DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK FDB SEMIS * * ======>> 204 << FCB $C6 FCC 'REPEA' ; 'REPEAT' FCB $D4 FDB AGAIN-8 REPEAT FDB DOCOL,TOR,TOR,AGAIN,FROMR,FROMR FDB TWO,SUB,ENDIF FDB SEMIS * * ======>> 205 << FCB $C2 FCC 'I' ; 'IF' FCB $C6 FDB REPEAT-9 IF FDB DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO FDB SEMIS * * ======>> 206 << FCB $C4 FCC 'ELS' ; 'ELSE' FCB $C5 FDB IF-5 ELSE FDB DOCOL,TWO,QPAIRS,COMPIL,BRAN,HERE FDB ZERO,COMMA,SWAP,TWO,ENDIF,TWO FDB SEMIS * * ======>> 207 << FCB $C5 FCC 'WHIL' ; 'WHILE' FCB $C5 FDB ELSE-7 WHILE FDB DOCOL,IF,TWOP FDB SEMIS * * ######>> screen 75 << * ======>> 208 << FCB $86 FCC 'SPACE' ; 'SPACES' FCB $D3 FDB WHILE-8 SPACES FDB DOCOL,ZERO,MAX,DDUP,ZBRAN FDB SPACE3-* FDB ZERO,XDO SPACE2 FDB SPACE,XLOOP FDB SPACE2-* SPACE3 FDB SEMIS * * ======>> 209 << FCB $82 FCC '<' ; '<#' FCB $A3 FDB SPACES-9 BDIGS FDB DOCOL,PAD,HLD,STORE FDB SEMIS * * ======>> 210 << FCB $82 FCC '#' ; '#>' FCB $BE FDB BDIGS-5 EDIGS FDB DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB FDB SEMIS * * ======>> 211 << FCB $84 FCC 'SIG' ; 'SIGN' FCB $CE FDB EDIGS-5 SIGN FDB DOCOL,ROT,ZLESS,ZBRAN FDB SIGN2-* FDB CLITER FCC "-" FDB HOLD SIGN2 FDB SEMIS * * ======>> 212 << FCB $81 # FCB $A3 FDB SIGN-7 DIG FDB DOCOL,BASE,AT,MSMOD,ROT,CLITER FCB 9 FDB OVER,LESS,ZBRAN FDB DIG2-* FDB CLITER FCB 7 FDB PLUS DIG2 FDB CLITER FCC "0" ascii zero FDB PLUS,HOLD FDB SEMIS * * ======>> 213 << FCB $82 FCC '#' ; '#S' FCB $D3 FDB DIG-4 DIGS FDB DOCOL DIGS2 FDB DIG,OVER,OVER,OR,ZEQU,ZBRAN FDB DIGS2-* FDB SEMIS * * ######>> screen 76 << * ======>> 214 << FCB $82 FCC '.' ; '.R' FCB $D2 FDB DIGS-5 DOTR FDB DOCOL,TOR,STOD,FROMR,DDOTR FDB SEMIS * * ======>> 215 << FCB $83 FCC 'D.' ; 'D.R' FCB $D2 FDB DOTR-5 DDOTR FDB DOCOL,TOR,SWAP,OVER,DABS,BDIGS,DIGS,SIGN FDB EDIGS,FROMR,OVER,SUB,SPACES,TYPE FDB SEMIS * * ======>> 216 << FCB $82 FCC 'D' ; 'D.' FCB $AE FDB DDOTR-6 DDOT FDB DOCOL,ZERO,DDOTR,SPACE FDB SEMIS * * ======>> 217 << FCB $81 . FCB $AE FDB DDOT-5 DOT FDB DOCOL,STOD,DDOT FDB SEMIS * * ======>> 218 << FCB $81 ? FCB $BF FDB DOT-4 QUEST FDB DOCOL,AT,DOT FDB SEMIS * * ######>> screen 77 << * ======>> 219 << FCB $84 FCC 'LIS' ; 'LIST' FCB $D4 FDB QUEST-4 LIST FDB DOCOL,DEC,CR,DUP,SCR,STORE,PDOTQ FCB 6 FCC "SCR # " FDB DOT,CLITER FCB $10 FDB ZERO,XDO LIST2 FDB CR,I,THREE FDB DOTR,SPACE,I,SCR,AT,DLINE,XLOOP FDB LIST2-* FDB CR FDB SEMIS * * ======>> 220 << FCB $85 FCC 'INDE' ; 'INDEX' FCB $D8 FDB LIST-7 INDEX FDB DOCOL,CR,ONEP,SWAP,XDO INDEX2 FDB CR,I,THREE FDB DOTR,SPACE,ZERO,I,DLINE FDB QTERM,ZBRAN FDB INDEX3-* FDB LEAVE INDEX3 FDB XLOOP FDB INDEX2-* FDB SEMIS * * ======>> 221 << FCB $85 FCC 'TRIA' ; 'TRIAD' FCB $C4 FDB INDEX-8 TRIAD FDB DOCOL,THREE,SLASH,THREE,STAR FDB THREE,OVER,PLUS,SWAP,XDO TRIAD2 FDB CR,I FDB LIST,QTERM,ZBRAN FDB TRIAD3-* FDB LEAVE TRIAD3 FDB XLOOP FDB TRIAD2-* FDB CR,CLITER FCB $0F FDB MESS,CR FDB SEMIS * * ######>> screen 78 << * ======>> 222 << FCB $85 FCC 'VLIS' ; 'VLIST' FCB $D4 FDB TRIAD-8 VLIST FDB DOCOL,CLITER FCB $80 FDB OUT,STORE,CONTXT,AT,AT VLIST1 FDB OUT,AT,COLUMS,AT,CLITER FCB 32 FDB SUB,GREAT,ZBRAN FDB VLIST2-* FDB CR,ZERO,OUT,STORE VLIST2 FDB DUP,IDDOT,SPACE,SPACE,PFA,LFA,AT FDB DUP,ZEQU,QTERM,OR,ZBRAN FDB VLIST1-* FDB DROP FDB SEMIS * * ======>> XX << FCB $84 FCC 'NOO' ; 'NOOP' FCB $D0 FDB VLIST-8 NOOP FDB NEXT a useful no-op ZZZZ FDB 0,0,0,0,0,0,0,0 end of rom program PAGE OPT L END