contrl

.PAG 'CONTRL 1/4/84'
;  OUTPUT ERROR CODE AND START AGAIN
OMERR	LDX #ERROM      ;OUT OF MEMORY
;
;  ENTRY  X= OFFSET FROM ERRTABLE
ERROR	JMP (IERROR)
NERROR
	STX ERRNUM      ;SAVE ERROR INDEX
  CPX #ERRUS ;DON'T TRAP UNDEFINED STATEMENT ERRORS
  BEQ ERRISD
  JSR TSTDIR ;DON'T TRAP IF IN DIRECT MODE
  BEQ ERRISD
  LDY TRAPNO+1 ;IS TRAP VECTOR SET?
  INY
  BEQ ERRISD ;NOT IF $FF
  DEY ;RESTORE TRAPNO+1
  STY LINNUM+1
  STY TMPTRP ;SAVE UNTIL A RESUME IS EXECUTED
  LDY TRAPNO ;FINISH VECTOR
  STY LINNUM
  LDY #$FF
  STY TRAPNO+1 ;MARKS NO MORE TRAPS UNTIL A 'RESUME' OR 'TRAP'
  LDX #1
SOTS
  LDA CURLIN,X
  STA ERRLIN,X
  LDA OLDTXT,X
  STA ERRTXT,X
  DEX
  BPL SOTS
  LDX OLDSTK
  TXS
  JSR MAPTXT ;MAKE SURE WE'RE IN TEXT
  JSR LUK4IT ;SET UP POINTERS
  JMP NSTT9 ;AND GOTO THAT LINE
ERRISD	LDA CHANNL
	BEQ ERROR2      ;CLOSE NON-TERMINAL CHANNEL.
	JSR CLRCH       ;CLOSE IT
	LDA #0
	STA CHANNL
ERROR2	JSR OCRLF       ;OUTPUT NEW LINE
	JSR OUTQST      ;OUTPUT '?'
	LDX ERRNUM      ;RESTORE OFFSET
;
	JSR MSG         ;OUTPUT MESSAGE
;
	JSR STKINI      ;RESET STK AND FLAGS
;
ERRFIN
	JSR MAPTXT      ;RESET I6509
	LDY CURLIN+1
	CPY #$FA
	BCS READY       ;IF # = 64000, DON'T TYPE LINE #
	LDX #INTXT
	JSR MSG
	LDA CURLIN+1
	LDX CURLIN
;
	JSR LINPRT      ;LIST LINE
.PAG
;  MAIN LOOP FOR BASIC
;
READY	LDX #MSRDY
	JSR MSG         ;READY.
	LDA #$80        ;TURN OFF MESSAGES
	JSR SETMSG
.SKI 4
MAIN	JMP (IMAIN)
NMAIN
	LDX #255
	STX CURLIN+1
	STX ERRLIN
  STX ERRLIN+1 ;FLAG NO ERRORS YET
	STX ERRNUM
	JSR INLIN       ;GET A LINE FROM TERMINAL
	STA TXTPTR      ;TXTPTR:=^TO INPUT BUFFER
	STY TXTPTR+1
	STX TXTPTR+2
	JSR CHRGET
	TAX
	BEQ MAIN        ;IF END OF LINE
	BCC MAIN1       ;IF LINE NUMBER
	JSR CRUNCH
	JSR CHRGOT      ;GET COMMAND
	JMP XEQDIR      ;EXECUTE COMMAND
;
MAIN1
	JSR LINGET      ;READ LINE # INTO LINNUM
	JSR CRUNCH
	STY COUNT       ;RETAIN CHAR COUNT
	JSR FNDLIN
	BCC NODEL       ;NO MATCH, SO DON'T DELETE
	LDY #1
	LDA (LOWTR)Y
	STA INDEX1+1
	.IFN CC1 <
	LDA VARTAB      ;TEXT END (64K)
>
	.IFE CC1 <
	LDA TXTEND      ;TEXT END (EXCEPT 64K)
>
	STA INDEX1
	LDA LOWTR+1     ;SET XFER TO
	STA INDEX2+1
	DEY
	LDA (LOWTR)Y    ; COMPUTE LENGTH
	CLC
	SBC LOWTR
	EOR #$FF        ; MAKE IT NEGATIVE
	CLC
	.IFN CC1 <
	ADC VARTAB      ;COMPUTE NEW TEXT END
	STA VARTAB
	STA INDEX2      ;SET LOW OF XFER TO
	LDA VARTAB+1
	ADC #255
	STA VARTAB+1    ;COMPUTE HIGH OF TEXT END
>
	.IFE CC1 <
	ADC TXTEND      ;COMPUTE NEW TEXT END
	STA TXTEND
	STA INDEX2      ;SET LOW OF XFER TO
	LDA TXTEND+1
	ADC #255
	STA TXTEND+1    ;COMPUTE HIGH OF TEXT END
>
	SBC LOWTR+1     ;COMPUTE # OF BLOCKS TO MOVE
	TAX
	SEC
	LDA LOWTR
	.IFN CC1 <
	SBC VARTAB      ;COMPUTE OFFSET
>
	.IFE CC1 <
	SBC TXTEND
>
	TAY
	BCS QDECT1      ;IF VARTAB <= LOWTR
	INX             ;DEC DUE TO CARRY AND
	DEC INDEX2+1    ;DEC STORE SO CARRY WORKS
QDECT1	CLC
	ADC INDEX1
	BCC MLOOP
	DEC INDEX1+1
	CLC
MLOOP	LDA (INDEX1)Y
	STA (INDEX2)Y
	INY
	BNE MLOOP
	INC INDEX1+1
	INC INDEX2+1
	DEX
	BNE MLOOP
NODEL	JSR CLEARC
	JSR LNKPRG
	LDY #0
	LDA (TXTPTR)Y   ;DELETE LINE?
	BNE NODELE      ;NO...
	JMP MAIN
NODELE
	CLC             ;NO...SOMETHING TO INSERT
;
	.IFN CC1 <
	LDA VARTAB
	LDY VARTAB+1
>
	.IFE CC1 <
	LDA TXTEND
	LDY TXTEND+1
>
	STA HIGHTR
	STY HIGHTR+1    ;TOP OF BLOCK TO MOVE
;
	ADC COUNT       ;LENGTH OF CHARACTERS IN LINE
	BCC NODEL1
	INY
NODEL1	CLC
	ADC #4          ;PLUS LINK AND LINE #
	BCC NODELC
	INY
NODELC	STA HIGHDS      ;DESTINATION OF TOP
	STY HIGHDS+1
;
;LOW BLOCK ADDRESS IS LOWTR
;WHERE IT WAS LEFT IN THE CALL TO FNDLIN
;
	.IFN CC1 <
	JSR BLTU
>
	.IFN CC2+CC3+CC4 <
	JSR BLTUT
>
;
;MAKE LINKS NON-NULL TO FOOL CHEAD
;
	LDY #0
	LDA #1
	STA (LOWTR)Y
	INY
	STA (LOWTR)Y
;
;PUT LINE NUMBER IN TEXT
;
	INY
	LDA LINNUM
	STA (LOWTR)Y
	LDA LINNUM+1
	INY
	STA (LOWTR)Y
;
;ADVANCE LOWTR TO START OF LINE
;
	INY
	TYA
	CLC
	ADC LOWTR
	STA LOWTR
	BCC MAIN2
	INC LOWTR+1
MAIN2
	.IFN CC1 <
	LDA STREND      ; 64K ONLY
	LDY STREND+1
	STA VARTAB
	STY VARTAB+1
>
;
;BLOCK MOVE LINE TO TEXT
;
	LDY COUNT
	DEY
STOLOP	LDA (TXTPTR)Y
	STA (LOWTR)Y
	DEY
       DEC COUNT
      BNE STOLOP
FINI	JSR LNKPRG
      JSR RUNC
      JMP MAIN
;
LNKPRG
      LDA TXTTAB
	LDY TXTTAB+1
	STA INDEX
	STY INDEX+1
	CLC 
CHEAD	LDY #0
	LDA (INDEX)Y    ;CHECK FOR NULL LINK
	BNE CHEA3
	INY
	LDA (INDEX)Y
	BEQ LNKRTS
CHEA3	LDY #4
CZLOOP	INY
	LDA (INDEX)Y
	BNE CZLOOP
	INY
	TYA
	ADC INDEX
	TAX
	LDY #0
	STA (INDEX)Y
	TYA
	ADC INDEX+1
	INY
	STA (INDEX)Y
	STX INDEX
	STA INDEX+1
	BCC CHEAD       ;ALWAYS
LNKRTS	CLC
	LDA INDEX       ;SET POINTER TO END OF TEXT
	LDY INDEX+1
	ADC #2
	BCC *+3
	INY
	.IFN CC1 <
	STA VAREND
	STY VAREND+1
>
	.IFE CC1 <
	STA TXTEND
	STY TXTEND+1
>
	RTS
.SKI 4
;  LINE INPUT ROUTINE
;
;   ENTER: BUFFPT IS USED AS POINTER TO START OF INPUT
;          BUFFER.
;   EXIT:  REGS CONTAIN POINTER TO BYTE PRECEDING BUFFER
;          INDEX1 ALSO HAS THIS POINTER VALUE.
;          .A, .Y = OFFSET
;          .X = BANK#
;
INLIN
	LDA BUFFPT
	LDY BUFFPT+1
	LDX #TXTBNK
	STA INDEX1
	STY INDEX1+1
	STX INDEX1+2
	LDY #0
INLINC	STY COUNT
	JSR BASIN
	CMP #CR
	BEQ FININL
	LDY COUNT
	STA (INDEX1)Y
	INY
	CPY #BUFSIZ
	BCC INLINC
	JMP ERRLEN      ;STRING TOO LONG
FININL	LDY COUNT
	LDA #0
	STA (INDEX1)Y   ;LINE TERMINATOR
	LDA CHANNL
	BNE *+5
	JSR OCRLF
	LDY INDEX1+1
	LDX INDEX1
	BNE *+3
	DEY
	DEX
	TXA
	LDX #TXTBNK
	RTS
.PAG
;  SEARCHES PROGRAM TEXT FOR THE LINE WHOSE
;  NUMBER IS PASSED IN 'LINNUM'.
;  EXIT
;  CBIT SET.
;  LOWTR -> TO THE LINK FIELD IN THE LINE
;  WHICH IS THE ONE SEARCHED FOR.
;  CBIT CLEAR
;  LINE NOT FOUND. (LOWTR) -> LINE IN THE
;  PROGRAM > THE ONE SOUGH AFTER
;
;  ALWAYS ASSUME TEXT BANK SHOULD BE USED
;
FNDLIN
	LDA TXTTAB
	LDX TXTTAB+1
FNDLNC
	STA LOWTR
	STX LOWTR+1
	LDY #0
	LDA (LOWTR)Y    ;CHECK FOR NULL LINK
	BNE FNDLN3
	INY
	LDA (LOWTR)Y
	BEQ FLNRT
FNDLN3	LDY #3
	LDA (LOWTR)Y
	CMP LINNUM+1
	BEQ FNDL20      ;LOOK AT LOW BYTES
	BCC AFFRTS      ;IF NOT EQUAL,TRY NEXT
FLNRT	CLC             ;DIDN'T FIND IT
FLNRTS	RTS
;
FNDL20	DEY
	LDA (LOWTR)Y
	CMP LINNUM
	BEQ FLNRTS      ;IF NUMBER FOUND
	BCS FLNRT       ;IF ABOVE NUMBER
AFFRTS	LDY #1
	LDA (LOWTR)Y
	TAX
	DEY
	LDA (LOWTR)Y
	BCC FNDLNC      ;ALWAYS
;
.PAG
;  HERE FOR NEW STATMENT. CHARACTER -> BY TXTPTR
;  IS ':' OR EOL. THE ADR OF THIS LOC IS LEFT ON
;  THE STACK WHEN A STATEMENT IS EXECUTED SO THAT
;  IT CAN MERELY DO A RTS WHEN IT IS DONE.
;  GET CHAR, EXIT VIA XEQCM3, AND
;  RETURN TO NEWSTT
XEQCM
GONE	JMP (IGONE)
NGONE	JSR CHRGET      ;GET STATEMENT TYPE
XEQDIR	JSR XEQCM3
;
NEWSTT
	JSR KSTOP
	BNE NSTT1       ;IF STOP NOT REQUESTED
	SEC             ;BRK MSG DESIRED
	JMP STOPC       ;IF STOP REQUESTED
;
SAV42	LDA (TXTPTR)Y   ;MAKE SURE IT'S NOT END-OF-TEXT
	BNE NSTT4
	INY
	LDA (TXTPTR)Y   ;END OF TEXT STORAGE?
	BNE NSTT4       ;NO...GO TO NEXT LINE
NSTT3	JMP READY       ;YES...FINISHED
;
NSTT4	LDY #3          ;NEW LINE, UPDATE POINTERS
	LDA (TXTPTR)Y   ;EXTRACT LINE# LO BYTE
	STA CURLIN
	INY
	LDA (TXTPTR)Y   ;EXTRACT LINE # HI BYTE
	STA CURLIN+1
	RTS
;
NSTT1	JSR TSTDIR      ;ARE WE IN DIRECT MODE?
	BEQ NSTT2       ;YES...
;
; IN RUN MODE...
; SAVE TXTPTR FOR CONT COMMAND
;
NSTT9	;ENTRY POINT FOR ERROR TRAPPING
	LDA TXTPTR
	LDY TXTPTR+1
	STA OLDTXT
	STY OLDTXT+1
 TSX
 STX OLDSTK ;SAVE IN CASE OF ERROR
;
NSTT2
	LDY #0
	LDA (TXTPTR)Y   ;END OF THE LINE?
	BNE MORSTS      ;NO...END OF STATEMENT
;
	JSR TSTDIR      ;IN DIRECT MODE?
	BEQ NSTT3       ;YES...FINISHED EXECUTION
;
;IN RUN MODE...
;LOOK FOR START OF NEXT LINE
;
	LDY #1
	JSR SAV42
	TYA             ;Y=4
	CLC
	ADC TXTPTR      ;POINT @ CHARACTER BEFORE LINE START
	STA TXTPTR
	BCC XEQCM
	INC TXTPTR+1
	BNE XEQCM       ;ALWAYS...EXECUTE NEW LINE
;
;  SET UP FOR COMMAND PROCESSING AND
;  SET PROCESSOR ADDRESS ON STACK,
;  EXIT VIA JMP TO CHRGET
;
XEQCM3	BEQ FFRTS
XEQCM2
	CMP #PI
	BEQ SNERR1
	SEC
	SBC #TKEND
	BCC GLET
	CMP #TKSCRA-TKEND+1
	BCC NSTT6
	CMP #TKGO-TKEND
	BCC SNERR1
	CMP #TKUSIN-TKEND ;PATCH REV4 FIXES  USING C/R***********
	BCS SNERR1      ;TRAP USING, ERR$ & INSTR$
	SBC #TKGO-TKSCRA-2
NSTT6	ASL A
	TAY
	LDA STMDSP+1,Y
	PHA
	LDA STMDSP,Y
	PHA             ;PROCESS ADDRESS ON STACK
	JMP CHRGET      ;PROCESS COMMAND
;
GLET	JMP LET
;
MORSTS	CMP #':
	BNE SNERR1
	JMP XEQCM       ;IF ':', CONTINUE STATEMENT
SNERR1	JMP SNERR       ;SYNTAX ERROR
.PAG
;  FIND A 'FOR' ENTRY ON THE STACK VIA VARPNT
;
;  EXIT: NOT FOUND - Z=0
;        FOUND -     Z=1
;                   .X=STACK OFFSET TO FOR ENTRY
;
;  FNDFOR IS ALSO USED BY THE RETURN STATEMENT TO CLEAR
;  OFF ALL LOOPS ACTIVATED DURING A GOSUB CALL. I.E.,
;  ALL FOR ENTRIES BETWEEN TOS AND LAST GOSUB ENTRY. REG-
;  ISTER .A CONTAINS TOKEN VALUE WHICH ENDED THE SEARCH.
;
;  WHEN FNDFOR IS USED BY A NEXT STATEMENT FOR WHICH
;  NO FOR-VARIABLE WAS GIVEN, FORPNT SHALL CONTAIN VALUES
;  IMPOSSIBLE FOR ACTUAL VARIABLES.
;
FNDFOR
	TSX             ;LOAD X WITH STK PTR.
	INX
	INX
	INX
	INX             ;IGNORE ADR (NEWSTT) AND RTS ADR.
FFLOOP
	LDA 257,X       ;GET STACK ENTRY
	CMP #TKFOR
	BNE FFRTS       ;IF NOT 'FOR' TOKEN
	LDA FORPNT+2    ;TEST FOR REAL BANK#
	BPL CMPFOR      ;YES...
	LDA 258,X       ;NO, SO ASSUME THIS ONE
	STA FORPNT
	LDA 259,X
	STA FORPNT+1
	LDA 260,X
	STA FORPNT+2
CMPFOR	CMP 260,X
	BNE ADDFRS
	LDA FORPNT+1
	CMP 259,X
	BNE ADDFRS
	LDA FORPNT
	CMP 258,X
	BEQ FFRTS
ADDFRS	TXA 
	CLC
	ADC #FORSIZ
	TAX
	BNE FFLOOP
FFRTS	RTS
.PAG
;  BLOCK TRANSFER ROUTINE(S).
;  MAKE SPACE BY SHOVING EVERYTHING FORWARD.
;
;  THIS IS DONE FOR TWO PURPOSES:
;  1. TO MAKE ROOM FOR NEW STATEMENTS
;  2. TO MAKE ROOM FOR NEW SIMPLE VARIABLES.
;
;  FOR THE 64K VERSION, A SINGLE BLOCK TRANSFER ROUTINE (BLTU)
;  SERVES BOTH PURPOSES. FOR THE 128K, 192K, AND 256K VERSIONS,
;  SEPARATE ROUTINES, BLTUT (FOR TEXT) AND BLTUV (FOR VARS),
;  ARE USED AS WELL AS A GENERAL VERSION OF BLTU.
;
;  THE ALLOCATION OF NEW SPACE REQUIRES THAT CHECKS BE MADE
;  TO SEE IF ENOUGH MEMORY EXISTS. FOR THE 64K VERSION, THE
;  ROUTINE, REASON, IS CALLED. FOR THE 128K, 192K, AND 256K
;  VERSIONS, REASON IS CALLED FOR VARIABLES AND REASNT IS
;  CALLED FOR TEXT.
;
;  ENTRY  Y,A = (HIGHDS)
;  (HIGHDS)= DESTINATION OF HIGH ADDRESS
;  (LOWTR) = LOWEST ADR TO BE XFERRED
;  (HIGHTR)= HIGHEST ADR TO BE XFERRED
;
;
;  EXIT (LOWTR) = UNCHANGED
;  (HIGHTR)= (LOWTR)-80H
;  (HIGHDS)= LOWEST ADR XFERRED INTO MINUS 80H
;   HIGH BOUNDARY SET TO NEW VALUE:
;      BLTU(64K): STREND
;      BLTUT: TEXT END
;      BLTUV: VARIABLE END (STREND OR VAREND)
;
	.IFN CC2+CC3+CC4 <
BLTUT	JSR REASNT
	STA TXTEND      ;SET NEW END OF TEXT
	STY TXTEND+1
	BCC BLTU        ;MOVE IT  ... ALWAYS
;
;
BLTUV	JSR REASON
>
	.IFN CC2 <
	STA STREND      ;128K VERSION
	STY STREND+1
	JSR MAPVAR
>
	.IFN CC3 <
	STA STREND      ;192K VERSION
	STY STREND+1
	RTS             ; NOTHING TO MOVE
>
	.IFN CC4 <
	STA VAREND      ;256K VERSION
	STY VAREND+1
	RTS             ; NOTHING TO MOVE
>
BLTU
	.IFN CC1 <
	JSR REASON      ;64K VERSION
	STA STREND
	STY STREND+1
	JSR MAPTXT
>
	SEC             ;(ALL VERSIONS) PREPARE TO SUBRACT
	LDA HIGHTR
	SBC LOWTR       ;COMPUTE # OF THINGS TO MOVE AND SAVE
	STA INDEX
	TAY
	LDA HIGHTR+1
	SBC LOWTR+1
	TAX             ;PUT IT IN A COUNTER REG
	INX             ;SO THAT CNTR ALGORITHM WORKS
	TYA             ;SEE IF LOW PART OF CNT IS 0
	BEQ DECBLT      ;IF 0, START MOVING BLOCKS
	LDA HIGHTR      ;MUST JUSTIFY BASE ADR
	SEC
	SBC INDEX
	STA HIGHTR
	BCS BLT1
	DEC HIGHTR+1
	SEC
BLT1	LDA HIGHDS
	SBC INDEX
	STA HIGHDS
	BCS MOREN1
	DEC HIGHDS+1
	BCC MOREN1
BLTLP	LDA (HIGHTR)Y
	STA (HIGHDS)Y
MOREN1	DEY
	BNE BLTLP
	LDA (HIGHTR)Y
	STA (HIGHDS)Y
DECBLT	DEC HIGHTR+1
	DEC HIGHDS+1
	DEX
	BNE MOREN1
	JMP MAPTXT
.PAG
;  ASCERTAIN THAT A GIVEN NUMBER OF LOCS REMAIN
;  AVAILABLE FOR THE STACK.
;  ENTRY  LDA #NUMBER OF WORD ENTRIES NEEDED
;  JSR GETSTK
;  MUST BE CALLED BY ANY ROUTINE WHICH PUTS AN
;  ARBITRARY AMOUNT OF STUFF ON THE STACK.
;  NOTE ROUTINES THAT MERELY USE AND FREE UP THE
;  GUARANTEED NUMLEV LOCATIONS NEED NOT CALL GETSTK.
;
;  EXIT
;  A AND X HAVE BEEN MODIFIED.
;
GETSTK	ASL A           ;AN ENTRY IS TWO BYTES
	ADC #NUMLEV+NUMLEV ;OVERHEAD REQUIRED FOR MAXIMUM
	BCS OSERR
	STA INDEX       ;THIS MUCH MEMORY MUST BE LEFT
	TSX
	CPX INDEX       ;IS IT?
	BCS REARTS      ;YES...
;
OSERR	LDX #ERROS      ;OUT OF STACK SPACE ERROR
	JMP ERROR
.SKI 4
REASON
	.IFN CC1+CC2+CC3 <
	CPY FRETOP+1
	BCC REARTS
	BNE TRYMOR
	CMP FRETOP
	BCC REARTS
TRYMOR	PHA
	LDX #8+ADDPRC
	TYA
REASAV	PHA
	LDA HIGHDS-1,X
	DEX
	BPL REASAV
	JSR GARBA2
	LDX #248-ADDPRC
REASTO	PLA
	STA HIGHDS+8+ADDPRC,X
	INX
	BMI REASTO
	PLA
	TAY
	PLA
	CPY FRETOP+1
	BCC REARTS
	BNE OMERRC
	CMP FRETOP
	BCC REARTS
>
	.IFN CC4 <
	CPY HIGHST+1
	BCC REARTS
	BNE OMERRC
	CMP HIGHST
	BCC REARTS
>
OMERRC	JMP OMERR       ;OUT OF MEMORY ERROR
;
SAV73
 JSR PTRGET
SAV74
 STA FORPNT
 STY FORPNT+1
 STX FORPNT+2
REARTS	RTS
	.IFN CC2+CC3+CC4 <
.SKIP 2
REASNT	CPY BUFFPT+1
	BCC REARTS
	BNE OMERRT
	CMP BUFFPT
	BCC REARTS
OMERRT	LDX #ERROT
	JMP ERROR
>
	.IFN CC3+CC4 <
.SKIP 2
REASNA	CPY HIGHST+1
	BCC REARTS
	BNE OMERRA
	CMP HIGHST
	BCC REARTS
OMERRA	LDX #ERROA
	JMP ERROR
>
.PAG
;CRUNCH
;
;ENTRY:  TXTPTR POINTS TO START OF TEXT TO CRUNCH
;EXIT:   TXTPTR POINTS TO START OF CRUNCHED TEXT
;CALLS:  CHRGET
;        CHRGOT
;        RESER
;        KLOOP
;        REM
;        DATA
;COLLAPSES ALL RESERVED WORDS TO TOKENS.  DOES
;NOT ALTER DATA OR REM.  REMOVES ALL GRAPHIC
;CHARACTERS NOT IN QUOTED STRINGS
;
CRUNCH	JMP (ICRNCH)
NCRNCH
	LDA TXTPTR      ;SAVE OLD TEXT LOC
	PHA
	LDA TXTPTR+1
	PHA
CRUN05	JSR CHRGOT
	JMP CRUN20
;
CRUN10	JSR CHRGET
CRUN20	BCC CRUN10      ;DON'T CRUNCH NUMBERS
	CMP #0          ;END OF LINE?
	BEQ CRUN90      ;YES...
	CMP #':'        ;MULTI-STMT CHAR?
	BEQ CRUN10
	CMP #'?         ;PRINT ABREVIATION?
	BNE CRUN30      ;NO...
	LDA #TKPRIN     ;SUBSTITUTE PRINT TOKEN
	LDY #0
	STA (TXTPTR)Y
	BEQ CRUN10      ;BRANCH ALWAYS
CRUN30	CMP #$80        ;GRAPHICS?
	BCC CRUN40      ;NO...
	CMP #PI         ;YES...PI?
	BEQ CRUN10      ;O.K....LEAVE ALONE
	LDY #1
	JSR KLOOP       ;CRUNCH OUT GRAPHICS
	BEQ CRUN05      ;BRANCH ALWAYS
CRUN40	CMP #'"         ;QUOTE STRING?
	BNE CRUN60      ;NO...
CRUN50	JSR CHRGET
	CMP #$0         ;END OF LINE?
	BEQ CRUN90      ;YES...
	CMP #'"         ;CLOSE QUOTE?
	BEQ CRUN10      ;YES...
	BNE CRUN50      ;NO...
CRUN60	JSR RESER       ;RESERVED WORD?
	BCC CRUN10
	CPY #0          ;ANYTHING TO MOVE?
	BEQ CRUN70      ;NO...
	JSR KLOOP       ;CRUNCH IT OUT
CRUN70	LDA COUNT       ;PUT TOKEN...
	LDY #0
	STA (TXTPTR)Y   ;IN TEXT
	CMP #TKREM
	BEQ CRUN80
	CMP #TKDATA
	BNE CRUN10
	JSR CHRGET
	JSR DATA
	JMP CRUN05
CRUN80	JSR CHRGET
	JSR REM
;
;NO OTHER STATEMENTS CAN FOLLOW A REM
;
CRUN90	LDX TXTPTR
	PLA
	STA TXTPTR+1
	PLA
	STA TXTPTR
	SEC             ;COMPUTE LENGTH OF LINE
	TXA
	SBC TXTPTR
	TAY
	INY
	RTS
.PAG
;KLOOP
;
;CRUNCH LOOP.  MOVES OFFSET .Y CHARACTERS
;FROM TXTPTR TO END OF LINE
;
;ASSUME I6509 SET TO TEXT BY CRUNCH.
;
KLOOP	CLC             ;COMPUTE SOURCE ADDRESS
	TYA
	ADC TXTPTR
	STA INDEX1
	LDA TXTPTR+1
	ADC #0
	STA INDEX1+1
	LDY #0
KLOOP2	LDA (INDEX1)Y   ;MOVE SOURCE
	STA (TXTPTR)Y   ;TO DESTINATION OFFSET
	INY
	CMP #0          ;END OF LINE?
	BNE KLOOP2      ;NO...
	RTS
.PAG
;RESER
;
;SEARCH RESERVED WORD LIST FOR A MATCH
;ENTRY:  (TXTPTR) IS FIRST CHAR OF WORD TO MATCH
;EXIT:   .Y=LENGTH OF WORD MATCHED
;        .C=SUCCESS/FAIL (SET/CLEAR) FLAG
;        COUNT=TOKEN VALUE
;
;ASSUME I6509 SET TO TEXT BY CRUNCH ALREADY.
;
RESER	LDA #>RESLST    ;START SEARCH HERE
	LDY #<RESLST
	STA INDEX1+1
	STY INDEX1
	LDY #0
	STY COUNT
	DEY
RESE10	INY
RESE20	LDA (TXTPTR)Y
	SEC
	SBC (INDEX1)Y   ;DOES LETTER MATCH?
	BEQ RESE10      ;YES...CONTINUE
	CMP #EOM        ;NO...END OF WORD?
	BEQ RESE60      ;YES...C SET...DONE
;
;FIND NEXT WORD
;
RESE30	JSR LDI1Y
	BMI RESE40      ;FOUND END OF CURRENT
	INY
	BNE RESE30
RESE40	INY             ;START OF NEXT
	INC COUNT       ;VALUE OF TOKEN
	CLC
	TYA
	JSR SAV14
	CLC
	LDY #0
	JSR LDI1Y       ; END OF LIST?
	BNE RESE20      ;NO...
;
;YES...CARRY CLEAR...FAIL
;
RESE60	ORA COUNT       ;.A=$80 IF MATCH
	STA COUNT       ;TOKEN IS FORMED
	RTS
.END