
*Disk access for the xb compiler  May 2 2015
*This first cut will only do display variable files and only one file
*open at a time
	
*DSRLNK from MG Smart Programmer - seems to work OK even though
*separated from GPLLNK in RUNTIME2
 
PUTSTK EQU >50
TYPE   EQU >836D
NAMLEN EQU >8356
VWA    EQU >8C02
VRD    EQU >8800
GR4LB  EQU >83E9
GSTAT  EQU >837C
 
DSRLNK DATA DSRWS,DLINK1
 
DSRWS  EQU $
DR3LB  EQU $+7
DLINK1 MOV R12,R12
       JNE DLINK3
       LWPI GPLWS
       MOV @PUTSTK,R4
       BL *R4
       LI R4,>11
       MOVB R4,@>402(R13)
       JMP DLINK2
       DATA 0
       DATA 0,0,0
DLINK2 MOVB @GR4LB,@>402(R13)
       MOV @GETSTK,R5
       MOVB *R13,@DSRAD1
       INCT @DSRADD
       BL *R5
       LWPI DSRWS
       LI R12,>2000
DLINK3 INC R14
       MOVB *R14+,@TYPE
       MOV @NAMLEN,R3
       AI R3,-8
 
       BLWP @GPLLNK
DSRADD BYTE >03
DSRAD1 BYTE >00
*       MOV @OLDINT,@>83C2     RESTORE OLD INTERRUPTS
*       MOV @OLDINT+2,@>83C4

       MOVB @DR3LB,@VWA
       MOVB R3,@VWA
       SZCB R12,R15
       MOVB @VRD,R3
       SRL R3,5
       MOVB R3,*R13
       JNE SETEQ
       COC @GSTAT,R12
       JNE DSREND
SETEQ  SOCB R12,R15
DSREND RTWP

************************************
*BLWP @CSN										 *
*put address of string into calling R0; after BLWP R0 will contain the number *
**************************************************************
* BLWP @CNS	Convert integer number into a string		*
*		R6: contains integer to be converted		*
*		Results into GPBUFF+2
**************************************************************
*BL @GET1   Address of 1st argument in list goes to R6
*BL @GET4	Address of 1st argument to R3, 4th to R6
*****************************************************
*DISPLAY format saves everything as a string
**********************************************
*C *R13,R15	See if next word is a number or an instruction
*	JLT HCHARX	if LT then optional number included
*      R15 is GPBUF if GT then next number is instruction
*****************************
*to find out if a variable or constant is a string:
*	BL @ASTRNG		if R6 points to a string
*	JEQ STRING		if EQ it's a string
*****************************************
*BLWP @STRSTR - stores a string in the string buffer space
*Calling R0 points to length byte at front of string
*Calling R1 has address of pointer i.e. after GET1 put R6 into R1
*******************************
*MG DSRLNK - EQ will be set on return if there was an error
*R0 will have error code in MSB of R0
**************************************

*GPBUFF is >0118 bytes long

********************
EOF	BL @GET2	file # is in R5; temp variable in R6
	MOV *R5,R8
	BL @GTPABA
	LI R1,>0900	opcode for status
	BL @GODSR
EOF3	MOVB R9,R0	restore msb pab address
	DEC R0		byte 8 of pab
	BLWP @VSBR	read byte 8
	CLR R2
	SLA R1,7
	JNC EOF1
	DEC R2		if a carry then disk is full
EOF1	SLA R1,1
	JNC EOF2
	INC R2		if carry then at end of file
EOF2	MOV R2,*R6
	JMP OPENBK

***************************************************
*OPEN	next word is number, next word is 1st 2 bytes in PAB,
*      then Device Name. If 4th word 
*      word it is length such as 80
*      

PAB	DATA >0000,PAB+64,>5000,>0000,>6000
*****************************************************
OPEN	BL @GET3
*file number pointed to by R9
	MOV *R4,R8
	BL @GTPABA	get vdp address of pab in R9
*write the disk name to VDP			
	MOV R9,R0
	AI R0,9	now R0 points to address in VDP
	MOV *R6,R1	R1 points to string
	MOVB *R1,R2	length byte to r2
	SRL R2,8	to lsb
	INC R2		one more to include length byte
	BLWP @VMBW	write name of file to vdp
*device name written to vdp, now prepare pab		
	MOV *R5,@PAB	1st 2 bytes of PAB ready (computed by compiler)
	LI R6,>0050	default length of 80	
	C *R13,R15
	JGT OPEN1	no length was passed
	BL @GET1	get pointer to length in R6
	MOV *R6,R6	move the length to R6
OPEN1	SLA R6,8	length to MSB
	MOVB R6,@PAB+4	move length to byte 4,
*PAB is ready, send to VDP and call DSRLNK
	MOV R9,R0
	LI R1,PAB
	LI R2,9
	MOV R9,R3
	AI R3,>0040
	MOV R3,@2(R1)
	BLWP @VMBW
	CLR R1		0 is opcode for open
	BL @GODSR
OPENBK	B @RTN
	
GODSR	MOV R11,R10	because of BL @VSBW
	MOV R9,R0	address of pab
	BL @VSBW	send opcode to VDP
	AI R0,9	now R4 points to name length
	MOV R0,@>8356		pointer to name length to >8356
	
	BLWP @DSRLNK
	DATA 8
	JEQ GODSRE	if EQ then there was an error
GODSR1 B *R10

*R0 will have error code (0 to 7)	
GODSRE	MOV @ERRLN,R13	goto line # contained in ERRLN
	MOV @DERRLN,@ERRLN	default line is LASTLN
	B @RTN
	
*sub below gets address of PAB, put file# in R8, address will be in r9	
GTPABA	LI R2,>0140
	MPY R2,R8	now r9 is >140,>280, or >3c0
	AI R9,>2EC0	r9 is >3000,>3140, or >3280
	B *R11
	
*************************************************************************
*CLOSE	next word is number
CLOSE	BL @GET1	get the file number to close 
	MOV *R6,R8
	BL @GTPABA
	LI R1,>0100	Close
	BL @GODSR
	JMP OPENBK
*************************************************************************
*INPUTN  next word is number, words after that are strings or #s to input
LINPTN
INPUTN	BL @GET1	get the file number to input from but will ignore
	MOV *R6,R8
	BL @GTPABA
INPTN1	C *R13,R15
	JH OPENBK 	if next number is instruction then return
	LI R1,>0200
	BL @GODSR	otherwise read from disk
INPTNL	MOV R9,R0	Need to find out how many bytes were read
	AI R0,5
	BLWP @VSBR	   read length byte
	MOVB R1,@GPBUFF  put the length byte into GPBUFF
	SRL R1,8		length to lsb of R0
	MOV R1,R2
	LI R1,GPBUFF+1	Put string after length byte
	AI R0,59	59+5=64 - start of buffer in vdp
	BLWP @VMBR	copy string to gpbuff
	LI R0,GPBUFF		gpbuff in R0
	
INPTN2 BL @GET1	fetch address of string or number into R6
	BL @ASTRNG	see if it is a string or number
	JEQ INPTN5
*a number
*R0 points to GPBUFF
	BLWP @CSN
	MOV R0,*R6	assign the number
	JMP INPTN1
*a string
INPTN5	MOV R6,R1	now R1 points to the string.
	BLWP @STRSTR
	JMP INPTN1

***************************************************
*
*PRINTN   next word is number, words after that are strings or #s to print
*         look for trailing comma for pending print operation

PRINTN	BL @GET1	get file number to print to (will ignore this for now)
	MOV *R6,R8
	BL @GTPABA
PRNTN1	C *R13,R15	out of strings/numbers to print to file?
	JH OPENBK	go back if done
	BL @GET1	get pointer to string/number
	BL @ASTRNG	see if it's a string
	JEQ PRNTN8	handle strings at prntn8
*a number if here 
*N.B. in XB positive numbers padded with space on either side
*Negative numbers have a - in front and padded with trailing space
*length byte adjusted accordingly i.e. a zero has a length of 3
*-1 has a length of 3  (this is XB format)
	MOV *R6,R6
	BLWP @CNS	now string is in gpbuff+2
	LI R1,GPBUFF+2 R1 points to beginning of string
	JMP PRNTN9	
PRNTN8	MOV *R6,R1	address of string to R1
PRNTN9	MOVB *R1+,R2	put length byte into msb of R2 and inc r1
	SRL R2,8	# bytes to write to buffer
	MOV R9,R0
	AI R0,64
	BLWP @VMBW	write string to buffer (without length byte)
	AI R0,-59
	MOV R2,R1	
	SWPB R1
	BL @VSBW	write the # bytes into PAB
	LI R1,>0300 	Opcode for write
	BL @GODSR
	JMP PRNTN1
	
****************************************************
*ERROR	   look for line number following error
*ERRLN contains line number to go to if error
ERROR	LI R3,LASTLN
	C *R13,R15	see if line number follows error
	JGT ERROR5
	MOV *R13+,R3
ERROR5	MOV R3,@ERRLN
	JMP OPENBK	

*RETURN - must doctor RETURN to look for RETURN NEXT or RETURN 1234(done)
********************

*Must make close file when program stops
