;           Resident part of the hard disk driver
;                        with loader
;             =================================
;            *** Written by Oleg H. Jan 1997 ***
;                       version 01.07

	.TITLE	HDD-disk resident
	.LIST	TTM
	.DSABL	GBL
	.ENABL	LC

;============================================================================
	.Psect	Code		; Program code
	.Psect	Proc		; Subroutines
	.Psect	PPtst		; HDD/FD bus test
	.Psect	PPsbio		; Superblock I/O
	.Psect	PP.Ins		; Resident installer
	.psect	trproc		; TRAP procedures
	.psect	$trpt1		; TRAP table
	.psect	$trpt2
	.Psect	Data		; Data
	.Psect	Text,d		; Text strings
	.Psect	PP.Res		; Resident code
;============================================================================

.macro	trproc	pname
	.save
	.psect	$trpt2
$'pname::
	.word	pname
	.restore
pname::
.endm

.macro	trcall	pname
	trap	<$'pname-trptab>
.endm

.macro	mput	adrmp
	trcall	mput$
	.word   adrmp
.endm

.macro	.Exit
	clr	pc
.endm

.macro	.Print	msg
 .if nb,
	trcall	Pr$1
	.word	msg
 .iff
	trcall	Pr$2
 .endc
.endm

.macro	.Eprint	msg
	trcall	E$print
	.word	msg
.endm

;============================================================================
	WD$csr = 176670
	WD$vec = 144
	pw$vec = 24
	rsk2   = 176674
	rdk2   = 176676
	keyprc = 111144
	dprc0  = 174152
	disp   = 174164
	rap    = 177010
	rdp    = 177014
	WD$reg = 177054
	sysreg = 177716
	casadr = 32		; 26 ; with 600 !
	PASWRD = 342
	ADRPRC = 7126		; Restart process address
	PPBase = 1100
	WD$cqe = <1022-1010>/2
	DefBot = 120
	DefTim = 122
	Hide   = 124
;============================================================================
	.psect	$trpt1
trptab:
	.psect	$trpt2

	.psect	trproc
trdisp:	mov	r5,2(sp)
	mov	(sp),r5	
	mov	-(r5),r5		; TRAP instruction code
	mov	trptab-104400(r5),r5	; Jump address to handler
	rts	r5			; Start handler

	.rem %
	On exit, the stack contains the old value of R5,
	and R5 contains the return address to the main program,
	i.e. the call is equivalent to jsr r5,...
%
;============================================================================
	.Psect	code

Start:
.iif	df,casset	mov	#Casset,R0	; Cassette 0 for debugging

	mtps	(pc)
	Reset
	ash	#3,r0			; Cassette select bit
	bis	r0,N.Cas		; Cassette number for installer
	bis	r0,NN.Cas		; Cassette number for RW procedure
	bis	r0,NNN.Cas		; Cassette number for TEST
	mov	#TRdisp,@#34
	clr	@#36
	mput	Lo$Tst
	mput	Ex$Tst

	.Print	Ver
	
TstHDD	= :.+2
11$:	mov	#-1,r0
	bmi	11$
	
	tstb	r0
	beq	14$
	cmpb	r0,#377
	bne	17$
	.Eprint	NoPwr
14$:	.Eprint	NoCab

17$:	Call	sb$r			; Read master block
3$:	Call	sb.tst			; mov sbbuf,r1
	beq	5$
	.Print	SbCRC
5$:					; Setup resident
	movb	(r1)+,Spt		; Sectors per track
	movb	(r1)+,r3		; Heads per cylinder
	mul	Spt,r3
	mov	r3,SptHed		; Sectors per cylinder
	
	mov	Hide+SbBuf,r5		; Hidden partition
	inc	r5
	ash	#2,r5
	add	r5,Hidden		; -4 compensates inc r5
	
	mov	#DevTab,r0		; Fill partition table
	add	r0,r5			; Pointer to hidden partition (in DevTab)
	mov	#1,r2
	clr	r3
10$:
	mov	r3,(r0)+
	mov	r2,(r0)+
	tst	(r1)
	beq	30$

	cmp	r0,r5
	beq	20$			; Hidden partition

	Cmpb	Max.PN,#'7		; No more than 8
	Bhis	20$			; Boot partitions
	incb	Max.PN
20$:	add	(r1)+,r2
	adc	r3
	cmp	r0,#E$Dtab
	blo	10$
30$:
	add	r0,Parts
	add	r0,rend1
	sub	r0,rend2

	Mput	Lo$Ins			; Upload installer
	Mput	Ex$Ins			; And execute it

	mov	#alread,r0

WaiTes = :.+2
1$:	mov	#-1,r5			; Wait for installer return code
	bmi	1$
; *** RETCOD: 0 - already loaded; 1 - no memory; 2 - load OK ****
	beq	loadOK

	mov	#Succes,r0
	dec	r5
	bne	LoadOK
	.EPrint	NoMem
;============================================================================

LoadOK:	.print

	mov	#100,r2
	mov	(r2),-(sp)
	mov	#Tim$lc,(r2)
	bic	#^c7,SbBuf+DefBot
	bisb	SbBuf+DefBot,Cur.PN
	cmpb	Max.PN,#'1
	blt	Single			; Only one partition - do not ask
	bgt	Qpart
	movb	#',,Max.PN-1
Qpart:	.print	Q.Part
15$:	mov	SbBuf+DefTim,Tim$w
16$:	tst	Tim$w
	bmi	Sb.Exi
17$:	tstb	@#177560
	bpl	16$
	movb	@#177562,r0
	cmpb	r0,#177			; Rewrite superblock unconditionally
	beq	Sb.Wr
	cmpb	r0,#15			; Do not wait for timeout - default
	beq	Sb.Exi

	cmpb	r0,#40
	bne	300$
	clr	r4
	mov	SbBuf+DefTim,r5
	add	#25.,r5
	div	#50.,r4
	cmp	r4,#9.
	ble	170$
	mov	#9.,r4
170$:	add	#'0,r4
	movb	r4,Cur.T
	.Print	Q.Wait
171$:	tstb	@#177560
	bpl	171$
	movb	@#177562,r3
	cmpb	r3,#15
	beq	173$
	cmpb	r3,#'0
	blt	171$
	cmpb	r3,#'9
	bgt	171$
	movb	r3,Cur.T
	sub	#'0,r3
	mul	#50.,r3
	cmp	r3,SbBuf+DefTim
	beq	173$
	mov	r3,SbBuf+DefTim
	clr	r1
173$:	.Print	Cur.T
	br	Qpart

300$:	cmpb	r0,#'0
	blo	15$
	cmpb	r0,Max.PN
	bhi	15$

	cmpb	r0,Cur.PN		; If same partition - do not write
	beq	400$
 	movb	r0,Cur.PN
	movb	r0,SbBuf+DefBot
	clr	r1
400$:
Sb.Exi:	tst	r1
	bne	Sb.NWr
Sb.Wr:	call	Sb.clc			; mov sbbuf,r1
	Call	sb$w			; write superblock
Sb.NWr:
	.Print	Cur.PN
	.Print	ResCur
	.print	CrLfLf

	movb	Cur.PN,r0
	bicb	#^c7,r0			; Drive number
	movb	r0,SbRead+3

Single:
	mov	(sp)+,(r2)		; @#100

	mov	#WD$vec,r3		
	mov	#Sb$Lc,(r3)+		; Read block 0
	mov	#paswrd,(r3)

31$:	tstb	(r3)
	bmi	31$

	bne	B0$Err

	asl	r2			; 100 -> 200
	clr	r3
	mov	#SbBuf,r1		; Copy initial loader to block 0
	cmp	(r1),(pc)+
	nop
	bne	B0$inv
 	mtps	r2			; #200
40$:
	mov	(r1)+,(r3)+
	mov	(r1)+,(r3)+
	sob	r2,40$

 	mtps	r2
	clr	pc			; Start initial loader
B0$Err:
	.EPrint	B0.Err
B0$Inv:	
	.Eprint	B0.Inv
;============================================================================
	.Psect	data

Lo$tst:	.byte	0,20,32,0		; Write installer
	.word	PPBase
	.Word	TstBeg,/2

Lo$Ins:	.byte	0,20,32,0		; Write installer
	.word	PPBase
	.Word	InsBeg,/2

Lo$SB:	.byte	0,20,32,0		; Write RW0 procedures
	.word	PPBase
	.Word	Sb.RW,/2

Ex$Tst:
Ex$Ins:	.byte	0,30,32,0		; Run installer
	.word	PPBase

Ex$SbR:	.byte	0,30,32,0		; Read superblock
	.word	PPBase+Sb.R-Sb.RW
Ex$SbW:	.byte	0,30,32,0		; Write superblock
	.word	PPBase+Sb.W-Sb.RW

SbRead:	.word	0			; Q$blkn
	.word	0			; Q$func ! Q$unit
	.word	SbBuf			; Q$buff
	.word	400			; Q$wcnt
	.Word	SbRead			; ...CQE
	.blkw	WD$Cqe-3
Tim$lc:	dec	(pc)+
Tim$w:	.word	10.
Sb$Lc:	Rti

;============================================================================
	.Psect	Text

Alread:	.asciz	<204>/already loaded/<211><216>	; OK
Succes:	.asciz	<204><211>/ successfully/<216>	; OK
SbCRC:	.asciz	<202>/W-/<205>/ checksum/<216>
B0.Inv:	.asciz	<203>/Invalid/<215><210><216>	; OK
B0.Err:	.asciz	<207><210>/at 0/<216>		; OK
Sbioer:	.asciz	<207>/master-/<210>/at/<216>	; OK
NoMEM:	.asciz	<214>/no RAM for resident/<216>
NoPwr:	.asciz	<214>/no power/<216>		; OK	
NoCab:	.asciz	<203>/cable disconnected/<216>	; OK

Ver:
	.Ascii	<201>/ V01.07 by Oleg H./<33><247><65>	; OK
CrLfLf:	.byte	12,216,0				; +OK

Q.Wait:	.ascii	<15>/Wait time, from /<217>/9/<213>	; OK
Cur.T:	.asciz	/0/<212>				; +OK
Q.part:	.ascii	<216>/Partition/<215>/number/<217>	; OK
Max.PN:	.byte	'0-1, 213				; +OK
Cur.PN:	.asciz	/0/<212>				; +OK
ResCur:	.byte	33,247,66,216,0				; OK

W$tab:
	.byte	201			; First index to start with
	.asciz	/WDROM/			; 201	; WDROM
	.asciz	/?/<201>/-/		; 202	; ?WDROM-
	.asciz	<202>/F-/		; 203	; ?WDROM-F-
	.asciz	<202>/I-Resident /	; 204	; ?WDROM-I-Resident
	.asciz	/Error /		; 205
	.asciz	<203><205>		; 206	; ?WDROM-F-Error
	.asciz	<206>/read /		; 207	; ?WDROM-F-Read error
	.asciz	/block/			; 210
	.asciz	/loaded/		; 211
	.byte	10,33,277,244,0		; 212	; *** back ***
	.asciz	/): /<33><244>		; 213
	.asciz	<203>/No /		; 214	; ?WDROM-F-No
	.asciz	/ boot-/		; 215
	.byte	15,12,0			; 216
	.asciz	/ (0-/			; 217
	.byte	0			; End of dictionary
	.even

;============================================================================
	.Psect	proc
trproc	MPut$
	call	5$		; Wait until K2 is ready
1$:	call	4$		; Push first 2 bytes of address to K2
	clrb	@-(r5)		; Clear response byte
	jsr	r5,3$		; Send 2 bytes of terminator 377
	.word	-1
	tstb	@(r5)+		; Check response
2$:	rts	r5		; Return to main program
3$:	push	#2$
4$:	push	pc		; Ensure re-entry
	movb	(r5)+,@#rdk2	; Send byte to K2
5$:	tstb	@#rsk2		; Wait for K2 ready
	bpl	5$
	return			; Exit

;============================================================================
trproc	E$print
	mov	#5747,2(r5)	; tst -(pc)

trproc	Pr$1	
	mov	(r5)+,r0
trproc	Pr$2
	br	7$
5$:
	push	r0
	mov	r4,r0
	jsr	r5,7$
	pop	r0
	inc	r0
7$:
	mov	#W$tab,r4
	movb	(r4)+,r3	; 201
	
8$:	cmpb	(r0),r3
	beq	5$
10$:	tstb	(r4)+
	bne	10$
	inc	r3
	tstb	(r4)		; End of word table?
	bne	8$		; No

20$:	tstb	@#177564
	bpl	20$

	movb	(r0)+,@#177566
	bne	7$

	rts	r5

;============================================================================
Sb.Tst:
	jsr	r2,crcclc
	.word	377
	add	(r3),r5
	bis	r4,r5
	Return

Sb.clc:
	jsr	r2,crcclc
	.word	376
	com	r5
	neg	r4
	mov	r4,(r3)+
	mov	r5,(r3)
	Return

crcclc:
	mov	(r2)+,r0
	mov	#SbBuf,r1
	mov	r1,r3
	clr	r4
	clr	r5
2$:	add	(r3)+,r4
	adc	r5
	sob	r0,2$
	Rts	r2

;============================================================================
SB$R:
	call	$comon
	Mput	Ex$SBR
	return
SB$W:
	call	$comon
	Mput	Ex$SBW
$ret..:	return
$comon:
	mput	lo$sb
	mov	#-1,sb$WF

	call	@(sp)+	

$$$com:	tst	(pc)+
sb$WF:	.blkw	1
	bmi	$$$com
	beq	$ret..
	.EPrint	SbIOer

;============================================================================
	.Psect	pp.ins

; RETCOD: 0 - already loaded; 1 - no memory; 2 - load OK
InsBeg:
	clr	r3
	tst	@#casadr
	bne	100$
	inc	r3
N.Cas	= .+2
	mov	#6,@#CasAdr	; Set cassette number for resident
	mov	#Rap,r4
rend1	= .+2
	mov	#-R$beg,r0
	mov	r0,r2

	Call	@#176132	; Getmem(); r0 - size, r1 - pointer

	cmp	r0,r2		; Did we get enough memory?
	blo	100$
	inc	r3

	mov	#R$beg/2,(r4)	;
	Asr	r0
	jsr	r5,@#125602	; Copy resident...
	; r1 points to the buffer right after the end of the resident
rend2	= .+2
	add	#S$beg,r1		; Entry address of the resident

	add	r1,reldot-S$beg(r1)	; Relocation

	mov	@#adrprc,r0		; Address
	bmi	10$
	mov	r0,jmpadr-S$beg(r1)
10$:
	mov	r1,@#adrprc
100$:
	mov	#WaiTes/2,(r4)
	mov	r3,@#rdp
	Return
InsEnd:

;============================================================================
	.Psect	PPtst
; Test for HDD presence on PP bus
TstBeg:
	mov	@#100,JTimA
	mov	#JTLc-TstBeg+PPBase,@#100
	Return
JTLc:
	mov	@#WD$reg,-(sp)		; Save old state
NNN.Cas	= .+2
	mov	#6,@#WD$reg		; Connect ROM

	dec	#10.*50.
	beq	10$
	tstb	@#110000
	beq	100$
	cmpb	@#110000,#377
	beq	100$

10$:	mov	JTimA,@#100		; HDD responded (or not?)
	push	@#Rap
	mov	#TstHDD/2,@#Rap
	mov	@#110000,@#Rdp
	pop	@#Rap

100$:	mov	(sp)+,@#WD$reg
	jmp	@(pc)+
JTimA:
TstEnd:

;============================================================================
	.Psect	PPsbio
sb.rw:
Sb.W:
	jsr	r3,sbcomm
	mov	@(pc)+,(r3)
	.word	177717
Sb.R:
	jsr	r3,sbcomm
	mov	(r3),@(pc)+
	.word	177737
Sbcomm:
	tst	(sp)+

	call	int.d
2$:
	call	int...
	movb	@#110000,r4
	bpl	2$			; Device BUSY
	aslb	r4
	bvc	2$

	mov	#110014,r4
10$:
	mov	Sb.Tab-Sb.rw+PPbase-110014-2(r4),-(r4)
	bmi	10$

	mov	(r3)+,Sb.Cmd		; Write/read command
	mov	(r3)+,-(r4)		; COP to HDD
	Mov	#400,R0			; 400 = block size
20$:
	call	int...
	movb	(r4),r1
	bpl	20$			; BSY
	asr	r1
	bcc	sbIerr
	bic	#^c44,r1
	bne	20$

	mov	#110016,r3
	mov	#SbBuf/2,@#Rap

sb.cmd:	.blkw	1
	.word	Rdp
	inc	@#Rap
	sob	r0,sb.cmd
sbIerr:				; I/O error
	mov	#sb$WF/2,@#rap
	mov	r0,@#Rdp	; 0 = OK; 400 = error	
int.e:
	mov	R5,@#WD$reg
	mtps	#0
	return

Int...:	call	int.e
int.d:
	mov	@#WD$reg,R5		; Save old state
	mtps	(pc)
NN.Cas	= .+2
	mov	#6,@#WD$reg		; Connect ROM
	return

	;	110002		110004	110006	110010	110012
	;	s:d:h		trk-hi	trk-lo	sct	Nsct
	.word	<^c240> & 377,	^c0,	^c0,	^c1,	^c1
Sb.Tab:
	.Even
sb.rw.e:

;============================================================================
	.Psect	pp.res

R$beg:	.rad50	/WD SYS/
S$beg:
	mtps	(pc)			; Load PSW == 304
	mov	@#WD$reg,-(sp)		; Save old state
	mov	@#CASADR,@#WD$reg	; Connect ROM
	mov	r1,@#adrprc		; Store address of first process
	movb	@#110000,r0
	bpl	PL.nop			; BSY = 0 means device busy
	aslb	r0
	bmi	NE$nop			; DRDY = 1 means not ready
	mov	#rap,r4
	mov	#rdp,r5
	mov	(pc)+,r2
wcnt:	.word	0
	bgt	common			; Something else still needs to be done

	mov	#+1,(r4)	; Points to PSW in CPU vector
	cmp	#paswrd,(r5)
NE$nop:	bne	NE.nop			; Empty call - exit

	clr	RetCod			; Set return code to 0

				; ** Extract parameters from CPU
	dec	(r4)			; Pointer to WDint
	mov	(r5),(r4)
	ror	(r4)
	sub	#WD$cqe,(r4)		; Pointer to WDcqe
	mov	(r5),(r4)
	ror	(r4)			; Pointer to queue element

	mov	(r5),r3			; Block number
	inc	(r4)
	mov	(r5),r1			; Device number in high byte
	bmi	E.bad			
10$:
	clrb	r1
	ash	#-6,r1			; -8 + 2 = offset in table
	cmp	r1,(pc)+		; Hidden partition
Hidden:	.word	-4			; -1 << 2
	blo	20$			; Below hidden partition
	cmp	(r1)+,(r1)+
20$:
Parts	= .+2
	cmp	r1,#-DevTab-4		; Partition number exceeds existing?
	bhis	E.bad			; **********************************
	
	add	(pc)+,r1		; Pointer to DevTab (high word)
reldot:	.word	DevTab-S$Beg

	mov	(r1)+,r2

	mov	4(r1),r0
	sub	(r1),r0			; Partition size
	cmpb	(r5),#373		; Spfun "SIZE" ?
	bne	20$
					; Handle SpFun_373
	inc	(r4)			; Now points to @buffer
	mov	(r5),(r4)
	ror	(r4)			; Now points to buffer
	mov	r0,(r5)
	br	exit00
20$:
	tstb	(r5)
	bne	E.bad
	inc	(r4)			; Now points to @buffer
	sub	r3,r0			; How many blocks can still be read
					; from this partition
	blo	E.bad			; Do not cross partition boundary!!!

	add	(r1),r3			; R2,R3 = 32-bit absolute
	adc	r2			; block number on HDD

SPTHED = :.+2
	div	#1,r2
	mov	#110006,r1
	com	r2
	mov	r2,(r1)			; Track low
	swab	r2
	mov	r2,-(r1)		; Track high
	clr	r2
SPT    = :.+2
	div	#1,r2
	bis	#240,r2			; Sector size = 512
	com	r2
	com	r3
	sbc	r3

	mov	r2,-(r1)		; Head
	mov	r3,@#110010		; Sector
	mov	(r5),buff		; Buffer
	ror	buff

	jsr	r5,Set$RW		; Set read mode
	mov	(r3),(r5)		; <==
	tst	(r3)			;   |
	.word	177737			; <==

	inc	(r4)
	mov	(r5),r2			; Word count
	beq	exit0
	bpl	1$
	neg	r2
	jsr	r5,Set$RW		; Set write mode
	mov	(r5),(r3)		; <== 
	clr	(r3)			;   |
	.word	177717			; <==
1$:
	mov	r2,r3
	add	#377,r3
	clrb	r3
	swab	r3			; How many blocks to read (low byte)

	cmp	r3,r0
	blos	10$
	mov	r0,r3
	mov	r0,r2
	swab	r2

10$:	com	r3
	mov	r3,@#110012		; Sector count
	mov	r1,@#110000		; Start operation
;/////	mov	r2,wcnt
	br	S.wcnt
Common:
	mov	(pc)+,(r4)
buff:	.blkw	1
	mov	#110016,r3
next$b:
	movb	@#110000,r1
PL.nop:	bpl	ex.nop			; BSY
	asr	r1
	bcs	10$
	movb	@#110014,RetCod+1
E.bad	= .				; I/O ERROR
	inc	RetCod
Exit00	= . 
	clr	r2
	br	exit0
10$:	bic	#^c44,r1
NE.nop:	bne	ex.nop

	Mov	#400,R0			; 400 = block size
	sub	r0,r2
	bge	copy
	add	r2,r0
copy:
	Add	#3,r0
	ashc	#-2,r0
	ashc	#-14,r1
	sub	#14,r1
	sub	r1,pc
cmd1:	.blkw	1
	inc	(r4)
cmd2:	.blkw	1
	inc	(r4)
cmd3:	.blkw	1
	inc	(r4)
cmd4:	.blkw	1
	inc	(r4)
	sob	r0,cmd1

	mov	(r4),buff
S.wcnt:	mov	r2,wcnt
	bgt	common		; R2 < 0 means operation not finished yet
exit0:
	mov	#+1,(r4)
RetCod = :.+2
	mov	#0,(r5)			; Error code
	dec	(r4)
	mov	(r5),r0			; Interrupt vector
	mov	#pw$vec/2,(r4)
	mov	(r5),r1
	mov	r0,(r5)			; Pointer to WD$int
	bic	#100000,@#sysreg	; Interrupt to CPU
	bis	#100000,@#sysreg	; Interrupt to CPU
	clr	wcnt			; Operation completed
	mov	r1,(r5)			; Restore vector 24

	neg	r2
	ble	rest24
cmd5:	.blkw	1
	sob	r2,cmd5
rest24:

ex.nop:	
	mov	(sp)+,@#WD$reg
	mov	@#adrprc,r1		; Store address of first process
	mtps	(pc)			; Load PSW == 117
	jmp	@(pc)+
jmpadr:	.word	disp			; Return to dispatcher

Set$RW:
	mov	(r5),Cmd1
	mov	(r5),Cmd2
	mov	(r5),Cmd3
	mov	(r5)+,Cmd4
	mov	(r5)+,Cmd5
	mov	(r5)+,r1
	Rts	r5

DevTab:
E$Dtab	= DevTab + <2*2*<1+8.+8.+8.+8.+6.>>
SbBuf	= E$Dtab

	.END	start