--- /dev/null
+ OPT PRT
+
+* fig-FORTH FOR 6809, converted by unintelligent conversion from 6800 source.
+* 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 ANDB 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 4,FORTH
+ FCB $C8
+ FDB NOOP-7
+FORTH FDB DODOES,DOVOC,$81A0,TASK-7
+ FDB 0
+*
+ FCC "(C) Forth Interest Group, 1979"
+
+ FCB $84
+ FCC 3,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 2,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 6,EXECUTE
+ FCB $C5
+ FDB LIT-6
+EXEC FDB *+2
+ TFR S,X
+ LDX 0,X ; get code field address (CFA)
+ LEAS 1,S ; pop stack
+ LEAS 1,S
+ JMP NEXT3
+*
+* ######>> screen 15 <<
+* ======>> 4 <<
+ FCB $86
+ FCC 5,BRANCH
+ FCB $C8
+ FDB EXEC-10
+BRAN FDB ZBYES ; Go steal code in ZBRANCH
+*
+* ======>> 5 <<
+ FCB $87
+ FCC 6,0BRANCH
+ FCB $C8
+ FDB BRAN-9
+ZBRAN FDB *+2
+ PULS A
+ PULS B
+* ABA is only used here.
+* Could immediately convert PULs to LDD ,S++ ;
+* with no need for trailing BCS to look for overflow
+* because we are only testing for non-zero, but,
+* converting as if by unintelligent macro:
+ PSHS B ; LOL
+ ADDA ,S+
+* End of unintelligent ABA conversion.
+ 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 5,(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 6,(+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 #1
+ 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 3,(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 4,DIGIT
+ FCB $D4
+ FDB I-4
+DIGIT FDB *+2 ; NOTE: legal input range is 0-9, A-Z
+ TFR S,X
+ 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
+ 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 5,(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
+PCT EQU N+6 ; PC in 6800 source
+ 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 PCT
+ 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 ; sim 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 ; sim 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 ; sim 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 PCT
+ PSHS A
+ CLRA
+ PSHS A
+ LDB #1
+ JMP PUSHBA
+*
+ PSHS A
+ CLRA
+ PSHS A
+ LDB #1
+ JMP PUSHBA
+*
+* ######>> screen 20 <<
+* ======>> 12 <<
+ FCB $87
+ FCC 6,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
+ LDX 0,X
+ CLR N
+* wait for a non-delimiter or a NUL
+ENCL2 LDA 0,X
+ BEQ ENCL6
+ PSHS B ; sim 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 ; sim 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 3,EMIT
+ FCB $D4
+ FDB ENCLOS-10
+EMIT FDB *+2
+ PULS A
+ PULS A
+ JSR PEMIT
+ LDX UP
+ INC XOUT+1-UORIG,X
+ BNE *+4
+ INC XOUT-UORIG,X
+ JMP NEXT
+*
+* ======>> 14 <<
+ FCB $83
+ FCC 2,KEY
+ FCB $D9
+ FDB EMIT-7
+KEY FDB *+2
+ JSR PKEY
+ PSHS A
+ CLRA
+ PSHS A
+ JMP NEXT
+*
+* ======>> 15 <<
+ FCB $89
+ FCC 8,?TERMINAL
+ FCB $CC
+ FDB KEY-6
+QTERM FDB *+2
+ JSR PQTER
+ CLRB
+ JMP PUSHBA stack the flag
+*
+* ======>> 16 <<
+ FCB $82
+ FCC 1,CR
+ FCB $D2
+ FDB QTERM-12
+CR FDB *+2
+ JSR PRTCR
+ JMP NEXT
+*
+* ######>> screen 22 <<
+* ======>> 17 <<
+ FCB $85
+ FCC 4,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 1,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
+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 1,U/
+ FCB $AF
+ FDB USTAR-5
+USLASH FDB *+2
+ LDA #17
+ PSHS A
+ TFR S,X
+ LDA 3,X
+ LDB 4,X
+USL1 CMPA 1,X
+ BHI USL3
+ BCS USL2
+ CMPB 2,X
+ BCC USL3
+USL2 ANDCC #~1
+ BRA USL4
+USL3 SUBB 2,X
+ SBCA 1,X
+ ORCC #1
+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 2,AND
+ FCB $C4
+ FDB USLASH-5
+AND FDB *+2
+ PULS A
+ PULS B
+ TFR S,X
+ ANDB 1,X
+ ANDA 0,X
+ JMP STABX
+*
+* ======>> 21 <<
+ FCB $82
+ FCC 1,OR
+ FCB $D2
+ FDB AND-6
+OR FDB *+2
+ PULS A
+ PULS B
+ TFR S,X
+ ORB 1,X
+ ORA 0,X
+ JMP STABX
+*
+* ======>> 22 <<
+ FCB $83
+ FCC 2,XOR
+ FCB $D2
+ FDB OR-5
+XOR FDB *+2
+ PULS A
+ PULS B
+ TFR S,X
+ EORB 1,X
+ EORA 0,X
+ JMP STABX
+*
+* ######>> screen 26 <<
+* ======>> 23 <<
+ FCB $83
+ FCC 2,SP@
+ FCB $C0
+ FDB XOR-6
+SPAT FDB *+2
+ TFR S,X
+ STX N scratch area
+ LDX #N
+ JMP GETX
+*
+* ======>> 24 <<
+ FCB $83
+ FCC 2,SP!
+ FCB $A1
+ FDB SPAT-6
+SPSTOR FDB *+2
+ LDX UP
+ LDX XSPZER-UORIG,X
+* Potential problem area? ******
+ TFR X,S watch it ! X and S are not equal.
+ JMP NEXT
+* ======>> 25 <<
+ FCB $83
+ FCC 2,RP!
+ FCB $A1
+ FDB SPSTOR-6
+RPSTOR FDB *+2
+ LDX RINIT initialize from rom constant
+ STX RP
+ JMP NEXT
+*
+* ======>> 26 <<
+ FCB $82
+ FCC 1,;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 4,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 1,>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 1,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 1,0=
+ FCB $BD
+ FDB R-4
+ZEQU FDB *+2
+ TFR S,X
+ CLRA
+ CLRB
+ LDX 0,X
+ BNE ZEQU2
+ INCB
+ZEQU2 TFR S,X
+ JMP STABX
+*
+* ======>> 32 <<
+ FCB $82
+ FCC 1,0<
+ FCB $BC
+ FDB ZEQU-5
+ZLESS FDB *+2
+ TFR S,X
+ 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
+ ADDB 1,X
+ ADCA 0,X
+ JMP STABX
+*
+* ======>> 34 <<
+ FCB $82
+ FCC 1,D+
+ FCB $AB
+ FDB PLUS-4
+DPLUS FDB *+2
+ TFR S,X
+ ANDCC #~1
+ 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 4,MINUS
+ FCB $D3
+ FDB DPLUS-5
+MINUS FDB *+2
+ TFR S,X
+ NEG 1,X
+ BCC MINUS2
+ NEG 0,X
+ BRA MINUS3
+MINUS2 COM 0,X
+MINUS3 JMP NEXT
+*
+* ======>> 36 <<
+ FCB $86
+ FCC 5,DMINUS
+ FCB $D3
+ FDB MINUS-8
+DMINUS FDB *+2
+ TFR S,X
+ 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 3,OVER
+ FCB $D2
+ FDB DMINUS-9
+OVER FDB *+2
+ TFR S,X
+ LDA 2,X
+ LDB 3,X
+ JMP PUSHBA
+*
+* ======>> 38 <<
+ FCB $84
+ FCC 3,DROP
+ FCB $D0
+ FDB OVER-7
+DROP FDB *+2
+ LEAS 1,S
+ LEAS 1,S
+ JMP NEXT
+*
+* ======>> 39 <<
+ FCB $84
+ FCC 3,SWAP
+ FCB $D0
+ FDB DROP-7
+SWAP FDB *+2
+ PULS A
+ PULS B
+ TFR S,X
+ LDX 0,X
+ LEAS 1,S
+ LEAS 1,S
+ PSHS B
+ PSHS A
+ STX N
+ LDX #N
+ JMP GETX
+*
+* ======>> 40 <<
+ FCB $83
+ FCC 2,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 1,+!
+ FCB $A1
+ FDB DUP-6
+PSTORE FDB *+2
+ TFR S,X
+ 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 5,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
+ LDX 0,X get address
+ LEAS 1,S
+ LEAS 1,S
+ JMP GETX
+*
+* ======>> 44 <<
+ FCB $82
+ FCC 1,C@
+ FCB $C0
+ FDB AT-4
+CAT FDB *+2
+ TFR S,X
+ 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
+ LDX 0,X get address
+ LEAS 1,S
+ LEAS 1,S
+ JMP PULABX
+*
+* ======>> 46 <<
+ FCB $82
+ FCC 1,C!
+ FCB $A1
+ FDB STORE-4
+CSTORE FDB *+2
+ TFR S,X
+ 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 7,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 7,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 3,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 1,BL
+ FCB $CC
+ FDB THREE-4
+BL FDB DOCON ascii blank
+ FDB $20
+*
+* ======>> 57 <<
+ FCB $85
+ FCC 4,FIRST
+ FCB $D4
+ FDB BL-5
+FIRST FDB DOCON
+ FDB MEMEND-528 (132 * NBLK)
+*
+* ======>> 58 <<
+ FCB $85
+ FCC 4,LIMIT ( the end of memory +1 )
+ FCB $D4
+ FDB FIRST-8
+LIMIT FDB DOCON
+ FDB MEMEND
+*
+* ======>> 59 <<
+ FCB $85
+ FCC 4,B/BUF (bytes/buffer)
+ FCB $C6
+ FDB LIMIT-8
+BBUF FDB DOCON
+ FDB 128
+*
+* ======>> 60 <<
+ FCB $85
+ FCC 4,B/SCR (blocks/screen)
+ FCB $D2
+ FDB BBUF-8
+BSCR FDB DOCON
+ FDB 8
+* blocks/screen = 1024 / "B/BUF" = 8
+*
+* ======>> 61 <<
+ FCB $87
+ FCC 6,+ORIGIN
+ FCB $CE
+ FDB BSCR-8
+PORIG FDB DOCOL,LIT,ORIG,PLUS
+ FDB SEMIS
+*
+* ######>> screen 36 <<
+* ======>> 62 <<
+ FCB $82
+ FCC 1,S0
+ FCB $B0
+ FDB PORIG-10
+SZERO FDB DOUSER
+ FDB XSPZER-UORIG
+*
+* ======>> 63 <<
+ FCB $82
+ FCC 1,R0
+ FCB $B0
+ FDB SZERO-5
+RZERO FDB DOUSER
+ FDB XRZERO-UORIG
+*
+* ======>> 64 <<
+ FCB $83
+ FCC 2,TIB
+ FCB $C2
+ FDB RZERO-5
+TIB FDB DOUSER
+ FDB XTIB-UORIG
+*
+* ======>> 65 <<
+ FCB $85
+ FCC 4,WIDTH
+ FCB $C8
+ FDB TIB-6
+WIDTH FDB DOUSER
+ FDB XWIDTH-UORIG
+*
+* ======>> 66 <<
+ FCB $87
+ FCC 6,WARNING
+ FCB $C7
+ FDB WIDTH-8
+WARN FDB DOUSER
+ FDB XWARN-UORIG
+*
+* ======>> 67 <<
+ FCB $85
+ FCC 4,FENCE
+ FCB $C5
+ FDB WARN-10
+FENCE FDB DOUSER
+ FDB XFENCE-UORIG
+*
+* ======>> 68 <<
+ FCB $82
+ FCC 1,DP points to first free byte at end of dictionary
+ FCB $D0
+ FDB FENCE-8
+DICPT FDB DOUSER ; DP in 6800 source
+ FDB XDP-UORIG
+*
+* ======>> 68.5 <<
+ FCB $88
+ FCC 7,VOC-LINK
+ FCB $CB
+ FDB DICPT-5
+VOCLIN FDB DOUSER
+ FDB XVOCL-UORIG
+*
+* ======>> 69 <<
+ FCB $83
+ FCC 2,BLK
+ FCB $CB
+ FDB VOCLIN-11
+BLK FDB DOUSER
+ FDB XBLK-UORIG
+*
+* ======>> 70 <<
+ FCB $82
+ FCC 1,IN scan pointer for input line buffer
+ FCB $CE
+ FDB BLK-6
+IN FDB DOUSER
+ FDB XIN-UORIG
+*
+* ======>> 71 <<
+ FCB $83
+ FCC 2,OUT
+ FCB $D4
+ FDB IN-5
+OUT FDB DOUSER
+ FDB XOUT-UORIG
+*
+* ======>> 72 <<
+ FCB $83
+ FCC 2,SCR
+ FCB $D2
+ FDB OUT-6
+SCR FDB DOUSER
+ FDB XSCR-UORIG
+* ######>> screen 37 <<
+*
+* ======>> 73 <<
+ FCB $86
+ FCC 5,OFFSET
+ FCB $D4
+ FDB SCR-6
+OFSET FDB DOUSER
+ FDB XOFSET-UORIG
+*
+* ======>> 74 <<
+ FCB $87
+ FCC 6,CONTEXT points to pointer to vocab to search first
+ FCB $D4
+ FDB OFSET-9
+CONTXT FDB DOUSER
+ FDB XCONT-UORIG
+*
+* ======>> 75 <<
+ FCB $87
+ FCC 6,CURRENT points to ptr. to vocab being extended
+ FCB $D4
+ FDB CONTXT-10
+CURENT FDB DOUSER
+ FDB XCURR-UORIG
+*
+* ======>> 76 <<
+ FCB $85
+ FCC 4,STATE 1 if compiling, 0 if not
+ FCB $C5
+ FDB CURENT-10
+STATE FDB DOUSER
+ FDB XSTATE-UORIG
+*
+* ======>> 77 <<
+ FCB $84
+ FCC 3,BASE number base for all input & output
+ FCB $C5
+ FDB STATE-8
+BASE FDB DOUSER
+ FDB XBASE-UORIG
+*
+* ======>> 78 <<
+ FCB $83
+ FCC 2,DPL
+ FCB $CC
+ FDB BASE-7
+DPL FDB DOUSER
+ FDB XDPL-UORIG
+*
+* ======>> 79 <<
+ FCB $83
+ FCC 2,FLD
+ FCB $C4
+ FDB DPL-6
+FLD FDB DOUSER
+ FDB XFLD-UORIG
+*
+* ======>> 80 <<
+ FCB $83
+ FCC 2,CSP
+ FCB $D0
+ FDB FLD-6
+CSP FDB DOUSER
+ FDB XCSP-UORIG
+*
+* ======>> 81 <<
+ FCB $82
+ FCC 1,R#
+ FCB $A3
+ FDB CSP-6
+RNUM FDB DOUSER
+ FDB XRNUM-UORIG
+*
+* ======>> 82 <<
+ FCB $83
+ FCC 2,HLD
+ FCB $C4
+ FDB RNUM-5
+HLD FDB DOCON
+ FDB XHLD
+*
+* ======>> 82.5 <<== SPECIAL
+ FCB $87
+ FCC 6,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 1,2+
+ FCB $AB
+ FDB ONEP-5
+TWOP FDB DOCOL,TWO,PLUS
+ FDB SEMIS
+*
+* ======>> 85 <<
+ FCB $84
+ FCC 3,HERE
+ FCB $C5
+ FDB TWOP-5
+HERE FDB DOCOL,DICPT,AT
+ FDB SEMIS
+*
+* ======>> 86 <<
+ FCB $85
+ FCC 4,ALLOT
+ FCB $D4
+ FDB HERE-7
+ALLOT FDB DOCOL,DICPT,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 1,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
+ 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 2,ROT
+ FCB $D4
+ FDB GREAT-4
+ROT FDB DOCOL,TOR,SWAP,FROMR,SWAP
+ FDB SEMIS
+*
+* ======>> 94 <<
+ FCB $85
+ FCC 4,SPACE
+ FCB $C5
+ FDB ROT-6
+SPACE FDB DOCOL,BL,EMIT
+ FDB SEMIS
+*
+* ======>> 95 <<
+ FCB $83
+ FCC 2,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 2,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 3,-DUP
+ FCB $D0
+ FDB MAX-6
+DDUP FDB DOCOL,DUP,ZBRAN
+ FDB DDUP2-*
+ FDB DUP
+DDUP2 FDB SEMIS
+*
+* ######>> screen 39 <<
+* ======>> 98 <<
+ FCB $88
+ FCC 7,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 5,LATEST
+ FCB $D4
+ FDB TRAV-11
+LATEST FDB DOCOL,CURENT,AT,AT
+ FDB SEMIS
+*
+* ======>> 100 <<
+ FCB $83
+ FCC 2,LFA
+ FCB $C1
+ FDB LATEST-9
+LFA FDB DOCOL,CLITER
+ FCB 4
+ FDB SUB
+ FDB SEMIS
+*
+* ======>> 101 <<
+ FCB $83
+ FCC 2,CFA
+ FCB $C1
+ FDB LFA-6
+CFA FDB DOCOL,TWO,SUB
+ FDB SEMIS
+*
+* ======>> 102 <<
+ FCB $83
+ FCC 2,NFA
+ FCB $C1
+ FDB CFA-6
+NFA FDB DOCOL,CLITER
+ FCB 5
+ FDB SUB,ONE,MINUS,TRAV
+ FDB SEMIS
+*
+* ======>> 103 <<
+ FCB $83
+ FCC 2,PFA
+ FCB $C1
+ FDB NFA-6
+PFA FDB DOCOL,ONE,TRAV,CLITER
+ FCB 5
+ FDB PLUS
+ FDB SEMIS
+*
+* ######>> screen 40 <<
+* ======>> 104 <<
+ FCB $84
+ FCC 3,!CSP
+ FCB $D0
+ FDB PFA-6
+SCSP FDB DOCOL,SPAT,CSP,STORE
+ FDB SEMIS
+*
+* ======>> 105 <<
+ FCB $86
+ FCC 5,?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 4,?COMP
+ FCB $D0
+ FDB QERR-9
+QCOMP FDB DOCOL,STATE,AT,ZEQU,CLITER
+ FCB $11
+ FDB QERR
+ FDB SEMIS
+*
+* ======>> 107 <<
+ FCB $85
+ FCC 4,?EXEC
+ FCB $C3
+ FDB QCOMP-8
+QEXEC FDB DOCOL,STATE,AT,CLITER
+ FCB $12
+ FDB QERR
+ FDB SEMIS
+*
+* ======>> 108 <<
+ FCB $86
+ FCC 5,?PAIRS
+ FCB $D3
+ FDB QEXEC-8
+QPAIRS FDB DOCOL,SUB,CLITER
+ FCB $13
+ FDB QERR
+ FDB SEMIS
+*
+* ======>> 109 <<
+ FCB $84
+ FCC 3,?CSP
+ FCB $D0
+ FDB QPAIRS-9
+QCSP FDB DOCOL,SPAT,CSP,AT,SUB,CLITER
+ FCB $14
+ FDB QERR
+ FDB SEMIS
+*
+* ======>> 110 <<
+ FCB $88
+ FCC 7,?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 6,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 5,SMUDGE
+ FCB $C5
+ FDB RBRAK-4
+SMUDGE FDB DOCOL,LATEST,CLITER
+ FCB $20
+ FDB TOGGLE
+ FDB SEMIS
+*
+* ======>> 115 <<
+ FCB $83
+ FCC 2,HEX
+ FCB $D8
+ FDB SMUDGE-9
+HEX FDB DOCOL
+ FDB CLITER
+ FCB 16
+ FDB BASE,STORE
+ FDB SEMIS
+*
+* ======>> 116 <<
+ FCB $87
+ FCC 6,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 6,(;CODE)
+ FCB $A9
+ FDB DEC-10
+PSCODE FDB DOCOL,FROMR,TWOP,LATEST,PFA,CFA,STORE
+ FDB SEMIS
+*
+* ======>> 118 <<
+ FCB $C5 immediate
+ FCC 4,;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 6,<BUILDS
+ FCB $D3
+ FDB SEMIC-8
+BUILDS FDB DOCOL,ZERO,CON
+ FDB SEMIS
+*
+* ======>> 120 <<
+ FCB $85
+ FCC 4,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 4,COUNT
+ FCB $D4
+ FDB DOES-8
+COUNT FDB DOCOL,DUP,ONEP,SWAP,CAT
+ FDB SEMIS
+*
+* ======>> 122 <<
+ FCB $84
+ FCC 3,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 8,-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 3,(.")
+ 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 1,."
+ 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 5,?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 5,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 4,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 3,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 4,ERASE
+ FCB $C5
+ FDB FILL-7
+ERASE FDB DOCOL,ZERO,FILL
+ FDB SEMIS
+*
+* ======>> 135 <<
+ FCB $86
+ FCC 5,BLANKS
+ FCB $D3
+ FDB ERASE-8
+BLANKS FDB DOCOL,BL,FILL
+ FDB SEMIS
+*
+* ======>> 136 <<
+ FCB $84
+ FCC 3,HOLD
+ FCB $C4
+ FDB BLANKS-9
+HOLD FDB DOCOL,LIT,$FFFF,HLD,PSTORE,HLD,AT,CSTORE
+ FDB SEMIS
+*
+* ======>> 137 <<
+ FCB $83
+ FCC 2,PAD
+ FCB $C4
+ FDB HOLD-7
+PAD FDB DOCOL,HERE,CLITER
+ FCB $44
+ FDB PLUS
+ FDB SEMIS
+*
+* ######>> screen 48 <<
+* ======>> 138 <<
+ FCB $84
+ FCC 3,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 7,(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 5,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 4,-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 6,(ABORT)
+ FCB $A9
+ FDB DFIND-8
+PABORT FDB DOCOL,ABORT
+ FDB SEMIS
+*
+* ======>> 143 <<
+ FCB $85
+ FCC 4,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 2,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 5,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 8,[COMPILE]
+ FCB $DD
+ FDB CREATE-9
+BCOMP FDB DOCOL,DFIND,ZEQU,ZERO,QERR,DROP,CFA,COMMA
+ FDB SEMIS
+*
+* ======>> 147 <<
+ FCB $C7 immediate
+ FCC 6,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 7,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 8,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 8,IMMEDIATE
+ FCB $C5
+ FDB INTERP-12
+IMMED FDB DOCOL,LATEST,CLITER
+ FCB $40
+ FDB TOGGLE
+ FDB SEMIS
+*
+* ======>> 151 <<
+ FCB $8A
+ FCC 9,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 10,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 3,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 3, OK
+QUIT3 FDB BRAN
+ FDB QUIT2-*
+* FDB SEMIS ( never executed )
+*
+* ======>> 156 <<
+ FCB $85
+ FCC 4,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 3,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 4,FORTH
+ FCB $C8
+ FDB NOOP-7
+RFORTH FDB DODOES,DOVOC,$81A0,TASK-7
+ FDB 0
+ FCC "(C) Forth Interest Group, 1979"
+ FCB $84
+ FCC 3,TASK
+ FCB $CB
+ FDB FORTH-8
+RTASK FDB DOCOL,SEMIS
+ERAM FCC "David Lion"
+ PAGE
+*
+* ######>> screen 57 <<
+* ======>> 158 <<
+ FCB $84
+ FCC 3,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 3,/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 2,MOD
+ FCB $C4
+ FDB SLASH-4
+MOD FDB DOCOL,SLMOD,DROP
+ FDB SEMIS
+*
+* ======>> 163 <<
+ FCB $85
+ FCC 4,*/MOD
+ FCB $C4
+ FDB MOD-6
+SSMOD FDB DOCOL,TOR,USTAR,FROMR,USLASH
+ FDB SEMIS
+*
+* ======>> 164 <<
+ FCB $82
+ FCC 1,*/
+ FCB $AF
+ FDB SSMOD-8
+SSLASH FDB DOCOL,SSMOD,SWAP,DROP
+ FDB SEMIS
+*
+* ======>> 165 <<
+ FCB $85
+ FCC 4,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 2,ABS
+ FCB $D3
+ FDB MSMOD-8
+ABS FDB DOCOL,DUP,ZLESS,ZBRAN
+ FDB ABS2-*
+ FDB MINUS
+ABS2 FDB SEMIS
+*
+* ======>> 167 <<
+ FCB $84
+ FCC 3,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 2,USE
+ FCB $C5
+ FDB DABS-7
+USE FDB DOCON
+ FDB XUSE
+* ======>> 169 <<
+ FCB $84
+ FCC 3,PREV
+ FCB $D6
+ FDB USE-6
+PREV FDB DOCON
+ FDB XPREV
+* ======>> 170 <<
+ FCB $84
+ FCC 3,+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 5,UPDATE
+ FCB $C5
+ FDB PBUF-7
+UPDATE FDB DOCOL,PREV,AT,AT,LIT,$8000,OR,PREV,AT,STORE
+ FDB SEMIS
+*
+* ======>> 172 <<
+ FCB $8D
+ FCC 12,EMPTY-BUFFERS
+ FCB $D3
+ FDB UPDATE-9
+MTBUF FDB DOCOL,FIRST,LIMIT,OVER,SUB,ERASE
+ FDB SEMIS
+*
+* ======>> 173 <<
+ FCB $83
+ FCC 2,DR0
+ FCB $B0
+ FDB MTBUF-16
+DRZERO FDB DOCOL,ZERO,OFSET,STORE
+ FDB SEMIS
+*
+* ======>> 174 <<== system dependant word
+ FCB $83
+ FCC 2,DR1
+ FCB $B1
+ FDB DRZERO-6
+DRONE FDB DOCOL,LIT,$07D0,OFSET,STORE
+ FDB SEMIS
+*
+* ######>> screen 59 <<
+* ======>> 175 <<
+ FCB $86
+ FCC 5,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 4,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 5,(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 4,.LINE
+ FCB $C5
+ FDB PLINE-9
+DLINE FDB DOCOL,PLINE,DTRAIL,TYPE
+ FDB SEMIS
+*
+* ======>> 179 <<
+ FCB $87
+ FCC 6,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 6,err #
+ FDB DOT
+MESS4 FDB SEMIS
+*
+* ======>> 180 <<
+ FCB $84
+ FCC 3,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 2,-->
+ 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
+PRTCR LDA #$D carriage return ; PCR in 6800 source
+ 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 4,?DISC
+ FCB $C3
+ FDB ARROW-6
+QDISC FDB *+2
+ JMP NEXT
+*
+* ######>> screen 67 <<
+* ======>> 189 <<
+ FCB $8B
+ FCC 10,BLOCK-WRITE
+ FCB $C5
+ FDB QDISC-8
+BWRITE FDB *+2
+ JMP NEXT
+*
+* ######>> screen 68 <<
+* ======>> 190 <<
+ FCB $8A
+ FCC 9,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 1,LO
+ FCB $CF
+ FDB BREAD-13
+LO FDB DOCON
+ FDB MEMEND a system dependent equate at front
+*
+* ======>> 190.2 <<
+ FCB $82
+ FCC 1,HI
+ FCB $C9
+ FDB LO-5
+HI FDB DOCON
+ FDB MEMTOP ( $3FFF in this version )
+*
+* ######>> screen 69 <<
+* ======>> 191 <<
+ FCB $83
+ FCC 2,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 8, 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 5,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,DICPT,STORE,LFA,AT,CONTXT,AT,STORE
+ FDB SEMIS
+*
+* ######>> screen 73 <<
+* ======>> 194 <<
+ FCB $84
+ FCC 3,BACK
+ FCB $CB
+ FDB FORGET-9
+BACK FDB DOCOL,HERE,SUB,COMMA
+ FDB SEMIS
+*
+* ======>> 195 <<
+ FCB $C5
+ FCC 4,BEGIN
+ FCB $CE
+ FDB BACK-7
+BEGIN FDB DOCOL,QCOMP,HERE,ONE
+ FDB SEMIS
+*
+* ======>> 196 <<
+ FCB $C5
+ FCC 4,ENDIF
+ FCB $C6
+ FDB BEGIN-8
+ENDIF FDB DOCOL,QCOMP,TWO,QPAIRS,HERE
+ FDB OVER,SUB,SWAP,STORE
+ FDB SEMIS
+*
+* ======>> 197 <<
+ FCB $C4
+ FCC 3,THEN
+ FCB $CE
+ FDB ENDIF-8
+THEN FDB DOCOL,ENDIF
+ FDB SEMIS
+*
+* ======>> 198 <<
+ FCB $C2
+ FCC 1,DO
+ FCB $CF
+ FDB THEN-7
+DO FDB DOCOL,COMPIL,XDO,HERE,THREE
+ FDB SEMIS
+*
+* ======>> 199 <<
+ FCB $C4
+ FCC 3,LOOP
+ FCB $D0
+ FDB DO-5
+LOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XLOOP,BACK
+ FDB SEMIS
+*
+* ======>> 200 <<
+ FCB $C5
+ FCC 4,+LOOP
+ FCB $D0
+ FDB LOOP-7
+PLOOP FDB DOCOL,THREE,QPAIRS,COMPIL,XPLOOP,BACK
+ FDB SEMIS
+*
+* ======>> 201 <<
+ FCB $C5
+ FCC 4,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 2,END
+ FCB $C4
+ FDB UNTIL-8
+END FDB DOCOL,UNTIL
+ FDB SEMIS
+*
+* ======>> 203 <<
+ FCB $C5
+ FCC 4,AGAIN
+ FCB $CE
+ FDB END-6
+AGAIN FDB DOCOL,ONE,QPAIRS,COMPIL,BRAN,BACK
+ FDB SEMIS
+*
+* ======>> 204 <<
+ FCB $C6
+ FCC 5,REPEAT
+ FCB $D4
+ FDB AGAIN-8
+REPEAT FDB DOCOL,TOR,TOR,AGAIN,FROMR,FROMR
+ FDB TWO,SUB,ENDIF
+ FDB SEMIS
+*
+* ======>> 205 <<
+ FCB $C2
+ FCC 1,IF
+ FCB $C6
+ FDB REPEAT-9
+IF FDB DOCOL,COMPIL,ZBRAN,HERE,ZERO,COMMA,TWO
+ FDB SEMIS
+*
+* ======>> 206 <<
+ FCB $C4
+ FCC 3,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 4,WHILE
+ FCB $C5
+ FDB ELSE-7
+WHILE FDB DOCOL,IF,TWOP
+ FDB SEMIS
+*
+* ######>> screen 75 <<
+* ======>> 208 <<
+ FCB $86
+ FCC 5,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 1,<#
+ FCB $A3
+ FDB SPACES-9
+BDIGS FDB DOCOL,PAD,HLD,STORE
+ FDB SEMIS
+*
+* ======>> 210 <<
+ FCB $82
+ FCC 1,#>
+ FCB $BE
+ FDB BDIGS-5
+EDIGS FDB DOCOL,DROP,DROP,HLD,AT,PAD,OVER,SUB
+ FDB SEMIS
+*
+* ======>> 211 <<
+ FCB $84
+ FCC 3,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 1,#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 1,.R
+ FCB $D2
+ FDB DIGS-5
+DOTR FDB DOCOL,TOR,STOD,FROMR,DDOTR
+ FDB SEMIS
+*
+* ======>> 215 <<
+ FCB $83
+ FCC 2,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 1,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 3,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 4,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 4,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 4,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 3,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
OSDN Git Service
