+++ /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
