;---------------------------------------------------------------------
;    **   **   **  ***   ***   ****     **    ***  **  ****
;   ****  *** *** ** ** **     ** **   ****  **    ** **  **
;  **  ** ** * ** ** **  ***   *****  **  **  ***  ** **
;  ****** **   ** ** **    **  **  ** ******    ** ** **
;  **  ** **   ** ** ** *  **  **  ** **  ** *  ** ** **  **
;  **  ** **   **  ***   ***   *****  **  **  ***  **  ****
;---------------------------------------------------------------------
; Serial extension source code, V1.1
; By François Lionet
; AMOS and AMOS Compiler (c) Europress Software 1991
; To be used with AMOS1.3 and over
;--------------------------------------------------------------------- 
; This file is public domain
;---------------------------------------------------------------------
;
; Please refer to the _Music.s file for more informations...
;
;---------------------------------------------------------------------

		XREF		_LVOOpenDevice
		XREF		_LVOCloseDevice
		XREF		_LVOCheckIO
		XREF		_LVOWaitIO
		XREF		_LVOAbortIO
		XREF		_LVOSendIO
		XREF		_LVODoIO

* AMIGA's includes
		INCDIR		":Includes/I/"
		INCLUDE		"Exec/Types.I"
		INCLUDE		"Exec/Exec.I"
		INCLUDE 	"Devices/Serial.I"

*************** AMOS includes
ExtNb		equ	6-1

		INCDIR		":AMOS1.3/Comp/"
 		Include	"_Equ.s"
		RsSet	DataLong
		Include "_Pointe.s"
		Include	"_WEqu.s"
		Include "_CEqu.s"
		Include	"_LEqu.s"

Dlea		MACRO
		move.l	ExtAdr+ExtNb*16(a5),\2
		add.w	#\1-DT,\2
		ENDM
Dload		MACRO
		move.l	ExtAdr+ExtNb*16(a5),\1
		ENDM

* Number of serial channels allowed
NSerial		equ	4

******************************************************************
*	Header
Start	dc.l	C_Tk-C_Off
	dc.l	C_Lib-C_Tk
	dc.l	C_Title-C_Lib
	dc.l	C_End-C_Title
	dc.w	0	

******************************************************************
*	Offsets to library
C_Off   dc.w (L1-L0)/2,(L2-L1)/2,(L3-L2)/2,(L4-L3)/2
        dc.w (L5-L4)/2,(L6-L5)/2,(L7-L6)/2,(L8-L7)/2
        dc.w (L9-L8)/2,(L10-L9)/2,(L11-L10)/2,(L12-L11)/2
        dc.w (L13-L12)/2,(L14-L13)/2,(L15-L14)/2,(L16-L15)/2
        dc.w (L17-L16)/2,(L18-L17)/2,(L19-L18)/2,(L20-L19)/2
        dc.w (L21-L20)/2,(L22-L21)/2,(L23-L22)/2,(L24-L23)/2
        dc.w (L25-L24)/2,(L26-L25)/2,(L27-L26)/2,(L28-L27)/2
        dc.w (L29-L28)/2,(L30-L29)/2,(L31-L30)/2,(L32-L31)/2
        dc.w (L33-L32)/2,(L34-L33)/2,(L35-L34)/2

******************************************************************
*	TOKEN TABLE
C_Tk	dc.w 	1,0
	dc.b 	$80,-1
	dc.w	L_SerOp2,-1
	dc.b	"!serial ope","n"+$80,"I0,0",-2
	dc.w	L_SerOp5,-1
	dc.b	$80,"I0,0,0,0,0",-1
	dc.w	L_SerClo0,-1
	dc.b	"!serial clos","e"+$80,"I",-2
	dc.w	L_SerClo1,-1
	dc.b	$80,"I0",-1
	dc.w	L_SerSp,-1
	dc.b	"serial spee","d"+$80,"I0,0",-1
	dc.w	-1,L_SerChk
	dc.b	"serial chec","k"+$80,"00",-1
	dc.w 	L_SerSend,-1
	dc.b	"serial sen","d"+$80,"I0,2",-1
	dc.w 	L_SerSp,-1
	dc.b	"serial spee","d"+$80,"I0,0",-1
	dc.w 	L_SerBit,-1
	dc.b	"serial bit","s"+$80,"I0,0,0",-1
	dc.w 	L_SerX,-1
	dc.b	"serial ","x"+$80,"I0,0",-1
	dc.w 	L_SerBuf,-1
	dc.b	"serial bu","f"+$80,"I0,0",-1
	dc.w 	L_SerPar,-1
	dc.b	"serial parit","y"+$80,"I0,0",-1
	dc.w	-1,L_SerGet
	dc.b	"serial ge","t"+$80,"00",-1
	dc.w	-1,L_SerInp
	dc.b	"serial input","$"+$80,"20",-1
	dc.w	L_SerFast,-1
	dc.b	"serial fas","t"+$80,"I0",-1
	dc.w	L_SerSlow,-1
	dc.b	"serial slo","w"+$80,"I0",-1
	dc.w	-1,L_SerE
	dc.b	"serial erro","r"+$80,"00",-1
	dc.w	L_SerOut,-1
	dc.b	"serial ou","t"+$80,"I0,0,0",-1
	dc.w	0
C_Lib

******************************************************************
*		COLD START
L0	movem.l	a3-a6,-(sp)
	lea	DT(pc),a3
	move.l	a3,ExtAdr+ExtNb*16(a5)
	lea	SerDef(pc),a0
	move.l	a0,ExtAdr+ExtNb*16+4(a5)
	lea	SerEnd(pc),a0
	move.l	a0,ExtAdr+ExtNb*16+8(a5)
	movem.l	(sp)+,a3-a6
	moveq	#ExtNb,d0		* NO ERRORS
	rts

******* SCREEN RESET
SerDef	
******* QUIT
SerEnd	Rbra	L_SCloseA

*************** Data zone
DT
SerialIO	ds.l	NSerial*2
BufIn		dc.l	0
		dc.l	0
SerName		SERIALNAME
		even

L1
L2

***********************************************************
*	OPEN SERIAL DEVICE

******* Seropen logicnumber,physicnumber[,shared,xdisabled,7wires]	
L_SerOp2	equ	3
L3	clr.l	-(a3)
	clr.l	-(a3)
	clr.l	-(a3)
	Rbra	L_SerOp5
L_SerOp5	equ	4
L4	movem.l	a4-a6,-(sp)
	move.l	16(a3),d0
	Rbsr	L_GetSerial
	tst.l	(a2)
	Rbne	L_SerAOp
; Opens communication port
	clr.l	-(sp)
	clr.l	-(sp)
	moveq	#0,d0
	Rbsr	L_Amiga.Lib
	addq.l	#8,sp
	move.l	d0,4(a2)
	Rbeq	L_SerOpE
; Opens IO structure
	move.l	#IOEXTSER_SIZE,-(sp)
	move.l	d0,-(sp)
	moveq	#2,d0
	Rbsr	L_Amiga.Lib
	addq.l	#8,sp
	move.l	d0,(a2)
	Rbeq	L_SerOpE
; Opening parameters
	move.l	d0,a1
	tst.l	(a3)+
	beq.s	SerOpA
	bset	#SERB_7WIRE,IO_SERFLAGS(a1)
SerOpA	bset	#SERB_XDISABLED,IO_SERFLAGS(a1)
	tst.l	(a3)+
	beq.s	SerOpB
	bclr	#SERB_XDISABLED,IO_SERFLAGS(a1)
SerOpB  tst.l	(a3)+
	beq.s	SerOpC
	bset	#SERB_SHARED,IO_SERFLAGS(a1)
SerOpC	
	Dlea	SerName,a0
	move.l	(a3),d0
	moveq	#0,d1
	move.l	$4.w,a6
	jsr	_LVOOpenDevice(a6)
	tst.l	d0
	Rbne	L_SerOpE
	bset	#7,4(a2)
	move.l	(a3)+,d0
	addq.l	#4,a3
	beq.s	.PaSet
* If NOT user-serial (#0),
* default settings for French MINITEL: 1200/7/1 Stop/EVEN parity
	move.l	(a2),a1
	move.l	#1200,IO_BAUD(a1)
	move.b	#7,IO_READLEN(a1)
	move.b	#7,IO_WRITELEN(a1)
	move.b	#1,IO_STOPBITS(a1)
	bset	#SERB_XDISABLED,IO_SERFLAGS(a1)
	bset	#SERB_PARTY_ON,IO_SERFLAGS(a1)
	bclr	#SERB_PARTY_ODD,IO_SERFLAGS(a1)
	bclr	#SEXTB_MSPON,IO_EXTFLAGS+3(a1)
	bclr	#SEXTB_MARK,IO_EXTFLAGS+3(a1)
	Rbsr	L_Stpar
.PaSet	movem.l	(sp)+,a4-a6
	rts

***********************************************************
*	Serclose [N]
L_SerClo1	equ	5
L5	move.l	(a3)+,d0
	Rbsr	L_GetSerial
	tst.l	(a2)
	Rbeq	L_SerNOp
	Rbne	L_SClose
;-----> Close ALL channels
L_SerClo0	equ	6	
L_SCloseA	equ	6
L6	Dlea	SerialIO,a2
	moveq	#NSerial-1,d2
SCloA1	Rbsr	L_SClose
	lea	8(a2),a2
	dbra	d2,SCloA1
	rts
;-----> Close channel A2
L_SClose	equ	7
L7	movem.l	a0-a6/d0-d7,-(sp)
	move.l	4.w,a6
; Close device
	bclr	#7,4(a2)
	beq.s	SClo1
	move.l	(a2),a1
	jsr	_LVOAbortIO(a6)
	move.l	(a2),a1
	jsr	_LVOWaitIO(a6)
	move.l	(a2),a1
	jsr	_LVOCloseDevice(a6)
; Delete IO structure
SClo1	tst.l	(a2)
	beq.s	SClo2	
	move.l	(a2),-(sp)
	clr.l	(a2)	
	moveq	#3,d0
	Rbsr	L_Amiga.Lib
	addq.l	#4,sp
; Remove message port
SClo2	tst.l	4(a2)
	beq.s	SClo3
	move.l	4(a2),-(sp)
	clr.l	4(a2)
	moveq	#1,d0
	Rbsr	L_Amiga.Lib
	addq.l	#4,sp
SClo3	movem.l	(sp)+,d0-d7/a0-a6
	rts

***********************************************************
*	Serial Send ser,A$
L_SerSend	equ	8
L8	move.l	(a3)+,d1
	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	move.l	d1,a2
	moveq	#0,d0
	move.w	(a2)+,d0
	Rbeq	L_IFonc
	move.l	d0,IO_LENGTH(a1)
	move.l	a2,IO_DATA(a1)
	moveq	#CMD_WRITE,d0
	Rbra	L_DoSENDIO
***********************************************************
*	Serial Out ser,address,length
L_SerOut	equ	9
L9	move.l	(a3)+,d2
	Rbmi	L_IFonc
	Rbeq	L_IFonc
	move.l	(a3)+,d1
	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	move.l	d1,IO_DATA(a1)
	move.l	d2,IO_LENGTH(a1)
	moveq	#CMD_WRITE,d0
	Rbra	L_DoSENDIO
***********************************************************
*	=Serial Get(ser)
L_SerGet	equ	10
L10	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	move.w	#SDCMD_QUERY,d0
	Rbsr	L_DoDOIO
	moveq	#-1,d3
	move.l	IO_ACTUAL(a1),d0
	beq.s	SerINo
	Dlea	BufIn,a2
	move.l	a2,IO_DATA(a1)
	move.l	#1,IO_LENGTH(a1)
	moveq	#CMD_READ,d0
	Rbsr	L_DoDOIO
	moveq	#0,d3
	move.b	(a2),d3
SerINo	moveq	#0,d2
	rts
***********************************************************
*	=Serial Input$(Ser) 
L_SerInp	equ	11
L11	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	moveq	#SDCMD_QUERY,d0
	Rbsr	L_DoDOIO
	move.l	IO_ACTUAL(a1),d4
	beq.s	SInpNo
	cmp.l	#65530,d4
	Rbcc	L_IFonc
* Ask for string space...
	move.l	a1,-(sp)
	move.l	d4,d3
	and.w	#$FFFE,d3		* Only EVEN!
	addq.w	#2,d3
	Rjsr	L_Demande
	lea	2(a1,d3.w),a1
	move.l	a1,HiChaine(a5)
* Send to device...
	move.l	(sp)+,a1
	move.l	a0,d3
	move.w	d4,(a0)+
	move.l	a0,IO_DATA(a1)
	move.l	d4,IO_LENGTH(a1)
	moveq	#CMD_READ,d0
	Rbsr	L_DoDOIO
	moveq	#2,d2
	rts
* Nothing to return
SInpNo	move.l	ChVide(a5),d3		* Empty string
	moveq	#2,d2
	rts

***********************************************************
*	Serial Speed ser,baud
L_SerSp		equ	12
L12	move.l	(a3)+,d1
	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	move.l	d1,IO_BAUD(a1)
	Rbra	L_Stpar
L_Stpar		equ	13
L13	
	move.w	#SDCMD_SETPARAMS,d0
	Rbsr	L_DoDOIO
	Rbne	L_SerError
	rts
***********************************************************
*	Serial Bit ser,number,stop
L_SerBit	equ	14
L14	move.l	(a3)+,d2
	move.l	(a3)+,d1
	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	move.b	d1,IO_READLEN(a1)
	move.b	d1,IO_WRITELEN(a1)
	move.b	d2,IO_STOPBITS(a1)
	Rbra	L_Stpar
***********************************************************
*	Serial Parity ser,on/off/odd/even/mspon
L_SerPar	equ	15
L15	move.l	(a3)+,d1
	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	bclr	#SERB_PARTY_ON,IO_SERFLAGS(a1)
	bclr	#SERB_PARTY_ODD,IO_SERFLAGS(a1)
	bclr	#SEXTB_MSPON,IO_EXTFLAGS+3(a1)
	bclr	#SEXTB_MARK,IO_EXTFLAGS+3(a1)
; -1-> NO PARITY
	tst.w	d1
	bmi.s	.parX
; 0--> EVEN
	bne.s	.par1
	bset	#SERB_PARTY_ON,IO_SERFLAGS(a1)
	bra.s	.parX
; 1--> ODD
.par1	cmp.w	#1,d1
	bne.s	.par2
	bset	#SERB_PARTY_ON,IO_SERFLAGS(a1)
	bset	#SERB_PARTY_ODD,IO_SERFLAGS(a1)
	bra.s	.parX
; 2--> SPACE
.par2	cmp.w	#2,d1
	bne.s	.par3
	bset	#SEXTB_MSPON,IO_EXTFLAGS+3(a1)
	bra.s	.parX
; 3--> MARK
.par3	cmp.w	#3,d1
	bne.s	.parX
	bset	#SEXTB_MSPON,IO_EXTFLAGS+3(a1)
	bset	#SEXTB_MARK,IO_EXTFLAGS+3(a1)
; Envoie
.parX	Rbra	L_Stpar	
**********************************************************
*	Serial X ser,value
L_SerX		equ	16
L16	move.l	(a3)+,d1
	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	bset	#SERB_XDISABLED,IO_SERFLAGS(a1)
	cmp.l	#-1,d1
	Rbeq	L_Stpar
	bclr	#SERB_XDISABLED,IO_SERFLAGS(a1)
	move.l	d1,IO_CTLCHAR(a1)
	Rbra	L_Stpar
**********************************************************
*	Serial Buffer ser,length
L_SerBuf	equ	17
L17	move.l	(a3)+,d1
	move.l	(a3)+,d0
	Rbsr	L_GetSerA1
	move.l	d1,IO_RBUFLEN(a1)
	Rbra	L_Stpar
*********ome message
C_Title		dc.b 	31,"Requester V 1.3",0
*		End of extension
C_End		dc.w	0

	even
y:		rÊØfECo:		rs.w 1
DefECoN:	rs.w 1
DefEMo:		rs.w 1
DefEBa:		rs.w 1
DefEPa:		rs.w 8
		rs.w 8
		rs.w 8
		rs.w 8
EndPar:
ything ÊXe instruction.
;
;	- First character:
;		The first character defines the TYPE on instruction:
;			I--> instruction
;			0--> function that returns a integer
;			1--> function that returns a float
;			2--> function that returns a string
;			V--> reserved variable. In that case, you must
;				state the type int-float-string
;	- If your instruction does not need parameters, then you stop
;	- Your instruction needs parameters, now comes the param list
;			Type,TypetType,Type...
;		Type of the parameter (0 1 2)
;		Comma or "t" for TO
;
;	(4) End of instruction
;			"-1" states the end of the instruction
;			"-2" tells AMOS that another parameter list
;			     can be accepted. if so, MUST follow the
;			     complete instruction definition as explained
;			     but with another param list.
;	If so, you can use the "!" and $80 facility not to rewrite the
;	full name of the instruction...See SAM LOOP ON instruction for an
;	example...
;
;	Remember that AMOS token list comes first, so names like:
;	PRINTHELLO will never work: AMOS will tokenise PRINT first!
;	Extension token list are explored in order of number...

; The next two lines needs to be unchanged...
C_Tk:	dc.w 	1,0
	dc.b 	$80,-1

; Now the real tokens...
	dc.w	-1,L_FMB
	dc.b	"mubas","e"+$80,"0",-1
	dc.w	-1,L_FVu
	dc.b	"vumete","r"+$80,"00",-1
	dc.w	L_IVoice,-1
	dc.b	"voic","e"+$80,"I0",-1
	dc.w	L_IMusOff,-1
	dc.b	"music of","f"+$80,"I",-1
	dc.w	L_IMuStop,-1
	dc.b	"music sto","p"+$80,"I",-1
	dc.w	L_ITempo,-1
	dc.b	"temp","o"+$80,"I0",-1
	dc.w	L_IMusic,-1
	dc.b	"musi","c"+$80,"I0",-1
	dc.w	L_INoTo,-1
	dc.b	"noise t","o"+$80,"I0",-1
	dc.w	L_Boom,-1
	dc.b 	"boo","m"+$80,"I",-1
	dc.w	L_Shoot,-1
	dc.b	"shoo","t"+$80,"I",-1
	dc.w	L_ISBank,-1
	dc.b	"sam ban","k"+$80,"I0",-1
	dc.w	L_ISLOn0,-1
	dc.b	"!sam loop o","n"+$80,"I",-2
	dc.w	L_ISLOn1,-1
	dc.b	$80,"I",-1
	dc.w	L_ISLOf0,-1
	dc.b	"sam loop of","f"+$80,"I",-2
	dc.w	L_ISLOf1,-1
	dc.b	$80,"I0",-1
	dc.w	L_ISamTo,-1
	dc.b	"sampl","e"+$80,"I0t0",-1
	dc.w 	L_ISam1,-1
	dc.b 	"!sam pla","y"+$80,"I0",-2
	dc.w	L_ISam2,-1
	dc.b	$80,"I0,0",-2
	dc.w 	L_ISam3,-1
	dc.b	$80,"I0,0,0",-1 
	dc.w 	L_ISamR,-1
	dc.b 	"sam ra","w"+$80,"I0,0,0,0",-1	
	dc.w	L_Bell0,-1
	dc.b 	"!bel","l"+$80,"I",-2
	dc.w 	L_Bell1,-1
	dc.b	$80,"I0",-1
	dc.w	L_IPlOf0,-1
	dc.b	"!play of","f"+$80,"I",-2
	dc.w	L_IPlOf1,-1
	dc.b	$80,"I0",-1
	dc.w 	L_IPlay2,-1
	dc.b	"!pla","y"+$80,"I0,0",-2
	dc.w	L_IPlay3,-1
	dc.b	$80,"I0,0,0",-1
	dc.w 	L_ISWave,-1
	dc.b 	"set wav","e"+$80,"I0,2",-1
	dc.w	L_IDWave1,-1
	dc.b	"del wav","e"+$80,"I0",-1
	dc.w	L_ISEnv,-1
	dc.b	"set enve","l"+$80,"I0,0t0,0",-1
	dc.w	L_IMVol,-1
	dc.b	"mvolum","e"+$80,"I0",-1
	dc.w 	L_IVol1,-1
	dc.b	"!volum","e"+$80,"I0",-2
	dc.w 	L_IVol2,-1
	dc.b	$80,"I0,0",-1
	dc.w	L_IWave,-1
	dc.b 	"wav","e"+$80,"I0t0",-1
	dc.w	L_LedOn,-1
	dc.b	"led o","n"+$80,"I",-1
	dc.w	L_LedOf,-1
	dc.b	"led of","f"+$80,"I",-1
	dc.w	L_ISay1,-1
	dc.b	"!sa","y"+$80,"I2",-2
	dc.w	L_ISay2,-1
	dc.b	$80,"I2,0",-1
	dc.w	L_ITalk,-1
	dc.b	"set tal","k"+$80,"I0,0,0,0",-1
	dc.w 	0


;
; Now come the big part, the library. Every routine is delimited by the
; two labels: L(N) and L(N+1).
; AMOS loads the whole extension, but the compiler works differently:
; The compiler picks each routine in the library and copy it into the
; program, INDIVIDUALLY. It means that you MUST NEVER perform a JMP, a
; BSR or get an address from one library routine to another: the distance
; between them may change!!! Use the special macros instead...
;
; Importants points to follow: 
;
;	- Your code must be (pc), TOTALLY relocatable, check carefully your
;  	code!
;	- You cannot directly call other library routines from one routine
;	by doing a BSR, but I have defined special macros (in S_CEQU file) 
;	to allow you to easily do so. Here is the list of available macros:
;
;	RBsr	L_Routine	does a simple BSR to the routine
;	RBra	L_Routine	as a normal BRA
;	RBeq	L_Routine	as a normal Beq
;	RBne	L_Routine	...
;	RBcc	L_Routine
;	RBcs	L_Routine
;	RBlt	L_Routine
;	RBge	L_Routine
;	RBls	L_Routine
;	RBhi	L_Routine
;	RBle	L_Routine
;	RBpl	L_Routine
;	RBmi	L_Routine
;
; I remind you that you can only use this to call an library routine
; from ANOTHER routine. You cannot do a call WITHIN a routine, or call
; the number of the routine your caling from...
; The compiler (and AMOS1.3 extension loading part) will manage to find
; the good addresses in your program from the offset table.
;
; You can also call some main AMOS.Lib routines, to do so, use the 
; following macros:
;
;	RJsr	L_Routine	
;	RJmp	L_Routine	
; 
; As you do not have access any more to the small table with jumps to the
; routines within AMOS, here is the concordance of the routines (the numbers
; are just refecrences to the old AMOS 1.23 calling table, and is not of
; any use in AMOS1.3):
;
;	04- Normal error	RJmp	L_Error
;	08- Specific error	RJmp 	L_Error
;	0C- D3->A0 Bank address	RJsr	L_BankAd
;	10- Performs update	RJsr	L_Tests
;	14- Wait routine	RJsr	L_WaitRout
;	18- Get screen address	RJsr	L_GetEc
;	1C- Address or bank?	RJsr	L_AdOuBank
;	20- Erases bank #D3	RJsr	L_EffBank
;	24- Ask for string 	RJsr	L_Demande
;
; Explanation:
;	04- Normal error, please look to the last routine in the library.
;	08- D3.l (number of bank-1) -> A0 Bank address
;	10- Performs update
; 	14- Wait routine (see play)
;	18- Get screen address D0.l= screen number, return A0= adress
;	1C- Address or memory bank? (D3.l)
;	20- Erases bank #D3.l
;	24- D3.l is the length to ask for. Return A0/A1 point to free space.
;	    Poke your string there, add the length of it to A0, EVEN the 
;	    adress to the highest multiple of two, and move it into
;	    HICHAINE(a5) location...
;
; Some extra routines:
;	RJsr	L_RamChip	Ask for CLEAR, CHIP ram, size D0, 
;				returns address in D0, nothing changed
;	RJsr	L_RamChip2	CHI