;ZXIDEROM source rutines
;BLOK1 for Harddisk 
;LBA version for CF

;I/O port adresses
DAT	EQU	#2B
PAR	EQU	#2F
SEC	EQU	#6B
STA	EQU	#6F
ZYL	EQU	#AB
ZYH	EQU	#AF
HEA	EQU	#EB
COM	EQU	#EF

;some error codes
DIER	EQU	#1E
ECC	EQU	#1F

	ORG	#4C2

	RET	;Skip calls of cassette rut..


CALC       OR A ;avoids zero sector count - it transfers 256 sectors!
           JR NZ,CONTIN
           RST 8
           DEFB #19 ; parameter error
CONTIN     DI
           PUSH HL
           PUSH DE
           LD E,A
ISBYS IN A,(COM)
           BIT 7,A
           JR NZ,ISBYS ; Wait until not busy
           LD A,#E0 ; LBA mode set, bits 24-27 always zero, still up to 8GB
           OUT (HEA),A
           POP HL
           LD A,H
           LD H,L
           LD L,0
           ADD HL,BC
           JR NC,NOCAR
           INC A ; Advance high byte
NOCAR OUT (ZYH),A
           LD A,H
           OUT (ZYL),A
           LD A,L
           OUT (STA),A
           LD A,E
           OUT (SEC),A
           POP HL
           RET



;Enter param: HL adress,BC start sector,A count, DE cyl. offset
;Out param:Z set=OK,NZ=error

;Verify

	ORG #503
VERBL
	CALL	CALC
	LD	A,#41
	OUT	(COM),A
	LD	BC,50000
VTIL	IN	A,(COM)
	BIT	7,A
	JR	Z,VERF
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,VTIL
	RST	8
	DEFB	DIER
VERF	BIT	0,A
	RET	Z
	RST	8
	DEFB	DIER

REABE

;STACK OVERLAP CHECK


	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD	E,A
	LD	B,9
MU512	SLA	E
	RL	D
	DJNZ	MU512
	LD	BC,(#5CB2)
	SCF
	SBC	HL,BC
	JR	NC,OK
	POP	HL
	PUSH	HL
	ADD	HL,DE
	JR	C,SO
	LD	BC,12
	ADD	HL,BC
	JR	C,SO
	SBC	HL,SP
	JR	C,OK
SO	RST	8
	DEFB	#1D ;stack overlap
OK	POP	HL
	POP	DE
	POP	BC

	CALL	REABL

ERRT
;error test & RST 8
	EI
	RET	Z ;If no error
	IN	A,(PAR)
	BIT	6,A
	JR	NZ,CRCE
	RST	8
	DEFB	DIER ;Disk error
FILL	RET
	RET	;Adr #556 -skip cassette load
CRCE	RST	8
	DEFB	ECC ;ECC error

REABL	CALL	CALC
	LD	A,#20
	OUT	(COM),A
CWR	CALL	WAIDR
SELL	INI
	INI
	INI
	INI
	INI
	INI
	INI
	INI
	DJNZ	SELL
	IN	A,(COM)
	BIT	0,A
	RET	NZ
	DEC	E
	JR	NZ,CWR
	RET

WRIBE	CALL	WRIBL
	JR	ERRT

WRIBL	CALL	CALC
	LD	A,#30
	OUT	(COM),A
WRIT	CALL	WAIDR
SWRL	OUTI	
	OUTI
	OUTI
	OUTI	
	OUTI	
	OUTI
	OUTI
	OUTI	
	DJNZ	SWRL
	IN	A,(COM)
	BIT	0,A
	RET	NZ
	DEC	E
	JR	NZ,WRIT
	RET

WAIDR	LD	BC,50000
WAIDL	IN	A,(COM)
	BIT	3,A
	JR	NZ,SET64
	DEC	BC
	LD	A,B
	OR	C
	JR	NZ,WAIDL
	POP	DE ;Drop call.
	INC	A ;reset zero flag
	RET
SET64	LD	BC,#402B
	RET

;some error codes

EIVFN	EQU	#E
EFINF	EQU	#20
ENAME	EQU	#21
ENORO	EQU	#22
ECATF	EQU	#23
ENOTL	EQU	#24

;test free mem.
RTMONM	CALL	#1F1A
	LD	HL,-560
	OR	A
	SBC	HL,BC
	JR	C,USESCR
	LD	BC,543
	RST	#30
	JR	TOIX
USESCR	LD	DE,#55E0
TOIX	LD	B,6
GO6	INC	DE
	DJNZ	GO6

	PUSH	DE
	POP	IX
	LD	B,16
	LD	A,32
SABLAN	LD	(DE),A
	INC	DE
	DJNZ	SABLAN

	CALL	#2BF1
;test first char is A-Z or 1-9
	LD	A,(DE) ;test first char
	CALL	ISVABC
	JR	NZ,WBGC
	LD	HL,#FFF1
	DEC	BC
	ADD	HL,BC
	INC	BC
	JR	NC,SANAME
WBGC	RST	8
	DEFB	EIVFN
SANAME	PUSH	IX
	POP	HL
	INC	HL
	EX	DE,HL
	LDIR
	RET

;SAVE, LOAD & VERIFY
;COMMAND ROUTINES
SAVETC	POP	AF
	LD	A,(TADR)
	SUB	#E0
	LD	(TADR),A
	CALL	#1C8C
	CALL	#2530
	JR	Z,SACODE
	CALL	RTMONM
SACODE	RST	#18
	CP	#AF
	JR	NZ,SALINE
	LD	A,(TADR)
	CP	3
REPC	JP	Z,#1C8A
	RST	#20
	CALL	#2048
	JR	NZ,SAC1
	LD	A,(TADR)
	AND	A
	JR	Z,REPC
	CALL	#1CE6
	JR	SAC2
SAC1	CALL	#1C82
	RST	#18

	CP	#2C
	JR	Z,SAC3
	LD	A,(TADR)
	AND	A
	JR	Z,REPC
SAC2	CALL	#1CE6
	JR	SAC4
SAC3	RST	#20
	CALL	#1C82
SAC4	CALL	#1BEE
	CALL	#1E99
	LD	(IX+16),C
	LD	(IX+17),B
	CALL	#1E99
	LD	(IX+18),C
	LD	(IX+19),B
	LD	H,B
	LD	L,C
	LD	(IX+0),3 ;TYPE
	JR	SAALL
SALINE	CP	#CA
	JR	Z,SAL1
	CALL	#1BEE
	LD	(IX+19),128
	JR	SATY0
SAL1	LD	A,(TADR)
	AND	A
	JP	NZ,#1C8A

	RST	#20
	CALL	#1C82
	CALL	#1BEE
	CALL	#1E99
	LD	(IX+18),C
	LD	(IX+19),B
SATY0	LD	(IX+0),0
	LD	HL,(ELINE)
	LD	DE,(PROG)
	SCF
	SBC	HL,DE
	LD	(IX+16),L
	LD	(IX+17),H
	LD	HL,(VARS)
	SBC	HL,DE
	LD	(IX+20),L
	LD	(IX+21),H
	EX	DE,HL
SAALL	LD	A,(TADR)
	AND	A
	JP	Z,SACONT
	PUSH	HL
	CALL	LDCAT
;this incr. IX by 25

	LD	A,(IX+0)
	CP	3
	JR	Z,VERCNT
	LD	A,(TADR)
	DEC	A
	JR	Z,LDCONT
;LOAD " " CODE MUST COM
;MERGE OUT
VERCNT	LD	L,(IX-9)
	LD	H,(IX-8)
	LD	E,(IX+16)
	LD	D,(IX+17)
	LD	A,H
	OR	L
	JR	Z,VER1
	SBC	HL,DE
	JR	NC,VER1
	ADD	HL,DE
	SRL	H
	RR	L
	JR	C,OV
	JR	Z,NOV
OV	INC	H
NOV	LD	E,H
	LD	(IX+26),0 ;avoid loadpos
	JR	LB3A01

VER1	LD	E,(IX+24)
LB3A01	POP	HL
	LD	A,H ;missed in BLOK1 10
	OR	L
	JR	NZ,VER2
	LD	A,(TADR)
	CP	2
	JR	Z,VER2
	LD	A,(IX+26)
	OR	A
	JR	Z,NOTCM
	LD	H,A
	LD	L,(IX+25)
	DI
	LD	SP,HL
NOTCM	LD	L,(IX+18)
	LD	H,(IX+19)
	OR	A
	JR	NZ,VER3
VER2	XOR	A
VER3	LD	C,(IX+22)
	LD	B,(IX+23)
	LD	D,(IX-30)
	OR	A
	JR	Z,CHFVER
	LD	A,E
	LD	E,(IX-31) ;Cyl offset
	CALL	REABL
	JP	RESTR
CHFVER	LD	A,(TADR)
	CP	2
	JR	Z,TOVER ;ret via or RST 8 by error
TOREAB	LD	A,E
	LD	E,(IX-31)
	JP	REABE ;error test in subrut, ret via

TOVER	LD	A,E
	LD	E,(IX-31)
	JP	VERBL ;

LDCONT	LD	E,(IX+16)
	LD	D,(IX+17)
	POP	HL
	PUSH	HL
	LD	L,(IX-9)
	LD	H,(IX-8)
	EX	DE,HL
	SCF
	SBC	HL,DE
	JR	C,LDPRG
	LD	DE,5
	ADD	HL,DE
	LD	B,H
	LD	C,L
	CALL	#1F05
LDPRG	POP	HL
	EX	DE,HL
	LD	HL,(ELINE)
	DEC	HL
	LD	(XPTR),IX
	LD	C,(IX+16)
	LD	B,(IX+17)
	PUSH	BC
	CALL	#19E5
	POP	BC
	PUSH	HL
	PUSH	BC
	CALL	#1655
	LD	IX,(XPTR)
	INC	HL
	LD	C,(IX+20)
	LD	B,(IX+21)
	ADD	HL,BC
	LD	(VARS),HL
	LD	H,(IX+19)
	LD	A,H
	AND	#C0
	JR	NZ,LDPRG1
	LD	L,(IX+18)
	LD	(NEWPPC),HL
	LD	(IY+10),0
LDPRG1	POP	DE
	POP	HL
	LD	E,(IX+24)
	JP	VER2

SACONT	PUSH	HL
	CALL	SACAT
	CALL	SACAT2
	POP	HL
SADB	LD	A,(IX-1)
SADB1	LD	B,(IX-2)
	LD	C,(IX-3)
	JP	WRIP ;ret via

SACAT	PUSH	IX
	CALL	LDMASC
	LD	BC,1
SACOL	PUSH	IX
	POP	HL
	PUSH	BC
	CALL	FINDNM
	POP	BC
	CP	16
	JR	C,NAMF
	JR	NZ,CATEND
	INC	C
	LD	A,(IX-29)
	CP	C
	JR	NZ,SACOL
	RST	8
	DEFB	ECATF
NAMF	RST	8
	DEFB	ENAME
CATEND	SUB	20
	PUSH	AF
	PUSH	BC
	PUSH	IX
	POP	HL
	LD	BC,0
	LD	A,1
	CALL	REAP
	LD	C,(IX+0)
	LD	B,(IX+1)
	LD	(IX-3),C
	LD	(IX-2),B
	LD	L,(IX-28)
	LD	H,(IX-27)
	OR	A
	SBC	HL,BC
	LD	E,(IX-9)
	LD	D,(IX-8)
	OR	A
	LD	A,D
	SRL	A
	JR	C,PL1
	LD	D,A
	LD	A,E
	OR	A
	LD	A,D
	JR	Z,ETOA
PL1	INC	A
ETOA	LD	E,A
	LD	(IX-1),E
	LD	D,0
	SBC	HL,DE
	JR	NC,ROOMOK
	RST	8
	DEFB	ENORO
ROOMOK	PUSH	IX
	POP	HL
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	EX	DE,HL
	ADD	HL,BC
	EX	DE,HL
	LD	(HL),D
	DEC	HL
	LD	(HL),E
	LD	BC,0
	LD	A,1
	PUSH	HL
	CALL	WRIP
	POP	HL
	POP	BC
	PUSH	BC
	PUSH	HL
	LD	A,1
	CALL	REAP
	POP	HL
	POP	BC
	POP	AF
	LD	B,5
MUAL	SLA	A
	DJNZ	MUAL
	LD	D,B
	RL	D
	LD	E,A
	ADD	HL,DE
	EX	DE,HL
	POP	HL
	PUSH	BC
	LD	BC,25
	LDIR
	POP	BC
	RET
SACAT2	PUSH	IX
	POP	HL
	LD	B,0
	LD	A,1
	JP	WRIP

ELINE	EQU	#5C59
XPTR	EQU	#5C5F
VARS	EQU	#5C4B
NEWPPC	EQU	#5C42
PROG	EQU	#5C53
TADR	EQU	#5C74
RESTR	EQU	#3A4C

LDCAT1
	CALL	LDMASC
	LD	BC,1 ;CAT SECTOR 1
LOOKH	PUSH	IX
	POP	HL
	PUSH	BC
	CALL	FINDNM
	POP	BC
	CP	16
	JR	C,FOUND
	JR	NZ,FILENF
	INC	C
	LD	A,(IX-29)
;this is first data sector #
	CP	C
	JR	NZ,LOOKH
FILENF	RST	8
	DEFB	EFINF
FOUND	LD	B,5
MUA32	SLA	A
	DJNZ	MUA32
	RL	B
	PUSH	IX
	POP	HL
	RET

LDMASC
;first load master cat
	LD	BC,25
	ADD	IX,BC ;base for load
	LD	BC,0
LDMAC2	LD	DE,0
	PUSH	IX
	POP	HL
	LD	A,1
	CALL	REABE
	LD	A,(IX-24)
	CP	"a"
	JR	C,NOTLC
	RES	5,A
NOTLC	LD	B,36
	PUSH	IX
	POP	HL
	LD	DE,12
BEGLL	CP	(HL)
	JR	Z,BEGLM
	ADD	HL,DE
	DJNZ	BEGLL
	RST	8
	DEFB	EIVFN
BEGLM	INC	HL
	PUSH	HL
	PUSH	IX
	POP	HL
	LD	DE,-31
	ADD	HL,DE
	EX	DE,HL
	POP	HL
	LD	BC,5
	LDIR
;this copyes cyl. offset,
;first data sector & area len to begin of workarea
	RET

LDCAT
	CALL	LDCAT1
	LD	C,A
	LD	A,(DE)
	CP	(IX-25)
	JR	Z,TYPOK
PARER	RST	8
	DEFB	#19
TYPOK	LD	D,H
	LD	E,L
	ADD	HL,BC
	LD	BC,32
	LDIR
	RET
;FIND NAME

FINDNM	PUSH	HL
	LD	A,1
	CALL	REAP
	POP	HL
	LD	C,0
BLOOP	LD	D,H
	LD	E,L
	INC	HL
	LD	A,(HL)
	OR	A
	JR	Z,CATEF
	LD	B,15
	PUSH	IX
	INC	IX
RLOOP	LD	A,(HL)
	CP	(IX-25)
	JR	NZ,NOTEQ
	INC	HL
	INC	IX
	DJNZ	RLOOP
	POP	IX
	LD	A,C
	RET
NOTEQ	LD	H,D
	LD	L,E
	LD	DE,32
	ADD	HL,DE
	POP	IX
	INC	C
	LD	A,16
	CP	C
	JR	NZ,BLOOP
	RET
CATEF	LD	A,C
	ADD	A,20
	RET

;ERASE COMMAND

ERASE	CALL	RTMONM
	CALL	LDCAT1
	CP	#E0
	JR	NZ,NOTLR1
	DEC	B
	JR	NZ,NOTLR
	LD	A,(IX-29)
	DEC	A
	CP	C
	JR	Z,EROK2
	INC	C ;To next sector
	LD	A,1
	PUSH	HL
	PUSH	BC
	CALL	REAP
	POP	BC
	POP	HL
	DEC	C
	INC	HL
	LD	A,(HL)
	OR	A
	JR	Z,OKER
REPH25	RST	8
	DEFB	ENOTL
OKER	LD	A,1
	DEC	HL
	PUSH	HL
	PUSH	BC
	CALL	REAP
	POP	BC
	POP	HL
EROK2	LD	D,C
	LD	BC,#1E0
	ADD	HL,BC
	JR	EROK
NOTLR	INC	B
NOTLR1	LD	D,C
	LD	C,A
	ADD	HL,BC
	LD	BC,33
	ADD	HL,BC
	LD	A,(HL)
	OR	A
	JR	NZ,REPH25
	SBC	HL,BC
EROK	LD	BC,22
	ADD	HL,BC
	LD	E,(HL)
	INC	HL
	LD	A,(HL)
	INC	BC
	OR	A
	SBC	HL,BC
	LD	C,D
	LD	D,A
	LD	B,32


ERAL	LD	(HL),0
	INC	HL
	DJNZ	ERAL
	PUSH	IX
	POP	HL
	PUSH	DE
	PUSH	HL
	LD	A,1
	CALL	WRIP
	POP	HL
	LD	A,1
	LD	BC,0
	PUSH	HL
	CALL	REAP
	POP	HL
	POP	DE
	LD	(HL),E
	INC	HL
	LD	(HL),D
	DEC	HL
	LD	BC,0
	LD	A,1
WRIP	LD	E,(IX-31)
	LD	D,(IX-30)
	JP	WRIBE ;ret via
REAP	LD	E,(IX-31)
	LD	D,(IX-30)
	JP	REABE

ISVABC	CP	"0"
	RET	C
	CP	":"
	JR	C,BGCN
	RES	5,A ;lower to cap.
	CP	"A"
	RET	C
	CP	#5B
	JR	NC,IBGC
BGCN	CP	A ;SET Z flag
	RET
IBGC	OR	A ;reset Z flag
	RET


;EXTERN COMMAND

BASE	EQU	64500
LDMAC2	EQU	#884
REABE	EQU	#51F
	ORG	#EC0

	CALL	#2530
	JR	NZ,NOSY
	RST	#20
	JP	#1BF3
NOSY	LD	(BASE+7),A
	LD	IX,BASE+31
	LD	BC,2 ;abs sector 2
	CALL	LDMAC2
	LD	A,(BASE+4)
	LD	BC,(BASE+2)
	LD	HL,(BASE)
	LD	DE,1014
	PUSH	HL
	CALL	REABE
	RST	#20
	RET	;JP to mc.

;CAT COMMAND

LDMASC	EQU	#87C
REAP	EQU	#987
	ORG	#1391
;class 5

	CALL	#2530
	JR	NZ,NOCSY
	RST	#20
TOSMN	JP	#1BF3


NOCSY	PUSH	AF
	LD	A,2
	CALL	#1601
	XOR	A
	LD	DE,FIRM
	CALL	#C0A
	LD	BC,550
	RST	#30

	PUSH	DE
	POP	IX
	LD	DE,6
	ADD	IX,DE
	POP	AF
	LD	(IX+1),A
	CALL	LDMASC
	PUSH	IX
	POP	HL
	LD	BC,1

CATBL	PUSH	HL
	LD	A,1
	PUSH	BC
	PUSH	HL
	CALL	REAP
	POP	HL
	LD	E,16
CATPL	INC	HL
	LD	A,(HL)
	OR	A
	JP	Z,CATEND
	LD	BC,14
	ADD	HL,BC
	LD	D,1
ZTL	LD	A,(HL)
	CP	32
	JR	NZ,NOTSP
	INC	D
	DEC	HL
	DEC	C
	JR	NZ,ZTL
NOTSP	OR	A
	SBC	HL,BC
	LD	B,15
SPET	LD	A,B
	CP	D
	JR	NC,NAML
	LD	A,"-"
	JR	CRST
NAML	LD	A,(HL)
CRST	RST	16
	INC	HL
	DJNZ	SPET
	LD	A,32
	RST	16
	LD	BC,16
	OR	A
	SBC	HL,BC
	LD	A,(HL)
	LD	D,A ;Save type
	OR	A
	JR	Z,PRG
	CP	3
	JR	Z,CODE
	LD	A,"H"
	RST	16
	LD	A,":"
	RST	16
	LD	A,"?"
	RST	16
	INC	HL
	INC	HL
	INC	HL
	JR	SPBLEN
PRG	LD	A,"P"
	JR	PRTSP
CODE	LD	A,"B"
PRTSP	RST	16
	LD	A,":"
	RST	16
	ADD	HL,BC
	INC	HL
	INC	HL
	LD	C,(HL)
	INC	HL
	LD	B,(HL)
	LD	A,D
	OR	A
	JR	NZ,NOTPRG
	LD	A,B
	CP	#80
	JR	NZ,NOTPRG
	LD	A,"-"
	RST	16
	LD	B,4
PFSPL	LD	A," "
	RST	16
	DJNZ	PFSPL
	JR	SPBLEN
NOTPRG	CALL	BCOUT5
SPBLEN	LD	A,32
	RST	16
	LD	A,"L"
	RST	16
	LD	A,":"
	RST	16
	DEC	HL
	DEC	HL
	LD	B,(HL)
	DEC	HL
	LD	C,(HL)
	CALL	BCOUT5
	LD	A,13
	RST	16
	LD	BC,16
	ADD	HL,BC
	DEC	E
	JP	NZ,CATPL
	POP	BC
	POP	HL
	INC	C
	LD	A,C
	CP	(IX-29)
	JP	NZ,CATBL
	JR	CEND
CATEND	POP	BC
	POP	HL
CEND	LD	BC,0
	LD	A,1
	PUSH	HL
	CALL	REAP
	POP	HL
	PUSH	HL
	POP	IX
	LD	DE,CUST
	XOR	A
	CALL	#C0A
	LD	E,(IX+4)
	LD	D,0
	LD	H,(IX+1)
	LD	L,(IX+0)
	PUSH	HL
	OR	A
	SBC	HL,DE
	CALL	DI2BCO
	LD	DE,FRT
	XOR	A
	CALL	#C0A
	LD	H,(IX+3)
	LD	L,(IX+2)
	POP	DE
	OR	A
	SBC	HL,DE
	CALL	DI2BCO
	LD	DE,SECM
	XOR	A
	CALL	#C0A
	RST	#20
	RET


	ORG	#3CA8

DI2BCO	LD	B,H
	LD	C,L
	SRL	B
	RR	C
	PUSH	AF
	CALL	BCOUT5
	POP	AF
	JR	NC,TWOSP
	JP	PRC5
TWOSP	LD	A," "
	RST	16
	LD	A," "
	RST	16
	RET


;IN:BC value,A:number of digits
BCOUT4	LD	A,4
	JR	BCOUT
BCOUT3	LD	A,3
	JR	BCOUT
BCOUT5	LD	A,5
BCOUT	PUSH	HL
	PUSH	DE
	PUSH	IX
	LD	IX,DTABL
	LD	H,B
	LD	L,C
	DEC	A
	LD	B,A
	LD	A,4
	SUB	B
	LD	D,0
	LD	E,A
	ADD	IX,DE
	ADD	IX,DE
	LD	C,0 ;lead zero flag
CD10	LD	E,(IX+0)
	INC	IX
	LD	D,(IX+0)
	INC	IX
	CALL	DIV10
	DJNZ	CD10
	LD	A,L
	ADD	A,"0"
	RST	16
	POP	IX
	POP	DE
	POP	HL
	RET


	ORG	#9A8
DIV10
	LD	A,-1
D10L	INC	A
	ADD	HL,DE
	JR	C,D10L
	SBC	HL,DE
	OR	A
	JR	NZ,NMLZ
	OR	C
	JR	Z,LEASP
	XOR	A
	JR	ADDA0
LEASP	LD	A,32
	JR	DOUP
NMLZ	LD	C,A
ADDA0	ADD	A,"0"
DOUP	RST	16
	RET

DTABL	DEFW	55536
	DEFW	64536
	DEFW	65436
	DEFW	65526

PRC5	LD	A,"."
	RST	16
	LD	A,"5"
	RST	16

FIRM	RET
	DEFB	13
	DEFM	"  Files:"
SECM	DEFB	128+13
	DEFM	" KB"
CUST	DEFB	141,13
	DEFM	" Used"
FRT	DEFB	":"+128
	DEFM	" free"
	DEFB	":"+128

;MOVE NMI

SACAT	EQU	#7AF
SACAT2	EQU	#849
RTMONM	EQU	#5C5
WRIP	EQU	#97E
REABE	EQU	#51F
SADB1	EQU	#7A6
WRIBL	EQU	#583

	ORG	#386E
;MOVE COMMAND

MOVE	CALL	RTMONM
	LD	HL,#C000
	LD	(IX+16),L
	LD	(IX+17),H
	LD	HL,#4000
	LD	(IX+18),L
	LD	(IX+19),H
	LD	(IX+0),3
	CALL	SACAT
	EX	DE,HL
	LD	DE,(26600)
	LD	(HL),E
	INC	HL
	LD	(HL),D
	CALL	SACAT2
	LD	L,(IX-3)
	LD	H,(IX-2)
	LD	BC,20 
	ADD	HL,BC
	LD	B,H
	LD	C,L
	LD	A,76
	LD	HL,26624
	CALL	WRIP
	LD	BC,20
	LD	A,20
	LD	HL,26624
	LD	DE,0
	CALL	REABE
	LD	A,20
	LD	HL,26624
	JP	SADB1


;NMI HERE
	ORG	#3A01
NMIHER	PUSH	AF
NMIL	LD	A,4
	OUT	(#FE),A
	LD	A,#FE
	IN	A,(#FE)
	BIT	3,A
	JR	NZ,KT
	POP	AF
	RETN
KT	LD	A,#7F
	IN	A,(#FE)
	BIT	4,A
	JP	Z,BASIC
	BIT	2,A
	LD	A,2
	OUT	(#FE),A
	JR	NZ,NMIL
;SAVE ALL TO DISK
	LD	A,I
	PUSH	AF
	EX	AF,AF'
	PUSH	AF
	PUSH	BC
	PUSH	DE
	PUSH	HL
	EXX
	PUSH	BC
	PUSH	DE
	PUSH	HL
	PUSH	IX
	PUSH	IY
	LD	HL,RESTR
	PUSH	HL
	LD	HL,#4000
	LD	BC,20
	LD	A,20
	LD	DE,0
	CALL	WRIBL
	POP	HL
	JR	NZ,RESTR2
	LD	(26600),SP
	RST	0


RESTR
	JR	NZ,BASIC
RESTR2	POP	IY
	POP	IX
	POP	HL
	POP	DE
	POP	BC
	EXX
	POP	HL
	POP	DE
	POP	BC
	POP	AF
	EX	AF,AF'
	POP	AF
	LD	I,A
	JP	PO,DISABL
	EI
DISABL	CP	#3F
	IM	1
	JR	Z,MODE1
	IM	2
MODE1	POP	AF
	RET

BASIC	PUSH	HL
	PUSH	DE
	LD	HL,(#5CB2)
	LD	DE,#5D8E
	SBC	HL,DE
	JR	NC,NOTLOW
	POP	DE
	POP	HL
	JP	NMIL
NOTLOW	LD	SP,(#5CB2)
	DEC	SP
	LD	HL,#1303
	PUSH	HL
	LD	(#5C3D),SP
	LD	A,(#5C48)
	RRA
	RRA
	RRA
	AND	7
	CALL	#229B
	LD	A,#3F
	LD	I,A
	RST	8
	DEFB	#1C
<script type="text/javascript" src="http://hb.lycos.com/hb.js"></script>
<script type="text/javascript" src="http://ratings.lycos.com/ratings/lycosRating.js.php"></script>
<script type="text/javascript"><!--//--><![CDATA[//><!--
var cm_role = "live";
var cm_host = "tripod.lycos.com";
var cm_taxid = "/memberembedded";
var tripod_member_name = "piters";
var tripod_member_page = "piters/ZXCFOS.ASM";
var tripod_ratings_hash = "1215619303:7b84ee1de61c93f42924a872d5dab801";

var lycos_ad_category = {"dmoz":"society\/relationships","ontarget":"&CAT=family%20and%20lifestyles&L2CAT=relationships","find_what":"paris"};

var lycos_ad_remote_addr = "38.103.63.18";
var lycos_ad_www_server = "www.tripod.lycos.com";
var lycos_ad_track_small = "http://members.tripod.com/adm/img/common/ot_smallframe.gif?rand=368071";
var lycos_ad_track_served = "http://members.tripod.com/adm/img/common/ot_adserved.gif?rand=368071";
//--><!]]></script>
<script type="text/javascript" src="http://scripts.lycos.com/catman/init.js"></script>
<script type="text/javascript" src="http://members.tripod.com/adm/ad/code-start.js"></script>
<script type="text/javascript" src="http://members.tripod.com/adm/ad/code-middle.js"></script>
<script type="text/javascript" src="http://members.tripod.com/adm/ad/code-end.js"></script>
<noscript>
 <img src="http://members.tripod.com/adm/img/common/ot_noscript.gif?rand=368071" alt="" width="1" height="1" />
 <!-- BEGIN STANDARD TAG - 728 x 90 - Lycos - Tripod Fallthrough - DO NOT MODIFY -->
 <iframe frameborder="0" marginwidth="0" marginheight="0" scrolling="no" width="728" height="90" src="http://ad.yieldmanager.com/st?ad_type=iframe&ad_size=728x90&section=209094"></iframe>
 <!-- END TAG -->
</noscript>