MAIN PROC	temporg $9A00
	
; AsmIIGS directives to set equivalent 6502/65C02 MODE.
	MACHINE	M65C02
	LONGA	OFF
	LONGI	OFF

*******************IMPORTS***************************
		
		IMPORT VECTOUT	
		IMPORT VECTIN	
		IMPORT VDOSIO	
		IMPORT PREGA	
		IMPORT PREGX	
		IMPORT PREGY	
		IMPORT XCNUM
		IMPORT CHRLAST
		IMPORT EXACTV
		IMPORT ERRCODE
		IMPORT STATE
		IMPORT DTRACE
		IMPORT IFILACTV
		IMPORT OFILACTV
		IMPORT PFXACTV
		IMPORT PRINTERR
		IMPORT GOSYSTEM
		IMPORT CFREFNUM
		IMPORT CATFLAG
		IMPORT RWTRANS
		IMPORT RWCOUNT
		IMPORT RWDATA
		IMPORT VLNTH
		IMPORT FBITS
		IMPORT SMARK
		IMPORT DIRFLG
		IMPORT RWREFNUM
		IMPORT SREFNUM
		IMPORT INPTR
		IMPORT TBUFPTR
		IMPORT OPENCNT
		IMPORT STRINGS
		IMPORT VSYSIO
		IMPORT SBUFADR
		IMPORT RSHIMEM
		IMPORT SBUFREF
		IMPORT DEFSLT
		IMPORT VSLOT
		IMPORT DEFDRV
		IMPORT VDRIV
		IMPORT XLEN
		IMPORT PBITS
		IMPORT PIOSLT
		IMPORT VIOSLT
		IMPORT SUNITNUM
		IMPORT SDATPTR
		IMPORT EXTRNCMD
		IMPORT FIFILID
		IMPORT VADDR
		IMPORT VTYPE
		IMPORT SEOF
		IMPORT FIAUXID
		IMPORT VLINE
		IMPORT FIACESS
		IMPORT CRAUXID
		IMPORT CRFILID
		IMPORT CRACESS
		IMPORT CRFKIND
		IMPORT VENDA
		IMPORT VBYTE
		IMPORT OUTVECT0
		IMPORT VADDR
		IMPORT SBYE
		IMPORT SDATPTR
		IMPORT FIBLOKS
		IMPORT FIFKIND
		IMPORT OSYSBUF
		IMPORT OREFNUM
		IMPORT XTRNADDR
		IMPORT EXFILE
		IMPORT NEWLREF
		IMPORT NLINENBL
		IMPORT EXFILE
		IMPORT VRECD
		IMPORT VFELD
		IMPORT NLINENBL
		IMPORT SSGINFO
		IMPORT FIMDATE
		IMPORT SCREATE
		IMPORT SDSTROY
		IMPORT SRENAME
		IMPORT SONLINE
		IMPORT SSGPRFX
		IMPORT SOPEN
		IMPORT SNEWLIN
		IMPORT SREAD
		IMPORT SWRITE
		IMPORT SCLOSE
		IMPORT SFLUSH
		IMPORT SSETMRK
		IMPORT SGETEOF
		IMPORT SGETBUF
		IMPORT SSETBUF
		IMPORT SSETEOF
		IMPORT SGETMRK
		
**********************INCLUDES GO HERE *************************

		INCLUDE 'EQUATES'

		
	
	EJECT
	
	TITLE	'PRODOS CI FOR APPLESOFT'
*******************************************************
* SNORMIO SETS THE ZERO PAGE I/O HOOKS
* TO POINT AT THE CURRENT DEVICE ROUTINES.
*******************************************************
*

SNORMIO	PHA				;PRESERVE CHARACTER IN ACCUMULATOR.
		LDA	VECTOUT	 	;STRAITLINE FOR SPEED.
		STA	CSWL
		LDA	VECTOUT+1
		STA	CSWH
		LDA	VECTIN
		STA	KSWL
		LDA	VECTIN+1
		STA	KSWH
		PLA				;RESTORE	 CHARACTER.
		RTS
	SPACE
	TITLE	'SETSYSIO'
*******************************************************
* SETSYSIO sets the System I/O hooks to point at the 
*   ProDOS interceptor routines.  Before doing so, it 
*   preserves any current I/O address (providing that 
*   they don't already point at ProDOS). 
*******************************************************
SETSYSIO	LDX	#0	 		;SET I/O STATE TO IMMEDIATE MODE.
		JSR	SETSTATE
		LDA	KSWH	 		;ARE I/O HOOKS ALREADY POINTING
		CMP	VDOSIO+3	 	; AT PRODOS?
		BNE	*+5	 		;Branch around JMP (Range too far to BEQ)
		JMP	SSYSIO1	 	;BRANCH IF INPUT IS.
		LDA	CSWH
		CMP	VDOSIO+1
		BEQ	SSYSIO1	 	;BRANCH IF OUTPUT IS.
		BNE	SSYSIO	 	;OTHERWISE, PRESERVE CURRENT I/O ADDRESSES
	SPACE
	TITLE	'IMMEDIATE OUTPUT'
********************  IMMEDIATE OUTPUT  **************************	
* IMOUT is active while APPLESOFT is in IMMEDIATE MODE.  This 
*   routine simply swaps the I/O Vectors, passes characters to 
*   the Output Routine, and restores I/O Vectors to ProDOS. 
******************************************************************
IMMEDOUT	CMP	TRCIMG	 	;IS IT "#"?
		BNE	IMOCRCK		;BRANCH IF NOT.
		STX	PREGX	 		;SAVE X REGISTER.
		TSX				;LOOK	 AT STACK TO FIND OUT IF TRACE OUTPUT.
		LDA	$103,X
		CMP	#$12	 		;MUST READ $12, AND $D8
		BNE	IMDOUT1
		LDA	$104,X
		CMP	#$D8
		BNE	IMDOUT1
		LDX	#4	 		;SET RUN MODE.
		JSR	SETSTATE
		LDA	TRCIMG	 	;GO TO IT.
		LDX	PREGX
		JMP	DOSOUT
IMOCRCK	CMP	CHRLAST	 	;SAME AS LAST OUTPUT CHARACTER?
		STA	CHRLAST
		BNE	IMOUT	 		;BRANCH IF NOT...
		CMP	#$8D	 		;SUPPRESS DOUBLE CR ON LINE INPUT.
		BNE	IMOUT
		LDA	$24	 		;ONLY IF CURSOR HORZ IN COLUMN 0
		BNE	IMOCR	 		;AND LINE# INPUT (CARRY SET FROM CMP). 
		LDA	TXBUF
		CMP	#$3F	 		;MUST BE > '?' FOR SUPPRESSION.
IMOCR		LDA	#$8D	 		;RESTORE CR.
		BCS	IMOUT	 		;BRANCH IF FIRST NON-   SPACE  WAS ALPHA.
		RTS				;IGNORE CR.
   SPACE 
IMDOUT1	LDX	PREGX
		LDA	TRCIMG
IMOUT		JSR	SNORMIO	 	;SWAP IN I/O ROUTINE ADDRESSES.
		JSR	GOCSWL	 	;OUTPUT CHARACTER.
		CMP	#$8D	 		;WAS IT A CARRAGE RETURN?
		BNE	SSYSIO	 	;BRANCH IF NOT.
		LDA	ZTRACE	 	;IS TRACE MODE UNCHANGED?
		CMP	#$A5
		BEQ	IMOUT1	 	;BRANCH IF NOT
		STA	DTRACE	 	;SAVE STATE DESIRED.
		LDA	#$A5	 		;RESTORE TRACE BYTE.
		STA	ZTRACE
IMOUT1	LDA	#$8D	 		;RETURN WITH CARRAGE RETURN. 
SSYSIO	PHA				;RESTORE I/O HOOKS TO PRODOS, BUT...
		LDA	KSWH	 		;FIRST SAVE ANY CHANGES TO ROUTINE ADDRESSES.
		STA	VECTIN+1	 
		LDA	KSWL	 
		STA	VECTIN	 
		LDA	CSWH	 
		STA	VECTOUT+1	 
		LDA	CSWL	 
		STA	VECTOUT	 
		PLA				;(RESTORE CHARACTER) 
SSYSIO1	PHA				;THIS	 ENTRY USED BY 'SETSYSIO'
		LDA	VDOSIO	 	;PLACE ADDRESSES OF DOS I/O INTERCEPTOR
		STA	CSWL	 		; ROUTINES IN THE SYSTEM I/O HOOKS.
		LDA	VDOSIO+1	 	;THIS DONE STRAITLINE FOR SPEED.
		STA	CSWH
		LDA	VDOSIO+2
		STA	KSWL
		LDA	VDOSIO+3
		STA	KSWH
		PLA				;ALL DONE, RETURN ALL REGISTERS UN DISTURBED.
		RTS
	SPACE 2
	TITLE	'IMMEDIATE INPUT'	 
**********************IMMEDIATE INPUT**************************
* IMINP swaps in Normal I/O Routines, Gets a character,
*   Restores I/O to ProDOS, and passes the character back to
*   the Monitor GETLINE Routine.  When the character is a 
*   RETURN, control is passed to the ProDOS Syntaxer to check 
*   for, and Execute, ProDOS Commands.
***************************************************************
IMINP		BIT	EXACTV	 	;IS AN EXEC FILE ACTIVE?
		BPL	IMINP1	 	;BRANCH IF NOT.
		JSR	SAVREGS
		JMP	RDEXEC	 	;GO READ EXEC FILE
IMINP1	EQU	*
		JSR	SNORMIO	 	;SWAP IN REGULAR I/O VECTORS.
		JSR	GOKSWL	 	;GO GET A CHARACTER.
		CMP	#$8D	 		;IS IT A CARRAGE RETURN?
		BNE	IMINP3	 	;BRANCH IF NOT.
		JSR	SAVREGS	 	;SAVE ALL REGISTERS.
		STA	INLINE,X	 	;FINISH UP INPUT STRING.
RDEXEC2	JSR	SYNTAX	 	;NOW SEE IF IT'S A PRODOS COMMAND.
		BIT	XCNUM	 		;WAS IT A RECOGNIZED COMMAND?
		BMI	IMINP2	 	;BRANCH IF IT WAS NOT.
		BCS	DFERROR	 	;BRANCH IF AN ERROR WAS ENCOUNTERED.
		LDY	PREGY	 		;RESTORE ONLY Y TO IT'S ORIGINAL VALUE.
		LDA	#$88	 		; MAKE IT LOOK LIKE A NUL INPUT.
		LDX	#0
		BEQ	IMINP3	 	;BRANCH ALWAYS.
   	SPACE 
IMINP2	JSR	RSTREGS	 	;RESTORE A,X,&Y REGISTERS.
IMINP3	JMP	SSYSIO	 	;RESTORE I/O HOOKS TO PRODOS.
	SPACE
******************'ERROR HANDLER'*************************
		EXPORT NODEVERR
NODEVERR	LDA	#NODEV
IERROR	EQU	*
DFERROR	EQU	*
		EXPORT ERROR
ERROR		STA	ERRCODE
		STA	ASERR	 		;SAVE ERROR CODE IN GLOBALS AND FOR APPLESOFT.
		LDA	STATE	 		;DETERMINE RUNNING OR NOT...
		CMP	#1	 		;IF >0 THEN DEFERRED MODE (SETS CARRY)
		PHP				;SAVE	 MODE.
		LDA	#$F	 		;CLOSE ANY TEMP FILE
		STA	GLBLEVEL
		LDA	#0	 		;CLEAR I/O STATES
		STA	IFILACTV
		STA	OFILACTV
		STA	PFXACTV
		STA	CFREFNUM	 	;NOW CLOSE TEMP FILE. 
		LDA	#CLOSCMD
		JSR	GOSYSTEM
		BCS	IERROR2	 	;BRANCH IF CAN'T CLOSE.
		JSR	CLEARBUF	 	;WRITE ANY TEXT JUST LAYING AROUND.
		BCS	IERROR2	 	;BRANCH IF CAN'T CLEAR BUFFER.
		LDA	#0	 		;FLUSH ANY OPEN FILES.
		STA	GLBLEVEL
		STA	CFREFNUM
		LDA	#FLSHCMD
		JSR	GOSYSTEM
* 
IERROR2	PLP				;GET ERROR MODE AGAIN. 
		LDX	#4	 
		BIT	ONERRFLG	 	;IS 'ON ERROR' ACTIVE?
		BCS	IERROR4	 	;BRANCH IF NOT IMMEDIATE.
		LDX	#0	 
IERROR4	PHP
		JSR	SETSTATE	 	;SET I/O STATE ACCORDING TO X.
		JSR	SSYSIO1	 	;SET SYSTEM ADDR IN THE I/O HOOKS.
		LDA	ERRCODE
		PLP
		BMI	DFERROR1
		PHP
		JSR	PRINTERR	 	;GO PRINT ERROR MESSAGE.
		JSR	CLSEXEC
		PLP
		BCS	DFERROR2	 	;BRANCH IF DEFERRED ERROR.
		JSR	CROUT
		JMP	WRMSTRT	 	;WARMSTART APPLESOFT...
   SPACE  
DFERROR1	LDX	$F8	 		;RESET APPLESOFT STACK 
		DEX
		DEX
		TXS
		TAX				;MOVE ERROR CODE TO X FOR ONERR. 
DFERROR2	LDA	#3
		JMP	APSFTBRK	 	;GOTO APPLESOFT BREAK/ONERR HANDLER.
*
BRKINP	EQU	*	 		;INPUT IS UNEXPECTEDLY FROM IMMEDIATE MODE. 
		LDA	#0
		STA	ASERR
		LDA	#$A3	 		;Reset Trace flag image
		STA	TRCIMG
		JSR	APSFTNORM	 	;Applesoft's SETNORM routine
		JSR	SNORMIO
		JSR	CLRFBUF	 	;MAKE SURE ALL FILE BUFFERS ARE FLUSHED.
		JSR	SETSYSIO	 	;RESET SYSTEM I/O TO IMMEDIATE MODE.
		JSR	RSTREGS	 	; AND NOW, GOTO IMMEDIATE INPUT.
		JMP	IMINP	
	SPACE
	TITLE	'DEFERRED INPUT'	 
*************************** DEFERRED INPUT **************************
* DFINP is active while an Applesoft program is running. 
*   In the event that the program is halted, I/O is reset  
*   for immediate MODE operation.  If a file is active for 
*   Input, control is given to RDINPUT.  Otherwise, the I/O 
*   vectors are swapped, a character is read, and I/O is 
*   restored to ProDOS.  If the character is a BackSPACE , X=0, 
*   and the request is from an INPUT statement (as opposed to 
*   a GET statement), the character is ignored.  This prevents 
*   unnecessary reprompting by GETLINE.
*********************************************************************
DFINP		JSR	SAVREGS	 	;SAVE CHARACTER AT CURSOR, X & Y 
		BIT	PFXACTV	 	;PREFIX INPUT?
		BPL	DEFINP0	 	;BRANCH IF NOT.
		JMP	PFXINP
DEFINP0	BIT	IFILACTV	 	;IS AN INPUT FILE ACTIVE?
		BPL	DFINP00	 	;BRANCH IF NOT FILE INPUT.
		JMP	RDINPUT
DFINP00	BIT	EXACTV	 	;OR HOW ABOUT AN EXEC FILE?
		BMI	RDEXEC	 	;BRANCH IF EXEC FILE.
		LDA	PROMPT	 	;GET PROMPT CHARACTER FOR IMMEDIATE MODE CHECK.
		CMP	#$DD	 		;DID USER SLIP US INTO IMMEDIATE MODE?
		BEQ	BRKINP	 	;BRANCH IF WE DID.
		JSR	SNORMIO	 	;SWAP I/O TO REGULAR DEVICES.
DEFINP1	LDA	PREGA	 		;PASS CHARACTER TO INPUT ROUTINE.
		LDY	PREGY
		JSR	GOKSWL	 	;GET A CHARACTER.
		CMP	#$88	 		;IS IT A BACK   SPACE  CHARACTER?
		BNE	DEFINP3	 	;BRANCH IF NOT.
		LDA	PROMPT	 	;IS THIS AN INPUT?
		CMP	#$BE	 
		BEQ	DEFINP2	 	;BRANCH IF 'GET' INSTEAD OF 'INPUT'. 
		TXA				;IS IT THE FIRST CHARACTER IN THE INPUT LINE?
		BEQ	DEFINP1	 	;IGNORE IT IF SO.
DEFINP2	LDA	#$88	 		;RESTORE BACK   SPACE .
DEFINP3	JMP	SSYSIO	 	;RESTORE I/O TO PRODOS AND RETURN.
	SPACE 2
	TITLE	'READ EXEC'	 
***************************** READ EXEC ****************************
RDEXEC	EQU	*	 
		STA	(BASL),Y
		LDA	PROMPT
		CMP	#$BE	 		;IF 'GET' DO JUST 1 CHARACTER.
		BEQ	GETEXEC	 
		LDA	$C000
		BPL	RDEXEC0
		CMP	#$83	 		;APPLESOFT CONTROL-C FIX
		BNE	RDEXEC0	 	;BRANCH IF NOT CONRTROL-C
		JSR	CLSEXEC	 	;GO CLOSE EXEC FILE.
		LDA	RUNFLG	 	;IS PROGRAM EXECUTING?
		BNE	BADEX0	 	;BRANCH IF IT IS.
		STA	$C010	 		;CLEAR KBD
		BEQ	BADEX0	 	;BRANCH ALWAYS...
RDEXEC0	JSR	SETUPEXEC	 	;SET UP FOR READ OF EXEC FILE.
		JSR	RDEXEC1	 	;OTHERWISE, GET A WHOLE STRING.
		BCS	BADEXEC	 	;STOP IF ERROR ENCOUNTERED
		JSR	SAVREGS
		BCC	SETB7
SETB7A	DEX
		LDA	INLINE,X
SETB7		ORA	#$80	 		;Set bit 7 on in case going to Monitor 
		STA	INLINE,X	 	;SAVE LAST CHARACTER TOO.
		TXA
		BNE	SETB7A
		JSR	SNORMIO
		JSR	RDEXEC2	 	;CHECK FOR, AND EXECUTE, PRODOS COMMANDS.
		BIT	XCNUM	 		;WAS A COMMAND EXECUTED? 
		BPL	RDEXEC0	 	;LOOP IF IT WAS. 
EXEXIT	RTS				;OTHERWISE,	 RETURN WHATEVER... 
	SPACE 
GETEXEC	JSR	SETUPEXEC	 	;SET UP FOR READ OF AN EXEC FILE.
		JSR	RDGET1	 	;GO READ A CHARACTER.
		BCC	EXEXIT	 	;TERMINATE EXEC IF ERROR 
BADEXEC	JSR	CLSXERR	 	;GO CLOSE EXEC FILE.
		CMP	#CIEOFERR	 	;IS IT SIMPLE END OF FILE?
		BNE	BADREAD	 	;BRANCH IF NOT.
BADEX0	LDX	#0	 		;RESTORE ALL REGISTERS.
		LDY	$24	 
		BNE	BADEX1
		LDA	#$DD
		STA	PROMPT
		LDA	#$88
		RTS
BADEX1	LDA	(BASL),Y	 
		JMP	(KSWL)	 	;AND LOOP TO NORMAL INPUT.
BADREAD	JMP	ERROR

	TITLE	'READ INPUT'	
*********************** READ INPUT *********************************	
* RDINPUT Reads characters from a file into the Input Buffer. 
*   If Input is from a Directory File, differentiation between 
*   GET and INPUT is NOT made, and a full 80 character Directory 
*   entry is placed in the Input Buffer.  If this is called for 
*   a GET, only one character will be Read.  Otherwise 240 chars, 
*   or up to the first encountered END.OF.LINE char, will be Read. 
********************************************************************
RDINPUT	LDA	PROMPT
		CMP	#$DD	 		;BEFORE DOING READ MAKE
		BNE	RDINP1	 	; SURE PROGRAM IS RUNNING. 
		JMP	BRKINP	 	;QUIT IF NOT.
RDINP1	LDA	PREGA
		STA	(BASL),Y
		LDA	$C000
		BPL	RDINP2
		CMP	#$83	 		;APPLESOFT CTRL-C BUG FIX 
		BNE	RDINP2	 
		BIT	$C010	 		;CLEAR KBD STROBE
		RTS
RDINP2	LDA	PROMPT	 	;RESTORE VALUE FROM PROMPT.
		BIT	DIRFLG	 	;ARE WE READING A DIRECTORY FILE?
		BMI	RDDIR	 		;BRANCH IF DIRECTORY.
		CMP	#$BE	 		;IS THIS AN FROM A 'GET' STATEMENT?
		BEQ	RDGET	 		;BRANCH IF FROM 'GET'.
		JSR	RDLINE
		BCS	BADREAD
		RTS
	SPACE
RDGET		JSR	RDGET1
		BCS	BADREAD	 	;REPORT ERRORS.
		RTS
	SPACE
RDGET1	EQU	*
		LDA	RWCOUNT	 	;PRESERVE STANDARD RWCOUNT
		STA	VLNTH
		LDA	#1
		STA	RWCOUNT	 	;READ ONLY 1 CHARACTER.
		LDA	#READCMD	 	;GO DO IT.
		JSR	GOSYSTEM
		BCS	RDBAD	 		;RETURN ANY ERRORS IMMEDIATELY.
		LDA	VLNTH
		STA	RWCOUNT
		LDX	RWDATA
		LDA	INLINE,X	 	;RETURN CHARACTER IN ACC.
RDBAD		RTS
   SPACE 
RDLINE	LDA	PREGA	 		;REPLACE BLINKING CURSOR WITH ORIGINAL CHARACTER.
		STA	(BASL),Y
RDEXEC1	EQU	*	 		;EXEC CALLS HERE. 
		LDA	#READCMD	 	;GO READ IT.
		JSR	GOSYSTEM
		BCS	RDBAD	 		;REPORT ANY ERRORS IMMEDIATELY.
		LDA	RWTRANS	 	;FIND OUT HOW MANY CHARACTERS WERE READ.
		BEQ	RDLIN1	 	;BRANCH IF NUL INPUT.
		CLC
		ADC	RWDATA	 	;LOW BUFFER ADDRESS (EITHER 1 OR 0).
		TAX
		LDA	INLINE-1,X	 	;MAKE SURE LAST CHARACTER IS CARRAGE A CARRAGE RETURN.
		AND	#$7F
		CMP	#$0D	 		;(HI BIT NOT SET FOR TEXT I/O).
		BNE	RDLIN1	 	;BRANCH IF NOT. 
		LDA	FBITS+1	 	;IF LENGTH BIT SET, ADD EXTRA CR.
		AND	#L
		BNE	RDLIN1
		DEX				;RETURN PROPER INPUT POSITION.
RDLIN1	LDA	#$8D	 		;RETURN LAST CHARACTER AS CR.
		LDY	PREGY	 		;RESTORE Y REGISTER.
		CLC				;NO ERROR.
		RTS				;ALL DONE.
	SPACE
RDDIR		CMP	#$BE	 		;IS THIS A 'GET'?
		BEQ	RDLIN1	 	;IF SO, RETURN A CARRAGE RETURN.
		LDA	PREGA	 		;RESTORE CHARACTER AT CURSOR.
		STA	(BASL),Y
		LDA	#$4F
		STA	STRLEN	 	;SET INPUT LENGTH TO 80 CHARACTERS
		LDA	#GMRKCMD	 	;GET CURRENT FILE POSITION.
		JSR	GOSYSTEM
		BCS	RDDIRERR	 	;BRANCH IF ERROR.
		LDA	SMARK
		ORA	SMARK+1	 	;SPECIAL STUFF IF FILE POS=0.
		BNE	RDIR1	 		;BRANCH IF NOT BEGINNING 
		LDA	#2
		STA	CATFLAG	 	;INDICATE HEADER STUFF TO PROCESS.
		JSR	OPNDR2	 	;GET DIRECTORY NAME, FILE INFO, ETC.
		BCS	RDDIRERR
		LDA	RWREFNUM	 	;FIND ENTRY IN FILENAMES TO SET ENTLEN & MAXENT.
		LSR	A
		ROR	A
		ROR	A
		ROR	A
		TAX
		LDA	ENTLEN
		STA	FILNAMES+1,X	;PRESERVE WITH FILE NAME.
		LDA	MAXENT
		STA	FILNAMES+2,X
		JSR	CATITLE	 	;MOVE DIRECTORY NAME TO INPUT BUFFER.
RCRT00	LDA	#$A2	 		;PLACE QUOTE IN FRONT OF INPUT.
		STA	INLINE
		LDA	#$8D	 		;AND CR AT END.
		STA	INLINE,X
		CLC
		RTS
   SPACE 
RDIR1		LDA	CATFLAG	 	;PROCESSING DIRECTORY ENTRIES?
		BEQ	RDIR2
		BMI	RDIREND	 	;BRANCH IF LAST ENTRY ALREADY READ.
		LDX	#0	 		;ANTICIPATE GAP BETWEEN HEADER & FIRST ENTRY.
		DEC	CATFLAG
		BEQ	RCRT00	 	;BRANCH IF FIRST READ.
		JSR	SPACAT	 	;ELSE, RETURN HEADER STRING.
		LDX	#HEAD
		JSR	CONSTR
RCRT80	LDX	#$50	 
		BNE	RCRT00	 	;BRANCH ALWAYS TAKEN...
RDIREND	CMP	#$FF	 		;GIVE 'EM TRAILER?
		BNE	RCEOFERR	 	;NO, END OF FILE ERROR!
		DEC	CATFLAG	 	;YES, TRAILER, BUT ONLY ONCE!
		LDA	#0
		STA	RWCOUNT
		STA	RWCOUNT+1	 	;DO NUL READ TO GET DEVNUM.
		LDA	#READCMD
		JSR	GOSYSTEM
		JSR	CATRAIL	 	;CONSTRUCT LAST LINE.
		PHA				;SAVE	 ERROR CODE, IF ANY
		LDA	RWREFNUM	 	;RESTORE REFNUM FOR NEXT CALL
		STA	SREFNUM
		PLA
		BCC	RCRT80	 	;BRANCH IF NO ERROR
		BCS	RDDIRERR	 	;BRANCH ALWAYS. 
   SPACE 
RCEOFERR	LDA	#CIEOFERR
		SEC
RDDIRERR	JMP	ERROR	 
   SPACE 
RDIR2		LDA	#$FF
		STA	CURRENT	 	;FIGURE OUT CURRENT ENTRY BASED ON POSITION.
		LDA	RWREFNUM
		LSR	A
		ROR	A
		ROR	A
		ROR	A
		TAX
		LDA	FILNAMES+1,X	;RESET ENTLEN & MAXENT
		STA	ENTLEN
		LDA	FILNAMES+2,X
		STA	MAXENT
		LDA	SMARK+1	 	;GET 'PAGE' POSITION (1 OR 0)
		AND	#1
		TAX
		LDA	SMARK
		SEC
RDIRENT	INC	CURRENT
		SBC	ENTLEN	 	;SIMPLE DIVIDE BY SUCCESSIVE SUBTRACTION.
		BCS	RDIRENT
		DEX
		BEQ	RDIRENT 
		JSR	NXTCAT	 	;POSITION AND READ NEXT DIRECTORY ENTRY.
		BCC	RDIR3
		CMP	#ERRANGE	 	;IF ERROR, IS IT PAST END OF FILE?
		BEQ	RDIR4			;if error is range error
		CMP	#CIEOFERR		;if error is end of file error
		BNE	RDDIRERR	 	;BRANCH IF NOT 
RDIR4		DEC	CATFLAG
		LDX	#0
		JMP	RCRT00	 	;MARK NEXT IS TRAILER, RETURN NUL STRING.
	SPACE
RDIR3		JSR	CATASC	 	;CONVERT DIRECTORY ENTRY TO ASCII.
		JMP	RCRT80	 	; AND RETURN 80 CHARACTERS.
	SPACE
PFXINP	CMP	#$DD	 		;BREAK BEFORE PREFIX?
		BNE	PFXIN1	 	;BRANCH IF NOT
		JMP	BRKINP
PFXIN1	LDA	PREGA
		STA	(BASL),Y
		LDA	#0	 		;RESET PFXACTV.
		STA	PFXACTV	 
		LDX	TXBUF-1	 	;GET PREFIX LENGTH.
PFXIN2	LDA	TXBUF-1,X	 	;MOVE PREFIX TO INPUT BUFFER
		STA	INLINE-1,X
		DEX
		BNE	PFXIN2	 
		LDX	TXBUF-1
		LDA	#$8D	 		;RETURN A CR.
		RTS
   SPACE 2
SETUPEXEC	LDA	REFNUMS+7	 	;SET UP READ FROM EXEC FILE.
		STA	RWREFNUM
		LDA	#INLINE>>8	 	;SET TO INPUT BUFFER
		STA	RWDATA+1
		LDA	#$EF	 		;READ UP TO 239 CHARACTERS
		STA	RWCOUNT
		LDA	#0
		STA	RWCOUNT+1
		STA	RWDATA	 
		RTS				;THAT	 IS ALL.

	TITLE	'CTRL-D CHECK APPLESOFT'
**********************************************************
* OUTCKD is called to check for a CTRL-D after a PRINT Token 
*   is detected.  If a CTRL-D is detected, I/O State 2 is set 
*   so that the Command following can be Captured and Processed. 
*   Otherwise, I/O State 4 (Deferred MODE) is re-installed to  
*   allow File or Device I/O to proceed. 
**********************************************************
*
OUTCKD	JSR	SAVREGS	 	;SAVE A,X,&Y.
		CMP	#$84	 		;HAVE WE A DEFERRED COMMAND COMING?
		BNE	NOCTLD	 	;BRANCH IF NOT.
		JSR	CLRFBUF	 	;FLUSH ANY FILE BUFFER STUFF.
		STA	INPTR	 		;(ACC=0 AT THIS POINT.)
		STA	IFILACTV
		STA	OFILACTV
		STA	PFXACTV	 	;CLEAR ALL BUT EXEC FILE STATE.
		LDX	#8	 		;SET I/O TO GOBBLE COMMAND. 
		JSR	SETSTATE
		JMP	RSTREGS	 	;RESTORE REGISTERS AND RETURN.
*
NOCTLD	LDX	#4	 		;SET I/O STATE TO NORMAL DEFERRED MODE.
		JSR	SETSTATE
		JSR	RSTREGS	 	;GET ORIGINAL REGISTERS AGAIN.
		JMP	DOSOUT	 	;BEGIN AT THE TOP AGAIN.
*
CMDOUT	JSR	SAVREGS	 	;PRESERVE REGISTERS.
		LDX	INPTR	 		;SAVE OUTPUT IN INPUT BUFFER.
		STA	INLINE,X
		CMP	#$8D	 		;END OF LINE?
		BEQ	DFCMD	 		;BRANCH IF IT IS.
		INC	INPTR	 		;BUMP POINTER FOR NEXT CHARACTER.
		BNE	CMDOUT1	 	;BRANCH IF ALL IS WELL (SO FAR).
		LDA	#ERRSYN	 	;REPORT SYNTAX ERROR
GODFERR	JMP	DFERROR	 
*
CMDOUT1	LDX	PREGX	 		;RESTORE X REGISTER
		RTS				;ALL DONE FOR NOW.
*
DFCMD		INX
		DEX
		BEQ	DFCMDNUL
		JSR	SNORMIO	 	;SET NORMAL I/O FOR WHAT FOLLOWS...
		JSR	SYNTAX	 	;GO EXECUTE THE COMMAND. 
		BCS	GODFERR
		JSR	SSYSIO	 	;RESTORE SYSTEM ADDRESSES.
	SPACE
DFCMDNUL	LDX	#4	 		;RESTORE NORMAL DEFERRED STATE.
		JSR	SETSTATE
	SPACE
		JMP	RSTREGS	 	;RESTORE REGISTERS, AND RETURN
FILOUT	STY	PREGY	 		;SAVE Y FOR NOW.
		LDY	PROMPT	 	;OUTPUT MUST BE FROM PRINT, LIST OR CALL.
		BEQ	FILOUT1	 	;BRANCH IF PRINT.
		DEY
		BEQ	FILOUT1	 	;BRANCH IF LIST.
		DEY
		BEQ	FILOUT1	 	;BRANCH IF CALL.
		LDY	PREGY	 		;RESTORE Y, AND DO REGULAR OUTPUT (FOR INPUT PROMPT).
		JMP	IMOUT
*
FILOUT1	LDY	TBUFPTR	 	;ADD THIS CHARACTER TO TEMP BUFFER.
		AND	#$7F	 		;STRIP HI BITS...
		STA	(HIMEM),Y
		LDY	PREGY	 		;ANTICIPATE ALL DONE FOR NOW.
		INC	TBUFPTR	 	;ADD 1 TO CURRENT BUFFER POINTER.
		BNE	FILOUT2	 	;BRANCH IF NO NEED TO FLUSH.
		JSR	SAVREGS	 	;SAVE ALL REGISTERS.
		JSR	WRT256	 	;GO CLEAR ALL 256 BYTES OF TEMP BUF.
		BCS	GODFERR
		JSR	RSTREGS	 	;RESTORE REGISTERS (DOES NOT RETURN IF ERROR).
FILOUT2	RTS				;ALL	 DONE...

	TITLE	'DEFERRED OUTPUT'	 
******************** DEFERRED OUTPUT ************************
* DFOUT is the normal Deferred Output Routine.  There are 3 
*   functions served here:
*       1) To Detect TRACE Information being output, which  
*            signals Token Processing. 
*       2) To Direct Normal Printed output to File or Device. 
*       3) To assist in Detecting a Program BREAK due to Errors 
*            or a CTRL-C issued by the User. 
*************************************************************
;DFOUT	CMP	TRCIMG		;IS IT '#', THE TRACE MODE LEADER?
;		BNE	DFOUT2	 	;BRANCH IF NOT.
;		STX	PREGX
;		TSX				;TO VALIDATE IF IT IS TRUELY FROM TRACE,
;		LDA	$103,X	 	;THE STACK MUST BE EXAMINED FOR CALLING
;		CMP	#$12	 		; ROUTINE'S RETURN ADDRESS.
;		BNE	DFOUT1	 	;BRANCH IF NOT TRACE.
;		LDA	$104,X	 	;CHECK HI BYTE JUST TO BE SURE.
;		CMP	#$D8
;		BEQ	TOKENS	 	;GO PROCESS TRACE AND TOKENS.
;DFOUT1	LDA	TRCIMG	 	;RESTORE '#' AND X REG.
DFOUT		PHA
		STX	PREGX
		TSX				;TO VALIDATE IF IT IS TRUELY FROM TRACE,
		LDA	$104,X	 	;THE STACK MUST BE EXAMINED FOR CALLING
		CMP	#$12	 		; ROUTINE'S RETURN ADDRESS.
		BNE	notPound	 	;BRANCH IF NOT TRACE.
		LDA	$105,X	 	;CHECK HI BYTE JUST TO BE SURE.
		CMP	#$D8
		BNE	notpound
		PLA
		BCS	Tokens
NotPound	PLA
		NOP
		NOP
		NOP
		LDX	PREGX
DFOUT2	BIT	OFILACTV	 	;IS AN OUTPUT FILE ACTIVE?
		BPL	DFOUT4		;BRANCH IF NOT.
		CMP	#$DD	 		;is it ']' 
		BNE	DFOUT2A
		CMP	PROMPT
		BEQ	DFOUT5A
DFOUT2A	CMP	#$8D	 		;IS THIS CHARACTER A CARRAGE RETURN?
		BNE	FILOUT	 	;BRANCH IF NOT.
		LDA	PROMPT
		CMP	#$FF	 		;TEST IF OUTPUT POSSIBLE ERROR MESSAGE
		LDA	#$8D	 		;OTHERWISE, IT'S OK TO OUTPUT 2 CR'S.
		BCC	FILOUT
DFOUT3	JSR	CLRFBUF	 	;OTHERWISE, ASSUME DISASTER, AND FLUSH CURRENT FILE.
		STA	OFILACTV	 	; DISABLE OUTPUT TO FILE.
		LDA	#$8D	 		;AND PRINT SECOND CR TO REG DEVICE.
		BNE	GIMOUT	 	;BRANCH ALWAYS TAKEN 
*
DFOUT4	PHA				;SAVE	 CHARACTER
		LDA	IFILACTV	 	;DETERMINE IF OUTPUT SHOULD BE THROWN AWAY.
		ORA	PFXACTV
		BPL	DFOUT5
		LDA	PROMPT
		ORA	#4
		CMP	#$84	 		;IS THIS INPUT STATEMENT?
		BEQ	DFIGNORE	 	;BRANCH IF YES.
DFOUT5	PLA
		CMP	#$DD	 		;IS IT A ']' PROMPT?
		BNE	GIMOUT
		CMP	PROMPT	 	;IS PROMPT SET TO IMMEDIATE MODE?
		BNE	GIMOUT	 	;BRANCH IF NOT.
DFOUT5A	EQU	*
		JSR	SAVREGS
		LDA	OPENCNT	 	;ELSE, DETERMINE IF 'FILES OPEN' WARNING NEEDED.
		BEQ	DFOUT6	 	;BRANCH IF NO FILES OPEN.
		JSR	CLRFBUF
		STA	OFILACTV
		JSR	SNORMIO	 	;ELSE, PRINT WARNING!!!
		LDA	#FILSOPN
		JSR	PRINTERR	 
DFOUT6	JSR	RSTREGS	 	;RESTORE ']' THAT WAS TRASHED.
GIMOUT	JMP	IMOUT
*
DFIGNORE	PLA				;RESTORE CHARACTER
		CMP	#$8D
		BNE	DFIGNR1	 	;BRANCH IF NOT CARRAGE RETURN
		CMP	CHRLAST	 
DFIGNR1	STA	CHRLAST	 
		BNE	DFIGNR2
		STA	PROMPT
DFIGNR2	RTS				;NO OUTPUT.

	TITLE	'TOKENS'
*************************** TOKENS *******************************
TOKEN0	INC	$B9	 		;BUMP HIGH BYTE OF CHARGET PTR.
		BNE	TOKEN1	 	;BRANCH ALWAYS.
TOKENS	INC	$B8	 		;BUMP LOW BYTE OF CHARGET PTR.
		BEQ	TOKEN0	 	;BRANCH IF PAGE CROSS.
TOKEN1	EQU	*
		LDX	#$FF
		STX	PROMPT	 	;Save for error detection in DFOUT routines
		LDX	$F8	 		;FIRST RESET STACK FOR APPLESOFT.
		TXS
		BIT	DTRACE	 	;IS TRACE MODE REALLY ACTIVE?
		BMI	DOTRACE	 	;BRANCH IF IT IS.
TOKEN2	LDY	#0		 	;GET NEXT TOKEN.
		LDA	($B8),Y
		BMI	TOKEN3	 	;BRANCH IF REAL TOKEN.
		BEQ	GTOKEN
LETTOK1	DEC	STRINGS	 	;CHECK FOR GARBAGE COLLECT NEEDED
		BNE	TOKEN2A	 	;BRANCH IF NO NEED YET.
		LDA	STRBOT+1	 	;RESET CHECKER.
		SBC	ENDVAR+1	 
		CMP	#3	 		;IS IT WITHIN 2 PAGES OF GARBAGE COLECTION?
		BCS	TOKEN2B	 	;BRANCH IF NOT.
		JSR	CLRFBUF	 	;SAVE CURRENT FILE STUFF.
		JSR	COLLECT	 	;DO GARBAGE COLLECTION.
		LDA	STRBOT+1	 	;FIGURE OUT HOW MANY PAGES LEFT.
		SBC	ENDVAR+1	 
TOKEN2B	STA	STRINGS	 	;SAVE NEW COUNT.
		LDY	#0
		LDA	($B8),Y	 	;GET TOKEN AGAIN.
TOKEN2A	CMP	#$3A	 		;SET STATUSES.
GTOKEN	JMP	$D820	 		;GO EXECUTE IN APPLESOFT.
* 
TOKEN3	STA	PROMPT	 	;SAVE TOKEN IN PROMPT.
		TAY				;INDEX TO TOKEN TABLE.
		LDA	TOKTBL-$80,Y	;IF NEGATIVE, PASS IT THRU.
		BMI	GTOKEN	 	;BRANCH IF UN TRAPPED TOKEN.
	SPACE 2
	TITLE	'TOKEN DISPATCHER'
****************************** TOKEN DISPATCHER ****************************	
		STA	GO+1	 		;* * * * SELF MODOIFING CODE.
GO		BNE	PRINT	 		;DESTINATION CHANGED BY PRECEEDING INSTUCTION.
*
IF		EQU	*
PRINT		STA	PROMPT	 	;RESET PROMPT TO INDICATE PRINT ACTIVE.
		STA	CHRLAST
		LDA	CKDADDR	 	;RESET OUTPUT HOOK TO CHECK
		STA	VSYSIO	 	;FOR A CTRL-D BEING OUTPUT NEXT.
		LDA	CKDADDR+1
		STA	VSYSIO+1
		BNE	TOKEN4	 	;BRANCH ALWAYS TAKEN.
*
LIST		LDA	#1	 		;INDICATE LIST ACTIVE.
		STA	PROMPT
		BNE	TOKEN4	 	;BRANCH ALWAYS.
*
CALL		LDA	#2
		STA	PROMPT	 	;INDICATE CALL ACTIVE.
		BNE	TOKEN4	 	;BRANCH ALWAYS
*
LET		TYA				;RESTORE LET TOKEN.
		JMP	LETTOK1	 	;LET INVOKES A CHECK FOR GARBAGE COLLECT.
*
TRACE		STY	DTRACE	 	;SET TRACE MODE ON.
		BNE	TRACEON	 	;BRANCH ALWAYS.
NOTRACE	STA	DTRACE	 	;SET TRACE OFF. 
		DEY				;PASS TRACE token instead of NOTRACE, to keep us in the Hook.
TRACEON	LDA	#$4A	 		;SO TRACE FLG = $A5 AFTER 1 SHFT IN BY APSFT.
		STA	ZTRACE
TOKEN4	TYA				;RESTORE ORIGINAL TOKEN.
		JMP	$D820	 		;LET APPLESOFT EXECUTE IT. (JSR GONE3 at end of NEWSTT) 
RESUME	LDA	#0
		STA	ASERR	 		;CLEAR APPLESOFT ERROR CODE ON RESUME.
		TYA
		BNE	TOKEN2A	 	;BRANCH ALWAYS
*
DOTRACE	JSR	SNORMIO	 	;SET I/O HOOKS TO ALLOW
		LDA	#$A3	 		;CHARACTER OUTPUT.
		JSR	GOCSWL
		LDX	$75	 		;THIS SECTION COPIED FROM APPLESOFT.
		LDA	$76
		JSR	$ED24
		LDA	#$A0
		JSR	GOCSWL
		JSR	SSYSIO	 	;RESTORE NORMAL HOOKS TO PRODOS.
		SEC
		JMP	TOKEN2	 	;RESUME WITH TOKEN EVALUATION.
*
FLASH		LDA	#$E3	 
		BNE	FLASH1
NORMAL	EQU	*
INVERSE	LDA	#$A3
FLASH1	STA	TRCIMG
		TYA
		BNE	TOKEN2A	 	;Always...
		DC.B	$00	 		; Never
*
TRCIMG	DC.B	$A3
	SPACE 2
	TITLE	'SAVE REGISTERS'
************************** REGISTERS AND STATE ************************
SAVREGS	STA	PREGA
		STX	PREGX
		STY	PREGY
		RTS
*
RSTREGS	LDA	PREGA
		LDX	PREGX
		LDY	PREGY
		RTS
*
SETSTATE	STX	STATE	 		;SAVE STATE #. 
		LDY	#0	 		;MOVE I/O ADDRESSES TO VECTORS 'VSYSIO'.
SSTATE	LDA	SYSIO,X
		STA	VSYSIO,Y
		INX
		INY				;MOVE	 4 Bytes; 2 Input, 2 Output 
		CPY	#4
		BNE	SSTATE
		RTS	;ALL	 DONE.
	SPACE
	TITLE 'PRINT ERRORS'
******************PRINT ERRORS****************************
* PRINTERR Prints the ASCII Error Message for the Error Code 
*   passed to it in the Accumulator.  All Registers are used. 
**********************************************************
		EXPORT PRTERROR
PRTERROR	TAY				;GET ERROR # INTO Y 
		LDX	ERRTBL-2,Y	 
PRCOPYRT	JSR	CONSTR	 	;CONSTRUCT THE ERROR MESSAGE IN 'INBUF1'
		LDX	INPTR	 		;GET STRING LENGTH
		STX	STRLEN	 	;SAVE IT.
		JSR	CROUT
		LDA	#BELL	 		;BEEP THE BEEPER FIRST.
		JSR	COUT
*
PRTLINE	LDX	#0	 		; PRINT ERROR MESSAGE TO OUTPUT DEVICE
PRTLIN1	LDA	INBUF1,X	 	;PRINT 'STRLEN' CHARACTERS.
		JSR	COUT
		INX
		CPX	STRLEN	 	;DONE?
		BCC	PRTLIN1	 	;BRANCH IF NOT.
CROUT		LDA	#$8D	 		;END WITH CARRAGE RETURN.
COUT		JMP	GOCSWL	 
	SPACE
CONSTR	LDY	#0	 		;CONVERT ENCODED MESSAGE TO ASCII
		CLC				;INDICATE UPPER NYBBLE TO BE PROCESSED.
		STY	INPTR
CONSTR1	EQU	*
		JSR	GETNIB	 	;FETCH NEXT 4-BIT CHARACTER.
		BNE	STSTR	 		;BRANCH IF MOST OFTEN KIND.
		JSR	GETNIB	 	; OTHERWISE, IT'S A LESS POPULAR CHARACTER.
		ORA	#$10	 		; SHIFT TO LESSER USED CHARACTERS.
	SPACE
STSTR		TAY				;INDEX TO ASCII EQUIVALENT.
		LDA	EASCON-1,Y
		BEQ	CONSTR2	 	;BRANCH IF LAST CHARACTER PROCESSED. 
		LDY	INPTR	 		; OTHERWISE, SAVE IN 'INBUF1' 
		STA	INBUF1,Y	 
		INC	INPTR	 		;BUMP INPTR FOR NEXT TIME. 
		BNE	CONSTR1	 	;BRANCH ALWAYS.
CONSTR2	RTS				;ALL DONE...
	SPACE
GETNIB	EQU	*
		LDA	ERRSTR,X	 	;GET CURRENT BYTE
		BCS	SECND	 		;BRANCH IF LOWER NYBBLE.
		BEQ	STRCOL	 	;BRANCH IF COLUMN NUMBER ENCOUNTERED.
		LSR	A
		LSR	A
		LSR	A
		LSR	A
		SEC
		RTS				;INDICATE UPPER NYBBLE
	SPACE
STRCOL	INX				;INDEX TO COLUMN VALUE
		LDA	ERRSTR,X
		STA	INPTR
		INX				;BUMP	 TO NEXT NORMAL CHAR.
		BNE	GETNIB	 	;BRANCH ALWAYS TAKEN.
	SPACE
SECND		INX
		AND	#$F
		CLC				;INDICATE LOWER NYBBLE. 
		RTS
	SPACE
WRT256	LDA	#0	 		;WRITE ALL 256 BYTES OF TEMP TEXT
		LDY	#1	 		; BUFFER (AT HIMEM), MLI WRITE SET BY WRITE
		BNE	CLEARBF1	 	; AND APPEND COMMANDS (BRANCH ALWAYS)
	SPACE
CLRFBUF	JSR	CLEARBUF	 	;CLEAR ANY LEFTOVER TEXT
		BCC	GOODCLR	 	; FROM TEMP BUFFER.
		TAY				;SAVE	 ERROR IN Y FOR NOW.
		PLA				;FIX STACK
		PLA
		TYA
		JMP	DFERROR	 	;REPORT ERROR
	SPACE
CLEARBUF	LDY	#0	 		;WRITE LESS THAN 256 BYTES FROM TEMP
		LDA	TBUFPTR	 	; TEXT BUFFER.
		BEQ	CLEARBF2	 	;BRANCH IF NOTHING TO WRITE.
CLEARBF1	STA	RWCOUNT
		STY	RWCOUNT+1
		LDA	#WRITCMD	 	;WRITE TO FILE SET UP IN MLI
		JSR	GOSYSTEM	 	; CALL PARMS BY WRITE OR APPEND CMDS.
		PHA				;SAVE ANY ERROR.
		LDA	#0	 		;ALWAYS CLEAR TBUFPTR.
		STA	TBUFPTR
		PLA
		BCS	CLRBFERR	 	;RETURN ERRORS.
CLEARBF2	CLC
GOODCLR	EQU	*
CLRBFERR	RTS

	TITLE 'APPLESOFT GARBAGE COLLECTION'
*********************************************************
*          APPLESOFT GARBAGE COLLECTION ROUTINE         * 
*                                                       *
*  Subroutines used are:                                *
*      MOVBUF, SIMPLE, ARRAY, MVSTR                     * 
*                                                       *
*  Variables and Temps used:                            *
*      MEMTOP, MEMBOT, GPBUF, FROM, STRBOT, GARBOT,     *
*      END.LO, TO, SIMPTR, ARRPTR, VPTR, ENDVAR,        *
*      GARTOP, BUFBOT                                   *
*                                                       *
*  On Entry:                                            *
*     MEMTOP = "HIMEM", must be Greater than or Equal   * 
*                       to Applesoft HIMEM.             *
*     MEMBOT = End of Variable SPACE if called from     * 
*              GETBUF or beginning of a program for     *
*              STORE and CHAIN.                         *
*     GPBUF = Page address of 1K general purpose Buffer *
*               SPACE .SIMPTR, ARRPTR, ENDVAR are       * 
*            Applesoft zero-page values.                *
*                                                       *
*  On Exit:                                             * 
*     The Carry is Set if a MEMFUL Error has occurred.  * 
*     All Registers are used.                           *
*                                                       *
*********************************************************                                                       * 
*      Variable's names have two bytes.  They also      *
*   serve to identify the type of variable.             *
*                                                       * 
*         Type             sign of     sign of          * 
*                           byte 1      byte 2          * 
*      INTEGER                -           -             *
*         REAL                +           +             *
*       STRING                +           -             *
*     USER DEF                -           +             *
*                                                       *
*********************************************************
COLLALL	JSR	COLLECT	 
		BCS	RTNERR	 	;BRANCH IF ERROR
		LDA	BEGPROG+1
		STA	MEMBOT+1	 
		LDA	BEGPROG
		STA	MEMBOT
		LDA	HIMEM+1	 
		STA	GPBUF
		LDA	#3
		STA	BUFLEN
		LDA	STRBOT+1
		STA	MEMTOP+1
		LDA	#$00	 
		STA	MEMTOP
		JSR	GARB2	 		;NOTE ENTRY REQUIREMENTS 
RTNERR	RTS
	SPACE
COLLECT	EQU	*
		LDA	#0	 
		STA	MEMBOT
		LDA	#3	 
		STA	BUFLEN
		LDA	HIMEM+1	 	;BUFFER DEFAULTS TO HIMEM THRU HIMEM+$3FF
		STA	GPBUF
		LDA	STRBOT+1	 
		STA	MEMBOT+1
		SEC
		SBC	ENDVAR+1
		CMP	#7
		BCC	GOGARB
		SBC	#3	 
		STA	BUFLEN
		LDA	ENDVAR+1
		ADC	#0
		STA	GPBUF
		LDA	HIMEM+1	 	;NOW TEST FOR MAXIMUM BUFFER NEEDED.
		SBC	STRBOT+1
		ADC	#1	 		;THROW IN AN EXTRA PAGE FOR GOOD MEASURE...
		CMP	BUFLEN	 	;IS CURRENT BUFFER LENGTH OVERKILL?
		BCS	GOGARB	 	;BRANCH IF NOT.
		STA	BUFLEN	 	;OTHERWISE REDUCE TO MINIMUM PAGE COUNT.
GOGARB	EQU	*
		LDA	HIMEM+1	 	;Set Top of Memory to HIMEM
		STA	MEMTOP+1
		LDA	HIMEM
		STA	MEMTOP
		STA	STRBOT	 	;Bottom of collected strings
GARB2		CLC				;ANTICIPATE	 THAT THIS IS ON A PAGE BOUNDARY
		BEQ	G10	 		;BRANCH IF ASSUMPTION CORRECT
		SEC				;MAKE	 COLLECT COVER ALL OF HIGH PAGE TOO.
G10		LDA	MEMTOP+1	 
		STA	STRBOT+1
		SBC	#0	 		;ADJUST FOR TOP PAGE NEEDED TO BE MOVED
		STA	GARBOT	 	;SAVE INITIAL HI ADR OF GARBAGE WINDOW
		ADC	#0	 		;(CARRY IS SET, SO ADD 1)
		STA	GARTOP
		LDA	ENDVAR+1	 	;SET LOWEST MEM FOR GARBAGE TO GET.
		ADC	#1
		STA	MEMCHK
*
GARLOOP	EQU	*	 		;SET UP INITIAL POINTERS TO SIMPLE
		LDA	SIMPTR	 	; AND ARRAY VARIABLE TABLES.
		SBC	#6	 		;(SEE "SIMPLE" ROUTINE ,CARRY ASSUMED CLR)
		STA	VPTR
		LDA	SIMPTR+1
		SBC	#0
		STA	VPTR+1
		LDA	ARRPTR
		STA	END_LOW
		LDA	GARBOT	 	;NOW ADJUST GARBOT AND BUFBOT TO GET
		CMP	MEMBOT+1	 	; MAX WINDOW FOR GARBAGE COLLECT
		BCC	GARDONE	 	;BRANCH IF ALL COLLECTED.
		SBC	BUFLEN	 	;ADJUST BY BUFLEN PAGES TO OVERLAP
		STA	BUFBOT
		LDA	STRBOT+1	 	;NOW CALC NEW GARBOT 
		SBC	GARBOT		;(ASSUMES CARRY SET)
		SBC	BUFBOT		;(ASSUMES CARRY SET)
		EOR	#$FF	 		;COMPLIMENT AND ADD 2
		ADC	#2	 		;(ASSUMES CARRY CLEAR)
		CMP	BUFBOT	 	;GARBOT MUST BE LT OR EQ TO BUFBOT.
		BCC	G20
		LDA	BUFBOT
G20		CMP	MEMBOT+1	 	;OR MAY ONLY BE 1 PAGE LOWER THAN MEMBOT
		BCS	G30
		LDA	MEMBOT+1
		SBC	#0	 		;SUBTRACT 1 (CARRY WAS CLR)
G30		STA	GARBOT
		JSR	MOVBUF	 	;GO PRESERVE TOP 1K OF GARBAGE WINDOW
		LDX	ARRPTR+1
		JSR	SIMPLE	 	;COLLECT THE SIMPLE STRINGS IN THE WINDOW
		BCS	GARERR	 	;BRANCH IF MEMORY FULL ERROR.
		JSR	ARRAY	 		;GO COLLECT ARRAY STRINGS.
		LDA	GARBOT
		STA	GARTOP
		BCC	GARLOOP	 	;BRANCH IF NO ERRORS
*
GARERR	LDA	#MEMFUL	 	;REPORT MEMORY CONFLICT
*
GARDONE	RTS
	SPACE
	TITLE 'STRING VARIABLES'
*********************************************************
*                                                       *
*    Simple String Variable Search and Collection       * 
*                                                       *
*********************************************************
SIMPLE	CLC
SIMPLE1	LDA	VPTR	 		;ADJUST TO NEXT VARIBLE IN TABLE
		ADC	#7
		STA	VPTR
		BCC	SIMP10
		INC	VPTR+1	 	;ADJUST HI ADDR IF NECESSARY
SIMP10	EOR	ARRPTR	 	;END OF SIMPLE VARIABLES?
		BNE	NEXTS	 		;CONTINUE IF NOT.
		CPX	VPTR+1
		BEQ	SIMDONE	 	;ALL DONE IF MATCH.
*
NEXTS		LDY	#0	 		;INDEX TO FIRST CHAR OF VAR NAME
		LDA	(VPTR),Y	 	;TO BE STRING, FIRST MUST HAVE
		INY				; MUST HAVE HI BIT SET.
		EOR	(VPTR),Y
		BPL	SIMPLE	 	;NO NEXT VAR IF THIS ONE NOT STRING
		LDA	(VPTR),Y	 	;Check if its a DEF 
		BPL	SIMPLE
		LDY	#4	 		;INDEX TO HI BYTE OF POINTER TO STRING
		LDA	(VPTR),Y
		CMP	GARBOT	 	;DOES THIS STRING FIT IN CURRENT WINDOW?
		BCC	SIMPLE1	 	;BRANCH IF NOT
		CMP	GARTOP	 	;HAS IT ALREADY BEEN PROCESSED?
		BCS	SIMPLE
		JSR	MVSTR	 		;GO MOVE THE STRING.
		BCC	SIMPLE1	 	;BRANCH IF NO ERROR.
		RTS
*
ARRDONE	EQU	*
SIMDONE	CLC				;INDICATE NO ERROR.
		RTS
*
	TITLE 'ARRAY STRING VARIBALES'
*********************************************************
*                                                       *
*     Array String Variable Search and Collection       * 
*                                                       *
*********************************************************
ARRAY		JSR	CALCARR	 	;CALCULATE POSITION OF NEXT ARRAY.
		BCS	ARRDONE	 	;BRANCH IF FINISHED.
*
ELEMENT	LDY	#2	 		;INDEX TO HI ADDR OF STR POINTER
		LDA	(VPTR),Y
		CMP	GARBOT	 	;IS IT LOWER THAN WINDOW?
		BCC	NEXTE	 		;BRANCH IF IT IS.
		CMP	GARTOP	 	;HAS IT ALREADY BEEN COLLECTED?
		BCS	NEXTE	 		;BRANCH IF IT HAS
		JSR	MVSTR	 		;GO COLLECT IT IF IT HASN'T!
		BCC	NEXTE1
		RTS				;REPORT MEMORY FULL ERROR.
*
NEXTE	CLC
NEXTE1	LDA	#3
		ADC	VPTR	 		;ADJUST TO NEXT ARRAY ELEMENT.
		STA	VPTR
		BCC	ARRTEST	 	;BRANCH IF HI BYTE NEEDS NO ADJUSTMENT.
		INC	VPTR+1
ARRTEST	CMP	END_LOW	 	;DONE WITH THIS ARRAY?
		BNE	ELEMENT
		CPX	VPTR+1	 	;CHECK HI BYTE FOR DONE.
		BNE	ELEMENT	 	;BRANCH IF MORE ELEMENTS
		BEQ	ARRAY	 		;ALWAYS 
	SPACE
****************************************************
*    Calculate Pointer to next String Array        *
****************************************************
CALCARR	CLC
		LDA	END_LOW	 	;TEST FOR END OF ARRAY VARIABLES
		STA	VPTR
		STX	VPTR+1
		EOR	ENDVAR	 	;END OF VAR TABLE ?
		BNE	NEXTA	 		;NO DO NEXT ARRAY
		CPX	ENDVAR+1	 
		BEQ	CARRDNE	 	;BRANCH IF END OF TABLE (CARRY SET).
NEXTA		LDY	#2	 		;INDEX TO OFFSET OF NEXT ARRAY
		LDA	(VPTR),Y
		ADC	VPTR	 		;ADD TO CURRENT POINTER.
		STA	END_LOW
		INY
		LDA	(VPTR),Y
		ADC	VPTR+1	 
		TAX
		LDY	#0	 		;NOW CHECK FOR STRING ARRAY
		LDA	(VPTR),Y	 	;FIRST CHAR MUST HAVE HI BIT OFF
		INY
		EOR	(VPTR),Y
		BPL	CALCARR	 	;SECOND MUST HAVE HI BIT SET.
		LDY	#4	 		;NOW INDEX TO # OF DIMENSIONS.
		LDA	(VPTR),Y	 	; AND CALC POINTER TO FIRST ELEMENT.
		ASL	A
		ADC	#5			 ;(CARRY ASSUMED CLR)
		ADC	VPTR	 		;(CARRY ASSUMED CLEAR)
		STA	VPTR
		BCC	CARRDNE	 	;BRANCH IF HI POINTER NEEDS NO ADJUSTMENTS.
		INC	VPTR+1
		CLC
CARRDNE	RTS
	SPACE
	TITLE 'MOVE BUFFERS'
****************** MOVE BUFFERS *********************
*     Moves Data from page BUFBOT to GPBUF.         *
*     Moves 256 * BUFLEN.                           *
*****************************************************
MOVBUF	EQU	*
		LDA	BUFBOT
		STA	FROM+1	 	;SET UP SOURCE'S START PAGE.
		LDA	GPBUF
		STA	TO+1	 		; AND DESTINATION ADDRESS.
		LDY	#0	 		;ALWAYS ON A PAGE BOUNDARY.
		STY	FROM
		STY	TO
		LDX	BUFLEN	 
		INX
MVBUF		LDA	(FROM),Y	 	; MOVE BUFLEN PAGES.
		STA	(TO),Y
		INY
		BNE	MVBUF
		INC	TO+1
		INC	FROM+1
		DEX
		BNE	MVBUF	 		;BRANCH IF MORE PAGES TO MOVE.
		RTS
	SPACE
	TITLE 'MOVE STRING'
***************** MOVE STRING ****************************
*   Routine: MVSTR
*       Move String routine packs strings to STRBOT and 
*       updates the Variable's Pointer. 
**********************************************************
MVSTR		CMP	BUFBOT	 	;(A=HI ADR OF STRING POINTER)
		BCC	MVSTR1	 	;BRANCH IF STRING NOT IN GP BUFFER
		SBC	BUFBOT	 	;CALC CORRESPONDING ADR IN GP BUFFER.
		CLC
		ADC	GPBUF
MVSTR1	STA	FROM+1	 	;STORE HI BYTE OF SOURCE ADR.
		DEY
		LDA	(VPTR),Y	 	;GET LOW ADDRESS
		STA	FROM
		DEY				;NOW CALC NEW STRBOT.
		SEC
		LDA	STRBOT
		SBC	(VPTR),Y
		STA	STRBOT
		INY
		STA	(VPTR),Y	 	;AND UPDATE VARIABLE'S POINTER
		LDA	STRBOT+1
		SBC	#0
		STA	STRBOT+1
		INY
		STA	(VPTR),Y	 	;ADJUST HI BYTE TOO
		DEY				;NOW GET STRING'S LENGTH
		DEY
		LDA	(VPTR),Y
		BEQ	STRDONE	 	;BRANCH IF NUL STRING.
		TAY				;AND	 USE AS AN INDEX.
MVSTR2	DEY
		LDA	(FROM),Y	 	;NOW ACTUALLY MOVE THE STRING
		STA	(STRBOT),Y
		TYA
		BNE	MVSTR2		 ;This can't be a BPL since length may be >127 chrs 
STRDONE	CLC
		LDA	MEMCHK	 	;CHECK FOR POTENTIAL OUT OF MEMORY ERROR.
		SBC	STRBOT+1
		RTS				;IF CARRY SET THEN OUT OF MEMORY.
	SPACE

	TITLE	'BUFFER MANAGEMENT'	 
**************** BUFFER MANAGEMENT ************************
*
* GETSYSBUF sets Applesoft's HIMEM down 1K (4 pages) and returns  
*   a system buffer at the old HIMEM address.  The 1K    SPACE  above 
*   HIMEM is always reserved for the CI's temporary work   SPACE  
*   (used for garbage collection, and temporary system buffers). 
*
*************************************************************
GETSYSBUF	LDA	#4	 		;Allow for 4 pages
GETSYSMEM	STA	PAGES
		JSR	COLLECT	 	;COLLECT APPLESOFT'S STRINGS.
		BCS	GSBERR	 	;BRANCH IF MEMORY IS FULL.
		LDA	STRBOT+1	 	;NOW MAKE SURE THAT 1K IS AVAILABLE.
		SBC	ENDVAR+1
		CMP	PAGES	 		;TEST FOR AT LEAST 1K AVAILABLE.
		LDA	#MEMFUL	 	;ANTICIPATE MEMORY FULL.
		BCC	GSBERR		;BRANCH IF IT IS INDEED FULL.
		LDA	STRBOT+1		;PREPARE TO MOVE STRINGS DOWN
		STA	FROM+1		; TO MAKE ROOM FOR A SYSTEM BUFFER.
		SBC	PAGES	 		;(4 PAGES=1K)
		STA	TO+1
		STA	STRBOT+1	 	;MARK NEW STRING BOTTOM.
		LDA	STRBOT
		STA	FROM
		STA	TO
		LDA	HIMEM	 		;CALCULATE HOW MANY BYTES NEED TO BE MOVED.
		SBC	FROM	 		;(CARRY ASSUMED SET).
		STA	CNTLO
		LDA	HIMEM+1
		SBC	FROM+1	 
		STA	CNTHI
		JSR	MOVDOWN	 	;GO MOVE STRINGS.
		LDA	#0	 		;ADJUST STRING VARIABLE POINTERS
		SEC
		SBC	PAGES
		STA	STROFF	 	;STRING ADDRESS ARE ALWAYS ADJUSTED 
		JSR	ADJSTRGS		; BY PAGES, I.E. $XX00 BYTES.
		LDA	HIMEM+1
		STA	OLDHIMEM	 	;SAVE ADDRESS OF OLD HIMEM..
		SEC
		SBC	PAGES	 
		STA	HIMEM+1	 	;Now set HIMEM to HIMEM-PAGES 
		CLC
		ADC	#4
		STA	SYSBUFADR
		RTS				;ALL DONE.
*
GSBERR	SEC				;INDICATE ERROR.
		RTS
	SPACE
	TITLE 'FREE SYSTEM BUFFER'
************************ FRESYSBUF ************************
* FRESYSBUF gives buffer SPACE back to Applesoft. The     *
*   address (high byte) of the buffer should be sent in   * 
*   SYSBUFADR and must be the address of a SYSTEM buffer. * 
***********************************************************
FRESYSBUF	JSR	COLLECT	 	;FIRST PACK APPLESOFT'S STRINGS.
		BCS	FSBERR	 	;BRANCH SHOULD NEVER BE TAKEN.
		LDA	HIMEM+1		 ;PREPARE TO MOVE STRINGS UP 1K.
		SBC	#0	 		;(CARRY CLEAR, SUBTRACT 1)
		STA	FROM+1
		ADC	#3	 		;(CARRY SET, ADD 4)
		STA	TO+1
		LDA	STRBOT
		STA	FROM
		STA	TO
		LDA	HIMEM	 		;SHOULD ALWAYS BE ZERO!
		SEC
		SBC	STRBOT
		STA	CNTLO	 		;CALCULATE HOW MANY BYTES TO BE MOVED.
		LDA	HIMEM+1
		SBC	STRBOT+1
		STA	CNTHI
		JSR	MOVUP	 		;GO MOVE STRINGS...
		LDA	#4	 		;NOW ADJUST STRING VARIABLE POINTERS
		STA	STROFF	 	; TO NEW ADDRESSES.
		CLC				;ALSO	 ADJUST HIMEM.
		ADC	HIMEM+1
		STA	HIMEM+1
		JSR	ADJSTRGS	 	;UPDATE VARIABLE POINTERS.
		LDA	SYSBUFADR	 	;IS BUFFER JUST FREED AT HIMEM?
		CMP	HIMEM+1	 	;IF SO, THEN ALL DONE...
		BEQ	FSBDONE	 	;BRANCH IF DONE.
		PHA				;SAVE	 OLD BUF ADDR FOR NOW.
		LDX	OPENCNT	 	;WE MUST SHUFFLE OTHER BUFFERS TO FREE 1K ABOVE HIMEM.
		BEQ	FSBERRO	 	;SYSTEM DEATH IF NO OTHER BUFFERS!
		LDA	HIMEM+1	 	;FIND BUFFER THATS SITTING AT HIMEM.
FNDLOBUF	CMP	BUFADRS-1,X	 
		BEQ	SWAPBUFS	 	;BRANCH IF FOUND.
		DEX
		BNE	FNDLOBUF		 ;(HOPEFULLY BRANCH ALWAYS!)
*
FSBERRO	PLA				;CLEAN up buf adr from stack
		SEC				;SHOW	 error
FSBERR	RTS				;OUT	 OF MEMORY IF ERROR ENCOUNTERED.
*
SWAPBUFS	PLA				;GET	 FREED BUFFER ADDRESS AGAIN.
GOSBUF	STA	SBUFADR+1	 	;PREPARE MLI CALL 'SETBUF'
		STA	BUFADRS-1,X	 	;UPDATE FILE BUFFER ADDRESS LIST.
		LDA	#0
		STA	SBUFADR
		LDA	REFNUMS-1,X	 	;GET REFNUM FOR BUFFER (AT HIMEM).
		STA	SBUFREF
		LDA	#SBUFCMD
		JSR	GOSYSTEM	 	;(INDIRECT CALL TO MLI)
		BCS	FSBERR	 	;NO ERRORS TOLERABLE!!!
FSBDONE	CLC
		RTS				;ALL DONE FREEING BUFFERS AND SUCH.
	SPACE
	TITLE 'GETPAGES'
************************** GETPAGES *****************************
* GETPAGES allows the creation of a buffer N-pages in size.     *
*  On entry, the number of pages required is in the Accumulator.*
*  It returns the starting page # in the Accumulator.           *
*****************************************************************
		EXPORT GETPAGES
GETPAGES
		JSR	GETSYSMEM	 	;Get a buffer, the Acc=# pages
		BCS	GETPGBK	 	;The Acc will have the Error code
		PHA
		SBC	#3
		STA	OLDHIMEM+1
		PLA
GETPG2	STA	SBUFADR+1
		LDX	OPENCNT	 	;How many files are open?
		BEQ	MVEXEC		 ;None.
		LDA	OLDHIMEM	 	;Get old HIMEM
		CLC
		ADC	#4	 		;  move up 4 pages to next lowest 
		STA	OLDHIMEM	 	;  file buffer
GETPG3	CMP	BUFADRS-1,X	 	;Is that where the file is? 
		BNE	GETPG1
		LDA	SBUFADR+1	 	;Yes,
		JSR	JUGBUF	 	;  juggle the buffers and 
		JSR	GOSBUF	 	;  move it to new location 
		LDA	SBUFADR+1
		ADC	#4
		BCC	GETPG2
GETPG1	DEX
		BNE	GETPG3
MVEXEC	LDA	SBUFADR+1
		BIT	EXACTV	 	;Is there an EXEC file active
		BPL	GOTPAGES	 
MOVEXEC	LDX	#8
		JSR	JUGBUF
		JSR	GOSBUF
		LDA	SBUFADR+1	 	;Get location of new system buffer 
		ADC	#4	 		;Add 4 to get location of requested buffer 
GOTPAGES	CLC
GETPGBK	RTS
	SPACE
	TITLE 'FREPAGES'
********************** FREPAGES *************************
* FREPAGES frees up all the pages claimed by GETPAGES and
*   restores the buffers as they originally were.
*********************************************************
		EXPORT FREPAGES
FREPAGES
		LDA	OPENCNT	 	;How many files are open?
		ASL	A
		ASL	A	 		;Times 4 = # pages of file buffers
		ADC	HIMEM+1
		STA	OLDHIMEM	 	;EXEC & claimed pages live above here 
		LDA	HIMEM+1
		STA	OLDHIMEM+1	 	;Save the value of HIMEM+1
		LDA	RSHIMEM	 	;HIMEM at Boot time
		CMP	HIMEM+1
		BEQ	ALLFREE
		STA	HIMEM+1
		BIT	EXACTV	 	;Is there an EXEC file active?
		BPL	FREPG0	 
		JSR	MOVEXEC	 	;Yes, so move it, mister! 
		BCC	FREPG2
FREPG0	LDA	OLDHIMEM
FREPG1	LDX	OPENCNT	 	;# open files
		BEQ	FREGARB
FREPG3	CMP	BUFADRS-1,X
		BNE	FREPG5
		LDA	HIMEM+1
		JSR	JUGBUF
		JSR	GOSBUF
		SEC
		LDA	OLDHIMEM
		SBC	#4
		STA	OLDHIMEM
FREPG2	LDA	HIMEM+1
		SEC
		SBC	#4
		STA	HIMEM+1
		BCS	FREPG0	 
FREPG5	DEX
		BNE	FREPG3
FREGARB	JSR	COLLECT	 	;Go garbage collect if needed
ALLFREE	CLC
		RTS
JUGBUF	PHA
		LDA	OLDHIMEM+1
		JSR	GOSBUF
		PLA
		RTS
	SPACE
	TITLE 'MOVDOWN'
********************** MOVDOWN ********************************** 
* MOVDOWN moves CNT(HI&LO) bytes from FROM to TO.  Since ranges *
*  may overlap, the lowest byte is moved first, followed by     *
*  the next lowest, etc.                                        *
*****************************************************************
MOVDOWN	LDY	#0
		CPY	CNTHI	 		;IS THIS MOVE LESS THAN ONE PAGE?
		BEQ	MVDWN2	 	;BRANCH IF IT IS.
MVDWN1	LDA	(FROM),Y
		STA	(TO),Y
		INY
		BNE	MVDWN1	 	;LOOP FOR 1 PAGE.
		INC	FROM+1
		INC	TO+1
		DEC	CNTHI
		BNE	MVDWN1	 	;BRANCH IF MORE PAGES TO MOVE.
MVDWN2	CPY	CNTLO	 		;HAVE ALL BYTES BEEN MOVED?
		BEQ	MVDWN3	 	;BRANCH IF DONE.
		LDA	(FROM),Y
		STA	(TO),Y
		INY
		BNE	MVDWN2		;BRANCH ALWAYS TAKEN.
MVDWN3	RTS				;DOES	 ANYONE EVER READ THESE COMMENTS???
	SPACE
	TITLE 'MOVUP'
************************* MOVUP *******************************
*  MOVUP moves CNT(HI&LO) bytes up in memory starting with    *
*    the highest Byte(-1), then next highest, etc., to avoid  *
*    overlap problems.  FROM and TO are initially the highest * 
*    pages of the range.                                      *
***************************************************************
MOVUP		LDY	CNTLO	 		;MOVE PARTIAL PAGE FIRST
CSCMD	BEQ	MVUP2	 			;BRANCH IF NO PARTIAL PAGES
MVUP1		JSR	MOVUP1	 	;(RETURNS Y=0) 
		DEC	TO+1
		DEC	FROM+1
MVUP2		CPY	CNTHI
		BEQ	MVUP3
		DEC	CNTHI
		JMP	MVUP1	 		;Do next page
*
MOVUP1	DEY
		LDA	(FROM),Y
		STA	(TO),Y
		TYA				;DONE	 WITH THIS PAGE?
		BNE	MOVUP1
MVUP3		RTS
	SPACE
	TITLE 'ADJUST STRINGS'
******************** ADJSTRGS ***********************************
* ADJSTRGS adjusts the String Variables pointers by adding
*   STROFF(*$100) to the original values.  If strings are to be
*   adjusted down, say -1K, STROFF should be $100-(4) pages,
*   i.e. $FC.
*****************************************************************
ADJSTRGS	LDA	SIMPTR+1		;SET WORKING POINTER TO VARIABLE TABLE.
		STA	VPTR+1
		LDA	SIMPTR
		LDX	ARRPTR+1		;USE X TO TEST FOR END OF SIMPLE VARS.
		CLC
		BCC	ADJSIMP1		;BRANCH ALWAYS
  	SPACE
****************************************************************** 
* ADJUST SIMPLE STRING POINTERS.
****************************************************************** 
	SPACE
ADJSIMPLE	CLC				;ADD	 7 TO POINT TO NEXT VARIABLE NAME.
		LDA	VPTR
		ADC	#7
ADJSIMP1	STA	VPTR	 		;SAVE NEW POINTER.
		BCC	ADJSIMP2	 	;BRANCH IF HI POINTER ADDRESS OK.
		INC	VPTR+1
ADJSIMP2	EOR	ARRPTR	 	;TEST FOR END OF SIMPLE VARIABLES.
		BNE	ADJSIMP3	 	;BRANCH IF MORE SIMPLES.
		CPX	VPTR+1	 	;TEST HI ADDR TOO.
ADJSIMP3	CLC
		BEQ	ADJARRAY	 	;BRANCH IF DONE WITH SIMPLES.
		LDY	#0
		LDA	(VPTR),Y	 	;TEST FOR STRING VARIABLE TYPE.
		INY
		EOR	(VPTR),Y	 	;RESULT SHOULD BE MINUS IF STRING.
		BPL	ADJSIMPLE	 	;BRANCH IF NOT STRING TYPE.
		LDA	(VPTR),Y
		BPL	ADJSIMPLE	 	;Branch if USER DEF
		INY				;INDEX	 TO STRING LENGTH
		JSR	ADJSTR	 	;ADD IN OFFSET.
		JMP	ADJSIMPLE	 	;DO NEXT SIMPLE.
*
ADJARRAY	LDA	VPTR
		STA	END_LOW	 	;PREPARE TO DO ARRAYS...
ADJARR1	CLC
		JSR	CALCARR	 	;SET UP PTRS TO NEXT STRING ARRAY.
		BCS	ADJSTR1	 	;BRANCH IF ALL DONE FIXIN' STRINGS
ADJARR2	LDY	#0	 		;OTHERWISE, DO THIS ARRAY.
		CLC
		JSR	ADJSTR
		CLC
		LDA	#3	 		;BUMP TO NEXT ARRAY ELEMENT.
		ADC	VPTR
		STA	VPTR
		BCC	ADJARR3	 	;BRANCH IF HIGH ADDRESS OK.
		INC	VPTR+1
ADJARR3	CMP	END_LOW	 	;DONE WITH THIS ARRAY?
		BNE	ADJARR2	 	;BRANCH IF NOT.
		CPX	VPTR+1	 	;TEST HI PTR JUST TO BE SURE.
		BNE	ADJARR2
		BEQ	ADJARR1		 ;BRANCH ALWAYS TO DO NEXT ARRAY.
*
ADJSTR	LDA	(VPTR),Y		 ;TEST STRING LENGTH
		BEQ	ADJSTR1		 ;BRANCH IF NUL STRING.
		INY
		INY
		LDA	SIMPTR+1
		CMP	(VPTR),Y	 	;DON'T ADJUST VARIABLES IN PROGRAM!!
		BCS	ADJSTR1
		LDA	(VPTR),Y	 	;ADJUST HIGH ADDRESS ONLY.
		ADC	STROFF
		STA	(VPTR),Y	 	;SAVE UPDATED.
ADJSTR1	RTS
	SPACE
	TITLE	'Variable (Un)Packing'
************************ Variable (Un)Packing ***************************
* VARPACKER crunches all AppleSoft Variables into one handy
*   package which may be written (as in STORE) to disk or just
*   to allow maximum memory for programs to be READ (as in CHAIN).
*
* The file should include:
*   OVLEN  - Original length of variable table
*   OASTRT - Offset to where Array variables should start
*   OHIMEM - Original HIMEM 
*
* PACKADR should become AUXID and PACKLEN(+5) should become
*   end mark for the file (EOF).
**************************************************************************
VARPACKER	EQU	*
		JSR	COLLALL	 	;GARBAGE COLLECT ALL STRINGS
		BCS	VPRERR	 	;REPORT MEMFULL ERROR.
		LDA	ENDVAR	 	;CALCULATE AND SAVE LENGTH OF VARIABLE TABLE.
		SEC
		SBC	SIMPTR
		STA	OVLEN
		STA	CNTLO
		LDA	ENDVAR+1
		SBC	SIMPTR+1
		STA	OVLEN+1
		STA	CNTHI	 		;ALSO USED AS MOVE COUNT FOR PACKING.
		LDA	ARRPTR	 	;NOW CALCULATE AND SAVE RELATIVE ADDR
		SBC	SIMPTR	 	; OF ARRAY VARIABLES.
		STA	OASTRT
		LDA	ARRPTR+1
		SBC	SIMPTR+1
		STA	OASTRT+1
		LDA	STRBOT	 	;NOW PREPARE TO MOVE VARIABLE
		SBC	CNTLO	 		; TABLE UP TO BOTTOM OF STRINGS.
		STA	TO
		LDA	STRBOT+1
		SBC	#0	 		;(SUBTRACT 1 IF CARRY CLEAR)
		STA	TO+1
		LDA	ENDVAR
		SBC	CNTLO
		STA	FROM
		LDA	ENDVAR+1
		SBC	#0
		STA	FROM+1
	SPACE
	TITLE 'CHAIN/STORE PATCH ENTRY'
************************** CHAIN/STORE FIX BEGIN ******************************
		LDA	#03	 			;Load proper variable
		STA	CSCMD+1			;store it here before chain call
		JSR	MOVUP	 			;go crunch memory
		LDA	#07	 			;Reset variable     
		STA	CSCMD+1	 		;store it here after chain call
************************** CHAIN/STORE FIX END ********************************
		LDA	TO	 		;NOW SAVE BEG. ADDR. OF PACKED VARIABLES.
		STA	PACKADR
		INC	TO+1	 		;MOVUP returns at least 1 page+ moved
		LDA	TO+1
		STA	PACKADR+1
		LDA	HIMEM	 		;AND CALCULATE TOTAL PACKED LENGTH. 
		SEC
		SBC	TO
		STA	PACKLEN
		LDA	HIMEM+1	 	;ALSO PRESERVE ORIGINAL HIMEM ADDRESS.
		STA	OHIMEM
		SBC	TO+1
		STA	PACKLEN+1
		CLC				;INDICATE NO ERROR. 
VPRERR	RTS				;ALL DONE...
	SPACE
	TITLE 'VARUNPACK'
********************** VARUNPACK ******************************
* VARUNPACK unpacks crunched variable packets, overwriting	  *
*   previous values of ARRPTR and ENDVAR.  Also adjusts for   *
*   variations in HIMEM from when it was originally packed.   *
*   May be used immediately after VARPACKER (for CHAIN) or    *
*   after a STORE file is READ into the top of memory (as     *
*   in RESTORE).								  *
* OVLEN, OASTRT, OHIMEM, PACKLEN, and PACKADR must be set up  *
*   before calling. 							  *
***************************************************************
VARUNPACK	EQU	*
		LDA	OVLEN	 		;PREPARE TO MOVE VARIABLE TABLES
		STA	CNTLO	 		;DOWN TO WHERE APPLESOFT
		CLC				;EXPECTS THEM TO BE (SIMPTR).
		ADC	SIMPTR	 	;FIRST CALCULATE WHERE THE END
		STA	ENDVAR	 	;OF THE VARIABLE TABLE WILL BE.
		LDA	OVLEN+1
		STA	CNTHI
		ADC	SIMPTR+1	 	;ADD TABLE LENGTH TO VAR.PTR (LOMEM).
		STA	ENDVAR+1
		LDA	SIMPTR
		STA	TO
		ADC	OASTRT	 	;NOW FIGURE WHERE ARRAYS START.
		STA	ARRPTR
		LDA	SIMPTR+1
		STA	TO+1
		ADC	OASTRT+1
		STA	ARRPTR+1
		LDA	PACKADR	 	;LASTLY SET UP POINTER TO
		STA	FROM	 		; WHERE THE TABLE IS NOW.
		LDA	PACKADR+1
		STA	FROM+1
		JSR	MOVDOWN	 	;GO MOVE TABLES TO PROPER PLACE.
		LDA	CNTLO	 
		CLC
		ADC	FROM	 		;SET STRING BOTTOM FOR THESE STRINGS.
		STA	STRBOT
		LDA	FROM+1
		ADC	#0	 		;(ADDS CARRY)
		STA	STRBOT+1	 
		SEC
		LDA	HIMEM+1	 	;DO STRING POINTERS NEED ADJUSTMENT? 
		SBC	OHIMEM
		BEQ	VUPDONE	 	;BRANCH IF NOT.
		STA	STROFF
		JSR	ADJSTRGS	 	;FIX POINTERS TO STRINGS.
VUPDONE	CLC
		RTS				;VARIABLES	 ALL UNPACKED...
*

	TITLE	'Catalog Entry Syntaxing'
********************* Catalog Entry *************************
* Translate internal directory format to ASCII.  Used for	*
*   CAT, CATALOG and READ (when READing a directory from	*
*   a BASIC program).							*
*										*
* Expected input is a valid directory entry in the CATBUF.  *
*   Translates into the 80-column format.				*
*************************************************************
   SPACE 
CATASC	JSR	SPACAT	 	;FILL INBUF1 WITH 80    SPACE S 
		LDA	#$A2	 		;PLACE A LEADING QUOTE (") IN CASE
		STA	INBUF1-1	 	; THIS IS INPUT STRING TO APPLESOFT.
		LDA	CATBUF	 	;NOW GET THE LENGTH OF THE FILE NAME.
		AND	#$F	 		;STRIP FILE KIND.
		TAY
CATFNAM	LDA	CATBUF,Y	 	;MOVE FILE NAME TO POSITION 1-15 OF INBUF1.
		ORA	#$80	 		;MSB ON FOR APPLE II.
		STA	INBUF1,Y	 
		DEY
		BNE	CATFNAM
		STY	ACCH	 		;CLR TO INSURE GOOD HEX TO DECIMAL CONVERSIONS.
		LDA	CATBUF+$10	 	;TRANSLATE FILE TYPE TO ASCII
		LDX	#TYPNUM-1	 	;# RECOGNIZED TYPES -1 (0 IS OK) 
CTYP		INY
		INY
		CMP	RTYP,X	 	;LOOKUP FILE TYPES WITH ASCII NAMES
		BEQ	CTYP1	 		;BRANCH IF FOUND.
		INY
		DEX
		BPL	CTYP

		LDY	#$13	 		;INSTEAD OF MNUMONIC, OUTPUT HEX VALUE.
		JSR	HEXASC
		BNE	CEOF	 		;BRANCH ALWAYS TAKEN
	
CTYP1		LDX	#2	 		;MOVE FILE TYPE MNUMONIC TO TYPE FIELD. 
		PHA				;SAVE	 TYPE FOR LATER TEST.
CTYP2		LDA	ASCTYP,Y
		STA	INBUF1+$11,X
		DEY
		DEX
		BPL	CTYP2
		PLA				;GET	 TYPE AGAIN.
		BIT	STRLEN	 	;40 OR 80 COLUMN FORMAT?
		BVC	CBLKS	 		;BRANCH IF 40 COLUMN, ELSE FILL IN ALL 80.
		LDY	#$4E
		CMP	#6	 		;IS IT A BINARY FILE?
		BEQ	CATADDR	 	;BRANCH IF YES.
		CMP	#4	 		;IS IT A TEXT FILE?
		BNE	CEOF	 		;BRANCH IF NOT.
		LDA	#$D2	 		;SPECIFY "R" FOR RECORD LENGTH.
		STA	INBUF1+$48	 
		LDA	CATBUF+$1F	 	;TRANSLATE AUXID TO ASCII DECIMAL.
		LDX	CATBUF+$20
		JSR	HEXDEC
		JMP	CAXID2
	SPACE
CATADDR	LDA	#$C1	 		;SPECIFY "A" FOR ADDRESS.
		STA	INBUF1+$48	 
		LDA	CATBUF+$1F
		JSR	HEXASC
		LDA	CATBUF+$20
		JSR	HEXASC
	SPACE
CAXID2	LDA	#$BD	 		;PLACE "=" BEFORE VALUE
		STA	INBUF1+$49	 
CEOF		LDA	CATBUF+$17
		STA	ACCH	 		;CONVERT END OF FILE TO ASCII.
		LDA	CATBUF+$15
		LDX	CATBUF+$16
		LDY	#$46
		JSR	HEXDEC
	SPACE
		LDX	#$18	 		;DO CREATION DATE.
		LDY	#$3D
		JSR	DODATE
	SPACE
CBLKS		LDY	#$1B	 		;CONVERT BLOCK COUNT TO DECIMAL ASCII.
		LDA	CATBUF+$13
		LDX	CATBUF+$14
		JSR	HEXDEC
	SPACE
		LDA	CATBUF+$1E	 	;FETCH ATTRIBUTES
		AND	#$C2	 		;IF ANY OF THESE BITS (DESTROY,
		CMP	#$C2	 		; WRITE OR RENAME) ARE NOT ENABLED,
		BEQ	CDATES	 	; THEN MARK NAME WITH "*", OTHERWISE BRANCH.
		LDA	#$AA
		STA	INBUF1
CDATES	LDX	#$21	 		;LASTLY, DO MODIFICATION DATE AND TIME. 
		LDY	#$2C	 
* DROP INTO DODATE. 
*
DODATE	LDA	CATBUF+1,X	 	;CONVERT DATE AND TIME INTERNAL FORMAT
		LSR	A
		STA	YEAR	 		; TO HUMAN READABLE FORM...
		LDA	CATBUF,X	 	;MONTH/DAY
		PHA
		AND	#$1F
		STA	DAY
		PLA
		ROL	A	 		;COMBINE MONTH INTO ONE BYTE.
		ROL	A
		ROL	A
		ROL	A
		AND	#$F
		BEQ	NODATE	 	;BRANCH IF ILLEGAL DATE.
		CMP	#$D
		BCS	NODATE
		STA	MONTH
		ASL	A	 		;MONTH*3 INDEXES TABLE.
		ADC	MONTH
		STA	MONTH	 		;SAVE IT FOR NOW.
*
		LDA	DAY	 		;MAKE SURE DAY IS VALID.
		BEQ	NODATE
		LDA	YEAR	 		;MAKE SURE YEAR IS VALID.
		CMP	#$64	 		; CANNOT BE > 99
		BCC	DODATE1	 	;BRANCH IF GOOD.
*
NODATE	TYA				;PLACE "<NO DATE>" IN DATE FIELD
		SEC
		SBC	#6
		TAY
		LDX	#8	 
NODATE1	LDA	ASCNODT,X
		STA	INBUF1,Y	 	;
		DEY
		DEX
		BPL	NODATE1
		RTS				;ALL	 DONE WITH NOTHING...
	SPACE

DODATE1	LDA	CATBUF+3,X	 	;GET HOUR
		PHA	;SAVE	 IT.
		LDA	CATBUF+2,X	 	;GET MINUTE.
		LDX	#0	 		;CONVERT IT TO DECIMAL.
		CMP	#$3C	 		;MUST BE < 60
		BCC	DOMINIT
		TXA
DOMINIT	JSR	TWODIG	 	; MUST BE 2 DIGITS.
		LDA	#$BA			;SEPARATE WITH ":"
		STA	INBUF1,Y
		DEY
		PLA
		LDX	#0
		CMP	#$18	 		;HOUR MUST BE < 24.
		BCC	DOHOUR
		TXA
DOHOUR	CMP	#$A	 		;TEST FOR SINGLE DIGIT. 
		PHP
		JSR	HEXDEC
		PLP				;IF SINGLE DIGIT, DEC POSITION OF TEXT POINTER (Y).
		BCS	DOYEAR
		DEY
DOYEAR	DEY
		LDA	YEAR	 		;CONVERT YEAR TO DECIMAL.
		JSR	TWODIG
		DEY
		LDX	MONTH
		INX
		INX
		INX
DOMONTH	LDA	ASCMON-4,X		;MOVE MONTH MNUMONIC.
		STA	INBUF1,Y
		DEY
		DEX
		CPX	MONTH
		BNE	DOMONTH
*
		LDA	#$AD	 		;PLACE "-" BETWEEN DAY-MONTH-YEAR.
		STA	INBUF1,Y
		STA	INBUF1+4,Y
		DEY
		LDA	DAY	 		;LASTLY, DO DAY OF MONTH.
		LDX	#0
		JMP	HEXDEC
*
*
TWODIG	CLC				;TO	 MAKE SURE IT'S 2 DIGITS... 
		ADC	#$64	 		;ADD 100, THEN STRIP THE HUNDREDS COLUMN. 
		JSR	HEXDEC
		INY
		RTS
	SPACE
HEXASC	PHA				;CONVERT	 HEX VALUE IN ACC INTO HEX-ASCII.
		AND	#$F	 		; AND PLACE IT INTO INBUF1 AT Y AND Y-1.
		JSR	HEXASC1
		PLA				;DO	 HIGH NIBBLE TOO.
		LSR	A
		LSR	A
		LSR	A
		LSR	A
*
HEXASC1	ORA	#$B0	 		;ADD IN ASCII "0".
		CMP	#$BA	 		;IS IT A-F RANGE?
		BCC	HEXASC2	 	;BRANCH IF NOT.
		ADC	#6	 		;IF SO, MAKE IT THAT RANGE.
HEXASC2	STA	INBUF1,Y
		DEY
		LDA	#$A4
		STA	INBUF1,Y	 	;ALWAYS PLACE A "$" IN FRONT OF LAST VALUE.
		RTS
*
HEXDEC	STX	ACCM	 		;THIS ENTRY FOR 16 BIT CONVERSIONS
		STA	ACCL
HEXDEC1	JSR	DIVID10	 	;DIVIDE BY 10 AND CONVERT TO MODOULO TO ASCII.
		LDA	MODO
		ORA	#$B0	 		;MAKE IT ASCII 0-9
		STA	INBUF1,Y
		DEY
		LDA	ACCL
		ORA	ACCM	 		;TEST FOR ZERO.
		ORA	ACCH
		BNE	HEXDEC1	 	;BRANCH ALWAYS. 
HEXDEC2	RTS
*
DIVID10	LDX	#$18	 		;FOR 24 BITS.
		LDA	#0	 		;ZERO OUT MODOULO.
		STA	MODO
DIV1		JSR	SHFT24	 
		ROL	MODO
		SEC
		LDA	MODO
		SBC	#$A
		BCC	DIV2
		STA	MODO
		INC	ACCL
DIV2		DEX				;MORE	 BITS?
		BNE	DIV1
		RTS
*
SPACAT	LDA	#$A0	 		;(ALL CHARS HAVE HI BIT SET)
		LDX	#$4F
CATSPC	STA	INBUF1,X	 	;FILL TEXT BUFFER WITH    SPACE S.
		DEX
		BPL	CATSPC
		RTS
	SPACE
	Title 'Command Syntaxing'
***********'Command Syntaxing'*************************************

		EXPORT SYNTAX
SYNTAX	LDA	#$FF	 		;MAKE COMMAND NUMBER INVALID.
		STA	XCNUM
		LDA	#$20	 		;ALLOW LEADING    SPACE S BEFORE COMMAND.
		STA	SKPCHR
		LDA	#$8	 		;LONGEST COMMAND IS 8 CHARACTERS.
		STA	TCNT
		JSR	SCANNER	 	;GRAB FIRST 8 CHARACTERS.
		LDA	TXBUF	 		;TEST FOR ALPHA FIRST CHARACTER.
		CMP	#$41	 		;IS IT AT LEAST "A"?
		BCS	SYNTX1	 	;BRANCH IF IT IS.
		EOR	#$2D	 		;PERHAPS IT'S THE "-" COMMAND.
		BEQ	SYNTX1
SSNERR	JMP	SYNERR1	 	;CONSIDERED BY XDOS AS SYNTAX ERROR IF NOT.
   SPACE 
SYNTX1	JSR	SRCHCMD1	 	;GO LOOK FOR MTR COMMAND 1ST.
		BCS	SSNERR	 	;BRANCH IF IT WASN'T 
		LDA	STATE
		BNE	SYNTX1A	 	;NO CR IF IMMEDIATE MODE.
		LDA	EXACTV
		BNE	SYNTX1A	 	;OR IF FROM EXEC FILE
		JSR	CLEOL
		JSR	CROUT
SYNTX1A	LDA	#0	 		;BUT FIRST, CLEAR 'FOUND PARAMETERS' BYTES.
		STA	FBITS
		STA	FBITS+1
		STA	TXBUF	 		;MAKE FN1 INVALID UNTIL FOUND. 
		STA	TXBUF2
		LDA	DEFSLT	 	;SET UP DEFAULT SLOT AND DRIVE VALUES.
		STA	VSLOT
		LDA	DEFDRV
		STA	VDRIV	 
		LDA	HIMEM+1	 	;ALSO SET DEFAULT SYSTEM BUFFER
		STA	SYSBUFADR
   SPACE 
		LDX	XLEN	 		;NOW SET UP TO SCAN PAST COMMAND.
		INX
		INX
		STX	TCNT
		LDA	PBITS	 		;ANYTHING TO PROCESS?
		BEQ	GCXCUTE	 	;BRANCH IF NOT.
		ASL	A	 		;PROCESS PR# OR IN#?
		BMI	IOSYN	 		;BRANCH IF I/O CMD.
   SPACE 
		JSR	SCANNER	 	;SCAN TO CHARACTER FOLLOWING COMMAND.
		PHP				;SAVE	 RESULT
		PHA
		LDA	PBITS	 		;SHOULD PREFIX BE READ?
		BPL	SYNTX2	 	;BRANCH IF PREFIX NOT NEEDED
		LDA	#GPREFX	 	;GET PREFIX INTO 'TXBUF'
		JSR	GOSYSTEM	 	;NO ERRORS EXPECTED.
SYNTX2	PLA
		PLP
		BEQ	GCXCUTE	 	;BRANCH IF NO PARAMETERS GIVEN.
		CMP	#$2C	 		;WAS A COMMA FOLLOWING COMMAND?
		BNE	SYNTX3	 	;BRANCH FILE NAME POSIBLE. 
		JMP	NOFNAME
   SPACE 
SYNTX3	CMP	#$2F	 		;MUST BE "/" OR ALPHA.
		BEQ	SYNTX4
		CMP	#$41
		BCC	XCUTRUN	 	;SYNTAX ERROR IF not RUN
SYNTX4	DEX				;BACK	 UP ONE IN THE SCAN LINE.
		LDA	#$82	 		;DISABLE 'SKPCHR' (WITH HIGH BIT ON).
		STA	SKPCHR
		LSR	A	 		;MAXIMUM LENGTH OF FILE NAME IS $40+1 FOR TERMINATOR. 
		STA	TCNT
		LDY	#0
		JSR	SCANNXT	 	;MOVE FILENAME TO TEXT BUFFER.
		DEY				;DO NOT INCLUDE TERMINATOR IN FILE NAME LENGTH.
		STY	TXBUF-1	 	;SAVE FILE NAME LENGTH 
		LDA	#FN1	 		;INDICATE THAT A FILE NAME IS GIVEN.
		STA	FBITS
*
*  Now, since Y = length, copy file name as given to second main buffer
*
MVOPNAM	LDA	TXBUF-1,Y	 	; for OPEN, READ, WRITE, CLOSE, and FLUSH.
		STA	TXBUF2,Y
		DEY
		BPL	MVOPNAM
		DEX				;BACK	 UP IN SCAN LINE TO TERMINATOR OF FILENAME.
		JSR	SCANCOM	 	;ONLY COMMA OR CR IS VALID AT THIS POINT.
		BNE	SYNERR	 	;BRANCH IF OTHERWISE.
		BCC	CXCUTE	 	;EXECUTE COMMAND IF CR.
		LDA	PBITS	 		;TEST FOR FN2 (FOR RENAME).
		LSR	A	 		;MAKE SURE FN1 WAS EXPECTED.
		BCS	DOFN2	 		;BRANCH IF IT WAS EXPECTED.
   SPACE
SYNERR	JMP	SYNERR1	 	;REPORT SYNTAX ERROR.
*
XCUTRUN	LDA	XCNUM	 		;Get Command #
		CMP	#CIRUN	 	;Is it RUN?
		BNE	SYNERR	 	;Nope, don't do it, Bozo.
GCXCUTE	JMP	CXCUTE	 	;BRANCH EXTENDER... 
   SPACE
IOSYN		JSR	SCANNER	 	;GET NEXT CHARACTER.
		BEQ	SYNERR	 	;REPORT SYNTAX ERROR IF NO NEXT CHARACTER.
		CMP	#$41
		BEQ	IOADDR	 	;BRANCH IF IT'S AN ADDRESS
		JSR	ZIPACC	 	;CLEAR NUMERIC ACCUMULATOR (A-REG PRESERVED). 
		STY	PBYTES	 	;(Y=0) INDICATE 1 BYTE MAX, I.E. 0-255 
		LDY	#PIOSLT	 	;TELL 'PROCDEC' WHERE TO PLACE RESULT. 
		STY	PCADR
		LDY	#SLOT
		STY	FBITS
		JSR	PROCDEC	 	;PROCESS DECIMAL NUMBER.
		BCS	ANYERR	 	;RETURN ANY ERRORS IMMEDIATELY.
		LDA	VIOSLT	 	;MAKE SURE IT'S IN THE RANGE OF 0-7
		CMP	#$8
		BCC	IOPARM	 	;BRANCH IF GOOD SLOT#..
   SPACE
RANGERR	LDA	#ERRANGE
		SEC
ANYERR	RTS
	SPACE
DOFN2		LSR	A	 		;ARE THERE TWO FILE NAMES?
		BCC	NOFNAME	 	;BRANCH IF NOT.
		JSR	SCANCOM	 	;SKIP    SPACE S AFTER COMMA, IF ANY.
		BEQ	SYNERR	 	;BRANCH IF NO FN2.
		DEX
		LDA	#$82	 		;PREPARE TO MOVE FN2 TO TEXT BUF+$41
		STA	SKPCHR		;STOP	 SCAN IF    SPACE  ENCOUNTERED.
		LDY	#$01	 
		JSR	SCANFN2	 	;GO MOVE FILENAME 2.
		DEY
		DEY
		STY	TXBUF2
		LDA	#FN1+FN2	 	;UPDATE 'FOUND' BITS TO REFLECT BOTH NAMES FOUND.
		STA	FBITS
		DEX				;BACK	 UP SCAN TO TERMINATOR.
		JSR	SCANCOM	 	;MUST BE A COMMA OR CR.
		BNE	SYNERR
		BCC	CXCUTE	 	;EXECUTE COMMAND IF CR.
   SPACE
NOFNAME	JSR	SCANCOM	 	;GET NEXT PARM.
		BEQ	SYNERR	 	;BRANCH IF NO PARM.
IOADDR	JSR	PROCPARM	 	;GO PROCESS PARAMETER.
		BCS	ANYERR	 	;BRANCH IF ERROR ENCOUNTERED.
IOPARM	JSR	SCANCOM	 	;EXPECT TERMINATOR (',' OR CR)
		BNE	SYNERR	 	;BRANCH IF NOT PROPERLY TERMINATED PARAMETER.
		BCS	NOFNAME	 	;BRANCH IF MORE PARAMETERS EXPECTED.
   SPACE 
CXCUTE	LDA	VSLOT	 		;VALIDATE SLOT AND DRIVE PARAMETERS.
		BEQ	RANGERR	 	;SLOT MUST BE >0 AND <8.
		CMP	#8
		BCS	RANGERR
		LDA	VDRIV	 		;DRIVE MUST BE 1 OR 2.
		BEQ	RANGERR
		CMP	#3
		BCS	RANGERR
		LDA	PBITS	 		;TEST RUNFLG AND FILE NAME REQUIREMENTS
		AND	#RRUN+FN1
		LSR	A	 		;SHIFT FILE NAME REQUIRED TO CARRY
		BEQ	CXCUTE00	 	;BRANCH IF NOT RUN-ONLY CMD.
		LDA	RUNFLG	 	;IS PROGRAM RUNNING?
		BNE	CXCUTE00	 	;BRANCH IF SO.
		LDA	#NOTRUN	 	;REPORT "NOT DIRECT COMMAND".
		SEC
		RTS
	SPACE
CXCUTE00	BCC	CXCUTE5	 	;BRANCH IF FILE NAME NOT NEEDED. 
		LDA	PBITS+1	 	;IF NO SLOT & DRIVE NEEDED, NO FILENAME OK.
		AND	#SD
		BEQ	CXCUTE5
		LDA	FBITS
		LSR	A	 		;SHIFT FN1 INTO CARRY
		BCS	CXCUTE1	 	;BRANCH IF PRESENT.
		LDA	PBITS	 		;(IF BIT 7=1, FN1 OPTIONAL).
		AND	#FNOPT+PFIX	 	;IS FILE NAME OPTIONAL?
		BEQ	SYNERR1	 	;BRANCH IF REQUIRED, BUT NOT PRESENT.
		BPL	CXCUTE5	 	;BRANCH NOT REQUIRED AT ALL. 
   SPACE 
CXCUTE1	LDA	TXBUF	 		;IS PATHNAME PARTIAL? 
		EOR	#$2F
		BEQ	CXCUTE2	 	;BRANCH IF FULL PATHNAME.
		LDA	GLBPFX	 	;IF PARTIAL, IS THERE A PREFIX SET?
		BEQ	CXCUTE4	 	;BRANCH IF DEVICE VOLUME NAME NEEDS LOOKUP.
   SPACE 
CXCUTE2	LDA	FBITS+1	 	;WAS SLOT AND/OR DRIVE SPECIFIED?
		AND	#SD
		BEQ	CXCUTE5	 	;BRANCH IF NOT.
		BCS	CXCUTE4	 	;BRANCH IF PATHNAME PRESENT.
		LDA	#0	 		;OTHERWISE, MAKE VOLUME NAME THE PATHNAME
		STA	TXBUF-1
		STA	TXBUF
		LDA	#FN1	 		;CALL IT FILENAME 1
		ORA	FBITS	 
		STA	FBITS
   SPACE 
CXCUTE4	JSR	VOLNAME	 	;DO ON-LINE AND FIX FILENAMES AS NEEDED.
		BCS	ANYERR1	 
   SPACE 
CXCUTE5	LDA	XCNUM	 
		ASL	A	 		;INDEX COMMAND ADDRESS TABLE
		TAX
		LDA	CMDEXEC,X	 	;GET COMMAND EXECUTION ADDRESS.
		STA	EXADR
		LDA	CMDEXEC+1,X
		STA	EXADR+1
		CLC				;ANTICIPATE	 NO 'GETINFO' REQUIRED.
		TXA				;(NOT	 CALLED FOR USER CMD).
		BEQ	CXCUTE6
		EOR	#CIPRFX+CIPRFX	;NOT FOR PREFIX COMMAND EITHER
		BEQ	CXCUTE6
	SPACE
		LDA	PBITS+1	 	;NO 'GETINFO' FOR CMDS WITHOUT S&D PARMS.
		AND	#SD
		BEQ	CXCUTE6
		LDA	FBITS	 		; OR CMDS WITHOUT FILENAMES.
		LSR	A
		BCC	CXCUTE6
   SPACE 
		JSR	GOGETINFO	 	;GET THE POOP ON THIS GUY...
		BCC	CXCUTE6	 	;BRANCH IF FOUND.
		CMP	#REALFNF	 	;IS IT REALLY FNF AND NOT PNF OR VNF?
		BNE	ANYERR1	 	;BRANCH IF OTHER THAN FNF ERROR.
		LDA	PBITS	 		;CHECK FOR CREATE FLAG.
		AND	#CRFLG
		BNE	CXCUTE6	 	;(PASS CARRY SET... BUT EXECUTE.)
		LDA	#CIFNFERR	 	;REPORT PATH NOT FOUND.
		RTS
   SPACE 
CXCUTE6	JMP	(EXADR)	 	;GO EXECUTE COMMAND JUST PARSED...
   SPACE 2
SYNERR1	LDA	#ERRSYN	 
ANYERR1	SEC
		RTS				;RETURN ERROR. 
	SPACE
	Title 'Volname'
	
****************** Volname **********************
* 'VOLNAME' GETS THE NAME OF THE VOLUME		*
* SPECIFIED BY S&D PARAMETERS.  IN THOSE		*
* CASES WHEN A PARTIAL PATHAME IS PRESENT		*
* THE VOLUME NAME IS INSERTED BEFORE THE		*
* PATHNAME TO FORM A COMPLETE PATH.			*
* BOTH FN1 AND FN2 ARE ADJUSTED AS NEEDED.	*
* ON EXIT: CARRY SET INDICATES ERROR, 		*
* WITH ERROR CODE IN ACC.				*
*************************************************
   SPACE 
VOLNAME	LDA	VSLOT	 		;FORM DEVICE NUMBER WITH SLOT/DRIVE PARMS.
		ASL	A
		ASL	A
		ASL	A
		ASL	A
		ASL	A
		PHA
		LDA	VDRIV	 		;DRIVE 1=00,DRIVE 2=80
		EOR	#1	 		;(DRIVE AND SLOT ASSUMED VALID)
		LSR	A	 		;SHIFT TO CARRY
		PLA
		ROR	A	 		;SHIFT TO BIT 7, SLOT IN BITS 4-6.
		STA	SUNITNUM	 	;PREPARE FOR 'ON-LINE' CALL.
		LDA	#<INBUF1
		STA	SDATPTR
		LDA	#>INBUF1
		STA	SDATPTR+1
		LDA	#ONLINCMD
		JSR	GOSYSTEM	 	;GET NAME OF SPECIFIED VOLUME.
		BCS	ANYERR1	 	;REPORT ANY ERRORS.
*
		LDA	VDRIV	 		;IF SUCCESSFUL, SAVE THIS DRIVE
		STA	DEFDRV	 	; AND SLOT AS THE DEFAULTS.
		LDA	VSLOT
		STA	DEFSLT
		LDA	TXBUF	 		;TEST FOR COMPLETE PATHNAME
		EOR	#$2F	 		; ALREADY PRESENT.
		BEQ	GOODVOL	 	;BRANCH IF IT IS.
	SPACE
* INSERT VOLUME NAME IN FRONT OF FN1
	SPACE
		LDA	INBUF1		;GET VOLUME NAME LENGTH.
		AND	#$F
		ADC	#2	 		;ADD 2 FOR LEADING AND TRAILING "/"'S
		STA	INBUF1	 	;SAVE FOR FN2 PROCESS.
		ADC	TXBUF-1	 	;ADD TO CURRENT FILE NAME LENGTH.
		CMP	#$40	 		;TOTAL MUST NOT EXCEED 63.
		TAX				;(CARRY SET MEANS NAME TOO LONG.)
		LDA	#ERRSYN	 	;ANTICIPATE ERROR.
		BCS	VOLNERR	 	;RETURN SYNTAX ERROR IF NECESSARY.
		LDY	TXBUF-1	 	;MAKE ROOM FOR VOLUME NAME.
		STX	TXBUF-1	 	;SAVE NEW LENGTH.
VOLNAM1	DEX
		DEY
		BMI	VOLNAM2	 	;BRANCH IF ALL CHARACTERS MOVED.
		LDA	TXBUF,Y
		STA	TXBUF,X	 
		JMP	VOLNAM1	 	;LOOP TILL ALL CHARS MOVED.
   SPACE 
VOLNAM2	LDA	#$2F	 		;PLACE A "/" AT START AND END
		STA	TXBUF	 		; OF VOLUME NAME.
VOLNAM3	STA	TXBUF,X
		LDA	INBUF1-1,X
		DEX				;MOVE	 VOLUME NAME.
		BNE	VOLNAM3
		LDA	XCNUM	 		;IF CALL IS 'OPEN' LEAVE PN2 ALONE!!
		CMP	#CIOPEN
		BEQ	GOODVOL
		CMP	#CIAPND	 	;APPEND COMMAND
		BEQ	GOODVOL
		CMP	#CIEXEC	 	;(Guess what that is!)
		BEQ	GOODVOL
	SPACE
* INSERT VOLUME NAME IN FRONT OF FN2
	SPACE
		LDA	TXBUF2
		TAY				;SAVE	 OLD LENTH IN Y.
		CLC
		ADC	INBUF1	 	;ADD IN VOLUME NAME LENGHT WITH "/"S.
		CMP	#$40	 		;TOTAL MUST NOT EXCEED 63.
		TAX				;(CARRY SET MEANS NAME TOO LONG.)
		LDA	#ERRSYN	 	;ANTICIPATE ERROR.
		BCS	VOLNERR	 	;RETURN SYNTAX ERROR IF NECESSARY.
		STX	TXBUF2	 	;SAVE NEW LENGTH OF FN2  
VOLNAM4	DEX
		DEY
		BMI	VOLNAM5	 	;BRANCH IF ALL CHARACTERS MOVED.
		LDA	TXBUF2+1,Y
		STA	TXBUF2+1,X	 
		JMP	VOLNAM4	 	;LOOP TILL ALL CHARS MOVED.
   SPACE 
VOLNAM5	LDA	#$2F	 		;PLACE A "/" AT START AND END
		STA	TXBUF2+1	 	; OF VOLUME NAME.
VOLNAM6	STA	TXBUF2+1,X
		LDA	INBUF1-1,X
		DEX				;MOVE	 VOLUME NAME.
		BNE	VOLNAM6	 
   SPACE 
GOODVOL	CLC				;CLEAR CARRY TO INDICATE NO ERRORS
VOLNERR	EQU	*
		RTS

	SPACE
PROCPARM	JSR	ZIPACC	 	;ZERO NUMERIC ACCUMULATOR. 
		LDY	#9	 		;LOOK FOR XDOS NUMERIC PARAMETERS FIRST.
PRCPRM1	CMP	PTOK,Y
		BEQ	PRCPRM2	 	;BRANCH IF FOUND.
		DEY				;TABLE EXHAUSTED?
		BPL	PRCPRM1	 	;BRANCH IF NOT.
   SPACE 
		CMP	#$54	 		;PERHAPS IT IS 'TYPE'.
		BEQ	GETTYP
SYNERR2	JMP	SYNERR1	 
   SPACE 
GETTYP	LDA	#T
		AND	PBITS	 		;MAKE SURE TYPE EXPECTED.
		BEQ	PINVALID	 	;BRANCH IF NOT EXPECTED.
		ORA	FBITS
		STA	FBITS	 		;MARK TYPE SPECIFIED.
		LDA	#0
		STA	PBYTES
		LDA	#PTYPE
		STA	PCADR	 		;SETUP JUST IN CASE NUMERIC SPECIFIED.
		JSR	SCANCOM	 	;GET NEXT CHAR.
		BEQ	SYNERR2	 	;BRANCH IF NO NEXT CHAR.
		CMP	#$24	 		;IS IT HEX?
		BEQ	PROCHEX	 	;BRANCH IF IT IS.
		CMP	#$41	 		;IS IT ALPHA?
		BCC	PROCDEC	 	;ASSUME DECIMAL IF NOT.
		JMP	PROCTYP
   SPACE 
PINVALID	SEC				;INDICATE ERROR.
		LDA	#ERRINVLD	 	;REPORT UNEXPECTED PARAMETER.
		RTS
	SPACE
PRCPRM2	LDA	PTOKBIT,Y	 	;MAKE SURE THIS PARAMETER EXPECTED.
		BEQ	PRCPRM4	 	;BRANCH IF NO BIT TO MARK: I.E. "V" PARM.
		AND	PBITS+1
		BEQ	PINVALID	 	;BRANCH IF PARM NOT EXPECTED. 
		CMP	#SD	 		;SLOT OR DRIVE PARM?
		BNE	PRCPRM3	 	;BRANCH IF NOT.
		AND	FBITS+1	 	;EITHER SLOT OR DRIVE PREVIOUSLY PROCESSED
		BNE	PRCPRM4	 	;BRANCH IF YES.
		LDA	#1	 		;RESET DEFAULT DRIVE TO 1 IN CASE OF
		STA	VDRIV	 		; SLOT SPEC WITHOUT DRIVE.
		LDA	#SD
PRCPRM3	ORA	FBITS+1	 	;INDICATE SPECIFIC PARM FOUND.
		STA	FBITS+1
PRCPRM4	LDA	PCELL,Y	 	;PREPARE TO PROCESS NUMERIC PARM.
		AND	#3
		STA	PBYTES
		LDA	PCELL,Y
		LSR	A
		LSR	A
		STA	PCADR
		JSR	SCANCOM	 	;TEST FOR HEX OR DECIMAL
		BEQ	SYNERR3	 	;TERMINATOR NOT EXPECTED.
		CMP	#$24	 		;ASCII '$' FOR HEX?
		BEQ	PROCHEX	 	;BRANCH IF HEX.
PROCDEC	STX	INPTR	 		;SAVE INDEX TO INPUT LINE.
		JSR	DECHEX	 	;CONVERT DECIMAL TO HEXEDECIMAL.
		BCC	PRCDEC1	 	;BRANCH IF NO ERRORS.
		BMI	RANGERR1
		BCS	SYNERR3	 
PRCDEC1	LDX	INPTR	 		;GET NEXT CHAR.
		JSR	SCANCOM
		BNE	PROCDEC	 	;PROCESS NEXT DECIMAL NUMBER.
		BEQ	PRCPRM5	 	; ELSE, DONE CONVERTING.
   SPACE 
PROCHEX	JSR	SCANCOM	 	;GET FIRST HEX DIGIT.
		BEQ	SYNERR3	 	;REPORT SYNTAX ERROR IF NO HEX DIGITS.
PRCHEX1	STX	INPTR
		JSR	HEXHEX	 	;DO ASCII HEX TO GENUINE BINARY.
		BCC	PRCHEX2	 	;BRANCH IF NO ERRORS
		BMI	RANGERR1
		BCS	SYNERR3	 
PRCHEX2	LDX	INPTR
		JSR	SCANCOM	 	;DO NEXT DIGIT, IF ANY.
		BNE	PRCHEX1
   SPACE 
PRCPRM5	LDX	#2	 		;TEST RANGE.
PRMRANG	CPX	PBYTES	 	;REMAINING BYTES VALID?
		BEQ	PRCPRM6	 	;BRANCH IF THEY ARE
		LDA	ACCL,X	 	;(MUST BE ZERO)
		BNE	RANGERR1
		DEX
		BNE	PRMRANG	 	;TEST NEXT BYTE.
   SPACE 
PRCPRM6	LDY	PCADR	 		;INDEX TO HIGHEST BYTE OF PARAMETER.
PARMOVE	LDA	ACCL,X
		STA	PVALS,Y
		DEY
		DEX
		BPL	PARMOVE	 	;MOVE ALL BYTES OF PARAMETER JUST PROCESSED.
		LDX	INPTR	 
		CLC
		RTS
   SPACE 
SYNERR3	JMP	SYNERR1	 
   SPACE 
RANGERR1	JMP	RANGERR	 
   SPACE 2 
PROCTYP	LDY	#0	 		;FIRST GET ALL THREE BYTES OF SYMBOL. 
GTYP1		STA	ACCL,Y
		INY
		CPY	#3	 		;ALL THREE RECEIVED YET?
		BEQ	GTYP2
		JSR	SCANCOM	 	;MUST NOT BE TERMINATOR.
		BNE	GTYP1	 
		BEQ	SYNERR3	 
   SPACE 
GTYP2		STX	INPTR	 		;SAVE X FOR NOW.
GTYP3		LDX	#0
		LDA	PBYTES
		CMP	#TYPNUM	 	;MNEMONIC NOT FOUND?
		BEQ	SYNERR3	 
		ASL	A	 		;MULTIPLY BY 3
		ADC	PBYTES	 	;TO INDEX ASCTABLE.
		TAY
GTYP4		LDA	ACCL,X
		EOR	ASCTYP,Y	 	;COMPARE MNEMONIC.
		ASL	A	 		;IGNORE HI BIT.
		BNE	GTYP5
		INY
		INX
		CPX	#3	 		;ALL THREE BYTES MATCH?
		BNE	GTYP4	 		;CHECK NEXT IF NOT.
		BEQ	GTYP6	 		;FOUND IT!
GTYP5		INC	PBYTES
		BNE	GTYP3	 		;BRANCH ALWAYS TAKEN.
	SPACE
GTYP6		LDA	#TYPNUM-1	 	;ASCII FILE TYPE FOUND,
		SEC
		SBC	PBYTES	 	; CONVERT TO INTERNAL VALUE.
		TAY
		LDA	RTYP,Y
		STA	PVALS+PTYPE	 	;SAVE IT!
		LDX	INPTR	 		;END BY RETURNING NEXT CHARACTER.
		CLC				;NO	 ERRORS 
		RTS
*
SCANFN2	JSR	SCAN2	 		;GET A CHARACTER.
		STA	TXBUF2,Y	 	;SAVE IT.
		INY
		CMP	#$2C	 		;IS IT A TERMINATOR, SUCH AS COMMA?
		BEQ	SCANDNE	 	;BRANCH IF IT IS.
		CMP	#$20
		BEQ	SCANDNE	 	; OR    SPACE ?
		CMP	#$D
		BEQ	SCNDNE1	 	; OR CARRAGE RETURN?
		CPY	TCNT
		BCC	SCANFN2	 	;BRANCH IF ALLOWED TO MOVE SOME MORE...
		ORA	#0	 		;SET APPROPRIATE FLAGS.
		RTS				;(ONLY	 CR RETURNS EQUAL)
*
SCANNER	LDX	#0	 		;BEGIN SCAN AT THE BEGINNING
		LDY	#0	 		;(NATURALLY...)
SCANNXT	JSR	SCAN2	 		;GET A CHARACTER.
		STA	TXBUF,Y	 	;SAVE IT.
		INY
		CMP	#$2C	 		;IS IT A TERMINATOR, SUCH AS COMMA?
		BEQ	SCANDNE	 	;BRANCH IF IT IS.
		CMP	#$20
		BEQ	SCANDNE	 	; OR    SPACE ?
		CMP	#$D
		BEQ	SCNDNE1	 	; OR CARRAGE RETURN?
		CPY	TCNT
		BCC	SCANNXT	 	;BRANCH IF ALLOWED TO MOVE SOME MORE...
SCANDNE	ORA	#0	 		;SET APPROPRIATE FLAGS.
		RTS				;(ONLY CR RETURNS EQUAL)
   SPACE 2
SCANCOM	LDA	#$20	 		;   SPACE S SHOULD BE IGNORED.
		STA	SKPCHR
		JSR	SCAN2	 		;RETURN NEXT NON    SPACE  CHARACTER.
		CMP	#$2C	 		;SET CARRY AND EQUALS FLAGS IF COMMA.
		BEQ	SCOMDNE
		CMP	#$0D	 		;CLR CARRY AND EQUALS IF CARRAGE RETURN
SCNDNE1	CLC				;OTHERWISE	 'NOT' EQUAL.
SCOMDNE	RTS
   SPACE 2 
SCAN2		LDA	INLINE,X	 	;GET CHARACTER FROM INPUT BUFFER.
		AND	#$7F	 		;STRIP BIT 7.
		CMP	#$61	 		;TEST FOR LOWER CASE ALPHA.
		BCC	NOLOW	 		;BRANCH IF NO UPSHIFT NEEDED.
		AND	#$5F	 		;MAKE IT UPPER-CASE.
NOLOW		INX				;BUMP	 X FOR NEXT TIME.
		CMP	SKPCHR		;SHOULD THIS CHARACTER BE IGNORED?
		BEQ	SCAN2	 		;BRANCH IF IT SHOULD.
		RTS				;ELSE RETURN THE SUCKER.
   SPACE 2 
DECHEX	CMP	#$30	 		;BE SURE ASCII CHAR RECEIVED
		BCC	NODEC
		CMP	#$3A	 		; IS IN THE RANGE OF 0-9.
		BCC	ADDEC1	 	;BRANCH IF IT IS
NODEC		SEC				;INDICATE NO GOOD!
		ORA	#0	 		;INDICATE ORDINARY SYNTAX ERROR. 
		RTS
   SPACE 2
ADDEC1	AND	#$F	 		;STRIP ASCII PART.
		PHA				;SAVE	 IT FOR NOW.
		LDA	ACCH	 		;TEST FOR PROBABLE OVERFLOW.
		CMP	#$1A
		BCS	DECOVR	 	;BRANCH IF TOO BIG!
		LDX	#2
ADDEC2	LDA	ACCL,X	 	;MULTIPLY CURRENT VALUE BY 10
		PHA
		DEX
		BPL	ADDEC2
		JSR	SHFT24	 	;FIRST BY 4.
		JSR	SHFT24
		LDX	#0	 		;ADD IN ORIGINAL TO GET *5
		CLC
ADDEC3	PLA
		ADC	ACCL,X
		STA	ACCL,X
		INX
		TXA
		EOR	#3
		BNE	ADDEC3
		JSR	SHFT24	 	;NOW *2 TO GET *10 TOTAL
DECOVR	PLA				;ADD IN NEW GIVEN VALUE.
		BCS	OVFLOW	 	;RETURN OVERFLOW ERROR.
		ADC	ACCL
		STA	ACCL
		BCC	ADDEC4
		CLC				;INDICATE NO ERRORS EXPECTED.
		INC	ACCM
		BNE	ADDEC4
		INC	ACCH
		BNE	ADDEC4
OVFLOW	LDA	#$FF	 		;SET MINUS FLAG.
		SEC				;AND CARRY FOR ERROR.
ADDEC4	RTS
	SPACE 2
HEXHEX	CMP	#$30	 		;MAKE SURE IN RANGES 0-9 OR A-F.
		BCC	NOHEX
		CMP	#$3A
		BCC	HEXHX2	 
		CMP	#$41
		BCC	NOHEX
		CMP	#$47
		BCC	HEXHX1
NOHEX		SEC
		ORA	#0
		RTS				;CARRY SET, POSITIVE: SYNTAX ERROR.
   SPACE  
HEXHX1	SBC	#6	 		;ADJUST FOR ALPHA HEX.
HEXHX2	AND	#$F
		LDX	#3	 		;MULTIPLY CURRENT NUMBER BY 16.
HEXHX3	JSR	SHFT24
		BCS	OVFLOW	 	;RETURN RANGE ERROR.
		DEX
		BPL	HEXHX3
		ORA	ACCL
		STA	ACCL
		RTS				;(CARRY IS CLEAR).
   SPACE 2
SHFT24	ASL	ACCL
		ROL	ACCM
		ROL	ACCH
		RTS
   SPACE 2
SRCHCMD	LDX	#CMDCNT	 	;# of commands (31 COMMANDS, 0->30) 
		STX	XCNUM	 		;INITIALIZE COMMAND NUMBER.
		LDA	TXBUF	 		;BEFORE TESTING OTHER COMMANDS
		EOR	#$2D	 		;TEST FOR THE "DASH" COMMAND
		BNE	SRCHC0	 	;BRANCH IF NOT.
		INC	XCNUM	 		;BUMP COMMAND # TO $1F
		STA	XLEN
		BNE	FONDCMD	 	;BRANCH ALWAYS (INC XCNUM ABOVE MADE NOT EQUAL).
   SPACE 
SRCHC0	LDY	#8	 		; AND LENGTH OF EACH COMMAND STRING
		STY	XLEN
SRCHC1	LDA	SRCHTBL-1,X	 	;GET INDEX TO COMMAND STRING IN TABLE.
		BPL	SRCHC2	 	;BRANCH IF CURRENT STRING LENGTH IS CORRECT.
		AND	#$7F	 		;STRIP 'NEW GROUP' FLAG.
		DEY
		DEC	XLEN	 		;THIS STRING GROUP IS 1 CHARACTER SHORTER/COMMAND.
SRCHC2	TAX				;INDEX TO COMMAND STRING.
SRCHC3	LDA	TXBUF,Y	 	;COMPARE LASTR CHARCTER FIRST.
		CMP	XCMDS,X
		BNE	SRCHNXT	 	;BRANCH IF NOT COMMAND WERE LOOKING FOR.
		DEX				;BUMP POINTERS TO NEXT LOWER CHARACTER OF BOTH STRINGS.
		DEY
		BPL	SRCHC3	 	;BRANCH IF MORE CHARACTERS TO TEST
FONDCMD	LDA	XCNUM	 		;OTHERWISE, WE'VE GOT A MATCH.
		ASL	A	 		;GET ALLOWED PARAMETER BITS.
		TAX
		LDA	CPBITS-1,X
		STA	PBITS+1
		LDA	CPBITS-2,X
		STA	PBITS
		CLC				;INDICATE	 GOOD COMMAND.
		RTS
   SPACE 2 
SRCHNXT	LDY	XLEN	 		;PREPARE FOR NEXT COMMAND TO COMPARE TO.
		DEC	XCNUM	 		;TRY NEXT LOWER COMMAND NUMBER.
		LDX	XCNUM
		BNE	SRCHC1	 	;LOOP IF MORE TO TEST.
		DEC	XCNUM	 		;OTHERWISE, RETURN COMMAND $FF (NO MATCH!) 
		SEC				;INDICATE COMMAND NOT RECOGNIZED. 
		JMP	EXTRNCMD	 	;TRY EXTERNAL COMMAND.
   SPACE 
ZIPACC	LDY	#0
		STY	ACCL
		STY	ACCM
		STY	ACCH
		RTS

	TITLE	'SMART RUN (-)'	 
*********************** SMART RUN (-) ***********************
* The Dash (spelled "-") Command is a Smart RUN Command that*
*   RUNs BASIC Programs, BRUNs Binary Programs, EXECs Text  *
*   Files, and launches other Interpreter (SYSTEM) Files. 	*
* This should include S16 Files from GS/OS 
*************************************************************
	SPACE
DASH		LDA	FIFILID	 	;WHAT KIND OF FILE IS IT?
		CMP	#TBAS	 		;IS IT BASIC?
		BEQ	RUN	 		;BRANCH IF BASIC.
		CMP	#TBIN	 		;IS IT BINARY?
		BEQ	DASH3	 
   SPACE 
		CMP	#TTXT	 		;IS IT A TEXT FILE?
		BNE	DASH2	 		;BRANCH IF NOT.
		JMP	EXEC	 		;JUMP IF TEXT.
   SPACE 
DASH2		CMP	#TSYS	 		;LASTLY, IS IT ANOTHER INTERP FILE?
		BEQ	DASHSYS	 	;BRANCH IF IT IS!
		CMP	#TS16			;Is it a GS/OS File
		BEQ	DASHSYS		;BRANCH IF IT IS!
		LDA	#ERRTYP	 	;REPORT INVALID FILE TYPE.
		SEC
		RTS
   SPACE  
DASHSYS	PHA				;Added to handle either P8 or P16 files
		JSR	CLOSALL	 	;CLOSE ALL OPEN FILES FIRST.
		JSR	CLSEXEC	 	;CLOSE EXEC FILES TOO.
		LDA	#0	 		;SET "BLOAD" ADDR.
		STA	VADDR
		STA	MEMTABL+$13
		STA	MEMTABL+$14	 	;(ALSO CLEAR MEMTABLE BITS) 
		STA	MEMTABL+$15
		STA	MEMTABL+$16
		LDA	#1
		STA	MEMTABL+$17
		LDA	#$20	 		; AT A$2000
		STA	VADDR+1
		PLA				;Reset Filetype to TSYS or TS16
		CMP	#TSYS			;Is it a P8 File
		BNE	DASH4			;No so go to bye, else fall through and complete
		STA	VTYPE
		LDA	#AD	 		;INDICATE THESE PARMS ARE SPECIFIED.
		STA	FBITS+1
		LDA	#FN1+T
		STA	FBITS
DASH3		JMP	DASHBIN	 	;GO EXECUTE "BRUN" FILE.
DASH4		SEC				;set carry
		JSR	$FE1F			;Look at ID Routine
		BCS	DASH3			;Not a GS so give error
DASH5		JMP	BYE1			;goto bye command is GS/OS file
		
	SPACE
	TITLE	'CHAIN'
******************** Chain Command **********************	
	SPACE
CHAIN		JSR	VARPACKER	 	;GO PACK VARIABLES.
		LDA	HIMEM+1	 	;PRESERVE ORIGINAL HIMEM VALUE.
		STA	CHIMEM
		LDX	PACKADR+1	 	;AND SET IT TO A PAGE BELOW
		DEX				; PACKED VARIABLES.
		STX	HIMEM+1
		JSR	LOAD1A	 	;GO LOAD PROGRAM.
		LDX	CHIMEM	 	;RESTORE PROPER HIMEM.
		STX	HIMEM+1
		BCS	LODERR	 	;RETURN ANY ERRORS.
		JSR	PREPBAS	 	;INIT BASIC STUFF, THEN 
		JSR	VARUNPACK	 	;GO UNPACK VARIABLE.
		LDA	#0	 		; CLEAR ON ERROR FLAG.
		BEQ	RUN2	 		;BRANCH ALWAYS.
	SPACE
	TITLE	'RUN'
******************** RUN Command **********************		
	SPACE
RUN		EQU	*	 
		LDA	#0
		STA	IFILACTV
		STA	ASERR
		LDA	FBITS	 		;WAS A FILE NAME SPECIFIED?
		LSR	A
		BCC	GORUN	 		;BRANCH IF NOT.
		JSR	LOAD1	 		;GO LOAD SPECIFIED FILE.
		BCS	LODERR	 	;RETURN ANY ERRORS IMMEDIATELY.
		JSR	PREPBAS		;INIT BASIC.
RUN2		STA	ONERRFLG	 	;CLEAR ON-ERROR FLAG.       
		JSR	FNDLINE	 	;FIND RUN LINE IF NECESSARY.
		JSR	SSYSIO	 	;RESTORE I/O TO DOS.
		JSR	GORUN
		JMP	RUNBASIC		 ;EXECUTE PROGRAM.
*
GORUN		JSR	APSFTNORM	 	;Applesoft SETNORM routine
		LDA	#$A3
		STA	TRCIMG	 	;Reset Trace flag image
		LDA	#$FF
		STA	XCNUM	 		;JUST NEEDED TO MARK RUN FLAG
		STA	PROMPT	 
		LDX	#4	 		;SET RUN STATE
		JSR	SETSTATE
		JMP	SYNERR1	 	;INDICATE NOT RECOGNIZED.
	SPACE
	TITLE	'LOAD'
******************** LOAD Command **********************	
	SPACE
LOAD		JSR	LOAD1	 		;GO LOAD PROGRAM.
		BCS	LODERR	 	;RETURN ERRORS...
		EXPORT WARMDOS
WARMDOS	JSR	PREPBAS	 	;THIS CANNOT BE PUT IN "LOAD1" SINCE ONLY
                                    ;1 STACK LEVEL IS PRESERVED.
		JSR	SETSYSIO	 	;SET I/O BACK TO DOS.
		LDA	#0
		STA	$24
		JMP	WRMSTRT	 	;ELSE RE-ENTER BASIC WITH NEW PROGRAM LOADED.
   SPACE
LOAD1		JSR	CLOSALL	 	;FIRST CLOSE ALL OPEN FILES (EXCEPT EXECS). 
		BCS	LODERR	 	;DO NOTHING IF ERROR.
LOAD1A	JSR	LOAD2	 		;GO LOAD A BASIC PROGRAM.
		BCS	LODERR
		STY	ARRPTR	 	;INIT VARIABLE PTRS TO END OF PROG.
		STY	SIMPTR
		STY	ENDVAR
		STX	ARRPTR+1
		STX	SIMPTR+1
		STX	ENDVAR+1
LODERR	RTS
   SPACE 2 
LOAD2		LDA	#1	 		;NEED READ ACCESS.
		LDX	#TBAS	 		;TYPE="BAS" FOR APPLESOFT.
		JSR	DOFOPN	 	;GO OPEN FILE IF BASIC PROGRAM.
		BCS	LODERR	 	;RETURN ANY ERRORS IMMEDIATELY.
		LDA	#GEOFCMD		;GET FILE'S LENGTH.
		JSR	GOSYSTEM
		BCS	LODERR	 	;RETURN ERRORS.
		LDA	BEGPROG	 	;MOVE LOAD ADDRESS OF PROGRAM TO READ SPEC. 
		STA	RWDATA
		ADC	SEOF	 		;CALCULATE NEW END OF PROGRAM.
		STA	VADDR
		LDA	BEGPROG+1
		STA	RWDATA+1
		ADC	SEOF+1
		STA	VADDR+1	 	;SAVE NEW END ADDRESS.
		BCS	BIGERR	 	;(SHOULD NEVER HAPPEN)
		CMP	HIMEM+1	 	;IS IT TOO BIG TO LOAD?
BIGERR	LDA	#TOOBIG	 	;ANTICIPATE ERROR.
		BCS	LODERR	 	;BRANCH IF TOO BIG.
		LDX	SEOF	 		;REQUEST WHOLE FILE.
		LDY	SEOF+1
		JSR	DOREAD	 	;AND READ IT INTO MEMORY.
		BCS	LODERR
		JSR	DOCLOSE	 	;CLOSE THE FILE.
		BCS	LODERR
		JSR	RLOCBAS	 	;RELOCATE LINK ADDRESSES IF NECESSARY.
		LDX	VADDR+1	 	;SAVE NEW END OF PROGRAM.
		LDY	VADDR
		STX	ENDPROG+1
		STY	ENDPROG
		RTS				;ALL	 DONE LOADING.
   SPACE 2
RLOCBAS	SEC				;DETERMINE IF PROGRAM WAS SAVED
		LDA	BEGPROG	 	;FROM SAME ADDRESS AS JUST LOADED.
		SBC	FIAUXID	  
		STA	TO
		LDA	BEGPROG+1
		SBC	FIAUXID+1
		STA	TO+1	 		;SAVE RESULT IN ZERO PAGE.
		ORA	TO	 		;TEST FOR SAME ADDRESS (=)
		CLC				;(IN	 ANY CASE CLEAR CARRY.)
		BEQ	RLBASEND	 	;BRANCH IF SAME ADDRESSES.
   SPACE 
		LDX	BEGPROG
		LDA	BEGPROG+1	 	;BEGIN RELOC AT PROGRAM START.
RLBASIC	EQU	*	 		;ENTERED HERE FOR HI-REZ SPLIT.
		STX	FROM	 		;SAVE LINK ADDRESS.
		STA	FROM+1
		LDY	#1	 		;TEST FOR END OF PROGRAM.
		LDA	(FROM),Y
		DEY
		ORA	(FROM),Y	 	; LINK=0 IF END.
		BEQ	RLBASEND
		LDA	(FROM),Y	 	;ADJUST LINK ADDRESS.
		ADC	TO
		TAX
		STA	(FROM),Y
		INY
		LDA	(FROM),Y
		ADC	TO+1
		STA	(FROM),Y	 	;SAVE NEW LINK.
		CLC				;CLEAR CARRY FOR NEXT ADD.
		BCC	RLBASIC	 	;BRANCH ALWAYS TAKEN.
*
FNDLINE	LDA	FBITS+1	 	;WAS A LINE # SPECIFIED?
		AND	#LINE
		CLC
		BEQ	RLBASEND	 	;BRANCH IF NOT.
		LDA	VLINE	 		;MOVE CRUNCHED LINE NUMBER TO APPLESOFT'S
		STA	ASLINE	 	; LINE NUMBER REGISTER.
		LDA	VLINE+1
		STA	ASLINE+1
		JSR	ASFNDLIN	 	;USE APPLESOFT ROM CODE TO FIND LINE ADDRESS
		CLC
		LDA	ASLOWTR	 	;THE APPLESOFT ROUTINE PLACES PTR 
		ADC	#$FF	 		;TO LINEADR HERE... 
		STA	$B8	 		;SET CHRGET PTR TO LINEADR-1 
		LDA	ASLOWTR+1	 
		ADC	#$FF
		STA	$B9
		CLC				;INDICATE NO PROBLEMS.
RLBASEND	RTS
	SPACE
	TITLE	'SAVE'
******************** SAVE Command **********************	
	SPACE
SAVE		BCC	SAVE1	 		;BRANCH IF FILE ALREADY EXISTS.
		LDA	#$FC	 		;CREATE A BASIC FILE.
		STA	VTYPE
		STA	FIFILID
		LDA	#$C3	 		;ALL ACCESS BITS ENABLED
		STA	FIACESS
		LDA	BEGPROG	 	;AUXID HOLDS ADDRESS OF PROGRAM SAVED.
		STA	CRAUXID	 
		STA	FIAUXID
		LDA	BEGPROG+1
		STA	CRAUXID+1	 
		STA	FIAUXID+1
		JSR	FCREATE	 	;GO CREATE FILE.
		BCS	SAVERR	 	;REPORT ANY ERROR.
   SPACE 
SAVE1		LDA	#2	 		;REQUEST WRITE ACCESS.
		LDX	#TBAS	 		; TO A 'BAS' TYPE FILE.
		JSR	DOFOPN		;GO OPEN FILE.
		BCS	SAVERR
		LDA	ENDPROG	 	;FIGURE HOW BIG FILE IS.
		SEC
		SBC	BEGPROG
		TAX				;SET	 WRITE REQUEST COUNT.
		STA	SEOF	 		;AND ANTICIPATE NEW EOF.
		LDA	ENDPROG+1
		SBC	BEGPROG+1
		TAY
		STA	SEOF+1
		LDA	#0
		STA	SEOF+2
		LDA	BEGPROG	 	;SET WRITE ADDRESS.
		STA	RWDATA
		LDA	BEGPROG+1
		STA	RWDATA+1
		JSR	DOWRITE	 	;AND GO WRITE THAT SUCKER.
		BCS	SAVERR
		LDA	#SEOFCMD	 	;SET NEW END OF FILE.
		JSR	GOSYSTEM
		BCS	SAVERR
		JSR	DOCLOSE	 	;FINALLY, CLOSE FILE.
		BCS	SAVERR
		LDA	BEGPROG+1	 	;MAKE SURE AUXID IS CORRECT FOR
		LDX	BEGPROG
		CMP	FIAUXID+1	 	; THIS COMPLETED SAVE.
		BNE	CHGFINFO
		CPX	FIAUXID
		CLC				;ANTICIPATE	 SAME SAVE ADDRESS.
		BNE	CHGFINFO
SAVERR	RTS
   SPACE 2
CHGFINFO	STX	FIAUXID	 
		STA	FIAUXID+1
		JMP	GOSETINFO	 	;UPDATE FILE INFO.
	SPACE
	TITLE	'CREATE'
******************** CREATE Command **********************	
	SPACE
CREATE	LDA	#0	 		;MAKE AUXID = 0 AS DEFAULT.
		STA	CRAUXID
		STA	CRAUXID+1
		LDA	FBITS	 		;WAS TYPE SPECIFIED?
		AND	#T
		BNE	FCREATE	 	;BRANCH IF IT WAS.
		LDA	#$0F	 		;MAKE DEFAULT A DIRECTORY.
		STA	VTYPE
   SPACE 
FCREATE	LDA	EXACTV	 	;DETERMINE IF L.T. 8 FILES OPEN.
		ASL	A	 		;(ADD EXEC TO OPENCNT)
		LDA	#0
		ADC	OPENCNT
		CMP	#8	 		;IF 8 THEN BUFFER ERROR.
		BCS	NOBUFS
		LDA	VTYPE	 		;FIRST SET FILE ID.
		STA	CRFILID	 
		LDX	#$C3	 		;SET DEFAULT ACCESS
		LDY	#$01	 		; AND DEFAULT FILE KIND (TREE).
		CMP	#$0F	 		;IS THIS A DIRECTORY CREATE?
		BNE	FCRE1	 		;BRANCH IF NOT.
		LDY	#$0D	 		; DIRECTORY FILE KIND.
FCRE1		STX	CRACESS
		STY	CRFKIND
		LDA	#CRECMD
		JMP	GOSYSTEM	 	;GO CREATE IT.
   SPACE 
NOBUFS	LDA	#MEMFUL
		RTS				;CARRY IS SET ABOVE...
	SPACE 
	TITLE	'RENAME, DELETE, (UN)LOCK, PREFIX'	 
******************** RENAME, DELETE, PREFIX, (UN)LOCK Command **********************	
	SPACE
RENAME	LDA	FBITS	 		;MAKE SURE BOTH NAMES SPECIFIED.
		LSR	A	 
		LSR	A
		LDA	#RNMCMD	 	;ANTICIPATE BOTH NAMES PRESENT
		BCS	GOSYS1	 	;BRANCH IF THEY ARE. 
		JMP	SYNERR1	 	;ELSE; REPORT SYNTAX ERROR. 
   SPACE 
DELETE	LDA	#DSTCMD	 	;NOTHING TO DO BUT DO IT. 
GOSYS1	JMP	GOSYSTEM
   SPACE  
LOCK		EQU	*
		JSR	GOGETINFO
		LDA	FIACESS	 	;CLEAR WRITE, RENAME, DESTROY ENABLE BITS. 
		AND	#$3C	 
		ORA	#1	 		;MAKE SURE READ IS ENABLED. 
		STA	FIACESS
		JMP	GSINFO1	 	;AND THAT'S ALL THERE IS TO IT.
   SPACE  
UNLOCK	EQU	*
		JSR	GOGETINFO
		LDA	#$C3	 		;SET ALL ACCESS BITS ON.
		ORA	FIACESS
		STA	FIACESS
		JMP	GSINFO1	 
   SPACE 
PREFIX	LDA	FBITS+1	 	;WAS A SLOT AND/OR DRIVE SPECIFIED?
		AND	#SD
		SEC				;ANTICIPATE	 SLOT OR DRIVE SPECIFIED.
		BNE	PREFIX1	 	;BRANCH IF WE GUESSED RIGHT.
		LDA	FBITS	 		;WAS A FILE NAME GIVEN?
		LSR	A	 
PREFIX1	LDA	#SPREFX	 	;ASSUME WERE GOING TO SET IT.
		BCS	GOSYS1	 	;BRANCH IF PREFIX TO BE SET.
		LDA	PROMPT	 	;IS A PROGRAM RUNNING?
		BEQ	RNPRFIX	 	;SET INHOOK TO GET PREFIX NEXT INPUT.
		JSR	CROUT	 		;OUTPUT TWO CARRAGE RETURNS. 
		LDX	#0
DSPFIX1	CPX	TXBUF-1		;HAVE ALL CHARACTERS BEEN OUTPUT? 
		BEQ	DSPFIX2		;(MAY BE NONE) 
		LDA	TXBUF,X	 	;OUTPUT PREFIX.
		ORA	#$80	 		;SET HI BIT FOR APPLE II.
		JSR	COUT
		INX
		BNE	DSPFIX1	 	;BRANCH ALWAYS.
   SPACE 
TWOCROUT	EQU	*
DSPFIX2	JSR	CROUT	 
		JSR	CROUT
		CLC
		RTS
   SPACE 2
RNPRFIX	LDA	#$FF	 		;SET STATE TO READ PREFIX FROM PROGRAM.
		STA	PFXACTV	 
		CLC
		RTS
		
	SPACE
	TITLE	'BSAVE / BLOAD'	 
*********************** BSAVE / BLOAD ***********************
* BSAVE, BLOAD, BRUN, and Dash (-) all use basically the	*
*   same code.  The difference is only in whether it's a	*
*   Read or a Write, and, for BSAVE, if a file needs to be	*
*   CREATEd.  Common code starts at the label BINOPN.		*
*************************************************************
	SPACE
BSAVE		BCC	BSAVE1	 	;Branch if file does exist.
		LDA	FBITS+1		;IF NOT, MAKE SURE ADDRESS
		AND	#AD+L+E	 	; AND LENGTH OR END ADDRESS
		CMP	#AD+L	 		; IS PRESENT.
		BCC	BNOTFND	 	;REPORT FILE NOT FOUND IF NOT PRESENT.
		LDA	VADDR	 		;MAKE SPECIFIED ADDRESS AUXID.
		STA	CRAUXID
		STA	FIAUXID
		LDA	VADDR+1
		STA	CRAUXID+1
		STA	FIAUXID+1	 
		LDA	#TBIN	 		;PREPARE FOR "BIN" CREATE.
		STA	VTYPE
		STA	FIFILID
		LDA	FBITS	 		;BUT MAKE SURE TYPE WAS NOT SPECIFIED.
		AND	#T
		BNE	BNOTFND	 	;BRANCH IF USER ASKED FOR SPECIAL TYPE.
		JSR	FCREATE	 	;GO CREATE BINARY TYPE FILE.
		BCS	BFERR	 		;REPORT ERRORS.
		JSR	GOGETINFO	 	;GET NEW FILE INFO.
		BCS	BFERR 
BSAVE1	LDA	#2	 		;FOR WRITE ACCESS.
		BNE	BINOPN	 	;BRANCH ALWAYS TAKEN. 
BNOTFND	LDA	#CIFNFERR	 	;REPORT FILE AS SPEC'D NOT FOUND.
BFERR		SEC				;INDICATE ERROR ENCOUNTERED.
		RTS
	SPACE 2
DASHBIN	EQU	*
BRUN		JSR	BLOAD	 		;GO LOAD SPECIFIED FILE.
		BCS	BFERR	 		;RETURN ERRORS
		JSR	GOBRUN	 	;EXECUTE CODE.
		CLC				;NO ERRORS AT THIS POINT.
		RTS
   	SPACE 2
GOBRUN	JMP	(RWDATA)	 	;JUMP TO BEGINNING OF BINARY PROGRAM.
BLOAD		LDA	#1	 		;FOR READ ACCESS.
						;DROP INTO BINOPN.
BINOPN	LDX	#TBIN	 		;OPEN BINARY OR SPECIFIED TYPE (IN VTYPE).
		JSR	DOFOPN
		BCS	BFERR	 		;REPORT ERRORS.
		LDX	VADDR	 		;ANTICIPATE USER SPECIFIED ADDRESS.
		LDY	VADDR+1
		LDA	FBITS+1	 	;DID USER SPECIFIY ADDRESS?
		BMI	BINRW1	 	;BRANCH IF GOOD GUESS.
		LDX	FIAUXID	 	;OTHERWISE USE AUXID AS ADDESS.
		LDY	FIAUXID+1
		LDA	FBITS	 		;ADDRESS MUST BE PRESENT IF TYPE IS SPECIFIED.
		AND	#T
		BNE	BINVALD	 	;REPORT MISSING PARM.
		LDA	FBITS+1
BINRW1	STX	RWDATA	 	;SAVE TRANSFER ADDRESS.
		STY	RWDATA+1	
***************************** BSAVE PATCH 1 START *****************************
		BIT	FBITS+1
		BVS	PJMP1
		PHA				;move a out to makle room for compare of vtype
		LDA	FIFILID		;get file type (looking for BIN value)
		CMP	#TBIN			;is it a Binary file?
		BNE	@5			;if not Binary then don't set FIAUXID
		STX	FIAUXID	 	;Save A-Value in
		STY	FIAUXID+1	 	;File.Info Parm.List
@5		PLA				;restore a to previous value
***************************** BSAVE PATCH 1 END *******************************
PJMP1		LDX	VLNTH	 		;ANTICIPATE USER SPECIFIED LENGTH.
		LDY	VLNTH+1
		AND	#L+E	 		;WAS LENGTH OR ENDADDR SPECIFIED? 
		BEQ	BINRW3	 	;BRANCH IF NEITHER.
		EOR	#L+E	 		;WERE BOTH SPECIFIED?
		BEQ	BINVALD	 	;REPORT PARMS INVALID IF SO.
		AND	#L	 		;WAS IT LENGTH ONLY?
		BEQ	BINRW4	 	;BRANCH IF IT WAS.
		LDA	VENDA	 		;CALCULATE REQUEST LENGTH=VENDA-VADDR.
		SEC
		SBC	VADDR
		TAX				;SAVE	LOW IN X.
		LDA	VENDA+1
		SBC	VADDR+1
		TAY				;AND HIGH IN Y.
		INX				;ADD 1 FOR TRUE LENGTH.
		BNE	BINRW2	 	;BRANCH IF NOT PAGE BOUNDARY.
		INY
BINRW2	BCS	BINRW4	 	;BRANCH IF LENGTH>0! 
BRANGERR	LDA	#ERRANGE	 	;REPORT INVALD RANGE REQUESTED.
		SEC
		RTS
   	SPACE 2
BINVALD	LDA	#ERRINVLD	 	;REPORT INVALID PARAMETER COMBO.
		SEC
		RTS
	SPACE 2
BINRW3	LDA	#GEOFCMD	 	;USE CURRENT END OF FILE FOR LENGTH
		JSR	GOSYSTEM
		BCS	BFERR2	 	;BRANCH IF ERROR.
		LDX	SEOF	 		;GET FILE LENGTH.
		LDY	SEOF+1	 	;HIGH IN Y.
		LDA	SEOF+2		; BUT MAKE SURE RANGE IS NOT > 64K.
		BEQ	BINRW4		;BRANCH IF WITHIN RANGE.
BTOBIG	LDA	#TOOBIG	 	;REPORT FILE TOO BIG.
BFERR2	SEC
		RTS
	SPACE 2
BINRW4	STX	RWCOUNT
		STY	RWCOUNT+1	 	;SAVE REQUESTED TRANSFER COUNT.
		LDA	FBITS+1	 	;GET FOUND PARM BITS AGAIN.
		AND	#B	 		;WAS A BEGINNING BYTE ADDRESS SPECIFIED?
		BEQ	DOBINIO	 	;BRANCH IF NO OFFSET SPECIFIED.
		LDX	#2	 		;MOVE BYTE PARM TO MLI CALL SPEC.
BINRW5	LDA	VBYTE,X
		STA	SMARK,X
		DEX				;MOVE	 ALL THREE BYTES.
		BPL	BINRW5 
BINRW6	LDA	#SMRKCMD	 	;GO SET FILE POSITION.
		JSR	GOSYSTEM
		LDX	XCNUM	 		;ANTICIPATE FAILURE.
		BCC	DOBINIO	 	;BRANCH IF SUCCESSFUL!
		CMP	#ERRANGE	 	;WAS ERROR MARK>EOF?
		BNE	BFERR2	 	;BRANCH IF NOT.
		CPX	#CIBSAVE	 	;IF SO, NEW EOF CAN ONLY BE SET BY BSAVE.
		BNE	BFERR2	 	;BRANCH IF NOT BSAVE COMMAND.
		LDA	#SEOFCMD		 ;OTHERWISE SET END OF FILE TO
		JSR	GOSYSTEM	 	; USER SPECIFIED POSITION.
		BCC	BINRW6	 	;BRANCH IF NEW EOR SET.
		RTS				;ELSE	 GIVE UP NOW...
   SPACE 2
DOBINIO	LDX	XCNUM	 		;GET CI COMMAND NUMBER.
		LDA	#READCMD	 	;ANTICIPATE NOT BSAVE.
 		CPX 	#CIBSAVE		
		BNE	@2
		BIT	FBITS+1	 	;BSAVE command is active
		BVS	@1	 		;B-parm active so skip EOF
		LDA	FBITS+1
		AND	#L+E	 		;no B-parm given
		BEQ	@1	 		;no L or E parm given
		LDA	RWCOUNT	 	;L/E parm given without
		STA	SEOF	 		;B-parm - update EOF
		LDA	RWCOUNT+1
		STA	SEOF+1
*************** B-Parm Patch Begin ***********************************
		LDA 	#0			;clear B-parm from EOF
		STA	SEOF+2		;reset EOF based upon B-Parm
*************** B-Parm Patch End *************************************
		LDA	#SEOFCMD
		JSR	GOSYSTEM	 	;Set EOF
@1		LDA	#WRITCMD
@2		JSR	GOSYSTEM	 	;Read or Write called
		BCS	@4	 		;Error 
		BIT	FBITS+1
		BVS	@3	 		;B-parm given skip File.Info
		CPX	#$F	 		;B-parm not given
		BNE	@3	 		;BSAVE not active
		JSR	GOSETINFO	 	;BSAVE active - set File.Info
@3		JMP	DOCLOSE	 	;Close file and exit
@4		SEC				;Clear stack
		RTS				;RETURN to common code				
*************** End BSAVE Patch 2 **********************************

	TITLE	'STORE / RESTORE'	 
******************** STORE / RESTORE ******************************
* The STORE Command packs all the current AppleSoft Variables	*
*   and Writes them to the specified file.  After Writing to	*
*   the file, the variables are unpacked again for the normal(?)	*
*   operation of BASIC.								*
*											*
* The file has a 5 byte header consisting of:				*
*   OVLEN  - Original length of variable table.				*
*   OASTRT - Offset to where array variables start			*
*   OHIMEM - Original HIMEM							*
*											*
* PACKADR should become AUXID and PACKLEN(+5) should become the	*
*   end mark of the file (EOF).						*
*******************************************************************
	SPACE
STORE		BCC	STORE1	 	;BRANCH IF SPECIFIED FILE EXISTS.
		LDA	#TVAR			;CREATE AN APPLESOFT "VAR" TYPE FILE.
		STA	VTYPE
		STA	FIFILID
		LDA	#$C3	 		;ALLOW ALL FLAVORS OF ACCESS
		STA	FIACESS
		JSR	FCREATE	 	;GO MAKE IT.
		BCS	STORERROR	 	;RETURN ANY ERRORS.
*
STORE1	JSR	VARPACKER	 	;GO PACK APPLESOFT VARIABLES.
		BCS	STORERROR	 	;Carry set if not enough memory for packing
		LDX	#TVAR	 		;OPEN A "VAR" TYPE FILE.
		LDA	#2	 		; FOR WRITE ACCESS.
		JSR	DOFOPN
		BCS	STORDONE	 	;Unpack vars & Report Errors.
		JSR	SETHEADR	 	;SET UP HEADER INFO.
		JSR	DOWRITE	 	;GO WRITE HEADER INFO.
		BCS	STORDONE	 	;HANDLE ERROR.
		LDA	PACKADR	 	;NOW PREPARE TO WRITE VARIABLES.
		STA	RWDATA
		STA	FIAUXID	 	;(SAVE ORIGINAL PACK ADDRESS AS AUXID).
		LDA	PACKADR+1
		STA	RWDATA+1
		STA	FIAUXID+1
		LDY	PACKLEN+1
		LDX	PACKLEN	 	;GO WRITE 'PACKLEN' BYTES.
		JSR	DOWRITE
		BCS	STORDONE
		LDA	#GMRKCMD	 	;MAKE CURRENT FILE POSITION THE EOF.
		JSR	GOSYSTEM
		LDA	#SEOFCMD	 	;(NO ERROR ANTICIPATED FROM LAST CALL)
		JSR	GOSYSTEM
		BCS	STORDONE	 	;REPORT ERRORS
		JSR	GOSETINFO	 	;SET NEW FILE INFORMATION. 
		BCS	STORDONE
		JSR	DOCLOSE	 	;LASTLY, CLOSE THE FILE!! 
	SPACE 2
STORDONE	PHP				;SAVE	 ERROR STATUS
		PHA				;AND	 POSSIBLE ERROR CODE.
		JSR	VARUNPACK	 	;GO UNPACK VARIABLES.
		PLA				;RESTORE STATUSES.
		PLP
STORERROR	RTS
	SPACE 2
SETHEADR	LDA	#<OVLEN	 	;POINT AT HEADER INFO FOR
		STA	RWDATA	 	; STORE/RESTORE COMMANDS.
		LDA	#>OVLEN
		STA	RWDATA+1
		LDY	#0	 		;WHETHER STORE OR RECALL, HEADER
		LDX	#5	 		; INFO IS 5 BYTES LONG.
		RTS
	Title 'RESTORE'
******************* RESTORE *********************************
* RESTORE finds a VAR type file, reads in the variables	*
*   THAT WERE "STORE"D,							*
*   that were STOREd and unpacks them for BASIC to use.	*
*************************************************************
	SPACE
RESTORE	LDX	#TVAR	 		;OPEN A "VAR" TYPE FILE.
		LDA	#1	 		; FOR READ ACCESS.
		JSR	DOFOPN
		BCS	STORERROR	 	;RETURN ERRORS IMMEDIATELY. 
		JSR	SETHEADR	 	;SET UP PARMS TO READ HEADER.
		JSR	DOREAD	 	;GO READ HEADER.
		BCS	STORERROR
		LDA	FIAUXID	 	; SO FAR SO GOOD...
		STA	PACKADR
		STA	RWDATA	 	;SET LOW ADDRESS FOR VARIABLES TO BE READ.
		LDA	HIMEM+1	 	;FIGURE DIFFERENCE BETWEEN CURRENT
		SEC				;	 HIMEM AND THE HIMEM EXISTING WHEN THE FILE
		SBC	OHIMEM	 	; WAS ORIGINALLY WRITTEN.
		CLC				;ADD	 THE DIFFERENCE TO ORIGINAL STORE ADDRESS
		ADC	FIAUXID+1	 	; TO OBTAIN THE ADDRESS WHERE THE
		STA	RWDATA+1	 	; FILE SHOULD BE READ NOW.
		STA	PACKADR+1
		CMP	ENDPROG+1	 	;MAKE SURE THERE IS ENOUGH MEMORY TO DO THE READ.
		BCC	RSTOOBIG	 	;BRANCH IF MEMORY CONFLICT
		BEQ	RSTOOBIG
		LDA	#0	 		; NOW CALCULATE HOW MUCH SHOULD BE READ. 
		SBC	PACKADR	 	; (CARRY WAS SET BY COMPARE, ABOVE).
		TAX
		LDA	HIMEM+1
		SBC	PACKADR+1
		TAY
		JSR	DOREAD	 	;GO READ VARIABLES INTO MEMORY.
		BCS	STORERROR	 	;RETURN ERRORS.
		JSR	DOCLOSE	 	;GO CLOSE THE FILE.
		JMP	STORDONE	 	;AND GO UNPACK VARIABLES.
	SPACE
RSTOOBIG	LDA	#TOOBIG	 	;REPORT VARIABLE FILE WON'T
		SEC				;FIT IN AVAILABLE MEMORY    SPACE .
		RTS
	SPACE 2
DOCLOSE	LDA	#CLOSCMD
		BNE	GOSYS3	 	;BRANCH ALWAYS TAKEN. 
DOREAD	LDA	#READCMD
		BNE	SVCOUNT	 	;BRANCH ALWAYS
DOWRITE	LDA	#WRITCMD
SVCOUNT	STY	RWCOUNT+1	 	;STORE READ/WRITE COUNT  
		STX	RWCOUNT	 	; BEFORE CALLING. 
GOSYS3	JMP	GOSYSTEM

	Title 'PR# / IN#'
**********************'PR# / IN#'****************************	 
* The following routines, PRNUM and INNUM, change the I/O	*
*   hooks to specified or implied addresses.  Where a slot	*
*   number is specified, the address is looked up in the 	*
*   Globals for the corresponding slot.  If an address is	*
*   given, that address becomes the I/O address where 	*
*   characters are sent or requested.  If both slot and	*
*   address are specified, the address is entered into the	*
*   Globals for the specified slot (the I/O vector is not	*
*   changed until the next time a PR# or an IN# is issued).	*
*   Addresses below $C000 are checked for a CLD ($D8)		*
*   instruction as the first byte and are considered invalid*
*   if it is not present.  Addresses above $C000 are checked*
*   only for ROMs.  (The Apple II data bus is unstable if	*
*   no ROM or RAM is at the address tested.)			*
*************************************************************
	SPACE
PRNUM		LDA	#0			;SET UP OFFSETS TO OUTPUT TABLES
		STA	IOPTR	 
		BEQ	IONUM1	 	;BRANCH ALWAYS 
*
INNUM		LDA	#2	 		;OFFSET TO INPUT HOOK 
		STA	IOPTR
		LDA	#8	 		;OFFSET TO INPUT TABLE
IONUM1	ORA	VIOSLT	 	;CALCULATE OFFSET TO TABLE.
		ASL	A
		TAX
		LDA	FBITS	 		;DETERMINE IF SLOT NUMBER WAS SPECIFIED.
		AND	#SLOT	 		;(IF NOT, X-REG IS NOT VALID OR USED) 
		BEQ	IONUM2	 	;BRANCH IF ADDRESS ONLY GIVEN.
		LDA	FBITS+1	 	;WAS BOTH SLOT AND ADDRESS SPECIFIED?
		BMI	IONUM4	 	;BRANCH IF BOTH.
		LDA	OUTVECT0,X	 	;MOVE TABLE VALUE TO ADDRESS VAR
		STA	VADDR	 		; FOR VALIDATION BY 'IOLEGAL' ROUTINE.
		LDA	OUTVECT0+1,X
		STA	VADDR+1
IONUM2	JSR	IOLEGAL	 	;TEST ADDRESS FOR ROM OR 'CLD' OPCODE.
		BCS	IONUM3	 	;RETURN ERROR, IF ANY.
		LDY	IOPTR	 		;GET OFFSET TO PROPER HOOK.
		LDA	VADDR
		STA	CSWL,Y
		LDA	VADDR+1
		STA	CSWH,Y	 	;(CARRY IS CLEAR, NO ERROR) 
IONUM3	RTS
	SPACE 2
IONUM4	JSR	IOLEGAL	 	;VALIDATE ADDRESS BEFORE PLACING IN TABLE.
		BCS	IONUM5	 	;BRANCH IF INVALID ADDRESS.
		LDA	VADDR+1
		STA	OUTVECT0+1,X	;REASSIGN ADDRESS FOR SPECIFIED SLOT.
		LDA	VADDR
		STA	OUTVECT0,X	 	;(CARRY IS CLEAR, NO ERROR)
IONUM5	RTS
	SPACE 2
IOLEGAL	LDA	VADDR	 		;MOVE ADDRESS TO ZERO PAGE
		STA	FROM	 		; FOR INDIRECT ADDRESSING.
		LDA	VADDR+1
		STA	FROM+1
		LDY	#0
		CMP	#$C0	 		;IS IT RAM OR ROM?
		BCC	IOLEG3	 	;BRANCH IF RAM

		LDA	$CFFF	 		;CLEAR ANY SWITCHED IN $C800 SPACE .
		STY	TO	 		;USE 'TO' AS A COUNTER.
		LDA	(FROM),Y	 	;GET VALUE TO TEST AGAINST.
		CMP	#$FF
		BEQ	IONDEV
IOLEG1	CMP	(FROM),Y	 	;IS ADDRESSED DATA STABLE?
		BNE	IONDEV	 	;REPORT NO DEVICE IF NOT.
		DEC	TO
		BNE	IOLEG1	 	;TEST 256 TIMES.
IOLEG2	CLC				;INDICATE GOOD ADDRESS.
		RTS
	SPACE 2
IOLEG3	LDA	(FROM),Y	 	;TEST RAM ADDRESS FOR
		CMP	#$D8	 		; 'CLD' INSTRUCTION.
		BEQ	IOLEG2	 	;BRANCH IF GOOD. 
IONDEV	LDA	#NODEV	 	;REPORT NO DEVICE CONNECTED.
		SEC
		RTS
	SPACE 2
	Title 'Bye Command'
******************** Bye Command ***********************************
*  Bye command closes all open files and does an MLI Quit call.    *
********************************************************************
BYE		EQU	*
		JSR	CLOSALL	 	;Close all open files
		JSR	CLSEXEC	 	;Close EXEC file too
		LDA	#$65	 		;quit
		JSR	MLIENTRY	 	;and never return
		DC.B	$65
		DC.W	SBYE
		
BYE1		JSR	MLIENTRY	 	;and never return
		DC.B	$65
		DC.W	Parms
Parms		DC.B	$04			;Parameter count
		DC.B	$EE			;signature of extended quit code
		DC.W	TXBUF2
		DC.B	0,0,0			;remaining reserved parameters
		
	SPACE
	Title 'Catalog Command'
*********************'CAT(ALOG)'***********************************	 
* CAT and CATALOG OPEN the Directory specified by FN1, 		*
*   displays the contents (either 40 or 80 columns), and		*
*   CLOSEs the file.  Subroutines shared with RDCAT are		*
*   OPNCAT, NXTCAT and CATASC.						*
******************************************************************* 
CAT		LDA	#$27	 		;CAT PRODUCES 40 COLUMN OUTPUT.
		BNE	CAT1	 		;BRANCH ALWAYS
* 
CATALOG	LDA	#$4F	 		;CATALOG PRODUCES 80 COLUMNS.
CAT1		STA	STRLEN
		LDA	FBITS	 		;DO GETINFO ON PREFIX IF NO FILENAME.
		AND	#FN1+T
		LSR	A
		BNE	CAT1AA
		STA	VTYPE
CAT1AA	BCS	CAT1A	 		;BRANCH IF ALREADY GOT ONE.
		JSR	GOGETINFO
		BCS	CCATERR	 	;REPORT ERRORS.
CAT1A		JSR	OPNCAT	 	;OPEN DIRECTORY (IF IT IS A DIRECTORY)
		BCS	CCATERR	 	;RETURN ERRORS IMMEDIATELY.
		JSR	CROUT	 
		JSR	CATITLE		 ;PREPARE DIRECTORY NAME. 
		JSR	PRTLINE		 ;AND PRINT IT OUT. 
		JSR	CROUT	 		;ALONG WITH CARRAGE RETURN. 
*
		JSR	SPACAT	 	;CLEAR BUFFER
		LDX	#HEAD
		JSR	CONSTR	 	;AND PRINT IT.
		JSR	PRTLINE
		JSR	CROUT	 		;BLANK LINE BETWEEN HEADER AND FIRST FILE.
		LDA	TOTENT	 	;MAKE SURE THERE ARE SOME FILES
		ORA	TOTENT+1	 	; TO LIST...
		NOP
		NOP				;	 Used to be: "BEQ ENDCAT ; branch if not"
CAT2		JSR	NXTCAT	 	;READ NEXT VALID ENTRY.
		BCS	ENDCAT	 	; Used to be: BCS CCATERR DIRECTORY AND; REPORT ERROR.
		LDA	VTYPE	 		;IF TYPE=0 THEN PRINT ALL
		BEQ	CAT3
		CMP	CATBUF+$10	 	;ELSE, TEST FOR MATCHED TYPE
		BNE	CAT4A
CAT3		JSR	CATASC	 	;CONVERT CATALOG ENTRY TO ASCII.
		JSR	PRTLINE	 	;PRINT IT!.
CAT4A		LDA	$C000
		CMP	#$83	 		;CONTROL-C HALT?
		BNE	CAT5
		LDA	STATE	 		;PROGRAM EXECUTING?
		BNE	ENDCAT	 	;LEAVE KBD ALONE FOR PROGRAM
		BIT	$C010	 		;CLEAR KBD
		BCS	ENDCAT	 	;BRANCH ALWAYS (CARRY SET FROM COMPARE).
*
CAT5		NOP				; Fix BASIC CATALOG premature
		LDA	#$FF	 		; terminate after Control S (FF=any non zero)
		BNE	CAT2	 		; branch in all cases
	
ENDCAT	JSR	DOCLOSE	 	;CLOSE DIRECTORY.
		BCS	CCATERR	 	;RETURN ANY ERROR.
		JSR	CROUT	 		;BLANK LINE BETWEEN LAST NAME AND TRAILER.
		JSR	CATRAIL	 	;BUILD TRAILER... 
		BCS	CCATERR	 
		JSR	PRTLINE	 	;PRINT TRAILER 
		JSR	CROUT
		CLC				;NO	 ERRORS.. 
CCATERR	RTS
   SPACE 2
CATITLE	JSR	SPACAT	 	;CLEAR INPUT BUFFER.
		LDX	#1
		LDY	CATBUF+4
		LDA	#$AF	 		;ANTICIPATE 'ROOT' DIRECTORY
		CPY	#$F0
		BCC	CATTLE1	 	;BRANCH IF NOT ROOT.
		STA	INLINE,X	 	;ELSE, PRECEED NAME WITH '/'.
		INX
CATTLE1	TYA
		AND	#$F	 		;GET DIRECTORY NAME LENGTH.
		STA	INLINE
		LDY	#5	 		;Y INDEXES CATBUF, X INDEXES INPUT BUFFER.
CATTLE2	LDA	CATBUF,Y
		ORA	#$80	 		;SET HI BIT FOR APPLE II VIDEO.
		STA	INLINE,X
		INY				;INCREMENT	 INDEXES
		INX
		DEC	INLINE	 	;HAVE ALL CHARACTERS BEEN MOVED. ?
		BNE	CATTLE2	 	;BRANCH IF NOT.
		LDA	#$A2	 		;PLACE '"' AT BEGINNING IN CASE OF INPUT.
		STA	INLINE
		RTS				;(X CONTAINS POINTER TO LAST CHAR +1)
   SPACE 2
CATRAIL	LDA	#<TXBUF	 
		STA	SDATPTR
		LDA	#>TXBUF
		STA	SDATPTR+1	 	;GET NAME OF VOLUME.
		LDA	GLBDEV
		STA	SUNITNUM
		LDA	#ONLINCMD
		JSR	GOSYSTEM
		BCS	CCATERR	 	;RETURN ANY ERRORS.
		LDA	TXBUF	 		;GET VOLUME NAME LENGTH.
		AND	#$F
		TAX
		INX
		STX	TXBUF-1	 	;SAVE LENGTH OF 'PATH' FOR GETINFO
		LDA	#$AF	 		;PLACE LEADING "/"
		STA	TXBUF
		JSR	GOGETINFO	 	;GET FREE BLOCKS, ETC.
		BCS	CCATERR
		JSR	SPACAT
		LDX	#TAIL
		JSR	CONSTR	 	;PREPARE TRAILER...
		JSR	ZIPACC	 	;Clear 24 bit Accumulator
		LDA	FIAUXID
		LDX	FIAUXID+1	 	;CONVERT 'TOTAL BLOCKS' COUNT.
		LDY	#$3D
		JSR	HEXDEC
		LDA	FIBLOKS	 	;AND 'BLOCKS USED' COUNT.
		LDX	FIBLOKS+1
		LDY	#$26
		JSR	HEXDEC
		LDA	FIAUXID	 	; AND FINALLY, 'BLOCKS FREE' COUNT.
		SEC
		SBC	FIBLOKS
		PHA
		LDA	FIAUXID+1
		SBC	FIBLOKS+1
		TAX
		PLA
		LDY	#$10
		JSR	HEXDEC
		CLC
		RTS
   SPACE 2
OPNCAT	LDA	#$1	 		;READ ACCESS NEEDED.
		LDX	#TDIR	 		;DIRECTORY TYPE FILE.
		LDY	FIFKIND
		CPY	#$F	 		;IS IT ROOT DIR?
		BNE	OPNDR1	 	;BRANCH IF NOT
		STX	FIFILID
OPNDR1	JSR	DOCATOPN	 	;GO OPEN IT.
		BCS	COPN2	 		;BRANCH IF ERROR.
OPNDR2	LDA	#<CATBUF
		STA	RWDATA	 	;READ DIR HEADER INTO CATBUF.
		LDA	#>CATBUF
		STA	RWDATA+1
		LDA	#$2B	 		;READ STANDARD SIZE ENTRY+4
		STA	RWCOUNT
		LDA	#0	 		;MAKE SURE HI COUNT IS ZERO.
		STA	RWCOUNT+1	 
		LDA	#READCMD	 	;DO READ REQUEST
		JSR	GOSYSTEM
		BCS	COPN2	 		;CLOSE FILE AND; REPORT ERROR IF IT OCCURS.
		LDX	#3	 		;MOVE ENTLEN, MAXENT (PER BLOCK), AND TOTENT
COPN1		LDA	CATBUF+$23,X	 ; TO A MORE SECURE PLACE.
		STA	ENTLEN,X
		DEX
		BPL	COPN1
		STA	RWCOUNT
		LDA	#1	 		;SET CURRENT ENTRY (WITHIN A BLOCK) TO FIRST FILE ENTRY.
		STA	CURRENT
		LDA	#0
		STA	SMARK+1
		STA	SMARK+2
COPN2		RTS
   SPACE 2
DOFOPN	PHA				;SAVE	 REQUESTED ACCESS VALUE.
		LDA	FBITS	 		;TEST FOR OTHER SPECIFIED TYPE.
		AND	#T
		BEQ	DOFOPN1	 	;BRANCH IF X-SPECIFIED TYPE SHOULD BE USED.
		LDX	VTYPE	 		;ELSE PICK UP USER SPECIFIED TYPE
DOFOPN1	PLA				;RESTORE	 REQUESTED ACCESS.
DOCATOPN	CPX	FIFILID	 	;IS FILE TYPE SAME AS EXPECTED?
		BNE	OTYPERR	 	;REPORT TYPE MISMATCH IF NOT.
		AND	FIACESS	 	;IS REQUESTED ACCESS ALLOWED?
		BEQ	OACCERR	 	;BRANCH IF NOT.
		LDA	SYSBUFADR	 	;PREPARE FOR OPEN.
		STA	OSYSBUF+1
		LDA	#$F	 		;SET LOWEST PRIORITY FOR TEMP FILES.
		STA	GLBLEVEL
		LDA	#OPNCMD	 	; AND DO IT.
		JSR	GOSYSTEM
		BCS	ONOOPN	 	;REPORT ERRORS.
		LDA	OREFNUM	 	;SPREAD THE REFNUM AROUND.
		STA	RWREFNUM
		STA	CFREFNUM
		STA	SREFNUM
ONOOPN	RTS				;(OH,	 NO OPEN! IF CARRY SET).
   SPACE 2
OTYPERR	LDA	#ERRTYP	 	;REPORT TYPE MISMATCH.
		SEC
		RTS
   SPACE 2
OACCERR	LDA	#LOCKED	 	;REPORT ACCESS NOT PERMITTED.
		SEC
		RTS
	SPACE 2
NXTCAT	LDA	SMARK+1	 	;ROUND HIGH ADDR OF MARK TO 
		AND	#$FE	 		; TO BOTTOM OF 512 BYTE BOUNDARY.
		STA	SMARK+1
		LDY	CURRENT	 	;DO DUMB CALC TO NEXT ENTRY'S POSITION.
		LDA	#0
		CPY	MAXENT	 	;HAVE WE RUN OUT OF ENTRIES?
		BCC	NXCAT2	 	;BRANCH IF NOT.
		TAY
		STY	CURRENT	 	;BEGIN AT THE BEGINNIG, AGAIN...
		INC	SMARK+1	 	;GET NEXT BLOCK OF DIRECTORY 
NXCAT1	INC	SMARK+1
NXCAT2	DEY				;IS POSITION CORRECT YET?
		CLC
		BMI	NXCAT3	 	;BRANCH IF IT IS (ALMOST)
		ADC	ENTLEN
		BCC	NXCAT2
		BCS	NXCAT1	 	;ALWAYS
*
NXCAT3	ADC	#4	 		;ADJUST FOR DIRECTORY 'LINKS'.
		STA	SMARK
		LDA	#SMRKCMD	 	;POSITION TO START OF NEXT ENTRY.
		JSR	GOSYSTEM
		BCS	NXCAT4	 	;RETURN ERRORS...
		LDA	#READCMD	 	;NOW READ ENTRY...
		JSR	GOSYSTEM
		BCS	NXCAT4
		INC	CURRENT	 	;BUMP CURRENT COUNT FOR NEXT TIME.
		LDA	CATBUF	 	;IS IT AN ACTIVE FILE ENTRY?
		AND	#$F0
		BEQ	NXTCAT	 	;LOOP IF NOT.
		DEC	TOTENT	 	;REDUCE 'FOUND' COUNT FOR NEXT TIME.
		BNE	NXCAT4
		DEC	TOTENT+1
NXCAT4	RTS				;(CARRY IS SET IF ERROR)

*******************************************************
*
* USER COMMAND ADDRESS SET BY EXTERNAL ROUTINES 
*
*******************************************************
* 
USRCMD	JMP	(XTRNADDR)	 	;GOTO USER INSTALLED COMMAND.
 
EXEC		JSR	FNDNAME	 	;IS FILE CURRENTLY ACTIVE?
		BCS	EXEC1	 		;BRANCH IF NOT
		BIT	EXFILE	 	;IS IT THE CURRENT EXEC FILE?
		BPL	EXBUSY	 	;REPORT BUSY IF NOT! 
		STA	SREFNUM	 	;OTHERWISE, RESET POSITION OF FILE.
		LDA	#0
		STA	SMARK
		STA	SMARK+1
		STA	SMARK+2
		LDA	#SMRKCMD	 	;GO SET FILE POSITION TO ZERO.
		JSR	GOSYSTEM
		BCS	CLSXERR	 	;IF ERROR CLOSE EXEC.
		LDA	SREFNUM	 	;ELSE, CONTINUE WITH SETTING THINGS UP.
		BNE	EXECEND	 	;BRANCH ALWAYS TAKEN.
CLSXERR	PHA				;SAVE	 ERROR CODE.
		JSR	CLSEXEC	 	;GO CLOSE EXEC FILE.
		PLA
		SEC				;RESTORE ERROR CONDITION.
		RTS
*
EXBUSY	LDA	#FILBUSY
		SEC
		RTS
   SPACE 2
EXEC1		BIT	EXACTV	 	;IS ANOTHER EXEC FILE ACTIVE?
		BPL	EXEC2	 		;BRANCH IF NOT.
		JSR	CLSEXEC		;GO CLOSE EXEC FILE.
		BCS	EXECERR
*
EXEC2		LDA	FIFILID	 	;MAKE SURE IT'S A TEXT FILE.
		CMP	#TTXT
		BEQ	EXEC3
		LDA	#ERRTYP
EXECERR	SEC				;REPORT ERROR.
		RTS
*
EXEC3		JSR	GETSYSBUF	 	;GO ALLOCATE    SPACE  FOR EXEC FILE OPEN.
		BCS	EXECERR
		LDA	#$0
		STA	SBUFADR	 	;0 lo byte of buffer addr since must be page bndry
		LDA	SYSBUFADR
		STA	SBUFADR+1
		LDX	OPENCNT	 	;TEST TO SEE IF THIS FILE IS HIGHEST IN MEMORY.
		BEQ	EXEC7	 		;BRANCH IF NO OTHER FILES OPEN.
		TAY				;OTHERWISE,	 FIND THE FILE WITH THE HIGHEST
		TXA				; BUFFER ADDRESS, AND MAKE A TRADE WITH IT.
		ASL	A	 		;MULTIPLY OPENCNT BY 4 TO GET # OF PAGES
		ASL	A	 		; USED BY ALL OPEN FILES.
		ADC	SYSBUFADR	 	;ADD TO BUFFER WE GOT.
		PHA				;SAVE	 RESULT FOR LATER.
	
EXEC4		CMP	BUFADRS-1,X
		BEQ	EXEC5	 		;LOOK FOR MATCHING ADDRESS.
		DEX
		BNE	EXEC4	 		;LOOP TIL WE FIND IT.
		DC.B	$00	 		; NEVER!
EXEC5		TYA				;SET NEW BUFFER ADDRESS.
		STA	BUFADRS-1,X
		LDA	REFNUMS-1,X
		STA	SBUFREF	 	;GET REFNUM
		LDA	#SBUFCMD	 	;AND GO MOVE THAT TURKEY DOWN!
		JSR	GOSYSTEM
		BCC	EXEC6
		DC.B	$00	 		; Another break that should never happen
EXEC6		PLA				;GET	 BUFFER ADDRESS FOR EXEC FILE OPEN.
EXEC7		STA	SYSBUFADR	 	;SAVE IN CASE OF OPEN FAILURE.
		STA	OSYSBUF+1
		LDA	#0	 		;HIGHEST PRIORITY OPEN
		STA	GLBLEVEL
		LDA	#OPNCMD	 	;GO OPEN FILE.
		JSR	GOSYSTEM
		BCC	EXEC8	 		;BRANCH IF ALL WENT WELL
		PHA				;SAVE	 ERROR CODE.
		JSR	FRESYSBUF	 	;FREE UP BUFFER WE WORKED SO HARD TO GET.
		PLA
		SEC				;RESTORE ERROR INDICATION.
		RTS
*
EXEC8		LDX	OSYSBUF+1	 	;REMEMBER SYSTEM BUFFER ADDRESS
		STX	BUFADRS+7
		LDA	OREFNUM
		STA	REFNUMS+7	 	;AND REFERENCE NUMBER.
EXECEND	STA	RWREFNUM	 	;SAVE FOR POSITIONING.
		STA	SREFNUM
		STA	NEWLREF
		LDX	FIAUXID	 	;SET UP 'RECORD' LENGTH TOO.
		STX	VLNTH
		LDX	FIAUXID+1
		STX	VLNTH+1
		JSR	LOGEXEC	 	;GO SAVE EXEC FILE'S NAME WITH REG NAMES.
		LDA	#$7F	 		;ENABLE NEWLINE 'CR'
		STA	NLINENBL
		LDA	#NLINCMD
		JSR	GOSYSTEM
		LDA	FBITS+1	 	;WAS A FIELD SPECIFIED?
		AND	#F+R
		BEQ	EXEC9	 		;BRANCH IF NOT.
		JSR	POSN0	 		;POSITION FILE BY SPEC'D FIELD COUNT.
		BCC	EXEC9
		JMP	CLSXERR	 	;CLOSE EXEC AND RETURN ERRORS.
*
EXEC9		LDA	#$FF	 		;SET EXEC FILE ACTIVE.
		STA	EXACTV
		CLC				;INDICATE	 NO ERROR
		RTS				;ALL	 DONE...
	SPACE 2
CLSEXEC	LDA	EXACTV
		BPL	CLSEXC1	 	;BRANCH IF EXEC NOT OPEN. 
		STA	EXFILE	 	;SET FLAG TO TELL CLOSE IT'S SPECIAL.
		LDX	#8
		LDA	REFNUMS-1,X	 	;PASS REFNUM TO 'CLOSE1'
		JSR	CLOSE1	 	;CLOSE EXEC AND FREE BUFFER    SPACE .
CLSEXC1	RTS

	TITLE	'VERIFY'
************************* Verify ********************************
	
VERIFY	BCS	OFNFERR	 	;BRANCH IF FILE NOT FOUND. 
		LDA	FBITS	 		;TEST FOR FILE NAME PRESENT
		AND	#FN1
		BNE	VWITHPN	 	;IF NAME PRESENT, NO ERRORS OR MESSAGE.
		LDX	#COPYRIGHT	 	;ELSE, PRINT COPYRIGHT NOTICE. 
		JSR	PRCOPYRT	 
		JSR	CROUT
VWITHPN	CLC
		RTS
		
	Title 'FLUSH'
*************************  FLUSH  *********************************
* FLUSH INSURES THAT ALL DATA IN BUFFERS NOT YET WRITTEN TO THE	*		
* DISK IS WRITTEN AND DIRECTORIES UPDATED WITH CURRENT INFO.	*
* 'FLSHALL' IS AN INTERNAL ENTRY USED IN CASE OF ERROR, ETC.	*
*******************************************************************
   SPACE 
FLSHALL	LDA	#0
		BEQ	FLUSH1	 	;BRANCH ALWAYS TAKEN.
   SPACE 
FLUSH		LDA	FBITS	 		;TEST FOR SPECIFIC FILE TO FLUSH
		AND	#FN1
		BEQ	FLUSH1	 	;BRANCH IF ALL FILES TO BE FLUSHED.
		JSR	FNDNAME	 	;LOOK UP NAME AND GET REFNUM.
		BCS	FLSHERR	 	;BRANCH IF ERROR.
FLUSH1	STA	CFREFNUM
		LDA	#FLSHCMD	 	;TELL THE MLI TO DO IT.
		JSR	GOSYSTEM
FLSHERR	RTS				;RETURN ERROR (OR NO ERROR) STATUS.

	Title 'OPEN Command'
***************************  OPEN ***********************************
* OPEN COMMAND.  IF FILE DOES NOT EXIST, A TEXT FILE IS CREATED	  *
* WITH RECORD LEN OF (L).  BUFFER SPACE  IS ALLOCATED IF SUCESSFUL. * 
*********************************************************************
   SPACE 
OPEN		PHP				;SAVE	 FILE FOUND STATUS
		JSR	FNDNAME	 	;LOOK FOR FILE ALREADY OPEN.
		BCS	OPEN1	 		;BRANCH IF NONE FOUND.
		PLP				;RESTORE STACK.
		LDA	#FILBUSY	 	;REPORT FILE BUSY.
		SEC
		RTS
   SPACE 
OMISMTCH	LDA	#ERRTYP	 	;REPORT TYPE MISMATCH
		SEC
		RTS
   SPACE 
OFNFERR	LDA	#CIFNFERR
OPERR		SEC
		RTS
   SPACE 
OPEN1		PLP				;RESTORE FILE FOUND STATUS
		LDX	#0	 		;DEFAULT RECORD SIZE = 0000 
		LDY	#0	 
		LDA	FBITS+1	 	;WAS RECORD LENGTH SPECIFIED?
		AND	#L
		BNE	OPEN2	 		;BRANCH IF SO.
		STX	VLNTH+1	 	;ELSE SET DEFAULT TO 1. 
		STY	VLNTH
OPEN2		LDA	FBITS	 		;CHECK FOR TYPE SPECIFIED.
		AND	#T
		EOR	#T	 		;IF ZERO, THEN TYPE SPECIFIED.
		BEQ	OPEN3	 
		LDA	#TTXT	 		;SET TYPE TO TEXT.
		STA	VTYPE
OPEN3		BCC	OPEN4	 		;BRANCH IF FILE EXISTS
		BEQ	OFNFERR	 	;FILE NOT FOUND IF TYPE SPEC'D.
		STA	FIFILID	 	;SET FILE I.D.
		LDA	#$C3	 		;ALLOW ALL ACCESSES.
		STA	FIACESS
		LDX	VLNTH+1	 	;ELSE USE USER'S SPEC.
		LDY	VLNTH
		STX	CRAUXID+1	 	;SAVE REC LEN IN AUXID.
		STX	FIAUXID+1
		STY	CRAUXID
		STY	FIAUXID
		JSR	FCREATE	 	;GO CREATE TEXT FILE...
		BCS	OPERR	 		;BRANCH IF BUNGLED.
	SPACE
OPEN4		LDA	FIFILID	 	;IS FILE TYPE CORRECT?
		CMP	VTYPE
		BNE	OMISMTCH	 	;BRANCH IF NOT.
		CMP	#TTXT	 		;IS IT A TEXT FILE?
		BNE	OPEN4A	 	;IF NOT, LEAVE REC LEN AT 0 OR L
		LDX	FIAUXID+1
		LDY	FIAUXID
		LDA	FBITS+1	 	;SET UP RECORD LENGTH TO BE USED.
		AND	#L
		BNE	OPEN4A	 	;BRANCH IF LENGTH SPECIFIED.
		STX	VLNTH+1
		STY	VLNTH
OPEN4A	JSR	GETSYSBUF	 	;ALLOCATE BUFFER SPACE .
		BCS	OPERR	 		;RETURN ANY ERRORS.
		LDA	SYSBUFADR	 	;PASS BUFFER ADDRESS TO MLI.
		STA	OSYSBUF+1
		LDA	#7	 		;SET LEVEL TO MEDIUM PRIORITY.
		STA	GLBLEVEL
		LDA	#OPNCMD	 	;GO OPEN FILE.
		JSR	GOSYSTEM
		BCC	OPEN5	 		;BRANCH IF SUCCESSFUL
   SPACE 
		PHA				;SAVE	ERROR CODE.
		JSR	FRESYSBUF	 	;RETURN SYSTEM BUFFER TO APPLESOFT.
		PLA
		SEC
		RTS				;RETURN ERROR.
   SPACE 2
OPEN5		LDA	FIFILID
		CMP	#TDIR
		BEQ	OPEN6	 		;BRANCH IF DIRECTORY FILE.
		CLC				;INDICATE NON-DIRECTORY
OPEN6		LDA	#0	 
		ROR	A
		STA	DIRFLG
		LDX	OPENCNT	 	;MARK FILE IN BUFADR &
		LDA	SYSBUFADR	 	; REFNUM LISTS.
		STA	BUFADRS,X
		LDA	OREFNUM
		STA	REFNUMS,X
		INC	OPENCNT	 	;BUMP COUNT OF FILES OPEN.
LOGEXEC	ASL	A	 		;ENTRY USED TO STORE EXEC FILENAMES. 
		ASL	A
		ASL	A
		ASL	A
		ASL	A	 		;GET POSITION IN FILE NAME LIST.
		TAX
		LDA	TXBUF2	 	;GET TOTAL PATH LENGTH.
		ORA	DIRFLG	 	;MOVE DIRECTORY FILE INDICATOR TO HI BIT.
		STA	FILNAMES,X	 	;SAVE IN LIST
		AND	#$7F	 		;STRIP DIR FLG
		TAY
		CMP	#$1E	 		; ONLY 29 CHARACTER RESOLUTION...
		BCC	OPEN7	 		;BRANCH IF LESS.
		LDA	#$1D
OPEN7		STA	FROM
		LDA	VLNTH
		STA	FILNAMES+1,X
		LDA	VLNTH+1
		STA	FILNAMES+2,X	;SAVE RECORD LENGTH.
OPEN8		INX
		LDA	TXBUF2,Y	 	;MOVE FILENAME TO LIST.
		STA	FILNAMES+2,X
		DEY
		DEC	FROM
		BNE	OPEN8
OLDCMD	CLC				;Open was a SUCCESS!
		RTS
	SPACE 2
	TITLE	'FIND FILE'	 
****************** FIND FILE **************************
* FIND FILENAME IN ACTIVE FILE LIST.  POSITION IN	* 
* TABLE IS 32*REFNUM.  FIRST VALUE IN EACH NAME IS	*
* TOTAL PATH LENGTH (PLUS 128 IF DIR).			*
* NEXT WORD IS RECORD LENGTH.  LASTLY, UP TO 29 	*
* CHARACTERS OF THE PATHNAME IS STORED.			*
*******************************************************
   SPACE 
FNDNAME	LDA	FBITS	 		;FIRST VERIFY THAT A NAME WAS SPECD
		AND	#FN1
		BNE	FNDNAM0
		LDA	#ERRSYN
		SEC
		RTS
   SPACE 2
FNDNAM0	LDX	OPENCNT	 	;SEARCH LAST OPENED FIRST.
		BEQ	NOFILE	 	;BRANCH IF NO OPEN FILES.
		STX	EXFILE	 	;CLEAR EXEC MATCH FLAG (HI BIT IS SIGNIFICANT)
FNDNAM1	STX	FROM+1	 	;(NO CONFLICT)
		LDA	REFNUMS-1,X	 	;LOAD NEXT REFNUM.
		JSR	CMPNAME	 	;GO COMPARE NAME ASSOCIATED WITH REFNUM.
		BNE	FNDNAM2	 	;BRANCH IF MISMATCH.
		LDX	FROM+1	 	;ALL CHARACTERS MATCH!!!
EXFOUND	LDA	REFNUMS-1,X	 	;GET REFNUM AGAIN.
CLSNONE	CLC				;INDICATE MATCH FOUND.
		RTS
   SPACE 2
FNDNAM2	LDX	FROM+1	 	;TRY NEXT FILENAME
		DEX				;IF ANY...
		BNE	FNDNAM1	 	;BRANCH IF MORE.
NOFILE	LDA	EXACTV	 	;IS AN EXEC FILE ACTIVE?
		BPL	NOFIL1	 	;BRANCH IF NOT.
		LDA	REFNUMS+7	 	;ELSE CHECK TO SEE IF IT'S THE EXEC FILE.
		JSR	CMPNAME
		BNE	NOFIL1	 	;BRANCH IF EXEC DIDN'T MATCH.
		LDA	#$FF	 		;SET FLAG THAT IT'S AN EXEC FILE MATCH.
		STA	EXFILE
		LDX	#8	 		;GIVE BACK PTR TO REFNUM & BUFADR.
		BNE	EXFOUND	 	;BRANCH ALWAYS TAKEN.
NOFIL1	LDA	#FNOPN	 	;REPORT FILE NOT OPEN.
		SEC
		RTS
	SPACE 2
	Title 'Compare Pathname'
********************* Compare Pathname **********************
* CMPNAME compares the Pathname (or at least the last 29	*
* characters) in TXBUF with names indexed by a reference	*
* number.  It returns the Z flag to indicate if a match:	*
*      Z = 0 - Match							*
*      Z <> 0 - No Match						*
*************************************************************
CMPNAME	ASL	A
		ASL	A
		ASL	A	 		;CALC POSITION IN TABLE.
		ASL	A
		ASL	A	 		;(REF 8=00)
		TAX
		LDA	FILNAMES,X	 	;GET PATHNAME'S TOTAL LENGTH.
		STA	DIRFLG	 	;SET JUST IN CASE OF MATCH.
		AND	#$7F	 		;STRIP DIRECTORY BIT.
		CMP	TXBUF2	 	;IS LENGTH THE SAME?
		BNE	CMPNAM3	 	;BRANCH IF NOT.
		TAY
		CMP	#$1E	 		;ONLY LOOK AT LAST 29 
		BCC	CMPNAM1	 	; CHARACTERS, BR IF LESS.
		LDA	#$1D	 
CMPNAM1	STA	FROM	 		;MOVE RECORD LENGTH IN
		LDA	FILNAMES+1,X	; ANTICIPATION OF A MATCH.
		STA	RECLEN
		LDA	FILNAMES+2,X
		STA	RECLEN+1
CMPNAM2	INX				;COMPARE CHARACTER BY CHARACTER.
		LDA	TXBUF2,Y
		CMP	FILNAMES+2,X
		BNE	CMPNAM3	 	;BRANCH IF MISMATCH.
		DEY
		DEC	FROM	 
		BNE	CMPNAM2	 	;LOOP UNTIL ALL COMPARED.
CMPNAM3	RTS				;RETURN EQUALS OR NOT EQUALS...
	SPACE 2
	TITLE	'CLOSE'	 
***************** CLOSE *************************
* CLOSE / CLOSALL ROUTINES				*
*************************************************
   SPACE 
CLOSE		LDA	FBITS	 		;WAS A PARTICULAR FILE SPECIFIED?
		AND	#FN1
		BEQ	CLOSALL	 	;BRANCH IF ALL FILES SHOULD BE CLOSED.
		JSR	FNDNAME	 	;GO LOOK UP FILE'S REFNUM & BUFFER ADDR.
	SPACE 2
		BCS	CLSNONE	 	;NOT OPEN, IGNORE... 
CLOSE1	STA	CFREFNUM
		LDA	BUFADRS-1,X	 	;RETURN BUFADR IN SYSBUFADR
		STA	SYSBUFADR
		BIT	EXFILE	 	;IF THIS IS AN EXEC FILE
		BMI	CLOSE2	 	; DON'T MESS WITH THE REFNUMS!
		LDY	OPENCNT
		PHA
		LDA	BUFADRS-1,Y
		STA	BUFADRS-1,X
		PLA
		STA	BUFADRS-1,Y	 	;SWAP THIS ADDRESS & REFNUM
		LDA	REFNUMS-1,X	 	; WITH LAST IN LIST (MAY ALREADY BE LAST).
		PHA
		LDA	REFNUMS-1,Y
		STA	REFNUMS-1,X
		PLA
		STA	REFNUMS-1,Y
CLOSE2	LDA	#$0	 		;HIGHEST PRIORITY CLOSE.
		STA	GLBLEVEL
		LDA	#CLOSCMD	 	;CALL MLI TO CLOSE THIS ONE.
		JSR	GOSYSTEM
	SPACE 2
		BCS	CLSERR
		JSR	FRESYSBUF	 	;RETURN BUFFER SPACE TO APPLESOFT.
		BIT	EXFILE	 	;CHECK FOR EXEC FILE CLOSE.
		BPL	CLOSE3	 	;BRANCH IF NOT EXEC.
		PHA				;SAVE PROBLEMS,IF ANY.
		LDA	#0	 		;CLEAR EXACTV, EXFILE FLAGS 
		STA	EXACTV
		STA	EXFILE
		PLA
		RTS
	SPACE 2
CLOSE3	DEC	OPENCNT
		RTS
   	SPACE 2
CLOSALL	LDX	OPENCNT	 	;LOOP THRU OPEN LIST.
		BEQ	CLOSDONE
		STX	EXFILE	 	;'CLOSALL' CAN'T MESS WITH EXEC FILES.
		LDA	REFNUMS-1,X
		JSR	CLOSE1	 	;SEND REFNUM
	SPACE
		BCC	CLOSALL	 
CLSERR	RTS
   SPACE 2
CLOSDONE	LDA	#0	 		;FORCE ALL OTHER FILES WITH LOW 
		STA	CFREFNUM	 	; PRIORITIES, CLOSED... 
		LDA	#$7
		STA	GLBLEVEL
		LDA	#CLOSCMD
		JMP	GOSYSTEM	 	;EXIT VIA 'GOSYSTEM'
	SPACE
	TITLE	'Position'
********************* Position ********************************
* POSITION moves the file pointer forward by counting CRs and *
*  skipping the data in between...					  *
* The number of CRs is set either by the R (VRECD) or the	  *
*   F (VFELD) parameter (but NOT both).  POSITION with a	  *
*   zero argument is a null operation.				  *
***************************************************************
	SPACE
POSITION	JSR	FNDNAME	 	;LOOK UP FILE IN ACTIVE LIST.
		BCS	PERRTN	 	;RETURN ERROR IF NOT FOUND.
		STA	RWREFNUM
		STA	NEWLREF
		BIT	DIRFLG	 	;IF DIRECTORY, IGNORE IT!
		BMI	RTNPOS	 	;EXIT WITH CARRY CLEAR (NO ERROR).
POSN0		LDA	FBITS+1	 	;MUST HAVE FIELD OR RECORD PARM.
		AND	#F+R
		BEQ	PPRMERR	 	;RETURN PARAMETER ERROR IF NOT.
		CMP	#F+R	 
		BEQ	PPRMERR	 	;ERROR IF BOTH PRESENT.
		AND	#R	 		;USE RECORD OR FIELD?
		BEQ	POSNF	 		;BRANCH IF FIELD.
		LDA	VRECD	 		; ELSE, COPY VALUES TO FIELD.
		STA	VFELD
		LDA	VRECD+1
		STA	VFELD+1
*
POSN1		EQU	*	 		;Bug fix 4/17/84. See note 8 lines down 
POSNF		LDA	#$EF
		STA	RWCOUNT	 	; AS A SUBROUTINE.
		LDA	#0
		STA	RWCOUNT+1	 	;READ TO NEXT CR OR 239 CHARACTERS.
		STA	RWDATA	 	;SET READ ADDRESS TO INPUT BUFFER.
		LDA	#2
		STA	RWDATA+1
		LDA	#$7F	 		;(Label POSN1 used to be here)
		STA	NLINENBL
		LDA	#NLINCMD	 	;SET NEWLINE TO CR BEFORE SKIPPING
		JSR	GOSYSTEM	 	; SPECIFIED LINE COUNT.
	SPACE
		BCS	PERRTN
POSN2		LDA	VFELD	 		;TEST FOR FINISHED... (ENTRY USED
		ORA	VFELD+1	 	; BY READ AND WRITE) 
		CLC				;ANTICIPATE GOOD FINISH.
		BEQ	RTNPOS
		LDA	#READCMD	 	;READ NEXT FIELD AND DISCARD.
		JSR	GOSYSTEM
	SPACE
		BCS	PERRTN	 	;RETURN ERRORS.
		LDA	VFELD	 		;DECREMENT COUNT.
		SBC	#0	 		;(CARRY CLEAR SUBTRACTS 1)
		STA	VFELD
		LDA	VFELD+1
		SBC	#0
		STA	VFELD+1
		BCS	POSN2	 		;BRANCH ALWAYS TAKEN.
PPRMERR	LDA	#ERRINVLD	 	;REPORT INVALID PARAMETERS
PERRTN	SEC
RTNPOS	RTS				;EXIT	 POSITION COMMAND.
	SPACE 2
	Title 'CALPOSN'
********************* CALPOSN *******************************
* CALPOSN MULTIPLYS 'RECLEN' WITH 'VRECD' AND STORES THE 	*
* RESULT IN 'SMARK'.  IF RESULT IS >2^24 A RANGE ERROR IS	*
* RETURNED.									*
*************************************************************
   SPACE 
CALPOSN	LDA	RECLEN	 	;MOVE RECORD LENGTH TO 'ACC'
		STA	ACCL	 		; IN WORK SPACE FOR CALCULATION.
		LDA	RECLEN+1
		STA	ACCM
		LDA	#0
		STA	ACCH
		STA	MODO	 		;THIS IS USED TO DETECT OVERFLOW.
		STA	SMARK
		STA	SMARK+1
		STA	SMARK+2	 	;ZERO RESULT
CALPSN1	LSR	VRECD+1	 	;DO THE OLD SHIFT AND ADD STUFF...
		ROR	VRECD
		LDX	#0
		BCC	CALPSN3	 	;BRANCH IF NO ADD
		CLC
CALPSN2	LDA	ACCL,X	 	;ADD CURRENT (POWER OF 2) VALUE
		ADC	SMARK,X	 	; TO ACCUMUALTING TOTAL IN 'SMARK'.
		STA	SMARK,X
		INX
		TXA				;TEST FOR ALL 24 BITS ADDED.
		EOR	#3	 		;IN SUCH A WAY AS TO NOT DISTURB CARRY.
		BNE	CALPSN2
		BCS	CPSNERR	 	;RETURN ERROR IF OVERFLOW.
		LDX	MODO	 		;WAS MORE THAN 24 BITS TO BE ADDED?
		BNE	CPSNERR
   SPACE 
CALPSN3	ROL	ACCL,X	 	;THIS LOOP SHIFTS LEFT ALL
		INX				;BITS IN ACCL, ACCM, ACCH, & MODO.
		TXA
		EOR	#4
		BNE	CALPSN3
		LDA	VRECD	 		;TEST FOR MORE TO MULTIPLY.
		ORA	VRECD+1
		BNE	CALPSN1
		CLC
		RTS				;ALL DONE WITH GOOD MULTIPY.
   SPACE 2
CPSNERR	LDA	#ERRANGE	 	;REPORT RANGE ERROR.
		SEC
		RTS
	SPACE 2
	TITLE	'READ & WRITE'
********************** READ & WRITE ****************************
* READ sets Input for Applesoft to Read from a File instead of *
*   keyboard or devices.  Parameters R, F, B are allowed (in   *
*   order of precedence) to position the file marker for the   *
*   next READ.								   *
* The L parameter will cause a READ of L bytes for each INPUT, *
*   with NEWLINE disabled and incoming strings to be preceeded *
*   by a Quote automatically.						   *
****************************************************************
	SPACE
READ		JSR	FNDNAME	 	;LOOK UP FILE NAME TO GET
		BCS	RRDERR	 	; RECORD LENGTH AND REFNUM.
		STA	RWREFNUM
		STA	SREFNUM
		STA	NEWLREF
		BIT	DIRFLG	 	;IS THIS FILE A DIRECTORY? 
		BMI	READC	 		; BRANCH IF YES.
* READ NON-DIRECTORY
		JSR	RNDPOSN	 	;GO POSITION TO R,F,B AS SPECD 
		BCS	RRDERR
		LDX	#$7F	 		;ANTICIPATE ENABLING NEWLINE.
		LDY	#$EF	 		; AND READING UP TO 239 CHARACTERS.
		LDA	FBITS+1	 	;TEST FOR 'L' PARM FOR NEWLINE
		AND	#L	 		; ENABLE AND READ LENGTH PER INPUT.
		BEQ	READ1
		LDY	VLNTH	 		;GET LENGTH OF READ.
		LDX	VLNTH+1	 	;(MUST BE ZERO) AND DISABLE NEWLINE.
		BNE	RDRNGERR	 	;BRANCH IF RANGE ERROR
		CPY	#$EF	 		;MUST BE LESS THAN 239.
		BCS	RDRNGERR
		LDA	#$22	 		;SET FIRST CHARACTER OF INPUT BUFFER
		STA	INLINE	 	; TO A QUOTE TO ALLOW COMMAS & COLENS.
		LDA	#1	 		;SET INPUT ADDR TO INLINE PLUS 1.
READ1		STA	RWDATA
		STY	RWCOUNT	 	;SET UP MLI PARMS.
		STX	NLINENBL
		LDA	#>INLINE
		STA	RWDATA+1
		LDA	#0
		STA	RWCOUNT+1
		LDA	#NLINCMD
		JSR	GOSYSTEM	 	;SET NEWLINE (OR RESET AS THE CASE MAY BE)
		BCS	RRDERR
READ2		LDA	#$FF
		STA	IFILACTV	 	;SET FLAGS FOR INPUT (READ).
RRDERR	RTS				;ALL	 DONE!!!
   SPACE 2
		
		;STA	RWREFNUM		Duplicated from above at "READ"
		;STA	SREFNUM	 	Duplicated from above at "READ" ;FOR GETMARK/SETMARK.
READC		LDA	#<CATBUF
		STA	RWDATA
		LDA	#>CATBUF
		STA	RWDATA+1	 	;USE CAT BUFFER FOR RAW ENTRIES.
		LDA	#1
		STA	CATFLAG	 	; IF NOT FIRST READ, GIVE CR INSTEAD OF HEADER.
		LDA	FBITS+1	 	;CHECK ONLY FOR 'R' PARM TO REWIND DIRECTORY.
		AND	#R
		CLC				;ANTICIPATE	 NO ERRORS. 
		BEQ	READ2	 
		LDA	#0	 		;SET FILE POSITION TO ZERO.
		STA	SMARK
		STA	SMARK+1
		STA	SMARK+2
		LDA	#SMRKCMD	 	;SET NEW MARK FOR FILE.
		JSR	GOSYSTEM
		BCS	RDCATERR
		LDA	#$FF
		STA	IFILACTV	 	;SET FLAGS FOR INPUT (READ).
RDCATERR	RTS				;ALL DONE!!!
	SPACE 2
RDRNGERR	LDA	#ERRANGE	 	;REPORT FILE POSITION INVALID.
		TAX				;RETURN IN BOTH A & X.
		SEC
		RTS
	SPACE 2
RNDPOSN	LDA	FBITS+1	 	;TEST FOR RECORD, FIELD, AND BYTE POSITION
		AND	#R+F+B	 	; OFFSETS.
		BEQ	RNDP4	 		;BRANCH IF NO POSITIONING NEEDED.
		AND	#R	 		;WAS A RECORD SPECIFED?
		BEQ	RNDP1	 		;BRANCH IF NOT.
		JSR	CALPOSN	 	;CALCULATE ABS FILE POSN (RECLEN*VRECD).
		BCS	RDRNGERR	 	;BRANCH IF TOO BIG!
RNDPOS0	JSR	GOSMARK	 	;SET FILE MARK TO RECORD 'VRECD'.
	SPACE
		BCS	RNDPERR	 	;BRANCH IF PROBLEMS...
RNDP1		LDA	FBITS+1
		AND	#F	 		;MUST SOME FIELDS BE SKIPPED?
		BEQ	RNDP2	 		;BRANCH IF NOT.
		JSR	POSN1	 		;ELSE, READ & SKIP 'VFELD' FIELDS.
	SPACE
		BCS	RNDPERR	 
RNDP2		LDA	FBITS+1	 	;LASTLY, TEST FOR BYTE OFFSET PARM.
		AND	#B
		BEQ	RNDP4	 		;BRANCH IF NO 'B' PARM.
		LDA	#GMRKCMD	 	;ELSE ADD VBYTE TO SMARK TO FORM NEW SMARK.
		JSR	GOSYSTEM
	SPACE
		BCS	RNDPERR
		LDX	#0
		LDY	#2
RNDP3		LDA	VBYTE,X
		ADC	SMARK,X
		STA	SMARK,X
		INX
		DEY
		BPL	RNDP3	 
		BCS	RDRNGERR	 	;BRANCH IF >$FFFFFF
GOSMARK	LDA	#SMRKCMD	 	;SET NEW MARK FOR FILE.
		JSR	GOSYSTEM
	SPACE
		BCS	RNDPERR	 
RNDP4		CLC
RNDPERR	LDX	#0
		RTS
	SPACE 2
	Title 'Write Positions'
*************************************************************
* WRITE POSITIONS THE FILE TO SPECIFIED 'R'+'F'+'B'		*
* AND SETS PROGRAM OUTPUT TO DIRECT CHARACTERS TO THE FILE. *
*************************************************************
   	SPACE
WRITE		JSR	FNDNAME	 	;LOOK UP FILE NAME FOR REFNUM.
		BCS	WWRTERR	 	;PASS BACK ERRORS.
		STA	RWREFNUM
		STA	SREFNUM
		STA	NEWLREF
		BIT	DIRFLG	 	;CAN'T WRITE TO DIRECTORIES!
		BPL	WRITE1	 	;BRANCH IF NOT DIR.
		LDA	#LOCKED	 	;REPORT ILLEGAL ACCESS.
WWRTERR	SEC
		RTS
   SPACE 2
WRITE1	LDA	#<INLINE	 	;FOR POSITIONING, USE INPUT BUFFER. 
		STA	RWDATA
		LDA	#>INLINE
		STA	RWDATA+1
		JSR	RNDPOSN	 	;GO POSITION FILE MARKER. 
		BCC	WRITE3	 	;BRANCH IF NO PROBLEMS... 
		CMP	#ERRANGE	 	;OUT OF RANGE OF FILE?
		BNE	WWRTERR	 	;BRANCH IF SOME OTHER PROBLEM.
		CPX	#ERRANGE	 	;WAS 'RANGERR' NOT FROM MLI?
		BEQ	WWRTERR
WRITE2	LDA	#SEOFCMD	 	;EXTEND EOF TO NEW POSITION.
		JSR	GOSYSTEM
		BCS	WWRTERR
		JSR	RNDPOS0	 
		BCS	WWRTERR	 	;REPORT ANY ERRORS HERE. 
WRITE3	LDA	HIMEM	 		;SET WRITE BUFFER ABOVE APPLESOFT AREA.
		STA	RWDATA
		LDA	HIMEM+1
		STA	RWDATA+1
		LDA	#$FF	 		;LASTLY, SET 'OUTPUT FILE ACTIVE' FLAG.
		STA	OFILACTV
		CLC
		RTS
	SPACE 2
	TITLE	'APPEND'	 
*********************** APPEND ******************************
* APPEND Opens a file, Positions to EOF or the Record after *
*   the last, and enables WRITE MODE for Program output.    *
*************************************************************
	SPACE
APPEND	PHP				;SAVE	 STATUS OF FILE FOUND.
		JSR	FNDNAME	 	;DETERMINE IF FILE IS ALREADY OPEN.
		BCC	APEND1	 	;BRANCH IF FILE ALREADY OPEN.
		PLP				;SEND	 FILE FOUND STATE TO OPEN.
		JSR	OPEN	 		;GO OPEN FILE IF POSIBLE.
		BCS	APNDERR	 	;RETURN ERRORS.
		LDA	OREFNUM	 	;GET FILE REFNUM.
		BNE	APEND2	 	;BRANCH ALWAYS
		DC.B	$00	 		; NEVER!
APEND1	PLP				;THROW AWAY RESULT OF LOOKING UP FILE ON DISK
APEND2	STA	RWREFNUM	 	;REFNUM IN A-REG.
		STA	SREFNUM	 	;(FOR SETMARK, SETEOF)
		BIT	DIRFLG	 	;CAN'T WRITE TO A DIRECTORY!
		BPL	APEND3	 	;BRANCH IF NOT DIRECTORY.
		LDA	#LOCKED
APNDERR	SEC
		RTS
	SPACE 2
APEND3	LDX	VLNTH	 		;GET RECORD LENGTH
		LDY	VLNTH+1	 	;USE USER SPECIFIED.
		LDA	FBITS+1
		AND	#L	 		;UNLESS NONE SPECIFIED.
		BNE	APEND4	 	;BRANCH IF USER DID SPECIFY.
		LDX	FIAUXID	 	;ELSE, USE DEFAULT VALUES.
		LDY	FIAUXID+1
APEND4	TXA
		PHA				;SAVE	 LOW RECLEN FOR NOW.
		LDA	RWREFNUM	 	;GET REFNUM TO INDEX FILENAMES
		LSR	A
		ROR	A
		ROR	A
		ROR	A	 		;(BELIEVE IT OR NOT, MULTIPIES BY 32)
		TAX
		PLA				;STORE RECORD LENGTH WITH FILENAME & IN RECLEN.
		STA	FILNAMES+1,X
		STA	RECLEN
		TYA
		STA	FILNAMES+2,X
		STA	RECLEN+1	 	;THIS MAY BE REDUNDANT, BUT NECESSARY.
		LDA	#GEOFCMD	 	;GET CURRENT EOF VALUE.
		JSR	GOSYSTEM
		BCS	APNDERR
		LDA	RECLEN+1	 	;NOW DETERMINE IF NEW EOF SHOULD BE SET.
		BNE	APEND5	 	;BRANCH IF DEFINITELY YES.
		LDA	RECLEN
		CMP	#2	 		;IF 1 OR 0, CURRENT EOF WILL DO.
		BCC	APEND6
APEND5	JSR	CALCEOF	 	;GO FIGURE OUT NEW EOF.
		BCS	APNDERR
APEND6	JMP	WRITE2	 	;FINISH WITH WRITE ROUTINES.
	
CALCEOF	LDX	#3	 		;MOVE CURRENT EOF TO SAFER PLACE.
CCEOF1	LDA	SMARK-1,X
		STA	ACCL-1,X
		DEX
		BNE	CCEOF1
		STX	MODO	 		;SET MODOULO TO ZERO.
		STX	MODOH
		LDY	#$18	 		;COUNT FOR 24 BIT DIVIDE (BY 16 BITS).
CCEOF2	JSR	SHFT24	 	;Shift 24 bit ACC left
		ROL	MODO	 		;See Apple II Monitor Rom Listing for an 
		ROL	MODOH	 		;  explanation of this divide routine 
		SEC
		LDA	MODO	 
		SBC	RECLEN
		TAX
		LDA	MODOH	 		;(RESULT OF DIVIDE IS SHIFTED IN TO ACC
		SBC	RECLEN+1	 	; AS THE ORIGINAL VALUE IS SHIFTED
		BCC	CCEOF3	 	; THRU MODO.  ANY LEFTOVERS, OR MODOULO
		STX	MODO	 		; ARE LEFT IN 'MODO' AFTER LAST SHIFT.
		STA	MODOH
		INC	ACCL	 		;(SETS LOWEST BIT TO '1', BECAUSE OF ABOVE SHIFT)
CCEOF3	DEY
		BNE	CCEOF2	 	;LOOP THRU 24 BITS.
		LDA	MODO	 		;TEST FOR NEED OF ADJUSTMENT.
		ORA	MODOH
		CLC
		BEQ	CCEOF4	 	;BRANCH IF EOF ON RECORD BOUNDARY
		LDA	RECLEN	 	; NEWEOF=RECLEN-MODO+OLDEOF
		SEC
		SBC	MODO
		TAX
		LDA	RECLEN+1
		SBC	MODOH
		TAY
		TXA
		CLC
		ADC	SMARK
		STA	SMARK
		TYA
		ADC	SMARK+1
		STA	SMARK+1
		LDA	SMARK+2
		ADC	#0	 		;THAT SHOULD ABOUT DO IT...
		STA	SMARK+2
		LDA	#ERRANGE	 	;GET ERROR CODE JUST IN CASE OF OVERFLOW.
CCEOF4	RTS				;CARRY DETERMINES IF ERROR VALID!!!
	SPACE 2

	TITLE	'Set/Get File Info'	 
********************** Set/Get File Info **************************
* GOGETINFO and GOSETINFO use the same parameter SPACE, but		*
* with different parameter counts.  Also, Dates must be zeroed    *
* before the call to SETINFO.							*
*******************************************************************
	SPACE
GOGETINFO	LDA	#$A	 		;SET PARM COUNT TO 10
		STA	SSGINFO	 	; TO MAKE IT A VALID CALL.
		LDA	#GFINFO
		BNE	GGSINF	 	;EXECUTE REQUEST.
   SPACE
GOSETINFO	EQU	*
		LDA	#0	 		;ZERO MODO DATE/TIME
		STA	FIMDATE
		STA	FIMDATE+1
		STA	FIMDATE+2
		STA	FIMDATE+3
GSINFO1	LDA	#7	 		;ONLY 7 PARMS FOR SET FILE INFO.
GSINFO2	STA	SSGINFO
		LDA	#SFINFO
GGSINF	JMP	GOSYSTEM	 	;EXECUTE REQUEST.

	Title 'Hooks'
****************'Hooks'**********************************
		EXPORT DOSOUT
DOSOUT	JMP	(VSYSIO)
		EXPORT DOSINP
DOSINP	JMP	(VSYSIO+2)
SYSIO		EQU	*
		DC.W	IMMEDOUT	 
		DC.W	IMINP	 		;STATE = 0
*
		DC.W	DFOUT
		DC.W	DFINP	 		;STATE = 4
*
		DC.W	CMDOUT
		DC.W	DFINP	 		;STATE = 8
CKDADDR	DC.W	OUTCKD


	Title 'TABLES'
*****************'TABLES'***********************************
* Table of System Calls						     *
************************************************************
		EXPORT SYSCTBL
SYSCTBL	
		DC.B	SCREATE,SDSTROY,SRENAME,SSGINFO	  
		DC.B	SSGINFO,SONLINE,SSGPRFX,SSGPRFX	 
		DC.B	SOPEN,SNEWLIN,SREAD,SWRITE
		DC.B	SCLOSE,SFLUSH,SSETMRK,SGETMRK
		DC.B	SSETEOF,SGETEOF,SSETBUF,SGETBUF
*
TOKTBL	EQU	*	 		;Table of Applesoft commands (tokens)
		DC.B	$80,$81,$82,$83	 		;END,FOR,NEXT,DATA 
		DC.B	$84,$85,$86,$87	 		;INPUT,DEL,DIM,READ 
		DC.B	$88,$89,$8A,$8B	 		;GR,TEXT,PR#,IN# 
		DC.B	CALL-PRINT,$8D,$8E,$8F	 	;CALL,PLOT,HLIN,VLIN 
		DC.B	$90,$91,$92,$93	 		;HGR2,HGR,HCOLOR,HPLOT 
		DC.B	$94,$95,$96,$97	 		;DRAW,XDRAW,HTAB,HOME 
		DC.B	$98,$99,$9A,TRACE-PRINT	 	;ROT=,SCALE=,SHLOAD,TRACE 
		DC.B	NOTRACE-PRINT,NORMAL-PRINT,INVERSE-PRINT,FLASH-PRINT	 
		DC.B	$A0,$A1,$A2,$A3	 		;COLOR=,POP,VTAB,HIMEM: 
		DC.B	$A4,$A5,RESUME-PRINT,$A7	;LOMEM:,ONERR,RESUME,RECALL 
		DC.B	$A8,$A9,LET-PRINT,$AB	 	;STORE,SPEED=,LET,GOTO 
		DC.B	$AC,IF-PRINT,$AE,$AF	 	;RUN,IF,RESTORE,& 
		DC.B	$B0,$B1,$B2,$B3	 		;GOSUB,RETURN,REM,STOP 
		DC.B	$B4,$B5,$B6,$B7	 		;ON,WAIT,LOAD,SAVE 
		DC.B	$B8,$B9,PRINT-PRINT,$BB	 	;DEF,POKE,PRINT,CONT 
		DC.B	LIST-PRINT,$BD,$BE,$BF	 	;LIST,CLEAR,GET,NEW 
	SPACE 2
	Title 'SRCHTBL'
*******************************************************************
* SRCHTBL provides a relative offset into XCMDS table (below)	*
*  for each command.  The offset points to the last character	*
*  of the command string.  In addition, the high bit indicates	*
*  the last command of each group (the table is used in		*
*  decending order by SRCHCMD).  The groups are according to	*
*  command string length.							*
*******************************************************************
CMDCNT	EQU	$1F	 			;Highest command number (0-31)
*
SRCHTBL	EQU	*	 			;CI-COMMAND NUMBER 
		DC.B	XIN-XCMDS+2	  		;"IN#"=1 
		DC.B	XPR-XCMDS+2	  		;"PR#"=2
		DC.B	XCAT-XCMDS+2	 	;"CAT"=3 
		DC.B	XFRE-XCMDS+2	 	;"FRE"=4 
		DC.B	XBYE-XCMDS+2	 	;"BYE"=5
		DC.B	XRUN-XCMDS+$82	 	;"RUN"=6 
*
		DC.B	XBRUN-XCMDS+3	 	;"BRUN"=7 
		DC.B	XEXEC-XCMDS+3	 	;"EXEC"=8
		DC.B	XLOAD-XCMDS+3	 	;"LOAD"=9 
		DC.B	XLOCK-XCMDS+3	 	;"LOCK"=A
		DC.B	XOPEN-XCMDS+3	 	;"OPEN"=B
		DC.B	XREAD-XCMDS+3	 	;"READ"=C
		DC.B	XSAVE-XCMDS+$83	 	;"SAVE"=D
*
		DC.B	XBLOAD-XCMDS+4	 	;"BLOAD"=E
		DC.B	XBSAVE-XCMDS+4	 	;"BSAVE"=F
		DC.B	XCHAIN-XCMDS+4	 	;"CHAIN"=10
		DC.B	XCLOSE-XCMDS+4	 	;"CLOSE"=11
		DC.B	XFLUSH-XCMDS+4	 	;"FLUSH"=12
		DC.B	XNOMON-XCMDS+4	 	;"NOMON"=13
		DC.B	XSTORE-XCMDS+4	 	;"STORE"=14
		DC.B	XWRITE-XCMDS+$84	 	;"WRITE"=15 
*
		DC.B	XAPPEND-XCMDS+5	 	;"APPEND"=16 
		DC.B	XCREATE-XCMDS+5	 	;"CREATE"=17
		DC.B	XDELETE-XCMDS+5	 	;"DELETE"=18 
		DC.B	XPREFIX-XCMDS+5	 	;"PREFIX"=19 
		DC.B	XRENAME-XCMDS+5	 	;"RENAME"=1A 
		DC.B	XUNLOCK-XCMDS+5	 	;"UNLOCK"=1B 
		DC.B	XVERIFY-XCMDS+$85	 	;"VERIFY"=1C 
*
		DC.B	XCATLOG-XCMDS+6	 	;"CATALOG"=1D 
		DC.B	XRSTORE-XCMDS+$86	 	;"RESTORE"=1E 
*
		DC.B	XPOSION-XCMDS+$87	 	;"POSITION"=1F 
							;"-" (SMART RUN) =20 
	Title 'XCMDS'
******************************* XCMDS *****************************
* XCMDS is an ASCII list of the commands in no particular		*
*  order.  Some characters overlap, though the savings in memory	*
*  is not that big a deal...							*
*******************************************************************
		MSB	OFF
XCMDS		EQU	*
XBSAVE	DC.B	'B'
XSAVE		DC.B	'SA'
XVERIFY	DC.B	'VERIFY'
XBLOAD	DC.B	'B'
XLOAD		DC.B	'LOA'
XDELETE	DC.B	'DELETE'
XBYE		DC.B	'BYE'
XCAT		EQU	*
XCATLOG	DC.B	'CATALOG'
XOPEN		DC.B	'OPEN'
XWRITE	DC.B	'WRIT'
XEXEC		DC.B	'EXE'
XCREATE	DC.B	'CREATE'
XFRE		DC.B	'F'
XRSTORE	DC.B	'RE'
XSTORE	DC.B	'STO'
XRENAME	DC.B	'RENAME'
XBRUN		DC.B	'B'
XRUN		DC.B	'R'
XUNLOCK	DC.B	'UN'
XLOCK		DC.B	'LOCK'
XCHAIN	DC.B	'CHA'
XIN		DC.B	'IN#'
XFLUSH	DC.B	'FLUSH'
XREAD		DC.B	'READ'
XPOSION	DC.B	'POSITIO'
XNOMON	DC.B	'NOMON'
XPR		DC.B	'PR#'	 
XPREFIX	DC.B	'PREFIX'
XCLOSE	DC.B	'CLOSE'
XAPPEND	DC.B	'APPEND'
	
	Title 'CMDEXEC'
***************************** CMDEXEC *****************************
* CMDEXEC is the dispatch table for the commands after parameters	*
*  have been processed by CMDSYN.						*
*******************************************************************
CMDEXEC	EQU	*	 			;EXTERNAL COMMAND=0 
		DC.W	USRCMD
		DC.W	INNUM	 			;"IN#"=1 
		DC.W	PRNUM	 			;"PR#"=2 
		DC.W	CAT	 			;"CAT"=3 
		DC.W	COLLECT	 		;"FRE"=4 
		DC.W	BYE	 			;"BYE"=5
		DC.W	RUN	 			;"RUN"=6 
	SPACE 
		DC.W	BRUN	 			;"BRUN"=7 
		DC.W	EXEC	 			;"EXEC"=8 
		DC.W	LOAD	 			;"LOAD"=9 
		DC.W	LOCK	 			;"LOCK"=A 
		DC.W	OPEN	 			;"OPEN"=B  
		DC.W	READ				;"READ"=C 
		DC.W	SAVE	 			;"SAVE"=D 
	SPACE
		DC.W	BLOAD	 			;"BLOAD"=E 
		DC.W	BSAVE	 			;"BSAVE"=F
		DC.W	CHAIN	 			;"CHAIN"=10
		DC.W	CLOSE	 			;"CLOSE"=11 
		DC.W	FLUSH	 			;"FLUSH"=12 
		DC.W	OLDCMD	 		;"NOMON"=13 
		DC.W	STORE	 			;"STORE"=14 
		DC.W	WRITE	 			;"WRITE"=15 
	SPACE 
		DC.W	APPEND	 		;"APPEND"=16 
		DC.W	CREATE	 		;"CREATE"=17 
		DC.W	DELETE	 		;"DELETE"=18 
		DC.W	PREFIX	 		;"PREFIX"=19 
		DC.W	RENAME	 		;"RENAME"=1A 
		DC.W	UNLOCK	 		;"UNLOCK"=1B 
		DC.W	VERIFY	 		;"VERIFY"=1C 
	SPACE
		DC.W	CATALOG	 		;"CATALOG"=1D 
		DC.W	RESTORE	 		;"RESTORE"=1E 
	SPACE
		DC.W	POSITION	 		;"POSITION"=1F 
		DC.W	DASH	 			;(SMART RUN)=20 
	
CPBITS	EQU	*	 			;COMMAND PARAMETER TABLE 
		DC.B	SLOT,AD	 		;"IN#" 
		DC.B	SLOT,AD	 		;"PR#" 
		DC.B	PFIX+T+FNOPT+FN1,SD	;"CAT" 
		DC.B	$00,$0	 		;"FRE" 
		DC.B	$0,$0	 			;bye
		DC.B	FNOPT+FN1,LINE+SD	 	;"RUN" 
	SPACE
		DC.B	FN1,AD+B+L+E+SD	 	;"BRUN" 
		DC.B	FN1,F+R+SD	 		;"EXEC" 
		DC.B	FN1,SD	 		;"LOAD" 
		DC.B	FN1,SD	 		;"LOCK" 
		DC.B	RRUN+CRFLG+FN1+T,L+SD	;"OPEN"  
		DC.B	RRUN+FN1,R+F+B+L	 	;"READ" 
		DC.B	CRFLG+FN1,SD	 	;"SAVE" 
	SPACE
		DC.B	FN1+T,AD+B+L+E+SD	 	;"BLOAD" 
		DC.B	CRFLG+FN1+T,AD+B+L+E+SD	;"BSAVE" 
		DC.B	FN1,LINE+SD	 		;"CHAIN" 
		DC.B	FN1,0	 			;"CLOSE" 
		DC.B	FN1,0	 			;"FLUSH" 
		DC.B	$00,$0	 		;"NOMON" 
		DC.B	CRFLG+FN1,SD	 	;"STORE" 
		DC.B	RRUN+FN1,R+F+B	 	;"WRITE" 
	SPACE
		DC.B	RRUN+CRFLG+FN1+T,L+SD	;"APPEND" 
		DC.B	CRFLG+FN1+T,SD	 	;"CREATE" 
		DC.B	FN1,SD	 		;"DELETE" 
		DC.B	PFIX+FNOPT+FN1,SD	 	;"PREFIX" 
		DC.B	FN1+FN2,SD	 		;"RENAME" 
		DC.B	FN1,SD	 		;"UNLOCK" 
		DC.B	FNOPT+FN1,SD	 	;"VERIFY" 
	SPACE 
		DC.B	PFIX+T+FNOPT+FN1,SD	;"CATALOG" 
		DC.B	FN1,SD	 		;"RESTORE" 
	SPACE
		DC.B	RRUN+FN1,F+R	 	;"POSITION" 
		DC.B	FN1,SD	 		;"-" (SMART RUN) 
	
	Title 'Parameter Tables'
************************ Parameter Tables *******************
* PTOK, PTOKBIT, and PCELL are lookup tables for processing	*
*    Parameter Tokens. 							*
*************************************************************
PTOK		DC.B	'ABELSDFRV@'
	SPACE
PTOKBIT	DC.B	AD,B,E,L,SD	 
		DC.B	SD,F,R,V,LINE	 
	SPACE
PCELL	EQU	*
		DC.B	$5,$12,$19,$21,$24	 
		DC.B	$28,$31,$39,$40,$45	 

****************************************************************
*  RTYP and ASCTYP tables are used in Command Syntaxing the	   *
*  T parameter and by the CATASC routine that converts 	   *
*  a Directory entry into human readable stuff... 		   *
*  ASCMON and ASCNODT are used only by CATASC for date fields. *
****************************************************************
RTYP		DC.B	TSYS,TREL,TVAR,TBAS,TIVR	 
		DC.B	TINT,TCMD,TDIR,TBIN,TTXT
		DC.B	TPAS,TAWP,TASP,TADB,TS16
TYPNUM	EQU	*-RTYP	 		;Number of recognized file types
	SPACE
		MSB	ON
ASCTYP	DC.B	'S16ADBASPAWPPAS'
		DC.B	'TXTBINDIRCMDINT'
		DC.B	'IVRBASVARRELSYS'	 
	SPACE
ASCMON	DC.B	'JANFEBMARAPRMAYJUN'
		DC.B	'JULAUGSEPOCTNOVDEC'
ASCNODT	DC.B	'<NO DATE>'

	Title 'MLI & CI Error Table'
************************ MLI & CI ERROR ***********************
* 'MLIERTBL' AND 'CIERRTBL' ARE USED AS LOOKUP TABLES TO MAP  *
*  MLI ERRORS TO CI EQUIVALENT ERROR CODES.			  *
***************************************************************
		EXPORT MLIERTBL
MLIERTBL
		DC.B	$28,$2B,$40,$41,$42,$43,$44,$45,$46	 
		DC.B	$47,$48,$49,$4B,$4C,$4D,$4E,$50,$53,$56
		
		EXPORT CIERRTBL
CIERRTBL	
		DC.B	$03,$04,$10,$0C,$0C,$12,$06,$06,$07	 
		DC.B	$13,$09,$11,$0D,$05,$02,$0A,$14,$0B,$0C,$08	 
   
***************************************************************
* 'ERRTBL' IS AN RELITIVE INDEX TABLE INTO			  *
* 'ERRSTR' (BELOW) FOR EACH ERROR MESSAGE				  *
***************************************************************
ERRTBL	EQU	*
		DC.B	ERR2-ERR,ERR3-ERR
		DC.B	ERR4-ERR,ERR5-ERR,ERR6-ERR
		DC.B	ERR6-ERR,ERR8-ERR,ERR9-ERR
		DC.B	ERR10-ERR,ERR11-ERR,ERR12-ERR
		DC.B	ERR13-ERR,ERR14-ERR,ERR15-ERR
		DC.B	ERR16-ERR,ERR17-ERR,ERR18-ERR
		DC.B	ERR19-ERR,ERR20-ERR,ERR21-ERR
   
***************************************************************
* 'EASCON' CONTAINS THE ASCII EQUIVALENT FOR EACH 4 OR 8 BIT  * 
*  VALUE CONTAINED IN THE 'ERRSTR' TABLE.  SEE 'PRINTERR'	  *
*  FOR ADDITIONAL DETAILS...						  *
***************************************************************
EASCON	EQU	*
		DC.B	'ACDEFILMNORTU '
		DC.B	$00,$00
		DC.B	'BGHKPSVWXY/().:'
	
***************************************************************
* 'ERRSTR' IS A COMPACT CODING OF ALL CI ERROR MESSAGES. 	  * 
*  THE TRANSLATION IS DONE BY 'PRINTERR' ROUTINE. ALSO 	  *
*  INCLUDED ARE CONDENSED THE COPYRIGHT NOTICE AND CATALOG	  *
*  HEADER AND TRAILER.							  *
***************************************************************
ERRSTR	EQU	*
ERR		EQU	*
	SPACE
COPYRIGHT	EQU	*-ERR	 	;"COPYRIGHT APPLE COMPUTER" 
		DC.B	$2A,$05,$0A,$B6,$02,$03,$CE,$10,$50,$57,$4E,$2A,$80,$5D,$C4,$BF	 
HEAD		EQU	*-ERR	 	;CATALOG HEADER (VALUES NOT IN HEX ARE COLUMN #S). 
		DC.B	$E9,$18,$4E,$00,16,$C0,$A0,$54,$EE,$01,$7A,$20,$40,$6E,$00,30
		DC.B	$8A,$36,$56,$43,$00,47,$2B,$41,$C4,$3E,$00,64,$49,$35,$67,$4E
		DC.B	$06,$D0,$1C,$0A,$05,$4F
TAIL		EQU	*-ERR	 	;CATALOG TRAILER (VALUES NOT IN HEX ARE COLUMN #S). 
		DC.B	$01,$7A,$20,$40,$6E,$5B,$44,$0F,$00,22,$01,$7A,$20,$40,$6E
		DC.B	$D0,$64,$30,$FE,$00,44,$CA,$C1,$7E,$01,$7A,$20,$40,$60,$FF
ERR2			 		;"RANGE ERROR(CR)" 
		DC.B	$B1,$90,$24,$E4,$BB,$AB,$F0	 
ERR3			 		;"NO DEVICE CONNECTED(CR)
		DC.B	$9A,$E3,$40,$76,$24,$E2,$A9,$94,$2C,$43,$F0
ERR4			 		;"WRITE PROTECTED(CR)"
		DC.B	$08,$B6,$C4,$E0,$5B,$AC,$42,$C4,$3F
ERR5			 		;"END OF DATA(CR)"
		DC.B	$49,$3E,$A5,$E3,$1C,$1F
ERR6			 		;"PATH NOT FOUND(CR)"
		DC.B	$05,$1C,$03,$E9,$AC,$E5,$AD,$93,$F0
ERR8			 		;"I/O ERROR(CR)" 
		DC.B	$60,$BA,$E4,$BB,$AB,$F0	 
ERR9			 		;"DISK FULL(CR)" 
		DC.B	$36,$06,$04,$E5,$D7,$7F	 
ERR10			 		;"FILE LOCKED(CR)" 
		DC.B	$56,$74,$E7,$A2,$04,$43,$F0
ERR11			 		;"INVALID PARAMETER(CR)" 
		DC.B	$69,$07,$17,$63,$E0,$51,$B1,$84,$C4,$BF	 
ERR12			 		;"NO BUFFERS AVAILABLE(CR)"
		DC.B	$9A,$E0,$1D,$55,$4B,$06,$E1,$07,$16,$71,$01,$74,$F0
ERR13			 		;"FILE TYPE MISMATCH(CR)" 
		DC.B	$56,$74,$EC,$0A,$05,$4E,$86,$06,$81,$C2,$03,$F0
ERR14			 		;"PROGRAM TOO LARGE(CR)"
		DC.B	$05,$BA,$02,$B1,$8E,$CA,$AE,$71,$B0,$24,$F0
ERR15			 		;"NOT DIRECT COMMAND(CR)"
		DC.B	$9A,$CE,$36,$B4,$2C,$E2,$A8,$81,$93,$F0
ERR16			 		;"SYNTAX ERROR(CR)"
		DC.B	$06,$0A,$9C,$10,$9E,$4B,$BA,$BF	 
ERR17			 		;"DIRECTORY FULL(CR)"
		DC.B	$36,$B4,$2C,$AB,$0A,$E5,$D7,$7F	 
ERR18			 		;"FILE NOT OPEN(CR) 
		DC.B	$56,$74,$E9,$AC,$EA,$05,$49,$F0	 
ERR19			 		;"DUPLICATE FILE NAME(CR)"
		DC.B	$3D,$05,$76,$21,$C4,$E5,$67,$4E,$91,$84,$F0
ERR20			 		;"FILE BUSY(CR)"
		DC.B	$56,$74,$E0,$1D,$06,$0A,$F0
ERR21			 		;"FILE(S) STILL OPEN(CR)"
		DC.B	$56,$74,$0C,$06,$0D,$E0,$6C,$67,$7E,$A0,$54,$9F	 
	SPACE 2
PAGES		DC.B	0,0	 
OLDHIMEM	DC.B	0,0	 
;RNFLG		DC.B	0	Was used in EDASM but doesn't appear anywhere in MPW
 
	SPACE
	TITLE 'MONITOR COMMAND ADDED HERE'
****************************  MONITOR COMMAND *********************************
SRCHCMD1	LDY	#3-1	 			;length of command name 
@LOOP		LDA	TXBUF,Y	 		;load text buffer    
		CMP	@STRING,Y	 		;does it compare to MTR command
		BNE	@CLSRCH	 		;no so return to normal commands
		DEY
		BPL	@LOOP	 			;continue to compare all characters
		JSR	SETSYSIO			;make sure hooks are set correctly
		JSR	CLEOL				;Clear to end of line on MTR command
		JMP	$FF69	 			;MTR command valid so go to monitor
@CLSRCH	JMP	SRCHCMD			;return to normal commands
		MSB	OFF
@STRING	DC.B	'MTR'	 			;Monitor command syntax
************************** MONITOR COMMAND END *********************************

ZCILEFT	EQU	$BC7a-*	 		;REMAINING SPACE FOR ADDED CODE HAS
							;DC.B	$0 ;was included here in EDASM				
		
		EXPORT VERNUM
VERNUM	DC.B	$05	 			;Revision number
CHIMEM	DC.B	$0
BUFBOT	DC.B	$0
GPBUF		DC.B	$00	 
BUFLEN	DC.B	$4	 
GARBOT	DC.B	$0
GARTOP	DC.B	$0
END_LOW	DC.B	0	 
MEMCHK	DC.B	$0
MEMBOT	DC.W	$800	 
MEMTOP	DC.W	$9600	 
STROFF	DC.B	0
SYSBUFADR	DC.B	0
OVLEN		DC.W	0
OASTRT	DC.W	0
OHIMEM	DC.B	0
PACKADR	DC.W	0
PACKLEN	DC.W	0
CNTLO		DC.W	$0000
CNTHI		EQU	CNTLO+1
BUFADRS	DS.B	8	 
REFNUMS	DS.B	8	
RECLEN	DC.W	0
OSAVX		DC.B	0
OSAVY		DC.B	0
		EXPORT CALLX
CALLX		DC.B	0
IOPTR		EQU	*
SKPCHR	DC.B	0
TCNT		DC.B	0
EXADR		DC.W	0	 			;ADDRESS OF COMMAND TO BE EXECUTED.
PBYTES	DC.B	0
PCADR		DC.B	0
ACCL		DC.B	0
ACCM		DC.B	0
ACCH		DC.B	0
MODO		DC.B	0
MODOH		EQU	*
MONTH		DC.B	0
DAY		DC.B	0
YEAR		DC.B	0
STRLEN	DC.B	0
ENTLEN	DC.B	$00
MAXENT	DC.B	$00
TOTENT	DC.W	$0000
CURRENT	DC.B	$00
		DC.B	$00	 		;FOR TXBUF-1
		EXPORT TXBUF		
TXBUF		DS.B	$41 
FILNAMES	DS.B	$A7			;Storage space for open files and pathnames
ZCIEND	EQU	*	
*
* LS is CAT (40 columns). PFX is PREFIX. SRCHCMD jumps here only
* when the built-in table missed, so CAT, CATALOG, and PREFIX still win.
*
		EXPORT ALIASCMD
ALIASCMD	LDX	#1			;LS, XLEN = length-1
		LDY	#3			;CAT
		LDA	TXBUF
		CMP	#$4C			;'L'
		BNE	@ALSPFX
		LDA	TXBUF+1
		CMP	#$53			;'S'
		BNE	@ALSNO
		LDA	TXBUF+2
		JMP	@ALSTERM
@ALSPFX		LDX	#2			;PFX, XLEN = length-1
		LDY	#CIPRFX		;PREFIX
		LDA	TXBUF
		CMP	#$50			;'P'
		BNE	@ALSNO
		LDA	TXBUF+1
		CMP	#$46			;'F'
		BNE	@ALSNO
		LDA	TXBUF+2
		CMP	#$58			;'X'
		BNE	@ALSNO
		LDA	TXBUF+3
@ALSTERM	CMP	#$20			;space, comma, or return ends the name
		BEQ	@ALSSET
		CMP	#$2C
		BEQ	@ALSSET
		CMP	#$0D
		BEQ	@ALSSET
		CMP	#$2F			;'/' starts a pathname
		BNE	@ALSNO
@ALSSET		STX	XLEN
		STY	XCNUM
		TYA
		ASL	A
		TAX
		LDA	CPBITS-1,X		;same parameter bits as the real command
		STA	PBITS+1
		LDA	CPBITS-2,X
		STA	PBITS
		CLC
		RTS
@ALSNO		SEC
		RTS
		
		END

