****************************************************************
*
*       Le_Lisp  LLM3  :  les	trucs en tout genre	:
*		      (dernier module LLM3)
*
****************************************************************
*
*	       Jerome CHAILLOUX  (Chailloux.Vlsi)
*		        I.N.R.I.A.
*	       Domaine de Voluceau,  Rocquencourt
*	       B.P. 105,   78153 Le Chesnay Cedex
*	       tel : (1) 954 90 20	  poste 456
*
*****************************************************************


	TITRE	BLLSHT	   LLM3 :	le bullshit en tout	genre

	PURE

	XREF	BUILDAT,CSYMB		pour MAKFNT
	XREF	.UNDEF,.T,.VOID
	XREF	GC			pour CONS

	XREF	BCODE,ECODE
	XREF	REENTER,THEEND
	XREF	ERRNLA


	XDEF	INI_BLL

*
*	Creation des symboles
*	=====================
*

INI_BLL	EQU	*
	NOLIST
	MAKFNT	LOC,0,.VOID,3,'LOC'
	MAKFNT	VAG,0,.VOID,3,'VAG'
	MAKFNT	MEMORY,0,.VOID,6,'MEMORY'
	MAKFNT	ADDADR,0,.VOID,6,'ADDADR'
	MAKFNT	SUBADR,0,.VOID,6,'SUBADR'
	MAKFNT	GTADR,0,.VOID,5,'GTADR'

	MAKFNT	ABCODE,0,.VOID,6,<':BCODE'>
	MAKFNT	AECODE,0,.VOID,6,<':ECODE'>

	RETURN

*
*	(LOC s)	retourne l'adresse de s
*		(sous la forme (high . low))
*
*----------------------------------------
	FENTRY	LOC,SUBR1
*----------------------------------------
*	MOV	A1,D2
*	SWAP	D2
*	AND.L	#$FFFF,D2		isole les	poids forts
*	BEQ.S	LOC9		c'est un nb simple.
*	MOV	A1,D1
*	AND.L	#$FFFF,D1		isole les	poids faibles
*	CRANB	D1,A1		poids faibles internes
*	CRANB	D2,A2		poids forts internes
*	CONS	A2,A1		(forts . faibles)
LOC9	RETURN	*		qui est retournee

*
*	(VAG (high . loc))	retourne l'objet d'adresse (l	. h)
*
*----------------------------------------
	FENTRY	VAG,SUBR1
*----------------------------------------
	BFCONS.S	A1,VAGERR		il faut une liste
	MOV	CAR(A1),A2	high
	MOV	CDR(A1),A3	low
*	CLR.L	D1
*	MOVE.W	A2,D1		val high
*	CLR.L	D2
*	MOVE.W	A3,D2		val low
*	SWAP	D1		high - 00
*	OR.L	D1,D2		high - low
*	MOV	D2,A1
	RETURN
VAGERR	MOV	.VAG,A2		le nom
	BRA	ERRNLA		ce doit etre une liste

*
*	(ADDADR (high . low) (high . low))
*	fait l'addition des	2 adresses sans debordement!
*
*----------------------------------------
	FENTRY	ADDADR,SUBR2
*----------------------------------------
	BTNUMB.S	A1,ADDADR1	le nb est	pret
	BFCONS.S	A1,ADDAER1	il faut une liste alors
*	MOV	CAR(A1),A4	high
*	MOV	CDR(A1),A3	low
*	CLR.L	D1
*	MOVE.W	A4,D1		val high
*	CLR.L	D2
*	MOVE.W	A3,D2		val low
*	SWAP	D1		high - 00
*	OR.L	D1,D2		high - low
*	MOV	D2,A1
ADDADR1	BTNUMB.S	A2,ADDADR2	le nb est	pret
	BFCONS.S	A2,ADDAER2	il faut une liste alors
	MOV	CAR(A2),A4	high
	MOV	CDR(A2),A3	low
*	CLR.L	D1
*	MOVE.W	A4,D1		val high
*	CLR.L	D2
*	MOVE.W	A3,D2		val low
*	SWAP	D1		high - 00
*	OR.L	D1,D2		high - low
*	MOV	D2,A2
ADDADR2	PLUS	A2,A1		calcul de	la somme
	BRA	LOC		et on passe sous forme (h . l)

ADDAER2	MOV	A2,A1		le mauvais argument
ADDAER1	MOV	.ADDADR,A2	le nom
	BRA	ERRNLA		ce doit etre une liste

*
*	(SUBADR (high . low) (high . low))
*	fait la soustraction de 2 adresses (sans ovfl)
*
*----------------------------------------
	FENTRY	SUBADR,SUBR2
*----------------------------------------
	BTNUMB.S	A1,SUBADR1	le nb est	pret
	BFCONS.S	A1,SUBAER1	il faut une liste alors
	MOV	CAR(A1),A4	high
	MOV	CDR(A1),A3	low
*	CLR.L	D1
*	MOVE.W	A4,D1		val high
*	CLR.L	D2
*	MOVE.W	A3,D2		val low
*	SWAP	D1		high - 00
*	OR.L	D1,D2		high - low
*	MOV	D2,A1
SUBADR1	BTNUMB.S	A2,SUBADR2	le nb est	pret
	BFCONS.S	A2,SUBAER2	il faut une liste alors
	MOV	CAR(A2),A4	high
	MOV	CDR(A2),A3	low
*	CLR.L	D1
*	MOVE.W	A4,D1		val high
*	CLR.L	D2
*	MOVE.W	A3,D2		val low
*	SWAP	D1		high - 00
*	OR.L	D1,D2		high - low
*	MOV	D2,A2
SUBADR2	DIFF	A2,A1		calcul de	la somme
	BRA	LOC		et on passe sous forme (h . l)

SUBAER2	MOV	A2,A1		le mauvais argument
SUBAER1	MOV	.SUBADR,A2	le nom
	BRA	ERRNLA		ce doit etre une liste

*
*	(GTADR (high . low)	(high . low))
*	fait une comparaison d'adresse :
*	retourne T si a1 > a2
*
*----------------------------------------
	FENTRY	GTADR,SUBR2
*----------------------------------------
	BTNUMB.S	A1,CMPADR1	le nb est	pret
	BFCONS.S	A1,CMPAER1	il faut une liste alors
	MOV	CAR(A1),A4	high
	MOV	CDR(A1),A3	low
*	CLR.L	D1
*	MOVE.W	A4,D1		val high
*	CLR.L	D2
*	MOVE.W	A3,D2		val low
*	SWAP	D1		high - 00
*	OR.L	D1,D2		high - low
*	MOV	D2,A1
CMPADR1	BTNUMB.S	A2,CMPADR2	le nb est	pret
	BFCONS.S	A2,CMPAER2	il faut une liste alors
	MOV	CAR(A2),A4	high
	MOV	CDR(A2),A3	low
*	CLR.L	D1
*	MOVE.W	A4,D1		val high
*	CLR.L	D2
*	MOVE.W	A3,D2		val low
*	SWAP	D1		high - 00
*	OR.L	D1,D2		high - low
*	MOV	D2,A2
CMPADR2	CBGT.S	A1,A2,CMPADR8	si A1 >= A2
	MOVNIL	A1		retourne FAUX
	RETURN
CMPADR8	MOV	.T,A1		retourne T (pourquoi pas A1!)
	RETURN
CMPAER2	MOV	A2,A1		le mauvais argument
CMPAER1	MOV	.GTADR,A2		le nom
	BRA	ERRNLA		ce doit etre une liste

*
*	(MEMORY adr [val])
*	charge un	mot de 16	bits (utilise par le chargeur)
*
*----------------------------------------
	FENTRY	MEMORY,SUBRV2
*----------------------------------------
	BFCONS	A1,MEMORER         il faut une liste
	MOV	CAR(A1),A3
	MOV	CDR(A1),A4
*	VALNB	A3,D1
*	VALNB	A4,D2
*	SWAP	D1
*	AND.L	#$FFFF0000,D1
*	AND.L	#$FFFF,D2
*	OR.L	D1,D2		D2 contient l'adresse sur 32 bits
*	BTNIL.S	A2,MEMR2		vers le GET seul
*	VALNB	A2,D1		D1 contient la valeur
*	MOV	D2,A0
*	MOVE.W	D1,(A0)
*MEMR2	MOV	D2,A0		A0 contient l'adresse
*	MOVE.W	(A0),D1		le GET
*	CRANB	D1,A1
	RETURN	*		et retoune cette valeur
MEMORER	MOV	.MEMORY,A2	le nom
	BRA	ERRNLA		il fallait une liste

*
*	Manipulation de l'adresse de la zone code
*

*----------------------------------------
	FENTRY	ABCODE,SUBR0
*----------------------------------------
	MOV	BCODE,A1		la veritable adresse
	BRA	LOC		transformee en (high . low)

*----------------------------------------
	FENTRY	AECODE,SUBR0
*----------------------------------------
	MOV	ECODE,A1		la veritable adresse
	BRA	LOC		transformee en (high . low)


*========================================
*
*	Les donnees
*
*========================================

	IMPURE

*
*	bloc d'argument pour Pascal
*

ZONARG	DSADR	10


*
*	Fin de la	Section IMPURE (15)	!
*
	XDEF	.EIMPUR

	DSBYTE	 256	       il	faut un multiple de	256 (SAVECORE)
.EIMPUR	EQU	 *

	END