ob2src

.PAG 'CLOSE-LOAD-OPEN'
CLOSE	JSR PARS2
	LDA LA
CLOS5	;DOUBLE LABEL
FCLOSE	JSR JLTLK
	BNE JX170
CLOS10	JSR JZ100
	TXA
	PHA
	LDA FA
	BEQ JX150
	CMP #3
	BEQ JX150
	BCS JX120
	LDA SA          ;READ?
	BEQ JX150       ;YES
	JSR ZZZ         ;NO    .IT IS WRITE
	LDX #2
LF2EA	LDA LF304,X
	JSR BO21
	DEX
	BPL LF2EA
	JSR WBLK        ;EMPTY LAST BUFFER
	LDA SA
	CMP #$02        ;WRITE END OF TAPE BLOCK
	BNE JX150
	LDA #EOT        ;YES
	JSR TAPEH
	JMP JX150
LF304	.BYT $D,'1',0
JX120	JSR CLSE1
;
;ENTRY TO REMOVE A GIVE LOGICAL FILE
;FROM TABLE OF LOGICAL, PRIMARY,
;AND SECONDARY ADDRESSES
;
JX150	PLA
	TAX
	DEC LDTND
	CPX LDTND
	BEQ JX170
	LDY LDTND
	LDA LAT,Y
	STA LAT,X
	LDA FAT,Y
	STA FAT,X
	LDA SAT,Y
	STA SAT,X
JX170	RTS
STOP1	LDA STKEY
	CMP #$EF
	BNE STOP2
	PHP
	LDA #0
	STA NDX
	PLP
STOP2	RTS
STOP	JSR STOP1
	JMP BSTOP
SPMSG	LDA TXTPTR+1
	BNE STOP2
	JMP MSG
LOAD	LDA #0
	STA VERCK
LD10	JSR PARS1 ***VERIFY ENTRY
LOADNP	LDA #$FF
LD11	CMP STKEY
	BNE LD11
	CMP STKEY
	BNE LD11
	LDA #>$0400
	STA STAH
	LDA #<$0400
	STA STAL
	LDA FA
	BNE *+5
LD20	JMP SNERR
	CMP #3
	BEQ LD20
	BCC LD100
	JSR LF71C
	JSR LD300
	JSR OPENI
	JSR TALK
LD30	JSR LD400
.SKI
LD40	JSR STOP        ;EXIT ON STOP KEY
	JSR ACPTR       ;GET BYTE OFF IEEE
	LDX SATUS
	BMI LF3CC
.SKI
	LDY VERCK       ;PERFORMING VERIFY?
	BEQ LD50        ;NO...A LOAD
	DEY             ;.Y IS A 1...MAKE IT 0
	CMP (STAL)Y     ;COMPARE TO MEMORY
	BEQ LD60        ;VERIFIES O.K.
;LDX #SPERR      ;NO GOOD... VERIFY ERROR
	LDX #$02        ;NO GOOD... VERIFY ERROR
	STX SATUS
	BNE LD60
LD50	STA (STAL)Y
LD60	INC STAL        ;INCREMENT POINTER
	BNE LD40
	INC STAH
	JMP LD40
.SKI
LD100	JSR ZZZ
	JSR CSTE1
	JSR LD300
LD112	LDA FNLEN
	BEQ LD150
	JSR FAF
	BNE LD170
LD120	JMP OP160
LD150	JSR FAH
	BEQ LD120
LD170	CPX #BLF
	BNE LD112
	JSR LDAD2
	JSR LD400
	JSR TRD
LF3CC	LDA VERCK
	BNE LD115
	JSR TWAIT
	LDA SATUS
	AND #SPERR
	BEQ LD210
	LDY #0
	STY NDX
	LDY #MS22-MS1
	JMP ERMSG
LD210	LDY #MS19-MS1
	JSR SPMSG
	LDA TXTPTR+1
	BNE LD205
	LDA EAH
	STA VARTAB+1
	LDA EAL
	STA VARTAB
	JMP FINI
LD205	JSR STXTPT
	JMP FLOAD
LD300	LDA TXTPTR+1
	BNE LD115
	LDY #MS5-MS1
	JSR MSG
	LDA FNLEN
	BEQ LD115
	LDY #MS6-MS1
	JSR MSG
LD105	LDY FNLEN
	BEQ LD115
	LDY #0
LD110	LDA (FNADR)Y
	JSR PRT
	INY
	CPY FNLEN
	BNE LD110
LD115	RTS
LD400	LDY #MS10-MS1
	LDA VERCK
	BEQ LD410
	LDY #MS21-MS1
LD410	JSR SPMSG
	LDY #MS20-MS1
	JMP SPMSG
;USES BASIC ROUTINES TO PARSE
;LOAD,SAVE,VERIFY STATEMENTS
;     LOAD
;          (FILE NAME OPTION)
;          (OPT DEVICE #) DFLT=1
;          (EOT CMD) DFLT=0=NO
PARS1	LDX #0
	STX SATUS
	STX EAL
	STX FNLEN
	STX SA
	INX
	STX FA
	LDA #$04
	STX EAH         ;Ist das nicht ein Fehler?
	JSR PR140
	JSR PR200
	JSR PR140
	JSR PR070
	STX FA
	JSR PR140
	JSR PR070
	STX SA
PR060	RTS
PR070	JSR PR150
	JMP GETBYT
OPENI	LDA SA
	BMI PR060
	LDY FNLEN
	BEQ PR060
	JSR LISTN
	LDA SA
	ORA #$40
	STA SA
	ORA #$F0
OPENIB	JSR SECND
	LDA SATUS
	BPL OP35
OP37	LDY #MS13-MS1
	JMP ERMSG
OP35	LDA FNLEN
	BEQ OP45
	LDY #0
OP40	LDA (FNADR)Y
	JSR CIOUT
	INY
	CPY FNLEN
	BNE OP40
OP45	JMP UNLSN
FAF	JSR FAH
	BEQ FAF40
	LDY #5
	STY T2
	LDY #0
	STY T1
FAF20	CPY FNLEN
	BEQ FAF30
	LDA (FNADR)Y
	LDY T2
	CMP (TBUF)Y
	BNE FAF
	INC T1
	INC T2
	LDY T1
	BNE FAF20
FAF30	TYA
FAF40	RTS
VER	LDA #1
	STA VERCK
	JSR LD10
	LDA SATUS
	AND #SPERR
	BEQ VER10
	LDY #MS12-MS1
	JMP ERMSG
VER10	LDY #MS18-MS1
	JMP MSG
;USES BASIC ROUTINES TO PARSE
;OPEN,CLOSE
;     OPEN LFN (NO DEFAULT)
;          DEV # (DFLT=1)
;         2ND ADR (DFLT=0 OR NONE)
;          FILE NM STRNG (DEF=NUL)
PARS2	LDX #0
	STX SA
	STX SATUS
	STX FNLEN
	INX
	STX FA
	JSR PR130
	JSR GETBYT
	STX LA
	JSR PR140
	JSR PR070
	STX FA
	CPX #3
	BCC PR100
	DEC SA
PR100	JSR PR140
	JSR PR070
	STX SA
	JSR PR140
	JSR PR150
PR200	JSR FRMEVL
	JSR FRESTR
	STA FNLEN
	LDA INDEX1
	STA FNADR
	LDA INDEX1+1
	STA FNADR+1
	RTS
PR140	JSR CHRGOT
	BNE PR147
	PLA
	PLA
PR147	RTS
PR150	LDA #',
	JSR SYNCHR
PR130	JSR CHRGOT
	BNE PR147
	JMP SNERR
OPEN	JSR PARS2
	LDA LA
FOPEN	BNE OP98
	JMP SNERR
OP98	JSR JLTLK
	BNE OP100
	LDY #MS2-MS1
LF53B	BNE ERMSG
OP100	LDX LDTND
	LDY #0
	STY SATUS
	CPX #10
	BEQ LF53B
	INC LDTND
;STORE GPEN FILE PARMS INTO TABLE
	LDA LA
	STA LAT,X
	LDA SA
	STA SAT,X
	LDA FA
	STA FAT,X
	BEQ OP175
	CMP #3
	BEQ OP175
	BCC OP150
	JMP OPENI
OP150	LDA SA
	BNE OP200
	JSR CSTE1
	JSR LD300
	LDA FNLEN
	BEQ OP170
	JSR FAF
	BNE OP171
OP160	LDY #MS4-MS1
ERMSG	LDA #$D
	JSR PRT
	LDA #$3F
	JSR PRT
	JSR MSG
	JMP TYPERR
OP170	JSR FAH
	BEQ OP160
	BNE OP171
OP200	JSR CSTE2
	LDA #BDFH
	JSR TAPEH
OP171	LDX FA
	LDA #BUFSZ-1
	LDY SA
	BEQ OP172
	JSR LF5E3
	LDA #BDF
	STA (TBUF)Y
	TYA
OP172	STA BUFPT-1,X
OP175	RTS
.FILE OB3SRC