********************************************************************************
*GPLLNK AND DSRLINK FROM THE SMART PROGRAMMER (dsrlnk in runtime7)
********************************************************************************
 
GPLWS	EQU >83E0
GR4	EQU GPLWS+8
GR6	EQU GPLWS+12
LDGADD EQU >60
XTAB27 EQU >200E
GETSTK EQU >166C
 
GPLLNK DATA GLNKWS
	DATA GLINK1
 
RTNAD	DATA XMLRTN
GXMLAD DATA >176C
	DATA >50
 
GLNKWS EQU $->18
	BSS >08
 

GLINK1	MOV *R11,@GR4
	MOV *R14+,@GR6
	MOV @XTAB27,R12
	MOV R9,@XTAB27
	LWPI GPLWS
	BL *R4
	MOV @GXMLAD,@>8302(R4)
	INCT @>8373
	B @LDGADD
 
XMLRTN MOV @GETSTK,R4
	BL *R4
	LWPI GLNKWS
	MOV R12,@XTAB27

	RTWP
 

 

********************************************************************************
OLDINT BSS 2		A buffer to store the old interrupt
********************************************************************************

*****************************
IF	BL @GET1
	MOV *R6,R6
	JNE IF2
	INCT R13
	C *R13,R15
	JH IF3
IF2	MOV *R13,R13
IF3	B @RTN
*****************************
 
MINUS	BL @GET2
	MOV *R5,*R6
	NEG *R6
	B @RTN
*****************************
MLTPLY BL @GET3
 
	CI R4,RND
	JEQ RAND2
	CI R5,RND
	JEQ RAND1
 
	MOV *R5,R7
	MPY *R4,R7
	MOV R8,*R6
	B @RTN
 
RAND1	MOV R4,R5		pointer to limit goes to R5
RAND2	MOV @>83C0,R1
	CI R1,>C800		\
	JL RAND5		 attempt to auto randomize
	MOVB @>8379,R1	/
RAND5	LI R2,>6FE5
	MPY R1,R2
	AI R3,>7AB9
	MOV R3,@>83C0
	MOV *R5,R5
 
RAND3	C R2,R5
	JL RAND4
	SRL R2,1
	JMP RAND3
 
RAND4	SWPB R3
	DIV R5,R2
	MOV R3,*R6
	
IRND	C *R13,R15
	JGT RANDBK	go back if next word is instruction
	BL @GET2
	JMP RAND2
	
RANDBK	B @RTN
*****************************
DIVIDE BL @GET3
	CLR R10		FLAG
	CLR R7
	MOV *R4,R8
	JLT DIVID1
	JMP DIVID2
DIVID1 INV R10		if # being divided is <0 then flag=ffff
	NEG R8
DIVID2 MOV *R5,R3
	JLT DIVID3
	JMP DIVID4
 
DIVID3 INV R10
	NEG R3
 
DIVID4 DIV R3,R7
	MOV R10,R10
	JEQ DIVID5
	MOV R8,R8
	JEQ DIVID6
	INC R7
DIVID6 NEG R7
DIVID5 MOV R7,*R6
	B @RTN
*****************************
ADD	BL @GET3
	MOV *R4,*R6
	A *R5,*R6
	B @RTN
*****************************
SBTRCT BL @GET3
	MOV *R4,*R6
	S *R5,*R6
	B @RTN
*****************************
NOT	BL @GET2
	MOV *R5,*R6
	INV *R6
	B @RTN
*****************************
AND	BL @GET3
	MOV *R5,*R6
	MOV *R4,R8
	INV R8
	SZC R8,*R6
	B @RTN
*****************************
XOR	BL @GET3
	MOV *R5,R8
	XOR *R4,R8
	MOV R8,*R6
	B @RTN
*****************************
OR	BL @GET3
	MOV *R5,*R6
	SOC *R4,*R6
	B @RTN
*****************************
 
READ	C *R13,R15		is it an instruction
	JH READBK		yes, all done with read
	BL @GET1		 otherwise get address of pointer
	MOV @DATPNT,R8	data pointer to R8
	CI R8,LASTDT		out of data statements?
	JEQ READER		yep, report error
	MOVB *R8,R7
	SRL R7,8		length to R7
	INC R7			add 1 for length byte
	MOV R7,R9
	A R8,R9		R9 points to next data in data section
	MOV R9,@DATPNT	update data pointer
	BL @ASTRNG		a string?
	JEQ READ2		if yes goto READ2
	MOV R8,R0		R0 points to length byte of string
	BLWP @CSN		string to number
	MOV R0,*R6		update numeric variable
	JMP READ		 keep going
 
READ2	MOV R8,R0		string address into R0
	MOV R6,R1		pointer to string
	BLWP @STRSTR
	JMP READ
 
READBK B @RTN
 
READER LI R0,>2100
	BL @ERRRPT		DATA ERRRPT
 
********************
*BLWP @STRSTR - stores a string in the string buffer space
*Calling R0 points to string
*Calling R1 has address of pointer i.e. after GET1 put R6 into R1
*******************************
STRSTR DATA BLWPWS,STRST1
 
STRST1 MOV *R13,R0
	MOV @2(R13),R1
 
	MOV *R1,R4
	CLR @-2(R4)
 
	MOVB *R0,R3
	SRL R3,8
	INC R3
STRST2 MOV R3,R4
	AI R4,3
	ANDI R4,>FFFE
	MOV @NXTSTR,R2
	A R2,R4
	C R4,@STKPNT
	JLE STRST3
	DECT R0		R0 gets doctored if GARBAG moves string
	BL @GARBAG
	INCT R0
	JMP STRST2
 
STRST3 MOV R4,@NXTSTR
	MOV R1,*R2+
	MOV R2,*R1
STRST4 MOVB *R0+,*R2+
	DEC R3
	JGT STRST4
	RTWP
*************
*BL @GARBAG	does a garbage collection & reports mem. error if necessary
*************
GARBAG LI R5,FRSTST
	MOV R5,R6
GARBA1 C R6,@NXTSTR
	JEQ GARBA5
	MOV @2(R6),R9
	SRL R9,8
	AI R9,4
	ANDI R9,>FFFE
	MOV *R6,R7
	JEQ GARBA2
	C R5,R6
	JNE GARBA3
	A R9,R5
GARBA2 A R9,R6
	JMP GARBA1
GARBA3 MOV R5,*R7
	INCT *R7
 
	C R6,R0		\
	JNE GARBA4		 move R0 pointer in STRSTR if GARBAG moves string
	MOV R5,R0		/
GARBA4 MOV *R6+,*R5+
	DECT R9
	JNE GARBA4
	JMP GARBA1
 
GARBA5 C R5,R6
	JNE GARBA6
	CLR @>83C4		turn off fctn 4 scan
	LI R0,>0B00
	BL @ERRRPT
GARBA6 MOV R5,@NXTSTR
	B *R11
 
*****************************
RESTOR C *R13,R15
	JH RESTO1
	MOV *R13+,R0
	JMP RESTO2
RESTO1 LI R0,FRSTDT
RESTO2 MOV R0,@DATPNT
	B @RTN
*****************************
LET	BL @GET2
	BL @ASTRNG
	JEQ LET1
	MOV *R6,*R5
	JMP LET2
LET1	MOV R5,R1
	MOV *R6,R0
	BLWP @STRSTR
LET2	B @RTN
*****************************
STOP	B @XBRTN

***************************
LEN	BL @GET2
	MOV *R5,R5
LEN1	MOVB *R5,R4
	SRL R4,8
	MOV R4,*R6
	B @RTN
***************************
ABS	BL @GET2
	MOV *R5,*R6
	ABS *R6
	B @RTN
***************************
SGN	BL @GET2
	CLR *R6
	MOV *R5,R4
	JEQ SGN2
	JGT SGN1
	DECT *R6
SGN1	INC *R6
SGN2	B @RTN
***************************
ASC	BL @GET2
	MOV *R5,R5
	INC R5
	JMP LEN1
*************************
CHRS	BL @GET2
	MOV R6,R1
	LI R0,WKSP+6
	MOV *R5,R3
	ANDI R3,>00FF
	AI R3,>0100
	BLWP @STRSTR
	B @RTN
***************************
STRS	BL @GET2
	MOV R6,R1
	MOV *R5,R6
	BLWP @CNS
	LI R0,GPBUFF+2
	BLWP @STRSTR
	B @RTN
***************************
CONCAT BL @GET3
	MOV *R4,R4
	MOV *R5,R5
	LI R0,GPBUFF
	MOV R0,R1
	MOVB *R4,*R1
	AB *R5,*R1+
	JNC CONCA3
	SETO *R0
CONCA3 MOVB *R4+,R3
	JEQ CONCA4
	SRL R3,8
CONCA1 MOVB *R4+,*R1+
	DEC R3
	JNE CONCA1
CONCA4 MOVB *R5+,R3
	JEQ CONCA5
	SRL R3,8
CONCA2 CI R1,GPBUFF+256
	JHE CONCA5
	MOVB *R5+,*R1+
	DEC R3
	JNE CONCA2
CONCA5 MOV R6,R1
	BLWP @STRSTR
	B @RTN
***************************
VAL	BL @GET2
	MOV *R5,R0
	BLWP @CSN
	MOV R0,*R6
	B @RTN
***************************
INT	BL @GET2
	MOV *R5,*R6
	B @RTN
***************************
 
SEGS	LI R0,GPBUFF
	MOV R0,R7
	CLR *R7		in case of null string
	BL @GET4
	MOV *R3,R3
	MOVB *R3,R2
	SRL R2,8
	MOV *R4,R4
	MOV *R5,R5
	JEQ SEGS3
	C R4,R2		pointer past end of string?
	JGT SEGS3
 
	S R4,R2
	INC R2
	C R2,R5
	JHE SEGS1
	MOV R2,R5
SEGS1	MOVB @WKSP+11,*R7+
	A R4,R3
SEGS2	MOVB *R3+,*R7+
	DEC R5
	JNE SEGS2
SEGS3	MOV R6,R1
	BLWP @STRSTR
	B @RTN
 
*****************************
CGT	LI R2,>4000		0100 R2
	JMP CEQ1		0100 R3
 
CLT	CLR R2			0000 R2
CLT1	CLR R3		0000 R3
	JMP CMPARE
 
CEQ	LI R2,>2000		0010 R2
CEQ1	MOV R2,R3		0010 R3
	JMP CMPARE
 
CNE	LI R2,>4000		0100 R2
	JMP CLT1		0000 R3
 
CLE	LI R2,>2000		0010 R2
	JMP CLT1		0000 R3
 
CGE	LI R2,>2000		0010 R2
	LI R3,>4000		0100
 
CMPARE BL @GET3
	MOV R6,R7
	MOV R5,R6
	BL @ASTRNG
	JNE CMPAR5
 
	MOV *R4,R4		compare strings
	MOV *R6,R6
	MOVB *R4+,R10
	SRL R10,8		r10 has length of string at R4
	MOVB *R6+,R11
	SRL R11,8		R11 has length of string at R6
	C R10,R11
	JL CMPAR1
	MOV R11,R12
	JMP CMPAR2
CMPAR1 MOV R10,R12
CMPAR2 JEQ CMPAR4		shortest length to R12; if zero don't compare strings
CMPAR3 CB *R4+,*R6+
	JNE CMPAR6
	DEC R12
	JNE CMPAR3
CMPAR4 C R10,R11
	JMP CMPAR6
 
CMPAR5 C *R4,*R6
CMPAR6 STST R9
	ANDI R9,>6000
	C R2,R9
	JEQ CMPAR7
	C R3,R9
	JEQ CMPAR7
	CLR *R7
	JMP CMPAR8
CMPAR7 SETO *R7
CMPAR8 B @RTN
 
 
*****************************
ONGOTO BL @GET1
	MOV *R6,R6
	DEC R6
	SLA R6,1
	A R6,R13
*****************************
GOTO	 MOV *R13,R13
	B @RTN
*****************************
ONGOSU BL @GET1
	MOV *R6,R6
	DEC R6
	SLA R6,1
	A R13,R6
	MOV *R6,R8
ONGOS1 C *R13,R15		\
	JH GOSUB1		 read through line numbers till R13
	INCT R13		 points to next instruction
	JMP ONGOS1		/
*****************************
GOSUB	MOV *R13+,R8
GOSUB1 DECT @STKPNT
	C @NXTSTR,@STKPNT
	JLE GOSUB2
	BL @GARBAG
GOSUB2 MOV @STKPNT,R12
	MOV R13,*R12
	MOV R8,R13
	B @RTN
*****************************
RETURN C *R13,R15	for error when accessing disk
	JLT GOTO	if next word not instruction then must be line number
	
	MOV @STKPNT,R8
*	CI R8,FRSTLN
*	JL ONWARD, ELSE REPORT RETURN W/O GOSUB
	MOV *R8,R13
	INCT @STKPNT
	B @RTN

FOR	BL @GET4	 !!!NEXT MUST occur after FOR in BASIC program
	MOV *R4,*R3
	MOV *R6,R8	test whether step is pos or neg
	JLT FORX1
	C *R4,*R5
	JGT FORX4	 pos step; if 1st # bigger than 2nd then bypass
	JMP FORX2
FORX1	C *R5,*R4	 neg step; if 2nd # bigger than 1st then bypass
	JGT FORX4
FORX2	MOV *R5,*R13+
	MOV *R6,*R13+
FORX3	B @RTN
 
FORX4	MOV R13,R5	pointer to R5
	AI R5,-8		to jibe with NEXT address
	AI R13,4		bypass 2 temp variables
	LI R4,NEXT
FORX5	C *R13+,R4	look for NEXT
	JNE FORX5
	C *R13+,R5	found NEXT, check if right one
	JNE FORX5
	JMP FORX3	 return
 
 
NEXT	MOV R13,R12	store R13 for noe
	MOV *R13,R13	get pointer to variable name
	MOV *R13+,R7	get address of variable in R7
 
	LI R0,3	3 variables to bypas
NEXT10 MOV *R13+,R1
	C R1,R14	is this variable an array?
	JLT NEXT12	 no array, jump
NEXT11 MOV *R1+,R2	bypass the right # elements in array
	JEQ NEXT12	 when zero is found then done with elements
	INCT R13
	JMP NEXT11
NEXT12 DEC R0
	JNE NEXT10
 
	MOV *R13+,R5	actual limit to R5; step to R6 (not pointers!)
	MOV *R13+,R6
 
	MOV *R7,R1
	A R6,*R7
	MOV R6,R8
	JLT NEXT1	if LT then step is negative
	C *R7,R1
	JLT DONE
	C *R7,R5	positive step; if R7>R5 then done
	JMP NEXT2
NEXT1	C *R7,R1
	JGT DONE
	C R5,*R7	Negative step; compare limit with variable
NEXT2	JGT DONE
	B @RTN
 
DONE	MOV R12,R13
	INCT R13
	B @RTN
***************************
KEY	BL @GET3
	MOV *R4,R4
	SWPB R4
	MOVB R4,@>8374
	BLWP @KSCAN
	MOVB @>8375,R3
	SRL R3,8		Key byte to lsb
	CI R3,>00FF
	JNE KEY1
	SETO R3		Key=-1
KEY1	MOV R3,*R5
	CLR R2			status
	CI R3,>FFFF		if -1 then no key, status=0
	JEQ KEY3
	MOV @>837C,R1
	COC @HX2000,R1
	JNE KEY2
	INCT R2
KEY2	DEC R2
KEY3	MOV R2,*R6
	B @RTN
	
*************************
SCREEN BL @GET1
	MOV *R6,R0
	AI R0,>070F		REGISTER 7, foreground=black
	BLWP @VWTR	
	
	MOV @SCRENE,R5
	JEQ SCREE1		if EQ then are in screen1
	MOV R0,@SC2CLR	move to screen2 color
	JMP SCREE2
SCREE1	MOV R0,@SC1CLR	move to screen1 color
SCREE2	B @RTN
  
*******************************
CLEAR	CLR R0
	LI R1,>8000
	LI R2,768
	BL @VSBW
	JMP CLEAR2
CLEAR1 MOVB R1,@>8C00
CLEAR2 DEC R2
	JNE CLEAR1
	B @RTN
