	.TITLE	VL7
	.psect	VL7

;	stored on:	VL7.MAC
;	last revised:	6-SEP-82

xx1	=	version
xx2	=	options
xx3	=	eis
xx4	=	fis
xx5	=	clock
xx6	=	i11.04
xx7	=	recor


	.globl	atcons,atlist,atlst,atmcns,atquot,batom,bfodk,blist,bufat
	.globl	bufin,bufou,catoc,catol,cons,cranb
	.globl	erato,erimp,erlec,erovfl,evalfu
	.globl	false,frever,hdato,ibase,impld,impli,inbpt,inchb,inci,lcou
	.globl	lmar,mbuf,ncons,nil,oubpk,oubpt,popj,qcons,quo2
	.globl	rdprd,ringur,rmar,sign,t

	.iif	ne,fis	.globl	cranf

; MODULE	PAGE	CONTENTS

; VL7		9	****** initialisation de buffers : INIOTT, INIODK.
;		11	****** read.
;		14	****** rd1.
;		19	****** tryat, crato, crach, givchi.
;		27	****** getcv, getch, tabch.



; ****** routines d'initialisation de buffers : INIOTT, INIODK, INIITT, INIRDK.

; ----- iniott  :  initialisation du buffer sortie TT et de son pointeur.
;		  tue a1, a2, a4.

iniott::
	mov	#bufou,a4
	mov	#128.,a1
	mov	#' ,a2
1$:	movb	a2,(a4)+	; inonder bufou de blancs.
	sob	a1,1$
				; initialisation du pointeur de sortie TT.
	mov	lmar,oubpt	; NOTER : oubpt est un pointeur index = [0:127].
				; calcul de lcou.
	mov	rmar,a1
	sub	lmar,a1
	inc	a1
	mov	a1,lcou		; lcou = (rmar - lmar) + 1.
	return
	.page
; ----- INIODK  :  initialisation du buffer sortie DSK et de son pointeur.
;		  tue a1.

iniodk::
	mov	#510.,a1	; car bfodk = [0-1,2-3, ... 510.-511.]
1$:	clr	bfodk(a1)	; inonder bfodk de 0's.
	sub	#2,a1
	bge	1$
				; initialisation pointeur de sortie DSK.
	mov	#bfodk,oubpk	; NOTER : oubpk = pointeur d'adresse de byte.
	return


	.if	ne,recor

; ----- INIRDK  :  initialisation du buffer RECORD et de son pointeur.
;		  tue a1.

inirdk::
	mov	#510.,a1
1$:
	clr	bfrdk(a1)	; inonder bfrdk de 0's.
	sub	#2,a1
	bge	1$

	mov	#bfrdk,rcdpt	; initialisation pointeur buffer record.
	return			; NOTER : rcdpt pointe sur adresse de byte.

	.endc


; ----- INIITT  :  initialisation du buffer d'entree bufin et de son pointeur.

iniitt::
	clrb	bufin
	mov	#bufin,inbpt
	return
; ****** read

; ***** (read)  [subr 0]  -user-

readu::  call	rd1
	cmp	a4,#2		; 2  )

	beq	readu
	br	read0

; ----- read : read interne

read:   call	rd1


; ----- read interne : 1 truc a deja ete lu.

read0:  jmp	@read01(a4)

read01: .word   read2		; 0  (
	.word   erlec		; 2  )
	.word   read1		; 4  [
	.word   erlec		; 6  ]
	.word   erlec		; 8  .
	.word   popj		; 10 at

; ----- un [ a ete lu.


read51:	push	#read52		; element - [...]
read1:  call	rd1
	cmp	a4,#6		; 6  ]
	bne	read12
read11: mov	#nil,a1
	return


read12:
	mov	a4,a3		; sauver type.
	consl   #atlst,#nil,-(p); construire et empiler le hook (atlst . nil).
	push	(p)		; l'empiler une seconde fois : last.
	mov	a3,a4		; restituer type.
	br	read4

; ----- une ( a ete lue.

read50:	push	#read52		; element - (...)
read2:  call	rd1
	cmp	a4,#2		; 2  )
	beq	read11

	call	read0
	call	ncons
	push	a1
.page
; ----- lecture d'un element de liste.


read3:	push	a1
	call	rd1

; ----- traitement d'un element de liste.

read4:  jmp	@read41(a4)


read41: .word   read50		; 0  (
	.word   read42		; 2  )
	.word   read51		; 4  [
	.word   read46		; 6  ]
	.word   read48		; 8  .
	.word   read52		; 10 at

read52:				; hookage de l'element lu.
	call	ncons

	pop	a2
	mov	a1,cdr(a2)	; cdr a2 <- a1.
	br	read3



; ----- traitement fin de liste ( ... )

read42:
	tst	(p)+		; depiler last inutile.
read43:

	pop	a1		; recuperer hook.
	cmp	(a1),#atlst	; est-ce ( ... ]  ?
	bne	readj		; non. retour.
	br	erlecA		; [PM] si oui erreur lecture 2.

readl:  mov	#atlist,(a1)	; coller le veritable atome LIST dans le car.

readj:  return
.page
; ----- traitement fin de liste [ ... ]

read46: tst	(p)+		; depiler last inutile.
	pop	a1		; recuperer hook.
	cmp	(a1),#atlst	; est-ce [ ... )  ?
	beq	readl		; oui: retour.
	br	erlecA		; [PM] si non erreur lecture 3.

; ----- traitement de liste pointee.

read48: call	read		; lire l'expression pointee.
	push	a1		; la mettre au frais.
	call	rd1		; lire un truc separant.
	cmp	a4,#2		; 2  )   ?
	bne	1$		; non

; ----- cas ( suite . e )


	pop	a2		; recuperer l'expression pointee.
	pop	a1		; le dernier doublet.
	mov	a2,cdr(a1)	; lui enfoncer dans son cdr. aaarrgh !
	br	read43


; ----- continuons l'examen.

1$:	cmp	a4,#6		; 6  ]
	beq	2$		;
	br	erlecA		; [PM] si oui erreur lecture 6.

; ----- cas [ suite . e ]

2$:	pop	a1		; recuperer l'expression pointee.
	call	ncons		; en faire un doublet.
	mov	a1,a3		; coller dans a3.
	pop	a2		; recuperer le dernier doublet.
	mov	a3,cdr(a2)	; accrocher le doublet-exp-point au cdr.
	pop	a1		; recuperer hook.
	mov	(a1),a3		; coller le car du hook dans a3.
	cmp	a3,#atlst	; est-ce ( suite . ]  ?
	beq	3$		;
	br	erlecA		; [PM] si oui erreur lecture 5
				; si non: optimisations locales.
3$:	mov	#atcons,a3
	cmp	a2,cdr(a1)	; si l'avant-dernier doublet est
				; le cdr du hook :
	beq	4$		; [ e1 . e2 ] devient (CONS e1 e2).
	mov	#atmcns,a3	; sinon [ e1 ... eN-1 . eN ]
				; devient (MCONS e1 ... eN-1 eN).

4$:	mov	a3,(a1)
	return
; ****** rd1

; ----- rd1 : lit l'u.s. suivante
; au retour a1 = adresse de l'objet LISP lu.
;			a4 = son type
;
;	getcv: ramene dans a4: le type du caractere
;			   a1: le vrai caractere.

rd1:	call	getcv

	sub	#4,a4		; a4 <- a4 - 4.
	asl	a4		; a4 <- a4 * 2.
	jmp	@1$(a4)

1$:	.word   rdparo		; 4  ->   0   (
	.word   rdparf		; 5  ->   2   )
	.word   popj		; 6  ->   4   [
	.word   popj		; 7  ->   6   ]
	.word   popj		; 8  ->   8   .
	.word   rd1		; 9  ->  10   separateur: on saute.
	.word   rdmac		; 10 ->  12   macro-caractere.
	.word   rdst		; 11 ->  14   chaine.
	.word   rdndec		; 12 ->  16   specif (#) de nb non-decimal.
	.word   rd2		; 13 ->  18   normal p-name.

rdparo: inc	rdprd		; incr compteur de "("
	return

rdparf: dec	rdprd		; decr compteur de ")"
	bge	1$
	clr	rdprd		; rdprd doit tjours etre >= 0.
1$:	return
.page
; ----- traitement des macro-caracteres.

rdmac:  call	crach
	mov	a1,a2		; atome-fonction dans a2
	mov	#nil,a1		; liste args dans a1.
	call	evalfu


; ----- objlis  :  ramene le type objet-lisp pour read.

objlis:
	clr	a3		; pour gc.
	mov	#10.,a4		; 10 objet lisp.
	return


; ----- traitement du macro-caractere quote.

rdmaq::	call	read		; lit la s-expression.
	call	ncons
	mov	#atquot,a2
	push	#objlis
xcons::	consl	a2,a1,a1		; [PM] (cons a2 a1) -> a1
	return				; [PM]

; ----- traitement des strings.

rdst:
	mov	#maxpn,a3		; nb max de caracteres.
	mov	#mbuf+1,a2		; pointe sur debut p-name.
rdst3:
	push	a2
	push	a3

	call	getch			; caractere suivant.

	pop	a3
	pop	a2

	cmp	a4,#clstr		; delimiteur chaine ?
	beq	rdst5			; oui. fin de chaine.

	movb	a1,(a2)+		; charger dans buffer.
	sob	a3,rdst3		; si non chien de garde, boucler.
erlecA:	jmp	erlec			; chaine trop longue.
rdst5:
	sub	#maxpn,a3		; calcul plength
	neg	a3
	movb	a3,mbuf			; que l'on range.
	call	crato			; vers interner.
	mov	a1,(a1)			; force la c-val de l'atome
	movb	#at.str,dpptyp(a1)	; force le p-type pseudo-chaine.
	br	objlis
.page
; ----- traitement des nombres non-decimaux.

rdndec:
	call	getcv		; prendre 1 caractere.
	call	givchi		; si chiffre a1 = [0:15] sinon carry
	bcs	erlecA		; [PM] chiffre obligatoire apres le #.
	clr	a5		; a5 : totalisateur.

	clr	a2		; offset decal base 16.
	mov	#4,a3		; nb max de chiffres en base 16.
	cmp	ibase,#16.
	beq	rdndc1		; ok. base 16.


	mov	#2,a2		; offset decal base 8.
	mov	#6,a3		; nb max de chiffres en base 8.
	cmp	ibase,#8.
	beq	rdndc1		; ok. base 8.


	mov	#6,a2		; offset decal base 2.
	mov	#16.,a3		; nb max de chiffres en base 2.
	cmp	ibase,#2
	beq	rdndc1		; ok. base 2.
.page
rdndc0:
	call	givchi		; chiffre dans a1. carry = 1 si non-chiffre.
	bcs	erlecA		; [PM] cas non-chiffre.
rdndc1:
	cmp	a1,ibase
	bge	erlecA		; [PM] chiffre >= base.
	dec	a3		; nb max de chiffres.
	blt	erlecA		; [PM]
	jmp	1$(a2)		; a2 : offset

1$:
	asl	a5		; a2 = 0  -> base 16.
	asl	a5		; a2 = 2  -> base 8.
	asl	a5		; a2 = 4  -> base 4. (non-implementee).
	asl	a5		; a2 = 6  -> base 2.
	bis	a1,a5		; placer le chiffre dans le trou.


	push	a5
	push	a3
	push	a2

	call	getcv		; chiffre suivant.


	pop	a2
	pop	a3
	pop	a5

	cmp	a4,#clnor	; caractere normal ?
	beq	rdndc0		; oui. vers suite des tests.

	mov	a1,ringur	; le refiler au prochain lecteur.
	mov	a5,a1

	clr	a2		; pour gc.
	clr	a3		; pour gc.


	call	cranb		; creer le nombre.
	br	objlis		; et le ramener comme un objet LISP licite.
.page
; ----- traitement des pnames.

rd2:
	mov	#maxpn,a5	; nb caracteres max de pname.
	mov	#mbuf+1,a2	; a2 pointeur dans buffer pname.
	br	rd4


rd3:
	push	a2
	push	a5
	call	getcv		; caractere suivant dans a1.
	pop	a5
	pop	a2

	cmp	a4,#clnor	; toujours normal ?
	beq	rd4		; oui.
	cmp	a4,#cldot	; est-ce un point (.) ?
	bne	rd5		; non. vers fin pname.
				; idee : un (.) ne doit PAS etre en tete
				; d'un atome ou d'un nombre.


rd4:	movb	a1,(a2)+	; oui. charger dans buffer pname.
	sob	a5,rd3		; plength > maxpn ?
	br	erlecA		; [PM] erreur pname trop long.

rd5:	mov	a1,ringur	; sauver le dernier separateur.

	sub	#maxpn,a5	; calcul longueur pname.
	neg	a5
	movb	a5,mbuf		; coller longueur en tete.
	push	#objlis		; pour ramener le type rd1 = 10 (objet lisp)
				; tryat doit suivre.
; ****** tryat, crato, crach, givchi

; ----- tryat : regarde la chaine dans mbuf.
;		appelle cranb si nombre, cratom  si atome litteral.
;		on tombe directement ici a partir de la page precedente.

tryat:	mov	#mbuf,a4	; adresse du buffer dans a4
	movb	(a4)+,a2	; taille du buffer dans a2

	clr	a1		; raz accu.
	clr	sign		; raz signe.

	movb	(a4)+,a3	; recup le 1er caractere.
	cmp	#'-,a3		; test de signe.
	bne	trya8		; rate.
	dec	a2		; actualise le nb de caracteres restants.
	beq	crato		; yavait qu'un "-" ! vieux piege.
	inc	sign		; sinon signe < 0.

; .........
	.if	eq,fis
trya7:	movb	(a4)+,a3	; caractere suivant dans a3.
trya8:	sub	#'9+1,a3	; verifier que c'est un chiffre.
	add	#'9+1-'0,a3
	bcc	crato		; c'en est pas un.
				; val chiffre dans a3.
	cmp	a1,#3276.	; [PM] is it to big to multiply by 10?
	blos	1$		; [PM] jump if not
	jmp	erovfl		; [PM] indicate overflow
;
; now compute:  a1 = a3 + 10*a1
;
1$:	asl	a1		; [PM]
	add	a1,a3		; [PM]
	asl	a1		; [PM]
	asl	a1		; [PM]
	add	a3,a1		; [PM] accum. = accum. + digit

	sob	a2,trya7	; si plength > 0.
				; creation nb avec sign.
	jmp	quo2		; [PM] go attach the sign
	.endc
; .........
.page
; .........
	.if	ne,fis
				; si unite flottante.

trya7:
	movb	(a4)+,a3	; caractere suivant dans a3.

trya8:
	cmp	a3,#'.		; est-ce le point ?
	beq	tryflo		; oui. cas flottant.
				; non.
	sub	#'9+1,a3	; verifier que c'est un chiffre.
	add	#'9+1-'0,a3
	bcc	crato		; c'en est pas un. symbole atomique.
	sob	a2,trya7	; tantque plength > 0.

	; cas entier.

	mov	#mbuf,a4	; adresse buffer dans a4
	movb	(a4)+,a2	; taille buffer dans a2.
	movb	(a4)+,a3	; 1er caractere dans a3.
	cmp	#'-,a3		; est-ce "-" ?
	bne	trya10		; non.
	dec	a2		; oui. decroitre longueur et avancer.
trya9:
	movb	(a4)+,a3	; prochain caractere.
trya10:
	sub	#'0,a3		; chiffre dans a3.
	push	a2		; sauver longueur.
	mul	#10.,a1		; a1-a2 <- a1 * 10.
	bcc	1$		; overflow ?
	jmp	erovfl		; oui.
1$:				; non.
	mov	a2,a1		; rendons a Cesar...
	add	a3,a1		; et sommons le chiffre.
	pop	a2		; restaurer longueur du buffer restant.
	sob	a2,trya9	; et boucler tant que necessaire.
	jmp	quo2		; [PM]
	.endc
	.page
	.if	ne,fis

	; cas flottant.

tryflo:	mov	#mbuf,a4	; adresse buffer dans a4
	movb	(a4)+,a2	; taille buffer dans a2.
	cmp	a2,#1		; [PM] a floating pt. # cant be length 1
	beq	crato		; [PM] (EXPLODE ".") = (.) not (0.)
	movb	(a4)+,a3	; 1er caractere dans a3.
	clr	-(p)		; accu flottant low.
	clr	-(p)		; accu flottant high.
	cmp	#'-,a3		; est-ce "-" ?
	bne	tryfl2		; non.
	dec	a2		; oui. decroitre longueur et avancer.
tryfl1:	movb	(a4)+,a3	; prochain caractere.
tryfl2:	cmp	a3,#'.		; est-ce le point ?
	beq	tryfl3		; oui.
				; non.

	sub	#'0,a3		; chiffre dans a3.
				; "push" 10.0
	clr	-(p)
	push	#041040

	fmul	p		; accu-flt-1 <- accu-flt-1 * 10.0

	asl	a3		; car tflt1 est une table de mots.

	clr	-(p)		; pusher le-chiffre en flottant.
	push	tflt1(a3)

	fadd	p
	sob	a2,tryfl1

tryfl3:	clr	-(p)		; new acc flt low.
	clr	-(p)		; new acc flt high.
	clr	a5		; nb chiffres apres point.
	br	tryfl5

tryfl4:	movb	(a4)+,a3	; prochain caractere.
	inc	a5		; un chiffre de plus apres le point.
	sub	#'0,a3		; chiffre dans a3.

				; "push" 10.0
	clr	-(p)
	push	#041040

	fmul	p

	asl	a3		; car tflt1 est une table de mots.

	clr	-(p)		; pusher le-chiffre en flottant.
	push	tflt1(a3)

	fadd	p		; additionner le-chiffre-floated.
	.endc
	.page
	.if	ne,fis

tryfl5:
	sob	a2,tryfl4
	tst	a5
	br	2$
1$:				; on divise le 2d accu flottant.
	clr	-(p)		; par 10.0 autant de fois qu'ya de chiffres
	push	#041040		; apres le point.
	fdiv	p
	dec	a5
2$:
	bgt	1$

	fadd	p		; additionner les 2 accus flottants.
	pop	a1
	pop	a2
	tst	sign
	beq	3$

	bis	#100000,a1	; coller bit de signe.
3$:
	jmp	cranf

tflt1:				; table des chiffres 0 : 9 en flottant-1-mot.
	.word   000000		; 0.0
	.word   040200		; 1.0
	.word   040400		; 2.0
	.word   040500		; 3.0
	.word   040600		; 4.0
	.word   040640		; 5.0
	.word   040700		; 6.0
	.word   040740		; 7.0
	.word   041000		; 8.0
	.word   041020		; 9.0

	.endc
; .........
.page
; ----- crato : cherche l'atome litteral dans mbuf.
;		le cree s'il n'existe pas.


crato:
	mov	hdato,a3
	movb	mbuf,a2		; longueur p-name.
craf1:
	cmpb	dplpn(a3),a2
	bne	craf6

	push	a3		; sauver adresse atome courant.
	mov	a2,a4		; plength dans a4 compteur.
	add	#dplpn+1,a3
	mov	#mbuf+1,a5
craf3:				; avance dans mbuf.
	cmpb	(a5)+,(a3)+
	bne	craf5		; c'est pas le meme.
	sob	a4,craf3
				; trouve !!!
	mov	a1,a2		; predecesseur dans a2
	pop	a1		; pop adresse de l'atome courant.
	cmp	a1,hdato	; c'etait le premier ?
	beq	1$		; oui.
	mov	dpnexa(a1),dpnexa(a2)	; suivant predecesseur <- suiv.courant.
	mov	hdato,dpnexa(a1)	; vieux premier devient second.
	mov	a1,hdato		; courant devient premier.
1$:
	clr	a3		; pour gc.
	return			; et on livre tout chaud au client.
craf5:
	pop	a3		; restaurer adresse atome courant.

craf6:
	mov	a3,a1		; predecesseur dans a1.
	mov	dpnexa(a3),a3	; adresse next atome dans a3.
	bne	craf1		; si non fin de chaine alors vers craf1.


				; creer atome. a2 = plength.
	mov	catoc,a1	; courant atome.
	mov	#bufat,a3	; pour copier le nouvel atome.
	add	#11.,a2		; a2 = nb bytes de l'atome : 11. + plength.
	mov	a2,a4
	dec	a4
	add	catoc,a4	; a4 = catoc + 11. + plength - 1;
	jflst   a4,1$		; ca rentre ?
	jmp	erato		; helas non.
.page
1$:
	mov	(a3)+,(a1)+	; copier 1 mot.
	sub	#2,a2
	bgt	1$		; continuer s'il en reste.

	mov	a1,a4
	mov	catoc,a1
	mov	hdato,dpnexa(a1)
	mov	a1,catol
	mov	a1,hdato	; un nouvellement cree devient premier.
	mov	a4,catoc

	clr	a2		; pour gc.
	clr	a3		; pour gc.

	return


; ----- givchi  :  caractere dans a1. "0" ... "9" "A" ... "F".
;		  met le carry a 1 si c'est pas un de ceux-ci.
;		  si c'en est a1 = [0:15]

givchi:
	cmp	a1,#'0
	blo	2$		; c = 1.
	cmp	a1,#'9
	blos	1$		; soustraire #'0.
	cmp	a1,#'A
	blo	2$		; c = 1.
	cmp	#'F,a1
	blo	2$		; c = 1.
	sub	#7,a1
1$:
	sub	#'0,a1
	clc			; c = 0.
2$:
	return
.page
; ***** (PEEKCH)  [SUBR 0]  ne le mange pas.

peekch::
	call	getch		; lit n'importe quoi.
	mov	a1,ringur	; pour le remanger.
	br	crach		; [PM] interne.

; ***** (READCH)  [SUBR 0]

readch:: call	getch		; crach doit suivre.

; ----- crach : cree l'atome mono-caractere (caractere dans a1).

crach::
	mov	#mbuf,a4	; pointe sur p-length
	movb	#1,(a4)+	; plength = 1.
	movb	a1,(a4)		; charge le caractere.
	jmp	tryat		; et on interne.

; ----- vlas : met dans a1 le code ascii du 1er caractere
;		de l'atome dans a1 (litteral ou numerique).

vlas::
	jtnum   a1,vlas1	; dans le cas d'un nombre.
				; cas atome.
	movb	dplpn+1(a1),a1	; attraper le 1er caractere.
	return

vlas1:				; cas nombre, c'est un inum.
;;;;	bic	#177600,a1	; se saisir des poids faibles.
;;;;	add	#'0,a1		; convertir froidement.
;;;;	return			; et ne pas s'en faire si > 9.
				; [PM] I deleted previous 3 lines & added next 2
	bic	#177400,a1	; much more natural for PRINCH and OUTBUF especially
	return			; for 4010 graphics (this allows all 8 bits to be used)

; ***** (TEREAD)  [SUBR 0] passe a l'enregistrement suivant.

teread:: call	inci		; do it.
	jmp	false		; ramene toujours nil.


; ***** (ASCII N)  [SUBR 1]  cree l'atome de code ascii N.

ascii::  bic	#177600,a1	; recupere les 7 bits low, ok : a1 est un inum.
	br	crach		; [PM] on le cree.


; ***** (CASCII C)  [SUBR 1] ramene le code ascii du caractere C.

cascii  ==	vlas
.page
; ***** (TYPECH C [VAL])  [SUBR 2]
;			get/set le type du caractere C dans la table TABCH.

typech::
	call	vlas		; a1 = le code ascii de a1.
	jfnil   a2,1$		; que faire ?

	movb	tabch(a1),a1	; attraper le code dans a1. (inum).

	return			; et bye.

1$:				; modifier.
	movb	a2,tabch(a1)	; placer a2 qui a interet a etre un INUM.
	a2popj			; et on ramene la valeur.


; ***** (IMPLODE L)  [SUBR 1] interne la liste L.

implod::
	push	a1		; protege la liste (G.C.)
	mov	a1,impld	; pour getch.
	inc	impli		; indic implode = vrai.
	call	read
	clr	impli		; indic implode = faux.
	tst	(p)+		; enleve la vieille liste.
	return


; ***** (READLINE)   [SUBR 0] ramene une liste des caracteres d'une ligne.
;				%%%%%% verifier que ca ne lit pas 1
;				nouveau bloc disque.
;				montre qu'il faut un buffer SEPARE d'entree TT.

readli::				; [PM] deleted the jsr pc,teread
	push	#nil		; preparer et sauver le NIL du CONS.
	br	2$
1$:
	call	crach		; interner le caractere lu.
	mov	(p),a2
	call	cons
	mov	a1,(p)
2$:
	call	inchb
	cmp	a1,#cr
	beq	2$		; [PM] ignore carriage returns completely
	cmp	a1,#lf		; use line feeds to separate lines
	bne	1$
3$:
	pop	a1
	mov	#nil,a2		; pour plaire a FREVERSE.
	jmp	frever
; ****** getcv, getch, tabch

; ----- getcv : ramene le 1er caractere LISP valide.
;		traite les commentaires et les slashes.
;		fait la conversion MIN -> MAJ.
;		ramene: a1 = le-caractere, a4 = le-type.

getv1:
	call	getch
	cmp	a4,#clbcm	; debut commentaire ?
	beq	getcv		; oui. commentaire termine (; ...	;)
	cmp	a4,#clecm	; fin commentaire ?
	bne	getv1		; non. continuer lecture du commentaire.

; ----- entry getcv

getcv:
	call	getch
	cmp	a4,#clshl	; quote caractere ?
	bne	getv2		; non. vers suite des tests.
	call	getch		; oui. on lit le suivant.
	mov	#clnor,a4	; qui est normal d'autorite.
	return

getv2:  cmp	a4,#clbcm	; debut commentaire ?
	beq	getv1		; oui.
	cmp	a4,#clecm	; fin commentaire ?
	beq	getcv		; oui. on l'ignore.
				; conversion min -> maj.
	tst	impli
	bne	getv3		; si implode : pas de conversion min -> maj.

	cmp	a1,#141		; a minuscule.
	blo	getv3		; si inferieur pas de conversion.
	cmp	a1,#172		; z minuscule.
	bhi	getv3		; si superieur pas de conversion.
	sub	#40,a1		; la-conversion.
getv3:
	return
.page
; ----- getch : lit le caractere suivant ou celui a reingurgiter.
;		ramene: a1 = le-caractere, a4 = le-code.

getch:  mov	ringur,a1	; qqchose a reingurgiter ?
	beq	geth1		; non.
	clr	ringur		; raz ringur. caractere dans a1.
	br	geth2

geth1:
	tst	impli		; est-on dans la fonction implode ?
	bne	geth3		; oui.
				; non.
	call	inchb		; a1 <- le caractere suivant.

geth2:
	movb	tabch(a1),a4	; a4 <- le type.

	beq	getch		; caractere nul a ignorer ?
	return
geth3:
	mov	impld,a1	; recupere la liste-implode.
	jtnil   a1,geth6	; s'il n'en reste plus.

	jtlst   a1,1$
	jmp	erimp		; c'est une liste pointee. aarrgghh...
1$:
	push	a2		; on ne sait jamais.
	uncns
	mov	a1,impld	; sauve le cdr.
	mov	a2,a1
	jtnum   a1,geth4
	movb	dplpn+1(a1),a1	; 1er caractere du p-name.
	br	geth5
geth4:
	bic	#177600,a1	; prendre les 7 bits low.
	add	#'0,a1		; et convertir en ascii
geth5:
	pop	a2		; restaurer le on-ne-sait-jamais.
	br	geth2		; avec le caractere dans a1.
geth6:
	mov	#t,impld	; 1ere fin : pourquoi laisser le T ?
	mov	#' ,a1		; dernier separateur.
	br	geth5
.page
; ----- tabch


tabch::
	.byte	0.,13.,13.,13., 13.,13.,13.,13.		; nl ^a ^b ^c  ^d ^e ^f ^g
	.byte	9., 9., 9., 9.,  9., 9.,13.,13.		; bs ht lf vt  ff rc ^n ^o
	.byte   13.,13.,13.,13., 13.,13.,13.,13.	; ^p ^q ^r ^s  ^t ^u ^v ^w
	.byte   13.,13.,13.,13.,  0., 0., 0., 0.	; ^x ^y ^z es  no no no no
	.byte	9.,13.,11.,12., 13.,13.,13.,10.		; sp  !  "  #   $  %  &  '
	.byte	4., 5.,13.,13., 13.,13., 8., 3.		;  (  )  *  +   ,  -  .  /
	.byte   13.,13.,13.,13., 13.,13.,13.,13.	;  0  1  2  3   4  5  6  7
	.byte   13.,13.,13., 1., 13.,13.,13.,13.	;  8  9  :  ;   <  =  >  ?
	.byte   13.,13.,13.,13., 13.,13.,13.,13.	;  @  A  B  C   D  E  F  G
	.byte   13.,13.,13.,13., 13.,13.,13.,13.	;  H  I  J  K   L  M  N  O
	.byte   13.,13.,13.,13., 13.,13.,13.,13.	;  P  Q  R  S   T  U  V  W
	.byte   13.,13.,13., 6., 13., 7.,13.,13.	;  X  Y  Z co   \ cf  ^ hb
	.byte	0.,13.,13.,13., 13.,13.,13.,13.		; no  a  b  c   d  e  f  g
	.byte   13.,13.,13.,13., 13.,13.,13.,13.	;  h  i  j  k   l  m  n  o
	.byte   13.,13.,13.,13., 13.,13.,13.,13.	;  p  q  r  s   t  u  v  w
	.byte   13.,13.,13.,13., 13.,13.,13., 0.	;  x  y  z ao  vb af ng dl


	.end			; ****** END OF VL7 ******
